Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/extract_rst.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/extract_rst.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/extract_rst.sh	(revision 8732)
@@ -0,0 +1,312 @@
+#! /bin/sh
+set -x
+#+
+#
+# ==========
+# extract.sh
+# ==========
+#
+# -----------------------------------------
+# extract ReStructuredText from source file
+# -----------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ``extract_rst.sh -i filein -l language -o fileout``
+#
+# DESCRIPTION
+# ===========
+#
+# ``extract_rst.sh`` extracts ReST comments from the file given in argument
+#
+# -i  input file
+# -o  output file (ReST)
+# -l  language
+#
+# Comment block (start, end) identification depends on language :
+#
+#  *F90*
+#   FORTRAN source free form
+#  *fortran*
+#   FORTRAN source fixed form
+#  *sh*
+#   shell scripts
+#  *IDL*
+#   IDL source
+#  *xml*
+#   XML and XSL
+#  *dot*
+#   graphviz files
+#  *php*
+#   PHP files
+#  *matlab*
+#   matlab or octave files
+#
+# EXAMPLES
+# ========
+#
+# To extract ReST comments of this shell script::
+#
+#  $ extract_rst.sh -i extract_rst.sh -l sh -o extract_rst.sh.rst
+#  iii : rst lines of extract_rst.sh are in extract_rst.sh.rst
+#
+# You can produce HTML file from this new file::
+#
+#  $ rst2html.py --input-encoding=ISO-8859-15 extract_rst.sh.rst \
+#    /usr/temp/${LOGNAME}/extract_rst.sh.html
+#
+# You can produce PDF file from this new file::
+#
+#  $ rst2newlatex.py --input-encoding=ISO-8859-15 extract_rst.sh.rst \
+#    /usr/temp/${LOGNAME}/extract_rst.sh.tex
+#  $ pdflatex extract_rst.sh.tex
+#
+# Of course beware of consistency of path on links.
+#
+# CAUTIONS
+# ========
+#
+# Becaue of poor implementation of Standard FORTRAN in cpp (prepocessing)
+# within gfortran and g95, ReST comments might induce trouble in
+# FORTRAN sources.
+#
+# For example following line is pointed out be gfortran with
+# ``error: unterminated comment``.
+# This is because ``/*`` is the beginning of a C style comment !!
+# ::
+#
+#      !    **MEAN** = sum( *X*\ (:) )/*ntime*
+#
+#
+#
+# One can modify this ReST line with
+# ::
+#
+#      !    **MEAN** = sum( *X*\ (:) ) / *ntime*
+#
+# TODO
+# ====
+#
+# check parameters
+#
+# log
+#
+# add perl
+#
+# SEE ALSO
+# ========
+#
+# ReStructuredText_
+#
+# .. _ReStructuredText: http://docutils.sourceforge.net/rst.html
+#
+# Docutils_
+#
+# .. _Docutils: http://docutils.sourceforge.net/
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+# - fplod 2009-04-20T08:13:37Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add CAUTIONS paragraph to warn about possible FORTRAN compiling problem
+#
+# - fplod 2009-04-03T14:53:18Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * usage of tr instead of sed to remove ``\r``
+#     due to difference between ``/sw/bin/sed`` and ``/usr/bin/sed`` (the last
+#     one do not work coorectly on ``\r`` interpertation ie: remove the first occurence of
+#     ``r``)
+#
+# - fplod 2009-02-10T10:46:23Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add language fortran for FORTRAN source in fixed form
+#
+# - fplod 2009-01-05T11:41:33Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * remove \\r (CRLF) from file before awk and sed (otherwise ReST block
+#     was not found in "ISO-8859 text, with CRLF line terminators" files
+#
+# - fplod 2008-12-22T10:37:37Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add matlab (octave)
+#
+# - fplod 2008-09-17T13:40:37Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add php language
+#
+# - fplod 2008-09-08T09:34:04Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add F90 language
+#
+# - fplod 2008-08-08T08:28:30Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add KML files (with other XML files)
+#   * add parameters ``-i`` ``-l`` ``-o``
+#
+# - fplod 200807
+#
+#   * creation
+#
+#-
+#
+system=$(uname)
+case "${system}" in
+   AIX|IRIX64)
+      echo " www : no specific posix checking"
+   ;;
+   *)
+      set -o posix
+   ;;
+esac
+unset system
+#
+command=$(basename ${0})
+log_date=$(date -u +"%Y%m%dT%H%M%SZ")
+log=/tmp/$(basename ${command} .sh).log.${log_date}
+#
+usage=" Usage : ${command} -i filein -l language -o fileout"
+#
+minargcount=6
+#echo " narg ${#}"
+if [ ${#} -lt ${minargcount} ]
+then
+   echo "eee : not enought arguments"
+   echo "${usage}"
+   exit 1
+fi
+#
+# default
+# n.a.
+#
+while [ ! -z "${1}" ]
+do
+   case ${1} in
+      -i)
+         filein=${2}
+         shift
+      ;;
+      -o)
+         fileout=${2}
+         shift
+      ;;
+      -l)
+         language=${2}
+         shift
+      ;;
+      -h)
+         echo "${usage}"
+         exit 0
+      ;;
+      *)
+         echo "eee : unknown option ${1}"
+         echo "${usage}"
+         exit 1
+      ;;
+   esac
+   # next flag
+   shift
+done
+#
+set -u
+#
+# ++ check param
+#
+case "${language}" in
+   fortran)
+      awkblockstart="^C\+$"
+      awkblockend="^C-$"
+      sedblockstart="^C+$"
+      sedblockend="^C-$"
+      comment="^C"
+   ;;
+   F90)
+      awkblockstart="^!\+$"
+      awkblockend="^!-$"
+      sedblockstart="^!+$"
+      sedblockend="^!-$"
+      comment="^!"
+   ;;
+   IDL)
+      awkblockstart="^;\+$"
+      awkblockend="^;-$"
+      sedblockstart="^;+$"
+      sedblockend="^;-$"
+      comment="^;"
+   ;;
+   xml)
+      awkblockstart="^<!--rst$"
+      awkblockend="-->$"
+      sedblockstart="^<!--rst$"
+      sedblockend="-->$"
+      comment=""
+   ;;
+   sh)
+      # iii : awk '/^\#\+/,/^\#\-/' $file
+      awkblockstart="^\#\+$"
+      awkblockend="^\#\-$"
+      sedblockstart="^#+"
+      sedblockend="^#-"
+      comment="^#"
+   ;;
+   dot|php)
+      awkblockstart="^\/\*rst$"
+      awkblockend="*\/"
+      sedblockstart="^\/\*rst$"
+      sedblockend="^\*\/"
+      comment=""
+   ;;
+   matlab)
+      awkblockstart="^%\+$"
+      awkblockend="^%-$"
+      sedblockstart="^%+$"
+      sedblockend="^%-$"
+      comment="^%"
+   ;;
+   *)
+      echo "eee : ${language} not implemented"
+      exit 1
+   ;;
+esac
+#
+# just in case suppress \r at the end of lines
+tr -d '\r' < ${filein} > /tmp/${$}_0
+#
+# put rst blocks in one temporary file
+#awk '/^;+/,/^;-/' a.pro | sed -e "/^;+$/d" -e "/^;-$/d" -e "s/^;//"
+cmdawk="awk '/${awkblockstart}/,/${awkblockend}/' /tmp/${$}_0 > /tmp/${$}_1" #++
+eval ${cmdawk}
+if [ ! -s /tmp/${$}_1 ]
+then
+   rm /tmp/${$}_0 /tmp/${$}_1
+   echo "iii : no rst comments in ${filein}"
+   exit 1
+fi
+#
+# suppress begin and end of each block
+sedcmd="sed -e \"/${sedblockstart}/d\" -e \"/${sedblockend}/d\" /tmp/${$}_1 > /tmp/${$}_2"
+eval ${sedcmd}
+#
+# suppress comment at the beginning of each line
+if [ "${comment}" != "" ]
+then
+   sedcmd="sed -e \"s/${comment}//\" /tmp/${$}_2 > /tmp/${$}_3"
+   eval ${sedcmd}
+   # suppress first blank
+   cp /tmp/${$}_3 /tmp/${$}_2
+   sed -e "s/^ //" /tmp/${$}_2 > /tmp/${$}_3
+   cp /tmp/${$}_3 ${fileout}
+else
+   cp /tmp/${$}_2 ${fileout}
+fi
+#
+echo "iii : rst lines of ${filein} are in ${fileout}"
+#
+# clean
+rm /tmp/${$}_0 /tmp/${$}_1 /tmp/${$}_2 /tmp/${$}_3 2> /dev/null
+#
+# exit
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/install.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/install.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/install.sh	(revision 8732)
@@ -0,0 +1,193 @@
+#!/bin/sh -x
+#+
+#
+# ==========
+# install.sh
+# ==========
+#
+# ----------------------------------------------
+# publication of HTML files and associated files
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ install.sh -w dirwww -p dirpublish -u urlpublish -l login
+#
+# DESCRIPTION
+# ===========
+#
+# publication (rsync) of dirwww content on dirpublish given in argument
+#
+# If the host of publication is cerbere.locean-ipsl.upmc.fr, a specific update
+# is launched.
+#
+# -w  input directort
+# -p  output directory
+# -u  output url
+# -l  login used to access on output url
+#
+# If needed, existing directories might be removed before (to erase obsolete
+# files), using ncftp tool :
+#
+# For example, to clean directory on LOCEAN web server ::
+#
+#  $ ncftp -u fplod www.locean-ipsl.upmc.fr
+#  ncftp> cd fplod
+#  ncftp> rm -f pageperso/.DS_Store
+#  ncftp> rm -rf pageperso
+#  ncftp> exit
+#
+# EXAMPLES
+# ========
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+# - fplod 2008-09-16T15:24:26Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * comments in ReStructured Text
+#
+# - fplod 2008-06-17T09:10:19Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add -l parameter only used in specific case at LOCEAN when user
+#     parameter of persoweb must be different tthan login (ex: acmo vs fplod)
+#   * replace http://www.lodyc.jussieu.fr/info_reseau/persoweb/?fastupdate=1&user=${user}" by
+#     http://intranet.locean-ipsl.upmc.fr/persoweb/?fastupdate=1&user=${user}
+#
+# - fplod 2008-03-28T10:26:58Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * new personnal webpages policy at LOCEAN so new command and new parameter (-u)
+#
+# - fplod 2007-09-28T09:30:43Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * parametrisation and translation
+#
+# - smasson 2007-06-07T16:43:42Z arete.locean-ipsl.upmc.fr (Darwin)
+#
+#   * can give the answer with input parameters
+#
+# - fplod 2007-04-26T11:51:42Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#-
+system=$(uname)
+case "${system}" in
+   AIX|IRIX64)
+      echo " www : no specific posix checking"
+   ;;
+   *)
+      set -o posix
+   ;;
+esac
+unset system
+#
+command=$(basename ${0})
+log_date=$(date -u +"%Y%m%dT%H%M%SZ")
+log=/tmp/$(basename ${command} .sh).log.${log_date}
+#
+usage=" Usage : ${command} -w dirwww -p dirpublish -u urlpublish -l login"
+#
+minargcount=4
+#echo " narg ${#}"
+if [ ${#} -lt ${minargcount} ]
+then
+   echo "eee : not enought arguments"
+   echo "${usage}"
+   exit 1
+fi
+unset minargcount
+#
+# default
+dirpublish="none"
+urlpublish="none"
+login="none"
+#
+while [ ! -z "${1}" ]
+do
+   case ${1} in
+      -w)
+         dirwww=${2}
+         shift
+      ;;
+      -p)
+         dirpublish=${2}
+         shift
+      ;;
+      -u)
+         urlpublish=${2}
+         shift
+      ;;
+      -l)
+         login=${2}
+         shift
+      ;;
+   esac
+   # next flag
+   shift
+done
+#
+set -u
+#
+# ++ check directories
+#
+answer=${1:-" "}
+case ${answer} in
+   y|Y|n|N)
+   ;;
+   *)
+      if [ "${dirpublish}" != "none" ]
+      then
+         echo "Do you want to install on ${dirpublish} (y|[n]) ?"
+         read answer
+      fi
+      if [ "${urlpublish}" != "none" ]
+      then
+         echo "Do you want to install on ${urlpublish} (y|[n]) ?"
+         read answer
+      fi
+   ;;
+esac
+#
+case  ${answer} in
+   y|Y)
+      if [ "${dirpublish}" != "none" ]
+      then
+         # copy of ${dirwww} on $dirpublish
+         echo "iii : update of ${dirpublish}"
+         rsync -av --exclude=".DS_Store" -e ssh ${dirwww}/ ${dirpublish}
+         # detect if in dirpublish following this pattern [USER@]HOST:SRC, HOST
+         # is cerbere.locean-ipsl.upmc.fr. If so, a specific update is launched
+         userhost=${dirpublish%%:*}
+         host=${userhost##*@}
+         if [ ${login} = "none" ]
+         then
+            user=${userhost%%@*}
+         else
+            user=${login}
+         fi
+         if [ "${host}" = "cerbere.locean-ipsl.upmc.fr" ]
+         then
+            wget -q "http://intranet.locean-ipsl.upmc.fr/persoweb/?fastupdate=1&user=${user}" -O /dev/null
+         fi
+      else
+         # urlpublish=http://www.locean-ipsl.upmc.fr/~ginette/produit
+         dirpublish=${urlpublish##*~}
+         cd ${dirwww}
+         #lftp -e "mirror -R . ${dirpublish};quit" -u ${LOGNAME} skyros.locean-ipsl.upmc.fr
+         lftp -e "mirror -R . ${dirpublish};quit" -u ${LOGNAME} localhost
+         # pour acmo a la main ++
+         #++lftp -e 'mirror -R . acmo/nouveaux/;quit' -u fplod www.locean-ipsl.upmc.fr
+         # ++ log
+      fi
+   ;;
+   *)
+      echo "no update of ${dirpublish} or ${urlpublish}"
+   ;;
+esac
+#
+# normal exit
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/makefile_compile
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/makefile_compile	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/makefile_compile	(revision 8732)
@@ -0,0 +1,335 @@
+#+
+#
+# ========
+# makefile
+# ========
+#
+# -----------------------------------------------
+# generation of documentation of NEMO compilation
+# -----------------------------------------------
+#
+# TODO
+# ====
+#
+# add -W to sphinx command when encoding problems are solved
+#
+# usage of sphinx/source/Makefile
+#
+# revision of manual section of php and xsl
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+# - fplod 20100419T145702Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * remove rest2web (sphinx is prefered)
+#
+# - fplod 20100323T135104Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * remove one pdf and html
+#
+# - fplod 20100311T143131Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add rest2web (alternative to sphinx)
+#
+# - fplod 20100310T190253Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add php and xsl files to man_troff
+#
+# - fplod 20100310T182201Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * usage of sphinx (for the first time !) not yet ok ...
+#
+# - fplod 20100310T091541Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add man_troff with shell scripts possible now with docutils 0.6
+#     can be test with
+#      $ man -M ../doc//manuals/man bibopa.sh
+#
+# - fplod 2009-05-13T14:08:49Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * implicit rules
+#
+#     nb : may be will only work wih GNU make
+#     but easier to update : only one line to add in thi makefile when
+#     a new file is added in $(DIRSRC) directory
+#
+#   * rst2latex usage of manuals_many.sty and manual_one.sty (for TOC and parindent)
+#   * bug fix for PDF manual (missing one pdf2latex)
+#
+# - fplod 2008-10-28T10:59:44Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * add newpage directive
+#     (thanks to http://docutils.sourceforge.net/docs/user/latex.html)
+#
+# - fplod 2008-09-17T09:16:08Z aedon.locean-ipsl.upmc.fr (Darwin)
+#   * add xsl files
+#
+# - fplod 2008-09-16T14:59:02Z aedon.locean-ipsl.upmc.fr (Darwin)
+#   * creation
+#
+# SEE ALSO
+# ========
+#
+# extract_rst.sh_
+#
+# .. _extract_rst.sh: ../extract_rst.sh.html
+#
+#-
+#
+PRODUCT = \
+NEMO_UTIL
+
+PRODUCTNAME = \
+$$(echo $(PRODUCT) | tr [:lower:] [:upper:])
+
+DIRSRC = \
+../../NEMOGCM/TOOLS/COMPILE
+
+DIRADM = \
+./
+
+DIRTMP = \
+./
+
+DIRDESIGN = \
+./design/
+
+DIRWWW = \
+./doc/
+
+URLPUBLISH = \
+http://192.168.0.12/~rblod/$(PRODUCT)
+
+LIST_SRCSH = $(wildcard $(DIRSRC)/*.sh) \
+$(DIRSRC)/../../CONFIG/makenemo \
+$(DIRSRC)/../maketools
+
+LIST_SRCSH_RST = $(addprefix $(DIRTMP)/, $(notdir $(addsuffix .rst,$(LIST_SRCSH))))
+
+LIST_SRCSH_R2W = $(addprefix $(DIRTMP)/rest2web_tmpdir/, $(notdir $(addsuffix .txt,$(LIST_SRCSH))))
+
+LIST_SRCSH_TROFF = $(addprefix $(DIRWWW)/manuals/man/man1/, $(notdir $(addsuffix .1,$(LIST_SRCSH))))
+
+LIST_SRCSH_HTML = $(adprefix $(DIRWWW)/manuals/html/many/, $(notdir $(addsuffix .html,$(LIST_SRCSH))))
+
+LIST_SRCSH_PDF = $(addprefix $(DIRSRC)+$(DIRWWW)/manuals/pdf/many/,$(notdir $(addsuffix .pdf,$(LIST_SRCSH))))
+
+RST2MAN = \
+rst2man.py
+
+RST2HTML = \
+rst2html.py
+
+RST2LATEX = \
+rst2latex.py
+
+RST2LATEX_OPTIONS_MANY = \
+--documentclass=article \
+--stylesheet=manuals_many.sty \
+--traceback \
+--use-verbatim-when-possible
+
+.PHONY : \
+help \
+before \
+clean \
+cleantmp \
+design \
+htmllinkcheckb \
+htmllinkchecka \
+spellcheck \
+all \
+man \
+man_troff \
+man_html \
+man_html_many \
+man_html_sphinx \
+man_pdf \
+man_pdf_many \
+man_pdf_sphinx
+
+help :
+	@echo "Prepare output directories :"
+	@echo "\$$ make before"
+	@echo ""
+	@echo "Following commands are available to build outputs :"
+	@echo "\$$ make all"
+	@echo " "
+	@echo "Check links before installation : "
+	@echo "\$$ make htmllinkcheckb"
+	@echo " "
+	@echo "Last step = installation"
+	@echo "\$$ make install"
+	@echo " "
+	@echo "Check links after installation : "
+	@echo "\$$ make htmllinkchecka"
+	@echo " "
+
+before :
+	@mkdir -p $(DIRWWW)/manuals/man/man1/
+	@mkdir -p $(DIRWWW)/manuals/html/many/
+	@mkdir -p $(DIRWWW)/manuals/html/rest2web/
+	@mkdir -p $(DIRWWW)/manuals/html/rest2web/css/
+	@mkdir -p $(DIRWWW)/manuals/html/sphinx/
+	@mkdir -p $(DIRWWW)/manuals/pdf/many/
+	@mkdir -p $(DIRWWW)/manuals/pdf/sphinx/
+	@mkdir -p $(DIRTMP)/sphinx_tmpdir/doctrees/
+	@mkdir -p $(DIRTMP)/rest2web_tmpdir/
+
+install :
+	@install.sh -w $(DIRWWW) -u $(URLPUBLISH)
+
+clean : \
+cleantmp
+	-@rm -fr $(DIRWWW)/
+	-@rm -fr $(DIRWWW)/manuals/man/
+	-@rm -fr $(DIRWWW)/manuals/html/
+	-@rm -fr $(DIRWWW)/manuals/pdf/
+
+cleantmp :
+	-@rm -f $(DIRTMP)/all.xml
+	-@rm -f $(DIRTMP)/*.rst
+	-@rm -f $(DIRTMP)/*.tex
+	-@rm -rf $(DIRTMP)/rest2web_tmpdir/
+	-@rm -f $(DIRTMP)/rest2web.log
+	-@rm -f $(DIRWWW)/manuals/pdf/many/*.aux
+	-@rm -f $(DIRWWW)/manuals/pdf/many/*.log
+	-@rm -f $(DIRWWW)/manuals/pdf/many/*.out
+	-@rm -rf $(DIRTMP)/sphinx_tmpdir/
+	-@rm -f $(DIRTMP)/sphinx_*.log
+
+design : \
+$(DIRDESIGN)/images/$(PRODUCT)_fulldependencies.png \
+$(DIRDESIGN)/images/$(PRODUCT)_fulldependencies.svg
+
+htmllinkcheckb :
+	@linkchecker.sh -d $(DIRWWW)/manuals/html/
+
+htmllinkchecka :
+	@linkchecker.sh -u $(URLPUBLISH)
+
+spellcheck :
+	@++aspell --mode=sgml --master=francais -c \
+	$(DIRSRC)/$(PRODUCT).xml
+
+all : \
+SPECIAL_RST \
+man_troff \
+man_html \
+man_pdf
+
+man_troff : \
+$(LIST_SRCSH_TROFF) 
+
+man_html : \
+man_html_many \
+man_html_sphinx
+
+man_html_many : \
+$(DIRWWW)/manuals/html/many/index.html \
+$(LIST_SRCSH_HTML) 
+
+man_html_sphinx : \
+$(DIRADM)/sphinx/conf.py \
+$(DIRTMP)/sphinx_tmpdir/index.rst \
+$(LIST_SRCSH_RST) 
+	@cp $(LIST_SRCSH_RST) $(DIRTMP)/sphinx_tmpdir/
+	sphinx-build -b html -c $(DIRADM)/sphinx \
+	    -d $(DIRTMP)/sphinx_tmpdir/doctrees \
+	    -w $(DIRTMP)/sphinx_html.log \
+	    $(DIRTMP)/sphinx_tmpdir/ \
+	    $(DIRWWW)/manuals/html/sphinx/
+
+man_pdf : \
+man_pdf_many \
+man_pdf_sphinx
+
+man_pdf_many : \
+$(LIST_SRCSH_PHP) 
+
+man_pdf_sphinx : \
+$(DIRADM)/sphinx/conf.py \
+$(DIRTMP)/sphinx_tmpdir/index.rst \
+$(LIST_SRCSH_RST) 
+	@cp $(LIST_SRCSH_RST) $(DIRTMP)/sphinx_tmpdir/
+	@sphinx-build -b latex -c $(DIRADM)/sphinx \
+	    -d $(DIRTMP)/sphinx_tmpdir/doctrees \
+	    -w $(DIRTMP)/sphinx_pdf.log \
+	    $(DIRTMP)/sphinx_tmpdir/ \
+	    $(DIRTMP)/sphinx_tmpdir/latex_output
+	cd $(DIRTMP)/sphinx_tmpdir/latex_output/; make all-pdf
+	cp $(DIRTMP)/sphinx_tmpdir/latex_output/*.pdf \
+	   $(DIRWWW)/manuals/pdf/sphinx/
+
+$(DIRWWW)/manuals/html/many/index.html : \
+$(DIRTMP)/index_many.rst
+	@$(RST2HTML) --input-encoding=ISO-8859-15 --strict \
+	$< $@
+
+$(DIRTMP)/index_many.rst :
+	@echo "$(PRODUCTNAME) manuals" | tr [:print:] = > $@
+	@echo "$(PRODUCTNAME) manuals" >> $@
+	@echo "$(PRODUCTNAME) manuals" | tr [:print:] = >> $@
+	@echo " " >> $@
+	@echo "Shell scripts" >> $@
+	@echo "Shell scripts" | tr [:print:] = >> $@
+	@for file in $(LIST_SRCSH); do echo " ";echo "$$(basename $${file})_"; echo " "; echo ".. _$$(basename $${file}) : $$(basename $${file}).html"; done >> $@
+
+$(DIRTMP)/sphinx_tmpdir/index.rst :
+	@echo ".. _index:" >> $@
+	@echo " " >> $@
+	@echo "$(PRODUCTNAME) manuals" | tr [:print:] = >> $@
+	@echo "$(PRODUCTNAME) manuals" >> $@
+	@echo "$(PRODUCTNAME) manuals" | tr [:print:] = >> $@
+	@echo " " >> $@
+	@echo "Shell scripts" >> $@
+	@echo "Shell scripts" | tr [:print:] = >> $@
+	@echo ".. toctree::" >> $@
+	@echo "   :maxdepth: 1" 1>> $@
+	@echo "   :glob:" 1>> $@
+	@echo " " >> $@
+	@for file in $(LIST_SRCSH); \
+	do \
+	   echo "   $$(basename $${file})"; \
+	done >> $@
+	@echo " " >> $@
+
+$(DIRWWW)/manuals/man/man1/%.1:$(DIRTMP)/%.rst
+	@$(RST2MAN) --input-encoding=ISO-8859-15 --strict \
+	$< $@
+
+$(DIRWWW)/manuals/html/many/%.html:$(DIRTMP)/%.rst
+	@$(RST2HTML) --input-encoding=ISO-8859-15 --strict \
+	$< $@
+
+$(DIRWWW)/manuals/pdf/many/%.pdf : $(DIRTMP)/%.tex
+	@-pdflatex -output-directory $(DIRWWW)/manuals/pdf/many/ $<
+	@-pdflatex -output-directory $(DIRWWW)/manuals/pdf/many/ $<
+
+$(DIRTMP)/%.tex : $(DIRTMP)/%.rst
+	@$(RST2LATEX) $(RST2LATEX_OPTIONS_MANY) --input-encoding=ISO-8859-15 --strict \
+	$< $@
+
+$(DIRTMP)/%.sh.rst : $(DIRSRC)/%.sh 
+	@$(DIRADM)/extract_rst.sh -i $< -l sh -o $@
+
+SPECIAL_RST : $(DIRTMP)/makenemo.rst $(DIRTMP)/maketools.rst
+
+$(DIRTMP)/makenemo.rst : $(DIRSRC)/../../CONFIG/makenemo
+	@$(DIRADM)/extract_rst.sh -i $< -l sh -o $@
+$(DIRTMP)/maketools.rst : $(DIRSRC)/../maketools
+	@$(DIRADM)/extract_rst.sh -i $< -l sh -o $@
+
+
+$(DIRDESIGN)/images/%.png : $(DIRDESIGN)/images/%.svg
+	@convert $< $@
+
+$(DIRDESIGN)/images/%.svg : $(DIRDESIGN)/%.dot
+	@dot -Tsvg -o $@ $<
+
+$(DIRDESIGN)/$(PRODUCT)_fulldependencies.dot : \
+./makefile
+	@makeppgraph --graphviz --output=$@
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/sphinx/conf.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/sphinx/conf.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/DOC_SCRIPTS/sphinx/conf.py	(revision 8732)
@@ -0,0 +1,202 @@
+# -*- coding: utf-8 -*-
+#
+# superbib documentation build configuration file, created by
+# sphinx-quickstart on Wed Mar 10 16:19:33 2010.
+#
+# This file is execfile()d with the current directory set to its containing dir.
+#
+# Note that not all possible configuration values are present in this
+# autogenerated file.
+#
+# All configuration values have a default; values that are commented out
+# serve to show the default.
+
+import sys, os
+
+# If extensions (or modules to document with autodoc) are in another directory,
+# add these directories to sys.path here. If the directory is relative to the
+# documentation root, use os.path.abspath to make it absolute, like shown here.
+#sys.path.append(os.path.abspath('/usr/home/fplod/src/superbib_ws/adm/sphinx_tmpdir/source/'))
+
+
+# -- General configuration -----------------------------------------------------
+
+# Add any Sphinx extension module names here, as strings. They can be extensions
+# coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
+extensions = ['sphinx.ext.todo']
+todo_include_todos = True
+
+
+# Add any paths that contain templates here, relative to this directory.
+templates_path = ['_templates']
+
+# The suffix of source filenames.
+source_suffix = '.rst'
+
+# The encoding of source files.
+source_encoding = 'iso-8859-15'
+
+# The master toctree document.
+master_doc = 'index'
+
+# General information about the project.
+project = u'NEMO FCM'
+copyright = u'2010, CNRS'
+
+# The version info for the project you're documenting, acts as replacement for
+# |version| and |release|, also used in various other places throughout the
+# built documents.
+#
+# The short X.Y version.
+version = '1.0.1'
+# The full version, including alpha/beta/rc tags.
+release = '1.0.1'
+
+# The language for content autogenerated by Sphinx. Refer to documentation
+# for a list of supported languages.
+language = 'en'
+
+# There are two options for replacing |today|: either, you set today to some
+# non-false value, then it is used:
+#today = ''
+# Else, today_fmt is used as the format for a strftime call.
+#today_fmt = '%B %d, %Y'
+today_fmt = '%Y%m%d'
+
+# List of documents that shouldn't be included in the build.
+#unused_docs = []
+
+# List of directories, relative to source directory, that shouldn't be searched
+# for source files.
+exclude_trees = []
+
+exclude_dirnames = ['.svn']
+
+# The reST default role (used for this markup: `text`) to use for all documents.
+#default_role = None
+
+# If true, '()' will be appended to :func: etc. cross-reference text.
+#add_function_parentheses = True
+
+# If true, the current module name will be prepended to all description
+# unit titles (such as .. function::).
+#add_module_names = True
+
+# If true, sectionauthor and moduleauthor directives will be shown in the
+# output. They are ignored by default.
+#show_authors = False
+
+# The name of the Pygments (syntax highlighting) style to use.
+pygments_style = 'sphinx'
+
+# A list of ignored prefixes for module index sorting.
+modindex_common_prefix = []
+
+
+# -- Options for HTML output ---------------------------------------------------
+
+# The theme to use for HTML and HTML Help pages.  Major themes that come with
+# Sphinx are currently 'default' and 'sphinxdoc'.
+html_theme = 'default'
+
+# Theme options are theme-specific and customize the look and feel of a theme
+# further.  For a list of options available for each theme, see the
+# documentation.
+#html_theme_options = {}
+
+# Add any paths that contain custom themes here, relative to this directory.
+#html_theme_path = []
+
+# The name for this set of Sphinx documents.  If None, it defaults to
+# "<project> v<release> documentation".
+#html_title = None
+
+# A shorter title for the navigation bar.  Default is the same as html_title.
+#html_short_title = None
+
+# The name of an image file (relative to this directory) to place at the top
+# of the sidebar.
+#html_logo = None
+
+# The name of an image file (within the static path) to use as favicon of the
+# docs.  This file should be a Windows icon file (.ico) being 16x16 or 32x32
+# pixels large.
+#html_favicon = None
+
+# Add any paths that contain custom static files (such as style sheets) here,
+# relative to this directory. They are copied after the builtin static files,
+# so a file named "default.css" will overwrite the builtin "default.css".
+html_static_path = ['_static']
+
+# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,
+# using the given strftime format.
+#html_last_updated_fmt = '%b %d, %Y'
+
+# If true, SmartyPants will be used to convert quotes and dashes to
+# typographically correct entities.
+#html_use_smartypants = True
+
+# Custom sidebar templates, maps document names to template names.
+#html_sidebars = {}
+
+# Additional templates that should be rendered to pages, maps page names to
+# template names.
+#html_additional_pages = {}
+
+# If false, no module index is generated.
+html_use_modindex = True
+
+# If false, no index is generated.
+html_use_index = True
+
+# If true, the index is split into individual pages for each letter.
+#html_split_index = False
+
+# If true, links to the reST sources are added to the pages.
+html_show_sourcelink = False
+
+# If true, an OpenSearch description file will be output, and all pages will
+# contain a <link> tag referring to it.  The value of this option must be the
+# base URL from which the finished HTML is served.
+#html_use_opensearch = ''
+
+# If nonempty, this is the file name suffix for HTML files (e.g. ".xhtml").
+#html_file_suffix = ''
+
+# Output file base name for HTML help builder.
+htmlhelp_basename = 'SETTE validation tool'
+
+
+# -- Options for LaTeX output --------------------------------------------------
+
+# The paper size ('letter' or 'a4').
+#latex_paper_size = 'letter'
+
+# The font size ('10pt', '11pt' or '12pt').
+#latex_font_size = '10pt'
+
+# Grouping the document tree into LaTeX files. List of tuples
+# (source start file, target name, title, author, documentclass [howto/manual]).
+latex_documents = [
+  ('index', 'sette_tools.tex', u'NEMO validation tools Documentation',
+   u'C. Levy', 'manual'),
+]
+
+# The name of an image file (relative to this directory) to place at the top of
+# the title page.
+#latex_logo = None
+
+# For "manual" documents, if this is true, then toplevel headings are parts,
+# not chapters.
+#latex_use_parts = False
+
+# Additional stuff for the LaTeX preamble.
+#latex_preamble = ''
+
+# Documents to append as an appendix to all manuals.
+#latex_appendices = []
+
+# If false, no module index is generated.
+#latex_use_modindex = True
+
+keep_warnings = 'True'
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/ADM/README	(revision 8732)
@@ -0,0 +1,9 @@
+Generates automatic documentation: in ADM/DOC_SCRIPTS 
+Pre requisite: to have sphinx installed
+Input file is in ADM/DOC_SCRIPTS/sphinx/conf.py to be checked/modifies by user
+
+Once the input file is set up, run:
+cd ADM/DOC_SCRIPTS
+gmake -f makefile_compile before
+gmake -f makefile_compile man_pdf
+to generate documentation in pdf in ADM/DOC_SCRIPTS/doc/manuals/pdf/sphinx
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/LaTeX2HTML.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/LaTeX2HTML.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/LaTeX2HTML.sh	(revision 8732)
@@ -0,0 +1,11 @@
+#!/bin/bash
+
+sed -i -e 's#\\documentclass#%\\documentclass#' -e '/{document}/ s/^/%/' TexFiles/Chapters/*.tex
+sed -i    '30,${s#\\subfile{#\\include{#g}'                                    NEMO_book.tex
+latex NEMO_book && makeindex NEMO_book && bibtex NEMO_book
+mkdir -p html
+latex2html -local_icons -no_footnode -split 4 -link 2 -dir html $*
+sed -i -e 's#%\\documentclass#\\documentclass#' -e '/{document}/ s/^%//' TexFiles/Chapters/*.tex
+sed -i    '30,${s#\\include{#\\subfile{#g}'                                    NEMO_book.tex
+
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/NEMO_book.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/NEMO_book.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/NEMO_book.tex	(revision 8732)
@@ -0,0 +1,112 @@
+%description: Book template
+
+% template of document for LaTeX
+% (C) Xavier Perseguers 2002 - xavier.perseguers@epfl.ch
+
+% ================================================================
+% PREAMBLE
+% ================================================================
+
+\include{TexFiles/Preamble}
+
+% ================================================================
+% TOP MATTER
+% ================================================================
+
+\include{TexFiles/Top_Matter}
+
+% ================================================================
+% DOCUMENT
+% ================================================================
+
+\begin{document}
+
+\maketitle						% generate the title
+
+\frontmatter
+
+\tableofcontents					% generate a table of contents
+%\listoffigures					% generate a list  of figures
+%\listoftables					        % generate a list of tables
+
+\mainmatter
+
+% ================================================================
+% Abstract - Foreword
+% ================================================================
+
+\subfile{TexFiles/Chapters/Abstracts_Foreword}
+
+% ================================================================
+% INTRODUCTION
+% ================================================================
+
+\subfile{TexFiles/Chapters/Introduction}
+
+% ================================================================
+% CHAPTERS
+% ================================================================
+
+\subfile{TexFiles/Chapters/Chap_Model_Basics}
+
+\subfile{TexFiles/Chapters/Chap_STP}			% Time discretisation (time stepping strategy)
+
+\subfile{TexFiles/Chapters/Chap_DOM}			% Space discretisation
+
+\subfile{TexFiles/Chapters/Chap_TRA}			% Tracer advection/diffusion equation
+
+\subfile{TexFiles/Chapters/Chap_DYN}			% Dynamics : momentum equation
+
+\subfile{TexFiles/Chapters/Chap_SBC}			% Surface Boundary Conditions
+
+\subfile{TexFiles/Chapters/Chap_LBC}			% Lateral Boundary Conditions
+
+\subfile{TexFiles/Chapters/Chap_LDF}			% Lateral diffusion
+
+\subfile{TexFiles/Chapters/Chap_ZDF}			% Vertical diffusion
+
+\subfile{TexFiles/Chapters/Chap_DIA}			% Outputs and Diagnostics
+
+\subfile{TexFiles/Chapters/Chap_OBS}                    % Observation operator
+
+\subfile{TexFiles/Chapters/Chap_ASM}                    % Assimilation increments
+
+\subfile{TexFiles/Chapters/Chap_STO}                    % Stochastic param.
+
+\subfile{TexFiles/Chapters/Chap_MISC}			% Miscellaneous topics
+
+\subfile{TexFiles/Chapters/Chap_CFG}			% Predefined configurations
+
+% ================================================================
+% APPENDIX
+% ================================================================
+
+\appendix
+
+%\subfile{TexFiles/Chapters/Chap_Conservation}
+\subfile{TexFiles/Chapters/Annex_A}			% generalised vertical coordinate
+\subfile{TexFiles/Chapters/Annex_B}			% diffusive operator
+\subfile{TexFiles/Chapters/Annex_C}			% Discrete invariants of the eqs.
+\subfile{TexFiles/Chapters/Annex_ISO}	                  % Isoneutral diffusion using triads
+\subfile{TexFiles/Chapters/Annex_D}			% Coding rules
+%\subfile{TexFiles/Chapters/Annex_E}	                  % Notes on some on going staff (no included in the DOC)
+%\subfile{TexFiles/Chapters/Annex_Fox-Kemper}   % Notes on Fox-Kemper (no included in the DOC)
+%\subfile{TexFiles/Chapters/Annex_EVP}        	% Notes on EVP (no included in the DOC)
+
+% ================================================================
+% INDEX
+% ================================================================
+
+\addcontentsline{toc}{chapter}{Index}
+\printindex
+
+% ================================================================
+% BIBLIOGRAPHY
+% ================================================================
+
+%%\bibliographystyle{plainat}
+\bibliographystyle{TexFiles/Styles/ametsoc}		% AMS biblio style (JPO)
+\bibliography{TexFiles/Bibliography/Biblio}
+
+% ================================================================
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/NEMO_coding.conv.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/NEMO_coding.conv.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/NEMO_coding.conv.tex	(revision 8732)
@@ -0,0 +1,599 @@
+\documentclass[a4paper]{article}
+\usepackage{type1cm} 
+\usepackage{times} 
+\usepackage{color} 
+\usepackage{rotating} 
+\usepackage{color} 
+\usepackage{framed} 
+\usepackage{makeidx} 
+\graphicspath{{Figures/}}
+
+%%%%%%%
+\pagestyle{empty} 
+\setlength{\leftmargin}{1 cm} 
+\setlength{\rightmargin}{1 cm} 
+\setlength{\oddsidemargin}{0 cm} 
+\setlength{\evensidemargin}{0 cm} 
+\setlength{\topmargin}{-1cm} 
+\setlength{\textwidth}{16 cm} 
+\setlength{\textheight}{25cm} 
+
+%%%%%%%%%essai plus jolis from NEMO book
+\usepackage{fancyhdr}
+
+\pagestyle{fancy}
+%\usepackage[colorlinks=true]{hyperref} %%create link
+ 
+\makeindex %% run first makeindex NEMO_coding.conv.idx NEMO_coding.conv.ist
+		
+\begin{document}
+
+
+\title{ 
+\includegraphics[width=0.3\textwidth]{NEMO_logo_Black} \\
+\vspace{1.0cm}
+\rule{345pt}{1.5pt} \\
+\vspace{0.45cm}
+ {\Huge NEMO coding conventions} 
+\rule{345pt}{1.5pt} \\ 
+{\small  -- version 3 --}   }
+%\title{NEMO coding conventions}
+\author{NEMO System Team }
+\date{March 2011}
+
+
+\maketitle
+
+\newpage
+
+\tableofcontents   
+         
+\newpage
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Introduction}
+This document describes conventions\index{conventions} used in NEMO coding and suggested for its development. The objectives are to offer a guide to all readers of the NEMO code, and to facilitate the work of all the developers, including the validation of their developments, and eventually the implementation of these developments within the NEMO platform. \\
+A first approach of these rules can be found in the code in $NEMO/OPA\_SRC/module\_example$ where all the basics coding conventions are illustrated. More details can be found below.\\
+This work is based on the coding conventions in use for the Community Climate System Model, \footnote { http://www.cesm.ucar.edu/working\_groups/Software/dev\_guide/dev\_guide/node7.html }
+ the previous version of this document (``FORTRAN coding standard in the OPA System'') and the expertise of the NEMO System Team which can be contacted for further information ($nemo\_st@locean-ipsl.upmc.fr$)
+After a general overview below, this document will describe :
+\begin{itemize} 
+\item The style rules, i.e. the syntax, appearance and naming conventions chosen to improve readability of the code;
+\item The content rules, i.e. the conventions to improve the reliability of the different parts of the code;
+\item The package rules to go a step further by improving the reliability of the whole and interfaces between routines and modules.
+\end{itemize}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Overview and general conventions}
+NEMO has several different components: ocean dynamics ($OPA\_SRC$), sea-ice ($LIM\_SRC$), ocean biogeochemistry\- ($TOP\_SRC$), linear-tangent and adjoint of the dynamics ($TAM$)É each of them corresponding to a directory.
+In each directory, one will find some FORTRAN files and/or subdirectories, one per functionality of the code: $BDY$ (boundaries), $DIA$ (diagnostics), $DOM$ (domain), $DYN$ (dynamics), $LDF$ (lateral diffusion), etc...\\
+All name are chosen to be as self-explanatory as possible, in English, all prefixes are 3 digits.\\
+English is used for all variables names, comments, and documentation. \\
+Physical units are MKS. The only exception to this is the temperature, which is expressed in degrees Celsius, except in bulk formulae and part of LIM sea-ice model where it is in Kelvin. See $DOM/phycst.F90$ files for conversions.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Architecture}
+Within each directory, organisation of files is driven by ÒorthogonalityÓ\index{orthogonality}, i.e. one functionality of the code is intended to be in one and only one directory, and one module and all its related routines are in one file.
+The functional modules\index{module} are:
+\begin{itemize} 
+\item SBC		surface module 
+\item IOM		management of the I/O 
+\item NST		interface to AGRIF (nesting model) for dynamics and biogeochemistry 
+\item OBC, BDY	management of structured and unstructured open boundaries 
+\item C1D		1D (vertical) configuration for dynamics, sea-ice and biogeochemistry 
+\item OFF		off-line module: passive tracer or biogeochemistry alone 
+\item CFG 		tutorial and reference configurations 
+\item DOC		documentation 
+\end{itemize}
+
+For example, the file $domain.F90$ contains the module $domain$ and all the subroutines related to this module ($ dom\_init, dom\_nam, dom\_ctl$).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Style rules}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Argument list format}
+Routine argument lists will contain a maximum 5 variables\index{variable} per line, whilst continuation lines can be used. 
+This applies both to the calling routine and the dummy argument list in the routine being called. The purpose is to simplify matching up the arguments between caller and callee. 
+
+\begin{verbatim}
+SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )
+
+      CALL tra_adv_eiv( kt, zun, zvn, zwn )
+\end{verbatim}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Array syntax}
+Except for long loops (see below), array notation should be used if possible. To improve readability the array shape must be shown in brackets, e.g.: 
+\begin{verbatim}
+onedarraya(:) = onedarrayb(:) + onedarrayc(:) 
+twodarray (:,:) = scalar * anothertwodarray(:,:) 
+\end{verbatim}
+When accessing sections of arrays, for example in finite difference equations, do so by using the triplet notation on the full array, e.g.:
+\begin{verbatim}
+twodarray(:,2:len2) = scalar                      & 
+   &                * ( twodarray2(:,1:len2-1 )   & 
+   &                -   twodarray2(:,2:len2 ) ) 
+\end{verbatim}   
+For long, complicated loops, explicitly indexed loops should be preferred. In general when using this syntax, the order of the loops indices should reflect the following scheme (for best usage of data locality):
+\begin{verbatim}
+DO jk = 1, jpk 
+   DO jj = 1, jpj 
+      DO ji = 1, jpi 
+         array(ji,jj,jk) = ... 
+      END DO 
+   END DO 
+END DO 
+\end{verbatim}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Case}
+All FORTRAN keywords are in capital : \begin {verbatim} DIMENSION, WRITE, DO, END DO, NAMELIST \end{verbatim} 
+All other parts of the NEMO code will be written in lower case.	
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Comments}
+Comments in the code are useful when reading the code and changing or developing it. \\
+The full documentation and detailed explanations are to be added in the reference manual (TeX files, aside from the code itself). \\
+In the code, the comments should explain variable content and describe each computational step.\\
+Comments in the header start with ``!!''. For more details on the content of the headers, see ÒContent rules/HeadersÓ in this document.\\
+Comments in the code start with ``!''.\\
+All comments are indented (3, 6, or 9 É blank spaces).\\
+Short comments may be included on the same line as executable code, and an additional line can be used with proper alignment. For example: 
+\begin{verbatim}
+      zx = zx *zzy   ! Describe what is going on and if it is 
+      !              ! too long use another Ô!Õ for proper 
+      !              ! alignment with automatic indentation 
+\end{verbatim}      
+More in-depth comments should be written in the form: 
+\begin{verbatim}
+!   Check of some namelist values
+\end{verbatim}         
+or 
+\begin{verbatim}    
+!
+!         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!         !  Bottom boundary condition on tke
+!         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!
+\end{verbatim}    
+Key features of this style are 1) it starts with a "!" in the column required for proper indentation, 2) the text is offset above and below by a blank line or a content line built for underlying. 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Continuation lines}
+Continuation lines can be used with precise alignment for readability. For example: 
+\begin{verbatim}   
+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) )
+\end{verbatim}    
+Code lines, which are continuation lines of assignment statements, must begin to the right of the column of the assignment operator. Due to the possibility of automatic indentation in some editor (emacs for example), use a ``\&'' as first character of the continuing lines to maintain the alignment. 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Declaration of arguments and local variables}
+
+In a routine, input arguments and local variables are declared 1 per line, with a comment field on the same line as the declaration. Multiple comment lines describing a single variable are acceptable if needed. For example: 
+\begin{verbatim}  
+INTEGER             ::   kstp   ! ocean time-step index
+\end{verbatim}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{F90 Standard}
+NEMO software adheres to the FORTRAN 95 language standard and does not rely on any specific language or vendor extensions.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Free-Form Source}
+Free-form source will be used. The F90/95 standard allows lines of up to 132 characters, but a self-imposed limit of 80 should enhance readability, or print source files with two columns per page. Multi-line comments that extend to column 100 are unacceptable.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Indentation}
+Code as well as comment lines within loops, if-blocks, continuation lines, MODULE or SUBROUTINE statements will be indented 3 characters for readability. (except for CONTAINS that remains at first column) 
+\begin{verbatim}  
+MODULE mod1 
+   REAL(wp) xx 
+CONTAINS 
+   SUBROUTINE sub76( px, py, pz, pw, pa,   & 
+      &              pb, pc, pd, pe      ) 
+      <instruction> 
+   END SUBROUTINE sub76 
+END MODULE mod1 
+\end{verbatim}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Loops}
+Loops, if explicit, should be structured with the do-end do construct as opposed to numbered loops. Nevertheless non-numeric labels can be used for a big iterative loop of a recursive algorithm. In the case of a long loop, a self-descriptive label can be used (i.e. not just a number).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Naming Conventions: files}
+A file containing a module will have the same name as the module it contains (because dependency rules used by "make" programs are based on file names).
+\footnote{For example, if routine A "USE"s module B, then "make" must be told of the dependency relation which requires B to be compiled before A. If one can assume that module B resides in file B.o, building a tool to generate this dependency rule (e.g. A.o: B.o) is quite simple. Put another way, it is difficult (to say nothing of CPU-intensive) to search an entire source tree to find the file in which module B resides for each routine or module which "USE"s B.}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Naming Conventions: modules}
+Use a meaningful English name and the ``3 letters'' naming convention: first 3 letters for the code section, and last 3 to describe the module. For example, zdftke, where ``zdf'' stands for vertical diffusion, and ``tke'' for turbulent kinetic energy. 
+\\
+Note that by implication multiple modules are not allowed in a single file. 
+The use of common blocks is deprecated in Fortran 90 and their use in NEMO is strongly discouraged. Modules are a better way to declare static data. Among the advantages of modules is the ability to freely mix data of various types, and to limit access to contained variables through the use of the ONLY and PRIVATE attributes. 
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Naming Conventions: variables}
+All variable should be named as explicitly as possible in English. The naming convention concerns prefix letters of these name, in  order to identify the variable type and status.\\
+Never use a FORTRAN keyword as a routine or variable name. \\
+The table below lists the starting letter(s) to be used for variable naming, depending on their type and status:
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]
+\begin{center}
+\begin{tabular}{|p{50pt}|p{50pt}|p{50pt}|p{50pt}|p{50pt}|p{50pt}|p{50pt}|}
+\hline  Type \par / Status &   integer&   real&   logical &   character&   double \par precision&   complex \\  
+\hline
+public  \par or  \par module variable& 
+\textbf{m n} \par \textit{but not } \par \textbf{nn\_}& 
+\textbf{a b e f g h o} \textbf{q} \textit{to} \textbf{x} \par but not \par \textbf{fs rn\_}& 
+\textbf{l} \par \textit{but not} \par \textbf{lp ld ll ln\_}& 
+\textbf{c} \par \textit{but not} \par \textbf{cp cd cl cn\_}& 
+\textbf{d} \par \textit{but not} \par \textbf{dp dd dl dn\_}& 
+\textbf{y} \par \textit{but not} \par \textbf{yp yd yl} \\
+\hline
+dummy \par argument& 
+\textbf{k} \par \textit{but not} \par \textbf{kf}& 
+\textbf{p} \par \textit{but not}  \par \textbf{pp pf}& 
+\textbf{ld}& 
+\textbf{cd}& 
+\textbf{dd}& 
+\textbf{yd} \\
+\hline
+local \par variable& 
+\textbf{i}& 
+\textbf{z}& 
+\textbf{ll}& 
+\textbf{cl}& 
+\textbf{cd}& 
+\textbf{yl} \\
+\hline
+loop \par control& 
+\textbf{j} \par \textit{but not } \par \textbf{jp}& 
+& 
+& 
+& 
+& 
+ \\
+\hline
+parameter& 
+\textbf{jp}& 
+\textbf{pp}& 
+\textbf{lp}& 
+\textbf{cp}& 
+\textbf{dp}& 
+\textbf{yp} \\
+\hline
+
+namelist&
+\textbf{nn\_}& 
+\textbf{rn\_}& 
+\textbf{ln\_}& 
+\textbf{cn\_}& 
+\textbf{dn\_}& 
+\\
+\hline
+CPP \par macro& 
+\textbf{kf}& 
+\textbf{sf} \par & 
+& 
+& 
+& 
+ \\
+\hline
+\end{tabular}
+\label{tab1}
+\end{center}
+\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Operators}
+Use of the operators $<, >, <=, >=, ==, /= $ is strongly recommended instead of their deprecated counterparts, $lt., .gt., .le., .ge., .eq., and .ne. $ The motivation is readability. In general use the notation: \\
+$<Blank><Operator><Blank>$
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Pre processor}
+Where the use of a language pre-processor is required, it will be the C pre-processor (cpp).\\
+The cpp key is the main feature used, allowing to ignore some useless parts of the code at compilation step. \\
+The advantage is to reduce the memory use; the drawback is that compilation of this part of the code isn't checked. \\
+The cpp key feature should only be used for a few limited options, if it reduces the memory usage. In all cases, a logical variable and a FORTRAN $IF$ should be preferred.
+When using a cpp key $key\_optionname$, a corresponding logical variable $lk\_optionname$ should be declared to allow FORTRAN $IF$ tests in the code and  a FORTRAN module with the same name (i.e. $optionname.F90$) should
+ be defined. This module is the only place where a ``\#if defined'' command appears, selecting either the whole FORTRAN code or a dummy module. For example, the TKE vertical physics, the module name is $zdftke.F90$, the CPP key is $key\_zdftke$ and the associated logical is $lk\_zdftke$. 
+
+The following syntax:
+\begin{verbatim} 
+#if defined key_optionname 
+!! Part of code conditionally compiled if cpp key key_optionname is active
+#endif
+\end{verbatim} 
+Is to be used rather than the \#ifdef abbreviate form since it may have conflicts with some Unix scripts.
+
+Tests on cpp keys included in NEMO at compilation step:
+\begin{itemize}
+\item The CPP keys used are compared to the previous list of cpp keys (the compilation will stop if trying to specify a Ònon-existing keyÓ)
+\item If a change occurs in the CPP keys used for a given experiment, the whole compilation phase is done again.
+\end{itemize}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Content rules}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Configurations}
+The configuration defines the domain and the grid on which NEMO is running. It may be useful to associate a cpp key and some variables to a given configuration, although the part of the code changed under each of those keys should be minimized. As an example, the "ORCA2" configuration (global ocean, 2 degrees grid size) is associated with the cpp key $key\_orca2$ for which 
+\begin{verbatim} 
+cp_cfg = "orca"
+jp_cfg = 2
+\end{verbatim} 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Constants}
+Physical constants (e.g. pi, gas constants) must never be hardwired into the executable portion of a code. Instead, a mnemonically named variable or parameter should be set to the appropriate value, in the setup routine for the package\index{package}. We realize than many parameterizations rely on empirically derived constants or fudge factors, which are not easy to name. In these cases it is not forbidden to leave such factors coded as "magic numbers" buried in executable code, but comments should be included referring to the source of the empirical formula. Hard-coded numbers should never be passed through argument lists. 
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Declaration for variables and constants}
+
+\subsubsection{Rules :}
+Variables used as constants should be declared with attribute PARAMETER and used always without copying to local variables, inorder to prevent from using different values for the same constant or changing it accidentally. 
+\begin{itemize}
+\item Usage of the DIMENSION statement or attribute is required in declaration statements
+\item The ``::'' notation is quite useful to show that this program unit declaration part is  written in standard FORTRAN syntax, even if there are no attributes to clarify the  declaration section. Always use the notation $<$blank$>$::$<$three blanks$>$ to improve readability. 
+\item Declare the length of a character variable using the CHARACTER (len=xxx) syntax
+\footnote { The len specifier is important because it is possible to have several kinds for characters  (e.g. Unicode using two bytes per character, or there might be a different kind for Japanese e.g. NEC). }
+
+\item For all global data (in contrast to module data, that is all data that can be access by other module) must be accompanied with a comment field  on the same line. 
+\footnote {This allows a easy research of where and how a variable is declared using the unix command: ``grep var *90 |grep !:''. }
+\\
+For example:
+\begin{verbatim}
+REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ua  &  !: i-horizontal velocity (m/s) 
+\end{verbatim}
+\end{itemize}
+
+\subsubsection{Implicit None:}
+ All subroutines and functions will include an IMPLICIT NONE statement. 
+Thus all variables must be explicitly typed. It also allows the compiler to detect typographical errors in variable names. 
+For modules, one IMPLICIT NONE statement in the modules definition section is needed. This also removes the need to have IMPLICIT NONE statements in any routines that are CONTAIN'd in the module.
+Improper data initialisation is another common source of errors. 
+\footnote{A variable could contain an initial value you did not expect. This can happen for several reasons, e.g. the variable has never been assigned a value, its value is outdated, memory has been allocated for a pointer but you have forgotten to initialise the variable pointed to.} 
+To avoid problems, initialise variables as close as possible to where they are first used. 
+
+\subsubsection{Attributes:}
+$PRIVATE / PUBLIC$ : 
+All resources of a module are $PUBLIC$ by default.
+A reason to store multiple routines and their data in a single module is that the scope of the data defined in the module can be limited to the routines which are in the same module. This is accomplished with the $PRIVATE$ attribute.\\
+$INTENT$ :
+All dummy arguments of a routine must include the $INTENT$ clause in their declaration in order to improve control of variables in routine calls. 
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Headers}
+Prologues are not used in NEMO for now, although it may become an interesting tool in combination with ProTeX auto documentation script in the future. 
+Rules to code the headers and layout of a module or a routine are illustrated in the example module available with the code : {\it NEMO/OPA\_SRC/module\_example}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Interface blocks}
+Explicit interface blocks are required between routines if optional or keyword arguments are to be used. They also allow the compiler to check that the type, shape and number of arguments specified in the CALL are the same as those specified in the subprogram itself. FORTRAN 95 compilers can automatically provide explicit interface blocks  for routines contained in a module. 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{I/O Error Conditions}
+I/O statements which need to check an error condition will use the $iostat=<integer variable>$ construct instead of the outmoded end= and err=. \\
+Note that a 0 value means success, a positive value means an error has occurred, and a negative value means the end of record or end of file was encountered. 
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{PRINT - ASCII output files}
+Output listing and errors are directed to $numout$ logical unit =6 and produces a file called $ocean.output$  (use ln\_prt to have one output per process in  MPP). Logical $lwp$ variable allows for less verbose outputs.
+To output an error from a routine, one can use the following template:
+\begin{verbatim}
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found'
+      ENDIF
+\end{verbatim}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Precision}
+Parameterizations should not rely on vendor-supplied flags to supply a default floating point precision or integer size. The F95$ KIND$ feature should be used instead. In order to improve portability between 32 and 64 bit platforms, it is necessary to make use of kinds by using a specific module ($OPA\_SRC/par\_kind.F90$)  declaring the "kind definitions" to obtain the required numerical precision and range as well as the size of INTEGER. It should be noted that numerical constants need to have a suffix of \_$kindvalue$ to have the according size. \\
+Thus $wp$ being the "working precision" as declared in $OPA\_SRC/par\_kind.F90$, declaring real array $zpc$ will take the form:
+\begin{verbatim}
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zpc      ! power consumption
+\end{verbatim}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Structures}
+The TYPE structure allowing to declare some variables is more often used in NEMO, especially in the modules dealing with reading fields, or interfaces.For example
+\begin{verbatim}
+ ! 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
+\end{verbatim}
+ 
+ Missing rule on structure name??
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Packages coding rules}
+ 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Bounds checking}
+NEMO is able to run when an array bounds checking option is enabled (provided the cpp key $key\_vectopt\_loop$ is not defined). \\
+Thus, constructs of the  following form are disallowed: 
+\begin{verbatim}
+REAL(wp) :: arr(1) 
+\end{verbatim}
+where "arr" is an input argument into which the user wishes to index beyond 1. Use of the (*) construct in array dimensioning  is forbidden also because it effectively disables array bounds checking.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Communication}
+A package should refer only to its own modules and subprograms and to those intrinsic functions included in the Fortran standard.\\
+All communication with the package will be through the argument list or namelist input.
+\footnote { The point behind this rule is that packages should not have to know details of the surrounding model data structures, or the names of variables outside of the package. A notable exception to this rule is model resolution parameters. The reason for the exception is to allow compile-time array sizing inside the package. This is often important for efficiency.}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Error conditions}
+When an error condition occurs inside a package, a message describing what went wrong will be printed (see PRINT - ASCII output files). The name of the routine in which the error occurred must be included. It is acceptable to terminate execution within a package, but the developer may instead wish to return an error flag through the argument list, see $stpctl.F90$.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Memory management}
+
+The main action is to identify and declare which arrays are PUBLIC and
+which are PRIVATE.\\ As of version 3.3.1 of NEMO, the use of static
+arrays (size fixed at compile time) has been deprecated.  All module
+arrays are now declared ALLOCATABLE and allocated in either the
+$<$module\_name$>$\_alloc() or $<$module\_name$>$\_init()
+routines. The success or otherwise of each ALLOCATE must be checked
+using the $Stat=<integer\ variable>$ optional argument.\\
+
+In addition to arrays contained within modules, many routines in NEMO
+require local, ``workspace'' arrays to hold the intermediate results
+of calculations. In previous versions of NEMO, these arrays were
+declared in such a way as to be automatically allocated on the stack
+when the routine was called.  An example of an automatic array is:
+\begin{verbatim}
+SUBROUTINE sub(n) 
+   REAL :: a(n) 
+   ... 
+END SUBROUTINE sub 
+\end{verbatim}
+The downside of this approach is that the program will crash if it
+runs out of stack space and the reason for the crash might not be
+obvious to the user.
+
+Therefore, as of version 3.3.1, the use of automatic arrays is
+deprecated. Instead, a new module, ``wrk\_nemo,'' has been introduced
+which contains 1-,2-,3- and 4-dimensional workspace arrays for use in
+subroutines. These workspace arrays should be used in preference to
+declaring new, local (allocatable) arrays whenever possible. The only
+exceptions to this are when workspace arrays with lower bounds other
+than 1 and/or with extent(s) greater than those in the {\it wrk\_nemo}
+module are required.\\
+
+The 2D, 3D and 4D workspace arrays in {\it wrk\_nemo} have extents
+$jpi$, $jpj$, $jpk$ and $jpts$ ($x$, $y$, $z$ and tracers) in the first,
+second, third and fourth dimensions, respectively. The 1D arrays are
+allocated with extent MAX($jpi\times jpj, jpk\times jpj, jpi\times
+jpk$).\\
+
+The REAL (KIND=$wp$) workspace arrays in {\it wrk\_nemo} are named
+e.g. $wrk\_1d\_1$, $wrk\_4d\_2$ etc. and should be accessed by USE'ing
+the {\it wrk\_nemo} module. Since these arrays are available to any
+routine, some care must be taken that a given workspace array is not
+already being used somewhere up the call stack. To help with this,
+{\it wrk\_nemo} also contains some utility routines; {\it
+  wrk\_in\_use()} and {\it wrk\_not\_released()}. The former first
+checks that the requested arrays are not already in use and then sets
+internal flags to show that they are now in use. The {\it
+  wrk\_not\_released()} routine un-sets those internal flags. A
+subroutine using this functionality for two, 3D workspace arrays named
+$zwrk1$ and $zwrk2$ will look something like:
+\begin{verbatim}
+SUBROUTINE sub()
+   USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
+   USE wrk_nemo, ONLY: zwrk1 => wrk_3d_5, zwrk2 => wrk_3d_6
+   !
+   IF(wrk_in_use(3, 5,6)THEN
+      CALL ctl_stop('sub: requested workspace arrays unavailable.')
+      RETURN
+   END IF
+   ... 
+   ...
+   IF(wrk_not_released(3, 5,6)THEN
+      CALL ctl_stop('sub: failed to release workspace arrays.')
+   END IF
+   !
+END SUBROUTINE sub 
+\end{verbatim}
+The first argument to each of the utility routines is the
+dimensionality of the required workspace (1--4). Following this there
+must be one or more integers identifying which workspaces are to be
+used/released.
+Note that, in the interests of keeping the code as simple as possible,
+there is no use of POINTERs etc. in the {\it wrk\_nemo}
+module. Therefore it is the responsibility of the developer to ensure
+that the arguments to {\it wrk\_in\_use()} and {\it
+  wrk\_not\_released()} match the workspace arrays actually being used
+by the subroutine.\\
+
+If a workspace array is required that has extent(s) less than those of
+the arrays in the {\it wrk\_nemo} module then the advantages of
+implicit loops and bounds checking may be retained by defining a
+pointer to a sub-array as follows:
+\begin{verbatim}
+SUBROUTINE sub()
+   USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
+   USE wrk_nemo, ONLY: wrk_3d_5
+   !
+   REAL(wp), DIMENSION(:,:,:), POINTER :: zwrk1
+   !
+   IF(wrk_in_use(3, 5)THEN
+      CALL ctl_stop('sub: requested workspace arrays unavailable.')
+      RETURN
+   END IF
+   !
+   zwrk1 => wrk_3d_5(1:10,1:10,1:10)
+   ... 
+END SUBROUTINE sub 
+\end{verbatim}
+Here, instead of ``use associating'' the variable $zwrk1$ with the
+array $wrk\_3d\_5$ (as in the first example), it is explicitly
+declared as a pointer to a 3D array. It is then associated with a
+sub-array of $wrk\_3d\_5$ once the call to {\it wrk\_in\_use()} has
+completed successfully. Note that in F95 (to which NEMO conforms) it
+is not possible for either the upper or lower array bounds of the
+pointer object to differ from those of the target array.\\
+
+In addition to the REAL (KIND=$wp$) workspace arrays, {\it wrk\_nemo}
+also contains 2D integer arrays and 2D REAL arrays with extent ($jpi$,
+$jpk$), {\it i.e.} $xz$. The utility routines for the integer
+workspaces are {\it iwrk\_in\_use()} and {\it iwrk\_not\_released()}
+while those for the $xz$ workspaces are {\it wrk\_in\_use\_xz()}
+and {\it wrk\_not\_released\_xz()}.
+
+Should a call to one of the {\it wrk\_in\_use()} family of utilities
+fail, an error message is printed along with a table showing which of
+the workspace arrays are currently in use. This should enable the
+developer to choose alternatives for use in the subroutine being
+worked on.\\
+
+When compiling NEMO for production runs, the calls to {\it
+  wrk\_in\_use()}/{\it wrk\_not\_released()} can be reduced to stubs
+that just return $.$FALSE$.$ by setting the cpp key
+{\it key\_no\_workspace\_check}. These stubs may then be inlined (and
+thus effectively removed altogether) by setting appropriate compiler
+flags (e.g. ``-finline'' for the Intel compiler or ``-Q'' for the IBM
+compiler).
+
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Optimisation}
+
+Considering the new computer architecture, optimisation cannot be considered independently from the computer type.
+In NEMO, portability is a priority, before any too specific optimisation.
+Some tools are available to help: \\
+For vector computers: 
+\begin{itemize} 
+\item  using $key\_vectopt\_loop$ allows to unroll a loop
+\end{itemize}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{Package attribute: $PRIVATE, PUBLIC, USE, ONLY$}
+Module variables and routines should be encapsulated by using the PRIVATE attribute. What shall be used outside the module can be declared PUBLIC instead. Use USE with the ONLY attribute to specify which of the variables, type definitions etc. defined in a module are to be made available to the using routine. 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection {Parallelism: using MPI}
+NEMO is written in order to be able to run on one processor, or on one or more using MPI (i.e. activating the cpp key $key\_mpp\_mpi$. The domain decomposition divides the global domain in cubes (see NEMO reference manual). Whilst coding a new development, the MPI compatibility has to be taken in account (see $LBC/lib\_mpp.F90$) and should be tested. By default, the $x$-$z$ part of the decomposition is chosen to be as square as possible. However, this may be overriden by specifying the number of subdomains in latitude and longitude in the nammpp section of the namelist file.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Features to be avoided}
+
+The code must follow the current standards of FORTRAN and ANSI C.  In particular, the code should not produce any WARNING at compiling phase, so that users can be easily alerted of potential bugs when some appear in their new developments. ). 
+Below is a list of features to avoid:
+\begin{itemize}
+\item COMMON blocks (use the declaration part of MODULEs instead)
+\item EQUIVALENCE (use POINTERs or derived data types instead to form data structures)
+\item Assigned and computed GOTOs (use the CASE construct instead)
+\item Arithmetic IF statements ( use the block IF, ELSE, ELSEIF, ENDIF or SELECT CASE construct instead) 
+\item Labeled DO constructs  (use unlabeled END DO instead) 
+\item FORMAT statements (use character parameters or explicit format- specifiers inside the READ or WRITE statement instead)
+\item GOTO and CONTINUE statement (use IF, CASE, DO WHILE, EXIT or CYCLE statements or a contained 
+\item PAUSE 
+\item ENTRY statements: a subprogram must only have one entry point. 
+\item RETURN Ð it is obsolete and so not necessary at the end of program units
+\item STATEMENT FUNCTION 
+ \item Avoid functions with side effects.
+\footnote{ First, the code is easier to understand, if you can rely on the rule that functions don't change their arguments, second, some compilers generate more efficient code for PURE (in FORTRAN 95 there are the attributes PURE and ELEMENTAL) functions, because they can store the arguments in different places. This is especially important on massive parallel and as well on vector machines. }
+\item DATA and BLOCK DATA - (use initialisers)
+\end{itemize}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% \printindex
+% \input NEMO_coding.conv.ind
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_asminc
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_asminc	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_asminc	(revision 8732)
@@ -0,0 +1,18 @@
+!-----------------------------------------------------------------------
+&nam_asminc    !   assimilation increments                              ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri  = .false.   !  Logical switch for writing out background state
+    ln_trainc  = .false.   !  Logical switch for applying tracer increments
+    ln_dyninc  = .false.   !  Logical switch for applying velocity increments
+    ln_sshinc  = .false.   !  Logical switch for applying SSH increments
+    ln_asmdin  = .false.   !  Logical switch for Direct Initialization (DI)
+    ln_asmiau  = .false.   !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg     = 0         !  Timestep of background in [0,nitend-nit000-1]
+    nitdin     = 0         !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr  = 1         !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin  = 15        !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn     = 0         !  Type of IAU weighting function
+    ln_salfix  = .false.   !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin  = -9999     !  Minimum salinity after applying the increments
+    nn_divdmp  = 0         !  Number of iterations of divergence damping operator
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_dia25h
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_dia25h	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_dia25h	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&nam_dia25h    !  25h Mean Output                                        (default F)
+!-----------------------------------------------------------------------
+   ln_dia25h   = .false.   ! Choose 25h mean output or not
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_diaharm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_diaharm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_diaharm	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents               ("key_diaharm")
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_diatmb
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_diatmb	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_diatmb	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&nam_diatmb    !  Top Middle Bottom Output                               (default F)
+!-----------------------------------------------------------------------
+   ln_diatmb   = .false.   !  Choose Top Middle and Bottom output or not
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_tide
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_tide	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_tide	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters
+!-----------------------------------------------------------------------
+   ln_tide       = .true.   !  Activate tide module
+   ln_tide_pot   = .true.   !  use tidal potential forcing
+   ln_tide_ramp  = .false.  !
+   rdttideramp   =    0.    !
+   clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_vvl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_vvl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nam_vvl	(revision 8732)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations
+   ln_vvl_layer  = .false.          !  full layer vertical coordinate
+   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar
+   ln_vvl_zstar_at_eqtor  = .false. !  ztilde near the equator
+   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient
+   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days]
+   rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days]
+   rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation
+   ln_vvl_dbg    = .true.           !  debug prints    (T/F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namagrif
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namagrif	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namagrif	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&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 [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+   ln_chk_bathy  = .FALSE. !
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambbc
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambbc	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambbc	(revision 8732)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_qgh      ='geothermal_heating.nc',  -12.       , 'heatflow',   .false.   , .true.  , 'yearly'  ,   ''     ,   ''     ,   ''
+   !
+   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]
+   cn_dir      = './'      !  root directory for the location of the runoff files 
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambbl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambbl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambbl	(revision 8732)
@@ -0,0 +1,8 @@
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+   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]
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy	(revision 8732)
@@ -0,0 +1,35 @@
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+!-----------------------------------------------------------------------
+    ln_bdy         = .true.               !  Activate BDY module
+    nb_bdy         = 0                    !  number of open boundary sets
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file   = .false.              !  =T : read mask from file
+    cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.)
+    cn_dyn2d       = 'none'               !
+    nn_dyn2d_dta   =  0                   !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    cn_dyn3d      =  'none'               !
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_tra        =  'none'               !
+    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_ice_lim      =  'none'             !
+    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice
+    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           --
+    rn_ice_age      = 30.                 !  lim3 only:      --   age                --
+
+    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers
+    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities
+    rn_time_dmp   =  1.                   ! Damping time scale in days
+    rn_time_dmp_out =  1.                 ! Outflow damping time scale
+    nn_rimwidth   = 10                    !  width of the relaxation zone
+    ln_vol        = .false.               !  total volume correction (see nn_volctl parameter)
+    nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_dta
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_dta	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_dta	(revision 8732)
@@ -0,0 +1,24 @@
+!-----------------------------------------------------------------------
+&nambdy_dta    !  open boundaries - external data
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh      = 'amm12_bdyT_u2d',         24        , 'sossheig',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_u2d      = 'amm12_bdyU_u2d',         24        , 'vobtcrtx',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_v2d      = 'amm12_bdyV_u2d',         24        , 'vobtcrty',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_u3d      = 'amm12_bdyU_u3d',         24        , 'vozocrtx',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_v3d      = 'amm12_bdyV_u3d',         24        , 'vomecrty',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+! for lim2
+!   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+! for lim3
+!   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_ht_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_ht_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+
+   cn_dir      = 'bdydta/' !  root directory for the location of the bulk files
+   ln_full_vel = .false.   !  
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_tide
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_tide	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_tide	(revision 8732)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files
+   ln_bdytide_2ddta = .false.                   !
+   ln_bdytide_conj  = .false.                   ! 
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namberg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namberg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namberg	(revision 8732)
@@ -0,0 +1,34 @@
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters                                   (default: No iceberg)
+!-----------------------------------------------------------------------
+      ln_icebergs              = .false.              ! iceberg floats or not
+      ln_bergdia               = .true.               ! Calculate budgets
+      nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0
+      nn_verbose_write         = 15                   ! Timesteps between verbose messages
+      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage
+                                                      ! Initial mass required for an iceberg of each class
+      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
+                                                      ! Proportion of calving mass to apportion to each class
+      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
+                                                      ! Ratio between effective and real iceberg mass (non-dim)
+                                                      ! i.e. number of icebergs represented at a point
+      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
+                                                      ! thickness of newly calved bergs (m)
+      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250.
+      rn_rho_bergs             = 850.                 ! Density of icebergs
+      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs
+      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics
+      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
+      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
+      ln_passive_mode          = .false.              ! iceberg - ocean decoupling
+      nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no)
+                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
+      rn_test_box              = 108.0,  116.0, -66.0, -58.0
+      rn_speed_limit           = 0.                   ! CFL speed limit for a berg
+
+!            ! file name ! frequency (hours) !   variable   ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!            !           !  (if <0  months)  !     name     !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+      sn_icb =  'calving',       -1          , 'calvingmask',   .true.    , .true.  , 'yearly'  ,    ''    ,    ''    ,     ''
+
+      cn_dir = './'
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambfr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambfr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambfr	(revision 8732)
@@ -0,0 +1,23 @@
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction                                      (default: linear)
+!-----------------------------------------------------------------------
+   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). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max=    1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   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)
+   rn_tfri1    =    4.e-4  !  top drag coefficient (linear case)
+   rn_tfri2    =    2.5e-3 !  top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_tfri2_max=    1.e-1  !  max. top drag coefficient (non linear case and ln_loglayer=T)
+   rn_tfeb2    =    0.0    !  top turbulent kinetic energy background  (m2/s2)
+   rn_tfrz0    =    3.e-3  !  top roughness [m] if ln_loglayer=T
+   ln_tfr2d    = .false.   !  horizontal variation of the top friction coef (read a 2D mask file )
+   rn_tfrien   =   50.     !  local multiplying factor of tfr (ln_tfr2d=T)
+
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+   ln_loglayer = .false.   !  logarithmic formulation (non linear case)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d	(revision 8732)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namc1d        !   1D configuration options                             ("key_c1d")
+!-----------------------------------------------------------------------
+   rn_lat1d    =      50   !  Column latitude (default at PAPA station)
+   rn_lon1d    =    -145   !  Column longitude (default at PAPA station)
+   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d_dyndmp
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d_dyndmp	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d_dyndmp	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d_uvd
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d_uvd	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namc1d_uvd	(revision 8732)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namc1d_uvd    !   data: U & V currents                                 ("key_c1d")
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , ''
+   sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , ''
+!
+   cn_dir        = './'    !  root directory for the location of the files
+   ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F)
+   ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcfg	(revision 8732)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "domain_cfg"         ! domain configuration filename
+      !
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+      cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename
+      !
+   ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present
+   !                       !  in netcdf input files, as the start j-row for reading
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcfg_orca1
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcfg_orca1	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcfg_orca1	(revision 8732)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+   ln_use_jattr = .true.               !  use (T) the file attribute: open_ocean_jstart if present
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcrs
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcrs	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namcrs	(revision 8732)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namcrs        !   coarsened grid (for outputs and/or TOP)              ("key_crs")
+!-----------------------------------------------------------------------
+   nn_factx    = 3         !  Reduction factor of x-direction
+   nn_facty    = 3         !  Reduction factor of y-direction
+   nn_binref   = 0         !  Bin centering preference: NORTH or EQUAT
+                           !  0, coarse grid is binned with preferential treatment of the north fold
+                           !  1, coarse grid is binned with centering at the equator
+                           !    Symmetry with nn_facty being odd-numbered. Asymmetry with even-numbered nn_facty.
+   nn_msh_crs  = 1         !  create (=1) a mesh file or not (=0)
+   nn_crs_kz   = 0         ! 0, MEAN of volume boxes
+                           ! 1, MAX of boxes
+                           ! 2, MIN of boxes
+   ln_crs_wn   = .true.    ! wn coarsened (T) or computed using horizontal divergence ( F )
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namctl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namctl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namctl	(revision 8732)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+&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_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+   nn_diacfl   =    0      !  Write out CFL diagnostics (=1) in cfl_diagnostics.ascii, or not (=0)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdct
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdct	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdct	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namdct        ! transports through some sections                        ("key_diadct")
+!-----------------------------------------------------------------------
+    nn_dct     = 15        !  time step frequency for transports computing
+    nn_dctwri  = 15        !  time step frequency for transports writing
+    nn_secdebug= 112       !      0 : no section to debug
+    !                      !     -1 : debug all section
+    !                      !  0 < n : debug section number n
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdiu
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdiu	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdiu	(revision 8732)
@@ -0,0 +1,6 @@
+!-----------------------------------------------------------------------
+&namdiu        !   Cool skin and warm layer models                       (default F)
+!-----------------------------------------------------------------------
+   ln_diurnal      = .false.   ! 
+   ln_diurnal_only = .false.   !
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdom
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdom	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdom	(revision 8732)
@@ -0,0 +1,39 @@
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
+   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    1      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   ln_crs      = .false.      !  Logical switch for coarsening module
+   jphgr_msh   =       0               !  type of horizontal mesh
+                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+                                       !  = 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
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =     -35.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =       1.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =       0.5             !  meridional grid-spacing (degrees)
+   ppe1_m      =    5000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    5000.0             !  meridional grid-spacing (degrees)
+   ppsur       =    -4762.96143546300  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =      255.58049070440  ! (default coefficients)
+   ppa1        =      245.58132232490  !
+   ppkth       =       21.43336197938  !
+   ppacr       =        3.0            !
+   ppdzmin     =       10.             !  Minimum vertical spacing
+   pphmax      =     5000.             !  Maximum depth
+   ldbletanh   =    .TRUE.             !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =      100.760928500000 !  Double tanh function parameters
+   ppkth2      =       48.029893720000 !
+   ppacr2      =       13.000000000000 !
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_adv
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_adv	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_adv	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection                (default: vector form)
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_hpg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_hpg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_hpg	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps)
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_ldf
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_ldf	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_ldf	(revision 8732)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO)
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.    !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_spg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_spg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_spg	(revision 8732)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient                            (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynspg_exp  = .false.   ! explicit free surface
+   ln_dynspg_ts   = .false.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed
+         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_vor
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_vor	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namdyn_vor	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1          ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)  ! PLEASE DO NOT ACTIVATE
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namelist_dmp
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namelist_dmp	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namelist_dmp	(revision 8732)
@@ -0,0 +1,24 @@
+&nam_dmp_create
+    cp_cfg = 'orca'            ! Name of model grid (orca and C1D have special options - otherwise ignored)
+    cp_cfz = 'antarctic'       ! Name of zoom configuration (arctic and antarctic have some special treatment if lzoom=.true.)
+    jp_cfg = 2                 ! Resolution of the model (used for med_red_seas damping)
+    lzoom = .false.            ! Zoom configuration or not
+    ln_full_field = .false.    ! Calculate coefficient over whole of domain 
+    ln_med_red_seas = .true.   ! Damping in Med/Red Seas (or local modifications here if ln_full_field=.true.)
+    ln_old_31_lev_code = .true.   ! Replicate behaviour of old online code for 31 level model (Med/Red seas damping based on level number instead of depth)
+    ln_coast = .true.          ! Reduce near to coastlines 
+    ln_zero_top_layer = .true. ! No damping in top layer
+    ln_custom = .false.        ! Call "custom" module to apply user modifications to the damping coefficient field
+    nn_hdmp = 10               ! Damp poleward of this latitude (smooth transition up to maximum damping)
+    pn_surf = 0.25             ! Surface Relaxation timescale (days) 
+    pn_bot = 0.25              ! Bottom relaxation timescale (days)
+    pn_dep = 1000              ! Transition depth from upper to deep ocean
+    jperio = 2                 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
+&nam_zoom_dmp
+    lzoom_n = .false.     ! Open boundary had northern edge?
+    lzoom_e = .false.     ! Open boundary at eastern edge?
+    lzoom_w = .false.     ! Open boundary at western edge?
+    lzoom_s = .false.     ! Open boundary at southern edge?
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nameos
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nameos	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nameos	(revision 8732)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .false.         !  = Use EOS80 equation of state
+   ln_seos     = .false.         !  = Use simplified equation of state (S-EOS)
+                                 !
+   !                     ! S-EOS coefficients (ln_seos=T):
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namflo
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namflo	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namflo	(revision 8732)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&namflo        !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   jpnfl       = 1         !  total number of floats during the run
+   jpnnewflo   = 0         !  number of floats for the restart
+   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)
+   ln_ariane   = .true.    !  Input with Ariane tool convention(T)
+   ln_flo_ascii= .true.    !  Output with Ariane tool netcdf convention(F) or ascii file (T)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namhsb
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namhsb	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namhsb	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namhsb        !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+   ln_diahsb   = .false.   !  check the heat and salt budgets (T) or not (F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namlbc
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namlbc	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namlbc	(revision 8732)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nammpp
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nammpp	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nammpp	(revision 8732)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+&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
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
+   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)
+   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)
+   jpnij       =   0       !  jpnij  number of local domains (set automatically if < 1)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namnc4
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namnc4	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namnc4	(revision 8732)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+&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
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namobs
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namobs	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namobs	(revision 8732)
@@ -0,0 +1,37 @@
+!-----------------------------------------------------------------------
+&namobs        !  observation usage switch
+!-----------------------------------------------------------------------
+   ln_diaobs   = .false.             ! Logical switch for the observation operator
+   ln_t3d      = .false.             ! Logical switch for T profile observations
+   ln_s3d      = .false.             ! Logical switch for S profile observations
+   ln_sla      = .false.             ! Logical switch for SLA observations
+   ln_sst      = .false.             ! Logical switch for SST observations
+   ln_sic      = .false.             ! Logical switch for Sea Ice observations
+   ln_vel3d    = .false.             ! Logical switch for velocity observations
+   ln_altbias  = .false.             ! Logical switch for altimeter bias correction
+   ln_nea      = .false.             ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.           ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.   ! Logical switch for obs grid search w/lookup table
+   ln_ignmis   = .true.              ! Logical switch for ignoring missing files
+   ln_s_at_t   = .false.             ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.             ! Logical switch for calculating night-time average for SST obs
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   cn_profbfiles = 'profiles_01.nc'  ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'       ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'       ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'       ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'       ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'     ! Altimeter bias input file name
+   cn_gridsearchfile='gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5            ! Grid search resolution
+   rn_dobsini  = 00010101.000000     ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend  = 00010102.000000     ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint    = 0                   ! Type of vertical interpolation method
+   nn_2dint    = 0                   ! Type of horizontal interpolation method
+   nn_msshc    = 0                   ! MSSH correction scheme
+   rn_mdtcorr  = 1.61                ! MDT  correction
+   rn_mdtcutoff = 65.0               ! MDT cutoff for computed correction
+   nn_profdavtypes = -1              ! Profile daily average types - array
+   ln_sstbias  = .false.             !
+   cn_sstbias_files = 'sstbias.nc'   !
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namobs_example
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namobs_example	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namobs_example	(revision 8732)
@@ -0,0 +1,34 @@
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch
+!-----------------------------------------------------------------------
+   ln_diaobs  = .true.                 ! Logical switch for the observation operator
+   ln_t3d     = .true.                 ! Logical switch for T profile observations
+   ln_s3d     = .true.                 ! Logical switch for S profile observations
+   ln_sla     = .false.                ! Logical switch for SLA observations
+   ln_sst     = .false.                ! Logical switch for SST observations
+   ln_sic     = .false.                ! Logical switch for Sea Ice observations
+   ln_vel3d   = .false.                ! Logical switch for velocity observations
+   ln_altbias = .false.                ! Logical switch for altimeter bias correction
+   ln_nea     = .false.                ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.             ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.     ! Logical switch for obs grid search w/lookup table
+   ln_ignmis  = .true.                 ! Logical switch for ignoring missing files
+   ln_s_at_t  = .false.                ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.               ! Logical switch for calculating night-time average for SST obs
+   cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name
+   cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5              ! Grid search resolution
+   rn_dobsini = 00010101.000000        ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend = 00010102.000000        ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint = 0                        ! Type of vertical interpolation method
+   nn_2dint = 0                        ! Type of horizontal interpolation method
+   nn_msshc = 0                        ! MSSH correction scheme
+   rn_mdtcorr = 1.61                   ! MDT  correction
+   rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction
+   nn_profdavtypes = -1                ! Profile daily average types - array
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namptr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namptr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namptr	(revision 8732)
@@ -0,0 +1,6 @@
+!-----------------------------------------------------------------------
+&namptr        !   Poleward Transport Diagnostic                         (default F)
+!-----------------------------------------------------------------------
+   ln_diaptr   = .false.   !  Poleward heat and salt transport (T) or not (F)
+   ln_subbas   = .false.   !  Atlantic/Pacific/Indian basins computation (T) or not
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namrun
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namrun	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namrun	(revision 8732)
@@ -0,0 +1,31 @@
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    5475   !  last  time step (std 5475)
+   nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_time0    =       0   !  initial time of day in hhmm
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      nn_euler    =    1            !  = 0 : start with forward time step if ln_rstart=T
+      nn_rstctl   =    0            !  restart control ==> activated only if ln_rstart=T
+      !                             !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
+      !                             !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
+      !                             !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
+      cn_ocerst_in    = "restart"   !  suffix of ocean restart name (input)
+      cn_ocerst_indir = "."         !  directory from which to read input ocean restarts
+      cn_ocerst_out   = "restart"   !  suffix of ocean restart name (output)
+      cn_ocerst_outdir= "."         !  directory in which to write output ocean restarts
+   ln_iscpl    = .false.   !  cavity evolution forcing or coupling to ice sheet model
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
+   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
+   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc	(revision 8732)
@@ -0,0 +1,44 @@
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice & iceberg model call)
+                     ! Type of air-sea fluxes 
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio)
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+                     ! Type of coupling (Ocean/Ice/Atmosphere) :
+   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
+   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
+   nn_components = 0       !  configuration of the opa-sas OASIS coupling
+                           !  =0 no opa-sas OASIS coupling: default single executable configuration
+                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
+                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
+   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)
+                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled
+                           !  = 0  Average per-category fluxes (forced and coupled mode)
+                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
+                           !  = 2  Redistribute a single flux over categories (coupled mode only)
+                     ! Sea-ice :
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice")
+   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =1 levitating ice with mass and salt exchange but no presure effect
+                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
+                     ! Misc. options of sbc : 
+   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr )
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 2         !  FreshWater Budget: =0 unchecked
+                           !     =1 global mean of e-p-r set to zero at each time step
+                           !     =2 annual global mean of e-p-r set to zero
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_isf      = .false.   !  ice shelf                                 (T   => fill namsbc_isf)
+   ln_wave     = .false.   !  coupling with surface wave                (T => fill namsbc_wave)
+   nn_lsm      = 0         !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) ,
+                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_alb
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_alb	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_alb	(revision 8732)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+   nn_ice_alb  =    0      !  parameterization of ice/snow albedo
+                           !     0: Shine & Henderson-Sellers (JGR 1985)
+                           !     1: "home made" based on Brandt et al. (J. Climate 2005)
+                           !                         and Grenfell & Perovich (JGR 2004)
+   rn_albice   =  0.53     !  albedo of bare puddled ice (values from 0.49 to 0.58)
+                           !     0.53 (default) => if nn_ice_alb=0
+                           !     0.50 (default) => if nn_ice_alb=1
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_ana
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_ana	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_ana	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&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)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_apr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_apr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_apr	(revision 8732)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,      ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   rn_pref     = 101000.   !  reference atmospheric pressure   [N/m2]/
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+   ln_apr_obc  = .false.   !  inverse barometer added to OBC ssh data
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_clio
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_clio	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_clio	(revision 8732)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_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
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_core
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_core	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_core	(revision 8732)
@@ -0,0 +1,24 @@
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask !
+!              !                              !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      !
+   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_tdif     = 'taudif_core'                ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_zqt      = 10.       !  Air temperature and humidity reference height (m)
+   rn_zu       = 10.       !  Wind vector reference height (m)
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
+                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_cpl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_cpl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_cpl	(revision 8732)
@@ -0,0 +1,27 @@
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+!                    !     description      !  multiple  !    vector   !      vector          ! vector !
+!                    !                      ! categories !  reference  !    orientation       ! grids  !
+! send
+   sn_snd_temp   =   'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_alb    =   'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_thick  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_crt    =   'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'
+   sn_snd_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
+! receive
+   sn_rcv_w10m   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_taumod =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_tau    =   'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'
+   sn_rcv_dqnsdt =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_qsr    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_qns    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_emp    =   'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_rnf    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+!
+   nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models
+   !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_flx
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_flx	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_flx	(revision 8732)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_utau     = '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
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_iscpl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_iscpl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_iscpl	(revision 8732)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namsbc_iscpl  !   land ice / ocean coupling option                     
+!-----------------------------------------------------------------------
+   nn_drown    = 10        ! number of iteration of the extrapolation loop (fill the new wet cells)
+   ln_hsb      = .false.   ! activate conservation module (conservation exact after a time of rn_fiscpl)
+   nn_fiscpl   = 43800     ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_isf
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_isf	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_isf	(revision 8732)
@@ -0,0 +1,33 @@
+!-----------------------------------------------------------------------
+&namsbc_isf    !  Top boundary layer (ISF)                              (nn_isf >0)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+! nn_isf == 4
+   sn_fwfisf   = 'rnfisf'  ,         -12       ,'sowflisf',   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 3
+   sn_rnfisf   = 'rnfisf'  ,         -12       ,'sofwfisf',   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 2 and 3
+   sn_depmax_isf='rnfisf'  ,         -12       ,'sozisfmax',  .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+   sn_depmin_isf='rnfisf'  ,         -12       ,'sozisfmin',  .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 2
+   sn_Leff_isf = 'rnfisf'  ,         -12       ,'Leff'    ,   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+!
+! for all case
+   nn_isf      = 1         !  ice shelf melting/freezing
+                           !  1 = presence of ISF    2 = bg03 parametrisation 
+                           !  3 = rnf file for isf   4 = ISF fwf specified
+                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
+! only for nn_isf = 1 or 2
+   rn_gammat0  = 1.e-4     ! gammat coefficient used in blk formula
+   rn_gammas0  = 1.e-4     ! gammas coefficient used in blk formula
+! only for nn_isf = 1 or 4
+   rn_hisf_tbl =  30.      ! thickness of the top boundary layer    (Losh et al. 2008)
+   !                       ! 0 => thickness of the tbl = thickness of the first wet cell
+! only for nn_isf = 1
+   nn_isfblk   = 1         ! 1 ISOMIP  like: 2 equations formulation (Hunter et al., 2006)
+   !                       ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+   nn_gammablk = 1         ! 0 = cst Gammat (= gammat/s)
+   !                       ! 1 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010)
+   !                       ! 2 = velocity and stability dependent Gamma    (Holland et al. 1999)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_mfs
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_mfs	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_mfs	(revision 8732)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable ! time interp. !  clim  ! 'yearly'/ ! weights     ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name   !   (logical)  !  (T/F) ! 'monthly' ! filename    ! pairing  ! filename      !
+   sn_wndi     =   'ecmwf'   ,        6          , 'u10'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_wndj     =   'ecmwf'   ,        6          , 'v10'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_clc      =   'ecmwf'   ,        6          , 'clc'    ,    .true.    , .false., 'daily'   ,'bilinear.nc',   ''     ,   ''
+   sn_msl      =   'ecmwf'   ,        6          , 'msl'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_tair     =   'ecmwf'   ,        6          , 't2'     ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_rhm      =   'ecmwf'   ,        6          , 'rh'     ,    .true.    , .false., 'daily'   ,'bilinear.nc',   ''     ,   ''
+   sn_prec     =   'ecmwf'   ,        6          , 'precip' ,    .true.    , .true. , 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+
+   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_rnf
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_rnf	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_rnf	(revision 8732)
@@ -0,0 +1,24 @@
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T)
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_rnf_mouth= .true.    !  specific treatment at rivers mouths
+      rn_hrnf     =  15.e0    !  depth over which enhanced vertical mixing is used    (ln_rnf_mouth=T)
+      rn_avt_rnf  =   1.e-3   !  value of the additional vertical mixing coef. [m2/s] (ln_rnf_mouth=T)
+   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
+   ln_rnf_depth_ini = .false. ! compute depth at initialisation from runoff file
+      rn_rnf_max  = 5.735e-4  !  max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )
+      rn_dep_max  = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+      nn_rnf_depth_file = 0   !  create (=1) a runoff depth file or not (=0)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_sas
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_sas	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_sas	(revision 8732)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namsbc_sas    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_usp      = 'sas_grid_U',     120           , 'vozocrtx',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_vsp      = 'sas_grid_V',     120           , 'vomecrty',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_tem      = 'sas_grid_T',     120           , 'sosstsst',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_sal      = 'sas_grid_T',     120           , 'sosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_ssh      = 'sas_grid_T',     120           , 'sossheig',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_e3t      = 'sas_grid_T',     120           , 'e3t_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_frq      = 'sas_grid_T',     120           , 'frq_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+
+   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
+   ln_read_frq = .false.   !  specify whether we must read frq or not
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_ssr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_ssr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_ssr	(revision 8732)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !   (logical) !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   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     =  -166.67  !  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]
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_wave
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_wave	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc_wave	(revision 8732)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model                        (ln_wave=T)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable    ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name      !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_cdg      = 'cdg_wave',        1          , 'drag_coeff',   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+   sn_usd      = 'sdw_wave',        1          , 'u_sd2d'    ,   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+   sn_vsd      = 'sdw_wave',        1          , 'v_sd2d'    ,   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+   sn_wn       = 'sdw_wave',        1          , 'wave_num'  ,   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+!
+   cn_dir_cdg  = './'      !  root directory for the location of drag coefficient files
+   ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model
+   ln_sdw      = .false.   !  Computation of 3D stokes drift               
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsto
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsto	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsto	(revision 8732)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+&namsto        ! Stochastic parametrization of EOS                      (default: NO)
+!-----------------------------------------------------------------------
+   ln_sto_eos  = .false.   ! stochastic equation of state
+   nn_sto_eos  = 1         ! number of independent random walks
+   rn_eos_stdxy= 1.4       ! random walk horz. standard deviation (in grid points)
+   rn_eos_stdz = 0.7       ! random walk vert. standard deviation (in grid points)
+   rn_eos_tcor = 1440.     ! random walk time correlation (in timesteps)
+   nn_eos_ord  = 1         ! order of autoregressive processes
+   nn_eos_flt  = 0         ! passes of Laplacian filter
+   rn_eos_lim  = 2.0       ! limitation factor (default = 3.0)
+   ln_rststo   = .false.   ! start from mean parameter (F) or from restart file (T)
+   ln_rstseed  = .true.    ! read seed of RNG from restart file
+   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input)
+   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_adv
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_adv	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_adv	(revision 8732)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer                          (default: NO advection)
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .false. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_adv_mle
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_adv_mle	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_adv_mle	(revision 8732)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+   ln_mle      = .false.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation
+   rn_ce       = 0.06      ! magnitude of the MLE (typical value: 0.06 to 0.08)
+   nn_mle      = 1         ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
+   rn_lf       = 5.e+3     ! typical scale of mixed layer front (meters)                      (case rn_mle=0)
+   rn_time     = 172800.   ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_mle=0)
+   rn_lat      = 20.       ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1)
+   nn_mld_uv   = 0         ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
+   nn_conv     = 0         ! =1 no MLE in case of convection ; =0 always MLE
+   rn_rho_c_mle= 0.01      ! delta rho criterion used to calculate MLD for FK
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_dmp
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_dmp	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_dmp	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_ldf
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_ldf	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_ldf	(revision 8732)
@@ -0,0 +1,33 @@
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion)
+!-----------------------------------------------------------------------
+   !                       !  Operator type:
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_ldfeiv
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_ldfeiv	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_ldfeiv	(revision 8732)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+   ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_qsr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_qsr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtra_qsr	(revision 8732)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T)
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   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_si1      =   23.0    !  2 bands: longest depth of extinction
+   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtrd
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtrd	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtrd	(revision 8732)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namtrd        !   trend diagnostics                                    (default F)
+!-----------------------------------------------------------------------
+   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
+   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
+   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
+   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet)
+   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
+   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
+   ln_tra_trd  = .false.   ! (T) 3D tracer trend output
+   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
+   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtsd
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtsd	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namtsd	(revision 8732)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namtsd        !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+!              !  file name                 ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                            !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_tem = 'data_1m_potential_temperature_nomask',     -1      ,'votemper',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_sal = 'data_1m_salinity_nomask'             ,     -1      ,'vosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_tsd_init = .true.    !  Initialisation of ocean T & S with T & S input data (T) or not (F)
+   ln_tsd_tradmp = .true.  !  damping of ocean T & S toward T & S input data (T) or not (F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namwad
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namwad	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namwad	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namwad        !   Wetting and drying                                   (default F)
+!-----------------------------------------------------------------------
+   ln_wd       = .false.   !  T/F activation of wetting and drying
+   rn_wdmin1   =  0.1      !  Minimum wet depth on dried cells
+   rn_wdmin2   =  0.01     !  Tolerance of min wet depth on dried cells
+   rn_wdld     =  20.0     !  Land elevation below which wetting/drying is allowed
+   nn_wdit     =  10       !  Max iterations for W/D limiter
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf	(revision 8732)
@@ -0,0 +1,16 @@
+!-----------------------------------------------------------------------
+&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 Convective 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
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_ddm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_ddm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_ddm	(revision 8732)
@@ -0,0 +1,6 @@
+!-----------------------------------------------------------------------
+&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
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_gls
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_gls	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_gls	(revision 8732)
@@ -0,0 +1,18 @@
+!-----------------------------------------------------------------------
+&namzdf_gls    !   GLS vertical diffusion                               ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-7   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.267   !  galperin limit
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   rn_hsro       =  0.02   !  Minimum surface roughness
+   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met=2)
+   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2)
+   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum)
+   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum)
+   nn_stab_func  =     2   !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =     1   !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_ric
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_ric	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_ric	(revision 8732)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&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
+   rn_ekmfc    =    0.7    !  Factor in the Ekman depth Equation
+   rn_mldmin   =    1.0    !  minimum allowable mixed-layer depth estimate (m)
+   rn_mldmax   = 1000.0    !  maximum allowable mixed-layer depth estimate (m)
+   rn_wtmix    =   10.0    !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
+   rn_wvmix    =   10.0    !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
+   ln_mldw     =  .true.   !  Flag to use or not the mixed layer depth param.
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tke
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tke	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tke	(revision 8732)
@@ -0,0 +1,28 @@
+!-----------------------------------------------------------------------
+&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]
+   rn_bshear   =   1.e-20  ! background shear (>0) currently a numerical threshold (do not change it)
+   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 near 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           (ln_cpl=T)
+   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
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tmx
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tmx	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tmx	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&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  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tmx_new
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tmx_new	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzdf_tmx_new	(revision 8732)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm")
+!-----------------------------------------------------------------------
+   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
+   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency
+   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzgr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzgr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzgr	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate                                  (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps
+   ln_zps      = .false.   !  z-coordinate - partial steps
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate
+   ln_isfcav   = .false.   !  ice shelf cavity
+   ln_linssh   = .false.   !  linear free surface
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzgr_sco
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzgr_sco	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namzgr_sco	(revision 8732)
@@ -0,0 +1,25 @@
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate                (default F)
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_hc       =  150.0    !  critical depth for transition to stretched coordinates
+                        !!!!!!!  Envelop bathymetry
+   rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1)
+                        !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma
+                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
+   rn_alpha    =    4.4    !  stretching with SF12 s-sigma
+   rn_efold    =    0.0    !  efold length scale for transition to stretched coord
+   rn_zs       =    1.0    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb
+   rn_zb_b     =   -0.2    !  offset for calculating Zb
+                        !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1)
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Bibliography/Biblio.bib
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Bibliography/Biblio.bib	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Bibliography/Biblio.bib	(revision 8732)
@@ -0,0 +1,3382 @@
+This file was created with JabRef 2.2.
+Encoding: UTF8
+
+@STRING{AP = {Academic Press}}
+
+@STRING{AREPS = {Annual Review of Earth Planetary Science}}
+
+@STRING{ARFM = {Annual Review of Fluid Mechanics}}
+
+@STRING{ASL = {Atmospheric Science Letters}}
+
+@STRING{AW = {Addison-Wesley}}
+
+@STRING{CP = {Clarendon Press}}
+
+@STRING{CD = {Clim. Dyn.}}
+
+@STRING{CUP = {Cambridge University Press}}
+
+@STRING{CSR = {Cont. Shelf Res.}}
+
+@STRING{D = {Dover Publications}}
+
+@STRING{DAO = {Dyn. Atmos. Ocean}}
+
+@STRING{DSR = {Deep-Sea Res.}}
+
+@STRING{E = {Eyrolles}}
+
+@STRING{EFM ={Environ. Fluid Mech.}}
+
+@STRING{GRL = {Geophys. Res. Let.}}
+
+@STRING{I = {Interscience}}
+
+@STRING{JAOT = {J. Atmos. Ocean Tech.}}
+
+@STRING{JAS = {J. Atmos. Sc.}}
+
+@STRING{JC = {J. Climate}}
+
+@STRING{JCP = {J. Comput. Phys.}}
+
+@STRING{JFM = {J. Fluid Mech.}}
+
+@STRING{JGR = {J. Geophys. Res}}
+
+@STRING{JHUP = {The Johns Hopkins University Press}}
+
+@STRING{JMR = {J. Mar. Res.}}
+
+@STRING{JMS = {J. Mar. Sys.}}
+
+@STRING{JMSJ = {J. Met. Soc. Japan}}
+
+@STRING{JPO = {J. Phys. Oceanogr.}}
+
+@STRING{JSC = {J. Supercomputing.}}
+
+@STRING{JWS = {John Wiley and Sons}}
+
+@STRING{M = {Macmillan}}
+
+@STRING{MGH = {McGraw-Hill}}
+
+@STRING{MWR = {Mon. Wea. Rev.}}
+
+@STRING{Nature = {Nat.}}
+
+@STRING{NH = {North-Holland}}
+
+@STRING{Ocean = {Oceanology}}
+
+@STRING{OD = {Ocean Dyn.}}
+
+@STRING{OM = {Ocean Modelling}}
+
+@STRING{OS = {Ocean Sc.}}
+
+@STRING{OUP = {Oxford University Press}}
+
+@STRING{PH = {Prentice-Hall}}
+
+@STRING{PO = {Prog. Oceangr.}}
+
+@STRING{PP = {Pergamon Press}}
+
+@STRING{PRSL = {Proceedings of the Royal Society of London}}
+
+@STRING{QJRMS = {Quart. J. Roy. Meteor. Soc.}}
+
+@STRING{Recherche = {La Recherche}}
+
+@STRING{RGSP = {Rev. Geophys. Space Phys.}}
+
+@STRING{Science = {Science}}
+
+@STRING{SV = {Springer-Verlag}}
+
+@STRING{Tellus = {Tellus}}
+
+
+@ARTICLE{Adcroft_Campin_OM04,
+  author = {A. Adcroft and J.-M. Campin},
+  title = {Re-scaled height coordinates for accurate representation of free-surface flows in ocean circulation models},
+  journal = OM,
+  year = {2004},
+  volume = {7},
+  pages = {269--284},
+  doi = {10.1016/j.ocemod.2003.09.003},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2003.09.003}
+}
+
+@ARTICLE{Arakawa1966,
+  author = {A. Arakawa},
+  title = {Computational design for long term numerical integration of the equations 
+    of fluid motion, two-dimensional incompressible flow, Part. I.},
+  journal = JCP,
+  year = {1966},
+  volume = {I},
+  pages = {119--149}
+}
+
+@ARTICLE{Arakawa_Hsu_MWR90,
+  author = {A. Arakawa and Y.-J. G. Hsu},
+  title = {Energy Conserving and Potential-Enstrophy Dissipating Schemes for the Shallow Water Equations},
+  journal = MWR,
+  year = {1990},
+  volume = {118},  number = {10},
+  pages = {1960--1969},
+}
+
+@ARTICLE{Arakawa_Lamb_MWR81,
+  author = {Arakawa, Akio and Lamb, Vivian R.},
+  title = {A Potential Enstrophy and Energy Conserving Scheme for the Shallow
+	Water Equations},
+  journal = MWR,
+  year = {1981},
+  volume = {109},  number = {1},
+  pages = {18--36}
+}
+
+@ARTICLE{Arhan2006,
+  author = {M. Arhan and A.M. Treguier and B. Bourles and S. Michel},
+  title = {Diagnosing the annual cycle of the Equatorial Undercurrent in the
+	Atlantic Ocean from a general circulation model},
+  journal = JPO,
+  year = {2006},
+  volume = {36},
+  pages = {1502--1522}
+}
+
+@ARTICLE{Artale_al_JGR02,
+  author={V. Artale and D. Iudicone and R. Santoleri and V. Rupolo and S. Marullo
+          and F. {D'O}rtenzio},
+  title={Role of surface fluxes in ocean general circulation models using satellite
+          sea surface temperature: Validation of and sensitivity to the forcing
+          frequency of the Mediterranean thermohaline circulation},
+  journal=JGR,
+  year={2002},
+  volume={107},
+  pages={1978-2012},
+  doi = {10.1029/2000JC000452},
+}
+
+@ARTICLE{ASSELIN_MWR72,
+  author = {R. Asselin},
+  title = {Frequency Filter for Time Integrations},
+  journal = MWR,
+  year = {1972},
+  volume = {100},  number = {6},
+  pages = {487--490}
+}
+
+@ARTICLE{Atmadipoera_al_DSR09,
+  author = {A. Atmadipoera and R. Molcard and G. Madec and S.Wijffels and J.
+	Sprintall and A. Koch-Larrouy and I. Jaya and A. Supangat},
+  title = {Characteristics and Variability of the Indonesian Throughflow Water
+	at the Outflow Straits},
+  journal = DSR,
+  year = {2009},
+  volume = {56},  number = {11},
+  pages = {1942--1954},
+  doi = {10.1016/j.dsr.2009.06.004},
+  url = {http://dx.doi.org/10.1016/j.dsr.2009.06.004}
+}
+
+@ARTICLE{Aumont_al_GBC99,
+  author = {O. Aumont and P. Monfray and J. C. Orr and G. Madec and E. Maier-Reimer},
+  title = {Nutrient trapping in the equatorial Pacific: The ocean circulation solution},
+  journal = GBC,
+  year = {1999},
+  volume = {13},
+  pages = {351--369}
+}
+
+@ARTICLE{Aumont_al_CD98,
+  author = {O. Aumont and J.C. Orr and D. Jamous and P. Monfray and O. Marti and G. Madec},
+  title = {A degradation approach to accelerate simulations to steady state
+	in a 3-D tracer transport model of the global ocean},
+  journal = CD,
+  year = {1998},
+  volume = {14},
+  pages = {101--116}
+}
+
+@ARTICLE{Axell_JGR02,
+  author = {L. B. Axell},
+  title = {Wind-driven internal waves and Langmuir circulations in a numerical ocean model of the southern Baltic Sea},
+  journal = JGR,
+  year = {2002},
+  volume = {107},
+  doi = {10.1029/2001JC000922},
+  url = {http://dx.doi.org/10.1029/2001JC000922}
+}
+
+@ARTICLE{Axell_Liungman_EFM01,
+  author = {L. B. Axell and O. Liungman},
+  title = {A one-equation turbulence model for geophysical applications: 
+  Comparison with data and the k-$\epsilon$ model},
+  journal = EFM,
+  year = {2001},
+  volume = {1}, pages = {71--106},
+  doi = {10.1029/2001JC000922},
+  url = {http://dx.doi.org/10.1029/2001JC000922}
+}
+
+@ARTICLE{Ayina_al_JC06,
+  author = {L.-H. Ayina and A. Bentamy and A. Munes-Mestaz and G. Madec},
+  title = {The Impact of Satellite Winds and Latent Heat Fluxes in a Numerical
+	Simulation of the Tropical Pacific Ocean},
+  journal = JC,
+  year = {2006},
+  volume = {19},
+  pages = {5889--5902}
+}
+
+@ARTICLE{Barnier_al_OD06,
+  author = {B. Barnier and G. Madec and T. Penduff and J.-M. Molines and A.-M.
+	Treguier and J. Le Sommer and A. Beckmann and A. Biastoch and C. Boning 
+	and J. Dengg and C. Derval and E. Durand and S. Gulev and
+	E. Remy and C. Talandier and S. Theetten and M. Maltrud and J. McClean and B. De Cuevas},
+  title = {Impact of partial steps and momentum advection schemes in a global
+	ocean circulation model at eddy-permitting resolution.},
+  journal = OD,
+  year = {2006},
+  volume = {56},
+  pages = {543--567},
+  doi = {10.1007/s10236-006-0082-1},
+  url = {http://dx.doi.org/10.1007/s10236-006-0082-1}
+}
+
+@INCOLLECTION{Barnier1996,
+  author = {B. Barnier and P. Marchesiello and A.P. de Miranda},
+  title = {Modeling the ocean circulation in the South Atlantic: A strategy for dealing with open boundaries},
+  booktitle = {The South Atlantic: Present and Past Circulation},
+  publisher = {Springer-Verlag, Berlin},
+  year = {1996},
+  editor = {G.Wefer and W.H. Berger and G Siedler and D. Webb},
+  pages = {289-304}
+}
+
+@ARTICLE{Barnier1998,
+  author = {B. Barnier and P. Marchesiello and A. P. de Miranda and J.M. Molines
+	and M. Coulibaly},
+  title = {A sigma-coordinate primitive equation model for studying the circulation
+	in the South Atlantic I, Model configuration with error estimates},
+  journal = DSR,
+  year = {1998},
+  volume = {45},
+  pages = {543--572}
+}
+
+@ARTICLE{Barthelet_al_CRAS98,
+  author = {P. Barthelet and S. Bony and P. Braconnot and A. Braum and D. Cariolle
+	and E. Cohen-Solal and J.-L. Dufresne and P. Delecluse and M. D\'{e}qu\'{e}
+	and L. Fairhead and M.-A. Filiberti and M. Forichon and J.-Y. Grandpeix
+	and E. Guilyardi and M.-N. Houssais and M. Imbard and H. Le Treut
+	and C. Lévy and Z.X. Li and G. Madec and P. Marquet and O. Marti
+	and S. Planton and L. Terray and O. Thual and S. Valcke},
+  title = {Global coupled simulations of climate change due to increased atmospheric CO2 concentration},
+  journal = {C. R. Acad. Sci Paris},
+  year = {1998},
+  volume = {326},
+  pages = {677--684}
+}
+
+@ARTICLE{Beckmann2003,
+  author = {A. Beckmann and H. Goosse},
+  title = {A parameterization of ice shelf-ocean interaction for climate models},
+  journal = OM,
+  year = {2003},
+  volume = {5},
+  pages = {157--170}
+}
+
+@ARTICLE{Beckmann1998,
+  author = {A. Beckmann},
+  title = {The representation of bottom boundary layer processes in numerical
+	ocean circulation models.},
+  journal = {Ocean modelling and parameterization, E. P. Chassignet and J. Verron
+	(eds.), NATO Science Series, Kluwer Academic Publishers},
+  year = {1998}
+}
+
+@ARTICLE{Beckmann_Doscher1997,
+  author = {A. Beckmann and R. D\"{o}scher},
+  title = {A method for improved representation of dense water spreading over
+	topography in geopotential-coordinate models},
+  journal = JPO,
+  year = {1997},
+  volume = {27},
+  pages = {581--591}
+}
+
+@ARTICLE{Beckmann1993,
+  author = {A. Beckmann and D. B. Haidvogel},
+  title = {Numerical Simulation of Flow around a Tall Isolated Seamount. 
+   Part I - Problem Formulation and Model Accuracy},
+  journal = JPO,
+  year = {1993},
+  volume = {23},  number = {8},
+  pages = {1736--1753}
+}
+
+@ARTICLE{Bernie_al_CD07,
+  author = {D. Bernie and E. Guilyardi and G. Madec and J. M. Slingo and S. J. Woolnough},
+  title = {Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. Part 1: a diurnally forced OGCM},
+  journal = CD,
+  year = {2007},
+  volume = {29},  number = {6},
+  pages = {575--590}
+}
+
+@ARTICLE{Bernie_al_CD08,
+  author = {D. Bernie and E. Guilyardi and G. Madec and J. M. Slingo and S. J. Woolnough},
+  title = {Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. Part 2: A diurnally coupled CGCM},
+  journal = CD,
+  year = {2008},
+  volume = {31},  number = {7},
+  pages = {909--925},
+  doi = {10.1007/s00382-008-0429-z},
+  url = {http://dx.doi.org/10.1007/s00382-008-0429-z}
+}
+
+@ARTICLE{Bernie_al_JC05,
+  author = {D. J. Bernie and S. J. Woolnough and J. M. Slingo and E. Guilyardi},
+  title = {Modelling diurnal and intraseasonal variability of the ocean mixed
+	layer},
+  journal = JC,
+  year = {2005},
+  volume = {18},  number = {8},
+  pages = {1190--1200}
+}
+
+@ARTICLE{Bessiere_al_GRL08,
+  author = {L. Bessi\'{e}res and G. Madec and F. Lyard},
+  title = {Global Tidal Residual Mean Circulation: Does it Affect a Climate OGCM?},
+  journal = GRL,
+  year = {2008},
+  volume = {35},
+  pages = {L03609},
+  doi = {10.1029/2007GL032644},
+  url = {http://dx.doi.org/10.1029/2007GL032644}
+}
+
+@ARTICLE{Biastoch_al_JC08,
+  author = {A. Biastoch and C. W. Böning and J. Getzlaff and J.-M. Molines and G. Madec},
+  title = {Causes of interannual – decadal variability in the meridional overturning
+	circulation of the mid-latitude North Atlantic Ocean},
+  journal = JC,
+  year = {2008},
+  volume = {21},  number = {24},
+  pages = {6599-6615},
+  doi = {10.1175/2008JCLI2404.1},
+  url = {http://dx.doi.org/10.1175/2008JCLI2404.1}
+}
+
+@ARTICLE{Bignami_al_JGR95,
+  author = {F. Bignami and S. Marullo and R. Santoleri and M. E. Schiano},
+  title = {Longwave radiation budget in the Mediterranean Sea}, 
+  journal = JGR,
+  year = {1995},
+  volume = {100},  number = {C2},
+  pages = {2501--2514},
+  doi = {10.1029/94JC02496},
+}
+
+@ARTICLE{Blanke_al_JPO99,
+  author = {B. Blanke and M. Arhan and G. Madec and S. Roche},
+  title = {Warm Water Paths in the Equatorial Atlantic as Diagnosed with a General Circulation Model},
+  journal = JPO,
+  year = {1999},
+  volume = {29},  number = {11},
+  pages = {2753-2768}
+}
+
+@ARTICLE{Blanke1993,
+  author = {B. Blanke and P. Delecluse},
+  title = {Low frequency variability of the tropical Atlantic ocean simulated
+	by a general circulation model with mixed layer physics},
+  journal = JPO,
+  year = {1993},
+  volume = {23},
+  pages = {1363--1388}
+}
+
+@ARTICLE{blanke_al_JC97,
+  author = {B. Blanke and J. D. Neelin and D. Gutzler},
+  title = {Estimating the effect of stochastic wind forcing on ENSO irregularity},
+  journal = JC,
+  year = {1997},
+  volume = {10},
+  pages = {1473--1486}
+}
+
+@ARTICLE{Blanke_Raynaud_JPO97,
+  author = {B. Blanke and S. Raynaud},
+  title = {Kinematics of the Pacific Equatorial Undercurrent: An Eulerian and
+	Lagrangian Approach from GCM Results},
+  journal = JPO,
+  year = {1997},
+  volume = {27},  number = {6},
+  pages = {1038--1053}
+}
+
+@ARTICLE{Blanke_al_JPO01,
+  author = {B. Blanke and S. Speich and G. Madec and K. Döös},
+  title = {A global Diagnostic of interocean mass transfers},
+  journal = JPO,
+  year = {2001},
+  volume = {31},  number = {6},
+  pages = {1623--1632}
+}
+
+@ARTICLE{Blanke_al_GRL02,
+  author = {B. Blanke and S. Speich and G. Madec and R. Maug\'{e}},
+  title = {A global diagnostic of interior ocean ventilation},
+  journal = GRL,
+  year = {2002},
+  volume = {29},  number = {8},
+  pages = {1081--1084}
+}
+
+@ARTICLE{Blayo2005,
+  author = {E. Blayo and L. Debreu},
+  title = {Revisiting open boundary conditions from the point of view of characteristic
+	variables},
+  journal = OM,
+  year = {2005},
+  volume = {9},
+  pages = {231--252}
+}
+
+@ARTICLE{Bloom_al_MWR96,
+  author = {S. C. Bloom and L. L. Takacs and A. M. Da Silva and D. Ledvina},
+  title = {Data assimilation using incremental analysis updates},
+  journal = MWR,
+  year = {1996},
+  volume = {124},
+  pages = {1256--1271}
+}
+
+@ARTICLE{Bopp_al_GBC01,
+  author = {L. Bopp and P. Monfray and O. Aumont and J.-L. Dufresne and H. Le Treut 
+    and G. Madec and L. Terray and J.C. Orr},
+  title = {Potential impact of climate change on marine export production},
+  journal = GBC,
+  year = {2001},
+  volume = {15},  number = {1},
+  pages = {81--101}
+}
+
+@article{bouffard_Boegman_DAO2013,
+	author = {D. Bouffard and L. Boegman},
+	title = {A diapycnal diffusivity model for stratified environmental flows},
+	volume = {61-62},
+	issn = {03770265},
+	url = {http://dx.doi.org/10.1016/j.dynatmoce.2013.02.002},
+	doi = {10.1016/j.dynatmoce.2013.02.002},
+	journal = DAO,
+	year = {2013},
+	pages = {14--34},
+}
+
+@ARTICLE{Bougeault1989,
+  author = {P. Bougeault and P. Lacarrere},
+  title = {Parameterization of Orography-Induced Turbulence in a Mesobeta--Scale
+	Model},
+  journal = MWR,
+  year = {1989},
+  volume = {117},  number = {8},
+  pages = {1872--1890},
+}
+
+@ARTICLE{Bouillon_al_OM09,
+  author = {S. Bouillon and M.A. Morales Maqueda and V. Legat and T. Fichefet},
+  title = {An Elastic-Viscous-Plastic Sea Ice Model formulated on Arakawa B and C Grids},
+  journal = OM,
+  year = {2009},
+  volume = {27},
+  pages = {174--184},
+  doi = {10.1016/j.ocemod.2009.01.004},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2009.01.004}
+}
+
+@ARTICLE{Boulanger_al_GRL01,
+  author = {J.-P. Boulanger and E. Durand and J.-P. Duvel and C. Menkes and P.
+	Delecluse and M. Imbard and M. Lengaigne and G. Madec and S. Masson},
+  title = {Role of non-linear oceanic processes in the response to westerly
+	wind events: new implications for the 1997 El Niño onset},
+  journal = GRL,
+  year = {2001},
+  volume = {28},  number = {8},
+  pages = {1603--1606}
+}
+
+@article{Brankart_OM2013,
+author = "J.-M. Brankart",
+title = "Impact of uncertainties in the horizontal density gradient upon low resolution global ocean modelling ",
+journal = OM,
+year = "2013",
+volume = "66", pages = "64--76",
+issn = "1463-5003",
+doi = "http://dx.doi.org/10.1016/j.ocemod.2013.02.004",
+url = "http://www.sciencedirect.com/science/article/pii/S1463500313000309",
+}
+
+@Article{Brankart_al_GMD2015,
+AUTHOR = {Brankart, J.-M. and Candille, G. and Garnier, F. and Calone, C. and Melet, A. and Bouttier, P.-A. and Brasseur, P. and Verron, J.},
+TITLE = {A generic approach to explicit simulation of uncertainty in the NEMO ocean model},
+JOURNAL = {Geoscientific Model Development},
+VOLUME = {8},
+YEAR = {2015},
+NUMBER = {5},
+PAGES = {1285--1297},
+URL = {http://www.geosci-model-dev.net/8/1285/2015/},
+DOI = {10.5194/gmd-8-1285-2015}
+}
+
+@ARTICLE{Brodeau_al_OM09,
+  author = {L. Brodeau and B. Barnier and A.-M. Tr\'{e}guier and T. Penduff and S. Gulev},
+  title = {An ERA40-based atmospheric forcing for global ocean circulation models},
+  journal = OM,
+  year = {2009},
+  volume = {31},  number = {3-4},
+  pages = {88--104}
+}
+
+
+@ARTICLE{de_Boyer_Montegut_al_JGR04,
+  author = {C. de Boyer Mont\'{e}gut and G. Madec and A.S. Fischer and A. Lazar and D. Iudicone},
+  title = {Mixed layer depth over the global ocean: An examination of profile
+	data and a profile-based climatology},
+  journal = JGR,
+  year = {2004},
+  volume = {109},
+  pages = {C12003},
+  doi = {10.1029/2004JC002378},
+  url = {http://dx.doi.org/10.1029/2004JC002378}
+}
+
+@ARTICLE{de_Boyer_Montegut_al_JC07,
+  author = {C. de Boyer Mont\'{e}gut and J. Vialard and F. Durand and G. Madec},
+  title = {Simulated seasonal and interannual variability of mixed layer heat
+	budget in the northern Indian Ocean},
+  journal = JC,
+  year = {2007},
+  volume = {20},  number = {13},
+  pages = {3249--3268}
+}
+
+@ARTICLE{Brown_Campana_MWR78,
+  author = {J. A. Brown and K. A. Campana},
+  title = {An Economical Time-Differencing System for Numerical Weather Prediction},
+  journal = MWR,
+  year = {1978},
+  volume = {106},  number = {8},
+  pages = {1125--1136},
+}
+
+@ARTICLE{Bryan1997,
+  author = {K. Bryan},
+  title = {A Numerical Method for the Study of the Circulation of the World Ocean},
+  journal = JCP,
+  year = {1997},
+  volume = {135},  number = {2}
+}
+
+@ARTICLE{Bryan1984,
+  author = {K. Bryan},
+  title = {Accelerating the convergence to equilibrium of ocean-climate models},
+  journal = JPO,
+  year = {1984},
+  volume = {14},
+  pages = {666--673}
+}
+
+@ARTICLE{Bryden1973,
+  author = {H. L. Bryden},
+  title = {New polynomials for thermal expansion, adiabatic temperature gradient
+    and potential temperature of sea water},
+  journal = DSR,
+  year = {1973},
+  volume = {20},
+  pages = {401--408}
+}
+
+@ARTICLE{Burchard_OM02,
+  author = {Hans Burchard},
+  title = {Energy-conserving discretisation of turbulent shear and buoyancy
+	production},
+  journal = OM,
+  year = {2002},
+  volume = {4},  number = {3-4},
+  pages = {347--361},
+  doi = {10.1016/S1463-5003(02)00009-4},
+  url = {http://dx.doi.org/10.1016/S1463-5003(02)00009-4}
+}
+
+@ARTICLE{Campin2004,
+  author = {J.-M. Campin and A. Adcroft and C. Hill and J. Marshall},
+  title = {Conservation of properties in a free-surface model},
+  journal = OM,
+  year = {2004},
+  volume = {6},  number = {3-4},
+  pages = {221--244}
+}
+
+@ARTICLE{Campin_al_OM08,
+  author = {J.-M. Campin and J. Marshall and D. Ferreira},
+  title = {Sea ice-ocean coupling using a rescaled vertical coordinate z*},
+  journal = OM,
+  year = {2008},
+  volume = {24},  number = {1-2},
+  pages = {1--14},
+  doi = {10.1016/j.ocemod.2008.05.005},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2008.05.005}
+}
+
+@ARTICLE{Campin_Goosse_Tel99,
+  author = {J.-M. Campin and H. Goosse},
+  title = {Parameterization of density-driven downsloping flow for a coarse-resolution ocean model in z-coordinate},
+  journal = {Tellus},
+  year = {1999},
+  volume = {51},
+  pages = {412--430}
+}
+
+@ARTICLE{Carrere_Lyard_GRL03,
+  author = {L. Carr\`{e}re and F. Lyard},
+  title = {Modelling the barotropic response of the global ocean to atmospheric
+	wind and pressure forcing - comparisons with observations},
+  journal = GRL,
+  year = {2003},
+  volume = {30},  number = {6},
+  doi = {10.1029/2002GL016473},
+  url = {http://dx.doi.org/10.1029/2002GL016473}
+}
+
+@ARTICLE{Castellari_al_JMS1998,
+  author = {S> Castellari and  N. Pinardi and K. Leaman },
+  title = {A model study of air-sea interactions in the Mediterranean Sea.},
+  journal = JMS,
+  year = {1998},
+  volume = {18},
+  pages = {89--114}
+}
+
+@TECHREPORT{Chanut2005,
+ author = {J. Chanut},
+ title = {Nesting code for NEMO},
+ year = {2005},
+ institution = {European Union: Marine Environment and Security for the European Area (MERSEA) Integrated Project},
+note = {MERSEA-WP09-MERCA-TASK-9.1.1}
+} 
+
+@ARTICLE{Chassignet_al_JPO03,
+  author = {Eric P. Chassignet and Linda T. Smith and George R. Halliwell},
+  title = {North Atlantic Simulations with the Hybrid Coordinate Ocean Model
+	(HYCOM): Impact of the Vertical Coordinate Choice, Reference Pressure, and Thermobaricity},
+  journal = JPO,
+  year = {2003},
+  volume = {33},
+  pages = {2504-2526}
+}
+
+@ARTICLE{Covey_al_CD00,
+  author = {C. Covey and A. Abe-Ouchi and G.J. Boer and B.A. Boville and U. Cubasch
+	and L. Fairhead and G.M. Flato and H. Gordon and E. Guilyardi and X. Jiang 
+	and T.C. Johns and H. Le Treut and G. Madec and G.A. Meehl and R. Miller 
+	and A. Noda and S. B. Power and E. Roeckner and G. Russell and E.K. Schneider 
+	and R.J. Stouffer and L. Terray and J.-S. von Storch},
+  title = {The seasonal cycle in coupled ocean-atmosphere general circulation models},
+  journal = CD,
+  year = {2000},
+  volume = {16},
+  pages = {775--787}
+}
+
+@ARTICLE{Canuto_2001,
+  author = {V. M. Canuto and A. Howard and Y. Cheng and M. S. Dubovikov},
+  title = {Ocean turbulence. PartI: One-point closure model-momentum and heat vertical diffusivities},
+  journal = JPO,
+  year = {2001},
+  volume = {24},  number = {12},
+  pages = {2546--2559}
+}
+
+@ARTICLE{Cox1987,
+  author = {M. Cox},
+  title = {Isopycnal diffusion in a z-coordinate ocean model},
+  journal = OM,
+  year = {1987},
+  volume = {74},
+  pages = {1--9}
+}
+
+@ARTICLE{Craig_Banner_JPO94,
+  author = {P. D. Craig and M. L. Banner},
+  title = {Modeling wave-enhanced turbulence in the ocean surface layer},
+  journal = JPO,
+  year = {1994},
+  volume = {24},  number = {12},
+  pages = {2546--2559}
+}
+
+@ARTICLE{Craik_Leibovich_JFM76,
+  author = {A. D. D. Craik and S. Leibovich},
+  title = {A rational model for Langmuir circulations},
+  journal = JFM,
+  year = {1976},
+  volume = {73}, 
+  pages = {401--426}
+}
+
+@ARTICLE{Cravatte_al_OM07,
+  author = {Cravatte, S. and G. Madec and T. Izumo and C. Menkes and A. Bozec},
+  title = {Progress in the 3-D circulation of the eastern equatorial Pacific
+	in a climate ocean model},
+  journal = OM,
+  year = {2007},
+  volume = {17},  number = {1},
+  pages = {28--48}
+}
+
+@BOOK{Daley_Barker_Bk01,
+  author = {R. Daley and E. Barker},
+  title = {NAVDAS Source Book 2001},
+  publisher = {NRL/PU/7530-01-441, Available from the Naval Research Laboratory, Monterey, CA., 93943-5502},
+  year = {2001},
+  pages = {163pp}
+}
+
+@ARTICLE{D'Alessio_al_JPO98,
+  author = {S. J. D. D'Alessio and K. Abdella and N. A. McFarlane},
+  title = {A new second-order turbulence closure scheme for modeling the oceanic mixed layer},
+  journal = JPO,
+  year = {1998},
+  volume = {28},
+  pages = {1624--1641}
+}
+
+
+@ARTICLE{Danabasoglu_al_2008,
+	author = {G. Danabasoglu and R. Ferrari and J. C. McWilliams},
+	title = {Sensitivity of an ocean general circulation model to a parameterization of near-surface eddy fluxes},
+	volume = {21},
+	year = {2008},
+	doi = {10.1175/2007JCLI1508.1},
+	journal = {J. Climate},
+	pages = {1192--1208},
+        url = {http://dx.doi.org/10.1175/2007JCLI1508.1}
+}
+@ARTICLE{Dandonneau_al_S04,
+  author = {Y. Dandonneau and C. Menkes and T. Gorgues and G. Madec},
+  title = {Reply to Peter Killworth, 2004 : '' Comment on the Oceanic Rossby
+	Waves acting as a “Hay Rake” for ecosystem by-products ''},
+  journal = {Science},
+  year = {2004},
+  volume = {304},
+  pages = {390}
+}
+
+@ARTICLE{Davies_QJRMS76,
+ author = {H.C. Davies},
+ title = {A lateral boundary formulation for multi-level prediction models},
+ year = {1976},
+ journal = QJRMS,
+ volume = {102},
+ pages = {405--418}
+}
+
+@ARTICLE{Debreu_al_CG2008,
+  author = {L. Debreu and C. Vouland and E. Blayo},
+  title = {AGRIF: Adaptive Grid Refinement In Fortran},
+  journal = {Computers and Geosciences},
+  year = {2008},
+  volume = {34},
+  pages = {8--13}
+}
+
+@article{de_lavergne_JPO2016_mixing,
+	author = {C. de Lavergne and G. Madec and J. Le Sommer and A. J. G. Nurser and A. C. Naveira Garabato },
+	title = {On Antarctic Bottom Water consumption in the abyssal ocean},
+	issn = {0022-3670},
+	url = {http://dx.doi.org/10.1175/JPO-D-14-0201.1},
+	doi = {10.1175/JPO-D-14-0201.1},
+	abstract = {In studies of ocean mixing, it is generally assumed that small-scale turbulent overturns lose 15-20 \% of their energy in eroding the background stratification. Accumulating evidence that this energy fraction, or mixing efficiency Rf, significantly varies depending on flow properties challenges this assumption, however. Here, we examine the implications of a varying mixing efficiency for ocean energetics and deep water mass transformation. Combining current parameterizations of internal wave-driven mixing with a recent model expressing Rf as a function of a turbulence intensity parameter Reb = εν/νN2, we show that accounting for reduced mixing efficiencies in regions of weak stratification or energetic turbulence (high Reb) strongly limits the ability of breaking internal waves to supply oceanic potential energy and drive abyssal upwelling. Moving from a fixed Rf = 1/6 to a variable efficiency Rf(Reb) causes Antarctic Bottom Water upwelling induced by locally-dissipating internal tides and lee waves to fall from 9 to 4 Sv, and the corresponding potential energy source to plunge from 97 to 44 GW. When adding the contribution of remotely-dissipating internal tides under idealized distributions of energy dissipation, the total rate of Antarctic Bottom Water upwelling is reduced by about a factor of 2, reaching 5-15 Sv compared to 10-33 Sv for a fixed efficiency. Our results suggest that distributed mixing, overflow-related boundary processes and geothermal heating are more effective in consuming abyssal waters than topographically-enhanced mixing by breaking internal waves. Our calculations also point to the importance of accurately constraining Rf(Reb) and including the effect in ocean models.},
+	journal = {Journal of Physical Oceanography},
+	year = {2016},
+	volume = {46},  pages = {635-–661}
+}
+
+@article{de_lavergne_JPO2016_efficiency,
+	author = {C. de Lavergne and G. Madec and J. Le Sommer and A. J. G. Nurser and A. C. Naveira Garabato },
+	title = {The impact of a variable mixing efficiency on the abyssal overturning},
+	issn = {0022-3670},
+	url = {http://dx.doi.org//10.1175/JPO-D-14-0259.1},
+	doi = {10.1175/JPO-D-14-0259.1},
+	abstract = {In studies of ocean mixing, it is generally assumed that small-scale turbulent overturns lose 15-20 \% of their energy in eroding the background stratification. Accumulating evidence that this energy fraction, or mixing efficiency Rf, significantly varies depending on flow properties challenges this assumption, however. Here, we examine the implications of a varying mixing efficiency for ocean energetics and deep water mass transformation. Combining current parameterizations of internal wave-driven mixing with a recent model expressing Rf as a function of a turbulence intensity parameter Reb = εν/νN2, we show that accounting for reduced mixing efficiencies in regions of weak stratification or energetic turbulence (high Reb) strongly limits the ability of breaking internal waves to supply oceanic potential energy and drive abyssal upwelling. Moving from a fixed Rf = 1/6 to a variable efficiency Rf(Reb) causes Antarctic Bottom Water upwelling induced by locally-dissipating internal tides and lee waves to fall from 9 to 4 Sv, and the corresponding potential energy source to plunge from 97 to 44 GW. When adding the contribution of remotely-dissipating internal tides under idealized distributions of energy dissipation, the total rate of Antarctic Bottom Water upwelling is reduced by about a factor of 2, reaching 5-15 Sv compared to 10-33 Sv for a fixed efficiency. Our results suggest that distributed mixing, overflow-related boundary processes and geothermal heating are more effective in consuming abyssal waters than topographically-enhanced mixing by breaking internal waves. Our calculations also point to the importance of accurately constraining Rf(Reb) and including the effect in ocean models.},
+	journal = {Journal of Physical Oceanography},
+	year = {2016},
+	volume = {46},  pages = {663-–681}
+}
+
+@ARTICLE{Delecluse_Madec_Bk00,
+  author = {P. Delecluse and G. Madec},
+  title = {Ocean modelling and the role of the ocean in the climate system},
+  journal = {In \textit{Modeling the Earth's Climate and its Variability}, Les
+	Houches, Session, LXVII 1997,
+	Eds. W. R. Holland, S. Joussaume and F. David, Elsevier Science},
+  year = {2000},
+  pages = {237--313}
+}
+
+@PHDTHESIS{Demange_PhD2014,
+  author = {J. Demange},
+  title = {Sch\'{e}́mas num\'{e}́riques d'advection et de propagation d’ondes de gravit\'{e}́ 
+           dans les mod\`{e}les de circulation oc\'{e}́anique.},
+  school = {Doctorat es Applied Mathematiques, Grenoble University, France},
+  year = {2014},
+  pages = {138pp}
+}
+
+@ARTICLE{Dobricic_al_OS07,
+  author = {S. Dobricic and N. Pinardi and M. Adani and M. Tonani and 
+            C. Fratianni and A. Bonazzi and V. Fernandez},
+  title = {Daily oceanographic analysis by the Mediterranean basin scale 
+           assimilation system},
+  journal = OS,
+  year = {2007},
+  volume = {3},
+  pages = {149-157}
+}
+
+@ARTICLE{Doney_al_GBC04,
+  author = {S.C. Doney and K. Lindsay and K. Caldeira and J.−M. Campin and H.
+	Drange and J.−C. Dutay and M. Follows and Y. Gao and A. Gnanadesikan
+	and N. Gruber and A. Ishida and F. Joos and G. Madec and E. Maier−Reimer
+	and J.C. Marshall and R.J. Matear and P. Monfray and A. Mouchet and
+	R. Najjar and J.C. Orr and G.−K. Plattner and J. Sarmiento and R.
+	Schlitzer and R. Slater and I.J. Totterdell and M.−F. Weirig and
+	Y. Yamanaka and A. Yoo},
+  title = {Evaluating global ocean carbon models: the importance of realistic
+	physics},
+  journal = GBC,
+  year = {2004},
+  volume = {18},
+  pages = {GB3017},
+  doi = {10.1029/2003GB002150},
+  url = {http://dx.doi.org/10.1029/2003GB002150}
+}
+
+@ARTICLE{Dorscher_Beckmann_JAOT00,
+  author = {R. D\"{o}scher and A. Beckmann},
+  title = {Effects of a Bottom Boundary Layer Parameterization in a Coarse-Resolution
+	Model of the North Atlantic Ocean},
+  journal = JAOT,
+  year = {2000},
+  volume = {17},
+  pages = {698--707}
+}
+
+@ARTICLE{Drijfhout_JPO94,
+  author = {S. S. Drijfhout},
+  title = {Heat transport by Mesoscale Eddies in an Ocean Circulation Model},
+  journal = JPO,
+  year = {1994},
+  volume = {24},
+  pages = {353--369}
+}
+
+@ARTICLE{Dukowicz1994,
+  author = {J. K. Dukowicz and R. D. Smith},
+  title = {Implicit free-surface method for the Bryan-Cox-Semtner ocean model},
+  journal = JGR,
+  year = {1994},
+  volume = {99},
+  pages = {7991--8014}
+}
+
+@ARTICLE{Durand_al_JC07,
+  author = {F. Durand and D. Shankar and C. de Boyer Mont\'{e}gut and S.S.C.
+	Shenoi and B. Blanke and G. Madec},
+  title = {Modeling the barrier-layer formation in the South-Eastern Arabian
+	Sea},
+  journal = JC,
+  year = {2007},
+  volume = {20},  number = {10},
+  pages = {2109--2120}
+}
+
+@ARTICLE{Durand_al_GRL04,
+  author = {F. Durand and S. R. Shetye and J. Vialard and D. Shankar and S.S.C.
+	Shenoi and C. Eth\'{e} and G. Madec},
+  title = {Impact of temperature inversions on SST evolution in the South−Eastern
+	Arabian Sea during the pre−summer monsoon season},
+  journal = GRL,
+  year = {2004},
+  volume = {31},
+  pages = {L01305},
+  doi = {10.1029/2003GL018906},
+  url = {http://dx.doi.org/10.1029/2003GL018906}
+}
+
+@INCOLLECTION{Durran2001,
+  author = {D.R. Durran },
+  title = {Open boundary conditions: fact and fiction},
+  booktitle = {Advances in Mathematical Modelling of Atmosphere and Ocean Dynamics},
+  publisher = {Kluwer Academic Publishers},
+  year = {2001},
+  editor = {P.F. Hodnett}
+}
+
+@ARTICLE{Dutay_al_OM02,
+  author = {J.-C. Dutay and J.L. Bullister and S.C. Doney and J.C. Orr and R.
+	Najjar and K. Caldeira and J.-M. Campin and H. Drange and M. Follows
+	and Y. Gao and N. Gruber and M. W. Hecht and A. Ishida and F. Joos
+	and K. Lindsay and G. Madec and E. Maier-Reimer and J.C. Mashall
+	and R. J. Matear and P. Monfray and G.-K. Plattner and J. Sarmiento
+	and R. Schlitzer and R. Slater and I.J. Totterdell and M.-F. Weirig
+	and Y. Yamanaka and A. Tool},
+  title = {Evaluation of ocean model ventilation with CFC-11: comparison of
+	13 global ocean models},
+  journal = OM,
+  year = {2002},
+  volume = {4},
+  pages = {89--120}
+}
+
+@ARTICLE{Dutay_al_EFM09,
+  author = {J.-C. Dutay and J. Emile-Geay and D. Iudicone and P. Jean-Baptiste
+	and G. Madec and C. Carouge},
+  title = {Helium Isotopic Constraints on Simulated Ocean Circulations - Implications
+	for abyssal theories},
+  journal = EFM,
+  year = {2009},
+  volume = {10},  number = {1-2},
+  pages = {257--273},
+  url = {http://dx.doi.org/10.1007/s10652-009-9159-y}
+}
+
+@ARTICLE{Dutay.J.C2004,
+  author = {J. -C. Dutay and P. J. -Baptiste and J. -M. Campin and A. Ishida
+	and E. M. -Reimer and R. J. Matear and A. Mouchet and I. J. Totterdell
+	and Y. Yamanaka and K. Rodgers and G. Madec and J.C. Orr},
+  title = {Evaluation of OCMIP-2 ocean models deep circulation with mantle helium-3},
+  journal = JMS,
+  year = {2004},
+  pages = {1--22}
+}
+
+@ARTICLE{D'Ortenzio_al_GRL05,
+  author = {F. D\'Ortenzio and D. Iudicone and C. de Boyer Mont\'{e}gut and P.
+	Testor and D. Antoine and S. Marullo and R. Santoleri and G. Madec},
+  title = {Seasonal variability of the mixed layer depth in the Mediterranean
+	Sea : a new climatology based on analysis of individual profiles},
+  journal = GRL,
+  year = {2005},
+  volume = {32},
+  pages = {L12605},
+  doi = {10.1029/2005GL022463},
+  url = {http://dx.doi.org/10.1029/2005GL022463}
+}
+
+@ARTICLE{Egbert_Ray_JGR01,
+  author = {G.B. Egbert and R.D. Ray},
+  title = {Estimates of M2 tidal energy dissipation from TOPEX/POSEIDON altimeter
+	data},
+  journal = JGR,
+  year = {2001},
+  volume = {106},
+  pages = {22475--22502}
+}
+
+@ARTICLE{Egbert_Ray_Nat00,
+  author = {G.B. Egbert and R.D Ray},
+  title = {Significant dissipation of tidal energy in the deep ocean inferred
+	from satellite altimeter data},
+  journal = {Nature},
+  year = {2000},
+  volume = {405},
+  pages = {775--778}
+}
+
+@ARTICLE{Eiseman1980,
+  author = {P. R. Eiseman and A. P. Stone},
+  title = {Conservation lows of fluid dynamics -- A survey},
+  journal = {SIAM Review},
+  year = {1980},
+  volume = {22},
+  pages = {12--27}
+}
+
+@ARTICLE{Emile-Geay_Madec_OS09,
+  author = {J. Emile-Geay and G. Madec},
+  title = {Geothermal heating, diapycnal mixing and the abyssal circulation},
+  journal = OS,
+  year = {2009},
+  volume = {5},
+  pages = {281--325}
+}
+
+@ARTICLE{Engerdahl_Tel95,
+ author = {H. Engerdahl},
+ year = {1995},
+ title = {Use of the flow relaxation scheme in a three-dimensional baroclinic ocean model with realistic topography},
+ journal = {Tellus},
+ volume = {47A},
+ pages = {365--382}
+}
+
+@ARTICLE{EUROMODEL_OA95,
+  author = {EUROMODEL Group (P.M. Lehucher, L. Beautier, M. Chartier, F. Martel,
+	L. Mortier, P. Brehmer, C. Millot, C. Alberola, M. Benzhora, I. Taupier-Letage,
+	G. Chabert d'Hieres, H. Didelle, P. Gleizon, D. Obaton, M. Cr\'{e}pon,
+	C. Herbaut, G. Madec, S. Speich, J. Nihoul, J. M. Beckers, P. Brasseur,
+	E. Deleersnijder, S. Djenidi, J. Font, A. Castellon, E. Garcia-Ladona,
+	M. J. Lopez-Garcia, M. Manriquez, M. Maso, J. Salat, J. Tintore,
+	S. Alonso, D. Gomis, A. Viudez, M. Astraldi, D. Bacciola, M. Borghini,
+	F. Dell'amico, C. Galli, E. Lazzoni, G. P. Gasparini, S. Sparnocchia,
+	and A. Harzallah, 1995 : Progress from 1989 to 1992 in understanding
+	the circulation of the Western Mediterranean Sea. Oceanologica Acta,
+	18, 2, 255-271.},
+  title = {EUROMODEL Group (P.M. Lehucher, L. Beautier, M. Chartier, F. Martel,
+	L. Mortier, P. Brehmer, C. Millot, C. Alberola, M. Benzhora, I. Taupier-Letage,
+	G. Chabert d'Hieres, H. Didelle, P. Gleizon, D. Obaton, M. Cr\'{e}pon,
+	C. Herbaut, G. Madec, S. Speich, J. Nihoul, J. M. Beckers, P. Brasseur,
+	E. Deleersnijder, S. Djenidi, J. Font, A. Castellon, E. Garcia-Ladona,
+	M. J. Lopez-Garcia, M. Manriquez, M. Maso, J. Salat, J. Tintore,
+	S. Alonso, D. Gomis, A. Viudez, M. Astraldi, D. Bacciola, M. Borghini,
+	F. Dell'amico, C. Galli, E. Lazzoni, G. P. Gasparini, S. Sparnocchia,
+	and A. Harzallah, 1995 : Progress from 1989 to 1992 in understanding
+	the circulation of the Western Mediterranean Sea.},
+  journal = {Oceanologica Acta},
+  year = {1995},
+  volume = {18},  number = {2},
+  pages = {255--271}
+}
+
+@PHDTHESIS{Farge1987,
+  author = {M. Farge},
+  title = {Dynamique non lineaire des ondes et des tourbillons dans les equations de Saint Venant},
+  school = {Doctorat es Mathematiques, Paris VI University, France},
+  year = {1987},
+  pages = {401pp}
+}
+
+@ARTICLE{Farrow1995,
+  author = {D. E. Farrow and D. P. Stevens},
+  title = {A new tracer advection scheme for Bryan--Cox type ocean general circulation
+	models},
+  journal = JPO,
+  year = {1995},
+  volume = {25},
+  pages = {1731--1741.}
+}
+
+@ARTICLE{Flather1976,
+ author = {R.A. Flather},
+ year = {1976},
+ title = {A tidal model of the north-west European continental shelf},
+ journal = {Memoires de la Societ\'{e} Royale des Sciences de Li\`{e}ge},
+ volume = {6},
+ pages = {141--164}
+}
+
+@ARTICLE{Flather_JPO94,
+ author = {R.A. Flather},
+ year = {1994},
+ title = {A storm surge prediction model for the northern Bay of Bengal with application to the cyclone disaster in April 1991},
+ journal = JPO,
+ volume = {24},
+ pages = {172--190}
+}
+
+@ARTICLE{Fujio1991,
+  author = {S. Fujio and N. Imasato},
+  title = {Diagnostic calculation for circulation and water mass movement in
+	the deep Pacific},
+  journal = JGR,
+  year = {1991},
+  volume = {96},
+  pages = {759--774}
+}
+
+@ARTICLE{Galperin_al_JAS88,
+  author = {B. Galperin and L. H. Kantha and S. Hassid and A. Rosati},
+  title = {A quasi-equilibrium turbulent energy model for geophysical flows},
+  journal = JAS,
+  year = {1988},
+  volume = {45},
+  pages = {55--62}
+}
+
+@ARTICLE{Gargett1984,
+  author = {A. E. Gargett},
+  title = {Vertical eddy diffusivity in the ocean interior},
+  journal = JMR,
+  year = {1984},
+  volume = {42}
+}
+
+@ARTICLE{Gaspar1990,
+  author = {P. Gaspar and Y. Gr{\'e}goris and J.-M. Lefevre},
+  title = {A simple eddy kinetic energy model for simulations of the oceanic vertical mixing\: 
+    Tests at Station Papa and long-term upper ocean study site},
+  journal = JGR,
+  year = {1990},
+  volume = {95},  number = {C9}
+}
+
+@ARTICLE{Gent1990,
+  author = {P. R. Gent and J. C. Mcwilliams},
+  title = {Isopycnal Mixing in Ocean Circulation Models},
+  journal = JPO,
+  year = {1990},
+  volume = {20},  number = {1},
+  pages = {150--155},
+}
+
+@Article{Gentemann_al_JGR09,
+  author = 	 {C. L. Gentemann  and P. J. Minnett and B. Ward},
+  title =        {Profiles of Ocean Surface heating ({POSH}): A new model 
+                  of upper ocean diurnal warming},
+  journal = 	 JGR,
+  year = 	 {2009},
+  Volume = 	 {114},
+  Pages = 	 {C07017},
+  doi = 	 {10.1029/2008JC004825},
+  OPTannote = 	 {}
+}
+
+@ARTICLE{Gerdes1993a,
+  author = {R. Gerdes},
+  title = {A primitive equation ocean circulation model using a general vertical
+	coordinate transformation 1. Description and testing of the model},
+  journal = JGR,
+  year = {1993},
+  volume = {98}
+}
+
+@ARTICLE{Gerdes1993b,
+  author = {R. Gerdes},
+  title = {A primitive equation ocean circulation model using a general vertical
+	coordinate transformation 2. Application to an overflow problem},
+  journal = JGR,
+  year = {1993},
+  volume = {98},
+  pages = {14703--14726}
+}
+@ARTICLE{Gerdes1991,
+	Author = {Gerdes, R{\"u}diger and K{\"o}berle, Cornelia and Willebrand, J{\"u}rgen},
+	Doi = {10.1007/BF00210006},
+	Journal = {Clim. Dynamics},
+	Number = {4},
+	Pages = {211--226},
+	Title = {The influence of numerical advection schemes on the results of ocean general circulation models},
+	Url = {http://dx.doi.org/10.1007/BF00210006},
+	Volume = {5},
+	Year = {1991},
+}
+@TECHREPORT{Gibson_TR86,
+  author = {J. K. Gibson},
+  title = {Standard software development and maintenance},
+  institution = {Operational Dep., ECMWF, Reading, UK.},
+  year = {1986}
+}
+
+@BOOK{Gill1982,
+  title = {Atmosphere-Ocean Dynamics},
+  publisher = {International Geophysics Series, Academic Press, New-York},
+  year = {1982},
+  author = {A. E. Gill}
+}
+
+@article{goff_JGR2010,
+	author = {J. A. Goff},
+	title = {Global prediction of abyssal hill root-mean-square heights from small-scale altimetric gravity variability},
+	issn = {2156-2202},
+	url = {http://dx.doi.org/10.1029/2010JB007867},
+	doi = {10.1029/2010JB007867},
+	abstract = {Abyssal hills, which are pervasive landforms on the seafloor of the Earth's oceans, represent a potential tectonic record of the history of mid-ocean ridge spreading. However, the most detailed global maps of the seafloor, derived from the satellite altimetry-based gravity field, cannot be used to deterministically characterize such small-scale ({\textless}10 km) morphology. Nevertheless, the small-scale variability of the gravity field can be related to the statistical properties of abyssal hill morphology using the upward continuation formulation. In this paper, I construct a global prediction of abyssal hill root-mean-square (rms) heights from the small-scale variability of the altimetric gravity field. The abyssal hill-related component of the gravity field is derived by first masking distinct features, such as seamounts, mid-ocean ridges, and continental margins, and then applying a newly designed adaptive directional filter algorithm to remove fracture zone/discontinuity fabric. A noise field is derived empirically by correlating the rms variability of the small-scale gravity field to the altimetric noise field in regions of very low relief, and the noise variance is subtracted from the small-scale gravity variance. Suites of synthetically derived, abyssal hill formed gravity fields are generated as a function of water depth, basement rms heights, and sediment thickness and used to predict abyssal hill seafloor rms heights from corrected small-scale gravity rms height. The resulting global prediction of abyssal hill rms heights is validated qualitatively by comparing against expected variations in abyssal hill morphology and quantitatively by comparing against actual measurements of rms heights. Although there is scatter, the prediction appears unbiased.},
+	volume = {115},
+	number = {B12},
+	journal = {Journal of Geophysical Research: Solid Earth},
+	year = {2010},
+	pages = {B12104},
+}
+
+@ARTICLE{Goosse_al_JGR99,
+  author = {H. Goosse and E. Deleersnijder and T. Fichefet and M. England},
+  title = {Sensitivity of a global coupled ocean-sea ice model to the parameterization of vertical mixing},
+  journal = JGR,
+  year = {1999},
+  volume = {104},
+  pages = {13,681--13,695}
+}
+
+@ARTICLE{Gorgues_al_GRL07,
+  author = {T. Gorgues and C. Menkes and O. Aumont and K. Rodgers and G. Madec and Y. Dandonneau},
+  title = {Indonesian Throughflow control of the eastern equatorial Pacific biogeochemistry},
+  journal = GRL,
+  year = {2007},
+  volume = {34},
+  pages = {L05609},
+  doi = {10.1029/2006GL028210},
+  url = {http://dx.doi.org/10.1029/2006GL028210}
+}
+
+@ARTICLE{Graham_McDougall_JPO13,
+  author = {F.S. Graham and T.J. McDougall},
+  title = {Quantifying the nonconservative production of conservative temperature, potential temperature, and entropy},
+  journal = JPO,
+  year = {2013},
+  volume = {43},
+  pages = {838--862},
+  url ={http://dx.doi.org/10.1175/JPO-D-11-0188.1}
+}
+
+@ARTICLE{Greatbatch_JGR94,
+  author = {R. J. Greatbatch},
+  title = {A note on the representation of steric sea level in models that conserve
+	volume rather than mass},
+  journal = JGR,
+  year = {1994},
+  volume = {99},  number = {C6},
+  pages = {12,767--12,771}
+}
+
+@BOOK{Griffies_Bk04,
+  title = {Fundamentals of ocean climate models},
+  publisher = {Princeton University Press, 434pp},
+  year = {2004},
+  author = {S.M. Griffies}
+}
+
+@ARTICLE{Griffies_JPO98,
+  author = {S.M. Griffies},
+  title = {The Gent-McWilliams skew-flux},
+  journal = JPO,
+  year = {1998},
+  volume = {28},
+  pages = {831--841}
+}
+
+@ARTICLE{Griffies_al_OM09,
+  author = {S.M. Griffies and A. Biastoch and C. Boning and F. Bryan and G. Danabasoglu
+	and E. P. Chassignet and M. H. England and R. Gerdes and H. Haak
+	and R. W. Hallberg and W. Hazeleger and J. Jungclaus and W. G. Large
+	and G. Madec and A. Pirani and B. L. Samuels and M. Scheinert and
+	A. Sen Gupta and C. A. Severijns and H. L. Simmons and A.-M. Treguier
+	and M. Winton and S. Yeager and J. Yin},
+  title = {Coordinated Ocean-ice Reference Experiments (COREs)},
+  journal = OM,
+  year = {2009},
+  volume = {26},  number = {1-2},
+  pages = {1--46},
+  doi = {10.1016/j.ocemod.2008.08.007},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2008.08.007}
+}
+
+@ARTICLE{Griffies_al_OS05,
+  author = {S.M. Griffies and A. Gnanadesikan and K.W. Dixon and J.P. Dunne and
+	R. Gerdes and M.J. Harrison and A. Rosati and J.L. Russell and B.L.
+	Samuels and M.J. Spelman and M. Winton and R. Zhang},
+  title = {Formulation of an ocean model for global climate simulations},
+  journal = OS,
+  year = {2005},
+  volume = {1},
+  pages = {45--79}
+  }
+
+@ARTICLE{Griffies_al_JPO98,
+  author = {S.M. Griffies and A. Gnanadesikan and R.C. Pacanowski and V.D. Larichev
+	and J.K. Dukowicz and R.D. Smith},
+  title = {Isoneutral Diffusion in a z-Coordinate Ocean Model},
+  journal = JPO,
+  year = {1998},
+  volume = {28},  number = {5},
+  pages = {805--830},
+}
+
+@ARTICLE{Griffies_al_MWR01,
+  author = {S.M. Griffies and R.C. Pacanowski and M. Schmidt and V. Balaji},
+  title = {Tracer Conservation with an Explicit Free Surface Method for z-Coordinate
+	Ocean Models},
+  journal = MWR,
+  year = {2001},
+  volume = {129},  number = {5},
+  pages = {1081--1098},
+}
+
+@ARTICLE{Griffies_Hallberg_MWR00,
+  author = {S.M. Griffies and R.W. Hallberg},
+  title = {Biharmonic friction with a Smagorinsky-like viscosity for use in large-scale eddy-permitting ocean models},
+  journal = MWR,
+  year = {2000},
+  volume = {128},  
+  pages = {2935–-2946},
+ url = {http://dx.doi.org/10.1175/1520-0493(2000)128}
+}
+
+@ARTICLE{Guilyardi_al_JC04,
+  author = {E. Guilyardi and S. Gualdi and J. M. Slingo and A. Navarra and P. Delecluse 
+    and J. Cole and G. Madec and M. Roberts and M. Latif and L. Terray},
+  title = {Representing El Ni\~{n}o in coupled ocean-atmosphere GCMs: the dominant role of the atmospheric component},
+  journal = JC,
+  year = {2004},
+  volume = {17},
+  pages = {4623--4629}
+}
+
+@ARTICLE{Guilyardi_Madec_CD98,
+  author = {E. Guilyardi and G. Madec},
+  title = {Performance of the OPA-ARPEGE-T21 global ocean-atmosphere coupled model},
+  journal = CD,
+  year = {1997},
+  volume = {13},
+  pages = {149--165}
+}
+
+@ARTICLE{Guilyardi_al_CD01,
+  author = {E. Guilyardi and G. Madec and L. Terray},
+  title = {The role of lateral ocean physics in the upper ocean thermal balance of a coupled ocean-atmosphere GCM},
+  journal = CD,
+  year = {2001},
+  volume = {17},
+  pages = {589--599},
+  number = {8}
+}
+
+@ARTICLE{Guilyardi_al_CRAS95,
+  author = {E. Guilyardi and G. Madec and L. Terray and M. D\'{e}qu\'{e} and
+	M. Pontaud and M. Imbard and D. Stephenson and M.-A. Filiberti and
+	D. Cariolle and P. Delecluse and O. Thual},
+  title = {Simulation couplée océan-atmosphère de la variabilité du climat},
+  journal = {C. R. Acad. Sci Paris},
+  year = {1995},
+  volume = {320},  number = {s\'{e}rie IIa},
+  pages = {683--690}
+}
+
+@ARTICLE{Guyon_al_EP99,
+  author = {M. Guyon and G. Madec and F.-X. Roux and M. Imbard},
+  title = {A Parallel ocean model for high resolution studies},
+  journal = {Lecture Notes in Computer Science},
+  year = {1999},
+  volume = {Euro-Par'99},
+  pages = {603--607}
+}
+
+@ARTICLE{Guyon_al_CalPar99,
+  author = {M. Guyon and G. Madec and F.-X. Roux and M. Imbard and C. Herbaut
+	and P. Fronier},
+  title = {Parallelization of the OPA ocean model},
+  journal = {Calculateurs Paralleles},
+  year = {1999},
+  volume = {11},  number = {4},
+  pages = {499--517}
+}
+
+@BOOK{Haltiner1980,
+  title = {Numerical prediction and dynamic meteorology},
+  publisher = {John Wiley {\&} Sons Eds., second edition},
+  year = {1980},
+  author = {G. J. Haltiner and R. T. Williams},
+  pages = {477pp}
+}
+
+@ARTICLE{Haney1991,
+  author = {R. L. Haney},
+  title = {On the Pressure Gradient Force over Steep Topography in Sigma Coordinate Ocean Models},
+  journal = JPO,
+  year = {1991},
+  volume = {21},  number = {4},
+  pages = {610--619},
+}
+
+@ARTICLE{Hazeleger_Drijfhout_JPO98,
+  author = {W. Hazeleger and S. S. Drijfhout},
+  title = {Mode water variability in a model of the subtropical gyre: response to anomalous forcing},
+  journal = JPO,
+  year = {1998},
+  volume = {28},
+  pages = {266--288},
+}
+
+@ARTICLE{Hazeleger_Drijfhout_JPO99,
+  author = {W. Hazeleger and S. S. Drijfhout},
+  title = {Stochastically forced mode water variability},
+  journal = JPO,
+  year = {1999},
+  volume = {29},
+  pages = {1772--1786},
+}
+
+@ARTICLE{Hazeleger_Drijfhout_JGR00,
+  author = {W. Hazeleger and S. S. Drijfhout},
+  title = {A model study on internally generated variability in subtropical mode water formation},
+  journal = JGR,
+  year = {2000},
+  volume = {105},
+  pages = {13,965--13,979},
+}
+@ARTICLE{Hazeleger_Drijfhout_JPO00,
+  author = {W. Hazeleger and S. S. Drijfhout},
+  title = {Eddy subduction in a model of the subtropical gyre},
+  journal = JPO,
+  year = {2000},
+  volume = {30},
+  pages = {677--695},
+}
+
+@ARTICLE{Hellerman_Rosenstein_JPO83,
+  author = {S. Hellerman and  M. Rosenstein },
+  title = {Normal monthly wind stress over the world ocean with error estimates},
+  journal = JPO,
+  year = {1983},
+  volume = {13},
+  pages = {1093--1104},
+}
+
+@ARTICLE{He_Ding_JSC01,
+  author = {Y. He and C. H. Q. Ding},
+  title = {Using Accurate Arithmetics to Improve Numerical Reproducibility and Stability in Parallel Applications},
+  journal = JSC,
+  year = {2001},
+  volume = {18},
+  pages = {259--277},
+}
+
+@ARTICLE{Hirt_al_JCP74,
+  author = {C. W. Hirt and A. A. Amsden and J. L. Cook},
+  title = {An Arbitrary Lagrangian--Eulerian Computing Method for All Flow Speeds},
+  journal = JCP,
+  year = {1974},
+  volume = {14},
+  pages = {227--253}
+}
+
+@ARTICLE{Hofmeister_al_OM09,
+  author = {R. Hofmeister and H. Burchard and J.-M. Beckers},
+  title = {Non-uniform adaptive vertical grids for 3D numerical ocean models},
+  journal = OM,
+  year = {2009},
+  volume = {33},
+  pages = {70--86},
+  doi = {10.1016/j.ocemod.2009.12.003},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2009.12.003},
+  issn = {1463-5003},
+}
+
+@ARTICLE{Holland1999, 
+  author = {D. Holland and A. Jenkins},
+  title = {Modeling Thermodynamic Ice-Ocean Interactions at the Base of an Ice Shelf},
+  journal = JPO,
+  year = {1999},
+  volume = {29},  
+  pages = {1787--1800},
+}
+
+@ARTICLE{HollowayOM86,
+  author = {Greg Holloway},
+  title = {A Shelf Wave/Topographic Pump Drives Mean Coastal Circulation (part I)},
+  journal = OM,
+  year = {1986},
+  volume = {68},  
+}
+
+@ARTICLE{HollowayJPO92,
+  author = {Greg Holloway},
+  title = {Representing Topographic Stress for Large-Scale Ocean Models},
+  journal = JPO,
+  year = {1992},
+  volume = {22},  
+  pages = {1033--1046},
+}
+
+@ARTICLE{HollowayJPO94,
+  author = {Michael Eby and Greg Holloway},
+  title = {Sensitivity of a Large-Scale Ocean Model to a Parameterization of Topographic Stress},
+  journal = JPO,
+  year = {1994},
+  volume = {24},  
+  pages = {2577--2587},
+}
+
+@ARTICLE{HollowayJGR09,
+  author = {Greg Holloway and Zeliang Wang},
+  title = {Representing eddy stress in an Arctic Ocean model},
+  journal = JGR,
+  year = {2009},
+  doi = {10.1029/2008JC005169},  
+}
+
+@ARTICLE{HollowayOM08,
+  author = {Mathew Maltrud and Greg Holloway},
+  title = {Implementing biharmonic neptune in a global eddying ocean model},
+  journal = OM,
+  year = {2008},
+  volume = {21},  
+  pages = {22--34},
+}
+
+@ARTICLE{Hordoir_al_CD08,
+  author = {R. Hordoir and J. Polcher and J.-C. Brun-Cottan and G. Madec},
+  title = {Towards a parametrization of river discharges into ocean general
+	circulation models: a closure through energy conservation},
+  journal = CD,
+  year = {2008},
+  volume = {31},  number = {7-8},
+  pages = {891--908},
+  doi = {10.1007/s00382-008-0416-4},
+  url = {http://dx.doi.org/10.1007/s00382-008-0416-4}
+}
+
+@ARTICLE{Hsu1990,
+  author = {Hsu, Yueh-Jiuan G. and Arakawa, Akio},
+  title = {Numerical Modeling of the Atmosphere with an Isentropic Vertical Coordinate},
+  journal = MWR,
+  year = {1990},
+  volume = {118},  number = {10},
+  pages = {1933--1959},
+}
+
+@ARTICLE{Huang_JPO93,
+  author = {R.X. Huang},
+  title = {Real freshwater flux as a natural boundary condition for the salinity
+	balance and thermohaline circulation forced by evaporation and precipitation},
+  journal = JPO,
+  year = {1993},
+  volume = {23},
+  pages = {2428--2446}
+}
+
+@TECHREPORT{Hunke2008,
+  author = {E.C. Hunke and W.H. Lipscomb},
+  title = {CICE: the Los Alamos sea ice model documentation and software user's manual, 
+        Version 4.0},
+  institution = { Los Alamos National Laboratory, N.M.},
+  publisher = {LA-CC-06-012, Los Alamos National Laboratory, N.M.},
+  year = {2008}
+}
+
+@TechReport{Hunter2006,
+  Title                    = {Specification for Test Models of Ice Shelf Cavities},
+  Author                   = {J. R. Hunter},
+  Institution              = {Antarctic Climate \& Ecosystems Cooperative Research Centre Private Bag 80, Hobart, Tasmania 7001},
+  Year                     = {2006},
+}
+
+@TECHREPORT{TEOS10,
+  author = {IOC and SCOR and IAPSO},
+  title = {The international thermodynamic equation of seawater - 2010: Calculation and use of thermodynamic properties},
+  institution = {Intergovernmental Oceanographic Commission},
+  publisher = {Manuals and Guides No. 56, UNESCO (English)},
+  year = {2010},
+  pages = {196pp},
+  url = {http://www.teos-10.org/pubs/TEOS-10_Manual.pdf}
+}
+
+@ARTICLE{Iudicone_al_JPO08b,
+  author = {D. Iudicone and G. Madec and B. Blanke and S. Speich},
+  title = {The role of Southern Ocean surface forcings and mixing in the global conveyor},
+  journal = JPO,
+  year = {2008},
+  volume = {38},
+  pages = {1377--1400}
+}
+
+@ARTICLE{Iudicone_al_JPO08a,
+  author = {D. Iudicone and G. Madec and T. J. McDougall},
+  title = {Diagnosing water transformations and the key role of light penetration},
+  journal = JPO,
+  year = {2008},
+  volume = {38},
+  pages = {1357--1376}
+}
+
+@ARTICLE{Iudicone_al_JPO07,
+  author = {D. Iudicone and K. Rodgers and R. Schopp and G. Madec},
+  title = {An Exchange window for the Antarctic Intermediate Water Injection into the South Pacific},
+  journal = JPO,
+  year = {2007},
+  volume = {37},
+  pages = {31--49}
+}
+
+@ARTICLE{Iudicone_al_JPO08c,
+  author = {D. Iudicone and S. Speich and G. Madec and B. Blanke},
+  title = {The global Conveyor Belt in a Southern Ocean perspective},
+  journal = JPO,
+  year = {2008},
+  volume = {38},
+  pages = {1401--1425}
+}
+
+@ARTICLE{Izumo_al_CD10,
+  author = {T. Izumo and S.Masson and J. Vialard and C. de Boyer Montegut and
+	S. K. Behera and G. Madec and K. Takahashi and T. Yamagata},
+  title = {Interannual variations of low-frequency Madden-Julian Oscillation in autral summer: Observations},
+  journal = CD,
+  year = {2010},
+  volume = {35},  number = {4},
+  pages = {669--683},
+  url = {http://dx.doi.org/10.1007/s00382-009-0655-z}
+}
+
+@ARTICLE{JackMcD1995,
+  author = {D. R. Jackett and T. J. McDougall},
+  title = {Minimal adjustment of hydrographic data to achieve static stability},
+  journal = JAOT,
+  year = {1995},
+  volume = {12},
+  pages = {381--389}
+}
+
+@article{Jackson_Rehmann_JPO2014,
+	author = {P. R. Jackson and C. R. Rehmann},
+	title = {Experiments on differential scalar mixing in turbulence in a sheared, stratified flow},
+	journal = JPO,
+	volume = {44},
+	issn = {0022-3670},
+	url = {http://dx.doi.org/10.1175/JPO-D-14-0027.1},
+	doi = {10.1175/JPO-D-14-0027.1},
+	number = {10},
+	year = {2014},
+	pages = {2661--2680},
+}
+
+@ARTICLE{Jayne_St_Laurent_GRL01,
+  author = {S.R. Jayne and L.C. {St. Laurent}},
+  title = {Parameterizing tidal disspiation over rough topography},
+  journal = GRL,
+  pages = {811--814}
+}
+
+@ARTICLE{Jenkins1991,
+  author = {A. Jenkins},
+  title = {A one-dimensional model of ice shelf-ocean interaction},
+  journal = JGR,
+  year = {1991},
+  volume = {96},  number = {C11},
+  pages = {2298--2312}
+}
+
+@ARTICLE{Jenkins2001,
+  author = {A. Jenkins},
+  title = {The Role of Meltwater Advection in the Formulation of Conservative Boundary Conditions at an Ice-Ocean Interface},
+  journal = JPO,
+  year = {2001},
+  volume = {31},
+  pages = {285--296}
+}
+
+@ARTICLE{Jenkins2010,
+  author = {A. Jenkins},
+  title = {observation and parameterization of ablation at the base of Ronne Ice Shelf, Antarctica},
+  journal = JPO,
+  year = {2010},
+  volume = {40},  number = {10},
+  pages = {2298--2312}
+}
+
+@BOOK{Jerlov_Bk68,
+  title = {Optical Oceanography},
+  publisher = {Elsevier},
+  year = {1968},
+  author = {N. G. Jerlov},
+  pages = {194pp}
+}
+
+@ARTICLE{Jones_MWR99,
+  author = {P. W. Jones},
+  title = {First- and second-order conservative remapping schemes for grids in spherical coordinates},
+  journal = MWR,
+  year = {1999},
+  volume = {127},
+  pages = {2204--2210}
+}
+
+@BOOK{Jones_Bk01,
+  title = {A User's Guide for SCRIP: A Spherical Coordinate Remapping and Interpolation Package. Version 1.4},
+  publisher = {Los Alamos National Laboratory},
+  year = {2001},
+  author = {P. W. Jones},
+  pages = {27pp},
+  url = {http://climate.lanl.gov/Software/SCRIP/SCRIPusers.pdf}
+}
+
+@TECHREPORT{Jones_1998,
+  title = {A User's Guide for SCRIP: A Spherical Coordinate Remapping and Interpolation Package. Version 1.4},
+  institution = {Los Alamos National Laboratory},
+  year = {1998},
+  author = {P. W. Jones},
+  url = {http://climate.lanl.gov/Software/SCRIP/SCRIPusers.pdf}
+} 
+
+@ARTICLE{Kantha_Clayson_1994,
+  author = {L. H. Kantha and C. A. Clayson},
+  title = {An improved mixed layer model for geophysical applications},
+  journal = JGR,
+  year = {1994},
+  volume = {99},
+  pages = {25,235--25,266}
+}
+
+@ARTICLE{Kantha_Carniel_CSR05,
+  author = {L. Kantha and S. Carniel},
+  title = {Comment on ''Generic length-scale equation for geophysical turbulence models'' by L. Umlauf and H. Burchard},
+  journal = JMS, 
+  year = {2005},
+  volume = {61},
+  pages = {693--702}
+}
+
+@ARTICLE{Kasahara_MWR74,
+  author = {A. Kasahara},
+  title = {Various vertical coordinate systems used for numerical weather prediction},
+  journal = MWR,
+  year = {1974},
+  volume = {102},
+  pages = {509--522}
+}
+
+@ARTICLE{Killworth_al_JPO91,
+  author = {P.D. Killworth and D. Stainforth and D.J. Webb and S.M. Paterson},
+  title = {The Development of a Free-Surface Bryan-Cox-Semtner Ocean Model},
+  journal = JPO,
+  year = {1991},
+  volume = {21},  number = {9},
+  pages = {1333--1348}
+}
+
+@INPROCEEDINGS{Killworth1989,
+  author = {P. D. Killworth},
+  title = {On the parameterization of deep convection in ocean models},
+  booktitle = {Parameterization of small-scale processes},
+  year = {1989},
+  editor = {Hawaiian winter workshop},
+  month = {January 17-20},
+  organization = {University of Hawaii at Manoa}
+}
+
+@ARTICLE{Killworth1992,
+  author = {P. D. Killworth},
+  title = {An equivalent-barotropic mode in the fine resolution Antarctic model},
+  journal = JPO,
+  year = {1992},
+  volume = {22},
+  pages = {1379--1387}
+}
+
+@ARTICLE{Koch-Larrouy_al_CD10,
+  author = {A. Koch-Larrouy and M. Lengaigne and P. Terray and G. Madec and S. Masson},
+  title = {Tidal mixing in the Indonesian Seas and its effect on the tropical climate system},
+  journal = CD,
+  year = {2010},
+  volume = {34},  number = {6},
+  pages = {891--904},
+  doi = {10.1007/s00382-009-0642-4},
+  url = {http://dx.doi.org/10.1007/s00382-009-0642-4}
+}
+
+@ARTICLE{Koch-Larrouy_al_OD08b,
+  author = {A. Koch-Larrouy and G. Madec and B. Blanke and R. Molcard},
+  title = {Water mass transformation along the Indonesian throughflow in an OGCM},
+  journal = OD,
+  year = {2008},
+  volume = {58},  number = {3-4},
+  pages = {289--309},
+  doi = {10.1007/s10236-008-0155-4},
+  url = {http://dx.doi.org/10.1007/s10236-008-0155-4}
+}
+
+@ARTICLE{Koch-Larrouy_al_GRL07,
+  author = {A. Koch-Larrouy and G. Madec and P. Bouruet-Aubertot and T. Gerkema and L. Bessieres and R. Molcard},
+  title = {Tidal mixing in the Indonesian Seas and its effect on the tropical climate system},
+  journal = GRL,
+  year = {2007},
+  volume = {34},
+  pages = {L04604},
+  doi = {10.1029/2006GL028405},
+  url = {http://dx.doi.org/10.1029/2006GL028405}
+}
+
+@ARTICLE{Koch-Larrouy_al_OD08a,
+  author = {A. Koch-Larrouy and G. Madec and D. Iudicone and A. Atmadipoera and R. Molcard},
+  title = {Physical processes contributing to the water mass transformation of the Indonesian Throughflow},
+  journal = OD,
+  year = {2008},
+  volume = {58},  number = {3-4},
+  pages = {275--288},
+  doi = {10.1007/s10236-008-0154-5},
+  url = {http://dx.doi.org/10.1007/s10236-008-0154-5}
+}
+
+@ARTICLE{Kolmogorov1942,
+  author = {A. N. Kolmogorov},
+  title = {The equation of turbulent motion in an incompressible fluid},
+  journal = {Izv. Akad. Nauk SSSR, Ser. Fiz.},
+  year = {1942},
+  volume = {6},
+  pages = {56--58}
+}
+@ARTICLE{Kondo1975,
+  author = {J. Kondo},
+  title = {Air-sea bulk transfer coefficients in diabatic conditions},
+  journal = {Boundary-Layer Meteorol},
+  year = {1975},
+  volume = {9},
+  pages = {91--112}
+}
+
+@article{Lemarie_OM2012,
+author = "F. Lemari\'{e} and L. Debreu and A.F. Shchepetkin and J.C. McWilliams",
+title = "On the stability and accuracy of the harmonic and biharmonic isoneutral mixing operators in ocean models ",
+journal = OM,
+year = "2012",
+volume = "52–53", pages = "9--35",
+issn = "1463-5003",
+doi = "http://dx.doi.org/10.1016/j.ocemod.2012.04.007",
+url = "http://www.sciencedirect.com/science/article/pii/S1463500312000674",
+}
+
+
+@ARTICLE{Lemarie_OM2015,
+  author = {F. Lemari\'{e} and L. Debreu and J. Demange and  G. Madec and J.M. Molines and M. Honnorat},
+  title = {Stability Constraints for Oceanic Numerical Models: 
+           Implications for the Formulation of time and space Discretizations},
+  journal = OM,
+  year = {2015},
+  volume = {92}, 
+  pages = {124--148},
+  doi = {10.1016/j.ocemod.2015.06.006},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2015.06.006}
+}
+
+@ARTICLE{Lermusiaux2001,
+  author = {P. F. J. Lermusiaux},
+  title = {Evolving the subspace of three-dimensional miltiscale ocean variability: Massachusetts Bay},
+  journal = JMS,
+  year = {2001},
+  volume = {29},
+  pages = {385--422}
+}
+
+@PHDTHESIS{Levy_PhD96,
+  author = {M. L\'{e}vy},
+  title = {Mod\'{e}lisation des processus biog\'{e}ochimiques en M\'{e}diterran\'{e}e
+	        nord-occidentale. Cycle saisonnier et variabilit\'{e} m\'{e}so\'{e}chelle},
+  school = {Universit\'{e} Pierre et Marie Curie, Paris, France, 207pp},
+  year = {1996}
+}
+
+@ARTICLE{Levy_al_GRL01,
+  author = {M. L\'{e}vy and A. Estubier and G Madec},
+  title = {Choice of an advection scheme for biogeochemical models},
+  journal = GRL,
+  year = {2001},
+  volume = {28}
+}
+
+@ARTICLE{Levy_al_OM10,
+  author = {M. L\'{e}vy and P. Klein and A.-M. Tr\'{e}guier and D. Iovino and
+	G. Madec and S. Masson and T. Takahashi},
+  title = {Impacts of sub-mesoscale physics on idealized gyres},
+  journal = OM,
+  year = {2010},
+  volume = {34},  number = {1-2},
+  doi = {10.1016/j.ocemod.2010.04.001},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2010.04.001}
+}
+
+@ARTICLE{Levy_al_JMS99,
+  author = {M. L\'{e}vy and L. M\'{e}mery and G. Madec},
+  title = {The onset of a bloom after deep winter convection in the Northwestern
+	Mediterranean Sea: mesoscale process study with a primitive equation
+	model},
+  journal = JMS,
+  year = {1999},
+  volume = {16},  number = {1-2},
+  pages = {7--21}
+}
+
+@ARTICLE{Levy_al_DSR98,
+  author = {M. L\'{e}vy and L. M\'{e}mery and G. Madec},
+  title = {The onset of the spring bloom in the MEDOC area: mesoscale spatial
+	variability},
+  journal = DSR,
+  year = {1998},
+  volume = {I},  number = {46},
+  pages = {1137--1160}
+}
+
+@ARTICLE{Levy_al_DSR00,
+  author = {M. L\'{e}vy and L. M\'{e}mery and G. Madec},
+  title = {Combined effects of mesoscale processes and atmospheric high-frequency
+	variability on the spring bloom in the MEDOC area},
+  journal = DSR,
+  year = {2000},
+  volume = {47},
+  pages = {527--531}
+}
+
+@BOOK{Large_Yeager_Rep04,
+  title = {Diurnal to decadal global forcing for ocean and sea-ice models: the data sets and flux climatologies},
+  publisher = {NCAR Technical Note, NCAR/TN-460+STR, CGD Division of the National Center for Atmospheric Research},
+  year = {2004},
+  author = {W. G. Large and S. Yeager}}
+
+@ARTICLE{Large_al_RG94,
+  author = {W. G. Large and J. C. McWilliams and S. C. Doney},
+  title = {Oceanic vertical mixing - a review and a model with a nonlocal boundary layer parameterization},
+  journal = {Reviews of Geophysics},
+  year = {1994},
+  volume = {32},
+  pages = {363--404},
+  doi = {10.1029/94RG01872},
+  url = {http://dx.doi.org/10.1029/94RG01872}
+}
+
+@ARTICLE{Latif_al_JC06,
+  author = {M. Latif and C. Böning and J. Willebrand and A. Biastoch and J. Dengg
+	and N. Keenlyside and U. Schweckendiek and G. Madec},
+  title = {Is the Thermohaline Circulation Changing?},
+  journal = JC,
+  year = {2006},
+  volume = {19},
+  pages = {4631--4637}
+}
+
+@PHDTHESIS{Lazar_PhD97,
+  author = {A. Lazar},
+  title = {La branche froide de la circulation thermohaline - sensibilit\'{e}
+	\`{a} la diffusion turbulente dans un mod\`{e}le de circulation g\'{e}n\'{e}rale
+	id\'{e}alis\'{e}e},
+  school = {Universit\'{e} Pierre et Marie Curie, Paris, France, 200pp},
+  year = {1997}
+}
+
+@ARTICLE{Lazar_al_JPO99,
+  author = {A. Lazar and G. Madec and P. Delecluse},
+  title = {The Deep Interior Downwelling, the Veronis Effect, and Mesoscale
+	Tracer Transport Parameterizations in an OGCM},
+  journal = JPO,
+  year = {1999},
+  volume = {29},  number = {11},
+  pages = {2945--2961},
+}
+
+@ARTICLE{Le_Sommer_al_OM09,
+  author = {J. {Le Sommer} and T. Penduff and S. Theetten and G. Madec and B.
+	Barnier},
+  title = {How momentum advection schemes influence current-topography interactions
+	at eddy permitting resolution},
+  journal = OM,
+  year = {2009},
+  volume = {29},  number = {1},
+  pages = {1--14},
+  doi = {10.1016/j.ocemod.2008.11.007},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2008.11.007}
+}
+
+@PHDTHESIS{Leclair_PhD2010,
+  author = {M. Leclair},
+  title = {introduction d'une coordonn\'{e}e verticale arbitrairement Lagrangienne
+	Eul\'{e}rienne dans le code NEMO, 180pp.},
+  school = {Universit\'{e} Pierre and Marie Curie},
+  year = {2010}
+}
+
+@ARTICLE{Leclair_Madec_OM09,
+  author = {M. Leclair and G. Madec},
+  title = {A conservative leap-frog time stepping method},
+  journal = OM,
+  year = {2009},
+  volume = {30},  number = {2-3},
+  pages = {88-94},
+  doi = {10.1016/j.ocemod.2009.06.006},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2009.06.006}
+}
+
+@ARTICLE{Leclair_Madec_OM11,
+  author = {M. Leclair and G. Madec},
+  title = {$\tilde{z}$-coordinate, an Arbitrary Lagrangian-Eulerian coordinate separating high and low frequency},
+  journal = OM,
+  year = {2011},
+  volume = {37},  pages = {139--152}, 
+  doi = {10.1016/j.ocemod.2011.02.001},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2011.02.001}
+}
+
+@ARTICLE{Lele_JCP1992,
+  author = {S.K. Lele},
+  title = {Compact finite difference schemes with spectral-like resolution},
+  journal = JCP,
+  year = {1992},
+  volume = {103}, pages = {16--42}
+}
+
+@ARTICLE{Lengaigne_al_JC03,
+  author = {M. Lengaigne and J.-P. Boulanger and C. Menkes and G. Madec and P.
+	Delecluse and E. Guilyardi, and J. Slingo},
+  title = {The March 1997 Westerly Wind Event and the onset of the 1997/98 El
+	Niño: Understanding the role of the atmospheric},
+  journal = JC,
+  year = {2003},
+  volume = {16},  number = {20}, pages = {3330--3343}
+}
+
+@ARTICLE{Lengaigne_al_JGR02,
+  author = {M. Lengaigne and J.-P. Boulanger and C. Menkes and S. Masson and
+	G. Madec and P. Delecluse},
+  title = {Ocean response to the March 1997 Westerly Wind Event},
+  journal = JGR,
+  year = {2002},
+  doi = {10.1029/2001JC000841},
+  url = {http://dx.doi.org/10.1029/2001JC000841}
+}
+
+@ARTICLE{Lengaigne_al_JGR03,
+  author = {M. Lengaigne and G. Madec and G. Alory and C. Menkes},
+  title = {Sensitivity of the tropical Pacific Ocean to isopycnal diffusion
+	on tracer and dynamics},
+  journal = JGR,
+  year = {2003},
+  volume = {108},  number = {C11},
+  pages = {3345},
+  doi = {10.1029/2002JC001704},
+  url = {http://dx.doi.org/10.1029/2002JC001704}
+}
+
+@ARTICLE{Lengaigne_al_GRL09,
+  author = {M. Lengaigne and G. Madec and L. Bopp and C. Menkes and O. Aumont and P. Cadule},
+  title = {Bio-physical feedbacks in the Arctic Ocean using an Earth System model},
+  journal = GRL,
+  year = {2009},
+  volume = {36},  
+  pages = {L21602},
+  doi = {10.1029/2009GL040145},
+  url = {http://dx.doi.org/10.1029/2009GL040145}
+}
+
+@ARTICLE{Lengaigne_al_CD07,
+  author = {M. Lengaigne and C. Menkes and O. Aumont and T. Gorgues and L. Bopp and J.-M. Andr\'{e} G. Madec},
+  title = {Bio-physical feedbacks on the tropical Pacific climate in a Coupled
+	General Circulation Model},
+  journal = CD,
+  year = {2007},
+  volume = {28},
+  pages = {503--516}
+}
+
+@ARTICLE{Leonard1991,
+  author = {B. P. Leonard},
+  title = {The ULTIMATE conservative difference scheme applied to unsteady one--dimensional advection},
+  journal = {Computer Methods in Applied Mechanics and Engineering},
+  year = {1991},
+  pages = {17--74}
+}
+
+@TECHREPORT{Leonard_Rep88,
+  author = {B. P. Leonard},
+  title = {Universal limiter for transient interpolation modelling of the advective transport equations},
+  institution = {Technical Memorandum TM-100916 ICOMP-88-11, NASA},
+  year = {1988}
+}
+
+@ARTICLE{Leonard1979,
+  author = {B. P. Leonard},
+  title = {A stable and accurate convective modelling procedure based on quadratic
+	upstream interpolation},
+  journal = {Computer Methods in Applied Mechanics and Engineering},
+  year = {1979},
+  volume = {19},
+  pages = {59--98},
+}
+
+@TECHREPORT{Levier2007,
+  author = {B. Levier and A.-M. Tr\'{e}guier and G. Madec and V. Garnier},
+  title = {Free surface and variable volume in the NEMO code},
+  institution = {MERSEA MERSEA IP report WP09-CNRS-STR-03-1A, 47pp, available on the
+	NEMO web site},
+  year = {2007}
+}
+
+@BOOK{levitus82,
+  title = {Climatological Atlas of the world ocean},
+  publisher = {NOAA professional paper No. 13, 174pp},
+  year = {1982},
+  author = {S Levitus },
+  pages = {173 pp}
+}
+
+@ARTICLE{Li_Garrett_JMR93,
+  author = {M. Li and C. Garrett},
+  title = {Cell merging and the jet/downwelling ratio in Langmuir circulation},
+  journal = JMR,
+  year = {1993},
+  volume = {51},
+  pages = {737--769}
+}
+
+@ARTICLE{Losch2008,
+  author = {M. Losch},
+  title = {Modeling ice shelf cavities in a z coordinate ocean general circulation model},
+  journal = JGR,
+  year = {2008},
+  volume = {113},  number = {C13},
+}
+
+@TECHREPORT{Lott1989,
+  author = {F. Lott and G. Madec},
+  title = {Implementation of bottom topography in the Ocean General Circulation
+	Model OPA of the LODYC: formalism and experiments.},
+  institution = {LODYC, France, 36pp.},
+  year = {1989},
+  number = {3}
+}
+
+@ARTICLE{Lott_al_OM90,
+  author = {F. Lott and G. Madec and J. Verron},
+  title = {Topographic experiments in an Ocean General Circulation Model},
+  journal = OM,
+  year = {1990},
+  volume = {88},
+  pages = {1--4}
+}
+
+@ARTICLE{Luo_al_JC05,
+  author = {J.-J. Luo and S. Masson and E. Roeckner and G. Madec and T. Yamagata},
+  title = {Reducing climatology bias in an ocean-atmosphere CGCM with improved
+	coupling physics},
+  journal = JC,
+  year = {2005},
+  volume = {18},  number = {13},
+  pages = {2344--2360}
+}
+
+@BOOK{Madec_Bk08,
+  title = {NEMO ocean engine},
+  publisher = {Note du P\^ole de mod\'{e}lisation, Institut Pierre-Simon Laplace
+	(IPSL), France, No 27, ISSN No 1288-1619},
+  year = {2008},
+  author = {G. Madec}
+}
+
+@BOOK{Madec_HDR01,
+  title = {Le Cycle des Masses d'Eau Oc\'{e}aniqueset sa variabilit\'{e} dans le Syst\'{e}me Climatique},
+  year = {2001},
+  author = {G. Madec},
+  pages = {63pp.},
+  series = {Habilitation \'{a} Diriger des Recherches, Universit\'{e} Pierre et Marie Curie}
+}
+
+@PHDTHESIS{Madec_PhD90,
+  author = {G. Madec},
+  title = {La formation d'eau profonde et son impact sur la circulation r\'{e}gionale
+	en M\'{e}diterran\'{e}e Occidentale - une approche num\'{e}rique},
+  school = {Universit\'{e} Pierre et Marie Curie, Paris, France, 194pp.},
+  year = {1990},
+  month = {2 mai}
+}
+
+@ARTICLE{Madec_al_DAO91,
+  author = {G. Madec and M. Chartier and M. Cr\'{e}pon},
+  title = {Effect of thermohaline forcing variability on deep water formation
+	in the Northwestern Mediterranean Sea - a high resulution three-dimensional
+	study},
+  journal = DAO,
+  year = {1991},
+  volume = {15},
+  pages = {301--332}
+}
+
+@ARTICLE{Madec_al_JPO91,
+  author = {G. Madec and M. Chartier and P. Delecluse and M. Cr\'{e}pon},
+  title = {A three-dimensional numerical study of deep water formation in the Northwestern Mediterranean Sea .},
+  journal = JPO,
+  year = {1991},
+  volume = {21},
+  pages = {1349--1371}
+}
+
+@INBOOK{Madec_Crepon_Bk91,
+  chapter = {Thermohaline-driven deep water formation in the Northwestern Mediterranean
+	Sea},
+  pages = {241--265},
+  title = {Deep convection and deep water formation in the oceans},
+  publisher = {Elsevier Oceanographic Series, P.C. Chu and J.C. Gascard (Eds.)},
+  year = {1991},
+  author = {G. Madec and M. Cr\'{e}pon}
+  }
+
+@ARTICLE{Madec1997,
+  author = {G. Madec and P. Delecluse},
+  title = {The OPA/ARPEGE and OPA/LMD Global Ocean-Atmosphere Coupled Model},
+  journal = {Int. WOCE Newsletter},
+  year = {1997},
+  volume = {26},
+  pages = {12--15}
+}
+
+@TECHREPORT{Madec1998,
+  author = {G. Madec and P. Delecluse and M. Imbard and C. Levy},
+  title = {OPA 8 Ocean General Circulation Model - Reference Manual},
+  institution = {LODYC/IPSL Note 11},
+  year = {1998}
+}
+
+@ARTICLE{Madec_Imbard_CD96,
+  author = {G Madec and M Imbard},
+  title = {A global ocean mesh to overcome the north pole singularity},
+  journal = CD,
+  year = {1996},
+  volume = {12},
+  pages = {381--388}
+}
+
+@ARTICLE{Madec_al_JPO96,
+  author = {G. Madec and F. Lott and P. Delecluse and M. Cr\'{e}pon},
+  title = {Large-Scale Preconditioning of Deep-Water Formation in the Northwestern
+	Mediterranean Sea},
+  journal = JPO,
+  year = {1996},
+  volume = {26},  number = {8},
+  pages = {1393--1408},
+}
+
+@ARTICLE{Madec_al_OM88,
+  author = {G. Madec and C. Rahier and M. Chartier},
+  title = {A comparison of two-dimensional elliptic solvers for the streamfunction
+	in a multilevel OGCM},
+  journal = OM,
+  year = {1988},
+  volume = {78},
+  pages = {1-6}
+}
+
+@ARTICLE{Maes_al_CD98,
+  author = {C. Maes and P. Delecluse and G. Madec},
+  title = {Impact of westerly wind bursts on the warm pool of the TOGA-COARE
+	domain in an OGCM},
+  journal = CD,
+  year = {1998},
+  volume = {14},
+  pages = {55--70}
+}
+
+@ARTICLE{Maes_al_MWR97,
+  author = {C. Maes and G. Madec and P. Delecluse},
+  title = {Sensitivity of an Equatorial Pacific OGCM to the lateral diffusion},
+  journal = MWR,
+  year = {1997},
+  volume = {125},  number = {5},
+  pages = {958--971}
+}
+
+@ARTICLE{Maggiore_al_PCE98,
+  author = {A. Maggiore and  M. Zavatarelli and M. G. Angelucci and N. Pinardi},
+  title = {Surface heat and water fluxes in the Adriatic Sea: seasonal and interannual variability},
+  journal = {Phys Chem Earth},
+  year = {1998},
+  volume = {23},
+  pages = {561--567}
+}
+
+@ARTICLE{Maltrud1998,
+  author = {M. E. Maltrud and R. D. Smith and A. J. Semtner and R. C. Malone},
+  title = {Global eddy-resolving ocean simulations driven by 1985-1995 atmospheric
+	winds},
+  journal = JGR,
+  year = {1998},
+  volume = {103},  number = {C13},
+  pages = {30,825--30,854}
+}
+
+@ARTICLE{Marchesiello2001,
+  author = { P. Marchesiello and J. Mc Williams and A. Shchepetkin },
+  title = {Open boundary conditions for long-term integrations of Regional Oceanic
+	Models},
+  journal = OM,
+  year = {2001},
+  volume = {3},
+  pages = {1--20}
+}
+
+@ARTICLE{Marsaleix_al_OM08,
+  author = {P. Marsaleix and F. Auclair and J. W. Floor and M. J. Herrmann and
+	C. Estournel and I. Pairaud and C. Ulses},
+  title = {Energy conservation issues in sigma-coordinate free-surface ocean
+	models},
+  journal = OM,
+  year = {2008},
+  volume = {20},  number = {1},
+  pages = {61--89},
+  doi = {10.1016/j.ocemod.2007.07.005},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2007.07.005}
+}
+
+@Article{Marsh_GMD2015,
+AUTHOR = {R. Marsh and V. O. Ivchenko and N. Skliris and S. Alderson and G. R. Bigg and G. Madec and A. T. Blaker and Y. Aksenov and B. Sinha and A. C. Coward and J. Le Sommer and N. Merino and V. B. Zalesny},
+TITLE = {NEMO-ICB (v1.0): interactive icebergs in the NEMO ocean model globally configured at eddy-permitting resolution},
+JOURNAL = {Geoscientific Model Development},
+VOLUME = {8},
+YEAR = {2015},
+NUMBER = {5},
+PAGES = {1547--1562},
+url = {HTTP://www.geosci-model-dev.net/8/1547/2015/},
+DOI = {10.5194/gmd-8-1547-2015}
+}
+
+@article{Martin_Adcroft_OM10,
+author = {T. Martin and A. Adcroft},
+title = {Parameterizing the fresh-water flux from land ice to ocean with interactive icebergs in a coupled climate model},
+journal = OM,
+year = {2010},
+volume = {34}, number = {3--4},
+pages = {111--124},
+issn = {1463-5003},
+doi = {10.1016/j.ocemod.2010.05.001},
+url = {http://dx.doi.org/10.1016/j.ocemod.2010.05.001}
+}
+
+@BOOK{MIT-GCM_2004,
+  title = {MIT-gcm User Manual},
+  year = {2004},
+  editor = {MIT Department of EAPS},
+  author = {J. Marshall and A. Adcroft and J.-M. Campin and P. Heimbach and A.
+	Molod and S. Dutkiewicz and H. Hill and M. Losch and B. Fox-Kemper
+	and D. Menemenlis and D. Ferreira and E. Hill and M. Follows and
+	C. Hill and C. Evangelinos and G. Forget}
+	}
+
+@PHDTHESIS{Marti_PhD92,
+  author = {O. Marti},
+  title = {Etude de l'oc\'{e}an mondial : mod\'{e}lisation de la circulation
+	et du transport de traceurs anthropog\'{e}niques},
+  school = {Universit\'{e} Pierre et Marie Curie, Paris, France, 201pp},
+  year = {1992}
+}
+
+@ARTICLE{Marti_al_CD10,
+  author = {O. Marti and P. Braconnot and J.-L. Dufresne and J. Bellier and R.
+	Benshila and S. Bony and P. Brockmann and P. Cadule and A. Caubel
+	and F Codron and S. Denvil and L. Fairhead and T. Fichefet and M.-A.
+	Filiberti and M.-A. Foujols and P. Friedlingstein and H. Goosse and
+	J.-Y. Grandpeix and E. Guilyardi and F. Hourdin and G. Krinner and
+	C. L\'{e}vy and G. Madec and J. Mignot and I. Musat and D. Swingedouw
+	and C. Talandier},
+  title = {Key features of the IPSL ocean atmosphere model and its sensitivity
+	to atmospheric resolution},
+  journal = CD,
+  year = {2010},
+  volume = {34},  number = {1},
+  pages = {1--26},
+  doi = {10.1007/s00382-009-0640-6},
+  url = {http://dx.doi.org/10.1007/s00382-009-0640-6}
+}
+
+@ARTICLE{Marti_al_JGR92,
+  author = {O. Marti and G. Madec and P. Delecluse},
+  title = {Comment on "Net diffusivity in ocean general circulation models with
+	nonuniform grids" by F. L. Yin and I. Y. Fung},
+  journal = JGR,
+  year = {1992},
+  volume = {97},
+  pages = {12,763--12,766}
+}
+
+@INBOOK{Masson_al_Bk08,
+  chapter = {OPA9 - French experiments on the Earth Simulator and Teraflop Workbench
+	tunings},
+  pages = {25-34},
+  title = {In High Performance computing on Vector System 2007, Stuttgart, Germany},
+  publisher = {Springer-Verlag},
+  year = {2008},
+  editor = {Resch M, Roller S, Lammers P, Furui T, Galle M, Bez W},
+  author = {S. Masson and M.-A. Foujols and P. Klein and G. Madec and L. Hua and M. Levy 
+  and H. Sasaki and K. Takahashi and F. Svensson},
+  doi = {10.1007/978-3-540-74384-2},
+  url = {http://dx.doi.org/10.1007/978-3-540-74384-2}
+}
+
+@ARTICLE{Masson_al_GRL05,
+  author = {S. Masson and J.-J. Luo and G. Madec and J. Vialard and F. Durand
+	and S. Gualdi and E. Guilyardi and S. Behera and P. Delecluse and
+	A. Navarra and T. Yamagata},
+  title = {Impact of barrier layer on winter-spring variability of the South-Eastern
+	Arabian Sea},
+  journal = GRL,
+  year = {2005},
+  volume = {32},
+  pages = {L07703},
+  doi = {10.1029/2004GL021980},
+  url = {http://dx.doi.org/10.1029/2004GL021980}
+}
+
+@ARTICLE{McDougall1987,
+  author = {T. J. McDougall},
+  title = {Neutral Surfaces},
+  journal = JPO,
+  year = {1987},
+  volume = {17},  number = {11},
+  pages = {1950--1964},
+}
+
+@ARTICLE{McDougall_Taylor_JMR84,
+  author = {T. J. McDougall and J. R. Taylor},
+  title = {Flux measurements across a finger interface at low values of the stability ratio},
+  journal = JMR,
+  year = {1984},
+  volume = {42},
+  pages = {1--14}
+}
+
+@ARTICLE{Mellor_Blumberg_JPO04,
+author = {G. Mellor and A. Blumberg},
+title = {Wave Breaking and Ocean Surface Layer Thermal Response},
+journal = JPO,
+volume = {34}, number = {3},
+pages = {693--698},
+year = {2004},
+doi = {10.1175/2517.1},
+URL = {http://journals.ametsoc.org/doi/abs/10.1175/2517.1}
+}
+
+@ARTICLE{Mellor_Yamada_1982,
+  author = {G. L. Mellor and T. Yamada},
+  title = {Development of a turbulence closure model for geophysical fluid problems},
+  journal = RGSP,
+  year = {1982},
+  volume = {20},
+  pages = {851--875}
+}
+
+@ARTICLE{Menkes_al_JPO06,
+  author = {C. Menkes and J. Vialard and S C. Kennan and J.-P. Boulanger and G. Madec},
+  title = {A modelling study of the three-dimensional heat budget of Tropical
+	 Instability Waves in the Equatorial Pacific},
+  journal = JPO,
+  year = {2006},
+  volume = {36},  number = {5},
+  pages = {847--865}
+}
+
+@ARTICLE{Merryfield1999,
+  author = {W. J. Merryfield and G. Holloway and A. E. Gargett},
+  title = {A Global Ocean Model with Double-Diffusive Mixing},
+  journal = JPO,
+  year = {1999},
+  volume = {29},  number = {6},
+  pages = {1124--1142}
+}
+
+@BOOK{Mesinger_Arakawa_Bk76,
+  title = {Numerical methods used in Atmospheric models},
+  publisher = {GARP Publication Series No 17},
+  year = {1976},
+  author = {F. Mesinger and A. Arakawa}
+}
+
+@ARTICLE{Morel_JGR88,
+  author = {A. Morel},
+  title = {Optical modeling of the upper ocean in relation to its biogenous matter content (Case I waters)},
+  journal = JGR,
+  year = {1988},
+  volume = {93},
+  pages = {10,749--10,768}
+}
+
+@ARTICLE{Morel_Berthon_LO89,
+  author = {A. Morel and J.-F. Berthon},
+  title = {Surface pigments, algal biomass profiles, and potential production of the euphotic layer: 
+           Relationships reinvestigated in view of remote-sensing applications},
+  journal = {Limnol. Oceanogr.},
+  year = {1989},
+  volume = {34(8)},
+  pages = {1545--1562}
+}
+
+@ARTICLE{Morel_Maritorena_JGR01,
+  author = {A. Morel and S. Maritorena},
+  title = {Bio-optical properties of oceanic waters: a reappraisal},
+  journal = JGR,
+  year = {2001},
+  volume = {106}, number = {C4},
+  pages = {7163--7180}
+}
+
+@ARTICLE{Moun_al_JPO02,
+  author = {J.N. Moum and D.R. Caldwell and J.D. Nash and G.D. Gunderson},
+  title = {Observations of boundary mixing over the continental slope},
+  journal = JPO,
+  year = {2002},
+  volume = {32}, number = {7},
+  pages = {2113--2130}
+}
+
+@ARTICLE{Murray_JCP96,
+  author = {R. J. Murray},
+  title = {Explicit Generation of Orthogonal Grids for Ocean Models},
+  journal = JCP,
+  year = {1996},
+  volume = {126},  number = {2},
+  pages = {251--273},
+}
+
+@ARTICLE{Oddo_al_OS09,
+  author = {P. Oddo and M. Adani and N. Pinardi and C. Fratianni and M. Tonani and D. Pettenuzzo},
+  title = {A nested Atlantic-Mediterranean Sea general circulation model for operational forecasting},
+  journal = OS,
+  year = {2009},
+  volume = {5},
+  pages = {1--13},
+}
+
+@PHDTHESIS{Olivier_PhD01,
+  author = {F. Olivier},
+  title = {Etude de l'activit\'{e} biologique et de la circulation oc\'{e}anique
+	dans un jet g\'{e}ostrophique: le front Alm\'{e}ria-Oran},
+  school = {Universit\'{e} Pierre et Marie Curie, Paris, France},
+  year = {2001}
+}
+
+@ARTICLE{Osborn_JPO80,
+  author = {T.R. Osborn},
+  title = {Estimates of the local rate of vertical diffusion from dissipation measurements},
+  journal = JPO,
+  year = {1980},
+  volume = {10},
+  pages = {83--89}
+}
+
+@ARTICLE{Pacanowski_Philander_JPO81,
+  author = {R.C. Pacanowski and S.G.H. Philander},
+  title = {Parameterization of Vertical Mixing in Numerical Models of Tropical Oceans},
+  journal = JPO,
+  year = {1981},
+  volume = {11},  number = {11},
+  pages = {1443--1451}
+}
+
+@ARTICLE{Pacanowski_Gnanadesikan_MWR98,
+  author = {R. C. Pacanowski and A. Gnanadesikan},
+  title = {Transient response in a z-level ocean model that resolves topography with partial-cells},
+  journal = MWR,
+  year = {1998},
+  volume = {126},
+  pages = {3248--3270}
+}
+
+@ARTICLE{Park_al_JC09,
+  author = {W. Park and N. Keenlyside and M. Latif and A. Str\¨{o}h and R. Redler and E. Roeckner and G. Madec},
+  title = {Tropical Pacific Climate and its Response to Global Warming in the
+	Kiel Climate Model},
+  journal = JC,
+  year = {2009},
+  volume = {22},  number = {1},
+  pages = {71--92},
+  doi = {10.1175/2008JCLI2261.1},
+  url = {http://dx.doi.org/10.1175/2008JCLI2261.1}
+}
+
+@ARTICLE{Paulson1977,
+  author = {C. A. Paulson and J. J. Simpson},
+  title = {Irradiance Measurements in the Upper Ocean},
+  journal = JPO,
+  year = {1977},
+  volume = {7},  number = {6},
+  pages = {952--956}
+}
+
+@ARTICLE{Payne_JAS72,
+  author = {R. E. Payne},
+  title = {Albedo of the Sea Surface},
+  journal = JAS,
+  year = {1972},
+  volume = {29},
+  pages = {959--970}
+}
+
+@ARTICLE{Penduff_al_OM06,
+  author = {T. Penduff and B. Barnier and J.-M. Molines and G. Madec},
+  title = {On the use of current meter data to assess the realism of ocean model simulations},
+  journal = OM,
+  year = {2006},
+  volume = {11},  number = {3--4},
+  pages = {399--416}
+}
+
+@ARTICLE{Penduff_al_JGR00,
+  author = {T. Penduff and B. Barnier and A. Colin de Verdi\`{e}re},
+  title = {Self-adapting open boundaries for a regional model of the eastern North Atlantic},
+  journal = JGR,
+  year = {2000},
+  volume = {105},
+  pages = {11,279--11,297}
+}
+
+@ARTICLE{Penduff_al_OS07,
+  author = {T. Penduff and J. Le Sommer and B. Barnier and A.M. Treguier and J. Molines and G. Madec},
+  title = {Influence of numerical schemes on current-topography interactions
+	in 1/4$^{\circ}$ global ocean simulations},
+  journal = OS,
+  year = {2007},
+  volume = {3},
+  pages = {509--524}
+}
+
+@ARTICLE{Phillips1959,
+  author = {R. S. Phillips},
+  title = {Dissipative Operators and Hyperbolic Systems of Partial Differential Equations},
+  journal = {Transactions of the American Mathematical Society},
+  year = {1959},
+  volume = {90},  number = {2},
+  pages = {193--254},
+  doi = {10.2307/1993202},
+  url = {http://dx.doi.org/10.2307/1993202}
+}
+
+@ARTICLE{Le_Quere_al_GBC00,
+  author = {C. Le Qu\'{e}r\'{e} and J. C. Orr and P. Monfray and O. Aumont and G. Madec},
+  title = {Interannual variability of the global and regional sea-air flux of C02 from 1979 to 1993},
+  journal = GBC,
+  year = {2000},
+  volume = {14},
+  pages = {1247--1266}
+}
+
+@ARTICLE{Raynaud_al_GRL00,
+  author = {S. Raynaud and S. Speich and E. Guilyardi and G. Madec},
+  title = {Impact of the ocean lateral diffusion on the ENSO-like variability of a global coupled GCM},
+  journal = GRL,
+  year = {2000},
+  volume = {27},  number = {19},
+  pages = {3041--3044}
+}
+
+@ARTICLE{Redi_JPO82,
+  author = {M. H. Redi},
+  title = {Oceanic isopycnal mixing by coordinate rotation},
+  journal = JPO,
+  year = {1982},
+  volume = {13},
+  pages = {1154--1158}
+}
+
+@ARTICLE{Reed_JPO77,
+  author = {R. K. Reed},
+  title = {On estimating insolation over the ocean},
+  journal = JPO,
+  year = {1977},
+  volume = {1},
+  pages = {874--971}
+}
+
+@ARTICLE{Reverdin1991,
+  author = {G. Reverdin and P. Delecluse and C. L\'{e}vy and P. Andrich and A. Morli\`{e}re and J. M. Verstraete},
+  title = {The near surface tropical Atlantic in 1982-1984 : results from a numerical simulation and a data analysis},
+  journal = PO,
+  year = {1991},
+  volume = {27},
+  pages = {273--340}
+}
+
+@BOOK{Richtmyer1967,
+  title = {Difference methods for initial-value problems},
+  publisher = {Interscience Publisher, Second Edition},
+  year = {1967},
+  author = {R. D. Richtmyer and K. W. Morton},
+  pages = {405pp}
+}
+
+@ARTICLE{Robert_JMSJ66,
+  author = {A. J. Robert},
+  title = {The integration of a Low order spectral form of the primitive meteorological equations},
+  journal = JMSJ,
+  year = {1966},
+  volume = {44},  number = {2}
+}
+
+@ARTICLE{Rodgers_al_GRL04,
+  author = {K. Rodgers and O. Aumont and G. Madec and C. Menkes},
+  title = {Radiocarbon as a thermocline proxy for the eastern equatorial Pacific},
+  journal = GRL,
+  year = {2004},
+  volume = {31},
+  pages = {L14314},
+  doi = {10.1029/2004GL019764},
+  url = {http://dx.doi.org/10.1029/2004GL019764}
+}
+
+@ARTICLE{Rodgers_al_GRL03,
+  author = {K. Rodgers and B. Blanke and G. Madec and O. Aumont and P. Ciais and J.-C. Dutay},
+  title = {Extratropical sources of equatorial pacific upwelling in an OGCM},
+  journal = GRL,
+  year = {2003},
+  volume = {30},  number = {2},
+  doi = {10.1029/2002GL016003},
+  url = {http://dx.doi.org/10.1029/2002GL016003}
+}
+
+@Article{Rodgers_2014,
+AUTHOR = {Rodgers, K. B. and Aumont, O. and Mikaloff Fletcher, S. E. and Plancherel, Y. and Bopp, L. and de Boyer Mont\'egut, C. and Iudicone, D. and Keeling, R. F. and Madec, G. and Wanninkhof, R.},
+TITLE = {Strong sensitivity of Southern Ocean carbon uptake and nutrient cycling to wind stirring},
+JOURNAL = {Biogeosciences},
+VOLUME = {11},
+YEAR = {2014},
+NUMBER = {15},
+PAGES = {4077--4098},
+URL = {HTTP://www.biogeosciences.net/11/4077/2014/},
+DOI = {10.5194/bg-11-4077-2014}
+}
+
+@ARTICLE{Rodi_1987,
+  author = {W. Rodi},
+  title = {Examples of calculation methods for flow and mixing in stratified fluids},
+  journal = JGR,
+  year = {1987},
+  volume = {92},  number = {C5},
+  pages = {5305--5328}
+}
+
+@INCOLLECTION{Roed1986,
+  author = {L.P. Roed and C.K. Cooper},
+  title = {Open boundary conditions in numerical ocean models},
+  booktitle = {Advanced Physical Oceanography Numerical Modelling},
+  publisher = { NATO ASI Series, vol. 186.},
+  year = {1986},
+  editor = {J.J. O'Brien}
+}
+
+@article{Roquet_OM2015,
+author = "F. Roquet and G. Madec and T.J. McDougall and P.M. Barker",
+title = "Accurate polynomial expressions for the density and specific volume of seawater using the TEOS-10 standard ",
+journal = OM,
+volume = "90",
+pages = "29--43",
+year = "2015",
+issn = "1463-5003",
+doi = "10.1016/j.ocemod.2015.04.002",
+url = "http://dx.doi.org/10.1016/j.ocemod.2015.04.002"
+}
+
+@article{Roquet_JPO2015,
+author = "F. Roquet and G. Madec and L. Brodeau and J. Nycander",
+title = "Defining a Simplified Yet Realistic Equation of State for Seawater",
+journal = JPO,
+volume = "45",
+pages = "2564--2579",
+year = "2015",
+doi = "10.1175/JPO-D-15-0080.1",
+url = "http://dx.doi.org/10.1175/JPO-D-15-0080.1"
+}
+
+@ARTICLE{Roullet_Madec_JGR00,
+  author = {G. Roullet and G. Madec},
+  title = {salt conservation, free surface, and varying levels: a new formulation
+	for ocean general circulation models},
+  journal = JGR,
+  year = {2000},
+  volume = {105},
+  pages = {23,927--23,942}
+}
+
+@ARTICLE{Rousset_GMD2015,
+  author = {C. Rousset and M. Vancoppenolle and G. Madec and T. Fichefet and S. Flavoni 
+            and A. Barth\'{e}lemy and R. Benshila and J. Chanut and C. L\'{e}vy and S. Masson and F. Vivier },
+  title  = {The Louvain-La-Neuve sea-ice model LIM3.6: Global and regional capabilities},
+  journal= {Geoscientific Model Development},
+  year = {2015},
+  volume = {8}, pages={2991--3005},
+  doi = {10.5194/gmd-8-2991-2015},
+  url = {http://dx.doi.org/10.5194/gmd-8-2991-2015}
+}
+
+@ARTICLE{Sadourny1975,
+  author = {R. Sadourny},
+  title = {The Dynamics of Finite-Difference Models of the Shallow-Water Equations},
+  journal = JAS,
+  year = {1975},
+  volume = {32},  number = {4},
+  pages = {680--689},
+}
+
+@ARTICLE{Sarmiento1982,
+  author = {J. L. Sarmiento and K. Bryan},
+  title = {Ocean transport model for the North Atlantic},
+  journal = JGR,
+  year = {1982},
+  volume = {87},
+  pages = {394--409}
+}
+
+@ARTICLE{Saunders_JAS82,
+  author={P. M. Saunders},
+  title={{The Temperature at the Ocean-air Interface}},
+  journal=JAS,
+  year={1967},
+  volume={24},
+  pages={269-273},
+  doi = {10.1175/1520-0469(1967)024<0269:TTATOA>2.0.CO;2},
+}
+
+@BOOK{Shchepetkin_McWilliams_Bk08,
+  author = {A. F. Shchepetkin and J. C. McWilliams},
+  title = {Handbook of Numerical Analysis, Vol. XIV: Computational Methods for the Ocean and the Atmosphere, pp 121-183},
+  publisher = {P. G. Ciarlet, editor, R. Temam and J. Tribbia, guest eds., Elsevier Science},
+  year = {2008},
+  pages = {784}
+}
+
+@ARTICLE{Shchepetkin_McWilliams_OM05,
+  author = {A. F. Shchepetkin and J. C. McWilliams},
+  title = {The regional oceanic modeling system (ROMS) - a split-explicit, free-surface,
+	topography-following-coordinate oceanic modelr},
+  journal = OM,
+  year = {2005},
+  volume = {9},  number = {4},
+  pages = {347--404}
+}
+
+@ARTICLE{Sacha2003,
+  author = {A. F. Shchepetkin and J. C. McWilliams},
+  title = {A method for computing horizontal pressure-gradient force in an oceanic
+	model with a nonaligned vertical coordinate},
+  journal = JGR,
+  year = {2003},
+  volume = {108},  number = {C3},
+  pages = {3090},
+  doi = {10.1029/2001JC001047},
+  url = {http://dx.doi.org/10.1029/2001JC001047}
+}
+
+@ARTICLE{Shchepetkin1996,
+  author = {A. F. Shchepetkin and J. J. O'Brien},
+  title = {A Physically Consistent Formulation of Lateral Friction in Shallow-Water Equation Ocean Models},
+  journal = MWR,
+  year = {1996},
+  volume = {124},  number = {6},
+  pages = {1285--1300}
+}
+
+@ARTICLE{Siddorn_Furner_OM12,
+  author = {J. Siddorn and R. Furner},
+  title = {An analytical stretching function that combines the best attributes of geopotential and terrain-following vertical coordinates},
+  journal = OM,
+  year = {2012},
+  pages = {submitted},
+}
+@ARTICLE{Simmons_al_OM04,
+  author = {H. L. Simmons and S. R. Jayne and L. C. {St. Laurent} and A. J. Weaver},
+  title = {Tidally driven mixing in a numerical model of the ocean general circulation},
+  journal = OM,
+  year = {2004},
+  pages = {245--263},
+}
+
+@INBOOK{Smagorinsky_93,
+  author = {Smagorinsky, J.},
+  chapter = {Some historical remarks on the use of non-linear viscosities},
+  title = {Large Eddy Simulation of Complex Engineering and Geophysical Flows},
+  pages = {3--36},
+  year = {1993},
+  publisher = {Cambridge University Press, B. Galperin and S. A. Orszag (eds.)},
+}
+
+@ARTICLE{Song_Haidvogel_JCP94,
+  author = {Y. Song and D. Haidvogel},
+  title = {A semi-implicit ocean circulation model using a generalized topography-following coordinate system},
+  journal = JCP,
+  year = {1994},
+  volume = {115},  number = {1},
+  pages = {228--244}
+}
+
+@ARTICLE{Song1998,
+  author = {Y. T. Song},
+  title = {A General Pressure Gradient Formulation for Ocean Models. Part I: Scheme Design and Diagnostic Analysis},
+  journal = MWR,
+  year = {1998},
+  volume = {126},  number = {12},
+  pages = {3213--3230}
+}
+
+@ARTICLE{SongWright1998,
+  author = {Y. T. Song and D. G. Wright},
+  title = {A General Pressure Gradient Formulation for Ocean Models. 
+    Part II: Energy, Momentum, and Bottom Torque Consistency},
+  journal = MWR,
+  year = {1998},
+  volume = {126},  number = {12},
+  pages = {3231--3247}
+}
+
+@ARTICLE{Speer_al_Tel00,
+  author = {K. Speer and E. Guilyardi and G. Madec},
+  title = {Southern Ocean transformation in a coupled model with and without eddy mass fluxes},
+  journal = {Tellus},
+  year = {2000},
+  volume = {52A},  number = {5},
+  pages = {554--565}
+}
+
+@PHDTHESIS{Speich_PhD92,
+  author = {S. Speich},
+  title = {Etude du for\c{c}age de la circulation g\'{e}n\'{e}rale oc\'{e}anique
+	par les d\'{e}troits - cas de la mer d'Alboran},
+  school = {Universit\'{e} Pierre et Marie Curie, Paris, France},
+  year = {1992}
+}
+
+@ARTICLE{Speich_al_GRL01,
+  author = {S. Speich and B. Blanke and G. Madec},
+  title = {Warm and cold water paths of an OGCM thermohaline conveyor belt},
+  journal = GRL,
+  year = {2001},
+  volume = {28},  number = {2},
+  pages = {311--314}
+}
+
+@ARTICLE{Speich_al_JPO96,
+  author = {S. Speich and G. Madec and M. Cr\'{e}pon},
+  title = {The circulation in the Alboran Sea - a sensitivity study},
+  journal = JPO,
+  year = {1996},
+  volume = {26},  number = {3},
+  pages = {320--340}
+}
+
+@ARTICLE{St_Laurent_Garrett_JPO02,
+  author = {L.C. {St. Laurent} and C. Garrett},
+  title = {The role of internal tides in mixing the deep ocean},
+  journal = JPO,
+  pages = {2882--2899}
+}
+
+@ARTICLE{St_Laurent_Nash_DSR04,
+  author = {L.C. {St. Laurent} and J. D. Nash},
+  title = {An examination of the radiative and dissipative properties of deep ocean internal tides},
+  journal = DSR,
+  year = {2004},
+  volume = {II},  number = {51},
+  pages = {3029--3042},
+  doi = {10.1016/j.dsr2.2004.09.008},
+  url = {http://dx.doi.org/10.1016/j.dsr2.2004.09.008}
+}
+
+@ARTICLE{St_Laurent_al_GRL02,
+  author = {L.C. {St. Laurent} and H.L. Simmons and S.R. Jayne},
+  title = {Estimating tidally driven mixing in the deep ocean},
+  journal = GRL,
+  year = {2002},
+  volume = {29},
+  pages = {2106},
+  doi = {10.1029/2002GL015633},
+  url = {http://dx.doi.org/10.1029/2002GL015633}
+}
+
+@ARTICLE{Stacey_JPO99,
+  author = {M. W. Stacey},
+  title = {Simulations of the wind-forced near-surface circulation in Knight Inlet: 
+             A parameterization of the roughness length},
+  journal = JPO,
+  year = {1999},
+  volume = {29},
+  pages = {1363--1367},
+}
+
+@ARTICLE{Steele2001,
+  author = {M. Steele and R. Morley and W. Ermold},
+  title = {PHC- A Global Ocean Hydrography with a High-Quality Arctic Ocean},
+  journal = JC,
+  year = {2001},
+  volume = {14},  number = {9},
+  pages = {2079--2087},
+}
+
+@ARTICLE{Stein_Stein_Nat92,
+  author = {C. A. Stein and S. Stein},
+  title = {A model for the global variation in oceanic depth and heat flow with lithospheric age},
+  journal = {Nature},
+  year = {1992},
+  volume = {359},
+  pages = {123--129}
+}
+
+@ARTICLE{Takaya_al_JGR10,
+  author = {Y. Takaya and J-R. Bidlot and A. C. M. Beljaars and 
+                  P. A. E. M. Janssen},
+  title = {Refinements to a prognostic scheme of sea surface skin temperature},
+  journal = JGR,
+  year   = 	 {2010},
+  Volume = 	 {115},
+  Pages  = 	 {C06009},
+  doi    = {10.1029/2009JC005985},
+}
+
+@ARTICLE{Talagrand_JAS72,
+  author = {O. Talagrand},
+  title = {On the damping of high-frequency motions in four-dimensional 
+           assimilation of meteorological data},
+  journal = JAS,
+  year = {1972},
+  volume = {29},
+  pages = {1571-1574}
+}
+
+@ARTICLE{Thiem_Berntsen_OM06,
+  author = {O. Thiem and J. Berntsen},
+  title = {Internal pressure errors in sigma-coordinate ocean models due to anisotropy},
+  journal = OM,
+  year = {2006},
+  volume = {12},  number = {1-2},
+}
+
+@ARTICLE{Timmermann_al_OM05,
+  author = {R. Timmermann and H. Goosse and G. Madec and T. Fichefet and C. \'{E}the and V. Duli\`{e}re},
+  title = {On the representation of high latitude processes in the ORCA-LIM global coupled sea ice-ocean model},
+  journal = OM,
+  year = {2005},
+  volume = {8},
+  pages = {175--201}
+}
+
+@ARTICLE{Tonani_al_OS08,
+  author = {M. Tonani and N. Pinardi and S. Dobricic and I. Pujol and C. Fratianni},
+  title = {A high-resolution free-surface model of the Mediterranean Sea},
+  journal = OS,
+  year = {2008},
+  volume = {4},
+  pages = {1--14}
+}
+
+@ARTICLE{Treguier_JGR92,
+  author = {A.M. Tr\'{e}guier},
+  title = {Kinetic energy analysis of an eddy resolving, primitive equation North Atlantic model},
+  journal = JGR,
+  year = {1992},
+  volume = {97},
+  pages = {687--701}
+}
+
+@ARTICLE{Treguier_al_JGR01,
+  author = {A.M. Tr\'{e}guier and B. Barnier and A.P. de Miranda and J.M. Molines
+    and N. Grima and M. Imbard and G. Madec and C. Messager and T. Reynaud and S. Michel},
+  title = {An Eddy Permitting model of the Atlantic circulation: evaluating open boundary conditions},
+  journal = JGR,
+  year = {2001},
+  volume = {106},
+  pages = {22,115--22,129}
+}
+
+@ARTICLE{Treguier_al_DSR03,
+  author = {A.-M. Tr\'{e}guier and O. Boedel and B. Barnier and G. Madec},
+  title = {Agulhas eddy fluxes in a 1/6^o Atlantic model},
+  journal = DSR,
+  year = {2003},
+  pages = {251--280}
+}
+
+@ARTICLE{Treguier1996,
+  author = {A.-M. Tr\'{e}guier and J. Dukowicz and K. Bryan},
+  title = {Properties of nonuniform grids used in ocean general circulation models},
+  journal = JGR,
+  year = {1996},
+  volume = {101},
+  pages = {20,877--20,881}
+}
+
+@ARTICLE{Treguier_al_OS07,
+  author = {A.-M. Tr\'{e}guier and M. H. England and S. R. Rintoul and G. Madec and J. Le Sommer and J.-M. Molines},
+  title = {Southern Ocean overturning across streamlines in an eddying simulation of the Antarctic Circumpolar Current},
+  journal = OS,
+  year = {2007},
+  volume = {4},
+  pages = {653--698}
+}
+
+@ARTICLE{Treguier_al_OD06,
+  author = {A.-M. Tr\'{e}guier and C. Gourcuff and P. Lherminier and H. Mercier and B. Barnier 
+  and G. Madec and J.-M. Molines and T. Penduff and L. Czeschel and C. Böning},
+  title = {Internal and forced variability along a section between Greenland
+	and Portugal in the CLIPPER Atlantic model},
+  journal = OD,
+  year = {2006},
+  volume = {56},
+  pages = {568--580},
+  doi = {10.1007/s10236-006-0069-y},
+  url = {http://dx.doi.org/10.1007/s10236-006-0069-y}
+}
+
+@ARTICLE{Treguier1997,
+  author = {A. M. Tr\'{e}guier and I. M. Held and V. D. Larichev},
+  title = {Parameterization of Quasigeostrophic Eddies in Primitive Equation Ocean Models},
+  journal = JPO,
+  year = {1997},
+  volume = {27},  number = {4},
+  pages = {567--580}
+}
+
+@ARTICLE{Tu_Tsuang_GRL05,
+  title={{Cool-skin simulation by a one-column ocean model}},
+  author={{C-Y}. Tu  and {B-J}. Tsuang},
+  journal=GRL,
+  year={2005},
+  volume={32},
+  pages={L22602},
+  doi = {10.1029/2005GL024252},
+}
+
+@ARTICLE{Umlauf_Burchard_JMS03,
+  author = {L. Umlauf and H. Burchard},
+  title = {A generic length-scale equation for geophysical turbulence models},
+  journal = JMS, 
+  year = {2003},
+  volume = {61},  number = {2},
+  pages = {235--265}
+}
+
+@ARTICLE{Umlauf_Burchard_CSR05,
+  author = {L. Umlauf and H. Burchard},
+  title = {Second-order turbulence closure models for geophysical boundary layers. A review of recent work},
+  journal = JMS, 
+  year = {2005},
+  volume = {25},
+  pages = {795--827}
+}
+
+@BOOK{UNESCO1983,
+  title = {Algorithms for computation of fundamental property of sea water},
+  publisher = {Techn. Paper in Mar. Sci, 44, UNESCO},
+  year = {1983},
+  author = {UNESCO}
+}
+
+@TECHREPORT{OASIS2006,
+  author = {S. Valcke},
+  title = {OASIS3 User Guide (prism\_2-5)},
+  institution = {PRISM Support Initiative Report No 3, CERFACS, Toulouse, France},
+  year = {2006},
+  pages = {64pp}
+}
+
+@TECHREPORT{Valcke_al_Rep00,
+  author = {S. Valcke and L. Terray and A. Piacentini },
+  title = {The OASIS Coupled User Guide Version 2.4},
+  institution = {CERFACS},
+  year = {2000},
+  number = {TR/CMGC/00-10}
+}
+
+@ARTICLE{Vancoppenolle_al_OM09b,
+  author = {M. Vancoppenolle and T. Fichefet and H. Goosse},
+  title = {Simulating the mass balance and salinity of Arctic and Antarctic sea ice. 2. 
+     Importance of sea ice salinity variations},
+  journal = OM,
+  year = {2009},
+  volume = {27},
+  pages = {54--69}
+}
+
+@book{Vallis06,
+author = {Vallis, G. K.},
+title = {Atmospheric and Oceanic Fluid Dynamics},
+publisher = {Cambridge University Press},
+address = {Cambridge, U.K.},
+year = {2006},
+pages = {745},
+}
+
+@ARTICLE{Vancoppenolle_al_OM09a,
+  author = {M. Vancoppenolle and T. Fichefet and H. Goosse and S. Bouillon and
+	G. Madec and M. A. Morales Maqueda},
+  title = {Simulating the mass balance and salinity of Arctic and Antarctic
+	sea ice. 1. Model description and validation},
+  journal = OM,
+  year = {2009},
+  volume = {27},
+  pages = {33--53},
+  doi = {10.1016/j.ocemod.2008.10.005},
+  url = {http://dx.doi.org/10.1016/j.ocemod.2008.10.005}
+}
+
+@ARTICLE{Vialard_al_JPO01,
+  author = {J. Vialard and C. Menkes and J.-P. Boulanger and P. Delecluse and
+	E. Guilyardi and M.J. McPhaden and G. Madec},
+  title = {A Model Study of Oceanic Mechanisms Affecting Equatorial Pacific
+	Sea Surface Temperature During the 1997-98 El Niño},
+  journal = JPO,
+  year = {2001},
+  volume = {31},  number = {7},
+  pages = {1649--1675}
+}
+
+@ARTICLE{Warner_al_OM05,
+  author = {J. C. Warner and C. R. Sherwood and H. G. Arango and R. P. Signell},
+  title = {Performance of four turbulence closure models implemented using a generic length scale method},
+  journal = OM,
+  year = {2005},
+  volume = {8},
+  pages = {81--113},
+  doi = {10.1016/j.ocemod.2003.12.003},
+  url = {http://dx.doi.org/j.ocemod.2003.12.003}
+}
+
+@ARTICLE{Weatherly_JMR84,
+  author = {G. L. Weatherly},
+  title = {An estimate of bottom frictional dissipation by Gulf Stream fluctuations},
+  journal = JMR,
+  year = {1984},
+  volume = {42},  number = {2},
+  pages = {289--301}
+}
+
+@ARTICLE{Weaver_Eby_JPO97,
+  author = {A. J. Weaver and M. Eby},
+  title = {On the numerical implementation of advection schemes for use in conjuction
+	with various mixing parameterizations in the GFDL ocean model},
+  journal = JPO,
+  year = {1997},
+  volume = {27}
+}
+
+@ARTICLE{Webb_al_JAOT98,
+  author = {D. J. Webb and B. A. de Cuevas and C. S. Richmond},
+  title = {Improved Advection Schemes for Ocean Models},
+  journal = JAOT,
+  year = {1998},
+  volume = {15},  number = {5},
+  pages = {1171--1187},
+}
+
+@ARTICLE{White_al_JCP09,
+  author = {L. White and A. Adcroft and R. Hallberg},
+  title = {High-order regridding-remapping schemes for continuous isopycnal
+	and generalized coordinates in ocean models},
+  journal = JC,
+  year = {2009},
+  volume = {228},
+  pages = {8665--8692}
+}
+
+@ARTICLE{Wilcox_1988,
+  author = {D. C. Wilcox},
+  title = {Reassessment of the scale-determining equation for advanced turbulence models},
+  journal = {AIAA journal},
+  year = {1988},
+  volume = {26},  number = {11},
+  pages = {1299--1310}
+}
+
+@ARTICLE{Willebrand_al_PO01,
+  author = {J. Willebrand and B. Barnier and C. Boning and C. Dieterich and P.
+	D. Killworth and C. Le Provost and Y. Jia and J.-M. Molines and A. L. New},
+  title = {Circulation characteristics in three eddy-permitting models of the North Atlantic},
+  journal = PO,
+  year = {2001},
+  volume = {48},  number = {2},
+  pages = {123--161}
+}
+
+@ARTICLE{Williams_al_DAO09,
+  author = {P.D. Williams and E. Guilyardi and G. Madec and S. Gualdi and E. Scoccimarro},
+  title = {The role of mean ocean salinity on climate},
+  journal = DAO,
+  year = {2010},
+  volume = {49},  number = {2-3},
+  pages = {108--123},
+  doi = {10.1016/j.dynatmoce.2009.02.001},
+  url = {http://dx.doi.org/10.1016/j.dynatmoce.2009.02.001}
+}
+
+@ARTICLE{Williams_al_GRL07,
+  author = {P.D. Williams and E. Guilyardi and R. Sutton and J.M. Gregory and G. Madec},
+  title = {A new feedback on climate change from the hydrological cycle},
+  journal = GRL,
+  year = {2007},
+  volume = {34},
+  pages = {L08706},
+  doi = {10.1029/2007GL029275},
+  url = {http://dx.doi.org/10.1029/2007GL029275}
+}
+
+@ARTICLE{Williams_al_CD06,
+  author = {P.D. Williams and E. Guilyardi and R. Sutton and J.M. Gregory and G. Madec},
+  title = {On the climate response of the low-latitude Pacific ocean to changes in the global freshwater cycle},
+  journal = CD,
+  year = {2006},
+  volume = {27},
+  pages = {593--611}
+}
+
+@ARTICLE{Zalesak_JCP79,
+  author = {S. T. Zalesak},
+  title = {Fully multidimensional flux corrected transport algorithms for fluids},
+  journal = JCP,
+  year = {1979},
+  volume = {31}
+}
+
+@ARTICLE{Zhang_Endoh_JGR92,
+  author = {Zhang, R.-H. and Endoh, M.},
+  title = {A free surface general circulation model for the tropical Pacific Ocean},
+  journal = JGR,
+  year = {1992},
+  volume = {97},
+  pages = {11,237--11,255}
+}
+
+@comment{jabref-meta: groupsversion:3;}
+
+@comment{jabref-meta: groupstree:
+0 AllEntriesGroup:;
+1 ExplicitGroup:El Nino\;2\;blanketal97\;;
+2 ExplicitGroup:97/98 event\;0\;;
+2 ExplicitGroup:Forecast\;0\;;
+2 ExplicitGroup:GHG change\;0\;;
+2 ExplicitGroup:in GCMs\;0\;;
+2 ExplicitGroup:in MIPs\;0\;;
+2 ExplicitGroup:momentum balance\;0\;;
+2 ExplicitGroup:Obs analysis\;0\;;
+2 ExplicitGroup:Paleo\;0\;;
+2 ExplicitGroup:Previous events\;0\;;
+2 ExplicitGroup:Reviews\;0\;;
+2 ExplicitGroup:Simple models\;0\;Zhang_Endoh_JGR92\;;
+2 ExplicitGroup:SPL, SC, mean\;0\;;
+2 ExplicitGroup:Teleconnections\;0\;;
+2 ExplicitGroup:Low freq\;0\;;
+2 ExplicitGroup:Theory\;0\;;
+2 ExplicitGroup:Energetics\;0\;;
+1 ExplicitGroup:Diurnal in tropics\;0\;;
+1 ExplicitGroup:Indian\;0\;;
+1 ExplicitGroup:Atlantic\;0\;;
+1 ExplicitGroup:MJO, IO, TIW\;2\;;
+2 ExplicitGroup:Obs\;0\;;
+2 ExplicitGroup:GCM\;0\;;
+2 ExplicitGroup:Mechanims\;0\;;
+2 ExplicitGroup:TIW\;0\;;
+1 ExplicitGroup:Observations\;2\;;
+2 ExplicitGroup:ERBE\;0\;;
+2 ExplicitGroup:Tropical\;0\;;
+2 ExplicitGroup:Global\;0\;;
+2 ExplicitGroup:Clouds\;0\;;
+2 ExplicitGroup:Scale interactions\;0\;;
+1 ExplicitGroup:Mechanisms\;2\;;
+2 ExplicitGroup:CRF\;0\;;
+2 ExplicitGroup:Water vapor\;0\;;
+2 ExplicitGroup:Atmos mechanisms\;0\;;
+1 ExplicitGroup:GCMs\;2\;;
+2 ExplicitGroup:Uncertainty\;0\;;
+2 ExplicitGroup:Momentum balance\;0\;;
+1 ExplicitGroup:Climate change\;0\;;
+2 ExplicitGroup:IPCC AR4\;0\;;
+1 ExplicitGroup:Analysis tools\;0\;;
+1 KeywordGroup:EG publis\;0\;author\;guilyardi\;0\;0\;;
+}
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Abstracts_Foreword.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 8732)
@@ -0,0 +1,73 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+
+% ================================================================
+% Abstract (English / French)
+% ================================================================
+
+\chapter*{Abstract / R\'{e}sum\'{e}}
+
+\vspace{-40pt}
+
+{\small
+The ocean engine of NEMO (Nucleus for European Modelling of the Ocean) is a primitive 
+equation model adapted to regional and global ocean circulation problems. It is intended to 
+be a flexible tool for studying the ocean and its interactions with the others components of 
+the earth climate system over a wide range of space and time scales. 
+Prognostic variables are the three-dimensional velocity field, a non-linear sea surface height, 
+the \textit{Conservative} Temperature and the \textit{Absolute} Salinity. 
+In the horizontal direction, the model uses a curvilinear orthogonal grid and in the vertical direction, 
+a full or partial step $z$-coordinate, or $s$-coordinate, or a mixture of the two. 
+The distribution of variables is a three-dimensional Arakawa C-type grid. 
+Various physical choices are available to describe ocean physics, including TKE, and GLS vertical physics. 
+Within NEMO, the ocean is interfaced with a sea-ice model (LIM or CICE), passive tracer and 
+biogeochemical models (TOP) and, via the OASIS coupler, with several atmospheric general circulation models. 
+It also support two-way grid embedding via the AGRIF software.
+
+% ================================================================
+% \vspace{0.5cm}
+
+%Le moteur oc\'{e}anique de NEMO (Nucleus for European Modelling of the Ocean) est un 
+%mod\`{e}le aux \'{e}quations primitives de la circulation oc\'{e}anique r\'{e}gionale et globale. 
+%Il se veut un outil flexible pour \'{e}tudier sur un vaste spectre spatiotemporel l'oc\'{e}an et ses 
+%interactions avec les autres composantes du syst\`{e}me climatique terrestre. 
+%Les variables pronostiques sont le champ tridimensionnel de vitesse, une hauteur de la mer 
+%lin\'{e}aire, la Temp\'{e}rature Conservative et la Salinit\'{e} Absolue. 
+%La distribution des variables se fait sur une grille C d'Arakawa tridimensionnelle utilisant une 
+%coordonn\'{e}e verticale $z$ \`{a} niveaux entiers ou partiels, ou une coordonn\'{e}e s, ou encore 
+%une combinaison des deux. Diff\'{e}rents choix sont propos\'{e}s pour d\'{e}crire la physique 
+%oc\'{e}anique, incluant notamment des physiques verticales TKE et GLS. A travers l'infrastructure 
+%NEMO, l'oc\'{e}an est interfac\'{e} avec des mod\`{e}les de glace de mer (LIM ou CICE), 
+%de biog\'{e}ochimie marine et de traceurs passifs, et, via le coupleur OASIS, \`{a} plusieurs 
+%mod\`{e}les de circulation g\'{e}n\'{e}rale atmosph\'{e}rique. 
+%Il supporte \'{e}galement l'embo\^{i}tement interactif de maillages via le logiciel AGRIF.
+} 
+
+% ================================================================
+% Disclaimer
+% ================================================================
+\chapter*{Disclaimer}
+
+Like all components of NEMO, the ocean component is developed under the CECILL license, 
+which is a French adaptation of the GNU GPL (General Public License). Anyone may use it 
+freely for research purposes, and is encouraged to communicate back to the NEMO team 
+its own developments and improvements. The model and the present document have been 
+made available as a service to the community. We cannot certify that the code and its manual 
+are free of errors. Bugs are inevitable and some have undoubtedly survived the testing phase. 
+Users are encouraged to bring them to our attention. The author assumes no responsibility 
+for problems, errors, or incorrect usage of NEMO.
+
+ \vspace{1cm}
+NEMO reference in papers and other publications is as follows:
+ \vspace{0.5cm}
+
+Madec, G., and the NEMO team, 2008: NEMO ocean engine. 
+\textit{Note du P\^ole de mod\'{e}lisation}, Institut Pierre-Simon Laplace (IPSL), France, 
+No 27, ISSN No 1288-1619.\\
+
+
+ \vspace{0.5cm}
+Additional information can be found on \href{http://www.nemo-ocean.eu/}{nemo-ocean.eu} website.
+ \vspace{0.5cm}
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_A.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_A.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_A.tex	(revision 8732)
@@ -0,0 +1,536 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+
+% ================================================================
+% Chapter Ñ Appendix A : Curvilinear s-Coordinate Equations
+% ================================================================
+\chapter{Curvilinear $s-$Coordinate Equations}
+\label{Apdx_A}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Chain rule
+% ================================================================
+\section{The chain rule for $s-$coordinates}
+\label{Apdx_A_continuity}
+
+In order to establish the set of Primitive Equation in curvilinear $s$-coordinates
+($i.e.$ an orthogonal curvilinear coordinate in the horizontal and an Arbitrary Lagrangian 
+Eulerian (ALE) coordinate in the vertical), we start from the set of equations established 
+in \S\ref{PE_zco_Eq} for the special case $k = z$ and thus $e_3 = 1$, and we introduce 
+an arbitrary vertical coordinate $a = a(i,j,z,t)$. Let us define a new vertical scale factor by 
+$e_3 = \partial z / \partial s$ (which now depends on $(i,j,z,t)$) and the horizontal 
+slope of $s-$surfaces by :
+\begin{equation} \label{Apdx_A_s_slope}
+\sigma _1 =\frac{1}{e_1 }\;\left. {\frac{\partial z}{\partial i}} \right|_s 
+\quad \text{and} \quad 
+\sigma _2 =\frac{1}{e_2 }\;\left. {\frac{\partial z}{\partial j}} \right|_s 
+\end{equation}
+
+The chain rule to establish the model equations in the curvilinear $s-$coordinate 
+system is:
+\begin{equation} \label{Apdx_A_s_chain_rule}
+\begin{aligned}
+&\left. {\frac{\partial \bullet }{\partial t}} \right|_z  =
+\left. {\frac{\partial \bullet }{\partial t}} \right|_s 
+	 -\frac{\partial \bullet }{\partial s}\;\frac{\partial s}{\partial t} \\
+&\left. {\frac{\partial \bullet }{\partial i}} \right|_z  =
+  \left. {\frac{\partial \bullet }{\partial i}} \right|_s 
+  	  -\frac{\partial \bullet }{\partial s}\;\frac{\partial s}{\partial i}=
+	  \left. {\frac{\partial \bullet }{\partial i}} \right|_s 
+	  -\frac{e_1 }{e_3 }\sigma _1 \frac{\partial \bullet }{\partial s} \\
+&\left. {\frac{\partial \bullet }{\partial j}} \right|_z  =
+\left. {\frac{\partial \bullet }{\partial j}} \right|_s 
+	- \frac{\partial \bullet }{\partial s}\;\frac{\partial s}{\partial j}=
+\left. {\frac{\partial \bullet }{\partial j}} \right|_s 
+	- \frac{e_2 }{e_3 }\sigma _2 \frac{\partial \bullet }{\partial s} \\
+&\;\frac{\partial \bullet }{\partial z}  \;\; = \frac{1}{e_3 }\frac{\partial \bullet }{\partial s} \\
+\end{aligned}
+\end{equation}
+
+In particular applying the time derivative chain rule to $z$ provides the expression 
+for $w_s$,  the vertical velocity of the $s-$surfaces referenced to a fix z-coordinate:
+\begin{equation} \label{Apdx_A_w_in_s}
+w_s   =  \left.   \frac{\partial z }{\partial t}   \right|_s 
+				= \frac{\partial z}{\partial s} \; \frac{\partial s}{\partial t} 
+			    = e_3 \, \frac{\partial s}{\partial t} 
+\end{equation}
+
+
+% ================================================================
+% continuity equation
+% ================================================================
+\section{Continuity Equation in $s-$coordinates}
+\label{Apdx_A_continuity}
+
+Using (\ref{Apdx_A_s_chain_rule}) and the fact that the horizontal scale factors 
+$e_1$ and $e_2$ do not depend on the vertical coordinate, the divergence of 
+the velocity relative to the ($i$,$j$,$z$) coordinate system is transformed as follows
+in order to obtain its expression in the curvilinear $s-$coordinate system:
+
+\begin{subequations} 
+\begin{align*} {\begin{array}{*{20}l} 
+\nabla \cdot {\rm {\bf U}} 
+&= \frac{1}{e_1 \,e_2 }  \left[ \left. {\frac{\partial (e_2 \,u)}{\partial i}} \right|_z 
+						+\left. {\frac{\partial(e_1 \,v)}{\partial j}} \right|_z  \right]
++ \frac{\partial w}{\partial z} 		\\
+\\
+&     = \frac{1}{e_1 \,e_2 }  \left[ 
+		  \left.   \frac{\partial (e_2 \,u)}{\partial i}    \right|_s       
+		  - \frac{e_1 }{e_3 } \sigma _1 \frac{\partial (e_2 \,u)}{\partial s}
+		+ \left.   \frac{\partial (e_1 \,v)}{\partial j}    \right|_s       
+		  - \frac{e_2 }{e_3 } \sigma _2 \frac{\partial (e_1 \,v)}{\partial s}	\right]
+	+ \frac{\partial w}{\partial s} \; \frac{\partial s}{\partial z}                        \\
+\\
+&     = \frac{1}{e_1 \,e_2 }   \left[ 
+		  \left.   \frac{\partial (e_2 \,u)}{\partial i}    \right|_s       
+		+ \left.   \frac{\partial (e_1 \,v)}{\partial j}    \right|_s       	\right]
+	+ \frac{1}{e_3 }\left[        \frac{\partial w}{\partial s}
+						-  \sigma _1 \frac{\partial u}{\partial s}
+						-  \sigma _2 \frac{\partial v}{\partial s}      \right]          \\
+\\
+&     = \frac{1}{e_1 \,e_2 \,e_3 }   \left[ 
+		  \left.   \frac{\partial (e_2 \,e_3 \,u)}{\partial i}    \right|_s  
+		  -\left.    e_2 \,u    \frac{\partial e_3 }{\partial i}     \right|_s      
+		+ \left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j}    \right|_s
+		  - \left.    e_1 v      \frac{\partial e_3 }{\partial j}    \right|_s   \right]          \\
+& \qquad \qquad \qquad \qquad \qquad \qquad \qquad \qquad \qquad
+	+ \frac{1}{e_3 } \left[        \frac{\partial w}{\partial s}
+						-  \sigma _1 \frac{\partial u}{\partial s}
+						-  \sigma _2 \frac{\partial v}{\partial s}      \right]      \\
+%
+\intertext{Noting that $
+  \frac{1}{e_1} \left.{ \frac{\partial e_3}{\partial i}} \right|_s 
+=\frac{1}{e_1} \left.{ \frac{\partial^2 z}{\partial i\,\partial s}} \right|_s 
+=\frac{\partial}{\partial s} \left( {\frac{1}{e_1 } \left.{ \frac{\partial z}{\partial i} }\right|_s } \right)
+=\frac{\partial \sigma _1}{\partial s}
+$ and $
+\frac{1}{e_2 }\left. {\frac{\partial e_3 }{\partial j}} \right|_s 
+=\frac{\partial \sigma _2}{\partial s}
+$, it becomes:}
+%
+\nabla \cdot {\rm {\bf U}} 
+& = \frac{1}{e_1 \,e_2 \,e_3 }  \left[   
+		  \left.  \frac{\partial (e_2 \,e_3 \,u)}{\partial i} \right|_s 
+		+\left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j} \right|_s        \right]        \\ 
+& \qquad \qquad \qquad \qquad \quad
+ +\frac{1}{e_3 }\left[ {\frac{\partial w}{\partial s}-u\frac{\partial \sigma _1 }{\partial s}-v\frac{\partial \sigma _2 }{\partial s}-\sigma _1 \frac{\partial u}{\partial s}-\sigma _2 \frac{\partial v}{\partial s}} \right] \\ 
+\\
+& = \frac{1}{e_1 \,e_2 \,e_3 }  \left[   
+		  \left.  \frac{\partial (e_2 \,e_3 \,u)}{\partial i} \right|_s 
+		+\left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j} \right|_s        \right]      
+   + \frac{1}{e_3 } \; \frac{\partial}{\partial s}   \left[  w -  u\;\sigma _1  - v\;\sigma _2  \right]
+\end{array} } 		
+\end{align*}
+\end{subequations}
+
+Here, $w$ is the vertical velocity relative to the $z-$coordinate system. 
+Introducing the dia-surface velocity component, $\omega $, defined as 
+the volume flux across the moving $s$-surfaces per unit horizontal area:
+\begin{equation} \label{Apdx_A_w_s}
+\omega  = w - w_s - \sigma _1 \,u - \sigma _2 \,v    \\
+\end{equation}
+with $w_s$ given by \eqref{Apdx_A_w_in_s}, we obtain the expression for 
+the divergence of the velocity in the curvilinear $s-$coordinate system:
+\begin{subequations} 
+\begin{align*} {\begin{array}{*{20}l} 
+\nabla \cdot {\rm {\bf U}} 
+&= \frac{1}{e_1 \,e_2 \,e_3 }    \left[ 
+		  \left.  \frac{\partial (e_2 \,e_3 \,u)}{\partial i} \right|_s 
+		+\left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j} \right|_s        \right]      
++ \frac{1}{e_3 } \frac{\partial \omega }{\partial s} 
++ \frac{1}{e_3 } \frac{\partial w_s       }{\partial s}    \\
+\\
+&= \frac{1}{e_1 \,e_2 \,e_3 }    \left[ 
+		  \left.  \frac{\partial (e_2 \,e_3 \,u)}{\partial i} \right|_s 
+		+\left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j} \right|_s        \right]      
++ \frac{1}{e_3 } \frac{\partial \omega }{\partial s} 
++ \frac{1}{e_3 } \frac{\partial}{\partial s}  \left(  e_3 \; \frac{\partial s}{\partial t}   \right)   \\
+\\
+&= \frac{1}{e_1 \,e_2 \,e_3 }    \left[ 
+		  \left.  \frac{\partial (e_2 \,e_3 \,u)}{\partial i} \right|_s 
+		+\left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j} \right|_s        \right]      
++ \frac{1}{e_3 } \frac{\partial \omega }{\partial s} 
++ \frac{\partial}{\partial s} \frac{\partial s}{\partial t}
++ \frac{1}{e_3 } \frac{\partial s}{\partial t} \frac{\partial e_3}{\partial s}     \\
+\\
+&= \frac{1}{e_1 \,e_2 \,e_3 }    \left[ 
+		  \left.  \frac{\partial (e_2 \,e_3 \,u)}{\partial i} \right|_s 
+		+\left.  \frac{\partial (e_1 \,e_3 \,v)}{\partial j} \right|_s        \right]      
++ \frac{1}{e_3 } \frac{\partial \omega }{\partial s} 
++ \frac{1}{e_3 } \frac{\partial e_3}{\partial t}     \\
+\end{array} } 		
+\end{align*}
+\end{subequations}
+
+As a result, the continuity equation \eqref{Eq_PE_continuity} in the 
+$s-$coordinates is:
+\begin{equation} \label{Apdx_A_sco_Continuity}
+\frac{1}{e_3 } \frac{\partial e_3}{\partial t} 
++ \frac{1}{e_1 \,e_2 \,e_3 }\left[ 
+			{\left. {\frac{\partial (e_2 \,e_3 \,u)}{\partial i}} \right|_s 
+		    +  \left. {\frac{\partial (e_1 \,e_3 \,v)}{\partial j}} \right|_s } \right]
+ +\frac{1}{e_3 }\frac{\partial \omega }{\partial s} = 0   
+\end{equation}
+A additional term has appeared that take into account the contribution of the time variation 
+of the vertical coordinate to the volume budget.
+
+
+% ================================================================
+% momentum equation
+% ================================================================
+\section{Momentum Equation in $s-$coordinate}
+\label{Apdx_A_momentum}
+
+Here we only consider the first component of the momentum equation, 
+the generalization to the second one being straightforward.
+
+$\ $\newline    % force a new ligne
+
+$\bullet$ \textbf{Total derivative in vector invariant form}
+
+Let us consider \eqref{Eq_PE_dyn_vect}, the first component of the momentum 
+equation in the vector invariant form. Its total $z-$coordinate time derivative, 
+$\left. \frac{D u}{D t} \right|_z$ can be transformed as follows in order to obtain 
+its expression in the curvilinear $s-$coordinate system:
+
+\begin{subequations} 
+\begin{align*} {\begin{array}{*{20}l} 
+\left. \frac{D u}{D t} \right|_z 
+&= \left. {\frac{\partial u }{\partial t}} \right|_z 
+   - \left. \zeta \right|_z v 
+  + \frac{1}{2e_1} \left.{ \frac{\partial (u^2+v^2)}{\partial i}} \right|_z 
+  + w \;\frac{\partial u}{\partial z} \\
+\\
+&= \left. {\frac{\partial u }{\partial t}} \right|_z 
+   - \left. \zeta \right|_z v 
+  +  \frac{1}{e_1 \,e_2 }\left[ { \left.{ \frac{\partial (e_2 \,v)}{\partial i} }\right|_z 
+                                             -\left.{ \frac{\partial (e_1 \,u)}{\partial j} }\right|_z } \right] \; v     
+  +  \frac{1}{2e_1} \left.{ \frac{\partial (u^2+v^2)}{\partial i} } \right|_z 
+  +  w \;\frac{\partial u}{\partial z}      \\
+%
+\intertext{introducing the chain rule (\ref{Apdx_A_s_chain_rule}) }
+%
+&= \left. {\frac{\partial u }{\partial t}} \right|_z       
+   - \frac{1}{e_1\,e_2}\left[ { \left.{ \frac{\partial (e_2 \,v)}{\partial i} } \right|_s 
+                                          -\left.{ \frac{\partial (e_1 \,u)}{\partial j} } \right|_s } \right.
+                                          \left. {-\frac{e_1}{e_3}\sigma _1 \frac{\partial (e_2 \,v)}{\partial s}
+                                                   +\frac{e_2}{e_3}\sigma _2 \frac{\partial (e_1 \,u)}{\partial s}} \right] \; v  \\ 
+& \qquad \qquad \qquad \qquad
+ { + \frac{1}{2e_1} \left(                                  \left.  \frac{\partial (u^2+v^2)}{\partial i} \right|_s 
+                                    - \frac{e_1}{e_3}\sigma _1 \frac{\partial (u^2+v^2)}{\partial s}               \right)
+   + \frac{w}{e_3 } \;\frac{\partial u}{\partial s} }    \\
+\\
+&= \left. {\frac{\partial u }{\partial t}} \right|_z       
+  + \left. \zeta \right|_s \;v
+  + \frac{1}{2\,e_1}\left. {\frac{\partial (u^2+v^2)}{\partial i}} \right|_s      \\
+&\qquad \qquad \qquad \quad
+  + \frac{w}{e_3 } \;\frac{\partial u}{\partial s}
+   - \left[   {\frac{\sigma _1 }{e_3 }\frac{\partial v}{\partial s}
+               - \frac{\sigma_2 }{e_3 }\frac{\partial u}{\partial s}}   \right]\;v      
+   - \frac{\sigma _1 }{2e_3 }\frac{\partial (u^2+v^2)}{\partial s}      \\
+\\
+&= \left. {\frac{\partial u }{\partial t}} \right|_z       
+  + \left. \zeta \right|_s \;v
+  + \frac{1}{2\,e_1}\left. {\frac{\partial (u^2+v^2)}{\partial i}} \right|_s      \\
+&\qquad \qquad \qquad \quad
+ + \frac{1}{e_3} \left[    {w\frac{\partial u}{\partial s}
+	                        +\sigma _1 v\frac{\partial v}{\partial s} - \sigma _2 v\frac{\partial u}{\partial s}
+	                        - \sigma _1 u\frac{\partial u}{\partial s} - \sigma _1 v\frac{\partial v}{\partial s}} \right] \\
+\\
+&= \left. {\frac{\partial u }{\partial t}} \right|_z       
+  + \left. \zeta \right|_s \;v
+  + \frac{1}{2\,e_1}\left. {\frac{\partial (u^2+v^2)}{\partial i}} \right|_s  
+  + \frac{1}{e_3} \left[  w - \sigma _2 v - \sigma _1 u  \right] 
+		  			 \; \frac{\partial u}{\partial s}   \\
+%
+\intertext{Introducing $\omega$, the dia-a-surface velocity given by (\ref{Apdx_A_w_s}) }
+%
+&= \left. {\frac{\partial u }{\partial t}} \right|_z       
+  + \left. \zeta \right|_s \;v
+  + \frac{1}{2\,e_1}\left. {\frac{\partial (u^2+v^2)}{\partial i}} \right|_s  
+  + \frac{1}{e_3 } \left( \omega - w_s \right) \frac{\partial u}{\partial s}   \\
+\end{array} } 		
+\end{align*}
+\end{subequations}
+%
+Applying the time derivative chain rule (first equation of (\ref{Apdx_A_s_chain_rule}))
+to $u$ and using (\ref{Apdx_A_w_in_s}) provides the expression of the last term 
+of the right hand side,
+\begin{equation*} {\begin{array}{*{20}l} 
+w_s  \;\frac{\partial u}{\partial s} 
+	= \frac{\partial s}{\partial t} \;  \frac{\partial u }{\partial s}
+	= \left. {\frac{\partial u }{\partial t}} \right|_s  - \left. {\frac{\partial u }{\partial t}} \right|_z \quad , 
+\end{array} } 		
+\end{equation*}
+leads to the $s-$coordinate formulation of the total $z-$coordinate time derivative, 
+$i.e.$ the total $s-$coordinate time derivative :
+\begin{align} \label{Apdx_A_sco_Dt_vect}
+\left. \frac{D u}{D t} \right|_s 
+  = \left. {\frac{\partial u }{\partial t}} \right|_s       
+  + \left. \zeta \right|_s \;v
+  + \frac{1}{2\,e_1}\left. {\frac{\partial (u^2+v^2)}{\partial i}} \right|_s  
+  + \frac{1}{e_3 } \omega \;\frac{\partial u}{\partial s}   
+\end{align}
+Therefore, the vector invariant form of the total time derivative has exactly the same 
+mathematical form in $z-$ and $s-$coordinates. This is not the case for the flux form
+as shown in next paragraph.
+
+$\ $\newline    % force a new ligne
+
+$\bullet$ \textbf{Total derivative in flux form}
+
+Let us start from the total time derivative in the curvilinear $s-$coordinate system 
+we have just establish. Following the procedure used to establish (\ref{Eq_PE_flux_form}), 
+it can be transformed into :
+%\begin{subequations} 
+\begin{align*} {\begin{array}{*{20}l} 
+\left. \frac{D u}{D t} \right|_s  &= \left. {\frac{\partial u }{\partial t}} \right|_s  
+           					    & -  \zeta \;v 
+           					+ \frac{1}{2\;e_1 } \frac{\partial \left( {u^2+v^2} \right)}{\partial i}
+                                                 + \frac{1}{e_3} \omega \;\frac{\partial u}{\partial s}          \\
+\\
+  &= \left. {\frac{\partial u }{\partial t}} \right|_s  
+          &+\frac{1}{e_1\;e_2}  \left(    \frac{\partial \left( {e_2 \,u\,u } \right)}{\partial i}
+		                                    + \frac{\partial \left( {e_1 \,u\,v } \right)}{\partial j}     \right)
+            + \frac{1}{e_3 } \frac{\partial \left( {\omega\,u} \right)}{\partial s}                                \\ 
+\\
+        &&- \,u \left[     \frac{1}{e_1 e_2 } \left(    \frac{\partial(e_2 u)}{\partial i}
+				  	  	                 + \frac{\partial(e_1 v)}{\partial j}    \right)
+                          + \frac{1}{e_3}        \frac{\partial \omega}{\partial s}                       \right]      \\
+\\
+        &&- \frac{v}{e_1 e_2 }\left(    v	\;\frac{\partial e_2 }{\partial i}
+				 	           -u	\;\frac{\partial e_1 }{\partial j} 	\right)                             \\
+\end{array} } 		
+\end{align*}
+%
+Introducing the vertical scale factor inside the horizontal derivative of the first two terms 
+($i.e.$ the horizontal divergence), it becomes :
+\begin{subequations} 
+\begin{align*} {\begin{array}{*{20}l} 
+%\begin{align*} {\begin{array}{*{20}l} 
+%{\begin{array}{*{20}l} 
+\left. \frac{D u}{D t} \right|_s  
+   &= \left. {\frac{\partial u }{\partial t}} \right|_s  
+   &+ \frac{1}{e_1\,e_2\,e_3}  \left(  \frac{\partial( e_2 e_3 \,u^2 )}{\partial i}
+			                  		  + \frac{\partial( e_1 e_3 \,u v )}{\partial j}     
+	     							   -  e_2 u u \frac{\partial e_3}{\partial i}
+							  -  e_1 u v \frac{\partial e_3 }{\partial j}    \right)
+	    + \frac{1}{e_3} \frac{\partial \left( {\omega\,u} \right)}{\partial s}                                  \\
+\\
+           && - \,u \left[  \frac{1}{e_1 e_2 e_3} \left(   \frac{\partial(e_2 e_3 \, u)}{\partial i} 
+			   							 + \frac{\partial(e_1 e_3 \, v)}{\partial j}  
+	                							 -  e_2 u \;\frac{\partial e_3 }{\partial i}
+				 	  	                      -  e_1 v \;\frac{\partial e_3 }{\partial j}   \right)
+             -\frac{1}{e_3}        \frac{\partial \omega}{\partial s}                       \right]                      \\
+\\
+            && - \frac{v}{e_1 e_2 }\left( 	v  \;\frac{\partial e_2 }{\partial i}
+				     	              -u  \;\frac{\partial e_1 }{\partial j} 	\right)                      \\
+\\
+   &= \left. {\frac{\partial u }{\partial t}} \right|_s  
+   &+ \frac{1}{e_1\,e_2\,e_3}  \left(  \frac{\partial( e_2 e_3 \,u\,u )}{\partial i}
+			                  		  + \frac{\partial( e_1 e_3 \,u\,v )}{\partial j}    \right)
+     + \frac{1}{e_3 } \frac{\partial \left( {\omega\,u} \right)}{\partial s}                               \\
+\\
+&& - \,u \left[  \frac{1}{e_1 e_2 e_3} \left(   \frac{\partial(e_2 e_3 \, u)}{\partial i} 
+									+ \frac{\partial(e_1 e_3 \, v)}{\partial j}  \right)
+        -\frac{1}{e_3}        \frac{\partial \omega}{\partial s}                       \right]                  
+     - \frac{v}{e_1 e_2 }\left( 	v   \;\frac{\partial e_2 }{\partial i}
+				            	      -u   \;\frac{\partial e_1 }{\partial j} 	\right)                  \\
+%
+\intertext {Introducing a more compact form for the divergence of the momentum fluxes, 
+and using (\ref{Apdx_A_sco_Continuity}), the $s-$coordinate continuity equation, 
+it becomes : }
+%
+   &= \left. {\frac{\partial u }{\partial t}} \right|_s  
+   &+ \left.  \nabla \cdot \left(   {{\rm {\bf U}}\,u}   \right)    \right|_s
+     + \,u \frac{1}{e_3 } \frac{\partial e_3}{\partial t}    
+      - \frac{v}{e_1 e_2 }\left(    v  \;\frac{\partial e_2 }{\partial i}
+				             -u  \;\frac{\partial e_1 }{\partial j} 	\right) \\
+\end{array} } 		
+\end{align*}
+\end{subequations}
+which leads to the $s-$coordinate flux formulation of the total $s-$coordinate time derivative, 
+$i.e.$ the total $s-$coordinate time derivative in flux form :
+\begin{flalign}\label{Apdx_A_sco_Dt_flux}
+\left. \frac{D u}{D t} \right|_s   = \frac{1}{e_3}  \left. \frac{\partial ( e_3\,u)}{\partial t} \right|_s  
+           + \left.  \nabla \cdot \left(   {{\rm {\bf U}}\,u}   \right)    \right|_s
+           - \frac{v}{e_1 e_2 }\left(    v  \;\frac{\partial e_2 }{\partial i}
+				 	          -u  \;\frac{\partial e_1 }{\partial j}            \right)
+\end{flalign}
+which is the total time derivative expressed in the curvilinear $s-$coordinate system.
+It has the same form as in the $z-$coordinate but for the vertical scale factor 
+that has appeared inside the time derivative which comes from the modification 
+of (\ref{Apdx_A_sco_Continuity}), the continuity equation.
+
+$\ $\newline    % force a new ligne
+
+$\bullet$ \textbf{horizontal pressure gradient}
+
+The horizontal pressure gradient term can be transformed as follows:
+\begin{equation*}
+\begin{split}
+ -\frac{1}{\rho _o \, e_1 }\left. {\frac{\partial p}{\partial i}} \right|_z
+ & =-\frac{1}{\rho _o e_1 }\left[ {\left. {\frac{\partial p}{\partial i}} \right|_s -\frac{e_1 }{e_3 }\sigma _1 \frac{\partial p}{\partial s}} \right] \\
+& =-\frac{1}{\rho _o \,e_1 }\left. {\frac{\partial p}{\partial i}} \right|_s +\frac{\sigma _1 }{\rho _o \,e_3 }\left( {-g\;\rho \;e_3 } \right) \\
+&=-\frac{1}{\rho _o \,e_1 }\left. {\frac{\partial p}{\partial i}} \right|_s -\frac{g\;\rho }{\rho _o }\sigma _1
+\end{split}
+\end{equation*}
+Applying similar manipulation to the second component and replacing 
+$\sigma _1$ and $\sigma _2$ by their expression \eqref{Apdx_A_s_slope}, it comes:
+\begin{equation} \label{Apdx_A_grad_p}
+\begin{split}
+ -\frac{1}{\rho _o \, e_1 } \left. {\frac{\partial p}{\partial i}} \right|_z
+&=-\frac{1}{\rho _o \,e_1 } \left(     \left.              {\frac{\partial p}{\partial i}} \right|_s 
+                                                  + g\;\rho  \;\left. {\frac{\partial z}{\partial i}} \right|_s    \right) \\
+%
+ -\frac{1}{\rho _o \, e_2 }\left. {\frac{\partial p}{\partial j}} \right|_z
+&=-\frac{1}{\rho _o \,e_2 } \left(    \left.               {\frac{\partial p}{\partial j}} \right|_s 
+                                                   + g\;\rho \;\left. {\frac{\partial z}{\partial j}} \right|_s   \right) \\
+\end{split}
+\end{equation}
+
+An additional term appears in (\ref{Apdx_A_grad_p}) which accounts for the 
+tilt of $s-$surfaces with respect to geopotential $z-$surfaces.
+
+As in $z$-coordinate, the horizontal pressure gradient can be split in two parts
+following \citet{Marsaleix_al_OM08}. Let defined a density anomaly, $d$, by $d=(\rho - \rho_o)/ \rho_o$,
+and a hydrostatic pressure anomaly, $p_h'$, by $p_h'= g \; \int_z^\eta d \; e_3 \; dk$. 
+The pressure is then given by:
+\begin{equation*} 
+\begin{split}
+p &= g\; \int_z^\eta \rho \; e_3 \; dk = g\; \int_z^\eta \left(  \rho_o \, d + 1 \right) \; e_3 \; dk   \\
+   &= g \, \rho_o \; \int_z^\eta d \; e_3 \; dk + g \, \int_z^\eta e_3 \; dk    
+\end{split}
+\end{equation*}
+Therefore, $p$ and $p_h'$ are linked through:
+\begin{equation} \label{Apdx_A_pressure}
+   p = \rho_o \; p_h' + g \, ( z + \eta )
+\end{equation}
+and the hydrostatic pressure balance expressed in terms of $p_h'$ and $d$ is:
+\begin{equation*} 
+\frac{\partial p_h'}{\partial k} = - d \, g \, e_3
+\end{equation*}
+
+Substituing \eqref{Apdx_A_pressure} in \eqref{Apdx_A_grad_p} and using the definition of 
+the density anomaly it comes the expression in two parts:
+\begin{equation} \label{Apdx_A_grad_p}
+\begin{split}
+ -\frac{1}{\rho _o \, e_1 } \left. {\frac{\partial p}{\partial i}} \right|_z
+&=-\frac{1}{e_1 } \left(     \left.              {\frac{\partial p_h'}{\partial i}} \right|_s 
+                                       + g\; d  \;\left. {\frac{\partial z}{\partial i}} \right|_s    \right)  - \frac{g}{e_1 } \frac{\partial \eta}{\partial i} \\
+%
+ -\frac{1}{\rho _o \, e_2 }\left. {\frac{\partial p}{\partial j}} \right|_z
+&=-\frac{1}{e_2 } \left(    \left.               {\frac{\partial p_h'}{\partial j}} \right|_s 
+                                        + g\; d \;\left. {\frac{\partial z}{\partial j}} \right|_s   \right)  - \frac{g}{e_2 } \frac{\partial \eta}{\partial j}\\
+\end{split}
+\end{equation}
+This formulation of the pressure gradient is characterised by the appearance of a term depending on the 
+the sea surface height only (last term on the right hand side of expression \eqref{Apdx_A_grad_p}).
+This term will be loosely termed \textit{surface pressure gradient}
+whereas the first term will be termed the 
+\textit{hydrostatic pressure gradient} by analogy to the $z$-coordinate formulation. 
+In fact, the the true surface pressure gradient is $1/\rho_o \nabla (\rho \eta)$, and 
+$\eta$ is implicitly included in the computation of $p_h'$ through the upper bound of 
+the vertical integration.
+ 
+
+$\ $\newline    % force a new ligne
+
+$\bullet$ \textbf{The other terms of the momentum equation}
+
+The coriolis and forcing terms as well as the the vertical physics remain unchanged 
+as they involve neither time nor space derivatives. The form of the lateral physics is 
+discussed in appendix~\ref{Apdx_B}.
+
+
+$\ $\newline    % force a new ligne
+
+$\bullet$ \textbf{Full momentum equation}
+
+To sum up, in a curvilinear $s$-coordinate system, the vector invariant momentum equation 
+solved by the model has the same mathematical expression as the one in a curvilinear 
+$z-$coordinate, except for the pressure gradient term :
+\begin{subequations} \label{Apdx_A_dyn_vect}
+\begin{multline} \label{Apdx_A_PE_dyn_vect_u}
+ \frac{\partial u}{\partial t}=
+	+   \left( {\zeta +f} \right)\,v                                    
+	-   \frac{1}{2\,e_1} \frac{\partial}{\partial i} \left(  u^2+v^2   \right) 
+	-   \frac{1}{e_3} \omega \frac{\partial u}{\partial k}       \\
+        -   \frac{1}{e_1 } \left(    \frac{\partial p_h'}{\partial i} + g\; d  \; \frac{\partial z}{\partial i}    \right)  
+        -   \frac{g}{e_1 } \frac{\partial \eta}{\partial i}
+	+   D_u^{\vect{U}}  +   F_u^{\vect{U}}
+\end{multline}
+\begin{multline} \label{Apdx_A_dyn_vect_v}
+\frac{\partial v}{\partial t}=
+	-   \left( {\zeta +f} \right)\,u   
+	-   \frac{1}{2\,e_2 }\frac{\partial }{\partial j}\left(  u^2+v^2  \right)     	
+	-   \frac{1}{e_3 } \omega \frac{\partial v}{\partial k}         \\
+        -   \frac{1}{e_2 } \left(    \frac{\partial p_h'}{\partial j} + g\; d  \; \frac{\partial z}{\partial j}    \right)  
+        -   \frac{g}{e_2 } \frac{\partial \eta}{\partial j}
+	+  D_v^{\vect{U}}  +   F_v^{\vect{U}}
+\end{multline}
+\end{subequations}
+whereas the flux form momentum equation differ from it by the formulation of both
+the time derivative and the pressure gradient term  :
+\begin{subequations} \label{Apdx_A_dyn_flux}
+\begin{multline} \label{Apdx_A_PE_dyn_flux_u}
+ \frac{1}{e_3} \frac{\partial \left(  e_3\,u  \right) }{\partial t} =
+	\nabla \cdot \left(   {{\rm {\bf U}}\,u}   \right) 
+	+   \left\{ {f + \frac{1}{e_1 e_2 }\left(    v  \;\frac{\partial e_2 }{\partial i}
+				 	                        -u  \;\frac{\partial e_1 }{\partial j}            \right)} \right\} \,v     \\                               
+        -   \frac{1}{e_1 } \left(    \frac{\partial p_h'}{\partial i} + g\; d  \; \frac{\partial z}{\partial i}    \right)  
+        -   \frac{g}{e_1 } \frac{\partial \eta}{\partial i}
+	+   D_u^{\vect{U}}  +   F_u^{\vect{U}}
+\end{multline}
+\begin{multline} \label{Apdx_A_dyn_flux_v}
+ \frac{1}{e_3}\frac{\partial \left(  e_3\,v  \right) }{\partial t}=
+	-  \nabla \cdot \left(   {{\rm {\bf U}}\,v}   \right) 
+	+   \left\{ {f + \frac{1}{e_1 e_2 }\left(    v  \;\frac{\partial e_2 }{\partial i}
+				 	                         -u  \;\frac{\partial e_1 }{\partial j}            \right)} \right\} \,u     \\                               
+        -   \frac{1}{e_2 } \left(    \frac{\partial p_h'}{\partial j} + g\; d  \; \frac{\partial z}{\partial j}    \right)  
+        -   \frac{g}{e_2 } \frac{\partial \eta}{\partial j}
+	+  D_v^{\vect{U}}  +   F_v^{\vect{U}}
+\end{multline}
+\end{subequations}
+Both formulation share the same hydrostatic pressure balance expressed in terms of
+hydrostatic pressure and density anomalies, $p_h'$ and $d=( \frac{\rho}{\rho_o}-1 )$:
+\begin{equation} \label{Apdx_A_dyn_zph}
+\frac{\partial p_h'}{\partial k} = - d \, g \, e_3
+\end{equation}
+
+It is important to realize that the change in coordinate system has only concerned
+the position on the vertical. It has not affected (\textbf{i},\textbf{j},\textbf{k}), the 
+orthogonal curvilinear set of unit vectors. ($u$,$v$) are always horizontal velocities
+so that their evolution is driven by \emph{horizontal} forces, in particular 
+the pressure gradient. By contrast, $\omega$ is not $w$, the third component of the velocity,
+but the dia-surface velocity component, $i.e.$ the volume flux across the moving 
+$s$-surfaces per unit horizontal area. 
+
+
+% ================================================================
+% Tracer equation
+% ================================================================
+\section{Tracer Equation}
+\label{Apdx_A_tracer}
+
+The tracer equation is obtained using the same calculation as for the continuity 
+equation and then regrouping the time derivative terms in the left hand side :
+
+\begin{multline} \label{Apdx_A_tracer}
+ \frac{1}{e_3} \frac{\partial \left(  e_3 T  \right)}{\partial t} 
+ 	= -\frac{1}{e_1 \,e_2 \,e_3} 
+		\left[           \frac{\partial }{\partial i} \left( {e_2 \,e_3 \;Tu} \right) 
+		             +   \frac{\partial }{\partial j} \left( {e_1 \,e_3 \;Tv} \right)               \right]       \\
+ 	+  \frac{1}{e_3}  \frac{\partial }{\partial k} \left(                   Tw  \right)  
+	 +  D^{T} +F^{T}
+\end{multline}
+
+
+The expression for the advection term is a straight consequence of (A.4), the 
+expression of the 3D divergence in the $s-$coordinates established above. 
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_B.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_B.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_B.tex	(revision 8732)
@@ -0,0 +1,368 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter Ñ Appendix B : Diffusive Operators
+% ================================================================
+\chapter{Appendix B : Diffusive Operators}
+\label{Apdx_B}
+\minitoc
+
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Horizontal/Vertical 2nd Order Tracer Diffusive Operators
+% ================================================================
+\section{Horizontal/Vertical 2nd Order Tracer Diffusive Operators}
+\label{Apdx_B_1}
+
+\subsubsection*{In z-coordinates}
+In $z$-coordinates, the horizontal/vertical second order tracer diffusion operator
+is given by:
+\begin{eqnarray} \label{Apdx_B1}
+ &D^T = \frac{1}{e_1 \, e_2}      \left[
+  \left. \frac{\partial}{\partial i} \left( 	\frac{e_2}{e_1}A^{lT} \;\left. \frac{\partial T}{\partial i} \right|_z   \right)   \right|_z      \right.
+  						     \left.
++ \left. \frac{\partial}{\partial j} \left(  \frac{e_1}{e_2}A^{lT} \;\left. \frac{\partial T}{\partial j} \right|_z   \right)   \right|_z      \right]
++ \frac{\partial }{\partial z}\left( {A^{vT} \;\frac{\partial T}{\partial z}} \right)
+\end{eqnarray}
+
+\subsubsection*{In generalized vertical coordinates}
+In $s$-coordinates, we defined the slopes of $s$-surfaces, $\sigma_1$ and
+$\sigma_2$ by \eqref{Apdx_A_s_slope} and the vertical/horizontal ratio of diffusion
+coefficient by $\epsilon = A^{vT} / A^{lT}$. The diffusion operator is given by:
+
+\begin{equation} \label{Apdx_B2}
+D^T = \left. \nabla \right|_s \cdot
+           \left[ A^{lT} \;\Re \cdot \left. \nabla \right|_s T  \right] \\
+\;\;\text{where} \;\Re =\left( {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill & {-\sigma _1 } \hfill \\
+ 0 \hfill & 1 \hfill & {-\sigma _2 } \hfill \\
+ {-\sigma _1 } \hfill & {-\sigma _2 } \hfill & {\varepsilon +\sigma _1
+^2+\sigma _2 ^2} \hfill \\
+\end{array} }} \right)
+\end{equation}
+or in expanded form:
+\begin{subequations}
+\begin{align*} {\begin{array}{*{20}l}
+D^T=& \frac{1}{e_1\,e_2\,e_3 }\;\left[ {\ \ \ \ e_2\,e_3\,A^{lT} \;\left.
+{\frac{\partial }{\partial i}\left( {\frac{1}{e_1}\;\left. {\frac{\partial T}{\partial i}} \right|_s -\frac{\sigma _1 }{e_3 }\;\frac{\partial T}{\partial s}} \right)} \right|_s } \right.  \\
+&\qquad \quad \ \ \ +e_1\,e_3\,A^{lT} \;\left. {\frac{\partial }{\partial j}\left( {\frac{1}{e_2 }\;\left. {\frac{\partial T}{\partial j}} \right|_s -\frac{\sigma _2 }{e_3 }\;\frac{\partial T}{\partial s}} \right)} \right|_s \\
+&\qquad \quad \ \ \ + e_1\,e_2\,A^{lT} \;\frac{\partial }{\partial s}\left( {-\frac{\sigma _1 }{e_1 }\;\left. {\frac{\partial T}{\partial i}} \right|_s -\frac{\sigma _2 }{e_2 }\;\left. {\frac{\partial T}{\partial j}} \right|_s } \right.
+ \left. {\left. {+\left( {\varepsilon +\sigma _1^2+\sigma _2 ^2} \right)\;\frac{1}{e_3 }\;\frac{\partial T}{\partial s}} \right)\;\;} \right]
+\end{array} }
+\end{align*}
+\end{subequations}
+
+Equation \eqref{Apdx_B2} is obtained from \eqref{Apdx_B1} without any
+additional assumption. Indeed, for the special case $k=z$ and thus $e_3 =1$,
+we introduce an arbitrary vertical coordinate $s = s (i,j,z)$ as in Appendix~\ref{Apdx_A}
+and use \eqref{Apdx_A_s_slope} and \eqref{Apdx_A_s_chain_rule}.
+Since no cross horizontal derivative $\partial _i \partial _j $ appears in
+\eqref{Apdx_B1}, the ($i$,$z$) and ($j$,$z$) planes are independent.
+The derivation can then be demonstrated for the ($i$,$z$)~$\to$~($j$,$s$)
+transformation without any loss of generality:
+
+\begin{subequations}
+\begin{align*} {\begin{array}{*{20}l}
+D^T&=\frac{1}{e_1\,e_2} \left. {\frac{\partial }{\partial i}\left( {\frac{e_2}{e_1}A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_z } \right)} \right|_z
+                     +\frac{\partial }{\partial z}\left( {A^{vT}\;\frac{\partial T}{\partial z}} \right)     \\
+ \\
+%
+&=\frac{1}{e_1\,e_2 }\left[ {\left. {\;\frac{\partial }{\partial i}\left( {\frac{e_2}{e_1}A^{lT}\;\left( {\left. {\frac{\partial T}{\partial i}} \right|_s
+                                                    -\frac{e_1\,\sigma _1 }{e_3 }\frac{\partial T}{\partial s}} \right)} \right)} \right|_s } \right. \\
+& \qquad \qquad \left. { -\frac{e_1\,\sigma _1 }{e_3 }\frac{\partial }{\partial s}\left( {\frac{e_2 }{e_1 }A^{lT}\;\left. {\left( {\left. {\frac{\partial T}{\partial i}} \right|_s -\frac{e_1 \,\sigma _1 }{e_3 }\frac{\partial T}{\partial s}} \right)} \right|_s } \right)\;} \right]
+\shoveright{ +\frac{1}{e_3 }\frac{\partial }{\partial s}\left[ {\frac{A^{vT}}{e_3 }\;\frac{\partial T}{\partial s}} \right]}  \qquad \qquad \qquad \\
+ \\
+%
+&=\frac{1}{e_1 \,e_2 \,e_3 }\left[ {\left. {\;\;\frac{\partial }{\partial i}\left( {\frac{e_2 \,e_3 }{e_1 }A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right)} \right|_s -\left. {\frac{e_2 }{e_1}A^{lT}\;\frac{\partial e_3 }{\partial i}} \right|_s \left. {\frac{\partial T}{\partial i}} \right|_s } \right. \\
+&  \qquad \qquad \quad \left. {-e_3 \frac{\partial }{\partial i}\left( {\frac{e_2 \,\sigma _1 }{e_3 }A^{lT}\;\frac{\partial T}{\partial s}} \right)} \right|_s -e_1 \,\sigma _1 \frac{\partial }{\partial s}\left( {\frac{e_2 }{e_1 }A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right) \\
+&  \qquad \qquad \quad \shoveright{ -e_1 \,\sigma _1 \frac{\partial }{\partial s}\left( {-\frac{e_2 \,\sigma _1 }{e_3 }A^{lT}\;\frac{\partial T}{\partial s}} \right)\;\,\left. {+\frac{\partial }{\partial s}\left( {\frac{e_1 \,e_2 }{e_3 }A^{vT}\;\frac{\partial T}{\partial s}} \right)\quad} \right] }\\
+\end{array} } 		\\
+%
+ {\begin{array}{*{20}l}
+\intertext{Noting that $\frac{1}{e_1} \left. \frac{\partial e_3 }{\partial i} \right|_s = \frac{\partial \sigma _1 }{\partial s}$, it becomes:}
+%
+& =\frac{1}{e_1\,e_2\,e_3 }\left[ {\left. {\;\;\;\frac{\partial }{\partial i}\left( {\frac{e_2\,e_3 }{e_1}\,A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right)} \right|_s \left. -\, {e_3 \frac{\partial }{\partial i}\left( {\frac{e_2 \,\sigma _1 }{e_3 }A^{lT}\;\frac{\partial T}{\partial s}} \right)} \right|_s } \right. \\
+& \qquad \qquad \quad -e_2 A^{lT}\;\frac{\partial \sigma _1 }{\partial s}\left. {\frac{\partial T}{\partial i}} \right|_s -e_1 \,\sigma_1 \frac{\partial }{\partial s}\left( {\frac{e_2 }{e_1 }A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right) \\
+& \qquad \qquad \quad\shoveright{ \left. { +e_1 \,\sigma _1 \frac{\partial }{\partial s}\left( {\frac{e_2 \,\sigma _1 }{e_3 }A^{lT}\;\frac{\partial T}{\partial s}} \right)+\frac{\partial }{\partial s}\left( {\frac{e_1 \,e_2 }{e_3 }A^{vT}\;\frac{\partial T}{\partial z}} \right)\;\;\;} \right] }\\
+\\
+&=\frac{1}{e_1 \,e_2 \,e_3 } \left[ {\left. {\;\;\;\frac{\partial }{\partial i} \left( {\frac{e_2 \,e_3 }{e_1 }A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right)} \right|_s \left. {-\frac{\partial }{\partial i}\left( {e_2 \,\sigma _1 A^{lT}\;\frac{\partial T}{\partial s}} \right)} \right|_s } \right. \\
+& \qquad \qquad \quad \left. {+\frac{e_2 \,\sigma _1 }{e_3}A^{lT}\;\frac{\partial T}{\partial s} \;\frac{\partial e_3 }{\partial i}}  \right|_s -e_2 A^{lT}\;\frac{\partial \sigma _1 }{\partial s}\left. {\frac{\partial T}{\partial i}} \right|_s \\
+& \qquad \qquad \quad-e_2 \,\sigma _1 \frac{\partial}{\partial s}\left( {A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right)+\frac{\partial }{\partial s}\left( {\frac{e_1 \,e_2 \,\sigma _1 ^2}{e_3 }A^{lT}\;\frac{\partial T}{\partial s}} \right) \\
+& \qquad \qquad \quad\shoveright{ \left. {-\frac{\partial \left( {e_1 \,e_2 \,\sigma _1 } \right)}{\partial s} \left( {\frac{\sigma _1 }{e_3}A^{lT}\;\frac{\partial T}{\partial s}} \right) + \frac{\partial }{\partial s}\left( {\frac{e_1 \,e_2 }{e_3 }A^{vT}\;\frac{\partial T}{\partial s}} \right)\;\;\;} \right]}
+\end{array} } \\
+{\begin{array}{*{20}l}
+%
+\intertext{using the same remark as just above, it becomes:}
+%
+&= \frac{1}{e_1 \,e_2 \,e_3 } \left[ {\left. {\;\;\;\frac{\partial }{\partial i} \left( {\frac{e_2 \,e_3 }{e_1 }A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s -e_2 \,\sigma _1 A^{lT}\;\frac{\partial T}{\partial s}} \right)} \right|_s } \right.\;\;\; \\
+& \qquad \qquad \quad+\frac{e_1 \,e_2 \,\sigma _1 }{e_3 }A^{lT}\;\frac{\partial T}{\partial s}\;\frac{\partial \sigma _1 }{\partial s} - \frac {\sigma _1 }{e_3} A^{lT} \;\frac{\partial \left( {e_1 \,e_2 \,\sigma _1 } \right)}{\partial s}\;\frac{\partial T}{\partial s} \\
+& \qquad \qquad \quad-e_2 \left( {A^{lT}\;\frac{\partial \sigma _1 }{\partial s}\left. {\frac{\partial T}{\partial i}} \right|_s +\frac{\partial }{\partial s}\left( {\sigma _1 A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right)-\frac{\partial \sigma _1 }{\partial s}\;A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s } \right) \\
+& \qquad \qquad \quad\shoveright{\left. {+\frac{\partial }{\partial s}\left( {\frac{e_1 \,e_2 \,\sigma _1 ^2}{e_3 }A^{lT}\;\frac{\partial T}{\partial s}+\frac{e_1 \,e_2}{e_3 }A^{vT}\;\frac{\partial T}{\partial s}} \right)\;\;\;} \right] }
+ \end{array} } \\
+{\begin{array}{*{20}l}
+%
+\intertext{Since the horizontal scale factors do not depend on the vertical coordinate,
+the last term of the first line and the first term of the last line cancel, while
+the second line reduces to a single vertical derivative, so it becomes:}
+%
+& =\frac{1}{e_1 \,e_2 \,e_3 }\left[ {\left. {\;\;\;\frac{\partial }{\partial i}\left( {\frac{e_2 \,e_3 }{e_1 }A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s -e_2 \,\sigma _1 \,A^{lT}\;\frac{\partial T}{\partial s}} \right)} \right|_s } \right. \\
+& \qquad \qquad \quad \shoveright{ \left. {+\frac{\partial }{\partial s}\left( {-e_2 \,\sigma _1 \,A^{lT}\;\left. {\frac{\partial T}{\partial i}} \right|_s +A^{lT}\frac{e_1 \,e_2 }{e_3 }\;\left( {\varepsilon +\sigma _1 ^2} \right)\frac{\partial T}{\partial s}} \right)\;\;\;} \right]}
+ \\
+%
+\intertext{in other words, the horizontal/vertical Laplacian operator in the ($i$,$s$) plane takes the following form:}
+\end{array} } \\
+%
+{\frac{1}{e_1\,e_2\,e_3}}
+\left( {{\begin{array}{*{30}c}
+{\left. {\frac{\partial \left( {e_2 e_3 \bullet } \right)}{\partial i}} \right|_s } \hfill \\
+{\frac{\partial \left( {e_1 e_2 \bullet } \right)}{\partial s}} \hfill \\
+\end{array}}}\right)
+\cdot \left[ {A^{lT}
+\left( {{\begin{array}{*{30}c}
+ {1} \hfill & {-\sigma_1 } \hfill \\
+ {-\sigma_1} \hfill & {\varepsilon + \sigma_1^2} \hfill \\
+\end{array} }} \right)
+\cdot
+\left( {{\begin{array}{*{30}c}
+{\frac{1}{e_1 }\;\left. {\frac{\partial \bullet }{\partial i}} \right|_s } \hfill \\
+{\frac{1}{e_3 }\;\frac{\partial \bullet }{\partial s}} \hfill \\
+\end{array}}}       \right) \left( T \right)} \right]
+\end{align*}
+\end{subequations}
+\addtocounter{equation}{-2}
+
+% ================================================================
+% Isopycnal/Vertical 2nd Order Tracer Diffusive Operators
+% ================================================================
+\section{Iso/diapycnal 2nd Order Tracer Diffusive Operators}
+\label{Apdx_B_2}
+
+\subsubsection*{In z-coordinates}
+
+The iso/diapycnal diffusive tensor $\textbf {A}_{\textbf I}$ expressed in the ($i$,$j$,$k$)
+curvilinear coordinate system in which the equations of the ocean circulation model are
+formulated, takes the following form \citep{Redi_JPO82}:
+
+\begin{equation} \label{Apdx_B3}
+\textbf {A}_{\textbf I} = \frac{A^{lT}}{\left( {1+a_1 ^2+a_2 ^2} \right)}
+\left[ {{\begin{array}{*{20}c}
+ {1+a_1 ^2} \hfill & {-a_1 a_2 } \hfill & {-a_1 } \hfill \\
+ {-a_1 a_2 } \hfill & {1+a_2 ^2} \hfill & {-a_2 } \hfill \\
+ {-a_1 } \hfill & {-a_2 } \hfill & {\varepsilon +a_1 ^2+a_2 ^2} \hfill \\
+\end{array} }} \right]
+\end{equation}
+where ($a_1$, $a_2$) are the isopycnal slopes in ($\textbf{i}$,
+$\textbf{j}$) directions, relative to geopotentials:
+\begin{equation*}
+a_1 =\frac{e_3 }{e_1 }\left( {\frac{\partial \rho }{\partial i}} \right)\left( {\frac{\partial \rho }{\partial k}} \right)^{-1}
+\qquad , \qquad
+a_2 =\frac{e_3 }{e_2 }\left( {\frac{\partial \rho }{\partial j}}
+\right)\left( {\frac{\partial \rho }{\partial k}} \right)^{-1}
+\end{equation*}
+
+In practice, isopycnal slopes are generally less than $10^{-2}$ in the ocean, so
+$\textbf {A}_{\textbf I}$ can be simplified appreciably \citep{Cox1987}:
+\begin{subequations} \label{Apdx_B4}
+\begin{equation} \label{Apdx_B4a}
+{\textbf{A}_{\textbf{I}}} \approx A^{lT}\;\Re\;\text{where} \;\Re =
+\left[ {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill & {-a_1 } \hfill \\
+ 0 \hfill & 1 \hfill & {-a_2 } \hfill \\
+ {-a_1 } \hfill & {-a_2 } \hfill & {\varepsilon +a_1 ^2+a_2 ^2} \hfill \\
+\end{array} }} \right],
+\end{equation}
+and the iso/dianeutral diffusive operator in $z$-coordinates is then
+\begin{equation}\label{Apdx_B4b}
+ D^T = \left. \nabla \right|_z \cdot
+           \left[ A^{lT} \;\Re \cdot \left. \nabla \right|_z T  \right]. \\
+\end{equation}
+\end{subequations}
+
+
+Physically, the full tensor \eqref{Apdx_B3}
+represents strong isoneutral diffusion on a plane parallel to the isoneutral
+surface and weak dianeutral diffusion perpendicular to this plane.
+However, the approximate `weak-slope' tensor \eqref{Apdx_B4a} represents strong
+diffusion along the isoneutral surface, with weak
+\emph{vertical}  diffusion -- the principal axes of the tensor are no
+longer orthogonal. This simplification also decouples
+the ($i$,$z$) and ($j$,$z$) planes of the tensor. The weak-slope operator therefore takes the same
+form, \eqref{Apdx_B4}, as \eqref{Apdx_B2}, the diffusion operator for geopotential
+diffusion written in non-orthogonal $i,j,s$-coordinates. Written out
+explicitly,
+
+\begin{multline} \label{Apdx_B_ldfiso}
+ D^T=\frac{1}{e_1 e_2 }\left\{
+ {\;\frac{\partial }{\partial i}\left[ {A_h \left( {\frac{e_2}{e_1}\frac{\partial T}{\partial i}-a_1 \frac{e_2}{e_3}\frac{\partial T}{\partial k}} \right)} \right]}
+ {+\frac{\partial}{\partial j}\left[ {A_h \left( {\frac{e_1}{e_2}\frac{\partial T}{\partial j}-a_2 \frac{e_1}{e_3}\frac{\partial T}{\partial k}} \right)} \right]\;} \right\} \\
+\shoveright{+\frac{1}{e_3 }\frac{\partial }{\partial k}\left[ {A_h \left( {-\frac{a_1 }{e_1 }\frac{\partial T}{\partial i}-\frac{a_2 }{e_2 }\frac{\partial T}{\partial j}+\frac{\left( {a_1 ^2+a_2 ^2+\varepsilon} \right)}{e_3 }\frac{\partial T}{\partial k}} \right)} \right]}. \\
+\end{multline}
+
+
+The isopycnal diffusion operator \eqref{Apdx_B4},
+\eqref{Apdx_B_ldfiso} conserves tracer quantity and dissipates its
+square. The demonstration of the first property is trivial as \eqref{Apdx_B4} is the divergence
+of fluxes. Let us demonstrate the second one:
+\begin{equation*}
+\iiint\limits_D T\;\nabla .\left( {\textbf{A}}_{\textbf{I}} \nabla T \right)\,dv
+          = -\iiint\limits_D \nabla T\;.\left( {\textbf{A}}_{\textbf{I}} \nabla T \right)\,dv,
+\end{equation*}
+and since
+\begin{subequations}
+\begin{align*} {\begin{array}{*{20}l}
+\nabla T\;.\left( {{\rm {\bf A}}_{\rm {\bf I}} \nabla T}
+\right)&=A^{lT}\left[ {\left( {\frac{\partial T}{\partial i}} \right)^2-2a_1
+\frac{\partial T}{\partial i}\frac{\partial T}{\partial k}+\left(
+{\frac{\partial T}{\partial j}} \right)^2} \right. \\
+&\qquad \qquad \qquad
+{ \left. -\,{2a_2 \frac{\partial T}{\partial j}\frac{\partial T}{\partial k}+\left( {a_1 ^2+a_2 ^2+\varepsilon} \right)\left( {\frac{\partial T}{\partial k}} \right)^2} \right]} \\
+&=A_h \left[ {\left( {\frac{\partial T}{\partial i}-a_1 \frac{\partial
+          T}{\partial k}} \right)^2+\left( {\frac{\partial T}{\partial
+          j}-a_2 \frac{\partial T}{\partial k}} \right)^2}
+  +\varepsilon \left(\frac{\partial T}{\partial k}\right) ^2\right]      \\
+& \geq 0
+\end{array} }
+\end{align*}
+\end{subequations}
+\addtocounter{equation}{-1}
+ the property becomes obvious.
+
+\subsubsection*{In generalized vertical coordinates}
+
+Because the weak-slope operator \eqref{Apdx_B4}, \eqref{Apdx_B_ldfiso} is decoupled
+in the ($i$,$z$) and ($j$,$z$) planes, it may be transformed into
+generalized $s$-coordinates in the same way as \eqref{Apdx_B_1} was transformed into
+\eqref{Apdx_B_2}. The resulting operator then takes the simple form
+
+\begin{equation} \label{Apdx_B_ldfiso_s}
+D^T = \left. \nabla \right|_s \cdot
+           \left[ A^{lT} \;\Re \cdot \left. \nabla \right|_s T  \right] \\
+\;\;\text{where} \;\Re =\left( {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill & {-r _1 } \hfill \\
+ 0 \hfill & 1 \hfill & {-r _2 } \hfill \\
+ {-r _1 } \hfill & {-r _2 } \hfill & {\varepsilon +r _1
+^2+r _2 ^2} \hfill \\
+\end{array} }} \right),
+\end{equation}
+
+where ($r_1$, $r_2$) are the isopycnal slopes in ($\textbf{i}$,
+$\textbf{j}$) directions, relative to $s$-coordinate surfaces:
+\begin{equation*}
+r_1 =\frac{e_3 }{e_1 }\left( {\frac{\partial \rho }{\partial i}} \right)\left( {\frac{\partial \rho }{\partial s}} \right)^{-1}
+\qquad , \qquad
+r_2 =\frac{e_3 }{e_2 }\left( {\frac{\partial \rho }{\partial j}}
+\right)\left( {\frac{\partial \rho }{\partial s}} \right)^{-1}.
+\end{equation*}
+
+To prove  \eqref{Apdx_B5}  by direct re-expression of \eqref{Apdx_B_ldfiso} is
+straightforward, but laborious. An easier way is first to note (by reversing the
+derivation of \eqref{Apdx_B_2} from \eqref{Apdx_B_1} ) that the
+weak-slope operator may be \emph{exactly} reexpressed in 
+non-orthogonal $i,j,\rho$-coordinates as
+
+\begin{equation} \label{Apdx_B5}
+D^T = \left. \nabla \right|_\rho \cdot
+           \left[ A^{lT} \;\Re \cdot \left. \nabla \right|_\rho T  \right] \\
+\;\;\text{where} \;\Re =\left( {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill &0 \hfill \\
+ 0 \hfill & 1 \hfill & 0 \hfill \\
+0 \hfill & 0 \hfill & \varepsilon \hfill \\
+\end{array} }} \right).
+\end{equation}
+Then direct transformation from $i,j,\rho$-coordinates to
+$i,j,s$-coordinates gives \eqref{Apdx_B_ldfiso_s} immediately.
+
+Note that the weak-slope approximation is only made in
+transforming from the (rotated,orthogonal) isoneutral axes to the
+non-orthogonal $i,j,\rho$-coordinates. The further transformation
+into $i,j,s$-coordinates is exact, whatever the steepness of
+the  $s$-surfaces, in the same way as the transformation of
+horizontal/vertical Laplacian diffusion in $z$-coordinates,
+\eqref{Apdx_B_1} onto $s$-coordinates is exact, however steep the $s$-surfaces.
+
+
+% ================================================================
+% Lateral/Vertical Momentum Diffusive Operators
+% ================================================================
+\section{Lateral/Vertical Momentum Diffusive Operators}
+\label{Apdx_B_3}
+
+The second order momentum diffusion operator (Laplacian) in the $z$-coordinate
+is found by applying \eqref{Eq_PE_lap_vector}, the expression for the Laplacian
+of a vector,  to the horizontal velocity vector :
+\begin{align*}
+\Delta {\textbf{U}}_h
+&=\nabla \left( {\nabla \cdot {\textbf{U}}_h } \right)-
+\nabla \times \left( {\nabla \times {\textbf{U}}_h } \right)    \\
+\\
+&=\left( {{\begin{array}{*{20}c}
+ {\frac{1}{e_1 }\frac{\partial \chi }{\partial i}} \hfill \\
+ {\frac{1}{e_2 }\frac{\partial \chi }{\partial j}} \hfill \\
+ {\frac{1}{e_3 }\frac{\partial \chi }{\partial k}} \hfill \\
+\end{array} }} \right)-\left( {{\begin{array}{*{20}c}
+ {\frac{1}{e_2 }\frac{\partial \zeta }{\partial j}-\frac{1}{e_3
+}\frac{\partial }{\partial k}\left( {\frac{1}{e_3 }\frac{\partial
+u}{\partial k}} \right)} \hfill \\
+ {\frac{1}{e_3 }\frac{\partial }{\partial k}\left( {-\frac{1}{e_3
+}\frac{\partial v}{\partial k}} \right)-\frac{1}{e_1 }\frac{\partial \zeta
+}{\partial i}} \hfill \\
+ {\frac{1}{e_1 e_2 }\left[ {\frac{\partial }{\partial i}\left( {\frac{e_2
+}{e_3 }\frac{\partial u}{\partial k}} \right)-\frac{\partial }{\partial
+j}\left( {-\frac{e_1 }{e_3 }\frac{\partial v}{\partial k}} \right)} \right]}
+\hfill \\
+\end{array} }} \right)
+\\
+\\
+&=\left( {{\begin{array}{*{20}c}
+{\frac{1}{e_1 }\frac{\partial \chi }{\partial i}-\frac{1}{e_2 }\frac{\partial \zeta }{\partial j}} \\
+{\frac{1}{e_2 }\frac{\partial \chi }{\partial j}+\frac{1}{e_1 }\frac{\partial \zeta }{\partial i}} \\
+0 \\
+\end{array} }} \right)
++\frac{1}{e_3 }
+\left( {{\begin{array}{*{20}c}
+{\frac{\partial }{\partial k}\left( {\frac{1}{e_3 }\frac{\partial u}{\partial k}} \right)} \\
+{\frac{\partial }{\partial k}\left( {\frac{1}{e_3 }\frac{\partial v}{\partial k}} \right)} \\
+{\frac{\partial \chi }{\partial k}-\frac{1}{e_1 e_2 }\left( {\frac{\partial ^2\left( {e_2 \,u} \right)}{\partial i\partial k}+\frac{\partial ^2\left( {e_1 \,v} \right)}{\partial j\partial k}} \right)} \\
+\end{array} }} \right)
+\end{align*}
+Using \eqref{Eq_PE_div}, the definition of the horizontal divergence, the third
+componant of the second vector is obviously zero and thus :
+\begin{equation*}
+\Delta {\textbf{U}}_h = \nabla _h \left( \chi \right) - \nabla _h \times \left( \zeta \right) + \frac {1}{e_3 } \frac {\partial }{\partial k} \left( {\frac {1}{e_3 } \frac{\partial {\textbf{ U}}_h }{\partial k}} \right)
+\end{equation*}
+
+Note that this operator ensures a full separation between the vorticity and horizontal
+divergence fields (see Appendix~\ref{Apdx_C}). It is only equal to a Laplacian
+applied to each component in Cartesian coordinates, not on the sphere.
+
+The horizontal/vertical second order (Laplacian type) operator used to diffuse
+horizontal momentum in the $z$-coordinate therefore takes the following form :
+\begin{equation} \label{Apdx_B_Lap_U}
+ {\textbf{D}}^{\textbf{U}} =
+ 	  \nabla _h \left( {A^{lm}\;\chi } \right)
+	- \nabla _h \times \left( {A^{lm}\;\zeta \;{\textbf{k}}} \right)
+	+ \frac{1}{e_3 }\frac{\partial }{\partial k}\left( {\frac{A^{vm}\;}{e_3 }
+				\frac{\partial {\rm {\bf U}}_h }{\partial k}} \right) \\
+\end{equation}
+that is, in expanded form:
+\begin{align*}
+D^{\textbf{U}}_u
+& = \frac{1}{e_1} \frac{\partial \left( {A^{lm}\chi   } \right)}{\partial i}
+     -\frac{1}{e_2} \frac{\partial \left( {A^{lm}\zeta } \right)}{\partial j}
+     +\frac{1}{e_3} \frac{\partial u}{\partial k}      \\
+D^{\textbf{U}}_v
+& = \frac{1}{e_2 }\frac{\partial \left( {A^{lm}\chi   } \right)}{\partial j}
+     +\frac{1}{e_1 }\frac{\partial \left( {A^{lm}\zeta } \right)}{\partial i}
+     +\frac{1}{e_3} \frac{\partial v}{\partial k}
+\end{align*}
+
+Note Bene: introducing a rotation in \eqref{Apdx_B_Lap_U} does not lead to a
+useful expression for the iso/diapycnal Laplacian operator in the $z$-coordinate.
+Similarly, we did not found an expression of practical use for the geopotential
+horizontal/vertical Laplacian operator in the $s$-coordinate. Generally,
+\eqref{Apdx_B_Lap_U} is used in both $z$- and $s$-coordinate systems, that is
+a Laplacian diffusion is applied on momentum along the coordinate directions.
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_C.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_C.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_C.tex	(revision 8732)
@@ -0,0 +1,1535 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter Ñ Appendix C : Discrete Invariants of the Equations
+% ================================================================
+\chapter{Discrete Invariants of the Equations}
+\label{Apdx_C}
+\minitoc
+
+%%%  Appendix put in gmcomment as it has not been updated for z* and s coordinate
+%I'm writting this appendix. It will be available in a forthcoming release of the documentation
+
+%\gmcomment{
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Introduction / Notations
+% ================================================================
+\section{Introduction / Notations}
+\label{Apdx_C.0}
+
+Notation used in this appendix in the demonstations :
+
+fluxes at the faces of a $T$-box:
+\begin{equation*}
+U = e_{2u}\,e_{3u}\; u  \qquad  V = e_{1v}\,e_{3v}\; v  \qquad W = e_{1w}\,e_{2w}\; \omega     \\
+\end{equation*}
+
+volume of cells at $u$-, $v$-, and $T$-points:
+\begin{equation*}
+b_u = e_{1u}\,e_{2u}\,e_{3u}  \qquad  b_v = e_{1v}\,e_{2v}\,e_{3v}  \qquad b_t = e_{1t}\,e_{2t}\,e_{3t}     \\
+\end{equation*}
+
+partial derivative notation: $\partial_\bullet = \frac{\partial}{\partial \bullet}$
+
+$dv=e_1\,e_2\,e_3 \,di\,dj\,dk$  is the volume element, with only $e_3$ that depends on time.
+$D$ and $S$ are the ocean domain volume and surface, respectively. 
+No wetting/drying is allow ($i.e.$ $\frac{\partial S}{\partial t} = 0$) 
+Let $k_s$ and $k_b$ be the ocean surface and bottom, resp. 
+($i.e.$ $s(k_s) = \eta$ and $s(k_b)=-H$, where $H$ is the bottom depth).
+\begin{flalign*}
+ z(k) = \eta - \int\limits_{\tilde{k}=k}^{\tilde{k}=k_s}  e_3(\tilde{k}) \;d\tilde{k}
+        = \eta - \int\limits_k^{k_s}  e_3 \;d\tilde{k} 
+\end{flalign*}
+
+Continuity equation with the above notation:
+\begin{equation*}
+\frac{1}{e_{3t}} \partial_t (e_{3t})+ \frac{1}{b_t}  \biggl\{  \delta_i [U] + \delta_j [V] + \delta_k [W] \biggr\} = 0
+\end{equation*}
+
+A quantity, $Q$ is conserved when its domain averaged time change is zero, that is when:
+\begin{equation*}
+\partial_t \left( \int_D{ Q\;dv } \right) =0
+\end{equation*}
+Noting that the coordinate system used ....  blah blah
+\begin{equation*}
+\partial_t \left( \int_D {Q\;dv} \right) =  \int_D { \partial_t \left( e_3 \, Q \right) e_1e_2\;di\,dj\,dk }
+                                                       =  \int_D { \frac{1}{e_3} \partial_t \left( e_3 \, Q \right) dv } =0
+\end{equation*}
+equation of evolution of $Q$ written as the time evolution of the vertical content of $Q$
+like for tracers, or momentum in flux form, the quadratic quantity $\frac{1}{2}Q^2$ is conserved when :
+\begin{flalign*}
+\partial_t \left(   \int_D{ \frac{1}{2} \,Q^2\;dv }   \right)
+=&  \int_D{ \frac{1}{2} \partial_t \left( \frac{1}{e_3}\left( e_3 \, Q \right)^2 \right) e_1e_2\;di\,dj\,dk } \\
+=&  \int_D {         Q   \;\partial_t\left( e_3 \, Q \right) e_1e_2\;di\,dj\,dk }  
+-  \int_D { \frac{1}{2} Q^2 \,\partial_t  (e_3) \;e_1e_2\;di\,dj\,dk } \\
+\end{flalign*}
+that is in a more compact form :
+\begin{flalign} \label{Eq_Q2_flux}
+\partial_t \left( \int_D {\frac{1}{2} Q^2\;dv} \right)
+=&                   \int_D { \frac{Q}{e_3}  \partial_t \left( e_3 \, Q \right) dv }  
+  -   \frac{1}{2} \int_D {  \frac{Q^2}{e_3} \partial_t (e_3) \;dv }
+\end{flalign}
+equation of evolution of $Q$ written as the time evolution of $Q$
+like for momentum in vector invariant form, the quadratic quantity $\frac{1}{2}Q^2$ is conserved when :
+\begin{flalign*}
+\partial_t \left( \int_D {\frac{1}{2} Q^2\;dv} \right)
+=&  \int_D { \frac{1}{2} \partial_t \left( e_3 \, Q^2 \right) \;e_1e_2\;di\,dj\,dk } \\
+=& \int_D {         Q      \partial_t Q  \;e_1e_2e_3\;di\,dj\,dk }  
++  \int_D { \frac{1}{2} Q^2 \, \partial_t e_3  \;e_1e_2\;di\,dj\,dk } \\
+\end{flalign*}
+that is in a more compact form :
+\begin{flalign} \label{Eq_Q2_vect}
+\partial_t \left( \int_D {\frac{1}{2} Q^2\;dv} \right)
+=& \int_D {         Q   \,\partial_t Q  \;dv }  
++   \frac{1}{2} \int_D { \frac{1}{e_3} Q^2 \partial_t e_3 \;dv }
+\end{flalign}
+
+
+% ================================================================
+% Continuous Total energy Conservation
+% ================================================================
+\section{Continuous conservation}
+\label{Apdx_C.1}
+
+
+The discretization of pimitive equation in $s$-coordinate ($i.e.$ time and space varying 
+vertical coordinate) must be chosen so that the discrete equation of the model satisfy 
+integral constrains on energy and enstrophy. 
+
+
+Let us first establish those constraint in the continuous world.
+The total energy ($i.e.$ kinetic plus potential energies) is conserved :
+\begin{flalign} \label{Eq_Tot_Energy}
+  \partial_t \left( \int_D \left( \frac{1}{2} {\textbf{U}_h}^2 +  \rho \, g \, z \right) \;dv \right)  = & 0
+\end{flalign}
+under the following assumptions: no dissipation, no forcing 
+(wind, buoyancy flux, atmospheric pressure variations), mass 
+conservation, and closed domain. 
+
+This equation can be transformed to obtain several sub-equalities. 
+The transformation for the advection term depends on whether 
+the vector invariant form or the flux form is used for the momentum equation.
+Using \eqref{Eq_Q2_vect} and introducing \eqref{Apdx_A_dyn_vect} in \eqref{Eq_Tot_Energy} 
+for the former form and
+Using \eqref{Eq_Q2_flux} and introducing \eqref{Apdx_A_dyn_flux} in \eqref{Eq_Tot_Energy} 
+for the latter form  leads to:
+
+\begin{subequations} \label{E_tot}
+
+advection term (vector invariant form):
+\begin{equation} \label{E_tot_vect_vor}
+\int\limits_D  \zeta \; \left( \textbf{k} \times \textbf{U}_h  \right) \cdot \textbf{U}_h  \;  dv   = 0   \\
+\end{equation}
+%
+\begin{equation} \label{E_tot_vect_adv}
+   \int\limits_D  \textbf{U}_h \cdot \nabla_h \left( \frac{{\textbf{U}_h}^2}{2} \right)     dv 
++ \int\limits_D  \textbf{U}_h \cdot \nabla_z \textbf{U}_h  \;dv    
+-  \int\limits_D { \frac{{\textbf{U}_h}^2}{2} \frac{1}{e_3} \partial_t e_3 \;dv }   = 0   \\
+\end{equation}
+
+advection term (flux form):
+\begin{equation} \label{E_tot_flux_metric}
+\int\limits_D  \frac{1} {e_1 e_2 } \left( v \,\partial_i e_2 - u \,\partial_j e_1  \right)\; 
+ \left(  \textbf{k} \times \textbf{U}_h  \right) \cdot \textbf{U}_h  \;  dv   = 0   \\
+\end{equation}
+
+\begin{equation} \label{E_tot_flux_adv}
+   \int\limits_D \textbf{U}_h \cdot     \left(                 {{\begin{array} {*{20}c}
+\nabla \cdot \left( \textbf{U}\,u \right) \hfill \\
+\nabla \cdot \left( \textbf{U}\,v \right) \hfill \\       \end{array}} }           \right)   \;dv 
++   \frac{1}{2} \int\limits_D {  {\textbf{U}_h}^2 \frac{1}{e_3} \partial_t e_3 \;dv } =\;0  \\
+\end{equation}
+
+coriolis term
+\begin{equation} \label{E_tot_cor}
+\int\limits_D  f   \; \left( \textbf{k} \times \textbf{U}_h  \right) \cdot \textbf{U}_h  \;  dv   = 0   \\
+\end{equation}
+
+pressure gradient:
+\begin{equation} \label{E_tot_pg}
+   - \int\limits_D  \left. \nabla p \right|_z \cdot \textbf{U}_h \;dv 
+= - \int\limits_D \nabla \cdot \left( \rho \,\textbf {U} \right)\;g\;z\;\;dv
+   + \int\limits_D g\, \rho \; \partial_t z  \;dv   \\
+\end{equation}
+\end{subequations}
+
+where $\nabla_h = \left. \nabla \right|_k$ is the gradient along the $s$-surfaces.
+
+blah blah....
+$\ $\newline    % force a new ligne
+The prognostic ocean dynamics equation can be summarized as follows:
+\begin{equation*}
+\text{NXT} = \dbinom	{\text{VOR} + \text{KEG} + \text {ZAD} }
+						{\text{COR} + \text{ADV}                       }
+			+ \text{HPG} + \text{SPG} + \text{LDF} + \text{ZDF}
+\end{equation*}
+$\ $\newline    % force a new ligne
+
+Vector invariant form:
+\begin{subequations} \label{E_tot_vect}
+\begin{equation} \label{E_tot_vect_vor}
+\int\limits_D   \textbf{U}_h \cdot \text{VOR} \;dv   = 0   \\
+\end{equation}
+\begin{equation} \label{E_tot_vect_adv}
+   \int\limits_D  \textbf{U}_h \cdot \text{KEG}  \;dv 
++ \int\limits_D  \textbf{U}_h \cdot \text{ZAD}  \;dv    
+-  \int\limits_D { \frac{{\textbf{U}_h}^2}{2} \frac{1}{e_3} \partial_t e_3 \;dv }   = 0   \\
+\end{equation}
+\begin{equation} \label{E_tot_pg}
+   - \int\limits_D  \textbf{U}_h \cdot (\text{HPG}+ \text{SPG}) \;dv 
+= - \int\limits_D \nabla \cdot \left( \rho \,\textbf {U} \right)\;g\;z\;\;dv
+   + \int\limits_D g\, \rho \; \partial_t z  \;dv   \\
+\end{equation}
+\end{subequations}
+
+Flux form:
+\begin{subequations} \label{E_tot_flux}
+\begin{equation} \label{E_tot_flux_metric}
+\int\limits_D  \textbf{U}_h \cdot \text {COR} \;  dv   = 0   \\
+\end{equation}
+\begin{equation} \label{E_tot_flux_adv}
+   \int\limits_D \textbf{U}_h \cdot \text{ADV}   \;dv 
++   \frac{1}{2} \int\limits_D {  {\textbf{U}_h}^2 \frac{1}{e_3} \partial_t e_3  \;dv } =\;0  \\
+\end{equation}
+\begin{equation} \label{E_tot_pg}
+   - \int\limits_D  \textbf{U}_h \cdot (\text{HPG}+ \text{SPG}) \;dv 
+= - \int\limits_D \nabla \cdot \left( \rho \,\textbf {U} \right)\;g\;z\;\;dv
+   + \int\limits_D g\, \rho \; \partial_t  z  \;dv   \\
+\end{equation}
+\end{subequations}
+
+
+$\ $\newline    % force a new ligne
+
+
+\eqref{E_tot_pg} is the balance between the conversion KE to PE and PE to KE. 
+Indeed the left hand side of \eqref{E_tot_pg} can be transformed as follows:
+\begin{flalign*}
+\partial_t  \left( \int\limits_D { \rho \, g \, z  \;dv} \right) 
+&= + \int\limits_D \frac{1}{e_3} \partial_t (e_3\,\rho) \;g\;z\;\;dv
+     +  \int\limits_D g\, \rho \; \partial_t z  \;dv   &&&\\
+&= - \int\limits_D \nabla \cdot \left( \rho \,\textbf {U} \right)\;g\;z\;\;dv
+     + \int\limits_D g\, \rho \; \partial_t z \;dv   &&&\\
+&= + \int\limits_D  \rho \,g \left( \textbf {U}_h \cdot \nabla_h z + \omega \frac{1}{e_3} \partial_k z \right)  \;dv
+     + \int\limits_D g\, \rho \; \partial_t z \;dv   &&&\\
+&= + \int\limits_D  \rho \,g \left( \omega + \partial_t z + \textbf {U}_h \cdot \nabla_h z  \right)  \;dv  &&&\\
+&=+  \int\limits_D g\, \rho \; w \; dv   &&&\\
+\end{flalign*}
+where the last equality is obtained by noting that the brackets is exactly the expression of $w$, 
+the vertical velocity referenced to the fixe $z$-coordinate system (see \eqref{Apdx_A_w_s}). 
+ 
+The left hand side of \eqref{E_tot_pg} can be transformed as follows:
+\begin{flalign*}
+- \int\limits_D  \left. \nabla p \right|_z & \cdot \textbf{U}_h \;dv  
+= - \int\limits_D  \left( \nabla_h p + \rho \, g \nabla_h z \right) \cdot \textbf{U}_h \;dv   &&&\\
+\allowdisplaybreaks
+&= - \int\limits_D  \nabla_h  p \cdot \textbf{U}_h \;dv   - \int\limits_D  \rho \, g \, \nabla_h z \cdot \textbf{U}_h \;dv   &&&\\
+\allowdisplaybreaks
+&= +\int\limits_D p \,\nabla_h \cdot \textbf{U}_h \;dv   + \int\limits_D  \rho \, g \left( \omega - w + \partial_t z \right) \;dv   &&&\\
+\allowdisplaybreaks
+&= -\int\limits_D p \left( \frac{1}{e_3} \partial_t e_3 + \frac{1}{e_3} \partial_k \omega  \right) \;dv
+    +\int\limits_D  \rho \, g \left( \omega - w + \partial_t z \right) \;dv   &&&\\
+\allowdisplaybreaks
+&= -\int\limits_D \frac{p}{e_3} \partial_t e_3  \;dv    
+     +\int\limits_D \frac{1}{e_3} \partial_k p\; \omega \;dv
+    +\int\limits_D  \rho \, g \left( \omega - w + \partial_t z \right) \;dv   &&&\\
+&= -\int\limits_D \frac{p}{e_3} \partial_t e_3  \;dv    
+     -\int\limits_D \rho \, g \, \omega \;dv
+    +\int\limits_D  \rho \, g \left( \omega - w + \partial_t z \right) \;dv   &&&\\
+&= - \int\limits_D \frac{p}{e_3} \partial_t e_3 \; \;dv    
+     - \int\limits_D  \rho \, g \, w \;dv 
+     + \int\limits_D   \rho \, g \, \partial_t z \;dv   &&&\\
+\allowdisplaybreaks
+\intertext{introducing the hydrostatic balance $\partial_k p=-\rho \,g\,e_3$ in the last term,
+it becomes:}
+&= - \int\limits_D \frac{p}{e_3} \partial_t e_3 \;dv    
+     - \int\limits_D  \rho \, g \, w \;dv 
+     - \int\limits_D  \frac{1}{e_3} \partial_k p\, \partial_t z \;dv   &&&\\
+&= - \int\limits_D \frac{p}{e_3} \partial_t e_3 \;dv    
+     - \int\limits_D  \rho \, g \, w \;dv 
+     + \int\limits_D \,\frac{p}{e_3}\partial_t ( \partial_k z )  dv   &&&\\
+% 
+&= - \int\limits_D  \rho \, g \, w \;dv   &&&\\
+\end{flalign*}
+
+
+%gm comment
+\gmcomment{
+%
+The last equality comes from the following equation,
+\begin{flalign*}
+\int\limits_D p \frac{1}{e_3} \frac{\partial e_3}{\partial t}\; \;dv    
+     = \int\limits_D   \rho \, g \, \frac{\partial z }{\partial t} \;dv \quad,  \\ 
+\end{flalign*}
+that can be demonstrated as follows:
+
+\begin{flalign*}
+\int\limits_D   \rho \, g \, \frac{\partial z }{\partial t} \;dv   
+&= \int\limits_D    \rho \, g \, \frac{\partial \eta}{\partial t} \;dv   
+  -  \int\limits_D    \rho \, g \, \frac{\partial}{\partial t} \left(  \int\limits_k^{k_s}  e_3 \;d\tilde{k} \right) \;dv   &&&\\
+&= \int\limits_D    \rho \, g \, \frac{\partial \eta}{\partial t} \;dv   
+  -  \int\limits_D    \rho \, g    \left(  \int\limits_k^{k_s}  \frac{\partial e_3}{\partial t} \;d\tilde{k} \right) \;dv   &&&\\
+%
+\allowdisplaybreaks
+\intertext{The second term of the right hand side can be transformed by applying the integration by part rule: 
+$\left[ a\,b \right]_{k_b}^{k_s} = \int_{k_b}^{k_s}  a\,\frac{\partial b}{\partial k}       \;dk
+                                               + \int_{k_b}^{k_s}      \frac{\partial a}{\partial k} \,b \;dk $
+to the following function: $a=  \int_k^{k_s}  \frac{\partial e_3}{\partial t} \;d\tilde{k}$ 
+and $b=  \int_k^{k_s}  \rho \, e_3 \;d\tilde{k}$
+(note that $\frac{\partial}{\partial k} \left(  \int_k^{k_s}  a \;d\tilde{k}  \right) = - a$ as $k$ is the lower bound of the integral).
+This leads to:  }
+\end{flalign*}
+\begin{flalign*}
+&\left[ \int\limits_{k}^{k_s}  \frac{\partial e_3}{\partial t} \,dk \cdot \int\limits_{k}^{k_s}  \rho \, e_3 \,dk   \right]_{k_b}^{k_s}
+=-\int\limits_{k_b}^{k_s} \left(  \int\limits_k^{k_s}  \frac{\partial e_3}{\partial t} \;d\tilde{k} \right)  \rho \,e_3 \;dk
+  -\int\limits_{k_b}^{k_s}  \frac{\partial e_3}{\partial t}  \left(  \int\limits_k^{k_s}  \rho \, e_3 \;d\tilde{k} \right)   dk
+&&&\\
+\allowdisplaybreaks
+\intertext{Noting that $\frac{\partial \eta}{\partial t} 
+		= \frac{\partial}{\partial t}  \left( \int_{k_b}^{k_s}   e_3  \;d\tilde{k}  \right)
+		= \int_{k_b}^{k_s}  \frac{\partial e_3}{\partial t} \;d\tilde{k}$
+and 
+		$p(k) = \int_k^{k_s}  \rho \,g \, e_3 \;d\tilde{k} $, 
+but also that $\frac{\partial \eta}{\partial t}$ does not depends on $k$, it comes:
+}
+& - \int\limits_{k_b}^{k_s}  \rho \, \frac{\partial \eta}{\partial t} \, e_3 \;dk
+= - \int\limits_{k_b}^{k_s} \left(  \int\limits_k^{k_s}  \frac{\partial e_3}{\partial t} \;d\tilde{k} \right)   \, \rho \, g   e_3\;dk
+   - \int\limits_{k_b}^{k_s}  \frac{\partial e_3}{\partial t} \frac{p}{g}         \;dk       &&&\\
+\end{flalign*}
+Mutliplying by $g$ and integrating over the $(i,j)$ domain it becomes:
+\begin{flalign*}
+\int\limits_D  \rho \, g \, \left(  \int\limits_k^{k_s}  \frac{\partial e_3}{\partial t} \;d\tilde{k} \right)    \;dv
+=  \int\limits_D  \rho \, g \, \frac{\partial \eta}{\partial t} dv
+  - \int\limits_D  \frac{p}{e_3}\frac{\partial e_3}{\partial t}         \;dv
+\end{flalign*}
+Using this property, we therefore have:
+\begin{flalign*}
+\int\limits_D   \rho \, g \, \frac{\partial z }{\partial t} \;dv   
+&= \int\limits_D    \rho \, g \, \frac{\partial \eta}{\partial t}   \;dv   
+  - \left(  \int\limits_D  \rho \, g \, \frac{\partial \eta}{\partial t} dv
+           - \int\limits_D  \frac{p}{e_3}\frac{\partial e_3}{\partial t}   \;dv  \right)    &&&\\
+%
+&=\int\limits_D \frac{p}{e_3} \frac{\partial (e_3\,\rho)}{\partial t}\; \;dv     
+\end{flalign*}
+% end gm comment
+}
+%
+
+
+% ================================================================
+% Discrete Total energy Conservation : vector invariant form
+% ================================================================
+\section{Discrete total energy conservation : vector invariant form}
+\label{Apdx_C.1}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Total energy conservation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Total energy conservation}
+\label{Apdx_C_KE+PE}
+
+The discrete form of the total energy conservation, \eqref{Eq_Tot_Energy}, is given by:
+\begin{flalign*}
+\partial_t  \left(  \sum\limits_{i,j,k} \biggl\{ \frac{u^2}{2} \,b_u + \frac{v^2}{2}\, b_v +  \rho \, g \, z_t \,b_t  \biggr\} \right) &=0  \\
+\end{flalign*}
+which in vector invariant forms, it leads to:
+\begin{equation} \label{KE+PE_vect_discrete}   \begin{split}
+                        \sum\limits_{i,j,k} \biggl\{   u\,                        \partial_t u         \;b_u 
+                                                              + v\,                        \partial_t v          \;b_v  \biggr\}
+  + \frac{1}{2} \sum\limits_{i,j,k} \biggl\{  \frac{u^2}{e_{3u}}\partial_t e_{3u} \;b_u 
+                                                             +  \frac{v^2}{e_{3v}}\partial_t e_{3v} \;b_v   \biggr\}      \\
+= - \sum\limits_{i,j,k} \biggl\{ \frac{1}{e_{3t}}\partial_t (e_{3t} \rho) \, g \, z_t \;b_t  \biggr\} 
+     - \sum\limits_{i,j,k} \biggl\{ \rho \,g\,\partial_t (z_t) \,b_t  \biggr\}                                
+\end{split} \end{equation}
+
+Substituting the discrete expression of the time derivative of the velocity either in vector invariant,
+leads to the discrete equivalent of the four equations \eqref{E_tot_flux}. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       Vorticity term (coriolis + vorticity part of the advection)
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Vorticity term (coriolis + vorticity part of the advection)}
+\label{Apdx_C_vor}
+
+Let $q$, located at $f$-points, be either the relative ($q=\zeta / e_{3f}$), or  
+the planetary ($q=f/e_{3f}$), or the total potential vorticity ($q=(\zeta +f) /e_{3f}$). 
+Two discretisation of the vorticity term (ENE and EEN) allows the conservation of 
+the kinetic energy.
+% -------------------------------------------------------------------------------------------------------------
+%       Vorticity Term with ENE scheme
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Vorticity Term with ENE scheme (\np{ln\_dynvor\_ene}=.true.)}
+\label{Apdx_C_vorENE} 
+
+For the ENE scheme, the two components of the vorticity term are given by :
+\begin{equation*}
+- e_3 \, q \;{\textbf{k}}\times {\textbf {U}}_h    \equiv 
+	\left( {{  \begin{array} {*{20}c}
+		+ \frac{1} {e_{1u}} \; 
+		\overline {\, q \ \overline {\left( e_{1v}\,e_{3v}\,v \right)}^{\,i+1/2}} ^{\,j}        \hfill \\
+		- \frac{1} {e_{2v}} \; 
+		\overline {\, q \ \overline {\left( e_{2u}\,e_{3u}\,u \right)}^{\,j+1/2}} ^{\,i}       \hfill \\
+	\end{array}} }    \right)
+\end{equation*}
+
+This formulation does not conserve the enstrophy but it does conserve the 
+total kinetic energy. Indeed, the kinetic energy tendency associated to the 
+vorticity term and averaged over the ocean domain can be transformed as
+follows:
+\begin{flalign*}
+&\int\limits_D -  \left(  e_3 \, q \;\textbf{k} \times \textbf{U}_h  \right) \cdot \textbf{U}_h  \;  dv &&  \\
+& \qquad \qquad {\begin{array}{*{20}l} 
+&\equiv \sum\limits_{i,j,k} 	\biggl\{ 	
+	  \frac{1} {e_{1u}} \overline { \,q\ \overline{ V }^{\,i+1/2}} ^{\,j} \, u \; b_u 
+	- \frac{1} {e_{2v}}\overline { \, q\ \overline{ U }^{\,j+1/2}} ^{\,i} \, v \; b_v \; \biggr\}    \\ 
+&\equiv  \sum\limits_{i,j,k} 	\biggl\{ 	
+	  \overline { \,q\ \overline{ V }^{\,i+1/2}}^{\,j} \; U 
+	- \overline { \,q\ \overline{ U }^{\,j+1/2}}^{\,i} \; V  \; \biggr\}     \\
+&\equiv \sum\limits_{i,j,k} q \  \biggl\{  \overline{ V }^{\,i+1/2}\; \overline{ U }^{\,j+1/2}        
+		                                        - \overline{ U }^{\,j+1/2}\; \overline{ V }^{\,i+1/2}         \biggr\}  \quad  \equiv 0
+\end{array} } 		
+\end{flalign*}
+In other words, the domain averaged kinetic energy does not change due to the vorticity term.
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Vorticity Term with EEN scheme
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Vorticity Term with EEN scheme (\np{ln\_dynvor\_een}=.true.)}
+\label{Apdx_C_vorEEN} 
+
+With the EEN scheme, the vorticity terms are represented as: 
+\begin{equation} \label{Eq_dynvor_een}
+\left\{ {    \begin{aligned}
+ +q\,e_3 \, v 	&\equiv +\frac{1}{e_{1u} }   \sum_{\substack{i_p,\,k_p}} 
+                         {^{i+1/2-i_p}_j}  \mathbb{Q}^{i_p}_{j_p}  \left( e_{1v} e_{3v} \ v  \right)^{i+i_p-1/2}_{j+j_p}   \\
+ - q\,e_3 \, u     &\equiv -\frac{1}{e_{2v} }    \sum_{\substack{i_p,\,k_p}} 
+                         {^i_{j+1/2-j_p}}  \mathbb{Q}^{i_p}_{j_p}  \left( e_{2u} e_{3u} \ u  \right)^{i+i_p}_{j+j_p-1/2}   \\
+\end{aligned}   } \right.
+\end{equation} 
+where the indices $i_p$ and $j_p$ take the following value: 
+$i_p = -1/2$ or $1/2$ and $j_p = -1/2$ or $1/2$,
+and the vorticity triads, ${^i_j}\mathbb{Q}^{i_p}_{j_p}$, defined at $T$-point, are given by: 
+\begin{equation} \label{Q_triads}
+_i^j \mathbb{Q}^{i_p}_{j_p}
+= \frac{1}{12} \ \left(   q^{i-i_p}_{j+j_p} + q^{i+j_p}_{j+i_p} + q^{i+i_p}_{j-j_p}  \right)
+\end{equation}
+
+This formulation does conserve the total kinetic energy. Indeed,
+\begin{flalign*}
+&\int\limits_D - \textbf{U}_h \cdot   \left(  \zeta \;\textbf{k} \times \textbf{U}_h  \right)  \;  dv &&  \\
+\equiv \sum\limits_{i,j,k} &	\biggl\{ 
+	    \left[  \sum_{\substack{i_p,\,k_p}} 
+                         {^{i+1/2-i_p}_j}\mathbb{Q}^{i_p}_{j_p} \; V^{i+1/2-i_p}_{j+j_p} \right] U^{i+1/2}_{j}    %   &&\\
+	  - \left[  \sum_{\substack{i_p,\,k_p}} 
+                         {^i_{j+1/2-j_p}}\mathbb{Q}^{i_p}_{j_p} \; U^{i+i_p}_{j+1/2-j_p}  \right] V^{i}_{j+1/2}    \biggr\}     && \\
+\\
+\equiv \sum\limits_{i,j,k} &  \sum_{\substack{i_p,\,k_p}} \biggl\{  \ \  
+                         {^{i+1/2-i_p}_j}\mathbb{Q}^{i_p}_{j_p} \; V^{i+1/2-i_p}_{j+j_p}  \, U^{i+1/2}_{j}     %  &&\\
+                       - {^i_{j+1/2-j_p}}\mathbb{Q}^{i_p}_{j_p} \; U^{i+i_p}_{j+1/2-j_p} \, V^{i}_{j+1/2}     \ \;     \biggr\}     &&  \\
+%
+\allowdisplaybreaks
+\intertext{ Expending the summation on $i_p$ and $k_p$, it becomes:}
+%
+\equiv \sum\limits_{i,j,k} & \biggl\{  \ \  
+                    {^{i+1}_j     }\mathbb{Q}^{-1/2}_{+1/2} \;V^{i+1}_{j+1/2} \; U^{\,i+1/2}_{j}      
+                -  {^i_{j}\quad}\mathbb{Q}^{-1/2}_{+1/2} \; U^{i-1/2}_{j}    \; V^{\,i}_{j+1/2}         &&  \\
+        &       + {^{i+1}_j     }\mathbb{Q}^{-1/2}_{-1/2} \; V^{i+1}_{j-1/2} \; U^{\,i+1/2}_{j}        
+                  - {^i_{j+1}     }\mathbb{Q}^{-1/2}_{-1/2} \; U^{i-1/2}_{j+1} \; V^{\,i}_{j+1/2}        \biggr.     &&  \\
+        &       + {^{i}_j\quad}\mathbb{Q}^{+1/2}_{+1/2} \; V^{i}_{j+1/2}   \; U^{\,i+1/2}_{j}      
+                  - {^i_{j}\quad}\mathbb{Q}^{+1/2}_{+1/2} \; U^{i+1/2}_{j}   \; V^{\,i}_{j+1/2}          \biggr.        &&  \\
+        &       + {^{i}_j\quad}\mathbb{Q}^{+1/2}_{-1/2} \; V^{i}_{j-1/2}     \; U^{\,i+1/2}_{j}       
+                 -  {^i_{j+1}     }\mathbb{Q}^{+1/2}_{-1/2} \; U^{i+1/2}_{j+1}\; V^{\,i}_{j+1/2}  \ \;     \biggr\}     &&  \\
+%
+\allowdisplaybreaks
+\intertext{The summation is done over all $i$ and $j$ indices, it is therefore possible to introduce 
+a shift of $-1$ either in $i$ or $j$ direction in some of the term of the summation (first term of the 
+first and second lines, second term of the second and fourth lines). By doning so, we can regroup 
+all the terms of the summation by triad at a ($i$,$j$) point. In other words, we regroup all the terms 
+in the neighbourhood  that contain a triad at the same ($i$,$j$) indices. It becomes: }
+\allowdisplaybreaks
+%
+\equiv \sum\limits_{i,j,k} & \biggl\{  \ \  
+             {^{i}_j}\mathbb{Q}^{-1/2}_{+1/2}  \left[  V^{i}_{j+1/2}\, U^{\,i-1/2}_{j}    
+                                                                       -  U^{i-1/2}_{j} \, V^{\,i}_{j+1/2}      \right]    &&  \\
+ &       + {^{i}_j}\mathbb{Q}^{-1/2}_{-1/2}  \left[  V^{i}_{j-1/2} \, U^{\,i-1/2}_{j}        
+                                                                     -    U^{i-1/2}_{j} \, V^{\,i}_{j-1/2}      \right]    \biggr.   &&  \\
+ &      + {^{i}_j}\mathbb{Q}^{+1/2}_{+1/2}  \left[  V^{i}_{j+1/2} \, U^{\,i+1/2}_{j}      
+                                                                     -    U^{i+1/2}_{j} \, V^{\,i}_{j+1/2}     \right]  \biggr.  &&  \\
+ &     + {^{i}_j}\mathbb{Q}^{+1/2}_{-1/2}  \left[   V^{i}_{j-1/2} \, U^{\,i+1/2}_{j}                                                                     
+                                                                    -    U^{i+1/2}_{j-1} \, V^{\,i}_{j-1/2}  \right]  \ \;   \biggr\}   \qquad
+\equiv \ 0   &&
+\end{flalign*}
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Gradient of Kinetic Energy / Vertical Advection
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Gradient of Kinetic Energy / Vertical Advection}
+\label{Apdx_C_zad} 
+
+The change of Kinetic Energy (KE) due to the vertical advection is exactly 
+balanced by the change of KE due to the horizontal gradient of KE~:
+\begin{equation*}
+    \int_D \textbf{U}_h \cdot \frac{1}{e_3 } \omega \partial_k \textbf{U}_h \;dv
+=  -   \int_D \textbf{U}_h \cdot \nabla_h \left( \frac{1}{2}\;{\textbf{U}_h}^2 \right)\;dv
+   +   \frac{1}{2} \int_D {  \frac{{\textbf{U}_h}^2}{e_3} \partial_t ( e_3) \;dv }  \\
+\end{equation*}
+Indeed, using successively \eqref{DOM_di_adj} ($i.e.$ the skew symmetry 
+property of the $\delta$ operator) and the continuity equation, then 
+\eqref{DOM_di_adj} again, then the commutativity of operators 
+$\overline {\,\cdot \,}$ and $\delta$, and finally \eqref{DOM_mi_adj} 
+($i.e.$ the symmetry property of the $\overline {\,\cdot \,}$ operator) 
+applied in the horizontal and vertical directions, it becomes:
+\begin{flalign*}
+& - \int_D \textbf{U}_h \cdot \text{KEG}\;dv 	
+= - \int_D \textbf{U}_h \cdot \nabla_h \left( \frac{1}{2}\;{\textbf{U}_h}^2 \right)\;dv    &&&\\
+%
+\equiv  & -  \sum\limits_{i,j,k} \frac{1}{2}  \biggl\{	
+	\frac{1} {e_{1u}}  \delta_{i+1/2}   \left[   \overline {u^2}^{\,i} + \overline {v^2}^{\,j}   \right]  u \ b_u 
+     + \frac{1} {e_{2v}}  \delta_{j+1/2}   \left[   \overline {u^2}^{\,i} + \overline {v^2}^{\,j}   \right]  v \ b_v   \biggr\}  	&&&  \\ 
+%
+\equiv & + \sum\limits_{i,j,k} \frac{1}{2}  \left(   \overline {u^2}^{\,i} + \overline {v^2}^{\,j}   \right)\;
+                                                              \biggl\{ \delta_{i} \left[  U   \right] +  \delta_{j} \left[  V  \right]    \biggr\}       &&&  \\ 
+\allowdisplaybreaks
+%
+\equiv   & - \sum\limits_{i,j,k}  \frac{1}{2}
+	\left(       \overline {u^2}^{\,i} + \overline {v^2}^{\,j}   \right)  \;  
+	\biggl\{   \frac{b_t}{e_{3t}} \partial_t (e_{3t})  +  \delta_k \left[  W   \right]    \biggr\}    &&&\\
+\allowdisplaybreaks
+%
+\equiv & +  \sum\limits_{i,j,k} \frac{1}{2} \delta_{k+1/2}   \left[ \overline{ u^2}^{\,i} + \overline{ v^2}^{\,j}   \right] \;  W 
+	       -  \sum\limits_{i,j,k} \frac{1}{2} \left(   \overline {u^2}^{\,i} + \overline {v^2}^{\,j}   \right) \;\partial_t b_t   &&& \\
+\allowdisplaybreaks
+%
+\equiv   & + \sum\limits_{i,j,k} \frac{1} {2} \left(    \overline{\delta_{k+1/2} \left[ u^2 \right]}^{\,i} 
+	                                                                + \overline{\delta_{k+1/2} \left[ v^2 \right]}^{\,j}    \right) \; W     
+	       -  \sum\limits_{i,j,k}  \left(  \frac{u^2}{2}\,\partial_t \overline{b_t}^{\,{i+1/2}}
+	                                              + \frac{v^2}{2}\,\partial_t \overline{b_t}^{\,{j+1/2}}   \right)    &&& \\
+\allowdisplaybreaks
+\intertext{Assuming that $b_u= \overline{b_t}^{\,i+1/2}$ and $b_v= \overline{b_t}^{\,j+1/2}$, or at least that the time
+derivative of these two equations is satisfied, it becomes:}
+%
+\equiv &     \sum\limits_{i,j,k} \frac{1} {2}
+	\biggl\{ \; \overline{W}^{\,i+1/2}\;\delta_{k+1/2} \left[ u^2 \right]    
+	            + \overline{W}^{\,j+1/2}\;\delta_{k+1/2} \left[ v^2 \right]  \;  \biggr\}   
+	       -  \sum\limits_{i,j,k}  \left(  \frac{u^2}{2}\,\partial_t b_u
+	                                             + \frac{v^2}{2}\,\partial_t b_v   \right)    &&& \\
+\allowdisplaybreaks
+%	
+\equiv &     \sum\limits_{i,j,k} 
+	\biggl\{ \; \overline{W}^{\,i+1/2}\; \overline {u}^{\,k+1/2}\; \delta_{k+1/2}[ u ]    
+	            + \overline{W}^{\,j+1/2}\; \overline {v}^{\,k+1/2}\; \delta_{k+1/2}[ v ]  \;  \biggr\} 
+	       -  \sum\limits_{i,j,k}  \left(  \frac{u^2}{2}\,\partial_t b_u
+	                                             + \frac{v^2}{2}\,\partial_t b_v   \right)    &&& \\
+%
+\allowdisplaybreaks
+\equiv  &  \sum\limits_{i,j,k}  
+	\biggl\{ \; \frac{1} {b_u } \; \overline { \overline{W}^{\,i+1/2}\,\delta_{k+1/2}  \left[ u \right] }^{\,k} \;u\;b_u  
+                    + \frac{1} {b_v } \; \overline { \overline{W}^{\,j+1/2} \delta_{k+1/2}  \left[ v \right]  }^{\,k} \;v\;b_v  \; \biggr\}  
+	       -  \sum\limits_{i,j,k}  \left(  \frac{u^2}{2}\,\partial_t b_u
+	                                             + \frac{v^2}{2}\,\partial_t b_v   \right)    &&& \\
+%
+\intertext{The first term provides the discrete expression for the vertical advection of momentum (ZAD), 
+while the second term corresponds exactly to \eqref{KE+PE_vect_discrete}, therefore:}
+\equiv&                   \int\limits_D \textbf{U}_h \cdot \text{ZAD} \;dv  
+           + \frac{1}{2} \int_D { {\textbf{U}_h}^2 \frac{1}{e_3} \partial_t  (e_3)  \;dv }    &&&\\
+\equiv&                   \int\limits_D \textbf{U}_h \cdot w \partial_k \textbf{U}_h \;dv  
+           + \frac{1}{2} \int_D { {\textbf{U}_h}^2 \frac{1}{e_3} \partial_t  (e_3)  \;dv }    &&&\\
+\end{flalign*}
+
+There is two main points here. First, the satisfaction of this property links the choice of 
+the discrete formulation of the vertical advection and of the horizontal gradient 
+of KE. Choosing one imposes the other. For example KE can also be discretized 
+as $1/2\,({\overline u^{\,i}}^2 + {\overline v^{\,j}}^2)$. This leads to the following 
+expression for the vertical advection:
+\begin{equation*}
+\frac{1} {e_3 }\; \omega\; \partial_k \textbf{U}_h
+\equiv \left( {{\begin{array} {*{20}c}
+\frac{1} {e_{1u}\,e_{2u}\,e_{3u}} \;  \overline{\overline {e_{1t}\,e_{2t} \,\omega\;\delta_{k+1/2} 
+\left[ \overline u^{\,i+1/2} \right]}}^{\,i+1/2,k}  \hfill \\
+\frac{1} {e_{1v}\,e_{2v}\,e_{3v}} \;   \overline{\overline {e_{1t}\,e_{2t} \,\omega \;\delta_{k+1/2}
+\left[ \overline v^{\,j+1/2} \right]}}^{\,j+1/2,k} \hfill \\
+\end{array}} } \right)
+\end{equation*}
+a formulation that requires an additional horizontal mean in contrast with 
+the one used in NEMO. Nine velocity points have to be used instead of 3. 
+This is the reason why it has not been chosen.
+
+Second, as soon as the chosen $s$-coordinate depends on time, an extra constraint
+arises on the time derivative of the volume at $u$- and $v$-points:
+\begin{flalign*}
+e_{1u}\,e_{2u}\,\partial_t (e_{3u}) =\overline{ e_{1t}\,e_{2t}\;\partial_t (e_{3t}) }^{\,i+1/2}    \\
+e_{1v}\,e_{2v}\,\partial_t (e_{3v})  =\overline{ e_{1t}\,e_{2t}\;\partial_t (e_{3t}) }^{\,j+1/2}
+\end{flalign*}
+which is (over-)satified by defining the vertical scale factor as follows:
+\begin{flalign} \label{e3u-e3v}
+e_{3u} = \frac{1}{e_{1u}\,e_{2u}}\;\overline{ e_{1t}^{ }\,e_{2t}^{ }\,e_{3t}^{ } }^{\,i+1/2}    \\
+e_{3v} = \frac{1}{e_{1v}\,e_{2v}}\;\overline{ e_{1t}^{ }\,e_{2t}^{ }\,e_{3t}^{ } }^{\,j+1/2} 
+\end{flalign}
+
+Blah blah required on the the step representation of bottom topography.....
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Pressure Gradient Term
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Pressure Gradient Term}
+\label{Apdx_C.1.4}
+
+\gmcomment{
+A pressure gradient has no contribution to the evolution of the vorticity as the 
+curl of a gradient is zero. In the $z$-coordinate, this property is satisfied locally 
+on a C-grid with 2nd order finite differences (property \eqref{Eq_DOM_curl_grad}). 
+}
+
+When the equation of state is linear ($i.e.$ when an advection-diffusion equation 
+for density can be derived from those of temperature and salinity) the change of 
+KE due to the work of pressure forces is balanced by the change of potential 
+energy due to buoyancy forces: 
+\begin{equation*}
+- \int_D  \left. \nabla p \right|_z \cdot \textbf{U}_h \;dv 
+= - \int_D \nabla \cdot \left( \rho \,\textbf {U} \right) \,g\,z \;dv
+  + \int_D g\, \rho \; \partial_t (z)  \;dv
+\end{equation*}
+
+This property can be satisfied in a discrete sense for both $z$- and $s$-coordinates. 
+Indeed, defining the depth of a $T$-point, $z_t$, as the sum of the vertical scale 
+factors at $w$-points starting from the surface, the work of pressure forces can be 
+written as:
+\begin{flalign*}
+&- \int_D  \left. \nabla p \right|_z \cdot \textbf{U}_h \;dv   
+\equiv \sum\limits_{i,j,k} \biggl\{ \;  - \frac{1} {e_{1u}}   \Bigl( 
+\delta_{i+1/2} [p_t] - g\;\overline \rho^{\,i+1/2}\;\delta_{i+1/2} [z_t]     \Bigr)  \; u\;b_u  
+	&&  \\ & \qquad \qquad  \qquad \qquad  \qquad \quad \ \,
+					 	      - \frac{1} {e_{2v}}    \Bigl( 
+\delta_{j+1/2} [p_t] - g\;\overline \rho^{\,j+1/2}\delta_{j+1/2} [z_t]      \Bigr)  \; v\;b_v \;  \biggr\}   && \\ 
+%
+\allowdisplaybreaks
+\intertext{Using successively  \eqref{DOM_di_adj}, $i.e.$ the skew symmetry property of 
+the $\delta$ operator, \eqref{Eq_wzv}, the continuity equation, \eqref{Eq_dynhpg_sco}, 
+the hydrostatic equation in the $s$-coordinate, and $\delta_{k+1/2} \left[ z_t \right] \equiv e_{3w} $,
+which comes from the definition of $z_t$, it becomes: }
+\allowdisplaybreaks
+%
+\equiv& +  \sum\limits_{i,j,k}   g  \biggl\{ 
+		\overline\rho^{\,i+1/2}\,U\,\delta_{i+1/2}[z_t]    
+	+  	\overline\rho^{\,j+1/2}\,V\,\delta_{j+1/2}[z_t]     
+	+\Bigl(  \delta_i[U] + \delta_j [V]  \Bigr)\;\frac{p_t}{g} \biggr\}  &&\\
+%
+\equiv& +  \sum\limits_{i,j,k}   g   \biggl\{ 
+		\overline\rho^{\,i+1/2}\,U\,\delta_{i+1/2}[z_t]    
+	+  	\overline\rho^{\,j+1/2}\,V\,\delta_{j+1/2}[z_t]     
+	 -       \left(   \frac{b_t}{e_{3t}} \partial_t (e_{3t})  +  \delta_k \left[ W \right]    \right) \frac{p_t}{g}    \biggr\}   &&&\\ 
+%
+\equiv& +  \sum\limits_{i,j,k}  g   \biggl\{ 
+		\overline\rho^{\,i+1/2}\,U\,\delta_{i+1/2}[z_t]    
+	+  	\overline\rho^{\,j+1/2}\,V\,\delta_{j+1/2}[z_t]     
+	+	\frac{W}{g}\;\delta_{k+1/2} [p_t] 
+	 -        \frac{p_t}{g}\,\partial_t b_t    \biggr\}    &&&\\
+%
+\equiv& +  \sum\limits_{i,j,k}  g   \biggl\{ 
+		\overline\rho^{\,i+1/2}\,U\,\delta_{i+1/2}[z_t]    
+	+  	\overline\rho^{\,j+1/2}\,V\,\delta_{j+1/2}[z_t]     
+	- 	W\;e_{3w} \overline \rho^{\,k+1/2}         
+	 -        \frac{p_t}{g}\,\partial_t b_t    \biggr\}    &&&\\
+%
+\equiv& +  \sum\limits_{i,j,k}    g   \biggl\{ 
+		\overline\rho^{\,i+1/2}\,U\,\delta_{i+1/2}[z_t]    
+	+  	\overline\rho^{\,j+1/2}\,V\,\delta_{j+1/2}[z_t]     
+	+ 	W\; \overline \rho^{\,k+1/2}\;\delta_{k+1/2} [z_t]   
+	 -        \frac{p_t}{g}\,\partial_t b_t    \biggr\}    &&&\\
+%
+\allowdisplaybreaks
+%
+\equiv& - \sum\limits_{i,j,k}   g \; z_t      \biggl\{ 
+		\delta_i 	\left[ U\;	\overline \rho^{\,i+1/2} 	\right]
+	+ 	\delta_j 	\left[ V\;	\overline \rho^{\,j+1/2} 	\right]
+	+ 	\delta_k 	\left[ W\;	\overline \rho^{\,k+1/2} 	\right]       \biggr\}    
+             - \sum\limits_{i,j,k}       \biggl\{ p_t\;\partial_t b_t    \biggr\}   &&&\\	
+%
+\equiv& + \sum\limits_{i,j,k}   g \; z_t    \biggl\{      \partial_t ( e_{3t} \,\rho)    \biggr\}  \; b_t    
+             -  \sum\limits_{i,j,k}                 \biggl\{  p_t\;\partial_t b_t                     \biggr\}              &&&\\	
+%
+\end{flalign*}
+The first term is exactly the first term of the right-hand-side of \eqref{KE+PE_vect_discrete}.
+It remains to demonstrate that the last term, which is obviously a discrete analogue of 
+$\int_D \frac{p}{e_3} \partial_t (e_3)\;dv$ is equal to the last term of \eqref{KE+PE_vect_discrete}.
+In other words, the following property must be satisfied:
+\begin{flalign*}
+           \sum\limits_{i,j,k}  \biggl\{  p_t\;\partial_t b_t                  \biggr\}        
+\equiv  \sum\limits_{i,j,k}  \biggl\{ \rho \,g\,\partial_t (z_t) \,b_t  \biggr\}                                
+\end{flalign*}
+
+Let introduce $p_w$ the pressure at $w$-point such that $\delta_k [p_w] = - \rho \,g\,e_{3t}$. 
+The right-hand-side of the above equation can be transformed as follows:
+
+\begin{flalign*}
+               \sum\limits_{i,j,k}  \biggl\{ \rho \,g\,\partial_t (z_t) \,b_t  \biggr\}  
+&\equiv   - \sum\limits_{i,j,k}  \biggl\{ \delta_k [p_w]\,\partial_t (z_t) \,e_{1t}\,e_{2t}  \biggr\}        &&&\\
+%
+&\equiv  + \sum\limits_{i,j,k}  \biggl\{  p_w\, \delta_{k+1/2} [\partial_t (z_t)] \,e_{1t}\,e_{2t}  \biggr\}  
+  \equiv  + \sum\limits_{i,j,k}  \biggl\{  p_w\, \partial_t (e_{3w}) \,e_{1t}\,e_{2t}  \biggr\}        &&&\\
+&\equiv  + \sum\limits_{i,j,k}  \biggl\{  p_w\, \partial_t (b_w) \biggr\}  
+ %
+% & \equiv     \sum\limits_{i,j,k} \biggl\{  \frac{1}{e_{3t}} \delta_k [p_w]\;\partial_t (z_t) \,b_w   \right)   \biggr\}           &&&\\
+% & \equiv     \sum\limits_{i,j,k} \biggl\{   p_w\;\partial_t \left(    \delta_k [z_t]   \right)  e_{1w}\,e_{2w}   \biggr\}           &&&\\
+% & \equiv     \sum\limits_{i,j,k} \biggl\{   p_w\;\partial_t b_w   \biggr\}          
+\end{flalign*}
+therefore, the balance to be satisfied is:
+\begin{flalign*}
+           \sum\limits_{i,j,k}  \biggl\{  p_t\;\partial_t (b_t) \biggr\}  \equiv  \sum\limits_{i,j,k}  \biggl\{  p_w\, \partial_t (b_w) \biggr\}  
+\end{flalign*}
+which is a purely vertical balance:
+\begin{flalign*}
+           \sum\limits_{k}  \biggl\{  p_t\;\partial_t (e_{3t}) \biggr\}  \equiv  \sum\limits_{k}  \biggl\{  p_w\, \partial_t (e_{3w}) \biggr\}  
+\end{flalign*}
+Defining $p_w = \overline{p_t}^{\,k+1/2}$
+
+%gm comment
+\gmcomment{
+\begin{flalign*}
+ \sum\limits_{i,j,k} \biggl\{   p_t\;\partial_t b_t   \biggr\}                                &&&\\
+ %
+ & \equiv     \sum\limits_{i,j,k} \biggl\{  \frac{1}{e_{3t}} \delta_k [p_w]\;\partial_t (z_t) \,b_w    \biggr\}           &&&\\
+ & \equiv     \sum\limits_{i,j,k} \biggl\{   p_w\;\partial_t \left(    \delta_{k+1/2} [z_t]   \right)  e_{1w}\,e_{2w}   \biggr\}           &&&\\
+ & \equiv     \sum\limits_{i,j,k} \biggl\{   p_w\;\partial_t b_w   \biggr\}          
+\end{flalign*}
+
+
+\begin{flalign*}
+\int\limits_D   \rho \, g \, \frac{\partial z }{\partial t} \;dv
+\equiv&  \sum\limits_{i,j,k}   \biggl\{  \frac{1}{e_{3t}} \frac{\partial e_{3t}}{\partial t} p   \biggr\} \; b_t   &&&\\
+\equiv&  \sum\limits_{i,j,k}   \biggl\{      \biggr\} \; b_t   &&&\\
+\end{flalign*}
+
+%
+\begin{flalign*}
+\equiv& - \int_D \nabla \cdot \left( \rho \,\textbf {U} \right)\;g\;z\;\;dv
+   + \int\limits_D g\, \rho \; \frac{\partial z}{\partial t}  \;dv     &&& \\
+\end{flalign*}
+%
+}
+%end gm comment
+
+
+Note that this property strongly constrains the discrete expression of both 
+the depth of $T-$points and of the term added to the pressure gradient in the
+$s$-coordinate. Nevertheless, it is almost never satisfied since a linear equation 
+of state is rarely used.
+
+
+
+
+
+
+
+% ================================================================
+% Discrete Total energy Conservation : flux form
+% ================================================================
+\section{Discrete total energy conservation : flux form}
+\label{Apdx_C.1}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Total energy conservation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Total energy conservation}
+\label{Apdx_C_KE+PE}
+
+The discrete form of the total energy conservation, \eqref{Eq_Tot_Energy}, is given by:
+\begin{flalign*}
+\partial_t \left(  \sum\limits_{i,j,k} \biggl\{ \frac{u^2}{2} \,b_u + \frac{v^2}{2}\, b_v +  \rho \, g \, z_t \,b_t  \biggr\} \right) &=0  \\
+\end{flalign*}
+which in flux form, it leads to:
+\begin{flalign*}
+                        \sum\limits_{i,j,k} \biggl\{  \frac{u    }{e_{3u}}\,\frac{\partial (e_{3u}u)}{\partial t} \,b_u 
+                                                             +  \frac{v    }{e_{3v}}\,\frac{\partial (e_{3v}v)}{\partial t} \,b_v  \biggr\}
+&  -  \frac{1}{2} \sum\limits_{i,j,k} \biggl\{  \frac{u^2}{e_{3u}}\frac{\partial    e_{3u}    }{\partial t} \,b_u 
+                                                             +  \frac{v^2}{e_{3v}}\frac{\partial    e_{3v}    }{\partial t} \,b_v   \biggr\}      \\
+&= - \sum\limits_{i,j,k} \biggl\{ \frac{1}{e_3t}\frac{\partial e_{3t} \rho}{\partial t} \, g \, z_t \,b_t  \biggr\} 
+     - \sum\limits_{i,j,k} \biggl\{ \rho \,g\,\frac{\partial z_t}{\partial t} \,b_t  \biggr\}                                     \\
+\end{flalign*}
+
+Substituting the discrete expression of the time derivative of the velocity either in vector invariant or in flux form,
+leads to the discrete equivalent of the 
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Coriolis and advection terms: flux form
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Coriolis and advection terms: flux form}
+\label{Apdx_C.1.3}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Coriolis plus ``metric'' Term
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Coriolis plus ``metric'' Term}
+\label{Apdx_C.1.3.1} 
+
+In flux from the vorticity term reduces to a Coriolis term in which the Coriolis 
+parameter has been modified to account for the ``metric'' term. This altered 
+Coriolis parameter is discretised at an f-point. It is given by: 
+\begin{equation*}
+f+\frac{1} {e_1 e_2 } \left( v \frac{\partial e_2 } {\partial i} - u \frac{\partial e_1 } {\partial j}\right)\;
+\equiv \;
+f+\frac{1} {e_{1f}\,e_{2f}} \left( \overline v^{\,i+1/2} \delta_{i+1/2} \left[ e_{2u} \right] 
+                                               -\overline u^{\,j+1/2} \delta_{j+1/2} \left[ e_{1u}  \right] \right)
+\end{equation*}
+
+Either the ENE or EEN scheme is then applied to obtain the vorticity term in flux form. 
+It therefore conserves the total KE. The derivation is the same as for the 
+vorticity term in the vector invariant form (\S\ref{Apdx_C_vor}).
+
+% -------------------------------------------------------------------------------------------------------------
+%       Flux form advection
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Flux form advection}
+\label{Apdx_C.1.3.2} 
+
+The flux form operator of the momentum advection is evaluated using a 
+centered second order finite difference scheme. Because of the flux form, 
+the discrete operator does not contribute to the global budget of linear 
+momentum. Because of the centered second order scheme, it conserves 
+the horizontal kinetic energy, that is :
+
+\begin{equation} \label{Apdx_C_ADV_KE_flux}
+ -  \int_D \textbf{U}_h \cdot     \left(                 {{\begin{array} {*{20}c}
+\nabla \cdot \left( \textbf{U}\,u \right) \hfill \\
+\nabla \cdot \left( \textbf{U}\,v \right) \hfill \\       \end{array}} }           \right)   \;dv 
+-   \frac{1}{2} \int_D {  {\textbf{U}_h}^2 \frac{1}{e_3} \frac{\partial  e_3 }{\partial t} \;dv } =\;0
+\end{equation}
+
+Let us first consider the first term of the scalar product ($i.e.$ just the the terms 
+associated with the i-component of the advection) :
+\begin{flalign*}
+&  - \int_D u \cdot \nabla \cdot \left(   \textbf{U}\,u   \right) \; dv   \\
+%
+\equiv& - \sum\limits_{i,j,k} \biggl\{    \frac{1} {b_u}    \biggl(   
+      \delta_{i+1/2}  \left[   \overline {U}^{\,i}      \;\overline u^{\,i}          \right]   
+   + \delta_j           \left[   \overline {V}^{\,i+1/2}\;\overline u^{\,j+1/2}   \right]   
+   + \delta_k          \left[   \overline {W}^{\,i+1/2}\;\overline u^{\,k+1/2} \right]  \biggr)   \;   \biggr\} \, b_u \;u &&&  \\ 
+%
+\equiv& - \sum\limits_{i,j,k} 
+	\biggl\{ 
+      \delta_{i+1/2} \left[   \overline {U}^{\,i}\;  \overline u^{\,i}  \right]
+   + \delta_j          \left[   \overline {V}^{\,i+1/2}\;\overline u^{\,j+1/2}   \right]
+   + \delta_k         \left[   \overline {W}^{\,i+12}\;\overline u^{\,k+1/2}  \right]
+   	\; \biggr\} \; u     \\
+%
+\equiv& + \sum\limits_{i,j,k}
+	\biggl\{ 
+	   \overline {U}^{\,i}\;	\overline u^{\,i} 	\delta_i \left[ u \right] 
+        + \overline {V}^{\,i+1/2}\;	\overline u^{\,j+1/2} 	\delta_{j+1/2} \left[ u \right] 
+        + \overline {W}^{\,i+1/2}\;	\overline u^{\,k+1/2}	\delta_{k+1/2} 	\left[ u \right]     \biggr\}     && \\
+%
+\equiv& + \frac{1}{2} \sum\limits_{i,j,k}    \biggl\{ 
+	    \overline{U}^{\,i} 		\delta_i 		\left[ u^2 \right] 
+	 + \overline{V}^{\,i+1/2} 	\delta_{j+/2} 	\left[ u^2 \right]
+	 + \overline{W}^{\,i+1/2} 	\delta_{k+1/2} 	\left[ u^2 \right]      \biggr\} && \\
+%
+\equiv& -  \sum\limits_{i,j,k}    \frac{1}{2}   \bigg\{ 
+	    U  \; \delta_{i+1/2}    \left[ \overline {u^2}^{\,i} \right]
+         + V  \; \delta_{j+1/2}    \left[ \overline {u^2}^{\,i} \right]
+	 + W \; \delta_{k+1/2}   \left[ \overline {u^2}^{\,i} \right]     \biggr\}    &&& \\
+%
+\equiv& - \sum\limits_{i,j,k}  \frac{1}{2}  \overline {u^2}^{\,i}     \biggl\{ 
+	   \delta_{i+1/2} 	\left[ U  \right]
+	+ \delta_{j+1/2} 	\left[ V  \right]
+	+ \delta_{k+1/2} 	\left[ W \right]     \biggr\}    &&& \\
+%
+\equiv& + \sum\limits_{i,j,k}  \frac{1}{2}  \overline {u^2}^{\,i} 
+	\biggl\{     \left(   \frac{1}{e_{3t}} \frac{\partial e_{3t}}{\partial t}   \right) \; b_t     \biggr\}    &&& \\
+\end{flalign*}
+Applying similar manipulation applied to the second term of the scalar product 
+leads to :
+\begin{equation*}
+ -  \int_D \textbf{U}_h \cdot     \left(                 {{\begin{array} {*{20}c}
+\nabla \cdot \left( \textbf{U}\,u \right) \hfill \\
+\nabla \cdot \left( \textbf{U}\,v \right) \hfill \\       \end{array}} }           \right)   \;dv     
+\equiv + \sum\limits_{i,j,k}  \frac{1}{2}  \left( \overline {u^2}^{\,i} + \overline {v^2}^{\,j} \right)
+	\biggl\{     \left(   \frac{1}{e_{3t}} \frac{\partial e_{3t}}{\partial t}   \right) \; b_t     \biggr\}    
+\end{equation*}
+which is the discrete form of 
+$ \frac{1}{2} \int_D u \cdot \nabla \cdot \left(   \textbf{U}\,u   \right) \; dv $. 
+\eqref{Apdx_C_ADV_KE_flux} is thus satisfied.
+
+
+When the UBS scheme is used to evaluate the flux form momentum advection, 
+the discrete operator does not contribute to the global budget of linear momentum 
+(flux form). The horizontal kinetic energy is not conserved, but forced to decay 
+($i.e.$ the scheme is diffusive). 
+
+
+
+
+
+
+
+
+
+
+% ================================================================
+% Discrete Enstrophy Conservation
+% ================================================================
+\section{Discrete enstrophy conservation}
+\label{Apdx_C.1}
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Vorticity Term with ENS scheme
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Vorticity Term with ENS scheme  (\np{ln\_dynvor\_ens}=.true.)}
+\label{Apdx_C_vorENS} 
+
+In the ENS scheme, the vorticity term is descretized as follows:
+\begin{equation} \label{Eq_dynvor_ens}
+\left\{   \begin{aligned}
++\frac{1}{e_{1u}} & \overline{q}^{\,i}  & {\overline{ \overline{\left( e_{1v}\,e_{3v}\;  v \right) } } }^{\,i, j+1/2}    \\
+- \frac{1}{e_{2v}} & \overline{q}^{\,j}  & {\overline{ \overline{\left( e_{2u}\,e_{3u}\; u \right) } } }^{\,i+1/2, j}  
+\end{aligned}  \right.
+\end{equation} 
+
+The scheme does not allow but the conservation of the total kinetic energy but the conservation 
+of $q^2$, the potential enstrophy for a horizontally non-divergent flow ($i.e.$ when $\chi$=$0$). 
+Indeed, using the symmetry or skew symmetry properties of the operators (Eqs \eqref{DOM_mi_adj} 
+and \eqref{DOM_di_adj}), it can be shown that:
+\begin{equation} \label{Apdx_C_1.1}
+\int_D {q\,\;{\textbf{k}}\cdot \frac{1} {e_3} \nabla \times \left( {e_3 \, q \;{\textbf{k}}\times {\textbf{U}}_h } \right)\;dv} \equiv 0
+\end{equation}
+where $dv=e_1\,e_2\,e_3 \; di\,dj\,dk$ is the volume element. Indeed, using 
+\eqref{Eq_dynvor_ens}, the discrete form of the right hand side of \eqref{Apdx_C_1.1} 
+can be transformed as follow:
+\begin{flalign*} 
+&\int_D q \,\; \textbf{k} \cdot \frac{1} {e_3 } \nabla \times 
+	\left(  e_3 \, q \; \textbf{k} \times  \textbf{U}_h   \right)\;   dv       \\
+%
+& \qquad {\begin{array}{*{20}l} 
+&\equiv \sum\limits_{i,j,k} 
+q \ \left\{  \delta_{i+1/2}  \left[ - \,\overline {q}^{\,i}\;  \overline{\overline  U }^{\,i,j+1/ 2} \right]  
+             - \delta_{j+1/2} \left[	 \overline {q}^{\,j}\;  \overline{\overline  V }^{\,i+1/2, j} \right]     \right\}    \\ 
+%
+&\equiv \sum\limits_{i,j,k} 
+	\left\{   \delta_i [q] \; \overline{q}^{\,i} \; \overline{  \overline U  }^{\,i,j+1/2} 
+		+ \delta_j [q] \; \overline{q}^{\,j} \; \overline{\overline V }^{\,i+1/2,j}        \right\}       &&  \\ 
+%
+&\equiv \,\frac{1} {2} \sum\limits_{i,j,k}  
+	\left\{         \delta_i  \left[ q^2 \right] \; \overline{\overline U }^{\,i,j+1/2} 
+		      + \delta_j  \left[ q^2 \right] \; \overline{\overline V }^{\,i+1/2,j}      \right\}    &&  \\ 
+%
+&\equiv - \frac{1} {2} \sum\limits_{i,j,k} 	q^2 \;
+	\left\{    \delta_{i+1/2}   \left[   \overline{\overline{ U }}^{\,i,j+1/2}    \right]  
+	         + \delta_{j+1/2}  \left[   \overline{\overline{ V }}^{\,i+1/2,j}     \right]    \right\}    && \\ 
+\end{array} } 		
+%
+\allowdisplaybreaks
+\intertext{ Since $\overline {\;\cdot \;} $ and $\delta $ operators commute: $\delta_{i+1/2} 
+\left[ {\overline a^{\,i}} \right] = \overline {\delta_i \left[ a \right]}^{\,i+1/2}$, 
+and introducing the horizontal divergence $\chi $, it becomes: }
+\allowdisplaybreaks
+%
+& \qquad {\begin{array}{*{20}l} 
+&\equiv \sum\limits_{i,j,k} - \frac{1} {2} q^2 \; \overline{\overline{ e_{1t}\,e_{2t}\,e_{3t}^{}\, \chi}}^{\,i+1/2,j+1/2} 
+\quad \equiv 0 &&
+\end{array} } 		
+\end{flalign*}
+The later equality is obtain only when the flow is horizontally non-divergent, $i.e.$ $\chi$=$0$. 
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Vorticity Term with EEN scheme
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Vorticity Term with EEN scheme (\np{ln\_dynvor\_een}=.true.)}
+\label{Apdx_C_vorEEN} 
+
+With the EEN scheme, the vorticity terms are represented as: 
+\begin{equation} \label{Eq_dynvor_een}
+\left\{ {    \begin{aligned}
+ +q\,e_3 \, v 	&\equiv +\frac{1}{e_{1u} }   \sum_{\substack{i_p,\,k_p}} 
+                         {^{i+1/2-i_p}_j}  \mathbb{Q}^{i_p}_{j_p}  \left( e_{1v} e_{3v} \ v  \right)^{i+i_p-1/2}_{j+j_p}   \\
+ - q\,e_3 \, u     &\equiv -\frac{1}{e_{2v} }    \sum_{\substack{i_p,\,k_p}} 
+                         {^i_{j+1/2-j_p}}  \mathbb{Q}^{i_p}_{j_p}  \left( e_{2u} e_{3u} \ u  \right)^{i+i_p}_{j+j_p-1/2}   \\
+\end{aligned}   } \right.
+\end{equation} 
+where the indices $i_p$ and $k_p$ take the following value: 
+$i_p = -1/2$ or $1/2$ and $j_p = -1/2$ or $1/2$,
+and the vorticity triads, ${^i_j}\mathbb{Q}^{i_p}_{j_p}$, defined at $T$-point, are given by: 
+\begin{equation} \label{Q_triads}
+_i^j \mathbb{Q}^{i_p}_{j_p}
+= \frac{1}{12} \ \left(   q^{i-i_p}_{j+j_p} + q^{i+j_p}_{j+i_p} + q^{i+i_p}_{j-j_p}  \right)
+\end{equation}
+
+
+This formulation does conserve the potential enstrophy for a horizontally non-divergent flow ($i.e.$ $\chi=0$). 
+
+Let consider one of the vorticity triad, for example ${^{i}_j}\mathbb{Q}^{+1/2}_{+1/2} $, 
+similar manipulation can be done for the 3 others. The discrete form of the right hand 
+side of \eqref{Apdx_C_1.1} applied to this triad only can be transformed as follow:
+
+\begin{flalign*} 
+&\int_D {q\,\;{\textbf{k}}\cdot \frac{1} {e_3} \nabla \times \left( {e_3 \, q \;{\textbf{k}}\times {\textbf{U}}_h } \right)\;dv} \\
+%
+\equiv& \sum\limits_{i,j,k} 
+ {q} \    \biggl\{ \;\;
+	\delta_{i+1/2} \left[   -\, {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}  \; U^{i+1/2}_{j}}    \right]  
+      - \delta_{j+1/2} \left[       {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}  \; V^{i}_{j+1/2}}    \right] 
+	\;\;\biggr\}        &&  \\ 
+%
+\equiv& \sum\limits_{i,j,k} 
+	\biggl\{   \delta_i [q] \  {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}  \; U^{i+1/2}_{j}}
+		   + \delta_j [q] \  {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}  \; V^{i}_{j+1/2}}   \biggr\}
+		&& \\ 
+%
+... & &&\\
+&Demonstation \ to \ be \ done... &&\\
+... & &&\\
+%
+\equiv& \frac{1} {2} \sum\limits_{i,j,k}  
+	\biggl\{	\delta_i    \Bigl[    \left(  {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}} \right)^2   \Bigr]\;
+			\overline{\overline {U}}^{\,i,j+1/2} 
+		      + \delta_j 	\Bigl[    \left( {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}} \right)^2     \Bigr]\; 
+			\overline{\overline {V}}^{\,i+1/2,j} 
+	\biggr\} 
+	&&  \\ 
+%
+\equiv& - \frac{1} {2} \sum\limits_{i,j,k} 	\left( {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}} \right)^2\;
+	\biggl\{    \delta_{i+1/2} 
+	      \left[   \overline{\overline {U}}^{\,i,j+1/2}    \right]  
+	            + \delta_{j+1/2}
+		\left[   \overline{\overline {V}}^{\,i+1/2,j}     \right]  
+	\biggr\}    && \\ 
+%
+\equiv& \sum\limits_{i,j,k} - \frac{1} {2} \left( {{^i_j}\mathbb{Q}^{+1/2}_{+1/2}} \right)^2
+                                                            \; \overline{\overline{ b_t^{}\, \chi}}^{\,i+1/2,\,j+1/2}  &&\\
+%
+\ \ \equiv& \ 0     &&\\
+\end{flalign*}
+
+
+
+
+
+% ================================================================
+% Conservation Properties on Tracers
+% ================================================================
+\section{Conservation Properties on Tracers}
+\label{Apdx_C.2}
+
+
+All the numerical schemes used in NEMO are written such that the tracer content 
+is conserved by the internal dynamics and physics (equations in flux form). 
+For advection, only the CEN2 scheme ($i.e.$ $2^{nd}$ order finite different scheme) 
+conserves the global variance of tracer. Nevertheless the other schemes ensure 
+that the global variance decreases ($i.e.$ they are at least slightly diffusive). 
+For diffusion, all the schemes ensure the decrease of the total tracer variance, 
+except the iso-neutral operator. There is generally no strict conservation of mass, 
+as the equation of state is non linear with respect to $T$ and $S$. In practice, 
+the mass is conserved to a very high accuracy. 
+% -------------------------------------------------------------------------------------------------------------
+%       Advection Term
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Advection Term}
+\label{Apdx_C.2.1}
+
+conservation of a tracer, $T$:
+\begin{equation*}
+\frac{\partial }{\partial t} \left(   \int_D {T\;dv}   \right) 
+=  \int_D { \frac{1}{e_3}\frac{\partial \left( e_3 \, T \right)}{\partial t} \;dv }=0
+\end{equation*}
+
+conservation of its variance:
+\begin{flalign*} 
+\frac{\partial }{\partial t} \left( \int_D {\frac{1}{2} T^2\;dv} \right)
+=&  \int_D { \frac{1}{e_3} Q      \frac{\partial \left( e_3 \, T \right) }{\partial t} \;dv }  
+-   \frac{1}{2} \int_D {  T^2 \frac{1}{e_3} \frac{\partial  e_3 }{\partial t} \;dv }
+\end{flalign*}
+
+
+Whatever the advection scheme considered it conserves of the tracer content as all 
+the scheme are written in flux form. Indeed,  let $T$ be the tracer and $\tau_u$, $\tau_v$, 
+and $\tau_w$ its interpolated values at velocity point (whatever the interpolation is), 
+the conservation of the tracer content due to the advection tendency is obtained as follows: 
+\begin{flalign*}
+&\int_D { \frac{1}{e_3}\frac{\partial \left( e_3 \, T \right)}{\partial t} \;dv } = - \int_D \nabla \cdot \left( T \textbf{U} \right)\;dv    &&&\\
+&\equiv - \sum\limits_{i,j,k}    \biggl\{
+	 \frac{1} {b_t}  \left(  \delta_i    \left[   U \;\tau_u   \right]
+	                             + \delta_j    \left[   V  \;\tau_v   \right] \right) 
+	+ \frac{1} {e_{3t}} \delta_k \left[ w\;\tau_w \right]    \biggl\}  b_t   &&&\\
+%
+&\equiv - \sum\limits_{i,j,k}     \left\{
+	    \delta_i  \left[   U \;\tau_u   \right]
+         + \delta_j  \left[   V  \;\tau_v   \right]
+ 	 + \delta_k \left[ W \;\tau_w \right] \right\}   && \\
+&\equiv 0 &&&
+\end{flalign*}
+
+The conservation of the variance of tracer due to the advection tendency 
+can be achieved only with the CEN2 scheme, $i.e.$ when 
+$\tau_u= \overline T^{\,i+1/2}$, $\tau_v= \overline T^{\,j+1/2}$, and $\tau_w= \overline T^{\,k+1/2}$. 
+It can be demonstarted as follows:
+\begin{flalign*}
+&\int_D { \frac{1}{e_3} Q      \frac{\partial \left( e_3 \, T \right) }{\partial t} \;dv }
+= - \int\limits_D \tau\;\nabla \cdot \left( T\; \textbf{U} \right)\;dv &&&\\
+\equiv& - \sum\limits_{i,j,k} T\;
+	\left\{
+	   \delta_i  \left[ U  \overline T^{\,i+1/2}  \right]
+	+ \delta_j  \left[ V  \overline T^{\,j+1/2}  \right]
+	+ \delta_k \left[ W \overline T^{\,k+1/2} \right]          \right\} && \\
+\equiv& + \sum\limits_{i,j,k} 
+	\left\{     U  \overline T^{\,i+1/2} \,\delta_{i+1/2}  \left[ T \right] 
+                 +  V  \overline T^{\,j+1/2} \;\delta_{j+1/2}  \left[ T \right]
+                 +  W \overline T^{\,k+1/2}\;\delta_{k+1/2} \left[ T \right]     \right\}      &&\\
+\equiv&  + \frac{1} {2}  \sum\limits_{i,j,k}
+	\Bigl\{   U  \;\delta_{i+1/2} \left[ T^2 \right]
+                 + V  \;\delta_{j+1/2}  \left[ T^2 \right]
+                 + W \;\delta_{k+1/2} \left[ T^2 \right]   \Bigr\}     && \\ 
+\equiv& - \frac{1} {2}  \sum\limits_{i,j,k} T^2
+	\Bigl\{    \delta_i  \left[ U  \right]
+                  + \delta_j  \left[ V  \right]
+                  + \delta_k \left[ W \right]     \Bigr\}      &&&  \\
+\equiv& + \frac{1} {2}  \sum\limits_{i,j,k} T^2
+	\Bigl\{   \frac{1}{e_{3t}} \frac{\partial e_{3t}\,T }{\partial t}     \Bigr\}      &&& \\
+\end{flalign*}
+which is the discrete form of $ \frac{1}{2} \int_D {  T^2 \frac{1}{e_3} \frac{\partial  e_3 }{\partial t} \;dv }$.
+
+% ================================================================
+% Conservation Properties on Lateral Momentum Physics
+% ================================================================
+\section{Conservation Properties on Lateral Momentum Physics}
+\label{Apdx_dynldf_properties}
+
+
+The discrete formulation of the horizontal diffusion of momentum ensures the 
+conservation of potential vorticity and the horizontal divergence, and the 
+dissipation of the square of these quantities ($i.e.$ enstrophy and the 
+variance of the horizontal divergence) as well as the dissipation of the 
+horizontal kinetic energy. In particular, when the eddy coefficients are 
+horizontally uniform, it ensures a complete separation of vorticity and 
+horizontal divergence fields, so that diffusion (dissipation) of vorticity 
+(enstrophy) does not generate horizontal divergence (variance of the 
+horizontal divergence) and \textit{vice versa}. 
+
+These properties of the horizontal diffusion operator are a direct consequence 
+of properties \eqref{Eq_DOM_curl_grad} and \eqref{Eq_DOM_div_curl}. 
+When the vertical curl of the horizontal diffusion of momentum (discrete sense) 
+is taken, the term associated with the horizontal gradient of the divergence is 
+locally zero. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation of Potential Vorticity
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Conservation of Potential Vorticity}
+\label{Apdx_C.3.1}
+
+The lateral momentum diffusion term conserves the potential vorticity :
+\begin{flalign*}
+&\int \limits_D \frac{1} {e_3 } \textbf{k} \cdot \nabla \times 
+	\Bigl[    \nabla_h  \left( A^{\,lm}\;\chi  \right)
+	        - \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)    \Bigr]\;dv   \\ 
+%\end{flalign*}
+%%%%%%%%%%  recheck here....  (gm)
+%\begin{flalign*}
+=& \int \limits_D  -\frac{1} {e_3 } \textbf{k} \cdot \nabla \times 
+	\Bigl[ \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)  \Bigr]\;dv  \\ 
+%\end{flalign*}
+%\begin{flalign*}
+\equiv& \sum\limits_{i,j}
+	\left\{
+	  \delta_{i+1/2} \left[  \frac {e_{2v}} {e_{1v}\,e_{3v}}  \delta_i \left[ A_f^{\,lm} e_{3f} \zeta  \right]  \right]
+ 	+ \delta_{j+1/2} \left[  \frac {e_{1u}} {e_{2u}\,e_{3u}}  \delta_j \left[ A_f^{\,lm} e_{3f} \zeta  \right]  \right]
+	\right\} 	 \\ 
+%
+\intertext{Using \eqref{DOM_di_adj}, it follows:}
+%
+\equiv& \sum\limits_{i,j,k} 
+	-\,\left\{
+	   \frac{e_{2v}} {e_{1v}\,e_{3v}}  \delta_i	\left[ A_f^{\,lm} e_{3f} \zeta  \right]\;\delta_i \left[ 1\right]
+	 + \frac{e_{1u}} {e_{2u}\,e_{3u}}  \delta_j 	\left[ A_f^{\,lm} e_{3f} \zeta  \right]\;\delta_j \left[ 1\right]
+	\right\} \quad \equiv 0 
+	 \\ 
+\end{flalign*}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Dissipation of Horizontal Kinetic Energy
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Dissipation of Horizontal Kinetic Energy}
+\label{Apdx_C.3.2}
+
+The lateral momentum diffusion term dissipates the horizontal kinetic energy:
+%\begin{flalign*}
+\begin{equation*}
+\begin{split}
+\int_D \textbf{U}_h \cdot 
+	\left[ \nabla_h 		\right.   &     \left.       \left( A^{\,lm}\;\chi \right)      
+	- \nabla_h \times  \left( A^{\,lm}\;\zeta \;\textbf{k} \right)     \right] \; dv    \\
+\\  %%%
+\equiv& \sum\limits_{i,j,k} 
+	\left\{
+	  \frac{1} {e_{1u}}               \delta_{i+1/2} \left[  A_T^{\,lm}          \chi     \right]
+	- \frac{1} {e_{2u}\,e_{3u}}  \delta_j           \left[ A_f^{\,lm} e_{3f} \zeta   \right]
+	\right\} \; e_{1u}\,e_{2u}\,e_{3u} \;u     \\
+&\;\; + 	\left\{
+	   \frac{1} {e_{2u}}             \delta_{j+1/2}	\left[ A_T^{\,lm}          \chi    \right] 
+	+ \frac{1} {e_{1v}\,e_{3v}} \delta_i            \left[ A_f^{\,lm} e_{3f} \zeta  \right] 
+	\right\} \; e_{1v}\,e_{2u}\,e_{3v} \;v     \qquad \\ 
+\\  %%%
+\equiv& \sum\limits_{i,j,k} 
+ 	\Bigl\{
+	  e_{2u}\,e_{3u} \;u\;  \delta_{i+1/2} \left[ A_T^{\,lm}           \chi    \right]
+	- e_{1u}             \;u\;  \delta_j           \left[ A_f^{\,lm} e_{3f} \zeta  \right]
+	 \Bigl\} 
+	 \\ 
+&\;\; + \Bigl\{
+	   e_{1v}\,e_{3v} \;v\;  \delta_{j+1/2}  \left[ A_T^{\,lm}           \chi    \right]
+	+ e_{2v}             \;v\;  \delta_i            \left[ A_f^{\,lm} e_{3f} \zeta  \right]
+	\Bigl\}      \\ 
+\\  %%%
+\equiv& \sum\limits_{i,j,k} 
+	- \Bigl(
+	  \delta_i   \left[  e_{2u}\,e_{3u} \;u  \right]
+	+ \delta_j  \left[  e_{1v}\,e_{3v}  \;v  \right] 
+	     \Bigr) \;  A_T^{\,lm} \chi   \\ 
+&\;\; - \Bigl(
+	  \delta_{i+1/2}  \left[  e_{2v}  \;v  \right]
+	- \delta_{j+1/2}  \left[  e_{1u} \;u  \right] 
+	     \Bigr)\;  A_f^{\,lm} e_{3f} \zeta      \\ 
+\\  %%%
+\equiv& \sum\limits_{i,j,k} 
+	- A_T^{\,lm}  \,\chi^2   \;e_{1t}\,e_{2t}\,e_{3t}
+	- A_f ^{\,lm}  \,\zeta^2 \;e_{1f }\,e_{2f }\,e_{3f}  
+\quad \leq 0       \\
+\end{split}
+\end{equation*}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Dissipation of Enstrophy
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Dissipation of Enstrophy}
+\label{Apdx_C.3.3}
+
+The lateral momentum diffusion term dissipates the enstrophy when the eddy 
+coefficients are horizontally uniform:
+\begin{flalign*}
+&\int\limits_D  \zeta \; \textbf{k} \cdot \nabla \times 
+	\left[   \nabla_h \left( A^{\,lm}\;\chi  \right)
+	       - \nabla_h \times \left( A^{\,lm}\;\zeta \; \textbf{k} \right)   \right]\;dv &&&\\
+&\quad = A^{\,lm} \int \limits_D \zeta \textbf{k} \cdot \nabla \times 
+ 	\left[    \nabla_h \times \left( \zeta \; \textbf{k} \right)   \right]\;dv &&&\\
+&\quad \equiv A^{\,lm} \sum\limits_{i,j,k}  \zeta \;e_{3f} 
+	\left\{     \delta_{i+1/2} \left[  \frac{e_{2v}} {e_{1v}\,e_{3v}} \delta_i \left[ e_{3f} \zeta  \right]   \right]
+	          + \delta_{j+1/2} \left[  \frac{e_{1u}} {e_{2u}\,e_{3u}} \delta_j \left[ e_{3f} \zeta  \right]   \right]      \right\}   &&&\\ 
+%
+\intertext{Using \eqref{DOM_di_adj}, it follows:}
+%
+&\quad \equiv  - A^{\,lm} \sum\limits_{i,j,k} 
+	\left\{    \left(  \frac{1} {e_{1v}\,e_{3v}}  \delta_i \left[ e_{3f} \zeta  \right]  \right)^2   b_v
+	         + \left(  \frac{1} {e_{2u}\,e_{3u}}  \delta_j \left[ e_{3f} \zeta  \right] \right)^2   b_u  \right\}  \quad \leq \;0    &&&\\
+\end{flalign*}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation of Horizontal Divergence
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Conservation of Horizontal Divergence}
+\label{Apdx_C.3.4}
+
+When the horizontal divergence of the horizontal diffusion of momentum 
+(discrete sense) is taken, the term associated with the vertical curl of the 
+vorticity is zero locally, due to \eqref{Eq_DOM_div_curl}. 
+The resulting term conserves the $\chi$ and dissipates $\chi^2$ 
+when the eddy coefficients are horizontally uniform.
+\begin{flalign*}
+& \int\limits_D  \nabla_h \cdot 
+	\Bigl[     \nabla_h \left( A^{\,lm}\;\chi \right)
+	          - \nabla_h \times \left( A^{\,lm}\;\zeta \;\textbf{k} \right)    \Bigr]  dv
+= \int\limits_D  \nabla_h \cdot \nabla_h \left( A^{\,lm}\;\chi  \right)   dv   \\
+%
+&\equiv \sum\limits_{i,j,k} 
+	\left\{   \delta_i \left[ A_u^{\,lm} \frac{e_{2u}\,e_{3u}} {e_{1u}}  \delta_{i+1/2} \left[ \chi \right]  \right]
+	        + \delta_j \left[ A_v^{\,lm} \frac{e_{1v}\,e_{3v}} {e_{2v}}  \delta_{j+1/2} \left[ \chi \right]  \right]    \right\}    \\ 
+%
+\intertext{Using \eqref{DOM_di_adj}, it follows:}
+%
+&\equiv \sum\limits_{i,j,k} 
+	- \left\{   \frac{e_{2u}\,e_{3u}} {e_{1u}}  A_u^{\,lm} \delta_{i+1/2} \left[ \chi \right] \delta_{i+1/2} \left[ 1 \right] 
+	          + \frac{e_{1v}\,e_{3v}} {e_{2v}}  A_v^{\,lm} \delta_{j+1/2} \left[ \chi \right] \delta_{j+1/2} \left[ 1 \right]    \right\} 
+	\quad \equiv 0      \\ 
+\end{flalign*}
+
+% -------------------------------------------------------------------------------------------------------------
+%       Dissipation of Horizontal Divergence Variance
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Dissipation of Horizontal Divergence Variance}
+\label{Apdx_C.3.5}
+
+\begin{flalign*}
+&\int\limits_D \chi \;\nabla_h \cdot 
+	\left[    \nabla_h              \left( A^{\,lm}\;\chi                    \right)
+	        - \nabla_h   \times  \left( A^{\,lm}\;\zeta \;\textbf{k} \right)    \right]\;  dv
+ = A^{\,lm}   \int\limits_D \chi \;\nabla_h \cdot \nabla_h \left( \chi \right)\;  dv    \\ 
+%
+&\equiv A^{\,lm}  \sum\limits_{i,j,k}  \frac{1} {e_{1t}\,e_{2t}\,e_{3t}}  \chi 
+	\left\{
+	   \delta_i  \left[   \frac{e_{2u}\,e_{3u}} {e_{1u}}  \delta_{i+1/2} \left[ \chi \right]   \right]
+	+ \delta_j  \left[   \frac{e_{1v}\,e_{3v}} {e_{2v}}   \delta_{j+1/2} \left[ \chi \right]   \right]
+	\right\} \;   e_{1t}\,e_{2t}\,e_{3t}    \\ 
+%
+\intertext{Using \eqref{DOM_di_adj}, it turns out to be:}
+%
+&\equiv - A^{\,lm} \sum\limits_{i,j,k}
+	\left\{    \left(  \frac{1} {e_{1u}}  \delta_{i+1/2}  \left[ \chi \right]  \right)^2  b_u
+            + \left(  \frac{1} {e_{2v}}  \delta_{j+1/2}  \left[ \chi \right]  \right)^2  b_v    \right\}    
+\quad \leq 0             \\
+\end{flalign*}
+
+% ================================================================
+% Conservation Properties on Vertical Momentum Physics
+% ================================================================
+\section{Conservation Properties on Vertical Momentum Physics}
+\label{Apdx_C_4}
+
+As for the lateral momentum physics, the continuous form of the vertical diffusion 
+of momentum satisfies several integral constraints. The first two are associated 
+with the conservation of momentum and the dissipation of horizontal kinetic energy:
+\begin{align*}
+ \int\limits_D   \frac{1} {e_3 }\; \frac{\partial } {\partial k} 
+       \left(   \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}   \right)\;  dv 
+	\qquad \quad &= \vec{\textbf{0}}    \\
+%
+\intertext{and}
+%
+\int\limits_D 
+	\textbf{U}_h \cdot   \frac{1} {e_3 }\; \frac{\partial } {\partial k}
+	\left(   \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}   \right)\; dv    \quad &\leq 0     \\
+\end{align*}
+
+The first property is obvious. The second results from:
+\begin{flalign*}
+\int\limits_D 
+	\textbf{U}_h \cdot   \frac{1} {e_3 }\; \frac{\partial } {\partial k}
+	\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}   \right)\;dv    &&&\\
+\end{flalign*}
+\begin{flalign*}
+&\equiv \sum\limits_{i,j,k} 
+	\left( 
+	   u\; \delta_k \left[ \frac{A_u^{\,vm}} {e_{3uw}} \delta_{k+1/2}  \left[ u \right]  \right]\;  e_{1u}\,e_{2u} 
+	+ v\; \delta_k \left[ \frac{A_v^{\,vm}} {e_{3vw}} \delta_{k+1/2}   \left[ v \right]  \right]\;  e_{1v}\,e_{2v} \right)   &&&\\ 
+%
+\intertext{since the horizontal scale factor does not depend on $k$, it follows:}
+%
+&\equiv - \sum\limits_{i,j,k} 
+	\left(  \frac{A_u^{\,vm}} {e_{3uw}} \left( \delta_{k+1/2} \left[ u \right] \right)^2\; e_{1u}\,e_{2u} 
+	      + \frac{A_v^{\,vm}} {e_{3vw}}  \left( \delta_{k+1/2} \left[ v \right] \right)^2\; e_{1v}\,e_{2v}  \right)
+\quad \leq 0   &&&\\
+\end{flalign*}
+
+The vorticity is also conserved. Indeed:
+\begin{flalign*}
+\int \limits_D 
+	\frac{1} {e_3 } \textbf{k} \cdot \nabla \times 
+		\left( \frac{1} {e_3 }\; \frac{\partial } {\partial k}  \left( 
+		        \frac{A^{\,vm}} {e_3}\; \frac{\partial \textbf{U}_h } {\partial k}  
+		  \right)  \right)\; dv   &&&\\ 
+\end{flalign*}
+\begin{flalign*}
+\equiv \sum\limits_{i,j,k}  \frac{1} {e_{3f}}\; \frac{1} {e_{1f}\,e_{2f}}
+	\bigg\{    \biggr.   \quad
+	\delta_{i+1/2} 
+		&\left(   \frac{e_{2v}} {e_{3v}} \delta_k  \left[  \frac{1} {e_{3vw}} \delta_{k+1/2} \left[ v \right]  \right]  \right)   &&\\
+	\biggl. 
+	- \delta_{j+1/2} 
+		&\left(   \frac{e_{1u}} {e_{3u}} \delta_k \left[  \frac{1} {e_{3uw}}\delta_{k+1/2} \left[ u \right]  \right]   \right)
+	\biggr\} \;
+	e_{1f}\,e_{2f}\,e_{3f} \; \equiv 0   && \\
+\end{flalign*}
+
+If the vertical diffusion coefficient is uniform over the whole domain, the 
+enstrophy is dissipated, $i.e.$
+\begin{flalign*}
+\int\limits_D \zeta \, \textbf{k} \cdot \nabla \times 
+	\left(   \frac{1} {e_3}\; \frac{\partial } {\partial k}
+		\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}   \right)   \right)\; dv = 0   &&&\\
+\end{flalign*}
+
+This property is only satisfied in $z$-coordinates:
+\begin{flalign*}
+\int\limits_D \zeta \, \textbf{k} \cdot \nabla \times 
+	\left(  \frac{1} {e_3}\; \frac{\partial } {\partial k}
+		\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}  \right)   \right)\; dv   &&& \\ 
+\end{flalign*}
+\begin{flalign*}
+\equiv \sum\limits_{i,j,k} \zeta \;e_{3f} \;
+	\biggl\{ 	\biggr.	\quad
+	\delta_{i+1/2} 
+		&\left(   \frac{e_{2v}} {e_{3v}} \delta_k \left[ \frac{A_v^{\,vm}} {e_{3vw}} \delta_{k+1/2}[v]  \right]   \right)   &&\\
+	- \delta_{j+1/2} 
+		&\biggl.
+		\left(   \frac{e_{1u}} {e_{3u}} \delta_k \left[ \frac{A_u^{\,vm}} {e_{3uw}} \delta_{k+1/2} [u]  \right]    \right) \biggr\}   &&\\ 
+\end{flalign*}
+\begin{flalign*}
+\equiv \sum\limits_{i,j,k} \zeta \;e_{3f} 
+	\biggl\{		\biggr.	\quad
+	\frac{1} {e_{3v}} \delta_k 
+		&\left[ \frac{A_v^{\,vm}} {e_{3vw}} \delta_{k+1/2} \left[ \delta_{i+1/2} \left[ e_{2v}\,v \right] \right]   \right]    &&\\ 
+ 	 \biggl. 
+	- \frac{1} {e_{3u}} \delta_k 
+		&\left[  \frac{A_u^{\,vm}} {e_{3uw}} \delta_{k+1/2} \left[ \delta_{j+1/2} \left[ e_{1u}\,u \right] \right]  \right]  \biggr\}  &&\\ 
+\end{flalign*}
+Using the fact that the vertical diffusion coefficients are uniform, and that in 
+$z$-coordinate, the vertical scale factors do not depend on $i$ and $j$ so 
+that: $e_{3f} =e_{3u} =e_{3v} =e_{3t} $ and $e_{3w} =e_{3uw} =e_{3vw} $, 
+it follows:
+\begin{flalign*}
+\equiv A^{\,vm} \sum\limits_{i,j,k} \zeta \;\delta_k 
+	\left[   \frac{1} {e_{3w}} \delta_{k+1/2} \Bigl[   \delta_{i+1/2} \left[ e_{2v}\,v \right]
+		                          - \delta_{j+1/ 2} \left[ e_{1u}\,u \right]   \Bigr]    \right]    &&&\\
+\end{flalign*}
+\begin{flalign*}
+\equiv - A^{\,vm} \sum\limits_{i,j,k} \frac{1} {e_{3w}}
+	\left( \delta_{k+1/2} \left[ \zeta  \right] \right)^2 \; e_{1f}\,e_{2f}  \; \leq 0    &&&\\
+\end{flalign*}
+Similarly, the horizontal divergence is obviously conserved:
+
+\begin{flalign*}
+\int\limits_D \nabla \cdot 
+\left( \frac{1} {e_3 }\; \frac{\partial } {\partial k}
+		\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k} \right) \right)\; dv = 0    &&&\\
+\end{flalign*}
+and the square of the horizontal divergence decreases ($i.e.$ the horizontal 
+divergence is dissipated) if the vertical diffusion coefficient is uniform over the 
+whole domain:
+
+\begin{flalign*}
+\int\limits_D \chi \;\nabla \cdot 
+\left( \frac{1} {e_3 }\; \frac{\partial } {\partial k}
+		\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k}  \right) \right)\;  dv = 0  &&&\\
+\end{flalign*}
+This property is only satisfied in the $z$-coordinate:
+\begin{flalign*}
+\int\limits_D \chi \;\nabla \cdot 
+\left( \frac{1} {e_3 }\; \frac{\partial } {\partial k}
+		\left( \frac{A^{\,vm}} {e_3 }\; \frac{\partial \textbf{U}_h } {\partial k} \right)  \right)\; dv    &&&\\
+\end{flalign*}
+\begin{flalign*}
+\equiv \sum\limits_{i,j,k} \frac{\chi } {e_{1t}\,e_{2t}}
+	\biggl\{ 	\Biggr.	\quad
+	\delta_{i+1/2} 
+		&\left(   \frac{e_{2u}} {e_{3u}} \delta_k 
+		   	\left[ \frac{A_u^{\,vm}} {e_{3uw}} \delta_{k+1/2} [u] \right] \right)    &&\\ 
+ 	\Biggl. 
+	+ \delta_{j+1/2} 
+		&\left( \frac{e_{1v}} {e_{3v}} \delta_k 
+			\left[ \frac{A_v^{\,vm}} {e_{3vw}} \delta_{k+1/2} [v] \right]   \right)
+	\Biggr\} \;  e_{1t}\,e_{2t}\,e_{3t}   &&\\ 
+\end{flalign*}
+
+\begin{flalign*}
+\equiv A^{\,vm} \sum\limits_{i,j,k}  \chi \,
+	\biggl\{	\biggr.	\quad
+	\delta_{i+1/2}
+		&\left( 
+		   \delta_k \left[ 
+			\frac{1} {e_{3uw}} \delta_{k+1/2} \left[ e_{2u}\,u \right] \right]   \right)    && \\ 
+	\biggl. 
+	+ \delta_{j+1/2} 
+		&\left(    \delta_k \left[ 
+			\frac{1} {e_{3vw}} \delta_{k+1/2} \left[ e_{1v}\,v \right] \right]   \right)   \biggr\}    && \\ 
+\end{flalign*}
+
+\begin{flalign*}
+\equiv -A^{\,vm} \sum\limits_{i,j,k} 
+\frac{\delta_{k+1/2} \left[ \chi \right]} {e_{3w}}\; \biggl\{ 
+	\delta_{k+1/2} \Bigl[
+		   \delta_{i+1/2} \left[ e_{2u}\,u \right]
+		+ \delta_{j+1/2} \left[ e_{1v}\,v \right]  \Bigr]    \biggr\}    &&&\\
+\end{flalign*}
+
+\begin{flalign*}
+\equiv -A^{\,vm} \sum\limits_{i,j,k}
+ \frac{1} {e_{3w}} \delta_{k+1/2} \left[ \chi \right]\; \delta_{k+1/2} \left[ e_{1t}\,e_{2t} \;\chi \right]   &&&\\
+\end{flalign*}
+
+\begin{flalign*}
+\equiv -A^{\,vm} \sum\limits_{i,j,k} 
+\frac{e_{1t}\,e_{2t}} {e_{3w}}\; \left( \delta_{k+1/2} \left[ \chi \right]  \right)^2     \quad  \equiv 0    &&&\\
+\end{flalign*}
+
+% ================================================================
+% Conservation Properties on Tracer Physics
+% ================================================================
+\section{Conservation Properties on Tracer Physics}
+\label{Apdx_C.5}
+
+The numerical schemes used for tracer subgridscale physics are written such 
+that the heat and salt contents are conserved (equations in flux form). 
+Since a flux form is used to compute the temperature and salinity, 
+the quadratic form of these quantities ($i.e.$ their variance) globally tends to diminish. 
+As for the advection term, there is conservation of mass only if the Equation Of Seawater is linear. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation of Tracers
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Conservation of Tracers}
+\label{Apdx_C.5.1}
+
+constraint of conservation of tracers:
+\begin{flalign*}
+&\int\limits_D  \nabla  \cdot \left( A\;\nabla T \right)\;dv  &&&\\ 
+\\
+&\equiv \sum\limits_{i,j,k} 
+	\biggl\{ 	\biggr.
+	\delta_i 
+		\left[ 
+		A_u^{\,lT} \frac{e_{2u}\,e_{3u}} {e_{1u}} \delta_{i+1/2} 
+			\left[ T \right]
+		\right]
+	+ \delta_j 
+		\left[ 
+		A_v^{\,lT} \frac{e_{1v}\,e_{3v}} {e_{2v}} \delta_{j+1/2} 
+			\left[ T \right] 
+		\right]
+	&&\\  & \qquad \qquad \qquad \qquad \qquad \qquad \quad \;\;\;
+	+ \delta_k 
+		\left[ 
+		A_w^{\,vT} \frac{e_{1t}\,e_{2t}} {e_{3t}} \delta_{k+1/2} 
+			\left[ T \right] 
+		\right]
+	\biggr\}   \quad  \equiv 0
+	&&\\ 
+\end{flalign*}
+
+In fact, this property simply results from the flux form of the operator. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       Dissipation of Tracer Variance
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Dissipation of Tracer Variance}
+\label{Apdx_C.5.2}
+
+constraint on the dissipation of tracer variance:
+\begin{flalign*}
+\int\limits_D T\;\nabla & \cdot \left( A\;\nabla T \right)\;dv	&&&\\ 
+&\equiv   \sum\limits_{i,j,k} \; T
+\biggl\{  \biggr.
+     \delta_i \left[ A_u^{\,lT} \frac{e_{2u}\,e_{3u}} {e_{1u}} \delta_{i+1/2} \left[T\right] \right]
+& + \delta_j \left[ A_v^{\,lT} \frac{e_{1v} \,e_{3v}} {e_{2v}} \delta_{j+1/2} \left[T\right] \right] 
+		\quad&& \\ 
+ \biggl. 
+&&+ \delta_k \left[A_w^{\,vT}\frac{e_{1t}\,e_{2t}} {e_{3t}}\delta_{k+1/2}\left[T\right]\right]
+\biggr\} && 
+\end{flalign*}
+\begin{flalign*}
+\equiv - \sum\limits_{i,j,k} 
+	\biggl\{ 	\biggr.	\quad
+	&    A_u^{\,lT} \left( \frac{1} {e_{1u}} \delta_{i+1/2} \left[ T \right]  \right)^2   e_{1u}\,e_{2u}\,e_{3u}    && \\
+	& + A_v^{\,lT} \left( \frac{1} {e_{2v}} \delta_{j+1/2} \left[ T \right]  \right)^2   e_{1v}\,e_{2v}\,e_{3v}     && \\ \biggl. 
+	& + A_w^{\,vT} \left( \frac{1} {e_{3w}} \delta_{k+1/2} \left[ T \right]   \right)^2    e_{1w}\,e_{2w}\,e_{3w}   \biggr\} 
+	\quad      \leq 0      && \\ 
+\end{flalign*}
+
+
+%%%%  end of appendix in gm comment
+%}
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_D.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_D.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_D.tex	(revision 8732)
@@ -0,0 +1,206 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Appendix D Ñ Coding Rules
+% ================================================================
+\chapter{Coding Rules}
+\label{Apdx_D}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+$\ $\newline    % force a new ligne
+
+
+A "model life" is more than ten years. Its software, composed of a few 
+hundred modules, is used by many people who are scientists or students 
+and do not necessarily know every aspect of computing very well. 
+Moreover, a well thought-out program is easier to read and understand, 
+less difficult to modify, produces fewer bugs and is easier to maintain. 
+Therefore, it is essential that the model development follows some rules :
+
+- well planned and designed
+
+- well written
+
+- well documented (both on- and off-line)
+
+- maintainable
+
+- easily portable
+
+- flexible.
+
+To satisfy part of these aims, \NEMO is written with a coding standard which 
+is close to the ECMWF rules, named DOCTOR \citep{Gibson_TR86}. 
+These rules present some advantages like :
+
+- to provide a well presented program
+
+- to use rules for variable names which allow recognition of their type 
+(integer, real, parameter, local or shared variables, etc. ). 
+
+This facilitates both the understanding and the debugging of an algorithm.
+
+% ================================================================
+% The program structure
+% ================================================================
+\section{The program structure}
+\label{Apdx_D_structure}
+
+Each program begins with a set of headline comments containing :
+
+- the program title
+
+- the purpose of the routine
+
+- the method and algorithms used
+
+- the detail of input and output interfaces
+
+- the external routines and functions used (if they exist)
+
+- references (if they exist)
+
+- the author name(s), the date of creation and any updates.
+
+- Each program is split into several well separated sections and 
+sub-sections with an underlined title and specific labelled statements.
+
+- A program has not more than 200 to 300 lines.
+
+A template of a module style can be found on the NEMO depository 
+in the following file : NEMO/OPA\_SRC/module\_example.
+% ================================================================
+% Coding conventions
+% ================================================================
+\section{Coding conventions}
+\label{Apdx_D_coding}
+
+- Use of the universal language \textsc{Fortran} 90, and try to avoid obsolescent
+features like statement functions, do not use GO TO and EQUIVALENCE statements.
+
+- A continuation line begins with the character {\&} indented by three spaces 
+compared to the previous line, while the previous line ended with the character {\&}.
+
+- All the variables must be declared. The code is usually compiled with implicit none.
+ 
+- Never use continuation lines in the declaration of a variable. When searching a 
+variable in the code through a \textit{grep} command, the declaration line will be found.
+
+- In the declaration of a PUBLIC variable, the comment part at the end of the line 
+should start with the two characters "\verb?!:?". the following UNIX command, \\
+\verb?grep var_name *90 \ grep \!: ? \\
+will display the module name and the line where the var\_name declaration is.
+
+- Always use a three spaces indentation in DO loop, CASE, or IF-ELSEIF-ELSE-ENDIF 
+statements.
+
+- use a space after a comma, except when it appears to separate the indices of an array.
+
+- use call to ctl\_stop routine instead of just a STOP.
+
+
+\newpage
+% ================================================================
+% Naming Conventions
+% ================================================================
+\section{Naming Conventions}
+\label{Apdx_D_naming}
+
+The purpose of the naming conventions is to use prefix letters to classify 
+model variables. These conventions allow the variable type to be easily 
+known and rapidly identified. The naming conventions are summarised 
+in the Table below:
+
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]  \label{Tab_VarName}
+\begin{center}
+\begin{tabular}{|p{45pt}|p{35pt}|p{45pt}|p{40pt}|p{40pt}|p{40pt}|p{40pt}|p{40pt}|}
+\hline  Type \par / Status &   integer&   real&   logical &   character  & structure &   double \par precision&   complex \\  
+\hline
+public  \par or  \par module variable& 
+\textbf{m n} \par \textit{but not} \par \textbf{nn\_ np\_}& 
+\textbf{a b e f g h o q r} \par \textbf{t} \textit{to} \textbf{x} \par but not \par \textbf{fs rn\_}& 
+\textbf{l} \par \textit{but not} \par \textbf{lp ld} \par \textbf{ ll ln\_}& 
+\textbf{c} \par \textit{but not} \par \textbf{cp cd} \par \textbf{cl cn\_}& 
+\textbf{s} \par \textit{but not} \par \textbf{sd sd} \par \textbf{sl sn\_}& 
+\textbf{d} \par \textit{but not} \par \textbf{dp dd} \par \textbf{dl dn\_}& 
+\textbf{y} \par \textit{but not} \par \textbf{yp yd} \par \textbf{yl yn} \\
+\hline
+dummy \par argument& 
+\textbf{k} \par \textit{but not} \par \textbf{kf}& 
+\textbf{p} \par \textit{but not} \par \textbf{pp pf}& 
+\textbf{ld}& 
+\textbf{cd}& 
+\textbf{sd}& 
+\textbf{dd}& 
+\textbf{yd} \\
+\hline
+local \par variable& 
+\textbf{i}& 
+\textbf{z}& 
+\textbf{ll}& 
+\textbf{cl}& 
+\textbf{sl}& 
+\textbf{dl}& 
+\textbf{yl} \\
+\hline
+loop \par control& 
+\textbf{j} \par \textit{but not} \par \textbf{jp}& 
+& 
+& 
+&
+& 
+& 
+ \\
+\hline
+parameter& 
+\textbf{jp np\_}& 
+\textbf{pp}& 
+\textbf{lp}& 
+\textbf{cp}& 
+\textbf{sp}& 
+\textbf{dp}& 
+\textbf{yp} \\
+\hline
+
+namelist&
+\textbf{nn\_}& 
+\textbf{rn\_}& 
+\textbf{ln\_}& 
+\textbf{cn\_}& 
+\textbf{sn\_}& 
+\textbf{dn\_}& 
+\textbf{yn\_}
+\\
+\hline
+CPP \par macro& 
+\textbf{kf}& 
+\textbf{fs} \par & 
+& 
+&
+& 
+& 
+ \\
+\hline
+\end{tabular}
+\label{tab1}
+\end{center}
+\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+N.B.   Parameter here, in not only parameter in the \textsc{Fortran} acceptation, it is also used for code variables 
+that are read in namelist and should never been modified during a simulation. 
+It is the case, for example, for the size of a domain (jpi,jpj,jpk).
+
+\newpage
+% ================================================================
+% The program structure
+% ================================================================
+\section{The program structure}
+\label{Apdx_D_structure}
+
+To be done....
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_E.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_E.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_E.tex	(revision 8732)
@@ -0,0 +1,810 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Appendix E : Note on some algorithms
+% ================================================================
+\chapter{Note on some algorithms}
+\label{Apdx_E}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+ 
+ This appendix some on going consideration on algorithms used or planned to be used
+in \NEMO. 
+
+$\ $\newline    % force a new ligne
+
+% -------------------------------------------------------------------------------------------------------------
+%        UBS scheme  
+% -------------------------------------------------------------------------------------------------------------
+\section{Upstream Biased Scheme (UBS) (\np{ln\_traadv\_ubs}=T)}
+\label{TRA_adv_ubs}
+
+The UBS advection scheme is an upstream biased third order scheme based on 
+an upstream-biased parabolic interpolation. It is also known as Cell Averaged 
+QUICK scheme (Quadratic Upstream Interpolation for Convective 
+Kinematics). For example, in the $i$-direction :
+\begin{equation} \label{Eq_tra_adv_ubs2}
+\tau _u^{ubs} = \left\{	 \begin{aligned}
+  & \tau _u^{cen4} + \frac{1}{12} \,\tau"_i	   & \quad \text{if }\ u_{i+1/2} \geqslant 0 \\
+  & \tau _u^{cen4} - \frac{1}{12} \,\tau"_{i+1} & \quad \text{if }\ u_{i+1/2}       <       0
+  						 \end{aligned}    \right.
+\end{equation}
+or equivalently, the advective flux is
+\begin{equation} \label{Eq_tra_adv_ubs2}
+U_{i+1/2} \ \tau _u^{ubs} 
+=U_{i+1/2} \ \overline{ T_i - \frac{1}{6}\,\tau"_i }^{\,i+1/2}
+- \frac{1}{2}\, |U|_{i+1/2} \;\frac{1}{6} \;\delta_{i+1/2}[\tau"_i]
+\end{equation}
+where $U_{i+1/2} = e_{1u}\,e_{3u}\,u_{i+1/2}$ and 
+$\tau "_i =\delta _i \left[ {\delta _{i+1/2} \left[ \tau \right]} \right]$. 
+By choosing this expression for $\tau "$ we consider a fourth order approximation 
+of $\partial_i^2$ with a constant i-grid spacing ($\Delta i=1$). 
+
+Alternative choice: introduce the scale factors:  
+$\tau "_i =\frac{e_{1T}}{e_{2T}\,e_{3T}}\delta _i \left[ \frac{e_{2u} e_{3u} }{e_{1u} }\delta _{i+1/2}[\tau] \right]$.
+
+
+This results in a dissipatively dominant (i.e. hyper-diffusive) truncation 
+error \citep{Shchepetkin_McWilliams_OM05}. The overall performance of the 
+advection scheme is similar to that reported in \cite{Farrow1995}. 
+It is a relatively good compromise between accuracy and smoothness. It is 
+not a \emph{positive} scheme meaning false extrema are permitted but the 
+amplitude of such are significantly reduced over the centred second order 
+method. Nevertheless it is not recommended to apply it to a passive tracer 
+that requires positivity. 
+
+The intrinsic diffusion of UBS makes its use risky in the vertical direction 
+where the control of artificial diapycnal fluxes is of paramount importance. 
+It has therefore been preferred to evaluate the vertical flux using the TVD 
+scheme when \np{ln\_traadv\_ubs}=T.
+
+For stability reasons, in \eqref{Eq_tra_adv_ubs}, the first term which corresponds 
+to a second order centred scheme is evaluated using the \textit{now} velocity 
+(centred in time) while the second term which is the diffusive part of the scheme, 
+is evaluated using the \textit{before} velocity (forward in time. This is discussed 
+by \citet{Webb_al_JAOT98} in the context of the Quick advection scheme. UBS and QUICK 
+schemes only differ by one coefficient. Substituting 1/6 with 1/8 in 
+(\ref{Eq_tra_adv_ubs}) leads to the QUICK advection scheme \citep{Webb_al_JAOT98}. 
+This option is not available through a namelist parameter, since the 1/6 
+coefficient is hard coded. Nevertheless it is quite easy to make the 
+substitution in \mdl{traadv\_ubs} module and obtain a QUICK scheme
+
+NB 1: When a high vertical resolution $O(1m)$ is used, the model stability can 
+be controlled by vertical advection (not vertical diffusion which is usually 
+solved using an implicit scheme). Computer time can be saved by using a 
+time-splitting technique on vertical advection. This possibility have been 
+implemented and validated in ORCA05-L301. It is not currently offered in the 
+current reference version. 
+
+NB 2 : In a forthcoming release four options will be proposed for the 
+vertical component used in the UBS scheme. $\tau _w^{ubs}$ will be 
+evaluated using either \textit{(a)} a centred $2^{nd}$ order scheme , 
+or  \textit{(b)} a TVD scheme, or  \textit{(c)} an interpolation based on conservative 
+parabolic splines following \citet{Shchepetkin_McWilliams_OM05} implementation of UBS in ROMS, 
+or  \textit{(d)} an UBS. The $3^{rd}$ case has dispersion properties similar to an 
+eight-order accurate conventional scheme.
+
+NB 3 : It is straight forward to rewrite \eqref{Eq_tra_adv_ubs} as follows:
+\begin{equation} \label{Eq_tra_adv_ubs2}
+\tau _u^{ubs} = \left\{	 \begin{aligned}
+	& \tau _u^{cen4} + \frac{1}{12} \tau"_i		& \quad \text{if }\ u_{i+1/2} \geqslant 0 \\
+	& \tau _u^{cen4} - \frac{1}{12} \tau"_{i+1}	& \quad \text{if }\ u_{i+1/2}       <       0
+  						 \end{aligned}    \right.
+\end{equation}
+or equivalently 
+\begin{equation} \label{Eq_tra_adv_ubs2}
+\begin{split}
+e_{2u} e_{3u}\,u_{i+1/2} \ \tau _u^{ubs} 
+&= e_{2u} e_{3u}\,u_{i+1/2} \ \overline{ T - \frac{1}{6}\,\tau"_i }^{\,i+1/2} \\
+& - \frac{1}{2} e_{2u} e_{3u}\,|u|_{i+1/2} \;\frac{1}{6} \;\delta_{i+1/2}[\tau"_i]
+\end{split}
+\end{equation}
+\eqref{Eq_tra_adv_ubs2} has several advantages. First it clearly evidence that 
+the UBS scheme is based on the fourth order scheme to which is added an 
+upstream biased diffusive term. Second, this emphasises that the $4^{th}$ order 
+part have to be evaluated at \emph{now} time step, not only the $2^{th}$ order 
+part as stated above using \eqref{Eq_tra_adv_ubs}. Third, the diffusive term is 
+in fact a biharmonic operator with a eddy coefficient with is simply proportional 
+to the velocity.
+
+laplacian diffusion:
+\begin{equation} \label{Eq_tra_ldf_lap}
+\begin{split}
+D_T^{lT} =\frac{1}{e_{1T} \; e_{2T}\;  e_{3T} } &\left[ {\quad \delta _i 
+\left[ {A_u^{lT} \frac{e_{2u} e_{3u} }{e_{1u} }\;\delta _{i+1/2} 
+\left[ T \right]} \right]} \right.
+\\
+&\ \left. {+\; \delta _j \left[ 
+{A_v^{lT} \left( {\frac{e_{1v} e_{3v} }{e_{2v} }\;\delta _{j+1/2} \left[ T 
+\right]} \right)} \right]\quad } \right]
+\end{split}
+\end{equation}
+
+bilaplacian:
+\begin{equation} \label{Eq_tra_ldf_lap}
+\begin{split}
+D_T^{lT} =&-\frac{1}{e_{1T} \; e_{2T}\;  e_{3T}} \\
+& \delta _i \left[  \sqrt{A_u^{lT}}\ \frac{e_{2u}\,e_{3u}}{e_{1u}}\;\delta _{i+1/2} 
+		  \left[ \frac{1}{e_{1T}\,e_{2T}\, e_{3T}}
+    \delta _i \left[ \sqrt{A_u^{lT}}\ \frac{e_{2u}\,e_{3u}}{e_{1u}}\;\delta _{i+1/2} 
+    		  [T] \right] \right] \right]
+\end{split}
+\end{equation}
+with ${A_u^{lT}}^2 = \frac{1}{12} {e_{1u}}^3\ |u|$, 
+$i.e.$ $A_u^{lT} = \frac{1}{\sqrt{12}} \,e_{1u}\ \sqrt{ e_{1u}\,|u|\,}$
+it comes :
+\begin{equation} \label{Eq_tra_ldf_lap}
+\begin{split}
+D_T^{lT} =&-\frac{1}{12}\,\frac{1}{e_{1T} \; e_{2T}\;  e_{3T}} \\
+& \delta _i \left[ e_{2u}\,e_{3u}\,\sqrt{ e_{1u}\,|u|\,}\;\delta _{i+1/2} 
+		 \left[ \frac{1}{e_{1T}\,e_{2T}\, e_{3T}} 
+    \delta _i \left[ e_{2u}\,e_{3u}\,\sqrt{ e_{1u}\,|u|\,}\;\delta _{i+1/2} 
+    		[T] \right] \right] \right]
+\end{split}
+\end{equation}
+if the velocity is uniform ($i.e.$ $|u|=cst$) then the diffusive flux is
+\begin{equation} \label{Eq_tra_ldf_lap}
+\begin{split}
+F_u^{lT} = - \frac{1}{12}
+ e_{2u}\,e_{3u}\,|u| \;\sqrt{ e_{1u}}\,\delta _{i+1/2} 
+		 \left[ \frac{1}{e_{1T}\,e_{2T}\, e_{3T}} 
+    \delta _i \left[ e_{2u}\,e_{3u}\,\sqrt{ e_{1u}}\:\delta _{i+1/2} 
+    		[T] \right] \right]
+\end{split}
+\end{equation}
+beurk....  reverte the logic: starting from the diffusive part of the advective flux it comes:
+
+\begin{equation} \label{Eq_tra_adv_ubs2}
+\begin{split}
+F_u^{lT}
+&= - \frac{1}{2} e_{2u} e_{3u}\,|u|_{i+1/2} \;\frac{1}{6} \;\delta_{i+1/2}[\tau"_i]
+\end{split}
+\end{equation}
+if the velocity is uniform ($i.e.$ $|u|=cst$) and choosing $\tau "_i =\frac{e_{1T}}{e_{2T}\,e_{3T}}\delta _i \left[ \frac{e_{2u} e_{3u} }{e_{1u} } \delta _{i+1/2}[\tau] \right]$
+
+sol 1 coefficient at T-point ( add $e_{1u}$ and $e_{1T}$ on both side of first $\delta$):
+\begin{equation} \label{Eq_tra_adv_ubs2}
+\begin{split}
+F_u^{lT}
+&= - \frac{1}{12} \frac{e_{2u} e_{3u}}{e_{1u}}\;\delta_{i+1/2}\left[ \frac{e_{1T}^3\,|u|}{e_{1T}e_{2T}\,e_{3T}}\,\delta _i \left[ \frac{e_{2u} e_{3u} }{e_{1u} } \delta _{i+1/2}[\tau] \right] \right]
+\end{split}
+\end{equation}
+which leads to ${A_T^{lT}}^2 = \frac{1}{12} {e_{1T}}^3\ \overline{|u|}^{\,i+1/2}$
+
+sol 2 coefficient at u-point: split $|u|$ into $\sqrt{|u|}$ and $e_{1T}$ into $\sqrt{e_{1u}}$
+\begin{equation} \label{Eq_tra_adv_ubs2}
+\begin{split}
+F_u^{lT}
+&= - \frac{1}{12} {e_{1u}}^1 \sqrt{e_{1u}|u|} \frac{e_{2u} e_{3u}}{e_{1u}}\;\delta_{i+1/2}\left[ \frac{1}{e_{2T}\,e_{3T}}\,\delta _i \left[ \sqrt{e_{1u}|u|} \frac{e_{2u} e_{3u} }{e_{1u} } \delta _{i+1/2}[\tau] \right] \right] \\
+&= - \frac{1}{12} e_{1u} \sqrt{e_{1u}|u|\,} \frac{e_{2u} e_{3u}}{e_{1u}}\;\delta_{i+1/2}\left[ \frac{1}{e_{1T}\,e_{2T}\,e_{3T}}\,\delta _i \left[ e_{1u} \sqrt{e_{1u}|u|\,} \frac{e_{2u} e_{3u} }{e_{1u}} \delta _{i+1/2}[\tau] \right] \right]
+\end{split}
+\end{equation}
+which leads to ${A_u^{lT}} = \frac{1}{12} {e_{1u}}^3\ |u|$
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Leap-Frog energetic  
+% -------------------------------------------------------------------------------------------------------------
+\section{Leap-Frog energetic }
+\label{LF}
+
+We adopt the following semi-discrete notation for time derivative. Given the values of a variable $q$ at successive time step, the time derivation and averaging operators at the mid time step are:
+\begin{subequations} \label{dt_mt}
+\begin{align}
+ \delta _{t+\rdt/2} [q]     &=  \  \ \,   q^{t+\rdt}  - q^{t}		\\
+ \overline q^{\,t+\rdt/2} &= \left\{ q^{t+\rdt} + q^{t} \right\} \; / \; 2
+\end{align}
+\end{subequations}
+As for space operator, the adjoint of the derivation and averaging time operators are 
+$\delta_t^*=\delta_{t+\rdt/2}$ and $\overline{\cdot}^{\,t\,*}= \overline{\cdot}^{\,t+\Delta/2}$
+, respectively. 
+
+The Leap-frog time stepping given by \eqref{Eq_DOM_nxt} can be defined as:
+\begin{equation} \label{LF}
+   \frac{\partial q}{\partial t} 
+   		\equiv \frac{1}{\rdt} \overline{ \delta _{t+\rdt/2}[q]}^{\,t} 
+		=         \frac{q^{t+\rdt}-q^{t-\rdt}}{2\rdt}
+\end{equation} 
+Note that \eqref{LF} shows that the leapfrog time step is $\rdt$, not $2\rdt$ 
+as it can be found sometime in literature. 
+The leap-Frog time stepping is a second order centered scheme. As such it respects 
+the quadratic invariant in integral forms, $i.e.$ the following continuous property,
+\begin{equation} \label{Energy}
+\int_{t_0}^{t_1} {q\, \frac{\partial q}{\partial t} \;dt} 
+	=\int_{t_0}^{t_1} {\frac{1}{2}\, \frac{\partial q^2}{\partial t} \;dt} 
+	=  \frac{1}{2} \left( {q_{t_1}}^2 - {q_{t_0}}^2 \right) ,
+\end{equation}
+is satisfied in discrete form. Indeed, 
+\begin{equation} \begin{split}
+\int_{t_0}^{t_1} {q\, \frac{\partial q}{\partial t} \;dt} 
+	&\equiv \sum\limits_{0}^{N} 
+			{\frac{1}{\rdt} q^t \ \overline{ \delta _{t+\rdt/2}[q]}^{\,t} \ \rdt} 
+	   \equiv \sum\limits_{0}^{N}  { q^t \ \overline{ \delta _{t+\rdt/2}[q]}^{\,t} } \\
+	&\equiv \sum\limits_{0}^{N}  { \overline{q}^{\,t+\Delta/2}{ \delta _{t+\rdt/2}[q]}}
+	   \equiv \sum\limits_{0}^{N}  { \frac{1}{2} \delta _{t+\rdt/2}[q^2] }\\
+	&\equiv \sum\limits_{0}^{N}  { \frac{1}{2} \delta _{t+\rdt/2}[q^2] }
+	   \equiv \frac{1}{2} \left( {q_{t_1}}^2 - {q_{t_0}}^2 \right)
+\end{split} \end{equation}
+NB here pb of boundary condition when applying the adjoin! In space, setting to 0 
+the quantity in land area is sufficient to get rid of the boundary condition 
+(equivalently of the boundary value of the integration by part). In time this boundary 
+condition is not physical and \textbf{add something here!!!}
+
+
+
+
+
+
+% ================================================================
+% Iso-neutral diffusion : 
+% ================================================================
+
+\section{Lateral diffusion operator}
+
+% ================================================================
+% Griffies' iso-neutral diffusion operator : 
+% ================================================================
+\subsection{Griffies' iso-neutral diffusion operator}
+
+Let try to define a scheme that get its inspiration from the \citet{Griffies_al_JPO98}
+scheme, but is formulated within the \NEMO framework ($i.e.$ using scale 
+factors rather than grid-size and having a position of $T$-points that is not 
+necessary in the middle of vertical velocity points, see Fig.~\ref{Fig_zgr_e3}).
+
+In the formulation \eqref{Eq_tra_ldf_iso} introduced in 1995 in OPA, the ancestor of \NEMO, 
+the off-diagonal terms of the small angle diffusion tensor contain several double 
+spatial averages of a gradient, for example $\overline{\overline{\delta_k \cdot}}^{\,i,k}$. 
+It is apparent that the combination of a $k$ average and a $k$ derivative of the tracer 
+allows for the presence of grid point oscillation structures that will be invisible 
+to the operator. These structures are \textit{computational modes}. They
+will not be damped by the iso-neutral operator, and even possibly amplified by it. 
+In other word, the operator applied to a tracer does not warranties the decrease of 
+its global average variance. To circumvent this, we have introduced a smoothing of 
+the slopes of the iso-neutral surfaces (see \S\ref{LDF}). Nevertheless, this technique 
+works fine for $T$ and $S$ as they are active tracers ($i.e.$ they enter the computation 
+of density), but it does not work for a passive tracer.   \citep{Griffies_al_JPO98} introduce 
+a different way to discretise the off-diagonal terms that nicely solve the problem. 
+The idea is to get rid of combinations of an averaged in one direction combined 
+with a derivative in the same direction by considering triads. For example in the 
+(\textbf{i},\textbf{k}) plane, the four triads are defined at the $(i,k)$ $T$-point as follows:
+\begin{equation} \label{Gf_triads}
+_i^k \mathbb{T}_{i_p}^{k_p} (T)
+= \frac{1}{4} \ {b_u}_{\,i+i_p}^{\,k}  \  A_i^k  	\left(  
+                                                     \frac{ \delta_{i + i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} } 
+-\ {_i^k \mathbb{R}_{i_p}^{k_p}} \ \frac{ \delta_{k+k_p} [T^i] }{ {e_{3w}}_{\,i}^{\,k+k_p} } 
+									  \right)
+\end{equation}
+where the indices $i_p$ and $k_p$ define the four triads and take the following value: 
+$i_p = -1/2$ or $1/2$ and $k_p = -1/2$ or $1/2$, 
+$b_u= e_{1u}\,e_{2u}\,e_{3u}$ is the volume of $u$-cells, 
+$A_i^k$ is the lateral eddy diffusivity coefficient defined at $T$-point,
+and $_i^k \mathbb{R}_{i_p}^{k_p}$ is the slope associated with each triad :
+\begin{equation} \label{Gf_slopes}
+_i^k \mathbb{R}_{i_p}^{k_p} 
+=\frac{ {e_{3w}}_{\,i}^{\,k+k_p}} { {e_{1u}}_{\,i+i_p}^{\,k}} \ \frac 
+{\left(\alpha / \beta \right)_i^k  \ \delta_{i + i_p}[T^k] - \delta_{i + i_p}[S^k] }
+{\left(\alpha / \beta \right)_i^k  \ \delta_{k+k_p}[T^i ] - \delta_{k+k_p}[S^i ] }
+\end{equation}
+Note that in \eqref{Gf_slopes} we use the ratio $\alpha / \beta$ instead of 
+multiplying the temperature derivative by $\alpha$ and the salinity derivative 
+by $\beta$. This is more efficient as the ratio $\alpha / \beta$ can to be 
+evaluated directly.
+
+Note that in \eqref{Gf_triads}, we chose to use ${b_u}_{\,i+i_p}^{\,k}$ instead of 
+${b_{uw}}_{\,i+i_p}^{\,k+k_p}$. This choice has been motivated by the decrease 
+of tracer variance and the presence of partial cell at the ocean bottom 
+(see Appendix~\ref{Apdx_Gf_operator}).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht] \label{Fig_ISO_triad}
+\begin{center}
+\includegraphics[width=0.70\textwidth]{Fig_ISO_triad}
+\caption{  \label{Fig_ISO_triad}   
+Triads used in the Griffies's like iso-neutral diffision scheme for 
+$u$-component (upper panel) and $w$-component (lower panel).}
+\end{center}
+\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The four iso-neutral fluxes associated with the triads are defined at $T$-point. 
+They take the following expression :
+\begin{flalign} \label{Gf_fluxes}
+\begin{split}
+{_i^k {\mathbb{F}_u}_{i_p}^{k_p} } (T) 
+   &= \ \; \qquad  \quad    { _i^k \mathbb{T}_{i_p}^{k_p} }(T) \;\ / \ { {e_{1u}}_{\,i+i_p}^{\,k}}    \\
+{_i^k {\mathbb{F}_w}_{i_p}^{k_p} } (T)
+   &=  -\; { _i^k \mathbb{R}_{i_p}^{k_p} }
+				 \ \; { _i^k \mathbb{T}_{i_p}^{k_p} }(T) \;\ / \ { {e_{3w}}_{\,i}^{\,k+k_p}}
+\end{split}
+\end{flalign}
+
+The resulting iso-neutral fluxes at $u$- and $w$-points are then given by the 
+sum of the fluxes that cross the $u$- and $w$-face (Fig.~\ref{Fig_ISO_triad}):
+\begin{flalign} \label{Eq_iso_flux} 
+\textbf{F}_{iso}(T) 
+&\equiv  \sum_{\substack{i_p,\,k_p}} 
+   \begin{pmatrix} 
+      {_{i+1/2-i_p}^k {\mathbb{F}_u}_{i_p}^{k_p} } (T)      \\
+      \\
+      {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p} } (T)      \\   
+   \end{pmatrix}    \notag \\
+&  \notag \\
+&\equiv  \sum_{\substack{i_p,\,k_p}} 
+   \begin{pmatrix} 
+      && { _{i+1/2-i_p}^k \mathbb{T}_{i_p}^{k_p} }(T) \;\ / \ { {e_{1u}}_{\,i+1/2}^{\,k} }    \\
+      \\
+      & -\; { _i^{k+1/2-k_p} \mathbb{R}_{i_p}^{k_p} }
+        & {_i^{k+1/2-k_p} \mathbb{T}_{i_p}^{k_p} }(T) \;\ / \ { {e_{3w}}_{\,i}^{\,k+1/2} }   \\   
+   \end{pmatrix}      % \\
+% &\\
+% &\equiv  \sum_{\substack{i_p,\,k_p}} 
+%    \begin{pmatrix} 
+%       \qquad  \qquad  \qquad 
+%       \frac{1}{ {e_{1u}}_{\,i+1/2}^{\,k} }  \ \;  
+%        { _{i+1/2-i_p}^k \mathbb{T}_{i_p}^{k_p} }(T)\\
+%       \\
+%       -\frac{1}{ {e_{3w}}_{\,i}^{\,k+1/2} }  \ \; 
+%        { _i^{k+1/2-k_p} \mathbb{R}_{i_p}^{k_p} } \ \;  
+%                  {_i^{k+1/2-k_p} \mathbb{T}_{i_p}^{k_p} }(T)\\   
+%    \end{pmatrix}      
+\end{flalign}
+resulting in a iso-neutral diffusion tendency on temperature given by the divergence 
+of the sum of all the four triad fluxes :
+\begin{equation} \label{Gf_operator}
+D_l^T = \frac{1}{b_T}  \sum_{\substack{i_p,\,k_p}} \left\{  
+		 \delta_{i} \left[{_{i+1/2-i_p}^k {\mathbb{F}_u }_{i_p}^{k_p}} \right] 
+	     + \delta_{k} \left[ {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p}} \right]   \right\}
+\end{equation}
+where $b_T= e_{1T}\,e_{2T}\,e_{3T}$ is the volume of $T$-cells. 
+
+This expression of the iso-neutral diffusion has been chosen in order to satisfy 
+the following six properties:
+\begin{description}
+\item[$\bullet$ horizontal diffusion] The discretization of the diffusion operator 
+recovers the traditional five-point Laplacian in the limit of flat iso-neutral direction :
+\begin{equation} \label{Gf_property1a}
+D_l^T = \frac{1}{b_T}  \ \delta_{i} 
+	\left[ \frac{e_{2u}\,e_{3u}}{e_{1u}} \; \overline{A}^{\,i} \; \delta_{i+1/2}[T] \right] 
+\qquad  \text{when} \quad 
+	{ _i^k \mathbb{R}_{i_p}^{k_p} }=0
+\end{equation}
+
+\item[$\bullet$ implicit treatment in the vertical]  In the diagonal term associated 
+with the vertical divergence of the iso-neutral fluxes (i.e. the term associated 
+with a second order vertical derivative) appears only tracer values associated 
+with a single water column. This is of paramount importance since it means
+that the implicit in time algorithm for solving the vertical diffusion equation can 
+be used to evaluate this term. It is a necessity since the vertical eddy diffusivity 
+associated with this term,  
+\begin{equation}
+	 \sum_{\substack{i_p, \,k_p}} \left\{  
+		A_i^k \; \left(_i^k \mathbb{R}_{i_p}^{k_p}\right)^2
+	\right\} 
+\end{equation}
+can be quite large.
+
+\item[$\bullet$ pure iso-neutral operator]  The iso-neutral flux of locally referenced 
+potential density is zero, $i.e.$
+\begin{align} \label{Gf_property2}
+\begin{matrix}
+&{_i^k {\mathbb{F}_u}_{i_p}^{k_p} (\rho)} 
+	&=    &\alpha_i^k   &{_i^k {\mathbb{F}_u}_{i_p}^{k_p} } (T) 
+	&- \ \;  \beta _i^k    &{_i^k {\mathbb{F}_u}_{i_p}^{k_p} } (S) & = \ 0   \\
+&{_i^k {\mathbb{F}_w}_{i_p}^{k_p} (\rho)} 
+	&=    &\alpha_i^k   &{_i^k {\mathbb{F}_w}_{i_p}^{k_p} } (T) 
+	&- \  \; \beta _i^k    &{_i^k {\mathbb{F}_w}_{i_p}^{k_p} } (S)  &= \ 0
+\end{matrix}
+\end{align}
+This result is trivially obtained using the \eqref{Gf_triads} applied to $T$ and $S$ 
+and the definition of the triads' slopes \eqref{Gf_slopes}.
+
+\item[$\bullet$ conservation of tracer] The iso-neutral diffusion term conserve the 
+total tracer content, $i.e.$
+\begin{equation} \label{Gf_property1}
+\sum_{i,j,k} \left\{ D_l^T \ b_T \right\} = 0
+\end{equation}
+This property is trivially satisfied since the iso-neutral diffusive operator 
+is written in flux form.
+
+\item[$\bullet$ decrease of tracer variance] The iso-neutral diffusion term does 
+not increase the total tracer variance, $i.e.$
+\begin{equation} \label{Gf_property1}
+\sum_{i,j,k} \left\{ T \ D_l^T \ b_T \right\} \leq 0
+\end{equation}
+The property is demonstrated in the Appendix~\ref{Apdx_Gf_operator}. It is a 
+key property for a diffusion term. It means that the operator is also a dissipation 
+term, $i.e.$ it is a sink term for the square of the quantity on which it is applied. 
+It therfore ensure that, when the diffusivity coefficient is large enough, the field 
+on which it is applied become free of grid-point noise.
+
+\item[$\bullet$ self-adjoint operator] The iso-neutral diffusion operator is self-adjoint, 
+$i.e.$
+\begin{equation} \label{Gf_property1}
+\sum_{i,j,k} \left\{ S \ D_l^T \ b_T \right\} = \sum_{i,j,k} \left\{ D_l^S \ T \ b_T \right\} 
+\end{equation}
+In other word, there is no needs to develop a specific routine from the adjoint of this 
+operator. We just have to apply the same routine. This properties can be demonstrated 
+quite easily in a similar way the "non increase of tracer variance" property has been 
+proved (see Appendix~\ref{Apdx_Gf_operator}).
+\end{description}
+
+
+$\ $\newline      %force an empty line
+% ================================================================
+% Skew flux formulation for Eddy Induced Velocity : 
+% ================================================================
+\subsection{ Eddy induced velocity and Skew flux formulation}
+
+When Gent and McWilliams [1990] diffusion is used (\key{traldf\_eiv} defined), 
+an additional advection term is added. The associated velocity is the so called 
+eddy induced velocity, the formulation of which depends on the slopes of iso-
+neutral surfaces. Contrary to the case of iso-neutral mixing, the slopes used 
+here are referenced to the geopotential surfaces, $i.e.$ \eqref{Eq_ldfslp_geo} 
+is used in $z$-coordinate, and the sum \eqref{Eq_ldfslp_geo}
++ \eqref{Eq_ldfslp_iso} in $z^*$ or $s$-coordinates. 
+
+The eddy induced velocity is given by: 
+\begin{equation} \label{Eq_eiv_v}
+\begin{split}
+ u^* & = - \frac{1}{e_2\,e_{3}}          \;\partial_k \left( e_2 \, A_e \; r_i  \right)   
+          = - \frac{1}{e_3}                     \;\partial_k \left(           A_e \; r_i  \right)            \\
+ v^* & = - \frac{1}{e_1\,e_3}\;             \partial_k \left( e_1 \, A_e \; r_j  \right)   
+          = - \frac{1}{e_3}                     \;\partial_k \left(           A_e \; r_j  \right)             \\
+w^* & =    \frac{1}{e_1\,e_2}\; \left\{   \partial_i  \left( e_2 \, A_e \; r_i  \right) 
+					              + \partial_j  \left( e_1 \, A_e \;r_j   \right) \right\}   \\
+\end{split}
+\end{equation}
+where $A_{e}$ is the eddy induced velocity coefficient, and $r_i$ and $r_j$ the 
+slopes between the iso-neutral and the geopotential surfaces.
+%%gm wrong: to be modified with 2 2D streamfunctions
+ In other words,
+the eddy induced velocity can be derived from a vector streamfuntion, $\phi$, which
+is given by $\phi = A_e\,\textbf{r}$ as $\textbf{U}^*  = \textbf{k} \times \nabla \phi$
+%%end gm
+
+A traditional way to implement this additional advection is to add it to the eulerian 
+velocity prior to compute the tracer advection. This allows us to take advantage of 
+all the advection schemes offered for the tracers (see \S\ref{TRA_adv}) and not just 
+a $2^{nd}$ order advection scheme. This is particularly useful for passive tracers 
+where \emph{positivity} of the advection scheme is of paramount importance. 
+% give here the expression using the triads. It is different from the one given in \eqref{Eq_ldfeiv}
+% see just below a copy of this equation:
+%\begin{equation} \label{Eq_ldfeiv}
+%\begin{split}
+% u^* & = \frac{1}{e_{2u}e_{3u}}\; \delta_k \left[e_{2u} \, A_{uw}^{eiv} \; \overline{r_{1w}}^{\,i+1/2} \right]\\
+% v^* & = \frac{1}{e_{1u}e_{3v}}\; \delta_k \left[e_{1v} \, A_{vw}^{eiv} \; \overline{r_{2w}}^{\,j+1/2} \right]\\
+%w^* & = \frac{1}{e_{1w}e_{2w}}\; \left\{ \delta_i \left[e_{2u} \, A_{uw}^{eiv} \; \overline{r_{1w}}^{\,i+1/2} \right] + %\delta_j \left[e_{1v} \, A_{vw}^{eiv} \; \overline{r_{2w}}^{\,j+1/2} \right] \right\} \\
+%\end{split}
+%\end{equation}
+\begin{equation} \label{Eq_eiv_vd}  
+\textbf{F}_{eiv}^T   \equiv   \left( \begin{aligned}                                
+ \sum_{\substack{i_p,\,k_p}} &
+ +{e_{2u}}_{i+1/2-i_p}^{k}                                  \ \ {A_{e}}_{i+1/2-i_p}^{k} 
+\ \ \ { _{i+1/2-i_p}^k \mathbb{R}_{i_p}^{k_p} }    \ \ \delta_{k+k_p}[T_{i+1/2-i_p}]      \\
+    \\
+ \sum_{\substack{i_p,\,k_p}} &
+ - {e_{2u}}_i^{k+1/2-k_p}                                      \ {A_{e}}_i^{k+1/2-k_p} 
+\ \ { _i^{k+1/2-k_p} \mathbb{R}_{i_p}^{k_p} }    \ \delta_{i+i_p}[T^{k+1/2-k_p}]    \\   
+\end{aligned}   \right)
+\end{equation}
+
+\ref{Griffies_JPO98} introduces another way to implement the eddy induced advection, 
+the so-called skew form. It is based on a transformation of the advective fluxes 
+using the non-divergent nature of the eddy induced velocity. 
+For example in the (\textbf{i},\textbf{k}) plane, the tracer advective fluxes can be 
+transformed as follows:
+\begin{flalign*}
+\begin{split}
+\textbf{F}_{eiv}^T = 
+\begin{pmatrix} 
+ 	        {e_{2}\,e_{3}\;  u^*} 	 	\\
+ 		{e_{1}\,e_{2}\; w^*}	 \\
+\end{pmatrix}   \;   T
+&=
+\begin{pmatrix} 
+ 	        { - \partial_k \left( e_{2} \, A_{e} \; r_i \right) \; T \;} 	 	\\
+ 		{+ \partial_i  \left( e_{2} \, A_{e} \; r_i \right) \; T \;}	 \\
+\end{pmatrix} 			\\
+&=			
+\begin{pmatrix} 
+ 	        { - \partial_k \left( e_{2} \, A_{e} \; r_i  \; T \right) \;}  \\
+ 		{+ \partial_i  \left( e_{2} \, A_{e} \; r_i  \; T \right) \;}	 \\
+\end{pmatrix} 			
+ + 
+\begin{pmatrix} 
+ 	        {+ e_{2} \, A_{e} \; r_i  \; \partial_k T}  \\
+ 		{ - e_{2} \, A_{e} \; r_i  \; \partial_i  T}	 \\
+\end{pmatrix} 	 
+\end{split}
+\end{flalign*}
+and since the eddy induces velocity field is no-divergent, we end up with the skew 
+form of the eddy induced advective fluxes:
+\begin{equation} \label{Eq_eiv_skew_continuous}
+\textbf{F}_{eiv}^T = \begin{pmatrix} 
+ 	        {+ e_{2} \, A_{e} \; r_i  \; \partial_k T}   \\
+ 		{ - e_{2} \, A_{e} \; r_i  \; \partial_i  T}	 \\
+                                 \end{pmatrix}
+\end{equation}
+The tendency associated with eddy induced velocity is then simply the divergence 
+of the \eqref{Eq_eiv_skew_continuous} fluxes. It naturally conserves the tracer 
+content, as it is expressed in flux form and, as the advective form, it preserve the 
+tracer variance. Another interesting property of \eqref{Eq_eiv_skew_continuous} 
+form is that when $A=A_e$, a simplification occurs in the sum of the iso-neutral 
+diffusion and eddy induced velocity terms:
+\begin{flalign} \label{Eq_eiv_skew+eiv_continuous}
+\textbf{F}_{iso}^T + \textbf{F}_{eiv}^T &= 
+\begin{pmatrix} 
+ 	        + \frac{e_2\,e_3\,}{e_1} A \;\partial_i T -  e_2 \, A \; r_i                              \;\partial_k T   \\
+ 		-  e_2 \, A_{e} \; r_i           \;\partial_i T + \frac{e_1\,e_2}{e_3} \, A \; r_i^2 \;\partial_k T   \\
+\end{pmatrix}
++
+\begin{pmatrix} 
+ 	        {+ e_{2} \, A_{e} \; r_i  \; \partial_k T}   \\
+ 		{ - e_{2} \, A_{e} \; r_i  \; \partial_i  T}	 \\
+\end{pmatrix}      \\
+&= \begin{pmatrix} 
+ 	        + \frac{e_2\,e_3\,}{e_1} A \;\partial_i T    \\
+ 		-  2\; e_2 \, A_{e} \; r_i      \;\partial_i T + \frac{e_1\,e_2}{e_3} \, A \; r_i^2 \;\partial_k T   \\
+\end{pmatrix}
+\end{flalign}
+The horizontal component reduces to the one use for an horizontal laplacian 
+operator and the vertical one keep the same complexity, but not more. This property
+has been used to reduce the computational time \citep{Griffies_JPO98}, but it is 
+not of practical use as usually $A \neq A_e$. Nevertheless this property can be used to 
+choose a discret form of  \eqref{Eq_eiv_skew_continuous} which is consistent with the 
+iso-neutral operator \eqref{Gf_operator}. Using the slopes \eqref{Gf_slopes} 
+and defining $A_e$ at $T$-point($i.e.$ as $A$, the eddy diffusivity coefficient),
+the resulting discret form is given by:
+\begin{equation} \label{Eq_eiv_skew}  
+\textbf{F}_{eiv}^T   \equiv   \frac{1}{4} \left( \begin{aligned}                                
+ \sum_{\substack{i_p,\,k_p}} &
+ +{e_{2u}}_{i+1/2-i_p}^{k}                                  \ \ {A_{e}}_{i+1/2-i_p}^{k} 
+\ \ \ { _{i+1/2-i_p}^k \mathbb{R}_{i_p}^{k_p} }    \ \ \delta_{k+k_p}[T_{i+1/2-i_p}]      \\
+    \\
+ \sum_{\substack{i_p,\,k_p}} &
+ - {e_{2u}}_i^{k+1/2-k_p}                                      \ {A_{e}}_i^{k+1/2-k_p} 
+\ \ { _i^{k+1/2-k_p} \mathbb{R}_{i_p}^{k_p} }    \ \delta_{i+i_p}[T^{k+1/2-k_p}]    \\   
+\end{aligned}   \right)
+\end{equation}
+Note that \eqref{Eq_eiv_skew} is valid in $z$-coordinate with or without partial cells. 
+In $z^*$ or $s$-coordinate, the slope between the level and the geopotential surfaces 
+must be added to $\mathbb{R}$ for the discret form to be exact. 
+
+Such a choice of discretisation is consistent with the iso-neutral operator as it uses the 
+same definition for the slopes. It also ensures the conservation of the tracer variance 
+(see Appendix \ref{Apdx_eiv_skew}), $i.e.$ it does not include a diffusive component 
+but is a "pure" advection term.
+
+
+
+
+$\ $\newpage      %force an empty line
+% ================================================================
+% Discrete Invariants of the iso-neutral diffrusion 
+% ================================================================
+\subsection{Discrete Invariants of the iso-neutral diffrusion}
+\label{Apdx_Gf_operator}
+
+Demonstration of the decrease of the tracer variance in the (\textbf{i},\textbf{j}) plane. 
+
+This part will be moved in an Appendix.
+
+The continuous property to be demonstrated is :
+\begin{align*}
+\int_D  D_l^T \; T \;dv   \leq 0
+\end{align*}
+The discrete form of its left hand side is obtained using \eqref{Eq_iso_flux}
+
+\begin{align*}
+&\int_D  D_l^T \; T \;dv \equiv  \sum_{i,k} \left\{ T \ D_l^T \ b_T \right\}    \\
+&\equiv + \sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{  
+		\delta_{i} \left[{_{i+1/2-i_p}^k {\mathbb{F}_u }_{i_p}^{k_p}} \right] 
+	     + \delta_{k} \left[ {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p}} \right]  \ T \right\}    \\
+&\equiv  - \sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{  
+                {_{i+1/2-i_p}^k {\mathbb{F}_u }_{i_p}^{k_p}} \ \delta_{i+1/2} [T]
+             + {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p}}  \ \delta_{k+1/2} [T]   \right\}      \\
+&\equiv -\sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{  
+	\frac{ _{i+1/2-i_p}^k \mathbb{T}_{i_p}^{k_p} (T) }{ {e_{1u}}_{\,i+1/2}^{\,k} }  \ \delta_{i+1/2} [T]
+ - { _i^{k+1/2-k_p} \mathbb{R}_{i_p}^{k_p} } \ \; 
+	\frac{ _i^{k+1/2-k_p} \mathbb{T}_{i_p}^{k_p} (T) }{ {e_{3w}}_{\,i}^{\,k+1/2}  } \ \delta_{k+1/2} [T]   
+	                                                                    \right\}      \\
+%
+\allowdisplaybreaks
+\intertext{ Expending the summation on $i_p$ and $k_p$, it becomes:}
+%
+&\equiv -\sum_{i,k}
+\begin{Bmatrix}  
+&\ \ \Bigl(  { _{i+1}^{k} \mathbb{T}_{-1/2}^{-1/2} (T) } 
+&\frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ {_{i}^{k+1} \mathbb{R}_{-1/2}^{-1/2}} 
+&      {_{i}^{k+1} \mathbb{T}_{-1/2}^{-1/2} (T) }   
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)
+& \\
+&+\Bigl( \ \;\; { _i^k \mathbb{T}_{+1/2}^{-1/2} (T) }  
+&\frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ {_i^{k+1} \mathbb{R}_{+1/2}^{-1/2}}
+& { _i^{k+1} \mathbb{T}_{+1/2}^{-1/2} (T) }   
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}      \Bigr)
+& \\
+&+\Bigl(  { _{i+1}^{k} \mathbb{T}_{-1/2}^{+1/2} (T) } 
+&\frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ \ \;\;{_{i}^{k} \mathbb{R}_{-1/2}^{+1/2}} 
+&      \ \;\;{_{i}^{k} \mathbb{T}_{-1/2}^{+1/2} (T) }   
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)
+& \\
+&+\Bigl( \ \;\; { _{i}^{k} \mathbb{T}_{+1/2}^{+1/2} (T) } 
+&\frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ \ \;\;{_{i}^{k} \mathbb{R}_{+1/2}^{+1/2}} 
+&      \ \;\;{_{i}^{k} \mathbb{T}_{+1/2}^{+1/2} (T) }   
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)   \\
+\end{Bmatrix}
+%
+\allowdisplaybreaks
+\intertext{The summation is done over all $i$ and $k$ indices, it is therefore possible to introduce a shift of $-1$ either in $i$ or $k$ direction in order to regroup all the terms of the summation by triad at a ($i$,$k$) point. In other words, we regroup all the terms in the neighbourhood  that contain a triad at the same ($i$,$k$) indices. It becomes: }
+%
+&\equiv -\sum_{i,k}
+\begin{Bmatrix}  
+&\ \ \Bigl(  {_i^k \mathbb{T}_{-1/2}^{-1/2} (T) } 
+&\frac{ \delta_{i -1/2} [T] }{{e_{1u} }_{\,i-1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{-1/2}^{-1/2}} 
+&      {_i^k \mathbb{T}_{-1/2}^{-1/2} (T) }   
+&\frac{ \delta_{k-1/2} [T] }{{e_{3w}}_{\,i}^{\,k-1/2}}     \Bigr)
+& \\
+&+\Bigl(  { _i^k \mathbb{T}_{+1/2}^{-1/2} (T) }  
+&\frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{+1/2}^{-1/2}}
+&      { _i^k \mathbb{T}_{+1/2}^{-1/2} (T) }   
+&\frac{ \delta_{k-1/2} [T] }{{e_{3w}}_{\,i}^{\,k-1/2}}      \Bigr)
+& \\
+&+\Bigl(  {_i^k \mathbb{T}_{-1/2}^{+1/2} (T) } 
+&\frac{ \delta_{i -1/2} [T] }{{e_{1u} }_{\,i-1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{-1/2}^{+1/2}} 
+&      {_i^k \mathbb{T}_{-1/2}^{+1/2} (T) }   
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)
+& \\
+&+\Bigl( { _i^k \mathbb{T}_{+1/2}^{+1/2} (T) } 
+&\frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{+1/2}^{+1/2}} 
+&      {_i^k \mathbb{T}_{+1/2}^{+1/2} (T) }   
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)   \\
+\end{Bmatrix}   \\
+%
+\allowdisplaybreaks
+\intertext{Then outing in factor the triad in each of the four terms of the summation and substituting the triads by their expression given in \eqref{Gf_triads}. It becomes: }
+%
+&\equiv -\sum_{i,k}
+\begin{Bmatrix}  
+&\ \ \Bigl(  \frac{ \delta_{i -1/2} [T] }{{e_{1u} }_{\,i-1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{-1/2}^{-1/2}} 
+&\frac{ \delta_{k-1/2} [T] }{{e_{3w}}_{\,i}^{\,k-1/2}}     \Bigr)^2
+& \frac{1}{4} \ {b_u}_{\,i-1/2}^{\,k}  \  A_i^k
+& \\
+&+\Bigl(  \frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{+1/2}^{-1/2}}
+&\frac{ \delta_{k-1/2} [T] }{{e_{3w}}_{\,i}^{\,k-1/2}}      \Bigr)^2
+& \frac{1}{4} \ {b_u}_{\,i+1/2}^{\,k}  \  A_i^k
+& \\
+&+\Bigl(  \frac{ \delta_{i -1/2} [T] }{{e_{1u} }_{\,i-1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{-1/2}^{+1/2}} 
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)^2
+& \frac{1}{4} \ {b_u}_{\,i-1/2}^{\,k}  \  A_i^k
+& \\
+&+\Bigl( \frac{ \delta_{i +1/2} [T] }{{e_{1u} }_{\,i+1/2}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{+1/2}^{+1/2}} 
+&\frac{ \delta_{k+1/2} [T] }{{e_{3w}}_{\,i}^{\,k+1/2}}     \Bigr)^2
+& \frac{1}{4} \ {b_u}_{\,i+1/2}^{\,k}  \  A_i^k      \\
+\end{Bmatrix}   \\
+& \\
+%
+&\equiv - \sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{  
+\begin{matrix}  
+&\Bigl( \frac{ \delta_{i +i_p} [T] }{{e_{1u} }_{\,i+i_p}^{\,k}} 
+& -\ \ {_i^k \mathbb{R}_{i_p}^{k_p}} 
+&\frac{ \delta_{k+k_p} [T] }{{e_{3w}}_{\,i}^{\,k+k_p}}     \Bigr)^2
+& \frac{1}{4} \ {b_u}_{\,i+i_p}^{\,k}  \  A_i^k   \ \ 
+\end{matrix}
+ \right\}   
+\quad   \leq 0
+\end{align*} 
+The last inequality is obviously obtained as we succeed in obtaining a negative summation of square quantities.
+
+Note that, if instead of multiplying $D_l^T$ by $T$, we were using another tracer field, let say $S$, then the previous demonstration would have let to:
+\begin{align*}
+\int_D  S \; D_l^T  \;dv &\equiv  \sum_{i,k} \left\{ S \ D_l^T \ b_T \right\}    \\
+&\equiv - \sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{  
+\left( \frac{ \delta_{i +i_p} [S] }{{e_{1u} }_{\,i+i_p}^{\,k}} 
+ - {_i^k \mathbb{R}_{i_p}^{k_p}} 
+\frac{ \delta_{k+k_p} [S] }{{e_{3w}}_{\,i}^{\,k+k_p}}     \right)  \right.    
+\\   & \qquad \qquad \qquad \ \left.
+\left( \frac{ \delta_{i +i_p} [T] }{{e_{1u} }_{\,i+i_p}^{\,k}} 
+ - {_i^k \mathbb{R}_{i_p}^{k_p}} 
+\frac{ \delta_{k+k_p} [T] }{{e_{3w}}_{\,i}^{\,k+k_p}}     \right) 
+ \frac{1}{4} \ {b_u}_{\,i+i_p}^{\,k}  \  A_i^k   \
+ \right\}   
+%
+\allowdisplaybreaks
+\intertext{which, by applying the same operation as before but in reverse order, leads to: }
+%
+&\equiv  \sum_{i,k} \left\{ D_l^S \ T \ b_T \right\}   
+\end{align*} 
+This means that the iso-neutral operator is self-adjoint. There is no need to develop a specific to obtain it.
+
+
+
+$\ $\newpage      %force an empty line
+% ================================================================
+% Discrete Invariants of the skew flux formulation
+% ================================================================
+\subsection{Discrete Invariants of the skew flux formulation}
+\label{Apdx_eiv_skew}
+
+
+Demonstration for the conservation of the tracer variance in the (\textbf{i},\textbf{j}) plane. 
+
+This have to be moved in an Appendix.
+
+The continuous property to be demonstrated is :
+\begin{align*}
+\int_D \nabla \cdot \textbf{F}_{eiv}(T) \; T \;dv  \equiv 0
+\end{align*}
+The discrete form of its left hand side is obtained using \eqref{Eq_eiv_skew}
+\begin{align*}
+ \sum\limits_{i,k} \sum_{\substack{i_p,\,k_p}}  \Biggl\{   \;\;
+ \delta_i  &\left[                                                    
+{e_{2u}}_{i+i_p+1/2}^{k}                                  \;\ \ {A_{e}}_{i+i_p+1/2}^{k} 
+\ \ \ { _{i+i_p+1/2}^k \mathbb{R}_{-i_p}^{k_p} }   \quad \delta_{k+k_p}[T_{i+i_p+1/2}]         
+   \right] \; T_i^k      \\
+- \delta_k &\left[ 
+{e_{2u}}_i^{k+k_p+1/2}                                     \ \ {A_{e}}_i^{k+k_p+1/2} 
+\ \ { _i^{k+k_p+1/2} \mathbb{R}_{i_p}^{-k_p} }   \ \ \delta_{i+i_p}[T^{k+k_p+1/2}]   
+   \right] \; T_i^k      \         \Biggr\}   
+\end{align*}
+apply the adjoint of delta operator, it becomes
+\begin{align*}
+ \sum\limits_{i,k} \sum_{\substack{i_p,\,k_p}}  \Biggl\{   \;\;
+  &\left(                                                    
+{e_{2u}}_{i+i_p+1/2}^{k}                                  \;\ \ {A_{e}}_{i+i_p+1/2}^{k} 
+\ \ \ { _{i+i_p+1/2}^k \mathbb{R}_{-i_p}^{k_p} }   \quad \delta_{k+k_p}[T_{i+i_p+1/2}]         
+   \right) \; \delta_{i+1/2}[T^{k}]      \\
+- &\left( 
+{e_{2u}}_i^{k+k_p+1/2}                                     \ \ {A_{e}}_i^{k+k_p+1/2} 
+\ \ { _i^{k+k_p+1/2} \mathbb{R}_{i_p}^{-k_p} }   \ \ \delta_{i+i_p}[T^{k+k_p+1/2}]   
+     \right) \; \delta_{k+1/2}[T_{i}]       \         \Biggr\}       
+\end{align*}
+Expending the summation on $i_p$ and $k_p$, it becomes:
+\begin{align*}
+ \begin{matrix}  
+&\sum\limits_{i,k}   \Bigl\{ 
+  &+{e_{2u}}_{i+1}^{k}                             &{A_{e}}_{i+1    }^{k} 
+  &\ {_{i+1}^k \mathbb{R}_{- 1/2}^{-1/2}} &\delta_{k-1/2}[T_{i+1}]    &\delta_{i+1/2}[T^{k}]   &\\
+&&+{e_{2u}}_i^{k\ \ \ \:}                            &{A_{e}}_{i}^{k\ \ \ \:}      
+  &\ {\ \ \;_i^k \mathbb{R}_{+1/2}^{-1/2}}  &\delta_{k-1/2}[T_{i\ \ \ \;}]  &\delta_{i+1/2}[T^{k}] &\\
+&&+{e_{2u}}_{i+1}^{k}                             &{A_{e}}_{i+1    }^{k} 
+  &\ {_{i+1}^k \mathbb{R}_{- 1/2}^{+1/2}} &\delta_{k+1/2}[T_{i+1}]     &\delta_{i+1/2}[T^{k}] &\\
+&&+{e_{2u}}_i^{k\ \ \ \:}                            &{A_{e}}_{i}^{k\ \ \ \:}       
+    &\ {\ \ \;_i^k \mathbb{R}_{+1/2}^{+1/2}} &\delta_{k+1/2}[T_{i\ \ \ \;}] &\delta_{i+1/2}[T^{k}] &\\
+%
+&&-{e_{2u}}_i^{k+1}                                &{A_{e}}_i^{k+1} 
+  &{_i^{k+1} \mathbb{R}_{-1/2}^{- 1/2}}   &\delta_{i-1/2}[T^{k+1}]      &\delta_{k+1/2}[T_{i}] &\\   
+&&-{e_{2u}}_i^{k\ \ \ \:}                             &{A_{e}}_i^{k\ \ \ \:} 
+  &{\ \ \;_i^k  \mathbb{R}_{-1/2}^{+1/2}}   &\delta_{i-1/2}[T^{k\ \ \ \:}]  &\delta_{k+1/2}[T_{i}] &\\
+&&-{e_{2u}}_i^{k+1    }                             &{A_{e}}_i^{k+1} 
+  &{_i^{k+1} \mathbb{R}_{+1/2}^{- 1/2}}   &\delta_{i+1/2}[T^{k+1}]      &\delta_{k+1/2}[T_{i}] &\\   
+&&-{e_{2u}}_i^{k\ \ \ \:}                             &{A_{e}}_i^{k\ \ \ \:} 
+  &{\ \ \;_i^k  \mathbb{R}_{+1/2}^{+1/2}}   &\delta_{i+1/2}[T^{k\ \ \ \:}]  &\delta_{k+1/2}[T_{i}] 
+&\Bigr\}  \\
+\end{matrix}   
+\end{align*}
+The two terms associated with the triad ${_i^k \mathbb{R}_{+1/2}^{+1/2}}$ are the 
+same but of opposite signs, they cancel out. 
+Exactly the same thing occurs for the triad ${_i^k \mathbb{R}_{-1/2}^{-1/2}}$. 
+The two terms associated with the triad ${_i^k \mathbb{R}_{+1/2}^{-1/2}}$ are the 
+same but both of opposite signs and shifted by 1 in $k$ direction. When summing over $k$ 
+they cancel out with the neighbouring grid points. 
+Exactly the same thing occurs for the triad ${_i^k \mathbb{R}_{-1/2}^{+1/2}}$ in the 
+$i$ direction. Therefore the sum over the domain is zero, $i.e.$ the variance of the 
+tracer is preserved by the discretisation of the skew fluxes.
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_ISO.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_ISO.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Annex_ISO.tex	(revision 8732)
@@ -0,0 +1,1179 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Iso-neutral diffusion :
+% ================================================================
+\chapter[Iso-neutral diffusion and eddy advection using
+triads]{Iso-neutral diffusion and eddy advection using triads}
+\label{sec:triad}
+\minitoc
+\pagebreak
+\section{Choice of \ngn{namtra\_ldf} namelist parameters}
+%-----------------------------------------nam_traldf------------------------------------------------------
+\namdisplay{namtra_ldf}
+%---------------------------------------------------------------------------------------------------------
+
+Two scheme are available to perform the iso-neutral diffusion. 
+If the namelist logical \np{ln\_traldf\_triad} is set true, 
+\NEMO updates both active and passive tracers using the Griffies triad representation 
+of iso-neutral diffusion and the eddy-induced advective skew (GM) fluxes. 
+If the namelist logical \np{ln\_traldf\_iso} is set true, 
+the filtered version of Cox's original scheme (the Standard scheme) is employed (\S\ref{LDF_slp}). 
+In the present implementation of the Griffies scheme, 
+the advective skew fluxes are implemented even if \np{ln\_traldf\_eiv} is false.
+
+Values of iso-neutral diffusivity and GM coefficient are set as
+described in \S\ref{LDF_coef}. Note that when GM fluxes are used, 
+the eddy-advective (GM) velocities are output for diagnostic purposes using xIOS, 
+even though the eddy advection is accomplished by means of the skew fluxes.
+
+
+The options specific to the Griffies scheme include:
+\begin{description}[font=\normalfont]
+\item[\np{ln\_triad\_iso}] See \S\ref{sec:triad:taper}. If this is set false (the default), then
+  `iso-neutral' mixing is accomplished within the surface mixed-layer
+  along slopes linearly decreasing with depth from the value immediately below
+  the mixed-layer to zero (flat) at the surface (\S\ref{sec:triad:lintaper}). 
+  This is the same treatment as used in the default implementation \S\ref{LDF_slp_iso}; Fig.~\ref{Fig_eiv_slp}.  
+  Where \np{ln\_triad\_iso} is set true, the vertical skew flux is further reduced 
+  to ensure no vertical buoyancy flux, giving an almost pure
+  horizontal diffusive tracer flux within the mixed layer. This is similar to
+  the tapering suggested by \citet{Gerdes1991}. See \S\ref{sec:triad:Gerdes-taper}
+\item[\np{ln\_botmix\_triad}] See \S\ref{sec:triad:iso_bdry}. 
+  If this is set false (the default) then the lateral diffusive fluxes
+  associated with triads partly masked by topography are neglected. 
+  If it is set true, however, then these lateral diffusive fluxes are applied, 
+  giving smoother bottom tracer fields at the cost of introducing diapycnal mixing.
+\item[\np{rn\_sw\_triad}]  blah blah to be added....
+\end{description}
+The options shared with the Standard scheme include:
+\begin{description}[font=\normalfont]
+\item[\np{ln\_traldf\_msc}]   blah blah to be added
+\item[\np{rn\_slpmax}]  blah blah to be added
+\end{description}
+\section{Triad formulation of iso-neutral diffusion}
+\label{sec:triad:iso}
+We have implemented into \NEMO a scheme inspired by \citet{Griffies_al_JPO98}, 
+but formulated within the \NEMO framework, using scale factors rather than grid-sizes.
+
+\subsection{The iso-neutral diffusion operator}
+The iso-neutral second order tracer diffusive operator for small
+angles between iso-neutral surfaces and geopotentials is given by
+\eqref{Eq_PE_iso_tensor}:
+\begin{subequations} \label{eq:triad:PE_iso_tensor}
+  \begin{equation}
+    D^{lT}=-\Div\vect{f}^{lT}\equiv
+    -\frac{1}{e_1e_2e_3}\left[\pd{i}\left (f_1^{lT}e_2e_3\right) +
+      \pd{j}\left (f_2^{lT}e_2e_3\right) + \pd{k}\left (f_3^{lT}e_1e_2\right)\right],
+  \end{equation}
+  where the diffusive flux per unit area of physical space
+  \begin{equation}
+    \vect{f}^{lT}=-\Alt\Re\cdot\grad T,
+  \end{equation}
+  \begin{equation}
+    \label{eq:triad:PE_iso_tensor:c}
+    \mbox{with}\quad \;\;\Re =
+    \begin{pmatrix}
+       1   &  0   & -r_1           \mystrut \\
+       0   &  1   & -r_2           \mystrut \\
+      -r_1 & -r_2 &  r_1 ^2+r_2 ^2 \mystrut
+    \end{pmatrix}
+    \quad \text{and} \quad\grad T=
+    \begin{pmatrix}
+      \frac{1}{e_1} \pd[T]{i} \mystrut \\
+      \frac{1}{e_2} \pd[T]{j} \mystrut \\
+      \frac{1}{e_3} \pd[T]{k} \mystrut
+    \end{pmatrix}.
+  \end{equation}
+\end{subequations}
+% \left( {{\begin{array}{*{20}c}
+%  1 \hfill & 0 \hfill & {-r_1 } \hfill \\
+%  0 \hfill & 1 \hfill & {-r_2 } \hfill \\
+%  {-r_1 } \hfill & {-r_2 } \hfill & {r_1 ^2+r_2 ^2} \hfill \\
+% \end{array} }} \right)
+ Here \eqref{Eq_PE_iso_slopes} 
+\begin{align*}
+  r_1 &=-\frac{e_3 }{e_1 } \left( \frac{\partial \rho }{\partial i}
+  \right)
+  \left( {\frac{\partial \rho }{\partial k}} \right)^{-1} \\
+  &=-\frac{e_3 }{e_1 } \left( -\alpha\frac{\partial T }{\partial i} +
+    \beta\frac{\partial S }{\partial i} \right) \left(
+    -\alpha\frac{\partial T }{\partial k} + \beta\frac{\partial S
+    }{\partial k} \right)^{-1}
+\end{align*}
+is the $i$-component of the slope of the iso-neutral surface relative to the computational
+surface, and $r_2$ is the $j$-component.
+
+We will find it useful to consider the fluxes per unit area in $i,j,k$
+space; we write
+\begin{equation}
+  \label{eq:triad:Fijk}
+  \vect{F}_{\mathrm{iso}}=\left(f_1^{lT}e_2e_3, f_2^{lT}e_1e_3, f_3^{lT}e_1e_2\right).
+\end{equation}
+Additionally, we will sometimes write the contributions towards the
+fluxes $\vect{f}$ and $\vect{F}_\mathrm{iso}$ from the component
+$R_{ij}$ of $\Re$ as $f_{ij}$, $F_{\mathrm{iso}\: ij}$, with
+$f_{ij}=R_{ij}e_i^{-1}\partial T/\partial x_i$ (no summation) etc.
+
+The off-diagonal terms of the small angle diffusion tensor
+\eqref{Eq_PE_iso_tensor}, \eqref{eq:triad:PE_iso_tensor:c} produce skew-fluxes along the
+$i$- and $j$-directions resulting from the vertical tracer gradient:
+\begin{align}
+  \label{eq:triad:i13c}
+  f_{13}=&+\Alt r_1\frac{1}{e_3}\frac{\partial T}{\partial k},\qquad f_{23}=+\Alt r_2\frac{1}{e_3}\frac{\partial T}{\partial k}\\
+\intertext{and in the k-direction resulting from the lateral tracer gradients}
+  \label{eq:triad:i31c}
+ f_{31}+f_{32}=& \Alt r_1\frac{1}{e_1}\frac{\partial T}{\partial i}+\Alt r_2\frac{1}{e_1}\frac{\partial T}{\partial i}
+\end{align}
+
+The vertical diffusive flux associated with the $_{33}$
+component of the small angle diffusion tensor is
+\begin{equation}
+  \label{eq:triad:i33c}
+  f_{33}=-\Alt(r_1^2 +r_2^2) \frac{1}{e_3}\frac{\partial T}{\partial k}.
+\end{equation}
+
+Since there are no cross terms involving $r_1$ and $r_2$ in the above, we can
+consider the iso-neutral diffusive fluxes separately in the $i$-$k$ and $j$-$k$
+planes, just adding together the vertical components from each
+plane. The following description will describe the fluxes on the $i$-$k$
+plane.
+
+There is no natural discretization for the $i$-component of the
+skew-flux, \eqref{eq:triad:i13c}, as
+although it must be evaluated at $u$-points, it involves vertical
+gradients (both for the tracer and the slope $r_1$), defined at
+$w$-points. Similarly, the vertical skew flux, \eqref{eq:triad:i31c}, is evaluated at
+$w$-points but involves horizontal gradients defined at $u$-points.
+
+\subsection{The standard discretization}
+The straightforward approach to discretize the lateral skew flux
+\eqref{eq:triad:i13c} from tracer cell $i,k$ to $i+1,k$, introduced in 1995
+into OPA, \eqref{Eq_tra_ldf_iso}, is to calculate a mean vertical
+gradient at the $u$-point from the average of the four surrounding
+vertical tracer gradients, and multiply this by a mean slope at the
+$u$-point, calculated from the averaged surrounding vertical density
+gradients. The total area-integrated skew-flux (flux per unit area in
+$ijk$ space) from tracer cell $i,k$
+to $i+1,k$, noting that the $e_{{3}_{i+1/2}^k}$ in the area
+$e{_{3}}_{i+1/2}^k{e_{2}}_{i+1/2}i^k$ at the $u$-point cancels out with
+the $1/{e_{3}}_{i+1/2}^k$ associated with the vertical tracer
+gradient, is then \eqref{Eq_tra_ldf_iso}
+\begin{equation*}
+  \left(F_u^{13} \right)_{i+\hhalf}^k = \Alts_{i+\hhalf}^k
+  {e_{2}}_{i+1/2}^k \overline{\overline
+    r_1} ^{\,i,k}\,\overline{\overline{\delta_k T}}^{\,i,k},
+\end{equation*}
+where
+\begin{equation*}
+  \overline{\overline
+   r_1} ^{\,i,k} = -\frac{{e_{3u}}_{i+1/2}^k}{{e_{1u}}_{i+1/2}^k}
+  \frac{\delta_{i+1/2} [\rho]}{\overline{\overline{\delta_k \rho}}^{\,i,k}},
+\end{equation*}
+and here and in the following we drop the $^{lT}$ superscript from
+$\Alt$ for simplicity.
+Unfortunately the resulting combination $\overline{\overline{\delta_k
+    \bullet}}^{\,i,k}$ of a $k$ average and a $k$ difference %of the tracer
+reduces to $\bullet_{k+1}-\bullet_{k-1}$, so two-grid-point oscillations are
+invisible to this discretization of the iso-neutral operator. These
+\emph{computational modes} will not be damped by this operator, and
+may even possibly be amplified by it.  Consequently, applying this
+operator to a tracer does not guarantee the decrease of its
+global-average variance. To correct this, we introduced a smoothing of
+the slopes of the iso-neutral surfaces (see \S\ref{LDF}). This
+technique works for $T$ and $S$ in so far as they are active tracers
+($i.e.$ they enter the computation of density), but it does not work
+for a passive tracer.
+\subsection{Expression of the skew-flux in terms of triad slopes}
+\citep{Griffies_al_JPO98} introduce a different discretization of the
+off-diagonal terms that nicely solves the problem.
+% Instead of multiplying the mean slope calculated at the $u$-point by
+% the mean vertical gradient at the $u$-point,
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[tb] \begin{center}
+    \includegraphics[width=1.05\textwidth]{Fig_GRIFF_triad_fluxes}
+    \caption{ \label{fig:triad:ISO_triad}
+      (a) Arrangement of triads $S_i$ and tracer gradients to
+           give lateral tracer flux from box $i,k$ to $i+1,k$
+      (b) Triads $S'_i$ and tracer gradients to give vertical tracer flux from
+            box $i,k$ to $i,k+1$.}
+ \end{center} \end{figure}
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+They get the skew flux from the products of the vertical gradients at
+each $w$-point surrounding the $u$-point with the corresponding `triad'
+slope calculated from the lateral density gradient across the $u$-point
+divided by the vertical density gradient at the same $w$-point as the
+tracer gradient. See Fig.~\ref{fig:triad:ISO_triad}a, where the thick lines
+denote the tracer gradients, and the thin lines the corresponding
+triads, with slopes $s_1, \dotsc s_4$. The total area-integrated
+skew-flux from tracer cell $i,k$ to $i+1,k$
+\begin{multline}
+  \label{eq:triad:i13}
+  \left( F_u^{13}  \right)_{i+\frac{1}{2}}^k = \Alts_{i+1}^k a_1 s_1
+  \delta _{k+\frac{1}{2}} \left[ T^{i+1}
+  \right]/e_{{3w}_{i+1}}^{k+\frac{1}{2}}  + \Alts _i^k a_2 s_2 \delta
+  _{k+\frac{1}{2}} \left[ T^i
+  \right]/e_{{3w}_{i+1}}^{k+\frac{1}{2}} \\
+   +\Alts _{i+1}^k a_3 s_3 \delta _{k-\frac{1}{2}} \left[ T^{i+1}
+  \right]/e_{{3w}_{i+1}}^{k+\frac{1}{2}}  +\Alts _i^k a_4 s_4 \delta
+  _{k-\frac{1}{2}} \left[ T^i \right]/e_{{3w}_{i+1}}^{k+\frac{1}{2}},
+\end{multline}
+where the contributions of the triad fluxes are weighted by areas
+$a_1, \dotsc a_4$, and $\Alts$ is now defined at the tracer points
+rather than the $u$-points. This discretization gives a much closer
+stencil, and disallows the two-point computational modes.
+
+ The vertical skew flux \eqref{eq:triad:i31c} from tracer cell $i,k$ to $i,k+1$ at the
+$w$-point $i,k+\hhalf$ is constructed similarly (Fig.~\ref{fig:triad:ISO_triad}b)
+by multiplying lateral tracer gradients from each of the four
+surrounding $u$-points by the appropriate triad slope:
+\begin{multline}
+  \label{eq:triad:i31}
+  \left( F_w^{31} \right) _i ^{k+\frac{1}{2}} =  \Alts_i^{k+1} a_{1}'
+  s_{1}' \delta _{i-\frac{1}{2}} \left[ T^{k+1} \right]/{e_{3u}}_{i-\frac{1}{2}}^{k+1}
+   +\Alts_i^{k+1} a_{2}' s_{2}' \delta _{i+\frac{1}{2}} \left[ T^{k+1} \right]/{e_{3u}}_{i+\frac{1}{2}}^{k+1}\\
+  + \Alts_i^k a_{3}' s_{3}' \delta _{i-\frac{1}{2}} \left[ T^k\right]/{e_{3u}}_{i-\frac{1}{2}}^k
+  +\Alts_i^k a_{4}' s_{4}' \delta _{i+\frac{1}{2}} \left[ T^k \right]/{e_{3u}}_{i+\frac{1}{2}}^k.
+\end{multline}
+
+We notate the triad slopes $s_i$ and $s'_i$ in terms of the `anchor point' $i,k$
+(appearing in both the vertical and lateral gradient), and the $u$- and
+$w$-points $(i+i_p,k)$, $(i,k+k_p)$ at the centres of the `arms' of the
+triad as follows (see also Fig.~\ref{fig:triad:ISO_triad}):
+\begin{equation}
+  \label{eq:triad:R}
+  _i^k \mathbb{R}_{i_p}^{k_p}
+  =-\frac{ {e_{3w}}_{\,i}^{\,k+k_p}} { {e_{1u}}_{\,i+i_p}^{\,k}}
+  \
+  \frac
+  { \alpha_i^k  \ \delta_{i+i_p}[T^k] - \beta_i^k \ \delta_{i+i_p}[S^k] }
+  { \alpha_i^k  \ \delta_{k+k_p}[T^i] - \beta_i^k \ \delta_{k+k_p}[S^i] }.
+\end{equation}
+In calculating the slopes of the local neutral surfaces, 
+the expansion coefficients $\alpha$ and $\beta$ are evaluated at the anchor points of the triad, 
+while the metrics are calculated at the $u$- and $w$-points on the arms.
+
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[tb] \begin{center}
+    \includegraphics[width=0.80\textwidth]{Fig_GRIFF_qcells}
+    \caption{   \label{fig:triad:qcells}
+    Triad notation for quarter cells. $T$-cells are inside
+      boxes, while the  $i+\half,k$ $u$-cell is shaded in green and the
+      $i,k+\half$ $w$-cell is shaded in pink.}
+  \end{center} \end{figure}
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Each triad $\{_i^{k}\:_{i_p}^{k_p}\}$ is associated (Fig.~\ref{fig:triad:qcells}) with the quarter
+cell that is the intersection of the $i,k$ $T$-cell, the $i+i_p,k$ $u$-cell and the $i,k+k_p$ $w$-cell. 
+Expressing the slopes $s_i$ and $s'_i$ in \eqref{eq:triad:i13} and \eqref{eq:triad:i31} in this notation, 
+we have $e.g.$ \ $s_1=s'_1={\:}_i^k \mathbb{R}_{1/2}^{1/2}$. 
+Each triad slope $_i^k\mathbb{R}_{i_p}^{k_p}$ is used once (as an $s$) 
+to calculate the lateral flux along its $u$-arm, at $(i+i_p,k)$, 
+and then again as an $s'$ to calculate the vertical flux along its $w$-arm at $(i,k+k_p)$. 
+Each vertical area $a_i$ used to calculate the lateral flux and horizontal area $a'_i$ used 
+to calculate the vertical flux can also be identified as the area across the $u$- and $w$-arms 
+of a unique triad, and we notate these areas, similarly to the triad slopes, 
+as $_i^k{\mathbb{A}_u}_{i_p}^{k_p}$, $_i^k{\mathbb{A}_w}_{i_p}^{k_p}$, 
+where $e.g.$ in \eqref{eq:triad:i13} $a_{1}={\:}_i^k{\mathbb{A}_u}_{1/2}^{1/2}$, 
+and in \eqref{eq:triad:i31} $a'_{1}={\:}_i^k{\mathbb{A}_w}_{1/2}^{1/2}$.
+
+\subsection{The full triad fluxes}
+A key property of iso-neutral diffusion is that it should not affect
+the (locally referenced) density. In particular there should be no
+lateral or vertical density flux. The lateral density flux disappears so long as the
+area-integrated lateral diffusive flux from tracer cell $i,k$ to
+$i+1,k$ coming from the $_{11}$ term of the diffusion tensor takes the
+form
+\begin{equation}
+  \label{eq:triad:i11}
+  \left( F_u^{11} \right) _{i+\frac{1}{2}} ^{k} =
+  - \left( \Alts_i^{k+1} a_{1} + \Alts_i^{k+1} a_{2} + \Alts_i^k
+    a_{3} + \Alts_i^k a_{4} \right)
+  \frac{\delta _{i+1/2} \left[ T^k\right]}{{e_{1u}}_{\,i+1/2}^{\,k}},
+\end{equation}
+where the areas $a_i$ are as in \eqref{eq:triad:i13}. In this case,
+separating the total lateral flux, the sum of \eqref{eq:triad:i13} and
+\eqref{eq:triad:i11}, into triad components, a lateral tracer
+flux
+\begin{equation}
+  \label{eq:triad:latflux-triad}
+  _i^k {\mathbb{F}_u}_{i_p}^{k_p} (T) = - \Alts_i^k{ \:}_i^k{\mathbb{A}_u}_{i_p}^{k_p}
+  \left(
+    \frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    -\ {_i^k\mathbb{R}_{i_p}^{k_p}} \
+    \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+  \right)
+\end{equation}
+can be identified with each triad. Then, because the
+same metric factors ${e_{3w}}_{\,i}^{\,k+k_p}$ and
+${e_{1u}}_{\,i+i_p}^{\,k}$ are employed for both the density gradients
+in $ _i^k \mathbb{R}_{i_p}^{k_p}$ and the tracer gradients, the lateral
+density flux associated with each triad separately disappears.
+\begin{equation}
+  \label{eq:triad:latflux-rho}
+  {\mathbb{F}_u}_{i_p}^{k_p} (\rho)=-\alpha _i^k {\:}_i^k {\mathbb{F}_u}_{i_p}^{k_p} (T) + \beta_i^k {\:}_i^k {\mathbb{F}_u}_{i_p}^{k_p} (S)=0
+\end{equation}
+Thus the total flux $\left( F_u^{31} \right) ^i _{i,k+\frac{1}{2}} +
+\left( F_u^{11} \right) ^i _{i,k+\frac{1}{2}}$ from tracer cell $i,k$
+to $i+1,k$ must also vanish since it is a sum of four such triad fluxes.
+
+The squared slope $r_1^2$ in the expression \eqref{eq:triad:i33c} for the
+$_{33}$ component is also expressed in terms of area-weighted
+squared triad slopes, so the area-integrated vertical flux from tracer
+cell $i,k$ to $i,k+1$ resulting from the $r_1^2$ term is
+\begin{equation}
+  \label{eq:triad:i33}
+  \left( F_w^{33} \right) _i^{k+\frac{1}{2}} =
+    - \left( \Alts_i^{k+1} a_{1}' s_{1}'^2
+    + \Alts_i^{k+1} a_{2}' s_{2}'^2
+    + \Alts_i^k a_{3}' s_{3}'^2
+    + \Alts_i^k a_{4}' s_{4}'^2 \right)\delta_{k+\frac{1}{2}} \left[ T^{i+1} \right],
+\end{equation}
+where the areas $a'$ and slopes $s'$ are the same as in
+\eqref{eq:triad:i31}.
+Then, separating the total vertical flux, the sum of \eqref{eq:triad:i31} and
+\eqref{eq:triad:i33}, into triad components,  a vertical flux
+\begin{align}
+  \label{eq:triad:vertflux-triad}
+  _i^k {\mathbb{F}_w}_{i_p}^{k_p} (T)
+  &= \Alts_i^k{\: }_i^k{\mathbb{A}_w}_{i_p}^{k_p}
+  \left(
+    {_i^k\mathbb{R}_{i_p}^{k_p}}\frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    -\ \left({_i^k\mathbb{R}_{i_p}^{k_p}}\right)^2 \
+    \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+  \right) \\
+  &= - \left(\left.{ }_i^k{\mathbb{A}_w}_{i_p}^{k_p}\right/{ }_i^k{\mathbb{A}_u}_{i_p}^{k_p}\right)
+   {_i^k\mathbb{R}_{i_p}^{k_p}}{\: }_i^k{\mathbb{F}_u}_{i_p}^{k_p} (T) \label{eq:triad:vertflux-triad2}
+\end{align}
+may be associated with each triad. Each vertical density flux $_i^k {\mathbb{F}_w}_{i_p}^{k_p} (\rho)$
+associated with a triad then separately disappears (because the
+lateral flux $_i^k{\mathbb{F}_u}_{i_p}^{k_p} (\rho)$
+disappears). Consequently the total vertical density flux $\left( F_w^{31} \right)_i ^{k+\frac{1}{2}} +
+\left( F_w^{33} \right)_i^{k+\frac{1}{2}}$ from tracer cell $i,k$
+to $i,k+1$ must also vanish since it is a sum of four such triad
+fluxes.
+
+We can explicitly identify (Fig.~\ref{fig:triad:qcells}) the triads associated with the $s_i$, $a_i$, and $s'_i$, $a'_i$ used in the definition of
+the $u$-fluxes and $w$-fluxes in
+\eqref{eq:triad:i31}, \eqref{eq:triad:i13}, \eqref{eq:triad:i11} \eqref{eq:triad:i33} and
+Fig.~\ref{fig:triad:ISO_triad} to  write out the iso-neutral fluxes at $u$- and
+$w$-points as sums of the triad fluxes that cross the $u$- and $w$-faces:
+%(Fig.~\ref{Fig_ISO_triad}):
+\begin{flalign} \label{Eq_iso_flux} \vect{F}_\mathrm{iso}(T) &\equiv
+  \sum_{\substack{i_p,\,k_p}}
+  \begin{pmatrix}
+    {_{i+1/2-i_p}^k {\mathbb{F}_u}_{i_p}^{k_p} } (T)      \\
+    \\
+    {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p} } (T)      \\
+  \end{pmatrix}.
+\end{flalign}
+\subsection{Ensuring the scheme does not increase tracer variance}
+\label{sec:triad:variance}
+
+We now require that this operator should not increase the
+globally-integrated tracer variance.
+%This changes according to
+% \begin{align*}
+% &\int_D  D_l^T \; T \;dv \equiv  \sum_{i,k} \left\{ T \ D_l^T \ b_T \right\}    \\
+% &\equiv + \sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{
+% 		\delta_{i} \left[{_{i+1/2-i_p}^k {\mathbb{F}_u }_{i_p}^{k_p}} \right]
+% 	     + \delta_{k} \left[ {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p}} \right]  \ T \right\}    \\
+% &\equiv  - \sum_{i,k} \sum_{\substack{i_p,\,k_p}} \left\{
+%                 {_{i+1/2-i_p}^k {\mathbb{F}_u }_{i_p}^{k_p}} \ \delta_{i+1/2} [T]
+%              + {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p}}  \ \delta_{k+1/2} [T]   \right\}      \\
+% \end{align*}
+Each triad slope $_i^k\mathbb{R}_{i_p}^{k_p}$ drives a lateral flux
+$_i^k{\mathbb{F}_u}_{i_p}^{k_p} (T)$ across the $u$-point $i+i_p,k$ and
+a vertical flux $_i^k{\mathbb{F}_w}_{i_p}^{k_p} (T)$ across the
+$w$-point $i,k+k_p$.  The lateral flux drives a net rate of change of
+variance, summed over the two $T$-points $i+i_p-\half,k$ and $i+i_p+\half,k$, of
+\begin{multline}
+  {b_T}_{i+i_p-1/2}^k\left(\frac{\partial T}{\partial t}T\right)_{i+i_p-1/2}^k+
+  \quad {b_T}_{i+i_p+1/2}^k\left(\frac{\partial T}{\partial
+      t}T\right)_{i+i_p+1/2}^k \\
+ \begin{split}
+  &= -T_{i+i_p-1/2}^k{\;} _i^k{\mathbb{F}_u}_{i_p}^{k_p} (T) \quad + \quad  T_{i+i_p+1/2}^k
+  {\;}_i^k{\mathbb{F}_u}_{i_p}^{k_p} (T) \\
+  &={\;} _i^k{\mathbb{F}_u}_{i_p}^{k_p} (T)\,\delta_{i+ i_p}[T^k], \label{eq:triad:dvar_iso_i}
+ \end{split}
+\end{multline}
+while the vertical flux similarly drives a net rate of change of
+variance summed over the $T$-points $i,k+k_p-\half$ (above) and
+$i,k+k_p+\half$ (below) of
+\begin{equation}
+\label{eq:triad:dvar_iso_k}
+  _i^k{\mathbb{F}_w}_{i_p}^{k_p} (T) \,\delta_{k+ k_p}[T^i].
+\end{equation}
+The total variance tendency driven by the triad is the sum of these
+two. Expanding $_i^k{\mathbb{F}_u}_{i_p}^{k_p} (T)$ and
+$_i^k{\mathbb{F}_w}_{i_p}^{k_p} (T)$ with \eqref{eq:triad:latflux-triad} and
+\eqref{eq:triad:vertflux-triad}, it is
+\begin{multline*}
+-\Alts_i^k\left \{
+{ } _i^k{\mathbb{A}_u}_{i_p}^{k_p}
+  \left(
+    \frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    - {_i^k\mathbb{R}_{i_p}^{k_p}} \
+    \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }\right)\,\delta_{i+ i_p}[T^k] \right.\\
+- \left. { } _i^k{\mathbb{A}_w}_{i_p}^{k_p}
+  \left(
+    \frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    -{\:}_i^k\mathbb{R}_{i_p}^{k_p}
+    \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+  \right) {\,}_i^k\mathbb{R}_{i_p}^{k_p}\delta_{k+ k_p}[T^i]
+\right \}.
+\end{multline*}
+The key point is then that if we require
+$_i^k{\mathbb{A}_u}_{i_p}^{k_p}$ and $_i^k{\mathbb{A}_w}_{i_p}^{k_p}$
+to be related to a triad volume $_i^k\mathbb{V}_{i_p}^{k_p}$ by
+\begin{equation}
+  \label{eq:triad:V-A}
+  _i^k\mathbb{V}_{i_p}^{k_p}
+  ={\;}_i^k{\mathbb{A}_u}_{i_p}^{k_p}\,{e_{1u}}_{\,i + i_p}^{\,k}
+  ={\;}_i^k{\mathbb{A}_w}_{i_p}^{k_p}\,{e_{3w}}_{\,i}^{\,k + k_p},
+\end{equation}
+the variance tendency reduces to the perfect square
+\begin{equation}
+  \label{eq:triad:perfect-square}
+  -\Alts_i^k{\:} _i^k\mathbb{V}_{i_p}^{k_p}
+  \left(
+    \frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    -{\:}_i^k\mathbb{R}_{i_p}^{k_p}
+    \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+  \right)^2\leq 0.
+\end{equation}
+Thus, the constraint \eqref{eq:triad:V-A} ensures that the fluxes (\ref{eq:triad:latflux-triad}, \ref{eq:triad:vertflux-triad}) associated
+with a given slope triad $_i^k\mathbb{R}_{i_p}^{k_p}$ do not increase
+the net variance. Since the total fluxes are sums of such fluxes from
+the various triads, this constraint, applied to all triads, is
+sufficient to ensure that the globally integrated variance does not
+increase.
+
+The expression \eqref{eq:triad:V-A} can be interpreted as a discretization
+of the global integral
+\begin{equation}
+  \label{eq:triad:cts-var}
+  \frac{\partial}{\partial t}\int\!\half T^2\, dV =
+  \int\!\mathbf{F}\cdot\nabla T\, dV,
+\end{equation}
+where, within each triad volume $_i^k\mathbb{V}_{i_p}^{k_p}$, the
+lateral and vertical fluxes/unit area
+\[
+\mathbf{F}=\left(
+\left.{}_i^k{\mathbb{F}_u}_{i_p}^{k_p} (T)\right/{}_i^k{\mathbb{A}_u}_{i_p}^{k_p},
+\left.{\:}_i^k{\mathbb{F}_w}_{i_p}^{k_p} (T)\right/{}_i^k{\mathbb{A}_w}_{i_p}^{k_p}
+ \right)
+\]
+and the gradient
+ \[\nabla T = \left(
+\left.\delta_{i+ i_p}[T^k] \right/ {e_{1u}}_{\,i + i_p}^{\,k},
+\left.\delta_{k+ k_p}[T^i] \right/ {e_{3w}}_{\,i}^{\,k + k_p}
+\right)
+\]
+\subsection{Triad volumes in Griffes's scheme and in \NEMO}
+To complete the discretization we now need only specify the triad
+volumes $_i^k\mathbb{V}_{i_p}^{k_p}$. \citet{Griffies_al_JPO98} identify
+these $_i^k\mathbb{V}_{i_p}^{k_p}$ as the volumes of the quarter
+cells, defined in terms of the distances between $T$, $u$,$f$ and
+$w$-points. This is the natural discretization of
+\eqref{eq:triad:cts-var}. The \NEMO model, however, operates with scale
+factors instead of grid sizes, and scale factors for the quarter
+cells are not defined. Instead, therefore we simply choose
+\begin{equation}
+  \label{eq:triad:V-NEMO}
+  _i^k\mathbb{V}_{i_p}^{k_p}=\quarter {b_u}_{i+i_p}^k,
+\end{equation}
+as a quarter of the volume of the $u$-cell inside which the triad
+quarter-cell lies. This has the nice property that when the slopes
+$\mathbb{R}$ vanish, the lateral flux from tracer cell $i,k$ to
+$i+1,k$ reduces to the classical form
+\begin{equation}
+  \label{eq:triad:lat-normal}
+-\overline\Alts_{\,i+1/2}^k\;
+\frac{{b_u}_{i+1/2}^k}{{e_{1u}}_{\,i + i_p}^{\,k}}
+\;\frac{\delta_{i+ 1/2}[T^k] }{{e_{1u}}_{\,i + i_p}^{\,k}}
+ = -\overline\Alts_{\,i+1/2}^k\;\frac{{e_{1w}}_{\,i + 1/2}^{\,k}\:{e_{1v}}_{\,i + 1/2}^{\,k}\;\delta_{i+ 1/2}[T^k]}{{e_{1u}}_{\,i + 1/2}^{\,k}}.
+\end{equation}
+In fact if the diffusive coefficient is defined at $u$-points, so that
+we employ $\Alts_{i+i_p}^k$ instead of  $\Alts_i^k$ in the definitions of the
+triad fluxes \eqref{eq:triad:latflux-triad} and \eqref{eq:triad:vertflux-triad},
+we can replace $\overline{A}_{\,i+1/2}^k$ by $A_{i+1/2}^k$ in the above.
+
+\subsection{Summary of the scheme}
+The iso-neutral fluxes at $u$- and
+$w$-points are the sums of the triad fluxes that cross the $u$- and
+$w$-faces \eqref{Eq_iso_flux}:
+\begin{subequations}\label{eq:triad:alltriadflux}
+  \begin{flalign}\label{eq:triad:vect_isoflux}
+    \vect{F}_\mathrm{iso}(T) &\equiv
+    \sum_{\substack{i_p,\,k_p}}
+    \begin{pmatrix}
+      {_{i+1/2-i_p}^k {\mathbb{F}_u}_{i_p}^{k_p} } (T)      \\
+      \\
+      {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p} } (T) 
+    \end{pmatrix},
+  \end{flalign}
+  where \eqref{eq:triad:latflux-triad}:
+  \begin{align}
+    \label{eq:triad:triadfluxu}
+    _i^k {\mathbb{F}_u}_{i_p}^{k_p} (T) &= - \Alts_i^k{
+      \:}\frac{{{}_i^k\mathbb{V}}_{i_p}^{k_p}}{{e_{1u}}_{\,i + i_p}^{\,k}}
+    \left(
+      \frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+      -\ {_i^k\mathbb{R}_{i_p}^{k_p}} \
+      \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+    \right),\\
+    \intertext{and}
+    _i^k {\mathbb{F}_w}_{i_p}^{k_p} (T)
+    &= \Alts_i^k{\: }\frac{{{}_i^k\mathbb{V}}_{i_p}^{k_p}}{{e_{3w}}_{\,i}^{\,k+k_p}}
+    \left(
+      {_i^k\mathbb{R}_{i_p}^{k_p}}\frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+      -\ \left({_i^k\mathbb{R}_{i_p}^{k_p}}\right)^2 \
+      \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+    \right),\label{eq:triad:triadfluxw}
+  \end{align}
+  with \eqref{eq:triad:V-NEMO}
+  \begin{equation}
+    \label{eq:triad:V-NEMO2}
+    _i^k{\mathbb{V}}_{i_p}^{k_p}=\quarter {b_u}_{i+i_p}^k.
+  \end{equation}
+\end{subequations}
+
+ The divergence of the expression \eqref{Eq_iso_flux} for the fluxes gives the iso-neutral diffusion tendency at
+each tracer point:
+\begin{equation} \label{eq:triad:iso_operator} D_l^T = \frac{1}{b_T}
+  \sum_{\substack{i_p,\,k_p}} \left\{ \delta_{i} \left[{_{i+1/2-i_p}^k
+        {\mathbb{F}_u }_{i_p}^{k_p}} \right] + \delta_{k} \left[
+      {_i^{k+1/2-k_p} {\mathbb{F}_w}_{i_p}^{k_p}} \right] \right\}
+\end{equation}
+where $b_T= e_{1T}\,e_{2T}\,e_{3T}$ is the volume of $T$-cells.
+The diffusion scheme satisfies the following six properties:
+\begin{description}
+\item[$\bullet$ horizontal diffusion] The discretization of the
+  diffusion operator recovers \eqref{eq:triad:lat-normal} the traditional five-point Laplacian in
+  the limit of flat iso-neutral direction :
+  \begin{equation} \label{eq:triad:iso_property0} D_l^T = \frac{1}{b_T} \
+    \delta_{i} \left[ \frac{e_{2u}\,e_{3u}}{e_{1u}} \;
+      \overline\Alts^{\,i} \; \delta_{i+1/2}[T] \right] \qquad
+    \text{when} \quad { _i^k \mathbb{R}_{i_p}^{k_p} }=0
+  \end{equation}
+
+\item[$\bullet$ implicit treatment in the vertical] Only tracer values
+  associated with a single water column appear in the expression
+  \eqref{eq:triad:i33} for the $_{33}$ fluxes, vertical fluxes driven by
+  vertical gradients. This is of paramount importance since it means
+  that a time-implicit algorithm can be used to solve the vertical
+  diffusion equation. This is necessary
+ since the vertical eddy
+  diffusivity associated with this term,
+  \begin{equation}
+    \frac{1}{b_w}\sum_{\substack{i_p, \,k_p}} \left\{
+      {\:}_i^k\mathbb{V}_{i_p}^{k_p} \: \Alts_i^k \: \left(_i^k \mathbb{R}_{i_p}^{k_p}\right)^2
+    \right\}  =
+    \frac{1}{4b_w}\sum_{\substack{i_p, \,k_p}} \left\{
+      {b_u}_{i+i_p}^k\: \Alts_i^k \: \left(_i^k \mathbb{R}_{i_p}^{k_p}\right)^2
+    \right\},
+ \end{equation}
+  (where $b_w= e_{1w}\,e_{2w}\,e_{3w}$ is the volume of $w$-cells) can be quite large.
+
+\item[$\bullet$ pure iso-neutral operator] The iso-neutral flux of
+  locally referenced potential density is zero. See
+  \eqref{eq:triad:latflux-rho} and \eqref{eq:triad:vertflux-triad2}.
+
+\item[$\bullet$ conservation of tracer] The iso-neutral diffusion
+  conserves tracer content, $i.e.$
+  \begin{equation} \label{eq:triad:iso_property1} \sum_{i,j,k} \left\{ D_l^T \
+      b_T \right\} = 0
+  \end{equation}
+  This property is trivially satisfied since the iso-neutral diffusive
+  operator is written in flux form.
+
+\item[$\bullet$ no increase of tracer variance] The iso-neutral diffusion
+  does not increase the tracer variance, $i.e.$
+  \begin{equation} \label{eq:triad:iso_property2} \sum_{i,j,k} \left\{ T \ D_l^T
+      \ b_T \right\} \leq 0
+  \end{equation}
+  The property is demonstrated in
+  \S\ref{sec:triad:variance} above. It is a key property for a diffusion
+  term. It means that it is also a dissipation term, $i.e.$ it
+  dissipates the square of the quantity on which it is applied.  It
+  therefore ensures that, when the diffusivity coefficient is large
+  enough, the field on which it is applied becomes free of grid-point
+  noise.
+
+\item[$\bullet$ self-adjoint operator] The iso-neutral diffusion
+  operator is self-adjoint, $i.e.$
+  \begin{equation} \label{eq:triad:iso_property3} \sum_{i,j,k} \left\{ S \ D_l^T
+      \ b_T \right\} = \sum_{i,j,k} \left\{ D_l^S \ T \ b_T \right\}
+  \end{equation}
+  In other word, there is no need to develop a specific routine from
+  the adjoint of this operator. We just have to apply the same
+  routine. This property can be demonstrated similarly to the proof of
+  the `no increase of tracer variance' property. The contribution by a
+  single triad towards the left hand side of \eqref{eq:triad:iso_property3}, can
+  be found by replacing $\delta[T]$ by $\delta[S]$ in \eqref{eq:triad:dvar_iso_i}
+  and \eqref{eq:triad:dvar_iso_k}. This results in a term similar to
+  \eqref{eq:triad:perfect-square},
+\begin{equation}
+  \label{eq:triad:TScovar}
+  - \Alts_i^k{\:} _i^k\mathbb{V}_{i_p}^{k_p}
+  \left(
+    \frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    -{\:}_i^k\mathbb{R}_{i_p}^{k_p}
+    \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+  \right)
+  \left(
+    \frac{ \delta_{i+ i_p}[S^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }
+    -{\:}_i^k\mathbb{R}_{i_p}^{k_p}
+    \frac{ \delta_{k+k_p} [S^i] }{{e_{3w}}_{\,i}^{\,k+k_p} }
+  \right).
+\end{equation}
+This is symmetrical in $T $ and $S$, so exactly the same term arises
+from the discretization of this triad's contribution towards the
+RHS of \eqref{eq:triad:iso_property3}.
+\end{description}
+\subsection{Treatment of the triads at the boundaries}\label{sec:triad:iso_bdry}
+The triad slope can only be defined where both the grid boxes centred at
+the end of the arms exist. Triads that would poke up
+through the upper ocean surface into the atmosphere, or down into the
+ocean floor, must be masked out. See Fig.~\ref{fig:triad:bdry_triads}. Surface layer triads
+$\triad{i}{1}{R}{1/2}{-1/2}$ (magenta) and
+$\triad{i+1}{1}{R}{-1/2}{-1/2}$ (blue) that require density to be
+specified above the ocean surface are masked (Fig.~\ref{fig:triad:bdry_triads}a): this ensures that lateral
+tracer gradients produce no flux through the ocean surface. However,
+to prevent surface noise, it is customary to retain the $_{11}$ contributions towards
+the lateral triad fluxes $\triad[u]{i}{1}{F}{1/2}{-1/2}$ and
+$\triad[u]{i+1}{1}{F}{-1/2}{-1/2}$; this drives diapycnal tracer
+fluxes. Similar comments apply to triads that would intersect the
+ocean floor (Fig.~\ref{fig:triad:bdry_triads}b). Note that both near bottom
+triad slopes $\triad{i}{k}{R}{1/2}{1/2}$ and
+$\triad{i+1}{k}{R}{-1/2}{1/2}$ are masked when either of the $i,k+1$
+or $i+1,k+1$ tracer points is masked, i.e.\ the $i,k+1$ $u$-point is
+masked. The associated lateral fluxes (grey-black dashed line) are
+masked if \np{ln\_botmix\_triad}=false, but left unmasked,
+giving bottom mixing, if \np{ln\_botmix\_triad}=true.
+
+The default option \np{ln\_botmix\_triad}=false is suitable when the
+bbl mixing option is enabled (\key{trabbl}, with \np{nn\_bbl\_ldf}=1),
+or  for simple idealized  problems. For setups with topography without
+bbl mixing, \np{ln\_botmix\_triad}=true may be necessary.
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[h] \begin{center}
+    \includegraphics[width=0.60\textwidth]{Fig_GRIFF_bdry_triads}
+    \caption{  \label{fig:triad:bdry_triads}
+      (a) Uppermost model layer $k=1$ with $i,1$ and $i+1,1$ tracer
+      points (black dots), and $i+1/2,1$ $u$-point (blue square). Triad
+      slopes $\triad{i}{1}{R}{1/2}{-1/2}$ (magenta) and $\triad{i+1}{1}{R}{-1/2}{-1/2}$
+      (blue) poking through the ocean surface are masked (faded in
+      figure). However, the lateral $_{11}$ contributions towards
+      $\triad[u]{i}{1}{F}{1/2}{-1/2}$ and $\triad[u]{i+1}{1}{F}{-1/2}{-1/2}$
+      (yellow line) are still applied, giving diapycnal diffusive
+      fluxes.\\
+      (b) Both near bottom triad slopes $\triad{i}{k}{R}{1/2}{1/2}$ and
+      $\triad{i+1}{k}{R}{-1/2}{1/2}$ are masked when either of the $i,k+1$
+      or $i+1,k+1$ tracer points is masked, i.e.\ the $i,k+1$ $u$-point
+      is masked. The associated lateral fluxes (grey-black dashed
+      line) are masked if \np{botmix\_triad}=.false., but left
+      unmasked, giving bottom mixing, if \np{botmix\_triad}=.true.}
+ \end{center} \end{figure}
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\subsection{ Limiting of the slopes within the interior}\label{sec:triad:limit}
+As discussed in \S\ref{LDF_slp_iso}, iso-neutral slopes relative to
+geopotentials must be bounded everywhere, both for consistency with the small-slope
+approximation and for numerical stability \citep{Cox1987,
+  Griffies_Bk04}. The bound chosen in \NEMO is applied to each
+component of the slope separately and has a value of $1/100$ in the ocean interior.
+%, ramping linearly down above 70~m depth to zero at the surface
+It is of course relevant to the iso-neutral slopes $\tilde{r}_i=r_i+\sigma_i$ relative to
+geopotentials (here the $\sigma_i$ are the slopes of the coordinate surfaces relative to
+geopotentials) \eqref{Eq_PE_slopes_eiv} rather than the slope $r_i$ relative to coordinate
+surfaces, so we require
+\begin{equation*}
+  |\tilde{r}_i|\leq \tilde{r}_\mathrm{max}=0.01.
+\end{equation*}
+and then recalculate the slopes $r_i$ relative to coordinates.
+Each individual triad slope
+ \begin{equation}
+   \label{eq:triad:Rtilde}
+_i^k\tilde{\mathbb{R}}_{i_p}^{k_p} = {}_i^k\mathbb{R}_{i_p}^{k_p}  + \frac{\delta_{i+i_p}[z_T^k]}{{e_{1u}}_{\,i + i_p}^{\,k}}
+ \end{equation}
+is limited like this and then the corresponding
+$_i^k\mathbb{R}_{i_p}^{k_p} $ are recalculated and combined to form the fluxes.
+Note that where the slopes have been limited, there is now a non-zero
+iso-neutral density flux that drives dianeutral mixing.  In particular this iso-neutral density flux
+is always downwards, and so acts to reduce gravitational potential energy.
+\subsection{Tapering within the surface mixed layer}\label{sec:triad:taper}
+
+Additional tapering of the iso-neutral fluxes is necessary within the
+surface mixed layer. When the Griffies triads are used, we offer two
+options for this.
+\subsubsection{Linear slope tapering within the surface mixed layer}\label{sec:triad:lintaper}
+This is the option activated by the default choice
+\np{ln\_triad\_iso}=false. Slopes $\tilde{r}_i$ relative to
+geopotentials are tapered linearly from their value immediately below the mixed layer to zero at the
+surface, as described in option (c) of Fig.~\ref{Fig_eiv_slp}, to values
+\begin{subequations}
+  \begin{equation}
+   \label{eq:triad:rmtilde}
+     \rMLt =
+  -\frac{z}{h}\left.\tilde{r}_i\right|_{z=-h}\quad \text{ for  } z>-h,
+  \end{equation}
+and then the $r_i$ relative to vertical coordinate surfaces are appropriately
+adjusted to
+  \begin{equation}
+   \label{eq:triad:rm}
+ \rML =\rMLt -\sigma_i \quad \text{ for  } z>-h.
+  \end{equation}
+\end{subequations}
+Thus the diffusion operator within the mixed layer is given by:
+\begin{equation} \label{eq:triad:iso_tensor_ML}
+D^{lT}=\nabla {\rm {\bf .}}\left( {A^{lT}\;\Re \;\nabla T} \right) \qquad
+\mbox{with}\quad \;\;\Re =\left( {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill & {-\rML[1]}\hfill \\
+ 0 \hfill & 1 \hfill & {-\rML[2]} \hfill \\
+ {-\rML[1]}\hfill &   {-\rML[2]} \hfill & {\rML[1]^2+\rML[2]^2} \hfill
+\end{array} }} \right)
+\end{equation}
+
+This slope tapering gives a natural connection between tracer in the
+mixed-layer and in isopycnal layers immediately below, in the
+thermocline. It is consistent with the way the $\tilde{r}_i$ are
+tapered within the mixed layer (see \S\ref{sec:triad:taperskew} below)
+so as to ensure a uniform GM eddy-induced velocity throughout the
+mixed layer. However, it gives a downwards density flux and so acts so
+as to reduce potential energy in the same way as does the slope
+limiting discussed above in \S\ref{sec:triad:limit}.
+ 
+As in \S\ref{sec:triad:limit} above, the tapering
+\eqref{eq:triad:rmtilde} is applied separately to each triad
+$_i^k\tilde{\mathbb{R}}_{i_p}^{k_p}$, and the
+$_i^k\mathbb{R}_{i_p}^{k_p}$ adjusted. For clarity, we assume
+$z$-coordinates in the following; the conversion from
+$\mathbb{R}$ to $\tilde{\mathbb{R}}$ and back to $\mathbb{R}$ follows exactly as described
+above by \eqref{eq:triad:Rtilde}.
+\begin{enumerate}
+\item Mixed-layer depth is defined so as to avoid including regions of weak
+vertical stratification in the slope definition.
+ At each $i,j$ (simplified to $i$ in
+Fig.~\ref{fig:triad:MLB_triad}), we define the mixed-layer by setting
+the vertical index of the tracer point immediately below the mixed
+layer, $k_\mathrm{ML}$, as the maximum $k$ (shallowest tracer point)
+such that the potential density
+${\rho_0}_{i,k}>{\rho_0}_{i,k_{10}}+\Delta\rho_c$, where $i,k_{10}$ is
+the tracer gridbox within which the depth reaches 10~m. See the left
+side of Fig.~\ref{fig:triad:MLB_triad}. We use the $k_{10}$-gridbox
+instead of the surface gridbox to avoid problems e.g.\ with thin
+daytime mixed-layers. Currently we use the same
+$\Delta\rho_c=0.01\;\mathrm{kg\:m^{-3}}$ for ML triad tapering as is
+used to output the diagnosed mixed-layer depth
+$h_\mathrm{ML}=|z_{W}|_{k_\mathrm{ML}+1/2}$, the depth of the $w$-point
+above the $i,k_\mathrm{ML}$ tracer point.
+
+\item We define `basal' triad slopes
+${\:}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p}$ as the slopes
+of those triads whose vertical `arms' go down from the
+$i,k_\mathrm{ML}$ tracer point to the $i,k_\mathrm{ML}-1$ tracer point
+below. This is to ensure that the vertical density gradients
+associated with these basal triad slopes
+${\:}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p}$ are
+representative of the thermocline. The four basal triads defined in the bottom part
+of Fig.~\ref{fig:triad:MLB_triad} are then
+\begin{align}
+  {\:}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p} &=
+ {\:}^{k_\mathrm{ML}-k_p-1/2}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p}, \label{eq:triad:Rbase}
+\\
+\intertext{with e.g.\ the green triad}
+{\:}_i{\mathbb{R}_\mathrm{base}}_{1/2}^{-1/2}&=
+{\:}^{k_\mathrm{ML}}_i{\mathbb{R}_\mathrm{base}}_{\,1/2}^{-1/2}. \notag
+\end{align}
+The vertical flux associated with each of these triads passes through the $w$-point
+$i,k_\mathrm{ML}-1/2$ lying \emph{below} the $i,k_\mathrm{ML}$ tracer point,
+so it is this depth
+\begin{equation}
+  \label{eq:triad:zbase}
+  {z_\mathrm{base}}_{\,i}={z_{w}}_{k_\mathrm{ML}-1/2}
+\end{equation}
+(one gridbox deeper than the
+diagnosed ML depth $z_\mathrm{ML})$ that sets the $h$ used to taper
+the slopes in \eqref{eq:triad:rmtilde}.
+\item Finally, we calculate the adjusted triads
+${\:}_i^k{\mathbb{R}_\mathrm{ML}}_{\,i_p}^{k_p}$ within the mixed
+layer, by multiplying the appropriate
+${\:}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p}$ by the ratio of
+the depth of the $w$-point ${z_w}_{k+k_p}$ to ${z_\mathrm{base}}_{\,i}$. For
+instance the green triad centred on $i,k$
+\begin{align}
+  {\:}_i^k{\mathbb{R}_\mathrm{ML}}_{\,1/2}^{-1/2} &=
+\frac{{z_w}_{k-1/2}}{{z_\mathrm{base}}_{\,i}}{\:}_i{\mathbb{R}_\mathrm{base}}_{\,1/2}^{-1/2}
+\notag \\
+\intertext{and more generally}
+ {\:}_i^k{\mathbb{R}_\mathrm{ML}}_{\,i_p}^{k_p} &=
+\frac{{z_w}_{k+k_p}}{{z_\mathrm{base}}_{\,i}}{\:}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p}.\label{eq:triad:RML}
+\end{align}
+\end{enumerate}
+
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[h]
+  \fcapside {\caption{\label{fig:triad:MLB_triad} Definition of
+      mixed-layer depth and calculation of linearly tapered
+      triads. The figure shows a water column at a given $i,j$
+      (simplified to $i$), with the ocean surface at the top. Tracer points are denoted by
+      bullets, and black lines the edges of the tracer cells; $k$
+      increases upwards. \\
+      \hspace{5 em}We define the mixed-layer by setting the vertical index
+      of the tracer point immediately below the mixed layer,
+      $k_\mathrm{ML}$, as the maximum $k$ (shallowest tracer point)
+      such that ${\rho_0}_{i,k}>{\rho_0}_{i,k_{10}}+\Delta\rho_c$,
+      where $i,k_{10}$ is the tracer gridbox within which the depth
+      reaches 10~m. We calculate the triad slopes within the mixed
+      layer by linearly tapering them from zero (at the surface) to
+      the `basal' slopes, the slopes of the four triads passing through the
+      $w$-point $i,k_\mathrm{ML}-1/2$ (blue square),
+      ${\:}_i{\mathbb{R}_\mathrm{base}}_{\,i_p}^{k_p}$. Triads with
+    different $i_p,k_p$, denoted by different colours, (e.g. the green
+    triad $i_p=1/2,k_p=-1/2$) are tapered to the appropriate basal triad.}}
+  {\includegraphics[width=0.60\textwidth]{Fig_GRIFF_MLB_triads}}
+\end{figure}
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\subsubsection{Additional truncation of skew iso-neutral flux
+  components}
+\label{sec:triad:Gerdes-taper}
+The alternative option is activated by setting \np{ln\_triad\_iso} =
+  true. This retains the same tapered slope $\rML$  described above for the
+calculation of the $_{33}$ term of the iso-neutral diffusion tensor (the
+vertical tracer flux driven by vertical tracer gradients), but
+replaces the $\rML$ in the skew term by
+\begin{equation}
+  \label{eq:triad:rm*}
+  \rML^*=\left.\rMLt^2\right/\tilde{r}_i-\sigma_i,
+\end{equation}
+giving a ML diffusive operator
+\begin{equation} \label{eq:triad:iso_tensor_ML2}
+D^{lT}=\nabla {\rm {\bf .}}\left( {A^{lT}\;\Re \;\nabla T} \right) \qquad
+\mbox{with}\quad \;\;\Re =\left( {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill & {-\rML[1]^*}\hfill \\
+ 0 \hfill & 1 \hfill & {-\rML[2]^*} \hfill \\
+ {-\rML[1]^*}\hfill &   {-\rML[2]^*} \hfill & {\rML[1]^2+\rML[2]^2} \hfill \\
+\end{array} }} \right).
+\end{equation}
+This operator
+\footnote{To ensure good behaviour where horizontal density
+  gradients are weak, we in fact follow \citet{Gerdes1991} and set
+$\rML^*=\mathrm{sgn}(\tilde{r}_i)\min(|\rMLt^2/\tilde{r}_i|,|\tilde{r}_i|)-\sigma_i$.}
+then has the property it gives no vertical density flux, and so does
+not change the potential energy.
+This approach is similar to multiplying the iso-neutral  diffusion
+coefficient by $\tilde{r}_\mathrm{max}^{-2}\tilde{r}_i^{-2}$ for steep
+slopes, as suggested by \citet{Gerdes1991} (see also \citet{Griffies_Bk04}).
+Again it is applied separately to each triad $_i^k\mathbb{R}_{i_p}^{k_p}$
+
+In practice, this approach gives weak vertical tracer fluxes through
+the mixed-layer, as well as vanishing density fluxes. While it is
+theoretically advantageous that it does not change the potential
+energy, it may give a discontinuity between the
+fluxes within the mixed-layer (purely horizontal) and just below (along
+iso-neutral surfaces).
+% This may give strange looking results,
+% particularly where the mixed-layer depth varies strongly laterally.
+% ================================================================
+% Skew flux formulation for Eddy Induced Velocity :
+% ================================================================
+\section{Eddy induced advection formulated as a skew flux}\label{sec:triad:skew-flux}
+
+\subsection{The continuous skew flux formulation}\label{sec:triad:continuous-skew-flux}
+
+ When Gent and McWilliams's [1990] diffusion is used,
+an additional advection term is added. The associated velocity is the so called
+eddy induced velocity, the formulation of which depends on the slopes of iso-
+neutral surfaces. Contrary to the case of iso-neutral mixing, the slopes used
+here are referenced to the geopotential surfaces, $i.e.$ \eqref{Eq_ldfslp_geo}
+is used in $z$-coordinate, and the sum \eqref{Eq_ldfslp_geo}
++ \eqref{Eq_ldfslp_iso} in $z^*$ or $s$-coordinates.
+
+The eddy induced velocity is given by:
+\begin{subequations} \label{eq:triad:eiv}
+\begin{equation}\label{eq:triad:eiv_v}
+\begin{split}
+ u^* & = - \frac{1}{e_{3}}\;          \partial_i\psi_1,  \\
+ v^* & = - \frac{1}{e_{3}}\;          \partial_j\psi_2,    \\
+w^* & =    \frac{1}{e_{1}e_{2}}\; \left\{ \partial_i  \left( e_{2} \, \psi_1\right)
+							    + \partial_j  \left( e_{1} \, \psi_2\right) \right\},
+\end{split}
+\end{equation}
+where the streamfunctions $\psi_i$ are given by
+\begin{equation} \label{eq:triad:eiv_psi}
+\begin{split}
+\psi_1 & = A_{e} \; \tilde{r}_1,   \\
+\psi_2 & = A_{e} \; \tilde{r}_2,
+\end{split}
+\end{equation}
+\end{subequations}
+with $A_{e}$ the eddy induced velocity coefficient, and $\tilde{r}_1$ and $\tilde{r}_2$ the slopes between the iso-neutral and the geopotential surfaces.
+
+The traditional way to implement this additional advection is to add
+it to the Eulerian velocity prior to computing the tracer
+advection. This is implemented if \key{traldf\_eiv} is set in the
+default implementation, where \np{ln\_traldf\_triad} is set
+false. This allows us to take advantage of all the advection schemes
+offered for the tracers (see \S\ref{TRA_adv}) and not just a $2^{nd}$
+order advection scheme. This is particularly useful for passive
+tracers where \emph{positivity} of the advection scheme is of
+paramount importance.
+
+However, when \np{ln\_traldf\_triad} is set true, \NEMO instead
+implements eddy induced advection according to the so-called skew form
+\citep{Griffies_JPO98}. It is based on a transformation of the advective fluxes
+using the non-divergent nature of the eddy induced velocity.
+For example in the (\textbf{i},\textbf{k}) plane, the tracer advective
+fluxes per unit area in $ijk$ space can be
+transformed as follows:
+\begin{flalign*}
+\begin{split}
+\textbf{F}_\mathrm{eiv}^T =
+\begin{pmatrix}
+ 	        {e_{2}\,e_{3}\;  u^*} 	 	\\
+ 		{e_{1}\,e_{2}\; w^*}	 \\
+\end{pmatrix}   \;   T
+&=
+\begin{pmatrix}
+ 	        { - \partial_k \left( e_{2} \,\psi_1 \right) \; T \;} 	 	\\
+ 		{+ \partial_i  \left( e_{2} \, \psi_1 \right) \; T \;}	 \\
+\end{pmatrix} 			\\
+&=
+\begin{pmatrix}
+ 	        { - \partial_k \left( e_{2} \, \psi_1  \; T \right) \;}  \\
+ 		{+ \partial_i  \left( e_{2} \,\psi_1 \; T \right) \;}	 \\
+\end{pmatrix}
+ +
+\begin{pmatrix}
+ 	        {+ e_{2} \, \psi_1  \; \partial_k T}  \\
+ 		{ - e_{2} \, \psi_1  \; \partial_i  T}	 \\
+\end{pmatrix}
+\end{split}
+\end{flalign*}
+and since the eddy induced velocity field is non-divergent, we end up with the skew
+form of the eddy induced advective fluxes per unit area in $ijk$ space:
+\begin{equation} \label{eq:triad:eiv_skew_ijk}
+\textbf{F}_\mathrm{eiv}^T = \begin{pmatrix}
+ 	        {+ e_{2} \, \psi_1  \; \partial_k T}   \\
+ 		{ - e_{2} \, \psi_1  \; \partial_i  T}	 \\
+                                 \end{pmatrix}
+\end{equation}
+The total fluxes per unit physical area are then
+\begin{equation}\label{eq:triad:eiv_skew_physical}
+\begin{split}
+ f^*_1 & = \frac{1}{e_{3}}\; \psi_1 \partial_k T   \\
+ f^*_2 & = \frac{1}{e_{3}}\; \psi_2 \partial_k T   \\
+ f^*_3 & =  -\frac{1}{e_{1}e_{2}}\; \left\{ e_{2} \psi_1 \partial_i T
+   + e_{1} \psi_2 \partial_j T \right\}. \\
+\end{split}
+\end{equation}
+Note that Eq.~ \eqref{eq:triad:eiv_skew_physical} takes the same form whatever the
+vertical coordinate, though of course the slopes
+$\tilde{r}_i$ which define the $\psi_i$ in \eqref{eq:triad:eiv_psi} are relative to geopotentials.
+The tendency associated with eddy induced velocity is then simply the convergence
+of the fluxes (\ref{eq:triad:eiv_skew_ijk}, \ref{eq:triad:eiv_skew_physical}), so
+\begin{equation} \label{eq:triad:skew_eiv_conv}
+\frac{\partial T}{\partial t}= -\frac{1}{e_1 \, e_2 \, e_3 }      \left[
+  \frac{\partial}{\partial i} \left( e_2 \psi_1 \partial_k T\right)
+  + \frac{\partial}{\partial j} \left( e_1  \;
+    \psi_2 \partial_k T\right)
+ -  \frac{\partial}{\partial k} \left( e_{2} \psi_1 \partial_i T
+   + e_{1} \psi_2 \partial_j T \right)  \right]
+\end{equation}
+ It naturally conserves the tracer content, as it is expressed in flux
+ form. Since it has the same divergence as the advective form it also
+ preserves the tracer variance.
+
+\subsection{The discrete skew flux formulation}
+The skew fluxes in (\ref{eq:triad:eiv_skew_physical}, \ref{eq:triad:eiv_skew_ijk}), like the off-diagonal terms
+(\ref{eq:triad:i13c}, \ref{eq:triad:i31c}) of the small angle diffusion tensor, are best
+expressed in terms of the triad slopes, as in Fig.~\ref{fig:triad:ISO_triad}
+and Eqs~(\ref{eq:triad:i13}, \ref{eq:triad:i31}); but now in terms of the triad slopes
+$\tilde{\mathbb{R}}$ relative to geopotentials instead of the
+$\mathbb{R}$ relative to coordinate surfaces. The discrete form of
+\eqref{eq:triad:eiv_skew_ijk} using the slopes \eqref{eq:triad:R} and
+defining $A_e$ at $T$-points is then given by:
+
+
+\begin{subequations}\label{eq:triad:allskewflux}
+  \begin{flalign}\label{eq:triad:vect_skew_flux}
+    \vect{F}_\mathrm{eiv}(T) &\equiv
+    \sum_{\substack{i_p,\,k_p}}
+    \begin{pmatrix}
+      {_{i+1/2-i_p}^k {\mathbb{S}_u}_{i_p}^{k_p} } (T)      \\
+      \\
+      {_i^{k+1/2-k_p} {\mathbb{S}_w}_{i_p}^{k_p} } (T)      \\
+    \end{pmatrix},
+  \end{flalign}
+  where the skew flux in the $i$-direction associated with a given
+  triad is (\ref{eq:triad:latflux-triad}, \ref{eq:triad:triadfluxu}):
+  \begin{align}
+    \label{eq:triad:skewfluxu}
+    _i^k {\mathbb{S}_u}_{i_p}^{k_p} (T) &= + \quarter {A_e}_i^k{
+      \:}\frac{{b_u}_{i+i_p}^k}{{e_{1u}}_{\,i + i_p}^{\,k}}
+     \ {_i^k\tilde{\mathbb{R}}_{i_p}^{k_p}} \
+      \frac{ \delta_{k+k_p} [T^i] }{{e_{3w}}_{\,i}^{\,k+k_p} },
+   \\
+    \intertext{and \eqref{eq:triad:triadfluxw} in the $k$-direction, changing the sign
+      to be consistent with \eqref{eq:triad:eiv_skew_ijk}:}
+    _i^k {\mathbb{S}_w}_{i_p}^{k_p} (T)
+    &= -\quarter {A_e}_i^k{\: }\frac{{b_u}_{i+i_p}^k}{{e_{3w}}_{\,i}^{\,k+k_p}}
+     {_i^k\tilde{\mathbb{R}}_{i_p}^{k_p}}\frac{ \delta_{i+ i_p}[T^k] }{ {e_{1u}}_{\,i + i_p}^{\,k} }.\label{eq:triad:skewfluxw}
+  \end{align}
+\end{subequations}
+
+Such a discretisation is consistent with the iso-neutral
+operator as it uses the same definition for the slopes.  It also
+ensures the following two key properties.
+\subsubsection{No change in tracer variance}
+The discretization conserves tracer variance, $i.e.$ it does not
+include a diffusive component but is a `pure' advection term. This can
+be seen
+%either from Appendix \ref{Apdx_eiv_skew} or
+by considering the
+fluxes associated with a given triad slope
+$_i^k{\mathbb{R}}_{i_p}^{k_p} (T)$. For, following
+\S\ref{sec:triad:variance} and \eqref{eq:triad:dvar_iso_i}, the
+associated horizontal skew-flux $_i^k{\mathbb{S}_u}_{i_p}^{k_p} (T)$
+drives a net rate of change of variance, summed over the two
+$T$-points $i+i_p-\half,k$ and $i+i_p+\half,k$, of
+\begin{equation}
+\label{eq:triad:dvar_eiv_i}
+  _i^k{\mathbb{S}_u}_{i_p}^{k_p} (T)\,\delta_{i+ i_p}[T^k],
+\end{equation}
+while the associated vertical skew-flux gives a variance change summed over the
+$T$-points $i,k+k_p-\half$ (above) and $i,k+k_p+\half$ (below) of
+\begin{equation}
+\label{eq:triad:dvar_eiv_k}
+  _i^k{\mathbb{S}_w}_{i_p}^{k_p} (T) \,\delta_{k+ k_p}[T^i].
+\end{equation}
+Inspection of the definitions (\ref{eq:triad:skewfluxu}, \ref{eq:triad:skewfluxw})
+shows that these two variance changes (\ref{eq:triad:dvar_eiv_i}, \ref{eq:triad:dvar_eiv_k})
+sum to zero. Hence the two fluxes associated with each triad make no
+net contribution to the variance budget.
+
+\subsubsection{Reduction in gravitational PE}
+The vertical density flux associated with the vertical skew-flux
+always has the same sign as the vertical density gradient; thus, so
+long as the fluid is stable (the vertical density gradient is
+negative) the vertical density flux is negative (downward) and hence
+reduces the gravitational PE.
+
+For the change in gravitational PE driven by the $k$-flux is
+\begin{align}
+  \label{eq:triad:vert_densityPE}
+  g {e_{3w}}_{\,i}^{\,k+k_p}{\mathbb{S}_w}_{i_p}^{k_p} (\rho)
+  &=g {e_{3w}}_{\,i}^{\,k+k_p}\left[-\alpha _i^k {\:}_i^k
+    {\mathbb{S}_w}_{i_p}^{k_p} (T) + \beta_i^k {\:}_i^k
+    {\mathbb{S}_w}_{i_p}^{k_p} (S) \right]. \notag \\
+\intertext{Substituting  ${\:}_i^k {\mathbb{S}_w}_{i_p}^{k_p}$ from
+  \eqref{eq:triad:skewfluxw}, gives}
+% and separating out
+% $\rtriadt{R}=\rtriad{R} + \delta_{i+i_p}[z_T^k]$,
+% gives two terms. The
+% first $\rtriad{R}$ term (the only term for $z$-coordinates) is:
+ &=-\quarter g{A_e}_i^k{\: }{b_u}_{i+i_p}^k {_i^k\tilde{\mathbb{R}}_{i_p}^{k_p}}
+\frac{ -\alpha _i^k\delta_{i+ i_p}[T^k]+ \beta_i^k\delta_{i+ i_p}[S^k]} { {e_{1u}}_{\,i + i_p}^{\,k} } \notag \\
+ &=+\quarter g{A_e}_i^k{\: }{b_u}_{i+i_p}^k
+     \left({_i^k\mathbb{R}_{i_p}^{k_p}}+\frac{\delta_{i+i_p}[z_T^k]}{{e_{1u}}_{\,i + i_p}^{\,k}}\right) {_i^k\mathbb{R}_{i_p}^{k_p}}
+\frac{-\alpha_i^k \delta_{k+ k_p}[T^i]+ \beta_i^k\delta_{k+ k_p}[S^i]} {{e_{3w}}_{\,i}^{\,k+k_p}},
+\end{align}
+using the definition of the triad slope $\rtriad{R}$,
+\eqref{eq:triad:R} to express $-\alpha _i^k\delta_{i+ i_p}[T^k]+
+\beta_i^k\delta_{i+ i_p}[S^k]$ in terms of  $-\alpha_i^k \delta_{k+
+  k_p}[T^i]+ \beta_i^k\delta_{k+ k_p}[S^i]$.
+
+Where the coordinates slope, the $i$-flux gives a PE change
+\begin{multline}
+  \label{eq:triad:lat_densityPE}
+ g \delta_{i+i_p}[z_T^k]
+\left[
+-\alpha _i^k {\:}_i^k {\mathbb{S}_u}_{i_p}^{k_p} (T) + \beta_i^k {\:}_i^k {\mathbb{S}_u}_{i_p}^{k_p} (S)
+\right] \\
+= +\quarter g{A_e}_i^k{\: }{b_u}_{i+i_p}^k
+     \frac{\delta_{i+i_p}[z_T^k]}{{e_{1u}}_{\,i + i_p}^{\,k}}
+\left({_i^k\mathbb{R}_{i_p}^{k_p}}+\frac{\delta_{i+i_p}[z_T^k]}{{e_{1u}}_{\,i + i_p}^{\,k}}\right)
+\frac{-\alpha_i^k \delta_{k+ k_p}[T^i]+ \beta_i^k\delta_{k+ k_p}[S^i]} {{e_{3w}}_{\,i}^{\,k+k_p}},
+\end{multline}
+(using \eqref{eq:triad:skewfluxu}) and so the total PE change
+\eqref{eq:triad:vert_densityPE} + \eqref{eq:triad:lat_densityPE} associated with the triad fluxes is
+\begin{multline}
+  \label{eq:triad:tot_densityPE}
+  g{e_{3w}}_{\,i}^{\,k+k_p}{\mathbb{S}_w}_{i_p}^{k_p} (\rho) +
+g\delta_{i+i_p}[z_T^k] {\:}_i^k {\mathbb{S}_u}_{i_p}^{k_p} (\rho) \\
+= +\quarter g{A_e}_i^k{\: }{b_u}_{i+i_p}^k
+     \left({_i^k\mathbb{R}_{i_p}^{k_p}}+\frac{\delta_{i+i_p}[z_T^k]}{{e_{1u}}_{\,i + i_p}^{\,k}}\right)^2
+\frac{-\alpha_i^k \delta_{k+ k_p}[T^i]+ \beta_i^k\delta_{k+ k_p}[S^i]} {{e_{3w}}_{\,i}^{\,k+k_p}}.
+\end{multline}
+Where the fluid is stable, with $-\alpha_i^k \delta_{k+ k_p}[T^i]+
+\beta_i^k\delta_{k+ k_p}[S^i]<0$, this PE change is negative.
+
+\subsection{Treatment of the triads at the boundaries}\label{sec:triad:skew_bdry}
+Triad slopes \rtriadt{R} used for the calculation of the eddy-induced skew-fluxes
+are masked at the boundaries in exactly the same way as are the triad
+slopes \rtriad{R} used for the iso-neutral diffusive fluxes, as
+described in \S\ref{sec:triad:iso_bdry} and
+Fig.~\ref{fig:triad:bdry_triads}. Thus surface layer triads
+$\triadt{i}{1}{R}{1/2}{-1/2}$ and $\triadt{i+1}{1}{R}{-1/2}{-1/2}$ are
+masked, and both near bottom triad slopes $\triadt{i}{k}{R}{1/2}{1/2}$
+and $\triadt{i+1}{k}{R}{-1/2}{1/2}$ are masked when either of the
+$i,k+1$ or $i+1,k+1$ tracer points is masked, i.e.\ the $i,k+1$
+$u$-point is masked. The namelist parameter \np{ln\_botmix\_triad} has
+no effect on the eddy-induced skew-fluxes.
+
+\subsection{ Limiting of the slopes within the interior}\label{sec:triad:limitskew}
+Presently, the iso-neutral slopes $\tilde{r}_i$ relative
+to geopotentials are limited to be less than $1/100$, exactly as in
+calculating the iso-neutral diffusion, \S \ref{sec:triad:limit}. Each
+individual triad \rtriadt{R} is so limited.
+
+\subsection{Tapering within the surface mixed layer}\label{sec:triad:taperskew}
+The slopes $\tilde{r}_i$ relative to
+geopotentials (and thus the individual triads \rtriadt{R}) are always tapered linearly from their value immediately below the mixed layer to zero at the
+surface \eqref{eq:triad:rmtilde}, as described in \S\ref{sec:triad:lintaper}. This is
+option (c) of Fig.~\ref{Fig_eiv_slp}. This linear tapering for the
+slopes used to calculate the eddy-induced fluxes is
+unaffected by the value of \np{ln\_triad\_iso}.
+
+The justification for this linear slope tapering is that, for $A_e$
+that is constant or varies only in the horizontal (the most commonly
+used options in \NEMO: see \S\ref{LDF_coef}), it is
+equivalent to a horizontal eiv (eddy-induced velocity) that is uniform
+within the mixed layer \eqref{eq:triad:eiv_v}. This ensures that the
+eiv velocities do not restratify the mixed layer \citep{Treguier1997,
+  Danabasoglu_al_2008}. Equivantly, in terms
+of the skew-flux formulation we use here, the
+linear slope tapering within the mixed-layer gives a linearly varying
+vertical flux, and so a tracer convergence uniform in depth (the
+horizontal flux convergence is relatively insignificant within the mixed-layer).
+
+\subsection{Streamfunction diagnostics}\label{sec:triad:sfdiag}
+Where the namelist parameter \np{ln\_traldf\_gdia}=true, diagnosed
+mean eddy-induced velocities are output. Each time step,
+streamfunctions are calculated in the $i$-$k$ and $j$-$k$ planes at
+$uw$ (integer +1/2 $i$, integer $j$, integer +1/2 $k$) and $vw$
+(integer $i$, integer +1/2 $j$, integer +1/2 $k$) points (see Table
+\ref{Tab_cell}) respectively. We follow \citep{Griffies_Bk04} and
+calculate the streamfunction at a given $uw$-point from the
+surrounding four triads according to:
+\begin{equation}
+  \label{eq:triad:sfdiagi}
+  {\psi_1}_{i+1/2}^{k+1/2}={\quarter}\sum_{\substack{i_p,\,k_p}}
+  {A_e}_{i+1/2-i_p}^{k+1/2-k_p}\:\triadd{i+1/2-i_p}{k+1/2-k_p}{R}{i_p}{k_p}.
+\end{equation}
+The streamfunction $\psi_1$ is calculated similarly at $vw$ points.
+The eddy-induced velocities are then calculated from the
+straightforward discretisation of \eqref{eq:triad:eiv_v}:
+\begin{equation}\label{eq:triad:eiv_v_discrete}
+\begin{split}
+ {u^*}_{i+1/2}^{k} & = - \frac{1}{{e_{3u}}_{i}^{k}}\left({\psi_1}_{i+1/2}^{k+1/2}-{\psi_1}_{i+1/2}^{k+1/2}\right),   \\
+ {v^*}_{j+1/2}^{k} & = - \frac{1}{{e_{3v}}_{j}^{k}}\left({\psi_2}_{j+1/2}^{k+1/2}-{\psi_2}_{j+1/2}^{k+1/2}\right),   \\
+ {w^*}_{i,j}^{k+1/2} & =    \frac{1}{e_{1t}e_{2t}}\; \left\{
+ {e_{2u}}_{i+1/2}^{k+1/2} \,{\psi_1}_{i+1/2}^{k+1/2} -
+ {e_{2u}}_{i-1/2}^{k+1/2} \,{\psi_1}_{i-1/2}^{k+1/2} \right. + \\
+\phantom{=} & \qquad\qquad\left. {e_{2v}}_{j+1/2}^{k+1/2} \,{\psi_2}_{j+1/2}^{k+1/2} - {e_{2v}}_{j-1/2}^{k+1/2} \,{\psi_2}_{j-1/2}^{k+1/2} \right\},
+\end{split}
+\end{equation}
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_ASM.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_ASM.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_ASM.tex	(revision 8732)
@@ -0,0 +1,176 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter Assimilation increments (ASM)
+% ================================================================
+\chapter{Apply assimilation increments (ASM)}
+\label{ASM}
+
+Authors: D. Lea,  M. Martin, K. Mogensen, A. Weaver, ...   % do we keep
+
+\minitoc
+
+
+\newpage
+$\ $\newline    % force a new line
+
+The ASM code adds the functionality to apply increments to the model variables: 
+temperature, salinity, sea surface height, velocity and sea ice concentration. 
+These are read into the model from a NetCDF file which may be produced by separate data
+assimilation code.  The code can also output model background fields which are used
+as an input to data assimilation code. This is all controlled by the namelist
+\textit{\ngn{nam\_asminc} }.  There is a brief description of all the namelist options
+provided.  To build the ASM code \key{asminc} must be set.
+
+%===============================================================
+
+\section{Direct initialization}
+\label{ASM_DI}
+
+Direct initialization (DI) refers to the instantaneous correction
+of the model background state using the analysis increment.
+DI is used when \np{ln\_asmdin} is set to true.
+
+\section{Incremental Analysis Updates}
+\label{ASM_IAU}
+
+Rather than updating the model state directly with the analysis increment,
+it may be preferable to introduce the increment gradually into the ocean
+model in order to minimize spurious adjustment processes. This technique
+is referred to as Incremental Analysis Updates (IAU) \citep{Bloom_al_MWR96}.
+IAU is a common technique used with 3D assimilation methods such as 3D-Var or OI.
+IAU is used when \np{ln\_asmiau} is set to true.
+
+With IAU, the model state trajectory ${\bf x}$ in the assimilation window 
+($t_{0} \leq t_{i} \leq t_{N}$)
+is corrected by adding the analysis increments for temperature, salinity, horizontal velocity and SSH
+as additional tendency terms to the prognostic equations:
+\begin{eqnarray}     \label{eq:wa_traj_iau}
+{\bf x}^{a}(t_{i}) = M(t_{i}, t_{0})[{\bf x}^{b}(t_{0})] 
+\; + \; F_{i} \delta \tilde{\bf x}^{a} 
+\end{eqnarray}
+where $F_{i}$ is a weighting function for applying the increments $\delta
+\tilde{\bf x}^{a}$ defined such that $\sum_{i=1}^{N} F_{i}=1$.
+${\bf x}^b$ denotes the model initial state and ${\bf x}^a$ is the model state
+after the increments are applied. 
+To control the adjustment time of the model to the increment,
+the increment can be applied over an arbitrary sub-window,
+$t_{m} \leq t_{i} \leq t_{n}$, of the main assimilation window,
+where $t_{0} \leq t_{m} \leq t_{i}$ and $t_{i} \leq t_{n} \leq t_{N}$,
+Typically the increments are spread evenly over the full window.
+In addition, two different weighting functions have been implemented.
+The first function employs constant weights, 
+\begin{eqnarray}    \label{eq:F1_i}
+F^{(1)}_{i}
+=\left\{ \begin{array}{ll}
+   0     &    {\rm if} \; \; \; t_{i} < t_{m}                \\
+   1/M &    {\rm if} \; \; \; t_{m} < t_{i} \leq t_{n} \\
+   0     &    {\rm if} \; \; \; t_{i} > t_{n}
+  \end{array} \right. 
+\end{eqnarray}
+where $M = m-n$.
+The second function employs peaked hat-like weights in order to give maximum 
+weight in the centre of the sub-window, with the weighting reduced 
+linearly to a small value at the window end-points:
+\begin{eqnarray}     \label{eq:F2_i}
+F^{(2)}_{i}
+=\left\{ \begin{array}{ll}
+   0                           &    {\rm if} \; \; \; t_{i}       <     t_{m}                        \\
+   \alpha \, i               &    {\rm if} \; \; \; t_{m}    \leq t_{i}    \leq   t_{M/2}   \\
+   \alpha \, (M - i +1) &    {\rm if} \; \; \; t_{M/2}  <    t_{i}    \leq   t_{n}       \\
+   0                            &   {\rm if} \; \; \; t_{i}        >    t_{n}
+  \end{array} \right.
+\end{eqnarray}
+where $\alpha^{-1} = \sum_{i=1}^{M/2} 2i$ and $M$ is assumed to be even. 
+The weights described by \eqref{eq:F2_i} provide a 
+smoother transition of the analysis trajectory from one assimilation cycle 
+to the next than that described by \eqref{eq:F1_i}.
+
+%==========================================================================
+% Divergence damping description %%%
+\section{Divergence damping initialisation}
+\label{ASM_details}
+
+The velocity increments may be initialized by the iterative application of 
+a divergence damping operator. In iteration step $n$ new estimates of 
+velocity increments $u^{n}_I$ and $v^{n}_I$ are updated by:
+\begin{equation} \label{eq:asm_dmp}
+\left\{ \begin{aligned}
+ u^{n}_I = u^{n-1}_I + \frac{1}{e_{1u} } \delta _{i+1/2} \left( {A_D
+\;\chi^{n-1}_I } \right) \\
+\\
+ v^{n}_I = v^{n-1}_I + \frac{1}{e_{2v} } \delta _{j+1/2} \left( {A_D
+\;\chi^{n-1}_I } \right) \\
+\end{aligned} \right.,
+\end{equation}
+where
+\begin{equation} \label{eq:asm_div}
+\chi^{n-1}_I = \frac{1}{e_{1t}\,e_{2t}\,e_{3t} }
+                \left( {\delta _i \left[ {e_{2u}\,e_{3u}\,u^{n-1}_I} \right]
+                       +\delta _j \left[ {e_{1v}\,e_{3v}\,v^{n-1}_I} \right]} \right).
+\end{equation}
+By the application of \eqref{eq:asm_dmp} and \eqref{eq:asm_dmp} the divergence is filtered
+in each iteration, and the vorticity is left unchanged. In the presence of coastal boundaries
+with zero velocity increments perpendicular to the coast the divergence is strongly damped.
+This type of the initialisation reduces the vertical velocity magnitude  and alleviates the
+problem of the excessive unphysical vertical mixing in the first steps of the model 
+integration \citep{Talagrand_JAS72, Dobricic_al_OS07}. Diffusion coefficients are defined as 
+$A_D = \alpha e_{1t} e_{2t}$, where $\alpha = 0.2$. The divergence damping is activated by
+assigning to \np{nn\_divdmp} in the \textit{nam\_asminc} namelist a value greater than zero. 
+By choosing this value to be of the order of 100 the increments in the vertical velocity will 
+be significantly reduced.
+
+
+%==========================================================================
+
+\section{Implementation details}
+\label{ASM_details}
+
+Here we show an example \ngn{namasm} namelist and the header of an example assimilation 
+increments file on the ORCA2 grid.
+
+%------------------------------------------namasm-----------------------------------------------------
+\namdisplay{namasm}
+%-------------------------------------------------------------------------------------------------------------
+
+The header of an assimilation increments file produced using the NetCDF tool
+\mbox{\textit{ncdump~-h}} is shown below
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+netcdf assim_background_increments {
+dimensions:
+        x = 182 ;
+        y = 149 ;
+        z = 31 ;
+        t = UNLIMITED ; // (1 currently)
+variables:
+        float nav_lon(y, x) ;
+        float nav_lat(y, x) ;
+        float nav_lev(z) ;
+        double time_counter(t) ;
+        double time ;
+        double z_inc_dateb ;
+        double z_inc_datef ;
+        double bckint(t, z, y, x) ;
+        double bckins(t, z, y, x) ;
+        double bckinu(t, z, y, x) ;
+        double bckinv(t, z, y, x) ;
+        double bckineta(t, y, x) ;
+
+// global attributes:
+                :DOMAIN_number_total = 1 ;
+                :DOMAIN_number = 0 ;
+                :DOMAIN_dimensions_ids = 1, 2 ;
+                :DOMAIN_size_global = 182, 149 ;
+                :DOMAIN_size_local = 182, 149 ;
+                :DOMAIN_position_first = 1, 1 ;
+                :DOMAIN_position_last = 182, 149 ;
+                :DOMAIN_halo_size_start = 0, 0 ;
+                :DOMAIN_halo_size_end = 0, 0 ;
+                :DOMAIN_type = "BOX" ;
+}
+\end{verbatim}
+\end{alltt}
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_CFG.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_CFG.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_CFG.tex	(revision 8732)
@@ -0,0 +1,304 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter � Configurations
+% ================================================================
+\chapter{Configurations}
+\label{CFG}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Introduction
+% ================================================================
+\section{Introduction}
+\label{CFG_intro}
+
+
+The purpose of this part of the manual is to introduce the \NEMO reference configurations. 
+These configurations are offered as means to explore various numerical and physical options, 
+thus allowing the user to verify that the code is performing in a manner consistent with that 
+we are running. This form of verification is critical as one adopts the code for his or her particular 
+research purposes. The reference configurations also provide a sense for some of the options available 
+in the code, though by no means are all options exercised in the reference configurations.
+
+Configuration is defined mainly through the \ngn{namcfg}  namelist variables:
+\sfcomment {Here change namcfg part of namelist. Configuration is defined throughout domain\_cfg.nc file now}  
+
+%------------------------------------------namcfg----------------------------------------------------
+\namdisplay{namcfg}
+%-------------------------------------------------------------------------------------------------------------
+
+% ================================================================
+% 1D model configuration
+% ================================================================
+\section{Water column model: 1D model (C1D) (\key{c1d}) }
+\label{CFG_c1d}
+
+The 1D model option simulates a stand alone water column within the 3D \NEMO system. 
+It can be applied to the ocean alone or to the ocean-ice system and can include passive tracers 
+or a biogeochemical model. It is set up by defining the position of the 1D water column in the grid 
+(see \textit{CONFIG/SHARED/namelist\_ref} ). 
+The 1D model is a very useful tool  
+\textit{(a)} to learn about the physics and numerical treatment of vertical mixing processes ; 
+\textit{(b)} to investigate suitable parameterisations of unresolved turbulence (surface wave
+breaking, Langmuir circulation, ...) ; 
+\textit{(c)} to compare the behaviour of different vertical mixing schemes  ; 
+\textit{(d)} to perform sensitivity studies on the vertical diffusion at a particular point of an ocean domain ; 
+\textit{(d)} to produce extra diagnostics, without the large memory requirement of the full 3D model.
+
+The methodology is based on the use of the zoom functionality over the smallest possible 
+domain : a 3x3 domain centered on the grid point of interest, 
+with some extra routines. There is no need to define a new mesh, bathymetry, 
+initial state or forcing, since the 1D model will use those of the configuration it is a zoom of. 
+The chosen grid point is set in \textit{\ngn{namcfg}} namelist by setting the \np{jpizoom} and \np{jpjzoom} 
+parameters to the indices of the location of the chosen grid point.
+
+The 1D model has some specifies. First, all the horizontal derivatives are assumed to be zero, and
+second, the two components of the velocity are moved on a $T$-point. 
+Therefore, defining \key{c1d} changes five main things in the code behaviour: 
+\begin{description}
+\item[(1)] the lateral boundary condition routine (\rou{lbc\_lnk}) set the value of the central column 
+of the 3x3 domain is imposed over the whole domain ; 
+\item[(3)] a call to \rou{lbc\_lnk} is systematically done when reading input data ($i.e.$ in \mdl{iom}) ; 
+\item[(3)] a simplified \rou{stp} routine is used (\rou{stp\_c1d}, see \mdl{step\_c1d} module) in which 
+both lateral tendancy terms and lateral physics are not called ; 
+\item[(4)] the vertical velocity is zero (so far, no attempt at introducing a Ekman pumping velocity 
+has been made) ; 
+\item[(5)] a simplified treatment of the Coriolis term is performed as $U$- and $V$-points are the same 
+(see \mdl{dyncor\_c1d}).
+\end{description}
+All the relevant \textit{\_c1d} modules can be found in the NEMOGCM/NEMO/OPA\_SRC/C1D directory of 
+the \NEMO distribution.
+
+% to be added:  a test case on the yearlong Ocean Weather Station (OWS) Papa dataset of Martin (1985)
+
+% ================================================================
+% ORCA family configurations
+% ================================================================
+\section{ORCA family: global ocean with tripolar grid }
+\label{CFG_orca}
+
+The ORCA family is a series of global ocean configurations that are run together with 
+the LIM sea-ice model (ORCA-LIM) and possibly with PISCES biogeochemical model 
+(ORCA-LIM-PISCES), using various resolutions.
+The appropriate namelist is available in \textit{CONFIG/ORCA2\_LIM3\_PISCES/EXP00/namelist\_cfg} 
+for ORCA2 and in \textit{CONFIG/SHARED/README\_configs\_namcfg\_namdom}  \sfcomment {not really true, they are obsolete namelists, where find these informations?}  
+for other resolutions
+
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]   \begin{center}
+\includegraphics[width=0.98\textwidth]{Fig_ORCA_NH_mesh}
+\caption{  \label{Fig_MISC_ORCA_msh}     
+ORCA mesh conception. The departure from an isotropic Mercator grid start poleward of 20\degN.
+The two "north pole" are the foci of a series of embedded ellipses (blue curves) 
+which are determined analytically and form the i-lines of the ORCA mesh (pseudo latitudes). 
+Then, following \citet{Madec_Imbard_CD96}, the normal to the series of ellipses (red curves) is computed 
+which provide the j-lines of the mesh (pseudo longitudes).  }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%       ORCA tripolar grid
+% -------------------------------------------------------------------------------------------------------------
+\subsection{ORCA tripolar grid}
+\label{CFG_orca_grid}
+
+The ORCA grid is a tripolar is based on the semi-analytical method of \citet{Madec_Imbard_CD96}. 
+It allows to construct a global orthogonal curvilinear ocean mesh which has no singularity point inside 
+the computational domain since two north mesh poles are introduced and placed on lands.
+The method involves defining an analytical set of mesh parallels in the stereographic polar plan, 
+computing the associated set of mesh meridians, and projecting the resulting mesh onto the sphere. 
+The set of mesh parallels used is a series of embedded ellipses which foci are the two mesh north 
+poles (Fig.~\ref{Fig_MISC_ORCA_msh}). The resulting mesh presents no loss of continuity in 
+either the mesh lines or the scale factors, or even the scale factor derivatives over the whole 
+ocean domain, as the mesh is not a composite mesh. 
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tbp]  \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_ORCA_NH_msh05_e1_e2}
+\includegraphics[width=0.80\textwidth]{Fig_ORCA_aniso}
+\caption {  \label{Fig_MISC_ORCA_e1e2}
+\textit{Top}: Horizontal scale factors ($e_1$, $e_2$) and 
+\textit{Bottom}: ratio of anisotropy ($e_1 / e_2$)
+for ORCA 0.5\deg ~mesh. South of 20\degN a Mercator grid is used ($e_1 = e_2$) 
+so that the anisotropy ratio is 1. Poleward of 20\degN, the two "north pole" 
+introduce a weak anisotropy over the ocean areas ($< 1.2$) except in vicinity of Victoria Island 
+(Canadian Arctic Archipelago). }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+The method is applied to Mercator grid ($i.e.$ same zonal and meridional grid spacing) poleward 
+of 20\degN, so that the Equator is a mesh line, which provides a better numerical solution 
+for equatorial dynamics. The choice of the series of embedded ellipses (position of the foci and 
+variation of the ellipses) is a compromise between maintaining  the ratio of mesh anisotropy 
+($e_1 / e_2$) close to one in the ocean (especially in area of strong eddy activities such as 
+the Gulf Stream) and keeping the smallest scale factor in the northern hemisphere larger 
+than the smallest one in the southern hemisphere.
+The resulting mesh is shown in Fig.~\ref{Fig_MISC_ORCA_msh} and \ref{Fig_MISC_ORCA_e1e2} 
+for a half a degree grid (ORCA\_R05). The smallest ocean scale factor is found in along  
+Antarctica, while the ratio of anisotropy remains close to one except near the Victoria Island 
+in the Canadian Archipelago. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       ORCA-LIM(-PISCES) configurations
+% -------------------------------------------------------------------------------------------------------------
+\subsection{ORCA pre-defined resolution}
+\label{CFG_orca_resolution}
+
+
+The NEMO system is provided with five built-in ORCA configurations which differ in the 
+horizontal resolution. The value of the resolution is given by the resolution at the Equator 
+expressed in degrees. Each of configuration is set through the \textit{domain\_cfg} file, 
+which sets the grid size and configuration name parameters \sfcomment {I would like to change tab_ORCA but I can not find it, wrong jp_cfg}  
+ (Tab. \ref{Tab_ORCA}).
+
+
+
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[!t]     \begin{center}
+\begin{tabular}{p{4cm} c c c c}
+Horizontal Grid         	             & \np{ORCA\_index} &  \np{jpiglo} & \np{jpjglo} &       \\  
+\hline  \hline
+\~4\deg	   &        4         &         92     &      76      &       \\
+\~2\deg        &        2         &       182     &    149      &        \\
+\~1\deg        &        1         &       362     &     292     &        \\
+\~0.5\deg     &        05       &       722     &     511     &        \\
+\~0.25\deg   &        025     &      1442    &   1021     &        \\
+%\key{orca\_r8}       &        8         &      2882    &   2042     &        \\
+%\key{orca\_r12}     &      12         &      4322    &   3062      &       \\
+\hline   \hline
+\end{tabular}
+\caption{ \label{Tab_ORCA}   
+Set of predefined parameters for ORCA family configurations.
+In all cases, the flag for configurations of ORCA family is set to 1 in \textit{domain\_cfg}  }
+\end{center}
+\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+
+The ORCA\_R2 configuration has the following specificity : starting from a 2\deg~ORCA mesh, 
+local mesh refinements were applied to the Mediterranean, Red, Black and Caspian Seas, 
+so that the resolution is 1\deg \time 1\deg there. A local transformation were also applied 
+with in the Tropics in order to refine the meridional resolution up to 0.5\deg at the Equator.
+
+The ORCA\_R1 configuration has only a local tropical transformation  to refine the meridional 
+resolution up to 1/3\deg~at the Equator. Note that the tropical mesh refinements in ORCA\_R2 
+and R1 strongly increases the mesh anisotropy there.
+
+The ORCA\_R05 and higher global configurations do not incorporate any regional refinements.  
+
+For ORCA\_R1 and R025, setting the configuration key to 75 allows to use 75 vertical levels, 
+otherwise 46 are used. In the other ORCA configurations, 31 levels are used 
+(see Tab.~\ref{Tab_orca_zgr} \sfcomment{HERE I need to put new table for ORCA2 values} and Fig.~\ref{Fig_zgr}).
+
+Only the ORCA\_R2 is provided with all its input files in the \NEMO distribution. 
+It is very similar to that used as part of the climate model developed at IPSL for the 4th IPCC 
+assessment of climate change (Marti et al., 2009). It is also the basis for the \NEMO contribution 
+to the Coordinate Ocean-ice Reference Experiments (COREs) documented in \citet{Griffies_al_OM09}. 
+
+This version of ORCA\_R2 has 31 levels in the vertical, with the highest resolution (10m) 
+in the upper 150m (see Tab.~\ref{Tab_orca_zgr} and Fig.~\ref{Fig_zgr}). 
+The bottom topography and the coastlines are derived from the global atlas of Smith and Sandwell (1997). 
+The default forcing uses the boundary forcing from \citet{Large_Yeager_Rep04} (see \S\ref{SBC_blk_core}), 
+which was developed for the purpose of running global coupled ocean-ice simulations 
+without an interactive atmosphere. This \citet{Large_Yeager_Rep04} dataset is available 
+through the \href{http://nomads.gfdl.noaa.gov/nomads/forms/mom4/CORE.html}{GFDL web site}. 
+The "normal year" of \citet{Large_Yeager_Rep04} has been chosen of the \NEMO distribution 
+since release v3.3. 
+
+ORCA\_R2 pre-defined configuration can also be run with an AGRIF zoom over the Agulhas 
+current area ( \key{agrif}  defined) and, by setting the appropriate variables, see \textit{CONFIG/SHARED/namelist\_ref}
+a regional Arctic or peri-Antarctic configuration is extracted from an ORCA\_R2 or R05 configurations
+using sponge layers at open boundaries. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       GYRE family: double gyre basin
+% -------------------------------------------------------------------------------------------------------------
+\section{GYRE family: double gyre basin }
+\label{CFG_gyre}
+
+The GYRE configuration \citep{Levy_al_OM10} has been built to simulate
+the seasonal cycle of a double-gyre box model. It consists in an idealized domain 
+similar to that used in the studies of \citet{Drijfhout_JPO94} and \citet{Hazeleger_Drijfhout_JPO98, 
+Hazeleger_Drijfhout_JPO99, Hazeleger_Drijfhout_JGR00, Hazeleger_Drijfhout_JPO00}, 
+over which an analytical seasonal forcing is applied. This allows to investigate the 
+spontaneous generation of a large number of interacting, transient mesoscale eddies 
+and their contribution to the large scale circulation. 
+
+The domain geometry is a closed rectangular basin on the $\beta$-plane centred 
+at $\sim$ 30\degN and rotated by 45\deg, 3180~km long, 2120~km wide 
+and 4~km deep (Fig.~\ref{Fig_MISC_strait_hand}). 
+The domain is bounded by vertical walls and by a flat bottom. The configuration is 
+meant to represent an idealized North Atlantic or North Pacific basin. 
+The circulation is forced by analytical profiles of wind and buoyancy fluxes. 
+The applied forcings vary seasonally in a sinusoidal manner between winter 
+and summer extrema \citep{Levy_al_OM10}. 
+The wind stress is zonal and its curl changes sign at 22\degN and 36\degN. 
+It forces a subpolar gyre in the north, a subtropical gyre in the wider part of the domain 
+and a small recirculation gyre in the southern corner. 
+The net heat flux takes the form of a restoring toward a zonal apparent air 
+temperature profile. A portion of the net heat flux which comes from the solar radiation
+is allowed to penetrate within the water column. 
+The fresh water flux is also prescribed and varies zonally. 
+It is determined such as, at each time step, the basin-integrated flux is zero. 
+The basin is initialised at rest with vertical profiles of temperature and salinity 
+uniformly applied to the whole domain.
+
+The GYRE configuration is set like an analytical configuration, through \np{ln\_read\_cfg\textit{=true}} in \textit{namcfg} namelist defined in the reference configuration \textit{CONFIG/GYRE/EXP00/namelist\_cfg}. Its horizontal resolution 
+(and thus the size of the domain) is determined by setting \np{nn\_GYRE} in  \ngn{namusr\_def}: \\
+\np{jpiglo} $= 30 \times$ \np{nn\_GYRE} + 2   \\
+\np{jpjglo} $= 20 \times$ \np{nn\_GYRE} + 2   \\
+Obviously, the namelist parameters have to be adjusted to the chosen resolution, see the Configurations 
+pages on the NEMO web site (Using NEMO\/Configurations) .
+In the vertical, GYRE uses the default 30 ocean levels (\pp{jpk}=31) (Fig.~\ref{Fig_zgr}).
+
+The GYRE configuration is also used in benchmark test as it is very simple to increase 
+its resolution and as it does not requires any input file. For example, keeping a same model size 
+on each processor while increasing the number of processor used is very easy, even though the 
+physical integrity of the solution can be compromised. Benchmark is activate via \np{ln\_bench\textit{=true}} in \ngn{namusr\_def} in namelist  \textit{CONFIG/GYRE/EXP00/namelist\_cfg}.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]   \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_GYRE}
+\caption{  \label{Fig_GYRE}   
+Snapshot of relative vorticity at the surface of the model domain 
+in GYRE R9, R27 and R54. From \citet{Levy_al_OM10}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%       AMM configuration
+% -------------------------------------------------------------------------------------------------------------
+\section{AMM: atlantic margin configuration }
+\label{MISC_config_AMM}
+
+The AMM, Atlantic Margins Model, is a regional model covering the
+Northwest European Shelf domain on a regular lat-lon grid at
+approximately 12km horizontal resolution. The appropriate 
+\textit{\&namcfg} namelist  is available in \textit{CONFIG/AMM12/EXP00/namelist\_cfg}.
+It is used to build the correct dimensions of the AMM domain.
+
+This configuration tests several features of NEMO functionality specific
+to the shelf seas.
+In particular, the AMM uses $S$-coordinates in the vertical rather than
+$z$-coordinates and is forced with tidal lateral boundary conditions
+using a flather boundary condition from the BDY module.
+The AMM configuration  uses the GLS (key\_zdfgls) turbulence scheme, the
+VVL non-linear free surface(key\_vvl) and time-splitting
+(key\_dynspg\_ts).
+
+In addition to the tidal boundary condition the model may also take
+open boundary conditions from a North Atlantic model. Boundaries may be
+completely omitted by setting \np{ln\_bdy} to false.
+Sample surface fluxes, river forcing and a sample initial restart file
+are included to test a realistic model run. The Baltic boundary is
+included within the river input file and is specified as a river source.
+Unlike ordinary river points the Baltic inputs also include salinity and
+temperature data.
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Conservation.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Conservation.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Conservation.tex	(revision 8732)
@@ -0,0 +1,337 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+
+% ================================================================
+% Invariant of the Equations
+% ================================================================
+\chapter{Invariants of the Primitive Equations}
+\label{Invariant}
+\minitoc
+
+The continuous equations of motion have many analytic properties. Many 
+quantities (total mass, energy, enstrophy, etc.) are strictly conserved in 
+the inviscid and unforced limit, while ocean physics conserve the total 
+quantities on which they act (momentum, temperature, salinity) but dissipate 
+their total variance (energy, enstrophy, etc.). Unfortunately, the finite 
+difference form of these equations is not guaranteed to retain all these 
+important properties. In constructing the finite differencing schemes, we 
+wish to ensure that certain integral constraints will be maintained. In 
+particular, it is desirable to construct the finite difference equations so 
+that horizontal kinetic energy and/or potential enstrophy of horizontally 
+non-divergent flow, and variance of temperature and salinity will be 
+conserved in the absence of dissipative effects and forcing. \citet{Arakawa1966} 
+has first pointed out the advantage of this approach. He showed that if 
+integral constraints on energy are maintained, the computation will be free 
+of the troublesome "non linear" instability originally pointed out by 
+\citet{Phillips1959}. A consistent formulation of the energetic properties is 
+also extremely important in carrying out long-term numerical simulations for 
+an oceanographic model. Such a formulation avoids systematic errors that 
+accumulate with time \citep{Bryan1997}.
+
+The general philosophy of OPA which has led to the discrete formulation 
+presented in {\S}II.2 and II.3 is to choose second order non-diffusive 
+scheme for advective terms for both dynamical and tracer equations. At this 
+level of complexity, the resulting schemes are dispersive schemes. 
+Therefore, they require the addition of a diffusive operator to be stable. 
+The alternative is to use diffusive schemes such as upstream or flux 
+corrected schemes. This last option was rejected because we prefer a 
+complete handling of the model diffusion, i.e. of the model physics rather 
+than letting the advective scheme produces its own implicit diffusion 
+without controlling the space and time structure of this implicit diffusion. 
+Note that in some very specific cases as passive tracer studies, the 
+positivity of the advective scheme is required. In that case, and in that 
+case only, the advective scheme used for passive tracer is a flux correction 
+scheme \citep{Marti1992, Levy1996, Levy1998}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation Properties on Ocean Dynamics
+% -------------------------------------------------------------------------------------------------------------
+\section{Conservation Properties on Ocean Dynamics}
+\label{Invariant_dyn}
+
+The non linear term of the momentum equations has been split into a 
+vorticity term, a gradient of horizontal kinetic energy and a vertical 
+advection term. Three schemes are available for the former (see {\S}~II.2) 
+according to the CPP variable defined (default option\textbf{ 
+}or \textbf{key{\_}vorenergy } or \textbf{key{\_}vorcombined 
+} defined). They differ in their conservative 
+properties (energy or enstrophy conserving scheme). The two latter terms 
+preserve the total kinetic energy: the large scale kinetic energy is also 
+preserved in practice. The remaining non-diffusive terms of the momentum 
+equation (namely the hydrostatic and surface pressure gradient terms) also 
+preserve the total kinetic energy and have no effect on the vorticity of the 
+flow.
+
+\textbf{* relative, planetary and total vorticity term:}
+
+Let us define as either the relative, planetary and total potential 
+vorticity, i.e. , , and , respectively. The continuous formulation of the 
+vorticity term satisfies following integral constraints:
+\begin{equation} \label{Eq_vor_vorticity}
+\int_D {{\textbf {k}}\cdot \frac{1}{e_3 }\nabla \times \left( {\varsigma 
+\;{\rm {\bf k}}\times {\textbf {U}}_h } \right)\;dv} =0
+\end{equation}
+
+\begin{equation} \label{Eq_vor_enstrophy}
+if\quad \chi =0\quad \quad \int\limits_D {\varsigma \;{\textbf{k}}\cdot 
+\frac{1}{e_3 }\nabla \times \left( {\varsigma {\textbf{k}}\times {\textbf{U}}_h } \right)\;dv} =-\int\limits_D {\frac{1}{2}\varsigma ^2\,\chi \;dv} 
+=0
+\end{equation}
+
+\begin{equation} \label{Eq_vor_energy}
+\int_D {{\textbf{U}}_h \times \left( {\varsigma \;{\textbf{k}}\times {\textbf{U}}_h } \right)\;dv} =0
+\end{equation}
+where $dv = e_1\, e_2\, e_3\, di\, dj\, dk$ is the volume element. 
+(II.4.1a) means that $\varsigma $ is conserved. (II.4.1b) is obtained by an 
+integration by part. It means that $\varsigma^2$ is conserved for a horizontally 
+non-divergent flow. 
+(II.4.1c) is even satisfied locally since the vorticity term is orthogonal 
+to the horizontal velocity. It means that the vorticity term has no 
+contribution to the evolution of the total kinetic energy. (II.4.1a) is 
+obviously always satisfied, but (II.4.1b) and (II.4.1c) cannot be satisfied 
+simultaneously with a second order scheme. Using the symmetry or 
+anti-symmetry properties of the operators (Eqs II.1.10 and 11), it can be 
+shown that the scheme (II.2.11) satisfies (II.4.1b) but not (II.4.1c), while 
+scheme (II.2.12) satisfies (II.4.1c) but not (II.4.1b) (see appendix C). 
+Note that the enstrophy conserving scheme on total vorticity has been chosen 
+as the standard discrete form of the vorticity term.
+
+\textbf{* Gradient of kinetic energy / vertical advection}
+
+In continuous formulation, the gradient of horizontal kinetic energy has no 
+contribution to the evolution of the vorticity as the curl of a gradient is 
+zero. This property is satisfied locally with the discrete form of both the 
+gradient and the curl operator we have made (property (II.1.9)~). Another 
+continuous property is that the change of horizontal kinetic energy due to 
+vertical advection is exactly balanced by the change of horizontal kinetic 
+energy due to the horizontal gradient of horizontal kinetic energy:
+
+\begin{equation} \label{Eq_keg_zad}
+\int_D {{\textbf{U}}_h \cdot \nabla _h \left( {1/2\;{\textbf{U}}_h ^2} \right)\;dv} =-\int_D {{\textbf{U}}_h \cdot \frac{w}{e_3 }\;\frac{\partial 
+{\textbf{U}}_h }{\partial k}\;dv}
+\end{equation}
+
+Using the discrete form given in {\S}II.2-a and the symmetry or 
+anti-symmetry properties of the mean and difference operators, \eqref{Eq_keg_zad} is 
+demonstrated in the Appendix C. The main point here is that satisfying 
+\eqref{Eq_keg_zad} links the choice of the discrete forms of the vertical advection 
+and of the horizontal gradient of horizontal kinetic energy. Choosing one 
+imposes the other. The discrete form of the vertical advection given in 
+{\S}II.2-a is a direct consequence of formulating the horizontal kinetic 
+energy as $1/2 \left( \overline{u^2}^i + \overline{v^2}^j \right) $ in the gradient term.
+
+\textbf{* hydrostatic pressure gradient term}
+
+In continuous formulation, a pressure gradient has no contribution to the 
+evolution of the vorticity as the curl of a gradient is zero. This 
+properties is satisfied locally with the choice of discretization we have 
+made (property (II.1.9)~). In addition, when the equation of state is linear 
+(i.e. when an advective-diffusive equation for density can be derived from 
+those of temperature and salinity) the change of horizontal kinetic energy 
+due to the work of pressure forces is balanced by the change of potential 
+energy due to buoyancy forces:
+
+\begin{equation} \label{Eq_hpg_pe}
+\int_D {-\frac{1}{\rho _o }\left. {\nabla p^h} \right|_z \cdot {\textbf {U}}_h \;dv} \;=\;\int_D {\nabla .\left( {\rho \,{\textbf{U}}} \right)\;g\;z\;\;dv}
+\end{equation}
+
+Using the discrete form given in {\S}~II.2-a and the symmetry or 
+anti-symmetry properties of the mean and difference operators, (II.4.3) is 
+demonstrated in the Appendix C. The main point here is that satisfying 
+(II.4.3) strongly constraints the discrete expression of the depth of 
+$T$-points and of the term added to the pressure gradient in $s-$coordinates: the 
+depth of a $T$-point, $z_T$, is defined as the sum the vertical scale 
+factors at $w$-points starting from the surface.
+
+\textbf{* surface pressure gradient term}
+
+In continuous formulation, the surface pressure gradient has no contribution 
+to the evolution of vorticity. This properties is trivially satisfied 
+locally as (II.2.3) (the equation verified by $\psi$ has been 
+derived from the discrete formulation of the momentum equations, vertical 
+sum and curl. Nevertheless, the $\psi$-equation is solved numerically by an 
+iterative solver (see {\S}~III.5), thus the property is only satisfied with 
+the accuracy required on the solver. In addition, with the rigid-lid 
+approximation, the change of horizontal kinetic energy due to the work of 
+surface pressure forces is exactly zero:
+\begin{equation} \label{Eq_spg}
+\int_D {-\frac{1}{\rho _o }\nabla _h } \left( {p_s } \right)\cdot {\textbf{U}}_h \;dv=0
+\end{equation}
+
+(II.4.4) is satisfied in discrete form only if the discrete barotropic 
+streamfunction time evolution equation is given by (II.2.3) (see appendix 
+C). This shows that (II.2.3) is the only way to compute the streamfunction, 
+otherwise there is no guarantee that the surface pressure force work 
+vanishes.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation Properties on Ocean Thermodynamics
+% -------------------------------------------------------------------------------------------------------------
+\section{Conservation Properties on Ocean Thermodynamics}
+\label{Invariant_tra}
+
+In continuous formulation, the advective terms of the tracer equations 
+conserve the tracer content and the quadratic form of the tracer, i.e.
+\begin{equation} \label{Eq_tra_tra2}
+\int_D {\nabla .\left( {T\;{\textbf{U}}} \right)\;dv} =0
+\;\text{and}
+\int_D {T\;\nabla .\left( {T\;{\textbf{U}}} \right)\;dv} =0
+\end{equation}
+
+The numerical scheme used ({\S}II.2-b) (equations in flux form, second order 
+centred finite differences) satisfies (II.4.5) (see appendix C). Note that 
+in both continuous and discrete formulations, there is generally no strict 
+conservation of mass, since the equation of state is non linear with respect 
+to $T$ and $S$. In practice, the mass is conserved with a very good accuracy. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation Properties on Momentum Physics
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Conservation Properties on Momentum Physics}
+\label{Invariant_dyn_physics}
+
+\textbf{* lateral momentum diffusion term}
+
+The continuous formulation of the horizontal diffusion of momentum satisfies 
+the following integral constraints~:
+\begin{equation} \label{Eq_dynldf_dyn}
+\int\limits_D {\frac{1}{e_3 }{\rm {\bf k}}\cdot \nabla \times \left[ {\nabla 
+_h \left( {A^{lm}\;\chi } \right)-\nabla _h \times \left( {A^{lm}\;\zeta 
+\;{\rm {\bf k}}} \right)} \right]\;dv} =0
+\end{equation}
+
+\begin{equation} \label{Eq_dynldf_div}
+\int\limits_D {\nabla _h \cdot \left[ {\nabla _h \left( {A^{lm}\;\chi } 
+\right)-\nabla _h \times \left( {A^{lm}\;\zeta \;{\rm {\bf k}}} \right)} 
+\right]\;dv} =0
+\end{equation}
+
+\begin{equation} \label{Eq_dynldf_curl}
+\int_D {{\rm {\bf U}}_h \cdot \left[ {\nabla _h \left( {A^{lm}\;\chi } 
+\right)-\nabla _h \times \left( {A^{lm}\;\zeta \;{\rm {\bf k}}} \right)} 
+\right]\;dv} \leqslant 0
+\end{equation}
+
+\begin{equation} \label{Eq_dynldf_curl2}
+\mbox{if}\quad A^{lm}=cste\quad \quad \int_D {\zeta \;{\rm {\bf k}}\cdot 
+\nabla \times \left[ {\nabla _h \left( {A^{lm}\;\chi } \right)-\nabla _h 
+\times \left( {A^{lm}\;\zeta \;{\rm {\bf k}}} \right)} \right]\;dv} 
+\leqslant 0
+\end{equation}
+
+\begin{equation} \label{Eq_dynldf_div2}
+\mbox{if}\quad A^{lm}=cste\quad \quad \int_D {\chi \;\nabla _h \cdot \left[ 
+{\nabla _h \left( {A^{lm}\;\chi } \right)-\nabla _h \times \left( 
+{A^{lm}\;\zeta \;{\rm {\bf k}}} \right)} \right]\;dv} \leqslant 0
+\end{equation}
+
+
+(II.4.6a) and (II.4.6b) means that the horizontal diffusion of momentum 
+conserve both the potential vorticity and the divergence of the flow, while 
+Eqs (II.4.6c) to (II.4.6e) mean that it dissipates the energy, the enstrophy 
+and the square of the divergence. The two latter properties are only 
+satisfied when the eddy coefficients are horizontally uniform.
+
+Using (II.1.8) and (II.1.9), and the symmetry or anti-symmetry properties of 
+the mean and difference operators, it is shown that the discrete form of the 
+lateral momentum diffusion given in {\S}II.2-c satisfies all the integral 
+constraints (II.4.6) (see appendix C). In particular, when the eddy 
+coefficients are horizontally uniform, a complete separation of vorticity 
+and horizontal divergence fields is ensured, so that diffusion (dissipation) 
+of vorticity (enstrophy) does not generate horizontal divergence (variance 
+of the horizontal divergence) and \textit{vice versa}. When the vertical curl of the horizontal 
+diffusion of momentum (discrete sense) is taken, the term associated to the 
+horizontal gradient of the divergence is zero locally. When the horizontal 
+divergence of the horizontal diffusion of momentum (discrete sense) is 
+taken, the term associated to the vertical curl of the vorticity is zero 
+locally. The resulting term conserves $\chi$ and dissipates 
+$\chi^2$ when the 
+eddy coefficient is horizontally uniform.
+
+\textbf{* vertical momentum diffusion term}
+
+As for the lateral momentum physics, the continuous form of the vertical 
+diffusion of momentum satisfies following integral constraints~:
+
+conservation of momentum, dissipation of horizontal kinetic energy
+
+\begin{equation} \label{Eq_dynzdf_dyn}
+\begin{aligned}
+& \int_D {\frac{1}{e_3 }}  \frac{\partial }{\partial k}\left( \frac{A^{vm}}{e_3 }\frac{\partial {\textbf{U}}_h }{\partial k} \right) \;dv = \overrightarrow{\textbf{0}} \\ 
+& \int_D \textbf{U}_h \cdot \frac{1}{e_3} \frac{\partial}{\partial k} \left( {\frac{A^{vm}}{e_3 }}{\frac{\partial \textbf{U}_h }{\partial k}} \right) \;dv \leq 0 \\ 
+ \end{aligned} 
+ \end{equation}
+conservation of vorticity, dissipation of enstrophy
+\begin{equation} \label{Eq_dynzdf_vor}
+\begin{aligned}
+& \int_D {\frac{1}{e_3 }{\rm {\bf k}}\cdot \nabla \times \left( {\frac{1}{e_3 
+}\frac{\partial }{\partial k}\left( {\frac{A^{vm}}{e_3 }\frac{\partial {\rm 
+{\bf U}}_h }{\partial k}} \right)} \right)\;dv} =0 \\ 
+& \int_D {\zeta \,{\rm {\bf k}}\cdot \nabla \times \left( {\frac{1}{e_3 
+}\frac{\partial }{\partial k}\left( {\frac{A^{vm}}{e_3 }\frac{\partial {\rm 
+{\bf U}}_h }{\partial k}} \right)} \right)\;dv} \leq 0 \\ 
+\end{aligned}
+\end{equation}
+conservation of horizontal divergence, dissipation of square of the 
+horizontal divergence
+\begin{equation} \label{Eq_dynzdf_div}
+\begin{aligned}
+ &\int_D {\nabla \cdot \left( {\frac{1}{e_3 }\frac{\partial }{\partial 
+k}\left( {\frac{A^{vm}}{e_3 }\frac{\partial {\rm {\bf U}}_h }{\partial k}} 
+\right)} \right)\;dv} =0 \\ 
+& \int_D {\chi \;\nabla \cdot \left( {\frac{1}{e_3 }\frac{\partial }{\partial 
+k}\left( {\frac{A^{vm}}{e_3 }\frac{\partial {\rm {\bf U}}_h }{\partial k}} 
+\right)} \right)\;dv} \leq 0 \\ 
+\end{aligned}
+\end{equation}
+
+In discrete form, all these properties are satisfied in $z$-coordinate (see 
+Appendix C). In $s$-coordinates, only first order properties can be 
+demonstrated, i.e. the vertical momentum physics conserve momentum, 
+potential vorticity, and horizontal divergence.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Conservation Properties on Tracer Physics
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Conservation Properties on Tracer Physics}
+\label{Invariant_tra_physics}
+
+The numerical schemes used for tracer subgridscale physics are written in 
+such a way that the heat and salt contents are conserved (equations in flux 
+form, second order centred finite differences). As a form flux is used to 
+compute the temperature and salinity, the quadratic form of these quantities 
+(i.e. their variance) globally tends to diminish. As for the advective term, 
+there is generally no strict conservation of mass even if, in practice, the 
+mass is conserved with a very good accuracy. 
+
+\textbf{* lateral physics: }conservation of tracer, dissipation of tracer 
+variance, i.e.
+
+\begin{equation} \label{Eq_traldf_t_t2}
+\begin{aligned}
+&\int_D \nabla\, \cdot\, \left( A^{lT} \,\Re \,\nabla \,T \right)\;dv = 0 \\ 
+&\int_D \,T\, \nabla\, \cdot\, \left( A^{lT} \,\Re \,\nabla \,T \right)\;dv \leq 0 \\ 
+\end{aligned}
+\end{equation}
+
+\textbf{* vertical physics: }conservation of tracer, dissipation of tracer 
+variance, i.e.
+
+\begin{equation} \label{Eq_trazdf_t_t2}
+\begin{aligned}
+& \int_D \frac{1}{e_3 } \frac{\partial }{\partial k}\left( \frac{A^{vT}}{e_3 }  \frac{\partial T}{\partial k}  \right)\;dv = 0 \\ 
+& \int_D \,T \frac{1}{e_3 } \frac{\partial }{\partial k}\left( \frac{A^{vT}}{e_3 }  \frac{\partial T}{\partial k}  \right)\;dv \leq 0 \\ 
+\end{aligned}
+\end{equation}
+
+Using the symmetry or anti-symmetry properties of the mean and difference 
+operators, it is shown that the discrete form of tracer physics given in 
+{\S}~II.2-c satisfies all the integral constraints (II.4.8) and (II.4.9) 
+except the dissipation of the square of the tracer when non-geopotential 
+diffusion is used (see appendix C). A discrete form of the lateral tracer 
+physics can be derived which satisfies these last properties. Nevertheless, 
+it requires a horizontal averaging of the vertical component of the lateral 
+physics that prevents the use of implicit resolution in the vertical. It has 
+not been implemented.
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DIA.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 8732)
@@ -0,0 +1,1844 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter I/O & Diagnostics
+% ================================================================
+\chapter{Output and Diagnostics (IOM, DIA, TRD, FLO)}
+\label{DIA}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new line
+
+% ================================================================
+%       Old Model Output 
+% ================================================================
+\section{Old Model Output (default)}
+\label{DIA_io_old}
+
+The model outputs are of three types: the restart file, the output listing, 
+and the diagnostic output file(s). The restart file is used internally by the code when 
+the user wants to start the model with initial conditions defined by a 
+previous simulation. It contains all the information that is necessary in 
+order for there to be no changes in the model results (even at the computer 
+precision) between a run performed with several restarts and the same run 
+performed in one step. It should be noted that this requires that the restart file 
+contain two consecutive time steps for all the prognostic variables, and 
+that it is saved in the same binary format as the one used by the computer 
+that is to read it (in particular, 32 bits binary IEEE format must not be used for 
+this file). 
+
+The output listing and file(s) are predefined but should be checked 
+and eventually adapted to the user's needs. The output listing is stored in 
+the $ocean.output$ file. The information is printed from within the code on the 
+logical unit $numout$. To locate these prints, use the UNIX command 
+"\textit{grep -i numout}" in the source code directory.
+
+By default, diagnostic output files are written in NetCDF format. 
+Since version 3.2, when defining \key{iomput}, an I/O server has been added 
+which provides more flexibility in the choice of the fields to be written 
+as well as how the writing work is distributed over the processors in massively parallel computing. 
+A complete description of the use of this I/O server is presented in the next section. 
+
+By default, \key{iomput} is not defined, NEMO produces NetCDF with the old IOIPSL library 
+which has been kept for compatibility and its easy installation. 
+However, the IOIPSL library is quite inefficient on parallel machines and, since version 3.2, 
+many diagnostic options have been added presuming the use of \key{iomput}. 
+The usefulness of the default IOIPSL-based option is expected to reduce with each new release. 
+If \key{iomput} is not defined, output files and content are defined in the \mdl{diawri} module 
+and contain mean (or instantaneous if \key{diainstant} is defined) values over a regular period 
+of nn\_write time-steps (namelist parameter). 
+
+%\gmcomment{                    % start of gmcomment
+
+% ================================================================
+% Diagnostics
+% ================================================================
+\section{Standard model Output (IOM)}
+\label{DIA_iom}
+
+
+Since version 3.2, iomput is the NEMO output interface of choice. 
+It has been designed to be simple to use, flexible and efficient. 
+The two main purposes of iomput are: 
+\begin{enumerate}
+\item The complete and flexible control of the output files through external XML files 
+adapted by the user from standard templates. 
+\item To achieve high performance and scalable output through the optional distribution 
+of all diagnostic output related tasks to dedicated processes. 
+\end{enumerate}
+The first functionality allows the user to specify, without code changes or recompilation, 
+aspects of the diagnostic output stream, such as:
+\begin{itemize}
+\item The choice of output frequencies that can be different for each file (including real months and years).
+\item The choice of file contents; includes complete flexibility over which data are written in which files 
+(the same data can be written in different files). 
+\item The possibility to split output files at a chosen frequency.
+\item The possibility to extract a vertical or an horizontal subdomain.
+\item The choice of the temporal operation to perform, e.g.: average, accumulate, instantaneous, min, max and once.
+\item Control over metadata via a large XML "database" of possible output fields.
+\end{itemize}
+In addition, iomput allows the user to add in the code the output of any new variable (scalar, 2D or 3D) 
+in a very easy way. All details of iomput functionalities are listed in the following subsections. 
+Examples of the XML files that control the outputs can be found in:
+\begin{alltt}
+\begin{verbatim}
+  NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
+  NEMOGCM/CONFIG/SHARED/field_def.xml
+  and
+  NEMOGCM/CONFIG/SHARED/domain_def.xml.
+\end{verbatim}
+\end{alltt}
+
+The second functionality targets output performance when running in parallel (\key{mpp\_mpi}). 
+Iomput provides the possibility to specify N dedicated I/O processes (in addition to the NEMO processes) 
+to collect and write the outputs. With an appropriate choice of N by the user, 
+the bottleneck associated with the writing of the output files can be greatly reduced. 
+
+In version 3.6, the iom\_put interface depends on an external code called 
+\href{https://forge.ipsl.jussieu.fr/ioserver/browser/XIOS/branchs/xios-1.0}{XIOS-1.0} 
+(use of revision 618 or higher is required). This new IO server can take advantage of 
+the parallel I/O functionality of NetCDF4 to create a single output file and therefore 
+to bypass the rebuilding phase. Note that writing in parallel into the same NetCDF files 
+requires that your NetCDF4 library is linked to an HDF5 library that has been correctly compiled 
+($i.e.$ with the configure option $--$enable-parallel). 
+Note that the files created by iomput through XIOS are incompatible with NetCDF3. 
+All post-processsing and visualization tools must therefore be compatible with NetCDF4 and not only NetCDF3.
+
+Even if not using the parallel I/O functionality of NetCDF4, using N dedicated I/O servers, 
+where N is typically much less than the number of NEMO processors, will reduce the number of output files created. 
+This can greatly reduce the post-processing burden usually associated with using large numbers of NEMO processors. 
+Note that for smaller configurations, the rebuilding phase can be avoided, 
+even without a parallel-enabled NetCDF4 library, simply by employing only one dedicated I/O server.
+
+\subsection{XIOS: the IO\_SERVER}
+
+\subsubsection{Attached or detached mode?}
+
+Iomput is based on \href{http://forge.ipsl.jussieu.fr/ioserver/wiki}{XIOS}, 
+the io\_server developed by Yann Meurdesoif from IPSL. 
+The behaviour of the I/O subsystem is controlled by settings in the external XML files listed above. 
+Key settings in the iodef.xml file are {\tt using\_server} and the {\tt type} tag associated with each defined file. 
+The {\tt using\_server} setting determines whether or not the server will be used in \textit{attached mode} (as a library) 
+[{\tt false}] or in \textit{detached mode} (as an external executable on N additional, dedicated cpus) [{\tt true}]. 
+The \textit{attached mode} is simpler to use but much less efficient for massively parallel applications. 
+The type of each file can be either ''multiple\_file'' or ''one\_file''.
+
+In \textit{attached mode} and if the type of file is ''multiple\_file'', 
+then each NEMO process will also act as an IO server and produce its own set of output files. 
+Superficially, this emulates the standard behaviour in previous versions. 
+However, the subdomain written out by each process does not correspond to the {\tt jpi x jpj x jpk} 
+domain actually computed by the process (although it may if {\tt jpni=1}). 
+Instead each process will have collected and written out a number of complete longitudinal strips. 
+If the ''one\_file'' option is chosen then all processes will collect their longitudinal strips 
+and write (in parallel) to a single output file. 
+
+In \textit{detached mode} and if the type of file is ''multiple\_file'', 
+then each stand-alone XIOS process will collect data for a range of complete longitudinal strips 
+and write to its own set of output files. If the ''one\_file'' option is chosen then 
+all XIOS processes will collect their longitudinal strips and write (in parallel) to a single output file. 
+Note running in detached mode requires launching a Multiple Process Multiple Data (MPMD) parallel job. 
+The following subsection provides a typical example but the syntax will vary in different MPP environments.
+
+\subsubsection{Number of cpu used by XIOS in detached mode}
+
+The number of cores used by the XIOS is specified when launching the model. 
+The number of cores dedicated to XIOS should be from ~1/10 to ~1/50 of the number or cores dedicated to NEMO. 
+Some manufacturers suggest using O($\sqrt{N}$) dedicated IO processors for N processors 
+but this is a general recommendation and not specific to NEMO. 
+It is difficult to provide precise recommendations because the optimal choice will depend on 
+the particular hardware properties of the target system (parallel filesystem performance, available memory, 
+memory bandwidth etc.) and the volume and frequency of data to be created. 
+Here is an example of 2 cpus for the io\_server and 62 cpu for nemo using mpirun:
+
+\texttt{ mpirun -np 62 ./nemo.exe : -np 2 ./xios\_server.exe }
+
+\subsubsection{Control of XIOS: the XIOS context in iodef.xml}
+
+As well as the {\tt using\_server} flag, other controls on the use of XIOS are set in the XIOS context in iodef.xml. 
+See the XML basics section below for more details on XML syntax and rules.
+
+\begin{tabular}{|p{4cm}|p{6.0cm}|p{2.0cm}|}
+   \hline
+   variable name & 
+   description & 
+   example \\ 
+   \hline   
+   \hline
+   buffer\_size & 
+   buffer size used by XIOS to send data from NEMO to XIOS. Larger is more efficient. 
+   Note that needed/used buffer sizes are summarized at the end of the job & 
+   25000000 \\ 
+   \hline   
+   buffer\_server\_factor\_size & 
+   ratio between NEMO and XIOS buffer size. Should be 2. & 
+   2 \\ 
+   \hline
+   info\_level & 
+   verbosity level (0 to 100) & 
+   0 \\ 
+   \hline
+   using\_server & 
+   activate attached(false) or detached(true) mode & 
+   true \\ 
+   \hline
+   using\_oasis & 
+   XIOS is used with OASIS(true) or not (false) & 
+   false \\ 
+   \hline
+   oasis\_codes\_id & 
+   when using oasis, define the identifier of NEMO in the namcouple. Note that the identifier of XIOS is xios.x & 
+   oceanx \\ 
+   \hline   
+\end{tabular}
+
+
+\subsection{Practical issues}
+
+\subsubsection{Installation}
+
+As mentioned, XIOS is supported separately and must be downloaded and compiled before it can be used with NEMO. 
+See the installation guide on the \href{http://forge.ipsl.jussieu.fr/ioserver/wiki}{XIOS} wiki for help and guidance. 
+NEMO will need to link to the compiled XIOS library. 
+The \href{http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/XIOS-IO-server-installation-and-use}{XIOS with NEMO} 
+guide provides an example illustration of how this can be achieved.
+
+\subsubsection{Add your own outputs}
+
+It is very easy to add your own outputs with iomput. 
+Many standard fields and diagnostics are already prepared ($i.e.$, steps 1 to 3 below have been done) 
+and simply need to be activated by including the required output in a file definition in iodef.xml (step 4). 
+To add new output variables, all 4 of the following steps must be taken.
+\begin{description}
+\item[1.] in NEMO code, add a \\
+\texttt{      CALL iom\_put( 'identifier', array ) } \\
+where you want to output a 2D or 3D array.
+
+\item[2.] If necessary, add \\
+\texttt{   USE iom\ \ \ \ \ \ \ \ \ \ \ \ ! I/O manager library }  \\
+to the list of used modules in the upper part of your module. 
+
+\item[3.] in the field\_def.xml file, add the definition of your variable using the same identifier 
+you used in the f90 code (see subsequent sections for a details of the XML syntax and rules). 
+For example:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_definition>
+      <!-- T grid -->
+
+     <field_group id="grid_T" grid_ref="grid_T_3D">
+      ...
+      <field id="identifier" long_name="blabla" ... />   
+      ...
+   </field_definition> 
+\end{verbatim}
+}}\end{alltt} 
+Note your definition must be added to the field\_group whose reference grid is consistent 
+with the size of the array passed to iomput. 
+The grid\_ref attribute refers to definitions set in iodef.xml which, in turn, reference grids 
+and axes either defined in the code (iom\_set\_domain\_attr and iom\_set\_axis\_attr in iom.F90) 
+or defined in the domain\_def.xml file. $e.g.$:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+\end{verbatim}
+}}\end{alltt} 
+Note, if your array is computed within the surface module each nn\_fsbc time\_step, 
+add the field definition within the field\_group defined with the id ''SBC'': $<$field\_group id=''SBC''...$>$ 
+which has been defined with the correct frequency of operations (iom\_set\_field\_attr in iom.F90)
+
+\item[4.] add your field in one of the output files defined in iodef.xml (again see subsequent sections for syntax and rules)   \\
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file id="file1" .../>   
+      ...
+      <field field_ref="identifier" />   
+      ...
+   </file>   
+\end{verbatim}
+}}\end{alltt} 
+
+\end{description}
+\subsection{XML fundamentals}
+
+\subsubsection{ XML basic rules}
+
+XML tags begin with the less-than character ("$<$") and end with the greater-than character (''$>$''). 
+You use tags to mark the start and end of elements, which are the logical units of information 
+in an XML document. In addition to marking the beginning of an element, XML start tags also 
+provide a place to specify attributes. An attribute specifies a single property for an element, 
+using a name/value pair, for example: $<$a b="x" c="y" b="z"$>$ ... $<$/a$>$.
+See \href{http://www.xmlnews.org/docs/xml-basics.html}{here} for more details.
+
+\subsubsection{Structure of the xml file used in NEMO}
+
+The XML file used in XIOS is structured by 7 families of tags: context, axis, domain, grid, field, file and variable. 
+Each tag family has hierarchy of three flavors (except for context):
+\\
+\begin{tabular}{|p{3.0cm}|p{4.5cm}|p{4.5cm}|}
+   \hline
+   flavor &
+   description &
+   example \\
+   \hline
+   \hline
+   root &
+   declaration of the root element that can contain element groups or elements &
+   {\scriptsize \verb? < file_definition ... >?} \\
+   \hline
+   group &
+   declaration of a group element that can contain element groups or elements &
+   {\scriptsize \verb? < file_group ... >?} \\
+   \hline
+   element &
+   declaration of an element that can contain elements &
+   {\scriptsize \verb? < file ... >?} \\
+   \hline
+\end{tabular}
+\\
+
+Each element may have several attributes. 
+Some attributes are mandatory, other are optional but have a default value and other are are completely optional. 
+Id is a special attribute used to identify an element or a group of elements. 
+It must be unique for a kind of element. 
+It is optional, but no reference to the corresponding element can be done if it is not defined.
+
+The XML file is split into context tags that are used to isolate IO definition from different codes 
+or different parts of a code. No interference is possible between 2 different contexts. 
+Each context has its own calendar and an associated timestep. 
+In \NEMO, we used the following contexts (that can be defined in any order):\\
+\\
+\begin{tabular}{|p{3.0cm}|p{4.5cm}|p{4.5cm}|}
+   \hline
+   context &
+   description &
+   example \\
+   \hline
+   \hline
+   context xios &
+   context containing information for XIOS &
+   {\scriptsize \verb? <context id="xios" ...  ?} \\
+   \hline
+   context nemo &
+   context containing IO information for NEMO (mother grid when using AGRIF) &
+   {\scriptsize \verb? <context id="nemo" ... ?} \\
+   \hline
+   context 1\_nemo &
+   context containing IO information for NEMO child grid 1 (when using AGRIF) &
+   {\scriptsize \verb? <context id="1_nemo" ...  ?} \\
+   \hline
+   context n\_nemo &
+   context containing IO information for NEMO child grid n (when using AGRIF) &
+   {\scriptsize \verb? <context id="n_nemo" ...  ?} \\
+   \hline
+\end{tabular}
+\\
+
+\noindent The xios context contains only 1 tag:
+\\
+\begin{tabular}{|p{3.0cm}|p{4.5cm}|p{4.5cm}|}
+   \hline
+   context tag &
+   description &
+   example \\
+   \hline
+   \hline
+   variable\_definition &
+   define variables needed by XIOS. This can be seen as a kind of namelist for XIOS. &
+   {\scriptsize \verb? <variable_definition ... ?} \\
+   \hline
+\end{tabular}
+\\
+
+\noindent Each context tag related to NEMO (mother or child grids) is divided into 5 parts 
+(that can be defined in any order):\\
+\\
+\begin{tabular}{|p{3.0cm}|p{4.5cm}|p{4.5cm}|}
+   \hline
+   context tag &
+   description &
+   example \\
+   \hline
+   \hline
+   field\_definition &
+   define all variables that can potentially be outputted &
+   {\scriptsize \verb? <field_definition ... ?} \\
+   \hline
+   file\_definition &
+   define the netcdf files to be created and the variables they will contain &
+   {\scriptsize \verb? <file_definition ... ?} \\
+   \hline
+   axis\_definition &
+   define vertical axis &
+   {\scriptsize \verb? <axis_definition ... ?} \\
+   \hline
+   domain\_definition &
+   define the horizontal grids &
+   {\scriptsize \verb? <domain_definition ... ?} \\
+   \hline
+   grid\_definition &
+   define the 2D and 3D grids (association of an axis and a domain) &
+   {\scriptsize \verb? <grid_definition ... ?} \\
+   \hline
+\end{tabular}
+\\
+
+\subsubsection{Nesting XML files}
+
+The XML file can be split in different parts to improve its readability and facilitate its use. 
+The inclusion of XML files into the main XML file can be done through the attribute src: \\
+{\scriptsize \verb? <context src="./nemo_def.xml" /> ?}\\
+ 
+\noindent In NEMO, by default, the field and domain definition is done in 2 separate files:
+{\scriptsize \tt
+\begin{verbatim}
+NEMOGCM/CONFIG/SHARED/field_def.xml
+and
+NEMOGCM/CONFIG/SHARED/domain_def.xml 
+\end{verbatim}
+}
+\noindent that are included in the main iodef.xml file through the following commands: \\
+{\scriptsize \verb? <field_definition src="./field_def.xml" /> ? \\
+\verb? <domain_definition src="./domain_def.xml" /> ? }
+
+
+\subsubsection{Use of inheritance}
+
+XML extensively uses the concept of inheritance. 
+XML has a tree based structure with a parent-child oriented relation: 
+all children inherit attributes from parent, but an attribute defined in a child replace the inherited attribute value. 
+Note that the special attribute ''id'' is never inherited.  \\
+\\
+example 1: Direct inheritance.
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+   <field_definition operation="average" >
+     <field id="sst"                    />   <!-- averaged      sst --> 
+     <field id="sss" operation="instant"/>   <!-- instantaneous sss --> 
+   </field_definition> 
+\end{verbatim}
+}}\end{alltt} 
+
+The field ''sst'' which is part (or a child) of the field\_definition will inherit the value ''average'' 
+of the attribute ''operation'' from its parent. Note that a child can overwrite 
+the attribute definition inherited from its parents. In the example above, the field ''sss'' will 
+for example output instantaneous values instead of average values. \\
+\\
+example 2: Inheritance by reference.
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_definition>
+     <field id="sst" long_name="sea surface temperature" />   
+     <field id="sss" long_name="sea surface salinity"    />  
+   </field_definition>      
+
+   <file_definition>
+     <file id="myfile" output_freq="1d" />   
+       <field field_ref="sst"                            />  <!-- default def -->
+       <field field_ref="sss" long_name="my description" />  <!-- overwrite   -->
+     </file>   
+   </file_definition> 
+\end{verbatim}
+}}\end{alltt} 
+Inherit (and overwrite, if needed) the attributes of a tag you are refering to.
+
+\subsubsection{Use of Groups}
+
+Groups can be used for 2 purposes. 
+Firstly, the group can be used to define common attributes to be shared by the elements of the group through inheritance. 
+In the following example, we define a group of field that will share a common grid ''grid\_T\_2D''. 
+Note that for the field ''toce'', we overwrite the grid definition inherited from the group by ''grid\_T\_3D''.
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_group id="grid_T" grid_ref="grid_T_2D">
+    <field id="toce" long_name="temperature"             unit="degC" grid_ref="grid_T_3D"/>
+    <field id="sst"  long_name="sea surface temperature" unit="degC"                     />
+    <field id="sss"  long_name="sea surface salinity"    unit="psu"                      />
+    <field id="ssh"  long_name="sea surface height"      unit="m"                        />
+         ...
+\end{verbatim}
+}}\end{alltt} 
+
+Secondly, the group can be used to replace a list of elements. 
+Several examples of groups of fields are proposed at the end of the file {\tt CONFIG/SHARED/field\_def.xml}. 
+For example, a short list of the usual variables related to the U grid:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_group id="groupU" >
+    <field field_ref="uoce"  />
+    <field field_ref="suoce" />
+    <field field_ref="utau"  />
+   </field_group>
+\end{verbatim}
+}}\end{alltt} 
+that can be directly included in a file through the following syntax:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file id="myfile_U" output_freq="1d" />   
+    <field_group group_ref="groupU"/>  
+    <field field_ref="uocetr_eff"  />  <!-- add another field -->
+   </file>   
+\end{verbatim}
+}}\end{alltt} 
+
+\subsection{Detailed functionalities }
+
+The file {\tt NEMOGCM/CONFIG/ORCA2\_LIM/iodef\_demo.xml} provides several examples of the use 
+of the new functionalities offered by the XML interface of XIOS. 
+
+\subsubsection{Define horizontal subdomains}
+Horizontal subdomains are defined through the attributs zoom\_ibegin, zoom\_jbegin, zoom\_ni, zoom\_nj of the tag family domain. 
+It must therefore be done in the domain part of the XML file. 
+For example, in {\tt CONFIG/SHARED/domain\_def.xml}, we provide the following example of a definition 
+of a 5 by 5 box with the bottom left corner at point (10,10).
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <domain_group id="grid_T">
+    <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" />
+\end{verbatim}
+}}\end{alltt} 
+The use of this subdomain is done through the redefinition of the attribute domain\_ref of the tag family field. For example:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file id="myfile_vzoom" output_freq="1d" >
+      <field field_ref="toce" domain_ref="myzoom"/>
+   </file>
+\end{verbatim}
+}}\end{alltt} 
+Moorings are seen as an extrem case corresponding to a 1 by 1 subdomain. 
+The Equatorial section, the TAO, RAMA and PIRATA moorings are alredy registered in the code 
+and can therefore be outputted without taking care of their (i,j) position in the grid. 
+These predefined domains can be activated by the use of specific domain\_ref: ''EqT'', ''EqU'' or ''EqW'' 
+for the equatorial sections and the mooring position for TAO, RAMA and PIRATA followed 
+by ''T'' (for example: ''8s137eT'', ''1.5s80.5eT'' ...)
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file id="myfile_vzoom" output_freq="1d" >
+      <field field_ref="toce" domain_ref="0n180wT"/>
+   </file>
+\end{verbatim}
+}}\end{alltt} 
+Note that if the domain decomposition used in XIOS cuts the subdomain in several parts and if you use the ''multiple\_file'' type for your output files, you will endup with several files you will need to rebuild using unprovided tools (like ncpdq and ncrcat, \href{http://nco.sourceforge.net/nco.html#Concatenation}{see nco manual}). We are therefore advising to use the ''one\_file'' type in this case.
+
+\subsubsection{Define vertical zooms}
+Vertical zooms are defined through the attributs zoom\_begin and zoom\_end of the tag family axis. It must therefore be done in the axis part of the XML file. For example, in NEMOGCM/CONFIG/ORCA2\_LIM/iodef\_demo.xml, we provide the following example:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <axis_group id="deptht" long_name="Vertical T levels" unit="m" positive="down" >
+      <axis id="deptht" />
+      <axis id="deptht_myzoom" zoom_begin="1" zoom_end="10" />
+\end{verbatim}
+}}\end{alltt} 
+The use of this vertical zoom is done through the redefinition of the attribute axis\_ref of the tag family field. For example:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file id="myfile_hzoom" output_freq="1d" >
+      <field field_ref="toce" axis_ref="deptht_myzoom"/>
+   </file>
+\end{verbatim}
+}}\end{alltt} 
+
+\subsubsection{Control of the output file names}
+
+The output file names are defined by the attributs ''name'' and ''name\_suffix'' of the tag family file. for example:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file_group id="1d" output_freq="1d" name="myfile_1d" > 
+      <file id="myfileA" name_suffix="_AAA" > <!-- will create file "myfile_1d_AAA"  -->
+         ...
+      </file>
+      <file id="myfileB" name_suffix="_BBB" > <!-- will create file "myfile_1d_BBB" -->
+         ...
+      </file>
+   </file_group>
+\end{verbatim}
+}}\end{alltt} 
+However it is often very convienent to define the file name with the name of the experiment, the output file frequency and the date of the beginning and the end of the simulation (which are informations stored either in the namelist or in the XML file). To do so, we added the following rule: if the id of the tag file is ''fileN''(where N = 1 to 999 on 1 to 3 digits) or one of the predefined sections or moorings (see next subsection), the following part of the name and the name\_suffix (that can be inherited) will be automatically replaced by:\\
+\\
+\begin{tabular}{|p{4cm}|p{8cm}|}
+   \hline
+   \centering placeholder string & automatically  replaced by \\
+   \hline
+   \hline
+   \centering @expname@ &
+   the experiment name (from cn\_exp in the namelist) \\
+   \hline
+   \centering @freq@ &
+   output frequency (from attribute output\_freq) \\
+   \hline
+   \centering @startdate@  &
+   starting date of the simulation (from nn\_date0 in the restart or the namelist). \verb?yyyymmdd? format \\
+   \hline
+   \centering @startdatefull@  & 
+   starting date of the simulation (from nn\_date0 in the restart or the namelist). \verb?yyyymmdd_hh:mm:ss? format \\
+   \hline
+   \centering @enddate@  &
+   ending date of the simulation (from nn\_date0 and nn\_itend in the namelist). \verb?yyyymmdd? format \\
+   \hline
+   \centering @enddatefull@  & 
+   ending date of the simulation (from nn\_date0 and nn\_itend in the namelist). \verb?yyyymmdd_hh:mm:ss? format \\
+   \hline
+\end{tabular}\\
+\\
+
+\noindent For example, 
+{{\scriptsize
+\begin{verbatim}
+   <file id="myfile_hzoom" name="myfile_@expname@_@startdate@_freq@freq@" output_freq="1d" >
+\end{verbatim}
+}}
+\noindent with the namelist:
+{{\scriptsize
+\begin{verbatim}
+   cn_exp      =  "ORCA2"
+   nn_date0    =  19891231
+   ln_rstart   = .false.
+\end{verbatim}
+}}
+\noindent will give the following file name radical:
+{{\scriptsize
+\begin{verbatim}
+   myfile_ORCA2_19891231_freq1d 
+\end{verbatim}
+}}
+
+\subsubsection{Other controls of the xml attributes from NEMO}
+
+The values of some attributes are defined by subroutine calls within NEMO (calls to iom\_set\_domain\_attr, iom\_set\_axis\_attr and iom\_set\_field\_attr in iom.F90). Any definition given in the xml file will be overwritten. By convention, these attributes are defined to ''auto'' (for string) or ''0000'' (for integer) in the xml file (but this is not necessary). 
+
+Here is the list of these attributes:\\
+\\
+\begin{tabular}{|l|c|c|c|}
+   \hline
+ \multicolumn{2}{|c|}{tag ids affected by automatic           }  & name      & attribute value \\
+  \multicolumn{2}{|c|}{definition of some of their attributes }  & attribute  &        \\
+   \hline
+   \hline
+    \multicolumn{2}{|c|}{field\_definition} & freq\_op & \np{rn\_rdt} \\
+   \hline
+    \multicolumn{2}{|c|}{SBC}               & freq\_op & \np{rn\_rdt} $\times$ \np{nn\_fsbc}  \\
+   \hline
+    \multicolumn{2}{|c|}{ptrc\_T}           & freq\_op & \np{rn\_rdt} $\times$ \np{nn\_dttrc} \\
+   \hline
+    \multicolumn{2}{|c|}{diad\_T}           & freq\_op & \np{rn\_rdt} $\times$ \np{nn\_dttrc} \\
+   \hline
+    \multicolumn{2}{|c|}{EqT, EqU, EqW} & jbegin, ni,      & according to the grid    \\
+    \multicolumn{2}{|c|}{                         } & name\_suffix &                                      \\
+   \hline
+   \multicolumn{2}{|c|}{TAO, RAMA and PIRATA moorings} & zoom\_ibegin, zoom\_jbegin, & according to the grid    \\
+    \multicolumn{2}{|c|}{                                                       } & name\_suffix &                                      \\
+   \hline
+\end{tabular}
+
+\subsubsection{Advanced use of XIOS functionalities}
+
+\subsection{XML reference tables}
+\label{IOM_xmlref}
+
+(1) Simple computation: directly define the computation when refering to the variable in the file definition.
+
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+ <field field\_ref="sst"  name="tosK"  unit="degK" > sst + 273.15 </field>
+ <field field\_ref="taum" name="taum2" unit="N2/m4" long\_name="square of wind stress module" > taum * taum </field>
+ <field field\_ref="qt"   name="stupid\_check" > qt - qsr - qns </field>
+\end{verbatim}
+}}\end{alltt} 
+
+(2) Simple computation: define a new variable and use it in the file definition.
+
+in field\_definition:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+ <field id="sst2" long\_name="square of sea surface temperature" unit="degC2" >  sst * sst </field >
+\end{verbatim}
+}}\end{alltt} 
+in file\_definition:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+ <field field\_ref="sst2" > sst2 </field>
+\end{verbatim}
+}}\end{alltt} 
+Note that in this case, the following syntaxe $<$field field\_ref="sst2" /$>$ is not working as sst2 won't be evaluated.
+
+(3) Change of variable precision:
+
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+     <!-- force to keep real 8 -->
+ <field field\_ref="sst" name="tos\_r8" prec="8" />
+      <!-- integer 2  with add\_offset and scale\_factor attributes -->
+ <field field\_ref="sss" name="sos\_i2" prec="2" add\_offset="20." scale\_factor="1.e-3" />
+\end{verbatim}
+}}\end{alltt} 
+Note that, then the code is crashing, writting real4 variables forces a numerical convection from real8 to real4 which will create an internal error in NetCDF and will avoid the creation of the output files. Forcing double precision outputs with prec="8" (for example in the field\_definition) will avoid this problem.
+
+(4) add user defined attributes:
+
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+      <file\_group id="1d" output\_freq="1d" output\_level="10" enabled=".TRUE."> <!-- 1d files --> 
+	<file id="file1" name\_suffix="\_grid\_T" description="ocean T grid variables" >
+	  <field field\_ref="sst" name="tos" >
+	    <variable id="my\_attribute1" type="string"  > blabla </variable>
+	    <variable id="my\_attribute2" type="integer" > 3      </variable>
+	    <variable id="my\_attribute3" type="float"   > 5.0    </variable>
+	  </field>
+	  <variable id="my\_global\_attribute" type="string" > blabla\_global </variable>
+       </file>
+     </file\_group> 
+\end{verbatim}
+}}\end{alltt} 
+
+(5) use of the ``@'' function: example 1, weighted temporal average
+
+ - define a new variable in field\_definition
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+ <field id="toce\_e3t" long\_name="temperature * e3t" unit="degC*m" grid\_ref="grid\_T\_3D" > toce * e3t </field >
+\end{verbatim}
+}}\end{alltt}
+ - use it when defining your file.  
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+<file\_group id="5d" output\_freq="5d"  output\_level="10" enabled=".TRUE." >  <!-- 5d files -->  
+ <file id="file1" name\_suffix="\_grid\_T" description="ocean T grid variables" >
+  <field field\_ref="toce" operation="instant" freq\_op="5d" > @toce\_e3t / @e3t </field>
+ </file>
+</file\_group> 
+\end{verbatim}
+}}\end{alltt}
+The freq\_op="5d" attribute is used to define the operation frequency of the ``@'' function: here 5 day. The temporal operation done by the ``@'' is the one defined in the field definition: here we use the default, average. So, in the above case, @toce\_e3t will do the 5-day mean of toce*e3t. Operation="instant" refers to the temporal operation to be performed on the field''@toce\_e3t / @e3t'': here the temporal average is alreday done by the ``@'' function so we just use instant to do the ratio of the 2 mean values. field\_ref="toce" means that attributes not explicitely defined, are inherited from toce field. Note that in this case, freq\_op must be equal to the file output\_freq.
+
+(6) use of the ``@'' function: example 2, monthly SSH standard deviation
+
+ - define a new variable in field\_definition
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+ <field id="ssh2" long\_name="square of sea surface temperature" unit="degC2" >  ssh * ssh </field >
+\end{verbatim}
+}}\end{alltt} 
+ - use it when defining your file.  
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+<file\_group id="1m" output\_freq="1m"  output\_level="10" enabled=".TRUE." >  <!-- 1m files -->  
+ <file id="file1" name\_suffix="\_grid\_T" description="ocean T grid variables" >
+  <field field\_ref="ssh" name="sshstd" long\_name="sea\_surface\_temperature\_standard\_deviation" operation="instant" freq\_op="1m" > sqrt( @ssh2 - @ssh * @ssh ) </field>
+ </file>
+</file\_group> 
+\end{verbatim}
+}}\end{alltt}
+The freq\_op="1m" attribute is used to define the operation frequency of the ``@'' function: here 1 month. The temporal operation done by the ``@'' is the one defined in the field definition: here we use the default, average. So, in the above case, @ssh2 will do the monthly mean of ssh*ssh. Operation="instant" refers to the temporal operation to be performed on the field ''sqrt( @ssh2 - @ssh * @ssh )'': here the temporal average is alreday done by the ``@'' function so we just use instant. field\_ref="ssh" means that attributes not explicitely defined, are inherited from ssh field. Note that in this case, freq\_op must be equal to the file output\_freq.
+
+(7) use of the ``@'' function: example 3, monthly average of SST diurnal cycle
+
+ - define 2 new variables in field\_definition
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+ <field id="sstmax" field\_ref="sst" long\_name="max of sea surface temperature" operation="maximum" />
+ <field id="sstmin" field\_ref="sst" long\_name="min of sea surface temperature" operation="minimum" />
+\end{verbatim}
+}}\end{alltt} 
+ - use these 2 new variables when defining your file.  
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+<file\_group id="1m" output\_freq="1m"  output\_level="10" enabled=".TRUE." >  <!-- 1m files -->  
+ <file id="file1" name\_suffix="\_grid\_T" description="ocean T grid variables" >
+  <field field\_ref="sst" name="sstdcy" long\_name="amplitude of sst diurnal cycle" operation="average" freq\_op="1d" > @sstmax - @sstmin </field>
+ </file>
+</file\_group> 
+\end{verbatim}
+}}\end{alltt}
+The freq\_op="1d" attribute is used to define the operation frequency of the ``@'' function: here 1 day. The temporal operation done by the ``@'' is the one defined in the field definition: here maximum for sstmax and minimum for sstmin. So, in the above case, @sstmax will do the daily max and @sstmin the daily min. Operation="average" refers to the temporal operation to be performed on the field ``@sstmax - @sstmin'': here monthly mean (of daily max - daily min of the sst). field\_ref="sst" means that attributes not explicitely defined, are inherited from sst field.
+
+
+
+\subsubsection{Tag list}
+
+\begin{longtable}{|p{2.2cm}|p{2.5cm}|p{3.5cm}|p{2.2cm}|p{1.6cm}|}
+   \hline
+   tag name & 
+   description & 
+   accepted attribute & 
+   child of &
+   parent of \endhead
+   \hline   
+   simulation & 
+   this tag is the root tag which encapsulates all the content of the xml file &
+   none &
+   none &
+   context \\
+   \hline   
+   context &
+   encapsulates parts of the xml file dedicated to different codes or different parts of a code &
+   id (''xios'', ''nemo'' or ''n\_nemo'' for the nth AGRIF zoom), src, time\_origin &
+   simulation &
+   all root tags: ... \_definition \\
+   \hline   
+   \hline   
+   field\_definition &
+   encapsulates the definition of all the fields that can potentially be outputted &
+   axis\_ref, default\_value, domain\_ref, enabled, grid\_ref, level, operation, prec, src &
+   context &
+   field or field\_group \\
+   \hline   
+   field\_group &
+   encapsulates a group of fields &
+   axis\_ref, default\_value, domain\_ref, enabled, group\_ref, grid\_ref, id, level, operation, prec, src &
+   field\_definition, field\_group, file &
+   field or field\_group \\
+   \hline   
+   field &
+   define a specific field &
+   axis\_ref, default\_value, domain\_ref, enabled, field\_ref, grid\_ref, id, level, long\_name, name, operation, prec, standard\_name, unit &
+   field\_definition, field\_group, file &
+   none \\
+   \hline   
+   \hline   
+   file\_definition & 
+   encapsulates the definition of all the files that will be outputted &
+   enabled, min\_digits, name, name\_suffix, output\_level, split\_freq\_format, split\_freq, sync\_freq, type, src &
+   context & 
+   file or file\_group \\
+   \hline   
+   file\_group & 
+   encapsulates a group of files that will be outputted &
+   enabled, description, id, min\_digits, name, name\_suffix, output\_freq, output\_level, split\_freq\_format, split\_freq, sync\_freq, type, src &
+   file\_definition, file\_group & 
+   file or file\_group \\
+   \hline   
+   file & 
+   define the contents of a file to be outputted &
+   enabled, description, id, min\_digits, name, name\_suffix, output\_freq, output\_level, split\_freq\_format, split\_freq, sync\_freq, type, src &
+   file\_definition, file\_group & 
+   field \\
+   \hline   
+   axis\_definition & 
+   define all the vertical axis potentially used by the variables &
+   src &
+   context &  
+   axis\_group, axis \\
+   \hline   
+   axis\_group & 
+   encapsulates a group of vertical axis &
+   id, lon\_name, positive, src, standard\_name, unit, zoom\_begin, zoom\_end, zoom\_size &
+   axis\_definition, axis\_group & 
+   axis\_group, axis \\
+   \hline   
+   axis & 
+   define a vertical axis &
+   id, lon\_name, positive, src, standard\_name, unit, zoom\_begin, zoom\_end, zoom\_size &
+   axis\_definition, axis\_group  & 
+   none \\
+   \hline   
+   \hline   
+   domain\_\-definition & 
+   define all the horizontal domains potentially used by the variables &
+   src &
+   context & 
+   domain\_\-group, domain \\
+   \hline   
+   domain\_group & 
+   encapsulates a group of horizontal domains &
+   id, lon\_name, src, zoom\_ibegin, zoom\_jbegin, zoom\_ni, zoom\_nj &
+   domain\_\-definition, domain\_group & 
+   domain\_\-group, domain \\
+   \hline   
+   domain & 
+   define an horizontal domain &
+   id, lon\_name, src, zoom\_ibegin, zoom\_jbegin, zoom\_ni, zoom\_nj &
+   domain\_\-definition, domain\_group & 
+   none \\
+   \hline   
+   \hline   
+   grid\_definition & 
+   define all the grid (association of a domain and/or an axis) potentially used by the variables &
+   src &
+   context & 
+   grid\_group, grid \\
+   \hline   
+   grid\_group & 
+   encapsulates a group of grids &
+   id, domain\_ref, axis\_ref &
+   grid\_definition, grid\_group & 
+   grid\_group, grid \\
+   \hline   
+   grid & 
+   define a grid &
+   id, domain\_ref, axis\_ref &
+   grid\_definition, grid\_group & 
+   none \\
+   \hline   
+\end{longtable}
+
+
+\subsubsection{Attributes list}
+
+\begin{longtable}{|p{2.2cm}|p{4cm}|p{3.8cm}|p{2cm}|}
+   \hline
+   attribute name & 
+   description & 
+   example & 
+   accepted by \endhead
+   \hline   
+   axis\_ref & 
+   refers to the id of a vertical axis & 
+   axis\_ref="deptht" & 
+   field, grid families \\ 
+   \hline   
+   enabled & 
+   switch on/off the output of a field or a file & 
+   enabled=".TRUE." & 
+   field, file families \\ 
+   \hline   
+   default\_value & 
+   missing\_value definition & 
+   default\_value="1.e20" & 
+   field family \\ 
+   \hline   
+   description & 
+   just for information, not used & 
+   description="ocean T grid variables" & 
+   all tags \\ 
+   \hline   
+   domain\_ref & 
+   refers to the id of a domain & 
+   domain\_ref="grid\_T" & 
+   field or grid families \\ 
+   \hline   
+   field\_ref & 
+   id of the field we want to add in a file & 
+   field\_ref="toce" & 
+   field \\ 
+   \hline   
+   grid\_ref & 
+   refers to the id of a grid & 
+   grid\_ref="grid\_T\_2D" & 
+   field family \\ 
+   \hline   
+   group\_ref & 
+   refer to a group of variables & 
+   group\_ref="mooring" & 
+   field\_group \\ 
+   \hline   
+   id & 
+   allow to identify a tag & 
+   id="nemo" &
+   accepted by all tags except simulation \\ 
+   \hline   
+   level & 
+   output priority of a field: 0 (high) to 10 (low)& 
+   level="1" & 
+   field family \\ 
+   \hline   
+   long\_name & 
+   define the long\_name attribute in the NetCDF file & 
+   long\_name="Vertical T levels" & 
+   field \\ 
+   \hline   
+   min\_digits & 
+   specify the minimum of digits used in the core number in the name of the NetCDF file & 
+   min\_digits="4" & 
+   file family \\ 
+   \hline   
+   name & 
+   name of a variable or a file. If the name of a file is undefined, its id is used as a name & 
+   name="tos" & 
+   field or file families \\ 
+   \hline   
+   name\_suffix & 
+   suffix to be inserted after the name and before the cpu number and the ''.nc'' termination of a file & 
+   name\_suffix="\_myzoom" & 
+   file family \\ 
+   \hline   
+   attribute name & 
+   description & 
+   example & 
+   accepted by \\ 
+   \hline   
+   \hline   
+   operation & 
+   type of temporal operation: average, accumulate, instantaneous, min, max and once & 
+   operation="average" & 
+   field family \\ 
+   \hline   
+   output\_freq & 
+   operation frequency. units can be ts (timestep), y, mo, d, h, mi, s. & 
+   output\_freq="1d12h" & 
+   field family \\ 
+   \hline   
+   output\_level & 
+   output priority of variables in a file: 0 (high) to 10 (low). All variables listed in the file with a level smaller or equal to output\_level will be output. Other variables won't be output even if they are listed in the file. &  
+   output\_level="10"& 
+   file family \\ 
+   \hline   
+   positive & 
+   convention used for the orientation of vertival axis (positive downward in \NEMO). & 
+   positive="down" & 
+   axis family \\ 
+   \hline   
+   prec & 
+   output precision: real 4 or real 8 & 
+   prec="4" & 
+   field family \\ 
+   \hline   
+   split\_freq & 
+   frequency at which to temporally split output files. Units can be ts (timestep), y, mo, d, h, mi, s. Useful for long runs to prevent over-sized output files.& 
+   split\_freq="1mo" & 
+   file family \\ 
+   \hline   
+   split\_freq\-\_format & 
+   date format used in the name of temporally split output files. Can be specified 
+   using the following syntaxes: \%y, \%mo, \%d, \%h \%mi and \%s & 
+   split\_freq\_format= "\%y\%mo\%d" & 
+   file family \\ 
+   \hline   
+   src & 
+   allow to include a file & 
+   src="./field\_def.xml" & 
+   accepted by all tags except simulation \\ 
+   \hline   
+   standard\_name & 
+   define the standard\_name attribute in the NetCDF file & 
+   standard\_name= "Eastward\_Sea\_Ice\_Transport" & 
+   field \\ 
+   \hline   
+   sync\_freq & 
+   NetCDF file synchronization frequency (update of the time\_counter). units can be ts (timestep), y, mo, d, h, mi, s. & 
+   sync\_freq="10d" & 
+   file family \\ 
+   \hline   
+   attribute name & 
+   description & 
+   example & 
+   accepted by \\ 
+   \hline   
+   \hline   
+   time\_origin & 
+   specify the origin of the time counter & 
+   time\_origin="1900-01-01 00:00:00"& 
+   context \\ 
+   \hline   
+   type (1)& 
+   specify if the output files are to be split spatially (multiple\_file) or not (one\_file) & 
+   type="multiple\_file" & 
+   file familly \\ 
+   \hline   
+   type (2)& 
+   define the type of a variable tag & 
+   type="boolean" & 
+   variable \\ 
+   \hline   
+   unit & 
+   unit of a variable or the vertical axis & 
+   unit="m" & 
+   field and axis families \\ 
+   \hline   
+   zoom\_ibegin & 
+   starting point along x direction of the zoom. Automatically defined for TAO/RAMA/PIRATA moorings & 
+   zoom\_ibegin="1" & 
+   domain family \\ 
+   \hline   
+   zoom\_jbegin & 
+   starting point along y direction of the zoom. Automatically defined for TAO/RAMA/PIRATA moorings & 
+   zoom\_jbegin="1" & 
+   domain family \\ 
+   \hline   
+   zoom\_ni & 
+   zoom extent along x direction & 
+   zoom\_ni="1" & 
+   domain family \\ 
+   \hline   
+   zoom\_nj & 
+   zoom extent along y direction & 
+   zoom\_nj="1" & 
+   domain family \\ 
+   \hline   
+\end{longtable}
+
+\subsection{CF metadata standard compliance}
+
+Output from the XIOS-1.0 IO server is compliant with \href{http://cfconventions.org/Data/cf-conventions/cf-conventions-1.5/build/cf-conventions.html}{version 1.5} of the CF metadata standard. Therefore while a user may wish to add their own metadata to the output files (as demonstrated in example 4 of section \ref{IOM_xmlref}) the metadata should, for the most part, comply with the CF-1.5 standard.
+
+Some metadata that may significantly increase the file size (horizontal cell areas and vertices) are controlled by the namelist parameter \np{ln\_cfmeta} in the \ngn{namrun} namelist. This must be set to true if these metadata are to be included in the output files.
+
+
+% ================================================================
+%       NetCDF4 support
+% ================================================================
+\section{NetCDF4 Support (\key{netcdf4})}
+\label{DIA_iom}
+
+Since version 3.3, support for NetCDF4 chunking and (loss-less) compression has
+been included.  These options build on the standard NetCDF output and allow
+the user control over the size of the chunks via namelist settings. Chunking
+and compression can lead to significant reductions in file sizes for a small
+runtime overhead. For a fuller discussion on chunking and other performance
+issues the reader is referred to the NetCDF4 documentation found 
+\href{http://www.unidata.ucar.edu/software/netcdf/docs/netcdf.html#Chunking}{here}.
+
+The new features are only available when the code has been linked with a
+NetCDF4 library (version 4.1 onwards, recommended) which has been built
+with HDF5 support (version 1.8.4 onwards, recommended). Datasets created
+with chunking and compression are not backwards compatible with NetCDF3
+"classic" format but most analysis codes can be relinked simply with the
+new libraries and will then read both NetCDF3 and NetCDF4 files. NEMO
+executables linked with NetCDF4 libraries can be made to produce NetCDF3
+files by setting the \np{ln\_nc4zip} logical to false in the \textit{namnc4} 
+namelist:
+
+%------------------------------------------namnc4----------------------------------------------------
+\namdisplay{namnc4}
+%-------------------------------------------------------------------------------------------------------------
+
+If \key{netcdf4} has not been defined, these namelist parameters are not read. 
+In this case, \np{ln\_nc4zip} is set false and dummy routines for a few
+NetCDF4-specific functions are defined. These functions will not be used but
+need to be included so that compilation is possible with NetCDF3 libraries.
+
+When using NetCDF4 libraries, \key{netcdf4} should be defined even if the
+intention is to create only NetCDF3-compatible files. This is necessary to
+avoid duplication between the dummy routines and the actual routines present
+in the library. Most compilers will fail at compile time when faced with
+such duplication. Thus when linking with NetCDF4 libraries the user must
+define \key{netcdf4} and control the type of NetCDF file produced via the
+namelist parameter.
+
+Chunking and compression is applied only to 4D fields and there is no
+advantage in chunking across more than one time dimension since previously
+written chunks would have to be read back and decompressed before being
+added to. Therefore, user control over chunk sizes is provided only for the
+three space dimensions. The user sets an approximate number of chunks along
+each spatial axis. The actual size of the chunks will depend on global domain
+size for mono-processors or, more likely, the local processor domain size for
+distributed processing. The derived values are subject to practical minimum
+values (to avoid wastefully small chunk sizes) and cannot be greater than the
+domain size in any dimension. The algorithm used is:
+
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize 
+\begin{verbatim}
+     ichunksz(1) = MIN( idomain_size,MAX( (idomain_size-1)/nn_nchunks_i + 1 ,16 ) )
+     ichunksz(2) = MIN( jdomain_size,MAX( (jdomain_size-1)/nn_nchunks_j + 1 ,16 ) )
+     ichunksz(3) = MIN( kdomain_size,MAX( (kdomain_size-1)/nn_nchunks_k + 1 , 1 ) )
+     ichunksz(4) = 1
+\end{verbatim}
+}}\end{alltt} 
+
+\noindent As an example, setting:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+     nn_nchunks_i=4, nn_nchunks_j=4 and nn_nchunks_k=31
+\end{verbatim}
+}}\end{alltt} \vspace{-10pt}
+
+\noindent for a standard ORCA2\_LIM configuration gives chunksizes of {\small\tt 46x38x1}
+respectively in the mono-processor case (i.e. global domain of {\small\tt 182x149x31}).
+An illustration of the potential space savings that NetCDF4 chunking and compression
+provides is given in table \ref{Tab_NC4} which compares the results of two short
+runs of the ORCA2\_LIM reference configuration with a 4x2 mpi partitioning. Note
+the variation in the compression ratio achieved which reflects chiefly the dry to wet 
+volume ratio of each processing region.
+
+%------------------------------------------TABLE----------------------------------------------------
+\begin{table} 	\begin{tabular}{lrrr}
+Filename & NetCDF3 & NetCDF4 & Reduction\\
+         &filesize & filesize & \% \\
+         &(KB)     & (KB)     & \\
+ORCA2\_restart\_0000.nc & 16420 & 8860 & 47\%\\
+ORCA2\_restart\_0001.nc & 16064 & 11456 & 29\%\\
+ORCA2\_restart\_0002.nc & 16064 & 9744 & 40\%\\
+ORCA2\_restart\_0003.nc & 16420 & 9404 & 43\%\\
+ORCA2\_restart\_0004.nc & 16200 & 5844 & 64\%\\
+ORCA2\_restart\_0005.nc & 15848 & 8172 & 49\%\\
+ORCA2\_restart\_0006.nc & 15848 & 8012 & 50\%\\
+ORCA2\_restart\_0007.nc & 16200 & 5148 & 69\%\\
+ORCA2\_2d\_grid\_T\_0000.nc & 2200 & 1504 & 32\%\\
+ORCA2\_2d\_grid\_T\_0001.nc & 2200 & 1748 & 21\%\\
+ORCA2\_2d\_grid\_T\_0002.nc & 2200 & 1592 & 28\%\\
+ORCA2\_2d\_grid\_T\_0003.nc & 2200 & 1540 & 30\%\\
+ORCA2\_2d\_grid\_T\_0004.nc & 2200 & 1204 & 46\%\\
+ORCA2\_2d\_grid\_T\_0005.nc & 2200 & 1444 & 35\%\\
+ORCA2\_2d\_grid\_T\_0006.nc & 2200 & 1428 & 36\%\\
+ORCA2\_2d\_grid\_T\_0007.nc & 2200 & 1148 & 48\%\\
+             ...            &  ... &  ... & ..  \\
+ORCA2\_2d\_grid\_W\_0000.nc & 4416 & 2240 & 50\%\\
+ORCA2\_2d\_grid\_W\_0001.nc & 4416 & 2924 & 34\%\\
+ORCA2\_2d\_grid\_W\_0002.nc & 4416 & 2512 & 44\%\\
+ORCA2\_2d\_grid\_W\_0003.nc & 4416 & 2368 & 47\%\\
+ORCA2\_2d\_grid\_W\_0004.nc & 4416 & 1432 & 68\%\\
+ORCA2\_2d\_grid\_W\_0005.nc & 4416 & 1972 & 56\%\\
+ORCA2\_2d\_grid\_W\_0006.nc & 4416 & 2028 & 55\%\\
+ORCA2\_2d\_grid\_W\_0007.nc & 4416 & 1368 & 70\%\\
+\end{tabular}
+\caption{ 	\label{Tab_NC4} 
+Filesize comparison between NetCDF3 and NetCDF4 with chunking and compression}
+\end{table}
+%----------------------------------------------------------------------------------------------------
+
+When \key{iomput} is activated with \key{netcdf4} chunking and
+compression parameters for fields produced via \np{iom\_put} calls are
+set via an equivalent and identically named namelist to \textit{namnc4} 
+in \np{xmlio\_server.def}. Typically this namelist serves the mean files
+whilst the \ngn{ namnc4} in the main namelist file continues to serve the
+restart files. This duplication is unfortunate but appropriate since, if
+using io\_servers, the domain sizes of the individual files produced by the
+io\_server processes may be different to those produced by the invidual
+processing regions and different chunking choices may be desired.
+ 
+
+% -------------------------------------------------------------------------------------------------------------
+%       Tracer/Dynamics Trends
+% -------------------------------------------------------------------------------------------------------------
+\section[Tracer/Dynamics Trends (TRD)]
+                  {Tracer/Dynamics Trends  (\ngn{namtrd})}
+\label{DIA_trd}
+
+%------------------------------------------namtrd----------------------------------------------------
+\namdisplay{namtrd} 
+%-------------------------------------------------------------------------------------------------------------
+
+Each trend of the dynamics and/or temperature and salinity time evolution equations 
+can be send to \mdl{trddyn} and/or \mdl{trdtra} modules (see TRD directory) just after their computation 
+($i.e.$ at the end of each $dyn\cdots.F90$ and/or $tra\cdots.F90$ routines). 
+This capability is controlled by options offered in \ngn{namtrd} namelist. 
+Note that the output are done with xIOS, and therefore the \key{IOM} is required.
+
+What is done depends on the \ngn{namtrd} logical set to \textit{true}:
+\begin{description}
+\item[\np{ln\_glo\_trd}] : at each \np{nn\_trd} time-step a check of the basin averaged properties 
+of the momentum and tracer equations is performed. This also includes a check of $T^2$, $S^2$, 
+$\tfrac{1}{2} (u^2+v2)$, and potential energy time evolution equations properties ; 
+\item[\np{ln\_dyn\_trd}] : each 3D trend of the evolution of the two momentum components is output ; 
+\item[\np{ln\_dyn\_mxl}] : each 3D trend of the evolution of the two momentum components averaged 
+                           over the mixed layer is output  ; 
+\item[\np{ln\_vor\_trd}] : a vertical summation of the moment tendencies is performed, 
+                           then the curl is computed to obtain the barotropic vorticity tendencies which are output ;
+\item[\np{ln\_KE\_trd}]  : each 3D trend of the Kinetic Energy equation is output ;
+\item[\np{ln\_tra\_trd}] : each 3D trend of the evolution of temperature and salinity is output ;
+\item[\np{ln\_tra\_mxl}] : each 2D trend of the evolution of temperature and salinity averaged 
+                           over the mixed layer is output ;
+\end{description}
+
+Note that the mixed layer tendency diagnostic can also be used on biogeochemical models 
+via the \key{trdtrc} and \key{trdmld\_trc} CPP keys.
+
+\textbf{Note that} in the current version (v3.6), many changes has been introduced but not fully tested. 
+In particular, options associated with \np{ln\_dyn\_mxl}, \np{ln\_vor\_trd}, and \np{ln\_tra\_mxl} 
+are not working, and none of the option have been tested with variable volume ($i.e.$ \key{vvl} defined).
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       On-line Floats trajectories
+% -------------------------------------------------------------------------------------------------------------
+\section{On-line Floats trajectories (FLO) (\key{floats})}
+\label{FLO}
+%--------------------------------------------namflo-------------------------------------------------------
+\namdisplay{namflo} 
+%--------------------------------------------------------------------------------------------------------------
+
+The on-line computation of floats advected either by the three dimensional velocity 
+field or constraint to remain at a given depth ($w = 0$ in the computation) have been 
+introduced in the system during the CLIPPER project. Options are defined by \ngn{namflo}
+namelis variables. The algorithm used is based 
+either on the work of \cite{Blanke_Raynaud_JPO97} (default option), or on a $4^th$
+Runge-Hutta algorithm (\np{ln\_flork4}=true). Note that the \cite{Blanke_Raynaud_JPO97} 
+algorithm have the advantage of providing trajectories which are consistent with the 
+numeric of the code, so that the trajectories never intercept the bathymetry. 
+
+\subsubsection{ Input data: initial coordinates }
+
+Initial coordinates can be given with Ariane Tools convention ( IJK coordinates ,(\np{ln\_ariane}=true) )
+or with longitude and latitude.
+
+
+In case of Ariane convention, input filename is \np{init\_float\_ariane}. Its format is:
+
+\texttt{ I J K nisobfl itrash itrash }
+
+\noindent with: 
+
+ - I,J,K  : indexes of initial position
+
+ - nisobfl: 0 for an isobar float, 1 for a float following the w velocity  
+
+ - itrash : set to zero; it is a dummy variable to respect Ariane Tools convention
+
+ - itrash :set to zero; it is a dummy variable to respect Ariane Tools convention
+
+\noindent Example:\\
+\noindent \texttt{ 100.00000  90.00000  -1.50000 1.00000   0.00000}\\
+\texttt{ 102.00000  90.00000  -1.50000 1.00000   0.00000}\\
+\texttt{ 104.00000  90.00000  -1.50000 1.00000   0.00000}\\
+\texttt{ 106.00000  90.00000  -1.50000 1.00000   0.00000}\\
+\texttt{ 108.00000  90.00000  -1.50000 1.00000   0.00000}\\
+
+
+In the other case ( longitude and latitude ), input filename is init\_float. Its format is:
+
+\texttt{ Long Lat depth nisobfl ngrpfl itrash}
+
+\noindent with:
+
+ - Long, Lat, depth  : Longitude, latitude, depth
+
+ - nisobfl: 0 for an isobar float, 1 for a float following the w velocity
+
+ - ngrpfl : number to identify searcher group
+
+ - itrash :set to 1; it is a dummy variable.
+
+\noindent Example:
+
+\noindent\texttt{  20.0 0.0 0.0 0 1 1 }\\
+\texttt{ -21.0 0.0 0.0 0 1 1 }\\
+\texttt{ -22.0 0.0 0.0 0 1 1 }\\
+\texttt{ -23.0 0.0 0.0 0 1 1 }\\
+\texttt{ -24.0 0.0 0.0 0 1 1 }\\
+
+\np{jpnfl} is the total number of floats during the run.
+When initial positions are read in a restart file ( \np{ln\_rstflo}= .TRUE. ),  \np{jpnflnewflo}
+can be added in the initialization file. 
+
+\subsubsection{ Output data }
+
+\np{nn\_writefl} is the frequency of writing in float output file and \np{nn\_stockfl} 
+is the frequency of creation of the float restart file.
+
+Output data can be written in ascii files (\np{ln\_flo\_ascii} = .TRUE. ). In that case, 
+output filename is trajec\_float.
+
+Another possiblity of writing format is Netcdf (\np{ln\_flo\_ascii} = .FALSE. ). There are 2 possibilities:
+
+ - if (\key{iomput}) is used, outputs are selected in  iodef.xml. Here it is an example of specification 
+   to put in files description section:
+
+\vspace{-30pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+
+     <group id="1d\_grid\_T" name="auto" description="ocean T grid variables" >   }
+       <file id="floats"  description="floats variables"> }\\
+           <field ref="traj\_lon"   name="floats\_longitude"   freq\_op="86400" />}
+           <field ref="traj\_lat"   name="floats\_latitude"    freq\_op="86400" />}
+           <field ref="traj\_dep"   name="floats\_depth"       freq\_op="86400" />}
+           <field ref="traj\_temp"  name="floats\_temperature" freq\_op="86400" />}
+           <field ref="traj\_salt"  name="floats\_salinity"    freq\_op="86400" />}
+           <field ref="traj\_dens"  name="floats\_density"     freq\_op="86400" />}
+           <field ref="traj\_group" name="floats\_group"       freq\_op="86400" />}
+       </file>}
+  </group>}
+
+\end{verbatim}
+}}\end{alltt}
+
+
+ -  if (\key{iomput}) is not used, a file called trajec\_float.nc will be created by IOIPSL library.
+
+
+
+See also \href{http://stockage.univ-brest.fr/~grima/Ariane/}{here} the web site describing 
+the off-line use of this marvellous diagnostic tool.
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Harmonic analysis of tidal constituents
+% -------------------------------------------------------------------------------------------------------------
+\section{Harmonic analysis of tidal constituents (\key{diaharm}) }
+\label{DIA_diag_harm}
+
+%------------------------------------------namdia_harm----------------------------------------------------
+\namdisplay{namdia_harm}
+%----------------------------------------------------------------------------------------------------------
+
+A module is available to compute the amplitude and phase of tidal waves. 
+This on-line Harmonic analysis is actived with \key{diaharm}.
+Some parameters are available in namelist \ngn{namdia\_harm} :
+
+- \np{nit000\_han} is the first time step used for harmonic analysis
+
+- \np{nitend\_han} is the last time step used for harmonic analysis
+
+- \np{nstep\_han} is the time step frequency for harmonic analysis
+
+- \np{nb\_ana} is the number of harmonics to analyse
+
+- \np{tname} is an array with names of tidal constituents to analyse
+
+\np{nit000\_han} and \np{nitend\_han} must be between \np{nit000} and \np{nitend} of the simulation.
+The restart capability is not implemented.
+
+The Harmonic analysis solve the following equation:
+\begin{equation}
+h_{i} - A_{0} + \sum^{nb\_ana}_{j=1}[A_{j}cos(\nu_{j}t_{j}-\phi_{j})] = e_{i}
+\end{equation}
+
+With $A_{j}$,$\nu_{j}$,$\phi_{j}$, the amplitude, frequency and phase for each wave and $e_{i}$ the error.
+$h_{i}$ is the sea level for the time $t_{i}$ and $A_{0}$ is the mean sea level. \\
+We can rewrite this equation:
+\begin{equation}
+h_{i} - A_{0} + \sum^{nb\_ana}_{j=1}[C_{j}cos(\nu_{j}t_{j})+S_{j}sin(\nu_{j}t_{j})] = e_{i}
+\end{equation}
+with $A_{j}=\sqrt{C^{2}_{j}+S^{2}_{j}}$ et $\phi_{j}=arctan(S_{j}/C_{j})$.
+
+We obtain in output $C_{j}$ and $S_{j}$ for each tidal wave.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Sections transports
+% -------------------------------------------------------------------------------------------------------------
+\section{Transports across sections (\key{diadct}) }
+\label{DIA_diag_dct}
+
+%------------------------------------------namdct----------------------------------------------------
+\namdisplay{namdct}
+%-------------------------------------------------------------------------------------------------------------
+
+A module is available to compute the transport of volume, heat and salt through sections. 
+This diagnostic is actived with \key{diadct}.
+
+Each section is defined by the coordinates of its 2 extremities. The pathways between them are contructed
+using tools which can be found in  \texttt{NEMOGCM/TOOLS/SECTIONS\_DIADCT} and are written in a binary file
+ \texttt{section\_ijglobal.diadct\_ORCA2\_LIM} which is later read in by NEMO to compute on-line transports.
+
+The on-line transports module creates three output ascii files: 
+
+- \texttt{volume\_transport} for volume transports (  unit: $10^{6} m^{3} s^{-1}$ )
+
+- \texttt{heat\_transport}   for heat transports   (  unit: $10^{15} W $ )
+
+- \texttt{salt\_transport}   for salt transports   (  unit: $10^{9}Kg s^{-1}$ )\\
+
+
+Namelist variables in \ngn{namdct} control how frequently the flows are summed 
+and the time scales over which they are averaged, as well as the level of output for debugging:
+
+\np{nn\_dct}: frequency of instantaneous transports computing
+
+\np{nn\_dctwri}: frequency of writing ( mean of instantaneous transports )
+
+\np{nn\_debug}: debugging of the section
+
+\subsubsection{ Creating a binary file containing the pathway of each section }
+
+In \texttt{NEMOGCM/TOOLS/SECTIONS\_DIADCT/run}, the file \textit{ {list\_sections.ascii\_global}}
+contains a list of all the sections that are to be computed (this list of sections is based on MERSEA project metrics).
+
+Another file is available for the GYRE configuration (\texttt{ {list\_sections.ascii\_GYRE}}). 
+
+Each section is defined by:
+
+\noindent \texttt{ long1 lat1 long2 lat2 nclass (ok/no)strpond (no)ice section\_name }\\
+with:
+
+- \texttt{long1 lat1} , coordinates of the first extremity of the section;
+
+- \texttt{long2 lat2} , coordinates of the second extremity of the section;
+
+- \texttt{nclass} the number of bounds of your classes (e.g. 3 bounds for 2 classes);
+
+- \texttt{okstrpond} to compute heat and salt transport, \texttt{nostrpond} if no;
+
+- \texttt{ice}  to compute surface and volume ice transports, \texttt{noice} if no. \\
+
+
+\noindent The results of the computing of transports, and the directions of positive
+ and negative flow do not depend on the order of the 2 extremities in this file.\\ 
+
+
+\noindent If nclass =/ 0,the next lines contain the class type and the nclass bounds:
+
+\texttt{long1 lat1 long2 lat2 nclass (ok/no)strpond (no)ice section\_name}
+
+\texttt{classtype}
+
+\texttt{zbound1}
+
+\texttt{zbound2}
+
+\texttt{.}
+
+\texttt{.}
+
+\texttt{nclass-1}
+
+\texttt{nclass}
+
+\noindent where \texttt{classtype} can be:
+
+- \texttt{zsal} for salinity classes
+
+- \texttt{ztem} for temperature classes
+
+- \texttt{zlay} for depth classes
+
+- \texttt{zsigi} for insitu density classes
+
+- \texttt{zsigp} for potential density classes \\
+
+  
+The script \texttt{job.ksh} computes the pathway for each section and creates a binary file 
+\texttt{section\_ijglobal.diadct\_ORCA2\_LIM} which is read by NEMO. \\
+
+It is possible to use this tools for new configuations: \texttt{job.ksh} has to be updated 
+with the coordinates file name and path. \\
+
+
+Examples of two sections, the ACC\_Drake\_Passage with no classes, and the
+ ATL\_Cuba\_Florida with 4 temperature clases (5 class bounds), are shown:
+
+\noindent \texttt{ -68.    -54.5   -60.    -64.7  00 okstrpond noice ACC\_Drake\_Passage}
+
+\noindent \texttt{ -80.5    22.5   -80.5    25.5  05 nostrpond noice ATL\_Cuba\_Florida}
+
+\noindent \texttt{ztem}
+
+\noindent \texttt{-2.0}
+
+\noindent \texttt{ 4.5}
+
+\noindent \texttt{ 7.0}
+
+\noindent \texttt{12.0}
+
+\noindent \texttt{40.0}
+
+
+\subsubsection{ To read the output files }
+
+The output format is :
+ 
+{\small\texttt{date, time-step number, section number, section name, section slope coefficient, class number, 
+class name, class bound 1 , classe bound2, transport\_direction1 ,  transport\_direction2, transport\_total}}\\
+
+
+For sections with classes, the first \texttt{nclass-1} lines correspond to the transport for each class 
+and the last line corresponds to the total transport summed over all classes. For sections with no classes, class number
+\texttt{ 1 } corresponds to \texttt{ total class } and this class is called  \texttt{N}, meaning \texttt{none}.\\
+
+
+\noindent \texttt{ transport\_direction1 } is the positive part of the transport ( \texttt{ > = 0 } ).
+
+\noindent \texttt{ transport\_direction2 } is the negative part of the transport ( \texttt{ < = 0 } ).\\
+
+
+\noindent The \texttt{section slope coefficient} gives information about the significance of transports signs and direction:\\
+
+
+
+\begin{tabular}{|c|c|c|c|p{4cm}|}
+\hline
+section slope coefficient & section type & direction 1 & direction 2 & total transport \\ \hline
+0.    &  horizontal & northward & southward & postive: northward  \\ \hline
+1000. &  vertical   & eastward  & westward  & postive: eastward  \\ \hline                
+\texttt{=/0, =/ 1000.}   &  diagonal   & eastward  & westward  & postive: eastward  \\ \hline                
+\end{tabular}
+
+
+% ================================================================
+% Steric effect in sea surface height
+% ================================================================
+\section{Diagnosing the Steric effect in sea surface height}
+\label{DIA_steric}
+
+
+Changes in steric sea level are caused when changes in the density of the water 
+column imply an expansion or contraction of the column. It is essentially produced 
+through surface heating/cooling and to a lesser extent through non-linear effects of 
+the equation of state (cabbeling, thermobaricity...).
+Non-Boussinesq models contain all ocean effects within the ocean acting 
+on the sea level. In particular, they include the steric effect. In contrast, 
+Boussinesq models, such as \NEMO, conserve volume, rather than mass, 
+and so do not properly represent expansion or contraction. The steric effect is 
+therefore not explicitely represented.
+This approximation does not represent a serious error with respect to the flow field 
+calculated by the model \citep{Greatbatch_JGR94}, but extra attention is required
+when investigating sea level, as steric changes are an important 
+contribution to local changes in sea level on seasonal and climatic time scales.
+This is especially true for investigation into sea level rise due to global warming. 
+
+Fortunately, the steric contribution to the sea level consists of a spatially uniform 
+component that can be diagnosed by considering the mass budget of the world 
+ocean \citep{Greatbatch_JGR94}. 
+In order to better understand how global mean sea level evolves and thus how
+the steric sea level can be diagnosed, we compare, in the following, the 
+non-Boussinesq and Boussinesq cases.
+
+Let denote 
+$\mathcal{M}$ the total mass of liquid seawater ($\mathcal{M}=\int_D \rho dv$), 
+$\mathcal{V}$ the total volume of seawater ($\mathcal{V}=\int_D dv$), 
+$\mathcal{A}$ the total surface of the ocean ($\mathcal{A}=\int_S ds$), 
+$\bar{\rho}$ the global mean seawater (\textit{in situ}) density ($\bar{\rho}= 1/\mathcal{V} \int_D \rho \,dv$), and
+$\bar{\eta}$ the global mean sea level ($\bar{\eta}=1/\mathcal{A}\int_S \eta \,ds$).
+
+A non-Boussinesq fluid conserves mass. It satisfies the following relations:
+\begin{equation} \label{Eq_MV_nBq} 
+\begin{split} 
+\mathcal{M} &=  \mathcal{V}  \;\bar{\rho}      	\\
+\mathcal{V} &=  \mathcal{A}  \;\bar{\eta}	
+\end{split}
+\end{equation}
+Temporal changes in total mass is obtained from the density conservation equation :
+\begin{equation}  \label{Eq_Co_nBq}
+\frac{1}{e_3} \partial_t ( e_3\,\rho) + \nabla( \rho \, \textbf{U} ) = \left. \frac{\textit{emp}}{e_3}\right|_\textit{surface}
+\end{equation}
+where $\rho$ is the \textit{in situ} density, and \textit{emp} the surface mass 
+exchanges with the other media of the Earth system (atmosphere, sea-ice, land). 
+Its global averaged leads to the total mass change 
+\begin{equation}  \label{Eq_Mass_nBq}
+\partial_t \mathcal{M} = \mathcal{A} \;\overline{\textit{emp}}
+\end{equation}
+where $\overline{\textit{emp}}=\int_S \textit{emp}\,ds$ is the net mass flux 
+through the ocean surface.
+Bringing \eqref{Eq_Mass_nBq} and the time derivative of \eqref{Eq_MV_nBq} 
+together leads to the evolution equation of the mean sea level
+\begin{equation} \label{Eq_ssh_nBq}
+  \partial_t \bar{\eta} =  \frac{\overline{\textit{emp}}}{ \bar{\rho}} 
+  					- \frac{\mathcal{V}}{\mathcal{A}}  \;\frac{\partial_t \bar{\rho} }{\bar{\rho}}
+\end{equation}
+The first term in equation \eqref{Eq_ssh_nBq} alters sea level by adding or 
+subtracting mass from the ocean. 
+The second term arises from temporal changes in the global mean 
+density; $i.e.$ from steric effects. 
+
+In a Boussinesq fluid, $\rho$ is replaced by $\rho_o$ in all the equation except when $\rho$ 
+appears multiplied by the gravity ($i.e.$ in the hydrostatic balance of the primitive Equations). 
+In particular, the mass conservation equation, \eqref{Eq_Co_nBq}, degenerates into 
+the incompressibility equation:
+\begin{equation}  \label{Eq_Co_Bq}
+\frac{1}{e_3} \partial_t ( e_3 ) + \nabla( \textbf{U} ) =  \left. \frac{\textit{emp}}{\rho_o \,e_3}\right|_ \textit{surface}
+\end{equation}
+and the global average of this equation now gives the temporal change of the total volume,
+\begin{equation}  \label{Eq_V_Bq}
+  \partial_t \mathcal{V} =   \mathcal{A} \;\frac{\overline{\textit{emp}}}{\rho_o} 
+\end{equation}
+Only the volume is conserved, not mass, or, more precisely, the mass which is conserved is the 
+Boussinesq mass, $\mathcal{M}_o = \rho_o \mathcal{V}$. The total volume (or equivalently  
+the global mean sea level) is altered only by net volume fluxes across the ocean surface,  
+not by changes in mean mass of the ocean: the steric effect is missing in a Boussinesq fluid.
+ 
+Nevertheless, following \citep{Greatbatch_JGR94}, the steric effect on the volume can be 
+diagnosed by considering the mass budget of the ocean. 
+The apparent changes in $\mathcal{M}$, mass of the ocean, which are not induced by surface 
+mass flux must be compensated by a spatially uniform change in the mean sea level due to 
+expansion/contraction of the ocean \citep{Greatbatch_JGR94}. In others words, the Boussinesq 
+mass, $\mathcal{M}_o$, can be related to $\mathcal{M}$, the  total mass of the ocean seen 
+by the Boussinesq model, via the steric contribution to the sea level, $\eta_s$, a spatially 
+uniform variable, as follows:
+\begin{equation}  \label{Eq_M_Bq}
+   \mathcal{M}_o  =  \mathcal{M} + \rho_o \,\eta_s \,\mathcal{A} 
+\end{equation}
+Any change in $\mathcal{M}$ which cannot be explained by the net mass flux through 
+the ocean surface is converted into a mean change in sea level. Introducing the total density 
+anomaly, $\mathcal{D}= \int_D d_a \,dv$, where $d_a= (\rho -\rho_o ) / \rho_o$  
+is the density anomaly used in \NEMO (cf. \S\ref{TRA_eos}) in \eqref{Eq_M_Bq}
+leads to a very simple form for the steric height:
+\begin{equation}  \label{Eq_steric_Bq}
+   \eta_s = - \frac{1}{\mathcal{A}} \mathcal{D} 
+\end{equation}
+
+The above formulation of the steric height of a Boussinesq ocean requires four remarks.
+First, one can be tempted to define $\rho_o$ as the initial value of $\mathcal{M}/\mathcal{V}$,
+$i.e.$ set $\mathcal{D}_{t=0}=0$, so that the initial steric height is zero. We do not
+recommend that. Indeed, in this case $\rho_o$ depends on the initial state of the ocean. 
+Since $\rho_o$ has a direct effect on the dynamics of the ocean (it appears in the pressure 
+gradient term of the momentum equation) it is definitively not a good idea when 
+inter-comparing experiments. 
+We better recommend to fixe once for all $\rho_o$ to $1035\;Kg\,m^{-3}$. This value is a 
+sensible choice for the reference density used in a Boussinesq ocean climate model since, 
+with the exception of only a small percentage of the ocean, density in the World Ocean 
+varies by no more than 2$\%$ from this value (\cite{Gill1982}, page 47).
+
+Second, we have assumed here that the total ocean surface, $\mathcal{A}$, does not
+change when the sea level is changing as it is the case in all global ocean GCMs 
+(wetting and drying of grid point is not allowed). 
+  
+Third, the discretisation of \eqref{Eq_steric_Bq} depends on the type of free surface
+which is considered. In the non linear free surface case, $i.e.$ \key{vvl} defined, it is
+given by
+\begin{equation}  \label{Eq_discrete_steric_Bq}
+   \eta_s =  - \frac{ \sum_{i,\,j,\,k} d_a\; e_{1t} e_{2t} e_{3t} }
+   					{ \sum_{i,\,j,\,k}         e_{1t} e_{2t} e_{3t} } 
+\end{equation}
+whereas in the linear free surface, the volume above the \textit{z=0} surface must be explicitly taken 
+into account to better approximate the total ocean mass and thus the steric sea level:
+\begin{equation}  \label{Eq_discrete_steric_Bq}
+   \eta_s =  - \frac{ \sum_{i,\,j,\,k} d_a\; e_{1t}e_{2t}e_{3t} + \sum_{i,\,j} d_a\; e_{1t}e_{2t} \eta }
+   						{\sum_{i,\,j,\,k} e_{1t}e_{2t}e_{3t} + \sum_{i,\,j}           e_{1t}e_{2t} \eta } 
+\end{equation}
+
+The fourth and last remark concerns the effective sea level and the presence of sea-ice.
+In the real ocean, sea ice (and snow above it)  depresses the liquid seawater through 
+its mass loading. This depression is a result of the mass of sea ice/snow system acting 
+on the liquid ocean. There is, however, no dynamical effect associated with these depressions 
+in the liquid ocean sea level, so that there are no associated ocean currents. Hence, the 
+dynamically relevant sea level is the effective sea level, $i.e.$ the sea level as if sea ice 
+(and snow) were converted to liquid seawater \citep{Campin_al_OM08}. However,
+in the current version of \NEMO the sea-ice is levitating above the ocean without 
+mass exchanges between ice and ocean. Therefore the model effective sea level
+is always given by $\eta + \eta_s$, whether or not there is sea ice present.
+
+In AR5 outputs, the thermosteric sea level is demanded. It is steric sea level due to 
+changes in ocean density arising just from changes in temperature. It is given by:
+\begin{equation}  \label{Eq_thermosteric_Bq}
+   \eta_s = - \frac{1}{\mathcal{A}} \int_D d_a(T,S_o,p_o) \,dv
+\end{equation}
+where $S_o$ and $p_o$ are the initial salinity and pressure, respectively.
+
+Both steric and thermosteric sea level are computed in \mdl{diaar5} which needs
+the \key{diaar5} defined to be called.
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Other Diagnostics
+% -------------------------------------------------------------------------------------------------------------
+\section{Other Diagnostics (\key{diahth}, \key{diaar5})}
+\label{DIA_diag_others}
+
+
+Aside from the standard model variables, other diagnostics can be computed on-line. 
+The available ready-to-add diagnostics modules can be found in directory DIA. 
+
+\subsection{Depth of various quantities (\mdl{diahth})}
+
+Among the available diagnostics the following ones are obtained when defining 
+the \key{diahth} CPP key: 
+
+- the mixed layer depth (based on a density criterion \citep{de_Boyer_Montegut_al_JGR04}) (\mdl{diahth})
+
+- the turbocline depth (based on a turbulent mixing coefficient criterion) (\mdl{diahth})
+
+- the depth of the 20\deg C isotherm (\mdl{diahth})
+
+- the depth of the thermocline (maximum of the vertical temperature gradient) (\mdl{diahth})
+
+% -----------------------------------------------------------
+%     Poleward heat and salt transports
+% -----------------------------------------------------------
+
+\subsection{Poleward heat and salt transports (\mdl{diaptr})}
+
+%------------------------------------------namptr-----------------------------------------
+\namdisplay{namptr} 
+%-----------------------------------------------------------------------------------------
+
+The poleward heat and salt transports, their advective and diffusive component, and 
+the meriodional stream function can be computed on-line in \mdl{diaptr} 
+\np{ln\_diaptr} to true (see the \textit{\ngn{namptr} } namelist below).  
+When \np{ln\_subbas}~=~true, transports and stream function are computed 
+for the Atlantic, Indian, Pacific and Indo-Pacific Oceans (defined north of 30\deg S) 
+as well as for the World Ocean. The sub-basin decomposition requires an input file 
+(\ifile{subbasins}) which contains three 2D mask arrays, the Indo-Pacific mask 
+been deduced from the sum of the Indian and Pacific mask (Fig~\ref{Fig_mask_subasins}). 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_mask_subasins}
+\caption{	\label{Fig_mask_subasins}
+Decomposition of the World Ocean (here ORCA2) into sub-basin used in to compute
+the heat and salt transports as well as the meridional stream-function: Atlantic basin (red), 
+Pacific basin (green), Indian basin (bleue), Indo-Pacific basin (bleue+green). 
+Note that semi-enclosed seas (Red, Med and Baltic seas) as well as Hudson Bay 
+are removed from the sub-basins. Note also that the Arctic Ocean has been split 
+into Atlantic and Pacific basins along the North fold line.  }
+\end{center}   \end{figure}  
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% -----------------------------------------------------------
+%       CMIP specific diagnostics 
+% -----------------------------------------------------------
+\subsection{CMIP specific diagnostics (\mdl{diaar5})}
+
+A series of diagnostics has been added in the \mdl{diaar5}. 
+They corresponds to outputs that are required for AR5 simulations (CMIP5)
+(see also Section \ref{DIA_steric} for one of them). 
+Activating those outputs requires to define the \key{diaar5} CPP key.
+
+
+% -----------------------------------------------------------
+%       25 hour mean and hourly Surface, Mid and Bed 
+% -----------------------------------------------------------
+\subsection{25 hour mean output for tidal models }
+
+%------------------------------------------nam_dia25h-------------------------------------
+\namdisplay{nam_dia25h}
+%-----------------------------------------------------------------------------------------
+
+A module is available to compute a crudely detided M2 signal by obtaining a 25 hour mean.
+The 25 hour mean is available for daily runs by summing up the 25 hourly instantananeous hourly values from
+midnight at the start of the day to midight at the day end.
+This diagnostic is actived with the logical  $ln\_dia25h$
+
+
+% -----------------------------------------------------------
+%     Top Middle and Bed hourly output
+% -----------------------------------------------------------
+\subsection{Top Middle and Bed hourly output }
+
+%------------------------------------------nam_diatmb-----------------------------------------------------
+\namdisplay{nam_diatmb}
+%----------------------------------------------------------------------------------------------------------
+
+A module is available to output the surface (top), mid water and bed diagnostics of a set of standard variables. 
+This can be a useful diagnostic when hourly or sub-hourly output is required in high resolution tidal outputs.
+The tidal signal is retained but the overall data usage is cut to just three vertical levels. Also the bottom level 
+is calculated for each cell.
+This diagnostic is actived with the logical  $ln\_diatmb$
+
+
+
+% -----------------------------------------------------------
+%     Courant numbers
+% -----------------------------------------------------------
+\subsection{Courant numbers}
+Courant numbers provide a theoretical indication of the model's numerical stability. The advective Courant numbers can be calculated according to
+\begin{equation}
+\label{eq:CFL}
+C_u = |u|\frac{\rdt}{e_{1u}}, \quad C_v = |v|\frac{\rdt}{e_{2v}}, \quad C_w = |w|\frac{\rdt}{e_{3w}}
+\end{equation}
+in the zonal, meridional and vertical directions respectively. The vertical component is included although it is not strictly valid as the vertical velocity is calculated from the continuity equation rather than as a prognostic variable. Physically this represents the rate at which information is propogated across a grid cell. Values greater than 1 indicate that information is propagated across more than one grid cell in a single time step.
+
+The variables can be activated by setting the \np{nn\_diacfl} namelist parameter to 1 in the \ngn{namctl} namelist. The diagnostics will be written out to an ascii file named cfl\_diagnostics.ascii. In this file the maximum value of $C_u$, $C_v$, and $C_w$ are printed at each timestep along with the coordinates of where the maximum value occurs. At the end of the model run the maximum value of $C_u$, $C_v$, and $C_w$ for the whole model run is printed along with the coordinates of each. The maximum values from the run are also copied to the ocean.output file. 
+
+
+% ================================================================
+
+
+
+
+
+
+
+
+
+
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DIU.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DIU.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DIU.tex	(revision 8732)
@@ -0,0 +1,166 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Diurnal SST models (DIU)
+% Edited by James While
+% ================================================================
+\chapter{Diurnal SST models (DIU)}
+\label{DIU}
+
+\minitoc
+
+
+\newpage
+$\ $\newline % force a new line
+
+Code to produce an estimate of the diurnal warming and cooling of the sea surface skin
+temperature (skin SST) is found in the DIU directory.  
+The skin temperature can be split into three parts:
+\begin{itemize}
+\item A foundation SST which is free from diurnal warming.
+\item A warm layer, typically ~3\,m thick, where heating from solar radiation can
+cause a warm stably stratified layer during the daytime
+\item A cool skin, a thin layer, approximately ~1\,mm thick, where long wave cooling
+is dominant and cools the immediate ocean surface.
+\end{itemize}
+
+Models are provided for both the warm layer, diurnal\_bulk.F90, and the cool skin,
+cool\_skin.F90.  Foundation SST is not considered as it can be obtained
+either from the main NEMO model ($i.e.$ from the temperature of the top few model levels)
+or from some other source.  
+It must be noted that both the cool skin and warm layer models produce estimates of 
+the change in temperature ($\Delta T_{\rm{cs}}$ and $\Delta T_{\rm{wl}}$) 
+and both must be added to a foundation SST to obtain the true skin temperature.
+
+Both the cool skin and warm layer models are controlled through the namelist \ngn{namdiu}:
+\namdisplay{namdiu}
+This namelist contains only two variables:
+\begin{description}
+\item[\np{ln\_diurnal}] A logical switch for turning on/off both the cool skin and warm layer.
+\item[\np{ln\_diurnal\_only}] A logical switch which if .TRUE. will run the diurnal model
+without the other dynamical parts of NEMO.  
+\np{ln\_diurnal\_only} must be .FALSE. if \np{ln\_diurnal} is .FALSE.
+\end{description}
+
+Output for the diurnal model is through the variables `sst\_wl' (warm\_layer) and
+`sst\_cs' (cool skin).  These are 2-D variables which will be included in the model
+output if they are specified in the iodef.xml file.
+
+Initialisation is through the restart file.  Specifically the code will expect 
+the presence of the 2-D variable ``Dsst'' to initialise the warm layer.  
+The cool skin model, which is determined purely by the instantaneous fluxes, 
+has no initialisation variable.  
+
+%===============================================================
+\section{Warm Layer model}
+\label{warm_layer_sec}
+%===============================================================
+
+The warm layer is calculated using the model of \citet{Takaya_al_JGR10} (TAKAYA10 model
+hereafter).  This is a simple flux based model that is defined by the equations
+\begin{eqnarray}
+\frac{\partial{\Delta T_{\rm{wl}}}}{\partial{t}}&=&\frac{Q(\nu+1)}{D_T\rho_w c_p
+\nu}-\frac{(\nu+1)ku^*_{w}f(L_a)\Delta T}{D_T\Phi\!\left(\frac{D_T}{L}\right)} \mbox{,}
+\label{ecmwf1} \\
+L&=&\frac{\rho_w c_p u^{*^3}_{w}}{\kappa g \alpha_w Q }\mbox{,}\label{ecmwf2}
+\end{eqnarray}
+where $\Delta T_{\rm{wl}}$ is the temperature difference between the top of the warm
+layer and the depth $D_T=3$\,m at which there is assumed to be no diurnal signal. In
+equation (\ref{ecmwf1}) $\alpha_w=2\times10^{-4}$ is the thermal expansion
+coefficient of water, $\kappa=0.4$ is von K\'{a}rm\'{a}n's constant, $c_p$ is the heat
+capacity at constant pressure of sea water, $\rho_w$ is the
+water density, and $L$ is the Monin-Obukhov length. The tunable
+variable $\nu$ is a shape parameter that defines the expected
+subskin temperature profile via $T(z)=T(0)-\left(\frac{z}{D_T}\right)^\nu\Delta
+T_{\rm{wl}}$,
+where $T$ is the absolute temperature and $z\le D_T$ is the depth
+below the top of the warm layer.
+The influence of wind on TAKAYA10 comes through the magnitude of the friction velocity
+of the water
+$u^*_{w}$, which can be related to the 10\,m wind speed $u_{10}$ through the relationship
+$u^*_{w} = u_{10}\sqrt{\frac{C_d\rho_a}{\rho_w}}$, where $C_d$ is
+the drag coefficient, and $\rho_a$ is the density of air.  The symbol $Q$ in equation
+(\ref{ecmwf1}) is the instantaneous total thermal energy
+flux into
+the diurnal layer, $i.e.$
+\begin{equation}
+Q = Q_{\rm{sol}} + Q_{\rm{lw}} + Q_{\rm{h}}\mbox{,} \label{e_flux_eqn}
+\end{equation}
+where $Q_{\rm{h}}$ is the sensible and latent heat flux, $Q_{\rm{lw}}$ is the long
+wave flux, and $Q_{\rm{sol}}$ is the solar flux absorbed
+within the diurnal warm layer. For $Q_{\rm{sol}}$ the 9 term
+representation of \citet{Gentemann_al_JGR09} is used.  In equation \ref{ecmwf1}
+the function $f(L_a)=\max(1,L_a^{\frac{2}{3}})$, where $L_a=0.3$\footnote{This
+is a global average value, more accurately $L_a$ could be computed as
+$L_a=(u^*_{w}/u_s)^{\frac{1}{2}}$, where $u_s$ is the stokes drift, but this is not
+currently done} is the turbulent Langmuir number and is a
+parametrization of the effect of waves.
+The function $\Phi\!\left(\frac{D_T}{L}\right)$ is the similarity function that
+parametrizes the stability of the water column and
+is given by:
+\begin{equation}
+\Phi(\zeta) = \left\{ \begin{array}{cc} 1 + \frac{5\zeta +
+4\zeta^2}{1+3\zeta+0.25\zeta^2} &(\zeta \ge 0) \\
+                                    (1 - 16\zeta)^{-\frac{1}{2}} & (\zeta < 0) \mbox{,}
+                                    \end{array} \right. \label{stab_func_eqn}
+\end{equation}
+where $\zeta=\frac{D_T}{L}$.  It is clear that the first derivative of
+(\ref{stab_func_eqn}), and thus of (\ref{ecmwf1}),
+is discontinuous at $\zeta=0$ ($i.e.$ $Q\rightarrow0$ in equation (\ref{ecmwf2})).
+
+The two terms on the right hand side of (\ref{ecmwf1}) represent different processes.
+The first term is simply the diabatic heating or cooling of the
+diurnal warm
+layer due to thermal energy
+fluxes into and out of the layer.  The second term
+parametrizes turbulent fluxes of heat out of the diurnal warm layer due to wind
+induced mixing. In practice the second term acts as a relaxation
+on the temperature.
+
+%===============================================================
+
+\section{Cool Skin model}
+\label{cool_skin_sec}
+
+%===============================================================
+
+The cool skin is modelled using the framework of \citet{Saunders_JAS82} who used a
+formulation of the near surface temperature difference based upon the heat flux and
+the friction velocity $u^*_{w}$.  As the cool skin
+is so thin (~1\,mm) we ignore the solar flux component to the heat flux and the
+Saunders equation for the cool skin temperature difference $\Delta T_{\rm{cs}}$ becomes
+\begin{equation}
+\label{sunders_eqn}
+\Delta T_{\rm{cs}}=\frac{Q_{\rm{ns}}\delta}{k_t} \mbox{,}
+\end{equation}
+where $Q_{\rm{ns}}$ is the, usually negative, non-solar heat flux into the ocean and
+$k_t$ is the thermal conductivity of sea water. $\delta$ is the thickness of the
+skin layer and is given by
+\begin{equation}
+\label{sunders_thick_eqn}
+\delta=\frac{\lambda \mu}{u^*_{w}} \mbox{,}
+\end{equation}
+where $\mu$ is the kinematic viscosity of sea water and $\lambda$ is a constant of
+proportionality which \citet{Saunders_JAS82} suggested varied between 5 and 10.
+
+The value of $\lambda$ used in equation (\ref{sunders_thick_eqn}) is that of
+\citet{Artale_al_JGR02},
+which is shown in \citet{Tu_Tsuang_GRL05} to outperform a number of other
+parametrisations at both low and high wind speeds. Specifically,
+\begin{equation}
+\label{artale_lambda_eqn}
+\lambda = \frac{ 8.64\times10^4 u^*_{w} k_t }{ \rho c_p h \mu \gamma }\mbox{,}
+\end{equation}
+where $h=10$\,m is a reference depth and
+$\gamma$ is a dimensionless function of wind speed $u$:
+\begin{equation}
+\label{artale_gamma_eqn}
+\gamma = \left\{ \begin{matrix}
+                     0.2u+0.5\mbox{,} & u \le 7.5\,\mbox{ms}^{-1} \\
+                     1.6u-10\mbox{,} & 7.5 < u < 10\,\mbox{ms}^{-1} \\
+                     6\mbox{,} & \ge 10\,\mbox{ms}^{-1} \\
+                 \end{matrix}
+          \right.
+\end{equation}
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DOM.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 8732)
@@ -0,0 +1,1024 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter 2 ——— Space and Time Domain (DOM)
+% ================================================================
+\chapter{Space Domain (DOM) }
+\label{DOM}
+\minitoc
+
+% Missing things:
+% 	- istate: description of the initial state   ==> this has to be put elsewhere..
+%                  perhaps in MISC ?  By the way the initialisation of T S and dynamics 
+%                  should be put outside of DOM routine (better with TRC staff and off-line
+%                  tracers)
+% 	-geo2ocean:  how to switch from geographic to mesh coordinate
+%     - domclo:  closed sea and lakes.... management of closea sea area : specific to global configuration, both forced and coupled
+
+
+\newpage
+$\ $\newline    % force a new line
+
+Having defined the continuous equations in Chap.~\ref{PE} and chosen a time 
+discretization Chap.~\ref{STP}, we need to choose a discretization on a grid, 
+and numerical algorithms. In the present chapter, we provide a general description 
+of the staggered grid used in \NEMO, and other information relevant to the main 
+directory routines as well as the DOM (DOMain) directory. 
+
+$\ $\newline    % force a new line
+
+% ================================================================
+% Fundamentals of the Discretisation
+% ================================================================
+\section{Fundamentals of the Discretisation}
+\label{DOM_basics}
+
+% -------------------------------------------------------------------------------------------------------------
+%        Arrangement of Variables 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Arrangement of Variables}
+\label{DOM_cell}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tb]    \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_cell}
+\caption{ \label{Fig_cell}    
+Arrangement of variables. $t$ indicates scalar points where temperature, 
+salinity, density, pressure and horizontal divergence are defined. ($u$,$v$,$w$) 
+indicates vector points, and $f$ indicates vorticity points where both relative and 
+planetary vorticities are defined}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The numerical techniques used to solve the Primitive Equations in this model are 
+based on the traditional, centred second-order finite difference approximation. 
+Special attention has been given to the homogeneity of the solution in the three 
+space directions. The arrangement of variables is the same in all directions. 
+It consists of cells centred on scalar points ($t$, $S$, $p$, $\rho$) with vector 
+points $(u, v, w)$ defined in the centre of each face of the cells (Fig. \ref{Fig_cell}). 
+This is the generalisation to three dimensions of the well-known ``C'' grid in 
+Arakawa's classification \citep{Mesinger_Arakawa_Bk76}. The relative and 
+planetary vorticity, $\zeta$ and $f$, are defined in the centre of each vertical edge 
+and the barotropic stream function $\psi$ is defined at horizontal points overlying 
+the $\zeta$ and $f$-points.
+
+The ocean mesh ($i.e.$ the position of all the scalar and vector points) is defined 
+by the transformation that gives ($\lambda$ ,$\varphi$ ,$z$) as a function of $(i,j,k)$. 
+The grid-points are located at integer or integer and a half value of $(i,j,k)$ as 
+indicated on Table \ref{Tab_cell}. In all the following, subscripts $u$, $v$, $w$, 
+$f$, $uw$, $vw$ or $fw$ indicate the position of the grid-point where the scale 
+factors are defined. Each scale factor is defined as the local analytical value 
+provided by \eqref{Eq_scale_factors}. As a result, the mesh on which partial 
+derivatives $\frac{\partial}{\partial \lambda}, \frac{\partial}{\partial \varphi}$, and 
+$\frac{\partial}{\partial z} $ are evaluated is a uniform mesh with a grid size of unity. 
+Discrete partial derivatives are formulated by the traditional, centred second order 
+finite difference approximation while the scale factors are chosen equal to their 
+local analytical value. An important point here is that the partial derivative of the 
+scale factors must be evaluated by centred finite difference approximation, not 
+from their analytical expression. This preserves the symmetry of the discrete set 
+of equations and therefore satisfies many of the continuous properties (see 
+Appendix~\ref{Apdx_C}). A similar, related remark can be made about the domain 
+size: when needed, an area, volume, or the total ocean depth must be evaluated 
+as the sum of the relevant scale factors (see \eqref{DOM_bar}) in the next section). 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{table}[!tb]
+\begin{center} \begin{tabular}{|p{46pt}|p{56pt}|p{56pt}|p{56pt}|}
+\hline
+T	&$i$ 		& $j$		& $k$		 \\ \hline
+u	& $i+1/2$	& $j$		& $k$	 	\\ \hline
+v	& $i$	 	& $j+1/2$	& $k$	 	\\ \hline
+w	& $i$	 	& $j$		& $k+1/2$ 	\\ \hline
+f	& $i+1/2$ 	& $j+1/2$	& $k$	 	\\ \hline
+uw	& $i+1/2$ 	& $j$		& $k+1/2$ 	\\ \hline
+vw	& $i$	 	& $j+1/2$	& $k+1/2$ 	\\ \hline
+fw	& $i+1/2$ 	& $j+1/2$	& $k+1/2$ 	\\ \hline
+\end{tabular}
+\caption{ \label{Tab_cell}
+Location of grid-points as a function of integer or integer and a half value of the column, 
+line or level. This indexing is only used for the writing of the semi-discrete equation. 
+In the code, the indexing uses integer values only and has a reverse direction 
+in the vertical (see \S\ref{DOM_Num_Index})}
+\end{center}
+\end{table}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        Vector Invariant Formulation 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Discrete Operators}
+\label{DOM_operators}
+
+Given the values of a variable $q$ at adjacent points, the differencing and 
+averaging operators at the midpoint between them are:
+\begin{subequations} \label{Eq_di_mi}
+\begin{align}
+ \delta _i [q]       &=  \  \    q(i+1/2)  - q(i-1/2)		\\
+ \overline q^{\,i} &= \left\{ q(i+1/2) + q(i-1/2) \right\} \; / \; 2
+\end{align}
+\end{subequations}
+
+Similar operators are defined with respect to $i+1/2$, $j$, $j+1/2$, $k$, and 
+$k+1/2$. Following \eqref{Eq_PE_grad} and \eqref{Eq_PE_lap}, the gradient of a 
+variable $q$ defined at a $t$-point has its three components defined at $u$-, $v$- 
+and $w$-points while its Laplacien is defined at $t$-point. These operators have 
+the following discrete forms in the curvilinear $s$-coordinate system:
+\begin{equation} \label{Eq_DOM_grad}
+\nabla q\equiv 	\frac{1}{e_{1u} } \delta _{i+1/2 } [q] \;\,\mathbf{i}
+		+	\frac{1}{e_{2v} } \delta _{j+1/2 } [q] \;\,\mathbf{j}
+		+	\frac{1}{e_{3w}} \delta _{k+1/2} [q] \;\,\mathbf{k}
+\end{equation}
+\begin{multline} \label{Eq_DOM_lap}
+\Delta q\equiv \frac{1}{e_{1t}\,e_{2t}\,e_{3t} }
+       \;\left(          \delta_i  \left[ \frac{e_{2u}\,e_{3u}} {e_{1u}} \;\delta_{i+1/2} [q] \right]
++                        \delta_j  \left[ \frac{e_{1v}\,e_{3v}}  {e_{2v}} \;\delta_{j+1/2} [q] \right] \;  \right)		\\
++\frac{1}{e_{3t}} \delta_k \left[ \frac{1}{e_{3w} }                     \;\delta_{k+1/2} [q] \right]
+\end{multline}
+
+Following \eqref{Eq_PE_curl} and \eqref{Eq_PE_div}, a vector ${\rm {\bf A}}=\left( a_1,a_2,a_3\right)$ 
+defined at vector points $(u,v,w)$ has its three curl components defined at $vw$-, $uw$, 
+and $f$-points, and its divergence defined at $t$-points:
+\begin{eqnarray}  \label{Eq_DOM_curl}
+ \nabla \times {\rm{\bf A}}\equiv &
+      \frac{1}{e_{2v}\,e_{3vw} } \ \left( \delta_{j +1/2} \left[e_{3w}\,a_3 \right] -\delta_{k+1/2} \left[e_{2v} \,a_2 \right] \right)  &\ \mathbf{i} \\ 
+ +& \frac{1}{e_{2u}\,e_{3uw}} \ \left( \delta_{k+1/2} \left[e_{1u}\,a_1  \right] -\delta_{i +1/2} \left[e_{3w}\,a_3 \right] \right)  &\ \mathbf{j} \\
+ +& \frac{1}{e_{1f} \,e_{2f}    } \ \left( \delta_{i +1/2} \left[e_{2v}\,a_2  \right] -\delta_{j +1/2} \left[e_{1u}\,a_1 \right] \right)  &\ \mathbf{k}
+ \end{eqnarray}
+\begin{eqnarray} \label{Eq_DOM_div}
+\nabla \cdot \rm{\bf A} \equiv 
+    \frac{1}{e_{1t}\,e_{2t}\,e_{3t}} \left( \delta_i \left[e_{2u}\,e_{3u}\,a_1 \right]
+                                           +\delta_j \left[e_{1v}\,e_{3v}\,a_2 \right] \right)+\frac{1}{e_{3t} }\delta_k \left[a_3 \right]
+\end{eqnarray}
+
+The vertical average over the whole water column denoted by an overbar becomes 
+for a quantity $q$ which is a masked field (i.e. equal to zero inside solid area):
+\begin{equation} \label{DOM_bar}
+\bar q 	=         \frac{1}{H}    \int_{k^b}^{k^o} {q\;e_{3q} \,dk} 
+		\equiv \frac{1}{H_q }\sum\limits_k {q\;e_{3q} }
+\end{equation}
+where $H_q$  is the ocean depth, which is the masked sum of the vertical scale 
+factors at $q$ points, $k^b$ and $k^o$ are the bottom and surface $k$-indices, 
+and the symbol $k^o$ refers to a summation over all grid points of the same type 
+in the direction indicated by the subscript (here $k$). 
+
+In continuous form, the following properties are satisfied:
+\begin{equation} \label{Eq_DOM_curl_grad}
+\nabla \times \nabla q ={\rm {\bf {0}}}
+\end{equation}
+\begin{equation} \label{Eq_DOM_div_curl}
+\nabla \cdot \left( {\nabla \times {\rm {\bf A}}} \right)=0
+\end{equation}
+
+It is straightforward to demonstrate that these properties are verified locally in 
+discrete form as soon as the scalar $q$ is taken at $t$-points and the vector 
+\textbf{A} has its components defined at vector points $(u,v,w)$.
+
+Let $a$ and $b$ be two fields defined on the mesh, with value zero inside 
+continental area. Using integration by parts it can be shown that the differencing 
+operators ($\delta_i$, $\delta_j$ and $\delta_k$) are skew-symmetric linear operators, 
+and further that the averaging operators $\overline{\,\cdot\,}^{\,i}$, 
+$\overline{\,\cdot\,}^{\,k}$ and $\overline{\,\cdot\,}^{\,k}$) are symmetric linear 
+operators, $i.e.$
+\begin{align} 
+\label{DOM_di_adj}
+\sum\limits_i { a_i \;\delta _i \left[ b \right]} 
+	&\equiv -\sum\limits_i {\delta _{i+1/2} \left[ a \right]\;b_{i+1/2} }      \\
+\label{DOM_mi_adj}
+\sum\limits_i { a_i \;\overline b^{\,i}} 
+	& \equiv \quad \sum\limits_i {\overline a ^{\,i+1/2}\;b_{i+1/2} } 
+\end{align}
+
+In other words, the adjoint of the differencing and averaging operators are 
+$\delta_i^*=\delta_{i+1/2}$ and 
+${(\overline{\,\cdot \,}^{\,i})}^*= \overline{\,\cdot\,}^{\,i+1/2}$, respectively. 
+These two properties will be used extensively in the Appendix~\ref{Apdx_C} to 
+demonstrate integral conservative properties of the discrete formulation chosen.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Numerical Indexing 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Numerical Indexing}
+\label{DOM_Num_Index}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tb]  \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_index_hor}
+\caption{   \label{Fig_index_hor}    
+Horizontal integer indexing used in the \textsc{Fortran} code. The dashed area indicates 
+the cell in which variables contained in arrays have the same $i$- and $j$-indices}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The array representation used in the \textsc{Fortran} code requires an integer 
+indexing while the analytical definition of the mesh (see \S\ref{DOM_cell}) is 
+associated with the use of integer values for $t$-points and both integer and 
+integer and a half values for all the other points. Therefore a specific integer 
+indexing must be defined for points other than $t$-points ($i.e.$ velocity and 
+vorticity grid-points). Furthermore, the direction of the vertical indexing has 
+been changed so that the surface level is at $k=1$.
+
+% -----------------------------------
+%        Horizontal Indexing 
+% -----------------------------------
+\subsubsection{Horizontal Indexing}
+\label{DOM_Num_Index_hor}
+
+The indexing in the horizontal plane has been chosen as shown in Fig.\ref{Fig_index_hor}. 
+For an increasing $i$ index ($j$ index), the $t$-point and the eastward $u$-point 
+(northward $v$-point) have the same index (see the dashed area in Fig.\ref{Fig_index_hor}). 
+A $t$-point and its nearest northeast $f$-point have the same $i$-and $j$-indices.
+
+% -----------------------------------
+%        Vertical indexing 
+% -----------------------------------
+\subsubsection{Vertical Indexing}
+\label{DOM_Num_Index_vertical}
+
+In the vertical, the chosen indexing requires special attention since the 
+$k$-axis is re-orientated downward in the \textsc{Fortran} code compared 
+to the indexing used in the semi-discrete equations and given in \S\ref{DOM_cell}. 
+The sea surface corresponds to the $w$-level $k=1$ which is the same index 
+as $t$-level just below (Fig.\ref{Fig_index_vert}). The last $w$-level ($k=jpk$) 
+either corresponds to the ocean floor or is inside the bathymetry while the last 
+$t$-level is always inside the bathymetry (Fig.\ref{Fig_index_vert}). Note that 
+for an increasing $k$ index, a $w$-point and the $t$-point just below have the 
+same $k$ index, in opposition to what is done in the horizontal plane where 
+it is the $t$-point and the nearest velocity points in the direction of the horizontal 
+axis that have the same $i$ or $j$ index (compare the dashed area in 
+Fig.\ref{Fig_index_hor} and \ref{Fig_index_vert}). Since the scale factors are 
+chosen to be strictly positive, a \emph{minus sign} appears in the \textsc{Fortran} 
+code \emph{before all the vertical derivatives} of the discrete equations given in 
+this documentation.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!pt]    \begin{center}
+\includegraphics[width=.90\textwidth]{Fig_index_vert}
+\caption{ \label{Fig_index_vert}     
+Vertical integer indexing used in the \textsc{Fortran } code. Note that 
+the $k$-axis is orientated downward. The dashed area indicates the cell in 
+which variables contained in arrays have the same $k$-index.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -----------------------------------
+%        Domain Size
+% -----------------------------------
+\subsubsection{Domain Size}
+\label{DOM_size}
+
+The total size of the computational domain is set by the parameters \np{jpiglo}, 
+\np{jpjglo} and \np{jpkglo} in the $i$, $j$ and $k$ directions respectively. They are 
+given as namelist variables in the \ngn{namcfg} namelist. 
+%%%
+%%%
+%%%
+Parameters $jpi$ and $jpj$ refer to the size of each processor subdomain when the code is 
+run in parallel using domain decomposition (\key{mpp\_mpi} defined, see \S\ref{LBC_mpp}).
+
+
+$\ $\newline    % force a new line
+
+%%%
+\sfcomment {Hereafter I want to create new subsection 4.2: "fields needed by opa engine or something like this"
+and add list of fields :
+case 1: read in domain.nc
+case 2: defined in userdef\_hrg\/zgr.F90
+longitude, latitude, domaine size 
+number of points
+factor scales (e1, e2, e3)
+coriolis
+k\_top, k\_bottom (first and last ocean level)
+periodicity
+}
+%%%
+
+% ================================================================
+% Domain: List of fields needed
+% ================================================================
+\section  [Domain: Needed fields]
+		{Domain: Needed fields}
+\label{DOM_fields}
+The ocean mesh ($i.e.$ the position of all the scalar and vector points) is defined 
+by the transformation that gives $(\lambda,\varphi,z)$ as a function of $(i,j,k)$. 
+The grid-points are located at integer or integer and a half values of as indicated 
+in Table~\ref{Tab_cell}. The associated scale factors are defined using the  
+analytical first derivative of the transformation \eqref{Eq_scale_factors}. These 
+definitions are done in two modules given by example, \mdl{userdef\_hgr} and \mdl{userdef\_zgr}, which 
+provide the horizontal and vertical meshes, respectively. Otherwise all needed fields can be read in file \np{cn\_domcfg} specified in \ngn{namcfg}.
+ 
+The needed fields for domain are: 
+
+geographic position :
+
+longitude : glamt , glamu , glamv and glamf  (at T, U, V and F point)
+
+latitude : gphit , gphiu , gphiv and gphif (at T, U, V and F point)
+
+Coriolis parameter (if domain not on the sphere):  ff\_f  and  ff\_t (at T and F point)
+
+Scale factors : e1t, e1u, e1v and e1f (on i direction),
+
+   e2t, e2u, e2v and e2f (on j direction)
+
+   and ie1e2u\_v, e1e2u , e1e2v   
+
+%%%
+\sfcomment {
+say something about ie1e2u\_v, e1e2u , e1e2v
+
+and add list of fields :
+case 1: read in domain.nc
+case 2: defined in userdef\_hrg\/zgr.F90
+longitude, latitude, domaine size
+number of points
+factor scales (e1, e2, e3)
+coriolis
+k\_top, k\_bottom (first and last ocean level)
+periodicity
+----
+        int ORCA ;
+   int ORCA\_index ;
+   int jpiglo ; j, k
+   int jperio ;
+   int ln_zco ; zps, sco
+   int ln_isfcav ;
+   double glamt(t, y, x) ; u,v,f
+   double gphit(t, y, x) ; u,v,f
+   double e1t(t, y, x) ; u,v,w,
+   double e2t(t, y, x) ; u,v,w
+   double ff\_f(t, y, x) ;  double ff\_t(t, y, x) ;
+   double e3t\_1d(t, z) ;
+   double e3w\_1d(t, z) ;
+   double e3t\_0(t, z, y, x) ; u0, v0 , w0
+----
+}
+
+% -------------------------------------------------------------------------------------------------------------
+%        Needed fields 
+% -------------------------------------------------------------------------------------------------------------
+%\subsection{List of needed fields to build DOMAIN}
+%\label{DOM_fields_list}
+
+
+% ================================================================
+% Domain: Horizontal Grid (mesh) 
+% ================================================================
+\section  [Domain: Horizontal Grid (mesh) (\textit{domhgr})]               
+		{Domain: Horizontal Grid (mesh) \small{(\mdl{domhgr} module)} }
+\label{DOM_hgr}
+
+% -------------------------------------------------------------------------------------------------------------
+%        Coordinates and scale factors 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Coordinates and scale factors}
+\label{DOM_hgr_coord_e}
+
+The ocean mesh ($i.e.$ the position of all the scalar and vector points) is defined 
+by the transformation that gives $(\lambda,\varphi,z)$ as a function of $(i,j,k)$. 
+The grid-points are located at integer or integer and a half values of as indicated 
+in Table~\ref{Tab_cell}. The associated scale factors are defined using the 
+analytical first derivative of the transformation \eqref{Eq_scale_factors}. These 
+definitions are done in two modules, \mdl{domhgr} and \mdl{domzgr}, which 
+provide the horizontal and vertical meshes, respectively. This section deals with 
+the horizontal mesh parameters.
+
+In a horizontal plane, the location of all the model grid points is defined from the 
+analytical expressions of the longitude $\lambda$ and  latitude $\varphi$ as a 
+function of  $(i,j)$. The horizontal scale factors are calculated using 
+\eqref{Eq_scale_factors}. For example, when the longitude and latitude are 
+function of a single value ($i$ and $j$, respectively) (geographical configuration 
+of the mesh), the horizontal mesh definition reduces to define the wanted 
+$\lambda(i)$, $\varphi(j)$, and their derivatives $\lambda'(i)$ $\varphi'(j)$ in the 
+\mdl{domhgr} module. The model computes the grid-point positions and scale 
+factors in the horizontal plane as follows:
+\begin{flalign*}
+\lambda_t &\equiv \text{glamt}= \lambda(i)	  & \varphi_t &\equiv \text{gphit} = \varphi(j)\\
+\lambda_u &\equiv \text{glamu}= \lambda(i+1/2)& \varphi_u &\equiv \text{gphiu}= \varphi(j)\\
+\lambda_v &\equiv \text{glamv}= \lambda(i)       & \varphi_v &\equiv \text{gphiv} = \varphi(j+1/2)\\
+\lambda_f &\equiv \text{glamf }= \lambda(i+1/2)& \varphi_f &\equiv \text{gphif }= \varphi(j+1/2) 
+\end{flalign*}
+\begin{flalign*}
+e_{1t} &\equiv \text{e1t} = r_a |\lambda'(i)		\; \cos\varphi(j)  |&
+e_{2t} &\equiv \text{e2t} = r_a |\varphi'(j)|  \\
+e_{1u} &\equiv \text{e1t} = r_a |\lambda'(i+1/2)	\; \cos\varphi(j)  |&
+e_{2u} &\equiv \text{e2t} = r_a |\varphi'(j)|\\
+e_{1v} &\equiv \text{e1t} = r_a |\lambda'(i)		\; \cos\varphi(j+1/2)  |&
+e_{2v} &\equiv \text{e2t} = r_a |\varphi'(j+1/2)|\\
+e_{1f} &\equiv \text{e1t} = r_a |\lambda'(i+1/2)\; \cos\varphi(j+1/2)  |&
+e_{2f} &\equiv \text{e2t} = r_a |\varphi'(j+1/2)|
+\end{flalign*}
+where the last letter of each computational name indicates the grid point 
+considered and $r_a$ is the earth radius (defined in \mdl{phycst} along with 
+all universal constants). Note that the horizontal position of and scale factors 
+at $w$-points are exactly equal to those of $t$-points, thus no specific arrays 
+are defined at $w$-points. 
+
+Note that the definition of the scale factors ($i.e.$ as the analytical first derivative 
+of the transformation that gives $(\lambda,\varphi,z)$ as a function of $(i,j,k)$) is 
+specific to the \NEMO model \citep{Marti_al_JGR92}. As an example, $e_{1t}$ is defined 
+locally at a $t$-point, whereas many other models on a C grid choose to define 
+such a scale factor as the distance between the $U$-points on each side of the 
+$t$-point. Relying on an analytical transformation has two advantages: firstly, there 
+is no ambiguity in the scale factors appearing in the discrete equations, since they 
+are first introduced in the continuous equations; secondly, analytical transformations 
+encourage good practice by the definition of smoothly varying grids (rather than 
+allowing the user to set arbitrary jumps in thickness between adjacent layers) 
+\citep{Treguier1996}. An example of the effect of such a choice is shown in 
+Fig.~\ref{Fig_zgr_e3}.
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]     \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_zgr_e3}
+\caption{ \label{Fig_zgr_e3}    
+Comparison of (a) traditional definitions of grid-point position and grid-size in the vertical, 
+and (b) analytically derived grid-point position and scale factors. 
+For both grids here,  the same $w$-point depth has been chosen but in (a) the 
+$t$-points are set half way between $w$-points while in (b) they are defined from 
+an analytical function: $z(k)=5\,(k-1/2)^3 - 45\,(k-1/2)^2 + 140\,(k-1/2) - 150$. 
+Note the resulting difference between the value of the grid-size $\Delta_k$ and 
+those of the scale factor $e_k$. }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        Choice of horizontal grid
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Choice of horizontal grid}
+\label{DOM_hgr_msh_choice}
+
+The user has three options available in defining a horizontal grid, which involve 
+the namelist variable \np{jphgr\_mesh} of the \ngn{namcfg} namelist. 
+\begin{description}
+\item[\np{jphgr\_mesh}=0]  The most general curvilinear orthogonal grids.
+The coordinates and their first derivatives with respect to $i$ and $j$ are provided
+in a input file (\ifile{coordinates}), read in \rou{hgr\_read} subroutine of the domhgr module.
+\item[\np{jphgr\_mesh}=1 to 5] A few simple analytical grids are provided (see below). 
+For other analytical grids, the \mdl{domhgr} module must be modified by the user. 
+\end{description}
+
+There are two simple cases of geographical grids on the sphere. With 
+\np{jphgr\_mesh}=1, the grid (expressed in degrees) is regular in space, 
+with grid sizes specified by parameters \np{ppe1\_deg} and \np{ppe2\_deg}, 
+respectively. Such a geographical grid can be very anisotropic at high latitudes 
+because of the convergence of meridians (the zonal scale factors $e_1$ 
+become much smaller than the meridional scale factors $e_2$). The Mercator 
+grid (\np{jphgr\_mesh}=4) avoids this anisotropy by refining the meridional scale 
+factors in the same way as the zonal ones. In this case, meridional scale factors 
+and latitudes are calculated analytically using the formulae appropriate for 
+a Mercator projection, based on \np{ppe1\_deg} which is a reference grid spacing 
+at the equator (this applies even when the geographical equator is situated outside 
+the model domain). 
+%%%
+\gmcomment{ give here the analytical expression of the Mercator mesh}
+%%%
+In these two cases (\np{jphgr\_mesh}=1 or 4), the grid position is defined by the 
+longitude and latitude of the south-westernmost point (\np{ppglamt0} 
+and \np{ppgphi0}). Note that for the Mercator grid the user need only provide 
+an approximate starting latitude: the real latitude will be recalculated analytically, 
+in order to ensure that the equator corresponds to line passing through $t$- 
+and $u$-points.  
+
+Rectangular grids ignoring the spherical geometry are defined with 
+\np{jphgr\_mesh} = 2, 3, 5. The domain is either an $f$-plane (\np{jphgr\_mesh} = 2, 
+Coriolis factor is constant) or a beta-plane (\np{jphgr\_mesh} = 3, the Coriolis factor 
+is linear in the $j$-direction). The grid size is uniform in meter in each direction, 
+and given by the parameters \np{ppe1\_m} and \np{ppe2\_m} respectively. 
+The zonal grid coordinate (\textit{glam} arrays) is in kilometers, starting at zero 
+with the first $t$-point. The meridional coordinate (gphi. arrays) is in kilometers, 
+and the second $t$-point corresponds to coordinate $gphit=0$. The input 
+variable \np{ppglam0} is ignored. \np{ppgphi0} is used to set the reference 
+latitude for computation of the Coriolis parameter. In the case of the beta plane, 
+\np{ppgphi0} corresponds to the center of the domain. Finally, the special case 
+\np{jphgr\_mesh}=5 corresponds to a beta plane in a rotated domain for the 
+GYRE configuration, representing a classical mid-latitude double gyre system. 
+The rotation allows us to maximize the jet length relative to the gyre areas 
+(and the number of grid points). 
+
+The choice of the grid must be consistent with the boundary conditions specified 
+by \np{jperio}, a parameter found in \ngn{namcfg} namelist (see {\S\ref{LBC}).
+
+% -------------------------------------------------------------------------------------------------------------
+%        Grid files
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Output Grid files}
+\label{DOM_hgr_files}
+
+All the arrays relating to a particular ocean model configuration (grid-point 
+position, scale factors, masks) can be saved in files if $\np{nn\_msh} \not= 0$ 
+(namelist variable in \ngn{namdom}). This can be particularly useful for plots and off-line 
+diagnostics. In some cases, the user may choose to make a local modification 
+of a scale factor in the code. This is the case in global configurations when 
+restricting the width of a specific strait (usually a one-grid-point strait that 
+happens to be too wide due to insufficient model resolution). An example 
+is Gibraltar Strait in the ORCA2 configuration. When such modifications are done, 
+the output grid written when $\np{nn\_msh} \not=0$ is no more equal to the input grid.
+
+$\ $\newline    % force a new line
+
+% ================================================================
+% Domain: Vertical Grid (domzgr)
+% ================================================================
+\section  [Domain: Vertical Grid (\textit{domzgr})]
+		{Domain: Vertical Grid \small{(\mdl{domzgr} module)} }
+\label{DOM_zgr}
+%-----------------------------------------nam_zgr & namdom-------------------------------------------
+\namdisplay{namzgr} 
+\namdisplay{namdom} 
+%-------------------------------------------------------------------------------------------------------------
+
+Variables are defined through the \ngn{namzgr} and \ngn{namdom} namelists.
+In the vertical, the model mesh is determined by four things: 
+(1) the bathymetry given in meters ; 
+(2) the number of levels of the model (\jp{jpk}) ; 
+(3) the analytical transformation $z(i,j,k)$ and the vertical scale factors 
+(derivatives of the transformation) ; 
+and (4) the masking system, $i.e.$ the number of wet model levels at each 
+$(i,j)$ column of points.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tb]    \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_z_zps_s_sps}
+\caption{  \label{Fig_z_zps_s_sps}   
+The ocean bottom as seen by the model: 
+(a) $z$-coordinate with full step, 
+(b) $z$-coordinate with partial step, 
+(c) $s$-coordinate: terrain following representation, 
+(d) hybrid $s-z$ coordinate, 
+(e) hybrid $s-z$ coordinate with partial step, and 
+(f) same as (e) but in the non-linear free surface (\np{ln\_linssh}=false). 
+Note that the non-linear free surface can be used with any of the 
+5 coordinates (a) to (e).}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The choice of a vertical coordinate, even if it is made through \ngn{namzgr} namelist parameters, 
+must be done once of all at the beginning of an experiment. It is not intended as an 
+option which can be enabled or disabled in the middle of an experiment. Three main 
+choices are offered (Fig.~\ref{Fig_z_zps_s_sps}a to c): $z$-coordinate with full step 
+bathymetry (\np{ln\_zco}~=~true), $z$-coordinate with partial step bathymetry 
+(\np{ln\_zps}~=~true), or generalized, $s$-coordinate (\np{ln\_sco}~=~true). 
+Hybridation of the three main coordinates are available: $s-z$ or $s-zps$ coordinate 
+(Fig.~\ref{Fig_z_zps_s_sps}d and \ref{Fig_z_zps_s_sps}e). By default a non-linear free surface is used:
+the coordinate follow the time-variation of the free surface so that the transformation is time dependent: 
+$z(i,j,k,t)$ (Fig.~\ref{Fig_z_zps_s_sps}f). When a linear free surface is assumed (\np{ln\_linssh}=true), 
+the vertical coordinate are fixed in time, but the seawater can move up and down across the z=0 surface 
+(in other words, the top of the ocean in not a rigid-lid). 
+The last choice in terms of vertical coordinate concerns the presence (or not) in the model domain 
+of ocean cavities beneath ice shelves. Setting \np{ln\_isfcav} to true allows to manage ocean cavities, 
+otherwise they are filled in. This option is currently only available in $z$- or $zps$-coordinate,
+and partial step are also applied at the ocean/ice shelf interface. 
+
+Contrary to the horizontal grid, the vertical grid is computed in the code and no 
+provision is made for reading it from a file. The only input file is the bathymetry 
+(in meters) (\ifile{bathy\_meter}). 
+\footnote{N.B. in full step $z$-coordinate, a \ifile{bathy\_level} file can replace the 
+\ifile{bathy\_meter} file, so that the computation of the number of wet ocean point 
+in each water column is by-passed}. 
+If \np{ln\_isfcav}~=~true, an extra file input file describing the ice shelf draft 
+(in meters) (\ifile{isf\_draft\_meter}) is needed.
+
+After reading the bathymetry, the algorithm for vertical grid definition differs 
+between the different options:
+\begin{description}
+\item[\textit{zco}] set a reference coordinate transformation $z_0 (k)$, and set $z(i,j,k,t)=z_0 (k)$.
+\item[\textit{zps}] set a reference coordinate transformation $z_0 (k)$, and 
+calculate the thickness of the deepest level at each $(i,j)$ point using the 
+bathymetry, to obtain the final three-dimensional depth and scale factor arrays.
+\item[\textit{sco}] smooth the bathymetry to fulfil the hydrostatic consistency 
+criteria and set the three-dimensional transformation.
+\item[\textit{s-z} and \textit{s-zps}] smooth the bathymetry to fulfil the hydrostatic 
+consistency criteria and set the three-dimensional transformation $z(i,j,k)$, and 
+possibly introduce masking of extra land points to better fit the original bathymetry file
+\end{description}
+%%%
+\gmcomment{   add the description of the smoothing:  envelop topography...}
+%%%
+
+Unless a linear free surface is used (\np{ln\_linssh}=false), the arrays describing 
+the grid point depths and vertical scale factors are three set of three dimensional arrays $(i,j,k)$ 
+defined at \textit{before}, \textit{now} and \textit{after} time step. The time at which they are
+defined is indicated by a suffix:$\_b$, $\_n$, or $\_a$, respectively. They are updated at each model time step
+using a fixed reference coordinate system which computer names have a $\_0$ suffix. 
+When the linear free surface option is used (\np{ln\_linssh}=true), \textit{before}, \textit{now} 
+and \textit{after} arrays are simply set one for all to their reference counterpart. 
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Meter Bathymetry
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Meter Bathymetry}
+\label{DOM_bathy}
+
+Three options are possible for defining the bathymetry, according to the 
+namelist variable \np{nn\_bathy} (found in \ngn{namdom} namelist): 
+\begin{description}
+\item[\np{nn\_bathy} = 0] a flat-bottom domain is defined. The total depth $z_w (jpk)$ 
+is given by the coordinate transformation. The domain can either be a closed 
+basin or a periodic channel depending on the parameter \np{jperio}. 
+\item[\np{nn\_bathy} = -1] a domain with a bump of topography one third of the 
+domain width at the central latitude. This is meant for the "EEL-R5" configuration, 
+a periodic or open boundary channel with a seamount. 
+\item[\np{nn\_bathy} = 1] read a bathymetry and ice shelf draft (if needed).
+ The \ifile{bathy\_meter} file (Netcdf format) provides the ocean depth (positive, in meters)
+ at each grid point of the model grid. The bathymetry is usually built by interpolating a standard bathymetry product 
+($e.g.$ ETOPO2) onto the horizontal ocean mesh. Defining the bathymetry also 
+defines the coastline: where the bathymetry is zero, no model levels are defined 
+(all levels are masked).
+
+The \ifile{isfdraft\_meter} file (Netcdf format) provides the ice shelf draft (positive, in meters)
+ at each grid point of the model grid. This file is only needed if \np{ln\_isfcav}~=~true. 
+Defining the ice shelf draft will also define the ice shelf edge and the grounding line position.
+\end{description}
+
+When a global ocean is coupled to an atmospheric model it is better to represent 
+all large water bodies (e.g, great lakes, Caspian sea...) even if the model 
+resolution does not allow their communication with the rest of the ocean. 
+This is unnecessary when the ocean is forced by fixed atmospheric conditions, 
+so these seas can be removed from the ocean domain. The user has the option 
+to set the bathymetry in closed seas to zero (see \S\ref{MISC_closea}), but the 
+code has to be adapted to the user's configuration. 
+
+% -------------------------------------------------------------------------------------------------------------
+%        z-coordinate  and reference coordinate transformation
+% -------------------------------------------------------------------------------------------------------------
+\subsection[$z$-coordinate (\np{ln\_zco}]
+	  	  {$z$-coordinate (\np{ln\_zco}=true) and reference coordinate}
+\label{DOM_zco}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tb]    \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_zgr}
+\caption{ \label{Fig_zgr}    
+Default vertical mesh for ORCA2: 30 ocean levels (L30). Vertical level functions for 
+(a) T-point depth and (b) the associated scale factor as computed 
+from \eqref{DOM_zgr_ana} using \eqref{DOM_zgr_coef} in $z$-coordinate.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The reference coordinate transformation $z_0 (k)$ defines the arrays $gdept_0$ 
+and $gdepw_0$ for $t$- and $w$-points, respectively. As indicated on 
+Fig.\ref{Fig_index_vert} \jp{jpk} is the number of $w$-levels. $gdepw_0(1)$ is the 
+ocean surface. There are at most \jp{jpk}-1 $t$-points inside the ocean, the 
+additional $t$-point at $jk=jpk$ is below the sea floor and is not used. 
+The vertical location of $w$- and $t$-levels is defined from the analytic expression 
+of the depth $z_0(k)$ whose analytical derivative with respect to $k$ provides the 
+vertical scale factors. The user must provide the analytical expression of both 
+$z_0$ and its first derivative with respect to $k$. This is done in routine \mdl{domzgr} 
+through statement functions, using parameters provided in the \ngn{namcfg} namelist. 
+
+It is possible to define a simple regular vertical grid by giving zero stretching (\np{ppacr=0}). 
+In that case, the parameters \jp{jpk} (number of $w$-levels) and \np{pphmax} 
+(total ocean depth in meters) fully define the grid. 
+
+For climate-related studies it is often desirable to concentrate the vertical resolution 
+near the ocean surface. The following function is proposed as a standard for a 
+$z$-coordinate (with either full or partial steps): 
+\begin{equation} \label{DOM_zgr_ana}
+\begin{split}
+ z_0 (k) 	&= h_{sur} -h_0 \;k-\;h_1 \;\log \left[ {\,\cosh \left( {{(k-h_{th} )} / {h_{cr} }} \right)\,} \right] \\ 
+ e_3^0 (k) 	&= \left| -h_0 -h_1 \;\tanh \left( {{(k-h_{th} )} / {h_{cr} }} \right) \right| 
+\end{split}
+\end{equation}
+where $k=1$ to \jp{jpk} for $w$-levels and $k=1$ to $k=1$ for $T-$levels. Such an 
+expression allows us to define a nearly uniform vertical location of levels at the 
+ocean top and bottom with a smooth hyperbolic tangent transition in between 
+(Fig.~\ref{Fig_zgr}).
+
+If the ice shelf cavities are opened (\np{ln\_isfcav}=~true~}), the definition of $z_0$ is the same. 
+However, definition of $e_3^0$ at $t$- and $w$-points is respectively changed to:
+\begin{equation} \label{DOM_zgr_ana}
+\begin{split}
+ e_3^T(k) &= z_W (k+1) - z_W (k)   \\
+ e_3^W(k) &= z_T (k)   - z_T (k-1) \\
+\end{split}
+\end{equation}
+This formulation decrease the self-generated circulation into the ice shelf cavity 
+(which can, in extreme case, leads to blow up).\\
+
+ 
+The most used vertical grid for ORCA2 has $10~m$ ($500~m)$ resolution in the 
+surface (bottom) layers and a depth which varies from 0 at the sea surface to a 
+minimum of $-5000~m$. This leads to the following conditions:
+\begin{equation} \label{DOM_zgr_coef}
+\begin{split}
+ e_3 (1+1/2)		&=10. \\ 
+ e_3 (jpk-1/2)	&=500. \\ 
+ z(1)			&=0. \\ 
+ z(jpk)			&=-5000. \\ 
+\end{split}
+\end{equation}
+
+With the choice of the stretching $h_{cr} =3$ and the number of levels 
+\jp{jpk}=$31$, the four coefficients $h_{sur}$, $h_{0}$, $h_{1}$, and $h_{th}$ in 
+\eqref{DOM_zgr_ana} have been determined such that \eqref{DOM_zgr_coef} is 
+satisfied, through an optimisation procedure using a bisection method. For the first 
+standard ORCA2 vertical grid this led to the following values: $h_{sur} =4762.96$, 
+$h_0 =255.58, h_1 =245.5813$, and $h_{th} =21.43336$. The resulting depths and 
+scale factors as a function of the model levels are shown in Fig.~\ref{Fig_zgr} and 
+given in Table \ref{Tab_orca_zgr}. Those values correspond to the parameters 
+\np{ppsur}, \np{ppa0}, \np{ppa1}, \np{ppkth} in \ngn{namcfg} namelist. 
+
+Rather than entering parameters $h_{sur}$, $h_{0}$, and $h_{1}$ directly, it is 
+possible to recalculate them. In that case the user sets 
+\np{ppsur}=\np{ppa0}=\np{ppa1}=999999., in \ngn{namcfg} namelist, 
+and specifies instead the four following parameters:
+\begin{itemize}
+\item 	\np{ppacr}=$h_{cr} $: stretching factor (nondimensional). The larger 
+\np{ppacr}, the smaller the stretching. Values from $3$ to $10$ are usual.
+\item 	\np{ppkth}=$h_{th} $: is approximately the model level at which maximum 
+stretching occurs (nondimensional, usually of order 1/2 or 2/3 of \jp{jpk})
+\item 	\np{ppdzmin}: minimum thickness for the top layer (in meters)
+\item 	\np{pphmax}: total depth of the ocean (meters).
+\end{itemize}
+As an example, for the $45$ layers used in the DRAKKAR configuration those 
+parameters are: \jp{jpk}=46, \np{ppacr}=9, \np{ppkth}=23.563, \np{ppdzmin}=6m, 
+\np{pphmax}=5750m.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{table}     \begin{center} \begin{tabular}{c||r|r|r|r}
+\hline
+\textbf{LEVEL}& \textbf{gdept}& \textbf{gdepw}& \textbf{e3t }& \textbf{e3w  } \\ \hline
+1	&	\textbf{  5.00}	&       0.00 &	\textbf{ 10.00} &	 10.00 \\	\hline
+2	&	\textbf{15.00}	& 	  10.00 &	\textbf{ 10.00} &	 10.00 \\	\hline
+3	&	\textbf{25.00}	&	  20.00 &	\textbf{ 10.00} & 	 10.00 \\	\hline
+4	&	\textbf{35.01}	&	  30.00 & 	\textbf{ 10.01} & 	 10.00 \\	\hline
+5	&	\textbf{45.01}	&	  40.01 &	\textbf{ 10.01} &	 10.01 \\	\hline
+6	&	\textbf{55.03}	&	  50.02 &	\textbf{ 10.02} & 	 10.02 \\	\hline
+7	&	\textbf{65.06}	&	  60.04 &	\textbf{ 10.04} &	 10.03 \\	\hline
+8	&	\textbf{75.13}	&	  70.09 &	\textbf{ 10.09} &	 10.06 \\	\hline
+9	&	\textbf{85.25}	&	  80.18 &	\textbf{ 10.17} &	 10.12 \\	\hline
+10	& 	\textbf{95.49}	& 	  90.35 &	\textbf{ 10.33} &	 10.24 \\	\hline
+11	& 	\textbf{105.97}	& 	 100.69 &	\textbf{ 10.65} &	 10.47 \\	\hline
+12	& 	\textbf{116.90}	& 	 111.36 &	\textbf{ 11.27} &	 10.91 \\	\hline
+13	& 	\textbf{128.70}	& 	 122.65 &	\textbf{ 12.47} &	 11.77 \\	\hline
+14	& 	\textbf{142.20}	& 	 135.16 &	\textbf{ 14.78} &	 13.43 \\	\hline
+15	& 	\textbf{158.96}	& 	 150.03 &	\textbf{ 19.23} &	 16.65 \\	\hline
+16	& 	\textbf{181.96}	& 	 169.42 &	\textbf{ 27.66} &	 22.78 \\	\hline
+17	& 	\textbf{216.65}	& 	 197.37 & 	\textbf{ 43.26} &	 34.30 \\ \hline
+18	& 	\textbf{272.48}	& 	 241.13 & 	\textbf{ 70.88} &	 55.21 \\ \hline
+19	& 	\textbf{364.30}	& 	 312.74 & 	\textbf{116.11} &	 90.99 \\ \hline
+20	& 	\textbf{511.53}	& 	 429.72 & 	\textbf{181.55} & 	146.43 \\ \hline
+21	& 	\textbf{732.20}	& 	 611.89 & 	\textbf{261.03} & 	220.35 \\ \hline
+22	& 	\textbf{1033.22}&	 872.87 & 	\textbf{339.39} & 	301.42 \\ \hline
+23	& 	\textbf{1405.70}&	1211.59 & \textbf{402.26} & 	373.31 \\ \hline
+24	& 	\textbf{1830.89}&	1612.98 & \textbf{444.87} & 	426.00 \\ \hline
+25	& 	\textbf{2289.77}&	2057.13 & \textbf{470.55} & 	459.47 \\ \hline
+26	& 	\textbf{2768.24}&	2527.22 & \textbf{484.95} & 	478.83 \\ \hline
+27	& 	\textbf{3257.48}&	3011.90 & \textbf{492.70} & 	489.44 \\ \hline
+28	& 	\textbf{3752.44}&	3504.46 & \textbf{496.78} & 	495.07 \\ \hline
+29	& 	\textbf{4250.40}&	4001.16 & \textbf{498.90} & 	498.02 \\ \hline
+30	& 	\textbf{4749.91}&	4500.02 & \textbf{500.00} &	499.54 \\ \hline
+31	& 	\textbf{5250.23}&	5000.00 &	\textbf{500.56} &	500.33 \\ \hline
+\end{tabular} \end{center} 
+\caption{ \label{Tab_orca_zgr}   
+Default vertical mesh in $z$-coordinate for 30 layers ORCA2 configuration as computed 
+from \eqref{DOM_zgr_ana} using the coefficients given in \eqref{DOM_zgr_coef}}
+\end{table}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        z-coordinate with partial step
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [$z$-coordinate with partial step (\np{ln\_zps})]
+			{$z$-coordinate with partial step (\np{ln\_zps}=.true.)}
+\label{DOM_zps}
+%--------------------------------------------namdom-------------------------------------------------------
+\namdisplay{namdom} 
+%--------------------------------------------------------------------------------------------------------------
+
+In $z$-coordinate partial step, the depths of the model levels are defined by the 
+reference analytical function $z_0 (k)$ as described in the previous 
+section, \emph{except} in the bottom layer. The thickness of the bottom layer is 
+allowed to vary as a function of geographical location $(\lambda,\varphi)$ to allow a 
+better representation of the bathymetry, especially in the case of small 
+slopes (where the bathymetry varies by less than one level thickness from 
+one grid point to the next). The reference layer thicknesses $e_{3t}^0$ have been 
+defined in the absence of bathymetry. With partial steps, layers from 1 to 
+\jp{jpk}-2 can have a thickness smaller than $e_{3t}(jk)$. The model deepest layer (\jp{jpk}-1) 
+is allowed to have either a smaller or larger thickness than $e_{3t}(jpk)$: the 
+maximum thickness allowed is $2*e_{3t}(jpk-1)$. This has to be kept in mind when 
+specifying values in \ngn{namdom} namelist, as the maximum depth \np{pphmax} 
+in partial steps: for example, with 
+\np{pphmax}$=5750~m$ for the DRAKKAR 45 layer grid, the maximum ocean depth 
+allowed is actually $6000~m$ (the default thickness $e_{3t}(jpk-1)$ being $250~m$). 
+Two variables in the namdom namelist are used to define the partial step 
+vertical grid. The mimimum water thickness (in meters) allowed for a cell 
+partially filled with bathymetry at level jk is the minimum of \np{rn\_e3zps\_min} 
+(thickness in meters, usually $20~m$) or $e_{3t}(jk)*\np{rn\_e3zps\_rat}$ (a fraction, 
+usually 10\%, of the default thickness $e_{3t}(jk)$).
+
+\gmcomment{ \colorbox{yellow}{Add a figure here of pstep especially at last ocean level }  }
+
+% -------------------------------------------------------------------------------------------------------------
+%        s-coordinate
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [$s$-coordinate (\np{ln\_sco})]
+		     {$s$-coordinate (\np{ln\_sco}=true)}
+\label{DOM_sco}
+%------------------------------------------nam_zgr_sco---------------------------------------------------
+\namdisplay{namzgr_sco} 
+%--------------------------------------------------------------------------------------------------------------
+Options are defined in \ngn{namzgr\_sco}.
+In $s$-coordinate (\np{ln\_sco}~=~true), the depth and thickness of the model 
+levels are defined from the product of a depth field and either a stretching 
+function or its derivative, respectively:
+
+\begin{equation} \label{DOM_sco_ana}
+\begin{split}
+ z(k) 		&= h(i,j) \; z_0(k)	\\
+ e_3(k)	&= h(i,j) \; z_0'(k)
+\end{split}
+\end{equation}
+
+where $h$ is the depth of the last $w$-level ($z_0(k)$) defined at the $t$-point 
+location in the horizontal and $z_0(k)$ is a function which varies from $0$ at the sea 
+surface to $1$ at the ocean bottom. The depth field $h$ is not necessary the ocean 
+depth, since a mixed step-like and bottom-following representation of the 
+topography can be used (Fig.~\ref{Fig_z_zps_s_sps}d-e) or an envelop bathymetry can be defined (Fig.~\ref{Fig_z_zps_s_sps}f).
+The namelist parameter \np{rn\_rmax} determines the slope at which the terrain-following coordinate intersects 
+the sea bed and becomes a pseudo z-coordinate. 
+The coordinate can also be hybridised by specifying \np{rn\_sbot\_min} and \np{rn\_sbot\_max} 
+as the minimum and maximum depths at which the terrain-following vertical coordinate is calculated.
+
+Options for stretching the coordinate are provided as examples, but care must be taken to ensure 
+that the vertical stretch used is appropriate for the application.
+
+The original default NEMO s-coordinate stretching is available if neither of the other options 
+are specified as true (\np{ln\_s\_SH94}~=~false and \np{ln\_s\_SF12}~=~false). 
+This uses a depth independent $\tanh$ function for the stretching \citep{Madec_al_JPO96}:
+
+\begin{equation}
+  z = s_{min}+C\left(s\right)\left(H-s_{min}\right)
+  \label{eq:SH94_1}
+\end{equation}
+
+where $s_{min}$ is the depth at which the $s$-coordinate stretching starts and 
+allows a $z$-coordinate to placed on top of the stretched coordinate, 
+and $z$ is the depth (negative down from the asea surface).
+
+\begin{equation}
+  s = -\frac{k}{n-1} \quad \text{ and } \quad 0 \leq k \leq n-1
+  \label{eq:s}
+\end{equation}
+
+\begin{equation} \label{DOM_sco_function}
+\begin{split}
+C(s)	&=  \frac{ \left[	  \tanh{ \left( \theta \, (s+b) \right)} 
+	  	 			- \tanh{ \left(  \theta \, b      \right)}  \right]}
+		      {2\;\sinh \left( \theta \right)}
+\end{split}
+\end{equation}
+
+A stretching function, modified from the commonly used \citet{Song_Haidvogel_JCP94} 
+stretching (\np{ln\_s\_SH94}~=~true), is also available and is more commonly used for shelf seas modelling:
+
+\begin{equation}
+  C\left(s\right) =   \left(1 - b \right)\frac{ \sinh\left( \theta s\right)}{\sinh\left(\theta\right)} +      \\
+  b\frac{ \tanh \left[ \theta \left(s + \frac{1}{2} \right)\right] - \tanh\left(\frac{\theta}{2}\right)}{ 2\tanh\left (\frac{\theta}{2}\right)}
+  \label{eq:SH94_2}
+\end{equation}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]    \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_sco_function}
+\caption{  \label{Fig_sco_function}   
+Examples of the stretching function applied to a seamount; from left to right: 
+surface, surface and bottom, and bottom intensified resolutions}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+where $H_c$ is the critical depth (\np{rn\_hc}) at which the coordinate transitions from 
+pure $\sigma$ to the stretched coordinate,  and $\theta$ (\np{rn\_theta}) and $b$ (\np{rn\_bb}) 
+are the surface and bottom control parameters such that $0\leqslant \theta \leqslant 20$, and 
+$0\leqslant b\leqslant 1$. $b$ has been designed to allow surface and/or bottom 
+increase of the vertical resolution (Fig.~\ref{Fig_sco_function}).
+
+Another example has been provided at version 3.5 (\np{ln\_s\_SF12}) that allows 
+a fixed surface resolution in an analytical terrain-following stretching \citet{Siddorn_Furner_OM12}. 
+In this case the a stretching function $\gamma$ is defined such that:
+
+\begin{equation}
+z = -\gamma h \quad \text{ with } \quad 0 \leq \gamma \leq 1
+\label{eq:z}
+\end{equation}
+
+The function is defined with respect to $\sigma$, the unstretched terrain-following coordinate:
+
+\begin{equation} \label{DOM_gamma_deriv}
+\gamma= A\left(\sigma-\frac{1}{2}\left(\sigma^{2}+f\left(\sigma\right)\right)\right)+B\left(\sigma^{3}-f\left(\sigma\right)\right)+f\left(\sigma\right)
+\end{equation}
+
+Where:
+\begin{equation} \label{DOM_gamma}
+f\left(\sigma\right)=\left(\alpha+2\right)\sigma^{\alpha+1}-\left(\alpha+1\right)\sigma^{\alpha+2} \quad \text{ and } \quad \sigma = \frac{k}{n-1} 
+\end{equation}
+
+This gives an analytical stretching of $\sigma$ that is solvable in $A$ and $B$ as a function of 
+the user prescribed stretching parameter $\alpha$ (\np{rn\_alpha}) that stretches towards 
+the surface ($\alpha > 1.0$) or the bottom ($\alpha < 1.0$) and user prescribed surface (\np{rn\_zs}) 
+and bottom depths. The bottom cell depth in this example is given as a function of water depth:
+
+\begin{equation} \label{DOM_zb}
+Z_b= h a + b
+\end{equation}
+
+where the namelist parameters \np{rn\_zb\_a} and \np{rn\_zb\_b} are $a$ and $b$ respectively.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]
+   \includegraphics[width=1.0\textwidth]{FIG_DOM_compare_coordinates_surface}
+        \caption{A comparison of the \citet{Song_Haidvogel_JCP94} $S$-coordinate (solid lines), a 50 level $Z$-coordinate (contoured surfaces) and the \citet{Siddorn_Furner_OM12} $S$-coordinate (dashed lines) in the surface 100m for a idealised bathymetry that goes from 50m to 5500m depth. For clarity every third coordinate surface is shown.}
+    \label{fig_compare_coordinates_surface}
+\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+This gives a smooth analytical stretching in computational space that is constrained to given specified surface and bottom grid cell thicknesses in real space. This is not to be confused with the hybrid schemes that superimpose geopotential coordinates on terrain following coordinates thus creating a non-analytical vertical coordinate that therefore may suffer from large gradients in the vertical resolutions. This stretching is less straightforward to implement than the \citet{Song_Haidvogel_JCP94} stretching, but has the advantage of resolving diurnal processes in deep water and has generally flatter slopes.
+
+As with the \citet{Song_Haidvogel_JCP94} stretching the stretch is only applied at depths greater than the critical depth $h_c$. In this example two options are available in depths shallower than $h_c$, with pure sigma being applied if the \np{ln\_sigcrit} is true and pure z-coordinates if it is false (the z-coordinate being equal to the depths of the stretched coordinate at $h_c$.
+
+Minimising the horizontal slope of the vertical coordinate is important in terrain-following systems as large slopes lead to hydrostatic consistency. A hydrostatic consistency parameter diagnostic following \citet{Haney1991} has been implemented, and is output as part of the model mesh file at the start of the run.
+
+% -------------------------------------------------------------------------------------------------------------
+%        z*- or s*-coordinate
+% -------------------------------------------------------------------------------------------------------------
+\subsection{$z^*$- or $s^*$-coordinate (\np{ln\_linssh}=false) }
+\label{DOM_zgr_star}
+
+This option is described in the Report by Levier \textit{et al.} (2007), available on the \NEMO web site. 
+
+%gm% key advantage: minimise the diffusion/dispertion associated with advection in response to high frequency surface disturbances
+
+% -------------------------------------------------------------------------------------------------------------
+%        level bathymetry and mask 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{level bathymetry and mask}
+\label{DOM_msk}
+
+Whatever the vertical coordinate used, the model offers the possibility of 
+representing the bottom topography with steps that follow the face of the 
+model cells (step like topography) \citep{Madec_al_JPO96}. The distribution of 
+the steps in the horizontal is defined in a 2D integer array, mbathy, which 
+gives the number of ocean levels ($i.e.$ those that are not masked) at each 
+$t$-point. mbathy is computed from the meter bathymetry using the definiton of 
+gdept as the number of $t$-points which gdept $\leq$ bathy.
+
+Modifications of the model bathymetry are performed in the \textit{bat\_ctl} 
+routine (see \mdl{domzgr} module) after mbathy is computed. Isolated grid points 
+that do not communicate with another ocean point at the same level are eliminated.
+
+As for the representation of bathymetry, a 2D integer array, misfdep, is created. 
+misfdep defines the level of the first wet $t$-point. All the cells between $k=1$ and $misfdep(i,j)-1$ are masked. 
+By default, misfdep(:,:)=1 and no cells are masked.
+
+In case of ice shelf cavities, modifications of the model bathymetry and ice shelf draft into 
+the cavities are performed in the \textit{zgr\_isf} routine. The compatibility between ice shelf draft and bathymetry is checked. 
+All the locations where the isf cavity is thinnest than \np{rn\_isfhmin} meters are grounded ($i.e.$ masked). 
+If only one cell on the water column is opened at $t$-, $u$- or $v$-points, the bathymetry or the ice shelf draft is dug to fit this constrain.
+If the incompatibility is too strong (need to dig more than 1 cell), the cell is masked.\\ 
+
+From the \textit{mbathy} and \textit{misfdep} array, the mask fields are defined as follows:
+\begin{align*}
+tmask(i,j,k) &= \begin{cases}   \; 0&   \text{ if $k < misfdep(i,j) $ } \\
+                                \; 1&   \text{ if $misfdep(i,j) \leq k\leq mbathy(i,j)$  }    \\
+                                \; 0&   \text{ if $k > mbathy(i,j)$  }    \end{cases}     \\
+umask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i+1,j,k)	\\
+vmask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i,j+1,k)	\\
+fmask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i+1,j,k)	\\
+             &    \ \ \, * tmask(i,j,k) \ * \ tmask(i+1,j,k) \\
+wmask(i,j,k) &=         \; tmask(i,j,k) \ * \ tmask(i,j,k-1) \text{ with } wmask(i,j,1) = tmask(i,j,1) 
+\end{align*}
+
+Note that, without ice shelves cavities, masks at $t-$ and $w-$points are identical with 
+the numerical indexing used (\S~\ref{DOM_Num_Index}). Nevertheless, $wmask$ are required 
+with oceean cavities to deal with the top boundary (ice shelf/ocean interface) 
+exactly in the same way as for the bottom boundary. 
+
+The specification of closed lateral boundaries requires that at least the first and last 
+rows and columns of the \textit{mbathy} array are set to zero. In the particular 
+case of an east-west cyclical boundary condition, \textit{mbathy} has its last 
+column equal to the second one and its first column equal to the last but one 
+(and so too the mask arrays) (see \S~\ref{LBC_jperio}).
+
+
+% ================================================================
+% Domain: Initial State (dtatsd & istate)
+% ================================================================
+\section  [Domain: Initial State (\textit{istate and dtatsd})]
+		{Domain: Initial State \small{(\mdl{istate} and \mdl{dtatsd} modules)} }
+\label{DTA_tsd}
+%-----------------------------------------namtsd-------------------------------------------
+\namdisplay{namtsd} 
+%------------------------------------------------------------------------------------------
+
+Options are defined in \ngn{namtsd}.
+By default, the ocean start from rest (the velocity field is set to zero) and the initialization of 
+temperature and salinity fields is controlled through the \np{ln\_tsd\_ini} namelist parameter.
+\begin{description}
+\item[ln\_tsd\_init = .true.]  use a T and S input files that can be given on the model grid itself or 
+on their native input data grid. In the latter case, the data will be interpolated on-the-fly both in the 
+horizontal and the vertical to the model grid (see \S~\ref{SBC_iof}). The information relative to the 
+input files are given in the \np{sn\_tem} and \np{sn\_sal} structures. 
+The computation is done in the \mdl{dtatsd} module.
+\item[ln\_tsd\_init = .false.] use constant salinity value of 35.5 psu and an analytical profile of temperature
+(typical of the tropical ocean), see \rou{istate\_t\_s} subroutine called from \mdl{istate} module.
+\end{description}
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DYN.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 8732)
@@ -0,0 +1,1267 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter ——— Ocean Dynamics (DYN)
+% ================================================================
+\chapter{Ocean Dynamics (DYN)}
+\label{DYN}
+\minitoc
+
+%\vspace{2.cm}
+$\ $\newline      %force an empty line
+
+Using the representation described in Chapter \ref{DOM}, several semi-discrete 
+space forms of the dynamical equations are available depending on the vertical 
+coordinate used and on the conservation properties of the vorticity term. In all 
+the equations presented here, the masking has been omitted for simplicity. 
+One must be aware that all the quantities are masked fields and that each time an
+average or difference operator is used, the resulting field is multiplied by a mask.
+
+The prognostic ocean dynamics equation can be summarized as follows:
+\begin{equation*}
+\text{NXT} = \dbinom	{\text{VOR} + \text{KEG} + \text {ZAD} }
+						{\text{COR} + \text{ADV}                       }
+			+ \text{HPG} + \text{SPG} + \text{LDF} + \text{ZDF}
+\end{equation*}
+NXT stands for next, referring to the time-stepping. The first group of terms on 
+the rhs of this equation corresponds to the Coriolis and advection 
+terms that are decomposed into either a vorticity part (VOR), a kinetic energy part (KEG) 
+and a vertical advection part (ZAD) in the vector invariant formulation, or a Coriolis 
+and advection part (COR+ADV) in the flux formulation. The terms following these 
+are the pressure gradient contributions (HPG, Hydrostatic Pressure Gradient, 
+and SPG, Surface Pressure Gradient); and contributions from lateral diffusion 
+(LDF) and vertical diffusion (ZDF), which are added to the rhs in the \mdl{dynldf} 
+and \mdl{dynzdf} modules. The vertical diffusion term includes the surface and 
+bottom stresses. The external forcings and parameterisations require complex 
+inputs (surface wind stress calculation using bulk formulae, estimation of mixing 
+coefficients) that are carried out in modules SBC, LDF and ZDF and are described 
+in Chapters \ref{SBC}, \ref{LDF} and \ref{ZDF}, respectively. 
+
+In the present chapter we also describe the diagnostic equations used to compute 
+the horizontal divergence, curl of the velocities (\emph{divcur} module) and 
+the vertical velocity (\emph{wzvmod} module).
+
+The different options available to the user are managed by namelist variables. 
+For term \textit{ttt} in the momentum equations, the logical namelist variables are \textit{ln\_dynttt\_xxx}, 
+where \textit{xxx} is a 3 or 4 letter acronym corresponding to each optional scheme. 
+If a CPP key is used for this term its name is \textbf{key\_ttt}. The corresponding 
+code can be found in the \textit{dynttt\_xxx} module in the DYN directory, and it is 
+usually computed in the \textit{dyn\_ttt\_xxx} subroutine.
+
+The user has the option of extracting and outputting each tendency term from the
+3D momentum equations (\key{trddyn} defined), as described in 
+Chap.\ref{MISC}.  Furthermore, the tendency terms associated with the 2D 
+barotropic vorticity balance (when \key{trdvor} is defined) can be derived from the 
+3D terms.
+%%%
+\gmcomment{STEVEN: not quite sure I've got the sense of the last sentence. does 
+MISC correspond to "extracting tendency terms" or "vorticity balance"?}
+
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Sea Surface Height evolution & Diagnostics variables
+% ================================================================
+\section{Sea surface height and diagnostic variables ($\eta$, $\zeta$, $\chi$, $w$)}
+\label{DYN_divcur_wzv}
+
+%--------------------------------------------------------------------------------------------------------------
+%           Horizontal divergence and relative vorticity
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Horizontal divergence and relative vorticity (\textit{divcur})]
+			{Horizontal divergence and relative vorticity (\mdl{divcur})}
+\label{DYN_divcur}
+
+The vorticity is defined at an $f$-point ($i.e.$ corner point) as follows:
+\begin{equation} \label{Eq_divcur_cur}
+\zeta =\frac{1}{e_{1f}\,e_{2f} }\left( {\;\delta _{i+1/2} \left[ {e_{2v}\;v} \right]
+						        -\delta _{j+1/2} \left[ {e_{1u}\;u} \right]\;} \right)
+\end{equation} 
+
+The horizontal divergence is defined at a $T$-point. It is given by:
+\begin{equation} \label{Eq_divcur_div}
+\chi =\frac{1}{e_{1t}\,e_{2t}\,e_{3t} }
+		\left( {\delta _i \left[ {e_{2u}\,e_{3u}\,u} \right]
+		       +\delta _j \left[ {e_{1v}\,e_{3v}\,v} \right]} \right)
+\end{equation} 
+
+Note that although the vorticity has the same discrete expression in $z$- 
+and $s$-coordinates, its physical meaning is not identical. $\zeta$ is a pseudo 
+vorticity along $s$-surfaces (only pseudo because $(u,v)$ are still defined along 
+geopotential surfaces, but are not necessarily defined at the same depth).
+
+The vorticity and divergence at the \textit{before} step are used in the computation 
+of the horizontal diffusion of momentum. Note that because they have been 
+calculated prior to the Asselin filtering of the \textit{before} velocities, the 
+\textit{before} vorticity and divergence arrays must be included in the restart file 
+to ensure perfect restartability. The vorticity and divergence at the \textit{now} 
+time step are used for the computation of the nonlinear advection and of the 
+vertical velocity respectively. 
+
+%--------------------------------------------------------------------------------------------------------------
+%           Sea Surface Height evolution
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Sea surface height evolution and vertical velocity (\textit{sshwzv})]
+			{Horizontal divergence and relative vorticity (\mdl{sshwzv})}
+\label{DYN_sshwzv}
+
+The sea surface height is given by :
+\begin{equation} \label{Eq_dynspg_ssh}
+\begin{aligned}
+\frac{\partial \eta }{\partial t}
+&\equiv    \frac{1}{e_{1t} e_{2t} }\sum\limits_k { \left\{  \delta _i \left[ {e_{2u}\,e_{3u}\;u} \right]
+                                                                                  +\delta _j \left[ {e_{1v}\,e_{3v}\;v} \right]  \right\} } 
+           -    \frac{\textit{emp}}{\rho _w }   \\
+&\equiv    \sum\limits_k {\chi \ e_{3t}}  -  \frac{\textit{emp}}{\rho _w }
+\end{aligned}
+\end{equation}
+where \textit{emp} is the surface freshwater budget (evaporation minus precipitation), 
+expressed in Kg/m$^2$/s (which is equal to mm/s), and $\rho _w$=1,035~Kg/m$^3$ 
+is the reference density of sea water (Boussinesq approximation). If river runoff is 
+expressed as a surface freshwater flux (see \S\ref{SBC}) then \textit{emp} can be 
+written as the evaporation minus precipitation, minus the river runoff. 
+The sea-surface height is evaluated using exactly the same time stepping scheme 
+as the tracer equation \eqref{Eq_tra_nxt}: 
+a leapfrog scheme in combination with an Asselin time filter, $i.e.$ the velocity appearing 
+in \eqref{Eq_dynspg_ssh} is centred in time (\textit{now} velocity). 
+This is of paramount importance. Replacing $T$ by the number $1$ in the tracer equation and summing
+over the water column must lead to the sea surface height equation otherwise tracer content
+will not be conserved \citep{Griffies_al_MWR01, Leclair_Madec_OM09}.
+
+The vertical velocity is computed by an upward integration of the horizontal 
+divergence starting at the bottom, taking into account the change of the thickness of the levels :
+\begin{equation} \label{Eq_wzv}
+\left\{   \begin{aligned}
+&\left. w \right|_{k_b-1/2} \quad= 0    \qquad \text{where } k_b \text{ is the level just above the sea floor }  	\\
+&\left. w \right|_{k+1/2}     = \left. w \right|_{k-1/2}  +  \left. e_{3t} \right|_{k}\;  \left. \chi \right|_k  
+                                         - \frac{1} {2 \rdt} \left(  \left. e_{3t}^{t+1}\right|_{k} - \left. e_{3t}^{t-1}\right|_{k}\right)
+\end{aligned}   \right.
+\end{equation}
+
+In the case of a non-linear free surface (\key{vvl}), the top vertical velocity is $-\textit{emp}/\rho_w$, 
+as changes in the divergence of the barotropic transport are absorbed into the change 
+of the level thicknesses, re-orientated downward.
+\gmcomment{not sure of this...  to be modified with the change in emp setting}
+In the case of a linear free surface, the time derivative in \eqref{Eq_wzv} disappears.
+The upper boundary condition applies at a fixed level $z=0$. The top vertical velocity 
+is thus equal to the divergence of the barotropic transport ($i.e.$ the first term in the
+right-hand-side of \eqref{Eq_dynspg_ssh}).
+
+Note also that whereas the vertical velocity has the same discrete 
+expression in $z$- and $s$-coordinates, its physical meaning is not the same: 
+in the second case, $w$ is the velocity normal to the $s$-surfaces. 
+Note also that the $k$-axis is re-orientated downwards in the \textsc{fortran} code compared 
+to the indexing used in the semi-discrete equations such as \eqref{Eq_wzv} 
+(see  \S\ref{DOM_Num_Index_vertical}). 
+
+
+% ================================================================
+% Coriolis and Advection terms: vector invariant form
+% ================================================================
+\section{Coriolis and Advection: vector invariant form}
+\label{DYN_adv_cor_vect}
+%-----------------------------------------nam_dynadv----------------------------------------------------
+\namdisplay{namdyn_adv} 
+%-------------------------------------------------------------------------------------------------------------
+
+The vector invariant form of the momentum equations is the one most 
+often used in applications of the \NEMO ocean model. The flux form option 
+(see next section) has been present since version $2$. Options are defined
+through the \ngn{namdyn\_adv} namelist variables
+Coriolis and momentum advection terms are evaluated using a leapfrog 
+scheme, $i.e.$ the velocity appearing in these expressions is centred in 
+time (\textit{now} velocity). 
+At the lateral boundaries either free slip, no slip or partial slip boundary 
+conditions are applied following Chap.\ref{LBC}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Vorticity term 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Vorticity term (\textit{dynvor}) ]
+			{Vorticity term (\mdl{dynvor})}
+\label{DYN_vor}
+%------------------------------------------nam_dynvor----------------------------------------------------
+\namdisplay{namdyn_vor} 
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namdyn\_vor} namelist variables.
+Four discretisations of the vorticity term (\textit{ln\_dynvor\_xxx}=true) are available: 
+conserving potential enstrophy of horizontally non-divergent flow (ENS scheme) ; 
+conserving horizontal kinetic energy (ENE scheme) ; conserving potential enstrophy for 
+the relative vorticity term and horizontal kinetic energy for the planetary vorticity 
+term (MIX scheme) ; or conserving both the potential enstrophy of horizontally non-divergent 
+flow and horizontal kinetic energy (EEN scheme) (see  Appendix~\ref{Apdx_C_vorEEN}). In the 
+case of ENS, ENE or MIX schemes the land sea mask may be slightly modified to ensure the 
+consistency of vorticity term with analytical equations (\textit{ln\_dynvor\_con}=true).
+The vorticity terms are all computed in dedicated routines that can be found in 
+the \mdl{dynvor} module.
+
+%-------------------------------------------------------------
+%                 enstrophy conserving scheme
+%-------------------------------------------------------------
+\subsubsection{Enstrophy conserving scheme (\np{ln\_dynvor\_ens}=true)}
+\label{DYN_vor_ens}
+
+In the enstrophy conserving case (ENS scheme), the discrete formulation of the 
+vorticity term provides a global conservation of the enstrophy 
+($ [ (\zeta +f ) / e_{3f} ]^2 $ in $s$-coordinates) for a horizontally non-divergent 
+flow ($i.e.$ $\chi$=$0$), but does not conserve the total kinetic energy. It is given by:
+\begin{equation} \label{Eq_dynvor_ens}
+\left\{ 
+\begin{aligned}
+{+\frac{1}{e_{1u} } } & {\overline {\left( { \frac{\zeta +f}{e_{3f} }} \right)} }^{\,i} 
+                                & {\overline{\overline {\left( {e_{1v}\,e_{3v}\;v} \right)}} }^{\,i, j+1/2}    \\
+{- \frac{1}{e_{2v} } } & {\overline {\left( {\frac{\zeta +f}{e_{3f} }} \right)} }^{\,j}  
+                                & {\overline{\overline {\left( {e_{2u}\,e_{3u}\;u} \right)}} }^{\,i+1/2, j}  
+\end{aligned} 
+ \right.
+\end{equation} 
+
+%-------------------------------------------------------------
+%                 energy conserving scheme
+%-------------------------------------------------------------
+\subsubsection{Energy conserving scheme (\np{ln\_dynvor\_ene}=true)}
+\label{DYN_vor_ene}
+
+The kinetic energy conserving scheme (ENE scheme) conserves the global 
+kinetic energy but not the global enstrophy. It is given by:
+\begin{equation} \label{Eq_dynvor_ene}
+\left\{   \begin{aligned}
+{+\frac{1}{e_{1u}}\; {\overline {\left( {\frac{\zeta +f}{e_{3f} }} \right)
+                            \;  \overline {\left( {e_{1v}\,e_{3v}\;v} \right)} ^{\,i+1/2}} }^{\,j} }    \\
+{- \frac{1}{e_{2v}}\; {\overline {\left( {\frac{\zeta +f}{e_{3f} }} \right)
+                            \;  \overline {\left( {e_{2u}\,e_{3u}\;u} \right)} ^{\,j+1/2}} }^{\,i} }
+\end{aligned}    \right.
+\end{equation} 
+
+%-------------------------------------------------------------
+%                 mix energy/enstrophy conserving scheme
+%-------------------------------------------------------------
+\subsubsection{Mixed energy/enstrophy conserving scheme (\np{ln\_dynvor\_mix}=true) }
+\label{DYN_vor_mix}
+
+For the mixed energy/enstrophy conserving scheme (MIX scheme), a mixture of the 
+two previous schemes is used. It consists of the ENS scheme (\ref{Eq_dynvor_ens}) 
+for the relative vorticity term, and of the ENE scheme (\ref{Eq_dynvor_ene}) applied 
+to the planetary vorticity term.
+\begin{equation} \label{Eq_dynvor_mix}
+\left\{ {     \begin{aligned}
+ {+\frac{1}{e_{1u} }\; {\overline {\left( {\frac{\zeta }{e_{3f} }} \right)} }^{\,i} 
+ \; {\overline{\overline {\left( {e_{1v}\,e_{3v}\;v} \right)}} }^{\,i,j+1/2} -\frac{1}{e_{1u} }
+ \; {\overline {\left( {\frac{f}{e_{3f} }} \right) 
+ \;\overline {\left( {e_{1v}\,e_{3v}\;v} \right)} ^{\,i+1/2}} }^{\,j} } \\
+{-\frac{1}{e_{2v} }\; {\overline {\left( {\frac{\zeta }{e_{3f} }} \right)} }^j
+ \; {\overline{\overline {\left( {e_{2u}\,e_{3u}\;u} \right)}} }^{\,i+1/2,j} +\frac{1}{e_{2v} }
+ \; {\overline {\left( {\frac{f}{e_{3f} }} \right)
+ \;\overline {\left( {e_{2u}\,e_{3u}\;u} \right)} ^{\,j+1/2}} }^{\,i} } \hfill
+\end{aligned}     } \right.
+\end{equation} 
+
+%-------------------------------------------------------------
+%                 energy and enstrophy conserving scheme
+%-------------------------------------------------------------
+\subsubsection{Energy and enstrophy conserving scheme (\np{ln\_dynvor\_een}=true) }
+\label{DYN_vor_een}
+
+In both the ENS and ENE schemes, it is apparent that the combination of $i$ and $j$ 
+averages of the velocity allows for the presence of grid point oscillation structures 
+that will be invisible to the operator. These structures are \textit{computational modes} 
+that will be at least partly damped by the momentum diffusion operator ($i.e.$ the 
+subgrid-scale advection), but not by the resolved advection term. The ENS and ENE schemes
+therefore do not contribute to dump any grid point noise in the horizontal velocity field.
+Such noise would result in more noise in the vertical velocity field, an undesirable feature. 
+This is a well-known characteristic of $C$-grid discretization where $u$ and $v$ are located 
+at different grid points, a price worth paying to avoid a double averaging in the pressure 
+gradient term as in the $B$-grid. 
+\gmcomment{ To circumvent this, Adcroft (ADD REF HERE) 
+Nevertheless, this technique strongly distort the phase and group velocity of Rossby waves....}
+
+A very nice solution to the problem of double averaging was proposed by \citet{Arakawa_Hsu_MWR90}. 
+The idea is to get rid of the double averaging by considering triad combinations of vorticity. 
+It is noteworthy that this solution is conceptually quite similar to the one proposed by
+\citep{Griffies_al_JPO98} for the discretization of the iso-neutral diffusion operator (see App.\ref{Apdx_C}).
+
+The \citet{Arakawa_Hsu_MWR90} vorticity advection scheme for a single layer is modified 
+for spherical coordinates as described by \citet{Arakawa_Lamb_MWR81} to obtain the EEN scheme. 
+First consider the discrete expression of the potential vorticity, $q$, defined at an $f$-point: 
+\begin{equation} \label{Eq_pot_vor}
+q  = \frac{\zeta +f} {e_{3f} }
+\end{equation}
+where the relative vorticity is defined by (\ref{Eq_divcur_cur}), the Coriolis parameter 
+is given by $f=2 \,\Omega \;\sin \varphi _f $ and the layer thickness at $f$-points is: 
+\begin{equation} \label{Eq_een_e3f}
+e_{3f} = \overline{\overline {e_{3t} }} ^{\,i+1/2,j+1/2}
+\end{equation}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]    \begin{center}
+\includegraphics[width=0.70\textwidth]{Fig_DYN_een_triad}
+\caption{ \label{Fig_DYN_een_triad}  
+Triads used in the energy and enstrophy conserving scheme (een) for 
+$u$-component (upper panel) and $v$-component (lower panel).}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+A key point in \eqref{Eq_een_e3f} is how the averaging in the \textbf{i}- and \textbf{j}- directions is made. 
+It uses the sum of masked t-point vertical scale factor divided either 
+by the sum of the four t-point masks (\np{nn\_een\_e3f}~=~1), 
+or  just by $4$ (\np{nn\_een\_e3f}~=~true).
+The latter case preserves the continuity of $e_{3f}$ when one or more of the neighbouring $e_{3t}$ 
+tends to zero and extends by continuity the value of $e_{3f}$ into the land areas. 
+This case introduces a sub-grid-scale topography at f-points (with a systematic reduction of $e_{3f}$ 
+when a model level intercept the bathymetry) that tends to reinforce the topostrophy of the flow 
+($i.e.$ the tendency of the flow to follow the isobaths) \citep{Penduff_al_OS07}. 
+
+Next, the vorticity triads, $ {^i_j}\mathbb{Q}^{i_p}_{j_p}$ can be defined at a $T$-point as 
+the following triad combinations of the neighbouring potential vorticities defined at f-points 
+(Fig.~\ref{Fig_DYN_een_triad}): 
+\begin{equation} \label{Q_triads}
+_i^j \mathbb{Q}^{i_p}_{j_p}
+= \frac{1}{12} \ \left(   q^{i-i_p}_{j+j_p} + q^{i+j_p}_{j+i_p} + q^{i+i_p}_{j-j_p}  \right)
+\end{equation}
+where the indices $i_p$ and $k_p$ take the values: $i_p = -1/2$ or $1/2$ and $j_p = -1/2$ or $1/2$. 
+
+Finally, the vorticity terms are represented as: 
+\begin{equation} \label{Eq_dynvor_een}
+\left\{ {
+\begin{aligned}
+ +q\,e_3 \, v 	&\equiv +\frac{1}{e_{1u} }   \sum_{\substack{i_p,\,k_p}} 
+                         {^{i+1/2-i_p}_j}  \mathbb{Q}^{i_p}_{j_p}  \left( e_{1v}\,e_{3v} \;v  \right)^{i+1/2-i_p}_{j+j_p}   \\
+ - q\,e_3 \, u     &\equiv -\frac{1}{e_{2v} }    \sum_{\substack{i_p,\,k_p}} 
+                         {^i_{j+1/2-j_p}}  \mathbb{Q}^{i_p}_{j_p}  \left( e_{2u}\,e_{3u} \;u  \right)^{i+i_p}_{j+1/2-j_p}   \\
+\end{aligned} 
+} \right.
+\end{equation} 
+
+This EEN scheme in fact combines the conservation properties of the ENS and ENE schemes. 
+It conserves both total energy and potential enstrophy in the limit of horizontally 
+nondivergent flow ($i.e.$ $\chi$=$0$) (see  Appendix~\ref{Apdx_C_vorEEN}). 
+Applied to a realistic ocean configuration, it has been shown that it leads to a significant 
+reduction of the noise in the vertical velocity field \citep{Le_Sommer_al_OM09}. 
+Furthermore, used in combination with a partial steps representation of bottom topography,
+it improves the interaction between current and topography, leading to a larger
+topostrophy of the flow  \citep{Barnier_al_OD06, Penduff_al_OS07}. 
+
+%--------------------------------------------------------------------------------------------------------------
+%           Kinetic Energy Gradient term
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Kinetic Energy Gradient term (\textit{dynkeg})]
+			{Kinetic Energy Gradient term (\mdl{dynkeg})}
+\label{DYN_keg}
+
+As demonstrated in Appendix~\ref{Apdx_C}, there is a single discrete formulation 
+of the kinetic energy gradient term that, together with the formulation chosen for 
+the vertical advection (see below), conserves the total kinetic energy:
+\begin{equation} \label{Eq_dynkeg}
+\left\{ \begin{aligned}
+ -\frac{1}{2 \; e_{1u} }  & \ \delta _{i+1/2} \left[ {\overline {u^2}^{\,i} + \overline{v^2}^{\,j}} \right]   \\
+ -\frac{1}{2 \; e_{2v} }  & \ \delta _{j+1/2} \left[ {\overline {u^2}^{\,i} + \overline{v^2}^{\,j}} \right]    
+\end{aligned} \right.
+\end{equation} 
+
+%--------------------------------------------------------------------------------------------------------------
+%           Vertical advection term
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Vertical advection term (\textit{dynzad}) ]
+			{Vertical advection term (\mdl{dynzad}) }
+\label{DYN_zad}
+
+The discrete formulation of the vertical advection, together with the formulation 
+chosen for the gradient of kinetic energy (KE) term, conserves the total kinetic 
+energy. Indeed, the change of KE due to the vertical advection is exactly 
+balanced by the change of KE due to the gradient of KE (see Appendix~\ref{Apdx_C}).
+\begin{equation} \label{Eq_dynzad}
+\left\{ 		\begin{aligned}
+-\frac{1} {e_{1u}\,e_{2u}\,e_{3u}} &\ \overline{\ \overline{ e_{1t}\,e_{2t}\;w } ^{\,i+1/2}  \;\delta _{k+1/2} \left[ u \right]\  }^{\,k}  \\
+-\frac{1} {e_{1v}\,e_{2v}\,e_{3v}}  &\ \overline{\ \overline{ e_{1t}\,e_{2t}\;w } ^{\,j+1/2}  \;\delta _{k+1/2} \left[ u \right]\  }^{\,k} 
+\end{aligned}         \right.
+\end{equation} 
+When \np{ln\_dynzad\_zts}~=~\textit{true}, a split-explicit time stepping with 5 sub-timesteps is used 
+on the vertical advection term.
+This option can be useful when the value of the timestep is limited by vertical advection \citep{Lemarie_OM2015}. 
+Note that in this case, a similar split-explicit time stepping should be used on 
+vertical advection of tracer to ensure a better stability, 
+an option which is only available with a TVD scheme (see \np{ln\_traadv\_tvd\_zts} in \S\ref{TRA_adv_tvd}).
+
+
+% ================================================================
+% Coriolis and Advection : flux form
+% ================================================================
+\section{Coriolis and Advection: flux form}
+\label{DYN_adv_cor_flux}
+%------------------------------------------nam_dynadv----------------------------------------------------
+\namdisplay{namdyn_adv} 
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namdyn\_adv} namelist variables.
+In the flux form (as in the vector invariant form), the Coriolis and momentum 
+advection terms are evaluated using a leapfrog scheme, $i.e.$ the velocity 
+appearing in their expressions is centred in time (\textit{now} velocity). At the 
+lateral boundaries either free slip, no slip or partial slip boundary conditions 
+are applied following Chap.\ref{LBC}.
+
+
+%--------------------------------------------------------------------------------------------------------------
+%           Coriolis plus curvature metric terms
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Coriolis plus curvature metric terms (\textit{dynvor}) ]
+			{Coriolis plus curvature metric terms (\mdl{dynvor}) }
+\label{DYN_cor_flux}
+
+In flux form, the vorticity term reduces to a Coriolis term in which the Coriolis 
+parameter has been modified to account for the "metric" term. This altered 
+Coriolis parameter is thus discretised at $f$-points. It is given by: 
+\begin{multline} \label{Eq_dyncor_metric}
+f+\frac{1}{e_1 e_2 }\left( {v\frac{\partial e_2 }{\partial i}  -  u\frac{\partial e_1 }{\partial j}} \right)  \\
+   \equiv   f + \frac{1}{e_{1f} e_{2f} } \left( { \ \overline v ^{i+1/2}\delta _{i+1/2} \left[ {e_{2u} } \right]  
+                                                                 -  \overline u ^{j+1/2}\delta _{j+1/2} \left[ {e_{1u} } \right]  }  \ \right)
+\end{multline} 
+
+Any of the (\ref{Eq_dynvor_ens}), (\ref{Eq_dynvor_ene}) and (\ref{Eq_dynvor_een}) 
+schemes can be used to compute the product of the Coriolis parameter and the 
+vorticity. However, the energy-conserving scheme  (\ref{Eq_dynvor_een}) has 
+exclusively been used to date. This term is evaluated using a leapfrog scheme, 
+$i.e.$ the velocity is centred in time (\textit{now} velocity).
+
+%--------------------------------------------------------------------------------------------------------------
+%           Flux form Advection term
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Flux form Advection term (\textit{dynadv}) ]
+			{Flux form Advection term (\mdl{dynadv}) }
+\label{DYN_adv_flux}
+
+The discrete expression of the advection term is given by :
+\begin{equation} \label{Eq_dynadv}
+\left\{ 
+\begin{aligned}
+\frac{1}{e_{1u}\,e_{2u}\,e_{3u}} 
+\left(      \delta _{i+1/2} \left[ \overline{e_{2u}\,e_{3u}\;u }^{i       }  \ u_t      \right]    
+          + \delta _{j       } \left[ \overline{e_{1u}\,e_{3u}\;v }^{i+1/2}  \ u_f      \right] \right.  \ \;   \\
+\left.   + \delta _{k      } \left[ \overline{e_{1w}\,e_{2w}\;w}^{i+1/2}  \ u_{uw} \right] \right)   \\
+\\
+\frac{1}{e_{1v}\,e_{2v}\,e_{3v}} 
+\left(     \delta _{i       } \left[ \overline{e_{2u}\,e_{3u }\;u }^{j+1/2} \ v_f       \right] 
+         + \delta _{j+1/2} \left[ \overline{e_{1u}\,e_{3u }\;v }^{i       } \ v_t       \right] \right.  \ \, \, \\
+\left.  + \delta _{k      } \left[ \overline{e_{1w}\,e_{2w}\;w}^{j+1/2} \ v_{vw}  \right] \right) \\
+\end{aligned}
+\right.
+\end{equation}
+
+Two advection schemes are available: a $2^{nd}$ order centered finite 
+difference scheme, CEN2, or a $3^{rd}$ order upstream biased scheme, UBS. 
+The latter is described in \citet{Shchepetkin_McWilliams_OM05}. The schemes are 
+selected using the namelist logicals \np{ln\_dynadv\_cen2} and \np{ln\_dynadv\_ubs}. 
+In flux form, the schemes differ by the choice of a space and time interpolation to 
+define the value of $u$ and $v$ at the centre of each face of $u$- and $v$-cells, 
+$i.e.$ at the $T$-, $f$-, and $uw$-points for $u$ and at the $f$-, $T$- and 
+$vw$-points for $v$. 
+
+%-------------------------------------------------------------
+%                 2nd order centred scheme
+%-------------------------------------------------------------
+\subsubsection{$2^{nd}$ order centred scheme (cen2) (\np{ln\_dynadv\_cen2}=true)}
+\label{DYN_adv_cen2}
+
+In the centered $2^{nd}$ order formulation, the velocity is evaluated as the 
+mean of the two neighbouring points :
+\begin{equation} \label{Eq_dynadv_cen2}
+\left\{ 		\begin{aligned}
+ u_T^{cen2} &=\overline u^{i }       \quad &  u_F^{cen2} &=\overline u^{j+1/2}  \quad &  u_{uw}^{cen2} &=\overline u^{k+1/2}   \\
+ v_F^{cen2} &=\overline v ^{i+1/2} \quad & v_F^{cen2} &=\overline v^j		\quad &  v_{vw}^{cen2} &=\overline v ^{k+1/2}  \\
+\end{aligned}      \right.
+\end{equation} 
+
+The scheme is non diffusive (i.e. conserves the kinetic energy) but dispersive 
+($i.e.$ it may create false extrema). It is therefore notoriously noisy and must be 
+used in conjunction with an explicit diffusion operator to produce a sensible solution. 
+The associated time-stepping is performed using a leapfrog scheme in conjunction 
+with an Asselin time-filter, so $u$ and $v$ are the \emph{now} velocities.
+
+%-------------------------------------------------------------
+%                 UBS scheme
+%-------------------------------------------------------------
+\subsubsection{Upstream Biased Scheme (UBS) (\np{ln\_dynadv\_ubs}=true)}
+\label{DYN_adv_ubs}
+
+The UBS advection scheme is an upstream biased third order scheme based on 
+an upstream-biased parabolic interpolation. For example, the evaluation of 
+$u_T^{ubs} $ is done as follows:
+\begin{equation} \label{Eq_dynadv_ubs}
+u_T^{ubs} =\overline u ^i-\;\frac{1}{6} 	\begin{cases}
+		u"_{i-1/2}& 	\text{if $\ \overline{e_{2u}\,e_{3u} \ u}^i  \geqslant 0$ } 	\\
+		u"_{i+1/2}& 	\text{if $\ \overline{e_{2u}\,e_{3u} \ u}^i  < 0$ }
+\end{cases}
+\end{equation}
+where $u"_{i+1/2} =\delta _{i+1/2} \left[ {\delta _i \left[ u \right]} \right]$. This results 
+in a dissipatively dominant ($i.e.$ hyper-diffusive) truncation error \citep{Shchepetkin_McWilliams_OM05}. 
+The overall performance of the advection scheme is similar to that reported in 
+\citet{Farrow1995}. It is a relatively good compromise between accuracy and 
+smoothness. It is not a \emph{positive} scheme, meaning that false extrema are 
+permitted. But the amplitudes of the false extrema are significantly reduced over 
+those in the centred second order method. As the scheme already includes 
+a diffusion component, it can be used without explicit  lateral diffusion on momentum 
+($i.e.$ \np{ln\_dynldf\_lap}=\np{ln\_dynldf\_bilap}=false), and it is recommended to do so.
+
+The UBS scheme is not used in all directions. In the vertical, the centred $2^{nd}$ 
+order evaluation of the advection is preferred, $i.e.$ $u_{uw}^{ubs}$ and 
+$u_{vw}^{ubs}$ in \eqref{Eq_dynadv_cen2} are used. UBS is diffusive and is 
+associated with vertical mixing of momentum. \gmcomment{ gm  pursue the 
+sentence:Since vertical mixing of momentum is a source term of the TKE equation...  }
+
+For stability reasons,  the first term in (\ref{Eq_dynadv_ubs}), which corresponds 
+to a second order centred scheme, is evaluated using the \textit{now} velocity 
+(centred in time), while the second term, which is the diffusion part of the scheme, 
+is evaluated using the \textit{before} velocity (forward in time). This is discussed 
+by \citet{Webb_al_JAOT98} in the context of the Quick advection scheme.
+
+Note that the UBS and QUICK (Quadratic Upstream Interpolation for Convective Kinematics) 
+schemes only differ by one coefficient. Replacing $1/6$ by $1/8$ in 
+(\ref{Eq_dynadv_ubs}) leads to the QUICK advection scheme \citep{Webb_al_JAOT98}. 
+This option is not available through a namelist parameter, since the $1/6$ coefficient 
+is hard coded. Nevertheless it is quite easy to make the substitution in the
+\mdl{dynadv\_ubs} module and obtain a QUICK scheme.
+
+Note also that in the current version of \mdl{dynadv\_ubs}, there is also the 
+possibility of using a $4^{th}$ order evaluation of the advective velocity as in 
+ROMS. This is an error and should be suppressed soon.
+%%%
+\gmcomment{action :  this have to be done}
+%%%
+
+% ================================================================
+%           Hydrostatic pressure gradient term
+% ================================================================
+\section  [Hydrostatic pressure gradient (\textit{dynhpg})]
+		{Hydrostatic pressure gradient (\mdl{dynhpg})}
+\label{DYN_hpg}
+%------------------------------------------nam_dynhpg---------------------------------------------------
+\namdisplay{namdyn_hpg} 
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namdyn\_hpg} namelist variables.
+The key distinction between the different algorithms used for the hydrostatic 
+pressure gradient is the vertical coordinate used, since HPG is a \emph{horizontal} 
+pressure gradient, $i.e.$ computed along geopotential surfaces. As a result, any 
+tilt of the surface of the computational levels will require a specific treatment to 
+compute the hydrostatic pressure gradient.
+
+The hydrostatic pressure gradient term is evaluated either using a leapfrog scheme, 
+$i.e.$ the density appearing in its expression is centred in time (\emph{now} $\rho$), or 
+a semi-implcit scheme. At the lateral boundaries either free slip, no slip or partial slip 
+boundary conditions are applied.
+
+%--------------------------------------------------------------------------------------------------------------
+%           z-coordinate with full step
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [$z$-coordinate with full step (\np{ln\_dynhpg\_zco}) ]
+			{$z$-coordinate with full step (\np{ln\_dynhpg\_zco}=true)}
+\label{DYN_hpg_zco}
+
+The hydrostatic pressure can be obtained by integrating the hydrostatic equation 
+vertically from the surface. However, the pressure is large at great depth while its 
+horizontal gradient is several orders of magnitude smaller. This may lead to large 
+truncation errors in the pressure gradient terms. Thus, the two horizontal components 
+of the hydrostatic pressure gradient are computed directly as follows:
+
+for $k=km$ (surface layer, $jk=1$ in the code)
+\begin{equation} \label{Eq_dynhpg_zco_surf}
+\left\{ \begin{aligned}
+					\left. \delta _{i+1/2} \left[  p^h 			 \right] \right|_{k=km} 
+&= \frac{1}{2} g \ 	\left. \delta _{i+1/2} \left[  e_{3w} \ \rho \right] \right|_{k=km}   \\
+     					\left. \delta _{j+1/2} \left[  p^h  			 \right] \right|_{k=km} 
+&= \frac{1}{2} g \ 	\left. \delta _{j+1/2} \left[  e_{3w} \ \rho \right] \right|_{k=km}   \\
+\end{aligned} \right.
+\end{equation} 
+
+for $1<k<km$ (interior layer)
+\begin{equation} \label{Eq_dynhpg_zco}
+\left\{ \begin{aligned}
+					\left. \delta _{i+1/2} \left[  p^h 			 \right] \right|_{k} 
+&=					\left. \delta _{i+1/2} \left[  p^h 			 \right] \right|_{k-1} 
++    \frac{1}{2}\;g\;	\left. \delta _{i+1/2} \left[  e_{3w} \ \overline {\rho}^{k+1/2} \right] \right|_{k}   \\
+     					\left. \delta _{j+1/2} \left[  p^h  			 \right] \right|_{k} 
+&=     				\left. \delta _{j+1/2} \left[  p^h  			 \right] \right|_{k-1} 
++    \frac{1}{2}\;g\;	\left. \delta _{j+1/2} \left[  e_{3w} \ \overline {\rho}^{k+1/2} \right] \right|_{k}   \\
+\end{aligned} \right.
+\end{equation} 
+
+Note that the $1/2$ factor in (\ref{Eq_dynhpg_zco_surf}) is adequate because of 
+the definition of $e_{3w}$ as the vertical derivative of the scale factor at the surface 
+level ($z=0$). Note also that in case of variable volume level (\key{vvl} defined), the 
+surface pressure gradient is included in \eqref{Eq_dynhpg_zco_surf} and \eqref{Eq_dynhpg_zco} 
+through the space and time variations of the vertical scale factor $e_{3w}$.
+
+%--------------------------------------------------------------------------------------------------------------
+%           z-coordinate with partial step
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [$z$-coordinate with partial step (\np{ln\_dynhpg\_zps})]
+			{$z$-coordinate with partial step (\np{ln\_dynhpg\_zps}=true)}
+\label{DYN_hpg_zps}
+
+With partial bottom cells, tracers in horizontally adjacent cells generally live at 
+different depths. Before taking horizontal gradients between these tracer points, 
+a linear interpolation is used to approximate the deeper tracer as if it actually lived 
+at the depth of the shallower tracer point. 
+
+Apart from this modification, the horizontal hydrostatic pressure gradient evaluated 
+in the $z$-coordinate with partial step is exactly as in the pure $z$-coordinate case. 
+As explained in detail in section \S\ref{TRA_zpshde}, the nonlinearity of pressure 
+effects in the equation of state is such that it is better to interpolate temperature and 
+salinity vertically before computing the density. Horizontal gradients of temperature 
+and salinity are needed for the TRA modules, which is the reason why the horizontal 
+gradients of density at the deepest model level are computed in module \mdl{zpsdhe} 
+located in the TRA directory and described in \S\ref{TRA_zpshde}.
+
+%--------------------------------------------------------------------------------------------------------------
+%           s- and s-z-coordinates
+%--------------------------------------------------------------------------------------------------------------
+\subsection{$s$- and $z$-$s$-coordinates}
+\label{DYN_hpg_sco}
+
+Pressure gradient formulations in an $s$-coordinate have been the subject of a vast 
+number of papers ($e.g.$, \citet{Song1998, Shchepetkin_McWilliams_OM05}). 
+A number of different pressure gradient options are coded but the ROMS-like, density Jacobian with 
+cubic polynomial method is currently disabled whilst known bugs are under investigation.
+
+$\bullet$ Traditional coding (see for example \citet{Madec_al_JPO96}: (\np{ln\_dynhpg\_sco}=true)
+\begin{equation} \label{Eq_dynhpg_sco}
+\left\{ \begin{aligned}
+ - \frac{1}    					{\rho_o \, e_{1u}} \;	\delta _{i+1/2} \left[  p^h  \right] 
++ \frac{g\; \overline {\rho}^{i+1/2}}	{\rho_o \, e_{1u}} \;	\delta _{i+1/2} \left[  z_t   \right]    \\
+ - \frac{1}    					{\rho_o \, e_{2v}} \;	\delta _{j+1/2} \left[  p^h  \right]  
++ \frac{g\; \overline {\rho}^{j+1/2}}	{\rho_o \, e_{2v}} \;	\delta _{j+1/2} \left[  z_t   \right]    \\
+\end{aligned} \right.
+\end{equation} 
+
+Where the first term is the pressure gradient along coordinates, computed as in 
+\eqref{Eq_dynhpg_zco_surf} - \eqref{Eq_dynhpg_zco}, and $z_T$ is the depth of 
+the $T$-point evaluated from the sum of the vertical scale factors at the $w$-point 
+($e_{3w}$).
+ 
+$\bullet$ Traditional coding with adaptation for ice shelf cavities (\np{ln\_dynhpg\_isf}=true).
+This scheme need the activation of ice shelf cavities (\np{ln\_isfcav}=true).
+
+$\bullet$ Pressure Jacobian scheme (prj) (a research paper in preparation) (\np{ln\_dynhpg\_prj}=true)
+
+$\bullet$ Density Jacobian with cubic polynomial scheme (DJC) \citep{Shchepetkin_McWilliams_OM05} 
+(\np{ln\_dynhpg\_djc}=true) (currently disabled; under development)
+
+Note that expression \eqref{Eq_dynhpg_sco} is commonly used when the variable volume formulation is
+activated (\key{vvl}) because in that case, even with a flat bottom, the coordinate surfaces are not
+horizontal but follow the free surface \citep{Levier2007}. The pressure jacobian scheme
+(\np{ln\_dynhpg\_prj}=true) is available as an improved option to \np{ln\_dynhpg\_sco}=true when
+\key{vvl} is active.  The pressure Jacobian scheme uses a constrained cubic spline to reconstruct
+the density profile across the water column. This method maintains the monotonicity between the
+density nodes  The pressure can be calculated by analytical integration of the density profile and a
+pressure Jacobian method is used to solve the horizontal pressure gradient. This method can provide
+a more accurate calculation of the horizontal pressure gradient than the standard scheme.
+
+\subsection{Ice shelf cavity}
+\label{DYN_hpg_isf}
+Beneath an ice shelf, the total pressure gradient is the sum of the pressure gradient due to the ice shelf load and
+ the pressure gradient due to the ocean load. If cavity opened (\np{ln\_isfcav}~=~true) these 2 terms can be
+ calculated by setting \np{ln\_dynhpg\_isf}~=~true. No other scheme are working with the ice shelf.\\
+
+$\bullet$ The main hypothesis to compute the ice shelf load is that the ice shelf is in an isostatic equilibrium.
+ The top pressure is computed integrating from surface to the base of the ice shelf a reference density profile 
+(prescribed as density of a water at 34.4 PSU and -1.9\degC) and corresponds to the water replaced by the ice shelf. 
+This top pressure is constant over time. A detailed description of this method is described in \citet{Losch2008}.\\
+
+$\bullet$ The ocean load is computed using the expression \eqref{Eq_dynhpg_sco} described in \ref{DYN_hpg_sco}. 
+
+%--------------------------------------------------------------------------------------------------------------
+%           Time-scheme
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Time-scheme (\np{ln\_dynhpg\_imp}) ]
+			{Time-scheme (\np{ln\_dynhpg\_imp}= true/false)}
+\label{DYN_hpg_imp}
+
+The default time differencing scheme used for the horizontal pressure gradient is 
+a leapfrog scheme and therefore the density used in all discrete expressions given 
+above is the  \textit{now} density, computed from the \textit{now} temperature and 
+salinity. In some specific cases (usually high resolution simulations over an ocean 
+domain which includes weakly stratified regions) the physical phenomenon that 
+controls the time-step is internal gravity waves (IGWs). A semi-implicit scheme for 
+doubling the stability limit associated with IGWs can be used \citep{Brown_Campana_MWR78, 
+Maltrud1998}. It involves the evaluation of the hydrostatic pressure gradient as an 
+average over the three time levels $t-\rdt$, $t$, and $t+\rdt$ ($i.e.$  
+\textit{before},  \textit{now} and  \textit{after} time-steps), rather than at the central 
+time level $t$ only, as in the standard leapfrog scheme. 
+
+$\bullet$ leapfrog scheme (\np{ln\_dynhpg\_imp}=true):
+
+\begin{equation} \label{Eq_dynhpg_lf}
+\frac{u^{t+\rdt}-u^{t-\rdt}}{2\rdt} = \;\cdots \;
+	-\frac{1}{\rho _o \,e_{1u} }\delta _{i+1/2} \left[ {p_h^t } \right]
+\end{equation}
+
+$\bullet$ semi-implicit scheme (\np{ln\_dynhpg\_imp}=true):
+\begin{equation} \label{Eq_dynhpg_imp}
+\frac{u^{t+\rdt}-u^{t-\rdt}}{2\rdt} = \;\cdots \;
+	-\frac{1}{4\,\rho _o \,e_{1u} } \delta_{i+1/2} \left[ p_h^{t+\rdt} +2\,p_h^t +p_h^{t-\rdt}  \right]
+\end{equation}
+
+The semi-implicit time scheme \eqref{Eq_dynhpg_imp} is made possible without 
+significant additional computation since the density can be updated to time level 
+$t+\rdt$ before computing the horizontal hydrostatic pressure gradient. It can 
+be easily shown that the stability limit associated with the hydrostatic pressure 
+gradient doubles using \eqref{Eq_dynhpg_imp} compared to that using the 
+standard leapfrog scheme \eqref{Eq_dynhpg_lf}. Note that \eqref{Eq_dynhpg_imp} 
+is equivalent to applying a time filter to the pressure gradient to eliminate high 
+frequency IGWs. Obviously, when using \eqref{Eq_dynhpg_imp}, the doubling of 
+the time-step is achievable only if no other factors control the time-step, such as 
+the stability limits associated with advection or diffusion.
+
+In practice, the semi-implicit scheme is used when \np{ln\_dynhpg\_imp}=true. 
+In this case, we choose to apply the time filter to temperature and salinity used in 
+the equation of state, instead of applying it to the hydrostatic pressure or to the 
+density, so that no additional storage array has to be defined. The density used to 
+compute the hydrostatic pressure gradient (whatever the formulation) is evaluated 
+as follows:
+\begin{equation} \label{Eq_rho_flt}
+	\rho^t = \rho( \widetilde{T},\widetilde {S},z_t)
+ \quad	  \text{with}	\quad 
+	\widetilde{X} = 1 / 4 \left(  X^{t+\rdt} +2 \,X^t + X^{t-\rdt}  \right)
+\end{equation}
+
+Note that in the semi-implicit case, it is necessary to save the filtered density, an 
+extra three-dimensional field, in the restart file to restart the model with exact 
+reproducibility. This option is controlled by  \np{nn\_dynhpg\_rst}, a namelist parameter.
+
+% ================================================================
+% Surface Pressure Gradient
+% ================================================================
+\section  [Surface pressure gradient (\textit{dynspg}) ]
+		{Surface pressure gradient (\mdl{dynspg})}
+\label{DYN_spg}
+%-----------------------------------------nam_dynspg----------------------------------------------------
+\namdisplay{namdyn_spg} 
+%------------------------------------------------------------------------------------------------------------
+
+$\ $\newline      %force an empty line
+
+Options are defined through the \ngn{namdyn\_spg} namelist variables.
+The surface pressure gradient term is related to the representation of the free surface (\S\ref{PE_hor_pg}). 
+The main distinction is between the fixed volume case (linear free surface) and the variable volume case 
+(nonlinear free surface, \key{vvl} is defined). In the linear free surface case (\S\ref{PE_free_surface}) 
+the vertical scale factors $e_{3}$ are fixed in time, while they are time-dependent in the nonlinear case 
+(\S\ref{PE_free_surface}). 
+With both linear and nonlinear free surface, external gravity waves are allowed in the equations, 
+which imposes a very small time step when an explicit time stepping is used. 
+Two methods are proposed to allow a longer time step for the three-dimensional equations: 
+the filtered free surface, which is a modification of the continuous equations (see \eqref{Eq_PE_flt}), 
+and the split-explicit free surface described below. 
+The extra term introduced in the filtered method is calculated implicitly, 
+so that the update of the next velocities is done in module \mdl{dynspg\_flt} and not in \mdl{dynnxt}.
+
+
+The form of the surface pressure gradient term depends on how the user wants to handle 
+the fast external gravity waves that are a solution of the analytical equation (\S\ref{PE_hor_pg}). 
+Three formulations are available, all controlled by a CPP key (ln\_dynspg\_xxx):
+an explicit formulation which requires a small time step ;
+a filtered free surface formulation which allows a larger time step by adding a filtering 
+term into the momentum equation ; 
+and a split-explicit free surface formulation, described below, which also allows a larger time step.
+
+The extra term introduced in the filtered method is calculated 
+implicitly, so that a solver is used to compute it. As a consequence the update of the $next$ 
+velocities is done in module \mdl{dynspg\_flt} and not in \mdl{dynnxt}.
+
+
+%--------------------------------------------------------------------------------------------------------------
+% Explicit free surface formulation
+%--------------------------------------------------------------------------------------------------------------
+\subsection{Explicit free surface (\key{dynspg\_exp})}
+\label{DYN_spg_exp}
+
+In the explicit free surface formulation (\key{dynspg\_exp} defined), the model time step 
+is chosen to be small enough to resolve the external gravity waves (typically a few tens of seconds). 
+The surface pressure gradient, evaluated using a leap-frog scheme ($i.e.$ centered in time),
+is thus simply given by :
+\begin{equation} \label{Eq_dynspg_exp}
+\left\{ \begin{aligned}
+ - \frac{1}{e_{1u}\,\rho_o} \;	\delta _{i+1/2} \left[  \,\rho \,\eta\,  \right] 	\\
+ - \frac{1}{e_{2v}\,\rho_o} \;	\delta _{j+1/2} \left[  \,\rho \,\eta\,  \right]  
+\end{aligned} \right.
+\end{equation} 
+
+Note that in the non-linear free surface case ($i.e.$ \key{vvl} defined), the surface pressure 
+gradient is already included in the momentum tendency  through the level thickness variation 
+allowed in the computation of the hydrostatic pressure gradient. Thus, nothing is done in the \mdl{dynspg\_exp} module.
+
+%--------------------------------------------------------------------------------------------------------------
+% Split-explict free surface formulation
+%--------------------------------------------------------------------------------------------------------------
+\subsection{Split-Explicit free surface (\key{dynspg\_ts})}
+\label{DYN_spg_ts}
+%------------------------------------------namsplit-----------------------------------------------------------
+\namdisplay{namsplit} 
+%-------------------------------------------------------------------------------------------------------------
+
+The split-explicit free surface formulation used in \NEMO (\key{dynspg\_ts} defined),
+also called the time-splitting formulation, follows the one 
+proposed by \citet{Shchepetkin_McWilliams_OM05}. The general idea is to solve the free surface 
+equation and the associated barotropic velocity equations with a smaller time 
+step than $\rdt$, the time step used for the three dimensional prognostic 
+variables (Fig.~\ref{Fig_DYN_dynspg_ts}). 
+The size of the small time step, $\rdt_e$ (the external mode or barotropic time step)
+ is provided through the \np{nn\_baro} namelist parameter as: 
+$\rdt_e = \rdt / nn\_baro$. This parameter can be optionally defined automatically (\np{ln\_bt\_nn\_auto}=true) 
+considering that the stability of the barotropic system is essentially controled by external waves propagation. 
+Maximum Courant number is in that case time independent, and easily computed online from the input bathymetry.
+Therefore, $\rdt_e$ is adjusted so that the Maximum allowed Courant number is smaller than \np{rn\_bt\_cmax}.
+
+%%%
+The barotropic mode solves the following equations:
+\begin{subequations} \label{Eq_BT}
+  \begin{equation}     \label{Eq_BT_dyn}
+\frac{\partial {\rm \overline{{\bf U}}_h} }{\partial t}=
+ -f\;{\rm {\bf k}}\times {\rm \overline{{\bf U}}_h} 
+-g\nabla _h \eta -\frac{c_b^{\textbf U}}{H+\eta} \rm {\overline{{\bf U}}_h} + \rm {\overline{\bf G}}
+  \end{equation}
+
+  \begin{equation} \label{Eq_BT_ssh}
+\frac{\partial \eta }{\partial t}=-\nabla \cdot \left[ {\left( {H+\eta } \right) \; {\rm{\bf \overline{U}}}_h \,} \right]+P-E
+  \end{equation}
+\end{subequations}
+where $\rm {\overline{\bf G}}$ is a forcing term held constant, containing coupling term between modes, surface atmospheric forcing as well as slowly varying barotropic terms not explicitly computed to gain efficiency. The third term on the right hand side of \eqref{Eq_BT_dyn} represents the bottom stress (see section \S\ref{ZDF_bfr}), explicitly accounted for at each barotropic iteration. Temporal discretization of the system above follows a three-time step Generalized Forward Backward algorithm detailed in \citet{Shchepetkin_McWilliams_OM05}. AB3-AM4 coefficients used in \NEMO follow the second-order accurate, "multi-purpose" stability compromise as defined in \citet{Shchepetkin_McWilliams_Bk08} (see their figure 12, lower left). 
+
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.7\textwidth]{Fig_DYN_dynspg_ts}
+\caption{  \label{Fig_DYN_dynspg_ts}
+Schematic of the split-explicit time stepping scheme for the external 
+and internal modes. Time increases to the right. In this particular exemple, 
+a boxcar averaging window over $nn\_baro$ barotropic time steps is used ($nn\_bt\_flt=1$) and $nn\_baro=5$.
+Internal mode time steps (which are also the model time steps) are denoted 
+by $t-\rdt$, $t$ and $t+\rdt$. Variables with $k$ superscript refer to instantaneous barotropic variables, 
+$< >$ and $<< >>$ operator refer to time filtered variables using respectively primary (red vertical bars) and secondary weights (blue vertical bars). 
+The former are used to obtain time filtered quantities at $t+\rdt$ while the latter are used to obtain time averaged 
+transports to advect tracers.
+a) Forward time integration: \np{ln\_bt\_fw}=true,  \np{ln\_bt\_av}=true. 
+b) Centred time integration: \np{ln\_bt\_fw}=false, \np{ln\_bt\_av}=true. 
+c) Forward time integration with no time filtering (POM-like scheme): \np{ln\_bt\_fw}=true, \np{ln\_bt\_av}=false. }
+\end{center}    \end{figure}
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+
+In the default case (\np{ln\_bt\_fw}=true), the external mode is integrated 
+between \textit{now} and  \textit{after} baroclinic time-steps (Fig.~\ref{Fig_DYN_dynspg_ts}a). To avoid aliasing of fast barotropic motions into three dimensional equations, time filtering is eventually applied on barotropic 
+quantities (\np{ln\_bt\_av}=true). In that case, the integration is extended slightly beyond  \textit{after} time step to provide time filtered quantities. 
+These are used for the subsequent initialization of the barotropic mode in the following baroclinic step. 
+Since external mode equations written at baroclinic time steps finally follow a forward time stepping scheme, 
+asselin filtering is not applied to barotropic quantities. \\
+Alternatively, one can choose to integrate barotropic equations starting 
+from \textit{before} time step (\np{ln\_bt\_fw}=false). Although more computationaly expensive ( \np{nn\_baro} additional iterations are indeed necessary), the baroclinic to barotropic forcing term given at \textit{now} time step 
+become centred in the middle of the integration window. It can easily be shown that this property 
+removes part of splitting errors between modes, which increases the overall numerical robustness.
+%references to Patrick Marsaleix' work here. Also work done by SHOM group.
+
+%%%
+
+As far as tracer conservation is concerned, barotropic velocities used to advect tracers must also be updated 
+at \textit{now} time step. This implies to change the traditional order of computations in \NEMO: most of momentum  
+trends (including the barotropic mode calculation) updated first, tracers' after. This \textit{de facto} makes semi-implicit hydrostatic 
+pressure gradient (see section \S\ref{DYN_hpg_imp}) and time splitting not compatible. 
+Advective barotropic velocities are obtained by using a secondary set of filtering weights, uniquely defined from the filter 
+coefficients used for the time averaging (\citet{Shchepetkin_McWilliams_OM05}). Consistency between the time averaged continuity equation and the time stepping of tracers is here the key to obtain exact conservation.
+
+%%%
+
+One can eventually choose to feedback instantaneous values by not using any time filter (\np{ln\_bt\_av}=false). 
+In that case, external mode equations are continuous in time, ie they are not re-initialized when starting a new 
+sub-stepping sequence. This is the method used so far in the POM model, the stability being maintained by refreshing at (almost) 
+each barotropic time step advection and horizontal diffusion terms. Since the latter terms have not been added in \NEMO for 
+computational efficiency, removing time filtering is not recommended except for debugging purposes. 
+This may be used for instance to appreciate the damping effect of the standard formulation on external gravity waves in idealized or weakly non-linear cases. Although the damping is lower than for the filtered free surface, it is still significant as shown by \citet{Levier2007} in the case of an analytical barotropic Kelvin wave.
+
+%>>>>>===============
+\gmcomment{               %%% copy from griffies Book 
+
+\textbf{title: Time stepping the barotropic system }
+
+Assume knowledge of the full velocity and tracer fields at baroclinic time $\tau$. Hence, 
+we can update the surface height and vertically integrated velocity with a leap-frog 
+scheme using the small barotropic time step $\rdt$. We have 
+
+\begin{equation} \label{DYN_spg_ts_eta}
+\eta^{(b)}(\tau,t_{n+1}) - \eta^{(b)}(\tau,t_{n+1}) (\tau,t_{n-1})
+	= 2 \rdt \left[-\nabla \cdot \textbf{U}^{(b)}(\tau,t_n) + \text{EMP}_w(\tau) \right] 
+\end{equation}
+\begin{multline} \label{DYN_spg_ts_u}
+\textbf{U}^{(b)}(\tau,t_{n+1}) - \textbf{U}^{(b)}(\tau,t_{n-1})  \\
+	= 2\rdt \left[ - f \textbf{k} \times \textbf{U}^{(b)}(\tau,t_{n}) 
+	- H(\tau) \nabla p_s^{(b)}(\tau,t_{n}) +\textbf{M}(\tau) \right]
+\end{multline}
+\
+
+In these equations, araised (b) denotes values of surface height and vertically integrated velocity updated with the barotropic time steps. The $\tau$ time label on $\eta^{(b)}$ 
+and $U^{(b)}$ denotes the baroclinic time at which the vertically integrated forcing $\textbf{M}(\tau)$ (note that this forcing includes the surface freshwater forcing), the tracer fields, the freshwater flux $\text{EMP}_w(\tau)$, and total depth of the ocean $H(\tau)$ are held for the duration of the barotropic time stepping over a single cycle. This is also the time 
+that sets the barotropic time steps via 
+\begin{equation} \label{DYN_spg_ts_t}
+t_n=\tau+n\rdt   
+\end{equation}
+with $n$ an integer. The density scaled surface pressure is evaluated via 
+\begin{equation} \label{DYN_spg_ts_ps}
+p_s^{(b)}(\tau,t_{n}) = \begin{cases}
+	g \;\eta_s^{(b)}(\tau,t_{n}) \;\rho(\tau)_{k=1}) / \rho_o  &      \text{non-linear case} \\
+	g \;\eta_s^{(b)}(\tau,t_{n})  &      \text{linear case} 
+	\end{cases}
+\end{equation}
+To get started, we assume the following initial conditions 
+\begin{equation} \label{DYN_spg_ts_eta}
+\begin{split}
+\eta^{(b)}(\tau,t_{n=0}) &= \overline{\eta^{(b)}(\tau)}
+\\
+\eta^{(b)}(\tau,t_{n=1}) &= \eta^{(b)}(\tau,t_{n=0}) + \rdt \ \text{RHS}_{n=0} 
+\end{split}
+\end{equation}
+with 
+\begin{equation} \label{DYN_spg_ts_etaF}
+ \overline{\eta^{(b)}(\tau)} = \frac{1}{N+1} \sum\limits_{n=0}^N \eta^{(b)}(\tau-\rdt,t_{n})
+\end{equation}
+the time averaged surface height taken from the previous barotropic cycle. Likewise, 
+\begin{equation} \label{DYN_spg_ts_u}
+\textbf{U}^{(b)}(\tau,t_{n=0}) = \overline{\textbf{U}^{(b)}(\tau)}	\\
+\\
+\textbf{U}(\tau,t_{n=1}) = \textbf{U}^{(b)}(\tau,t_{n=0}) + \rdt \ \text{RHS}_{n=0}  	
+\end{equation}
+with 
+\begin{equation} \label{DYN_spg_ts_u}
+ \overline{\textbf{U}^{(b)}(\tau)} 
+ 	= \frac{1}{N+1} \sum\limits_{n=0}^N\textbf{U}^{(b)}(\tau-\rdt,t_{n})
+\end{equation}
+the time averaged vertically integrated transport. Notably, there is no Robert-Asselin time filter used in the barotropic portion of the integration. 
+
+Upon reaching $t_{n=N} = \tau + 2\rdt \tau$ , the vertically integrated velocity is time averaged to produce the updated vertically integrated velocity at baroclinic time $\tau + \rdt \tau$ 
+\begin{equation} \label{DYN_spg_ts_u}
+\textbf{U}(\tau+\rdt) = \overline{\textbf{U}^{(b)}(\tau+\rdt)} 
+ 	= \frac{1}{N+1} \sum\limits_{n=0}^N\textbf{U}^{(b)}(\tau,t_{n})
+\end{equation}
+The surface height on the new baroclinic time step is then determined via a baroclinic leap-frog using the following form 
+
+\begin{equation} \label{DYN_spg_ts_ssh}
+\eta(\tau+\Delta) - \eta^{F}(\tau-\Delta) = 2\rdt \ \left[ - \nabla \cdot \textbf{U}(\tau) + \text{EMP}_w \right]  
+\end{equation}
+
+ The use of this "big-leap-frog" scheme for the surface height ensures compatibility between the mass/volume budgets and the tracer budgets. More discussion of this point is provided in Chapter 10 (see in particular Section 10.2). 
+ 
+In general, some form of time filter is needed to maintain integrity of the surface 
+height field due to the leap-frog splitting mode in equation \ref{DYN_spg_ts_ssh}. We 
+have tried various forms of such filtering, with the following method discussed in 
+\cite{Griffies_al_MWR01} chosen due to its stability and reasonably good maintenance of 
+tracer conservation properties (see Section ??) 
+
+\begin{equation} \label{DYN_spg_ts_sshf}
+\eta^{F}(\tau-\Delta) =  \overline{\eta^{(b)}(\tau)} 
+\end{equation}
+Another approach tried was 
+
+\begin{equation} \label{DYN_spg_ts_sshf2}
+\eta^{F}(\tau-\Delta) = \eta(\tau) 
+	+ (\alpha/2) \left[\overline{\eta^{(b)}}(\tau+\rdt)
+				    + \overline{\eta^{(b)}}(\tau-\rdt) -2 \;\eta(\tau) \right]
+\end{equation}
+
+which is useful since it isolates all the time filtering aspects into the term multiplied 
+by $\alpha$. This isolation allows for an easy check that tracer conservation is exact when 
+eliminating tracer and surface height time filtering (see Section ?? for more complete discussion). However, in the general case with a non-zero $\alpha$, the filter \ref{DYN_spg_ts_sshf} was found to be more conservative, and so is recommended. 
+
+}            %%end gm comment (copy of griffies book)
+
+%>>>>>===============
+
+
+%--------------------------------------------------------------------------------------------------------------
+% Filtered free surface formulation
+%--------------------------------------------------------------------------------------------------------------
+\subsection{Filtered free surface (\key{dynspg\_flt})}
+\label{DYN_spg_fltp}
+
+The filtered formulation follows the \citet{Roullet_Madec_JGR00} implementation. 
+The extra term introduced in the equations (see \S\ref{PE_free_surface}) is solved implicitly. 
+The elliptic solvers available in the code are documented in \S\ref{MISC}.
+
+%% gm %%======>>>>   given here the discrete eqs provided to the solver
+\gmcomment{               %%% copy from chap-model basics 
+\begin{equation} \label{Eq_spg_flt}
+\frac{\partial {\rm {\bf U}}_h }{\partial t}= {\rm {\bf M}}
+- g \nabla \left( \tilde{\rho} \ \eta \right) 
+- g \ T_c \nabla \left( \widetilde{\rho} \ \partial_t \eta \right) 
+\end{equation}
+where $T_c$, is a parameter with dimensions of time which characterizes the force, 
+$\widetilde{\rho} = \rho / \rho_o$ is the dimensionless density, and $\rm {\bf M}$ 
+represents the collected contributions of the Coriolis, hydrostatic pressure gradient, 
+non-linear and viscous terms in \eqref{Eq_PE_dyn}.
+}   %end gmcomment
+
+Note that in the linear free surface formulation (\key{vvl} not defined), the ocean depth 
+is time-independent and so is the matrix to be inverted. It is computed once and for all and applies to all ocean time steps. 
+
+% ================================================================
+% Lateral diffusion term
+% ================================================================
+\section  [Lateral diffusion term (\textit{dynldf})]
+		{Lateral diffusion term (\mdl{dynldf})}
+\label{DYN_ldf}
+%------------------------------------------nam_dynldf----------------------------------------------------
+\namdisplay{namdyn_ldf} 
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namdyn\_ldf} namelist variables.
+The options available for lateral diffusion are to use either laplacian 
+(rotated or not) or biharmonic operators. The coefficients may be constant 
+or spatially variable; the description of the coefficients is found in the chapter 
+on lateral physics (Chap.\ref{LDF}). The lateral diffusion of momentum is 
+evaluated using a forward scheme, $i.e.$ the velocity appearing in its expression 
+is the \textit{before} velocity in time, except for the pure vertical component 
+that appears when a tensor of rotation is used. This latter term is solved 
+implicitly together with the vertical diffusion term (see \S\ref{STP}) 
+
+At the lateral boundaries either free slip, no slip or partial slip boundary 
+conditions are applied according to the user's choice (see Chap.\ref{LBC}).
+
+\gmcomment{
+Hyperviscous operators are frequently used in the simulation of turbulent flows to control 
+the dissipation of unresolved small scale features. 
+Their primary role is to provide strong dissipation at the smallest scale supported by the grid 
+while minimizing the impact on the larger scale features. 
+Hyperviscous operators are thus designed to be more scale selective than the traditional, 
+physically motivated Laplace operator. 
+In finite difference methods, the biharmonic operator is frequently the method of choice to achieve 
+this scale selective dissipation since its damping time ($i.e.$ its spin down time) 
+scale like $\lambda^{-4}$ for disturbances of wavelength $\lambda$ 
+(so that short waves damped more rapidelly than long ones), 
+whereas the Laplace operator damping time scales only like $\lambda^{-2}$.
+}
+
+% ================================================================
+\subsection   [Iso-level laplacian operator (\np{ln\_dynldf\_lap}) ]
+			{Iso-level laplacian operator (\np{ln\_dynldf\_lap}=true)}
+\label{DYN_ldf_lap}
+
+For lateral iso-level diffusion, the discrete operator is: 
+\begin{equation} \label{Eq_dynldf_lap}
+\left\{ \begin{aligned}
+ D_u^{l{\rm {\bf U}}} =\frac{1}{e_{1u} }\delta _{i+1/2} \left[ {A_T^{lm} 
+\;\chi } \right]-\frac{1}{e_{2u} {\kern 1pt}e_{3u} }\delta _j \left[ 
+{A_f^{lm} \;e_{3f} \zeta } \right] \\ 
+\\
+ D_v^{l{\rm {\bf U}}} =\frac{1}{e_{2v} }\delta _{j+1/2} \left[ {A_T^{lm} 
+\;\chi } \right]+\frac{1}{e_{1v} {\kern 1pt}e_{3v} }\delta _i \left[ 
+{A_f^{lm} \;e_{3f} \zeta } \right] \\ 
+\end{aligned} \right.
+\end{equation} 
+
+As explained in \S\ref{PE_ldf}, this formulation (as the gradient of a divergence 
+and curl of the vorticity) preserves symmetry and ensures a complete 
+separation between the vorticity and divergence parts of the momentum diffusion. 
+
+%--------------------------------------------------------------------------------------------------------------
+%           Rotated laplacian operator
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Rotated laplacian operator (\np{ln\_dynldf\_iso}) ]
+			{Rotated laplacian operator (\np{ln\_dynldf\_iso}=true)}
+\label{DYN_ldf_iso}
+
+A rotation of the lateral momentum diffusion operator is needed in several cases: 
+for iso-neutral diffusion in the $z$-coordinate (\np{ln\_dynldf\_iso}=true) and for 
+either iso-neutral (\np{ln\_dynldf\_iso}=true) or geopotential 
+(\np{ln\_dynldf\_hor}=true) diffusion in the $s$-coordinate. In the partial step 
+case, coordinates are horizontal except at the deepest level and no 
+rotation is performed when \np{ln\_dynldf\_hor}=true. The diffusion operator 
+is defined simply as the divergence of down gradient momentum fluxes on each 
+momentum component. It must be emphasized that this formulation ignores 
+constraints on the stress tensor such as symmetry. The resulting discrete 
+representation is:
+\begin{equation} \label{Eq_dyn_ldf_iso}
+\begin{split}
+ D_u^{l\textbf{U}} &= \frac{1}{e_{1u} \, e_{2u} \, e_{3u} }	\\
+&  \left\{\quad  {\delta _{i+1/2} \left[ {A_T^{lm}  \left( 
+	 {\frac{e_{2t} \; e_{3t} }{e_{1t} } \,\delta _{i}[u]
+	-e_{2t} \; r_{1t} \,\overline{\overline {\delta _{k+1/2}[u]}}^{\,i,\,k}}
+ \right)} \right]} 	\right.
+\\ 
+& \qquad +\ \delta_j \left[ {A_f^{lm} \left( {\frac{e_{1f}\,e_{3f} }{e_{2f} 
+}\,\delta _{j+1/2} [u] - e_{1f}\, r_{2f} 
+\,\overline{\overline {\delta _{k+1/2} [u]}} ^{\,j+1/2,\,k}} 
+\right)} \right] 
+\\ 
+&\qquad +\ \delta_k \left[ {A_{uw}^{lm} \left( {-e_{2u} \, r_{1uw} \,\overline{\overline 
+{\delta_{i+1/2} [u]}}^{\,i+1/2,\,k+1/2} } 
+\right.} \right. 
+\\ 
+&  \ \qquad \qquad \qquad \quad\ 
+- e_{1u} \, r_{2uw} \,\overline{\overline {\delta_{j+1/2} [u]}} ^{\,j,\,k+1/2}
+\\ 
+& \left. {\left. { \ \qquad \qquad \qquad \ \ \ \left. {\ 
++\frac{e_{1u}\, e_{2u} }{e_{3uw} }\,\left( {r_{1uw}^2+r_{2uw}^2} 
+\right)\,\delta_{k+1/2} [u]} \right)} \right]\;\;\;} \right\} 
+\\
+\\
+ D_v^{l\textbf{V}} &= \frac{1}{e_{1v} \, e_{2v} \, e_{3v} }    \\
+&  \left\{\quad  {\delta _{i+1/2} \left[ {A_f^{lm}  \left( 
+	 {\frac{e_{2f} \; e_{3f} }{e_{1f} } \,\delta _{i+1/2}[v]
+	-e_{2f} \; r_{1f} \,\overline{\overline {\delta _{k+1/2}[v]}}^{\,i+1/2,\,k}}
+ \right)} \right]} 	\right.
+\\ 
+& \qquad +\ \delta_j \left[ {A_T^{lm} \left( {\frac{e_{1t}\,e_{3t} }{e_{2t} 
+}\,\delta _{j} [v] - e_{1t}\, r_{2t} 
+\,\overline{\overline {\delta _{k+1/2} [v]}} ^{\,j,\,k}} 
+\right)} \right] 
+\\ 
+& \qquad +\ \delta_k \left[ {A_{vw}^{lm} \left( {-e_{2v} \, r_{1vw} \,\overline{\overline 
+{\delta_{i+1/2} [v]}}^{\,i+1/2,\,k+1/2} }\right.} \right. 
+\\
+&  \ \qquad \qquad \qquad \quad\ 
+- e_{1v} \, r_{2vw} \,\overline{\overline {\delta_{j+1/2} [v]}} ^{\,j+1/2,\,k+1/2}
+\\ 
+& \left. {\left. { \ \qquad \qquad \qquad \ \ \ \left. {\ 
++\frac{e_{1v}\, e_{2v} }{e_{3vw} }\,\left( {r_{1vw}^2+r_{2vw}^2} 
+\right)\,\delta_{k+1/2} [v]} \right)} \right]\;\;\;} \right\} 
+ \end{split}
+\end{equation}
+where $r_1$ and $r_2$ are the slopes between the surface along which the 
+diffusion operator acts and the surface of computation ($z$- or $s$-surfaces). 
+The way these slopes are evaluated is given in the lateral physics chapter 
+(Chap.\ref{LDF}).
+
+%--------------------------------------------------------------------------------------------------------------
+%           Iso-level bilaplacian operator
+%--------------------------------------------------------------------------------------------------------------
+\subsection   [Iso-level bilaplacian operator (\np{ln\_dynldf\_bilap})]
+			{Iso-level bilaplacian operator (\np{ln\_dynldf\_bilap}=true)}
+\label{DYN_ldf_bilap}
+
+The lateral fourth order operator formulation on momentum is obtained by 
+applying \eqref{Eq_dynldf_lap} twice. It requires an additional assumption on 
+boundary conditions: the first derivative term normal to the coast depends on 
+the free or no-slip lateral boundary conditions chosen, while the third 
+derivative terms normal to the coast are set to zero (see Chap.\ref{LBC}).
+%%%
+\gmcomment{add a remark on the the change in the position of the coefficient}
+%%%
+
+% ================================================================
+%           Vertical diffusion term
+% ================================================================
+\section  [Vertical diffusion term (\mdl{dynzdf})]
+		{Vertical diffusion term (\mdl{dynzdf})}
+\label{DYN_zdf}
+%----------------------------------------------namzdf------------------------------------------------------
+\namdisplay{namzdf} 
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namzdf} namelist variables.
+The large vertical diffusion coefficient found in the surface mixed layer together 
+with high vertical resolution implies that in the case of explicit time stepping there 
+would be too restrictive a constraint on the time step. Two time stepping schemes 
+can be used for the vertical diffusion term : $(a)$ a forward time differencing 
+scheme (\np{ln\_zdfexp}=true) using a time splitting technique 
+(\np{nn\_zdfexp} $>$ 1) or $(b)$ a backward (or implicit) time differencing scheme 
+(\np{ln\_zdfexp}=false) (see \S\ref{STP}). Note that namelist variables 
+\np{ln\_zdfexp} and \np{nn\_zdfexp} apply to both tracers and dynamics. 
+
+The formulation of the vertical subgrid scale physics is the same whatever 
+the vertical coordinate is. The vertical diffusion operators given by 
+\eqref{Eq_PE_zdf} take the following semi-discrete space form:
+\begin{equation} \label{Eq_dynzdf}
+\left\{   \begin{aligned}
+D_u^{vm} &\equiv \frac{1}{e_{3u}} \ \delta _k \left[ \frac{A_{uw}^{vm} }{e_{3uw} }
+                              \ \delta _{k+1/2} [\,u\,]         \right]     \\
+\\
+D_v^{vm} &\equiv \frac{1}{e_{3v}} \ \delta _k \left[ \frac{A_{vw}^{vm} }{e_{3vw} }
+                              \ \delta _{k+1/2} [\,v\,]         \right]
+\end{aligned}   \right.
+\end{equation} 
+where $A_{uw}^{vm} $ and $A_{vw}^{vm} $ are the vertical eddy viscosity and 
+diffusivity coefficients. The way these coefficients are evaluated 
+depends on the vertical physics used (see \S\ref{ZDF}).
+
+The surface boundary condition on momentum is the stress exerted by 
+the wind. At the surface, the momentum fluxes are prescribed as the boundary 
+condition on the vertical turbulent momentum fluxes,
+\begin{equation} \label{Eq_dynzdf_sbc}
+\left.{\left( {\frac{A^{vm} }{e_3 }\ \frac{\partial \textbf{U}_h}{\partial k}} \right)} \right|_{z=1}
+	 = \frac{1}{\rho _o} \binom{\tau _u}{\tau _v }
+\end{equation}
+where $\left( \tau _u ,\tau _v \right)$ are the two components of the wind stress 
+vector in the (\textbf{i},\textbf{j}) coordinate system. The high mixing coefficients 
+in the surface mixed layer ensure that the surface wind stress is distributed in 
+the vertical over the mixed layer depth. If the vertical mixing coefficient 
+is small (when no mixed layer scheme is used) the surface stress enters only 
+the top model level, as a body force. The surface wind stress is calculated 
+in the surface module routines (SBC, see Chap.\ref{SBC})
+
+The turbulent flux of momentum at the bottom of the ocean is specified through 
+a bottom friction parameterisation (see \S\ref{ZDF_bfr})
+
+% ================================================================
+% External Forcing
+% ================================================================
+\section{External Forcings}
+\label{DYN_forcing}
+
+Besides the surface and bottom stresses (see the above section) which are 
+introduced as boundary conditions on the vertical mixing, three other forcings 
+may enter the dynamical equations by affecting the surface pressure gradient. 
+
+(1) When \np{ln\_apr\_dyn}~=~true (see \S\ref{SBC_apr}), the atmospheric pressure is taken 
+into account when computing the surface pressure gradient.
+
+(2) When \np{ln\_tide\_pot}~=~true and \np{ln\_tide}~=~true (see \S\ref{SBC_tide}), 
+the tidal potential is taken into account when computing the surface pressure gradient.
+
+(3) When \np{nn\_ice\_embd}~=~2 and LIM or CICE is used ($i.e.$ when the sea-ice is embedded in the ocean), 
+the snow-ice mass is taken into account when computing the surface pressure gradient.
+
+
+\gmcomment{ missing : the lateral boundary condition !!!   another external forcing
+ }
+
+% ================================================================
+% Time evolution term 
+% ================================================================
+\section  [Time evolution term (\textit{dynnxt})]
+		{Time evolution term (\mdl{dynnxt})}
+\label{DYN_nxt}
+
+%----------------------------------------------namdom----------------------------------------------------
+\namdisplay{namdom} 
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namdom} namelist variables.
+The general framework for dynamics time stepping is a leap-frog scheme, 
+$i.e.$ a three level centred time scheme associated with an Asselin time filter 
+(cf. Chap.\ref{STP}). The scheme is applied to the velocity, except when using 
+the flux form of momentum advection (cf. \S\ref{DYN_adv_cor_flux}) in the variable 
+volume case (\key{vvl} defined), where it has to be applied to the thickness 
+weighted velocity (see \S\ref{Apdx_A_momentum})  
+
+$\bullet$ vector invariant form or linear free surface (\np{ln\_dynhpg\_vec}=true ; \key{vvl} not defined):
+\begin{equation} \label{Eq_dynnxt_vec}
+\left\{   \begin{aligned}
+&u^{t+\rdt} = u_f^{t-\rdt} + 2\rdt  \ \text{RHS}_u^t  	\\
+&u_f^t \;\quad = u^t+\gamma \,\left[ {u_f^{t-\rdt} -2u^t+u^{t+\rdt}} \right]
+\end{aligned}   \right.
+\end{equation} 
+
+$\bullet$ flux form and nonlinear free surface (\np{ln\_dynhpg\_vec}=false ; \key{vvl} defined):
+\begin{equation} \label{Eq_dynnxt_flux}
+\left\{   \begin{aligned}
+&\left(e_{3u}\,u\right)^{t+\rdt} = \left(e_{3u}\,u\right)_f^{t-\rdt} + 2\rdt \; e_{3u} \;\text{RHS}_u^t  	\\
+&\left(e_{3u}\,u\right)_f^t \;\quad = \left(e_{3u}\,u\right)^t
+  +\gamma \,\left[ {\left(e_{3u}\,u\right)_f^{t-\rdt} -2\left(e_{3u}\,u\right)^t+\left(e_{3u}\,u\right)^{t+\rdt}} \right]
+\end{aligned}   \right.
+\end{equation} 
+where RHS is the right hand side of the momentum equation, the subscript $f$ 
+denotes filtered values and $\gamma$ is the Asselin coefficient. $\gamma$ is 
+initialized as \np{nn\_atfp} (namelist parameter). Its default value is \np{nn\_atfp} = $10^{-3}$.
+In both cases, the modified Asselin filter is not applied since perfect conservation 
+is not an issue for the momentum equations.
+
+Note that with the filtered free surface, the update of the \textit{after} velocities 
+is done in the \mdl{dynsp\_flt} module, and only array swapping
+and Asselin filtering is done in \mdl{dynnxt}.
+
+% ================================================================
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_LBC.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_LBC.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_LBC.tex	(revision 8732)
@@ -0,0 +1,646 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter — Lateral Boundary Condition (LBC) 
+% ================================================================
+\chapter{Lateral Boundary Condition (LBC) }
+\label{LBC}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+
+
+%gm% add here introduction to this chapter
+
+% ================================================================
+% Boundary Condition at the Coast
+% ================================================================
+\section{Boundary Condition at the Coast (\np{rn\_shlat})}
+\label{LBC_coast}
+%--------------------------------------------nam_lbc-------------------------------------------------------
+\namdisplay{namlbc} 
+%--------------------------------------------------------------------------------------------------------------
+
+%The lateral ocean boundary conditions contiguous to coastlines are Neumann conditions for heat and salt (no flux across boundaries) and Dirichlet conditions for momentum (ranging from free-slip to "strong" no-slip). They are handled automatically by the mask system (see \S\ref{DOM_msk}). 
+
+%OPA allows land and topography grid points in the computational domain due to the presence of continents or islands, and includes the use of a full or partial step representation of bottom topography. The computation is performed over the whole domain, i.e. we do not try to restrict the computation to ocean-only points. This choice has two motivations. Firstly, working on ocean only grid points overloads the code and harms the code readability. Secondly, and more importantly, it drastically reduces the vector portion of the computation, leading to a dramatic increase of CPU time requirement on vector computers.  The current section describes how the masking affects the computation of the various terms of the equations with respect to the boundary condition at solid walls. The process of defining which areas are to be masked is described in \S\ref{DOM_msk}.
+
+Options are defined through the \ngn{namlbc} namelist variables.
+The discrete representation of a domain with complex boundaries (coastlines and 
+bottom topography) leads to arrays that include large portions where a computation 
+is not required as the model variables remain at zero. Nevertheless, vectorial 
+supercomputers are far more efficient when computing over a whole array, and the 
+readability of a code is greatly improved when boundary conditions are applied in 
+an automatic way rather than by a specific computation before or after each 
+computational loop. An efficient way to work over the whole domain while specifying 
+the boundary conditions, is to use multiplication by mask arrays in the computation. 
+A mask array is a matrix whose elements are $1$ in the ocean domain and $0$ 
+elsewhere. A simple multiplication of a variable by its own mask ensures that it will 
+remain zero over land areas. Since most of the boundary conditions consist of a 
+zero flux across the solid boundaries, they can be simply applied by multiplying 
+variables by the correct mask arrays, $i.e.$ the mask array of the grid point where 
+the flux is evaluated. For example, the heat flux in the \textbf{i}-direction is evaluated 
+at $u$-points. Evaluating this quantity as,
+
+\begin{equation} \label{Eq_lbc_aaaa}
+\frac{A^{lT} }{e_1 }\frac{\partial T}{\partial i}\equiv \frac{A_u^{lT} 
+}{e_{1u} } \; \delta _{i+1 / 2} \left[ T \right]\;\;mask_u 
+\end{equation}
+(where mask$_{u}$ is the mask array at a $u$-point) ensures that the heat flux is 
+zero inside land and at the boundaries, since mask$_{u}$ is zero at solid boundaries 
+which in this case are defined at $u$-points (normal velocity $u$ remains zero at 
+the coast) (Fig.~\ref{Fig_LBC_uv}). 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]     \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_LBC_uv}
+\caption{  \label{Fig_LBC_uv}
+Lateral boundary (thick line) at T-level. The velocity normal to the boundary is set to zero.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+For momentum the situation is a bit more complex as two boundary conditions 
+must be provided along the coast (one each for the normal and tangential velocities). 
+The boundary of the ocean in the C-grid is defined by the velocity-faces. 
+For example, at a given $T$-level, the lateral boundary (a coastline or an intersection 
+with the bottom topography) is made of segments joining $f$-points, and normal 
+velocity points are located between two $f-$points (Fig.~\ref{Fig_LBC_uv}). 
+The boundary condition on the normal velocity (no flux through solid boundaries) 
+can thus be easily implemented using the mask system. The boundary condition 
+on the tangential velocity requires a more specific treatment. This boundary 
+condition influences the relative vorticity and momentum diffusive trends, and is 
+required in order to compute the vorticity at the coast. Four different types of 
+lateral boundary condition are available, controlled by the value of the \np{rn\_shlat} 
+namelist parameter. (The value of the mask$_{f}$ array along the coastline is set 
+equal to this parameter.) These are:
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!p] \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_LBC_shlat}
+\caption{     \label{Fig_LBC_shlat} 
+lateral boundary condition (a) free-slip ($rn\_shlat=0$) ; (b) no-slip ($rn\_shlat=2$) 
+; (c) "partial" free-slip ($0<rn\_shlat<2$) and (d) "strong" no-slip ($2<rn\_shlat$). 
+Implied "ghost" velocity inside land area is display in grey. }
+\end{center}    \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\begin{description}
+
+\item[free-slip boundary condition (\np{rn\_shlat}=0): ]  the tangential velocity at the 
+coastline is equal to the offshore velocity, $i.e.$ the normal derivative of the 
+tangential velocity is zero at the coast, so the vorticity: mask$_{f}$ array is set 
+to zero inside the land and just at the coast (Fig.~\ref{Fig_LBC_shlat}-a).
+
+\item[no-slip boundary condition (\np{rn\_shlat}=2): ] the tangential velocity vanishes 
+at the coastline. Assuming that the tangential velocity decreases linearly from 
+the closest ocean velocity grid point to the coastline, the normal derivative is 
+evaluated as if the velocities at the closest land velocity gridpoint and the closest 
+ocean velocity gridpoint were of the same magnitude but in the opposite direction 
+(Fig.~\ref{Fig_LBC_shlat}-b). Therefore, the vorticity along the coastlines is given by: 
+
+\begin{equation*}
+\zeta \equiv 2 \left(\delta_{i+1/2} \left[e_{2v} v \right] - \delta_{j+1/2} \left[e_{1u} u \right] \right) / \left(e_{1f} e_{2f} \right) \ ,
+\end{equation*}
+where $u$ and $v$ are masked fields. Setting the mask$_{f}$ array to $2$ along 
+the coastline provides a vorticity field computed with the no-slip boundary condition, 
+simply by multiplying it by the mask$_{f}$ :
+\begin{equation} \label{Eq_lbc_bbbb}
+\zeta \equiv \frac{1}{e_{1f} {\kern 1pt}e_{2f} }\left( {\delta _{i+1/2} 
+\left[ {e_{2v} \,v} \right]-\delta _{j+1/2} \left[ {e_{1u} \,u} \right]} 
+\right)\;\mbox{mask}_f 
+\end{equation}
+
+\item["partial" free-slip boundary condition (0$<$\np{rn\_shlat}$<$2): ] the tangential 
+velocity at the coastline is smaller than the offshore velocity, $i.e.$ there is a lateral 
+friction but not strong enough to make the tangential velocity at the coast vanish 
+(Fig.~\ref{Fig_LBC_shlat}-c). This can be selected by providing a value of mask$_{f}$ 
+strictly inbetween $0$ and $2$.
+
+\item["strong" no-slip boundary condition (2$<$\np{rn\_shlat}): ] the viscous boundary 
+layer is assumed to be smaller than half the grid size (Fig.~\ref{Fig_LBC_shlat}-d). 
+The friction is thus larger than in the no-slip case.
+
+\end{description}
+
+Note that when the bottom topography is entirely represented by the $s$-coor-dinates 
+(pure $s$-coordinate), the lateral boundary condition on tangential velocity is of much 
+less importance as it is only applied next to the coast where the minimum water depth 
+can be quite shallow.
+
+
+% ================================================================
+% Boundary Condition around the Model Domain
+% ================================================================
+\section{Model Domain Boundary Condition (\np{jperio})}
+\label{LBC_jperio}
+
+At the model domain boundaries several choices are offered: closed, cyclic east-west, 
+south symmetric across the equator, a north-fold, and combination closed-north fold 
+or cyclic-north-fold. The north-fold boundary condition is associated with the 3-pole ORCA mesh. 
+
+% -------------------------------------------------------------------------------------------------------------
+%        Closed, cyclic, south symmetric (\np{jperio} = 0, 1 or 2) 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Closed, cyclic, south symmetric (\np{jperio} = 0, 1 or 2)}
+\label{LBC_jperio012}
+
+The choice of closed, cyclic or symmetric model domain boundary condition is made 
+by setting \np{jperio} to 0, 1 or 2 in namelist \ngn{namcfg}. Each time such a boundary 
+condition is needed, it is set by a call to routine \mdl{lbclnk}. The computation of 
+momentum and tracer trends proceeds from $i=2$ to $i=jpi-1$ and from $j=2$ to 
+$j=jpj-1$, $i.e.$ in the model interior. To choose a lateral model boundary condition 
+is to specify the first and last rows and columns of the model variables. 
+
+\begin{description}
+
+\item[For closed boundary (\textit{jperio=0})], solid walls are imposed at all model 
+boundaries: first and last rows and columns are set to zero.
+
+\item[For cyclic east-west boundary (\textit{jperio=1})], first and last rows are set 
+to zero (closed) whilst the first column is set to the value of the last-but-one column 
+and the last column to the value of the second one (Fig.~\ref{Fig_LBC_jperio}-a). 
+Whatever flows out of the eastern (western) end of the basin enters the western 
+(eastern) end. Note that there is no option for north-south cyclic or for doubly 
+cyclic cases.
+
+\item[For symmetric boundary condition across the equator (\textit{jperio=2})], 
+last rows, and first and last columns are set to zero (closed). The row of symmetry 
+is chosen to be the $u$- and $T-$points equator line ($j=2$, i.e. at the southern 
+end of the domain). For arrays defined at $u-$ or $T-$points, the first row is set 
+to the value of the third row while for most of $v$- and $f$-point arrays ($v$, $\zeta$, 
+$j\psi$, but \gmcomment{not sure why this is "but"} scalar arrays such as eddy coefficients) 
+the first row is set to minus the value of the second row (Fig.~\ref{Fig_LBC_jperio}-b). 
+Note that this boundary condition is not yet available for the case of a massively 
+parallel computer (\textbf{key{\_}mpp} defined).
+
+\end{description}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]     \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_LBC_jperio}
+\caption{    \label{Fig_LBC_jperio}
+setting of (a) east-west cyclic  (b) symmetric across the equator boundary conditions.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        North fold (\textit{jperio = 3 }to $6)$ 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{North-fold (\textit{jperio = 3 }to $6$) }
+\label{LBC_north_fold}
+
+The north fold boundary condition has been introduced in order to handle the north 
+boundary of a three-polar ORCA grid. Such a grid has two poles in the northern hemisphere 
+(Fig.\ref{Fig_MISC_ORCA_msh}, and thus requires a specific treatment illustrated in Fig.\ref{Fig_North_Fold_T}. 
+Further information can be found in \mdl{lbcnfd} module which applies the north fold boundary condition.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_North_Fold_T}
+\caption{    \label{Fig_North_Fold_T} 
+North fold boundary with a $T$-point pivot and cyclic east-west boundary condition 
+($jperio=4$), as used in ORCA 2, 1/4, and 1/12. Pink shaded area corresponds 
+to the inner domain mask (see text). }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% ====================================================================
+% Exchange with neighbouring processors 
+% ====================================================================
+\section  [Exchange with neighbouring processors (\textit{lbclnk}, \textit{lib\_mpp})]
+		{Exchange with neighbouring processors (\mdl{lbclnk}, \mdl{lib\_mpp})}
+\label{LBC_mpp}
+
+For massively parallel processing (mpp), a domain decomposition method is used. 
+The basic idea of the method is to split the large computation domain of a numerical 
+experiment into several smaller domains and solve the set of equations by addressing 
+independent local problems. Each processor has its own local memory and computes 
+the model equation over a subdomain of the whole model domain. The subdomain 
+boundary conditions are specified through communications between processors 
+which are organized by explicit statements (message passing method). 
+
+A big advantage is that the method does not need many modifications of the initial 
+FORTRAN code. From the modeller's point of view, each sub domain running on 
+a processor is identical to the "mono-domain" code. In addition, the programmer 
+manages the communications between subdomains, and the code is faster when 
+the number of processors is increased. The porting of OPA code on an iPSC860 
+was achieved during Guyon's PhD [Guyon et al. 1994, 1995] in collaboration with 
+CETIIS and ONERA. The implementation in the operational context and the studies 
+of performance on a T3D and T3E Cray computers have been made in collaboration 
+with IDRIS and CNRS. The present implementation is largely inspired by Guyon's 
+work  [Guyon 1995].
+
+The parallelization strategy is defined by the physical characteristics of the 
+ocean model. Second order finite difference schemes lead to local discrete 
+operators that depend at the very most on one neighbouring point. The only 
+non-local computations concern the vertical physics (implicit diffusion, 
+turbulent closure scheme, ...) (delocalization over the whole water column), 
+and the solving of the elliptic equation associated with the surface pressure 
+gradient computation (delocalization over the whole horizontal domain). 
+Therefore, a pencil strategy is used for the data sub-structuration 
+: the 3D initial domain is laid out on local processor 
+memories following a 2D horizontal topological splitting. Each sub-domain 
+computes its own surface and bottom boundary conditions and has a side 
+wall overlapping interface which defines the lateral boundary conditions for 
+computations in the inner sub-domain. The overlapping area consists of the 
+two rows at each edge of the sub-domain. After a computation, a communication 
+phase starts: each processor sends to its neighbouring processors the update 
+values of the points corresponding to the interior overlapping area to its 
+neighbouring sub-domain ($i.e.$ the innermost of the two overlapping rows). 
+The communication is done through the Message Passing Interface (MPI). 
+The data exchanges between processors are required at the very 
+place where lateral domain boundary conditions are set in the mono-domain 
+computation : the \rou{lbc\_lnk} routine (found in \mdl{lbclnk} module) 
+which manages such conditions is interfaced with routines found in \mdl{lib\_mpp} module 
+when running on an MPP computer ($i.e.$ when \key{mpp\_mpi} defined). 
+It has to be pointed out that when using the MPP version of the model, 
+the east-west cyclic boundary condition is done implicitly, 
+whilst the south-symmetric boundary condition option is not available.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_mpp}
+\caption{   \label{Fig_mpp} 
+Positioning of a sub-domain when massively parallel processing is used. }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+In the standard version of \NEMO, the splitting is regular and arithmetic.
+The i-axis is divided by \jp{jpni} and the j-axis by \jp{jpnj} for a number of processors 
+\jp{jpnij} most often equal to $jpni \times jpnj$ (parameters set in 
+ \ngn{nammpp} namelist). Each processor is independent and without message passing 
+ or synchronous process, programs run alone and access just its own local memory. 
+ For this reason, the main model dimensions are now the local dimensions of the subdomain (pencil) 
+ that are named \jp{jpi}, \jp{jpj}, \jp{jpk}. These dimensions include the internal 
+ domain and the overlapping rows. The number of rows to exchange (known as 
+ the halo) is usually set to one (\jp{jpreci}=1, in \mdl{par\_oce}). The whole domain 
+ dimensions are named \np{jpiglo}, \np{jpjglo} and \jp{jpk}. The relationship between 
+ the whole domain and a sub-domain is:
+\begin{eqnarray} 
+      jpi & = & ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci  \nonumber \\
+      jpj & = & ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj  \label{Eq_lbc_jpi}
+\end{eqnarray}
+where \jp{jpni}, \jp{jpnj} are the number of processors following the i- and j-axis.
+
+One also defines variables nldi and nlei which correspond to the internal domain bounds, 
+and the variables nimpp and njmpp which are the position of the (1,1) grid-point in the global domain. 
+An element of $T_{l}$, a local array (subdomain) corresponds to an element of $T_{g}$, 
+a global array (whole domain) by the relationship: 
+\begin{equation} \label{Eq_lbc_nimpp}
+T_{g} (i+nimpp-1,j+njmpp-1,k) = T_{l} (i,j,k),
+\end{equation}
+with  $1 \leq i \leq jpi$, $1  \leq j \leq jpj $ , and  $1  \leq k \leq jpk$.
+
+Processors are numbered from 0 to $jpnij-1$, the number is saved in the variable 
+nproc. In the standard version, a processor has no more than four neighbouring 
+processors named nono (for north), noea (east), noso (south) and nowe (west) 
+and two variables, nbondi and nbondj, indicate the relative position of the processor :
+\begin{itemize}
+\item 		nbondi = -1 	an east neighbour, no west processor,
+\item 		nbondi =  0	an east neighbour, a west neighbour,
+\item 		nbondi =  1 	no east processor, a west neighbour,
+\item 		nbondi =  2 	no splitting following the i-axis.
+\end{itemize}
+During the simulation, processors exchange data with their neighbours. 
+If there is effectively a neighbour, the processor receives variables from this 
+processor on its overlapping row, and sends the data issued from internal 
+domain corresponding to the overlapping row of the other processor.
+
+
+The \NEMO model computes equation terms with the help of mask arrays (0 on land 
+points and 1 on sea points). It is easily readable and very efficient in the context of 
+a computer with vectorial architecture. However, in the case of a scalar processor, 
+computations over the land regions become more expensive in terms of CPU time. 
+It is worse when we use a complex configuration with a realistic bathymetry like the 
+global ocean where more than 50 \% of points are land points. For this reason, a 
+pre-processing tool can be used to choose the mpp domain decomposition with a 
+maximum number of only land points processors, which can then be eliminated (Fig. \ref{Fig_mppini2})
+(For example, the mpp\_optimiz tools, available from the DRAKKAR web site). 
+This optimisation is dependent on the specific bathymetry employed. The user 
+then chooses optimal parameters \jp{jpni}, \jp{jpnj} and \jp{jpnij} with 
+$jpnij < jpni \times jpnj$, leading to the elimination of $jpni \times jpnj - jpnij$ 
+land processors. When those parameters are specified in \ngn{nammpp} namelist, 
+the algorithm in the \rou{inimpp2} routine sets each processor's parameters (nbound, 
+nono, noea,...) so that the land-only processors are not taken into account. 
+
+\gmcomment{Note that the inimpp2 routine is general so that the original inimpp 
+routine should be suppressed from the code.}
+
+When land processors are eliminated, the value corresponding to these locations in 
+the model output files is undefined. Note that this is a problem for the meshmask file 
+which requires to be defined over the whole domain. Therefore, user should not eliminate 
+land processors when creating a meshmask file ($i.e.$ when setting a non-zero value to \np{nn\_msh}).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]     \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_mppini2}
+\caption {    \label{Fig_mppini2}
+Example of Atlantic domain defined for the CLIPPER projet. Initial grid is 
+composed of 773 x 1236 horizontal points. 
+(a) the domain is split onto 9 \time 20 subdomains (jpni=9, jpnj=20). 
+52 subdomains are land areas. 
+(b) 52 subdomains are eliminated (white rectangles) and the resulting number 
+of processors really used during the computation is jpnij=128.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% ====================================================================
+% Unstructured open boundaries BDY 
+% ====================================================================
+\section{Unstructured Open Boundary Conditions (BDY)}
+\label{LBC_bdy}
+
+%-----------------------------------------nambdy--------------------------------------------
+\namdisplay{nambdy} 
+%-----------------------------------------------------------------------------------------------
+%-----------------------------------------nambdy_index--------------------------------------------
+\namdisplay{nambdy_index} 
+%-----------------------------------------------------------------------------------------------
+%-----------------------------------------nambdy_dta--------------------------------------------
+\namdisplay{nambdy_dta} 
+%-----------------------------------------------------------------------------------------------
+%-----------------------------------------nambdy_dta--------------------------------------------
+\namdisplay{nambdy_dta2} 
+%-----------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{nambdy} \ngn{nambdy\_index} 
+\ngn{nambdy\_dta} \ngn{nambdy\_dta2} namelist variables.
+The BDY module is the core implementation of open boundary
+conditions for regional configurations. It implements the Flow
+Relaxation Scheme algorithm for temperature, salinity, velocities and
+ice fields, and the Flather radiation condition for the depth-mean
+transports. The specification of the location of the open boundary is
+completely flexible and allows for example the open boundary to follow
+an isobath or other irregular contour. 
+
+The BDY module was modelled on the OBC module (see NEMO 3.4) and shares many
+features and a similar coding structure \citep{Chanut2005}.
+
+Boundary data files used with earlier versions of NEMO may need
+to be re-ordered to work with this version. See the
+section on the Input Boundary Data Files for details.
+
+%----------------------------------------------
+\subsection{The namelists}
+\label{BDY_namelist}
+
+The BDY module is activated by setting \np{ln\_bdy} to true.
+It is possible to define more than one boundary ``set'' and apply
+different boundary conditions to each set. The number of boundary
+sets is defined by \np{nb\_bdy}.  Each boundary set may be defined
+as a set of straight line segments in a namelist
+(\np{ln\_coords\_file}=.false.) or read in from a file
+(\np{ln\_coords\_file}=.true.). If the set is defined in a namelist,
+then the namelists nambdy\_index must be included separately, one for
+each set. If the set is defined by a file, then a
+``coordinates.bdy.nc'' file must be provided. The coordinates.bdy file
+is analagous to the usual NEMO ``coordinates.nc'' file. In the example
+above, there are two boundary sets, the first of which is defined via
+a file and the second is defined in a namelist. For more details of
+the definition of the boundary geometry see section
+\ref{BDY_geometry}.
+
+For each boundary set a boundary
+condition has to be chosen for the barotropic solution (``u2d'':
+sea-surface height and barotropic velocities), for the baroclinic
+velocities (``u3d''), and for the active tracers\footnote{The BDY
+  module does not deal with passive tracers at this version}
+(``tra''). For each set of variables there is a choice of algorithm
+and a choice for the data, eg. for the active tracers the algorithm is
+set by \np{nn\_tra} and the choice of data is set by
+\np{nn\_tra\_dta}. 
+
+The choice of algorithm is currently as follows:
+
+\mbox{}
+
+\begin{itemize}
+\item[0.] No boundary condition applied. So the solution will ``see''
+  the land points around the edge of the edge of the domain.
+\item[1.] Flow Relaxation Scheme (FRS) available for all variables. 
+\item[2.] Flather radiation scheme for the barotropic variables. The
+  Flather scheme is not compatible with the filtered free surface
+  ({\it dynspg\_ts}). 
+\end{itemize}
+
+\mbox{}
+
+The main choice for the boundary data is
+to use initial conditions as boundary data (\np{nn\_tra\_dta}=0) or to
+use external data from a file (\np{nn\_tra\_dta}=1). For the
+barotropic solution there is also the option to use tidal
+harmonic forcing either by itself or in addition to other external
+data. 
+
+If external boundary data is required then the nambdy\_dta namelist
+must be defined. One nambdy\_dta namelist is required for each boundary
+set in the order in which the boundary sets are defined in nambdy. In
+the example given, two boundary sets have been defined and so there
+are two nambdy\_dta namelists. The boundary data is read in using the
+fldread module, so the nambdy\_dta namelist is in the format required
+for fldread. For each variable required, the filename, the frequency
+of the files and the frequency of the data in the files is given. Also
+whether or not time-interpolation is required and whether the data is
+climatological (time-cyclic) data. Note that on-the-fly spatial
+interpolation of boundary data is not available at this version. 
+
+In the example namelists given, two boundary sets are defined. The
+first set is defined via a file and applies FRS conditions to
+temperature and salinity and Flather conditions to the barotropic
+variables. External data is provided in daily files (from a
+large-scale model). Tidal harmonic forcing is also used. The second
+set is defined in a namelist. FRS conditions are applied on
+temperature and salinity and climatological data is read from external
+files. 
+
+%----------------------------------------------
+\subsection{The Flow Relaxation Scheme}
+\label{BDY_FRS_scheme}
+
+The Flow Relaxation Scheme (FRS) \citep{Davies_QJRMS76,Engerdahl_Tel95},
+applies a simple relaxation of the model fields to
+externally-specified values over a zone next to the edge of the model
+domain. Given a model prognostic variable $\Phi$ 
+\begin{equation}  \label{Eq_bdy_frs1}
+\Phi(d) = \alpha(d)\Phi_{e}(d) + (1-\alpha(d))\Phi_{m}(d)\;\;\;\;\; d=1,N
+\end{equation}
+where $\Phi_{m}$ is the model solution and $\Phi_{e}$ is the specified
+external field, $d$ gives the discrete distance from the model
+boundary  and $\alpha$ is a parameter that varies from $1$ at $d=1$ to
+a small value at $d=N$. It can be shown that this scheme is equivalent
+to adding a relaxation term to the prognostic equation for $\Phi$ of
+the form:
+\begin{equation}  \label{Eq_bdy_frs2}
+-\frac{1}{\tau}\left(\Phi - \Phi_{e}\right)
+\end{equation}
+where the relaxation time scale $\tau$ is given by a function of
+$\alpha$ and the model time step $\Delta t$:
+\begin{equation}  \label{Eq_bdy_frs3}
+\tau = \frac{1-\alpha}{\alpha}  \,\rdt
+\end{equation}
+Thus the model solution is completely prescribed by the external
+conditions at the edge of the model domain and is relaxed towards the
+external conditions over the rest of the FRS zone. The application of
+a relaxation zone helps to prevent spurious reflection of outgoing
+signals from the model boundary. 
+
+The function $\alpha$ is specified as a $tanh$ function:
+\begin{equation}  \label{Eq_bdy_frs4}
+\alpha(d) = 1 - \tanh\left(\frac{d-1}{2}\right),       \quad d=1,N
+\end{equation}
+The width of the FRS zone is specified in the namelist as 
+\np{nn\_rimwidth}. This is typically set to a value between 8 and 10. 
+
+%----------------------------------------------
+\subsection{The Flather radiation scheme}
+\label{BDY_flather_scheme}
+
+The \citet{Flather_JPO94} scheme is a radiation condition on the normal, depth-mean
+transport across the open boundary. It takes the form
+\begin{equation}  \label{Eq_bdy_fla1}
+U = U_{e} + \frac{c}{h}\left(\eta - \eta_{e}\right),
+\end{equation}
+where $U$ is the depth-mean velocity normal to the boundary and $\eta$
+is the sea surface height, both from the model. The subscript $e$
+indicates the same fields from external sources. The speed of external
+gravity waves is given by $c = \sqrt{gh}$, and $h$ is the depth of the
+water column. The depth-mean normal velocity along the edge of the
+model domain is set equal to the
+external depth-mean normal velocity, plus a correction term that
+allows gravity waves generated internally to exit the model boundary.
+Note that the sea-surface height gradient in \eqref{Eq_bdy_fla1}
+is a spatial gradient across the model boundary, so that $\eta_{e}$ is
+defined on the $T$ points with $nbr=1$ and $\eta$ is defined on the
+$T$ points with $nbr=2$. $U$ and $U_{e}$ are defined on the $U$ or
+$V$ points with $nbr=1$, $i.e.$ between the two $T$ grid points.
+
+%----------------------------------------------
+\subsection{Boundary geometry}
+\label{BDY_geometry}
+
+Each open boundary set is defined as a list of points. The information
+is stored in the arrays $nbi$, $nbj$, and $nbr$ in the $idx\_bdy$
+structure.  The $nbi$ and $nbj$ arrays
+define the local $(i,j)$ indices of each point in the boundary zone
+and the $nbr$ array defines the discrete distance from the boundary
+with $nbr=1$ meaning that the point is next to the edge of the
+model domain and $nbr>1$ showing that the point is increasingly
+further away from the edge of the model domain. A set of $nbi$, $nbj$,
+and $nbr$ arrays is defined for each of the $T$, $U$ and $V$
+grids. Figure \ref{Fig_LBC_bdy_geom} shows an example of an irregular
+boundary. 
+
+The boundary geometry for each set may be defined in a namelist
+nambdy\_index or by reading in a ``coordinates.bdy.nc'' file. The
+nambdy\_index namelist defines a series of straight-line segments for
+north, east, south and west boundaries. For the northern boundary,
+\np{nbdysegn} gives the number of segments, \np{jpjnob} gives the $j$
+index for each segment and \np{jpindt} and \np{jpinft} give the start
+and end $i$ indices for each segment with similar for the other
+boundaries. These segments define a list of $T$ grid points along the
+outermost row of the boundary ($nbr\,=\, 1$). The code deduces the $U$ and
+$V$ points and also the points for $nbr\,>\, 1$ if
+$nn\_rimwidth\,>\,1$.
+
+The boundary geometry may also be defined from a
+``coordinates.bdy.nc'' file. Figure \ref{Fig_LBC_nc_header}
+gives an example of the header information from such a file. The file
+should contain the index arrays for each of the $T$, $U$ and $V$
+grids. The arrays must be in order of increasing $nbr$. Note that the
+$nbi$, $nbj$ values in the file are global values and are converted to
+local values in the code. Typically this file will be used to generate
+external boundary data via interpolation and so will also contain the
+latitudes and longitudes of each point as shown. However, this is not
+necessary to run the model. 
+
+For some choices of irregular boundary the model domain may contain
+areas of ocean which are not part of the computational domain. For
+example if an open boundary is defined along an isobath, say at the
+shelf break, then the areas of ocean outside of this boundary will
+need to be masked out. This can be done by reading a mask file defined
+as \np{cn\_mask\_file} in the nam\_bdy namelist. Only one mask file is
+used even if multiple boundary sets are defined.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]      \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_LBC_bdy_geom}
+\caption {      \label{Fig_LBC_bdy_geom}
+Example of geometry of unstructured open boundary}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+%----------------------------------------------
+\subsection{Input boundary data files}
+\label{BDY_data}
+
+The data files contain the data arrays
+in the order in which the points are defined in the $nbi$ and $nbj$
+arrays. The data arrays are dimensioned on: a time dimension;
+$xb$ which is the index of the boundary data point in the horizontal;
+and $yb$ which is a degenerate dimension of 1 to enable the file to be
+read by the standard NEMO I/O routines. The 3D fields also have a
+depth dimension. 
+
+At Version 3.4 there are new restrictions on the order in which the
+boundary points are defined (and therefore restrictions on the order
+of the data in the file). In particular:
+
+\mbox{}
+
+\begin{enumerate}
+\item The data points must be in order of increasing $nbr$, ie. all
+  the $nbr=1$ points, then all the $nbr=2$ points etc.
+\item All the data for a particular boundary set must be in the same
+  order. (Prior to 3.4 it was possible to define barotropic data in a
+  different order to the data for tracers and baroclinic velocities). 
+\end{enumerate}
+
+\mbox{}
+
+These restrictions mean that data files used with previous versions of
+the model may not work with version 3.4. A fortran utility
+{\it bdy\_reorder} exists in the TOOLS directory which will re-order the
+data in old BDY data files. 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]     \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_LBC_nc_header}
+\caption {     \label{Fig_LBC_nc_header} 
+Example of the header for a coordinates.bdy.nc file}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+%----------------------------------------------
+\subsection{Volume correction}
+\label{BDY_vol_corr}
+
+There is an option to force the total volume in the regional model to be constant, 
+similar to the option in the OBC module. This is controlled  by the \np{nn\_volctl} 
+parameter in the namelist. A value of \np{nn\_volctl}~=~0 indicates that this option is not used. 
+If  \np{nn\_volctl}~=~1 then a correction is applied to the normal velocities 
+around the boundary at each timestep to ensure that the integrated volume flow 
+through the boundary is zero. If \np{nn\_volctl}~=~2 then the calculation of 
+the volume change on the timestep includes the change due to the freshwater 
+flux across the surface and the correction velocity corrects for this as well.
+
+If more than one boundary set is used then volume correction is
+applied to all boundaries at once.
+
+\newpage
+%----------------------------------------------
+\subsection{Tidal harmonic forcing}
+\label{BDY_tides}
+
+%-----------------------------------------nambdy_tide--------------------------------------------
+\namdisplay{nambdy_tide} 
+%-----------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{nambdy\_tide} namelist variables.
+ To be written....
+
+
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_LDF.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 8732)
@@ -0,0 +1,503 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+
+% ================================================================
+% Chapter ———  Lateral Ocean Physics (LDF)
+% ================================================================
+\chapter{Lateral Ocean Physics (LDF)}
+\label{LDF}
+\minitoc
+
+
+\newpage
+$\ $\newline    % force a new ligne
+
+
+The lateral physics terms in the momentum and tracer equations have been 
+described in \S\ref{PE_zdf} and their discrete formulation in \S\ref{TRA_ldf} 
+and \S\ref{DYN_ldf}). In this section we further discuss each lateral physics option. 
+Choosing one lateral physics scheme means for the user defining, 
+(1) the type of operator used (laplacian or bilaplacian operators, or no lateral mixing term) ; 
+(2) the direction along which the lateral diffusive fluxes are evaluated (model level, geopotential or isopycnal surfaces) ; and 
+(3) the space and time variations of the eddy coefficients. 
+These three aspects of the lateral diffusion are set through namelist parameters 
+(see the \textit{\ngn{nam\_traldf}} and \textit{\ngn{nam\_dynldf}} below). 
+Note that this chapter describes the standard implementation of iso-neutral
+tracer mixing, and Griffies's implementation, which is used if
+\np{traldf\_grif}=true, is described in Appdx\ref{sec:triad}
+
+%-----------------------------------nam_traldf - nam_dynldf--------------------------------------------
+\namdisplay{namtra_ldf} 
+\namdisplay{namdyn_ldf} 
+%--------------------------------------------------------------------------------------------------------------
+
+
+% ================================================================
+% Direction of lateral Mixing
+% ================================================================
+\section  [Direction of Lateral Mixing (\textit{ldfslp})]
+		{Direction of Lateral Mixing (\mdl{ldfslp})}
+\label{LDF_slp}
+
+%%%
+\gmcomment{  we should emphasize here that the implementation is a rather old one. 
+Better work can be achieved by using \citet{Griffies_al_JPO98, Griffies_Bk04} iso-neutral scheme. }
+
+A direction for lateral mixing has to be defined when the desired operator does 
+not act along the model levels. This occurs when $(a)$ horizontal mixing is 
+required on tracer or momentum (\np{ln\_traldf\_hor} or \np{ln\_dynldf\_hor}) 
+in $s$- or mixed $s$-$z$- coordinates, and $(b)$ isoneutral mixing is required 
+whatever the vertical coordinate is. This direction of mixing is defined by its 
+slopes in the \textbf{i}- and \textbf{j}-directions at the face of the cell of the 
+quantity to be diffused. For a tracer, this leads to the following four slopes : 
+$r_{1u}$, $r_{1w}$, $r_{2v}$, $r_{2w}$ (see \eqref{Eq_tra_ldf_iso}), while 
+for momentum the slopes are  $r_{1t}$, $r_{1uw}$, $r_{2f}$, $r_{2uw}$ for 
+$u$ and  $r_{1f}$, $r_{1vw}$, $r_{2t}$, $r_{2vw}$ for $v$. 
+
+%gm% add here afigure of the slope in i-direction
+
+\subsection{slopes for tracer geopotential mixing in the $s$-coordinate}
+
+In $s$-coordinates, geopotential mixing ($i.e.$ horizontal mixing) $r_1$ and 
+$r_2$ are the slopes between the geopotential and computational surfaces. 
+Their discrete formulation is found by locally solving \eqref{Eq_tra_ldf_iso} 
+when the diffusive fluxes in the three directions are set to zero and $T$ is 
+assumed to be horizontally uniform, $i.e.$ a linear function of $z_T$, the 
+depth of a $T$-point. 
+%gm { Steven : My version is obviously wrong since I'm left with an arbitrary constant which is the local vertical temperature gradient}
+
+\begin{equation} \label{Eq_ldfslp_geo}
+\begin{aligned}
+ r_{1u} &= \frac{e_{3u}}{ \left( e_{1u}\;\overline{\overline{e_{3w}}}^{\,i+1/2,\,k} \right)}
+ 			  \;\delta_{i+1/2}[z_t] 
+ 		&\approx \frac{1}{e_{1u}}\; \delta_{i+1/2}[z_t] \ \ \
+\\
+ r_{2v} &= \frac{e_{3v}}{\left( e_{2v}\;\overline{\overline{e_{3w}}}^{\,j+1/2,\,k} \right)} 
+ 			  \;\delta_{j+1/2} [z_t] 
+		&\approx \frac{1}{e_{2v}}\; \delta_{j+1/2}[z_t] \ \ \
+\\
+ r_{1w} &= \frac{1}{e_{1w}}\;\overline{\overline{\delta_{i+1/2}[z_t]}}^{\,i,\,k+1/2}
+ 		&\approx \frac{1}{e_{1w}}\; \delta_{i+1/2}[z_{uw}] 
+ \\
+ r_{2w} &= \frac{1}{e_{2w}}\;\overline{\overline{\delta_{j+1/2}[z_t]}}^{\,j,\,k+1/2}
+		&\approx \frac{1}{e_{2w}}\; \delta_{j+1/2}[z_{vw}] 
+ \\
+\end{aligned}
+\end{equation}
+
+%gm%  caution I'm not sure the simplification was a good idea! 
+
+These slopes are computed once in \rou{ldfslp\_init} when \np{ln\_sco}=True, 
+and either \np{ln\_traldf\_hor}=True or \np{ln\_dynldf\_hor}=True. 
+
+\subsection{Slopes for tracer iso-neutral mixing}\label{LDF_slp_iso}
+In iso-neutral mixing  $r_1$ and $r_2$ are the slopes between the iso-neutral 
+and computational surfaces. Their formulation does not depend on the vertical 
+coordinate used. Their discrete formulation is found using the fact that the 
+diffusive fluxes of locally referenced potential density ($i.e.$ $in situ$ density) 
+vanish. So, substituting $T$ by $\rho$ in \eqref{Eq_tra_ldf_iso} and setting the 
+diffusive fluxes in the three directions to zero leads to the following definition for 
+the neutral slopes:
+
+\begin{equation} \label{Eq_ldfslp_iso}
+\begin{split}
+ r_{1u} &= \frac{e_{3u}}{e_{1u}}\; \frac{\delta_{i+1/2}[\rho]}
+ 								{\overline{\overline{\delta_{k+1/2}[\rho]}}^{\,i+1/2,\,k}}
+\\
+ r_{2v} &= \frac{e_{3v}}{e_{2v}}\; \frac{\delta_{j+1/2}\left[\rho \right]}
+ 								{\overline{\overline{\delta_{k+1/2}[\rho]}}^{\,j+1/2,\,k}}
+\\
+ r_{1w} &= \frac{e_{3w}}{e_{1w}}\; 
+ 			\frac{\overline{\overline{\delta_{i+1/2}[\rho]}}^{\,i,\,k+1/2}}
+				 {\delta_{k+1/2}[\rho]}
+\\
+ r_{2w} &= \frac{e_{3w}}{e_{2w}}\; 
+ 			\frac{\overline{\overline{\delta_{j+1/2}[\rho]}}^{\,j,\,k+1/2}}
+				 {\delta_{k+1/2}[\rho]}
+\\
+\end{split}
+\end{equation}
+
+%gm% rewrite this as the explanation is not very clear !!!
+%In practice, \eqref{Eq_ldfslp_iso} is of little help in evaluating the neutral surface slopes. Indeed, for an unsimplified equation of state, the density has a strong dependancy on pressure (here approximated as the depth), therefore applying \eqref{Eq_ldfslp_iso} using the $in situ$ density, $\rho$, computed at T-points leads to a flattening of slopes as the depth increases. This is due to the strong increase of the $in situ$ density with depth. 
+
+%By definition, neutral surfaces are tangent to the local $in situ$ density \citep{McDougall1987}, therefore in \eqref{Eq_ldfslp_iso}, all the derivatives have to be evaluated at the same local pressure (which in decibars is approximated by the depth in meters).
+
+%In the $z$-coordinate, the derivative of the  \eqref{Eq_ldfslp_iso} numerator is evaluated at the same depth \nocite{as what?} ($T$-level, which is the same as the $u$- and $v$-levels), so  the $in situ$ density can be used for its evaluation. 
+
+As the mixing is performed along neutral surfaces, the gradient of $\rho$ in 
+\eqref{Eq_ldfslp_iso} has to be evaluated at the same local pressure (which, 
+in decibars, is approximated by the depth in meters in the model). Therefore 
+\eqref{Eq_ldfslp_iso} cannot be used as such, but further transformation is 
+needed depending on the vertical coordinate used:
+
+\begin{description}
+
+\item[$z$-coordinate with full step : ] in \eqref{Eq_ldfslp_iso} the densities 
+appearing in the $i$ and $j$ derivatives  are taken at the same depth, thus 
+the $in situ$ density can be used. This is not the case for the vertical 
+derivatives: $\delta_{k+1/2}[\rho]$ is replaced by $-\rho N^2/g$, where $N^2$ 
+is the local Brunt-Vais\"{a}l\"{a} frequency evaluated following 
+\citet{McDougall1987} (see \S\ref{TRA_bn2}). 
+
+\item[$z$-coordinate with partial step : ] this case is identical to the full step 
+case except that at partial step level, the \emph{horizontal} density gradient 
+is evaluated as described in \S\ref{TRA_zpshde}.
+
+\item[$s$- or hybrid $s$-$z$- coordinate : ] in the current release of \NEMO, 
+iso-neutral mixing is only employed for $s$-coordinates if the
+Griffies scheme is used (\np{traldf\_grif}=true; see Appdx \ref{sec:triad}). 
+In other words, iso-neutral mixing will only be accurately represented with a 
+linear equation of state (\np{nn\_eos}=1 or 2). In the case of a "true" equation 
+of state, the evaluation of $i$ and $j$ derivatives in \eqref{Eq_ldfslp_iso} 
+will include a pressure dependent part, leading to the wrong evaluation of 
+the neutral slopes.
+
+%gm% 
+Note: The solution for $s$-coordinate passes trough the use of different 
+(and better) expression for the constraint on iso-neutral fluxes. Following 
+\citet{Griffies_Bk04}, instead of specifying directly that there is a zero neutral 
+diffusive flux of locally referenced potential density, we stay in the $T$-$S$ 
+plane and consider the balance between the neutral direction diffusive fluxes 
+of potential temperature and salinity:
+\begin{equation}
+\alpha \ \textbf{F}(T) = \beta \ \textbf{F}(S)
+\end{equation}
+%gm{  where vector F is ....}
+
+This constraint leads to the following definition for the slopes:
+
+\begin{equation} \label{Eq_ldfslp_iso2}
+\begin{split}
+ r_{1u} &= \frac{e_{3u}}{e_{1u}}\; \frac
+ 		{\alpha_u \;\delta_{i+1/2}[T] - \beta_u \;\delta_{i+1/2}[S]}
+		{\alpha_u \;\overline{\overline{\delta_{k+1/2}[T]}}^{\,i+1/2,\,k}
+		 -\beta_u  \;\overline{\overline{\delta_{k+1/2}[S]}}^{\,i+1/2,\,k} }
+\\
+ r_{2v} &= \frac{e_{3v}}{e_{2v}}\; \frac
+ 		{\alpha_v \;\delta_{j+1/2}[T] - \beta_v \;\delta_{j+1/2}[S]}
+		{\alpha_v \;\overline{\overline{\delta_{k+1/2}[T]}}^{\,j+1/2,\,k}
+		 -\beta_v  \;\overline{\overline{\delta_{k+1/2}[S]}}^{\,j+1/2,\,k} }
+\\
+ r_{1w} &= \frac{e_{3w}}{e_{1w}}\; \frac
+		{\alpha_w \;\overline{\overline{\delta_{i+1/2}[T]}}^{\,i,\,k+1/2}
+		 -\beta_w  \;\overline{\overline{\delta_{i+1/2}[S]}}^{\,i,\,k+1/2} }
+ 		{\alpha_w \;\delta_{k+1/2}[T] - \beta_w \;\delta_{k+1/2}[S]}
+\\
+ r_{2w} &= \frac{e_{3w}}{e_{2w}}\; \frac
+		{\alpha_w \;\overline{\overline{\delta_{j+1/2}[T]}}^{\,j,\,k+1/2}
+		 -\beta_w  \;\overline{\overline{\delta_{j+1/2}[S]}}^{\,j,\,k+1/2} }
+ 		{\alpha_w \;\delta_{k+1/2}[T] - \beta_w \;\delta_{k+1/2}[S]}
+\\
+\end{split}
+\end{equation}
+where $\alpha$ and $\beta$, the thermal expansion and saline contraction 
+coefficients introduced in \S\ref{TRA_bn2}, have to be evaluated at the three 
+velocity points. In order to save computation time, they should be approximated 
+by the mean of their values at $T$-points (for example in the case of $\alpha$:  
+$\alpha_u=\overline{\alpha_T}^{i+1/2}$,  $\alpha_v=\overline{\alpha_T}^{j+1/2}$ 
+and $\alpha_w=\overline{\alpha_T}^{k+1/2}$).
+
+Note that such a formulation could be also used in the $z$-coordinate and 
+$z$-coordinate with partial steps cases.
+
+\end{description}
+
+This implementation is a rather old one. It is similar to the one
+proposed by Cox [1987], except for the background horizontal
+diffusion. Indeed, the Cox implementation of isopycnal diffusion in
+GFDL-type models requires a minimum background horizontal diffusion
+for numerical stability reasons.  To overcome this problem, several
+techniques have been proposed in which the numerical schemes of the
+ocean model are modified \citep{Weaver_Eby_JPO97,
+  Griffies_al_JPO98}. Griffies's scheme is now available in \NEMO if
+\np{traldf\_grif\_iso} is set true; see Appdx \ref{sec:triad}. Here,
+another strategy is presented \citep{Lazar_PhD97}: a local
+filtering of the iso-neutral slopes (made on 9 grid-points) prevents
+the development of grid point noise generated by the iso-neutral
+diffusion operator (Fig.~\ref{Fig_LDF_ZDF1}). This allows an
+iso-neutral diffusion scheme without additional background horizontal
+mixing. This technique can be viewed as a diffusion operator that acts
+along large-scale (2~$\Delta$x) \gmcomment{2deltax doesnt seem very
+  large scale} iso-neutral surfaces. The diapycnal diffusion required
+for numerical stability is thus minimized and its net effect on the
+flow is quite small when compared to the effect of an horizontal
+background mixing.
+
+Nevertheless, this iso-neutral operator does not ensure that variance cannot increase, 
+contrary to the \citet{Griffies_al_JPO98} operator which has that property. 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]      \begin{center}
+\includegraphics[width=0.70\textwidth]{Fig_LDF_ZDF1}
+\caption {    \label{Fig_LDF_ZDF1}
+averaging procedure for isopycnal slope computation.}
+\end{center}    \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+%There are three additional questions about the slope calculation. 
+%First the expression for the rotation tensor has been obtain assuming the "small slope" approximation, so a bound has to be imposed on slopes. 
+%Second, numerical stability issues also require a bound on slopes. 
+%Third, the question of boundary condition specified on slopes...
+
+%from griffies: chapter 13.1....
+
+
+
+% In addition and also for numerical stability reasons \citep{Cox1987, Griffies_Bk04}, 
+% the slopes are bounded by $1/100$ everywhere. This limit is decreasing linearly 
+% to zero fom $70$ meters depth and the surface (the fact that the eddies "feel" the 
+% surface motivates this flattening of isopycnals near the surface).
+
+For numerical stability reasons \citep{Cox1987, Griffies_Bk04}, the slopes must also 
+be bounded by $1/100$ everywhere. This constraint is applied in a piecewise linear 
+fashion, increasing from zero at the surface to $1/100$ at $70$ metres and thereafter 
+decreasing to zero at the bottom of the ocean. (the fact that the eddies "feel" the 
+surface motivates this flattening of isopycnals near the surface).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]     \begin{center}
+\includegraphics[width=0.70\textwidth]{Fig_eiv_slp}
+\caption {     \label{Fig_eiv_slp}
+Vertical profile of the slope used for lateral mixing in the mixed layer : 
+\textit{(a)} in the real ocean the slope is the iso-neutral slope in the ocean interior, 
+which has to be adjusted at the surface boundary (i.e. it must tend to zero at the 
+surface since there is no mixing across the air-sea interface: wall boundary 
+condition). Nevertheless, the profile between the surface zero value and the interior 
+iso-neutral one is unknown, and especially the value at the base of the mixed layer ; 
+\textit{(b)} profile of slope using a linear tapering of the slope near the surface and 
+imposing a maximum slope of 1/100 ; \textit{(c)} profile of slope actually used in 
+\NEMO: a linear decrease of the slope from zero at the surface to its ocean interior 
+value computed just below the mixed layer. Note the huge change in the slope at the 
+base of the mixed layer between  \textit{(b)}  and \textit{(c)}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\colorbox{yellow}{add here a discussion about the flattening of the slopes, vs  tapering the coefficient.}
+
+\subsection{slopes for momentum iso-neutral mixing}
+
+The iso-neutral diffusion operator on momentum is the same as the one used on 
+tracers but applied to each component of the velocity separately (see 
+\eqref{Eq_dyn_ldf_iso} in section~\ref{DYN_ldf_iso}). The slopes between the 
+surface along which the diffusion operator acts and the surface of computation 
+($z$- or $s$-surfaces) are defined at $T$-, $f$-, and \textit{uw}- points for the 
+$u$-component, and $T$-, $f$- and \textit{vw}- points for the $v$-component. 
+They are computed from the slopes used for tracer diffusion, $i.e.$ 
+\eqref{Eq_ldfslp_geo} and \eqref{Eq_ldfslp_iso} :
+
+\begin{equation} \label{Eq_ldfslp_dyn}
+\begin{aligned}
+&r_{1t}\ \ = \overline{r_{1u}}^{\,i}       &&&    r_{1f}\ \ &= \overline{r_{1u}}^{\,i+1/2} \\
+&r_{2f} \ \ = \overline{r_{2v}}^{\,j+1/2} &&& 	r_{2t}\ &= \overline{r_{2v}}^{\,j} \\
+&r_{1uw}  = \overline{r_{1w}}^{\,i+1/2} &&\ \ \text{and} \ \ &   r_{1vw}&= \overline{r_{1w}}^{\,j+1/2} \\
+&r_{2uw}= \overline{r_{2w}}^{\,j+1/2} &&&         r_{2vw}&= \overline{r_{2w}}^{\,j+1/2}\\
+\end{aligned}
+\end{equation}
+
+The major issue remaining is in the specification of the boundary conditions. 
+The same boundary conditions are chosen as those used for lateral 
+diffusion along model level surfaces, i.e. using the shear computed along 
+the model levels and with no additional friction at the ocean bottom (see 
+\S\ref{LBC_coast}).
+
+
+% ================================================================
+% Lateral Mixing Operator
+% ================================================================
+\section [Lateral Mixing Operators (\textit{ldftra}, \textit{ldfdyn})] 
+		  {Lateral Mixing Operators (\mdl{traldf}, \mdl{traldf}) }
+\label{LDF_op}
+
+
+   
+% ================================================================
+% Lateral Mixing Coefficients
+% ================================================================
+\section [Lateral Mixing Coefficient (\textit{ldftra}, \textit{ldfdyn})] 
+		  {Lateral Mixing Coefficient (\mdl{ldftra}, \mdl{ldfdyn}) }
+\label{LDF_coef}
+
+Introducing a space variation in the lateral eddy mixing coefficients changes 
+the model core memory requirement, adding up to four extra three-dimensional 
+arrays for the geopotential or isopycnal second order operator applied to 
+momentum. Six CPP keys control the space variation of eddy coefficients: 
+three for momentum and three for tracer. The three choices allow: 
+a space variation in the three space directions (\key{traldf\_c3d},  \key{dynldf\_c3d}), 
+in the horizontal plane (\key{traldf\_c2d},  \key{dynldf\_c2d}), 
+or in the vertical only (\key{traldf\_c1d},  \key{dynldf\_c1d}). 
+The default option is a constant value over the whole ocean on both momentum and tracers. 
+   
+The number of additional arrays that have to be defined and the gridpoint 
+position at which they are defined depend on both the space variation chosen 
+and the type of operator used. The resulting eddy viscosity and diffusivity 
+coefficients can be a function of more than one variable. Changes in the 
+computer code when switching from one option to another have been 
+minimized by introducing the eddy coefficients as statement functions
+(include file \hf{ldftra\_substitute} and \hf{ldfdyn\_substitute}). The functions 
+are replaced by their actual meaning during the preprocessing step (CPP). 
+The specification of the space variation of the coefficient is made in 
+\mdl{ldftra} and \mdl{ldfdyn}, or more precisely in include files 
+\textit{traldf\_cNd.h90} and \textit{dynldf\_cNd.h90}, with N=1, 2 or 3. 
+The user can modify these include files as he/she wishes. The way the 
+mixing coefficient are set in the reference version can be briefly described 
+as follows:
+
+\subsubsection{Constant Mixing Coefficients (default option)}
+When none of the \textbf{key\_dynldf\_...} and \textbf{key\_traldf\_...} keys are 
+defined, a constant value is used over the whole ocean for momentum and 
+tracers, which is specified through the \np{rn\_ahm0} and \np{rn\_aht0} namelist 
+parameters.
+
+\subsubsection{Vertically varying Mixing Coefficients (\key{traldf\_c1d} and \key{dynldf\_c1d})} 
+The 1D option is only available when using the $z$-coordinate with full step. 
+Indeed in all the other types of vertical coordinate, the depth is a 3D function 
+of (\textbf{i},\textbf{j},\textbf{k}) and therefore, introducing depth-dependent 
+mixing coefficients will require 3D arrays. In the 1D option, a hyperbolic variation 
+of the lateral mixing coefficient is introduced in which the surface value is 
+\np{rn\_aht0} (\np{rn\_ahm0}), the bottom value is 1/4 of the surface value, 
+and the transition takes place around z=300~m with a width of 300~m 
+($i.e.$ both the depth and the width of the inflection point are set to 300~m). 
+This profile is hard coded in file \hf{traldf\_c1d}, but can be easily modified by users.
+
+\subsubsection{Horizontally Varying Mixing Coefficients (\key{traldf\_c2d} and \key{dynldf\_c2d})}
+By default the horizontal variation of the eddy coefficient depends on the local mesh 
+size and the type of operator used:
+\begin{equation} \label{Eq_title}
+  A_l = \left\{     
+   \begin{aligned}
+         & \frac{\max(e_1,e_2)}{e_{max}} A_o^l  			& \text{for laplacian operator } \\
+         & \frac{\max(e_1,e_2)^{3}}{e_{max}^{3}} A_o^l          & \text{for bilaplacian operator } 
+   \end{aligned}    \right.
+\end{equation}
+where $e_{max}$ is the maximum of $e_1$ and $e_2$ taken over the whole masked 
+ocean domain, and $A_o^l$ is the \np{rn\_ahm0} (momentum) or \np{rn\_aht0} (tracer) 
+namelist parameter. This variation is intended to reflect the lesser need for subgrid 
+scale eddy mixing where the grid size is smaller in the domain. It was introduced in 
+the context of the DYNAMO modelling project \citep{Willebrand_al_PO01}. 
+Note that such a grid scale dependance of mixing coefficients significantly increase 
+the range of stability of model configurations presenting large changes in grid pacing 
+such as global ocean models. Indeed, in such a case, a constant mixing coefficient 
+can lead to a blow up of the model due to large coefficient compare to the smallest 
+grid size (see \S\ref{STP_forward_imp}), especially when using a bilaplacian operator.
+
+Other formulations can be introduced by the user for a given configuration. 
+For example, in the ORCA2 global ocean model (see Configurations), the laplacian 
+viscosity operator uses \np{rn\_ahm0}~= 4.10$^4$ m$^2$/s poleward of 20$^{\circ}$ 
+north and south and decreases linearly to \np{rn\_aht0}~= 2.10$^3$ m$^2$/s 
+at the equator \citep{Madec_al_JPO96, Delecluse_Madec_Bk00}. This modification 
+can be found in routine \rou{ldf\_dyn\_c2d\_orca} defined in \mdl{ldfdyn\_c2d}. 
+Similar modified horizontal variations can be found with the Antarctic or Arctic 
+sub-domain options of ORCA2 and ORCA05 (see \&namcfg namelist).
+
+\subsubsection{Space Varying Mixing Coefficients (\key{traldf\_c3d} and \key{dynldf\_c3d})}
+
+The 3D space variation of the mixing coefficient is simply the combination of the 
+1D and 2D cases, $i.e.$ a hyperbolic tangent variation with depth associated with 
+a grid size dependence of the magnitude of the coefficient. 
+
+\subsubsection{Space and Time Varying Mixing Coefficients}
+
+There is no default specification of space and time varying mixing coefficient. 
+The only case available is specific to the ORCA2 and ORCA05 global ocean 
+configurations. It provides only a tracer 
+mixing coefficient for eddy induced velocity (ORCA2) or both iso-neutral and 
+eddy induced velocity (ORCA05) that depends on the local growth rate of 
+baroclinic instability. This specification is actually used when an ORCA key 
+and both \key{traldf\_eiv} and \key{traldf\_c2d} are defined.
+
+$\ $\newline    % force a new ligne
+
+The following points are relevant when the eddy coefficient varies spatially:
+
+(1) the momentum diffusion operator acting along model level surfaces is 
+written in terms of curl and divergent components of the horizontal current 
+(see \S\ref{PE_ldf}). Although the eddy coefficient could be set to different values 
+in these two terms, this option is not currently available. 
+
+(2) with an horizontally varying viscosity, the quadratic integral constraints 
+on enstrophy and on the square of the horizontal divergence for operators 
+acting along model-surfaces are no longer satisfied 
+(Appendix~\ref{Apdx_dynldf_properties}).
+
+(3) for isopycnal diffusion on momentum or tracers, an additional purely 
+horizontal background diffusion with uniform coefficient can be added by 
+setting a non zero value of \np{rn\_ahmb0} or \np{rn\_ahtb0}, a background horizontal 
+eddy viscosity or diffusivity coefficient (namelist parameters whose default 
+values are $0$). However, the technique used to compute the isopycnal 
+slopes is intended to get rid of such a background diffusion, since it introduces 
+spurious diapycnal diffusion (see \S\ref{LDF_slp}).
+
+(4) when an eddy induced advection term is used (\key{traldf\_eiv}), $A^{eiv}$, 
+the eddy induced coefficient has to be defined. Its space variations are controlled 
+by the same CPP variable as for the eddy diffusivity coefficient ($i.e.$ 
+\textbf{key\_traldf\_cNd}). 
+
+(5) the eddy coefficient associated with a biharmonic operator must be set to a \emph{negative} value.
+
+(6) it is possible to use both the laplacian and biharmonic operators concurrently.
+
+(7) it is possible to run without explicit lateral diffusion on momentum (\np{ln\_dynldf\_lap} = 
+\np{ln\_dynldf\_bilap} = false). This is recommended when using the UBS advection 
+scheme on momentum (\np{ln\_dynadv\_ubs} = true, see \ref{DYN_adv_ubs}) 
+and can be useful for testing purposes.
+
+% ================================================================
+% Eddy Induced Mixing
+% ================================================================
+\section  [Eddy Induced Velocity (\textit{traadv\_eiv}, \textit{ldfeiv})]
+		{Eddy Induced Velocity (\mdl{traadv\_eiv}, \mdl{ldfeiv})}
+\label{LDF_eiv}
+
+%%gm  from Triad appendix  : to be incorporated....
+\gmcomment{
+Values of iso-neutral diffusivity and GM coefficient are set as
+described in \S\ref{LDF_coef}. If none of the keys \key{traldf\_cNd},
+N=1,2,3 is set (the default), spatially constant iso-neutral $A_l$ and
+GM diffusivity $A_e$ are directly set by \np{rn\_aeih\_0} and
+\np{rn\_aeiv\_0}. If 2D-varying coefficients are set with
+\key{traldf\_c2d} then $A_l$ is reduced in proportion with horizontal
+scale factor according to \eqref{Eq_title} \footnote{Except in global ORCA
+  $0.5^{\circ}$ runs with \key{traldf\_eiv}, where
+  $A_l$ is set like $A_e$ but with a minimum vale of
+  $100\;\mathrm{m}^2\;\mathrm{s}^{-1}$}. In idealised setups with
+\key{traldf\_c2d}, $A_e$ is reduced similarly, but if \key{traldf\_eiv}
+is set in the global configurations with \key{traldf\_c2d}, a horizontally varying $A_e$ is
+instead set from the Held-Larichev parameterisation\footnote{In this
+  case, $A_e$ at low latitudes $|\theta|<20^{\circ}$ is further
+  reduced by a factor $|f/f_{20}|$, where $f_{20}$ is the value of $f$
+  at $20^{\circ}$~N} (\mdl{ldfeiv}) and \np{rn\_aeiv\_0} is ignored
+unless it is zero.
+}
+
+When Gent and McWilliams [1990] diffusion is used (\key{traldf\_eiv} defined), 
+an eddy induced tracer advection term is added, the formulation of which 
+depends on the slopes of iso-neutral surfaces. Contrary to the case of iso-neutral 
+mixing, the slopes used here are referenced to the geopotential surfaces, $i.e.$ 
+\eqref{Eq_ldfslp_geo} is used in $z$-coordinates, and the sum \eqref{Eq_ldfslp_geo}  
++ \eqref{Eq_ldfslp_iso} in $s$-coordinates. The eddy induced velocity is given by: 
+\begin{equation} \label{Eq_ldfeiv}
+\begin{split}
+ u^* & = \frac{1}{e_{2u}e_{3u}}\; \delta_k \left[e_{2u} \, A_{uw}^{eiv} \; \overline{r_{1w}}^{\,i+1/2} \right]\\
+v^* & = \frac{1}{e_{1u}e_{3v}}\; \delta_k \left[e_{1v} \, A_{vw}^{eiv} \; \overline{r_{2w}}^{\,j+1/2} \right]\\
+w^* & = \frac{1}{e_{1w}e_{2w}}\; \left\{ \delta_i \left[e_{2u} \, A_{uw}^{eiv} \; \overline{r_{1w}}^{\,i+1/2} \right] + \delta_j \left[e_{1v} \, A_{vw}^{eiv} \; \overline{r_{2w}}^{\,j+1/2} \right] \right\} \\
+\end{split}
+\end{equation}
+where $A^{eiv}$ is the eddy induced velocity coefficient whose value is set 
+through \np{rn\_aeiv}, a \textit{nam\_traldf} namelist parameter. 
+The three components of the eddy induced velocity are computed and add 
+to the eulerian velocity in \mdl{traadv\_eiv}. This has been preferred to a 
+separate computation of the advective trends associated with the eiv velocity, 
+since it allows us to take advantage of all the advection schemes offered for 
+the tracers (see \S\ref{TRA_adv}) and not just the $2^{nd}$ order advection 
+scheme as in previous releases of OPA \citep{Madec1998}. This is particularly 
+useful for passive tracers where \emph{positivity} of the advection scheme is 
+of paramount importance. 
+
+At the surface, lateral and bottom boundaries, the eddy induced velocity, 
+and thus the advective eddy fluxes of heat and salt, are set to zero. 
+
+
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_MISC.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_MISC.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_MISC.tex	(revision 8732)
@@ -0,0 +1,326 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter ——— Miscellaneous Topics
+% ================================================================
+\chapter{Miscellaneous Topics}
+\label{MISC}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Representation of Unresolved Straits
+% ================================================================
+\section{Representation of Unresolved Straits}
+\label{MISC_strait}
+
+In climate modeling, it often occurs that a crucial connections between water masses
+is broken as the grid mesh is too coarse to resolve narrow straits. For example, coarse 
+grid spacing typically closes off the Mediterranean from the Atlantic at the Strait of 
+Gibraltar. In this case, it is important for climate models to include the effects of salty 
+water entering the Atlantic from the Mediterranean. Likewise, it is important for the 
+Mediterranean to replenish its supply of water from the Atlantic to balance the net 
+evaporation occurring over the Mediterranean region. This problem occurs even in 
+eddy permitting simulations. For example, in ORCA 1/4\deg several straits of the Indonesian 
+archipelago (Ombai, Lombok...) are much narrow than even a single ocean grid-point.
+
+We describe briefly here the three methods that can be used in \NEMO to handle 
+such improperly resolved straits. The first two consist of opening the strait by hand 
+while ensuring that the mass exchanges through the strait are not too large by 
+either artificially reducing the surface of the strait grid-cells or, locally increasing 
+the lateral friction. In the third one, the strait is closed but exchanges of mass, 
+heat and salt across the land are allowed.
+Note that such modifications are so specific to a given configuration that no attempt 
+has been made to set them in a generic way. However, examples of how 
+they can be set up is given in the ORCA 2\deg and 0.5\deg configurations. For example, 
+for details of implementation in ORCA2, search: 
+\texttt{ IF( cp\_cfg == "orca" .AND. jp\_cfg == 2 ) }
+
+% -------------------------------------------------------------------------------------------------------------
+%       Hand made geometry changes
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Hand made geometry changes}
+\label{MISC_strait_hand}
+
+$\bullet$ reduced scale factor in the cross-strait direction to a value in better agreement 
+with the true mean width of the strait. (Fig.~\ref{Fig_MISC_strait_hand}).
+This technique is sometime called "partially open face" or "partially closed cells".
+The key issue here is only to reduce the faces of $T$-cell ($i.e.$ change the value 
+of the horizontal scale factors at $u$- or $v$-point) but not the volume of the $T$-cell.
+Indeed, reducing the volume of strait $T$-cell can easily produce a numerical 
+instability at that grid point that would require a reduction of the model time step.
+The changes associated with strait management are done in \mdl{domhgr}, 
+just after the definition or reading of the horizontal scale factors. 
+
+$\bullet$ increase of the viscous boundary layer thickness by local increase of the 
+fmask value at the coast (Fig.~\ref{Fig_MISC_strait_hand}). This is done in 
+\mdl{dommsk} together with the setting of the coastal value of fmask 
+(see Section \ref{LBC_coast})
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tbp] 	 \begin{center}
+\includegraphics[width=0.80\textwidth]{Fig_Gibraltar}
+\includegraphics[width=0.80\textwidth]{Fig_Gibraltar2}
+\caption{	\label{Fig_MISC_strait_hand} 
+Example of the Gibraltar strait defined in a $1^{\circ} \times 1^{\circ}$ mesh. 
+\textit{Top}: using partially open cells. The meridional scale factor at $v$-point 
+is reduced on both sides of the strait to account for the real width of the strait 
+(about 20 km). Note that the scale factors of the strait $T$-point remains unchanged. 
+\textit{Bottom}: using viscous boundary layers. The four fmask parameters 
+along the strait coastlines are set to a value larger than 4, $i.e.$ "strong" no-slip 
+case (see Fig.\ref{Fig_LBC_shlat}) creating a large viscous boundary layer 
+that allows a reduced transport through the strait.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% ================================================================
+% Closed seas
+% ================================================================
+\section{Closed seas (\mdl{closea})}
+\label{MISC_closea}
+
+\colorbox{yellow}{Add here a short description of the way closed seas are managed}
+
+
+% ================================================================
+% Sub-Domain Functionality (\textit{nizoom, njzoom}, namelist parameters)
+% ================================================================
+\section{Sub-Domain Functionality (\np{jpizoom}, \np{jpjzoom})}
+\label{MISC_zoom}
+
+The sub-domain functionality, also improperly called the zoom option 
+(improperly because it is not associated with a change in model resolution) 
+is a quite simple function that allows a simulation over a sub-domain of an 
+already defined configuration ($i.e.$ without defining a new mesh, initial 
+state and forcings). This option can be useful for testing the user settings 
+of surface boundary conditions, or the initial ocean state of a huge ocean 
+model configuration while having a small computer memory requirement. 
+It can also be used to easily test specific physics in a sub-domain (for example, 
+see \citep{Madec_al_JPO96} for a test of the coupling used in the global ocean 
+version of OPA between sea-ice and ocean model over the Arctic or Antarctic 
+ocean, using a sub-domain). In the standard model, this option does not 
+include any specific treatment for the ocean boundaries of the sub-domain: 
+they are considered as artificial vertical walls. Nevertheless, it is quite easy 
+to add a restoring term toward a climatology in the vicinity of such boundaries 
+(see \S\ref{TRA_dmp}).
+
+In order to easily define a sub-domain over which the computation can be 
+performed, the dimension of all input arrays (ocean mesh, bathymetry, 
+forcing, initial state, ...) are defined as \np{jpidta}, \np{jpjdta} and \np{jpkdta} 
+( in \ngn{namcfg} namelist), while the computational domain is defined through 
+\np{jpiglo}, \np{jpjglo} and \jp{jpk} (\ngn{namcfg} namelist). When running the 
+model over the whole domain, the user sets \np{jpiglo}=\np{jpidta} \np{jpjglo}=\np{jpjdta} 
+and \jp{jpk}=\jp{jpkdta}. When running the model over a sub-domain, the user 
+has to provide the size of the sub-domain, (\np{jpiglo}, \np{jpjglo}, \np{jpkglo}), 
+and the indices of the south western corner as \np{jpizoom} and \np{jpjzoom} in 
+the  \ngn{namcfg} namelist (Fig.~\ref{Fig_LBC_zoom}). 
+
+Note that a third set of dimensions exist, \jp{jpi}, \jp{jpj} and \jp{jpk} which is 
+actually used to perform the computation. It is set by default to \jp{jpi}=\np{jpjglo} 
+and \jp{jpj}=\np{jpjglo}, except for massively parallel computing where the 
+computational domain is laid out on local processor memories following a 2D 
+horizontal splitting. % (see {\S}IV.2-c) ref to the section to be updated
+
+\subsection{Simple subsetting of input files via netCDF attributes}
+
+The extended grids for use with the under-shelf ice cavities will result in redundant rows
+around Antarctica if the ice cavities are not active. A simple mechanism for subsetting
+input files associated with the extended domains has been implemented to avoid the need to
+maintain different sets of input fields for use with or without active ice cavities. The
+existing 'zoom' options are overly complex for this task and marked for deletion anyway.
+This alternative subsetting operates for the j-direction only and works by optionally
+looking for and using a global file attribute (named: \np{open\_ocean\_jstart}) to
+determine the starting j-row for input. The use of this option is best explained with an
+example: Consider an ORCA1 configuration using the extended grid bathymetry and coordinate
+files:
+\vspace{-10pt}
+\begin{alltt}
+\tiny
+\begin{verbatim}
+eORCA1_bathymetry_v2.nc
+eORCA1_coordinates.nc
+\end{verbatim}
+\end{alltt}
+\noindent These files define a horizontal domain of 362x332. Assuming the first row with
+open ocean wet points in the non-isf bathymetry for this set is row 42 (Fortran indexing)
+then the formally correct setting for \np{open\_ocean\_jstart} is 41. Using this value as the
+first row to be read will result in a 362x292 domain which is the same size as the original
+ORCA1 domain. Thus the extended coordinates and bathymetry files can be used with all the
+original input files for ORCA1 if the ice cavities are not active (\np{ln\_isfcav =
+.false.}). Full instructions for achieving this are:
+
+\noindent Add the new attribute to any input files requiring a j-row offset, i.e:
+\vspace{-10pt}
+\begin{alltt}
+\tiny
+\begin{verbatim}
+ncatted  -a open_ocean_jstart,global,a,d,41 eORCA1_coordinates.nc 
+ncatted  -a open_ocean_jstart,global,a,d,41 eORCA1_bathymetry_v2.nc
+\end{verbatim}
+\end{alltt}
+ 
+\noindent Add the logical switch to \ngn{namcfg} in the configuration namelist and set true:
+%--------------------------------------------namcfg--------------------------------------------------------
+\namdisplay{namcfg_orca1}
+%--------------------------------------------------------------------------------------------------------------
+
+\noindent Note the j-size of the global domain is the (extended j-size minus
+\np{open\_ocean\_jstart} + 1 ) and this must match the size of all datasets other than
+bathymetry and coordinates currently. However the option can be extended to any global, 2D
+and 3D, netcdf, input field by adding the:
+\vspace{-10pt}
+\begin{alltt}
+\tiny
+\begin{verbatim}
+lrowattr=ln_use_jattr
+\end{verbatim}
+\end{alltt}
+optional argument to the appropriate \np{iom\_get} call and the \np{open\_ocean\_jstart} attribute to the corresponding input files. It remains the users responsibility to set \np{jpjdta} and \np{jpjglo} values in the \np{namelist\_cfg} file according to their needs.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht] 	  \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_LBC_zoom}
+\caption{	\label{Fig_LBC_zoom}
+Position of a model domain compared to the data input domain when the zoom functionality is used.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% ================================================================
+% Accuracy and Reproducibility
+% ================================================================
+\section{Accuracy and Reproducibility (\mdl{lib\_fortran})}
+\label{MISC_fortran}
+
+\subsection{Issues with intrinsinc SIGN function (\key{nosignedzero})}
+\label{MISC_sign}
+
+The SIGN(A, B) is the \textsc {Fortran} intrinsic function delivers the magnitude 
+of A with the sign of B. For example, SIGN(-3.0,2.0) has the value 3.0.
+The problematic case is when the second argument is zero, because, on platforms 
+that support IEEE arithmetic, zero is actually a signed number. 
+There is a positive zero and a negative zero.
+
+In \textsc{Fortran}~90, the processor was required always to deliver a positive result for SIGN(A, B) 
+if B was zero. Nevertheless, in \textsc{Fortran}~95, the processor is allowed to do the correct thing 
+and deliver ABS(A) when B is a positive zero and -ABS(A) when B is a negative zero. 
+This change in the specification becomes apparent only when B is of type real, and is zero, 
+and the processor is capable of distinguishing between positive and negative zero, 
+and B is negative real zero. Then SIGN delivers a negative result where, under \textsc{Fortran}~90 
+rules,  it used to return a positive result. 
+This change may be especially sensitive for the ice model, so we overwrite the intrinsinc 
+function with our own function simply performing :   \\
+\verb?   IF( B >= 0.e0 ) THEN   ;   SIGN(A,B) = ABS(A)  ?    \\
+\verb?   ELSE                   ;   SIGN(A,B) =-ABS(A)     ?  \\
+\verb?   ENDIF    ? \\
+This feature can be found in \mdl{lib\_fortran} module and is effective when \key{nosignedzero}
+is defined. We use a CPP key as the overwritting of a intrinsic function can present 
+performance issues with some computers/compilers.
+
+
+\subsection{MPP reproducibility}
+\label{MISC_glosum}
+
+The numerical reproducibility of simulations on distributed memory parallel computers 
+is a critical issue. In particular, within NEMO global summation of distributed arrays 
+is most susceptible to rounding errors, and their propagation and accumulation cause 
+uncertainty in final simulation reproducibility on different numbers of processors.
+To avoid so, based on \citet{He_Ding_JSC01} review of different technics, 
+we use a so called self-compensated summation method. The idea is to estimate 
+the roundoff error, store it in a buffer, and then add it back in the next addition. 
+
+Suppose we need to calculate $b = a_1 + a_2 + a_3$. The following algorithm 
+will allow to split the sum in two ($sum_1 = a_{1} + a_{2}$ and $b = sum_2 = sum_1 + a_3$) 
+with exactly the same rounding errors as the sum performed all at once.
+\begin{align*}
+	sum_1 \ \  &= a_1 + a_2 \\
+	error_1     &= a_2 + ( a_1 - sum_1 ) \\
+	sum_2 \ \  &= sum_1 + a_3 + error_1 \\
+	error_2     &= a_3 + error_1 + ( sum_1 - sum_2 ) \\
+	b \qquad \ &= sum_2 \\
+\end{align*}
+An example of this feature can be found in \mdl{lib\_fortran} module.
+It is systematicallt used in glob\_sum function (summation over the entire basin excluding 
+duplicated rows and columns due to cyclic or north fold boundary condition as well as 
+overlap MPP areas). The self-compensated summation method should be used in all summation
+in i- and/or j-direction. See closea.F90 module for an example.
+Note also that this implementation may be sensitive to the optimization level. 
+
+\subsection{MPP scalability}
+\label{MISC_mppsca}
+
+The default method of communicating values across the north-fold in distributed memory applications
+(\key{mpp\_mpi}) uses a \textsc{MPI\_ALLGATHER} function to exchange values from each processing
+region in the northern row with every other processing region in the northern row. This enables a
+global width array containing the top 4 rows to be collated on every northern row processor and then
+folded with a simple algorithm. Although conceptually simple, this "All to All" communication will
+hamper performance scalability for large numbers of northern row processors. From version 3.4
+onwards an alternative method is available which only performs direct "Peer to Peer" communications
+between each processor and its immediate "neighbours" across the fold line. This is achieved by
+using the default \textsc{MPI\_ALLGATHER} method during initialisation to help identify the "active"
+neighbours. Stored lists of these neighbours are then used in all subsequent north-fold exchanges to
+restrict exchanges to those between associated regions. The collated global width array for each
+region is thus only partially filled but is guaranteed to be set at all the locations actually
+required by each individual for the fold operation. This alternative method should give identical
+results to the default \textsc{ALLGATHER} method and is recommended for large values of \np{jpni}.
+The new method is activated by setting \np{ln\_nnogather} to be true ({\bf nammpp}). The
+reproducibility of results using the two methods should be confirmed for each new, non-reference
+configuration.
+
+% ================================================================
+% Model optimisation, Control Print and Benchmark
+% ================================================================
+\section{Model Optimisation, Control Print and Benchmark}
+\label{MISC_opt}
+%--------------------------------------------namctl-------------------------------------------------------
+\namdisplay{namctl} 
+%--------------------------------------------------------------------------------------------------------------
+
+ \gmcomment{why not make these bullets into subsections?}
+Options are defined through the  \ngn{namctl} namelist variables.
+
+$\bullet$ Vector optimisation:
+
+\key{vectopt\_loop} enables the internal loops to collapse. This is very 
+a very efficient way to increase the length of vector calculations and thus 
+to speed up the model on vector computers.
+ 
+% Add here also one word on NPROMA technique that has been found useless, since compiler have made significant progress during the last decade.
+ 
+% Add also one word on NEC specific optimisation (Novercheck option for example)
+ 
+$\bullet$ Control print %: describe here 4 things:
+
+1- \np{ln\_ctl} : compute and print the trends averaged over the interior domain 
+in all TRA, DYN, LDF and ZDF modules. This option is very helpful when 
+diagnosing the origin of an undesired change in model results. 
+
+2- also \np{ln\_ctl} but using the nictl and njctl namelist parameters to check 
+the source of differences between mono and multi processor runs.
+
+%%gm   to be removed both here and in the code
+3- last digit comparison (\np{nn\_bit\_cmp}). In an MPP simulation, the computation of 
+a sum over the whole domain is performed as the summation over all processors of 
+each of their sums over their interior domains. This double sum never gives exactly 
+the same result as a single sum over the whole domain, due to truncation differences. 
+The "bit comparison" option has been introduced in order to be able to check that 
+mono-processor and multi-processor runs give exactly the same results. 
+%THIS is to be updated with the mpp_sum_glo  introduced in v3.3
+% nn_bit_cmp  today only check that the nn_cla = 0 (no cross land advection)
+%%gm end
+
+$\bullet$  Benchmark (\np{nn\_bench}). This option defines a benchmark run based on 
+a GYRE configuration (see \S\ref{CFG_gyre}) in which the resolution remains the same 
+whatever the domain size. This allows a very large model domain to be used, just by 
+changing the domain size (\jp{jpiglo}, \jp{jpjglo}) and without adjusting either the time-step 
+or the physical parameterisations. 
+
+% ================================================================
+\end{document}
+
+
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Model_Basics.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 8732)
@@ -0,0 +1,1252 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter 1 Ñ Model Basics
+% ================================================================
+
+\chapter{Model basics}
+\label{PE}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Primitive Equations
+% ================================================================
+\section{Primitive Equations}
+\label{PE_PE}
+
+% -------------------------------------------------------------------------------------------------------------
+%        Vector Invariant Formulation 
+% -------------------------------------------------------------------------------------------------------------
+
+\subsection{Vector Invariant Formulation}
+\label{PE_Vector}
+
+
+The ocean is a fluid that can be described to a good approximation by the primitive 
+equations, $i.e.$ the Navier-Stokes equations along with a nonlinear equation of 
+state which couples the two active tracers (temperature and salinity) to the fluid 
+velocity, plus the following additional assumptions made from scale considerations:
+
+\textit{(1) spherical earth approximation: }the geopotential surfaces are assumed to 
+be spheres so that gravity (local vertical) is parallel to the earth's radius
+
+\textit{(2) thin-shell approximation: }the ocean depth is neglected compared to the earth's radius
+
+\textit{(3) turbulent closure hypothesis: }the turbulent fluxes (which represent the effect 
+of small scale processes on the large-scale) are expressed in terms of large-scale features
+
+\textit{(4) Boussinesq hypothesis:} density variations are neglected except in their 
+contribution to the buoyancy force
+
+\textit{(5) Hydrostatic hypothesis: }the vertical momentum equation is reduced to a 
+balance between the vertical pressure gradient and the buoyancy force (this removes 
+convective processes from the initial Navier-Stokes equations and so convective processes 
+must be parameterized instead)
+
+\textit{(6) Incompressibility hypothesis: }the three dimensional divergence of the velocity 
+vector is assumed to be zero.
+
+Because the gravitational force is so dominant in the equations of large-scale motions, 
+it is useful to choose an orthogonal set of unit vectors (\textbf{i},\textbf{j},\textbf{k}) linked 
+to the earth such that \textbf{k} is the local upward vector and (\textbf{i},\textbf{j}) are two 
+vectors orthogonal to \textbf{k}, $i.e.$ tangent to the geopotential surfaces. Let us define 
+the following variables: \textbf{U} the vector velocity, $\textbf{U}=\textbf{U}_h + w\, \textbf{k}$ 
+(the subscript $h$ denotes the local horizontal vector, $i.e.$ over the (\textbf{i},\textbf{j}) plane), 
+$T$ the potential temperature, $S$ the salinity, \textit{$\rho $} the \textit{in situ} density. 
+The vector invariant form of the primitive equations in the (\textbf{i},\textbf{j},\textbf{k}) 
+vector system provides the following six equations (namely the momentum balance, the 
+hydrostatic equilibrium, the incompressibility equation, the heat and salt conservation 
+equations and an equation of state):
+\begin{subequations} \label{Eq_PE}
+  \begin{equation}     \label{Eq_PE_dyn}
+\frac{\partial {\rm {\bf U}}_h }{\partial t}=
+-\left[    {\left( {\nabla \times {\rm {\bf U}}} \right)\times {\rm {\bf U}}
+            +\frac{1}{2}\nabla \left( {{\rm {\bf U}}^2} \right)}    \right]_h
+ -f\;{\rm {\bf k}}\times {\rm {\bf U}}_h 
+-\frac{1}{\rho _o }\nabla _h p + {\rm {\bf D}}^{\rm {\bf U}} + {\rm {\bf F}}^{\rm {\bf U}}
+  \end{equation}
+  \begin{equation}     \label{Eq_PE_hydrostatic}
+\frac{\partial p }{\partial z} = - \rho \ g
+  \end{equation}
+  \begin{equation}     \label{Eq_PE_continuity}
+\nabla \cdot {\bf U}=  0
+  \end{equation}
+\begin{equation} \label{Eq_PE_tra_T}
+\frac{\partial T}{\partial t} = - \nabla \cdot  \left( T \ \rm{\bf U} \right) + D^T + F^T
+  \end{equation}
+  \begin{equation}     \label{Eq_PE_tra_S}
+\frac{\partial S}{\partial t} = - \nabla \cdot  \left( S \ \rm{\bf U} \right) + D^S + F^S
+  \end{equation}
+  \begin{equation}     \label{Eq_PE_eos}
+\rho = \rho \left( T,S,p \right)
+  \end{equation}
+\end{subequations}
+where $\nabla$ is the generalised derivative vector operator in $(\bf i,\bf j, \bf k)$ directions, 
+$t$ is the time, $z$ is the vertical coordinate, $\rho $ is the \textit{in situ} density given by 
+the equation of state (\ref{Eq_PE_eos}), $\rho_o$ is a reference density, $p$ the pressure, 
+$f=2 \bf \Omega \cdot \bf k$ is the Coriolis acceleration (where $\bf \Omega$ is the Earth's 
+angular velocity vector), and $g$ is the gravitational acceleration. 
+${\rm {\bf D}}^{\rm {\bf U}}$, $D^T$ and $D^S$ are the parameterisations of small-scale 
+physics for momentum, temperature and salinity, and ${\rm {\bf F}}^{\rm {\bf U}}$, $F^T$ 
+and $F^S$ surface forcing terms. Their nature and formulation are discussed in 
+\S\ref{PE_zdf_ldf} and page \S\ref{PE_boundary_condition}.
+
+.
+
+% -------------------------------------------------------------------------------------------------------------
+% Boundary condition
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Boundary Conditions}
+\label{PE_boundary_condition}
+
+An ocean is bounded by complex coastlines, bottom topography at its base and an air-sea 
+or ice-sea interface at its top. These boundaries can be defined by two surfaces, $z=-H(i,j)$ 
+and $z=\eta(i,j,k,t)$, where $H$ is the depth of the ocean bottom and $\eta$ is the height 
+of the sea surface. Both $H$ and $\eta$ are usually referenced to a given surface, $z=0$, 
+chosen as a mean sea surface (Fig.~\ref{Fig_ocean_bc}). Through these two boundaries, 
+the ocean can exchange fluxes of heat, fresh water, salt, and momentum with the solid earth, 
+the continental margins, the sea ice and the atmosphere. However, some of these fluxes are 
+so weak that even on climatic time scales of thousands of years they can be neglected. 
+In the following, we briefly review the fluxes exchanged at the interfaces between the ocean 
+and the other components of the earth system.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]	 \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_I_ocean_bc}
+\caption{	 \label{Fig_ocean_bc} 
+The ocean is bounded by two surfaces, $z=-H(i,j)$ and $z=\eta(i,j,t)$, where $H$ 
+is the depth of the sea floor and $\eta$ the height of the sea surface. 
+Both $H$ and $\eta$ are referenced to $z=0$.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+\begin{description}
+\item[Land - ocean interface:] the major flux between continental margins and the ocean is 
+a mass exchange of fresh water through river runoff. Such an exchange modifies the sea 
+surface salinity especially in the vicinity of major river mouths. It can be neglected for short 
+range integrations but has to be taken into account for long term integrations as it influences 
+the characteristics of water masses formed (especially at high latitudes). It is required in order 
+to close the water cycle of the climate system. It is usually specified as a fresh water flux at 
+the air-sea interface in the vicinity of river mouths.
+\item[Solid earth - ocean interface:] heat and salt fluxes through the sea floor are small, 
+except in special areas of little extent. They are usually neglected in the model 
+\footnote{In fact, it has been shown that the heat flux associated with the solid Earth cooling 
+($i.e.$the geothermal heating) is not negligible for the thermohaline circulation of the world 
+ocean (see \ref{TRA_bbc}).}. 
+The boundary condition is thus set to no flux of heat and salt across solid boundaries. 
+For momentum, the situation is different. There is no flow across solid boundaries, 
+$i.e.$ the velocity normal to the ocean bottom and coastlines is zero (in other words, 
+the bottom velocity is parallel to solid boundaries). This kinematic boundary condition 
+can be expressed as:
+\begin{equation} \label{Eq_PE_w_bbc}
+w = -{\rm {\bf U}}_h \cdot  \nabla _h \left( H \right)
+\end{equation}
+In addition, the ocean exchanges momentum with the earth through frictional processes. 
+Such momentum transfer occurs at small scales in a boundary layer. It must be parameterized 
+in terms of turbulent fluxes using bottom and/or lateral boundary conditions. Its specification 
+depends on the nature of the physical parameterisation used for ${\rm {\bf D}}^{\rm {\bf U}}$ 
+in \eqref{Eq_PE_dyn}. It is discussed in \S\ref{PE_zdf}, page~\pageref{PE_zdf}.% and Chap. III.6 to 9.
+\item[Atmosphere - ocean interface:] the kinematic surface condition plus the mass flux 
+of fresh water PE  (the precipitation minus evaporation budget) leads to: 
+\begin{equation} \label{Eq_PE_w_sbc}
+w = \frac{\partial \eta }{\partial t} 
+    + \left. {{\rm {\bf U}}_h } \right|_{z=\eta } \cdot  \nabla _h \left( \eta \right) 
+    + P-E
+\end{equation}
+The dynamic boundary condition, neglecting the surface tension (which removes capillary 
+waves from the system) leads to the continuity of pressure across the interface $z=\eta$. 
+The atmosphere and ocean also exchange horizontal momentum (wind stress), and heat.
+\item[Sea ice - ocean interface:] the ocean and sea ice exchange heat, salt, fresh water 
+and momentum. The sea surface temperature is constrained to be at the freezing point 
+at the interface. Sea ice salinity is very low ($\sim4-6 \,psu$) compared to those of the 
+ocean ($\sim34 \,psu$). The cycle of freezing/melting is associated with fresh water and 
+salt fluxes that cannot be neglected.
+\end{description}
+
+
+%\newpage
+%$\ $\newline    % force a new ligne
+
+% ================================================================
+% The Horizontal Pressure Gradient
+% ================================================================
+\section{The Horizontal Pressure Gradient }
+\label{PE_hor_pg}
+
+% -------------------------------------------------------------------------------------------------------------
+% Pressure Formulation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Pressure Formulation}
+\label{PE_p_formulation}
+
+The total pressure at a given depth $z$ is composed of a surface pressure $p_s$ at a 
+reference geopotential surface ($z=0$) and a hydrostatic pressure $p_h$ such that: 
+$p(i,j,k,t)=p_s(i,j,t)+p_h(i,j,k,t)$. The latter is computed by integrating (\ref{Eq_PE_hydrostatic}), 
+assuming that pressure in decibars can be approximated by depth in meters in (\ref{Eq_PE_eos}). 
+The hydrostatic pressure is then given by:
+\begin{equation} \label{Eq_PE_pressure}
+p_h \left( {i,j,z,t} \right)
+ = \int_{\varsigma =z}^{\varsigma =0} {g\;\rho \left( {T,S,\varsigma} \right)\;d\varsigma } 
+\end{equation}
+ Two strategies can be considered for the surface pressure term: $(a)$ introduce of a 
+ new variable $\eta$, the free-surface elevation, for which a prognostic equation can be 
+ established and solved; $(b)$ assume that the ocean surface is a rigid lid, on which the 
+ pressure (or its horizontal gradient) can be diagnosed. When the former strategy is used, 
+ one solution of the free-surface elevation consists of the excitation of external gravity waves. 
+ The flow is barotropic and the surface moves up and down with gravity as the restoring force. 
+ The phase speed of such waves is high (some hundreds of metres per second) so that 
+ the time step would have to be very short if they were present in the model. The latter 
+ strategy filters out these waves since the rigid lid approximation implies $\eta=0$, $i.e.$ 
+ the sea surface is the surface $z=0$. This well known approximation increases the surface 
+ wave speed to infinity and modifies certain other longwave dynamics ($e.g.$ barotropic 
+ Rossby or planetary waves). The rigid-lid hypothesis is an obsolescent feature in modern 
+ OGCMs. It has been available until the release 3.1 of  \NEMO, and it has been removed
+ in release 3.2 and followings. Only the free surface formulation is now described in the
+ this document (see the next sub-section).
+
+% -------------------------------------------------------------------------------------------------------------
+% Free Surface Formulation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Free Surface Formulation}
+\label{PE_free_surface}
+
+In the free surface formulation, a variable $\eta$, the sea-surface height, is introduced 
+which describes the shape of the air-sea interface. This variable is solution of a 
+prognostic equation which is established by forming the vertical average of the kinematic 
+surface condition (\ref{Eq_PE_w_bbc}):
+\begin{equation} \label{Eq_PE_ssh}
+\frac{\partial \eta }{\partial t}=-D+P-E
+ 	\quad \text{where} \ 
+D=\nabla \cdot \left[ {\left( {H+\eta } \right) \; {\rm{\bf \overline{U}}}_h \,} \right]
+\end{equation}
+and using (\ref{Eq_PE_hydrostatic}) the surface pressure is given by: $p_s = \rho \, g \, \eta$.
+
+Allowing the air-sea interface to move introduces the external gravity waves (EGWs) 
+as a class of solution of the primitive equations. These waves are barotropic because 
+of hydrostatic assumption, and their phase speed is quite high. Their time scale is 
+short with respect to the other processes described by the primitive equations.
+
+Two choices can be made regarding the implementation of the free surface in the model, 
+depending on the physical processes of interest. 
+
+$\bullet$ If one is interested in EGWs, in particular the tides and their interaction 
+with the baroclinic structure of the ocean (internal waves) possibly in shallow seas, 
+then a non linear free surface is the most appropriate. This means that no 
+approximation is made in (\ref{Eq_PE_ssh}) and that the variation of the ocean 
+volume is fully taken into account. Note that in order to study the fast time scales 
+associated with EGWs it is necessary to minimize time filtering effects (use an 
+explicit time scheme with very small time step, or a split-explicit scheme with 
+reasonably small time step, see \S\ref{DYN_spg_exp} or \S\ref{DYN_spg_ts}.
+
+$\bullet$ If one is not interested in EGW but rather sees them as high frequency 
+noise, it is possible to apply an explicit filter to slow down the fastest waves while 
+not altering the slow barotropic Rossby waves. If further, an approximative conservation 
+of heat and salt contents is sufficient for the problem solved, then it is 
+sufficient to solve a linearized version of (\ref{Eq_PE_ssh}), which still allows 
+to take into account freshwater fluxes applied at the ocean surface \citep{Roullet_Madec_JGR00}.
+Nevertheless, with the linearization, an exact conservation of heat and salt contents is lost.
+
+The filtering of EGWs in models with a free surface is usually a matter of discretisation 
+of the temporal derivatives, using a split-explicit method \citep{Killworth_al_JPO91, Zhang_Endoh_JGR92} 
+or the implicit scheme \citep{Dukowicz1994} or the addition of a filtering force in the momentum equation 
+\citep{Roullet_Madec_JGR00}. With the present release, \NEMO offers the choice between 
+an explicit free surface (see \S\ref{DYN_spg_exp}) or a split-explicit scheme strongly 
+inspired the one proposed by \citet{Shchepetkin_McWilliams_OM05} (see \S\ref{DYN_spg_ts}).
+
+%\newpage
+%$\ $\newline    % force a new line
+
+% ================================================================
+% Curvilinear z-coordinate System
+% ================================================================
+\section{Curvilinear \textit{z-}coordinate System}
+\label{PE_zco}
+
+
+% -------------------------------------------------------------------------------------------------------------
+% Tensorial Formalism
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Tensorial Formalism}
+\label{PE_tensorial}
+
+In many ocean circulation problems, the flow field has regions of enhanced dynamics 
+($i.e.$ surface layers, western boundary currents, equatorial currents, or ocean fronts). 
+The representation of such dynamical processes can be improved by specifically increasing 
+the model resolution in these regions. As well, it may be convenient to use a lateral 
+boundary-following coordinate system to better represent coastal dynamics. Moreover, 
+the common geographical coordinate system has a singular point at the North Pole that 
+cannot be easily treated in a global model without filtering. A solution consists of introducing 
+an appropriate coordinate transformation that shifts the singular point onto land 
+\citep{Madec_Imbard_CD96, Murray_JCP96}. As a consequence, it is important to solve the primitive 
+equations in various curvilinear coordinate systems. An efficient way of introducing an 
+appropriate coordinate transform can be found when using a tensorial formalism. 
+This formalism is suited to any multidimensional curvilinear coordinate system. Ocean 
+modellers mainly use three-dimensional orthogonal grids on the sphere (spherical earth 
+approximation), with preservation of the local vertical. Here we give the simplified equations 
+for this particular case. The general case is detailed by \citet{Eiseman1980} in their survey 
+of the conservation laws of fluid dynamics.
+
+Let (\textit{i},\textit{j},\textit{k}) be a set of orthogonal curvilinear coordinates on the sphere 
+associated with the positively oriented orthogonal set of unit vectors (\textbf{i},\textbf{j},\textbf{k}) 
+linked to the earth such that \textbf{k} is the local upward vector and (\textbf{i},\textbf{j}) are 
+two vectors orthogonal to \textbf{k}, $i.e.$ along geopotential surfaces (Fig.\ref{Fig_referential}). 
+Let $(\lambda,\varphi,z)$ be the geographical coordinate system in which a position is defined 
+by the latitude $\varphi(i,j)$, the longitude $\lambda(i,j)$ and the distance from the centre of 
+the earth $a+z(k)$ where $a$ is the earth's radius and $z$ the altitude above a reference sea 
+level (Fig.\ref{Fig_referential}). The local deformation of the curvilinear coordinate system is 
+given by $e_1$, $e_2$ and $e_3$, the three scale factors:
+\begin{equation} \label{Eq_scale_factors}
+\begin{aligned}
+ e_1 &=\left( {a+z} \right)\;\left[ {\left( {\frac{\partial \lambda 
+}{\partial i}\cos \varphi } \right)^2+\left( {\frac{\partial \varphi 
+}{\partial i}} \right)^2} \right]^{1/2} \\ 
+ e_2 &=\left( {a+z} \right)\;\left[ {\left( {\frac{\partial \lambda 
+}{\partial j}\cos \varphi } \right)^2+\left( {\frac{\partial \varphi 
+}{\partial j}} \right)^2} \right]^{1/2} \\ 
+ e_3 &=\left( {\frac{\partial z}{\partial k}} \right) \\ 
+ \end{aligned}
+ \end{equation}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tb] 	 \begin{center}
+\includegraphics[width=0.60\textwidth]{Fig_I_earth_referential}
+\caption{	\label{Fig_referential} 
+the geographical coordinate system $(\lambda,\varphi,z)$ and the curvilinear 
+coordinate system (\textbf{i},\textbf{j},\textbf{k}). }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Since the ocean depth is far smaller than the earth's radius, $a+z$, can be replaced by 
+$a$ in (\ref{Eq_scale_factors}) (thin-shell approximation). The resulting horizontal scale 
+factors $e_1$, $e_2$  are independent of $k$ while the vertical scale factor is a single 
+function of $k$ as \textbf{k} is parallel to \textbf{z}. The scalar and vector operators that 
+appear in the primitive equations (Eqs. \eqref{Eq_PE_dyn} to \eqref{Eq_PE_eos}) can 
+be written in the tensorial form, invariant in any orthogonal horizontal curvilinear coordinate 
+system transformation:
+\begin{subequations} \label{Eq_PE_discrete_operators}
+\begin{equation} \label{Eq_PE_grad}
+\nabla q=\frac{1}{e_1 }\frac{\partial q}{\partial i}\;{\rm {\bf 
+i}}+\frac{1}{e_2 }\frac{\partial q}{\partial j}\;{\rm {\bf j}}+\frac{1}{e_3 
+}\frac{\partial q}{\partial k}\;{\rm {\bf k}}    \\
+\end{equation}
+\begin{equation} \label{Eq_PE_div}
+\nabla \cdot {\rm {\bf A}} 
+= \frac{1}{e_1 \; e_2} \left[ 
+  \frac{\partial \left(e_2 \; a_1\right)}{\partial i }
++\frac{\partial \left(e_1 \; a_2\right)}{\partial j }    	\right]
++ \frac{1}{e_3} \left[ \frac{\partial a_3}{\partial k }   \right]
+\end{equation}
+\begin{equation} \label{Eq_PE_curl}
+   \begin{split}
+\nabla \times \vect{A} = 
+    \left[ {\frac{1}{e_2 }\frac{\partial a_3}{\partial j}
+            -\frac{1}{e_3 }\frac{\partial a_2 }{\partial k}} \right] \; \vect{i}
+&+\left[ {\frac{1}{e_3 }\frac{\partial a_1 }{\partial k}
+           -\frac{1}{e_1 }\frac{\partial a_3 }{\partial i}} \right] \; \vect{j} 		\\
+&+\frac{1}{e_1 e_2 } \left[ {\frac{\partial \left( {e_2 a_2 } \right)}{\partial i}
+                                       -\frac{\partial \left( {e_1 a_1 } \right)}{\partial j}} \right] \; \vect{k} 
+   \end{split}
+\end{equation}
+\begin{equation} \label{Eq_PE_lap}
+\Delta q = \nabla \cdot \left(  \nabla q \right)
+\end{equation}
+\begin{equation} \label{Eq_PE_lap_vector}
+\Delta {\rm {\bf A}} =
+  \nabla \left( \nabla \cdot {\rm {\bf A}} \right)
+- \nabla \times \left(  \nabla \times {\rm {\bf A}} \right)
+\end{equation}
+\end{subequations}
+where $q$ is a scalar quantity and ${\rm {\bf A}}=(a_1,a_2,a_3)$ a vector in the $(i,j,k)$ coordinate system.
+
+% -------------------------------------------------------------------------------------------------------------
+% Continuous Model Equations
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Continuous Model Equations}
+\label{PE_zco_Eq}
+
+In order to express the Primitive Equations in tensorial formalism, it is necessary to compute 
+the horizontal component of the non-linear and viscous terms of the equation using 
+\eqref{Eq_PE_grad}) to \eqref{Eq_PE_lap_vector}. 
+Let us set $\vect U=(u,v,w)={\vect{U}}_h +w\;\vect{k}$, the velocity in the $(i,j,k)$ coordinate 
+system and define the relative vorticity $\zeta$ and the divergence of the horizontal velocity 
+field $\chi$, by:
+\begin{equation} \label{Eq_PE_curl_Uh}
+\zeta =\frac{1}{e_1 e_2 }\left[ {\frac{\partial \left( {e_2 \,v} 
+\right)}{\partial i}-\frac{\partial \left( {e_1 \,u} \right)}{\partial j}} 
+\right]
+\end{equation}
+\begin{equation} \label{Eq_PE_div_Uh}
+\chi =\frac{1}{e_1 e_2 }\left[ {\frac{\partial \left( {e_2 \,u} 
+\right)}{\partial i}+\frac{\partial \left( {e_1 \,v} \right)}{\partial j}} 
+\right]
+\end{equation}
+
+Using the fact that the horizontal scale factors $e_1$ and $e_2$ are independent of $k$ 
+and that $e_3$  is a function of the single variable $k$, the nonlinear term of 
+\eqref{Eq_PE_dyn} can be transformed as follows:
+\begin{flalign*}
+&\left[ {\left( {	\nabla \times {\rm {\bf U}}    } \right) \times {\rm {\bf U}}
++\frac{1}{2}	\nabla \left( {{\rm {\bf U}}^2} \right)}	 \right]_h 			&
+\end{flalign*}
+\begin{flalign*}
+&\qquad=\left( {{\begin{array}{*{20}c}
+ {\left[ 	{	 \frac{1}{e_3}	\frac{\partial u	}{\partial k}
+			-\frac{1}{e_1}	\frac{\partial w	}{\partial i} } \right] w - \zeta \; v } 	 	\\
+ 		{\zeta \; u - \left[ {	 \frac{1}{e_2} \frac{\partial w}{\partial j}
+							-\frac{1}{e_3} \frac{\partial v}{\partial k} } \right] \ w}	 \\
+		 \end{array} }} \right)			
++\frac{1}{2}	\left( {{\begin{array}{*{20}c}
+		 {	\frac{1}{e_1}	\frac{\partial \left( u^2+v^2+w^2 \right)}{\partial i}} 	\hfill	 \\
+		 {	\frac{1}{e_2}	\frac{\partial \left( u^2+v^2+w^2 \right)}{\partial j}} 	\hfill	 \\
+		 \end{array} }} \right)			&
+\end{flalign*}
+\begin{flalign*}
+& \qquad =\left( {{	\begin{array}{*{20}c}
+ {-\zeta \; v} \hfill \\
+ { \zeta \; u} \hfill \\
+			\end{array} }} \right)
++\frac{1}{2}\left( {{	\begin{array}{*{20}c}
+ {\frac{1}{e_1 }\frac{\partial \left( {u^2+v^2} \right)}{\partial i}} \hfill 	\\
+ {\frac{1}{e_2 }\frac{\partial \left( {u^2+v^2} \right)}{\partial j}} \hfill 	\\
+						\end{array} }} \right)			
++\frac{1}{e_3 }\left( {{		\begin{array}{*{20}c}
+ { w \; \frac{\partial u}{\partial k}} 	\\
+ { w \; \frac{\partial v}{\partial k}} 	\\
+							\end{array} }} \right)	
+-\left( {{	\begin{array}{*{20}c}
+ {\frac{w}{e_1}\frac{\partial w}{\partial i}
+ -\frac{1}{2e_1}\frac{\partial w^2}{\partial i}} \hfill \\
+ {\frac{w}{e_2}\frac{\partial w}{\partial j}
+  -\frac{1}{2e_2}\frac{\partial w^2}{\partial j}} \hfill \\
+			\end{array} }} \right) 			&
+\end{flalign*}
+
+The last term of the right hand side is obviously zero, and thus the nonlinear term of 
+\eqref{Eq_PE_dyn} is written in the $(i,j,k)$ coordinate system:
+\begin{equation} \label{Eq_PE_vector_form}
+\left[ {\left( {	\nabla \times {\rm {\bf U}}    } \right) \times {\rm {\bf U}}
++\frac{1}{2}	\nabla \left( {{\rm {\bf U}}^2} \right)}	 \right]_h 
+=\zeta 
+\;{\rm {\bf k}}\times {\rm {\bf U}}_h +\frac{1}{2}\nabla _h \left( {{\rm 
+{\bf U}}_h^2 } \right)+\frac{1}{e_3 }w\frac{\partial {\rm {\bf U}}_h 
+}{\partial k}   	
+\end{equation}
+
+This is the so-called \textit{vector invariant form} of the momentum advection term. 
+For some purposes, it can be advantageous to write this term in the so-called flux form, 
+$i.e.$ to write it as the divergence of fluxes. For example, the first component of 
+\eqref{Eq_PE_vector_form} (the $i$-component) is transformed as follows:
+\begin{flalign*}
+&{	\begin{array}{*{20}l}
+\left[ {\left( {\nabla \times \vect{U}} \right)\times \vect{U}
+          +\frac{1}{2}\nabla \left( {\vect{U}}^2 \right)} \right]_i   % \\
+%\\
+     = - \zeta \;v 
+     + \frac{1}{2\;e_1 } \frac{\partial \left( {u^2+v^2} \right)}{\partial i}
+     + \frac{1}{e_3}w \ \frac{\partial u}{\partial k} 			\\
+\\
+\qquad =\frac{1}{e_1 \; e_2} \left( 	-v\frac{\partial \left( {e_2 \,v} \right)}{\partial i}
+							+v\frac{\partial \left( {e_1 \,u} \right)}{\partial j}	 \right)
++\frac{1}{e_1 e_2 }\left( 	+e_2 \; u\frac{\partial u}{\partial i}
+ 							+e_2 \; v\frac{\partial v}{\partial i}	  				 \right) 
++\frac{1}{e_3}       \left( 	w\;\frac{\partial u}{\partial k} 		\right)   \\
+\end{array} } 			&
+\end{flalign*}
+\begin{flalign*}
+&{	\begin{array}{*{20}l}
+\qquad =\frac{1}{e_1 \; e_2} 	\left\{ 
+ -\left(   	    v^2 	\frac{\partial e_2                                }{\partial i} 
+ 		+e_2 \,v		\frac{\partial v                                   }{\partial i}  	\right)
++\left( 				\frac{\partial \left( {e_1 \,u\,v} 	\right)}{\partial j}
+		-e_1 \,u		\frac{\partial v                                   }{\partial j} 	\right) 	\right. 
+\\  \left.	\qquad \qquad \quad
++\left( 				\frac{\partial \left( {e_2 u\,u}     \right)}{\partial i}
+		-u			\frac{\partial \left( {e_2 u}         \right)}{\partial i} 	\right)
++e_2 v		 		\frac{\partial v                                    }{\partial i}
+ 						\right\} 
++\frac{1}{e_3} \left(
+ 					\frac{\partial \left( {w\,u} \right)         }{\partial k}
+		 -u			\frac{\partial w 						   }{\partial k} 	\right) \\
+\end{array} } 		&
+\end{flalign*}
+\begin{flalign*}
+&{	\begin{array}{*{20}l}
+\qquad =\frac{1}{e_1 \; e_2} 	\left( 
+					\frac{\partial \left( {e_2 \,u\,u} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \,u\,v} \right)}{\partial j}	\right)
++\frac{1}{e_3 }		\frac{\partial \left( {w\,u		 } \right)}{\partial k}
+\\  \qquad \qquad \quad
++\frac{1}{e_1 e_2 }		\left( 
+ 		-u	\left( 	\frac{\partial \left( {e_1 v	 } \right)}{\partial j}
+	 				-v\,\frac{\partial e_1 }{\partial j}				 \right)
+		-u			\frac{\partial \left( {e_2 u	 } \right)}{\partial i}
+						\right)
+ -\frac{1}{e_3 }	 	\frac{\partial w}{\partial k}	u
+ +\frac{1}{e_1 e_2 }\left( 	-v^2\frac{\partial e_2	 }{\partial i}		 \right)	
+\end{array} } 		&
+\end{flalign*}
+\begin{flalign*}
+&{	\begin{array}{*{20}l}
+\qquad = \nabla \cdot \left( {{\rm {\bf U}}\,u}	\right)
+-   \left( \nabla \cdot {\rm {\bf U}} \right) \ u
++\frac{1}{e_1 e_2 }\left( 
+		-v^2		\frac{\partial e_2 }{\partial i}
+		+uv	\,		\frac{\partial e_1 }{\partial j} 	\right) \\
+\end{array} } 		&
+\end{flalign*}
+as $\nabla \cdot {\rm {\bf U}}\;=0$ (incompressibility) it comes:
+\begin{flalign*}
+&{	\begin{array}{*{20}l}
+\qquad = \nabla \cdot \left( 	{{\rm {\bf U}}\,u}		\right)
++	\frac{1}{e_1 e_2 }   \left( v \; \frac{\partial e_2}{\partial i}
+						       -u \; \frac{\partial e_1}{\partial j} 	\right)  \left( -v \right)	
+\end{array} } 		&
+\end{flalign*}
+
+The flux form of the momentum advection term is therefore given by:
+\begin{multline} \label{Eq_PE_flux_form}
+		\left[ 
+  \left( 	{\nabla \times {\rm {\bf U}}} 	\right) \times {\rm {\bf U}}
++\frac{1}{2}	\nabla \left( 	{{\rm {\bf U}}^2} 	\right)
+		\right]_h 
+\\
+= \nabla \cdot 	\left( {{\begin{array}{*{20}c}	{\rm {\bf U}} \, u 	\hfill \\
+												{\rm {\bf U}} \, v	\hfill \\
+						\end{array} }} 	
+				\right)
++\frac{1}{e_1 e_2 }		\left( 
+		 v\frac{\partial e_2}{\partial i}
+		-u\frac{\partial e_1}{\partial j} 
+						\right) {\rm {\bf k}} \times {\rm {\bf U}}_h
+\end{multline}
+
+The flux form has two terms, the first one is expressed as the divergence of momentum 
+fluxes (hence the flux form name given to this formulation) and the second one is due to 
+the curvilinear nature of the coordinate system used. The latter is called the \emph{metric} 
+term and can be viewed as a modification of the Coriolis parameter: 
+\begin{equation} \label{Eq_PE_cor+metric}
+f \to f + \frac{1}{e_1\;e_2}  \left(  v \frac{\partial e_2}{\partial i}
+					         -u \frac{\partial e_1}{\partial j}  \right)
+\end{equation}
+
+Note that in the case of geographical coordinate, $i.e.$ when $(i,j) \to (\lambda ,\varphi )$ 
+and $(e_1 ,e_2) \to (a \,\cos \varphi ,a)$, we recover the commonly used modification of 
+the Coriolis parameter $f \to f+(u/a) \tan \varphi$.
+
+
+$\ $\newline    % force a new ligne
+
+To sum up, the curvilinear $z$-coordinate equations solved by the ocean model can be 
+written in the following tensorial formalism:
+
+\vspace{+10pt}
+$\bullet$ \textbf{Vector invariant form of the momentum equations} :
+
+\begin{subequations} \label{Eq_PE_dyn_vect}
+\begin{equation} \label{Eq_PE_dyn_vect_u} \begin{split}
+\frac{\partial u}{\partial t} 
+= +   \left( {\zeta +f} \right)\,v                                    
+   -   \frac{1}{2\,e_1}           \frac{\partial}{\partial i} \left(  u^2+v^2   \right) 
+   -   \frac{1}{e_3    }  w     \frac{\partial u}{\partial k}      &      \\
+   -   \frac{1}{e_1    }            \frac{\partial}{\partial i} \left( \frac{p_s+p_h }{\rho _o}    \right)    
+   &+   D_u^{\vect{U}}  +   F_u^{\vect{U}}      \\
+\\
+\frac{\partial v}{\partial t} =
+       -   \left( {\zeta +f} \right)\,u   
+       -   \frac{1}{2\,e_2 }        \frac{\partial }{\partial j}\left(  u^2+v^2  \right)   
+       -   \frac{1}{e_3     }   w  \frac{\partial v}{\partial k}     &      \\
+       -   \frac{1}{e_2     }        \frac{\partial }{\partial j}\left( \frac{p_s+p_h }{\rho _o}  \right)    
+    &+  D_v^{\vect{U}}  +   F_v^{\vect{U}}
+\end{split} \end{equation}
+\end{subequations}
+
+
+\vspace{+10pt}
+$\bullet$ \textbf{flux form of the momentum equations} :
+\begin{subequations} \label{Eq_PE_dyn_flux}
+\begin{multline} \label{Eq_PE_dyn_flux_u}
+\frac{\partial u}{\partial t}=
++   \left( { f + \frac{1}{e_1 \; e_2}
+					\left( 	 v \frac{\partial e_2}{\partial i}
+						-u \frac{\partial e_1}{\partial j} 	\right)} 	\right) \, v    \\
+- \frac{1}{e_1 \; e_2} 	\left( 
+					\frac{\partial \left( {e_2 \,u\,u} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \,v\,u} \right)}{\partial j}	\right)
+                 - \frac{1}{e_3 }\frac{\partial \left( {         w\,u} \right)}{\partial k}    \\
+-   \frac{1}{e_1 }\frac{\partial}{\partial i}\left( \frac{p_s+p_h }{\rho _o}   \right)
++   D_u^{\vect{U}} +   F_u^{\vect{U}}
+\end{multline}
+\begin{multline} \label{Eq_PE_dyn_flux_v}
+\frac{\partial v}{\partial t}=
+-   \left( { f + \frac{1}{e_1 \; e_2}
+					\left( 	 v \frac{\partial e_2}{\partial i}
+						-u \frac{\partial e_1}{\partial j} 	\right)} 	\right) \, u   \\
+ \frac{1}{e_1 \; e_2} 	\left( 
+					\frac{\partial \left( {e_2 \,u\,v} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \,v\,v} \right)}{\partial j}	\right)
+                 - \frac{1}{e_3 } \frac{\partial \left( {        w\,v} \right)}{\partial k}    \\
+-   \frac{1}{e_2 }\frac{\partial }{\partial j}\left( \frac{p_s+p_h }{\rho _o}    \right)
++  D_v^{\vect{U}} +  F_v^{\vect{U}} 
+\end{multline}
+\end{subequations}
+where $\zeta$, the relative vorticity, is given by \eqref{Eq_PE_curl_Uh} and $p_s $, 
+the surface pressure, is given by:
+\begin{equation} \label{Eq_PE_spg}
+p_s =  \rho \,g \,\eta 
+\end{equation}
+with $\eta$ is solution of \eqref{Eq_PE_ssh}
+
+The vertical velocity and the hydrostatic pressure are diagnosed from the following equations:
+\begin{equation} \label{Eq_w_diag}
+\frac{\partial w}{\partial k}=-\chi \;e_3 
+\end{equation}
+\begin{equation} \label{Eq_hp_diag}
+\frac{\partial p_h }{\partial k}=-\rho \;g\;e_3 
+\end{equation}
+where the divergence of the horizontal velocity, $\chi$ is given by \eqref{Eq_PE_div_Uh}.
+
+\vspace{+10pt}
+$\bullet$ \textit{tracer equations} :
+\begin{equation} \label{Eq_S}
+\frac{\partial T}{\partial t} = 
+-\frac{1}{e_1 e_2 }\left[ {	   \frac{\partial \left( {e_2 T\,u} \right)}{\partial i}
+						+\frac{\partial \left( {e_1 T\,v} \right)}{\partial j}} \right]
+-\frac{1}{e_3 }\frac{\partial \left( {T\,w} \right)}{\partial k} + D^T + F^T
+\end{equation}
+\begin{equation} \label{Eq_T}
+\frac{\partial S}{\partial t} = 
+-\frac{1}{e_1 e_2 }\left[ 	  {\frac{\partial \left( {e_2 S\,u} \right)}{\partial i}
+						+\frac{\partial \left( {e_1 S\,v} \right)}{\partial j}} \right]
+-\frac{1}{e_3 }\frac{\partial \left( {S\,w} \right)}{\partial k} + D^S + F^S
+\end{equation}
+\begin{equation} \label{Eq_rho}
+\rho =\rho \left( {T,S,z(k)} \right)
+\end{equation}
+
+The expression of \textbf{D}$^{U}$, $D^{S}$ and $D^{T}$ depends on the subgrid scale 
+parameterisation used. It will be defined in \S\ref{PE_zdf}. The nature and formulation of 
+${\rm {\bf F}}^{\rm {\bf U}}$, $F^T$ and $F^S$, the surface forcing terms, are discussed 
+in Chapter~\ref{SBC}.
+
+
+\newpage 
+$\ $\newline    % force a new ligne
+% ================================================================
+% Curvilinear generalised vertical coordinate System
+% ================================================================
+\section{Curvilinear generalised vertical coordinate System}
+\label{PE_gco}
+
+The ocean domain presents a huge diversity of situation in the vertical. First the ocean surface is a time dependent surface (moving surface). Second the ocean floor depends on the geographical position, varying from more than 6,000 meters in abyssal trenches to zero at the coast. Last but not least, the ocean stratification exerts a strong barrier to vertical motions and mixing. 
+Therefore, in order to represent the ocean with respect to the first point a space and time dependent vertical coordinate that follows the variation of the sea surface height $e.g.$ an $z$*-coordinate; for the second point, a space variation to fit the change of bottom topography $e.g.$ a terrain-following or $\sigma$-coordinate; and for the third point, one will be tempted to use a space and time dependent coordinate that follows the isopycnal surfaces, $e.g.$ an isopycnic coordinate.
+
+In order to satisfy two or more constrains one can even be tempted to mixed these coordinate systems, as in HYCOM (mixture of $z$-coordinate at the surface, isopycnic coordinate in the ocean interior and $\sigma$ at the ocean bottom) \citep{Chassignet_al_JPO03}  or OPA (mixture of $z$-coordinate in vicinity the surface and steep topography areas and $\sigma$-coordinate elsewhere) \citep{Madec_al_JPO96} among others.
+
+In fact one is totally free to choose any space and time vertical coordinate by introducing an arbitrary vertical coordinate :
+\begin{equation} \label{Eq_s}
+s=s(i,j,k,t)
+\end{equation}
+with the restriction that the above equation gives a single-valued monotonic relationship between $s$ and $k$, when $i$, $j$ and $t$ are held fixed. \eqref{Eq_s} is a transformation from the $(i,j,k,t)$ coordinate system with independent variables into the $(i,j,s,t)$ generalised coordinate system with $s$ depending on the other three variables through \eqref{Eq_s}.
+This so-called \textit{generalised vertical coordinate} \citep{Kasahara_MWR74} is in fact an Arbitrary Lagrangian--Eulerian (ALE) coordinate. Indeed, choosing an expression for $s$ is an arbitrary choice that determines which part of the vertical velocity (defined from a fixed referential) will cross the levels (Eulerian part) and which part will be used to move them (Lagrangian part).
+The coordinate is also sometime referenced as an adaptive coordinate \citep{Hofmeister_al_OM09}, since the coordinate system is adapted in the course of the simulation. Its most often used implementation is via an ALE algorithm, in which a pure lagrangian step is followed by regridding and remapping steps, the later step implicitly embedding the vertical advection \citep{Hirt_al_JCP74, Chassignet_al_JPO03, White_al_JCP09}. Here we follow the \citep{Kasahara_MWR74} strategy : a regridding step (an update of the vertical coordinate) followed by an eulerian step with an explicit computation of vertical advection relative to the moving s-surfaces.
+
+%\gmcomment{
+
+%A key point here is that the $s$-coordinate depends on $(i,j)$ ==> horizontal pressure gradient...
+
+the generalized vertical coordinates used in ocean modelling are not orthogonal, 
+which contrasts with many other applications in mathematical physics. 
+Hence, it is useful to keep in mind the following properties that may seem 
+odd on initial encounter.
+
+The horizontal velocity in ocean models measures motions in the horizontal plane, 
+perpendicular to the local gravitational field. That is, horizontal velocity is mathematically 
+the same regardless the vertical coordinate, be it geopotential, isopycnal, pressure, 
+or terrain following. The key motivation for maintaining the same horizontal velocity 
+component is that the hydrostatic and geostrophic balances are dominant in the large-scale ocean. 
+Use of an alternative quasi-horizontal velocity, for example one oriented parallel 
+to the generalized surface, would lead to unacceptable numerical errors. 
+Correspondingly, the vertical direction is anti-parallel to the gravitational force in all 
+of the coordinate systems. We do not choose the alternative of a quasi-vertical 
+direction oriented normal to the surface of a constant generalized vertical coordinate. 
+
+It is the method used to measure transport across the generalized vertical coordinate 
+surfaces which differs between the vertical coordinate choices. That is, computation 
+of the dia-surface velocity component represents the fundamental distinction between 
+the various coordinates. In some models, such as geopotential, pressure, and 
+terrain following, this transport is typically diagnosed from volume or mass conservation. 
+In other models, such as isopycnal layered models, this transport is prescribed based 
+on assumptions about the physical processes producing a flux across the layer interfaces. 
+
+
+In this section we first establish the PE in the generalised vertical $s$-coordinate, 
+then we discuss the particular cases available in \NEMO, namely $z$, $z$*, $s$, and $\tilde z$.  
+%}
+
+% -------------------------------------------------------------------------------------------------------------
+% The s-coordinate Formulation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{The \textit{s-}coordinate Formulation}
+
+Starting from the set of equations established in \S\ref{PE_zco} for the special case $k=z$ 
+and thus $e_3=1$, we introduce an arbitrary vertical coordinate $s=s(i,j,k,t)$, which includes 
+$z$-, \textit{z*}- and $\sigma-$coordinates as special cases ($s=z$, $s=\textit{z*}$, and 
+$s=\sigma=z/H$ or $=z/\left(H+\eta \right)$, resp.). A formal derivation of the transformed 
+equations is given in Appendix~\ref{Apdx_A}. Let us define the vertical scale factor by 
+$e_3=\partial_s z$  ($e_3$ is now a function of $(i,j,k,t)$ ), and the slopes in the 
+(\textbf{i},\textbf{j}) directions between $s-$ and $z-$surfaces by :
+\begin{equation} \label{Eq_PE_sco_slope}
+\sigma _1 =\frac{1}{e_1 }\;\left. {\frac{\partial z}{\partial i}} \right|_s 
+\quad \text{, and } \quad 
+\sigma _2 =\frac{1}{e_2 }\;\left. {\frac{\partial z}{\partial j}} \right|_s
+\end{equation}
+We also introduce  $\omega $, a dia-surface velocity component, defined as the velocity 
+relative to the moving $s$-surfaces and normal to them:
+\begin{equation} \label{Eq_PE_sco_w}
+\omega  = w - e_3 \, \frac{\partial s}{\partial t} - \sigma _1 \,u - \sigma _2 \,v    \\
+\end{equation}
+
+The equations solved by the ocean model \eqref{Eq_PE} in $s-$coordinate can be written as follows (see Appendix~\ref{Apdx_A_momentum}):
+
+ \vspace{0.5cm}
+$\bullet$ Vector invariant form of the momentum equation :
+\begin{multline} \label{Eq_PE_sco_u}
+\frac{\partial  u   }{\partial t}=
+	+   \left( {\zeta +f} \right)\,v                                    
+	-   \frac{1}{2\,e_1} \frac{\partial}{\partial i} \left(  u^2+v^2   \right) 
+	-   \frac{1}{e_3} \omega \frac{\partial u}{\partial k}       \\
+	-   \frac{1}{e_1} \frac{\partial}{\partial i} \left( \frac{p_s + p_h}{\rho _o}    \right)    
+	+  g\frac{\rho }{\rho _o}\sigma _1 
+	+   D_u^{\vect{U}}  +   F_u^{\vect{U}} \quad
+\end{multline}
+\begin{multline} \label{Eq_PE_sco_v}
+\frac{\partial v }{\partial t}=
+	-   \left( {\zeta +f} \right)\,u   
+	-   \frac{1}{2\,e_2 }\frac{\partial }{\partial j}\left(  u^2+v^2  \right)     	
+	-   \frac{1}{e_3 } \omega \frac{\partial v}{\partial k}         \\
+	-   \frac{1}{e_2 }\frac{\partial }{\partial j}\left( \frac{p_s+p_h }{\rho _o}  \right) 
+	 +  g\frac{\rho }{\rho _o }\sigma _2   
+	+  D_v^{\vect{U}}  +   F_v^{\vect{U}} \quad
+\end{multline}
+
+ \vspace{0.5cm}
+$\bullet$ Vector invariant form of the momentum equation :
+\begin{multline} \label{Eq_PE_sco_u}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,u  \right) }{\partial t}=
+   +   \left( { f + \frac{1}{e_1 \; e_2 }
+					\left( 	 v \frac{\partial e_2}{\partial i}
+						-u \frac{\partial e_1}{\partial j} 	\right)} 	\right) \, v    \\
+   - \frac{1}{e_1 \; e_2 \; e_3 } 	\left( 
+					\frac{\partial \left( {e_2 \, e_3 \, u\,u} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \, e_3 \, v\,u} \right)}{\partial j}	\right)
+   - \frac{1}{e_3 }\frac{\partial \left( { \omega\,u} \right)}{\partial k}    \\
+	- \frac{1}{e_1} \frac{\partial}{\partial i} \left( \frac{p_s + p_h}{\rho _o}    \right)    
+	+  g\frac{\rho }{\rho _o}\sigma _1 
+	+   D_u^{\vect{U}}  +   F_u^{\vect{U}} \quad
+\end{multline}
+\begin{multline} \label{Eq_PE_sco_v}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,v  \right) }{\partial t}=
+   -   \left( { f + \frac{1}{e_1 \; e_2}
+					\left( 	 v \frac{\partial e_2}{\partial i}
+						-u \frac{\partial e_1}{\partial j} 	\right)} 	\right) \, u   \\
+   - \frac{1}{e_1 \; e_2 \; e_3 } 	\left( 
+					\frac{\partial \left( {e_2 \; e_3  \,u\,v} \right)}{\partial i}
+		+			\frac{\partial \left( {e_1 \; e_3  \,v\,v} \right)}{\partial j}	\right)
+                 - \frac{1}{e_3 } \frac{\partial \left( { \omega\,v} \right)}{\partial k}    \\
+	-   \frac{1}{e_2 }\frac{\partial }{\partial j}\left( \frac{p_s+p_h }{\rho _o}  \right) 
+	 +  g\frac{\rho }{\rho _o }\sigma _2   
+	+  D_v^{\vect{U}}  +   F_v^{\vect{U}} \quad
+\end{multline}
+
+where the relative vorticity, \textit{$\zeta $}, the surface pressure gradient, and the hydrostatic 
+pressure have the same expressions as in $z$-coordinates although they do not represent 
+exactly the same quantities. $\omega$ is provided by the continuity equation 
+(see Appendix~\ref{Apdx_A}):
+\begin{equation} \label{Eq_PE_sco_continuity}
+\frac{\partial e_3}{\partial t} + e_3 \; \chi + \frac{\partial \omega }{\partial s} = 0   
+\qquad \text{with }\;\;  
+\chi =\frac{1}{e_1 e_2 e_3 }\left[ {\frac{\partial \left( {e_2 e_3 \,u} 
+\right)}{\partial i}+\frac{\partial \left( {e_1 e_3 \,v} \right)}{\partial 
+j}} \right]
+\end{equation}
+
+ \vspace{0.5cm}
+$\bullet$ tracer equations:
+\begin{multline} \label{Eq_PE_sco_t}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,T  \right) }{\partial t}=
+-\frac{1}{e_1 e_2 e_3 }\left[ {\frac{\partial \left( {e_2 e_3\,u\,T} \right)}{\partial i}
+                                           +\frac{\partial \left( {e_1 e_3\,v\,T} \right)}{\partial j}} \right]   \\
+-\frac{1}{e_3 }\frac{\partial \left( {T\,\omega } \right)}{\partial k}   + D^T + F^S   \qquad
+\end{multline}
+
+\begin{multline} \label{Eq_PE_sco_s}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,S  \right) }{\partial t}=
+-\frac{1}{e_1 e_2 e_3 }\left[ {\frac{\partial \left( {e_2 e_3\,u\,S} \right)}{\partial i}
+                                           +\frac{\partial \left( {e_1 e_3\,v\,S} \right)}{\partial j}} \right]    \\
+-\frac{1}{e_3 }\frac{\partial \left( {S\,\omega } \right)}{\partial k}     + D^S + F^S   \qquad
+\end{multline}
+
+The equation of state has the same expression as in $z$-coordinate, and similar expressions 
+are used for mixing and forcing terms.
+
+\gmcomment{
+\colorbox{yellow}{ to be updated $= = >$}
+Add a few works on z and zps and s and underlies the differences between all of them
+\colorbox{yellow}{ $< = =$ end update}  }
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+% Curvilinear z*-coordinate System
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Curvilinear \textit{z*}--coordinate System}
+\label{PE_zco_star}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!b] 	 \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_z_zstar}
+\caption{	\label{Fig_z_zstar} 
+(a) $z$-coordinate in linear free-surface case ; 
+(b) $z-$coordinate in non-linear free surface case ; 
+(c) re-scaled height coordinate (become popular as the \textit{z*-}coordinate 
+\citep{Adcroft_Campin_OM04} ).}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+In that case, the free surface equation is nonlinear, and the variations of volume are fully 
+taken into account. These coordinates systems is presented in a report \citep{Levier2007} 
+available on the \NEMO web site. 
+
+%\gmcomment{
+The \textit{z*} coordinate approach is an unapproximated, non-linear free surface implementation 
+which allows one to deal with large amplitude free-surface
+variations relative to the vertical resolution \citep{Adcroft_Campin_OM04}. In
+the  \textit{z*} formulation, the variation of the column thickness due to sea-surface
+undulations is not concentrated in the surface level, as in the $z$-coordinate formulation,
+but is equally distributed over the full water column. Thus vertical
+levels naturally follow sea-surface variations, with a linear attenuation with
+depth, as illustrated by figure fig.1c . Note that with a flat bottom, such as in
+fig.1c, the bottom-following  $z$ coordinate and  \textit{z*} are equivalent.
+The definition and modified oceanic equations for the rescaled vertical coordinate
+ \textit{z*}, including the treatment of fresh-water flux at the surface, are
+detailed in Adcroft and Campin (2004). The major points are summarized
+here. The position ( \textit{z*}) and vertical discretization (\textit{z*}) are expressed as:
+\begin{equation} \label{Eq_z-star}
+H +  \textit{z*} = (H + z) / r \quad \text{and} \ \delta \textit{z*} = \delta z / r \quad \text{with} \ r = \frac{H+\eta} {H}
+\end{equation} 
+Since the vertical displacement of the free surface is incorporated in the vertical
+coordinate  \textit{z*}, the upper and lower boundaries are at fixed  \textit{z*} position,  
+$\textit{z*} = 0$ and  $\textit{z*} = -H$ respectively. Also the divergence of the flow field 
+is no longer zero as shown by the continuity equation:
+\begin{equation*} 
+\frac{\partial r}{\partial t} = \nabla_{\textit{z*}} \cdot \left( r \; \rm{\bf U}_h \right)
+		\left( r \; w\textit{*} \right) = 0 
+\end{equation*} 
+%}
+
+
+% from MOM4p1 documentation
+
+To overcome problems with vanishing surface and/or bottom cells, we consider the 
+zstar coordinate 
+\begin{equation} \label{PE_}
+	z^\star = H \left( \frac{z-\eta}{H+\eta} \right)
+\end{equation}
+
+This coordinate is closely related to the "eta" coordinate used in many atmospheric 
+models (see Black (1994) for a review of eta coordinate atmospheric models). It 
+was originally used in ocean models by Stacey et al. (1995) for studies of tides 
+next to shelves, and it has been recently promoted by Adcroft and Campin (2004) 
+for global climate modelling.
+
+The surfaces of constant $z^\star$ are quasi-horizontal. Indeed, the $z^\star$ coordinate reduces to $z$ when $\eta$ is zero. In general, when noting the large differences between 
+undulations of the bottom topography versus undulations in the surface height, it 
+is clear that surfaces constant $z^\star$ are very similar to the depth surfaces. These properties greatly reduce difficulties of computing the horizontal pressure gradient relative to terrain following sigma models discussed in \S\ref{PE_sco}. 
+Additionally, since $z^\star$ when $\eta = 0$, no flow is spontaneously generated in an 
+unforced ocean starting from rest, regardless the bottom topography. This behaviour is in contrast to the case with "s"-models, where pressure gradient errors in 
+the presence of nontrivial topographic variations can generate nontrivial spontaneous flow from a resting state, depending on the sophistication of the pressure 
+gradient solver. The quasi-horizontal nature of the coordinate surfaces also facilitates the implementation of neutral physics parameterizations in $z^\star$ models using 
+the same techniques as in $z$-models (see Chapters 13-16 of \cite{Griffies_Bk04}) for a 
+discussion of neutral physics in $z$-models, as well as Section \S\ref{LDF_slp} 
+in this document for treatment in \NEMO). 
+
+The range over which $z^\star$ varies is time independent $-H \leq z^\star \leq 0$. Hence, all 
+cells remain nonvanishing, so long as the surface height maintains $\eta > ?H$. This 
+is a minor constraint relative to that encountered on the surface height when using 
+$s = z$ or $s = z - \eta$. 
+
+Because $z^\star$ has a time independent range, all grid cells have static increments 
+ds, and the sum of the ver tical increments yields the time independent ocean 
+depth %·k ds = H. 
+The $z^\star$ coordinate is therefore invisible to undulations of the 
+free surface, since it moves along with the free surface. This proper ty means that 
+no spurious ver tical transpor t is induced across surfaces of constant $z^\star$ by the 
+motion of external gravity waves. Such spurious transpor t can be a problem in 
+z-models, especially those with tidal forcing. Quite generally, the time independent 
+range for the $z^\star$ coordinate is a very convenient proper ty that allows for a nearly 
+arbitrary ver tical resolution even in the presence of large amplitude fluctuations of 
+the surface height, again so long as $\eta > -H$. 
+
+%end MOM doc %%%
+
+
+
+\newpage 
+% -------------------------------------------------------------------------------------------------------------
+% Terrain following  coordinate System
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Curvilinear Terrain-following \textit{s}--coordinate}
+\label{PE_sco}
+
+% -------------------------------------------------------------------------------------------------------------
+% Introduction
+% -------------------------------------------------------------------------------------------------------------
+\subsubsection{Introduction}
+
+Several important aspects of the ocean circulation are influenced by bottom topography. 
+Of course, the most important is that bottom topography determines deep ocean sub-basins, 
+barriers, sills and channels that strongly constrain the path of water masses, but more subtle 
+effects exist. For example, the topographic $\beta$-effect is usually larger than the planetary 
+one along continental slopes. Topographic Rossby waves can be excited and can interact 
+with the mean current. In the $z-$coordinate system presented in the previous section 
+(\S\ref{PE_zco}), $z-$surfaces are geopotential surfaces. The bottom topography is 
+discretised by steps. This often leads to a misrepresentation of a gradually sloping bottom 
+and to large localized depth gradients associated with large localized vertical velocities. 
+The response to such a velocity field often leads to numerical dispersion effects. 
+One solution to strongly reduce this error is to use a partial step representation of bottom 
+topography instead of a full step one \cite{Pacanowski_Gnanadesikan_MWR98}. 
+Another solution is to introduce a terrain-following coordinate system (hereafter $s-$coordinate) 
+
+The $s$-coordinate avoids the discretisation error in the depth field since the layers of 
+computation are gradually adjusted with depth to the ocean bottom. Relatively small 
+topographic features as well as  gentle, large-scale slopes of the sea floor in the deep 
+ocean, which would be ignored in typical $z$-model applications with the largest grid 
+spacing at greatest depths, can easily be represented (with relatively low vertical resolution). 
+A terrain-following model (hereafter $s-$model) also facilitates the modelling of the 
+boundary layer flows over a large depth range, which in the framework of the $z$-model 
+would require high vertical resolution over the whole depth range. Moreover, with a 
+$s$-coordinate it is possible, at least in principle, to have the bottom and the sea surface 
+as the only boundaries of the domain (nomore lateral boundary condition to specify). 
+Nevertheless, a $s$-coordinate also has its drawbacks. Perfectly adapted to a 
+homogeneous ocean, it has strong limitations as soon as stratification is introduced. 
+The main two problems come from the truncation error in the horizontal pressure 
+gradient and a possibly increased diapycnal diffusion. The horizontal pressure force 
+in $s$-coordinate consists of two terms (see Appendix~\ref{Apdx_A}),
+
+\begin{equation} \label{Eq_PE_p_sco}
+\left. {\nabla p} \right|_z =\left. {\nabla p} \right|_s -\frac{\partial 
+p}{\partial s}\left. {\nabla z} \right|_s 
+\end{equation}
+
+The second term in \eqref{Eq_PE_p_sco} depends on the tilt of the coordinate surface 
+and introduces a truncation error that is not present in a $z$-model. In the special case 
+of a $\sigma-$coordinate (i.e. a depth-normalised coordinate system $\sigma = z/H$), 
+\citet{Haney1991} and \citet{Beckmann1993} have given estimates of the magnitude 
+of this truncation error. It depends on topographic slope, stratification, horizontal and 
+vertical resolution, the equation of state, and the finite difference scheme. This error 
+limits the possible topographic slopes that a model can handle at a given horizontal 
+and vertical resolution. This is a severe restriction for large-scale applications using 
+realistic bottom topography. The large-scale slopes require high horizontal resolution, 
+and the computational cost becomes prohibitive. This problem can be at least partially 
+overcome by mixing $s$-coordinate and step-like representation of bottom topography \citep{Gerdes1993a,Gerdes1993b,Madec_al_JPO96}. However, the definition of the model 
+domain vertical coordinate becomes then a non-trivial thing for a realistic bottom 
+topography: a envelope topography is defined in $s$-coordinate on which a full or 
+partial step bottom topography is then applied in order to adjust the model depth to 
+the observed one (see \S\ref{DOM_zgr}.
+
+For numerical reasons a minimum of diffusion is required along the coordinate surfaces 
+of any finite difference model. It causes spurious diapycnal mixing when coordinate 
+surfaces do not coincide with isoneutral surfaces. This is the case for a $z$-model as 
+well as for a $s$-model. However, density varies more strongly on $s-$surfaces than 
+on horizontal surfaces in regions of large topographic slopes, implying larger diapycnal 
+diffusion in a $s$-model than in a $z$-model. Whereas such a diapycnal diffusion in a 
+$z$-model tends to weaken horizontal density (pressure) gradients and thus the horizontal 
+circulation, it usually reinforces these gradients in a $s$-model, creating spurious circulation. 
+For example, imagine an isolated bump of topography in an ocean at rest with a horizontally 
+uniform stratification. Spurious diffusion along $s$-surfaces will induce a bump of isoneutral 
+surfaces over the topography, and thus will generate there a baroclinic eddy. In contrast, 
+the ocean will stay at rest in a $z$-model. As for the truncation error, the problem can be reduced by introducing the terrain-following coordinate below the strongly stratified portion of the water column 
+($i.e.$ the main thermocline) \citep{Madec_al_JPO96}. An alternate solution consists of rotating 
+the lateral diffusive tensor to geopotential or to isoneutral surfaces (see \S\ref{PE_ldf}. 
+Unfortunately, the slope of isoneutral surfaces relative to the $s$-surfaces can very large, 
+strongly exceeding the stability limit of such a operator when it is discretized (see Chapter~\ref{LDF}). 
+
+The $s-$coordinates introduced here \citep{Lott_al_OM90,Madec_al_JPO96} differ mainly in two 
+aspects from similar models:  it allows  a representation of bottom topography with mixed 
+full or partial step-like/terrain following topography ; It also offers a completely general 
+transformation, $s=s(i,j,z)$ for the vertical coordinate.
+
+
+\newpage 
+% -------------------------------------------------------------------------------------------------------------
+% Curvilinear z-tilde coordinate System
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Curvilinear $\tilde{z}$--coordinate}
+\label{PE_zco_tilde}
+
+The $\tilde{z}$-coordinate has been developed by \citet{Leclair_Madec_OM11}.
+It is available in \NEMO since the version 3.4. Nevertheless, it is currently not robust enough 
+to be used in all possible configurations. Its use is therefore not recommended.
+
+
+\newpage 
+% ================================================================
+% Subgrid Scale Physics
+% ================================================================
+\section{Subgrid Scale Physics}
+\label{PE_zdf_ldf}
+
+The primitive equations describe the behaviour of a geophysical fluid at 
+space and time scales larger than a few kilometres in the horizontal, a few 
+meters in the vertical and a few minutes. They are usually solved at larger 
+scales: the specified grid spacing and time step of the numerical model. The 
+effects of smaller scale motions (coming from the advective terms in the 
+Navier-Stokes equations) must be represented entirely in terms of 
+large-scale patterns to close the equations. These effects appear in the 
+equations as the divergence of turbulent fluxes ($i.e.$ fluxes associated with 
+the mean correlation of small scale perturbations). Assuming a turbulent 
+closure hypothesis is equivalent to choose a formulation for these fluxes. 
+It is usually called the subgrid scale physics. It must be emphasized that 
+this is the weakest part of the primitive equations, but also one of the 
+most important for long-term simulations as small scale processes \textit{in fine} 
+balance the surface input of kinetic energy and heat.
+
+The control exerted by gravity on the flow induces a strong anisotropy 
+between the lateral and vertical motions. Therefore subgrid-scale physics  
+\textbf{D}$^{\vect{U}}$, $D^{S}$ and $D^{T}$  in \eqref{Eq_PE_dyn}, 
+\eqref{Eq_PE_tra_T} and \eqref{Eq_PE_tra_S} are divided into a lateral part  
+\textbf{D}$^{l \vect{U}}$, $D^{lS}$ and $D^{lT}$ and a vertical part  
+\textbf{D}$^{vU}$, $D^{vS}$ and $D^{vT}$. The formulation of these terms 
+and their underlying physics are briefly discussed in the next two subsections.
+
+% -------------------------------------------------------------------------------------------------------------
+% Vertical Subgrid Scale Physics
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Vertical Subgrid Scale Physics}
+\label{PE_zdf}
+
+The model resolution is always larger than the scale at which the major 
+sources of vertical turbulence occur (shear instability, internal wave 
+breaking...). Turbulent motions are thus never explicitly solved, even 
+partially, but always parameterized. The vertical turbulent fluxes are 
+assumed to depend linearly on the gradients of large-scale quantities (for 
+example, the turbulent heat flux is given by $\overline{T'w'}=-A^{vT} \partial_z \overline T$, 
+where $A^{vT}$ is an eddy coefficient). This formulation is 
+analogous to that of molecular diffusion and dissipation. This is quite 
+clearly a necessary compromise: considering only the molecular viscosity 
+acting on large scale severely underestimates the role of turbulent 
+diffusion and dissipation, while an accurate consideration of the details of 
+turbulent motions is simply impractical. The resulting vertical momentum and 
+tracer diffusive operators are of second order:
+\begin{equation} \label{Eq_PE_zdf}
+   \begin{split}
+{\vect{D}}^{v \vect{U}} &=\frac{\partial }{\partial z}\left( {A^{vm}\frac{\partial {\vect{U}}_h }{\partial z}} \right) \ , \\         
+D^{vT}                         &= \frac{\partial }{\partial z}\left( {A^{vT}\frac{\partial T}{\partial z}} \right) \ ,
+\quad
+D^{vS}=\frac{\partial }{\partial z}\left( {A^{vT}\frac{\partial S}{\partial z}} \right)
+   \end{split}
+\end{equation}
+where $A^{vm}$ and $A^{vT}$ are the vertical eddy viscosity and diffusivity coefficients, 
+respectively. At the sea surface and at the bottom, turbulent fluxes of momentum, heat 
+and salt must be specified (see Chap.~\ref{SBC} and \ref{ZDF} and \S\ref{TRA_bbl}). 
+All the vertical physics is embedded in the specification of the eddy coefficients. 
+They can be assumed to be either constant, or function of the local fluid properties 
+($e.g.$ Richardson number, Brunt-Vais\"{a}l\"{a} frequency...), or computed from a 
+turbulent closure model. The choices available in \NEMO are discussed in \S\ref{ZDF}).
+
+% -------------------------------------------------------------------------------------------------------------
+% Lateral Diffusive and Viscous Operators Formulation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Formulation of the Lateral Diffusive and Viscous Operators}
+\label{PE_ldf}
+
+Lateral turbulence can be roughly divided into a mesoscale turbulence 
+associated with eddies (which can be solved explicitly if the resolution is 
+sufficient since their underlying physics are included in the primitive 
+equations), and a sub mesoscale turbulence which is never explicitly solved 
+even partially, but always parameterized. The formulation of lateral eddy 
+fluxes depends on whether the mesoscale is below or above the grid-spacing 
+($i.e.$ the model is eddy-resolving or not).
+
+In non-eddy-resolving configurations, the closure is similar to that used 
+for the vertical physics. The lateral turbulent fluxes are assumed to depend 
+linearly on the lateral gradients of large-scale quantities. The resulting 
+lateral diffusive and dissipative operators are of second order. 
+Observations show that lateral mixing induced by mesoscale turbulence tends 
+to be along isopycnal surfaces (or more precisely neutral surfaces \cite{McDougall1987}) 
+rather than across them. 
+As the slope of neutral surfaces is small in the ocean, a common 
+approximation is to assume that the `lateral' direction is the horizontal, 
+$i.e.$ the lateral mixing is performed along geopotential surfaces. This leads 
+to a geopotential second order operator for lateral subgrid scale physics. 
+This assumption can be relaxed: the eddy-induced turbulent fluxes can be 
+better approached by assuming that they depend linearly on the gradients of 
+large-scale quantities computed along neutral surfaces. In such a case, 
+the diffusive operator is an isoneutral second order operator and it has 
+components in the three space directions. However, both horizontal and 
+isoneutral operators have no effect on mean ($i.e.$ large scale) potential 
+energy whereas potential energy is a main source of turbulence (through 
+baroclinic instabilities). \citet{Gent1990} have proposed a 
+parameterisation of mesoscale eddy-induced turbulence which associates an 
+eddy-induced velocity to the isoneutral diffusion. Its mean effect is to 
+reduce the mean potential energy of the ocean. This leads to a formulation 
+of lateral subgrid-scale physics made up of an isoneutral second order 
+operator and an eddy induced advective part. In all these lateral diffusive 
+formulations, the specification of the lateral eddy coefficients remains the 
+problematic point as there is no really satisfactory formulation of these 
+coefficients as a function of large-scale features.
+
+In eddy-resolving configurations, a second order operator can be used, but 
+usually the more scale selective biharmonic operator is preferred as the 
+grid-spacing is usually not small enough compared to the scale of the 
+eddies. The role devoted to the subgrid-scale physics is to dissipate the 
+energy that cascades toward the grid scale and thus to ensure the stability of 
+the model while not interfering with the resolved mesoscale activity. Another approach 
+is becoming more and more popular: instead of specifying explicitly a sub-grid scale 
+term in the momentum and tracer time evolution equations, one uses a advective 
+scheme which is diffusive enough to maintain the model stability. It must be emphasised
+that then, all the sub-grid scale physics is included in the formulation of the
+advection scheme. 
+
+All these parameterisations of subgrid scale physics have advantages and 
+drawbacks. There are not all available in \NEMO. For active tracers (temperature and 
+salinity) the main ones are: Laplacian and bilaplacian operators acting along 
+geopotential or iso-neutral surfaces, \citet{Gent1990} parameterisation, 
+and various slightly diffusive advection schemes. 
+For momentum, the main ones are: Laplacian and bilaplacian operators acting along 
+geopotential surfaces, and UBS advection schemes when flux form is chosen for the momentum advection.
+
+\subsubsection{Lateral Laplacian tracer diffusive operator}
+
+The lateral Laplacian tracer diffusive operator is defined by (see Appendix~\ref{Apdx_B}):
+\begin{equation} \label{Eq_PE_iso_tensor}
+D^{lT}=\nabla {\rm {\bf .}}\left( {A^{lT}\;\Re \;\nabla T} \right) \qquad 
+\mbox{with}\quad \;\;\Re =\left( {{\begin{array}{*{20}c}
+ 1 \hfill & 0 \hfill & {-r_1 } \hfill \\
+ 0 \hfill & 1 \hfill & {-r_2 } \hfill \\
+ {-r_1 } \hfill & {-r_2 } \hfill & {r_1 ^2+r_2 ^2} \hfill \\
+\end{array} }} \right)
+\end{equation}
+where $r_1 \;\mbox{and}\;r_2 $ are the slopes between the surface along 
+which the diffusive operator acts and the model level ($e. g.$ $z$- or 
+$s$-surfaces). Note that the formulation \eqref{Eq_PE_iso_tensor} is exact for the 
+rotation between geopotential and $s$-surfaces, while it is only an approximation 
+for the rotation between isoneutral and $z$- or $s$-surfaces. Indeed, in the latter 
+case, two assumptions are made to simplify  \eqref{Eq_PE_iso_tensor} \citep{Cox1987}. 
+First, the horizontal contribution of the dianeutral mixing is neglected since the ratio 
+between iso and dia-neutral diffusive coefficients is known to be several orders of 
+magnitude smaller than unity. Second, the two isoneutral directions of diffusion are 
+assumed to be independent since the slopes are generally less than $10^{-2}$ in the 
+ocean (see Appendix~\ref{Apdx_B}).
+
+For \textit{iso-level} diffusion, $r_1$ and $r_2 $ are zero. $\Re $ reduces to the identity 
+in the horizontal direction, no rotation is applied. 
+
+For \textit{geopotential} diffusion, $r_1$ and $r_2 $ are the slopes between the 
+geopotential and computational surfaces: they are equal to $\sigma _1$ and $\sigma _2$, 
+respectively (see \eqref{Eq_PE_sco_slope} ).
+
+For \textit{isoneutral} diffusion $r_1$ and $r_2$ are the slopes between the isoneutral 
+and computational surfaces. Therefore, they are different quantities,
+but have similar expressions in $z$- and $s$-coordinates. In $z$-coordinates:
+\begin{equation} \label{Eq_PE_iso_slopes}
+r_1 =\frac{e_3 }{e_1 }	\left( \pd[\rho]{i} \right) \left( \pd[\rho]{k} \right)^{-1} \, \quad
+r_2 =\frac{e_3 }{e_2 }	\left( \pd[\rho]{j} \right) \left( \pd[\rho]{k} \right)^{-1} \,
+\end{equation}
+while in $s$-coordinates $\pd[]{k}$ is replaced by $\pd[]{s}$.
+
+\subsubsection{Eddy induced velocity}
+ When the \textit{eddy induced velocity} parametrisation (eiv) \citep{Gent1990} is used, 
+an additional tracer advection is introduced in combination with the isoneutral diffusion of tracers:
+\begin{equation} \label{Eq_PE_iso+eiv}
+D^{lT}=\nabla \cdot \left( {A^{lT}\;\Re \;\nabla T} \right)
+           +\nabla \cdot \left( {{\vect{U}}^\ast \,T} \right)
+\end{equation}
+where ${\vect{U}}^\ast =\left( {u^\ast ,v^\ast ,w^\ast } \right)$ is a non-divergent, 
+eddy-induced transport velocity. This velocity field is defined by:
+\begin{equation} \label{Eq_PE_eiv}
+   \begin{split}
+ u^\ast  &= +\frac{1}{e_3       }\frac{\partial }{\partial k}\left[ {A^{eiv}\;\tilde{r}_1 } \right] \\ 
+ v^\ast  &= +\frac{1}{e_3       }\frac{\partial }{\partial k}\left[ {A^{eiv}\;\tilde{r}_2 } \right] \\ 
+ w^\ast &=  -\frac{1}{e_1 e_2 }\left[ 
+                      \frac{\partial }{\partial i}\left( {A^{eiv}\;e_2\,\tilde{r}_1 } \right)
+                     +\frac{\partial }{\partial j}\left( {A^{eiv}\;e_1\,\tilde{r}_2 } \right)      \right]
+   \end{split}
+\end{equation}
+where $A^{eiv}$ is the eddy induced velocity coefficient (or equivalently the isoneutral 
+thickness diffusivity coefficient), and $\tilde{r}_1$ and $\tilde{r}_2$ are the slopes 
+between isoneutral and \emph{geopotential} surfaces. Their values are
+thus independent of the vertical coordinate, but their expression depends on the coordinate: 
+\begin{align} \label{Eq_PE_slopes_eiv}
+\tilde{r}_n = \begin{cases}
+   r_n            &      \text{in $z$-coordinate}    \\
+   r_n + \sigma_n &      \text{in \textit{z*} and $s$-coordinates}  
+              \end{cases}
+\quad \text{where } n=1,2
+\end{align}
+
+The normal component of the eddy induced velocity is zero at all the boundaries. 
+This can be achieved in a model by tapering either the eddy coefficient or the slopes 
+to zero in the vicinity of the boundaries. The latter strategy is used in \NEMO (cf. Chap.~\ref{LDF}).
+
+\subsubsection{Lateral bilaplacian tracer diffusive operator}
+
+The lateral bilaplacian tracer diffusive operator is defined by:
+\begin{equation} \label{Eq_PE_bilapT}
+D^{lT}= - \Delta \left( \;\Delta T \right) 
+\qquad \text{where} \;\; \Delta \bullet = \nabla \left( {\sqrt{B^{lT}\,}\;\Re \;\nabla \bullet} \right)
+ \end{equation}
+It is the Laplacian operator given by \eqref{Eq_PE_iso_tensor} applied twice with 
+the harmonic eddy diffusion coefficient set to the square root of the biharmonic one. 
+
+
+\subsubsection{Lateral Laplacian momentum diffusive operator}
+
+The Laplacian momentum diffusive operator along $z$- or $s$-surfaces is found by 
+applying \eqref{Eq_PE_lap_vector} to the horizontal velocity vector (see Appendix~\ref{Apdx_B}):
+\begin{equation} \label{Eq_PE_lapU}
+\begin{split}
+{\rm {\bf D}}^{l{\rm {\bf U}}} 
+&= \quad \  \nabla _h \left( {A^{lm}\chi } \right)
+   \ - \ \nabla _h \times \left( {A^{lm}\,\zeta \;{\rm {\bf k}}} \right)     \\
+&=   \left(      \begin{aligned}
+             \frac{1}{e_1      } \frac{\partial \left( A^{lm} \chi          \right)}{\partial i} 
+         &-\frac{1}{e_2 e_3}\frac{\partial \left( {A^{lm} \;e_3 \zeta} \right)}{\partial j}  \\
+             \frac{1}{e_2      }\frac{\partial \left( {A^{lm} \chi         } \right)}{\partial j}   
+         &+\frac{1}{e_1 e_3}\frac{\partial \left( {A^{lm} \;e_3 \zeta} \right)}{\partial i}
+        \end{aligned}    \right)
+\end{split}
+\end{equation}
+
+Such a formulation ensures a complete separation between the vorticity and 
+horizontal divergence fields (see Appendix~\ref{Apdx_C}). 
+Unfortunately, it is only available in \textit{iso-level} direction. 
+When a rotation is required ($i.e.$ geopotential diffusion in $s-$coordinates 
+or isoneutral diffusion in both $z$- and $s$-coordinates), the $u$ and $v-$fields 
+are considered as independent scalar fields, so that the diffusive operator is given by:
+\begin{equation} \label{Eq_PE_lapU_iso}
+\begin{split}
+ D_u^{l{\rm {\bf U}}} &= \nabla .\left( {A^{lm} \;\Re \;\nabla u} \right) \\ 
+ D_v^{l{\rm {\bf U}}} &= \nabla .\left( {A^{lm} \;\Re \;\nabla v} \right)
+ \end{split}
+ \end{equation}
+where $\Re$ is given by  \eqref{Eq_PE_iso_tensor}. It is the same expression as 
+those used for diffusive operator on tracers. It must be emphasised that such a 
+formulation is only exact in a Cartesian coordinate system, $i.e.$ on a $f-$ or 
+$\beta-$plane, not on the sphere. It is also a very good approximation in vicinity 
+of the Equator in a geographical coordinate system \citep{Lengaigne_al_JGR03}.
+
+\subsubsection{lateral bilaplacian momentum diffusive operator}
+
+As for tracers, the bilaplacian order momentum diffusive operator is a 
+re-entering Laplacian operator with the harmonic eddy diffusion coefficient 
+set to the square root of the biharmonic one. Nevertheless it is currently 
+not available in the iso-neutral case.
+
+\end{document}
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 8732)
@@ -0,0 +1,260 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter 1 ——— Model Basics
+% ================================================================
+% ================================================================
+% Curvilinear z*- s*-coordinate System
+% ================================================================
+\chapter{ essai z* s*}
+\section{Curvilinear \textit{z*}- or \textit{s*} coordinate System}
+
+% -------------------------------------------------------------------------------------------------------------
+% ????
+% -------------------------------------------------------------------------------------------------------------
+
+\colorbox{yellow}{ to be updated }
+
+In that case, the free surface equation is nonlinear, and the variations of 
+volume are fully taken into account. These coordinates systems is presented in 
+a report \citep{Levier2007} available on the \NEMO web site. 
+
+\colorbox{yellow}{  end of to be updated}
+\newline
+
+% from MOM4p1 documentation
+
+To overcome problems with vanishing surface and/or bottom cells, we consider the 
+zstar coordinate 
+\begin{equation} \label{PE_}
+	z^\star = H \left( \frac{z-\eta}{H+\eta} \right)
+\end{equation}
+
+This coordinate is closely related to the "eta" coordinate used in many atmospheric 
+models (see Black (1994) for a review of eta coordinate atmospheric models). It 
+was originally used in ocean models by Stacey et al. (1995) for studies of tides 
+next to shelves, and it has been recently promoted by Adcroft and Campin (2004) 
+for global climate modelling.
+
+The surfaces of constant $z^\star$ are quasi-horizontal. Indeed, the $z^\star$ coordinate reduces to $z$ when $\eta$ is zero. In general, when noting the large differences between 
+undulations of the bottom topography versus undulations in the surface height, it 
+is clear that surfaces constant $z^\star$ are very similar to the depth surfaces. These properties greatly reduce difficulties of computing the horizontal pressure gradient relative to terrain following sigma models discussed in \S\ref{PE_sco}. 
+Additionally, since $z^\star$ when $\eta = 0$, no flow is spontaneously generated in an 
+unforced ocean starting from rest, regardless the bottom topography. This behaviour is in contrast to the case with "s"-models, where pressure gradient errors in 
+the presence of nontrivial topographic variations can generate nontrivial spontaneous flow from a resting state, depending on the sophistication of the pressure 
+gradient solver. The quasi-horizontal nature of the coordinate surfaces also facilitates the implementation of neutral physics parameterizations in $z^\star$ models using 
+the same techniques as in $z$-models (see Chapters 13-16 of Griffies (2004) for a 
+discussion of neutral physics in $z$-models, as well as Section \S\ref{LDF_slp} 
+in this document for treatment in \NEMO). 
+
+The range over which $z^\star$ varies is time independent $-H \leq z^\star \leq 0$. Hence, all 
+cells remain nonvanishing, so long as the surface height maintains $\eta > ?H$. This 
+is a minor constraint relative to that encountered on the surface height when using 
+$s = z$ or $s = z - \eta$. 
+
+Because $z^\star$ has a time independent range, all grid cells have static increments 
+ds, and the sum of the ver tical increments yields the time independent ocean 
+depth %�k ds = H. 
+The $z^\star$ coordinate is therefore invisible to undulations of the 
+free surface, since it moves along with the free surface. This proper ty means that 
+no spurious ver tical transpor t is induced across surfaces of constant $z^\star$ by the 
+motion of external gravity waves. Such spurious transpor t can be a problem in 
+z-models, especially those with tidal forcing. Quite generally, the time independent 
+range for the $z^\star$ coordinate is a very convenient proper ty that allows for a nearly 
+arbitrary ver tical resolution even in the presence of large amplitude fluctuations of 
+the surface height, again so long as $\eta > -H$. 
+
+
+
+%%%
+%  essai update time splitting...
+%%%
+
+
+% ================================================================
+% Surface Pressure Gradient and Sea Surface Height
+% ================================================================
+\section{Surface pressure gradient and Sea Surface Heigth (\mdl{dynspg})}
+\label{DYN_hpg_spg}
+%-----------------------------------------nam_dynspg----------------------------------------------------
+\namdisplay{nam_dynspg} 
+%------------------------------------------------------------------------------------------------------------
+Options are defined through the  \ngn{nam\_dynspg} namelist variables.
+The surface pressure gradient term is related to the representation of the free surface (\S\ref{PE_hor_pg}). The main distinction is between the fixed volume case (linear free surface or rigid lid) and the variable volume case (nonlinear free surface, \key{vvl} is active). In the linear free surface case (\S\ref{PE_free_surface}) and rigid lid (\S\ref{PE_rigid_lid}), the vertical scale factors $e_{3}$ are fixed in time, while in the nonlinear case (\S\ref{PE_free_surface}) they are time-dependent. With both linear and nonlinear free surface, external gravity waves are allowed in the equations, which imposes a very small time step when an explicit time stepping is used. Two methods are proposed to allow a longer time step for the three-dimensional equations: the filtered free surface, which is a modification of the continuous equations (see \eqref{Eq_PE_flt}), and the split-explicit free surface described below. The extra term introduced in the filtered method is calculated implicitly, so that the update of the next velocities is done in module \mdl{dynspg\_flt} and not in \mdl{dynnxt}.
+
+%-------------------------------------------------------------
+% Explicit
+%-------------------------------------------------------------
+\subsubsection{Explicit (\key{dynspg\_exp})}
+\label{DYN_spg_exp}
+
+In the explicit free surface formulation, the model time step is chosen small enough to describe the external gravity waves (typically a few ten seconds). The sea surface height is given by :
+\begin{equation} \label{Eq_dynspg_ssh}
+\frac{\partial \eta }{\partial t}\equiv \frac{\text{EMP}}{\rho _w }+\frac{1}{e_{1T} 
+e_{2T} }\sum\limits_k {\left( {\delta _i \left[ {e_{2u} e_{3u} u} 
+\right]+\delta _j \left[ {e_{1v} e_{3v} v} \right]} \right)} 
+\end{equation}
+
+where EMP is the surface freshwater budget (evaporation minus precipitation, and minus river runoffs (if the later are introduced as a surface freshwater flux, see \S\ref{SBC}) expressed in $Kg.m^{-2}.s^{-1}$, and $\rho _w =1,000\,Kg.m^{-3}$ is the volumic mass of pure water. The sea-surface height is evaluated using a leapfrog scheme in combination with an Asselin time filter, i.e. the velocity appearing in (\ref{Eq_dynspg_ssh}) is centred in time (\textit{now} velocity). 
+
+The surface pressure gradient, also evaluated using a leap-frog scheme, is then simply given by :
+\begin{equation} \label{Eq_dynspg_exp}
+\left\{ \begin{aligned}
+ - \frac{1}    						{e_{1u}} \;	\delta _{i+1/2} \left[  \,\eta\,  \right] 	\\
+ \\
+ - \frac{1}    						{e_{2v}} \;	\delta _{j+1/2} \left[  \,\eta\,  \right]  
+\end{aligned} \right.
+\end{equation} 
+
+Consistent with the linearization, a $\left. \rho \right|_{k=1} / \rho _o$ factor is omitted in (\ref{Eq_dynspg_exp}). 
+
+%-------------------------------------------------------------
+% Split-explicit time-stepping
+%-------------------------------------------------------------
+\subsubsection{Split-explicit time-stepping (\key{dynspg\_ts})}
+\label{DYN_spg_ts}
+%--------------------------------------------namdom----------------------------------------------------
+\namdisplay{namdom} 
+%--------------------------------------------------------------------------------------------------------------
+The split-explicit free surface formulation used in OPA follows the one proposed by \citet{Griffies2004}. The general idea is to solve the free surface equation with a small time step, while the three dimensional prognostic variables are solved with a longer time step that is a multiple of \np{rdtbt}
+in the  \ngn{namdom} namelist. 
+(Figure III.3). 
+
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+\begin{figure}[!t] 	\begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_DYN_dynspg_ts}
+\caption{	 \label{Fig_DYN_dynspg_ts}
+Schematic of the split-explicit time stepping scheme for the barotropic and baroclinic modes, 
+after \citet{Griffies2004}. Time increases to the right. Baroclinic time steps are denoted by 
+$t-\Delta t$, $t, t+\Delta t$, and $t+2\Delta t$. The curved line represents a leap-frog time step, 
+and the smaller barotropic time steps $N \Delta t=2\Delta t$ are denoted by the zig-zag line. 
+The vertically integrated forcing \textbf{M}(t) computed at baroclinic time step t represents 
+the interaction between the barotropic and baroclinic motions. While keeping the total depth, 
+tracer, and freshwater forcing fields fixed, a leap-frog integration carries the surface height 
+and vertically integrated velocity from t to $t+2 \Delta t$ using N barotropic time steps of length 
+$\Delta t$. Time averaging the barotropic fields over the N+1 time steps (endpoints included) 
+centers the vertically integrated velocity at the baroclinic timestep $t+\Delta t$. 
+A baroclinic leap-frog time step carries the surface height to $t+\Delta t$ using the convergence 
+of the time averaged vertically integrated velocity taken from baroclinic time step t. }
+\end{center}
+\end{figure}
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+
+The split-explicit formulation has a damping effect on external gravity waves, which is weaker than the filtered free surface but still significant as shown by \citet{Levier2007} in the case of an analytical barotropic Kelvin wave. 
+
+%from griffies book: .....   copy past !
+
+\textbf{title: Time stepping the barotropic system }
+
+Assume knowledge of the full velocity and tracer fields at baroclinic time $\tau$. Hence, 
+we can update the surface height and vertically integrated velocity with a leap-frog 
+scheme using the small barotropic time step $\Delta t$. We have 
+
+\begin{equation} \label{DYN_spg_ts_eta}
+\eta^{(b)}(\tau,t_{n+1}) - \eta^{(b)}(\tau,t_{n+1}) (\tau,t_{n-1})
+	= 2 \Delta t \left[-\nabla \cdot \textbf{U}^{(b)}(\tau,t_n) + \text{EMP}_w(\tau) \right] 
+\end{equation}
+\begin{multline} \label{DYN_spg_ts_u}
+\textbf{U}^{(b)}(\tau,t_{n+1}) - \textbf{U}^{(b)}(\tau,t_{n-1})  \\
+	= 2\Delta t \left[ - f \textbf{k} \times \textbf{U}^{(b)}(\tau,t_{n}) 
+	- H(\tau) \nabla p_s^{(b)}(\tau,t_{n}) +\textbf{M}(\tau) \right]
+\end{multline}
+\
+
+In these equations, araised (b) denotes values of surface height and vertically integrated velocity updated with the barotropic time steps. The $\tau$ time label on $\eta^{(b)}$ 
+and $U^{(b)}$ denotes the baroclinic time at which the vertically integrated forcing $\textbf{M}(\tau)$ (note that this forcing includes the surface freshwater forcing), the tracer fields, the freshwater flux $\text{EMP}_w(\tau)$, and total depth of the ocean $H(\tau)$ are held for the duration of the barotropic time stepping over a single cycle. This is also the time 
+that sets the barotropic time steps via 
+\begin{equation} \label{DYN_spg_ts_t}
+t_n=\tau+n\Delta t   
+\end{equation}
+with $n$ an integer. The density scaled surface pressure is evaluated via 
+\begin{equation} \label{DYN_spg_ts_ps}
+p_s^{(b)}(\tau,t_{n}) = \begin{cases}
+	g \;\eta_s^{(b)}(\tau,t_{n}) \;\rho(\tau)_{k=1}) / \rho_o  &      \text{non-linear case} \\
+	g \;\eta_s^{(b)}(\tau,t_{n})  &      \text{linear case} 
+	\end{cases}
+\end{equation}
+To get started, we assume the following initial conditions 
+\begin{equation} \label{DYN_spg_ts_eta}
+\begin{split}
+\eta^{(b)}(\tau,t_{n=0}) &= \overline{\eta^{(b)}(\tau)}
+\\
+\eta^{(b)}(\tau,t_{n=1}) &= \eta^{(b)}(\tau,t_{n=0}) + \Delta t \ \text{RHS}_{n=0} 
+\end{split}
+\end{equation}
+with 
+\begin{equation} \label{DYN_spg_ts_etaF}
+ \overline{\eta^{(b)}(\tau)} = \frac{1}{N+1} \sum\limits_{n=0}^N \eta^{(b)}(\tau-\Delta t,t_{n})
+\end{equation}
+the time averaged surface height taken from the previous barotropic cycle. Likewise, 
+\begin{equation} \label{DYN_spg_ts_u}
+\textbf{U}^{(b)}(\tau,t_{n=0}) = \overline{\textbf{U}^{(b)}(\tau)}	\\
+\\
+\textbf{U}(\tau,t_{n=1}) = \textbf{U}^{(b)}(\tau,t_{n=0}) + \Delta t \ \text{RHS}_{n=0}  	
+\end{equation}
+with 
+\begin{equation} \label{DYN_spg_ts_u}
+ \overline{\textbf{U}^{(b)}(\tau)} 
+ 	= \frac{1}{N+1} \sum\limits_{n=0}^N\textbf{U}^{(b)}(\tau-\Delta t,t_{n})
+\end{equation}
+the time averaged vertically integrated transport. Notably, there is no Robert-Asselin time filter used in the barotropic portion of the integration. 
+
+Upon reaching $t_{n=N} = \tau + 2\Delta \tau$ , the vertically integrated velocity is time averaged to produce the updated vertically integrated velocity at baroclinic time $\tau + \Delta \tau$ 
+\begin{equation} \label{DYN_spg_ts_u}
+\textbf{U}(\tau+\Delta t) = \overline{\textbf{U}^{(b)}(\tau+\Delta t)} 
+ 	= \frac{1}{N+1} \sum\limits_{n=0}^N\textbf{U}^{(b)}(\tau,t_{n})
+\end{equation}
+The surface height on the new baroclinic time step is then determined via a baroclinic leap-frog using the following form 
+
+\begin{equation} \label{DYN_spg_ts_ssh}
+\eta(\tau+\Delta) - \eta^{F}(\tau-\Delta) = 2\Delta t \ \left[ - \nabla \cdot \textbf{U}(\tau) + \text{EMP}_w \right]  
+\end{equation}
+
+ The use of this "big-leap-frog" scheme for the surface height ensures compatibility between the mass/volume budgets and the tracer budgets. More discussion of this point is provided in Chapter 10 (see in particular Section 10.2). 
+ 
+In general, some form of time filter is needed to maintain integrity of the surface 
+height field due to the leap-frog splitting mode in equation \ref{DYN_spg_ts_ssh}. We 
+have tried various forms of such filtering, with the following method discussed in 
+Griffies et al. (2001) chosen due to its stability and reasonably good maintenance of 
+tracer conservation properties (see Section ??) 
+
+\begin{equation} \label{DYN_spg_ts_sshf}
+\eta^{F}(\tau-\Delta) =  \overline{\eta^{(b)}(\tau)} 
+\end{equation}
+Another approach tried was 
+
+\begin{equation} \label{DYN_spg_ts_sshf2}
+\eta^{F}(\tau-\Delta) = \eta(\tau) 
+	+ (\alpha/2) \left[\overline{\eta^{(b)}}(\tau+\Delta t)
+				    + \overline{\eta^{(b)}}(\tau-\Delta t) -2 \;\eta(\tau) \right]
+\end{equation}
+
+which is useful since it isolates all the time filtering aspects into the term multiplied 
+by $\alpha$. This isolation allows for an easy check that tracer conservation is exact when 
+eliminating tracer and surface height time filtering (see Section ?? for more complete discussion). However, in the general case with a non-zero $\alpha$, the filter \ref{DYN_spg_ts_sshf} was found to be more conservative, and so is recommended. 
+
+
+
+
+
+%-------------------------------------------------------------
+% Filtered formulation 
+%-------------------------------------------------------------
+\subsubsection{Filtered formulation (\key{dynspg\_flt})}
+\label{DYN_spg_flt}
+
+The filtered formulation follows the \citet{Roullet2000} implementation. The extra term introduced in the equations (see {\S}I.2.2) is solved implicitly. The elliptic solvers available in the code are 
+documented in \S\ref{MISC}. The amplitude of the extra term is given by the namelist variable \np{rnu}. The default value is 1, as recommended by \citet{Roullet2000}
+
+\colorbox{red}{\np{rnu}=1 to be suppressed from namelist !}
+
+%-------------------------------------------------------------
+% Non-linear free surface formulation 
+%-------------------------------------------------------------
+\subsection{Non-linear free surface formulation (\key{vvl})}
+\label{DYN_spg_vvl}
+
+In the non-linear free surface formulation, the variations of volume are fully taken into account. This option is presented in a report \citep{Levier2007} available on the NEMO web site. The three time-stepping methods (explicit, split-explicit and filtered) are the same as in \S\ref{DYN_spg_linear} except that the ocean depth is now time-dependent. In particular, this means that in filtered case, the matrix to be inverted has to be recomputed at each time-step.
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_OBS.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_OBS.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_OBS.tex	(revision 8732)
@@ -0,0 +1,1414 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter observation operator (OBS)
+% ================================================================
+\chapter{Observation and model comparison (OBS)}
+\label{OBS}
+
+Authors: D. Lea, M. Martin, K. Mogensen, A. Vidard, A. Weaver, A. Ryan, ...   % do we keep that ?
+
+\minitoc
+
+
+\newpage
+$\ $\newline    % force a new line
+
+The observation and model comparison code (OBS) reads in observation files (profile
+temperature and salinity, sea surface temperature, sea level anomaly, sea ice concentration,
+and velocity) and calculates  an interpolated model equivalent value at the observation
+location and nearest model timestep. The resulting data are saved in a ``feedback'' file (or
+files). The code was originally developed for use with the NEMOVAR data assimilation code, but
+can be used for validation or verification of the model or with any other data assimilation system.
+
+The OBS code is called from \mdl{nemogcm} for model initialisation and to calculate the model
+equivalent values for observations on the 0th timestep. The code is then called again after
+each timestep from \mdl{step}. The code is only activated if the namelist logical \np{ln\_diaobs}
+is set to true.
+
+For all data types a 2D horizontal  interpolator is needed to interpolate the model fields to
+the observation location. For {\em in situ} profiles, a 1D vertical interpolator is needed in
+addition to provide model fields at the observation depths. Currently this only works in
+z-level model configurations, but is being developed to work with a generalised vertical
+coordinate system. 
+
+Some profile observation types (e.g. tropical moored buoys) are made available as daily averaged quantities.
+The observation operator code can be set-up to calculated the equivalent daily average model temperature fields
+using the \np{nn\_profdavtypes} namelist array. Some SST observations are equivalent to a night-time
+average value and the observation operator code can calculate equivalent night-time average model SST fields by
+setting the namelist value \np{ln\_sstnight} to true. Otherwise the model value from the nearest timestep to the
+observation time is used.
+
+The code is controlled by the namelist \textit{nam\_obs}. See the following sections for more
+details on setting up the namelist.
+
+Section~\ref{OBS_example} introduces a test example of the observation operator code including
+where to obtain data and how to setup the namelist. Section~\ref{OBS_details} introduces some
+more technical details of the different observation types used and also shows a more complete
+namelist. Section~\ref{OBS_theory} introduces some of the theoretical aspects of the observation
+operator including interpolation methods and running on multiple processors.
+Section~\ref{OBS_ooo} describes the offline observation operator code.
+Section~\ref{OBS_obsutils} introduces some utilities to help working with the files
+produced by the OBS code.
+
+% ================================================================
+% Example
+% ================================================================
+\section{Running the observation operator code example}
+\label{OBS_example}
+
+This section describes an example of running the observation operator code using
+profile data which can be freely downloaded. It shows how to adapt an
+existing run and build of NEMO to run the observation operator.
+
+\begin{enumerate}
+\item Compile NEMO.
+
+\item Download some EN4 data from 
+\href{http://www.metoffice.gov.uk/hadobs}{http://www.metoffice.gov.uk/hadobs}. Choose observations which are
+valid for the period of your test run because the observation operator compares
+the model and observations for a matching date and time. 
+
+\item Compile the OBSTOOLS code using: 
+\begin{verbatim}
+./maketools -n OBSTOOLS -m [ARCH].
+\end{verbatim}
+
+\item Convert the EN4 data into feedback format: 
+\begin{verbatim}
+enact2fb.exe profiles_01.nc EN.4.1.1.f.profiles.g10.YYYYMM.nc
+\end{verbatim}
+
+\item Include the following in the NEMO namelist to run the observation
+operator on this data:
+\end{enumerate}
+
+%------------------------------------------namobs_example-----------------------------------------------------
+\namdisplay{namobs_example}
+%-------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namobs} namelist variables.
+The options \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity
+profile observation operator code. The filename or array of filenames are
+specified using the \np{cn\_profbfiles} variable. The model grid points for a
+particular  observation latitude and longitude are found using the grid
+searching part of the code. This can be expensive, particularly for large
+numbers of observations, setting \np{ln\_grid\_search\_lookup} allows the use of
+a lookup table which is saved into an ``xypos`` file (or files). This will need
+to be generated the first time if it does not exist in the run directory.
+However, once produced it will significantly speed up future grid searches.
+Setting \np{ln\_grid\_global} means that the code distributes the observations
+evenly between processors. Alternatively each processor will work with
+observations located within the model subdomain (see section~\ref{OBS_parallel}).
+
+A number of utilities are now provided to plot the feedback files, convert and
+recombine the files. These are explained in more detail in section~\ref{OBS_obsutils}.
+Utilites to convert other input data formats into the feedback format are also 
+described in section~\ref{OBS_obsutils}.
+
+\section{Technical details}
+\label{OBS_details}
+
+Here we show a more complete example namelist  \ngn{namobs} and also show the NetCDF headers
+of the observation
+files that may be used with the observation operator
+
+%------------------------------------------namobs--------------------------------------------------------
+\namdisplay{namobs}
+%-------------------------------------------------------------------------------------------------------------
+
+The observation operator code uses the "feedback" observation file format for
+all data types. All the
+observation files must be in NetCDF format. Some example headers (produced using
+\mbox{\textit{ncdump~-h}}) for profile
+data, sea level anomaly and sea surface temperature are in the following
+subsections.
+
+\subsection{Profile feedback type observation file header}
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+netcdf profiles_01 {
+dimensions:
+     N_OBS = 603 ;
+     N_LEVELS = 150 ;
+     N_VARS = 2 ;
+     N_QCF = 2 ;
+     N_ENTRIES = 1 ;
+     N_EXTRA = 1 ;
+     STRINGNAM = 8 ;
+     STRINGGRID = 1 ;
+     STRINGWMO = 8 ;
+     STRINGTYP = 4 ;
+     STRINGJULD = 14 ;
+variables:
+     char VARIABLES(N_VARS, STRINGNAM) ;
+          VARIABLES:long_name = "List of variables in feedback files" ;
+     char ENTRIES(N_ENTRIES, STRINGNAM) ;
+          ENTRIES:long_name = "List of additional entries for each variable in feedback files" ;
+     char EXTRA(N_EXTRA, STRINGNAM) ;
+          EXTRA:long_name = "List of extra variables" ;
+     char STATION_IDENTIFIER(N_OBS, STRINGWMO) ;
+          STATION_IDENTIFIER:long_name = "Station identifier" ;
+     char STATION_TYPE(N_OBS, STRINGTYP) ;
+          STATION_TYPE:long_name = "Code instrument type" ;
+     double LONGITUDE(N_OBS) ;
+          LONGITUDE:long_name = "Longitude" ;
+          LONGITUDE:units = "degrees_east" ;
+          LONGITUDE:_Fillvalue = 99999.f ;
+     double LATITUDE(N_OBS) ;
+          LATITUDE:long_name = "Latitude" ;
+          LATITUDE:units = "degrees_north" ;
+          LATITUDE:_Fillvalue = 99999.f ;
+     double DEPTH(N_OBS, N_LEVELS) ;
+          DEPTH:long_name = "Depth" ;
+          DEPTH:units = "metre" ;
+          DEPTH:_Fillvalue = 99999.f ;
+     int DEPTH_QC(N_OBS, N_LEVELS) ;
+          DEPTH_QC:long_name = "Quality on depth" ;
+          DEPTH_QC:Conventions = "q where q =[0,9]" ;
+          DEPTH_QC:_Fillvalue = 0 ;
+     int DEPTH_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          DEPTH_QC_FLAGS:long_name = "Quality flags on depth" ;
+          DEPTH_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+     double JULD(N_OBS) ;
+          JULD:long_name = "Julian day" ;
+          JULD:units = "days since JULD_REFERENCE" ;
+          JULD:Conventions = "relative julian days with decimal part (as parts of day)" ;
+          JULD:_Fillvalue = 99999.f ;
+     char JULD_REFERENCE(STRINGJULD) ;
+          JULD_REFERENCE:long_name = "Date of reference for julian days" ;
+          JULD_REFERENCE:Conventions = "YYYYMMDDHHMMSS" ;
+     int OBSERVATION_QC(N_OBS) ;
+          OBSERVATION_QC:long_name = "Quality on observation" ;
+          OBSERVATION_QC:Conventions = "q where q =[0,9]" ;
+          OBSERVATION_QC:_Fillvalue = 0 ;
+     int OBSERVATION_QC_FLAGS(N_OBS, N_QCF) ;
+          OBSERVATION_QC_FLAGS:long_name = "Quality flags on observation" ;
+          OBSERVATION_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          OBSERVATION_QC_FLAGS:_Fillvalue = 0 ;
+     int POSITION_QC(N_OBS) ;
+          POSITION_QC:long_name = "Quality on position (latitude and longitude)" ;
+          POSITION_QC:Conventions = "q where q =[0,9]" ;
+          POSITION_QC:_Fillvalue = 0 ;
+     int POSITION_QC_FLAGS(N_OBS, N_QCF) ;
+          POSITION_QC_FLAGS:long_name = "Quality flags on position" ;
+          POSITION_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          POSITION_QC_FLAGS:_Fillvalue = 0 ;
+     int JULD_QC(N_OBS) ;
+          JULD_QC:long_name = "Quality on date and time" ;
+          JULD_QC:Conventions = "q where q =[0,9]" ;
+          JULD_QC:_Fillvalue = 0 ;
+     int JULD_QC_FLAGS(N_OBS, N_QCF) ;
+          JULD_QC_FLAGS:long_name = "Quality flags on date and time" ;
+          JULD_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          JULD_QC_FLAGS:_Fillvalue = 0 ;
+     int ORIGINAL_FILE_INDEX(N_OBS) ;
+          ORIGINAL_FILE_INDEX:long_name = "Index in original data file" ;
+          ORIGINAL_FILE_INDEX:_Fillvalue = -99999 ;
+     float POTM_OBS(N_OBS, N_LEVELS) ;
+          POTM_OBS:long_name = "Potential temperature" ;
+          POTM_OBS:units = "Degrees Celsius" ;
+          POTM_OBS:_Fillvalue = 99999.f ;
+     float POTM_Hx(N_OBS, N_LEVELS) ;
+          POTM_Hx:long_name = "Model interpolated potential temperature" ;
+          POTM_Hx:units = "Degrees Celsius" ;
+          POTM_Hx:_Fillvalue = 99999.f ;
+     int POTM_QC(N_OBS) ;
+          POTM_QC:long_name = "Quality on potential temperature" ;
+          POTM_QC:Conventions = "q where q =[0,9]" ;
+          POTM_QC:_Fillvalue = 0 ;
+     int POTM_QC_FLAGS(N_OBS, N_QCF) ;
+          POTM_QC_FLAGS:long_name = "Quality flags on potential temperature" ;
+          POTM_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          POTM_QC_FLAGS:_Fillvalue = 0 ;
+     int POTM_LEVEL_QC(N_OBS, N_LEVELS) ;
+          POTM_LEVEL_QC:long_name = "Quality for each level on potential temperature" ;
+          POTM_LEVEL_QC:Conventions = "q where q =[0,9]" ;
+          POTM_LEVEL_QC:_Fillvalue = 0 ;
+     int POTM_LEVEL_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          POTM_LEVEL_QC_FLAGS:long_name = "Quality flags for each level on potential temperature" ;
+          POTM_LEVEL_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          POTM_LEVEL_QC_FLAGS:_Fillvalue = 0 ;
+     int POTM_IOBSI(N_OBS) ;
+          POTM_IOBSI:long_name = "ORCA grid search I coordinate" ;
+     int POTM_IOBSJ(N_OBS) ;
+          POTM_IOBSJ:long_name = "ORCA grid search J coordinate" ;
+     int POTM_IOBSK(N_OBS, N_LEVELS) ;
+          POTM_IOBSK:long_name = "ORCA grid search K coordinate" ;
+     char POTM_GRID(STRINGGRID) ;
+          POTM_GRID:long_name = "ORCA grid search grid (T,U,V)" ;
+     float PSAL_OBS(N_OBS, N_LEVELS) ;
+          PSAL_OBS:long_name = "Practical salinity" ;
+          PSAL_OBS:units = "PSU" ;
+          PSAL_OBS:_Fillvalue = 99999.f ;
+     float PSAL_Hx(N_OBS, N_LEVELS) ;
+          PSAL_Hx:long_name = "Model interpolated practical salinity" ;
+          PSAL_Hx:units = "PSU" ;
+          PSAL_Hx:_Fillvalue = 99999.f ;
+     int PSAL_QC(N_OBS) ;
+          PSAL_QC:long_name = "Quality on practical salinity" ;
+          PSAL_QC:Conventions = "q where q =[0,9]" ;
+          PSAL_QC:_Fillvalue = 0 ;
+     int PSAL_QC_FLAGS(N_OBS, N_QCF) ;
+          PSAL_QC_FLAGS:long_name = "Quality flags on practical salinity" ;
+          PSAL_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          PSAL_QC_FLAGS:_Fillvalue = 0 ;
+     int PSAL_LEVEL_QC(N_OBS, N_LEVELS) ;
+          PSAL_LEVEL_QC:long_name = "Quality for each level on practical salinity" ;
+          PSAL_LEVEL_QC:Conventions = "q where q =[0,9]" ;
+          PSAL_LEVEL_QC:_Fillvalue = 0 ;
+     int PSAL_LEVEL_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          PSAL_LEVEL_QC_FLAGS:long_name = "Quality flags for each level on practical salinity" ;
+          PSAL_LEVEL_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          PSAL_LEVEL_QC_FLAGS:_Fillvalue = 0 ;
+     int PSAL_IOBSI(N_OBS) ;
+          PSAL_IOBSI:long_name = "ORCA grid search I coordinate" ;
+     int PSAL_IOBSJ(N_OBS) ;
+          PSAL_IOBSJ:long_name = "ORCA grid search J coordinate" ;
+     int PSAL_IOBSK(N_OBS, N_LEVELS) ;
+          PSAL_IOBSK:long_name = "ORCA grid search K coordinate" ;
+     char PSAL_GRID(STRINGGRID) ;
+          PSAL_GRID:long_name = "ORCA grid search grid (T,U,V)" ;
+     float TEMP(N_OBS, N_LEVELS) ;
+          TEMP:long_name = "Insitu temperature" ;
+          TEMP:units = "Degrees Celsius" ;
+          TEMP:_Fillvalue = 99999.f ;
+
+// global attributes:
+          :title = "NEMO observation operator output" ;
+          :Convention = "NEMO unified observation operator output" ;
+}
+\end{verbatim}
+\end{alltt}
+
+\subsection{Sea level anomaly feedback type observation file header}
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+netcdf sla_01 {
+dimensions:
+     N_OBS = 41301 ;
+     N_LEVELS = 1 ;
+     N_VARS = 1 ;
+     N_QCF = 2 ;
+     N_ENTRIES = 1 ;
+     N_EXTRA = 1 ;
+     STRINGNAM = 8 ;
+     STRINGGRID = 1 ;
+     STRINGWMO = 8 ;
+     STRINGTYP = 4 ;
+     STRINGJULD = 14 ;
+variables:
+     char VARIABLES(N_VARS, STRINGNAM) ;
+          VARIABLES:long_name = "List of variables in feedback files" ;
+     char ENTRIES(N_ENTRIES, STRINGNAM) ;
+          ENTRIES:long_name = "List of additional entries for each variable in feedback files" ;
+     char EXTRA(N_EXTRA, STRINGNAM) ;
+          EXTRA:long_name = "List of extra variables" ;
+     char STATION_IDENTIFIER(N_OBS, STRINGWMO) ;
+          STATION_IDENTIFIER:long_name = "Station identifier" ;
+     char STATION_TYPE(N_OBS, STRINGTYP) ;
+          STATION_TYPE:long_name = "Code instrument type" ;
+     double LONGITUDE(N_OBS) ;
+          LONGITUDE:long_name = "Longitude" ;
+          LONGITUDE:units = "degrees_east" ;
+          LONGITUDE:_Fillvalue = 99999.f ;
+     double LATITUDE(N_OBS) ;
+          LATITUDE:long_name = "Latitude" ;
+          LATITUDE:units = "degrees_north" ;
+          LATITUDE:_Fillvalue = 99999.f ;
+     double DEPTH(N_OBS, N_LEVELS) ;
+          DEPTH:long_name = "Depth" ;
+          DEPTH:units = "metre" ;
+          DEPTH:_Fillvalue = 99999.f ;
+     int DEPTH_QC(N_OBS, N_LEVELS) ;
+          DEPTH_QC:long_name = "Quality on depth" ;
+          DEPTH_QC:Conventions = "q where q =[0,9]" ;
+          DEPTH_QC:_Fillvalue = 0 ;
+     int DEPTH_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          DEPTH_QC_FLAGS:long_name = "Quality flags on depth" ;
+          DEPTH_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+     double JULD(N_OBS) ;
+          JULD:long_name = "Julian day" ;
+          JULD:units = "days since JULD_REFERENCE" ;
+          JULD:Conventions = "relative julian days with decimal part (as parts of day)" ;
+          JULD:_Fillvalue = 99999.f ;
+     char JULD_REFERENCE(STRINGJULD) ;
+          JULD_REFERENCE:long_name = "Date of reference for julian days" ;
+          JULD_REFERENCE:Conventions = "YYYYMMDDHHMMSS" ;
+     int OBSERVATION_QC(N_OBS) ;
+          OBSERVATION_QC:long_name = "Quality on observation" ;
+          OBSERVATION_QC:Conventions = "q where q =[0,9]" ;
+          OBSERVATION_QC:_Fillvalue = 0 ;
+     int OBSERVATION_QC_FLAGS(N_OBS, N_QCF) ;
+          OBSERVATION_QC_FLAGS:long_name = "Quality flags on observation" ;
+          OBSERVATION_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          OBSERVATION_QC_FLAGS:_Fillvalue = 0 ;
+     int POSITION_QC(N_OBS) ;
+          POSITION_QC:long_name = "Quality on position (latitude and longitude)" ;
+          POSITION_QC:Conventions = "q where q =[0,9]" ;
+          POSITION_QC:_Fillvalue = 0 ;
+     int POSITION_QC_FLAGS(N_OBS, N_QCF) ;
+          POSITION_QC_FLAGS:long_name = "Quality flags on position" ;
+          POSITION_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          POSITION_QC_FLAGS:_Fillvalue = 0 ;
+     int JULD_QC(N_OBS) ;
+          JULD_QC:long_name = "Quality on date and time" ;
+          JULD_QC:Conventions = "q where q =[0,9]" ;
+          JULD_QC:_Fillvalue = 0 ;
+     int JULD_QC_FLAGS(N_OBS, N_QCF) ;
+          JULD_QC_FLAGS:long_name = "Quality flags on date and time" ;
+          JULD_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          JULD_QC_FLAGS:_Fillvalue = 0 ;
+     int ORIGINAL_FILE_INDEX(N_OBS) ;
+          ORIGINAL_FILE_INDEX:long_name = "Index in original data file" ;
+          ORIGINAL_FILE_INDEX:_Fillvalue = -99999 ;
+     float SLA_OBS(N_OBS, N_LEVELS) ;
+          SLA_OBS:long_name = "Sea level anomaly" ;
+          SLA_OBS:units = "metre" ;
+          SLA_OBS:_Fillvalue = 99999.f ;
+     float SLA_Hx(N_OBS, N_LEVELS) ;
+          SLA_Hx:long_name = "Model interpolated sea level anomaly" ;
+          SLA_Hx:units = "metre" ;
+          SLA_Hx:_Fillvalue = 99999.f ;
+     int SLA_QC(N_OBS) ;
+          SLA_QC:long_name = "Quality on sea level anomaly" ;
+          SLA_QC:Conventions = "q where q =[0,9]" ;
+          SLA_QC:_Fillvalue = 0 ;
+     int SLA_QC_FLAGS(N_OBS, N_QCF) ;
+          SLA_QC_FLAGS:long_name = "Quality flags on sea level anomaly" ;
+          SLA_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          SLA_QC_FLAGS:_Fillvalue = 0 ;
+     int SLA_LEVEL_QC(N_OBS, N_LEVELS) ;
+          SLA_LEVEL_QC:long_name = "Quality for each level on sea level anomaly" ;
+          SLA_LEVEL_QC:Conventions = "q where q =[0,9]" ;
+          SLA_LEVEL_QC:_Fillvalue = 0 ;
+     int SLA_LEVEL_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          SLA_LEVEL_QC_FLAGS:long_name = "Quality flags for each level on sea level anomaly" ;
+          SLA_LEVEL_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          SLA_LEVEL_QC_FLAGS:_Fillvalue = 0 ;
+     int SLA_IOBSI(N_OBS) ;
+          SLA_IOBSI:long_name = "ORCA grid search I coordinate" ;
+     int SLA_IOBSJ(N_OBS) ;
+          SLA_IOBSJ:long_name = "ORCA grid search J coordinate" ;
+     int SLA_IOBSK(N_OBS, N_LEVELS) ;
+          SLA_IOBSK:long_name = "ORCA grid search K coordinate" ;
+     char SLA_GRID(STRINGGRID) ;
+          SLA_GRID:long_name = "ORCA grid search grid (T,U,V)" ;
+     float MDT(N_OBS, N_LEVELS) ;
+          MDT:long_name = "Mean Dynamic Topography" ;
+          MDT:units = "metre" ;
+          MDT:_Fillvalue = 99999.f ;
+
+// global attributes:
+          :title = "NEMO observation operator output" ;
+          :Convention = "NEMO unified observation operator output" ;
+}
+\end{verbatim}
+\end{alltt}
+
+The mean dynamic
+topography (MDT) must be provided in a separate file defined on the model grid
+ called {\it slaReferenceLevel.nc}. The MDT is required in
+order to produce the model equivalent sea level anomaly from the model sea
+surface height. Below is an example header for this file (on the ORCA025 grid).
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+dimensions:
+        x = 1442 ;
+        y = 1021 ;
+variables:
+        float nav_lon(y, x) ;
+                nav_lon:units = "degrees_east" ;
+        float nav_lat(y, x) ;
+                nav_lat:units = "degrees_north" ;
+        float sossheig(y, x) ;
+                sossheig:_FillValue = -1.e+30f ;
+                sossheig:coordinates = "nav_lon nav_lat" ;
+                sossheig:long_name = "Mean Dynamic Topography" ;
+                sossheig:units = "metres" ;
+                sossheig:grid = "orca025T" ;
+\end{verbatim}
+\end{alltt}
+
+\subsection{Sea surface temperature feedback type observation file header}
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+netcdf sst_01 {
+dimensions:
+     N_OBS = 33099 ;
+     N_LEVELS = 1 ;
+     N_VARS = 1 ;
+     N_QCF = 2 ;
+     N_ENTRIES = 1 ;
+     STRINGNAM = 8 ;
+     STRINGGRID = 1 ;
+     STRINGWMO = 8 ;
+     STRINGTYP = 4 ;
+     STRINGJULD = 14 ;
+variables:
+     char VARIABLES(N_VARS, STRINGNAM) ;
+          VARIABLES:long_name = "List of variables in feedback files" ;
+     char ENTRIES(N_ENTRIES, STRINGNAM) ;
+          ENTRIES:long_name = "List of additional entries for each variable in feedback files" ;
+     char STATION_IDENTIFIER(N_OBS, STRINGWMO) ;
+          STATION_IDENTIFIER:long_name = "Station identifier" ;
+     char STATION_TYPE(N_OBS, STRINGTYP) ;
+          STATION_TYPE:long_name = "Code instrument type" ;
+     double LONGITUDE(N_OBS) ;
+          LONGITUDE:long_name = "Longitude" ;
+          LONGITUDE:units = "degrees_east" ;
+          LONGITUDE:_Fillvalue = 99999.f ;
+     double LATITUDE(N_OBS) ;
+          LATITUDE:long_name = "Latitude" ;
+          LATITUDE:units = "degrees_north" ;
+          LATITUDE:_Fillvalue = 99999.f ;
+     double DEPTH(N_OBS, N_LEVELS) ;
+          DEPTH:long_name = "Depth" ;
+          DEPTH:units = "metre" ;
+          DEPTH:_Fillvalue = 99999.f ;
+     int DEPTH_QC(N_OBS, N_LEVELS) ;
+          DEPTH_QC:long_name = "Quality on depth" ;
+          DEPTH_QC:Conventions = "q where q =[0,9]" ;
+          DEPTH_QC:_Fillvalue = 0 ;
+     int DEPTH_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          DEPTH_QC_FLAGS:long_name = "Quality flags on depth" ;
+          DEPTH_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+     double JULD(N_OBS) ;
+          JULD:long_name = "Julian day" ;
+          JULD:units = "days since JULD_REFERENCE" ;
+          JULD:Conventions = "relative julian days with decimal part (as parts of day)" ;
+          JULD:_Fillvalue = 99999.f ;
+     char JULD_REFERENCE(STRINGJULD) ;
+          JULD_REFERENCE:long_name = "Date of reference for julian days" ;
+          JULD_REFERENCE:Conventions = "YYYYMMDDHHMMSS" ;
+     int OBSERVATION_QC(N_OBS) ;
+          OBSERVATION_QC:long_name = "Quality on observation" ;
+          OBSERVATION_QC:Conventions = "q where q =[0,9]" ;
+          OBSERVATION_QC:_Fillvalue = 0 ;
+     int OBSERVATION_QC_FLAGS(N_OBS, N_QCF) ;
+          OBSERVATION_QC_FLAGS:long_name = "Quality flags on observation" ;
+          OBSERVATION_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          OBSERVATION_QC_FLAGS:_Fillvalue = 0 ;
+     int POSITION_QC(N_OBS) ;
+          POSITION_QC:long_name = "Quality on position (latitude and longitude)" ;
+          POSITION_QC:Conventions = "q where q =[0,9]" ;
+          POSITION_QC:_Fillvalue = 0 ;
+     int POSITION_QC_FLAGS(N_OBS, N_QCF) ;
+          POSITION_QC_FLAGS:long_name = "Quality flags on position" ;
+          POSITION_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          POSITION_QC_FLAGS:_Fillvalue = 0 ;
+     int JULD_QC(N_OBS) ;
+          JULD_QC:long_name = "Quality on date and time" ;
+          JULD_QC:Conventions = "q where q =[0,9]" ;
+          JULD_QC:_Fillvalue = 0 ;
+     int JULD_QC_FLAGS(N_OBS, N_QCF) ;
+          JULD_QC_FLAGS:long_name = "Quality flags on date and time" ;
+          JULD_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          JULD_QC_FLAGS:_Fillvalue = 0 ;
+     int ORIGINAL_FILE_INDEX(N_OBS) ;
+          ORIGINAL_FILE_INDEX:long_name = "Index in original data file" ;
+          ORIGINAL_FILE_INDEX:_Fillvalue = -99999 ;
+     float SST_OBS(N_OBS, N_LEVELS) ;
+          SST_OBS:long_name = "Sea surface temperature" ;
+          SST_OBS:units = "Degree centigrade" ;
+          SST_OBS:_Fillvalue = 99999.f ;
+     float SST_Hx(N_OBS, N_LEVELS) ;
+          SST_Hx:long_name = "Model interpolated sea surface temperature" ;
+          SST_Hx:units = "Degree centigrade" ;
+          SST_Hx:_Fillvalue = 99999.f ;
+     int SST_QC(N_OBS) ;
+          SST_QC:long_name = "Quality on sea surface temperature" ;
+          SST_QC:Conventions = "q where q =[0,9]" ;
+          SST_QC:_Fillvalue = 0 ;
+     int SST_QC_FLAGS(N_OBS, N_QCF) ;
+          SST_QC_FLAGS:long_name = "Quality flags on sea surface temperature" ;
+          SST_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          SST_QC_FLAGS:_Fillvalue = 0 ;
+     int SST_LEVEL_QC(N_OBS, N_LEVELS) ;
+          SST_LEVEL_QC:long_name = "Quality for each level on sea surface temperature" ;
+          SST_LEVEL_QC:Conventions = "q where q =[0,9]" ;
+          SST_LEVEL_QC:_Fillvalue = 0 ;
+     int SST_LEVEL_QC_FLAGS(N_OBS, N_LEVELS, N_QCF) ;
+          SST_LEVEL_QC_FLAGS:long_name = "Quality flags for each level on sea surface temperature" ;
+          SST_LEVEL_QC_FLAGS:Conventions = "NEMOVAR flag conventions" ;
+          SST_LEVEL_QC_FLAGS:_Fillvalue = 0 ;
+     int SST_IOBSI(N_OBS) ;
+          SST_IOBSI:long_name = "ORCA grid search I coordinate" ;
+     int SST_IOBSJ(N_OBS) ;
+          SST_IOBSJ:long_name = "ORCA grid search J coordinate" ;
+     int SST_IOBSK(N_OBS, N_LEVELS) ;
+          SST_IOBSK:long_name = "ORCA grid search K coordinate" ;
+     char SST_GRID(STRINGGRID) ;
+          SST_GRID:long_name = "ORCA grid search grid (T,U,V)" ;
+
+// global attributes:
+          :title = "NEMO observation operator output" ;
+          :Convention = "NEMO unified observation operator output" ;
+}
+\end{verbatim}
+\end{alltt}
+
+\section{Theoretical details}
+\label{OBS_theory}
+
+\subsection{Horizontal interpolation methods}
+
+Consider an observation point ${\rm P}$ with 
+with longitude and latitude $({\lambda_{}}_{\rm P}, \phi_{\rm P})$ and the 
+four nearest neighbouring model grid points ${\rm A}$, ${\rm B}$, ${\rm C}$ 
+and ${\rm D}$ with longitude and latitude ($\lambda_{\rm A}$, $\phi_{\rm A}$),
+($\lambda_{\rm B}$, $\phi_{\rm B}$) etc.
+All horizontal interpolation methods implemented in NEMO
+estimate the value of a model variable $x$ at point $P$ as
+a weighted linear combination of the values of the model 
+variables at the grid points ${\rm A}$, ${\rm B}$ etc.:
+\begin{eqnarray}
+{x_{}}_{\rm P} & \hspace{-2mm} = \hspace{-2mm} & 
+\frac{1}{w} \left( {w_{}}_{\rm A} {x_{}}_{\rm A} + 
+                   {w_{}}_{\rm B} {x_{}}_{\rm B} + 
+                   {w_{}}_{\rm C} {x_{}}_{\rm C} + 
+                   {w_{}}_{\rm D} {x_{}}_{\rm D} \right)
+\end{eqnarray}
+where ${w_{}}_{\rm A}$, ${w_{}}_{\rm B}$ etc. are the respective weights for the 
+model field at points ${\rm A}$, ${\rm B}$ etc., and 
+$w = {w_{}}_{\rm A} + {w_{}}_{\rm B} + {w_{}}_{\rm C} + {w_{}}_{\rm D}$.
+
+Four different possibilities are available for computing the weights.
+
+\begin{enumerate}
+
+\item[1.] {\bf Great-Circle distance-weighted interpolation.} The weights
+  are computed as a function of the great-circle distance $s(P, \cdot)$ 
+  between $P$ and the model grid points $A$, $B$ etc. For example, 
+  the weight given to the field ${x_{}}_{\rm A}$ is specified as the 
+  product of the distances from ${\rm P}$ to the other points:
+  \begin{eqnarray}
+  {w_{}}_{\rm A} = s({\rm P}, {\rm B}) \, s({\rm P}, {\rm C}) \, s({\rm P}, {\rm D})
+  \nonumber
+  \end{eqnarray}
+  where 
+  \begin{eqnarray}
+   s\left ({\rm P}, {\rm M} \right ) 
+     & \hspace{-2mm} = \hspace{-2mm} & 
+      \cos^{-1} \! \left\{ 
+               \sin {\phi_{}}_{\rm P} \sin {\phi_{}}_{\rm M}
+             + \cos {\phi_{}}_{\rm P} \cos {\phi_{}}_{\rm M} 
+               \cos ({\lambda_{}}_{\rm M} - {\lambda_{}}_{\rm P}) 
+                   \right\}
+   \end{eqnarray}
+   and $M$ corresponds to $B$, $C$ or $D$.
+   A more stable form of the great-circle distance formula for
+   small distances ($x$ near 1) involves the arcsine function
+   ($e.g.$ see p.~101 of \citet{Daley_Barker_Bk01}:
+   \begin{eqnarray}
+   s\left( {\rm P}, {\rm M} \right) 
+     & \hspace{-2mm} = \hspace{-2mm} & 
+      \sin^{-1} \! \left\{ \sqrt{ 1 - x^2 } \right\}
+   \nonumber
+   \end{eqnarray}
+   where
+   \begin{eqnarray}
+    x & \hspace{-2mm} = \hspace{-2mm} & 
+      {a_{}}_{\rm M} {a_{}}_{\rm P} + {b_{}}_{\rm M} {b_{}}_{\rm P} + {c_{}}_{\rm M} {c_{}}_{\rm P}
+   \nonumber
+   \end{eqnarray}
+   and 
+   \begin{eqnarray}
+      {a_{}}_{\rm M} & \hspace{-2mm} = \hspace{-2mm} & \sin {\phi_{}}_{\rm M}, 
+      \nonumber \\
+      {a_{}}_{\rm P} & \hspace{-2mm} = \hspace{-2mm} & \sin {\phi_{}}_{\rm P}, 
+      \nonumber \\
+      {b_{}}_{\rm M} & \hspace{-2mm} = \hspace{-2mm} & \cos {\phi_{}}_{\rm M} \cos {\phi_{}}_{\rm M}, 
+      \nonumber \\
+      {b_{}}_{\rm P} & \hspace{-2mm} = \hspace{-2mm} & \cos {\phi_{}}_{\rm P} \cos {\phi_{}}_{\rm P}, 
+      \nonumber \\
+      {c_{}}_{\rm M} & \hspace{-2mm} = \hspace{-2mm} & \cos {\phi_{}}_{\rm M} \sin {\phi_{}}_{\rm M}, 
+      \nonumber \\
+      {c_{}}_{\rm P} & \hspace{-2mm} = \hspace{-2mm} & \cos {\phi_{}}_{\rm P} \sin {\phi_{}}_{\rm P}.
+      \nonumber
+   \nonumber
+  \end{eqnarray}
+
+\item[2.] {\bf Great-Circle distance-weighted interpolation with small angle
+  approximation.} Similar to the previous interpolation but with the
+  distance $s$ computed as
+  \begin{eqnarray}
+    s\left( {\rm P}, {\rm M} \right) 
+     & \hspace{-2mm} = \hspace{-2mm} & 
+      \sqrt{ \left( {\phi_{}}_{\rm M} - {\phi_{}}_{\rm P} \right)^{2} 
+      + \left( {\lambda_{}}_{\rm M} - {\lambda_{}}_{\rm P} \right)^{2}
+        \cos^{2} {\phi_{}}_{\rm M} }
+  \end{eqnarray}
+  where $M$ corresponds to $A$, $B$, $C$ or $D$.
+
+\item[3.] {\bf Bilinear interpolation for a regular spaced grid.} The
+  interpolation is split into two 1D interpolations in the longitude
+  and latitude directions, respectively.
+
+\item[4.] {\bf Bilinear remapping interpolation for a general grid.} An
+  iterative scheme that involves first mapping a quadrilateral cell
+  into a cell with coordinates (0,0), (1,0), (0,1) and (1,1). This
+  method is based on the SCRIP interpolation package \citep{Jones_1998}.
+  
+\end{enumerate}
+
+\subsection{Grid search}
+
+For many grids used by the NEMO model, such as the ORCA family, 
+the horizontal grid coordinates $i$ and $j$ are not simple functions 
+of latitude and longitude. Therefore, it is not always straightforward 
+to determine the grid points surrounding any given observational position.
+Before the interpolation can be performed, a search 
+algorithm is then required to determine the corner points of 
+the quadrilateral cell in which the observation is located.
+This is the most difficult and time consuming part of the 
+2D interpolation procedure. 
+A robust test for determining if an observation falls
+within a given quadrilateral cell is as follows. Let 
+${\rm P}({\lambda_{}}_{\rm P} ,{\phi_{}}_{\rm P} )$ denote the observation point,
+and let ${\rm A}({\lambda_{}}_{\rm A} ,{\phi_{}}_{\rm A} )$,
+${\rm B}({\lambda_{}}_{\rm B} ,{\phi_{}}_{\rm B} )$,
+${\rm C}({\lambda_{}}_{\rm C} ,{\phi_{}}_{\rm C} )$ 
+and 
+${\rm D}({\lambda_{}}_{\rm D} ,{\phi_{}}_{\rm D} )$ denote
+the bottom left, bottom right, top left and top right
+corner points of the cell, respectively. 
+To determine if P is inside 
+the cell, we verify that the cross-products 
+\begin{eqnarray}
+\begin{array}{lllll}
+{{\bf r}_{}}_{\rm PA} \times {{\bf r}_{}}_{\rm PC}
+& = & [({\lambda_{}}_{\rm A}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm C}   \; -\; {\phi_{}}_{\rm P} )
+    - ({\lambda_{}}_{\rm C}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm A}   \; -\; {\phi_{}}_{\rm P} )] \; \widehat{\bf k} \\
+{{\bf r}_{}}_{\rm PB} \times {{\bf r}_{}}_{\rm PA}
+& = & [({\lambda_{}}_{\rm B}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm A}   \; -\; {\phi_{}}_{\rm P} )
+    - ({\lambda_{}}_{\rm A}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm B}   \; -\; {\phi_{}}_{\rm P} )] \; \widehat{\bf k} \\
+{{\bf r}_{}}_{\rm PC} \times {{\bf r}_{}}_{\rm PD}
+& = & [({\lambda_{}}_{\rm C}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm D}   \; -\; {\phi_{}}_{\rm P} )
+    - ({\lambda_{}}_{\rm D}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm C}   \; -\; {\phi_{}}_{\rm P} )] \; \widehat{\bf k} \\
+{{\bf r}_{}}_{\rm PD} \times {{\bf r}_{}}_{\rm PB}
+& = & [({\lambda_{}}_{\rm D}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm B}   \; -\; {\phi_{}}_{\rm P} )
+    - ({\lambda_{}}_{\rm B}\; -\; {\lambda_{}}_{\rm P} )
+      ({\phi_{}}_{\rm D}  \;  - \; {\phi_{}}_{\rm P} )] \; \widehat{\bf k} \\
+\end{array}
+\label{eq:cross}
+\end{eqnarray}
+point in the opposite direction to the unit normal 
+$\widehat{\bf k}$ (i.e., that the coefficients of 
+$\widehat{\bf k}$ are negative),
+where ${{\bf r}_{}}_{\rm PA}$, ${{\bf r}_{}}_{\rm PB}$, 
+etc. correspond to the vectors between points P and A, 
+P and B, etc.. The method used is
+similar to the method used in
+the SCRIP interpolation package \citep{Jones_1998}.
+
+In order to speed up the grid search, there is the possibility to construct 
+a lookup table for a user specified resolution. This lookup
+table contains the lower and upper bounds on the $i$ and $j$ indices
+to be searched for on a regular grid. For each observation position,
+the closest point on the regular grid of this position is computed and
+the $i$ and $j$ ranges of this point searched to determine the precise
+four points surrounding the observation. 
+
+\subsection{Parallel aspects of horizontal interpolation}
+\label{OBS_parallel}
+
+For horizontal interpolation, there is the basic problem that the
+observations are unevenly distributed on the globe. In numerical
+models, it is common to divide the model grid into subgrids (or
+domains) where each subgrid is executed on a single processing element
+with explicit message passing for exchange of information along the
+domain boundaries when running on a massively parallel processor (MPP)
+system. This approach is used by \NEMO.
+
+For observations there is no natural distribution since the
+observations are not equally distributed on the globe. 
+Two options have been made available: 1) geographical distribution;
+and 2) round-robin.
+
+\subsubsection{Geographical distribution of observations among processors}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}      \begin{center}
+\includegraphics[width=10cm,height=12cm,angle=-90.]{Fig_ASM_obsdist_local}
+\caption{      \label{fig:obslocal}
+Example of the distribution of observations with the geographical distribution of observational data.} 
+\end{center}      \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+This is the simplest option in which the observations are distributed according 
+to the domain of the grid-point parallelization. Figure~\ref{fig:obslocal}
+shows an example of the distribution of the {\em in situ} data on processors 
+with a different colour for each observation
+on a given processor for a 4 $\times$ 2 decomposition with ORCA2. 
+The grid-point domain decomposition is clearly visible on the plot.
+
+The advantage of this approach is that all
+information needed for horizontal interpolation is available without
+any MPP communication. Of course, this is under the assumption that 
+we are only using a $2 \times 2$ grid-point stencil for the interpolation 
+(e.g., bilinear interpolation). For higher order interpolation schemes this
+is no longer valid. A disadvantage with the above scheme is that the number of
+observations on each processor can be very different. If the cost of
+the actual interpolation is expensive relative to the communication of
+data needed for interpolation, this could lead to load imbalance.
+
+\subsubsection{Round-robin distribution of observations among processors}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}     \begin{center}
+\includegraphics[width=10cm,height=12cm,angle=-90.]{Fig_ASM_obsdist_global}
+\caption{      \label{fig:obsglobal}
+Example of the distribution of observations with the round-robin distribution of observational data.}
+\end{center}     \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+An alternative approach is to distribute the observations equally
+among processors and use message passing in order to retrieve 
+the stencil for interpolation. The simplest distribution of the observations 
+is to distribute them using a round-robin scheme. Figure~\ref{fig:obsglobal}
+shows the distribution of the {\em in situ} data on processors for the
+round-robin distribution of observations with a different colour for
+each observation on a given processor for a 4 $\times$ 2 decomposition 
+with ORCA2 for the same input data as in Fig.~\ref{fig:obslocal}.
+The observations are now clearly randomly distributed on the globe.
+In order to be able to perform horizontal interpolation in this case, 
+a subroutine has been developed that retrieves any grid points in the 
+global space.
+
+\subsection{Vertical interpolation operator}
+
+Vertical interpolation is achieved using either a cubic spline or
+linear interpolation. For the cubic spline, the top and
+bottom boundary conditions for the second derivative of the 
+interpolating polynomial in the spline are set to zero.
+At the bottom boundary, this is done using the land-ocean mask.
+
+\newpage
+
+% ================================================================
+% Offline observation operator documentation
+% ================================================================
+
+%\usepackage{framed}
+
+\section{Offline observation operator}
+\label{OBS_ooo}
+
+\subsection{Concept}
+
+The obs oper maps model variables to observation space. It is possible to apply this mapping
+without running the model. The software which performs this functionality is known as the
+\textbf{offline obs oper}. The obs oper is divided into three stages. An initialisation phase,
+an interpolation phase and an output phase. The implementation of which is outlined in the
+previous sections. During the interpolation phase the offline obs oper populates the model
+arrays by reading saved model fields from disk.
+
+There are two ways of exploiting this offline capacity. The first is to mimic the behaviour of
+the online system by supplying model fields at regular intervals between the start and the end
+of the run. This approach results in a single model counterpart per observation. This kind of
+usage produces feedback files the same file format as the online obs oper. 
+The second is to take advantage of the offline setting in which multiple model counterparts can
+be calculated per observation. In this case it is possible to consider all forecasts verifying
+at the same time. By forecast, I mean any method which produces an estimate of physical reality
+which is not an observed value. In the case of class 4 files this means forecasts, analyses, persisted
+analyses and climatological values verifying at the same time. Although the class 4 file format
+doesn't account for multiple ensemble members or multiple experiments per observation, it is possible
+to include these components in the same or multiple files.
+
+%--------------------------------------------------------------------------------------------------------
+% offline_oper.exe 
+%--------------------------------------------------------------------------------------------------------
+
+\subsection{Using the offline observation operator}
+
+\subsubsection{Building}
+
+In addition to \emph{OPA\_SRC} the offline obs oper requires the inclusion
+of the \emph{OOO\_SRC} directory. \emph{OOO\_SRC} contains a replacement \textbf{nemo.f90} and
+\textbf{nemogcm.F90} which overwrites the resultant \textbf{nemo.exe}. This is the approach taken
+by \emph{SAS\_SRC} and \emph{OFF\_SRC}.
+
+%--------------------------------------------------------------------------------------------------------
+% Running 
+%--------------------------------------------------------------------------------------------------------
+\subsubsection{Running}
+
+The simplest way to use the executable is to edit and append the \textbf{ooo.nml} namelist to
+a full NEMO namelist and then to run the executable as if it were nemo.exe. 
+
+\subsubsection{Quick script}
+
+A useful Python utility to control the namelist options can be found in \textbf{OBSTOOLS/OOO}. The
+functions which locate model fields and observation files can be manually specified. The package
+can be installed by appropriate use of the included setup.py script.
+
+Documentation can be auto-generated by Sphinx by running \emph{make html} in the \textbf{doc} directory.
+
+%--------------------------------------------------------------------------------------------------------
+% Configuration section
+%--------------------------------------------------------------------------------------------------------
+\subsection{Configuring the offline observation operator}
+The observation files and settings understood by \textbf{namobs} have been outlined in the online
+obs oper section. In addition there are two further namelists wich control the operation of the offline
+obs oper. \textbf{namooo} which controls the input model fields and \textbf{namcl4} which controls the
+production of class 4 files. 
+
+\subsubsection{Single field}
+
+In offline mode model arrays are populated at appropriate time steps via input files.
+At present, \textbf{tsn} and \textbf{sshn} are populated by the default read routines. 
+These routines will be expanded upon in future versions to allow the specification of any
+model variable. As such, input files must be global versions of the model domain with
+\textbf{votemper}, \textbf{vosaline} and optionally \textbf{sshn} present.
+
+For each field read there must be an entry in the \textbf{namooo} namelist specifying the
+name of the file to read and the index along the \emph{time\_counter}. For example, to
+read the second time counter from a single file the namelist would be.
+
+\begin{alltt}
+\tiny
+\begin{verbatim} 
+!----------------------------------------------------------------------
+!       namooo Offline obs_oper namelist
+!----------------------------------------------------------------------
+!   ooo_files    specifies the files containing the model counterpart
+!   nn_ooo_idx   specifies the time_counter index within the model file
+&namooo
+   ooo_files = "foo.nc"
+   nn_ooo_idx = 2
+/
+\end{verbatim} 
+\end{alltt}
+
+\subsubsection{Multiple fields per run}
+
+Model field iteration is controlled via \textbf{nn\_ooo\_freq} which specifies
+the number of model steps at which the next field gets read. For example, if
+12 hourly fields are to be interpolated in a setup where 288 steps equals 24 hours.
+
+\begin{alltt}
+\tiny
+\begin{verbatim} 
+!----------------------------------------------------------------------
+!       namooo Offline obs_oper namelist
+!----------------------------------------------------------------------
+!   ooo_files    specifies the files containing the model counterpart
+!   nn_ooo_idx   specifies the time_counter index within the model file
+!   nn_ooo_freq  specifies number of time steps between read operations
+&namooo
+   ooo_files = "foo.nc" "foo.nc"
+   nn_ooo_idx = 1 2
+   nn_ooo_freq = 144
+/
+\end{verbatim} 
+\end{alltt}
+
+The above namelist will result in feedback files whose first 12 hours contain
+the first field of foo.nc and the second 12 hours contain the second field.
+
+%\begin{framed}
+\textbf{Note} Missing files can be denoted as "nofile".
+%\end{framed}
+
+It is easy to see how a collection of fields taken fron a number of files 
+at different indices can be combined at a particular frequency in time to 
+generate a pseudo model evolution. As long as all that is needed is a single
+model counterpart at a regular interval then namooo is all that needs to
+be edited. However, a far more interesting approach can be taken in which
+multiple forecasts, analyses, persisted analyses and climatologies are
+considered against the same set of observations. For this a slightly more
+complicated approach is needed. It is referred to as \emph{Class 4} since
+it is the fourth metric defined by the GODAE intercomparison project.
+
+%--------------------------------------------------------------------------------------------------------
+% Class 4 file section
+%--------------------------------------------------------------------------------------------------------
+\subsubsection{Multiple model counterparts per observation a.k.a Class 4}
+
+A generalisation of feedback files to allow multiple model components per observation. For a single
+observation, as well as previous forecasts verifying at the same time there are also analyses, persisted
+analyses and climatologies. 
+
+
+The above namelist performs two basic functions. It organises the fields
+given in \textbf{namooo} into groups so that observations can be matched
+up multiple times. It also controls the metadata and the output variable
+of the class 4 file when a write routine is called.
+
+%\begin{framed}
+\textbf{Note: ln\_cl4} must be set to \emph{.TRUE.} in \textbf{namobs} 
+to use class 4 outputs.
+%\end{framed}
+
+\subsubsection{Class 4 naming convention}
+
+The standard class 4 file naming convention is as follows.
+
+\noindent
+\linebreak
+\textbf{\$\{prefix\}\_\$\{yyyymmdd\}\_\$\{sys\}\_\$\{cfg\}\_\$\{vn\}\_\$\{kind\}\_\$\{nproc\}.nc}
+
+\noindent
+\linebreak
+Much of the namelist is devoted to specifying this convention. The
+following namelist settings control the elements of the output
+file names. Each should be specified as a single string of character data.
+
+\begin{description}
+\item[cl4\_prefix]
+Prefix for class 4 files e.g. class4
+\item[cl4\_date]
+YYYYMMDD validity date
+\item[cl4\_sys]
+The name of the class 4 model system e.g. FOAM
+\item[cl4\_cfg]
+The name of the class 4 model configuration e.g. orca025
+\item[cl4\_vn]
+The name of the class 4 model version e.g. 12.0
+\end{description}
+
+\noindent
+The kind is specified by the observation type internally to the obs oper. The processor
+number is specified internally in NEMO. 
+
+\subsubsection{Class 4 file global attributes}
+
+Global attributes necessary to fulfill the class 4 file definition. These
+are also useful pieces of information when collaborating with external
+partners.
+
+\begin{description}
+\item[cl4\_contact]
+Contact email for class 4 files.
+\item[cl4\_inst]
+The name of the producers institution.
+\item[cl4\_cfg]
+The name of the class 4 model configuration e.g. orca025
+\item[cl4\_vn]
+The name of the class 4 model version e.g. 12.0
+\end{description}
+
+\noindent
+The obs\_type,
+creation date and validity time are specified internally to the obs oper.
+
+\subsubsection{Class 4 model counterpart configuration}
+
+As seen previously it is possible to perform a single sweep of the
+obs oper and specify a collection of model fields equally spaced 
+along that sweep. In the class 4 case the single sweep is replaced
+with multiple sweeps and a certain ammount of book keeping is
+needed to ensure each model counterpart makes its way to the 
+correct piece of memory in the output files.
+
+\noindent
+\linebreak
+In terms of book keeping, the offline obs oper needs to know how many
+full sweeps need to be performed. This is specified via the 
+\textbf{cl4\_match\_len} variable and is the total number of model
+counterparts per observation. For example, a 3 forecasts plus 3 persistence
+fields plus an analysis field would be 7 counterparts per observation.
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   cl4_match_len = 7
+\end{verbatim}
+\end{alltt}
+
+Then to correctly allocate a class 4 file the forecast axis must be defined. This
+is controlled via \textbf{cl4\_fcst\_len}, which in out above example would be 3.
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   cl4_fcst_len = 3
+\end{verbatim}
+\end{alltt}
+
+Then for each model field it is necessary to designate what class 4 variable and
+index along the forecast dimension the model counterpart should be stored in the
+output file. As well as a value for that lead time in hours, this will be useful
+when interpreting the data afterwards. 
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   cl4_vars = "forecast" "forecast" "forecast" "persistence" "persistence"
+              "persistence" "best_estimate"
+   cl4_fcst_idx = 1 2 3 1 2 3 1
+   cl4_leadtime = 12 36 60 
+\end{verbatim}
+\end{alltt}
+
+In terms of files and indices of fields inside each file the class 4 approach
+makes use of the \textbf{namooo} namelist. If our fields are in separate files
+with a single field per file our example inputs will be specified.
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   ooo_files = "F.1.nc" "F.2.nc" "F.3.nc" "P.1.nc" "P.2.nc" "P.3.nc" "A.1.nc"
+   nn_ooo_idx = 1 1 1 1 1 1 1
+\end{verbatim}
+\end{alltt}
+
+When we combine all of the naming conventions, global attributes and i/o instructions
+the class 4 namelist becomes.
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+!----------------------------------------------------------------------
+!       namooo Offline obs_oper namelist
+!----------------------------------------------------------------------
+!   ooo_files    specifies the files containing the model counterpart
+!   nn_ooo_idx   specifies the time_counter index within the model file
+!   nn_ooo_freq  specifies number of time steps between read operations
+&namooo
+   ooo_files = "F.1.nc" "F.2.nc" "F.3.nc" "P.1.nc" "P.2.nc" "P.3.nc" "A.1.nc"
+   nn_ooo_idx = 1 1 1 1 1 1 1
+/
+!----------------------------------------------------------------------
+!       namcl4 Offline obs_oper class 4 namelist
+!----------------------------------------------------------------------
+!
+!  Naming convention
+!  -----------------
+!  cl4_prefix    specifies the output file prefix
+!  cl4_date      specifies the output file validity date
+!  cl4_sys       specifies the model counterpart system
+!  cl4_cfg       specifies the model counterpart configuration
+!  cl4_vn        specifies the model counterpart version
+!  cl4_inst      specifies the model counterpart institute
+!  cl4_contact   specifies the file producers contact details
+!
+!  I/O specification
+!  -----------------
+!  cl4_vars      specifies the names of the output file netcdf variable
+!  cl4_fcst_idx  specifies output file forecast index
+!  cl4_fcst_len  specifies forecast axis length
+!  cl4_match_len specifies number of unique matches per observation
+!  cl4_leadtime  specifies the forecast axis lead time 
+!
+&namcl4
+   cl4_match_len = 7
+   cl4_fcst_len = 3
+   cl4_fcst_idx = 1 2 3 1 2 3 1
+   cl4_vars = "forecast" "forecast" "forecast" "persistence" "persistence"
+              "persistence" "best_estimate"
+   cl4_leadtime = 12 36 60
+   cl4_prefix = "class4"
+   cl4_date = "20130101"
+   cl4_vn = "12.0"
+   cl4_sys = "FOAM"
+   cl4_cfg = "AMM7"
+   cl4_contact = "example@example.com"
+   cl4_inst = "UK Met Office"
+/
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{Climatology interpolation}
+
+The climatological counterpart is generated at the start of the run by restarting 
+the model from climatology through appropriate use of \textbf{namtsd}. To override
+the offline observation operator read routine and to take advantage of the restart
+settings, specify the first entry in \textbf{cl4\_vars} as "climatology". This will then
+pipe the restart from climatology into the output class 4 file. As in every other
+class 4 matchup the input file, input index and output index must be specified.
+These can be replaced with dummy data since they are not used but they must be
+present to cycle through the matchups correctly. 
+
+\subsection{Advanced usage}
+
+In certain cases it may be desirable to include both multiple model fields per
+observation window with multiple match ups per observation. This can be achieved
+by specifying \textbf{nn\_ooo\_freq} as well as the class 4 settings. Care must
+be taken in generating the ooo\_files list such that the files are arranged into
+consecutive blocks of single match ups. For example, 2 forecast fields 
+of 12 hourly data would result in 4 separate read operations but only 2 write
+operations, 1 per forecast.
+
+\begin{alltt}
+\tiny
+\begin{verbatim}
+   ooo_files = "F1.nc" "F1.nc" "F2.nc" "F2.nc"
+...
+   cl4_fcst_idx = 1 2
+\end{verbatim}
+\end{alltt}
+
+The above notation reveals the internal split between match up iterators and file
+iterators. This technique has not been used before so experimentation is needed
+before results can be trusted.
+
+
+
+
+\newpage
+
+\section{Observation Utilities}
+\label{OBS_obsutils}
+
+Some tools for viewing and processing of observation and feedback files are provided in the
+NEMO repository for convenience. These include OBSTOOLS which are a collection of Fortran
+programs which are helpful to deal with feedback files. They do such tasks as observation file
+conversion, printing of file contents, some basic statistical analysis of feedback files. The
+other tool is an IDL program called dataplot which uses a graphical interface to visualise
+observations and feedback files. OBSTOOLS and dataplot are described in more detail below.  
+
+\subsection{Obstools}
+
+A series of Fortran utilities is provided with NEMO called OBSTOOLS. This are helpful in
+handling observation files and the feedback file output from the NEMO observation operator.
+The utilities are as follows
+
+\subsubsection{c4comb}
+
+The program c4comb combines multiple class 4 files produced by individual processors in an
+MPI run of NEMO offline obs\_oper into a single class 4 file. The program is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+c4comb.exe outputfile inputfile1 inputfile2 ...
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{corio2fb}
+
+The program corio2fb converts profile observation files from the Coriolis format to the
+standard feedback format. The program is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+corio2fb.exe outputfile inputfile1 inputfile2 ...
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{enact2fb}
+
+The program enact2fb converts profile observation files from the ENACT format to the standard
+feedback format. The program is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+enact2fb.exe outputfile inputfile1 inputfile2 ...
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{fbcomb}
+
+The program fbcomb combines multiple feedback files produced by individual processors in an
+MPI run of NEMO into a single feedback file. The program is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+fbcomb.exe outputfile inputfile1 inputfile2 ...
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{fbmatchup}
+
+The program fbmatchup will match observations from two feedback files. The program is called
+in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+fbmatchup.exe outputfile inputfile1 varname1 inputfile2 varname2 ...
+\end{verbatim}
+\end{alltt}
+
+
+\subsubsection{fbprint}
+
+The program fbprint will print the contents of a feedback file or files to standard output.
+Selected information can be output using optional arguments. The program is called in the
+following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+fbprint.exe [options] inputfile
+
+options:
+     -b            shorter output
+     -q            Select observations based on QC flags
+     -Q            Select observations based on QC flags
+     -B            Select observations based on QC flags
+     -u            unsorted
+     -s ID         select station ID  
+     -t TYPE       select observation type
+     -v NUM1-NUM2  select variable range to print by number 
+                      (default all)
+     -a NUM1-NUM2  select additional variable range to print by number 
+                      (default all)
+     -e NUM1-NUM2  select extra variable range to print by number 
+                      (default all)
+     -d            output date range
+     -D            print depths
+     -z            use zipped files
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{fbsel}
+
+The program fbsel will select or subsample observations. The program is called in the
+following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+fbsel.exe <input filename> <output filename>
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{fbstat}
+
+The program fbstat will output summary statistics in different global areas into a number of
+files. The program is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+fbstat.exe [-nmlev] <filenames>
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{fbthin}
+
+The program fbthin will thin the data to 1 degree resolution. The code could easily be
+modified to thin to a different resolution. The program is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+fbthin.exe inputfile outputfile
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{sla2fb}
+
+The program sla2fb will convert an AVISO SLA format file to feedback format. The program is
+called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+sla2fb.exe [-s type] outputfile inputfile1 inputfile2 ...
+
+Option:
+     -s            Select altimeter data_source
+\end{verbatim}
+\end{alltt}
+
+\subsubsection{vel2fb}
+
+The program vel2fb will convert TAO/PIRATA/RAMA currents files to feedback format. The program
+is called in the following way:
+
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+vel2fb.exe outputfile inputfile1 inputfile2 ...
+\end{verbatim}
+\end{alltt}
+
+\subsection{building the obstools}
+
+To build the obstools use in the tools directory use ./maketools -n OBSTOOLS -m [ARCH].
+
+\subsection{Dataplot}
+
+An IDL program called dataplot is included which uses a graphical interface to visualise
+observations and feedback files. It is possible to zoom in, plot individual profiles and
+calculate some basic statistics. To plot some data run IDL and then:
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+IDL> dataplot, "filename"
+\end{verbatim}
+\end{alltt}
+
+To read multiple files into dataplot, for example multiple feedback files from different
+processors or from different days, the easiest method is to use the spawn command to generate
+a list of files which can then be passed to dataplot.
+\begin{alltt}
+\footnotesize
+\begin{verbatim}
+IDL> spawn, 'ls profb*.nc', files
+IDL> dataplot, files
+\end{verbatim}
+\end{alltt}
+
+Fig~\ref{fig:obsdataplotmain} shows the main window which is launched when dataplot starts.
+This is split into three parts. At the top there is a menu bar which contains a variety of
+drop down menus. Areas - zooms into prespecified regions; plot - plots the data as a
+timeseries or a T-S diagram if appropriate; Find - allows data to be searched; Config - sets
+various configuration options.
+
+The middle part is a plot of the geographical location of the observations. This will plot the
+observation value, the model background value or observation minus background value depending
+on the option selected in the radio button at the bottom of the window. The plotting colour
+range can be changed by clicking on the colour bar. The title of the plot gives some basic
+information about the date range and depth range shown, the extreme values, and the mean and
+rms values. It is possible to zoom in using a drag-box. You may also zoom in or out using the
+mouse wheel.
+
+The bottom part of the window controls what is visible in the plot above. There are two bars
+which select the level range plotted (for profile data). The other bars below select the date
+range shown. The bottom of the figure allows the option to plot the mean, root mean square,
+standard deviation or mean square values. As mentioned above you can choose to plot the
+observation value, the model background value or observation minus background value. The next
+group of radio buttons selects the map projection. This can either be regular latitude
+longitude grid, or north or south polar stereographic. The next group of radio buttons will
+plot bad observations, switch to salinity and plot density for profile observations. The
+rightmost group of buttons will print the plot window as a postscript, save it as png, or exit
+from dataplot.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}     \begin{center}
+%\includegraphics[width=10cm,height=12cm,angle=-90.]{Fig_OBS_dataplot_main}
+\includegraphics[width=9cm,angle=-90.]{Fig_OBS_dataplot_main}
+\caption{      \label{fig:obsdataplotmain}
+Main window of dataplot.}
+\end{center}     \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+If a profile point is clicked with the mouse button a plot of the observation and background
+values as a function of depth (Fig~\ref{fig:obsdataplotprofile}).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}     \begin{center}
+%\includegraphics[width=10cm,height=12cm,angle=-90.]{Fig_OBS_dataplot_prof}
+\includegraphics[width=7cm,angle=-90.]{Fig_OBS_dataplot_prof}
+\caption{      \label{fig:obsdataplotprofile}
+Profile plot from dataplot produced by right clicking on a point in the main window.}
+\end{center}     \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_SBC.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 8732)
@@ -0,0 +1,1365 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter —— Surface Boundary Condition (SBC, ISF, ICB) 
+% ================================================================
+\chapter{Surface Boundary Condition (SBC, ISF, ICB) }
+\label{SBC}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+%---------------------------------------namsbc--------------------------------------------------
+\namdisplay{namsbc}
+%--------------------------------------------------------------------------------------------------------------
+$\ $\newline    % force a new ligne
+
+The ocean needs six fields as surface boundary condition:
+\begin{itemize}
+	\item the two components of the surface ocean stress $\left( {\tau _u \;,\;\tau _v} \right)$
+	\item the incoming solar and non solar heat fluxes $\left( {Q_{ns} \;,\;Q_{sr} } \right)$
+	\item the surface freshwater budget $\left( {\textit{emp}} \right)$
+	\item the surface salt flux associated with freezing/melting of seawater $\left( {\textit{sfx}} \right)$
+\end{itemize}
+plus an optional field:
+\begin{itemize}
+	\item the atmospheric pressure at the ocean surface $\left( p_a \right)$
+\end{itemize}
+
+Five different ways to provide the first six fields to the ocean are available which 
+are controlled by namelist \ngn{namsbc} variables: an analytical formulation (\np{ln\_ana}~=~true), 
+a flux formulation (\np{ln\_flx}~=~true), a bulk formulae formulation (CORE 
+(\np{ln\_blk\_core}~=~true), CLIO (\np{ln\_blk\_clio}~=~true) or MFS
+\footnote { Note that MFS bulk formulae compute fluxes only for the ocean component}
+(\np{ln\_blk\_mfs}~=~true) bulk formulae) and a coupled or mixed forced/coupled formulation 
+(exchanges with a atmospheric model via the OASIS coupler) (\np{ln\_cpl} or \np{ln\_mixcpl}~=~true). 
+When used ($i.e.$ \np{ln\_apr\_dyn}~=~true), the atmospheric pressure forces both ocean and ice dynamics.
+
+The frequency at which the forcing fields have to be updated is given by the \np{nn\_fsbc} namelist parameter. 
+When the fields are supplied from data files (flux and bulk formulations), the input fields 
+need not be supplied on the model grid. Instead a file of coordinates and weights can 
+be supplied which maps the data from the supplied grid to the model points 
+(so called "Interpolation on the Fly", see \S\ref{SBC_iof}).
+If the Interpolation on the Fly option is used, input data belonging to land points (in the native grid),
+can be masked to avoid spurious results in proximity of the coasts  as large sea-land gradients characterize
+most of the atmospheric variables.
+
+In addition, the resulting fields can be further modified using several namelist options. 
+These options control 
+\begin{itemize}
+\item the rotation of vector components supplied relative to an east-north 
+coordinate system onto the local grid directions in the model ; 
+\item the addition of a surface restoring term to observed SST and/or SSS (\np{ln\_ssr}~=~true) ; 
+\item the modification of fluxes below ice-covered areas (using observed ice-cover or a sea-ice model) (\np{nn\_ice}~=~0,1, 2 or 3) ; 
+\item the addition of river runoffs as surface freshwater fluxes or lateral inflow (\np{ln\_rnf}~=~true) ; 
+\item the addition of isf melting as lateral inflow (parameterisation) or as fluxes applied at the land-ice ocean interface (\np{ln\_isf}) ; 
+\item the addition of a freshwater flux adjustment in order to avoid a mean sea-level drift (\np{nn\_fwb}~=~0,~1~or~2) ; 
+\item the transformation of the solar radiation (if provided as daily mean) into a diurnal cycle (\np{ln\_dm2dc}~=~true) ; 
+and a neutral drag coefficient can be read from an external wave model (\np{ln\_cdgw}~=~true). 
+\end{itemize}
+The latter option is possible only in case core or mfs bulk formulas are selected.
+
+In this chapter, we first discuss where the surface boundary condition appears in the
+model equations. Then we present the five ways of providing the surface boundary condition, 
+followed by the description of the atmospheric pressure and the river runoff. 
+Next the scheme for interpolation on the fly is described.
+Finally, the different options that further modify the fluxes applied to the ocean are discussed.
+One of these is modification by icebergs (see \S\ref{ICB_icebergs}), which act as drifting sources of fresh water.
+Another example of modification is that due to the ice shelf melting/freezing (see \S\ref{SBC_isf}), 
+which provides additional sources of fresh water.
+
+
+% ================================================================
+% Surface boundary condition for the ocean
+% ================================================================
+\section{Surface boundary condition for the ocean}
+\label{SBC_general}
+
+The surface ocean stress is the stress exerted by the wind and the sea-ice 
+on the ocean. It is applied in \mdl{dynzdf} module as a surface boundary condition of the 
+computation of the momentum vertical mixing trend (see \eqref{Eq_dynzdf_sbc} in \S\ref{DYN_zdf}).
+As such, it has to be provided as a 2D vector interpolated 
+onto the horizontal velocity ocean mesh, $i.e.$ resolved onto the model 
+(\textbf{i},\textbf{j}) direction at $u$- and $v$-points.
+
+The surface heat flux is decomposed into two parts, a non solar and a solar heat 
+flux, $Q_{ns}$ and $Q_{sr}$, respectively. The former is the non penetrative part 
+of the heat flux ($i.e.$ the sum of sensible, latent and long wave heat fluxes 
+plus the heat content of the mass exchange with the atmosphere and sea-ice). 
+It is applied in \mdl{trasbc} module as a surface boundary condition trend of 
+the first level temperature time evolution equation (see \eqref{Eq_tra_sbc} 
+and \eqref{Eq_tra_sbc_lin} in \S\ref{TRA_sbc}). 
+The latter is the penetrative part of the heat flux. It is applied as a 3D 
+trends of the temperature equation (\mdl{traqsr} module) when \np{ln\_traqsr}=\textit{true}.
+The way the light penetrates inside the water column is generally a sum of decreasing 
+exponentials (see \S\ref{TRA_qsr}). 
+
+The surface freshwater budget is provided by the \textit{emp} field.
+It represents the mass flux exchanged with the atmosphere (evaporation minus precipitation) 
+and possibly with the sea-ice and ice shelves (freezing minus melting of ice). 
+It affects both the ocean in two different ways: 
+$(i)$   it changes the volume of the ocean and therefore appears in the sea surface height 
+equation as a volume flux, and 
+$(ii)$  it changes the surface temperature and salinity through the heat and salt contents 
+of the mass exchanged with the atmosphere, the sea-ice and the ice shelves. 
+
+
+%\colorbox{yellow}{Miss: }
+%
+%A extensive description of all namsbc namelist (parameter that have to be 
+%created!)
+%
+%Especially the \np{nn\_fsbc}, the \mdl{sbc\_oce} module (fluxes + mean sst sss ssu 
+%ssv) i.e. information required by flux computation or sea-ice
+%
+%\mdl{sbc\_oce} containt the definition in memory of the 7 fields (6+runoff), add 
+%a word on runoff: included in surface bc or add as lateral obc{\ldots}.
+%
+%Sbcmod manage the ``providing'' (fourniture) to the ocean the 7 fields
+%
+%Fluxes update only each nf{\_}sbc time step (namsbc) explain relation 
+%between nf{\_}sbc and nf{\_}ice, do we define nf{\_}blk??? ? only one 
+%nf{\_}sbc
+%
+%Explain here all the namlist namsbc variable{\ldots}.
+% 
+% explain : use or not of surface currents
+%
+%\colorbox{yellow}{End Miss }
+
+The ocean model provides, at each time step, to the surface module (\mdl{sbcmod}) 
+the surface currents, temperature and salinity.  
+These variables are averaged over \np{nn\_fsbc} time-step (\ref{Tab_ssm}), 
+and it is these averaged fields which are used to computes the surface fluxes 
+at a frequency of \np{nn\_fsbc} time-step.
+
+
+%-------------------------------------------------TABLE---------------------------------------------------
+\begin{table}[tb]   \begin{center}   \begin{tabular}{|l|l|l|l|}
+\hline
+Variable description					& Model variable	& Units	& point \\	\hline
+i-component of the surface current	& ssu\_m	& $m.s^{-1}$	& U \\	\hline
+j-component of the surface current	& ssv\_m	& $m.s^{-1}$	& V \\	\hline
+Sea surface temperature				& sst\_m	& \r{}$K$		& T \\	\hline
+Sea surface salinty					& sss\_m	& $psu$			& T \\	\hline
+\end{tabular}
+\caption{  \label{Tab_ssm}   
+Ocean variables provided by the ocean to the surface module (SBC). 
+The variable are averaged over nn{\_}fsbc time step, 
+$i.e.$ the frequency of computation of surface fluxes.}
+\end{center}   \end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+%\colorbox{yellow}{Penser a} mettre dans le restant l'info nn{\_}fsbc ET nn{\_}fsbc*rdt de sorte de reinitialiser la moyenne si on change la frequence ou le pdt
+
+
+% ================================================================
+%       Input Data 
+% ================================================================
+\section{Input Data generic interface}
+\label{SBC_input}
+
+A generic interface has been introduced to manage the way input data (2D or 3D fields, 
+like surface forcing or ocean T and S) are specify in \NEMO. This task is archieved by fldread.F90. 
+The module was design with four main objectives in mind: 
+\begin{enumerate}  
+\item optionally provide a time interpolation of the input data at model time-step, 
+whatever their input frequency is, and according to the different calendars available in the model.
+\item optionally provide an on-the-fly space interpolation from the native input data grid to the model grid.
+\item make the run duration independent from the period cover by the input files.
+\item provide a simple user interface and a rather simple developer interface by limiting the 
+ number of prerequisite information. 
+\end{enumerate}  
+
+As a results the user have only to fill in for each variable a structure in the namelist file 
+to defined the input data file and variable names, the frequency of the data (in hours or months), 
+whether its is climatological data or not, the period covered by the input file (one year, month, week or day), 
+and three additional parameters for on-the-fly interpolation. When adding a new input variable, 
+the developer has to add the associated structure in the namelist, read this information 
+by mirroring the namelist read in \rou{sbc\_blk\_init} for example, and simply call \rou{fld\_read} 
+to obtain the desired input field at the model time-step and grid points.
+
+The only constraints are that the input file is a NetCDF file, the file name follows a nomenclature 
+(see \S\ref{SBC_fldread}), the period it cover is one year, month, week or day, and, if on-the-fly 
+interpolation is used, a file of weights must be supplied (see \S\ref{SBC_iof}).
+
+Note that when an input data is archived on a disc which is accessible directly 
+from the workspace where the code is executed, then the use can set the \np{cn\_dir} 
+to the pathway leading to the data. By default, the data are assumed to have been 
+copied so that cn\_dir='./'.
+
+% -------------------------------------------------------------------------------------------------------------
+% Input Data specification (\mdl{fldread})
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Input Data specification (\mdl{fldread})}
+\label{SBC_fldread}
+
+The structure associated with an input variable contains the following information:
+\begin{alltt}  {{\tiny    
+\begin{verbatim}
+!  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
+!             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+\end{verbatim}
+}}\end{alltt} 
+where 
+\begin{description}  
+\item[File name]: the stem name of the NetCDF file to be open. 
+This stem will be completed automatically by the model, with the addition of a '.nc' at its end 
+and by date information and possibly a prefix (when using AGRIF). 
+Tab.\ref{Tab_fldread} provides the resulting file name in all possible cases according to whether 
+it is a climatological file or not, and to the open/close frequency (see below for definition). 
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp] 
+\begin{center}
+\begin{tabular}{|l|c|c|c|}
+\hline
+                         & daily or weekLLL	        & monthly                   &   yearly          \\   \hline
+clim = false	& fn\_yYYYYmMMdDD  &   fn\_yYYYYmMM   &   fn\_yYYYY  \\   \hline
+clim = true	 	   & not possible 	              &  fn\_m??.nc             &   fn                \\   \hline
+\end{tabular}
+\end{center}
+\caption{ \label{Tab_fldread}   naming nomenclature for climatological or interannual input file, 
+as a function of the Open/close frequency. The stem name is assumed to be 'fn'. 
+For weekly files, the 'LLL' corresponds to the first three letters of the first day of the week ($i.e.$ 'sun','sat','fri','thu','wed','tue','mon'). The 'YYYY', 'MM' and 'DD' should be replaced by the 
+actual year/month/day, always coded with 4 or 2 digits. Note that (1) in mpp, if the file is split 
+over each subdomain, the suffix '.nc' is replaced by '\_PPPP.nc', where 'PPPP' is the 
+process number coded with 4 digits; (2) when using AGRIF, the prefix
+'\_N' is added to files, 
+where 'N'  is the child grid number.}
+\end{table}
+%--------------------------------------------------------------------------------------------------------------
+  
+
+\item[Record frequency]: the frequency of the records contained in the input file. 
+Its unit is in hours if it is positive (for example 24 for daily forcing) or in months if negative 
+(for example -1 for monthly forcing or -12 for annual forcing). 
+Note that this frequency must really be an integer and not a real. 
+On some computers, seting it to '24.' can be interpreted as 240!
+
+\item[Variable name]: the name of the variable to be read in the input NetCDF file.
+
+\item[Time interpolation]: a logical to activate, or not, the time interpolation. If set to 'false', 
+the forcing will have a steplike shape remaining constant during each forcing period. 
+For example, when using a daily forcing without time interpolation, the forcing remaining 
+constant from 00h00'00'' to 23h59'59". If set to 'true', the forcing will have a broken line shape. 
+Records are assumed to be dated the middle of the forcing period. 
+For example, when using a daily forcing with time interpolation, linear interpolation will 
+be performed between mid-day of two consecutive days. 
+
+\item[Climatological forcing]: a logical to specify if a input file contains climatological forcing 
+which can be cycle in time, or an interannual forcing which will requires additional files 
+if the period covered by the simulation exceed the one of the file. See the above the file 
+naming strategy which impacts the expected name of the file to be opened. 
+
+\item[Open/close frequency]: the frequency at which forcing files must be opened/closed. 
+Four cases are coded: 'daily', 'weekLLL' (with 'LLL' the first 3 letters of the first day of the week), 
+'monthly' and 'yearly' which means the forcing files will contain data for one day, one week, 
+one month or one year. Files are assumed to contain data from the beginning of the open/close period. 
+For example, the first record of a yearly file containing daily data is Jan 1st even if the experiment 
+is not starting at the beginning of the year. 
+
+\item[Others]: 'weights filename', 'pairing rotation' and 'land/sea mask' are associted with on-the-fly interpolation 
+which is described in \S\ref{SBC_iof}.
+
+\end{description}
+
+Additional remarks:\\
+(1) The time interpolation is a simple linear interpolation between two consecutive records of 
+the input data. The only tricky point is therefore to specify the date at which we need to do 
+the interpolation and the date of the records read in the input files. 
+Following \citet{Leclair_Madec_OM09}, the date of a time step is set at the middle of the 
+time step. For example, for an experiment starting at 0h00'00" with a one hour time-step, 
+a time interpolation will be performed at the following time: 0h30'00", 1h30'00", 2h30'00", etc.
+However, for forcing data related to the surface module, values are not needed at every 
+time-step but at every \np{nn\_fsbc} time-step. For example with \np{nn\_fsbc}~=~3, 
+the surface module will be called at time-steps 1, 4, 7, etc. The date used for the time interpolation 
+is thus redefined to be at the middle of \np{nn\_fsbc} time-step period. In the previous example, 
+this leads to: 1h30'00", 4h30'00", 7h30'00", etc. \\ 
+(2) For code readablility and maintenance issues, we don't take into account the NetCDF input file 
+calendar. The calendar associated with the forcing field is build according to the information 
+provided by user in the record frequency, the open/close frequency and the type of temporal interpolation. 
+For example, the first record of a yearly file containing daily data that will be interpolated in time 
+is assumed to be start Jan 1st at 12h00'00" and end Dec 31st at 12h00'00". \\
+(3) If a time interpolation is requested, the code will pick up the needed data in the previous (next) file 
+when interpolating data with the first (last) record of the open/close period. 
+For example, if the input file specifications are ''yearly, containing daily data to be interpolated in time'', 
+the values given by the code between 00h00'00" and 11h59'59" on Jan 1st will be interpolated values 
+between Dec 31st 12h00'00" and Jan 1st 12h00'00". If the forcing is climatological, Dec and Jan will 
+be keep-up from the same year. However, if the forcing is not climatological, at the end of the 
+open/close period the code will automatically close the current file and open the next one. 
+Note that, if the experiment is starting (ending) at the beginning (end) of an open/close period 
+we do accept that the previous (next) file is not existing. In this case, the time interpolation 
+will be performed between two identical values. For example, when starting an experiment on 
+Jan 1st of year Y with yearly files and daily data to be interpolated, we do accept that the file 
+related to year Y-1 is not existing. The value of Jan 1st will be used as the missing one for 
+Dec 31st of year Y-1. If the file of year Y-1 exists, the code will read its last record. 
+Therefore, this file can contain only one record corresponding to Dec 31st, a useful feature for 
+user considering that it is too heavy to manipulate the complete file for year Y-1.
+
+
+% -------------------------------------------------------------------------------------------------------------
+% Interpolation on the Fly
+% -------------------------------------------------------------------------------------------------------------
+\subsection [Interpolation on-the-Fly] {Interpolation on-the-Fly}
+\label{SBC_iof}
+
+Interpolation on the Fly allows the user to supply input files required
+for the surface forcing on grids other than the model grid.
+To do this he or she must supply, in addition to the source data file,
+a file of weights to be used to interpolate from the data grid to the model grid.
+The original development of this code used the SCRIP package (freely available 
+\href{http://climate.lanl.gov/Software/SCRIP}{here} under a copyright agreement).
+In principle, any package can be used to generate the weights, but the
+variables in the input weights file must have the same names and meanings as
+assumed by the model.
+Two methods are currently available: bilinear and bicubic interpolation.
+Prior to the interpolation, providing a land/sea mask file, the user can decide to
+ remove land points from the input file and substitute the corresponding values 
+with the average of the 8 neighbouring points in the native external grid.
+ Only "sea points" are considered for the averaging. The land/sea mask file must 
+be provided in the structure associated with the input variable.
+ The netcdf land/sea mask variable name must be 'LSM' it must have the same 
+horizontal and vertical dimensions of the associated variable and should 
+be equal to 1 over land and 0 elsewhere.
+The procedure can be recursively applied setting nn\_lsm > 1 in namsbc namelist. 
+Note that nn\_lsm=0 forces the code to not apply the procedure even if a file for land/sea mask is supplied.
+
+\subsubsection{Bilinear Interpolation}
+\label{SBC_iof_bilinear}
+
+The input weights file in this case has two sets of variables: src01, src02,
+src03, src04 and wgt01, wgt02, wgt03, wgt04.
+The "src" variables correspond to the point in the input grid to which the weight
+"wgt" is to be applied. Each src value is an integer corresponding to the index of a 
+point in the input grid when written as a one dimensional array.  For example, for an input grid
+of size 5x10, point (3,2) is referenced as point 8, since (2-1)*5+3=8.
+There are four of each variable because bilinear interpolation uses the four points defining
+the grid box containing the point to be interpolated.
+All of these arrays are on the model grid, so that values src01(i,j) and
+wgt01(i,j) are used to generate a value for point (i,j) in the model.
+
+Symbolically, the algorithm used is:
+
+\begin{equation}
+f_{m}(i,j) = f_{m}(i,j) + \sum_{k=1}^{4} {wgt(k)f(idx(src(k)))}
+\end{equation}
+where function idx() transforms a one dimensional index src(k) into a two dimensional index,
+and wgt(1) corresponds to variable "wgt01" for example.
+
+\subsubsection{Bicubic Interpolation}
+\label{SBC_iof_bicubic}
+
+Again there are two sets of variables: "src" and "wgt".
+But in this case there are 16 of each.
+The symbolic algorithm used to calculate values on the model grid is now:
+
+\begin{equation*} \begin{split}
+f_{m}(i,j) =  f_{m}(i,j) +& \sum_{k=1}^{4} {wgt(k)f(idx(src(k)))}     
+              +   \sum_{k=5}^{8} {wgt(k)\left.\frac{\partial f}{\partial i}\right| _{idx(src(k))} }    \\
+              +& \sum_{k=9}^{12} {wgt(k)\left.\frac{\partial f}{\partial j}\right| _{idx(src(k))} }   
+              +   \sum_{k=13}^{16} {wgt(k)\left.\frac{\partial ^2 f}{\partial i \partial j}\right| _{idx(src(k))} }
+\end{split}
+\end{equation*}
+The gradients here are taken with respect to the horizontal indices and not distances since the spatial dependency has been absorbed into the weights.
+
+\subsubsection{Implementation}
+\label{SBC_iof_imp}
+
+To activate this option, a non-empty string should be supplied in the weights filename column 
+of the relevant namelist; if this is left as an empty string no action is taken.
+In the model, weights files are read in and stored in a structured type (WGT) in the fldread 
+module, as and when they are first required.
+This initialisation procedure determines whether the input data grid should be treated 
+as cyclical or not by inspecting a global attribute stored in the weights input file.
+This attribute must be called "ew\_wrap" and be of integer type.
+If it is negative, the input non-model grid is assumed not to be cyclic.
+If zero or greater, then the value represents the number of columns that overlap.
+$E.g.$ if the input grid has columns at longitudes 0, 1, 2, .... , 359, then ew\_wrap should be set to 0;
+if longitudes are 0.5, 2.5, .... , 358.5, 360.5, 362.5, ew\_wrap should be 2.
+If the model does not find attribute ew\_wrap, then a value of -999 is assumed.
+In this case the \rou{fld\_read} routine defaults ew\_wrap to value 0 and therefore the grid 
+is assumed to be cyclic with no overlapping columns.
+(In fact this only matters when bicubic interpolation is required.)
+Note that no testing is done to check the validity in the model, since there is no way 
+of knowing the name used for the longitude variable,
+so it is up to the user to make sure his or her data is correctly represented.
+
+Next the routine reads in the weights.
+Bicubic interpolation is assumed if it finds a variable with name "src05", otherwise 
+bilinear interpolation is used. The WGT structure includes dynamic arrays both for 
+the storage of the weights (on the model grid), and when required, for reading in 
+the variable to be interpolated (on the input data grid).
+The size of the input data array is determined by examining the values in the "src" 
+arrays to find the minimum and maximum i and j values required.
+Since bicubic interpolation requires the calculation of gradients at each point on the grid, 
+the corresponding arrays are dimensioned with a halo of width one grid point all the way around.
+When the array of points from the data file is adjacent to an edge of the data grid, 
+the halo is either a copy of the row/column next to it (non-cyclical case), or is a copy 
+of one from the first few columns on the opposite side of the grid (cyclical case).
+
+\subsubsection{Limitations}
+\label{SBC_iof_lim}
+
+\begin{enumerate}  
+\item  The case where input data grids are not logically rectangular has not been tested.
+\item  This code is not guaranteed to produce positive definite answers from positive definite inputs
+          when a bicubic interpolation method is used.
+\item  The cyclic condition is only applied on left and right columns, and not to top and bottom rows.
+\item  The gradients across the ends of a cyclical grid assume that the grid spacing between 
+          the two columns involved are consistent with the weights used.
+\item  Neither interpolation scheme is conservative. (There is a conservative scheme available 
+          in SCRIP, but this has not been implemented.)
+\end{enumerate}
+
+\subsubsection{Utilities}
+\label{SBC_iof_util}
+
+% to be completed
+A set of utilities to create a weights file for a rectilinear input grid is available 
+(see the directory NEMOGCM/TOOLS/WEIGHTS).
+
+% -------------------------------------------------------------------------------------------------------------
+% Standalone Surface Boundary Condition Scheme
+% -------------------------------------------------------------------------------------------------------------
+\subsection [Standalone Surface Boundary Condition Scheme] {Standalone Surface Boundary Condition Scheme}
+\label{SAS_iof}
+
+%---------------------------------------namsbc_ana--------------------------------------------------
+\namdisplay{namsbc_sas}
+%--------------------------------------------------------------------------------------------------------------
+
+In some circumstances it may be useful to avoid calculating the 3D temperature, salinity and velocity fields 
+and simply read them in from a previous run or receive them from OASIS.  
+For example:
+
+\begin{itemize}
+\item  Multiple runs of the model are required in code development to see the effect of different algorithms in
+       the bulk formulae.
+\item  The effect of different parameter sets in the ice model is to be examined.
+\item  Development of sea-ice algorithms or parameterizations.
+\item  spinup of the iceberg floats
+\item  ocean/sea-ice simulation with both media running in parallel (\np{ln\_mixcpl}~=~\textit{true})
+\end{itemize}
+
+The StandAlone Surface scheme provides this utility.
+Its options are defined through the \ngn{namsbc\_sas} namelist variables.
+A new copy of the model has to be compiled with a configuration based on ORCA2\_SAS\_LIM.
+However no namelist parameters need be changed from the settings of the previous run (except perhaps nn{\_}date0)
+In this configuration, a few routines in the standard model are overriden by new versions.
+Routines replaced are:
+
+\begin{itemize}
+\item \mdl{nemogcm} : This routine initialises the rest of the model and repeatedly calls the stp time stepping routine (step.F90)
+       Since the ocean state is not calculated all associated initialisations have been removed.
+\item  \mdl{step} : The main time stepping routine now only needs to call the sbc routine (and a few utility functions).
+\item  \mdl{sbcmod} : This has been cut down and now only calculates surface forcing and the ice model required.  New surface modules
+       that can function when only the surface level of the ocean state is defined can also be added (e.g. icebergs).
+\item  \mdl{daymod} : No ocean restarts are read or written (though the ice model restarts are retained), so calls to restart functions
+       have been removed.  This also means that the calendar cannot be controlled by time in a restart file, so the user
+       must make sure that nn{\_}date0 in the model namelist is correct for his or her purposes.
+\item  \mdl{stpctl} : Since there is no free surface solver, references to it have been removed from \rou{stp\_ctl} module.
+\item  \mdl{diawri} : All 3D data have been removed from the output.  The surface temperature, salinity and velocity components (which
+       have been read in) are written along with relevant forcing and ice data.
+\end{itemize}
+
+One new routine has been added:
+
+\begin{itemize}
+\item  \mdl{sbcsas} : This module initialises the input files needed for reading temperature, salinity and velocity arrays at the surface.
+       These filenames are supplied in namelist namsbc{\_}sas.  Unfortunately because of limitations with the \mdl{iom} module,
+       the full 3D fields from the mean files have to be read in and interpolated in time, before using just the top level.
+       Since fldread is used to read in the data, Interpolation on the Fly may be used to change input data resolution.
+\end{itemize}
+
+
+% Missing the description of the 2 following variables:
+%   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
+%   ln_read_frq = .false.    !  specify whether we must read frq or not
+
+
+
+% ================================================================
+% Analytical formulation (sbcana module) 
+% ================================================================
+\section  [Analytical formulation (\textit{sbcana}) ]
+		{Analytical formulation (\mdl{sbcana} module) }
+\label{SBC_ana}
+
+%---------------------------------------namsbc_ana--------------------------------------------------
+\namdisplay{namsbc_ana}
+%--------------------------------------------------------------------------------------------------------------
+
+The analytical formulation of the surface boundary condition is the default scheme.
+In this case, all the six fluxes needed by the ocean are assumed to 
+be uniform in space. They take constant values given in the namelist 
+\ngn{namsbc{\_}ana} by the variables \np{rn\_utau0}, \np{rn\_vtau0}, \np{rn\_qns0}, 
+\np{rn\_qsr0}, and \np{rn\_emp0} ($\textit{emp}=\textit{emp}_S$). The runoff is set to zero. 
+In addition, the wind is allowed to reach its nominal value within a given number 
+of time steps (\np{nn\_tau000}).
+
+If a user wants to apply a different analytical forcing, the \mdl{sbcana} 
+module can be modified to use another scheme. As an example, 
+the \mdl{sbc\_ana\_gyre} routine provides the analytical forcing for the 
+GYRE configuration (see GYRE configuration manual, in preparation).
+
+
+% ================================================================
+% Flux formulation 
+% ================================================================
+\section  [Flux formulation (\textit{sbcflx}) ]
+		{Flux formulation (\mdl{sbcflx} module) }
+\label{SBC_flx}
+%------------------------------------------namsbc_flx----------------------------------------------------
+\namdisplay{namsbc_flx} 
+%-------------------------------------------------------------------------------------------------------------
+
+In the flux formulation (\np{ln\_flx}=true), the surface boundary 
+condition fields are directly read from input files. The user has to define 
+in the namelist \ngn{namsbc{\_}flx} the name of the file, the name of the variable 
+read in the file, the time frequency at which it is given (in hours), and a logical 
+setting whether a time interpolation to the model time step is required 
+for this field. See \S\ref{SBC_fldread} for a more detailed description of the parameters.
+
+Note that in general, a flux formulation is used in associated with a 
+restoring term to observed SST and/or SSS. See \S\ref{SBC_ssr} for its 
+specification.
+
+
+% ================================================================
+% Bulk formulation
+% ================================================================
+\section  [Bulk formulation (\textit{sbcblk\_core}, \textit{sbcblk\_clio} or \textit{sbcblk\_mfs}) ]
+		{Bulk formulation \small{(\mdl{sbcblk\_core} \mdl{sbcblk\_clio} \mdl{sbcblk\_mfs} modules)} }
+\label{SBC_blk}
+
+In the bulk formulation, the surface boundary condition fields are computed 
+using bulk formulae and atmospheric fields and ocean (and ice) variables. 
+
+The atmospheric fields used depend on the bulk formulae used. Three bulk formulations 
+are available : the CORE, the CLIO and the MFS bulk formulea. The choice is made by setting to true
+one of the following namelist variable : \np{ln\_core} ; \np{ln\_clio} or  \np{ln\_mfs}.
+
+Note : in forced mode, when a sea-ice model is used, a bulk formulation (CLIO or CORE) have to be used. 
+Therefore the two bulk (CLIO and CORE) formulea include the computation of the fluxes over both 
+an ocean and an ice surface. 
+
+% -------------------------------------------------------------------------------------------------------------
+%        CORE Bulk formulea
+% -------------------------------------------------------------------------------------------------------------
+\subsection    [CORE Bulk formulea (\np{ln\_core}=true)]
+		      {CORE Bulk formulea (\np{ln\_core}=true, \mdl{sbcblk\_core})}
+\label{SBC_blk_core}
+%------------------------------------------namsbc_core----------------------------------------------------
+\namdisplay{namsbc_core} 
+%-------------------------------------------------------------------------------------------------------------
+
+The CORE bulk formulae have been developed by \citet{Large_Yeager_Rep04}. 
+They have been designed to handle the CORE forcing, a mixture of NCEP 
+reanalysis and satellite data. They use an inertial dissipative method to compute 
+the turbulent transfer coefficients (momentum, sensible heat and evaporation) 
+from the 10 metre wind speed, air temperature and specific humidity.
+This \citet{Large_Yeager_Rep04} dataset is available through the 
+\href{http://nomads.gfdl.noaa.gov/nomads/forms/mom4/CORE.html}{GFDL web site}. 
+
+Note that substituting ERA40 to NCEP reanalysis fields 
+does not require changes in the bulk formulea themself. 
+This is the so-called DRAKKAR Forcing Set (DFS) \citep{Brodeau_al_OM09}. 
+
+Options are defined through the  \ngn{namsbc\_core} namelist variables.
+The required 8 input fields are:
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]   \label{Tab_CORE}
+\begin{center}
+\begin{tabular}{|l|c|c|c|}
+\hline
+Variable desciption					& Model variable	& Units	 & point \\		\hline
+i-component of the 10m air velocity	& utau		& $m.s^{-1}$			& T  \\ 	\hline
+j-component of the 10m air velocity	& vtau		& $m.s^{-1}$			& T  \\	\hline
+10m air temperature					& tair		& \r{}$K$				& T 	\\	\hline
+Specific humidity					& humi		& \%					& T \\		\hline
+Incoming long wave radiation		& qlw		& $W.m^{-2}$			& T \\		\hline
+Incoming short wave radiation		& qsr		& $W.m^{-2}$			& T \\		\hline
+Total precipitation (liquid + solid)	& precip	& $Kg.m^{-2}.s^{-1}$	& T \\ 	\hline
+Solid precipitation					& snow		& $Kg.m^{-2}.s^{-1}$	& T \\	\hline
+\end{tabular}
+\end{center}
+\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+Note that the air velocity is provided at a tracer ocean point, not at a velocity ocean 
+point ($u$- and $v$-points). It is simpler and faster (less fields to be read), 
+but it is not the recommended method when the ocean grid size is the same 
+or larger than the one of the input atmospheric fields.
+
+The \np{sn\_wndi}, \np{sn\_wndj}, \np{sn\_qsr}, \np{sn\_qlw}, \np{sn\_tair}, \np{sn\_humi},
+\np{sn\_prec}, \np{sn\_snow}, \np{sn\_tdif} parameters describe the fields 
+and the way they have to be used (spatial and temporal interpolations). 
+
+\np{cn\_dir} is the directory of location of bulk files
+\np{ln\_taudif} is the flag to specify if we use Hight Frequency (HF) tau information (.true.) or not (.false.)
+\np{rn\_zqt}: is the height of humidity and temperature measurements (m)
+\np{rn\_zu}: is the height of wind measurements (m)
+
+Three multiplicative factors are availables : 
+\np{rn\_pfac} and \np{rn\_efac} allows to adjust (if necessary) the global freshwater budget 
+by increasing/reducing the precipitations (total and snow) and or evaporation, respectively.
+The third one,\np{rn\_vfac}, control to which extend the ice/ocean velocities are taken into account 
+in the calculation of surface wind stress. Its range should be between zero and one, 
+and it is recommended to set it to 0.
+
+% -------------------------------------------------------------------------------------------------------------
+%        CLIO Bulk formulea
+% -------------------------------------------------------------------------------------------------------------
+\subsection    [CLIO Bulk formulea (\np{ln\_clio}=true)]
+		      {CLIO Bulk formulea (\np{ln\_clio}=true, \mdl{sbcblk\_clio})}
+\label{SBC_blk_clio}
+%------------------------------------------namsbc_clio----------------------------------------------------
+\namdisplay{namsbc_clio} 
+%-------------------------------------------------------------------------------------------------------------
+
+The CLIO bulk formulae were developed several years ago for the 
+Louvain-la-neuve coupled ice-ocean model (CLIO, \cite{Goosse_al_JGR99}). 
+They are simpler bulk formulae. They assume the stress to be known and 
+compute the radiative fluxes from a climatological cloud cover. 
+
+Options are defined through the  \ngn{namsbc\_clio} namelist variables.
+The required 7 input fields are:
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]   \label{Tab_CLIO}
+\begin{center}
+\begin{tabular}{|l|l|l|l|}
+\hline
+Variable desciption				& Model variable	& Units				& point \\	\hline
+i-component of the ocean stress		& utau			& $N.m^{-2}$			& U \\	\hline
+j-component of the ocean stress		& vtau			& $N.m^{-2}$			& V \\	\hline
+Wind speed module					& vatm			& $m.s^{-1}$			& T \\	\hline
+10m air temperature					& tair			& \r{}$K$				& T \\	\hline
+Specific humidity						& humi			& \%					& T \\	\hline
+Cloud cover							& 				& \%					& T \\	\hline
+Total precipitation (liquid + solid)	& precip		& $Kg.m^{-2}.s^{-1}$	& T \\	\hline
+Solid precipitation 					& snow			& $Kg.m^{-2}.s^{-1}$	& T \\	\hline
+\end{tabular}
+\end{center}
+\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+As for the flux formulation, information about the input data required by the 
+model is provided in the namsbc\_blk\_core or namsbc\_blk\_clio 
+namelist (see \S\ref{SBC_fldread}). 
+
+% -------------------------------------------------------------------------------------------------------------
+%        MFS Bulk formulae
+% -------------------------------------------------------------------------------------------------------------
+\subsection    [MFS Bulk formulea (\np{ln\_mfs}=true)]
+		      {MFS Bulk formulea (\np{ln\_mfs}=true, \mdl{sbcblk\_mfs})}
+\label{SBC_blk_mfs}
+%------------------------------------------namsbc_mfs----------------------------------------------------
+\namdisplay{namsbc_mfs} 
+%----------------------------------------------------------------------------------------------------------
+
+The MFS (Mediterranean Forecasting System) bulk formulae have been developed by
+ \citet{Castellari_al_JMS1998}. 
+They have been designed to handle the ECMWF operational data and are currently 
+in use in the MFS operational system \citep{Tonani_al_OS08}, \citep{Oddo_al_OS09}.
+The wind stress computation uses a drag coefficient computed according to \citet{Hellerman_Rosenstein_JPO83}.
+The surface boundary condition for temperature involves the balance between surface solar radiation,
+net long-wave radiation, the latent and sensible heat fluxes.
+Solar radiation is dependent on cloud cover and is computed by means of
+an astronomical formula \citep{Reed_JPO77}. Albedo monthly values are from \citet{Payne_JAS72} 
+as means of the values at $40^{o}N$ and $30^{o}N$ for the Atlantic Ocean (hence the same latitudinal
+band of the Mediterranean Sea). The net long-wave radiation flux
+\citep{Bignami_al_JGR95} is a function of
+air temperature, sea-surface temperature, cloud cover and relative humidity.
+Sensible heat and latent heat fluxes are computed by classical
+bulk formulae parameterised according to \citet{Kondo1975}.
+Details on the bulk formulae used can be found in \citet{Maggiore_al_PCE98} and \citet{Castellari_al_JMS1998}.
+
+Options are defined through the  \ngn{namsbc\_mfs} namelist variables.
+The required 7 input fields must be provided on the model Grid-T and  are:
+\begin{itemize}
+\item          Zonal Component of the 10m wind ($ms^{-1}$)  (\np{sn\_windi})
+\item          Meridional Component of the 10m wind ($ms^{-1}$)  (\np{sn\_windj})
+\item          Total Claud Cover (\%)  (\np{sn\_clc})
+\item          2m Air Temperature ($K$) (\np{sn\_tair})
+\item          2m Dew Point Temperature ($K$)  (\np{sn\_rhm})
+\item          Total Precipitation ${Kg} m^{-2} s^{-1}$ (\np{sn\_prec})
+\item          Mean Sea Level Pressure (${Pa}$) (\np{sn\_msl})
+\end{itemize}
+% -------------------------------------------------------------------------------------------------------------
+% ================================================================
+% Coupled formulation
+% ================================================================
+\section  [Coupled formulation (\textit{sbccpl}) ]
+		{Coupled formulation (\mdl{sbccpl} module)}
+\label{SBC_cpl}
+%------------------------------------------namsbc_cpl----------------------------------------------------
+\namdisplay{namsbc_cpl} 
+%-------------------------------------------------------------------------------------------------------------
+
+In the coupled formulation of the surface boundary condition, the fluxes are 
+provided by the OASIS coupler at a frequency which is defined in the OASIS coupler, 
+while sea and ice surface temperature, ocean and ice albedo, and ocean currents 
+are sent to the atmospheric component.
+
+A generalised coupled interface has been developed. 
+It is currently interfaced with OASIS-3-MCT (\key{oasis3}). 
+It has been successfully used to interface \NEMO to most of the European atmospheric 
+GCM (ARPEGE, ECHAM, ECMWF, HadAM, HadGAM, LMDz), 
+as well as to \href{http://wrf-model.org/}{WRF} (Weather Research and Forecasting Model).
+
+Note that in addition to the setting of \np{ln\_cpl} to true, the \key{coupled} have to be defined. 
+The CPP key is mainly used in sea-ice to ensure that the atmospheric fluxes are 
+actually recieved by the ice-ocean system (no calculation of ice sublimation in coupled mode).
+When PISCES biogeochemical model (\key{top} and \key{pisces}) is also used in the coupled system, 
+the whole carbon cycle is computed by defining \key{cpl\_carbon\_cycle}. In this case, 
+CO$_2$ fluxes will be exchanged between the atmosphere and the ice-ocean system (and need to be activated in \ngn{namsbc{\_}cpl} ).
+
+The namelist above allows control of various aspects of the coupling fields (particularly for
+vectors) and now allows for any coupling fields to have multiple sea ice categories (as required by LIM3
+and CICE).  When indicating a multi-category coupling field in namsbc{\_}cpl the number of categories will be
+determined by the number used in the sea ice model.  In some limited cases it may be possible to specify 
+single category coupling fields even when the sea ice model is running with multiple categories - in this
+case the user should examine the code to be sure the assumptions made are satisfactory.  In cases where
+this is definitely not possible the model should abort with an error message.  The new code has been tested using
+ECHAM with LIM2, and HadGAM3 with CICE but although it will compile with \key{lim3} additional minor code changes
+may be required to run using LIM3.
+
+
+% ================================================================
+%        Atmospheric pressure
+% ================================================================
+\section   [Atmospheric pressure (\textit{sbcapr})]
+			{Atmospheric pressure (\mdl{sbcapr})}
+\label{SBC_apr}
+%------------------------------------------namsbc_apr----------------------------------------------------
+\namdisplay{namsbc_apr} 
+%-------------------------------------------------------------------------------------------------------------
+
+The optional atmospheric pressure can be used to force ocean and ice dynamics 
+(\np{ln\_apr\_dyn}~=~true, \textit{\ngn{namsbc}} namelist ).
+The input atmospheric forcing defined via \np{sn\_apr} structure (\textit{namsbc\_apr} namelist) 
+can be interpolated in time to the model time step, and even in space when the 
+interpolation on-the-fly is used. When used to force the dynamics, the atmospheric 
+pressure is further transformed into an equivalent inverse barometer sea surface height, 
+$\eta_{ib}$, using:
+\begin{equation} \label{SBC_ssh_ib}
+	\eta_{ib} = -  \frac{1}{g\,\rho_o}  \left( P_{atm} - P_o \right) 
+\end{equation}
+where $P_{atm}$ is the atmospheric pressure and $P_o$ a reference atmospheric pressure.
+A value of $101,000~N/m^2$ is used unless \np{ln\_ref\_apr} is set to true. In this case $P_o$ 
+is set to the value of $P_{atm}$ averaged over the ocean domain, $i.e.$ the mean value of 
+$\eta_{ib}$ is kept to zero at all time step.
+
+The gradient of $\eta_{ib}$ is added to the RHS of the ocean momentum equation 
+(see \mdl{dynspg} for the ocean). For sea-ice, the sea surface height, $\eta_m$, 
+which is provided to the sea ice model is set to $\eta - \eta_{ib}$ (see \mdl{sbcssr} module).
+$\eta_{ib}$ can be set in the output. This can simplify altimetry data and model comparison 
+as inverse barometer sea surface height is usually removed from these date prior to their distribution.
+
+When using time-splitting and BDY package for open boundaries conditions, the equivalent 
+inverse barometer sea surface height $\eta_{ib}$ can be added to BDY ssh data: 
+\np{ln\_apr\_obc}  might be set to true.
+
+% ================================================================
+%        Tidal Potential
+% ================================================================
+\section   [Tidal Potential (\textit{sbctide})]
+                        {Tidal Potential (\mdl{sbctide})}
+\label{SBC_tide}
+
+%------------------------------------------nam_tide---------------------------------------
+\namdisplay{nam_tide}
+%-----------------------------------------------------------------------------------------
+
+A module is available to compute the tidal potential and use it in the momentum equation.
+This option is activated when \np{ln\_tide} is set to true in \ngn{nam\_tide}.
+
+Some parameters are available in namelist \ngn{nam\_tide}:
+
+- \np{ln\_tide\_pot} activate the tidal potential forcing
+
+- \np{nb\_harmo} is the number of constituent used
+
+- \np{clname} is the name of constituent
+
+The tide is generated by the forces of gravity ot the Earth-Moon and Earth-Sun sytem;
+they are expressed as the gradient of the astronomical potential ($\vec{\nabla}\Pi_{a}$). \\
+
+The potential astronomical expressed, for the three types of tidal frequencies
+following, by : \\
+Tide long period :
+\begin{equation}
+\Pi_{a}=gA_{k}(\frac{1}{2}-\frac{3}{2}sin^{2}\phi)cos(\omega_{k}t+V_{0k})
+\end{equation}
+diurnal Tide :
+\begin{equation}
+\Pi_{a}=gA_{k}(sin 2\phi)cos(\omega_{k}t+\lambda+V_{0k})
+\end{equation}
+Semi-diurnal tide:
+\begin{equation}
+\Pi_{a}=gA_{k}(cos^{2}\phi)cos(\omega_{k}t+2\lambda+V_{0k})
+\end{equation}
+
+
+$A_{k}$ is the amplitude of the wave k, $\omega_{k}$ the pulsation of the wave k, $V_{0k}$ the astronomical phase of the wave
+$k$ to Greenwich.
+
+We make corrections to the astronomical potential.
+We obtain : 
+\begin{equation}
+\Pi-g\delta = (1+k-h) \Pi_{A}(\lambda,\phi)
+\end{equation}
+with $k$ a number of Love estimated to 0.6 which parameterised the astronomical tidal land,
+and $h$ a number of Love to 0.3 which parameterised the parameterisation due to the astronomical tidal land.
+
+% ================================================================
+%        River runoffs
+% ================================================================
+\section   [River runoffs (\textit{sbcrnf})]
+			{River runoffs (\mdl{sbcrnf})}
+\label{SBC_rnf}
+%------------------------------------------namsbc_rnf----------------------------------------------------
+\namdisplay{namsbc_rnf} 
+%-------------------------------------------------------------------------------------------------------------
+
+%River runoff generally enters the ocean at a nonzero depth rather than through the surface. 
+%Many models, however, have traditionally inserted river runoff to the top model cell.
+%This was the case in \NEMO prior to the version 3.3. The switch toward a input of runoff 
+%throughout a nonzero depth has been motivated by the numerical and physical problems 
+%that arise when the top grid cells are of the order of one meter. This situation is common in 
+%coastal modelling and becomes more and more often open ocean and climate modelling 
+%\footnote{At least a top cells thickness of 1~meter and a 3 hours forcing frequency are
+%required to properly represent the diurnal cycle \citep{Bernie_al_JC05}. see also \S\ref{SBC_dcy}.}.
+
+
+%To do this we need to treat evaporation/precipitation fluxes and river runoff differently in the 
+%\mdl{tra\_sbc} module.  We decided to separate them throughout the code, so that the variable 
+%\textit{emp} represented solely evaporation minus precipitation fluxes, and a new 2d variable 
+%rnf was added which represents the volume flux of river runoff (in kg/m2s to remain consistent with 
+%emp).  This meant many uses of emp and emps needed to be changed, a list of all modules which use 
+%emp or emps and the changes made are below:
+
+
+%Rachel:
+River runoff generally enters the ocean at a nonzero depth rather than through the surface.
+Many models, however, have traditionally inserted river runoff to the top model cell.
+This was the case in \NEMO prior to the version 3.3, and was combined with an option 
+to increase vertical mixing near the river mouth.
+
+However, with this method numerical and physical problems arise when the top grid cells are 
+of the order of one meter. This situation is common in coastal modelling and is becoming 
+more common in open ocean and climate modelling 
+\footnote{At least a top cells thickness of 1~meter and a 3 hours forcing frequency are
+required to properly represent the diurnal cycle \citep{Bernie_al_JC05}. see also \S\ref{SBC_dcy}.}.
+
+As such from V~3.3 onwards it is possible to add river runoff through a non-zero depth, and for the 
+temperature and salinity of the river to effect the surrounding ocean.
+The user is able to specify, in a NetCDF input file, the temperature and salinity of the river, along with the   
+depth (in metres) which the river should be added to.
+
+Namelist variables in \ngn{namsbc\_rnf}, \np{ln\_rnf\_depth}, \np{ln\_rnf\_sal} and \np{ln\_rnf\_temp} control whether 
+the river attributes (depth, salinity and temperature) are read in and used.  If these are set 
+as false the river is added to the surface box only, assumed to be fresh (0~psu), and/or 
+taken as surface temperature respectively.
+
+The runoff value and attributes are read in in sbcrnf.  
+For temperature -999 is taken as missing data and the river temperature is taken to be the 
+surface temperatue at the river point.
+For the depth parameter a value of -1 means the river is added to the surface box only, 
+and a value of -999 means the river is added through the entire water column. 
+After being read in the temperature and salinity variables are multiplied by the amount of runoff (converted into m/s) 
+to give the heat and salt content of the river runoff.
+After the user specified depth is read ini, the number of grid boxes this corresponds to is 
+calculated and stored in the variable \np{nz\_rnf}.
+The variable \textit{h\_dep} is then calculated to be the depth (in metres) of the bottom of the 
+lowest box the river water is being added to (i.e. the total depth that river water is being added to in the model).
+
+The mass/volume addition due to the river runoff is, at each relevant depth level, added to the horizontal divergence 
+(\textit{hdivn}) in the subroutine \rou{sbc\_rnf\_div} (called from \mdl{divcur}).
+This increases the diffusion term in the vicinity of the river, thereby simulating a momentum flux.
+The sea surface height is calculated using the sum of the horizontal divergence terms, and so the 
+river runoff indirectly forces an increase in sea surface height. 
+
+The \textit{hdivn} terms are used in the tracer advection modules to force vertical velocities.
+This causes a mass of water, equal to the amount of runoff, to be moved into the box above. 
+The heat and salt content of the river runoff is not included in this step, and so the tracer 
+concentrations are diluted as water of ocean temperature and salinity is moved upward out of the box 
+and replaced by the same volume of river water with no corresponding heat and salt addition.
+
+For the linear free surface case, at the surface box the tracer advection causes a flux of water 
+(of equal volume to the runoff) through the sea surface out of the domain, which causes a salt and heat flux out of the model.
+As such the volume of water does not change, but the water is diluted.
+
+For the non-linear free surface case (\key{vvl}), no flux is allowed through the surface.
+Instead in the surface box (as well as water moving up from the boxes below) a volume of runoff water 
+is added with no corresponding heat and salt addition and so as happens in the lower boxes there is a dilution effect.
+(The runoff addition to the top box along with the water being moved up through boxes below means the surface box has a large 
+increase in volume, whilst all other boxes remain the same size)
+
+In trasbc the addition of heat and salt due to the river runoff is added.
+This is done in the same way for both vvl and non-vvl.
+The temperature and salinity are increased through the specified depth according to the heat and salt content of the river. 
+
+In the non-linear free surface case (vvl), near the end of the time step the change in sea surface height is redistrubuted 
+through the grid boxes, so that the original ratios of grid box heights are restored.
+In doing this water is moved into boxes below, throughout the water column, so the large volume addition to the surface box is spread between all the grid boxes.
+
+It is also possible for runnoff to be specified as a negative value for modelling flow through straits, i.e. modelling the Baltic flow in and out of the North Sea.
+When the flow is out of the domain there is no change in temperature and salinity, regardless of the namelist options used, as the ocean water leaving the domain removes heat and salt (at the same concentration) with it. 
+
+
+%\colorbox{yellow}{Nevertheless, Pb of vertical resolution and 3D input : increase vertical mixing near river mouths to mimic a 3D river 
+
+%All river runoff and emp fluxes are assumed to be fresh water (zero salinity) and at the same temperature as the sea surface.}
+
+%\colorbox{yellow}{river mouths{\ldots}}
+
+%IF( ln_rnf ) THEN                                     ! increase diffusivity at rivers mouths
+%        DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + rn_avt_rnf * rnfmsk(:,:)   ;   END DO
+%ENDIF
+
+%\gmcomment{  word doc of runoffs:
+%
+%In the current \NEMO setup river runoff is added to emp fluxes, these are then applied at just the sea surface as a volume change (in the variable volume case this is a literal volume change, and in the linear free surface case the free surface is moved) and a salt flux due to the concentration/dilution effect.  There is also an option to increase vertical mixing near river mouths; this gives the effect of having a 3d river.  All river runoff and emp fluxes are assumed to be fresh water (zero salinity) and at the same temperature as the sea surface.
+%Our aim was to code the option to specify the temperature and salinity of river runoff, (as well as the amount), along with the depth that the river water will affect.  This would make it possible to model low salinity outflow, such as the Baltic, and would allow the ocean temperature to be affected by river runoff.  
+
+%The depth option makes it possible to have the river water affecting just the surface layer, throughout depth, or some specified point in between.
+
+%To do this we need to treat evaporation/precipitation fluxes and river runoff differently in the tra_sbc module.  We decided to separate them throughout the code, so that the variable emp represented solely evaporation minus precipitation fluxes, and a new 2d variable rnf was added which represents the volume flux of river runoff (in kg/m2s to remain consistent with emp).  This meant many uses of emp and emps needed to be changed, a list of all modules which use emp or emps and the changes made are below:
+
+%}
+% ================================================================
+%        Ice shelf melting
+% ================================================================
+\section   [Ice shelf melting (\textit{sbcisf})]
+                        {Ice shelf melting (\mdl{sbcisf})}
+\label{SBC_isf}
+%------------------------------------------namsbc_isf----------------------------------------------------
+\namdisplay{namsbc_isf}
+%--------------------------------------------------------------------------------------------------------
+Namelist variable in \ngn{namsbc}, \np{nn\_isf}, controls the ice shelf representation used. 
+\begin{description}
+\item[\np{nn\_isf}~=~1]
+The ice shelf cavity is represented (\np{ln\_isfcav}~=~true needed). The fwf and heat flux are computed. 
+Two different bulk formula are available:
+	\begin{description}
+	\item[\np{nn\_isfblk}~=~1]
+	The bulk formula used to compute the melt is based the one described in \citet{Hunter2006}.
+        This formulation is based on a balance between the upward ocean heat flux and the latent heat flux at the ice shelf base.
+
+	\item[\np{nn\_isfblk}~=~2] 
+	The bulk formula used to compute the melt is based the one described in \citet{Jenkins1991}.
+        This formulation is based on a 3 equations formulation (a heat flux budget, a salt flux budget
+         and a linearised freezing point temperature equation).
+	\end{description}
+
+For this 2 bulk formulations, there are 3 different ways to compute the exchange coeficient:
+	\begin{description}
+        \item[\np{nn\_gammablk~=~0~}]
+	The salt and heat exchange coefficients are constant and defined by \np{rn\_gammas0} and \np{rn\_gammat0}
+
+	\item[\np{nn\_gammablk~=~1~}]
+	The salt and heat exchange coefficients are velocity dependent and defined as $\np{rn\_gammas0} \times u_{*}$ and $\np{rn\_gammat0} \times u_{*}$
+        where $u_{*}$ is the friction velocity in the top boundary layer (ie first \np{rn\_hisf\_tbl} meters).
+        See \citet{Jenkins2010} for all the details on this formulation.
+	
+	\item[\np{nn\_gammablk~=~2~}]
+	The salt and heat exchange coefficients are velocity and stability dependent and defined as 
+        $\gamma_{T,S} = \frac{u_{*}}{\Gamma_{Turb} + \Gamma^{T,S}_{Mole}}$
+        where $u_{*}$ is the friction velocity in the top boundary layer (ie first \np{rn\_hisf\_tbl} meters), 
+        $\Gamma_{Turb}$ the contribution of the ocean stability and 
+        $\Gamma^{T,S}_{Mole}$ the contribution of the molecular diffusion.
+        See \citet{Holland1999} for all the details on this formulation.
+        \end{description}
+
+\item[\np{nn\_isf}~=~2]
+A parameterisation of isf is used. The ice shelf cavity is not represented. 
+The fwf is distributed along the ice shelf edge between the depth of the average grounding line (GL)
+(\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}) as in (\np{nn\_isf}~=~3). 
+Furthermore the fwf and heat flux are computed using the \citet{Beckmann2003} parameterisation of isf melting. 
+The effective melting length (\np{sn\_Leff\_isf}) is read from a file.
+
+\item[\np{nn\_isf}~=~3]
+A simple parameterisation of isf is used. The ice shelf cavity is not represented. 
+The fwf (\np{sn\_rnfisf}) is prescribed and distributed along the ice shelf edge between the depth of the average grounding line (GL)
+(\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}). 
+The heat flux ($Q_h$) is computed as $Q_h = fwf \times L_f$.
+
+\item[\np{nn\_isf}~=~4]
+The ice shelf cavity is opened (\np{ln\_isfcav}~=~true needed). However, the fwf is not computed but specified from file \np{sn\_fwfisf}). 
+The heat flux ($Q_h$) is computed as $Q_h = fwf \times L_f$.\\
+\end{description}
+
+
+$\bullet$ \np{nn\_isf}~=~1 and \np{nn\_isf}~=~2 compute a melt rate based on the water mass properties, ocean velocities and depth.
+ This flux is thus highly dependent of the model resolution (horizontal and vertical), realism of the water masses onto the shelf ...\\
+
+
+$\bullet$ \np{nn\_isf}~=~3 and \np{nn\_isf}~=~4 read the melt rate from a file. You have total control of the fwf forcing.
+This can be usefull if the water masses on the shelf are not realistic or the resolution (horizontal/vertical) are too 
+coarse to have realistic melting or for studies where you need to control your heat and fw input.\\ 
+
+A namelist parameters control over how many meters the heat and fw fluxes are spread. 
+\np{rn\_hisf\_tbl}] is the top boundary layer thickness as defined in \citet{Losch2008}. 
+This parameter is only used if \np{nn\_isf}~=~1 or \np{nn\_isf}~=~4
+
+If \np{rn\_hisf\_tbl} = 0., the fluxes are put in the top level whatever is its tickness. 
+
+If \np{rn\_hisf\_tbl} $>$ 0., the fluxes are spread over the first \np{rn\_hisf\_tbl} m (ie over one or several cells).\\
+
+The ice shelf melt is implemented as a volume flux with in the same way as for the runoff.
+The fw addition due to the ice shelf melting is, at each relevant depth level, added to the horizontal divergence 
+(\textit{hdivn}) in the subroutine \rou{sbc\_isf\_div}, called from \mdl{divcur}. 
+See the runoff section \ref{SBC_rnf} for all the details about the divergence correction. 
+
+
+\section{ Ice sheet coupling}
+\label{SBC_iscpl}
+%------------------------------------------namsbc_iscpl----------------------------------------------------
+\namdisplay{namsbc_iscpl}
+%--------------------------------------------------------------------------------------------------------
+Ice sheet/ocean coupling is done through file exchange at the restart step. NEMO, at each restart step, 
+read the bathymetry and ice shelf draft variable in a netcdf file. 
+If \np{ln\_iscpl = ~true}, the isf draft is assume to be different at each restart step 
+with potentially some new wet/dry cells due to the ice sheet dynamics/thermodynamics.
+The wetting and drying scheme applied on the restart is very simple and described below for the 6 different cases:
+\begin{description}
+\item[Thin a cell down:]
+	T/S/ssh are unchanged and U/V in the top cell are corrected to keep the barotropic transport (bt) constant ($bt_b=bt_n$).
+\item[Enlarge  a cell:]
+	See case "Thin a cell down"
+\item[Dry a cell:]
+	mask, T/S, U/V and ssh are set to 0. Furthermore, U/V into the water column are modified to satisfy ($bt_b=bt_n$).
+\item[Wet a cell:] 
+	mask is set to 1, T/S is extrapolated from neighbours, $ssh_n = ssh_b$ and U/V set to 0. If no neighbours along i,j and k, T/S/U/V and mask are set to 0.
+\item[Dry a column:]
+	mask, T/S, U/V are set to 0 everywhere in the column and ssh set to 0.
+\item[Wet a column:]
+	set mask to 1, T/S is extrapolated from neighbours, ssh is extrapolated from neighbours and U/V set to 0. If no neighbour, T/S/U/V and mask set to 0.
+\end{description}
+The extrapolation is call \np{nn\_drown} times. It means that if the grounding line retreat by more than \np{nn\_drown} cells between 2 coupling steps,
+ the code will be unable to fill all the new wet cells properly. The default number is set up for the MISOMIP idealised experiments.\\
+This coupling procedure is able to take into account grounding line and calving front migration. However, it is a non-conservative processe. 
+This could lead to a trend in heat/salt content and volume. In order to remove the trend and keep the conservation level as close to 0 as possible,
+ a simple conservation scheme is available with \np{ln\_hsb = ~true}. The heat/salt/vol. gain/loss is diagnose, as well as the location. 
+Based on what is done on sbcrnf to prescribed a source of heat/salt/vol., the heat/salt/vol. gain/loss is removed/added,
+ over a period of \np{rn\_fiscpl} time step, into the system. 
+So after \np{rn\_fiscpl} time step, all the heat/salt/vol. gain/loss due to extrapolation process is canceled.\\
+
+As the before and now fields are not compatible (modification of the geometry), the restart time step is prescribed to be an euler time step instead of a leap frog and $fields_b = fields_n$.
+%
+% ================================================================
+%        Handling of icebergs
+% ================================================================
+\section{Handling of icebergs (ICB)}
+\label{ICB_icebergs}
+%------------------------------------------namberg----------------------------------------------------
+\namdisplay{namberg}
+%-------------------------------------------------------------------------------------------------------------
+
+Icebergs are modelled as lagrangian particles in NEMO \citep{Marsh_GMD2015}.
+Their physical behaviour is controlled by equations as described in \citet{Martin_Adcroft_OM10} ).
+(Note that the authors kindly provided a copy of their code to act as a basis for implementation in NEMO).
+Icebergs are initially spawned into one of ten classes which have specific mass and thickness as described 
+in the \ngn{namberg} namelist: 
+\np{rn\_initial\_mass} and \np{rn\_initial\_thickness}.
+Each class has an associated scaling (\np{rn\_mass\_scaling}), which is an integer representing how many icebergs 
+of this class are being described as one lagrangian point (this reduces the numerical problem of tracking every single iceberg).
+They are enabled by setting \np{ln\_icebergs}~=~true.
+
+Two initialisation schemes are possible.
+\begin{description}
+\item[\np{nn\_test\_icebergs}~$>$~0]
+In this scheme, the value of \np{nn\_test\_icebergs} represents the class of iceberg to generate 
+(so between 1 and 10), and \np{nn\_test\_icebergs} provides a lon/lat box in the domain at each 
+grid point of which an iceberg is generated at the beginning of the run. 
+(Note that this happens each time the timestep equals \np{nn\_nit000}.)
+\np{nn\_test\_icebergs} is defined by four numbers in \np{nn\_test\_box} representing the corners 
+of the geographical box: lonmin,lonmax,latmin,latmax
+\item[\np{nn\_test\_icebergs}~=~-1]
+In this scheme the model reads a calving file supplied in the \np{sn\_icb} parameter.
+This should be a file with a field on the configuration grid (typically ORCA) representing ice accumulation rate at each model point. 
+These should be ocean points adjacent to land where icebergs are known to calve.
+Most points in this input grid are going to have value zero.
+When the model runs, ice is accumulated at each grid point which has a non-zero source term.
+At each time step, a test is performed to see if there is enough ice mass to calve an iceberg of each class in order (1 to 10).
+Note that this is the initial mass multiplied by the number each particle represents ($i.e.$ the scaling).
+If there is enough ice, a new iceberg is spawned and the total available ice reduced accordingly.
+\end{description}
+
+Icebergs are influenced by wind, waves and currents, bottom melt and erosion.
+The latter act to disintegrate the iceberg. This is either all melted freshwater, or 
+(if \np{rn\_bits\_erosion\_fraction}~$>$~0) into melt and additionally small ice bits
+which are assumed to propagate with their larger parent and thus delay fluxing into the ocean.
+Melt water (and other variables on the configuration grid) are written into the main NEMO model output files.
+
+Extensive diagnostics can be produced.
+Separate output files are maintained for human-readable iceberg information.
+A separate file is produced for each processor (independent of \np{ln\_ctl}).
+The amount of information is controlled by two integer parameters:
+\begin{description}
+\item[\np{nn\_verbose\_level}]  takes a value between one and four and represents 
+an increasing number of points in the code at which variables are written, and an 
+increasing level of obscurity.
+\item[\np{nn\_verbose\_write}] is the number of timesteps between writes
+\end{description}
+
+Iceberg trajectories can also be written out and this is enabled by setting \np{nn\_sample\_rate}~$>$~0.
+A non-zero value represents how many timesteps between writes of information into the output file.
+These output files are in NETCDF format.
+When \key{mpp\_mpi} is defined, each output file contains only those icebergs in the corresponding processor.
+Trajectory points are written out in the order of their parent iceberg in the model's "linked list" of icebergs.
+So care is needed to recreate data for individual icebergs, since its trajectory data may be spread across
+multiple files.
+
+
+% ================================================================
+% Miscellanea options
+% ================================================================
+\section{Miscellaneous options}
+\label{SBC_misc}
+
+% -------------------------------------------------------------------------------------------------------------
+%        Diurnal cycle
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Diurnal  cycle (\textit{sbcdcy})]
+			{Diurnal cycle (\mdl{sbcdcy})}
+\label{SBC_dcy}
+%------------------------------------------namsbc_rnf----------------------------------------------------
+%\namdisplay{namsbc} 
+%-------------------------------------------------------------------------------------------------------------
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_SBC_diurnal}
+\caption{ \label{Fig_SBC_diurnal}    
+Example of recontruction of the diurnal cycle variation of short wave flux  
+from daily mean values. The reconstructed diurnal cycle (black line) is chosen 
+as the mean value of the analytical cycle (blue line) over a time step, not 
+as the mid time step value of the analytically cycle (red square). From \citet{Bernie_al_CD07}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\cite{Bernie_al_JC05} have shown that to capture 90$\%$ of the diurnal variability of 
+SST requires a vertical resolution in upper ocean of 1~m or better and a temporal resolution 
+of the surface fluxes of 3~h or less. Unfortunately high frequency forcing fields are rare, 
+not to say inexistent. Nevertheless, it is possible to obtain a reasonable diurnal cycle 
+of the SST knowning only short wave flux (SWF) at high frequency \citep{Bernie_al_CD07}.
+Furthermore, only the knowledge of daily mean value of SWF is needed, 
+as higher frequency variations can be reconstructed from them, assuming that 
+the diurnal cycle of SWF is a scaling of the top of the atmosphere diurnal cycle 
+of incident SWF. The \cite{Bernie_al_CD07} reconstruction algorithm is available
+in \NEMO by setting \np{ln\_dm2dc}~=~true (a \textit{\ngn{namsbc}} namelist variable) when using 
+CORE bulk formulea (\np{ln\_blk\_core}~=~true) or the flux formulation (\np{ln\_flx}~=~true). 
+The reconstruction is performed in the \mdl{sbcdcy} module. The detail of the algoritm used 
+can be found in the appendix~A of \cite{Bernie_al_CD07}. The algorithm preserve the daily 
+mean incomming SWF as the reconstructed SWF at a given time step is the mean value 
+of the analytical cycle over this time step (Fig.\ref{Fig_SBC_diurnal}). 
+The use of diurnal cycle reconstruction requires the input SWF to be daily 
+($i.e.$ a frequency of 24 and a time interpolation set to true in \np{sn\_qsr} namelist parameter).
+Furthermore, it is recommended to have a least 8 surface module time step per day,
+that is  $\rdt \ \np{nn\_fsbc} < 10,800~s = 3~h$. An example of recontructed SWF 
+is given in Fig.\ref{Fig_SBC_dcy} for a 12 reconstructed diurnal cycle, one every 2~hours 
+(from 1am to 11pm).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]  \begin{center}
+\includegraphics[width=0.7\textwidth]{Fig_SBC_dcy}
+\caption{ \label{Fig_SBC_dcy}   
+Example of recontruction of the diurnal cycle variation of short wave flux  
+from daily mean values on an ORCA2 grid with a time sampling of 2~hours (from 1am to 11pm). 
+The display is on (i,j) plane. }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Note also that the setting a diurnal cycle in SWF is highly recommended  when 
+the top layer thickness approach 1~m or less, otherwise large error in SST can 
+appear due to an inconsistency between the scale of the vertical resolution 
+and the forcing acting on that scale.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Rotation of vector pairs onto the model grid directions
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Rotation of vector pairs onto the model grid directions}
+\label{SBC_rotation}
+
+When using a flux (\np{ln\_flx}=true) or bulk (\np{ln\_clio}=true or \np{ln\_core}=true) formulation, 
+pairs of vector components can be rotated from east-north directions onto the local grid directions.  
+This is particularly useful when interpolation on the fly is used since here any vectors are likely to be defined 
+relative to a rectilinear grid.
+To activate this option a non-empty string is supplied in the rotation pair column of the relevant namelist.
+The eastward component must start with "U" and the northward component with "V".  
+The remaining characters in the strings are used to identify which pair of components go together.
+So for example, strings "U1" and "V1" next to "utau" and "vtau" would pair the wind stress components together
+and rotate them on to the model grid directions; "U2" and "V2" could be used against a second pair of components, 
+and so on.
+The extra characters used in the strings are arbitrary.
+The rot\_rep routine from the \mdl{geo2ocean} module is used to perform the rotation.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Surface restoring to observed SST and/or SSS
+% -------------------------------------------------------------------------------------------------------------
+\subsection    [Surface restoring to observed SST and/or SSS (\textit{sbcssr})]
+			{Surface restoring to observed SST and/or SSS (\mdl{sbcssr})}
+\label{SBC_ssr}
+%------------------------------------------namsbc_ssr----------------------------------------------------
+\namdisplay{namsbc_ssr} 
+%-------------------------------------------------------------------------------------------------------------
+
+IOptions are defined through the  \ngn{namsbc\_ssr} namelist variables.
+n forced mode using a flux formulation (\np{ln\_flx}~=~true), a 
+feedback term \emph{must} be added to the surface heat flux $Q_{ns}^o$:
+\begin{equation} \label{Eq_sbc_dmp_q}
+Q_{ns} = Q_{ns}^o + \frac{dQ}{dT} \left( \left. T \right|_{k=1} - SST_{Obs} \right)
+\end{equation}
+where SST is a sea surface temperature field (observed or climatological), $T$ is 
+the model surface layer temperature and $\frac{dQ}{dT}$ is a negative feedback 
+coefficient usually taken equal to $-40~W/m^2/K$. For a $50~m$ 
+mixed-layer depth, this value corresponds to a relaxation time scale of two months. 
+This term ensures that if $T$ perfectly matches the supplied SST, then $Q$ is 
+equal to $Q_o$. 
+
+In the fresh water budget, a feedback term can also be added. Converted into an 
+equivalent freshwater flux, it takes the following expression :
+
+\begin{equation} \label{Eq_sbc_dmp_emp}
+\textit{emp} = \textit{emp}_o + \gamma_s^{-1} e_{3t}  \frac{  \left(\left.S\right|_{k=1}-SSS_{Obs}\right)}
+												         {\left.S\right|_{k=1}}
+\end{equation}
+
+where $\textit{emp}_{o }$ is a net surface fresh water flux (observed, climatological or an
+atmospheric model product), \textit{SSS}$_{Obs}$ is a sea surface salinity (usually a time 
+interpolation of the monthly mean Polar Hydrographic Climatology \citep{Steele2001}), 
+$\left.S\right|_{k=1}$ is the model surface layer salinity and $\gamma_s$ is a negative 
+feedback coefficient which is provided as a namelist parameter. Unlike heat flux, there is no 
+physical justification for the feedback term in \ref{Eq_sbc_dmp_emp} as the atmosphere 
+does not care about ocean surface salinity \citep{Madec1997}. The SSS restoring 
+term should be viewed as a flux correction on freshwater fluxes to reduce the 
+uncertainties we have on the observed freshwater budget.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Handling of ice-covered area
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Handling of ice-covered area  (\textit{sbcice\_...})}
+\label{SBC_ice-cover}
+
+The presence at the sea surface of an ice covered area modifies all the fluxes 
+transmitted to the ocean. There are several way to handle sea-ice in the system 
+depending on the value of the \np{nn\_ice} namelist parameter found in \ngn{namsbc} namelist.  
+\begin{description}
+\item[nn{\_}ice = 0]  there will never be sea-ice in the computational domain. 
+This is a typical namelist value used for tropical ocean domain. The surface fluxes 
+are simply specified for an ice-free ocean. No specific things is done for sea-ice.
+\item[nn{\_}ice = 1]  sea-ice can exist in the computational domain, but no sea-ice model 
+is used. An observed ice covered area is read in a file. Below this area, the SST is 
+restored to the freezing point and the heat fluxes are set to $-4~W/m^2$ ($-2~W/m^2$) 
+in the northern (southern) hemisphere. The associated modification of the freshwater 
+fluxes are done in such a way that the change in buoyancy fluxes remains zero. 
+This prevents deep convection to occur when trying to reach the freezing point 
+(and so ice covered area condition) while the SSS is too large. This manner of 
+managing sea-ice area, just by using si IF case, is usually referred as the \textit{ice-if} 
+model. It can be found in the \mdl{sbcice{\_}if} module.
+\item[nn{\_}ice = 2 or more]  A full sea ice model is used. This model computes the 
+ice-ocean fluxes, that are combined with the air-sea fluxes using the ice fraction of 
+each model cell to provide the surface ocean fluxes. Note that the activation of a 
+sea-ice model is is done by defining a CPP key (\key{lim2}, \key{lim3} or \key{cice}). 
+The activation automatically overwrites the read value of nn{\_}ice to its appropriate 
+value ($i.e.$ $2$ for LIM-2, $3$ for LIM-3 or $4$ for CICE).
+\end{description}
+
+% {Description of Ice-ocean interface to be added here or in LIM 2 and 3 doc ?}
+
+\subsection   [Interface to CICE (\textit{sbcice\_cice})]
+			{Interface to CICE (\mdl{sbcice\_cice})}
+\label{SBC_cice}
+
+It is now possible to couple a regional or global NEMO configuration (without AGRIF) to the CICE sea-ice
+model by using \key{cice}.  The CICE code can be obtained from 
+\href{http://oceans11.lanl.gov/trac/CICE/}{LANL} and the additional 'hadgem3' drivers will be required, 
+even with the latest code release.  Input grid files consistent with those used in NEMO will also be needed, 
+and CICE CPP keys \textbf{ORCA\_GRID}, \textbf{CICE\_IN\_NEMO} and \textbf{coupled} should be used (seek advice from UKMO 
+if necessary).  Currently the code is only designed to work when using the CORE forcing option for NEMO (with
+\textit{calc\_strair~=~true} and \textit{calc\_Tsfc~=~true} in the CICE name-list), or alternatively when NEMO 
+is coupled to the HadGAM3 atmosphere model (with \textit{calc\_strair~=~false} and \textit{calc\_Tsfc~=~false}).
+The code is intended to be used with \np{nn\_fsbc} set to 1 (although coupling ocean and ice less frequently 
+should work, it is possible the calculation of some of the ocean-ice fluxes needs to be modified slightly - the
+user should check that results are not significantly different to the standard case).
+
+There are two options for the technical coupling between NEMO and CICE.  The standard version allows
+complete flexibility for the domain decompositions in the individual models, but this is at the expense of global
+gather and scatter operations in the coupling which become very expensive on larger numbers of processors. The
+alternative option (using \key{nemocice\_decomp} for both NEMO and CICE) ensures that the domain decomposition is
+identical in both models (provided domain parameters are set appropriately, and 
+\textit{processor\_shape~=~square-ice} and \textit{distribution\_wght~=~block} in the CICE name-list) and allows
+much more efficient direct coupling on individual processors.  This solution scales much better although it is at 
+the expense of having more idle CICE processors in areas where there is no sea ice.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Freshwater budget control 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Freshwater budget control (\textit{sbcfwb})]
+			{Freshwater budget control (\mdl{sbcfwb})}
+\label{SBC_fwb}
+
+For global ocean simulation it can be useful to introduce a control of the mean sea 
+level in order to prevent unrealistic drift of the sea surface height due to inaccuracy 
+in the freshwater fluxes. In \NEMO, two way of controlling the the freshwater budget. 
+\begin{description}
+\item[\np{nn\_fwb}=0]  no control at all. The mean sea level is free to drift, and will 
+certainly do so.
+\item[\np{nn\_fwb}=1]  global mean \textit{emp} set to zero at each model time step. 
+%Note that with a sea-ice model, this technique only control the mean sea level with linear free surface (\key{vvl} not defined) and no mass flux between ocean and ice (as it is implemented in the current ice-ocean coupling). 
+\item[\np{nn\_fwb}=2]  freshwater budget is adjusted from the previous year annual 
+mean budget which is read in the \textit{EMPave\_old.dat} file. As the model uses the 
+Boussinesq approximation, the annual mean fresh water budget is simply evaluated 
+from the change in the mean sea level at January the first and saved in the 
+\textit{EMPav.dat} file. 
+\end{description}
+
+% -------------------------------------------------------------------------------------------------------------
+%        Neutral Drag Coefficient from external wave model
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Neutral drag coefficient from external wave model (\textit{sbcwave})]
+              {Neutral drag coefficient from external wave model (\mdl{sbcwave})}
+\label{SBC_wave}
+%------------------------------------------namwave----------------------------------------------------
+\namdisplay{namsbc_wave}
+%-------------------------------------------------------------------------------------------------------------
+
+In order to read a neutral drag coeff, from an external data source ($i.e.$ a wave model), the 
+logical variable \np{ln\_cdgw} in \ngn{namsbc} namelist must be set to \textit{true}. 
+The \mdl{sbcwave} module containing the routine \np{sbc\_wave} reads the
+namelist \ngn{namsbc\_wave} (for external data names, locations, frequency, interpolation and all 
+the miscellanous options allowed by Input Data generic Interface see \S\ref{SBC_input}) 
+and a 2D field of neutral drag coefficient. 
+Then using the routine TURB\_CORE\_1Z or TURB\_CORE\_2Z, and starting from the neutral drag coefficent provided, 
+the drag coefficient is computed according to stable/unstable conditions of the air-sea interface following \citet{Large_Yeager_Rep04}.
+
+
+% Griffies doc:
+% When running ocean-ice simulations, we are not explicitly representing land processes, 
+% such as rivers, catchment areas, snow accumulation, etc. However, to reduce model drift, 
+% it is important to balance the hydrological cycle in ocean-ice models. 
+% We thus need to prescribe some form of global normalization to the precipitation minus evaporation plus river runoff. 
+% The result of the normalization should be a global integrated zero net water input to the ocean-ice system over 
+% a chosen time scale. 
+%How often the normalization is done is a matter of choice. In mom4p1, we choose to do so at each model time step, 
+% so that there is always a zero net input of water to the ocean-ice system. 
+% Others choose to normalize over an annual cycle, in which case the net imbalance over an annual cycle is used 
+% to alter the subsequent year�s water budget in an attempt to damp the annual water imbalance. 
+% Note that the annual budget approach may be inappropriate with interannually varying precipitation forcing. 
+% When running ocean-ice coupled models, it is incorrect to include the water transport between the ocean 
+% and ice models when aiming to balance the hydrological cycle. 
+% The reason is that it is the sum of the water in the ocean plus ice that should be balanced when running ocean-ice models, 
+% not the water in any one sub-component. As an extreme example to illustrate the issue, 
+% consider an ocean-ice model with zero initial sea ice. As the ocean-ice model spins up, 
+% there should be a net accumulation of water in the growing sea ice, and thus a net loss of water from the ocean. 
+% The total water contained in the ocean plus ice system is constant, but there is an exchange of water between 
+% the subcomponents. This exchange should not be part of the normalization used to balance the hydrological cycle 
+% in ocean-ice models. 
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_STO.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_STO.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_STO.tex	(revision 8732)
@@ -0,0 +1,178 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter stochastic parametrization of EOS (STO)
+% ================================================================
+\chapter{Stochastic parametrization of EOS (STO)}
+\label{STO}
+
+Authors: P.-A. Bouttier
+
+\minitoc
+
+\newpage
+
+
+The stochastic parametrization module aims to explicitly simulate uncertainties in the model. 
+More particularly, \cite{Brankart_OM2013} has shown that, 
+because of the nonlinearity of the seawater equation of state, unresolved scales represent 
+a major source of uncertainties in the computation of the large scale horizontal density gradient 
+(from T/S large scale fields), and that the impact of these uncertainties can be simulated 
+by random processes representing unresolved T/S fluctuations.
+
+The stochastic formulation of the equation of state can be written as:
+\begin{equation}
+ \label{eq:eos_sto}
+  \rho = \frac{1}{2} \sum_{i=1}^m\{ \rho[T+\Delta T_i,S+\Delta S_i,p_o(z)] + \rho[T-\Delta T_i,S-\Delta S_i,p_o(z)] \}
+\end{equation}
+where $p_o(z)$ is the reference pressure depending on the depth and, 
+$\Delta T_i$ and $\Delta S_i$ are a set of T/S perturbations defined as the scalar product 
+of the respective local T/S gradients with random walks $\mathbf{\xi}$:
+\begin{equation}
+ \label{eq:sto_pert}
+ \Delta T_i = \mathbf{\xi}_i \cdot \nabla T \qquad \hbox{and} \qquad \Delta S_i = \mathbf{\xi}_i \cdot \nabla S
+\end{equation}
+$\mathbf{\xi}_i$ are produced by a first-order autoregressive processes (AR-1) with 
+a parametrized decorrelation time scale, and horizontal and vertical standard deviations $\sigma_s$. 
+$\mathbf{\xi}$ are uncorrelated over the horizontal and fully correlated along the vertical.
+
+
+\section{Stochastic processes}
+\label{STO_the_details}
+
+The starting point of our implementation of stochastic parameterizations
+in NEMO is to observe that many existing parameterizations are based
+on autoregressive processes, which are used as a basic source of randomness
+to transform a deterministic model into a probabilistic model.
+A generic approach is thus to add one single new module in NEMO,
+generating processes with appropriate statistics
+to simulate each kind of uncertainty in the model
+(see \cite{Brankart_al_GMD2015} for more details).
+
+In practice, at every model grid point, independent Gaussian autoregressive
+processes~$\xi^{(i)},\,i=1,\ldots,m$ are first generated
+using the same basic equation:
+
+\begin{equation}
+\label{eq:autoreg}
+\xi^{(i)}_{k+1} = a^{(i)} \xi^{(i)}_k + b^{(i)} w^{(i)} + c^{(i)}
+\end{equation}
+
+\noindent
+where $k$ is the index of the model timestep; and
+$a^{(i)}$, $b^{(i)}$, $c^{(i)}$ are parameters defining
+the mean ($\mu^{(i)}$) standard deviation ($\sigma^{(i)}$)
+and correlation timescale ($\tau^{(i)}$) of each process:
+
+\begin{itemize}
+\item for order~1 processes, $w^{(i)}$ is a Gaussian white noise,
+with zero mean and standard deviation equal to~1, and the parameters
+$a^{(i)}$, $b^{(i)}$, $c^{(i)}$ are given by:
+
+\begin{equation}
+\label{eq:ord1}
+\left\{
+\begin{array}{l}
+a^{(i)} = \varphi \\
+b^{(i)} = \sigma^{(i)} \sqrt{ 1 - \varphi^2 } 
+ \qquad\qquad\mbox{with}\qquad\qquad
+\varphi = \exp \left( - 1 / \tau^{(i)} \right) \\
+c^{(i)} = \mu^{(i)} \left( 1 - \varphi \right) \\
+\end{array}
+\right.
+\end{equation}
+
+\item for order~$n>1$ processes, $w^{(i)}$ is an order~$n-1$ autoregressive process,
+with zero mean, standard deviation equal to~$\sigma^{(i)}$; correlation timescale
+equal to~$\tau^{(i)}$; and the parameters $a^{(i)}$, $b^{(i)}$, $c^{(i)}$ are given by:
+
+\begin{equation}
+\label{eq:ord2}
+\left\{
+\begin{array}{l}
+a^{(i)} = \varphi \\
+b^{(i)} = \frac{n-1}{2(4n-3)} \sqrt{ 1 - \varphi^2 } 
+ \qquad\qquad\mbox{with}\qquad\qquad
+\varphi = \exp \left( - 1 / \tau^{(i)} \right) \\
+c^{(i)} = \mu^{(i)} \left( 1 - \varphi \right) \\
+\end{array}
+\right.
+\end{equation}
+
+\end{itemize}
+
+\noindent
+In this way, higher order processes can be easily generated recursively using 
+the same piece of code implementing Eq.~(\ref{eq:autoreg}), 
+and using succesively processes from order $0$ to~$n-1$ as~$w^{(i)}$.
+The parameters in Eq.~(\ref{eq:ord2}) are computed so that this recursive application
+of Eq.~(\ref{eq:autoreg}) leads to processes with the required standard deviation
+and correlation timescale, with the additional condition that
+the $n-1$ first derivatives of the autocorrelation function
+are equal to zero at~$t=0$, so that the resulting processes
+become smoother and smoother as $n$ is increased.
+
+Overall, this method provides quite a simple and generic way of generating 
+a wide class of stochastic processes. 
+However, this also means that new model parameters are needed to specify each of 
+these stochastic processes. As in any parameterization of lacking physics, 
+a very important issues then to tune these new parameters using either first principles, 
+model simulations, or real-world observations.
+
+\section{Implementation details}
+\label{STO_thech_details}
+
+%---------------------------------------namsbc--------------------------------------------------
+\namdisplay{namsto}
+%--------------------------------------------------------------------------------------------------------------
+
+The computer code implementing stochastic parametrisations can be found in the STO directory.
+It involves three modules : 
+\begin{description}
+\item[\mdl{stopar}] : define the Stochastic parameters and their time evolution.
+\item[\mdl{storng}] : a random number generator based on (and includes) the 64-bit KISS 
+                      (Keep It Simple Stupid) random number generator distributed by George Marsaglia 
+                      (see \href{https://groups.google.com/forum/#!searchin/comp.lang.fortran/64-bit$20KISS$20RNGs}{here})
+\item[\mdl{stopts}] : stochastic parametrisation associated with the non-linearity of the equation of seawater, 
+ implementing Eq~\ref{eq:sto_pert} and specific piece of code in the equation of state implementing Eq~\ref{eq:eos_sto}.
+\end{description}
+
+The \mdl{stopar} module has 3 public routines to be called by the model (in our case, NEMO):
+
+The first routine (\rou{sto\_par}) is a direct implementation of Eq.~(\ref{eq:autoreg}),
+applied at each model grid point (in 2D or 3D), 
+and called at each model time step ($k$) to update
+every autoregressive process ($i=1,\ldots,m$).
+This routine also includes a filtering operator, applied to $w^{(i)}$,
+to introduce a spatial correlation between the stochastic processes.
+
+The second routine (\rou{sto\_par\_init}) is an initialization routine mainly dedicated
+to the computation of parameters $a^{(i)}, b^{(i)}, c^{(i)}$
+for each autoregressive process, as a function of the statistical properties
+required by the model user (mean, standard deviation, time correlation,
+order of the process,\ldots). 
+
+Parameters for the processes can be specified through the following \ngn{namsto} namelist parameters:
+\begin{description}
+   \item[\np{nn\_sto\_eos}]   : number of independent random walks 
+   \item[\np{rn\_eos\_stdxy}] : random walk horz. standard deviation (in grid points)
+   \item[\np{rn\_eos\_stdz}]  : random walk vert. standard deviation (in grid points)
+   \item[\np{rn\_eos\_tcor}]  : random walk time correlation (in timesteps)
+   \item[\np{nn\_eos\_ord}]   : order of autoregressive processes
+   \item[\np{nn\_eos\_flt}]   : passes of Laplacian filter
+   \item[\np{rn\_eos\_lim}]   : limitation factor (default = 3.0)
+\end{description}
+This routine also includes the initialization (seeding) of the random number generator.
+
+The third routine (\rou{sto\_rst\_write}) writes a restart file (which suffix name is 
+given by \np{cn\_storst\_out} namelist parameter) containing the current value of 
+all autoregressive processes to allow restarting a simulation from where it has been interrupted.
+This file also contains the current state of the random number generator.
+When \np{ln\_rststo} is set to \textit{true}), the restart file (which suffix name is 
+given by \np{cn\_storst\_in} namelist parameter) is read by the initialization routine 
+(\rou{sto\_par\_init}). The simulation will continue exactly as if it was not interrupted
+only  when \np{ln\_rstseed} is set to \textit{true}, $i.e.$ when the state of 
+the random number generator is read in the restart file.
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_STP.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_STP.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_STP.tex	(revision 8732)
@@ -0,0 +1,406 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+
+% ================================================================
+% Chapter 2 ——— Time Domain (step.F90)
+% ================================================================
+\chapter{Time Domain (STP) }
+\label{STP}
+\minitoc
+
+% Missing things:
+%	- daymod: definition of the time domain (nit000, nitend andd the calendar)
+
+
+\gmcomment{STEVEN :maybe a picture of the directory structure in the introduction 
+which could be referred to here, would help  ==> to be added}
+%%%%
+
+
+\newpage
+$\ $\newline    % force a new ligne
+
+
+Having defined the continuous equations in Chap.~\ref{PE}, we need now to choose 
+a time discretization, a key feature of an ocean model as it exerts a strong influence  
+on the structure of the computer code ($i.e.$ on its flowchart). 
+In the present chapter, we provide a general description of the \NEMO 
+time stepping strategy and the consequences for the order in which the equations are
+solved.
+
+$\ $\newline    % force a new ligne
+% ================================================================
+% Time Discretisation
+% ================================================================
+\section{Time stepping environment}
+\label{STP_environment}
+
+The time stepping used in \NEMO is a three level scheme that can be 
+represented as follows:
+\begin{equation} \label{Eq_STP}
+   x^{t+\rdt} = x^{t-\rdt} + 2 \, \rdt \  \text{RHS}_x^{t-\rdt,\,t,\,t+\rdt}
+\end{equation} 
+where $x$ stands for $u$, $v$, $T$ or $S$; RHS is the Right-Hand-Side of the 
+corresponding time evolution equation; $\rdt$ is the time step; and the 
+superscripts indicate the time at which a quantity is evaluated. Each term of the 
+RHS is evaluated at a specific time step depending on the physics with which 
+it is associated. 
+
+The choice of the time step used for this evaluation is discussed below as 
+well as the implications for starting or restarting a model 
+simulation. Note that the time stepping calculation is generally performed in a single 
+operation. With such a complex and nonlinear system of equations it would be 
+dangerous to let a prognostic variable evolve in time for each term separately.
+
+The three level scheme requires three arrays for each prognostic variable. 
+For each variable $x$ there is $x_b$ (before), $x_n$ (now) and $x_a$. The third array, 
+although referred to as $x_a$ (after) in the code, is usually not the variable at 
+the after time step; but rather it is used to store the time derivative (RHS in 
+\eqref{Eq_STP}) prior to time-stepping the equation. Generally, the time 
+stepping is performed once at each time step in the \mdl{tranxt} and \mdl{dynnxt} 
+modules, except when using implicit vertical diffusion or calculating sea surface height 
+in which case time-splitting options are used.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Non-Diffusive Part---Leapfrog Scheme
+% -------------------------------------------------------------------------------------------------------------
+\section{Non-Diffusive Part --- Leapfrog Scheme}
+\label{STP_leap_frog}
+
+The time stepping used for processes other than diffusion is the well-known leapfrog
+scheme \citep{Mesinger_Arakawa_Bk76}.  This scheme is widely used for advection 
+processes in low-viscosity fluids. It is a time centred scheme, $i.e.$ 
+the RHS in \eqref{Eq_STP} is evaluated at time step $t$, the now time step. 
+It may be used for momentum and tracer advection, 
+pressure gradient, and Coriolis terms, but not for diffusion terms.
+It is an efficient method that achieves 
+second-order accuracy with just one right hand side evaluation per time step. 
+Moreover, it does not artificially damp linear oscillatory motion nor does it produce 
+instability by amplifying the oscillations. These advantages are somewhat diminished 
+by the large phase-speed error of the leapfrog scheme, and the unsuitability 
+of leapfrog differencing for the representation of diffusion and Rayleigh 
+damping processes. However, the scheme allows the coexistence of a numerical 
+and a physical mode due to its leading third order dispersive error. In other words a 
+divergence of odd and even time steps may occur. To prevent it, the leapfrog scheme 
+is often used in association with a Robert-Asselin time filter (hereafter the LF-RA scheme). 
+This filter, first designed by \citet{Robert_JMSJ66} and more comprehensively studied 
+by \citet{Asselin_MWR72}, is a kind of laplacian diffusion in time that mixes odd and 
+even time steps:
+\begin{equation} \label{Eq_STP_asselin}
+x_F^t  = x^t + \gamma \, \left[ x_F^{t-\rdt} - 2 x^t + x^{t+\rdt} \right]
+\end{equation} 
+where the subscript $F$ denotes filtered values and $\gamma$ is the Asselin 
+coefficient. $\gamma$ is initialized as \np{rn\_atfp} (namelist parameter). 
+Its default value is \np{rn\_atfp}=$10^{-3}$ (see \S~\ref{STP_mLF}), 
+causing only a weak dissipation of high frequency motions (\citep{Farge1987}). 
+The addition of a time filter degrades the accuracy of the 
+calculation from second to first order. However, the second order truncation 
+error is proportional to $\gamma$, which is small compared to 1. Therefore, 
+the LF-RA is a quasi second order accurate scheme. The LF-RA scheme 
+is preferred to other time differencing schemes such as 
+predictor corrector or trapezoidal schemes, because the user has an explicit 
+and simple control of the magnitude of the time diffusion of the scheme. 
+When used with the 2nd order space centred discretisation of the 
+advection terms in the momentum and tracer equations, LF-RA avoids implicit 
+numerical diffusion: diffusion is set explicitly by the user through the Robert-Asselin 
+filter parameter and the viscosity and diffusion coefficients.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Diffusive Part---Forward or Backward Scheme
+% -------------------------------------------------------------------------------------------------------------
+\section{Diffusive Part --- Forward or Backward Scheme}
+\label{STP_forward_imp}
+
+The leapfrog differencing scheme is unsuitable for the representation of 
+diffusion and damping processes. For a tendancy $D_x$, representing a 
+diffusion term or a restoring term to a tracer climatology 
+(when present, see \S~\ref{TRA_dmp}), a forward time differencing scheme
+ is used :
+\begin{equation} \label{Eq_STP_euler}
+   x^{t+\rdt} = x^{t-\rdt} + 2 \, \rdt \ {D_x}^{t-\rdt}
+\end{equation} 
+
+This is diffusive in time and conditionally stable. The 
+conditions for stability of second and fourth order horizontal diffusion schemes are \citep{Griffies_Bk04}:
+\begin{equation} \label{Eq_STP_euler_stability}
+A^h < \left\{
+\begin{aligned}
+                    &\frac{e^2}{  8 \; \rdt } 	&&\quad \text{laplacian diffusion} 	\\
+                    &\frac{e^4}{64 \; \rdt } 	&&\quad \text{bilaplacian diffusion} 
+            \end{aligned}
+\right.
+\end{equation}
+where $e$ is the smallest grid size in the two horizontal directions and $A^h$ is 
+the mixing coefficient. The linear constraint \eqref{Eq_STP_euler_stability} 
+is a necessary condition, but not sufficient. If it is not satisfied, even mildly, 
+then the model soon becomes wildly unstable. The instability can be removed 
+by either reducing the length of the time steps or reducing the mixing coefficient.
+
+For the vertical diffusion terms, a forward time differencing scheme can be 
+used, but usually the numerical stability condition imposes a strong 
+constraint on the time step. Two solutions are available in \NEMO to overcome 
+the stability constraint: $(a)$ a forward time differencing scheme using a 
+time splitting technique (\np{ln\_zdfexp} = true) or $(b)$ a backward (or implicit) 
+time differencing scheme (\np{ln\_zdfexp} = false). In $(a)$, the master 
+time step $\Delta $t is cut into $N$ fractional time steps so that the 
+stability criterion is reduced by a factor of $N$. The computation is performed as 
+follows:
+\begin{equation} \label{Eq_STP_ts}
+\begin{split}
+& x_\ast ^{t-\rdt} = x^{t-\rdt}   \\
+& x_\ast ^{t-\rdt+L\frac{2\rdt}{N}}=x_\ast ^{t-\rdt+\left( {L-1} 
+\right)\frac{2\rdt}{N}}+\frac{2\rdt}{N}\;\text{DF}^{t-\rdt+\left( {L-1} \right)\frac{2\rdt}{N}}
+        \quad \text{for $L=1$ to $N$}      \\
+& x^{t+\rdt} = x_\ast^{t+\rdt}
+\end{split}
+\end{equation}
+with DF a vertical diffusion term. The number of fractional time steps, $N$, is given 
+by setting \np{nn\_zdfexp}, (namelist parameter). The scheme $(b)$ is unconditionally 
+stable but diffusive. It can be written as follows:
+\begin{equation} \label{Eq_STP_imp}
+   x^{t+\rdt} = x^{t-\rdt} + 2 \, \rdt \  \text{RHS}_x^{t+\rdt}
+\end{equation} 
+
+%%gm
+%%gm   UPDATE the next paragraphs with time varying thickness ...
+%%gm
+
+This scheme is rather time consuming since it requires a matrix inversion, 
+but it becomes attractive since a value of 3 or more is needed for N in
+the forward time differencing scheme. For example, the finite difference 
+approximation of the temperature equation is:
+\begin{equation} \label{Eq_STP_imp_zdf}
+\frac{T(k)^{t+1}-T(k)^{t-1}}{2\;\rdt}\equiv \text{RHS}+\frac{1}{e_{3t} }\delta 
+_k \left[ {\frac{A_w^{vT} }{e_{3w} }\delta _{k+1/2} \left[ {T^{t+1}} \right]} 
+\right]
+\end{equation}
+where RHS is the right hand side of the equation except for the vertical diffusion term. 
+We rewrite \eqref{Eq_STP_imp} as:
+\begin{equation} \label{Eq_STP_imp_mat}
+-c(k+1)\;T^{t+1}(k+1) + d(k)\;T^{t+1}(k) - \;c(k)\;T^{t+1}(k-1) \equiv b(k)
+\end{equation}
+where 
+\begin{align*} 
+ c(k) &= A_w^{vT} (k) \, / \, e_{3w} (k)     \\
+ d(k) &= e_{3t} (k)       \, / \, (2\rdt) + c_k + c_{k+1}    \\
+ b(k) &= e_{3t} (k) \; \left( T^{t-1}(k) \, / \, (2\rdt) + \text{RHS} \right)    
+\end{align*}
+
+\eqref{Eq_STP_imp_mat} is a linear system of equations with an associated 
+matrix which is tridiagonal. Moreover, $c(k)$ and $d(k)$ are positive and the diagonal 
+term is greater than the sum of the two extra-diagonal terms, therefore a special 
+adaptation of the Gauss elimination procedure is used to find the solution 
+(see for example \citet{Richtmyer1967}).
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Surface Pressure gradient
+% -------------------------------------------------------------------------------------------------------------
+\section{Surface Pressure Gradient}
+\label{STP_spg_ts}
+
+===>>>>  TO BE written....  :-)
+
+%\gmcomment{ 
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=0.7\textwidth]{Fig_TimeStepping_flowchart}
+\caption{ 	\label{Fig_TimeStep_flowchart}
+Sketch of the leapfrog time stepping sequence in \NEMO from \citet{Leclair_Madec_OM09}. 
+The use of a semi-implicit computation of the hydrostatic pressure gradient requires
+the tracer equation to be stepped forward prior to the momentum equation. 
+The need for knowledge of the vertical scale factor (here denoted as $h$)
+requires the sea surface height and the continuity equation to be stepped forward
+prior to the computation of the tracer equation.
+Note that the method for the evaluation of the surface pressure gradient $\nabla p_s$ is not presented here 
+(see \S~\ref{DYN_spg}). }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+%}
+
+% -------------------------------------------------------------------------------------------------------------
+%        The Modified Leapfrog -- Asselin Filter scheme
+% -------------------------------------------------------------------------------------------------------------
+\section{The Modified Leapfrog -- Asselin Filter scheme}
+\label{STP_mLF}
+
+Significant changes have been introduced by \cite{Leclair_Madec_OM09} in the 
+LF-RA scheme in order to ensure tracer conservation and to allow the use of 
+a much smaller value of the Asselin filter parameter. The modifications affect 
+both the forcing and filtering treatments in the LF-RA scheme.
+
+In a classical LF-RA environment, the forcing term is centred in time, $i.e.$ 
+it is time-stepped over a $2\rdt$ period:  $x^t  = x^t + 2\rdt Q^t $ where $Q$ 
+is the forcing applied to $x$, and the time filter is given by \eqref{Eq_STP_asselin} 
+so that $Q$ is redistributed over several time step. 
+In the modified LF-RA environment, these two formulations have been replaced by:
+\begin{align} 
+x^{t+\rdt}  &= x^{t-\rdt} + \rdt \left( Q^{t-\rdt/2} + Q^{t+\rdt/2} \right)                   \label{Eq_STP_forcing} \\
+%
+x_F^t  &= x^t + \gamma \, \left[ x_F^{t-\rdt} - 2 x^t + x^{t+\rdt} \right] 
+           - \gamma\,\rdt \, \left[ Q^{t+\rdt/2} -  Q^{t-\rdt/2} \right]                          \label{Eq_STP_RA}
+\end{align}
+The change in the forcing formulation given by \eqref{Eq_STP_forcing} 
+(see Fig.\ref{Fig_MLF_forcing}) has a significant effect: the forcing term no 
+longer excites the divergence of odd and even time steps \citep{Leclair_Madec_OM09}. 
+% forcing seen by the model....
+This property improves the LF-RA scheme in two respects. 
+First, the LF-RA can now ensure the local and global conservation of tracers.
+Indeed, time filtering is no longer required on the forcing part. The influence of 
+the Asselin filter on the forcing is be removed by adding a new term in the filter
+(last term in \eqref{Eq_STP_RA} compared to \eqref{Eq_STP_asselin}). Since 
+the filtering of the forcing was the source of non-conservation in the classical 
+LF-RA scheme, the modified formulation becomes conservative  \citep{Leclair_Madec_OM09}.
+Second, the LF-RA becomes a truly quasi-second order scheme. Indeed, 
+\eqref{Eq_STP_forcing} used in combination with a careful treatment of static 
+instability (\S\ref{ZDF_evd}) and of the TKE physics (\S\ref{ZDF_tke_ene}),
+the two other main sources of time step divergence, allows a reduction by 
+two orders of magnitude of the Asselin filter parameter. 
+
+Note that the forcing is now provided at the middle of a time step: $Q^{t+\rdt/2}$ 
+is the forcing applied over the $[t,t+\rdt]$ time interval. This and the change 
+in the time filter, \eqref{Eq_STP_RA}, allows an exact evaluation of the 
+contribution due to the forcing term between any two time steps, 
+even if separated by only $\rdt$ since the time filter is no longer applied to the
+forcing term.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_MLF_forcing}
+\caption{ 	\label{Fig_MLF_forcing}
+Illustration of forcing integration methods. 
+(top) ''Traditional'' formulation : the forcing is defined at the same time as the variable 
+to which it is applied (integer value of the time step index) and it is applied over a $2\rdt$ period. 
+(bottom)  modified formulation : the forcing is defined in the middle of the time (integer and a half 
+value of the time step index) and the mean of two successive forcing values ($n-1/2$, $n+1/2$).
+is applied over a $2\rdt$ period.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        Start/Restart strategy
+% -------------------------------------------------------------------------------------------------------------
+\section{Start/Restart strategy}
+\label{STP_rst}
+%--------------------------------------------namrun-------------------------------------------
+\namdisplay{namrun}         
+%--------------------------------------------------------------------------------------------------------------
+
+The first time step of this three level scheme when starting from initial conditions 
+is a forward step (Euler time integration): 
+\begin{equation} \label{Eq_DOM_euler}
+	x^1 = x^0 + \rdt \ \text{RHS}^0
+\end{equation}
+This is done simply by keeping the leapfrog environment ($i.e.$ the \eqref{Eq_STP} 
+three level time stepping) but setting all $x^0$ (\textit{before}) and $x^{1}$ (\textit{now}) fields 
+equal at the first time step and using half the value of $\rdt$.
+
+It is also possible to restart from a previous computation, by using a 
+restart file. The restart strategy is designed to ensure perfect 
+restartability of the code: the user should obtain the same results to 
+machine precision either by running the model for $2N$ time steps in one go, 
+or by performing two consecutive experiments of $N$ steps with a restart. 
+This requires saving two time levels and many auxiliary data in the restart 
+files in machine precision. 
+
+Note that when a semi-implicit scheme is used to evaluate the hydrostatic pressure 
+gradient (see \S\ref{DYN_hpg_imp}), an extra three-dimensional field has to be 
+added to the restart file to ensure an exact restartability. This is done optionally 
+via the  \np{nn\_dynhpg\_rst} namelist parameter, so that the size of the
+restart file can be reduced when restartability is not a key issue (operational 
+oceanography or in ensemble simulations for seasonal forecasting).
+
+Note the size of the time step used, $\rdt$, is also saved in the restart file. 
+When restarting, if the the time step has been changed, a restart using an Euler time 
+stepping scheme is imposed. 
+Options are defined through the  \ngn{namrun} namelist variables.
+%%%
+\gmcomment{
+add here how to force the restart to contain only one time step for operational purposes
+
+add also the idea of writing several restart for seasonal forecast : how is it done ?
+
+verify that all namelist pararmeters are truly described 
+
+a word on the check of restart  .....
+}
+%%%
+
+\gmcomment{       % add a subsection here  
+
+%-------------------------------------------------------------------------------------------------------------
+%        Time Domain
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Time domain}
+\label{STP_time}
+%--------------------------------------------namrun-------------------------------------------
+\namdisplay{namdom}         
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namdom} namelist variables.
+ \colorbox{yellow}{add here a few word on nit000 and nitend}
+
+ \colorbox{yellow}{Write documentation on the calendar and the key variable adatrj}
+
+add a description of daymod, and the model calandar (leap-year and co)
+
+}     	%% end add
+
+
+
+%%
+\gmcomment{       % add implicit in vvl case  and Crant-Nicholson scheme   
+
+Implicit time stepping in case of variable volume thickness.
+
+Tracer case (NB for momentum in vector invariant form take care!)
+
+\begin{flalign*}
+&\frac{\left( e_{3t}\,T \right)_k^{t+1}-\left( e_{3t}\,T \right)_k^{t-1}}{2\rdt}
+\equiv \text{RHS}+ \delta _k \left[ {\frac{A_w^{vt} }{e_{3w}^{t+1} }\delta _{k+1/2} \left[ {T^{t+1}} \right]} 
+\right]      \\
+&\left( e_{3t}\,T \right)_k^{t+1}-\left( e_{3t}\,T \right)_k^{t-1}
+\equiv {2\rdt} \ \text{RHS}+ {2\rdt} \ \delta _k \left[ {\frac{A_w^{vt} }{e_{3w}^{t+1} }\delta _{k+1/2} \left[ {T^{t+1}} \right]} 
+\right]      \\
+&\left( e_{3t}\,T \right)_k^{t+1}-\left( e_{3t}\,T \right)_k^{t-1}
+\equiv 2\rdt \ \text{RHS}
++ 2\rdt \ \left\{ \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k+1/2} [ T_{k+1}^{t+1} - T_k      ^{t+1} ]
+                          - \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k-1/2} [ T_k       ^{t+1} - T_{k-1}^{t+1} ]  \right\}     \\
+&\\
+&\left( e_{3t}\,T \right)_k^{t+1}
+-  {2\rdt} \           \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k+1/2}                  T_{k+1}^{t+1} 
++ {2\rdt} \ \left\{  \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k+1/2} 
+                            +  \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k-1/2}     \right\}   T_{k    }^{t+1}
+-  {2\rdt} \           \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k-1/2}                  T_{k-1}^{t+1}      \\
+&\equiv \left( e_{3t}\,T \right)_k^{t-1} + {2\rdt} \ \text{RHS}    \\
+%
+\end{flalign*}
+
+\begin{flalign*}
+\allowdisplaybreaks
+\intertext{ Tracer case }
+%
+&  \qquad \qquad  \quad   -  {2\rdt}                  \ \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k+1/2}   
+                                                                                                      \qquad \qquad \qquad  \qquad  T_{k+1}^{t+1}   \\
+&+ {2\rdt} \ \biggl\{  (e_{3t})_{k   }^{t+1}  \bigg. +    \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k+1/2}  
+                                                                               +   \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k-1/2} \bigg. \biggr\}  \ \ \ T_{k   }^{t+1}  &&\\
+& \qquad \qquad  \qquad \qquad \qquad \quad \ \ -  {2\rdt} \                          \left[ \frac{A_w^{vt}}{e_{3w}^{t+1}} \right]_{k-1/2}                          \quad \ \ T_{k-1}^{t+1}     
+\ \equiv \ \left( e_{3t}\,T \right)_k^{t-1} + {2\rdt} \ \text{RHS}  \\
+%
+\end{flalign*}
+\begin{flalign*}
+\allowdisplaybreaks
+\intertext{ Tracer content case }
+%
+& -  {2\rdt} \              & \frac{(A_w^{vt})_{k+1/2}} {(e_{3w})_{k+1/2}^{t+1}\;(e_{3t})_{k+1}^{t+1}}  && \  \left( e_{3t}\,T \right)_{k+1}^{t+1}   &\\
+& + {2\rdt} \ \left[ 1  \right.+ & \frac{(A_w^{vt})_{k+1/2}} {(e_{3w})_{k+1/2}^{t+1}\;(e_{3t})_k^{t+1}} 
+                                    + & \frac{(A_w^{vt})_{k -1/2}} {(e_{3w})_{k -1/2}^{t+1}\;(e_{3t})_k^{t+1}}  \left.  \right]  & \left( e_{3t}\,T \right)_{k   }^{t+1}  &\\
+& -  {2\rdt} \               & \frac{(A_w^{vt})_{k -1/2}} {(e_{3w})_{k -1/2}^{t+1}\;(e_{3t})_{k-1}^{t+1}}     &\  \left( e_{3t}\,T \right)_{k-1}^{t+1}   
+\equiv \left( e_{3t}\,T \right)_k^{t-1} + {2\rdt} \ \text{RHS}  &
+\end{flalign*}
+
+%%
+}
+%%
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_TRA.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 8732)
@@ -0,0 +1,1479 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter 1 ——— Ocean Tracers (TRA)
+% ================================================================
+\chapter{Ocean Tracers (TRA)}
+\label{TRA}
+\minitoc
+
+% missing/update 
+% traqsr: need to coordinate with SBC module
+
+%STEVEN :  is the use of the word "positive" to describe a scheme enough, or should it be "positive definite"? I added a comment to this effect on some instances of this below
+
+%\newpage
+\vspace{2.cm}
+%$\ $\newline    % force a new ligne
+
+Using the representation described in Chap.~\ref{DOM}, several semi-discrete 
+space forms of the tracer equations are available depending on the vertical 
+coordinate used and on the physics used. In all the equations presented 
+here, the masking has been omitted for simplicity. One must be aware that 
+all the quantities are masked fields and that each time a mean or difference 
+operator is used, the resulting field is multiplied by a mask.
+
+The two active tracers are potential temperature and salinity. Their prognostic 
+equations can be summarized as follows:
+\begin{equation*}
+\text{NXT} = \text{ADV}+\text{LDF}+\text{ZDF}+\text{SBC}
+                   \ (+\text{QSR})\ (+\text{BBC})\ (+\text{BBL})\ (+\text{DMP})
+\end{equation*}
+
+NXT stands for next, referring to the time-stepping. From left to right, the terms 
+on the rhs of the tracer equations are the advection (ADV), the lateral diffusion 
+(LDF), the vertical diffusion (ZDF), the contributions from the external forcings 
+(SBC: Surface Boundary Condition, QSR: penetrative Solar Radiation, and BBC: 
+Bottom Boundary Condition), the contribution from the bottom boundary Layer 
+(BBL) parametrisation, and an internal damping (DMP) term. The terms QSR, 
+BBC, BBL and DMP are optional. The external forcings and parameterisations 
+require complex inputs and complex calculations ($e.g.$ bulk formulae, estimation 
+of mixing coefficients) that are carried out in the SBC, LDF and ZDF modules and 
+described in chapters \S\ref{SBC}, \S\ref{LDF} and  \S\ref{ZDF}, respectively. 
+Note that \mdl{tranpc}, the non-penetrative convection module, although 
+located in the NEMO/OPA/TRA directory as it directly modifies the tracer fields, 
+is described with the model vertical physics (ZDF) together with other available 
+parameterization of convection.
+
+In the present chapter we also describe the diagnostic equations used to compute 
+the sea-water properties (density, Brunt-V\"{a}is\"{a}l\"{a} frequency, specific heat and 
+freezing point with associated modules \mdl{eosbn2} and \mdl{phycst}).
+
+The different options available to the user are managed by namelist logicals or CPP keys. 
+For each equation term  \textit{TTT}, the namelist logicals are \textit{ln\_traTTT\_xxx}, 
+where \textit{xxx} is a 3 or 4 letter acronym corresponding to each optional scheme. 
+The CPP key (when it exists) is \textbf{key\_traTTT}. The equivalent code can be 
+found in the \textit{traTTT} or \textit{traTTT\_xxx} module, in the NEMO/OPA/TRA directory.
+
+The user has the option of extracting each tendency term on the RHS of the tracer 
+equation for output (\np{ln\_tra\_trd} or \np{ln\_tra\_mxl}~=~true), as described in Chap.~\ref{DIA}.
+
+$\ $\newline    % force a new ligne
+% ================================================================
+% Tracer Advection
+% ================================================================
+\section  [Tracer Advection (\textit{traadv})]
+		{Tracer Advection (\mdl{traadv})}
+\label{TRA_adv}
+%------------------------------------------namtra_adv-----------------------------------------------------
+\namdisplay{namtra_adv}
+%-------------------------------------------------------------------------------------------------------------
+
+When considered ($i.e.$ when \np{ln\_traadv\_NONE} is not set to \textit{true}), 
+the advection tendency of a tracer is expressed in flux form, 
+$i.e.$ as the divergence of the advective fluxes. Its discrete expression is given by :
+\begin{equation} \label{Eq_tra_adv}
+ADV_\tau =-\frac{1}{b_t} \left( 
+\;\delta _i \left[ e_{2u}\,e_{3u} \;  u\; \tau _u  \right]
++\delta _j \left[ e_{1v}\,e_{3v}  \;  v\; \tau _v  \right] \; \right)
+-\frac{1}{e_{3t}} \;\delta _k \left[ w\; \tau _w \right]
+\end{equation}
+where $\tau$ is either T or S, and $b_t= e_{1t}\,e_{2t}\,e_{3t}$ is the volume of $T$-cells. 
+The flux form in \eqref{Eq_tra_adv} 
+implicitly requires the use of the continuity equation. Indeed, it is obtained
+by using the following equality : $\nabla \cdot \left( \vect{U}\,T \right)=\vect{U} \cdot \nabla T$ 
+which results from the use of the continuity equation,  $\partial _t e_3 + e_3\;\nabla \cdot \vect{U}=0$ 
+(which reduces to $\nabla \cdot \vect{U}=0$ in linear free surface, $i.e.$ \np{ln\_linssh}=true). 
+Therefore it is of paramount importance to design the discrete analogue of the 
+advection tendency so that it is consistent with the continuity equation in order to 
+enforce the conservation properties of the continuous equations. In other words, 
+by setting $\tau = 1$ in (\ref{Eq_tra_adv}) we recover the discrete form of 
+the continuity equation which is used to calculate the vertical velocity.
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	 \begin{center}
+\includegraphics[width=0.9\textwidth]{Fig_adv_scheme}
+\caption{	\label{Fig_adv_scheme} 
+Schematic representation of some ways used to evaluate the tracer value 
+at $u$-point and the amount of tracer exchanged between two neighbouring grid 
+points. Upsteam biased scheme (ups): the upstream value is used and the black 
+area is exchanged. Piecewise parabolic method (ppm): a parabolic interpolation 
+is used and the black and dark grey areas are exchanged. Monotonic upstream 
+scheme for conservative laws (muscl):  a parabolic interpolation is used and black, 
+dark grey and grey areas are exchanged. Second order scheme (cen2): the mean 
+value is used and black, dark grey, grey and light grey areas are exchanged. Note 
+that this illustration does not include the flux limiter used in ppm and muscl schemes.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The key difference between the advection schemes available in \NEMO is the choice 
+made in space and time interpolation to define the value of the tracer at the 
+velocity points (Fig.~\ref{Fig_adv_scheme}). 
+
+Along solid lateral and bottom boundaries a zero tracer flux is automatically 
+specified, since the normal velocity is zero there. At the sea surface the 
+boundary condition depends on the type of sea surface chosen: 
+\begin{description}
+\item [linear free surface:] (\np{ln\_linssh}=true) the first level thickness is constant in time: 
+the vertical boundary condition is applied at the fixed surface $z=0$ 
+rather than on the moving surface $z=\eta$. There is a non-zero advective 
+flux which is set for all advection schemes as 
+$\left. {\tau _w } \right|_{k=1/2} =T_{k=1} $, $i.e.$ 
+the product of surface velocity (at $z=0$) by the first level tracer value.
+\item [non-linear free surface:] (\np{ln\_linssh}=false) 
+convergence/divergence in the first ocean level moves the free surface 
+up/down. There is no tracer advection through it so that the advective 
+fluxes through the surface are also zero 
+\end{description}
+In all cases, this boundary condition retains local conservation of tracer. 
+Global conservation is obtained in non-linear free surface case, 
+but \textit{not} in the linear free surface case. Nevertheless, in the latter case, 
+it is achieved to a good approximation since the non-conservative 
+term is the product of the time derivative of the tracer and the free surface 
+height, two quantities that are not correlated \citep{Roullet_Madec_JGR00,Griffies_al_MWR01,Campin2004}.
+
+The velocity field that appears in (\ref{Eq_tra_adv}) and (\ref{Eq_tra_adv_zco}) 
+is the centred (\textit{now}) \textit{effective} ocean velocity, $i.e.$ the \textit{eulerian} velocity
+(see Chap.~\ref{DYN}) plus the eddy induced velocity (\textit{eiv}) 
+and/or the mixed layer eddy induced velocity (\textit{eiv})
+when those parameterisations are used (see Chap.~\ref{LDF}).
+
+Several tracer advection scheme are proposed, namely 
+a $2^{nd}$ or $4^{th}$ order centred schemes (CEN), 
+a $2^{nd}$ or $4^{th}$ order Flux Corrected Transport scheme (FCT),
+a Monotone Upstream Scheme for Conservative Laws scheme (MUSCL),
+a $3^{rd}$ Upstream Biased Scheme (UBS, also often called UP3), and
+a Quadratic Upstream Interpolation for Convective Kinematics with 
+Estimated Streaming Terms scheme (QUICKEST).
+The choice is made in the \textit{\ngn{namtra\_adv}} namelist, by 
+setting to \textit{true} one of the logicals \textit{ln\_traadv\_xxx}. 
+The corresponding code can be found in the \textit{traadv\_xxx.F90} module, 
+where \textit{xxx} is a 3 or 4 letter acronym corresponding to each scheme. 
+By default ($i.e.$ in the reference namelist, \ngn{namelist\_ref}), all the logicals 
+are set to \textit{false}. If the user does not select an advection scheme 
+in the configuration namelist (\ngn{namelist\_cfg}), the tracers will \textit{not} be advected !
+
+Details of the advection schemes are given below. The choosing an advection scheme 
+is a complex matter which depends on the model physics, model resolution, 
+type of tracer, as well as the issue of numerical cost. In particular, we note that
+(1) CEN and FCT schemes require an explicit diffusion operator 
+while the other schemes are diffusive enough so that they do not necessarily need additional diffusion ; 
+(2) CEN and UBS are not \textit{positive} schemes
+\footnote{negative values can appear in an initially strictly positive tracer field 
+which is advected}
+, implying that false extrema are permitted. Their use is not recommended on passive tracers ; 
+(3) It is recommended that the same advection-diffusion scheme is 
+used on both active and passive tracers. Indeed, if a source or sink of a 
+passive tracer depends on an active one, the difference of treatment of 
+active and passive tracers can create very nice-looking frontal structures 
+that are pure numerical artefacts. Nevertheless, most of our users set a different 
+treatment on passive and active tracers, that's the reason why this possibility 
+is offered. We strongly suggest them to perform a sensitivity experiment 
+using a same treatment to assess the robustness of their results.
+
+% -------------------------------------------------------------------------------------------------------------
+%        2nd and 4th order centred schemes
+% -------------------------------------------------------------------------------------------------------------
+\subsection [Centred schemes (CEN) (\np{ln\_traadv\_cen})]
+			   {Centred schemes (CEN) (\np{ln\_traadv\_cen}=true)}
+\label{TRA_adv_cen}
+
+%        2nd order centred scheme  
+
+The centred advection scheme (CEN) is used when \np{ln\_traadv\_cen}~=~\textit{true}. 
+Its order ($2^{nd}$ or $4^{th}$) can be chosen independently on horizontal (iso-level) 
+and vertical direction by setting \np{nn\_cen\_h} and \np{nn\_cen\_v} to $2$ or $4$. 
+CEN implementation can be found in the \mdl{traadv\_cen} module.
+
+In the $2^{nd}$ order centred formulation (CEN2), the tracer at velocity points 
+is evaluated as the mean of the two neighbouring $T$-point values. 
+For example, in the $i$-direction :
+\begin{equation} \label{Eq_tra_adv_cen2}
+\tau _u^{cen2} =\overline T ^{i+1/2}
+\end{equation}
+
+CEN2 is non diffusive ($i.e.$ it conserves the tracer variance, $\tau^2)$ 
+but dispersive ($i.e.$ it may create false extrema). It is therefore notoriously 
+noisy and must be used in conjunction with an explicit diffusion operator to 
+produce a sensible solution. The associated time-stepping is performed using 
+a leapfrog scheme in conjunction with an Asselin time-filter, so $T$ in 
+(\ref{Eq_tra_adv_cen2}) is the \textit{now} tracer value. 
+
+Note that using the CEN2, the overall tracer advection is of second 
+order accuracy since both (\ref{Eq_tra_adv}) and (\ref{Eq_tra_adv_cen2}) 
+have this order of accuracy.
+
+%        4nd order centred scheme  
+
+In the $4^{th}$ order formulation (CEN4), tracer values are evaluated at u- and v-points as 
+a $4^{th}$ order interpolation, and thus depend on the four neighbouring $T$-points. 
+For example, in the $i$-direction:
+\begin{equation} \label{Eq_tra_adv_cen4}
+\tau _u^{cen4} 
+=\overline{   T - \frac{1}{6}\,\delta _i \left[ \delta_{i+1/2}[T] \,\right]   }^{\,i+1/2}
+\end{equation}
+In the vertical direction (\np{nn\_cen\_v}=$4$), a $4^{th}$ COMPACT interpolation 
+has been prefered \citep{Demange_PhD2014}.
+In the COMPACT scheme, both the field and its derivative are interpolated, 
+which leads, after a matrix inversion, spectral characteristics 
+similar to schemes of higher order \citep{Lele_JCP1992}.
+ 
+
+Strictly speaking, the CEN4 scheme is not a $4^{th}$ order advection scheme 
+but a $4^{th}$ order evaluation of advective fluxes, since the divergence of 
+advective fluxes \eqref{Eq_tra_adv} is kept at $2^{nd}$ order. 
+The expression \textit{$4^{th}$ order scheme} used in oceanographic literature 
+is usually associated with the scheme presented here. 
+Introducing a \textit{true} $4^{th}$ order advection scheme is feasible but, 
+for consistency reasons, it requires changes in the discretisation of the tracer 
+advection together with changes in the continuity equation, 
+and the momentum advection and pressure terms.  
+
+A direct consequence of the pseudo-fourth order nature of the scheme is that 
+it is not non-diffusive, $i.e.$ the global variance of a tracer is not preserved using CEN4. 
+Furthermore, it must be used in conjunction with an explicit diffusion operator 
+to produce a sensible solution. 
+As in CEN2 case, the time-stepping is performed using a leapfrog scheme in conjunction 
+with an Asselin time-filter, so $T$ in (\ref{Eq_tra_adv_cen4}) is the \textit{now} tracer.
+
+At a $T$-grid cell adjacent to a boundary (coastline, bottom and surface), 
+an additional hypothesis must be made to evaluate $\tau _u^{cen4}$. 
+This hypothesis usually reduces the order of the scheme. 
+Here we choose to set the gradient of $T$ across the boundary to zero. 
+Alternative conditions can be specified, such as a reduction to a second order scheme 
+for these near boundary grid points.
+
+% -------------------------------------------------------------------------------------------------------------
+%        FCT scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Flux Corrected Transport schemes (FCT) (\np{ln\_traadv\_fct})]
+			{Flux Corrected Transport schemes (FCT) (\np{ln\_traadv\_fct}=true)}
+\label{TRA_adv_tvd}
+
+The Flux Corrected Transport schemes (FCT) is used when \np{ln\_traadv\_fct}~=~\textit{true}. 
+Its order ($2^{nd}$ or $4^{th}$) can be chosen independently on horizontal (iso-level) 
+and vertical direction by setting \np{nn\_fct\_h} and \np{nn\_fct\_v} to $2$ or $4$.
+FCT implementation can be found in the \mdl{traadv\_fct} module.
+
+In FCT formulation, the tracer at velocity points is evaluated using a combination of 
+an upstream and a centred scheme. For example, in the $i$-direction :
+\begin{equation} \label{Eq_tra_adv_fct}
+\begin{split}
+\tau _u^{ups}&= \begin{cases}
+ 					T_{i+1} 	& \text{if $\ u_{i+1/2} <     0$} \hfill \\
+ 					T_i   		& \text{if $\ u_{i+1/2} \geq 0$} \hfill \\
+				  \end{cases}     \\
+\\
+\tau _u^{fct}&=\tau _u^{ups} +c_u \;\left( {\tau _u^{cen} -\tau _u^{ups} } \right)
+\end{split}
+\end{equation}
+where $c_u$ is a flux limiter function taking values between 0 and 1. 
+The FCT order is the one of the centred scheme used ($i.e.$ it depends on the setting of
+\np{nn\_fct\_h} and \np{nn\_fct\_v}.
+There exist many ways to define $c_u$, each corresponding to a different 
+FCT scheme. The one chosen in \NEMO is described in \citet{Zalesak_JCP79}. 
+$c_u$ only departs from $1$ when the advective term produces a local extremum in the tracer field. 
+The resulting scheme is quite expensive but \emph{positive}. 
+It can be used on both active and passive tracers. 
+A comparison of FCT-2 with MUSCL and a MPDATA scheme can be found in \citet{Levy_al_GRL01}. 
+
+An additional option has been added controlled by \np{nn\_fct\_zts}. By setting this integer to 
+a value larger than zero, a $2^{nd}$ order FCT scheme is used on both horizontal and vertical direction, 
+but on the latter, a split-explicit time stepping is used, with a number of sub-timestep equals
+to \np{nn\_fct\_zts}. This option can be useful when the size of the timestep is limited 
+by vertical advection \citep{Lemarie_OM2015}. Note that in this case, a similar split-explicit 
+time stepping should be used on vertical advection of momentum to insure a better stability
+(see \S\ref{DYN_zad}).
+
+For stability reasons (see \S\ref{STP}), $\tau _u^{cen}$ is evaluated in (\ref{Eq_tra_adv_fct}) 
+using the \textit{now} tracer while $\tau _u^{ups}$ is evaluated using the \textit{before} tracer. In other words, 
+the advective part of the scheme is time stepped with a leap-frog scheme 
+while a forward scheme is used for the diffusive part. 
+
+% -------------------------------------------------------------------------------------------------------------
+%        MUSCL scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection[MUSCL scheme  (\np{ln\_traadv\_mus})]
+	{Monotone Upstream Scheme for Conservative Laws (MUSCL) (\np{ln\_traadv\_mus}=T)}
+\label{TRA_adv_mus}
+
+The Monotone Upstream Scheme for Conservative Laws (MUSCL) is used when \np{ln\_traadv\_mus}~=~\textit{true}. 
+MUSCL implementation can be found in the \mdl{traadv\_mus} module.
+
+MUSCL has been first implemented in \NEMO by \citet{Levy_al_GRL01}. In its formulation, the tracer at velocity points 
+is evaluated assuming a linear tracer variation between two $T$-points 
+(Fig.\ref{Fig_adv_scheme}). For example, in the $i$-direction :
+\begin{equation} \label{Eq_tra_adv_mus}
+   \tau _u^{mus} = \left\{      \begin{aligned}
+         &\tau _i  &+ \frac{1}{2} \;\left( 1-\frac{u_{i+1/2} \;\rdt}{e_{1u}} \right)
+         &\ \widetilde{\partial _i \tau}  & \quad \text{if }\;u_{i+1/2} \geqslant 0      \\
+         &\tau _{i+1/2} &+\frac{1}{2}\;\left( 1+\frac{u_{i+1/2} \;\rdt}{e_{1u} } \right)
+         &\ \widetilde{\partial_{i+1/2} \tau } & \text{if }\;u_{i+1/2} <0
+   \end{aligned}    \right.
+\end{equation}
+where $\widetilde{\partial _i \tau}$ is the slope of the tracer on which a limitation 
+is imposed to ensure the \textit{positive} character of the scheme.
+
+The time stepping is performed using a forward scheme, that is the \textit{before} 
+tracer field is used to evaluate $\tau _u^{mus}$.
+
+For an ocean grid point adjacent to land and where the ocean velocity is 
+directed toward land, an upstream flux is used. This choice ensure 
+the \textit{positive} character of the scheme. 
+In addition, fluxes round a grid-point where a runoff is applied can optionally be 
+computed using upstream fluxes (\np{ln\_mus\_ups}~=~\textit{true}).
+
+% -------------------------------------------------------------------------------------------------------------
+%        UBS scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Upstream-Biased Scheme (UBS) (\np{ln\_traadv\_ubs})]
+			{Upstream-Biased Scheme (UBS) (\np{ln\_traadv\_ubs}=true)}
+\label{TRA_adv_ubs}
+
+The Upstream-Biased Scheme (UBS) is used when \np{ln\_traadv\_ubs}~=~\textit{true}. 
+UBS implementation can be found in the \mdl{traadv\_mus} module.
+
+The UBS scheme, often called UP3, is also known as the Cell Averaged QUICK scheme 
+(Quadratic Upstream Interpolation for Convective Kinematics). It is an upstream-biased 
+third order scheme based on an upstream-biased parabolic interpolation.  
+For example, in the $i$-direction :
+\begin{equation} \label{Eq_tra_adv_ubs}
+   \tau _u^{ubs} =\overline T ^{i+1/2}-\;\frac{1}{6} \left\{      
+   \begin{aligned}
+         &\tau"_i        	& \quad \text{if }\ u_{i+1/2} \geqslant 0      \\
+         &\tau"_{i+1}	& \quad \text{if }\ u_{i+1/2}       <       0
+   \end{aligned}    \right.
+\end{equation}
+where $\tau "_i =\delta _i \left[ {\delta _{i+1/2} \left[ \tau \right]} \right]$.
+
+This results in a dissipatively dominant (i.e. hyper-diffusive) truncation 
+error \citep{Shchepetkin_McWilliams_OM05}. The overall performance of
+ the advection scheme is similar to that reported in \cite{Farrow1995}. 
+It is a relatively good compromise between accuracy and smoothness. 
+Nevertheless the scheme is not \emph{positive}, meaning that false extrema are permitted, 
+but the amplitude of such are significantly reduced over the centred second 
+or fourth order method. therefore it is not recommended that it should be 
+applied to a passive tracer that requires positivity. 
+
+The intrinsic diffusion of UBS makes its use risky in the vertical direction 
+where the control of artificial diapycnal fluxes is of paramount importance \citep{Shchepetkin_McWilliams_OM05, Demange_PhD2014}. 
+Therefore the vertical flux is evaluated using either a $2^nd$ order FCT scheme 
+or a $4^th$ order COMPACT scheme (\np{nn\_cen\_v}=2 or 4).
+
+For stability reasons  (see \S\ref{STP}),
+the first term  in \eqref{Eq_tra_adv_ubs} (which corresponds to a second order 
+centred scheme) is evaluated using the \textit{now} tracer (centred in time) 
+while the second term (which is the diffusive part of the scheme), is 
+evaluated using the \textit{before} tracer (forward in time). 
+This choice is discussed by \citet{Webb_al_JAOT98} in the context of the 
+QUICK advection scheme. UBS and QUICK schemes only differ 
+by one coefficient. Replacing 1/6 with 1/8 in \eqref{Eq_tra_adv_ubs} 
+leads to the QUICK advection scheme \citep{Webb_al_JAOT98}. 
+This option is not available through a namelist parameter, since the 
+1/6 coefficient is hard coded. Nevertheless it is quite easy to make the 
+substitution in the \mdl{traadv\_ubs} module and obtain a QUICK scheme.
+
+Note that it is straightforward to rewrite \eqref{Eq_tra_adv_ubs} as follows:
+\begin{equation} \label{Eq_traadv_ubs2}
+\tau _u^{ubs} = \tau _u^{cen4} + \frac{1}{12} \left\{	 
+   \begin{aligned}
+	& + \tau"_i			& \quad \text{if }\ u_{i+1/2} \geqslant 0 \\
+	&  - \tau"_{i+1}		& \quad \text{if }\ u_{i+1/2}       <       0
+   \end{aligned}    \right.
+\end{equation}
+or equivalently 
+\begin{equation} \label{Eq_traadv_ubs2b}
+u_{i+1/2} \ \tau _u^{ubs} 
+=u_{i+1/2} \ \overline{ T - \frac{1}{6}\,\delta _i\left[ \delta_{i+1/2}[T] \,\right] }^{\,i+1/2}
+- \frac{1}{2} |u|_{i+1/2} \;\frac{1}{6} \;\delta_{i+1/2}[\tau"_i]
+\end{equation}
+
+\eqref{Eq_traadv_ubs2} has several advantages. Firstly, it clearly reveals 
+that the UBS scheme is based on the fourth order scheme to which an 
+upstream-biased diffusion term is added. Secondly, this emphasises that the 
+$4^{th}$ order part (as well as the $2^{nd}$ order part as stated above) has 
+to be evaluated at the \emph{now} time step using \eqref{Eq_tra_adv_ubs}. 
+Thirdly, the diffusion term is in fact a biharmonic operator with an eddy 
+coefficient which is simply proportional to the velocity:
+ $A_u^{lm}= \frac{1}{12}\,{e_{1u}}^3\,|u|$. Note the current version of NEMO uses 
+the computationally more efficient formulation \eqref{Eq_tra_adv_ubs}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        QCK scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [QUICKEST scheme (QCK) (\np{ln\_traadv\_qck})]
+			{QUICKEST scheme (QCK) (\np{ln\_traadv\_qck}=true)}
+\label{TRA_adv_qck}
+
+The Quadratic Upstream Interpolation for Convective Kinematics with 
+Estimated Streaming Terms (QUICKEST) scheme proposed by \citet{Leonard1979} 
+is used when \np{ln\_traadv\_qck}~=~\textit{true}. 
+QUICKEST implementation can be found in the \mdl{traadv\_qck} module.
+
+QUICKEST is the third order Godunov scheme which is associated with the ULTIMATE QUICKEST 
+limiter \citep{Leonard1991}. It has been implemented in NEMO by G. Reffray 
+(MERCATOR-ocean) and can be found in the \mdl{traadv\_qck} module.
+The resulting scheme is quite expensive but \emph{positive}. 
+It can be used on both active and passive tracers. 
+However, the intrinsic diffusion of QCK makes its use risky in the vertical 
+direction where the control of artificial diapycnal fluxes is of paramount importance. 
+Therefore the vertical flux is evaluated using the CEN2 scheme. 
+This no longer guarantees the positivity of the scheme. 
+The use of FCT in the vertical direction (as for the UBS case) should be implemented 
+to restore this property.
+
+%%%gmcomment   :  Cross term are missing in the current implementation....
+
+
+% ================================================================
+% Tracer Lateral Diffusion
+% ================================================================
+\section  [Tracer Lateral Diffusion (\textit{traldf})]
+		{Tracer Lateral Diffusion (\mdl{traldf})}
+\label{TRA_ldf}
+%-----------------------------------------nam_traldf------------------------------------------------------
+\namdisplay{namtra_ldf}
+%-------------------------------------------------------------------------------------------------------------
+ 
+Options are defined through the \ngn{namtra\_ldf} namelist variables.
+They are regrouped in four items, allowing to specify 
+$(i)$   the type of operator used (none, laplacian, bilaplacian), 
+$(ii)$  the direction along which the operator acts (iso-level, horizontal, iso-neutral), 
+$(iii)$ some specific options related to the rotated operators ($i.e.$ non-iso-level operator), and 
+$(iv)$  the specification of eddy diffusivity coefficient (either constant or variable in space and time).
+Item $(iv)$ will be described in Chap.\ref{LDF} .
+The direction along which the operators act is defined through the slope between this direction and the iso-level surfaces.
+The slope is computed in the \mdl{ldfslp} module and will also be described in Chap.~\ref{LDF}. 
+
+The lateral diffusion of tracers is evaluated using a forward scheme, 
+$i.e.$ the tracers appearing in its expression are the \textit{before} tracers in time, 
+except for the pure vertical component that appears when a rotation tensor is used. 
+This latter component is solved implicitly together with the vertical diffusion term (see \S\ref{STP}). 
+When \np{ln\_traldf\_msc}~=~\textit{true}, a Method of Stabilizing Correction is used in which 
+the pure vertical component is split into an explicit and an implicit part \citep{Lemarie_OM2012}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Type of operator
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Type of operator (\np{ln\_traldf\_NONE}, \np{ln\_traldf\_lap}, \np{ln\_traldf\_blp})]
+			     {Type of operator (\np{ln\_traldf\_NONE}, \np{ln\_traldf\_lap}, or \np{ln\_traldf\_blp} = true) } 
+\label{TRA_ldf_op}
+
+Three operator options are proposed and, one and only one of them must be selected:
+\begin{description}
+\item [\np{ln\_traldf\_NONE}] = true : no operator selected, the lateral diffusive tendency will not be 
+applied to the tracer equation. This option can be used when the selected advection scheme 
+is diffusive enough (MUSCL scheme for example).
+\item [ \np{ln\_traldf\_lap}] = true : a laplacian operator is selected. This harmonic operator 
+takes the following expression:  $\mathpzc{L}(T)=\nabla \cdot A_{ht}\;\nabla T $, 
+where the gradient operates along the selected direction (see \S\ref{TRA_ldf_dir}),
+and $A_{ht}$ is the eddy diffusivity coefficient expressed in $m^2/s$ (see Chap.~\ref{LDF}).
+\item [\np{ln\_traldf\_blp}] = true : a bilaplacian operator is selected. This biharmonic operator 
+takes the following expression:  
+$\mathpzc{B}=- \mathpzc{L}\left(\mathpzc{L}(T) \right) = -\nabla \cdot b\nabla \left( {\nabla \cdot b\nabla T} \right)$ 
+where the gradient operats along the selected direction,
+and $b^2=B_{ht}$ is the eddy diffusivity coefficient expressed in $m^4/s$  (see Chap.~\ref{LDF}).
+In the code, the bilaplacian operator is obtained by calling the laplacian twice.
+\end{description}
+
+Both laplacian and bilaplacian operators ensure the total tracer variance decrease. 
+Their primary role is to provide strong dissipation at the smallest scale supported 
+by the grid while minimizing the impact on the larger scale features. 
+The main difference between the two operators is the scale selectiveness. 
+The bilaplacian damping time ($i.e.$ its spin down time) scales like $\lambda^{-4}$ 
+for disturbances of wavelength $\lambda$ (so that short waves damped more rapidelly than long ones), 
+whereas the laplacian damping time scales only like $\lambda^{-2}$.
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Direction of action
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Direction of action (\np{ln\_traldf\_lev}, \np{ln\_traldf\_hor}, \np{ln\_traldf\_iso}, \np{ln\_traldf\_triad})]
+			     {Direction of action (\np{ln\_traldf\_lev}, \textit{...\_hor}, \textit{...\_iso}, or \textit{...\_triad} = true) } 
+\label{TRA_ldf_dir}
+
+The choice of a direction of action determines the form of operator used. 
+The operator is a simple (re-entrant) laplacian acting in the (\textbf{i},\textbf{j}) plane 
+when iso-level option is used (\np{ln\_traldf\_lev}~=~\textit{true})
+or when a horizontal ($i.e.$ geopotential) operator is demanded in \textit{z}-coordinate 
+(\np{ln\_traldf\_hor} and \np{ln\_zco} equal \textit{true}). 
+The associated code can be found in the \mdl{traldf\_lap\_blp} module.
+The operator is a rotated (re-entrant) laplacian when the direction along which it acts 
+does not coincide with the iso-level surfaces, 
+that is when standard or triad iso-neutral option is used (\np{ln\_traldf\_iso} or 
+ \np{ln\_traldf\_triad} equals \textit{true}, see \mdl{traldf\_iso} or \mdl{traldf\_triad} module, resp.), 
+or when a horizontal ($i.e.$ geopotential) operator is demanded in \textit{s}-coordinate 
+(\np{ln\_traldf\_hor} and \np{ln\_sco} equal \textit{true})
+\footnote{In this case, the standard iso-neutral operator will be automatically selected}. 
+In that case, a rotation is applied to the gradient(s) that appears in the operator 
+so that diffusive fluxes acts on the three spatial direction.
+
+The resulting discret form of the three operators (one iso-level and two rotated one) 
+is given in the next two sub-sections. 
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       iso-level operator
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Iso-level (bi-)laplacian operator ( \np{ln\_traldf\_iso})]
+			{Iso-level (bi-)laplacian operator ( \np{ln\_traldf\_iso}) }
+\label{TRA_ldf_lev}
+
+The laplacian diffusion operator acting along the model (\textit{i,j})-surfaces is given by: 
+\begin{equation} \label{Eq_tra_ldf_lap}
+D_t^{lT} =\frac{1}{b_t} \left( \;
+   \delta _{i}\left[ A_u^{lT} \; \frac{e_{2u}\,e_{3u}}{e_{1u}} \;\delta _{i+1/2} [T] \right] 
++ \delta _{j}\left[ A_v^{lT} \;  \frac{e_{1v}\,e_{3v}}{e_{2v}} \;\delta _{j+1/2} [T] \right]  \;\right)
+\end{equation}
+where  $b_t$=$e_{1t}\,e_{2t}\,e_{3t}$  is the volume of $T$-cells 
+and where zero diffusive fluxes is assumed across solid boundaries, 
+first (and third in bilaplacian case) horizontal tracer derivative are masked. 
+It is implemented in the \rou{traldf\_lap} subroutine found in the \mdl{traldf\_lap} module. 
+The module also contains \rou{traldf\_blp}, the subroutine calling twice \rou{traldf\_lap} 
+in order to compute the iso-level bilaplacian operator. 
+
+It is a \emph{horizontal} operator ($i.e.$ acting along geopotential surfaces) in the $z$-coordinate 
+with or without partial steps, but is simply an iso-level operator in the $s$-coordinate. 
+It is thus used when, in addition to \np{ln\_traldf\_lap} or \np{ln\_traldf\_blp}~=~\textit{true}, 
+we have \np{ln\_traldf\_lev}~=~\textit{true} or \np{ln\_traldf\_hor}~=~\np{ln\_zco}~=~\textit{true}. 
+In both cases, it significantly contributes to diapycnal mixing. 
+It is therefore never recommended, even when using it in the bilaplacian case.
+
+Note that in the partial step $z$-coordinate (\np{ln\_zps}=true), tracers in horizontally 
+adjacent cells are located at different depths in the vicinity of the bottom. 
+In this case, horizontal derivatives in (\ref{Eq_tra_ldf_lap}) at the bottom level 
+require a specific treatment. They are calculated in the \mdl{zpshde} module, 
+described in \S\ref{TRA_zpshde}.
+
+
+% -------------------------------------------------------------------------------------------------------------
+%         Rotated laplacian operator
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Standard and triad rotated (bi-)laplacian operator (\mdl{traldf\_iso}, \mdl{traldf\_triad})]
+		       	{Standard and triad (bi-)laplacian operator (\mdl{traldf\_iso}, \mdl{traldf\_triad}))}
+\label{TRA_ldf_iso_triad}
+
+%&&    Standard rotated (bi-)laplacian operator
+%&& ----------------------------------------------
+\subsubsection   [Standard rotated (bi-)laplacian operator (\mdl{traldf\_iso})]
+		        	  {Standard rotated (bi-)laplacian operator (\mdl{traldf\_iso})}
+\label{TRA_ldf_iso}
+The general form of the second order lateral tracer subgrid scale physics 
+(\ref{Eq_PE_zdf}) takes the following semi-discrete space form in $z$- and $s$-coordinates:
+\begin{equation} \label{Eq_tra_ldf_iso}
+\begin{split}
+ D_T^{lT} = \frac{1}{b_t}   & \left\{   \,\;\delta_i \left[   A_u^{lT}  \left( 
+	  \frac{e_{2u}\,e_{3u}}{e_{1u}} \,\delta_{i+1/2}[T]
+	- e_{2u}\;r_{1u} \,\overline{\overline{ \delta_{k+1/2}[T] }}^{\,i+1/2,k}
+                                                     \right)   \right]   \right.    \\ 
+&             +\delta_j \left[ A_v^{lT} \left( 
+          \frac{e_{1v}\,e_{3v}}{e_{2v}}  \,\delta_{j+1/2} [T] 
+        - e_{1v}\,r_{2v} \,\overline{\overline{ \delta_{k+1/2} [T] }}^{\,j+1/2,k} 
+                                                    \right)   \right]                 \\ 
+& +\delta_k \left[ A_w^{lT} \left( 
+       -\;e_{2w}\,r_{1w} \,\overline{\overline{ \delta_{i+1/2} [T] }}^{\,i,k+1/2}
+                                                    \right.   \right.                 \\ 
+& \qquad \qquad \quad 
+        - e_{1w}\,r_{2w} \,\overline{\overline{ \delta_{j+1/2} [T] }}^{\,j,k+1/2}     \\
+& \left. {\left. {   \qquad \qquad \ \ \ \left. {
+        +\;\frac{e_{1w}\,e_{2w}}{e_{3w}} \,\left( r_{1w}^2 + r_{2w}^2 \right)
+           \,\delta_{k+1/2} [T] } \right) } \right] \quad } \right\} 
+ \end{split}
+ \end{equation}
+where $b_t$=$e_{1t}\,e_{2t}\,e_{3t}$  is the volume of $T$-cells, 
+$r_1$ and $r_2$ are the slopes between the surface of computation 
+($z$- or $s$-surfaces) and the surface along which the diffusion operator 
+acts ($i.e.$ horizontal or iso-neutral surfaces).  It is thus used when, 
+in addition to \np{ln\_traldf\_lap}= true, we have \np{ln\_traldf\_iso}=true, 
+or both \np{ln\_traldf\_hor}=true and \np{ln\_zco}=true. The way these 
+slopes are evaluated is given in \S\ref{LDF_slp}. At the surface, bottom 
+and lateral boundaries, the turbulent fluxes of heat and salt are set to zero 
+using the mask technique (see \S\ref{LBC_coast}). 
+
+The operator in \eqref{Eq_tra_ldf_iso} involves both lateral and vertical 
+derivatives. For numerical stability, the vertical second derivative must 
+be solved using the same implicit time scheme as that used in the vertical 
+physics (see \S\ref{TRA_zdf}). For computer efficiency reasons, this term 
+is not computed in the \mdl{traldf\_iso} module, but in the \mdl{trazdf} module 
+where, if iso-neutral mixing is used, the vertical mixing coefficient is simply 
+increased by $\frac{e_{1w}\,e_{2w} }{e_{3w} }\ \left( {r_{1w} ^2+r_{2w} ^2} \right)$. 
+
+This formulation conserves the tracer but does not ensure the decrease 
+of the tracer variance. Nevertheless the treatment performed on the slopes 
+(see \S\ref{LDF}) allows the model to run safely without any additional 
+background horizontal diffusion \citep{Guilyardi_al_CD01}. 
+
+Note that in the partial step $z$-coordinate (\np{ln\_zps}=true), the horizontal derivatives 
+at the bottom level in \eqref{Eq_tra_ldf_iso} require a specific treatment. 
+They are calculated in module zpshde, described in \S\ref{TRA_zpshde}.
+
+%&&     Triad rotated (bi-)laplacian operator
+%&&  -------------------------------------------
+\subsubsection   [Triad rotated (bi-)laplacian operator (\np{ln\_traldf\_triad})]
+		        	  {Triad rotated (bi-)laplacian operator (\np{ln\_traldf\_triad})}
+\label{TRA_ldf_triad}
+
+If the Griffies triad scheme is employed (\np{ln\_traldf\_triad}=true ; see App.\ref{sec:triad}) 
+
+An alternative scheme developed by \cite{Griffies_al_JPO98} which ensures tracer variance decreases 
+is also available in \NEMO (\np{ln\_traldf\_grif}=true). A complete description of 
+the algorithm is given in App.\ref{sec:triad}.
+
+The lateral fourth order bilaplacian operator on tracers is obtained by 
+applying (\ref{Eq_tra_ldf_lap}) twice. The operator requires an additional assumption 
+on boundary conditions: both first and third derivative terms normal to the 
+coast are set to zero.
+
+The lateral fourth order operator formulation on tracers is obtained by 
+applying (\ref{Eq_tra_ldf_iso}) twice. It requires an additional assumption 
+on boundary conditions: first and third derivative terms normal to the 
+coast, normal to the bottom and normal to the surface are set to zero. 
+
+%&&    Option for the rotated operators
+%&& ----------------------------------------------
+\subsubsection   [Option for the rotated operators]
+		        	  {Option for the rotated operators}
+\label{TRA_ldf_options}
+
+\np{ln\_traldf\_msc} = Method of Stabilizing Correction (both operators)
+
+\np{rn\_slpmax} = slope limit (both operators)
+
+\np{ln\_triad\_iso} = pure horizontal mixing in ML (triad only)
+
+\np{rn\_sw\_triad} =1 switching triad ; =0 all 4 triads used (triad only) 
+
+\np{ln\_botmix\_triad} = lateral mixing on bottom (triad only)
+
+% ================================================================
+% Tracer Vertical Diffusion
+% ================================================================
+\section  [Tracer Vertical Diffusion (\textit{trazdf})]
+		{Tracer Vertical Diffusion (\mdl{trazdf})}
+\label{TRA_zdf}
+%--------------------------------------------namzdf---------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the \ngn{namzdf} namelist variables.
+The formulation of the vertical subgrid scale tracer physics is the same 
+for all the vertical coordinates, and is based on a laplacian operator. 
+The vertical diffusion operator given by (\ref{Eq_PE_zdf}) takes the 
+following semi-discrete space form:
+\begin{equation} \label{Eq_tra_zdf}
+\begin{split}
+D^{vT}_T &= \frac{1}{e_{3t}} \; \delta_k \left[ \;\frac{A^{vT}_w}{e_{3w}}  \delta_{k+1/2}[T] \;\right] 
+\\
+D^{vS}_T &= \frac{1}{e_{3t}} \; \delta_k \left[ \;\frac{A^{vS}_w}{e_{3w}}  \delta_{k+1/2}[S] \;\right] 
+\end{split}
+\end{equation}
+where $A_w^{vT}$ and $A_w^{vS}$ are the vertical eddy diffusivity 
+coefficients on temperature and salinity, respectively. Generally, 
+$A_w^{vT}=A_w^{vS}$ except when double diffusive mixing is 
+parameterised ($i.e.$ \key{zdfddm} is defined). The way these coefficients 
+are evaluated is given in \S\ref{ZDF} (ZDF). Furthermore, when 
+iso-neutral mixing is used, both mixing coefficients are increased 
+by $\frac{e_{1w}\,e_{2w} }{e_{3w} }\ \left( {r_{1w} ^2+r_{2w} ^2} \right)$ 
+to account for the vertical second derivative of \eqref{Eq_tra_ldf_iso}. 
+
+At the surface and bottom boundaries, the turbulent fluxes of 
+heat and salt must be specified. At the surface they are prescribed 
+from the surface forcing and added in a dedicated routine (see \S\ref{TRA_sbc}), 
+whilst at the bottom they are set to zero for heat and salt unless 
+a geothermal flux forcing is prescribed as a bottom boundary 
+condition (see \S\ref{TRA_bbc}). 
+
+The large eddy coefficient found in the mixed layer together with high 
+vertical resolution implies that in the case of explicit time stepping 
+(\np{ln\_zdfexp}=true) there would be too restrictive a constraint on 
+the time step. Therefore, the default implicit time stepping is preferred 
+for the vertical diffusion since it overcomes the stability constraint. 
+A forward time differencing scheme (\np{ln\_zdfexp}=true) using a time 
+splitting technique (\np{nn\_zdfexp} $> 1$) is provided as an alternative. 
+Namelist variables \np{ln\_zdfexp} and \np{nn\_zdfexp} apply to both 
+tracers and dynamics. 
+
+% ================================================================
+% External Forcing
+% ================================================================
+\section{External Forcing}
+\label{TRA_sbc_qsr_bbc}
+
+% -------------------------------------------------------------------------------------------------------------
+%        surface boundary condition
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Surface boundary condition (\textit{trasbc})]
+			{Surface boundary condition (\mdl{trasbc})}
+\label{TRA_sbc}
+
+The surface boundary condition for tracers is implemented in a separate 
+module (\mdl{trasbc}) instead of entering as a boundary condition on the vertical 
+diffusion operator (as in the case of momentum). This has been found to 
+enhance readability of the code. The two formulations are completely 
+equivalent; the forcing terms in trasbc are the surface fluxes divided by 
+the thickness of the top model layer. 
+
+Due to interactions and mass exchange of water ($F_{mass}$) with other Earth system components 
+($i.e.$ atmosphere, sea-ice, land), the change in the heat and salt content of the surface layer 
+of the ocean is due both to the heat and salt fluxes crossing the sea surface (not linked with $F_{mass}$) 
+and to the heat and salt content of the mass exchange. They are both included directly in $Q_{ns}$, 
+the surface heat flux, and $F_{salt}$, the surface salt flux (see \S\ref{SBC} for further details).
+By doing this, the forcing formulation is the same for any tracer (including temperature and salinity).
+
+The surface module (\mdl{sbcmod}, see \S\ref{SBC}) provides the following 
+forcing fields (used on tracers):
+
+$\bullet$ $Q_{ns}$, the non-solar part of the net surface heat flux that crosses the sea surface 
+(i.e. the difference between the total surface heat flux and the fraction of the short wave flux that 
+penetrates into the water column, see \S\ref{TRA_qsr}) plus the heat content associated with 
+of the mass exchange with the atmosphere and lands.
+
+$\bullet$ $\textit{sfx}$, the salt flux resulting from ice-ocean mass exchange (freezing, melting, ridging...)
+
+$\bullet$ \textit{emp}, the mass flux exchanged with the atmosphere (evaporation minus precipitation) 
+ and possibly with the sea-ice and ice-shelves.
+
+$\bullet$ \textit{rnf}, the mass flux associated with runoff 
+(see \S\ref{SBC_rnf} for further detail of how it acts on temperature and salinity tendencies)
+
+$\bullet$ \textit{fwfisf}, the mass flux associated with ice shelf melt, 
+(see \S\ref{SBC_isf} for further details on how the ice shelf melt is computed and applied).
+
+The surface boundary condition on temperature and salinity is applied as follows:
+\begin{equation} \label{Eq_tra_sbc}
+\begin{aligned}
+ &F^T = \frac{ 1 }{\rho _o \;C_p \,\left. e_{3t} \right|_{k=1} }  &\overline{ Q_{ns}       }^t  & \\ 
+& F^S =\frac{ 1 }{\rho _o  \,      \left. e_{3t} \right|_{k=1} }  &\overline{ \textit{sfx} }^t   & \\   
+ \end{aligned}
+\end{equation} 
+where $\overline{x }^t$ means that $x$ is averaged over two consecutive time steps 
+($t-\rdt/2$ and $t+\rdt/2$). Such time averaging prevents the 
+divergence of odd and even time step (see \S\ref{STP}).
+
+In the linear free surface case (\np{ln\_linssh}~=~\textit{true}), 
+an additional term has to be added on both temperature and salinity. 
+On temperature, this term remove the heat content associated with mass exchange
+that has been added to $Q_{ns}$. On salinity, this term mimics the concentration/dilution effect that
+would have resulted from a change in the volume of the first level.
+The resulting surface boundary condition is applied as follows:
+\begin{equation} \label{Eq_tra_sbc_lin}
+\begin{aligned}
+ &F^T = \frac{ 1 }{\rho _o \;C_p \,\left. e_{3t} \right|_{k=1} }   
+           &\overline{ \left( Q_{ns} - \textit{emp}\;C_p\,\left. T \right|_{k=1} \right) }^t  & \\ 
+%
+& F^S =\frac{ 1 }{\rho _o \,\left. e_{3t} \right|_{k=1} } 
+           &\overline{ \left( \;\textit{sfx} - \textit{emp} \;\left. S \right|_{k=1}  \right) }^t   & \\   
+ \end{aligned}
+\end{equation} 
+Note that an exact conservation of heat and salt content is only achieved with non-linear free surface. 
+In the linear free surface case, there is a small imbalance. The imbalance is larger 
+than the imbalance associated with the Asselin time filter \citep{Leclair_Madec_OM09}. 
+This is the reason why the modified filter is not applied in the linear free surface case (see \S\ref{STP}).
+
+% -------------------------------------------------------------------------------------------------------------
+%        Solar Radiation Penetration 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Solar Radiation Penetration (\textit{traqsr})]
+			{Solar Radiation Penetration (\mdl{traqsr})}
+\label{TRA_qsr}
+%--------------------------------------------namqsr--------------------------------------------------------
+\namdisplay{namtra_qsr}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namtra\_qsr} namelist variables.
+When the penetrative solar radiation option is used (\np{ln\_flxqsr}=true), 
+the solar radiation penetrates the top few tens of meters of the ocean. If it is not used 
+(\np{ln\_flxqsr}=false) all the heat flux is absorbed in the first ocean level. 
+Thus, in the former case a term is added to the time evolution equation of 
+temperature \eqref{Eq_PE_tra_T} and the surface boundary condition is 
+modified to take into account only the non-penetrative part of the surface 
+heat flux:
+\begin{equation} \label{Eq_PE_qsr}
+\begin{split}
+\frac{\partial T}{\partial t} &= {\ldots} + \frac{1}{\rho_o\, C_p \,e_3} \; \frac{\partial I}{\partial k}	\\
+Q_{ns} &= Q_\text{Total} - Q_{sr}
+\end{split}
+\end{equation}
+where $Q_{sr}$ is the penetrative part of the surface heat flux ($i.e.$ the shortwave radiation) 
+and $I$ is the downward irradiance ($\left. I \right|_{z=\eta}=Q_{sr}$). 
+The additional term in \eqref{Eq_PE_qsr} is discretized as follows:
+\begin{equation} \label{Eq_tra_qsr}
+\frac{1}{\rho_o\, C_p \,e_3} \; \frac{\partial I}{\partial k} \equiv \frac{1}{\rho_o\, C_p\, e_{3t}} \delta_k \left[ I_w \right]
+\end{equation}
+
+The shortwave radiation,  $Q_{sr}$, consists of energy distributed across a wide spectral range. 
+The ocean is strongly absorbing for wavelengths longer than 700~nm and these 
+wavelengths contribute to heating the upper few tens of centimetres. The fraction of $Q_{sr}$ 
+that resides in these almost non-penetrative wavebands, $R$, is $\sim 58\%$ (specified 
+through namelist parameter \np{rn\_abs}).  It is assumed to penetrate the ocean 
+with a decreasing exponential profile, with an e-folding depth scale, $\xi_0$, 
+of a few tens of centimetres (typically $\xi_0=0.35~m$ set as \np{rn\_si0} in the namtra\_qsr namelist).
+For shorter wavelengths (400-700~nm), the ocean is more transparent, and solar energy 
+propagates to larger depths where it contributes to 
+local heating. 
+The way this second part of the solar energy penetrates into the ocean depends on 
+which formulation is chosen. In the simple 2-waveband light penetration scheme  (\np{ln\_qsr\_2bd}=true) 
+a chlorophyll-independent monochromatic formulation is chosen for the shorter wavelengths, 
+leading to the following expression  \citep{Paulson1977}:
+\begin{equation} \label{Eq_traqsr_iradiance}
+I(z) = Q_{sr} \left[Re^{-z / \xi_0} + \left( 1-R\right) e^{-z / \xi_1} \right]
+\end{equation}
+where $\xi_1$ is the second extinction length scale associated with the shorter wavelengths.  
+It is usually chosen to be 23~m by setting the \np{rn\_si0} namelist parameter. 
+The set of default values ($\xi_0$, $\xi_1$, $R$) corresponds to a Type I water in 
+Jerlov's (1968) classification (oligotrophic waters).
+
+Such assumptions have been shown to provide a very crude and simplistic 
+representation of observed light penetration profiles (\cite{Morel_JGR88}, see also 
+Fig.\ref{Fig_traqsr_irradiance}). Light absorption in the ocean depends on 
+particle concentration and is spectrally selective. \cite{Morel_JGR88} has shown 
+that an accurate representation of light penetration can be provided by a 61 waveband 
+formulation. Unfortunately, such a model is very computationally expensive. 
+Thus, \cite{Lengaigne_al_CD07} have constructed a simplified version of this 
+formulation in which visible light is split into three wavebands: blue (400-500 nm), 
+green (500-600 nm) and red (600-700nm). For each wave-band, the chlorophyll-dependent 
+attenuation coefficient is fitted to the coefficients computed from the full spectral model 
+of \cite{Morel_JGR88} (as modified by \cite{Morel_Maritorena_JGR01}), assuming 
+the same power-law relationship. As shown in Fig.\ref{Fig_traqsr_irradiance}, 
+this formulation, called RGB (Red-Green-Blue), reproduces quite closely 
+the light penetration profiles predicted by the full spectal model, but with much greater 
+computational efficiency. The 2-bands formulation does not reproduce the full model very well. 
+
+The RGB formulation is used when \np{ln\_qsr\_rgb}=true. The RGB attenuation coefficients
+($i.e.$ the inverses of the extinction length scales) are tabulated over 61 nonuniform 
+chlorophyll classes ranging from 0.01 to 10 g.Chl/L (see the routine \rou{trc\_oce\_rgb} 
+in \mdl{trc\_oce} module). Four types of chlorophyll can be chosen in the RGB formulation:
+\begin{description} 
+\item[\np{nn\_chdta}=0] 
+a constant 0.05 g.Chl/L value everywhere ; 
+\item[\np{nn\_chdta}=1]  
+an observed time varying chlorophyll deduced from satellite surface ocean color measurement 
+spread uniformly in the vertical direction ; 
+\item[\np{nn\_chdta}=2]  
+same as previous case except that a vertical profile of chlorophyl is used. 
+Following \cite{Morel_Berthon_LO89}, the profile is computed from the local surface chlorophyll value ;
+\item[\np{ln\_qsr\_bio}=true]  
+simulated time varying chlorophyll by TOP biogeochemical model. 
+In this case, the RGB formulation is used to calculate both the phytoplankton 
+light limitation in PISCES or LOBSTER and the oceanic heating rate. 
+\end{description} 
+The trend in \eqref{Eq_tra_qsr} associated with the penetration of the solar radiation 
+is added to the temperature trend, and the surface heat flux is modified in routine \mdl{traqsr}. 
+
+When the $z$-coordinate is preferred to the $s$-coordinate, the depth of $w-$levels does 
+not significantly vary with location. The level at which the light has been totally 
+absorbed ($i.e.$ it is less than the computer precision) is computed once, 
+and the trend associated with the penetration of the solar radiation is only added down to that level. 
+Finally, note that when the ocean is shallow ($<$ 200~m), part of the 
+solar radiation can reach the ocean floor. In this case, we have 
+chosen that all remaining radiation is absorbed in the last ocean 
+level ($i.e.$ $I$ is masked). 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_TRA_Irradiance}
+\caption{ 	 \label{Fig_traqsr_irradiance}
+Penetration profile of the downward solar irradiance calculated by four models. 
+Two waveband chlorophyll-independent formulation (blue), a chlorophyll-dependent 
+monochromatic formulation (green), 4 waveband RGB formulation (red), 
+61 waveband Morel (1988) formulation (black) for a chlorophyll concentration of 
+(a) Chl=0.05 mg/m$^3$ and (b) Chl=0.5 mg/m$^3$. From \citet{Lengaigne_al_CD07}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        Bottom Boundary Condition
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Bottom Boundary Condition (\textit{trabbc})]
+			{Bottom Boundary Condition (\mdl{trabbc})}
+\label{TRA_bbc}
+%--------------------------------------------nambbc--------------------------------------------------------
+\namdisplay{nambbc}
+%--------------------------------------------------------------------------------------------------------------
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=1.0\textwidth]{Fig_TRA_geoth}
+\caption{ 	\label{Fig_geothermal}
+Geothermal Heat flux (in $mW.m^{-2}$) used by \cite{Emile-Geay_Madec_OS09}.
+It is inferred from the age of the sea floor and the formulae of \citet{Stein_Stein_Nat92}.}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Usually it is assumed that there is no exchange of heat or salt through 
+the ocean bottom, $i.e.$ a no flux boundary condition is applied on active 
+tracers at the bottom. This is the default option in \NEMO, and it is 
+implemented using the masking technique. However, there is a 
+non-zero heat flux across the seafloor that is associated with solid 
+earth cooling. This flux is weak compared to surface fluxes (a mean 
+global value of $\sim0.1\;W/m^2$ \citep{Stein_Stein_Nat92}), but it warms 
+systematically the ocean and acts on the densest water masses. 
+Taking this flux into account in a global ocean model increases
+the deepest overturning cell ($i.e.$ the one associated with the Antarctic 
+Bottom Water) by a few Sverdrups  \citep{Emile-Geay_Madec_OS09}. 
+
+Options are defined through the  \ngn{namtra\_bbc} namelist variables.
+The presence of geothermal heating is controlled by setting the namelist 
+parameter  \np{ln\_trabbc} to true. Then, when \np{nn\_geoflx} is set to 1, 
+a constant geothermal heating is introduced whose value is given by the 
+\np{nn\_geoflx\_cst}, which is also a namelist parameter. 
+When  \np{nn\_geoflx} is set to 2, a spatially varying geothermal heat flux is 
+introduced which is provided in the \ifile{geothermal\_heating} NetCDF file 
+(Fig.\ref{Fig_geothermal}) \citep{Emile-Geay_Madec_OS09}.
+
+% ================================================================
+% Bottom Boundary Layer
+% ================================================================
+\section  [Bottom Boundary Layer (\mdl{trabbl} - \key{trabbl})]
+		{Bottom Boundary Layer (\mdl{trabbl} - \key{trabbl})}
+\label{TRA_bbl}
+%--------------------------------------------nambbl---------------------------------------------------------
+\namdisplay{nambbl}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{nambbl} namelist variables.
+In a $z$-coordinate configuration, the bottom topography is represented by a 
+series of discrete steps. This is not adequate to represent gravity driven 
+downslope flows. Such flows arise either downstream of sills such as the Strait of 
+Gibraltar or Denmark Strait, where dense water formed in marginal seas flows 
+into a basin filled with less dense water, or along the continental slope when dense 
+water masses are formed on a continental shelf. The amount of entrainment 
+that occurs in these gravity plumes is critical in determining the density 
+and volume flux of the densest waters of the ocean, such as Antarctic Bottom Water, 
+or North Atlantic Deep Water. $z$-coordinate models tend to overestimate the 
+entrainment, because the gravity flow is mixed vertically by convection 
+as it goes ''downstairs'' following the step topography, sometimes over a thickness 
+much larger than the thickness of the observed gravity plume. A similar problem 
+occurs in the $s$-coordinate when the thickness of the bottom level varies rapidly 
+downstream of a sill \citep{Willebrand_al_PO01}, and the thickness 
+of the plume is not resolved. 
+
+The idea of the bottom boundary layer (BBL) parameterisation, first introduced by 
+\citet{Beckmann_Doscher1997}, is to allow a direct communication between 
+two adjacent bottom cells at different levels, whenever the densest water is 
+located above the less dense water. The communication can be by a diffusive flux
+(diffusive BBL), an advective flux (advective BBL), or both. In the current 
+implementation of the BBL, only the tracers are modified, not the velocities. 
+Furthermore, it only connects ocean bottom cells, and therefore does not include 
+all the improvements introduced by \citet{Campin_Goosse_Tel99}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Diffusive BBL
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Diffusive Bottom Boundary layer (\np{nn\_bbl\_ldf}=1)}
+\label{TRA_bbl_diff}
+
+When applying sigma-diffusion (\key{trabbl} defined and \np{nn\_bbl\_ldf} set to 1), 
+the diffusive flux between two adjacent cells at the ocean floor is given by 
+\begin{equation} \label{Eq_tra_bbl_diff}
+{\rm {\bf F}}_\sigma=A_l^\sigma \; \nabla_\sigma T
+\end{equation} 
+with $\nabla_\sigma$ the lateral gradient operator taken between bottom cells, 
+and  $A_l^\sigma$ the lateral diffusivity in the BBL. Following \citet{Beckmann_Doscher1997}, 
+the latter is prescribed with a spatial dependence, $i.e.$ in the conditional form
+\begin{equation} \label{Eq_tra_bbl_coef}
+A_l^\sigma (i,j,t)=\left\{ {\begin{array}{l}
+ A_{bbl}  \quad \quad   \mbox{if}  \quad   \nabla_\sigma \rho  \cdot  \nabla H<0 \\ 
+ \\
+ 0\quad \quad \;\,\mbox{otherwise} \\ 
+ \end{array}} \right.
+\end{equation} 
+where $A_{bbl}$ is the BBL diffusivity coefficient, given by the namelist 
+parameter \np{rn\_ahtbbl} and usually set to a value much larger 
+than the one used for lateral mixing in the open ocean. The constraint in \eqref{Eq_tra_bbl_coef} 
+implies that sigma-like diffusion only occurs when the density above the sea floor, at the top of 
+the slope, is larger than in the deeper ocean (see green arrow in Fig.\ref{Fig_bbl}). 
+In practice, this constraint is applied separately in the two horizontal directions, 
+and the density gradient in \eqref{Eq_tra_bbl_coef} is evaluated with the log gradient formulation: 
+\begin{equation} \label{Eq_tra_bbl_Drho}
+	\nabla_\sigma \rho / \rho = \alpha \,\nabla_\sigma T + \beta   \,\nabla_\sigma S
+\end{equation} 
+where $\rho$, $\alpha$ and $\beta$ are functions of $\overline{T}^\sigma$, 
+$\overline{S}^\sigma$ and $\overline{H}^\sigma$, the along bottom mean temperature, 
+salinity and depth, respectively.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Advective BBL
+% -------------------------------------------------------------------------------------------------------------
+\subsection   {Advective Bottom Boundary Layer  (\np{nn\_bbl\_adv}= 1 or 2)}
+\label{TRA_bbl_adv}
+
+\sgacomment{"downsloping flow" has been replaced by "downslope flow" in the following
+if this is not what is meant then "downwards sloping flow" is also a possibility"}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	\begin{center}
+\includegraphics[width=0.7\textwidth]{Fig_BBL_adv}
+\caption{ 	\label{Fig_bbl}  
+Advective/diffusive Bottom Boundary Layer. The BBL parameterisation is 
+activated when $\rho^i_{kup}$ is larger than $\rho^{i+1}_{kdnw}$. 
+Red arrows indicate the additional overturning circulation due to the advective BBL. 
+The transport of the downslope flow is defined either as the transport of the bottom 
+ocean cell (black arrow), or as a function of the along slope density gradient. 
+The green arrow indicates the diffusive BBL flux directly connecting $kup$ and $kdwn$
+ocean bottom cells.
+connection}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+%!!      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
+
+%%%gmcomment   :  this section has to be really written
+
+When applying an advective BBL (\np{nn\_bbl\_adv} = 1 or 2), an overturning 
+circulation is added which connects two adjacent bottom grid-points only if dense 
+water overlies less dense water on the slope. The density difference causes dense 
+water to move down the slope. 
+
+\np{nn\_bbl\_adv} = 1 : the downslope velocity is chosen to be the Eulerian
+ocean velocity just above the topographic step (see black arrow in Fig.\ref{Fig_bbl}) 
+\citep{Beckmann_Doscher1997}. It is a \textit{conditional advection}, that is, advection
+is allowed only if dense water overlies less dense water on the slope ($i.e.$ 
+$\nabla_\sigma \rho  \cdot  \nabla H<0$) and if the velocity is directed towards 
+greater depth ($i.e.$ $\vect{U}  \cdot  \nabla H>0$).
+
+\np{nn\_bbl\_adv} = 2 : the downslope velocity is chosen to be proportional to $\Delta \rho$,
+the density difference between the higher cell and lower cell densities \citep{Campin_Goosse_Tel99}.
+The advection is allowed only  if dense water overlies less dense water on the slope ($i.e.$ 
+$\nabla_\sigma \rho  \cdot  \nabla H<0$). For example, the resulting transport of the 
+downslope flow, here in the $i$-direction (Fig.\ref{Fig_bbl}), is simply given by the 
+following expression:
+\begin{equation} \label{Eq_bbl_Utr}
+ u^{tr}_{bbl} = \gamma \, g \frac{\Delta \rho}{\rho_o}  e_{1u} \; min \left( {e_{3u}}_{kup},{e_{3u}}_{kdwn} \right)
+\end{equation}
+where $\gamma$, expressed in seconds, is the coefficient of proportionality 
+provided as \np{rn\_gambbl}, a namelist parameter, and \textit{kup} and \textit{kdwn} 
+are the vertical index of the higher and lower cells, respectively.
+The parameter $\gamma$ should take a different value for each bathymetric 
+step, but for simplicity, and because no direct estimation of this parameter is 
+available, a uniform value has been assumed. The possible values for $\gamma$ 
+range between 1 and $10~s$ \citep{Campin_Goosse_Tel99}.  
+
+Scalar properties are advected by this additional transport $( u^{tr}_{bbl}, v^{tr}_{bbl} )$ 
+using the upwind scheme. Such a diffusive advective scheme has been chosen 
+to mimic the entrainment between the downslope plume and the surrounding 
+water at intermediate depths. The entrainment is replaced by the vertical mixing 
+implicit in the advection scheme. Let us consider as an example the 
+case displayed in Fig.\ref{Fig_bbl} where the density at level $(i,kup)$ is 
+larger than the one at level $(i,kdwn)$. The advective BBL scheme
+modifies the tracer time tendency of the ocean cells near the 
+topographic step by the downslope flow \eqref{Eq_bbl_dw}, 
+the horizontal \eqref{Eq_bbl_hor}  and the upward \eqref{Eq_bbl_up} 
+return flows as follows: 
+\begin{align} 
+\partial_t T^{do}_{kdw} &\equiv \partial_t T^{do}_{kdw}
+                                     +  \frac{u^{tr}_{bbl}}{{b_t}^{do}_{kdw}}  \left( T^{sh}_{kup} - T^{do}_{kdw} \right)  \label{Eq_bbl_dw} \\
+%
+\partial_t T^{sh}_{kup} &\equiv \partial_t T^{sh}_{kup} 
+				   + \frac{u^{tr}_{bbl}}{{b_t}^{sh}_{kup}}   \left( T^{do}_{kup} - T^{sh}_{kup} \right)   \label{Eq_bbl_hor} \\
+%
+\intertext{and for $k =kdw-1,\;..., \; kup$ :} 
+%
+\partial_t T^{do}_{k} &\equiv \partial_t S^{do}_{k}
+				   + \frac{u^{tr}_{bbl}}{{b_t}^{do}_{k}}   \left( T^{do}_{k+1} - T^{sh}_{k} \right)   \label{Eq_bbl_up}
+\end{align}
+where $b_t$ is the $T$-cell volume. 
+
+Note that the BBL transport, $( u^{tr}_{bbl}, v^{tr}_{bbl} )$, is available in 
+the model outputs. It has to be used to compute the effective velocity 
+as well as the effective overturning circulation.
+
+% ================================================================
+% Tracer damping
+% ================================================================
+\section  [Tracer damping (\textit{tradmp})]
+		{Tracer damping (\mdl{tradmp})}
+\label{TRA_dmp}
+%--------------------------------------------namtra_dmp-------------------------------------------------
+\namdisplay{namtra_dmp}
+%--------------------------------------------------------------------------------------------------------------
+
+In some applications it can be useful to add a Newtonian damping term 
+into the temperature and salinity equations:
+\begin{equation} \label{Eq_tra_dmp}
+\begin{split}
+ \frac{\partial T}{\partial t}=\;\cdots \;-\gamma \,\left( {T-T_o } \right)  \\
+ \frac{\partial S}{\partial t}=\;\cdots \;-\gamma \,\left( {S-S_o } \right) 
+ \end{split}
+ \end{equation} 
+where $\gamma$ is the inverse of a time scale, and $T_o$ and $S_o$ 
+are given temperature and salinity fields (usually a climatology). 
+Options are defined through the  \ngn{namtra\_dmp} namelist variables.
+The restoring term is added when the namelist parameter \np{ln\_tradmp} is set to true. 
+It also requires that both \np{ln\_tsd\_init} and \np{ln\_tsd\_tradmp} are set to true
+in \textit{namtsd} namelist as well as \np{sn\_tem} and \np{sn\_sal} structures are 
+correctly set  ($i.e.$ that $T_o$ and $S_o$ are provided in input files and read 
+using \mdl{fldread}, see \S\ref{SBC_fldread}). 
+The restoring coefficient $\gamma$ is a three-dimensional array read in during the \rou{tra\_dmp\_init} routine. The file name is specified by the namelist variable \np{cn\_resto}. The DMP\_TOOLS tool is provided to allow users to generate the netcdf file.
+
+The two main cases in which \eqref{Eq_tra_dmp} is used are \textit{(a)} 
+the specification of the boundary conditions along artificial walls of a 
+limited domain basin and \textit{(b)} the computation of the velocity 
+field associated with a given $T$-$S$ field (for example to build the 
+initial state of a prognostic simulation, or to use the resulting velocity 
+field for a passive tracer study). The first case applies to regional 
+models that have artificial walls instead of open boundaries. 
+In the vicinity of these walls, $\gamma$ takes large values (equivalent to 
+a time scale of a few days) whereas it is zero in the interior of the 
+model domain. The second case corresponds to the use of the robust 
+diagnostic method \citep{Sarmiento1982}. It allows us to find the velocity 
+field consistent with the model dynamics whilst having a $T$, $S$ field 
+close to a given climatological field ($T_o$, $S_o$). 
+
+The robust diagnostic method is very efficient in preventing temperature 
+drift in intermediate waters but it produces artificial sources of heat and salt 
+within the ocean. It also has undesirable effects on the ocean convection. 
+It tends to prevent deep convection and subsequent deep-water formation, 
+by stabilising the water column too much.
+
+The namelist parameter \np{nn\_zdmp} sets whether the damping should be applied in the whole water column or only below the mixed layer (defined either on a density or $S_o$ criterion). It is common to set the damping to zero in the mixed layer as the adjustment time scale is short here \citep{Madec_al_JPO96}.
+
+\subsection[DMP\_TOOLS]{Generating resto.nc using DMP\_TOOLS}
+
+DMP\_TOOLS can be used to generate a netcdf file containing the restoration coefficient $\gamma$. 
+Note that in order to maintain bit comparison with previous NEMO versions DMP\_TOOLS must be compiled 
+and run on the same machine as the NEMO model. A mesh\_mask.nc file for the model configuration is required as an input. 
+This can be generated by carrying out a short model run with the namelist parameter \np{nn\_msh} set to 1. 
+The namelist parameter \np{ln\_tradmp} will also need to be set to .false. for this to work. 
+The \nl{nam\_dmp\_create} namelist in the DMP\_TOOLS directory is used to specify options for the restoration coefficient.
+
+%--------------------------------------------nam_dmp_create-------------------------------------------------
+\namtools{namelist_dmp}
+%-------------------------------------------------------------------------------------------------------
+
+\np{cp\_cfg}, \np{cp\_cpz}, \np{jp\_cfg} and \np{jperio} specify the model configuration being used and should be the same as specified in \nl{namcfg}. The variable \nl{lzoom} is used to specify that the damping is being used as in case \textit{a} above to provide boundary conditions to a zoom configuration. In the case of the arctic or antarctic zoom configurations this includes some specific treatment. Otherwise damping is applied to the 6 grid points along the ocean boundaries. The open boundaries are specified by the variables \np{lzoom\_n}, \np{lzoom\_e}, \np{lzoom\_s}, \np{lzoom\_w} in the \nl{nam\_zoom\_dmp} name list.
+
+The remaining switch namelist variables determine the spatial variation of the restoration coefficient in non-zoom configurations. 
+\np{ln\_full\_field} specifies that newtonian damping should be applied to the whole model domain. 
+\np{ln\_med\_red\_seas} specifies grid specific restoration coefficients in the Mediterranean Sea 
+for the ORCA4, ORCA2 and ORCA05 configurations. 
+If \np{ln\_old\_31\_lev\_code} is set then the depth variation of the coeffients will be specified as 
+a function of the model number. This option is included to allow backwards compatability of the ORCA2 reference 
+configurations with previous model versions. 
+\np{ln\_coast} specifies that the restoration coefficient should be reduced near to coastlines. 
+This option only has an effect if \np{ln\_full\_field} is true. 
+\np{ln\_zero\_top\_layer} specifies that the restoration coefficient should be zero in the surface layer. 
+Finally \np{ln\_custom} specifies that the custom module will be called. 
+This module is contained in the file custom.F90 and can be edited by users. For example damping could be applied in a specific region.
+
+The restoration coefficient can be set to zero in equatorial regions by specifying a positive value of \np{nn\_hdmp}. 
+Equatorward of this latitude the restoration coefficient will be zero with a smooth transition to 
+the full values of a 10\deg latitud band. 
+This is often used because of the short adjustment time scale in the equatorial region 
+\citep{Reverdin1991, Fujio1991, Marti_PhD92}. The time scale associated with the damping depends on the depth as a 
+hyperbolic tangent, with \np{rn\_surf} as surface value, \np{rn\_bot} as bottom value and a transition depth of \np{rn\_dep}.  
+
+% ================================================================
+% Tracer time evolution
+% ================================================================
+\section  [Tracer time evolution (\textit{tranxt})]
+		{Tracer time evolution (\mdl{tranxt})}
+\label{TRA_nxt}
+%--------------------------------------------namdom-----------------------------------------------------
+\namdisplay{namdom}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namdom} namelist variables.
+The general framework for tracer time stepping is a modified leap-frog scheme 
+\citep{Leclair_Madec_OM09}, $i.e.$ a three level centred time scheme associated 
+with a Asselin time filter (cf. \S\ref{STP_mLF}):
+\begin{equation} \label{Eq_tra_nxt}
+\begin{aligned}
+(e_{3t}T)^{t+\rdt} &= (e_{3t}T)_f^{t-\rdt} &+ 2 \, \rdt  \,e_{3t}^t\ \text{RHS}^t &	\\
+\\
+(e_{3t}T)_f^t  \;\ \quad &= (e_{3t}T)^t \;\quad 
+                                    &+\gamma \,\left[ {(e_{3t}T)_f^{t-\rdt} -2(e_{3t}T)^t+(e_{3t}T)^{t+\rdt}} \right] &  \\
+                                 & &- \gamma\,\rdt \, \left[ Q^{t+\rdt/2} -  Q^{t-\rdt/2} \right]  &                      
+\end{aligned}
+\end{equation} 
+where RHS is the right hand side of the temperature equation, 
+the subscript $f$ denotes filtered values, $\gamma$ is the Asselin coefficient,
+and $S$ is the total forcing applied on $T$ ($i.e.$ fluxes plus content in mass exchanges). 
+$\gamma$ is initialized as \np{rn\_atfp} (\textbf{namelist} parameter). 
+Its default value is \np{rn\_atfp}=$10^{-3}$. Note that the forcing correction term in the filter
+is not applied in linear free surface (\jp{lk\_vvl}=false) (see \S\ref{TRA_sbc}.
+Not also that in constant volume case, the time stepping is performed on $T$, 
+not on its content, $e_{3t}T$.
+
+When the vertical mixing is solved implicitly, the update of the \textit{next} tracer 
+fields is done in module \mdl{trazdf}. In this case only the swapping of arrays 
+and the Asselin filtering is done in the \mdl{tranxt} module.
+
+In order to prepare for the computation of the \textit{next} time step, 
+a swap of tracer arrays is performed: $T^{t-\rdt} = T^t$ and $T^t = T_f$. 
+
+% ================================================================
+% Equation of State (eosbn2) 
+% ================================================================
+\section  [Equation of State (\textit{eosbn2}) ]
+		{Equation of State (\mdl{eosbn2}) }
+\label{TRA_eosbn2}
+%--------------------------------------------nameos-----------------------------------------------------
+\namdisplay{nameos}
+%--------------------------------------------------------------------------------------------------------------
+
+% -------------------------------------------------------------------------------------------------------------
+%        Equation of State
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Equation Of Seawater (\np{nn\_eos} = -1, 0, or 1)}
+\label{TRA_eos}
+
+The Equation Of Seawater (EOS) is an empirical nonlinear thermodynamic relationship 
+linking seawater density, $\rho$, to a number of state variables, 
+most typically temperature, salinity and pressure. 
+Because density gradients control the pressure gradient force through the hydrostatic balance, 
+the equation of state provides a fundamental bridge between the distribution of active tracers 
+and the fluid dynamics. Nonlinearities of the EOS are of major importance, in particular 
+influencing the circulation through determination of the static stability below the mixed layer, 
+thus controlling rates of exchange between the atmosphere  and the ocean interior \citep{Roquet_JPO2015}. 
+Therefore an accurate EOS based on either the 1980 equation of state (EOS-80, \cite{UNESCO1983}) 
+or TEOS-10 \citep{TEOS10} standards should be used anytime a simulation of the real 
+ocean circulation is attempted \citep{Roquet_JPO2015}. 
+The use of TEOS-10 is highly recommended because 
+\textit{(i)} it is the new official EOS, 
+\textit{(ii)} it is more accurate, being based on an updated database of laboratory measurements, and 
+\textit{(iii)} it uses Conservative Temperature and Absolute Salinity (instead of potential temperature 
+and practical salinity for EOS-980, both variables being more suitable for use as model variables 
+\citep{TEOS10, Graham_McDougall_JPO13}. 
+EOS-80 is an obsolescent feature of the NEMO system, kept only for backward compatibility.
+For process studies, it is often convenient to use an approximation of the EOS. To that purposed, 
+a simplified EOS (S-EOS) inspired by \citet{Vallis06} is also available.
+
+In the computer code, a density anomaly, $d_a= \rho / \rho_o - 1$, 
+is computed, with $\rho_o$ a reference density. Called \textit{rau0} 
+in the code, $\rho_o$ is set in \mdl{phycst} to a value of $1,026~Kg/m^3$. 
+This is a sensible choice for the reference density used in a Boussinesq ocean 
+climate model, as, with the exception of only a small percentage of the ocean, 
+density in the World Ocean varies by no more than 2$\%$ from that value \citep{Gill1982}.
+
+Options are defined through the  \ngn{nameos} namelist variables, and in particular \np{nn\_eos} 
+which controls the EOS used (=-1 for TEOS10 ; =0 for EOS-80 ; =1 for S-EOS).
+\begin{description}
+
+\item[\np{nn\_eos}$=-1$] the polyTEOS10-bsq equation of seawater \citep{Roquet_OM2015} is used.  
+The accuracy of this approximation is comparable to the TEOS-10 rational function approximation, 
+but it is optimized for a boussinesq fluid and the polynomial expressions have simpler 
+and more computationally efficient expressions for their derived quantities 
+which make them more adapted for use in ocean models. 
+Note that a slightly higher precision polynomial form is now used replacement of the TEOS-10 
+rational function approximation for hydrographic data analysis  \citep{TEOS10}. 
+A key point is that conservative state variables are used: 
+Absolute Salinity (unit: g/kg, notation: $S_A$) and Conservative Temperature (unit: \degC, notation: $\Theta$).
+The pressure in decibars is approximated by the depth in meters. 
+With TEOS10, the specific heat capacity of sea water, $C_p$, is a constant. It is set to 
+$C_p=3991.86795711963~J\,Kg^{-1}\,^{\circ}K^{-1}$, according to \citet{TEOS10}.
+
+Choosing polyTEOS10-bsq implies that the state variables used by the model are 
+$\Theta$ and $S_A$. In particular, the initial state deined by the user have to be given as 
+\textit{Conservative} Temperature and \textit{Absolute} Salinity. 
+In addition, setting \np{ln\_useCT} to \textit{true} convert the Conservative SST to potential SST 
+prior to either computing the air-sea and ice-sea fluxes (forced mode) 
+or sending the SST field to the atmosphere (coupled mode).
+
+\item[\np{nn\_eos}$=0$] the polyEOS80-bsq equation of seawater is used.
+It takes the same polynomial form as the polyTEOS10, but the coefficients have been optimized 
+to accurately fit EOS80 (Roquet, personal comm.). The state variables used in both the EOS80 
+and the ocean model are: 
+the Practical Salinity ((unit: psu, notation: $S_p$)) and Potential Temperature (unit: $^{\circ}C$, notation: $\theta$).
+The pressure in decibars is approximated by the depth in meters.  
+With thsi EOS, the specific heat capacity of sea water, $C_p$, is a function of temperature, 
+salinity and pressure \citep{UNESCO1983}. Nevertheless, a severe assumption is made in order to 
+have a heat content ($C_p T_p$) which is conserved by the model: $C_p$ is set to a constant 
+value, the TEOS10 value. 
+ 
+\item[\np{nn\_eos}$=1$] a simplified EOS (S-EOS) inspired by \citet{Vallis06} is chosen, 
+the coefficients of which has been optimized to fit the behavior of TEOS10 (Roquet, personal comm.) 
+(see also \citet{Roquet_JPO2015}). It provides a simplistic linear representation of both 
+cabbeling and thermobaricity effects which is enough for a proper treatment of the EOS 
+in theoretical studies \citep{Roquet_JPO2015}.
+With such an equation of state there is no longer a distinction between 
+\textit{conservative} and \textit{potential} temperature, as well as between \textit{absolute} 
+and \textit{practical} salinity.
+S-EOS takes the following expression:
+\begin{equation} \label{Eq_tra_S-EOS}
+\begin{split}
+  d_a(T,S,z)  =  ( & - a_0 \; ( 1 + 0.5 \; \lambda_1 \; T_a + \mu_1 \; z ) * T_a  \\
+                                & + b_0 \; ( 1 - 0.5 \; \lambda_2 \; S_a - \mu_2 \; z ) * S_a  \\
+                                & - \nu \; T_a \; S_a \;  ) \; / \; \rho_o                     \\
+  with \ \  T_a = T-10  \; ;  & \;  S_a = S-35  \; ;\;  \rho_o = 1026~Kg/m^3
+\end{split}
+\end{equation} 
+where the computer name of the coefficients as well as their standard value are given in \ref{Tab_SEOS}.
+In fact, when choosing S-EOS, various approximation of EOS can be specified simply by changing 
+the associated coefficients. 
+Setting to zero the two thermobaric coefficients ($\mu_1$, $\mu_2$) remove thermobaric effect from S-EOS.
+setting to zero the three cabbeling coefficients ($\lambda_1$, $\lambda_2$, $\nu$) remove cabbeling effect from S-EOS.
+Keeping non-zero value to $a_0$ and $b_0$ provide a linear EOS function of T and S.
+
+\end{description}
+
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{table}[!tb]
+\begin{center} \begin{tabular}{|p{26pt}|p{72pt}|p{56pt}|p{136pt}|}
+\hline
+coeff.	& computer name   & S-EOS		&  description		                  \\ \hline
+$a_0$       & \np{rn\_a0}     & 1.6550 $10^{-1}$ &  linear thermal expansion coeff. 	\\ \hline
+$b_0$	      & \np{rn\_b0} 	   & 7.6554 $10^{-1}$ &  linear haline  expansion coeff. 	\\ \hline
+$\lambda_1$	& \np{rn\_lambda1}& 5.9520 $10^{-2}$ &  cabbeling coeff. in $T^2$ 	      \\ \hline
+$\lambda_2$	& \np{rn\_lambda2}& 5.4914 $10^{-4}$ &  cabbeling coeff. in $S^2$	 	   \\ \hline
+$\nu$       & \np{rn\_nu}     & 2.4341 $10^{-3}$ &  cabbeling coeff. in $T \, S$ 	   \\ \hline
+$\mu_1$     & \np{rn\_mu1} 	& 1.4970 $10^{-4}$ &  thermobaric coeff. in T    	   \\ \hline
+$\mu_2$     & \np{rn\_mu2} 	& 1.1090 $10^{-5}$ &  thermobaric coeff. in S   	      \\ \hline
+\end{tabular}
+\caption{ \label{Tab_SEOS}
+Standard value of S-EOS coefficients. }
+\end{center}
+\end{table}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Brunt-V\"{a}is\"{a}l\"{a} Frequency
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Brunt-V\"{a}is\"{a}l\"{a} Frequency (\np{nn\_eos} = 0, 1 or 2)}
+\label{TRA_bn2}
+
+An accurate computation of the ocean stability (i.e. of $N$, the brunt-V\"{a}is\"{a}l\"{a}
+ frequency) is of paramount importance as determine the ocean stratification and 
+ is used in several ocean parameterisations (namely TKE, GLS, Richardson number dependent 
+ vertical diffusion, enhanced vertical diffusion, non-penetrative convection, tidal mixing 
+ parameterisation, iso-neutral diffusion). In particular, $N^2$ has to be computed at the local pressure 
+ (pressure in decibar being approximated by the depth in meters). The expression for $N^2$ 
+ is given by: 
+\begin{equation} \label{Eq_tra_bn2}
+N^2 =	\frac{g}{e_{3w}} \left(   \beta \;\delta_{k+1/2}[S] - \alpha \;\delta_{k+1/2}[T]   \right)
+\end{equation} 
+where $(T,S) = (\Theta, S_A)$ for TEOS10, $= (\theta, S_p)$ for TEOS-80, or $=(T,S)$ for S-EOS, 
+and, $\alpha$ and $\beta$ are the thermal and haline expansion coefficients. 
+The coefficients are a polynomial function of temperature, salinity and depth which expression 
+depends on the chosen EOS. They are computed through \textit{eos\_rab}, a \textsc{Fortran} 
+function that can be found in \mdl{eosbn2}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Freezing Point of Seawater
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Freezing Point of Seawater]
+			{Freezing Point of Seawater}
+\label{TRA_fzp}
+
+The freezing point of seawater is a function of salinity and pressure \citep{UNESCO1983}:
+\begin{equation} \label{Eq_tra_eos_fzp}
+   \begin{split}
+T_f (S,p) = \left( -0.0575 + 1.710523 \;10^{-3} \, \sqrt{S} 
+						     -  2.154996 \;10^{-4} \,S  \right) \ S    \\
+               - 7.53\,10^{-3} \ \ p 
+   \end{split}
+\end{equation}
+
+\eqref{Eq_tra_eos_fzp} is only used to compute the potential freezing point of 
+sea water ($i.e.$ referenced to the surface $p=0$), thus the pressure dependent 
+terms in \eqref{Eq_tra_eos_fzp} (last term) have been dropped. The freezing
+point is computed through \textit{eos\_fzp}, a \textsc{Fortran} function that can be found 
+in \mdl{eosbn2}.  
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Potential Energy     
+% -------------------------------------------------------------------------------------------------------------
+%\subsection{Potential Energy anomalies}
+%\label{TRA_bn2}
+
+%    =====>>>>> TO BE written
+%
+
+
+% ================================================================
+% Horizontal Derivative in zps-coordinate 
+% ================================================================
+\section  [Horizontal Derivative in \textit{zps}-coordinate (\textit{zpshde})]
+		{Horizontal Derivative in \textit{zps}-coordinate (\mdl{zpshde})}
+\label{TRA_zpshde}
+
+\gmcomment{STEVEN: to be consistent with earlier discussion of differencing and averaging operators, 
+                   I've changed "derivative" to "difference" and "mean" to "average"}
+
+With partial cells (\np{ln\_zps}=true) at bottom and top (\np{ln\_isfcav}=true), in general, 
+tracers in horizontally adjacent cells live at different depths. 
+Horizontal gradients of tracers are needed for horizontal diffusion (\mdl{traldf} module) 
+and the hydrostatic pressure gradient calculations (\mdl{dynhpg} module). 
+The partial cell properties at the top (\np{ln\_isfcav}=true) are computed in the same way as for the bottom. 
+So, only the bottom interpolation is explained below.
+
+Before taking horizontal gradients between the tracers next to the bottom, a linear 
+interpolation in the vertical is used to approximate the deeper tracer as if it actually 
+lived at the depth of the shallower tracer point (Fig.~\ref{Fig_Partial_step_scheme}). 
+For example, for temperature in the $i$-direction the needed interpolated 
+temperature, $\widetilde{T}$, is:
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!p] 	 \begin{center}
+\includegraphics[width=0.9\textwidth]{Partial_step_scheme}
+\caption{ 	\label{Fig_Partial_step_scheme} 
+Discretisation of the horizontal difference and average of tracers in the $z$-partial 
+step coordinate (\np{ln\_zps}=true) in the case $( e3w_k^{i+1} - e3w_k^i  )>0$. 
+A linear interpolation is used to estimate $\widetilde{T}_k^{i+1}$, the tracer value 
+at the depth of the shallower tracer point of the two adjacent bottom $T$-points. 
+The horizontal difference is then given by: $\delta _{i+1/2} T_k=  \widetilde{T}_k^{\,i+1} -T_k^{\,i}$ 
+and the average by: $\overline{T}_k^{\,i+1/2}= ( \widetilde{T}_k^{\,i+1/2} - T_k^{\,i} ) / 2$.  }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{equation*}
+\widetilde{T}= \left\{  \begin{aligned}  
+&T^{\,i+1}      -\frac{ \left( e_{3w}^{i+1} -e_{3w}^i \right)}{ e_{3w}^{i+1} }\;\delta _k T^{i+1}	
+ 								&& \quad\text{if  $\ e_{3w}^{i+1} \geq e_{3w}^i$   } 	\\
+										\\
+&T^{\,i} \ \ \ \,+\frac{ \left( e_{3w}^{i+1} -e_{3w}^i \right) }{e_{3w}^i       }\;\delta _k T^{i+1}
+			 					&& \quad\text{if  $\ e_{3w}^{i+1}    <   e_{3w}^i$   } 
+            \end{aligned}   \right.
+\end{equation*}
+and the resulting forms for the horizontal difference and the horizontal average 
+value of $T$ at a $U$-point are: 
+\begin{equation} \label{Eq_zps_hde}
+\begin{aligned}
+ \delta _{i+1/2} T= 	\begin{cases}
+\ \ \ \widetilde {T}\quad\ -T^i	 	& \ \ \quad\quad\text{if  $\ e_{3w}^{i+1} \geq e_{3w}^i$ } \\
+										\\
+\ \ \ T^{\,i+1}-\widetilde{T}		& \ \ \quad\quad\text{if  $\ e_{3w}^{i+1}    <   e_{3w}^i$   } 
+            		\end{cases}     \\
+\\
+\overline {T}^{\,i+1/2} \ = 	\begin{cases}
+( \widetilde {T}\ \ \;\,-T^{\,i})	 / 2	& \;\ \ \quad\text{if  $\ e_{3w}^{i+1} \geq e_{3w}^i$ } \\
+										\\
+( T^{\,i+1}-\widetilde{T} ) / 2		& \;\ \ \quad\text{if  $\ e_{3w}^{i+1}    <   e_{3w}^i$   } 
+            \end{cases}
+\end{aligned}
+\end{equation}
+
+The computation of horizontal derivative of tracers as well as of density is 
+performed once for all at each time step in \mdl{zpshde} module and stored 
+in shared arrays to be used when needed. It has to be emphasized that the 
+procedure used to compute the interpolated density, $\widetilde{\rho}$, is not 
+the same as that used for $T$ and $S$. Instead of forming a linear approximation 
+of density, we compute $\widetilde{\rho }$ from the interpolated values of $T$ 
+and $S$, and the pressure at a $u$-point (in the equation of state pressure is 
+approximated by depth, see \S\ref{TRA_eos} ) : 
+\begin{equation} \label{Eq_zps_hde_rho}
+\widetilde{\rho } = \rho ( {\widetilde{T},\widetilde {S},z_u }) 
+\quad \text{where }\  z_u = \min \left( {z_T^{i+1} ,z_T^i } \right)
+\end{equation} 
+
+This is a much better approximation as the variation of $\rho$ with depth (and 
+thus pressure) is highly non-linear with a true equation of state and thus is badly 
+approximated with a linear interpolation. This approximation is used to compute 
+both the horizontal pressure gradient (\S\ref{DYN_hpg}) and the slopes of neutral 
+surfaces (\S\ref{LDF_slp})
+
+Note that in almost all the advection schemes presented in this Chapter, both 
+averaging and differencing operators appear. Yet \eqref{Eq_zps_hde} has not 
+been used in these schemes: in contrast to diffusion and pressure gradient 
+computations, no correction for partial steps is applied for advection. The main 
+motivation is to preserve the domain averaged mean variance of the advected 
+field when using the $2^{nd}$ order centred scheme. Sensitivity of the advection 
+schemes to the way horizontal averages are performed in the vicinity of partial 
+cells should be further investigated in the near future.
+%%%
+\gmcomment{gm :   this last remark has to be done}
+%%%
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_ZDF.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_ZDF.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_ZDF.tex	(revision 8732)
@@ -0,0 +1,1359 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+% ================================================================
+% Chapter  Vertical Ocean Physics (ZDF)
+% ================================================================
+\chapter{Vertical Ocean Physics (ZDF)}
+\label{ZDF}
+\minitoc
+
+%gm% Add here a small introduction to ZDF and naming of the different physics (similar to what have been written for TRA and DYN.
+
+
+\newpage
+$\ $\newline    % force a new ligne
+
+
+% ================================================================
+% Vertical Mixing
+% ================================================================
+\section{Vertical Mixing}
+\label{ZDF_zdf}
+
+The discrete form of the ocean subgrid scale physics has been presented in 
+\S\ref{TRA_zdf} and \S\ref{DYN_zdf}. At the surface and bottom boundaries, 
+the turbulent fluxes of momentum, heat and salt have to be defined. At the 
+surface they are prescribed from the surface forcing (see Chap.~\ref{SBC}), 
+while at the bottom they are set to zero for heat and salt, unless a geothermal 
+flux forcing is prescribed as a bottom boundary condition ($i.e.$ \key{trabbl} 
+defined, see \S\ref{TRA_bbc}), and specified through a bottom friction 
+parameterisation for momentum (see \S\ref{ZDF_bfr}).
+
+In this section we briefly discuss the various choices offered to compute 
+the vertical eddy viscosity and diffusivity coefficients, $A_u^{vm}$ , 
+$A_v^{vm}$ and $A^{vT}$ ($A^{vS}$), defined at $uw$-, $vw$- and $w$- 
+points, respectively (see \S\ref{TRA_zdf} and \S\ref{DYN_zdf}). These 
+coefficients can be assumed to be either constant, or a function of the local 
+Richardson number, or computed from a turbulent closure model (either 
+TKE or GLS formulation). The computation of these coefficients is initialized 
+in the \mdl{zdfini} module and performed in the \mdl{zdfric}, \mdl{zdftke} or 
+\mdl{zdfgls} modules. The trends due to the vertical momentum and tracer 
+diffusion, including the surface forcing, are computed and added to the 
+general trend in the \mdl{dynzdf} and \mdl{trazdf} modules, respectively. 
+These trends can be computed using either a forward time stepping scheme 
+(namelist parameter \np{ln\_zdfexp}=true) or a backward time stepping 
+scheme (\np{ln\_zdfexp}=false) depending on the magnitude of the mixing 
+coefficients, and thus of the formulation used (see \S\ref{STP}).
+
+% -------------------------------------------------------------------------------------------------------------
+%        Constant 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Constant (\key{zdfcst})}
+\label{ZDF_cst}
+%--------------------------------------------namzdf---------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namzdf} namelist variables.
+When \key{zdfcst} is defined, the momentum and tracer vertical eddy coefficients 
+are set to constant values over the whole ocean. This is the crudest way to define 
+the vertical ocean physics. It is recommended that this option is only used in 
+process studies, not in basin scale simulations. Typical values used in this case are:
+\begin{align*} 
+A_u^{vm} = A_v^{vm} &= 1.2\ 10^{-4}~m^2.s^{-1} 	\\
+A^{vT} = A^{vS} &= 1.2\ 10^{-5}~m^2.s^{-1}
+\end{align*}
+
+These values are set through the \np{rn\_avm0} and \np{rn\_avt0} namelist parameters. 
+In all cases, do not use values smaller that those associated with the molecular 
+viscosity and diffusivity, that is $\sim10^{-6}~m^2.s^{-1}$ for momentum, 
+$\sim10^{-7}~m^2.s^{-1}$ for temperature and $\sim10^{-9}~m^2.s^{-1}$ for salinity.
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Richardson Number Dependent
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Richardson Number Dependent (\key{zdfric})}
+\label{ZDF_ric}
+
+%--------------------------------------------namric---------------------------------------------------------
+\namdisplay{namzdf_ric}
+%--------------------------------------------------------------------------------------------------------------
+
+When \key{zdfric} is defined, a local Richardson number dependent formulation 
+for the vertical momentum and tracer eddy coefficients is set through the  \ngn{namzdf\_ric} 
+namelist variables.The vertical mixing 
+coefficients are diagnosed from the large scale variables computed by the model. 
+\textit{In situ} measurements have been used to link vertical turbulent activity to 
+large scale ocean structures. The hypothesis of a mixing mainly maintained by the 
+growth of Kelvin-Helmholtz like instabilities leads to a dependency between the 
+vertical eddy coefficients and the local Richardson number ($i.e.$ the 
+ratio of stratification to vertical shear). Following \citet{Pacanowski_Philander_JPO81}, the following 
+formulation has been implemented:
+\begin{equation} \label{Eq_zdfric}
+   \left\{      \begin{aligned}
+         A^{vT} &= \frac {A_{ric}^{vT}}{\left( 1+a \; Ri \right)^n} + A_b^{vT}       \\
+         A^{vm} &= \frac{A^{vT}        }{\left( 1+ a \;Ri  \right)   } + A_b^{vm}
+   \end{aligned}    \right.
+\end{equation}
+where $Ri = N^2 / \left(\partial_z \textbf{U}_h \right)^2$ is the local Richardson 
+number, $N$ is the local Brunt-Vais\"{a}l\"{a} frequency (see \S\ref{TRA_bn2}), 
+$A_b^{vT} $ and $A_b^{vm}$ are the constant background values set as in the 
+constant case (see \S\ref{ZDF_cst}), and $A_{ric}^{vT} = 10^{-4}~m^2.s^{-1}$ 
+is the maximum value that can be reached by the coefficient when $Ri\leq 0$, 
+$a=5$ and $n=2$. The last three values can be modified by setting the 
+\np{rn\_avmri}, \np{rn\_alp} and \np{nn\_ric} namelist parameters, respectively.
+
+A simple mixing-layer model to transfer and dissipate the atmospheric
+ forcings (wind-stress and buoyancy fluxes) can be activated setting 
+the \np{ln\_mldw} =.true. in the namelist.
+
+In this case, the local depth of turbulent wind-mixing or "Ekman depth"
+ $h_{e}(x,y,t)$ is evaluated and the vertical eddy coefficients prescribed within this layer.
+
+This depth is assumed proportional to the "depth of frictional influence" that is limited by rotation:
+\begin{equation}
+         h_{e} = Ek \frac {u^{*}} {f_{0}}  	\\
+\end{equation}
+where, $Ek$ is an empirical parameter, $u^{*}$ is the friction velocity and $f_{0}$ is the Coriolis 
+parameter.
+
+In this similarity height relationship, the turbulent friction velocity:
+\begin{equation}
+         u^{*} = \sqrt \frac {|\tau|} {\rho_o}  	\\
+\end{equation}
+
+is computed from the wind stress vector $|\tau|$ and the reference density $ \rho_o$.
+The final $h_{e}$ is further constrained by the adjustable bounds \np{rn\_mldmin} and \np{rn\_mldmax}.
+Once $h_{e}$ is computed, the vertical eddy coefficients within $h_{e}$ are set to 
+the empirical values \np{rn\_wtmix} and \np{rn\_wvmix} \citep{Lermusiaux2001}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        TKE Turbulent Closure Scheme 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{TKE Turbulent Closure Scheme (\key{zdftke})}
+\label{ZDF_tke}
+
+%--------------------------------------------namzdf_tke--------------------------------------------------
+\namdisplay{namzdf_tke}
+%--------------------------------------------------------------------------------------------------------------
+
+The vertical eddy viscosity and diffusivity coefficients are computed from a TKE 
+turbulent closure model based on a prognostic equation for $\bar{e}$, the turbulent 
+kinetic energy, and a closure assumption for the turbulent length scales. This 
+turbulent closure model has been developed by \citet{Bougeault1989} in the 
+atmospheric case, adapted by \citet{Gaspar1990} for the oceanic case, and 
+embedded in OPA, the ancestor of NEMO, by \citet{Blanke1993} for equatorial Atlantic 
+simulations. Since then, significant modifications have been introduced by 
+\citet{Madec1998} in both the implementation and the formulation of the mixing 
+length scale. The time evolution of $\bar{e}$ is the result of the production of 
+$\bar{e}$ through vertical shear, its destruction through stratification, its vertical 
+diffusion, and its dissipation of \citet{Kolmogorov1942} type:
+\begin{equation} \label{Eq_zdftke_e}
+\frac{\partial \bar{e}}{\partial t} = 
+\frac{K_m}{{e_3}^2 }\;\left[ {\left( {\frac{\partial u}{\partial k}} \right)^2
+				        +\left( {\frac{\partial v}{\partial k}} \right)^2} \right]
+-K_\rho\,N^2
++\frac{1}{e_3}	\;\frac{\partial }{\partial k}\left[ {\frac{A^{vm}}{e_3 }
+				\;\frac{\partial \bar{e}}{\partial k}} \right]
+- c_\epsilon \;\frac{\bar {e}^{3/2}}{l_\epsilon }
+\end{equation}
+\begin{equation} \label{Eq_zdftke_kz}
+   \begin{split}
+         K_m &= C_k\  l_k\  \sqrt {\bar{e}\; }  	\\
+         K_\rho &= A^{vm} / P_{rt}
+   \end{split}
+\end{equation}
+where $N$ is the local Brunt-Vais\"{a}l\"{a} frequency (see \S\ref{TRA_bn2}), 
+$l_{\epsilon }$ and $l_{\kappa }$ are the dissipation and mixing length scales, 
+$P_{rt}$ is the Prandtl number, $K_m$ and $K_\rho$ are the vertical eddy viscosity 
+and diffusivity coefficients. The constants $C_k =  0.1$ and $C_\epsilon = \sqrt {2} /2$  
+$\approx 0.7$ are designed to deal with vertical mixing at any depth \citep{Gaspar1990}. 
+They are set through namelist parameters \np{nn\_ediff} and \np{nn\_ediss}. 
+$P_{rt}$ can be set to unity or, following \citet{Blanke1993}, be a function 
+of the local Richardson number, $R_i$:
+\begin{align*} \label{Eq_prt}
+P_{rt} = \begin{cases}
+                    \ \ \ 1 &      \text{if $\ R_i \leq 0.2$} 	\\
+                    5\,R_i &      \text{if $\ 0.2 \leq R_i \leq 2$} 	\\
+                    \ \ 10 &      \text{if $\ 2 \leq R_i$} 
+            \end{cases}
+\end{align*}
+Options are defined through the  \ngn{namzdfy\_tke} namelist variables.
+The choice of $P_{rt}$ is controlled by the \np{nn\_pdl} namelist variable.
+
+At the sea surface, the value of $\bar{e}$ is prescribed from the wind 
+stress field as $\bar{e}_o = e_{bb} |\tau| / \rho_o$, with $e_{bb}$ the \np{rn\_ebb} 
+namelist parameter. The default value of $e_{bb}$ is 3.75. \citep{Gaspar1990}), 
+however a much larger value can be used when taking into account the 
+surface wave breaking (see below Eq. \eqref{ZDF_Esbc}). 
+The bottom value of TKE is assumed to be equal to the value of the level just above. 
+The time integration of the $\bar{e}$ equation may formally lead to negative values 
+because the numerical scheme does not ensure its positivity. To overcome this 
+problem, a cut-off in the minimum value of $\bar{e}$ is used (\np{rn\_emin} 
+namelist parameter). Following \citet{Gaspar1990}, the cut-off value is set 
+to $\sqrt{2}/2~10^{-6}~m^2.s^{-2}$. This allows the subsequent formulations 
+to match that of \citet{Gargett1984} for the diffusion in the thermocline and 
+deep ocean :  $K_\rho = 10^{-3} / N$. 
+In addition, a cut-off is applied on $K_m$ and $K_\rho$ to avoid numerical 
+instabilities associated with too weak vertical diffusion. They must be 
+specified at least larger than the molecular values, and are set through 
+\np{rn\_avm0} and \np{rn\_avt0} (namzdf namelist, see \S\ref{ZDF_cst}).
+
+\subsubsection{Turbulent length scale}
+For computational efficiency, the original formulation of the turbulent length 
+scales proposed by \citet{Gaspar1990} has been simplified. Four formulations 
+are proposed, the choice of which is controlled by the \np{nn\_mxl} namelist 
+parameter. The first two are based on the following first order approximation 
+\citep{Blanke1993}:
+\begin{equation} \label{Eq_tke_mxl0_1}
+l_k = l_\epsilon = \sqrt {2 \bar{e}\; } / N
+\end{equation}
+which is valid in a stable stratified region with constant values of the Brunt-
+Vais\"{a}l\"{a} frequency. The resulting length scale is bounded by the distance 
+to the surface or to the bottom (\np{nn\_mxl} = 0) or by the local vertical scale factor 
+(\np{nn\_mxl} = 1). \citet{Blanke1993} notice that this simplification has two major 
+drawbacks: it makes no sense for locally unstable stratification and the 
+computation no longer uses all the information contained in the vertical density 
+profile. To overcome these drawbacks, \citet{Madec1998} introduces the 
+\np{nn\_mxl} = 2 or 3 cases, which add an extra assumption concerning the vertical 
+gradient of the computed length scale. So, the length scales are first evaluated 
+as in \eqref{Eq_tke_mxl0_1} and then bounded such that:
+\begin{equation} \label{Eq_tke_mxl_constraint}
+\frac{1}{e_3 }\left| {\frac{\partial l}{\partial k}} \right| \leq 1
+\qquad \text{with }\  l =  l_k = l_\epsilon
+\end{equation}
+\eqref{Eq_tke_mxl_constraint} means that the vertical variations of the length 
+scale cannot be larger than the variations of depth. It provides a better 
+approximation of the \citet{Gaspar1990} formulation while being much less 
+time consuming. In particular, it allows the length scale to be limited not only 
+by the distance to the surface or to the ocean bottom but also by the distance 
+to a strongly stratified portion of the water column such as the thermocline 
+(Fig.~\ref{Fig_mixing_length}). In order to impose the \eqref{Eq_tke_mxl_constraint} 
+constraint, we introduce two additional length scales: $l_{up}$ and $l_{dwn}$, 
+the upward and downward length scales, and evaluate the dissipation and 
+mixing length scales as (and note that here we use numerical indexing):
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] \begin{center}
+\includegraphics[width=1.00\textwidth]{Fig_mixing_length}
+\caption{ \label{Fig_mixing_length} 
+Illustration of the mixing length computation. }
+\end{center}  
+\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{equation} \label{Eq_tke_mxl2}
+\begin{aligned}
+ l_{up\ \ }^{(k)} &= \min \left(  l^{(k)} \ , \ l_{up}^{(k+1)} + e_{3t}^{(k)}\ \ \ \;  \right)
+    \quad &\text{ from $k=1$ to $jpk$ }\ \\
+ l_{dwn}^{(k)} &= \min \left(  l^{(k)} \ , \ l_{dwn}^{(k-1)} + e_{3t}^{(k-1)}  \right)   
+    \quad &\text{ from $k=jpk$ to $1$ }\ \\
+\end{aligned}
+\end{equation}
+where $l^{(k)}$ is computed using \eqref{Eq_tke_mxl0_1}, 
+$i.e.$ $l^{(k)} = \sqrt {2 {\bar e}^{(k)} / {N^2}^{(k)} }$.
+
+In the \np{nn\_mxl}~=~2 case, the dissipation and mixing length scales take the same 
+value: $ l_k=  l_\epsilon = \min \left(\ l_{up} \;,\;  l_{dwn}\ \right)$, while in the 
+\np{nn\_mxl}~=~3 case, the dissipation and mixing turbulent length scales are give 
+as in \citet{Gaspar1990}:
+\begin{equation} \label{Eq_tke_mxl_gaspar}
+\begin{aligned}
+& l_k          = \sqrt{\  l_{up} \ \ l_{dwn}\ }  	\\
+& l_\epsilon = \min \left(\ l_{up} \;,\;  l_{dwn}\ \right) 
+\end{aligned}
+\end{equation}
+
+At the ocean surface, a non zero length scale is set through the  \np{rn\_mxl0} namelist 
+parameter. Usually the surface scale is given by $l_o = \kappa \,z_o$ 
+where $\kappa = 0.4$ is von Karman's constant and $z_o$ the roughness 
+parameter of the surface. Assuming $z_o=0.1$~m \citep{Craig_Banner_JPO94} 
+leads to a 0.04~m, the default value of \np{rn\_mxl0}. In the ocean interior 
+a minimum length scale is set to recover the molecular viscosity when $\bar{e}$ 
+reach its minimum value ($1.10^{-6}= C_k\, l_{min} \,\sqrt{\bar{e}_{min}}$ ).
+
+
+\subsubsection{Surface wave breaking parameterization}
+%-----------------------------------------------------------------------%
+Following \citet{Mellor_Blumberg_JPO04}, the TKE turbulence closure model has been modified 
+to include the effect of surface wave breaking energetics. This results in a reduction of summertime 
+surface temperature when the mixed layer is relatively shallow. The \citet{Mellor_Blumberg_JPO04} 
+modifications acts on surface length scale and TKE values and air-sea drag coefficient. 
+The latter concerns the bulk formulea and is not discussed here. 
+
+Following \citet{Craig_Banner_JPO94}, the boundary condition on surface TKE value is :
+\begin{equation}  \label{ZDF_Esbc}
+\bar{e}_o = \frac{1}{2}\,\left(  15.8\,\alpha_{CB} \right)^{2/3} \,\frac{|\tau|}{\rho_o}
+\end{equation}
+where $\alpha_{CB}$ is the \citet{Craig_Banner_JPO94} constant of proportionality 
+which depends on the ''wave age'', ranging from 57 for mature waves to 146 for 
+younger waves \citep{Mellor_Blumberg_JPO04}. 
+The boundary condition on the turbulent length scale follows the Charnock's relation:
+\begin{equation} \label{ZDF_Lsbc}
+l_o = \kappa \beta \,\frac{|\tau|}{g\,\rho_o}
+\end{equation}
+where $\kappa=0.40$ is the von Karman constant, and $\beta$ is the Charnock's constant.
+\citet{Mellor_Blumberg_JPO04} suggest $\beta = 2.10^{5}$ the value chosen by \citet{Stacey_JPO99}
+citing observation evidence, and $\alpha_{CB} = 100$ the Craig and Banner's value.
+As the surface boundary condition on TKE is prescribed through $\bar{e}_o = e_{bb} |\tau| / \rho_o$, 
+with $e_{bb}$ the \np{rn\_ebb} namelist parameter, setting \np{rn\_ebb}~=~67.83 corresponds 
+to $\alpha_{CB} = 100$. Further setting  \np{ln\_mxl0} to true applies \eqref{ZDF_Lsbc} 
+as surface boundary condition on length scale, with $\beta$ hard coded to the Stacey's value.
+Note that a minimal threshold of \np{rn\_emin0}$=10^{-4}~m^2.s^{-2}$ (namelist parameters) 
+is applied on surface $\bar{e}$ value.
+
+
+\subsubsection{Langmuir cells}
+%--------------------------------------%
+Langmuir circulations (LC) can be described as ordered large-scale vertical motions 
+in the surface layer of the oceans. Although LC have nothing to do with convection, 
+the circulation pattern is rather similar to so-called convective rolls in the atmospheric 
+boundary layer. The detailed physics behind LC is described in, for example, 
+\citet{Craik_Leibovich_JFM76}. The prevailing explanation is that LC arise from 
+a nonlinear interaction between the Stokes drift and wind drift currents. 
+
+Here we introduced in the TKE turbulent closure the simple parameterization of 
+Langmuir circulations proposed by \citep{Axell_JGR02} for a $k-\epsilon$ turbulent closure. 
+The parameterization, tuned against large-eddy simulation, includes the whole effect
+of LC in an extra source terms of TKE, $P_{LC}$.
+The presence of $P_{LC}$ in \eqref{Eq_zdftke_e}, the TKE equation, is controlled 
+by setting \np{ln\_lc} to \textit{true} in the namtke namelist.
+ 
+By making an analogy with the characteristic convective velocity scale 
+($e.g.$, \citet{D'Alessio_al_JPO98}), $P_{LC}$ is assumed to be : 
+\begin{equation}
+P_{LC}(z) = \frac{w_{LC}^3(z)}{H_{LC}}
+\end{equation}
+where $w_{LC}(z)$ is the vertical velocity profile of LC, and $H_{LC}$ is the LC depth.
+With no information about the wave field, $w_{LC}$ is assumed to be proportional to 
+the Stokes drift $u_s = 0.377\,\,|\tau|^{1/2}$, where $|\tau|$ is the surface wind stress module 
+\footnote{Following \citet{Li_Garrett_JMR93}, the surface Stoke drift velocity
+may be expressed as $u_s =  0.016 \,|U_{10m}|$. Assuming an air density of 
+$\rho_a=1.22 \,Kg/m^3$ and a drag coefficient of $1.5~10^{-3}$ give the expression 
+used of $u_s$ as a function of the module of surface stress}. 
+For the vertical variation, $w_{LC}$ is assumed to be zero at the surface as well as 
+at a finite depth $H_{LC}$ (which is often close to the mixed layer depth), and simply 
+varies as a sine function in between (a first-order profile for the Langmuir cell structures). 
+The resulting expression for $w_{LC}$ is :
+\begin{equation}
+w_{LC}  = \begin{cases}
+                   c_{LC} \,u_s \,\sin(- \pi\,z / H_{LC} )    &      \text{if $-z \leq H_{LC}$} 	\\
+                   0                 				 &      \text{otherwise} 
+                 \end{cases}
+\end{equation}
+where $c_{LC} = 0.15$ has been chosen by \citep{Axell_JGR02} as a good compromise 
+to fit LES data. The chosen value yields maximum vertical velocities $w_{LC}$ of the order 
+of a few centimeters per second. The value of $c_{LC}$ is set through the \np{rn\_lc} 
+namelist parameter, having in mind that it should stay between 0.15 and 0.54 \citep{Axell_JGR02}. 
+
+The $H_{LC}$ is estimated in a similar way as the turbulent length scale of TKE equations:
+$H_{LC}$ is depth to which a water parcel with kinetic energy due to Stoke drift
+can reach on its own by converting its kinetic energy to potential energy, according to 
+\begin{equation}
+- \int_{-H_{LC}}^0 { N^2\;z  \;dz} = \frac{1}{2} u_s^2
+\end{equation}
+
+
+\subsubsection{Mixing just below the mixed layer}
+%--------------------------------------------------------------%
+
+Vertical mixing parameterizations commonly used in ocean general circulation models 
+tend to produce mixed-layer depths that are too shallow during summer months and windy conditions.
+This bias is particularly acute over the Southern Ocean. 
+To overcome this systematic bias, an ad hoc parameterization is introduced into the TKE scheme  \cite{Rodgers_2014}. 
+The parameterization is an empirical one, $i.e.$ not derived from theoretical considerations, 
+but rather is meant to account for observed processes that affect the density structure of 
+the ocean’s planetary boundary layer that are not explicitly captured by default in the TKE scheme 
+($i.e.$ near-inertial oscillations and ocean swells and waves).
+
+When using this parameterization ($i.e.$ when \np{nn\_etau}~=~1), the TKE input to the ocean ($S$) 
+imposed by the winds in the form of near-inertial oscillations, swell and waves is parameterized 
+by \eqref{ZDF_Esbc} the standard TKE surface boundary condition, plus a depth depend one given by:
+\begin{equation}  \label{ZDF_Ehtau}
+S = (1-f_i) \; f_r \; e_s \; e^{-z / h_\tau} 
+\end{equation}
+where 
+$z$ is the depth,  
+$e_s$ is TKE surface boundary condition, 
+$f_r$ is the fraction of the surface TKE that penetrate in the ocean, 
+$h_\tau$ is a vertical mixing length scale that controls exponential shape of the penetration, 
+and $f_i$ is the ice concentration (no penetration if $f_i=1$, that is if the ocean is entirely 
+covered by sea-ice).
+The value of $f_r$, usually a few percents, is specified through \np{rn\_efr} namelist parameter. 
+The vertical mixing length scale, $h_\tau$, can be set as a 10~m uniform value (\np{nn\_etau}~=~0) 
+or a latitude dependent value (varying from 0.5~m at the Equator to a maximum value of 30~m 
+at high latitudes (\np{nn\_etau}~=~1). 
+
+Note that two other option existe, \np{nn\_etau}~=~2, or 3. They correspond to applying 
+\eqref{ZDF_Ehtau} only at the base of the mixed layer, or to using the high frequency part 
+of the stress to evaluate the fraction of TKE that penetrate the ocean. 
+Those two options are obsolescent features introduced for test purposes.
+They will be removed in the next release. 
+
+
+
+% from Burchard et al OM 2008 : 
+% the most critical process not reproduced by statistical turbulence models is the activity of 
+% internal waves and their interaction with turbulence. After the Reynolds decomposition, 
+% internal waves are in principle included in the RANS equations, but later partially 
+% excluded by the hydrostatic assumption and the model resolution. 
+% Thus far, the representation of internal wave mixing in ocean models has been relatively crude 
+% (e.g. Mellor, 1989; Large et al., 1994; Meier, 2001; Axell, 2002; St. Laurent and Garrett, 2002).
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        TKE discretization considerations
+% -------------------------------------------------------------------------------------------------------------
+\subsection{TKE discretization considerations (\key{zdftke})}
+\label{ZDF_tke_ene}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]   \begin{center}
+\includegraphics[width=1.00\textwidth]{Fig_ZDF_TKE_time_scheme}
+\caption{ \label{Fig_TKE_time_scheme} 
+Illustration of the TKE time integration and its links to the momentum and tracer time integration. }
+\end{center}  
+\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The production of turbulence by vertical shear (the first term of the right hand side 
+of \eqref{Eq_zdftke_e}) should balance the loss of kinetic energy associated with
+the vertical momentum diffusion (first line in \eqref{Eq_PE_zdf}). To do so a special care 
+have to be taken for both the time and space discretization of the TKE equation 
+\citep{Burchard_OM02,Marsaleix_al_OM08}.
+
+Let us first address the time stepping issue. Fig.~\ref{Fig_TKE_time_scheme} shows 
+how the two-level Leap-Frog time stepping of the momentum and tracer equations interplays 
+with the one-level forward time stepping of TKE equation. With this framework, the total loss 
+of kinetic energy (in 1D for the demonstration) due to the vertical momentum diffusion is 
+obtained by multiplying this quantity by $u^t$ and summing the result vertically:   
+\begin{equation} \label{Eq_energ1}
+\begin{split}
+\int_{-H}^{\eta}  u^t \,\partial_z &\left( {K_m}^t \,(\partial_z u)^{t+\rdt}  \right) \,dz   \\
+&= \Bigl[  u^t \,{K_m}^t \,(\partial_z u)^{t+\rdt} \Bigr]_{-H}^{\eta}          
+ - \int_{-H}^{\eta}{ {K_m}^t \,\partial_z{u^t} \,\partial_z u^{t+\rdt} \,dz }
+\end{split}
+\end{equation}
+Here, the vertical diffusion of momentum is discretized backward in time 
+with a coefficient, $K_m$, known at time $t$ (Fig.~\ref{Fig_TKE_time_scheme}), 
+as it is required when using the TKE scheme (see \S\ref{STP_forward_imp}). 
+The first term of the right hand side of \eqref{Eq_energ1} represents the kinetic energy 
+transfer at the surface (atmospheric forcing) and at the bottom (friction effect). 
+The second term is always negative. It is the dissipation rate of kinetic energy, 
+and thus minus the shear production rate of $\bar{e}$. \eqref{Eq_energ1} 
+implies that, to be energetically consistent, the production rate of $\bar{e}$ 
+used to compute $(\bar{e})^t$ (and thus ${K_m}^t$) should be expressed as 
+${K_m}^{t-\rdt}\,(\partial_z u)^{t-\rdt} \,(\partial_z u)^t$ (and not by the more straightforward 
+$K_m \left( \partial_z u \right)^2$ expression taken at time $t$ or $t-\rdt$).
+
+A similar consideration applies on the destruction rate of $\bar{e}$ due to stratification 
+(second term of the right hand side of \eqref{Eq_zdftke_e}). This term 
+must balance the input of potential energy resulting from vertical mixing. 
+The rate of change of potential energy (in 1D for the demonstration) due vertical 
+mixing is obtained by multiplying vertical density diffusion 
+tendency by $g\,z$ and and summing the result vertically:
+\begin{equation} \label{Eq_energ2}
+\begin{split}
+\int_{-H}^{\eta} g\,z\,\partial_z &\left( {K_\rho}^t \,(\partial_k \rho)^{t+\rdt}   \right) \,dz    \\
+&= \Bigl[  g\,z \,{K_\rho}^t \,(\partial_z \rho)^{t+\rdt} \Bigr]_{-H}^{\eta}  
+   - \int_{-H}^{\eta}{ g \,{K_\rho}^t \,(\partial_k \rho)^{t+\rdt} } \,dz   \\
+&= - \Bigl[  z\,{K_\rho}^t \,(N^2)^{t+\rdt} \Bigr]_{-H}^{\eta}
++ \int_{-H}^{\eta}{  \rho^{t+\rdt} \, {K_\rho}^t \,(N^2)^{t+\rdt} \,dz  }
+\end{split}
+\end{equation}
+where we use $N^2 = -g \,\partial_k \rho / (e_3 \rho)$. 
+The first term of the right hand side of \eqref{Eq_energ2}  is always zero 
+because there is no diffusive flux through the ocean surface and bottom). 
+The second term is minus the destruction rate of  $\bar{e}$ due to stratification. 
+Therefore \eqref{Eq_energ1} implies that, to be energetically consistent, the product 
+${K_\rho}^{t-\rdt}\,(N^2)^t$ should be used in \eqref{Eq_zdftke_e}, the TKE equation.
+
+Let us now address the space discretization issue. 
+The vertical eddy coefficients are defined at $w$-point whereas the horizontal velocity 
+components are in the centre of the side faces of a $t$-box in staggered C-grid 
+(Fig.\ref{Fig_cell}). A space averaging is thus required to obtain the shear TKE production term.
+By redoing the \eqref{Eq_energ1} in the 3D case, it can be shown that the product of 
+eddy coefficient by the shear at $t$ and $t-\rdt$ must be performed prior to the averaging.
+Furthermore, the possible time variation of $e_3$ (\key{vvl} case) have to be taken into 
+account.
+
+The above energetic considerations leads to 
+the following final discrete form for the TKE equation:
+\begin{equation} \label{Eq_zdftke_ene}
+\begin{split}
+\frac { (\bar{e})^t - (\bar{e})^{t-\rdt} } {\rdt}  \equiv  
+\Biggl\{ \Biggr.
+  &\overline{ \left( \left(\overline{K_m}^{\,i+1/2}\right)^{t-\rdt} \,\frac{\delta_{k+1/2}[u^{t+\rdt}]}{{e_3u}^{t+\rdt} } 
+                                                                              \ \frac{\delta_{k+1/2}[u^ t         ]}{{e_3u}^ t          }  \right) }^{\,i} \\
++&\overline{  \left( \left(\overline{K_m}^{\,j+1/2}\right)^{t-\rdt} \,\frac{\delta_{k+1/2}[v^{t+\rdt}]}{{e_3v}^{t+\rdt} } 
+                                                                               \ \frac{\delta_{k+1/2}[v^ t         ]}{{e_3v}^ t          }  \right) }^{\,j} 
+\Biggr. \Biggr\}   \\
+%
+- &{K_\rho}^{t-\rdt}\,{(N^2)^t}    \\
+%
++&\frac{1}{{e_3w}^{t+\rdt}}  \;\delta_{k+1/2} \left[   {K_m}^{t-\rdt} \,\frac{\delta_{k}[(\bar{e})^{t+\rdt}]} {{e_3w}^{t+\rdt}}   \right]   \\
+%
+- &c_\epsilon \; \left( \frac{\sqrt{\bar {e}}}{l_\epsilon}\right)^{t-\rdt}\,(\bar {e})^{t+\rdt}
+\end{split}
+\end{equation}
+where the last two terms in \eqref{Eq_zdftke_ene} (vertical diffusion and Kolmogorov dissipation) 
+are time stepped using a backward scheme (see\S\ref{STP_forward_imp}). 
+Note that the Kolmogorov term has been linearized in time in order to render 
+the implicit computation possible. The restart of the TKE scheme 
+requires the storage of $\bar {e}$, $K_m$, $K_\rho$ and $l_\epsilon$ as they all appear in 
+the right hand side of \eqref{Eq_zdftke_ene}. For the latter, it is in fact 
+the ratio $\sqrt{\bar{e}}/l_\epsilon$ which is stored. 
+
+% -------------------------------------------------------------------------------------------------------------
+%        GLS Generic Length Scale Scheme 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{GLS Generic Length Scale (\key{zdfgls})}
+\label{ZDF_gls}
+
+%--------------------------------------------namzdf_gls---------------------------------------------------------
+\namdisplay{namzdf_gls}
+%--------------------------------------------------------------------------------------------------------------
+
+The Generic Length Scale (GLS) scheme is a turbulent closure scheme based on 
+two prognostic equations: one for the turbulent kinetic energy $\bar {e}$, and another 
+for the generic length scale, $\psi$ \citep{Umlauf_Burchard_JMS03, Umlauf_Burchard_CSR05}. 
+This later variable is defined as : $\psi = {C_{0\mu}}^{p} \ {\bar{e}}^{m} \ l^{n}$, 
+where the triplet $(p, m, n)$ value given in Tab.\ref{Tab_GLS} allows to recover 
+a number of well-known turbulent closures ($k$-$kl$ \citep{Mellor_Yamada_1982}, 
+$k$-$\epsilon$ \citep{Rodi_1987}, $k$-$\omega$ \citep{Wilcox_1988} 
+among others \citep{Umlauf_Burchard_JMS03,Kantha_Carniel_CSR05}). 
+The GLS scheme is given by the following set of equations:
+\begin{equation} \label{Eq_zdfgls_e}
+\frac{\partial \bar{e}}{\partial t} = 
+\frac{K_m}{\sigma_e e_3 }\;\left[ {\left( \frac{\partial u}{\partial k} \right)^2
+                                                   +\left( \frac{\partial v}{\partial k} \right)^2} \right]
+-K_\rho \,N^2
++\frac{1}{e_3}\,\frac{\partial}{\partial k} \left[ \frac{K_m}{e_3}\,\frac{\partial \bar{e}}{\partial k} \right]
+- \epsilon
+\end{equation}
+
+\begin{equation} \label{Eq_zdfgls_psi}
+   \begin{split}
+\frac{\partial \psi}{\partial t} =& \frac{\psi}{\bar{e}} \left\{
+\frac{C_1\,K_m}{\sigma_{\psi} {e_3}}\;\left[ {\left( \frac{\partial u}{\partial k} \right)^2
+                                                                   +\left( \frac{\partial v}{\partial k} \right)^2} \right]
+- C_3 \,K_\rho\,N^2   - C_2 \,\epsilon \,Fw   \right\}             \\
+&+\frac{1}{e_3}  \;\frac{\partial }{\partial k}\left[ {\frac{K_m}{e_3 }
+                                  \;\frac{\partial \psi}{\partial k}} \right]\;
+   \end{split}
+\end{equation}
+
+\begin{equation} \label{Eq_zdfgls_kz}
+   \begin{split}
+         K_m    &= C_{\mu} \ \sqrt {\bar{e}} \ l         \\
+         K_\rho &= C_{\mu'}\ \sqrt {\bar{e}} \ l
+   \end{split}
+\end{equation}
+
+\begin{equation} \label{Eq_zdfgls_eps}
+{\epsilon} = C_{0\mu} \,\frac{\bar {e}^{3/2}}{l} \;
+\end{equation}
+where $N$ is the local Brunt-Vais\"{a}l\"{a} frequency (see \S\ref{TRA_bn2}) 
+and $\epsilon$ the dissipation rate. 
+The constants $C_1$, $C_2$, $C_3$, ${\sigma_e}$, ${\sigma_{\psi}}$ and the wall function ($Fw$) 
+depends of the choice of the turbulence model. Four different turbulent models are pre-defined 
+(Tab.\ref{Tab_GLS}). They are made available through the \np{nn\_clo} namelist parameter. 
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]	\begin{center}
+%\begin{tabular}{cp{70pt}cp{70pt}cp{70pt}cp{70pt}cp{70pt}cp{70pt}c}
+\begin{tabular}{ccccc}
+          	             &   $k-kl$   & $k-\epsilon$ & $k-\omega$ &   generic   \\  
+%                        & \citep{Mellor_Yamada_1982} &  \citep{Rodi_1987}       & \citep{Wilcox_1988} &                 \\  
+\hline  \hline 
+\np{nn\_clo}     & \textbf{0} &   \textbf{1}  &   \textbf{2}   &    \textbf{3}   \\  
+\hline 
+$( p , n , m )$	       &   ( 0 , 1 , 1 )   & ( 3 , 1.5 , -1 )   & ( -1 , 0.5 , -1 )    &  ( 2 , 1 , -0.67 )  \\
+$\sigma_k$      &    2.44         &     1.              &      2.                &      0.8          \\
+$\sigma_\psi$  &    2.44         &     1.3            &      2.                 &       1.07       \\
+$C_1$              &      0.9         &     1.44          &      0.555          &       1.           \\
+$C_2$              &      0.5         &     1.92          &      0.833          &       1.22       \\
+$C_3$              &      1.           &     1.              &      1.                &       1.           \\
+$F_{wall}$        &      Yes        &       --             &     --                  &      --          \\
+\hline
+\hline
+\end{tabular}
+\caption{   \label{Tab_GLS} 
+Set of predefined GLS parameters, or equivalently predefined turbulence models available 
+with \key{zdfgls} and controlled by the \np{nn\_clos} namelist variable in \ngn{namzdf\_gls} .}
+\end{center}	\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+In the Mellor-Yamada model, the negativity of $n$ allows to use a wall function to force
+the convergence of the mixing length towards $K z_b$ ($K$: Kappa and $z_b$: rugosity length) 
+value near physical boundaries (logarithmic boundary layer law). $C_{\mu}$ and $C_{\mu'}$ 
+are calculated from stability function proposed by \citet{Galperin_al_JAS88}, or by \citet{Kantha_Clayson_1994} 
+or one of the two functions suggested by \citet{Canuto_2001}  (\np{nn\_stab\_func} = 0, 1, 2 or 3, resp.). 
+The value of $C_{0\mu}$ depends of the choice of the stability function.
+
+The surface and bottom boundary condition on both $\bar{e}$ and $\psi$ can be calculated 
+thanks to Dirichlet or Neumann condition through \np{nn\_tkebc\_surf} and \np{nn\_tkebc\_bot}, resp. 
+As for TKE closure , the wave effect on the mixing is considered when \np{ln\_crban}~=~true
+\citep{Craig_Banner_JPO94, Mellor_Blumberg_JPO04}. The \np{rn\_crban} namelist parameter 
+is $\alpha_{CB}$ in \eqref{ZDF_Esbc} and \np{rn\_charn} provides the value of $\beta$ in \eqref{ZDF_Lsbc}. 
+
+The $\psi$ equation is known to fail in stably stratified flows, and for this reason 
+almost all authors apply a clipping of the length scale as an \textit{ad hoc} remedy. 
+With this clipping, the maximum permissible length scale is determined by 
+$l_{max} = c_{lim} \sqrt{2\bar{e}}/ N$. A value of $c_{lim} = 0.53$ is often used 
+\citep{Galperin_al_JAS88}. \cite{Umlauf_Burchard_CSR05} show that the value of 
+the clipping factor is of crucial importance for the entrainment depth predicted in 
+stably stratified situations, and that its value has to be chosen in accordance 
+with the algebraic model for the turbulent fluxes. The clipping is only activated 
+if \np{ln\_length\_lim}=true, and the $c_{lim}$ is set to the \np{rn\_clim\_galp} value.
+
+The time and space discretization of the GLS equations follows the same energetic 
+consideration as for the TKE case described in \S\ref{ZDF_tke_ene}  \citep{Burchard_OM02}. 
+Examples of performance of the 4 turbulent closure scheme can be found in \citet{Warner_al_OM05}.
+
+
+% ================================================================
+% Convection
+% ================================================================
+\section{Convection}
+\label{ZDF_conv}
+
+%--------------------------------------------namzdf--------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+Static instabilities (i.e. light potential densities under heavy ones) may 
+occur at particular ocean grid points. In nature, convective processes 
+quickly re-establish the static stability of the water column. These 
+processes have been removed from the model via the hydrostatic 
+assumption so they must be parameterized. Three parameterisations 
+are available to deal with convective processes: a non-penetrative 
+convective adjustment or an enhanced vertical diffusion, or/and the 
+use of a turbulent closure scheme.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Non-Penetrative Convective Adjustment 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Non-Penetrative Convective Adjustment (\np{ln\_tranpc}) ]
+			{Non-Penetrative Convective Adjustment (\np{ln\_tranpc}=.true.) }
+\label{ZDF_npc}
+
+%--------------------------------------------namzdf--------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!htb]  	\begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_npc}
+\caption{  \label{Fig_npc} 
+Example of an unstable density profile treated by the non penetrative 
+convective adjustment algorithm. $1^{st}$ step: the initial profile is checked from 
+the surface to the bottom. It is found to be unstable between levels 3 and 4. 
+They are mixed. The resulting $\rho$ is still larger than $\rho$(5): levels 3 to 5 
+are mixed. The resulting $\rho$ is still larger than $\rho$(6): levels 3 to 6 are 
+mixed. The $1^{st}$ step ends since the density profile is then stable below 
+the level 3. $2^{nd}$ step: the new $\rho$ profile is checked following the same 
+procedure as in $1^{st}$ step: levels 2 to 5 are mixed. The new density profile 
+is checked. It is found stable: end of algorithm.}
+\end{center}  	\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Options are defined through the  \ngn{namzdf} namelist variables.
+The non-penetrative convective adjustment is used when \np{ln\_zdfnpc}~=~\textit{true}. 
+It is applied at each \np{nn\_npc} time step and mixes downwards instantaneously 
+the statically unstable portion of the water column, but only until the density 
+structure becomes neutrally stable ($i.e.$ until the mixed portion of the water 
+column has \textit{exactly} the density of the water just below) \citep{Madec_al_JPO91}. 
+The associated algorithm is an iterative process used in the following way 
+(Fig. \ref{Fig_npc}): starting from the top of the ocean, the first instability is 
+found. Assume in the following that the instability is located between levels 
+$k$ and $k+1$. The temperature and salinity in the two levels are 
+vertically mixed, conserving the heat and salt contents of the water column. 
+The new density is then computed by a linear approximation. If the new 
+density profile is still unstable between levels $k+1$ and $k+2$, levels $k$, 
+$k+1$ and $k+2$ are then mixed. This process is repeated until stability is 
+established below the level $k$ (the mixing process can go down to the 
+ocean bottom). The algorithm is repeated to check if the density profile 
+between level $k-1$ and $k$ is unstable and/or if there is no deeper instability.
+
+This algorithm is significantly different from mixing statically unstable levels 
+two by two. The latter procedure cannot converge with a finite number 
+of iterations for some vertical profiles while the algorithm used in \NEMO 
+converges for any profile in a number of iterations which is less than the 
+number of vertical levels. This property is of paramount importance as 
+pointed out by \citet{Killworth1989}: it avoids the existence of permanent 
+and unrealistic static instabilities at the sea surface. This non-penetrative 
+convective algorithm has been proved successful in studies of the deep 
+water formation in the north-western Mediterranean Sea 
+\citep{Madec_al_JPO91, Madec_al_DAO91, Madec_Crepon_Bk91}.
+
+The current implementation has been modified in order to deal with any non linear 
+equation of seawater (L. Brodeau, personnal communication). 
+Two main differences have been introduced compared to the original algorithm: 
+$(i)$ the stability is now checked using the Brunt-V\"{a}is\"{a}l\"{a} frequency 
+(not the the difference in potential density) ; 
+$(ii)$ when two levels are found unstable, their thermal and haline expansion coefficients 
+are vertically mixed in the same way their temperature and salinity has been mixed.
+These two modifications allow the algorithm to perform properly and accurately 
+with TEOS10 or EOS-80 without having to recompute the expansion coefficients at each 
+mixing iteration.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Enhanced Vertical Diffusion 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Enhanced Vertical Diffusion (\np{ln\_zdfevd})]
+		     	  {Enhanced Vertical Diffusion (\np{ln\_zdfevd}=true)}
+\label{ZDF_evd}
+
+%--------------------------------------------namzdf--------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namzdf} namelist variables.
+The enhanced vertical diffusion parameterisation is used when \np{ln\_zdfevd}=true. 
+In this case, the vertical eddy mixing coefficients are assigned very large values 
+(a typical value is $10\;m^2s^{-1})$ in regions where the stratification is unstable 
+($i.e.$ when $N^2$ the Brunt-Vais\"{a}l\"{a} frequency is negative) 
+\citep{Lazar_PhD97, Lazar_al_JPO99}. This is done either on tracers only 
+(\np{nn\_evdm}=0) or on both momentum and tracers (\np{nn\_evdm}=1).
+
+In practice, where $N^2\leq 10^{-12}$, $A_T^{vT}$ and $A_T^{vS}$, and 
+if \np{nn\_evdm}=1, the four neighbouring $A_u^{vm} \;\mbox{and}\;A_v^{vm}$ 
+values also, are set equal to the namelist parameter \np{rn\_avevd}. A typical value 
+for $rn\_avevd$ is between 1 and $100~m^2.s^{-1}$. This parameterisation of 
+convective processes is less time consuming than the convective adjustment 
+algorithm presented above when mixing both tracers and momentum in the 
+case of static instabilities. It requires the use of an implicit time stepping on 
+vertical diffusion terms (i.e. \np{ln\_zdfexp}=false). 
+
+Note that the stability test is performed on both \textit{before} and \textit{now} 
+values of $N^2$. This removes a potential source of divergence of odd and
+even time step in a leapfrog environment \citep{Leclair_PhD2010} (see \S\ref{STP_mLF}).
+
+% -------------------------------------------------------------------------------------------------------------
+%       Turbulent Closure Scheme 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Turbulent Closure Scheme (\key{zdftke} or \key{zdfgls})}
+\label{ZDF_tcs}
+
+The turbulent closure scheme presented in \S\ref{ZDF_tke} and \S\ref{ZDF_gls} 
+(\key{zdftke} or \key{zdftke} is defined) in theory solves the problem of statically 
+unstable density profiles. In such a case, the term corresponding to the 
+destruction of turbulent kinetic energy through stratification in \eqref{Eq_zdftke_e} 
+or \eqref{Eq_zdfgls_e} becomes a source term, since $N^2$ is negative. 
+It results in large values of $A_T^{vT}$ and  $A_T^{vT}$, and also the four neighbouring 
+$A_u^{vm} {and}\;A_v^{vm}$ (up to $1\;m^2s^{-1})$. These large values 
+restore the static stability of the water column in a way similar to that of the 
+enhanced vertical diffusion parameterisation (\S\ref{ZDF_evd}). However, 
+in the vicinity of the sea surface (first ocean layer), the eddy coefficients 
+computed by the turbulent closure scheme do not usually exceed $10^{-2}m.s^{-1}$, 
+because the mixing length scale is bounded by the distance to the sea surface. 
+It can thus be useful to combine the enhanced vertical 
+diffusion with the turbulent closure scheme, $i.e.$ setting the \np{ln\_zdfnpc} 
+namelist parameter to true and defining the turbulent closure CPP key all together.
+
+The KPP turbulent closure scheme already includes enhanced vertical diffusion 
+in the case of convection, as governed by the variables $bvsqcon$ and $difcon$ 
+found in \mdl{zdfkpp}, therefore \np{ln\_zdfevd}=false should be used with the KPP 
+scheme. %gm%  + one word on non local flux with KPP scheme trakpp.F90 module...
+
+% ================================================================
+% Double Diffusion Mixing
+% ================================================================
+\section  [Double Diffusion Mixing (\key{zdfddm})]
+		{Double Diffusion Mixing (\key{zdfddm})}
+\label{ZDF_ddm}
+
+%-------------------------------------------namzdf_ddm-------------------------------------------------
+\namdisplay{namzdf_ddm}
+%--------------------------------------------------------------------------------------------------------------
+
+Options are defined through the  \ngn{namzdf\_ddm} namelist variables.
+Double diffusion occurs when relatively warm, salty water overlies cooler, fresher 
+water, or vice versa. The former condition leads to salt fingering and the latter 
+to diffusive convection. Double-diffusive phenomena contribute to diapycnal 
+mixing in extensive regions of the ocean.  \citet{Merryfield1999} include a 
+parameterisation of such phenomena in a global ocean model and show that 
+it leads to relatively minor changes in circulation but exerts significant regional 
+influences on temperature and salinity. This parameterisation has been 
+introduced in \mdl{zdfddm} module and is controlled by the \key{zdfddm} CPP key.
+
+Diapycnal mixing of S and T are described by diapycnal diffusion coefficients 
+\begin{align*} % \label{Eq_zdfddm_Kz}
+    &A^{vT} = A_o^{vT}+A_f^{vT}+A_d^{vT}	\\
+    &A^{vS} = A_o^{vS}+A_f^{vS}+A_d^{vS}
+\end{align*}
+where subscript $f$ represents mixing by salt fingering, $d$ by diffusive convection, 
+and $o$ by processes other than double diffusion. The rates of double-diffusive 
+mixing depend on the buoyancy ratio $R_\rho = \alpha \partial_z T / \beta \partial_z S$, 
+where $\alpha$ and $\beta$ are coefficients of thermal expansion and saline 
+contraction (see \S\ref{TRA_eos}). To represent mixing of $S$ and $T$ by salt 
+fingering, we adopt the diapycnal diffusivities suggested by Schmitt (1981):
+\begin{align} \label{Eq_zdfddm_f}
+A_f^{vS} &= 	\begin{cases}
+	\frac{A^{\ast v}}{1+(R_\rho / R_c)^n   } &\text{if  $R_\rho > 1$ and $N^2>0$ } \\
+	0 				  					    &\text{otherwise} 
+				\end{cases}   
+\\ 		    \label{Eq_zdfddm_f_T}
+A_f^{vT} &= 0.7 \ A_f^{vS} / R_\rho 
+\end{align}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]   \begin{center}
+\includegraphics[width=0.99\textwidth]{Fig_zdfddm}
+\caption{  \label{Fig_zdfddm}
+From \citet{Merryfield1999} : (a) Diapycnal diffusivities $A_f^{vT}$ 
+and $A_f^{vS}$ for temperature and salt in regions of salt fingering. Heavy 
+curves denote $A^{\ast v} = 10^{-3}~m^2.s^{-1}$ and thin curves 
+$A^{\ast v} = 10^{-4}~m^2.s^{-1}$ ; (b) diapycnal diffusivities $A_d^{vT}$ and 
+$A_d^{vS}$ for temperature and salt in regions of diffusive convection. Heavy 
+curves denote the Federov parameterisation and thin curves the Kelley 
+parameterisation. The latter is not implemented in \NEMO. }
+\end{center}    \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The factor 0.7 in \eqref{Eq_zdfddm_f_T} reflects the measured ratio 
+$\alpha F_T /\beta F_S \approx  0.7$ of buoyancy flux of heat to buoyancy 
+flux of salt ($e.g.$, \citet{McDougall_Taylor_JMR84}). Following  \citet{Merryfield1999}, 
+we adopt $R_c = 1.6$, $n = 6$, and $A^{\ast v} = 10^{-4}~m^2.s^{-1}$.
+
+To represent mixing of S and T by diffusive layering,  the diapycnal diffusivities suggested by Federov (1988) is used: 
+\begin{align} 	\label{Eq_zdfddm_d}
+A_d^{vT} &= 	\begin{cases}
+	1.3635 \, \exp{\left( 4.6\, \exp{ \left[  -0.54\,( R_{\rho}^{-1} - 1 )  \right] }    \right)}
+									&\text{if  $0<R_\rho < 1$ and $N^2>0$ } \\
+	0 								&\text{otherwise} 
+				\end{cases}   
+\\   			\label{Eq_zdfddm_d_S}
+A_d^{vS} &= 	\begin{cases}
+	A_d^{vT}\ \left( 1.85\,R_{\rho} - 0.85 \right)
+									&\text{if  $0.5 \leq R_\rho<1$ and $N^2>0$ } \\
+	A_d^{vT} \ 0.15 \ R_\rho
+									&\text{if  $\ \ 0 < R_\rho<0.5$ and $N^2>0$ } \\
+	0 								&\text{otherwise} 
+				\end{cases}   
+\end{align}
+
+The dependencies of \eqref{Eq_zdfddm_f} to \eqref{Eq_zdfddm_d_S} on $R_\rho$ 
+are illustrated in Fig.~\ref{Fig_zdfddm}. Implementing this requires computing 
+$R_\rho$ at each grid point on every time step. This is done in \mdl{eosbn2} at the 
+same time as $N^2$ is computed. This avoids duplication in the computation of 
+$\alpha$ and $\beta$ (which is usually quite expensive).
+
+% ================================================================
+% Bottom Friction
+% ================================================================
+\section  [Bottom and Top Friction (\textit{zdfbfr})]   {Bottom and Top Friction (\mdl{zdfbfr} module)}
+\label{ZDF_bfr}
+
+%--------------------------------------------nambfr--------------------------------------------------------
+\namdisplay{nambfr}
+%--------------------------------------------------------------------------------------------------------------
+
+Options to define the top and bottom friction are defined through the  \ngn{nambfr} namelist variables.
+The bottom friction represents the friction generated by the bathymetry. 
+The top friction represents the friction generated by the ice shelf/ocean interface. 
+As the friction processes at the top and bottom are treated in similar way, 
+only the bottom friction is described in detail below.
+
+
+Both the surface momentum flux (wind stress) and the bottom momentum 
+flux (bottom friction) enter the equations as a condition on the vertical 
+diffusive flux. For the bottom boundary layer, one has:
+\begin{equation} \label{Eq_zdfbfr_flux}
+A^{vm} \left( \partial {\textbf U}_h / \partial z \right) = {{\cal F}}_h^{\textbf U}
+\end{equation}
+where ${\cal F}_h^{\textbf U}$ is represents the downward flux of horizontal momentum 
+outside the logarithmic turbulent boundary layer (thickness of the order of 
+1~m in the ocean). How ${\cal F}_h^{\textbf U}$ influences the interior depends on the 
+vertical resolution of the model near the bottom relative to the Ekman layer 
+depth. For example, in order to obtain an Ekman layer depth 
+$d = \sqrt{2\;A^{vm}} / f = 50$~m, one needs a vertical diffusion coefficient 
+$A^{vm} = 0.125$~m$^2$s$^{-1}$ (for a Coriolis frequency 
+$f = 10^{-4}$~m$^2$s$^{-1}$). With a background diffusion coefficient 
+$A^{vm} = 10^{-4}$~m$^2$s$^{-1}$, the Ekman layer depth is only 1.4~m. 
+When the vertical mixing coefficient is this small, using a flux condition is 
+equivalent to entering the viscous forces (either wind stress or bottom friction) 
+as a body force over the depth of the top or bottom model layer. To illustrate 
+this, consider the equation for $u$ at $k$, the last ocean level:
+\begin{equation} \label{Eq_zdfbfr_flux2}
+\frac{\partial u_k}{\partial t} = \frac{1}{e_{3u}} \left[ \frac{A_{uw}^{vm}}{e_{3uw}} \delta_{k+1/2}\;[u] - {\cal F}^u_h \right] \approx - \frac{{\cal F}^u_{h}}{e_{3u}}
+\end{equation}
+If the bottom layer thickness is 200~m, the Ekman transport will 
+be distributed over that depth. On the other hand, if the vertical resolution 
+is high (1~m or less) and a turbulent closure model is used, the turbulent 
+Ekman layer will be represented explicitly by the model. However, the 
+logarithmic layer is never represented in current primitive equation model 
+applications: it is \emph{necessary} to parameterize the flux ${\cal F}^u_h $. 
+Two choices are available in \NEMO: a linear and a quadratic bottom friction. 
+Note that in both cases, the rotation between the interior velocity and the 
+bottom friction is neglected in the present release of \NEMO.
+
+In the code, the bottom friction is imposed by adding the trend due to the bottom 
+friction to the general momentum trend in \mdl{dynbfr}. For the time-split surface 
+pressure gradient algorithm, the momentum trend due to the barotropic component 
+needs to be handled separately. For this purpose it is convenient to compute and 
+store coefficients which can be simply combined with bottom velocities and geometric 
+values to provide the momentum trend due to bottom friction. 
+These coefficients are computed in \mdl{zdfbfr} and generally take the form 
+$c_b^{\textbf U}$ where:
+\begin{equation} \label{Eq_zdfbfr_bdef}
+\frac{\partial {\textbf U_h}}{\partial t} = 
+  - \frac{{\cal F}^{\textbf U}_{h}}{e_{3u}} = \frac{c_b^{\textbf U}}{e_{3u}} \;{\textbf U}_h^b
+\end{equation}
+where $\textbf{U}_h^b = (u_b\;,\;v_b)$ is the near-bottom, horizontal, ocean velocity.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Linear Bottom Friction
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Linear Bottom Friction (\np{nn\_botfr} = 0 or 1) }
+\label{ZDF_bfr_linear}
+
+The linear bottom friction parameterisation (including the special case 
+of a free-slip condition) assumes that the bottom friction 
+is proportional to the interior velocity (i.e. the velocity of the last 
+model level):
+\begin{equation} \label{Eq_zdfbfr_linear}
+{\cal F}_h^\textbf{U} = \frac{A^{vm}}{e_3} \; \frac{\partial \textbf{U}_h}{\partial k} = r \; \textbf{U}_h^b
+\end{equation}
+where $r$ is a friction coefficient expressed in ms$^{-1}$. 
+This coefficient is generally estimated by setting a typical decay time 
+$\tau$ in the deep ocean, 
+and setting $r = H / \tau$, where $H$ is the ocean depth. Commonly accepted 
+values of $\tau$ are of the order of 100 to 200 days \citep{Weatherly_JMR84}. 
+A value $\tau^{-1} = 10^{-7}$~s$^{-1}$ equivalent to 115 days, is usually used 
+in quasi-geostrophic models. One may consider the linear friction as an 
+approximation of quadratic friction, $r \approx 2\;C_D\;U_{av}$ (\citet{Gill1982}, 
+Eq. 9.6.6). For example, with a drag coefficient $C_D = 0.002$, a typical speed 
+of tidal currents of $U_{av} =0.1$~m\;s$^{-1}$, and assuming an ocean depth 
+$H = 4000$~m, the resulting friction coefficient is $r = 4\;10^{-4}$~m\;s$^{-1}$. 
+This is the default value used in \NEMO. It corresponds to a decay time scale 
+of 115~days. It can be changed by specifying \np{rn\_bfri1} (namelist parameter).
+
+For the linear friction case the coefficients defined in the general 
+expression \eqref{Eq_zdfbfr_bdef} are: 
+\begin{equation} \label{Eq_zdfbfr_linbfr_b}
+\begin{split}
+ c_b^u &= - r\\
+ c_b^v &= - r\\
+\end{split}
+\end{equation}
+When \np{nn\_botfr}=1, the value of $r$ used is \np{rn\_bfri1}. 
+Setting \np{nn\_botfr}=0 is equivalent to setting $r=0$ and leads to a free-slip 
+bottom boundary condition. These values are assigned in \mdl{zdfbfr}. 
+From v3.2 onwards there is support for local enhancement of these values 
+via an externally defined 2D mask array (\np{ln\_bfr2d}=true) given
+in the \ifile{bfr\_coef} input NetCDF file. The mask values should vary from 0 to 1. 
+Locations with a non-zero mask value will have the friction coefficient increased 
+by $mask\_value$*\np{rn\_bfrien}*\np{rn\_bfri1}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Non-Linear Bottom Friction
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Non-Linear Bottom Friction (\np{nn\_botfr} = 2)}
+\label{ZDF_bfr_nonlinear}
+
+The non-linear bottom friction parameterisation assumes that the bottom 
+friction is quadratic: 
+\begin{equation} \label{Eq_zdfbfr_nonlinear}
+{\cal F}_h^\textbf{U} = \frac{A^{vm}}{e_3 }\frac{\partial \textbf {U}_h 
+}{\partial k}=C_D \;\sqrt {u_b ^2+v_b ^2+e_b } \;\; \textbf {U}_h^b 
+\end{equation}
+where $C_D$ is a drag coefficient, and $e_b $ a bottom turbulent kinetic energy 
+due to tides, internal waves breaking and other short time scale currents. 
+A typical value of the drag coefficient is $C_D = 10^{-3} $. As an example, 
+the CME experiment \citep{Treguier_JGR92} uses $C_D = 10^{-3}$ and 
+$e_b = 2.5\;10^{-3}$m$^2$\;s$^{-2}$, while the FRAM experiment \citep{Killworth1992} 
+uses $C_D = 1.4\;10^{-3}$ and $e_b =2.5\;\;10^{-3}$m$^2$\;s$^{-2}$. 
+The CME choices have been set as default values (\np{rn\_bfri2} and \np{rn\_bfeb2} 
+namelist parameters).
+
+As for the linear case, the bottom friction is imposed in the code by 
+adding the trend due to the bottom friction to the general momentum trend 
+in \mdl{dynbfr}.
+For the non-linear friction case the terms
+computed in \mdl{zdfbfr}  are: 
+\begin{equation} \label{Eq_zdfbfr_nonlinbfr}
+\begin{split}
+ c_b^u &= - \; C_D\;\left[ u^2 + \left(\bar{\bar{v}}^{i+1,j}\right)^2 + e_b \right]^{1/2}\\
+ c_b^v &= - \; C_D\;\left[  \left(\bar{\bar{u}}^{i,j+1}\right)^2 + v^2 + e_b \right]^{1/2}\\
+\end{split}
+\end{equation}
+
+The coefficients that control the strength of the non-linear bottom friction are
+initialised as namelist parameters: $C_D$= \np{rn\_bfri2}, and $e_b$ =\np{rn\_bfeb2}.
+Note for applications which treat tides explicitly a low or even zero value of
+\np{rn\_bfeb2} is recommended. From v3.2 onwards a local enhancement of $C_D$ is possible
+via an externally defined 2D mask array (\np{ln\_bfr2d}=true).  This works in the same way
+as for the linear bottom friction case with non-zero masked locations increased by
+$mask\_value$*\np{rn\_bfrien}*\np{rn\_bfri2}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Bottom Friction Log-layer
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Log-layer Bottom Friction enhancement (\np{nn\_botfr} = 2, \np{ln\_loglayer} = .true.)}
+\label{ZDF_bfr_loglayer}
+
+In the non-linear bottom friction case, the drag coefficient, $C_D$, can be optionally
+enhanced using a "law of the wall" scaling. If  \np{ln\_loglayer} = .true., $C_D$ is no
+longer constant but is related to the thickness of the last wet layer in each column by:
+
+\begin{equation}
+C_D = \left ( {\kappa \over {\rm log}\left ( 0.5e_{3t}/rn\_bfrz0 \right ) } \right )^2
+\end{equation}
+
+\noindent where $\kappa$ is the von-Karman constant and \np{rn\_bfrz0} is a roughness
+length provided via the namelist.
+
+For stability, the drag coefficient is bounded such that it is kept greater or equal to
+the base \np{rn\_bfri2} value and it is not allowed to exceed the value of an additional
+namelist parameter: \np{rn\_bfri2\_max}, i.e.:
+
+\begin{equation}
+rn\_bfri2 \leq C_D \leq rn\_bfri2\_max
+\end{equation}
+
+\noindent Note also that a log-layer enhancement can also be applied to the top boundary
+friction if under ice-shelf cavities are in use (\np{ln\_isfcav}=.true.).  In this case, the
+relevant namelist parameters are \np{rn\_tfrz0}, \np{rn\_tfri2}
+and \np{rn\_tfri2\_max}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Bottom Friction stability
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Bottom Friction stability considerations}
+\label{ZDF_bfr_stability}
+
+Some care needs to exercised over the choice of parameters to ensure that the
+implementation of bottom friction does not induce numerical instability. For 
+the purposes of stability analysis, an approximation to \eqref{Eq_zdfbfr_flux2}
+is:
+\begin{equation} \label{Eqn_bfrstab}
+\begin{split}
+ \Delta u &= -\frac{{{\cal F}_h}^u}{e_{3u}}\;2 \rdt    \\
+               &= -\frac{ru}{e_{3u}}\;2\rdt\\
+\end{split}
+\end{equation}
+\noindent where linear bottom friction and a leapfrog timestep have been assumed. 
+To ensure that the bottom friction cannot reverse the direction of flow it is necessary to have:
+\begin{equation}
+ |\Delta u| < \;|u| 
+\end{equation}
+\noindent which, using \eqref{Eqn_bfrstab}, gives:
+\begin{equation}
+r\frac{2\rdt}{e_{3u}} < 1 \qquad  \Rightarrow \qquad r < \frac{e_{3u}}{2\rdt}\\
+\end{equation}
+This same inequality can also be derived in the non-linear bottom friction case 
+if a velocity of 1 m.s$^{-1}$ is assumed. Alternatively, this criterion can be 
+rearranged to suggest a minimum bottom box thickness to ensure stability:
+\begin{equation}
+e_{3u} > 2\;r\;\rdt
+\end{equation}
+\noindent which it may be necessary to impose if partial steps are being used. 
+For example, if $|u| = 1$ m.s$^{-1}$, $rdt = 1800$ s, $r = 10^{-3}$ then
+$e_{3u}$ should be greater than 3.6 m. For most applications, with physically
+sensible parameters these restrictions should not be of concern. But 
+caution may be necessary if attempts are made to locally enhance the bottom
+friction parameters. 
+To ensure stability limits are imposed on the bottom friction coefficients both during 
+initialisation and at each time step. Checks at initialisation are made in \mdl{zdfbfr} 
+(assuming a 1 m.s$^{-1}$ velocity in the non-linear case).
+The number of breaches of the stability criterion are reported as well as the minimum 
+and maximum values that have been set. The criterion is also checked at each time step, 
+using the actual velocity, in \mdl{dynbfr}. Values of the bottom friction coefficient are 
+reduced as necessary to ensure stability; these changes are not reported.
+
+Limits on the bottom friction coefficient are not imposed if the user has elected to
+handle the bottom friction implicitly (see \S\ref{ZDF_bfr_imp}). The number of potential
+breaches of the explicit stability criterion are still reported for information purposes.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Implicit Bottom Friction
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Implicit Bottom Friction (\np{ln\_bfrimp}$=$\textit{T})}
+\label{ZDF_bfr_imp}
+
+An optional implicit form of bottom friction has been implemented to improve
+model stability. We recommend this option for shelf sea and coastal ocean applications, especially 
+for split-explicit time splitting. This option can be invoked by setting \np{ln\_bfrimp} 
+to \textit{true} in the \textit{nambfr} namelist. This option requires \np{ln\_zdfexp} to be \textit{false} 
+in the \textit{namzdf} namelist. 
+
+This implementation is realised in \mdl{dynzdf\_imp} and \mdl{dynspg\_ts}. In \mdl{dynzdf\_imp}, the 
+bottom boundary condition is implemented implicitly.
+
+\begin{equation} \label{Eq_dynzdf_bfr}
+\left.{\left( {\frac{A^{vm} }{e_3 }\ \frac{\partial \textbf{U}_h}{\partial k}} \right)} \right|_{mbk}
+	 = \binom{c_{b}^{u}u^{n+1}_{mbk}}{c_{b}^{v}v^{n+1}_{mbk}}
+\end{equation}
+
+where $mbk$ is the layer number of the bottom wet layer. superscript $n+1$ means the velocity used in the
+friction formula is to be calculated, so, it is implicit.
+
+If split-explicit time splitting is used, care must be taken to avoid the double counting of
+the bottom friction in the 2-D barotropic momentum equations. As NEMO only updates the barotropic 
+pressure gradient and Coriolis' forcing terms in the 2-D barotropic calculation, we need to remove
+the bottom friction induced by these two terms which has been included in the 3-D momentum trend 
+and update it with the latest value. On the other hand, the bottom friction contributed by the
+other terms (e.g. the advection term, viscosity term) has been included in the 3-D momentum equations
+and should not be added in the 2-D barotropic mode.
+
+The implementation of the implicit bottom friction in \mdl{dynspg\_ts} is done in two steps as the
+following:
+
+\begin{equation} \label{Eq_dynspg_ts_bfr1}
+\frac{\textbf{U}_{med}-\textbf{U}^{m-1}}{2\Delta t}=-g\nabla\eta-f\textbf{k}\times\textbf{U}^{m}+c_{b}
+\left(\textbf{U}_{med}-\textbf{U}^{m-1}\right)
+\end{equation}
+\begin{equation} \label{Eq_dynspg_ts_bfr2}
+\frac{\textbf{U}^{m+1}-\textbf{U}_{med}}{2\Delta t}=\textbf{T}+
+\left(g\nabla\eta^{'}+f\textbf{k}\times\textbf{U}^{'}\right)-
+2\Delta t_{bc}c_{b}\left(g\nabla\eta^{'}+f\textbf{k}\times\textbf{u}_{b}\right)
+\end{equation}
+
+where $\textbf{T}$ is the vertical integrated 3-D momentum trend. We assume the leap-frog time-stepping
+is used here. $\Delta t$ is the barotropic mode time step and $\Delta t_{bc}$ is the baroclinic mode time step.
+ $c_{b}$ is the friction coefficient. $\eta$ is the sea surface level calculated in the barotropic loops
+while $\eta^{'}$ is the sea surface level used in the 3-D baroclinic mode. $\textbf{u}_{b}$ is the bottom
+layer horizontal velocity.
+
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       Bottom Friction with split-explicit time splitting
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Bottom Friction with split-explicit time splitting (\np{ln\_bfrimp}$=$\textit{F})}
+\label{ZDF_bfr_ts}
+
+When calculating the momentum trend due to bottom friction in \mdl{dynbfr}, the
+bottom velocity at the before time step is used. This velocity includes both the
+baroclinic and barotropic components which is appropriate when using either the
+explicit or filtered surface pressure gradient algorithms (\key{dynspg\_exp} or 
+\key{dynspg\_flt}). Extra attention is required, however, when using 
+split-explicit time stepping (\key{dynspg\_ts}). In this case the free surface 
+equation is solved with a small time step \np{rn\_rdt}/\np{nn\_baro}, while the three 
+dimensional prognostic variables are solved with the longer time step 
+of \np{rn\_rdt} seconds. The trend in the barotropic momentum due to bottom 
+friction appropriate to this method is that given by the selected parameterisation 
+($i.e.$ linear or non-linear bottom friction) computed with the evolving velocities 
+at each barotropic timestep. 
+
+In the case of non-linear bottom friction, we have elected to partially linearise 
+the problem by keeping the coefficients fixed throughout the barotropic 
+time-stepping to those computed in \mdl{zdfbfr} using the now timestep. 
+This decision allows an efficient use of the $c_b^{\vect{U}}$ coefficients to:
+
+\begin{enumerate}
+\item On entry to \rou{dyn\_spg\_ts}, remove the contribution of the before
+barotropic velocity to the bottom friction component of the vertically
+integrated momentum trend. Note the same stability check that is carried out 
+on the bottom friction coefficient in \mdl{dynbfr} has to be applied here to
+ensure that the trend removed matches that which was added in \mdl{dynbfr}.
+\item At each barotropic step, compute the contribution of the current barotropic
+velocity to the trend due to bottom friction. Add this contribution to the
+vertically integrated momentum trend. This contribution is handled implicitly which
+eliminates the need to impose a stability criteria on the values of the bottom friction
+coefficient within the barotropic loop. 
+\end{enumerate}
+
+Note that the use of an implicit formulation within the barotropic loop
+for the bottom friction trend means that any limiting of the bottom friction coefficient 
+in \mdl{dynbfr} does not adversely affect the solution when using split-explicit time 
+splitting. This is because the major contribution to bottom friction is likely to come from 
+the barotropic component which uses the unrestricted value of the coefficient. However, if the
+limiting is thought to be having a major effect (a more likely prospect in coastal and shelf seas
+applications) then the fully implicit form of the bottom friction should be used (see \S\ref{ZDF_bfr_imp} ) 
+which can be selected by setting \np{ln\_bfrimp} $=$ \textit{true}.
+
+Otherwise, the implicit formulation takes the form:
+\begin{equation} \label{Eq_zdfbfr_implicitts}
+ \bar{U}^{t+ \rdt} = \; \left [ \bar{U}^{t-\rdt}\; + 2 \rdt\;RHS \right ] / \left [ 1 - 2 \rdt \;c_b^{u} / H_e \right ]  
+\end{equation}
+where $\bar U$ is the barotropic velocity, $H_e$ is the full depth (including sea surface height), 
+$c_b^u$ is the bottom friction coefficient as calculated in \rou{zdf\_bfr} and $RHS$ represents 
+all the components to the vertically integrated momentum trend except for that due to bottom friction.
+
+
+
+
+% ================================================================
+% Tidal Mixing
+% ================================================================
+\section{Tidal Mixing (\key{zdftmx})}
+\label{ZDF_tmx}
+
+%--------------------------------------------namzdf_tmx--------------------------------------------------
+\namdisplay{namzdf_tmx}
+%--------------------------------------------------------------------------------------------------------------
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Bottom intensified tidal mixing 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Bottom intensified tidal mixing}
+\label{ZDF_tmx_bottom}
+
+Options are defined through the  \ngn{namzdf\_tmx} namelist variables.
+The parameterization of tidal mixing follows the general formulation for 
+the vertical eddy diffusivity proposed by \citet{St_Laurent_al_GRL02} and 
+first introduced in an OGCM by \citep{Simmons_al_OM04}. 
+In this formulation an additional vertical diffusivity resulting from internal tide breaking, 
+$A^{vT}_{tides}$ is expressed as a function of $E(x,y)$, the energy transfer from barotropic 
+tides to baroclinic tides : 
+\begin{equation} \label{Eq_Ktides}
+A^{vT}_{tides} =  q \,\Gamma \,\frac{ E(x,y) \, F(z) }{ \rho \, N^2 }
+\end{equation}
+where $\Gamma$ is the mixing efficiency, $N$ the Brunt-Vais\"{a}l\"{a} frequency 
+(see \S\ref{TRA_bn2}), $\rho$ the density, $q$ the tidal dissipation efficiency, 
+and $F(z)$ the vertical structure function. 
+
+The mixing efficiency of turbulence is set by $\Gamma$ (\np{rn\_me} namelist parameter)
+and is usually taken to be the canonical value of $\Gamma = 0.2$ (Osborn 1980). 
+The tidal dissipation efficiency is given by the parameter $q$ (\np{rn\_tfe} namelist parameter) 
+represents the part of the internal wave energy flux $E(x, y)$ that is dissipated locally, 
+with the remaining $1-q$ radiating away as low mode internal waves and 
+contributing to the background internal wave field. A value of $q=1/3$ is typically used  
+\citet{St_Laurent_al_GRL02}.
+The vertical structure function $F(z)$ models the distribution of the turbulent mixing in the vertical. 
+It is implemented as a simple exponential decaying upward away from the bottom, 
+with a vertical scale of $h_o$ (\np{rn\_htmx} namelist parameter, with a typical value of $500\,m$) \citep{St_Laurent_Nash_DSR04}, 
+\begin{equation} \label{Eq_Fz}
+F(i,j,k) = \frac{ e^{ -\frac{H+z}{h_o} } }{ h_o \left( 1- e^{ -\frac{H}{h_o} } \right) }
+\end{equation}
+and is normalized so that vertical integral over the water column is unity. 
+
+The associated vertical viscosity is calculated from the vertical 
+diffusivity assuming a Prandtl number of 1, $i.e.$ $A^{vm}_{tides}=A^{vT}_{tides}$. 
+In the limit of $N \rightarrow 0$ (or becoming negative), the vertical diffusivity 
+is capped at $300\,cm^2/s$ and impose a lower limit on $N^2$ of \np{rn\_n2min} 
+usually set to $10^{-8} s^{-2}$. These bounds are usually rarely encountered.
+
+The internal wave energy map, $E(x, y)$ in \eqref{Eq_Ktides}, is derived 
+from a barotropic model of the tides utilizing a parameterization of the 
+conversion of barotropic tidal energy into internal waves. 
+The essential goal of the parameterization is to represent the momentum 
+exchange between the barotropic tides and the unrepresented internal waves 
+induced by the tidal flow over rough topography in a stratified ocean. 
+In the current version of \NEMO, the map is built from the output of 
+the barotropic global ocean tide model MOG2D-G \citep{Carrere_Lyard_GRL03}.
+This model provides the dissipation associated with internal wave energy for the M2 and K1 
+tides component (Fig.~\ref{Fig_ZDF_M2_K1_tmx}). The S2 dissipation is simply approximated
+as being $1/4$ of the M2 one. The internal wave energy is thus : $E(x, y) = 1.25 E_{M2} + E_{K1}$. 
+Its global mean value is $1.1$ TW, in agreement with independent estimates 
+\citep{Egbert_Ray_Nat00, Egbert_Ray_JGR01}. 
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	\begin{center}
+\includegraphics[width=0.90\textwidth]{Fig_ZDF_M2_K1_tmx}
+\caption{  \label{Fig_ZDF_M2_K1_tmx} 
+(a) M2 and (b) K1 internal wave drag energy from \citet{Carrere_Lyard_GRL03} ($W/m^2$). }
+\end{center}  	\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
+ 
+% -------------------------------------------------------------------------------------------------------------
+%        Indonesian area specific treatment 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Indonesian area specific treatment (\np{ln\_zdftmx\_itf})}
+\label{ZDF_tmx_itf}
+
+When the Indonesian Through Flow (ITF) area is included in the model domain,
+a specific treatment of tidal induced mixing in this area can be used. 
+It is activated through the namelist logical \np{ln\_tmx\_itf}, and the user must provide
+an input NetCDF file, \ifile{mask\_itf}, which contains a mask array defining the ITF area
+where the specific treatment is applied.
+
+When \np{ln\_tmx\_itf}=true, the two key parameters $q$ and $F(z)$ are adjusted following 
+the parameterisation developed by \citet{Koch-Larrouy_al_GRL07}:
+
+First, the Indonesian archipelago is a complex geographic region 
+with a series of large, deep, semi-enclosed basins connected via 
+numerous narrow straits. Once generated, internal tides remain 
+confined within this semi-enclosed area and hardly radiate away. 
+Therefore all the internal tides energy is consumed within this area. 
+So it is assumed that $q = 1$, $i.e.$ all the energy generated is available for mixing.
+Note that for test purposed, the ITF tidal dissipation efficiency is a 
+namelist parameter (\np{rn\_tfe\_itf}). A value of $1$ or close to is
+this recommended for this parameter.
+
+Second, the vertical structure function, $F(z)$, is no more associated
+with a bottom intensification of the mixing, but with a maximum of 
+energy available within the thermocline. \citet{Koch-Larrouy_al_GRL07} 
+have suggested that the vertical distribution of the energy dissipation 
+proportional to $N^2$ below the core of the thermocline and to $N$ above. 
+The resulting $F(z)$ is:
+\begin{equation} \label{Eq_Fz_itf}
+F(i,j,k) \sim     \left\{ \begin{aligned}
+\frac{q\,\Gamma E(i,j) } {\rho N \, \int N     dz}    \qquad \text{when $\partial_z N < 0$} \\
+\frac{q\,\Gamma E(i,j) } {\rho     \, \int N^2 dz}    \qquad \text{when $\partial_z N > 0$}
+                      \end{aligned} \right.
+\end{equation}
+
+Averaged over the ITF area, the resulting tidal mixing coefficient is $1.5\,cm^2/s$, 
+which agrees with the independent estimates inferred from observations. 
+Introduced in a regional OGCM, the parameterization improves the water mass 
+characteristics in the different Indonesian seas, suggesting that the horizontal 
+and vertical distributions of the mixing are adequately prescribed 
+\citep{Koch-Larrouy_al_GRL07, Koch-Larrouy_al_OD08a, Koch-Larrouy_al_OD08b}.
+Note also that such a parameterisation has a significant impact on the behaviour 
+of global coupled GCMs \citep{Koch-Larrouy_al_CD10}.
+
+
+% ================================================================
+% Internal wave-driven mixing
+% ================================================================
+\section{Internal wave-driven mixing (\key{zdftmx\_new})}
+\label{ZDF_tmx_new}
+
+%--------------------------------------------namzdf_tmx_new------------------------------------------
+\namdisplay{namzdf_tmx_new}
+%--------------------------------------------------------------------------------------------------------------
+
+The parameterization of mixing induced by breaking internal waves is a generalization 
+of the approach originally proposed by \citet{St_Laurent_al_GRL02}. 
+A three-dimensional field of internal wave energy dissipation $\epsilon(x,y,z)$ is first constructed, 
+and the resulting diffusivity is obtained as 
+\begin{equation} \label{Eq_Kwave}
+A^{vT}_{wave} =  R_f \,\frac{ \epsilon }{ \rho \, N^2 }
+\end{equation}
+where $R_f$ is the mixing efficiency and $\epsilon$ is a specified three dimensional distribution 
+of the energy available for mixing. If the \np{ln\_mevar} namelist parameter is set to false, 
+the mixing efficiency is taken as constant and equal to 1/6 \citep{Osborn_JPO80}. 
+In the opposite (recommended) case, $R_f$ is instead a function of the turbulence intensity parameter 
+$Re_b = \frac{ \epsilon}{\nu \, N^2}$, with $\nu$ the molecular viscosity of seawater, 
+following the model of \cite{Bouffard_Boegman_DAO2013} 
+and the implementation of \cite{de_lavergne_JPO2016_efficiency}.
+Note that $A^{vT}_{wave}$ is bounded by $10^{-2}\,m^2/s$, a limit that is often reached when the mixing efficiency is constant.
+
+In addition to the mixing efficiency, the ratio of salt to heat diffusivities can chosen to vary 
+as a function of $Re_b$ by setting the \np{ln\_tsdiff} parameter to true, a recommended choice). 
+This parameterization of differential mixing, due to \cite{Jackson_Rehmann_JPO2014}, 
+is implemented as in \cite{de_lavergne_JPO2016_efficiency}.
+
+The three-dimensional distribution of the energy available for mixing, $\epsilon(i,j,k)$, is constructed 
+from three static maps of column-integrated internal wave energy dissipation, $E_{cri}(i,j)$, 
+$E_{pyc}(i,j)$, and $E_{bot}(i,j)$, combined to three corresponding vertical structures 
+(de Lavergne et al., in prep):
+\begin{align*}
+F_{cri}(i,j,k) &\propto e^{-h_{ab} / h_{cri} }\\
+F_{pyc}(i,j,k) &\propto N^{n\_p}\\
+F_{bot}(i,j,k) &\propto N^2 \, e^{- h_{wkb} / h_{bot} }
+\end{align*} 
+In the above formula, $h_{ab}$ denotes the height above bottom, 
+$h_{wkb}$ denotes the WKB-stretched height above bottom, defined by
+\begin{equation*}
+h_{wkb} = H \, \frac{ \int_{-H}^{z} N \, dz' } { \int_{-H}^{\eta} N \, dz'  } \; ,
+\end{equation*}
+The $n_p$ parameter (given by \np{nn\_zpyc} in \ngn{namzdf\_tmx\_new} namelist)  controls the stratification-dependence of the pycnocline-intensified dissipation. 
+It can take values of 1 (recommended) or 2.
+Finally, the vertical structures $F_{cri}$ and $F_{bot}$ require the specification of 
+the decay scales $h_{cri}(i,j)$ and $h_{bot}(i,j)$, which are defined by two additional input maps. 
+$h_{cri}$ is related to the large-scale topography of the ocean (etopo2) 
+and $h_{bot}$ is a function of the energy flux $E_{bot}$, the characteristic horizontal scale of 
+the abyssal hill topography \citep{Goff_JGR2010} and the latitude.
+
+% ================================================================
+
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Introduction.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Introduction.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Introduction.tex	(revision 8732)
@@ -0,0 +1,270 @@
+\documentclass[NEMO_book]{subfiles}
+\begin{document}
+
+% ================================================================
+% INTRODUCTION
+% ================================================================
+
+\chapter{Introduction}
+
+The Nucleus for European Modelling of the Ocean (\NEMO) is a framework of ocean 
+related engines, namely OPA\footnote{OPA = Oc\'{e}an PArall\'{e}lis\'{e}} for the 
+ocean dynamics and thermodynamics, LIM\footnote{LIM= Louvain)la-neuve Ice 
+Model} for the sea-ice dynamics and thermodynamics, TOP\footnote{TOP = Tracer 
+in the Ocean Paradigm} for the biogeochemistry (both transport (TRP) and sources 
+minus sinks (LOBSTER, PISCES)\footnote{Both LOBSTER and PISCES are not 
+acronyms just name}. It is intended to be a flexible tool for studying the ocean and 
+its interactions with the other components of the earth climate system (atmosphere, 
+sea-ice, biogeochemical tracers, ...) over a wide range of space and time scales. 
+This documentation provides information about the physics represented by the ocean 
+component of \NEMO and the rationale for the choice of numerical schemes and 
+the model design. More specific information about running the model on different 
+computers, or how to set up a configuration, are found on the \NEMO web site 
+(www.nemo-ocean.eu). 
+
+The ocean component of \NEMO has been developed from the OPA model, 
+release 8.2, described in \citet{Madec1998}. This model has been used for a wide 
+range of applications, both regional or global, as a forced ocean model and as a 
+model coupled with the sea-ice and/or the atmosphere.  
+
+This manual is organised in as follows. Chapter~\ref{PE} presents the model basics, 
+$i.e.$ the equations and their assumptions, the vertical coordinates used, and the 
+subgrid scale physics. This part deals with the continuous equations of the model 
+(primitive equations, with temperature, salinity and an equation of seawater). 
+The equations are written in a curvilinear coordinate system, with a choice of vertical 
+coordinates ($z$, $s$, \textit{z*}, \textit{s*}, $\tilde{z}$, $\tilde{s}$, and a mixture of them). 
+Momentum equations are formulated in vector invariant or flux form. 
+Dimensional units in the meter, kilogram, second (MKS) international system 
+are used throughout.
+
+The following chapters deal with the discrete equations. Chapter~\ref{STP} presents the 
+time domain. The model time stepping environment is a three level scheme in which 
+the tendency terms of the equations are evaluated either centered  in time, or forward, 
+or backward depending of the nature of the term.
+Chapter~\ref{DOM} presents the space domain. The model is discretised on a staggered 
+grid (Arakawa C grid) with masking of land areas. Vertical discretisation used depends 
+on both how the bottom topography is represented and whether the free surface is linear or not. 
+Full step or partial step $z$-coordinate or $s$- (terrain-following) coordinate is used 
+with linear free surface (level position are then fixed in time). In non-linear free surface, 
+the corresponding rescaled height coordinate formulation (\textit{z*} or \textit{s*}) is used 
+(the level position then vary in time as a function of the sea surface heigh). 
+The following two chapters (\ref{TRA} and \ref{DYN}) describe the discretisation of the 
+prognostic equations for the active tracers and the momentum. Explicit, split-explicit 
+and filtered free surface formulations are implemented. 
+A number of numerical schemes are available for momentum advection, for the computation 
+of the pressure gradients, as well as for the advection of tracers (second or higher 
+order advection schemes, including positive ones).
+
+Surface boundary conditions (chapter~\ref{SBC}) can be implemented as prescribed
+fluxes, or bulk formulations for the surface fluxes (wind stress, heat, freshwater). The 
+model allows penetration of solar radiation  There is an optional geothermal heating at 
+the ocean bottom. Within the \NEMO system the ocean model is interactively coupled 
+with a sea ice model (LIM) and with biogeochemistry models (PISCES, LOBSTER). 
+Interactive coupling to Atmospheric models is possible via the OASIS coupler 
+\citep{OASIS2006}. Two-way nesting is also available through an interface to the
+AGRIF package (Adaptative Grid Refinement in \textsc{Fortran}) \citep{Debreu_al_CG2008}.
+The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008})
+has now been upgraded so that it works for both global and regional domains, although AGRIF 
+is still not available.
+
+Other model characteristics are the lateral boundary conditions (chapter~\ref{LBC}).  
+Global configurations of the model make use of the ORCA tripolar grid, with special north 
+fold boundary condition. Free-slip or no-slip boundary conditions are allowed at land 
+boundaries. Closed basin geometries as well as periodic domains and open boundary 
+conditions are possible. 
+
+Physical parameterisations are described in chapters~\ref{LDF} and \ref{ZDF}. The 
+model includes an implicit treatment of vertical viscosity and diffusivity. The lateral 
+Laplacian and biharmonic viscosity and diffusion can be rotated following a geopotential 
+or neutral direction. There is an optional eddy induced velocity \citep{Gent1990} with a 
+space and time variable coefficient \citet{Treguier1997}. The model has vertical harmonic 
+viscosity and diffusion with a space and time variable coefficient, with options to compute 
+the coefficients with \citet{Blanke1993}, \citet{Pacanowski_Philander_JPO81}, 
+or \citet{Umlauf_Burchard_JMS03} mixing schemes.
+ \vspace{1cm}
+ 
+%%gm    To be put somewhere else ....
+
+\noindent CPP keys and namelists are used for inputs to the code.  \newline
+
+\noindent \index{CPP keys} CPP keys \newline
+Some CPP keys are implemented in the FORTRAN code to allow code selection at compiling step. This selection of code at compilation time reduces the reliability of the whole platform since it changes the code from one set of CPP keys to the other. It is used only when the addition/suppression of the part of code highly changes the amount of memory at run time.
+Usual coding looks like : 
+ \vspace{-10pt}
+\begin{alltt}
+\tiny  
+\begin{verbatim}
+#if defined key_option1    
+	          This part of the FORTRAN code will be active   
+	          only if key_option1 is activated at compiling step 
+#endif  
+\end{verbatim} 
+\end{alltt}     
+
+
+\noindent \index{Namelist} Namelists
+
+The namelist allows to input variables (character, logical, real and integer) into the code. There is one namelist file for each component of NEMO (dynamics, sea-ice, biogeochemistry...) containing all the FOTRAN namelists needed. The implementation in NEMO uses a two step process. For each FORTRAN namelist, two files are read:
+\begin{enumerate}
+\item A reference namelist ( in \textit{CONFIG/SHARED/namelist\_ref} ) is read first. This file contains all the namelist variables which are initialised to default values  
+\item A configuration namelist ( in \textit{CONFIG/CFG\_NAME/EXP00/namelist\_cfg} ) is read aferwards. This file contains only the namelist variables which are changed from default values, and overwrites those.
+\end{enumerate}
+A template can be found in \textit{NEMO/OPA\_SRC/module.example}
+The effective namelist, taken in account during the run, is stored at execution time in an output\_namelist\_dyn (or \_ice or \_top) file.
+ \vspace{1cm}
+
+%%gm  end
+
+Model outputs management and specific online diagnostics are described in chapters~\ref{DIA}.
+The diagnostics includes the output of all the tendencies of the momentum and tracers equations, 
+the output of tracers tendencies averaged over the time evolving mixed layer, the output of 
+the tendencies of the barotropic vorticity equation, the computation of on-line floats trajectories... 
+Chapter~\ref{OBS} describes a tool which reads in observation files (profile temperature 
+and salinity, sea surface temperature, sea level anomaly and sea ice concentration) 
+and calculates an interpolated model equivalent value at the observation location 
+and nearest model timestep. Originally developed of data assimilation, it is a fantastic 
+tool for model and data comparison. Chapter~\ref{ASM} describes how increments 
+produced by data assimilation may be applied to the model equations.
+Finally, Chapter~\ref{CFG} provides a brief introduction to the pre-defined model 
+configurations (water column model, ORCA and GYRE families of configurations).
+
+The model is implemented in \textsc{Fortran 90}, with preprocessing (C-pre-processor). 
+It runs under UNIX. It is optimized for vector computers and parallelised by domain  
+decomposition with MPI. All input and output is done in NetCDF (Network Common Data 
+Format) with a optional direct access format for output. To ensure the clarity and 
+readability of the code it is necessary to follow coding rules. The coding rules for OPA 
+include conventions for naming variables, with different starting letters for different types 
+of variables (real, integer, parameter\ldots). Those rules are briefly presented in 
+Appendix~\ref{Apdx_D} and a more complete document is available on the \NEMO web site.
+
+The model is organized with a high internal modularity based on physics. For example, 
+each trend ($i.e.$, a term in the RHS of the prognostic equation) for momentum and 
+tracers is computed in a dedicated module.  To make it easier for the user to find his way 
+around the code, the module names follow a three-letter rule. For example, \mdl{traldf} 
+is a module related to the TRAcers equation, computing the Lateral DiFfussion. 
+%The complete list of module names is presented in Appendix~\ref{Apdx_D}.      %====>>>> to be done !
+Furthermore, modules are organized in a few directories that correspond to their category, 
+as indicated by the first three letters of their name (Tab.~\ref{Tab_chap}). 
+
+The manual mirrors the organization of the model. 
+After the presentation of the continuous equations (Chapter \ref{PE}), the following chapters 
+refer to specific terms of the equations each associated with a group of modules (Tab.~\ref{Tab_chap}).
+
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[!t]	
+%\begin{center} \begin{tabular}{|p{143pt}|l|l|}	\hline
+\caption{ \label{Tab_chap}   Organization of Chapters mimicking the one of the model directories. }
+\begin{center} 	\begin{tabular}{|l|l|l|}	\hline
+Chapter \ref{STP}	& -   		        & model time STePping environment \\		\hline
+Chapter \ref{DOM}	& DOM		& model DOMain \\		\hline
+Chapter \ref{TRA}	& TRA		& TRAcer equations (potential temperature and salinity) \\   \hline
+Chapter \ref{DYN}	& DYN		& DYNamic equations (momentum) \\		\hline
+Chapter \ref{SBC} 	& SBC		& Surface Boundary Conditions \\			\hline
+Chapter \ref{LBC}	& LBC		& Lateral Boundary Conditions (also OBC and BDY)  \\ 		\hline
+Chapter \ref{LDF}	& LDF		& Lateral DiFfusion (parameterisations) \\	\hline
+Chapter \ref{ZDF}	& ZDF		& vertical (Z) DiFfusion (parameterisations)  \\		\hline
+Chapter \ref{DIA}	& DIA		& I/O and DIAgnostics (also IOM, FLO and TRD) \\		\hline
+Chapter \ref{OBS}	& OBS		& OBServation and model comparison  \\		\hline
+Chapter \ref{ASM}	& ASM		& ASsiMilation increment  \\		\hline
+Chapter \ref{MISC}	& SOL		& Miscellaneous  topics (including solvers)  \\       \hline
+Chapter \ref{CFG}	&  - 			& predefined configurations (including C1D) \\		\hline
+\end{tabular} 	
+\end{center}	\end{table}
+%--------------------------------------------------------------------------------------------------------------
+
+
+\subsubsection{Changes between releases}
+NEMO/OPA, like all research tools, is in perpetual evolution. The present document describes 
+the OPA version include in the release 3.4 of NEMO.  This release differs significantly
+from version 8, documented in \citet{Madec1998}.\\
+
+$\bullet$ The main modifications from OPA v8 and NEMO/OPA v3.2 are :\\
+\begin{enumerate}
+\item transition to full native \textsc{Fortran} 90, deep code restructuring and drastic 
+reduction of CPP keys; 
+\item introduction of partial step representation of bottom topography \citep{Barnier_al_OD06, Le_Sommer_al_OM09, Penduff_al_OS07}; 
+\item partial reactivation of a terrain-following vertical coordinate ($s$- and hybrid $s$-$z$) 
+with the addition of several options for pressure gradient computation \footnote{Partial 
+support of $s$-coordinate: there is presently no support for neutral physics in $s$-
+coordinate and for the new options for horizontal pressure gradient computation with 
+a non-linear equation of state.}; 
+\item more choices for the treatment of the free surface: full explicit, split-explicit or filtered 
+schemes, and suppression of the rigid-lid option;
+\item non linear free surface associated with the rescaled height coordinate  
+\textit{z*} or  \textit{s}; 
+\item additional schemes for vector and flux forms of the momentum  advection; 
+\item additional advection schemes for tracers; 
+\item implementation of the AGRIF package (Adaptative Grid Refinement in \textsc{Fortran}) \citep{Debreu_al_CG2008}; 
+\item online diagnostics : tracers trend in the mixed layer and vorticity balance;
+\item rewriting of the I/O management with the use of an I/O server; 
+\item generalized ocean-ice-atmosphere-CO2 coupling interface, interfaced with OASIS 3 coupler ;
+\item surface module (SBC) that simplify the way the ocean is forced and include two
+bulk formulea (CLIO and CORE) and which includes an on-the-fly interpolation of input forcing fields ;
+\item RGB light penetration and optional use of ocean color 
+\item major changes in the TKE schemes: it now includes a Langmuir cell parameterization  \citep{Axell_JGR02}, 
+the \citet{Mellor_Blumberg_JPO04} surface wave breaking parameterization, and has a time discretization 
+which is energetically consistent with the ocean model equations \citep{Burchard_OM02, Marsaleix_al_OM08}; 
+\item tidal mixing parametrisation (bottom intensification) + Indonesian specific tidal mixing \citep{Koch-Larrouy_al_GRL07}; 
+\item introduction of LIM-3, the new Louvain-la-Neuve sea-ice model (C-grid rheology and
+new thermodynamics including bulk ice salinity) \citep{Vancoppenolle_al_OM09a, Vancoppenolle_al_OM09b}
+\end{enumerate}
+
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.2 and  v3.3 are :\\
+\begin{enumerate}
+\item introduction of a modified leapfrog-Asselin filter time stepping scheme \citep{Leclair_Madec_OM09}; 
+\item additional scheme for iso-neutral mixing \citep{Griffies_al_JPO98}, although it is still a "work in progress"; 
+\item a rewriting of the bottom boundary layer scheme, following \citet{Campin_Goosse_Tel99}; 
+\item addition of a Generic Length Scale vertical mixing scheme, following \citet{Umlauf_Burchard_JMS03}; 
+\item addition of the atmospheric pressure as an external forcing on both ocean and sea-ice dynamics; 
+\item addition of a diurnal cycle on solar radiation \citep{Bernie_al_CD07}; 
+\item river runoffs added through a non-zero depth, and having its own temperature and salinity; 
+\item CORE II normal year forcing set as the default forcing of ORCA2-LIM configuration ; 
+\item generalisation of the use of \mdl{fldread} for all input fields (ocean climatology, sea-ice damping...) ; 
+\item addition of an on-line observation and model comparison (thanks to NEMOVAR project); 
+\item optional application of an assimilation increment (thanks to NEMOVAR project); 
+\item coupling interface adjusted for WRF atmospheric model; 
+\item C-grid ice rheology now available fro both LIM-2 and LIM-3 \citep{Bouillon_al_OM09}; 
+\item LIM-3 ice-ocean momentum coupling applied to LIM-2 ; 
+\item a deep re-writting and simplification of the off-line tracer component (OFF\_SRC) ; 
+\item the merge of passive and active advection and diffusion modules ;
+\item  Use of the Flexible Configuration Manager (FCM) to build configurations, generate the Makefile and produce the executable ;
+\item Linear-tangent and Adjoint component (TAM) added, phased with v3.0
+\end{enumerate}
+ \vspace{1cm}
+In addition, several minor modifications in the coding have been introduced with the constant 
+concern of improving the model performance. 
+
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.3 and  v3.4 are :\\
+\begin{enumerate}
+\item finalisation of above iso-neutral mixing \citep{Griffies_al_JPO98}"; 
+\item "Neptune effect" parametrisation;
+\item horizontal pressure gradient suitable for s-coordinate; 
+\item semi-implicit bottom friction;
+\item finalisation of the merge of passive and active tracers advection-diffusion modules; 
+\item a new bulk formulae (so-called MFS);
+\item use fldread for the off-line tracer component (OFF\_SRC) ; 
+\item use MPI point to point communications  for north fold;
+\item diagnostic of transport ; 
+\end{enumerate}
+
+
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.4 and  v3.6 are :\\
+\begin{enumerate}
+\item ... ; 
+\end{enumerate}
+
+
+ \vspace{1cm}
+$\bullet$ The main modifications from NEMO/OPA v3.6 and  v4.0 are :\\
+\begin{enumerate}
+\item ... ; 
+
+
+\end{enumerate}
+
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Preamble.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Preamble.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Preamble.tex	(revision 8732)
@@ -0,0 +1,176 @@
+\documentclass[a4paper,11pt]{book}
+%\documentclass[a4paper,11pt,makeidx]{book} <== may need this to generate index
+
+%  makeindex NEMO_book  <== to regenerate the index
+%  bibtex    NEMO_book	<== to generate  the bibliography
+
+%\usepackage[french]{babel}
+%\usepackage{color}
+\usepackage{graphicx}			                   % allows insertion of pictures
+%\usepackage{graphics}			                   % allows insertion of pictures
+\graphicspath{{Figures/}}                                  % Set global directory for pictures
+%\DeclareGraphicsExtensions{.pdf,.eps}                      % Use .eps for LaTeX2HTML
+%\usepackage{xcolor}                                       % Incompatibility with color -> graphicx
+\usepackage[capbesideposition={top,center}]{floatrow}      % allows captions
+\floatsetup[table]{style=plaintop}                         % beside pictures
+\usepackage[margin=10pt,font={small},                      % Gives small font for captions
+labelsep=colon,labelfont={bf}]{caption}                    %
+\usepackage{enumitem}                                      % allows non-bold description items
+\usepackage{longtable}                                     % allows multipage tables
+%\usepackage{colortbl}                                     % gives coloured panels behind table columns
+
+%hyperref
+\usepackage[pdftitle={NEMO ocean engine},pdfauthor={Gurvan Madec},pdfstartview=FitH,
+bookmarks=true,bookmarksopen=true,breaklinks=true,colorlinks=true,
+linkcolor=blue,anchorcolor=blue,citecolor=blue,filecolor=blue,menucolor=blue,urlcolor=blue]{hyperref}
+% pdfsubject={The preprint document class
+%   elsart},% pdfkeywords={diapycnal diffusion,numerical mixing,z-level models},%%  usage of exteranl hyperlink :  \href{mailto:my_address@wikibooks.org}{my\_address@wikibooks.org}
+%                                                 \url{http://www.wikibooks.org}
+%                                     or         \href{http://www.wikibooks.org}{wikibooks home}
+
+
+%%%% page styles etc................
+\usepackage{fancyhdr}
+\pagestyle{fancy}
+% with this we ensure that the chapter and section
+% headings are in lowercase.
+\renewcommand{\chaptermark}[1]{\markboth{#1}{}}
+\renewcommand{\sectionmark}[1]{\markright{\thesection.\ #1}}
+\fancyhf{}             % delete current setting for header and footer
+\fancyhead[LE,RO]{\bfseries\thepage}
+\fancyhead[LO]{\bfseries\hspace{-0em}\rightmark}
+\fancyhead[RE]{\bfseries\leftmark}
+\renewcommand{\headrulewidth}{0.5pt}
+\renewcommand{\footrulewidth}{0pt  }
+\addtolength{\headheight}{2.6pt}   % make space for the rule
+%\addtolength{\headheight}{1.6pt}   % make space for the rule
+% get rid of headers on plain pages
+\fancypagestyle{plain}{\fancyhead{}\renewcommand{\headrulewidth}{0pt}}
+
+
+%%%%  Section number in Margin.......
+% typeset the number of each section in the left margin, with the start of each instance of
+% sectional heading text aligned with the left hand edge of  the body text.
+\makeatletter
+\def\@seccntformat#1{\protect\makebox[0pt][r]{\csname the#1\endcsname\quad}}
+\makeatother
+
+% Leave blank pages completely empty, w/o header
+\makeatletter
+\def\cleardoublepage{\clearpage\if@twoside \ifodd\c@page\else
+  \hbox{}
+  \vspace*{\fill}
+  \vspace{\fill}
+  \thispagestyle{empty}
+  \newpage
+  \if@twocolumn\hbox{}\newpage\fi\fi\fi}
+\makeatother
+
+%%%% define the chapter  style ................
+\usepackage{minitoc}				%In French : \usepackage[french]{minitoc}
+%\usepackage{mtcoff}				% invalidate the use of minitocs
+\usepackage{fancybox}
+
+\makeatletter
+\def\LigneVerticale{\vrule height 5cm depth 2cm\hspace{0.1cm}\relax}
+\def\LignesVerticales{%
+  \let\LV\LigneVerticale\LV\LV\LV\LV\LV\LV\LV\LV\LV\LV}
+\def\GrosCarreAvecUnChiffre#1{%
+  \rlap{\vrule height 0.8cm width 1cm depth 0.2cm}%
+ \rlap{\hbox to 1cm{\hss\mbox{\color{white} #1}\hss}}%
+  \vrule height 0pt width 1cm depth 0pt}
+\def\GrosCarreAvecTroisChiffre#1{%
+  \rlap{\vrule height 0.8cm width 1.6cm depth 0.2cm}%
+ \rlap{\hbox to 1.5cm{\hss\mbox{\color{white} #1}\hss}}%
+  \vrule height 0pt width 1cm depth 0pt}
+
+\def\@makechapterhead#1{\hbox{%
+   \huge
+    \LignesVerticales
+    \hspace{-0.5cm}%
+    \GrosCarreAvecUnChiffre{\thechapter}
+    \hspace{0.2cm}\hbox{#1}%
+%    \GrosCarreAvecTroisChiffre{\thechapter}
+%    \hspace{1cm}\hbox{#1}%
+%}\par\vskip 2cm}
+}\par\vskip 1cm}
+\def\@makeschapterhead#1{\hbox{%
+   \huge
+    \LignesVerticales
+    %\hspace{0.5cm}%
+    \hbox{#1}%
+}\par\vskip 2cm}
+\makeatother
+
+%\def\thechapter{\Roman{chapter}}   	% chapter number to be Roman
+
+
+%%%%           Mathematics...............
+%\documentclass{amsart}
+\usepackage{xspace}                              % helpd ensure correct spacing after macros
+\usepackage{latexsym,amssymb,amsmath}
+\allowdisplaybreaks[1]				% allow page breaks in the middle of equations
+\usepackage{TexFiles/Styles/math_abbrev}    % use maths shortcuts
+
+\usepackage{times}			 	 % use times font for text
+%\usepackage{mathtime}                          % font for illustrator to work (belleek fonts )
+%\usepackage[latin1]{inputenc}                % allows some unicode removed (agn)
+
+
+%%% essai commande
+\newcommand{\nl}[1]{\texttt{\small{\textcolor{blue}{#1}}}}
+\newcommand{\nlv}[1]{\texttt{\footnotesize#1}\xspace}
+\newcommand{\smnlv}[1]{\texttt{\scriptsize#1}\xspace}
+
+%%%% namelist & code display................................
+\usepackage{alltt,verbatim}  	%%  alltt & verbatim for namelist
+% namelists
+\newcommand{\namdisplay}[1]{\begin{alltt}{\tiny\verbatiminput{Namelists/#1}}\end{alltt}\vspace{-10pt}}
+\newcommand{\namtools}[1]{\begin{alltt}{\tiny\verbatiminput{Namelists/#1}}\end{alltt}\vspace{-10pt}}
+% code display
+%\newcommand{\codedisplay} [1] {\begin{alltt}{\tiny {\begin{verbatim} {#1}} \end{verbatim}} \end{alltt}      }
+
+
+
+%%%% commands for working with text................................
+% command to "comment out" portions of text ({} argument) or not ({#1} argument)
+\newcommand{\amtcomment}[1]{}   	% command to "commented out" portions of text or not (#1 in argument)
+\newcommand{\sgacomment}[1]{}   	% command to "commented out" portions of
+\newcommand{\gmcomment}[1]{}   	% command to "commented out" portions of
+\newcommand{\sfcomment}[1]{}   	% command to "commented out" portions of
+%                                    				% text that span line breaks
+%Red (NR) or Yellow(WARN)
+%\newcommand{\NR}   {\colorbox{red}   {#1}}
+%\newcommand{\WARN} {\colorbox{yellow}{#1}}
+
+
+
+%%% index commands......................
+\usepackage{makeidx}
+%\usepackage{showidx}				% show the index entry
+
+\newcommand{\mdl}[1]{\textit{#1.F90}\index{Modules!#1}}	%module (mdl)
+\newcommand{\rou}[1]{\textit{#1}\index{Routines!#1}}	%module (routine)
+\newcommand{\hf}[1]{\textit{#1.h90}\index{h90 file!#1}}	%module (h90 files)
+\newcommand{\ngn}[1]{\textit{#1}\index{Namelist Group Name!#1}}	%namelist name (nampar)
+\newcommand{\np}[1]{\textit{#1}\index{Namelist variables!#1}}        %namelist variable
+\newcommand{\jp}[1]{\textit{#1}\index{Model parameters!#1}}	%model parameter (jp)
+\newcommand{\pp}[1]{\textit{#1}\index{Model parameters!#1}} 	%namelist parameter (pp)
+\newcommand{\ifile}[1]{\textit{#1.nc  }\index{Input NetCDF files!#1.nc}}	%input NetCDF files (.nc)
+\newcommand{\key}[1]{\textbf{key\_#1}\index{CPP keys!key\_#1}}	%key_cpp (key)
+\newcommand{\NEMO}{\textit{NEMO}\xspace}	%NEMO (nemo)
+
+%%%%   Bibliography   .............
+\usepackage[nottoc,notlof,notlot]{tocbibind}
+\usepackage[square,comma]{natbib}
+\bibpunct{[}{]}{,}{a}{}{;}                           %suppress "," after "et al."
+\providecommand{\bibfont}{\small}
+
+\usepackage{subfiles}                          % Separate compilation of chapters from whole manual
+%\newcommand{\onlyinsubfile}[1]{#1}             % New commands for printing parts according to
+%\newcommand{\notinsubfile}[1]{}                % the file being compiled
+% Commands to use in the documentfile
+%\renewcommand{\onlyinsubfile}[1]{}                      % Appears only if chapter   .tex file is compiled
+%\renewcommand{\notinsubfile}[1]{#1}                     %    "    ""   "" NEMO_book .tex file is compiled
+
+\DeclareMathAlphabet{\mathpzc}{OT1}{pzc}{m}{it}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/NEMO.ist
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/NEMO.ist	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/NEMO.ist	(revision 8732)
@@ -0,0 +1,3 @@
+delim_0 "\\dotfill"
+delim_1 "\\dotfill"
+delim_2 "\\dotfill"
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/ametsoc.bst
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/ametsoc.bst	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/ametsoc.bst	(revision 8732)
@@ -0,0 +1,1662 @@
+%%
+%% This is file `ametsoc7.bst',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% merlin.mbs  (with options: `ay,nat,nm-rev1,ed-rev,jnrlst,nmdash,nmd-3,dt-beg,yr-com,yrp-col,thtit-a,vol-2bf,vnum-sp,volp-com,pgsep-s,num-xser,numser,ser-vol,bkpg-x,pg-bk,pre-edn,agu-doi,doi,edparc,bkedcap,edby,edbyy,blk-tit,in-x,pp,ed,abr,ednx,ord,jabr,eprint,url,url-nt,em-it,nfss,')
+%% ----------------------------------------
+%% *** Bibliography style file for ALL AMS Journals...version 1.0  ***
+%% *** Brian Papa - American Meteorological Society ***
+%% 
+%% Copyright 1994-2004 Patrick W Daly
+ % ===============================================================
+ % IMPORTANT NOTICE:
+ % This bibliographic style (bst) file has been generated from one or
+ % more master bibliographic style (mbs) files, listed above.
+ %
+ % This generated file can be redistributed and/or modified under the terms
+ % of the LaTeX Project Public License Distributed from CTAN
+ % archives in directory macros/latex/base/lppl.txt; either
+ % version 1 of the License, or any later version.
+ % ===============================================================
+ % Name and version information of the main mbs file:
+ % \ProvidesFile{merlin.mbs}[2004/02/09 4.13 (PWD, AO, DPC)]
+ %   For use with BibTeX version 0.99a or later
+ %-------------------------------------------------------------------
+ % This bibliography style file is intended for texts in ENGLISH
+ % This is an author-year citation style bibliography. As such, it is
+ % non-standard LaTeX, and requires a special package file to function properly.
+ % Such a package is    natbib.sty   by Patrick W. Daly
+ % The form of the \bibitem entries is
+ %   \bibitem[Jones et al.(1990)]{key}...
+ %   \bibitem[Jones et al.(1990)Jones, Baker, and Smith]{key}...
+ % The essential feature is that the label (the part in brackets) consists
+ % of the author names, as they should appear in the citation, with the year
+ % in parentheses following. There must be no space before the opening
+ % parenthesis!
+ % With natbib v5.3, a full list of authors may also follow the year.
+ % In natbib.sty, it is possible to define the type of enclosures that is
+ % really wanted (brackets or parentheses), but in either case, there must
+ % be parentheses in the label.
+ % The \cite command functions as follows:
+ %   \citet{key} ==>>                Jones et al. (1990)
+ %   \citet*{key} ==>>               Jones, Baker, and Smith (1990)
+ %   \citep{key} ==>>                (Jones et al., 1990)
+ %   \citep*{key} ==>>               (Jones, Baker, and Smith, 1990)
+ %   \citep[chap. 2]{key} ==>>       (Jones et al., 1990, chap. 2)
+ %   \citep[e.g.][]{key} ==>>        (e.g. Jones et al., 1990)
+ %   \citep[e.g.][p. 32]{key} ==>>   (e.g. Jones et al., p. 32)
+ %   \citeauthor{key} ==>>           Jones et al.
+ %   \citeauthor*{key} ==>>          Jones, Baker, and Smith
+ %   \citeyear{key} ==>>             1990
+ %---------------------------------------------------------------------
+
+ENTRY
+  { address
+    archive
+    author
+    booktitle
+    chapter
+    doi
+    edition
+    editor
+    eid
+    eprint
+    howpublished
+    department
+    institution
+    journal
+    key
+    month
+    note
+    number
+    organization
+    pages
+    publisher
+    school
+    series
+    title
+    type
+    url
+    volume
+    year
+  }
+  {}
+  { label extra.label sort.label short.list }
+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
+FUNCTION {init.state.consts}
+{ #0 'before.all :=
+  #1 'mid.sentence :=
+  #2 'after.sentence :=
+  #3 'after.block :=
+}
+STRINGS { s t}
+FUNCTION {output.nonnull}
+{ 's :=
+  output.state mid.sentence =
+    { ", " * write$ }
+    { output.state after.block =
+        { add.period$ write$
+          newline$
+          "\newblock " write$
+        }
+        { output.state before.all =
+            'write$
+            { add.period$ " " * write$ }
+          if$
+        }
+      if$
+      mid.sentence 'output.state :=
+    }
+  if$
+  s
+}
+FUNCTION {output}
+{ duplicate$ empty$
+    'pop$
+    'output.nonnull
+  if$
+}
+FUNCTION {output.check}
+{ 't :=
+  duplicate$ empty$
+    { pop$ "empty " t * " in " * cite$ * warning$ }
+    'output.nonnull
+  if$
+}
+FUNCTION {fin.entry}
+{ add.period$
+  write$
+  newline$
+}
+
+FUNCTION {new.block}
+{ output.state before.all =
+    'skip$
+    { after.block 'output.state := }
+  if$
+}
+FUNCTION {new.sentence}
+{ output.state after.block =
+    'skip$
+    { output.state before.all =
+        'skip$
+        { after.sentence 'output.state := }
+      if$
+    }
+  if$
+}
+FUNCTION {add.blank}
+{  " " * before.all 'output.state :=
+}
+
+FUNCTION {date.block}
+{
+  ":" *
+  add.blank
+}
+
+FUNCTION {not}
+{   { #0 }
+    { #1 }
+  if$
+}
+FUNCTION {and}
+{   'skip$
+    { pop$ #0 }
+  if$
+}
+FUNCTION {or}
+{   { pop$ #1 }
+    'skip$
+  if$
+}
+FUNCTION {new.block.checkb}
+{ empty$
+  swap$ empty$
+  and
+    'skip$
+    'new.block
+  if$
+}
+FUNCTION {field.or.null}
+{ duplicate$ empty$
+    { pop$ "" }
+    'skip$
+  if$
+}
+FUNCTION {emphasize}
+{ duplicate$ empty$
+    { pop$ "" }
+    { "\textit{" swap$ * "}" * }
+  if$
+}
+FUNCTION {bolden}
+{ duplicate$ empty$
+    { pop$ "" }
+    { "\textbf{" swap$ * "}" * }
+  if$
+}
+FUNCTION {tie.or.space.prefix}
+{ duplicate$ text.length$ #3 <
+    { "~" }
+    { " " }
+  if$
+  swap$
+}
+
+FUNCTION {capitalize}
+{ "u" change.case$ "t" change.case$ }
+
+FUNCTION {space.word}
+{ " " swap$ * " " * }
+ % Here are the language-specific definitions for explicit words.
+ % Each function has a name bbl.xxx where xxx is the English word.
+ % The language selected here is ENGLISH
+FUNCTION {bbl.and}
+{ "and"}
+
+FUNCTION {bbl.etal}
+{ "et~al." }
+
+FUNCTION {bbl.editors}
+{ "Eds." }
+
+FUNCTION {bbl.editor}
+{ "Ed." }
+
+FUNCTION {bbl.edby}
+{ "edited by" }
+
+FUNCTION {bbl.edition}
+{ "ed." }
+
+FUNCTION {bbl.volume}
+{ "Vol." }
+
+FUNCTION {bbl.of}
+{ "of" }
+
+FUNCTION {bbl.number}
+{ "No." }
+
+FUNCTION {bbl.nr}
+{ "No." }
+
+FUNCTION {bbl.in}
+{ "in" }
+
+FUNCTION {bbl.pages}
+{ "pp." }
+
+FUNCTION {bbl.page}
+{ "p." }
+
+FUNCTION {bbl.chapter}
+{ "chap." }
+
+FUNCTION {bbl.techrep}
+{ "Tech. Rep." }
+
+FUNCTION {bbl.mthesis}
+{ "Master's thesis" }
+
+FUNCTION {bbl.phdthesis}
+{ "Ph.D. thesis" }
+
+FUNCTION {bbl.first}
+{ "1st" }
+
+FUNCTION {bbl.second}
+{ "2d" }
+
+FUNCTION {bbl.third}
+{ "3d" }
+
+FUNCTION {bbl.fourth}
+{ "4th" }
+
+FUNCTION {bbl.fifth}
+{ "5th" }
+
+FUNCTION {bbl.st}
+{ "st" }
+
+FUNCTION {bbl.nd}
+{ "d" }
+
+FUNCTION {bbl.rd}
+{ "d" }
+
+FUNCTION {bbl.th}
+{ "th" }
+
+MACRO {jan} {"Jan."}
+
+MACRO {feb} {"Feb."}
+
+MACRO {mar} {"Mar."}
+
+MACRO {apr} {"Apr."}
+
+MACRO {may} {"May"}
+
+MACRO {jun} {"Jun."}
+
+MACRO {jul} {"Jul."}
+
+MACRO {aug} {"Aug."}
+
+MACRO {sep} {"Sep."}
+
+MACRO {oct} {"Oct."}
+
+MACRO {nov} {"Nov."}
+
+MACRO {dec} {"Dec."}
+
+FUNCTION {eng.ord}
+{ duplicate$ "1" swap$ *
+  #-2 #1 substring$ "1" =
+     { bbl.th * }
+     { duplicate$ #-1 #1 substring$
+       duplicate$ "1" =
+         { pop$ bbl.st * }
+         { duplicate$ "2" =
+             { pop$ bbl.nd * }
+             { "3" =
+                 { bbl.rd * }
+                 { bbl.th * }
+               if$
+             }
+           if$
+          }
+       if$
+     }
+   if$
+}
+
+MACRO {acmcs} {"ACM Comput. Surv."}
+
+MACRO {acta} {"Acta Inf."}
+
+MACRO {cacm} {"Commun. ACM"}
+
+MACRO {ibmjrd} {"IBM J. Res. Dev."}
+
+MACRO {ibmsj} {"IBM Syst.~J."}
+
+MACRO {ieeese} {"IEEE Trans. Software Eng."}
+
+MACRO {ieeetc} {"IEEE Trans. Comput."}
+
+MACRO {ieeetcad}
+ {"IEEE Trans. Comput. Aid. Des."}
+
+MACRO {ipl} {"Inf. Process. Lett."}
+
+MACRO {jacm} {"J.~ACM"}
+
+MACRO {jcss} {"J.~Comput. Syst. Sci."}
+
+MACRO {scp} {"Sci. Comput. Program."}
+
+MACRO {sicomp} {"SIAM J. Comput."}
+
+MACRO {tocs} {"ACM Trans. Comput. Syst."}
+
+MACRO {tods} {"ACM Trans. Database Syst."}
+
+MACRO {tog} {"ACM Trans. Graphic."}
+
+MACRO {toms} {"ACM Trans. Math. Software"}
+
+MACRO {toois} {"ACM Trans. Office Inf. Syst."}
+
+MACRO {toplas} {"ACM Trans. Progr. Lang. Syst."}
+
+MACRO {tcs} {"Theor. Comput. Sci."}
+
+FUNCTION {bibinfo.check}
+{ swap$
+  duplicate$ missing$
+    {
+      pop$ pop$
+      ""
+    }
+    { duplicate$ empty$
+        {
+          swap$ pop$
+        }
+        { swap$
+          pop$
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {bibinfo.warn}
+{ swap$
+  duplicate$ missing$
+    {
+      swap$ "missing " swap$ * " in " * cite$ * warning$ pop$
+      ""
+    }
+    { duplicate$ empty$
+        {
+          swap$ "empty " swap$ * " in " * cite$ * warning$
+        }
+        { swap$
+          pop$
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {format.eprint}
+{ eprint duplicate$ empty$
+    'skip$
+    { "\eprint"
+      archive empty$
+        'skip$
+        { "[" * archive * "]" * }
+      if$
+      "{" * swap$ * "}" *
+    }
+  if$
+}
+STRINGS  { bibinfo}
+INTEGERS { nameptr namesleft numnames }
+
+FUNCTION {format.names}
+{ 'bibinfo :=
+  duplicate$ empty$ 'skip$ {
+  's :=
+  "" 't :=
+  #1 'nameptr :=
+  s num.names$ 'numnames :=
+  numnames 'namesleft :=
+    { namesleft #0 > }
+    { s nameptr
+      duplicate$ #1 >
+        { "{f.~}{vv~}{ll}{, jj}" }
+        { "{vv~}{ll}{, f.}{, jj}" }
+      if$
+      format.name$
+      bibinfo bibinfo.check
+      't :=
+      nameptr #1 >
+        {
+          namesleft #1 >
+            { ", " * t * }
+            {
+              numnames #2 >
+                { "," * }
+                'skip$
+              if$
+              s nameptr "{ll}" format.name$ duplicate$ "others" =
+                { 't := }
+                { pop$ }
+              if$
+              t "others" =
+                {
+                  " " * bbl.etal *
+                }
+                {
+                  bbl.and
+                  space.word * t *
+                }
+              if$
+            }
+          if$
+        }
+        't
+      if$
+      nameptr #1 + 'nameptr :=
+      namesleft #1 - 'namesleft :=
+    }
+  while$
+  } if$
+}
+FUNCTION {format.names.ed}
+{
+  format.names
+}
+FUNCTION {format.key}
+{ empty$
+    { key field.or.null }
+    { "" }
+  if$
+}
+
+FUNCTION {format.authors}
+{ author "author" format.names
+}
+FUNCTION {get.bbl.editor}
+{ editor num.names$ #1 > 'bbl.editors 'bbl.editor if$ }
+
+FUNCTION {format.editors}
+{ editor "editor" format.names duplicate$ empty$ 'skip$
+    {
+      "," *
+      " " *
+      get.bbl.editor
+      capitalize
+   "(" swap$ * ")" *
+      *
+    }
+  if$
+}
+FUNCTION {format.book.pages}
+{ pages "pages" bibinfo.check
+  duplicate$ empty$ 'skip$
+    { " " * bbl.pages * }
+  if$
+}
+FUNCTION {format.doi}
+{ doi "doi" bibinfo.check
+  duplicate$ empty$ 'skip$
+    {
+      "\doi{" swap$ * "}" *
+    }
+  if$
+}
+FUNCTION {format.note}
+{
+  url empty$
+    'skip$
+    { "\urlprefix\url{" url * "}" * output }
+  if$
+ note empty$
+    { "" }
+    { note #1 #1 substring$
+      duplicate$ "{" =
+        'skip$
+        { output.state mid.sentence =
+          { "l" }
+          { "u" }
+        if$
+        change.case$
+        }
+      if$
+      note #2 global.max$ substring$ * "note" bibinfo.check
+    }
+  if$
+}
+
+FUNCTION {format.title}
+{ title
+  duplicate$ empty$ 'skip$
+    { "t" change.case$ }
+  if$
+  "title" bibinfo.check
+}
+FUNCTION {format.full.names}
+{'s :=
+ "" 't :=
+  #1 'nameptr :=
+  s num.names$ 'numnames :=
+  numnames 'namesleft :=
+    { namesleft #0 > }
+    { s nameptr
+      "{vv~}{ll}" format.name$
+      't :=
+      nameptr #1 >
+        {
+          namesleft #1 >
+            { ", " * t * }
+            {
+              s nameptr "{ll}" format.name$ duplicate$ "others" =
+                { 't := }
+                { pop$ }
+              if$
+              t "others" =
+                {
+                  " " * bbl.etal *
+                }
+                {
+                  numnames #2 >
+                    { "," * }
+                    'skip$
+                  if$
+                  bbl.and
+                  space.word * t *
+                }
+              if$
+            }
+          if$
+        }
+        't
+      if$
+      nameptr #1 + 'nameptr :=
+      namesleft #1 - 'namesleft :=
+    }
+  while$
+}
+
+FUNCTION {author.editor.key.full}
+{ author empty$
+    { editor empty$
+        { key empty$
+            { cite$ #1 #3 substring$ }
+            'key
+          if$
+        }
+        { editor format.full.names }
+      if$
+    }
+    { author format.full.names }
+  if$
+}
+
+FUNCTION {author.key.full}
+{ author empty$
+    { key empty$
+         { cite$ #1 #3 substring$ }
+          'key
+      if$
+    }
+    { author format.full.names }
+  if$
+}
+
+FUNCTION {editor.key.full}
+{ editor empty$
+    { key empty$
+         { cite$ #1 #3 substring$ }
+          'key
+      if$
+    }
+    { editor format.full.names }
+  if$
+}
+
+FUNCTION {make.full.names}
+{ type$ "book" =
+  type$ "inbook" =
+  or
+    'author.editor.key.full
+    { type$ "proceedings" =
+        'editor.key.full
+        'author.key.full
+      if$
+    }
+  if$
+}
+
+FUNCTION {output.bibitem}
+{ newline$
+  "\bibitem[{" write$
+  label write$
+  ")" make.full.names duplicate$ short.list =
+     { pop$ }
+     { * }
+   if$
+  "}]{" * write$
+  cite$ write$
+  "}" write$
+  newline$
+  ""
+  before.all 'output.state :=
+}
+
+FUNCTION {if.digit}
+{ duplicate$ "0" =
+  swap$ duplicate$ "1" =
+  swap$ duplicate$ "2" =
+  swap$ duplicate$ "3" =
+  swap$ duplicate$ "4" =
+  swap$ duplicate$ "5" =
+  swap$ duplicate$ "6" =
+  swap$ duplicate$ "7" =
+  swap$ duplicate$ "8" =
+  swap$ "9" = or or or or or or or or or
+}
+FUNCTION {n.separate}
+{ 't :=
+  ""
+  #0 'numnames :=
+  { t empty$ not }
+  { t #-1 #1 substring$ if.digit
+      { numnames #1 + 'numnames := }
+      { #0 'numnames := }
+    if$
+    t #-1 #1 substring$ swap$ *
+    t #-2 global.max$ substring$ 't :=
+    numnames #5 =
+      { duplicate$ #1 #2 substring$ swap$
+        #3 global.max$ substring$
+        "\," swap$ * *
+      }
+      'skip$
+    if$
+  }
+  while$
+}
+FUNCTION {n.dashify}
+{
+  n.separate
+  't :=
+  ""
+    { t empty$ not }
+    { t #1 #1 substring$ "-" =
+        { t #1 #2 substring$ "--" = not
+            { "--" *
+              t #2 global.max$ substring$ 't :=
+            }
+            {   { t #1 #1 substring$ "-" = }
+                { "-" *
+                  t #2 global.max$ substring$ 't :=
+                }
+              while$
+            }
+          if$
+        }
+        { t #1 #1 substring$ *
+          t #2 global.max$ substring$ 't :=
+        }
+      if$
+    }
+  while$
+}
+
+FUNCTION {word.in}
+{ "" }
+
+FUNCTION {format.date}
+{ year "year" bibinfo.check duplicate$ empty$
+    {
+      "empty year in " cite$ * "; set to ????" * warning$
+       pop$ "????"
+    }
+    'skip$
+  if$
+  extra.label *
+  before.all 'output.state :=
+  ", " swap$ *
+}
+FUNCTION {format.btitle}
+{ title "title" bibinfo.check
+  duplicate$ empty$ 'skip$
+    {
+      emphasize
+    }
+  if$
+}
+FUNCTION {either.or.check}
+{ empty$
+    'pop$
+    { "can't use both " swap$ * " fields in " * cite$ * warning$ }
+  if$
+}
+FUNCTION {format.bvolume}
+{ volume empty$
+    { "" }
+    { bbl.volume volume tie.or.space.prefix
+      "volume" bibinfo.check * *
+      series "series" bibinfo.check
+      duplicate$ empty$ 'pop$
+%%% NO ITALIC SERIES        { emphasize ", " * swap$ * }
+      {", " * swap$ * }
+      if$
+      "volume and number" number either.or.check
+    }
+  if$
+}
+FUNCTION {format.number.series}
+{ volume empty$
+    { number empty$
+        { series field.or.null }
+        { series empty$
+            { number "number" bibinfo.check }
+            { output.state mid.sentence =
+                { bbl.number }
+                { bbl.number capitalize }
+              if$
+              number tie.or.space.prefix "number" bibinfo.check * *
+              bbl.in space.word *
+              series "series" bibinfo.check *
+            }
+          if$
+        }
+      if$
+    }
+    { "" }
+  if$
+}
+FUNCTION {is.num}
+{ chr.to.int$
+  duplicate$ "0" chr.to.int$ < not
+  swap$ "9" chr.to.int$ > not and
+}
+
+FUNCTION {extract.num}
+{ duplicate$ 't :=
+  "" 's :=
+  { t empty$ not }
+  { t #1 #1 substring$
+    t #2 global.max$ substring$ 't :=
+    duplicate$ is.num
+      { s swap$ * 's := }
+      { pop$ "" 't := }
+    if$
+  }
+  while$
+  s empty$
+    'skip$
+    { pop$ s }
+  if$
+}
+
+FUNCTION {convert.edition}
+{ extract.num "l" change.case$ 's :=
+  s "first" = s "1" = or
+    { bbl.first 't := }
+    { s "second" = s "2" = or
+        { bbl.second 't := }
+        { s "third" = s "3" = or
+            { bbl.third 't := }
+            { s "fourth" = s "4" = or
+                { bbl.fourth 't := }
+                { s "fifth" = s "5" = or
+                    { bbl.fifth 't := }
+                    { s #1 #1 substring$ is.num
+                        { s eng.ord 't := }
+                        { edition 't := }
+                      if$
+                    }
+                  if$
+                }
+              if$
+            }
+          if$
+        }
+      if$
+    }
+  if$
+  t
+}
+
+FUNCTION {format.edition}
+{ edition duplicate$ empty$ 'skip$
+    {
+      convert.edition
+      output.state mid.sentence =
+        { "l" }
+        { "t" }
+      if$ change.case$
+      "edition" bibinfo.check
+      " " * bbl.edition *
+    }
+  if$
+}
+INTEGERS { multiresult }
+FUNCTION {multi.page.check}
+{ 't :=
+  #0 'multiresult :=
+    { multiresult not
+      t empty$ not
+      and
+    }
+    { t #1 #1 substring$
+      duplicate$ "-" =
+      swap$ duplicate$ "," =
+      swap$ "+" =
+      or or
+        { #1 'multiresult := }
+        { t #2 global.max$ substring$ 't := }
+      if$
+    }
+  while$
+  multiresult
+}
+FUNCTION {format.pages}
+{ pages duplicate$ empty$ 'skip$
+    { duplicate$ multi.page.check
+        {
+          n.dashify
+        }
+        {
+        }
+      if$
+      "pages" bibinfo.check
+    }
+  if$
+}
+FUNCTION {format.journal.pages}
+{ pages duplicate$ empty$ 'pop$
+    { swap$ duplicate$ empty$
+        { pop$ pop$ format.pages }
+        {
+          ", " *
+          swap$
+          n.dashify
+          "pages" bibinfo.check
+          *
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {format.journal.eid}
+{ eid "eid" bibinfo.check
+  duplicate$ empty$ 'pop$
+    { swap$ duplicate$ empty$ 'skip$
+      {
+          ", " *
+      }
+      if$
+      swap$ *
+    }
+  if$
+}
+FUNCTION {format.vol.num.pages}
+{ volume field.or.null
+  duplicate$ empty$ 'skip$
+    {
+      "volume" bibinfo.check
+    }
+  if$
+  number "number" bibinfo.check duplicate$ empty$ 'skip$
+    {
+      swap$ duplicate$ empty$
+        { "there's a number but no volume in " cite$ * warning$ }
+        'skip$
+      if$
+      swap$
+      "~(" swap$ * ")" *
+    }
+  if$ *
+  bolden
+  eid empty$
+    { format.journal.pages }
+    { format.journal.eid }
+  if$
+}
+
+FUNCTION {format.chapter.pages}
+{ chapter empty$
+    'format.pages
+    { type empty$
+        { bbl.chapter }
+        { type "l" change.case$
+          "type" bibinfo.check
+        }
+      if$
+      chapter tie.or.space.prefix
+      "chapter" bibinfo.check
+      * *
+      pages empty$
+        'skip$
+        { ", " * format.pages * }
+      if$
+    }
+  if$
+}
+
+FUNCTION {format.booktitle}
+{
+  booktitle "booktitle" bibinfo.check
+  emphasize
+}
+FUNCTION {format.in.ed.booktitle}
+{ format.booktitle duplicate$ empty$ 'skip$
+    {
+      editor "editor" format.names.ed duplicate$ empty$ 'pop$
+        {
+          get.bbl.editor
+          swap$ "," *
+          " " * swap$ *
+          swap$
+          "," *
+          " " * swap$
+          * }
+      if$
+      word.in swap$ *
+    }
+  if$
+}
+FUNCTION {format.thesis.type}
+{ type duplicate$ empty$
+    'pop$
+    { swap$ pop$
+      "t" change.case$ "type" bibinfo.check
+    }
+  if$
+}
+FUNCTION {format.tr.number}
+{ number "number" bibinfo.check
+  type duplicate$ empty$
+    { pop$ bbl.techrep }
+    'skip$
+  if$
+  "type" bibinfo.check
+  swap$ duplicate$ empty$
+    { pop$ "t" change.case$ }
+    { tie.or.space.prefix * * }
+  if$
+}
+FUNCTION {format.article.crossref}
+{
+  word.in
+  " \cite{" * crossref * "}" *
+}
+FUNCTION {format.book.crossref}
+{ volume duplicate$ empty$
+    { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
+      pop$ word.in
+    }
+    { bbl.volume
+      capitalize
+      swap$ tie.or.space.prefix "volume" bibinfo.check * * bbl.of space.word *
+    }
+  if$
+  " \cite{" * crossref * "}" *
+}
+FUNCTION {format.incoll.inproc.crossref}
+{
+  word.in
+  " \cite{" * crossref * "}" *
+}
+FUNCTION {format.org.or.pub}
+{ 't :=
+  ""
+  address empty$ t empty$ and
+    'skip$
+    {
+      t empty$
+        { address "address" bibinfo.check *
+        }
+        { t *
+          address empty$
+            'skip$
+            { ", " * address "address" bibinfo.check * }
+          if$
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {format.publisher.address}
+{ publisher "publisher" bibinfo.warn format.org.or.pub
+}
+
+FUNCTION {format.organization.address}
+{ organization "organization" bibinfo.check format.org.or.pub
+}
+
+STRINGS {oldname}
+
+FUNCTION {name.or.dash}
+{ 's :=
+   oldname empty$
+     { s 'oldname := s }
+     { s oldname =
+         { "---{}---{}---" }
+         { s 'oldname := s }
+       if$
+     }
+   if$
+}
+
+FUNCTION {article}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title "title" output.check
+  new.sentence
+  crossref missing$
+    {
+      journal
+      "journal" bibinfo.check
+      emphasize
+      "journal" output.check
+      format.vol.num.pages output
+  format.doi output
+    }
+    { format.article.crossref output.nonnull
+      format.pages output
+    }
+  if$
+  format.note output
+  format.eprint output
+  fin.entry
+}
+FUNCTION {book}
+{ output.bibitem
+  author empty$
+    { format.editors "author and editor" output.check
+      editor format.key output
+      add.blank
+      name.or.dash
+    }
+    { format.authors output.nonnull
+      name.or.dash
+      crossref missing$
+        { "author and editor" editor either.or.check }
+        'skip$
+      if$
+    }
+  if$
+  format.date "year" output.check
+  date.block
+  format.btitle "title" output.check
+  crossref missing$
+    { format.bvolume output
+  new.sentence
+      format.edition output
+      format.number.series output
+      format.publisher.address output
+    }
+    {
+  new.sentence
+      format.book.crossref output.nonnull
+    }
+  if$
+  format.book.pages output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+FUNCTION {booklet}
+{ output.bibitem
+  format.authors output
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title "title" output.check
+  new.sentence
+  howpublished "howpublished" bibinfo.check output
+  address "address" bibinfo.check output
+  format.book.pages output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {inbook}
+{ output.bibitem
+  author empty$
+    { format.editors "author and editor" output.check
+      editor format.key output
+      name.or.dash
+    }
+    { format.authors output.nonnull
+      name.or.dash
+      crossref missing$
+        { "author and editor" editor either.or.check }
+        'skip$
+      if$
+    }
+  if$
+  format.date "year" output.check
+  date.block
+  format.btitle "title" output.check
+  crossref missing$
+    {
+      format.bvolume output
+      format.chapter.pages "chapter and pages" output.check
+  new.sentence
+      format.edition output
+      format.number.series output
+      format.publisher.address output
+    }
+    {
+      format.chapter.pages "chapter and pages" output.check
+  new.sentence
+      format.book.crossref output.nonnull
+    }
+  if$
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {incollection}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title "title" output.check
+  new.sentence
+  crossref missing$
+    { format.in.ed.booktitle "booktitle" output.check
+      format.publisher.address output      
+      format.bvolume output
+      format.number.series output
+      format.edition output
+      format.chapter.pages output
+    }
+    { format.incoll.inproc.crossref output.nonnull
+      format.chapter.pages output
+    }
+  if$
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+FUNCTION {inproceedings}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title "title" output.check
+  new.sentence
+  crossref missing$
+    { format.in.ed.booktitle "booktitle" output.check
+      publisher empty$
+        { format.organization.address output }
+        { organization "organization" bibinfo.check output
+          format.publisher.address output
+        }
+      if$
+      format.bvolume output
+      format.pages output
+      format.number.series output
+      howpublished "howpublished" bibinfo.check output
+    }
+    { format.incoll.inproc.crossref output.nonnull
+      format.pages output
+    }
+  if$
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+FUNCTION {conference} { inproceedings }
+FUNCTION {manual}
+{ output.bibitem
+  format.authors output
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.btitle "title" output.check
+  new.sentence
+  organization "organization" bibinfo.check output
+  address "address" bibinfo.check output
+  format.edition output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {mastersthesis}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title
+  "title" output.check
+  new.sentence
+  bbl.mthesis format.thesis.type output.nonnull
+  department "department" bibinfo.warn output
+  school "school" bibinfo.warn output
+  address "address" bibinfo.check output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {misc}
+{ output.bibitem
+  format.authors output
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title output
+  new.sentence
+  howpublished "howpublished" bibinfo.check output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+FUNCTION {phdthesis}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title
+  "title" output.check
+  new.sentence
+  bbl.phdthesis format.thesis.type output.nonnull
+  school "school" bibinfo.warn output
+  address "address" bibinfo.check output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {proceedings}
+{ output.bibitem
+  format.editors output
+  editor format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.btitle "title" output.check
+  format.bvolume output
+  format.number.series output
+  publisher empty$
+    { format.organization.address output }
+    { organization "organization" bibinfo.check output
+      format.publisher.address output
+    }
+  if$
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {techreport}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title
+  "title" output.check
+  new.sentence
+  format.tr.number output.nonnull
+  institution "institution" bibinfo.warn output
+  address "address" bibinfo.check output
+  format.doi output
+  format.note output
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {unpublished}
+{ output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  name.or.dash
+  format.date "year" output.check
+  date.block
+  format.title "title" output.check
+  format.doi output
+  format.note "note" output.check
+  format.eprint output
+  fin.entry
+}
+
+FUNCTION {default.type} { misc }
+READ
+FUNCTION {sortify}
+{ purify$
+  "l" change.case$
+}
+INTEGERS { len }
+FUNCTION {chop.word}
+{ 's :=
+  'len :=
+  s #1 len substring$ =
+    { s len #1 + global.max$ substring$ }
+    's
+  if$
+}
+FUNCTION {format.lab.names}
+{ 's :=
+  "" 't :=
+  s #1 "{vv~}{ll}" format.name$
+  s num.names$ duplicate$
+  #2 >
+    { pop$
+      " " * bbl.etal *
+    }
+    { #2 <
+        'skip$
+        { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+            {
+              " " * bbl.etal *
+            }
+            { bbl.and space.word * s #2 "{vv~}{ll}" format.name$
+              * }
+          if$
+        }
+      if$
+    }
+  if$
+}
+
+FUNCTION {author.key.label}
+{ author empty$
+    { key empty$
+        { cite$ #1 #3 substring$ }
+        'key
+      if$
+    }
+    { author format.lab.names }
+  if$
+}
+
+FUNCTION {author.editor.key.label}
+{ author empty$
+    { editor empty$
+        { key empty$
+            { cite$ #1 #3 substring$ }
+            'key
+          if$
+        }
+        { editor format.lab.names }
+      if$
+    }
+    { author format.lab.names }
+  if$
+}
+
+FUNCTION {editor.key.label}
+{ editor empty$
+    { key empty$
+        { cite$ #1 #3 substring$ }
+        'key
+      if$
+    }
+    { editor format.lab.names }
+  if$
+}
+
+FUNCTION {calc.short.authors}
+{ type$ "book" =
+  type$ "inbook" =
+  or
+    'author.editor.key.label
+    { type$ "proceedings" =
+        'editor.key.label
+        'author.key.label
+      if$
+    }
+  if$
+  'short.list :=
+}
+
+FUNCTION {calc.label}
+{ calc.short.authors
+  short.list
+  "("
+  *
+  year duplicate$ empty$
+     { pop$ "????" }
+     { purify$ #-1 #4 substring$ }
+  if$
+  *
+  'label :=
+}
+
+FUNCTION {sort.format.names}
+{ 's :=
+  #1 'nameptr :=
+  ""
+  s num.names$ 'numnames :=
+  numnames 'namesleft :=
+    { namesleft #0 > }
+    { s nameptr
+      "{vv{ } }{ll{ }}{  f{ }}{  jj{ }}"
+      format.name$ 't :=
+      nameptr #1 >
+        {
+          "   "  *
+          namesleft #1 = t "others" = and
+            { "zzzzz" * }
+            { t sortify * }
+          if$
+        }
+        { t sortify * }
+      if$
+      nameptr #1 + 'nameptr :=
+      namesleft #1 - 'namesleft :=
+    }
+  while$
+}
+
+FUNCTION {sort.format.title}
+{ 't :=
+  "A " #2
+    "An " #3
+      "The " #4 t chop.word
+    chop.word
+  chop.word
+  sortify
+  #1 global.max$ substring$
+}
+FUNCTION {author.sort}
+{ author empty$
+    { key empty$
+        { "to sort, need author or key in " cite$ * warning$
+          ""
+        }
+        { key sortify }
+      if$
+    }
+    { author sort.format.names }
+  if$
+}
+FUNCTION {author.editor.sort}
+{ author empty$
+    { editor empty$
+        { key empty$
+            { "to sort, need author, editor, or key in " cite$ * warning$
+              ""
+            }
+            { key sortify }
+          if$
+        }
+        { editor sort.format.names }
+      if$
+    }
+    { author sort.format.names }
+  if$
+}
+FUNCTION {editor.sort}
+{ editor empty$
+    { key empty$
+        { "to sort, need editor or key in " cite$ * warning$
+          ""
+        }
+        { key sortify }
+      if$
+    }
+    { editor sort.format.names }
+  if$
+}
+FUNCTION {presort}
+{ calc.label
+  label sortify
+  "    "
+  *
+  type$ "book" =
+  type$ "inbook" =
+  or
+    'author.editor.sort
+    { type$ "proceedings" =
+        'editor.sort
+        'author.sort
+      if$
+    }
+  if$
+  #1 entry.max$ substring$
+  'sort.label :=
+  sort.label
+  *
+  "    "
+  *
+  title field.or.null
+  sort.format.title
+  *
+  #1 entry.max$ substring$
+  'sort.key$ :=
+}
+
+ITERATE {presort}
+SORT
+STRINGS { last.label next.extra }
+INTEGERS { last.extra.num number.label }
+FUNCTION {initialize.extra.label.stuff}
+{ #0 int.to.chr$ 'last.label :=
+  "" 'next.extra :=
+  #0 'last.extra.num :=
+  #0 'number.label :=
+}
+FUNCTION {forward.pass}
+{ last.label label =
+    { last.extra.num #1 + 'last.extra.num :=
+      last.extra.num int.to.chr$ 'extra.label :=
+    }
+    { "a" chr.to.int$ 'last.extra.num :=
+      "" 'extra.label :=
+      label 'last.label :=
+    }
+  if$
+  number.label #1 + 'number.label :=
+}
+FUNCTION {reverse.pass}
+{ next.extra "b" =
+    { "a" 'extra.label := }
+    'skip$
+  if$
+  extra.label 'next.extra :=
+  extra.label
+  duplicate$ empty$
+    'skip$
+    { "{\natexlab{" swap$ * "}}" * }
+  if$
+  'extra.label :=
+  label extra.label * 'label :=
+}
+EXECUTE {initialize.extra.label.stuff}
+ITERATE {forward.pass}
+REVERSE {reverse.pass}
+FUNCTION {bib.sort.order}
+{ sort.label
+  "    "
+  *
+  year field.or.null sortify
+  *
+  "    "
+  *
+  title field.or.null
+  sort.format.title
+  *
+  #1 entry.max$ substring$
+  'sort.key$ :=
+}
+ITERATE {bib.sort.order}
+SORT
+FUNCTION {begin.bib}
+{ preamble$ empty$
+    'skip$
+    { preamble$ write$ newline$ }
+  if$
+  "\begin{thebibliography}{" number.label int.to.str$ * "}" *
+  write$ newline$
+  "\providecommand{\natexlab}[1]{#1}"
+  write$ newline$
+  "\providecommand{\url}[1]{\texttt{#1}}"
+  write$ newline$
+  "\providecommand{\urlprefix}{URL }"
+  write$ newline$
+  "\expandafter\ifx\csname urlstyle\endcsname\relax"
+  write$ newline$
+  "  \providecommand{\doi}[1]{doi:\discretionary{}{}{}#1}\else"
+  write$ newline$
+  "  \providecommand{\doi}{doi:\discretionary{}{}{}\begingroup \urlstyle{rm}\Url}\fi"
+  write$ newline$
+  "\providecommand{\eprint}[2][]{\url{#2}}"
+  write$ newline$
+}
+EXECUTE {begin.bib}
+EXECUTE {init.state.consts}
+ITERATE {call.type$}
+FUNCTION {end.bib}
+{ newline$
+  "\end{thebibliography}" write$ newline$
+}
+EXECUTE {end.bib}
+%% End of customized bst file
+%%
+%% End of file `ametsoc7.bst'.
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/math_abbrev.sty
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/math_abbrev.sty	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Styles/math_abbrev.sty	(revision 8732)
@@ -0,0 +1,36 @@
+\def\half{\textstyle\frac{1}{2}}
+\def\hhalf{\scriptstyle\frac{1}{2}}
+\def\quarter{\textstyle\frac{1}{4}}
+\def\qquarter{\scriptstyle\frac{1}{4}}
+\def\squarter{\sfrac{1}{4}}
+\def\stwelfth{\sfrac{1}{12}}
+\def\sthirtysixth{\sfrac{1}{36}}
+% \newcommand{\grad}{\boldsymbol{\nabla}}
+% \newcommand{\gradh}{\boldsymbol{\nabla}_h}
+\newcommand{\grad}{\nabla}
+\newcommand{\gradh}{\nabla_h}
+\def\bgamma\boldsymbol{\gamma}
+\def\rdt{\Delta t}
+\newcommand{\ew}[3]{{e_{3#1}}_{\,#2}^{\,#3} }
+\newcommand{\vect}[1]{\ensuremath{\mathbf{#1}}} % for vectors                                % non-italic bold
+\newcommand{\Div}{\grad\cdot}
+% \newcommand{\curl}{\boldsymbol{\nabla} \times} % for curl
+\newcommand{\curl}{\nabla \times} % for curl
+\newcommand{\pd}[2][]{\frac{\partial #1}{\partial #2}}
+\def\deg{$^{\circ}$}                           % degrees  (NB: \r{} can % % also be used)
+\def\degC{$^{\circ}C$}
+\def\degK{$^{\circ}K$}
+\def\degN{$^{\circ}N$}
+\def\degS{$^{\circ}S$}
+\newcommand{\alpbet} {\left(\alpha / \beta \right)} 	% alpha/beta  for slp computation
+\newcommand{\triad}[6][]{\ensuremath{{}_{#2}^{#3}{\mathbb{#4}_{#1}}_{#5}^{\,#6}}}
+\newcommand{\triadd}[5]{\ensuremath{{}_{#1}^{#2}{\mathbb{#3}}_{#4}^{\,#5}}}
+\newcommand{\triadt}[5]{\ensuremath{{}_{#1}^{#2}{\tilde{\mathbb{#3}}}_{#4}^{\,#5}}}
+\newcommand{\rtriad}[2][]{\ensuremath{\triad[#1]{i}{k}{#2}{i_p}{k_p}}}
+\newcommand{\rtriadt}[1]{\ensuremath{\triadt{i}{k}{#1}{i_p}{k_p}}}
+\newcommand{\Alts}{{A}}
+\newcommand{\Alt}{{A^{lT}}}
+\newcommand{\rMLt}[1][i]{\tilde{r}_{\mathrm{ML}\,#1}}
+\newcommand{\rML}[1][i]{r_{\mathrm{ML}\,#1}}
+\newcommand{\mygstrut}[2]{\rule[#1 em]{0pt}{#2 em}}
+\newcommand{\mystrut}{\rule[-.9 em]{0pt}{1.79 em}}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Top_Matter.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Top_Matter.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Top_Matter.tex	(revision 8732)
@@ -0,0 +1,36 @@
+%\usepackage{pstricks}
+\title{
+%\psset{unit=1.1in,linewidth=4pt} 	%parameters of the units for pstricks
+% \rput(0,2){ \includegraphics[width=1.1\textwidth]{logo_ALL.pdf}             } \\
+% \vspace{0.1cm}
+\vspace{-6.0cm}
+\includegraphics[width=1.1\textwidth]{logo_ALL}\\
+\vspace{5.1cm}
+\includegraphics[width=0.9\textwidth]{NEMO_logo_Black} \\
+\vspace{1.4cm}
+\rule{345pt}{1.5pt} \\
+\vspace{0.45cm}
+{\Huge NEMO ocean engine}
+\rule{345pt}{1.5pt} \\
+ }
+%{ -- Draft --}   }
+%\date{\today}
+\date{
+January 2017  \\
+{\small  -- version 4.0 alpha --} \\
+~  \\
+\textit{\small Note du P\^ole de mod\'{e}lisation de l'Institut Pierre-Simon Laplace No 27 }\\
+\vspace{0.45cm}
+{ ISSN No 1288-1619.}
+}
+
+
+\author{
+\Large Gurvan Madec, and the NEMO team  \\
+ \texttt{\small gurvan.madec@locean-ipsl.umpc.fr} \\
+ \texttt{\small nemo\_st@locean-ipsl.umpc.fr} \\
+%{\small Laboratoire d'Oc\'{e}anographie  et du Climat: Exp\'{e}rimentation et Approches Num\'{e}riques }
+}
+
+\dominitoc
+\makeindex  		%type this first :     makeindex -s NEMO.ist NEMO_book.idx
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/clean.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/clean.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/clean.sh	(revision 8732)
@@ -0,0 +1,2 @@
+rm -f $( ls -1 NEMO_book.* | egrep -v "(tex|pdf)" ) *mpgraph*
+rm -f Chapters/*.aux Chapters/*.log
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/namelist_split.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/namelist_split.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/namelist_split.sh	(revision 8732)
@@ -0,0 +1,247 @@
+#! /bin/sh
+#
+#       usage for NEMO doc to create an update of the Namelist directory :
+# 1- delete the existing directory (You can also choose to save it somewhere) 
+#    rm -rf Namelist
+# 2- create the updated Namelist directory from the SHARED/namelist_ref :
+#    ./namelist_split.sh -i ../../NEMOGCM/CONFIG/SHARED/namelist_ref -o Namelist
+#
+# .. _namelist_split.sh:
+#
+# =================
+# namelist_split.sh
+# =================
+#
+# ----------------
+# split a namelist
+# ----------------
+#
+# SYNOPSIS
+# ========
+#
+# .. code-block:: bash
+#
+#    namelist_split.sh -i namelist -o dirout [-n]
+#
+# DESCRIPTION
+# ===========
+#
+# Split a namelist file (NEMO convention syntax) given in parameter
+# into files in a given output directory.
+#
+# .. option:: -i <input file (namelist)>
+# .. option:: -o <output directory>
+# .. option:: -n <numbered output files>
+#
+# Each file of the output directory is named after the *block* it contains.
+#
+# We assume here that the input file is written with this pattern of block:
+#
+# .. parsed-literal::
+#
+#    !---------------
+#    &nameblock
+#    !---------------
+#    var1 = val1
+#    ...
+#    varn = valn
+#    /
+#
+# If ``-n`` option is used, files in the directory output are named after
+# the number of the block it contains and the name of this block. This might
+# be useful to recombine blocks in the same order.
+#
+# EXAMPLES
+# ========
+#
+# To split the namelist NEMO ORCA2_LIM experiment 00 if you are in NEMO
+# working space :
+#
+# .. code-block:: bash
+#
+#    namelist_split.sh -i CONFIG/ORCA2_LIM/EXP00/namelist -o /tmp/EXP00_namelist_split/
+#
+# To split the namelist under data directory with numbered files:
+#
+# .. code-block:: bash
+#
+#    namelist_split.sh -i ./data/namelist -o /tmp/EXP00_namelist_split/ -n
+#
+# Check can be made by concatenation of files in output directory if ``-n``
+# option have been used and comparison with original file :
+#
+# .. code-block:: bash
+#
+#    cat /tmp/EXP00_namelist_split/b???_* > /tmp/EXP00_namelist_rebuild
+#    sdiff -w80 ./data/namelist /tmp/EXP00_namelist_rebuild
+#
+# Output contains lines which are before the first block, after the last
+# block and lines between blocks.
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+# - fplod 2008-08-11T08:56:44Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * commentaires dans ce fichier en reStructuredText
+#     cf. reStructuredText_ and Docutils_
+#
+# .. _reStructuredText: http://docutils.sourceforge.net/rst.html
+# .. _Docutils: http://docutils.sourceforge.net/
+#
+# - fplod 2008-07-22T12:41:04Z aedon.locean-ipsl.upmc.fr (Darwin)
+#
+#   * creation with test on
+#     http://forge.ipsl.jussieu.fr/nemo/browser/trunk/CONFIG/ORCA2_LIM/EXP00/namelist revision 1151
+#-
+#
+system=$(uname)
+case "${system}" in
+    AIX|IRIX64)
+        echo " www : no specific posix checking"
+    ;;
+    *)
+        set -o posix
+    ;;
+esac
+unset system
+#
+command=$(basename ${0})
+log_date=$(date -u +"%Y%m%dT%H%M%SZ")
+#
+usage=" Usage : ${command} -i namelist -o dirout [-n]"
+#
+# default
+blocknum=0
+#
+minargcount=4
+if [ ${#} -lt ${minargcount} ]
+then
+    echo "eee : not enough arguments"
+    echo "${usage}"
+    exit 1
+fi
+#
+while [ ${#} -gt 0 ]
+do
+    case ${1} in
+        -i)
+            filein=${2}
+            shift
+        ;;
+        -o)
+            dirout=${2}
+            shift
+        ;;
+        -h)
+            echo "${usage}"
+            exit 0
+        ;;
+        -n)
+            blocknum=1
+        ;;
+        *)
+            # anything else
+            echo "eee : unknown option ${1}"
+            echo "eee : ${usage}"
+            exit 1
+        ;;
+    esac
+    # next flag
+    shift
+done
+unset usage
+#
+set -u
+#
+# check for filein
+if [ ! -r ${filein} ]
+then
+    echo "eee : ${filein} not accessible"
+    exit 1
+fi
+#
+# check for dirout
+# the idea is to prevent unwanted overwrite
+if [ -d ${dirout} ]
+then
+    echo "eee : ${dirout} already exist"
+    exit 1
+else
+    mkdir -p ${dirout}
+    if [ ${?} -ne 0 ]
+    then
+        echo "eee : cannot create ${dirout}"
+        exit 1
+    fi
+fi
+#
+# loop on each line of ${filein} ie the namelist to be split
+fileout=/dev/null
+begin=0
+if [ ${blocknum} -eq 1 ]
+then
+    iblock=0
+fi
+nbline=$(wc -l ${filein} | awk '{print $1}')
+il=1
+while [ ${il} -le ${nbline} ]
+do
+    line=$(sed -ne "${il},${il}p" ${filein})
+    # if current line start with "&", we can establish the name of output file
+    echo ${line} | grep -q "^&"
+    if [ ${?} -eq 0 ]
+    then
+        begin=1
+        # the form of this line is "&block   !"
+        block=${line#&}
+        block=${block%% *}
+        echo "iii : detection of the beginning of ${block}"
+        if [ ${blocknum} -eq 1 ]
+        then
+            iblock=$(( ${iblock} + 1))
+            fileout=${dirout}/b$(echo ${iblock} | awk '{printf "%3.3d", $1}')_${block}
+        else
+            fileout="${dirout}/${block}"
+        fi
+        # check for ${fileout}
+        if [ -f ${fileout} ]
+        then
+            echo "eee : ${fileout} already exists"
+            exit 1
+        fi
+        # write the previous line and the current line
+        echo "${memoline}" > ${fileout}
+        echo "${line}" >> ${fileout}
+    fi
+    # if current line contains "/" there will be no more lines to put in fileout
+    echo ${line} | grep -q "^/$"
+    if [ ${?} -eq 0 ]
+    then
+        echo "iii : detection of the end of ${block}"
+        echo "${line}" >> ${fileout}
+        fileout="/dev/null"
+    fi
+    # if current line is between "&" and "/", it should be written in fileout
+    # if current line is before the first &, it won't be written
+    if [ "${fileout}" != "/dev/null" ]
+    then
+        if [ ${begin} -eq 0 ]
+        then
+            echo "${line}" >> ${fileout}
+        fi
+    fi
+    # keep memory of this current line to use it if the next one is the
+    # beginning of a block
+    memoline=${line}
+    begin=0
+    # next line
+    il=$(( ${il} + 1 ))
+done
+#
+echo "iii : ${filein} is split in ${dirout}"
+#
+# end
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm	(revision 8732)
@@ -0,0 +1,62 @@
+# mpi gfortran compiler options for ATHENA using XIOS parallel writer server
+#
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+
+%NCDF_HOME           /users/home/ans040/local
+%HDF5_HOME           /users/home/ans040/local
+%XIOS_HOME           /users/home/ans040/SOFTWARE/XIOS/trunk
+
+%NCDF_INC            -I%NCDF_HOME/include
+%NCDF_LIB            -L%NCDF_HOME/lib
+
+%HDF5_INC            -I%HDF5_HOME/include
+%HDF5_LIB            -L%HDF5_HOME/lib -lhdf5_hl -lhdf5
+
+%XIOS_INC            -I%XIOS_HOME/inc
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+
+%CPP                 cpp
+%FC                  mpif90
+%FCFLAGS             -fdefault-real-8 -fno-second-underscore -Dgfortran -ffree-line-length-none
+%FFLAGS              %FCFLAGS
+%LD                  %FC
+%LDFLAGS
+%FPPFLAGS            -x f77-cpp-input
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
+%USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB  -lnetcdff -lnetcdf -lstdc++ -lz -lcurl -lgpfs
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm	(revision 8732)
@@ -0,0 +1,35 @@
+# 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+
+
+%NCDF_INC -I${NETCDF}/include
+%NCDF_LIB -L${NETCDF}/lib -lnetcdf -lnetcdff
+%CPP                 cpp
+%FC mpiifort
+%FCFLAGS -r8 -O3 -xHost -fp-model source -traceback
+%FFLAGS %FCFLAGS
+%LD mpiifort
+%FPPFLAGS -P -C -traditional
+%LDFLAGS
+%AR ar
+%ARFLAGS -r
+%MK gmake
+%USER_INC %NCDF_INC
+%USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm	(revision 8732)
@@ -0,0 +1,35 @@
+# 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+
+
+%NCDF_INC -I$NETCDF/include
+%NCDF_LIB -L$NETCDF/lib -lnetcdf -lnetcdff
+%CPP                 cpp
+%FC mpiifort
+%FCFLAGS -fpe0 -g -r8 -O1 -xHost -fp-model source -traceback
+%FFLAGS %FCFLAGS
+%LD mpiifort
+%FPPFLAGS -P -C -traditional
+%LDFLAGS
+%AR ar
+%ARFLAGS -r
+%MK gmake
+%USER_INC %NCDF_INC
+%USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm	(revision 8732)
@@ -0,0 +1,35 @@
+# 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+
+
+%NCDF_INC -I$NETCDF/include
+%NCDF_LIB -L$NETCDF/lib -lnetcdf -lnetcdff
+%CPP                 cpp
+%FC ifort
+%FCFLAGS -r8 -O3 -xHost -fp-model source -traceback
+%FFLAGS  %FCFLAGS
+%LD ifort
+%FPPFLAGS -P -C -traditional
+%LDFLAGS
+%AR ar
+%ARFLAGS -r
+%MK gmake
+%USER_INC %NCDF_INC
+%USER_LIB %NCDF_LIB
+%CC                  icc
+%CFLAGS              -O0
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm	(revision 8732)
@@ -0,0 +1,62 @@
+# mpi ifort compiler options for ATHENA using XIOS parallel writer server
+#
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+
+# required modules
+# module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.7.0 HDF5/hdf5-1.8.11_parallel
+
+# NETCDF and PNETCDF should be set automatically when loading modules.
+# The following environment variables must be set by the user.
+#export XIOS=/users/home/models/nemo/xios
+#export HDF5=/users/home/opt/hdf5/hdf5-1.8.11_parallel
+
+%NCDF_INC            -I${NETCDF}/include -I${PNETCDF}/include
+%NCDF_LIB            -L${NETCDF}/lib -lnetcdff -lnetcdf -L${PNETCDF}/lib -lpnetcdf
+%HDF5_INC            -I${HDF5}/include
+%HDF5_LIB            -L${HDF5}/lib -lhdf5_hl -lhdf5
+%XIOS_INC            -I${XIOS}/inc
+%XIOS_LIB            -L${XIOS}/lib -lxios
+%CPP                 cpp
+%FC                  mpiifort
+%FCFLAGS             -r8 -O3 -xHost -fp-model source -traceback
+%FFLAGS              %FCFLAGS
+%LD                  mpiifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -lstdc++ -lz -lgpfs -lcurl
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC
+%USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm	(revision 8732)
@@ -0,0 +1,37 @@
+# EKMAN IBM Intel Sandy Bridge at INGV
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# XIOS_ROOT   root directory containing lib for XIOS
+# MPI_INTEL   directory for intel mpi 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+
+%NCDF_INC            -I/srv/lib/netcdf-x/include
+%NCDF_LIB            -L/srv/lib/netcdf-x/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lstdc++
+%XIOS_ROOT           /home/delrosso/XIOS_1.0/xios-1.0
+%MPI_INTEL           -I/srv/intel/impi/4.1.0.024/include
+%CPP                 cpp
+%FC                  mpiifort
+%FCFLAGS             -r8 -O1 -g -traceback -fp-model precise
+%FFLAGS              %FCFLAGS
+%LD                  mpiifort
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            -I%XIOS_ROOT/inc %NCDF_INC %MPI_INTEL -I/srv/lib/zlib-last/include
+%USER_LIB            -L%XIOS_ROOT/lib -lxios %NCDF_LIB -L/srv/lib/zlib-last/lib -lz
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-ALTIX_JADE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-ALTIX_JADE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-ALTIX_JADE.fcm	(revision 8732)
@@ -0,0 +1,29 @@
+# ifort compiler options for CINES SGI-ALTIX Jade, http://www.cines.fr/spip.php?rubrique291
+# 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/opt/software/SGI/netcdf/4.1.3/include
+%NCDF_LIB            -L/opt/software/SGI/netcdf/4.1.3/lib -lnetcdf -lnetcdff 
+%FC                  ifort -lmpi
+%FCFLAGS             -r8 -O3 -xSSE4.2 -automatic -static 
+%FFLAGS              %FCFLAGS   
+%LD                  %FC
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -ruv
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-BG_BABEL.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-BG_BABEL.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-BG_BABEL.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-IA64_PLATINE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-IA64_PLATINE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-IA64_PLATINE.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-PW6MONO_VARGAS.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-PW6MONO_VARGAS.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-PW6MONO_VARGAS.fcm	(revision 8732)
@@ -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 -qstrict -qrealsize=8 -qextname=flush -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%FFLAGS              -qfixed -O3 -qstrict -qrealsize=8 -qextname=flush -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-PW6_VARGAS.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-PW6_VARGAS.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-PW6_VARGAS.fcm	(revision 8732)
@@ -0,0 +1,32 @@
+# 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>
+#
+# module load netcdf/4.1.3-par
+# module load phdf5/1.8.7
+#
+%NCDF_INC            
+%NCDF_LIB    
+%XIOS_ROOT           /workgpfs/rech/eee/reee217/XIOS
+%FC                  mpxlf90_r
+%FCFLAGS             -qfree=f90 -O3 -qstrict -qrealsize=8 -qextname=flush -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%FFLAGS              -qfixed -O3 -qstrict -qrealsize=8 -qextname=flush -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%LD                  mpCC_r
+%LDFLAGS             -lxlf90
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             rs
+%MK                  gmake 
+%USER_INC            %NCDF_INC -I%XIOS_ROOT/inc
+%USER_LIB            -L%XIOS_ROOT/lib -lxios %NCDF_LIB 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX8_BRODIE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX8_BRODIE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX8_BRODIE.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX8_MERCURE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX8_MERCURE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX8_MERCURE.fcm	(revision 8732)
@@ -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 -Wf"-init heap=zero" -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX9_ES2.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX9_ES2.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX9_ES2.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX9_MERCURE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX9_MERCURE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-SX9_MERCURE.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-TX7_ULAM.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-TX7_ULAM.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-TX7_ULAM.fcm	(revision 8732)
@@ -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/usr/local/pub/NetCDF/3.6.3/include
+%NCDF_LIB            -L/usr/local/pub/NetCDF/3.6.3/lib -lnetcdf_c++ -lnetcdf
+%FC                  ifort
+%FCFLAGS             -r8 -O3  -traceback
+%FFLAGS              %FCFLAGS
+%LD                  %FC
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-X64_TITANE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-X64_TITANE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-X64_TITANE.fcm	(revision 8732)
@@ -0,0 +1,28 @@
+# 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_INC_DIR
+%NCDF_LIB            -L$NETCDF_LIB_DIR -lnetcdff -lnetcdf
+%FC                  mpif90 -c -cpp
+%FCFLAGS             -i4 -r8 -DCPP_PARA -O3 -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-X86_CESIUM.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-X86_CESIUM.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-X86_CESIUM.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-ifort_CICLAD.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-ifort_CICLAD.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/CNRS/arch-ifort_CICLAD.fcm	(revision 8732)
@@ -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/opt/netcdf3/ifort/include 
+%NCDF_LIB            -L /opt/netcdf3/ifort/lib -lnetcdf   
+%FC                  /usr/lib64/openmpi/1.4.3-ifort/bin/mpif90 -c -cpp -DCPP_PARA -pg
+%FCFLAGS 	     -i4 -r8 -O3  -traceback 
+%FFLAGS 	     -i4 -r8 -O3  -traceback 
+%LD                  /usr/lib64/openmpi/1.4.3-ifort/bin/mpif90 
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-ALTIX_NAUTILUS.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-ALTIX_NAUTILUS.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-ALTIX_NAUTILUS.fcm	(revision 8732)
@@ -0,0 +1,33 @@
+# ifort (mpif90) 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-XT6_HECTORcrayftn.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-XT6_HECTORcrayftn.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-XT6_HECTORcrayftn.fcm	(revision 8732)
@@ -0,0 +1,44 @@
+# compiler options for hector CRAY XT6 (using crayftn compiler)
+
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# 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>
+
+
+# PrgEnv-cray (default for hector phase 3)
+# use "module load netcdf/4.1.2" to setup netcdf (defines NETCDF_DIR and HDF5_DIR)
+
+%NCDF_HOME           $NETCDF_DIR
+%HDF5_HOME           $HDF5_DIR
+%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             -em -s integer32 -s real64 -O3
+%FFLAGS              -em -s integer32 -s real64 -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-pgf90_mobius.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-pgf90_mobius.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/NOC/arch-pgf90_mobius.fcm	(revision 8732)
@@ -0,0 +1,32 @@
+# mpi compiler options for NOCL's cluster Mobius
+# 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/cm/shared/apps/netcdf/pgi/64/4.1.1/include -I/usr/mpi/qlogic/include
+%NCDF_LIB             -L/cm/shared/apps/pgi/7.1-6/linux86-64/7.1-6/lib -L/usr/mpi/qlogic/lib64  -L/cm/shared/apps/netcdf/pgi/64/4.1.1/lib -lnetcdf
+%FC	             mpif90 -c
+%FCFLAGS             -i4 -r8 -O3 -Mfree  
+## FCFLAGS for debugging
+#%FCFLAGS             -i4 -r8 -Mfree -Ktrp=fp -g -C 
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%LDFLAGS                  
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -rs 
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-PW6_C1A.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-PW6_C1A.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-PW6_C1A.fcm	(revision 8732)
@@ -0,0 +1,29 @@
+# POWER 6 at ECMWF
+# 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>
+#-g -C -qsigtrap 
+
+%NCDF_INC            -I /usr/local/apps/netcdf/3.6.3/LP64/include
+%NCDF_LIB            -L /usr/local/apps/netcdf/3.6.3/LP64/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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-PW6_METO.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-PW6_METO.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-PW6_METO.fcm	(revision 8732)
@@ -0,0 +1,29 @@
+# IBM POWER6  UKMO
+# 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/opt/netcdf/netcdf-3.6.0-p1_ec/include
+%NCDF_LIB            -L /opt/netcdf/netcdf-3.6.0-p1_ec/lib -lnetcdf
+%FC                  mpxlf90_r
+%FCFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr6 -NS32768 -I/opt/netcdf-3.6.0-p1_ex/include -qxflag=p6div:p6divmsg -g -O3 -qnostrict 
+%FFLAGS              -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr6 -NS32768 -I/opt/netcdf-3.6.0-p1_ex/include -qxflag=p6div:p6divmsg -g -O3 -qnostrict 
+%LD                  mpxlf90_r
+%LDFLAGS             -L /opt/netcdf/netcdf-3.6.0-p1_ec/lib -lnetcdf -O3 -L/projects/um1/lib -lsig -O3 -L MASS
+%FPPFLAGS            -E -P -traditional -I/usr/lpp/ppe.poe/include/thread64
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-XT6_HECTOR.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-XT6_HECTOR.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-XT6_HECTOR.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-g95_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-g95_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-g95_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-g95_osx.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-g95_osx.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-g95_osx.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-gfortran_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-gfortran_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-gfortran_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-gfortran_osx.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-gfortran_osx.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-gfortran_osx.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm	(revision 8732)
@@ -0,0 +1,32 @@
+# 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>
+# debug: -g  -check bounds -check uninit -check pointers -traceback 
+
+%NCDF_INC            -I$NETCDF_INC
+%NCDF_LIB            -L$NETCDF_LIB -lnetcdff -lnetcdf -L$HDF5_LIB -lhdf5_hl -lhdf5 -lz
+
+%CPP                 cpp
+%FC                  mpif90
+%FCFLAGS             -O2 -fp-model precise  -traceback -r8  -convert big_endian -assume byterecl
+%FFLAGS              %FCFLAGS
+%LD                   mpif90
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -O2
+%AR                  ar
+%ARFLAGS             -rs
+%MK                  gmake
+%USER_INC            -I$XIOS_INC %NCDF_INC
+%USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_linux_omp.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_linux_omp.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_linux_omp.fcm	(revision 8732)
@@ -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 -openmp
+%FFLAGS 	            -r8 -O3  -traceback -openmp
+%LD                  ifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_osx.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_osx.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-ifort_osx.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-lahey_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-lahey_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-lahey_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-mpxlf_aix.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-mpxlf_aix.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-mpxlf_aix.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-nag_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-nag_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-nag_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-pathscale_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-pathscale_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-pathscale_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-pgf90_linux.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-pgf90_linux.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-pgf90_linux.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_aix.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_aix.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_aix.fcm	(revision 8732)
@@ -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                  xlf90_r
+%FCFLAGS             -qsuffix=f=f90 -qrealsize=8 -qextname -NS32768 -qnostrict -O5 -d -qsmp=omp -qhot -qessl -qipa -qreport
+%FFLAGS              -qrealsize=8 -qextname -NS32768 -qnostrict -O5 -d -qsmp=omp -qhot -qessl -qipa -qreport 
+%LD                  xlf90_r
+%LDFLAGS
+%FPPFLAGS            -P -C
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_osx.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_osx.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_osx.fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_pwr6.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_pwr6.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/OLD/arch-xlf_pwr6.fcm	(revision 8732)
@@ -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                  xlf90_r
+%FCFLAGS             -qsuffix=f=f90 -qrealsize=8 -qextname -qarch=pwr6 -qtune=pwr6 -NS32768 -qxflag=p6div:p6divmsg -qnostrict -O5 -d -qsmp=omp -qhot -qessl -qipa -qreport
+%FFLAGS              -qrealsize=8 -qextname -qarch=pwr6 -qtune=pwr6 -NS32768 -qxflag=p6div:p6divmsg -qnostrict -O5 -d -qsmp=omp -qhot -qessl -qipa -qreport 
+%LD                  xlf90_r
+%LDFLAGS
+%FPPFLAGS            -P -C
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 8732)
@@ -0,0 +1,64 @@
+# 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
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%HDF5_HOME           /fibre/omfman/NETCDF_PAR
+%NCDF_HOME           /fibre/omfman/NETCDF_PAR
+%XIOS_HOME           /fibre/omfman/XIOS
+%OASIS_HOME          
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+# Note use of -Bstatic because the library root directories may not be accessible to the back-end compute nodes
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -Bstatic -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -Bdynamic -lz
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  ifort
+%FCFLAGS             -r8 -O3 -fp-model precise -xT -ip -vec-report0
+%FFLAGS              -r8 -O3 -fp-model precise -xT -ip -vec-report0
+%LD                  ifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -lmpi -lstdc++ -lcurl
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_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
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm	(revision 8732)
@@ -0,0 +1,54 @@
+# POWER 6 at ECMWF
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+#
+# 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    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+#options:
+#
+#debug   : g -C -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:underflow:zerodivide:invalid:enable
+#portage : -qsource
+#format  : -qfree=f90 -qfixed -qsuffix=f=f90 -qsuffix=cpp=F90
+#others  : -qmaxmem=-1 -qsave -qlargepage 
+#
+%NCDF_INC            -I${NETCDF_INC1}
+%NCDF_LIB            -L${NETCDF_LIB1} -lnetcdff -lnetcdf -L${HDF5_LIB} -lhdf5_hl -lhdf5 -lz
+%XIOS_INC            -I${XIOS_INC}
+%XIOS_LIB            -L${XIOS_LIB} -lxios
+
+%XLF90_LIB           -lxlf90_r
+
+%CPP	             cpp
+%FC                  mpxlf90_r
+%FCFLAGS             -qsuffix=f=f90 -qsuffix=cpp=F90 -qfree=f90 -O3 -qrealsize=8 -qarch=auto -qtune=auto -qinitauto
+%FFLAGS              -qsuffix=f=f90 -qsuffix=cpp=F90 -qfixed    -O3 -qrealsize=8 -qarch=auto -qtune=auto -qinitauto
+%LD                  mpCC_r
+%FPPFLAGS
+%LDFLAGS             -O2
+%AR                  ar  
+%ARFLAGS             -r
+%MK                  gmake 
+%USER_INC            %XIOS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %NCDF_LIB %XLF90_LIB
+
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_METO.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_METO.fcm	(revision 8732)
@@ -0,0 +1,38 @@
+# IBM POWER7  UKMO
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# XIOS_INC    XIOS include files
+# XIOS_LIB    XIOS 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+
+
+%NCDF_INC            -I/home/cr/ocean/hadcv/netcdf/4.1.3_par/include
+%NCDF_LIB            -L/home/cr/ocean/hadcv/netcdf/4.1.3_par/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
+%XIOS_INC            -I/home/cr/ocean/hadcv/xios_lib/par/r618/xios/inc
+%XIOS_LIB            -L/home/cr/ocean/hadcv/xios_lib/par/r618/xios/lib -lxios
+%CPP	             cpp
+%FC                  mpxlf90_r
+%FCFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
+%FFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
+%LD                  mpCC_r
+%LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS
+%FPPFLAGS            -E -P -traditional -I/opt/ibmhpc/pecurrent/ppe.poe/include -I/usr/lpp/ppe.poe/include/thread64
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC %XIOS_INC
+%USER_LIB            %NCDF_LIB %XIOS_LIB
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm	(revision 8732)
@@ -0,0 +1,38 @@
+# IBM POWER7  UKMO
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# XIOS_INC    XIOS include files
+# XIOS_LIB    XIOS 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+
+%NCDF_INC            -I/home/dcalve/netcdf/4.1.3_seq/include
+%NCDF_LIB            -L/home/dcalve/netcdf/4.1.3_seq/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
+%XIOS_INC            -I/home/dstork/xios_lib/par/r521/xios/inc
+%XIOS_LIB            -L/home/dstork/xios_lib/par/r521/xios/lib -lxios
+%CPP	             cpp
+%FC                  mpxlf90_r
+%FCFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
+%FFLAGS              -qrealsize=8 -qextname -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF -qfixed
+%LD                  mpCC_r
+%LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS
+%FPPFLAGS            -E -P -traditional -I/opt/ibmhpc/pecurrent/ppe.poe/include -I/usr/lpp/ppe.poe/include/thread64
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC %XIOS_INC
+%USER_LIB            %NCDF_LIB %XIOS_LIB
+
+%CC                  xlc
+%CFLAGS              -O -qcpluscmt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-THALASSA.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-THALASSA.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-THALASSA.fcm	(revision 8732)
@@ -0,0 +1,68 @@
+# generic gfortran compiler options for OSX installed with macport, http://www.macports.org/
+#
+# port packages needed:
+#    sudo port install openmpi +gcc48
+#    sudo port install hdf5-18 +cxx +fortran +openmpi (I'am not sure cxx is needed)
+#    sudo port install netcdf         +openmpi
+#    sudo port install netcdf-fortran +openmpi
+#    sudo port install netcdf-cxx     +openmpi (I'am not sure it is needed)
+#    sudo port install p5-uri
+# add to your PATH /opt/local/lib/openmpi/bin so that mpif90 is properly known
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /nerc/packages/netcdf/4.3.3.1
+%HDF5_HOME           /nerc/packages/hdf5/1.8.15
+%XIOS_HOME           /noc/msm/working/nemo/acc/XIOS/xios-1.0
+%OASIS_HOME          
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdff -lnetcdf
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           
+%OASIS_LIB           
+
+%CPP	             cpp
+%FC	             mpif90
+%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer -ffree-line-length-none
+%FFLAGS              %FCFLAGS
+%LD                  %FC
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  make
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA.fcm	(revision 8732)
@@ -0,0 +1,60 @@
+# Ada  IBM x3750 at french IDRIS, http://www.idris.fr/ada/ada-hw-ada.html
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /smplocal/pub/NetCDF/4.1.3/mpi
+%HDF5_HOME           /smplocal/pub/HDF5/1.8.9/par
+%XIOS_HOME           $WORKDIR/XIOS2
+####%OASIS_HOME          $WORKDIR/oasis3-mct/BLD
+%OASIS_HOME          /not/defined
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -Bstatic -lnetcdff -lnetcdf -Bdynamic -L%HDF5_HOME/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz 
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  mpiifort -c -cpp
+%FCFLAGS             -DCPP_PARA -i4 -r8 -O3 -xAVX -fp-model precise
+%FFLAGS              %FCFLAGS
+%LD                  mpiifort
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA_DEBUG.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA_DEBUG.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA_DEBUG.fcm	(revision 8732)
@@ -0,0 +1,59 @@
+# Ada  IBM x3750 at french IDRIS, http://www.idris.fr/ada/ada-hw-ada.html
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /smplocal/pub/NetCDF/4.1.3/mpi
+%HDF5_HOME           /smplocal/pub/HDF5/1.8.9/par
+%XIOS_HOME           $WORKDIR/XIOS2
+%OASIS_HOME          /not/yet/defined
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -Bstatic -lnetcdff -lnetcdf -Bdynamic -L%HDF5_HOME/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz 
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  mpiifort -c -cpp
+%FCFLAGS             -DCPP_PARA -i4 -r8 -g -O0 -debug all -traceback -xAVX -fp-model precise -check all -ftrapuv -fpe0   
+%FFLAGS              %FCFLAGS
+%LD                  mpiifort
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm	(revision 8732)
@@ -0,0 +1,54 @@
+# Ada  IBM x3750 at french IDRIS, http://www.idris.fr/ada/ada-hw-ada.html
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /smplocal/pub/NetCDF/4.1.3/mpi
+%HDF5_HOME           /smplocal/pub/HDF5/1.8.9/par
+%XIOS_HOME           $WORKDIR/XIOS2
+%OASIS_HOME          /not/yet/defined
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -Bstatic -lnetcdff -lnetcdf -Bdynamic -L%HDF5_HOME/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz 
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  mpiifort -c -cpp
+%FCFLAGS             -DCPP_PARA -i4 -r8 -O0 -xAVX -fp-model precise
+%FFLAGS              %FCFLAGS
+%LD                  mpiifort
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_CURIE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_CURIE.fcm	(revision 8732)
@@ -0,0 +1,64 @@
+# Curie BULL at TGCC, http://www-hpc.cea.fr/en/complexe/tgcc-curie.htm
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME            /usr/local/netcdf-4.3.3.1_hdf5_parallel
+%HDF5_HOME           /usr/local/hdf5-1.8.12_parallel
+%XIOS_HOME           $WORKDIR/xios-1.0
+%OASIS_HOME          $WORKDIR/now/models/oa3mct
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdff -lnetcdf -L%HDF5_HOME/lib -lhdf5_hl -lhdf5 -lhdf5
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  mpif90 -c -cpp
+# for Curie Fat Node
+#%FCFLAGS             -i4 -r8 -O3 -fp-model precise -xSSE4.2 
+# for Curie Thin Node
+#%FCFLAGS             -i4 -r8 -O3 -fp-model precise -xAVX
+# for Curie all Node
+%FCFLAGS             -i4 -r8 -O3 -fp-model precise
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm	(revision 8732)
@@ -0,0 +1,64 @@
+# Mobilis - ClusterVision X86_64 cluster at NOCS
+#
+# Currently Loaded Modulefiles:
+#   1) gcc/4.8.1                               
+#   2) intel/compiler/64/14.0/2013_sp1.1.106
+#   3) openmpi/intel/64/1.6.5
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /home/acc/shared
+%HDF5_HOME           /home/acc/shared
+%XIOS_HOME           /home/acc/XIOS_2.0
+%OASIS_HOME          
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdf -lnetcdff -lnetcdf -L%HDF5_HOME/lib -lhdf5_hl -lhdf5 -lhdf5 -lcurl
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           
+%OASIS_LIB           
+
+%CPP	             cpp
+%FC                  mpif90 -c -cpp
+%FCFLAGS             -i4 -r8 -O3 -fp-model source -xAVX
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  icc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_VAYU.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_VAYU.fcm	(revision 8732)
@@ -0,0 +1,59 @@
+# Vayu Sun Constellation at Australian NCI, http://nf.nci.org.au/facilities/vayu/hardware.php
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /short/e14/$( whoami )/util
+%HDF5_HOME           /short/e14/$( whoami )/util
+%XIOS_HOME           /short/e14/$( whoami )/now/models/xios
+%OASIS_HOME          /short/e14/$( whoami )/now/models/oa3mct
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdff -lnetcdf -L%HDF5_HOME/lib -lhdf5_hl -lhdf5 -lhdf5 -lz
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  mpif90 -c -cpp
+%FCFLAGS             -i4 -r8
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm	(revision 8732)
@@ -0,0 +1,59 @@
+# Yellowstone IBM at NCAR, http://www2.cisl.ucar.edu/resources/yellowstone
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /glade/apps/opt/netcdf-mpi/4.2/intel/12.1.4
+%HDF5_HOME           /glade/apps/opt/hdf5-mpi/1.8.9/intel/12.1.4
+%XIOS_HOME           /glade/p/work/$( whoami )/now/models/xios
+%OASIS_HOME          /glade/p/work/$( whoami )/now/models/oa3mct
+
+%NCDF_INC            -I%NCDF_HOME/include 
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdff -lnetcdf -L%HDF5_HOME/lib -lhdf5_hl -lhdf5 -lhdf5
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  mpif90 -c -cpp
+%FCFLAGS            -i4 -r8 -O3 -fp-model precise -xAVX
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%LDFLAGS             -lstdc++
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC40_METO.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC40_METO.fcm	(revision 8732)
@@ -0,0 +1,66 @@
+# compiler options for Archer CRAY XC-40 (using crayftn compiler)
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+# This arch file depends on loading XIOS-PrgEnv/2.0/24708
+
+%NCDF_HOME           $NETCDF_DIR
+%HDF5_HOME           $HDF5_DIR
+%XIOS_HOME           $xios_path
+%OASIS_HOME          $prism_path
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz
+
+%XIOS_INC            -I%XIOS_HOME/inc
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIBDIR        -L%OASIS_HOME/lib
+%OASIS_LIB           -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP                 cpp
+%FC                  ftn
+
+%FCFLAGS             -em -s real64 -s integer32  -O2 -hflex_mp=intolerant -e0 -ez
+%FFLAGS              -em -s real64 -s integer32  -O0 -hflex_mp=strict -e0 -ez -Rb
+%LD                  ftn
+%FPPFLAGS            -P -E -traditional-cpp
+%LDFLAGS             -hbyteswapio
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+
+%USER_INC            %NCDF_INC %XIOS_INC
+%USER_LIB            %NCDF_LIB %XIOS_LIB 
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC_ARCHER.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC_ARCHER.fcm	(revision 8732)
@@ -0,0 +1,63 @@
+# compiler options for Archer CRAY XC-30 (using crayftn compiler)
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           $NETCDF_DIR
+%HDF5_HOME           $HDF5_DIR
+%XIOS_HOME           /work/n01/n01/acc/XIOS_r474
+#OASIS_HOME          
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+#OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+#OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  ftn
+#FCFLAGS             -em -s integer32 -s real64 -O3
+#FFLAGS              -em -s integer32 -s real64 -O3
+%FCFLAGS             -em -s integer32 -s real64 -O0 -e0 -eZ
+%FFLAGS              -em -s integer32 -s real64 -O0 -e0 -eZ
+%LD                  CC -Wl,"--allow-multiple-definition"
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %XIOS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %NCDF_LIB
+#USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+#USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm	(revision 8732)
@@ -0,0 +1,61 @@
+# compiler options for Archer CRAY XC-30 (using intel compiler)
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           $NETCDF_DIR
+%HDF5_HOME           $HDF5_DIR
+%XIOS_HOME           /work/n01/n01/acc/XIOS_r484
+#OASIS_HOME          
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+#OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+#OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp
+%FC                  ftn
+%FCFLAGS             -integer-size 32 -real-size 64 -O3 -fp-model source -zero -fpp -warn all
+%FFLAGS              -integer-size 32 -real-size 64 -O3 -fp-model source -zero -fpp -warn all
+%LD                  CC -Wl,"--allow-multiple-definition"
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %XIOS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %NCDF_LIB
+#USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+#USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-macport_osx.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-macport_osx.fcm	(revision 8732)
@@ -0,0 +1,68 @@
+# generic gfortran compiler options for OSX installed with macport, http://www.macports.org/
+#
+# port packages needed:
+#    sudo port install openmpi +gcc48
+#    sudo port install hdf5-18 +cxx +fortran +openmpi (I'am not sure cxx is needed)
+#    sudo port install netcdf         +openmpi
+#    sudo port install netcdf-fortran +openmpi
+#    sudo port install netcdf-cxx     +openmpi (I'am not sure it is needed)
+#    sudo port install p5-uri
+# add to your PATH /opt/local/lib/openmpi/bin so that mpif90 is properly known
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /opt/local
+%HDF5_HOME           /opt/local
+%XIOS_HOME           /Users/$( whoami )/xios-2.0
+%OASIS_HOME          /not/defined
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdff -lnetcdf
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp-mp-4.8
+%FC	             mpif90 
+%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer -ffree-line-length-none
+%FFLAGS              %FCFLAGS
+%LD                  %FC
+%LDFLAGS             -lstdc++ -lmpi_cxx
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  make
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-macport_osx_debug.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-macport_osx_debug.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-macport_osx_debug.fcm	(revision 8732)
@@ -0,0 +1,69 @@
+# generic gfortran compiler options for OSX installed with macport, http://www.macports.org/
+#
+# port packages needed:
+#    sudo port install openmpi +gcc48
+#    sudo port install hdf5-18 +cxx +fortran +openmpi (I'am not sure cxx is needed)
+#    sudo port install netcdf         +openmpi
+#    sudo port install netcdf-fortran +openmpi
+#    sudo port install netcdf-cxx     +openmpi (I'am not sure it is needed)
+#    sudo port install p5-uri
+# add to your PATH /opt/local/lib/openmpi/bin so that mpif90 is properly known
+#
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME   root directory containing lib for XIOS
+# OASIS_HOME  root directory containing lib for OASIS
+#
+# NCDF_INC    netcdf4 include file
+# NCDF_LIB    netcdf4 library
+# XIOS_INC    xios include file    (taken into accound only if key_iomput is activated)
+# XIOS_LIB    xios library         (taken into accound only if key_iomput is activated)
+# OASIS_INC   oasis include file   (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB   oasis library        (taken into accound only if key_oasis3 is activated)
+#
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    complete list of include files
+# USER_LIB    complete list of libraries to pass to the linker
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+#
+# Note that:
+#  - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+#  - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME           /opt/local
+%HDF5_HOME           /opt/local
+%XIOS_HOME           /Users/sflod/XIOS
+%OASIS_HOME          /not/defined
+
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%NCDF_HOME/lib -lnetcdff -lnetcdf
+%XIOS_INC            -I%XIOS_HOME/inc 
+%XIOS_LIB            -L%XIOS_HOME/lib -lxios
+%OASIS_INC           -I%OASIS_HOME/build/lib/mct -I%OASIS_HOME/build/lib/psmile.MPI1
+%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip
+
+%CPP	             cpp-mp-4.9
+%FC	             mpif90 
+#%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer -ffree-line-length-none -fbounds-check
+%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer -ffree-line-length-none -fcheck=bounds -finit-real=nan
+%FFLAGS              %FCFLAGS
+%LD                  %FC
+%LDFLAGS             -lstdc++ -lmpi_cxx
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  make
+%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC
+%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm	(revision 8732)
@@ -0,0 +1,37 @@
+# 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>
+# CC          C compiler used to compile conv for AGRIF
+# CFLAGS      compiler flags used with CC
+# debug: -g  -check bounds -check uninit -check pointers -traceback
+
+#
+%NCDF_INC            -I$NETCDF_INC
+%NCDF_LIB            -L$NETCDF_LIB -lnetcdff -lnetcdf -L$HDF5_LIB -lhdf5_hl -lhdf5 -lz
+
+%CPP	             cpp
+%FC                  mpif90
+%FCFLAGS             -O2 -fp-model precise  -traceback -r8  -convert big_endian -assume byterecl
+%FFLAGS              %FCFLAGS
+%LD                   mpif90
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -O2
+%AR                  ar
+%ARFLAGS             -rs
+%MK                  gmake
+%USER_INC            -I$XIOS_INC %NCDF_INC
+%USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
+
+%CC                  cc
+%CFLAGS              -O0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo-opa.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/file_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/file_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/file_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,149 @@
+<?xml version="1.0"?>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+<!--old      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> old --> <!-- 1h files --> 
+   <!-- TMB files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."  >                      
+
+   <file id="file9" name_suffix="_shelftmb_grid_T" description="ocean T grid variables" enabled=".TRUE." >
+     <field field_ref="top_temp"           name="votemper_top"   operation="instant" enabled=".TRUE." />
+     <field field_ref="mid_temp"           name="votemper_mid"   operation="instant" enabled=".TRUE." />
+     <field field_ref="bot_temp"           name="votemper_bot"   operation="instant" enabled=".TRUE." />
+     <field field_ref="sshnmasked"         name="sossheig"       operation="instant" enabled=".TRUE." /> 
+     <field field_ref="top_sal"            name="vosaline_top"   operation="instant" enabled=".TRUE." />
+     <field field_ref="mid_sal"            name="vosaline_mid"   operation="instant" enabled=".TRUE." />
+     <field field_ref="bot_sal"            name="vosaline_bot"   operation="instant" enabled=".TRUE." />
+   </file>
+
+   <file id="file10" name_suffix="_shelftmb_grid_U" description="TMB ocean U grid variables" enabled=".TRUE." >
+     <field field_ref="top_u"         name="vozocrtx_top"   operation="instant" />
+     <field field_ref="mid_u"         name="vozocrtx_mid"   operation="instant" />
+     <field field_ref="bot_u"         name="vozocrtx_bot"   operation="instant" />
+     <field field_ref="baro_u"        name="vobtcrtx"       operation="instant" />
+   </file>
+
+   <file id="file11" name_suffix="_shelftmb_grid_V" description="TMB ocean V grid variables" enabled=".TRUE." >
+     <field field_ref="top_v"         name="vomecrty_top"   operation="instant" />
+     <field field_ref="mid_v"         name="vomecrty_mid"   operation="instant" />
+     <field field_ref="bot_v"         name="vomecrty_bot"   operation="instant" />
+     <field field_ref="baro_v"        name="vobtcrty"       operation="instant" />
+   </file>
+
+      </file_group>
+
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+
+      <file_group id="25h_mean" output_freq="1d" output_level="10" enabled=".TRUE.">
+
+
+     <file id="file12" name_suffix="_25hourm_grid_T" description="ocean T grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="temper25h"   name="votemper"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="tempis25h"   name="votempis"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="salin25h"    name="vosaline"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="ssh25h"      name="sossheig"  operation="instant" enabled=".TRUE."/>
+    </file>
+
+     <file id="file13" name_suffix="_25hourm_grid_U" description="ocean U grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="vozocrtx25h" name="vozocrtx"  operation="instant" enabled=".TRUE."/>
+    </file>
+
+     <file id="file14" name_suffix="_25hourm_grid_V" description="ocean V grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="vomecrty25h" name="vomecrty"  operation="instant" enabled=".TRUE."/>
+    </file>
+
+     <file id="file15" name_suffix="_25hourm_grid_W" description="ocean W grid variables, 25h meaned" enabled=".TRUE." >
+     <field field_ref="vomecrtz25h"          name="vomerctz"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="woce"                 name="vovecrtz"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="avt25h"               name="votkeavt"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="avm25h"               name="votkeavm"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="tke25h"               name="votke"  operation="instant" enabled=".TRUE."/>
+     <field field_ref="mxln25h"              name="mxln"   operation="instant" enabled=".TRUE."/>
+    </file>
+      </file_group>
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+	
+      </file_group>
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+
+	<file id="file4" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"    />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"    />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+	
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+
+   </file_definition>
+    
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,27 @@
+<?xml version="1.0"?>
+<simulation> 
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios">
+
+      <variable_definition>
+	
+	  <variable id="info_level"                type="int">0</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,400 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : AMM12 configuration namelist used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "AMM12"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    1296   !  last  time step (std 1 day = 144)
+   nn_date0    =  20120102 !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_leapy    =       1   !  Leap year calendar (1) or not (0)
+   ln_rstart   =  .true.  !  start from rest (F) or from a restart file (T)
+   nn_euler    =       1   !  = 0 : start with forward time step if ln_rstart=.true.
+   cn_ocerst_in   = "amm12_restart_oce"   !  suffix of ocean restart name (input)
+   cn_ocerst_out  = "restart_oce_out"   !  suffix of ocean restart name (input)
+   nn_stock    =    1296   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =     144   !  frequency of write in the output file   (modulo referenced to nit000) 
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .true.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "AMM_R12_sco_domcfg"     ! domain configuration filename
+/
+
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+!              !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   ln_flx      = .true.    !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+   nn_ice      = 0         !  =0 no ice boundary condition
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_utau = 'amm12_utau',          1        , 'utau'    ,  .false.     , .false., 'daily'   ,  ''      ,  ''      , ''
+   sn_vtau = 'amm12_vtau',          1        , 'vtau'    ,  .false.     , .false., 'daily'   ,  ''      ,  ''      , ''
+   sn_qtot = 'amm12_flx' ,          3        , 'sonsfldo',  .true.      , .false., 'daily'   ,  ''      ,  ''      , ''
+   sn_qsr  = 'amm12_flx' ,          3        , 'soshfldo',  .true.      , .false., 'daily'   ,  ''      ,  ''      , ''
+   sn_emp  = 'amm12_flx' ,          3        , 'sowafldo',  .true.      , .false., 'daily'   ,  ''      ,  ''      , ''
+   cn_dir  = './fluxes/'        !  root directory for the location of the flux files
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'amm12_rivers'       ,        24         , 'rorunoff',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_cnf      = 'runoff_1m_nomask'   ,         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_s_rnf    = 'amm12_rivers'       ,        24         , 'rosaline',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_t_rnf    = 'amm12_rivers'       ,        24         , 'rotemper',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_dep_rnf  = 'amm12_rivers'       ,        24         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   ln_rnf_depth = .true.    !  read in depth information for runoff
+   ln_rnf_tem   = .true.    !  read in temperature information for runoff
+   ln_rnf_sal   = .true.    !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_apr     = 'amm12_mslp'     ,          1        ,  'p_msl'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+
+   cn_dir      = './fluxes/' !  root directory for the location of the bulk files
+   rn_pref     = 101000.     !  reference atmospheric pressure   [N/m2]/
+   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F)
+   ln_apr_obc  = .true.    !  inverse barometer added to OBC ssh data
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_sst      = 'amm12_sstref'    ,        24         ,  'sst'     ,     .true.     , .false. , 'daily'   , .false. , ''       , '' , ''
+   sn_sss      = 'sss_data'        ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , .false. , ''       , '' , ''
+
+   cn_dir      = 'fluxes/' !  root directory for the location of the runoff files
+   nn_sstr     =     1     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_deds     =  -27.7    !  magnitude of the damping on salinity   [mm/day]
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =     0     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters
+!-----------------------------------------------------------------------
+   ln_tide     = .true.
+   clname(1)     =   'Q1'   !  name of constituent
+   clname(2)     =   'O1'
+   clname(3)     =   'P1'
+   clname(4)     =   'S1'
+   clname(5)     =   'K1'
+   clname(6)     =   '2N2'
+   clname(7)     =   'MU2'
+   clname(8)     =   'N2'
+   clname(9)     =   'NU2'
+   clname(10)    =   'M2'
+   clname(11)    =   'L2'
+   clname(12)    =   'T2'
+   clname(13)    =   'S2'
+   clname(14)    =   'K2'
+   clname(15)    =   'M4'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+    ln_bdy         = .true.
+    nb_bdy         =  1
+    cn_dyn2d       = 'flather'
+    nn_dyn2d_dta   =  3
+    cn_tra         =  'frs'
+    nn_tra_dta    =   1 
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh =     'amm12_bdyT_dyn2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_u2d =     'amm12_bdyU_dyn2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_v2d =     'amm12_bdyV_dyn2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_u3d  =    'amm12_bdyU_dyn3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_v3d  =    'amm12_bdyV_dyn3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_tem  =    'amm12_bdyT_tra'   ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_sal  =    'amm12_bdyT_tra'   ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   cn_dir  =    './bdydta/'
+   ln_full_vel = .false.
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri2    =    2.5e-3 !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    0.0e0  !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_loglayer =    .true. !  loglayer bottom friction (only effect when nn_bfr = 2)
+   rn_bfrz0    =    0.003  !  bottom roughness (only effect when ln_loglayer = .true.)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10   = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .true.   !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        =   50.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_prj  = .true.   !  s-coordinate (Pressure Jacobian scheme)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient 
+!-----------------------------------------------------------------------
+   ln_dynspg_ts = .true.    ! split-explicit free surface
+      ln_bt_auto    = .false.  ! Number of sub-step defined from:
+         nn_baro       = 30       ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .true.     !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     60.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.0e+10     !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   0.1e-6  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.1e-6  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.   !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_charn =  100000.     !  Charnock constant for wb induced roughness length
+   nn_z0_met = 1           !  Method for surface roughness computation (0/1/2)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diatmb  !  Top Middle Bottom Output
+!-----------------------------------------------------------------------
+   ln_diatmb  = .true.    !  Choose Top Middle and Bottom output or not
+/
+!-----------------------------------------------------------------------
+&nam_dia25h  !  25h Mean Output
+!-----------------------------------------------------------------------
+   ln_dia25h  = .true.    ! Choose 25h mean output or not
+/
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_zdfgls key_diainstant key_mpp_mpi key_iomput
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/domain_def.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/domain_def.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/domain_def.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/field_def.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/field_def.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/field_def.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,165 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1950-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."> <!-- 1h files -->
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="sst"          name="sosstsst"  />
+	  <field field_ref="sss"          name="sosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+	  <field field_ref="empmr"        name="sowaflup"  />
+	  <field field_ref="qsr"          name="soshfldo"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
+	  <field field_ref="qt"           name="sohefldo"  />
+	  <field field_ref="mldr10_1"     name="somxl010"  />
+	  <field field_ref="mldkz5"       name="somixhgt"  />
+    </file>
+	
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+          <field field_ref="utau"         name="sozotaux"  />
+    </file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+          <field field_ref="vtau"         name="sometauy"  /> 
+    </file>
+	
+	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz" />
+          <field field_ref="avt"          name="votkeavt" />
+          <field field_ref="aht2d"        name="soleahtw" />
+    </file>
+      </file_group>
+
+
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+	<file id="file5" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="sst"          name="sosstsst"  />
+	  <field field_ref="sss"          name="sosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+	  <field field_ref="empmr"        name="sowaflup"  />
+	  <field field_ref="qsr"          name="soshfldo"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
+	  <field field_ref="qt"           name="sohefldo"  />
+	  <field field_ref="mldr10_1"     name="somxl010"  />
+	  <field field_ref="mldkz5"       name="somixhgt"  />
+    </file>
+	
+	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+          <field field_ref="utau"         name="sozotaux"  />
+    </file>
+	
+	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+          <field field_ref="vtau"         name="sometauy"  /> 
+    </file>
+	
+	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz" />
+          <field field_ref="avt"          name="votkeavt" />
+          <field field_ref="aht2d"        name="soleahtw" />
+    </file>
+      </file_group>
+
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+    </grid_definition>   
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">25000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,329 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : 1D configuration based on Kato-Philipps () exp.
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "PAPA"   !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   87600   !  last  time step
+   nn_date0    =  20100615 !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_leapy    =       1   !  Leap year calendar (1) or not (0)
+   nn_stock    =   87600   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =     240   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration   
+!-----------------------------------------------------------------------
+   cp_cfg      =  "papa"                 !  name of the configuration
+   jp_cfg      =       1                 !  resolution of the configuration
+!   jpidta      =       3                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2
+!   jpjdta      =       3                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2 
+!   jpkdta      =      75                 !  number of levels      ( >= jpk )
+!   jpiglo      =       3                 !  1st dimension of global domain --> i  = jpidta
+!   jpjglo      =       3                 !  2nd    -                  -    --> j  = jpjdta
+   jperio      =       0                 !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
+   rn_bathy    = 4198.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_rdt      =  360.     !  time step for the dynamics 
+   ppglam0     =    -150.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      50.0               ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =       0.1               !  zonal      grid-spacing (degrees)
+   ppe2_deg    =       0.1               !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0               !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829    !  ORCA r4, r2 and r05 coefficients
+   ppa0        =    103.9530096000000    ! (default coefficients)
+   ppa1        =     2.415951269000000   !
+   ppkth       =      15.35101370000000  !
+   ppacr       =       7.0               !
+   ppdzmin     =  999999.0               !  Minimum vertical spacing
+   pphmax      =  999999.0               !  Maximum depth
+   ldbletanh   =  .TRUE.                 !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  100.7609285000000      !  Double tanh function parameters
+   ppkth2      =  48.02989372000000      !
+   ppacr2      =   13.00000000000        !
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d        !   1D configuration options                             ("key_c1d")
+!-----------------------------------------------------------------------
+   ln_c1d_locpt= .false.   ! Localization of 1D config in a grid (T) or independant point (F)
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_tem  = 'init_PAPASTATION',   24        ,'votemper' ,  .false.     , .true.,  'daily'  , ''       , ' '        , ''
+   sn_sal  = 'init_PAPASTATION',   24        ,'vosaline' ,  .false.     , .true.,  'daily'  , ''       , ' '        , ''
+   !
+   cn_dir        = './'     !  root directory for the location of the runoff files
+   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T)
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_wndi     = 'forcing_PAPASTATION_1h' ,         1         , 'wndwe'   ,   .true.     , .false. , 'yearly' , '' , '', ''
+   sn_wndj     = 'forcing_PAPASTATION_1h' ,         1         , 'wndsn'   ,   .true.     , .false. , 'yearly' , '' , '', ''
+   sn_qsr      = 'forcing_PAPASTATION_1h' ,         1         , 'qsr'     ,   .false.    , .false. , 'yearly' , '' , '', ''
+   sn_qlw      = 'forcing_PAPASTATION_1h' ,         1         , 'qlw'     ,   .false.    , .false. , 'yearly' , '' , '', ''
+   sn_tair     = 'forcing_PAPASTATION_1h' ,         1         , 'tair'    ,   .true.     , .false. , 'yearly' , '' , '', ''
+   sn_humi     = 'forcing_PAPASTATION_1h' ,         1         , 'humi'    ,   .true.     , .false. , 'yearly' , '' , '', ''
+   sn_prec     = 'forcing_PAPASTATION_1h' ,         1         , 'prec'    ,   .false.    , .false. , 'yearly' , '' , '', ''
+   sn_snow     = 'forcing_PAPASTATION_1h' ,         1         , 'snow'    ,   .false.    , .false. , 'yearly' , '' , '', ''
+   sn_slp      = 'slp.15JUNE2009_fill'        ,         6         , 'SLP',        .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+
+   nn_bulk_algo = 1        !  Bulk algorithm to use to compute bulk transfer coefficients Cd, Ce and Ch
+                           !  1 => "NCAR" algorithm        (Large and Yeager, 2008)
+                           !  2 => "COARE 3.0" algorithm   (Fairall et al 2003)
+                           !  3 => "ECMWF" algorithm       (IFS cycle 31)
+                           !  4 => "COARE 3.5" algorithm   (Edson et al 2013)
+
+   rn_zqt      =  2.       !  Air temperature and humidity reference height (m)
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_sas    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_chl      ='chlorophyll_PAPASTATION', -1    , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_eos80    = .true.         !  = Use EOS80 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+! C1D : no advection scheme 
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+! C1D : no lateral diffusion  
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!-----------------------------------------------------------------------
+! C1D : no eiv  
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+! C1D : no advection scheme 
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_uvd    !   data: U & V currents                                 ("key_c1d")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient                            (default: NO spg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   ln_dynldf_lap    =  .false.  !  laplacian operator
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_zdfevd   = .false.        !  enhanced vertical diffusion (evd) (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 60       !  time step frequency for transports computing
+    nn_dctwri   = 60       !  time step frequency for transports writing
+    nn_secdebug = 0        !      0 : no section to debug
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/cpp_C1D_PAPA.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/cpp_C1D_PAPA.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/C1D_PAPA/cpp_C1D_PAPA.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_c1d key_zdfgls
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,121 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+    <field_definition src="./field_def_nemo-pisces.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo.xml"/>     
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/field_def_nemo-pisces.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/field_def_nemo-pisces.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/field_def_nemo-pisces.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-pisces.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/file_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/file_def_nemo.xml	(revision 8732)
@@ -0,0 +1,36 @@
+<?xml version="1.0"?>
+<!--
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,27 @@
+<?xml version="1.0"?>
+<simulation> 
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios">
+
+      <variable_definition>
+	
+	  <variable id="info_level"                type="int">0</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,320 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : GYRE_PISCES Configuration namelist to overwrite reference dynamical namelist
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namusr_def    !   GYRE user defined namelist  
+!-----------------------------------------------------------------------
+   nn_GYRE     =     1     !  GYRE resolution [1/degrees]
+   ln_bench    = .false.   !  ! =T benchmark with gyre: the gridsize is kept constant
+   jpkglo      =    31     !  number of model levels
+/
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "GYRE"   !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    4320   !  last  time step
+   nn_leapy    =      30   !  Leap year calendar (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 nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration   
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+!
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    0      !  create (>0) a mesh file or not (=0)
+   !
+   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  
+   cn_dir        = './'      !  root directory for the location of the runoff files
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+   ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_eos80    = .true.         !  = Use EOS80 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.    !  z-coordinate - full steps
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      = 100000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =      0.     !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 60       !  time step frequency for transports computing
+    nn_dctwri   = 60       !  time step frequency for transports writing
+    nn_secdebug = 0        !      0 : no section to debug
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_cfg	(revision 8732)
@@ -0,0 +1,60 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO-TOP : GYRE_BFM configuration namelist used to overwrite SHARED/namelist_top_ref
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+   nn_writetrc   =  0        !  time step frequency for sn_tracer outputs
+   ln_top_euler  = .true.    !  use Euler time-stepping for TOP
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namtrc     !   tracers definition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_trcdta     =  .false.        !  Initialisation from data input file (T) or not (F)
+!
+!              !    name   !           title of the field              !   units    ! initial data ! save   !
+!              !           !                                           !            ! from file    ! or not !
+!              !           !                                           !            ! or not       !        !
+   sn_tracer(1)   = 'DUMMY   ' , 'Dummy tracer      '                 ,  'dummy-units' ,  .false.     ,  .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta    ! initial conditions
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_bc     ! boundary conditions
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
+!                          or mixed-layer trends          ('key_trdmld_trc')
+!----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_top_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/runscript
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/runscript	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/EXP00/runscript	(revision 8732)
@@ -0,0 +1,40 @@
+#! /bin/sh 
+### This is an example of a runscript for the LSF queueing system
+#BSUB -a poe
+#BSUB -J GYRE_BFM         # Name of the job.
+#BSUB -o GYRE_BFM_%J.out  # Appends std output to file %J.out.
+#BSUB -e GYRE_BFM_%J.err  # Appends std error to file %J.out.
+#BSUB -P nemo
+#BSUB -q poe_short    # queue
+#BSUB -n 4            # Number of CPUs
+
+set -evx
+
+export MP_WAIT_MODE=poll
+export MP_POLLING_INTERVAL=30000000
+export MP_SHARED_MEMORY=yes
+export MP_EUILIB=us
+export MP_EUIDEVICE=sn_all
+export LDR_CNTRL=TEXTPSIZE=64K@STACKPSIZE=64K@DATAPSIZE=64K
+export MP_TASK_AFFINITY=core
+
+EXP="EXP00"
+
+workdir="TO_BE_SET_BY_USER"
+execdir=`pwd`
+
+if [ ! -d ${workdir} ] ; then
+  mkdir -p ${workdir}
+fi
+
+cd ${workdir}
+rm -rf *
+# Copy files to exp folder
+cp ${execdir}/opa ./opa.x
+cp ${execdir}/* ./
+
+# Launch the model
+
+mpirun.lsf opa.x 
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/README	(revision 8732)
@@ -0,0 +1,90 @@
+-----------------------------------------------------------------------
+Coupling with the Biogeochemical Flux Model (BFM)
+-----------------------------------------------------------------------
+Author: M. Vichi, BFM system team and NEMO system team
+INFO HELPDESK: info@bfm-community.eu
+WEB SITE: www.bfm-community.eu
+REVISION DATE: October 2013
+
+Please address any technical query to the BFM System Team 
+bfm_st@lists.cmcc.it
+-----------------------------------------------------------------------
+
+-----------------------------------------------------------------------
+What is the BFM?
+-----------------------------------------------------------------------
+The Biogeochemical Flux Model (BFM) is a numerical model for the 
+simulation of the dynamics of major biogeochemical properties 
+in marine ecosystems.  The BFM is open source software freely available 
+under the GNU Public License. The model can be used in standalone mode 
+to simulate a 0-D system or coupled with other OGCM.
+The coupling with NEMO is maintained by CMCC as part of the 
+NEMO system team activity
+
+-----------------------------------------------------------------------
+How to get the BFM code
+-----------------------------------------------------------------------
+The code can be downloaded from http://www.bfm-community.eu after
+the registration of a new user. Follow the instructions on how to 
+install the code. It is recommended to run the STANDALONE test cases 
+before using the NEMO-BFM coupled system.
+
+-----------------------------------------------------------------------
+Compile NEMO with the BFM 
+-----------------------------------------------------------------------
+NEMO-BFM is compiled from the BFM configuration script relying on the
+NEMO FCM compilation environment. This is done to allow BFM users to
+use new configurations in NEMO that are not part of the NEMO
+standard distribution code.
+The BFM configuration shipped with NEMO is GYRE_BFM (see next section)
+
+Make sure that the BFMDIR variable is defined in your environment
+and define the variable NEMODIR pointing to the root of NEMO source code
+It is assumed here that you have expanded the bfm in /home/user/bfm
+and the root of this NEMO directory in /home/user/nemo then
+and that you have already adjusted the appropriate ARCHFILE that
+is used for the NEMO compilation with makenemo in ../../ARCH
+
+Execute the following commands:
+>> export BFMDIR=/home/user/bfm
+>> export NEMODIR=/home/user/nemo
+>> cd $BFMDIR/build
+>> ./bfm_config.sh -gcd -p GYRE_BFM
+
+The script will generate (-g) the BFM code, then launch 
+makenemo for compilation (-c) and create the run directory
+(-d) in $BFMDIR/run.
+
+to get information on how to use the BFM configuration script run
+>> ./bfm_config.sh -h
+
+-----------------------------------------------------------------------
+Standard test case
+-----------------------------------------------------------------------
+The distributed standard test case is GYRE_BFM, a version of GYRE
+with a full-blown BFM. It is a demnstration simulation and it is not
+meant to produce any published result. 
+GYRE_BFM runs with analytical input data only.
+The namelists for the BFM are not distributed with NEMO but are 
+generated directly by the BFM, in directory $BFMDIR/run/gyre_bfm. 
+The generation of the BFM namelist also copy the required NEMO
+namelist and namelist_top files to this directory. 
+This is why there are no namelist files found in the standard 
+run directory $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00 
+
+Note for expert users:
+If a user prefers to work in the NEMO directory than she has to
+copy the generated namelists there 
+>> cp $BFMDIR/run/gyre_bfm/* $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00
+Once the BFM code has been generated the first time, the code can be 
+also rebuilt with the standard NEMO command:
+>> ./makenemo -n GYRE_BFM -m ARCHFILE -e $BFMDIR/src/nemo 
+
+-----------------------------------------------------------------------
+Other examples
+-----------------------------------------------------------------------
+Other couplings with NEMO are available in $BFMDIR/build/configurations.
+Run the command 
+>> ./bfm_config.sh -P
+to get a list of available presets
+Please refer to the README file in each directory for more information.
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm	(revision 8732)
@@ -0,0 +1,2 @@
+bld::tool::fppkeys key_zdftke key_top key_my_trc key_mpp_mpi key_iomput
+inc $BFMDIR/src/nemo/bfm.fcm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/AA_job
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/AA_job	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/AA_job	(revision 8732)
@@ -0,0 +1,142 @@
+#-Q- sxnec ##################
+#-Q- sxnec ## SXNEC IDRIS
+#-Q- sxnec ##################
+#-Q- sxnec #@$-r :XXX:XXX:XXX:           # job name
+#-Q- sxnec #@$-o output_XXXXXXX.1        # outputfile name
+#-Q- sxnec #@$-me                        # sends a mail at the end of execution
+#-Q- sxnec #@$-eo                        # merge standard error and output
+#-Q- sxnec #@$-jo                        # print a short performance analysis
+#-Q- sxnec #@$-lT 00:30:00                # Max total CPU time
+#-Q- sxnec #@$-lt 00:30:00                # Max CPU time per process
+#-Q- sxnec #@$-lM 500Mb                    # Max memory
+#-Q- sxnec ##@$-c 4                     # Max number of simultaneous procs used (here=4)
+#-Q- sxnec ##@$-q multi                 # Use more than 1 proc
+#-Q- aix ##################
+#-Q- aix ## IBM   IDRIS  ##
+#-Q- aix ##################
+#-Q- aix #@job_name= :XXX:XXX:XXX:          
+#-Q- aix #@output= output_XXXXXXX.1          
+#-Q- aix #@error= error_XXXXXXX.1          
+#-Q- aix #@cpu_limit= 1800
+#-Q- aix #@stack_limit= 200Mb        
+#-Q- aix #@data_limit= 1.8Gb         
+#-Q- aix #@notification= complete
+#-Q- aix #@total_tasks= 1 
+#-Q- aix #@job_type= parallel
+#-Q- aix #@queue
+#-Q- sx8brodie ##################
+#-Q- sx8brodie ## SX8NEC IDRIS ##
+#-Q- sx8brodie ##################
+#-Q- sx8brodie #PBS -N :XXX:XXX:XXX:        # job name
+#-Q- sx8brodie #PBS -o output_XXXXXXX.1     # outputfile name
+#-Q- sx8brodie #PBS -j o                    # merge standard error and output
+#-Q- sx8brodie #PBS -S /usr/bin/ksh         # user shell
+#-Q- sx8brodie #PBS -l memsz_job=3.6gb      # Max memory
+#-Q- sx8brodie #PBS -l cputim_prc=1:01:00   # Max CPU time/prc
+#-Q- sx8brodie #PBS -l cputim_job=1:01:00   # Max CPU time/job
+#-Q- sx8brodie ##PBS -l cpunum_job=4
+#-Q- sx8brodie ##PBS -q multi
+#-Q- sx8mercure ##################
+#-Q- sx8mercure ## SX8NEC   CEA ##
+#-Q- sx8mercure ##################
+#-Q- sx8mercure #PBS -N :XXX:XXX:XXX:        # job name
+#-Q- sx8mercure #PBS -o output_XXXXXXX.1     # outputfile name
+#-Q- sx8mercure #PBS -j o                    # merge standard error and output
+#-Q- sx8mercure #PBS -S /usr/bin/ksh         # user shell
+#-Q- sx8mercure #PBS -l memsz_job=500mb      # Max memory
+#-Q- sx8mercure #PBS -l cputim_job=00:30:00   # Max CPU time
+#-Q- sx8mercure ##PBS -l cpunum_job=4
+########################################################################
+##
+##      Script to run a short experiment when installing the
+##      GYRE configuration 
+##
+##            Rachid Benshila, OPA System Team
+##
+##
+#########################################################################
+##-- print echo of commands before and after shell interpretation
+date
+set -vx
+
+#################################
+# Beginning of user modification
+#################################
+
+##-- define some directories:
+#- Launching run repository
+#-Q- sxnec R_EXPER=${QSUB_WORKDIR:-${PWD}}
+#-Q- sx8brodie R_EXPER=${PBS_O_WORKDIR}
+#-Q- aix R_EXPER=${QSUB_WORKDIR:-${PWD}}
+#-Q- sx8mercure R_EXPER=${PWD}
+#- modipsl repository
+R_EXEDIR=MMMMMMM     
+#- output files storing 
+R_SORTIE_OCE=AAAAAAA/GYRE_PISCES
+#- execution repository
+R_TMP=$TMPDIR         
+
+#################################
+# End of user modification
+#################################
+
+[ -d ${R_TMP} ] || mkdir ${R_TMP}
+cd ${R_TMP}
+
+#--  get the executable
+#-Q- sxnec rcp ${LOGNAME}@rhodes:${R_EXEDIR}/bin/opa opa.xx
+#-Q- sx8brodie rcp ${LOGNAME}@brodie:${R_EXEDIR}/bin/opa opa.xx
+#-Q- aix cp ${R_EXEDIR}/bin/opa opa.xx
+#-Q- sx8mercure cp ${R_EXEDIR}/bin/opa opa.xx
+chmod 777 opa.xx
+
+## --  Copy ancillary files
+#
+#- Namelist for the configuration 
+cp ${R_EXPER}/namelist         namelist
+cp ${R_EXPER}/namelist_top     namelist_top
+cp ${R_EXPER}/namelist_pisces namelist_pisces
+ls -alF
+
+#-Q- sxnec export F_PROGINF=yes
+#-Q- sxnec export F_ERRCNT=5
+#-Q- sx8brodie export F_PROGINF=yes
+#-Q- sx8brodie export F_ERRCNT=5
+#-Q- sx8mercure export F_PROGINF=yes
+#-Q- sx8mercure export F_ERRCNT=5
+
+#-Q- sxnec #- To be use for a mpp run
+#-Q- sxnec #mpirun -np ${NB_PROC} ./opa.xx
+#-Q- sx8brodie #- To be use for a mpp run
+#-Q- sx8brodie #mpirun -np ${NB_PROC} ./opa.xx
+#-Q- sx8mercure #- To be use for a mpp run
+#-Q- sx8mercure #mpirun -np ${NB_PROC} ./opa.xx
+
+./opa.xx
+
+## -- Save output files
+ls -alF
+#- to copy on a storage machine
+#-Q- sxnec DPUT=mfput
+#-Q- sx8brodie DPUT=mfput
+#-Q- aix DPUT=mfput
+#-Q- sx8mercure DPUT=cp 
+#-Q- sx8mercure [ -d ${R_SORTIE_OCE} ] || mkdir -p ${R_SORTIE_OCE}
+
+#- Save ocean output files
+$DPUT ocean.output ${R_SORTIE_OCE}/ocean.output
+$DPUT solver.stat ${R_SORTIE_OCE}/solver.stat
+[ -f mpp.output* ] && $DPUT mpp.output* ${R_SORTIE_OCE}/.
+for file_netcdf in *_grid_*.nc *_diad_T*.nc *_ptrc_T*.nc
+do
+$DPUT $file_netcdf ${R_SORTIE_OCE}/$file_netcdf
+done
+#
+#- Save restart files
+for restart in *restart*
+do
+$DPUT $restart ${R_SORTIE_OCE}/$restart 
+done
+#
+#- Save ftrace file
+[ -f ftrace.out* ] && $DPUT ftrace.out* ${R_SORTIE_OCE}/.
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,121 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+    <field_definition src="./field_def_nemo-pisces.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo.xml"/>     
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/field_def_nemo-pisces.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/field_def_nemo-pisces.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/field_def_nemo-pisces.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-pisces.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/file_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/file_def_nemo.xml	(revision 8732)
@@ -0,0 +1,103 @@
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+ 
+        <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="sst"          name="sosstsst"  />
+	  <field field_ref="sss"          name="sosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+	  <field field_ref="empmr"        name="sowaflup"  />
+	  <field field_ref="qsr"          name="soshfldo"  />
+          <field field_ref="saltflx"      name="sosfldow"  />
+	  <field field_ref="qt"           name="sohefldo"  />
+	  <field field_ref="mldr10_1"     name="somxl010"  />
+	  <field field_ref="mldkz5"       name="somixhgt"  />
+        </file>
+	
+        <file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+          <field field_ref="utau"         name="sozotaux"  />
+        </file>
+	
+        <file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+          <field field_ref="vtau"         name="sometauy"  /> 
+        </file>
+	
+        <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz" />
+          <field field_ref="avt"          name="votkeavt" />
+          <field field_ref="aht2d"        name="soleahtw" />
+        </file>
+
+	<file id="file5" name_suffix="_ptrc_T" description="lobster sms variables" >
+          <field field_ref="DET"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="PHY"      />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+          <field field_ref="DOM"      />
+	</file>
+	
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files -->
+
+	<file id="file6" name_suffix="_diad_T" description="additional lobster diagnostics" >  
+          <field field_ref="FNO3PHY"   /> 
+          <field field_ref="FNH4PHY"   /> 
+          <field field_ref="FNH4NO3"   /> 
+          <field field_ref="TNO3PHY"   /> 
+          <field field_ref="TNH4PHY"   /> 
+          <field field_ref="TPHYDOM"   /> 
+          <field field_ref="TPHYNH4"   /> 
+          <field field_ref="TPHYZOO"   /> 
+          <field field_ref="TPHYDET"   /> 
+          <field field_ref="TDETZOO"   /> 
+          <field field_ref="TDETSED"   /> 
+          <field field_ref="TZOODET"   /> 
+          <field field_ref="TZOOBOD"   /> 
+          <field field_ref="TZOONH4"   /> 
+          <field field_ref="TZOODOM"   /> 
+          <field field_ref="TNH4NO3"   /> 
+          <field field_ref="TDOMNH4"   /> 
+          <field field_ref="TDETNH4"   /> 
+          <field field_ref="TPHYTOT"   /> 
+          <field field_ref="TZOOTOT"   /> 
+          <field field_ref="SEDPOC"    /> 
+	</file>
+
+      </file_group>
+
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+ 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,27 @@
+<?xml version="1.0"?>
+<simulation> 
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios">
+
+      <variable_definition>
+	
+	  <variable id="info_level"                type="int">0</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,321 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : GYRE_PISCES Configuration namelist to overwrite reference dynamical namelist
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namusr_def    !   GYRE user defined namelist  
+!-----------------------------------------------------------------------
+   nn_GYRE     =     1     !  GYRE resolution [1/degrees]
+   ln_bench    = .false.   !  ! =T benchmark with gyre: the gridsize is kept constant
+   jpkglo      =    31     !  number of model levels
+/
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "GYRE"   !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    4320   !  last  time step
+   nn_leapy    =      30   !  Leap year calendar (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 nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration   
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+   !
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    0      !  create (>0) a mesh file or not (=0)
+   !
+   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+!              !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing
+   cn_dir        = './'      !  root directory for the location of the runoff files
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+   !                       !     (also = the frequency of sea-ice model call)
+   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+   ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_eos80    = .true.         !  = Use EOS80 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.    !  z-coordinate - full steps
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      = 100000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =      0.     !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 60       !  time step frequency for transports computing
+    nn_dctwri   = 60       !  time step frequency for transports writing
+    nn_secdebug = 0        !      0 : no section to debug
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_cfg	(revision 8732)
@@ -0,0 +1,125 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  (key_pisces) reference namelist (see below for key_pisces_reduced)
+!!              1  - air-sea exchange                         (nampisext)
+!!              2  - biological parameters                    (nampisbio)
+!!              3  - parameters for nutrient limitations      (nampislim)    
+!!              4  - parameters for phytoplankton             (nampisprod,nampismort)
+!!              5  - parameters for zooplankton               (nampismes,nampiszoo)
+!!              6  - parameters for remineralization          (nampisrem)
+!!              7  - parameters for calcite chemistry         (nampiscal)
+!!              8  - parameters for inputs deposition         (nampissed)
+!!              11 - Damping                                  (nampisdmp)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismod     !  Model used 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+    ln_p4z = .false.
+    ln_p2z = .true.
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisext     !   air-sea exchange
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisatm     !  Atmospheric prrssure 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisopt     !   parameters for optics
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/ 
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisfer     !   parameters for iron chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/  
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissbc     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisice      !  Prescribed sea ice tracers
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdmp     !  Damping 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismass     !  Mass conservation
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES reduced (key_pisces_reduced, ex LOBSTER) : namelists
+!!              1  - biological parameters for phytoplankton    (namlobphy)
+!!              2  - biological parameters for nutrients        (namlobnut)
+!!              3  - biological parameters for zooplankton      (namlobzoo)    
+!!              4  - biological parameters for detritus         (namlobdet)
+!!              5  - biological parameters for DOM              (namlobdom)
+!!              6  - parameters from aphotic layers to sediment (namlobsed)
+!!              7  - general coefficients                       (namlobrat)
+!!              8  - optical parameters                         (namlobopt)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobphy     !   biological parameters for phytoplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobnut     !   biological parameters for nutrients
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobzoo     !   biological parameters for zooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobdet     !   biological parameters for detritus
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobdom     !   biological parameters for DOM
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobsed     !   parameters from aphotic layers to sediment
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobrat     !   general coefficients
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobopt     !   optical parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_pisces_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_pisces_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_cfg	(revision 8732)
@@ -0,0 +1,73 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   jp_bgc        =  6
+!
+   ln_pisces     =  .true.
+   ln_age        =  .false.
+   ln_cfc11      =  .false.
+   ln_cfc12      =  .false.
+   ln_c14        =  .false.
+   ln_my_trc     =  .false.
+!
+!                 !           !                             !               !
+!                 !    name   !   title of the field        !   units       ! initial data from file or not !
+!                 !           !                                             !                               !
+   sn_tracer(1)   = 'DET'     , 'Detritus                   ',  'mmole-N/m3' ,  .false.    
+   sn_tracer(2)   = 'ZOO'     , 'Zooplankton concentration  ',  'mmole-N/m3' ,  .false.   
+   sn_tracer(3)   = 'PHY'     , 'Phytoplankton concentration',  'mmole-N/m3' ,  .false.  
+   sn_tracer(4)   = 'NO3'     , 'Nitrate concentration      ',  'mmole-N/m3' ,  .false. 
+   sn_tracer(5)   = 'NH4'     , 'Ammonium concentration     ',  'mmole-N/m3' ,  .false.   
+   sn_tracer(6)   = 'DOM'     , 'Dissolved organic matter   ',  'mmole-N/m3' ,  .false.  
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer
+!-----------------------------------------------------------------------
+   ln_trcadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer
+!-----------------------------------------------------------------------
+   rn_ahtrc_0       =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .false.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp      !   passive tracer newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_ice      !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_trd      !   diagnostics on tracer trends                       ('key_trdtrc')
+!                          or mixed-layer trends                        ('key_trdmld_trc')
+!----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bdy      !   Setup of tracer boundary conditions
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_top_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_zdftke key_top key_mpp_mpi key_iomput
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg	(revision 8732)
@@ -0,0 +1,252 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  Configuration namelist used to overwrite SHARED/1_namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      = "Agulhas" !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =   10950   !  last  time step
+   nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .true.    !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "AGRIF_AGULHAS_domain_cfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------  
+   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
+   !
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+!              !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_blk      = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
+   nn_ice      = 3         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T)
+!-----------------------------------------------------------------------
+!              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                              ! rotation ! land/sea mask !
+!              !                              !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                             ! pairing  ! filename      !
+   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'     , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'     , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_slp      = 'slp.15JUNE2009_fill'        ,         6         , 'SLP'     ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   sn_tdif     = 'taudif_core'                ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'    , ''       , ''
+   !
+   !                    !  bulk algorithm :
+   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008)
+   !
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    1    !  baroclinic update frequency
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+  ln_teos10   = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .true.     !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  =  0          !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 8.5e+11     !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ice_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ice_cfg	(revision 8732)
@@ -0,0 +1,49 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM3 configuration namelist: Overwrites 1_namelist_ice_ref
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Diagnostics                        (namicediag)
+!!              3 - Ice initialization                 (namiceini)
+!!              4 - Ice discretization                 (namiceitd)
+!!              5 - Ice dynamics and transport         (namicedyn)
+!!              6 - Ice diffusion                      (namicehdf)
+!!              7 - Ice thermodynamics                 (namicethd)
+!!              8 - Ice salinity                       (namicesal)
+!!              9 - Ice mechanical redistribution      (namiceitdme)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicediag    !   Diagnostics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ice_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ice_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ice_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/1_namelist_ice_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/1_namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/AGRIF_FixedGrids.in
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/AGRIF_FixedGrids.in	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/AGRIF_FixedGrids.in	(revision 8732)
@@ -0,0 +1,3 @@
+1
+125 170 36 63 4 4 2
+0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,122 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+    <field_definition src="./field_def_nemo-lim.xml"/>   <!--  LIM ice model                     -->
+    <field_definition src="./field_def_nemo-pisces.xml"/>   <!--  Ocean biology                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-lim.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-lim.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-lim.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-lim.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-pisces.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-pisces.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/field_def_nemo-pisces.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-pisces.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml	(revision 8732)
@@ -0,0 +1,351 @@
+<?xml version="1.0"?>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
+
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->
+      
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+	
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="e3t"      />
+	  <field field_ref="toce"         name="thetao"                                                                      operation="instant" freq_op="5d" > @toce_e3t / @e3t </field>
+	  <field field_ref="soce"         name="so"                                                                          operation="instant" freq_op="5d" > @soce_e3t / @e3t </field>
+	  <field field_ref="sst"          name="tos"   />
+	  <field field_ref="sss"          name="sos"   />
+	  <field field_ref="ssh"          name="zos"   />
+	  <field field_ref="sst"          name="tosstd"       long_name="sea surface temperature standard deviation"         operation="instant" freq_op="5d" > sqrt( @sst2 - @sst * @sst ) </field>
+	  <field field_ref="ssh"          name="zosstd"       long_name="sea surface height above geoid standard deviation"  operation="instant" freq_op="5d" > sqrt( @ssh2 - @ssh * @ssh ) </field>
+	  <field field_ref="sst"          name="sstdcy"       long_name="amplitude of sst diurnal cycle"                     operation="average" freq_op="1d" > @sstmax - @sstmin </field>
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	  <field field_ref="mldr10_1"     name="mldr10_1dcy"  long_name="amplitude of mldr10_1 diurnal cycle"                operation="average" freq_op="1d" > @mldr10_1max - @mldr10_1min </field>
+	  <field field_ref="sbt"      />
+	  <field field_ref="heatc"        name="heatc" />
+	  <field field_ref="saltc"        name="saltc" />
+	</file>
+
+	<file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc -->
+	  <field field_ref="empmr"        name="wfo"      />
+	  <field field_ref="qsr_oce"      name="qsr_oce"  />
+	  <field field_ref="qns_oce"      name="qns_oce"  />
+	  <field field_ref="qt_oce"       name="qt_oce"   />
+	  <field field_ref="qsr_ice"      name="qsr_ice"  />
+	  <field field_ref="qns_ice"      name="qns_ice"  />
+	  <field field_ref="qtr_ice"      name="qtr_ice"  />
+	  <field field_ref="qt_ice"       name="qt_ice"   />
+	  <field field_ref="saltflx"      name="sfx"      />
+	  <field field_ref="taum"         name="taum"     />
+	  <field field_ref="wspd"         name="windsp"   />
+	  <field field_ref="precip"       name="precip"   />
+	  <!-- ice and snow -->
+	  <field field_ref="snowpre" />
+	  <field field_ref="utau_ice"     name="utau_ice" />
+	  <field field_ref="vtau_ice"     name="vtau_ice" />
+	</file>
+
+	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="e3u" />
+	  <field field_ref="ssu"          name="uos"      />
+	  <field field_ref="uoce"         name="uo"       operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field>
+	  <field field_ref="utau"         name="tauuo"    />
+          <field field_ref="uocetr_eff"   name="uocetr_eff"  />
+          <!-- available with diaar5 -->
+	  <field field_ref="u_masstr"     name="vozomatr" />
+	  <field field_ref="u_heattr"     name="sozohetr" />
+      <field field_ref="u_salttr"     name="sozosatr" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="e3v" />
+	  <field field_ref="ssv"          name="vos"      />
+	  <field field_ref="voce"         name="vo"       operation="instant" freq_op="5d" > @voce_e3v / @e3v </field>
+	  <field field_ref="vtau"         name="tauvo"    />
+          <field field_ref="vocetr_eff"   name="vocetr_eff"  />
+          <!-- available with diaar5 -->
+	  <field field_ref="v_masstr"     name="vomematr" />
+	  <field field_ref="v_heattr"     name="somehetr" />
+          <field field_ref="v_salttr"     name="somesatr" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="e3w" />
+	  <field field_ref="woce"         name="wo"       />
+	  <field field_ref="avt"          name="difvho"   />
+	  <field field_ref="w_masstr"     name="vovematr" />
+          <!-- variables available with key_zdftmx_new -->
+          <field field_ref="av_wave"      name="av_wave"    />
+          <field field_ref="bn2"          name="bn2"        />
+          <field field_ref="bflx_tmx"     name="bflx_tmx"   />
+          <field field_ref="pcmap_tmx"    name="pcmap_tmx"  />
+          <field field_ref="emix_tmx"     name="emix_tmx"   />
+          <field field_ref="av_ratio"     name="av_ratio"   />
+	</file>
+
+	<file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." >
+          <field field_ref="snowthic_cea"    name="snthic" />
+          <field field_ref="icethic_cea"     name="sithic" />
+          <field field_ref="icevolu"         name="sivolu" />
+          <field field_ref="snowvol"         name="snvolu" />
+          <field field_ref="iceconc"         name="siconc" />
+
+          <field field_ref="vfxbog"          name="vfxbog" />
+          <field field_ref="vfxdyn"          name="vfxdyn" />
+          <field field_ref="vfxopw"          name="vfxopw" />
+          <field field_ref="vfxsni"          name="vfxsni" />
+          <field field_ref="vfxsum"          name="vfxsum" />
+          <field field_ref="vfxbom"          name="vfxbom" />
+          <field field_ref="vfxres"          name="vfxres" />
+          <field field_ref="vfxice"          name="vfxice" />
+          <field field_ref="vfxsnw"          name="vfxsnw" />
+          <field field_ref="vfxsub"          name="vfxsub" />
+          <field field_ref="vfxspr"          name="vfxspr" />
+
+          <field field_ref="icetrp"          name="sivtrp" />
+          <field field_ref="snwtrp"          name="snvtrp" />
+          <field field_ref="saltrp"          name="saltrp" />
+          <field field_ref="deitrp"          name="deitrp" />
+          <field field_ref="destrp"          name="destrp" />
+
+          <field field_ref="sfxbri"          name="sfxbri" />
+          <field field_ref="sfxdyn"          name="sfxdyn" />
+          <field field_ref="sfxres"          name="sfxres" />
+          <field field_ref="sfxbog"          name="sfxbog" />
+          <field field_ref="sfxbom"          name="sfxbom" />
+          <field field_ref="sfxsum"          name="sfxsum" />
+          <field field_ref="sfxsni"          name="sfxsni" />
+          <field field_ref="sfxopw"          name="sfxopw" />
+          <field field_ref="sfx"             name="sfx"    />
+
+          <field field_ref="hfxsum"          name="hfxsum"     />
+          <field field_ref="hfxbom"          name="hfxbom"     />
+          <field field_ref="hfxbog"          name="hfxbog"     />
+          <field field_ref="hfxdif"          name="hfxdif"     />
+          <field field_ref="hfxopw"          name="hfxopw"     />
+          <field field_ref="hfxout"          name="hfxout"     />
+          <field field_ref="hfxin"           name="hfxin"      />
+          <field field_ref="hfxsnw"          name="hfxsnw"     />
+          <field field_ref="hfxerr"          name="hfxerr"     />
+          <field field_ref="hfxerr_rem"      name="hfxerr_rem" />
+
+	  <!-- ice-ocean heat flux from mass exchange -->
+          <field field_ref="hfxdyn"          name="hfxdyn" />
+          <field field_ref="hfxres"          name="hfxres" />
+          <field field_ref="hfxthd"          name="hfxthd" />
+	  <!-- ice-atm. heat flux from mass exchange -->
+          <field field_ref="hfxsub"          name="hfxsub" />
+          <field field_ref="hfxspr"          name="hfxspr" />
+
+	  <!-- diags -->
+          <field field_ref="hfxdhc"          name="hfxdhc" />
+          <field field_ref="hfxtur"          name="hfxtur" />
+
+          <field field_ref="isst"            name="sst"    />
+          <field field_ref="isss"            name="sss"    />
+          <field field_ref="micesalt"        name="sisali" />
+          <field field_ref="micet"           name="sitemp" />
+          <field field_ref="icest"           name="sistem" />
+          <field field_ref="icehc"           name="siheco" />
+          <field field_ref="isnowhc"         name="snheco" />
+          <field field_ref="miceage"         name="siages" />
+
+          <field field_ref="uice_ipa"        name="sivelu" />
+          <field field_ref="vice_ipa"        name="sivelv" />
+          <field field_ref="icevel"          name="sivelo" />
+          <field field_ref="idive"           name="sidive" />
+          <field field_ref="ishear"          name="sishea" />
+          <field field_ref="icestr"          name="sistre" />
+
+          <field field_ref="ibrinv"          name="sibrin" />
+          <field field_ref="icecolf"         name="sicolf" />
+
+          <field field_ref="iceage_cat"      name="siagecat" />
+          <field field_ref="iceconc_cat"     name="siconcat" />
+          <field field_ref="icethic_cat"     name="sithicat" />
+          <field field_ref="snowthic_cat"    name="snthicat" />
+          <field field_ref="salinity_cat"    name="salincat" />
+          <field field_ref="brinevol_cat"    name="sibricat" />
+	  <field field_ref="icetemp_cat"     name="sitemcat" />
+	  <field field_ref="snwtemp_cat"     name="sntemcat" />
+
+	</file>
+
+        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." >
+          <field field_ref="voltot"       name="scvoltot"   />
+          <field field_ref="sshtot"       name="scsshtot"   />
+          <field field_ref="sshsteric"    name="scsshste"   />
+          <field field_ref="sshthster"    name="scsshtst"   />
+          <field field_ref="masstot"      name="scmastot"   />
+          <field field_ref="temptot"      name="sctemtot"   />
+          <field field_ref="saltot"       name="scsaltot"   />
+
+          <field field_ref="bgtemper"     name="bgtemper"   />
+          <field field_ref="bgsaline"     name="bgsaline"   />
+          <field field_ref="bgheatco"     name="bgheatco"   />
+          <field field_ref="bgsaltco"     name="bgsaltco"   />
+          <field field_ref="bgvolssh"     name="bgvolssh"   /> 
+          <field field_ref="bgvole3t"     name="bgvole3t"   />
+          <field field_ref="bgfrcvol"     name="bgfrcvol"   />
+          <field field_ref="bgfrctem"     name="bgfrctem"   />
+          <field field_ref="bgfrcsal"     name="bgfrcsal"   />
+        </file>
+
+        <file id="file8" name_suffix="_SBC_scalar" description="scalar variables" enabled=".true." >
+          <!-- global contents -->
+	  <field field_ref="ibgvol_tot"    name="ibgvol_tot"   />
+	  <field field_ref="sbgvol_tot"    name="sbgvol_tot"   />
+	  <field field_ref="ibgarea_tot"   name="ibgarea_tot"  />
+	  <field field_ref="ibgsalt_tot"   name="ibgsalt_tot"  />
+	  <field field_ref="ibgheat_tot"   name="ibgheat_tot"  />
+	  <field field_ref="sbgheat_tot"   name="sbgheat_tot"  />
+	  
+	  <!-- global drifts (conservation checks) -->
+	  <field field_ref="ibgvolume"     name="ibgvolume"    />
+	  <field field_ref="ibgsaltco"     name="ibgsaltco"    />
+	  <field field_ref="ibgheatco"     name="ibgheatco"    />
+	  <field field_ref="ibgheatfx"     name="ibgheatfx"    />
+	  
+	  <!-- global forcings  -->
+	  <field field_ref="ibgfrcvoltop"  name="ibgfrcvoltop" />
+	  <field field_ref="ibgfrcvolbot"  name="ibgfrcvolbot" />
+	  <field field_ref="ibgfrctemtop"  name="ibgfrctemtop" />
+	  <field field_ref="ibgfrctembot"  name="ibgfrctembot" />
+	  <field field_ref="ibgfrcsal"     name="ibgfrcsal"    />
+	  <field field_ref="ibgfrchfxtop"  name="ibgfrchfxtop" />
+	  <field field_ref="ibgfrchfxbot"  name="ibgfrchfxbot" />
+        </file>
+
+        <file id="file9" name_suffix="_bioscalar" description="pisces sms variables" >
+          <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>
+          <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+          <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
+          <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
+          <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
+        <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field>
+        </file>
+	<!--
+	<file id="file20" name_suffix="_Tides" description="tidal harmonics" >
+	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
+	  <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  />
+	  <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       />
+	  <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  />
+	  <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       />
+	  <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  />
+	</file>
+	-->
+
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+
+	<file id="file10" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="PO4"      />
+          <field field_ref="Si"       />
+          <field field_ref="Fer"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+	</file>
+	
+	<file id="file11" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+	</file>
+
+      </file_group>
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files -->
+
+	<file id="file12" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="CaCO3"    />
+          <field field_ref="PO4"      />
+          <field field_ref="POC"      />
+          <field field_ref="Si"       />
+          <field field_ref="PHY"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="DOC"      />
+          <field field_ref="PHY2"     />
+          <field field_ref="ZOO2"     />
+          <field field_ref="DSi"      />
+          <field field_ref="Fer"      />
+          <field field_ref="BFe"      />
+          <field field_ref="GOC"      />
+          <field field_ref="SFe"      />
+          <field field_ref="DFe"      />
+          <field field_ref="GSi"      />
+          <field field_ref="NFe"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+	</file>
+
+	<file id="file13" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="PH"       />
+          <field field_ref="PAR"      />
+          <field field_ref="PPPHYN"    />
+          <field field_ref="PPPHYD"   />
+          <field field_ref="PPPHYP"   />
+          <field field_ref="PPNEWN"   />
+          <field field_ref="PPNEWD"   />
+          <field field_ref="PPNEWP"   />
+          <field field_ref="PBSi"     />
+          <field field_ref="PFeN"     />
+          <field field_ref="PFeD"     />
+          <field field_ref="PCAL"     />
+          <field field_ref="DCAL"     />
+          <field field_ref="GRAZ1"    />
+          <field field_ref="GRAZ2"    />
+          <field field_ref="EPC100"   />
+          <field field_ref="EPFE100"  />
+          <field field_ref="EPSI100"  />
+          <field field_ref="EPCAL100" />
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+          <field field_ref="Heup"     />
+          <field field_ref="Nfix"     />
+	</file>
+     </file_group>  
+
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,288 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    5475   !  last  time step (std 5475)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .true.    !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    0      !  create (>0) a mesh file or not (=0)
+   !
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk )
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  Bulk formulae
+!-----------------------------------------------------------------------
+   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008)
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+      ln_icebergs              = .true.               ! iceberg floats or not
+      ln_bergdia               = .true.               ! Calculate budgets
+      nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0
+      nn_verbose_write         = 15                   ! Timesteps between verbose messages
+      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage
+                                                      ! Initial mass required for an iceberg of each class
+      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
+                                                      ! Proportion of calving mass to apportion to each class
+      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
+                                                      ! Ratio between effective and real iceberg mass (non-dim)
+                                                      ! i.e. number of icebergs represented at a point
+      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
+                                                      ! thickness of newly calved bergs (m)
+      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250.
+      rn_rho_bergs             = 850.                 ! Density of icebergs
+      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs
+      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics
+      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
+      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
+      ln_passive_mode          = .false.              ! iceberg - ocean decoupling
+      nn_test_icebergs         = -1                   ! Create test icebergs of this class (-1 = no)
+                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
+      rn_test_box              = 108.0,  116.0, -66.0, -58.0
+      rn_speed_limit           = 0.                   ! CFL speed limit for a berg
+
+!            ! file name ! frequency (hours) !   variable   ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!            !           !  (if <0  months)  !     name     !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+      sn_icb =  'calving',       -1          , 'calving'    ,   .true.    , .true.  , 'yearly'  ,    ''    ,    ''    ,     ''
+
+      cn_dir = './'
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+   ln_mle      = .true.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm")
+!-----------------------------------------------------------------------
+   nn_zpyc     = 2         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
+   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency
+   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+   ln_diahsb  = .true.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg	(revision 8732)
@@ -0,0 +1,48 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Diagnostics                        (namicediag)
+!!              3 - Ice initialization                 (namiceini)
+!!              4 - Ice discretization                 (namiceitd)
+!!              5 - Ice dynamics and transport         (namicedyn)
+!!              6 - Ice diffusion                      (namicehdf)
+!!              7 - Ice thermodynamics                 (namicethd)
+!!              8 - Ice salinity                       (namicesal)
+!!              9 - Ice mechanical redistribution      (namiceitdme)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicediag    !   Diagnostics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ice_lim3_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_pisces_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_pisces_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_pisces_cfg	(revision 8732)
@@ -0,0 +1,63 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  :   Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_pis_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisext     !   air-sea exchange
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisatm     !  Atmospheric prrssure 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisopt     !   parameters for optics
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/ 
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisfer     !   parameters for iron chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/  
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissbc     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdmp     !  Damping 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismass     !  Mass conservation
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_pisces_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_pisces_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_pisces_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_pisces_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_cfg	(revision 8732)
@@ -0,0 +1,109 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+   ln_top_euler  = .true.
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   jp_bgc        =  24
+!
+   ln_pisces     =  .true.
+   ln_my_trc     =  .false.
+   ln_age        =  .false.
+   ln_cfc11      =  .false.
+   ln_cfc12      =  .false.
+   ln_c14        =  .false.
+!
+   ln_trcdta     =  .true.  !  Initialisation from data input file (T) or not (F)
+!                 !           !                                          !             !
+!                 !    name   !           title of the field             !   units     ! initial data from file or not !
+!                 !           !                                          !             !
+   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.
+   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.
+   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.
+   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.
+   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.
+   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.
+   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.
+   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.
+   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.
+   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.
+   sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.
+   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.
+   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.
+   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.
+   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.
+   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.
+   sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.
+   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.
+   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.
+   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.
+   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.
+   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   rn_trfac(1)   =   1.0e-06  !  multiplicative factor
+   rn_trfac(2)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(3)   =  44.6e-06  !  -      -      -     -
+   rn_trfac(5)   = 122.0e-06  !  -      -      -     -
+   rn_trfac(7)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(10)  =   1.0      !  -      -      -     -
+   rn_trfac(14)  =   1.0      !  -      -      -     -
+   rn_trfac(23)  =   7.6e-06  !  -      -      -     -
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_mus =  .true.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp      !   passive tracer newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_ice      !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_trd      !   diagnostics on tracer trends                       ('key_trdtrc')
+!                          or mixed-layer trends                        ('key_trdmld_trc')
+!----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bdy      !   Setup of tracer boundary conditions
+!-----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_top_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_top_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/README	(revision 8732)
@@ -0,0 +1,61 @@
+#----------------------------------------------------------------------
+# prerequired
+#----------------------------------------------------------------------
+First, you need either :
+- IDL (version 6.4 or above), see : http://www.exelisvis.com/ProductsServices/IDL.aspx
+  In this case, you also need to download SAXO which is a free package of IDL scripts:
+  define $PATH_SAXO, the path where you will download SAXO and get it through svn with the following command.
+  > PATH_SAXO=...
+  > svn checkout http://forge.ipsl.jussieu.fr/saxo/svn/trunk/SRC $PATH_SAXO/SAXO_DIR/SRC
+
+- or the IDL Virtual Machine which is free to use and does not require a license to run , see :
+  http://www.exelisvis.com/Support/HelpArticlesDetail/TabId/219/ArtMID/900/ArticleID/12395/The-IDL-Virtual-Machine.aspx
+  the virtual machine requites std_main.sav that is distributed with this README.
+
+Next, to use these idl tools, you need to download some climatogies and mask files;
+that you can find here: http://dodsp.idris.fr/reee512/NEMO_OUT/ORCA2_LIM/
+
+There is the wget command to get all those files (thanks to F. Pinsard)
+wget --recursive -l2 --no-directories --no-parent -A.nc -erobots=off http://dodsp.idris.fr/reee512/NEMO_OUT/ORCA2_LIM/
+
+You will aslo need the meshmask file (set nn_msh = 1 or nn_msh = 7 in your namelist and run the model for at least 1 time step).
+
+#----------------------------------------------------------------------
+# define your std_plot_vardef.sh or std_ts_vardef.sh file
+#----------------------------------------------------------------------
+These files are needed to define your PATHs, the experiments and variables names you used in your experiment.
+ - std_plot_vardef.sh is used to do all plots based on temporal mean (maps, vertical profiles...).
+ - std_ts_vardef.sh is used to do all time-series type of plot.
+
+To build you own std_plot_vardef.sh or std_ts_vardef.sh file; use the examples provided such as:
+ - std_ts_vardef.sh_example1 or std_ts_vardef.sh_example2
+ - std_plot_vardef.sh_example1 or std_plot_vardef.sh_example2
+
+Note that if you use the IDL Virtual Machine, the variable SAXO_DIR defined in std_plot_vardef.sh or std_ts_vardef.sh is not used. Any definition will be ok.
+
+#----------------------------------------------------------------------
+# HOW TO USE 
+#----------------------------------------------------------------------
+./std_main.sh -plot -pdf
+or
+./std_main.sh -ts -pdf
+
+
+
+
+##########################################################################################################
+# short note for developers of this package on:
+#                   How to build the tarball required for IDL virtual Machine:
+##########################################################################################################
+#
+# we need to recreate std_main.sav as soon as we change IDL programmes files as
+# std_main.sav contains all ".pro" files aready compiled to be used with the virtual machine
+#
+. ./std_plot_vardef.sh # or . ./std_ts_vardef.sh 
+idl -IDL_STARTUP initenv
+IDL> .r std_main
+IDL> resolve_all
+IDL> save, /routines, filename='std_main.sav'
+IDL> exit
+#
+#----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/initenv.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/initenv.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/initenv.pro	(revision 8732)
@@ -0,0 +1,56 @@
+;
+; This is the initialisation file.
+; it defines the !path and the defaut values of some of the common variables
+;
+; this is supposed to speed-up IDL...
+;
+; a = fltarr(1000,1000,100)
+; a = 0
+;
+; path definition
+;
+!path = expand_path('+' + getenv('SAXO_DIR') ) + ':' + expand_path('+' + !dir)
+;
+; compatibility with the old version
+;
+keep_compatibility, 0
+;
+; define all the commons
+;
+@all_cm
+;
+; define default directories
+;
+homedir = './'
+iodir = './'
+psdir = isadirectory(getenv('PS_DIR'), title = 'Select the default postscripts directory')
+imagedir = './'
+animdir = './'
+;
+; define printer parameters
+;
+printer_human_names = ''
+printer_machine_names = ''
+print_command = ''
+;
+; colors ...
+;
+device, decomposed = 0
+device, retain = 2
+lct, 65
+;
+; postscript parameters ...
+;
+key_portrait = 0
+page_size = [20.9903, 29.7039]
+windowsize_scale = 1.0000
+archive_ps = 0
+;
+;========================================================
+; end of the part that should be modified by the users...
+;========================================================
+;
+; if needed, keep compatibility with the old version
+;
+@updateold
+;
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_common.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_common.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_common.pro	(revision 8732)
@@ -0,0 +1,9 @@
+COMMON std, cnt $
+   , std_iodir_climato, std_iodir_data $
+   , std_file1_T, std_file2_T $
+   , std_file1_U, std_file2_U $
+   , std_file1_V, std_file2_V $
+   , std_file1_I, std_file2_I $
+   , std_file_msksub $
+   , date1, date2, date1_2, date2_2 $
+   , allrec, blabla, htmltxt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main.pro	(revision 8732)
@@ -0,0 +1,12 @@
+PRO std_main
+@initenv
+;
+  type = getenv('PLOTTYPE')
+  CASE type OF
+    '':print, 'The environment variable PLOTTYPE is not defined. We stop'
+    'ts':std_ts_all, /postscript
+    'plot':std_plot_all, /postscript
+    ELSE:print, 'Wrong definition of the environment variable PLOTTYPE. We stop'
+  ENDCASE
+;
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main.sh	(revision 8732)
@@ -0,0 +1,239 @@
+#!/bin/sh 
+#+
+#
+# .. program:: std_main.sh
+#
+# ================
+# std_main.sh
+# ================
+#
+# -------------------------------------
+# launch idl scripts to produce graphics diagnostics in Postscript, PDF or HTML document
+# -------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ``std_main.sh -ts`` or ``std_main.sh -plot`` 
+# 
+# DESCRIPTION
+# ===========
+#
+# .. option:: -ts    to produce time series 
+# .. option:: -plot  to produce maps and sections
+# .. option:: -html  to produce html document
+# .. option:: -pdf   to produce pdf document
+# .. option:: -noidl to skip the call to IDL and the production of Postscript
+# .. option:: -vm    to use IDL virtual machine (free) instead of IDL
+# .. option:: -help  to get help!
+#
+# variables have to be defined in std_plot_vardef.sh (or std_ts_vardef.sh)
+# before calling std_main.sh -plot (or std_main.sh -ts)
+#
+# EXAMPLES
+# ========
+# $ ./std_main.sh -ts html
+# $ ./std_main.sh -ts pdf -noidl
+# 
+# $ ./std_main.sh -plot -pdf -vm
+#
+# AUTHOR - date
+# ===========
+# Françoise Pinsard - 01/2010 - LOCEAN
+# Simona Flavoni    - 01/2010 - LOCEAN
+# Sebastien Masson  - 04/2011 - LOCEAN
+#
+#-----------------------------------------------------------
+# Usage...
+#-----------------------------------------------------------
+#
+#-
+system=$(uname)
+case "${system}" in
+   AIX|IRIX64)
+      echo " www : no specific posix checking"
+   ;;
+   *)
+      set -o posix
+   ;;
+esac
+#
+usage="Usage: std_main.sh [OPTION]
+Options
+ -ts    to produce time series 
+ -plot  to produce maps and sections
+ -html  to produce html document
+ -pdf   to produce pdf document
+ -noidl to skip the call to IDL and the production of Postscript
+ -vm    to use IDL virtual machine (free) instead of IDL
+ -help  to get this help
+"
+#
+vm=0
+noidl=0
+format=ps
+while [ ! -z "${1}" ]
+do
+    case ${1} in
+	-plot|--plot) PLOTTYPE=plot ;;
+	-ts|--ts) PLOTTYPE=ts ;;
+	-f|-format|--format) format=${2}	  shift	 ;;
+	-html|--html) format=html ;;
+	-pdf|--pdf) format=pdf ;;
+	-h|-help|--help)	
+	    echo "${usage}"
+	    exit 0	
+	    ;;
+	-ni|--ni|-noidl|--noidl) noidl=1 ;;
+	-vm|--vm|-virtual_machine|--virtual_machine) vm=1 ;;
+	*) # other choice
+	    echo "${usage}"
+	    exit 1
+	    ;;
+    esac
+    shift # next flag
+done
+#
+PLOTTYPE=${PLOTTYPE:-NG}
+if [[ ( "$PLOTTYPE" != "plot" ) && ( "$PLOTTYPE" != "ts" ) ]]
+then
+    echo 'the type of plot must be defined with the option -plot or -ts'
+	exit 1
+fi
+export PLOTTYPE
+#
+set -u
+#
+#
+tstexe () {
+    type ${1}
+    status_type=${?}
+    if [ ${status_type} -ne 0 ]
+    then
+	echo "eee : ${2}"
+	exit 1
+    fi
+}
+#
+#-----------------------------------------------------------
+# define output directory for POSTCRIPT files
+#-----------------------------------------------------------
+#
+. ./std_${PLOTTYPE}_vardef.sh
+[ ! -d ${PS_DIR} ] && mkdir -p ${PS_DIR}
+#
+#-----------------------------------------------------------
+# run IDL
+#-----------------------------------------------------------
+#
+if [ $noidl -eq 0 ]
+then 
+    tstexe ${idl_command} "idl not found"
+#
+    if [ $vm -eq 1 ]
+    then
+	${idl_command} -vm=std_main.sav
+    else 
+	${idl_command} -IDL_STARTUP 'initenv' << EOF
+std_${PLOTTYPE}_all, /postscript
+EOF
+    fi
+    status_idl=${?}
+    if [ ${status_idl} -ne 0 ]
+    then
+	echo "eee : error in the execution of IDL"
+	exit 1
+    fi
+fi
+#
+#-----------------------------------------------------------
+# produce the final document
+#-----------------------------------------------------------
+#
+# build the list of ps that has been created by IDL
+pslist=$( grep "img width" ${PS_DIR}/std_${PLOTTYPE}_html_body.txt | sed -e "s/.*src=\(.*\)png.*/\1/" )
+#
+case ${format} in
+#__________________________________________________________
+# PDF
+    pdf)
+# check if ps2pdf available
+	ps2pdf_command=$( which ps2pdf )
+	tstexe ${ps2pdf_command} "ps2pdf not found"
+# check if texexec available
+	texexec_command=$( which texexec )
+	tstexe ${texexec_command} "texexec not found"
+#
+	filepdf=all_${PLOTTYPE}.pdf
+	[ ! -d ${PDF_DIR} ] && mkdir -p ${PDF_DIR}
+	pdflist=''
+	for file in ${pslist} ; do
+	    ps2pdf -sPAPERSIZE=a4 ${PS_DIR}/${file}ps ${PDF_DIR}/${file}pdf
+	    echo "ps2pdf ${file}ps done"
+	    pdflist=${pdflist}' '${PDF_DIR}/${file}pdf
+	done
+#pdfjam needed to use pdfjoin
+	pdfjoin ${pdflist} --outfile $PDF_DIR/${filepdf}
+	texexec --pdfarrange --result=$PDF_DIR/$filepdf $pdflist
+	rm -f $PDF_DIR/$( basename $filepdf .pdf ).aux $PDF_DIR/$( basename $filepdf .pdf ).log
+	if [ ! -e ${PDF_DIR}/$filepdf ]
+	then
+	        echo "\n ATTENTION !!!!! \n"
+                echo "${PDF_DIR}/$filepdf do not exist \n"
+        else
+                 echo "${PDF_DIR}/$filepdf done"
+       fi
+#commented because convert gives images of bad quality
+#	convert ${PS_DIR}/*.ps /tmp/all_${PLOTTYPE}.pdf
+#       convert -resize 800x600 ${PS_DIR}/${exp1}_${exp2}/ps/*.ps /tmp/all_${PLOTTYPE}.pdf
+	;;
+#__________________________________________________________
+# HTML
+    html)
+	filehtml=all_${PLOTTYPE}.html
+	[ ! -d ${HTML_DIR} ] && mkdir -p ${HTML_DIR}
+# check if convert available
+	convert_command=$( which convert )
+	tstexe ${convert_command} "convert not found"
+# convert each ps to png	
+	for file in ${pslist} ; do
+	    ${convert_command} -antialias ${PS_DIR}/${file}ps ${HTML_DIR}/${file}png
+	done
+# creation of the HTML file
+	cat << EOF > ${HTML_DIR}/$filehtml
+<!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>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+</head>
+<body>
+EOF
+	cat ${PS_DIR}/std_${PLOTTYPE}_html_body.txt >>  ${HTML_DIR}/$filehtml
+	cat << EOF >> ${HTML_DIR}/$filehtml
+<hr>
+</body>
+</html>
+EOF
+	echo ${HTML_DIR}/$filehtml done
+	;;
+    ps)	;; # nothing to do...
+    *)	
+	echo " format ${format} not implemented"
+	exit 1
+	;;
+esac
+
+    #
+#=====================
+# prepare to put images on dods
+# +++ to finish it
+#LOGIN=xxxx
+#Tag_Name=ORCA2_LIM2
+#rsh ${LOGIN}@gaya.idris.fr exec /bin/ksh <<EOF
+#       cd ${homegaya}/IGCM_OUT/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1}
+#       /usr/local/bin/dods_rm DODS/pub/${LOGIN}/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1} > /dev/null 2>&1
+#       /usr/local/bin/dods_cp ${exp1} DODS/pub/${LOGIN}/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1} > /dev/null 2>&1
+#EOF
+#=====================
+# end
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_1Y.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_1Y.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_1Y.sh	(revision 8732)
@@ -0,0 +1,239 @@
+#!/bin/sh 
+#+
+#
+# .. program:: std_main.sh
+#
+# ================
+# std_main.sh
+# ================
+#
+# -------------------------------------
+# launch idl scripts to produce graphics diagnostics in Postscript, PDF or HTML document
+# -------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ``std_main.sh -ts`` or ``std_main.sh -plot`` 
+# 
+# DESCRIPTION
+# ===========
+#
+# .. option:: -ts    to produce time series 
+# .. option:: -plot  to produce maps and sections
+# .. option:: -html  to produce html document
+# .. option:: -pdf   to produce pdf document
+# .. option:: -noidl to skip the call to IDL and the production of Postscript
+# .. option:: -vm    to use IDL virtual machine (free) instead of IDL
+# .. option:: -help  to get help!
+#
+# variables have to be defined in std_plot_vardef.sh (or std_ts_vardef.sh)
+# before calling std_main.sh -plot (or std_main.sh -ts)
+#
+# EXAMPLES
+# ========
+# $ ./std_main.sh -ts html
+# $ ./std_main.sh -ts pdf -noidl
+# 
+# $ ./std_main.sh -plot -pdf -vm
+#
+# AUTHOR - date
+# ===========
+# Françoise Pinsard - 01/2010 - LOCEAN
+# Simona Flavoni    - 01/2010 - LOCEAN
+# Sebastien Masson  - 04/2011 - LOCEAN
+#
+#-----------------------------------------------------------
+# Usage...
+#-----------------------------------------------------------
+#
+#-
+system=$(uname)
+case "${system}" in
+   AIX|IRIX64)
+      echo " www : no specific posix checking"
+   ;;
+   *)
+      set -o posix
+   ;;
+esac
+#
+usage="Usage: std_main.sh [OPTION]
+Options
+ -ts    to produce time series 
+ -plot  to produce maps and sections
+ -html  to produce html document
+ -pdf   to produce pdf document
+ -noidl to skip the call to IDL and the production of Postscript
+ -vm    to use IDL virtual machine (free) instead of IDL
+ -help  to get this help
+"
+#
+vm=0
+noidl=0
+format=ps
+while [ ! -z "${1}" ]
+do
+    case ${1} in
+	-plot|--plot) PLOTTYPE=plot ;;
+	-ts|--ts) PLOTTYPE=ts ;;
+	-f|-format|--format) format=${2}	  shift	 ;;
+	-html|--html) format=html ;;
+	-pdf|--pdf) format=pdf ;;
+	-h|-help|--help)	
+	    echo "${usage}"
+	    exit 0	
+	    ;;
+	-ni|--ni|-noidl|--noidl) noidl=1 ;;
+	-vm|--vm|-virtual_machine|--virtual_machine) vm=1 ;;
+	*) # other choice
+	    echo "${usage}"
+	    exit 1
+	    ;;
+    esac
+    shift # next flag
+done
+#
+PLOTTYPE=${PLOTTYPE:-NG}
+if [[ ( "$PLOTTYPE" != "plot" ) && ( "$PLOTTYPE" != "ts" ) ]]
+then
+    echo 'the type of plot must be defined with the option -plot or -ts'
+	exit 1
+fi
+export PLOTTYPE
+#
+set -u
+#
+#
+tstexe () {
+    type ${1}
+    status_type=${?}
+    if [ ${status_type} -ne 0 ]
+    then
+	echo "eee : ${2}"
+	exit 1
+    fi
+}
+#
+#-----------------------------------------------------------
+# define output directory for POSTCRIPT files
+#-----------------------------------------------------------
+#
+. ./std_${PLOTTYPE}_vardef.sh
+[ ! -d ${PS_DIR} ] && mkdir -p ${PS_DIR}
+#
+#-----------------------------------------------------------
+# run IDL
+#-----------------------------------------------------------
+#
+if [ $noidl -eq 0 ]
+then 
+    tstexe ${idl_command} "idl not found"
+#
+    if [ $vm -eq 1 ]
+    then
+	${idl_command} -vm=std_main.sav
+    else 
+	${idl_command} -IDL_STARTUP 'initenv' << EOF
+std_${PLOTTYPE}_all, /postscript
+EOF
+    fi
+    status_idl=${?}
+    if [ ${status_idl} -ne 0 ]
+    then
+	echo "eee : error in the execution of IDL"
+	exit 1
+    fi
+fi
+#
+#-----------------------------------------------------------
+# produce the final document
+#-----------------------------------------------------------
+#
+# build the list of ps that has been created by IDL
+pslist=$( grep "img width" ${PS_DIR}/std_${PLOTTYPE}_html_body.txt | sed -e "s/.*src=\(.*\)png.*/\1/" )
+#
+case ${format} in
+#__________________________________________________________
+# PDF
+    pdf)
+# check if ps2pdf available
+	ps2pdf_command=$( which ps2pdf )
+	tstexe ${ps2pdf_command} "ps2pdf not found"
+# check if texexec available
+	texexec_command=$( which texexec )
+	tstexe ${texexec_command} "texexec not found"
+#
+	filepdf=all_${PLOTTYPE}.pdf
+	[ ! -d ${PDF_DIR} ] && mkdir -p ${PDF_DIR}
+	pdflist=''
+	for file in ${pslist} ; do
+	    ps2pdf -sPAPERSIZE=a4 ${PS_DIR}/${file}ps ${PDF_DIR}/${file}pdf
+	    echo "ps2pdf ${file}ps done"
+	    pdflist=${pdflist}' '${PDF_DIR}/${file}pdf
+	done
+#pdfjam needed to use pdfjoin
+	pdfjoin ${pdflist} --outfile $PDF_DIR/${filepdf}
+	texexec --pdfarrange --result=$PDF_DIR/$filepdf $pdflist
+	rm -f $PDF_DIR/$( basename $filepdf .pdf ).aux $PDF_DIR/$( basename $filepdf .pdf ).log
+	if [ ! -e ${PDF_DIR}/$filepdf ]
+	then
+	        echo "\n ATTENTION !!!!! \n"
+                echo "${PDF_DIR}/$filepdf do not exist \n"
+        else
+                 echo "${PDF_DIR}/$filepdf done"
+       fi
+#commented because convert gives images of bad quality
+#	convert ${PS_DIR}/*.ps /tmp/all_${PLOTTYPE}.pdf
+#       convert -resize 800x600 ${PS_DIR}/${exp1}_${exp2}/ps/*.ps /tmp/all_${PLOTTYPE}.pdf
+	;;
+#__________________________________________________________
+# HTML
+    html)
+	filehtml=all_${PLOTTYPE}.html
+	[ ! -d ${HTML_DIR} ] && mkdir -p ${HTML_DIR}
+# check if convert available
+	convert_command=$( which convert )
+	tstexe ${convert_command} "convert not found"
+# convert each ps to png	
+	for file in ${pslist} ; do
+	    ${convert_command} -antialias ${PS_DIR}/${file}ps ${HTML_DIR}/${file}png
+	done
+# creation of the HTML file
+	cat << EOF > ${HTML_DIR}/$filehtml
+<!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>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+</head>
+<body>
+EOF
+	cat ${PS_DIR}/std_${PLOTTYPE}_html_body.txt >>  ${HTML_DIR}/$filehtml
+	cat << EOF >> ${HTML_DIR}/$filehtml
+<hr>
+</body>
+</html>
+EOF
+	echo ${HTML_DIR}/$filehtml done
+	;;
+    ps)	;; # nothing to do...
+    *)	
+	echo " format ${format} not implemented"
+	exit 1
+	;;
+esac
+
+    #
+#=====================
+# prepare to put images on dods
+# +++ to finish it
+#LOGIN=xxxx
+#Tag_Name=ORCA2_LIM2
+#rsh ${LOGIN}@gaya.idris.fr exec /bin/ksh <<EOF
+#       cd ${homegaya}/IGCM_OUT/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1}
+#       /usr/local/bin/dods_rm DODS/pub/${LOGIN}/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1} > /dev/null 2>&1
+#       /usr/local/bin/dods_cp ${exp1} DODS/pub/${LOGIN}/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1} > /dev/null 2>&1
+#EOF
+#=====================
+# end
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_5D.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_5D.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_5D.sh	(revision 8732)
@@ -0,0 +1,238 @@
+#!/bin/sh 
+#+
+#
+# .. program:: std_main_5D.sh
+#
+# ================
+# std_main.sh
+# ================
+#
+# -------------------------------------
+# launch idl scripts to produce graphics diagnostics in Postscript, PDF or HTML document
+# for output of 5days for 1 year run
+# nota: it is like std_main.sh but it calls routins for 5days
+# -------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ``std_main_5D.sh -ts`` or ``std_main_5D.sh -plot`` 
+# 
+# DESCRIPTION
+# ===========
+#
+# .. option:: -ts    to produce time series 
+# .. option:: -plot  to produce maps and sections
+# .. option:: -html  to produce html document
+# .. option:: -pdf   to produce pdf document
+# .. option:: -noidl to skip the call to IDL and the production of Postscript
+# .. option:: -vm    to use IDL virtual machine (free) instead of IDL
+# .. option:: -help  to get help!
+#
+# variables have to be defined in std_plot_vardef.sh (or std_ts_vardef.sh)
+# before calling std_main_5D.sh -plot 
+#
+# EXAMPLES
+# ========
+# $ ./std_main_5D.sh -plot -pdf 
+#
+# AUTHOR - date
+# ===========
+# Françoise Pinsard - 01/2010 - LOCEAN
+# Simona Flavoni    - 01/2010 - LOCEAN
+# Sebastien Masson  - 04/2011 - LOCEAN
+#
+#-----------------------------------------------------------
+# Usage...
+#-----------------------------------------------------------
+#
+#-
+system=$(uname)
+case "${system}" in
+   AIX|IRIX64)
+      echo " www : no specific posix checking"
+   ;;
+   *)
+      set -o posix
+   ;;
+esac
+#
+usage="Usage: std_main_5D.sh [OPTION]
+Options
+ -ts    to produce time series 
+ -plot  to produce maps and sections
+ -html  to produce html document
+ -pdf   to produce pdf document
+ -noidl to skip the call to IDL and the production of Postscript
+ -vm    to use IDL virtual machine (free) instead of IDL
+ -help  to get this help
+"
+#
+vm=0
+noidl=0
+format=ps
+while [ ! -z "${1}" ]
+do
+    case ${1} in
+	-plot|--plot) PLOTTYPE=plot ;;
+	-ts|--ts) PLOTTYPE=ts ;;
+	-f|-format|--format) format=${2}	  shift	 ;;
+	-html|--html) format=html ;;
+	-pdf|--pdf) format=pdf ;;
+	-h|-help|--help)	
+	    echo "${usage}"
+	    exit 0	
+	    ;;
+	-ni|--ni|-noidl|--noidl) noidl=1 ;;
+	-vm|--vm|-virtual_machine|--virtual_machine) vm=1 ;;
+	*) # other choice
+	    echo "${usage}"
+	    exit 1
+	    ;;
+    esac
+    shift # next flag
+done
+#
+PLOTTYPE=${PLOTTYPE:-NG}
+if [[ ( "$PLOTTYPE" != "plot" ) && ( "$PLOTTYPE" != "ts" ) ]]
+then
+    echo 'the type of plot must be defined with the option -plot or -ts'
+	exit 1
+fi
+export PLOTTYPE
+#
+set -u
+#
+#
+tstexe () {
+    type ${1}
+    status_type=${?}
+    if [ ${status_type} -ne 0 ]
+    then
+	echo "eee : ${2}"
+	exit 1
+    fi
+}
+#
+#-----------------------------------------------------------
+# define output directory for POSTCRIPT files
+#-----------------------------------------------------------
+#
+. ./std_${PLOTTYPE}_vardef.sh
+[ ! -d ${PS_DIR} ] && mkdir -p ${PS_DIR}
+#
+#-----------------------------------------------------------
+# run IDL
+#-----------------------------------------------------------
+#
+if [ $noidl -eq 0 ]
+then 
+    tstexe ${idl_command} "idl not found"
+#
+    if [ $vm -eq 1 ]
+    then
+	${idl_command} -vm=std_main.sav
+    else 
+	${idl_command} -IDL_STARTUP 'initenv' << EOF
+std_${PLOTTYPE}_all_last_year_5D, /postscript
+EOF
+    fi
+    status_idl=${?}
+    if [ ${status_idl} -ne 0 ]
+    then
+	echo "eee : error in the execution of IDL"
+	exit 1
+    fi
+fi
+#
+#-----------------------------------------------------------
+# produce the final document
+#-----------------------------------------------------------
+#
+# build the list of ps that has been created by IDL
+pslist=$( grep "img width" ${PS_DIR}/std_${PLOTTYPE}_html_body.txt | sed -e "s/.*src=\(.*\)png.*/\1/" )
+#
+case ${format} in
+#__________________________________________________________
+# PDF
+    pdf)
+# check if ps2pdf available
+	ps2pdf_command=$( which ps2pdf )
+	tstexe ${ps2pdf_command} "ps2pdf not found"
+# check if texexec available
+	texexec_command=$( which texexec )
+	tstexe ${texexec_command} "texexec not found"
+#
+	filepdf=all_${PLOTTYPE}.pdf
+	[ ! -d ${PDF_DIR} ] && mkdir -p ${PDF_DIR}
+	pdflist=''
+	for file in ${pslist} ; do
+	    ps2pdf -sPAPERSIZE=a4 ${PS_DIR}/${file}ps ${PDF_DIR}/${file}pdf
+	    echo "ps2pdf ${file}ps done"
+	    pdflist=${pdflist}' '${PDF_DIR}/${file}pdf
+	done
+#pdfjam needed to use pdfjoin
+	pdfjoin ${pdflist} --outfile $PDF_DIR/${filepdf}
+	texexec --pdfarrange --result=$PDF_DIR/$filepdf $pdflist
+	rm -f $PDF_DIR/$( basename $filepdf .pdf ).aux $PDF_DIR/$( basename $filepdf .pdf ).log
+	if [ ! -e ${PDF_DIR}/$filepdf ]
+	then
+	        echo "\n ATTENTION !!!!! \n"
+                echo "${PDF_DIR}/$filepdf do not exist \n"
+        else
+                 echo "${PDF_DIR}/$filepdf done"
+       fi
+#commented because convert gives images of bad quality
+#	convert ${PS_DIR}/*.ps /tmp/all_${PLOTTYPE}.pdf
+#       convert -resize 800x600 ${PS_DIR}/${exp1}_${exp2}/ps/*.ps /tmp/all_${PLOTTYPE}.pdf
+	;;
+#__________________________________________________________
+# HTML
+    html)
+	filehtml=all_${PLOTTYPE}.html
+	[ ! -d ${HTML_DIR} ] && mkdir -p ${HTML_DIR}
+# check if convert available
+	convert_command=$( which convert )
+	tstexe ${convert_command} "convert not found"
+# convert each ps to png	
+	for file in ${pslist} ; do
+	    ${convert_command} -antialias ${PS_DIR}/${file}ps ${HTML_DIR}/${file}png
+	done
+# creation of the HTML file
+	cat << EOF > ${HTML_DIR}/$filehtml
+<!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>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+</head>
+<body>
+EOF
+	cat ${PS_DIR}/std_${PLOTTYPE}_html_body.txt >>  ${HTML_DIR}/$filehtml
+	cat << EOF >> ${HTML_DIR}/$filehtml
+<hr>
+</body>
+</html>
+EOF
+	echo ${HTML_DIR}/$filehtml done
+	;;
+    ps)	;; # nothing to do...
+    *)	
+	echo " format ${format} not implemented"
+	exit 1
+	;;
+esac
+
+    #
+#=====================
+# prepare to put images on dods
+# +++ to finish it
+#LOGIN=xxxx
+#Tag_Name=ORCA2_LIM2
+#rsh ${LOGIN}@gaya.idris.fr exec /bin/ksh <<EOF
+#       cd ${homegaya}/IGCM_OUT/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1}
+#       /usr/local/bin/dods_rm DODS/pub/${LOGIN}/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1} > /dev/null 2>&1
+#       /usr/local/bin/dods_cp ${exp1} DODS/pub/${LOGIN}/${Tag_Name}/CORE2/INTERAN/${PLOTTYPE}_pdf/${exp1} > /dev/null 2>&1
+#EOF
+#=====================
+# end
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_last_year_5D.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_last_year_5D.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_main_last_year_5D.pro	(revision 8732)
@@ -0,0 +1,12 @@
+PRO std_main_last_year_5D
+@initenv
+;
+  type = getenv('PLOTTYPE')
+  CASE type OF
+    '':print, 'The environment variable PLOTTYPE is not defined. We stop'
+    'ts':std_ts_all, /postscript
+    'plot':std_plot_all_last_year_5D, /postscript
+    ELSE:print, 'Wrong definition of the environment variable PLOTTYPE. We stop'
+  ENDCASE
+;
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_ArcSal.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_ArcSal.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_ArcSal.pro	(revision 8732)
@@ -0,0 +1,62 @@
+pro std_plot_ArcSal, S1, S2in, SLevin, Z100 = z100, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  CASE n_params() OF
+    2:BEGIN
+      Slev = S2in
+    END
+    3:BEGIN
+      IF S2in.arr[0] EQ -1 THEN return
+      S2 = S2in
+      Slev = Slevin
+    END
+  ENDCASE
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+;
+  IF keyword_set(z100) THEN tmp = min(abs(100 - gdept), ind) ELSE ind = 0
+  sdepref = strtrim(round(gdept[ind]), 1)+'m'
+  filename = cdti3 + '_Arctic_Sal'+sdepref+'_'+std_file1_T
+  IF keyword_set(S2) THEN filename = filename + '_' + std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+; 
+  domdef, 20, 380, 50, 90
+;
+  varunit = S1.unit
+  titleorg = 'Salinity ('+sdepref+')!C'
+;
+  IF keyword_set(S2) THEN BEGIN
+    title = titleorg+std_file1_T+ ' - '+std_file2_T
+    plt, S1.arr - S2.arr, MIN = -4., MAX = 4., INTER = 0.2, CELL_FILL = 2,  STYLE = 'so0so', format = '(f4.1)'  $     
+         , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, CHARSIZE = -0.55, GLINETHICK = 2. $      
+         , /ORTHO, MAP = [90, 0, 0], LATDEL = 5, boxzoom = [ind, ind], /zindex, /portrait, _extra = ex
+  ENDIF ELSE BEGIN 
+    title = titleorg+std_file1_T
+    plt, S1, MIN = 30.0, MAX = 36., INTER = 0.2, CELL_FILL = 2, format = '(f4.1)' $
+         , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, CHARSIZE = -0.55, GLINETHICK = 2. $
+         , /ORTHO, MAP = [90, 0, 0], LATDEL = 5, boxzoom = [ind, ind], /zindex, /PORTRAIT, _extra = ex
+  ENDELSE 
+; 
+  IF keyword_set(S2) THEN BEGIN
+    title = titleorg+std_file2_T+ ' - Levitus'
+    tmp = S2.arr - SLev.arr
+  ENDIF ELSE BEGIN 
+    title = titleorg+std_file1_T+ ' - Levitus'
+    tmp = S1.arr - SLev.arr
+  ENDELSE
+  plt, temporary(tmp), MIN = -4., MAX = 4., INTER = 0.2, CELL_FILL = 2,  STYLE = 'so0so', format = '(f4.1)'  $     
+       , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, CHARSIZE = -0.55, GLINETHICK = 2. $      
+       , /ORTHO, MAP = [90, 0, 0], LATDEL = 5, boxzoom = [ind, ind], /zindex, /NOERASE, _extra = ex
+;
+  domdef
+;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqS.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqS.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqS.pro	(revision 8732)
@@ -0,0 +1,34 @@
+pro std_plot_EqS, S1, S2, SLev, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_EqS_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  title = 'Equatorial Salinity!C'+std_file1_T
+  pltz, S1, MININ = 33., MAXIN = 37., INTER = .2, typein = 'xz', FORMAT = '(f4.1)'  $
+        , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = [20., 380., -1., 1., 0., 500.], /PORTRAIT, _extra = ex
+  
+  if std_file1_T EQ std_file2_T then begin
+    S = S1.arr - Slev.arr
+    title = title+' - Levitus'
+  ENDIF ELSE BEGIN 
+    S = S1.arr - S2.arr
+    title = title+' - '+std_file2_T
+  ENDELSE
+  
+  pltz, S, MININ = -1., MAXIN = 1., INTER = 0.1, typein = 'xz', STYLE = 'so0so', FORMAT = '(f4.1)' $
+        , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [20., 380., -1., 1., 0., 500.], /noerase, _extra = ex
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqT.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqT.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqT.pro	(revision 8732)
@@ -0,0 +1,42 @@
+pro std_plot_EqT, T1, T2, TLev, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_EqT_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  title = 'Equatorial Temperature!C'+std_file1_T
+  pltz, T1, MININ = 2., MAXIN = 30., INTER = 1., typein = 'xz', FORMAT = '(I2)'  $
+        , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = [20., 380., -1., 1., 0., 500.], /PORTRAIT, _extra = ex
+  
+  if std_file1_T EQ std_file2_T then begin
+    T = T1.arr - TLev.arr
+    title = title+' - Levitus'
+    min = -4.
+    max = -min
+    inter = .5
+    fmt = '(I2)'
+  ENDIF ELSE BEGIN 
+    T = T1.arr - T2.arr
+    title = title+' - '+std_file2_T
+    min =  -2.
+    max = -min
+    inter = .25
+    fmt = '(f4.1)'
+  ENDELSE 
+  
+  pltz, T, MININ = min, MAXIN = max, INTER = inter, typein = 'xz', STYLE = 'so0so', FORMAT = fmt $
+        , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [20., 380., -1., 1., 0., 500.], /NOERASE, _extra = ex
+                                ; 
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqU.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqU.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_EqU.pro	(revision 8732)
@@ -0,0 +1,28 @@
+pro std_plot_EqU, U1, U2, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_EqU_'+std_file1_U
+  if std_file1_U NE std_file2_U then filename = filename + '_'+std_file2_U
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  title = 'Equatorial Zonal Current!C'+std_file1_U
+  pltz, U1, MININ = -1., MAXIN = 1., INTER = .1, typein = 'xz', STYLE = 'so0so', FORMAT = '(f4.1)' $
+        , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = [20., 380., -1., 1., 0., 500.], ZOOM = 500, /PORTRAIT, _extra = ex
+
+  if std_file1_U NE std_file2_U then begin
+    title = title+' - '+std_file2_U
+    pltz, U1.arr-U2.arr, MININ = -.5, MAXIN = .5, INTER = .1, typein = 'xz', STYLE = 'so0so', FORMAT = '(f4.1)' $
+          , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [20., 380., -1., 1., 0., 500.], ZOOM = 500, /PORTRAIT, _extra = ex
+  endif
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_GlobMeanTS.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_GlobMeanTS.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_GlobMeanTS.pro	(revision 8732)
@@ -0,0 +1,39 @@
+pro std_plot_GlobMeanTS, T1, T2, TLev, S1, S2, SLev, sEXP1, sEXP2, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_GlobMeanTS_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+
+  varunit = T1.unit
+  title = 'Temperature Global mean!C'+std_file1_T+' - Levitus (Black)'
+  if std_file1_T NE std_file2_T THEN title = title+'!C'+std_file2_T+' - Levitus (Red)'
+  plt1d, T1.arr - TLev.arr, typein = 'z', ticklen = 1, MIN = -2., MAX = 2., boxzoom = [4., 5300.], /KEEPBOTTOM $
+         , small = [1, 2, 1], XGRIDSTYLE = 2, YGRIDSTYLE = 2, TITLE = title, /PORTRAIT,  _extra = ex
+  if std_file1_T NE std_file2_T then begin
+    plt1d, T2.arr - TLev.arr, typein = 'z',  ticklen = 1, MIN = -2., MAX = 2., boxzoom = [4., 5300.], /KEEPBOTTOM  $
+           , /ov1d, COLOR = 250, TITLE = title, _extra = ex 
+  endif
+;
+  varunit = S1.unit
+  title = 'Salinity Global mean!C'+std_file1_T+' - Levitus (Black)'
+  if std_file1_T NE std_file2_T THEN title = title+'!C'+std_file2_T+' - Levitus (Red)'
+  plt1d, S1.arr - SLev.arr, typein = 'z', ticklen = 1, MIN = -.2, MAX = .4, boxzoom = [4., 5300.], /KEEPBOTTOM $
+         , small = [1, 2, 2], XGRIDSTYLE = 2, YGRIDSTYLE = 2, TITLE = title, /NOERASE, _extra = ex
+  if std_file1_T NE std_file2_T then begin
+    plt1d, S2.arr - SLev.arr, typein = 'z',  ticklen = 1, MIN = -2., MAX = 4., boxzoom = [4., 5300.], /KEEPBOTTOM $
+           ,  /ov1d, COLOR = 250, TITLE = title, _extra = ex 
+  endif
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceAge.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceAge.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceAge.pro	(revision 8732)
@@ -0,0 +1,75 @@
+pro std_plot_IceAge, Iage1, Iage2, Ifra1, Ifra2, ARC = arc, ANT = ant, FEBR = febr, MARCH = march, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+
+  var = 'IceAge'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  IF keyword_set(febr) THEN var = var+'Febr'
+  IF keyword_set(march) THEN var = var+'March'
+  IF keyword_set(sept) THEN var = var+'Sept'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_I
+  IF std_file1_I NE std_file2_I then filename = filename + '_'+std_file2_I
+  IF KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  IF keyword_set(arc) THEN BEGIN 
+    domdef, 20, 380, 50, 90
+    vmin = 0.
+    vmax = 7.
+    vint = 0.5 
+    fmtd = '(f4.1)'
+    vmind = -3.
+    vmaxd = 3.
+    vintd = 0.5
+    fmtd = '(f4.1)'
+    div = 7
+    map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN 
+    domdef, 20, 380, -90, -50
+    vmin = 0.
+    vmax = 2.
+    vint = 0.2
+    fmt = '(f4.1)'
+    vmind = -1.
+    vmaxd = 1.
+    vintd = 0.2
+    fmtd = '(f4.1)'
+    div = 5
+    map = [-90, 0, 0]
+  ENDIF
+;
+  varunit = Iage1.unit
+;
+  title = var+'!C'+std_file1_I
+  
+  Iage1.arr = Iage1.arr * ( Ifra1.arr gt 0.15 )
+ 
+  plt, Iage1.arr - 1.E-04, MIN = vmin, MAX = vmax, INTER = vint, /STRICTFILL, CELL_FILL = 2, format = fmt $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, divisions = div  $
+       , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+;                                ;
+  if std_file1_I NE std_file2_I then begin            
+    title = title + std_file2_I
+ 
+    Iage2.arr = Iage2.arr * ( Ifra2.arr gt 0.15 )
+  
+    plt, Iage1.arr - Iage2.arr, MIN = vmind, MAX = vmaxd, INTER = vintd, STYLE = 'so0so', format = fmtd $
+         , small = [1, 2, 2], COAST_THICK = 2, CELL_FILL = 2, TITLE = title  $
+         , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /NOERASE, _extra = ex
+  endif                        
+  
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceFrac.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceFrac.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceFrac.pro	(revision 8732)
@@ -0,0 +1,60 @@
+pro std_plot_IceFrac, Ifra1, Ifra2, ARC = arc, ANT = ant, FEBR = febr, MARCH = march, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+
+  var = 'IceFra'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  IF keyword_set(febr) THEN var = var+'Febr'
+  IF keyword_set(march) THEN var = var+'March'
+  IF keyword_set(sept) THEN var = var+'Sept'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_I
+  if std_file1_I NE std_file2_I then filename = filename + '_'+std_file2_I
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  IF keyword_set(arc) THEN BEGIN 
+    domdef, 20, 380, 40, 90
+    map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN 
+    domdef, 20, 380, -90, -40
+    map = [-90, 0, 0]
+  ENDIF
+;
+  varunit = Ifra1.unit
+;
+  title = var+'!C'+std_file1_I
+  Ifra1.arr = Ifra1.arr * ( Ifra1.arr gt 0.15 )
+  plt, Ifra1.arr - 1.E-04, MIN = 0., MAX = 1., INTER = .1, /STRICTFILL, CELL_FILL = 2, format = '(f4.1)' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title $
+       , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+;                                ;
+  if std_file1_I NE std_file2_I then begin            
+    title = title + std_file2_I
+    Ifra2.arr = Ifra2.arr * ( Ifra2.arr gt 0.15 )
+    plt, Ifra1.arr - Ifra2.arr, MIN = -1, MAX = 1, INTER = .1, STYLE = 'so0so', format = '(f4.1)' $
+         , small = [1, 2, 2], COAST_THICK = 2, CELL_FILL = 2, TITLE = title $
+         , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /NOERASE, _extra = ex
+;;SF  finire, aggiungere lettura obs
+;;SF  endif else begin
+;;SF    title = title+ ' - Observations'
+;;SF    plt, Ifra1.arr - Ifra_obs.arr, MIN = -1., MAX = 1., INTER = 0.1, STYLE = 'so0so', format = '(f4.1)' $
+;;SF         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, CELL_FILL = 2, TITLE = title $
+;;SF         , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /NOERASE, _extra = ex
+;;SF  endelse  
+endif
+
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceSal.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceSal.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceSal.pro	(revision 8732)
@@ -0,0 +1,57 @@
+pro std_plot_IceSal, Isal1, Isal2, Ifra1, Ifra2, ARC = arc, ANT = ant, FEBR = febr, MARCH = march, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+;
+  var = 'IceSal'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  IF keyword_set(febr) THEN var = var+'Febr'
+  IF keyword_set(march) THEN var = var+'March'
+  IF keyword_set(sept) THEN var = var+'Sept'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_I
+  if std_file1_I NE std_file2_I then filename = filename + '_'+std_file2_I
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+ 
+  IF keyword_set(arc) THEN BEGIN
+     domdef, 20, 380, 50, 90
+     map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN
+     domdef, 20, 380, -90, -50
+     map = [-90, 0, 0]
+  ENDIF
+  ;
+  varunit = Isal1.unit
+  ;
+   title = var+'!C'+std_file1_I
+
+   Isal1.arr = Isal1.arr * ( Ifra1.arr gt 0.15 )
+   plt, Isal1.arr - 1.E-04, MIN = 0., MAX = 10., INTER = 1., /STRICTFILL, CELL_FILL = 2, format = '(f4.1)' $
+        , small = [1, 2, 1], COAST_THICK = 2, TITLE = title $
+        , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+ ;                                ;
+   if std_file1_I NE std_file2_I then begin
+     title = title + std_file2_I
+     
+     Isal2.arr = Isal2.arr * ( Ifra2.arr gt 0.15 )
+     
+     plt, Isal1.arr - Isal2.arr, MIN = -2., MAX = 2., INTER = 1., STYLE = 'so0so', format = '(f4.1)' $
+          , small = [1, 2, 2], COAST_THICK = 2, CELL_FILL = 2, TITLE = title $
+          , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /NOERASE, _extra = ex
+ endif
+ 
+   domdef
+ 
+   htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+   if KEYWORD_SET(postscript) then closeps
+ 
+   return
+ end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceThick.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceThick.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceThick.pro	(revision 8732)
@@ -0,0 +1,75 @@
+pro std_plot_IceThick, Ithi1, Ithi2, Ifra1, Ifra2, ARC = arc, ANT = ant, APRIL = april, JAN = jan, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+
+  var = 'IceThi'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  IF keyword_set(april) THEN var = var+'April'
+  IF keyword_set(jan) THEN var = var+'Jan'
+  IF keyword_set(sept) THEN var = var+'Sept'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_I
+  IF std_file1_I NE std_file2_I then filename = filename + '_'+std_file2_I
+  IF KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  IF keyword_set(arc) THEN BEGIN 
+    domdef, 20, 380, 50, 90
+    vmin = 0.
+    vmax = 6.
+    vint = 0.5
+    fmtd = '(f4.1)'
+    vmind = -3.
+    vmaxd = 3.
+    vintd = 0.5
+    fmtd = '(f4.1)'
+    div = 6
+    map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN 
+    domdef, 20, 380, -90, -50
+    vmin = 0.
+    vmax = 3.
+    vint = 0.2
+    fmt = '(f4.1)'
+    vmind = -1.
+    vmaxd = 1.
+    vintd = 0.2
+    fmtd = '(f4.1)'
+    div = 5
+    map = [-90, 0, 0]
+  ENDIF
+;
+  varunit = Ithi1.unit
+;
+  title = var+'!C'+std_file1_I
+
+  Ithi1.arr = Ithi1.arr * ( Ifra1.arr gt 0.15 )
+ 
+  plt, (Ithi1.arr < 10. ) - 1.E-04, MIN = vmin, MAX = vmax, INTER = vint, /STRICTFILL, CELL_FILL = 2, format = fmt $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, divisions = div  $
+       , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+;                                ;
+  if std_file1_I NE std_file2_I then begin            
+    title = title + std_file2_I
+
+    Ithi2.arr = Ithi2.arr * ( Ifra2.arr gt 0.15 )
+
+    plt, Ithi1.arr - Ithi2.arr, MIN = vmind, MAX = vmaxd, INTER = vintd, STYLE = 'so0so', format = fmtd $
+         , small = [1, 2, 2], COAST_THICK = 2, CELL_FILL = 2, TITLE = title  $
+         , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /NOERASE, _extra = ex
+  endif                        
+  
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceVel.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceVel.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_IceVel.pro	(revision 8732)
@@ -0,0 +1,60 @@
+pro std_plot_IceVel, IvelU1, IvelU2, IvelV1, IvelV2, Ivelo1, Ivelo2, ARC = arc, ANT = ant, FEBR = febr, MARCH = march, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+
+  var = 'IceVel'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  IF keyword_set(febr) THEN var = var+'Febr'
+  IF keyword_set(march) THEN var = var+'March'
+  IF keyword_set(sept) THEN var = var+'Sept'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_I
+  if std_file1_I NE std_file2_I then filename = filename + '_'+std_file2_I
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+ 
+  IF keyword_set(arc) THEN BEGIN
+     domdef, 20, 380, 50, 90
+     map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN
+     domdef, 20, 380, -90, -50
+     map = [-90, 0, 0]
+  ENDIF
+  ;
+  title = var+'!C'+std_file1_I
+   
+  Ivelo1 = {arr: Ivelo1.arr - 1.E-04, g: 'T'}
+  ; Ivelo1 = {arr: Ivelo1.arr, g: 'T'}
+  
+  plt, Ivelo1, vecteur={u:IvelU1, v:IvelV1}, unvectsur=[3,3], normeref = 0.5, cmref = 1.  $
+        , small = [1, 2, 1], TITLE = title $
+        , /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+ ;                                
+ 
+  if std_file1_I NE std_file2_I then begin
+     title = title + std_file2_I  
+  ;   
+     Ivelo = {arr: Ivelo1.arr - Ivelo2.arr, g: 'T'}
+     ; Ivelo1 = {arr: Ivelo1.arr, g: 'T'}
+     ; Ivelo2 = {arr: Ivelo2.arr - 1.E-04, g: 'T'}
+     Ivelo2 = {arr: Ivelo2.arr , g: 'T'}
+    
+     plt, Ivelo, vecteur={u: IvelU2, v: IvelV2}, unvectsur=[3,3], normeref = 0.5, cmref = 1.  $
+          , small = [1, 2, 2], TITLE = title $
+          , /ORTHO, MAP = map, /NOERASE, _extra = ex
+ endif
+ 
+   domdef
+ 
+   htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+   if KEYWORD_SET(postscript) then closeps
+ 
+   return
+ end
+ 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_MLD_ortho.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_MLD_ortho.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_MLD_ortho.pro	(revision 8732)
@@ -0,0 +1,48 @@
+pro std_plot_MLD_ortho, MLD1, MLD2, ARC = arc, ANT = ant, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+
+  var = 'MLD'
+  IF keyword_set(arc) THEN var = var+'_Arc'
+  IF keyword_set(ant) THEN var = var+'_Ant'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  IF keyword_set(arc) THEN BEGIN 
+    domdef, 20, 380, 40, 90
+    map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN 
+    domdef, 20, 380, -90, -40
+    map = [-90, 0, 0]
+  ENDIF
+;
+;  varunit = .unit
+;
+  title = var+'!C'+std_file1_T
+;                                ;
+  plt, MLD1.arr, label=4, cb_label=[0, 15, 25, 50, 75, 100, 125, 150, 250, 400, 600, 850], format = '(I3)' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title $
+       , /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+  if std_file1_T NE std_file2_T then begin            
+    title = title + ' - '+ std_file2_T
+    plt, MLD1.arr - MLD2.arr,  MIN = -80., MAX = 80., INTER = 10., format = '(I3)' $
+       , small = [1, 2, 2], COAST_THICK = 2, TITLE = title $
+       , /ORTHO, MAP = map, /NOERASE, _extra = ex
+  endif
+
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_Med_Sdepth.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_Med_Sdepth.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_Med_Sdepth.pro	(revision 8732)
@@ -0,0 +1,36 @@
+pro std_plot_Med_Sdepth, S1, S2, SLev, lat, POSTSCRIPT = postscript,  _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  slat = strtrim(lat, 1)+'N'
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_Med_Sdepth_'+slat+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  title = 'Salinity ('+slat+')!C'+std_file1_T
+  pltz, S1, MININ = 35., MAXIN = 37., INTER = 0.1, FORMAT = '(f4.1)' $
+        , small = [1, 2, 1], COAST_THICK = 2, endpoints = [300., lat, 357., lat], TITLE = title $
+        , boxzoom = [2000.], ZOOM = 2000., /PORTRAIT, _extra = ex 
+;
+  if std_file1_T NE std_file2_T then begin
+    title = title+ ' - '+std_file2_T
+    pltz, S1.arr - S2.arr + valmask*(1.-tmask), MININ = -.4, MAXIN = .4, INTER = .05, STYLE = 'so0so', FORMAT = '(f4.1)' $ 
+          , small = [1, 2, 2], COAST_THICK = 2, endpoints = [300., lat, 357., lat], TITLE = title $
+          , boxzoom = [2000.], ZOOM = 2000., /noerase, _extra = ex 
+  endif else begin
+    title = title+ ' - Levitus'
+    pltz, S1.arr - SLev.arr + valmask*(1.-tmask), MININ = -1., MAXIN = 1., INTER = 0.1, STYLE = 'so0so', FORMAT = '(f4.1)' $ 
+          , small = [1, 2, 2], COAST_THICK = 2, endpoints = [300., lat, 357., lat], TITLE = title $
+          , boxzoom = [2000.], ZOOM = 2000., /noerase, _extra = ex 
+  endelse
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_Med_Sspread.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_Med_Sspread.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_Med_Sspread.pro	(revision 8732)
@@ -0,0 +1,34 @@
+pro std_plot_Med_Sspread, S1, S2, SLev, depth, POSTSCRIPT = postscript,  _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  tmp = min(abs(depth - gdept), ind)
+  sdepref = strtrim(round(gdept[ind]), 1)+'m'
+  filename = cdti3 + '_Med_Sspread_'+sdepref+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;  
+  title = 'Salinity ('+sdepref+')!C'+std_file1_T
+  plt, S1, MININ = 35., MAXIN = 37., INTER = 0.1, FORMAT = '(f4.1)' $
+       , small = [1, 2, 1], boxzoom = [270, 365, 5, 70, ind, ind], /zindex, COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex
+;
+  if std_file1_T NE std_file2_T then begin
+    title = title+ ' - '+std_file2_T
+    plt, S1.arr - S2.arr, MININ = -.4, MAXIN = .4, INTER = .05, STYLE = 'so0so', FORMAT = '(f4.1)'  $
+         , small = [1, 2, 2], boxzoom = [270, 365, 5, 70, ind, ind], /zindex, COAST_THICK = 2, TITLE = title, /noerase, _extra = ex
+  endif else begin
+    title = title+ ' - Levitus'
+    plt, S1.arr - SLev.arr, MININ = -1., MAXIN = 1., INTER = 0.1, STYLE = 'so0so', FORMAT = '(f4.1)'  $
+         , small = [1, 2, 2], boxzoom = [270, 365, 5, 70, ind, ind], /zindex, COAST_THICK = 2, TITLE = title, /noerase, _extra = ex
+  ENDELSE
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_S100m.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_S100m.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_S100m.pro	(revision 8732)
@@ -0,0 +1,34 @@
+pro std_plot_S100m, S1, S2, SLev, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  tmp = min(abs(100 - gdept), ind)
+  sdepref = strtrim(round(gdept[ind]), 1)+'m'
+  filename = cdti3 + '_S'+sdepref+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  title = 'Salinity ('+sdepref+')!C'+std_file1_T
+  plt, S1, MIN = 33., MAX = 38.2, INTER = .2, format = '(f4.1)' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = [floor(gdept[ind]), ceil(gdept[ind])], /PORTRAIT, _extra = ex
+;
+  if std_file1_T NE std_file2_T then begin
+    title = title+ ' - '+std_file2_T
+    plt, S1.arr[*, *, 0] - S2.arr[*, *, 0], MIN = -1., MAX = 1., INTER = .1, STYLE = 'so0so', format = '(f4.1)' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [floor(gdept[ind]), ceil(gdept[ind])], /noerase, _extra = ex   
+  endif else begin
+    title = title+ ' - Levitus'
+    plt, S1.arr-SLev.arr, MIN = -1., MAX = 1., INTER = 0.1, STYLE = 'so0so', format = '(f4.1)' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [floor(gdept[ind]), ceil(gdept[ind])], /noerase, _extra = ex
+  endelse
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_SnowThick.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_SnowThick.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_SnowThick.pro	(revision 8732)
@@ -0,0 +1,75 @@
+pro std_plot_SnowThick, Isnow1, Isnow2, Ifra1, Ifra2, ARC = arc, ANT = ant, FEBR = febr, MARCH = march, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+
+  var = 'SnowThi'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  IF keyword_set(febr) THEN var = var+'Febr'
+  IF keyword_set(march) THEN var = var+'March'
+  IF keyword_set(sept) THEN var = var+'Sept'
+
+  filename = cdti3 + '_'+var+'_'+std_file1_I
+  if std_file1_I NE std_file2_I then filename = filename + '_'+std_file2_I
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  IF keyword_set(arc) THEN BEGIN 
+    domdef, 20, 380, 50, 90
+    vmin = 0.
+    vmax = .6
+    vint = 0.1
+    ;fmt = '(i2)'
+    fmt = '(f4.1)'
+    vmind = -1.
+    vmaxd = 1.
+    vintd = 0.1
+    ;fmtd = '(i2)'
+    fmtd = '(f4.1)'
+    map = [90, 0, 0]
+  ENDIF
+  IF keyword_set(ant) THEN BEGIN 
+    domdef, 20, 380, -90, -50
+    vmin = 0.
+    vmax = 1.
+    vint = 0.1
+    fmt = '(f4.1)'
+    vmind = -1.
+    vmaxd = 1.
+    vintd = 0.1
+    fmtd = '(f4.1)'
+    map = [-90, 0, 0]
+  ENDIF
+;
+  varunit = Isnow1.unit
+;
+  title = var+'!C'+std_file1_I
+  
+  Isnow1.arr = Isnow1.arr * ( Ifra1.arr gt 0.15 )
+  
+  plt, (Isnow1.arr < 10. ) - 1.E-04, MIN = vmin, MAX = vmax, INTER = vint, /STRICTFILL, CELL_FILL = 2, format = fmt $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title $
+       , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /PORTRAIT, _extra = ex
+;                                ;
+  if std_file1_I NE std_file2_I then begin            
+    title = title + std_file2_I
+   
+    Isnow2.arr = Isnow2.arr * ( Ifra2.arr gt 0.15 )
+     
+    plt, Isnow1.arr - Isnow2.arr, MIN = vmind, MAX = vmaxd, INTER = vintd, STYLE = 'so0so', format = fmtd $
+         , small = [1, 2, 2], COAST_THICK = 2, CELL_FILL = 2, TITLE = title $
+         , CHARSIZE = 1.05, GLINETHICK = 2., /ORTHO, MAP = map, /NOERASE, _extra = ex
+  endif                        
+  
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_T100m.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_T100m.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_T100m.pro	(revision 8732)
@@ -0,0 +1,34 @@
+pro std_plot_T100m, T1, T2, TLev, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  tmp = min(abs(100 - gdept), ind)
+  sdepref = strtrim(round(gdept[ind]), 1)+'m'
+  filename = cdti3 + '_T'+sdepref+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;                              
+  title = 'Temperature ('+sdepref+')!C'+std_file1_T
+  plt, T1, MIN = -2., MAX = 32., INTER = 1., FORMAT = '(I2)'  $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = [floor(gdept[ind]), ceil(gdept[ind])], /portrait, _extra = ex
+;
+  IF std_file1_T NE std_file2_T THEN BEGIN
+    title = title+ ' - '+std_file2_T
+    plt, T1.arr - T2.arr, MIN = -2., MAX = 2., INTER = .2, STYLE = 'so0so', FORMAT = '(f4.1)' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [floor(gdept[ind]), ceil(gdept[ind])], /noerase,  _extra = ex
+  ENDIF ELSE BEGIN
+    title = title+ ' - Levitus'
+    plt, T1.arr - TLev.arr, MIN = -5., MAX = 5., INTER = .5, STYLE = 'so0so', FORMAT = '(I2)'  $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = [floor(gdept[ind]), ceil(gdept[ind])], /noerase, _extra = ex   
+  ENDELSE
+;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_ZonMld.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_ZonMld.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_ZonMld.pro	(revision 8732)
@@ -0,0 +1,32 @@
+pro std_plot_ZonMld, MLD1, MLD2, MLD, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ZonMld_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+                                ;
+  title = std_file1_T+' (Black)!C'
+  if std_file1_T NE std_file2_T THEN title = title + std_file2_T+' (Red)!C'
+  title = title + 'DeBoyer (Blue)!C'
+
+  plt1d, -MLD1.arr, MIN = -300., MAX = 0., INTER = 10., typein = 'y' $
+         , small = [1, 1, 1], boxzoom = 5500, ZOOM = 500, CHARSIZE = .8, TITLE = title, /PORTRAIT, _extra = ex 
+                                ;
+  IF std_file1_T NE std_file2_T THEN $
+     plt1d, -MLD2.arr, MIN = -300., MAX = 0., INTER = 10., typein = 'y' $
+            , /ov1d, COLOR = 250, TITLE = title, /NOERASE, _extra = ex ; color 250 = red
+                                ;
+  plt1d, -MLD.arr, MIN = -300., MAX = 0., INTER = 10., typein = 'y' $
+         ,  /ov1d, COLOR = 100, THICK = 3, TITLE = title, /NOERASE, _extra = ex ; color 100 = blue
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all.pro	(revision 8732)
@@ -0,0 +1,589 @@
+pro std_plot_all, doplot = doplot, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common
+@std_common
+                                ; scripts for nemo v3_2 and v3_3
+
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+  PRINT, '                    LAUNCH of std_plots'
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+;
+  std_iodir_data    = isadirectory(getenv('DIR_DATA'),     title = 'path of data in NetCdf format')
+  std_iodir_climato = isadirectory(getenv('DIR_CLIMATO'),  title = 'path of climatological data')
+  std_iodir_mask    = isadirectory(getenv('DIR_MASK'),     title = 'path of mask files (ex: subbasins)')
+; meshmask
+  std_file_mesh = isafile(getenv('FILE_MESH_MASK'),        title = 'mesh_mask', iodir = std_iodir_mask)
+  std_file_msksub = isafile(getenv('FILE_MASK_SUBDOMAIN'), title = 'sub-bassin masks', iodir = std_iodir_mask)
+
+; climatologies
+  std_file_Levitus_T =  isafile(getenv('FILE_TEMP_3D'),    title = 'Levitus_T', iodir = std_iodir_climato)
+  std_file_Levitus_S =  isafile(getenv('FILE_SAL_3D'),     title = 'Levitus_S', iodir = std_iodir_climato)
+  std_file_reynolds  =  isafile(getenv('FILE_SST'),        title = 'Reynolds', iodir = std_iodir_climato)
+  std_file_oaflux    =  isafile(getenv('FILE_FLUX'),       title = 'oaflux', iodir = std_iodir_climato)
+  std_file_mld       =  isafile(getenv('FILE_MLD'),        title = 'Mixed layer depth', iodir = std_iodir_climato)
+  std_file_ice       =  isafile(getenv('FILE_ICE'),        title = 'ICE', iodir = std_iodir_climato)
+  std_file_snow_arc  =  isafile(getenv('FILE_SNOW_ARC'),   title = 'SNOW_ARC', iodir = std_iodir_climato)
+  std_file_snow_ant  =  isafile(getenv('FILE_SNOW_ANT'),   title = 'SNOW_ANT', iodir = std_iodir_climato)
+
+  IF strlowcase(getenv('FILE_GEOHEAT')) EQ 'no' THEN std_file_geoheat = 'no' $
+  ELSE std_file_geoheat =  isafile(getenv('FILE_GEOHEAT'), title = 'Geothermal heating', iodir = std_iodir_climato)
+;
+  allrec =  1 - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+  
+; Output run experience1
+  std_file1_T     = isafile(getenv('FILE1_T'), title = 'exp1 grid T input file', iodir = std_iodir_data)
+  std_file1_U     = isafile(getenv('FILE1_U'), title = 'exp1 grid U input file', iodir = std_iodir_data)
+  std_file1_V     = isafile(getenv('FILE1_V'), title = 'exp1 grid V input file', iodir = std_iodir_data)
+  std_file1_I     = isafile(getenv('FILE1_I'), title = 'exp1 ice    input file', iodir = std_iodir_data)
+  
+; Output run experience2
+  std_file2_T     = isafile(getenv('FILE2_T'), title = 'exp2 grid T input file', iodir = std_iodir_data)
+  std_file2_U     = isafile(getenv('FILE2_U'), title = 'exp2 grid U input file', iodir = std_iodir_data)
+  std_file2_V     = isafile(getenv('FILE2_V'), title = 'exp2 grid V input file', iodir = std_iodir_data)
+  std_file2_I     = isafile(getenv('FILE2_I'), title = 'exp2 ice    input file', iodir = std_iodir_data)
+
+  PRINT, ''
+  PRINT, '	std_iodir_data : ' + std_iodir_data 
+  PRINT, '	std_file1T : ' + std_file1_T
+  PRINT, '	std_file1U : ' + std_file1_U
+  PRINT, '	std_file1V : ' + std_file1_V
+;  PRINT, '	std_file1W : ' + std_file1_W
+  PRINT, '	std_file2I : ' + std_file1_I
+  PRINT, '	std_file2T : ' + std_file2_T
+  PRINT, '	std_file2U : ' + std_file2_U
+  PRINT, '	std_file2V : ' + std_file2_V
+;  PRINT, '	std_file2W : ' + std_file2_W
+  PRINT, '	std_file2I : ' + std_file2_I
+  PRINT, ''
+
+;#########################################################################
+;##########################  Load Grids   ################################
+;#########################################################################
+; load the grid
+  load_orca, std_file_mesh  
+; reading variables
+  masknp = read_ncdf('tmaskutil', file = std_file_mesh, /nostruct, /cont_nofill)
+;#########################################################################
+;############################  Read Data  ################################
+;#########################################################################
+;
+  allrec =  1; - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+;
+;;; 3D ;;;
+; temperature
+  T1 = read_ncdf(getenv('VAR1_T'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    T2 = read_ncdf(getenv('VAR2_T'), allrecords = allrec, direc = 't', filename = std_file2_T ) 
+  ENDIF ELSE T2 = {arr:-1}
+  TLev = read_ncdf(getenv('VAR_TEMP_3D'), filename = std_file_Levitus_T ) 
+  TRey = read_ncdf(getenv('VAR_SST'), filename = std_file_reynolds ) 
+
+; salinity
+  S1 = read_ncdf(getenv('VAR1_S'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    S2 = read_ncdf(getenv('VAR2_S'), allrecords = allrec, direc = 't', filename = std_file2_T ) 
+  ENDIF ELSE S2 = {arr:-1}
+  SLev = read_ncdf(getenv('VAR_SAL_3D'), filename = std_file_Levitus_S ) 
+
+;;; 2D ;;;
+; Net Downward heat flux
+  Q1 = read_ncdf(getenv('VAR1_QNET'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    Q2 = read_ncdf(getenv('VAR2_QNET'), allrecords = allrec, direc = 't', filename = std_file2_T )
+  ENDIF ELSE Q2 = {arr:-1}
+; Geothermal heating
+  IF std_file_geoheat EQ 'no' THEN geo = {arr:float(getenv('VAR_GEOHEAT'))} $
+  ELSE geo = read_ncdf(getenv('VAR_GEOHEAT'), filename =  std_file_geoheat )
+  geo = geo.arr*1.e-3          ; convert into W/m2
+;climatology 
+  QNET = read_ncdf(getenv('VAR_FLUX'), filename = std_file_oaflux )
+
+; erp (evaporation damping)
+  ERP1 = read_ncdf(getenv('VAR1_ERP'), allrecords = allrec, direc = 't', filename = std_file1_T )
+  ERP1 = {arr:ERP1.arr * 86400., unit:'mm/day', grid:'T'}
+  IF std_file2_T NE std_file1_T THEN BEGIN
+     ERP2 = read_ncdf(getenv('VAR2_ERP'), allrecords = allrec, direc = 't', filename = std_file2_T )
+     ERP2 = {arr:ERP2.arr * 86400., unit:'mm/day', grid:'T'}
+  ENDIF ELSE ERP2 = {arr:-1}
+ 
+; emp (evaporation minus precipitation)
+  EMP1 = read_ncdf(getenv('VAR1_EMP'), allrecords = allrec, direc = 't', filename = std_file1_T )
+  EMP1 = {arr:EMP1.arr * 86400., unit:'mm/day', grid:'T'}
+   IF std_file2_T NE std_file1_T THEN BEGIN
+     EMP2 = read_ncdf(getenv('VAR2_EMP'), allrecords = allrec, direc = 't', filename = std_file2_T )
+     EMP2 = {arr:EMP2.arr * 86400., unit:'mm/day', grid:'T'}
+   ENDIF ELSE EMP2 = {arr:-1}
+   
+ ;mixed layer depth
+   MLD1 = read_ncdf(getenv('VAR1_MLD'), allrecords = allrec, direc = 't', filename = std_file1_T ) ; 10 m
+   IF std_file2_T NE std_file1_T THEN BEGIN
+     MLD2 = read_ncdf(getenv('VAR2_MLD'), allrecords = allrec, direc = 't', filename = std_file2_T ) ; 10 m
+   ENDIF ELSE MLD2 = {arr:-1}
+ ;climatology 
+   MLD = read_ncdf(getenv('VAR_MLD'), filename = std_file_mld )
+
+ ; velocities
+   U1 = read_ncdf(getenv('VAR1_U'), allrecords = allrec, direc = 't', filename = std_file1_U )
+   ; old formulation: we tested variable name
+   ; IF strlowcase(getenv('VAR1_U')) EQ 'uocetr_eff' OR strlowcase(getenv('VAR1_U')) EQ 'vozoeftr' THEN BEGIN
+   IF strlowcase(U1.unit) EQ 'm3/s' THEN BEGIN
+     ;IF it is a transport it is transofrmed in velocity
+     U1.arr = U1.arr / e3u_3d(/e2) * umask()
+     U1.unit = 'm/s'
+   ENDIF 
+   IF std_file2_U NE std_file1_U THEN BEGIN
+     U2 = read_ncdf(getenv('VAR2_U'), allrecords = allrec, direc = 't', filename = std_file2_U )
+     ; old formulation: we tested variable name
+     ; IF strlowcase(getenv('VAR2_U')) EQ 'uocetr_eff' OR strlowcase(getenv('VAR2_U')) EQ 'vozoeftr' THEN BEGIN
+     IF strlowcase(U2.unit) EQ 'm3/s' THEN BEGIN
+       U2.arr = U2.arr / e3u_3d(/e2) * umask()
+       U2.unit = 'm/s'
+     ENDIF 
+   ENDIF ELSE U2 = {arr:-1}
+;
+   V1 = read_ncdf(getenv('VAR1_V'), allrecords = allrec, direc = 't', filename = std_file1_V )
+   ; old formulation: we tested variable name
+   ; IF strlowcase(getenv('VAR1_V')) EQ 'vocetr_eff' OR strlowcase(getenv('VAR1_V')) EQ 'vomeeftr' THEN BEGIN
+   IF strlowcase(V1.unit) EQ 'm3/s' THEN BEGIN ; test on unit to understand if it is a transport or velocity
+     ;IF it is a transport it is transofrmed in velocity
+     V1.arr = V1.arr / e3v_3d(/e1) * vmask()
+     V1.unit = 'm/s'
+   ENDIF 
+   IF std_file2_V NE std_file1_V THEN BEGIN
+     V2 = read_ncdf(getenv('VAR2_V'), allrecords = allrec, direc = 't', filename = std_file2_V )
+     ; old formulation
+     ; IF strlowcase(getenv('VAR2_V')) EQ 'vocetr_eff' OR strlowcase(getenv('VAR2_V')) EQ 'vozoeftr' THEN BEGIN
+     IF strlowcase(V2.unit) EQ 'm3/s' THEN BEGIN 
+       V2.arr = V2.arr / e3v_3d(/e1) * vmask()
+       V2.unit = 'm/s'
+     ENDIF 
+   ENDIF ELSE V2 = {arr:-1}
+
+; ice
+  Ithi_1 = read_ncdf(getenv('VAR1_Ithick'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  april = where(mm EQ 4, cnt)
+  Ithi_april_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_1.unit}
+  jan = where(mm EQ 1, cnt)
+  Ithi_jan_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
+  sept = where(mm EQ 9, cnt)
+  Ithi_sept_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
+  undefine, Ithi_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+     Ithi_2 = read_ncdf(getenv('VAR2_Ithick'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     april = where(mm EQ 4, cnt)
+     Ithi_april_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     jan = where(mm EQ 1, cnt)
+     sept = where(mm EQ 9, cnt)
+     Ithi_sept_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     Ithi_jan_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     undefine, Ithi_2
+  ENDIF ELSE BEGIN 
+     Ithi_april_2 = {arr:-1}
+     Ithi_sept_2 = {arr:-1}
+     Ithi_jan_2 = {arr:-1}
+  ENDELSE
+;
+  Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  jan = where(mm EQ 1, cnt)
+  Ifra_jan_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  febr = where(mm EQ 2, cnt)
+  Ifra_febr_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  march = where(mm EQ 3, cnt)
+  Ifra_march_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  april = where(mm EQ 4, cnt)
+  Ifra_april_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  sept = where(mm EQ 9, cnt)
+  Ifra_sept_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ifra_1.unit}
+  undefine, Ifra_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+    Ifra_2 = read_ncdf(getenv('VAR2_Ifrac'), allrecords = allrec, filename = std_file2_I ) 
+    caldat, time, mm
+    jan = where(mm EQ 1, cnt)
+    Ifra_jan_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    febr = where(mm EQ 2, cnt)
+    Ifra_febr_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    march = where(mm EQ 3, cnt)
+    Ifra_march_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    april = where(mm EQ 4, cnt)
+    Ifra_april_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    sept = where(mm EQ 9, cnt)
+    Ifra_sept_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    undefine, Ifra_2
+  ENDIF ELSE BEGIN 
+    Ifra_jan_2 = {arr:-1} 
+    Ifra_febr_2 = {arr:-1}
+    Ifra_march_2 = {arr:-1}
+    Ifra_april_2 = {arr:-1}
+    Ifra_sept_2 = {arr:-1}
+  ENDELSE
+;
+   Isnow_1 = read_ncdf(getenv('VAR1_Isnow'), allrecords = allrec, filename = std_file1_I ) 
+   caldat, time, mm
+   febr = where(mm EQ 2, cnt)
+   Isnow_febr_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isnow_1.unit} 
+   march = where(mm EQ 3, cnt)
+   Isnow_march_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isnow_1.unit} 
+   sept = where(mm EQ 9, cnt)
+   Isnow_sept_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isnow_1.unit}
+   ;undefine, Isnow_1
+ ;
+   IF std_file2_I NE std_file1_I THEN BEGIN
+     Isnow_2 = read_ncdf(getenv('VAR2_Isnow'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     febr = where(mm EQ 2, cnt)
+     Isnow_febr_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+     march = where(mm EQ 3, cnt)
+     Isnow_march_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+     sept = where(mm EQ 9, cnt)
+     Isnow_sept_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+   ;  undefine, Isnow_2
+   ENDIF ELSE BEGIN 
+     Isnow_febr_2 = {arr:-1}
+     Isnow_march_2 = {arr:-1}
+     Isnow_sept_2 = {arr:-1}
+   ENDELSE
+;
+   Isal_1 = read_ncdf(getenv('VAR1_Isal'), allrecords = allrec, filename = std_file1_I ) 
+;SF  ready for mask : remove 0.15% for observations
+;SF
+;SF   Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I )
+;SF   msk = Ifra_1.arr gt 0.15 ; remove 0.15% for observations 
+   caldat, time, mm
+   march = where(mm EQ 3, cnt)
+   febr = where(mm EQ 2, cnt)
+   Isal_march_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+;SF
+;SF   Isal_1.arr = Isal_1.arr * msk
+;SF 
+;SF   Isal_march_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   Isal_febr_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   sept = where(mm EQ 9, cnt)
+   Isal_sept_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isal_1.unit}
+   ;undefine, Isal_1
+ ;
+   Isal_2 = read_ncdf(getenv('VAR2_Isal'), allrecords = allrec, filename = std_file2_I ) 
+   IF std_file2_I NE std_file1_I THEN BEGIN
+     caldat, time, mm
+     march = where(mm EQ 3, cnt)
+     febr = where(mm EQ 2, cnt)
+     Isal_march_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+     Isal_febr_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+     sept = where(mm EQ 9, cnt)
+     Isal_sept_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+   ;  undefine, Isal_2
+   ENDIF ELSE BEGIN 
+     Isal_febr_2 = {arr:-1}
+     Isal_march_2 = {arr:-1}
+     Isal_sept_2 = {arr:-1}
+   ENDELSE
+
+  IvelU_1 = read_ncdf(getenv('VAR1_IvelU'), allrecords = allrec, filename = std_file1_I ) 
+  IvelV_1 = read_ncdf(getenv('VAR1_IvelV'), allrecords = allrec, filename = std_file1_I ) 
+  Ivelo_1 = read_ncdf(getenv('VAR1_Ivelo'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  febr = where(mm EQ 2, cnt)
+  IvelU_febr_1 = {arr:1./float(cnt) * total(reform(IvelU_1.arr[*, *, febr],nxt,nyt,cnt), 3), unit:IvelU_1.unit, g: 'T'}
+  IvelV_febr_1 = {arr:1./float(cnt) * total(reform(IvelV_1.arr[*, *, febr],nxt,nyt,cnt), 3), unit:IvelV_1.unit, g: 'T'}
+  Ivelo_febr_1 = {arr:1./float(cnt) * total(reform(Ivelo_1.arr[*, *, febr],nxt,nyt,cnt), 3), unit:Ivelo_1.unit, g: 'T'} 
+  march = where(mm EQ 3, cnt)
+  IvelU_march_1 = {arr:1./float(cnt) * total(reform(IvelU_1.arr[*, *, march],nxt,nyt,cnt), 3), unit:IvelU_1.unit, g: 'T'}
+  IvelV_march_1 = {arr:1./float(cnt) * total(reform(IvelV_1.arr[*, *, march],nxt,nyt,cnt), 3), unit:IvelV_1.unit, g: 'T'}
+  Ivelo_march_1 = {arr:1./float(cnt) * total(reform(Ivelo_1.arr[*, *, march],nxt,nyt,cnt), 3), unit:Ivelo_1.unit, g: 'T'} 
+  sept = where(mm EQ 9, cnt)
+  IvelU_sept_1 = {arr:1./float(cnt) * total(reform(IvelU_1.arr[*, *, sept],nxt,nyt,cnt), 3), unit:IvelU_1.unit, g: 'T'}
+  IvelV_sept_1 = {arr:1./float(cnt) * total(reform(IvelV_1.arr[*, *, sept],nxt,nyt,cnt), 3), unit:IvelV_1.unit, g: 'T'}
+  Ivelo_sept_1 = {arr:1./float(cnt) * total(reform(Ivelo_1.arr[*, *, sept],nxt,nyt,cnt), 3), unit:Ivelo_1.unit, g: 'T'}
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+    IvelU_2 = read_ncdf(getenv('VAR2_IvelU'), allrecords = allrec, filename = std_file2_I ) 
+    IvelV_2 = read_ncdf(getenv('VAR2_IvelV'), allrecords = allrec, filename = std_file2_I ) 
+    Ivelo_2 = read_ncdf(getenv('VAR2_Ivelo'), allrecords = allrec, filename = std_file2_I ) 
+    caldat, time, mm
+    febr = where(mm EQ 2, cnt)
+    IvelU_febr_2 = {arr:1./float(cnt) * total(reform(IvelU_2.arr[*, *, febr],nxt,nyt,cnt), 3), unit:IvelU_2.unit}
+    IvelV_febr_2 = {arr:1./float(cnt) * total(reform(IvelV_2.arr[*, *, febr],nxt,nyt,cnt), 3), unit:IvelV_2.unit}
+    Ivelo_febr_2 = {arr:1./float(cnt) * total(reform(Ivelo_2.arr[*, *, febr],nxt,nyt,cnt), 3), unit:Ivelo_2.unit}
+    march = where(mm EQ 3, cnt)
+    IvelU_march_2 = {arr:1./float(cnt) * total(reform(IvelU_2.arr[*, *, march],nxt,nyt,cnt), 3), unit:IvelU_2.unit}
+    IvelV_march_2 = {arr:1./float(cnt) * total(reform(IvelV_2.arr[*, *, march],nxt,nyt,cnt), 3), unit:IvelV_2.unit}
+    Ivelo_march_2 = {arr:1./float(cnt) * total(reform(Ivelo_2.arr[*, *, march],nxt,nyt,cnt), 3), unit:Ivelo_2.unit}
+    sept = where(mm EQ 9, cnt)
+    IvelU_sept_2 = {arr:1./float(cnt) * total(reform(IvelU_2.arr[*, *, sept],nxt,nyt,cnt), 3), unit:IvelU_2.unit}
+    IvelV_sept_2 = {arr:1./float(cnt) * total(reform(IvelV_2.arr[*, *, sept],nxt,nyt,cnt), 3), unit:IvelV_2.unit}   
+    Ivelo_sept_2 = {arr:1./float(cnt) * total(reform(Ivelo_2.arr[*, *, sept],nxt,nyt,cnt), 3), unit:Ivelo_2.unit}
+    undefine, Ifra_2
+  ENDIF ELSE BEGIN 
+    IvelU_febr_2 = {arr:-1}
+    IvelV_febr_2 = {arr:-1}
+    Ivelo_febr_2 = {arr:-1}
+    IvelU_march_2 = {arr:-1}
+    IvelV_march_2 = {arr:-1}
+    Ivelo_march_2 = {arr:-1}
+    IvelU_sept_2 = {arr:-1}
+    IvelV_sept_2 = {arr:-1}
+    Ivelo_sept_2 = {arr:-1}
+  ENDELSE
+
+  Iage_1 = read_ncdf(getenv('VAR1_Iage'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  febr = where(mm EQ 2, cnt)
+  Iage_febr_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Iage_1.unit}
+  march = where(mm EQ 3, cnt)
+  Iage_march_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Iage_1.unit}
+  sept = where(mm EQ 9, cnt)
+  Iage_sept_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Iage_1.unit} 
+  undefine, Iage_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+     Iage_2 = read_ncdf(getenv('VAR2_Iage'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     febr = where(mm EQ 2, cnt)
+     Iage_febr_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     march = where(mm EQ 3, cnt)
+     Iage_march_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     sept = where(mm EQ 9, cnt)
+     Iage_sept_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     undefine, Iage_2
+  ENDIF ELSE BEGIN 
+     Iage_febr_2 = {arr:-1}
+     Iage_march_2 = {arr:-1}
+     Iage_sept_2 = {arr:-1}
+  ENDELSE
+;
+  jpt = 1
+;
+; shorter file names for legends...
+;
+  std_file1_T = file_basename(std_file1_T,'.nc')
+  std_file1_T = (strsplit(std_file1_T,'_grid_T',/extract,/regex))[0]
+  std_file2_T = file_basename(std_file2_T,'.nc')
+  std_file2_T = (strsplit(std_file2_T,'_grid_T',/extract,/regex))[0]
+  std_file1_U = file_basename(std_file1_U,'.nc')
+  std_file1_U = (strsplit(std_file1_U,'_grid_U',/extract,/regex))[0]
+  std_file2_U = file_basename(std_file2_U,'.nc')
+  std_file2_U = (strsplit(std_file2_U,'_grid_U',/extract,/regex))[0]
+  std_file1_V = file_basename(std_file1_V,'.nc')
+  std_file1_V = (strsplit(std_file1_V,'_grid_V',/extract,/regex))[0]
+  std_file2_V = file_basename(std_file2_V,'.nc')
+  std_file2_V = (strsplit(std_file2_V,'_grid_V',/extract,/regex))[0]
+  std_file1_I = file_basename(std_file1_I,'.nc')
+  std_file1_I = (strsplit(std_file1_I,'_icemod',/extract,/regex))[0]
+  std_file2_I = file_basename(std_file2_I,'.nc')
+  std_file2_I = (strsplit(std_file2_I,'_icemod',/extract,/regex))[0]
+
+;#########################################################################
+;######################  STANDARD PLOTS   ################################
+;#########################################################################
+
+  IF keyword_set(doplot) EQ 0 THEN doplot = 0
+
+; fixed color tabled
+  lct, 64
+  cnt = 0
+  htmltxt = ''
+;
+  cnt = cnt+1   &   blabla = 'Erp salinity damping term'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_erp, ERP1, ERP2, _extra = ex
+;;
+  cnt = cnt+1   &   blabla = 'Evaporation - Precipitation - Runoff term'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_emp, EMP1, EMP2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Net heat flux'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_qnet, Q1, Q2, QNET, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Meridionnal Heat Transport'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mht, Q1.arr+geo, Q2.arr+geo, masknp, std_file_msksub, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Global Barotropic stream Function'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_bsf, U1, U2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Temperature diff with New Reynolds'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_sst, T1, T2, TRey, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Salinity diff with Levitus'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_sss, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, SLev, _extra = ex       
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus and exp2'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, SLev, /z100, _extra = ex       
+; 
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus and exp2 at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, S2, SLev, /z100, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Temperature diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_T100m, T1, T2, Tlev, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'mean Salinity diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_S100m, S1, S2, SLev, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Mixed layer depth'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD1, MLD, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mixed layer depth differences'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD1, MLD2, MLD, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mixed layer depth ortho plan ARCTIC'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_MLD_ortho, MLD1, MLD2, /ARC, _extra = ex
+;sf
+  cnt = cnt+1   &   blabla = 'Mixed layer depth ortho plan ANTARTIC'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_MLD_ortho, MLD1, MLD2, /ANT, _extra = ex
+;sf
+  cnt = cnt+1   &   blabla = 'Zonal mean Mixed layer depth'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ZonMld, MLD1, MLD2, MLD, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Vertical Global mean T & S'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_GlobMeanTS, T1, T2, TLev, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Global'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Atl', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Ind', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Pac', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Global'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Atl', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Ind', _extra = ex 
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Pac', _extra = ex 
+;  
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Global (no Med)'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'GloNoMed', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'Atl', _extra = ex
+ ;
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'Ind', _extra = ex
+ ;
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Indo-Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'IndoPac', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial Temperature'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqT, T1, T2, Tlev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial Salinity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqS, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial zonal velocity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqU, U1, U2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean salt tongue at depth=700'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sspread, S1, S2, SLev, 700, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean salt tongue at depth=1000'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sspread, S1, S2, SLev, 1000, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean water at lat=40¡ N'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sdepth, S1, S2, SLev, 40, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean water at lat=38¡ N'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sdepth, S1, S2, SLev, 38, _extra = ex
+;
+;;
+; all plot are done for ice fraction > 0.15%
+;;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Fraction: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Fraction: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_sept_1, Ifra_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Fraction: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_febr_1, Ifra_febr_2, /ANT, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Fraction: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: JAN'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_jan_1, Ithi_jan_2, Ifra_jan_1, Ifra_jan_2, /ARC, /JAN, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: APRIL'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_april_1, Ithi_april_2, Ifra_april_1, Ifra_april_2, /ARC, /APRIL, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: APRIL'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_april_1, Ithi_april_2, Ifra_april_1, Ifra_april_2, /ANT, /APRIL, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_sept_1, Ithi_sept_2, Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic SNOW Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_march_1, Isnow_march_2, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic SNOW Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_sept_1, Isnow_sept_2, Ifra_sept_1, Ifra_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic SNOW Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_febr_1, Isnow_febr_2, Ifra_febr_1, Ifra_febr_2, /ANT, /FEBR, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Antarctic SNOW Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_sept_1, Isnow_sept_2, Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Salinity: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_march_1, Isal_march_2, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Salinity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_sept_1, Isal_sept_2, Ifra_sept_1, Ifra_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Salinity: FEBRUARY'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_febr_1, Isal_febr_2, Ifra_febr_1, Ifra_febr_2, /ANT, /FEBR, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Salinity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_sept_1, Isal_sept_2, Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Velocity: FEBRUARY'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceVel, IvelU_febr_1, IvelU_febr_2, IvelV_febr_1, IvelV_febr_2, Ivelo_febr_1, Ivelo_febr_2, /ARC, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Velocity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceVel, IvelU_sept_1, IvelU_sept_2, IvelV_sept_1, IvelV_sept_2, Ivelo_sept_1, Ivelo_sept_2, /ARC,  /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antartic Ice Velocity: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceVel, IvelU_march_1, IvelU_march_2, IvelV_march_1, IvelV_march_2, Ivelo_march_1, Ivelo_march_2, /ANT,  /MARCH, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antartic Ice Velocity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceVel, IvelU_sept_1, IvelU_sept_2, IvelV_sept_1, IvelV_sept_2, Ivelo_sept_1, Ivelo_sept_2, /ANT,  /SEPT, _extra = ex
+
+  cnt = cnt+1   &   blabla = 'Arctic Ice Age: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_march_1, Iage_march_2, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Age: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_sept_1, Iage_sept_2,  Ifra_sept_1, Ifra_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Age: FEBR'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_febr_1, Iage_febr_2, Ifra_febr_1, Ifra_febr_2, /ANT, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Age: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_sept_1, Iage_sept_2,  Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+;
+ 
+  IF n_elements(htmltxt) GT 1 THEN putfile, psdir+'std_plot_html_body.txt', htmltxt[1:*]
+  
+  return
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all_1Y.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all_1Y.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all_1Y.pro	(revision 8732)
@@ -0,0 +1,510 @@
+pro std_plot_all_1Y, doplot = doplot, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common
+@std_common
+                                ; scripts for nemo v3_2 and v3_3
+
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+  PRINT, '                    LAUNCH of std_plots'
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+;
+  std_iodir_data    = isadirectory(getenv('DIR_DATA'),     title = 'path of data in NetCdf format')
+  std_iodir_climato = isadirectory(getenv('DIR_CLIMATO'),  title = 'path of climatological data')
+  std_iodir_mask    = isadirectory(getenv('DIR_MASK'),     title = 'path of mask files (ex: subbasins)')
+; meshmask
+  std_file_mesh = isafile(getenv('FILE_MESH_MASK'),        title = 'mesh_mask', iodir = std_iodir_mask)
+  std_file_msksub = isafile(getenv('FILE_MASK_SUBDOMAIN'), title = 'sub-bassin masks', iodir = std_iodir_mask)
+
+; climatologies
+  std_file_Levitus_T =  isafile(getenv('FILE_TEMP_3D'),    title = 'Levitus_T', iodir = std_iodir_climato)
+  std_file_Levitus_S =  isafile(getenv('FILE_SAL_3D'),     title = 'Levitus_S', iodir = std_iodir_climato)
+  std_file_reynolds  =  isafile(getenv('FILE_SST'),        title = 'Reynolds', iodir = std_iodir_climato)
+  std_file_oaflux    =  isafile(getenv('FILE_FLUX'),       title = 'oaflux', iodir = std_iodir_climato)
+  std_file_mld       =  isafile(getenv('FILE_MLD'),        title = 'Mixed layer depth', iodir = std_iodir_climato)
+  std_file_ice       =  isafile(getenv('FILE_ICE'),        title = 'ICE', iodir = std_iodir_climato)
+  std_file_snow_arc  =  isafile(getenv('FILE_SNOW_ARC'),   title = 'SNOW_ARC', iodir = std_iodir_climato)
+  std_file_snow_ant  =  isafile(getenv('FILE_SNOW_ANT'),   title = 'SNOW_ANT', iodir = std_iodir_climato)
+
+  IF strlowcase(getenv('FILE_GEOHEAT')) EQ 'no' THEN std_file_geoheat = 'no' $
+  ELSE std_file_geoheat =  isafile(getenv('FILE_GEOHEAT'), title = 'Geothermal heating', iodir = std_iodir_climato)
+;
+  allrec =  1 - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+; Output run experience1
+  std_file1_T     = isafile(getenv('FILE1_T'), title = 'exp1 grid T input file', iodir = std_iodir_data)
+  std_file1_U     = isafile(getenv('FILE1_U'), title = 'exp1 grid U input file', iodir = std_iodir_data)
+  std_file1_V     = isafile(getenv('FILE1_V'), title = 'exp1 grid V input file', iodir = std_iodir_data)
+  std_file1_I     = isafile(getenv('FILE1_I'), title = 'exp1 ice    input file', iodir = std_iodir_data)
+  
+; Output run experience2
+  std_file2_T     = isafile(getenv('FILE2_T'), title = 'exp2 grid T input file', iodir = std_iodir_data)
+  std_file2_U     = isafile(getenv('FILE2_U'), title = 'exp2 grid U input file', iodir = std_iodir_data)
+  std_file2_V     = isafile(getenv('FILE2_V'), title = 'exp2 grid V input file', iodir = std_iodir_data)
+  std_file2_I     = isafile(getenv('FILE2_I'), title = 'exp2 ice    input file', iodir = std_iodir_data)
+
+  PRINT, ''
+  PRINT, '	std_iodir_data : ' + std_iodir_data 
+  PRINT, '	std_file1T : ' + std_file1_T
+  PRINT, '	std_file1U : ' + std_file1_U
+  PRINT, '	std_file1V : ' + std_file1_V
+;  PRINT, '	std_file1W : ' + std_file1_W
+  PRINT, '	std_file2I : ' + std_file1_I
+  PRINT, '	std_file2T : ' + std_file2_T
+  PRINT, '	std_file2U : ' + std_file2_U
+  PRINT, '	std_file2V : ' + std_file2_V
+;  PRINT, '	std_file2W : ' + std_file2_W
+  PRINT, '	std_file2I : ' + std_file2_I
+  PRINT, ''
+
+;#########################################################################
+;##########################  Load Grids   ################################
+;#########################################################################
+; load the grid
+  load_orca, std_file_mesh  
+; reading variables
+  masknp = read_ncdf('tmaskutil', file = std_file_mesh, /nostruct, /cont_nofill)
+;#########################################################################
+;############################  Read Data  ################################
+;#########################################################################
+;
+  allrec =  1; - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+;
+;;; 3D ;;;
+; temperature
+  T1 = read_ncdf(getenv('VAR1_T'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    T2 = read_ncdf(getenv('VAR2_T'), allrecords = allrec, direc = 't', filename = std_file2_T ) 
+  ENDIF ELSE T2 = {arr:-1}
+  TLev = read_ncdf(getenv('VAR_TEMP_3D'), filename = std_file_Levitus_T ) 
+  TRey = read_ncdf(getenv('VAR_SST'), filename = std_file_reynolds ) 
+
+; salinity
+  S1 = read_ncdf(getenv('VAR1_S'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    S2 = read_ncdf(getenv('VAR2_S'), allrecords = allrec, direc = 't', filename = std_file2_T ) 
+  ENDIF ELSE S2 = {arr:-1}
+  SLev = read_ncdf(getenv('VAR_SAL_3D'), filename = std_file_Levitus_S ) 
+
+;;; 2D ;;;
+; Net Downward heat flux
+  Q1 = read_ncdf(getenv('VAR1_QNET'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    Q2 = read_ncdf(getenv('VAR2_QNET'), allrecords = allrec, direc = 't', filename = std_file2_T )
+  ENDIF ELSE Q2 = {arr:-1}
+; Geothermal heating
+  IF std_file_geoheat EQ 'no' THEN geo = {arr:float(getenv('VAR_GEOHEAT'))} $
+  ELSE geo = read_ncdf(getenv('VAR_GEOHEAT'), filename =  std_file_geoheat )
+  geo = geo.arr*1.e-3          ; convert into W/m2
+;climatology 
+  QNET = read_ncdf(getenv('VAR_FLUX'), filename = std_file_oaflux )
+
+; erp (evaporation damping)
+  ERP1 = read_ncdf(getenv('VAR1_ERP'), allrecords = allrec, direc = 't', filename = std_file1_T )
+  ERP1 = {arr:ERP1.arr * 86400., unit:'mm/day', grid:'T'}
+  IF std_file2_T NE std_file1_T THEN BEGIN
+     ERP2 = read_ncdf(getenv('VAR2_ERP'), allrecords = allrec, direc = 't', filename = std_file2_T )
+     ERP2 = {arr:ERP2.arr * 86400., unit:'mm/day', grid:'T'}
+  ENDIF ELSE ERP2 = {arr:-1}
+ 
+; emp (evaporation minus precipitation)
+  EMP1 = read_ncdf(getenv('VAR1_EMP'), allrecords = allrec, direc = 't', filename = std_file1_T )
+  EMP1 = {arr:EMP1.arr * 86400., unit:'mm/day', grid:'T'}
+   IF std_file2_T NE std_file1_T THEN BEGIN
+     EMP2 = read_ncdf(getenv('VAR2_EMP'), allrecords = allrec, direc = 't', filename = std_file2_T )
+     EMP2 = {arr:EMP2.arr * 86400., unit:'mm/day', grid:'T'}
+   ENDIF ELSE EMP2 = {arr:-1}
+   
+ ;mixed layer depth
+   MLD1 = read_ncdf(getenv('VAR1_MLD'), allrecords = allrec, direc = 't', filename = std_file1_T ) ; 10 m
+   IF std_file2_T NE std_file1_T THEN BEGIN
+     MLD2 = read_ncdf(getenv('VAR2_MLD'), allrecords = allrec, direc = 't', filename = std_file2_T ) ; 10 m
+   ENDIF ELSE MLD2 = {arr:-1}
+ ;climatology 
+   MLD = read_ncdf(getenv('VAR_MLD'), filename = std_file_mld )
+
+ ; velocities
+   U1 = read_ncdf(getenv('VAR1_U'), allrecords = allrec, direc = 't', filename = std_file1_U )
+   ; old formulation: we tested variable name
+   ; IF strlowcase(getenv('VAR1_U')) EQ 'uocetr_eff' OR strlowcase(getenv('VAR1_U')) EQ 'vozoeftr' THEN BEGIN
+   IF strlowcase(U1.unit) EQ 'm3/s' THEN BEGIN
+     ;IF it is a transport it is transofrmed in velocity
+     U1.arr = U1.arr / e3u_3d(/e2) * umask()
+     U1.unit = 'm/s'
+   ENDIF 
+   IF std_file2_U NE std_file1_U THEN BEGIN
+     U2 = read_ncdf(getenv('VAR2_U'), allrecords = allrec, direc = 't', filename = std_file2_U )
+     ; old formulation: we tested variable name
+     ; IF strlowcase(getenv('VAR2_U')) EQ 'uocetr_eff' OR strlowcase(getenv('VAR2_U')) EQ 'vozoeftr' THEN BEGIN
+     IF strlowcase(U2.unit) EQ 'm3/s' THEN BEGIN
+       U2.arr = U2.arr / e3u_3d(/e2) * umask()
+       U2.unit = 'm/s'
+     ENDIF 
+   ENDIF ELSE U2 = {arr:-1}
+;
+   V1 = read_ncdf(getenv('VAR1_V'), allrecords = allrec, direc = 't', filename = std_file1_V )
+   ; old formulation: we tested variable name
+   ; IF strlowcase(getenv('VAR1_V')) EQ 'vocetr_eff' OR strlowcase(getenv('VAR1_V')) EQ 'vomeeftr' THEN BEGIN
+   IF strlowcase(V1.unit) EQ 'm3/s' THEN BEGIN ; test on unit to understand if it is a transport or velocity
+     ;IF it is a transport it is transofrmed in velocity
+     V1.arr = V1.arr / e3v_3d(/e1) * vmask()
+     V1.unit = 'm/s'
+   ENDIF 
+   IF std_file2_V NE std_file1_V THEN BEGIN
+     V2 = read_ncdf(getenv('VAR2_V'), allrecords = allrec, direc = 't', filename = std_file2_V )
+     ; old formulation
+     ; IF strlowcase(getenv('VAR2_V')) EQ 'vocetr_eff' OR strlowcase(getenv('VAR2_V')) EQ 'vozoeftr' THEN BEGIN
+     IF strlowcase(V2.unit) EQ 'm3/s' THEN BEGIN 
+       V2.arr = V2.arr / e3v_3d(/e1) * vmask()
+       V2.unit = 'm/s'
+     ENDIF 
+   ENDIF ELSE V2 = {arr:-1}
+
+; ice
+  Ithi_1 = read_ncdf(getenv('VAR1_Ithick'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  april = where(mm EQ 4, cnt)
+  Ithi_april_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_1.unit}
+  jan = where(mm EQ 1, cnt)
+  sept = where(mm EQ 9, cnt)
+  Ithi_jan_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
+  Ithi_sept_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
+  undefine, Ithi_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+     Ithi_2 = read_ncdf(getenv('VAR2_Ithick'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     april = where(mm EQ 4, cnt)
+     Ithi_april_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     jan = where(mm EQ 1, cnt)
+     sept = where(mm EQ 9, cnt)
+     Ithi_sept_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     Ithi_jan_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     undefine, Ithi_2
+  ENDIF ELSE BEGIN 
+     Ithi_april_2 = {arr:-1}
+     Ithi_sept_2 = {arr:-1}
+     Ithi_jan_2 = {arr:-1}
+  ENDELSE
+;
+  Iage_1 = read_ncdf(getenv('VAR1_Iage'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  febr = where(mm EQ 2, cnt)
+  Iage_febr_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Iage_1.unit}
+  march = where(mm EQ 3, cnt)
+  Iage_march_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Iage_1.unit}
+  sept = where(mm EQ 9, cnt)
+  Iage_sept_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Iage_1.unit} 
+  undefine, Iage_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+     Iage_2 = read_ncdf(getenv('VAR2_Iage'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     febr = where(mm EQ 2, cnt)
+     Iage_febr_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     march = where(mm EQ 3, cnt)
+     Iage_march_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     sept = where(mm EQ 9, cnt)
+     Iage_sept_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     undefine, Iage_2
+  ENDIF ELSE BEGIN 
+     Iage_febr_2 = {arr:-1}
+     Iage_march_2 = {arr:-1}
+     Iage_sept_2 = {arr:-1}
+  ENDELSE
+;
+  Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  febr = where(mm EQ 2, cnt)
+  Ifra_febr_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  march = where(mm EQ 3, cnt)
+  Ifra_march_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  sept = where(mm EQ 9, cnt)
+  Ifra_sept_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ifra_1.unit}
+  undefine, Ifra_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+    Ifra_2 = read_ncdf(getenv('VAR2_Ifrac'), allrecords = allrec, filename = std_file2_I ) 
+    caldat, time, mm
+    febr = where(mm EQ 2, cnt)
+    Ifra_febr_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    march = where(mm EQ 3, cnt)
+    Ifra_march_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    sept = where(mm EQ 9, cnt)
+    Ifra_sept_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    undefine, Ifra_2
+  ENDIF ELSE BEGIN 
+    Ifra_febr_2 = {arr:-1}
+    Ifra_march_2 = {arr:-1}
+    Ifra_sept_2 = {arr:-1}
+  ENDELSE
+;
+   Isnow_1 = read_ncdf(getenv('VAR1_Isnow'), allrecords = allrec, filename = std_file1_I ) 
+   caldat, time, mm
+   febr = where(mm EQ 2, cnt)
+   Isnow_febr_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isnow_1.unit} 
+   march = where(mm EQ 3, cnt)
+   Isnow_march_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isnow_1.unit} 
+   sept = where(mm EQ 9, cnt)
+   Isnow_sept_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isnow_1.unit}
+   ;undefine, Isnow_1
+ ;
+   IF std_file2_I NE std_file1_I THEN BEGIN
+     Isnow_2 = read_ncdf(getenv('VAR2_Isnow'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     febr = where(mm EQ 2, cnt)
+     Isnow_febr_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+     march = where(mm EQ 3, cnt)
+     Isnow_march_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+     sept = where(mm EQ 9, cnt)
+     Isnow_sept_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+   ;  undefine, Isnow_2
+   ENDIF ELSE BEGIN 
+     Isnow_febr_2 = {arr:-1}
+     Isnow_march_2 = {arr:-1}
+     Isnow_sept_2 = {arr:-1}
+   ENDELSE
+;
+   Isal_1 = read_ncdf(getenv('VAR1_Isal'), allrecords = allrec, filename = std_file1_I ) 
+   Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I )
+   msk = Ifra_1.arr gt 0.15 ; remove 0.15% for observations 
+   caldat, time, mm
+   march = where(mm EQ 3, cnt)
+   febr = where(mm EQ 2, cnt)
+   ;SF  Isal_march_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   Isal_1.arr = Isal_1.arr * msk
+   Isal_march_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   Isal_febr_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   sept = where(mm EQ 9, cnt)
+   Isal_sept_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isal_1.unit}
+   ;undefine, Isal_1
+ ;
+   Isal_2 = read_ncdf(getenv('VAR2_Isal'), allrecords = allrec, filename = std_file2_I ) 
+   Ifra_2 = read_ncdf(getenv('VAR2_Ifrac'), allrecords = allrec, filename = std_file2_I )
+   msk = Ifra_2.arr gt 0.15 ; remove 0.15% for observations 
+   IF std_file2_I NE std_file1_I THEN BEGIN
+     Isal_2 = read_ncdf(getenv('VAR2_Isal'), allrecords = allrec, filename = std_file2_I ) 
+     Isal_2.arr = Isal_2.arr * msk
+     caldat, time, mm
+     march = where(mm EQ 3, cnt)
+     febr = where(mm EQ 2, cnt)
+     Isal_march_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+     Isal_febr_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+     sept = where(mm EQ 9, cnt)
+     Isal_sept_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+   ;  undefine, Isal_2
+   ENDIF ELSE BEGIN 
+     Isal_febr_2 = {arr:-1}
+     Isal_march_2 = {arr:-1}
+     Isal_sept_2 = {arr:-1}
+   ENDELSE
+;
+  jpt = 1
+;
+; shorter file names for legends...
+;
+  std_file1_T = file_basename(std_file1_T,'.nc')
+  std_file1_T = (strsplit(std_file1_T,'_grid_T',/extract,/regex))[0]
+  std_file2_T = file_basename(std_file2_T,'.nc')
+  std_file2_T = (strsplit(std_file2_T,'_grid_T',/extract,/regex))[0]
+  std_file1_U = file_basename(std_file1_U,'.nc')
+  std_file1_U = (strsplit(std_file1_U,'_grid_U',/extract,/regex))[0]
+  std_file2_U = file_basename(std_file2_U,'.nc')
+  std_file2_U = (strsplit(std_file2_U,'_grid_U',/extract,/regex))[0]
+  std_file1_V = file_basename(std_file1_V,'.nc')
+  std_file1_V = (strsplit(std_file1_V,'_grid_V',/extract,/regex))[0]
+  std_file2_V = file_basename(std_file2_V,'.nc')
+  std_file2_V = (strsplit(std_file2_V,'_grid_V',/extract,/regex))[0]
+  std_file1_I = file_basename(std_file1_I,'.nc')
+  std_file1_I = (strsplit(std_file1_I,'_icemod',/extract,/regex))[0]
+  std_file2_I = file_basename(std_file2_I,'.nc')
+  std_file2_I = (strsplit(std_file2_I,'_icemod',/extract,/regex))[0]
+
+;#########################################################################
+;######################  STANDARD PLOTS   ################################
+;#########################################################################
+
+  IF keyword_set(doplot) EQ 0 THEN doplot = 0
+
+; fixed color tabled
+  lct, 64
+  cnt = 0
+  htmltxt = ''
+;
+  cnt = cnt+1   &   blabla = 'Erp salinity damping term'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_erp, ERP1, ERP2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Evaporation - Precipitation - Runoff term'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_emp, EMP1, EMP2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Net heat flux'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_qnet, Q1, Q2, QNET, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Meridionnal Heat Transport'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mht, Q1.arr+geo, Q2.arr+geo, masknp, std_file_msksub, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Global Barotropic stream Function'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_bsf, U1, U2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Temperature diff with New Reynolds'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_sst, T1, T2, TRey, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Salinity diff with Levitus'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_sss, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, SLev, _extra = ex       
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus and exp2'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, SLev, /z100, _extra = ex       
+; 
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus and exp2 at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, S2, SLev, /z100, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Temperature diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_T100m, T1, T2, Tlev, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'mean Salinity diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_S100m, S1, S2, SLev, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Mixed layer depth'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD1, MLD, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mixed layer depth differences'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD1, MLD2, MLD, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Mixed layer depth'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ZonMld, MLD1, MLD2, MLD, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Vertical Global mean T & S'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_GlobMeanTS, T1, T2, TLev, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Global'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Atl', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Ind', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Pac', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Global'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Atl', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Ind', _extra = ex 
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Pac', _extra = ex 
+;  
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Global (no Med)'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'GloNoMed', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'Atl', _extra = ex
+ ;
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'Ind', _extra = ex
+ ;
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Indo-Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'IndoPac', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial Temperature'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqT, T1, T2, Tlev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial Salinity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqS, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial zonal velocity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqU, U1, U2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean salt tongue at depth=700'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sspread, S1, S2, SLev, 700, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean salt tongue at depth=1000'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sspread, S1, S2, SLev, 1000, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean water at lat=40°N'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sdepth, S1, S2, SLev, 40, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean water at lat=38°N'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sdepth, S1, S2, SLev, 38, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: JAN'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_jan_1, Ithi_jan_2, /ARC, /JAN, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: APRIL'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_april_1, Ithi_april_2, /ARC, /APRIL, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: APRIL'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_april_1, Ithi_april_2, /ANT, /APRIL, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_sept_1, Ithi_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Age: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_march_1, Iage_march_2, /ARC, /MARCH, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Age: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_sept_1, Iage_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Age: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_febr_1, Iage_febr_2, /ANT, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Age: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_sept_1, Iage_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Fraction: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Fraction: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_sept_1, Ifra_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Fraction: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_febr_1, Ifra_febr_2, /ANT, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Fraction: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic SNOW Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_march_1, Isnow_march_2, /ARC, /MARCH, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic SNOW Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_sept_1, Isnow_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic SNOW Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_febr_1, Isnow_febr_2, /ANT, /FEBR, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Antarctic SNOW Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_sept_1, Isnow_sept_2, /ANT, /SEPT, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Salinity: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_march_1, Isal_march_2, /ARC, /MARCH, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Salinity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_sept_1, Isal_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Salinity: FEBRUARY'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_febr_1, Isal_febr_2, /ANT, /FEBR, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Salinity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_sept_1, Isal_sept_2, /ANT, /SEPT, _extra = ex
+; 
+ 
+  IF n_elements(htmltxt) GT 1 THEN putfile, psdir+'std_plot_html_body.txt', htmltxt[1:*]
+  
+  return
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all_last_year_5D.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all_last_year_5D.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_all_last_year_5D.pro	(revision 8732)
@@ -0,0 +1,531 @@
+pro std_plot_all_last_year_5D, doplot = doplot, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common
+@std_common
+                                ; scripts for nemo v3_2 and v3_3
+
+;; script for max MLD, output 5 days
+
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+  PRINT, '                    LAUNCH of std_plots_last_year_5D'
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+;
+  std_iodir_data    = isadirectory(getenv('DIR_DATA'),     title = 'path of data in NetCdf format')
+  std_iodir_climato = isadirectory(getenv('DIR_CLIMATO'),  title = 'path of climatological data')
+  std_iodir_mask    = isadirectory(getenv('DIR_MASK'),     title = 'path of mask files (ex: subbasins)')
+; meshmask
+  std_file_mesh = isafile(getenv('FILE_MESH_MASK'),        title = 'mesh_mask', iodir = std_iodir_mask)
+  std_file_msksub = isafile(getenv('FILE_MASK_SUBDOMAIN'), title = 'sub-bassin masks', iodir = std_iodir_mask)
+
+; climatologies
+  std_file_Levitus_T =  isafile(getenv('FILE_TEMP_3D'),    title = 'Levitus_T', iodir = std_iodir_climato)
+  std_file_Levitus_S =  isafile(getenv('FILE_SAL_3D'),     title = 'Levitus_S', iodir = std_iodir_climato)
+  std_file_reynolds  =  isafile(getenv('FILE_SST'),        title = 'Reynolds', iodir = std_iodir_climato)
+  std_file_oaflux    =  isafile(getenv('FILE_FLUX'),       title = 'oaflux', iodir = std_iodir_climato)
+  std_file_mld       =  isafile(getenv('FILE_MLD'),        title = 'Mixed layer depth', iodir = std_iodir_climato)
+  std_file_ice       =  isafile(getenv('FILE_ICE'),        title = 'ICE', iodir = std_iodir_climato)
+  std_file_snow_arc  =  isafile(getenv('FILE_SNOW_ARC'),   title = 'SNOW_ARC', iodir = std_iodir_climato)
+  std_file_snow_ant  =  isafile(getenv('FILE_SNOW_ANT'),   title = 'SNOW_ANT', iodir = std_iodir_climato)
+
+  IF strlowcase(getenv('FILE_GEOHEAT')) EQ 'no' THEN std_file_geoheat = 'no' $
+  ELSE std_file_geoheat =  isafile(getenv('FILE_GEOHEAT'), title = 'Geothermal heating', iodir = std_iodir_climato)
+;
+  allrec =  1 - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+; Output run experience1
+  std_file1_T     = isafile(getenv('FILE1_T'), title = 'exp1 grid T input file', iodir = std_iodir_data)
+  std_file1_U     = isafile(getenv('FILE1_U'), title = 'exp1 grid U input file', iodir = std_iodir_data)
+  std_file1_V     = isafile(getenv('FILE1_V'), title = 'exp1 grid V input file', iodir = std_iodir_data)
+  std_file1_I     = isafile(getenv('FILE1_I'), title = 'exp1 ice    input file', iodir = std_iodir_data)
+  
+; Output run experience2
+  std_file2_T     = isafile(getenv('FILE2_T'), title = 'exp2 grid T input file', iodir = std_iodir_data)
+  std_file2_U     = isafile(getenv('FILE2_U'), title = 'exp2 grid U input file', iodir = std_iodir_data)
+  std_file2_V     = isafile(getenv('FILE2_V'), title = 'exp2 grid V input file', iodir = std_iodir_data)
+  std_file2_I     = isafile(getenv('FILE2_I'), title = 'exp2 ice    input file', iodir = std_iodir_data)
+
+  PRINT, ''
+  PRINT, '	std_iodir_data : ' + std_iodir_data 
+  PRINT, '	std_file1T : ' + std_file1_T
+  PRINT, '	std_file1U : ' + std_file1_U
+  PRINT, '	std_file1V : ' + std_file1_V
+;  PRINT, '	std_file1W : ' + std_file1_W
+  PRINT, '	std_file2I : ' + std_file1_I
+  PRINT, '	std_file2T : ' + std_file2_T
+  PRINT, '	std_file2U : ' + std_file2_U
+  PRINT, '	std_file2V : ' + std_file2_V
+;  PRINT, '	std_file2W : ' + std_file2_W
+  PRINT, '	std_file2I : ' + std_file2_I
+  PRINT, ''
+
+;#########################################################################
+;##########################  Load Grids   ################################
+;#########################################################################
+; load the grid
+  load_orca, std_file_mesh  
+; reading variables
+  masknp = read_ncdf('tmaskutil', file = std_file_mesh, /nostruct, /cont_nofill)
+;#########################################################################
+;############################  Read Data  ################################
+;#########################################################################
+;
+  allrec =  1; - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+;
+;;; 3D ;;;
+; temperature
+  T1 = read_ncdf(getenv('VAR1_T'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    T2 = read_ncdf(getenv('VAR2_T'), allrecords = allrec, direc = 't', filename = std_file2_T ) 
+  ENDIF ELSE T2 = {arr:-1}
+  TLev = read_ncdf(getenv('VAR_TEMP_3D'), filename = std_file_Levitus_T ) 
+  TRey = read_ncdf(getenv('VAR_SST'), filename = std_file_reynolds ) 
+
+; salinity
+  S1 = read_ncdf(getenv('VAR1_S'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    S2 = read_ncdf(getenv('VAR2_S'), allrecords = allrec, direc = 't', filename = std_file2_T ) 
+  ENDIF ELSE S2 = {arr:-1}
+  SLev = read_ncdf(getenv('VAR_SAL_3D'), filename = std_file_Levitus_S ) 
+
+;;; 2D ;;;
+; Net Downward heat flux
+  Q1 = read_ncdf(getenv('VAR1_QNET'), allrecords = allrec, direc = 't', filename = std_file1_T ) 
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    Q2 = read_ncdf(getenv('VAR2_QNET'), allrecords = allrec, direc = 't', filename = std_file2_T )
+  ENDIF ELSE Q2 = {arr:-1}
+; Geothermal heating
+  IF std_file_geoheat EQ 'no' THEN geo = {arr:float(getenv('VAR_GEOHEAT'))} $
+  ELSE geo = read_ncdf(getenv('VAR_GEOHEAT'), filename =  std_file_geoheat )
+  geo = geo.arr*1.e-3          ; convert into W/m2
+;climatology 
+  QNET = read_ncdf(getenv('VAR_FLUX'), filename = std_file_oaflux )
+
+; erp (evaporation damping)
+  ERP1 = read_ncdf(getenv('VAR1_ERP'), allrecords = allrec, direc = 't', filename = std_file1_T )
+  ERP1 = {arr:ERP1.arr * 86400., unit:'mm/day', grid:'T'}
+  IF std_file2_T NE std_file1_T THEN BEGIN
+     ERP2 = read_ncdf(getenv('VAR2_ERP'), allrecords = allrec, direc = 't', filename = std_file2_T )
+     ERP2 = {arr:ERP2.arr * 86400., unit:'mm/day', grid:'T'}
+  ENDIF ELSE ERP2 = {arr:-1}
+ 
+; emp (evaporation minus precipitation)
+  EMP1 = read_ncdf(getenv('VAR1_EMP'), allrecords = allrec, direc = 't', filename = std_file1_T )
+  EMP1 = {arr:EMP1.arr * 86400., unit:'mm/day', grid:'T'}
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    EMP2 = read_ncdf(getenv('VAR2_EMP'), allrecords = allrec, direc = 't', filename = std_file2_T )
+    EMP2 = {arr:EMP2.arr * 86400., unit:'mm/day', grid:'T'}
+  ENDIF ELSE EMP2 = {arr:-1}
+  
+  ;mixed layer depth
+  ;; nyear=jpt/73
+  MLD_1 = read_ncdf(getenv('VAR1_MLD'), allrecords = allrec, filename = std_file1_T ) 
+  caldat, time, mm
+  march = where(mm EQ 3, cnt)
+  MLD_march_1 = max(MLD_1.arr[*,*,march], dim=3)
+  MLD_march_1 = {arr: MLD_march_1, unit: MLD_1.unit}
+  sept = where(mm EQ 9, cnt)
+  MLD_sept_1 = max(MLD_1.arr[*,*,sept], dim=3) 
+  MLD_sept_1 = {arr: MLD_sept_1, unit: MLD_1.unit}
+  MLD_1 = {arr: max(MLD_1.arr[*,*,*], dim=3), unit: MLD_1.unit}
+  IF std_file2_T NE std_file1_T THEN BEGIN
+    MLD_2 = read_ncdf(getenv('VAR2_MLD'), allrecords = allrec, filename = std_file2_T ) ; 10 m
+    caldat, time, mm
+    march = where(mm EQ 3, cnt)
+    MLD_march_2 = max(MLD_2.arr[*,*,march], dim=3)
+    MLD_march_2 = {arr: MLD_march_2, unit: MLD_2.unit}
+    sept = where(mm EQ 9, cnt)
+    MLD_sept_2 = max(MLD_2.arr[*,*,sept], dim=3) 
+    MLD_sept_2 = {arr:MLD_sept_2, unit: MLD_2.unit}
+    MLD_2 = {arr: max(MLD_2.arr[*,*,*], dim=3), unit: MLD_2.unit}
+  ENDIF ELSE BEGIN
+    MLD_2 = {arr:-1}
+    MLD_march_2 = {arr:-1}
+    MLD_sept_2 = {arr:-1}
+  ENDELSE
+  
+  ;climatology 
+  MLD = read_ncdf(getenv('VAR_MLD'), filename = std_file_mld )
+; if monthly climatology
+;  MLD = {arr: max(MLD.arr[*,*,*], dim=3), unit: MLD.unit} 
+
+; velocities
+  U1 = read_ncdf(getenv('VAR1_U'), allrecords = allrec, direc = 't', filename = std_file1_U )
+  IF strlowcase(getenv('VAR1_U')) EQ 'uocetr_eff' THEN BEGIN
+    U1.arr = U1.arr / e3u_3d(/e2) * umask()
+    U1.unit = 'm/s'
+  ENDIF 
+  IF std_file2_U NE std_file1_U THEN BEGIN
+    U2 = read_ncdf(getenv('VAR2_U'), allrecords = allrec, direc = 't', filename = std_file2_U )
+    IF strlowcase(getenv('VAR2_U')) EQ 'uocetr_eff' THEN BEGIN
+      U2.arr = U2.arr / e3u_3d(/e2) * umask()
+      U2.unit = 'm/s'
+    ENDIF 
+  ENDIF ELSE U2 = {arr:-1}
+;
+  V1 = read_ncdf(getenv('VAR1_V'), allrecords = allrec, direc = 't', filename = std_file1_V )
+  IF strlowcase(getenv('VAR1_V')) EQ 'vocetr_eff' THEN BEGIN
+    V1.arr = V1.arr / e3v_3d(/e1) * vmask()
+    V1.unit = 'm/s'
+  ENDIF 
+  IF std_file2_V NE std_file1_V THEN BEGIN
+    V2 = read_ncdf(getenv('VAR2_V'), allrecords = allrec, direc = 't', filename = std_file2_V )
+    IF strlowcase(getenv('VAR2_V')) EQ 'vocetr_eff' THEN BEGIN
+      V2.arr = V2.arr / e3v_3d(/e1) * vmask()
+      V2.unit = 'm/s'
+    ENDIF 
+  ENDIF ELSE V2 = {arr:-1}
+
+; ice
+  Ithi_1 = read_ncdf(getenv('VAR1_Ithick'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  april = where(mm EQ 4, cnt)
+  Ithi_april_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_1.unit}
+  jan = where(mm EQ 1, cnt)
+  sept = where(mm EQ 9, cnt)
+  Ithi_jan_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
+  Ithi_sept_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
+  undefine, Ithi_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+     Ithi_2 = read_ncdf(getenv('VAR2_Ithick'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     april = where(mm EQ 4, cnt)
+     Ithi_april_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     jan = where(mm EQ 1, cnt)
+     sept = where(mm EQ 9, cnt)
+     Ithi_sept_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     Ithi_jan_2 = {arr:1./float(cnt) * total(reform(Ithi_2.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_2.unit} 
+     undefine, Ithi_2
+  ENDIF ELSE BEGIN 
+     Ithi_april_2 = {arr:-1}
+     Ithi_sept_2 = {arr:-1}
+     Ithi_jan_2 = {arr:-1}
+  ENDELSE
+;
+  Iage_1 = read_ncdf(getenv('VAR1_Iage'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  febr = where(mm EQ 2, cnt)
+  Iage_febr_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Iage_1.unit}
+  march = where(mm EQ 3, cnt)
+  Iage_march_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Iage_1.unit}
+  sept = where(mm EQ 9, cnt)
+  Iage_sept_1 = {arr:1./float(cnt) * total(reform(Iage_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Iage_1.unit} 
+  undefine, Iage_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+     Iage_2 = read_ncdf(getenv('VAR2_Iage'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     febr = where(mm EQ 2, cnt)
+     Iage_febr_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     march = where(mm EQ 3, cnt)
+     Iage_march_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     sept = where(mm EQ 9, cnt)
+     Iage_sept_2 = {arr:1./float(cnt) * total(reform(Iage_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Iage_2.unit} 
+     undefine, Iage_2
+  ENDIF ELSE BEGIN 
+     Iage_febr_2 = {arr:-1}
+     Iage_march_2 = {arr:-1}
+     Iage_sept_2 = {arr:-1}
+  ENDELSE
+;
+  Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  febr = where(mm EQ 2, cnt)
+  Ifra_febr_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  march = where(mm EQ 3, cnt)
+  Ifra_march_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Ifra_1.unit} 
+  sept = where(mm EQ 9, cnt)
+  Ifra_sept_1 = {arr:1./float(cnt) * total(reform(Ifra_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ifra_1.unit}
+  undefine, Ifra_1
+;
+  IF std_file2_I NE std_file1_I THEN BEGIN
+    Ifra_2 = read_ncdf(getenv('VAR2_Ifrac'), allrecords = allrec, filename = std_file2_I ) 
+    caldat, time, mm
+    febr = where(mm EQ 2, cnt)
+    Ifra_febr_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    march = where(mm EQ 3, cnt)
+    Ifra_march_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    sept = where(mm EQ 9, cnt)
+    Ifra_sept_2 = {arr:1./float(cnt) * total(reform(Ifra_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ifra_2.unit}
+    undefine, Ifra_2
+  ENDIF ELSE BEGIN 
+    Ifra_febr_2 = {arr:-1}
+    Ifra_march_2 = {arr:-1}
+    Ifra_sept_2 = {arr:-1}
+  ENDELSE
+;
+   Isnow_1 = read_ncdf(getenv('VAR1_Isnow'), allrecords = allrec, filename = std_file1_I ) 
+   caldat, time, mm
+   febr = where(mm EQ 2, cnt)
+   Isnow_febr_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isnow_1.unit} 
+   march = where(mm EQ 3, cnt)
+   Isnow_march_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isnow_1.unit} 
+   sept = where(mm EQ 9, cnt)
+   Isnow_sept_1 = {arr:1./float(cnt) * total(reform(Isnow_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isnow_1.unit}
+   ;undefine, Isnow_1
+ ;
+   IF std_file2_I NE std_file1_I THEN BEGIN
+     Isnow_2 = read_ncdf(getenv('VAR2_Isnow'), allrecords = allrec, filename = std_file2_I ) 
+     caldat, time, mm
+     febr = where(mm EQ 2, cnt)
+     Isnow_febr_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+     march = where(mm EQ 3, cnt)
+     Isnow_march_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+     sept = where(mm EQ 9, cnt)
+     Isnow_sept_2 = {arr:1./float(cnt) * total(reform(Isnow_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isnow_2.unit}
+   ;  undefine, Isnow_2
+   ENDIF ELSE BEGIN 
+     Isnow_febr_2 = {arr:-1}
+     Isnow_march_2 = {arr:-1}
+     Isnow_sept_2 = {arr:-1}
+   ENDELSE
+;
+   Isal_1 = read_ncdf(getenv('VAR1_Isal'), allrecords = allrec, filename = std_file1_I ) 
+   Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I )
+   msk = Ifra_1.arr gt 0.15 ; remove 0.15% for observations 
+   caldat, time, mm
+   march = where(mm EQ 3, cnt)
+   febr = where(mm EQ 2, cnt)
+   ;SF  Isal_march_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   Isal_1.arr = Isal_1.arr * msk
+   Isal_march_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   Isal_febr_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isal_1.unit} 
+   sept = where(mm EQ 9, cnt)
+   Isal_sept_1 = {arr:1./float(cnt) * total(reform(Isal_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isal_1.unit}
+   ;undefine, Isal_1
+ ;
+   Isal_2 = read_ncdf(getenv('VAR2_Isal'), allrecords = allrec, filename = std_file2_I ) 
+   Ifra_2 = read_ncdf(getenv('VAR2_Ifrac'), allrecords = allrec, filename = std_file2_I )
+   msk = Ifra_2.arr gt 0.15 ; remove 0.15% for observations 
+   IF std_file2_I NE std_file1_I THEN BEGIN
+     Isal_2 = read_ncdf(getenv('VAR2_Isal'), allrecords = allrec, filename = std_file2_I ) 
+     Isal_2.arr = Isal_2.arr * msk
+     caldat, time, mm
+     march = where(mm EQ 3, cnt)
+     febr = where(mm EQ 2, cnt)
+     Isal_march_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(march)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+     Isal_febr_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(febr)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+     sept = where(mm EQ 9, cnt)
+     Isal_sept_2 = {arr:1./float(cnt) * total(reform(Isal_2.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Isal_2.unit}
+   ;  undefine, Isal_2
+   ENDIF ELSE BEGIN 
+     Isal_febr_2 = {arr:-1}
+     Isal_march_2 = {arr:-1}
+     Isal_sept_2 = {arr:-1}
+   ENDELSE
+;
+  jpt = 1
+;
+; shorter file names for legends...
+;
+  std_file1_T = file_basename(std_file1_T,'.nc')
+  std_file1_T = (strsplit(std_file1_T,'_grid_T',/extract,/regex))[0]
+  std_file2_T = file_basename(std_file2_T,'.nc')
+  std_file2_T = (strsplit(std_file2_T,'_grid_T',/extract,/regex))[0]
+  std_file1_U = file_basename(std_file1_U,'.nc')
+  std_file1_U = (strsplit(std_file1_U,'_grid_U',/extract,/regex))[0]
+  std_file2_U = file_basename(std_file2_U,'.nc')
+  std_file2_U = (strsplit(std_file2_U,'_grid_U',/extract,/regex))[0]
+  std_file1_V = file_basename(std_file1_V,'.nc')
+  std_file1_V = (strsplit(std_file1_V,'_grid_V',/extract,/regex))[0]
+  std_file2_V = file_basename(std_file2_V,'.nc')
+  std_file2_V = (strsplit(std_file2_V,'_grid_V',/extract,/regex))[0]
+  std_file1_I = file_basename(std_file1_I,'.nc')
+  std_file1_I = (strsplit(std_file1_I,'_icemod',/extract,/regex))[0]
+  std_file2_I = file_basename(std_file2_I,'.nc')
+  std_file2_I = (strsplit(std_file2_I,'_icemod',/extract,/regex))[0]
+
+;#########################################################################
+;######################  STANDARD PLOTS   ################################
+;#########################################################################
+
+  IF keyword_set(doplot) EQ 0 THEN doplot = 0
+
+; fixed color tabled
+  lct, 64
+  cnt = 0
+  htmltxt = ''
+;
+  cnt = cnt+1   &   blabla = 'Erp salinity damping term'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_erp, ERP1, ERP2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Evaporation - Precipitation - Runoff term'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_emp, EMP1, EMP2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Net heat flux'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_qnet, Q1, Q2, QNET, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Meridionnal Heat Transport'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mht, Q1.arr+geo, Q2.arr+geo, masknp, std_file_msksub, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Global Barotropic stream Function'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_bsf, U1, U2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Temperature diff with New Reynolds'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_sst, T1, T2, TRey, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Salinity diff with Levitus'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_sss, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, SLev, _extra = ex       
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus and exp2'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, SLev, /z100, _extra = ex       
+; 
+  cnt = cnt+1   &   blabla = 'Arctic mean Salinity diff with Levitus and exp2 at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ArcSal, S1, S2, SLev, /z100, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'mean Temperature diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_T100m, T1, T2, Tlev, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'mean Salinity diff with Levitus at z=100 meters'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_S100m, S1, S2, SLev, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Mixed layer depth'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD1, MLD, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mixed layer depth differences'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD_1, MLD_2, MLD, _extra = ex
+
+  ;SF: add 2 cases for max of Mixed Layer depth on march & septembre
+  cnt = cnt+1   &   blabla = 'Mixed layer depth on March'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_max_mld, MLD_march_1, MLD_march_2, /MARCH, _extra = ex
+
+  cnt = cnt+1   &   blabla = 'Mixed layer depth on September'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_max_mld, MLD_sept_1, MLD_sept_2, /SEPT, _extra = ex
+
+;; SF: commented because not ok for max MLD, output 5 days
+;; cnt = cnt+1   &   blabla = 'Zonal mean Mixed layer depth'
+;; IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ZonMld, MLD_1, MLD_2, MLD, _extra = ex
+  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Global'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Atl', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Ind', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Zonal mean Temperature diff with Levitus: Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_T, T1, T2, TLev, SUBBASIN = 'Pac', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Global'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Atl', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Ind', _extra = ex 
+;
+  cnt = cnt+1   &   blabla = 'Zonal mean Salinity diff with Levitus: Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_zonal_S, S1, S2, SLev, SUBBASIN = 'Pac', _extra = ex 
+;  
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Global (no Med)'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'GloNoMed', _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Atlantic'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'Atl', _extra = ex
+ ;
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Indian'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'Ind', _extra = ex
+ ;
+  cnt = cnt+1   &   blabla = 'Meridional stream Function: Indo-Pacific'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_msf, V1, V2, SUBBASIN = 'IndoPac', _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial Temperature'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqT, T1, T2, Tlev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial Salinity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqS, S1, S2, SLev, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Equatorial zonal velocity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_EqU, U1, U2, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean salt tongue at depth=700'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sspread, S1, S2, SLev, 700, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean salt tongue at depth=1000'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sspread, S1, S2, SLev, 1000, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean water at lat=40°N'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sdepth, S1, S2, SLev, 40, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Mediterranean water at lat=38°N'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_Med_Sdepth, S1, S2, SLev, 38, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: JAN'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_jan_1, Ithi_jan_2, /ARC, /JAN, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: APRIL'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_april_1, Ithi_april_2, /ARC, /APRIL, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: APRIL'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_april_1, Ithi_april_2, /ANT, /APRIL, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_sept_1, Ithi_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Age: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_march_1, Iage_march_2, /ARC, /MARCH, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Age: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_sept_1, Iage_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Age: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_febr_1, Iage_febr_2, /ANT, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Age: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_sept_1, Iage_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic Ice Fraction: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Fraction: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_sept_1, Ifra_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Fraction: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_febr_1, Ifra_febr_2, /ANT, /FEBR, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Fraction: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceFrac, Ifra_sept_1, Ifra_sept_2, /ANT, /SEPT, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Arctic SNOW Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_march_1, Isnow_march_2, /ARC, /MARCH, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic SNOW Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_sept_1, Isnow_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic SNOW Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_febr_1, Isnow_febr_2, /ANT, /FEBR, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Antarctic SNOW Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_SnowThick, Isnow_sept_1, Isnow_sept_2, /ANT, /SEPT, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Salinity: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_march_1, Isal_march_2, /ARC, /MARCH, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Arctic Ice Salinity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_sept_1, Isal_sept_2, /ARC, /SEPT, _extra = ex
+;  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Salinity: FEBRUARY'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_febr_1, Isal_febr_2, /ANT, /FEBR, _extra = ex
+; 
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Salinity: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceSal, Isal_sept_1, Isal_sept_2, /ANT, /SEPT, _extra = ex
+; 
+ 
+  IF n_elements(htmltxt) GT 1 THEN putfile, psdir+'std_plot_html_body.txt', htmltxt[1:*]
+  
+  return
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_bsf.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_bsf.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_bsf.pro	(revision 8732)
@@ -0,0 +1,40 @@
+pro std_plot_bsf, U1, U2, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_BSF_'+std_file1_U
+  if std_file1_U NE std_file2_U then filename = filename + '_'+std_file2_U
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  domdef, 0, 6000
+
+  ;formulation for variable: TRANSPORT
+  ;bb1 = bsf(U1.arr, refvalue = 0., refpoint = [25, 0], /transport )
+  ;
+  ;formulation for variable: VELOCITY
+  bb1 = bsf(U1.arr, refvalue = 0., refpoint = [25, 0])
+  title = 'Barotropic Stream Function!C'+std_file1_U
+  plt, bb1, min = -200., max = 200., int = 10., /portrait, FORMAT = '(I4)', STYLE = 'so0so' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title,  _extra = ex
+
+  if std_file1_U NE std_file2_U then BEGIN
+    ;formulation for variable: TRANSPORT
+    ;bb2 = bsf(U2.arr, refvalue = 0., refpoint = [25, 0], /transport )
+    ;formulation for variable: VELOCITY
+    bb2 = bsf(U2.arr, refvalue = 0., refpoint = [25, 0] )
+    title = 'Barotropic Stream Function!C'+std_file1_U+' - '+std_file2_U
+    plt, bb1.arr - bb2.arr, min = -20., max = 20., int = 2.,  FORMAT = '(I2)', STYLE = 'so0so' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /NOERASE, _extra = ex
+  endif
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_emp.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_emp.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_emp.pro	(revision 8732)
@@ -0,0 +1,29 @@
+pro std_plot_emp, EMP1, EMP2, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_Emp_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  title = 'Emp!C'+std_file1_T
+  plt, EMP1,  MIN = -10., MAX = 10., INTER = 1., style = 'so0so' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, format = '(i3)', /PORTRAIT, _extra = ex
+  
+  if std_file1_T NE std_file2_T then begin
+    title = title+' - '+std_file2_T
+    plt, EMP1.arr - EMP2.arr, MIN = -5., MAX = 5., INTER = 1., style = 'so0so' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, format = '(i3)', /NOERASE, _extra = ex
+  endif
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_erp.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_erp.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_erp.pro	(revision 8732)
@@ -0,0 +1,29 @@
+pro std_plot_erp, ERP1, ERP2, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_Erp_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  title = 'Erp!C'+std_file1_T
+  plt, ERP1,  MIN = -5., MAX = 5., INTER = .5, style = 'so0so' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /PORTRAIT, format = '(i2)', _extra = ex
+  
+  if std_file1_T NE std_file2_T then begin
+    title = title+' - '+std_file2_T
+    plt, ERP1.arr - ERP2.arr, MIN = -2., MAX = 2., INTER = .25, style = 'so0so' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, format = '(f4.1)', /NOERASE, _extra = ex
+  endif
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_max_mld.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_max_mld.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_max_mld.pro	(revision 8732)
@@ -0,0 +1,70 @@
+pro std_plot_max_mld, MLD1, MLD2, MARCH = march, SEPT = sept, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  
+  var = 'max_MLD'
+  IF keyword_set(march) THEN var = var+'_March'
+  IF keyword_set(sept) THEN var = var+'_Sept'
+  
+  filename = cdti3 + '_'+var+'_'+std_file1_T
+  IF std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  IF KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  varunit = MLD1.unit
+  titleorg =  var+'!C'
+;
+;;   IF MLD2.arr[0] NE -1  THEN BEGIN
+;;     title = titleorg+std_file1_T+ ' - '+std_file2_T
+;;     plt, MLD1.arr - MLD2.arr, MIN = -80., MAX = 80., INTER = 10., FORMAT = '(I3)'  $
+;;          , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /NOCONTOUR, /PORTRAIT, _extra = ex
+;;   ENDIF ELSE BEGIN 
+;;     title = titleorg+std_file1_T
+;;     plt, MLD1,label=4, cb_label=[0, 15, 25, 50, 75, 100, 125, 150, 250, 400, 600, 850],/NOCONTOUR,FORMAT = '(I3)' $
+;;        , small = [1, 2, 1],COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex
+;;  ;
+;;  ;ORI SF    plt, MLD1, MIN = 0., MAX = 500., INTER = 25., /NOCONTOUR, FORMAT = '(I3)' $
+;;  ;ORI SF         , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex
+;;  ;
+;;    ENDELSE 
+;
+
+   IF MLD2.arr[0] NE -1  THEN BEGIN
+     title = titleorg+ std_file2_T
+     ; plt, MLD2.arr, MIN = 0., MAX = 800., INTER = 50., FORMAT = '(I3)'  $
+     plt, MLD2.arr, label=4, cb_label=[0, 15, 25, 50, 75, 100, 125, 150, 250, 400, 600, 850],FORMAT = '(I3)' $
+          , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /NOCONTOUR, /PORTRAIT, _extra = ex   
+     ;
+     title = titleorg+std_file1_T+ ' - '+std_file2_T
+     plt, MLD1.arr - MLD2.arr, MIN = -80., MAX = 80., INTER = 10., FORMAT = '(I3)'  $
+          , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /NOCONTOUR, /PORTRAIT, _extra = ex
+   ENDIF ELSE BEGIN 
+     title = titleorg+std_file1_T
+     plt, MLD1,label=4, cb_label=[0, 15, 25, 50, 75, 100, 125, 150, 250, 400, 600, 850],/NOCONTOUR,FORMAT = '(I3)' $
+        , small = [1, 2, 1],COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex
+   ENDELSE
+
+
+  
+;;  IF MLD2.arr[0] NE -1  THEN BEGIN
+;;    title = titleorg+std_file2_T+ ' - DeBoyer'
+;;    tmp = MLD2.arr - MLD.arr
+;;  ENDIF ELSE BEGIN 
+;;    title = titleorg+std_file1_T+ ' - DeBoyer'
+;;    tmp = MLD1.arr - MLD.arr
+;;  ENDELSE
+;;  plt, temporary(tmp), MIN = -80., MAX = 80., INTER = 10., FORMAT = '(I3)'  $
+;;       , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /NOCONTOUR, /NOERASE, _extra = ex
+;  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+;
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_mht.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_mht.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_mht.pro	(revision 8732)
@@ -0,0 +1,89 @@
+PRO std_plot_domht, Q, masknp, mask_filename, ibce, htr, htr_atl
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+
+  Qave = moyenne(Q, 'xy', mask2d = masknp) ; mean value
+  Qnet = Q - Qave
+  ibce = STRTRIM(Qave, 1)
+; 
+  msk = read_ncdf('atlmsk_nomed', filename = mask_filename, /nostruct)
+  msk = msk[*]#replicate(1., nzt) ; from 2D array to 3D array 
+                                
+; *1.E-15 to have PetaWatt
+  Qx     = moyenne(Qnet*e2t    , 'x', mask2d = masknp, /integration)*1.E-15
+  Qx_atl = moyenne(Qnet*e2t*msk, 'x', mask2d = masknp, /integration)*1.E-15
+; northward heat flux transport from antartic  
+  htr     = total(Qx, /cumulative)
+  htr_atl = total(reverse(Qx_atl), /cumulative) ; ! from north to south
+  htr_atl = -reverse(htr_atl)
+; we take from values north till 30° South
+  htr_atl[where(gphit[0, *] lt -30.)] = !Values.F_NaN 
+
+return
+END
+
+pro std_plot_mht, Q1, Q2, masknp, mask_filename, POSTSCRIPT = postscript,  _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_MHT_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+; find the x index with the highest latitude (for the plot)
+  index = where(gphit eq max(gphit))
+  nx = index[0] mod jpi
+  gphi_save = gphit
+  gphit[0, *] = gphit[nx, *]
+; compute meridional heat transport
+  std_plot_domht, Q1, masknp, mask_filename, ibce1, htr1, htr1_atl
+  
+; update data informations
+  varname = 'MHT'
+  varunit = 'Pw'
+  vargrid = 'T' 
+
+  title = 'MHT (Black) & Atlantic MHT (Blue)!C'+std_file1_T
+  subtitle = '(Qnet='+ibce1+' W/m2)'
+  plt1d, htr1, 'y', min = -2., max = 2.5, TITLE = title, SUBTITLE = subtitle, /portrait $ 
+         , SMALL = [2-(std_file1_T EQ std_file2_T), 2, 1], YTITLE = 'PW',  XGRIDSTYLE = 2, TICKLEN = 1, YGRIDSTYLE = 2, _extra = ex
+  plt1d, htr1_atl, 'y', COLOR = 50, /ov1d,  _extra = ex
+
+  if std_file1_T NE std_file2_T then begin
+; compute meridional heat transport
+    std_plot_domht, Q2, masknp, mask_filename, ibce2, htr2, htr2_atl
+
+    title = 'MHT (Black) & Atlantic MHT (Blue)!C'+std_file2_T
+    subtitle = '(Qnet='+ibce2+' W/m2)'
+    plt1d, htr2, 'y', min = -2., max = 2.5, TITLE = title, SUBTITLE = subtitle, /noerase $ 
+           , SMALL = [2, 2, 2], YTITLE = 'PW',  XGRIDSTYLE = 2, TICKLEN = 1, YGRIDSTYLE = 2, _extra = ex
+    plt1d, htr2_atl, 'y', COLOR = 50, /ov1d,  _extra = ex
+
+    title = 'MHT (Black) & Atlantic MHT (Blue) '+std_file1_T+' !C (Red) '+std_file2_T
+    plt1d, htr1, 'y', min = -2., max = 2., TITLE = title $
+           , SMALL = [2, 2, 3], TICKLEN = 1, XGRIDSTYLE = 2 $
+           , YTITLE = 'PW', YGRIDSTYLE = 2, /NOERASE, _extra = ex
+    plt1d, htr2, 'y', COLOR = 250, /ov1d,  _extra = ex
+    plt1d, htr1_atl, 'y', COLOR = 50, /ov1d,  _extra = ex
+    plt1d, htr2_atl, 'y', COLOR = 250, /ov1d,  _extra = ex
+    ;plt1d, (htr1-htr2)*1.e3, 'y', min = -250., max = 250., TITLE = title $
+    ;       , SMALL = [2, 2, 3], TICKLEN = 1, XGRIDSTYLE = 2 $
+    ;       , YTITLE = 'TW', YGRIDSTYLE = 2, /NOERASE, _extra = ex
+    ;plt1d, (htr1_atl - htr2_atl)*1.e3, 'y', COLOR = 50, /ov1d,  _extra = ex
+    
+  endif 
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  
+  gphit = gphi_save
+  
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_mld.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_mld.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_mld.pro	(revision 8732)
@@ -0,0 +1,55 @@
+pro std_plot_mld, MLD1, MLD2in, MLDin, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  CASE n_params() OF
+    2:BEGIN
+      MLD = MLD2in
+    END
+    3:BEGIN
+      IF MLD2in.arr[0] EQ -1 THEN return
+      MLD2 = MLD2in
+      MLD = MLDin
+    END
+  ENDCASE
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_MLD_'+std_file1_T
+  IF keyword_set(MLD2) THEN filename = filename + '_' + std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  varunit = MLD1.unit
+  titleorg = 'MLD!C'
+;
+  IF keyword_set(MLD2) THEN BEGIN
+    title = titleorg+std_file1_T+ ' - '+std_file2_T
+    plt, MLD1.arr - MLD2.arr, MIN = -80., MAX = 80., INTER = 10., FORMAT = '(I3)'  $
+         , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /NOCONTOUR, /PORTRAIT, _extra = ex
+  ENDIF ELSE BEGIN 
+    title = titleorg+std_file1_T
+    plt, MLD1,label=4, cb_label=[0, 15, 25, 50, 75, 100, 125, 150, 250, 400, 600, 850],/NOCONTOUR,FORMAT = '(I3)' $
+            , small = [1, 2, 1],COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex
+;ORI SF    plt, MLD1, MIN = 0., MAX = 500., INTER = 25., /NOCONTOUR, FORMAT = '(I3)' $
+;ORI SF         , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex
+  ENDELSE 
+; 
+  IF keyword_set(MLD2) THEN BEGIN
+    title = titleorg+std_file2_T+ ' - DeBoyer'
+    tmp = MLD2.arr - MLD.arr
+  ENDIF ELSE BEGIN 
+    title = titleorg+std_file1_T+ ' - DeBoyer'
+    tmp = MLD1.arr - MLD.arr
+  ENDELSE
+  plt, temporary(tmp), MIN = -80., MAX = 80., INTER = 10., FORMAT = '(I3)'  $
+       , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /NOCONTOUR, /NOERASE, _extra = ex
+;  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+;
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_msf.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_msf.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_msf.pro	(revision 8732)
@@ -0,0 +1,60 @@
+pro std_plot_msf, V1, V2, SUBBASIN = subbasin, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  if KEYWORD_SET(SUBBASIN) then subname = subbasin else subname = "Glo"
+  filename = cdti3 + '_MSF_'+subname+'_'+std_file1_V
+  if std_file1_V NE std_file2_V then filename = filename + '_'+std_file2_V
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  if KEYWORD_SET(SUBBASIN) then begin
+    CASE subname of 
+      'Atl' : var = 'atlmsk_nomed'
+      'Ind' : var = 'indmsk'
+      'IndoPac' : var = 'indpacmsk'
+      'GloNoMed' : var = 'glomsk_nomed'
+    ENDCASE
+    msk = read_ncdf( var, filename = std_file_msksub, /nostruct, _extra = ex )
+  endif else msk = tmask[*, *, 0]
+;
+  CASE subname OF
+    'GloNoMed':lat_ext = [-80, 90]
+    'Glo':lat_ext = [-80, 90]
+    'Atl':lat_ext = [-30, 90]
+    'Ind':lat_ext = [-30, 30]
+    'IndoPac':lat_ext = [-30, 70]
+  ENDCASE
+  
+  domdef, 0, 6000
+
+  ;formulation for variable: TRANSPORT
+  ;mm1 = msf(V1.arr, msk, indexboxzoom = ind, maskout = ma, /transport )
+  ;
+  ;formulation for variable: VELOCITY
+  mm1 = msf(V1.arr, msk, indexboxzoom = ind, maskout = ma )
+  title = 'Meridional Stream Function, '+subname+'!C'+std_file1_V
+  pltz, mm1, 'yz', -20., 20., int = 1., boxzoom = [ind[0:1], lat_ext, 0, 5500], /xindex, FORMAT = '(I3)', /portrait $
+        , small = [1, 2, 1], COAST_THICK = 2, zoom = 5500, maskdta = ma, /no_partial, TITLE = title, style = 'so0so'
+
+  if std_file1_V NE std_file2_V then begin
+    ;formulation for variable: TRANSPORT
+    ;mm2 = msf(V2.arr, msk, indexboxzoom = ind, maskout = ma, /transport )
+    ;
+    ;formulation for variable: VELOCITY
+    mm2 = msf(V2.arr, msk, indexboxzoom = ind, maskout = ma)
+    title = title+' - '+std_file2_V
+    pltz, mm1.arr-mm2.arr, 'yz', -10., 10., int = 1., boxzoom = [ind[0:1], lat_ext, 0, 5500], /xindex,  FORMAT = '(I3)'  $
+          , small = [1, 2, 2], COAST_THICK = 2, zoom = 5500, maskdta = ma, /no_partial, TITLE = title, /NOERASE, style = 'so0so'
+  endif
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_qnet.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_qnet.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_qnet.pro	(revision 8732)
@@ -0,0 +1,34 @@
+pro std_plot_qnet,  Q1, Q2, QNET, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_Qnet_'+std_file1_T
+  if std_file1_T EQ std_file2_T then filename = filename + '_OAFlux' $
+  ELSE filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  title = 'Qnet!C'+std_file1_T
+  plt,  Q1,  MIN = -200., MAX = 200., INTER = 20., STYLE = 'so0so' $
+        , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, FORMAT = '(I4)', /PORTRAIT, _extra = ex
+
+  if std_file1_T EQ std_file2_T then begin
+    title = 'Qnet!C'+std_file1_T+' - OAFlux'
+    Q = Q1.arr - QNET.arr
+  ENDIF ELSE BEGIN 
+    title = 'Qnet!C'+std_file1_T+' - '+std_file2_T
+    Q = Q1.arr - Q2.arr
+  ENDELSE 
+  plt, Q, MIN = -100, MAX = 100, INTER = 10, STYLE = 'so0so'  $
+       , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, FORMAT = '(I4)', /NOERASE, _extra = ex
+                                ;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_sss.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_sss.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_sss.pro	(revision 8732)
@@ -0,0 +1,34 @@
+pro std_plot_sss, S1, S2, SLev, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_SSS_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+  
+  varunit = S1.unit  
+  
+  title = 'SSS!C'+std_file1_T
+  plt, S1.arr[*, *, 0], MIN = 33., MAX = 41., INTER = .25, format = '(f4.1)' $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, /PORTRAIT, _extra = ex 
+                                ;
+  if std_file1_T NE std_file2_T then begin
+    title = 'SSS!C'+std_file1_T+' - '+std_file2_T
+    plt, S1.arr[*, *, 0] - S2.arr[*, *, 0], MIN = -2., MAX = 2., INTER = 0.2, STYLE = 'so0so' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /noerase, format = '(f4.1)', _extra = ex
+  endif else begin
+    title = 'SSS!C'+std_file1_T+' - Levitus'
+    plt, S1.arr[*, *, 0] - SLev.arr[*, *, 0], MIN = -3., MAX = 3., INTER = 0.2, STYLE = 'so0so' $
+         , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /noerase, format = '(f4.1)', _extra = ex
+  endelse
+                                ;
+   htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_sst.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_sst.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_sst.pro	(revision 8732)
@@ -0,0 +1,43 @@
+pro std_plot_sst, T1, T2, TRey, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_SST_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+
+  if std_file1_T EQ std_file2_T then begin
+    T = T1.arr[*, *, 0]
+    min = -2.
+    max = 32.
+    inter = 1. 
+    STYLE = 0
+    title = 'SST!C'+std_file1_T
+  ENDIF ELSE BEGIN 
+    T = T1.arr[*, *, 0] - T2.arr[*, *, 0]
+    min =  -1.
+    max = -min
+    inter = 0.1
+    STYLE = 'so0so'
+    title = 'SST!C'+std_file1_T+' - '+std_file2_T
+  ENDELSE 
+;
+  varunit = T1.unit
+; 
+  plt, T, MIN = min, MAX = max, INTER = inter, STYLE = STYLE $
+       , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, FORMAT = '(I2)', /PORTRAIT, _extra = ex
+; 
+  title = 'SST!C'+std_file1_T+' - NewReynolds'
+  plt, T1.arr[*, *, 0] - TRey.arr, MIN = -8., MAX = 8., INTER = 0.5, STYLE = 'so0so', FORMAT = '(I2)' $
+       , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, /NOERASE, _extra = ex
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh	(revision 8732)
@@ -0,0 +1,129 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_plot.sh and std_plot.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_plot_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+#idl_command=/Applications/itt/idl64/bin/idl
+idl_command=/Applications/itt/idl71/bin/idl
+#idl_command=/usr/local_linux/idl/idl_6.4/idl64/bin/idl
+#idl_command=idl71
+#
+PS_DIR=$( pwd )/p4H25a50-testht_ps_plot
+PDF_DIR=$( pwd )/p4H25a50-testht_pdf_plot
+HTML_DIR=$( pwd )/html_plot
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+VAR_SNOW_NH=SnowDepth    ;   FILE_SNOW_ARC=Warren99_1954_1991_arctic_snowdepth.nc    # Snow arctic 
+VAR_SNOW_SH=sno_dept_mm  ;   FILE_SNOW_ANT=SMMR_SSMI_antarc_sno_dep_mm1979_2004.nc   # Snow antartic
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+FILE1_T=p4H25a50_20410101_20501231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=p4H25a50_20410101_20501231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=p4H25a50_20410101_20501231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=p4H25a50_20410101_20501231_1M_icemod.nc   # exp1 ice    input file
+VAR1_T=thetao
+VAR1_S=so        
+VAR1_QNET=qt
+VAR1_ERP=wfcorr
+VAR1_EMP=wfo
+VAR1_MLD=mldr10_1
+VAR1_U=uocetr_eff
+VAR1_V=vocetr_eff
+VAR1_Ithick=sithic
+VAR1_Ifrac=siconc
+VAR1_Isnow=snvolu
+VAR1_Isal=sisali
+VAR1_Iage=siages
+VAR1_IvelU=sivelu
+VAR1_IvelV=sivelv
+VAR1_Ivelo=sivelo
+#
+#===================== EXP2 =====================
+#
+FILE2_T=testht_20410101_20501231_1Y_grid_T.nc   # exp1 grid T input file
+FILE2_U=testht_20410101_20501231_1Y_grid_U.nc   # exp1 grid U input file
+FILE2_V=testht_20410101_20501231_1Y_grid_V.nc   # exp1 grid V input file
+FILE2_I=testht_20410101_20501231_1M_icemod.nc   # exp1 ice    input file
+VAR2_T=thetao
+VAR2_S=so
+VAR2_QNET=qt
+VAR2_ERP=wfcorr
+VAR2_EMP=wfo
+VAR2_MLD=mldr10_1
+VAR2_U=uocetr_eff
+VAR2_V=vocetr_eff
+VAR2_Ithick=sithic
+VAR2_Ifrac=siconc
+VAR2_Isnow=snvolu
+VAR2_Isal=sisali
+VAR2_Iage=siages
+VAR2_IvelU=sivelu
+VAR2_IvelV=sivelv
+VAR2_Ivelo=sivelo
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D   VAR_TEMP_3D
+export FILE_SAL_3D    VAR_SAL_3D
+export FILE_SST       VAR_SST
+export FILE_GEOHEAT   VAR_GEOHEAT
+export FILE_FLUX      VAR_FLUX
+export FILE_MLD       VAR_MLD
+export FILE_ICE       VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH VAR_ICE_area_SH
+export FILE_SNOW_ARC  VAR_SNOW_NH
+export FILE_SNOW_ANT  VAR_SNOW_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+export FILE1_T     FILE1_U  FILE1_V   FILE1_I
+export VAR1_T      VAR1_S   VAR1_QNET VAR1_ERP VAR1_EMP VAR1_MLD 
+export VAR1_U      VAR1_V
+export VAR1_Ithick VAR1_Ifrac VAR1_Isnow VAR1_Isal VAR1_Iage VAR1_IvelU VAR1_IvelV VAR1_Ivelo
+#===================== EXP2 =====================
+export FILE2_T     FILE2_U    FILE2_V   FILE2_I
+export VAR2_T      VAR2_S     VAR2_QNET VAR2_ERP VAR2_EMP VAR2_MLD 
+export VAR2_U      VAR2_V
+export VAR2_Ithick VAR2_Ifrac VAR2_Isnow VAR2_Isal VAR2_Iage VAR2_IvelU VAR2_IvelV VAR2_Ivelo
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.last_year_5D
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.last_year_5D	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.last_year_5D	(revision 8732)
@@ -0,0 +1,129 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_plot.sh and std_plot.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_plot_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+#idl_command=/Applications/itt/idl64/bin/idl
+idl_command=/Applications/itt/idl71/bin/idl
+#idl_command=/usr/local_linux/idl/idl_6.4/idl64/bin/idl
+#idl_command=idl71
+#
+PS_DIR=$( pwd )/l3fwb178-plot_lastyear_ps
+PDF_DIR=$( pwd )/l3fwb178_plot_lastyear_pdf
+HTML_DIR=$( pwd )/html_plot
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=~/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=~/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=~//idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+VAR_SNOW_NH=SnowDepth    ;   FILE_SNOW_ARC=Warren99_1954_1991_arctic_snowdepth.nc    # Snow arctic 
+VAR_SNOW_SH=sno_dept_mm  ;   FILE_SNOW_ANT=SMMR_SSMI_antarc_sno_dep_mm1979_2004.nc   # Snow antartic
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+FILE1_T=l3fwb178_25010101_25011231_5D_grid_T.nc   # exp1 grid T input file
+FILE1_U=l3fwb178_25010101_25011231_5D_grid_U.nc   # exp1 grid U input file
+FILE1_V=l3fwb178_25010101_25011231_5D_grid_V.nc   # exp1 grid V input file
+FILE1_I=l3fwb178_25010101_25011231_5D_icemod.nc   # exp1 ice    input file
+VAR1_T=votemper
+VAR1_S=vosaline
+VAR1_QNET=sohflxdo
+VAR1_ERP=sowafldp
+VAR1_EMP=sowaflup
+VAR1_MLD=max5dmld
+VAR1_U=vozoeftr
+VAR1_V=vomeeftr
+VAR1_Ithick=iicethic
+VAR1_Ifrac=iiceconc
+VAR1_Isnow=isnowvol
+VAR1_Isal=iicesali
+VAR1_Iage=iiceages
+VAR1_IvelU=iicevelu
+VAR1_IvelV=iicevelv
+VAR1_Ivelo=iicevelo
+#
+#===================== EXP2 =====================
+#
+FILE2_T=l3fwb178_25010101_25011231_5D_grid_T.nc   # exp1 grid T input file
+FILE2_U=l3fwb178_25010101_25011231_5D_grid_U.nc   # exp1 grid U input file
+FILE2_V=l3fwb178_25010101_25011231_5D_grid_V.nc   # exp1 grid V input file
+FILE2_I=l3fwb178_25010101_25011231_5D_icemod.nc   # exp1 ice    input file
+VAR2_T=votemper
+VAR2_S=vosaline
+VAR2_QNET=sohflxdo
+VAR2_ERP=sowafldp
+VAR2_EMP=sowaflup
+VAR2_MLD=max5dmld
+VAR2_U=vozoeftr
+VAR2_V=vomeeftr
+VAR2_Ithick=iicethic
+VAR2_Ifrac=iiceconc
+VAR2_Isnow=isnowthi
+VAR2_Isal=iicesali
+VAR2_Iage=iiceages
+VAR2_IvelU=iicevelu
+VAR2_IvelV=iicevelv
+VAR2_Ivelo=iicevelo
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D   VAR_TEMP_3D
+export FILE_SAL_3D    VAR_SAL_3D
+export FILE_SST       VAR_SST
+export FILE_GEOHEAT   VAR_GEOHEAT
+export FILE_FLUX      VAR_FLUX
+export FILE_MLD       VAR_MLD
+export FILE_ICE       VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH VAR_ICE_area_SH
+export FILE_SNOW_ARC  VAR_SNOW_NH
+export FILE_SNOW_ANT  VAR_SNOW_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+export FILE1_T     FILE1_U  FILE1_V   FILE1_I
+export VAR1_T      VAR1_S   VAR1_QNET VAR1_ERP VAR1_EMP VAR1_MLD 
+export VAR1_U      VAR1_V
+export VAR1_Ithick VAR1_Ifrac VAR1_Isnow VAR1_Isal VAR1_Iage VAR1_IvelU VAR1_IvelV VAR1_Ivelo
+#===================== EXP2 =====================
+export FILE2_T     FILE2_U    FILE2_V   FILE2_I
+export VAR2_T      VAR2_S     VAR2_QNET VAR2_ERP VAR2_EMP VAR2_MLD 
+export VAR2_U      VAR2_V
+export VAR2_Ithick VAR2_Ifrac VAR2_Isnow VAR2_Isal VAR2_Iage VAR2_IvelU VAR2_IvelV VAR2_Ivelo
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.new_names
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.new_names	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.new_names	(revision 8732)
@@ -0,0 +1,129 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_plot.sh and std_plot.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_plot_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+#idl_command=/Applications/itt/idl64/bin/idl
+idl_command=/Applications/itt/idl71/bin/idl
+#idl_command=/usr/local_linux/idl/idl_6.4/idl64/bin/idl
+#idl_command=idl71
+#
+PS_DIR=$( pwd )/sbcmodMV_ps_plot
+PDF_DIR=$( pwd )/sbcmodMV_pdf_plot
+HTML_DIR=$( pwd )/html_plot
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+VAR_SNOW_NH=SnowDepth    ;   FILE_SNOW_ARC=Warren99_1954_1991_arctic_snowdepth.nc    # Snow arctic 
+VAR_SNOW_SH=sno_dept_mm  ;   FILE_SNOW_ANT=SMMR_SSMI_antarc_sno_dep_mm1979_2004.nc   # Snow antartic
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+FILE1_T=sbcmodMV_20410101_20501231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=sbcmodMV_20410101_20501231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=sbcmodMV_20410101_20501231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=sbcmodMV_20410101_20501231_1M_icemod.nc   # exp1 ice    input file
+VAR1_T=thetao
+VAR1_S=so        
+VAR1_QNET=tohfls
+VAR1_ERP=sowafldp      
+VAR1_EMP=wfo
+VAR1_MLD=mldr10_1
+VAR1_U=uocetr_eff
+VAR1_V=vocetr_eff
+VAR1_Ithick=sithic
+VAR1_Ifrac=siconc
+VAR1_Isnow=snvolu
+VAR1_Isal=sisali
+VAR1_Iage=siages
+VAR1_IvelU=sivelu
+VAR1_IvelV=sivelv
+VAR1_Ivelo=sivelo
+#
+#===================== EXP2 =====================
+#
+FILE2_T=sbcmodMV_20410101_20501231_1Y_grid_T.nc   # exp1 grid T input file
+FILE2_U=sbcmodMV_20410101_20501231_1Y_grid_U.nc   # exp1 grid U input file
+FILE2_V=sbcmodMV_20410101_20501231_1Y_grid_V.nc   # exp1 grid V input file
+FILE2_I=sbcmodMV_20410101_20501231_1M_icemod.nc   # exp1 ice    input file
+VAR2_T=thetao
+VAR2_S=so
+VAR2_QNET=tohfls
+VAR2_ERP=sowafldp
+VAR2_EMP=wfo
+VAR2_MLD=mldr10_1
+VAR2_U=uocetr_eff
+VAR2_V=vocetr_eff
+VAR2_Ithick=sithic
+VAR2_Ifrac=siconc
+VAR2_Isnow=snvolu
+VAR2_Isal=sisali
+VAR2_Iage=siages
+VAR2_IvelU=sivelu
+VAR2_IvelV=sivelv
+VAR2_Ivelo=sivelo
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D   VAR_TEMP_3D
+export FILE_SAL_3D    VAR_SAL_3D
+export FILE_SST       VAR_SST
+export FILE_GEOHEAT   VAR_GEOHEAT
+export FILE_FLUX      VAR_FLUX
+export FILE_MLD       VAR_MLD
+export FILE_ICE       VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH VAR_ICE_area_SH
+export FILE_SNOW_ARC  VAR_SNOW_NH
+export FILE_SNOW_ANT  VAR_SNOW_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+export FILE1_T     FILE1_U  FILE1_V   FILE1_I
+export VAR1_T      VAR1_S   VAR1_QNET VAR1_ERP VAR1_EMP VAR1_MLD 
+export VAR1_U      VAR1_V
+export VAR1_Ithick VAR1_Ifrac VAR1_Isnow VAR1_Isal VAR1_Iage VAR1_IvelU VAR1_IvelV VAR1_Ivelo
+#===================== EXP2 =====================
+export FILE2_T     FILE2_U    FILE2_V   FILE2_I
+export VAR2_T      VAR2_S     VAR2_QNET VAR2_ERP VAR2_EMP VAR2_MLD 
+export VAR2_U      VAR2_V
+export VAR2_Ithick VAR2_Ifrac VAR2_Isnow VAR2_Isal VAR2_Iage VAR2_IvelU VAR2_IvelV VAR2_Ivelo
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.old_names
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.old_names	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh.old_names	(revision 8732)
@@ -0,0 +1,131 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_plot.sh and std_plot.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_plot_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+#idl_command=/Applications/itt/idl64/bin/idl
+idl_command=/Applications/itt/idl71/bin/idl
+#idl_command=/usr/local_linux/idl/idl_6.4/idl64/bin/idl
+#idl_command=idl71
+#
+PS_DIR=$( pwd )/500yfwb0_ps_plot_500y
+PDF_DIR=$( pwd )/500yfwb0_pdf_plot_500y
+HTML_DIR=$( pwd )/html_plot
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+VAR_SNOW_NH=SnowDepth    ;   FILE_SNOW_ARC=Warren99_1954_1991_arctic_snowdepth.nc    # Snow arctic 
+VAR_SNOW_SH=sno_dept_mm  ;   FILE_SNOW_ANT=SMMR_SSMI_antarc_sno_dep_mm1979_2004.nc   # Snow antartic
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+FILE1_T=500yfwb0_24910101_25001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=500yfwb0_24910101_25001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=500yfwb0_24910101_25001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=500yfwb0_24910101_25001231_1M_icemod.nc   # exp1 ice    input file
+VAR1_T=votemper
+VAR1_S=vosaline
+VAR1_QNET=sohflxdo
+VAR1_ERP=sowafldp
+VAR1_EMP=sowaflup
+VAR1_MLD=somxl010
+VAR1_U=vozoeftr
+VAR1_V=vomeeftr
+VAR1_Ithick=iicethic
+VAR1_Ifrac=iiceconc
+VAR1_Isnow=isnowvol
+VAR1_Isal=iicesali
+VAR1_Iage=iiceages
+VAR1_IvelU=iicevelu
+VAR1_IvelV=iicevelv
+#VAR1_Ivelo=iicevelo
+#
+#===================== EXP2 =====================
+#
+FILE2_T=500yfwb0_24910101_25001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE2_U=500yfwb0_24910101_25001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE2_V=500yfwb0_24910101_25001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE2_I=500yfwb0_24910101_25001231_1M_icemod.nc   # exp1 ice    input file
+VAR2_T=votemper
+VAR2_S=vosaline
+VAR2_QNET=sohflxdo
+VAR2_ERP=sowafldp
+VAR2_EMP=sowaflup
+VAR2_MLD=somxl010
+#VAR2_U=uoce
+VAR2_U=vozoeftr
+#VAR2_V=voce
+VAR2_V=vomeeftr
+VAR2_Ithick=iicethic
+VAR2_Ifrac=iiceconc
+VAR2_Isnow=isnowthi
+VAR2_Isal=iicesali
+VAR2_Iage=iiceages
+VAR2_IvelU=iicevelu
+VAR2_IvelV=iicevelv
+#VAR2_Ivelo=iicevelo
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D   VAR_TEMP_3D
+export FILE_SAL_3D    VAR_SAL_3D
+export FILE_SST       VAR_SST
+export FILE_GEOHEAT   VAR_GEOHEAT
+export FILE_FLUX      VAR_FLUX
+export FILE_MLD       VAR_MLD
+export FILE_ICE       VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH VAR_ICE_area_SH
+export FILE_SNOW_ARC  VAR_SNOW_NH
+export FILE_SNOW_ANT  VAR_SNOW_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+export FILE1_T     FILE1_U  FILE1_V   FILE1_I
+export VAR1_T      VAR1_S   VAR1_QNET VAR1_ERP VAR1_EMP VAR1_MLD 
+export VAR1_U      VAR1_V
+export VAR1_Ithick VAR1_Ifrac VAR1_Isnow VAR1_Isal VAR1_Iage VAR1_IvelU VAR1_IvelV VAR1_Ivelo
+#===================== EXP2 =====================
+export FILE2_T     FILE2_U    FILE2_V   FILE2_I
+export VAR2_T      VAR2_S     VAR2_QNET VAR2_ERP VAR2_EMP VAR2_MLD 
+export VAR2_U      VAR2_V
+export VAR2_Ithick VAR2_Ifrac VAR2_Isnow VAR2_Isal VAR2_Iage VAR2_IvelU VAR2_IvelV VAR2_Ivelo
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh_example1
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh_example1	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh_example1	(revision 8732)
@@ -0,0 +1,129 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_plot.sh and std_plot.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_plot_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+#idl_command=/Applications/itt/idl64/bin/idl
+idl_command=/Applications/itt/idl71/bin/idl
+#idl_command=/usr/local_linux/idl/idl_6.4/idl64/bin/idl
+#idl_command=idl71
+#
+PS_DIR=$( pwd )/ps_plot
+PDF_DIR=$( pwd )/pdf_plot
+HTML_DIR=$( pwd )/html_plot
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=~/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=~/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=~//idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+VAR_SNOW_NH=SnowDepth    ;   FILE_SNOW_ARC=Warren99_1954_1991_arctic_snowdepth.nc    # Snow arctic 
+VAR_SNOW_SH=sno_dept_mm  ;   FILE_SNOW_ANT=SMMR_SSMI_antarc_sno_dep_mm1979_2004.nc   # Snow antartic
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+FILE1_T=500yfwb0_24910101_25001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=500yfwb0_24910101_25001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=500yfwb0_24910101_25001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=500yfwb0_24910101_25001231_1M_icemod.nc   # exp1 ice    input file
+VAR1_T=votemper
+VAR1_S=vosaline
+VAR1_QNET=sohflxdo
+VAR1_ERP=sowafldp
+VAR1_EMP=sowaflup
+VAR1_MLD=somxl010
+VAR1_U=vozoeftr
+VAR1_V=vomeeftr
+VAR1_Ithick=iicethic
+VAR1_Ifrac=iiceconc
+VAR1_Isnow=isnowvol
+VAR1_Isal=iicesali
+VAR1_Iage=iiceages
+VAR1_IvelU=iicevelu
+VAR1_IvelV=iicevelv
+VAR1_Ivelo=iicevelo
+#
+#===================== EXP2 =====================
+#
+FILE2_T=tr33beta_00910101_01001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE2_U=tr33beta_00910101_01001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE2_V=tr33beta_00910101_01001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE2_I=tr33beta_00910101_01001231_1M_icemod.nc   # exp1 ice    input file
+VAR2_T=thetao
+VAR2_S=so
+VAR2_QNET=qt
+VAR2_ERP=wfcorr
+VAR2_EMP=wfo
+VAR2_MLD=mldr10_1
+VAR2_U=uocetr_eff
+VAR2_V=vocetr_eff
+VAR2_Ithick=sit
+VAR2_Ifrac=sic
+VAR2_Isnow=isnowthi
+VAR2_Isal=iicesali
+VAR2_Iage=iiceages
+VAR2_IvelU=iicevelu
+VAR2_IvelV=iicevelv
+VAR2_Ivelo=iicevelo
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D   VAR_TEMP_3D
+export FILE_SAL_3D    VAR_SAL_3D
+export FILE_SST       VAR_SST
+export FILE_GEOHEAT   VAR_GEOHEAT
+export FILE_FLUX      VAR_FLUX
+export FILE_MLD       VAR_MLD
+export FILE_ICE       VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH VAR_ICE_area_SH
+export FILE_SNOW_ARC  VAR_SNOW_NH
+export FILE_SNOW_ANT  VAR_SNOW_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+export FILE1_T     FILE1_U  FILE1_V   FILE1_I
+export VAR1_T      VAR1_S   VAR1_QNET VAR1_ERP VAR1_EMP VAR1_MLD 
+export VAR1_U      VAR1_V
+export VAR1_Ithick VAR1_Ifrac VAR1_Isnow VAR1_Isal VAR1_Iage VAR1_IvelU VAR1_IvelV VAR1_Ivelo
+#===================== EXP2 =====================
+export FILE2_T     FILE2_U    FILE2_V   FILE2_I
+export VAR2_T      VAR2_S     VAR2_QNET VAR2_ERP VAR2_EMP VAR2_MLD 
+export VAR2_U      VAR2_V
+export VAR2_Ithick VAR2_Ifrac VAR2_Isnow VAR2_Isal VAR2_Iage VAR2_IvelU VAR2_IvelV VAR2_Ivelo
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh_example2
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh_example2	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_vardef.sh_example2	(revision 8732)
@@ -0,0 +1,129 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_plot.sh and std_plot.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_plot_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+#idl_command=/Applications/itt/idl64/bin/idl
+idl_command=/Applications/itt/idl71/bin/idl
+#idl_command=/usr/local_linux/idl/idl_6.4/idl64/bin/idl
+#idl_command=idl71
+#
+PS_DIR=$( pwd )/ps_plot
+PDF_DIR=$( pwd )/pdf_plot
+HTML_DIR=$( pwd )/html_plot
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=~/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=~/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=~//idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+VAR_SNOW_NH=SnowDepth    ;   FILE_SNOW_ARC=Warren99_1954_1991_arctic_snowdepth.nc    # Snow arctic 
+VAR_SNOW_SH=sno_dept_mm  ;   FILE_SNOW_ANT=SMMR_SSMI_antarc_sno_dep_mm1979_2004.nc   # Snow antartic
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+FILE1_T=500yfwb0_24910101_25001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=500yfwb0_24910101_25001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=500yfwb0_24910101_25001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=500yfwb0_24910101_25001231_1M_icemod.nc   # exp1 ice    input file
+VAR1_T=votemper
+VAR1_S=vosaline
+VAR1_QNET=sohflxdo
+VAR1_ERP=sowafldp
+VAR1_EMP=sowaflup
+VAR1_MLD=somxl010
+VAR1_U=vozoeftr
+VAR1_V=vomeeftr
+VAR1_Ithick=iicethic
+VAR1_Ifrac=iiceconc
+VAR1_Isnow=isnowvol
+VAR1_Isal=iicesali
+VAR1_Iage=iiceages
+VAR1_IvelU=iicevelu
+VAR1_IvelV=iicevelv
+VAR1_Ivelo=iicevelo
+#
+#===================== EXP2 =====================
+#
+FILE1_T=500yfwb0_24910101_25001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=500yfwb0_24910101_25001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=500yfwb0_24910101_25001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=500yfwb0_24910101_25001231_1M_icemod.nc   # exp1 ice    input file
+VAR1_T=votemper
+VAR1_S=vosaline
+VAR1_QNET=sohflxdo
+VAR1_ERP=sowafldp
+VAR1_EMP=sowaflup
+VAR1_MLD=somxl010
+VAR1_U=vozoeftr
+VAR1_V=vomeeftr
+VAR1_Ithick=iicethic
+VAR1_Ifrac=iiceconc
+VAR1_Isnow=isnowvol
+VAR1_Isal=iicesali
+VAR1_Iage=iiceages
+VAR2_IvelU=iicevelu
+VAR2_IvelV=iicevelv
+VAR2_Ivelo=iicevelo
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D   VAR_TEMP_3D
+export FILE_SAL_3D    VAR_SAL_3D
+export FILE_SST       VAR_SST
+export FILE_GEOHEAT   VAR_GEOHEAT
+export FILE_FLUX      VAR_FLUX
+export FILE_MLD       VAR_MLD
+export FILE_ICE       VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH VAR_ICE_area_SH
+export FILE_SNOW_ARC  VAR_SNOW_NH
+export FILE_SNOW_ANT  VAR_SNOW_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+export FILE1_T     FILE1_U  FILE1_V   FILE1_I
+export VAR1_T      VAR1_S   VAR1_QNET VAR1_ERP VAR1_EMP VAR1_MLD 
+export VAR1_U      VAR1_V
+export VAR1_Ithick VAR1_Ifrac VAR1_Isnow VAR1_Isal VAR1_Iage VAR1_IvelU VAR1_IvelV VAR1_Ivelo
+#===================== EXP2 =====================
+export FILE2_T     FILE2_U    FILE2_V   FILE2_I
+export VAR2_T      VAR2_S     VAR2_QNET VAR2_ERP VAR2_EMP VAR2_MLD 
+export VAR2_U      VAR2_V
+export VAR2_Ithick VAR2_Ifrac VAR2_Isnow VAR2_Isal VAR2_Iage VAR2_IvelU VAR2_IvelV VAR2_Ivelo
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_zonal_S.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_zonal_S.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_zonal_S.pro	(revision 8732)
@@ -0,0 +1,55 @@
+pro std_plot_zonal_S, S1, S2, SLev, SUBBASIN = subbasin, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  if KEYWORD_SET(SUBBASIN) then subname = subbasin else subname = "Glo"
+  filename = cdti3 + '_ZonalS_'+subname+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+
+; looking for longitudinal index corresponding to the highest latitude (closest to the North Pole)
+  index = where(gphit eq max(gphit))
+  nx = index[0] mod jpi
+  gphi_save = gphit
+  gphit[0, *] = gphit[nx, *]
+
+  if KEYWORD_SET(SUBBASIN) then begin
+    tmasksv = tmask
+    CASE 1 of 
+      subbasin eq 'Atl' : var = 'atlmsk_nomed'
+      subbasin eq 'Ind' : var = 'indmsk_nored'
+      subbasin eq 'Pac' : var = 'pacmsk'
+    ENDCASE
+    msk = read_ncdf( var, filename = std_file_msksub, _extra = ex)
+; from 2D array to 3D array
+    msk = msk.arr[*]#replicate(1., nzt)
+    tmask[firstxt:lastxt, firstyt:lastyt, firstzt:lastzt] = tmask[firstxt:lastxt, firstyt:lastyt, firstzt:lastzt] * msk
+  endif
+;
+  title = 'Salinity, '+subname+'!C'+std_file1_T
+  pltz, S1, MININ = 31., MAXIN = 36.8, INTER = .2, typein = 'yz', FORMAT = '(f4.1)' $ 
+        , small = [1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = 5500, ZOOM = 1000, /PORTRAIT,  _extra = ex 
+; 
+  if std_file1_T NE std_file2_T then begin
+    title = title+' - '+std_file2_T
+    pltz, S1.arr-S2.arr, MIN = -1., MAX = 1., INTER = .1, typein = 'yz', FORMAT = '(f4.1)', style = 'so0so' $
+          , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = 5500, ZOOM = 1000, /NOERASE,  _extra = ex    
+  endif else begin
+    title = title+' - Levitus'
+    pltz, S1.arr-SLev.arr, MININ = -1, MAXIN = 1., INTER = .1, typein = 'yz', FORMAT = '(f4.1)', style = 'so0so'  $
+          , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = 5500, ZOOM = 1000, /NOERASE, _extra = ex
+  endelse
+;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+;
+  if KEYWORD_SET(SUBBASIN) then tmask = tmasksv
+  gphit = gphi_save
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_zonal_T.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_zonal_T.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_plot_zonal_T.pro	(revision 8732)
@@ -0,0 +1,55 @@
+pro std_plot_zonal_T, T1, T2, TLev, SUBBASIN = subbasin, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+
+@common  
+@std_common
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  if KEYWORD_SET(SUBBASIN) then subname = subbasin else subname = "Glo"
+  filename = cdti3 + '_ZonalT_'+subname+'_'+std_file1_T
+  if std_file1_T NE std_file2_T then filename = filename + '_'+std_file2_T
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;  
+; looking for longitudinal index corresponding to the highest latitude (closest to the North Pole)
+  index = where(gphit eq max(gphit))
+  nx = index[0] mod jpi
+  gphi_save = gphit
+  gphit[0, *] = gphit[nx, *]
+;
+  if KEYWORD_SET(SUBBASIN) then begin
+    tmasksv = tmask
+    CASE 1 of 
+      subbasin eq 'Atl' : var = 'atlmsk_nomed'
+      subbasin eq 'Ind' : var = 'indmsk_nored'
+      subbasin eq 'Pac' : var = 'pacmsk'
+    ENDCASE
+    msk = read_ncdf( var, filename = std_file_msksub, _extra = ex)
+; from 2D array to 3D array
+    msk = msk.arr[*]#replicate(1., nzt)
+    tmask[firstxt:lastxt, firstyt:lastyt, firstzt:lastzt] = tmask[firstxt:lastxt, firstyt:lastyt, firstzt:lastzt] * msk
+  endif
+;
+  title = 'Temperature, '+subname+'!C'+std_file1_T
+  pltz, T1, MININ = -2., MAXIN = 30., INTER = 1., typein = 'yz', FORMAT = '(I2)' $ 
+        , small = [ 1, 2, 1], COAST_THICK = 2, TITLE = title, boxzoom = 5500, ZOOM = 1000, /PORTRAIT, _extra = ex 
+; 
+  if std_file1_T NE std_file2_T then begin
+    title = title+' - '+std_file2_T
+    pltz, T1.arr-T2.arr, MIN = -2., MAX = 2., INTER = .2, typein = 'yz', FORMAT = '(f4.1)', style = 'so0so' $
+          , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = 5500, ZOOM = 1000, /NOERASE, _extra = ex
+  endif else begin
+    title = title+' - Levitus'
+    pltz, T1.arr-TLev.arr, MININ = -4., MAXIN = 4., INTER = .5, typein = 'yz', FORMAT = '(I2)', style = 'so0so' $
+          , small = [1, 2, 2], COAST_THICK = 2, TITLE = title, boxzoom = 5500, ZOOM = 1000, /NOERASE, _extra = ex
+  endelse
+;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+;
+  if KEYWORD_SET(SUBBASIN) then tmask = tmasksv  
+  gphit = gphi_save
+;
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_AMOC.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_AMOC.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_AMOC.pro	(revision 8732)
@@ -0,0 +1,143 @@
+PRO std_ts_read_AMOC, var_name, dt1, dt2, prefix, suffix, t45, t70, t50
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+  list = rseries_ncdf(var_name, dt1, dt2, prefix, suffix, /fileslist)
+  nfiles = n_elements(list)
+
+  t45 = 0.
+  t70 = 0.
+  t50 = 0.
+  ts_Time = 0.
+
+  trans = strlowcase(var_name) EQ 'vocetr_eff' OR strlowcase(var_name) EQ 'vomeeftr'
+  ;trans = strlowcase(var_name) EQ 'vomeeftr'
+
+  ; ADD definition of mask_atl_nomed to compute AMOC (with no Mediterranean Sea)
+  msk_atl_nomed = read_ncdf( 'atlmsk_nomed', filename = std_file_msksub, /nostruct, _extra = ex )
+  FOR i = 0, nfiles-1 DO BEGIN
+    var = read_ncdf(var_name, allrecords = allrec, filename = list[i], /nostruct)
+    ts_Time = [ ts_Time, Time]
+;
+    FOR t = 0, jpt-1 DO BEGIN
+      msfatl = msf(var[*, *, *, t], msk_atl_nomed, TRANSPORT = trans, /nostruct, indexboxzoom = ind)
+      msftot = msf(var[*, *, *, t], TRANSPORT = trans, /nostruct, indexboxzoom = ind)
+      yaxis = gphit[ind[0], ind[2]:ind[3]]
+
+; computation of max Atlatic Meridional Overturninc Circulation at 40°N and 50°N
+      indy = where(yaxis gt 40 and yaxis le 50)
+      domdef, 0, 3500
+      ;SF commented because we've to compute msftot starting from msf atlantic; i.e. without mediterranean sea.
+      ;SF t45 = [t45, max(msftot[indy, firstzw:lastzw], /NaN)]
+      t45 = [t45, max(msfatl[indy, firstzw:lastzw], /NaN)]
+      
+; computation of max atlantic Antarctic Bottom Water between 80°S and 65°S
+      indy = where(yaxis gt -80 and yaxis le -65)
+      domdef, 300, 3500
+      t70 = [t70, min(msftot[indy, firstzw:lastzw], /NaN)]
+
+;  computation of max Antarctic Abyssal Bottom Cell between 65°S and 30°N , 
+      indy = where(yaxis gt -65 and yaxis le 30)
+      domdef, 2500, 5000
+      t50 = [t50, min(msftot[indy, firstzw:lastzw], /NaN)]
+      
+      domdef, 0, jpk-1, /zindex
+    ENDFOR
+
+  ENDFOR
+
+  time = ts_Time[1:*]           ; remove first record of 0
+  jpt = n_elements(time)
+  
+  t45 = t45[1:*]                ; remove first record of 0 
+  t70 = t70[1:*]                ; remove first record of 0 
+  t50 = t50[1:*]                ; remove first record of 0 
+
+  return
+end
+
+pro std_ts_AMOC, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vV1 = getenv('VAR1_V')   &   prefix = getenv('V1V_PREF')    &   suffix = getenv('V1V_SUFF')
+; get exp2 info
+  vV2 = getenv('VAR2_V')   &   prefix2 = getenv('V2V_PREF')   &   suffix2 = getenv('V2V_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_AMOC_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'_1.ps', portrait = 1
+;
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+  d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+;
+  iodir = std_iodir_data
+
+; compute the MSF
+;  
+  std_ts_read_AMOC, vV1, date1, date2, prefix, suffix, t45, t70, t50
+  if prefix NE prefix2 then begin
+    tsave = time
+    std_ts_read_AMOC, vV2, date1_2, date2_2, prefix2, suffix2, t45_2, t70_2, t50_2
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+  ENDIF
+
+; plots...  
+
+  title = prefix+' '+d1_d2+'!C'+'Max Atlantic MOC between 40N and 50N'
+  pltt, t45, 't', MIN = 0., MAX = 30., date1, date2, /REMPLI, /PORTRAIT, XGRIDSTYLE = 1 $
+        ,  small = [1, 2, 1],  TITLE = title, YTITLE = varunit, _extra = ex
+  IF prefix NE prefix2 then begin
+    title = prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'Max Atlantic MOC between 40N and 50N'
+    pltt, t45, 't', MIN = 0., MAX = 30., date1, date2, /REMPLI , /NOERASE, XGRIDSTYLE = 1 $
+          ,  small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; BLACK
+    pltt, t45_2, 't', date1, date2, /REMPLI, /NOERASE $
+          ,  /ov1d, COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; RED
+  endif
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_1.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+  title = prefix+' '+d1_d2+'!C'+'Max AntArctic Bottom Water between 80S and 65S '+d1_d2
+  pltt, -t70, 't', MIN = 0., MAX = 20., date1, date2, /REMPLI, /PORTRAIT, XGRIDSTYLE = 1, window = 2  $
+        , small = [1, 2, 1],  TITLE = title, YTITLE = varunit, _extra = ex
+  if prefix NE prefix2 then begin 
+    title = prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'Max AntArctic Bottom Water between 80S and 65S'
+    pltt, -t70, 't', MIN = 0.,MAX =  20., date1, date2, /REMPLI, /NOERASE, XGRIDSTYLE = 1 $
+          ,  small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; BLACK
+    pltt, -t70_2, 't', date1, date2, /REMPLI, /NOERASE $
+          , /ov1d, COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; RED
+  endif
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  if KEYWORD_SET(postscript) then openps, filename+'_3.ps', portrait = 1
+
+  title = prefix+' '+d1_d2+'!C '+'Max AntArctic Bottom Cell between 65S and 30N '+d1_d2
+  pltt, -t50, 't', MIN = 5., MAX = 30., date1, date2, /REMPLI, /PORTRAIT, XGRIDSTYLE = 1, window = 3  $
+        ,  small = [1, 2, 1],  TITLE = title, YTITLE = varunit, _extra = ex
+  if prefix NE prefix2 then begin
+    title = prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'Max AntArctic Bottom Cell between 65S and 30N'
+    pltt, -t50 , 't', MIN = 5., MAX = 30., date1, date2, /REMPLI, /NOERASE, XGRIDSTYLE = 1 $
+          ,  small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; BLACK
+    pltt, -t50_2, 't', date1, date2, /REMPLI, /NOERASE  $
+          , /ov1d, COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; RED
+  endif
+  
+  domdef, 0, jpk-1, /zindex
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_3.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+    
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_Drake.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_Drake.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_Drake.pro	(revision 8732)
@@ -0,0 +1,75 @@
+pro std_ts_Drake, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vU1 = getenv('VAR1_U')   &   prefix = getenv('V1U_PREF')    &   suffix = getenv('V1U_SUFF')
+; get exp2 info
+  vU2 = getenv('VAR2_U')   &   prefix2 = getenv('V2U_PREF')   &   suffix2 = getenv('V2U_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_Drake_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+ 
+; find a point in south America (around 60E-30S)
+  if max(glamt) gt 300 then testlam = abs(glamt - 300) else testlam = abs(glamt + 60)
+  testlat = abs(gphit + 30)
+  index = where(abs(testlam - min(testlam)) lt 1 and abs(testlat - min(testlat)) lt 1 )
+  xindex = index[0] mod jpi
+  yindex = index[0]/jpi
+; define a domain limited to a thin band going from Antactica to this point in south America
+  domdef, xindex, xindex+1, 0, yindex, 0, jpk-1, /index ; keep 2 points for x to avoid degenerated dimension...
+;
+  u1 = rseries_ncdf(vU1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, /nostruct)
+  drk1 = fltarr(jpt)
+  ; old formulation: we tested variable name
+  trans = strlowcase(getenv('VAR1_U')) EQ 'uocetr_eff' OR strlowcase(getenv('VAR1_U')) EQ 'vozoeftr'
+  ;SF trans = strlowcase(getenv('VAR1_U')) EQ 'vozoeftr'
+  FOR t = 0, jpt-1 DO BEGIN
+    tmp = bsf(u1[*, *, *, t], TRANSPORT = trans, /nostruct)
+    drk1[t] = tmp[0, nyt-1]-tmp[0, 0]
+  ENDFOR
+;
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, drk1, 't', 0., 200., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 1],  TITLE = title, YTITLE = varunit, /PORTRAIT, _extra = ex
+  
+  if prefix NE prefix2 then begin
+;
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    u2 = rseries_ncdf(vU2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, /nostruct)
+    drk2 = fltarr(jpt)
+    ; old formulation: we tested variable name
+    trans = strlowcase(getenv('VAR2_U')) EQ 'uocetr_eff' OR strlowcase(getenv('VAR2_U')) EQ 'vozoeftr'
+    ;SF trans = strlowcase(getenv('VAR1_U')) EQ 'vozoeftr'
+    FOR t = 0, jpt-1 DO BEGIN
+      tmp = bsf(u2[*, *, *, t], TRANSPORT = trans, /nostruct)
+      drk2[t] = tmp[0, nyt-1]-tmp[0, 0]
+    ENDFOR
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    title = prefix+' (BLACK) - '+prefix2+' (RED)  '+d1_d2_2+'!C'+blabla
+    pltt, drk1 , 't', 0., 200., date1, date2, /REMPLI, /NOERASE, XGRIDSTYLE = 1 $
+          , COLOR = 000, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; BLACK
+    pltt, drk2, 't', 0., 200., date1, date2, /REMPLI, /NOERASE $
+          , /ov1d, COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex ; RED
+    
+  endif
+
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_EMP.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_EMP.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_EMP.pro	(revision 8732)
@@ -0,0 +1,51 @@
+pro std_ts_EMP, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vemp = getenv('VAR1_EMP')    &   prefix = getenv('V1EMP_PREF')    &   suffix = getenv('V1EMP_SUFF')
+; get exp2 info
+  vemp2 = getenv('VAR2_EMP')   &   prefix2 = getenv('V2EMP_PREF')   &   suffix2 = getenv('V2EMP_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_EMP_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+;
+  surf_oce = e1t * e2t * tmask[*,*,0] * masknp
+  surf_oce = total(surf_oce)
+;
+  ts_EMP = rseries_ncdf(vemp, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, direc = 'xy', mask2d = masknp)
+  ts_EMP.arr = ts_EMP.arr * ( 1.E-09 * surf_oce )   &   ts_EMP.unit = 'Sv'
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, ts_EMP, 't', MIN = -2.,MAX = 2., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 1], YTITLE = 'Sv', TITLE = title, /PORTRAIT, _extra = ex
+  
+  IF prefix NE prefix2 THEN BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    ts_EMP2 = rseries_ncdf(vemp2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, direc = 'xy', mask2d = masknp)
+    ts_EMP2.arr = ts_EMP2.arr * ( 1.E-09 * surf_oce )   &   ts_EMP2.unit = 'Sv'
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    title = prefix+' (BLACK) - ' +prefix2+' (RED) '+d1_d2_2+'!C'+blabla
+    pltt, ts_EMP.arr - ts_EMP2.arr, 't', MIN = -2., MAX = 2., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+          , color = 250, small = [1, 2, 2], YTITLE = 'Sv', TITLE = title, /noerase, _extra = ex
+
+  ENDIF 
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE.pro	(revision 8732)
@@ -0,0 +1,204 @@
+function read_arr2d, filename, varname, t1, t2
+;; function that read input file and return 2d array with monthly timecounter 
+nyear = (t2-t1+1)/12
+arr2d = ncdf_lec(filename, VAR=varname)
+arr2d = arr2d[t1:t2]
+arr2d = reform(arr2d,12,nyear) ; put in 2D array
+arr2d = total(arr2d,2)/nyear ; total over 2th dimension (i.e.years)
+
+return, arr2d
+end 
+
+;; here start procedure that use function read_arr2d  
+pro std_ts_ICE, masknp, s_iodir_data,  POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vICE1 = getenv('VAR1_ICE')   &   prefix = getenv('V1ICE_PREF')    &   suffix = getenv('V1ICE_SUFF')
+; get exp2 info
+  vICE2 = getenv('VAR2_ICE')   &   prefix2 = getenv('V2ICE_PREF')   &   suffix2 = getenv('V2ICE_SUFF')
+; get ice climatology info
+  std_file_ice =  isafile(getenv('FILE_ICE'), title = 'ICE Extent Climatology', iodir = std_iodir_climato)
+;
+  time_ice = ncdf_lec( std_file_ice, VAR='time' )
+  time_ice = (time_ice - FLOOR(time_ice) ) * 12
+  time_ice = (round(time_ice) + 11) mod 12; round to nearest integer
+  t1 = where(time_ice eq 0)
+  t1 = t1[0] ;  january
+  t2 = where(time_ice eq 11, count)
+  t2 = t2[count-1] ; last day of december
+
+  vICE_ext_NH = read_arr2d(std_file_ice, getenv('VAR_ICE_EXT_NH'), t1, t2 )
+  vICE_ext_SH = read_arr2d(std_file_ice, getenv('VAR_ICE_EXT_SH'), t1, t2 )
+;
+  vICE_area_NH = read_arr2d(std_file_ice, getenv('VAR_ICE_area_NH'), t1, t2 )
+  vICE_area_SH = read_arr2d(std_file_ice, getenv('VAR_ICE_area_SH'), t1, t2 )
+;  
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_ICE_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+  ; ICE Area in NORTH Hemisphere
+  domdef, 0, jpi-1, 30, 90, /xindex
+  ICE_N = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  ICE_N = grossemoyenne(ICE_N.arr, 'xy', /integration, mask2d = masknp)
+
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_N = reform(ice_n, 12,nyr)
+  ICE_n = total(ice_n,2)/nyr
+  ICE_N = {arr:ICE_N * 1.e-12, unit : '10^12 m^2'}
+
+  ; ICE EXTENT (Area minus 15%) in NORTH Hemisphere
+  ICE_N_15 = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  msk = ICE_N_15.arr gt 0.15 ; remove 0.15% for observations
+  ICE_N_15 = grossemoyenne( msk, 'xy', /integration, mask2d = masknp)
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_N_15 = reform(ice_n_15, 12,nyr)
+  ICE_n_15 = total(ice_n_15,2)/nyr
+  ICE_N_15 = {arr:ICE_N_15 * 1.e-12, unit : '10^12 m^2'}
+  ;
+  ;ICE Area in SOUTH Hemisphere
+  domdef, 0, jpi-1, -90, -30, /xindex 
+  ICE_S = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  ICE_S = grossemoyenne(ICE_S.arr, 'xy', /integration, mask2d = masknp)
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_S = reform(ice_S, 12,nyr)
+  ICE_S = total(ice_S,2)/nyr
+  ICE_S = {arr:ICE_S * 1.e-12, unit : '10^12 m^2'}
+  ; ICE EXTENT (Area minus 15%) in SOUTH Hemisphere
+  ICE_S_15 = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  msk = ICE_S_15.arr gt 0.15 ; remove 0.15% for observations
+  ICE_S_15 = grossemoyenne(msk, 'xy', /integration, mask2d = masknp)
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_S_15 = reform(ice_S_15, 12,nyr)
+  ICE_S_15 = total(ice_S_15,2)/nyr
+  ICE_S_15 = {arr:ICE_S_15 * 1.e-12, unit : '10^12 m^2'}
+  ;
+  ;;title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)'
+  title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (DASHED) '+'!C'+ 'and Extend minus 15% (CONTINUOUS)'
+  jpt=12
+  time=julday(1,15,1900)+30*lindgen(12)
+  pltt, ICE_N, 't', MIN = 4., MAX = 16., /REMPLI, /PORTRAIT, LINESTYLE=2, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $
+       , COLOR = 000 , small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, ICE_N_15, 't', /REMPLI, /PORTRAIT $       ;;; dashed lines is LINESTYLE=2  $
+        , /ov1d, COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
+  pltt, vICE_area_NH, 't',  /REMPLI, /PORTRAIT, LINESTYLE=2  $ 
+        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, vICE_ext_NH, 't', /REMPLI, /PORTRAIT $   ;;; dashed lines is LINESTYLE=2  $
+        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+;
+  title = 'Southern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (DASHED) '+'!C'+ 'and Extend minus 15% (CONTINUOUS)'
+  pltt, ICE_S, 't', MIN = 0., MAX = 20., /REMPLI, LINESTYLE=2, /NOERASE , XGRIDSTYLE = 1 , DATE_FORMAT = '%M' $
+        ,COLOR = 000, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, ICE_S_15, 't', /REMPLI, /PORTRAIT $ 
+        , /ov1d, COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
+  pltt,  vICE_area_SH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2  $ 
+         , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt,  vICE_ext_SH, 't', /REMPLI, /PORTRAIT $ 
+        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  if prefix NE prefix2 then BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    domdef, 0, jpi-1, 30, 90, /xindex
+    ;ICE Extent in NORTH Hemisphere
+    ICE_N2 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    ICE_N2 = grossemoyenne(ICE_N2.arr, 'xy', /integration, mask2d = masknp)
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_N2 = reform(ICE_N2, 12,nyr)
+    ICE_N2 = total(ICE_N2,2)/nyr
+    ICE_N2 = {arr:ICE_N2 * 1.e-12, unit : '10^12 m^2'}
+    ;ICE Extent minus 15% in NORTH Hemisphere
+    ICE_N2_15 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    msk = ICE_N2_15.arr gt 0.15  ; remove 0.15% for observations
+    ICE_N2_15 = grossemoyenne( msk, 'xy', /integration, mask2d = masknp)
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_N2_15 = reform(ICE_N2_15, 12,nyr)
+    ICE_N2_15 = total(ICE_N2_15,2)/nyr
+    ICE_N2_15 = {arr:ICE_N2_15 * 1.e-12, unit : '10^12 m^2'}
+    ;ICE Extent in SOUTH Hemisphere
+    domdef, 0, jpi-1, -90, -30, /xindex 
+    ICE_S2 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    ICE_S2 = grossemoyenne(ICE_S2.arr, 'xy', /integration, mask2d = masknp)
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_S2 = reform(ICE_S2, 12,nyr)
+    ICE_S2 = total(ICE_S2,2)/nyr
+    ICE_S2 = {arr:ICE_S2 * 1.e-12, unit : '10^12 m^2'}
+    ;ICE Extent minus 15% in SOUTH Hemisphere
+    ICE_S2_15 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    msk = ICE_S2_15.arr gt 0.15  ; remove 0.15% for observations
+    ICE_S2_15 = grossemoyenne(msk, 'xy', /integration, mask2d = masknp)
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_S2_15 = reform(ICE_S2_15, 12,nyr)
+    ICE_S2_15 = total(ICE_S2_15,2)/nyr
+    ICE_S2_15 = {arr:ICE_S2_15 * 1.e-12, unit : '10^12 m^2'}
+  ;
+ ;   time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+
+  ;;title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)'
+  title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (DASHED) '+'!C'+ 'and Extend minus 15% (CONTINUOUS)'
+  jpt=12
+  time=julday(1,15,1900)+30*lindgen(12)
+  pltt, ICE_N, 't', MIN = 4, MAX = 16,  /REMPLI, /PORTRAIT, LINESTYLE=2, XGRIDSTYLE = 1, window = 2, DATE_FORMAT = '%M' $
+        , COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex ; BLACK
+  pltt, ICE_N2, 't', /REMPLI, /PORTRAIT , LINESTYLE=2 $
+        , /ov1d, COLOR = 250, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  ; RED
+  pltt, ICE_N_15, 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $
+        , /ov1d, COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
+  pltt, ICE_N2_15, 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $
+        , /ov1d, COLOR = 250, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, vICE_area_NH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2  $ 
+        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  ; light blue
+  pltt, vICE_ext_NH, 't', /REMPLI, /PORTRAIT $ 
+        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  ; blu scuro
+;
+  title ='Southern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+'Global Annual Mean Ice Area (DASHED)'+'!C'+ 'and Extend minus 15% (CONTINUOUS)'
+;  title ='Southern Hemisphere'+'!C'
+  pltt, ICE_S, 't', MIN = 0., MAX = 20., /REMPLI, LINESTYLE=2, /NOERASE, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $
+         , COLOR = 000, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, ICE_S2, 't', /REMPLI, /NOERASE, LINESTYLE=2 $
+        , /ov1d, COLOR = 250, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, ICE_S_15 , 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $
+        , /ov1d, COLOR = 000, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt, ICE_S2_15, 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $
+        , /ov1d, COLOR = 250, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt,  vICE_area_SH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $ 
+          , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  pltt,  vICE_ext_SH, 't', /REMPLI, /PORTRAIT $ 
+        , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+;
+
+    htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+    if KEYWORD_SET(postscript) then closeps
+
+  endif
+
+  domdef
+  
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_FRAM.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_FRAM.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_FRAM.pro	(revision 8732)
@@ -0,0 +1,211 @@
+function read_arr2d, filename, varname, t1, t2
+;; function that read input file and return 2d array with monthly timecounter 
+nyear = (t2-t1+1)/12
+arr2d = ncdf_lec(filename, VAR=varname)
+arr2d = arr2d[t1:t2]
+arr2d = reform(arr2d,12,nyear) ; put in 2D array
+;arr2d = total(arr2d,2)/nyear ; total over 2th dimension (i.e.years)
+arr2d = arr2d[*, nyear-1] ;  select last year
+
+return, arr2d
+end 
+
+;; here start procedure that use function read_arr2d
+pro std_ts_ICE_FRAM, masknp, s_iodir_data,  POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vICE1     = getenv('VAR1_ICE')     &   prefix = getenv('V1ICE_PREF')  &   suffix = getenv('V1ICE_SUFF')
+  v1_Ithick = getenv('VAR1_Ithick')  &   prefix = getenv('V1It_PREF')   &   suffix = getenv('V1It_SUFF')
+  v1_IV     = getenv('VAR1_IvelV')   &   prefix = getenv('V1IvV_PREF')  &   suffix = getenv('V1IvV_SUFF')
+; get exp2 info
+  vICE2     = getenv('VAR2_ICE')     &   prefix2 = getenv('V2ICE_PREF')   &   suffix2 = getenv('V2ICE_SUFF')
+  v2_Ithick = getenv('VAR2_Ithick')  &   prefix2 = getenv('V2It_PREF')    &   suffix2 = getenv('V2It_SUFF')
+  v2_IV     = getenv('VAR2_IvelV')   &   prefix2 = getenv('V2IvV_PREF')   &   suffix2 = getenv('V2IvV_SUFF')
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_ICE_FRAM_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+  d2 = '('+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+  ; ICE Area(=Surface) in FRAM Strait
+  ;; FRAM Strait points, computed with ncview meshmask for ORCA2 grid (133-1434-135-136, 137)
+  indx0 = 133 
+  indx0_last = 136
+  indy0 = 137
+  indy0_last = 137
+  ;; ORI domdef, 133, 137, 136, 136, /xindex, /yindex,/memeindices
+  indx1= (indx0 - ixminmesh + key_shift)mod(jpi)
+  indx2= (indx0_last - ixminmesh + key_shift)mod(jpi)
+  indy1= indy0 - iyminmesh
+  indy2= indy1 
+ ;
+ ;OBSERVATIONS : mean seasonal cycle/month
+ ; vol_obs = [0.261625, 0.230750, 0.325375, 0.252000, 0.172500, 0.0805000, 0.0805000, 0.0805000, 0.0805000, 0.176500, 0.148500, 0.235000]
+  vol_obs = [261.625, 230.750, 325.375, 252.000, 172.500, 80.5000, 80.5000, 80.5000, 80.5000, 176.500, 148.500, 235.000]
+  area_obs = [0.103292, 0.0997500, 0.107625, 0.0944167, 0.0612083, 0.0262500, 0.0262500, 0.0262500, 0.0262500, 0.0843750, 0.0914583, 0.104083]
+ ;
+  domdef, indx1, indx2, indy1, indy2, /xindex, /yindex,/memeindices
+  ICE = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, /nostruct)
+  ICE_thick = rseries_ncdf(v1_Ithick, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, /nostruct)
+ ; domdef for V-Point in j-1
+ ; REALLY NOT NECESSARY, BECAUSE FLUX CAN BE COMPUTED IN J POINT, is the same
+  domdef, indx1, indx2, indy1-1, indy2-1, /xindex, /yindex,/memeindices
+  VN = rseries_ncdf(v1_IV, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec,/nostruct) ;!! warning positive northward
+
+  ;; Area export
+  ICE_area_export = (-1) * ICE * VN * ((e1v[firstxv:lastxv, firstyv:lastyv])[*]#replicate(1., jpt))
+  ICE_area_export = total(reform(ICE_area_export),1) ; in m2/s -> need to change the unit?
+
+  ;; Volume export
+  ICE_vol_export = (-1) * ICE * ICE_thick * VN * ((e1v[firstxv:lastxv, firstyv:lastyv])[*]#replicate(1., jpt))
+  ICE_vol_export = total(reform(ICE_vol_export),1) ;! in m3/s -> need to change the unit?
+
+  ;   needed for seasonal cycle :
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ;; AREA
+  ICE_area_export = reform(ICE_area_export, 12, nyr)
+  ;ICE_area_export = total(ICE_area_export,2)/nyr  ; old version monthly mean average  over all years
+  ICE_area_export = ICE_area_export[*,nyr-1]  ; dim= 12, index 0-11; last year choosen
+  ; ICE_area_export = {arr:ICE_area_export * 1.e-12 * 86400 * 365 , unit : '10^6 Km^2/year'}  ; annual mean
+  ICE_area_export = {arr:ICE_area_export * 1.e-12 * 86400 * 30 , unit : '10^6 Km^2/month'}    ; monthly mean
+  
+  ;
+  ICE_vol_export = reform(ICE_vol_export, 12, nyr)
+  ;ICE_vol_export = total(ICE_vol_export,2)/nyr
+  ICE_vol_export = ICE_vol_export[*,nyr-1]
+  ; ICE_vol_export = {arr:ICE_vol_export * 1.e-9 * 86400 * 365 , unit : '10^3 Km^3/year'}      ; annual mean
+  ICE_vol_export = {arr:ICE_vol_export * 1.e-9 * 86400 * 30 , unit : '10^3 Km^3/month'}      ; monthly mean
+
+  ;
+  ;title = 'Fram Strait Areal Export: LAST YEAR'+'!C'+prefix+' '+d1_d2
+  title = 'Fram Strait Areal Export: LAST YEAR'+'!C'+prefix+' '+d2
+  jpt=12
+  time=julday(1,15,1900)+30*lindgen(12)
+  pltt, ICE_area_export, 't', /REMPLI, /PORTRAIT, MIN = 0., MAX = .5 , XGRIDSTYLE = 1 $
+        , small = [1, 2, 1],YTITLE = '10^6 Km^2/month',  TITLE = title, DATE_FORMAT = '%M', _extra = ex    
+  pltt, area_obs, 't', /REMPLI, /NOERASE, psym = 4, THICK = 4  $    ; light blue
+         , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^6 Km^2/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex
+  ;
+  tot_area_expo = total(ICE_area_export.arr)
+  ;
+  xyouts, julday(5,15,1900), 0.49, 'Tot. Annual Export OBS = 0.851 million Km2', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+  xyouts, julday(5,15,1900), 0.46, 'Tot. Annual Export Model = '+strtrim(tot_area_expo, 1)+' million Km2', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+  xyouts, julday(7,15,1900), 0.41, 'Data from Kwok et al.(2004), 1979-2002 ', ALIGN = 0, CHARTHICK = 2, CHARSIZE=0.8, COLOR=2
+  ;
+  ;title = 'Fram Strait Volume Export LAST YEAR'+'!C'+prefix+' '+d1_d2
+  title = 'Fram Strait Volume Export LAST YEAR'+'!C'+prefix+' '+d2
+  pltt, ICE_vol_export, 't',  /REMPLI, MIN = 60., MAX = 500. , /NOERASE, XGRIDSTYLE = 1 $
+       , small = [1, 2, 2], YTITLE = '10^3 Km^3/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex
+  pltt, vol_obs, 't', /REMPLI, /NOERASE, psym = 4, THICK = 4  $    ; light blue
+         , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^6 Km^2/month',DATE_FORMAT = '%M', TITLE = title, _extra = ex
+  ;
+  tot_vol_expo = total(ICE_vol_export.arr)
+  tot_vol_expo_Sv = tot_vol_expo * 1.e06 * 1/86400 * 1/365 ; annual mean in Sverdrup
+  xyouts, julday(5,15,1900), 490, 'Tot. Annual Export OBS = 2124 10^3 Km3/year', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+  xyouts, julday(5,15,1900), 460, 'Tot. Annual Export Model = '+strtrim(tot_vol_expo, 1)+' 10^3 Km3/year', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+  xyouts, julday(9,15,1900), 440, 'in Sv = '+strtrim(tot_vol_expo_Sv, 1)+' Sv', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+  xyouts, julday(7,15,1900), 360, 'Data from Kwok et al.(2004), 1992-1998 ', ALIGN = 0, CHARTHICK = 2, CHARSIZE=0.8, COLOR=2
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  if prefix NE prefix2 then BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    d2_2 = '('+strtrim(date2_2, 1)+')'
+    tsave = time
+    domdef, indx1, indx2, indy1, indy2, /xindex, /yindex,/memeindices
+    ICE_2= rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, /nostruct)
+    ICE_thick_2 = rseries_ncdf(v2_Ithick, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, /nostruct)
+    ; domdef for V-Point in j-1
+    ; REALLY NOT NECESSARY, BECAUSE FLUX CAN BE COMPUTED IN J POINT, is the same
+    domdef, indx1, indx2, indy1-1, indy2-1, /xindex, /yindex,/memeindices
+    VN_2 = rseries_ncdf(v2_IV, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec,/nostruct) ;!! warning positive northward
+
+    ;; Area export
+    ICE_area_export_2 = (-1) * ICE_2 * VN_2 * ((e1v[firstxv:lastxv, firstyv:lastyv])[*]#replicate(1., jpt))
+    ICE_area_export_2 = total(reform(ICE_area_export_2),1) ; in m2/s -> need to change the unit?
+
+    ;; Volume export
+    ICE_vol_export_2 = (-1) * ICE_2 * ICE_thick_2 * VN_2 * ((e1v[firstxv:lastxv, firstyv:lastyv])[*]#replicate(1., jpt))
+    ICE_vol_export_2 = total(reform(ICE_vol_export_2),1) ;! in m3/s -> need to change the unit?
+
+    ;   needed for seasonal cycle :
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ;; AREA
+    ICE_area_export_2 = reform(ICE_area_export_2, 12, nyr)
+    ;ICE_area_export_2 = total(ICE_area_export_2,2)/nyr
+    ICE_area_export_2 = ICE_area_export_2[*,nyr-1]
+    ; ICE_area_export_2 = {arr:ICE_area_export_2 * 1.e-12 * 86400 * 365 , unit : '10^6 Km^2/year'}   ; annual mean
+    ICE_area_export_2 = {arr:ICE_area_export_2 * 1.e-12 * 86400 * 30 , unit : '10^6 Km^2/month'}     ; monthly mean
+    ;
+    ICE_vol_export_2 = reform(ICE_vol_export_2, 12, nyr)
+    ;ICE_vol_export_2 = total(ICE_vol_export_2,2)/nyr
+    ICE_vol_export_2 = ICE_vol_export_2[*,nyr-1]
+    ; ICE_vol_export_2 = {arr:ICE_vol_export_2 * 1.e-12 * 86400 * 365 , unit : '10^3 Km^3/year'}     ; annual mean
+    ICE_vol_export_2 = {arr:ICE_vol_export_2 * 1.e-9 * 86400 * 30 , unit : '10^3 Km^3/month'}       ; monthly mean
+    ;
+    ;
+    if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+    ;title = 'Fram Strait Areal Export'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2
+    title = 'Fram Strait Areal Export LAST YEAR'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d2_2
+    jpt=12
+    time=julday(1,15,1900)+30*lindgen(12)
+    pltt, ICE_area_export, 't', /REMPLI, /PORTRAIT, MIN = 0., MAX = .5, XGRIDSTYLE = 1, window = 2 $
+        , small = [1, 2, 1], YTITLE = '10^6 Km^2/month',  TITLE = title, DATE_FORMAT = '%M', _extra = ex    
+    pltt, ICE_area_export_2 ,'t', /REMPLI, /PORTRAIT, /NOERASE $
+        , /ov1d, COLOR = 250, small = [1, 2, 1],YTITLE = '10^6 Km^2/month',  TITLE = title, DATE_FORMAT = '%M', _extra = ex
+    pltt, area_obs, 't', /REMPLI, /NOERASE, psym = 4, THICK = 4  $    ; light blue
+         , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^6 Km^2/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex
+    ;
+    tot_area_expo = total(ICE_area_export.arr)
+    tot_area_expo_2 = total(ICE_area_export_2.arr)
+    ;
+    xyouts, julday(5,15,1900), 0.49, 'Tot. Annual Export OBS = 0.851 million Km2', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(5,15,1900), 0.46, 'Tot. Annual Export Model 1= '+strtrim(tot_area_expo, 1)+' million Km2', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(5,15,1900), 0.43, 'Tot. Annual Export Model 2= '+strtrim(tot_area_expo_2, 1)+' million Km2', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(7,15,1900), 0.41, 'Data from Kwok et al.(2004), 1979-2002 ', ALIGN = 0, CHARTHICK = 2, CHARSIZE=0.8, COLOR=2
+    ;
+    ;title = 'Fram Strait Volume Export'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2
+    title = 'Fram Strait Volume Export LAST YEAR'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d2_2
+    pltt, ICE_vol_export, 't', /REMPLI,  MIN = 60., MAX = 500., /NOERASE, XGRIDSTYLE = 1 $
+        , small = [1, 2, 2], YTITLE = '10^3 Km^3/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex
+    pltt, ICE_vol_export_2, 't', /REMPLI, /NOERASE  $
+        , /ov1d, COLOR = 250, small = [1, 2, 2], YTITLE = '10^3 Km^3/month', TITLE = title, DATE_FORMAT = '%M',  _extra = ex
+    pltt, vol_obs, 't', /REMPLI, /NOERASE, psym = 4, THICK = 4  $    ; light blue
+         , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^6 Km^2/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex
+    ;
+    tot_vol_expo = total(ICE_vol_export.arr)
+    tot_vol_expo_2 = total(ICE_vol_export_2.arr)
+    tot_vol_expo_Sv = tot_vol_expo * 1.e06 * 1/86400 * 1/365 ; annual mean in Sverdrup
+    tot_vol_expo_2_Sv = tot_vol_expo_2 * 1.e06 * 1/86400 * 1/365 ; annual mean in Sverdrup
+    xyouts, julday(5,15,1900), 490, 'Tot. Annual Export OBS = 2124 10^3 Km3/year', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(5,15,1900), 460, 'Tot. Annual Export Model 1 = '+strtrim(tot_vol_expo, 1)+' 10^3 Km3/year', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(9,15,1900), 440, 'in Sv = '+strtrim(tot_vol_expo_Sv, 1)+' Sv', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(5,15,1900), 410, 'Tot. Annual Export Model 2 = '+strtrim(tot_vol_expo_2, 1)+' 10^3 Km3/year', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(9,15,1900), 390, 'in Sv = '+strtrim(tot_vol_expo_2_Sv, 1)+' Sv', ALIGN = 0, CHARTHICK = 2, CHARSIZE=1, COLOR=2
+    xyouts, julday(7,15,1900), 360, 'Data from Kwok et al.(2004), 1992-1998 ', ALIGN = 0, CHARTHICK = 2, CHARSIZE=0.8, COLOR=2
+
+    htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+    if KEYWORD_SET(postscript) then closeps
+
+  endif
+
+  domdef
+  
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_Vel.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_Vel.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_Vel.pro	(revision 8732)
@@ -0,0 +1,132 @@
+function read_arr2d, filename, varname, t1, t2
+;; function that read input file and return 2d array with monthly timecounter 
+nyear = (t2-t1+1)/12
+arr2d = ncdf_lec(filename, VAR=varname)
+arr2d = arr2d[t1:t2]
+arr2d = reform(arr2d,12,nyear) ; put in 2D array
+arr2d = total(arr2d,2)/nyear ; total over 2th dimension (i.e.years)
+
+return, arr2d
+end 
+
+;; here start procedure that use function read_arr2d
+pro std_ts_ICE_Vel, masknp, s_iodir_data,  POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+; get exp1 info
+  vICE1 = getenv('VAR1_ICE')   &   prefix = getenv('V1ICE_PREF')    &   suffix = getenv('V1ICE_SUFF')
+; get exp2 info
+  vICE2 = getenv('VAR2_ICE')   &   prefix2 = getenv('V2ICE_PREF')   &   suffix2 = getenv('V2ICE_SUFF')
+; get exp1 info
+  vICE_vel_1 = getenv('VAR1_Ivel')   &   prefix = getenv('V1Iv_PREF')  &   suffix = getenv('V1Iv_SUFF')
+; get exp2 info
+  vICE_vel_2 = getenv('VAR2_Ivel')   &   prefix2 = getenv('V2Iv_PREF')  &  suffix2 = getenv('V2Iv_SUFF')
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_ICE_Vel_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+  ; ICE Velocity in NORTH Hemisphere
+  domdef, 0, jpi-1, 30, 90, /xindex
+  Velo_N = rseries_ncdf(vICE_vel_1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, /nostruct) ;!! warning positive northward
+  ICE_N_15 = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec,  /nostruct) 
+  print, 'N15', max(ICE_N_15)
+  
+  
+  ICE_N_15[where(ICE_N_15 lt 0.15)] = 0.
+  
+  ICE_velo_N = grossemoyenne( (Velo_N < 1.e10) * (ICE_N_15 < 1.e10), 'xy',/integration, mask2d = masknp)
+  ICE_N_15 = grossemoyenne(ICE_N_15, 'xy',/integration, mask2d = masknp)
+  
+  ICE_velo_N = ICE_velo_N / ICE_N_15
+  
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_velo_N = reform(ICE_velo_N, 12, nyr)
+  ICE_velo_N = total(ICE_velo_N,2)/nyr
+  ICE_velo_N = {arr:ICE_velo_N , unit : 'm/s'}  
+   
+ 
+  ;ICE Velocity in SOUTH Hemisphere
+  domdef, 0, jpi-1, -90, -30, /xindex
+  Velo_S = rseries_ncdf(vICE_vel_1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec,/nostruct) ;!! warning positive northward
+
+   
+    
+  title = 'Northern Hemisphere'+'!C'+prefix+' '+d1_d2+'!C'+'Ice Velocity (Black SOLID simulation)'
+  jpt=12
+  time=julday(1,15,1900)+30*lindgen(12)
+
+
+  pltt, ICE_velo_N, 't', /REMPLI, /PORTRAIT, XGRIDSTYLE = 1 $
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, _extra = ex    
+  ;
+  title ='Southern Hemisphere' +'!C'+prefix+' '+d1_d2+' - '+'!C'+'Ice Velocity (Black SOLID simulation)'
+  pltt, Velo_S, 't',  /REMPLI, /NOERASE, XGRIDSTYLE = 1 $
+       , small = [1, 2, 2], YTITLE = varunit, TITLE = title, _extra = ex
+  ;
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  if prefix NE prefix2 then BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    ; ICE Velocity in NORTH Hemisphere
+    domdef, 0, jpi-1, 30, 90, /xindex
+    Velo_N_2 = rseries_ncdf(vICE_vel_2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec,/nostruct)
+    
+    ;;;;;; if grossempoyenne is not present dimension of array is not ok: 54   Array[180, 54, 120] 
+    ;;;;;; with the domain dimensions [jpi/nx, jpj/ny, jpk/nz, jpt] = [180/180, 149/50, 31/31, 12]
+  
+    ICE_velo_N_2 = grossemoyenne(Velo_N_2, 'xy', /integration, mask2d = masknp)
+    print, 'max ice velo', max(ICE_velo_N_2)
+  
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_velo_N_2 = reform(ICE_velo_N_2, 12, nyr)
+    ICE_velo_N_2 = total(ICE_velo_N_2,2)/nyr
+    ICE_velo_N_2 = {arr:ICE_velo_N_2 * 86400 * 365, unit : 'm/year'}  
+    print, 'max ice velo', max(ICE_velo_N_2.arr)
+    
+  
+    ;ICE Velocity in SOUTH Hemisphere
+    domdef, 0, jpi-1, -90, -30, /xindex
+    Velo_S_2 = rseries_ncdf(vICE_vel_2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec,/nostruct)
+      
+    if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+    jpt=12
+    time=julday(1,15,1900)+30*lindgen(12)
+
+    title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 +'!C'+'Ice Velocity (BLACK) '
+    pltt, ICE_velo_N , 't', /REMPLI, XGRIDSTYLE = 1, window = 2  $
+          , small = [1, 2, 1], YTITLE = varunit, TITLE = title, /noerase, _extra = ex
+    pltt, ICE_velo_N_2, 't', /REMPLI $
+          , /ov1d, color = 250, small = [1, 2, 1], YTITLE = varunit, TITLE = title, /noerase, _extra = ex
+ 
+    title = 'Southern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 +'!C'+'Ice Velocity (BLACK) '
+    pltt, Velo_S , 't', /REMPLI, XGRIDSTYLE = 1 $
+          , small = [1, 2, 2], YTITLE = varunit, TITLE = title, /noerase, _extra = ex
+    pltt, Velo_S_2, 't', /REMPLI $
+         , /ov1d, color = 250, small = [1, 2, 2], YTITLE = varunit, TITLE = title, /noerase, _extra = ex
+
+    htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+    if KEYWORD_SET(postscript) then closeps
+
+  endif
+
+  domdef
+  
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_Vol.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_Vol.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_ICE_Vol.pro	(revision 8732)
@@ -0,0 +1,135 @@
+function read_arr2d, filename, varname, t1, t2
+;; function that read input file and return 2d array with monthly timecounter 
+nyear = (t2-t1+1)/12
+arr2d = ncdf_lec(filename, VAR=varname)
+arr2d = arr2d[t1:t2]
+arr2d = reform(arr2d,12,nyear) ; put in 2D array
+arr2d = total(arr2d,2)/nyear ; total over 2th dimension (i.e.years)
+
+return, arr2d
+end 
+
+;
+;
+pro std_ts_ICE_Vol, masknp, s_iodir_data,  POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vICE1     = getenv('VAR1_ICE')     &   prefix = getenv('V1ICE_PREF')  &   suffix = getenv('V1ICE_SUFF')
+  v1_Ithick = getenv('VAR1_Ithick')  &   prefix = getenv('V1It_PREF')   &   suffix = getenv('V1It_SUFF')
+; get exp2 info
+  vICE2     = getenv('VAR2_ICE')     &   prefix2 = getenv('V2ICE_PREF')   &   suffix2 = getenv('V2ICE_SUFF')
+  v2_Ithick = getenv('VAR2_Ithick')  &   prefix2 = getenv('V2It_PREF')    &   suffix2 = getenv('V2It_SUFF')
+
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_ICE_Vol_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+;
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+  ; ICE Area(=Surface) in NORTH Hemisphere
+  domdef, 0, jpi-1, 30, 90, /xindex
+  ICE_N = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  ICE_thick = rseries_ncdf(v1_Ithick, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  ; Volume = Area(=Surface) * Thickness
+  ICE_vol_N = (ICE_N.arr < 1.e10 ) * ( ICE_thick.arr < 1.e10)  ; limited mask value of 1.e20, because 1.e20 * 1.e20 = inf for idl
+  ICE_vol_N = grossemoyenne(ICE_vol_N, 'xy', /integration, mask2d = masknp)
+
+  ;
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_vol_N = reform(ICE_vol_N, 12, nyr)
+  ICE_vol_N = total(ICE_vol_N,2)/nyr
+  ICE_vol_N = {arr:ICE_vol_N * 1.e-9, unit : '10^9 Km^3'}
+  ;
+  ;ICE Area(=Surface) in SOUTH Hemisphere
+  domdef, 0, jpi-1, -90, -30, /xindex 
+  ICE_S = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  ICE_thick = rseries_ncdf(v1_Ithick, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec)
+  ; Volume = Area(=Surface) * Thickness
+  ICE_vol_S = (ICE_S.arr < 1.e10 ) * ( ICE_thick.arr < 1.e10)  ; limited mask value of 1.e20, because 1.e20 * 1.e20 = inf for idl
+  ICE_vol_S = grossemoyenne(ICE_vol_S, 'xy', /integration, mask2d = masknp)
+  if jpt mod 12 ne 0 then stop
+  nyr=jpt/12.
+  ICE_vol_S = reform(ICE_vol_S, 12, nyr)
+  ICE_vol_S = total(ICE_vol_S,2)/nyr
+  ICE_vol_S = {arr:ICE_vol_S * 1.e-9, unit : '10^9 Km^3'}
+  ;
+  title = 'Northern Hemisphere'+'!C'+prefix+' '+d1_d2+'!C'+'Global Annual Mean Ice Volume (BLACK) '
+  jpt=12
+  time=julday(1,15,1900)+30*lindgen(12)
+  pltt, ICE_vol_N, 't', MIN = 0., MAX = 40000., /REMPLI, /PORTRAIT, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $
+        , small = [1, 2, 1], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex
+;
+  title ='Southern Hemisphere' +'!C'+prefix+' '+d1_d2+' - '+'!C'+'Global Annual Mean Ice Volume (BLACK)'
+  pltt, ICE_vol_S, 't', MIN = 0., MAX = 12000., /REMPLI, /NOERASE, XGRIDSTYLE = 1 , DATE_FORMAT = '%M' $
+        , small = [1, 2, 2], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex
+;
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  if prefix NE prefix2 then BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    domdef, 0, jpi-1, 30, 90, /xindex
+    ;ICE Area(=Surface) in NORTH Hemisphere
+    ICE_N2 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    ICE_thick2 = rseries_ncdf(v2_Ithick, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    ; Volume = Area(=Surface) * Thickness
+    ICE_vol_N2 = (ICE_N2.arr < 1.e10 ) * ( ICE_thick2.arr < 1.e10) ; limited mask value of 1.e20, because 1.e20 * 1.e20 = inf for idl
+    ICE_vol_N2 = grossemoyenne(ICE_vol_N2, 'xy', /integration, mask2d = masknp)
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_vol_N2 = reform(ICE_vol_N2, 12, nyr)
+    ICE_vol_N2 = total(ICE_vol_N2,2)/nyr
+    ICE_vol_N2 = {arr:ICE_vol_N2 * 1.e-9, unit : '10^3 Km^3'}
+
+    ;ICE Area(=Surface) in SOUTH Hemisphere
+    domdef, 0, jpi-1, -90, -30, /xindex 
+    ICE_S2 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    ICE_thick2 = rseries_ncdf(v2_Ithick, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec)
+    ; Volume = Area(=Surface) * Thickness
+    ICE_vol_S2 = (ICE_S2.arr < 1.e10 ) * ( ICE_thick.arr < 1.e10) ; limited mask value of 1.e20, because 1.e20 * 1.e20 = inf for idl
+    ICE_vol_S2 = grossemoyenne(ICE_vol_S2, 'xy', /integration, mask2d = masknp)
+    if jpt mod 12 ne 0 then stop
+    nyr=jpt/12.
+    ICE_vol_S2 = reform(ICE_vol_S2, 12, nyr)
+    ICE_vol_S2 = total(ICE_vol_S2,2)/nyr
+    ICE_vol_S2 = {arr:ICE_vol_S2 * 1.e-9, unit : '10^3 Km^3'}
+
+   ; time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+    title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 +'!C'+'Global Annual Mean Ice Volume (BLACK) '
+    jpt=12
+    time=julday(1,15,1900)+30*lindgen(12)
+    pltt, ICE_vol_N, 't', MIN = 0., MAX = 40000., /REMPLI, /PORTRAIT, XGRIDSTYLE = 1, window = 2, DATE_FORMAT = '%M' $
+          , small = [1, 2, 1], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex
+    pltt, ICE_vol_N2 , 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $
+        , /ov1d, COLOR = 250, small = [1, 2, 1], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex
+    ;
+    title = 'Southern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'Global Annual Mean Ice Volume'
+    pltt, ICE_vol_S, 't', MIN = 0., MAX = 12000., /REMPLI, /NOERASE, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $
+          , small = [1, 2, 2], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex   
+    pltt, ICE_vol_S2, 't',  /REMPLI, /NOERASE $
+          , /ov1d, COLOR = 250, small = [1, 2, 2], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex   
+
+    htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+    if KEYWORD_SET(postscript) then closeps
+
+  endif
+
+  domdef
+  
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_Q.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_Q.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_Q.pro	(revision 8732)
@@ -0,0 +1,48 @@
+pro std_ts_Q, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vq = getenv('VAR1_Q')    &   prefix = getenv('V1Q_PREF')    &   suffix = getenv('V1Q_SUFF')
+; get exp2 info
+  vq2 = getenv('VAR2_Q')   &   prefix2 = getenv('V2Q_PREF')   &   suffix2 = getenv('V2Q_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_Q_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+;
+  ts_Q = rseries_ncdf(vq, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, direc = 'xy', mask2d = masknp)
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, ts_Q, 't', MIN = -4, MAX = 4, date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, _extra = ex
+  
+  IF prefix NE prefix2 THEN BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    ts_Q2 = rseries_ncdf(vq2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, direc = 'xy', mask2d = masknp)
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    title = prefix+' (BLACK)  - '+prefix2+' (RED) '+d1_d2_2+'!C'+blabla
+    pltt, ts_Q.arr , 't', MIN = -4., MAX = 4., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+          , small = [1, 2, 2], YTITLE = varunit, TITLE = title, /noerase, _extra = ex
+    pltt, ts_Q2.arr, 't', date1, date2, /REMPLI $
+          , /ov1d, color = 250, small = [1, 2, 2], YTITLE = varunit, TITLE = title, /noerase, _extra = ex
+
+  ENDIF 
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_S.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_S.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_S.pro	(revision 8732)
@@ -0,0 +1,85 @@
+pro std_ts_S, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vsal = getenv('VAR1_S')      &   prefix = getenv('V1S_PREF')         &   suffix = getenv('V1S_SUFF')
+  vssh = getenv('VAR1_SSH')    &   sshprefix = getenv('V1SSH_PREF')    &   sshsuffix = getenv('V1SSH_SUFF')
+; get exp2 info
+  vsal2 = getenv('VAR2_S')     &   prefix2 = getenv('V2S_PREF')        &   suffix2 = getenv('V2S_SUFF')
+  vssh2 = getenv('VAR2_SSH')   &   sshprefix2 = getenv('V2SSH_PREF')   &   sshsuffix2 = getenv('V2SSH_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_S_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'_1.ps', portrait = 1
+
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+
+; read levitus data
+  std_file_Levitus_S =  isafile(getenv('FILE_SAL_3D'), title = 'Levitus_S', iodir = std_iodir_climato)
+  Lev = read_ncdf(getenv('VAR_SAL_3D'), filename = std_file_Levitus_S, /nostruct ) 
+  Lev_xyz = moyenne(Lev, 'xyz', mask2d = masknp)
+  levz = moyenne(temporary(Lev), 'xy', mask2d = masknp, /KEEPBOTTOM)
+;
+  iodir = std_iodir_data
+;
+
+; read exp1 data
+  std_ts_read, vsal, date1, date2, prefix, suffix, ts_Sal, ts_z, masknp $
+               , WITHSSH = vssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz
+
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, ts_Sal, 't', MIN = 34.54, MAX = 34.76, date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, _extra = ex
+
+  title = prefix+' '+d1_d2+' - Levitus!C'+blabla
+  pltt, ts_Sal - Lev_xyz, 't', MIN = -.05, MAX = .05, date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 2], YTITLE = varunit, TITLE = title, /NOERASE, _extra = ex
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_1.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+  title = prefix+' '+d1_d2+' - Levitus!C ZT-plot (0-1500m) '+blabla
+  pltt, ts_z, 'zt', MIN = -.5, MAX = .5, INTER = .05, date1, date2, /REMPLI, style = 'so0so', XGRIDSTYLE = 1 $ 
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, boxzoom = 1500., /portrait, window = 1, _extra = ex
+  
+  title = prefix+' '+d1_d2+' - Levitus!C ZT-plot (0-6000m) '+blabla
+  pltt, ts_z, 'zt', MIN = -.5, MAX = .5, INTER = .05, date1, date2, /REMPLI, style = 'so0so', XGRIDSTYLE = 1 $ 
+        , small = [1, 2, 2], YTITLE = varunit, TITLE = title, boxzoom = 6000., /NOERASE, _extra = ex
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  IF prefix NE prefix2 THEN BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+; read exp2 data
+    tsave = time
+    std_ts_read, vsal2, date1_2, date2_2, prefix2, suffix2, ts_Sal2, ts_z2, masknp $
+                 , WITHSSH = vssh2, SSHPREFIX = sshprefix2, SSHSUFFIX = sshsuffix2, LEVZ = levz
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    if KEYWORD_SET(postscript) then openps, filename+'_3.ps', portrait = 1
+
+    title = prefix+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_Sal - ts_Sal2, 't', MIN = -0.1, MAX = 0.1, date1, date2, /REMPLI , XGRIDSTYLE = 1 $
+          , COLOR = 250, small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, window = 2, _extra = ex
+
+    title = prefix+' - '+prefix2+' '+d1_d2_2+'!C ZT-plot (0-6000m) '+blabla
+    pltt, ts_z - ts_z2, 'zt', MIN = -0.1, MAX = 0.1, INTER = .01, date1, date2, /REMPLI, style = 'so0so', XGRIDSTYLE = 1 $ 
+          , small = [1, 2, 2], YTITLE = varunit, TITLE = title, boxzoom = 6000., /NOERASE, _extra = ex
+
+    htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_3.png  />  ' ]
+    if KEYWORD_SET(postscript) then closeps
+
+  ENDIF
+
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_SSH.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_SSH.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_SSH.pro	(revision 8732)
@@ -0,0 +1,48 @@
+pro std_ts_SSH, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vssh = getenv('VAR1_SSH')    &   prefix = getenv('V1SSH_PREF')    &   suffix = getenv('V1SSH_SUFF')
+; get exp2 info
+  vssh2 = getenv('VAR2_SSH')   &   prefix2 = getenv('V2SSH_PREF')   &   suffix2 = getenv('V2SSH_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_SSH_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'.ps', portrait = 1
+
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+;
+  iodir = std_iodir_data
+;
+  ts_SSH = rseries_ncdf(vssh, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, direc = 'xy', mask2d = masknp)
+  ts_SSH.arr = ts_SSH.arr   &   ts_SSH.unit = 'm'
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, ts_SSH, 't', MIN = -12., MAX = 12., date1, date2, /REMPLI , XGRIDSTYLE = 1 $
+        , small = [1, 2, 1], YTITLE = 'm', TITLE = title, /PORTRAIT, _extra = ex
+  
+  IF prefix NE prefix2 THEN BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+    tsave = time
+    ts_SSH2 = rseries_ncdf(vssh2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, direc = 'xy', mask2d = masknp)
+    ts_SSH2.arr = ts_SSH2.arr   &   ts_SSH2.unit = 'm'
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    title = prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+blabla
+    pltt, ts_SSH.arr - ts_SSH2.arr, 't', MIN = -10., MAX = 10., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+          , color = 250, small = [1, 2, 2], YTITLE = 'm', TITLE = title, /noerase, _extra = ex
+
+  ENDIF 
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  
+  return
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_T.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_T.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_T.pro	(revision 8732)
@@ -0,0 +1,84 @@
+pro std_ts_T, masknp, s_iodir_data, POSTSCRIPT = postscript, _extra = ex
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+; get exp1 info
+  vtemp = getenv('VAR1_T')     &   prefix = getenv('V1T_PREF')         &   suffix = getenv('V1T_SUFF')
+  vssh = getenv('VAR1_SSH')    &   sshprefix = getenv('V1SSH_PREF')    &   sshsuffix = getenv('V1SSH_SUFF')
+; get exp2 info
+  vtemp2 = getenv('VAR2_T')    &   prefix2 = getenv('V2T_PREF')        &   suffix2 = getenv('V2T_SUFF')
+  vssh2 = getenv('VAR2_SSH')   &   sshprefix2 = getenv('V2SSH_PREF')   &   sshsuffix2 = getenv('V2SSH_SUFF')
+;
+  cdti3 = string(cnt, format = '(i3.3)')
+  print, cdti3 + ') ' + blabla
+  filename = cdti3 + '_ts_T_'+prefix
+  if prefix NE prefix2 then filename = filename + '_'+prefix2
+  if KEYWORD_SET(postscript) then openps, filename+'_1.ps', portrait = 1
+
+  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')'
+
+; read levitus data
+  std_file_Levitus_T = isafile(getenv('FILE_TEMP_3D'), title = 'Levitus_T', iodir = std_iodir_climato)
+  Lev = read_ncdf(getenv('VAR_TEMP_3D'), filename = std_file_Levitus_T, /nostruct ) 
+  Lev_xyz = moyenne(Lev, 'xyz', mask2d = masknp)
+  levz = moyenne(temporary(Lev), 'xy', mask2d = masknp, /KEEPBOTTOM)
+;
+  iodir = std_iodir_data
+;
+
+; read exp1 data
+  std_ts_read, vtemp, date1, date2, prefix, suffix, ts_Temp, ts_z, masknp $
+               , WITHSSH = vssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz
+
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, ts_Temp, 't', MIN = 1., MAX = 4.5, date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, _extra = ex
+
+  title = prefix+' '+d1_d2+' - Levitus!C'+blabla
+  pltt, ts_Temp - Lev_xyz, 't', MIN = -1., MAX = 1., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+        , small = [1, 2, 2], YTITLE = varunit, TITLE = title, /NOERASE, _extra = ex
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_1.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+  if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1
+
+  title = prefix+' '+d1_d2+' - Levitus!C ZT-plot (0-1500m) '+blabla
+  pltt, ts_z, 'zt', MIN = -2.,MAX = 2., inter = .1, date1, date2, /REMPLI, style = 'so0so', XGRIDSTYLE = 1 $ 
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, boxzoom = 1500., /portrait, window = 1, _extra = ex
+  
+  title = prefix+' '+d1_d2+' - Levitus!C ZT-plot (0-6000m) '+blabla
+  pltt, ts_z, 'zt', MIN = -2., MAX = 2., inter = .1, date1, date2, /REMPLI, style = 'so0so', XGRIDSTYLE = 1 $ 
+        , small = [1, 2, 2], YTITLE = varunit, TITLE = title, boxzoom = 6000., /NOERASE, _extra = ex
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_2.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  IF prefix NE prefix2 THEN BEGIN
+
+    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')'
+; read exp2 data
+    tsave = time
+    std_ts_read, vtemp2, date1_2, date2_2, prefix2, suffix2, ts_Temp2, ts_z2, masknp $
+                 , WITHSSH = vssh2, SSHPREFIX = sshprefix2, SSHSUFFIX = sshsuffix2, LEVZ = levz
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    if KEYWORD_SET(postscript) then openps, filename+'_3.ps', portrait = 1
+
+    title = prefix+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_Temp - ts_Temp2, 't', MIN = -1., MAX = 1., date1, date2, /REMPLI, XGRIDSTYLE = 1 $
+          , COLOR = 250, small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, window = 2, _extra = ex
+
+    title = prefix+' - '+prefix2+' '+d1_d2_2+'!C ZT-plot (0-6000m) '+blabla
+    pltt, ts_z - ts_z2, 'zt', MIN = -1., MAX = 1., inter = .1, date1, date2, /REMPLI, style = 'so0so', XGRIDSTYLE = 1 $ 
+          , small = [1, 2, 2], YTITLE = varunit, TITLE = title, boxzoom = 6000., /NOERASE, _extra = ex
+
+    htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_3.png  />  ' ]
+    if KEYWORD_SET(postscript) then closeps
+    
+  ENDIF
+
+  return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_all.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_all.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_all.pro	(revision 8732)
@@ -0,0 +1,89 @@
+pro std_ts_all, doplot = doplot, _extra=ex
+
+  compile_opt idl2, strictarrsubs
+
+@common
+@std_common
+
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+  PRINT, '                   plot of all TIME SERIES'
+  PRINT, ''
+  PRINT, ' 	############################################'
+  PRINT, ''
+;
+  std_iodir_data    = isadirectory(getenv('DIR_DATA'), title = 'path of data in NetCdf format')
+  std_iodir_climato = isadirectory(getenv('DIR_CLIMATO'), title = 'path of climatological data')
+  std_iodir_mask    = isadirectory(getenv('DIR_MASK'), title = 'path of mask files (ex: subbasins)')
+; meshmask
+  std_file_mesh = isafile(getenv('FILE_MESH_MASK'), title = 'mesh_mask', iodir = std_iodir_mask)
+  std_file_msksub = isafile(getenv('FILE_MASK_SUBDOMAIN'), title = 'sub-bassin masks', iodir = std_iodir_mask)
+; load the grid
+  load_orca, std_file_mesh  
+; reading variables
+  masknp = read_ncdf('tmaskutil', file = std_file_mesh, /nostruct, /cont_nofill)
+; climatologies
+  std_file_Levitus_T =  isafile(getenv('FILE_TEMP_3D'),  title = 'Levitus_T', iodir = std_iodir_climato)
+  std_file_Levitus_S =  isafile(getenv('FILE_SAL_3D'),   title = 'Levitus_S', iodir = std_iodir_climato)
+  std_file_reynolds  =  isafile(getenv('FILE_SST'),      title = 'Reynolds', iodir = std_iodir_climato)
+  std_file_oaflux    =  isafile(getenv('FILE_FLUX'),     title = 'oaflux', iodir = std_iodir_climato)
+  std_file_mld       =  isafile(getenv('FILE_MLD'),      title = 'Mixed layer depth', iodir = std_iodir_climato)
+  std_file_ice       =  isafile(getenv('FILE_ICE'),      title = 'ICE', iodir = std_iodir_climato)
+  std_file_snow_arc  =  isafile(getenv('FILE_SNOW_ARC'), title = 'SNOW_ARC', iodir = std_iodir_climato)
+  std_file_snow_ant  =  isafile(getenv('FILE_SNOW_ANT'), title = 'SNOW_ANT', iodir = std_iodir_climato)
+
+
+  date1   = long(getenv('DATE1'))     &   date2   = long(getenv('DATE2'))
+  date1_2 = long(getenv('DATE1_2'))   &   date2_2 = long(getenv('DATE2_2'))
+
+  allrec =  1 - keyword_set(long(getenv('READ_ONLY_FIRST_RECORD')))
+
+;#########################################################################
+;######################  STANDARD PLOTS   ################################
+;#########################################################################
+
+  IF keyword_set(doplot) EQ 0 THEN doplot = 0
+
+; fixed color tabled
+  lct, 64
+  cnt = 0
+  htmltxt = ''
+;
+  cnt = cnt+1   &   blabla = 'Global Mean Temperature'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_T, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Global Mean Salinity'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_S, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Global Mean SSH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_SSH, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+;;;;  cnt = cnt+1   &   blabla = 'Global Mean Q net'
+;;;;  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_Q, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Global Mean EMP'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_EMP, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Drake Transport'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_Drake, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Max AMOC'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_AMOC, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Sea-Ice Cover'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  cnt = cnt+1   &   blabla = 'Sea-Ice Volume'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_Vol, masknp, POSTSCRIPT = postscript, _extra = ex
+;SF; and probably useless
+;SF  cnt = cnt+1   &   blabla = 'ICE Velocity '
+;SF  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_Vel, masknp, POSTSCRIPT = postscript, _extra = ex
+;SF;
+  cnt = cnt+1   &   blabla = 'Sea-Ice Volume Export at Fram Strait'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_FRAM, masknp, POSTSCRIPT = postscript, _extra = ex
+;
+  IF n_elements(htmltxt) GT 1 THEN putfile, psdir+'std_ts_html_body.txt', htmltxt[1:*]
+
+  return
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_read.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_read.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_read.pro	(revision 8732)
@@ -0,0 +1,44 @@
+PRO std_ts_read, var_name, dt1, dt2, prefix, suffix, ts, ts_z, masknp $
+                 , WITHSSH = withssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz
+
+  compile_opt idl2, strictarrsubs
+  
+@common
+@std_common
+
+
+  list = rseries_ncdf(var_name, dt1, dt2, prefix, suffix, /fileslist)
+  nfiles = n_elements(list)
+  IF keyword_set(withssh) THEN BEGIN
+    sshlist = rseries_ncdf(withssh, dt1, dt2, sshprefix, sshsuffix, /fileslist)
+    IF nfiles NE n_elements(sshlist) THEN stop
+  ENDIF
+
+  ts = 0.
+  ts_Time = 0.
+  ts_z = fltarr(jpk)
+
+  FOR i = 0, nfiles-1 DO BEGIN
+    IF keyword_set(withssh) THEN ssh = read_ncdf(withssh, allrecords = allrec, filename = sshlist[i], /nostruct)
+    var = read_ncdf(var_name, allrecords = allrec, filename = list[i], /nostruct)
+    ts_Time = [ ts_Time, Time]
+;
+    IF jpt EQ 1 THEN txyz = moyenne(var, 'xyz', mask2d = masknp, ssh = ssh) $
+    ELSE txyz = grossemoyenne(var, 'xyz', mask2d = masknp, ssh = ssh)
+    ts = [ ts, txyz ]
+;
+    IF jpt EQ 1 THEN tz = moyenne(temporary(var), 'xy', mask2d = masknp, ssh = ssh, /KEEPBOTTOM) $
+    ELSE tz = grossemoyenne(temporary(var), 'xy', mask2d = masknp, ssh = ssh, /KEEPBOTTOM)
+    IF keyword_set(levz) THEN ts_z = [ [ts_z], [tz - (levz[*] # replicate(1., jpt))] ] $
+    ELSE ts_z = [ [ts_z], [tz] ]
+  ENDFOR
+
+  time = ts_Time[1:*]           ; remove first record of 0
+  jpt = n_elements(time)
+  
+  ts = ts[1:*]        ; remove first record of 0 
+  ts_z = ts_z[*, 1:*]           ; remove first record of 0
+
+
+return
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh	(revision 8732)
@@ -0,0 +1,133 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_ts.sh and std_ts.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_ts_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+idl_command=/Applications/itt/idl64/bin/idl
+#
+PS_DIR=$( pwd )/ts_p4H25a50-testht_ps
+PDF_DIR=$( pwd )/ts_p4H25a50-testht_pdf
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file
+#
+DATE1=20010101  		  ;   DATE2=20501231
+#
+VAR1_T=thetao          ;   V1T_PREF=p4H25a50      ;   V1T_SUFF=_1Y_grid_T.nc
+VAR1_S=so              ;   V1S_PREF=p4H25a50      ;   V1S_SUFF=_1Y_grid_T.nc
+VAR1_SSH=zos         ;   V1SSH_PREF=p4H25a50    ;   V1SSH_SUFF=_1Y_grid_T.nc
+##VAR1_Q=qt              ;   V1Q_PREF=p4H25a50      ;   V1Q_SUFF=_1Y_grid_T.nc
+VAR1_EMP=wfo         ;   V1EMP_PREF=p4H25a50    ;   V1EMP_SUFF=_1Y_grid_T.nc
+VAR1_U=uocetr_eff      ;   V1U_PREF=p4H25a50      ;   V1U_SUFF=_1Y_grid_U.nc
+VAR1_V=vocetr_eff      ;   V1V_PREF=p4H25a50      ;   V1V_SUFF=_1Y_grid_V.nc
+VAR1_ICE=siconc      ;   V1ICE_PREF=p4H25a50    ;   V1ICE_SUFF=_1M_icemod.nc
+VAR1_Ithick=sithic    ;   V1It_PREF=p4H25a50     ;   V1It_SUFF=_1M_icemod.nc
+VAR1_SNOW=snthic    ;   V1SNOW_PREF=p4H25a50   ;   V1SNOW_SUFF=_1M_icemod.nc
+VAR1_IvelV=sivelv    ;   V1IvV_PREF=p4H25a50    ;   V1IvV_SUFF=_1M_icemod.nc 
+VAR1_Ivel=sivelo      ;   V1Iv_PREF=p4H25a50     ;   V1Iv_SUFF=_1M_icemod.nc
+#
+#===================== EXP2 =====================
+#
+DATE1_2=20010101   	  ;   DATE2_2=20501231
+#
+VAR2_T=thetao     	  ;   V2T_PREF=testht     ;   V2T_SUFF=_1Y_grid_T.nc
+VAR2_S=so        	  ;   V2S_PREF=testht     ;   V2S_SUFF=_1Y_grid_T.nc
+VAR2_SSH=zos      	;   V2SSH_PREF=testht   ;   V2SSH_SUFF=_1Y_grid_T.nc
+##VAR2_Q=qt       	  ;   V2Q_PREF=testht     ;   V2Q_SUFF=_1Y_grid_T.nc
+VAR2_EMP=wfo            ;   V2EMP_PREF=testht   ;   V2EMP_SUFF=_1Y_grid_T.nc
+VAR2_U=uocetr_eff   	  ;   V2U_PREF=testht     ;   V2U_SUFF=_1Y_grid_U.nc
+VAR2_V=vocetr_eff   	  ;   V2V_PREF=testht     ;   V2V_SUFF=_1Y_grid_V.nc
+VAR2_ICE=siconc         ;   V2ICE_PREF=testht   ;   V2ICE_SUFF=_1M_icemod.nc
+VAR2_Ithick=sithic       ;   V2It_PREF=testht    ;   V2It_SUFF=_1M_icemod.nc
+VAR2_SNOW=snthic       ;   V2SNOW_PREF=testht  ;   V2SNOW_SUFF=_1M_icemod.nc
+VAR2_IvelV=sivelv       ;   V2IvV_PREF=testht   ;   V2IvV_SUFF=_1M_icemod.nc 
+VAR2_Ivel=sivelo        ;   V2IvV_PREF=testht   ;   V2IvV_SUFF=_1M_icemod.nc 
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D  VAR_TEMP_3D
+export FILE_SAL_3D   VAR_SAL_3D
+export FILE_SST      VAR_SST
+export FILE_GEOHEAT  VAR_GEOHEAT
+export FILE_FLUX     VAR_FLUX
+export FILE_MLD      VAR_MLD
+export FILE_ICE      VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH  VAR_ICE_area_SH
+export FILE_SNOW     VAR_SNOW_NH     VAR_SNOW_SH    VAR_SNOW_area_NH VAR_SNOW_area_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+#
+export DATE1        DATE2
+export VAR1_T       V1T_PREF     V1T_SUFF
+export VAR1_S       V1S_PREF     V1S_SUFF
+export VAR1_SSH     V1SSH_PREF   V1SSH_SUFF
+export VAR1_Q       V1Q_PREF     V1Q_SUFF
+export VAR1_EMP     V1EMP_PREF   V1EMP_SUFF
+export VAR1_U       V1U_PREF     V1U_SUFF
+export VAR1_V       V1V_PREF     V1V_SUFF
+export VAR1_ICE     V1ICE_PREF   V1ICE_SUFF
+export VAR1_Ithick  V1It_PREF    V1It_SUFF
+export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
+export VAR1_Ivel    V1Iv_PREF    V1Iv_SUFF
+
+#===================== EXP2 =====================
+export DATE1_2      DATE2_2
+export VAR2_T       V2T_PREF     V2T_SUFF
+export VAR2_S       V2S_PREF     V2S_SUFF
+export VAR2_SSH     V2SSH_PREF   V2SSH_SUFF
+export VAR2_Q       V2Q_PREF     V2Q_SUFF
+export VAR2_EMP     V2EMP_PREF   V2EMP_SUFF
+export VAR2_U       V2U_PREF     V2U_SUFF
+export VAR2_V       V2V_PREF     V2V_SUFF
+export VAR2_ICE     V2ICE_PREF   V2ICE_SUFF
+export VAR2_Ithick  V2It_PREF    V2It_SUFF
+export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
+export VAR2_Ivel    V2Iv_PREF    V2Iv_SUFF
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh.new_names
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh.new_names	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh.new_names	(revision 8732)
@@ -0,0 +1,136 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_ts.sh and std_ts.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_ts_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+idl_command=/Applications/itt/idl64/bin/idl
+#
+PS_DIR=$( pwd )/ts_sbcmodMV_ps
+PDF_DIR=$( pwd )/ts_sbcmodMV_pdf
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada      # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file
+#
+#DATE1=20010101   ;   DATE2=25001231
+DATE1=20010101    ;   DATE2=20501231
+#DATE1=00010101  		;   DATE2=00101231
+#
+VAR1_T=thetao        ;   V1T_PREF=sbcmodMV      ;   V1T_SUFF=_1Y_grid_T.nc
+VAR1_S=so            ;   V1S_PREF=sbcmodMV      ;   V1S_SUFF=_1Y_grid_T.nc
+VAR1_SSH=zos         ;   V1SSH_PREF=sbcmodMV    ;   V1SSH_SUFF=_1Y_grid_T.nc
+VAR1_Q=tohfls        ;   V1Q_PREF=sbcmodMV      ;   V1Q_SUFF=_1Y_grid_T.nc
+VAR1_EMP=wfo         ;   V1EMP_PREF=sbcmodMV    ;   V1EMP_SUFF=_1Y_grid_T.nc
+VAR1_U=uocetr_eff    ;   V1U_PREF=sbcmodMV      ;   V1U_SUFF=_1Y_grid_U.nc
+VAR1_V=vocetr_eff    ;   V1V_PREF=sbcmodMV      ;   V1V_SUFF=_1Y_grid_V.nc
+VAR1_ICE=siconc      ;   V1ICE_PREF=sbcmodMV    ;   V1ICE_SUFF=_1M_icemod.nc
+VAR1_Ithick=sithic   ;   V1It_PREF=sbcmodMV     ;   V1It_SUFF=_1M_icemod.nc
+VAR1_SNOW=sndept     ;   V1SNOW_PREF=sbcmodMV   ;   V1SNOW_SUFF=_1M_icemod.nc
+VAR1_IvelV=sivelv    ;   V1IvV_PREF=sbcmodMV    ;   V1IvV_SUFF=_1M_icemod.nc
+VAR1_Ivel=sivelo     ;   V1Iv_PREF=sbcmodMV     ;   V1Iv_SUFF=_1M_icemod.nc
+#
+#===================== EXP2 =====================
+#
+#DATE1_2=20010101    ;   DATE2_2=20101231
+DATE1_2=20010101     ;   DATE2_2=20501231
+#
+VAR2_T=thetao        ;   V2T_PREF=sbcmodMV      ;   V2T_SUFF=_1Y_grid_T.nc
+VAR2_S=so            ;   V2S_PREF=sbcmodMV      ;   V2S_SUFF=_1Y_grid_T.nc
+VAR2_SSH=zos         ;   V2SSH_PREF=sbcmodMV    ;   V2SSH_SUFF=_1Y_grid_T.nc
+VAR2_Q=tohfls        ;   V2Q_PREF=sbcmodMV      ;   V2Q_SUFF=_1Y_grid_T.nc
+VAR2_EMP=wfo         ;   V2EMP_PREF=sbcmodMV    ;   V2EMP_SUFF=_1Y_grid_T.nc
+VAR2_U=uocetr_eff    ;   V2U_PREF=sbcmodMV      ;   V2U_SUFF=_1Y_grid_U.nc
+VAR2_V=vocetr_eff    ;   V2V_PREF=sbcmodMV      ;   V2V_SUFF=_1Y_grid_V.nc
+VAR2_ICE=siconc      ;   V2ICE_PREF=sbcmodMV    ;   V2ICE_SUFF=_1M_icemod.nc
+VAR2_Ithick=sithic   ;   V2It_PREF=sbcmodMV     ;   V2It_SUFF=_1M_icemod.nc
+VAR2_SNOW=sndept     ;   V2SNOW_PREF=sbcmodMV   ;   V2SNOW_SUFF=_1M_icemod.nc
+VAR2_IvelV=sivelv    ;   V2IvV_PREF=sbcmodMV    ;   V2IvV_SUFF=_1M_icemod.nc
+VAR2_Ivel=sivelo     ;   V2Iv_PREF=sbcmodMV     ;   V2Iv_SUFF=_1M_icemod.nc
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D  VAR_TEMP_3D
+export FILE_SAL_3D   VAR_SAL_3D
+export FILE_SST      VAR_SST
+export FILE_GEOHEAT  VAR_GEOHEAT
+export FILE_FLUX     VAR_FLUX
+export FILE_MLD      VAR_MLD
+export FILE_ICE      VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH  VAR_ICE_area_SH
+export FILE_SNOW     VAR_SNOW_NH     VAR_SNOW_SH    VAR_SNOW_area_NH VAR_SNOW_area_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+#
+export DATE1        DATE2
+export VAR1_T       V1T_PREF     V1T_SUFF
+export VAR1_S       V1S_PREF     V1S_SUFF
+export VAR1_SSH     V1SSH_PREF   V1SSH_SUFF
+export VAR1_Q       V1Q_PREF     V1Q_SUFF
+export VAR1_EMP     V1EMP_PREF   V1EMP_SUFF
+export VAR1_U       V1U_PREF     V1U_SUFF
+export VAR1_V       V1V_PREF     V1V_SUFF
+export VAR1_ICE     V1ICE_PREF   V1ICE_SUFF
+export VAR1_Ithick  V1It_PREF    V1It_SUFF
+export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
+export VAR1_Ivel    V1Iv_PREF    V1Iv_SUFF
+
+#===================== EXP2 =====================
+export DATE1_2      DATE2_2
+export VAR2_T       V2T_PREF     V2T_SUFF
+export VAR2_S       V2S_PREF     V2S_SUFF
+export VAR2_SSH     V2SSH_PREF   V2SSH_SUFF
+export VAR2_Q       V2Q_PREF     V2Q_SUFF
+export VAR2_EMP     V2EMP_PREF   V2EMP_SUFF
+export VAR2_U       V2U_PREF     V2U_SUFF
+export VAR2_V       V2V_PREF     V2V_SUFF
+export VAR2_ICE     V2ICE_PREF   V2ICE_SUFF
+export VAR2_Ithick  V2It_PREF    V2It_SUFF
+export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
+export VAR2_Ivel    V2Iv_PREF    V2Iv_SUFF
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example1
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example1	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example1	(revision 8732)
@@ -0,0 +1,128 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_ts.sh and std_ts.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_ts_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+idl_command=/Applications/itt/idl64/bin/idl
+#
+PS_DIR=$( pwd )/ps_tag33_tag331
+PDF_DIR=$( pwd )/pdf_tag33_tag331
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada      # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file
+#
+DATE1=20010101   ;   DATE2=21001231
+#
+VAR1_T=thetao          ;   V1T_PREF=tmx_2000     ;   V1T_SUFF=_1Y_grid_T.nc
+VAR1_S=so              ;   V1S_PREF=tmx_2000     ;   V1S_SUFF=_1Y_grid_T.nc
+VAR1_SSH=zos           ;   V1SSH_PREF=tmx_2000   ;   V1SSH_SUFF=_1Y_grid_T.nc
+VAR1_Q=qns+qsr         ;   V1Q_PREF=tmx_2000     ;   V1Q_SUFF=_1Y_grid_T.nc
+VAR1_EMP=wfo           ;   V1EMP_PREF=tmx_2000   ;   V1EMP_SUFF=_1Y_grid_T.nc
+VAR1_U=uoce_eff        ;   V1U_PREF=tmx_2000     ;   V1U_SUFF=_1Y_grid_U.nc
+VAR1_V=voce_eff        ;   V1V_PREF=tmx_2000     ;   V1V_SUFF=_1Y_grid_V.nc
+VAR1_ICE=sic           ;   V1ICE_PREF=tmx_2000   ;   V1ICE_SUFF=_1M_icemod.nc
+VAR1_Ithick=sit        ;   V1It_PREF=tmx_2000    ;   V1It_SUFF=_1M_icemod.nc
+VAR1_SNOW=isnowthi     ;   V1SNOW_PREF=tmx_2000  ;   V1SNOW_SUFF=_1M_icemod.nc
+VAR1_IvelV=vice_ipa    ;   V1IvV_PREF=tmx_2000   ;   V1IvV_SUFF=_1M_icemod.nc
+#
+#===================== EXP2 =====================
+#
+DATE1_2=10101   ;   DATE2_2=20001231
+#
+VAR2_T=thetao         ;   V2T_PREF=core2000     ;   V2T_SUFF=_1Y_grid_T.nc
+VAR2_S=so             ;   V2S_PREF=core2000     ;   V2S_SUFF=_1Y_grid_T.nc
+VAR2_SSH=zos          ;   V2SSH_PREF=core2000   ;   V2SSH_SUFF=_1Y_grid_T.nc
+VAR2_Q=qns+qsr        ;   V2Q_PREF=core2000     ;   V2Q_SUFF=_1Y_grid_T.nc
+VAR2_EMP=wfo          ;   V2EMP_PREF=core2000   ;   V2EMP_SUFF=_1Y_grid_T.nc
+VAR2_U=uoce_eff       ;   V2U_PREF=core2000     ;   V2U_SUFF=_1Y_grid_U.nc
+VAR2_V=voce_eff       ;   V2V_PREF=core2000     ;   V2V_SUFF=_1Y_grid_V.nc
+VAR2_ICE=sic          ;   V2ICE_PREF=core2000   ;   V2ICE_SUFF=_1M_icemod.nc
+VAR2_Ithick=sit       ;   V2It_PREF=core2000    ;   V2It_SUFF=_1M_icemod.nc
+VAR2_SNOW=isnowthi    ;   V2ICE_SNOW=core2000   ;   V2SNOW_SUFF=_1M_icemod.nc
+VAR2_IvelV=vice_ipa   ;   V2IvV_PREF=core2000   ;   V2IvV_SUFF=_1M_icemod.nc
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D  VAR_TEMP_3D
+export FILE_SAL_3D   VAR_SAL_3D
+export FILE_SST      VAR_SST
+export FILE_GEOHEAT  VAR_GEOHEAT
+export FILE_FLUX     VAR_FLUX
+export FILE_MLD      VAR_MLD
+export FILE_ICE      VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH  VAR_ICE_area_SH
+export FILE_SNOW     VAR_SNOW_NH     VAR_SNOW_SH    VAR_SNOW_area_NH VAR_SNOW_area_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+#
+export DATE1        DATE2
+export VAR1_T       V1T_PREF     V1T_SUFF
+export VAR1_S       V1S_PREF     V1S_SUFF
+export VAR1_SSH     V1SSH_PREF   V1SSH_SUFF
+export VAR1_Q       V1Q_PREF     V1Q_SUFF
+export VAR1_EMP     V1EMP_PREF   V1EMP_SUFF
+export VAR1_U       V1U_PREF     V1U_SUFF
+export VAR1_V       V1V_PREF     V1V_SUFF
+export VAR1_ICE     V1ICE_PREF   V1ICE_SUFF
+export VAR1_Ithick  V1It_PREF    V1It_SUFF
+export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
+#===================== EXP2 =====================
+export DATE1_2      DATE2_2
+export VAR2_T       V2T_PREF    V2T_SUFF
+export VAR2_S       V2S_PREF    V2S_SUFF
+export VAR2_SSH     V2SSH_PREF  V2SSH_SUFF
+export VAR2_Q       V2Q_PREF    V2Q_SUFF
+export VAR2_EMP     V2EMP_PREF  V2EMP_SUFF
+export VAR2_U       V2U_PREF    V2U_SUFF
+export VAR2_V       V2V_PREF    V2V_SUFF
+export VAR2_ICE     V2ICE_PREF  V2ICE_SUFF
+export VAR2_Ithick  V2It_PREF   V2It_SUFF
+export VAR2_SNOW    V2SNOW_PREF V2SNOW_SUFF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example2
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example2	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example2	(revision 8732)
@@ -0,0 +1,128 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_ts.sh and std_ts.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_ts_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+idl_command=/Applications/itt/idl64/bin/idl
+#
+PS_DIR=$( pwd )/ps_tag33_tag331
+PDF_DIR=$( pwd )/pdf_tag33_tag331
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada      # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file
+#
+DATE1=20010101   ;   DATE2=21001231
+#
+VAR1_T=thetao         ;   V1T_PREF=tag33        ;   V1T_SUFF=_1Y_grid_T.nc
+VAR1_S=so             ;   V1S_PREF=tag33        ;   V1S_SUFF=_1Y_grid_T.nc
+VAR1_SSH=zos          ;   V1SSH_PREF=tag33      ;   V1SSH_SUFF=_1Y_grid_T.nc
+VAR1_Q=qt             ;   V1Q_PREF=tag33        ;   V1Q_SUFF=_1Y_grid_T.nc
+VAR1_EMP=wfo          ;   V1EMP_PREF=tag33      ;   V1EMP_SUFF=_1Y_grid_T.nc
+VAR1_U=uocetr_eff     ;   V1U_PREF=tag33        ;   V1U_SUFF=_1Y_grid_U.nc
+VAR1_V=vocetr_eff     ;   V1V_PREF=tag33        ;   V1V_SUFF=_1Y_grid_V.nc
+VAR1_ICE=sic          ;   V1ICE_PREF=tag33      ;   V1ICE_SUFF=_1M_icemod.nc
+VAR1_Ithick=sit       ;   V1It_PREF=tag33       ;   V1It_SUFF=_1M_icemod.nc
+VAR1_SNOW=isnowthi    ;   V1SNOW_PREF=tag33     ;   V1SNOW_SUFF=_1M_icemod.nc
+VAR1_IvelV=vice_ipa   ;   V1IvV_PREF=tag33      ;   V1IvV_SUFF=_1M_icemod.nc
+#
+#===================== EXP2 =====================
+#
+DATE1_2=20010101   ;   DATE2_2=21001231
+#
+VAR2_T=thetao         ;   V2T_PREF=trunk331     ;   V2T_SUFF=_1Y_grid_T.nc
+VAR2_S=so             ;   V2S_PREF=trunk331     ;   V2S_SUFF=_1Y_grid_T.nc
+VAR2_SSH=zos          ;   V2SSH_PREF=trunk331   ;   V2SSH_SUFF=_1Y_grid_T.nc
+VAR2_Q=qt             ;   V2Q_PREF=trunk331     ;   V2Q_SUFF=_1Y_grid_T.nc
+VAR2_EMP=wfo          ;   V2EMP_PREF=trunk331   ;   V2EMP_SUFF=_1Y_grid_T.nc
+VAR2_U=uocetr_eff     ;   V2U_PREF=trunk331     ;   V2U_SUFF=_1Y_grid_U.nc
+VAR2_V=vocetr_eff     ;   V2V_PREF=trunk331     ;   V2V_SUFF=_1Y_grid_V.nc
+VAR2_ICE=sic          ;   V2ICE_PREF=trunk331   ;   V2ICE_SUFF=_1M_icemod.nc
+VAR2_Ithick=sit       ;   V2It_PREF=trunk331    ;   V2It_SUFF=_1M_icemod.nc
+VAR2_SNOW=isnowthi    ;   V2ICE_SNOW=trunk331   ;   V2SNOW_SUFF=_1M_icemod.nc
+VAR2_IvelV=vice_ipa   ;   V2IvV_PREF=trunk331   ;   V2IvV_SUFF=_1M_icemod.nc
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D  VAR_TEMP_3D
+export FILE_SAL_3D   VAR_SAL_3D
+export FILE_SST      VAR_SST
+export FILE_GEOHEAT  VAR_GEOHEAT
+export FILE_FLUX     VAR_FLUX
+export FILE_MLD      VAR_MLD
+export FILE_ICE      VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH  VAR_ICE_area_SH
+export FILE_SNOW     VAR_SNOW_NH     VAR_SNOW_SH    VAR_SNOW_area_NH VAR_SNOW_area_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+#
+export DATE1        DATE2
+export VAR1_T       V1T_PREF     V1T_SUFF
+export VAR1_S       V1S_PREF     V1S_SUFF
+export VAR1_SSH     V1SSH_PREF   V1SSH_SUFF
+export VAR1_Q       V1Q_PREF     V1Q_SUFF
+export VAR1_EMP     V1EMP_PREF   V1EMP_SUFF
+export VAR1_U       V1U_PREF     V1U_SUFF
+export VAR1_V       V1V_PREF     V1V_SUFF
+export VAR1_ICE     V1ICE_PREF   V1ICE_SUFF
+export VAR1_Ithick  V1It_PREF    V1It_SUFF
+export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
+#===================== EXP2 =====================
+export DATE1_2      DATE2_2
+export VAR2_T       V2T_PREF    V2T_SUFF
+export VAR2_S       V2S_PREF    V2S_SUFF
+export VAR2_SSH     V2SSH_PREF  V2SSH_SUFF
+export VAR2_Q       V2Q_PREF    V2Q_SUFF
+export VAR2_EMP     V2EMP_PREF  V2EMP_SUFF
+export VAR2_U       V2U_PREF    V2U_SUFF
+export VAR2_V       V2V_PREF    V2V_SUFF
+export VAR2_ICE     V2ICE_PREF  V2ICE_SUFF
+export VAR2_Ithick  V2It_PREF   V2It_SUFF
+export VAR2_SNOW    V2SNOW_PREF V2SNOW_SUFF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example_ipcc
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example_ipcc	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example_ipcc	(revision 8732)
@@ -0,0 +1,133 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_ts.sh and std_ts.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_ts_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+idl_command=/Applications/itt/idl64/bin/idl
+#
+PS_DIR=$( pwd )/ps_tag33_tag331
+PDF_DIR=$( pwd )/pdf_tag33_tag331
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada      # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file
+#
+DATE1=20010101   ;   DATE2=21001231
+#
+VAR1_T=thetao       ;   V1T_PREF=tag33      ;   V1T_SUFF=_1Y_grid_T.nc
+VAR1_S=so           ;   V1S_PREF=tag33      ;   V1S_SUFF=_1Y_grid_T.nc
+VAR1_SSH=zos        ;   V1SSH_PREF=tag33    ;   V1SSH_SUFF=_1Y_grid_T.nc
+VAR1_Q=qt           ;   V1Q_PREF=tag33      ;   V1Q_SUFF=_1Y_grid_T.nc
+VAR1_EMP=wfo        ;   V1EMP_PREF=tag33    ;   V1EMP_SUFF=_1Y_grid_T.nc
+VAR1_U=uocetr_eff   ;   V1U_PREF=tag33      ;   V1U_SUFF=_1Y_grid_U.nc
+VAR1_V=vocetr_eff   ;   V1V_PREF=tag33      ;   V1V_SUFF=_1Y_grid_V.nc
+VAR1_ICE=sic        ;   V1ICE_PREF=tag33    ;   V1ICE_SUFF=_1M_icemod.nc
+VAR1_Ithick=sit     ;   V1It_PREF=tag33     ;   V1It_SUFF=_1M_icemod.nc
+VAR1_SNOW=isnowthi  ;   V1SNOW_PREF=tag33   ;   V1SNOW_SUFF=_1M_icemod.nc
+VAR1_IvelV=iicevelv ;   V1IvV_PREF=tag33    ;   V1IvV_SUFF=_1M_icemod.nc
+VAR1_Ivel=iicevelo  ;   V1Iv_PREF=tag33     ;   V1Iv_SUFF=_1M_icemod.nc
+#
+#===================== EXP2 =====================
+#
+DATE1_2=20010101    ;   DATE2_2=21001231
+#
+VAR2_T=thetao       ;   V2T_PREF=trunk331      ;   V2T_SUFF=_1Y_grid_T.nc
+VAR2_S=so           ;   V2S_PREF=trunk331      ;   V2S_SUFF=_1Y_grid_T.nc
+VAR2_SSH=zos        ;   V2SSH_PREF=trunk331    ;   V2SSH_SUFF=_1Y_grid_T.nc
+VAR2_Q=qt           ;   V2Q_PREF=trunk331      ;   V2Q_SUFF=_1Y_grid_T.nc
+VAR2_EMP=wfo        ;   V2EMP_PREF=trunk331    ;   V2EMP_SUFF=_1Y_grid_T.nc
+VAR2_U=uocetr_eff   ;   V2U_PREF=trunk331      ;   V2U_SUFF=_1Y_grid_U.nc
+VAR2_V=vocetr_eff   ;   V2V_PREF=trunk331      ;   V2V_SUFF=_1Y_grid_V.nc
+VAR2_ICE=sic        ;   V2ICE_PREF=trunk331    ;   V2ICE_SUFF=_1M_icemod.nc
+VAR2_Ithick=sit     ;   V2It_PREF=trunk331     ;   V2It_SUFF=_1M_icemod.nc
+VAR2_SNOW=isnowthi  ;   V2ICE_SNOW=trunk331    ;   V2SNOW_SUFF=_1M_icemod.nc
+VAR2_IvelV=iicevelv ;   V2IvV_PREF=trunk331    ;   V2IvV_SUFF=_1M_icemod.nc
+VAR2_Ivel=iicevelo  ;   V2Iv_PREF=trunk331     ;   V2Iv_SUFF=_1M_icemod.nc
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D  VAR_TEMP_3D
+export FILE_SAL_3D   VAR_SAL_3D
+export FILE_SST      VAR_SST
+export FILE_GEOHEAT  VAR_GEOHEAT
+export FILE_FLUX     VAR_FLUX
+export FILE_MLD      VAR_MLD
+export FILE_ICE      VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH  VAR_ICE_area_SH
+export FILE_SNOW     VAR_SNOW_NH     VAR_SNOW_SH    VAR_SNOW_area_NH VAR_SNOW_area_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+#
+export DATE1        DATE2
+export VAR1_T       V1T_PREF     V1T_SUFF
+export VAR1_S       V1S_PREF     V1S_SUFF
+export VAR1_SSH     V1SSH_PREF   V1SSH_SUFF
+export VAR1_Q       V1Q_PREF     V1Q_SUFF
+export VAR1_EMP     V1EMP_PREF   V1EMP_SUFF
+export VAR1_U       V1U_PREF     V1U_SUFF
+export VAR1_V       V1V_PREF     V1V_SUFF
+export VAR1_ICE     V1ICE_PREF   V1ICE_SUFF
+export VAR1_Ithick  V1It_PREF    V1It_SUFF
+export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
+export VAR1_Ivel    V1Iv_PREF    V1Iv_SUFF
+
+#===================== EXP2 =====================
+export DATE1_2      DATE2_2
+export VAR2_T       V2T_PREF     V2T_SUFF
+export VAR2_S       V2S_PREF     V2S_SUFF
+export VAR2_SSH     V2SSH_PREF   V2SSH_SUFF
+export VAR2_Q       V2Q_PREF     V2Q_SUFF
+export VAR2_EMP     V2EMP_PREF   V2EMP_SUFF
+export VAR2_U       V2U_PREF     V2U_SUFF
+export VAR2_V       V2V_PREF     V2V_SUFF
+export VAR2_ICE     V2ICE_PREF   V2ICE_SUFF
+export VAR2_Ithick  V2It_PREF    V2It_SUFF
+export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
+export VAR2_Ivel    V2Iv_PREF    V2Iv_SUFF
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example_old_names
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example_old_names	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/IDL_scripts/std_ts_vardef.sh_example_old_names	(revision 8732)
@@ -0,0 +1,133 @@
+#!/bin/sh 
+#
+# AUTHOR - date
+# ===========
+# Sebastien Masson - 04/2011 - LOCEAN
+#
+# DESCRIPTION
+# ===========
+# define all varibles needed by std_ts.sh and std_ts.pro
+#
+# EXAMPLES
+# ========
+# $ . ./std_ts_vardef.sh
+#
+#
+#===================== User PATHS =====================
+#
+idl_command=/Applications/itt/idl64/bin/idl
+#
+PS_DIR=$( pwd )/amax9999_ts_ps
+PDF_DIR=$( pwd )/amax9999_ts_pdf
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/sflod/SAXO_DIR
+#
+DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada      # path of data in NetCDF format
+DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data
+DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/sflod/idl_PLOTS/MASK/ORL2PISV35_mesh_mask.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper     ;   FILE_TEMP_3D=potT_annual_mean.nc                         # PHC3
+VAR_SAL_3D=vosaline      ;   FILE_SAL_3D=Salt_1y_corr_PHC3WOA09.nc                    # PHC3
+VAR_SST=sst              ;   FILE_SST=NewREY_ORCA2_1991_2000_1y.nc                   # Reynolds
+VAR_FLUX=qnet            ;   FILE_FLUX=OAFlux_1my_01_12_1984_2004_orca2_qnet.nc      # flux
+VAR_MLD=mld              ;   FILE_MLD=mld_DR003_c1m_ORCA2_1y.nc                      # Mixed layer depth
+VAR_ICE_EXT_NH=extt_NH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent North Emisphere
+VAR_ICE_EXT_SH=extt_SH   ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Extent South Emisphere
+VAR_ICE_area_NH=area_NH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area North Emisphere
+VAR_ICE_area_SH=area_SH  ;   FILE_ICE=sea_ice_index_2000.nc                               # Ice Area South Emisphere
+#
+# Geothermal heating -> define FILE_GEOHEAT to 'NO' if there is not such forcing
+#                    -> define VAR_GEOHEAT to a constant if geothermal heating is constant over the domain
+VAR_GEOHEAT=heatflow   ;   FILE_GEOHEAT=geothermal_heating.nc 
+#
+#===================== EXP1 =====================
+#
+READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file
+#
+DATE1=00010101  		;   DATE2=00101231
+#
+VAR1_T=votemper       	;   V1T_PREF=ow_amax9999      ;   V1T_SUFF=_1m_grid_T.nc
+VAR1_S=vosaline        	;   V1S_PREF=ow_amax9999      ;   V1S_SUFF=_1m_grid_T.nc
+VAR1_SSH=sossheig      	;   V1SSH_PREF=ow_amax9999    ;   V1SSH_SUFF=_1m_grid_T.nc
+VAR1_Q=sohefldo        	;   V1Q_PREF=ow_amax9999      ;   V1Q_SUFF=_1m_grid_T.nc
+VAR1_EMP=sowaflup      	;   V1EMP_PREF=ow_amax9999    ;   V1EMP_SUFF=_1m_grid_T.nc
+VAR1_U=uocetr_eff      	;   V1U_PREF=ow_amax9999      ;   V1U_SUFF=_1m_grid_U.nc
+VAR1_V=vocetr_eff   	;   V1V_PREF=ow_amax9999      ;   V1V_SUFF=_1m_grid_V.nc
+VAR1_ICE=iiceconc 	    ;   V1ICE_PREF=ow_amax9999    ;   V1ICE_SUFF=_1m_icemod.nc
+VAR1_Ithick=iicethic    ;   V1It_PREF=ow_amax9999     ;   V1It_SUFF=_1m_icemod.nc
+VAR1_SNOW=isnowthi   	;   V1SNOW_PREF=ow_amax9999   ;   V1SNOW_SUFF=_1m_icemod.nc
+VAR1_IvelV=sivelv       ;   V1IvV_PREF=ow_amax9999    ;   V1IvV_SUFF=_1m_icemod.nc 
+VAR1_Ivel=sivelo        ;   V1Iv_PREF=ow_amax9999     ;   V1Iv_SUFF=_1m_icemod.nc
+#
+#===================== EXP2 =====================
+#
+DATE1_2=00010101   		;   DATE2_2=00101231
+#
+VAR2_T=votemper     	;   V2T_PREF=ow_amax9999     ;   V2T_SUFF=_1m_grid_T.nc
+VAR2_S=vosaline        	;   V2S_PREF=ow_amax9999     ;   V2S_SUFF=_1m_grid_T.nc
+VAR2_SSH=sossheig      	;   V2SSH_PREF=ow_amax9999   ;   V2SSH_SUFF=_1m_grid_T.nc
+VAR2_Q=sohefldo       	;   V2Q_PREF=ow_amax9999     ;   V2Q_SUFF=_1m_grid_T.nc
+VAR2_EMP=sowaflup     	;   V2EMP_PREF=ow_amax9999   ;   V2EMP_SUFF=_1m_grid_T.nc
+VAR2_U=uocetr_eff   	;   V2U_PREF=ow_amax9999     ;   V2U_SUFF=_1m_grid_U.nc
+VAR2_V=vocetr_eff   	;   V2V_PREF=ow_amax9999     ;   V2V_SUFF=_1m_grid_V.nc
+VAR2_ICE=iiceconc     	;   V2ICE_PREF=ow_amax9999   ;   V2ICE_SUFF=_1m_icemod.nc
+VAR2_Ithick=iicethic    ;   V2It_PREF=ow_amax9999    ;   V2It_SUFF=_1m_icemod.nc
+VAR2_SNOW=isnowthi   	;   V2SNOW_PREF=ow_amax9999  ;   V2SNOW_SUFF=_1m_icemod.nc
+VAR2_IvelV=sivelv       ;   V2IvV_PREF=ow_amax9999   ;   V2IvV_SUFF=_1m_icemod.nc 
+VAR2_Ivel=sivelo        ;   V2IvV_PREF=ow_amax9999   ;   V2IvV_SUFF=_1m_icemod.nc 
+#
+######################### Export Variables ###############################
+#
+#===================== User PATHS =====================
+export PS_DIR PDF_DIR HTML_DIR SAXO_DIR
+export DIR_DATA DIR_CLIMATO DIR_MASK
+#===================== Model GRID =====================
+export FILE_MESH_MASK FILE_MASK_SUBDOMAIN
+#===================== DATA =====================
+export FILE_TEMP_3D  VAR_TEMP_3D
+export FILE_SAL_3D   VAR_SAL_3D
+export FILE_SST      VAR_SST
+export FILE_GEOHEAT  VAR_GEOHEAT
+export FILE_FLUX     VAR_FLUX
+export FILE_MLD      VAR_MLD
+export FILE_ICE      VAR_ICE_EXT_NH  VAR_ICE_EXT_SH VAR_ICE_area_NH  VAR_ICE_area_SH
+export FILE_SNOW     VAR_SNOW_NH     VAR_SNOW_SH    VAR_SNOW_area_NH VAR_SNOW_area_SH
+#===================== EXP1 =====================
+export READ_ONLY_FIRST_RECORD
+#
+export DATE1        DATE2
+export VAR1_T       V1T_PREF     V1T_SUFF
+export VAR1_S       V1S_PREF     V1S_SUFF
+export VAR1_SSH     V1SSH_PREF   V1SSH_SUFF
+export VAR1_Q       V1Q_PREF     V1Q_SUFF
+export VAR1_EMP     V1EMP_PREF   V1EMP_SUFF
+export VAR1_U       V1U_PREF     V1U_SUFF
+export VAR1_V       V1V_PREF     V1V_SUFF
+export VAR1_ICE     V1ICE_PREF   V1ICE_SUFF
+export VAR1_Ithick  V1It_PREF    V1It_SUFF
+export VAR1_SNOW    V1SNOW_PREF  V1SNOW_SUFF
+export VAR1_IvelV   V1IvV_PREF   V1IvV_SUFF
+export VAR1_Ivel    V1Iv_PREF    V1Iv_SUFF
+
+#===================== EXP2 =====================
+export DATE1_2      DATE2_2
+export VAR2_T       V2T_PREF     V2T_SUFF
+export VAR2_S       V2S_PREF     V2S_SUFF
+export VAR2_SSH     V2SSH_PREF   V2SSH_SUFF
+export VAR2_Q       V2Q_PREF     V2Q_SUFF
+export VAR2_EMP     V2EMP_PREF   V2EMP_SUFF
+export VAR2_U       V2U_PREF     V2U_SUFF
+export VAR2_V       V2V_PREF     V2V_SUFF
+export VAR2_ICE     V2ICE_PREF   V2ICE_SUFF
+export VAR2_Ithick  V2It_PREF    V2It_SUFF
+export VAR2_SNOW    V2SNOW_PREF  V2SNOW_SUFF
+export VAR2_IvelV   V2IvV_PREF   V2IvV_SUFF
+export VAR2_Ivel    V2Iv_PREF    V2Iv_SUFF
+#
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/cpp_ORCA2_LIM3_PISCES.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/cpp_ORCA2_LIM3_PISCES.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/cpp_ORCA2_LIM3_PISCES.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx_new key_iomput key_mpp_mpi key_top key_nosignedzero
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job	(revision 8732)
@@ -0,0 +1,166 @@
+#-Q- sxnec ##################
+#-Q- sxnec ## SXNEC IDRIS
+#-Q- sxnec ##################
+#-Q- sxnec #@$-r :XXX:XXX:XXX:           # job name
+#-Q- sxnec #@$-o output_XXXXXXX.1        # outputfile name
+#-Q- sxnec #@$-me                        # sends a mail at the end of execution
+#-Q- sxnec #@$-eo                        # merge standard error and output
+#-Q- sxnec #@$-jo                        # print a short performance analysis
+#-Q- sxnec #@$-lT 3:00:00                # Max total CPU time
+#-Q- sxnec #@$-lt 2:59:00                # Max CPU time per process
+#-Q- sxnec #@$-lM 4Gb                    # Max memory
+#-Q- sxnec ##@$-c 4                     # Max number of simultaneous procs used (here=4)
+#-Q- sxnec ##@$-q multi                 # Use more than 1 proc
+#-Q- aix ##################
+#-Q- aix ## IBM   IDRIS  ##
+#-Q- aix ##################
+#-Q- aix #@job_name= :XXX:XXX:XXX:          
+#-Q- aix #@output= output_XXXXXXX.1          
+#-Q- aix #@error= error_XXXXXXX.1          
+#-Q- aix #@cpu_limit= 14200
+#-Q- aix #@stack_limit= 200Mb        
+#-Q- aix #@data_limit= 4.8Gb         
+#-Q- aix #@notification= complete
+#-Q- aix #@total_tasks= 1 
+#-Q- aix #@job_type= parallel
+#-Q- aix #@queue
+#-Q- sx8brodie ##################
+#-Q- sx8brodie ## SX8NEC IDRIS ##
+#-Q- sx8brodie ##################
+#-Q- sx8brodie #PBS -N :XXX:XXX:XXX:        # job name
+#-Q- sx8brodie #PBS -o output_XXXXXXX.1     # outputfile name
+#-Q- sx8brodie #PBS -j o                    # merge standard error and output
+#-Q- sx8brodie #PBS -S /usr/bin/ksh         # user shell
+#-Q- sx8brodie #PBS -l memsz_job=4.6gb      # Max memory
+#-Q- sx8brodie #PBS -l cputim_prc=3:30:00   # Max CPU time/prc
+#-Q- sx8brodie #PBS -l cputim_job=3:30:00   # Max CPU time/job
+#-Q- sx8brodie ##PBS -l cpunum_job=4
+#-Q- sx8brodie ##PBS -q multi
+#-Q- sx8mercure ##################
+#-Q- sx8mercure ## SX8NEC   CEA ##
+#-Q- sx8mercure ##################
+#-Q- sx8mercure #PBS -N :XXX:XXX:XXX:        # job name
+#-Q- sx8mercure #PBS -o output_XXXXXXX.1     # outputfile name
+#-Q- sx8mercure #PBS -j o                    # merge standard error and output
+#-Q- sx8mercure #PBS -S /usr/bin/ksh         # user shell
+#-Q- sx8mercure #PBS -l memsz_job=4.6gb      # Max memory
+#-Q- sx8mercure #PBS -l cputim_job=3:30:00   # Max CPU time
+#-Q- sx8mercure ##PBS -l cpunum_job=4
+########################################################################
+##
+##      Script to run a short experiment when installing the
+##      ORCA2_LIM configuration 
+##
+##            Rachid Benshila, OPA System Team
+##
+##
+#########################################################################
+##-- print echo of commands before and after shell interpretation
+date
+set -vx
+
+#################################
+# Beginning of user modification
+#################################
+
+##-- define some directories : 
+#- Input file storing 
+#-Q- sxnec R_FORCING="gaya:/u/rech/eee/reee512/NEMO"
+#-Q- sx8brodie R_FORCING="gaya:/u/rech/eee/reee512/NEMO"
+#-Q- aix R_FORCING="gaya:/u/rech/eee/reee512/NEMO"
+#-Q- sx8mercure R_FORCING="/dmnfs10/cont003/p48ethe/FORCINGS/ORCA_R2/NEMO"
+#- Launching run repository
+#-Q- sxnec R_EXPER=${QSUB_WORKDIR:-${PWD}}
+#-Q- sx8brodie R_EXPER=${PBS_O_WORKDIR}
+#-Q- aix R_EXPER=${QSUB_WORKDIR:-${PWD}}
+#-Q- sx8mercure R_EXPER=${PWD}
+#- modipsl repository
+R_EXEDIR=MMMMMMM     
+#- output files storing 
+R_SORTIE_OCE=AAAAAAA/ORCA2_OFF_PISCES
+#- execution repository
+R_TMP=$TMPDIR         
+
+##-- define processus number : to change when running in mpp
+NB_PROC=1
+
+#################################
+# End of user modification
+#################################
+
+#--  define a fonction to get the input tarfile
+#-Q- sxnec Rapatrie () { [ -f $1/$2 ] || ( rcp ${R_FORCING}/$2 $1 ; cd $1; tar xvf $2 ;) }
+#-Q- sx8brodie Rapatrie () { [ -f $1/$2 ] || ( rcp ${R_FORCING}/$2 $1 ; cd $1; tar xvf $2 ;) }
+#-Q- aix Rapatrie () { [ -f $1/$2 ] || ( rcp ${R_FORCING}/$2 $1 ; cd $1; tar xvf $2 ;) }
+#-Q- sx8mercure Rapatrie () { [ -f $1/$2 ] || ( cp ${R_FORCING}/$2 $1 ; cd $1; tar xvf $2 ;) }
+
+[ -d ${R_TMP} ] || mkdir ${R_TMP}
+cd ${R_TMP}
+
+#--  get the executable
+#-Q- sxnec rcp ${LOGNAME}@rhodes:${R_EXEDIR}/bin/opa opa.xx
+#-Q- sx8brodie rcp ${LOGNAME}@brodie:${R_EXEDIR}/bin/opa opa.xx
+#-Q- aix cp ${R_EXEDIR}/bin/opa opa.xx
+#-Q- sx8mercure cp ${R_EXEDIR}/bin/opa opa.xx
+chmod 777 opa.xx
+
+## --  Copy ancillary files
+#
+
+#- Namelist for the configuration
+cp ${R_EXPER}/namelist            namelist
+cp ${R_EXPER}/namelist_top        namelist_top
+cp ${R_EXPER}/namelist_pisces     namelist_pisces
+cp ${R_EXPER}/kRGB61.txt          kRGB61.txt
+
+ls -alF
+
+#- Files for the configuration 
+Rapatrie ${R_TMP} INPUTS_INIT_v3.tar
+Rapatrie ${R_TMP} INPUTS_DYNA_v3.tar
+Rapatrie ${R_TMP} INPUTS_PISCES_v3.tar
+
+ls -alF
+
+#-Q- sxnec export F_PROGINF=yes
+#-Q- sxnec export F_ERRCNT=5
+#-Q- sx8brodie export F_PROGINF=yes
+#-Q- sx8brodie export F_ERRCNT=5
+#-Q- sx8mercure export F_PROGINF=yes
+#-Q- sx8mercure export F_ERRCNT=5
+
+#-Q- sxnec #- To be use for a mpp run
+#-Q- sxnec #mpirun -np ${NB_PROC} ./opa.xx
+#-Q- sx8brodie #- To be use for a mpp run
+#-Q- sx8brodie #mpirun -np ${NB_PROC} ./opa.xx
+#-Q- sx8mercure #- To be use for a mpp run
+#-Q- sx8mercure #mpirun -np ${NB_PROC} ./opa.xx
+
+./opa.xx
+
+## -- Save output files
+ls -alF
+#- to copy on a storage machine
+#-Q- sxnec DPUT=mfput
+#-Q- sx8brodie DPUT=mfput
+#-Q- aix DPUT=mfput
+#-Q- sx8mercure DPUT=cp 
+#-Q- sx8mercure [ -d ${R_SORTIE_OCE} ] || mkdir -p ${R_SORTIE_OCE}
+
+#- Save ocean output files
+$DPUT *ocean.output ${R_SORTIE_OCE}/.
+$DPUT *solver.stat ${R_SORTIE_OCE}/.
+[ -f *mpp.output* ] && $DPUT *mpp.output* ${R_SORTIE_OCE}/.
+for file_netcdf in *_diad_T*.nc *_ptrc_T*.nc
+do
+$DPUT ${file_netcdf} ${R_SORTIE_OCE}/${file_netcdf}
+done
+#
+#- Save restart files
+for restart in *restart*
+do
+$DPUT ${restart} ${R_SORTIE_OCE}/${restart} 
+done
+#
+#- Save ftrace file
+[ -f ftrace.out* ] && $DPUT ftrace.out* ${R_SORTIE_OCE}/.
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-pisces.xml"/>   <!--  Ocean biology                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/field_def_nemo-pisces.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/field_def_nemo-pisces.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/field_def_nemo-pisces.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-pisces.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/file_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/file_def_nemo.xml	(revision 8732)
@@ -0,0 +1,149 @@
+<?xml version="1.0"?>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+
+   <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+        <file id="file1" name_suffix="_bioscalar" description="pisces sms variables" >
+           <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>
+           <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>
+           <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>
+           <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>
+           <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>
+           <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
+           <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+           <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
+           <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
+           <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
+           <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field>
+        </file>
+      </file_group>
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+
+	<file id="file2" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="PO4"      />
+          <field field_ref="Si"       />
+          <field field_ref="Fer"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+	</file>
+	
+	<file id="file3" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+	</file>
+
+      </file_group>
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files -->
+
+	<file id="file4" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="CaCO3"    />
+          <field field_ref="PO4"      />
+          <field field_ref="POC"      />
+          <field field_ref="Si"       />
+          <field field_ref="PHY"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="DOC"      />
+          <field field_ref="PHY2"     />
+          <field field_ref="ZOO2"     />
+          <field field_ref="DSi"      />
+          <field field_ref="Fer"      />
+          <field field_ref="BFe"      />
+          <field field_ref="GOC"      />
+          <field field_ref="SFe"      />
+          <field field_ref="DFe"      />
+          <field field_ref="GSi"      />
+          <field field_ref="NFe"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+	</file>
+
+	<file id="file5" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="PH"       />
+          <field field_ref="CO3"      />
+          <field field_ref="CO3sat"   />
+          <field field_ref="PAR"      />
+          <field field_ref="PPPHYN"    />
+          <field field_ref="PPPHYD"   />
+          <field field_ref="PPNEWN"   />
+          <field field_ref="PPNEWD"   />
+          <field field_ref="PBSi"     />
+          <field field_ref="PFeN"     />
+          <field field_ref="PFeD"     />
+          <field field_ref="xfracal"  />
+          <field field_ref="PCAL"     />
+          <field field_ref="DCAL"     />
+          <field field_ref="GRAZ1"    />
+          <field field_ref="GRAZ2"    />
+          <field field_ref="EPC100"   />
+          <field field_ref="EPFE100"  />
+          <field field_ref="EPSI100"  />
+          <field field_ref="EPCAL100" />
+          <field field_ref="Cflx"     />
+          <field field_ref="Oflx"     />
+          <field field_ref="Kg"       />
+          <field field_ref="Dpco2"    />
+          <field field_ref="Dpo2"     />
+          <field field_ref="Heup"     />
+          <field field_ref="Irondep"  />
+          <field field_ref="Ironsed"  />
+          <field field_ref="Ironice"  />
+          <field field_ref="Nfix"     />
+          <field field_ref="MuN"      />
+          <field field_ref="MuD"      />
+          <field field_ref="LNnut"    />
+          <field field_ref="LDnut"    />
+          <field field_ref="LNFe"     />
+          <field field_ref="LDFe"     />
+          <field field_ref="LNlight"  />
+          <field field_ref="LDlight"  />
+          <field field_ref="pdust"    />
+          <field field_ref="Fe2"      />
+          <field field_ref="Fe3"      />
+          <field field_ref="FeL1"     />
+          <field field_ref="FeL2"     />
+          <field field_ref="FeP"      />
+          <field field_ref="TL1"      />
+          <field field_ref="TL2"      />
+          <field field_ref="Sdenit"   />
+          <field field_ref="Totlig"   />
+	</file>
+
+      </file_group>
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,156 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  ORCA2_OFF_PISCES configuration namelist used ot overwrite SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "PISCES"  !  experience name 
+   nn_it000    =       1    !  first time step
+   nn_itend    =    1460    !  last  time step (std 5475)
+   nn_stock    =    1460    !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .true.    !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   rn_rdt      = 21600.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk )
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
+   ln_rnf      = .false.   !  runoffs
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  Bulk formulae
+!-----------------------------------------------------------------------
+   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008)
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/      
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 0      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namdta_dyn        !   offline dynamics read in files                ("key_offline")
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_tem  = 'dyna_grid_T' ,    120            , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_sal  = 'dyna_grid_T' ,    120            , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_mld  = 'dyna_grid_T' ,    120            , 'somixhgt' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_emp  = 'dyna_grid_T' ,    120            , 'sowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_fmf  = 'dyna_grid_T' ,    120            , 'iowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_ice  = 'dyna_grid_T' ,    120            , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_qsr  = 'dyna_grid_T' ,    120            , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_wnd  = 'dyna_grid_T' ,    120            , 'sowindsp' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_uwd  = 'dyna_grid_U' ,    120            , 'uocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_vwd  = 'dyna_grid_V' ,    120            , 'vocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_wwd  = 'dyna_grid_W' ,    120            , 'wocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_avt  = 'dyna_grid_W' ,    120            , 'voddmavs' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_ubl  = 'dyna_grid_U' ,    120            , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_vbl  = 'dyna_grid_V' ,    120            , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+!
+   cn_dir          = './'       !  root directory for the location of the dynamical files
+   ln_dynrnf       =  .false.   !  runoffs option enabled (T) or not (F)
+   ln_dynrnf_depth =  .false.   ! runoffs is spread in vertical (T) or not (F)
+!   fwbcorr      = 3.786e-06    ! annual global mean of empmr for ssh correction
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_cfg	(revision 8732)
@@ -0,0 +1,156 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES reference namelist 
+!!              1  - air-sea exchange                         (nampisext)
+!!              2  - biological parameters                    (nampisbio)
+!!              3  - parameters for nutrient limitations      (nampislim)    
+!!              4  - parameters for phytoplankton             (nampisprod,nampismort)
+!!              5  - parameters for zooplankton               (nampismes,nampiszoo)
+!!              6  - parameters for remineralization          (nampisrem)
+!!              7  - parameters for calcite chemistry         (nampiscal)
+!!              8  - parameters for inputs deposition         (nampissed)
+!!              11 - Damping                                  (nampisdmp)
+!-----------------------------------------------------------------------
+&nampismod     !  Model used 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisext     !   air-sea exchange
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisatm     !  Atmospheric prrssure 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisbio     !   biological parameters
+!-----------------------------------------------------------------------
+   nrdttrc    =  4        ! time step frequency for biology
+/
+!-----------------------------------------------------------------------
+&namp4zlim     !   parameters for nutrient limitations for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp5zlim     !   parameters for nutrient limitations PISCES QUOTA - ln_p5z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp5zquota    !   parameters for nutrient limitations PISCES quota - ln_p5z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisopt     !   parameters for optics
+!-----------------------------------------------------------------------
+/ 
+!-----------------------------------------------------------------------
+&namp4zprod     !   parameters for phytoplankton growth for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namp5zprod     !   parameters for phytoplankton growth for PISCES quota - ln_p5z
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!-----------------------------------------------------------------------
+&namp4zmort     !   parameters for phytoplankton sinks for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp5zmort     !   parameters for phytoplankton sinks for PISCES quota - ln_p5z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp4zmes     !   parameters for mesozooplankton for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp5zmes     !   parameters for mesozooplankton
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp4zzoo     !   parameters for microzooplankton for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namp5zzoo     !   parameters for microzooplankton
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisfer     !   parameters for iron chemistry
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------  
+&nampisrem     !   parameters for remineralization
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampispoc     !   parameters for organic particles
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampiscal     !   parameters for Calcite chemistry
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampissbc     !   parameters for inputs deposition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampislig      !  Namelist parameters for ligands, nampislig
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisice      !  Prescribed sea ice tracers
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nampisdmp     !  Damping 
+!-----------------------------------------------------------------------
+   nn_pisdmp    =  1460       !  Frequency of Relaxation
+/
+!-----------------------------------------------------------------------
+&nampismass     !  Mass conservation
+!-----------------------------------------------------------------------
+/
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES reduced (key_pisces_reduced, ex LOBSTER) : namelists
+!!              1  - biological parameters for phytoplankton    (namlobphy)
+!!              2  - biological parameters for nutrients        (namlobnut)
+!!              3  - biological parameters for zooplankton      (namlobzoo)    
+!!              4  - biological parameters for detritus         (namlobdet)
+!!              5  - biological parameters for DOM              (namlobdom)
+!!              6  - parameters from aphotic layers to sediment (namlobsed)
+!!              7  - general coefficients                       (namlobrat)
+!!              8  - optical parameters                         (namlobopt)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namlobphy     !   biological parameters for phytoplankton
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobnut     !   biological parameters for nutrients
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobzoo     !   biological parameters for zooplankton
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobdet     !   biological parameters for detritus
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobdom     !   biological parameters for DOM
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobsed     !   parameters from aphotic layers to sediment
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobrat     !   general coefficients
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlobopt     !   optical parameters
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_pisces_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg	(revision 8732)
@@ -0,0 +1,109 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+   ln_top_euler  = .true.
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   jp_bgc        =  24
+!
+   ln_pisces     =  .true.
+   ln_my_trc     =  .false.
+   ln_age        =  .false.
+   ln_cfc11      =  .false.
+   ln_cfc12      =  .false.
+   ln_c14        =  .false.
+!
+   ln_trcdta     =  .true.  !  Initialisation from data input file (T) or not (F)
+!                 !           !                                          !             !
+!                 !    name   !           title of the field             !   units     ! initial data from file or not !
+!                 !           !                                          !             !
+   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.
+   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.
+   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.
+   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.
+   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.
+   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.
+   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.
+   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.
+   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.
+   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.
+   sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.
+   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.
+   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.
+   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.
+   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.
+   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.
+   sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.
+   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.
+   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.
+   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.
+   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.
+   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   rn_trfac(1)   =   1.0e-06  !  multiplicative factor
+   rn_trfac(2)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(3)   =  44.6e-06  !  -      -      -     -
+   rn_trfac(5)   = 122.0e-06  !  -      -      -     -
+   rn_trfac(7)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(10)  =   1.0      !  -      -      -     -
+   rn_trfac(14)  =   1.0      !  -      -      -     -
+   rn_trfac(23)  =   7.6e-06  !  -      -      -     -
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_mus =  .true.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp      !   passive tracer newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_ice      !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_trd      !   diagnostics on tracer trends                       ('key_trdtrc')
+!                          or mixed-layer trends                        ('key_trdmld_trc')
+!----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bdy      !   Setup of tracer boundary conditions
+!-----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_top_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_top key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/CFCs_CMIP6.dat
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/CFCs_CMIP6.dat	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/CFCs_CMIP6.dat	(revision 8732)
@@ -0,0 +1,90 @@
+// Source   : http://www.climate-energy-college.net/cmip6  
+// Dataset  : input4MIPs_GHGConcentrations_CMIP_UoM-CMIP-1-1-0_gr3-GMNHSH_0000-2014 
+// Units    : mole_fraction_of_gas_in_air (ppt) 
+// Gas (Lifetime in yrs): CFC-11 (45) ; CFC-12 (100) ; SF6 (3200) 
+// --------------- 
+// Time    CFC11_NH   CFC11_SH   CFC12_NH   CFC12_SH     SF6_NH     SF6_SH  
+ 1931.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1932.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1933.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1934.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1935.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1936.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1937.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1938.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1939.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1940.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1941.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1942.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1943.50     0.0000     0.0000     0.0000     0.0000     0.0000     0.0000
+ 1944.50     0.0000     0.0000     0.0389     0.0000     0.0000     0.0000
+ 1945.50     0.0097     0.0000     0.6632     0.1798     0.0000     0.0000
+ 1946.50     0.1430     0.0237     1.9860     1.2854     0.0000     0.0000
+ 1947.50     0.3792     0.2208     3.1940     2.4761     0.0000     0.0000
+ 1948.50     0.5809     0.4191     4.3875     3.6625     0.0000     0.0000
+ 1949.50     0.7827     0.6174     5.5813     4.8488     0.0005     0.0000
+ 1950.50     0.9846     0.8032     6.7696     5.9949     0.0038     0.0000
+ 1951.50     1.2843     1.0094     8.2644     7.2863     0.0094     0.0015
+ 1952.50     1.7519     1.3561     9.9730     8.9158     0.0194     0.0106
+ 1953.50     2.3962     1.8627    11.8029    10.6238     0.0294     0.0206
+ 1954.50     3.1975     2.5297    13.8700    12.5378     0.0394     0.0306
+ 1955.50     4.1818     3.3538    16.1926    14.6867     0.0494     0.0406
+ 1956.50     5.4084     4.3932    18.8780    17.1363     0.0594     0.0506
+ 1957.50     6.8006     5.6782    21.9592    19.9959     0.0694     0.0606
+ 1958.50     8.1092     7.0252    25.2321    23.1365     0.0794     0.0706
+ 1959.50     9.3648     8.2294    28.7821    26.4360     0.0900     0.0800
+ 1960.50    10.9617     9.5125    32.9815    30.2292     0.1033     0.0867
+ 1961.50    13.0988    11.2369    37.7986    34.6748     0.1194     0.1006
+ 1962.50    15.8065    13.4733    43.2782    39.6754     0.1421     0.1179
+ 1963.50    19.1422    16.2919    49.7137    45.4955     0.1644     0.1456
+ 1964.50    23.1083    19.7350    57.2452    52.3544     0.1888     0.1712
+ 1965.50    27.6347    23.7849    65.7934    60.2646     0.2088     0.1912
+ 1966.50    32.6658    28.3416    75.3530    69.1428     0.2299     0.2101
+ 1967.50    38.3166    33.4164    86.1078    79.1125     0.2554     0.2246
+ 1968.50    44.7353    39.1430    98.1830    90.3364     0.2805     0.2595
+ 1969.50    52.1513    45.6939   111.6563   102.9221     0.3127     0.2873
+ 1970.50    60.6132    53.2933   126.4224   116.8759     0.3385     0.3115
+ 1971.50    69.8971    61.7959   142.2978   131.9786     0.3704     0.3396
+ 1972.50    80.2349    71.1069   159.4922   148.2202     0.4067     0.3733
+ 1973.50    92.0607    81.6845   178.4721   166.0425     0.4440     0.4059
+ 1974.50   105.1788    93.8990   199.2271   185.9014     0.4803     0.4397
+ 1975.50   117.9118   106.7517   219.8109   206.6596     0.5239     0.4761
+ 1976.50   130.3438   119.1177   239.4081   226.5863     0.5723     0.5165
+ 1977.50   142.2200   131.3714   258.2146   245.7738     0.6264     0.5627
+ 1978.50   153.1134   142.8958   276.0173   263.9851     0.6962     0.6238
+ 1979.50   162.2028   153.0742   292.3476   280.6407     0.8121     0.7279
+ 1980.50   170.5498   161.6052   307.8804   296.4841     0.9350     0.8449
+ 1981.50   179.3513   170.1257   324.9629   313.8773     1.0467     0.9533
+ 1982.50   187.9503   178.6046   340.5308   329.7557     1.1699     1.0701
+ 1983.50   196.7353   185.5994   357.7383   347.2739     1.2912     1.1888
+ 1984.50   204.7625   195.1718   371.8763   361.7221     1.4169     1.3031
+ 1985.50   215.8735   212.1934   388.1887   378.3458     1.5618     1.4381
+ 1986.50   227.5221   217.1573   407.1783   397.6461     1.7160     1.5839
+ 1987.50   240.1905   226.4808   427.9579   418.7369     1.8697     1.7303
+ 1988.50   252.0584   237.5931   453.7782   444.8680     2.0444     1.8956
+ 1989.50   262.0493   251.1293   472.3727   463.7717     2.2289     2.0710
+ 1990.50   267.5756   258.5948   486.9013   478.6108     2.4359     2.2640
+ 1991.50   271.2310   264.3494   497.7744   489.7940     2.6542     2.4657
+ 1992.50   273.8311   267.7208   509.7028   502.0332     2.8665     2.6735
+ 1993.50   273.9458   268.3918   515.6682   508.3080     3.0855     2.8944
+ 1994.50   271.7952   267.4604   521.7385   514.6896     3.3091     3.1109
+ 1995.50   269.6854   266.5223   528.0264   521.2878     3.5424     3.3176
+ 1996.50   268.0736   265.4381   534.5837   528.2323     3.7731     3.5468
+ 1997.50   266.4531   264.1306   537.7316   532.1944     3.9942     3.7858
+ 1998.50   264.9137   262.8540   540.0532   535.2809     4.2065     4.0135
+ 1999.50   263.4598   261.6319   542.0468   538.2392     4.4461     4.2712
+ 2000.50   262.1325   260.2072   544.1802   540.5858     4.6513     4.4764
+ 2001.50   260.4715   258.6281   544.8814   541.5086     4.8658     4.6879
+ 2002.50   258.4897   256.8479   545.0656   542.2464     5.0800     4.9010
+ 2003.50   256.1665   254.6592   544.6391   542.0629     5.3020     5.1137
+ 2004.50   253.8825   252.5051   543.9137   541.7823     5.5307     5.3397
+ 2005.50   251.6731   250.1566   543.1487   541.1432     5.7538     5.5583
+ 2006.50   249.4018   247.9278   541.5136   539.7864     5.9925     5.7912
+ 2007.50   247.1505   245.6772   539.3451   537.5069     6.2679     6.0601
+ 2008.50   245.2019   243.7518   537.3547   535.3132     6.5649     6.3421
+ 2009.50   243.1215   241.8001   534.7938   532.7581     6.8439     6.6128
+ 2010.50   241.1162   239.7874   532.2179   530.3461     7.1274     6.8930
+ 2011.50   238.9335   237.5581   529.4227   527.6433     7.4222     7.1925
+ 2012.50   236.8707   235.5429   526.6390   525.0289     7.7157     7.4813
+ 2013.50   235.1576   233.6041   523.8412   522.3888     8.0341     7.7876
+ 2014.50   234.0237   232.1361   521.3281   519.8338     8.3456     8.0972
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/atmc14.dat
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/atmc14.dat	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/atmc14.dat	(revision 8732)
@@ -0,0 +1,245 @@
+ Year    South 30S-30N   North 
+ 1765.5       0        0      0
+ 1766.5       0        0      0
+ 1767.5       0        0      0
+ 1768.5       0        0      0
+ 1769.5       0        0      0
+ 1770.5       0        0      0
+ 1771.5       0        0      0
+ 1772.5       0        0      0
+ 1773.5       0        0      0
+ 1774.5       0        0      0
+ 1775.5       0        0      0
+ 1776.5       0        0      0
+ 1777.5       0        0      0
+ 1778.5       0        0      0
+ 1779.5       0        0      0
+ 1780.5       0        0      0
+ 1781.5       0        0      0
+ 1782.5       0        0      0
+ 1783.5       0        0      0
+ 1784.5       0        0      0
+ 1785.5       0        0      0
+ 1786.5       0        0      0
+ 1787.5       0        0      0
+ 1788.5       0        0      0
+ 1789.5       0        0      0
+ 1790.5       0        0      0
+ 1791.5       0        0      0
+ 1792.5       0        0      0
+ 1793.5       0        0      0
+ 1794.5       0        0      0
+ 1795.5       0        0      0
+ 1796.5       0        0      0
+ 1797.5       0        0      0
+ 1798.5       0        0      0
+ 1799.5       0        0      0
+ 1800.5       0        0      0
+ 1801.5       0        0      0
+ 1802.5       0        0      0
+ 1803.5       0        0      0
+ 1804.5       0        0      0
+ 1805.5       0        0      0
+ 1806.5       0        0      0
+ 1807.5       0        0      0
+ 1808.5       0        0      0
+ 1809.5       0        0      0
+ 1810.5       0        0      0
+ 1811.5       0        0      0
+ 1812.5       0        0      0
+ 1813.5       0        0      0
+ 1814.5       0        0      0
+ 1815.5       0        0      0
+ 1816.5       0        0      0
+ 1817.5       0        0      0
+ 1818.5       0        0      0
+ 1819.5       0        0      0
+ 1820.5       0        0      0
+ 1821.5       0        0      0
+ 1822.5       0        0      0
+ 1823.5       0        0      0
+ 1824.5       0        0      0
+ 1825.5       0        0      0
+ 1826.5       0        0      0
+ 1827.5       0        0      0
+ 1828.5       0        0      0
+ 1829.5       0        0      0
+ 1830.5       0        0      0
+ 1831.5       0        0      0
+ 1832.5       0        0      0
+ 1833.5       0        0      0
+ 1834.5       0        0      0
+ 1835.5       0        0      0
+ 1836.5       0        0      0
+ 1837.5       0        0      0
+ 1838.5       0        0      0
+ 1839.5       0        0      0
+ 1840.5    -0.9     -0.9   -0.9
+ 1841.5      -1       -1     -1
+ 1842.5    -1.2     -1.2   -1.2
+ 1843.5    -1.3     -1.3   -1.3
+ 1844.5    -1.5     -1.5   -1.5
+ 1845.5    -1.6     -1.6   -1.6
+ 1846.5    -1.7     -1.7   -1.7
+ 1847.5    -1.9     -1.9   -1.9
+ 1848.5      -2       -2     -2
+ 1849.5    -2.2     -2.2   -2.2
+ 1850.5    -2.3     -2.3   -2.3
+ 1851.5    -2.5     -2.5   -2.5
+ 1852.5    -2.6     -2.6   -2.6
+ 1853.5    -2.8     -2.8   -2.8
+ 1854.5      -3       -3     -3
+ 1855.5    -3.1     -3.1   -3.1
+ 1856.5    -3.3     -3.3   -3.3
+ 1857.5    -3.6     -3.6   -3.6
+ 1858.5    -3.8     -3.8   -3.8
+ 1859.5      -4       -4     -4
+ 1860.5    -4.2     -4.2   -4.2
+ 1861.5    -4.5     -4.5   -4.5
+ 1862.5    -4.7     -4.7   -4.7
+ 1863.5    -4.9     -4.9   -4.9
+ 1864.5    -5.2     -5.2   -5.2
+ 1865.5    -5.4     -5.4   -5.4
+ 1866.5    -5.4     -5.4   -5.4
+ 1867.5    -5.4     -5.4   -5.4
+ 1868.5    -5.4     -5.4   -5.4
+ 1869.5    -5.4     -5.4   -5.4
+ 1870.5    -5.4     -5.4   -5.4
+ 1871.5    -5.3     -5.3   -5.3
+ 1872.5    -5.3     -5.3   -5.3
+ 1873.5    -5.3     -5.3   -5.3
+ 1874.5    -5.3     -5.3   -5.3
+ 1875.5    -5.3     -5.3   -5.3
+ 1876.5    -5.3     -5.3   -5.3
+ 1877.5    -5.3     -5.3   -5.3
+ 1878.5    -5.2     -5.2   -5.2
+ 1879.5    -5.2     -5.2   -5.2
+ 1880.5    -5.2     -5.2   -5.2
+ 1881.5    -5.2     -5.2   -5.2
+ 1882.5    -5.2     -5.2   -5.2
+ 1883.5    -5.1     -5.1   -5.1
+ 1884.5    -5.1     -5.1   -5.1
+ 1885.5    -5.1     -5.1   -5.1
+ 1886.5    -4.9     -4.9   -4.9
+ 1887.5    -4.8     -4.8   -4.8
+ 1888.5    -4.6     -4.6   -4.6
+ 1889.5    -4.5     -4.5   -4.5
+ 1890.5      -7     -4.5     -2
+ 1891.5      -7     -4.5     -2
+ 1892.5      -7     -4.5     -2
+ 1893.5      -7     -4.5     -2
+ 1894.5      -7     -4.5     -2
+ 1895.5      -7     -4.5     -2
+ 1896.5    -7.3     -4.8   -2.3
+ 1897.5    -7.7     -5.2   -2.7
+ 1898.5      -8     -5.5     -3
+ 1899.5    -8.3     -5.8   -3.3
+ 1900.5    -8.7     -6.2   -3.7
+ 1901.5      -9     -6.5     -4
+ 1902.5    -9.3     -6.8   -4.3
+ 1903.5    -9.7     -7.2   -4.7
+ 1904.5     -10     -7.5     -5
+ 1905.5   -10.3     -7.8   -5.3
+ 1906.5   -10.7     -8.2   -5.7
+ 1907.5     -11     -8.5     -6
+ 1908.5   -11.3     -8.8   -6.3
+ 1909.5   -11.7     -9.2   -6.7
+ 1910.5     -12     -9.5     -7
+ 1911.5   -12.3     -9.8   -7.3
+ 1912.5   -12.7    -10.2   -7.7
+ 1913.5     -13    -10.5     -8
+ 1914.5   -13.3    -10.8   -8.3
+ 1915.5   -13.7    -11.2   -8.7
+ 1916.5     -14    -11.5     -9
+ 1917.5   -14.3    -11.8   -9.3
+ 1918.5   -14.7    -12.2   -9.7
+ 1919.5     -15    -12.5    -10
+ 1920.5   -15.3    -12.8  -10.3
+ 1921.5   -15.7    -13.2  -10.7
+ 1922.5     -16    -13.5    -11
+ 1923.5   -16.3    -13.8  -11.3
+ 1924.5   -16.7    -14.2  -11.7
+ 1925.5     -17    -14.5    -12
+ 1926.5   -17.3    -14.8  -12.3
+ 1927.5   -17.7    -15.2  -12.7
+ 1928.5     -18    -15.5    -13
+ 1929.5   -18.3    -15.8  -13.3
+ 1930.5   -18.7    -16.2  -13.7
+ 1931.5     -19    -16.5    -14
+ 1932.5   -19.3    -16.8  -14.3
+ 1933.5   -19.7    -17.2  -14.7
+ 1934.5     -20    -17.5    -15
+ 1935.5   -20.3    -17.8  -15.3
+ 1936.5   -20.7    -18.2  -15.7
+ 1937.5     -21    -18.5    -16
+ 1938.5   -21.3    -18.8  -16.3
+ 1939.5   -21.7    -19.2  -16.7
+ 1940.5   -22.2    -21.5  -20.2
+ 1941.5   -21.4    -20.8  -19.4
+ 1942.5   -21.6      -21  -19.6
+ 1943.5   -24.5    -23.9  -22.5
+ 1944.5   -23.7      -23  -21.7
+ 1945.5   -24.1    -23.4  -22.1
+ 1946.5   -23.6    -22.8  -21.6
+ 1947.5   -23.1    -22.2  -21.1
+ 1948.5   -24.3    -23.4  -22.3
+ 1949.5   -26.6    -25.9  -24.6
+ 1950.5   -26.8    -26.1  -24.8
+ 1951.5   -26.8      -26  -24.8
+ 1952.5   -26.9    -25.7  -24.9
+ 1953.5   -25.9    -23.5  -23.9
+ 1954.5   -23.8    -14.4  -21.1
+ 1955.5     -11     -6.4   -8.2
+ 1956.5    14.7     23.4   26.5
+ 1957.5    35.8     51.9     73
+ 1958.5    81.8    105.7  140.2
+ 1959.5   141.1    176.8    228
+ 1960.5   185.6    200.3  212.3
+ 1961.5   198.7    205.8  221.6
+ 1962.5   215.9    256.2  358.5
+ 1963.5   330.6    474.3  718.3
+ 1964.5   520.6    672.3  835.7
+ 1965.5   637.3    697.5  756.3
+ 1966.5   619.7    658.5  691.9
+ 1967.5   585.6    605.4  623.6
+ 1968.5   549.7    559.6  564.5
+ 1969.5   528.5    537.1  545.4
+ 1970.5     506    519.1  529.1
+ 1971.5     489    495.4  499.4
+ 1972.5   461.6    466.6  465.6
+ 1973.5   430.9    426.1  418.6
+ 1974.5   394.9    400.7  400.8
+ 1975.5   378.2    378.7  369.8
+ 1976.5   349.8    354.4  352.5
+ 1977.5   326.7      330  333.9
+ 1978.5   310.2    320.6  325.8
+ 1979.5     291    296.1  295.8
+ 1980.5   274.8      272  264.5
+ 1981.5   257.5    254.8  256.7
+ 1982.5   241.1    241.1  238.3
+ 1983.5   221.5      225  224.2
+ 1984.5   206.7    209.7  209.3
+ 1985.5   197.1      204  201.1
+ 1986.5   187.4    193.9  191.1
+ 1987.5   175.5    186.5  183.6
+ 1988.5   171.6    177.6  174.7
+ 1989.5   157.3    166.6  163.7
+ 1990.5   148.3    155.1  152.2
+ 1991.5   141.2    145.3  142.4
+ 1992.5   132.2    137.6  136.3
+ 1993.5   127.2    131.8  128.7
+ 1994.5   120.4    125.5  122.1
+ 1995.5   114.9      120  115.8
+ 1996.5   110.3    109.6  109.8
+ 1997.5   105.2    109.7    104
+ 1998.5   100.2    103.2  100.3
+ 1999.5    92.7     98.6   95.7
+ 2000.5    86.5     92.6   89.7
+ 2001.5    80.7     87.6   84.8
+ 2002.5    72.9     80.4   77.5
+ 2003.5    79.5     77.4   73.5
+ 2004.5    77.7       75   70.6
+ 2005.5    75.7       73     67
+ 2006.5      75       72     66
+ 2007.5      74       71     65
+ 2008.5      73       70     64
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-pisces.xml"/>   <!--  Ocean biology                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/field_def_nemo-pisces.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/field_def_nemo-pisces.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/field_def_nemo-pisces.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-pisces.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/file_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/file_def_nemo.xml	(revision 8732)
@@ -0,0 +1,48 @@
+<?xml version="1.0"?>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+
+   <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+      </file_group>
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+      </file_group>
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files -->
+
+        <file id="file1" name_suffix="_ptrc_T" description="passive tracers variables" >
+           <field field_ref="Age"    />
+           <field field_ref="CFC11"  />
+           <field field_ref="CFC12"  />
+           <field field_ref="SF6"    />
+           <field field_ref="RC14"   />
+         </file>
+
+      </file_group>
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+   
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,158 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  ORCA2_OFF_PISCES configuration namelist used ot overwrite SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "TRACERS"  !  experience name 
+   nn_it000    =       1    !  first time step
+   nn_itend    =    1460    !  last  time step (std 1460)
+   nn_stock    =    1460    !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_date0    = 19600101  
+   ln_mskland  = .true.   !  mask land points in NetCDF outputs (costly: + ~15%)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .true.    !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   rn_rdt      = 21600.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk )
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
+   ln_rnf      = .false.   !  runoffs
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  Bulk formulae
+!-----------------------------------------------------------------------
+   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008)
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/      
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 0      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namdta_dyn        !   offline dynamics read in files                ("key_offline")
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_tem  = 'dyna_grid_T' ,    120            , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_sal  = 'dyna_grid_T' ,    120            , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_mld  = 'dyna_grid_T' ,    120            , 'somixhgt' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_emp  = 'dyna_grid_T' ,    120            , 'sowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_fmf  = 'dyna_grid_T' ,    120            , 'iowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_ice  = 'dyna_grid_T' ,    120            , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_qsr  = 'dyna_grid_T' ,    120            , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_wnd  = 'dyna_grid_T' ,    120            , 'sowindsp' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_uwd  = 'dyna_grid_U' ,    120            , 'uocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_vwd  = 'dyna_grid_V' ,    120            , 'vocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_wwd  = 'dyna_grid_W' ,    120            , 'wocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_avt  = 'dyna_grid_W' ,    120            , 'voddmavs' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_ubl  = 'dyna_grid_U' ,    120            , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+   sn_vbl  = 'dyna_grid_V' ,    120            , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , ''
+!
+   cn_dir          = './'       !  root directory for the location of the dynamical files
+   ln_dynrnf       =  .false.   !  runoffs option enabled (T) or not (F)
+   ln_dynrnf_depth =  .false.   ! runoffs is spread in vertical (T) or not (F)
+!   fwbcorr      = 3.786e-06    ! annual global mean of empmr for ssh correction
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_top_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_top_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_top_cfg	(revision 8732)
@@ -0,0 +1,71 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :   - tracer run information                (namtrc_run)
+!!               - tracer definition                     (namtrc    )
+!!               - tracer data initialisation            (namtrc_dta)
+!!               - tracer advection                      (namtrc_adv)
+!!               - tracer lateral diffusion              (namtrc_ldf)
+!!               - tracer vertical physics               (namtrc_zdf)
+!!               - tracer newtonian damping              (namtrc_dmp)
+!!               - dynamical tracer trends               (namtrc_trd)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run      !   run information
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc          !   tracers definition
+!-----------------------------------------------------------------------
+   jp_bgc        =  0           !  Number of passive tracers of the BGC model
+!
+   ln_pisces     =  .false.     !  Run PISCES BGC model
+   ln_my_trc     =  .false.     !  Run MY_TRC BGC model
+   ln_age        =  .true.      !  Run the sea water age tracer
+   ln_cfc11      =  .true.      !  Run the CFC11 passive tracer
+   ln_cfc12      =  .false.     !  Run the CFC12 passive tracer
+   ln_sf6        =  .false.     !  Run the SF6 passive tracer
+   ln_c14        =  .true.      !  Run the Radiocarbon passive tracer
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_adv      !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_fct =  .true.  !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf      !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf      !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad      !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp      !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_ice      !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_trd      !   diagnostics on tracer trends                       ('key_trdtrc')
+!                          or mixed-layer trends                        ('key_trdmld_trc')
+!----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------
+&namtrc_bdy      !   Setup of tracer boundary conditions
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_top_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_top_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_top_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_top_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_trc_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_trc_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_trc_cfg	(revision 8732)
@@ -0,0 +1,32 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! Inert tracers reference namelist 
+!!       1  - AGE                (namage)
+!!       1  - CFC                (namcfc)
+!!       2  - C14               (namc14_typ, namc14_sbc, namc14_fcg)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namage         !   AGE - dates
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namcfc     !   CFC 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namc14_typ     !  C14 - type of C14 tracer, default values of C14/C and pco2
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namc14_sbc     !  C14 - surface BC
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namc14_fcg     !  files & dates
+!               !  For Paleo-historical: specify tyrc14_beg in yr BP
+!               !  For Bomb: tyrc14_beg=0
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_trc_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_trc_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/namelist_trc_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_trc_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/splco2.dat
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/splco2.dat	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/EXP00/splco2.dat	(revision 8732)
@@ -0,0 +1,482 @@
+#  4  452
+#   Weighted smoothing spline fit
+# Ice core and Mauna Loa CO2                                       
+# 50% attenuation at     23.4968    ; REG =     100.000 
+#     Time     Smoothed data   
+ 1765.0  277.9514
+ 1765.5  277.9652
+ 1766.0  277.9797
+ 1766.5  277.9949
+ 1767.0  278.0108
+ 1767.5  278.0275
+ 1768.0  278.0448
+ 1768.5  278.0628
+ 1769.0  278.0816
+ 1769.5  278.1011
+ 1770.0  278.1213
+ 1770.5  278.1423
+ 1771.0  278.1640
+ 1771.5  278.1864
+ 1772.0  278.2096
+ 1772.5  278.2335
+ 1773.0  278.2581
+ 1773.5  278.2835
+ 1774.0  278.3097
+ 1774.5  278.3366
+ 1775.0  278.3642
+ 1775.5  278.3927
+ 1776.0  278.4218
+ 1776.5  278.4518
+ 1777.0  278.4825
+ 1777.5  278.5140
+ 1778.0  278.5463
+ 1778.5  278.5793
+ 1779.0  278.6132
+ 1779.5  278.6478
+ 1780.0  278.6832
+ 1780.5  278.7194
+ 1781.0  278.7564
+ 1781.5  278.7942
+ 1782.0  278.8327
+ 1782.5  278.8721
+ 1783.0  278.9123
+ 1783.5  278.9533
+ 1784.0  278.9951
+ 1784.5  279.0378
+ 1785.0  279.0812
+ 1785.5  279.1255
+ 1786.0  279.1706
+ 1786.5  279.2165
+ 1787.0  279.2633
+ 1787.5  279.3109
+ 1788.0  279.3593
+ 1788.5  279.4085
+ 1789.0  279.4586
+ 1789.5  279.5096
+ 1790.0  279.5614
+ 1790.5  279.6140
+ 1791.0  279.6676
+ 1791.5  279.7219
+ 1792.0  279.7772
+ 1792.5  279.8332
+ 1793.0  279.8902
+ 1793.5  279.9480
+ 1794.0  280.0067
+ 1794.5  280.0662
+ 1795.0  280.1266
+ 1795.5  280.1878
+ 1796.0  280.2499
+ 1796.5  280.3129
+ 1797.0  280.3767
+ 1797.5  280.4414
+ 1798.0  280.5069
+ 1798.5  280.5732
+ 1799.0  280.6401
+ 1799.5  280.7077
+ 1800.0  280.7759
+ 1800.5  280.8447
+ 1801.0  280.9139
+ 1801.5  280.9836
+ 1802.0  281.0537
+ 1802.5  281.1241
+ 1803.0  281.1948
+ 1803.5  281.2657
+ 1804.0  281.3369
+ 1804.5  281.4081
+ 1805.0  281.4794
+ 1805.5  281.5508
+ 1806.0  281.6221
+ 1806.5  281.6933
+ 1807.0  281.7644
+ 1807.5  281.8354
+ 1808.0  281.9060
+ 1808.5  281.9764
+ 1809.0  282.0465
+ 1809.5  282.1161
+ 1810.0  282.1853
+ 1810.5  282.2540
+ 1811.0  282.3222
+ 1811.5  282.3897
+ 1812.0  282.4566
+ 1812.5  282.5228
+ 1813.0  282.5882
+ 1813.5  282.6528
+ 1814.0  282.7166
+ 1814.5  282.7794
+ 1815.0  282.8412
+ 1815.5  282.9021
+ 1816.0  282.9619
+ 1816.5  283.0205
+ 1817.0  283.0779
+ 1817.5  283.1343
+ 1818.0  283.1896
+ 1818.5  283.2438
+ 1819.0  283.2971
+ 1819.5  283.3495
+ 1820.0  283.4011
+ 1820.5  283.4519
+ 1821.0  283.5020
+ 1821.5  283.5513
+ 1822.0  283.6001
+ 1822.5  283.6483
+ 1823.0  283.6959
+ 1823.5  283.7432
+ 1824.0  283.7900
+ 1824.5  283.8365
+ 1825.0  283.8827
+ 1825.5  283.9286
+ 1826.0  283.9745
+ 1826.5  284.0201
+ 1827.0  284.0658
+ 1827.5  284.1115
+ 1828.0  284.1573
+ 1828.5  284.2032
+ 1829.0  284.2494
+ 1829.5  284.2958
+ 1830.0  284.3426
+ 1830.5  284.3898
+ 1831.0  284.4375
+ 1831.5  284.4857
+ 1832.0  284.5346
+ 1832.5  284.5842
+ 1833.0  284.6345
+ 1833.5  284.6856
+ 1834.0  284.7376
+ 1834.5  284.7906
+ 1835.0  284.8445
+ 1835.5  284.8995
+ 1836.0  284.9557
+ 1836.5  285.0131
+ 1837.0  285.0718
+ 1837.5  285.1318
+ 1838.0  285.1932
+ 1838.5  285.2561
+ 1839.0  285.3206
+ 1839.5  285.3866
+ 1840.0  285.4543
+ 1840.5  285.5233
+ 1841.0  285.5936
+ 1841.5  285.6647
+ 1842.0  285.7366
+ 1842.5  285.8088
+ 1843.0  285.8812
+ 1843.5  285.9535
+ 1844.0  286.0255
+ 1844.5  286.0971
+ 1845.0  286.1683
+ 1845.5  286.2390
+ 1846.0  286.3091
+ 1846.5  286.3786
+ 1847.0  286.4475
+ 1847.5  286.5157
+ 1848.0  286.5831
+ 1848.5  286.6498
+ 1849.0  286.7157
+ 1849.5  286.7808
+ 1850.0  286.8451
+ 1850.5  286.9087
+ 1851.0  286.9714
+ 1851.5  287.0332
+ 1852.0  287.0943
+ 1852.5  287.1544
+ 1853.0  287.2138
+ 1853.5  287.2722
+ 1854.0  287.3298
+ 1854.5  287.3865
+ 1855.0  287.4423
+ 1855.5  287.4972
+ 1856.0  287.5515
+ 1856.5  287.6052
+ 1857.0  287.6583
+ 1857.5  287.7111
+ 1858.0  287.7635
+ 1858.5  287.8158
+ 1859.0  287.8680
+ 1859.5  287.9202
+ 1860.0  287.9725
+ 1860.5  288.0250
+ 1861.0  288.0778
+ 1861.5  288.1310
+ 1862.0  288.1848
+ 1862.5  288.2392
+ 1863.0  288.2942
+ 1863.5  288.3501
+ 1864.0  288.4070
+ 1864.5  288.4648
+ 1865.0  288.5238
+ 1865.5  288.5840
+ 1866.0  288.6455
+ 1866.5  288.7084
+ 1867.0  288.7726
+ 1867.5  288.8382
+ 1868.0  288.9053
+ 1868.5  288.9737
+ 1869.0  289.0437
+ 1869.5  289.1151
+ 1870.0  289.1880
+ 1870.5  289.2624
+ 1871.0  289.3384
+ 1871.5  289.4160
+ 1872.0  289.4954
+ 1872.5  289.5764
+ 1873.0  289.6592
+ 1873.5  289.7439
+ 1874.0  289.8304
+ 1874.5  289.9188
+ 1875.0  290.0092
+ 1875.5  290.1014
+ 1876.0  290.1957
+ 1876.5  290.2918
+ 1877.0  290.3899
+ 1877.5  290.4898
+ 1878.0  290.5917
+ 1878.5  290.6954
+ 1879.0  290.8010
+ 1879.5  290.9083
+ 1880.0  291.0174
+ 1880.5  291.1281
+ 1881.0  291.2405
+ 1881.5  291.3543
+ 1882.0  291.4697
+ 1882.5  291.5864
+ 1883.0  291.7044
+ 1883.5  291.8237
+ 1884.0  291.9442
+ 1884.5  292.0658
+ 1885.0  292.1885
+ 1885.5  292.3122
+ 1886.0  292.4368
+ 1886.5  292.5622
+ 1887.0  292.6884
+ 1887.5  292.8154
+ 1888.0  292.9430
+ 1888.5  293.0711
+ 1889.0  293.1996
+ 1889.5  293.3284
+ 1890.0  293.4572
+ 1890.5  293.5860
+ 1891.0  293.7147
+ 1891.5  293.8430
+ 1892.0  293.9709
+ 1892.5  294.0982
+ 1893.0  294.2247
+ 1893.5  294.3504
+ 1894.0  294.4751
+ 1894.5  294.5987
+ 1895.0  294.7210
+ 1895.5  294.8422
+ 1896.0  294.9626
+ 1896.5  295.0822
+ 1897.0  295.2014
+ 1897.5  295.3202
+ 1898.0  295.4390
+ 1898.5  295.5578
+ 1899.0  295.6769
+ 1899.5  295.7964
+ 1900.0  295.9167
+ 1900.5  296.0378
+ 1901.0  296.1599
+ 1901.5  296.2834
+ 1902.0  296.4082
+ 1902.5  296.5348
+ 1903.0  296.6631
+ 1903.5  296.7935
+ 1904.0  296.9261
+ 1904.5  297.0609
+ 1905.0  297.1977
+ 1905.5  297.3365
+ 1906.0  297.4772
+ 1906.5  297.6196
+ 1907.0  297.7637
+ 1907.5  297.9093
+ 1908.0  298.0562
+ 1908.5  298.2043
+ 1909.0  298.3535
+ 1909.5  298.5036
+ 1910.0  298.6545
+ 1910.5  298.8061
+ 1911.0  298.9584
+ 1911.5  299.1113
+ 1912.0  299.2648
+ 1912.5  299.4189
+ 1913.0  299.5734
+ 1913.5  299.7285
+ 1914.0  299.8839
+ 1914.5  300.0397
+ 1915.0  300.1958
+ 1915.5  300.3522
+ 1916.0  300.5088
+ 1916.5  300.6656
+ 1917.0  300.8225
+ 1917.5  300.9796
+ 1918.0  301.1368
+ 1918.5  301.2941
+ 1919.0  301.4514
+ 1919.5  301.6087
+ 1920.0  301.7659
+ 1920.5  301.9232
+ 1921.0  302.0803
+ 1921.5  302.2373
+ 1922.0  302.3942
+ 1922.5  302.5508
+ 1923.0  302.7071
+ 1923.5  302.8628
+ 1924.0  303.0179
+ 1924.5  303.1723
+ 1925.0  303.3258
+ 1925.5  303.4783
+ 1926.0  303.6298
+ 1926.5  303.7800
+ 1927.0  303.9290
+ 1927.5  304.0764
+ 1928.0  304.2224
+ 1928.5  304.3668
+ 1929.0  304.5098
+ 1929.5  304.6515
+ 1930.0  304.7920
+ 1930.5  304.9312
+ 1931.0  305.0694
+ 1931.5  305.2066
+ 1932.0  305.3428
+ 1932.5  305.4782
+ 1933.0  305.6128
+ 1933.5  305.7468
+ 1934.0  305.8803
+ 1934.5  306.0135
+ 1935.0  306.1465
+ 1935.5  306.2795
+ 1936.0  306.4126
+ 1936.5  306.5461
+ 1937.0  306.6801
+ 1937.5  306.8148
+ 1938.0  306.9503
+ 1938.5  307.0871
+ 1939.0  307.2251
+ 1939.5  307.3647
+ 1940.0  307.5059
+ 1940.5  307.6490
+ 1941.0  307.7943
+ 1941.5  307.9417
+ 1942.0  308.0917
+ 1942.5  308.2444
+ 1943.0  308.3999
+ 1943.5  308.5586
+ 1944.0  308.7204
+ 1944.5  308.8857
+ 1945.0  309.0544
+ 1945.5  309.2267
+ 1946.0  309.4026
+ 1946.5  309.5824
+ 1947.0  309.7661
+ 1947.5  309.9538
+ 1948.0  310.1455
+ 1948.5  310.3415
+ 1949.0  310.5418
+ 1949.5  310.7465
+ 1950.0  310.9557
+ 1950.5  311.1696
+ 1951.0  311.3883
+ 1951.5  311.6119
+ 1952.0  311.8406
+ 1952.5  312.0746
+ 1953.0  312.3139
+ 1953.5  312.5587
+ 1954.0  312.8091
+ 1954.5  313.0653
+ 1955.0  313.3275
+ 1955.5  313.5958
+ 1956.0  313.8704
+ 1956.5  314.1514
+ 1957.0  314.4390
+ 1957.5  314.7334
+ 1958.0  315.0347
+ 1958.5  315.3430
+ 1959.0  315.6585
+ 1959.5  315.9810
+ 1960.0  316.3099
+ 1960.5  316.6444
+ 1961.0  316.9835
+ 1961.5  317.3266
+ 1962.0  317.6732
+ 1962.5  318.0236
+ 1963.0  318.3782
+ 1963.5  318.7385
+ 1964.0  319.1062
+ 1964.5  319.4833
+ 1965.0  319.8721
+ 1965.5  320.2745
+ 1966.0  320.6922
+ 1966.5  321.1253
+ 1967.0  321.5737
+ 1967.5  322.0377
+ 1968.0  322.5174
+ 1968.5  323.0131
+ 1969.0  323.5248
+ 1969.5  324.0520
+ 1970.0  324.5937
+ 1970.5  325.1487
+ 1971.0  325.7158
+ 1971.5  326.2941
+ 1972.0  326.8828
+ 1972.5  327.4806
+ 1973.0  328.0859
+ 1973.5  328.6966
+ 1974.0  329.3108
+ 1974.5  329.9296
+ 1975.0  330.5549
+ 1975.5  331.1889
+ 1976.0  331.8340
+ 1976.5  332.4917
+ 1977.0  333.1631
+ 1977.5  333.8474
+ 1978.0  334.5436
+ 1978.5  335.2500
+ 1979.0  335.9649
+ 1979.5  336.6871
+ 1980.0  337.4153
+ 1980.5  338.1481
+ 1981.0  338.8848
+ 1981.5  339.6254
+ 1982.0  340.3708
+ 1982.5  341.1221
+ 1983.0  341.8802
+ 1983.5  342.6460
+ 1984.0  343.4197
+ 1984.5  344.2017
+ 1985.0  344.9922
+ 1985.5  345.7917
+ 1986.0  346.6006
+ 1986.5  347.4193
+ 1987.0  348.2476
+ 1987.5  349.0837
+ 1988.0  349.9257
+ 1988.5  350.7702
+ 1989.0  351.6200
+ 1989.5  352.4700
+ 1990.0  353.3200
+ 1990.5  354.1700
+ 1991.0  354.9666
+ 1991.5  355.4840
+ 1992.0  355.9125
+ 1992.5  356.2656
+ 1993.0  356.4832
+ 1993.5  356.9545
+ 1994.0  357.6902
+ 1994.5  358.6209
+ 1995.0  359.6369
+ 1995.5  360.6260
+ 1996.0  361.5229
+ 1996.5  362.3600
+ 1997.0  362.8839
+ 1997.5  363.4538
+ 1998.0  364.7527
+ 1998.5  366.5040
+ 1999.0  367.6363
+ 1999.5  368.1512
+ 2000.0  368.5849
+ 2000.5  369.4103
+ 2001.0  370.3523
+ 2001.5  371.0773
+ 2002.0  371.9717
+ 2002.5  373.1636
+ 2003.0  374.4362
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_OFF_TRC/cpp_ORCA2_OFF_TRC.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_top key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,121 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+    <field_definition src="./field_def_nemo-lim.xml"/>   <!--  LIM ice model                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/field_def_nemo-lim.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/field_def_nemo-lim.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/field_def_nemo-lim.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-lim.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml	(revision 8732)
@@ -0,0 +1,351 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1950-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
+
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->
+      
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+	
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="e3t"      />
+	  <field field_ref="toce"         name="thetao"                                                                      operation="instant" freq_op="5d" > @toce_e3t / @e3t </field>
+	  <field field_ref="soce"         name="so"                                                                          operation="instant" freq_op="5d" > @soce_e3t / @e3t </field>
+	  <field field_ref="sst"          name="tos"   />
+	  <field field_ref="sss"          name="sos"   />
+	  <field field_ref="ssh"          name="zos"   />
+	  <field field_ref="sst"          name="tosstd"       long_name="sea surface temperature standard deviation"         operation="instant" freq_op="5d" > sqrt( @sst2 - @sst * @sst ) </field>
+	  <field field_ref="ssh"          name="zosstd"       long_name="sea surface height above geoid standard deviation"  operation="instant" freq_op="5d" > sqrt( @ssh2 - @ssh * @ssh ) </field>
+	  <field field_ref="sst"          name="sstdcy"       long_name="amplitude of sst diurnal cycle"                     operation="average" freq_op="1d" > @sstmax - @sstmin </field>
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	  <field field_ref="mldr10_1"     name="mldr10_1dcy"  long_name="amplitude of mldr10_1 diurnal cycle"                operation="average" freq_op="1d" > @mldr10_1max - @mldr10_1min </field>
+	  <field field_ref="sbt"      />
+	  <field field_ref="heatc"        name="heatc" />
+	  <field field_ref="saltc"        name="saltc" />
+	</file>
+
+	<file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc -->
+	  <field field_ref="empmr"        name="wfo"      />
+      <field field_ref="emp_oce"      name="emp_oce"  long_name="Evap minus Precip over ocean"              />
+      <field field_ref="emp_ice"      name="emp_ice"  long_name="Evap minus Precip over ice"                />
+	  <field field_ref="qsr_oce"      name="qsr_oce"  />
+	  <field field_ref="qns_oce"      name="qns_oce"  />
+	  <field field_ref="qt_oce"       name="qt_oce"   />
+	  <field field_ref="qsr_ice"      name="qsr_ice"  />
+	  <field field_ref="qns_ice"      name="qns_ice"  />
+	  <field field_ref="qtr_ice"      name="qtr_ice"  />
+	  <field field_ref="qt_ice"       name="qt_ice"   />
+	  <field field_ref="saltflx"      name="sfx"      />
+	  <field field_ref="taum"         name="taum"     />
+	  <field field_ref="wspd"         name="windsp"   />
+	  <field field_ref="precip"       name="precip"   />
+	  <!-- ice and snow -->
+	  <field field_ref="snowpre" />
+	  <field field_ref="utau_ice"     name="utau_ice" />
+	  <field field_ref="vtau_ice"     name="vtau_ice" />
+	</file>
+
+	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="e3u" />
+	  <field field_ref="ssu"          name="uos"      />
+	  <field field_ref="uoce"         name="uo"       operation="instant" freq_op="5d" > @uoce_e3u / @e3u </field>
+	  <field field_ref="utau"         name="tauuo"    />
+          <!-- available with key_diaar5 -->
+	  <field field_ref="u_masstr"     name="vozomatr" />
+	  <field field_ref="u_heattr"     name="sozohetr" />
+      <field field_ref="u_salttr"     name="sozosatr" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="e3v" />
+	  <field field_ref="ssv"          name="vos"      />
+	  <field field_ref="voce"         name="vo"       operation="instant" freq_op="5d" > @voce_e3v / @e3v </field>
+	  <field field_ref="vtau"         name="tauvo"    />
+          <!-- available with key_diaar5 -->
+	  <field field_ref="v_masstr"     name="vomematr" />
+	  <field field_ref="v_heattr"     name="somehetr" />
+      <field field_ref="v_salttr"     name="somesatr" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="e3w" />
+	  <field field_ref="woce"         name="wo"       />
+	  <field field_ref="avt"          name="difvho"   />
+	  <field field_ref="w_masstr"     name="vovematr" />
+	</file>
+
+	<file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." >
+          <field field_ref="snowthic_cea"    name="snthic" />
+          <field field_ref="icethic_cea"     name="sithic" />
+          <field field_ref="icevolu"         name="sivolu" />
+          <field field_ref="snowvol"         name="snvolu" />
+          <field field_ref="iceconc"         name="siconc" />
+
+          <field field_ref="vfxbog"          name="vfxbog" />
+          <field field_ref="vfxdyn"          name="vfxdyn" />
+          <field field_ref="vfxopw"          name="vfxopw" />
+          <field field_ref="vfxsni"          name="vfxsni" />
+          <field field_ref="vfxsum"          name="vfxsum" />
+          <field field_ref="vfxbom"          name="vfxbom" />
+          <field field_ref="vfxres"          name="vfxres" />
+          <field field_ref="vfxice"          name="vfxice" />
+          <field field_ref="vfxsnw"          name="vfxsnw" />
+          <field field_ref="vfxsub"          name="vfxsub" />
+          <field field_ref="vfxspr"          name="vfxspr" />
+
+          <field field_ref="icetrp"          name="sivtrp" />
+          <field field_ref="snwtrp"          name="snvtrp" />
+          <field field_ref="saltrp"          name="saltrp" />
+          <field field_ref="deitrp"          name="deitrp" />
+          <field field_ref="destrp"          name="destrp" />
+
+          <field field_ref="sfxbri"          name="sfxbri" />
+          <field field_ref="sfxdyn"          name="sfxdyn" />
+          <field field_ref="sfxres"          name="sfxres" />
+          <field field_ref="sfxbog"          name="sfxbog" />
+          <field field_ref="sfxbom"          name="sfxbom" />
+          <field field_ref="sfxsum"          name="sfxsum" />
+          <field field_ref="sfxsni"          name="sfxsni" />
+          <field field_ref="sfxopw"          name="sfxopw" />
+          <field field_ref="sfx"             name="sfx"    />
+
+          <field field_ref="hfxsum"          name="hfxsum"     />
+          <field field_ref="hfxbom"          name="hfxbom"     />
+          <field field_ref="hfxbog"          name="hfxbog"     />
+          <field field_ref="hfxdif"          name="hfxdif"     />
+          <field field_ref="hfxopw"          name="hfxopw"     />
+          <field field_ref="hfxout"          name="hfxout"     />
+          <field field_ref="hfxin"           name="hfxin"      />
+          <field field_ref="hfxsnw"          name="hfxsnw"     />
+          <field field_ref="hfxerr"          name="hfxerr"     />
+          <field field_ref="hfxerr_rem"      name="hfxerr_rem" />
+
+	  <!-- ice-ocean heat flux from mass exchange -->
+          <field field_ref="hfxdyn"          name="hfxdyn" />
+          <field field_ref="hfxres"          name="hfxres" />
+          <field field_ref="hfxthd"          name="hfxthd" />
+	  <!-- ice-atm. heat flux from mass exchange -->
+          <field field_ref="hfxsub"          name="hfxsub" />
+          <field field_ref="hfxspr"          name="hfxspr" />
+
+	  <!-- diags -->
+          <field field_ref="hfxdhc"          name="hfxdhc" />
+          <field field_ref="hfxtur"          name="hfxtur" />
+
+          <field field_ref="isst"            name="sst"    />
+          <field field_ref="isss"            name="sss"    />
+          <field field_ref="micesalt"        name="sisali" />
+          <field field_ref="micet"           name="sitemp" />
+          <field field_ref="icest"           name="sistem" />
+          <field field_ref="icehc"           name="siheco" />
+          <field field_ref="isnowhc"         name="snheco" />
+          <field field_ref="miceage"         name="siages" />
+
+          <field field_ref="uice_ipa"        name="sivelu" />
+          <field field_ref="vice_ipa"        name="sivelv" />
+          <field field_ref="icevel"          name="sivelo" />
+          <field field_ref="idive"           name="sidive" />
+          <field field_ref="ishear"          name="sishea" />
+          <field field_ref="icestr"          name="sistre" />
+
+          <field field_ref="ibrinv"          name="sibrin" />
+          <field field_ref="icecolf"         name="sicolf" />
+
+          <field field_ref="iceage_cat"      name="siagecat" />
+          <field field_ref="iceconc_cat"     name="siconcat" />
+          <field field_ref="icethic_cat"     name="sithicat" />
+          <field field_ref="snowthic_cat"    name="snthicat" />
+          <field field_ref="salinity_cat"    name="salincat" />
+          <field field_ref="brinevol_cat"    name="sibricat" />
+	  <field field_ref="icetemp_cat"     name="sitemcat" />
+	  <field field_ref="snwtemp_cat"     name="sntemcat" />
+
+	</file>
+
+        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." >
+          <field field_ref="voltot"       name="scvoltot"   />
+          <field field_ref="sshtot"       name="scsshtot"   />
+          <field field_ref="sshsteric"    name="scsshste"   />
+          <field field_ref="sshthster"    name="scsshtst"   />
+          <field field_ref="masstot"      name="scmastot"   />
+          <field field_ref="temptot"      name="sctemtot"   />
+          <field field_ref="saltot"       name="scsaltot"   />
+
+          <field field_ref="bgtemper"     name="bgtemper"   />
+          <field field_ref="bgsaline"     name="bgsaline"   />
+          <field field_ref="bgheatco"     name="bgheatco"   />
+          <field field_ref="bgsaltco"     name="bgsaltco"   />
+          <field field_ref="bgvolssh"     name="bgvolssh"   /> 
+          <field field_ref="bgvole3t"     name="bgvole3t"   />
+          <field field_ref="bgfrcvol"     name="bgfrcvol"   />
+          <field field_ref="bgfrctem"     name="bgfrctem"   />
+          <field field_ref="bgfrcsal"     name="bgfrcsal"   />
+
+          <field field_ref="ibgvoltot"    name="ibgvoltot"  />
+          <field field_ref="sbgvoltot"    name="sbgvoltot"  />
+          <field field_ref="ibgarea"      name="ibgarea"    />
+          <field field_ref="ibgsaline"    name="ibgsaline"  />
+          <field field_ref="ibgtemper"    name="ibgtemper"  />
+          <field field_ref="ibgheatco"    name="ibgheatco"  />
+          <field field_ref="sbgheatco"    name="sbgheatco"  />
+          <field field_ref="ibgsaltco"    name="ibgsaltco"  />
+
+          <field field_ref="ibgvfx"       name="ibgvfx"     />
+          <field field_ref="ibgvfxbog"    name="ibgvfxbog"  />
+          <field field_ref="ibgvfxopw"    name="ibgvfxopw"  />
+          <field field_ref="ibgvfxsni"    name="ibgvfxsni"  />
+          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"  />
+          <field field_ref="ibgvfxbom"    name="ibgvfxbom"  />
+          <field field_ref="ibgvfxsum"    name="ibgvfxsum"  />
+          <field field_ref="ibgvfxres"    name="ibgvfxres"  />
+          <field field_ref="ibgvfxspr"    name="ibgvfxspr"  />
+          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"  />
+          <field field_ref="ibgvfxsub"    name="ibgvfxsub"  />
+
+          <field field_ref="ibgsfx"       name="ibgsfx"     />
+          <field field_ref="ibgsfxbri"    name="ibgsfxbri"  />
+          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn"  />
+          <field field_ref="ibgsfxres"    name="ibgsfxres"  />
+          <field field_ref="ibgsfxbog"    name="ibgsfxbog"  />
+          <field field_ref="ibgsfxopw"    name="ibgsfxopw"  />
+          <field field_ref="ibgsfxsni"    name="ibgsfxsni"  />
+          <field field_ref="ibgsfxbom"    name="ibgsfxbom"  />
+          <field field_ref="ibgsfxsum"    name="ibgsfxsum"  />
+
+          <field field_ref="ibghfxdhc"    name="ibghfxdhc"  />
+          <field field_ref="ibghfxspr"    name="ibghfxspr"  />
+
+          <field field_ref="ibghfxres"    name="ibghfxres"  />
+          <field field_ref="ibghfxsub"    name="ibghfxsub"  />
+          <field field_ref="ibghfxdyn"    name="ibghfxdyn"  />
+          <field field_ref="ibghfxthd"    name="ibghfxthd"  />
+          <field field_ref="ibghfxsum"    name="ibghfxsum"  />
+          <field field_ref="ibghfxbom"    name="ibghfxbom"  />
+          <field field_ref="ibghfxbog"    name="ibghfxbog"  />
+          <field field_ref="ibghfxdif"    name="ibghfxdif"  />
+          <field field_ref="ibghfxopw"    name="ibghfxopw"  />
+          <field field_ref="ibghfxout"    name="ibghfxout"  />
+          <field field_ref="ibghfxin"     name="ibghfxin"   />
+          <field field_ref="ibghfxsnw"    name="ibghfxsnw"  />
+
+          <field field_ref="ibgfrcvol"    name="ibgfrcvol"  />
+          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  />
+          <field field_ref="ibgvolgrm"    name="ibgvolgrm"  />
+
+        </file>
+
+	<!--
+	<file id="file8" name_suffix="_Tides" description="tidal harmonics" >
+	  <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       />
+	  <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  />
+	  <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       />
+	  <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  />
+	  <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       />
+	  <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  />
+	</file>
+	-->
+
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
+    </grid_definition>   
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">50000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,242 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2_SAS"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =     100   !  last  time step (std 5475)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .true.    !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    0      !  create (>0) a mesh file or not (=0)
+   !
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk )
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  Bulk formulae
+!-----------------------------------------------------------------------
+   ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008)
+/
+!-----------------------------------------------------------------------
+&namsbc_sas    !   Stand-Alone Surface module
+!-----------------------------------------------------------------------
+/      
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg	(revision 8732)
@@ -0,0 +1,48 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Diagnostics                        (namicediag)
+!!              3 - Ice initialization                 (namiceini)
+!!              4 - Ice discretization                 (namiceitd)
+!!              5 - Ice dynamics and transport         (namicedyn)
+!!              6 - Ice diffusion                      (namicehdf)
+!!              7 - Ice thermodynamics                 (namicethd)
+!!              8 - Ice salinity                       (namicesal)
+!!              9 - Ice mechanical redistribution      (namiceitdme)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicediag    !   Diagnostics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ice_lim3_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_trabbl key_lim3  key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/README-setup-configs
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/README-setup-configs	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/README-setup-configs	(revision 8732)
@@ -0,0 +1,53 @@
+==============================================================
+== HOW TO set up user’s configuration in NEMO version 4.0 : ==
+==============================================================
+This document describes how a configuration is set up in NEMO.
+
+In NEMO 4.0 two types of configurations can be build: global/regional and idealized.
+
+- create NEMOGCM/CONFIG/your_config
+- case 1: regional or global 
+    => ln_read_cfg = .true. in NEMOGCM/CONFIG/your_config/EXP00/namelist_cfg (i.e. read domain_cfg.nc)
+- case 2: idealized 
+    =>in NEMOGCM/CONFIG/your_config/EXP00/namelist_cfg :
+      ln_read_cfg = .false. (need to define usrdef_hgr.F90 and usrdef_zgr.F90) 
+      ln_usr = .true.       (need to define usrdef_sbc.F90)    
+    => copy NEMOGCM/NEMO/OPA_SRC/USR in NEMOGC/CONFIG/your_config/MY_SRC routines nedeed to set up domain, forcing fields and initial state
+    
+  Routines in NEMOGCM/NEMO/OPA_SRC/USR define analytically the domain, the initial state and the surface boundary conditions for the reference configuration GYRE.
+	  •	usrdef_hgr.F90 and usrdef_zgr.F90 : define horizontal and vertical grid
+	  •	usrdef_sbc.F90    : provides at each time-step the surface boundary condition, i.e. the momentum, heat and freshwater fluxes
+	  •	usrdef_istate.F90 : defines initialization of the dynamics and tracers
+	  •	usrdef_fmask.F90  : used just in ORCA CONFIGURATIONS for alteration of f-point land/ocean mask in some straits 
+	  •	usrdef_closea.F90 : used just in ORCA CONFIGURATIONS for specific treatments associated with closed seas
+	  •	usrdef_nam.F90    : set the domain characteristics of a user configuration
+
+  Other analytical examples are given in NEMOGCM/CONFIG/TEST_CASES.
+
+===========================================
+== The domain_cfg.nc file must contain : ==
+===========================================
+   int ORCA  , ORCA_index            : configuration name, configuration resolution
+   int jpiglo, jpjglo , jpkglo       : global domain sizes 
+   int jperio                        : lateral global domain b.c. 
+   int ln_zco, ln_zps, ln_sco        : flags for z-coordinate, z-coordinate with partial steps and s-coordinate 
+   int ln_isfcav                     : flag  for ice shelf cavities 
+   double glamt, glamu, glamv, glamf : geographic position 
+   double gphit, gphiu, gphiv, gphif : geographic position
+   double iff, ff_f, ff_t            : Coriolis parameter (if not on the sphere)
+   double e1t, e1u, e1v, e1f         : horizontal scale factors
+   double e2t, e2u, e2v, e2f         : horizontal scale factors
+   double ie1e2u_v, e1e2u, e1e2v     : U and V surfaces (if grid size reduction in some straits)
+   double e3t_1d, e3w_1d             : reference vertical scale factors at T and W points
+   double e3t_0, e3u_0, e3v_0, e3f_0, e3w_0 : vertical scale factors 3D coordinate at T,U,V,F and W points
+   double e3uw_0,e3vw_0              : vertical scale factors 3D coordinate at UW and VW points
+   int bottom_level, top_level       : last wet T-points, 1st wet T-points (for ice shelf cavities)
+
+=======================================
+= HOW TO CREATE domain_cfg.nc file : ==
+=======================================
+Two options are possible :
+
+ - users can create with his own tool the domain_cfg.nc with all mandatory fields.  
+
+ - tool is available in NEMOGCM/TOOLS/DOMAINcfg based on NEMO 3.6 version. See NEMOGCM/TOOLS/DOMAINcfg/README.
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/1_namelist_ice_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/1_namelist_ice_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/1_namelist_ice_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link namelist_ice_lim3_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/1_namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/1_namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/1_namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/README_configs_namcfg_namdom
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/README_configs_namcfg_namdom	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/README_configs_namcfg_namdom	(revision 8732)
@@ -0,0 +1,609 @@
+
+
+This README file contains the informations for the &namcfg namelist for some configurations whic are not one of the reference configurations.
+These informations wher previoulsy in NEMO/OPA_SRC_par_*.h90 files. The full test with these configurations has not been done.
+
+
+ORCA_R4
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       4               !  resolution of the configuration
+   jpidta      =      92               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      76               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =      92               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      76               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+ORCA_R1 75 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     103.9530096000000 ! (default coefficients)
+   ppa1        =       2.415951269000000   !
+   ppkth       =      15.35101370000000    !
+   ppacr       =       7.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =   .TRUE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =     100.7609285000000 !  Double tanh function parameters
+   ppkth2      =      48.02989372000000    !
+   ppacr2      =      13.00000000000   !
+/
+
+
+ORCA_R1 46 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      46               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999998.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999998.0             ! (default coefficients)
+   ppa1        =  999998.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5750.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+ORCA_R05 
+========
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =      05               !  resolution of the configuration
+   jpidta      =     722               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     722               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     511               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+ORCA_R05 Antarctic zoom
+========
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "antarctic"          !  name of the zoom of configuration
+   jp_cfg      =      05               !  resolution of the configuration
+   jpidta      =     722               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     722               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     187               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+ORCA_R05 Arctic zoom
+========
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "arctic"             !  name of the zoom of configuration
+   jp_cfg      =      05               !  resolution of the configuration
+   jpidta      =     722               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     562               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     211               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =      81               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =     301               !  in data domain indices
+   jperio      =       5               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+ORCA2 - Antarctic zoom
+======================
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "antarctic"          !  name of the zoom of configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      50               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+
+
+ORCA2 - Arctic zoom
+=================== 
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "arctic"             !  name of the zoom of configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     142               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      53               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =      21               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =      97               !  in data domain indices
+   jperio      =       3               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+
+
+ORCA025 - 75 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =     025               !  resolution of the configuration
+   jpidta      =    1442               !  1st lateral dimension ( >= jpi )
+   jpjdta      =    1021               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =    1442               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =    1021               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =    103.9530096000000  ! (default coefficients)
+   ppa1        =      2.415951269000000  !
+   ppkth       =     15.35101370000000 !
+   ppacr       =       7.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =   .TRUE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =     100.7609285000000 !  Double tanh function parameters
+   ppkth2      =      48.02989372000000  !
+   ppacr2      =      13.              !
+/
+
+
+ORCA025 - 46 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =    1442               !  resolution of the configuration
+   jpidta      =    1021               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      46               !  number of levels      ( >= jpk )
+   jpiglo      =    1442               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =    1021               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999998.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999998.0             ! (default coefficients)
+   ppa1        =  999998.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5750.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+EEL R2: channel
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "eel"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =      83               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     242               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      30               !  number of levels      ( >= jpk )
+   jpiglo      =      83               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     242               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       3               !  type of horizontal mesh
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      35.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =    2000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    2000.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -2033.194295283385  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     155.8325369664153 ! (default coefficients)
+   ppa1        =     146.3615918601890 !
+   ppkth       =      17.28520372419791  !
+   ppacr       =       5.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+EEL R5: channel
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "eel"               !  name of the configuration
+   jp_cfg      =       5               !  resolution of the configuration
+   jpidta      =      66               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      66               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =      66               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      66               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       2               !  type of horizontal mesh
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      43.436430714     ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =    8000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    8000.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+EEL R6: 6 km resolution channel
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "eel"               !  name of the configuration
+   jp_cfg      =       6               !  resolution of the configuration
+   jpidta      =      29               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      83               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      30               !  number of levels      ( >= jpk )
+   jpiglo      =      29               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      83               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       3               !  type of horizontal mesh
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      35.              ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =    6000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    6000.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -2033.194295283385  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     155.8325369664153 ! (default coefficients)
+   ppa1        =     146.3615918601890 !
+   ppkth       =      17.28520372419791   !
+   ppacr       =       5.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+POMME: 025
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "pomme"             !  name of the configuration
+   jp_cfg      =     025               !  resolution of the configuration
+   jpidta      =      30               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      40               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      46               !  number of levels      ( >= jpk )
+   jpiglo      =      30               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      40               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999998.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999998.0             ! (default coefficients)
+   ppa1        =  999998.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5750.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+C1D - 1D configuration. Add key_c1d in active cpp keys
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =       3               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =       3               !  2nd    -                  -    --> j  =jpjdta
+! Choose postion of the 1D column: 
+!            jpizoom =   61, jpjzoom =   133  (160W,75N)
+!            jpizoom =   61, jpjzoom =   110  (160W,50N)
+!            jpizoom =   61, jpjzoom =   97   (160W,30N)
+!            jpizoom =   61, jpjzoom =   86   (160W,10N)
+!            jpizoom =   61, jpjzoom =   49   (160W,30S)
+!            jpizoom =   61, jpjzoom =   27   (160W,60S)
+!            jpizoom =   61, jpjzoom =    7   (160W,75S)
+!            jpizoom =   110,jpjzoom =   97   (64W,31.5N) BATS site
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,258 @@
+
+   <domain_definition>
+      <domain_group id="grid_T">
+         <domain id="grid_T" long_name="grid T"/>
+	 <!--   My zoom: example of hand defined zoom   -->
+
+         <domain id="moorT"   ibegin="39" jbegin="82" ni="1"  nj="1" />
+
+         <domain id="sec01T"  ibegin="33"  jbegin="62" ni="28" nj="1" />
+         <domain id="sec02T"  ibegin="34" jbegin="68" ni="27" nj="1" />
+         <domain id="sec03T"  ibegin="29"  jbegin="75" ni="18" nj="1" />
+         <domain id="sec04T"  ibegin="29"  jbegin="80" ni="16" nj="1" />
+         <domain id="sec05T"  ibegin="25"  jbegin="88" ni="12" nj="1" />
+         <domain id="sec06T"  ibegin="25"  jbegin="91" ni="7" nj="1" />
+         <domain id="sec07T"  ibegin="25"  jbegin="92" ni="3" nj="1" />
+         <domain id="sec08T"  ibegin="57" jbegin="77" ni="4" nj="1" />
+         <domain id="sec09T"  ibegin="61" jbegin="62" ni="1"  nj="15" />
+
+         <domain id="sec00ST" ibegin="2"   jbegin="2"   ni="115" nj="1"   />
+         <domain id="sec00NT" ibegin="2"   jbegin="104" ni="115" nj="1"   />
+         <domain id="sec00WT" ibegin="2"   jbegin="2"   ni="1"   nj="103" />
+         <domain id="sec00ET" ibegin="116" jbegin="2"   ni="1"   nj="103" />
+
+	 <domain id="1point" domain_ref="grid_T" >
+           <zoom_domain id="1point" ibegin="139" jbegin="119" ni="1" nj="1" />
+	 </domain>
+         <!--   Eq section -->
+	 <domain id="EqT" domain_ref="grid_T" >
+           <zoom_domain id="EqT" ibegin="0" jbegin="0000" ni="0000" nj="1" />
+         </domain>
+         <!--   TAO : see example above   -->
+         <!--   137e   -->
+         <!-- <domain id="2n137eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n137eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n137eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   147e   -\-> -->
+         <!-- <domain id="0n147eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n147eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n147eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   156e   -\-> -->
+         <!-- <domain id="5s156eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s156eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n156eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n156eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n156eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n156eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   165e   -\-> -->
+         <!-- <domain id="8s165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n165eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   180w   -\-> -->
+         <!-- <domain id="8s180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n180wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   170w   -\-> -->
+         <!-- <domain id="8s170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n170wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   155w   -\-> -->
+         <!-- <domain id="8s155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n155wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   140w   -\-> -->
+         <!-- <domain id="8s140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n140wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   125w   -\-> -->
+         <!-- <domain id="8s125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n125wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   110w   -\-> -->
+         <!-- <domain id="8s110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n110wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   95w   -\-> -->
+         <!-- <domain id="8s95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2s95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="2n95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5n95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n95wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   RAMA   -\-> -->
+         <!-- <\!--   55e   -\-> -->
+         <!-- <domain id="16s55eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12s55eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8s55eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4s55eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5s55eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n55eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5n55eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4n55eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!--    <\!--   65e   -\-> -->
+         <!-- <domain id="15n65eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!--    <\!--   67e   -\-> -->
+         <!-- <domain id="16s67eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12s67eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8s67eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4s67eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5s67eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n67eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5n67eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4n67eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n67eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   80.5e   -\-> -->
+         <!-- <domain id="16s80.5eT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12s80.5eT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8s80.5eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4s80.5eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5s80.5eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n80.5eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5n80.5eT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4n80.5eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   90e   -\-> -->
+         <!-- <domain id="1.5s90eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n90eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="1.5n90eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4n90eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n90eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12n90eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="15n90eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   95e   -\-> -->
+         <!-- <domain id="16s95eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12s95eT"    domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8s95eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="5s95eT"     domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   PIRATA   -\-> -->
+         <!-- <\!--   38w-30w   -\-> -->
+         <!-- <domain id="19s34wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="14s32wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8s30wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n35wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4n38wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="8n38wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12n38wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="15n38wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="20n38wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   23w   -\-> -->
+         <!-- <domain id="0n23wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="4n23wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="12n23wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="21n23wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   10w   -\-> -->
+         <!-- <domain id="10s10wT" domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="6s10wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <domain id="0n10wT"  domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+         <!-- <\!--   0e   -\-> -->
+         <!-- <domain id="0n0eT"   domain_ref="grid_T" ibegin="0000" jbegin="0000" ni="1" nj="1" /> -->
+	 
+      </domain_group>
+
+      <domain_group id="grid_U">
+         <domain id="grid_U" long_name="grid U"/>
+	 <!--   My zoom: example of hand defined zoom   -->
+         <domain id="moorU"   ibegin="39" jbegin="82" ni="1"  nj="1" />
+         <domain id="sec01U"  ibegin="33"  jbegin="62" ni="28" nj="1" />
+         <domain id="sec02U"  ibegin="34" jbegin="68" ni="27" nj="1" />
+         <domain id="sec03U"  ibegin="29"  jbegin="75" ni="18" nj="1" />
+         <domain id="sec04U"  ibegin="29"  jbegin="80" ni="16" nj="1" />
+         <domain id="sec05U"  ibegin="25"  jbegin="88" ni="12" nj="1" />
+         <domain id="sec06U"  ibegin="25"  jbegin="91" ni="7" nj="1" />
+         <domain id="sec07U"  ibegin="25"  jbegin="92" ni="3" nj="1" />
+         <domain id="sec08U"  ibegin="57" jbegin="77" ni="4" nj="1" />
+         <domain id="sec09U"  ibegin="61" jbegin="62" ni="1"  nj="15" />
+
+         <domain id="sec00SU" ibegin="2"   jbegin="2"   ni="115" nj="1"   />
+         <domain id="sec00NU" ibegin="2"   jbegin="104" ni="115" nj="1"   />
+         <domain id="sec00WU" ibegin="2"   jbegin="2"   ni="1"   nj="103" />
+         <domain id="sec00EU" ibegin="116" jbegin="2"   ni="1"   nj="103" />
+         <!--   Eq section   -->
+         <domain id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+
+      </domain_group>
+      
+      <domain_group id="grid_V">
+  	 <domain id="grid_V" long_name="grid V"/>
+ 	 <!--   My zoom: example of hand defined zoom   -->
+         <domain id="moorV"   ibegin="39" jbegin="82" ni="1"  nj="1" />
+         <domain id="sec01V"  ibegin="33"  jbegin="62" ni="28" nj="1" />
+         <domain id="sec02V"  ibegin="34" jbegin="68" ni="27" nj="1" />
+         <domain id="sec03V"  ibegin="29"  jbegin="75" ni="18" nj="1" />
+         <domain id="sec04V"  ibegin="29"  jbegin="80" ni="16" nj="1" />
+         <domain id="sec05V"  ibegin="25"  jbegin="88" ni="12" nj="1" />
+         <domain id="sec06V"  ibegin="25"  jbegin="91" ni="7" nj="1" />
+         <domain id="sec07V"  ibegin="25"  jbegin="92" ni="3" nj="1" />
+         <domain id="sec08V"  ibegin="57" jbegin="77" ni="4" nj="1" />
+         <domain id="sec09V"  ibegin="61" jbegin="62" ni="1"  nj="15" />
+
+         <domain id="sec00SV" ibegin="2"   jbegin="2"   ni="115" nj="1"   />
+         <domain id="sec00NV" ibegin="2"   jbegin="104" ni="115" nj="1"   />
+         <domain id="sec00WV" ibegin="2"   jbegin="2"   ni="1"   nj="103" />
+         <domain id="sec00EV" ibegin="116" jbegin="2"   ni="1"   nj="103" />
+      </domain_group>
+
+      <domain_group id="grid_W">
+         <domain id="grid_W" long_name="grid W"/>
+	 <!--   My zoom: example of hand defined zoom   -->
+         <domain id="moorW"   ibegin="39" jbegin="82" ni="1"  nj="1" />
+         <domain id="sec01W"  ibegin="33"  jbegin="62" ni="28" nj="1" />
+         <domain id="sec02W"  ibegin="34" jbegin="68" ni="27" nj="1" />
+         <domain id="sec03W"  ibegin="29"  jbegin="75" ni="18" nj="1" />
+         <domain id="sec04W"  ibegin="29"  jbegin="80" ni="16" nj="1" />
+         <domain id="sec05W"  ibegin="25"  jbegin="88" ni="12" nj="1" />
+         <domain id="sec06W"  ibegin="25"  jbegin="91" ni="7" nj="1" />
+         <domain id="sec07W"  ibegin="25"  jbegin="92" ni="3" nj="1" />
+         <domain id="sec08W"  ibegin="57" jbegin="77" ni="4" nj="1" />
+         <domain id="sec09W"  ibegin="61" jbegin="62" ni="1"  nj="15" />
+
+         <domain id="sec00SW" ibegin="2"   jbegin="2"   ni="115" nj="1"   />
+         <domain id="sec00NW" ibegin="2"   jbegin="104" ni="115" nj="1"   />
+         <domain id="sec00WW" ibegin="2"   jbegin="2"   ni="1"   nj="103" />
+         <domain id="sec00EW" ibegin="116" jbegin="2"   ni="1"   nj="103" />
+         <!--   Eq section   -->
+         <domain id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </domain_group>
+
+      <domain_group id="scalarpoint">
+         <domain id="scalarpoint" long_name="scalar"/>
+      </domain_group>
+
+      <domain_group id="gznl">
+        <domain id="gznl" long_name="gznl"/>
+        <domain id="ptr" domain_ref="gznl" >
+          <zoom_domain id="ptr" ibegin="0000" jbegin="0" ni="1" nj="0000" />
+        </domain>
+      </domain_group>
+      
+
+   </domain_definition>    
+ 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml	(revision 8732)
@@ -0,0 +1,183 @@
+<?xml version="1.0"?> 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+      <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+         <!-- LIM2(only) fields -->
+         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
+         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
+         <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             standard_name="surface_downward_latent_heat_flux"                  unit="W/m2"         />         
+         <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
+         <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
+         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                                                                                   unit="m/s"          />
+         <field id="iiceconc"     long_name="Ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="1"            />
+         <field id="ice_pres"     long_name="Ice presence"                                                                                                                    unit=""             />
+         <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       standard_name="surface_temperature"                                unit="degC"         />
+         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               standard_name="surface_temperature"                                unit="degC"         />
+         <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          standard_name="sea_ice_x_transport"                                unit="kg/s"         />
+         <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          standard_name="sea_ice_y_transport"                                unit="kg/s"         />
+
+         <!-- LIM3 fields -->  
+         <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            />
+ 
+         <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                standard_name="surface_snow_thickness"                             unit="m"            />
+         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 standard_name="sea_ice_thickness"                                  unit="m"            />
+
+         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  standard_name="sea_ice_x_velocity"                                 unit="m/s"          />      
+         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  standard_name="sea_ice_y_velocity"                                 unit="m/s"          />               
+         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             standard_name="surface_downward_x_stress"                          unit="N/m2"         />
+         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             standard_name="surface_downward_y_stress"                          unit="N/m2"         />
+         
+         <field id="iceconc"      long_name="ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="%"            />
+       	 <field id="isst"         long_name="sea surface temperature"                                      standard_name="sea_surface_temperature"                            unit="degC"         />
+         <field id="isss"         long_name="sea surface salinity"                                         standard_name="sea_surface_salinity"                               unit="1e-3"         /> 
+         <field id="qt_oce"       long_name="total flux at ocean surface"                                  standard_name="surface_downward_heat_flux_in_sea_water"            unit="W/m2"         />
+         <field id="qsr_oce"      long_name="solar heat flux at ocean surface"                             standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
+         <field id="qns_oce"      long_name="non-solar heat flux at ocean surface"                                                                                            unit="W/m2"         />
+         <field id="qt_ice"       long_name="total heat flux at ice surface: sum over categories"          standard_name="surface_downward_heat_flux_in_air"                  unit="W/m2"         />
+         <field id="qsr_ice"      long_name="solar heat flux at ice surface: sum over categories"          standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
+         <field id="qns_ice"      long_name="non-solar heat flux at ice surface: sum over categories"                                                                         unit="W/m2"         />
+         <field id="qtr_ice"      long_name="solar heat flux transmitted through ice: sum over categories"                                                                    unit="W/m2"         />
+         <field id="qemp_ice"     long_name="Downward Heat Flux from E-P over ice"                                                                                            unit="W/m2"         />
+         <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         />
+         <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        />
+         <field id="alb_ice"      long_name="Mean albedo over sea ice"                                                                                                        unit=""             />
+         <field id="albedo"       long_name="Mean albedo over sea ice and ocean"                                                                                              unit=""             />
+
+         <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   grid_ref="grid_T_3D_ncatice" />
+         <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      grid_ref="grid_T_3D_ncatice" />
+         <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      grid_ref="grid_T_3D_ncatice" />
+         <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      grid_ref="grid_T_3D_ncatice" />
+         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="g/kg"   grid_ref="grid_T_3D_ncatice" />
+         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      grid_ref="grid_T_3D_ncatice" />
+         <field id="icetemp_cat"  long_name="Ice temperature for categories"                               unit="degC"   grid_ref="grid_T_3D_ncatice" />
+         <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degC"   grid_ref="grid_T_3D_ncatice" />
+
+         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     />
+         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"    /> 
+         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    />
+         <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     />
+         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        />
+         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        />
+         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      />
+         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      />
+         <field id="idive"        long_name="divergence"                                                   unit="1e-8s-1"  />
+         <field id="ishear"       long_name="shear"                                                        unit="1e-8s-1"  />
+         <field id="icevolu"      long_name="ice volume"                                                   unit="m"        />
+         <field id="snowvol"      long_name="snow volume"                                                  unit="m"        />
+         <field id="tau_icebfr"   long_name="ice friction on ocean bottom for landfast ice"                unit="N/2"      />
+
+         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"          />
+         <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"          />
+         <field id="saltrp"       long_name="salt content transport"                                       unit="1e-3*kg/m2/day" />
+         <field id="deitrp"       long_name="advected ice enthalpy"                                        unit="W/m2"           />
+         <field id="destrp"       long_name="advected snw enthalpy"                                        unit="W/m2"           />
+
+         <field id="sfxbri"       long_name="brine salt flux"                                              unit="1e-3*kg/m2/day" />
+         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/day" />
+         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/day" />
+         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/day" />
+         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/day" />
+         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/day" />
+         <field id="sfxlam"       long_name="salt flux from lateral melt"                                  unit="1e-3*kg/m2/day" />
+         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" />
+         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" />
+         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/day" />
+         <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" />
+
+         <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   />
+         <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   />
+         <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   />
+         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   />
+         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   />
+         <field id="vfxlam"       long_name="lateral melt"                                                 unit="m/day"   />
+         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   />
+         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   />
+         <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   />
+         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   />
+         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   />
+         <field id="vfxsub_err"   long_name="excess of snw sublimation sent to ocean"                      unit="m/day"   />
+         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   />
+         <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(20cm) + open water"      unit="m/day"   />
+
+         <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   />
+         <field id="afxdyn"       long_name="area tendency (dynamics)"                                     unit="day-1"   />
+         <field id="afxthd"       long_name="area tendency (thermo)"                                       unit="day-1"   />
+
+         <field id="hfxsum"       long_name="heat fluxes causing surface ice melt"                         unit="W/m2"  />
+         <field id="hfxbom"       long_name="heat fluxes causing bottom ice melt"                          unit="W/m2"  />
+         <field id="hfxbog"       long_name="heat fluxes causing bottom ice growth"                        unit="W/m2"  />
+         <field id="hfxdif"       long_name="heat fluxes causing ice temperature change"                   unit="W/m2"  />
+         <field id="hfxopw"       long_name="heat fluxes causing open water ice formation"                 unit="W/m2"  />
+         <field id="hfxsnw"       long_name="heat fluxes causing snow melt"                                unit="W/m2"  />
+         <field id="hfxerr"       long_name="heat fluxes error after heat diffusion"                       unit="W/m2"  />
+         <field id="hfxerr_rem"   long_name="heat fluxes error after remapping"                            unit="W/m2"  />
+         <field id="hfxout"       long_name="total heat fluxes received by the ocean"                      unit="W/m2"  />
+         <field id="hfxin"        long_name="total heat fluxes at the ice/ocean surface"                   unit="W/m2"  />
+
+         <!-- heat flux associated with mass exchange -->
+         <field id="hfxthd"       long_name="heat fluxes from ice-ocean mass exchange during thermo"       unit="W/m2"  />
+         <field id="hfxdyn"       long_name="heat fluxes from ice-ocean mass exchange during dynamic"      unit="W/m2"  />
+         <field id="hfxres"       long_name="heat fluxes from ice-ocean mass exchange during resultant"    unit="W/m2"  />
+         <field id="hfxsub"       long_name="heat fluxes from ice-atm. mass exchange during sublimation"   unit="W/m2"  />
+         <field id="hfxspr"       long_name="heat fluxes from ice-atm. mass exchange during snow precip"   unit="W/m2"  />
+
+         <!-- diags -->
+         <field id="hfxdhc"       long_name="Heat content variation in snow and ice"                       unit="W/m2" />
+         <field id="hfxtur"       long_name="turbulent heat flux at the ice base"                          unit="W/m2" />
+
+	 <!-- sbcssm variables -->
+         <field id="sst_m"    unit="degC" />
+         <field id="sss_m"    unit="psu"  />
+         <field id="ssu_m"    unit="m/s"  />
+         <field id="ssv_m"    unit="m/s"  />
+         <field id="ssh_m"    unit="m"    />
+         <field id="e3t_m"    unit="m"    />
+         <field id="frq_m"    unit="-"    />
+
+      </field_group>
+
+      <!-- LIM3 scalar variables -->
+      <field_group id="SBC_scalar"  grid_ref="grid_T_2D" >
+         <!-- available with ln_limdiaout -->
+         <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"       />
+         <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"       />
+         <field id="ibgfrctemtop"    long_name="global mean heat on top of ice/snw/ocean-atm "                                             unit="1e20J"     />
+         <field id="ibgfrctembot"    long_name="global mean heat below ice (on top of ocean) "                                             unit="1e20J"     />
+         <field id="ibgfrcsal"       long_name="global mean ice/snow forcing (salt equivalent ocean volume)"                               unit="pss*km3"   />
+         <field id="ibgfrchfxtop"    long_name="global mean heat flux on top of ice/snw/ocean-atm "                                        unit="W/m2"      />
+         <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"      />
+ 
+         <field id="ibgvolume"       long_name="drift in ice/snow volume (equivalent ocean volume)"            unit="km3"        />
+         <field id="ibgsaltco"       long_name="drift in ice salt content (equivalent ocean volume)"           unit="pss*km3"    />
+         <field id="ibgheatco"       long_name="drift in ice/snow heat content"                                unit="1e20J"      />
+         <field id="ibgheatfx"       long_name="drift in ice/snow heat flux"                                   unit="W/m2"       />
+
+         <field id="ibgvol_tot"      long_name="global mean ice volume"                                        unit="km3"        />
+         <field id="sbgvol_tot"      long_name="global mean snow volume"                                       unit="km3"        />
+         <field id="ibgarea_tot"     long_name="global mean ice area"                                          unit="km2"        />
+         <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                  unit="1e-3*km3"   />
+         <field id="ibgheat_tot"     long_name="global mean ice heat content"                                  unit="1e20J"      />
+         <field id="sbgheat_tot"     long_name="global mean snow heat content"                                 unit="1e20J"      />
+      </field_group>
+  
+      <!-- 
+============================================================================================================
+	-->
+      <!-- output variables for my configuration (example) --> 
+      
+      <field_group id="myvarICE" >
+         <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        />
+         <field field_ref="icevolu"          name="sivolu"  />
+         <field field_ref="iceconc"          name="siconc"  />
+      </field_group>    
+      
+   </field_definition>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,881 @@
+<?xml version="1.0"?> 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+    <!-- 
+============================================================================================================
+                                  Physical ocean model variables
+============================================================================================================
+    -->
+
+      <!-- T grid -->
+      
+      <field_group id="grid_T" grid_ref="grid_T_2D" >
+         <field id="e3t"          long_name="T-cell thickness"   standard_name="cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+         <field id="e3t_0"        long_name="Initial T-cell thickness"   standard_name="ref_cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+
+         <field id="toce"         long_name="temperature"         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/>
+         <field id="toce_e3t"     long_name="temperature (thickness weighted)"                                      unit="degC"     grid_ref="grid_T_3D" > toce * e3t </field >
+         <field id="soce"         long_name="salinity"            standard_name="sea_water_practical_salinity"      unit="1e-3"     grid_ref="grid_T_3D"/>
+         <field id="soce_e3t"     long_name="salinity    (thickness weighted)"                                      unit="1e-3"     grid_ref="grid_T_3D" > soce * e3t </field >
+
+         <!-- t-eddy viscosity coefficients (ldfdyn) -->
+	 <field id="ahmt_2d"      long_name=" surface t-eddy viscosity coefficient"   unit="m2/s or m4/s" />
+	 <field id="ahmt_3d"      long_name=" 3D      t-eddy viscosity coefficient"   unit="m2/s or m4/s"                           grid_ref="grid_T_3D"/>
+
+         <field id="sst"          long_name="sea surface temperature"             standard_name="sea_surface_temperature"             unit="degC"     />
+         <field id="sst2"         long_name="square of sea surface temperature"   standard_name="square_of_sea_surface_temperature"   unit="degC2"     > sst * sst </field >
+         <field id="sstmax"       long_name="max of sea surface temperature"   field_ref="sst"   operation="maximum"                                  />
+         <field id="sstmin"       long_name="min of sea surface temperature"   field_ref="sst"   operation="minimum"                                  />
+         <field id="sstgrad"      long_name="module of sst gradient"                                                                  unit="degC/m"   />
+         <field id="sstgrad2"     long_name="square of module of sst gradient"                                                        unit="degC2/m2" />
+         <field id="sbt"          long_name="sea bottom temperature"                                                                  unit="degC"     />
+         <field id="tosmint"      long_name="vertical integral of temperature times density"   standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature"  unit="(kg m2) degree_C" />
+         <field id="sst_wl"       long_name="Delta SST of warm layer"                                                                 unit="degC"     />
+         <field id="sst_cs"       long_name="Delta SST of cool skin"                                                                  unit="degC"     />
+	 <field id="temp_3m"      long_name="temperature at 3m"                                                                       unit="degC"     />
+         
+         <field id="sss"          long_name="sea surface salinity"             standard_name="sea_surface_salinity"   unit="1e-3" />
+         <field id="sss2"         long_name="square of sea surface salinity"                                          unit="1e-6"  > sss * sss </field >
+         <field id="sssmax"       long_name="max of sea surface salinity"   field_ref="sss"   operation="maximum"                 />
+         <field id="sssmin"       long_name="min of sea surface salinity"   field_ref="sss"   operation="minimum"                 />
+         <field id="sbs"          long_name="sea bottom salinity"                                                     unit="0.001" />
+         <field id="somint"       long_name="vertical integral of salinity times density"   standard_name="integral_wrt_depth_of_product_of_density_and_salinity"  unit="(kg m2) x (1e-3)" /> 
+
+         <field id="taubot"       long_name="bottom stress module"                                                    unit="N/m2" /> 
+
+         <field id="ssh"          long_name="sea surface height"             standard_name="sea_surface_height_above_geoid"             unit="m" />
+         <field id="ssh2"         long_name="square of sea surface height"   standard_name="square_of_sea_surface_height_above_geoid"   unit="m2" > ssh * ssh </field >
+         <field id="wetdep"       long_name="wet depth"                      standard_name="wet_depth"                unit="m" />
+         <field id="sshmax"       long_name="max of sea surface height"   field_ref="ssh"   operation="maximum"                                  />
+
+         <field id="mldkz5"       long_name="Turbocline depth (Kz = 5e-4)"                       standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"                unit="m"          />
+         <field id="mldr10_1"     long_name="Mixed Layer Depth (dsigma = 0.01 wrt 10m)"          standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"          />
+         <field id="mldr10_1max"  long_name="Max of Mixed Layer Depth (dsigma = 0.01 wrt 10m)"   field_ref="mldr10_1"   operation="maximum"                                                                          />
+         <field id="mldr10_1min"  long_name="Min of Mixed Layer Depth (dsigma = 0.01 wrt 10m)"   field_ref="mldr10_1"   operation="minimum"                                                                          />
+         <field id="heatc"        long_name="Heat content vertically integrated"                 standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="saltc"        long_name="Salt content vertically integrated"                                                                                                                   unit="1e-3*kg/m2" />
+
+         <!-- EOS -->
+         <field id="alpha"        long_name="thermal expansion"                                                         unit="degC-1" grid_ref="grid_T_3D" />
+         <field id="beta"         long_name="haline contraction"                                                        unit="1e3"    grid_ref="grid_T_3D" />
+         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"                                           unit="s-1"    grid_ref="grid_T_3D" />
+         <field id="rhop"         long_name="potential density (sigma0)"        standard_name="sea_water_sigma_theta"   unit="kg/m3"  grid_ref="grid_T_3D" />
+
+         <!-- Energy - horizontal divergence -->
+         <field id="eken"         long_name="kinetic energy"          standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2"  grid_ref="grid_T_3D" />
+         <field id="hdiv"         long_name="horizontal divergence"                                                          unit="s-1"    grid_ref="grid_T_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="Lf_NHpf"      long_name="MLE: Lf = N H / f"   unit="m" />
+
+         <!-- next variables available with key_diahth -->
+         <field id="mlddzt"       long_name="Thermocline Depth (depth of max dT/dz)"         standard_name="depth_at_maximum_upward_derivative_of_sea_water_potential_temperature"             unit="m"                         />
+         <field id="mldr10_3"     long_name="Mixed Layer Depth (dsigma = 0.03 wrt 10m)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="mldr0_1"      long_name="Mixed Layer Depth (dsigma = 0.01 wrt sfc)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="mldr0_3"      long_name="Mixed Layer Depth (dsigma = 0.03 wrt sfc)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="mld_dt02"     long_name="Mixed Layer Depth (|dT| = 0.2 wrt 10m)"         standard_name="ocean_mixed_layer_thickness_defined_by_temperature"                                unit="m"                         />
+         <field id="topthdep"     long_name="Top of Thermocline Depth (dT = -0.2 wrt 10m)"   standard_name="ocean_mixed_layer_thickness_defined_by_temperature"                                unit="m"                         />
+         <field id="pycndep"      long_name="Pycnocline Depth (dsigma[dT=-0.2] wrt 10m)"     standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="BLT"          long_name="Barrier Layer Thickness"                                                                                                                          unit="m"                          > topthdep - pycndep </field>
+         <field id="tinv"         long_name="Max of vertical invertion of temperature"                                                                                                         unit="degC"                      />
+         <field id="depti"        long_name="Depth of max. vert. inv. of temperature"                                                                                                          unit="m"                         />
+         <field id="20d"          long_name="Depth of 20C isotherm"                          standard_name="depth_of_isosurface_of_sea_water_potential_temperature"                            unit="m"      axis_ref="iax_20C" />
+         <field id="28d"          long_name="Depth of 28C isotherm"                          standard_name="depth_of_isosurface_of_sea_water_potential_temperature"                            unit="m"      axis_ref="iax_28C" />
+         <field id="hc300"        long_name="Heat content 0-300m"                            standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"                      />
+
+         <!-- variables available with diaar5 -->
+         <field id="botpres"      long_name="Sea Water Pressure at Sea Floor"   standard_name="sea_water_pressure_at_sea_floor"   unit="dbar" />
+         <field id="sshdyn"       long_name="dynamic sea surface height"     standard_name="dynamic_sea_surface_height_above_geoid"     unit="m" />
+         <field id="sshdyn2"      long_name="square of dynamic sea surface height"     standard_name="dynamic_sea_surface_height_above_geoid_squared"     unit="m2" > sshdyn * sshdyn </field>
+         <field id="tnpeo"      long_name="Tendency of ocean potential energy content"          unit="W/m2"                           />
+
+         <!-- variables available ln_linssh=.FALSE. -->
+         <field id="tpt_dep"      long_name="T-point depth"                  standard_name="depth_below_geoid"   unit="m"   grid_ref="grid_T_3D" />
+         <field id="e3tdef"       long_name="T-cell thickness deformation"                                       unit="%"   grid_ref="grid_T_3D" />
+      </field_group>
+
+      <!-- Tides -->
+
+      <field_group id="Tides_T" grid_ref="grid_T_2D" operation="once" >
+         <!-- tidal composante -->
+         <field id="M2x"          long_name="M2 Elevation harmonic real part "                             unit="m"        />
+         <field id="M2y"          long_name="M2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="S2x"          long_name="S2 Elevation harmonic real part "                             unit="m"        />
+         <field id="S2y"          long_name="S2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="N2x"          long_name="N2 Elevation harmonic real part "                             unit="m"        />
+         <field id="N2y"          long_name="N2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="K1x"          long_name="K1 Elevation harmonic real part "                             unit="m"        />
+         <field id="K1y"          long_name="K1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="O1x"          long_name="O1 Elevation harmonic real part "                             unit="m"        />
+         <field id="O1y"          long_name="O1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Q1x"          long_name="Q1 Elevation harmonic real part "                             unit="m"        />
+         <field id="Q1y"          long_name="Q1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="M4x"          long_name="M4 Elevation harmonic real part "                             unit="m"        />
+         <field id="M4y"          long_name="M4 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="K2x"          long_name="K2 Elevation harmonic real part "                             unit="m"        />
+         <field id="K2y"          long_name="K2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="P1x"          long_name="P1 Elevation harmonic real part "                             unit="m"        />
+         <field id="P1y"          long_name="P1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Mfx"          long_name="Mf Elevation harmonic real part "                             unit="m"        />
+         <field id="Mfy"          long_name="Mf Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Mmx"          long_name="Mm Elevation harmonic real part "                             unit="m"        />
+         <field id="Mmy"          long_name="Mm Elevation harmonic imaginary part"                         unit="m"        />
+      </field_group>
+	 
+      <field_group id="Tides_U" grid_ref="grid_U_2D" operation="once" >
+         <field id="M2x_u"        long_name="M2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="M2y_u"        long_name="M2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="S2x_u"        long_name="S2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="S2y_u"        long_name="S2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="N2x_u"        long_name="N2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="N2y_u"        long_name="N2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K1x_u"        long_name="K1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="K1y_u"        long_name="K1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="O1x_u"        long_name="O1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="O1y_u"        long_name="O1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Q1x_u"        long_name="Q1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Q1y_u"        long_name="Q1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="M4x_u"        long_name="M4 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="M4y_u"        long_name="M4 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K2x_u"        long_name="K2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="K2y_u"        long_name="K2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="P1x_u"        long_name="P1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="P1y_u"        long_name="P1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mfx_u"        long_name="Mf current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Mfy_u"        long_name="Mf current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mmx_u"        long_name="Mm current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Mmy_u"        long_name="Mm current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+      </field_group>
+	 
+      <field_group id="Tides_V" grid_ref="grid_V_2D" operation="once" >
+         <field id="M2x_v"        long_name="M2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="M2y_v"        long_name="M2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="S2x_v"        long_name="S2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="S2y_v"        long_name="S2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="N2x_v"        long_name="N2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="N2y_v"        long_name="N2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K1x_v"        long_name="K1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="K1y_v"        long_name="K1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="O1x_v"        long_name="O1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="O1y_v"        long_name="O1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Q1x_v"        long_name="Q1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Q1y_v"        long_name="Q1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="M4x_v"        long_name="M4 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="M4y_v"        long_name="M4 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K2x_v"        long_name="K2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="K2y_v"        long_name="K2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="P1x_v"        long_name="P1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="P1y_v"        long_name="P1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mfx_v"        long_name="Mf current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Mfy_v"        long_name="Mf current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mmx_v"        long_name="Mm current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Mmy_v"        long_name="Mm current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />	 
+      </field_group>
+
+      <!-- SBC -->
+      
+      <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc -->
+         <field id="empmr"        long_name="Net Upward Water Flux"                standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   />
+         <field id="empbmr"       long_name="Net Upward Water Flux at pre. tstep"  standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   />
+         <field id="emp_oce"      long_name="Evap minus Precip over ocean"         standard_name="evap_minus_precip_over_sea_water"                                     unit="kg/m2/s"   />
+         <field id="emp_ice"      long_name="Evap minus Precip over ice"           standard_name="evap_minus_precip_over_sea_ice"                                       unit="kg/m2/s"   />
+         <field id="saltflx"      long_name="Downward salt flux"                                                                                                        unit="1e-3/m2/s" />
+         <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   />
+         <field id="snowpre"      long_name="Snow precipitation"                   standard_name="snowfall_flux"                                                        unit="kg/m2/s"   />
+         <field id="runoffs"      long_name="River Runoffs"                        standard_name="water_flux_into_sea_water_from_rivers"                                unit="kg/m2/s"   />
+         <field id="precip"       long_name="Total precipitation"                  standard_name="precipitation_flux"                                                   unit="kg/m2/s"   />
+ 
+         <field id="qt"           long_name="Net Downward Heat Flux"                standard_name="surface_downward_heat_flux_in_sea_water"                              unit="W/m2"                           />
+         <field id="qns"          long_name="non solar Downward Heat Flux"                                                                                               unit="W/m2"                           />
+         <field id="qsr"          long_name="Shortwave Radiation"                   standard_name="net_downward_shortwave_flux_at_sea_water_surface"                     unit="W/m2"                           />
+         <field id="qsr3d"        long_name="Shortwave Radiation 3D distribution"   standard_name="downwelling_shortwave_flux_in_sea_water"                              unit="W/m2"      grid_ref="grid_T_3D" />
+         <field id="qrp"          long_name="Surface Heat Flux: Damping"            standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation"                 unit="W/m2"                           />
+         <field id="erp"          long_name="Surface Water Flux: Damping"           standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation"              unit="kg/m2/s"                        />
+         <field id="taum"         long_name="wind stress module"                    standard_name="magnitude_of_surface_downward_stress"                                 unit="N/m2"                           />
+         <field id="wspd"         long_name="wind speed module"                     standard_name="wind_speed"                                                           unit="m/s"                            />
+         
+         <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+         <field id="ssh_ib"       long_name="Inverse barometer sea surface height"  standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency"   unit="m"        />
+
+         <!-- * variable related to ice shelf forcing * -->
+         <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  />
+         <field id="fwfisf3d"     long_name="Ice shelf melting"                             unit="kg/m2/s"  grid_ref="grid_T_3D" />
+         <field id="qlatisf"      long_name="Ice shelf latent heat flux"                    unit="W/m2"     />
+         <field id="qlatisf3d"    long_name="Ice shelf latent heat flux"                    unit="W/m2"     grid_ref="grid_T_3D" />
+         <field id="qhcisf"       long_name="Ice shelf heat content flux"                   unit="W/m2"     />
+         <field id="qhcisf3d"     long_name="Ice shelf heat content flux"                   unit="W/m2"     grid_ref="grid_T_3D" />
+         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature) "  unit="m/s"      />
+         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)    "  unit="m/s"      />
+         <field id="stbl"         long_name="salinity in the Losh tbl                    "  unit="PSU"      />
+         <field id="ttbl"         long_name="temperature in the Losh tbl                 "  unit="C"        />
+         <field id="utbl"         long_name="zonal current in the Losh tbl at T point    "  unit="m/s"      />
+         <field id="vtbl"         long_name="merid current in the Losh tbl at T point    "  unit="m/s"      />
+         <field id="thermald"     long_name="thermal driving of ice shelf melting        "  unit="C"        />
+         <field id="tfrz"         long_name="top freezing point (used to compute melt)   "  unit="C"        />
+         <field id="tinsitu"      long_name="top insitu temperature (used to cmpt melt)  "  unit="C"        />
+         <field id="ustar"        long_name="ustar at T point used in ice shelf melting  "  unit="m/s"      />
+
+         <!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"  standard_name="surface_net_downward_longwave_flux"   unit="W/m2"  />
+         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"  standard_name="surface_downward_sensible_heat_flux"  unit="W/m2"  />
+         <field id="qla_oce"      long_name="Latent Downward Heat Flux over open ocean"    standard_name="surface_downward_latent_heat_flux"    unit="W/m2"  />
+         <field id="qemp_oce"     long_name="Downward Heat Flux from E-P over open ocean"                                                       unit="W/m2"  />
+         <field id="taum_oce"     long_name="wind stress module over open ocean"           standard_name="magnitude_of_surface_downward_stress" unit="N/m2"  />
+
+         <!-- available key_oasis3 -->
+         <field id="snow_ao_cea"  long_name="Snow over ice-free ocean (cell average)"   standard_name="snowfall_flux"                             unit="kg/m2/s"  />
+         <field id="snow_ai_cea"  long_name="Snow over sea-ice (cell average)"          standard_name="snowfall_flux"                             unit="kg/m2/s"  />
+         <field id="subl_ai_cea"  long_name="Sublimation over sea-ice (cell average)"   standard_name="surface_snow_and_ice_sublimation_flux"     unit="kg/m2/s"  />
+         <field id="icealb_cea"   long_name="Ice albedo (cell average)"                 standard_name="sea_ice_albedo"                            unit="1"        />
+         <field id="calving_cea"  long_name="Calving"                                   standard_name="water_flux_into_sea_water_from_icebergs"   unit="kg/m2/s"  />
+         <field id="iceberg_cea"  long_name="Iceberg"                                   standard_name="water_flux_into_sea_water_from_icebergs"   unit="kg/m2/s"  />
+         <field id="iceshelf_cea" long_name="Iceshelf"                                  standard_name="water_flux_into_sea_water_from_iceshelf"   unit="kg/m2/s"  />
+
+
+         <!-- available if key_oasis3 + conservative method -->
+         <field id="rain"          long_name="Liquid precipitation"                                     standard_name="rainfall_flux"                                                                 unit="kg/m2/s"  />
+         <field id="evap_ao_cea"   long_name="Evaporation over ice-free ocean (cell average)"           standard_name="water_evaporation_flux"                                                        unit="kg/m2/s"  />
+         <field id="isnwmlt_cea"   long_name="Snow over Ice melting (cell average)"                     standard_name="surface_snow_melt_flux"                                                        unit="kg/m2/s"  />
+         <field id="fsal_virt_cea" long_name="Virtual salt flux due to ice formation (cell average)"    standard_name="virtual_salt_flux_into_sea_water_due_to_sea_ice_thermodynamics"                unit="kg/m2/s"  />
+         <field id="fsal_real_cea" long_name="Real salt flux due to ice formation (cell average)"       standard_name="downward_sea_ice_basal_salt_flux"                                              unit="kg/m2/s"  />
+         <field id="hflx_rain_cea" long_name="heat flux due to rainfall"                                standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"        unit="W/m2"     />
+         <field id="hflx_evap_cea" long_name="heat flux due to evaporation"                             standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"   unit="W/m2"     />
+         <field id="hflx_snow_cea" long_name="heat flux due to snow falling"                            standard_name="heat_flux_onto_ocean_and_ice_due_to_snow_thermodynamics"                       unit="W/m2"     />
+         <field id="hflx_snow_ai_cea" long_name="heat flux due to snow falling over ice"                standard_name="heat_flux_onto_ice_due_to_snow_thermodynamics"                                 unit="W/m2"     />
+         <field id="hflx_snow_ao_cea" long_name="heat flux due to snow falling over ice-free ocean"     standard_name="heat_flux_onto_sea_water_due_to_snow_thermodynamics"                           unit="W/m2"     />
+         <field id="hflx_ice_cea"  long_name="heat flux due to ice thermodynamics"                      standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                        unit="W/m2"     />
+         <field id="hflx_rnf_cea"  long_name="heat flux due to runoffs"                                 standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"          unit="W/m2"     />
+         <field id="hflx_cal_cea"  long_name="heat flux due to calving"                                 standard_name="heat_flux_into_sea_water_due_to_calving"                                       unit="W/m2"     />
+         <field id="hflx_icb_cea"  long_name="heat flux due to iceberg"                                 standard_name="heat_flux_into_sea_water_due_to_icebergs"                                      unit="W/m2"     />
+         <field id="hflx_isf_cea"  long_name="heat flux due to iceshelf"                                standard_name="heat_flux_into_sea_water_due_to_iceshelf"                                      unit="W/m2"     />
+         <field id="bicemel_cea"   long_name="Rate of Melt at Sea Ice Base (cell average)"              standard_name="tendency_of_sea_ice_amount_due_to_basal_melting"                               unit="kg/m2/s"  />
+         <field id="licepro_cea"   long_name="Lateral Sea Ice Growth Rate (cell average)"               standard_name="tendency_of_sea_ice_amount_due_to_lateral_growth_of_ice_floes"                 unit="kg/m2/s"  />
+         <field id="snowmel_cea"   long_name="Snow Melt Rate (cell average)"                            standard_name="surface_snow_melt_flux"                                                        unit="kg/m2/s"  />
+         <field id="sntoice_cea"   long_name="Snow-Ice Formation Rate (cell average)"                   standard_name="tendency_of_sea_ice_amount_due_to_snow_conversion"                             unit="kg/m2/s"  />
+         <field id="ticemel_cea"   long_name="Rate of Melt at Upper Surface of Sea Ice (cell average)"  standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"                             unit="kg/m2/s"  />
+
+         <!-- ice field (nn_ice=1)  -->
+         <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            />
+         
+         <!-- dilution -->
+         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                                                                                              unit="kg*degC/m2/s" />
+         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" />        
+         <field id="rnf_x_sst"    long_name="Runoff term on SST"                                                                                                              unit="kg*degC/m2/s" />
+         <field id="rnf_x_sss"    long_name="Runoff term on SSS"                                                                                                              unit="kg*1e-3/m2/s" />
+       
+	 <!-- sbcssm variables -->
+         <field id="sst_m"    unit="degC" />
+         <field id="sss_m"    unit="psu"  />
+         <field id="ssu_m"    unit="m/s"  />
+         <field id="ssv_m"    unit="m/s"  />
+         <field id="ssh_m"    unit="m"    />
+         <field id="e3t_m"    unit="m"    />
+         <field id="frq_m"    unit="-"    />
+
+      </field_group>
+
+      <!-- U grid -->
+      
+      <field_group id="grid_U"   grid_ref="grid_U_2D">
+         <field id="e3u"          long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" />
+         <field id="e3u_0"        long_name="Initial U-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_U_3D"/>
+         <field id="utau"         long_name="Wind Stress along i-axis"                               standard_name="surface_downward_x_stress"   unit="N/m2"                            />
+         <field id="uoce"         long_name="ocean current along i-axis"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" />
+         <field id="uoce_e3u"     long_name="ocean current along i-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_U_3D"  > uoce * e3u </field>
+         <field id="ssu"          long_name="ocean surface current along i-axis"                                                                 unit="m/s"                             />
+         <field id="sbu"          long_name="ocean bottom current along i-axis"                                                                  unit="m/s"                             />
+         <field id="ubar"         long_name="ocean barotropic current along i-axis"                                                              unit="m/s"                             />
+         <field id="uocetr_eff"   long_name="Effective ocean transport along i-axis"                 standard_name="ocean_volume_x_transport"    unit="m3/s"       grid_ref="grid_U_3D" />
+         <field id="uocet"        long_name="ocean transport along i-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_U_3D" />
+         <field id="uoces"        long_name="ocean transport along i-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_U_3D" />
+
+         <!-- u-eddy coefficients (ldftra) -->
+         <field id="ahtu_2d"      long_name=" surface u-eddy diffusivity coefficient"   unit="m2/s or m4/s" />
+         <field id="ahtu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s or m4/s"      grid_ref="grid_U_3D"/>
+         <field id="aeiu_2d"      long_name=" surface u-EIV coefficient"                unit="m2/s" />
+         <field id="aeiu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s"              grid_ref="grid_U_3D"/>
+
+         <!-- variables available with MLE -->
+         <field id="psiu_mle"     long_name="MLE streamfunction along i-axis"   unit="m3/s"   grid_ref="grid_U_3D" />
+
+         <!-- uoce_eiv: available EIV -->
+         <field id="uoce_eiv"     long_name="EIV ocean current along i-axis"   standard_name="bolus_sea_water_x_velocity"   unit="m/s"   grid_ref="grid_U_3D" />
+
+         <!-- uoce_eiv: available with key_trabbl -->
+         <field id="uoce_bbl"     long_name="BBL ocean current along i-axis"    unit="m/s"  />
+         <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"   unit="m3/s" />
+
+         <!-- variable for ice shelves -->
+         <field id="utbl"         long_name="zonal current in the Losh tbl"     unit="m/s" />
+
+         <field id="u_masstr"     long_name="Ocean Mass X Transport"    standard_name="ocean_mass_x_transport"                          unit="kg/s"        grid_ref="grid_U_3D" />
+         <field id="u_masstr_vint" long_name="vertical integral of ocean eulerian mass transport along i-axis"    standard_name="vertical_integral_of_ocean_mass_x_transport"  unit="kg/s" />
+         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"    standard_name="ocean_heat_x_transport"                          unit="W"                                />
+         <field id="u_salttr"     long_name="ocean eulerian salt transport along i-axis"    standard_name="ocean_salt_x_transport"                          unit="1e-3*kg/s"                        />
+         <field id="uadv_heattr"  long_name="ocean advective heat transport along i-axis"    standard_name="advectice_ocean_heat_x_transport"               unit="W"                                />
+         <field id="uadv_salttr"  long_name="ocean advective salt transport along i-axis"    standard_name="advectice_ocean_salt_x_transport"               unit="1e-3*kg/s"                      />
+         <field id="ueiv_heattr"  long_name="ocean bolus heat transport along i-axis"       standard_name="ocean_heat_x_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="ueiv_salttr"  long_name="ocean bolus salt transport along i-axis"       standard_name="ocean_salt_x_transport_due_to_bolus_advection"   unit="Kg"                                />
+         <field id="ueiv_heattr3d" long_name="ocean bolus heat transport along i-axis"    standard_name="ocean_heat_x_transport_due_to_bolus_advection"   unit="W"    grid_ref="grid_U_3D" />
+         <field id="ueiv_salttr3d" long_name="ocean bolus salt transport along i-axis"    standard_name="ocean_salt_x_transport_due_to_bolus_advection"   unit="kg"   grid_ref="grid_U_3D" />
+         <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis"   standard_name="ocean_heat_x_transport_due_to_diffusion"         unit="W"                                />
+         <field id="udiff_salttr" long_name="ocean diffusion salt transport along i-axis"   standard_name="ocean_salt_x_transport_due_to_diffusion"         unit="1e-3*kg/s"                                />
+      </field_group>
+      
+      <!-- V grid -->
+      
+      <field_group id="grid_V"   grid_ref="grid_V_2D">
+         <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" />
+         <field id="e3v_0"        long_name="Initial V-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_V_3D"/>
+         <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            />
+         <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" />
+         <field id="voce_e3v"     long_name="ocean current along j-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_V_3D"  > voce * e3v </field>
+         <field id="ssv"          long_name="ocean surface current along j-axis"                                                                 unit="m/s"                             />
+         <field id="sbv"          long_name="ocean bottom current along j-axis"                                                                  unit="m/s"                             />
+         <field id="vbar"         long_name="ocean barotropic current along j-axis"                                                              unit="m/s"                             />
+         <field id="vocetr_eff"   long_name="Effective ocean transport along j-axis"                 standard_name="ocean_volume_y_transport"    unit="m3/s"       grid_ref="grid_V_3D" />
+         <field id="vocet"        long_name="ocean transport along j-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_V_3D" />
+         <field id="voces"        long_name="ocean transport along j-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_V_3D" />
+
+         <!-- v-eddy coefficients (ldftra, ldfdyn) -->
+         <field id="ahtv_2d"      long_name=" surface v-eddy diffusivity coefficient"     unit="m2/s or (m4/s)^1/2" />
+         <field id="ahtv_3d"      long_name=" 3D v-eddy diffusivity coefficient"          unit="m2/s or (m4/s)^1/2"           grid_ref="grid_V_3D"/>
+         <field id="aeiv_2d"      long_name=" surface v-EIV coefficient"                  unit="m2/s" />
+         <field id="aeiv_3d"      long_name=" 3D v-EIV coefficient"                       unit="m2/s"                         grid_ref="grid_V_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="psiv_mle"     long_name="MLE streamfunction along j-axis"   unit="m3/s"   grid_ref="grid_V_3D" />
+
+         <!-- voce_eiv: available with EIV -->
+         <field id="voce_eiv"     long_name="EIV ocean current along j-axis"   standard_name="bolus_sea_water_y_velocity"   unit="m/s"   grid_ref="grid_V_3D" />
+
+         <!-- voce_eiv: available with key_trabbl -->
+         <field id="voce_bbl"     long_name="BBL ocean current along j-axis"    unit="m/s"  />
+         <field id="ahv_bbl"      long_name="BBL diffusive flux along j-axis"   unit="m3/s" />
+
+         <!-- variable for ice shelves -->
+         <field id="vtbl"         long_name="meridional current in the Losh tbl"   unit="m/s" />
+
+         <!-- variables available with diaar5 -->
+         <field id="v_masstr"     long_name="ocean eulerian mass transport along j-axis"    standard_name="ocean_mass_y_transport"                          unit="kg/s"        grid_ref="grid_V_3D" />
+         <field id="v_heattr"     long_name="ocean eulerian heat transport along j-axis"    standard_name="ocean_heat_y_transport"                          unit="W"                                />
+         <field id="v_salttr"     long_name="ocean eulerian salt transport along i-axis"    standard_name="ocean_salt_y_transport"                          unit="1e-3*kg/s"                        />
+         <field id="vadv_heattr"  long_name="ocean advective heat transport along j-axis"   standard_name="advectice_ocean_heat_y_transport"                unit="W"                      />
+         <field id="vadv_salttr"  long_name="ocean advective salt transport along j-axis"   standard_name="advectice_ocean_salt_y_transport"                unit="1e-3*kg/s"              />
+         <field id="veiv_heattr"  long_name="ocean bolus heat transport along j-axis"       standard_name="ocean_heat_y_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="veiv_salttr"  long_name="ocean bolus salt transport along j-axis"       standard_name="ocean_salt_x_transport_due_to_bolus_advection"   unit="Kg"                                />
+         <field id="veiv_heattr3d" long_name="ocean bolus heat transport along j-axis"    standard_name="ocean_heat_y_transport_due_to_bolus_advection"   unit="W"    grid_ref="grid_V_3D" />
+         <field id="veiv_salttr3d" long_name="ocean bolus salt transport along j-axis"    standard_name="ocean_salt_y_transport_due_to_bolus_advection"   unit="kg"   grid_ref="grid_V_3D" />
+         <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis"   standard_name="ocean_heat_y_transport_due_to_diffusion"         unit="W"                                />
+         <field id="vdiff_salttr" long_name="ocean diffusion salt transport along j-axis"   standard_name="ocean_salt_y_transport_due_to_diffusion"         unit="1e-3*kg/s"                        />
+      </field_group>
+      
+      <!-- W grid -->
+      
+      <field_group id="grid_W" grid_ref="grid_W_3D">
+         <field id="e3w"          long_name="W-cell thickness"                     standard_name="cell_thickness"              unit="m"    />
+         <field id="woce"         long_name="ocean vertical velocity"              standard_name="upward_sea_water_velocity"   unit="m/s"  />
+         <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                               unit="m3/s" />
+
+         <!-- woce_eiv: available with EIV -->
+         <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" />
+
+         <field id="avt"          long_name="vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+         <field id="logavt"       long_name="logarithm of vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+         <field id="avm"          long_name="vertical eddy viscosity"     standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" />
+
+         <!-- avs: available with key_zdfddm -->
+         <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" />
+         <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+
+         <!-- avt_evd and avm_evd: available with ln_zdfevd -->
+         <field id="avt_evd"      long_name="convective enhancement of vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" />
+         <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" />
+
+         <!-- avt_tide: available with key_zdftmx -->
+         <field id="av_tide"      long_name="tidal vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_tides"   unit="m2/s" />
+
+         <!-- variables available with key_zdftmx_new -->
+         <field id="av_ratio"     long_name="S over T diffusivity ratio"            standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    />
+         <field id="av_wave"      long_name="wave-induced vertical diffusivity"     standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves"         unit="m2/s" />
+         <field id="bflx_tmx"     long_name="wave-induced buoyancy flux"            standard_name="buoyancy_flux_due_to_internal_waves"                             unit="W/kg" />
+         <field id="pcmap_tmx"    long_name="power consumed by wave-driven mixing"  standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing"   unit="W/m2"      grid_ref="grid_W_2D" />
+         <field id="emix_tmx"     long_name="power density available for mixing"    standard_name="power_available_for_mixing_from_breaking_internal_waves"         unit="W/kg" />
+
+         <!-- variables available with diaar5 -->   
+         <field id="w_masstr"     long_name="vertical mass transport"             standard_name="upward_ocean_mass_transport"             unit="kg/s"   />
+         <field id="w_masstr2"    long_name="square of vertical mass transport"   standard_name="square_of_upward_ocean_mass_transport"   unit="kg2/s2" />
+
+         <!-- aht2d and  aht2d_eiv -->
+         <field id="aht2d"        long_name="lateral eddy diffusivity"       standard_name="ocean_tracer_xy_laplacian_diffusivity"      unit="m2/s"   grid_ref="grid_W_2D" />
+         <field id="aht2d_eiv"    long_name="EIV lateral eddy diffusivity"   standard_name="ocean_tracer_bolus_laplacian_diffusivity"   unit="m2/s"   grid_ref="grid_W_2D" />
+
+      </field_group>
+        
+      <!-- F grid -->
+      <!-- f-eddy viscosity coefficients (ldfdyn) -->
+      <field id="ahmf_2d"      long_name=" surface f-eddy viscosity coefficient"   unit="m2/s or m4/s" />
+      <field id="ahmf_3d"      long_name=" 3D      f-eddy viscosity coefficient"   unit="m2/s or m4/s"                           grid_ref="grid_T_3D"/>
+
+      <field_group id="scalar"  grid_ref="grid_T_2D"  >
+         <field id="voltot"     long_name="global total volume"                          standard_name="sea_water_volume"                               unit="m3"   />
+         <field id="sshtot"     long_name="global mean ssh"                              standard_name="global_average_sea_level_change"                unit="m"    />
+         <field id="sshsteric"  long_name="global mean ssh steric"                       standard_name="global_average_steric_sea_level_change"         unit="m"    />
+         <field id="sshthster"  long_name="global mean ssh thermosteric"                 standard_name="global_average_thermosteric_sea_level_change"   unit="m"    />
+         <field id="masstot"    long_name="global total mass"                            standard_name="sea_water_mass"                                 unit="kg"   />
+         <field id="temptot"    long_name="global mean temperature"                      standard_name="sea_water_potential_temperature"                unit="degC" />
+         <field id="saltot"     long_name="global mean salinity"                         standard_name="sea_water_salinity"                             unit="1e-3" />
+         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait"   standard_name="sea_ice_transport_across_line"                  unit="kg/s" />
+
+      	 <!-- available with ln_diahsb -->
+         <field id="bgtemper"     long_name="drift in global mean temperature wrt timestep 1"                 standard_name="change_over_time_in_sea_water_potential_temperature"   unit="degC"     />
+         <field id="bgsaline"     long_name="drift in global mean salinity wrt timestep 1"                    standard_name="change_over_time_in_sea_water_practical_salinity"      unit="1e-3"     />
+         <field id="bgheatco"     long_name="drift in global mean heat content wrt timestep 1"                                                                                      unit="1.e20J"   />
+         <field id="bgheatfx"     long_name="drift in global mean heat flux    wrt timestep 1"                                                                                      unit="W/m2"     />
+         <field id="bgsaltco"     long_name="drift in global mean salt content wrt timestep 1"                                                                                      unit="1e-3*km3" />
+         <field id="bgvolssh"     long_name="drift in global mean ssh volume wrt timestep 1"                                                                                        unit="km3"      />
+         <field id="bgvole3t"     long_name="drift in global mean volume variation (e3t) wrt timestep 1"                                                                            unit="km3"      />
+         <field id="bgfrcvol"     long_name="global mean volume from forcing"                                                                                                       unit="km3"      />
+         <field id="bgfrctem"     long_name="global mean heat content from forcing"                                                                                                 unit="1.e20J"   />
+         <field id="bgfrchfx"     long_name="global mean heat flux from forcing"                                                                                                    unit="W/m2"     />
+         <field id="bgfrcsal"     long_name="global mean salt content from forcing"                                                                                                 unit="1e-3*km3" />
+         <field id="bgmistem"     long_name="global mean temperature error due to free surface (linssh true)"                                                                            unit="degC"     />
+         <field id="bgmissal"     long_name="global mean salinity error due to free surface (linssh true)"                                                                               unit="1e-3"     />
+      </field_group>
+  
+      <!-- variables available with key_float -->
+
+      <field_group id="floatvar" grid_ref="grid_T_nfloat"  operation="instant" >
+         <field id="traj_lon"      long_name="floats longitude"                                                           unit="degrees_east"  />
+         <field id="traj_lat"      long_name="floats latitude"                                                            unit="degrees_north" />
+         <field id="traj_dep"      long_name="floats depth"                                                               unit="m"             />
+         <field id="traj_temp"     long_name="floats temperature"       standard_name="sea_water_potential_temperature"   unit="degC"          />
+         <field id="traj_salt"     long_name="floats salinity"          standard_name="sea_water_practical_salinity"      unit="1e-3"          />
+         <field id="traj_dens"     long_name="floats in-situ density"   standard_name="sea_water_density"                 unit="kg/m3"         />
+         <field id="traj_group"    long_name="floats group"                                                               unit="1"             />
+      </field_group>
+
+      <!-- variables available with iceberg trajectories -->
+
+      <field_group id="icbvar" domain_ref="grid_T"  > 
+         <field id="berg_melt"          long_name="icb melt rate of icebergs"                       unit="kg/m2/s"                    />
+         <field id="berg_buoy_melt"     long_name="icb buoyancy component of iceberg melt rate"     unit="kg/m2/s"                    />
+         <field id="berg_eros_melt"     long_name="icb erosion component of iceberg melt rate"      unit="kg/m2/s"                    />
+         <field id="berg_conv_melt"     long_name="icb convective component of iceberg melt rate"   unit="kg/m2/s"                    />
+         <field id="berg_virtual_area"  long_name="icb virtual coverage by icebergs"                unit="m2"                         />
+         <field id="bits_src"           long_name="icb mass source of bergy bits"                   unit="kg/m2/s"                    />
+         <field id="bits_melt"          long_name="icb melt rate of bergy bits"                     unit="kg/m2/s"                    />
+         <field id="bits_mass"          long_name="icb bergy bit density field"                     unit="kg/m2"                      />
+         <field id="berg_mass"          long_name="icb iceberg density field"                       unit="kg/m2"                      />
+         <field id="calving"            long_name="icb calving mass input"                          unit="kg/s"                       />
+         <field id="berg_floating_melt" long_name="icb melt rate of icebergs + bits"                unit="kg/m2/s"                    />
+         <field id="berg_real_calving"  long_name="icb calving into iceberg class"                  unit="kg/s"     axis_ref="icbcla" />
+         <field id="berg_stored_ice"    long_name="icb accumulated ice mass by class"               unit="kg"       axis_ref="icbcla" />
+      </field_group>
+
+      <!-- Poleward transport : ptr -->     
+      <field_group id="diaptr" >  
+         <field id="zomsfglo"          long_name="Meridional Stream-Function: Global"           unit="Sv"       grid_ref="gznl_W_3D" />
+         <field id="zomsfatl"          long_name="Meridional Stream-Function: Atlantic"         unit="Sv"       grid_ref="gznl_W_3D" />
+         <field id="zomsfpac"          long_name="Meridional Stream-Function: Pacific"          unit="Sv"       grid_ref="gznl_W_3D" />
+         <field id="zomsfind"          long_name="Meridional Stream-Function: Indian"           unit="Sv"       grid_ref="gznl_W_3D" />
+         <field id="zomsfipc"          long_name="Meridional Stream-Function: Pacific+Indian"   unit="Sv"       grid_ref="gznl_W_3D" />
+         <field id="zotemglo"          long_name="Zonal Mean Temperature : Global"              unit="degree_C"     grid_ref="gznl_T_3D" />
+         <field id="zotematl"          long_name="Zonal Mean Temperature : Atlantic"            unit="degree_C"     grid_ref="gznl_T_3D" />
+         <field id="zotempac"          long_name="Zonal Mean Temperature : Pacific"             unit="degree_C"     grid_ref="gznl_T_3D" />
+         <field id="zotemind"          long_name="Zonal Mean Temperature : Indian"              unit="degree_C"     grid_ref="gznl_T_3D" />
+         <field id="zotemipc"          long_name="Zonal Mean Temperature : Pacific+Indian"      unit="degree_C"     grid_ref="gznl_T_3D" />
+         <field id="zosalglo"          long_name="Zonal Mean Salinity : Global"                 unit="0.001"     grid_ref="gznl_T_3D" />
+         <field id="zosalatl"          long_name="Zonal Mean Salinity : Atlantic"               unit="0.001"     grid_ref="gznl_T_3D" />
+         <field id="zosalpac"          long_name="Zonal Mean Salinity : Pacific"                unit="0.001"     grid_ref="gznl_T_3D" />
+         <field id="zosalind"          long_name="Zonal Mean Salinity : Indian"                 unit="0.001"     grid_ref="gznl_T_3D" />
+         <field id="zosalipc"          long_name="Zonal Mean Salinity : Pacific+Indian"         unit="0.001"     grid_ref="gznl_T_3D" />
+         <field id="zosrfglo"          long_name="Zonal Mean Surface"                           unit="m2"       grid_ref="gznl_T_3D" />
+         <field id="zosrfatl"          long_name="Zonal Mean Surface : Atlantic"                unit="m2"       grid_ref="gznl_T_3D" />
+         <field id="zosrfpac"          long_name="Zonal Mean Surface : Pacific"                 unit="m2"       grid_ref="gznl_T_3D" />
+         <field id="zosrfind"          long_name="Zonal Mean Surface : Indian"                  unit="m2"       grid_ref="gznl_T_3D" />
+         <field id="zosrfipc"          long_name="Zonal Mean Surface : Pacific+Indian"          unit="m2"       grid_ref="gznl_T_3D" />
+         <field id="sophtadv"          long_name="Advective Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtadv_atl"      long_name="Advective Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtadv_pac"      long_name="Advective Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtadv_ind"      long_name="Advective Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtadv_ipc"      long_name="Advective Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtldf"          long_name="Diffusive Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtldf_atl"      long_name="Diffusive Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtldf_pac"      long_name="Diffusive Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtldf_ind"      long_name="Diffusive Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtldf_ipc"      long_name="Diffusive Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtove"          long_name="Overturning Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtove_atl"      long_name="Overturning Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtove_pac"      long_name="Overturning Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtove_ind"      long_name="Overturning Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtove_ipc"      long_name="Overturning Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtbtr"          long_name="Barotropic Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtbtr_atl"      long_name="Barotropic Heat Transport: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtbtr_pac"      long_name="Barotropic Heat Transport: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtbtr_ind"      long_name="Barotropic Heat Transport: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophtbtr_ipc"      long_name="Barotropic Heat Transport: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophteiv"          long_name="Heat Transport from mesoscale eddy advection"                     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophteiv_atl"      long_name="Heat Transport from mesoscale eddy advection: Atlantic"           unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophteiv_pac"      long_name="Heat Transport from mesoscale eddy advection: Pacific"            unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophteiv_ind"      long_name="Heat Transport from mesoscale eddy advection: Indian"             unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sophteiv_ipc"      long_name="Heat Transport from mesoscale eddy advection: Pacific+Indian"     unit="PW"       grid_ref="gznl_T_2D" />
+         <field id="sopstadv"          long_name="Advective Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstadv_atl"      long_name="Advective Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstadv_pac"      long_name="Advective Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstadv_ind"      long_name="Advective Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstadv_ipc"      long_name="Advective Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstove"          long_name="Overturning Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstove_atl"      long_name="Overturning Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstove_pac"      long_name="Overturning Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstove_ind"      long_name="Overturning Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstove_ipc"      long_name="Overturning Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstbtr"          long_name="Barotropic Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstbtr_atl"      long_name="Barotropic Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstbtr_pac"      long_name="Barotropic Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstbtr_ind"      long_name="Barotropic Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstbtr_ipc"      long_name="Barotropic Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstldf"          long_name="Diffusive Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstldf_atl"      long_name="Diffusive Salt Transport: Atlantic"           unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstldf_pac"      long_name="Diffusive Salt Transport: Pacific"            unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstldf_ind"      long_name="Diffusive Salt Transport: Indian"             unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopstldf_ipc"      long_name="Diffusive Salt Transport: Pacific+Indian"     unit="Giga g/s" grid_ref="gznl_T_2D" />
+         <field id="sopsteiv"          long_name="Salt Transport from mesoscale eddy advection"                     unit="Giga g/s"       grid_ref="gznl_T_2D" />
+          <field id="sopsteiv_atl"      long_name="Salt Transport from mesoscale eddy advection: Atlantic"           unit="Giga g/s"       grid_ref="gznl_T_2D" />
+         <field id="sopsteiv_pac"      long_name="Salt Transport from mesoscale eddy advection: Pacific"            unit="Giga g/s"       grid_ref="gznl_T_2D" />
+         <field id="sopsteiv_ind"      long_name="Salt Transport from mesoscale eddy advection: Indian"             unit="Giga g/s"       grid_ref="gznl_T_2D" />
+         <field id="sopsteiv_ipc"      long_name="Salt Transport from mesoscale eddy advection: Pacific+Indian"     unit="Giga g/s"       grid_ref="gznl_T_2D" />       
+      </field_group>
+
+    <!-- 
+============================================================================================================
+                  Physical ocean model trend diagnostics : temperature, KE, PE, momentum
+============================================================================================================
+    -->
+
+    <field_group id="trendT" grid_ref="grid_T_3D">
+       <!-- variables available with ln_tra_trd -->
+       <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                                                                                          unit="degC/s"                        />
+       <field id="strd_xad"      long_name="salinity   -trend: i-advection"                                                                                          unit="1e-3/s"                        />
+       <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                                                                                          unit="degC/s"                        />
+       <field id="strd_yad"      long_name="salinity   -trend: j-advection"                                                                                          unit="1e-3/s"                        />
+       <field id="ttrd_zad"      long_name="temperature-trend: k-advection"                                                                                          unit="degC/s"                        />
+       <field id="strd_zad"      long_name="salinity   -trend: k-advection"                                                                                          unit="1e-3/s"                        />
+       <field id="ttrd_ad"       long_name="temperature-trend: advection"               standard_name="tendency_of_sea_water_temperature_due_to_advection"           unit="degC/s"                         > sqrt( ttrd_xad^2 + ttrd_yad^2 + ttrd_zad^2 ) </field>
+       <field id="strd_ad"       long_name="salinity   -trend: advection"               standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="1e-3/s"                         > sqrt( strd_xad^2 + strd_yad^2 + strd_zad^2 ) </field>
+       <field id="ttrd_totad"    long_name="temperature-trend: total advection"         standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="degC/s"                        />
+       <field id="strd_totad"    long_name="salinity   -trend: total advection"         standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="1e-3/s"                        />
+       <field id="ttrd_sad"      long_name="temperature-trend: surface adv. (linssh true)"                                                                                unit="degC/s"   grid_ref="grid_T_2D" />
+       <field id="strd_sad"      long_name="salinity   -trend: surface adv. (linssh true)"                                                                                unit="1e-3/s"   grid_ref="grid_T_2D" />
+       <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"      standard_name="tendency_of_sea_water_temperature_due_to_horizontal_mixing"   unit="degC/s"                        />
+       <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"      standard_name="tendency_of_sea_water_salinity_due_to_horizontal_mixing"      unit="1e-3/s"                        />
+       <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"      standard_name="tendency_of_sea_water_temperature_due_to_vertical_mixing"     unit="degC/s"                        />
+       <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"      standard_name="tendency_of_sea_water_salinity_due_to_vertical_mixing"        unit="1e-3/s"                        />
+       <field id="ttrd_evd"      long_name="temperature-trend: EVD convection"                                                                                       unit="degC/s"                        />
+       <field id="strd_evd"      long_name="salinity   -trend: EVD convection"                                                                                       unit="1e-3/s"                        />
+
+       <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
+       <field id="ttrd_iso"      long_name="temperature-trend: isopycnal diffusion"                             unit="degC/s" > ttrd_ldf + ttrd_zdf - ttrd_zdfp </field>
+       <field id="strd_iso"      long_name="salinity   -trend: isopycnal diffusion"                             unit="1e-3/s" > strd_ldf + strd_zdf - strd_zdfp </field>
+       <field id="ttrd_zdfp"     long_name="temperature-trend: pure vert. diffusion"   unit="degC/s" />
+       <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"   unit="1e-3/s" />
+
+       <!-- -->
+       <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"        unit="degC/s" />
+       <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"        unit="1e-3/s" />
+       <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"     unit="degC/s" />
+       <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"     unit="1e-3/s" />
+       <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."     unit="degC/s" />
+       <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."     unit="1e-3/s" />
+       <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"   unit="degC/s" />
+       <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"   unit="degC/s" />
+       <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"     unit="degC/s" />
+       <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"        unit="degC/s" />
+       <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"       unit="degC/s" />
+       <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"       unit="1e-3/s" />
+       <field id="ttrd_tot"      long_name="temperature-trend: total model trend"         unit="degC/s" />
+       <field id="strd_tot"      long_name="salinity   -trend: total model trend"         unit="1e-3/s" />
+
+       <!-- Thickness weighted versions: -->
+       <field id="ttrd_xad_e3t"      unit="degC/s * m" >  ttrd_xad * e3t </field>
+       <field id="strd_xad_e3t"      unit="1e-3/s * m" >  strd_xad * e3t </field>
+       <field id="ttrd_yad_e3t"      unit="degC/s * m" >  ttrd_yad * e3t </field>
+       <field id="strd_yad_e3t"      unit="1e-3/s * m" >  strd_yad * e3t </field>
+       <field id="ttrd_zad_e3t"      unit="degC/s * m" >  ttrd_zad * e3t </field>
+       <field id="strd_zad_e3t"      unit="1e-3/s * m" >  strd_zad * e3t </field>
+       <field id="ttrd_ad_e3t"       unit="degC/s * m" >  ttrd_ad  * e3t </field>
+       <field id="strd_ad_e3t"       unit="1e-3/s * m" >  strd_ad  * e3t </field>
+       <field id="ttrd_totad_e3t"    unit="degC/s * m" >  ttrd_totad  * e3t </field>
+       <field id="strd_totad_e3t"    unit="1e-3/s * m" >  strd_totad  * e3t </field>
+       <field id="ttrd_ldf_e3t"      unit="degC/s * m" >  ttrd_ldf * e3t </field>
+       <field id="strd_ldf_e3t"      unit="1e-3/s * m" >  strd_ldf * e3t </field>
+       <field id="ttrd_zdf_e3t"      unit="degC/s * m" >  ttrd_zdf * e3t </field>
+       <field id="strd_zdf_e3t"      unit="1e-3/s * m" >  strd_zdf * e3t </field>
+       <field id="ttrd_evd_e3t"      unit="degC/s * m" >  ttrd_evd * e3t </field>
+       <field id="strd_evd_e3t"      unit="1e-3/s * m" >  strd_evd * e3t </field>
+
+       <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
+       <field id="ttrd_iso_e3t"      unit="degC/s * m"  >  ttrd_iso * e3t </field>
+       <field id="strd_iso_e3t"      unit="1e-3/s * m"  >  strd_iso * e3t </field>
+       <field id="ttrd_zdfp_e3t"     unit="degC/s * m"  >  ttrd_zdfp * e3t </field>
+       <field id="strd_zdfp_e3t"     unit="1e-3/s * m"  >  strd_zdfp * e3t </field>
+
+       <!-- -->
+       <field id="ttrd_dmp_e3t"      unit="degC/s * m"  >  ttrd_dmp * e3t </field>
+       <field id="strd_dmp_e3t"      unit="1e-3/s * m"  >  strd_dmp * e3t </field>
+       <field id="ttrd_bbl_e3t"      unit="degC/s * m"  >  ttrd_bbl * e3t </field>
+       <field id="strd_bbl_e3t"      unit="1e-3/s * m"  >  strd_bbl * e3t </field>
+       <field id="ttrd_npc_e3t"      unit="degC/s * m"  >  ttrd_npc * e3t </field>
+       <field id="strd_npc_e3t"      unit="1e-3/s * m"  >  strd_npc * e3t </field>
+       <field id="ttrd_qns_e3t"      unit="degC/s * m"  >  ttrd_qns * e3t_surf </field>
+       <field id="strd_cdt_e3t"      unit="degC/s * m"  >  strd_cdt * e3t_surf </field>
+       <field id="ttrd_qsr_e3t"      unit="degC/s * m"  >  ttrd_qsr * e3t </field>
+       <field id="ttrd_bbc_e3t"      unit="degC/s * m"  >  ttrd_bbc * e3t </field>
+       <field id="ttrd_atf_e3t"      unit="degC/s * m"  >  ttrd_atf * e3t </field>
+       <field id="strd_atf_e3t"      unit="1e-3/s * m"  >  strd_atf * e3t </field>
+       <field id="ttrd_tot_e3t"      unit="degC/s * m"  >  ttrd_tot * e3t </field>
+       <field id="strd_tot_e3t"      unit="1e-3/s * m"  >  strd_tot * e3t </field>
+
+
+       <!-- variables available with ln_KE_trd -->
+       <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"          unit="W/s^3"                        />
+       <field id="ketrd_spg"     long_name="ke-trend: surface     pressure gradient"          unit="W/s^3"                        />
+       <field id="ketrd_spgexp"  long_name="ke-trend: surface pressure gradient (explicit)"   unit="W/s^3"                        />
+       <field id="ketrd_spgflt"  long_name="ke-trend: surface pressure gradient (filter)"     unit="W/s^3"                        />
+       <field id="ssh_flt"       long_name="filtered contribution to ssh (dynspg_flt)"        unit="m"       grid_ref="grid_T_2D" />
+       <field id="w0"            long_name="surface vertical velocity"                        unit="m/s"     grid_ref="grid_T_2D" />
+       <field id="pw0_exp"       long_name="surface pressure flux due to ssh"                 unit="W/s^2"   grid_ref="grid_T_2D" />
+       <field id="pw0_flt"       long_name="surface pressure flux due to filtered ssh"        unit="W/s^2"   grid_ref="grid_T_2D" />
+       <field id="ketrd_keg"     long_name="ke-trend: KE gradient         or hor. adv."       unit="W/s^3"                        />
+       <field id="ketrd_rvo"     long_name="ke-trend: relative  vorticity or metric term"     unit="W/s^3"                        />
+       <field id="ketrd_pvo"     long_name="ke-trend: planetary vorticity"                    unit="W/s^3"                        />
+       <field id="ketrd_zad"     long_name="ke-trend: vertical  advection"                    unit="W/s^3"                        />
+       <field id="ketrd_udx"     long_name="ke-trend: U.dx[U]"                                unit="W/s^3"                        />
+       <field id="ketrd_ldf"     long_name="ke-trend: lateral   diffusion"                    unit="W/s^3"                        />
+       <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                    unit="W/s^3"                        />
+       <field id="ketrd_tau"     long_name="ke-trend: wind stress "                           unit="W/s^3"   grid_ref="grid_T_2D" />
+       <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        />   
+       <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        />   
+       <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        />  
+       <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"      unit="W/s^3"                        />
+       <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        />   
+
+       <!-- variables available with ln_PE_trd -->
+       <field id="petrd_xad"     long_name="pe-trend: i-advection"                unit="W/m^3"                        />
+       <field id="petrd_yad"     long_name="pe-trend: j-advection"                unit="W/m^3"                        />
+       <field id="petrd_zad"     long_name="pe-trend: k-advection"                unit="W/m^3"                        />
+       <field id="petrd_sad"     long_name="pe-trend: surface adv. (linssh true)"      unit="W/m^3"   grid_ref="grid_T_2D" />
+       <field id="petrd_ldf"     long_name="pe-trend: lateral  diffusion"         unit="W/m^3"                        />
+       <field id="petrd_zdf"     long_name="pe-trend: vertical diffusion"         unit="W/m^3"                        />
+       <field id="petrd_zdfp"    long_name="pe-trend: pure vert. diffusion"       unit="W/m^3"                        />
+       <field id="petrd_dmp"     long_name="pe-trend: interior restoring"         unit="W/m^3"                        />
+       <field id="petrd_bbl"     long_name="pe-trend: bottom boundary layer"      unit="W/m^3"                        />
+       <field id="petrd_npc"     long_name="pe-trend: non-penetrative conv."      unit="W/m^3"                        />
+       <field id="petrd_nsr"     long_name="pe-trend: surface forcing + runoff"   unit="W/m^3"                        />
+       <field id="petrd_qsr"     long_name="pe-trend: solar penetr. heating"      unit="W/m^3"                        />
+       <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"         unit="W/m^3"                        />
+       <field id="petrd_atf"     long_name="pe-trend: asselin time filter"        unit="W/m^3"                        />
+       <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            />   
+       <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degC-1"                       />   
+       <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          />   
+    </field_group>
+
+    <field_group id="trendU" grid_ref="grid_U_3D">
+       <!-- variables available with ln_dyn_trd -->
+       <field id="utrd_hpg"       long_name="i-trend: hydrostatic pressure gradient"          unit="m/s^2"                        />
+       <field id="utrd_spg"       long_name="i-trend: surface     pressure gradient"          unit="m/s^2"                        />
+       <field id="utrd_spgexp"    long_name="i-trend: surface pressure gradient (explicit)"   unit="m/s^2"                        />
+       <field id="utrd_spgflt"    long_name="i-trend: surface pressure gradient (filtered)"   unit="m/s^2"                        />
+       <field id="utrd_keg"       long_name="i-trend: KE gradient         or hor. adv."       unit="m/s^2"                        />
+       <field id="utrd_rvo"       long_name="i-trend: relative  vorticity or metric term"     unit="m/s^2"                        />
+       <field id="utrd_pvo"       long_name="i-trend: planetary vorticity"                    unit="m/s^2"                        />
+       <field id="utrd_zad"       long_name="i-trend: vertical  advection"                    unit="m/s^2"                        />
+       <field id="utrd_udx"       long_name="i-trend: U.dx[U]"                                unit="m/s^2"                        />
+       <field id="utrd_ldf"       long_name="i-trend: lateral   diffusion"                    unit="m/s^2"                        />
+       <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                    unit="m/s^2"                        />
+       <field id="utrd_tau"       long_name="i-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_U_2D" />
+       <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        />   
+       <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        />   
+       <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        />   
+       <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        />   
+    </field_group>
+
+    <field_group id="trendV" grid_ref="grid_V_3D">
+       <!-- variables available with ln_dyn_trd -->
+       <field id="vtrd_hpg"       long_name="j-trend: hydrostatic pressure gradient"          unit="m/s^2"                        />
+       <field id="vtrd_spg"       long_name="j-trend: surface     pressure gradient"          unit="m/s^2"                        />
+       <field id="vtrd_spgexp"    long_name="j-trend: surface pressure gradient (explicit)"   unit="m/s^2"                        />
+       <field id="vtrd_spgflt"    long_name="j-trend: surface pressure gradient (filtered)"   unit="m/s^2"                        />
+       <field id="vtrd_keg"       long_name="j-trend: KE gradient         or hor. adv."       unit="m/s^2"                        />
+       <field id="vtrd_rvo"       long_name="j-trend: relative  vorticity or metric term"     unit="m/s^2"                        />
+       <field id="vtrd_pvo"       long_name="j-trend: planetary vorticity"                    unit="m/s^2"                        />
+       <field id="vtrd_zad"       long_name="j-trend: vertical  advection"                    unit="m/s^2"                        />
+       <field id="vtrd_vdy"       long_name="i-trend: V.dx[V]"                                unit="m/s^2"                        />
+       <field id="vtrd_ldf"       long_name="j-trend: lateral   diffusion"                    unit="m/s^2"                        />
+       <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                    unit="m/s^2"                        />
+       <field id="vtrd_tau"       long_name="j-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_V_2D" />
+       <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        />   
+       <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        />   
+       <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        />   
+       <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        />   
+    </field_group>
+
+
+    <!-- 
+============================================================================================================
+                                        Definitions for iodef_demo.xml
+============================================================================================================
+    -->
+
+    <field_group id="mooring" >
+       <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"      />
+       <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                   />
+       <field field_ref="uoce"         name="uo"       long_name="sea_water_x_velocity"                 />
+       <field field_ref="voce"         name="vo"       long_name="sea_water_y_velocity"                 />
+       <field field_ref="woce"         name="wo"       long_name="sea_water_z_velocity"                 />
+       <field field_ref="avt"          name="difvho"   long_name="ocean_vertical_heat_diffusivity"      />
+       <field field_ref="avm"          name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"  />
+   
+       <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
+       <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
+       <field field_ref="sstgrad"      name="tosgrad"  long_name="module_of_sea_surface_temperature_gradient"    />
+       <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
+       <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+       <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
+       <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           />
+       <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          />
+       <field field_ref="taum"                                                                                   />
+       <field field_ref="20d"                                                                                    />
+       <field field_ref="mldkz5"                                                                                 />
+       <field field_ref="mldr10_1"                                                                               />
+       <field field_ref="mldr10_3"                                                                               />
+       <field field_ref="mldr0_1"                                                                                />
+       <field field_ref="mldr0_3"                                                                                />
+       <field field_ref="mld_dt02"                                                                               />
+       <field field_ref="topthdep"                                                                               />
+       <field field_ref="pycndep"                                                                                />
+       <field field_ref="tinv"                                                                                   />
+       <field field_ref="depti"                                                                                  />
+       <field field_ref="BLT"          name="blt"      long_name="barrier_layer_thickness"                       />
+       <field field_ref="utau"         name="tauuo"    long_name="surface_downward_x_stress"                     />
+       <field field_ref="vtau"         name="tauvo"    long_name="surface_downward_y_stress"                     />
+    </field_group>
+
+    <field_group id="groupT" >
+       <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               />
+       <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            />
+       <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
+       <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
+       <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
+       <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+       <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
+       <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           />
+       <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          />
+       <field field_ref="taum"                                                                                   />
+       <field field_ref="20d"                                                                                    />
+       <field field_ref="mldkz5"                                                                                 />
+       <field field_ref="mldr10_1"                                                                               />
+       <field field_ref="mldr10_3"                                                                               />
+       <field field_ref="mld_dt02"                                                                               />
+       <field field_ref="topthdep"                                                                               />
+       <field field_ref="pycndep"                                                                                />
+       <field field_ref="tinv"                                                                                   />
+       <field field_ref="depti"                                                                                  />
+       <field field_ref="BLT"          name="blt"      long_name="Barrier Layer Thickness"                       />
+    </field_group>
+    
+    <field_group id="groupU" >
+       <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
+       <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    />
+       <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+    </field_group>
+    
+    <field_group id="groupV" >
+       <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
+       <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    />
+       <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+    </field_group>
+    
+    <field_group id="groupW" >
+       <field field_ref="woce"         name="wo"       long_name="ocean vertical velocity"  />
+    </field_group>
+
+    <!-- TMB diagnostic output -->
+    <field_group  id="1h_grid_T_tmb" grid_ref="grid_T_2D" operation="instant">
+       <field id="top_temp"           name="votemper_top"  unit="degC"  />
+       <field id="mid_temp"           name="votemper_mid"  unit="degC"  />
+       <field id="bot_temp"           name="votemper_bot"  unit="degC"  />
+       <field id="top_sal"            name="vosaline_top"  unit="psu"   />
+       <field id="mid_sal"            name="vosaline_mid"  unit="psu"   />
+       <field id="bot_sal"            name="vosaline_bot"  unit="psu"   />
+       <field id="sshnmasked"         name="sossheig"      unit="m"     /> 
+    </field_group>
+
+    <field_group  id="1h_grid_U_tmb" grid_ref="grid_U_2D" operation="instant">
+       <field id="top_u"           name="vozocrtx_top"  unit="m/s"  />
+       <field id="mid_u"           name="vozocrtx_mid"  unit="m/s"  />
+       <field id="bot_u"           name="vozocrtx_bot"  unit="m/s"  />
+       <field id="baro_u"          name="vobtcrtx"      unit="m/s"  />
+    </field_group>
+
+    <field_group  id="1h_grid_V_tmb" grid_ref="grid_V_2D" operation="instant">
+       <field id="top_v"           name="vomecrty_top"  unit="m/s"  />
+       <field id="mid_v"           name="vomecrty_mid"  unit="m/s"  />
+       <field id="bot_v"           name="vomecrty_bot"  unit="m/s"  />
+       <field id="baro_v"          name="vobtcrty"      unit="m/s"  />
+    </field_group>
+
+    <!-- 25h diagnostic output -->
+    <field_group id="25h_grid_T" grid_ref="grid_T_3D" operation="instant">
+       <field id="temper25h"         name="potential temperature 25h mean"    unit="degC" />
+       <field id="tempis25h"         name="insitu temperature 25h mean"    unit="degC" />
+       <field id="salin25h"          name="salinity 25h mean"                 unit="psu"  />
+       <field id="ssh25h"            name="sea surface height 25h mean"  grid_ref="grid_T_2D"      unit="m"    />
+    </field_group>
+
+    <field_group id="25h_grid_U" grid_ref="grid_U_3D" operation="instant" >
+       <field id="vozocrtx25h"         name="i current 25h mean"    unit="m/s"   />
+    </field_group>
+
+    <field_group id="25h_grid_V" grid_ref="grid_V_3D" operation="instant">
+       <field id="vomecrty25h"         name="j current 25h mean"    unit="m/s"    />
+    </field_group>
+
+    <field_group id="25h_grid_W" grid_ref="grid_W_3D" operation="instant">
+       <field id="vomecrtz25h"         name="k current 25h mean"                 unit="m/s"      />
+       <field id="avt25h"             name="vertical diffusivity25h mean"       unit="m2/s" />
+       <field id="avm25h"              name="vertical viscosity 25h mean"        unit="m2/s" />
+       <field id="tke25h"              name="turbulent kinetic energy 25h mean" />
+       <field id="mxln25h"             name="mixing length 25h mean"             unit="m" />
+    </field_group>
+
+     <!-- 
+============================================================================================================
+       -->
+     <!-- output variables for my configuration (example) --> 
+ 
+    <field_group id="myvarOCE" >
+       <!-- grid T --> 
+       <field field_ref="e3t"          name="e3t"      long_name="vertical scale factor"           />
+       <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"         />
+       <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"            />
+       <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"  />
+      
+       <!-- grid U --> 
+       <field field_ref="e3u"          name="e3u"     long_name="vertical scale factor"            />
+       <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"           />
+      
+       <!-- grid V --> 
+       <field field_ref="e3v"          name="e3v"     long_name="vertical scale factor"            />
+       <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"           />     
+    </field_group>    
+
+   </field_definition>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-pisces.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-pisces.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-pisces.xml	(revision 8732)
@@ -0,0 +1,298 @@
+<?xml version="1.0"?> 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+    <!-- 
+============================================================================================================
+                                     Biogeochemistry model variables
+============================================================================================================
+    -->
+
+      <!-- ptrc on T grid -->
+
+     <field_group id="ptrc_T" grid_ref="grid_T_3D">
+       <!-- PISCES standard : variables available with ln_p4z  -->
+       <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="DIC_e3t"      long_name="DIC * e3t"                                unit="mmol/m2" > DIC * e3t </field >
+       <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" />
+       <field id="Alkalini_e3t" long_name="Alkalini * e3t"                           unit="mmol/m2"  > Alkalini * e3t </field >
+       <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="O2_e3t"       long_name="O2 * e3t"                                 unit="mmol/m2"  > O2 * e3t </field >
+       <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="CaCO3_e3t"    long_name="CaCO3 * e3t"                              unit="mmol/m2"  > CaCO3 * e3t </field >
+       <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="PO4_e3t"      long_name="PO4 * e3t"                                unit="mmol/m2"  > PO4 * e3t </field >
+       <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="POC_e3t"      long_name="POC * e3t"                                unit="mmol/m2"  > POC * e3t </field >
+       <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="Si_e3t"       long_name="Si * e3t"                                 unit="mmol/m2"  > Si * e3t </field >
+       <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" />
+       <field id="PHY_e3t"      long_name="PHY * e3t"                                unit="mmol/m2"  > PHY * e3t </field >
+       <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" />
+       <field id="ZOO_e3t"      long_name="ZOO2 * e3t"                               unit="mmol/m2"  > ZOO * e3t </field >
+       <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="DOC_e3t"      long_name="DOC * e3t"                                unit="mmol/m2"  > DOC * e3t </field >
+       <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="PHY2_e3t"     long_name="PHY2 * e3t"                               unit="mmol/m2"  > PHY2 * e3t </field >
+       <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="ZOO2_e3t"     long_name="ZOO2 * e3t"                               unit="mmol/m2"  > ZOO2 * e3t </field >
+       <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="DSi_e3t"      long_name="Dsi * e3t"                                unit="mmol/m2"  > DSi * e3t </field >
+       <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="Fer_e3t"      long_name="Fer * e3t"                                unit="mmol/m2"  > Fer * e3t </field >
+       <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="BFe_e3t"      long_name="BFe * e3t"                                unit="mmol/m2"  > BFe * e3t </field >
+       <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="GOC_e3t"      long_name="GOC * e3t"                                unit="mmol/m2"  > GOC * e3t </field >
+       <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="SFe_e3t"      long_name="SFe * e3t"                                unit="mmol/m2"  > SFe * e3t </field >
+       <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="DFe_e3t"      long_name="DFe * e3t"                                unit="mmol/m2"  > DFe * e3t </field >
+       <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="GSi_e3t"      long_name="GSi * e3t"                                unit="mmol/m2"  > GSi * e3t </field >
+       <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NFe_e3t"      long_name="NFe * e3t"                                unit="mmol/m2"  > NFe * e3t </field >
+       <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="mg/m3"   />
+       <field id="NCHL_e3t"     long_name="NCHL * e3t"                               unit="mmol/m2"  > NCHL * e3t </field >
+       <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="mg/m3"   />
+       <field id="DCHL_e3t"     long_name="DCHL * e3t"                               unit="mmol/m2"  > DCHL * e3t </field >
+       <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" />
+       <field id="NO3_e3t"      long_name="NO3 * e3t"                                unit="mmol/m2"  > NO3 * e3t </field >
+       <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" />
+       <field id="NH4_e3t"      long_name="NH4 * e3t"                                unit="mmol/m2"  > NH4 * e3t </field >
+
+       <!-- PISCES quota : variables available with ln_p5z  -->
+
+       <field id="DON"          long_name="Dissolved organic N Concentration"        unit="mmol/m3" />
+       <field id="DON_e3t"      long_name="DON * e3t"                                unit="mmol/m2"  > DON * e3t </field >
+       <field id="DOP"          long_name="Dissolved organic P Concentration"        unit="mmol/m3" />
+       <field id="DOP_e3t"      long_name="DOP * e3t"                                unit="mmol/m2"  > DOP * e3t </field >
+       <field id="PON"          long_name="Small PON Concentration"                  unit="mmol/m3" />
+       <field id="PON_e3t"      long_name="PON * e3t"                                unit="mmol/m2"  > PON * e3t </field >
+       <field id="POP"          long_name="Small POP Concentration"                  unit="mmol/m3" />
+       <field id="POP_e3t"      long_name="POP * e3t"                                unit="mmol/m2"  > POP * e3t </field >
+       <field id="GON"          long_name="Big PON Concentration"                    unit="mmol/m3" />
+       <field id="GON_e3t"      long_name="GON * e3t"                                unit="mmol/m2"  > GON * e3t </field >
+       <field id="GOP"          long_name="Big POP Concentration"                    unit="mmol/m3" />
+       <field id="GOP_e3t"      long_name="GOP * e3t"                                unit="mmol/m2"  > GOP * e3t </field >
+       <field id="PHYN"         long_name="Nanophytoplankton N biomass"              unit="mmol/m3" />
+       <field id="PHYN_e3t"     long_name="PHYN * e3t"                               unit="mmol/m2"  > PHYN * e3t </field >
+       <field id="PHYP"         long_name="Nanophytoplankton P biomass"              unit="mmol/m3" />
+       <field id="PHYP_e3t"     long_name="PHYP * e3t"                               unit="mmol/m2"  > PHYP * e3t </field >
+       <field id="DIAN"         long_name="Diatoms N biomass"                        unit="mmol/m3" />
+       <field id="DIAN_e3t"     long_name="DIAN * e3t"                               unit="mmol/m2"  > DIAN * e3t </field >
+       <field id="DIAP"         long_name="Diatoms P biomass"                        unit="mmol/m3" />
+       <field id="DIAP_e3t"     long_name="DIAP * e3t"                               unit="mmol/m2"  > DIAP * e3t </field >
+       <field id="PIC"          long_name="Picophytoplankton C biomass"              unit="mmol/m3" />
+       <field id="PIC_e3t"      long_name="PIC * e3t"                                unit="mmol/m2"  > PIC * e3t </field >
+       <field id="PICN"         long_name="Picophytoplankton N biomass"              unit="mmol/m3" />
+       <field id="PICN_e3t"     long_name="PICN * e3t"                               unit="mmol/m2"  > PICN * e3t </field >
+       <field id="PICP"         long_name="Picophytoplankton P biomass"              unit="mmol/m3" />
+       <field id="PICP_e3t"     long_name="PICP * e3t"                               unit="mmol/m2"  > PICP * e3t </field >
+       <field id="PFe"          long_name="Picophytoplankton Fe biomass"             unit="mmol/m3" />
+       <field id="PFe_e3t"      long_name="PFe * e3t"                                unit="mmol/m2"  > PFe * e3t </field >
+       <field id="PCHL"         long_name="Picophytoplankton Chl biomass"            unit="mg/m3" />
+       <field id="PCHL_e3t"     long_name="PCHL * e3t"                               unit="mmol/m2"  > PCHL * e3t </field >
+
+      <!-- PISCES with ligand parametisation : variables available namelist paramter ln_ligand -->
+       <field id="LGW"         long_name="Weak ligands concentration"                unit="mmol/m3" />
+       <field id="LGW_e3t"     long_name="LGW * e3t"                                 unit="mmol/m2"  > LGW * e3t </field >
+       <field id="LFe"         long_name="Lithogenic iron concentration"             unit="mmol/m3" />
+       <field id="LFe_e3t"     long_name="LFe * e3t"                                 unit="mmol/m2"  > LFe * e3t </field >
+
+       <!-- PISCES light : variables available with ln_p2z  -->
+       <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" />
+       <field id="DET_e3t"     long_name="DET * e3t"                                unit="mmol-N/m2"  > DET * e3t </field >
+       <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" />
+       <field id="DOM_e3t"     long_name="DOM * e3t"                                unit="mmol-N/m2"  > DOM * e3t </field >
+
+       <!-- CFC11 : variables available with ln_cfc11 -->
+       <field id="CFC11"       long_name="Chlorofluoro carbon11 Concentration"      unit="umol/m3" />
+       <field id="CFC11_e3t"   long_name="CFC11 * e3t"                              unit="umol/m2"  > CFC11 * e3t </field >
+
+       <!-- CFC12 : variables available with ln_cfc12 -->
+       <field id="CFC12"       long_name="Chlorofluoro carbon12 Concentration"      unit="umol/m3" />
+       <field id="CFC12_e3t"   long_name="CFC12 * e3t"                              unit="umol/m2"  > CFC12 * e3t </field >
+
+       <!-- SF6 : variables available with ln_sf6 -->
+       <field id="SF6"       long_name="Sulfur hexafluoride Concentration"      unit="umol/m3" />
+       <field id="SF6_e3t"   long_name="SF6 * e3t"                              unit="umol/m2"  > SF6 * e3t </field >
+
+       <!-- C14 : variables available with ln_c14 -->
+       <field id="RC14"        long_name="Radiocarbon ratio"                        unit="-"         />
+       <field id="RC14_e3t"    long_name="RC14 * e3t"                               unit="m"  > RC14 * e3t </field >
+
+       <!-- AGE : variables available with ln_age -->
+       <field id="Age"        long_name="Sea water age since surface contact"       unit="yr"         />
+       <field id="Age_e3t"    long_name="Age * e3t"                                 unit="yr * m"  > Age * e3t </field >
+
+     </field_group>
+
+     <!-- PISCES additional diagnostics on T grid  -->
+
+     <field_group id="diad_T" grid_ref="grid_T_2D">
+       <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" />
+       <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PPPHYN"      long_name="Primary production of nanophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PPPHYP"      long_name="Primary production of picophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PPPHYD"      long_name="Primary production of diatoms"           unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PPNEWP"      long_name="New Primary production of picophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PFeN"        long_name="Primary production of nano iron"         unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PFeP"        long_name="Primary production of pico iron"         unit="molC/m3/s"  grid_ref="grid_T_3D" />
+       <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" />
+       <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="REMINP"       long_name="Oxic remineralization rate of POC"      unit="d-1"        grid_ref="grid_T_3D" />
+       <field id="REMING"       long_name="Oxic remineralization rate of GOC"      unit="d-1"        grid_ref="grid_T_3D" />
+       <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuP"         long_name="Realized growth rate for picophyto"      unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MunetN"      long_name="Net growth rate for nanophyto"           unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MunetP"      long_name="Net growth rate for picophyto"           unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MunetD"      long_name="Net growth rate for diatomes"            unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" />
+       <field id="LPnut"       long_name="Nutrient limitation term in Picophyto"   unit="-"          grid_ref="grid_T_3D" />
+       <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" />
+       <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" />
+       <field id="LPFe"        long_name="Iron limitation term in Picophyto"       unit="-"          grid_ref="grid_T_3D" />
+       <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" />
+       <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" />
+       <field id="LPlight"     long_name="Light limitation term in Picophyto"      unit="-"          grid_ref="grid_T_3D" />
+       <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" />
+       <field id="SIZEN"       long_name="Mean relative size of nanophyto."        unit="-"          grid_ref="grid_T_3D" />
+       <field id="SIZEP"       long_name="Mean relative size of picophyto."        unit="-"          grid_ref="grid_T_3D" />
+       <field id="SIZED"       long_name="Mean relative size of diatoms"           unit="-"          grid_ref="grid_T_3D" />
+       <field id="Fe2"         long_name="Iron II concentration"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL2"        long_name="Complexed Iron concentration with L2"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeP"         long_name="Precipitated Iron III"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL2"         long_name="Total L2 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            />
+       <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="mol/m2/s"                        />
+       <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="mol/m2/s"                        />
+       <field id="SedCal"      long_name="Calcite burial in the sediments"         unit="molC/m2/s"                       />
+       <field id="SedSi"       long_name="Silicon burial in the sediments"         unit="molSi/m2/s"                      />
+       <field id="SedC"        long_name="Organic C burial in the sediments"       unit="molC/m2/s"                       />
+       <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        />
+       <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        />
+       <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        />
+       <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        />
+       <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        />
+       <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        />
+       <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   />
+       <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            />
+       <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            />
+       <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               />
+       <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        />
+       <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" />
+
+       <!-- dbio_T on T grid : variables available with diaar5 -->
+       <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          />
+       <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          />
+       <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              />
+       <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"                       />
+       <field id="INTPPPHYN"   long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"                       />
+       <field id="INTPPPHYD"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"                       />
+       <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"                       />
+       <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"                       />
+       <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"                       />
+       <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"                       />
+       <field id="INTPCAL"     long_name="Vertically integrated of calcite production"         unit="mol/m2/s"                       />
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  /> 
+       <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  /> 
+       <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  /> 
+       <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  /> 
+       <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  /> 
+       <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  /> 
+       <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  /> 
+       <field id="TZOODET"     long_name="TZOODET"                                 unit=""  /> 
+       <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  /> 
+       <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  /> 
+       <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  /> 
+       <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  /> 
+       <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  /> 
+       <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  /> 
+       <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  /> 
+       <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  /> 
+       <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  /> 
+       <field id="TDETSED"     long_name="TDETSED"                                 unit=""  /> 
+
+       <!-- CFC11 : variables available with ln_cfc11 -->
+       <field id="qtr_CFC11"    long_name="Air-sea flux of CFC-11"                  unit="mol/m2/s"   />
+       <field id="qint_CFC11"   long_name="Cumulative air-sea flux of CFC-11"       unit="mol/m2"     />
+
+       <!-- CFC12 : variables available with ln_cfc12 -->
+       <field id="qtr_CFC12"    long_name="Air-sea flux of CFC12"                  unit="mol/m2/s"   />
+       <field id="qint_CFC12"   long_name="Cumulative air-sea flux of CFC12"       unit="mol/m2"     />
+
+       <!-- SF6 : variables available with ln_sf6 -->
+       <field id="qtr_SF6"      long_name="Air-sea flux of SF6"                    unit="mol/m2/s"   />
+       <field id="qint_SF6"     long_name="Cumulative air-sea flux of SF6"         unit="mol/m2"     />
+
+       <!--  C14 : variables available with ln_c14 -->
+       <field id="DeltaC14"     long_name="Delta C14"                              unit="permil" grid_ref="grid_T_3D"   />
+       <field id="C14Age"       long_name="Radiocarbon age"                        unit="yr"     grid_ref="grid_T_3D"   />
+       <field id="RAge"         long_name="Reservoir Age"                          unit="yr"     />
+       <field id="qtr_C14"      long_name="Air-sea flux of C14"                    unit="1/m2/s"   />
+       <field id="qint_C14"     long_name="Cumulative air-sea flux of C14"         unit="1/m2"     />
+     </field_group>
+
+     <field_group id="tracer_scalar"  grid_ref="grid_T_2D"  >
+     <!-- PISCES scalar  -->
+       <field id="pno3tot"         long_name="Global mean nitrate concentration"                  unit="mol/m3"   />
+       <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   />
+       <field id="psiltot"         long_name="Global mean silicate concentration"                 unit="mol/m3"   />
+       <field id="palktot"         long_name="Global mean alkalinity concentration"               unit="mol/m3"   />
+       <field id="pfertot"         long_name="Global mean iron concentration"                     unit="mol/m3"   />
+       <field id="tcflx"           long_name="Total Flux of Carbon out of the ocean"              unit="mol/s"   />
+       <field id="tcflxcum"        long_name="Cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   />
+       <field id="tcexp"           long_name="Total Carbon export at 100m"                        unit="mol/s"   />
+       <field id="tintpp"          long_name="Global total integrated primary production"         unit="mol/s"   />
+       <field id="tnfix"           long_name="Global total nitrogen fixation"                     unit="mol/s"   />
+       <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   />
+     <!-- C14 scalar  -->
+       <field id="AtmCO2"          long_name="Global atmospheric CO2"                             unit="ppm"   />
+       <field id="AtmC14"          long_name="Global atmospheric DeltaC14"                        unit="permil"   />
+       <field id="K_C14"           long_name="Global 14C/C exchange velocity"                     unit="m/yr"   />
+       <field id="K_CO2"           long_name="Global CO2 piston velocity"                         unit="cm/h"   />
+       <field id="C14Inv"          long_name="global Radiocarbon ocean inventory"                 unit="10^26 atoms"   />
+     </field_group>
+
+   </field_definition>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref	(revision 8732)
@@ -0,0 +1,131 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM-2 : 1 - dynamics/advection/thermo          (namicerun)
+!! namelists    2 - ice intialisation                  (namiceini)
+!!              3 - ice dynamic                        (namicedyn)
+!!              4 - ice advection                      (namicetrp)
+!!              5 - thermodynamic                      (namicethd)
+!!              6 - ice damping                        (namice_dmp)
+!!              7 - ice diagnostics                    (namicedia)
+!!              8 - ice outputs                        (namiceout)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!-----------------------------------------------------------------------
+&namicerun     !   Share parameters for dynamics/advection/thermo
+!-----------------------------------------------------------------------
+   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
+   cn_icerst_indir = "."              !  directory from which to read input ice restarts
+   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
+   cn_icerst_outdir = "."             !  directory in which to write output ice restarts
+   ln_limdyn     = .true.             !  ice dynamics (T) or thermodynamics only (F)
+   ln_limdmp     = .false.            !  restoring ice thickness and fraction leads   (T => fill  namice_dmp)
+   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 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
+   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
+   rn_creepl   =   1.0e-08 !  creep limit
+   rn_ecc      =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   nn_nevp     =   120     !  number of EVP subcycling iterations
+   telast      =   9600    !  timescale for EVP elastic waves
+   alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses
+/
+!-----------------------------------------------------------------------
+&namicetrp     !   ice transport
+!-----------------------------------------------------------------------
+   bound       =   0.0     !  boundary conditions (=0. no-slip, =1. free-slip)
+/
+!-----------------------------------------------------------------------
+&namicethd     !   ice thermodynamic
+!-----------------------------------------------------------------------
+   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
+   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
+/
+!-----------------------------------------------------------------------
+&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 ! land/sea mask !
+!              !                !  (if <0  months)  !   name   !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_hicif    = 'ice_damping'  ,  -1.              , 'hicif'  ,   .true.     , .true. , 'yearly'  , ''       , ''       ,    ''
+   sn_frld     = '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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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
+/      
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref	(revision 8732)
@@ -0,0 +1,187 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! LIM3 namelist:  
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Diagnostics                        (namicediag)
+!!              3 - Ice initialization                 (namiceini)
+!!              4 - Ice discretization                 (namiceitd)
+!!              5 - Ice dynamics and transport         (namicedyn)
+!!              6 - Ice diffusion                      (namicehdf)
+!!              7 - Ice thermodynamics                 (namicethd)
+!!              8 - Ice salinity                       (namicesal)
+!!              9 - Ice mechanical redistribution      (namiceitdme)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+   jpl              =    5          !  number of ice  categories
+   nlay_i           =    2          !  number of ice  layers
+   nlay_s           =    1          !  number of snow layers (only 1 is working)
+   rn_amax_n        =   0.997       !  maximum tolerated ice concentration NH
+   rn_amax_s        =   0.997       !  maximum tolerated ice concentration SH
+   cn_icerst_in     = "restart_ice" !  suffix of ice restart name (input)
+   cn_icerst_out    = "restart_ice" !  suffix of ice restart name (output)
+   cn_icerst_indir  = "."           !  directory to read   input ice restarts
+   cn_icerst_outdir = "."           !  directory to write output ice restarts
+   ln_limthd        =  .true.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   nn_limdyn        =   2           !     (ln_limdyn=T) switch for ice dynamics   
+                                    !      2: total
+                                    !      1: advection only (no diffusion, no ridging/rafting)
+                                    !      0: advection only (as 1 but with prescribed velocity, bypass rheology)
+   rn_uice          =   0.00001     !     (nn_limdyn=0) ice u-velocity
+   rn_vice          =  -0.00001     !     (nn_limdyn=0) ice v-velocity
+/
+!------------------------------------------------------------------------------
+&namicediag    !   Diagnostics
+!------------------------------------------------------------------------------
+   ln_limdiachk   =  .false.        !  check online the heat, mass & salt budgets (T) or not (F)
+   ln_limdiahsb   =  .false.        !  output the heat, mass & salt budgets (T) or not (F)
+   ln_limctl      =  .false.        !  ice points output for debug (T or F)
+   iiceprt        =    10           !  i-index for debug
+   jiceprt        =    10           !  j-index for debug
+/
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+                  ! -- limistate -- !
+   ln_limini      = .true.          !  activate ice initialization (T) or not (F)
+   ln_limini_file = .false.         !  netcdf file provided for initialization (T) or not (F)
+   rn_thres_sst   =  2.0            !  maximum water temperature with initial ice (degC)
+   rn_hts_ini_n   =  0.3            !  initial real snow thickness (m), North
+   rn_hts_ini_s   =  0.3            !        "            "             South
+   rn_hti_ini_n   =  3.0            !  initial real ice thickness  (m), North
+   rn_hti_ini_s   =  1.0            !        "            "             South
+   rn_ati_ini_n   =  0.9            !  initial ice concentration   (-), North
+   rn_ati_ini_s   =  0.9            !        "            "             South
+   rn_smi_ini_n   =  6.3            !  initial ice salinity     (g/kg), North
+   rn_smi_ini_s   =  6.3            !        "            "             South
+   rn_tmi_ini_n   =  270.           !  initial ice/snw temperature (K), North
+   rn_tmi_ini_s   =  270.           !        "            "             South
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+   nn_catbnd      =    2           !  computation of ice category boundaries based on
+                                   !      1: tanh function
+                                   !      2: h^(-alpha), function of rn_himean
+   rn_himean      =    2.0         !  expected domain-average ice thickness (m), nn_catbnd = 2 only
+/
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+                  ! -- limtrp & limadv -- !
+   nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
+   nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0)
+                  ! -- limitd_me -- !
+   nn_icestr      =    0            !  ice strength parameteriztaion                      
+                                    !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A)
+                                    !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)    
+   rn_pe_rdg      =   17.0          !     (nn_icestr=1) ridging work divided by pot. energy change in ridging
+   rn_pstar       =    2.0e+04      !     (nn_icestr=0) ice strength thickness parameter (N/m2) 
+   rn_crhg        =   20.0          !     (nn_icestr=0) ice strength conc. parameter (-)
+   ln_icestr_bvf  =    .false.      !     ice strength function brine volume (T) or not (F)
+                                    !
+            ! -- limdyn & limrhg -- !
+   rn_cio         =    5.0e-03      !  ice-ocean drag coefficient (-)
+   rn_creepl      =    1.0e-12      !  creep limit (s-1)
+   rn_ecc         =    2.0          !  eccentricity of the elliptical yield curve          
+   nn_nevp        =  120            !  number of EVP subcycles                             
+   rn_relast      =    0.333        !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 
+                                    !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300)
+   ln_landfast    =  .false.        !  landfast ice parameterization (T or F)                           
+   rn_gamma       =    0.15         !     (ln_landfast=T)  fraction of ocean depth that ice must reach to initiate landfast
+                                    !                      recommended range: [0.1 ; 0.25]
+   rn_icebfr      =    10.          !     (ln_landfast=T)  maximum bottom stress per unit area of contact (N/m2)                 
+                                    !                      a very large value ensures ice velocity=0 even with a small contact area
+                                    !                      recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2)
+   rn_lfrelax     =    1.e-5        !     (ln_landfast=T)  relaxation time scale to reach static friction (s-1)                 
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+                     ! -- limhdf -- !
+   nn_ahi0        =    -1           !  horizontal diffusivity computation
+                                    !    -1: no diffusion (bypass limhdf)
+                                    !     0: use rn_ahi0_ref
+                                    !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length )
+                                    !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length )
+   rn_ahi0_ref    = 350.0           !  horizontal sea ice diffusivity (m2/s) 
+                                    !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution
+/
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+                 ! -- limthd_dif -- !
+   rn_kappa_i     = 1.0             !  radiation attenuation coefficient in sea ice (m-1)
+   nn_conv_dif    = 50              !  maximal number of iterations for heat diffusion computation
+   rn_terr_dif    = 1.0e-04         !  maximum temperature after heat diffusion (degC)
+   nn_ice_thcon   = 1               !  sea ice thermal conductivity
+                                    !     0: k = k0 + beta.S/T            (Untersteiner, 1964)
+                                    !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007)
+   ln_it_qnsice   = .true.          !  iterate the surface non-solar flux with surface temperature (T) or not (F)
+   nn_monocat     = 0               !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0)
+                                    !     2: simple piling instead of ridging    --- temporary option
+                                    !     3: activate G(he) only                 --- temporary option
+                                    !     4: activate extra lateral melting only --- temporary option
+   rn_cdsn     = 0.31              !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971)
+                                   !  Obs: 0.1-0.5 (Lecomte et al, JAMES 2013)
+                  ! -- limthd_dh -- !
+   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_betas       = 0.66            !  exponent in lead-ice repratition of snow precipitation
+                                    !     betas = 1 -> equipartition, betas < 1 -> more on leads
+                  ! -- limthd_da -- !
+   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_beta        = 1.0             !     (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[0.8-1.2]
+                                    !      => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2)
+                                    !         0.3 = best fit for western Fram Strait and Antarctica
+                                    !         1.4 = best fit for eastern Fram Strait      
+   rn_dmin        = 8.              !     (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10]
+                                    !      => 6  vs 8m = +40% melting at the peak (A~0.5)
+                                    !         10 vs 8m = -20% melting
+                 ! -- limthd_lac -- !
+   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_hnewice     = 0.1             !  thickness for new ice formation in open water (m)
+   ln_frazil      = .false.         !  Frazil ice parameterization (ice collection as a function of wind)
+   rn_maxfrazb    = 1.0             !     (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base
+   rn_vfrazb      = 0.417           !     (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s)
+   rn_Cfrazb      = 5.0             !     (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom
+                  ! -- limitd_th -- !
+   rn_himin       = 0.1             !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
+/
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+                 ! -- limthd_sal -- !
+   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   nn_icesal      =  2              !  ice salinity option
+                                    !     1: constant ice salinity (S=rn_icesal)
+                                    !     2: varying salinity parameterization S(z,t)
+                                    !     3: prescribed salinity profile S(z), Schwarzacher, 1959
+   rn_icesal      =  4.             !    (nn_icesal=1) ice salinity (g/kg)
+   rn_sal_gd      =  5.             !  restoring ice salinity, gravity drainage (g/kg)
+   rn_time_gd     =  1.73e+6        !  restoring time scale, gravity drainage  (s)
+   rn_sal_fl      =  2.             !  restoring ice salinity, flushing (g/kg)
+   rn_time_fl     =  8.64e+5        !  restoring time scale, flushing (s)
+   rn_simax       = 20.             !  maximum tolerated ice salinity (g/kg)
+   rn_simin       =  0.1            !  minimum tolerated ice salinity (g/kg)
+/
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+                  ! -- limitd_me -- !
+   rn_cs          =   0.5           !  fraction of shearing energy contributing to ridging
+   nn_partfun     =   1             !  type of ridging participation function
+                                    !     0: linear      (Thorndike et al, 1975)
+                                    !     1: exponential (Lipscomb, 2007)
+   rn_gstar       =   0.15          !     (nn_partfun = 0) fractional area of thin ice being ridged 
+   rn_astar       =   0.03          !     (nn_partfun = 1) exponential measure of ridging ice fraction [set to 0.05 if hstar=100]
+   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_hstar       =  25.0           !     (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980)
+   rn_por_rdg     =   0.3           !     (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995)
+   rn_fsnowrdg    =   0.5           !     (ln_ridging = T) snow volume fraction that survives in ridging
+   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_hraft       =   0.75          !     (ln_rafting = T) threshold thickness for rafting (m)
+   rn_craft       =   5.0           !     (ln_rafting = T) squeezing coefficient used in the rafting function
+   rn_fsnowrft    =   0.5           !     (ln_rafting = T) snow volume fraction that survives in rafting
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref	(revision 8732)
@@ -0,0 +1,525 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES reference namelist 
+!!              1  - air-sea exchange                         (nampisext)
+!!              2  - biological parameters                    (nampisbio)
+!!              3  - parameters for nutrient limitations      (nampislim)    
+!!              4  - parameters for phytoplankton             (nampisprod,nampismort)
+!!              5  - parameters for zooplankton               (nampismes,nampiszoo)
+!!              6  - parameters for remineralization          (nampisrem)
+!!              7  - parameters for calcite chemistry         (nampiscal)
+!!              8  - parameters for inputs deposition         (nampissed)
+!!              11 - Damping                                  (nampisdmp)
+!-----------------------------------------------------------------------
+&nampismod     !  Model used 
+!-----------------------------------------------------------------------
+  ln_p2z    = .false.        !  LOBSTER model used
+  ln_p4z    = .true.         !  PISCES model used
+  ln_p5z    = .false.        !  PISCES QUOTA model used
+  ln_ligand = .false.        !  Enable  organic ligands
+/
+!-----------------------------------------------------------------------
+&nampisext     !   air-sea exchange
+!-----------------------------------------------------------------------
+   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F)
+   atcco2     =  280.    ! Constant value atmospheric pCO2 - ln_co2int = F
+   clname     =  'atcco2.txt'  ! Name of atm pCO2 file - ln_co2int = T
+   nn_offset  =  0       ! Offset model-data start year - ln_co2int = T
+!                        ! If your model year is iyy, nn_offset=(years(1)-iyy) 
+!                        ! then the first atmospheric CO2 record read is at years(1)
+/
+!-----------------------------------------------------------------------
+&nampisatm     !  Atmospheric prrssure 
+!-----------------------------------------------------------------------
+!              !  file name   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !              !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_patm     = 'presatm'    ,     -1            , 'patm'    ,  .true.      , .true. , 'yearly'  , ''       , ''       , ''
+   sn_atmco2   = 'presatmco2' ,     -1            , 'xco2'    ,  .true.      , .true. , 'yearly'  , ''       , ''       , ''
+   cn_dir      = './'     !  root directory for the location of the dynamical files
+!
+   ln_presatm    = .false.   ! constant atmopsheric pressure (F) or from a file (T)
+   ln_presatmco2 = .false.   ! Read spatialized atm co2 files [ppm] if TRUE
+/
+!-----------------------------------------------------------------------
+&nampisbio     !   biological parameters
+!-----------------------------------------------------------------------
+   nrdttrc    =  1        ! time step frequency for biology
+   wsbio      =  2.       ! POC sinking speed
+   xkmort     =  2.E-7    ! half saturation constant for mortality
+   ferat3     =  10.E-6   ! Fe/C in zooplankton 
+   wsbio2     =  50.      ! Big particles sinking speed
+   wsbio2max  =  50.      ! Big particles maximum sinking speed
+   wsbio2scale=  5000.    ! Big particles length scale of sinking
+   niter1max  =  1        ! Maximum number of iterations for POC
+   niter2max  =  2        ! Maximum number of iterations for GOC
+!                         !  ln_ligand enabled
+   wfep       =  0.2      ! FeP sinking speed 
+   ldocp      =  1.E-5    ! Phyto ligand production per unit doc 
+   ldocz      =  1.E-5    ! Zoo ligand production per unit doc 
+   lthet      =  0.5      ! Proportional loss of ligands due to Fe uptake 
+!                         !  ln_p5z enabled
+   no3rat3    =  0.182    ! N/C ratio in zooplankton
+   po4rat3    =  0.0094   ! P/C ratio in zooplankton
+/
+!-----------------------------------------------------------------------
+&namp4zlim     !   parameters for nutrient limitations for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+   concnno3   =  1.e-6    ! Nitrate half saturation of nanophytoplankton
+   concdno3   =  3.E-6    ! Nitrate half saturation for diatoms
+   concnnh4   =  1.E-7    ! NH4 half saturation for phyto
+   concdnh4   =  3.E-7    ! NH4 half saturation for diatoms
+   concnfer   =  1.E-9    ! Iron half saturation for phyto
+   concdfer   =  3.E-9    ! Iron half saturation for diatoms
+   concbfe    =  1.E-11   ! Iron half-saturation for DOC remin.
+   concbnh4   =  2.E-8    ! NH4 half saturation for DOC remin.
+   concbno3   =  2.E-7    ! Nitrate half saturation for DOC remin.
+   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms
+   xsizephy   =  1.E-6    ! Minimum size criteria for phyto
+   xsizern    =  3.0      ! Size ratio for nanophytoplankton
+   xsizerd    =  3.0      ! Size ratio for diatoms
+   xksi1      =  2.E-6    ! half saturation constant for Si uptake
+   xksi2      =  20E-6    ! half saturation constant for Si/C
+   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
+   qnfelim    =  7.E-6    ! Optimal quota of phyto
+   qdfelim    =  7.E-6    ! Optimal quota of diatoms
+   caco3r     =  0.3      ! mean rain ratio
+   oxymin     =  1.E-6    ! Half-saturation constant for anoxia
+/
+!-----------------------------------------------------------------------
+&namp5zlim     !   parameters for nutrient limitations PISCES QUOTA - ln_p5z
+!-----------------------------------------------------------------------
+   concnno3   =  3e-6     ! Nitrate half saturation of nanophytoplankton
+   concpno3   =  1e-6
+   concdno3   =  4E-6     ! Phosphate half saturation for diatoms
+   concnnh4   =  1.5E-6   ! NH4 half saturation for phyto
+   concpnh4   =  4E-7
+   concdnh4   =  2E-6     ! NH4 half saturation for diatoms
+   concnpo4   =  3E-6     ! PO4 half saturation for phyto
+   concppo4   =  1.5E-6
+   concdpo4   =  4E-6     ! PO4 half saturation for diatoms
+   concnfer   =  3E-9   ! Iron half saturation for phyto
+   concpfer   =  1.5E-9
+   concdfer   =  4E-9   ! Iron half saturation for diatoms
+   concbfe    =  1.E-11   ! Half-saturation for Fe limitation of Bacteria
+   concbnh4   =  1.E-7    ! NH4 half saturation for phyto
+   concbno3   =  5.E-7    ! Phosphate half saturation for diatoms
+   concbpo4   =  1E-7     ! Phosphate half saturation for bacteria
+   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms
+   xsizephy   =  1.E-6    ! Minimum size criteria for phyto
+   xsizepic   =  1.E-6
+   xsizern    =  1.0      ! Size ratio for nanophytoplankton
+   xsizerp    =  1.0
+   xsizerd    =  4.0      ! Size ratio for diatoms
+   xksi1      =  2.E-6    ! half saturation constant for Si uptake
+   xksi2      =  20E-6  ! half saturation constant for Si/C
+   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
+   caco3r     =  0.35     ! mean rain ratio
+   oxymin     =  1.E-6    ! Half-saturation constant for anoxia
+/
+!-----------------------------------------------------------------------
+&namp5zquota    !   parameters for nutrient limitations PISCES quota - ln_p5z
+!-----------------------------------------------------------------------
+   qfnopt     =  7.E-6    ! Optimal Fe quota of nanophyto
+   qfpopt     =  7.E-6    ! Optimal Fe quota of picophyto
+   qfdopt     =  7.E-6    ! Optimal quota of diatoms
+   qnnmin     =  0.29     ! Minimal N quota for nano
+   qnnmax     =  1.39     ! Maximal N quota for nano
+   qpnmin     =  0.28     ! Minimal P quota for nano
+   qpnmax     =  1.06     ! Maximal P quota for nano
+   qnpmin     =  0.42     ! Minimal N quota for pico
+   qnpmax     =  1.39     ! Maximal N quota for pico
+   qppmin     =  0.25     ! Minimal P quota for pico
+   qppmax     =  0.7      ! Maximal P quota for pico
+   qndmin     =  0.25     ! Minimal N quota for diatoms
+   qndmax     =  1.39     ! Maximal N quota for diatoms
+   qpdmin     =  0.29     ! Minimal P quota for diatoms
+   qpdmax     =  1.32     ! Maximal P quota for diatoms
+   qfnmax     =  40E-6    ! Maximal Fe quota for nano
+   qfpmax     =  40E-6    ! Maximal Fe quota for pico
+   qfdmax     =  40E-6    ! Maximal Fe quota for diatoms
+/
+!-----------------------------------------------------------------------
+&nampisopt     !   parameters for optics
+!-----------------------------------------------------------------------
+!              !  file name       ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                  !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_par      = 'par.orca'       ,     24            , 'fr_par'  ,  .true.      , .true. , 'yearly'  , ''       , ''       , ''
+   cn_dir      = './'      !  root directory for the location of the dynamical files
+   ln_varpar   =  .true.   ! boolean for PAR variable
+   parlux      =  0.43      ! Fraction of shortwave as PAR
+/ 
+!-----------------------------------------------------------------------
+&namp4zprod     !   parameters for phytoplankton growth for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+   pislopen   =  2.       ! P-I slope
+   pisloped   =  2.       ! P-I slope  for diatoms
+   xadap      =  0.       ! Adaptation factor to low light
+   excretn    =  0.05     ! excretion ratio of phytoplankton
+   excretd    =  0.05     ! excretion ratio of diatoms
+   ln_newprod =  .true.   ! Enable new parame. of production (T/F) 
+   bresp      =  0.033    ! Basal respiration rate
+   chlcnm     =  0.033    ! Maximum Chl/C in nanophytoplankton
+   chlcdm     =  0.05     ! Maximum Chl/C in diatoms
+   chlcmin    =  0.004    ! Minimum Chl/c in phytoplankton
+   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton
+   fecdm      =  40E-6    ! Maximum Fe/C in diatoms
+   grosip     =  0.159    ! mean Si/C ratio
+/
+!-----------------------------------------------------------------------
+&namp5zprod     !   parameters for phytoplankton growth for PISCES quota - ln_p5z
+!-----------------------------------------------------------------------
+   pislopen   =  3.       ! P-I slope
+   pislopep   =  3.       ! P-I slope for picophytoplankton
+   pisloped   =  3.       ! P-I slope  for diatoms
+   excretn    =  0.05     ! excretion ratio of phytoplankton
+   excretp    =  0.05     ! excretion ratio of picophytoplankton
+   excretd    =  0.05     ! excretion ratio of diatoms
+   xadap      =  0.       ! Adaptation factor to low light
+   bresp      =  0.02     ! Basal respiration rate
+   thetannm   =  0.25     ! Maximum Chl/N in nanophytoplankton
+   thetanpm   =  0.25     ! Maximum Chl/N in picophytoplankton
+   thetandm   =  0.3      ! Maximum Chl/N in diatoms
+   chlcmin    =  0.004    ! Minimum Chl/c in phytoplankton
+   grosip     =  0.131    ! mean Si/C ratio
+/
+!-----------------------------------------------------------------------
+&namp4zmort     !   parameters for phytoplankton sinks for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+   wchl       =  0.01     ! quadratic mortality of phytoplankton
+   wchld      =  0.01     ! maximum quadratic mortality of diatoms
+   wchldm     =  0.03     ! maximum quadratic mortality of diatoms
+   mprat      =  0.01     ! phytoplankton mortality rate
+   mprat2     =  0.01     ! Diatoms mortality rate
+/
+!-----------------------------------------------------------------------
+&namp5zmort     !   parameters for phytoplankton sinks for PISCES quota - ln_p5z
+!-----------------------------------------------------------------------
+   wchln      =  0.01     ! quadratic mortality of nanophytoplankton
+   wchlp      =  0.01     ! quadratic mortality of picophytoplankton
+   wchld      =  0.01     ! maximum quadratic mortality of diatoms
+   wchldm     =  0.02     ! maximum quadratic mortality of diatoms
+   mpratn     =  0.01     ! nanophytoplankton mortality rate
+   mpratp     =  0.01     ! picophytoplankton mortality rate
+   mprat2     =  0.01     ! Diatoms mortality rate
+/
+!-----------------------------------------------------------------------
+&namp4zmes     !   parameters for mesozooplankton for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+   part2      =  0.75     ! part of calcite not dissolved in mesozoo guts
+   grazrat2   =  0.75     ! maximal mesozoo grazing rate
+   resrat2    =  0.005    ! exsudation rate of mesozooplankton
+   mzrat2     =  0.03     ! mesozooplankton mortality rate
+   xprefc     =  1.       ! mesozoo preference for diatoms
+   xprefp     =  0.3      ! mesozoo preference for nanophyto.
+   xprefz     =  1.       ! mesozoo preference for microzoo.
+   xprefpoc   =  0.3      ! mesozoo preference for poc
+   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton 
+   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton 
+   xthresh2phy = 1E-8     ! nanophyto feeding threshold for mesozooplankton 
+   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton 
+   xthresh2   =  3E-7     ! Food threshold for grazing
+   xkgraz2    =  20.E-6   ! half saturation constant for meso grazing
+   epsher2    =  0.35     ! Efficicency of Mesozoo growth
+   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM
+   unass2     =  0.3      ! non assimilated fraction of P by mesozoo
+   grazflux   =  2.e3     ! flux-feeding rate
+/
+!-----------------------------------------------------------------------
+&namp5zmes     !   parameters for mesozooplankton
+!-----------------------------------------------------------------------
+   part2      =  0.75     ! part of calcite not dissolved in mesozoo guts
+   grazrat2   =  0.85     ! maximal mesozoo grazing rate
+   bmetexc2   =  .true.   ! Metabolic use of excess carbon 
+   resrat2    =  0.005    ! exsudation rate of mesozooplankton
+   mzrat2     =  0.02     ! mesozooplankton mortality rate
+   xpref2d    =  1.       ! zoo preference for phyto
+   xpref2p    =  1.       ! zoo preference for POC
+   xpref2z    =  1.       ! zoo preference for zoo
+   xpref2m    =  0.2      ! meso preference for zoo
+   xpref2c    =  0.3      ! zoo preference for poc
+   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton
+   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton
+   xthresh2phy = 1E-8     ! nanophyto feeding threshold for mesozooplankton
+   xthresh2mes = 1E-8     ! meso feeding threshold for mesozooplankton
+   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton
+   xthresh2    =  3E-7     ! Food threshold for grazing
+   xkgraz2     =  20.E-6   ! half sturation constant for meso grazing
+   epsher2     =  0.5      ! Efficicency of Mesozoo growth
+   ssigma2     =  0.5     ! Fraction excreted as semi-labile DOM
+   srespir2    =  0.2     ! Active respiration
+   unass2c     =  0.3     ! non assimilated fraction of P by mesozoo
+   unass2n     =  0.3     ! non assimilated fraction of N by mesozoo
+   unass2p     =  0.3     ! non assimilated fraction of P by mesozoo
+   grazflux   =  3.e3     ! flux-feeding rate
+/
+!-----------------------------------------------------------------------
+&namp4zzoo     !   parameters for microzooplankton for PISCES std - ln_p4z
+!-----------------------------------------------------------------------
+   part       =  0.5      ! part of calcite not dissolved in microzoo guts
+   grazrat    =  3.0      ! maximal zoo grazing rate
+   resrat     =  0.03     ! exsudation rate of zooplankton
+   mzrat      =  0.004    ! zooplankton mortality rate
+   xpref2c    =  0.1      ! Microzoo preference for POM
+   xpref2p    =  1.       ! Microzoo preference for Nanophyto
+   xpref2d    =  0.5      ! Microzoo preference for Diatoms
+   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton 
+   xthreshphy =  1.E-8    ! Nanophyto feeding threshold for microzooplankton 
+   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton 
+   xthresh    =  3.E-7    ! Food threshold for feeding
+   xkgraz     =  20.E-6   ! half sturation constant for grazing
+   epsher     =  0.3      ! Efficiency of microzoo growth
+   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM
+   unass      =  0.3      ! non assimilated fraction of phyto by zoo
+/
+!-----------------------------------------------------------------------
+&namp5zzoo     !   parameters for microzooplankton
+!-----------------------------------------------------------------------
+   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa
+   grazrat    =  2.75     ! maximal zoo grazing rate
+   bmetexc    =  .true.   ! Metabolic use of excess carbon
+   resrat     =  0.03     ! exsudation rate of zooplankton
+   mzrat      =  0.005    ! zooplankton mortality rate
+   xprefc     =  0.1      ! Microzoo preference for POM
+   xprefn     =  1.       ! Microzoo preference for Nanophyto
+   xprefp     =  1.6      ! Microzoo preference for picophyto
+   xprefd     =  1.0      ! Microzoo preference for Diatoms
+   xprefz     =  0.3      ! Microzoo preference for microzooplankton
+   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton
+   xthreshphy =  1.E-8    ! Nanophyto feeding threshold for microzooplankton
+   xthreshpic =  1.E-8
+   xthreshzoo =  1.E-8    ! Nanophyto feeding threshold for microzooplankton
+   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton
+   xthresh    =  3.E-7    ! Food threshold for feeding
+   xkgraz     =  20.E-6   ! half sturation constant for grazing
+   epsher     =  0.5      ! Efficiency of microzoo growth
+   ssigma     =  0.5      ! Fraction excreted as semi-labile DOM
+   srespir    =  0.2      ! Active respiration
+   unassc     =  0.3      ! non assimilated fraction of C by zoo
+   unassn     =  0.3      ! non assimilated fraction of C by zoo
+   unassp     =  0.3      ! non assimilated fraction of C by zoo
+/
+!-----------------------------------------------------------------------
+&nampisfer     !   parameters for iron chemistry
+!-----------------------------------------------------------------------
+   ln_fechem =  .false.   ! complex iron chemistry ( T/F )
+   ln_ligvar =  .false.   ! variable ligand concentration
+   ln_fecolloid = .false. ! variable colloidal fraction
+   xlam1        =  0.005  ! scavenging rate of Iron
+   xlamdust     =  150.0  ! Scavenging rate of dust
+   ligand       =  0.6E-9 ! Ligands concentration 
+   kfep         =  0.     ! Nanoparticle formation rate constant
+/
+!-----------------------------------------------------------------------  
+&nampisrem     !   parameters for remineralization
+!-----------------------------------------------------------------------
+   xremik    =  0.3       ! remineralization rate of DOC
+   nitrif    =  0.05      ! NH4 nitrification rate
+   xsirem    =  0.003     ! remineralization rate of Si
+   xsiremlab =  0.03      ! fast remineralization rate of Si
+   xsilab    =  0.5       ! Fraction of labile biogenic silica
+   feratb    =  10.E-6    ! Fe/C quota in bacteria
+   xkferb    =  2.5E-10   ! Half-saturation constant for bacteria Fe/C
+!                         ! ln_p5z
+   xremikc   =  0.25      ! remineralization rate of DOC
+   xremikn   =  0.35      ! remineralization rate of DON
+   xremikp   =  0.4       ! remineralization rate of DOP
+!   feratb    =  20E-6     ! Bacterial Fe/C ratio
+!   xkferb    =  3E-10     ! Half-saturation constant for bact. Fe/C
+/
+!-----------------------------------------------------------------------
+&nampispoc     !   parameters for organic particles
+!-----------------------------------------------------------------------
+   xremip    =  0.035     ! remineralisation rate of PON
+   jcpoc     =  15        ! Number of lability classes
+   rshape    =  1.0       ! Shape of the gamma function
+!                         ! ln_p5z
+   xremipc   =  0.02      ! remineralisation rate of POC
+   xremipn   =  0.025     ! remineralisation rate of PON
+   xremipp   =  0.03      ! remineralisation rate of POP
+/
+!-----------------------------------------------------------------------
+&nampiscal     !   parameters for Calcite chemistry
+!-----------------------------------------------------------------------
+   kdca       =  6.       ! calcite dissolution rate constant (1/time)
+   nca        =  1.       ! order of dissolution reaction (dimensionless)
+/
+!-----------------------------------------------------------------------
+&nampissbc     !   parameters for inputs deposition
+!-----------------------------------------------------------------------
+!              !  file name        ! frequency (hours) ! variable      ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                   !  (if <0  months)  !   name        !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_dust     = 'dust.orca'       ,     -1            , 'dust'        ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_solub    = 'solubility.orca' ,    -12            , 'solubility1' ,  .false.     , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdic = 'river.orca'      ,    120            , 'riverdic'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdoc = 'river.orca'      ,    120            , 'riverdoc'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdin = 'river.orca'      ,    120            , 'riverdin'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdon = 'river.orca'      ,    120            , 'riverdon'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdip = 'river.orca'      ,    120            , 'riverdip'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdop = 'river.orca'      ,    120            , 'riverdop'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_riverdsi = 'river.orca'      ,    120            , 'riverdsi'    ,  .true.      , .true. , 'yearly'  , ''       , ''    , ''
+   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'        ,  .false.     , .true. , 'yearly'  , ''       , ''    , ''
+   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'       ,  .false.     , .true. , 'yearly'  , ''       , ''    , ''
+   sn_hydrofe  = 'hydrofe.orca'    ,    -12            , 'epsdb'       ,  .false.     , .true. , 'yearly'  , ''       , ''    , ''
+!
+   cn_dir      = './'      !  root directory for the location of the dynamical files
+   ln_dust     =  .true.   ! boolean for dust input from the atmosphere
+   ln_solub    =  .true.   ! boolean for variable solubility of atm. Iron
+   ln_river    =  .true.   ! boolean for river input of nutrients
+   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N
+   ln_ironsed  =  .true.   ! boolean for Fe input from sediments
+   ln_ironice  =  .true.   ! boolean for Fe input from sea ice
+   ln_hydrofe  =  .false.  ! boolean for from hydrothermal vents
+   sedfeinput  =  2.e-9    ! Coastal release of Iron
+   dustsolub   =  0.02     ! Solubility of the dusta
+   mfrac       =  0.035    ! Fe mineral fraction of dust
+   wdust       =  2.0      ! Dust sinking speed 
+   icefeinput  =  15.e-9   ! Iron concentration in sea ice
+   nitrfix     =  1.e-7    ! Nitrogen fixation rate
+   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2)
+   concfediaz  =  1.e-10   ! Diazotrophs half-saturation Cste for Iron
+   hratio      =  1.e+7    ! Fe to 3He ratio assumed for vent iron supply 
+!                          ! ln_ligand
+   fep_rats    =  1.       ! Fep/Fer ratio from sed sources 
+   fep_rath    =  1.       ! Fep/Fer ratio from sed hydro sources 
+   lgw_rath    =  0.5      ! Weak ligand ratio from sed hydro sources 
+/
+!-----------------------------------------------------------------------
+&nampislig      !  Namelist parameters for ligands, nampislig
+!-----------------------------------------------------------------------
+   rfep        =  0.001    ! Dissolution rate of FeP
+   rlgw        =  1.       ! Lifetime (years) of weak ligands
+   rlig        =  1.E-4    ! Remin ligand production per unit C
+   prlgw       =  1.E-4    ! Photolysis of weak ligand
+   rlgs        =  1000.    ! Lifetime (years) of strong ligands
+/
+!-----------------------------------------------------------------------
+&nampisice      !  Prescribed sea ice tracers
+!-----------------------------------------------------------------------
+! constant ocean tracer concentrations are defined in trcice_pisces.F90 (Global, Arctic, Antarctic and Baltic)
+! trc_ice_ratio     * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+!                   * -1 => the ice-ocean tracer concentration ratio follows the 
+!                           ice-ocean salinity ratio
+!                   * -2 => tracer concentration in sea ice is prescribed and 
+!                           trc_ice_prescr is used
+! trc_ice_prescr    * prescribed tracer concentration. used only if 
+!                     trc_ice_ratio = -2. equals -99 if not used.
+! cn_trc_o          * 'GL' use global ocean values making the Baltic distinction only
+!                     'AA' use specific Arctic/Antarctic/Baltic values
+!-----------------------------------------------------------------------
+!    sn_tri_ ! trc_ice_ratio ! trc_ice_prescr !     cn_trc_o
+   sn_tri_dic =           -1.,           -99.,          'AA'
+   sn_tri_doc =            0.,           -99.,          'AA'
+   sn_tri_tal =           -1.,           -99.,          'AA'
+   sn_tri_oxy =           -1.,           -99.,          'AA'
+   sn_tri_cal =            0.,           -99.,          'AA'
+   sn_tri_po4 =           -1.,           -99.,          'AA'
+   sn_tri_poc =            0.,           -99.,          'AA'
+   sn_tri_goc =            0.,           -99.,          'AA'
+   sn_tri_bfe =            0.,           -99.,          'AA'
+   sn_tri_num =            0.,           -99.,          'AA'
+   sn_tri_sil =           -1.,           -99.,          'AA'
+   sn_tri_dsi =            0.,           -99.,          'AA'
+   sn_tri_gsi =            0.,           -99.,          'AA'
+   sn_tri_phy =            0.,           -99.,          'AA'
+   sn_tri_dia =            0.,           -99.,          'AA'
+   sn_tri_zoo =            0.,           -99.,          'AA'
+   sn_tri_mes =            0.,           -99.,          'AA'
+   sn_tri_fer =           -2.,          15E-9,          'AA'
+   sn_tri_sfe =            0.,           -99.,          'AA'
+   sn_tri_dfe =            0.,           -99.,          'AA'
+   sn_tri_nfe =            0.,           -99.,          'AA'
+   sn_tri_nch =            0.,           -99.,          'AA'
+   sn_tri_dch =            0.,           -99.,          'AA'
+   sn_tri_no3 =           -1.,           -99.,          'AA'
+   sn_tri_nh4 =            1.,           -99.,          'AA'
+/
+!-----------------------------------------------------------------------
+&nampisdmp     !  Damping 
+!-----------------------------------------------------------------------
+   ln_pisdmp    =  .true.     !  Relaxation fo some tracers to a mean value
+   nn_pisdmp    =  5475       !  Frequency of Relaxation 
+/
+!-----------------------------------------------------------------------
+&nampismass     !  Mass conservation
+!-----------------------------------------------------------------------
+   ln_check_mass =  .false.    !  Check mass conservation
+/
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES reduced (key_pisces_reduced, ex LOBSTER) : namelists
+!!              1  - biological parameters for phytoplankton    (namlobphy)
+!!              2  - biological parameters for nutrients        (namlobnut)
+!!              3  - biological parameters for zooplankton      (namlobzoo)    
+!!              4  - biological parameters for detritus         (namlobdet)
+!!              5  - biological parameters for DOM              (namlobdom)
+!!              6  - parameters from aphotic layers to sediment (namlobsed)
+!!              7  - general coefficients                       (namlobrat)
+!!              8  - optical parameters                         (namlobopt)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namlobphy     !   biological parameters for phytoplankton
+!-----------------------------------------------------------------------
+   tmumax  =  1.21e-5   ! maximal phytoplankton growth rate            [s-1] 
+   rgamma  =  0.05      ! phytoplankton exudation fraction             [%]
+   fphylab =  0.75      ! NH4 fraction of phytoplankton exsudation     
+   tmminp  =  5.8e-7    ! minimal phytoplancton mortality rate         [0.05/86400 s-1=20 days] 
+   aki     =  33.       ! light photosynthesis half saturation constant[W/m2]
+/
+!-----------------------------------------------------------------------
+&namlobnut     !   biological parameters for nutrients
+!-----------------------------------------------------------------------
+   akno3   =  0.7       ! nitrate limitation half-saturation value     [mmol/m3]
+   aknh4   =  0.001     ! ammonium limitation half-saturation value    [mmol/m3]
+   taunn   =  5.80e-7   ! nitrification rate                           [s-1]  
+   psinut  =  3.        ! inhibition of nitrate uptake by ammonium
+/
+!-----------------------------------------------------------------------
+&namlobzoo     !   biological parameters for zooplankton
+!-----------------------------------------------------------------------
+   rppz    = 0.8        ! zooplankton nominal preference for phytoplancton food  [%]
+   taus    = 9.26E-6    ! specific zooplankton maximal grazing rate              [s-1] 
+!                       ! 0.75/86400 s-1=8.680555E-6    1/86400 = 1.15e-5
+   aks     = 1.         ! half-saturation constant for total zooplankton grazing [mmolN.m-3]
+   rpnaz   = 0.3        ! non-assimilated phytoplankton by zooplancton           [%]
+   rdnaz   = 0.3        ! non-assimilated detritus by zooplankton                [%] 
+   tauzn   = 8.1e-7     ! zooplancton specific excretion rate                    [0.1/86400 s-1=10 days] 
+   fzoolab = 0.5        ! NH4 fraction of zooplankton excretion
+   fdbod   = 0.5        ! zooplankton mortality fraction that goes to detritus
+   tmminz  = 2.31e-6    ! minimal zooplankton mortality rate                     [(mmolN/m3)-1 d-1]
+/
+!-----------------------------------------------------------------------
+&namlobdet     !   biological parameters for detritus
+!-----------------------------------------------------------------------
+   taudn   = 5.80e-7    ! detritus breakdown rate                        [0.1/86400 s-1=10 days]
+   fdetlab = 0.         ! NH4 fraction of detritus dissolution           
+/
+!-----------------------------------------------------------------------
+&namlobdom     !   biological parameters for DOM
+!-----------------------------------------------------------------------
+   taudomn = 6.43e-8    ! DOM breakdown rate                             [s-1] 
+!                       ! slow remineralization rate of semi-labile dom to nh4 (1 month)
+/
+!-----------------------------------------------------------------------
+&namlobsed     !   parameters from aphotic layers to sediment
+!-----------------------------------------------------------------------
+   sedlam     = 3.86e-7    ! time coefficient of POC remineralization in sediments [s-1]
+   sedlostpoc = 0.         ! mass of POC lost in sediments
+   vsed       = 3.47e-5    ! detritus sedimentation speed                   [m/s]
+   xhr        = -0.858     ! coeff for martin''s remineralisation profile
+/
+!-----------------------------------------------------------------------
+&namlobrat     !   general coefficients
+!-----------------------------------------------------------------------
+   rcchl   = 60.       ! Carbone/Chlorophyl ratio                     [mgC.mgChla-1]
+   redf    = 6.56       ! redfield ratio (C:N) for phyto
+   reddom  = 6.56       ! redfield ratio (C:N) for DOM
+/
+!-----------------------------------------------------------------------
+&namlobopt     !   optical parameters
+!-----------------------------------------------------------------------
+   xkg0   = 0.0232     ! green absorption coefficient of water
+   xkr0   = 0.225      ! red absorption coefficent of water
+   xkgp   = 0.074      ! green absorption coefficient of chl
+   xkrp   = 0.037      ! red absorption coefficient of chl
+   xlg    = 0.674      ! green chl exposant for absorption
+   xlr    = 0.629      ! red chl exposant for absorption
+   rpig   = 0.7        ! chla/chla+pheo ratio
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ref	(revision 8732)
@@ -0,0 +1,1199 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!!                            namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namcfg, namzgr, namdom, namtsd, namcrs, namc1d, namc1d_uvd)
+!!              3 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_sas)
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave)
+!!              4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx, namzdf_tmx_new)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
+!!             10 - miscellaneous    (nammpp, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun       parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    5475   !  last  time step (std 5475)
+   nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_time0    =       0   !  initial time of day in hhmm
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      nn_euler    =    1            !  = 0 : start with forward time step if ln_rstart=T
+      nn_rstctl   =    0            !  restart control ==> activated only if ln_rstart=T
+      !                             !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
+      !                             !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
+      !                             !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
+      cn_ocerst_in    = "restart"   !  suffix of ocean restart name (input)
+      cn_ocerst_indir = "."         !  directory from which to read input ocean restarts
+      cn_ocerst_out   = "restart"   !  suffix of ocean restart name (output)
+      cn_ocerst_outdir= "."         !  directory in which to write output ocean restarts
+   ln_iscpl    = .false.   !  cavity evolution forcing or coupling to ice sheet model
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
+   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
+   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+!
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namcfg       parameters of the configuration
+!!   namzgr       vertical coordinate                                   (default: NO selection)
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namwad       Wetting and drying                                    (default F)
+!!   namtsd       data: temperature & salinity
+!!   namcrs       coarsened grid (for outputs and/or TOP)               ("key_crs")
+!!   namc1d       1D configuration options                              ("key_c1d")
+!!   namc1d_dyndmp 1D newtonian damping applied on currents             ("key_c1d")
+!!   namc1d_uvd   1D data (currents)                                    ("key_c1d")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "domain_cfg"         ! domain configuration filename
+      !
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+      cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename
+      !
+   ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present
+   !                       !  in netcdf input files, as the start j-row for reading
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    0      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd        !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+!              !  file name                 ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                            !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_tem = 'data_1m_potential_temperature_nomask',     -1      ,'votemper',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_sal = 'data_1m_salinity_nomask'             ,     -1      ,'vosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_tsd_init = .true.    !  Initialisation of ocean T & S with T & S input data (T) or not (F)
+   ln_tsd_tradmp = .true.  !  damping of ocean T & S toward T & S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namwad        !   Wetting and drying                                   (default F)
+!-----------------------------------------------------------------------
+   ln_wd       = .false.   !  T/F activation of wetting and drying
+   rn_wdmin1   =  0.1      !  Minimum wet depth on dried cells
+   rn_wdmin2   =  0.01     !  Tolerance of min wet depth on dried cells
+   rn_wdld     =  20.0     !  Land elevation below which wetting/drying is allowed
+   nn_wdit     =  10       !  Max iterations for W/D limiter
+/
+!-----------------------------------------------------------------------
+&namcrs        !   coarsened grid (for outputs and/or TOP)              ("key_crs")
+!-----------------------------------------------------------------------
+   nn_factx    = 3         !  Reduction factor of x-direction
+   nn_facty    = 3         !  Reduction factor of y-direction
+   nn_binref   = 0         !  Bin centering preference: NORTH or EQUAT
+                           !  0, coarse grid is binned with preferential treatment of the north fold
+                           !  1, coarse grid is binned with centering at the equator
+                           !    Symmetry with nn_facty being odd-numbered. Asymmetry with even-numbered nn_facty.
+   nn_msh_crs  = 1         !  create (=1) a mesh file or not (=0)
+   nn_crs_kz   = 0         ! 0, MEAN of volume boxes
+                           ! 1, MAX of boxes
+                           ! 2, MIN of boxes
+   ln_crs_wn   = .true.    ! wn coarsened (T) or computed using horizontal divergence ( F )
+/
+!-----------------------------------------------------------------------
+&namc1d        !   1D configuration options                             ("key_c1d")
+!-----------------------------------------------------------------------
+   rn_lat1d    =      50   !  Column latitude (default at PAPA station)
+   rn_lon1d    =    -145   !  Column longitude (default at PAPA station)
+   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F)
+/
+!-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namc1d_uvd    !   data: U & V currents                                 ("key_c1d")
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , ''
+   sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , ''
+!
+   cn_dir        = './'    !  root directory for the location of the files
+   ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F)
+   ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_flx      flux               formulation                     (ln_flx     =T)
+!!   namsbc_blk      Bulk formulae formulation                          (ln_blk     =T)
+!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3" )
+!!   namsbc_sas      Stand-Alone Surface module
+!!   namtra_qsr      penetrative solar radiation                        (ln_traqsr  =T)
+!!   namsbc_rnf      river runoffs                                      (ln_rnf     =T)
+!!   namsbc_isf      ice shelf melting/freezing                         (nn_isf     >0)
+!!   namsbc_iscpl    coupling option between land ice model and ocean
+!!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T)
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)        (ln_ssr     =T)
+!!   namsbc_alb      albedo parameters
+!!   namsbc_wave     external fields from wave model                    (ln_wave    =T)
+!!   namberg         iceberg floats                                     (ln_icebergs=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice & iceberg model call)
+                     ! Type of air-sea fluxes 
+   ln_usr      = .false.   !  user defined formulation                  (T => check usrdef_sbc)
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk      = .true.    !  Bulk formulation                          (T => fill namsbc_blk )
+                     ! Type of coupling (Ocean/Ice/Atmosphere) :
+   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
+   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
+   nn_components = 0       !  configuration of the opa-sas OASIS coupling
+                           !  =0 no opa-sas OASIS coupling: default single executable configuration
+                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
+                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
+   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)
+                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled
+                           !  = 0  Average per-category fluxes (forced and coupled mode)
+                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
+                           !  = 2  Redistribute a single flux over categories (coupled mode only)
+                     ! Sea-ice :
+   nn_ice      = 3         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 to 4 :  ice-model used (LIM2, LIM3 or CICE)                         ("key_lim3", "key_lim2", or "key_cice")
+   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =1 levitating ice with mass and salt exchange but no presure effect
+                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
+                     ! Misc. options of sbc : 
+   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 2         !  FreshWater Budget: =0 unchecked
+                           !     =1 global mean of e-p-r set to zero at each time step
+                           !     =2 annual global mean of e-p-r set to zero
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_isf      = .false.   !  ice shelf                                 (T   => fill namsbc_isf)
+   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave)
+   ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave)
+   ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 
+   ln_tauoc    = .false.   !  Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave)
+   ln_stcor    = .false.   !  Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave)
+   nn_lsm      = 0         !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) ,
+                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_utau     = '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_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T)
+!-----------------------------------------------------------------------
+!              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                              ! rotation ! land/sea mask !
+!              !                              !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                             ! pairing  ! filename      !
+   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_slp      = 'slp.15JUNE2009_fill'        ,         6         , 'SLP'     ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_tdif     = 'taudif_core'                ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   !                    !  bulk algorithm :
+   ln_NCAR     = .false.   ! "NCAR"      algorithm   (Large and Yeager 2008)
+   ln_COARE_3p0= .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
+   ln_COARE_3p5= .false.   ! "COARE 3.5" algorithm   (Edson et al. 2013)
+   ln_ECMWF    = .false.   ! "ECMWF"     algorithm   (IFS cycle 31)
+   !
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_zqt      = 10.       !  Air temperature and humidity reference height (m)
+   rn_zu       = 10.       !  Wind vector reference height (m)
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
+                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
+   ln_Cd_L12   = .false.   !  Modify the drag ice-atm and oce-atm depending on ice concentration
+                           !  This parameterization is from Lupkes et al. (JGR 2012)
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+!                    !     description      !  multiple  !    vector   !      vector          ! vector !
+!                    !                      ! categories !  reference  !    orientation       ! grids  !
+! send
+   sn_snd_temp   =   'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_alb    =   'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_thick  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_crt    =   'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'
+   sn_snd_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_crtw   =       'none'                 ,    'no'    ,     ''      ,         ''           , 'U,V'
+   sn_snd_ifrac  =       'none'                 ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_wlev   =       'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
+! receive
+   sn_rcv_w10m   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_taumod =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_tau    =   'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'
+   sn_rcv_dqnsdt =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_qsr    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_qns    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_emp    =   'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_rnf    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_hsig   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_iceflx =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_mslp   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_phioc  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_sdrfx  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_sdrfy  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_wper   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_wnum   =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_wstrf  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_wdrag  =       'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+!
+   nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models
+   !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+/
+!-----------------------------------------------------------------------
+&namsbc_sas    !   Stand Alone Surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   l_sasread   = .TRUE.   ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE.
+   sn_usp      = 'sas_grid_U',     120           , 'vozocrtx',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_vsp      = 'sas_grid_V',     120           , 'vomecrty',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_tem      = 'sas_grid_T',     120           , 'sosstsst',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_sal      = 'sas_grid_T',     120           , 'sosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_ssh      = 'sas_grid_T',     120           , 'sossheig',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_e3t      = 'sas_grid_T',     120           , 'e3t_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_frq      = 'sas_grid_T',     120           , 'frq_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+
+   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
+   ln_read_frq = .false.   !  specify whether we must read frq or not
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T)
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   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_si1      =   23.0    !  2 bands: longest depth of extinction
+   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T)
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_rnf_mouth= .true.    !  specific treatment at rivers mouths
+      rn_hrnf     =  15.e0    !  depth over which enhanced vertical mixing is used    (ln_rnf_mouth=T)
+      rn_avt_rnf  =   1.e-3   !  value of the additional vertical mixing coef. [m2/s] (ln_rnf_mouth=T)
+   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
+   ln_rnf_depth_ini = .false. ! compute depth at initialisation from runoff file
+      rn_rnf_max  = 5.735e-4  !  max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )
+      rn_dep_max  = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+      nn_rnf_depth_file = 0   !  create (=1) a runoff depth file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_isf    !  Top boundary layer (ISF)                              (nn_isf >0)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+! nn_isf == 4
+   sn_fwfisf   = 'rnfisf'  ,         -12       ,'sowflisf',   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 3
+   sn_rnfisf   = 'rnfisf'  ,         -12       ,'sofwfisf',   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 2 and 3
+   sn_depmax_isf='rnfisf'  ,         -12       ,'sozisfmax',  .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+   sn_depmin_isf='rnfisf'  ,         -12       ,'sozisfmin',  .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 2
+   sn_Leff_isf = 'rnfisf'  ,         -12       ,'Leff'    ,   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+!
+! for all case
+   nn_isf      = 1         !  ice shelf melting/freezing
+                           !  1 = presence of ISF    2 = bg03 parametrisation 
+                           !  3 = rnf file for isf   4 = ISF fwf specified
+                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
+! only for nn_isf = 1 or 2
+   rn_gammat0  = 1.e-4     ! gammat coefficient used in blk formula
+   rn_gammas0  = 1.e-4     ! gammas coefficient used in blk formula
+! only for nn_isf = 1 or 4
+   rn_hisf_tbl =  30.      ! thickness of the top boundary layer    (Losh et al. 2008)
+   !                       ! 0 => thickness of the tbl = thickness of the first wet cell
+! only for nn_isf = 1
+   nn_isfblk   = 1         ! 1 ISOMIP  like: 2 equations formulation (Hunter et al., 2006)
+   !                       ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+   nn_gammablk = 1         ! 0 = cst Gammat (= gammat/s)
+   !                       ! 1 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010)
+   !                       ! 2 = velocity and stability dependent Gamma    (Holland et al. 1999)
+/
+!-----------------------------------------------------------------------
+&namsbc_iscpl  !   land ice / ocean coupling option                     
+!-----------------------------------------------------------------------
+   nn_drown    = 10        ! number of iteration of the extrapolation loop (fill the new wet cells)
+   ln_hsb      = .false.   ! activate conservation module (conservation exact after a time of rn_fiscpl)
+   nn_fiscpl   = 43800     ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing           (ln_apr_dyn =T)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,      ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   rn_pref     = 101000.   !  reference atmospheric pressure   [N/m2]/
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+   ln_apr_obc  = .false.   !  inverse barometer added to OBC ssh data
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !   (logical) !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   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     =  -166.67  !  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
+!-----------------------------------------------------------------------
+   nn_ice_alb   =    1   !  parameterization of ice/snow albedo
+                         !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo
+                         !     1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004),
+                         !        giving cloud-sky albedo
+   rn_alb_sdry  =  0.85  !  dry snow albedo         : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky)
+   rn_alb_smlt  =  0.75  !  melting snow albedo     : 0.65 ( '' )          ; 0.75 ( '' )          ; obs 0.72-0.82 ( '' )
+   rn_alb_idry  =  0.60  !  dry ice albedo          : 0.72 ( '' )          ; 0.60 ( '' )          ; obs 0.54-0.65 ( '' )
+   rn_alb_imlt  =  0.50  !  bare puddled ice albedo : 0.53 ( '' )          ; 0.50 ( '' )          ; obs 0.49-0.58 ( '' )
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model                        (ln_wave=T)
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable     ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name       !   (logical)  !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_cdg      =  'sdw_wave' ,        1          , 'drag_coeff' ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_usd      =  'sdw_wave' ,        1          , 'u_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_vsd      =  'sdw_wave' ,        1          , 'v_sd2d'     ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_hsw      =  'sdw_wave' ,        1          , 'hs'         ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_wmp      =  'sdw_wave' ,        1          , 'wmp'        ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_wnum     =  'sdw_wave' ,        1          , 'wave_num'   ,     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+   sn_tauoc    =  'sdw_wave' ,        1          , 'wave_stress',     .true.   , .false. , 'daily'   ,  ''      , ''       , ''
+!
+   cn_dir  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters                                   (default: No iceberg)
+!-----------------------------------------------------------------------
+   ln_icebergs              = .false.              ! iceberg floats or not
+   ln_bergdia               = .true.               ! Calculate budgets
+   nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0
+   nn_verbose_write         = 15                   ! Timesteps between verbose messages
+   nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage
+                                                   ! Initial mass required for an iceberg of each class
+   rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
+                                                   ! Proportion of calving mass to apportion to each class
+   rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
+                                                   ! Ratio between effective and real iceberg mass (non-dim)
+                                                   ! i.e. number of icebergs represented at a point
+   rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
+                                                   ! thickness of newly calved bergs (m)
+   rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250.
+   rn_rho_bergs             = 850.                 ! Density of icebergs
+   rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs
+   ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics
+   rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
+   rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
+   ln_passive_mode          = .false.              ! iceberg - ocean decoupling
+   nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no)
+                                                   ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
+   rn_test_box              = 108.0,  116.0, -66.0, -58.0
+   rn_speed_limit           = 0.                   ! CFL speed limit for a berg
+
+!         ! file name ! frequency (hours) !   variable   ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!         !           !  (if <0  months)  !     name     !   (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_icb =  'calving',       -1          , 'calvingmask',  .true.      , .true.  , 'yearly'  , ''       , ''       , ''
+
+   cn_dir = './'
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")
+!!   nam_tide      Tidal forcing 
+!!   nambdy        Unstructured open boundaries                         
+!!   nambdy_dta    Unstructured open boundaries - external data         
+!!   nambdy_tide   tidal forcing at open boundaries                     
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
+!-----------------------------------------------------------------------
+&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 [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+   ln_chk_bathy  = .FALSE. !
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters
+!-----------------------------------------------------------------------
+   ln_tide     = .false.
+   ln_tide_pot = .true.    !  use tidal potential forcing
+   ln_tide_ramp= .false.   !
+   rdttideramp =    0.     !
+   clname(1)   = 'DUMMY'   !  name of constituent - all tidal components must be set in namelist_cfg
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          
+!-----------------------------------------------------------------------
+    ln_bdy         = .false.              !  Use unstructured open boundaries
+    nb_bdy         = 0                    !  number of open boundary sets
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file   = .false.              !  =T : read mask from file
+    cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.)
+    cn_dyn2d       = 'none'               !
+    nn_dyn2d_dta   =  0                   !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    cn_dyn3d      =  'none'               !
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_tra        =  'none'               !
+    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_ice_lim      =  'none'             !
+    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice
+    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           --
+    rn_ice_age      = 30.                 !  lim3 only:      --   age                --
+
+    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers
+    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities
+    rn_time_dmp   =  1.                   ! Damping time scale in days
+    rn_time_dmp_out =  1.                 ! Outflow damping time scale
+    nn_rimwidth   = 10                    !  width of the relaxation zone
+    ln_vol        = .false.               !  total volume correction (see nn_volctl parameter)
+    nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero
+    nb_jpk_bdy    = -1                    ! number of levels in the bdy data (set < 0 if consistent with planned run)
+/
+!-----------------------------------------------------------------------
+&nambdy_dta    !  open boundaries - external data                       
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh      = 'amm12_bdyT_u2d',         24        , 'sossheig',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_u2d      = 'amm12_bdyU_u2d',         24        , 'vobtcrtx',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_v2d      = 'amm12_bdyV_u2d',         24        , 'vobtcrty',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_u3d      = 'amm12_bdyU_u3d',         24        , 'vozocrtx',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_v3d      = 'amm12_bdyV_u3d',         24        , 'vomecrty',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+! for lim2
+!   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+! for lim3
+!   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_ht_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_ht_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+
+   cn_dir      = 'bdydta/' !  root directory for the location of the bulk files
+   ln_full_vel = .false.   !  
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files
+   ln_bdytide_2ddta = .false.                   !
+   ln_bdytide_conj  = .false.                   ! 
+/
+
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction                                      (default: linear)
+!-----------------------------------------------------------------------
+   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). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max=    1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   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)
+   rn_tfri1    =    4.e-4  !  top drag coefficient (linear case)
+   rn_tfri2    =    2.5e-3 !  top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_tfri2_max=    1.e-1  !  max. top drag coefficient (non linear case and ln_loglayer=T)
+   rn_tfeb2    =    0.0    !  top turbulent kinetic energy background  (m2/s2)
+   rn_tfrz0    =    3.e-3  !  top roughness [m] if ln_loglayer=T
+   ln_tfr2d    = .false.   !  horizontal variation of the top friction coef (read a 2D mask file )
+   rn_tfrien   =   50.     !  local multiplying factor of tfr (ln_tfr2d=T)
+
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+   ln_loglayer = .false.   !  logarithmic formulation (non linear case)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_qgh      ='geothermal_heating.nc',  -12.       , 'heatflow',   .false.   , .true.  , 'yearly'  ,   ''     ,   ''     ,   ''
+   !
+   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]
+   cn_dir      = './'      !  root directory for the location of the runoff files 
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
+   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_adv_mle   mixed layer eddy param. (Fox-Kemper param.)
+!!   namtra_ldf       lateral diffusion scheme
+!!   namtra_ldfeiv    eddy induced velocity param.
+!!   namtra_dmp       T & S newtonian damping
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .false.         !  = Use EOS80 equation of state
+   ln_seos     = .false.         !  = Use simplified equation of state (S-EOS)
+                                 !
+   !                     ! S-EOS coefficients (ln_seos=T):
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  1.6550e-1      !  thermal expension coefficient
+   rn_b0       =  7.6554e-1      !  saline  expension coefficient
+   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer                          (default: NO advection)
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .false. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+   ln_mle      = .false.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation
+   rn_ce       = 0.06      ! magnitude of the MLE (typical value: 0.06 to 0.08)
+   nn_mle      = 1         ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
+   rn_lf       = 5.e+3     ! typical scale of mixed layer front (meters)                      (case rn_mle=0)
+   rn_time     = 172800.   ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_mle=0)
+   rn_lat      = 20.       ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1)
+   nn_mld_uv   = 0         ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
+   nn_conv     = 0         ! =1 no MLE in case of convection ; =0 always MLE
+   rn_rho_c_mle= 0.01      ! delta rho criterion used to calculate MLD for FK
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion)
+!-----------------------------------------------------------------------
+   !                       !  Operator type:
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+   ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection                (default: vector form)
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations
+   ln_vvl_layer  = .false.          !  full layer vertical coordinate
+   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar
+   ln_vvl_zstar_at_eqtor  = .false. !  ztilde near the equator
+   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient
+   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days]
+   rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days]
+   rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation
+   ln_vvl_dbg    = .true.           !  debug prints    (T/F)
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1          ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)  ! PLEASE DO NOT ACTIVATE
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps)
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient                            (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynspg_exp  = .false.   ! explicit free surface
+   ln_dynspg_ts   = .false.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed
+         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO)
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.    !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   !                                !  = 32  F(i,j,k)=F(local gridscale and deformation rate)
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !                       !  Smagorinsky settings (nn_ahm_ijk_t  = 32) :
+   rn_csmc       = 3.5         !  Smagorinsky constant of proportionality
+   rn_minfac     = 1.0         !  multiplier of theorectical lower limit
+   rn_maxfac     = 1.0         !  multiplier of theorectical upper limit
+/
+
+!!======================================================================
+!!             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_gls    GLS vertical mixing                                 ("key_zdfgls")
+!!    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 Convective 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
+   ln_zdfqiao  = .false.   !  Enhanced wave vertical mixing Qiao (2010) (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&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
+   rn_ekmfc    =    0.7    !  Factor in the Ekman depth Equation
+   rn_mldmin   =    1.0    !  minimum allowable mixed-layer depth estimate (m)
+   rn_mldmax   = 1000.0    !  maximum allowable mixed-layer depth estimate (m)
+   rn_wtmix    =   10.0    !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
+   rn_wvmix    =   10.0    !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
+   ln_mldw     =  .true.   !  Flag to use or not the mixed layer depth param.
+/
+!-----------------------------------------------------------------------
+&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]
+   rn_bshear   =   1.e-20  ! background shear (>0) currently a numerical threshold (do not change it)
+   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 near 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           (ln_cpl=T)
+   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_gls    !   GLS vertical diffusion                               ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-7   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.267   !  galperin limit
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   rn_hsro       =  0.02   !  Minimum surface roughness
+   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met=2)
+   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2/3)
+   !                             ! =3 requires ln_wave=T
+   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum)
+   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum)
+   nn_stab_func  =     2   !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =     1   !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&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  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm")
+!-----------------------------------------------------------------------
+   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
+   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency
+   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F)
+/
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints 
+!!   namsto            Stochastic parametrization of EOS
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&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
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
+   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)
+   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)
+   jpnij       =   0       !  jpnij  number of local domains (set automatically if < 1)
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints 
+!-----------------------------------------------------------------------
+   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_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+   nn_diacfl   =    0      !  Write out CFL diagnostics (=1) in cfl_diagnostics.ascii, or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsto        ! Stochastic parametrization of EOS                      (default: NO)
+!-----------------------------------------------------------------------
+   ln_sto_eos  = .false.   ! stochastic equation of state
+   nn_sto_eos  = 1         ! number of independent random walks
+   rn_eos_stdxy= 1.4       ! random walk horz. standard deviation (in grid points)
+   rn_eos_stdz = 0.7       ! random walk vert. standard deviation (in grid points)
+   rn_eos_tcor = 1440.     ! random walk time correlation (in timesteps)
+   nn_eos_ord  = 1         ! order of autoregressive processes
+   nn_eos_flt  = 0         ! passes of Laplacian filter
+   rn_eos_lim  = 2.0       ! limitation factor (default = 3.0)
+   ln_rststo   = .false.   ! start from mean parameter (F) or from restart file (T)
+   ln_rstseed  = .true.    ! read seed of RNG from restart file
+   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input)
+   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namtrd       dynamics and/or tracer trends                         (default F)
+!!   namptr       Poleward Transport Diagnostics                        (default F)
+!!   namhsb       Heat and salt budgets                                 (default F)
+!!   namdiu       Cool skin and warm layer models                       (default F)
+!!   namdiu       Cool skin and warm layer models                       (default F)
+!!   namflo       float parameters                                      ("key_float")
+!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm")
+!!   namdct       transports through some sections                      ("key_diadct")
+!!   nam_diatmb   Top Middle Bottom Output                              (default F)
+!!   nam_dia25h   25h Mean Output                                       (default F)
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namtrd        !   trend diagnostics                                    (default F)
+!-----------------------------------------------------------------------
+   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
+   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
+   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
+   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet)
+   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
+   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
+   ln_tra_trd  = .false.   ! (T) 3D tracer trend output
+   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
+   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
+/
+!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+!!gm
+!-----------------------------------------------------------------------
+&namptr        !   Poleward Transport Diagnostic                         (default F)
+!-----------------------------------------------------------------------
+   ln_diaptr   = .false.   !  Poleward heat and salt transport (T) or not (F)
+   ln_subbas   = .false.   !  Atlantic/Pacific/Indian basins computation (T) or not
+/
+!-----------------------------------------------------------------------
+&namhsb        !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+   ln_diahsb   = .false.   !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdiu        !   Cool skin and warm layer models                       (default F)
+!-----------------------------------------------------------------------
+   ln_diurnal      = .false.   !
+   ln_diurnal_only = .false.   !
+/
+!-----------------------------------------------------------------------
+&namflo        !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   jpnfl       = 1         !  total number of floats during the run
+   jpnnewflo   = 0         !  number of floats for the restart
+   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)
+   ln_ariane   = .true.    !  Input with Ariane tool convention(T)
+   ln_flo_ascii= .true.    !  Output with Ariane tool netcdf convention(F) or ascii file (T)
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents               ("key_diaharm")
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through some sections                        ("key_diadct")
+!-----------------------------------------------------------------------
+    nn_dct     = 15        !  time step frequency for transports computing
+    nn_dctwri  = 15        !  time step frequency for transports writing
+    nn_secdebug= 112       !      0 : no section to debug
+    !                      !     -1 : debug all section
+    !                      !  0 < n : debug section number n
+/
+!-----------------------------------------------------------------------
+&nam_diatmb    !  Top Middle Bottom Output                               (default F)
+!-----------------------------------------------------------------------
+   ln_diatmb   = .false.   !  Choose Top Middle and Bottom output or not
+/
+!-----------------------------------------------------------------------
+&nam_dia25h    !  25h Mean Output                                        (default F)
+!-----------------------------------------------------------------------
+   ln_dia25h   = .false.   ! Choose 25h mean output or not
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings             ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+   !                       !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+   !                       !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+   !                       !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+
+!!======================================================================
+!!               ***  Observation & Assimilation  ***
+!!======================================================================
+!!   namobs       observation and model comparison
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs        !  observation usage switch
+!-----------------------------------------------------------------------
+   ln_diaobs   = .false.             ! Logical switch for the observation operator
+   ln_t3d      = .false.             ! Logical switch for T profile observations
+   ln_s3d      = .false.             ! Logical switch for S profile observations
+   ln_sla      = .false.             ! Logical switch for SLA observations
+   ln_sst      = .false.             ! Logical switch for SST observations
+   ln_sic      = .false.             ! Logical switch for Sea Ice observations
+   ln_vel3d    = .false.             ! Logical switch for velocity observations
+   ln_altbias  = .false.             ! Logical switch for altimeter bias correction
+   ln_nea      = .false.             ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.           ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.   ! Logical switch for obs grid search w/lookup table
+   ln_ignmis   = .true.              ! Logical switch for ignoring missing files
+   ln_s_at_t   = .false.             ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.             ! Logical switch for calculating night-time average for SST obs
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   cn_profbfiles = 'profiles_01.nc'  ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'       ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'       ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'       ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'       ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'     ! Altimeter bias input file name
+   cn_gridsearchfile='gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5            ! Grid search resolution
+   rn_dobsini  = 00010101.000000     ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend  = 00010102.000000     ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint    = 0                   ! Type of vertical interpolation method
+   nn_2dint    = 0                   ! Type of horizontal interpolation method
+   nn_msshc    = 0                   ! MSSH correction scheme
+   rn_mdtcorr  = 1.61                ! MDT  correction
+   rn_mdtcutoff = 65.0               ! MDT cutoff for computed correction
+   nn_profdavtypes = -1              ! Profile daily average types - array
+   ln_sstbias  = .false.             !
+   cn_sstbias_files = 'sstbias.nc'   !
+/
+!-----------------------------------------------------------------------
+&nam_asminc    !   assimilation increments                              ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri  = .false.   !  Logical switch for writing out background state
+    ln_trainc  = .false.   !  Logical switch for applying tracer increments
+    ln_dyninc  = .false.   !  Logical switch for applying velocity increments
+    ln_sshinc  = .false.   !  Logical switch for applying SSH increments
+    ln_asmdin  = .false.   !  Logical switch for Direct Initialization (DI)
+    ln_asmiau  = .false.   !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg     = 0         !  Timestep of background in [0,nitend-nit000-1]
+    nitdin     = 0         !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr  = 1         !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin  = 15        !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn     = 0         !  Type of IAU weighting function
+    ln_salfix  = .false.   !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin  = -9999     !  Minimum salinity after applying the increments
+    nn_divdmp  = 0         !  Number of iterations of divergence damping operator
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_top_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_top_ref	(revision 8732)
@@ -0,0 +1,155 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :   - tracer run information                (namtrc_run)
+!!               - tracer definition                     (namtrc    )
+!!               - tracer data initialisation            (namtrc_dta)
+!!               - tracer advection                      (namtrc_adv)
+!!               - tracer lateral diffusion              (namtrc_ldf)
+!!               - tracer vertical physics               (namtrc_zdf)
+!!               - tracer newtonian damping              (namtrc_dmp)
+!!               - dynamical tracer trends               (namtrc_trd)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run      !   run information
+!-----------------------------------------------------------------------
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers
+   ln_top_euler  = .false.   !  use Euler time-stepping for TOP
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+                             !                  = 1 do not use the value in the restart file
+                             !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_indir = "."           !  directory from which to read input passive tracer restarts
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   cn_trcrst_outdir = "."          !  directory to which to write output passive tracer restarts
+/
+!-----------------------------------------------------------------------
+&namtrc          !   tracers definition
+!-----------------------------------------------------------------------
+   jp_bgc        =  0           !  Number of passive tracers of the BGC model
+!
+   ln_pisces     =  .false.     !  Run PISCES BGC model 
+   ln_my_trc     =  .false.     !  Run MY_TRC BGC model
+   ln_age        =  .false.     !  Run the sea water age tracer
+   ln_cfc11      =  .false.     !  Run the CFC11 passive tracer
+   ln_cfc12      =  .false.     !  Run the CFC12 passive tracer
+   ln_sf6        =  .false.     !  Run the SF6 passive tracer
+   ln_c14        =  .false.     !  Run the Radiocarbon passive tracer
+!
+   ln_trcdta     =  .false.  !  Initialisation from data input file (T) or not (F)
+   ln_trcdmp     =  .false.  !  add a damping termn (T) or not (F)
+   ln_trcdmp_clo =  .false.  !  damping term (T) or not (F) on closed seas
+!
+   jp_dia3d      = 0         ! Number of 3D diagnostic variables
+   jp_dia2d      = 0         ! Number of 2D diagnostic variables
+!                !           !                                         !            !                               !
+!                !    name   !           title of the field            !   units    ! initial data from file or not ! 
+!  sn_tracer(1)  = 'tracer  ' , 'Tracer  Concentration                 ',   ' - '    ,           .false.
+/
+!-----------------------------------------------------------------------
+&namage         !   AGE 
+!-----------------------------------------------------------------------
+   rn_age_depth      = 10            ! depth over which age tracer reset to zero
+   rn_age_kill_rate  = -0.000138888  !  = -1/7200 recip of relaxation timescale (s) for  age tracer shallower than age_depth
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+   cn_dir        =  './'     !  root directory for the location of the data files
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_trcdta(1)  = 'data_TRC_nomask'        ,        -12        ,  'TRC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+/
+!-----------------------------------------------------------------------
+&namtrc_adv      !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_cen =  .false.  !  2nd order centered scheme
+      nn_cen_h   =  4               !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4               !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_trcadv_fct =  .false.  !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+   ln_trcadv_mus =  .false.  !  MUSCL scheme
+      ln_mus_ups =  .false.         !  use upstream scheme near river mouths
+   ln_trcadv_ubs =  .false.  !  UBS scheme
+      nn_ubs_v   =  2               !  =2  , vertical 2nd order FCT
+   ln_trcadv_qck =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf      !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+!                            !  Type of the operator:  
+   ln_trcldf_lap   =  .true.     !    laplacian operator
+   ln_trcldf_blp   =  .false.    !  bilaplacian operator
+   !                         !  Direction of action:
+   ln_trcldf_lev   =  .false.    !  iso-level
+   ln_trcldf_hor   =  .false.    !  horizontal (geopotential)
+   ln_trcldf_iso   =  .true.     !  iso-neutral (standard operator)
+   ln_trcldf_triad =  .false.    !  iso-neutral (triad    operator)
+   !                         !  Coefficient 
+   rn_ahtrc_0      = 2000.       !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bhtrc_0      = 1.e+12      !  lateral eddy diffusivity (bilap. operator) [m4/s]
+   !
+   rn_fact_lap      =     1.     !     enhanced zonal eddy diffusivity
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf      !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad      !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad     =  .true.   !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp      !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+   nn_zdmp_tr    =    1      !  vertical   shape =0    damping throughout the water column
+                             !                   =1 no damping in the mixing layer (kz  criteria)
+                             !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto_tr   = 'resto_tr.nc'    !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_ice      !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+   nn_ice_tr     =  -1       !  tracer concentration in sea ice 
+                             !    =-1 (no vvl: identical cc in ice and ocean / vvl: cc_ice = 0)
+                             !    = 0 (no vvl: cc_ice = zero / vvl: cc_ice = )
+                             !    = 1 prescribed to a namelist value (implemented in pisces only)
+/
+!-----------------------------------------------------------------------
+&namtrc_trd      !   diagnostics on tracer trends                       ('key_trdtrc')
+!                          or mixed-layer trends                        ('key_trdmld_trc')
+!----------------------------------------------------------------------
+   nn_trd_trc    =  5475     !  time step frequency and tracers trends
+   nn_ctls_trc   =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc    =   1       !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false. !  restart for ML diagnostics
+   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
+   ln_trdtrc( 1) = .true.
+   ln_trdtrc( 2) = .true.
+   ln_trdtrc(23) = .true.
+/
+!----------------------------------------------------------------------
+&namtrc_bc       !   data for boundary conditions
+!-----------------------------------------------------------------------
+   cn_dir_sbc    =  './'     !  root directory for the location of SURFACE data files
+   cn_dir_cbc    =  './'     !  root directory for the location of COASTAL data files
+   cn_dir_obc    =  './'     !  root directory for the location of OPEN data files
+   ln_rnf_ctl    = .false.   !  Remove runoff dilution on tracers with absent river load
+   rn_bc_time    =  86400.   !  Time scaling factor for SBC and CBC data (seconds in a day)
+/
+!----------------------------------------------------------------------
+&namtrc_bdy      !   Setup of tracer boundary conditions
+!-----------------------------------------------------------------------
+   cn_trc_dflt   = 'neumann' !  OBC applied by default to all tracers
+   cn_trc        = 'none'    !  Boundary conditions used for tracers with data files (selected in namtrc)
+
+   nn_trcdmp_bdy = 0         !  Use damping timescales defined in nambdy of namelist
+                             !  = 0 NO damping of tracers at open boudaries
+                             !  = 1 Only for tracers forced with external data
+                             !  = 2 Damping applied to all tracers
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_trc_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_trc_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_trc_ref	(revision 8732)
@@ -0,0 +1,45 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! Inert tracers reference namelist 
+!!       1  - CFC                (namcfc)
+!!       2  - C14               (namc14_typ, namc14_sbc, namc14_fcg)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namcfc     !   CFC 
+!-----------------------------------------------------------------------
+   ndate_beg  = 300101    !  datedeb1
+   nyear_res  = 1932      !  iannee1
+   !
+   ! Formatted file of annual hemisperic CFCs concentration in the atmosphere (ppt)
+   clname     = 'CFCs_in_air_CMIP6.dat'
+/
+!
+!-----------------------------------------------------------------------
+&namc14_typ     !  C14 - type of C14 tracer, default values of C14/C and pco2
+!-----------------------------------------------------------------------
+   kc14typ  = 0          ! Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient)
+   rc14at   = 1.0        ! Default value for atmospheric C14/C (used for equil run)
+   pco2at   = 280.0      ! Default value for atmospheric pcO2 [atm] (used for equil run)
+   rc14init = 0.85       ! Default value for initialization of ocean C14/C (when no restart)
+/
+!
+!-----------------------------------------------------------------------
+&namc14_sbc     !  C14 - surface BC
+!-----------------------------------------------------------------------
+   ln_chemh = .true.     ! Chemical enhancement in piston vel.: yes/no
+   xkwind   = 0.360      ! Coefficient for gas exchange velocity
+   xdicsur  = 2.0        ! Reference DIC surface concentration (mol/m3)
+/
+!
+!-----------------------------------------------------------------------
+&namc14_fcg     !  files & dates
+!               !  For Paleo-historical: specify tyrc14_beg in yr BP
+!               !  For Bomb: tyrc14_beg=0
+!-----------------------------------------------------------------------
+   cfileco2    = 'splco2.dat'  !  atmospheric co2 - Bomb
+   cfilec14    = 'atmc14.dat'  !  atmospheric c14 - Bomb
+   tyrc14_beg  = 0.00          !  starting year of experiment - Bomb
+!   cfileco2    = 'ByrdEdcCO2.txt' !  atmospheric co2 - Paleo
+!   cfilec14    = 'intcal13.14c'   !  atmospheric c14 - Paleo
+!   tyrc14_beg  =  35000.00        !  starting year of experiment - Paleo (yr BP)
+/
+!
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/README	(revision 8732)
@@ -0,0 +1,25 @@
+# ISOMIP is a simple TEST_CASE to test the iceshelves in NEMO.
+# no input files are needed (all is prescribed in MY_SRC/usr_def routines
+# for a reference documentation on the ISOMIP test case, see experiement 1 on http://efdl.cims.nyu.edu/project_oisi/isomip/experiments/phase_I/idealized_numerical_models_5.pdf
+
+# default namelist is setup for a 30y run on 32 processors with the minimum output using XIOS in attached mode with single file output
+
+# How to build moc.nc and psi.nc
+   - Download or clone the CDFTOOLS (see https://github.com/meom-group/CDFTOOLS)
+   - Compile all the tools (or at least cdfpsi and cdfmoc) on your cluster (see https://github.com/meom-group/CDFTOOLS#using-cdftools)
+   - if mesh_mask.nc is splitted, you need to rebuild them using the rebuild NEMO tools (see in NEMOGCM/TOOLS) or run 1 (or more) time step on a single processor (nn_itend variable in the namelist). 
+   - set the correct link: ln -s mesh_mask.nc mask.nc ; ln -s mesh_mask.nc mesh_hgr.nc ; ln -s mesh_mask.nc mesh_zgr.nc
+   - run the cdftools : 
+        - cdfmoc ISOMIP_1m_00010101_00301231_grid_V.nc                                       => moc.nc
+        - cdfpsi ISOMIP_1m_00010101_00301231_grid_U.nc ISOMIP_1m_00010101_00301231_grid_V.nc => psi.nc
+
+# How to plt moc/psi and melt (python with netcdf and matplotlib library requiried):
+   - psi.png => python2.7 plot_psi.py -f psi.nc -v sobarstf
+   - moc.png => python2.7 plot_moc.py -f moc.nc -v zomsfglo
+   - mlt.png => python2.7 plot_mlt.py -f ISOMIP_1m_00010101_00301231_grid_T.nc -v sowflisf
+by default the last time frame is plotted.
+
+# location the expected circulation and melt plot after 30y of run:
+   - ISOMIP/EXP00/ISOMIP_psi.png
+   - ISOMIP/EXP00/ISOMIP_moc.png
+   - ISOMIP/EXP00/ISOMIP_mlt.png
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo-opa.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/file_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/file_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/file_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,51 @@
+<?xml version="1.0"?>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->  
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+	<file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+          <!-- variable for ice shelf -->
+          <field field_ref="qlatisf"      name="sohflisf"  />
+          <field field_ref="fwfisf"       name="sowflisf"  />
+          <field field_ref="isfgammat"    name="sogammat"  />
+          <field field_ref="isfgammas"    name="sogammas"  />
+        </file>
+	<file id="file2" output_freq="1mo" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+        </file>
+	<file id="file3" output_freq="1mo" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+        </file>
+      </file_group>
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">false</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,406 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : ISOMIP Configuration namelist to overwrite reference dynamical namelist
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namusr_def    !   ISOMIP user defined namelist  
+!-----------------------------------------------------------------------
+   ln_zps      = .true.       ! z-partial-step coordinate
+   rn_lam0     =   0.0        !  longitude of first raw and column T-point (jphgr_msh = 1)
+   rn_phi0     = -80.0        ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   rn_e1deg    =   0.3        !  zonal      grid-spacing (degrees)
+   rn_e2deg    =   0.1        !  meridional grid-spacing (degrees)
+   rn_e3       =   30.        !  vertical resolution
+/
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "ISOMIP" !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =  525600   !  last  time step
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   nn_stock    =  99999999 !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =      48   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration   
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      !
+   ln_write_cfg= .true.    !  (=T) create the domain configuration file
+   cn_domcfg_out = "ISOMIP_cfg_out" ! newly created domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.    !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   !
+   rn_rdt      = 1800.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+!              !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   cn_dir        = './'      !  root directory for the location of the runoff files
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 6         !  frequency of surface boundary condition computation
+   !                       !     (also = the frequency of sea-ice model call)
+   ln_blk      = .false.    !  Bulk formulation                          (T => fill namsbc_blk )
+   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      , 
+                           !  =2 ice-model used                
+   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =1 levitating ice with mass and salt exchange but no presure effect
+                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_isf      = .true.    !  ice shelf melting/freezing                (T => fill namsbc_isf)
+   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
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_isf    !  Top boundary layer (ISF)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  ! filename      !
+! nn_isf == 4
+   sn_fwfisf   = 'rnfisf'  ,         -12       ,'sowflisf',     .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+! nn_isf == 3
+   sn_rnfisf   = 'rnfisf'  ,         -12       ,'sofwfisf',     .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+! nn_isf == 2 and 3
+   sn_depmax_isf = 'rnfisf' ,        -12       ,'sozisfmax' ,   .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+   sn_depmin_isf = 'rnfisf' ,        -12       ,'sozisfmin' ,   .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+! nn_isf == 2
+   sn_Leff_isf = 'rnfisf'  ,         -12       ,'Leff'    ,     .false.    , .true.  , 'yearly'  ,  ''      ,   ''     , ''
+! for all case
+   nn_isf      = 1         !  ice shelf melting/freezing
+                           !  1 = presence of ISF    2 = bg03 parametrisation 
+                           !  3 = rnf file for isf   4 = ISF fwf specified
+                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
+! only for nn_isf = 1 or 2
+   rn_gammat0  = 1.0e-4   ! gammat coefficient used in blk formula
+   rn_gammas0  = 1.0e-4   ! gammas coefficient used in blk formula
+! only for nn_isf = 1 or 4
+   rn_hisf_tbl =  30.      ! thickness of the top boundary layer    (Losh et al. 2008)
+                          ! 0 => thickness of the tbl = thickness of the first wet cell
+! only for nn_isf = 1
+   nn_isfblk   = 1        ! 1 ISOMIP  like: 2 equations formulation (Hunter et al., 2006)
+                          ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+   nn_gammablk = 0        ! 0 = cst Gammat (= gammat/s)
+                          ! 1 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010)
+                          ! 2 = velocity and stability dependent Gamma    (Holland et al. 1999)
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max =   1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   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)
+   rn_tfri1    =    4.e-4  !  top drag coefficient (linear case)
+   rn_tfri2    =    2.5e-3 !  top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_tfri2_max =   1.e-1  !  max. top drag coefficient (non linear case and ln_loglayer=T)
+   rn_tfeb2    =    0.0    !  top turbulent kinetic energy background  (m2/s2)
+   rn_tfrz0    =    3.e-3  !  top roughness [m] if ln_loglayer=T
+   ln_tfr2d    = .false.   !  horizontal variation of the top friction coef (read a 2D mask file )
+   rn_tfrien   =    50.    !  local multiplying factor of tfr (ln_tfr2d=T)
+
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+   ln_loglayer = .false.   !  logarithmic formulation (non linear case)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .true.          !  = Use EOS80 equation of state
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .true.   !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        =  100.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_isf  = .true.    !  s-coordinate adapted for isf (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient 
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.    !  iso-level
+   ln_dynldf_hor =  .true.     !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =    600.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.0e-3  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   5.0e-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    =   0.1     !  evd mixing coefficient [m2/s]
+   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
+   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" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_mlt.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_mlt.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_mlt.py	(revision 8732)
@@ -0,0 +1,47 @@
+from netCDF4 import Dataset
+import numpy as np
+from numpy import ma
+import argparse
+import matplotlib.pyplot as plt
+import matplotlib
+
+parser = argparse.ArgumentParser()
+parser.add_argument("-f" , metavar='file_name'   , help="names of input files" , type=str  , nargs="+", required=True )
+parser.add_argument("-v" , metavar='var_name'    , help="variable list"        , type=str  , nargs=1  , required=True )
+args = parser.parse_args()
+
+# read mesh_mask
+ncid   = Dataset('mesh_mask.nc')
+lat2d  = ncid.variables['gphit'    ][  :,:].squeeze()
+lon2d  = ncid.variables['glamt'    ][  :,:].squeeze()
+msk    = ncid.variables['tmaskutil'][0,:,:].squeeze()
+ncid.close()
+
+plt.figure(figsize=np.array([210,210]) / 25.4)
+
+# read psi.nc
+ncid   = Dataset(args.f[0])
+var2d  = ncid.variables[args.v[0]][-1,:,:].squeeze() 
+var2dm = ma.masked_where(msk==0.0,var2d)
+# convert in m/y
+var2dm = var2dm * 86400 * 365 / 1e3
+ncid.close()
+ 
+# define colorbar 
+vlevel=np.arange(-1.6,1.8,0.2)
+pcol = plt.contourf(lon2d,lat2d,var2dm,levels=vlevel,extend='both')
+vlevel=np.arange(-1.6,1.8,0.4)
+matplotlib.rcParams['contour.negative_linestyle'] = 'solid'
+plt.contour(lon2d,lat2d,var2dm,levels=vlevel,colors='k')
+plt.grid()
+plt.title('melt rate ISOMIP (m/y)')
+plt.ylabel('Latitude',fontsize=14)
+plt.xlabel('Longitude',fontsize=14)
+cbar = plt.colorbar(pcol, ticks=vlevel)
+cbar.ax.tick_params(labelsize=14)
+
+# save figure
+plt.savefig('mlt.png', format='png', dpi=300)
+
+plt.show()
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_moc.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_moc.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_moc.py	(revision 8732)
@@ -0,0 +1,60 @@
+from netCDF4 import Dataset
+import numpy as np
+import argparse
+import matplotlib.pyplot as plt
+
+# read argument
+parser = argparse.ArgumentParser()
+parser.add_argument("-f" , metavar='file_name'   , help="names of input files" , type=str  , nargs=1  , required=True )
+parser.add_argument("-v" , metavar='var_name'    , help="variable list"        , type=str  , nargs=1  , required=True )
+args = parser.parse_args()
+
+# read mesh mask
+ncid  = Dataset('mesh_mask.nc')
+vx2d  = ncid.variables['gphit'  ][0,:,0].squeeze()
+vx2dv = ncid.variables['gphiv'  ][0,:,0].squeeze()
+y2d   = ncid.variables['gdepw_0'][0,:,:,1].squeeze()*-1
+y2dt  = ncid.variables['gdept_0'][0,:,:,1].squeeze()*-1
+msk   = ncid.variables['tmask'  ][0,:,:,1].squeeze()
+ncid.close()
+
+# build x 2d array
+x2d=y2d*0.0
+x2dv=y2d*0.0
+for jk in range(0,y2d.shape[0]):
+   x2d[jk,:]=vx2d[:]
+   x2dv[jk,:]=vx2d[:]
+
+plt.figure(figsize=np.array([210,210]) / 25.4)
+
+# read data and mask it
+ncid   = Dataset(args.f[0])
+var2d  = ncid.variables[args.v[0]][-1,:,:,:].squeeze() 
+var2dm = var2d[:,:]
+var2dm[msk==0] = -1
+ncid.close()
+
+# define colorbar
+vlevel=np.arange(0,0.13,0.01)  
+pcol = plt.contourf(x2d,y2d,var2dm,levels=vlevel)
+plt.clf()
+
+# plot contour
+ax = plt.subplot(1, 1, 1)
+ax.contour(x2dv,y2dt,var2dm,levels=vlevel)
+ax.grid()
+ax.set_title('MOC ISOMIP (Sv)')
+ax.set_ylabel('Depth (m)',fontsize=14)
+ax.set_xlabel('Latitude',fontsize=14)
+
+# plot colorbar
+plt.subplots_adjust(left=0.1,right=0.89, bottom=0.1, top=0.89, wspace=0.1, hspace=0.1)
+cax = plt.axes([0.91, 0.1, 0.02, 0.79])
+cbar= plt.colorbar(pcol, ticks=vlevel, cax=cax)
+cbar.ax.tick_params(labelsize=14)
+
+# save figure
+plt.savefig('moc.png', format='png', dpi=300)
+
+plt.show()
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_psi.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_psi.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/plot_psi.py	(revision 8732)
@@ -0,0 +1,52 @@
+from netCDF4 import Dataset
+import numpy as np
+from numpy import ma
+import argparse
+import matplotlib.pyplot as plt
+
+parser = argparse.ArgumentParser()
+parser.add_argument("-f" , metavar='file_name'   , help="names of input files" , type=str  , nargs="+", required=True )
+parser.add_argument("-v" , metavar='var_name'    , help="variable list"        , type=str  , nargs=1  , required=True )
+args = parser.parse_args()
+
+# read mesh_mask
+ncid   = Dataset('mesh_mask.nc')
+lat2d  = ncid.variables['gphit'    ][  :,:].squeeze()
+lon2d  = ncid.variables['glamt'    ][  :,:].squeeze()
+msk    = ncid.variables['tmaskutil'][0,:,:].squeeze()
+ncid.close()
+
+plt.figure(figsize=np.array([210,210]) / 25.4)
+
+# read psi.nc
+ncid   = Dataset(args.f[0])
+var2d  = ncid.variables[args.v[0]][-1,:,:].squeeze() 
+var2dm = ma.masked_where(msk==0.0,var2d)
+# convert in Sv
+var2dm = var2dm / 1e6
+ncid.close()
+ 
+# define colorbar 
+vlevel=np.arange(0.00,0.36,0.02)
+pcol = plt.contourf(lon2d,lat2d,var2dm,levels=vlevel)
+plt.clf()
+
+# plot contour
+ax = plt.subplot(1, 1, 1)
+ax.contour(lon2d,lat2d,var2dm,levels=vlevel)
+ax.grid()
+ax.set_title('PSI ISOMIP (Sv)')
+ax.set_ylabel('Latitude',fontsize=14)
+ax.set_xlabel('Longitude',fontsize=14)
+
+# plot colorbar
+plt.subplots_adjust(left=0.1,right=0.89, bottom=0.1, top=0.89, wspace=0.1, hspace=0.1)
+cax = plt.axes([0.91, 0.1, 0.02, 0.79])
+cbar= plt.colorbar(pcol, ticks=vlevel, cax=cax)
+cbar.ax.tick_params(labelsize=14)
+
+# save figure
+plt.savefig('psi.png', format='png', dpi=300)
+
+plt.show()
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_hgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_hgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_hgr.F90	(revision 8732)
@@ -0,0 +1,127 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                       ***  MODULE usrdef_hgr   ***
+   !!
+   !!                  ===  LOCK_EXCHANGE configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  NEMO  ! 2016-08  (S. Flavoni, G. Madec)   Original code
+   !!                  ! 2017-02  (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr    : initialize the horizontal mesh for ISOMIP configuration
+   !!----------------------------------------------------------------------
+   USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE usrdef_nam, ONLY: rn_lam0, rn_phi0, rn_e1deg, rn_e2deg   ! horizontal resolution in meters
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called by domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!                ISOMIP configuration
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zfact, zti, zui, zvi, zfi, ztj, zuj, zvj, zfj      ! local scalars
+      !!-------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('usr_def_hgr')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : ISOMIP configuration'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !                       !==  grid point position  ==!   (in kilometers)
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
+      IF(lwp) WRITE(numout,*) '          given by rn_e1deg and rn_e2deg'
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 )
+            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 )
+            zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+            zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+     ! Longitude
+            plamt(ji,jj) = rn_lam0 + rn_e1deg * zti
+            plamu(ji,jj) = rn_lam0 + rn_e1deg * zui
+            plamv(ji,jj) = rn_lam0 + rn_e1deg * zvi
+            plamf(ji,jj) = rn_lam0 + rn_e1deg * zfi
+     ! Latitude
+            pphit(ji,jj) = rn_phi0 + rn_e2deg * ztj
+            pphiu(ji,jj) = rn_phi0 + rn_e2deg * zuj
+            pphiv(ji,jj) = rn_phi0 + rn_e2deg * zvj
+            pphif(ji,jj) = rn_phi0 + rn_e2deg * zfj
+     !                       !==  Horizontal scale factors  ==!   (in meters)
+     ! e1
+            pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg
+            pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg
+            pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg
+            pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg
+     ! e2
+            pe2t(ji,jj) = ra * rad * rn_e2deg
+            pe2u(ji,jj) = ra * rad * rn_e2deg
+            pe2v(ji,jj) = ra * rad * rn_e2deg
+            pe2f(ji,jj) = ra * rad * rn_e2deg
+         END DO
+      END DO
+      !                             ! NO reduction of grid size in some straits 
+      ke1e2u_v = 0                  !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp           !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp           !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 0                       ! Coriolis parameter calculated on the sphere
+      !
+      !
+      pff_f(:,:) = 0._wp            ! CAUTION: set to zero to avoid error with some compilers that
+      pff_t(:,:) = 0._wp            !             require an initialization of INTENT(out) arguments
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('usr_def_hgr')
+      !
+   END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_istate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_istate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_istate.F90	(revision 8732)
@@ -0,0 +1,69 @@
+MODULE usrdef_istate
+   !!======================================================================
+   !!                     ***  MODULE usrdef_istate   ***
+   !!
+   !!                  ===  ISOMIP configuration  ===
+   !!
+   !! User defined : set the initial state of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-11 (S. Flavoni)             Original code
+   !!                 ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  usr_def_istate : initial state in Temperature and salinity
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean space and time domain
+   USE dom_oce , ONLY : glamt 
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_istate   ! called by istate.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers
+      !!                Here ISOMIP configuration 
+      !!
+      !! ** Method  : - set temperature field
+      !!              - set salinity    field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+      !
+      INTEGER  ::   jk     ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate : ISOMIP configuration, analytical definition of initial state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with a constant salinity and temperature.      '
+      pu  (:,:,:) = 0._wp        ! ocean at rest
+      pv  (:,:,:) = 0._wp
+      pssh(:,:)   = 0._wp
+      !
+      !                          ! T & S profiles
+      pts(:,:,:,jp_tem) = - 1.9 * ptmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields
+      pts(:,:,:,jp_sal) =  34.4 * ptmask(:,:,:)
+      !   
+   END SUBROUTINE usr_def_istate
+
+   !!======================================================================
+END MODULE usrdef_istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_nam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_nam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_nam.F90	(revision 8732)
@@ -0,0 +1,106 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_nam  ***
+   !!
+   !!                     ===  ISOMIP configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec)   Original code
+   !!                 ! 2017-02  (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain
+   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called by nemogcm.F90
+
+   !                              !!* namusr_def namelist *!!
+   REAL(wp), PUBLIC ::   rn_lam0, rn_phi0     
+   REAL(wp), PUBLIC ::   rn_e1deg, rn_e2deg, rn_e3
+   REAL(wp), PUBLIC ::   rbathy
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here ISOMIP configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   ios, ii   ! Local integer
+      !!
+      NAMELIST/namusr_def/ ln_zco, ln_zps, ln_sco, rn_lam0, rn_phi0, rn_e1deg, rn_e2deg, rn_e3
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      !
+      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. )
+      !
+      WRITE( ldnam(:), namusr_def )
+      !
+      cd_cfg = 'ISOMIP'           ! name & resolution (not used)
+      kk_cfg = INT( rn_e3 )
+      rbathy = 900.0   ! sea bed depth
+      !
+      ! Global Domain size:  ISOMIP domain is  200 km x 3 grid-points x 2000 m
+      kpi = INT( 15.0  / rn_e1deg ) + 1
+      kpj = INT( 10.0  / rn_e2deg ) + 1
+      kpk = INT( rbathy / rn_e3 ) + 1
+      !
+      !                             ! control print
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                 ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist namusr_def : ISOMIP test case'                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      type of vertical coordinate : '                                         ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         z-coordinate flag                     ln_zco = ', ln_zco             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         z-partial-step coordinate flag        ln_zps = ', ln_zps             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         s-coordinate flag                     ln_sco = ', ln_sco             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         resulting global domain size :        jpiglo = ', kpi                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpjglo = ', kpj                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpkglo = ', kpk                ;   ii = ii + 1
+      !
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 0                    ! ISOMIP configuration : close basin
+      !
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Lateral boundary condition of the global domain'                           ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      ISOMIP : closed basin                    jperio = ', kperio             ;   ii = ii + 1
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_sbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_sbc.F90	(revision 8732)
@@ -0,0 +1,87 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                       ***  MODULE usrdef_sbc  ***
+   !! 
+   !!                  ===  ISOMIP configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)   user defined interface
+   !!                  ! 2017-02  (P. Mathiot, S. Flavoni) adapt code to ISOMIP case
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_sbc    : user defined surface bounday conditions in ISOMIP case
+   !!----------------------------------------------------------------------
+   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 in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usr_def_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   all 0 fields, for ISOMIP case
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)' usr_sbc : ISOMIP case: NO surface forcing'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0'
+         !
+         utau(:,:) = 0._wp
+         vtau(:,:) = 0._wp
+         taum(:,:) = 0._wp
+         wndm(:,:) = 0._wp
+         !
+         emp (:,:) = 0._wp
+         sfx (:,:) = 0._wp
+         qns (:,:) = 0._wp
+         qsr (:,:) = 0._wp
+         !         
+      ENDIF
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_zgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/MY_SRC/usrdef_zgr.F90	(revision 8732)
@@ -0,0 +1,258 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                     ***  MODULE usrdef_zgr  ***
+   !!
+   !!                       ===  ISOMIP case  ===
+   !!
+   !! user defined :  vertical coordinate system of a user configuration
+   !!======================================================================
+   !! History :  4.0  ! 2016-08  (G. Madec,   S. Flavoni)  Original code
+   !!                 ! 2017-02  (P. Mathiot, S. Flavoni)  Adapt code to ISOMIP case
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system (required)
+   !!       zgr_z1d   : reference 1D z-coordinate 
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco          ! ocean space and time domain
+   USE dom_oce ,  ONLY: mj0   , mj1   , nimpp , njmpp   ! ocean space and time domain
+   USE dom_oce ,  ONLY: glamt , gphit                   ! ocean space and time domain
+   USE usrdef_nam     ! User defined : namelist variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_zgr   ! called by domzgr.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
+      &                    k_top  , k_bot    )                             ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   ji , jj, jk       ! dummy indices
+      INTEGER  ::   ij0, ij1          ! dummy indices  
+      INTEGER  ::   ik                ! local integers
+      REAL(wp) ::   zfact, z1_jpkm1   ! local scalar
+      REAL(wp) ::   ze3min, zdepth    ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj) ::   zht  , zhu         ! bottom depth
+      REAL(wp), DIMENSION(jpi,jpj) ::   zhisf, zhisfu      ! top depth
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk 
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                ! 2d workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : ISOMIP configuration (z(ps)- or s-coordinate closed box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ! set in usrdef_nam.F90 by reading the namusr_def namelist except for ISF
+      ln_zco    = .FALSE.      ! z-partial-step coordinate
+      ln_zps    = .TRUE.       ! z-partial-step coordinate
+      ln_sco    = .FALSE.      ! s-coordinate
+      ld_isfcav = .TRUE.       ! ISF Ice Shelves Flag
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      !
+      !                       !==  isfdraft  ==!
+      !
+      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0 
+      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level
+      CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90)
+      zmsk(:,:) = NINT( z2d(:,:) )
+      !
+      !
+      zht  (:,:) = rbathy 
+      zhisf(:,:) = 200._wp
+      ij0 = 1 ; ij1 = 40
+      DO jj = mj0(ij0), mj1(ij1)
+         zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
+      END DO
+      zhisf(:,:) = zhisf(:,:) * zmsk(:,:)
+      !
+      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
+      !
+      !                       !==  top masked level bathymetry  ==!  (all coordinates)
+      !
+      IF ( ln_zps ) THEN      !==  zps-coordinate  ==!   (partial bottom-steps)
+         !
+         ze3min = 0.1_wp * rn_e3
+         IF(lwp) WRITE(numout,*) '   minimum thickness of the partial cells = 10 % of e3 = ', ze3min
+         !
+         !                                !* bottom ocean compute from the depth of grid-points
+         k_bot(:,:) = jpkm1
+         DO jk = jpkm1, 1, -1
+            WHERE( zht(:,:) < pdepw_1d(jk) + ze3min )   k_bot(:,:) = jk-1
+         END DO
+         !                                !* top ocean compute from the depth of grid-points
+         k_top(:,:) = 1                   ! 
+         DO jk = 2, jpkm1
+            zdepth = pdepw_1d(jk+1) - ze3min
+            WHERE( zhisf(:,:) > 0.0 .AND. zhisf(:,:) >= zdepth )   k_top(:,:) = (jk + 1) 
+         END DO
+         !
+         !                                   !* vertical coordinate system
+         DO jk = 1, jpk                      ! initialization to the reference z-coordinate
+            pdept(:,:,jk) = pdept_1d(jk)
+            pdepw(:,:,jk) = pdepw_1d(jk)
+            pe3t (:,:,jk) = pe3t_1d (jk)
+            pe3u (:,:,jk) = pe3t_1d (jk)
+            pe3v (:,:,jk) = pe3t_1d (jk)
+            pe3f (:,:,jk) = pe3t_1d (jk)
+            pe3w (:,:,jk) = pe3w_1d (jk)
+            pe3uw(:,:,jk) = pe3w_1d (jk)
+            pe3vw(:,:,jk) = pe3w_1d (jk)
+         END DO
+         DO jj = 1, jpj                      ! top scale factors and depth at T- and W-points
+            DO ji = 1, jpi
+               ik = k_top(ji,jj)
+               IF ( ik > 2 ) THEN
+                  ! pdeptw at the interface
+                  pdepw(ji,jj,ik  ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) )
+                  ! e3t in both side of the interface
+                  pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+                  ! pdept in both side of the interface (from previous e3t)
+                  pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
+                  pdept(ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pe3t (ji,jj,ik  ) * 0.5_wp
+                  ! pe3w on both side of the interface
+                  pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik  )
+                  pe3w (ji,jj,ik  ) = pdept(ji,jj,ik  ) - pdept(ji,jj,ik-1)
+                  ! e3t into the ice shelf
+                  pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik  ) - pdepw(ji,jj,ik-1)
+               END IF
+            END DO
+         END DO         
+         DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points
+            DO ji = 1, jpi
+               ik = k_bot(ji,jj)
+               pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+               pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+               pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
+               !
+               pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
+               pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
+               pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)
+            END DO
+         END DO         
+         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points
+         DO jk = 1,jpkm1                     ! Computed as the minimum of neighbooring scale factors
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  pe3u (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji+1,jj,jk) )
+                  pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) )
+                  pe3uw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji+1,jj,jk) )
+                  pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) )
+               END DO
+            END DO
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                 pe3f(ji,jj,jk) = MIN( pe3v(ji,jj,jk), pe3v(ji+1,jj,jk) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3u , 'U', 1._wp )   ;   CALL lbc_lnk( pe3uw, 'U', 1._wp )   ! lateral boundary conditions
+         CALL lbc_lnk( pe3v , 'V', 1._wp )   ;   CALL lbc_lnk( pe3vw, 'V', 1._wp )
+         CALL lbc_lnk( pe3f , 'F', 1._wp )
+         DO jk = 1,jpkm1
+            ! set to z-scale factor if zero (i.e. along closed boundaries) because of lbclnk
+            WHERE( pe3u (:,:,jk) == 0._wp )   pe3u (:,:,jk) = pe3t_1d(jk)
+            WHERE( pe3v (:,:,jk) == 0._wp )   pe3v (:,:,jk) = pe3t_1d(jk)
+            WHERE( pe3uw(:,:,jk) == 0._wp )   pe3uw(:,:,jk) = pe3w_1d(jk)
+            WHERE( pe3vw(:,:,jk) == 0._wp )   pe3vw(:,:,jk) = pe3w_1d(jk)
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE usr_def_zgr
+
+
+   SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z1d  ***
+      !!
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
+      !!       The depth of model levels is set from dep(k), an analytical function:
+      !!                   w-level: depw_1d  = dep(k)
+      !!                   t-level: dept_1d  = dep(k+0.5)
+      !!       The scale factors are the discrete derivative of the depth:
+      !!                   e3w_1d(jk) = dk[ dept_1d ] 
+      !!                   e3t_1d(jk) = dk[ depw_1d ]
+      !!
+      !!            ===    Here constant vertical resolution   ===
+      !!
+      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
+      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
+      !
+      INTEGER  ::   jk       ! dummy loop indices
+      REAL(wp) ::   zt, zw   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_e3
+         WRITE(numout,*) '    ~~~~~~~'
+      ENDIF
+      !
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
+      ! ----------------------
+      DO jk = 1, jpk
+         zw = REAL( jk , wp )
+         zt = REAL( jk , wp ) + 0.5_wp
+         pdepw_1d(jk) =    rn_e3 *   REAL( jk-1 , wp )
+         pdept_1d(jk) =    rn_e3 * ( REAL( jk-1 , wp ) + 0.5_wp )
+         pe3w_1d (jk) =    rn_e3
+         pe3t_1d (jk) =    rn_e3
+      END DO
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      !
+   END SUBROUTINE zgr_z1d
+   
+   !!======================================================================
+END MODULE usrdef_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/cpp_ISOMIP.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/cpp_ISOMIP.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/cpp_ISOMIP.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_zdfcst key_iomput key_mpp_mpi key_nosignedzero 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo-opa.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/file_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/file_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/file_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,38 @@
+<?xml version="1.0"?>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@" sync_freq="10d" min_digits="4">
+      <file_group id="30mi" output_freq="30mi"  output_level="10" enabled=".TRUE." >  <!-- 5d files -->  
+ 
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="e3t"          name="e3t_inst"     long_name="instantaneous T-cell thickness"                operation="instant" />
+	  <field field_ref="toce"         name="thetao_inst"  long_name="instantaneous sea water potential temperature" operation="instant" /> 
+	  <field field_ref="ssh"          name="ssh_inst"     long_name="instantaneous sea surface height above geoid"  operation="instant" />
+	</file>
+
+	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="e3u"          name="e3u_inst"     long_name="instantaneous U-cell thickness"        operation="instant" />
+	  <field field_ref="uoce"         name="uo_inst"      long_name="instantaneous sea water x velocity"    operation="instant" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="e3v"          name="e3v_inst"     long_name="instantaneous V-cell thickness"        operation="instant" />
+	  <field field_ref="voce"         name="vo_inst"      long_name="instantaneous sea water y velocity"    operation="instant" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="e3w"          name="e3w_inst"     long_name="instantaneous W-cell thickness"        operation="instant" />
+	  <field field_ref="woce"         name="wo_inst"      long_name="instantaneous ocean vertical velocity" operation="instant" />
+	</file>
+
+      </file_group>
+
+   </file_definition>
+    
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_flux_cen2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .true.  !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_vect_eenH"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 1       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_vect_een"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_vect_ene"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_vect_ens"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT4_flux_cen2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .true.  !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT4_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT4_vect_eenH"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 1       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT4_vect_een"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT4_vect_ene"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT4_vect_ens"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,214 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   LOCK_EXCHANGE user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    500.   ! horizontal resolution in meters
+   rn_dz       =      1.   ! vertical   resolution in meters
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "LOCK_FCT2_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =   61200   ! for 17h of simulation  (=61200 time-step)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   61200   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   61200   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .false.   !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   nn_closea   =    1      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_isfhmin  =    0.00   !  treshold (m) to discriminate grounding ice to floating ice
+   !
+   rn_rdt      =    1.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   !
+   ln_crs      = .false.   !  Logical switch for coarsening module
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                     ! S-EOS coefficients (nn_eos=1):
+   !                          !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  0.          !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90	(revision 8732)
@@ -0,0 +1,114 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                       ***  MODULE usrdef_hgr   ***
+   !!
+   !!                  ===  LOCK_EXCHANGE configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  NEMO  ! 2016-08  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr    : initialize the horizontal mesh for LOCK_EXCHANGE configuration
+   !!----------------------------------------------------------------------
+   USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE usrdef_nam, ONLY: rn_dx   ! horizontal resolution in meters
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called by domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!                LOCK_EXCHANGE configuration : uniform grid spacing (rn_dx)
+      !!                without Coriolis force (f=0)
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zfact      ! local scalars
+      !!-------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('usr_def_hgr')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : LOCK_EXCHANGE configuration bassin'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   uniform grid spacing WITHOUT Coriolis force (f=0)'
+      !
+      !                       !==  grid point position  ==!   (in kilometers)
+      zfact = rn_dx * 1.e-3         ! conversion in km
+      DO jj = 1, jpj
+         DO ji = 1, jpi             ! longitude
+            plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+            plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
+            plamv(ji,jj) = plamt(ji,jj)
+            plamf(ji,jj) = plamu(ji,jj)
+            !                       ! latitude
+            pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
+            pphiu(ji,jj) = pphit(ji,jj)
+            pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
+            pphif(ji,jj) = pphiv(ji,jj)
+         END DO
+      END DO
+      !
+      !                       !==  Horizontal scale factors  ==!   (in meters) 
+      pe1t(:,:) = rn_dx   ;   pe2t(:,:) = rn_dx
+      pe1u(:,:) = rn_dx   ;   pe2u(:,:) = rn_dx
+      pe1v(:,:) = rn_dx   ;   pe2v(:,:) = rn_dx
+      pe1f(:,:) = rn_dx   ;   pe2f(:,:) = rn_dx
+      !
+      !                             ! NO reduction of grid size in some straits 
+      ke1e2u_v = 0                  !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp           !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp           !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 1                       !  indicate not to compute Coriolis parameter afterward
+      !
+      pff_f(:,:) = 0._wp            ! here No earth rotation: f=0
+      pff_t(:,:) = 0._wp
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('usr_def_hgr')
+      !
+   END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90	(revision 8732)
@@ -0,0 +1,81 @@
+MODULE usrdef_istate
+   !!======================================================================
+   !!                     ***  MODULE usrdef_istate   ***
+   !!
+   !!                  ===  LOCK_EXCHANGE configuration  ===
+   !!
+   !! User defined : set the initial state of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  usr_def_istate : initial state in Temperature and salinity
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean space and time domain
+   USE dom_oce , ONLY : glamt 
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_istate   ! called by istate.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers
+      !!                Here LOCK_EXCHANGE configuration 
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity   field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+      !
+      INTEGER  ::   jk     ! dummy loop indices
+      REAL(wp) ::   zdam   ! location of dam [Km]
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate : LOCK_EXCHANGE configuration, analytical definition of initial state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with a constant salinity (not used as rho=F(T) '
+      IF(lwp) WRITE(numout,*) '                 and a vertical density front with a 5 kg/m3 difference located at glam=32km'
+      IF(lwp) WRITE(numout,*) '                 (i.e. a temperature difference of 25 degrees with rn_a0 = 0.2'
+      !
+      !  rn_a0 =  0.2   !  thermal expension coefficient (nn_eos= 1)
+      !  rho = rau0 - rn_a0 * (T-10) 
+      !  delta_T = 25 degrees  ==>>  delta_rho = 25 * rn_a0 = 5 kg/m3
+      !
+      pu  (:,:,:) = 0._wp        ! ocean at rest
+      pv  (:,:,:) = 0._wp
+      pssh(:,:)   = 0._wp
+      !
+      !                          ! T & S profiles
+      zdam = 32.                      ! density front position in kilometers
+      pts(:,:,:,jp_tem) = 30._wp * ptmask(:,:,:)
+      DO jk = 1, jpkm1
+         WHERE( glamt(:,:) <= zdam )   pts(:,:,jk,jp_tem) = 5._wp * ptmask(:,:,jk)
+      END DO
+      !
+      pts(:,:,:,jp_sal) = 35._wp * ptmask(:,:,:)
+      !   
+   END SUBROUTINE usr_def_istate
+
+   !!======================================================================
+END MODULE usrdef_istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_nam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_nam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_nam.F90	(revision 8732)
@@ -0,0 +1,102 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                       ***  MODULE usrdef_nam  ***
+   !!
+   !!                  ===  LOCK_EXCHANGE configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called by nemogcm.F90
+
+   !                              !!* namusr_def namelist *!!
+   REAL(wp), PUBLIC ::   rn_dx     ! resolution in meters defining the horizontal domain size
+   REAL(wp), PUBLIC ::   rn_dz     ! resolution in meters defining the vertical   domain size
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here LOCK_EXCHANGE configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   ios, ii   ! Local integer
+      !!
+      NAMELIST/namusr_def/ rn_dx, rn_dz
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      !
+      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. )
+      !
+      WRITE( ldnam(:), namusr_def )
+      !
+      !
+      cd_cfg = 'LOCK_EXCHANGE'      ! name & resolution (not used)
+      kk_cfg = INT( rn_dx )
+      !
+      ! Global Domain size:  LOCK_EXCHANGE domain is 64 km x 3 grid-points x 20 m
+      kpi = INT(  64.e3 / rn_dx ) + 2
+      kpj = 3
+      kpk = INT(  20.  / rn_dz ) + 1
+      !
+      !                             ! control print
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                 ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist namusr_def : LOCK_EXCHANGE test case'                             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      horizontal resolution                    rn_dx  = ', rn_dx, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      LOCK_EXCHANGE domain = 64 km  x  3 grid-points  x  20 m'                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         resulting global domain size :        jpiglo = ', kpi                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpjglo = ', kpj                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpkglo = ', kpk                ;   ii = ii + 1
+      !
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 0                    ! LOCK_EXCHANGE configuration : closed domain
+      !
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Lateral boundary condition of the global domain'                           ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      closed                                   jperio = ', kperio             ;   ii = ii + 1
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_sbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_sbc.F90	(revision 8732)
@@ -0,0 +1,86 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                       ***  MODULE usrdef_sbc  ***
+   !! 
+   !!                  ===  LOCK_EXCHANGE configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_sbc    : user defined surface bounday conditions in LOCK_EXCHANGE case
+   !!----------------------------------------------------------------------
+   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 in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usr_def_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   all 0 fields, for LOCK_EXCHANGE case
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)' usr_sbc : LOCK_EXCHANGE case: NO surface forcing'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0'
+         !
+         utau(:,:) = 0._wp
+         vtau(:,:) = 0._wp
+         taum(:,:) = 0._wp
+         wndm(:,:) = 0._wp
+         !
+         emp (:,:) = 0._wp
+         sfx (:,:) = 0._wp
+         qns (:,:) = 0._wp
+         qsr (:,:) = 0._wp
+         !         
+      ENDIF
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/usrdef_zgr.F90	(revision 8732)
@@ -0,0 +1,171 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                   ***  MODULE  usrdef_zgr  ***
+   !!
+   !!                   ===  LOCK_EXCHANGE case  ===
+   !!
+   !! Ocean domain : user defined vertical coordinate system 
+   !!======================================================================
+   !! History :  4.0  ! 2016-08  (G. Madec, S. Flavoni)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system (required)
+   !!       zgr_z1d   : reference 1D z-coordinate 
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco   ! ocean space and time domain
+   USE usrdef_nam     ! User defined : namelist variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_zgr   ! called by domzgr.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
+      &                    k_top  , k_bot    )                             ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   jk   ! dummy indices
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : LOCK_EXCHANGE configuration (z-coordinate closed box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ! set in usrdef_nam.F90 by reading the namusr_def namelist only ln_zco
+      ln_zco    = .TRUE.       ! z-partial-step coordinate
+      ln_zps    = .FALSE.      ! z-partial-step coordinate
+      ln_sco    = .FALSE.      ! s-coordinate
+      ld_isfcav = .FALSE.      ! ISF Ice Shelves Flag
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      !
+      !                       !==  UNmasked meter bathymetry  ==!
+      !
+      ! flat bassin (20m deep and 64000m wide, set through the jpk and jpi (see userdef_nam.F90))
+      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
+      !
+      !
+      !                       !==  top masked level bathymetry  ==!  (all coordinates)
+      !
+      ! no ocean cavities : top ocean level is ONE, except over land
+      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0 
+      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level
+      CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90)
+      k_top(:,:) = NINT( z2d(:,:) )
+      !
+      !                              
+      !                       !==  z-coordinate  ==!   (step-like topography)
+      !
+      !                                !* bottom ocean compute from the depth of grid-points
+      k_bot(:,:) = jpkm1 * k_top(:,:)     ! here use k_top as a land mask
+      !                                !* horizontally uniform coordinate (reference z-co everywhere)
+      DO jk = 1, jpk
+         pdept(:,:,jk) = pdept_1d(jk)
+         pdepw(:,:,jk) = pdepw_1d(jk)
+         pe3t (:,:,jk) = pe3t_1d (jk)
+         pe3u (:,:,jk) = pe3t_1d (jk)
+         pe3v (:,:,jk) = pe3t_1d (jk)
+         pe3f (:,:,jk) = pe3t_1d (jk)
+         pe3w (:,:,jk) = pe3w_1d (jk)
+         pe3uw(:,:,jk) = pe3w_1d (jk)
+         pe3vw(:,:,jk) = pe3w_1d (jk)
+      END DO
+      !
+   END SUBROUTINE usr_def_zgr
+
+
+   SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z1d  ***
+      !!
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
+      !!       The depth of model levels is set from dep(k), an analytical function:
+      !!                   w-level: depw_1d  = dep(k)
+      !!                   t-level: dept_1d  = dep(k+0.5)
+      !!       The scale factors are the discrete derivative of the depth:
+      !!                   e3w_1d(jk) = dk[ dept_1d ] 
+      !!                   e3t_1d(jk) = dk[ depw_1d ]
+      !!
+      !!            ===    Here constant vertical resolution   ===
+      !!
+      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
+      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
+      !
+      INTEGER  ::   jk       ! dummy loop indices
+      REAL(wp) ::   zt, zw   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_dz
+         WRITE(numout,*) '    ~~~~~~~'
+      ENDIF
+      !
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
+      ! ----------------------
+      DO jk = 1, jpk
+         zw = REAL( jk , wp )
+         zt = REAL( jk , wp ) + 0.5_wp
+         pdepw_1d(jk) =    rn_dz *   REAL( jk-1 , wp )
+         pdept_1d(jk) =    rn_dz * ( REAL( jk-1 , wp ) + 0.5_wp )
+         pe3w_1d (jk) =    rn_dz
+         pe3t_1d (jk) =    rn_dz
+      END DO
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      !
+   END SUBROUTINE zgr_z1d
+   
+   !!======================================================================
+END MODULE usrdef_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/zdfini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/zdfini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/MY_SRC/zdfini.F90	(revision 8732)
@@ -0,0 +1,183 @@
+MODULE zdfini
+   !!======================================================================
+   !!                     ***  MODULE zdfini  ***
+   !!
+   !!                     ===  LOCK_EXCHANGE case  ===
+   !!
+   !! Ocean physics :   read vertical mixing namelist and check consistancy
+   !!======================================================================
+   !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix
+   !!            1.0  ! 2002-08  (G. Madec)  F90 : free form
+   !!             -   ! 2005-06  (C. Ethe) KPP scheme
+   !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.7  ! 2014-12  (G. Madec) remove KPP scheme
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE par_oce         ! mesh and scale factors
+   USE zdf_oce         ! TKE vertical mixing          
+   USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test)
+   USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
+   USE zdfric          ! Richardson vertical mixing   
+   USE zdfddm          ! double diffusion mixing      
+   USE zdfevd          ! enhanced vertical diffusion  
+   USE tranpc          ! convection: non penetrative adjustment
+   USE ldfslp          ! iso-neutral slopes
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+   USE lib_mpp         ! distribued memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_init   ! routine called by opa.F90
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zdf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the vertical ocean physics
+      !!
+      !! ** Method  :   Read namelist namzdf, control logicals 
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios       ! local integers
+      !!
+      NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   &
+         &              ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp,  &
+         &              ln_zdfqiao
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
+      READ  ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
+      READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf )
+
+      IF(lwp) THEN               !* Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_init: vertical physics'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters'
+         WRITE(numout,*) '      vertical eddy viscosity             rn_avm0   = ', rn_avm0
+         WRITE(numout,*) '      vertical eddy diffusivity           rn_avt0   = ', rn_avt0
+         WRITE(numout,*) '      constant background or profile      nn_avb    = ', nn_avb
+         WRITE(numout,*) '      horizontal variation for avtb       nn_havtb  = ', nn_havtb
+         WRITE(numout,*) '      time splitting / backward scheme    ln_zdfexp = ', ln_zdfexp
+         WRITE(numout,*) '      number of time step                 nn_zdfexp = ', nn_zdfexp
+         WRITE(numout,*) '      enhanced vertical diffusion         ln_zdfevd = ', ln_zdfevd
+         WRITE(numout,*) '         applied on momentum (=1/0)       nn_evdm   = ', nn_evdm
+         WRITE(numout,*) '      vertical coefficient for evd        rn_avevd  = ', rn_avevd
+         WRITE(numout,*) '      non-penetrative convection (npc)    ln_zdfnpc = ', ln_zdfnpc
+         WRITE(numout,*) '      npc call  frequency                 nn_npc    = ', nn_npc
+         WRITE(numout,*) '      npc print frequency                 nn_npcp   = ', nn_npcp
+      ENDIF
+
+      !                          !* Parameter & logical controls
+      !                          !  ----------------------------
+      !
+      !                               ! ... check of vertical mixing scheme on tracers
+      !                                              ==> will be done in trazdf module
+      !
+      !                               ! ... check of mixing coefficient
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   vertical mixing option :'
+      ioptio = 0
+      IF( lk_zdfcst ) THEN
+         IF(lwp) WRITE(numout,*) '      constant eddy diffusion coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfric ) THEN
+         IF(lwp) WRITE(numout,*) '      Richardson dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ioptio == 0 .OR. ioptio > 1 )   &
+         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
+      IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   &
+         &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
+      !
+      !                               ! ... Convection
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   convection :'
+      !
+#if defined key_top
+      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' )
+#endif
+      !
+      ioptio = 0
+      IF( ln_zdfnpc ) THEN
+         IF(lwp) WRITE(numout,*) '      use non penetrative convective scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ln_zdfevd ) THEN
+         IF(lwp) WRITE(numout,*) '      use enhanced vertical dif. scheme'
+         ioptio = ioptio+1
+      ENDIF
+      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 ( ioptio > 1 )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           &
+         !SF CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   &
+         CALL ctl_warn( ' except for TKE or GLS physics, a convection scheme is',   &
+         &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
+
+      !                               !* Background eddy viscosity and diffusivity profil
+      IF( nn_avb == 0 ) THEN                ! Define avmb, avtb from namelist parameter
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0                     
+      ELSE                                  ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990)
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0 + ( 3.e-4_wp - 2._wp * rn_avt0 ) * 1.e-4_wp * gdepw_1d(:)   ! m2/s
+         IF(ln_sco .AND. lwp)   CALL ctl_warn( 'avtb profile not valid in sco' )
+      ENDIF
+      !
+      IF( ln_rstart ) THEN                  !  Read avmb, avtb in restart (if exist)
+         ! if ln_traadv_cen, avmb, avtb have been modified in traadv_cen2 module. 
+         ! To ensure the restartability, avmb & avtb are written in the restart 
+         ! file in traadv_cen2 end read here. 
+         IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numror, jpdom_unknown, 'avmb', avmb )
+            CALL iom_get( numror, jpdom_unknown, 'avtb', avtb )
+         ENDIF
+      ENDIF
+      !                                     ! 2D shape of the avtb
+      avtb_2d(:,:) = 1.e0                        ! uniform 
+      !
+      IF( nn_havtb == 1 ) THEN                   ! decrease avtb in the equatorial band
+           !  -15S -5S : linear decrease from avt0 to avt0/10.
+           !  -5S  +5N : cst value avt0/10.
+           !   5N  15N : linear increase from avt0/10, to avt0
+           WHERE(-15. <= gphit .AND. gphit < -5 )   avtb_2d = (1.  - 0.09 * (gphit + 15.))
+           WHERE( -5. <= gphit .AND. gphit <  5 )   avtb_2d =  0.1
+           WHERE(  5. <= gphit .AND. gphit < 15 )   avtb_2d = (0.1 + 0.09 * (gphit -  5.))
+      ENDIF
+      !
+   END SUBROUTINE zdf_init
+
+   !!======================================================================
+END MODULE zdfini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/cpp_LOCK_EXCHANGE.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/cpp_LOCK_EXCHANGE.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/cpp_LOCK_EXCHANGE.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_zdfcst key_iomput key_mpp_mpi key_nosignedzero
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo-opa.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/file_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/file_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/file_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,36 @@
+<?xml version="1.0"?>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@" sync_freq="10d" min_digits="4">
+      <file_group id="30mi" output_freq="30mi"  output_level="10" enabled=".TRUE." >  <!-- 5d files -->  
+ 
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="e3t"          name="e3t_inst"     long_name="instantaneous T-cell thickness"                operation="instant" />
+	  <field field_ref="toce"         name="thetao_inst"  long_name="instantaneous sea water potential temperature" operation="instant" /> 
+	  <field field_ref="ssh"          name="ssh_inst"     long_name="instantaneous sea surface height above geoid"  operation="instant" />
+	</file>
+
+	<file id="file3" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="e3u"          name="e3u_inst"     long_name="instantaneous U-cell thickness"        operation="instant" />
+	  <field field_ref="uoce"         name="uo_inst"      long_name="instantaneous sea water x velocity"    operation="instant" />
+	</file>
+	
+	<file id="file4" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="e3v"          name="e3v_inst"     long_name="instantaneous V-cell thickness"        operation="instant" />
+	  <field field_ref="voce"         name="vo_inst"      long_name="instantaneous sea water y velocity"    operation="instant" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="e3w"          name="e3w_inst"     long_name="instantaneous W-cell thickness"        operation="instant" />
+	  <field field_ref="woce"         name="wo_inst"      long_name="instantaneous ocean vertical velocity" operation="instant" />
+	</file>
+
+      </file_group>
+
+   </file_definition>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,207 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   User defined :   OVERFLOW configuration 
+!-----------------------------------------------------------------------
+   !                       !  type of vertical coordinate
+   ln_zco      = .false.      ! z-coordinate
+   ln_zps      = .true.       ! z-partial-step coordinate
+   ln_sco      = .false.      ! s-coordinate   
+   rn_dx       =   1000.   !  horizontal resolution   [meters]
+   rn_dz       =     20.   !  vertical   resolution   [meters]
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "OVF_FCT2_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   !nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step) abort after 5802 for zps: pb of physiques conditions 
+   nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) 
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    5760   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    5760   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   rn_rdt      =   10.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state)
+   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.      !  iso-level
+   ln_dynldf_hor =  .false.     !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.     !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_sco_FCT2_flux_ubs_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_sco_FCT2_flux_ubs_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_sco_FCT2_flux_ubs_cfg	(revision 8732)
@@ -0,0 +1,207 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   User defined :   OVERFLOW configuration 
+!-----------------------------------------------------------------------
+   !                       !  type of vertical coordinate
+   ln_zco      = .false.      ! z-coordinate
+   ln_zps      = .false.      ! z-partial-step coordinate
+   ln_sco      = .true.       ! s-coordinate   
+   rn_dx       =   1000.   !  horizontal resolution   [meters]
+   rn_dz       =     20.   !  vertical   resolution   [meters]
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "OVF_sco_FCT2_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step) 
+   !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physiques conditions
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    1080   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    1080   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   rn_rdt      =   10.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state)
+   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.      !  iso-level
+   ln_dynldf_hor =  .false.     !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.     !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT2_flux_ubs_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT2_flux_ubs_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT2_flux_ubs_cfg	(revision 8732)
@@ -0,0 +1,207 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   User defined :   OVERFLOW configuration 
+!-----------------------------------------------------------------------
+   !                       !  type of vertical coordinate
+   ln_zco      = .false.      ! z-coordinate
+   ln_zps      = .true.       ! z-partial-step coordinate
+   ln_sco      = .false.      ! s-coordinate   
+   rn_dx       =   1000.   !  horizontal resolution   [meters]
+   rn_dz       =     20.   !  vertical   resolution   [meters]
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "OVF_zps_FCT2_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step) 
+   !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physiques conditions
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    1080   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    1080   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   rn_rdt      =   10.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state)
+   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.      !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.     !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_flux_ubs_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_flux_ubs_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_flux_ubs_cfg	(revision 8732)
@@ -0,0 +1,207 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   User defined :   OVERFLOW configuration 
+!-----------------------------------------------------------------------
+   !                       !  type of vertical coordinate
+   ln_zco      = .false.      ! z-coordinate
+   ln_zps      = .true.       ! z-partial-step coordinate
+   ln_sco      = .false.      ! s-coordinate   
+   rn_dx       =   1000.   !  horizontal resolution   [meters]
+   rn_dz       =     20.   !  vertical   resolution   [meters]
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "OVF_zps_FCT4_flux_ubs"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step) 
+   !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physiques conditions
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    1080   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    1080   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   rn_rdt      =   10.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state)
+   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .false. !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .true.  !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.      !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.     !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_vect_een_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_vect_een_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_zps_FCT4_vect_een_cfg	(revision 8732)
@@ -0,0 +1,207 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def    !   User defined :   OVERFLOW configuration 
+!-----------------------------------------------------------------------
+   !                       !  type of vertical coordinate
+   ln_zco      = .false.      ! z-coordinate
+   ln_zps      = .true.       ! z-partial-step coordinate
+   ln_sco      = .false.      ! s-coordinate   
+   rn_dx       =   1000.   !  horizontal resolution   [meters]
+   rn_dz       =     20.   !  vertical   resolution   [meters]
+/
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =   "OVF_zps_FCT4_vect_een"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    6120  ! here 17h of simulation  (=6120 time-step) 
+   !nn_itend    =    5760   ! here 16h of simulation  (=5760 time-step) abort after 5802 for zps: pb of physiques conditions
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    1080   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    1080   !  frequency of write in the output file   (modulo referenced to nn_it000)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   rn_rdt      =   10.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+  nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                          !     (also = the frequency of sea-ice & iceberg model call)
+  ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc)
+  ln_blk      = .false.   !  Bulk formulation                          (T => fill namsbc_blk )
+  nn_ice      = 0         !  =0 no ice boundary condition   
+  ln_traqsr   = .false.   !  Light penetration in the ocean            (T => fill namtra_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
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+!                         !  free slip  !   partial slip  !   no slip   ! strong slip
+  rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    0      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_seos     = .true.         !  = Use simplified equation of state (S-EOS)
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  0.2         !  thermal expension coefficient (for simplified equation of state)
+   rn_b0       =  0.          !  saline  expension coefficient (for simplified equation of state)
+   rn_lambda1  =  0.          !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  0.          !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  0.          !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  0.          !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  0.          !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .true. !  FCT scheme
+      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order
+      nn_fct_v   =  4            !  =2/4, vertical   2nd / COMPACT 4th order
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!-----------------------------------------------------------------------
+   !                       !  Operator type:    both false = No lateral diffusion
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                       (default: YES)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.  !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         nn_baro      =  1         ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.     !  iso-level
+   ln_dynldf_hor =  .true.      !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.     !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =     0.01    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =     0.      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =     1.e+12  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.     !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.  !  enhanced vertical diffusion (evd)
+   ln_zdfnpc   = .false.  !  Non-Penetrative Convective algorithm
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_hgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_hgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_hgr.F90	(revision 8732)
@@ -0,0 +1,114 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_hgr  ***
+   !!
+   !!                     ===  OVERFLOW configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  NEMO  ! 2016-08  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr    : initialize the horizontal mesh for OVERFLOW configuration
+   !!----------------------------------------------------------------------
+   USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE usrdef_nam, ONLY: rn_dx   ! horizontal resolution in meters
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called by domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!                OVERFLOW configuration : uniform grid spacing (rn_dx)
+      !!                without Coriolis force (f=0)
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zfact      ! local scalars
+      !!-------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('usr_def_hgr')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : OVERFLOW configuration bassin'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   uniform grid spacing WITHOUT Coriolis force (f=0)'
+      !
+      !                       !==  grid point position  ==!   (in kilometers)
+      zfact = rn_dx * 1.e-3         ! conversion in km
+      DO jj = 1, jpj
+         DO ji = 1, jpi             ! longitude
+            plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+            plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
+            plamv(ji,jj) = plamt(ji,jj)
+            plamf(ji,jj) = plamu(ji,jj)
+            !                       ! latitude
+            pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
+            pphiu(ji,jj) = pphit(ji,jj)
+            pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
+            pphif(ji,jj) = pphiv(ji,jj)
+         END DO
+      END DO
+      !
+      !                       !==  Horizontal scale factors  ==!   (in meters) 
+      pe1t(:,:) = rn_dx   ;   pe2t(:,:) = rn_dx
+      pe1u(:,:) = rn_dx   ;   pe2u(:,:) = rn_dx
+      pe1v(:,:) = rn_dx   ;   pe2v(:,:) = rn_dx
+      pe1f(:,:) = rn_dx   ;   pe2f(:,:) = rn_dx
+      !
+      !                             ! NO reduction of grid size in some straits 
+      ke1e2u_v = 0                  !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp           !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp           !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 1                       !  indicate not to compute Coriolis parameter afterward
+      !
+      pff_f(:,:) = 0._wp            ! here No earth rotation: f=0
+      pff_t(:,:) = 0._wp
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('usr_def_hgr')
+      !
+   END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_istate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_istate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_istate.F90	(revision 8732)
@@ -0,0 +1,81 @@
+MODULE usrdef_istate
+   !!==============================================================================
+   !!                       ***  MODULE usrdef_istate  ***
+   !!
+   !!                      ===  OVERFLOW configuration  ===
+   !!
+   !! User defined : set the initial state of a user configuration
+   !!==============================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  usr_def_istate : initial state in Temperature and salinity
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean space and time domain
+   USE dom_oce , ONLY : glamt 
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_istate   ! called by istate.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers
+      !!                Here OVERFLOW configuration 
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity   field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+      !
+      INTEGER  ::   jk     ! dummy loop indices
+      REAL(wp) ::   zdam   ! location of dam [Km]
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate : OVERFLOW configuration, analytical definition of initial state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with a constant salinity (not used as rho=F(T) '
+      IF(lwp) WRITE(numout,*) '                 and a vertical density front with a 2 kg/m3 difference located at glam=20km'
+      IF(lwp) WRITE(numout,*) '                 (i.e. a temperature difference of 10 degrees with rn_a0 = 0.2'
+      !
+      !  rn_a0 =  0.2   !  thermal expension coefficient (nn_eos= 1)
+      !  rho = rau0 - rn_a0 * (T-10) 
+      !  delta_T = 10 degrees  ==>>  delta_rho = 10 * rn_a0 = 2 kg/m3
+      !
+      pu  (:,:,:) = 0._wp        ! ocean at rest
+      pv  (:,:,:) = 0._wp
+      pssh(:,:)   = 0._wp
+      !
+      !                          ! T & S profiles
+      zdam = 20.                      ! density front position in kilometers
+      pts(:,:,:,jp_tem) = 20._wp * ptmask(:,:,:)
+      DO jk = 1, jpkm1
+         WHERE( glamt(:,:) <= zdam )   pts(:,:,jk,jp_tem) = 10._wp * ptmask(:,:,jk)
+      END DO
+      !
+      pts(:,:,:,jp_sal) = 35._wp * ptmask(:,:,:)
+      !   
+   END SUBROUTINE usr_def_istate
+
+   !!======================================================================
+END MODULE usrdef_istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_nam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_nam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_nam.F90	(revision 8732)
@@ -0,0 +1,106 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_nam  ***
+   !!
+   !!                     ===  OVERFLOW configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain
+   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called by nemogcm.F90
+
+   !                              !!* namusr_def namelist *!!
+   REAL(wp), PUBLIC ::   rn_dx     ! resolution in meters defining the horizontal domain size
+   REAL(wp), PUBLIC ::   rn_dz     ! resolution in meters defining the vertical   domain size
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here OVERFLOW configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   ios, ii   ! Local integer
+      !!
+      NAMELIST/namusr_def/ ln_zco, ln_zps, ln_sco, rn_dx, rn_dz
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      !
+      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. )
+      !
+      WRITE( ldnam(:), namusr_def )
+      !
+      cd_cfg = 'OVERFLOW'           ! name & resolution (not used)
+      kk_cfg = INT( rn_dx )
+      !
+      ! Global Domain size:  OVERFLOW domain is  200 km x 3 grid-points x 2000 m
+      kpi = INT( 200.e3 / rn_dx ) + 2
+      kpj = 3
+      kpk = INT(  2000. / rn_dz ) + 1
+      !
+      !                             ! control print
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                 ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist namusr_def : OVERFLOW test case'                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      type of vertical coordinate : '                                         ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         z-coordinate flag                     ln_zco = ', ln_zco             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         z-partial-step coordinate flag        ln_zps = ', ln_zps             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         s-coordinate flag                     ln_sco = ', ln_sco             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      horizontal resolution                    rn_dx  = ', rn_dx, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      OVERFLOW domain = 200 km x 3 grid-points x 2000 m'                      ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         resulting global domain size :        jpiglo = ', kpi                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpjglo = ', kpj                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpkglo = ', kpk                ;   ii = ii + 1
+      !
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 0                    ! OVERFLOW configuration : close basin
+      !
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Lateral boundary condition of the global domain'                           ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      OVERFLOW : closed basin                  jperio = ', kperio             ;   ii = ii + 1
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_sbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_sbc.F90	(revision 8732)
@@ -0,0 +1,86 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_sbc  ***
+   !! 
+   !!                     ===  OVERFLOW configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_sbc    : user defined surface bounday conditions in OVERFLOW case
+   !!----------------------------------------------------------------------
+   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 in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usr_def_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   all 0 fields, for OVERFLOW case
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)' usr_sbc : OVERFLOW case: NO surface forcing'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0'
+         !
+         utau(:,:) = 0._wp
+         vtau(:,:) = 0._wp
+         taum(:,:) = 0._wp
+         wndm(:,:) = 0._wp
+         !
+         emp (:,:) = 0._wp
+         sfx (:,:) = 0._wp
+         qns (:,:) = 0._wp
+         qsr (:,:) = 0._wp
+         !         
+      ENDIF
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_zgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/usrdef_zgr.F90	(revision 8732)
@@ -0,0 +1,267 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                     ***  MODULE usrdef_zgr  ***
+   !!
+   !!                       ===  OVERFLOW case  ===
+   !!
+   !! user defined :  vertical coordinate system of a user configuration
+   !!======================================================================
+   !! History :  4.0  ! 2016-08  (G. Madec, S. Flavoni)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system (required)
+   !!       zgr_z1d   : reference 1D z-coordinate 
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco   ! ocean space and time domain
+   USE dom_oce ,  ONLY: mi0, mi1, nimpp, njmpp   ! ocean space and time domain
+   USE dom_oce ,  ONLY: glamt                    ! ocean space and time domain
+   USE usrdef_nam     ! User defined : namelist variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_zgr   ! called by domzgr.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
+      &                    k_top  , k_bot    )                             ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   ji, jj, jk        ! dummy indices
+      INTEGER  ::   ik                ! local integers
+      REAL(wp) ::   zfact, z1_jpkm1   ! local scalar
+      REAL(wp) ::   ze3min            ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj) ::   zht, zhu, z2d   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : OVERFLOW configuration (z(ps)- or s-coordinate closed box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ! already set in usrdef_nam.F90 by reading the namusr_def namelist except for ISF
+      ld_isfcav = .FALSE.
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      !
+      !                       !==  UNmasked meter bathymetry  ==!
+      !
+      ! western continental shelf (500m deep) and eastern deep ocean (2000m deep)
+      ! (set through the jpk and jpi (see userdef_nam.F90))
+      ! with a hyperbolic tangent transition centered at 40km
+      ! NB: here glamt is in kilometers
+      !
+      zht(:,:) = + (  500. + 0.5 * 1500. * ( 1.0 + tanh( (glamt(:,:) - 40.) / 7. ) )  )
+      !
+      ! at u-point: averaging zht
+      DO ji = 1, jpim1
+         zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) )
+      END DO
+      CALL lbc_lnk( zhu, 'U', 1. )     ! boundary condition: this mask the surrouding grid-points
+      !                                ! ==>>>  set by hand non-zero value on first/last columns & rows 
+      DO ji = mi0(1), mi1(1)              ! first row of global domain only
+         zhu(ji,2) = zht(1,2)
+      END DO
+       DO ji = mi0(jpi), mi1(jpi)         ! last  row of global domain only
+         zhu(ji,2) = zht(jpi,2)
+      END DO
+      zhu(:,1) = zhu(:,2)
+      zhu(:,3) = zhu(:,2)
+      !     
+      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
+      !
+      !
+      !                       !==  top masked level bathymetry  ==!  (all coordinates)
+      !
+      ! no ocean cavities : top ocean level is ONE, except over land
+      ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0 
+      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level
+      CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90)
+      k_top(:,:) = NINT( z2d(:,:) )
+      !
+      !                              
+      !
+      IF ( ln_sco ) THEN      !==  s-coordinate  ==!   (terrain-following coordinate)
+         !
+         k_bot(:,:) = jpkm1 * k_top(:,:)  !* bottom ocean = jpk-1 (here use k_top as a land mask)
+         !
+         !                                !* terrain-following coordinate with e3.(k)=cst)
+         !                                !  OVERFLOW case : identical with j-index (T=V, U=F)
+         z1_jpkm1 = 1._wp / REAL( jpkm1 , wp)
+         DO jk = 1, jpk
+            pdept(:,:,jk) = zht(:,:) * z1_jpkm1 * ( REAL( jk   , wp ) - 0.5_wp )
+            pdepw(:,:,jk) = zht(:,:) * z1_jpkm1 * ( REAL( jk-1 , wp )          )
+            pe3t (:,:,jk) = zht(:,:) * z1_jpkm1
+            pe3u (:,:,jk) = zhu(:,:) * z1_jpkm1
+            pe3v (:,:,jk) = zht(:,:) * z1_jpkm1
+            pe3f (:,:,jk) = zhu(:,:) * z1_jpkm1
+            pe3w (:,:,jk) = zht(:,:) * z1_jpkm1
+            pe3uw(:,:,jk) = zhu(:,:) * z1_jpkm1
+            pe3vw(:,:,jk) = zht(:,:) * z1_jpkm1
+         END DO      
+      ENDIF
+      !
+      !
+      IF ( ln_zco ) THEN      !==  z-coordinate  ==!   (step-like topography)
+         !
+         !                                !* bottom ocean compute from the depth of grid-points
+         k_bot(:,:) = jpkm1 * k_top(:,:)     ! here use k_top as a land mask
+         DO jk = 1, jpkm1
+            WHERE( pdept_1d(jk) < zht(:,:) .AND. zht(:,:) <= pdept_1d(jk+1) )   k_bot(:,:) = jk * k_top(:,:)
+         END DO
+         !                                !* horizontally uniform coordinate (reference z-co everywhere)
+         DO jk = 1, jpk
+            pdept(:,:,jk) = pdept_1d(jk)
+            pdepw(:,:,jk) = pdepw_1d(jk)
+            pe3t (:,:,jk) = pe3t_1d (jk)
+            pe3u (:,:,jk) = pe3t_1d (jk)
+            pe3v (:,:,jk) = pe3t_1d (jk)
+            pe3f (:,:,jk) = pe3t_1d (jk)
+            pe3w (:,:,jk) = pe3w_1d (jk)
+            pe3uw(:,:,jk) = pe3w_1d (jk)
+            pe3vw(:,:,jk) = pe3w_1d (jk)
+         END DO
+      ENDIF
+      !
+      !
+      IF ( ln_zps ) THEN      !==  zps-coordinate  ==!   (partial bottom-steps)
+         !
+         ze3min = 0.1_wp * rn_dz
+         IF(lwp) WRITE(numout,*) '   minimum thickness of the partial cells = 10 % of e3 = ', ze3min
+         !
+         !
+         !                                !* bottom ocean compute from the depth of grid-points
+         k_bot(:,:) = jpkm1
+         DO jk = jpkm1, 1, -1
+            WHERE( zht(:,:) < pdepw_1d(jk) + ze3min )   k_bot(:,:) = jk-1
+         END DO
+         !
+         !                                !* vertical coordinate system
+         DO jk = 1, jpk                      ! initialization to the reference z-coordinate
+            pdept(:,:,jk) = pdept_1d(jk)
+            pdepw(:,:,jk) = pdepw_1d(jk)
+            pe3t (:,:,jk) = pe3t_1d (jk)
+            pe3u (:,:,jk) = pe3t_1d (jk)
+            pe3v (:,:,jk) = pe3t_1d (jk)
+            pe3f (:,:,jk) = pe3t_1d (jk)
+            pe3w (:,:,jk) = pe3w_1d (jk)
+            pe3uw(:,:,jk) = pe3w_1d (jk)
+            pe3vw(:,:,jk) = pe3w_1d (jk)
+         END DO
+         DO jj = 1, jpj                      ! bottom scale factors and depth at T- and W-points
+            DO ji = 1, jpi
+               ik = k_bot(ji,jj)
+                  pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
+                  pe3t (ji,jj,ik  ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
+                  pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik  ) 
+                  !
+                  pdept(ji,jj,ik  ) = pdepw(ji,jj,ik  ) + pe3t (ji,jj,ik  ) * 0.5_wp
+                  pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
+                  pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)              ! = pe3t (ji,jj,ik  )
+            END DO
+         END DO         
+         !                                   ! bottom scale factors and depth at  U-, V-, UW and VW-points
+         !                                   ! usually Computed as the minimum of neighbooring scale factors
+         pe3u (:,:,:) = pe3t(:,:,:)          ! HERE OVERFLOW configuration : 
+         pe3v (:,:,:) = pe3t(:,:,:)          !    e3 increases with i-index and identical with j-index
+         pe3f (:,:,:) = pe3t(:,:,:)          !    so e3 minimum of (i,i+1) points is (i) point
+         pe3uw(:,:,:) = pe3w(:,:,:)          !    in j-direction e3v=e3t and e3f=e3v
+         pe3vw(:,:,:) = pe3w(:,:,:)          !    ==>>  no need of lbc_lnk calls
+         !      
+      ENDIF
+      !
+   END SUBROUTINE usr_def_zgr
+
+
+   SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z1d  ***
+      !!
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
+      !!       The depth of model levels is set from dep(k), an analytical function:
+      !!                   w-level: depw_1d  = dep(k)
+      !!                   t-level: dept_1d  = dep(k+0.5)
+      !!       The scale factors are the discrete derivative of the depth:
+      !!                   e3w_1d(jk) = dk[ dept_1d ] 
+      !!                   e3t_1d(jk) = dk[ depw_1d ]
+      !!
+      !!            ===    Here constant vertical resolution   ===
+      !!
+      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
+      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
+      !
+      INTEGER  ::   jk       ! dummy loop indices
+      REAL(wp) ::   zt, zw   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_dz
+         WRITE(numout,*) '    ~~~~~~~'
+      ENDIF
+      !
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
+      ! ----------------------
+      DO jk = 1, jpk
+         zw = REAL( jk , wp )
+         zt = REAL( jk , wp ) + 0.5_wp
+         pdepw_1d(jk) =    rn_dz *   REAL( jk-1 , wp )
+         pdept_1d(jk) =    rn_dz * ( REAL( jk-1 , wp ) + 0.5_wp )
+         pe3w_1d (jk) =    rn_dz
+         pe3t_1d (jk) =    rn_dz
+      END DO
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      !
+   END SUBROUTINE zgr_z1d
+   
+   !!======================================================================
+END MODULE usrdef_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/zdfini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/zdfini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/MY_SRC/zdfini.F90	(revision 8732)
@@ -0,0 +1,183 @@
+MODULE zdfini
+   !!======================================================================
+   !!                     ***  MODULE zdfini  ***
+   !!
+   !!                     ===  OVERFLOW case  ===
+   !!
+   !! Ocean physics :   read vertical mixing namelist and check consistancy
+   !!======================================================================
+   !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix
+   !!            1.0  ! 2002-08  (G. Madec)  F90 : free form
+   !!             -   ! 2005-06  (C. Ethe) KPP scheme
+   !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.7  ! 2014-12  (G. Madec) remove KPP scheme
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE par_oce         ! mesh and scale factors
+   USE zdf_oce         ! TKE vertical mixing          
+   USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test)
+   USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
+   USE zdfric          ! Richardson vertical mixing   
+   USE zdfddm          ! double diffusion mixing      
+   USE zdfevd          ! enhanced vertical diffusion  
+   USE tranpc          ! convection: non penetrative adjustment
+   USE ldfslp          ! iso-neutral slopes
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+   USE lib_mpp         ! distribued memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_init   ! routine called by opa.F90
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zdf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the vertical ocean physics
+      !!
+      !! ** Method  :   Read namelist namzdf, control logicals 
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios       ! local integers
+      !!
+      NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   &
+         &              ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp,  &
+         &              ln_zdfqiao
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
+      READ  ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
+      READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf )
+
+      IF(lwp) THEN               !* Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_init: vertical physics'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters'
+         WRITE(numout,*) '      vertical eddy viscosity             rn_avm0   = ', rn_avm0
+         WRITE(numout,*) '      vertical eddy diffusivity           rn_avt0   = ', rn_avt0
+         WRITE(numout,*) '      constant background or profile      nn_avb    = ', nn_avb
+         WRITE(numout,*) '      horizontal variation for avtb       nn_havtb  = ', nn_havtb
+         WRITE(numout,*) '      time splitting / backward scheme    ln_zdfexp = ', ln_zdfexp
+         WRITE(numout,*) '      number of time step                 nn_zdfexp = ', nn_zdfexp
+         WRITE(numout,*) '      enhanced vertical diffusion         ln_zdfevd = ', ln_zdfevd
+         WRITE(numout,*) '         applied on momentum (=1/0)       nn_evdm   = ', nn_evdm
+         WRITE(numout,*) '      vertical coefficient for evd        rn_avevd  = ', rn_avevd
+         WRITE(numout,*) '      non-penetrative convection (npc)    ln_zdfnpc = ', ln_zdfnpc
+         WRITE(numout,*) '      npc call  frequency                 nn_npc    = ', nn_npc
+         WRITE(numout,*) '      npc print frequency                 nn_npcp   = ', nn_npcp
+      ENDIF
+
+      !                          !* Parameter & logical controls
+      !                          !  ----------------------------
+      !
+      !                               ! ... check of vertical mixing scheme on tracers
+      !                                              ==> will be done in trazdf module
+      !
+      !                               ! ... check of mixing coefficient
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   vertical mixing option :'
+      ioptio = 0
+      IF( lk_zdfcst ) THEN
+         IF(lwp) WRITE(numout,*) '      constant eddy diffusion coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfric ) THEN
+         IF(lwp) WRITE(numout,*) '      Richardson dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ioptio == 0 .OR. ioptio > 1 )   &
+         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
+      IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   &
+         &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
+      !
+      !                               ! ... Convection
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   convection :'
+      !
+#if defined key_top
+      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' )
+#endif
+      !
+      ioptio = 0
+      IF( ln_zdfnpc ) THEN
+         IF(lwp) WRITE(numout,*) '      use non penetrative convective scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ln_zdfevd ) THEN
+         IF(lwp) WRITE(numout,*) '      use enhanced vertical dif. scheme'
+         ioptio = ioptio+1
+      ENDIF
+      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 ( ioptio > 1 )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           &
+         !SF CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   &
+         CALL ctl_warn( ' except for TKE or GLS physics, a convection scheme is',   &
+         &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
+
+      !                               !* Background eddy viscosity and diffusivity profil
+      IF( nn_avb == 0 ) THEN                ! Define avmb, avtb from namelist parameter
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0                     
+      ELSE                                  ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990)
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0 + ( 3.e-4_wp - 2._wp * rn_avt0 ) * 1.e-4_wp * gdepw_1d(:)   ! m2/s
+         IF(ln_sco .AND. lwp)   CALL ctl_warn( 'avtb profile not valid in sco' )
+      ENDIF
+      !
+      IF( ln_rstart ) THEN                  !  Read avmb, avtb in restart (if exist)
+         ! if ln_traadv_cen, avmb, avtb have been modified in traadv_cen2 module. 
+         ! To ensure the restartability, avmb & avtb are written in the restart 
+         ! file in traadv_cen2 end read here. 
+         IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numror, jpdom_unknown, 'avmb', avmb )
+            CALL iom_get( numror, jpdom_unknown, 'avtb', avtb )
+         ENDIF
+      ENDIF
+      !                                     ! 2D shape of the avtb
+      avtb_2d(:,:) = 1.e0                        ! uniform 
+      !
+      IF( nn_havtb == 1 ) THEN                   ! decrease avtb in the equatorial band
+           !  -15S -5S : linear decrease from avt0 to avt0/10.
+           !  -5S  +5N : cst value avt0/10.
+           !   5N  15N : linear increase from avt0/10, to avt0
+           WHERE(-15. <= gphit .AND. gphit < -5 )   avtb_2d = (1.  - 0.09 * (gphit + 15.))
+           WHERE( -5. <= gphit .AND. gphit <  5 )   avtb_2d =  0.1
+           WHERE(  5. <= gphit .AND. gphit < 15 )   avtb_2d = (0.1 + 0.09 * (gphit -  5.))
+      ENDIF
+      !
+   END SUBROUTINE zdf_init
+
+   !!======================================================================
+END MODULE zdfini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/cpp_OVERFLOW.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/cpp_OVERFLOW.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/cpp_OVERFLOW.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_zdfcst key_mpp_mpi key_iomput key_nosignedzero
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/README	(revision 8732)
@@ -0,0 +1,6 @@
+## List of available test cases is in CONFIG/TEST_CASES/cfg.txt
+
+## HOW TO COMPILE TEST CASES :
+
+use makenemo to compile in "-a" alternative sub-directory for configurations (below CONFIG) 
+../makenemo -a TEST_CASES -n WAD2 -r WAD -m macport_osx -j 4
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_context_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link context_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_cfg	(revision 8732)
@@ -0,0 +1,245 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namusr_def    !   SAS_BIPER user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    1000.   ! horizontal resolution in meters
+   rn_dy       =    1000.   ! horizontal resolution in meters
+/
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0      !  job number (no more used...)
+   cn_exp      =  "SASBIPER"  !  experience name
+   nn_it000    =       1      !  first time step
+   nn_itend    =    30300     !  last  time step (std 5475)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.    !  (=T) read the domain configuration file
+      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "SASBIPER_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   !
+   rn_rdt      = 400.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_usr      = .true.   !  user defined formulation                  (T => check usrdef_sbc)
+   nn_fsbc     =  1       !  frequency of surface boundary condition computation
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  4               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.   !  z-coordinate - full steps
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_ice_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_ice_cfg	(revision 8732)
@@ -0,0 +1,86 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! LIM3 namelist:  
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Diagnostics                        (namicediag)
+!!              3 - Ice initialization                 (namiceini)
+!!              4 - Ice discretization                 (namiceitd)
+!!              5 - Ice dynamics and transport         (namicedyn)
+!!              6 - Ice diffusion                      (namicehdf)
+!!              7 - Ice thermodynamics                 (namicethd)
+!!              8 - Ice salinity                       (namicesal)
+!!              9 - Ice mechanical redistribution      (namiceitdme)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+   jpl              =    1          !  number of ice  categories
+   nlay_i           =    1          !  number of ice  layers
+   ln_limthd        =  .false.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   nn_limdyn        =   0           !     (ln_limdyn=T) switch for ice dynamics
+                                    !      2: total
+                                    !      1: advection only (no diffusion, no ridging/rafting)
+                                    !      0: advection only (as 1 but with prescribed velocity, bypass rheology)
+   rn_uice          =   0.5    !     (nn_limdyn=0) ice u-velocity
+   rn_vice          =   0.0    !     (nn_limdyn=0) ice v-velocity
+/
+!------------------------------------------------------------------------------
+&namicediag    !   Diagnostics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+                  ! -- limistate -- !
+   ln_limini      = .false.         !  activate ice initialization (T) or not (F)
+   ln_limini_file = .false.         !  netcdf file provided for initialization (T) or not (F)
+   cn_dir="./"
+   sn_hti = 'initice'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_hts = 'initice'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_ati = 'initice'    , -12 ,'ati'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_tsu = 'initice'    , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_tmi = 'initice'    , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_smi = 'initice'    , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+                  ! -- limtrp & limadv -- !
+   nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
+   nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0)
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+                  ! -- limthd_dh -- !
+   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+                  ! -- limthd_da -- !
+   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+                 ! -- limthd_lac -- !
+   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_hnewice     = 0.02            !  thickness for new ice formation in open water (m)
+                  ! -- limitd_th -- !
+   rn_himin       = 0.01            !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
+/
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+                 ! -- limthd_sal -- !
+   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+/
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+                  ! -- limitd_me -- !
+   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/1_namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/1_namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/AGRIF_FixedGrids.in
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/AGRIF_FixedGrids.in	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/AGRIF_FixedGrids.in	(revision 8732)
@@ -0,0 +1,3 @@
+1
+41 60 41 60 3 3 3
+0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,122 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+    <field_definition src="./field_def_nemo-lim.xml"/>   <!--  LIM ice model                           -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo-opa.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <file_definition src="./file_def_nemo-lim.xml"/>     <!--  NEMO ocean sea ice                      -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/file_def_nemo-lim.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/file_def_nemo-lim.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/file_def_nemo-lim.xml	(revision 8732)
@@ -0,0 +1,65 @@
+<?xml version="1.0"?>
+    <!-- $id$ -->
+    
+ <!--
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files for lim3                                =
+=                                         put the variables you want...                                    =
+============================================================================================================
+  -->
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE.">  <!-- 1 timestep files -->   	
+
+	<file id="file1" name_suffix="_icemod" description="ice variables" enabled=".true." >
+
+        <field field_ref="snowthic_cea"     name="snthic"     long_name="surface_snow_thickness"   />
+        <field field_ref="snowvol"          name="snvolu" />
+        <field field_ref="isnowhc"          name="snheco" />
+
+        <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        />
+        <field field_ref="icevolu"          name="sivolu" />
+        <field field_ref="iceconc"          name="siconc"  />
+        <field field_ref="micesalt"         name="sisali" />
+        <field field_ref="micet"            name="sitemp" />
+        <field field_ref="icest"            name="sistem" />
+        <field field_ref="icehc"            name="siheco" />
+        <field field_ref="uice_ipa"         name="sivelu" />
+        <field field_ref="vice_ipa"         name="sivelv" />
+        <field field_ref="icevel"           name="sivelo" />
+        <field field_ref="idive"            name="sidive" />
+        <field field_ref="ishear"           name="sishea" />
+        <field field_ref="icestr"           name="sistre" />
+        <!-- categories -->
+        <field field_ref="snowthic_cat"     name="snthicat"/>
+        <field field_ref="iceconc_cat"      name="siconcat"/>
+        <field field_ref="icethic_cat"      name="sithicat"/>
+        <field field_ref="salinity_cat"     name="salincat"/>
+        <field field_ref="iceage_cat"       name="siagecat"/>
+        <field field_ref="brinevol_cat"     name="sibricat"/>
+        <field field_ref="icetemp_cat"      name="sitemcat"/>
+        <field field_ref="snwtemp_cat"      name="sntemcat"/>
+
+        </file>
+
+      </file_group>
+
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->        
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   	
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/file_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/file_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/file_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,33 @@
+<?xml version="1.0"?>
+
+<!--
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own filesfor ocean dynamics context                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+   
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,33 @@
+<?xml version="1.0"?>
+<simulation> 
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+	  <!--
+          <variable id="optimal_buffer_size"       type="string">memory</variable>
+          <variable id="buffer_size_factor"        type="double">1.0</variable>
+	  -->
+	  <variable id="info_level"                type="int">10</variable>
+	  <variable id="using_server"              type="bool">true</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+  <context id="1_nemo" src="./1_context_nemo.xml"/>
+<!--
+  <context id="2_nemo" src="./2_context_nemo.xml"/>  
+-->
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/make_INITICE.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/make_INITICE.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/make_INITICE.py	(revision 8732)
@@ -0,0 +1,155 @@
+#!/usr/bin/python
+
+import os,sys
+from netCDF4 import Dataset as netcdf
+import numpy as np
+import matplotlib.pyplot as plt
+from math import exp
+from math import ceil
+
+resname=''
+
+# input file
+fcoord='mesh_mask.nc'
+
+# output file
+fflx='initice.nc'
+
+print '   creating init ice file  ' +fflx
+
+# Reading coordinates file
+nccoord=netcdf(fcoord,'r')
+nav_lon=nccoord.variables['nav_lon']
+nav_lat=nccoord.variables['nav_lat']
+time_counter=1
+LON1= nav_lon.shape[1]
+LAT1= nav_lon.shape[0]
+print 'nav_lon.shape[1]' ,nav_lon.shape[1]
+print 'LON1 ', LON1
+print 'LAT1 ', LAT1
+
+# Creating INITICE netcdf file
+nc=netcdf(fflx,'w')
+nc.createDimension('y',LAT1)
+nc.createDimension('x',LON1)
+nc.createDimension('time_counter',None)    # Setting dimension size to 0 or None makes it unlimited. 
+
+cdflon=nc.createVariable('nav_lon','f',('y','x'))
+cdflat=nc.createVariable('nav_lat','f',('y','x'))
+cdftimecounter=nc.createVariable('time_counter','f',('time_counter'))
+
+# ati : Fraction of open waters in sea ice - units %
+# hti : Sea ice thickness - units m
+# hts : Snow thickness - units m
+# smi : Sea ice salinity:
+# tmi : Sea ice internal temperature - units K
+# tsu : Sea ice surface temperature - units K
+#
+# Take constant values from namelist &namiceini of NEMO
+rn_hti_ini=2.0
+rn_hts_ini=0.2            #  initial real snow thickness (m)
+rn_ati_ini=0.9            #  initial ice concentration   (-)
+rn_smi_ini=6.3            #  initial ice salinity     (g/kg)
+rn_tmi_ini=270.           #  initial ice/snw temperature (K)
+rn_tsu_ini=270.           #  initial sea ice temperature (K)
+#
+cdfati=nc.createVariable('ati','f',('time_counter','y','x'))
+cdfati.units='Percentage'
+cdfati.long_name='Sea ice concentration'
+cdfhti=nc.createVariable('hti','f',('time_counter','y','x'))
+cdfhti.long_name='Sea ice thickness'
+cdfhti.units='m'
+cdfhts=nc.createVariable('hts','f',('time_counter','y','x'))
+cdfhts.long_name='Snow thickness'
+cdfhts.units='m'
+cdfsmi=nc.createVariable('smi','f',('time_counter','y','x'))
+cdfsmi.long_name='Sea ice salinity'
+cdfsmi.units='pss'
+cdftmi=nc.createVariable('tmi','f',('time_counter','y','x'))
+cdftmi.long_name='Sea ice internal temperature'
+cdftmi.units='Kelvin'
+cdftsu=nc.createVariable('tsu','f',('time_counter','y','x'))
+cdftsu.long_name='Sea ice surface temperature'
+cdftsu.units='Kelvin'
+
+cdflon[:,:]=nav_lon[:,:]
+cdflat[:,:]=nav_lat[:,:]
+cdftimecounter[0]=1
+
+# Fill fields
+#print 'cdfati[:,1]', cdfati[:,1]  -> 32 values
+
+# Add a gaussian for sea ice thickness here
+cdfhti[:,:,:]=0.
+cdfhts[:,:,:]=0.
+cdfati[:,:,:]=0.
+cdfsmi[:,:,:]=0.
+cdftmi[:,:,:]=rn_tmi_ini
+cdftsu[:,:,:]=rn_tsu_ini
+
+# --------------------------------------
+# for basin=99x99km with dx=1km ; dy=3km
+#sigx=-0.04
+#sigy=-0.04*9.
+#xshift=50.-1.
+#yshift=17.-1.
+#dlat=7
+#dlon=21
+
+# --------------------------------------
+# for basin=99x99km with dx=1km ; dy=1km
+#sigx=-0.04
+#sigy=-0.04
+#xshift=50.-1.
+#yshift=50.-1.
+#dlat=21
+#dlon=21
+
+# --- gaussian and square experiment ---
+#for y in np.arange(dlat,LAT1-dlat,1) :
+#    for x in np.arange(dlon,LON1-dlon,1) :
+#        cdfhti[:,y,x] = rn_hti_ini*exp(sigx*(x-xshift)**2)*exp(sigy*(y-yshift)**2)
+#        cdfhts[:,y,x] = rn_hts_ini*exp(sigx*(x-xshift)**2)*exp(sigy*(y-yshift)**2)
+#        cdfati[:,y,x] = rn_ati_ini
+#        cdfsmi[:,y,x] = rn_smi_ini
+#
+# --- Lipscomb 2004 experiment ---
+#cdfhti[:,:,:]=1.
+#cdfati[:,:,:]=0.1
+#for y in np.arange(0,LAT1,1) :
+#    for x in np.arange(0,LON1,1) :
+#        if (x > ceil(0.5*xshift) and x < xshift): # and (y > ceil(0.5*yshift) and y < yshift):
+#            cdfati[:,y,x] = rn_ati_ini / (ceil(0.5*xshift)*ceil(0.5*yshift)) * (x - ceil(0.5*xshift)) * (y - ceil(0.5*yshift))
+#            cdfsmi[:,y,x] = rn_smi_ini / (ceil(0.5*xshift)*ceil(0.5*yshift)) * (x - ceil(0.5*xshift)) * (y - ceil(0.5*yshift))
+#            cdfhti[:,y,x] = rn_hti_ini
+#            cdfhts[:,y,x] = rn_hts_ini
+#        if (x >= 25. and x < 50.):
+#            cdfati[:,y,x] = 0.9 * (x - 25.) / 25.
+#            cdfhti[:,y,x] = 1.
+#        elif (x >= 50. and x <= 75.):
+#            cdfati[:,y,x] = 0.9
+#            cdfhti[:,y,x] = 1.
+#        if (x > 30. and x < 70.):
+#            cdfhti[:,y,x] = 0.2
+            
+            
+# ----------------------------------------------
+# for basin=99x99km with dx=1km ; dy=1km + AGRIF
+sigx=-0.04
+sigy=-0.04
+xshift=20.-1.
+yshift=50.-1.
+dlat=18
+dlon=18
+for y in np.arange(32,66,1) :
+    for x in np.arange(2,36,1) :
+        cdfhti[:,y,x] = rn_hti_ini*exp(sigx*(x-xshift)**2)*exp(sigy*(y-yshift)**2)
+        cdfhts[:,y,x] = rn_hts_ini*exp(sigx*(x-xshift)**2)*exp(sigy*(y-yshift)**2)
+        cdfati[:,y,x] = rn_ati_ini   
+        cdfsmi[:,y,x] = rn_smi_ini
+# ------------------------------------------------
+
+nc.close()
+nccoord.close()
+
+#sys.exit()
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,250 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namusr_def    !   SAS_BIPER user defined namelist
+!-----------------------------------------------------------------------
+   rn_dx       =    3000.   ! horizontal resolution in meters
+   rn_dy       =    3000.   ! horizontal resolution in meters
+/
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0      !  job number (no more used...)
+   cn_exp      =  "SASBIPER"  !  experience name
+   nn_it000    =       1      !  first time step
+   nn_itend    =    10100     !  last  time step (std 5475)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.    !  (=T) read the domain configuration file
+      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+      cn_domcfg = "SASBIPER_domcfg"    ! domain configuration filename
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   !
+   rn_rdt      = 1200.     !  time step for the dynamics (and tracer if nn_acc=0)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   ln_usr      = .true.   !  user defined formulation                  (T => check usrdef_sbc)
+   ln_blk      = .false.  !  Bulk formulation                          (T => fill namsbc_blk )
+   nn_fsbc     =  1       !  frequency of surface boundary condition computation
+/
+!-----------------------------------------------------------------------
+&namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk = T)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_sas    !   Stand Alone Surface boundary condition
+!-----------------------------------------------------------------------
+   l_sasread   = .false.   ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE.
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  4               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.   !  z-coordinate - full steps
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg	(revision 8732)
@@ -0,0 +1,86 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! LIM3 namelist:  
+!!              1 - Generic parameters                 (namicerun)
+!!              2 - Diagnostics                        (namicediag)
+!!              3 - Ice initialization                 (namiceini)
+!!              4 - Ice discretization                 (namiceitd)
+!!              5 - Ice dynamics and transport         (namicedyn)
+!!              6 - Ice diffusion                      (namicehdf)
+!!              7 - Ice thermodynamics                 (namicethd)
+!!              8 - Ice salinity                       (namicesal)
+!!              9 - Ice mechanical redistribution      (namiceitdme)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!------------------------------------------------------------------------------
+&namicerun     !   Generic parameters
+!------------------------------------------------------------------------------
+   jpl              =    1          !  number of ice  categories
+   nlay_i           =    1          !  number of ice  layers
+   ln_limthd        =  .false.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   nn_limdyn        =   0           !     (ln_limdyn=T) switch for ice dynamics
+                                    !      2: total
+                                    !      1: advection only (no diffusion, no ridging/rafting)
+                                    !      0: advection only (as 1 but with prescribed velocity, bypass rheology)
+   rn_uice          =   0.5    !     (nn_limdyn=0) ice u-velocity
+   rn_vice          =   0.0    !     (nn_limdyn=0) ice v-velocity
+/
+!------------------------------------------------------------------------------
+&namicediag    !   Diagnostics
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceini     !   Ice initialization
+!------------------------------------------------------------------------------
+                  ! -- limistate -- !
+   ln_limini      = .true.         !  activate ice initialization (T) or not (F)
+   ln_limini_file = .true.         !  netcdf file provided for initialization (T) or not (F)
+   cn_dir="./"
+   sn_hti = 'initice'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_hts = 'initice'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_ati = 'initice'    , -12 ,'ati'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_tsu = 'initice'    , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_tmi = 'initice'    , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+   sn_smi = 'initice'    , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', ''
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicedyn     !   Ice dynamics and transport
+!------------------------------------------------------------------------------
+                  ! -- limtrp & limadv -- !
+   nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
+   nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0)
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicethd     !   Ice thermodynamics
+!------------------------------------------------------------------------------
+                  ! -- limthd_dh -- !
+   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+                  ! -- limthd_da -- !
+   ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+                 ! -- limthd_lac -- !
+   ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   rn_hnewice     = 0.02            !  thickness for new ice formation in open water (m)
+                  ! -- limitd_th -- !
+   rn_himin       = 0.01            !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
+/
+!------------------------------------------------------------------------------
+&namicesal     !   Ice salinity
+!------------------------------------------------------------------------------
+                 ! -- limthd_sal -- !
+   ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+/
+!------------------------------------------------------------------------------
+&namiceitdme   !   Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+                  ! -- limitd_me -- !
+   ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/namelist_ice_lim3_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_hgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_hgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_hgr.F90	(revision 8732)
@@ -0,0 +1,159 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_hgr  ***
+   !!
+   !!                     ===  SAS_BIPER configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  NEMO  ! 2016-08  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr    : initialize the horizontal mesh for SAS_BIPER configuration
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE par_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE usrdef_nam, ONLY: rn_dx, rn_dy   ! horizontal resolution in meters
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called by domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!                SAS_BIPER configuration : uniform grid spacing (rn_dx)
+      !!                without Coriolis force (f=0)
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zphi0, zlam0
+      REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      -
+      !!-------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('usr_def_hgr')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : SAS_BIPER configuration bassin'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          f-plane with irregular grid-spacing (+- 10%)'
+      IF(lwp) WRITE(numout,*) '          the max is given by rn_dx and rn_dy' 
+
+      !                          ==========
+      zlam0 = 0._wp
+      zphi0 = 0._wp
+         
+#if defined key_agrif 
+      IF( .NOT. Agrif_Root() ) THEN
+         zlam0  = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5
+         zphi0  = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5
+         rn_dx = Agrif_Parent(rn_dx)/Agrif_Rhox()
+         rn_dy = Agrif_Parent(rn_dy)/Agrif_Rhoy()          
+      ENDIF
+#endif         
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 )
+            zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 )
+            zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+            zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+
+            plamt(ji,jj) = zlam0 + rn_dx * 1.e-5 * zti
+            plamu(ji,jj) = zlam0 + rn_dx * 1.e-5 * zui
+            plamv(ji,jj) = zlam0 + rn_dx * 1.e-5 * zvi
+            plamf(ji,jj) = zlam0 + rn_dx * 1.e-5 * zfi
+   
+            pphit(ji,jj) = zphi0 + rn_dy * 1.e-5 * ztj
+            pphiu(ji,jj) = zphi0 + rn_dy * 1.e-5 * zuj
+            pphiv(ji,jj) = zphi0 + rn_dy * 1.e-5 * zvj
+            pphif(ji,jj) = zphi0 + rn_dy * 1.e-5 * zfj
+         END DO
+      END DO
+         
+         ! Horizontal scale factors (in meters)
+         !                              ======
+!! ==> EITHER 1) variable scale factors
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 )  ! gaussian shape
+               !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 )  ! gaussian shape
+               pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+               pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+            END DO
+         END DO
+#if defined key_agrif 
+         IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5)  &
+                     &                            * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) )       ! factor to match parent grid
+                  pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5)  &
+                     &                            * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) )       ! factor to match parent grid
+               END DO
+            END DO
+         ENDIF
+#endif
+!! ==> OR 2) constant scale factors
+!!         pe1t(:,:) = rn_dx
+!!         pe2t(:,:) = rn_dy
+         
+         pe1u(:,:) = pe1t(:,:)      ;      pe2u(:,:) = pe2t(:,:)
+         pe1v(:,:) = pe1t(:,:)      ;      pe2v(:,:) = pe2t(:,:)
+         pe1f(:,:) = pe1t(:,:)      ;      pe2f(:,:) = pe2t(:,:)
+
+      !                             ! NO reduction of grid size in some straits 
+      ke1e2u_v = 0                  !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp           !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp           !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 1                       !  indicate not to compute Coriolis parameter afterward
+      !
+      pff_f(:,:) = 0._wp            ! here No earth rotation: f=0
+      pff_t(:,:) = 0._wp
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('usr_def_hgr')
+      !
+      END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_nam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_nam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_nam.F90	(revision 8732)
@@ -0,0 +1,106 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_nam  ***
+   !!
+   !!                     ===  SAS_BIPER configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain
+   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called by nemogcm.F90
+
+   !                              !!* namusr_def namelist *!!
+   REAL(wp), PUBLIC ::   rn_dx     ! resolution in meters defining the horizontal domain size
+   REAL(wp), PUBLIC ::   rn_dy     ! resolution in meters defining the horizontal domain size
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here SAS_BIPER configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   ios, ii   ! Local integer
+      !!
+      NAMELIST/namusr_def/ ln_zco, rn_dx, rn_dy
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      !
+      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. )
+      !
+      WRITE( ldnam(:), namusr_def )
+      !
+      cd_cfg = 'SAS_BIPER'           ! name & resolution (not used)
+      kk_cfg = INT( rn_dx )
+      !
+      ! Global Domain size:  SAS_BIPER domain is  300 km x 300 Km x 2000 m
+      kpi = INT( 300.e3 / rn_dx ) -1
+      kpj = INT( 300.e3 / rn_dy ) -1
+      kpk = 1
+      !
+      !                             ! control print
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                 ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist namusr_def : SAS_BIPER test case'                                 ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      type of vertical coordinate : '                                         ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         z-coordinate flag                     ln_zco = ', ln_zco             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         z-partial-step coordinate flag        ln_zps = ', ln_zps             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         s-coordinate flag                     ln_sco = ', ln_sco             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      horizontal resolution                    rn_dx  = ', rn_dx, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      horizontal resolution                    rn_dy  = ', rn_dy, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      SAS_BIPER domain = 300 km x 300Km x 1 grid-point '                      ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         resulting global domain size :        jpiglo = ', kpi                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpjglo = ', kpj                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpkglo = ', kpk                ;   ii = ii + 1
+      !
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 7                    ! SAS_BIPER configuration : bi-periodic basin
+      !
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Lateral boundary condition of the global domain'                           ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      SAS_BIPER : bi-periodic basin            jperio = ', kperio             ;   ii = ii + 1
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90	(revision 8732)
@@ -0,0 +1,148 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_sbc  ***
+   !! 
+   !!                     ===  SAS_BIPER configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_sbc    : user defined surface bounday conditions in SAS_BIPER case
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE phycst          ! physical constants
+   USE ice, ONLY       : pfrld, a_i_b
+   USE limthd_dh       ! for CALL lim_thd_snwblow
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
+   USE wrk_nemo
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce      ! routine called by sbcmod.F90 for sbc ocean
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usr_def_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   all 0 fields, for SAS_BIPER case
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         !
+         IF(lwp)   WRITE(numout,*)' usrdef_sbc_oce : SAS_BIPER case: NO surface forcing'
+         ! --- oce variables --- !
+         utau(:,:) = 0._wp
+         vtau(:,:) = 0._wp
+         taum(:,:) = 0._wp
+         wndm(:,:) = 0._wp
+         !
+         emp (:,:) = 0._wp
+         sfx (:,:) = 0._wp
+         qns (:,:) = 0._wp
+         qsr (:,:) = 0._wp
+         !
+      ENDIF
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE usrdef_sbc_ice_tau  ***
+      !!
+      !! ** Purpose :   provide the surface boundary (momentum) condition over sea-ice
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: NO stress forcing'
+      !
+      utau_ice(:,:) = 0._wp
+      vtau_ice(:,:) = 0._wp
+      !
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE usrdef_sbc_ice_flx  ***
+      !!
+      !! ** Purpose :   provide the surface boundary (flux) condition over sea-ice
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), POINTER ::   zsnw       ! snw distribution after wind blowing
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      CALL wrk_alloc( jpi,jpj, zsnw )
+      !
+      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: NO flux forcing'
+      !
+      ! ocean variables (renaming)
+      emp_oce (:,:)   = 0._wp   ! uniform value for freshwater budget (E-P)
+      qsr_oce (:,:)   = 0._wp   ! uniform value for     solar radiation
+      qns_oce (:,:)   = 0._wp   ! uniform value for non-solar radiation
+
+      ! ice variables
+      alb_ice (:,:,:) = 0.7_wp  ! useless
+      qsr_ice (:,:,:) = 0._wp   ! uniform value for     solar radiation
+      qns_ice (:,:,:) = 0._wp   ! uniform value for non-solar radiation
+      sprecip (:,:)   = 0._wp   ! uniform value for snow precip
+      evap_ice(:,:,:) = 0._wp   ! uniform value for sublimation
+
+      ! ice fields deduced from above
+      zsnw(:,:) = 1._wp
+      !!CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
+      emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
+      emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
+      qevap_ice(:,:,:) =   0._wp
+      qprec_ice(:,:)   =   rhosn * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) !  in J/m3
+      qemp_oce (:,:)   = - emp_oce(:,:) * sst_m(:,:) * rcp
+      qemp_ice (:,:)   =   sprecip(:,:) * zsnw * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! solid precip (only)
+
+      ! total fluxes
+      emp_tot (:,:) = emp_ice  + emp_oce
+      qns_tot (:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot (:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+
+      !--------------------------------------------------------------------
+      ! FRACTIONs of net shortwave radiation which is not absorbed in the
+      ! thin surface layer and penetrates inside the ice cover
+      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
+      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+
+      CALL wrk_dealloc( jpi,jpj, zsnw )
+
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_zgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_zgr.F90	(revision 8732)
@@ -0,0 +1,115 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                   ***  MODULE  usrdef_zgr  ***
+   !!
+   !!                   ===  LOCK_EXCHANGE case  ===
+   !!
+   !! Ocean domain : user defined vertical coordinate system 
+   !!======================================================================
+   !! History :  4.0  ! 2016-08  (G. Madec, S. Flavoni)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system (required)
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco   ! ocean space and time domain
+   USE usrdef_nam     ! User defined : namelist variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_zgr   ! called by domzgr.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
+      &                    k_top  , k_bot    )                             ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   jk, k_dz  ! dummy indices
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : LOCK_EXCHANGE configuration (z-coordinate closed box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ! set in usrdef_nam.F90 by reading the namusr_def namelist only ln_zco
+      ln_zco    = .TRUE.       ! z-partial-step coordinate
+      ln_zps    = .FALSE.      ! z-partial-step coordinate
+      ln_sco    = .FALSE.      ! s-coordinate
+      ld_isfcav = .FALSE.      ! ISF Ice Shelves Flag
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      !
+      !                       !==  UNmasked meter bathymetry  ==!
+      !
+      ! 
+      k_dz = 1
+      DO jk = 1, jpk
+         pdepw_1d(jk) =    k_dz
+         pdept_1d(jk) =    k_dz
+         pe3w_1d (jk) =    k_dz
+         pe3t_1d (jk) =    k_dz
+      END DO
+      !                       !==  top masked level bathymetry  ==!  (all coordinates)
+      !
+      ! no ocean cavities : top ocean level is ONE, except over land
+      k_top(:,:) = 1
+      !
+      !                       !==  z-coordinate  ==!   (step-like topography)
+      !                                !* bottom ocean compute from the depth of grid-points
+      jpkm1 = jpk
+      k_bot(:,:) = 1    ! here use k_top as a land mask
+      !                                !* horizontally uniform coordinate (reference z-co everywhere)
+      DO jk = 1, jpk
+         pdept(:,:,jk) = pdept_1d(jk)
+         pdepw(:,:,jk) = pdepw_1d(jk)
+         pe3t (:,:,jk) = pe3t_1d (jk)
+         pe3u (:,:,jk) = pe3t_1d (jk)
+         pe3v (:,:,jk) = pe3t_1d (jk)
+         pe3f (:,:,jk) = pe3t_1d (jk)
+         pe3w (:,:,jk) = pe3w_1d (jk)
+         pe3uw(:,:,jk) = pe3w_1d (jk)
+         pe3vw(:,:,jk) = pe3w_1d (jk)
+      END DO
+      !
+   END SUBROUTINE usr_def_zgr
+
+   !!======================================================================
+END MODULE usrdef_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/cpp_SAS_BIPER.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/cpp_SAS_BIPER.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/cpp_SAS_BIPER.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_agrif key_lim3 key_mpp_mpi key_nosignedzero key_iomput
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/README.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/README.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/README.py	(revision 8732)
@@ -0,0 +1,5 @@
+ncks -O -d y,17,17,1 WAD_1ts_00010101_00010101_grid_T.nc sshtime.nc
+ncks -4 -A -v gdepw_0,ht_wd -d y,17,17,1 -d z,10,10,1 -C mesh_mask.nc sshtime.nc
+
+python2.7 matpoly2.py sshtime.nc
+animate wadfr*.png
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/context_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/context_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/context_nemo.xml	(revision 8732)
@@ -0,0 +1,120 @@
+<!--
+ ============================================================================================== 
+    NEMO context
+============================================================================================== 
+-->
+<context id="nemo">
+<!-- $id$ -->
+<!-- Fields definition -->
+    <field_definition src="./field_def_nemo-opa.xml"/>   <!--  NEMO ocean dynamics                     -->
+
+<!-- Files definition -->
+    <file_definition src="./file_def_nemo-opa.xml"/>     <!--  NEMO ocean dynamics                     -->
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+</context>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/domain_def_nemo.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/domain_def_nemo.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/domain_def_nemo.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/domain_def_nemo.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/field_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/field_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/field_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/field_def_nemo-opa.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/file_def_nemo-opa.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/file_def_nemo-opa.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/file_def_nemo-opa.xml	(revision 8732)
@@ -0,0 +1,104 @@
+<?xml version="1.0"?>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."> <!-- 1 time step files -->
+	<file id="file96" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="ssh"          name="sossheig"  />
+          <field field_ref="sss"          name="sosaline"  />
+	  <!--
+	  <field field_ref="wdmask"       name="wdmask"  />
+	  <field field_ref="wetdep"       name="wetdepth"  />
+          <field field_ref="toce"         name="votemper"  />
+          <field field_ref="soce"         name="vosaline"  />
+          -->
+        </file>
+	<file id="file87" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <!--
+          <field field_ref="un_b"         name="un_b"    operation="instant"/>
+          <field field_ref="uoce"         name="vozocrtx" operation="instant"  />
+          -->
+          <field field_ref="ubar"         name="ubaro"    operation="instant"/>
+	  <!--
+          <field field_ref="un_b"         name="un_b"    operation="instant"/>
+          <field field_ref="ucli"         name="uc_un" operation="instant"  />
+          <field field_ref="ucli2"         name="uc_un2" operation="instant"  />
+          <field field_ref="ssu"         name="r1_hu_a" operation="instant"  />
+          <field field_ref="wdlmtu"         name="wdlmtu" operation="instant"  />
+          -->
+        </file>
+	<file id="file88" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="vbar"         name="vbaro"    operation="instant"/>
+        </file>
+      </file_group>
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."> <!-- 1h files -->
+	<file id="file97" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="ssh"          name="sossheig"  operation="instant"  />
+	  <field field_ref="e3t"          name="e3t"  operation="instant"  />
+          <field field_ref="toce"         name="votemper"  />
+      </file>
+      <file id="file98" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="ubar"         name="ubaro"    operation="instant"/>
+      </file>
+      </file_group>
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->  
+ 
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="votemper"  />
+	  <field field_ref="soce"         name="vosaline"  />
+	  <field field_ref="sst"          name="sosstsst"  />
+	  <field field_ref="sss"          name="sosaline"  />
+	  <field field_ref="ssh"          name="sossheig"  />
+	  <field field_ref="empmr"        name="sowaflup"  />
+	  <field field_ref="qsr"          name="soshfldo"  />
+      <field field_ref="saltflx"      name="sosfldow"  />
+	  <field field_ref="qt"           name="sohefldo"  />
+	  <field field_ref="mldr10_1"     name="somxl010"  />
+	  <field field_ref="mldkz5"       name="somixhgt"  />
+    </file>
+	
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+          <field field_ref="uoce"         name="vozocrtx"  />
+          <field field_ref="utau"         name="sozotaux"  />
+    </file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+          <field field_ref="voce"         name="vomecrty"  /> 
+          <field field_ref="vtau"         name="sometauy"  /> 
+    </file>
+	
+	<file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >
+          <field field_ref="woce"         name="vovecrtz" />
+          <field field_ref="avt"          name="votkeavt" />
+          <field field_ref="aht2d"        name="soleahtw" />
+    </file>
+
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/iodef.xml	(revision 8732)
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<simulation>
+
+<!-- ============================================================================================ -->
+<!-- XIOS context                                                                                 -->
+<!-- ============================================================================================ -->
+
+  <context id="xios" >
+
+      <variable_definition>
+
+          <variable id="info_level"                type="int">10</variable>
+          <variable id="using_server"              type="bool">true</variable>
+          <variable id="using_oasis"               type="bool">false</variable>
+          <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+
+      </variable_definition>
+  </context>
+
+<!-- ============================================================================================ -->
+<!-- NEMO  CONTEXT add and suppress the components you need                                       -->
+<!-- ============================================================================================ -->
+
+  <context id="nemo" src="./context_nemo.xml"/>       <!--  NEMO       -->
+
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/makebdy_tc7.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/makebdy_tc7.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/makebdy_tc7.py	(revision 8732)
@@ -0,0 +1,80 @@
+from netCDF4 import Dataset
+import numpy as np
+
+pathout = "bdyssh_tc7"
+
+nx = 34 
+ny = 1
+nt = 24
+ndays=4
+
+#-------------------------------------------------------
+# Create bdyssh_tc7_m01d01.nc, bdyssh_tc7_m01d02.nc etc.
+#-------------------------------------------------------
+
+pathstart="{}_m12d30.nc".format(pathout)
+for nd in range(ndays):
+ print pathstart
+ ssh = np.zeros((nt,ny,nx))
+ for nnt in range(nd*nt,(nd+1)*nt):
+   tx = 2.5*np.cos((3.141592654/6.0)*(nnt+1.0))
+   print nnt, tx
+   for nnx in range(nx):
+     for nny in range(ny):
+       ssh[nnt-nd*nt,nny,nnx] = tx
+
+
+ fo = Dataset(pathstart, 'w', format='NETCDF4')
+ nxo = fo.createDimension('x', nx)
+ nyo = fo.createDimension('y', ny)
+ nto = fo.createDimension('t', None)
+ ssho = fo.createVariable('sshbdy', 'f4',('t','y','x'))
+
+ ssho[:,:,:] = ssh[:,:,:]
+ ssho.long_name = 'bdy ssh boundary condition'
+ ssho.standard_name = 'sshbdy'
+ ssho.units = 'm'
+#
+ fo.close()
+ pathstart="{}_m01d{:0>2d}.nc".format(pathout,nd+1)
+
+#-------------------------------------------------------
+# Create bdyuv_tc7_m01d01.nc, bdyuv_tc7_m01d02.nc etc.
+# u is -(1/H)*d(ssh)/dt; v =0.0
+#-------------------------------------------------------
+
+pathout = "bdyuv_tc7"
+
+
+pathstart="{}_m12d30.nc".format(pathout)
+for nd in range(ndays):
+ print pathstart
+ u = np.zeros((nt,ny,nx))
+ for nnt in range(nd*nt,(nd+1)*nt):
+  tx = 2.5*(3.141592654/6.0)*np.sin((3.141592654/6.0)*(nnt+1.0))/10.0
+  print nnt, tx
+  for nnx in range(nx):
+    for nny in range(ny):
+       u[nnt-nd*nt,nny,nnx] = tx
+
+ v = np.zeros((nt,ny,nx))
+
+ fo = Dataset(pathstart, 'w', format='NETCDF4')
+ nxo = fo.createDimension('x', nx)
+ nyo = fo.createDimension('y', ny)
+ nto = fo.createDimension('t', None)
+ uo = fo.createVariable('ubdy', 'f4',('t','y','x'))
+ vo = fo.createVariable('vbdy', 'f4',('t','y','x'))
+
+ uo[:,:,:] = u[:,:,:]
+ uo.long_name = 'bdy u boundary condition'
+ uo.standard_name = 'ubdy'
+ uo.units = 'm/s'
+#
+ vo[:,:,:] = v[:,:,:]
+ vo.long_name = 'bdy v boundary condition'
+ vo.standard_name = 'vbdy'
+ vo.units = 'm/s'
+#
+ fo.close()
+ pathstart="{}_m01d{:0>2d}.nc".format(pathout,nd+1)
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg	(revision 8732)
@@ -0,0 +1,451 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   rn_dx = 1000.0
+   rn_dz = 1.0
+   nn_wad_test = 1
+/
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "WAD"    !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =      3840  !  last  time step
+   !nn_itend    =         6  !  last  time step
+   nn_leapy    =      30   !  Leap year calendar (1) or not (0)
+   nn_stock    =    48000  !  frequency of creation of a restart file (modulo referenced to 1)
+
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration
+!-----------------------------------------------------------------------
+   ln_read_cfg = .false.   !  (=T) read the domain configuration file
+      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules
+   ln_write_cfg= .true.    !  (=T) create the domain configuration file
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .false.   !  z-coordinate - partial steps
+   ln_sco      = .true.    !  s-coordinate
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time
+   !
+   nn_msh      =    1      !  create (>0) a mesh file or not (=0)
+   rn_rdt      =    18.    !  time step for the dynamics 
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   cn_dir        = './'      !  root directory for the location of the runoff files
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+   !                       !     (also = the frequency of sea-ice model call)
+   ln_usr      = .true.    !  analytical formulation                    (T => fill namsbc_ana )
+   ln_blk      = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.0e0   !  uniform value for the i-stress
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+!-----------------------------------------------------------------------
+    ln_bdy         = .false.            
+    nb_bdy         = 0                    !  number of open boundary sets
+    ln_coords_file = .false.              !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file   = .false.              !  =T : read mask from file
+    cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.)
+    cn_dyn2d       = 'flather'            !
+    nn_dyn2d_dta   =  1                   !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    cn_dyn3d      =  'none'               !
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_tra        =  'frs'                !
+    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_ice_lim      =  'none'             !
+    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice
+    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           --
+    rn_ice_age      = 30.                 !  lim3 only:      --   age                --
+
+    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers
+    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities
+    rn_time_dmp   =  1.                   ! Damping time scale in days
+    rn_time_dmp_out =  1.                 ! Outflow damping time scale
+    nn_rimwidth   = 10                    !  width of the relaxation zone
+    ln_vol        = .false.               !  total volume correction (see nn_volctl parameter)
+    nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_index
+!-----------------------------------------------------------------------
+    ctypebdy = 'E'
+    nbdyind  = 50
+    nbdybeg  = 1
+    nbdyend  = 34
+    !ctypebdy = 'W'
+    !nbdyind  = 2
+    !nbdybeg  = 1
+    !nbdyend  = 34
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)   !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh =     'bdyssh_tc7' ,         1        , 'sshbdy',     .true.     , .true.  ,  'daily'  ,    ''    ,   ''     , ''
+   bn_u2d =     'bdyuv_tc7'  ,         1        , 'ubdy'  ,     .true.     , .true.  ,  'daily'  ,    ''    ,   ''     , ''
+   bn_v2d =     'bdyuv_tc7'  ,         1        , 'vbdy'  ,     .true.     , .true.  ,  'daily'  ,    ''    ,   ''     , ''
+   cn_dir      =    './'   !  root directory for the location of the bulk files
+   ln_full_vel = .false.        !
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+   !rn_bfri2    =    1.e-5  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   !rn_bfri2_max =   1.e-4  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfri2    =    1.e-5  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max =   1.e-4  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   !rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   !rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   ln_loglayer = .true.    !  logarithmic formulation (non linear case)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .false.         !  = Use EOS80 equation of state
+   ln_seos     = .true.          !  = Use simplified equation of state (S-EOS)
+                                 !
+   !                     ! S-EOS coefficients (ln_seos=T):
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos)
+!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+!!org  caution  now a0 = alpha / rau0   with rau0 = 1026
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen =  .false.  !  2nd order centered scheme
+   ln_traadv_mus =  .false.  !  MUSCL scheme
+   ln_traadv_fct =  .true.   !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral
+   ln_traldf_triad =  .false.  !  iso-neutral using Griffies triads
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML     (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom         (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 1000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.false.   ! use eddy induced velocity parameterization
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.    !  s-coordinate
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient 
+!-----------------------------------------------------------------------
+   ln_dynspg_ts  = .true.  !  split-explicit free surface
+   ln_bt_auto    = .false. ! Number of sub-step defined from:
+   nn_baro       =  12     ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      = 1000.        !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      =      0.     !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
+   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
+   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
+   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet)
+   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
+   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
+   ln_tra_trd  = .false.    ! (T) 3D tracer trend output
+   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
+   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
+/
+!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+!!gm
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 60       !  time step frequency for transports computing
+    nn_dctwri   = 60       !  time step frequency for transports writing
+    nn_secdebug = 0        !      0 : no section to debug
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   ln_wd             = .true.   ! T/F activation of wetting and drying
+   rn_wdmin1         =  0.3     ! Minimum wet depth on dried cells
+   rn_wdmin2         =  0.0001  ! Tolerance of min wet depth on dried cells
+   rn_wdld           =  2.5     ! Land elevation below which wetting/drying is allowed
+   nn_wdit           =   20     ! Max iterations for W/D limiter
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_ref	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../SHARED/namelist_ref
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/plotframes.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/plotframes.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/plotframes.py	(revision 8732)
@@ -0,0 +1,304 @@
+#!/usr/bin/env python
+################################################################################## 
+# Utility to produce animation frames directly from the WAD_TEST_CASE output.
+# It can be used without arguments, i.e.:
+#     python plotframes.py
+# in which case a frame is created every tenth time level from SSH data extracted from
+# WAD_1ts_00010101_00010101_grid_T.nc along the centre of the basin (j=17). A closed 
+# basin is assumed and frames are named wadfr0000.png etc. Bathymetry information is 
+# extracted from the mesh_mask.nc file. The frames are annotated with a timestamp that
+# assumes an 18s baroclinic timestep.
+# 
+# All these settings can be overridden with command-line arguments. See:
+#     python plotframes.py -h 
+# for details. For example:
+#     python plotframes.py  -nt 300 -stride 30 -froot mywad
+# 
+# Two major variations are also supported for specific test cases:
+#     python plotframes.py -obc
+# plots the right-hand side of the basin as an open boundary (test case 7) and:
+#     python plotframes.py -use_sal
+# colours each gridcell according to its salinity value (test case 6)
+################################################################################## 
+import os, sys
+from argparse import ArgumentParser
+import numpy as np
+import netCDF4
+
+import matplotlib.pyplot as plt
+import matplotlib
+from matplotlib.patches import Polygon
+from matplotlib.collections import PatchCollection
+from netCDF4 import Dataset
+
+#
+# Turn off the unhelpful warning about open figures
+#
+matplotlib.rcParams['figure.max_open_warning'] = 0
+
+if __name__ == '__main__':
+    parser = ArgumentParser(description=
+    """
+    produce frames for the animation of results from the WAD_TEST_CASES.
+    Mostly this can be run without arguments but command line arguments may be
+    used to override defaults. These are necessary in cases with open boundaries
+    (e.g. nn_wad_test=7) and cases where it is desired to show variations in salinity
+    (e.g. nn_wad_test=6).
+     e.g. plotframes.py -tfile <T-grid file> -bfile  <bathymetry file>
+    -froot <root name for frames>
+    -nt <maximum number of time frames to process>
+    -stride <stride through time frames> 
+    -rdt <length of baroclinic timestep (s)> 
+    -obc
+    -use_sal
+    """)
+    parser.add_argument('-tfile',dest='tfile',help='T-grid file if not WAD_1ts_00010101_00010101_grid_T.nc', default='WAD_1ts_00010101_00010101_grid_T.nc')
+    parser.add_argument('-bfile',dest='bfile',help='Bathymetry file if not mesh_mask.nc', default='mesh_mask.nc')
+    parser.add_argument('-j',dest='jrow',help='jrow; j-row to extract and plot (default: 17 (fortran index))', type=int, default=16)
+    parser.add_argument('-froot',dest='froot',help='froot; root name for frames (default: wadfr)', default='wadfr')
+    parser.add_argument('-nt',dest='nfmax',help='nfmax; maximum number of frames to produce', type=int, default=None)
+    parser.add_argument('-stride',dest='tinc',help='tinc; stride through time frames (default: 10)', type=int, default=10)
+    parser.add_argument('-rdt',dest='rdt',help='rdt; length of baroclinic timestep (s) (default: 18.0)', type=float, default=18.0)
+    parser.add_argument('-obc',help='Right-hand side boundary is open', action="store_true")
+    parser.add_argument('-use_sal',help='colour polygons according to salinity variations', action="store_true")
+    args   = parser.parse_args()
+    tfile  = args.tfile
+    bfile  = args.bfile
+    jrow   = args.jrow
+    froot  = args.froot
+    nfmax  = args.nfmax
+    stride = args.tinc
+    rdt    = args.rdt
+    obc    = args.obc
+    use_sal= args.use_sal
+
+
+fw = Dataset(tfile)
+ssh = fw.variables['sossheig'][:,jrow,:]
+vot = fw.variables['sosaline'][:,jrow,:]
+if use_sal:
+ sal = fw.variables['vosaline'][:,:,jrow,:]
+ nz = sal.shape[1]
+fw.close()
+
+fw = Dataset(bfile)
+bat = fw.variables['ht_wd'][0,jrow,:]
+if use_sal:
+ mbat = fw.variables['mbathy'][0,jrow,:]
+fw.close()
+
+#print "ssh"
+#print ssh.shape
+#print "bat"
+#print bat.shape 
+#print "vot"
+#print vot.shape 
+nt = ssh.shape[0]
+nx = ssh.shape[1]
+#print nx,nt
+
+bat = -1.*bat
+batmin = np.amin(bat)
+batmax = np.amax(bat)
+brange = batmax - batmin
+tol = 0.1*brange
+#print batmin,batmax,' ho'
+if obc:
+ batrhs = batmin
+else:
+ batrhs = batmax
+
+if nfmax is None:
+  nfmax = nt
+
+nf = 0
+ntmax = np.minimum(nt,nfmax*stride)
+
+if not use_sal:
+#
+# plot solid single colour polygons just showing ssh variation
+#
+  for t in range(0,ntmax,stride):
+   wadfr = froot+"{:0>4d}.png".format(nf)
+   nf = nf + 1
+  
+   tfac = rdt/3600.0
+   t24  = np.int(np.mod(t*tfac,24))
+   dy   = np.int(t*tfac/24.0)
+   mn   = np.int(np.rint((np.mod(t*tfac,24) - t24 )*60))
+   hour  = "t={:0>2d}:{:0>2d}:{:0>2d} ".format(dy,t24,mn)
+   hour2  = "  (days:hrs:mins)"
+   batpts = np.zeros((nx+4,2))
+   sshpts = np.zeros((2*nx,2))
+   votpts = np.zeros((nx,2))
+  
+   for pt in range(nx):
+      batpts[pt+2,0] = pt
+      batpts[pt+2,1] = bat[pt]
+      sshpts[pt,0] = pt
+      sshpts[pt,1] = ssh[t,pt]
+      votpts[pt,0] = pt
+      votpts[pt,1] = np.minimum(36.,vot[t,pt])
+      votpts[pt,1] = np.maximum(30.0,votpts[pt,1])
+      votpts[pt,1] = batmin +0.2*brange + (votpts[pt,1]-30.)*brange/6.0
+  
+   batpts[nx+1,1] = batrhs
+   batpts[nx+2,0] = nx-1
+   batpts[nx+2,1] = batrhs
+   batpts[nx+3,0] = nx-1
+   batpts[nx+3,1] = batmin
+   batpts[0,0] = 0.0
+   batpts[0,1] = batmin
+   batpts[1,0] = 0.0
+   batpts[1,1] = batmax
+   batpts[2,1] = batmax
+   sshpts[nx-1,0] = nx-1
+   sshpts[nx-1,1] = sshpts[nx-2,1]
+   sshpts[0,0] = 0.0
+   votpts[nx-2,0] = nx-1
+   votpts[nx-1,0] = nx-1
+   votpts[0,0] = 0.0
+   votpts[nx-1,1] = batmax + tol
+   votpts[0,1] = batmax + tol
+   sshpts[0,1] = sshpts[1,1]
+   for pt in range(nx):
+      sshpts[pt+nx,0]=batpts[nx+1-pt,0]
+      sshpts[pt+nx,1]=batpts[nx+1-pt,1]
+   
+  
+   xs, ys = zip(*votpts)
+   fig, ax = plt.subplots()
+  
+   patches = []
+   polygon = Polygon(batpts, True)
+   patches.append(polygon)
+   p = PatchCollection(patches, cmap=matplotlib.cm.jet, alpha=1.0)
+   p.set_facecolors(['#f1a9a9'])
+  
+   patches = []
+   polygon2 = Polygon(sshpts, True)
+   patches.append(polygon2)
+   p2 = PatchCollection(patches, cmap=matplotlib.cm.jet, alpha=1.0)
+   p2.set_facecolors(['#44a1ff'])
+   
+# Maximum depth set here to -10m
+   ax.set_ylim([-10., 6.0])
+   ax.set_xlim([0., 51.0])
+   ax.add_collection(p2)
+   ax.add_collection(p)
+   ax.plot(xs,ys, '--', color='black', ms=10)
+  
+   plt.annotate(hour,xy=(2,batmin+0.1*brange))
+   plt.annotate(hour2,xy=(2,batmin+0.05*brange))
+   plt.savefig(wadfr)
+
+else:
+#
+# plot each gridcell coloured according to its salinity value
+#
+  for t in range(0,ntmax,stride):
+   wadfr = froot+"{:0>4d}.png".format(nf)
+   nf = nf + 1
+
+   tfac = rdt/3600.0
+   t24  = np.int(np.mod(t*tfac,24))
+   dy   = np.int(t*tfac/24.0)
+   mn   = np.int(np.rint((np.mod(t*tfac,24) - t24 )*60))
+   hour  = "t={:0>2d}:{:0>2d}:{:0>2d} ".format(dy,t24,mn)
+   hour2  = "  (days:hrs:mins)"
+   batpts = np.zeros((nx+4,2))
+   votpts = np.zeros((nx,2))
+   salpts = np.zeros((nx*nz,6,2))
+   salmin = 28.
+   salmax = 37.
+   salrange = salmax - salmin
+   faccol = np.zeros((nx*nz))
+   cl = 0
+   for pt in range(nx):
+      batpts[pt+2,0] = pt
+      batpts[pt+2,1] = bat[pt]
+      votpts[pt,0] = pt
+      votpts[pt,1] = np.minimum(35.,vot[t,pt])
+      votpts[pt,1] = np.maximum(30.0,votpts[pt,1])
+      votpts[pt,1] = batmin +0.2*brange + (votpts[pt,1]-30.)*brange/6.0
+   batpts[nx+1,1] = batmax
+   batpts[nx+2,0] = nx-1
+   batpts[nx+2,1] = batmax
+   batpts[nx+3,0] = nx-1
+   batpts[nx+3,1] = batmin
+   batpts[0,0] = 0.0
+   batpts[0,1] = batmin
+   batpts[1,0] = 0.0
+   batpts[1,1] = batmax
+   batpts[2,1] = batmax
+   votpts[nx-2,0] = nx-1
+   votpts[nx-1,0] = nx-1
+   votpts[0,0] = 0.0
+   votpts[nx-1,1] = batmax + tol
+   votpts[0,1] = batmax + tol
+  
+   cl = 0
+   for pt in range(nx):
+      mz = np.maximum(1,mbat[pt])
+      im1 = np.maximum(pt-1,1)
+      ip1 = np.minimum(pt+1,nx-1)
+      dz  = (ssh[t,pt] - batpts[pt+2,1] )/mz
+      dz1 = 0.5*(ssh[t,pt] + ssh[t,im1] - batpts[pt+2,1] - batpts[im1+2,1] )/mz
+      dz2 = 0.5*(ssh[t,pt] + ssh[t,ip1] - batpts[pt+2,1] - batpts[ip1+2,1] )/mz
+      dz  = np.maximum(dz ,0.0)
+      dz1 = np.maximum(dz1,0.0)
+      dz2 = np.maximum(dz2,0.0)
+      bat1 = 0.5*( batpts[pt+2,1] + batpts[im1+2,1] )
+      bat2 = 0.5*( batpts[pt+2,1] + batpts[ip1+2,1] )
+      ptm = np.maximum(pt-0.5,0.0)
+      ptx = np.minimum(pt+0.5,nx-1)
+      for z in range(mz):
+        if ( sal[t,mz-1-z,pt] > 0.0 ):
+          salpts[cl,0,0] = pt
+          salpts[cl,1,0] = ptm
+          salpts[cl,2,0] = ptm
+          salpts[cl,3,0] = pt
+          salpts[cl,4,0] = ptx
+          salpts[cl,5,0] = ptx
+          salpts[cl,0,1] = batpts[pt+2,1] +dz*z
+          salpts[cl,1,1] = bat1 +dz1*z
+          salpts[cl,2,1] = bat1 +dz1*(z+1)
+          salpts[cl,3,1] = batpts[pt+2,1] +dz*(z+1)
+          salpts[cl,4,1] = bat2 +dz2*(z+1)
+          salpts[cl,5,1] = bat2 +dz2*z
+          faccol[cl] = 100*(sal[t,mz-1-z,pt] - salmin) / salrange
+          faccol[cl] = np.maximum(faccol[cl],0.0)
+          faccol[cl] = np.minimum(faccol[cl],100.0)
+          cl = cl + 1
+   
+  
+   votpts2 = votpts[2:nx-4,:]
+   xs, ys = zip(*votpts2)
+   fig, ax = plt.subplots()
+   patches = []
+  
+   for pt in range(cl-1):
+      polygon = Polygon(salpts[pt,:,:], True)
+      patches.append(polygon)
+  
+   p = PatchCollection(patches, cmap=matplotlib.cm.jet, alpha=1.0)
+   
+   p.set_array(faccol)
+   p.set_edgecolor('face')
+  
+   patches = []
+   polygon = Polygon(batpts, True)
+   patches.append(polygon)
+   p2 = PatchCollection(patches, cmap=matplotlib.cm.jet, alpha=1.0)
+   p2.set_facecolors(['#f1a9a9'])
+  
+# Maximum depth set here to -8m (suitable for test case 6 only)
+   ax.set_ylim([-8., 6.0])
+   ax.set_xlim([0., 51.0])
+   ax.add_collection(p)
+   ax.add_collection(p2)
+   ax.plot(xs,ys, '--', color='black', ms=10)
+  
+   plt.annotate(hour,xy=(2,batmin+0.1*brange))
+   plt.annotate(hour2,xy=(2,batmin+0.05*brange))
+   plt.savefig(wadfr)
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad	(revision 8732)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   ln_wd             = .true.   ! T/F activation of wetting and drying
+   rn_wdmin1         =  0.3     ! Minimum wet depth on dried cells
+   rn_wdmin2         =   0.0001 ! Tolerance of min wet depth on dried cells
+   rn_wdld           =  2.5     ! Land elevation below which wetting/drying is allowed
+   nn_wdit           =  20      ! Max iterations for W/D limiter
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc1
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc1	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc1	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 1
+/
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   rn_wdmin1         =  0.075   ! Minimum wet depth on dried cells
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc2
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc2	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc2	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 2
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc3
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc3	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc3	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 3
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc4
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc4	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc4	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 4
+/
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   rn_wdmin1         =  0.45    ! Minimum wet depth on dried cells
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc5
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc5	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc5	(revision 8732)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 5
+/
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   rn_wdmin1         =  0.15    ! Minimum wet depth on dried cells
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc6
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc6	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc6	(revision 8732)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 6
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc7
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc7	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_tc7	(revision 8732)
@@ -0,0 +1,21 @@
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   nn_wad_test = 7
+/
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_itend    =      9600  !  last  time step
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+!-----------------------------------------------------------------------
+    ln_bdy         = .true.             
+    nb_bdy         = 1                    !  number of open boundary sets
+/
+!-----------------------------------------------------------------------
+&namwad  !   Wetting and drying
+!-----------------------------------------------------------------------
+   rn_wdmin1         =  0.150   ! Minimum wet depth on dried cells
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_usr
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_usr	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Namelists/nam_wad_usr	(revision 8732)
@@ -0,0 +1,8 @@
+!
+!-----------------------------------------------------------------------
+&namusr_def
+!-----------------------------------------------------------------------
+   rn_dx = 1000.0
+   rn_dz = 1.0
+   nn_wad_test = 1
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Preamble.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Preamble.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/Preamble.tex	(revision 8732)
@@ -0,0 +1,175 @@
+\documentclass[a4paper,11pt]{book}
+%\documentclass[a4paper,11pt,makeidx]{book} <== may need this to generate index
+
+%  makeindex NEMO_book  <== to regenerate the index
+%  bibtex    NEMO_book	<== to generate  the bibliography
+
+%\usepackage[french]{babel}
+%\usepackage{color}
+\usepackage{rotating, graphicx}			           % allows insertion of pictures
+%\usepackage{graphics}			                   % allows insertion of pictures
+\graphicspath{{Figures/}}                                  % Set global directory for pictures
+\DeclareGraphicsExtensions{.pdf,.eps}                      % Use .eps for LaTeX2HTML
+%\usepackage{xcolor}                                       % Incompatibility with color -> graphicx
+\usepackage[capbesideposition={top,center}]{floatrow}      % allows captions
+\floatsetup[table]{style=plaintop}                         % beside pictures
+\usepackage[margin=10pt,font={small},                      % Gives small font for captions
+labelsep=colon,labelfont={bf}]{caption}                    %
+\usepackage{enumitem}                                      % allows non-bold description items
+\usepackage{longtable}                                     % allows multipage tables
+%\usepackage{colortbl}                                     % gives coloured panels behind table columns
+
+%hyperref
+\usepackage[pdftitle={NEMO ocean engine},pdfauthor={Gurvan Madec},pdfstartview=FitH,
+bookmarks=true,bookmarksopen=true,breaklinks=true,colorlinks=true,
+linkcolor=blue,anchorcolor=blue,citecolor=blue,filecolor=blue,menucolor=blue,urlcolor=blue]{hyperref}
+% pdfsubject={The preprint document class
+%   elsart},% pdfkeywords={diapycnal diffusion,numerical mixing,z-level models},%%  usage of exteranl hyperlink :  \href{mailto:my_address@wikibooks.org}{my\_address@wikibooks.org}
+%                                                 \url{http://www.wikibooks.org}
+%                                     or         \href{http://www.wikibooks.org}{wikibooks home}
+
+
+%%%% page styles etc................
+\usepackage{fancyhdr}
+\pagestyle{fancy}
+% with this we ensure that the chapter and section
+% headings are in lowercase.
+\renewcommand{\chaptermark}[1]{\markboth{#1}{}}
+\renewcommand{\sectionmark}[1]{\markright{\thesection.\ #1}}
+\fancyhf{}             % delete current setting for header and footer
+\fancyhead[LE,RO]{\bfseries\thepage}
+\fancyhead[LO]{\bfseries\hspace{-0em}\rightmark}
+\fancyhead[RE]{\bfseries\leftmark}
+\renewcommand{\headrulewidth}{0.5pt}
+\renewcommand{\footrulewidth}{0pt  }
+\addtolength{\headheight}{2.6pt}   % make space for the rule
+%\addtolength{\headheight}{1.6pt}   % make space for the rule
+% get rid of headers on plain pages
+\fancypagestyle{plain}{\fancyhead{}\renewcommand{\headrulewidth}{0pt}}
+
+
+%%%%  Section number in Margin.......
+% typeset the number of each section in the left margin, with the start of each instance of
+% sectional heading text aligned with the left hand edge of  the body text.
+\makeatletter
+\def\@seccntformat#1{\protect\makebox[0pt][r]{\csname the#1\endcsname\quad}}
+\makeatother
+
+% Leave blank pages completely empty, w/o header
+\makeatletter
+\def\cleardoublepage{\clearpage\if@twoside \ifodd\c@page\else
+  \hbox{}
+  \vspace*{\fill}
+  \vspace{\fill}
+  \thispagestyle{empty}
+  \newpage
+  \if@twocolumn\hbox{}\newpage\fi\fi\fi}
+\makeatother
+
+%%%% define the chapter  style ................
+\usepackage{minitoc}				%In French : \usepackage[french]{minitoc}
+%\usepackage{mtcoff}				% invalidate the use of minitocs
+\usepackage{fancybox}
+
+\makeatletter
+\def\LigneVerticale{\vrule height 5cm depth 2cm\hspace{0.1cm}\relax}
+\def\LignesVerticales{%
+  \let\LV\LigneVerticale\LV\LV\LV\LV\LV\LV\LV\LV\LV\LV}
+\def\GrosCarreAvecUnChiffre#1{%
+  \rlap{\vrule height 0.8cm width 1cm depth 0.2cm}%
+ \rlap{\hbox to 1cm{\hss\mbox{\color{white} #1}\hss}}%
+  \vrule height 0pt width 1cm depth 0pt}
+\def\GrosCarreAvecTroisChiffre#1{%
+  \rlap{\vrule height 0.8cm width 1.6cm depth 0.2cm}%
+ \rlap{\hbox to 1.5cm{\hss\mbox{\color{white} #1}\hss}}%
+  \vrule height 0pt width 1cm depth 0pt}
+
+\def\@makechapterhead#1{\hbox{%
+   \huge
+    \LignesVerticales
+    \hspace{-0.5cm}%
+    \GrosCarreAvecUnChiffre{\thechapter}
+    \hspace{0.2cm}\hbox{#1}%
+%    \GrosCarreAvecTroisChiffre{\thechapter}
+%    \hspace{1cm}\hbox{#1}%
+%}\par\vskip 2cm}
+}\par\vskip 1cm}
+\def\@makeschapterhead#1{\hbox{%
+   \huge
+    \LignesVerticales
+    %\hspace{0.5cm}%
+    \hbox{#1}%
+}\par\vskip 2cm}
+\makeatother
+
+%\def\thechapter{\Roman{chapter}}   	% chapter number to be Roman
+
+
+%%%%           Mathematics...............
+%\documentclass{amsart}
+\usepackage{xspace}                              % helpd ensure correct spacing after macros
+\usepackage{latexsym,amssymb,amsmath}
+\allowdisplaybreaks[1]				% allow page breaks in the middle of equations
+\usepackage{TexFiles/Styles/math_abbrev}    % use maths shortcuts
+
+\usepackage{times}			 	 % use times font for text
+%\usepackage{mathtime}                          % font for illustrator to work (belleek fonts )
+%\usepackage[latin1]{inputenc}                % allows some unicode removed (agn)
+
+
+%%% essai commande
+\newcommand{\nl}[1]{\texttt{\small{\textcolor{blue}{#1}}}}
+\newcommand{\nlv}[1]{\texttt{\footnotesize#1}\xspace}
+\newcommand{\smnlv}[1]{\texttt{\scriptsize#1}\xspace}
+
+%%%% namelist & code display................................
+\usepackage{alltt,verbatim}  	%%  alltt & verbatim for namelist
+% namelists
+\newcommand{\namdisplay}[1]{\begin{alltt}{\tiny\verbatiminput{Namelists/#1}}\end{alltt}\vspace{-10pt}}
+\newcommand{\namtools}[1]{\begin{alltt}{\tiny\verbatiminput{Namelists/#1}}\end{alltt}\vspace{-10pt}}
+% code display
+%\newcommand{\codedisplay} [1] {\begin{alltt}{\tiny {\begin{verbatim} {#1}} \end{verbatim}} \end{alltt}      }
+
+
+
+%%%% commands for working with text................................
+% command to "comment out" portions of text ({} argument) or not ({#1} argument)
+\newcommand{\amtcomment}[1]{}   	% command to "commented out" portions of text or not (#1 in argument)
+\newcommand{\sgacomment}[1]{}   	% command to "commented out" portions of
+\newcommand{\gmcomment}[1]{}   	% command to "commented out" portions of
+%                                    				% text that span line breaks
+%Red (NR) or Yellow(WARN)
+%\newcommand{\NR}   {\colorbox{red}   {#1}}
+%\newcommand{\WARN} {\colorbox{yellow}{#1}}
+
+
+
+%%% index commands......................
+\usepackage{makeidx}
+%\usepackage{showidx}				% show the index entry
+
+\newcommand{\mdl}[1]{\textit{#1.F90}\index{Modules!#1}}	%module (mdl)
+\newcommand{\rou}[1]{\textit{#1}\index{Routines!#1}}	%module (routine)
+\newcommand{\hf}[1]{\textit{#1.h90}\index{h90 file!#1}}	%module (h90 files)
+\newcommand{\ngn}[1]{\textit{#1}\index{Namelist Group Name!#1}}	%namelist name (nampar)
+\newcommand{\np}[1]{\textit{#1}\index{Namelist variables!#1}}        %namelist variable
+\newcommand{\jp}[1]{\textit{#1}\index{Model parameters!#1}}	%model parameter (jp)
+\newcommand{\pp}[1]{\textit{#1}\index{Model parameters!#1}} 	%namelist parameter (pp)
+\newcommand{\ifile}[1]{\textit{#1.nc  }\index{Input NetCDF files!#1.nc}}	%input NetCDF files (.nc)
+\newcommand{\key}[1]{\textbf{key\_#1}\index{CPP keys!key\_#1}}	%key_cpp (key)
+\newcommand{\NEMO}{\textit{NEMO}\xspace}	%NEMO (nemo)
+
+%%%%   Bibliography   .............
+\usepackage[nottoc,notlof,notlot]{tocbibind}
+\usepackage[square,comma]{natbib}
+\bibpunct{[}{]}{,}{a}{}{;}                           %suppress "," after "et al."
+\providecommand{\bibfont}{\small}
+
+\usepackage{subfiles}                          % Separate compilation of chapters from whole manual
+%\newcommand{\onlyinsubfile}[1]{#1}             % New commands for printing parts according to
+%\newcommand{\notinsubfile}[1]{}                % the file being compiled
+% Commands to use in the documentfile
+%\renewcommand{\onlyinsubfile}[1]{}                      % Appears only if chapter   .tex file is compiled
+%\renewcommand{\notinsubfile}[1]{#1}                     %    "    ""   "" NEMO_book .tex file is compiled
+
+\DeclareMathAlphabet{\mathpzc}{OT1}{pzc}{m}{it}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/WAD_doc.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/WAD_doc.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_DOCS/WAD_doc.tex	(revision 8732)
@@ -0,0 +1,474 @@
+\include{Preamble}
+
+\begin{document}
+
+\title{Draft description of NEMO wetting and drying scheme:     22 November 2016 }
+
+\author{ Hedong Liu, Jason Holt, Andrew Coward  and Michael J. Bell  }
+
+%------------------------------------------------------------------------
+% End of temporary latex header (to be removed) 
+%------------------------------------------------------------------------
+
+% ================================================================
+% Chapter Ocean Dynamics (DYN)
+% ================================================================
+\chapter{Ocean Dynamics (DYN)}
+\label{DYN}
+\minitoc
+
+% add a figure for  dynvor ens, ene latices
+
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% Wetting and drying 
+% ================================================================
+\section{Wetting and drying }
+\label{DYN_wetdry}
+
+This is preliminary documentation for the wetting and drying code (WAD).  The emphasis is
+on explaining the rationale for the code.  The approach used by the WAD is similar to that
+developed for POM by \cite{Oey06} and that developed for ROMS by \cite{WarnerEtal13} but
+the WAD uses schemes that have not been published.
+
+The following terminology is used. The depth of the topography (positive downwards)
+at each $(i,j)$ point is the quantity stored in array $\mathrm{ht\_wd}$ in the NEMO code.
+The height of the free surface (positive upwards) will be denoted by $ \mathrm{ssh}$. Both
+quantities are measured relative to a reference sea level at z$=$0m. Given the sign
+conventions used, the water depth is the height of the free surface plus the depth of the
+topography (i.e. $\mathrm{ssh} + \mathrm{ht\_wd}$).
+
+\namdisplay{nam_wad}
+
+WAD is activated by setting $\mathrm{ln\_wd} = \mathrm{.true.}$. Currently, this option
+works with six test cases provided in the WAD\_TEST\_CASES configuration. These are all
+pure sigma coordinate configurations which define their domain, surface forcing and
+initial conditions via a set of 'usrdef' routines in MY\_SRC. Extending this option to
+more realistic domains will require the derivation and provision of a suitable
+$\mathrm{ht\_wd}$ field in addition to the normal information provided in the domcfg.nc
+file. The six test cases are described in section \S\ref{WAD_test_cases}.
+
+The WAD takes all points in the domain below a land elevation of $\mathrm{rn\_wdld}$ to be
+covered by water. Points where the water depth is less than $\mathrm{rn\_wdmin1}$ are to
+be interpreted as ``dry''. The WAD requires the topography specified with a model
+configuration to have negative depths at points where the land is higher than the
+topography's reference sea-level. The vertical grid in NEMO is computed relative to an
+initial state with zero sea surface height elevation. These reference metrics and depths
+(i.e. the $\mathrm{e3t\_0, ht\_0}$ etc. arrays) are unaltered by WAD.
+$\mathrm{rn\_wdmin1}$ is usually chosen to be of order $0.075$m but complex topographies
+with steep slopes may require larger values. The scheme also makes use of a second
+parameter, $\mathrm{rn\_wdmin2}$, which is intended to be much smaller than
+$\mathrm{rn\_wdmin1}$, of order $10^{-6}$m or smaller {\it (Q: What is the purpose of
+$\mathrm{rn\_wdmin2}$? Seems a non-zero value is required for the flux limiter iterations
+to converge)}.
+
+The WAD modifies the fluxes across the faces of cells that are either already ``dry''
+or may become dry within the next time-step using an iterative method.  The
+first sub-section below describes this scheme. It also briefly describes the simpler ROMS
+method that has not been implemented.
+
+The following sub-section describes how the surface pressure gradients are modified by the
+WAD. The next sub-section should describe how the WAD maintains consistency between the
+points that are ``wet'' on the barotropic sub-steps and those that are wet on the longer
+baroclinic time-step. This sub-section has not yet been written. The final sub-section
+should describe the test cases that have been used to assess the performance of the WAD.
+
+%-----------------------------------------------------------------------------------------
+%   Flux limiters
+%-----------------------------------------------------------------------------------------
+\subsection   [Flux limiters (\textit{wet\_dry})]
+			{Flux limiters (\mdl{wet\_dry})}
+\label{DYN_wd_flux_limit}
+
+The flux limiter for the barotropic flow devised by Hedong Liu can be understood as follows: 
+
+The continuity equation for the total water depth in a column 
+\begin{equation} \label{dyn_wd_continuity}
+ \frac{\partial h}{\partial t} + \mathbf{\nabla.}(h\mathbf{u}) = 0 .
+\end{equation} 
+can be written in discrete form  as  
+
+\begin{align} \label{dyn_wd_continuity_2}
+\frac{e_1 e_2}{\Delta t} ( h_{i,j}(t_{n+1}) - h_{i,j}(t_e) ) 
+&= - ( \mathrm{flxu}_{i+1,j} - \mathrm{flxu}_{i,j}  + \mathrm{flxv}_{i,j+1} - \mathrm{flxv}_{i,j} ) \\
+&= \mathrm{zzflx}_{i,j} .
+\end{align} 
+
+In the above $h$ is the depth of the water in the column at point $(i,j)$,
+$\mathrm{flxu}_{i+1,j}$ is the flux out of the ``eastern'' face of the cell and
+$\mathrm{flxv}_{i,j+1}$ the flux out of the ``northern'' face of the cell; $t_{n+1}$ is
+the new timestep, $t_e$ is the old timestep (either $t_b$ or $t_n$) and $ \Delta t =
+t_{n+1} - t_e$; $e_1 e_2$ is the area of the tracer cells centred at $(i,j)$ and
+$\mathrm{zzflx}$ is the sum of the fluxes through all the faces.
+
+The flux limiter splits the flux $\mathrm{zzflx}$ into fluxes that are out of the cell
+(zzflxp) and fluxes that are into the cell (zzflxn).  Clearly
+
+\begin{equation} \label{dyn_wd_zzflx_p_n_1}
+\mathrm{zzflx}_{i,j} = \mathrm{zzflxp}_{i,j} + \mathrm{zzflxn}_{i,j} .  
+\end{equation} 
+
+The flux limiter iteratively adjusts the fluxes $\mathrm{flxu}$ and $\mathrm{flxv}$ until
+none of the cells will ``dry out''. To be precise the fluxes are limited until none of the
+cells has water depth less than $\mathrm{rn\_wdmin1}$ on step $n+1$.
+
+Let the fluxes on the $m$th iteration step be denoted by $\mathrm{flxu}^{(m)}$ and
+$\mathrm{flxv}^{(m)}$.  Then the adjustment is achieved by seeking a set of coefficients,
+$\mathrm{zcoef}_{i,j}^{(m)}$ such that:
+
+\begin{equation} \label{dyn_wd_continuity_coef}
+\begin{split}
+\mathrm{zzflxp}^{(m)}_{i,j} =& \mathrm{zcoef}_{i,j}^{(m)} \mathrm{zzflxp}^{(0)}_{i,j} \\
+\mathrm{zzflxn}^{(m)}_{i,j} =& \mathrm{zcoef}_{i,j}^{(m)} \mathrm{zzflxn}^{(0)}_{i,j}
+\end{split}
+\end{equation} 
+ 
+where the coefficients are $1.0$ generally but can vary between $0.0$ and $1.0$ around
+cells that would otherwise dry.
+
+The iteration is initialised by setting
+
+\begin{equation} \label{dyn_wd_zzflx_initial}
+\mathrm{zzflxp^{(0)}}_{i,j} = \mathrm{zzflxp}_{i,j} , \quad  \mathrm{zzflxn^{(0)}}_{i,j} = \mathrm{zzflxn}_{i,j} . 
+\end{equation} 
+
+The fluxes out of cell $(i,j)$ are updated at the $m+1$th iteration if the depth of the
+cell on timestep $t_e$, namely $h_{i,j}(t_e)$, is less than the total flux out of the cell
+times the timestep divided by the cell area. Using (\ref{dyn_wd_continuity_2}) this
+condition is
+
+\begin{equation} \label{dyn_wd_continuity_if}
+h_{i,j}(t_e)  - \mathrm{rn\_wdmin1} <  \frac{\Delta t}{e_1 e_2} ( \mathrm{zzflxp}^{(m)}_{i,j} + \mathrm{zzflxn}^{(m)}_{i,j} ) .
+\end{equation} 
+
+Rearranging (\ref{dyn_wd_continuity_if}) we can obtain an expression for the maximum
+outward flux that can be allowed and still maintain the minimum wet depth:
+
+\begin{equation} \label{dyn_wd_max_flux}
+\begin{split}
+\mathrm{zzflxp}^{(m+1)}_{i,j} = \Big[ (h_{i,j}(t_e) & - \mathrm{rn\_wdmin1} - \mathrm{rn\_wdmin2})  \frac{e_1 e_2}{\Delta t} \phantom{]} \\
+\phantom{[} & -  \mathrm{zzflxn}^{(m)}_{i,j} \Big]
+\end{split}
+\end{equation}
+
+Note a small tolerance ($\mathrm{rn\_wdmin2}$) has been introduced here {\it [Q: Why is
+this necessary/desirable?]}. Substituting from (\ref{dyn_wd_continuity_coef}) gives an
+expression for the coefficient needed to multiply the outward flux at this cell in order
+to avoid drying. 
+
+\begin{equation} \label{dyn_wd_continuity_nxtcoef}
+\begin{split}
+\mathrm{zcoef}^{(m+1)}_{i,j} = \Big[ (h_{i,j}(t_e) & - \mathrm{rn\_wdmin1} - \mathrm{rn\_wdmin2})  \frac{e_1 e_2}{\Delta t} \phantom{]} \\
+\phantom{[} & -  \mathrm{zzflxn}^{(m)}_{i,j} \Big] \frac{1}{ \mathrm{zzflxp}^{(0)}_{i,j} } 
+\end{split}
+\end{equation} 
+
+Only the outward flux components are altered but, of course, outward fluxes from one cell
+are inward fluxes to adjacent cells and the balance in these cells may need subsequent
+adjustment; hence the iterative nature of this scheme.  Note, for example, that the flux
+across the ``eastern'' face of the $(i,j)$th cell is only updated at the $m+1$th iteration
+if that flux at the $m$th iteration is out of the $(i,j)$th cell. If that is the case then
+the flux across that face is into the $(i+1,j)$ cell and that flux will not be updated by
+the calculation for the $(i+1,j)$th cell. In this sense the updates to the fluxes across
+the faces of the cells do not ``compete'' (they do not over-write each other) and one
+would expect the scheme to converge relatively quickly. The scheme is also flux based so
+conserves mass.
+
+The ROMS scheme to prevent drying out of a cell is somewhat simpler. It specifies that if
+a tracer cell is dry (the water depth is less than $\mathrm{rn\_wdmin1}$) on the backward
+timestep, $t_e$, then any outward flux through its cell faces should be set to zero. This
+scheme has a clear physical rationale. This scheme is equivalent to setting
+$\mathrm{zcoef}^{(m+1)}_{i,j}$ to $0.0$ whenever a cell is at risk of drying.  One
+objection to the ROMS scheme is that it introduces a spurious step function in the flux
+out of a cell as the water depth in the cell passes through the ``critical'' value
+$\mathrm{rn\_wdmin1}$.
+
+%----------------------------------------------------------------------------------------
+%      Surface pressure gradients
+%----------------------------------------------------------------------------------------
+\subsection   [Modification of surface pressure gradients (\textit{dynhpg})]
+			{Modification of surface pressure gradients (\mdl{dynhpg})}
+\label{DYN_wd_spg}
+
+At ``dry'' points the water depth is usually close to $\mathrm{rn\_wdmin1}$. If the
+topography is sloping at these points the sea-surface will have a similar slope and there
+will hence be very large horizontal pressure gradients at these points. The WAD modifies
+the magnitude but not the sign of the surface pressure gradients (zhpi and zhpj) at such
+points by mulitplying them by positive factors (zcpx and zcpy respectively) that lie
+between $0$ and $1$.
+
+We describe how the scheme works for the ``eastward'' pressure gradient, zhpi, calculated
+at the $(i,j)$th $u$-point. The scheme uses the ht\_wd depths and surface heights at the
+neighbouring $(i+1,j)$ and $(i,j)$ tracer points.  zcpx is calculated using two logicals
+variables, $\mathrm{ll\_tmp1}$ and $\mathrm{ll\_tmp2}$ which are evaluated for each grid
+column.  The three possible combinations are illustrated in figure \ref{Fig_WAD_dynhpg}.
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_dynhpg}
+\caption{ \label{Fig_WAD_dynhpg}
+Illustrations of the three possible combinations of the logical variables controlling the 
+limiting of the horizontal pressure gradient in wetting and drying regimes}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The first logical, $\mathrm{ll\_tmp1}$, is set to true if and only if the water depth at
+both neighbouring points is greater than $\mathrm{rn\_wdmin1} + \mathrm{rn\_wdmin2}$ and
+the minimum height of the sea surface at the two points is greater than the maximum height
+of the topography at the two points:
+
+\begin{equation} \label{dyn_ll_tmp1}
+\begin{split}
+\mathrm{ll\_tmp1}  = & \mathrm{MIN(sshn(ji,jj), sshn(ji+1,jj))} > \\
+                     & \quad \mathrm{MAX(-ht\_wd(ji,jj), -ht\_wd(ji+1,jj))\  .and.} \\
+& \mathrm{MAX(sshn(ji,jj) + ht\_wd(ji,jj),} \\
+& \mathrm{\phantom{MAX(}sshn(ji+1,jj) + ht\_wd(ji+1,jj))} >\\
+& \quad\quad\mathrm{rn\_wdmin1 + rn\_wdmin2 }
+\end{split}
+\end{equation} 
+
+The second logical, $\mathrm{ll\_tmp2}$, is set to true if and only if the maximum height
+of the sea surface at the two points is greater than the maximum height of the topography
+at the two points plus $\mathrm{rn\_wdmin1} + \mathrm{rn\_wdmin2}$
+
+\begin{equation} \label{dyn_ll_tmp2}
+\begin{split}
+\mathrm{ ll\_tmp2 } = & \mathrm{( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 )\ .AND.}\\
+& \mathrm{( MAX(sshn(ji,jj), sshn(ji+1,jj)) > } \\
+& \mathrm{\phantom{(} MAX(-ht\_wd(ji,jj), -ht\_wd(ji+1,jj)) + rn\_wdmin1 + rn\_wdmin2}) .
+\end{split}
+\end{equation} 
+
+If $\mathrm{ll\_tmp1}$ is true then the surface pressure gradient, zhpi at the $(i,j)$
+point is unmodified. If both logicals are false zhpi is set to zero.
+
+If $\mathrm{ll\_tmp1}$ is true and $\mathrm{ll\_tmp2}$ is false then the surface pressure
+gradient is multiplied through by zcpx which is the absolute value of the difference in
+the water depths at the two points divided by the difference in the surface heights at the
+two points. Thus the sign of the sea surface height gradient is retained but the magnitude
+of the pressure force is determined by the difference in water depths rather than the
+difference in surface height between the two points. Note that dividing by the difference
+between the sea surface heights can be problematic if the heights approach parity. An
+additional condition is applied to $\mathrm{ ll\_tmp2 }$ to ensure it is .false. in such
+conditions.
+
+%----------------------------------------------------------------------------------------
+%      The WAD test cases
+%----------------------------------------------------------------------------------------
+\subsection   [The WAD test cases (\textit{usrdef\_zgr})]
+			{The WAD test cases (\mdl{usrdef\_zgr})}
+\label{WAD_test_cases}
+
+This section contains details of the seven test cases that can be run as part of the
+WAD\_TEST\_CASES configuration. All the test cases are shallow (less than 10m deep),
+basins or channels with 4m high walls and some of topography that can wet and dry up to
+2.5m above sea-level. The horizontal grid is uniform with a 1km resolution and measures
+52km by 34km. These dimensions are determined by a combination of code in the
+\mdl{usrdef\_nam} module located in the WAD\_TEST\_CASES/MY\_SRC directory and setting
+read in from the namusr\_def namelist. The first six test cases are closed systems with no
+rotation or external forcing and motion is simply initiated by an initial ssh slope. The
+seventh test case introduces and open boundary at the right-hand end of the channel which
+is forced with sinousoidally varying ssh and barotropic velocities.
+
+\namdisplay{nam_wad_usr}
+
+The $\mathrm{nn\_wad\_test}$ parameter can takes values 1 to 7 and it is this parameter
+that determines which of the test cases will be run. Most cases can be run with the
+default settings but the simple linear slope cases (tests 1 and 5) can be run with lower
+values of $\mathrm{rn\_wdmin1}$. Any recommended changes to the default namelist settings
+will be stated in the individual subsections.
+
+Test case 7 requires additional {\tt namelist\_cfg} changes to activate the open boundary
+and lengthen the duration of the run (in order to demonstrate the full forcing cycle).
+There is also a simple python script which needs to be run in order to generate the
+boundary forcing files.  Full details are given in subsection (\ref{WAD_test_case7}).
+
+\clearpage
+\subsubsection [WAD test case 1 : A simple linear slope]
+                    {WAD test case 1 : A simple linear slope}
+\label{WAD_test_case1}
+
+The first test case is a simple linear slope (in the x-direction, uniform in y) with an
+adverse SSH gradient that, when released, creates a surge up the slope. The parameters are
+chosen such that the surge rises above sea-level before falling back and oscillating
+towards an equilibrium position. This case can be run with $\mathrm{rn\_wdmin1}$ values as
+low as 0.075m. I.e. the following change may be made to the default values in {\tt
+namelist\_cfg} (for this test only):
+
+\namdisplay{nam_wad_tc1}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC1}
+\caption{ \label{Fig_WAD_TC1}
+The evolution of the sea surface height in WAD\_TEST\_CASE 1 from the initial state (t=0)
+over the first three hours of simulation. Note that in this time-frame the resultant surge
+reaches to nearly 2m above sea-level before retreating.}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\clearpage
+\subsubsection [WAD test case 2 : A parabolic channel ]
+                    {WAD test case 2 : A parabolic channel}
+\label{WAD_test_case2}
+
+The second and third test cases use a closed channel which is parabolic in x and uniform
+in y.  Test case 2 uses a gentler initial SSH slope which nevertheless demonstrates the
+ability to wet and dry on both sides of the channel. This solution requires values of
+$\mathrm{rn\_wdmin1}$ at least 0.3m ({\it Q.: A function of the maximum topographic
+slope?})
+
+\namdisplay{nam_wad_tc2}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC2}
+\caption{ \label{Fig_WAD_TC2}
+The evolution of the sea surface height in WAD\_TEST\_CASE 2 from the initial state (t=0)
+over the first three hours of simulation. Note that in this time-frame the resultant sloshing
+causes wetting and drying on both sides of the parabolic channel.}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\clearpage
+\subsubsection [WAD test case 3 : A parabolic channel (extreme slope) ]
+                    {WAD test case 3 : A parabolic channel (extreme slope)}
+\label{WAD_test_case3}
+
+Similar to test case 2 but with a steeper initial SSH slope. The solution is similar but more vigorous.
+
+\namdisplay{nam_wad_tc3}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC3}
+\caption{ \label{Fig_WAD_TC3}
+The evolution of the sea surface height in WAD\_TEST\_CASE 3 from the initial state (t=0)
+over the first three hours of simulation. Note that in this time-frame the resultant sloshing
+causes wetting and drying on both sides of the parabolic channel.}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\clearpage
+\subsubsection [WAD test case 4 : A parabolic bowl ]
+                    {WAD test case 4 : A parabolic bowl}
+\label{WAD_test_case4}
+
+Test case 4 includes variation in the y-direction in the form of a parabolic bowl. The
+initial condition is now a raised bulge centred over the bowl. Figure \ref{Fig_WAD_TC4}
+shows a cross-section of the SSH in the X-direction but features can be seen to propagate
+in all directions and interfere when return paths cross.
+
+\namdisplay{nam_wad_tc4}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC4}
+\caption{ \label{Fig_WAD_TC4}
+The evolution of the sea surface height in WAD\_TEST\_CASE 4 from the initial state (t=0)
+over the first three hours of simulation. Note that this test case is a parabolic bowl with
+variations occurring in the y-direction too (not shown here).}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\clearpage
+\subsubsection [WAD test case 5 : A double slope with shelf channel ]
+                    {WAD test case 5 : A double slope with shelf channel}
+\label{WAD_test_case5}
+
+Similar in nature to test case 1 but with a change in slope and a mid-depth shelf.
+
+\namdisplay{nam_wad_tc5}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC5}
+\caption{ \label{Fig_WAD_TC5}
+The evolution of the sea surface height in WAD\_TEST\_CASE 5 from the initial state (t=0)
+over the first three hours of simulation. The surge resulting in this case wets to the full 
+depth permitted (2.5m above sea-level) and is only halted by the 4m high side walls.}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\clearpage
+\subsubsection [WAD test case 6 : A parabolic channel with central bar ]
+                    {WAD test case 6 : A parabolic channel with central bar}
+\label{WAD_test_case6}
+
+Test cases 1 to 5 have all used uniform T and S conditions. The dashed line in each plot
+shows the surface salinity along the y=17 line which remains satisfactorily constant. Test
+case 6 introduces variation in salinity by taking a parabolic channel divided by a central
+bar (gaussian) and using two different salinity values in each half of the channel. This
+step change in salinity is initially enforced by the central bar but the bar is
+subsequently over-topped after the initial SSH gradient is released. The time series in
+this case shows the SSH evolution with the water coloured according to local salinity
+values. Encroachment of the high salinity (red) waters into the low salinity (blue) basin
+can clearly be seen.
+
+\namdisplay{nam_wad_tc6}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC6}
+\caption{ \label{Fig_WAD_TC6}
+The evolution of the sea surface height in WAD\_TEST\_CASE 6 from the initial state (t=0)
+over the first three hours of simulation. Water is coloured according to local salinity
+values. Encroachment of the high salinity (red) waters into the low salinity (blue) basin
+can clearly be seen although the largest influx occurs early in the sequence between the
+frames shown.}
+\end{center}\end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+\clearpage
+\subsubsection [WAD test case 7 : A double slope with shelf, open-ended channel ]
+                    {WAD test case 7 : A double slope with shelf, open-ended channel}
+\label{WAD_test_case7}
+
+Similar in nature to test case 5 but with an open boundary forced with a sinusoidally
+varying ssh. This test case has been introduced to emulate a typical coastal application
+with a tidally forced open boundary. The bathymetry and setup is identical to test case 5
+except the right hand end of the channel is now open and has simple ssh and barotropic
+velocity boundary conditions applied at the open boundary. Several additional steps and
+namelist changes are required to run this test.
+
+\namdisplay{nam_wad_tc7}
+
+In addition, the boundary condition files must be generated using the python script
+provided.
+
+\begin{verbatim}
+python ./makebdy_tc7.py
+\end{verbatim}
+
+will create the following boundary files for this test (assuming a suitably configured
+python environment: python2.7 with netCDF4 and numpy):
+
+\begin{verbatim}
+  bdyssh_tc7_m12d30.nc   bdyuv_tc7_m12d30.nc
+  bdyssh_tc7_m01d01.nc   bdyuv_tc7_m01d01.nc
+  bdyssh_tc7_m01d02.nc   bdyuv_tc7_m01d02.nc
+  bdyssh_tc7_m01d03.nc   bdyuv_tc7_m01d03.nc
+\end{verbatim}
+
+These are sufficient for up to a three day simulation; the script is easily adapted if
+longer periods are required.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{sidewaysfigure}[htb] \begin{center}
+\includegraphics[width=0.8\textwidth]{Fig_WAD_TC7}
+\caption{ \label{Fig_WAD_TC7}
+The evolution of the sea surface height in WAD\_TEST\_CASE 7 from the initial state (t=0)
+over the first 24 hours of simulation. After the initial surge the solution settles into a
+simulated tidal cycle with an amplitude of 5m. This is enough to repeatedly wet and dry
+both shelves.}
+
+\end{center}\end{sidewaysfigure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% ================================================================
+
+\bibliographystyle{wileyqj}
+\bibliography{references}
+
+\end{document}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90	(revision 8732)
@@ -0,0 +1,1763 @@
+MODULE bdyini
+   !!======================================================================
+   !!                       ***  MODULE  bdyini  ***
+   !! Unstructured open boundaries : initialisation
+   !!======================================================================
+   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
+   !!             -   !  2007-01  (D. Storkey) Update to use IOM module
+   !!             -   !  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
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.4  !  2012     (J. Chanut) straight open boundary case update
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) optimization of BDY communications
+   !!            3.7  !  2016     (T. Lovato) Remove bdy macro, call here init for dta and tides
+   !!----------------------------------------------------------------------
+   !!   bdy_init      : Initialization of unstructured open boundaries
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! unstructured open boundary conditions
+   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine)
+   USE bdytides       ! open boundary cond. setting   (bdytide_init routine)
+   USE sbctide        ! Tidal forcing or not
+   USE phycst   , ONLY: rday
+   !
+   USE in_out_manager ! I/O units
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! for mpp_sum  
+   USE iom            ! I/O
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_init   ! routine called in nemo_init
+
+   INTEGER, PARAMETER ::   jp_nseg = 100   ! 
+   INTEGER, PARAMETER ::   nrimmax =  20   ! maximum rimwidth in structured
+                                               ! open boundary data files
+   ! Straight open boundary segment parameters:
+   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs 
+   INTEGER, DIMENSION(jp_nseg) ::   jpieob, jpjedt, jpjeft, npckge   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpiwob, jpjwdt, jpjwft, npckgw   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpjnob, jpindt, jpinft, npckgn   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpjsob, jpisdt, jpisft, npckgs   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: bdyini.F90 7421 2016-12-01 17:10:41Z flavoni $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_init  ***
+      !!
+      !! ** Purpose :   Initialization of the dynamics and tracer fields with
+      !!              unstructured open boundaries.
+      !!
+      !! ** Method  :   Read initialization arrays (mask, indices) to identify
+      !!              an unstructured open boundary
+      !!
+      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
+      !!----------------------------------------------------------------------
+      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice_lim, nn_ice_lim_dta,                             &
+         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
+         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+         !
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_init')
+
+      ! ------------------------
+      ! Read namelist parameters
+      ! ------------------------
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nambdy )
+
+      ! -----------------------------------------
+      ! unstructured open boundaries use control
+      ! -----------------------------------------
+      IF ( ln_bdy ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+         ! Open boundaries definition (arrays and masks)
+         CALL bdy_segs
+         !
+         ! Open boundaries initialisation of external data arrays
+         CALL bdy_dta_init
+         !
+         ! Open boundaries initialisation of tidal harmonic forcing
+         IF( ln_tide ) CALL bdytide_init
+         !
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'bdy_init : open boundaries not used (ln_bdy = F)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_init')
+      !
+   END SUBROUTINE bdy_init
+   
+   SUBROUTINE bdy_segs
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_init  ***
+      !!         
+      !! ** Purpose :   Definition of unstructured open boundaries.
+      !!
+      !! ** Method  :   Read initialization arrays (mask, indices) to identify 
+      !!              an unstructured open boundary
+      !!
+      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
+      !!----------------------------------------------------------------------      
+
+      ! local variables
+      !-------------------
+      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
+      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
+      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       -
+      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
+      INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
+      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       -
+      INTEGER  ::   i_offset, j_offset                     !   -       -
+      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts
+      REAL(wp), POINTER  ::  flagu, flagv                  !    -   -
+      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields
+      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars
+      INTEGER, DIMENSION (2)                  ::   kdimsz
+      INTEGER, DIMENSION(jpbgrd,jp_bdy)       ::   nblendta         ! Length of index arrays 
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points
+      CHARACTER(LEN=1),DIMENSION(jpbgrd)      ::   cgrid
+      INTEGER :: com_east, com_west, com_south, com_north          ! Flags for boundaries sending
+      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving
+      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates
+      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat)
+      !!
+      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        - 
+      INTEGER                              ::   nbdyind, nbdybeg, nbdyend
+      !!
+      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_segs')
+      !
+      cgrid = (/'t','u','v'/)
+
+      ! -----------------------------------------
+      ! Check and write out namelist parameters
+      ! -----------------------------------------
+      IF( jperio /= 0 )   CALL ctl_stop( 'bdy_segs: Cyclic or symmetric,',   &
+         &                               ' and general open boundary condition are not compatible' )
+
+      IF( nb_bdy == 0 ) THEN 
+        IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.'
+      ELSE
+        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy
+      ENDIF
+
+      DO ib_bdy = 1,nb_bdy
+        IF(lwp) WRITE(numout,*) ' ' 
+        IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------' 
+
+        IF( ln_coords_file(ib_bdy) ) THEN
+           IF(lwp) WRITE(numout,*) 'Boundary definition read from file '//TRIM(cn_coords_file(ib_bdy))
+        ELSE
+           IF(lwp) WRITE(numout,*) 'Boundary defined in namelist.'
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  '
+        SELECT CASE( cn_dyn2d(ib_bdy) )                  
+          CASE( 'none' )         
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .false.
+             dta_bdy(ib_bdy)%ll_v2d = .false.
+          CASE( 'frs' )          
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE( 'flather' )      
+             IF(lwp) WRITE(numout,*) '      Flather radiation condition'
+             dta_bdy(ib_bdy)%ll_ssh = .true.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE( 'orlanski' )     
+             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE( 'orlanski_npo' ) 
+             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' )
+        END SELECT
+        IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
+           SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   ! 
+              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'        
+              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file'
+              CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      tidal harmonic forcing taken from file'
+              CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      boundary data AND tidal harmonic forcing taken from files'
+              CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' )
+           END SELECT
+           IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.ln_tide)) THEN
+             CALL ctl_stop( 'You must activate with ln_tide to add tidal forcing at open boundaries' )
+           ENDIF
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  '
+        SELECT CASE( cn_dyn3d(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('frs')       
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('specified')
+             IF(lwp) WRITE(numout,*) '      Specified value'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('neumann')
+             IF(lwp) WRITE(numout,*) '      Neumann conditions'
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('zerograd')
+             IF(lwp) WRITE(numout,*) '      Zero gradient for baroclinic velocities'
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('zero')
+             IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)'
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('orlanski')
+             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('orlanski_npo')
+             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' )
+        END SELECT
+        IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
+           SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   ! 
+              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_dyn3d_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+
+        IF ( ln_dyn3d_dmp(ib_bdy) ) THEN
+           IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN
+              IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.'
+              ln_dyn3d_dmp(ib_bdy)=.false.
+           ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN
+              CALL ctl_stop( 'Use FRS OR relaxation' )
+           ELSE
+              IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone'
+              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days'
+              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' )
+              dta_bdy(ib_bdy)%ll_u3d = .true.
+              dta_bdy(ib_bdy)%ll_v3d = .true.
+           ENDIF
+        ELSE
+           IF(lwp) WRITE(numout,*) '      NO relaxation on baroclinic velocities'
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  '
+        SELECT CASE( cn_tra(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_tem = .false.
+             dta_bdy(ib_bdy)%ll_sal = .false.
+          CASE('frs')
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE('specified')
+             IF(lwp) WRITE(numout,*) '      Specified value'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE('neumann')
+             IF(lwp) WRITE(numout,*) '      Neumann conditions'
+             dta_bdy(ib_bdy)%ll_tem = .false.
+             dta_bdy(ib_bdy)%ll_sal = .false.
+          CASE('runoff')
+             IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity'
+             dta_bdy(ib_bdy)%ll_tem = .false.
+             dta_bdy(ib_bdy)%ll_sal = .false.
+          CASE('orlanski')
+             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE('orlanski_npo')
+             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_tra' )
+        END SELECT
+        IF( cn_tra(ib_bdy) /= 'none' ) THEN
+           SELECT CASE( nn_tra_dta(ib_bdy) )                   ! 
+              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_tra_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+
+        IF ( ln_tra_dmp(ib_bdy) ) THEN
+           IF ( cn_tra(ib_bdy) == 'none' ) THEN
+              IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.'
+              ln_tra_dmp(ib_bdy)=.false.
+           ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN
+              CALL ctl_stop( 'Use FRS OR relaxation' )
+           ELSE
+              IF(lwp) WRITE(numout,*) '      + T/S relaxation zone'
+              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days'
+              IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days'
+              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' )
+              dta_bdy(ib_bdy)%ll_tem = .true.
+              dta_bdy(ib_bdy)%ll_sal = .true.
+           ENDIF
+        ELSE
+           IF(lwp) WRITE(numout,*) '      NO T/S relaxation'
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+#if defined key_lim2
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
+        SELECT CASE( cn_ice_lim(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_frld  = .false.
+             dta_bdy(ib_bdy)%ll_hicif = .false.
+             dta_bdy(ib_bdy)%ll_hsnif = .false.
+          CASE('frs')
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_frld  = .true.
+             dta_bdy(ib_bdy)%ll_hicif = .true.
+             dta_bdy(ib_bdy)%ll_hsnif = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
+        END SELECT
+        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 
+           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   ! 
+              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_ice_lim_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+#elif defined key_lim3
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
+        SELECT CASE( cn_ice_lim(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_a_i  = .false.
+             dta_bdy(ib_bdy)%ll_ht_i = .false.
+             dta_bdy(ib_bdy)%ll_ht_s = .false.
+          CASE('frs')
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_a_i  = .true.
+             dta_bdy(ib_bdy)%ll_ht_i = .true.
+             dta_bdy(ib_bdy)%ll_ht_s = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
+        END SELECT
+        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 
+           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   ! 
+              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_ice_lim_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+        IF(lwp) WRITE(numout,*) '      tem of bdy sea-ice = ', rn_ice_tem(ib_bdy)         
+        IF(lwp) WRITE(numout,*) '      sal of bdy sea-ice = ', rn_ice_sal(ib_bdy)         
+        IF(lwp) WRITE(numout,*) '      age of bdy sea-ice = ', rn_ice_age(ib_bdy)         
+#endif
+
+        IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy)
+        IF(lwp) WRITE(numout,*)
+
+      ENDDO
+
+     IF (nb_bdy .gt. 0) THEN
+        IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value)
+          IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries'
+          IF(lwp) WRITE(numout,*)
+          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 applied at open boundaries'
+          IF(lwp) WRITE(numout,*)
+        ENDIF
+        IF( nb_jpk_bdy > 0 ) THEN
+           IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***'
+        ELSE
+           IF(lwp) WRITE(numout,*) '*** open boundary will be read straight onto the native grid without vertical interpolation ***'
+        ENDIF
+     ENDIF
+
+      ! -------------------------------------------------
+      ! Initialise indices arrays for open boundaries
+      ! -------------------------------------------------
+
+      ! Work out global dimensions of boundary data
+      ! ---------------------------------------------
+      REWIND( numnam_cfg )     
+
+      nblendta(:,:) = 0
+      nbdysege = 0
+      nbdysegw = 0
+      nbdysegn = 0
+      nbdysegs = 0
+      icount   = 0 ! count user defined segments
+      ! Dimensions below are used to allocate arrays to read external data
+      jpbdtas = 1 ! Maximum size of boundary data (structured case)
+      jpbdtau = 1 ! Maximum size of boundary data (unstructured case)
+
+      DO ib_bdy = 1, nb_bdy
+
+         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters
+ 
+            icount = icount + 1
+            ! No REWIND here because may need to read more than one nambdy_index namelist.
+            ! Read only namelist_cfg to avoid unseccessfull overwrite
+!!          REWIND( numnam_ref )              ! Namelist nambdy_index in reference namelist : Open boundaries indexes
+!!          READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 903)
+!!903       IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in reference namelist', lwp )
+
+!!          REWIND( numnam_cfg )              ! Namelist nambdy_index in configuration namelist : Open boundaries indexes
+            READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 )
+904         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp )
+            IF(lwm) WRITE ( numond, nambdy_index )
+
+            SELECT CASE ( TRIM(ctypebdy) )
+              CASE( 'N' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = jpjglo - 2  ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpiglo - 1
+                 ENDIF
+                 nbdysegn = nbdysegn + 1
+                 npckgn(nbdysegn) = ib_bdy ! Save bdy package number
+                 jpjnob(nbdysegn) = nbdyind
+                 jpindt(nbdysegn) = nbdybeg
+                 jpinft(nbdysegn) = nbdyend
+                 !
+              CASE( 'S' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = 2           ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpiglo - 1
+                 ENDIF
+                 nbdysegs = nbdysegs + 1
+                 npckgs(nbdysegs) = ib_bdy ! Save bdy package number
+                 jpjsob(nbdysegs) = nbdyind
+                 jpisdt(nbdysegs) = nbdybeg
+                 jpisft(nbdysegs) = nbdyend
+                 !
+              CASE( 'E' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = jpiglo - 2  ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpjglo - 1
+                 ENDIF
+                 nbdysege = nbdysege + 1 
+                 npckge(nbdysege) = ib_bdy ! Save bdy package number
+                 jpieob(nbdysege) = nbdyind
+                 jpjedt(nbdysege) = nbdybeg
+                 jpjeft(nbdysege) = nbdyend
+                 !
+              CASE( 'W' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = 2           ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpjglo - 1
+                 ENDIF
+                 nbdysegw = nbdysegw + 1
+                 npckgw(nbdysegw) = ib_bdy ! Save bdy package number
+                 jpiwob(nbdysegw) = nbdyind
+                 jpjwdt(nbdysegw) = nbdybeg
+                 jpjwft(nbdysegw) = nbdyend
+                 !
+              CASE DEFAULT   ;   CALL ctl_stop( 'ctypebdy must be N, S, E or W' )
+            END SELECT
+
+            ! For simplicity we assume that in case of straight bdy, arrays have the same length
+            ! (even if it is true that last tangential velocity points
+            ! are useless). This simplifies a little bit boundary data format (and agrees with format
+            ! used so far in obc package)
+
+            nblendta(1:jpbgrd,ib_bdy) =  (nbdyend - nbdybeg + 1) * nn_rimwidth(ib_bdy)
+            jpbdtas = MAX(jpbdtas, (nbdyend - nbdybeg + 1))
+            IF (lwp.and.(nn_rimwidth(ib_bdy)>nrimmax)) &
+            & CALL ctl_stop( 'rimwidth must be lower than nrimmax' )
+
+         ELSE            ! Read size of arrays in boundary coordinates file.
+            CALL iom_open( cn_coords_file(ib_bdy), inum )
+            DO igrd = 1, jpbgrd
+               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )  
+               !clem nblendta(igrd,ib_bdy) = kdimsz(1)
+               !clem jpbdtau = MAX(jpbdtau, kdimsz(1))
+               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz)
+               jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz))
+            END DO
+            CALL iom_close( inum )
+            !
+         ENDIF 
+         !
+      END DO ! ib_bdy
+
+      IF (nb_bdy>0) THEN
+         jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy))
+
+         ! Allocate arrays
+         !---------------
+         ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    &
+            &      nbrdta(jpbdta, jpbgrd, nb_bdy) )
+
+         IF( nb_jpk_bdy>0 ) THEN
+            ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) )
+            ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) )
+            ALLOCATE( dta_global_dz(jpbdtau, 1, nb_jpk_bdy) )
+         ELSE
+            ALLOCATE( dta_global(jpbdtau, 1, jpk) )
+            ALLOCATE( dta_global_z(jpbdtau, 1, jpk) ) ! needed ?? TODO
+            ALLOCATE( dta_global_dz(jpbdtau, 1, jpk) )! needed ?? TODO
+         ENDIF
+
+         IF ( icount>0 ) THEN
+            IF( nb_jpk_bdy>0 ) THEN
+               ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) )
+               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) )
+               ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, nb_jpk_bdy) )
+            ELSE
+               ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) )
+               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) ! needed ?? TODO
+               ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk) )! needed ?? TODO  
+            ENDIF
+         ENDIF
+         ! 
+      ENDIF
+
+      ! Now look for crossings in user (namelist) defined open boundary segments:
+      !--------------------------------------------------------------------------
+      IF( icount>0 )   CALL bdy_ctl_seg
+
+      ! Calculate global boundary index arrays or read in from file
+      !------------------------------------------------------------               
+      ! 1. Read global index arrays from boundary coordinates file.
+      DO ib_bdy = 1, nb_bdy
+         !
+         IF( ln_coords_file(ib_bdy) ) THEN
+            !
+            CALL iom_open( cn_coords_file(ib_bdy), inum )
+            DO igrd = 1, jpbgrd
+               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
+               DO ii = 1,nblendta(igrd,ib_bdy)
+                  nbidta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
+               END DO
+               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
+               DO ii = 1,nblendta(igrd,ib_bdy)
+                  nbjdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
+               END DO
+               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
+               DO ii = 1,nblendta(igrd,ib_bdy)
+                  nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
+               END DO
+               !
+               ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) )
+               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(ib_bdy)
+               IF (ibr_max < nn_rimwidth(ib_bdy))   &
+                     CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) )
+            END DO
+            CALL iom_close( inum )
+            !
+         ENDIF 
+         !
+      END DO      
+    
+      ! 2. Now fill indices corresponding to straight open boundary arrays:
+      ! East
+      !-----
+      DO iseg = 1, nbdysege
+         ib_bdy = npckge(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ij = jpjedt(iseg), jpjeft(iseg) - 1
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+      ENDDO
+      !
+      ! West
+      !-----
+      DO iseg = 1, nbdysegw
+         ib_bdy = npckgw(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ij = jpjwdt(iseg), jpjwft(iseg) - 1
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+      ENDDO
+      !
+      ! North
+      !-----
+      DO iseg = 1, nbdysegn
+         ib_bdy = npckgn(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ii = jpindt(iseg), jpinft(iseg) - 1
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      ! South
+      !-----
+      DO iseg = 1, nbdysegs
+         ib_bdy = npckgs(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ii = jpisdt(iseg), jpisft(iseg) - 1
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+      ENDDO
+
+      !  Deal with duplicated points
+      !-----------------------------
+      ! We assign negative indices to duplicated points (to remove them from bdy points to be updated)
+      ! if their distance to the bdy is greater than the other
+      ! If their distance are the same, just keep only one to avoid updating a point twice
+      DO igrd = 1, jpbgrd
+         DO ib_bdy1 = 1, nb_bdy
+            DO ib_bdy2 = 1, nb_bdy
+               IF (ib_bdy1/=ib_bdy2) THEN
+                  DO ib1 = 1, nblendta(igrd,ib_bdy1)
+                     DO ib2 = 1, nblendta(igrd,ib_bdy2)
+                        IF ((nbidta(ib1, igrd, ib_bdy1)==nbidta(ib2, igrd, ib_bdy2)).AND. &
+                        &   (nbjdta(ib1, igrd, ib_bdy1)==nbjdta(ib2, igrd, ib_bdy2))) THEN
+!                           IF ((lwp).AND.(igrd==1)) WRITE(numout,*) ' found coincident point ji, jj:', & 
+!                                                       &              nbidta(ib1, igrd, ib_bdy1),      & 
+!                                                       &              nbjdta(ib2, igrd, ib_bdy2)
+                           ! keep only points with the lowest distance to boundary:
+                           IF (nbrdta(ib1, igrd, ib_bdy1)<nbrdta(ib2, igrd, ib_bdy2)) THEN
+                             nbidta(ib2, igrd, ib_bdy2) =-ib_bdy2
+                             nbjdta(ib2, igrd, ib_bdy2) =-ib_bdy2
+                           ELSEIF (nbrdta(ib1, igrd, ib_bdy1)>nbrdta(ib2, igrd, ib_bdy2)) THEN
+                             nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                             nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                           ! Arbitrary choice if distances are the same:
+                           ELSE
+                             nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                             nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                           ENDIF
+                        END IF
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Work out dimensions of boundary data on each processor
+      ! ------------------------------------------------------
+
+      ! Rather assume that boundary data indices are given on global domain
+      ! TO BE DISCUSSED ?
+!      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2
+!      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1
+!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
+!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1      
+      iwe = mig(1) - 1 + 2         ! if monotasking and no zoom, iw=2
+      ies = mig(1) + nlci-1 - 1  ! if monotasking and no zoom, ie=jpim1
+      iso = mjg(1) - 1 + 2         ! if monotasking and no zoom, is=2
+      ino = mjg(1) + nlcj-1 - 1  ! if monotasking and no zoom, in=jpjm1
+
+      ALLOCATE( nbondi_bdy(nb_bdy))
+      ALLOCATE( nbondj_bdy(nb_bdy))
+      nbondi_bdy(:)=2
+      nbondj_bdy(:)=2
+      ALLOCATE( nbondi_bdy_b(nb_bdy))
+      ALLOCATE( nbondj_bdy_b(nb_bdy))
+      nbondi_bdy_b(:)=2
+      nbondj_bdy_b(:)=2
+
+      ! Work out dimensions of boundary data on each neighbour process
+      IF(nbondi == 0) THEN
+         iw_b(1) = 1 + nimppt(nowe+1)
+         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3
+         is_b(1) = 1 + njmppt(nowe+1)
+         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3
+
+         iw_b(2) = 1 + nimppt(noea+1)
+         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3
+         is_b(2) = 1 + njmppt(noea+1)
+         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3
+      ELSEIF(nbondi == 1) THEN
+         iw_b(1) = 1 + nimppt(nowe+1)
+         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3
+         is_b(1) = 1 + njmppt(nowe+1)
+         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3
+      ELSEIF(nbondi == -1) THEN
+         iw_b(2) = 1 + nimppt(noea+1)
+         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3
+         is_b(2) = 1 + njmppt(noea+1)
+         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3
+      ENDIF
+
+      IF(nbondj == 0) THEN
+         iw_b(3) = 1 + nimppt(noso+1)
+         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3
+         is_b(3) = 1 + njmppt(noso+1)
+         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3
+
+         iw_b(4) = 1 + nimppt(nono+1)
+         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3
+         is_b(4) = 1 + njmppt(nono+1)
+         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3
+      ELSEIF(nbondj == 1) THEN
+         iw_b(3) = 1 + nimppt(noso+1)
+         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3
+         is_b(3) = 1 + njmppt(noso+1)
+         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3
+      ELSEIF(nbondj == -1) THEN
+         iw_b(4) = 1 + nimppt(nono+1)
+         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3
+         is_b(4) = 1 + njmppt(nono+1)
+         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3
+      ENDIF
+
+      DO ib_bdy = 1, nb_bdy
+         DO igrd = 1, jpbgrd
+            icount  = 0
+            icountr = 0
+            idx_bdy(ib_bdy)%nblen(igrd)    = 0
+            idx_bdy(ib_bdy)%nblenrim(igrd) = 0
+            DO ib = 1, nblendta(igrd,ib_bdy)
+               ! check that data is in correct order in file
+               ibm1 = MAX(1,ib-1)
+               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc...
+                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN
+                     CALL ctl_stop('bdy_segs : ERROR : boundary data in file must be defined ', &
+                          &        ' in order of distance from edge nbr A utility for re-ordering ', &
+                          &        ' boundary coordinates and data files exists in the TOOLS/OBC directory')
+                  ENDIF    
+               ENDIF
+               ! check if point is in local domain
+               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN
+                  !
+                  icount = icount  + 1
+                  !
+                  IF( nbrdta(ib,igrd,ib_bdy) == 1 )   icountr = icountr+1
+               ENDIF
+            ENDDO
+            idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc
+            idx_bdy(ib_bdy)%nblen   (igrd) = icount  !: length of boundary data on each proc        
+         ENDDO  ! igrd
+
+         ! Allocate index arrays for this boundary set
+         !--------------------------------------------
+         ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )
+
+         ! Dispatch mapping indices and discrete distances on each processor
+         ! -----------------------------------------------------------------
+
+         com_east  = 0
+         com_west  = 0
+         com_south = 0
+         com_north = 0
+
+         com_east_b  = 0
+         com_west_b  = 0
+         com_south_b = 0
+         com_north_b = 0
+
+         DO igrd = 1, jpbgrd
+            icount  = 0
+            ! Loop on rimwidth to ensure outermost points come first in the local arrays.
+            DO ir=1, nn_rimwidth(ib_bdy)
+               DO ib = 1, nblendta(igrd,ib_bdy)
+                  ! check if point is in local domain and equals ir
+                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   &
+                     & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                     !
+                     icount = icount  + 1
+
+                     ! Rather assume that boundary data indices are given on global domain
+                     ! TO BE DISCUSSED ?
+!                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1
+!                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1
+                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1
+                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1
+                     ! check if point has to be sent
+                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(icount,igrd)
+                     if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then
+                        com_east = 1
+                     elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then
+                        com_west = 1
+                     endif 
+                     if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then
+                        com_south = 1
+                     elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then
+                        com_north = 1
+                     endif 
+                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy)
+                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
+                  ENDIF
+                  ! check if point has to be received from a neighbour
+                  IF(nbondi == 0) THEN
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
+                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_west_b = 1
+                       endif 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
+                       if((com_east_b .ne. 1) .and. (ii == 2)) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_east_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondi == 1) THEN
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
+                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_west_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondi == -1) THEN
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
+                       if((com_east_b .ne. 1) .and. (ii == 2)) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_east_b = 1
+                       endif 
+                     ENDIF
+                  ENDIF
+                  IF(nbondj == 0) THEN
+                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
+                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_north_b = 1 
+                     ENDIF
+                     IF(com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1  &
+                       &.OR. nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_south_b = 1 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
+                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then
+                          com_south_b = 1
+                       endif 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
+                       if((com_north_b .ne. 1) .and. (ij == 2)) then
+                          com_north_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondj == 1) THEN
+                     IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. &
+                       & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_south_b = 1 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
+                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then
+                          com_south_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondj == -1) THEN
+                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
+                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_north_b = 1 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
+                       if((com_north_b .ne. 1) .and. (ij == 2)) then
+                          com_north_b = 1
+                       endif 
+                     ENDIF
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO 
+
+         ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries
+         IF(     (com_east  == 1) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  0
+         ELSEIF( (com_east  == 1) .and. (com_west  == 0) ) THEN   ;   nbondi_bdy(ib_bdy) = -1
+         ELSEIF( (com_east  == 0) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  1
+         ENDIF
+         IF(     (com_north == 1) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  0
+         ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN   ;   nbondj_bdy(ib_bdy) = -1
+         ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  1
+         ENDIF
+
+         ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries
+         IF(     (com_east_b  == 1) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  0
+         ELSEIF( (com_east_b  == 1) .and. (com_west_b  == 0) ) THEN   ;   nbondi_bdy_b(ib_bdy) = -1
+         ELSEIF( (com_east_b  == 0) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  1
+         ENDIF
+         IF(     (com_north_b == 1) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  0
+         ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN   ;   nbondj_bdy_b(ib_bdy) = -1
+         ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  1
+         ENDIF
+
+         ! Compute rim weights for FRS scheme
+         ! ----------------------------------
+         DO igrd = 1, jpbgrd
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
+               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 )      ! tanh formulation
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy))       ! linear
+            END DO
+         END DO 
+
+         ! Compute damping coefficients
+         ! ----------------------------
+         DO igrd = 1, jpbgrd
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
+               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) & 
+               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) & 
+               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+            END DO
+         END DO 
+
+      ENDDO
+
+      ! ------------------------------------------------------
+      ! Initialise masks and find normal/tangential directions
+      ! ------------------------------------------------------
+
+      ! Read global 2D mask at T-points: bdytmask
+      ! -----------------------------------------
+      ! bdytmask = 1  on the computational domain AND on open boundaries
+      !          = 0  elsewhere   
+ 
+      bdytmask(:,:) = ssmask(:,:)
+
+      IF( ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
+         CALL iom_close( inum )
+
+         ! Derive mask on U and V grid from mask on T grid
+         bdyumask(:,:) = 0._wp
+         bdyvmask(:,:) = 0._wp
+         DO ij=1, jpjm1
+            DO ii=1, jpim1
+               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij )
+               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
+            END DO
+         END DO
+         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+
+      ENDIF ! ln_mask_file=.TRUE.
+      
+      IF( .NOT.ln_mask_file ) THEN
+         ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here.
+         bdyumask(:,:) = 0._wp
+         bdyvmask(:,:) = 0._wp
+         DO ij = 1, jpjm1
+            DO ii = 1, jpim1
+               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij )
+               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
+            END DO
+         END DO
+         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+      ENDIF
+
+      ! bdy masks are now set to zero on boundary points:
+      !
+      igrd = 1
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)      
+          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        END DO
+      END DO
+      !
+      igrd = 2
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        END DO
+      END DO
+      !
+      igrd = 3
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        ENDDO
+      ENDDO
+
+      ! For the flagu/flagv calculation below we require a version of fmask without
+      ! the land boundary condition (shlat) included:
+      CALL wrk_alloc(jpi,jpj,  zfmask ) 
+      DO ij = 2, jpjm1
+         DO ii = 2, jpim1
+            zfmask(ii,ij) = tmask(ii,ij  ,1) * tmask(ii+1,ij  ,1)   &
+           &              * tmask(ii,ij+1,1) * tmask(ii+1,ij+1,1)
+         END DO      
+      END DO
+
+      ! Lateral boundary conditions
+      CALL lbc_lnk( zfmask       , 'F', 1. )
+      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+
+      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components
+
+         idx_bdy(ib_bdy)%flagu(:,:) = 0._wp
+         idx_bdy(ib_bdy)%flagv(:,:) = 0._wp
+         icount = 0 
+
+         ! Calculate relationship of U direction to the local orientation of the boundary
+         ! flagu = -1 : u component is normal to the dynamical boundary and its direction is outward
+         ! flagu =  0 : u is tangential
+         ! flagu =  1 : u is normal to the boundary and is direction is inward
+  
+         DO igrd = 1,jpbgrd 
+            SELECT CASE( igrd )
+               CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0
+               CASE( 2 )   ;   pmask => bdytmask(:,:)     ;   i_offset = 1
+               CASE( 3 )   ;   pmask => zfmask  (:,:)     ;   i_offset = 0
+            END SELECT 
+            icount = 0
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)  
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               zefl = pmask(nbi+i_offset-1,nbj)
+               zwfl = pmask(nbi+i_offset,nbj)
+               ! This error check only works if you are using the bdyXmask arrays
+               IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN
+                  icount = icount + 1
+                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj)
+               ELSE
+                  idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl
+               ENDIF
+            END DO
+            IF( icount /= 0 ) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   &
+                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy
+               IF(lwp) WRITE(numout,*) ' ========== '
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ENDIF 
+         END DO
+
+         ! Calculate relationship of V direction to the local orientation of the boundary
+         ! flagv = -1 : v component is normal to the dynamical boundary but its direction is outward
+         ! flagv =  0 : v is tangential
+         ! flagv =  1 : v is normal to the boundary and is direction is inward
+
+         DO igrd = 1, jpbgrd 
+            SELECT CASE( igrd )
+               CASE( 1 )   ;   pmask => vmask (:,:,1)   ;   j_offset = 0
+               CASE( 2 )   ;   pmask => zfmask(:,:)     ;   j_offset = 0
+               CASE( 3 )   ;   pmask => bdytmask        ;   j_offset = 1
+            END SELECT 
+            icount = 0
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)  
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               znfl = pmask(nbi,nbj+j_offset-1)
+               zsfl = pmask(nbi,nbj+j_offset  )
+               ! This error check only works if you are using the bdyXmask arrays
+               IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN
+                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj)
+                  icount = icount + 1
+               ELSE
+                  idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl
+               END IF
+            END DO
+            IF( icount /= 0 ) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   &
+                  ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy
+               IF(lwp) WRITE(numout,*) ' ========== '
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ENDIF 
+         END DO
+         !
+      END DO
+
+      ! Compute total lateral surface for volume correction:
+      ! ----------------------------------------------------
+      ! JC: this must be done at each time step with non-linear free surface
+      bdysurftot = 0._wp 
+      IF( ln_vol ) THEN  
+         igrd = 2      ! Lateral surface at U-points
+         DO ib_bdy = 1, nb_bdy
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd)
+               bdysurftot = bdysurftot + hu_n   (nbi  , nbj)                           &
+                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) &
+                  &                    * tmask_i(nbi  , nbj)                           &
+                  &                    * tmask_i(nbi+1, nbj)                   
+            END DO
+         END DO
+
+         igrd=3 ! Add lateral surface at V-points
+         DO ib_bdy = 1, nb_bdy
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd)
+               bdysurftot = bdysurftot + hv_n   (nbi, nbj  )                           &
+                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) &
+                  &                    * tmask_i(nbi, nbj  )                           &
+                  &                    * tmask_i(nbi, nbj+1)
+            END DO
+         END DO
+         !
+         IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain
+      END IF   
+      !
+      ! Tidy up
+      !--------
+      IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta )
+      !
+      CALL wrk_dealloc(jpi,jpj,   zfmask ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_segs')
+      !
+   END SUBROUTINE bdy_segs
+
+   SUBROUTINE bdy_ctl_seg
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_ctl_seg  ***
+      !!
+      !! ** Purpose :   Check straight open boundary segments location
+      !!
+      !! ** Method  :   - Look for open boundary corners
+      !!                - Check that segments start or end on land 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ib, ib1, ib2, ji ,jj, itest  
+      INTEGER, DIMENSION(jp_nseg,2) :: icorne, icornw, icornn, icorns  
+      REAL(wp), DIMENSION(2) ::   ztestmask
+      !!----------------------------------------------------------------------
+      !
+      IF (lwp) WRITE(numout,*) ' '
+      IF (lwp) WRITE(numout,*) 'bdy_ctl_seg: Check analytical segments'
+      IF (lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
+      IF(lwp) WRITE(numout,*) 'Number of east  segments     : ', nbdysege
+      IF(lwp) WRITE(numout,*) 'Number of west  segments     : ', nbdysegw
+      IF(lwp) WRITE(numout,*) 'Number of north segments     : ', nbdysegn
+      IF(lwp) WRITE(numout,*) 'Number of south segments     : ', nbdysegs
+      ! 1. Check bounds
+      !----------------
+      DO ib = 1, nbdysegn
+         IF (lwp) WRITE(numout,*) '**check north seg bounds pckg: ', npckgn(ib)
+         IF ((jpjnob(ib).ge.jpjglo-1).or.& 
+            &(jpjnob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpindt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
+         IF (jpinft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' )
+      END DO
+      !
+      DO ib = 1, nbdysegs
+         IF (lwp) WRITE(numout,*) '**check south seg bounds pckg: ', npckgs(ib)
+         IF ((jpjsob(ib).ge.jpjglo-1).or.& 
+            &(jpjsob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpisdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
+         IF (jpisft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' )
+      END DO
+      !
+      DO ib = 1, nbdysege
+         IF (lwp) WRITE(numout,*) '**check east  seg bounds pckg: ', npckge(ib)
+         IF ((jpieob(ib).ge.jpiglo-1).or.& 
+            &(jpieob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpjedt(ib).lt.1     )     CALL ctl_stop( 'Start index out of domain' )!ACC
+         IF (jpjeft(ib).gt.jpjglo)     CALL ctl_stop( 'End index out of domain' )!ACC
+      END DO
+      !
+      DO ib = 1, nbdysegw
+         IF (lwp) WRITE(numout,*) '**check west  seg bounds pckg: ', npckgw(ib)
+         IF ((jpiwob(ib).ge.jpiglo-1).or.& 
+            &(jpiwob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpjwdt(ib).lt.1     )     CALL ctl_stop( 'Start index out of domain' ) !ACC
+         IF (jpjwft(ib).gt.jpjglo)     CALL ctl_stop( 'End index out of domain' ) !ACC
+      ENDDO
+      !
+      !      
+      ! 2. Look for segment crossings
+      !------------------------------ 
+      IF (lwp) WRITE(numout,*) '**Look for segments corners  :'
+      !
+      itest = 0 ! corner number
+      !
+      ! flag to detect if start or end of open boundary belongs to a corner
+      ! if not (=0), it must be on land.
+      ! if a corner is detected, save bdy package number for further tests
+      icorne(:,:)=0. ; icornw(:,:)=0. ; icornn(:,:)=0. ; icorns(:,:)=0.
+      ! South/West crossings
+      IF ((nbdysegw > 0).AND.(nbdysegs > 0)) THEN
+         DO ib1 = 1, nbdysegw        
+            DO ib2 = 1, nbdysegs
+               IF (( jpisdt(ib2)<=jpiwob(ib1)).AND. &
+                &  ( jpisft(ib2)>=jpiwob(ib1)).AND. &
+                &  ( jpjwdt(ib1)<=jpjsob(ib2)).AND. &
+                &  ( jpjwft(ib1)>=jpjsob(ib2))) THEN
+                  IF ((jpjwdt(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpiwob(ib1))) THEN 
+                     ! We have a possible South-West corner                      
+!                     WRITE(numout,*) ' Found a South-West corner at (i,j): ', jpisdt(ib2), jpjwdt(ib1) 
+!                     WRITE(numout,*) ' between segments: ', npckgw(ib1), npckgs(ib2)
+                     icornw(ib1,1) = npckgs(ib2)
+                     icorns(ib2,1) = npckgw(ib1)
+                  ELSEIF ((jpisft(ib2)==jpiwob(ib1)).AND.(jpjwft(ib1)==jpjsob(ib2))) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpisft(ib2), jpjwft(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with West segment: ',npckgw(ib1), & 
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check South and West Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1) , &
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop+1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! South/East crossings
+      IF ((nbdysege > 0).AND.(nbdysegs > 0)) THEN
+         DO ib1 = 1, nbdysege
+            DO ib2 = 1, nbdysegs
+               IF (( jpisdt(ib2)<=jpieob(ib1)+1).AND. &
+                &  ( jpisft(ib2)>=jpieob(ib1)+1).AND. &
+                &  ( jpjedt(ib1)<=jpjsob(ib2)  ).AND. &
+                &  ( jpjeft(ib1)>=jpjsob(ib2)  )) THEN
+                  IF ((jpjedt(ib1)==jpjsob(ib2)).AND.(jpisft(ib2)==jpieob(ib1)+1)) THEN
+                     ! We have a possible South-East corner 
+!                     WRITE(numout,*) ' Found a South-East corner at (i,j): ', jpisft(ib2), jpjedt(ib1) 
+!                     WRITE(numout,*) ' between segments: ', npckge(ib1), npckgs(ib2)
+                     icorne(ib1,1) = npckgs(ib2)
+                     icorns(ib2,2) = npckge(ib1)
+                  ELSEIF ((jpjeft(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpieob(ib1)+1)) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpisdt(ib2), jpjeft(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check South and East Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! North/West crossings
+      IF ((nbdysegn > 0).AND.(nbdysegw > 0)) THEN
+         DO ib1 = 1, nbdysegw        
+            DO ib2 = 1, nbdysegn
+               IF (( jpindt(ib2)<=jpiwob(ib1)  ).AND. &
+                &  ( jpinft(ib2)>=jpiwob(ib1)  ).AND. &
+                &  ( jpjwdt(ib1)<=jpjnob(ib2)+1).AND. &
+                &  ( jpjwft(ib1)>=jpjnob(ib2)+1)) THEN
+                  IF ((jpjwft(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpiwob(ib1))) THEN
+                     ! We have a possible North-West corner 
+!                     WRITE(numout,*) ' Found a North-West corner at (i,j): ', jpindt(ib2), jpjwft(ib1) 
+!                     WRITE(numout,*) ' between segments: ', npckgw(ib1), npckgn(ib2)
+                     icornw(ib1,2) = npckgn(ib2)
+                     icornn(ib2,1) = npckgw(ib1)
+                  ELSEIF ((jpjwdt(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpiwob(ib1))) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpinft(ib2), jpjwdt(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with West segment: ',npckgw(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check North and West Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! North/East crossings
+      IF ((nbdysegn > 0).AND.(nbdysege > 0)) THEN
+         DO ib1 = 1, nbdysege        
+            DO ib2 = 1, nbdysegn
+               IF (( jpindt(ib2)<=jpieob(ib1)+1).AND. &
+                &  ( jpinft(ib2)>=jpieob(ib1)+1).AND. &
+                &  ( jpjedt(ib1)<=jpjnob(ib2)+1).AND. &
+                &  ( jpjeft(ib1)>=jpjnob(ib2)+1)) THEN
+                  IF ((jpjeft(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpieob(ib1)+1)) THEN
+                     ! We have a possible North-East corner 
+!                     WRITE(numout,*) ' Found a North-East corner at (i,j): ', jpinft(ib2), jpjeft(ib1)
+!                     WRITE(numout,*) ' between segments: ', npckge(ib1), npckgn(ib2)
+                     icorne(ib1,2) = npckgn(ib2)
+                     icornn(ib2,2) = npckge(ib1)
+                  ELSEIF ((jpjedt(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpieob(ib1)+1)) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpindt(ib2), jpjedt(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check North and East Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! 3. Check if segment extremities are on land
+      !-------------------------------------------- 
+      !
+      ! West segments
+      DO ib = 1, nbdysegw
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 
+               &  ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 
+               &  ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF (ztestmask(1)==1) THEN 
+            IF (icornw(ib,1)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
+               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1))
+               itest=itest+1
+            ENDIF
+         ENDIF
+         IF (ztestmask(2)==1) THEN
+            IF (icornw(ib,2)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
+               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2))
+               itest=itest+1
+            ENDIF
+         ENDIF
+      END DO
+      !
+      ! East segments
+      DO ib = 1, nbdysege
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 
+               &  ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 
+               &  ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF (ztestmask(1)==1) THEN
+            IF (icorne(ib,1)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1 
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
+               CALL bdy_ctl_corn(npckge(ib), icorne(ib,1))
+               itest=itest+1
+            ENDIF
+         ENDIF
+         IF (ztestmask(2)==1) THEN
+            IF (icorne(ib,2)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
+               CALL bdy_ctl_corn(npckge(ib), icorne(ib,2))
+               itest=itest+1
+            ENDIF
+         ENDIF
+      END DO
+      !
+      ! South segments
+      DO ib = 1, nbdysegs
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 
+               &  ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 
+               &  ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+         IF ((ztestmask(2)==1).AND.(icorns(ib,2)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+      END DO
+      !
+      ! North segments
+      DO ib = 1, nbdysegn
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 
+               &  ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 
+               &  ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not start on land'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+         IF ((ztestmask(2)==1).AND.(icornn(ib,2)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not end on land'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+      END DO
+      !
+      IF ((itest==0).AND.(lwp)) WRITE(numout,*) 'NO open boundary corner found'
+      !
+      ! Other tests TBD: 
+      ! segments completly on land
+      ! optimized open boundary array length according to landmask
+      ! Nudging layers that overlap with interior domain
+      !
+   END SUBROUTINE bdy_ctl_seg
+
+   SUBROUTINE bdy_ctl_corn( ib1, ib2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_ctl_corn  ***
+      !!
+      !! ** Purpose :   Check numerical schemes consistency between
+      !!                segments having a common corner
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::   ib1, ib2
+      INTEGER :: itest
+      !!----------------------------------------------------------------------
+      itest = 0
+
+      IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) )   itest = itest + 1
+      IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) )   itest = itest + 1
+      IF( cn_tra  (ib1) /= cn_tra  (ib2) )   itest = itest + 1
+      !
+      IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) )   itest = itest + 1
+      IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) )   itest = itest + 1
+      IF( nn_tra_dta  (ib1) /= nn_tra_dta  (ib2) )   itest = itest + 1
+      !
+      IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) )   itest = itest + 1   
+      !
+      IF( itest>0 ) THEN
+         IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2
+         IF(lwp) WRITE(numout,*) ' ==========  have different open bdy schemes'                                                  
+         IF(lwp) WRITE(numout,*)
+         nstop = nstop + 1
+      ENDIF
+      !
+   END SUBROUTINE bdy_ctl_corn
+
+   !!=================================================================================
+END MODULE bdyini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90	(revision 8732)
@@ -0,0 +1,695 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dom_init      : initialize the space and time domain
+   !!   dom_glo       : initialize global domain <--> local domain indices
+   !!   dom_nam       : read and contral domain namelists
+   !!   dom_ctl       : control print for the ocean domain
+   !!   domain_cfg    : read the global domain size in domain configuration file
+   !!   cfg_write     : create the domain configuration file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! domain: ocean
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trc_oce        ! shared ocean & passive tracers variab
+   USE phycst         ! physical constants
+   USE usrdef_closea  ! closed seas
+   USE domhgr         ! domain: set the horizontal mesh
+   USE domzgr         ! domain: set the vertical mesh
+   USE dommsk         ! domain: set the mask system
+   USE domwri         ! domain: write the meshmask file
+   USE domvvl         ! variable volume
+   USE c1d            ! 1D configuration
+   USE domc1d         ! 1D configuration: column location
+   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
+   USE wet_dry        ! wetting and drying
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init     ! called by nemogcm.F90
+   PUBLIC   domain_cfg   ! called by nemogcm.F90
+
+   !!-------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: domain.F90 7587 2017-01-20 15:17:56Z acc $
+   !! 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_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - dom_wri: create the meshmask file if nn_msh=1
+      !!              - 1D configuration, move Coriolis, u and v at T-point
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
+      INTEGER ::   iconf = 0    ! local integers
+      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
+      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
+      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_init')
+      !
+      IF(lwp) THEN         ! Ocean domain Parameters (control print)
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+         !
+         WRITE(numout,*)     '   Domain info'
+         WRITE(numout,*)     '      dimension of model:'
+         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
+         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
+         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
+         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
+         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
+         WRITE(numout,*)     '      mpp local domain info (mpp):'
+         WRITE(numout,*)     '              jpni    : ', jpni, '   jpreci  : ', jpreci
+         WRITE(numout,*)     '              jpnj    : ', jpnj, '   jprecj  : ', jprecj
+         WRITE(numout,*)     '              jpnij   : ', jpnij
+         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
+         SELECT CASE ( jperio )
+         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
+         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
+         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
+         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
+         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
+         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
+         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
+         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south (jpnij=1 only))'
+         CASE DEFAULT
+            CALL ctl_stop( 'jperio is out of range' )
+         END SELECT
+         WRITE(numout,*)     '      Ocean model configuration used:'
+         WRITE(numout,*)     '              cn_cfg = ', cn_cfg
+         WRITE(numout,*)     '              nn_cfg = ', nn_cfg
+      ENDIF
+      !
+      !      
+!!gm  This should be removed with the new configuration interface
+      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d )
+!!gm end
+      !
+      !           !==  Reference coordinate system  ==!
+      !
+      CALL dom_glo                     ! global domain versus local domain
+      CALL dom_nam                     ! read namelist ( namrun, namdom )
+      CALL dom_clo( cn_cfg, nn_cfg )   ! Closed seas and lake
+      CALL dom_hgr                     ! Horizontal mesh
+      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
+      IF( nn_closea == 0 )   CALL clo_bat( ik_top, ik_bot )    !==  remove closed seas or lakes  ==!
+      CALL dom_msk( ik_top, ik_bot )   ! Masks
+      !
+      DO jj = 1, jpj                   ! depth of the iceshelves
+         DO ji = 1, jpi
+            ik = mikt(ji,jj)
+            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
+         END DO
+      END DO
+      !
+      ht_0(:,:) = 0._wp  ! Reference ocean thickness
+      hu_0(:,:) = 0._wp
+      hv_0(:,:) = 0._wp
+      DO jk = 1, jpk
+         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
+         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
+         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !
+      !           !==  time varying part of coordinate system  ==!
+      !
+      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
+      !
+         !       before        !          now          !       after         !
+            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
+            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
+                                   gde3w_n = gde3w_0   !        ---          !
+         !                                                                  
+              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
+              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
+              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
+                                     e3f_n =   e3f_0   !        ---          !
+              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
+             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
+             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
+         !
+         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
+         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
+         !
+         !        before       !          now          !       after         !
+                                      ht_n =    ht_0   !                     ! water column thickness
+               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   ! 
+               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
+            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
+            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
+         !
+         !
+      ELSE                       != time varying : initialize before/now/after variables
+         !
+         IF( .NOT.l_offline )  CALL dom_vvl_init 
+         !
+      ENDIF
+      !
+      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
+      !
+      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
+      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
+      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
+      !
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
+         WRITE(numout,*) 
+      ENDIF
+      !
+      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
+      !
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization of global domain <--> local domain indices
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
+      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
+      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop argument
+      !!----------------------------------------------------------------------
+      !
+      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
+        mig(ji) = ji + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + njmpp - 1
+      END DO
+      !                              ! global domain indices ==> local domain indices
+      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
+      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
+      DO ji = 1, jpiglo
+        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
+        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
+      END DO
+      DO jj = 1, jpjglo
+        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
+        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
+      END DO
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
+         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
+         IF( nn_print >= 1 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global i-index domain'
+            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  i-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global j-index domain'
+            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  j-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
+         ENDIF
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+      !
+   END SUBROUTINE dom_glo
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl
+      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
+         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
+         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
+         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
+         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,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         IF( ln_rst_list ) THEN
+            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
+         ELSE
+            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         ENDIF
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
+      ENDIF
+
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+      neuler = nn_euler
+      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
+         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
+         CALL ctl_warn( ctmp1 )
+         neuler = 0
+      ENDIF
+      !                             ! 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
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
+         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea
+         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,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
+         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
+         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
+      ENDIF
+      
+      call flush( numout )
+      !
+!     !          ! conversion DOCTOR names into model names (this should disappear soon)
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
+      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
+      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namnc4 )
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc   ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         !
+         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read the domain size in domain configuration file
+      !!
+      !! ** Method  :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   inum, ii   ! local integer
+      REAL(wp) ::   zorca_res                     ! local scalars
+      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
+      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
+      !
+      CALL iom_open( cn_domcfg, inum )
+      !
+      !                                   !- ORCA family specificity
+      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
+         !
+         cd_cfg = 'ORCA'
+         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
+         !
+         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
+         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
+         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
+         !
+      ELSE                                !- cd_cfg & k_cfg are not used
+         cd_cfg = 'UNKNOWN'
+         kk_cfg = -9999999
+                                          !- or they may be present as global attributes 
+                                          !- (netcdf only)  
+         IF( iom_file(inum)%iolib == jpnf90 ) THEN
+            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
+            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
+            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
+            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
+         ENDIF
+         !
+      ENDIF
+      !
+      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
+      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
+      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
+      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
+      CALL iom_close( inum )
+      !
+      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
+      !        
+   END SUBROUTINE domain_cfg
+   
+   
+   SUBROUTINE cfg_write
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE cfg_write  ***
+      !!                   
+      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which 
+      !!              contains all the ocean domain informations required to 
+      !!              define an ocean configuration.
+      !!
+      !! ** Method  :   Write in a file all the arrays required to set up an
+      !!              ocean configuration.
+      !!
+      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal 
+      !!                       mesh, Coriolis parameter, and vertical scale factors
+      !!                    NB: also contain ORCA family information
+      !!----------------------------------------------------------------------
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      INTEGER           ::   inum     ! local units
+      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                       ! ============================= !
+      !                       !  create 'domcfg_out.nc' file  !
+      !                       ! ============================= !
+      !         
+      clnam = 'domcfg_out'  ! filename (configuration information)
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
+      
+      !
+      !                             !==  ORCA family specificities  ==!
+      IF( cn_cfg == "ORCA" ) THEN
+         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
+      ENDIF
+      !
+      !                             !==  global domain size  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
+      !
+      !                             !==  domain characteristics  ==!
+      !
+      !                                   ! lateral boundary of the global domain
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !
+      !                                   ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !
+      !                                   ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+      !
+      !                             !==  horizontal mesh  !
+      !
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
+      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
+      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
+      !
+      !                             !==  vertical mesh  ==!
+      !                                                     
+      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
+      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
+      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
+      !                                         
+      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
+      !
+      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
+      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
+      !
+      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
+         CALL dom_stiff( z2d )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
+      ENDIF
+      !
+      IF( ln_wd ) THEN              ! wetting and drying domain
+         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
+         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
+      ENDIF
+      !
+      ! Add some global attributes ( netcdf only )
+      IF( iom_file(inum)%iolib == jpnf90 ) THEN
+         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
+         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
+      ENDIF
+      !
+      !                                ! ============================
+      !                                !        close the files 
+      !                                ! ============================
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE cfg_write
+
+   !!======================================================================
+END MODULE domain
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_hgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_hgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_hgr.F90	(revision 8732)
@@ -0,0 +1,114 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                       ***  MODULE usrdef_hgr   ***
+   !!
+   !!                  ===  WAD_TEST_CASES configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  NEMO  ! 2016-08  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr    : initialize the horizontal mesh for WAD_TEST_CASES configuration
+   !!----------------------------------------------------------------------
+   USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE usrdef_nam, ONLY: rn_dx   ! horizontal resolution in meters
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called by domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!                WAD_TEST_CASES configuration : uniform grid spacing (rn_dx)
+      !!                without Coriolis force (f=0)
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zfact      ! local scalars
+      !!-------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('usr_def_hgr')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : WAD_TEST_CASES configuration basin'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   uniform grid spacing WITHOUT Coriolis force (f=0)'
+      !
+      !                       !==  grid point position  ==!   (in kilometers)
+      zfact = rn_dx * 1.e-3         ! conversion in km
+      DO jj = 1, jpj
+         DO ji = 1, jpi             ! longitude
+            plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )  
+            plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  )
+            plamv(ji,jj) = plamt(ji,jj)
+            plamf(ji,jj) = plamu(ji,jj)
+            !                       ! latitude
+            pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  )
+            pphiu(ji,jj) = pphit(ji,jj)
+            pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  )
+            pphif(ji,jj) = pphiv(ji,jj)
+         END DO
+      END DO
+      !
+      !                       !==  Horizontal scale factors  ==!   (in meters) 
+      pe1t(:,:) = rn_dx   ;   pe2t(:,:) = rn_dx
+      pe1u(:,:) = rn_dx   ;   pe2u(:,:) = rn_dx
+      pe1v(:,:) = rn_dx   ;   pe2v(:,:) = rn_dx
+      pe1f(:,:) = rn_dx   ;   pe2f(:,:) = rn_dx
+      !
+      !                             ! NO reduction of grid size in some straits 
+      ke1e2u_v = 0                  !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp           !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp           !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 1                       !  indicate not to compute Coriolis parameter afterward
+      !
+      pff_f(:,:) = 0._wp            ! here No earth rotation: f=0
+      pff_t(:,:) = 0._wp
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('usr_def_hgr')
+      !
+   END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_istate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_istate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_istate.F90	(revision 8732)
@@ -0,0 +1,185 @@
+MODULE usrdef_istate
+   !!======================================================================
+   !!                     ***  MODULE usrdef_istate   ***
+   !!
+   !!                  ===  WAD_TEST_CASES configuration  ===
+   !!
+   !! User defined : set the initial state of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  usr_def_istate : initial state in Temperature and salinity
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean space and time domain
+   USE dom_oce , ONLY : mi0, mig, mjg, glamt, gphit, ht_0
+   USE phycst         ! physical constants
+   USE wet_dry        ! Wetting and drying
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_istate   ! called by istate.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers
+      !!                Here WAD_TEST_CASES configuration 
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity   field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+      INTEGER  ::   ji, jj            ! dummy loop indices
+      REAL(wp) ::   zi, zj
+      !
+      INTEGER  ::   jk     ! dummy loop indices
+      REAL(wp) ::   zdam   ! location of dam [Km]
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD_TEST_CASES configuration, analytical definition of initial state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with a constant temperature                    '
+      IF(lwp) WRITE(numout,*) '                 and  constant salinity (not used as rho=F(T) '
+      !
+      !
+      pu  (:,:,:) = 0._wp        ! ocean at rest
+      pv  (:,:,:) = 0._wp
+      pssh(:,:)   = 0._wp
+      !
+      !                          ! T & S profiles
+      pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:)
+      !
+      pts(:,:,:,jp_sal) = 35._wp * ptmask(:,:,:)
+      !!----------------------------------------------------------------------
+      !
+      !!----------------------------------------------------------------------
+      !
+      ! Uniform T & S in most test cases
+      pts(:,:,:,jp_tem) = 10._wp
+      pts(:,:,:,jp_sal) = 35._wp
+      SELECT CASE ( nn_cfg ) 
+         !                                        ! ====================
+         CASE ( 1 )                               ! WAD 1 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
+            end do
+            !                                     ! ====================
+         CASE ( 2, 8 )                            ! WAD 2 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
+            end do
+            !                                     ! ====================
+         CASE ( 3 )                               ! WAD 3 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
+            end do
+
+            !
+            !                                     ! ====================
+         CASE ( 4 )                               ! WAD 4 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope' 
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            DO ji = 1, jpi
+               zi = MAX(1.0-((glamt(ji,1)-25._wp)**2)/400.0, 0.0 )
+               DO jj = 1, jpj
+                  zj = MAX(1.0-((gphit(1,jj)-17._wp)**2)/144.0, 0.0 )
+                  pssh(ji,jj) = -2.5_wp + 5.4_wp*zi*zj
+               END DO
+            END DO
+
+            !
+            !                                    ! ===========================
+         CASE ( 5, 7 )                           ! WAD 5 and 7 configurations
+            !                                    ! ===========================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)
+            end do
+
+            !
+            !                                     ! ====================
+         CASE ( 6 )                               ! WAD 6 configuration
+            !                                     ! ====================
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge' 
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            do ji = 1,jpi
+             pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1)
+            end do
+            !
+            do ji = mi0(jpiglo/2), mi0(jpiglo)
+             pts(ji,:,:,jp_sal) = 30._wp
+             pssh(ji,:) = -0.1*ptmask(ji,:,1)
+            end do
+            !
+            !
+            !                                    ! ===========================
+         CASE DEFAULT                            ! NONE existing configuration
+            !                                    ! ===========================
+            WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'
+            !
+            CALL ctl_stop( ctmp1 )
+            !
+      END SELECT
+      !
+      ! Apply minimum wetdepth criterion
+      !
+      do jj = 1,jpj
+         do ji = 1,jpi
+            IF( ht_wd(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN
+               pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_wd(ji,jj) )
+            ENDIF
+         end do
+      end do
+      !
+   END SUBROUTINE usr_def_istate
+
+   !!======================================================================
+END MODULE usrdef_istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_nam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_nam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_nam.F90	(revision 8732)
@@ -0,0 +1,105 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                       ***  MODULE usrdef_nam  ***
+   !!
+   !!                  ===  WAD_TEST_CASES configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  NEMO ! 2016-03  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called by nemogcm.F90
+
+   !                              !!* namusr_def namelist *!!
+   REAL(wp), PUBLIC ::   rn_dx     ! resolution in meters defining the horizontal domain size
+   REAL(wp), PUBLIC ::   rn_dz     ! resolution in meters defining the vertical   domain size
+   INTEGER , PUBLIC :: nn_wad_test ! resolution in meters defining the vertical   domain size
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here WAD_TEST_CASES configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   ios, ii   ! Local integer
+      !!
+      NAMELIST/namusr_def/ rn_dx, rn_dz, nn_wad_test
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      !
+      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. )
+      !
+      WRITE( ldnam(:), namusr_def )
+      !
+      !
+      cd_cfg = 'wad'      ! name & resolution (not used)
+      nn_cfg = nn_wad_test
+      kk_cfg = nn_wad_test
+      !
+      ! Global Domain size:  WAD_TEST_CASES domain is 52 km x 34 km x 10 m
+      kpi = INT(  50.e3 / rn_dx ) + 2
+      kpj = INT(  32.e3 / rn_dx ) + 2
+      kpk = INT(  10.  / rn_dz ) + 1
+      !
+      !                             ! control print
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                 ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist namusr_def : WAD_TEST_CASES test case'                             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      horizontal resolution                    rn_dx  = ', rn_dx, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters'   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      WAD_TEST_CASES domain = 52 km  x  34 km x 10 m'                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         resulting global domain size :        jpiglo = ', kpi                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpjglo = ', kpj                ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '                                               jpkglo = ', kpk                ;   ii = ii + 1
+      !
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 0                    ! WAD_TEST_CASES configuration : closed domain
+      IF( nn_wad_test == 8 ) kperio = 7 ! North-South cyclic test
+      !
+      WRITE(ldtxt(ii),*) '   '                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Lateral boundary condition of the global domain'                           ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      closed                                   jperio = ', kperio             ;   ii = ii + 1
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_sbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_sbc.F90	(revision 8732)
@@ -0,0 +1,86 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                       ***  MODULE usrdef_sbc  ***
+   !! 
+   !!                  ===  WAD_TEST_CASES configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usrdef_sbc     : user defined surface bounday conditions in WAD_TEST_CASES case
+   !!----------------------------------------------------------------------
+   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 in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usr_def_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   all 0 fields, for WAD_TEST_CASES case
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)' usr_sbc : WAD_TEST_CASES case: NO surface forcing'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0'
+         !
+         utau(:,:) = 0._wp
+         vtau(:,:) = 0._wp
+         taum(:,:) = 0._wp
+         wndm(:,:) = 0._wp
+         !
+         emp (:,:) = 0._wp
+         sfx (:,:) = 0._wp
+         qns (:,:) = 0._wp
+         qsr (:,:) = 0._wp
+         !         
+      ENDIF
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/usrdef_zgr.F90	(revision 8732)
@@ -0,0 +1,394 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                   ***  MODULE  usrdef_zgr  ***
+   !!
+   !!                   ===  WAD_TEST_CASES case  ===
+   !!
+   !! Ocean domain : user defined vertical coordinate system 
+   !!======================================================================
+   !! History :  4.0  ! 2016-08  (G. Madec, S. Flavoni)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system (required)
+   !!       zgr_z1d   : reference 1D z-coordinate 
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce ,  ONLY: ln_zco, ln_zps, ln_sco   ! ocean space and time domain
+   USE dom_oce ,  ONLY: mi0, mi1, nimpp, njmpp,  &
+                      & mj0, mj1, glamt, gphit   ! ocean space and time domain
+   USE usrdef_nam     ! User defined : namelist variables
+   USE wet_dry ,  ONLY: rn_wdmin1, rn_wdmin2, rn_wdld, ht_wd
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_zgr   ! called by domzgr.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v , pe3f ,               &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw,                      &   !     -      -      -
+      &                    k_top  , k_bot    )                             ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   ji, jj, jk        ! dummy indices
+      INTEGER  ::   ik                ! local integers
+      REAL(wp) ::   zfact, z1_jpkm1   ! local scalar
+      REAL(wp) ::   ze3min            ! local scalar
+      REAL(wp) ::   zi, zj, zbathy    ! local scalar
+      REAL(wp) ::   ztmpu, ztmpv, ztmpf, ztmpu1, ztmpv1, ztmpf1, zwet
+      REAL(wp), DIMENSION(jpi,jpj) ::   zht, zhu, zhv, z2d   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : WAD_TEST_CASES configuration (s-coordinate closed box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ! set in usrdef_nam.F90 by reading the namusr_def namelist only ln_zco
+      ln_zco    = .FALSE.      ! z-partial-step coordinate
+      ln_zps    = .FALSE.      ! z-partial-step coordinate
+      ln_sco    = .TRUE.       ! s-coordinate
+      ld_isfcav = .FALSE.      ! ISF Ice Shelves Flag
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      !
+      !                       !==  UNmasked meter bathymetry  ==!
+      !
+!
+      zbathy=10.0
+      IF( cn_cfg == 'wad' ) THEN
+         SELECT CASE ( nn_cfg )
+            !                                        ! ====================
+            CASE ( 1 )                               ! WAD 1 configuration
+               !                                     ! ====================
+               !
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'usr_def_zgr (WAD) : Closed box with EW linear bottom slope'
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+               !
+               zht = 1.5_wp
+               DO ji = 1, jpi
+                 zi = MIN((glamt(ji,1) - 10.0)/40.0, 1.0 )
+                 zht(ji,:) = MAX(zbathy*zi, -2.0) 
+               END DO
+               zht(mi0(1):mi1(1),:) = -4._wp
+               zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+               zht(:,mj0(1):mj1(1)) = -4._wp
+               zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+               !                                     ! ====================
+            CASE ( 2, 3, 8 )                         ! WAD 2 or 3  configuration
+               !                                     ! ====================
+               !
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'usr_def_zgr (WAD) : Parobolic EW channel'
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+               !
+               DO ji = 1, jpi
+                 zi = MAX(1.0-((glamt(ji,1)-25.0)**2)/484.0, -0.3 )
+                 zht(ji,:) = MAX(zbathy*zi, -2.0)
+               END DO
+               zht(mi0(1):mi1(1),:) = -4._wp
+               zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+               IF( nn_cfg /= 8 ) THEN
+                  zht(:,mj0(1):mj1(1)) = -4._wp
+                  zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+               ENDIF
+               !                                     ! ====================
+            CASE ( 4 )                               ! WAD 4 configuration
+               !                                     ! ====================
+               !
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'usr_def_zgr (WAD) : Parobolic bowl'
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+               !
+               DO ji = 1, jpi
+                 zi = MAX(1.0-((glamt(ji,1)-25.0)**2)/484.0, -2.0 )
+               DO jj = 1, jpj
+                 zj = MAX(1.0-((gphit(1,jj)-17.0)**2)/196.0, -2.0 )
+                 zht(ji,jj) = MAX(zbathy*zi*zj, -2.0)
+               END DO
+               END DO
+               zht(mi0(1):mi1(1),:) = -4._wp
+               zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+               zht(:,mj0(1):mj1(1)) = -4._wp
+               zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+               !                                    ! ===========================
+            CASE ( 5 )                              ! WAD 5 configuration
+               !                                    ! ====================
+               !
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'usr_def_zgr (WAD) : Double slope with shelf'
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+               !
+               DO ji = 1, jpi
+                 zi = MIN(glamt(ji,1)/45.0, 1.0 )
+                 zht(ji,:) = MAX(zbathy*zi, -2.0)
+                 IF( glamt(ji,1) >= 46.0 ) THEN
+                   zht(ji,:) = 10.0
+                 ELSE IF( glamt(ji,1) >= 20.0 .AND. glamt(ji,1) < 46.0 ) THEN
+                   zi = 7.5/25.
+                   zht(ji,:) = MAX(10. - zi*(47.-glamt(ji,1)),2.5)
+                 ELSE IF( glamt(ji,1) >= 15.0 .AND. glamt(ji,1) < 20.0 ) THEN
+                   zht(ji,:) = 2.5
+                 ELSE IF( glamt(ji,1) >= 4.0 .AND. glamt(ji,1) < 15.0 ) THEN
+                   zi = 4.5/11.0
+                   zht(ji,:) = MAX(2.5 - zi*(16.0-glamt(ji,1)), -2.0)
+                 ELSE IF( glamt(ji,1) >= 0.0 .AND. glamt(ji,1) < 4.0 ) THEN
+                   zht(ji,:) = -2.0
+                 ENDIF
+               END DO
+               !                                    ! ===========================
+               zht(mi0(1):mi1(1),:) = -4._wp
+               zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+               zht(:,mj0(1):mj1(1)) = -4._wp
+               zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+               !                                    ! ===========================
+            CASE ( 6 )                              ! WAD 6 configuration
+               !                                    ! ====================
+               !
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'usr_def_zgr (WAD) : Parabolic channel with gaussian ridge'
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+               !
+               DO ji = 1, jpi
+                 zi = MAX(1.0-((glamt(ji,1)-25.0)**2)/484.0, -2.0 )
+                 zj = 1.075*MAX(EXP(-1.0*((glamt(ji,1)-25.0)**2)/32.0) , 0.0 )
+                 zht(ji,:) = MAX(zbathy*(zi-zj), -2.0)
+               END DO
+               zht(mi0(1):mi1(1),:) = -4._wp
+               zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+               zht(:,mj0(1):mj1(1)) = -4._wp
+               zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+               !                                    ! ===========================
+            CASE ( 7 )                              ! WAD 7 configuration
+               !                                    ! ====================
+               !
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'usr_def_zgr (WAD) : Double slope with open boundary'
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+               !
+               DO ji = 1, jpi
+                 zi = MIN(glamt(ji,1)/45.0, 1.0 )
+                 zht(ji,:) = MAX(zbathy*zi, -2.0)
+                 IF( glamt(ji,1) >= 46.0 ) THEN
+                   zht(ji,:) = 10.0
+                 ELSE IF( glamt(ji,1) >= 20.0 .AND. glamt(ji,1) < 46.0 ) THEN
+                   zi = 7.5/25.
+                   zht(ji,:) = MAX(10. - zi*(47.-glamt(ji,1)),2.5)
+                 ELSE IF( glamt(ji,1) >= 15.0 .AND. glamt(ji,1) < 20.0 ) THEN
+                   zht(ji,:) = 2.5
+                 ELSE IF( glamt(ji,1) >= 4.0 .AND. glamt(ji,1) < 15.0 ) THEN
+                   zi = 4.5/11.0
+                   zht(ji,:) = MAX(2.5 - zi*(16.0-glamt(ji,1)), -2.0)
+                 ELSE IF( glamt(ji,1) >= 0.0 .AND. glamt(ji,1) < 4.0 ) THEN
+                   zht(ji,:) = -2.0
+                 ENDIF
+               END DO
+               !                                    ! ===========================
+               zht(mi0(1):mi1(1),:) = -4._wp
+               zht(:,mj0(1):mj1(1)) = -4._wp
+               zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+            CASE DEFAULT
+               !                                    ! ===========================
+               WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'
+               !
+               CALL ctl_stop( ctmp1 )
+               !
+         END SELECT
+      END IF
+               !
+      !
+      ! at u-point: averaging zht
+      DO ji = 1, jpim1
+         zhu(ji,:) = 0.5_wp * ( zht(ji,:) + zht(ji+1,:) )
+      END DO
+      CALL lbc_lnk( zhu, 'U', 1. )     ! boundary condition: this mask the surrounding grid-points
+      !                                ! ==>>>  set by hand non-zero value on first/last columns & rows 
+      DO ji = mi0(1), mi1(1)              ! first row of global domain only
+         zhu(ji,:) = zht(1,:)
+      END DO
+       DO ji = mi0(jpiglo), mi1(jpiglo)   ! last  row of global domain only
+         zhu(ji,:) = zht(jpi,:)
+      END DO
+      ! at v-point: averaging zht
+      zhv = 0._wp
+      DO jj = 1, jpjm1
+         zhv(:,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) )
+      END DO
+      CALL lbc_lnk( zhv, 'V', 1. )     ! boundary condition: this mask the surrounding grid-points
+      DO jj = mj0(1), mj1(1)   ! first  row of global domain only
+         zhv(:,jj) = zht(:,jj)
+      END DO
+      DO jj = mj0(jpjglo), mj1(jpjglo)   ! last  row of global domain only
+         zhv(:,jj) = zht(:,jj)
+      END DO
+      !     
+      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
+      !
+      !
+      !                       !==  top masked level bathymetry  ==!  (all coordinates)
+      !
+      ! no ocean cavities : top ocean level is ONE, except over land
+      ! the ocean basin surrounnded by land (1 grid-point) set through lbc_lnk call as jperio=0 
+      z2d(:,:) = 1._wp                    ! surface ocean is the 1st level
+      z2d(mi0(1):mi1(1),:) = 0._wp
+      z2d(mi0(jpiglo):mi1(jpiglo),:) = 0._wp
+      z2d(:,mj0(1):mj1(1)) = 0._wp
+      z2d(:,mj0(jpjglo):mj1(jpjglo)) = 0._wp
+
+
+
+
+
+      CALL lbc_lnk( z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90)
+      k_top(:,:) = NINT( z2d(:,:) )
+      !
+      !                              
+      !
+      IF ( ln_sco ) THEN      !==  s-coordinate  ==!   (terrain-following coordinate)
+         !
+         ht_wd = zht
+         k_bot(:,:) = jpkm1 * k_top(:,:)  !* bottom ocean = jpk-1 (here use k_top as a land mask)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN
+                k_bot(ji,jj) = 0
+                k_top(ji,jj) = 0
+              ENDIF
+           END DO
+         END DO
+         !
+         !                                !* terrain-following coordinate with e3.(k)=cst)
+         !                                !  OVERFLOW case : identical with j-index (T=V, U=F)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+              z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp)
+              DO jk = 1, jpk
+                  zwet = MAX( zht(ji,jj), rn_wdmin1 )
+                  pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk   , wp ) - 0.5_wp )
+                  pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp )          )
+                  pe3t (ji,jj,jk) = zwet * z1_jpkm1
+                  pe3w (ji,jj,jk) = zwet * z1_jpkm1
+                  zwet = MAX( zhu(ji,jj), rn_wdmin1 )
+                  pe3u (ji,jj,jk) = zwet * z1_jpkm1
+                  pe3uw(ji,jj,jk) = zwet * z1_jpkm1
+                  pe3f (ji,jj,jk) = zwet * z1_jpkm1
+                  zwet = MAX( zhv(ji,jj), rn_wdmin1 )
+                  pe3v (ji,jj,jk) = zwet * z1_jpkm1
+                  pe3vw(ji,jj,jk) = zwet * z1_jpkm1
+              END DO      
+           END DO      
+         END DO      
+         CALL lbc_lnk( pdept, 'T', 1. )
+         CALL lbc_lnk( pdepw, 'T', 1. )
+         CALL lbc_lnk( pe3t , 'T', 1. )
+         CALL lbc_lnk( pe3w , 'T', 1. )
+         CALL lbc_lnk( pe3u , 'U', 1. )
+         CALL lbc_lnk( pe3uw, 'U', 1. )
+         CALL lbc_lnk( pe3f , 'F', 1. )
+         CALL lbc_lnk( pe3v , 'V', 1. )
+         CALL lbc_lnk( pe3vw, 'V', 1. )
+         WHERE( pe3t (:,:,:) == 0._wp )   pe3t (:,:,:) = 1._wp
+         WHERE( pe3u (:,:,:) == 0._wp )   pe3u (:,:,:) = 1._wp
+         WHERE( pe3v (:,:,:) == 0._wp )   pe3v (:,:,:) = 1._wp
+         WHERE( pe3f (:,:,:) == 0._wp )   pe3f (:,:,:) = 1._wp
+         WHERE( pe3w (:,:,:) == 0._wp )   pe3w (:,:,:) = 1._wp
+         WHERE( pe3uw(:,:,:) == 0._wp )   pe3uw(:,:,:) = 1._wp
+         WHERE( pe3vw(:,:,:) == 0._wp )   pe3vw(:,:,:) = 1._wp
+      ENDIF
+      !
+      !
+      !
+   END SUBROUTINE usr_def_zgr
+
+
+   SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z1d  ***
+      !!
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
+      !!       The depth of model levels is set from dep(k), an analytical function:
+      !!                   w-level: depw_1d  = dep(k)
+      !!                   t-level: dept_1d  = dep(k+0.5)
+      !!       The scale factors are the discrete derivative of the depth:
+      !!                   e3w_1d(jk) = dk[ dept_1d ] 
+      !!                   e3t_1d(jk) = dk[ depw_1d ]
+      !!
+      !!            ===    Here constant vertical resolution   ===
+      !!
+      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
+      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
+      REAL(wp), DIMENSION(:), INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
+      !
+      INTEGER  ::   jk       ! dummy loop indices
+      REAL(wp) ::   zt, zw   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_dz
+         WRITE(numout,*) '    ~~~~~~~'
+      ENDIF
+      !
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)   ! Madec & Imbard 1996 function
+      ! ----------------------
+      DO jk = 1, jpk
+         zw = REAL( jk , wp )
+         zt = REAL( jk , wp ) + 0.5_wp
+         pdepw_1d(jk) =    rn_dz *   REAL( jk-1 , wp )
+         pdept_1d(jk) =    rn_dz * ( REAL( jk-1 , wp ) + 0.5_wp )
+         pe3w_1d (jk) =    rn_dz
+         pe3t_1d (jk) =    rn_dz
+      END DO
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      !
+   END SUBROUTINE zgr_z1d
+   
+   !!======================================================================
+END MODULE usrdef_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/cpp_WAD.fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/cpp_WAD.fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/cpp_WAD.fcm	(revision 8732)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi key_nosignedzero
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/cfg.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/cfg.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/cfg.txt	(revision 8732)
@@ -0,0 +1,5 @@
+OVERFLOW OPA_SRC
+WAD OPA_SRC
+LOCK_EXCHANGE OPA_SRC
+SAS_BIPER OPA_SRC SAS_SRC LIM_SRC_3 NST_SRC
+ISOMIP OPA_SRC
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/cfg.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/cfg.txt	(revision 8732)
@@ -0,0 +1,8 @@
+AMM12 OPA_SRC
+C1D_PAPA OPA_SRC
+GYRE_PISCES OPA_SRC TOP_SRC
+GYRE_BFM OPA_SRC TOP_SRC
+ORCA2_SAS_LIM3 OPA_SRC SAS_SRC LIM_SRC_3 NST_SRC
+ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
+ORCA2_OFF_TRC OPA_SRC OFF_SRC TOP_SRC
+ORCA2_LIM3_PISCES OPA_SRC LIM_SRC_3 TOP_SRC NST_SRC
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/makenemo
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/makenemo	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/makenemo	(revision 8732)
@@ -0,0 +1,415 @@
+#!/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 from
+# - CMP_NAM     : compiler name
+# - NBR_PRC     : number of processes used to compile
+# - USP_CONF    : unsupported (external) configuration to build the new one from
+# - 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    :   "    "    "
+# - REMOTE_CTL  : URL link to a remote resource list for an external configuration 
+#                 which is not part of the reference suite
+# - LOCAL_REF   : Nearest reference configuration to an external configuration 
+#                 which is not part of the reference suite
+#                 (used to populate work directories if remote access is not available)
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./makenemo -m ifort_osx - j3 -n ORCA2_LIM
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+#-
+#- Initialization of the options ---
+x_d="";
+x_h="";
+x_n="";
+x_r="";
+x_u="";
+x_a="";
+x_m="";
+x_t="";
+x_c="";
+x_j=1;
+x_e="none";
+x_s=NEMO;
+x_v=1;
+
+#- 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}/${x_s}
+export AGRIFUSE=10
+declare -a TAB
+declare -a REMOTE_CTL
+declare -a LOCAL_REF
+list_key=0
+chk_key=1
+#-
+#- FCM and functions location ---
+export PATH=${MAIN_DIR}/EXTERNAL/fcm/bin:$PATH
+
+#-
+#- Choice of the options ---
+while getopts :hd:n:r:u:a:m:j:e:s:v:t:k: V
+do
+    case $V in
+	(h) x_h=${OPTARG};
+        echo "Usage	 : "${b_n} \
+	    " [-h] [-n name] [-m arch] [-d "dir1 dir2"] [-r conf] [-u conf] [-s Path] [-e Path] [-j No] [-v No] [-k 0/1]";
+	echo " -h	        : help";
+	echo " -h institute : specific help for consortium members";
+	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 " -u conf      : choose an unsupported (external) configuration";
+        echo " -s Path      : choose alternative location for NEMO main directory";
+        echo " -e Path      : choose alternative location for MY_SRC directory";
+        echo " -j No        : number of processes used to compile (0=nocompilation)";
+        echo " -v No        : set verbosity level for compilation [0-3]";
+        echo " -k 0/1       : used cpp keys check (default = 1 -> check activated)";
+	echo " -t dir       : temporary directory for compilation"
+	echo " -a dir       : alternative sub-directory for configurations (below CONFIG)"
+	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 ${CONFIG_DIR}/cfg.txt;
+	echo "";
+        echo "Available unsupported (external) configurations :"; 
+              if [ -f ${CONFIG_DIR}/uspcfg.txt ] ; then cat ${CONFIG_DIR}/uspcfg.txt; fi;
+	echo "";
+	echo "Example to install an unsupoorted configuration MY_USP";
+	echo "makenemo -n MY_USP -u MY_USP" ;
+	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 list the available keys of a CONFIG ";
+	echo "./makenemo list_key";
+	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 ${x_h}  ;
+	echo "";
+	echo "Default : previous configuration and compiler";
+	exit 0;;
+	(d)  x_d=${OPTARG};;
+	(n)  x_n=${OPTARG};;
+	(r)  x_r=${OPTARG};;
+	(u)  x_u=${OPTARG};;
+	(a)  x_a=${OPTARG};;
+	(m)  x_m=${OPTARG};;
+	(j)  x_j=${OPTARG};;
+	(t)  x_t=${OPTARG};;
+	(e)  x_e=${OPTARG};;
+	(s)  x_s=${OPTARG};;
+	(v)  x_v=${OPTARG};;
+	(k)  chk_key=${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)
+            # Checking if argument has anything other than whitespace
+            [[ ! "$2" =~ ^\ +$ ]] && { list_add_key=$2; export ${list_add_key}; }
+	    shift
+	    ;;
+	del_key)
+            # Checking if argument has anything other than whitespace
+            [[ ! "$2" =~ ^\ +$ ]] && { list_del_key=$2; export ${list_del_key}; }
+	    shift
+	    ;;
+	list_key)
+	    list_key=1
+	    ;;
+	*)
+	    echo " \"$1\" BAD OPTION"
+	    exit
+	    ;;
+
+    esac
+    shift
+done
+
+
+#-
+#- Go to NEMOGCM/CONFIG directory ---
+cd ${CONFIG_DIR}
+
+#-
+#- Initialisation from input ---
+export ALT_DIR=${x_a}
+if [ ! -z $ALT_DIR ]; then
+ if [ -d ${CONFIG_DIR}/${ALT_DIR} ]; then
+   export CONFIG_DIR=${CONFIG_DIR}/${ALT_DIR}
+#-
+#- Go to named subdirectory of the NEMOGCM/CONFIG directory ---
+   cd ${CONFIG_DIR}
+ fi
+fi
+export NEW_CONF=${x_n}
+NBR_PRC=${x_j}
+CMP_NAM=${x_m}
+NEM_SUBDIR=${x_d}
+REF_CONF=${x_r}
+USP_CONF=${x_u}
+NEMO_TDIR=${x_t}
+export NEMO_TDIR=${NEMO_TDIR:-$CONFIG_DIR}
+export NEMO_DIR=${MAIN_DIR}/${x_s}
+
+#- Check if the tool or the compiler exist or list it
+if [ "${NEW_CONF}" == help ] ; then
+    echo "Available configurations :"
+    cat ${CONFIG_DIR}/cfg.txt
+    echo
+    echo "Available unsupported (external) configurations :" 
+    if [ -f ${CONFIG_DIR}/uspcfg.txt ] ; then cat ${CONFIG_DIR}/uspcfg.txt; fi;
+    exit
+fi
+[ "${CMP_NAM}" ==  help ] && . ${COMPIL_DIR}/Flist_archfile.sh all && 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 ] && [ ${#REF_CONF} -eq 0 ] && [ ${#USP_CONF} -eq 0 ] ; then
+	echo "You are installing a new default (ORCA2_LIM) 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 ] && [ ${#USP_CONF} -eq 0 ] ; then
+	echo "You are  installing a new configuration based on ORCA2_LIM"
+	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}
+    elif [ ${#NEM_SUBDIR} -gt 0 ] && [ ${#REF_CONF} -gt 0 ]; then
+        echo "You are installing an hydrid configuration based on ${REF_CONF} with components ${NEM_SUBDIR}"
+        . ${COMPIL_DIR}/Fcopy_dir.sh ${REF_CONF}
+        TAB=( ${NEM_SUBDIR} )
+    elif [ ${#NEM_SUBDIR} -eq 0 ] && [ ${#USP_CONF} -gt 0 ]; then
+	echo "You are  installing a new configuration based on the unsupported (external) ${USP_CONF}"
+	. ${COMPIL_DIR}/Fcopy_extdir.sh ${USP_CONF}  
+        #echo "TTT " ${TAB}
+        #echo "RRR " ${REMOTE_CTL}
+        #echo "LLL " ${LOCAL_REF}
+    fi
+    NEW_CONF=${x_n}
+
+    if [ ${#USP_CONF} -gt 0 ]; then
+      . ${COMPIL_DIR}/Fmake_extconfig.sh ${NEW_CONF} ${LOCAL_REF}
+      . ${COMPIL_DIR}/Ffetch_extdir.sh ${NEW_CONF} ${REMOTE_CTL}  
+    else
+      . ${COMPIL_DIR}/Fmake_config.sh ${NEW_CONF} ${REF_CONF}
+    fi
+else
+    sed -e "/${NEW_CONF} /d"  ${CONFIG_DIR}/cfg.txt >  ${COMPIL_DIR}/cfg.tmp
+    \mv  ${COMPIL_DIR}/cfg.tmp  ${CONFIG_DIR}/cfg.txt
+fi
+
+#-
+#- Save new configuration and directories names ---
+echo ${NEW_CONF} ${TAB[*]} >> ${CONFIG_DIR}/cfg.txt
+
+#-
+#- Create the WORK ---
+#- Clean links and librairies ---
+#- Creating the good links, at first on OPA_SRC ---
+. ${COMPIL_DIR}/Fmake_WORK.sh ${x_e} ${NEW_CONF} ${TAB[*]} || exit
+
+. ${COMPIL_DIR}/Fmake_bld.sh ${CONFIG_DIR} ${NEW_CONF}  ${NEMO_TDIR} || exit
+
+# build the complete list of the cpp keys of this configuration
+if [ $chk_key -eq 1 ] ; then
+    for i in $( grep "^ *#.* key_" ${NEW_CONF}/WORK/* ) 
+    do
+	echo $i | grep key_ | sed -e "s/=.*//"
+    done | sort -d | uniq > ${COMPIL_DIR}/full_key_list.txt
+    if [ $list_key -eq 1 ]; then
+	cat ${COMPIL_DIR}/full_key_list.txt
+	exit 0
+    fi
+fi
+
+#- At this stage new configuration has been added, we add or remove keys
+[ ! -z "${list_add_key}" ] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; }
+[ ! -z "${list_del_key}" ] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; }
+
+#- check that all keys are really existing...
+if [ $chk_key -eq 1 ] ; then
+    for kk in $( cat ${NEW_CONF}/cpp_${NEW_CONF}.fcm )
+    do
+	if [ "$( echo $kk | cut -c 1-4 )" == "key_" ]; then
+	    kk=${kk/=*/}
+	    nb=$( grep -c $kk ${COMPIL_DIR}/full_key_list.txt )
+	    if [ $nb -eq 0 ]; then
+		echo
+		echo "E R R O R : key "$kk" is not found in ${NEW_CONF}/WORK routines..."
+		echo "we stop..."
+		echo
+		exit 1
+	    fi
+	fi
+    done
+fi
+
+#- At this stage cpp keys have been updated. we can check the arch file
+#- When used for the first time, choose a compiler ---
+. ${COMPIL_DIR}/Fcheck_archfile.sh arch_nemo.fcm cpp.fcm ${CMP_NAM} || exit
+
+#- At this stage the configuration has beeen chosen
+#- We coose the default light file
+export USEBLD=bldxag.cfg
+
+#- We look after agrif
+grep key_agrif ${COMPIL_DIR}/cpp.fcm && export AGRIFUSE=1 && export USEBLD=${USEBLD/xag/}
+. ${COMPIL_DIR}/Fprep_agrif.sh ${NEW_CONF} ${NEMO_TDIR} || exit
+
+#-
+#_ 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
+       if [ "$AGRIFUSE" == 1 ]; then 
+          fcm build --ignore-lock  -j 1 ${COMPIL_DIR}/bld_preproagr.cfg ||{ cd - ; exit ;}
+          echo ""
+          echo "---------------------------------"
+          echo "CONV preprocessing successfull !!"
+          echo "---------------------------------"
+          echo ""
+       fi
+    fi
+    fcm build ${x_c} --ignore-lock -v ${x_v} -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
+
+#add remove for clean option
+    if  [ ${#x_c} -ne 0 ]; then
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/OPAFILES
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/WORK
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/BLD
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/EXP00/opa
+        rm -f ${COMPIL_DIR}/*history ${COMPIL_DIR}/*fcm ${COMPIL_DIR}/*txt
+        echo "cleaning ${NEW_CONF} WORK, BLD"
+    fi
+
+fi
+
+#- Come back to original directory ---
+cd -
+
+#-
+#- Unset variables
+${COMPIL_DIR}/Fclean_var.sh
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/uspcfg.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/uspcfg.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/uspcfg.txt	(revision 8732)
@@ -0,0 +1,3 @@
+ORCA1_CICE # ORCA2_LIM # OPA_SRC TOP_SRC  # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ORCA1_CICE/v3.6.0/ORCA1_CICE_ctl.txt
+ISOMIP     # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/trunk/ISOMIP_ctl.txt
+IRISHSEA   # GYRE      # OPA_SRC          # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/IRISHSEA/v3.7.0/IRISHSEA_ctl.txt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90	(revision 8732)
@@ -0,0 +1,826 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Arrays
+!
+module Agrif_Arrays
+!
+    use Agrif_Types
+    use Agrif_Grids
+!
+    implicit none
+!
+#if defined AGRIF_MPI
+    interface
+        subroutine Agrif_InvLoc ( indloc, proc_id, dir, indglob )
+            integer, intent(in)     :: indloc   !< local index
+            integer, intent(in)     :: proc_id  !< rank of the proc calling this function
+            integer, intent(in)     :: dir      !< direction of the index
+            integer, intent(out)    :: indglob  !< global index
+        end subroutine Agrif_InvLoc
+    end interface
+    private :: Agrif_InvLoc
+#endif
+!
+contains
+!
+!===================================================================================================
+! subroutine Agrif_Childbounds
+!
+!> Computes the global indices of the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Childbounds ( nbdim,           &
+                               lb_var, ub_var,  &
+                               lb_tab, ub_tab,  &
+                               proc_id,         &
+                               coords,          &
+                               lb_tab_true, ub_tab_true, memberin )
+!---------------------------------------------------------------------------------------------------
+    integer,                   intent(in)  :: nbdim         !< Number of dimensions
+    integer, dimension(nbdim), intent(in)  :: lb_var        !< Local lower boundary on the current processor
+    integer, dimension(nbdim), intent(in)  :: ub_var        !< Local upper boundary on the current processor
+    integer, dimension(nbdim), intent(in)  :: lb_tab        !< Global lower boundary of the variable
+    integer, dimension(nbdim), intent(in)  :: ub_tab        !< Global upper boundary of the variable
+    integer,                   intent(in)  :: proc_id       !< Current processor
+    integer, dimension(nbdim), intent(in)  :: coords
+    integer, dimension(nbdim), intent(out) :: lb_tab_true   !< Global value of lb_var on the current processor
+    integer, dimension(nbdim), intent(out) :: ub_tab_true   !< Global value of ub_var on the current processor
+    logical,                   intent(out) :: memberin
+!
+    integer :: i, coord_i
+    integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices
+!
+    do i = 1, nbdim
+!
+        coord_i = coords(i)
+!
+#if defined AGRIF_MPI
+        call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index )
+        call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index )
+#else
+        lb_glob_index = lb_var(i)
+        ub_glob_index = ub_var(i)
+#endif
+        lb_tab_true(i) = max(lb_tab(i), lb_glob_index)
+        ub_tab_true(i) = min(ub_tab(i), ub_glob_index)
+    enddo
+!
+    memberin = .true.
+    do i = 1,nbdim
+        if (ub_tab_true(i) < lb_tab_true(i)) then
+            memberin = .false.
+            exit
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Childbounds
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),        intent(in)  :: var
+    integer, dimension(nbdim,2), intent(out) :: lubglob
+    integer,                     intent(in)  :: nbdim
+!
+#if defined AGRIF_MPI
+    include 'mpif.h'
+    integer, dimension(nbdim)   :: lb, ub
+    integer, dimension(nbdim,2) :: iminmaxg
+    integer :: i, code, coord_i
+#endif
+!
+#if !defined AGRIF_MPI
+    call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim)
+#else
+    call Agrif_get_var_bounds_array(var, lb, ub, nbdim)
+
+    do i = 1,nbdim
+        coord_i = var % root_var % coords(i)
+        call Agrif_InvLoc( lb(i), Agrif_Procrank, coord_i, iminmaxg(i,1) )
+        call Agrif_InvLoc( ub(i), Agrif_Procrank, coord_i, iminmaxg(i,2) )
+    enddo
+!
+    iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+    call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, Agrif_mpi_comm, code)
+    lubglob(1:nbdim,2)  = - lubglob(1:nbdim,2)
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_global_bounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_get_var_bounds
+!
+!> Gets the lower and the upper boundaries of a variable, for one particular direction.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds ( variable, lower, upper, index )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(in)    :: variable   !< Variable for which we want to extract boundaries
+    integer,              intent(out)   :: lower      !< Lower bound
+    integer,              intent(out)   :: upper      !< Upper bound
+    integer,              intent(in)    :: index      !< Direction for wich we want to know the boundaries
+!
+    lower = variable % lb(index)
+    upper = variable % ub(index)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_bounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_get_var_bounds_array
+!
+!> Gets the lower and the upper boundaries of a table.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(in)   :: variable   !< Variable for which we want to extract boundaries
+    integer, dimension(nbdim), intent(out)  :: lower      !< Lower bounds array
+    integer, dimension(nbdim), intent(out)  :: upper      !< Upper bounds array
+    integer, intent(in)                     :: nbdim      !< Numer of dimensions of the variable
+!
+    lower = variable % lb(1:nbdim)
+    upper = variable % ub(1:nbdim)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_bounds_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_array_allocate
+!
+!> Allocates data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_array_allocate ( variable, lb, ub, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: variable    !< Variable struct for allocation
+    integer, dimension(nbdim), intent(in)    :: lb          !< Lower bound
+    integer, dimension(nbdim), intent(in)    :: ub          !< Upper bound
+    integer,                   intent(in)    :: nbdim       !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; allocate(variable%array1(lb(1):ub(1)))
+    case (2) ; allocate(variable%array2(lb(1):ub(1),lb(2):ub(2)))
+    case (3) ; allocate(variable%array3(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))
+    case (4) ; allocate(variable%array4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))
+    case (5) ; allocate(variable%array5(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5)))
+    case (6) ; allocate(variable%array6(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6)))
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_array_allocate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_array_deallocate
+!
+!> Dellocates data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_array_deallocate ( variable, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: variable     !< Variable struct for deallocation
+    integer,              intent(in)    :: nbdim        !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; deallocate(variable%array1)
+    case (2) ; deallocate(variable%array2)
+    case (3) ; deallocate(variable%array3)
+    case (4) ; deallocate(variable%array4)
+    case (5) ; deallocate(variable%array5)
+    case (6) ; deallocate(variable%array6)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_array_deallocate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_set_array_tozero
+!
+!> Reset the value of the data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_set_array_tozero ( variable, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: variable     !< Variable
+    integer, intent(in)                 :: nbdim        !< Dimension of the array you want to reset
+!
+    select case (nbdim)
+    case (1) ; call Agrif_set_array_tozero_1D(variable%array1)
+    case (2) ; call Agrif_set_array_tozero_2D(variable%array2)
+    case (3) ; call Agrif_set_array_tozero_3D(variable%array3)
+    case (4) ; call Agrif_set_array_tozero_4D(variable%array4)
+    case (5) ; call Agrif_set_array_tozero_5D(variable%array5)
+    case (6) ; call Agrif_set_array_tozero_6D(variable%array6)
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+    subroutine Agrif_set_array_tozero_1D ( array )
+        real, dimension(:),           intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_1D
+!
+    subroutine Agrif_set_array_tozero_2D ( array )
+        real, dimension(:,:),         intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_2D
+!
+    subroutine Agrif_set_array_tozero_3D ( array )
+        real, dimension(:,:,:),       intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_3D
+!
+    subroutine Agrif_set_array_tozero_4D ( array )
+        real, dimension(:,:,:,:),     intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_4D
+!
+    subroutine Agrif_set_array_tozero_5D ( array )
+        real, dimension(:,:,:,:,:),   intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_5D
+!
+    subroutine Agrif_set_array_tozero_6D ( array )
+        real, dimension(:,:,:,:,:,:), intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_6D
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_set_array_tozero
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_copy_array
+!
+!> Copy a part of data array from var2 to var1
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_copy_array ( var1, inf1, sup1, var2, inf2, sup2, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
+    integer, dimension(nbdim), intent(in)    :: inf1    !< Lower boundary for var1
+    integer, dimension(nbdim), intent(in)    :: sup1    !< Upper boundary for var1
+    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
+    integer, dimension(nbdim), intent(in)    :: inf2    !< Lower boundary for var2
+    integer, dimension(nbdim), intent(in)    :: sup2    !< Upper boundary for var2
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; var1%array1(inf1(1):sup1(1)) = var2%array1(inf2(1):sup2(1))
+    case (2) ; call Agrif_copy_array_2d( var1%array2, var2%array2, &
+                                         lbound(var1%array2), lbound(var2%array2), inf1, sup1, inf2, sup2 )
+    case (3) ; call Agrif_copy_array_3d( var1%array3, var2%array3, &
+                                         lbound(var1%array3), lbound(var2%array3), inf1, sup1, inf2, sup2 )
+    case (4) ; call Agrif_copy_array_4d( var1%array4, var2%array4, &
+                                         lbound(var1%array4), lbound(var2%array4), inf1, sup1, inf2, sup2 )
+    case (5) ; var1%array5(inf1(1):sup1(1),   &
+                           inf1(2):sup1(2),   &
+                           inf1(3):sup1(3),   &
+                           inf1(4):sup1(4),   &
+                           inf1(5):sup1(5)) = var2%array5(inf2(1):sup2(1), &
+                                                          inf2(2):sup2(2), &
+                                                          inf2(3):sup2(3), &
+                                                          inf2(4):sup2(4), &
+                                                          inf2(5):sup2(5))
+    case (6) ; var1%array6(inf1(1):sup1(1),   &
+                           inf1(2):sup1(2),   &
+                           inf1(3):sup1(3),   &
+                           inf1(4):sup1(4),   &
+                           inf1(5):sup1(5),   &
+                           inf1(6):sup1(6)) = var2%array6(inf2(1):sup2(1), &
+                                                          inf2(2):sup2(2), &
+                                                          inf2(3):sup2(3), &
+                                                          inf2(4):sup2(4), &
+                                                          inf2(5):sup2(5), &
+                                                          inf2(6):sup2(6))
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+    subroutine Agrif_copy_array_2d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(2), intent(in)   :: l, m
+        integer, dimension(2), intent(in)   :: inf1, sup1
+        integer, dimension(2), intent(in)   :: inf2, sup2
+        real, dimension(l(1):,l(2):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2))
+    end subroutine Agrif_copy_array_2d
+!
+    subroutine Agrif_copy_array_3d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(3), intent(in)   :: l, m
+        integer, dimension(3), intent(in)   :: inf1, sup1
+        integer, dimension(3), intent(in)   :: inf2,sup2
+        real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):,m(3):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2), &
+               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2), &
+                                        inf2(3):sup2(3))
+    end subroutine Agrif_copy_array_3d
+!
+    subroutine Agrif_copy_array_4d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(4), intent(in)   :: l, m
+        integer, dimension(4), intent(in)   :: inf1, sup1
+        integer, dimension(4), intent(in)   :: inf2, sup2
+        real, dimension(l(1):,l(2):,l(3):,l(4):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):,m(3):,m(4):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2), &
+               inf1(3):sup1(3), &
+               inf1(4):sup1(4)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2), &
+                                        inf2(3):sup2(3), &
+                                        inf2(4):sup2(4))
+    end subroutine Agrif_copy_array_4d
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_copy_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_full_copy_array
+!
+!> Copy the full data array from var2 to var1
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_full_copy_array ( var1, var2, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: var1    !< Modified variable
+    type(Agrif_Variable), intent(in)    :: var2    !< Input variable
+    integer,              intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; var1 % array1 = var2 % array1
+    case (2) ; var1 % array2 = var2 % array2
+    case (3) ; var1 % array3 = var2 % array3
+    case (4) ; var1 % array4 = var2 % array4
+    case (5) ; var1 % array5 = var2 % array5
+    case (6) ; var1 % array6 = var2 % array6
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_full_copy_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine GiveAgrif_SpecialValueToTab_mpi
+!
+!> Copy \b value in data array \b var2 where it is present in \b var1.
+!---------------------------------------------------------------------------------------------------
+subroutine GiveAgrif_SpecialValueToTab_mpi ( var1, var2, bounds, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(in)    :: var1    !< Modified variable
+    type(Agrif_Variable),      intent(inout) :: var2    !< Input variable
+    integer, dimension(:,:,:), intent(in)    :: bounds  !< Bound for both arrays
+    real,                      intent(in)    :: value   !< Special value
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1)
+        where (var1 % array1(bounds(1,1,2):bounds(1,2,2)) == value )
+            var2 % array1(bounds(1,1,1):bounds(1,2,1)) = value
+        end where
+    case (2)
+        where (var1 % array2(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2)) == value)
+            var2 % array2(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1)) = value
+        end where
+    case (3)
+        where (var1 % array3(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2)) == value)
+            var2 % array3(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1)) = value
+        end where
+    case (4)
+        where (var1 % array4(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2)) == value)
+            var2 % array4(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1)) = value
+        end where
+    case (5)
+        where (var1 % array5(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2), &
+                             bounds(5,1,2):bounds(5,2,2)) == value)
+            var2 % array5(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1), &
+                          bounds(5,1,1):bounds(5,2,1)) = value
+        end where
+    case (6)
+        where (var1 % array6(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2), &
+                             bounds(5,1,2):bounds(5,2,2), &
+                             bounds(6,1,2):bounds(6,2,2)) == value)
+            var2 % array6(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1), &
+                          bounds(5,1,1):bounds(5,2,1), &
+                          bounds(6,1,1):bounds(6,2,1)) = value
+        end where
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine GiveAgrif_SpecialValueToTab_mpi
+!===================================================================================================
+!
+! no more used ???
+#if 0
+!===================================================================================================
+!  subroutine GiveAgrif_SpecialValueToTab
+!---------------------------------------------------------------------------------------------------
+subroutine GiveAgrif_SpecialValueToTab ( var1, var2, &
+                                         lower, upper, Value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Variable),      pointer      :: var1
+    TYPE(Agrif_Variable),      pointer      :: var2
+    INTEGER,                   intent(in)   :: nbdim
+    INTEGER, DIMENSION(nbdim), intent(in)   :: lower, upper
+    REAL,                      intent(in)   :: Value
+!
+    select case (nbdim)
+    case (1)
+        where (var1 % array1( lower(1):upper(1)) == Value)
+            var2 % array1(lower(1):upper(1)) = Value
+        end where
+    case (2)
+        where (var1 % array2( lower(1):upper(1), &
+                                   lower(2):upper(2)) == Value)
+            var2 % array2(lower(1):upper(1), &
+                               lower(2):upper(2)) = Value
+        end where
+    case (3)
+        where (var1 % array3( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3)) == Value)
+            var2 % array3(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3)) = Value
+        end where
+    case (4)
+        where (var1 % array4( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4)) == Value)
+            var2 % array4(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4)) = Value
+        end where
+    case (5)
+        where (var1 % array5( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4), &
+                                   lower(5):upper(5)) == Value)
+            var2 % array5(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4), &
+                               lower(5):upper(5)) = Value
+        end where
+    case (6)
+        where (var1 % array6( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4), &
+                                   lower(5):upper(5), &
+                                   lower(6):upper(6)) == Value)
+            var2 % array6(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4), &
+                               lower(5):upper(5), &
+                               lower(6):upper(6)) = Value
+        end where
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine GiveAgrif_SpecialValueToTab
+!===================================================================================================
+#endif
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_var_replace_value
+!
+!> Replace \b value by \var2 content in \var1 data array.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_replace_value ( var1, var2, lower, upper, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
+    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
+    integer, dimension(nbdim), intent(in)    :: lower   !< Lower bound
+    integer, dimension(nbdim), intent(in)    :: upper   !< Upper bound
+    real,                      intent(in)    :: value   !< Special value
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    integer :: i,j,k,l,m,n
+!
+    select case (nbdim)
+    case (1)
+        do i = lower(1),upper(1)
+            if (var1%array1(i) == value) then
+                var1%array1(i) = var2%array1(i)
+            endif
+        enddo
+    case (2)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array2(i,j) == value) then
+                var1%array2(i,j) = var2%array2(i,j)
+            endif
+        enddo
+        enddo
+    case (3)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array3(i,j,k) == value) then
+                var1%array3(i,j,k) = var2%array3(i,j,k)
+            endif
+        enddo
+        enddo
+        enddo
+    case (4)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array4(i,j,k,l) == value) then
+                var1%array4(i,j,k,l) = var2%array4(i,j,k,l)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+    case (5)
+        do m = lower(5),upper(5)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array5(i,j,k,l,m) == value) then
+                var1%array5(i,j,k,l,m) = var2%array5(i,j,k,l,m)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    case (6)
+        do n = lower(6),upper(6)
+        do m = lower(5),upper(5)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array6(i,j,k,l,m,n) == value) then
+                var1%array6(i,j,k,l,m,n) = var2%array6(i,j,k,l,m,n)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_replace_value
+!===================================================================================================
+#endif
+!
+!===================================================================================================
+!  subroutine PreProcessToInterpOrUpdate
+!---------------------------------------------------------------------------------------------------
+subroutine PreProcessToInterpOrUpdate ( parent, child,              &
+                                        nb_child, ub_child,         &
+                                        lb_child, lb_parent,        &
+                                        s_child,  s_parent,         &
+                                        ds_child, ds_parent, nbdim, interp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer, intent(in)   :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer, intent(in)   :: child        !< Variable on the child grid
+    integer, dimension(6), intent(out)          :: nb_child     !< Number of cells on the child grid
+    integer, dimension(6), intent(out)          :: ub_child     !< Upper bound on the child grid
+    integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid
+    integer, dimension(6), intent(out)          :: lb_parent    !< Lower bound on the parent grid
+    real, dimension(6),    intent(out)          :: s_child      !< Child  grid position (s_root = 0)
+    real, dimension(6),    intent(out)          :: s_parent     !< Parent grid position (s_root = 0)
+    real, dimension(6),    intent(out)          :: ds_child     !< Child  grid dx (ds_root = 1)
+    real, dimension(6),    intent(out)          :: ds_parent    !< Parent grid dx (ds_root = 1)
+    integer,               intent(out)          :: nbdim        !< Number of dimensions
+    logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n
+                                                                !! .false. if preprocess for update
+!
+    type(Agrif_Variable), pointer :: root_var
+    type(Agrif_Grid),     pointer :: Agrif_Child_Gr
+    type(Agrif_Grid),     pointer :: Agrif_Parent_Gr
+    integer :: n
+!
+    Agrif_Child_Gr  => Agrif_Curgrid
+    Agrif_Parent_Gr => Agrif_Curgrid % parent
+!
+    root_var => child % root_var
+!
+!   Number of dimensions of the current grid
+    nbdim = root_var % nbdim
+!
+    do n = 1,nbdim
+!
+!       Value of interptab(n) can be either x,y,z or N for a no space dimension
+        select case(root_var % interptab(n))
+!
+        case('x')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(1)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(1)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(1)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(1)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1)
+!
+            if ( root_var % posvar(n) == 1 ) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('y')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(2)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(2)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(2)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(2)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2)
+!
+            if (root_var % posvar(n)==1) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('z')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(3)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(3)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(3)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(3)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3)
+!
+            if (root_var % posvar(n)==1) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('N') ! No space dimension
+!
+!       The next coefficients are calculated in order to do a simple copy of
+!       values of the grid variable when the interpolation routine is
+!       called for this dimension.
+!
+            if (interp) then
+                call Agrif_get_var_bounds(parent, lb_child(n), ub_child(n), n)
+                nb_child(n) = parent % ub(n) - parent % lb(n)
+            else
+                call Agrif_get_var_bounds(child,  lb_child(n), ub_child(n), n)
+                nb_child(n) = child % ub(n) - child % lb(n)
+            endif
+!
+!           No interpolation but only a copy of the values of the grid variable
+            lb_parent(n) = lb_child(n)
+            s_child(n)   = 0.
+            s_parent(n)  = 0.
+            ds_child(n)  = 1.
+            ds_parent(n) = 1.
+!
+        end select
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PreProcessToInterpOrUpdate
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!   subroutine Agrif_GetLocalBoundaries
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_GetLocalBoundaries ( tab1, tab2, coord, lb, ub, deb, fin )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     ::  tab1
+    integer, intent(in)     ::  tab2
+    integer, intent(in)     ::  coord
+    integer, intent(in)     ::  lb, ub
+    integer, intent(out)    ::  deb, fin
+!
+    integer :: imin, imax
+    integer :: i1, i2
+!
+    call Agrif_InvLoc(lb, AGRIF_ProcRank, coord, imin)
+    call Agrif_InvLoc(ub, AGRIF_ProcRank, coord, imax)
+!
+    if ( imin > tab2 ) then
+        i1 = imax - imin
+    else
+        i1 = max(tab1 - imin,0)
+    endif
+!
+    if (imax < tab1) then
+        i2 = -(imax - imin)
+    else
+        i2 = min(tab2 - imax,0)
+    endif
+!
+    deb = lb + i1
+    fin = ub + i2
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_GetLocalBoundaries
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_GlobalToLocalBounds
+!
+!> For a global index located on the current processor, tabarray gives the corresponding local index
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob,    &
+                                       coords, nbdim, rank, member )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim,2,2), intent(out)   :: locbounds   !< Local values of \b lb_glob and \b ub_glob
+    integer, dimension(nbdim),     intent(in)    :: lb_var      !< Local lower boundary on the current processor
+    integer, dimension(nbdim),     intent(in)    :: ub_var      !< Local upper boundary on the current processor
+    integer, dimension(nbdim),     intent(in)    :: lb_glob     !< Global lower boundary
+    integer, dimension(nbdim),     intent(in)    :: ub_glob     !< Global upper boundary
+    integer, dimension(nbdim),     intent(in)    :: coords
+    integer,                       intent(in)    :: nbdim       !< Dimension of the array
+    integer,                       intent(in)    :: rank        !< Rank of the processor
+    logical,                       intent(out)   :: member
+!
+    integer     :: i, i1, k
+    integer     :: nbloc(nbdim)
+!
+    locbounds(:,1,:) =  HUGE(1)
+    locbounds(:,2,:) = -HUGE(1)
+!
+    nbloc = 0
+!
+    do i = 1,nbdim
+!
+        call Agrif_InvLoc(lb_var(i), rank, coords(i), i1)
+!
+        do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1
+!
+            if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then
+                nbloc(i) = 1
+                locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1)
+                locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1)
+
+                locbounds(i,1,2) = min(locbounds(i,1,2),k)
+                locbounds(i,2,2) = max(locbounds(i,2,2),k)
+            endif
+        enddo
+    enddo
+
+    member = ( sum(nbloc) == nbdim )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_GlobalToLocalBounds
+!===================================================================================================
+#endif
+!
+end module Agrif_Arrays
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90	(revision 8732)
@@ -0,0 +1,649 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Boundary.
+!>
+!> Contains subroutines to calculate the boundary conditions on the child grids from their
+!> parent grids.
+!
+module Agrif_Boundary
+!
+    use Agrif_Interpolation
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_CorrectVariable
+!
+!> subroutine to calculate the boundary conditions on a fine grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CorrectVariable ( parent, child, pweight, weight, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    logical                             :: pweight      !< Indicates if weight is used for the time interpolation
+    real                                :: weight       !< Coefficient for the time interpolation
+    procedure()                         :: procname     !< Data recovery procedure
+!
+    type(Agrif_Grid)    , pointer :: Agrif_Child_Gr, Agrif_Parent_Gr
+    type(Agrif_Variable), pointer :: root_var   ! Variable on the root grid
+    integer                :: nbdim  ! Number of dimensions of the grid variable
+    integer                :: n
+    integer, dimension(6)  :: lb_child       ! Index of the first point inside the domain for
+                                                !    the child grid variable
+    integer, dimension(6)  :: lb_parent      ! Index of the first point inside the domain for
+                                                !    the parent grid variable
+    integer, dimension(6)  :: ub_child     !  Upper bound on the child grid
+    integer, dimension(6)  :: nb_child       ! Number of cells for child
+    integer, dimension(6)  :: posvartab_child   ! Position of the variable on the cell
+    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border
+                                                !    with the root grid
+    real, dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids
+    real, dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.true.)
+    root_var => child % root_var
+    Agrif_Child_Gr => Agrif_Curgrid
+    Agrif_Parent_Gr => Agrif_Curgrid % parent
+!
+    loctab_child(:) = 0
+    posvartab_child(1:nbdim) = root_var % posvar(1:nbdim)
+!
+    do n = 1,nbdim
+!
+        select case(root_var % interptab(n))
+!
+        case('x') ! x DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(1))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(1))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(1)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3
+!
+        case('y') ! y DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(2))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(2))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(2)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3
+!
+        case('z') ! z DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(3))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(3))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(3)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3
+!
+        case('N') ! No space DIMENSION
+!
+            posvartab_child(n) = 1
+            loctab_child(n) = -3
+!
+        end select
+!
+    enddo
+!
+    call Agrif_Correctnd(parent, child, pweight, weight,                    &
+                         lb_child(1:nbdim), lb_parent(1:nbdim),             &
+                         nb_child(1:nbdim), posvartab_child(1:nbdim),       &
+                         loctab_child(1:nbdim),                             &
+                         s_child(1:nbdim), s_parent(1:nbdim),               &
+                         ds_child(1:nbdim),ds_parent(1:nbdim), nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CorrectVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Correctnd
+!
+!> calculates the boundary conditions for a nD grid variable on a fine grid by using
+!> a space and time interpolations; it is called by the #Agrif_CorrectVariable procedure
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Correctnd ( parent, child, pweight, weight,                        &
+                             pttab_child, pttab_Parent,                             &
+                             nbtab_Child, posvartab_Child, loctab_Child,            &
+                             s_Child, s_Parent, ds_Child, ds_Parent,                &
+                             nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    TYPE(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    TYPE(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    LOGICAL                             :: pweight      !< Indicates if weight is used for the temporal interpolation
+    REAL                                :: weight       !< Coefficient for the temporal interpolation
+    INTEGER, DIMENSION(nbdim)   :: pttab_child          !< Index of the first point inside the domain for the parent grid variable
+    INTEGER, DIMENSION(nbdim)   :: pttab_Parent         !< Index of the first point inside the domain for the child  grid variable
+    INTEGER, DIMENSION(nbdim)   :: nbtab_Child          !< Number of cells of the child grid
+    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2)
+    INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid
+    REAL   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids
+    REAL   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids
+    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable
+    procedure()                         :: procname     !< Data recovery procedure
+!
+    INTEGER,DIMENSION(6)                :: type_interp     ! Type of interpolation (linear, spline,...)
+    INTEGER,DIMENSION(6,6)              :: type_interp_bc  ! Type of interpolation (linear, spline,...)
+    INTEGER,DIMENSION(nbdim,2,2)        :: childarray
+    INTEGER,DIMENSION(nbdim,2)          :: lubglob
+    INTEGER                             :: kindex       ! Index used for safeguard and time interpolation
+    INTEGER,DIMENSION(nbdim,2,2)        :: indtab       ! Arrays indicating the limits of the child
+    INTEGER,DIMENSION(nbdim,2,2)        :: indtruetab   ! grid variable where boundary conditions are
+    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated
+    INTEGER,DIMENSION(nbdim)            :: coords
+    INTEGER                             :: i, nb, ndir
+    INTEGER                             :: n, sizetab
+    INTEGER                             :: ibeg, iend
+    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2
+    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t)
+#if defined AGRIF_MPI
+!
+    INTEGER, DIMENSION(nbdim)   :: lower, upper
+    INTEGER, DIMENSION(nbdim)   :: ltab, utab
+!
+#endif
+!
+    type_interp_bc = child % root_var % type_interp_bc
+    coords         = child % root_var % coords
+!
+    ibeg = child % bcinf
+    iend = child % bcsup
+!
+    indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim) + ibeg
+    indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( iend - ibeg )
+
+    indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - iend
+    indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - ibeg
+
+    WHERE (posvartab_child(1:nbdim) == 2)
+        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
+        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
+    END WHERE
+!
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2))
+    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2))
+!
+    do nb = 1,nbdim
+        do ndir = 1,2
+!
+            if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+!
+                do n = 1,2
+                    ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
+                enddo
+!
+                do i = 1,nbdim
+!
+                    if (i /= nb) then
+!
+                        if (loctab_child(i) == -1 .OR. loctab_child(i) == -3) then
+                            ptres(i,1,ndir,nb) = pttab_child(i)
+                        else
+                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+                        endif
+                        if (loctab_child(i) == -2 .OR. loctab_child(i) == -3) then
+                            if (posvartab_child(i) == 1) then
+                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i)
+                            else
+                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) - 1
+                            endif
+                        else
+                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+                        endif
+!
+                    endif
+!
+                enddo
+
+!
+#if defined AGRIF_MPI
+                call Agrif_get_var_bounds_array(child,lower,upper,nbdim)
+
+                do i = 1,nbdim
+!
+                    Call Agrif_GetLocalBoundaries(ptres(i,1,ndir,nb), ptres(i,2,ndir,nb),  &
+                                                  coords(i), lower(i), upper(i), ltab(i), utab(i) )
+                    ptres2(i,1,ndir,nb) = max(ltab(i),lower(i))
+                    ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
+                    if ((i == nb) .AND. (ndir == 1)) then
+                        ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
+                    elseif ((i == nb) .AND. (ndir == 2)) then
+                        ptres2(i,1,ndir,nb) = min(ltab(i),upper(i))
+                    endif
+!
+                enddo
+#else
+                ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
+#endif
+            endif
+!
+        enddo   ! ndir = 1,2
+    enddo       ! nb = 1,nbdim
+!
+    if ( child % interpIndex /= Agrif_Curgrid % parent % ngridstep .OR. &
+         child % Interpolationshouldbemade ) then
+!
+!     Space interpolation
+!
+        kindex = 1
+!
+        do nb = 1,nbdim
+
+            type_interp = type_interp_bc(nb,:)
+
+            do ndir = 1,2
+!
+                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+!
+                    call Agrif_InterpnD(type_interp, parent, child,             &
+                                        ptres(1:nbdim,1,ndir,nb),               &
+                                        ptres(1:nbdim,2,ndir,nb),               &
+                                        pttab_child(1:nbdim),                   &
+                                        pttab_Parent(1:nbdim),                  &
+                                        s_Child(1:nbdim), s_Parent(1:nbdim),    &
+                                        ds_Child(1:nbdim),ds_Parent(1:nbdim),   &
+                                        NULL(), .FALSE., nbdim,                 &
+                                        childarray,                             &
+                                        child%memberin(nb,ndir), .TRUE., procname, coords(nb), ndir)
+
+                    child % childarray(1:nbdim,:,:,nb,ndir) = childarray
+
+                    if (.not. child%interpolationshouldbemade) then
+!
+!                       Safeguard of the values of the grid variable (at times n and n+1 on the parent grid)
+!
+                        sizetab = 1
+                        do i = 1,nbdim
+                            sizetab = sizetab * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
+                        enddo
+
+                        call saveAfterInterp(child,ptres2(:,:,ndir,nb),kindex,sizetab,nbdim)
+!
+                    endif
+!
+                endif
+!
+            enddo   ! ndir = 1,2
+        enddo       ! nb = 1,nbdim
+!
+        child % interpIndex = Agrif_Curgrid % parent % ngridstep
+!
+    endif
+!
+    if (.not. child%interpolationshouldbemade) then
+!
+!       Calculation of the coefficients c1t and c2t for the temporary interpolation
+!
+        if (pweight) then
+            c1t = weight
+        else
+            c1t = (REAL(Agrif_Nbstepint()) + 1.) / Agrif_Rhot()
+        endif
+        c2t = 1. - c1t
+!
+!       Time interpolation
+!
+        kindex = 1
+!
+        do nb = 1,nbdim
+            do ndir = 1,2
+                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
+                endif
+            enddo
+        enddo
+!
+    endif
+!
+    do nb = 1,nbdim
+    do ndir = 1,2
+        if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
+            select case(nbdim)
+            case(1)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+
+                call procname(parray1(i1:i2),                               &
+                              i1,i2, .FALSE.,coords(nb),ndir)
+            case(2)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+
+                call procname(parray2(i1:i2,j1:j2),                         &
+                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir)
+            case(3)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+
+                call procname(parray3(i1:i2,j1:j2,k1:k2),                   &
+                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
+            case(4)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+
+                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             &
+                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir)
+            case(5)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+
+                call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2),       &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir)
+            case(6)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+                n1 = child % childarray(6,1,2,nb,ndir)
+                n2 = child % childarray(6,2,2,nb,ndir)
+
+                call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir)
+            end select
+        endif
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Correctnd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine saveAfterInterp
+!
+!> saves the values of the grid variable on the fine grid after the space interpolation
+!---------------------------------------------------------------------------------------------------
+subroutine saveAfterInterp ( child_var, bounds, kindex, newsize, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable),       INTENT(inout)  :: child_var !< The fine grid variable
+    INTEGER, DIMENSION(nbdim,2), INTENT(in)     :: bounds
+    INTEGER,                     INTENT(inout)  :: kindex    !< Index indicating where this safeguard
+                                                             !<     is done on the fine grid
+    INTEGER,                     INTENT(in)     :: newsize
+    INTEGER,                     INTENT(in)     :: nbdim
+!
+    INTEGER     :: ir,jr,kr,lr,mr,nr
+!
+!    Allocation of the array oldvalues2d
+!
+    if (newsize .LE. 0) return
+!
+    Call Agrif_Checksize(child_var,kindex+newsize)
+
+    if (child_var % interpIndex /= Agrif_Curgrid % parent % ngridstep ) then
+        child_var % oldvalues2d(1,kindex:kindex+newsize-1) = &
+        child_var % oldvalues2d(2,kindex:kindex+newsize-1)
+    endif
+
+    SELECT CASE (nbdim)
+    CASE (1)
+!CDIR ALTCODE
+        do ir = bounds(1,1), bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray1(ir)
+            kindex = kindex + 1
+        enddo
+!
+    CASE (2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray2(ir,jr)
+            kindex = kindex + 1
+        enddo
+        enddo
+!
+    CASE (3)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray3(ir,jr,kr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+!
+      CASE (4)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray4(ir,jr,kr,lr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (5)
+        do mr = bounds(5,1),bounds(5,2)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray5(ir,jr,kr,lr,mr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (6)
+        do nr = bounds(6,1),bounds(6,2)
+        do mr = bounds(5,1),bounds(5,2)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray6(ir,jr,kr,lr,mr,nr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    END SELECT
+!---------------------------------------------------------------------------------------------------
+end subroutine saveAfterInterp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine timeInterpolation
+!
+!> subroutine for a linear time interpolation on the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine timeInterpolation ( child_var, bounds, kindex, c1t, c2t, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable)       :: child_var !< The fine grid variable
+    INTEGER, DIMENSION(nbdim,2) :: bounds
+    INTEGER                     :: kindex    !< Index indicating the values of the fine grid got
+                                             !<    before and after the space interpolation and
+                                             !<    used for the time interpolation
+    REAL                        :: c1t, c2t  !< Coefficients for the time interpolation (c2t=1-c1t)
+    INTEGER                     :: nbdim
+!
+    INTEGER :: ir,jr,kr,lr,mr,nr
+!
+    SELECT CASE (nbdim)
+    CASE (1)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray1(ir) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                      c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+!
+    CASE (2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray2(ir,jr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                         c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+!
+    CASE (3)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                            c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+!
+    CASE (4)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                               c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (5)
+        do mr=bounds(5,1),bounds(5,2)
+        do lr=bounds(4,1),bounds(4,2)
+        do kr=bounds(3,1),bounds(3,2)
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir=bounds(1,1),bounds(1,2)
+            parray5(ir,jr,kr,lr,mr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                                  c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+        do mr=bounds(5,1),bounds(5,2)
+        do lr=bounds(4,1),bounds(4,2)
+        do kr=bounds(3,1),bounds(3,2)
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir=bounds(1,1),bounds(1,2)
+            parray6(ir,jr,kr,lr,mr,nr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                                     c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    END SELECT
+!---------------------------------------------------------------------------------------------------
+end subroutine timeInterpolation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Checksize
+!
+!> subroutine used in the saveAfterInterp procedure to allocate the oldvalues2d array
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Checksize ( child_var, newsize )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable), INTENT(inout)  :: child_var !< The fine grid variable
+    INTEGER              , INTENT(in)     :: newsize   !< Size of the domains where the boundary
+                                                       !<    conditions are calculated
+!
+    REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
+!
+    if (.NOT. associated(child_var % oldvalues2d)) then
+!
+        allocate(child_var % oldvalues2d(2,newsize))
+        child_var % oldvalues2d = 0.
+!
+    else
+!
+        if (SIZE(child_var % oldvalues2d,2) < newsize) then
+!
+            allocate(tempoldvalues(2,SIZE(child_var % oldvalues2d,2)))
+            tempoldvalues = child_var % oldvalues2d
+            deallocate(child_var % oldvalues2d)
+            allocate(  child_var % oldvalues2d(2,newsize))
+            child_var % oldvalues2d = 0.
+            child_var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = tempoldvalues(:,:)
+            deallocate(tempoldvalues)
+!
+        endif
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Checksize
+!===================================================================================================
+!
+end module Agrif_Boundary
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 8732)
@@ -0,0 +1,680 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_BcFunction.
+!
+module Agrif_BcFunction
+!
+!     Modules used:
+!
+    use Agrif_Boundary
+    use Agrif_Update
+    use Agrif_Save
+!
+    implicit none
+!
+    interface Agrif_Set_Parent
+        module procedure Agrif_Set_Parent_int,      &
+                         Agrif_Set_Parent_real4,    &
+                         Agrif_Set_Parent_real8
+    end interface
+!
+    interface Agrif_Save_Forrestore
+        module procedure Agrif_Save_Forrestore0d,   &
+                         Agrif_Save_Forrestore2d,   &
+                         Agrif_Save_Forrestore3d,   &
+                         Agrif_Save_Forrestore4d
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_int
+!
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_int(tabvarsindic,value)
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    integer, intent(in)     :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_int
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_real4
+!---------------------------------------------------------------------------------------------------
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real4 ( tabvarsindic, value )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    real(kind=4),intent(in) :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % array0 = value
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % sarray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_real4
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_real8
+!---------------------------------------------------------------------------------------------------
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real8 ( tabvarsindic, value )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    real(kind=8),intent(in) :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % darray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_real8
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_bc
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade )
+!---------------------------------------------------------------------------------------------------
+    integer,               intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    integer, dimension(2), intent(in)   :: bcinfsup     !< bcinfsup
+    logical, optional,     intent(in)   :: Interpolationshouldbemade !< interpolation should be made
+!
+    integer                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable),  pointer  :: var
+!
+    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+    else
+        print*,"Agrif_Set_bc : warning indic >= 0 !!!"
+        var => Agrif_Curgrid % tabvars(indic)
+    endif
+
+    if (.not.associated(var)) return ! Grand mother grid case
+!
+    if ( Agrif_Curgrid % fixedrank /= 0 ) then
+        if ( .not.associated(var % oldvalues2D) ) then
+            allocate(var % oldvalues2D(2,1))
+            var % interpIndex = -1
+            var % oldvalues2D = 0.
+        endif
+        if ( present(Interpolationshouldbemade) ) then
+            var % Interpolationshouldbemade = Interpolationshouldbemade
+        endif
+    endif
+!
+    var % bcinf = bcinfsup(1)
+    var % bcsup = bcinfsup(2)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_bc
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_interp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4)
+!---------------------------------------------------------------------------------------------------
+    integer,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    integer, optional, intent(in)   :: interp, interp1, interp2, interp3, interp4
+!
+    integer                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable), pointer   :: var
+!
+    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_interp : warning indic >= 0 !!!"
+        var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    var % type_interp = Agrif_Constant
+!
+    if (present(interp))    var % type_interp    = interp
+    if (present(interp1))   var % type_interp(1) = interp1
+    if (present(interp2))   var % type_interp(2) = interp2
+    if (present(interp3))   var % type_interp(3) = interp3
+    if (present(interp4))   var % type_interp(4) = interp4
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_bcinterp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_bcinterp ( tabvarsindic, interp,   interp1,  interp2,  interp3, interp4, &
+                                              interp11, interp12, interp21, interp22 )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    INTEGER, OPTIONAL, intent(in)   :: interp,   interp1,  interp2,  interp3, interp4
+    INTEGER, OPTIONAL, intent(in)   :: interp11, interp12, interp21, interp22
+!
+    INTEGER                         :: indic ! indice of the variable in tabvars
+    TYPE(Agrif_Variable), pointer   :: var
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_bcinterp : warning indic >= 0 !!!"
+        var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    var % type_interp_bc = Agrif_Constant
+!
+    if (present(interp))    var % type_interp_bc      = interp
+    if (present(interp1))   var % type_interp_bc(:,1) = interp1
+    if (present(interp11))  var % type_interp_bc(1,1) = interp11
+    if (present(interp12))  var % type_interp_bc(1,2) = interp12
+    if (present(interp2))   var % type_interp_bc(:,2) = interp2
+    if (present(interp21))  var % type_interp_bc(2,1) = interp21
+    if (present(interp22))  var % type_interp_bc(2,2) = interp22
+    if (present(interp3))   var % type_interp_bc(:,3) = interp3
+    if (present(interp4))   var % type_interp_bc(:,4) = interp4
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_bcinterp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_UpdateType
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, &
+                                                update3, update4, update5 )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,           intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5
+!
+    INTEGER                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable),  pointer  :: root_var
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_UpdateType : warning indic >= 0 !!!"
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    root_var % type_update = Agrif_Update_Copy
+    if (present(update))    root_var % type_update    = update
+    if (present(update1))   root_var % type_update(1) = update1
+    if (present(update2))   root_var % type_update(2) = update2
+    if (present(update3))   root_var % type_update(3) = update3
+    if (present(update4))   root_var % type_update(4) = update4
+    if (present(update5))   root_var % type_update(5) = update5
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_UpdateType
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_restore ( tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+!
+    INTEGER :: indic  !  indice of the variable in tabvars
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_restore
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Init_variable ( tabvarsindic, procname )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in)  :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()          :: procname         !< Data recovery procedure
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    call Agrif_Interp_variable(tabvarsindic, procname)
+    call Agrif_Bc_variable(tabvarsindic, procname, 1.)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Bc_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight )
+!---------------------------------------------------------------------------------------------------
+    integer,        intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()                :: procname
+    real, optional, intent(in) :: calledweight
+!
+    real    :: weight
+    logical :: pweight
+    integer :: indic
+    integer :: nbdim
+    type(Agrif_Variable), pointer :: root_var
+    type(Agrif_Variable), pointer :: parent_var
+    type(Agrif_Variable), pointer :: child_var
+    type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if ( present(calledweight) ) then
+        weight  = calledweight
+        pweight = .true.
+    else
+        weight  = 0.
+        pweight = .false.
+    endif
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        parent_var => child_var % parent_var
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Bc_variable : warning indic >= 0 !!!"
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+        root_var   => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    nbdim = root_var % nbdim
+!
+    select case( nbdim )
+    case(1)
+        allocate(parray1(child_var%lb(1):child_var%ub(1)))
+    case(2)
+        allocate(parray2(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2) ))
+    case(3)
+        allocate(parray3(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3) ))
+    case(4)
+        allocate(parray4(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4) ))
+    case(5)
+        allocate(parray5(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4), &
+                         child_var%lb(5):child_var%ub(5) ))
+    case(6)
+        allocate(parray6(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4), &
+                         child_var%lb(5):child_var%ub(5), &
+                         child_var%lb(6):child_var%ub(6) ))
+    end select
+!
+!   Create temporary child variable
+    allocate(child_tmp)
+!
+    child_tmp % root_var => root_var
+    child_tmp % oldvalues2D => child_var % oldvalues2D
+!
+!   Index indicating if a space interpolation is necessary
+    child_tmp % interpIndex =  child_var % interpIndex
+    child_tmp % list_interp => child_var % list_interp
+    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
+!
+    child_tmp % point = child_var % point
+    child_tmp % lb = child_var % lb
+    child_tmp % ub = child_var % ub
+!
+    child_tmp % bcinf = child_var % bcinf
+    child_tmp % bcsup = child_var % bcsup
+!
+    child_tmp % childarray = child_var % childarray
+    child_tmp % memberin   = child_var % memberin
+!
+    call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname)
+!
+    child_var % childarray = child_tmp % childarray
+    child_var % memberin   = child_tmp % memberin
+!
+    child_var % oldvalues2D => child_tmp % oldvalues2D
+    child_var % list_interp => child_tmp % list_interp
+!
+    child_var % interpIndex = child_tmp % interpIndex
+!
+    deallocate(child_tmp)
+!
+    select case( nbdim )
+        case(1); deallocate(parray1)
+        case(2); deallocate(parray2)
+        case(3); deallocate(parray3)
+        case(4); deallocate(parray4)
+        case(5); deallocate(parray5)
+        case(6); deallocate(parray6)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Bc_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_variable ( tabvarsindic, procname )
+!---------------------------------------------------------------------------------------------------
+    integer,     intent(in)     :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()                 :: procname         !< Data recovery procedure
+!
+    integer :: nbdim
+    integer :: indic  ! indice of the variable in tabvars
+    logical :: torestore
+    type(Agrif_Variable), pointer   :: root_var
+    type(Agrif_Variable), pointer   :: parent_var       ! Variable on the parent grid
+    type(Agrif_Variable), pointer   :: child_var        ! Variable on the parent grid
+    type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        parent_var => child_var % parent_var
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Interp_variable : warning indic >= 0 !!!"
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+        root_var   => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    nbdim     = root_var % nbdim
+    torestore = root_var % restore
+!
+    allocate(child_tmp)
+!
+    child_tmp % root_var => root_var
+    child_tmp % nbdim = root_var % nbdim
+    child_tmp % point = child_var % point
+    child_tmp % lb = child_var % lb
+    child_tmp % ub = child_var % ub
+    child_tmp % interpIndex =  child_var % interpIndex
+    child_tmp % list_interp => child_var % list_interp
+    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
+!
+    if ( torestore ) then
+        select case( nbdim )
+        case(1)
+            parray1 = child_var % array1
+            child_tmp % restore1D => child_var % restore1D
+        case(2)
+            parray2 = child_var % array2
+            child_tmp % restore2D => child_var % restore2D
+        case(3)
+            parray3 = child_var % array3
+            child_tmp % restore3D => child_var % restore3D
+        case(4)
+            parray4 = child_var % array4
+            child_tmp % restore4D => child_var % restore4D
+        case(5)
+            parray5 = child_var % array5
+            child_tmp % restore5D => child_var % restore5D
+        case(6)
+            parray6 = child_var % array6
+            child_tmp % restore6D => child_var % restore6D
+        end select
+    endif
+!
+    call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname)
+!
+    child_var % list_interp => child_tmp % list_interp
+!
+    deallocate(child_tmp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_Variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_Variable ( tabvarsindic, procname, &
+                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 )
+!---------------------------------------------------------------------------------------------------
+    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars
+    procedure()                                 :: procname         !< Data recovery procedure
+    integer, dimension(2), intent(in), optional :: locupdate
+    integer, dimension(2), intent(in), optional :: locupdate1
+    integer, dimension(2), intent(in), optional :: locupdate2
+    integer, dimension(2), intent(in), optional :: locupdate3
+    integer, dimension(2), intent(in), optional :: locupdate4
+!---------------------------------------------------------------------------------------------------
+    integer :: indic
+    integer :: nbdim
+    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated
+    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated
+    type(Agrif_Variable), pointer   :: root_var
+    type(Agrif_Variable), pointer   :: parent_var
+    type(Agrif_Variable), pointer   :: child_var
+!
+    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return
+    if (agrif_curgrid%grand_mother_grid) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid, -indic)
+        parent_var => child_var % parent_var
+
+        if (.not.associated(parent_var)) then
+          ! can occur during the first update of Agrif_Coarsegrid (if any)
+          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, -indic)
+          child_var % parent_var => parent_var
+        endif
+
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Update_Variable : warning indic >= 0 !!!"
+        root_var   => Agrif_Mygrid  % tabvars(indic)
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+    endif
+!
+    nbdim = root_var % nbdim
+!
+    updateinf = -99
+    updatesup = -99
+!
+    if ( present(locupdate) ) then
+        updateinf(1:nbdim) = locupdate(1)
+        updatesup(1:nbdim) = locupdate(2)
+    endif
+!
+    if ( present(locupdate1) ) then
+        updateinf(1) = locupdate1(1)
+        updatesup(1) = locupdate1(2)
+    endif
+!
+    if ( present(locupdate2) ) then
+        updateinf(2) = locupdate2(1)
+        updatesup(2) = locupdate2(2)
+    endif
+
+    if ( present(locupdate3) ) then
+        updateinf(3) = locupdate3(1)
+        updatesup(3) = locupdate3(2)
+    endif
+
+    if ( present(locupdate4) ) then
+        updateinf(4) = locupdate4(1)
+        updatesup(4) = locupdate4(2)
+    endif
+!
+    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_Variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore0D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: tabvarsindic0, tabvarsindic
+!
+    type(Agrif_Variable), pointer   :: root_var, save_var
+    integer :: nbdim
+!
+    root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
+    save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
+    nbdim =  root_var % nbdim
+!
+    select case(nbdim)
+        case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic)
+        case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic)
+        case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore0D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore2D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:), intent(in)        :: q
+    integer,              intent(in)        :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if ( .not.allocated(save_var%array2) ) then
+        allocate(save_var%array2(save_var%lb(1):save_var%ub(1),  &
+                                 save_var%lb(2):save_var%ub(2)))
+    endif
+!
+    save_var % array2  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore2D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore3D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:), intent(in)      :: q
+    integer,                intent(in)      :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if ( .not.allocated(save_var%array3) ) then
+        allocate(save_var%array3(save_var%lb(1):save_var%ub(1), &
+                                 save_var%lb(2):save_var%ub(2), &
+                                 save_var%lb(3):save_var%ub(3)))
+    endif
+!
+    save_var % array3  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore3D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore4D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:), intent(in)    :: q
+    integer,                  intent(in)    :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if (.not.allocated(save_var%array4)) then
+        allocate(save_var%array4(save_var%lb(1):save_var%ub(1),&
+                                 save_var%lb(2):save_var%ub(2),&
+                                 save_var%lb(3):save_var%ub(3),&
+                                 save_var%lb(4):save_var%ub(4)))
+    endif
+!
+    save_var % array4  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore4D
+!===================================================================================================
+!
+end module Agrif_BcFunction
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90	(revision 8732)
@@ -0,0 +1,1277 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Clustering
+!>
+!> Contains subroutines to create and initialize the grid hierarchy from the
+!> AGRIF_FixedGrids.in file.
+!
+module Agrif_Clustering
+!
+    use Agrif_CurgridFunctions
+    use Agrif_Init_Vars
+    use Agrif_Save
+!
+    implicit none
+!
+    abstract interface
+        subroutine init_proc()
+        end subroutine init_proc
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Cluster_All
+!
+!> Subroutine for the clustering. A temporary grid hierarchy, pointed by parent_rect, is created.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Cluster_All ( g, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer   :: g        !< Pointer on the current grid
+    TYPE(Agrif_Rectangle), pointer   :: parent_rect
+!
+    TYPE(Agrif_LRectangle), pointer  :: parcours
+    TYPE(Agrif_Grid)      , pointer  :: newgrid
+    REAL                             :: g_eps
+    INTEGER                          :: i
+!
+    g_eps = huge(1.)
+    do i = 1,Agrif_Probdim
+        g_eps = min(g_eps, g % Agrif_dx(i))
+    enddo
+!
+    g_eps = g_eps / 100.
+!
+!   Necessary condition for clustering
+    do i = 1,Agrif_Probdim
+        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps)) return
+    enddo
+!
+    nullify(parent_rect%childgrids)
+!
+    call Agrif_ClusterGridnD(g,parent_rect)
+!
+    parcours => parent_rect % childgrids
+!
+    do while ( associated(parcours) )
+!
+!       Newgrid is created. It is a copy of a fine grid created previously by clustering.
+        allocate(newgrid)
+!
+        do i = 1,Agrif_Probdim
+            newgrid % nb(i) = (parcours % r % imax(i) - parcours % r % imin(i)) * Agrif_Coeffref(i)
+            newgrid % Agrif_x(i)  = g % Agrif_x(i)  + (parcours % r % imin(i) -1) * g%Agrif_dx(i)
+            newgrid % Agrif_dx(i) = g % Agrif_dx(i) / Agrif_Coeffref(i)
+        enddo
+!
+        if ( Agrif_Probdim == 1 ) then
+            allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
+            newgrid%tabpoint1D = 0
+        endif
+!
+        if ( Agrif_Probdim == 2 ) then
+            allocate(newgrid%tabpoint2D(newgrid%nb(1)+1, newgrid%nb(2)+1))
+            newgrid%tabpoint2D = 0
+        endif
+!
+        if ( Agrif_Probdim == 3 ) then
+            allocate(newgrid%tabpoint3D(newgrid%nb(1)+1, newgrid%nb(2)+1, newgrid%nb(3)+1))
+            newgrid%tabpoint3D = 0
+        endif
+!
+!       Points detection on newgrid
+        call Agrif_TabpointsnD(Agrif_mygrid,newgrid)
+!
+!       recursive call to Agrif_Cluster_All
+        call Agrif_Cluster_All(newgrid, parcours % r)
+!
+        parcours => parcours % next
+!
+        if ( Agrif_Probdim == 1 ) deallocate(newgrid%tabpoint1D)
+        if ( Agrif_Probdim == 2 ) deallocate(newgrid%tabpoint2D)
+        if ( Agrif_Probdim == 3 ) deallocate(newgrid%tabpoint3D)
+!
+        deallocate(newgrid)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Cluster_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_TabpointsnD
+!
+!> Copy on newgrid of points detected on the grid hierarchy pointed by g.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_TabpointsnD ( g, newgrid )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer   :: g, newgrid
+!
+    TYPE(Agrif_PGrid), pointer  :: parcours
+!
+    REAL                  :: g_eps, newgrid_eps, eps
+    REAL   , DIMENSION(3) :: newmin, newmax
+    REAL   , DIMENSION(3) :: gmin, gmax
+    REAL   , DIMENSION(3) :: xmin
+    INTEGER, DIMENSION(3) :: igmin, inewmin
+    INTEGER, DIMENSION(3) :: inewmax
+    INTEGER               :: i,  j,  k
+    INTEGER               :: i0, j0, k0
+!
+    parcours => g % child_list % first
+!
+    do while( associated(parcours) )
+        call Agrif_TabpointsnD(parcours%gr,newgrid)
+        parcours => parcours % next
+    enddo
+!
+    g_eps = 10.
+    newgrid_eps = 10.
+!
+    do i = 1,Agrif_probdim
+        g_eps = min( g_eps , g % Agrif_dx(i) )
+        newgrid_eps = min(newgrid_eps,newgrid%Agrif_dx(i))
+    enddo
+!
+    eps = min(g_eps,newgrid_eps)/100.
+!
+    do i = 1,Agrif_probdim
+!
+         if ( newgrid%Agrif_dx(i) < (g%Agrif_dx(i)-eps) ) return
+!
+         gmin(i) = g%Agrif_x(i)
+         gmax(i) = g%Agrif_x(i) + g%nb(i) * g%Agrif_dx(i)
+!
+         newmin(i) = newgrid%Agrif_x(i)
+         newmax(i) = newgrid%Agrif_x(i) + newgrid%nb(i) * newgrid%Agrif_dx(i)
+!
+         if (gmax(i) < newmin(i)) return
+         if (gmin(i) > newmax(i)) return
+!
+         inewmin(i) = 1 - floor(-(max(gmin(i),newmin(i))-newmin(i)) / newgrid%Agrif_dx(i))
+!
+         xmin(i) = newgrid%Agrif_x(i) + (inewmin(i)-1)*newgrid%Agrif_dx(i)
+!
+         igmin(i) = 1 + nint((xmin(i)-gmin(i))/g%Agrif_dx(i))
+!
+         inewmax(i) = 1 + int(   (min(gmax(i),newmax(i))-newmin(i)) / newgrid%Agrif_dx(i))
+!
+    enddo
+!
+    if ( Agrif_probdim == 1 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            newgrid%tabpoint1D(i) = max( newgrid%tabpoint1D(i), g%tabpoint1D(i0) )
+        enddo
+        i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+    endif
+!
+    if ( Agrif_probdim == 2 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+                newgrid%tabpoint2D(i,j) = max( newgrid%tabpoint2D(i,j), g%tabpoint2D(i0,j0) )
+                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+        enddo
+    endif
+!
+    if ( Agrif_probdim == 3 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+                k0 = igmin(3)
+                do k = inewmin(3),inewmax(3)
+                    newgrid%tabpoint3D(i,j,k) = max( newgrid%tabpoint3D(i,j,k), g%tabpoint3D(i0,j0,k0))
+                    k0 = k0 + int(newgrid%Agrif_dx(3)/g%Agrif_dx(3))
+                enddo
+                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_TabpointsnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ClusterGridnD
+!
+!> Clustering on the grid pointed by g.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ClusterGridnD ( g, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer  :: g          !< Pointer on the current grid
+    TYPE(Agrif_Rectangle), pointer  :: parent_rect
+!
+    TYPE(Agrif_Rectangle) :: newrect
+    TYPE(Agrif_Variable_i)  :: newflag
+!
+    INTEGER               :: i,j,k
+    INTEGER, DIMENSION(3) :: sx
+    INTEGER               :: bufferwidth,flagpoints
+    INTEGER               :: n1,n2,m1,m2,o1,o2
+!
+    bufferwidth = int(Agrif_Minwidth/5.)
+!
+    do i = 1,Agrif_probdim
+        sx(i) = g % nb(i) + 1
+    enddo
+!
+    if ( Agrif_probdim == 1 ) then
+        allocate(newflag%iarray1(sx(1)))
+        newflag%iarray1 = 0
+    endif
+    if ( Agrif_probdim == 2 ) then
+        allocate(newflag%iarray2(sx(1),sx(2)))
+        newflag%iarray2 = 0
+    endif
+    if ( Agrif_probdim == 3 ) then
+        allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
+        newflag%iarray3 = 0
+    endif
+!
+    flagpoints = 0
+!
+    if ( bufferwidth>0 ) then
+!
+        if ( Agrif_probdim == 1 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+                if (g % tabpoint1D(i) == 1) then
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray1(m1:m2) = 1
+                endif
+            enddo
+        endif
+!
+        if ( Agrif_probdim == 2 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+            do j = bufferwidth,sx(2)-bufferwidth+1
+                if (g % tabpoint2D(i,j) == 1) then
+                    n1 = j - bufferwidth + 1
+                    n2 = j + bufferwidth - 1
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray2(m1:m2,n1:n2) = 1
+                endif
+            enddo
+            enddo
+        endif
+!
+        if ( Agrif_probdim == 3 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+            do j = bufferwidth,sx(2)-bufferwidth+1
+            do k = bufferwidth,sx(3)-bufferwidth+1
+                if (g % tabpoint3D(i,j,k) == 1) then
+                    o1 = k - bufferwidth + 1
+                    o2 = k + bufferwidth - 1
+                    n1 = j - bufferwidth + 1
+                    n2 = j + bufferwidth - 1
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray3(m1:m2,n1:n2,o1:o2) = 1
+                endif
+            enddo
+            enddo
+            enddo
+        endif
+!
+    else
+!
+        flagpoints = 1
+        if ( Agrif_probdim == 1 ) newflag%iarray1 = g % tabpoint1D
+        if ( Agrif_probdim == 2 ) newflag%iarray2 = g % tabpoint2D
+        if ( Agrif_probdim == 3 ) newflag%iarray3 = g % tabpoint3D
+!
+    endif
+!
+    if (flagpoints == 0) then
+        if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
+        if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
+        if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
+        return
+    endif
+!
+    do i = 1 , Agrif_probdim
+        newrect % imin(i) = 1
+        newrect % imax(i) = sx(i)
+    enddo
+!
+    call Agrif_Clusternd(newflag,parent_rect%childgrids,newrect)
+!
+    if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
+    if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
+    if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ClusterGridnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ClusternD
+!
+!> Clustering on the grid pointed by oldB.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Clusternd ( flag, boxlib, oldB )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Variable_i)            :: flag
+    TYPE(Agrif_LRectangle), pointer :: boxlib
+    TYPE(Agrif_Rectangle)           :: oldB
+!
+    TYPE(Agrif_LRectangle),pointer :: tempbox,parcbox,parcbox2
+    TYPE(Agrif_Rectangle) :: newB,newB2
+    INTEGER :: i,j,k
+    INTEGER, DIMENSION(:), allocatable :: i_sig, j_sig, k_sig
+    INTEGER, DIMENSION(3) :: ipu,ipl
+    INTEGER, DIMENSION(3) :: istr,islice
+    REAL :: cureff, neweff
+    INTEGER :: ValMax,ValSum,TailleTab
+    INTEGER :: nbpoints,nbpointsflag
+    LOGICAL :: test
+!
+                              allocate( i_sig(oldB%imin(1):oldB%imax(1)) )
+    if ( Agrif_probdim >= 2 ) allocate( j_sig(oldB%imin(2):oldB%imax(2)) )
+    if ( Agrif_probdim == 3 ) allocate( k_sig(oldB%imin(3):oldB%imax(3)) )
+!
+    test = .FALSE.
+    do i = 1,Agrif_probdim
+        test = test .OR. ( (oldB%imax(i)-oldB%imin(i)+1) <  Agrif_Minwidth)
+    enddo
+    if ( test ) return
+!
+    if ( Agrif_probdim == 1 ) i_sig = flag%iarray1
+    if ( Agrif_probdim == 2 ) then
+        do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray2(i, oldB%imin(2):oldB%imax(2)))
+        enddo
+        do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray2(oldB%imin(1):oldB%imax(1),j))
+        enddo
+    endif
+    if ( Agrif_probdim == 3 ) then
+        do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray3(i,oldB%imin(2):oldB%imax(2),    &
+                                          oldB%imin(3):oldB%imax(3)))
+        enddo
+        do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1), j, &
+                                          oldB%imin(3):oldB%imax(3)))
+        enddo
+        do k = oldB%imin(3),oldB%imax(3)
+            k_sig(k) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1),    &
+                                          oldB%imin(2):oldB%imax(2), k) )
+        enddo
+    endif
+!
+    do i = 1,Agrif_probdim
+        ipl(i) = oldB%imin(i)
+        ipu(i) = oldB%imax(i)
+    enddo
+!
+                              call Agrif_Clusterprune(i_sig,ipl(1),ipu(1))
+    if ( Agrif_probdim >= 2 ) call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))
+    if ( Agrif_probdim == 3 ) call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))
+!
+    test = .TRUE.
+    do i = 1,Agrif_probdim
+        test = test .AND. (ipl(i) == oldB%imin(i))
+        test = test .AND. (ipu(i) == oldB%imax(i))
+    enddo
+
+    if (.NOT. test) then
+        do i = 1 , Agrif_probdim
+            newB%imin(i) = ipl(i)
+            newB%imax(i) = ipu(i)
+        enddo
+!
+        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2),    &
+                                                              newB%imin(3):newB%imax(3)))
+!
+        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1)
+        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1) * &
+                                              (newB%imax(3)-newB%imin(3)+1)
+        neweff = REAL(nbpoints) / TailleTab
+!
+        if (nbpoints > 0) then
+!
+            if ((neweff > Agrif_efficiency)) then
+                call Agrif_Add_Rectangle(newB,boxlib)
+                return
+            else
+!
+                tempbox => boxlib
+                newB2 = newB
+                call Agrif_Clusternd(flag,boxlib,newB)
+!
+!               Compute new efficiency
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+!
+                do while (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) exit
+                    newB = parcbox2%r
+!
+                    if ( Agrif_probdim == 1 ) Valsum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim == 2 ) Valsum = SUM(flag%iarray2(newB%imin(1):newB%imax(1), &
+                                                                        newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim == 3 ) Valsum = SUM(flag%iarray3(newB%imin(1):newB%imax(1), &
+                                                                        newB%imin(2):newB%imax(2), &
+                                                                        newB%imin(3):newB%imax(3)))
+                    nbpointsflag = nbpointsflag + ValSum
+!
+                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1) * &
+                                                          (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next
+                enddo
+!
+! coefficient 1.05 avant 1.15 possibilite de laisser choix a l utilisateur
+                if ( REAL(nbpointsflag)/REAL(nbpoints) < (1.0001*cureff)) then
+                    parcbox2 => boxlib
+                    do while (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next
+                    enddo
+                    boxlib => tempbox
+                    call Agrif_Add_Rectangle(newB2,boxlib)
+                    return
+                endif
+            endif
+        endif
+        return
+    endif
+!
+    do i = 1,Agrif_Probdim
+        istr(i) = oldB%imax(i)
+        islice(i) = oldB%imin(i)
+    enddo
+!
+                              call Agrif_Clusterslice(i_sig,islice(1),istr(1))
+    if ( Agrif_probdim >= 2 ) call Agrif_Clusterslice(j_sig,islice(2),istr(2))
+    if ( Agrif_probdim == 3 ) call Agrif_Clusterslice(k_sig,islice(3),istr(3))
+!
+    ValSum = 0
+    do i = 1,Agrif_Probdim
+        Valsum = valSum + islice(i)
+    enddo
+!
+    if ( Valsum == -Agrif_Probdim ) then
+        call Agrif_Add_Rectangle(oldB,boxlib)
+        return
+    endif
+!
+    nullify(tempbox)
+    tempbox => boxlib
+    if ( Agrif_probdim == 1 ) cureff = (oldB%imax(1)-oldB%imin(1)+1)
+    if ( Agrif_probdim == 2 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
+                                       (oldB%imax(2)-oldB%imin(2)+1)
+    if ( Agrif_probdim == 3 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
+                                       (oldB%imax(2)-oldB%imin(2)+1) * &
+                                       (oldB%imax(3)-oldB%imin(3)+1)
+    nullify(parcbox)
+!
+    do i = 1,Agrif_Probdim
+        newB%imax(i) = oldB%imax(i)
+        newB%imin(i) = oldB%imin(i)
+    enddo
+!
+    ValMax = 0
+    do i = 1 , Agrif_Probdim
+        ValMax = Max(ValMax,istr(i))
+    enddo
+!
+    if (istr(1) == ValMax ) then
+        newB%imax(1) = islice(1)
+        call Agrif_Add_Rectangle(newB,parcbox)
+        newB%imin(1) = islice(1)+1
+        newB%imax(1) = oldB%imax(1)
+        call Agrif_Add_Rectangle(newB,parcbox)
+    else if ( Agrif_probdim >= 2 ) then
+        if (istr(2) == ValMax ) then
+            newB%imax(2) = islice(2)
+            call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(2) = islice(2)+1
+            newB%imax(2) = oldB%imax(2)
+            call Agrif_Add_Rectangle(newB,parcbox)
+        else if ( Agrif_probdim == 3 ) then
+            newB%imax(3) = islice(3)
+            call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(3) = islice(3)+1
+            newB%imax(3) = oldB%imax(3)
+            call Agrif_Add_Rectangle(newB,parcbox)
+        endif
+    endif
+!
+    do while ( associated(parcbox) )
+        newB = parcbox%r
+!
+        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2),    &
+                                                              newB%imin(3):newB%imax(3)))
+!
+        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1)
+        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1) * &
+                                              (newB%imax(3)-newB%imin(3)+1)
+        neweff = REAL(nbpoints) / TailleTab
+!
+        if ( nbpoints > 0 ) then
+!
+            if ( (neweff > Agrif_efficiency)) then
+                call Agrif_Add_Rectangle(newB,boxlib)
+            else
+                tempbox => boxlib
+                newB2 = newB
+                call Agrif_Clusternd(flag,boxlib,newB)
+!
+!               Compute new efficiency
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+!
+                do while (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) exit
+                    newB = parcbox2%r
+!
+                    if ( Agrif_probdim == 1 ) ValSum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim == 2 ) ValSum = SUM(flag%iarray2(newB%imin(1):newB%imax(1),  &
+                                                                        newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim == 3 ) ValSum = SUM(flag%iarray3(newB%imin(1):newB%imax(1),  &
+                                                                        newB%imin(2):newB%imax(2),  &
+                                                                        newB%imin(3):newB%imax(3)))
+                    nbpointsflag = nbpointsflag + ValSum
+!
+                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1) * &
+                                                          (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next
+                enddo
+!
+                if  ( REAL(nbpointsflag)/REAL(nbpoints) < (1.15*cureff)) then
+                    parcbox2 => boxlib
+                    do while (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next
+                    enddo
+                    boxlib => tempbox
+                    call Agrif_Add_Rectangle(newB2,boxlib)
+                endif
+            endif
+        endif
+        parcbox => parcbox%next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusternd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Clusterslice
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Clusterslice ( sig, slice, str )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,                       intent(inout) :: slice
+    INTEGER,                       intent(inout) :: str
+    INTEGER, DIMENSION(slice:str), intent(in)    :: sig
+!
+    INTEGER                         :: ideb, ifin
+    INTEGER                         :: i, t, a, di, ts
+    INTEGER, DIMENSION(slice:str)   :: lap
+!
+    ideb = slice
+    ifin = str
+!
+    if (SIZE(sig) <= 2*Agrif_Minwidth) then
+        str = -1
+        slice = -1
+        return
+    endif
+!
+    t = -1
+    a = -1
+!
+    do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if (sig(i) == 0) then
+            if ((i-ideb) < (ifin-i)) then
+                di = i - ideb
+            else
+                di = ifin - i
+            endif
+!
+            if (di > t) then
+                a = i
+                t = di
+            endif
+        endif
+    enddo
+!
+    if (a /= -1) then
+        slice = a
+        str = t
+        return
+    endif
+!
+    t = -1
+    a = -1
+!
+    do i = ideb+1,ifin-1
+        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i)
+    enddo
+!
+    do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if ((lap(i+1)*lap(i)) <= 0) then
+            ts = ABS(lap(i+1) - lap(i))
+            if (ts > t) then
+                t = ts
+                a = i
+            endif
+       endif
+    enddo
+!
+    if (a == (ideb + Agrif_Minwidth - 1)) then
+        a = -1
+        t = -1
+    endif
+!
+    slice = a
+    str = t
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusterslice
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Clusterprune
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Clusterprune ( sig, pl, pu )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,                   intent(inout)    :: pl, pu
+    INTEGER, DIMENSION(pl:pu), intent(in)       :: sig
+!
+    INTEGER :: ideb, ifin
+    INTEGER :: diff, addl, addu, udist, ldist
+!
+    ideb = pl
+    ifin = pu
+!
+    if (SIZE(sig) <= Agrif_Minwidth) return
+!
+    do while ((sig(pl) == 0) .AND. (pl < ifin))
+        pl = pl + 1
+    enddo
+!
+    do while ((sig(pu) == 0) .AND. (pu > ideb))
+        pu = pu - 1
+    enddo
+!
+    if ( (pu-pl) < Agrif_Minwidth ) then
+        diff = Agrif_Minwidth - (pu - pl + 1)
+        udist = ifin - pu
+        ldist = pl - ideb
+        addl = diff / 2
+        addu = diff - addl
+        if (addu > udist) then
+            addu = udist
+            addl = diff - addu
+        endif
+!
+        if (addl > ldist) then
+            addl = ldist
+            addu = diff - addl
+        endif
+!
+        pu = pu + addu
+        pl = pl - addl
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusterprune
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Add_Rectangle
+!
+!> Adds the Agrif_Rectangle R in a list managed by LR.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Add_Rectangle ( R, LR )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle)           :: R
+    TYPE(Agrif_LRectangle), pointer :: LR
+!
+    TYPE(Agrif_LRectangle), pointer :: newrect
+!
+    integer                         :: i
+!
+    allocate(newrect)
+    allocate(newrect % r)
+!
+    newrect % r = R
+!
+    do i = 1,Agrif_Probdim
+        newrect % r % spaceref(i) = Agrif_Coeffref(i)
+        newrect % r % timeref(i)  = Agrif_Coeffreft(i)
+    enddo
+!
+    newrect % r % number = -1
+    newrect % next => LR
+    LR => newrect
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Add_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Copy_Rectangle
+!
+!> Creates and returns a copy of Agrif_Rectangle R.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Copy_Rectangle ( R, expand ) result( copy )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle), pointer, intent(in) :: R
+    integer, optional,              intent(in) :: expand
+!
+    TYPE(Agrif_Rectangle), pointer :: copy
+!
+    allocate(copy)
+!
+    copy = R
+    if ( present(expand) ) then
+        copy % imin = copy % imin - expand
+        copy % imax = copy % imax + expand
+    endif
+    copy % childgrids => R % childgrids
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Copy_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Read_Fix_Grd
+!
+!> Creates the grid hierarchy from the reading of the AGRIF_FixedGrids.in file.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Read_Fix_Grd ( parent_rect, j, nunit )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle), pointer   :: parent_rect !< Pointer on the first grid of the grid hierarchy
+    INTEGER                          :: j          !< Number of the new grid
+    INTEGER                          :: nunit      !< unit associated with file
+!
+    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
+    TYPE(Agrif_LRectangle), pointer  :: parcours   ! Pointer for the recursive procedure
+    TYPE(Agrif_LRectangle), pointer  :: newlrect
+    TYPE(Agrif_LRectangle), pointer  :: end_list
+    INTEGER                          :: i,n        ! for each child grid
+    INTEGER                          :: nb_grids   ! Number of child grids
+!
+!   Reading of the number of child grids
+    read(nunit,*,end=99) nb_grids
+!
+    allocate(end_list)
+!
+    parent_rect % childgrids => end_list
+!
+!   Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
+!        time refinement factors for each child grid.
+!   Creation and addition of the new grid to the grid hierarchy.
+!
+    do n = 1,nb_grids
+!
+        allocate(newlrect)
+        newrect % number = j   ! Number of the grid
+!
+        if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+            if (Agrif_Probdim == 3) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % imin(3), newrect % imax(3), &
+                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
+                              newrect % timeref(1), newrect % timeref(2), newrect % timeref(3)
+            elseif (Agrif_Probdim == 2) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % spaceref(1), newrect % spaceref(2), &
+                              newrect % timeref(1),  newrect % timeref(2)
+            elseif (Agrif_Probdim == 1) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % spaceref(1), &
+                              newrect % timeref(1)
+            endif
+        else
+            if (Agrif_Probdim == 3) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % imin(3), newrect % imax(3), &
+                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
+                              newrect % timeref(1)
+            elseif (Agrif_Probdim == 2) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % spaceref(1), newrect % spaceref(2), &
+                              newrect % timeref(1)
+            elseif (Agrif_Probdim == 1) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % spaceref(1), &
+                              newrect % timeref(1)
+            endif
+!
+            if ( Agrif_probdim >= 2 ) then
+                do i = 2,Agrif_probdim
+                    newrect % timeref(i) = newrect % timeref(1)
+                enddo
+            endif
+!
+        endif
+!
+!       Addition to the grid hierarchy
+!
+        j = j + 1
+        allocate(newlrect%r)
+        newlrect % r = newrect
+        end_list % next => newlrect
+        end_list => end_list % next
+!
+    enddo
+!
+    parent_rect % childgrids => parent_rect % childgrids % next
+    parcours => parent_rect % childgrids
+!
+!   recursive operation to create the grid hierarchy branch by branch
+!
+    do while ( associated(parcours) )
+        call Agrif_Read_Fix_Grd(parcours % r, j, nunit)
+        parcours => parcours % next
+    enddo
+99  continue
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Read_Fix_Grd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Create_Grids
+!
+!> Creates the grid hierarchy (g) from the one created with the #Agrif_Read_Fix_Grd or
+!! #Agrif_Cluster_All procedures (parent_rect).
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Create_Grids ( parent_grid, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer  :: parent_grid  !< Pointer on the root coarse grid
+    TYPE(Agrif_Rectangle), pointer  :: parent_rect  !< Pointer on the root coarse grid of the grid hierarchy
+                                                    !!   created with the #Agrif_Read_Fix_Grd subroutine
+!
+    TYPE(Agrif_Grid)      , pointer :: child_grid   ! Newly created child grid
+    TYPE(Agrif_PGrid)     , pointer :: child_grid_p
+    TYPE(Agrif_LRectangle), pointer :: child_rect_p
+    type(Agrif_Rectangle),  pointer :: child_rect
+!
+    INTEGER                         :: i
+    INTEGER, save                   :: moving_grid_id = 0
+!
+    child_rect_p => parent_rect % childgrids
+!
+!   Creation of the grid hierarchy from the one created by using the Agrif_Read_Fix_Grd subroutine
+!
+    do while ( associated(child_rect_p) )
+!
+        child_rect => child_rect_p % r
+!
+        allocate(child_grid)
+!
+!       Pointer on the parent grid
+        child_grid % parent => parent_grid
+        child_grid % rect_in_parent => Agrif_Copy_Rectangle(child_rect_p % r, expand=Agrif_Extra_Boundary_Cells)
+!
+        moving_grid_id = moving_grid_id+1
+        child_grid % grid_id = moving_grid_id
+!
+        do i = 1,Agrif_Probdim
+            child_grid % spaceref(i) = child_rect % spaceref(i)
+            child_grid % timeref(i)  = child_rect % timeref(i)
+            child_grid % nb(i) = (child_rect % imax(i) - child_rect % imin(i)) * child_rect % spaceref(i)
+            child_grid % ix(i) =  child_rect % imin(i)
+            child_grid % Agrif_dt(i) = parent_grid % Agrif_dt(i) / REAL(child_grid % timeref(i))
+            child_grid % Agrif_dx(i) = parent_grid % Agrif_dx(i) / REAL(child_grid % spaceref(i))
+            child_grid % Agrif_x(i)  = parent_grid % Agrif_x(i) + &
+                                            (child_rect % imin(i) - 1) * parent_grid % Agrif_dx(i)
+        enddo
+!
+!       Size of the grid in terms of cpu cost (nx*ny*timeref)
+        child_grid % size = product( child_grid % nb(1:Agrif_Probdim) ) * child_grid % timeref(1)
+!
+!       Level of the current grid
+        child_grid % level = child_grid % parent % level + 1
+        if (child_grid % level > Agrif_MaxLevelLoc) then
+          Agrif_MaxLevelLoc = child_grid%level
+        endif
+!
+!       Number of the grid pointed by child_grid
+        child_grid % fixedrank = child_rect % number
+!
+!       Grid pointed by child_grid is a fixed grid
+        child_grid % fixed = ( child_grid % fixedrank > 0 )
+!
+!       Update the total number of fixed grids
+        if (child_grid % fixed) then
+            Agrif_nbfixedgrids = Agrif_nbfixedgrids + 1
+        endif
+!
+!       Initialize integration counter
+        child_grid % ngridstep = 0
+!
+!       Test indicating if the current grid has a common border with the root
+!       coarse grid in the x direction
+        do i = 1 , Agrif_Probdim
+!
+            child_grid % NearRootBorder(i) = (                  &
+                (child_grid % parent % NearRootBorder(i)) .AND. &
+                (child_grid % ix(i) == 1) )
+!
+            child_grid % DistantRootBorder(i) = (                  &
+                (child_grid % parent % DistantRootBorder(i)) .AND. &
+                (child_grid % ix(i) + (child_grid%nb(i)/child_grid%spaceref(i))-1  == child_grid % parent % nb(i)) )
+        enddo
+!
+!       Writing in output files
+        child_grid % oldgrid = .FALSE.
+!
+#if defined AGRIF_MPI
+        child_grid % communicator = parent_grid % communicator
+#endif
+!
+!       Definition of the characteristics of the variable of the grid pointed by child_grid
+        call Agrif_Create_Var(child_grid)
+!
+!       Addition of this grid to the grid hierarchy
+        call Agrif_gl_append( parent_grid % child_list, child_grid )
+!
+        child_rect_p => child_rect_p % next
+!
+    enddo
+!
+!   Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the grid hierarchy
+!
+    child_grid_p => parent_grid % child_list % first
+    child_rect_p => parent_rect % childgrids
+!
+    do while ( associated(child_rect_p) )
+        call Agrif_Create_Grids( child_grid_p % gr, child_rect_p % r )
+        child_grid_p => child_grid_p % next
+        child_rect_p => child_rect_p % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Create_Grids
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy
+!
+!> Initializes all the grids except the root coarse grid (this one, pointed by Agrif_Types::Agrif_Mygrid, is
+!! initialized by the subroutine Agrif_Util#Agrif_Init_Grids defined in the module Agrif_Util and
+!! called in the main program).
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
+    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    LOGICAL                    :: Init_Hierarchy
+!
+! Initialise the grand mother grid (if any)
+!
+    if ( associated(g, Agrif_Mygrid) .and. agrif_coarse ) then
+        call Agrif_Instance(Agrif_Coarsegrid)
+        call Agrif_Allocation(Agrif_Coarsegrid)
+        call Agrif_initialisations(Agrif_Coarsegrid)
+        call Agrif_InitWorkspace()
+!
+!       Initialization by interpolation (this routine is written by the user)
+        if (present(procname)) Then
+            call procname()
+        else
+            call Agrif_InitValues()
+        endif
+        call Agrif_Instance(Agrif_Mygrid)
+    endif
+
+    parcours => g % child_list % first
+!
+    do while ( associated(parcours) )
+!
+        Init_Hierarchy = .false.
+        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
+                Init_Hierarchy = .true.
+            endif
+        endif
+!
+        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
+        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
+!
+        if (Init_Hierarchy) then
+!
+!           Instanciation of the grid pointed by parcours%gr and its variables
+            call Agrif_Instance(parcours % gr)
+!
+!           Allocation of the arrays containing values of the variables of the
+!           grid pointed by parcours%gr
+!
+            call Agrif_Allocation(parcours % gr)
+            call Agrif_initialisations(parcours % gr)
+!
+            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!               Initialization by copy of the grids created by clustering
+                call Agrif_Allocate_Restore(parcours % gr)
+                call Agrif_CopyFromOld_All(parcours % gr, Agrif_oldmygrid)
+            endif
+!
+!           Initialization by interpolation (this routine is written by the user)
+            call Agrif_InitWorkSpace()
+            if (present(procname)) Then
+                call procname()
+            else
+                call Agrif_InitValues()
+            endif
+!
+            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+                call Agrif_Free_Restore(parcours % gr)
+            endif
+!
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    parcours => g % child_list % first
+!
+!   recursive operation to initialize all the grids
+    do while ( associated(parcours) )
+        call Agrif_Init_Hierarchy(parcours%gr,procname)
+        parcours => parcours%next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy_Parallel_1
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy_Parallel_1 ( g )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
+!
+    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    LOGICAL                    :: Init_Hierarchy
+!
+    parcours => g % child_list % first
+!
+    do while ( associated(parcours) )
+!
+        Init_Hierarchy = .false.
+        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
+                Init_Hierarchy = .true.
+            endif
+        endif
+!
+        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
+        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
+!
+        if (Init_Hierarchy) then
+!
+!           Instanciation of the grid pointed by parcours%gr and its variables
+            call Agrif_Instance(parcours % gr)
+!
+!           Allocation of the arrays containing values of the variables of the
+!           grid pointed by parcours%gr
+!
+            call Agrif_Allocation(parcours % gr)
+            call Agrif_initialisations(parcours % gr)
+!
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    parcours => g % child_list % first
+!
+!   recursive operation to initialize all the grids
+    do while ( associated(parcours) )
+        call Agrif_Init_Hierarchy_Parallel_1(parcours%gr)
+        parcours => parcours%next
+    enddo
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy_Parallel_1
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy_Parallel_2
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy_Parallel_2 ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid),     pointer   :: g            !< Pointer on the current grid
+    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    type(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    integer :: is
+!
+    call Agrif_Instance(g)
+    call Agrif_seq_init_sequences( g )
+!
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+        parcours => Agrif_seq_select_child(g,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!     Initialization by interpolation (this routine is written by the user)
+        if (present(procname)) Then
+            call procname()
+        else
+            call Agrif_InitValues()
+        endif
+!
+        call Agrif_Init_ProcList(parcours % gr % proc_def_list, &
+                                 parcours % gr % proc_def_in_parent_list % nitems)
+!
+        call Agrif_Init_Hierarchy_Parallel_2(parcours%gr,procname)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy_Parallel_2
+!===================================================================================================
+#endif
+!
+!===================================================================================================
+!  subroutine Agrif_Allocate_Restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Allocate_Restore ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
+!
+    integer :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        if ( Agrif_Mygrid%tabvars(i) % restore ) then
+            if ( Agrif_Gr%tabvars(i) % nbdim == 1 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore1D( &
+                    lbound(Agrif_Gr%tabvars(i)%array1,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array1,1)))
+                Agrif_Gr%tabvars(i)%Restore1D = 0
+            endif
+            if ( Agrif_Gr%tabvars(i) % nbdim == 2 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore2D( &
+                    lbound(Agrif_Gr%tabvars(i)%array2,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array2,1),&
+                    lbound(Agrif_Gr%tabvars(i)%array2,2):&
+                    ubound(Agrif_Gr%tabvars(i)%array2,2)))
+                Agrif_Gr%tabvars(i)%Restore2D = 0
+            endif
+            if ( Agrif_Mygrid%tabvars(i) % nbdim == 3 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore3D( &
+                    lbound(Agrif_Gr%tabvars(i)%array3,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,1),&
+                    lbound(Agrif_Gr%tabvars(i)%array3,2):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,2),&
+                    lbound(Agrif_Gr%tabvars(i)%array3,3):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,3)))
+                Agrif_Gr%tabvars(i)%Restore3D = 0
+            endif
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Allocate_Restore
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_Restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_Restore ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
+!
+    TYPE(Agrif_Variable), pointer :: var
+    integer                       :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+!
+            var = Agrif_Gr % tabvars(i)
+!
+            if (associated(var%Restore1D)) deallocate(var%Restore1D)
+            if (associated(var%Restore2D)) deallocate(var%Restore2D)
+            if (associated(var%Restore3D)) deallocate(var%Restore3D)
+            if (associated(var%Restore4D)) deallocate(var%Restore4D)
+            if (associated(var%Restore5D)) deallocate(var%Restore5D)
+            if (associated(var%Restore6D)) deallocate(var%Restore6D)
+!
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_Restore
+!===================================================================================================
+!
+end module Agrif_Clustering
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 8732)
@@ -0,0 +1,765 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module to define some procedures concerning the current grid
+!
+module Agrif_CurgridFunctions
+!
+    use Agrif_Init
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  function Agrif_rel_dt
+!
+!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.).
+!---------------------------------------------------------------------------------------------------
+function Agrif_rel_dt ( ) result( rel_dt )
+!---------------------------------------------------------------------------------------------------
+    integer :: i
+    real    :: rel_dt
+!
+    rel_dt = 1.
+!
+    do i = 1,Agrif_Probdim
+        rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_rel_dt
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_rel_idt
+!
+!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1).
+!---------------------------------------------------------------------------------------------------
+function Agrif_rel_idt ( ) result( rel_idt )
+!---------------------------------------------------------------------------------------------------
+    integer :: rel_idt
+!
+    rel_idt = nint(1./Agrif_rel_dt())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_rel_idt
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_IRhot
+!
+!> Returns the time refinement factor of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_IRhot ( ) result( irhot )
+!---------------------------------------------------------------------------------------------------
+    integer :: i, irhot
+!
+    irhot = 1
+!
+    do i = 1,Agrif_Probdim
+        irhot = max(irhot, Agrif_Curgrid % timeref(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_IRhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Rhot
+!
+!> Returns the time refinement factor of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Rhot ( ) result( rhot )
+!---------------------------------------------------------------------------------------------------
+    real    :: rhot
+!
+    rhot = float(Agrif_IRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Rhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_IRhot
+!
+!> Returns the time refinement factor of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_IRhot ( ) result( irhot )
+!---------------------------------------------------------------------------------------------------
+    integer :: i, irhot
+!
+    irhot = 1
+!
+    do i = 1,Agrif_Probdim
+        irhot = max(irhot, Agrif_Curgrid % parent % timeref(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_IRhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Rhot
+!
+!> Returns the time refinement factor of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Rhot ( ) result( rhot )
+!---------------------------------------------------------------------------------------------------
+    real :: rhot
+!
+    rhot = float(Agrif_Parent_IRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Rhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Nbstepint
+!
+!> function for the calculation of the coefficients used for the time interpolation
+!! (module #Agrif_Boundary).
+!---------------------------------------------------------------------------------------------------
+function Agrif_Nbstepint ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_nbstepint ! result
+!
+    Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Nbstepint
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Nbstepint
+!
+!> function for the calculation of the coefficients used for the time interpolation
+!! (module #Agrif_Boundary).
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Nbstepint ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Nbstepint ! result
+!
+    Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot()))
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Nbstepint
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderX
+!
+!> Allows to interpolate (in the x direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderX ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(1) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderX
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderX
+!
+!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderX ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(1) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderX
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderY
+!
+!> Allows to interpolate (in the y direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderY ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(2) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderY
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderY
+!
+!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderY ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(2) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderY
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderZ
+!
+!> Allows to interpolate (in the z direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderZ ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(3) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderZ
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderZ
+!
+!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderZ()
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(3) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderZ
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Nb_Step
+!
+!> Returns the number of time steps of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Nb_Step ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Nb_Step ! Result
+!
+    if (Agrif_Root()) then
+        Agrif_Parent_Nb_Step = -1
+    else
+        Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Nb_Step
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Root
+!
+!> Indicates if the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Root ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Root ! Result
+!
+    Agrif_Root = (Agrif_Curgrid % fixedrank == 0)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Root
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_GrandMother
+!
+!> Indicates if the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_GrandMother ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_GrandMother ! Result
+!
+    Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid
+!---------------------------------------------------------------------------------------------------
+end function Agrif_GrandMother
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Root
+!
+!> Indicates if the parent of the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Root ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Parent_Root ! Result
+!
+    Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Root
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Fixed
+!
+!> Returns the number of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Fixed   ! Result
+!
+    if (Agrif_Curgrid % fixed) then
+        Agrif_Fixed = Agrif_Curgrid % fixedrank
+    else
+        Agrif_Fixed = -1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Fixed
+!
+!> Returns the number of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Fixed   ! Result
+!
+    if (Agrif_Curgrid % parent % fixed) then
+        Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank
+    else
+        Agrif_Parent_Fixed = 0
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Is_Fixed
+!
+!> Returns .TRUE. if the current grid is fixed.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Is_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Is_Fixed   ! Result
+!
+    Agrif_Is_Fixed = Agrif_Curgrid % fixed
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Is_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Is_Fixed
+!
+!> Returns .TRUE. if the parent of the current grid is fixed.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Is_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Parent_Is_Fixed   ! Result
+!
+    Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Is_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_CFixed
+!
+!> Returns the number of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_CFixed ( )
+!---------------------------------------------------------------------------------------------------
+    character(3) :: Agrif_CFixed   ! Result
+!
+    character(3) :: cfixed
+    integer      :: fixed
+!
+    fixed = Agrif_Fixed()
+!
+    if (fixed /= -1) then
+!
+        if (fixed <= 9) then
+            write(cfixed,'(i1)') fixed
+        else
+            write(cfixed,'(i2)') fixed
+        endif
+!
+        Agrif_CFixed = cfixed
+        
+        if (associated(agrif_curgrid,agrif_coarsegrid)) then
+          Agrif_CFixed = 'gm'
+        endif
+!
+    else
+        print*,'Call to Agrif_CFixed() on a moving grid'
+        stop
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_CFixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrid_Parent_CFixed
+!
+!> Returns the number of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrid_Parent_CFixed ( )
+!---------------------------------------------------------------------------------------------------
+    character(3) :: Agrid_Parent_CFixed   ! Result
+!
+    character(3) :: cfixed
+    integer      :: fixed
+!
+    fixed = Agrif_Parent_Fixed()
+!
+    if(fixed /= -1) then
+!
+        if (fixed <= 9) then
+            write(cfixed,'(i1)')fixed
+        else
+            write(cfixed,'(i2)')fixed
+        endif
+!
+        Agrid_Parent_CFixed=cfixed
+!
+    else
+        print*,'Illegal call to Agrid_Parent_CFixed()'
+        stop
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrid_Parent_CFixed
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ChildGrid_to_ParentGrid
+!
+!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ChildGrid_to_ParentGrid ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % parent % save_grid => Agrif_Curgrid
+    call Agrif_Instance(Agrif_Curgrid%parent)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ChildGrid_to_ParentGrid
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ParentGrid_to_ChildGrid
+!
+!> Make the pointer #Agrif_Curgrid point on the child grid after having called the
+!! #Agrif_ChildGrid_to_ParentGrid subroutine.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ParentGrid_to_ChildGrid ( )
+!---------------------------------------------------------------------------------------------------
+    call Agrif_Instance(Agrif_Curgrid%save_grid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ParentGrid_to_ChildGrid
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Get_Unit
+!
+!> Returns a unit not connected to any file.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Get_Unit ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Get_Unit  ! Result
+!
+    integer :: n
+    logical :: op
+!
+    integer :: nunit
+    integer :: iii, out, iiimax
+    logical :: bexist
+    integer,dimension(1:1000) :: forbiddenunit
+!
+!   Load forbidden Unit if the file Agrif_forbidenUnit exist
+!
+    INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist)
+!
+    if (.not. bexist) then
+!       File Agrif_forbiddenUnit.txt not found
+    else
+        nunit = 777
+        OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old")
+        iii = 1
+        do while ( .TRUE. )
+            READ(nunit,*, end=99) forbiddenunit(iii)
+            iii = iii + 1
+        enddo
+   99   continue
+        iiimax = iii
+        close(nunit)
+    endif
+!
+    do n = 7,1000
+!
+        INQUIRE(Unit=n,Opened=op)
+!
+        out = 0
+        if ( bexist .AND. (.NOT.op) ) then
+            do iii = 1,iiimax
+                if ( n == forbiddenunit(iii) ) out = 1
+            enddo
+        endif
+!
+        if ( (.NOT.op) .AND. (out == 0) ) exit
+!
+    enddo
+!
+    Agrif_Get_Unit = n
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Get_Unit
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Extra_Boundary_Cells
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: nb_extra_cells
+!
+    Agrif_Extra_Boundary_Cells = nb_extra_cells
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Extra_Boundary_Cells
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Efficiency
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Efficiency ( eff )
+!---------------------------------------------------------------------------------------------------
+    real, intent(in) :: eff
+!
+    if ( (eff < 0.) .OR. (eff > 1) ) then
+        write(*,*) 'Error Efficiency should be between 0 and 1'
+        stop
+    else
+        Agrif_Efficiency = eff
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Efficiency
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Regridding
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Regridding ( regfreq )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: regfreq
+!
+    if (regfreq < 0) then
+        write(*,*) 'Regridding frequency should be positive'
+        stop
+    else
+        Agrif_Regridding = regfreq
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Regridding
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_x
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_x ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+      if (coeffref < 0) then
+         write(*,*) 'Coefficient of raffinement should be positive'
+         stop
+      else
+         Agrif_coeffref(1) = coeffref
+      endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_x
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_y
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_y ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of raffinement should be positive'
+        stop
+    else
+        Agrif_coeffref(2) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_y
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_z
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_z ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+!
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of raffinement should be positive'
+        stop
+    else
+        Agrif_coeffref(3) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_z
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_x
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_x ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(1) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_x
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_y
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_y ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+!
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(2) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_y
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_z
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_z ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*)'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(3) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_z
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Minwidth
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Minwidth ( coefminwidth )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coefminwidth
+!
+    if (coefminwidth < 0) then
+        write(*,*)'Coefficient of Minwidth should be positive'
+        stop
+    else
+        Agrif_Minwidth = coefminwidth
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Minwidth
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Rafmax
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Rafmax ( coefrafmax )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coefrafmax
+!
+    integer :: i
+    real    :: res
+!
+    if (coefrafmax < 0) then
+        write(*,*)'Coefficient of  should be positive'
+        stop
+    else
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(1))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(1) = 1. / res
+!
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(2))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(2) = 1. / res
+!
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(3))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(3) = 1. / res
+!
+      endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Rafmax
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_MaskMaxSearch
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: mymaxsearch
+!
+    MaxSearch = mymaxsearch
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_MaskMaxSearch
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Level
+!---------------------------------------------------------------------------------------------------
+function Agrif_Level ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Level  ! Result
+!
+    Agrif_Level = Agrif_Curgrid % level
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Level
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_MaxLevel
+!---------------------------------------------------------------------------------------------------
+function Agrif_MaxLevel ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_MaxLevel  ! Result
+!
+    Agrif_MaxLevel = Agrif_MaxLevelLoc
+!---------------------------------------------------------------------------------------------------
+end function Agrif_MaxLevel
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_GridAllocation_is_done
+!---------------------------------------------------------------------------------------------------
+function Agrif_GridAllocation_is_done ( ) result(isdone)
+!---------------------------------------------------------------------------------------------------
+    logical :: isdone
+!
+    isdone = Agrif_Curgrid % allocation_is_done
+!---------------------------------------------------------------------------------------------------
+end function Agrif_GridAllocation_is_done
+!===================================================================================================
+!
+end module Agrif_CurgridFunctions
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modgrids.F90	(revision 8732)
@@ -0,0 +1,478 @@
+module Agrif_Grids
+
+    use Agrif_Types
+!
+    implicit none
+!
+!===================================================================================================
+type Agrif_Grid_List
+!---------------------------------------------------------------------------------------------------
+!<  List of grids.
+!
+    integer                     :: nitems = 0      !< Number of elements in the list
+    type(Agrif_PGrid), pointer  :: first => NULL() !< Pointer to the first grid in the list
+    type(Agrif_PGrid), pointer  :: last  => NULL() !< Pointer to the last  grid inserted in the list
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Grid_List
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_PGrid
+!---------------------------------------------------------------------------------------------------
+!<  Data type to go over the grid hierarchy (used for the creation of this grid hierarchy
+!<  and during the time integration).
+!
+    type(Agrif_Grid) , pointer :: gr   => NULL()  !< Pointer to the actual grid data structure
+    type(Agrif_PGrid), pointer :: next => NULL()  !< Next grid in the list
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_PGrid
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Grid
+!---------------------------------------------------------------------------------------------------
+!<  Data type to define a grid (position, space and time refinement factors).
+!
+    type(Agrif_Grid)                    , pointer :: parent      => NULL() !< pointer on the parent grid
+    type(Agrif_Grid)                    , pointer :: save_grid   => NULL() !< pointer on the save grid
+    type(Agrif_Grid_List)                         :: child_list            !< List of child grids
+    type(Agrif_Variable),   dimension(:), allocatable :: tabvars    !< List of grid variables
+    type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c  !< List of character grid variables
+    type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r  !< List of real      grid variables
+    type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l  !< List of logical   grid variables
+    type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables
+!
+    real   , dimension(3)              :: Agrif_x   !< global x, y and z position
+    real   , dimension(3)              :: Agrif_dx  !< global space step in the x, y and z direction
+    real   , dimension(3)              :: Agrif_dt  !< global time  step in the x, y and z direction
+    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction
+    integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction
+    integer, dimension(3)              :: spaceref  !< space refinement factor in the x, y and z direction
+    integer, dimension(3)              :: timeref   !< Time refinement factor in the x, y and z direction
+    integer                            :: ngridstep !< number of time steps
+    integer                            :: rank
+    integer                            :: grid_id   !< moving grid id
+    integer                            :: fixedrank !< number of the grid
+    logical                            :: fixed     !< fixed or moving grid ?
+    logical                            :: oldgrid
+!> \name Logicals indicating if the current grid has a common border with the root coarse grid
+!> @{
+    logical, dimension(3)              :: NearRootBorder
+    logical, dimension(3)              :: DistantRootBorder
+!> @}
+!> \name Arrays for adaptive grid refinement
+!> @{
+    integer, dimension(:)    ,   allocatable :: tabpoint1D
+    integer, dimension(:,:)  ,   allocatable :: tabpoint2D
+    integer, dimension(:,:,:),   allocatable :: tabpoint3D
+!> @}
+!> \name Members for parallel integration
+!> @{
+    type(Agrif_Rectangle),  pointer    :: rect_in_parent => NULL()
+    type(Agrif_Grid_List)              :: neigh_list                !< List of neighboring grids (ie. connected through a common proc)
+    type(Agrif_Proc_List)              :: proc_def_list             !< List of procs that will integrate this grid
+    type(Agrif_Proc_List)              :: proc_def_in_parent_list   !< List of procs that will integrate this grid (defined as in the parent grid)
+    type(Agrif_Proc_List)              :: required_proc_list        !< List of procs that are required for this grid
+    type(Agrif_Sequence_List), pointer :: child_seq => NULL()       !< Sequence for childs
+    integer                            :: seq_num = 0
+    integer                            :: size = 0
+    integer                            :: dsat = 0
+#if defined AGRIF_MPI
+    integer                            :: communicator = -1
+#endif
+!> @}
+    type(Agrif_Variables_List), pointer :: variables => NULL()
+    integer                             :: NbVariables = 0
+    integer                             :: level    !< level of the grid in the hierarchy
+    logical                             :: allocation_is_done = .false.
+    logical                             :: grand_mother_grid = .false.
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Grid
+!===================================================================================================
+!
+!> this pointer always points on the root grid of the grid hierarchy
+type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
+
+!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
+type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
+
+!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
+!> It contains  the safeguard of the grid hierarchy.
+type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
+
+!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
+type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
+!
+!===================================================================================================
+type Agrif_Sequence
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List) :: gridlist
+    type(Agrif_Proc_List) :: proclist
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Sequence
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Sequence_List
+!---------------------------------------------------------------------------------------------------
+    integer :: nb_seqs
+    type(Agrif_Sequence), dimension(:), allocatable :: sequences
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Sequence_List
+!===================================================================================================
+!
+interface
+    function compare_grids ( grid1, grid2 ) result( res )
+        import Agrif_Grid
+        type(Agrif_Grid), intent(in)    :: grid1
+        type(Agrif_Grid), intent(in)    :: grid2
+        integer                         :: res  !< Result of the comparison :
+                                                !!  - res  < 0   if grid1 <  grid2
+                                                !!  - res == 0   if grid1 == grid2
+                                                !!  - res  > 0   if grid1 >  grid2
+    end function compare_grids
+end interface
+!
+contains
+!
+!===================================================================================================
+subroutine Agrif_gl_print ( gridlist )
+!
+!< DEBUG : a virer à terme.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Grid),  pointer  :: grid
+!
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        grid => gridp % gr
+        write(*,'("G",i0,", ")', advance='no') grid % fixedrank
+        gridp => gridp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_print
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_print_debug ( gridlist )
+!
+!< DEBUG : a virer à terme.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Grid),  pointer  :: grid
+!
+    write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        grid => gridp % gr
+        write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
+            grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
+        gridp => gridp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_print_debug
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_append ( gridlist, grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List),     intent(inout)  :: gridlist
+    type(Agrif_Grid), pointer, intent(in)     :: grid
+!
+    type(Agrif_PGrid), pointer   :: new_gp
+!
+    allocate( new_gp )
+!
+    new_gp % gr   => grid
+    new_gp % next => NULL()
+!
+    if ( associated(gridlist % last) ) then
+    ! the list is not empty, append the new pointer at the end
+        gridlist % last % next => new_gp
+    else
+    ! the list is empty, the new pointer is the first one
+        gridlist % first => new_gp
+    endif
+    ! anyway, for next time 'grid' will be the last one.
+    gridlist % last => new_gp
+    gridlist % nitems = gridlist % nitems + 1
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_append
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_popfirst ( gridlist ) result ( grid )
+!
+!<  Removes the first item of the list and returns it.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gridlist
+!
+    type(Agrif_PGrid), pointer :: grid_p
+    type(Agrif_Grid),  pointer :: grid
+!
+    grid_p => gridlist % first
+!
+    if ( .not. associated( grid_p ) ) then
+        grid => NULL()
+        return
+    endif
+!
+    grid              => grid_p % gr
+    gridlist % first  => grid_p % next
+    gridlist % nitems =  gridlist % nitems - 1
+    if ( .not. associated(gridlist % first) ) then
+       nullify(gridlist % last)
+    endif
+    deallocate(grid_p)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_popfirst
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_copy ( new_gl, model )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(out)  :: new_gl
+    type(Agrif_Grid_List), intent(in)   :: model
+!
+    type(Agrif_PGrid), pointer :: gp
+!
+    call Agrif_gl_clear(new_gl)
+    gp => model % first
+!
+    do while( associated(gp) )
+        call Agrif_gl_append( new_gl, gp % gr )
+        gp => gp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_copy
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_PGrid), pointer, intent(in)   :: gridp
+!
+    type(Agrif_Grid_List), pointer  :: gridlist
+    type(Agrif_PGrid),     pointer  :: gp
+!
+    allocate(gridlist)
+!
+    gp => gridp
+!
+    do while ( associated( gp ) )
+        call Agrif_gl_append( gridlist, gp % gr )
+        gp => gp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_build_from_gp
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gp_delete ( gridp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_PGrid), pointer, intent(inout)  :: gridp
+!
+    type(Agrif_PGrid), pointer   :: gp, gpd
+!
+    if ( .not. associated( gridp ) ) return
+!
+    gp => gridp
+!
+    do while( associated(gp) )
+        gpd => gp
+        gp  => gp % next
+        deallocate(gpd)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gp_delete
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_clear ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)  :: gridlist
+!
+    call Agrif_gp_delete(gridlist % first)
+    gridlist % first => NULL()
+    gridlist % last  => NULL()
+    gridlist % nitems = 0
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_clear
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_delete ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), pointer, intent(inout)  :: gridlist
+!
+    if ( .not. associated( gridlist ) ) return
+!
+    call Agrif_gp_delete(gridlist % first)
+    deallocate( gridlist )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_delete
+!===================================================================================================
+!
+!===================================================================================================
+recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)    :: gridlist
+    procedure(compare_grids)             :: compare_func
+    procedure(compare_grids), optional   :: compare_func_opt
+!
+    type(Agrif_Grid_List), pointer  :: gl_sorted
+    type(Agrif_Grid_List), pointer  :: gl_left,  gl_sorted_left
+    type(Agrif_Grid_List), pointer  :: gl_right, gl_sorted_right
+    type(Agrif_PGrid),     pointer  :: grid_p
+    integer                         :: n, middle
+!
+! if list size is 1, consider it sorted and return it
+    if  ( (gridlist % nitems <= 1) ) then
+        gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
+        return
+    endif
+!
+! else split the list into two sublists
+    n = 1
+    middle    =  gridlist % nitems / 2
+    grid_p    => gridlist % first
+!
+    allocate( gl_left, gl_right )
+!
+    do while ( associated(grid_p) )
+        if ( n <= middle ) then
+            call Agrif_gl_append(gl_left,  grid_p % gr)
+        else
+            call Agrif_gl_append(gl_right, grid_p % gr)
+        endif
+        grid_p => grid_p % next
+        n = n+1
+    enddo
+!
+! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
+    gl_sorted_left  => Agrif_gl_merge_sort(gl_left,  compare_func, compare_func_opt)
+    gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
+!
+! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
+    gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
+!
+    call Agrif_gl_delete( gl_left )
+    call Agrif_gl_delete( gl_right )
+    call Agrif_gl_delete( gl_sorted_left )
+    call Agrif_gl_delete( gl_sorted_right )
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_merge_sort
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gl_left
+    type(Agrif_Grid_List), intent(inout)    :: gl_right
+    procedure(compare_grids)                :: compare_func
+    procedure(compare_grids), optional      :: compare_func_opt
+!
+    type(Agrif_Grid_List), pointer  :: gl_merged
+    type(Agrif_Grid),      pointer  :: poped_grid
+    integer                         :: comp_value
+!
+    allocate( gl_merged )
+!
+    do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
+!
+        if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
+!
+!         Let.s compare both items with the first compare function
+            comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
+!
+            if     ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+            elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
+            else ! ( comp_value == 0 )
+!
+!             Both items are equal, let.s use the second criterion if the optional
+!             compare function is present.
+                if ( present(compare_func_opt) ) then
+!
+                    comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
+!
+                    if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+                    else                        ; poped_grid => Agrif_gl_popfirst(gl_right)
+                    endif
+                else
+!                 If the second criterion is not present, let.s just pick the left item
+                    poped_grid => Agrif_gl_popfirst(gl_left)
+                endif
+            endif
+!
+!     If one of the lists is empty, we just have to pick in the other one.
+        elseif ( gl_left  % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+        elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
+        endif
+!
+        call Agrif_gl_append( gl_merged, poped_grid )
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_merge
+!===================================================================================================
+!
+!===================================================================================================
+function compare_grid_degrees ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
+!---------------------------------------------------------------------------------------------------
+end function compare_grid_degrees
+!===================================================================================================
+!
+!===================================================================================================
+function compare_colors ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid1 % seq_num - grid2 % seq_num
+!---------------------------------------------------------------------------------------------------
+end function compare_colors
+!===================================================================================================
+!
+!===================================================================================================
+function compare_dsat_values ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % dsat - grid1 % dsat
+!---------------------------------------------------------------------------------------------------
+end function compare_dsat_values
+!===================================================================================================
+!
+!===================================================================================================
+function compare_size_values ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % size - grid1 % size
+!---------------------------------------------------------------------------------------------------
+end function compare_size_values
+!===================================================================================================
+!
+end module Agrif_Grids
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F90	(revision 8732)
@@ -0,0 +1,209 @@
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Init.
+!>
+!> Several operations on the variables of the current grid (creation, instanciation, ...)
+!! used during the creation of the grid hierarchy and during the time integration.
+!
+module Agrif_Init
+!
+    use Agrif_Grids
+    use Agrif_Link
+    use Agrif_Mpp
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Allocation
+!
+!> Allocates the arrays containing the values of the variables of the current grd.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Allocation ( Agrif_Gr, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),       pointer   :: Agrif_Gr   !< Pointer on the current grid
+    procedure(alloc_proc),  optional  :: procname   !< Allocation procedure (Default: Agrif_Allocationcalls)
+!
+    if ( present(procname) ) then
+        call procname(Agrif_Gr)
+    else
+        call Agrif_Allocationcalls(Agrif_Gr)
+    endif
+    Agrif_Gr % allocation_is_done = .true.
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!
+        if ( Agrif_Probdim == 1 ) allocate( Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1) )
+        if ( Agrif_Probdim == 2 ) allocate( Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1, &
+                                                                Agrif_Gr%nb(2)+1) )
+        if ( Agrif_Probdim == 3 ) allocate( Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1, &
+                                                                Agrif_Gr%nb(2)+1, &
+                                                                Agrif_Gr%nb(3)+1) )
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Allocation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Instance
+!
+!> Make the pointer Agrif_Types::Agrif_Curgrid point to Agrif_Gr
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Instance ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+!
+    Agrif_Curgrid => Agrif_Gr
+    Agrif_tabvars => Agrif_Curgrid % tabvars
+    Agrif_tabvars_c => Agrif_Curgrid % tabvars_c
+    Agrif_tabvars_r => Agrif_Curgrid % tabvars_r
+    Agrif_tabvars_l => Agrif_Curgrid % tabvars_l
+    Agrif_tabvars_i => Agrif_Curgrid % tabvars_i
+!
+#if defined AGRIF_MPI
+    if ( Agrif_Gr % communicator /= -1 ) then
+        call Agrif_MPI_switch_comm( Agrif_Gr % communicator )
+    endif
+#endif
+!
+    call Agrif_Get_numberofcells(Agrif_Gr)
+    call Agrif_InitWorkSpace()
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Instance
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_initialisations
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_initialisations ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+!
+    integer                         :: i
+    type(Agrif_Variable),   pointer :: var => NULL()
+    type(Agrif_Variable_c), pointer :: var_c => NULL()
+    type(Agrif_Variable_r), pointer :: var_r => NULL()
+    type(Agrif_Variable_l), pointer :: var_l => NULL()
+    type(Agrif_Variable_i), pointer :: var_i => NULL()
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Gr % tabvars(i)
+        var % nbdim = 0
+!
+        if (allocated(var%array1)) then
+            var % nbdim = 1
+            var % lb(1:1) = lbound(var%array1)
+            var % ub(1:1) = ubound(var%array1)
+        endif
+        if (allocated(var%array2)) then
+            var % nbdim = 2
+            var % lb(1:2) = lbound(var%array2)
+            var % ub(1:2) = ubound(var%array2)
+        endif
+        if (allocated(var%array3)) then
+            var % nbdim = 3
+            var % lb(1:3) = lbound(var%array3)
+            var % ub(1:3) = ubound(var%array3)
+        endif
+        if (allocated(var%array4)) then
+            var % nbdim = 4
+            var % lb(1:4) = lbound(var%array4)
+            var % ub(1:4) = ubound(var%array4)
+        endif
+        if (allocated(var%array5)) then
+            var % nbdim = 5
+            var % lb(1:5) = lbound(var%array5)
+            var % ub(1:5) = ubound(var%array5)
+        endif
+        if (allocated(var%array6)) then
+            var % nbdim = 6
+            var % lb(1:6) = lbound(var%array6)
+            var % ub(1:6) = ubound(var%array6)
+        endif
+!
+        if (allocated(var%darray1)) var % nbdim = 1
+        if (allocated(var%darray2)) var % nbdim = 2
+        if (allocated(var%darray3)) var % nbdim = 3
+        if (allocated(var%darray4)) var % nbdim = 4
+        if (allocated(var%darray5)) var % nbdim = 5
+        if (allocated(var%darray6)) var % nbdim = 6
+!
+        if (allocated(var%sarray1)) var % nbdim = 1
+        if (allocated(var%sarray2)) var % nbdim = 2
+        if (allocated(var%sarray3)) var % nbdim = 3
+        if (allocated(var%sarray4)) var % nbdim = 4
+        if (allocated(var%sarray5)) var % nbdim = 5
+        if (allocated(var%sarray6)) var % nbdim = 6
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(1)
+!
+        var_c => Agrif_Gr % tabvars_c(i)
+        var_c % nbdim = 0
+!
+        if (allocated(var_c%carray1)) var_c % nbdim = 1
+        if (allocated(var_c%carray2)) var_c % nbdim = 2
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(2)
+!
+        var_r => Agrif_Gr % tabvars_r(i)
+        var_r % nbdim = 0
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(3)
+!
+        var_l => Agrif_Gr % tabvars_l(i)
+        var_l % nbdim = 0
+!
+        if (allocated(var_l%larray1)) var_l % nbdim = 1
+        if (allocated(var_l%larray2)) var_l % nbdim = 2
+        if (allocated(var_l%larray3)) var_l % nbdim = 3
+        if (allocated(var_l%larray4)) var_l % nbdim = 4
+        if (allocated(var_l%larray5)) var_l % nbdim = 5
+        if (allocated(var_l%larray6)) var_l % nbdim = 6
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(4)
+!
+        var_i => Agrif_Gr % tabvars_i(i)
+        var_i % nbdim = 0
+!
+        if (allocated(var_i%iarray1)) var_i % nbdim = 1
+        if (allocated(var_i%iarray2)) var_i % nbdim = 2
+        if (allocated(var_i%iarray3)) var_i % nbdim = 3
+        if (allocated(var_i%iarray4)) var_i % nbdim = 4
+        if (allocated(var_i%iarray5)) var_i % nbdim = 5
+        if (allocated(var_i%iarray6)) var_i % nbdim = 6
+!
+    enddo
+
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_initialisations
+!===================================================================================================
+!
+end module Agrif_Init
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 8732)
@@ -0,0 +1,86 @@
+!
+! $Id$
+!
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Init_Vars
+!>
+!> Initialization of the variables of the current grid.
+!
+module Agrif_Init_Vars
+!
+    use Agrif_Types
+    use Agrif_Grids
+    use Agrif_Link
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Create_Var
+!
+!> Allocation of the list of grid variables for grid Agrif_Gr.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Create_Var ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
+!
+    integer :: nb
+!
+    if (Agrif_NbVariables(0) > 0) allocate(Agrif_Gr % tabvars  (Agrif_NbVariables(0)))
+    if (Agrif_NbVariables(1) > 0) allocate(Agrif_Gr % tabvars_c(Agrif_NbVariables(1)))
+    if (Agrif_NbVariables(2) > 0) allocate(Agrif_Gr % tabvars_r(Agrif_NbVariables(2)))
+    if (Agrif_NbVariables(3) > 0) allocate(Agrif_Gr % tabvars_l(Agrif_NbVariables(3)))
+    if (Agrif_NbVariables(4) > 0) allocate(Agrif_Gr % tabvars_i(Agrif_NbVariables(4)))
+!
+    if ( Agrif_Gr % fixedrank /= 0 ) then
+        do nb = 1, Agrif_NbVariables(0)
+            Agrif_Gr % tabvars(nb) % parent_var => Agrif_Gr % parent % tabvars(nb)
+            Agrif_Gr % tabvars(nb) % nbdim      =  Agrif_Mygrid % tabvars(nb) % nbdim
+            Agrif_Gr % tabvars(nb) % root_var   => Agrif_Mygrid % tabvars(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(1)
+            Agrif_Gr % tabvars_c(nb) % parent_var => Agrif_Gr % parent % tabvars_c(nb)
+            Agrif_Gr % tabvars_c(nb) % nbdim      =  Agrif_Mygrid % tabvars_c(nb) % nbdim
+            Agrif_Gr % tabvars_c(nb) % root_var   => Agrif_Mygrid % tabvars_c(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(2)
+            Agrif_Gr % tabvars_r(nb) % parent_var => Agrif_Gr % parent % tabvars_r(nb)
+            Agrif_Gr % tabvars_r(nb) % nbdim      =  Agrif_Mygrid % tabvars_r(nb) % nbdim
+            Agrif_Gr % tabvars_r(nb) % root_var   => Agrif_Mygrid % tabvars_r(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(3)
+            Agrif_Gr % tabvars_l(nb) % parent_var => Agrif_Gr % parent % tabvars_l(nb)
+            Agrif_Gr % tabvars_l(nb) % nbdim      =  Agrif_Mygrid % tabvars_l(nb) % nbdim
+            Agrif_Gr % tabvars_l(nb) % root_var   => Agrif_Mygrid % tabvars_l(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(4)
+            Agrif_Gr % tabvars_i(nb) % parent_var => Agrif_Gr % parent % tabvars_i(nb)
+            Agrif_Gr % tabvars_i(nb) % nbdim      =  Agrif_Mygrid % tabvars_i(nb) % nbdim
+            Agrif_Gr % tabvars_i(nb) % root_var   => Agrif_Mygrid % tabvars_i(nb)
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Create_Var
+!===================================================================================================
+!
+end module Agrif_Init_Vars
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90	(revision 8732)
@@ -0,0 +1,1526 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module to initialize a fine grid from its parent grid, by using a space interpolation
+!
+module Agrif_Interpolation
+!
+    use Agrif_InterpBasic
+    use Agrif_Arrays
+    use Agrif_Mask
+    use Agrif_CurgridFunctions
+#if defined AGRIF_MPI
+    use Agrif_Mpp
+#endif
+!
+    implicit none
+!
+    logical, private:: precomputedone(7) = .FALSE.
+!
+    private :: Agrif_Parentbounds
+    private :: Agrif_Interp_1D_recursive, Agrif_Interp_2D_recursive, Agrif_Interp_3D_recursive
+    private :: Agrif_Interp_4D_recursive, Agrif_Interp_5D_recursive, Agrif_Interp_6D_recursive
+    private :: Agrif_InterpBase
+    private :: Agrif_Find_list_interp, Agrif_AddTo_list_interp
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_InterpVariable
+!
+!> Sets some arguments of subroutine Agrif_InterpnD, n being the dimension of the grid variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpVariable ( parent, child, torestore, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    logical,              intent(in)    :: torestore    !< .false. indicates that the results of the
+                                                        !! interpolation are applied on the whole current grid
+    procedure()                         :: procname     !< Data recovery procedure
+!---------------------------------------------------------------------------------------------------
+    logical               :: memberin
+    integer               :: nbdim        ! Number of dimensions of the current grid
+    integer, dimension(6) :: type_interp  ! Type of interpolation (linear,spline,...)
+    integer, dimension(6) :: nb_child
+    integer, dimension(6) :: lb_child
+    integer, dimension(6) :: ub_child
+    integer, dimension(6) :: lb_parent
+    real   , dimension(6) :: s_child,   s_parent
+    real   , dimension(6) :: ds_child, ds_parent
+    integer, dimension(child % root_var % nbdim,2,2) :: childarray
+!
+    nbdim       = child % root_var % nbdim
+    type_interp = child % root_var % type_interp
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.true.)
+!
+!   Call to a procedure of interpolation against the number of dimensions of the grid variable
+!
+    call Agrif_InterpnD(type_interp, parent, child, &
+                        lb_child, ub_child,         &
+                        lb_child, lb_parent,        &
+                        s_child,   s_parent,        &
+                        ds_child, ds_parent,        &
+                        child, torestore, nbdim,    &
+                        childarray, memberin,       &
+                        .false., procname, 0, 0)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpnD
+!
+!> Interpolates a nD grid variable from its parent grid, by using a space interpolation
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpnD ( type_interp, parent, child, pttab, petab, pttab_Child, pttab_Parent, &
+                            s_Child, s_Parent, ds_Child, ds_Parent, restore, torestore,          &
+                            nbdim, childarray, memberin, in_bc, procname, nb, ndir )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    INTEGER, DIMENSION(6),     INTENT(in)   :: type_interp  !< Type of interpolation !    (linear,...)
+    TYPE(Agrif_Variable),      pointer      :: parent       !< Variable of the parent grid
+    TYPE(Agrif_Variable),      pointer      :: child        !< Variable of the child grid
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab        !< Index of the first point inside the domain
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: petab        !< Index of the first point inside the domain
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Child  !< Index of the first point inside the domain
+                                                            !<    for the child grid variable
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Parent !< Index of the first point inside the domain
+                                                            !<    for the parent grid variable
+    REAL,    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids
+    REAL,    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids
+    TYPE(Agrif_Variable),      pointer      :: restore            !< Indicates points where interpolation
+    LOGICAL,                   INTENT(in)   :: torestore          !< Indicates if the array restore is used
+    INTEGER,                   INTENT(in)   :: nbdim
+    LOGICAL,                   INTENT(out)  :: memberin
+    LOGICAL,                   INTENT(in)   :: in_bc              !< .true. if called from Agrif_CorrectVariable \n
+                                                                  !! .false. if called from Agrif_InterpVariable
+    procedure()                             :: procname           !< Data recovery procedure
+    INTEGER,                   INTENT(in)   :: nb, ndir
+!
+    INTEGER                       :: i,j,k,l,m,n
+    INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab
+    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax
+    INTEGER, DIMENSION(nbdim)     :: indminglob, indmaxglob
+#if defined AGRIF_MPI
+    INTEGER, DIMENSION(nbdim)     :: indminglob2,indmaxglob2
+#endif
+    LOGICAL, DIMENSION(nbdim)     :: noraftab
+    REAL   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp
+    INTEGER, DIMENSION(nbdim)     :: lowerbound, upperbound, coords
+    INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray
+    INTEGER, DIMENSION(nbdim,2,2)              :: parentarray
+    LOGICAL :: member
+    LOGICAL :: find_list_interp
+!
+#if defined AGRIF_MPI
+!
+    INTEGER, PARAMETER          :: etiquette = 100
+    INTEGER                     :: code, local_proc
+    INTEGER, DIMENSION(nbdim,4)                     :: tab3
+    INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1)   :: tab4
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: memberinall
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: sendtoproc1, recvfromproc1
+    LOGICAL, DIMENSION(1)                           :: memberin1
+    LOGICAL                                         :: memberout
+!
+#endif
+!
+    type(Agrif_Variable), pointer, save :: tempC => NULL()        ! Temporary child grid variable
+    type(Agrif_Variable), pointer, save :: tempP => NULL()        ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: tempPextend => NULL()  ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: parentvalues => NULL()
+!
+    coords = child % root_var % coords
+!
+!   Boundaries of the current grid where interpolation is done
+    find_list_interp =                                              &
+        Agrif_Find_list_interp(                                     &
+            child % list_interp,                                    &
+            pttab, petab, pttab_Child, pttab_Parent, nbdim,         &
+            indmin, indmax, indminglob, indmaxglob,                 &
+            pttruetab, cetruetab, memberin                          &
+#if defined AGRIF_MPI
+           ,indminglob2, indmaxglob2, parentarray,                  &
+            member, tab4t,memberinall,  sendtoproc1, recvfromproc1  &
+#endif
+        )
+!
+    if (.not.find_list_interp) then
+!
+        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+        call Agrif_Childbounds(nbdim, lowerbound, upperbound,               &
+                               pttab, petab, Agrif_Procrank, coords,        &
+                               pttruetab, cetruetab, memberin)
+        call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    &
+                                s_Parent_temp,s_Child_temp,                 &
+                                s_Child,ds_Child,                           &
+                                s_Parent,ds_Parent,                         &
+                                pttab,petab,                                &
+                                pttab_Child,pttab_Parent,                   &
+                                child%root_var % posvar, coords)
+#if defined AGRIF_MPI
+        if (memberin) then
+            call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax,        &
+                                    s_Parent_temp,s_Child_temp,             &
+                                    s_Child,ds_Child,                       &
+                                    s_Parent,ds_Parent,                     &
+                                    pttruetab,cetruetab,                    &
+                                    pttab_Child,pttab_Parent,               &
+                                    child%root_var % posvar, coords)
+        endif
+
+        local_proc = Agrif_Procrank
+        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
+                               indminglob,indmaxglob, local_proc, coords,   &
+                               indminglob2,indmaxglob2,member)
+!
+        if (member) then
+            call Agrif_GlobalToLocalBounds(parentarray,                     &
+                                           lowerbound,  upperbound,         &
+                                           indminglob2, indmaxglob2, coords,&
+                                           nbdim, local_proc, member)
+        endif
+
+        call Agrif_ParentGrid_to_ChildGrid()
+#else
+        parentarray(:,1,1) = indminglob
+        parentarray(:,2,1) = indmaxglob
+        parentarray(:,1,2) = indminglob
+        parentarray(:,2,2) = indmaxglob
+        indmin = indminglob
+        indmax = indmaxglob
+        member = .TRUE.
+#endif
+
+    else
+
+#if defined AGRIF_MPI
+        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+        s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
+#else
+        parentarray(:,1,1) = indminglob
+        parentarray(:,2,1) = indmaxglob
+        parentarray(:,1,2) = indminglob
+        parentarray(:,2,2) = indmaxglob
+        indmin = indminglob
+        indmax = indmaxglob
+        member = .TRUE.
+        s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent
+        s_Child_temp  = s_Child + (pttab - pttab_Child) * ds_Child
+#endif
+    endif
+!
+    if (member) then
+        if (.not.associated(tempP)) allocate(tempP)
+!
+        call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim)
+        call Agrif_var_set_array_tozero(tempP,nbdim)
+
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        select case (nbdim)
+        case(1)
+            call procname(tempP%array1,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir)
+        case(2)
+            call procname(tempP%array2,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir)
+        case(3)
+            call procname(tempP%array3,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir)
+        case(4)
+            call procname(tempP%array4,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir)
+        case(5)
+            call procname(tempP%array5,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),    &
+                      parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir)
+        case(6)
+            call procname(tempP%array6,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),    &
+                      parentarray(5,1,2),parentarray(5,2,2),    &
+                      parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
+        end select
+!
+        call Agrif_ParentGrid_to_ChildGrid()
+!
+    endif
+
+#if defined AGRIF_MPI
+    if (.not.find_list_interp) then
+!
+        tab3(:,1) = indminglob2(:)
+        tab3(:,2) = indmaxglob2(:)
+        tab3(:,3) = indmin(:)
+        tab3(:,4) = indmax(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        if (.not.associated(tempPextend))   allocate(tempPextend)
+
+        do k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = memberin
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+
+        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),         &
+                                     tab4t(:,:,3),tab4t(:,:,4),         &
+                                     nbdim,memberinall, coords,         &
+                                     sendtoproc1,recvfromproc1,         &
+                                     tab4t(:,:,5),tab4t(:,:,6),         &
+                                     tab4t(:,:,7),tab4t(:,:,8) )
+    endif
+
+    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
+            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
+            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,tempPextend)
+#else
+    tempPextend => tempP
+#endif
+
+    if (.not.find_list_interp) then
+        call Agrif_Addto_list_interp(                           &
+                child%list_interp,pttab,petab,                  &
+                pttab_Child,pttab_Parent,indmin,indmax,         &
+                indminglob,indmaxglob,                          &
+                pttruetab,cetruetab,                            &
+                memberin,nbdim                                  &
+#if defined AGRIF_MPI
+               ,indminglob2,indmaxglob2,                        &
+                parentarray,                                    &
+                member,                                         &
+                tab4t,memberinall,sendtoproc1,recvfromproc1     &
+#endif
+        )
+    endif
+!
+    if (memberin) then
+!
+        if (.not.associated(tempC)) allocate(tempC)
+!
+        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+!
+!       Special values on the parent grid
+        if (Agrif_UseSpecialValue) then
+!
+            noraftab(1:nbdim) = child % root_var % interptab(1:nbdim) == 'N'
+!
+            if (.not.associated(parentvalues))  allocate(parentvalues)
+!
+            call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim)
+            call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim)
+!
+            call Agrif_CheckMasknD(tempPextend,parentvalues,    &
+                    indmin(1:nbdim),indmax(1:nbdim),            &
+                    indmin(1:nbdim),indmax(1:nbdim),            &
+                    noraftab(1:nbdim),nbdim)
+!
+            call Agrif_array_deallocate(parentvalues,nbdim)
+!
+        endif
+!
+!       Interpolation of the current grid
+!
+        if ( memberin ) then
+            select case(nbdim)
+            case(1)
+                call Agrif_Interp_1D_recursive( type_interp(1),                         &
+                                                tempPextend%array1,                     &
+                                                tempC%array1,                           &
+                                                indmin(1), indmax(1),                   &
+                                                pttruetab(1),    cetruetab(1),          &
+                                                s_Child_temp(1), s_Parent_temp(1),      &
+                                                ds_Child(1),     ds_Parent(1) )
+            case(2)
+                call Agrif_Interp_2D_recursive( type_interp(1:2),                       &
+                                                tempPextend % array2,                   &
+                                                tempC       % array2,                   &
+                                                indmin(1:2), indmax(1:2),               &
+                                                pttruetab(1:2),    cetruetab(1:2),      &
+                                                s_Child_temp(1:2), s_Parent_temp(1:2),  &
+                                                ds_Child(1:2),    ds_Parent(1:2) )
+            case(3)
+                call Agrif_Interp_3D_recursive( type_interp(1:3),                       &
+                                                tempPextend % array3,                   &
+                                                tempC       % array3,                   &
+                                                indmin(1:3), indmax(1:3),               &
+                                                pttruetab(1:3),    cetruetab(1:3),      &
+                                                s_Child_temp(1:3), s_Parent_temp(1:3),  &
+                                                ds_Child(1:3),    ds_Parent(1:3) )
+            case(4)
+                call Agrif_Interp_4D_recursive( type_interp(1:4),                       &
+                                                tempPextend % array4,                   &
+                                                tempC       % array4,                   &
+                                                indmin(1:4), indmax(1:4),               &
+                                                pttruetab(1:4),    cetruetab(1:4),      &
+                                                s_Child_temp(1:4), s_Parent_temp(1:4),  &
+                                                ds_Child(1:4),    ds_Parent(1:4) )
+            case(5)
+                call Agrif_Interp_5D_recursive( type_interp(1:5),                       &
+                                                tempPextend % array5,                   &
+                                                tempC       % array5,                   &
+                                                indmin(1:5), indmax(1:5),               &
+                                                pttruetab(1:5),    cetruetab(1:5),      &
+                                                s_Child_temp(1:5), s_Parent_temp(1:5),  &
+                                                ds_Child(1:5),    ds_Parent(1:5) )
+            case(6)
+                call Agrif_Interp_6D_recursive( type_interp(1:6),                       &
+                                                tempPextend % array6,                   &
+                                                tempC       % array6,                   &
+                                                indmin(1:6), indmax(1:6),               &
+                                                pttruetab(1:6),    cetruetab(1:6),      &
+                                                s_Child_temp(1:6), s_Parent_temp(1:6),  &
+                                                ds_Child(1:6),    ds_Parent(1:6) )
+            end select
+!
+            call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim)
+
+#if defined AGRIF_MPI
+            call Agrif_GlobalToLocalBounds(childarray, lowerbound, upperbound,  &
+                                            pttruetab, cetruetab, coords,       &
+                                            nbdim, Agrif_Procrank, memberout)
+#else
+            childarray(:,1,1) = pttruetab
+            childarray(:,2,1) = cetruetab
+            childarray(:,1,2) = pttruetab
+            childarray(:,2,2) = cetruetab
+!cccccccccccccc       memberout = .TRUE.
+#endif
+!
+!           Special values on the child grid
+            if (Agrif_UseSpecialValueFineGrid) then
+                call GiveAgrif_SpecialValueToTab_mpi( child, tempC, childarray, Agrif_SpecialValueFineGrid,nbdim )
+            endif
+!
+        endif   ! ( memberin )
+!
+        if (torestore) then
+!
+#if defined AGRIF_MPI
+!
+            SELECT CASE (nbdim)
+            CASE (1)
+                do i = pttruetab(1),cetruetab(1)
+!hildarrayAModifier     if (restore%restore1D(i) == 0)      &
+!hildarrayAModifier         child%array1(childarray(i,1,2)) = tempC%array1(i)
+                enddo
+            CASE (2)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+!hildarrayAModifier     if (restore%restore2D(i,j) == 0)    &
+!hildarrayAModifier         child%array2(childarray(i,1,2), &
+!hildarrayAModifier                          childarray(j,2,2)) = tempC%array2(i,j)
+                enddo
+                enddo
+            CASE (3)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+!hildarrayAModifier     if (restore%restore3D(i,j,k) == 0)  &
+!hildarrayAModifier         child%array3(childarray(i,1,2), &
+!hildarrayAModifier                          childarray(j,2,2), &
+!hildarrayAModifier                          childarray(k,3,2)) = tempC%array3(i,j,k)
+                enddo
+                enddo
+                enddo
+            CASE (4)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+!hildarrayAModifier     if (restore%restore4D(i,j,k,l) == 0)    &
+!hildarrayAModifier         child%array4(childarray(i,1,2),     &
+!hildarrayAModifier                          childarray(j,2,2),     &
+!hildarrayAModifier                          childarray(k,3,2),     &
+!hildarrayAModifier                          childarray(l,4,2)) = tempC%array4(i,j,k,l)
+                enddo
+                enddo
+                enddo
+                enddo
+            CASE (5)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+                do m = pttruetab(5),cetruetab(5)
+!hildarrayAModifier     if (restore%restore5D(i,j,k,l,m) == 0)  &
+!hildarrayAModifier         child%array5(childarray(i,1,2),     &
+!hildarrayAModifier                          childarray(j,2,2),     &
+!hildarrayAModifier                          childarray(k,3,2),     &
+!hildarrayAModifier                          childarray(l,4,2),     &
+!hildarrayAModifier                          childarray(m,5,2)) = tempC%array5(i,j,k,l,m)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            CASE (6)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+                do m = pttruetab(5),cetruetab(5)
+                do n = pttruetab(6),cetruetab(6)
+!hildarrayAModifier     if (restore%restore6D(i,j,k,l,m,n) == 0)    &
+!hildarrayAModifier         child%array6(childarray(i,1,2),         &
+!hildarrayAModifier                          childarray(j,2,2),         &
+!hildarrayAModifier                          childarray(k,3,2),         &
+!hildarrayAModifier                          childarray(l,4,2),         &
+!hildarrayAModifier                          childarray(m,5,2),         &
+!hildarrayAModifier                          childarray(n,6,2)) = tempC%array6(i,j,k,l,m,n)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            END SELECT
+!
+#else
+            select case (nbdim)
+            case (1)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore1D(i) == 0)          &
+                        parray1(i) = tempC % array1(i)
+                enddo
+            case (2)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore2D(i,j) == 0)        &
+                        parray2(i,j) = tempC % array2(i,j)
+                enddo
+                enddo
+            case (3)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore3D(i,j,k) == 0)      &
+                        parray3(i,j,k) = tempC % array3(i,j,k)
+                enddo
+                enddo
+                enddo
+            case (4)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore4D(i,j,k,l) == 0)    &
+                        parray4(i,j,k,l) = tempC % array4(i,j,k,l)
+                enddo
+                enddo
+                enddo
+                enddo
+            case (5)
+                do m = pttruetab(5),cetruetab(5)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore5D(i,j,k,l,m) == 0)  &
+                        parray5(i,j,k,l,m) = tempC % array5(i,j,k,l,m)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            case (6)
+                do n = pttruetab(6),cetruetab(6)
+                do m = pttruetab(5),cetruetab(5)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore6D(i,j,k,l,m,n) == 0)    &
+                        parray6(i,j,k,l,m,n) = tempC % array6(i,j,k,l,m,n)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            end select
+!
+#endif
+!
+        else    ! .not.to_restore
+!
+            if (memberin) then
+    !
+                if ( .not.in_bc ) then
+                    select case(nbdim)
+                    case(1)
+                        call procname(tempC % array1(            &
+                                childarray(1,1,1):childarray(1,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),.FALSE.,nb,ndir)
+                    case(2)
+                        call procname(                                &
+                                tempC % array2(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),.FALSE.,nb,ndir)
+                    case(3)
+                        call procname(                                &
+                                tempC % array3(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),.FALSE.,nb,ndir)
+                    case(4)
+                        call procname(                                &
+                                tempC % array4(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),.FALSE.,nb,ndir)
+                    case(5)
+                        call procname(                                &
+                                tempC % array5(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1),  &
+                                childarray(5,1,1):childarray(5,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),  &
+                                childarray(5,1,2),childarray(5,2,2),.FALSE.,nb,ndir)
+                    case(6)
+                        call procname(                                &
+                                tempC % array6(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1),  &
+                                childarray(5,1,1):childarray(5,2,1),  &
+                                childarray(6,1,1):childarray(6,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),  &
+                                childarray(5,1,2),childarray(5,2,2),  &
+                                childarray(6,1,2),childarray(6,2,2),.FALSE.,nb,ndir)
+                    end select
+                else    ! we are in_bc
+                    select case (nbdim)
+                    case (1)
+                        parray1(childarray(1,1,2):childarray(1,2,2)) =    &
+                         tempC%array1(childarray(1,1,1):childarray(1,2,1))
+                    case (2)
+                        parray2(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2)) =    &
+                         tempC%array2(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1))
+                    case (3)
+                        parray3(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2)) =    &
+                         tempC%array3(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1))
+                    case (4)
+                        parray4(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2)) =    &
+                         tempC%array4(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1))
+                    case (5)
+                        parray5(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2),      &
+                                      childarray(5,1,2):childarray(5,2,2)) =    &
+                         tempC%array5(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1),      &
+                                      childarray(5,1,1):childarray(5,2,1))
+                    case (6)
+                        parray6(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2),      &
+                                      childarray(5,1,2):childarray(5,2,2),      &
+                                      childarray(6,1,2):childarray(6,2,2)) =    &
+                         tempC%array6(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1),      &
+                                      childarray(5,1,1):childarray(5,2,1),      &
+                                      childarray(6,1,1):childarray(6,2,1))
+                    end select
+                endif  ! < (.not.in_bc)
+            endif  ! < memberin
+!
+        endif
+
+        call Agrif_array_deallocate(tempPextend,nbdim)
+        call Agrif_array_deallocate(tempC,nbdim)
+
+    endif
+!
+!   Deallocations
+#if defined AGRIF_MPI
+    if (member) then
+        call Agrif_array_deallocate(tempP,nbdim)
+    endif
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Parentbounds
+!
+!> Calculates the bounds of the parent grid for the interpolation of the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, &
+                                s_Parent_temp, s_Child_temp,        &
+                                s_Child, ds_Child,                  &
+                                s_Parent,ds_Parent,                 &
+                                pttruetab, cetruetab,               &
+                                pttab_Child, pttab_Parent, posvar, coords )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, DIMENSION(6),     intent(in)  :: type_interp
+    INTEGER,                   intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax
+    REAL,    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp
+    REAL,    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child
+    REAL,    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent
+    INTEGER, DIMENSION(nbdim), intent(in)  :: pttruetab, cetruetab
+    INTEGER, DIMENSION(nbdim), intent(in)  :: pttab_Child, pttab_Parent
+    INTEGER, DIMENSION(nbdim), intent(in)  :: posvar
+    INTEGER, DIMENSION(nbdim), intent(in)  :: coords
+!
+    INTEGER :: i
+    REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax
+!
+    dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
+    dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
+!
+    do i = 1,nbdim
+!
+        indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+        indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+!
+!       Necessary for the Quadratic interpolation
+!
+        if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then
+        elseif ( coords(i) == 0 ) then  ! (interptab == 'N')
+        elseif ( (type_interp(i) == Agrif_ppm)     .or.     &
+                 (type_interp(i) == Agrif_eno)     .or.     &
+                 (type_interp(i) == Agrif_ppm_lim) .or.     &
+                 (type_interp(i) == Agrif_weno) ) then
+            indmin(i) = indmin(i) - 2
+            indmax(i) = indmax(i) + 2
+
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+
+        elseif ( (type_interp(i) /= Agrif_constant) .and.   &
+                 (type_interp(i) /= Agrif_linear) ) then
+            indmin(i) = indmin(i) - 1
+            indmax(i) = indmax(i) + 1
+
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+
+        elseif ( (type_interp(i) == Agrif_constant) .or.   &
+                 (type_interp(i) == Agrif_linear) ) then
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+
+        endif
+!
+    enddo
+!
+    s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+    s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Parentbounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_1D_Recursive
+!
+!> Subroutine for the interpolation of a 1D grid variable.
+!> It calls Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_1D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer,            intent(in)  :: type_interp
+    integer,            intent(in)  :: indmin, indmax
+    integer,            intent(in)  :: pttab_child, petab_child
+    real,               intent(in)  :: s_child, s_parent
+    real,               intent(in)  :: ds_child, ds_parent
+    real, dimension(            &
+        indmin:indmax           &
+    ),                  intent(in)  :: tabin
+    real, dimension(            &
+        pttab_child:petab_child &
+    ),                  intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    call Agrif_InterpBase(type_interp,                      &
+                          tabin(indmin:indmax),             &
+                          tabout(pttab_child:petab_child),  &
+                          indmin, indmax,                   &
+                          pttab_child, petab_child,         &
+                          s_parent,    s_child,             &
+                         ds_parent,   ds_child)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_1D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_2D_Recursive
+!
+!> Subroutine for the interpolation of a 2D grid variable.
+!> It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_2D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(2),              intent(in)  :: type_interp
+    integer, dimension(2),              intent(in)  :: indmin, indmax
+    integer, dimension(2),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(2),              intent(in)  :: s_child, s_parent
+    real,    dimension(2),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        indmin(2):indmax(2))            :: tabtemp
+    real, dimension(                    &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(1):petab_child(1))  :: tabout_trsp
+    real, dimension(                    &
+        indmin(2):indmax(2),            &
+        pttab_child(1):petab_child(1))  :: tabtemp_trsp
+    integer                             :: i, j, coeffraf
+!---------------------------------------------------------------------------------------------------
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    if ((type_interp(1) == Agrif_Linear) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(1))     &
+            call Linear1dPrecompute2d(                  &
+                    indmax(2)-indmin(2)+1,              &
+                    indmax(1)-indmin(1)+1,              &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+        call Linear1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+!
+    elseif ((type_interp(1) == Agrif_PPM) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(1))     &
+            call PPM1dPrecompute2d(                     &
+                    indmax(2)-indmin(2)+1,              &
+                    indmax(1)-indmin(1)+1,              &
+                    petab_child(1)-pttab_child(1)+1,        &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+    else
+        do j = indmin(2),indmax(2)
+!
+!---CDIR NEXPAND
+            call Agrif_Interp_1D_recursive(type_interp(1),                  &
+                    tabin(indmin(1):indmax(1),j),               &
+                    tabtemp(pttab_child(1):petab_child(1),j),   &
+                    indmin(1),indmax(1),                    &
+                    pttab_child(1),petab_child(1),          &
+                    s_child(1), s_parent(1),                &
+                    ds_child(1),ds_parent(1))
+!
+        enddo
+    endif
+
+    coeffraf = nint(ds_parent(2)/ds_child(2))
+    tabtemp_trsp = TRANSPOSE(tabtemp)
+
+    if ((type_interp(2) == Agrif_Linear) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(2))     &
+            call Linear1dPrecompute2d(                  &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    indmax(2)-indmin(2)+1,              &
+                    petab_child(2)-pttab_child(2)+1,    &
+                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+        call Linear1dAfterCompute(tabtemp_trsp,tabout_trsp, &
+                size(tabtemp_trsp),size(tabout_trsp),2)
+
+    elseif ((type_interp(2) == Agrif_PPM) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(2))     &
+            call PPM1dPrecompute2d(                     &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    indmax(2)-indmin(2)+1,              &
+                    petab_child(2)-pttab_child(2)+1,    &
+                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+        call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp,    &
+                               size(tabtemp_trsp), size(tabout_trsp), 2)
+    else
+        do i = pttab_child(1), petab_child(1)
+!
+!---CDIR NEXPAND
+            call Agrif_InterpBase(type_interp(2),                                   &
+                                  tabtemp_trsp(indmin(2):indmax(2), i),             &
+                                  tabout_trsp(pttab_child(2):petab_child(2), i),    &
+                                  indmin(2), indmax(2),                             &
+                                  pttab_child(2), petab_child(2),                   &
+                                  s_parent(2),    s_child(2),                       &
+                                 ds_parent(2),   ds_child(2) )
+        enddo
+    endif
+!
+    tabout = TRANSPOSE(tabout_trsp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_2D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_3D_Recursive
+!
+!> Subroutine for the interpolation of a 3D grid variable.
+!> It calls #Agrif_Interp_2D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_3D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),              intent(in)  :: type_interp
+    integer, dimension(3),              intent(in)  :: indmin, indmax
+    integer, dimension(3),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(3),              intent(in)  :: s_child, s_parent
+    real,    dimension(3),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        indmin(3):indmax(3))            :: tabtemp
+    integer                             :: i, j, k, coeffraf
+    integer                             :: locind_child_left, kdeb
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+    if ( (type_interp(1) == Agrif_Linear) .and. (coeffraf/=1) ) then
+        call Linear1dPrecompute2d(indmax(2)-indmin(2)+1,            &
+                                  indmax(1)-indmin(1)+1,            &
+                                  petab_child(1)-pttab_child(1)+1,  &
+                                  s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    elseif ( (type_interp(1) == Agrif_PPM) .and. (coeffraf/=1) ) then
+        call PPM1dPrecompute2d(indmax(2)-indmin(2)+1,           &
+                               indmax(1)-indmin(1)+1,           &
+                               petab_child(1)-pttab_child(1)+1, &
+                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    endif
+
+    coeffraf = nint ( ds_parent(2) / ds_child(2) )
+    if ( (type_interp(2) == Agrif_Linear) .and. (coeffraf/=1) ) then
+        call Linear1dPrecompute2d(petab_child(1)-pttab_child(1)+1,  &
+                                  indmax(2)-indmin(2)+1,            &
+                                  petab_child(2)-pttab_child(2)+1,  &
+                                  s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    elseif ( (type_interp(2) == Agrif_PPM) .and. (coeffraf/=1) ) then
+        call PPM1dPrecompute2d(petab_child(1)-pttab_child(1)+1, &
+                               indmax(2)-indmin(2)+1,           &
+                               petab_child(2)-pttab_child(2)+1, &
+                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    endif
+!
+    do k = indmin(3), indmax(3)
+        call Agrif_Interp_2D_recursive(type_interp(1:2),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2), k),               &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2), k),   &
+                                       indmin(1:2), indmax(1:2),                    &
+                                       pttab_child(1:2), petab_child(1:2),          &
+                                       s_child(1:2),     s_parent(1:2),             &
+                                       ds_child(1:2),   ds_parent(1:2) )
+    enddo
+!
+    precomputedone(1) = .FALSE.
+    precomputedone(2) = .FALSE.
+    coeffraf = nint(ds_parent(3)/ds_child(3))
+!
+    if ( coeffraf == 1 ) then
+        locind_child_left = 1 + agrif_int((s_child(3)-s_parent(3))/ds_parent(3))
+        kdeb = indmin(3)+locind_child_left-2
+        do k = pttab_child(3),petab_child(3)
+            kdeb = kdeb + 1
+            do j = pttab_child(2), petab_child(2)
+            do i = pttab_child(1), petab_child(1)
+                tabout(i,j,k) = tabtemp(i,j,kdeb)
+            enddo
+            enddo
+        enddo
+    else
+        do j = pttab_child(2), petab_child(2)
+        do i = pttab_child(1), petab_child(1)
+            call Agrif_InterpBase(type_interp(3),                                   &
+                                  tabtemp(i,j,indmin(3):indmax(3)),                 &
+                                  tabout(i,j,pttab_child(3):petab_child(3)),        &
+                                  indmin(3), indmax(3),                             &
+                                  pttab_child(3), petab_child(3),                   &
+                                  s_parent(3),    s_child(3),                       &
+                                 ds_parent(3),   ds_child(3) )
+        enddo
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_3D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_4D_Recursive
+!
+!> Subroutine for the interpolation of a 4D grid variable.
+!> It calls #Agrif_Interp_3D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_4D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(4),              intent(in)  :: type_interp
+    integer, dimension(4),              intent(in)  :: indmin, indmax
+    integer, dimension(4),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(4),              intent(in)  :: s_child, s_parent
+    real,    dimension(4),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        indmin(4):indmax(4))            :: tabtemp
+    integer                             :: i, j, k, l
+!
+    do l = indmin(4), indmax(4)
+        call Agrif_Interp_3D_recursive(type_interp(1:3),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3), l),               &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2),       &
+                                               pttab_child(3):petab_child(3), l),   &
+                                       indmin(1:3), indmax(1:3),                    &
+                                       pttab_child(1:3), petab_child(1:3),          &
+                                       s_child(1:3),    s_parent(1:3),              &
+                                       ds_child(1:3),  ds_parent(1:3) )
+    enddo
+!
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(4),                                       &
+                              tabtemp(i,j,k,indmin(4):indmax(4)),                   &
+                              tabout(i,j,k,pttab_child(4):petab_child(4)),          &
+                              indmin(4), indmax(4),                                 &
+                              pttab_child(4), petab_child(4),                       &
+                              s_parent(4),    s_child(4),                           &
+                             ds_parent(4),   ds_child(4) )
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_4D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_5D_Recursive
+!
+!> Subroutine for the interpolation of a 5D grid variable.
+!> It calls #Agrif_Interp_4D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_5D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(5),              intent(in)  :: type_interp
+    integer, dimension(5),              intent(in)  :: indmin, indmax
+    integer, dimension(5),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(5),              intent(in)  :: s_child, s_parent
+    real,    dimension(5),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4),            &
+        indmin(5):indmax(5)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        indmin(5):indmax(5))            :: tabtemp
+    integer                             :: i, j, k, l, m
+!
+    do m = indmin(5), indmax(5)
+        call Agrif_Interp_4D_recursive(type_interp(1:4),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3),                   &
+                                             indmin(4):indmax(4),m),                &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2),       &
+                                               pttab_child(3):petab_child(3),       &
+                                               pttab_child(4):petab_child(4), m),   &
+                                       indmin(1:4),indmax(1:4),                     &
+                                       pttab_child(1:4), petab_child(1:4),          &
+                                       s_child(1:4),     s_parent(1:4),             &
+                                       ds_child(1:4),   ds_parent(1:4) )
+    enddo
+!
+    do l = pttab_child(4), petab_child(4)
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(5),                                       &
+                              tabtemp(i,j,k,l,indmin(5):indmax(5)),                 &
+                              tabout(i,j,k,l,pttab_child(5):petab_child(5)),        &
+                              indmin(5), indmax(5),                                 &
+                              pttab_child(5), petab_child(5),                       &
+                              s_parent(5),   s_child(5),                            &
+                              ds_parent(5), ds_child(5) )
+    enddo
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_5D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_6D_Recursive
+!
+!> Subroutine for the interpolation of a 6D grid variable.
+!> It calls #Agrif_Interp_5D_recursive and Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_6D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6),                  intent(in)  :: type_interp
+    integer, dimension(6),                  intent(in)  :: indmin, indmax
+    integer, dimension(6),                  intent(in)  :: pttab_child, petab_child
+    real,    dimension(6),                  intent(in)  :: s_child, s_parent
+    real,    dimension(6),                  intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4),            &
+        indmin(5):indmax(5),            &
+        indmin(6):indmax(6)),               intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5),  &
+        pttab_child(6):petab_child(6)),     intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5),  &
+        indmin(6):indmax(6))            :: tabtemp
+    integer                             :: i, j, k, l, m, n
+!
+    do n = indmin(6), indmax(6)
+        call Agrif_Interp_5D_recursive(type_interp(1:5),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3),                   &
+                                             indmin(4):indmax(4),                   &
+                                             indmin(5):indmax(5), n),               &
+                                        tabtemp(pttab_child(1):petab_child(1),      &
+                                                pttab_child(2):petab_child(2),      &
+                                                pttab_child(3):petab_child(3),      &
+                                                pttab_child(4):petab_child(4),      &
+                                                pttab_child(5):petab_child(5), n),  &
+                                        indmin(1:5),indmax(1:5),                    &
+                                        pttab_child(1:5), petab_child(1:5),         &
+                                        s_child(1:5), s_parent(1:5),                &
+                                        ds_child(1:5),ds_parent(1:5) )
+    enddo
+!
+    do m = pttab_child(5), petab_child(5)
+    do l = pttab_child(4), petab_child(4)
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(6),                                       &
+                              tabtemp(i,j,k,l,m,indmin(6):indmax(6)),               &
+                              tabout(i,j,k,l,m,pttab_child(6):petab_child(6)),      &
+                              indmin(6), indmax(6),                                 &
+                              pttab_child(6), petab_child(6),                       &
+                              s_parent(6),   s_child(6),                            &
+                              ds_parent(6), ds_child(6) )
+    enddo
+    enddo
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_6D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpBase
+!
+!> Calls the interpolation method chosen by the user (linear, lagrange, spline, etc.).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpBase ( type_interp, parenttab, childtab, indmin, indmax, &
+                              pttab_child, petab_child,                         &
+                              s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    INTEGER                                                 :: type_interp
+    INTEGER                                                 :: indmin, indmax
+    INTEGER                                                 :: pttab_child, petab_child
+    REAL, DIMENSION(indmin:indmax),           INTENT(IN)    :: parenttab
+    REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT)   :: childtab
+    REAL                                                    :: s_parent, s_child
+    REAL                                                    :: ds_parent,ds_child
+!
+    if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then
+!
+        childtab(pttab_child) = parenttab(indmin)
+!
+    elseif (type_interp == Agrif_LINEAR) then    !       Linear interpolation
+!
+        call Agrif_basicinterp_linear1D(parenttab,childtab,                   &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif ( type_interp == Agrif_PPM ) then     !       PPM interpolation
+
+        call PPM1d(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif ( type_interp == Agrif_PPM_LIM ) then     !       PPM interpolation
+
+        call PPM1d_lim(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LAGRANGE) then  !       Lagrange interpolation
+!
+        call lagrange1D(parenttab,childtab,                 &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_ENO) then       !       Eno interpolation
+!
+        call ENO1d(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_WENO) then      !       Weno interpolation
+!
+        call WENO1d(parenttab,childtab,                     &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LINEARCONSERV) then !   Linear conservative interpolation
+!
+        call Linear1dConserv(parenttab,childtab,            &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LINEARCONSERVLIM) then !Linear conservative interpolation
+!
+        call Linear1dConservLim(parenttab,childtab,         &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_CONSTANT) then
+!
+        call Constant1d(parenttab,childtab,                 &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpBase
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Find_list_interp
+!---------------------------------------------------------------------------------------------------
+function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     &
+                                    nbdim, indmin, indmax, indminglob,  indmaxglob,         &
+                                    pttruetab, cetruetab, memberin                          &
+#if defined AGRIF_MPI
+                                   ,indminglob2, indmaxglob2, parentarray,                  &
+                                    member, tab4t, memberinall, sendtoproc1, recvfromproc1  &
+#endif
+    ) result(find_list_interp)
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_List_Interp_Loc),   pointer     :: list_interp
+    integer,                       intent(in)  :: nbdim
+    integer, dimension(nbdim),     intent(in)  :: pttab, petab, pttab_Child, pttab_Parent
+    integer, dimension(nbdim),     intent(out) :: indmin, indmax
+    integer, dimension(nbdim),     intent(out) :: indminglob, indmaxglob
+    integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab
+    logical,                       intent(out) :: memberin
+#if defined AGRIF_MPI
+    integer, dimension(nbdim),     intent(out) :: indminglob2, indmaxglob2
+    integer, dimension(nbdim,2,2), intent(out) :: parentarray
+    logical,                       intent(out) :: member
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
+    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: memberinall
+    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: sendtoproc1, recvfromproc1
+#endif
+    logical :: find_list_interp
+!
+    integer :: i
+    type(Agrif_List_Interp_Loc), pointer :: parcours
+    type(Agrif_Interp_Loc),      pointer :: pil
+
+    find_list_interp = .false.
+
+    if ( .not. associated(list_interp) )    return
+
+    parcours => list_interp
+    find_loop : do while ( associated(parcours) )
+
+        pil => parcours % interp_loc
+
+        do i = 1,nbdim
+            if ( (pttab(i) /= pil % pttab(i)) .or. &
+                 (petab(i) /= pil % petab(i)) .or. &
+                 (pttab_child(i)  /= pil % pttab_child(i)) .or. &
+                 (pttab_parent(i) /= pil % pttab_parent(i)) ) then
+                parcours => parcours % suiv
+                cycle find_loop
+            endif
+        enddo
+
+        indmin = pil % indmin(1:nbdim)
+        indmax = pil % indmax(1:nbdim)
+
+        pttruetab = pil % pttruetab(1:nbdim)
+        cetruetab = pil % cetruetab(1:nbdim)
+
+#if !defined AGRIF_MPI
+        indminglob  = pil % indminglob(1:nbdim)
+        indmaxglob  = pil % indmaxglob(1:nbdim)
+#else
+        indminglob  = pil % indminglob2(1:nbdim)
+        indmaxglob  = pil % indmaxglob2(1:nbdim)
+        indminglob2 = pil % indminglob2(1:nbdim)
+        indmaxglob2 = pil % indmaxglob2(1:nbdim)
+        parentarray = pil % parentarray(1:nbdim,:,:)
+        member      = pil % member
+        tab4t         = pil % tab4t(1:nbdim, 0:Agrif_Nbprocs-1, 1:8)
+        memberinall   = pil % memberinall(0:Agrif_Nbprocs-1)
+        sendtoproc1   = pil % sendtoproc1(0:Agrif_Nbprocs-1)
+        recvfromproc1 = pil % recvfromproc1(0:Agrif_Nbprocs-1)
+#endif
+        memberin = pil % memberin
+        find_list_interp = .true.
+        exit find_loop
+    enddo find_loop
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Find_list_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_AddTo_list_interp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,  &
+                                     indmin, indmax, indminglob, indmaxglob,                &
+                                     pttruetab, cetruetab,                                  &
+                                     memberin, nbdim                                        &
+#if defined AGRIF_MPI
+                                    ,indminglob2, indmaxglob2,                              &
+                                     parentarray,                                           &
+                                     member,                                                &
+                                     tab4t, memberinall, sendtoproc1, recvfromproc1         &
+#endif
+    )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_List_Interp_Loc), pointer    :: list_interp
+    integer                                 :: nbdim
+    integer, dimension(nbdim)               :: pttab, petab, pttab_Child, pttab_Parent
+    integer, dimension(nbdim)               :: indmin,indmax
+    integer, dimension(nbdim)               :: indminglob, indmaxglob
+    integer, dimension(nbdim)               :: pttruetab, cetruetab
+    logical                                 :: memberin
+#if defined AGRIF_MPI
+    integer, dimension(nbdim,2,2)           :: parentarray
+    logical                                 :: member
+    integer, dimension(nbdim)                       :: indminglob2,indmaxglob2
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    logical, dimension(0:Agrif_Nbprocs-1)           :: memberinall
+    logical, dimension(0:Agrif_Nbprocs-1)           :: sendtoproc1
+    logical, dimension(0:Agrif_Nbprocs-1)           :: recvfromproc1
+#endif
+!
+    type(Agrif_List_Interp_Loc), pointer    :: parcours
+    type(Agrif_Interp_Loc),      pointer    :: pil
+!
+    allocate(parcours)
+    allocate(parcours % interp_loc)
+
+    pil => parcours % interp_loc
+
+    pil % pttab(1:nbdim) = pttab(1:nbdim)
+    pil % petab(1:nbdim) = petab(1:nbdim)
+    pil % pttab_child(1:nbdim) = pttab_child(1:nbdim)
+    pil % pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+
+    pil % indmin(1:nbdim) = indmin(1:nbdim)
+    pil % indmax(1:nbdim) = indmax(1:nbdim)
+
+    pil % memberin = memberin
+#if !defined AGRIF_MPI
+    pil % indminglob(1:nbdim) = indminglob(1:nbdim)
+    pil % indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
+#else
+    pil % indminglob2(1:nbdim) = indminglob2(1:nbdim)
+    pil % indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
+    pil % parentarray(1:nbdim,:,:) = parentarray(1:nbdim,:,:)
+    pil % member = member
+    allocate(pil % tab4t(nbdim, 0:Agrif_Nbprocs-1, 8))
+    allocate(pil % memberinall(0:Agrif_Nbprocs-1))
+    allocate(pil % sendtoproc1(0:Agrif_Nbprocs-1))
+    allocate(pil % recvfromproc1(0:Agrif_Nbprocs-1))
+    pil % tab4t         = tab4t
+    pil % memberinall   = memberinall
+    pil % sendtoproc1   = sendtoproc1
+    pil % recvfromproc1 = recvfromproc1
+#endif
+
+    pil % pttruetab(1:nbdim) = pttruetab(1:nbdim)
+    pil % cetruetab(1:nbdim) = cetruetab(1:nbdim)
+
+    parcours % suiv => list_interp
+    list_interp => parcours
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Addto_list_interp
+!===================================================================================================
+!
+end module Agrif_Interpolation
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 8732)
@@ -0,0 +1,1464 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_InterpBasic
+!>
+!> Contains different procedures of interpolation (linear,lagrange, spline,...) used in
+!! the Agrif_Interpolation module.
+!
+module Agrif_InterpBasic
+!
+    use Agrif_Types
+!
+    implicit none
+!
+    real, dimension(5,Agrif_MaxRaff,3)      :: tabppm
+    real, dimension(Agrif_MaxRaff)          :: tabdiff2, tabdiff3
+    real, dimension(:),   allocatable       :: tabtest4
+    real, dimension(:,:), allocatable       :: coeffparent
+    integer, dimension(:,:), allocatable    :: indparent
+    integer, dimension(:,:), allocatable    :: indparentppm, indchildppm
+    integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d
+!
+    private :: Agrif_limiter_vanleer
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_basicinterp_linear1D
+!
+!> Linear 1D interpolation on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicinterp_linear1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(in)     :: x            !< Coarse input data from parent
+    real, dimension(nc), intent(out)    :: y            !< Fine output data to child
+    integer,             intent(in)     :: np           !< Length of input array
+    integer,             intent(in)     :: nc           !< Length of output array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+!
+    integer :: i, coeffraf, locind_parent_left
+    real    :: globind_parent_left, globind_parent_right
+    real    :: invds, invds2, ypos, ypos2, diff
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if ( coeffraf == 1 ) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    ypos = s_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    globind_parent_left  = s_parent + (locind_parent_left - 1)*ds_parent
+    globind_parent_right = globind_parent_left + ds_parent
+!
+    invds  = 1./ds_parent
+    invds2 = ds_child/ds_parent
+    ypos2 = ypos*invds
+    globind_parent_right = globind_parent_right*invds
+!
+    do i = 1,nc-1
+!
+        if (ypos2 > globind_parent_right) then
+            locind_parent_left = locind_parent_left + 1
+            globind_parent_right = globind_parent_right + 1.
+            ypos2 = ypos*invds+(i-1)*invds2
+        endif
+!
+        diff = globind_parent_right - ypos2
+        y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1))
+        ypos2 = ypos2 + invds2
+!
+    enddo
+!
+    ypos = s_child + (nc-1)*ds_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!
+    if (locind_parent_left == np) then
+        y(nc) = x(np)
+    else
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  &
+                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicinterp_linear1D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dPrecompute2d
+!
+!> Computes 2D coefficients and index for a linear 1D interpolation on a child grid (vector y)
+!! from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: np,nc,np2
+    real,    intent(in) :: s_parent, s_child
+    real,    intent(in) :: ds_parent, ds_child
+    integer, intent(in) :: dir
+!
+    integer :: i,coeffraf,locind_parent_left,inc,inc1,inc2
+    integer, dimension(:,:), allocatable :: indparent_tmp
+    real, dimension(:,:), allocatable :: coeffparent_tmp
+    real    :: ypos,globind_parent_left,globind_parent_right
+    real    :: invds, invds2, invds3
+    real :: ypos2,diff
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    ypos = s_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+    globind_parent_right = globind_parent_left + ds_parent
+!
+    invds = 1./ds_parent
+    invds2 = ds_child/ds_parent
+    invds3 = 0.5/real(coeffraf)
+    ypos2 = ypos*invds
+    globind_parent_right=globind_parent_right*invds
+!
+    if (.not.allocated(indparent)) then
+        allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+    else
+        if ( size(indparent,1) < nc*np2 ) then
+            allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
+            allocate(  indparent_tmp(size(indparent,1),size(indparent,2)))
+            coeffparent_tmp = coeffparent
+            indparent_tmp   = indparent
+            deallocate(indparent,coeffparent)
+            allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+            coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2)) = coeffparent_tmp
+            indparent(  1:size(indparent_tmp,  1),1:size(indparent_tmp,  2)) = indparent_tmp
+            deallocate(indparent_tmp,coeffparent_tmp)
+        endif
+    endif
+!
+    do i = 1,nc-1
+!
+        if (ypos2 > globind_parent_right) then
+            locind_parent_left = locind_parent_left + 1
+            globind_parent_right = globind_parent_right + 1.
+            ypos2 = ypos*invds+(i-1)*invds2
+        endif
+!
+        diff = globind_parent_right - ypos2
+        diff = invds3*nint(2*coeffraf*diff)
+        indparent(i,dir) = locind_parent_left
+        coeffparent(i,dir) = diff
+        ypos2 = ypos2 + invds2
+!
+    enddo
+!
+    ypos = s_child + (nc-1)*ds_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+    if (locind_parent_left == np) then
+        indparent(nc,dir) = locind_parent_left-1
+        coeffparent(nc,dir) = 0.
+    else
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+        indparent(nc,dir) = locind_parent_left
+        diff = (globind_parent_left + ds_parent - ypos) * invds
+        diff = invds3*nint(2*coeffraf*diff)
+        coeffparent(nc,dir) = diff
+    endif
+
+    do i=2, np2
+        inc  =  i*nc
+        inc1 = (i-1)*nc
+        inc2 = (i-2)*nc
+!CDIR ALTCODE
+        indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
+!CDIR ALTCODE
+        coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dPrecompute2d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dAfterCompute
+!
+!> Carries out a linear 1D interpolation on a child grid (vector y) from its parent grid (vector x)
+!! using precomputed coefficient and index.
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dAfterCompute ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    integer,             intent(in)     :: dir
+!
+    integer :: i
+!
+!CDIR ALTCODE
+!CDIR NODEP
+    do i = 1,nc
+        y(i) = coeffparent(i,dir)  * x(MAX(indparent(i,dir),1)) + &
+           (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Lagrange1d
+!
+!> Carries out a lagrange 1D interpolation on a child grid (vector y) from its parent grid
+!! (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Lagrange1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i, coeffraf, locind_parent_left
+    real    :: ypos,globind_parent_left
+    real    :: deltax, invdsparent
+    real    :: t2,t3,t4,t5,t6,t7,t8
+!
+    if (np <= 2) then
+        call Agrif_basicinterp_linear1D(x,y,np,nc,s_parent,s_child,ds_parent,ds_child)
+        return
+    endif
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invdsparent = 1./ds_parent
+    ypos = s_child
+!
+    do i = 1,nc
+!
+        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+
+        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+
+        ypos = ypos + ds_child
+        if (abs(deltax) <= 0.0001) then
+            y(i)=x(locind_parent_left)
+            cycle
+        endif
+!
+        t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4
+
+        y(i) = t5*x(locind_parent_left-1) + t6*x(locind_parent_left)    &
+              +t7*x(locind_parent_left+1) + t8*x(locind_parent_left+2)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Lagrange1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Constant1d
+!
+!> Carries out a constant 1D interpolation on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Constant1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i, coeffraf, locind_parent
+    real    :: ypos
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent:locind_parent+nc-1)
+        return
+    endif
+!
+    ypos = s_child
+!
+    do i = 1,nc
+!
+        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
+        y(i) = x(locind_parent)
+        ypos = ypos + ds_child
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Constant1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dConserv
+!
+!> Carries out a conservative linear 1D interpolation on a child grid (vector y) from its parent 
+!! grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dConserv ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    integer :: i1,i2,ii
+    integer :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+
+    xdiffmod = real(diffmod)/2.
+
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    xpmax = s_parent + (locind_parent_last-1)*ds_parent
+
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+    i = i1
+
+    if (locind_parent_left == 1) then
+        slope = (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
+    else
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+    endif
+
+    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+
+    locind_parent_left = locind_parent_left + 1
+
+    do i = i1+coeffraf, i2-coeffraf,coeffraf
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+        do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+    enddo
+
+    i = i2
+
+    if (locind_parent_left == np) then
+        slope = (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
+    else
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+    endif
+
+    do ii = i-coeffraf/2+diffmod,nc
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+!
+    y(1:nc)=ytemp(1:nc)
+!
+    deallocate(ytemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dConserv
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dConservLim
+!
+!> Carries out a limited conservative linear 1D interpolation on a child grid (vector y) from
+!! its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dConservLim ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    integer :: i1,i2,ii
+    integer :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    if (coeffraf /= 3) then
+        print *,'Linear1dConservLim not ready for refinement ratio = ', coeffraf
+        stop
+    endif
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+
+    xdiffmod = real(diffmod)/2.
+
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    xpmax = s_parent + (locind_parent_last-1)*ds_parent
+
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+    i = i1
+
+    if (locind_parent_left == 1) then
+        slope=0.
+    else
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+    endif
+
+    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+
+    locind_parent_left = locind_parent_left + 1
+
+    do i = i1+coeffraf, i2-coeffraf,coeffraf
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+    enddo
+
+    i = i2
+
+    if (locind_parent_left == np) then
+        slope=0.
+    else
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+    endif
+
+    do ii=i-coeffraf/2+diffmod,nc
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+!
+    deallocate(ytemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dConservLim
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1d
+!
+!> Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
+!! method (PPM) on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos,nmin,nmax
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin,a
+!
+    real, dimension(np) :: xl,delta,a6,slope
+    integer :: diffmod
+    real :: invcoeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    if( .not. allocated(tabtest4) ) then
+        allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+    else
+        if (size(tabtest4) < nc+4*coeffraf+1) then
+            deallocate( tabtest4 )
+            allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+        endif
+    endif
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+!CDIR NOVECTOR
+    do i=1,coeffraf
+        tabdiff2(i) = (real(i)-0.5)*invcoeffraf
+    enddo
+!
+    a = invcoeffraf**2
+    tabdiff3(1) = (1./3.)*a
+    a = 2.*a
+!CDIR NOVECTOR
+    do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+    enddo
+!
+    if      ( locind_parent_last+2 <= np ) then
+        nmax = locind_parent_last+2
+    else if ( locind_parent_last+1 <= np ) then
+        nmax = locind_parent_last+1
+    else
+        nmax = locind_parent_last
+    endif
+!
+    if (locind_parent_left-1 >= 1) then
+        nmin = locind_parent_left-1
+    else
+        nmin = locind_parent_left
+    endif
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = nmin,nmax
+        slope(i) = x(i) - x(i-1)
+    enddo
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = nmin+1,nmax-1
+        xl(i)= 0.5*(x(i-1)+x(i))-0.08333333333333*(slope(i+1)-slope(i-1))
+    enddo
+!
+! apply parabolic monotonicity
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = locind_parent_left,locind_parent_last
+        delta(i) = xl(i+1) - xl(i)
+        a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        do jj = ipos-coeffraf/2+diffmod,ipos+coeffraf/2
+!
+            tabtest4(jj) = xl(iparent) + tabdiff2(pos) *  (delta(iparent)+a6(iparent)) &
+                                       - tabdiff3(pos) *  a6(iparent)
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    y(1:nc) = tabtest4(1:nc)
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1dPrecompute2d
+!
+!> Computes 2D coefficients and index for a 1D interpolation using piecewise parabolic method
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np2, np, nc
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+    integer,             intent(in)     :: dir
+!
+    integer, dimension(:,:), allocatable :: indparent_tmp
+    integer, dimension(:,:), allocatable :: indchild_tmp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin,a
+!
+    integer :: diffmod
+    real :: invcoeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    if (.not.allocated(indparentppm)) then
+        allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
+    else
+        if (size(indparentppm,1) < np2*nc) then
+            allocate(   &
+                indparent_tmp(size(indparentppm,1),size(indparentppm,2)), &
+                indchild_tmp( size(indparentppm,1),size(indparentppm,2)))
+            indparent_tmp = indparentppm
+            indchild_tmp  = indchildppm
+            deallocate(indparentppm,indchildppm)
+            allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
+            indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indparent_tmp
+            indchildppm( 1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indchild_tmp
+            deallocate(indparent_tmp,indchild_tmp)
+        endif
+    endif
+
+    if (.not.allocated(indparentppm_1d)) then
+        allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),    &
+                 indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
+    else
+        if (size(indparentppm_1d) < nc+4*coeffraf+1) then
+            deallocate(indparentppm_1d,indchildppm_1d)
+            allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),&
+                     indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
+        endif
+    endif
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    do i = 1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+    enddo
+!
+    a = invcoeffraf**2
+    tabdiff3(1) = (1./3.)*a
+    a = 2.*a
+!CDIR ALTCODE
+    do i = 2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+    enddo
+
+!CDIR ALTCODE
+    do i = 1,coeffraf
+        tabppm(1,i,dir) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+        tabppm(2,i,dir) = 0.08333333333333*(7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+        tabppm(3,i,dir) = 0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+        tabppm(4,i,dir) = 0.08333333333333*(-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+        tabppm(5,i,dir) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+!CDIR ALTCODE
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            indparentppm_1d(jj) = iparent-2
+            indchildppm_1d(jj)  = pos
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+    do i = 1,np2
+        indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np
+        indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1dPrecompute2d
+!===================================================================================================
+!
+!===================================================================================================
+!subroutine PPM1dPrecompute(np,nc,&
+!                    s_parent,s_child,ds_parent,ds_child)
+!!
+!!CC   Description:
+!!CC   subroutine to compute coefficient and index for  a 1D interpolation
+!!CC   using piecewise parabolic method
+!!C    Method:
+!!
+!!     Declarations:
+!!
+!      Implicit none
+!!
+!!     Arguments
+!      Integer             :: np,nc
+!!      Real, Dimension(:),Allocatable :: ytemp
+!      Real                :: s_parent,s_child,ds_parent,ds_child
+!!
+!!     Local scalars
+!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+!      Integer :: iparent,ipos,pos,nmin,nmax
+!      Real    :: ypos
+!      integer :: i1,jj
+!      Real :: xpmin,a
+!!
+!      Real :: xrmin,xrmax,am3,s2,s1
+!      Real, Dimension(np) :: xl,delta,a6,slope
+!!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+!      INTEGER :: diffmod
+!      REAL :: invcoeffraf
+!!
+!      coeffraf = nint(ds_parent/ds_child)
+!!
+!      If (coeffraf == 1) Then
+!          return
+!      End If
+!      invcoeffraf = ds_child/ds_parent
+!!
+!
+!      if (.not.allocated(indparentppm)) then
+!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
+!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+!      else
+!      if (size(indparentppm,1)<nc+4*coeffraf+1) then
+!      deallocate(indparentppm,indchildppm)
+!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
+!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+!      endif
+!      endif
+!
+!      ypos = s_child
+!!
+!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!      locind_parent_last = 1 +&
+!      agrif_ceiling((ypos +(nc - 1)&
+!      *ds_child - s_parent)/ds_parent)
+!!
+!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!!
+!!
+!
+!      Do i=1,coeffraf
+!        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+!      EndDo
+!
+!      a = invcoeffraf**2
+!      tabdiff3(1) = (1./3.)*a
+!      a=2.*a
+!!CDIR ALTCODE
+!!!!CDIR SHORTLOOP
+!      Do i=2,coeffraf
+!        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+!      EndDo
+!
+!!CDIR ALTCODE
+!!!!CDIR SHORTLOOP
+!      Do i=1,coeffraf
+!      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+!      tabppm(2,i,1) = 0.08333333333333*&
+!              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+!      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+!      tabppm(4,i,1) = 0.08333333333333*&
+!              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+!      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
+!      End Do
+!!
+!!
+!        diffmod = 0
+!       IF (mod(coeffraf,2) == 0) diffmod = 1
+!!
+!        ipos = i1
+!!
+!        Do iparent = locind_parent_left,locind_parent_last
+!             pos=1
+!!CDIR ALTCODE
+!!CDIR SHORTLOOP
+!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!         indparentppm(jj,1) = iparent-2
+!         indchildppm(jj,1) = pos
+!               pos = pos+1
+!             End do
+!             ipos = ipos + coeffraf
+!!
+!        End do
+!
+!      Return
+!      End subroutine ppm1dprecompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1dAfterCompute
+!
+! Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
+! method (PPM) on a child grid (vector y) from its parent grid (vector x).
+! Use precomputed coefficient and index.
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1dAfterCompute ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    integer,             intent(in)     :: np, nc
+    integer,             intent(in)     :: dir
+!
+    integer :: i
+!
+    do i = 1,nc
+        y(i) = tabppm(1,indchildppm(i,dir),dir) * x(indparentppm(i,dir)  ) + &
+               tabppm(2,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+1) + &
+               tabppm(3,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+2) + &
+               tabppm(4,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+3) + &
+               tabppm(5,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+4)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine weno1d
+!
+! Carries out a 1D interpolation and apply monotonicity constraints
+! using WENO method on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+!subroutine weno1dnew ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+!
+!CC   Description:
+!CC   subroutine to do a 1D interpolation and apply monotonicity constraints
+!CC   using piecewise parabolic method
+!CC   on a child grid (vector y) from its parent grid (vector x).
+!C    Method:
+!
+!     Declarations:
+!
+!      Implicit none
+!
+!     Arguments
+!      Integer             :: np,nc
+!      Real, Dimension(np) :: x
+!      Real, Dimension(nc) :: y
+!      Real, Dimension(:),Allocatable :: ytemp
+!      Real                :: s_parent,s_child,ds_parent,ds_child
+!
+!     Local scalars
+!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+!      Integer :: iparent,ipos,pos,nmin,nmax
+!      Real    :: ypos
+!      integer :: i1,jj
+!      Real :: xpmin,cavg,a,b
+!
+!      Real :: xrmin,xrmax,am3,s2,s1
+!      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
+!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+!      INTEGER :: diffmod
+!      REAL :: invcoeffraf
+!      integer :: s,l,k
+!      integer :: etan, etap
+!      real :: delta0, delta1, delta2
+!      real :: epsilon
+!      parameter (epsilon = 1.D-8)
+!      real, dimension(:,:), allocatable :: ak, ck
+!
+!      coeffraf = nint(ds_parent/ds_child)
+!
+!      If (coeffraf == 1) Then
+!          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+!          return
+!      End If
+!      invcoeffraf = ds_child/ds_parent
+!      Allocate(ak(0:1,coeffraf))
+!      Allocate(ck(0:1,coeffraf))
+!
+!
+!      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!      ypos = s_child
+!
+!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!      locind_parent_last = 1 +&
+!      agrif_ceiling((ypos +(nc - 1)&
+!      *ds_child - s_parent)/ds_parent)
+!
+!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+!      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+!
+!      diff(1)=0.5*invcoeffraf
+!      do i=2,coeffraf
+!         diff(i) = diff(i-1)+invcoeffraf
+!      enddo
+!
+!      ak = 0.
+!      ck = 0.
+!
+!      do i=1,coeffraf
+!         do k=0,1
+!         do s=0,2
+!         do l=0,2
+!           if (l /= s) then
+!            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
+!           endif
+!         enddo
+!         enddo
+!         enddo
+!
+!         etap = 0
+!         etan = 0
+!         do k=0,1
+!          if (ak(k,i) > 0) then
+!            etap = etap+1
+!          else if (ak(k,i) < 0) then
+!            etan = etan + 1
+!          endif
+!         enddo
+!
+!         do k=0,1
+!           if (ak(k,i) == 0) then
+!            Ck(k,i) = 1.
+!           else if (ak(k,i) > 0) then
+!            Ck(k,i) = 1./(etap * ak(k,i))
+!           else
+!            Ck(k,i) = -1./(etan * ak(k,i))
+!           endif
+!         enddo
+!      enddo
+!
+!
+!      a = 0.
+!      b = invcoeffraf
+!      Do i=1,coeffraf
+!         diff2(i) = 0.5*(b*b - a*a)
+!         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+!         a = a + invcoeffraf
+!         b = b + invcoeffraf
+!      End do
+!
+!      if( locind_parent_last+2 <= np ) then
+!           nmax = locind_parent_last+2
+!      elseif( locind_parent_last+1 <= np ) then
+!           nmax = locind_parent_last+1
+!      else
+!           nmax = locind_parent_last
+!      endif
+!
+!      if(locind_parent_left-2 >= 1) then
+!          nmin = locind_parent_left-2
+!      elseif(locind_parent_left-1 >= 1) then
+!          nmin = locind_parent_left-1
+!      else
+!          nmin = locind_parent_left
+!      endif
+!
+!      Do i = nmin+1,nmax
+!         slope(i) = (x(i) - x(i-1))
+!      Enddo
+!      DO i=nmin+2,nmax
+!        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)&
+!       +(slope(i)-slope(i-1))**2
+!      enddo
+!
+!        diffmod = 0
+!        IF (mod(coeffraf,2) == 0) diffmod = 1
+!
+!        ipos = i1
+!
+!        Do iparent = locind_parent_left,locind_parent_last
+!             pos=1
+!
+!            delta0=1./(epsilon+smooth(iparent  ))**3
+!            delta1=1./(epsilon+smooth(iparent+1))**3
+!            delta2=1./(epsilon+smooth(iparent+2))**3
+!
+!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!
+!               pos = pos+1
+!             End do
+!             ipos = ipos + coeffraf
+!
+!        End do
+!
+!
+!        y(1:nc)=ytemp(1:nc)
+!        deallocate(ytemp)
+!        deallocate(diff, diff2, diff3)
+!
+!        deallocate(ak,ck)
+!
+!      Return
+!      End subroutine weno1dnew
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine WENO1d
+!
+!> Carries out a a 1D interpolation using WENO method on a child grid (vector y) from its parent 
+!! grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine WENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos,nmin,nmax
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin
+!
+    real, dimension(np) :: slope
+    real, dimension(:), allocatable  :: diff
+    integer :: diffmod
+    real :: invcoeffraf
+    real :: delta0, delta1, sumdelta
+    real, parameter :: epsilon = 1.d-8
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    allocate(diff(coeffraf))
+    diff(1) = 0.5*invcoeffraf
+    do i = 2,coeffraf
+        diff(i) = diff(i-1)+invcoeffraf
+    enddo
+!
+    if ( locind_parent_last+2 <= np ) then
+        nmax = locind_parent_last+2
+    else if ( locind_parent_last+1 <= np ) then
+        nmax = locind_parent_last+1
+      else
+        nmax = locind_parent_last
+    endif
+!
+    if(locind_parent_left-1 >= 1) then
+        nmin = locind_parent_left-1
+    else
+        nmin = locind_parent_left
+    endif
+!
+    do i = nmin+1,nmax
+        slope(i) = x(i) - x(i-1)
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+        delta0 = 1./(epsilon+slope(iparent  )**2)**2
+        delta1 = 1./(epsilon+slope(iparent+1)**2)**2
+        sumdelta = 1./(delta0+delta1)
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            ytemp(jj) = x(iparent)+(diff(pos)-0.5)*( delta0*slope(iparent) + &
+                                                     delta1*slope(iparent+1))*sumdelta
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+    deallocate(ytemp)
+    deallocate(diff)
+!---------------------------------------------------------------------------------------------------
+end subroutine WENO1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ENO1d
+!
+!> Carries out a 1D interpolation using piecewise polynomial ENO reconstruction technique
+!! on a child grid (vector y) from its parent grid (vector x).
+!! \see ---- p 163-164 Computational gasdynamics ----
+!---------------------------------------------------------------------------------------------------
+subroutine ENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: ipos, pos
+    real    :: ypos,xi
+    integer :: i1,jj
+    real :: xpmin
+!
+    real, dimension(:),   allocatable  :: ytemp
+    real, dimension(:,:), allocatable  :: xbar
+    real, dimension(1:np+1)            :: xhalf
+    real, dimension(3,np)              :: dd, c
+    integer :: diffmod, left
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    end if
+
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    do i = 1,np+1
+        xhalf(i) = i - 0.5
+    enddo
+!
+! Compute divided differences
+!
+    dd(1,1:np)   = x(1:np)
+    dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
+    dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
+!
+    allocate( xbar( coeffraf,2 ) )
+    xi = 0.5
+    do i = 1,coeffraf
+        xbar(i,1) = (i-1)*ds_child/ds_parent - xi
+        xbar(i,2) =  i   *ds_child/ds_parent - xi
+    enddo
+!
+    ipos = i1
+!
+    do i = locind_parent_left,locind_parent_last
+        left = i
+        do jj = 2,3
+            if(abs(dd(jj,left)) > abs(dd(jj,left-1))) left = left-1
+        enddo
+!
+!       convert to Taylor series form
+        call taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
+    enddo
+!
+! Evaluate the reconstruction on each cell
+!
+    do i = locind_parent_left,locind_parent_last
+!
+        pos = 1
+!
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            ytemp(jj) = ( c(1,i)*(xbar(pos,2)-xbar(pos,1))              &
+                        + c(2,i)*(xbar(pos,2)*xbar(pos,2) -             &
+                                  xbar(pos,1)*xbar(pos,1))              &
+                        + c(3,i)*(xbar(pos,2)*xbar(pos,2)*xbar(pos,2) - &
+                                  xbar(pos,1)*xbar(pos,1)*xbar(pos,1))  &
+                        ) * coeffraf
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+!
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+    deallocate(ytemp,xbar)
+!---------------------------------------------------------------------------------------------------
+end subroutine ENO1d
+!===================================================================================================
+!
+!     **************************************************************************  
+!CC   Subroutine ppm1d_lim
+!     ************************************************************************** 
+! 
+      Subroutine ppm1d_lim(x,y,np,nc,s_parent,s_child,ds_parent,ds_child) 
+!
+!CC   Description:
+!CC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+!CC   using piecewise parabolic method  
+!CC   on a child grid (vector y) from its parent grid (vector x).
+!C    Method:
+!
+!     Declarations:
+!
+      Implicit none
+!        
+!     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+!
+!     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+!      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: dela,xr,xl,delta,a6,slope,slope2
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+!      
+      coeffraf = nint(ds_parent/ds_child)
+!
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+!      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child  
+!
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 + &
+           agrif_ceiling((ypos +(nc - 1)  &
+           *ds_child - s_parent)/ds_parent)  
+!
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+!     
+      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+!      
+         diff(:) = ds_child/ds_parent
+!      
+      Do i=1,coeffraf
+         a = real(i-1)*ds_child/ds_parent
+         b = real(i)*ds_child/ds_parent
+         diff2(i) = 0.5*(b*b - a*a)  
+         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+      End do
+!
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+!      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+! 
+      Do i = nmin,nmax
+         slope(i) = x(i) - x(i-1)
+         slope2(i) = 2.*abs(slope(i))
+      Enddo
+!
+      Do i = nmin,nmax-1
+         dela(i) = 0.5 * ( slope(i) + slope(i+1) )
+! Van Leer slope limiter
+         dela(i) = min( abs(dela(i)),slope2(i), &
+                       slope2(i+1) )*sign(1.,dela(i))
+         IF( slope(i)*slope(i+1) <= 0. ) dela(i) = 0.
+      Enddo
+!
+      Do i = nmin,nmax-2
+         xr(i) = x(i) + (1./2.)*slope(i+1) + (-1./6.)*dela(i+1) &
+                                          + ( 1./6. )*dela(i)
+      Enddo
+!
+      Do i = nmin,nmax-2
+         xrmin = min(x(i),x(i+1))
+         xrmax = max(x(i),x(i+1))
+         xr(i) = min(xr(i),xrmax)
+         xr(i) = max(xr(i),xrmin)
+         xl(i+1) = xr(i)         
+      Enddo
+! apply parabolic monotonicity
+       Do i = locind_parent_left,locind_parent_last
+          If( ( (xr(i)-x(i))* (x(i)-xl(i)) ) .le. 0. ) then
+             xl(i) = x(i) 
+             xr(i) = x(i)
+          Endif          
+          delta(i) = xr(i) - xl(i)
+          am3 = 3. * x(i)
+          s1  = am3 - 2. * xr(i)
+          s2  = am3 - 2. * xl(i)
+          IF( delta(i) * (xl(i) - s1) .le. 0. ) xl(i) = s1
+          IF( delta(i) * (s2 - xr(i)) .le. 0. ) xr(i) = s2
+          delta(i) = xr(i) - xl(i)
+          a6(i) = 6.*x(i)-3.*(xl(i) +xr(i))
+!
+       End do   
+!
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1           
+!
+        ipos = i1
+!               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+             cavg = 0.
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!
+               ytemp(jj) = (diff(pos)*xl(iparent)   &
+                  + diff2(pos) &
+                  *  (delta(iparent)+a6(iparent)) &
+                  - diff3(pos)*a6(iparent))*coeffraf
+                              
+               cavg = cavg + ytemp(jj)
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+!
+        End do     
+!
+!
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff, diff2, diff3)
+      Return
+      End Subroutine ppm1d_lim
+!===================================================================================================
+!  subroutine taylor
+!---------------------------------------------------------------------------------------------------
+subroutine taylor ( ind, xhalf, dd, c )
+!---------------------------------------------------------------------------------------------------
+    integer,            intent(in)  :: ind
+    real, dimension(3), intent(in)  :: xhalf
+    real, dimension(3), intent(in)  :: dd
+    real, dimension(3), intent(out) :: c
+!
+    real, dimension(0:3,0:3) :: d
+    integer                  :: i, j
+!
+    d(0,0:3) = 1.0
+    do i = 1,3
+        d(i,0) = (ind-xhalf(i))*d(i-1,0)
+    enddo
+!
+    do i = 1,3
+        do j = 1,3-i
+            d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
+        enddo
+    enddo
+!
+    do j = 1,3
+        c(j) = 0.
+        do i=0,3-j
+            c(j) = c(j) + d(i,j)*dd(i+j)
+        enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine taylor
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_limiter_vanleer
+!---------------------------------------------------------------------------------------------------
+real function Agrif_limiter_vanleer ( tab ) result(res)
+!---------------------------------------------------------------------------------------------------
+    real, dimension(3), intent(in) :: tab
+!
+    real :: p1, p2, p3
+
+    p1 =    (tab(3)-tab(1))/2.
+    p2 = 2.*(tab(2)-tab(1))
+    p3 = 2.*(tab(3)-tab(2))
+
+    if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
+        res = minval((/p1,p2,p3/))
+    elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
+        res = maxval((/p1,p2,p3/))
+    else
+        res=0.
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_limiter_vanleer
+!===================================================================================================
+!
+end module Agrif_InterpBasic
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 8732)
@@ -0,0 +1,181 @@
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Link
+!>
+!> This module is used to link AGRIF files to the model.
+!
+module Agrif_Link
+!
+    interface
+!
+        subroutine Agrif_clustering_def ( )
+!
+        end subroutine Agrif_clustering_def
+!
+        subroutine Agrif_Set_numberofcells ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine Agrif_Set_numberofcells
+!
+        subroutine Agrif_Get_numberofcells ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine Agrif_Get_numberofcells
+!
+    end interface
+!
+    abstract interface
+!
+        subroutine alloc_proc ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine alloc_proc
+!
+        subroutine typedef_proc ( )
+            implicit none
+        end subroutine typedef_proc
+!
+    end interface
+    
+    procedure(alloc_proc)   :: Agrif_Allocationcalls
+    procedure(typedef_proc) :: Agrif_probdim_modtype_def
+!
+end module Agrif_Link
+!
+!===================================================================================================
+!  function Agrif_parent
+!        modify by conv. To use : un_parent = Agrif_Parent(un)
+!===================================================================================================
+!  function Agrif_Get_Coarse_Grid
+!        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
+!===================================================================================================
+!  function Agrif_Rhox
+!        modify by conv. To use : var = Agrif_Rhox()
+!                    REAL(Agrif_Curgrid % spaceref(1))
+!===================================================================================================
+!  function Agrif_Parent_Rhox
+!        modify by conv. To use : var = Agrif_Parent_Rhox()
+!                    REAL(Agrif_Curgrid % parent % spaceref(1))
+!===================================================================================================
+!  function Agrif_Irhox
+!        modify by conv. To use : var = Agrif_Parent_IRhox()
+!                    Agrif_Curgrid % spaceref(1)
+!===================================================================================================
+!  function Agrif_Parent_Irhox
+!        modify by conv. To use : var = Agrif_Parent_IRhox()
+!                    Agrif_Curgrid % parent % spaceref(1)
+!===================================================================================================
+!  function Agrif_Rhoy
+!        modify by conv. To use : var = Agrif_Rhoy()
+!                    REAL(Agrif_Curgrid % spaceref(2))
+!===================================================================================================
+!  function Agrif_Parent_Rhoy
+!        modify by conv. To use : var = Agrif_Parent_Rhoy()
+!                    REAL(Agrif_Curgrid % parent % spaceref(2))
+!===================================================================================================
+!  function Agrif_Irhoy
+!        modify by conv. To use : var = Agrif_Parent_IRhoy()
+!                    Agrif_Curgrid % spaceref(2)
+!===================================================================================================
+!  function Agrif_Parent_Irhoy
+!        modify by conv. To use : var = Agrif_Parent_IRhoy()
+!                    Agrif_Curgrid % parent % spaceref(2)
+!===================================================================================================
+!  function Agrif_Rhoz
+!        modify by conv. To use : var = Agrif_Rhoz()
+!                    REAL(Agrif_Curgrid % spaceref(3))
+!===================================================================================================
+!  function Agrif_Parent_Rhoz
+!        modify by conv. To use : var = Agrif_Parent_Rhoz()
+!                    REAL(Agrif_Curgrid % parent % spaceref(3))
+!===================================================================================================
+!  function Agrif_Irhoz
+!        modify by conv. To use : var = Agrif_Parent_IRhoz()
+!                    Agrif_Curgrid % spaceref(3)
+!===================================================================================================
+!  function Agrif_Parent_Irhoz
+!        modify by conv. To use : var = Agrif_Parent_IRhoz()
+!                    Agrif_Curgrid % parent % spaceref(3)
+!===================================================================================================
+!  function Agrif_NearCommonBorderX
+!        modify by conv. To use : var = Agrif_NearCommonBorderX()
+!                       Agrif_Curgrid % NearRootBorder(1)
+!===================================================================================================
+!  function Agrif_NearCommonBorderY
+!        modify by conv. To use : var = Agrif_NearCommonBorderY()
+!                       Agrif_Curgrid % NearRootBorder(2)
+!===================================================================================================
+!  function Agrif_NearCommonBorderZ
+!        modify by conv. To use : var = Agrif_NearCommonBorderZ()
+!                       Agrif_Curgrid % NearRootBorder(3)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderX
+!        modify by conv. To use : var = Agrif_DistantCommonBorderX()
+!                       Agrif_Curgrid % DistantRootBorder(1)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderY
+!        modify by conv. To use : var = Agrif_DistantCommonBorderY()
+!                       Agrif_Curgrid % DistantRootBorder(2)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderZ
+!        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
+!                       Agrif_Curgrid % DistantRootBorder(3)
+!===================================================================================================
+!  function Agrif_Nb_Step
+!        modify by conv. To use : var = Agrif_Nb_Step()
+!                          Agrif_Curgrid % ngridstep
+!===================================================================================================
+!  function Agrif_Nb_Fine_Grids
+!        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
+!                         Agrif_nbfixedgrids
+!===================================================================================================
+!  function Agrif_Ix
+!        modify by conv. To use : var = Agrif_Ix()
+!                         Agrif_Curgrid % ix(1)
+!===================================================================================================
+!  function Agrif_Parent_Ix
+!        modify by conv. To use : var = Agrif_Parent_Ix()
+!                        Agrif_Curgrid % parent % ix(1)
+!===================================================================================================
+!  function Agrif_Iy
+!        modify by conv. To use : var = Agrif_Iy()
+!                        Agrif_Curgrid % ix(2)
+!===================================================================================================
+!  function Agrif_Parent_Iy
+!        modify by conv. To use : var = Agrif_Parent_Iy()
+!                       Agrif_Curgrid % parent % ix(2)
+!===================================================================================================
+!  function Agrif_Iz
+!        modify by conv. To use : var = Agrif_Iz()
+!                      Agrif_Curgrid % ix(3)
+!===================================================================================================
+!  function Agrif_Parent_Iz
+!        modify by conv. To use : var = Agrif_Parent_Iz()
+!                     Agrif_Curgrid % parent % ix(3)
+!===================================================================================================
+!  function Agrif_Get_grid_id
+!        modify by conv. To use : var = Agrif_Get_grid_id()
+!                    Agrif_Curgrid % grid_id
+!===================================================================================================
+!  function Agrif_Get_parent_id
+!        modify by conv. To use : var = Agrif_Get_parent_id()
+!                    Agrif_Curgrid % parent % grid_id
+!===================================================================================================
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90	(revision 8732)
@@ -0,0 +1,586 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Mask.
+!>
+!> Module for masks.
+!
+module Agrif_Mask
+!
+    use Agrif_Types
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_CheckMasknD
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
+    type(Agrif_Variable), pointer   :: parent !< The parent grid
+    integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
+    integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
+    integer, dimension(nbdim)       :: ppbtab, ppetab
+    logical, dimension(nbdim)       :: noraftab
+    integer                         :: nbdim
+!
+    integer :: i0,j0,k0,l0,m0,n0
+!
+    select case (nbdim)
+    case (1)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array1(i0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0/),tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+    case (2)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array2(i0,j0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0/),tempP,parent,ppbtab,ppetab, noraftab,nbdim)
+            endif
+        enddo
+        enddo
+    case (3)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array3(i0,j0,k0) == Agrif_SpecialValue) then
+!------CDIR NEXPAND
+                call CalculNewValTempP3D((/i0,j0,k0/), &
+                    tempP%array3(ppbtab(1),ppbtab(2),ppbtab(3)),  &
+                    parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+
+!            Call CalculNewValTempP((/i0,j0,k0/),
+!     &                             tempP,parent,
+!     &                             ppbtab,ppetab,
+!     &                             noraftab,nbdim)
+
+            endif
+        enddo
+        enddo
+        enddo
+    case (4)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
+                call CalculNewValTempP4D((/i0,j0,k0,l0/), &
+                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
+                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+    case (5)
+        do m0 = pbtab(5),petab(5)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array5(i0,j0,k0,l0,m0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0,k0,l0,m0/), &
+                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    case (6)
+        do n0 = pbtab(6),petab(6)
+        do m0 = pbtab(5),petab(5)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array6(i0,j0,k0,l0,m0,n0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/), &
+                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CheckMasknD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP ( indic, tempP, parent, ppbtab, ppetab, noraftab, nbdim )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim)       :: indic
+    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
+    type(Agrif_Variable), pointer   :: parent !< The parent grid
+    integer, dimension(nbdim)       :: ppbtab, ppetab
+    logical, dimension(nbdim)       :: noraftab
+    integer                         :: nbdim
+!
+    integer                     :: i,ii,iii,jj,kk,ll,mm,nn
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: nbvals
+    real                        :: res
+    real                        :: valparent
+    integer                     :: ValMax
+    logical                     :: firsttest
+!
+    ValMax = 1
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+!CDIR NOVECTOR
+    imin = indic
+!CDIR NOVECTOR
+    imax = indic
+!
+    i = 1
+    firsttest = .TRUE.
+!
+    do while (i <= ValMax)
+!
+        if ( (i == 1).AND.(firsttest) ) i = Valmax
+!
+        do iii = 1,nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+!CDIR NOVECTOR
+                        idecal = indic
+                        idecal(iii) = idecal(iii)-1
+                        SELECT CASE(nbdim)
+                        CASE (1)
+                            if (tempP%array1(idecal(1) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (2)
+                            if (tempP%array2(idecal(1), idecal(2) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (3)
+                            if (tempP%array3(idecal(1), &
+                                             idecal(2), idecal(3) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (4)
+                            if (tempP%array4(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4)  &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (5)
+                            if (tempP%array5(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4), &
+                                             idecal(5)             &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (6)
+                            if (tempP%array6(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4), &
+                                             idecal(5), idecal(6)  &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        END SELECT
+                    endif
+                endif
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        SELECT CASE(nbdim)
+        CASE (1)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array1(ii)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+!
+        CASE (2)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array2(ii,jj)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+
+        CASE (3)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array3(ii,jj,kk)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+
+        CASE (4)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array4(ii,jj,kk,ll)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+
+        CASE (5)
+            do mm = imin(5),imax(5)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array5(ii,jj,kk,ll,mm)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+
+        CASE (6)
+            do nn = imin(6),imax(6)
+            do mm = imin(5),imax(5)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array6(ii,jj,kk,ll,mm,nn)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+
+        END SELECT
+!
+        if (Nbvals > 0) then
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
+            SELECT CASE(nbdim)
+            CASE (1)
+                tempP%array1(indic(1))           = Res/Nbvals
+            CASE (2)
+                tempP%array2(indic(1), indic(2)) = Res/Nbvals
+            CASE (3)
+                tempP%array3(indic(1), indic(2), &
+                             indic(3))           = Res/Nbvals
+            CASE (4)
+                tempP%array4(indic(1), indic(2), &
+                             indic(3), indic(4)) = Res/Nbvals
+            CASE (5)
+                tempP%array5(indic(1), indic(2), &
+                             indic(3), indic(4), &
+                             indic(5))           = Res/Nbvals
+            CASE (6)
+                tempP%array6(indic(1), indic(2), &
+                             indic(3), indic(4), &
+                             indic(5), indic(6)) = Res/Nbvals
+            END SELECT
+            exit
+        else
+            if (firsttest) exit
+            i = i + 1
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP3D
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP3D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
+                                 MaxSearch, Agrif_SpecialValue )
+!---------------------------------------------------------------------------------------------------
+    integer, parameter          :: nbdim = 3
+    integer, dimension(nbdim)   :: indic
+    integer, dimension(nbdim)   :: ppbtab, ppetab
+    logical, dimension(nbdim)   :: noraftab
+    integer                     :: MaxSearch
+    real                        :: Agrif_SpecialValue
+    real, dimension(ppbtab(1):ppetab(1), &
+                    ppbtab(2):ppetab(2), &
+                    ppbtab(3):ppetab(3)) &
+                                :: tempP, parent  !< Part of the parent grid used for
+                                                  !< the interpolation of the child grid
+!
+    integer                     :: i,ii,iii,jj,kk
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: Nbvals
+    real                        :: Res
+    real                        :: ValParent
+    integer                     :: ValMax
+    logical                     :: Existunmasked
+!
+    ValMax = 1
+!CDIR NOVECTOR
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+!CDIR NOVECTOR
+    imin = indic
+!CDIR NOVECTOR
+    imax = indic
+
+!CDIR NOVECTOR
+    idecal = indic
+    i = Valmax
+!
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            imin(iii) = max(indic(iii) - i,ppbtab(iii))
+            imax(iii) = min(indic(iii) + i,ppetab(iii))
+
+            if (indic(iii) > ppbtab(iii)) then
+                idecal(iii) = idecal(iii)-1
+                if (tempP(idecal(1),idecal(2),idecal(3)) == Agrif_SpecialValue) then
+                    imin(iii) = imax(iii)
+                endif
+                idecal(iii) = idecal(iii)+1
+            endif
+        endif
+    enddo
+!
+    Existunmasked = .FALSE.
+!
+    do kk = imin(3),imax(3)
+    do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+    do ii = imin(1),imax(1)
+        if ( parent(ii,jj,kk) /= Agrif_SpecialValue) then
+            Existunmasked = .TRUE.
+            exit
+        endif
+    enddo
+    enddo
+    enddo
+!
+    if (.Not.Existunmasked) return
+!
+    i = 1
+!
+    do while(i <= ValMax)
+!
+        do iii = 1 , nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        do kk = imin(3),imax(3)
+        do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+        do ii = imin(1),imax(1)
+            ValParent = parent(ii,jj,kk)
+            if ( ValParent /= Agrif_SpecialValue) then
+                Res = Res + ValParent
+                Nbvals = Nbvals + 1
+            endif
+        enddo
+        enddo
+        enddo
+!
+        if (Nbvals > 0) then
+            tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
+            exit
+        else
+            i = i + 1
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP3D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP4D
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
+                                 MaxSearch, Agrif_SpecialValue )
+!---------------------------------------------------------------------------------------------------
+    integer, parameter          :: nbdim = 4
+    integer, dimension(nbdim)   :: indic
+    integer, dimension(nbdim)   :: ppbtab, ppetab
+    logical, dimension(nbdim)   :: noraftab
+    integer                     :: MaxSearch
+    real                        :: Agrif_SpecialValue
+    real, dimension(ppbtab(1):ppetab(1), &
+                    ppbtab(2):ppetab(2), &
+                    ppbtab(3):ppetab(3), &
+                    ppbtab(4):ppetab(4)) &
+                                :: tempP, parent  !< Part of the parent grid used for
+                                                  !< the interpolation of the child grid
+!
+    integer                     :: i,ii,iii,jj,kk,ll
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: Nbvals
+    real                        :: Res
+    real                        :: ValParent
+    integer                     :: ValMax
+!
+    logical                     :: firsttest
+!
+    ValMax = 1
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+    imin = indic
+    imax = indic
+!
+    i = 1
+    firsttest = .TRUE.
+    idecal = indic
+!
+    do while (i <= ValMax)
+!
+        if ((i == 1).AND.(firsttest)) i = Valmax
+
+        do iii = 1,nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+                        idecal(iii) = idecal(iii)-1
+                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
+                            imin(iii) = imax(iii)
+                        endif
+                        idecal(iii) = idecal(iii)+1
+                    endif
+                endif
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        do ll = imin(4),imax(4)
+        do kk = imin(3),imax(3)
+        do jj = imin(2),imax(2)
+        do ii = imin(1),imax(1)
+            ValParent = parent(ii,jj,kk,ll)
+            if ( ValParent /= Agrif_SpecialValue) then
+                Res = Res + ValParent
+                Nbvals = Nbvals + 1
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+!
+        if (Nbvals > 0) then
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
+
+            tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+            exit
+        else
+            if (firsttest) exit
+            i = i + 1
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP4D
+!===================================================================================================
+!
+end module Agrif_Mask
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90	(revision 8732)
@@ -0,0 +1,634 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+module Agrif_Mpp
+!
+    use Agrif_Arrays
+    use Agrif_Grids
+!
+    implicit none
+!
+    interface
+        subroutine Agrif_get_proc_info ( imin, imax, jmin, jmax )
+            integer, intent(out) :: imin, imax
+            integer, intent(out) :: jmin, jmax
+        end subroutine Agrif_get_proc_info
+    end interface
+!
+    integer, private :: Agrif_MPI_prec
+!
+    private :: Agrif_get_proc_info
+!
+contains
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_MPI_Init
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_MPI_Init ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, optional, intent(in) :: comm    !< MPI communicator to be attached to the root grid.
+!
+    include 'mpif.h'
+    integer :: code, ierr
+    logical :: mpi_was_called
+    integer :: current_mpi_prec
+!
+    call MPI_INITIALIZED( mpi_was_called, code )
+    if( code /= MPI_SUCCESS ) then
+        write(*,*) ': Error in routine mpi_initialized'
+        call MPI_ABORT( MPI_COMM_WORLD, code, ierr )
+    endif
+    if( .not. mpi_was_called ) then
+        write(*,*) '### AGRIF Error : you should call Agrif_MPI_Init *after* MPI_Init.'
+        stop
+    endif
+
+    current_mpi_prec = KIND(1.0)
+    if (current_mpi_prec == 4) then
+      Agrif_MPI_prec = MPI_REAL4
+    else
+      Agrif_MPI_prec = MPI_REAL8
+    endif
+!
+    if ( present(comm) ) then
+        call Agrif_MPI_switch_comm(comm)
+    else
+        call Agrif_MPI_switch_comm(MPI_COMM_WORLD)
+    endif
+!
+    Agrif_Mygrid % communicator = Agrif_mpi_comm
+!
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Init_ProcList( Agrif_Mygrid % proc_def_list, Agrif_Nbprocs )
+        call Agrif_pl_copy( Agrif_Mygrid % proc_def_list, Agrif_Mygrid % required_proc_list )
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_Init
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_MPI_switch_comm ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: comm    !< MPI communicator you want to switch to.
+!
+    include 'mpif.h'
+    integer :: code
+    logical :: mpi_was_called
+!
+    call MPI_INITIALIZED( mpi_was_called, code )
+    if ( .not. mpi_was_called ) return
+!
+    call MPI_COMM_SIZE(comm, Agrif_Nbprocs, code)
+    call MPI_COMM_RANK(comm, Agrif_ProcRank, code)
+    Agrif_mpi_comm = comm
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_switch_comm
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_MPI_get_grid_comm ( ) result ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer :: comm
+    comm = Agrif_Curgrid % communicator
+!---------------------------------------------------------------------------------------------------
+end function Agrif_MPI_get_grid_comm
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_MPI_set_grid_comm ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: comm
+    Agrif_Curgrid % communicator = comm
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_set_grid_comm
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_Init_ProcList ( proclist, nbprocs )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(inout) :: proclist
+    integer,               intent(in)    :: nbprocs
+!
+    include 'mpif.h'
+    type(Agrif_Proc), pointer     :: new_proc
+    integer                       :: p, ierr
+    integer                       :: imin, imax, jmin, jmax
+    integer, dimension(5)         :: local_proc_grid_info
+    integer, dimension(5,nbprocs) :: all_procs_grid_info
+!
+    call Agrif_get_proc_info(imin, imax, jmin, jmax)
+!
+    local_proc_grid_info(:) = (/Agrif_Procrank, imin, jmin, imax, jmax/)
+!
+    call MPI_ALLGATHER(local_proc_grid_info, 5, MPI_INTEGER, &
+                       all_procs_grid_info,  5, MPI_INTEGER, Agrif_mpi_comm, ierr)
+!
+    do p = 1,nbprocs
+!
+        allocate(new_proc)
+        new_proc % pn = all_procs_grid_info(1,p)
+        new_proc % imin(1) = all_procs_grid_info(2,p)
+        new_proc % imin(2) = all_procs_grid_info(3,p)
+        new_proc % imax(1) = all_procs_grid_info(4,p)
+        new_proc % imax(2) = all_procs_grid_info(5,p)
+        call Agrif_pl_append( proclist, new_proc )
+!
+    enddo
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_ProcList
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Get_External_Data_first
+!---------------------------------------------------------------------------------------------------
+subroutine Get_External_Data_first ( pttruetab, cetruetab, pttruetabwhole, cetruetabwhole,  &
+                                     nbdim, memberoutall, coords, sendtoproc, recvfromproc, &
+                                     imin, imax, imin_recv, imax_recv )
+!---------------------------------------------------------------------------------------------------
+    include 'mpif.h'
+!
+    integer,                                     intent(in)  :: nbdim
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetab,     cetruetab
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetabwhole,cetruetabwhole
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(in)  :: memberoutall
+    integer, dimension(nbdim),                   intent(in)  :: coords
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: sendtoproc
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin,imax
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin_recv,imax_recv
+!
+    integer :: imintmp, imaxtmp, i, j, k, i1
+    integer :: imin1,imax1
+    logical :: tochange,tochangebis
+    integer, dimension(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,cetruetab2
+!
+! pttruetab2 and cetruetab2 are modified arrays in order to always
+! send the most inner points
+!
+    pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+    cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+!
+    do k = 0,Agrif_Nbprocs-1
+    do i = 1,nbdim
+        tochangebis = .TRUE.
+        DO i1 = 1,nbdim
+            IF (i /= i1) THEN
+                IF ( (pttruetab(i1,Agrif_Procrank) /= pttruetab(i1,k))  .OR. &
+                     (cetruetab(i1,Agrif_Procrank) /= cetruetab(i1,k))) THEN
+                    tochangebis = .FALSE.
+                    EXIT
+                ENDIF
+            ENDIF
+        ENDDO
+        IF (tochangebis) THEN
+            imin1 = max(pttruetab(i,Agrif_Procrank), pttruetab(i,k))
+            imax1 = min(cetruetab(i,Agrif_Procrank), cetruetab(i,k))
+! Always send the most interior points
+
+            tochange = .false.
+            IF (cetruetab(i,Agrif_Procrank) > cetruetab(i,k)) THEN
+                DO j=imin1,imax1
+                    IF ((cetruetab(i,k)-j) > (j-pttruetab(i,Agrif_Procrank))) THEN
+                        imintmp = j+1
+                        tochange = .TRUE.
+                    ELSE
+                        EXIT
+                    ENDIF
+                ENDDO
+            ENDIF
+
+            if (tochange) then
+                pttruetab2(i,Agrif_Procrank) = imintmp
+            endif
+
+            tochange = .FALSE.
+            imaxtmp=0
+            IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k)) THEN
+                DO j=imax1,imin1,-1
+                    IF ((j-pttruetab(i,k)) > (cetruetab(i,Agrif_Procrank)-j)) THEN
+                        imaxtmp = j-1
+                        tochange = .TRUE.
+                    ELSE
+                        EXIT
+                    ENDIF
+                ENDDO
+            ENDIF
+
+            if (tochange) then
+                cetruetab2(i,Agrif_Procrank) = imaxtmp
+            endif
+        ENDIF
+    enddo
+    enddo
+
+    do k = 0,Agrif_NbProcs-1
+!
+        sendtoproc(k) = .true.
+!
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+            imin(i,k) = max(pttruetab2(i,Agrif_Procrank), pttruetabwhole(i,k))
+            imax(i,k) = min(cetruetab2(i,Agrif_Procrank), cetruetabwhole(i,k))
+!
+            if ( (imin(i,k) > imax(i,k)) .and. (coords(i) /= 0) ) then
+                sendtoproc(k) = .false.
+            endif
+        enddo
+        IF ( .not. memberoutall(k) ) THEN
+            sendtoproc(k) = .false.
+        ENDIF
+    enddo
+!
+    call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,recvfromproc,imin_recv,imax_recv)
+!---------------------------------------------------------------------------------------------------
+end subroutine Get_External_Data_first
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ExchangeSameLevel_first
+!---------------------------------------------------------------------------------------------------
+subroutine ExchangeSameLevel_first ( sendtoproc, nbdim, imin, imax, recvfromproc, &
+                                     imin_recv, imax_recv )
+!---------------------------------------------------------------------------------------------------
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)  :: sendtoproc
+    INTEGER,                                     intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imin
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imax
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imin_recv
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imax_recv
+!
+    include 'mpif.h'
+    INTEGER :: k
+    INTEGER :: etiquette = 100
+    INTEGER :: code
+    LOGICAL :: res
+    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
+    INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1)    :: iminmax_temp
+
+    do k = 0,Agrif_ProcRank-1
+!
+        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
+!
+        if (sendtoproc(k)) then
+            iminmax_temp(:,1,k) = imin(:,k)
+            iminmax_temp(:,2,k) = imax(:,k)
+            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette,Agrif_mpi_comm,code)
+        endif
+!
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
+        recvfromproc(k) = res
+!
+        if (recvfromproc(k)) then
+            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,statut,code)
+            imin_recv(:,k) = iminmax_temp(:,1,k)
+            imax_recv(:,k) = iminmax_temp(:,2,k)
+        endif
+!
+    enddo
+
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
+!
+        if (sendtoproc(k)) then
+!
+            iminmax_temp(:,1,k) = imin(:,k)
+            iminmax_temp(:,2,k) = imax(:,k)
+
+            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,code)
+        endif
+!
+    enddo
+!
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank-1,0,-1
+!
+        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
+        recvfromproc(k) = res
+!
+        if (recvfromproc(k)) then
+!
+            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,statut,code)
+
+            imin_recv(:,k) = iminmax_temp(:,1,k)
+            imax_recv(:,k) = iminmax_temp(:,2,k)
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine ExchangeSamelevel_first
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ExchangeSameLevel
+!---------------------------------------------------------------------------------------------------
+subroutine ExchangeSameLevel ( sendtoproc, recvfromproc, nbdim,    &
+                               pttruetabwhole, cetruetabwhole,     &
+                               imin, imax, imin_recv, imax_recv,   &
+                               memberout, tempC, tempCextend )
+!---------------------------------------------------------------------------------------------------
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: sendtoproc
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: recvfromproc
+    INTEGER,                                     intent(in)    :: nbdim
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: pttruetabwhole
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: cetruetabwhole
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin,      imax
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin_recv, imax_recv
+    LOGICAL,                                     intent(in)    :: memberout
+    TYPE(Agrif_Variable), pointer,               intent(inout) :: tempC, tempCextend
+!
+    include 'mpif.h'
+    INTEGER :: i,k
+    INTEGER :: etiquette = 100
+    INTEGER :: code, datasize
+    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
+    TYPE(Agrif_Variable), pointer, SAVE   :: temprecv
+!
+    IF (memberout) THEN
+        call Agrif_array_allocate(tempCextend, pttruetabwhole(:,Agrif_ProcRank),  &
+                                               cetruetabwhole(:,Agrif_ProcRank),nbdim)
+        call Agrif_var_set_array_tozero(tempCextend,nbdim)
+    ENDIF
+!
+    IF (sendtoproc(Agrif_ProcRank)) THEN
+        call Agrif_var_copy_array(tempCextend,imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
+                                  tempC,      imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
+                                  nbdim)
+    ENDIF
+!
+    do k = 0,Agrif_ProcRank-1
+!
+        if (sendtoproc(k)) then
+!
+            datasize = 1
+!
+!CDIR SHORTLOOP
+            do i = 1,nbdim
+                datasize = datasize * (imax(i,k)-imin(i,k)+1)
+            enddo
+!
+            SELECT CASE(nbdim)
+            CASE(1)
+                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(2)
+                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(3)
+                call Agrif_Send_3Darray(tempC%array3,lbound(tempC%array3),imin(:,k),imax(:,k),k)
+            CASE(4)
+                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(5)
+                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k),     &
+                                           imin(5,k):imax(5,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(6)
+                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k),     &
+                                           imin(5,k):imax(5,k),     &
+                                           imin(6,k):imax(6,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            END SELECT
+!
+        endif
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        if (recvfromproc(k)) then
+!
+            datasize = 1
+!
+!CDIR SHORTLOOP
+            do i = 1,nbdim
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+            enddo
+
+            if (.not.associated(temprecv)) allocate(temprecv)
+            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
+
+            SELECT CASE(nbdim)
+            CASE(1)
+                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(2)
+                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(3)
+                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(4)
+                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(5)
+                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(6)
+                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            END SELECT
+
+            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+            call Agrif_array_deallocate(temprecv,nbdim)
+!
+        endif
+    enddo
+
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        if (sendtoproc(k)) then
+!
+            SELECT CASE(nbdim)
+            CASE(1)
+                datasize=SIZE(tempC%array1(imin(1,k):imax(1,k)))
+                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(2)
+                datasize=SIZE(tempC%array2(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k)))
+                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(3)
+                datasize=SIZE(tempC%array3(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k)))
+                call MPI_SEND(tempC%array3(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(4)
+                datasize=SIZE(tempC%array4(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k)))
+                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(5)
+                datasize=SIZE(tempC%array5(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k)))
+                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(6)
+                datasize=SIZE(tempC%array6(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k),     &
+                                               imin(6,k):imax(6,k)))
+                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k),     &
+                                               imin(6,k):imax(6,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            END SELECT
+!
+        endif
+!
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank-1,0,-1
+!
+        if (recvfromproc(k)) then
+!
+            if (.not.associated(temprecv)) allocate(temprecv)
+            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
+
+            SELECT CASE(nbdim)
+            CASE(1)
+                datasize=SIZE(temprecv%array1)
+                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(2)
+                datasize=SIZE(temprecv%array2)
+                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(3)
+                datasize=SIZE(temprecv%array3)
+                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(4)
+                datasize=SIZE(temprecv%array4)
+                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette,&
+                          Agrif_mpi_comm,statut,code)
+            CASE(5)
+                datasize=SIZE(temprecv%array5)
+                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette,&
+                         Agrif_mpi_comm,statut,code)
+            CASE(6)
+                datasize=SIZE(temprecv%array6)
+                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            END SELECT
+
+            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+            call Agrif_array_deallocate(temprecv,nbdim)
+!
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine ExchangeSamelevel
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Send_3Darray
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Send_3Darray ( tab3D, bounds, imin, imax, k )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),                                     intent(in) :: bounds
+    real, dimension(bounds(1):,bounds(2):,bounds(3):), target, intent(in) :: tab3D
+    integer, dimension(3),                                     intent(in) :: imin, imax
+    integer,                                                   intent(in) :: k
+!
+    integer :: etiquette = 100
+    integer :: datasize, code
+    include 'mpif.h'
+
+    datasize = SIZE(tab3D(imin(1):imax(1),  &
+                          imin(2):imax(2),  &
+                          imin(3):imax(3)))
+
+    call MPI_SEND( tab3D( imin(1):imax(1),  &
+                          imin(2):imax(2),  &
+                          imin(3):imax(3)), &
+                          datasize,Agrif_MPI_prec,k,etiquette,Agrif_mpi_comm,code)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Send_3Darray
+!===================================================================================================
+!
+#else
+    subroutine dummy_Agrif_Mpp ()
+    end subroutine dummy_Agrif_Mpp
+#endif
+!
+end Module Agrif_Mpp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modprocs.F90	(revision 8732)
@@ -0,0 +1,208 @@
+module Agrif_Procs
+!
+    implicit none
+!
+    type Agrif_Proc
+        integer               :: pn       !< Proc index in coarse grid
+        integer               :: pi       !< Proc index in x-direction (informative only, could be removed)
+        integer               :: pj       !< Proc index in y-direction (informative only, could be removed)
+        integer, dimension(3) :: imin
+        integer, dimension(3) :: imax
+        integer               :: nb_seqs = 0  !< Number of integration sequences the proc is attached to.
+        integer               :: grid_id = 0  !< Grid id the proc is attached to.
+    end type Agrif_Proc
+!
+    type Agrif_Proc_p
+        type(Agrif_Proc),   pointer   :: proc => NULL()  !< Pointer to the actual proc structure
+        type(Agrif_Proc_p), pointer   :: next => NULL()  !< Next proc in the list
+    end type Agrif_Proc_p
+!
+    type Agrif_Proc_List
+        integer                       :: nitems = 0      !< Number of elements in the list
+        type(Agrif_Proc_p), pointer   :: first => NULL() !< First proc in the list
+        type(Agrif_Proc_p), pointer   :: last  => NULL() !< Last proc inserted in the list
+    end type Agrif_Proc_List
+!
+contains
+!
+!===================================================================================================
+subroutine Agrif_pl_append ( proclist, proc )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List),     intent(inout)  :: proclist
+    type(Agrif_Proc), pointer, intent(in)     :: proc
+!
+    type(Agrif_Proc_p), pointer   :: new_pp
+!
+    allocate( new_pp )
+!
+    new_pp % proc => proc
+    new_pp % next => NULL()
+!
+    if ( associated(proclist % last) ) then
+        ! the list is not empty, let 'proc' be the next after the last (ie. the last one).
+        proclist % last % next => new_pp
+    else
+        ! the list has just been initialized. Let 'proc' be the first one.
+        proclist % first => new_pp
+    endif
+    ! anyway, for next time 'proc' will be the last one. 
+    proclist % last => new_pp
+    proclist % nitems = proclist % nitems + 1
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_append
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_print_array ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in) :: proclist
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: proc
+!
+    pp => proclist % first
+!
+    write(*,'("/-------+-----+-----+------+------+------+------+------\")')
+    write(*,'("| iproc | ipx | ipy | imin | imax | jmin | jmax | grid |")')
+    write(*,'("|-------+-----+-----+------+------+------+------+------|")')
+    do while ( associated(pp) )
+        proc => pp % proc
+        write(*,'("|",i6," |",i4," |",i4," |",i5," :",i5," |",i5," :",i5," | ",i4," |")') &
+            proc % pn, proc % pi, proc % pj, proc % imin(1), proc % imax(1), proc % imin(2), proc % imax(2), &
+            proc % grid_id
+        pp => pp % next
+    enddo
+    write(*,'("\-------+-----+-----+------+------+------+------+------/")')
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_print_array
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_print ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in) :: proclist
+!
+    type(Agrif_Proc_p), pointer :: pp
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        write(*,'(i0,",")',advance='no') pp % proc % pn
+        pp => pp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_print
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_copy ( proclist, copy )
+!
+!< Carries out a copy of 'proclist' into 'copy'
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)    :: proclist
+    type(Agrif_Proc_List), intent(out)   :: copy
+!
+    type(Agrif_Proc_p),    pointer    :: pp
+!
+    call Agrif_pl_clear(copy)
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        call Agrif_pl_append( copy, pp % proc )
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_copy
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_deep_copy ( proclist, copy )
+!
+!< Carries out a deep copy of 'proclist' into 'copy'
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)    :: proclist
+    type(Agrif_Proc_List), intent(out)   :: copy
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: new_proc
+!
+    call Agrif_pl_clear(copy)
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        allocate( new_proc )
+        new_proc = pp % proc
+        call Agrif_pl_append( copy, new_proc )
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_deep_copy
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_clear ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(inout)  :: proclist
+!
+    type(Agrif_Proc_p), pointer    :: pp, ppd
+!
+    pp => proclist % first
+!    
+    do while( associated(pp) )
+        ppd => pp
+        pp  => pp % next
+        deallocate(ppd)
+    enddo
+    
+    proclist % first => NULL()
+    proclist % last  => NULL()
+    proclist % nitems = 0
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_clear
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_to_array ( proclist, procarray )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List),                       intent(in)   :: proclist
+    type(Agrif_Proc), dimension(:), allocatable, intent(out)  :: procarray
+!
+    type(Agrif_Proc_p), pointer   :: pp
+!
+    allocate( procarray(1:proclist % nitems) )
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        procarray(pp%proc%pn+1) = pp % proc
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_to_array
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_pl_search_proc ( proclist, rank ) result ( proc )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)   :: proclist
+    integer,               intent(in)   :: rank
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: proc
+    logical :: found
+!
+    found = .false.
+    proc => NULL()
+    pp => proclist % first
+    do while ( .not.found .and. associated(pp) )
+        if ( pp % proc % pn == rank ) then
+            proc => pp % proc
+            return
+        else
+            pp => pp % next
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_pl_search_proc
+!===================================================================================================
+!
+end module Agrif_Procs
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90	(revision 8732)
@@ -0,0 +1,663 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Save
+!!
+!! Module for the initialization by copy of the grids created by clustering.
+!
+module Agrif_Save
+!
+    use Agrif_Types
+    use Agrif_Link
+    use Agrif_Arrays
+    use Agrif_Variables
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+! subroutine Agrif_deallocate_Arrays
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays ( var )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer :: var
+!
+    if (allocated(var%array1))  deallocate(var%array1)
+    if (allocated(var%array2))  deallocate(var%array2)
+    if (allocated(var%array3))  deallocate(var%array3)
+    if (allocated(var%array4))  deallocate(var%array4)
+    if (allocated(var%array5))  deallocate(var%array5)
+    if (allocated(var%array6))  deallocate(var%array6)
+!
+    if (allocated(var%darray1)) deallocate(var%darray1)
+    if (allocated(var%darray2)) deallocate(var%darray2)
+    if (allocated(var%darray3)) deallocate(var%darray3)
+    if (allocated(var%darray4)) deallocate(var%darray4)
+    if (allocated(var%darray5)) deallocate(var%darray5)
+    if (allocated(var%darray6)) deallocate(var%darray6)
+!
+    if (allocated(var%sarray1)) deallocate(var%sarray1)
+    if (allocated(var%sarray2)) deallocate(var%sarray2)
+    if (allocated(var%sarray3)) deallocate(var%sarray3)
+    if (allocated(var%sarray4)) deallocate(var%sarray4)
+    if (allocated(var%sarray5)) deallocate(var%sarray5)
+    if (allocated(var%sarray6)) deallocate(var%sarray6)
+!
+!
+    if (associated(var%oldvalues2D))    deallocate(var%oldvalues2D)
+    if (allocated(var%posvar))          deallocate(var%posvar)
+    if (allocated(var%interptab))       deallocate(var%interptab)
+    if (allocated(var%coords))          deallocate(var%coords)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_c ( var_c )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_c), pointer :: var_c
+!
+    if (allocated(var_c%carray1)) deallocate(var_c%carray1)
+    if (allocated(var_C%carray2)) deallocate(var_c%carray2)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_c
+!===================================================================================================
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_l ( var_l )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_l), pointer :: var_l
+!
+!
+    if (allocated(var_l%larray1)) deallocate(var_l%larray1)
+    if (allocated(var_l%larray2)) deallocate(var_l%larray2)
+    if (allocated(var_l%larray3)) deallocate(var_l%larray3)
+    if (allocated(var_l%larray4)) deallocate(var_l%larray4)
+    if (allocated(var_l%larray5)) deallocate(var_l%larray5)
+    if (allocated(var_l%larray6)) deallocate(var_l%larray6)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_l
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_i ( var_i )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_i), pointer :: var_i
+!
+!
+    if (allocated(var_i%iarray1)) deallocate(var_i%iarray1)
+    if (allocated(var_i%iarray2)) deallocate(var_i%iarray2)
+    if (allocated(var_i%iarray3)) deallocate(var_i%iarray3)
+    if (allocated(var_i%iarray4)) deallocate(var_i%iarray4)
+    if (allocated(var_i%iarray5)) deallocate(var_i%iarray5)
+    if (allocated(var_i%iarray6)) deallocate(var_i%iarray6)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_i
+!
+!===================================================================================================
+!  subroutine Agrif_Free_data_before
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_data_before ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr ! Pointer on the current grid
+!
+    integer :: i
+    type(Agrif_Variables_List), pointer :: parcours
+    type(Agrif_Variable),       pointer :: var
+    type(Agrif_Variable_c),     pointer :: var_c
+    type(Agrif_Variable_r),     pointer :: var_r
+    type(Agrif_Variable_l),     pointer :: var_l
+    type(Agrif_Variable_i),     pointer :: var_i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Gr % tabvars(i)
+!
+        if ( .NOT. Agrif_Mygrid % tabvars(i) % restore ) then
+            call Agrif_deallocate_Arrays(var)
+        endif
+!
+        if (associated(var%list_interp)) then
+            call Agrif_Free_list_interp(var%list_interp)
+        endif
+!
+    enddo
+    do i=1,Agrif_NbVariables(1)
+        var_c => Agrif_Gr % tabvars_c(i)
+        call Agrif_deallocate_Arrays_c(var_c)
+    enddo
+    do i=1,Agrif_NbVariables(3)
+        var_l => Agrif_Gr % tabvars_l(i)
+        call Agrif_deallocate_Arrays_l(var_l)
+    enddo
+    do i=1,Agrif_NbVariables(4)
+        var_i => Agrif_Gr % tabvars_i(i)
+        call Agrif_deallocate_Arrays_i(var_i)
+    enddo
+
+    parcours => Agrif_Gr % variables
+
+    do i = 1,Agrif_Gr%NbVariables
+!
+        if ( .NOT. parcours%var%root_var % restore ) then
+            call Agrif_deallocate_Arrays(parcours%var)
+        endif
+!
+        if (associated(parcours%var%list_interp)) then
+            call Agrif_Free_list_interp(parcours%var%list_interp)
+        endif
+!
+        if ( .NOT. parcours%var%root_var % restore ) then
+            deallocate(parcours%var)
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+        if ( Agrif_Probdim == 1 ) deallocate(Agrif_Gr%tabpoint1D)
+        if ( Agrif_Probdim == 2 ) deallocate(Agrif_Gr%tabpoint2D)
+        if ( Agrif_Probdim == 3 ) deallocate(Agrif_Gr%tabpoint3D)
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_data_before
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_list_interp
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_list_interp ( list_interp )
+!---------------------------------------------------------------------------------------------------
+      type(Agrif_List_Interp_Loc), pointer :: list_interp
+!
+      if (associated(list_interp%suiv)) call Agrif_Free_list_interp(list_interp%suiv)
+
+#if defined AGRIF_MPI
+       deallocate(list_interp%interp_loc%tab4t)
+       deallocate(list_interp%interp_loc%memberinall)
+       deallocate(list_interp%interp_loc%sendtoproc1)
+       deallocate(list_interp%interp_loc%recvfromproc1)
+#endif
+       deallocate(list_interp%interp_loc)
+       deallocate(list_interp)
+       nullify(list_interp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_list_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_data_after
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_data_after ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
+!
+    integer :: i
+    type(Agrif_Variables_List), pointer :: parcours, rootparcours
+    type(Agrif_Variable),       pointer :: var
+!
+    do i = 1,Agrif_NbVariables(0)
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+            var => Agrif_Gr%tabvars(i)
+            call Agrif_deallocate_Arrays(var)
+        endif
+    enddo
+!
+    parcours => Agrif_Gr%variables
+    rootparcours => Agrif_Mygrid%variables
+!
+    do i = 1,Agrif_Gr%NbVariables
+        if (rootparcours%var % restore ) then
+            call Agrif_deallocate_Arrays(parcours%var)
+            deallocate(parcours%var)
+        endif
+        parcours => parcours % next
+        rootparcours => rootparcours % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_data_after
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld_All
+!
+!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_CopyFromOld_All ( g, oldchildlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: g   !< Pointer on the current grid
+    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    real    :: g_eps, eps, oldgrid_eps
+    integer :: out
+    integer :: iii
+!
+    out = 0
+!
+    parcours => oldchildlist % first
+!
+    do while (associated(parcours))
+!
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+!
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1,Agrif_Probdim
+                g_eps = min(g_eps,g % Agrif_dx(iii))
+                oldgrid_eps = min(oldgrid_eps, parcours % gr % Agrif_dx(iii))
+            enddo
+!
+            eps = min(g_eps,oldgrid_eps)/100.
+!
+            do iii = 1,Agrif_Probdim
+                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
+                    parcours => parcours % next
+                    out = 1
+                    exit
+                endif
+            enddo
+!
+            if ( out == 1 ) cycle
+!
+            call Agrif_CopyFromOld(g,parcours%gr)
+!
+        endif
+!
+        call Agrif_CopyFromOld_All(g,parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+      enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld
+!
+!> Call to the Agrif_Copy procedure.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopyFromOld ( new_gr, old_gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: new_gr  !< Pointer on the current grid
+    type(Agrif_Grid), pointer, intent(inout) :: old_gr  !< Pointer on an old grid
+!
+    type(Agrif_Variable), pointer   :: new_var
+    type(Agrif_Variable), pointer   :: old_var
+    integer :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+            old_var => old_gr % tabvars(i)
+            new_var => new_gr % tabvars(i)
+            call Agrif_Copy(new_gr, old_gr, new_var, old_var )
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld_AllOneVar
+!
+!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_CopyFromOld_AllOneVar ( g, oldchildlist, indic )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: g            !< Pointer on the current grid
+    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
+    integer,                   intent(in)    :: indic
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    real    :: g_eps,eps,oldgrid_eps
+    integer :: out
+    integer :: iii
+!
+    out = 0
+!
+    parcours => oldchildlist % first
+!
+    do while (associated(parcours))
+!
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+!
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1,Agrif_Probdim
+                g_eps = min(g_eps,g % Agrif_dx(iii))
+                oldgrid_eps = min(oldgrid_eps,parcours % gr % Agrif_dx(iii))
+            enddo
+!
+            eps = min(g_eps,oldgrid_eps)/100.
+!
+            do iii = 1,Agrif_Probdim
+                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
+                    parcours => parcours % next
+                    out = 1
+                    exit
+                endif
+            enddo
+
+            if ( out == 1 ) cycle
+!
+            call Agrif_CopyFromOldOneVar(g,parcours%gr,indic)
+!
+        endif
+!
+        call Agrif_CopyFromOld_AllOneVar(g,parcours%gr % child_list,indic)
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld_AllOneVar
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOldOneVar
+!
+!> Call to Agrif_Copy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopyFromOldOneVar ( new_gr, old_gr, indic )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: new_gr     !< Pointer on the current grid
+    type(Agrif_Grid), pointer, intent(in)    :: old_gr     !< Pointer on an old grid
+    integer,                   intent(in)    :: indic
+!
+    type(Agrif_Variable),  pointer  :: new_var, old_var
+!
+    new_var => Agrif_Search_Variable(new_gr, -indic)
+    old_var => Agrif_Search_Variable(old_gr, -indic)
+!
+    call Agrif_array_allocate(new_var,new_var%lb,new_var%ub,new_var%nbdim)
+    call Agrif_Copy(new_gr, old_gr, new_var,old_var)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOldOneVar
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Copy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Copy ( new_gr, old_gr, new_var, old_var )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),     pointer, intent(in)       :: new_gr !< Pointer on the current grid
+    type(Agrif_Grid),     pointer, intent(in)       :: old_gr !< Pointer on an old grid
+    type(Agrif_Variable), pointer, intent(inout)    :: new_var
+    type(Agrif_Variable), pointer, intent(in)       :: old_var
+!
+    type(Agrif_Variable), pointer :: root ! Pointer on the variable of the root grid
+    integer               :: nbdim     ! Number of dimensions of the current grid
+    integer, dimension(6) :: pttabnew  ! Indexes of the first point in the domain
+    integer, dimension(6) :: petabnew  ! Indexes of the first point in the domain
+    integer, dimension(6) :: pttabold  ! Indexes of the first point in the domain
+    integer, dimension(6) :: petabold  ! Indexes of the first point in the domain
+    integer, dimension(6) :: nbtabold  ! Number of cells in each direction
+    integer, dimension(6) :: nbtabnew  ! Number of cells in each direction
+    real,    dimension(6) :: snew,sold
+    real,    dimension(6) :: dsnew,dsold
+    real    :: eps
+    integer :: n
+!
+    root => new_var % root_var
+    nbdim = root % nbdim
+!
+    do n = 1,nbdim
+!
+        select case(root % interptab(n))
+!
+        case('x')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n)  = new_gr % Agrif_x(1)
+            sold(n)  = old_gr % Agrif_x(1)
+            dsnew(n) = new_gr % Agrif_dx(1)
+            dsold(n) = old_gr % Agrif_dx(1)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(1)
+                petabold(n) = pttabold(n) + old_gr % nb(1)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(1) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(1) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('y')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n) = new_gr % Agrif_x(2)
+            sold(n) = old_gr % Agrif_x(2)
+            dsnew(n) = new_gr % Agrif_dx(2)
+            dsold(n) = old_gr % Agrif_dx(2)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(2)
+                petabold(n) = pttabold(n) + old_gr % nb(2)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(2) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(2) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('z')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n)  = new_gr % Agrif_x(3)
+            sold(n)  = old_gr % Agrif_x(3)
+            dsnew(n) = new_gr % Agrif_dx(3)
+            dsold(n) = old_gr % Agrif_dx(3)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(3)
+                petabold(n) = pttabold(n) + old_gr % nb(3)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(3) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(3) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('N')
+!
+            call Agrif_get_var_bounds(new_var,pttabnew(n),petabnew(n),n)
+!
+            pttabold(n) = pttabnew(n)
+            petabold(n) = petabnew(n)
+            snew(n) = 0.
+            sold(n) = 0.
+            dsnew(n) = 1.
+            dsold(n) = 1.
+!
+        end select
+!
+    enddo
+!
+    do n = 1,nbdim
+        nbtabnew(n) = petabnew(n) - pttabnew(n)
+        nbtabold(n) = petabold(n) - pttabold(n)
+    enddo
+!
+    eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim))) / 100.
+!
+    do n = 1,nbdim
+        if (snew(n) > (sold(n)+dsold(n)*nbtabold(n)+eps)) return
+        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) < sold(n)) return
+    enddo
+!
+    call Agrif_CopynD(new_var,old_var,pttabold,petabold,pttabnew,petabnew,  &
+                      sold,snew,dsold,dsnew,nbdim)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Copy
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopynD
+!
+!> Copy from the nD variable Old_Var the nD variable New_Var
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopynD ( new_var, old_var, pttabold, petabold, pttabnew, petabnew, &
+                          sold, snew, dsold, dsnew, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer, intent(inout) :: new_var
+    type(Agrif_Variable), pointer, intent(in)    :: old_var
+    integer, dimension(nbdim),     intent(in)    :: pttabnew
+    integer, dimension(nbdim),     intent(in)    :: petabnew
+    integer, dimension(nbdim),     intent(in)    :: pttabold
+    integer, dimension(nbdim),     intent(in)    :: petabold
+    real,    dimension(nbdim),     intent(in)    :: snew, sold
+    real,    dimension(nbdim),     intent(in)    :: dsnew,dsold
+    integer,                       intent(in)    :: nbdim
+!
+    integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
+!
+    real,    dimension(nbdim) :: dim_gmin,   dim_gmax
+    real,    dimension(nbdim) :: dim_newmin, dim_newmax
+    real,    dimension(nbdim) :: dim_min
+    integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax
+!
+    do i = 1,nbdim
+!
+        dim_gmin(i) = sold(i)
+        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
+!
+        dim_newmin(i) = snew(i)
+        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
+!
+    enddo
+!
+    do i = 1,nbdim
+        if (dim_gmax(i) < dim_newmin(i)) return
+        if (dim_gmin(i) > dim_newmax(i)) return
+    enddo
+!
+    do i = 1,nbdim
+!
+        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),dim_newmin(i))-dim_newmin(i))/dsnew(i))
+        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
+        ind_gmin(i)   = pttabold(i) + nint((dim_min(i)-dim_gmin(i))/dsold(i))
+        ind_newmax(i) = pttabnew(i) + int((min(dim_gmax(i),dim_newmax(i))-dim_newmin(i))/dsnew(i))
+!
+    enddo
+!
+    select case (nbdim)
+!
+    case (1)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+            new_var % array1(i)    = old_var % array1(i0)
+            new_var % restore1D(i) = 1
+            i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (2)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+            new_var % array2(i,j)    = old_var % array2(i0,j0)
+            new_var % restore2D(i,j) = 1
+            j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (3)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+            new_var % array3(i,j,k)    =  old_var % array3(i0,j0,k0)
+            new_var % restore3D(i,j,k) = 1
+            k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (4)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+            new_var % array4(i,j,k,l)    = old_var % array4(i0,j0,k0,l0)
+            new_var % restore4D(i,j,k,l) = 1
+            l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (5)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
+            new_var % array5(i,j,k,l,m)    = old_var % array5(i0,j0,k0,l0,m0)
+            new_var % restore5D(i,j,k,l,m) = 1
+            m0 = m0 + int(dsnew(5)/dsold(5))
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (6)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
+        n0 = ind_gmin(6) ; do n = ind_newmin(6),ind_newmax(6)
+            new_var % array6(i,j,k,l,m,n)    = old_var % array6(i0,j0,k0,l0,m0,n0)
+            new_var % restore6D(i,j,k,l,m,n) = 1
+            n0 = n0 + int(dsnew(6)/dsold(6))
+        enddo
+        m0 = m0 + int(dsnew(5)/dsold(5))
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+      end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopynD
+!===================================================================================================
+!
+end module Agrif_Save
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modseq.F90	(revision 8732)
@@ -0,0 +1,640 @@
+module Agrif_seq
+!
+    use Agrif_Init
+    use Agrif_Procs
+    use Agrif_Arrays
+!
+    implicit none
+!
+contains
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+function Agrif_seq_allocate_list ( nb_seqs ) result( seqlist )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: nb_seqs
+!
+    type(Agrif_Sequence_List), pointer :: seqlist
+!
+    allocate(seqlist)
+    seqlist % nb_seqs = nb_seqs
+    allocate(seqlist % sequences(1:nb_seqs))
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_allocate_list
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_add_grid ( seqlist, seq_num, grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Sequence_List), intent(inout)    :: seqlist
+    integer,                   intent(in)       :: seq_num
+    type(Agrif_Grid), pointer, intent(in)       :: grid
+!
+    call Agrif_gl_append(seqlist % sequences(seq_num) % gridlist, grid )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_add_grid
+!===================================================================================================
+!
+!===================================================================================================
+recursive subroutine Agrif_seq_init_sequences ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout)  :: grid
+!
+    type(Agrif_PGrid), pointer  :: gp
+!
+#if defined AGRIF_MPI
+!
+! Build list of required procs for each child grid
+    gp => grid % child_list % first
+    do while ( associated( gp ) )
+        call Agrif_seq_build_required_proclist( gp % gr )
+        gp => gp % next
+    enddo
+!
+! Create integration sequences for the current grid
+    call Agrif_seq_create_proc_sequences( grid )
+    call Agrif_seq_allocate_procs_to_childs( grid )
+!
+! Create new communicators for sequences
+    call Agrif_seq_create_communicators( grid )
+!
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_init_sequences
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_build_required_proclist ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: grid
+!
+    type(Agrif_Grid),      pointer  :: parent_grid
+    type(Agrif_Rectangle), pointer  :: grid_rect
+    type(Agrif_Proc_p),    pointer  :: proc_rect
+    type(Agrif_Proc),      pointer  :: proc
+    logical     :: proc_is_required
+    integer     :: i
+!
+    if ( grid % fixedrank == 0 ) then
+!       grid is the Root
+        if ( grid % required_proc_list % nitems == 0 ) then
+            print*, "### Error Agrif_seq_build_required_proclist: empty proc list."
+            print*, "# -> You should check if Agrif_Init_ProcList() is actually working."
+            stop
+        endif
+        return
+    endif
+!
+    parent_grid => grid % parent
+    grid_rect   => grid % rect_in_parent
+    proc_rect   => parent_grid % proc_def_list % first
+!
+
+    do while ( associated( proc_rect ) )
+
+!
+        proc => proc_rect % proc
+!
+        proc_is_required = .true.
+        do i = 1,Agrif_Probdim
+            proc_is_required = ( proc_is_required             .and. &
+                    ( grid_rect % imin(i) <= proc % imax(i) ) .and. &
+                    ( grid_rect % imax(i) >= proc % imin(i) ) )
+        enddo
+!
+        if ( proc_is_required ) then
+            call Agrif_pl_append(grid % required_proc_list, proc)
+        endif
+        proc_rect => proc_rect % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_build_required_proclist
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_create_proc_sequences ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout)    :: grid
+!
+    type(Agrif_Grid_List), pointer :: sorted_child_list
+    type(Agrif_PGrid),     pointer :: child_p
+    type(Agrif_PGrid),     pointer :: g1p, g2p
+    type(Agrif_Proc_p),    pointer :: pp1, pp2
+    type(Agrif_Proc),      pointer :: proc
+    integer                        :: nb_seq_max, nb_seqs, cur_seq
+!
+    nb_seq_max = 0
+!
+    if ( grid % child_list % nitems == 0 ) return
+!
+! For each required proc...
+    pp1  => grid % required_proc_list % first
+    do while ( associated(pp1) )
+        proc => pp1 % proc
+        proc % nb_seqs = 0
+!   ..loop over all child grids...
+        child_p => grid % child_list % first
+        do while ( associated(child_p) )
+!       ..and look for 'proc' in the list of procs required by 'child'
+            pp2 => child_p % gr % required_proc_list % first
+            do while ( associated(pp2) )
+                if ( proc % pn == pp2 % proc % pn ) then
+!                   'proc' is required by this child grid, so we increment its number of sequences
+                    proc % nb_seqs = proc % nb_seqs + 1
+                    pp2 => NULL()
+                else
+                    pp2 => pp2 % next
+                endif
+            enddo
+            child_p => child_p % next
+        enddo
+        nb_seq_max = max(nb_seq_max, proc % nb_seqs)
+        pp1 => pp1 % next
+    enddo
+!
+! For each grid...
+    g1p => grid % child_list % first
+    do while ( associated(g1p) )
+!     compare it with the following ones
+        g2p => g1p % next
+        do while ( associated(g2p) )
+            if ( Agrif_seq_grids_are_connected( g1p % gr, g2p % gr ) ) then
+                call Agrif_gl_append( g1p % gr % neigh_list, g2p % gr )
+                call Agrif_gl_append( g2p % gr % neigh_list, g1p % gr )
+            endif
+            g2p => g2p % next
+        enddo
+        g1p => g1p % next
+    enddo
+!
+! Colorize graph nodes
+    nb_seqs = Agrif_seq_colorize_grid_list(grid % child_list)
+    sorted_child_list => Agrif_gl_merge_sort ( grid % child_list, compare_colors )
+!
+! Create sequence structure
+    cur_seq = 0
+    grid % child_seq => Agrif_seq_allocate_list(nb_seqs)
+    child_p => sorted_child_list % first
+    do while ( associated(child_p) )
+        if ( cur_seq /= child_p % gr % seq_num ) then
+            cur_seq = child_p % gr % seq_num
+        endif
+        call Agrif_seq_add_grid(grid % child_seq,cur_seq,child_p% gr)
+        child_p => child_p % next
+    enddo
+!
+    call Agrif_gl_delete(sorted_child_list)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_create_proc_sequences
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_grids_are_connected( g1, g2 ) result( connection )
+!
+!< Compare required_proc_list for g1 and g2. These are connected if they share a same proc.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in) :: g1, g2
+!
+    logical :: connection
+    type(Agrif_Proc_p), pointer :: pp1, pp2
+!
+    connection = .false.
+!
+    pp1 => g1 % required_proc_list % first
+!
+    do while( associated(pp1) .and. (.not. connection) )
+!
+        pp2 => g2 % required_proc_list % first
+        do while ( associated(pp2) .and. (.not. connection) )
+            if ( pp1 % proc % pn == pp2 % proc % pn ) then
+            ! if pp1 and pp2 are the same proc, it means that g1 and g2 are connected. We stop here.
+                connection = .true.
+            endif
+            pp2 => pp2 % next
+        enddo
+        pp1 => pp1 % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_grids_are_connected
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_colorize_grid_list ( gridlist ) result ( ncolors )
+!
+!< 1.  Sort nodes in decreasing order of degree.
+!< 2.  Color the node with highest degree with color 1.
+!< 3.  Choose the node with the largest DSAT value. In case of conflict, choose the one with the
+!!       highest degree. Then the one corresponding to the largest grid.
+!< 4.  Color this node with the smallest possible color.
+!< 5.  If all nodes are colored, then stop. Otherwise, go to 3.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)    :: gridlist
+!
+    type(Agrif_Grid_List),   pointer  :: X, Y
+    type(Agrif_PGrid),       pointer  :: gridp
+    type(Agrif_Grid_List),   pointer  :: tmp_gl
+    integer                           :: ncolors
+    integer, dimension(1:gridlist%nitems)   :: colors
+!
+! Be carefull...
+    nullify(Y)
+!
+! First initialize the color of each node
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        gridp % gr % seq_num = 0
+        gridp => gridp % next
+    enddo
+!
+! Then sort the grids by decreasing degree
+    X => Agrif_gl_merge_sort( gridlist, compare_grid_degrees )
+    gridp => X % first
+!
+! Colorize the first grid in the list
+    gridp % gr % seq_num = 1
+    gridp => gridp % next
+!
+! Then for each of its neighbors...
+    do while ( associated(gridp) )
+!
+        if ( gridp % gr % neigh_list % nitems == 0 ) then
+        ! this grid is alone... let.s attach it to an existing sequence
+            call Agrif_seq_attach_grid( X, gridp % gr )
+            gridp => gridp % next
+            cycle
+        endif
+!
+!     Compute dsat value of all non-colored grids
+        tmp_gl => Agrif_gl_build_from_gp(gridp)
+        call Agrif_seq_calc_dsat(tmp_gl)
+!
+!     Sort non-colored grids by decreasing dsat value, then by size
+        call Agrif_gl_delete(Y)
+        Y => Agrif_gl_merge_sort( tmp_gl, compare_dsat_values, compare_size_values )
+!
+!     Next coloration is for the first grid in this list  TODO : maybe we could find a better choice ..?
+        gridp => Y % first
+!
+!     Assign a color to the chosen grid
+        gridp % gr % seq_num = Agrif_seq_smallest_available_color_in_neighborhood( gridp % gr % neigh_list )
+!
+        gridp => gridp % next
+        call Agrif_gl_delete(tmp_gl)
+!
+    enddo
+!
+    call Agrif_gl_delete(X)
+    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
+    ncolors = maxval(colors)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_colorize_grid_list
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_attach_grid ( gridlist, grid )
+!
+!< 'grid' is not connected to any neighbor. Therefore, we give an existing and well chosen color.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)       :: gridlist
+    type(Agrif_Grid),      intent(inout)    :: grid
+!
+    integer, dimension(gridlist%nitems) :: colors
+    integer, dimension(:), allocatable  :: ngrids_by_color
+    integer :: i, color, ncolors
+!
+    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
+    ncolors = maxval(colors)
+!
+    allocate(ngrids_by_color(ncolors))
+    ngrids_by_color = 0
+!
+    do i = 1,gridlist % nitems
+        if (colors(i) > 0)  ngrids_by_color(colors(i)) = ngrids_by_color(colors(i)) + 1
+    enddo
+!
+    color = ncolors
+    do i = 1,ncolors
+        if ( ngrids_by_color(i) < color ) color = i
+    enddo
+!
+    grid % seq_num = color
+    deallocate(ngrids_by_color)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_attach_grid
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_colors_in_neighborhood ( neigh_list, colors )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: neigh_list
+    integer, dimension(:), intent(out)  :: colors
+!
+    integer                     :: i
+    type(Agrif_PGrid), pointer  :: gridp
+!
+    i = lbound(colors,1)
+    colors = 0
+    gridp => neigh_list % first
+!
+    do while ( associated(gridp) )
+!
+        if ( i > ubound(colors,1) ) then
+            print*,'Error in Agrif_seq_colors_in_neighborhood : "colors" array is too small'
+            stop
+        endif
+        colors(i) = gridp % gr % seq_num
+        gridp => gridp % next
+        i = i+1
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_colors_in_neighborhood
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_smallest_available_color_in_neighborhood ( neigh_list ) result ( smallest )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: neigh_list
+!
+    integer, dimension(:), allocatable :: color_is_met
+    integer     :: colors_tab(1:neigh_list%nitems)
+    integer     :: i, smallest, max_color
+!
+    call Agrif_seq_colors_in_neighborhood( neigh_list, colors_tab )
+    max_color = maxval(colors_tab)
+!
+    allocate(color_is_met(1:max_color))
+    color_is_met = 0
+!
+    do i = 1,neigh_list % nitems
+        if ( colors_tab(i) /= 0 ) then
+            color_is_met(colors_tab(i)) = 1
+        endif
+    enddo
+!
+    smallest = max_color+1
+    do i = 1,max_color
+        if ( color_is_met(i) == 0 ) then
+            smallest = i
+            exit
+        endif
+    enddo
+!
+    deallocate(color_is_met)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_smallest_available_color_in_neighborhood
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_calc_dsat ( gridlist )
+!< For each node 'v' :
+!<   if none of its neighbors is colored then
+!<       DSAT(v) = degree(v)  #  degree(v) := number of neighbors
+!<   else
+!<       DSAT(v) = number of different colors used in the first neighborhood of v.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer          :: gridp
+    type(Agrif_Grid),  pointer          :: grid
+    integer, dimension(:), allocatable  :: colors, color_is_met
+    integer                             :: i, ncolors
+!
+    gridp => gridlist % first
+!
+    do while ( associated(gridp) )
+!
+        grid => gridp % gr
+!
+        allocate(colors(grid % neigh_list % nitems))
+        call Agrif_seq_colors_in_neighborhood( grid % neigh_list, colors )
+
+        allocate(color_is_met(1:maxval(colors)))
+        color_is_met = 0
+!
+        do i = 1,grid % neigh_list % nitems
+            if ( colors(i) /= 0 ) then
+                color_is_met(colors(i)) = 1
+            endif
+        enddo
+        ncolors = sum(color_is_met)
+!
+        if ( ncolors == 0 ) then
+            grid % dsat = grid % neigh_list % nitems
+        else
+            grid % dsat = ncolors
+        endif
+        deallocate(colors, color_is_met)
+        gridp => gridp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_calc_dsat
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_allocate_procs_to_childs ( coarse_grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: coarse_grid
+!
+    integer                         :: is, ip, ig, ngrids
+    type(Agrif_Grid_List), pointer  :: gridlist
+    type(Agrif_PGrid),     pointer  :: gp
+    type(Agrif_Grid),      pointer  :: grid
+    type(Agrif_Proc_List), pointer  :: proclist
+    type(Agrif_Proc),      pointer  :: proc
+    type(Agrif_Proc_p),    pointer  :: pp
+    type(Agrif_Proc), dimension(:), allocatable, target :: procarray
+    type(Agrif_Grid), dimension(:), allocatable         :: gridarray
+    type(Agrif_Sequence_List), pointer :: seqlist
+    real,dimension(:),allocatable :: grid_costs
+    integer,dimension(:), allocatable :: nbprocs_per_grid
+    integer :: i1, i2, j1, j2
+    real :: max_cost
+    integer :: max_index
+!
+    seqlist => coarse_grid % child_seq
+    if ( .not. associated(seqlist) ) return
+!
+! Initialize proc allocation
+    pp => coarse_grid % proc_def_list % first
+    do while ( associated(pp) )
+        pp % proc % grid_id = 0
+        pp => pp % next
+    enddo
+!
+! For each sequence...
+    do is = 1,seqlist % nb_seqs
+!
+        proclist => seqlist % sequences(is) % proclist
+        gridlist => seqlist % sequences(is) % gridlist
+!
+!     Copy coarse grid proc list and convert it to an array
+        call Agrif_pl_deep_copy( coarse_grid % proc_def_list, proclist )
+        call Agrif_pl_to_array ( proclist, procarray )
+!
+!     Allocate a temporary array with concerned grid numbers
+        ngrids = gridlist % nitems
+        allocate(gridarray(1:ngrids))
+        allocate(grid_costs(1:ngrids))
+        allocate(nbprocs_per_grid(1:ngrids))
+
+      nbprocs_per_grid = 0
+!
+!     Allocate required procs to each grid
+        gp => gridlist % first
+        ig = 0
+        do while ( associated(gp) )
+            grid => gp % gr
+            ig = ig+1 ; gridarray(ig) = grid
+            pp => grid % required_proc_list % first
+            do while ( associated(pp) )
+                procarray( pp % proc % pn+1 ) % grid_id = grid % fixedrank
+                nbprocs_per_grid(ig) = nbprocs_per_grid(ig) + 1
+                pp => pp % next
+            enddo
+            gp => gp % next
+        enddo
+!
+!     Add unused procs to the grids
+! TODO FIXME: This is just a dummy allocation. You should take into account grid size and more
+!             information here...
+
+! Estimate current costs
+
+        do ig = 1, ngrids
+          i1 = gridarray(ig)%ix(1)
+          i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
+          j1 = gridarray(ig)%ix(2)
+          j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
+          Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
+          grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
+        enddo
+
+        ig = 1
+        do ip = 1,proclist%nitems
+            if ( procarray( ip ) % grid_id == 0 ) then
+!             this proc is unused
+              max_cost = 0.
+              max_index = 1
+              do ig = 1,ngrids
+                 if (grid_costs(ig) > max_cost) then
+                    max_cost = grid_costs(ig)
+                    max_index = ig
+                 endif
+              enddo
+
+              ig = max_index
+              procarray( ip ) % grid_id = gridarray(ig) % fixedrank
+
+              nbprocs_per_grid(ig) =  nbprocs_per_grid(ig) + 1
+              i1 = gridarray(ig)%ix(1)
+              i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
+              j1 = gridarray(ig)%ix(2)
+              j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
+              Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
+              grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
+
+            endif
+        enddo
+!
+!     Allocate proc nums to each grid
+        gp => gridlist % first
+        do while ( associated(gp) )
+            do ip = 1,proclist%nitems
+                if ( procarray( ip ) % grid_id == gp % gr % fixedrank ) then
+                    allocate(proc)
+                    proc = procarray( ip )
+                    call Agrif_pl_append(gp % gr % proc_def_in_parent_list, proc)
+                endif
+            enddo
+            gp => gp % next
+        enddo
+!
+!     Clean up
+        deallocate(procarray, gridarray, grid_costs, nbprocs_per_grid)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_allocate_procs_to_childs
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_create_communicators ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: grid
+!
+    include 'mpif.h'
+    type(Agrif_Sequence_List), pointer  :: seqlist  ! List of child sequences
+    type(Agrif_PGrid), pointer          :: gridp
+    type(Agrif_Proc),  pointer          :: proc
+    integer     :: i, ierr
+    integer     :: current_comm, comm_seq, color_seq
+!
+    seqlist => grid % child_seq
+    if ( .not. associated(seqlist) ) return
+!
+    current_comm = grid % communicator
+    color_seq = MPI_COMM_NULL
+!
+! For each sequence, split the current communicator into as many groups as needed.
+    do i = 1,seqlist % nb_seqs
+!
+!     Loop over each proclist to give a color to the current process
+        gridp => seqlist % sequences(i) % gridlist % first
+        grid_loop : do while ( associated(gridp) )
+            proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
+            if ( associated(proc) ) then
+                if ( gridp % gr % fixedrank /= proc % grid_id ) then
+                    write(*,'("### Error Agrif_seq_create_communicators : ")')
+                    write(*,'("  inconsitancy on proc ",i2,":")') Agrif_Procrank
+                    write(*,'("gr % fixedrank = ",i0,", where proc % grid_id = ",i0)') &
+                            gridp % gr % fixedrank, proc % grid_id
+                    stop
+                endif
+                color_seq = gridp % gr % fixedrank
+                exit grid_loop
+            endif
+            gridp => gridp % next
+        enddo grid_loop
+!
+        call MPI_COMM_SPLIT(current_comm, color_seq, Agrif_ProcRank, comm_seq, ierr)
+        gridp % gr % communicator = comm_seq
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_create_communicators
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_select_child ( g, is ) result ( gridp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(in)   :: g
+    integer,                   intent(in)   :: is
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Proc),  pointer  :: proc
+!
+    call Agrif_Instance( g )
+    gridp => g % child_seq % sequences(is) % gridlist % first
+!
+    do while ( associated(gridp) )
+        proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
+        if ( associated(proc) ) then
+            return
+        endif
+        gridp => gridp % next
+    enddo
+    write(*,'("### Error Agrif_seq_select_child : no grid found in sequence ",i0," (mother G",i0,") for P",i0)')&
+        is, g%fixedrank, Agrif_Procrank
+    stop
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_select_child
+!===================================================================================================
+#else
+    subroutine dummy_Agrif_seq ()
+    end subroutine dummy_Agrif_seq
+#endif
+!
+end module Agrif_seq
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F90	(revision 8732)
@@ -0,0 +1,425 @@
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!
+!
+!> Definition of data types used in AGRIF, of several variables and parameters
+!
+module Agrif_Types
+!
+use Agrif_Procs
+!
+implicit none
+!
+integer, parameter :: Agrif_MaxRaff = 7       !< Maximum refinement ratio
+integer, parameter :: Agrif_NbMaxGrids = 10   !< Maximum number of grids of the hierarchy
+!
+!===================================================================================================
+type Agrif_LRectangle
+!---------------------------------------------------------------------------------------------------
+!<  Data type allowing a grid to reach a grid on the same level or its child grids
+!
+    type(Agrif_Rectangle) , pointer :: r    => NULL()   !< to reach a child grid
+    type(Agrif_LRectangle), pointer :: next => NULL()   !< to reach a grid on the same level
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_LRectangle
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Rectangle
+!---------------------------------------------------------------------------------------------------
+!<  Data type to define several characteristics of a grid (number, position, time and space
+!<  refinement factors, etc).
+!
+    integer                         :: number       !< Number of the grid
+    integer, dimension(3)           :: imin         !< Minimal position in the x,y and z direction
+    integer, dimension(3)           :: imax         !< Maximal position in the x,y and z direction
+    integer, dimension(3)           :: spaceref     !< Space refinement factor in the x,y and z direction
+    integer, dimension(3)           :: timeref      !< Time refinement factor in the x,y and z direction
+    type(Agrif_LRectangle), pointer :: childgrids => NULL()   !< Pointer to reach a grid on the same level or a child grid
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable), pointer  :: root_var   => NULL()  !< pointer on the variable of the root grid
+    type(Agrif_Variable), pointer  :: parent_var => NULL()  !< pointer on the parent variable
+!
+    integer,   dimension(6)              :: point           !< index of the first point in the
+                                                            !<    real domain (x,y and z direction)
+    integer,   dimension(:), allocatable :: posvar          !< position of the variable on the cell
+                                                            !<   (1 for the boarder of the edge, 2 for the center)
+    integer                            :: interpIndex = -1  !< Indication for the space interpolation (module Agrif_Boundary)
+    integer                            :: nbdim = 0         !< number of dimensions of the grid variable
+    character(1), dimension(:), allocatable :: interptab    !< Array indicating the type of dimension (space or not)
+                                                            !!   for each of them
+    integer,   dimension(:), allocatable :: coords          !< Array indicating the coordinate for each dimension
+                                                            !!   of the array that is refined :
+                                                            !!  'x' -> 1 ; 'y' -> 2 ; 'z' -> 3 ; 'N' -> 0
+
+!> @}
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real,    dimension(:)          , allocatable :: array1
+    real,    dimension(:,:)        , allocatable :: array2
+    real,    dimension(:,:,:)      , allocatable :: array3
+    real,    dimension(:,:,:,:)    , allocatable :: array4
+    real,    dimension(:,:,:,:,:)  , allocatable :: array5
+    real,    dimension(:,:,:,:,:,:), allocatable :: array6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8), dimension(:)          , allocatable :: darray1
+    real(8), dimension(:,:)        , allocatable :: darray2
+    real(8), dimension(:,:,:)      , allocatable :: darray3
+    real(8), dimension(:,:,:,:)    , allocatable :: darray4
+    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
+    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4), dimension(:)          , allocatable :: sarray1
+    real(4), dimension(:,:)        , allocatable :: sarray2
+    real(4), dimension(:,:,:)      , allocatable :: sarray3
+    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
+    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
+    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
+!> @}
+!> \name Arrays used to restore the values
+!> @{
+    integer, dimension(:)          , pointer :: restore1D => NULL()
+    integer, dimension(:,:)        , pointer :: restore2D => NULL()
+    integer, dimension(:,:,:)      , pointer :: restore3D => NULL()
+    integer, dimension(:,:,:,:)    , pointer :: restore4D => NULL()
+    integer, dimension(:,:,:,:,:)  , pointer :: restore5D => NULL()
+    integer, dimension(:,:,:,:,:,:), pointer :: restore6D => NULL()
+!> @}
+
+    real, dimension(:,:), pointer :: oldvalues2D => NULL() !< Array used for the time interpolation
+
+    logical :: restore = .FALSE. !< =1 if the variable should be restored
+    logical :: Interpolationshouldbemade = .FALSE. !< TRUE if the interpolation should be made in any case
+    integer                 :: bcinf !< option bc
+    integer                 :: bcsup !< option bc
+    integer, dimension(6)   :: type_interp    !< option interp
+    integer, dimension(6,6) :: type_interp_bc !< option bcinterp
+    integer, dimension(6)   :: type_update    !< option update
+
+    integer, dimension(6)   :: lb
+    integer, dimension(6)   :: ub
+
+    logical,dimension(6,2) :: memberin
+    integer,dimension(6,2,2,6,2) :: childarray
+
+    type(Agrif_List_Interp_Loc), pointer :: list_interp => NULL()
+    type(Agrif_List_Interp_Loc), pointer :: list_update => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_c
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_c), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_c), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (character)
+!> @{
+    character(2400)                             :: carray0
+    character(200), dimension(:)  , allocatable :: carray1
+    character(200), dimension(:,:), allocatable :: carray2
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_c
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_r
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_r), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_r), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real                                         :: array0
+    real,    dimension(:)          , allocatable :: array1
+    real,    dimension(:,:)        , allocatable :: array2
+    real,    dimension(:,:,:)      , allocatable :: array3
+    real,    dimension(:,:,:,:)    , allocatable :: array4
+    real,    dimension(:,:,:,:,:)  , allocatable :: array5
+    real,    dimension(:,:,:,:,:,:), allocatable :: array6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8)                                      :: darray0
+    real(8), dimension(:)          , allocatable :: darray1
+    real(8), dimension(:,:)        , allocatable :: darray2
+    real(8), dimension(:,:,:)      , allocatable :: darray3
+    real(8), dimension(:,:,:,:)    , allocatable :: darray4
+    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
+    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4)                                      :: sarray0
+    real(4), dimension(:)          , allocatable :: sarray1
+    real(4), dimension(:,:)        , allocatable :: sarray2
+    real(4), dimension(:,:,:)      , allocatable :: sarray3
+    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
+    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
+    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_r
+!===================================================================================================
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_l
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_l), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_l), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (logical)
+!> @{
+    logical                                      :: larray0
+    logical, dimension(:)          , allocatable :: larray1
+    logical, dimension(:,:)        , allocatable :: larray2
+    logical, dimension(:,:,:)      , allocatable :: larray3
+    logical, dimension(:,:,:,:)    , allocatable :: larray4
+    logical, dimension(:,:,:,:,:)  , allocatable :: larray5
+    logical, dimension(:,:,:,:,:,:), allocatable :: larray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_l
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_i
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_i), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_i), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0             !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (integer)
+!> @{
+    integer                                      :: iarray0
+    integer, dimension(:)          , allocatable :: iarray1
+    integer, dimension(:,:)        , allocatable :: iarray2
+    integer, dimension(:,:,:)      , allocatable :: iarray3
+    integer, dimension(:,:,:,:)    , allocatable :: iarray4
+    integer, dimension(:,:,:,:,:)  , allocatable :: iarray5
+    integer, dimension(:,:,:,:,:,:), allocatable :: iarray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_i
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Interp_Loc
+!---------------------------------------------------------------------------------------------------
+    integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99
+    integer,dimension(6)              :: indmin, indmax
+    integer,dimension(6)              :: pttruetab,cetruetab
+    logical :: member, memberin
+#if !defined AGRIF_MPI
+    integer,dimension(6)              :: indminglob,indmaxglob
+#else
+    integer,dimension(6)              :: indminglob2,indmaxglob2
+    integer,dimension(6,2,2)          :: parentarray
+    integer,dimension(:,:,:), pointer :: tab4t          => NULL()
+    integer,dimension(:,:,:), pointer :: tab5t          => NULL()
+    logical, dimension(:),    pointer :: memberinall    => NULL()
+    logical, dimension(:),    pointer :: memberinall2   => NULL()
+    logical, dimension(:),    pointer :: sendtoproc1    => NULL()
+    logical, dimension(:),    pointer :: sendtoproc2    => NULL()
+    logical, dimension(:),    pointer :: recvfromproc1  => NULL()
+    logical, dimension(:),    pointer :: recvfromproc2  => NULL()
+#endif
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Interp_Loc
+!===================================================================================================
+
+!===================================================================================================
+type Agrif_List_Interp_Loc
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Interp_Loc),      pointer :: interp_loc => NULL()
+    type(Agrif_List_Interp_Loc), pointer :: suiv       => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_List_Interp_Loc
+!===================================================================================================
+
+!===================================================================================================
+type Agrif_Variables_List
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),       pointer :: var  => NULL()
+    type(Agrif_Variables_List), pointer :: next => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variables_List
+!===================================================================================================
+!
+!===================================================================================================
+!> Different parameters
+!
+    type(Agrif_Variable),   dimension(:), pointer :: Agrif_tabvars => NULL()
+    type(Agrif_Variable_c), dimension(:), pointer :: Agrif_tabvars_c => NULL()
+    type(Agrif_Variable_r), dimension(:), pointer :: Agrif_tabvars_r => NULL()
+    type(Agrif_Variable_l), dimension(:), pointer :: Agrif_tabvars_l => NULL()
+    type(Agrif_Variable_i), dimension(:), pointer :: Agrif_tabvars_i => NULL()
+!
+    integer               :: Agrif_Probdim          !< Problem dimension
+    integer,dimension(0:4):: Agrif_NbVariables      !< Number of variables
+    integer               :: Agrif_nbfixedgrids     !< Number of fixed grids in the grid hierarchy
+    integer, dimension(3) :: Agrif_coeffref         !< Space refinement factor
+    integer, dimension(3) :: Agrif_coeffreft        !< Time refinement factor
+    logical               :: Agrif_UseSpecialValue          !< T if use special values on the parent grid
+    logical               :: Agrif_UseSpecialValueInUpdate  !< T if use special values on the parent grid
+    logical               :: Agrif_Update_Weights = .FALSE.
+    logical               :: Agrif_UseSpecialValueFineGrid  !< T if use special values on the current grid
+    real                  :: Agrif_SpecialValue             !< Special value on the parent grid
+    real                  :: Agrif_SpecialValueFineGrid     !< Special value on the current grid
+!>
+!> \name Clustering parameters
+!> @{
+    integer               :: Agrif_Regridding = 10
+    integer               :: Agrif_Minwidth
+    real                  :: Agrif_Efficiency = 0.7
+    integer               :: MaxSearch = 5
+    real, dimension(3)    :: Agrif_mind
+!> @}
+!> \name parameters for the interpolation of the child grids
+!> @{
+    integer, parameter    :: Agrif_linear = 1           !< linear interpolation
+    integer, parameter    :: Agrif_lagrange = 2         !< lagrange interpolation
+    integer, parameter    :: Agrif_eno = 3              !< spline interpolation
+    integer, parameter    :: Agrif_user_interp = 4      !< user defined interpolation
+    integer, parameter    :: Agrif_constant = 5         !< constant interpolation
+    integer, parameter    :: Agrif_linearconserv = 6    !< linear conservative interpolation
+    integer, parameter    :: Agrif_linearconservlim = 7 !< linear conservative interpolation
+    integer, parameter    :: Agrif_ppm = 8              !< PPM interpolation
+    integer, parameter    :: Agrif_weno = 9             !< WENO5 interpolation
+    integer, parameter    :: Agrif_ppm_lim = 10         !< PPM interpolation with monotonicity
+!> @}
+!> \name parameters for the update of the parent grids
+!> @{
+    integer, parameter    :: Agrif_Update_Copy = 1              !< copy
+    integer, parameter    :: Agrif_Update_Average = 2           !< average
+    integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting
+!> @}
+!> \name Raffinement grid switches
+!> @{
+    integer               :: Agrif_USE_ONLY_FIXED_GRIDS   !< = 1 if fixed grid mode
+    integer               :: Agrif_USE_FIXED_GRIDS        !< = 1 if AMR mode + fixed grid else only AMR mode
+!> @}
+    integer               :: Agrif_Maxlevelloc
+!
+#if defined AGRIF_MPI
+    integer :: Agrif_Nbprocs  !< Number of processors
+    integer :: Agrif_ProcRank !< Rank of the current processor
+    integer :: Agrif_Group    !< Group associated to Agrif_mpi_comm
+    integer :: Agrif_mpi_comm
+#else
+    integer :: Agrif_ProcRank = 0
+#endif
+!
+    integer :: Agrif_Extra_Boundary_Cells = 3       !< When computing integration sequences, the grid rects
+                                                    !! are expanded to this number of cells.
+    logical :: Agrif_Parallel_sisters = .FALSE.     !< When TRUE, try to compute sister grids (which have the same parent)
+                                                    !! in parallel rather than sequentially.
+    logical :: agrif_regrid_has_been_done = .FALSE. !< switch to skip Agrif_Regrid call
+!
+    real, dimension(:)          , allocatable :: parray1
+    real, dimension(:,:)        , allocatable :: parray2
+    real, dimension(:,:,:)      , allocatable :: parray3
+    real, dimension(:,:,:,:)    , allocatable :: parray4
+    real, dimension(:,:,:,:,:)  , allocatable :: parray5
+    real, dimension(:,:,:,:,:,:), allocatable :: parray6
+!
+    logical :: agrif_debug = .false.    ! may be activaded in users subroutine for debugging purposes
+
+! If a grand mother grid is present
+    logical :: agrif_coarse = .false.
+    integer, dimension(3) :: coarse_spaceref = (/1,1,1/)
+    integer, dimension(3) :: coarse_timeref  = (/1,1,1/)
+!
+contains
+!
+!===================================================================================================
+!  function Agrif_Ceiling
+!---------------------------------------------------------------------------------------------------
+integer function Agrif_Ceiling ( x )
+!---------------------------------------------------------------------------------------------------
+    real,   intent(in) :: x
+!
+    integer   :: i
+!
+    i = FLOOR(x)
+!
+    if( ABS(x - i) <= 0.0001 )then
+        Agrif_Ceiling = i
+    else
+        Agrif_Ceiling = i+1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Ceiling
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Int
+!---------------------------------------------------------------------------------------------------
+    integer function Agrif_Int(x)
+!---------------------------------------------------------------------------------------------------
+    real,   intent(in) :: x
+!
+    integer :: i
+!
+    i = FLOOR(x) + 1
+!
+    if( ABS(x - i) <= 0.0001 )then
+        Agrif_Int = i
+    else
+        Agrif_Int = i-1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Int
+!===================================================================================================
+!
+end module Agrif_Types
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90	(revision 8732)
@@ -0,0 +1,2130 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_Update
+!>
+!> This module  contains procedures to update a parent grid from its child grids.
+!
+module Agrif_Update
+!
+    use Agrif_UpdateBasic
+    use Agrif_Arrays
+    use Agrif_CurgridFunctions
+    use Agrif_Mask
+#if defined AGRIF_MPI
+    use Agrif_Mpp
+#endif
+!
+    implicit none
+!
+    logical, private :: precomputedone(7) = .FALSE.
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateVariable
+!
+!> subroutine to set arguments for Agrif_UpdatenD
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateVariable ( parent, child, updateinf, updatesup, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),  pointer      :: parent       !< Variable on the parent grid
+    type(Agrif_Variable),  pointer      :: child        !< Variable on the child grid
+    integer, dimension(6), intent(in)   :: updateinf    !< First positions where interpolations are calculated
+    integer, dimension(6), intent(in)   :: updatesup    !< Last  positions where interpolations are calculated
+    procedure()                         :: procname     !< Data recovery procedure
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6) :: nb_child           ! Number of cells on the child grid
+    integer, dimension(6) :: lb_child
+    integer, dimension(6) :: ub_child
+    integer, dimension(6) :: lb_parent
+    real   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0)
+    real   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0)
+    real   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1)
+    real   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1)
+    logical, dimension(6) :: do_update          ! Indicates if we perform update for each dimension
+    integer, dimension(6) :: posvar             ! Position of the variable on the cell (1 or 2)
+    integer, dimension(6) :: oldparentlbound, oldparentubound
+    integer               :: n, nbdim
+    logical               :: wholeupdate
+    type(Agrif_Variable), pointer :: root   ! Variable on the root grid
+!
+    root => child % root_var
+    nbdim = root % nbdim
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.false. )
+!
+    do_update(:) = .true.
+    posvar(1:nbdim) = root % posvar(1:nbdim)
+!
+    do n = 1,nbdim
+!
+        if ( root % interptab(n) == 'N' ) then
+            posvar(n) = 1
+            do_update(n) = .false.
+            oldparentlbound(n) = parent % lb(n)
+            oldparentubound(n) = parent % ub(n)
+            parent % lb(n) = child % lb(n)
+            parent % ub(n) = child % ub(n)
+        end if
+!
+    enddo
+
+    wholeupdate = .FALSE.
+!
+    do n = 1,nbdim
+        if ( do_update(n) ) then
+            if ( (updateinf(n) > updatesup(n)) .OR. &
+                ((updateinf(n) == -99) .AND. (updatesup(n) == -99)) &
+               ) then
+                wholeupdate = .TRUE.
+            endif
+        endif
+    enddo
+!
+    IF (wholeupdate) THEN
+        call Agrif_UpdateWhole(parent, child,               &
+                updateinf(1:nbdim), updatesup(1:nbdim),     &
+                lb_child(1:nbdim), lb_parent(1:nbdim),      &
+                nb_child(1:nbdim), posvar(1:nbdim),         &
+                do_update(1:nbdim),                         &
+                s_child(1:nbdim),   s_parent(1:nbdim),      &
+                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
+    ELSE
+        call Agrif_UpdateBcnD(parent, child,                &
+                updateinf(1:nbdim), updatesup(1:nbdim),     &
+                lb_child(1:nbdim), lb_parent(1:nbdim),      &
+                nb_child(1:nbdim), posvar(1:nbdim),         &
+                do_update(1:nbdim),                         &
+                s_child(1:nbdim),   s_parent(1:nbdim),      &
+                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
+    ENDIF
+!
+    do n = 1,nbdim
+!
+        if ( root % interptab(n) == 'N' ) then  ! No space DIMENSION
+            parent % lb(n) = oldparentlbound(n)
+            parent % ub(n) = oldparentubound(n)
+        end if
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateWhole
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateWhole ( parent, child, uinf, usup,       &
+                               lb_child, lb_parent,             &
+                               nb_child, posvar,                &
+                               do_update,                       &
+                               s_child,   s_parent,             &
+                               ds_child, ds_parent, nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    type(Agrif_Variable),      pointer    :: parent         !< Variable on the parent grid
+    type(Agrif_Variable),      pointer    :: child          !< Variable on the child grid
+    integer, dimension(nbdim), intent(in) :: uinf           !< First positions where interpolations are calculated
+    integer, dimension(nbdim), intent(in) :: usup           !< Last  positions where interpolations are calculated
+    integer,                   intent(in) :: nbdim          !< Number of dimensions of the grid variable
+    integer, dimension(nbdim), intent(in) :: lb_child       !< Index of the first point inside the domain for the parent grid variable
+    integer, dimension(nbdim), intent(in) :: lb_parent      !< Index of the first point inside the domain for the child grid variable
+    integer, dimension(nbdim), intent(in) :: nb_child       !< Number of cells of the child grid
+    integer, dimension(nbdim), intent(in) :: posvar         !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim), intent(in) :: do_update      !< Indicates if we update for each dimension
+    real,    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid
+    real,    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid
+    procedure()                           :: procname       !< Data recovery procedure
+!
+    integer, dimension(nbdim)     :: type_update ! Type of update (copy or average)
+    integer, dimension(nbdim,2)   :: lubglob
+    integer, dimension(nbdim,2,2) :: indtab      ! limits of the child grid that will be used in the update scheme
+    integer, dimension(nbdim,2,2) :: indtruetab  ! grid variable where boundary conditions are
+    integer :: coeffraf, i
+    integer :: uinfloc, usuploc
+!
+    type_update = child % root_var % type_update(1:nbdim)
+!
+    do i = 1, nbdim
+!
+        if ( do_update(i) ) then
+!
+            coeffraf = nint(ds_parent(i)/ds_child(i))
+            uinfloc = 0
+            usuploc = nb_child(i)/coeffraf - 1
+
+            IF (posvar(i) == 1) THEN
+                usuploc = usuploc - 1
+            ENDIF
+
+            IF (uinf(i) > usup(i)) THEN
+                uinfloc = uinf(i)
+                usuploc = usuploc - uinf(i)
+            ENDIF
+
+            indtab(i,1,1) = lb_child(i) + (uinfloc + 1) * coeffraf
+            indtab(i,1,2) = lb_child(i) + (usuploc + 1) * coeffraf
+
+            IF ( posvar(i) == 1 ) THEN
+                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
+                    indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)
+                ELSE IF ( type_update(i) /= Agrif_Update_Copy ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+                ENDIF
+            ELSE
+                indtab(i,1,1) = indtab(i,1,1) - coeffraf
+                indtab(i,1,2) = indtab(i,1,2) - 1
+    ! at this point, indices are OK for an average
+                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+                ENDIF
+            ENDIF
+!
+        else    ! IF ( .not.do_update(i) ) THEN
+!
+            if ( posvar(i) == 1 ) then
+                indtab(i,1,1) = lb_child(i)
+                indtab(i,1,2) = lb_child(i) + nb_child(i)
+            else
+                indtab(i,1,1) = lb_child(i)
+                indtab(i,1,2) = lb_child(i) + nb_child(i) - 1
+            endif
+!
+        endif
+    enddo
+
+! lubglob contains the global lbound and ubound of the child array
+! lubglob(:,1) : global lbound for each dimension
+! lubglob(:,2) : global lbound for each dimension
+!
+    call Agrif_get_var_global_bounds(child, lubglob, nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2), lubglob(1:nbdim,2))
+!
+    call Agrif_UpdatenD(type_update, parent, child,                         &
+                        indtruetab(1:nbdim,1,1), indtruetab(1:nbdim,1,2),   &
+                        lb_child(1:nbdim), lb_parent(1:nbdim),              &
+                        s_child(1:nbdim), s_parent(1:nbdim),                &
+                        ds_child(1:nbdim), ds_parent(1:nbdim),              &
+#if defined AGRIF_MPI
+                        posvar, do_update,                                  &
+#endif
+                        nbdim, procname)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateWhole
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateBcnd
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateBcnd ( parent, child, uinf, usup,        &
+                              lb_child, lb_parent,              &
+                              nb_child, posvar,                 &
+                              do_update,                        &
+                              s_child,  s_parent,               &
+                              ds_child, ds_parent, nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    type(Agrif_Variable), pointer           :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer           :: child        !< Variable on the child grid
+    integer, dimension(nbdim), intent(in)   :: uinf         !< First positions where interpolations are calculated
+    integer, dimension(nbdim), intent(in)   :: usup         !< Last  positions where interpolations are calculated
+    integer                                 :: nbdim        !< Number of dimensions of the grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_child     !< Index of the first point inside the domain for
+                                                            !!   the parent grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_parent    !< Index of the first point inside the domain for
+                                                            !!   the child grid variable
+    integer, dimension(nbdim), intent(in)   :: nb_child     !< Number of cells of the child grid
+    integer, dimension(nbdim), intent(in)   :: posvar       !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim), intent(in)   :: do_update    !< Indicates if we update for each dimension
+    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    procedure()                             :: procname     !< Data recovery procedure
+!
+    integer,dimension(nbdim)     :: type_update ! Type of update (copy or average)
+    integer,dimension(nbdim,2)   :: lubglob
+    integer                      :: i
+    integer,dimension(nbdim,2,2) :: indtab         ! Arrays indicating the limits of the child
+    integer,dimension(nbdim,2,2) :: indtruetab     ! grid variable where boundary conditions are
+    integer,dimension(nbdim,2,2,nbdim)   :: ptres  ! calculated
+    integer                      :: nb, ndir
+    integer :: coeffraf
+!
+    type_update = child % root_var % type_update(1:nbdim)
+!
+    DO i = 1, nbdim
+        coeffraf = nint(ds_parent(i)/ds_child(i))
+        indtab(i,1,1) = lb_child(i) + (uinf(i) + 1) * coeffraf
+        indtab(i,1,2) = lb_child(i) + (usup(i) + 1) * coeffraf
+
+        indtab(i,2,1) = lb_child(i) + nb_child(i) - (usup(i)+1) *  coeffraf
+        indtab(i,2,2) = lb_child(i) + nb_child(i) - (uinf(i)+1) *  coeffraf
+
+        IF (posvar(i) == 1) THEN
+            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
+                indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)
+            ELSE IF (type_update(i) /= Agrif_Update_Copy) THEN
+                indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
+                indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
+            ENDIF
+        ELSE
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf
+            indtab(i,1,2) = indtab(i,1,2) - 1
+            indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
+            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+                indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+                indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
+                indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
+            ENDIF
+        ENDIF
+    ENDDO
+!
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),lubglob(1:nbdim,2))
+    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),lubglob(1:nbdim,2))
+!
+    do nb = 1,nbdim
+        if ( do_update(nb) ) then
+            do ndir = 1,2
+                ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1)
+                ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2)
+                do i = 1,nbdim
+                    if ( i /= nb ) then
+                        if ( do_update(i) ) then
+                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+                        else
+                            if (posvar(i) == 1) then
+                                ptres(i,1,ndir,nb) = lb_child(i)
+                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i)
+                            else
+                                ptres(i,1,ndir,nb) = lb_child(i)
+                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i) - 1
+                            endif
+                        endif
+                    endif
+                enddo
+            enddo
+        endif
+    enddo
+!
+    do nb = 1,nbdim
+        if ( do_update(nb) ) then
+            do ndir = 1,2
+                call Agrif_UpdatenD(type_update, parent, child,             &
+                        ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),  &
+                        lb_child(1:nbdim),lb_parent(1:nbdim),               &
+                        s_child(1:nbdim),s_parent(1:nbdim),                 &
+                        ds_child(1:nbdim),ds_parent(1:nbdim),               &
+#if defined AGRIF_MPI
+                        posvar,do_update,                                   &
+#endif
+                        nbdim,procname,nb,ndir)
+            enddo
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateBcnd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdatenD
+!
+!> updates a 2D grid variable on the parent grid of the current grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdatenD ( type_update, parent, child,     &
+                            pttab, petab,                   &
+                            lb_child, lb_parent,            &
+                            s_child,  s_parent,             &
+                            ds_child, ds_parent,            &
+#if defined AGRIF_MPI
+                            posvar, do_update,              &
+#endif
+                            nbdim, procname, nb, ndir )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    integer, dimension(6),     intent(in)   :: type_update  !< Type of update (copy or average)
+    type(Agrif_Variable), pointer           :: parent       !< Variable of the parent grid
+    type(Agrif_Variable), pointer           :: child        !< Variable of the child grid
+    integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(in)   :: pttab        !< Index of the first point inside the domain
+    integer, dimension(nbdim), intent(in)   :: petab        !< Index of the first point inside the domain
+    integer, dimension(nbdim), intent(in)   :: lb_child  !< Index of the first point inside the domain for the child
+                                                            !!    grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_parent !< Index of the first point inside the domain for the parent
+                                                            !!    grid variable
+    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    procedure()                             :: procname     !< Data recovery procedure
+    integer, optional,         intent(in)   :: nb, ndir
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim)       :: pttruetab, cetruetab
+#if defined AGRIF_MPI
+    integer, dimension(nbdim)       :: posvar  !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim)       :: do_update
+#endif
+    integer, dimension(nbdim)       :: coords
+    integer, dimension(nbdim)       :: indmin, indmax
+    integer, dimension(nbdim)       :: indminglob, indmaxglob
+    real   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp
+    integer, dimension(nbdim)       :: lowerbound,upperbound
+    integer, dimension(nbdim)       :: pttruetabwhole, cetruetabwhole
+    integer, dimension(nbdim,2,2)   :: childarray
+    integer, dimension(nbdim,2,2)   :: parentarray
+    integer,dimension(nbdim)     :: type_update_temp
+    logical :: memberin, member
+    integer :: nbin, ndirin
+!
+#if defined AGRIF_MPI
+!
+    integer,dimension(nbdim)    :: indminglob2,indmaxglob2
+    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2
+    integer                               :: code, local_proc
+    integer                               :: i,j,k
+    integer, dimension(nbdim,4)           :: tab3
+    integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t
+    logical :: find_list_update
+    logical, dimension(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+    logical, dimension(1) :: memberin1
+!
+#endif
+!
+    type(Agrif_Variable), pointer, save :: tempC => NULL()       ! Temporary child grid variable
+    type(Agrif_Variable), pointer, save :: tempP => NULL()       ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child
+    type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent
+    type(Agrif_Variable), pointer :: tempP_indic, tempP_average
+    type(Agrif_Variable), pointer :: tempC_indic
+    logical :: compute_average
+    real :: coeff_multi
+    integer :: nb_dimensions
+!
+!   Get local lower and upper bound of the child variable
+    call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+
+! here pttab and petab corresponds to the (global) indices of the points needed in the update
+! pttruetab and cetruetab contains only indices that are present on the local processor
+!
+    coords = child % root_var % coords
+!
+    call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank,    &
+                            coords, pttruetab, cetruetab, memberin )
+    call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp,       &
+                         s_child, ds_child, s_parent, ds_parent,                            &
+                         pttab, petab, lb_child, lb_parent                                  &
+#if defined AGRIF_MPI
+                       , posvar, type_update, do_update, pttruetabwhole, cetruetabwhole     &
+#endif
+            )
+
+#if defined AGRIF_MPI
+!
+    IF (memberin) THEN
+        call Agrif_GlobalToLocalBounds(childarray,lowerbound,upperbound,    &
+                                       pttruetab,cetruetab, coords,         &
+                                       nbdim, Agrif_Procrank, member)
+    ENDIF
+
+    call Agrif_Prtbounds(nbdim, indmin, indmax,                     &
+                         s_Parent_temp, s_Child_temp,               &
+                         s_child, ds_child, s_parent, ds_parent,    &
+                         pttruetab, cetruetab, lb_child, lb_parent, &
+                         posvar, type_update, do_update,            &
+                         pttruetabwhole, cetruetabwhole)
+!
+#else
+    indmin = indminglob
+    indmax = indmaxglob
+    pttruetabwhole = pttruetab
+    cetruetabwhole = cetruetab
+    childarray(:,1,2) = pttruetab
+    childarray(:,2,2) = cetruetab
+#endif
+
+    IF (.not.present(nb)) THEN
+        nbin=0
+        ndirin=0
+    ELSE
+        nbin = nb
+        ndirin = ndir
+    ENDIF
+
+    IF (memberin) THEN
+!
+        IF ( .not.associated(tempC) )  allocate(tempC)
+!
+        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+        call Agrif_var_set_array_tozero(tempC,nbdim)
+
+        SELECT CASE (nbdim)
+        CASE(1)
+            CALL procname(tempC%array1,                 &
+                      childarray(1,1,2),childarray(1,2,2),.TRUE.,nbin,ndirin)
+        CASE(2)
+            CALL procname(tempC%array2,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),.TRUE.,nbin,ndirin)
+        CASE(3)
+            CALL procname(tempC%array3,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),.TRUE.,nbin,ndirin)
+        CASE(4)
+            CALL procname(tempC%array4,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),.TRUE.,nbin,ndirin)
+        CASE(5)
+            CALL procname(tempC%array5,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),  &
+                      childarray(5,1,2),childarray(5,2,2),.TRUE.,nbin,ndirin)
+        CASE(6)
+            CALL procname(tempC%array6,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),  &
+                      childarray(5,1,2),childarray(5,2,2),  &
+                      childarray(6,1,2),childarray(6,2,2),.TRUE.,nbin,ndirin)
+        END SELECT
+!
+    ENDIF
+!
+#if defined AGRIF_MPI
+!
+!     tab2 contains the necessary limits of the parent grid for each processor
+
+    if (Associated(child%list_update)) then
+        call Agrif_Find_list_update(child%list_update,pttab,petab,                      &
+                                    lb_child,lb_parent,nbdim,                         &
+                                    find_list_update,tab4t,tab5t,memberinall,memberinall2,  &
+                                    sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+    else
+        find_list_update = .FALSE.
+    endif
+
+    if (.not.find_list_update) then
+        tab3(:,1) = pttruetab(:)
+        tab3(:,2) = cetruetab(:)
+        tab3(:,3) = pttruetabwhole(:)
+        tab3(:,4) = cetruetabwhole(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        if ( .not.associated(tempCextend) ) allocate(tempCextend)
+        do k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = memberin
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+
+        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),tab4t(:,:,3),tab4t(:,:,4),   &
+                                     nbdim, memberinall, coords,                            &
+                                     sendtoproc1,recvfromproc1,                             &
+                                     tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+    endif
+
+    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
+            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
+            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,tempCextend)
+
+#else
+    tempCextend => tempC
+#endif
+!
+!     Update of the parent grid (tempP) from the child grid (tempC)
+!
+    IF (memberin) THEN
+!
+        IF ( .not.associated(tempP) ) allocate(tempP)
+!
+        call Agrif_array_allocate(tempP,indmin,indmax,nbdim)
+!
+        if ( nbdim == 1 ) then
+            tempP % array1 = 0.
+            call Agrif_Update_1D_Recursive( type_update(1),  &
+                                            tempP%array1,   &
+                                            tempCextend%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update(1:nbdim) == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array1),ubound(tempP%array1),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_1D_Recursive( type_update_temp(1),   &
+                                            tempP_average%array1,       &
+                                            tempCextend%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array1 = 0.
+            ELSEWHERE
+              tempC_indic%array1 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_1D_Recursive( type_update_temp(1),   &
+                                            tempP_indic%array1,       &
+                                            tempC_indic%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array1 == 0.)
+                  tempP%array1 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array1 == coeff_multi).AND.(tempP%array1 /= Agrif_SpecialValueFineGrid))
+                  tempP%array1 = tempP%array1 /tempP_indic%array1
+               ELSEWHERE
+                  tempP%array1 = tempP_average%array1 /tempP_indic%array1
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array1 == 0.)
+                  tempP%array1 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array1 = tempP%array1 /tempP_indic%array1
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array1)
+            deallocate(tempC_indic%array1)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array1)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 2 ) then
+            call Agrif_Update_2D_Recursive( type_update(1:2),   &
+                                            tempP%array2,       &
+                                            tempCextend%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim)
+ 
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array2),ubound(tempP%array2),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
+                                            tempP_average%array2,       &
+                                            tempCextend%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array2 = 0.
+            ELSEWHERE
+              tempC_indic%array2 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+            
+            call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
+                                            tempP_indic%array2,       &
+                                            tempC_indic%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array2 == 0.)
+                  tempP%array2 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array2 == coeff_multi).AND.(tempP%array2 /= Agrif_SpecialValueFineGrid))
+                  tempP%array2 = tempP%array2 /tempP_indic%array2
+               ELSEWHERE
+                  tempP%array2 = tempP_average%array2 /tempP_indic%array2
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array2 == 0.)
+                  tempP%array2 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array2 = tempP%array2 /tempP_indic%array2
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array2)
+            deallocate(tempC_indic%array2)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array2)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 3 ) then
+            call Agrif_Update_3D_Recursive( type_update(1:3),   &
+                                            tempP%array3,       &
+                                            tempCextend%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array3),ubound(tempP%array3),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
+                                            tempP_average%array3,       &
+                                            tempCextend%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array3 = 0.
+            ELSEWHERE
+              tempC_indic%array3 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
+                                            tempP_indic%array3,       &
+                                            tempC_indic%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array3 == 0.)
+                  tempP%array3 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array3 == coeff_multi).AND.(tempP%array3 /= Agrif_SpecialValueFineGrid))
+                  tempP%array3 = tempP%array3 /tempP_indic%array3
+               ELSEWHERE
+                  tempP%array3 = tempP_average%array3 /tempP_indic%array3
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array3 == 0.)
+                  tempP%array3 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array3 = tempP%array3 /tempP_indic%array3
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array3)
+            deallocate(tempC_indic%array3)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array3)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 4 ) then
+            call Agrif_Update_4D_Recursive( type_update(1:4),   &
+                                            tempP%array4,       &
+                                            tempCextend%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim)
+           
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array4),ubound(tempP%array4),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
+                                            tempP_average%array4,       &
+                                            tempCextend%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array4 = 0.
+            ELSEWHERE
+              tempC_indic%array4 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
+                                            tempP_indic%array4,       &
+                                            tempC_indic%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array4 == 0.)
+                  tempP%array4 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array4 == coeff_multi).AND.(tempP%array4 /= Agrif_SpecialValueFineGrid))
+                  tempP%array4 = tempP%array4 /tempP_indic%array4
+               ELSEWHERE
+                  tempP%array4 = tempP_average%array4 /tempP_indic%array4
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array4 == 0.)
+                  tempP%array4 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array4 = tempP%array4 /tempP_indic%array4
+               END WHERE
+            ENDIF
+            deallocate(tempP_indic%array4)
+            deallocate(tempC_indic%array4)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array4)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 5 ) then
+            call Agrif_Update_5D_Recursive( type_update(1:5),   &
+                                            tempP%array5,       &
+                                            tempCextend%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array5),ubound(tempP%array5),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
+                                            tempP_average%array5,       &
+                                            tempCextend%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array5 = 0.
+            ELSEWHERE
+              tempC_indic%array5 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
+                                            tempP_indic%array5,       &
+                                            tempC_indic%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array5 == 0.)
+                  tempP%array5 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array5 == coeff_multi).AND.(tempP%array5 /= Agrif_SpecialValueFineGrid))
+                  tempP%array5 = tempP%array5 /tempP_indic%array5
+               ELSEWHERE
+                  tempP%array5 = tempP_average%array5 /tempP_indic%array5
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array5 == 0.)
+                  tempP%array5 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array5 = tempP%array5 /tempP_indic%array5
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array5)
+            deallocate(tempC_indic%array5)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array5)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 6 ) then
+            call Agrif_Update_6D_Recursive( type_update(1:6),   &
+                                            tempP%array6,       &
+                                            tempCextend%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array6),ubound(tempP%array6),nbdim)
+              type_update_temp(1:nbdim) = type_update
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_average%array6,       &
+                                            tempCextend%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array6 == 0.)
+                  tempP%array6 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array6 == coeff_multi).AND.(tempP%array6 /= Agrif_SpecialValueFineGrid))
+                  tempP%array6 = tempP%array6 /tempP_indic%array6
+               ELSEWHERE
+                  tempP%array6 = tempP_average%array6 /tempP_indic%array6
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array6 == 0.)
+                  tempP%array6 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array6 = tempP%array6 /tempP_indic%array6
+               END WHERE
+            ENDIF
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_indic%array6,       &
+                                            tempC_indic%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
+            WHERE (tempP_indic%array6 == 0.)
+              tempP%array6 = Agrif_SpecialValueFineGrid
+            ELSEWHERE
+              tempP%array6 = tempP%array6 /tempP_indic%array6
+            END WHERE
+           
+            deallocate(tempP_indic%array6)
+            deallocate(tempC_indic%array6)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array6)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+        endif
+!
+        call Agrif_array_deallocate(tempCextend,nbdim)
+!
+    ENDIF
+
+#if defined AGRIF_MPI
+    local_proc = Agrif_Procrank
+    call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+    call Agrif_ChildGrid_to_ParentGrid()
+    call Agrif_Childbounds(nbdim, lowerbound, upperbound,                   &
+                           indminglob,  indmaxglob,  local_proc, coords,    &
+                           indminglob2, indmaxglob2, member)
+!
+    IF (member) THEN
+        call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, &
+                                       indminglob2, indmaxglob2, coords,    &
+                                       nbdim, local_proc, member)
+    ENDIF
+
+    call Agrif_ParentGrid_to_ChildGrid()
+
+    if (.not.find_list_update) then
+        tab3(:,1) = indmin(:)
+        tab3(:,2) = indmax(:)
+        tab3(:,3) = indminglob2(:)
+        tab3(:,4) = indmaxglob2(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        IF ( .not.associated(tempPextend) ) allocate(tempPextend)
+        DO k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab5t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = member
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+        call Get_External_Data_first(tab5t(:,:,1),tab5t(:,:,2),tab5t(:,:,3),tab5t(:,:,4),   &
+                                     nbdim, memberinall2, coords,                           &
+                                     sendtoproc2, recvfromproc2,                            &
+                                     tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+
+        call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent,      &
+                                     nbdim,tab4t,tab5t,memberinall,memberinall2,            &
+                                     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+
+    endif
+
+    call ExchangeSameLevel(sendtoproc2,recvfromproc2,nbdim,                     &
+                            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),&
+                            tab5t(:,:,7),tab5t(:,:,8),member,tempP,tempPextend)
+#else
+    tempPextend => tempP
+    parentarray(:,1,1) = indmin
+    parentarray(:,2,1) = indmax
+    parentarray(:,1,2) = indmin
+    parentarray(:,2,2) = indmax
+    member = .TRUE.
+#endif
+!
+!   Special values on the child grid
+    if ( Agrif_UseSpecialValueFineGrid ) then
+!
+!cc         noraftab(1:nbdim) =
+!cc     &    child % root_var % interptab(1:nbdim) == 'N'
+!
+#if defined AGRIF_MPI
+!
+!          allocate(childvalues% var)
+!
+!          Call Agrif_array_allocate(childvalues%var,
+!     &                      pttruetab,cetruetab,nbdim)
+!          Call Agrif_var_full_copy_array(childvalues% var,
+!     &                                tempC,
+!     &                                nbdim)
+!          Call Agrif_CheckMasknD(tempC,childvalues,
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           noraftab(1:nbdim),nbdim)
+!          Call Agrif_array_deallocate(childvalues% var,nbdim)
+!         Deallocate(childvalues % var)
+!
+#else
+!
+!          Call Agrif_get_var_bounds_array(child,
+!     &                              lowerbound,upperbound,nbdim)
+!          Call Agrif_CheckMasknD(tempC,child,
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           lowerbound,
+!     &                           upperbound,
+!     &                           noraftab(1:nbdim),nbdim)
+!
+#endif
+!
+    endif
+!
+!   Special values on the parent grid
+    if (Agrif_UseSpecialValue) then
+!
+#if defined AGRIF_MPI
+!
+!          Call GiveAgrif_SpecialValueToTab_mpi(parent,tempP,
+!     &                 parentarray,
+!     &                 Agrif_SpecialValue,nbdim)
+!
+!
+#else
+!
+!          Call GiveAgrif_SpecialValueToTab(parent,tempP,
+!     &                  indmin,indmax,
+!     &                  Agrif_SpecialValue,nbdim)
+!
+#endif
+!
+    endif
+!
+    IF (member) THEN
+
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        SELECT CASE(nbdim)
+        CASE(1)
+            call procname( tempPextend % array1(            &
+                    parentarray(1,1,1):parentarray(1,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin)
+        CASE(2)
+            call procname( tempPextend % array2(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin)
+        CASE(3)
+            call procname( tempPextend % array3(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin)
+        CASE(4)
+            call procname( tempPextend % array4(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin)
+        CASE(5)
+            call procname( tempPextend % array5(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1),  &
+                    parentarray(5,1,1):parentarray(5,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),  &
+                    parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin)
+        CASE(6)
+            call procname( tempPextend % array6(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1),  &
+                    parentarray(5,1,1):parentarray(5,2,1),  &
+                    parentarray(6,1,1):parentarray(6,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),  &
+                    parentarray(5,1,2),parentarray(5,2,2),  &
+                    parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin)
+        END SELECT
+!
+        call Agrif_ParentGrid_to_ChildGrid()
+!
+        call Agrif_array_deallocate(tempPextend,nbdim)
+!
+    ENDIF
+!
+#if defined AGRIF_MPI
+    IF (memberin) THEN
+        call Agrif_array_deallocate(tempP,nbdim)
+        call Agrif_array_deallocate(tempC,nbdim)
+    ENDIF
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdatenD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Prtbounds
+!
+!> calculates the bounds of the parent grid to be updated by the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Prtbounds ( nbdim, indmin, indmax, s_Parent_temp, s_Child_temp,        &
+                             s_child, ds_child, s_parent, ds_parent,                    &
+                             pttruetab, cetruetab, lb_child, lb_parent            &
+#if defined AGRIF_MPI
+                            ,posvar, type_update, do_update,                &
+                             pttruetabwhole, cetruetabwhole                             &
+#endif
+                )
+!---------------------------------------------------------------------------------------------------
+    integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(out)  :: indmin, indmax
+    real,    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp
+    real,    dimension(nbdim), intent(in)   :: s_child,  ds_child
+    real,    dimension(nbdim), intent(in)   :: s_parent, ds_parent
+    integer, dimension(nbdim), intent(in)   :: pttruetab, cetruetab
+    integer, dimension(nbdim), intent(in)   :: lb_child, lb_parent
+#if defined AGRIF_MPI
+    integer, dimension(nbdim), intent(in)   :: posvar   !< Position of the variable on the cell (1 or 2)
+    integer, dimension(nbdim), intent(in)   :: type_update
+    logical, dimension(nbdim), intent(in)   :: do_update
+    integer,dimension(nbdim), intent(out)   :: pttruetabwhole, cetruetabwhole
+#endif
+!
+    real,dimension(nbdim) :: dim_newmin,dim_newmax
+    integer :: i
+#if defined AGRIF_MPI
+    real    :: positionmin, positionmax
+    integer :: imin, imax
+    integer :: coeffraf
+#endif
+!
+    do i = 1,nbdim
+!
+        dim_newmin(i) = s_child(i) + (pttruetab(i) - lb_child(i)) * ds_child(i)
+        dim_newmax(i) = s_child(i) + (cetruetab(i) - lb_child(i)) * ds_child(i)
+!
+        indmin(i) = lb_parent(i) + agrif_ceiling((dim_newmin(i)-s_parent(i))/ds_parent(i))
+        indmax(i) = lb_parent(i) + agrif_int(    (dim_newmax(i)-s_parent(i))/ds_parent(i))
+!
+#if defined AGRIF_MPI
+        positionmin = s_parent(i) + (indmin(i)-lb_parent(i))*ds_parent(i)
+        IF ( do_update(i) ) THEN
+            IF (posvar(i) == 1) THEN
+                IF      (type_update(i) == Agrif_Update_Average) THEN
+                    positionmin = positionmin - ds_parent(i)/2.
+                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                    positionmin = positionmin - (ds_parent(i)-ds_child(i))
+                ENDIF
+            ELSE
+                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
+                    positionmin = positionmin - ds_parent(i)/2.
+                ELSE
+                    coeffraf = nint(ds_parent(i)/ds_child(i))
+                    if (mod(coeffraf,2) == 1) then
+                        positionmin = positionmin - (ds_parent(i)-ds_child(i))
+                    else
+                        positionmin = positionmin - (ds_parent(i)-ds_child(i))-ds_child(i)/2.
+                    endif
+                ENDIF
+            ENDIF
+        ENDIF
+!
+        imin = lb_child(i) + agrif_ceiling((positionmin-s_child(i))/ds_child(i))
+        positionmin = s_child(i)  + (imin - lb_child(i)) * ds_child(i)
+        positionmax = s_parent(i) + (indmax(i)-lb_parent(i))*ds_parent(i)
+        pttruetabwhole(i) = imin
+
+        IF ( do_update(i) ) THEN
+            IF (posvar(i) == 1) THEN
+                IF      (type_update(i) == Agrif_Update_Average) THEN
+                    positionmax = positionmax  + ds_parent(i)/2.
+                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                    positionmax = positionmax  + (ds_parent(i)-ds_child(i))
+                ENDIF
+            ELSE
+                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
+                    positionmax = positionmax  + ds_parent(i)/2.
+                ELSE
+                    coeffraf = nint(ds_parent(i)/ds_child(i))
+                    if (mod(coeffraf,2) == 1) then
+                        positionmax = positionmax + (ds_parent(i)-ds_child(i))
+                    else
+                        positionmax = positionmax + (ds_parent(i)-ds_child(i)) + ds_child(i)/2.
+                    endif
+                ENDIF
+            ENDIF
+        ENDIF
+
+        imax = lb_child(i) +agrif_int((positionmax-s_child(i))/ds_child(i))
+        positionmax = s_child(i) + (imax - lb_child(i)) * ds_child(i)
+        cetruetabwhole(i) = imax
+#endif
+!
+        s_Parent_temp(i) = s_parent(i) + (indmin(i) - lb_parent(i)) * ds_parent(i)
+        s_Child_temp(i)  = dim_newmin(i)
+
+#if defined AGRIF_MPI
+        s_Child_temp(i) = positionmin
+#endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Prtbounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_1D_Recursive
+!
+!> Updates a 1D grid variable on the parent grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_1D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                       s_child,  s_parent,  &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer,                            intent(in)  :: type_update            !< Type of update (copy or average)
+    integer,                            intent(in)  :: indmin, indmax
+    integer,                            intent(in)  :: lb_child, ub_child
+    real,                               intent(in)  ::  s_child,  s_parent
+    real,                               intent(in)  :: ds_child, ds_parent
+    real, dimension(indmin:indmax),     intent(out) :: tempP
+    real, dimension(lb_child:ub_child), intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    call Agrif_UpdateBase(type_update,              &
+                          tempP(indmin:indmax),     &
+                          tempC(lb_child:ub_child), &
+                          indmin, indmax,           &
+                          lb_child, ub_child,       &
+                          s_parent, s_child,        &
+                          ds_parent, ds_child)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_1D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_2D_Recursive
+!
+!> updates a 2D grid variable on the parent grid.
+!! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_2D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(2),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(2),          intent(in)  :: indmin, indmax
+    integer, dimension(2),          intent(in)  :: lb_child, ub_child
+    real,    dimension(2),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(2),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2)),       intent(out) :: tempP
+    real,    dimension(:,:),        intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
+    real, dimension(indmin(2):indmax(2), indmin(1):indmax(1))     :: tempP_trsp
+    real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp
+    integer :: i, j
+    integer :: coeffraf
+!
+    tabtemp = 0.
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    IF((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(1) ) then
+            call Average1dPrecompute( ub_child(2)-lb_child(2)+1,    &
+                                      indmax(1)-indmin(1)+1,              &
+                                      ub_child(1)-lb_child(1)+1,    &
+                                      s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!            precomputedone(1) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!
+    ELSE IF ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         if ( .NOT. precomputedone(1) ) then
+            call Agrif_basicupdate_copy1d_before( ub_child(2)-lb_child(2)+1, &
+                                   indmax(1)-indmin(1)+1,           &
+                                   ub_child(1)-lb_child(1)+1, &
+                                   s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!            precomputedone(1) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1)
+!
+    ELSE
+        do j = lb_child(2),ub_child(2)
+!
+!---CDIR NEXPAND
+            call Agrif_Update_1D_Recursive( type_update(1),             &
+                                            tabtemp(:,j),               &
+                                            tempC(:,j-lb_child(2)+1),   &
+                                            indmin(1), indmax(1),       &
+                                            lb_child(1),ub_child(1),    &
+                                            s_child(1),  s_parent(1),   &
+                                            ds_child(1),ds_parent(1))
+        enddo
+    ENDIF
+!
+    tabtemp_trsp = TRANSPOSE(tabtemp)
+    coeffraf = nint(ds_parent(2)/ds_child(2))
+!
+    tempP_trsp = 0.
+!
+    IF((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(2) ) then
+            call Average1dPrecompute( indmax(1)-indmin(1)+1,          &
+                                      indmax(2)-indmin(2)+1,          &
+                                      ub_child(2)-lb_child(2)+1,&
+                                      s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!            precomputedone(2) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Average1dAfterCompute( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),&
+                s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!
+    ELSE IF ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(2) ) then
+            call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,             &
+                                   indmax(2)-indmin(2)+1,             &
+                                   ub_child(2)-lb_child(2)+1,   &
+                                   s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!            precomputedone(2) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_after( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),2)
+!
+    ELSE
+        do i = indmin(1),indmax(1)
+!
+!---CDIR NEXPAND
+            call Agrif_UpdateBase(type_update(2),                                       &
+                                  tempP_trsp(indmin(2):indmax(2),i),            &
+                                  tabtemp_trsp(lb_child(2):ub_child(2),i),&
+                                  indmin(2),indmax(2),                          &
+                                  lb_child(2),ub_child(2),                &
+                                  s_parent(2),s_child(2),                       &
+                                  ds_parent(2),ds_child(2))
+!
+        enddo
+    ENDIF
+!
+    tempP = TRANSPOSE(tempP_trsp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_2D_Recursive
+!===================================================================================================
+!
+subroutine Agrif_Update_2D_Recursive_ok ( type_update, &
+                                        tempP, tempC, &
+                                        indmin, indmax,   &
+                                       lb_child, ub_child,                    &
+                                       s_child, s_parent, ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, DIMENSION(2), intent(in)   :: type_update            !< Type of update (copy or average)
+    INTEGER, DIMENSION(2), intent(in)   :: indmin, indmax
+    INTEGER, DIMENSION(2), intent(in)   :: lb_child, ub_child
+    REAL,    DIMENSION(2), intent(in)   :: s_child,  s_parent
+    REAL,    DIMENSION(2), intent(in)   :: ds_child, ds_parent
+    REAL,    DIMENSION(                 &
+                indmin(1):indmax(1),    &
+                indmin(2):indmax(2)),           intent(out) :: tempP
+    REAL, DIMENSION(                            &
+                lb_child(1):ub_child(1),  &
+                lb_child(2):ub_child(2)), intent(in)  :: tempC
+!
+    REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
+    INTEGER :: i
+!
+    do i = lb_child(2),ub_child(2)
+        call Agrif_Update_1D_Recursive(type_update(1),                              &
+                                       tabtemp(:, i),          &
+                                       tempC(:,i),  &
+                                       indmin(1),indmax(1),                 &
+                                       lb_child(1),ub_child(1),       &
+                                       s_child(1), s_parent(1),             &
+                                      ds_child(1),ds_parent(1))
+    enddo
+!
+    tempP = 0.
+!
+    do i = indmin(1),indmax(1)
+        call Agrif_UpdateBase(type_update(2),                                       &
+                              tempP(i,:),             &
+                              tabtemp(i,:), &
+                              indmin(2),indmax(2),                          &
+                              lb_child(2),ub_child(2),                &
+                              s_parent(2),s_child(2),                       &
+                             ds_parent(2),ds_child(2))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_2D_Recursive_ok
+!===================================================================================================
+
+!
+!===================================================================================================
+!  subroutine Agrif_Update_3D_Recursive
+!
+!> Updates a 3D grid variable on the parent grid.
+!! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_3D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(3),          intent(in)  :: indmin, indmax
+    integer, dimension(3),          intent(in)  :: lb_child, ub_child
+    real,    dimension(3),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(3),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(            &
+        indmin(1):indmax(1),    &
+        indmin(2):indmax(2),    &
+        lb_child(3):ub_child(3))    :: tabtemp
+    integer :: i,j,k
+    integer :: coeffraf,locind_child_left
+    integer :: kuinf
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    if ((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Average1dPrecompute(ub_child(2)-lb_child(2)+1,&
+                                 indmax(1)-indmin(1)+1,&
+                                 ub_child(1)-lb_child(1)+1,&
+                                 s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    else if ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+         call Agrif_basicupdate_copy1d_before(ub_child(2)-lb_child(2)+1, &
+                               indmax(1)-indmin(1)+1,           &
+                               ub_child(1)-lb_child(1)+1, &
+                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    endif
+!
+    coeffraf = nint ( ds_parent(2) / ds_child(2) )
+!
+    if ((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Average1dPrecompute(indmax(1)-indmin(1)+1,&
+                                 indmax(2)-indmin(2)+1,&
+                                 ub_child(2)-lb_child(2)+1,&
+                                 s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    else if ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,           &
+                               indmax(2)-indmin(2)+1,           &
+                               ub_child(2)-lb_child(2)+1, &
+                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    endif
+!
+    do k = lb_child(3),ub_child(3)
+        call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), &
+                                        indmin(1:2),indmax(1:2),                &
+                                        lb_child(1:2),ub_child(1:2),      &
+                                        s_child(1:2),s_parent(1:2),             &
+                                        ds_child(1:2),ds_parent(1:2) )
+    enddo
+!
+    precomputedone(1) = .FALSE.
+    precomputedone(2) = .FALSE.
+!
+    coeffraf = nint ( ds_parent(3) / ds_child(3) )
+    locind_child_left = 1 + agrif_int((s_parent(3)-s_child(3))/ds_child(3))
+!
+    if (coeffraf == 1) then
+        kuinf = lb_child(3)+locind_child_left-2
+        do k=indmin(3),indmax(3)
+            kuinf = kuinf + 1
+            do j = indmin(2),indmax(2)
+            do i = indmin(1),indmax(1)
+                tempP(i,j,k) = tabtemp(i,j,kuinf)
+            enddo
+            enddo
+        enddo
+    else
+        tempP = 0.
+        do j = indmin(2),indmax(2)
+        do i = indmin(1),indmax(1)
+            call Agrif_UpdateBase(type_update(3),tempP(i,j,:),tabtemp(i,j,:),   &
+                                  indmin(3),indmax(3),                  &
+                                  lb_child(3),ub_child(3),        &
+                                  s_parent(3),s_child(3),               &
+                                  ds_parent(3),ds_child(3))
+!
+        enddo
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_3D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_4D_Recursive
+!
+!> Updates a 4D grid variable on the parent grid.
+!! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_4D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(4),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(4),          intent(in)  :: indmin, indmax
+    integer, dimension(4),          intent(in)  :: lb_child, ub_child
+    real,    dimension(4),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(4),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:), allocatable       :: tabtemp
+    integer :: i,j,k,l
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     lb_child(4):ub_child(4)))
+!
+    do l = lb_child(4), ub_child(4)
+        call Agrif_Update_3D_Recursive(type_update(1:3),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3), l),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3), l),   &
+                                       indmin(1:3), indmax(1:3),            &
+                                       lb_child(1:3), ub_child(1:3),        &
+                                        s_child(1:3),  s_parent(1:3),       &
+                                       ds_child(1:3), ds_parent(1:3))
+    enddo
+!
+    tempP = 0.
+!
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase(type_update(4),                               &
+                              tempP(i,j,k,indmin(4):indmax(4)),             &
+                              tabtemp(i,j,k,lb_child(4):ub_child(4)),       &
+                              indmin(4), indmax(4),                         &
+                              lb_child(4), ub_child(4),                     &
+                               s_parent(4), s_child(4),                     &
+                              ds_parent(4),ds_child(4) )
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_4D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_5D_Recursive
+!
+!> Updates a 5D grid variable on the parent grid.
+!! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_5D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(5),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(5),          intent(in)  :: indmin, indmax
+    integer, dimension(5),          intent(in)  :: lb_child, ub_child
+    real,    dimension(5),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(5),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4),     &
+        indmin(5):indmax(5)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4), &
+        lb_child(5):ub_child(5)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:,:), allocatable     :: tabtemp
+    integer :: i,j,k,l,m
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     indmin(4):indmax(4), &
+                     lb_child(5):ub_child(5)))
+!
+    do m = lb_child(5), ub_child(5)
+        call Agrif_Update_4D_Recursive(type_update(1:4),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3),         &
+                                               indmin(4):indmax(4), m),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4), m),   &
+                                       indmin(1:4),indmax(1:4),             &
+                                       lb_child(1:4), ub_child(1:4),        &
+                                        s_child(1:4), s_parent(1:4),        &
+                                       ds_child(1:4), ds_parent(1:4))
+    enddo
+!
+    tempP = 0.
+!
+    do l = indmin(4), indmax(4)
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase( type_update(5),                              &
+                               tempP(i,j,k,l,indmin(5):indmax(5)),          &
+                               tabtemp(i,j,k,l,lb_child(5):ub_child(5)),    &
+                               indmin(5), indmax(5),                        &
+                               lb_child(5), ub_child(5),                    &
+                                s_parent(5), s_child(5),                    &
+                               ds_parent(5),ds_child(5) )
+    enddo
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_5D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_6D_Recursive
+!
+!> Updates a 6D grid variable on the parent grid.
+!! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_6D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(6),          intent(in)  :: indmin, indmax
+    integer, dimension(6),          intent(in)  :: lb_child, ub_child
+    real,    dimension(6),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(6),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4),     &
+        indmin(5):indmax(5),     &
+        indmin(6):indmax(6)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4), &
+        lb_child(5):ub_child(5), &
+        lb_child(6):ub_child(6)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:,:,:), allocatable   :: tabtemp
+    integer :: i,j,k,l,m,n
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     indmin(4):indmax(4), &
+                     indmin(5):indmax(5), &
+                     lb_child(6):ub_child(6)))
+!
+    do n = lb_child(6),ub_child(6)
+        call Agrif_Update_5D_Recursive(type_update(1:5),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3),         &
+                                               indmin(4):indmax(4),         &
+                                               indmin(5):indmax(5), n),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4),       &
+                                             lb_child(5):ub_child(5), n),   &
+                                       indmin(1:5), indmax(1:5),            &
+                                       lb_child(1:5),ub_child(1:5),         &
+                                       s_child(1:5), s_parent(1:5),         &
+                                      ds_child(1:5),ds_parent(1:5))
+    enddo
+!
+    tempP = 0.
+!
+    do m = indmin(5), indmax(5)
+    do l = indmin(4), indmax(4)
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase( type_update(6),                              &
+                               tempP(i,j,k,l,m,indmin(6):indmax(6)),        &
+                               tabtemp(i,j,k,l,m,lb_child(6):ub_child(6)),  &
+                               indmin(6), indmax(6),                        &
+                               lb_child(6),  ub_child(6),                   &
+                                s_parent(6),  s_child(6),                   &
+                               ds_parent(6), ds_child(6) )
+    enddo
+    enddo
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_6D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateBase
+!
+!> Calls the updating method chosen by the user (copy, average or full-weighting).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateBase ( type_update,              &
+                              parent_tab, child_tab,    &
+                              indmin, indmax,           &
+                              lb_child, ub_child,       &
+                              s_parent, s_child,        &
+                              ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,                            intent(in) :: type_update
+    integer,                            intent(in) :: indmin, indmax
+    integer,                            intent(in) :: lb_child, ub_child
+    real, dimension(indmin:indmax),     intent(out):: parent_tab
+    real, dimension(lb_child:ub_child), intent(in) :: child_tab
+    real,                               intent(in) :: s_parent,  s_child
+    real,                               intent(in) :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    integer :: np       ! Length of parent array
+    integer :: nc       ! Length of child  array
+!
+    np = indmax - indmin + 1
+    nc = ub_child - lb_child + 1
+!
+    if     ( type_update == Agrif_Update_Copy ) then
+!
+        call Agrif_basicupdate_copy1d(              &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                    s_parent,  s_child,             &
+                    ds_parent, ds_child )
+!
+    elseif ( type_update == Agrif_Update_Average ) then
+!
+        call Agrif_basicupdate_average1d(           &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                     s_parent,  s_child,            &
+                    ds_parent, ds_child )
+!
+    elseif ( type_update == Agrif_Update_Full_Weighting ) then
+!
+        call Agrif_basicupdate_full_weighting1D(    &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                    s_parent,  s_child,             &
+                    ds_parent, ds_child )
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateBase
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_Find_list_update
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Find_list_update ( list_update, pttab, petab, lb_child, lb_parent, nbdim, &
+                                    find_list_update, tab4t, tab5t, memberinall, memberinall2,   &
+                                    sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_List_Interp_Loc),                   pointer     :: list_update
+    INTEGER,                                       intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim),                     intent(in)  :: pttab, petab
+    INTEGER, DIMENSION(nbdim),                     intent(in)  :: lb_child, lb_parent
+    LOGICAL,                                       intent(out) :: find_list_update
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab5t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: memberinall,memberinall2
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc1,recvfromproc1
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc2,recvfromproc2
+!
+    Type(Agrif_List_Interp_Loc), Pointer :: parcours
+    INTEGER :: i
+!
+    find_list_update = .FALSE.
+!
+    parcours => list_update
+
+    Find_loop :  do while ( associated(parcours) )
+        do i = 1,nbdim
+            IF ((pttab(i) /= parcours%interp_loc%pttab(i)) .OR. &
+                (petab(i) /= parcours%interp_loc%petab(i)) .OR. &
+                (lb_child(i)  /= parcours%interp_loc%pttab_child(i)) .OR. &
+                (lb_parent(i) /= parcours%interp_loc%pttab_parent(i))) THEN
+                parcours => parcours%suiv
+                cycle Find_loop
+            ENDIF
+        enddo
+!
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall  =  parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        memberinall2 =  parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
+        sendtoproc1 =   parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
+        sendtoproc2 =   parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)
+        recvfromproc1 = parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
+        recvfromproc2 = parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)
+!
+        find_list_update = .TRUE.
+        exit Find_loop
+!
+    enddo Find_loop
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Find_list_update
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_AddTo_list_update
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_AddTo_list_update ( list_update, pttab, petab, lb_child, lb_parent,  &
+                                     nbdim, tab4t, tab5t, memberinall, memberinall2,        &
+                                     sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_List_Interp_Loc), pointer :: list_update
+    INTEGER,                                        intent(in) :: nbdim
+    INTEGER, DIMENSION(nbdim),                      intent(in) :: pttab, petab
+    INTEGER, DIMENSION(nbdim),                      intent(in) :: lb_child, lb_parent
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab4t
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab5t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: memberinall, memberinall2
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc1, recvfromproc1
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc2, recvfromproc2
+!
+    Type(Agrif_List_Interp_Loc), pointer :: parcours
+!
+    allocate(parcours)
+    allocate(parcours%interp_loc)
+
+    parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+    parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+    parcours%interp_loc%pttab_child(1:nbdim)  = lb_child(1:nbdim)
+    parcours%interp_loc%pttab_parent(1:nbdim) = lb_parent(1:nbdim)
+
+    allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+    allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
+
+    allocate(parcours%interp_loc%memberinall (0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
+
+    allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
+
+    parcours%interp_loc%tab4t = tab4t
+    parcours%interp_loc%tab5t = tab5t
+    parcours%interp_loc%memberinall   = memberinall
+    parcours%interp_loc%memberinall2  = memberinall2
+    parcours%interp_loc%sendtoproc1   = sendtoproc1
+    parcours%interp_loc%sendtoproc2   = sendtoproc2
+    parcours%interp_loc%recvfromproc1 = recvfromproc1
+    parcours%interp_loc%recvfromproc2 = recvfromproc2
+
+    parcours%suiv => list_update
+    list_update => parcours
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Addto_list_update
+!===================================================================================================
+#endif
+!
+end module Agrif_Update
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 8732)
@@ -0,0 +1,434 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!
+!> Module containing different procedures of update (copy, average, full_weighting)
+!! used in the #Agrif_Update module.
+!===================================================================================================
+!
+module Agrif_UpdateBasic
+!
+    use Agrif_Types
+
+    implicit none
+
+    integer, dimension(:,:), allocatable :: indchildcopy
+    integer, dimension(:,:), allocatable :: indchildaverage
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d
+!
+!> Carries out a copy on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
+    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+!---------------------------------------------------------------------------------------------------
+    integer :: i, locind_child_left, coeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+!
+    if ( coeffraf == 1 ) then
+!CDIR ALTCODE
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+!CDIR ALTCODE
+    do i = 1,np
+        x(i) = y(locind_child_left)
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d_before
+!
+!> Precomputes index for a copy on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d_before ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: nc2          !< Length of parent array
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+    integer,             intent(in)     :: dir          !< Direction
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(:,:), allocatable    :: indchildcopy_tmp
+    integer :: i, n_old, locind_child_left, coeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+    if ( .not.allocated(indchildcopy) ) then
+        allocate(indchildcopy(np*nc2, 3))
+    else
+        n_old = size(indchildcopy,1)
+        if ( n_old < np*nc2 ) then
+            allocate( indchildcopy_tmp(1:n_old, 3))
+            indchildcopy_tmp = indchildcopy
+            deallocate(indchildcopy)
+            allocate(indchildcopy(np*nc2, 3))
+            indchildcopy(1:n_old,:) = indchildcopy_tmp
+            deallocate(indchildcopy_tmp)
+        endif
+    endif
+!
+    do i = 1,np
+        indchildcopy(i,dir) = locind_child_left
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!
+    do i = 2,nc2
+        indchildcopy(1+(i-1)*np:i*np,dir) = indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d_before
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d_after
+!
+!> Carries out a copy on a parent grid (vector x) from its child grid (vector y)
+!! using precomputed index.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d_after ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
+    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    integer,             intent(in)     :: dir          !< Direction
+!---------------------------------------------------------------------------------------------------
+    integer :: i
+!
+!CDIR ALTCODE
+    do i = 1,np
+        x(i) = y(indchildcopy(i,dir))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d_after
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_average1d
+!
+!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_average1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(out)    :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np,nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+!
+    INTEGER :: i, ii, locind_child_left, coeffraf
+    REAL    :: xpos, invcoeffraf
+    INTEGER :: nbnonnuls
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    if (coeffraf == 1) then
+        locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = 0.
+!
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+        do i = 1,np
+            nbnonnuls = 0
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+!                    nbnonnuls = nbnonnuls + 1
+                    x(i) = x(i) + y(ii)
+                ENDIF
+            enddo
+!            IF (nbnonnuls /= 0) THEN
+!                x(i) = x(i)/nbnonnuls
+!            ELSE
+!                x(i) = Agrif_SpecialValueFineGrid
+!            ENDIF
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+    ELSE
+!
+!CDIR ALTCODE
+        do i = 1,np
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                x(i) = x(i) + y(ii)
+            enddo
+!            x(i) = x(i)*invcoeffraf
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+        IF (.not.Agrif_Update_Weights) THEN
+           x = x * invcoeffraf
+        ENDIF
+    ENDIF
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_average1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Average1dPrecompute
+!
+!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Average1dPrecompute ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: nc2, np, nc
+    REAL,    intent(in) :: s_parent,  s_child
+    REAL,    intent(in) :: ds_parent, ds_child
+    INTEGER, intent(in) :: dir
+!
+    INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp
+    INTEGER :: i, locind_child_left, coeffraf
+    REAL    :: xpos
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    xpos = s_parent
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    if (.not.allocated(indchildaverage)) then
+        allocate(indchildaverage(np*nc2,3))
+    else
+        if (size(indchildaverage,1)<np*nc2) then
+            allocate( indchildaverage_tmp(size(indchildaverage,1),size(indchildaverage,2)))
+            indchildaverage_tmp = indchildaverage
+            deallocate(indchildaverage)
+            allocate(indchildaverage(np*nc2,3))
+            indchildaverage(1:size(indchildaverage_tmp,1),1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
+            deallocate(indchildaverage_tmp)
+        endif
+    endif
+!
+    do i = 1,np
+        indchildaverage(i,dir)= -coeffraf/2+locind_child_left+diffmod
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!
+    do i = 2,nc2
+        indchildaverage(1+(i-1)*np:i*np,dir) = indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Average1dPrecompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Average1dAfterCompute
+!
+!> Carries out an update by average on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Average1dAfterCompute ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(inout)  :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np, nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+    INTEGER,             intent(in)     :: dir
+!
+    REAL    :: invcoeffraf
+    INTEGER :: i, j, coeffraf
+    INTEGER, DIMENSION(np) :: nbnonnuls
+    REAL, DIMENSION(0:7), parameter :: invcoeff = (/1.,1.,0.5,1./3.,0.25,0.2,1./6.,1./7./)
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+!
+!        nbnonnuls = 0
+        do  j = 1,coeffraf
+            do i = 1,np
+                IF (y(indchildaverage(i,dir) + j -1) /= Agrif_SpecialValueFineGrid) THEN
+!                    nbnonnuls(i) = nbnonnuls(i) + 1
+                    x(i) = x(i) +  y(indchildaverage(i,dir) + j-1 )
+                ENDIF
+            enddo
+        enddo
+        do i=1,np
+  !          x(i) = x(i)*invcoeff(nbnonnuls(i))
+  !          if (nbnonnuls(i) == 0) x(i) = Agrif_SpecialValueFineGrid
+        enddo
+!
+    ELSE
+!
+!CDIR NOLOOPCHG
+        do  j = 1,coeffraf
+!CDIR VECTOR
+            do i= 1,np
+                x(i) = x(i) + y(indchildaverage(i,dir) + j-1 )
+            enddo
+        enddo
+        IF (.not.Agrif_Update_Weights) THEN
+           x = x * invcoeffraf
+        ENDIF
+!
+    ENDIF
+
+!---------------------------------------------------------------------------------------------------
+end subroutine Average1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_full_weighting1D
+!
+!> Carries out an update by full_weighting on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_full_weighting1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x
+    real, dimension(nc), intent(in)     :: y
+    integer,             intent(in)     :: np, nc
+    real,                intent(in)     :: s_parent,  s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    REAL    :: xpos, xposfin
+    INTEGER :: i, ii, diffmod
+    INTEGER :: it1, it2
+    INTEGER :: i1,  i2
+    INTEGER :: coeffraf
+    INTEGER :: locind_child_left
+    REAL    :: sumweight, invsumweight
+    REAL    :: weights(-Agrif_MaxRaff:Agrif_MaxRaff)
+
+    coeffraf = nint(ds_parent/ds_child)
+    locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
+!
+    if (coeffraf == 1) then
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = 0.
+!
+    xposfin = s_child + ds_child * (locind_child_left - 1)
+    IF (abs(xposfin - xpos) < 0.001) THEN
+        diffmod = 0
+    ELSE
+        diffmod = 1
+    ENDIF
+!
+    if (diffmod == 1) THEN
+        invsumweight=1./(2.*coeffraf**2)
+        do i = -coeffraf,-1
+            weights(i) = invsumweight*(2*(coeffraf+i)+1)
+        enddo
+        do i = 0,coeffraf-1
+            weights(i) = weights(-(i+1))
+        enddo
+        it1 = -coeffraf
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 1
+        
+    else
+        invsumweight=1./coeffraf**2
+        do i = -(coeffraf-1),0
+            weights(i) = invsumweight*(coeffraf + i)
+        enddo
+        do i=1,coeffraf-1
+            weights(i) = invsumweight*(coeffraf - i)
+        enddo
+        it1 = -(coeffraf-1)
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 2
+
+    endif
+!
+    sumweight = 0.
+    MYLOOP : do i = 1,np
+!
+        it2 = it1
+
+!    sumweight = 0.
+    
+        do ii = i1,i1+i2
+!
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+                    x(i) = x(i) + weights(it2)*y(ii)
+!                    sumweight = sumweight+weights(it2)
+                ELSE
+                    x(i) = Agrif_SpecialValueFineGrid
+                    i1=i1+coeffraf
+                    CYCLE MYLOOP
+                ENDIF
+            ELSE
+                x(i) = x(i) + weights(it2)*y(ii)
+            ENDIF
+
+            it2 = it2+1
+!
+        enddo
+!
+        i1 = i1 + coeffraf
+!
+        enddo MYLOOP
+        
+        IF (Agrif_UseSpecialValueInUpdate) THEN
+          x = x * coeffraf ! x will be divided by coeffraf later in modupdate.F90
+        ENDIF
+        
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_full_weighting1D
+!===================================================================================================
+!
+end module Agrif_UpdateBasic
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90	(revision 8732)
@@ -0,0 +1,1108 @@
+!
+! $Id$
+!
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_Util
+!!
+!! This module contains the two procedures called in the main program :
+!! - #Agrif_Init_Grids allows the initialization of the root coarse grid
+!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration.
+!
+module Agrif_Util
+!
+    use Agrif_Clustering
+    use Agrif_BcFunction
+    use Agrif_seq
+!
+    implicit none
+!
+    abstract interface
+        subroutine step_proc()
+        end subroutine step_proc
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Step
+!
+!> Creates the grid hierarchy and manages the time integration procedure.
+!> It is called in the main program.
+!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+    type(agrif_grid), pointer :: ref_grid
+!
+! Set the clustering variables
+    call Agrif_clustering_def()
+!
+! Creation and initialization of the grid hierarchy
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+!
+        if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then
+            call Agrif_Regrid()
+            Agrif_regrid_has_been_done = .TRUE.
+        endif
+!
+    else
+!
+        if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then
+            call Agrif_Regrid()
+        endif
+!
+    endif
+!
+! Time integration of the grid hierarchy
+    if (agrif_coarse) then
+      ref_grid => agrif_coarsegrid
+    else
+      ref_grid => agrif_mygrid
+    endif
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Integrate_Parallel(ref_grid,procname)
+    else
+        call Agrif_Integrate(ref_grid,procname)
+    endif
+!
+    if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Child
+!
+!> Apply 'procname' to each grid of the hierarchy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_Child ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+!
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname)
+    else
+        call Agrif_Integrate_Child(Agrif_Mygrid,procname)
+    endif
+!
+    if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Regrid
+!
+!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Regrid ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(init_proc), optional    :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    type(Agrif_Rectangle), pointer     :: coarsegrid_fixed
+    type(Agrif_Rectangle), pointer     :: coarsegrid_moving
+    integer                            :: i, j
+    integer :: nunit
+    logical :: BEXIST
+    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
+    integer :: is_coarse, rhox, rhoy, rhoz, rhot
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
+        call Agrif_detect_all(Agrif_Mygrid)     ! Detection of areas to be refined
+!
+    allocate(coarsegrid_fixed)
+    allocate(coarsegrid_moving)
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
+        call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
+!
+    if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+!
+        if (Agrif_Mygrid % ngridstep == 0) then
+!            
+            nunit = Agrif_Get_Unit()
+            open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99)
+            if (agrif_coarse) then ! SKIP the coarse grid declaration
+                if (Agrif_Probdim == 3) then
+                    read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
+                elseif (Agrif_Probdim == 2) then
+                    read(nunit,*) is_coarse, rhox, rhoy, rhot
+                elseif (Agrif_Probdim == 2) then
+                    read(nunit,*) is_coarse, rhox, rhot
+                endif
+            endif
+!           Creation of the grid hierarchy from the Agrif_FixedGrids.in file
+            do i = 1,Agrif_Probdim
+                coarsegrid_fixed % imin(i) = 1
+                coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1
+            enddo
+            j = 1
+            call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit)
+            close(nunit)
+!
+            call Agrif_gl_clear(Agrif_oldmygrid)
+!
+!           Creation of the grid hierarchy from coarsegrid_fixed
+            call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed)
+            
+        else
+            call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
+        endif
+    else
+        call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
+        call Agrif_gl_clear(Agrif_Mygrid % child_list)
+    endif
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!
+        call Agrif_Save_All(Agrif_oldmygrid)
+        call Agrif_Free_before_All(Agrif_oldmygrid)
+!
+!       Creation of the grid hierarchy from coarsegrid_moving
+        call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving)
+!
+    endif
+!
+!   Initialization of the grid hierarchy by copy or interpolation
+!
+#if defined AGRIF_MPI
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid)
+        call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname)
+    else
+        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
+    endif
+#else
+        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
+#endif
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid)
+!
+    Agrif_regrid_has_been_done = .TRUE.
+!
+    call Agrif_Instance( Agrif_Mygrid )
+!
+    deallocate(coarsegrid_fixed)
+    deallocate(coarsegrid_moving)
+!
+    return
+!
+!     Opening error
+!
+99  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+    if (.not. BEXIST) then
+        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+        STOP
+    else
+        print*,'Error opening file AGRIF_FixedGrids.in'
+        STOP
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Regrid
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_detect_All
+!
+!> Detects areas to be refined.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_detect_all ( g )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid),  pointer  :: g        !< Pointer on the current grid
+!
+    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer, DIMENSION(3)       :: size
+    integer                     :: i
+    real                        :: g_eps
+!
+    parcours => g % child_list % first
+!
+!   To be positioned on the finer grids of the grid hierarchy
+!
+    do while (associated(parcours))
+        call Agrif_detect_all(parcours % gr)
+        parcours => parcours % next
+    enddo
+!
+    g_eps = huge(1.)
+    do i = 1,Agrif_Probdim
+        g_eps = min(g_eps, g % Agrif_dx(i))
+    enddo
+!
+    g_eps = g_eps / 100.
+!
+    if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0
+    if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0
+    if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0
+!
+    do i = 1,Agrif_Probdim
+        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return
+    enddo
+!
+    call Agrif_instance(g)
+!
+!   Detection (Agrif_detect is a users routine)
+!
+    do i = 1,Agrif_Probdim
+        size(i) = g % nb(i) + 1
+    enddo
+!
+    SELECT CASE (Agrif_Probdim)
+    CASE (1)
+        call Agrif_detect(g%tabpoint1D,size)
+    CASE (2)
+        call Agrif_detect(g%tabpoint2D,size)
+    CASE (3)
+        call Agrif_detect(g%tabpoint3D,size)
+    END SELECT
+!
+!   Addition of the areas detected on the child grids
+!
+    parcours => g % child_list % first
+!
+    do while (associated(parcours))
+        call Agrif_Add_detected_areas(g,parcours % gr)
+        parcours => parcours % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_detect_all
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Add_detected_areas
+!
+!> Adds on the parent grid the areas detected on its child grids
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Add_detected_areas ( parentgrid, childgrid )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid), pointer   :: parentgrid
+    Type(Agrif_Grid), pointer   :: childgrid
+!
+    integer :: i,j,k
+!
+    do i = 1,childgrid%nb(1)+1
+        if ( Agrif_Probdim == 1 ) then
+            if (childgrid%tabpoint1D(i)==1) then
+                parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1
+            endif
+        else
+            do j=1,childgrid%nb(2)+1
+                if (Agrif_Probdim==2) then
+                    if (childgrid%tabpoint2D(i,j)==1) then
+                        parentgrid%tabpoint2D(                       &
+                            childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
+                            childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
+                    endif
+                else
+                    do k=1,childgrid%nb(3)+1
+                        if (childgrid%tabpoint3D(i,j,k)==1) then
+                            parentgrid%tabpoint3D(                       &
+                                childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
+                                childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), &
+                                childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
+                        endif
+                    enddo
+                endif
+            enddo
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Add_detected_areas
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_before_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_before_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
+!
+    Type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
+!
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if (.not. parcours%gr%fixed) then
+            call Agrif_Free_data_before(parcours%gr)
+            parcours % gr % oldgrid = .TRUE.
+        endif
+!
+        call Agrif_Free_before_all (parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_before_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Save_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
+!
+    type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
+!
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if (.not. parcours%gr%fixed) then
+            call Agrif_Instance(parcours%gr)
+            call Agrif_Before_Regridding()
+            parcours % gr % oldgrid = .TRUE.
+        endif
+!
+        call Agrif_Save_All(parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+      enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_after_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_after_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid_List), intent(inout)    :: gridlist       !< Grid list to free
+!
+    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive proced
+    Type(Agrif_PGrid), pointer  :: preparcours
+    Type(Agrif_PGrid), pointer  :: preparcoursini
+!
+    allocate(preparcours)
+!
+    preparcoursini => preparcours
+!
+    nullify(preparcours % gr)
+!
+    preparcours % next => gridlist % first
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then
+            call Agrif_Free_data_after(parcours%gr)
+        endif
+!
+        call Agrif_Free_after_all( parcours%gr % child_list )
+!
+        if (parcours % gr % oldgrid) then
+            deallocate(parcours % gr)
+            preparcours % next => parcours % next
+            deallocate(parcours)
+            parcours => preparcours % next
+        else
+            preparcours => preparcours % next
+            parcours => parcours % next
+        endif
+!
+    enddo
+!
+    deallocate(preparcoursini)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_after_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k
+!
+!   Instanciation of the variables of the current grid
+!    if ( g % fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+!    endif
+!
+!   One step on the current grid
+!
+    call procname ()
+!
+!   Number of time steps on the current grid
+!
+    g%ngridstep = g % ngridstep + 1
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call Agrif_Integrate(parcours % gr, procname)
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Parallel
+!
+!> Manages the time integration of the grid hierarchy in parallel
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Parallel ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+#if defined AGRIF_MPI
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k, is
+!
+!   Instanciation of the variables of the current grid
+    if ( g % fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+    endif
+!
+! One step on the current grid
+    call procname ()
+!
+! Number of time steps on the current grid
+    g % ngridstep = g % ngridstep + 1
+!
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(g,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(gridp % gr)
+!
+!     Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, gridp % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call Agrif_Integrate_Parallel(gridp % gr, procname)
+        enddo
+!
+    enddo
+#else
+    call Agrif_Integrate( g, procname )
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Parallel
+!===================================================================================================
+!
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_ChildGrids
+!
+!> Manages the time integration of the grid hierarchy.
+!! Call the subroutine procname on each child grid of the current grid
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_ChildGrids ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k, is
+    type(Agrif_Grid)                    , pointer :: save_grid
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    
+    save_grid => Agrif_Curgrid
+
+! Number of time steps on the current grid
+    save_grid % ngridstep = save_grid % ngridstep + 1
+    
+#ifdef AGRIF_MPI
+    if ( .not. Agrif_Parallel_sisters ) then
+#endif
+    parcours => save_grid % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call procname()
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+
+#ifdef AGRIF_MPI
+    else
+#endif    
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(save_grid % child_seq) ) return
+!
+    do is = 1, save_grid % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(save_grid,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(gridp % gr)
+!
+!     Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, gridp % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call procname()
+        enddo
+!
+    enddo
+#ifdef AGRIF_MPI
+    endif
+#endif 
+
+    call Agrif_Instance(save_grid)
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_ChildGrids
+!===================================================================================================
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+!
+!   One step on the current grid
+!
+    call procname ()
+!
+!   Number of time steps on the current grid
+!
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+        call Agrif_Integrate_Child (parcours % gr, procname)
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child_Parallel
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+#if defined AGRIF_MPI
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    integer                     :: is
+!
+! Instanciation of the variables of the current grid
+    call Agrif_Instance(g)
+!
+! One step on the current grid
+    call procname ()
+!
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(g,is)
+        call Agrif_Integrate_Child_Parallel(gridp % gr, procname)
+!
+    enddo
+!
+    call Agrif_Instance(g)
+#else
+    call Agrif_Integrate_Child( g, procname )
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child_Parallel
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Grids
+!
+!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Init_Grids ( procname1, procname2 )
+!---------------------------------------------------------------------------------------------------
+    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
+    procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls)
+!
+    integer :: i, ierr_allocate, nunit
+    integer :: is_coarse, rhox,rhoy,rhoz,rhot
+    logical :: BEXIST
+!
+    if (present(procname1)) Then
+        call procname1()
+    else
+        call Agrif_probdim_modtype_def()
+    endif
+!
+
+! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in
+    nunit = Agrif_Get_Unit()
+    open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98)
+    if (Agrif_Probdim == 3) then
+       read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
+    elseif (Agrif_Probdim == 2) then
+       read(nunit,*) is_coarse, rhox, rhoy, rhot
+    elseif (Agrif_Probdim == 2) then
+       read(nunit,*) is_coarse, rhox, rhot
+    endif
+    if (is_coarse == -1) then
+       agrif_coarse = .TRUE.
+       if (Agrif_Probdim == 3) then
+          coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)
+       elseif (Agrif_Probdim == 2) then
+          coarse_spaceref(1:2)=(/rhox,rhoy/)
+       elseif (Agrif_Probdim == 2) then
+          coarse_spaceref(1:1)=(/rhox/)
+       endif
+       coarse_timeref(1:Agrif_Probdim) = rhot
+    endif
+    close(nunit)
+    
+    Agrif_UseSpecialValue = .FALSE.
+    Agrif_UseSpecialValueFineGrid = .FALSE.
+    Agrif_SpecialValue = 0.
+    Agrif_SpecialValueFineGrid = 0.
+!
+    allocate(Agrif_Mygrid)
+    allocate(Agrif_OldMygrid)
+!
+!   Space and time refinement factors are set to 1 on the root grid
+!
+    do i = 1,Agrif_Probdim
+        Agrif_Mygrid % spaceref(i) = coarse_spaceref(i)
+        Agrif_Mygrid % timeref(i)  = coarse_timeref(i)
+    enddo
+!
+!   Initialization of the number of time steps
+    Agrif_Mygrid % ngridstep = 0
+    Agrif_Mygrid % grid_id   = 0
+!
+!   No parent grid for the root coarse grid
+    nullify(Agrif_Mygrid % parent)
+!
+!   Initialization of the minimum positions, global abscissa and space steps
+    do i = 1, Agrif_Probdim
+        Agrif_Mygrid % ix(i) = 1
+        Agrif_Mygrid % Agrif_x(i)  = 0.
+        Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i)
+        Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i)
+!       Borders of the root coarse grid
+        Agrif_Mygrid % NearRootBorder(i) = .true.
+        Agrif_Mygrid % DistantRootBorder(i) = .true.
+    enddo
+!
+!   The root coarse grid is a fixed grid
+    Agrif_Mygrid % fixed = .TRUE.
+!   Level of the root grid
+    Agrif_Mygrid % level = 0
+!   Maximum level in the hierarchy
+    Agrif_MaxLevelLoc = 0
+!
+!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+    Agrif_Mygrid % rank = 1
+!
+!   Number of the root grid as a fixed grid
+    Agrif_Mygrid % fixedrank = 0
+!
+!   Initialization of some fields of the root grid variables
+    ierr_allocate = 0
+    if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate)
+    if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate)
+    if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate)
+    if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate)
+    if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate)
+    if (ierr_allocate /= 0) THEN
+      STOP "*** ERROR WHEN ALLOCATING TABVARS ***"
+    endif
+!
+!   Initialization of the other fields of the root grid variables (number of
+!   cells, positions, number and type of its dimensions, ...)
+    call Agrif_Instance(Agrif_Mygrid)
+    call Agrif_Set_numberofcells(Agrif_Mygrid)
+!
+!   Allocation of the array containing the values of the grid variables
+    call Agrif_Allocation(Agrif_Mygrid, procname2)
+    call Agrif_initialisations(Agrif_Mygrid)
+!
+!   Total number of fixed grids
+    Agrif_nbfixedgrids = 0
+    
+! If a grand mother grid is declared
+
+    if (agrif_coarse) then
+      allocate(Agrif_Coarsegrid)
+
+      Agrif_Coarsegrid % ngridstep = 0
+      Agrif_Coarsegrid % grid_id   = -9999
+      
+    do i = 1, Agrif_Probdim
+        Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i)
+        Agrif_Coarsegrid%timeref(i) = coarse_timeref(i)
+        Agrif_Coarsegrid % ix(i) = 1
+        Agrif_Coarsegrid % Agrif_x(i)  = 0.
+        Agrif_Coarsegrid % Agrif_dx(i) = 1.
+        Agrif_Coarsegrid % Agrif_dt(i) = 1.
+!       Borders of the root coarse grid
+        Agrif_Coarsegrid % NearRootBorder(i) = .true.
+        Agrif_Coarsegrid % DistantRootBorder(i) = .true.
+        Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i)
+    enddo      
+
+!   The root coarse grid is a fixed grid
+    Agrif_Coarsegrid % fixed = .TRUE.
+!   Level of the root grid
+    Agrif_Coarsegrid % level = -1
+    
+    Agrif_Coarsegrid % grand_mother_grid = .true.
+
+!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+    Agrif_Coarsegrid % rank = -9999
+!
+!   Number of the root grid as a fixed grid
+    Agrif_Coarsegrid % fixedrank = -9999
+    
+      Agrif_Mygrid%parent => Agrif_Coarsegrid
+      
+! Not used but required to prevent seg fault
+      Agrif_Coarsegrid%parent => Agrif_Mygrid
+      
+      call Agrif_Create_Var(Agrif_Coarsegrid)
+
+! Reset to null
+      Nullify(Agrif_Coarsegrid%parent)
+      
+      Agrif_Coarsegrid%child_list%nitems = 1
+      allocate(Agrif_Coarsegrid%child_list%first)
+      allocate(Agrif_Coarsegrid%child_list%last)
+      Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid
+      Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid
+
+    endif
+    
+    return
+
+98  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+    if (.not. BEXIST) then
+        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+        STOP
+    else
+        print*,'Error opening file AGRIF_FixedGrids.in'
+        STOP
+    endif
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Grids
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Deallocation
+!
+!> Deallocates all data arrays.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Deallocation
+!---------------------------------------------------------------------------------------------------
+    integer                         :: nb
+    type(Agrif_Variable), pointer   :: var
+    type(Agrif_Variable_c), pointer   :: var_c
+    type(Agrif_Variable_l), pointer   :: var_l
+    type(Agrif_Variable_i), pointer   :: var_i
+!
+    do nb = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Mygrid % tabvars(nb)
+!
+        if ( allocated(var % array1) ) deallocate(var % array1)
+        if ( allocated(var % array2) ) deallocate(var % array2)
+        if ( allocated(var % array3) ) deallocate(var % array3)
+        if ( allocated(var % array4) ) deallocate(var % array4)
+        if ( allocated(var % array5) ) deallocate(var % array5)
+        if ( allocated(var % array6) ) deallocate(var % array6)
+!
+        if ( allocated(var % sarray1) ) deallocate(var % sarray1)
+        if ( allocated(var % sarray2) ) deallocate(var % sarray2)
+        if ( allocated(var % sarray3) ) deallocate(var % sarray3)
+        if ( allocated(var % sarray4) ) deallocate(var % sarray4)
+        if ( allocated(var % sarray5) ) deallocate(var % sarray5)
+        if ( allocated(var % sarray6) ) deallocate(var % sarray6)
+!
+        if ( allocated(var % darray1) ) deallocate(var % darray1)
+        if ( allocated(var % darray2) ) deallocate(var % darray2)
+        if ( allocated(var % darray3) ) deallocate(var % darray3)
+        if ( allocated(var % darray4) ) deallocate(var % darray4)
+        if ( allocated(var % darray5) ) deallocate(var % darray5)
+        if ( allocated(var % darray6) ) deallocate(var % darray6)
+!
+    enddo
+!
+    do nb = 1,Agrif_NbVariables(1)
+!
+        var_c => Agrif_Mygrid % tabvars_c(nb)
+!
+        if ( allocated(var_c % carray1) ) deallocate(var_c % carray1)
+        if ( allocated(var_c % carray2) ) deallocate(var_c % carray2)
+!
+    enddo
+
+    do nb = 1,Agrif_NbVariables(3)
+!
+        var_l => Agrif_Mygrid % tabvars_l(nb)
+!
+        if ( allocated(var_l % larray1) ) deallocate(var_l % larray1)
+        if ( allocated(var_l % larray2) ) deallocate(var_l % larray2)
+        if ( allocated(var_l % larray3) ) deallocate(var_l % larray3)
+        if ( allocated(var_l % larray4) ) deallocate(var_l % larray4)
+        if ( allocated(var_l % larray5) ) deallocate(var_l % larray5)
+        if ( allocated(var_l % larray6) ) deallocate(var_l % larray6)
+!
+    enddo
+!
+    do nb = 1,Agrif_NbVariables(4)
+!
+        var_i => Agrif_Mygrid % tabvars_i(nb)
+!
+        if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1)
+        if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2)
+        if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3)
+        if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4)
+        if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5)
+        if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)
+!
+    enddo
+!
+    if ( allocated(Agrif_Mygrid % tabvars) )   deallocate(Agrif_Mygrid % tabvars)
+    if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c)
+    if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r)
+    if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l)
+    if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i)
+    deallocate(Agrif_Mygrid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Deallocation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_adj
+!
+!> creates the grid hierarchy and manages the backward time integration procedure.
+!> It is called in the main program.
+!> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_adj ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< Subroutine to call on each grid
+!
+!   Creation and initialization of the grid hierarchy
+!
+!   Set the clustering variables
+    call Agrif_clustering_def()
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+!
+        if (Agrif_Mygrid % ngridstep == 0) then
+            if (.not.Agrif_regrid_has_been_done ) then
+                call Agrif_Regrid()
+            endif
+            call Agrif_Instance(Agrif_Mygrid)
+        endif
+!
+    else
+!
+        if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
+            call Agrif_Regrid()
+            call Agrif_Instance(Agrif_Mygrid)
+        endif
+!
+    endif
+!
+!   Time integration of the grid hierarchy
+!
+    call Agrif_Integrate_adj (Agrif_Mygrid,procname)
+!
+    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_adj
+!
+!> Manages the backward time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_adj ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure
+    integer                    :: nbt      ! Number of time steps of the current grid
+    integer                    :: k
+!
+!   Instanciation of the variables of the current grid
+    if ( g%fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+    endif
+!
+!   Number of time steps on the current grid
+!
+    g%ngridstep = g % ngridstep + 1
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!   Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do k = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(k))
+        enddo
+!
+        do k = nbt,1,-1
+            call Agrif_Integrate_adj(parcours % gr, procname)
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
+!
+!   One step on the current grid
+    call procname ()
+!
+end subroutine Agrif_Integrate_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Child_adj
+!
+!> Apply 'procname' to each grid of the hierarchy from Child to Parent
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_Child_adj ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname)
+!
+    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!
+end subroutine Agrif_Step_Child_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child_adj
+!
+!> Manages the backward time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child_adj ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),pointer   :: g          !< Pointer on the current grid
+    procedure(step_proc)       :: procname   !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid),pointer  :: parcours   !< Pointer for the recursive procedure
+!
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+        call Agrif_Integrate_Child_adj(parcours % gr, procname)
+!
+       parcours => parcours % next
+!
+    enddo
+    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
+!
+!   One step on the current grid
+    call procname()
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child_adj
+!===================================================================================================
+!
+!===================================================================================================
+
+end module Agrif_Util
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F90	(revision 8732)
@@ -0,0 +1,146 @@
+module Agrif_Variables
+!
+    use Agrif_CurgridFunctions
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Declare_Variable
+!
+!> Declare a new variable profile
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Declare_Variable ( posvar, firstpoint, raf, lb, ub, varid, torestore )
+!---------------------------------------------------------------------------------------------------
+    integer,      dimension(:), intent(in)  :: posvar     !< position of the variable on the cell
+                                                          !! (1 for the border of the edge, 2 for the center)
+    integer,      dimension(:), intent(in)  :: firstpoint !< index of the first point in the real domain
+    character(1), dimension(:), intent(in)  :: raf        !< Array indicating the type of dimension (space or not)
+                                                          !!   for each of them
+    integer,      dimension(:), intent(in)  :: lb         !< Lower bounds of the array
+    integer,      dimension(:), intent(in)  :: ub         !< Upper bounds of the array
+    integer,                    intent(out) :: varid      !< Id number of the newly created variable
+    logical,      optional,     intent(in)  :: torestore  !< Indicates if the array restore is used
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variables_List), pointer :: new_varlist
+    type(Agrif_Variable),       pointer :: var
+    integer                             :: nbdim, i
+    logical                             :: restore
+
+    restore = .FALSE.
+    if ( Agrif_Mygrid % ngridstep /= 0 ) then
+        if (present(torestore)) restore = torestore
+    endif
+!
+    nbdim = SIZE(posvar)
+!
+    allocate(new_varlist)
+    allocate(new_varlist % var)
+
+    var => new_varlist % var
+
+    allocate(var % posvar(nbdim))
+    allocate(var % interptab(nbdim))
+    allocate(var % coords(nbdim))
+!
+    var % nbdim          = nbdim
+    var % interptab      = raf(1:nbdim)
+    var % posvar         = posvar(1:nbdim)
+    var % point(1:nbdim) = firstpoint(1:nbdim)
+    var % restore = restore
+!
+    do i = 1,nbdim
+        select case( raf(i) )
+            case('x')    ; var % coords(i) = 1
+            case('y')    ; var % coords(i) = 2
+            case('z')    ; var % coords(i) = 3
+            case('N')    ; var % coords(i) = 0
+            case default ; var % coords(i) = 0
+        end select
+    enddo
+!
+    var % lb(1:nbdim) = lb(1:nbdim)
+    var % ub(1:nbdim) = ub(1:nbdim)
+
+    if ( restore ) then
+        select case(nbdim)
+        case(1)
+            allocate(var % Restore1D(lb(1):ub(1)))
+            var % Restore1D = 0
+        case(2)
+            allocate(var % Restore2D(lb(1):ub(1),   &
+                                     lb(2):ub(2)))
+            var % Restore2D = 0
+        case(3)
+            allocate(var % Restore3D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3)))
+            var % Restore3D = 0
+        case(4)
+            allocate(var % Restore4D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3),   &
+                                     lb(4):ub(4)))
+            var % Restore4D = 0
+        case(5)
+            allocate(var % Restore5D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3),   &
+                                     lb(4):ub(4),   &
+                                     lb(5):ub(5)))
+            var % Restore5D = 0
+        end select
+    endif
+
+    new_varlist % next => Agrif_Curgrid % variables
+
+    Agrif_Curgrid % variables => new_varlist
+    Agrif_Curgrid % Nbvariables = Agrif_Curgrid % Nbvariables + 1
+
+    varid = -Agrif_Curgrid % Nbvariables
+
+    var % parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, Agrif_Curgrid % nbvariables)
+    var % root_var   => Agrif_Search_Variable(Agrif_Mygrid, Agrif_Curgrid % nbvariables)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Declare_Variable
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Search_Variable
+!
+!> Returns a pointer to the variable varid for the grid grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Search_Variable ( grid, varid ) result(outvar)
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer       :: grid     !< Pointer on the current grid.
+    integer,          intent(in)    :: varid    !< ID number of the variable we are looking for.
+!
+    type(Agrif_Variable),       pointer :: outvar
+    type(Agrif_Variables_List), pointer :: parcours
+    integer :: nb, varidinv
+!
+    if ( .not.associated(grid) ) then
+        outvar => NULL()
+        return
+    endif
+!
+    parcours => grid % variables
+
+    if (.not. associated(parcours)) then   ! can occur on the grand mother grid
+           outvar => NULL()                ! during the first call by agrif_mygrid
+           return
+    endif
+
+    varidinv = 1 + grid % nbvariables - varid
+
+    do nb = 1,varidinv-1
+        parcours => parcours % next
+    enddo
+
+    outvar => parcours % var
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Search_variable
+!===================================================================================================
+!
+end module Agrif_Variables
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/Makefile.lex	(revision 8732)
@@ -0,0 +1,31 @@
+LEX		= flex -i
+YACC	= bison -t -v -g
+
+all: main.c fortran.c
+
+main.c : convert.tab.c convert.yy.c
+	cat   convert.tab.c convert.yy.c > ../LIB/main.c
+	$(RM) convert.tab.c convert.yy.c
+
+fortran.c : fortran.tab.c fortran.yy.c
+	cat   fortran.tab.c fortran.yy.c > ../LIB/fortran.c
+	$(RM) fortran.tab.c fortran.yy.c
+
+convert.tab.c : convert.y decl.h
+	$(YACC) -p convert_ convert.y
+
+fortran.tab.c : fortran.y decl.h
+	$(YACC) -p fortran_ fortran.y
+
+convert.yy.c : convert.lex
+	$(LEX) -P convert_ -o convert.yy.c convert.lex
+
+fortran.yy.c : fortran.lex
+	$(LEX) -P fortran_ -o fortran.yy.c fortran.lex
+
+clean:
+	$(RM) convert.yy.c convert.tab.c convert.output convert.vcg convert.dot	\
+		  fortran.yy.c fortran.tab.c fortran.output fortran.vcg fortran.dot
+
+clean-all: clean
+	$(RM) ../LIB/main.c ../LIB/fortran.c
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.lex	(revision 8732)
@@ -0,0 +1,69 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%s character
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define YY_NO_INPUT
+%}
+
+SEPARATEUR      "::"
+COMMENTS        "%".*"%"
+PROBTYPE        "1D"|"2D"|"3D"
+USEITEM         "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
+NAME            [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER         [0-9]+
+NEXTLINE        \n+[ \t]+"$"|\n+[ \t]+"&"
+%%
+parammodule         { return TOK_MODULEMAIN; } /* name of the module                      */
+notgriddep          { return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
+use                 { return TOK_USE; }
+{COMMENTS}          { }
+{SEPARATEUR}        { return TOK_SEP; }
+KIND                { return TOK_KIND; }
+\=                  { return TOK_EQUAL; }
+{USEITEM}           { strcpy(yylval.na,yytext); return TOK_USEITEM;  }
+{PROBTYPE}          { strcpy(yylval.na,yytext); return TOK_PROBTYPE; }  /* dimension of the problem */
+{NAME}              { strcpy(yylval.na,yytext); return TOK_NAME; }
+{INTEGER}           { strcpy(yylval.na,yytext); return TOK_CSTINT; }
+;|\,|\(|\)|:|\[|\]  { return (int) *yytext; }
+\n                  { line_num++; return (int) *yytext; }
+[ \t]+ ;
+%%
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y	(revision 8732)
@@ -0,0 +1,463 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%{
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+%}
+
+%union {
+    char na[LONG_M];
+}
+
+%token TOK_SEP
+%token TOK_KIND
+%token TOK_EQUAL
+%token TOK_USE
+%token TOK_MODULEMAIN      /* name of the module                              */
+%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
+%token <na> TOK_USEITEM
+%token <na> TOK_NAME
+%token <na> TOK_CSTINT
+%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
+%token ','
+%token ';'
+
+%%
+
+input :
+    | input line ;
+
+line :
+      '\n'
+    | TOK_PROBTYPE TOK_NAME ';'                             { initdimprob(1,$2,"0","0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'                { initdimprob(2,$2, $4,"0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'   { initdimprob(3,$2, $4, $6); }
+    | TOK_MODULEMAIN TOK_NAME ';'
+        {
+            listofmodules = Addtolistnom($2,listofmodules,0);
+            Addmoduletothelist($2);
+        }
+    | TOK_KIND TOK_NAME TOK_EQUAL TOK_CSTINT ';'
+        {
+            if (!strcasecmp($4,"4"))
+            {
+                listofkind = Addtolistnom($2,listofkind,4);
+            }
+            else if (!strcasecmp($4,"8"))
+            {
+                listofkind = Addtolistnom($2,listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",$4);
+                exit(0);
+            }
+        }
+    | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'
+        {
+            Add_NotGridDepend_Var_1($3);
+        }
+    | TOK_USE TOK_USEITEM ';'
+        {
+            if (!strcasecmp($2,"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp($2,"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        }
+    ;
+%%
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
+
+int main(int argc,char *argv[])
+{
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
+
+/******************************************************************************/
+/*  3-  Parsing of the conv file <name>.in                                    */
+/******************************************************************************/
+
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/decl.h	(revision 8732)
@@ -0,0 +1,1 @@
+link ../LIB/decl.h
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.lex	(revision 8732)
@@ -0,0 +1,294 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%x parameter
+%s character
+%x donottreat
+%s fortran77style
+%s fortran90style
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_input = 1;
+int newlinef90 = 0;
+char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+%}
+
+REAL8 "real*8"[ \t]*"(a-h,o-z)"
+
+SLASH       "/"
+DSLASH      "/"[ \t]*"/"
+HEXA        Z\'[0-9a-fA-F]+\'
+NAME        [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER     [0-9]+
+
+EXPONENT    [edq][-+]?{INTEGER}
+
+BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*\n
+END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*\n
+
+BEG_INTERFACE   ^[ \t]*interface
+END_INTERFACE   ^[ \t]*end[ \t]*interface.*\n
+
+ASSIGNTYPE      "assignment"[ \t]*"("[ \t]*[-+=]+[ \t]*")"
+
+COMM_F77        ^([Cc*](([ \t]*\n)|([^AaHhOo\n].*\n)))
+COMM_F90        ^[ \t]*!.*\n
+COMM_F90_2      !.*
+NEXTLINEF90     "&".*\n+
+NEXTLINEF77     [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
+
+LABEL           ^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+
+
+%%
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree)  BEGIN(fortran90style) ;
+
+{REAL8}                     { return TOK_REAL8; }
+subroutine                  { return TOK_SUBROUTINE; }
+program                     { return TOK_PROGRAM; }
+allocate                    { inallocate = 1; return TOK_ALLOCATE; }
+nullify			            { return TOK_NULLIFY; }
+null[ ]*\([ ]*\)            { return TOK_NULL_PTR; }
+deallocate                  { inallocate = 1; return TOK_DEALLOCATE; }
+result                      { return TOK_RESULT; }
+function                    { return TOK_FUNCTION; }
+end[ \t]*program            { strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+end[ \t]*module             { strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+end[ \t]*subroutine         { strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+end[ \t]*function           { strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+end                         { strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+include                     { pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+^[ \t]*use[ ]+              { strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+rewind                      { return TOK_REWIND; }
+implicit                    { return TOK_IMPLICIT; }
+none                        { return TOK_NONE; }
+call                        { return TOK_CALL; }
+.true.                      { return TOK_TRUE; }
+.false.                     { return TOK_FALSE; }
+\=\>                        { return TOK_POINT_TO; }
+{ASSIGNTYPE}                { strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+\*\*                        { strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+\.[ \t]*eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; }
+\.[ \t]*eq\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+\.[ \t]*gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  }
+\.[ \t]*ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  }
+\.[ \t]*lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  }
+\.[ \t]*le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  }
+\.[ \t]*neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+\.[ \t]*ne\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  }
+\.[ \t]*not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; }
+\.[ \t]*or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  }
+\.[ \t]*xor\.               { strcpy(yylval.na,fortran_text); return TOK_XOR; }
+\.[ \t]*and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; }
+module                      { return TOK_MODULE; }
+while                       { return TOK_WHILE; }
+concurrent                  { return TOK_CONCURRENT; }
+end[ \t]*do                 { return TOK_ENDDO; }
+do                          { return TOK_PLAINDO;}
+real                        { strcpy(yylval.na,fortran_text); return TOK_REAL; }
+integer                     { strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+logical                     { strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+character                   { strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+{HEXA}                      { strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+double[ \t]*precision       { strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+double[ \t]*complex         { strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+complex                     { return TOK_COMPLEX; }
+allocatable                 { return TOK_ALLOCATABLE; }
+close                       { return TOK_CLOSE; }
+inquire                     { return TOK_INQUIRE; }
+dimension                   { return TOK_DIMENSION; }
+pause                       { return TOK_PAUSE; }
+equivalence                 { return TOK_EQUIVALENCE; }
+stop                        { return TOK_STOP; }
+where                       { return TOK_WHERE; }
+end[ \t]*where              { return TOK_ENDWHERE; }
+else[ \t]*where[ \t]*\(     { return TOK_ELSEWHEREPAR; }
+else[ \t]*where             { return TOK_ELSEWHERE; }
+^[ \t]*contains             { return TOK_CONTAINS; }
+only                        { return TOK_ONLY; }
+parameter                   { return TOK_PARAMETER; }
+recursive                   { return TOK_RECURSIVE; }
+common                      { return TOK_COMMON; }
+^[ \t]*global[ \t]+         { return TOK_GLOBAL; }
+external                    { return TOK_EXTERNAL; }
+intent                      { return TOK_INTENT; }
+pointer                     { return TOK_POINTER; }
+optional                    { return TOK_OPTIONAL; }
+save                        { return TOK_SAVE; }
+^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+^[ \t]*type[ \t\,]+         { return TOK_TYPE; }
+end[ \t]*type               { return TOK_ENDTYPE; }
+stat                        { if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+open                        { return TOK_OPEN; }
+return                      { return TOK_RETURN; }
+exit[^(]                    { return TOK_EXIT; }
+print                       { return TOK_PRINT; }
+module[ \t]*procedure       { return TOK_PROCEDURE; }
+read                        { return TOK_READ; }
+namelist                    { return TOK_NAMELIST; }
+write                       { return TOK_WRITE; }
+flush                       { return TOK_FLUSH; }
+target                      { return TOK_TARGET; }
+public                      { return TOK_PUBLIC; }
+private                     { return TOK_PRIVATE; }
+in                          { strcpy(yylval.na,fortran_text); return TOK_IN; }
+^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+continue                    { return TOK_CONTINUE; }
+go[ \t]*to                  { return TOK_PLAINGOTO; }
+out                         { strcpy(yylval.na,fortran_text); return TOK_OUT; }
+inout                       { strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+intrinsic                   { return TOK_INTRINSIC; }
+then                        { return TOK_THEN; }
+else[ \t]*if                { return TOK_ELSEIF; }
+else                        { return TOK_ELSE; }
+end[ \t]*if                 { return TOK_ENDIF; }
+if                          { return TOK_LOGICALIF; }
+sum[ \t]*\(                 { return TOK_SUM; }
+max[ \t]*\(                 { return TOK_MAX; }
+tanh                        { return TOK_TANH; }
+maxval                      { return TOK_MAXVAL; }
+trim                        { return TOK_TRIM; }
+sqrt\(                      { return TOK_SQRT; }
+select[ \t]*case            { return TOK_SELECTCASE; }
+^[ \t]*case[ \t]*           { return TOK_CASE; }
+default                     { return TOK_DEFAULT; }
+end[ \t]*select             { return TOK_ENDSELECT; }
+file[ \t]*\=                { return TOK_FILE; }
+unit[ \t]*\=                { return TOK_UNIT; }
+fmt[ \t]*\=                 { return TOK_FMT; }
+nml[ \t]*\=                 { return TOK_NML; }
+end[ \t]*\=                 { return TOK_END; }
+eor[ \t]*\=                 { return TOK_EOR; }
+err[ \t]*\=                 { return TOK_ERR; }
+exist[ \t]*\=               { return TOK_EXIST; }
+min[ \t]*\(                 { return TOK_MIN; }
+nint                        { return TOK_NINT; }
+float                       { return TOK_FLOAT; }
+exp                         { return TOK_EXP; }
+cos                         { return TOK_COS; }
+cosh                        { return TOK_COSH; }
+acos                        { return TOK_ACOS; }
+sin                         { return TOK_SIN; }
+sinh                        { return TOK_SINH; }
+asin                        { return TOK_ASIN; }
+log                         { return TOK_LOG; }
+tan                         { return TOK_TAN; }
+atan                        { return TOK_ATAN; }
+cycle                       { return TOK_CYCLE; }
+abs[ \t]*\(                 { return TOK_ABS; }
+mod                         { return TOK_MOD; }
+sign[ \t]*\(                { return TOK_SIGN; }
+minloc                      { return TOK_MINLOC; }
+maxloc                      { return TOK_MAXLOC; }
+minval                      { return TOK_MINVAL; }
+backspace                   { return TOK_BACKSPACE; }
+::                          { return TOK_FOURDOTS;  }
+\({SLASH}                   { return TOK_LEFTAB; }
+{SLASH}\)                   { return TOK_RIGHTAB; }
+format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  {
+                              return TOK_FORMAT; }
+{SLASH}                     { strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+DSLASH                      { strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\') {
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+(\')[^']*(\')             { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+(\")[^"]*(\")             { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+{BEG_INTERFACE}             { BEGIN(donottreat); }
+<donottreat>{END_INTERFACE} { out_of_donottreat(); return '\n'; }
+{NAME}                      { strcpy(yylval.na,fortran_text); return TOK_NAME; }
+({INTEGER}\.[0-9]*)/[^"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+(({INTEGER}\.[0-9]+|[0-9]*\.{INTEGER}){EXPONENT}?)|{INTEGER}(\.)?{EXPONENT}                     {  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+{INTEGER}                   { strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+\$                          {}
+\.                          {}
+\(|\)|:|\[|\]|\+|\-|\*      { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\%                          { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\;                          { return TOK_SEMICOLON; }
+\,                          { return (int) *fortran_text; }
+\=                          { return (int) *fortran_text; }
+\<                          { return (int) *fortran_text; }
+\>                          { return (int) *fortran_text; }
+\n                          { INCREMENT_LINE_NUM() ; return '\n'; }
+^[ ]*$                      {}
+[ \t]+                      {}
+{LABEL}                     { if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+{NEXTLINEF90}               { INCREMENT_LINE_NUM() ; newlinef90=1; }
+{NEXTLINEF77}               { INCREMENT_LINE_NUM() ; }
+
+{BEG_DNT}                   { INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+<donottreat>{END_DNT}       { out_of_donottreat(); return '\n'; }
+<donottreat>.*\n            { INCREMENT_LINE_NUM() ; }
+<fortran77style>{COMM_F77}  { INCREMENT_LINE_NUM() ; }
+{COMM_F90}                  { INCREMENT_LINE_NUM() ; }
+{COMM_F90_2}                {}
+%%
+
+void out_of_donottreat ( void )
+{
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.y	(revision 8732)
@@ -0,0 +1,2225 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http ://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+%{
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
+int c_selectorgiven=0;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+int removeline=0;
+listvar *test;
+
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+%}
+
+%union {
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+}
+
+%left ','
+%nonassoc ':'
+%right '='
+%left TOK_EQV TOK_NEQV
+%left TOK_OR TOK_XOR
+%left TOK_AND
+%left TOK_NOT
+%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
+%left TOK_DSLASH
+%left '+' '-'
+%left '*' TOK_SLASH
+%right TOK_DASTER
+
+%token TOK_SEMICOLON
+%token TOK_PARAMETER
+%token TOK_RESULT
+%token TOK_ONLY
+%token TOK_INCLUDE
+%token TOK_SUBROUTINE
+%token TOK_PROGRAM
+%token TOK_FUNCTION
+%token TOK_FORMAT
+%token TOK_MAX
+%token TOK_TANH
+%token TOK_WHERE
+%token TOK_ELSEWHEREPAR
+%token TOK_ELSEWHERE
+%token TOK_ENDWHERE
+%token TOK_MAXVAL
+%token TOK_TRIM
+%token TOK_NULL_PTR
+%token TOK_SUM
+%token TOK_SQRT
+%token TOK_CASE
+%token TOK_SELECTCASE
+%token TOK_FILE
+%token TOK_UNIT
+%token TOK_FMT
+%token TOK_NML
+%token TOK_END
+%token TOK_EOR
+%token TOK_ERR
+%token TOK_EXIST
+%token TOK_MIN
+%token TOK_FLOAT
+%token TOK_EXP
+%token TOK_COS
+%token TOK_COSH
+%token TOK_ACOS
+%token TOK_NINT
+%token TOK_CYCLE
+%token TOK_SIN
+%token TOK_SINH
+%token TOK_ASIN
+%token TOK_EQUIVALENCE
+%token TOK_BACKSPACE
+%token TOK_LOG
+%token TOK_TAN
+%token TOK_ATAN
+%token TOK_RECURSIVE
+%token TOK_ABS
+%token TOK_MOD
+%token TOK_SIGN
+%token TOK_MINLOC
+%token TOK_MAXLOC
+%token TOK_EXIT
+%token TOK_MINVAL
+%token TOK_PUBLIC
+%token TOK_PRIVATE
+%token TOK_ALLOCATABLE
+%token TOK_RETURN
+%token TOK_THEN
+%token TOK_ELSEIF
+%token TOK_ELSE
+%token TOK_ENDIF
+%token TOK_PRINT
+%token TOK_PLAINGOTO
+%token TOK_LOGICALIF
+%token TOK_PLAINDO
+%token TOK_CONTAINS
+%token TOK_ENDDO
+%token TOK_MODULE
+%token TOK_ENDMODULE
+%token TOK_WHILE
+%token TOK_CONCURRENT
+%token TOK_ALLOCATE
+%token TOK_OPEN
+%token TOK_CLOSE
+%token TOK_INQUIRE
+%token TOK_WRITE
+%token TOK_FLUSH
+%token TOK_READ
+%token TOK_REWIND
+%token TOK_DEALLOCATE
+%token TOK_NULLIFY
+%token TOK_DIMENSION
+%token TOK_ENDSELECT
+%token TOK_EXTERNAL
+%token TOK_INTENT
+%token TOK_INTRINSIC
+%token TOK_NAMELIST
+%token TOK_DEFAULT
+%token TOK_OPTIONAL
+%token TOK_POINTER
+%token TOK_CONTINUE
+%token TOK_SAVE
+%token TOK_TARGET
+%token TOK_IMPLICIT
+%token TOK_NONE
+%token TOK_CALL
+%token TOK_STAT
+%token TOK_POINT_TO
+%token TOK_COMMON
+%token TOK_GLOBAL
+%token TOK_LEFTAB
+%token TOK_RIGHTAB
+%token TOK_PAUSE
+%token TOK_PROCEDURE
+%token TOK_STOP
+%token TOK_REAL8
+%token TOK_FOURDOTS
+%token <na> TOK_HEXA
+%token <na> TOK_ASSIGNTYPE
+%token <na> TOK_OUT
+%token <na> TOK_INOUT
+%token <na> TOK_IN
+%token <na> TOK_USE
+%token <na> TOK_DSLASH
+%token <na> TOK_DASTER
+%token <na> TOK_EQ
+%token <na> TOK_EQV
+%token <na> TOK_GT
+%token <na> TOK_LT
+%token <na> TOK_GE
+%token <na> TOK_NE
+%token <na> TOK_NEQV
+%token <na> TOK_LE
+%token <na> TOK_OR
+%token <na> TOK_XOR
+%token <na> TOK_NOT
+%token <na> TOK_AND
+%token <na> TOK_TRUE
+%token <na> TOK_FALSE
+%token <na> TOK_LABEL
+%token <na> TOK_TYPE
+%token <na> TOK_TYPEPAR
+%token <na> TOK_ENDTYPE
+%token <na> TOK_REAL
+%token <na> TOK_INTEGER
+%token <na> TOK_LOGICAL
+%token <na> TOK_DOUBLEPRECISION
+%token <na> TOK_ENDSUBROUTINE
+%token <na> TOK_ENDFUNCTION
+%token <na> TOK_ENDPROGRAM
+%token <na> TOK_ENDUNIT
+%token <na> TOK_CHARACTER
+%token <na> TOK_CHAR_CONSTANT
+%token <na> TOK_CHAR_CUT
+%token <na> TOK_DATA
+%token <na> TOK_CHAR_MESSAGE
+%token <na> TOK_CSTREAL
+%token <na> TOK_COMPLEX
+%token <na> TOK_DOUBLECOMPLEX
+%token <na> TOK_NAME
+%token <na> TOK_SLASH
+%token <na> TOK_CSTINT
+%token ','
+%token ':'
+%token '('
+%token ')'
+%token '<'
+%token '>'
+%type <l> dcl
+%type <l> after_type
+%type <l> dimension
+%type <l> paramlist
+%type <l> args
+%type <l> arglist
+%type <lc> only_list
+%type <lc> only_name
+%type <lc> rename_list
+%type <lc> rename_name
+%type <d> dims
+%type <d> dimlist
+%type <dim1> dim
+%type <v> paramitem
+%type <na> comblock
+%type <na> name_routine
+%type <na> opt_name
+%type <na> type
+%type <na> word_endsubroutine
+%type <na> word_endfunction
+%type <na> word_endprogram
+%type <na> word_endunit
+%type <na> typespec
+%type <na> string_constant
+%type <na> simple_const
+%type <na> ident
+%type <na> intent_spec
+%type <na> signe
+%type <na> opt_signe
+%type <na> filename
+%type <na> attribute
+%type <na> complex_const
+%type <na> begin_array
+%type <na> clause
+%type <na> arg
+%type <na> uexpr
+%type <na> minmaxlist
+%type <na> lhs
+%type <na> vec
+%type <na> outlist
+%type <na> other
+%type <na> dospec
+%type <na> expr_data
+%type <na> structure_component
+%type <na> array_ele_substring_func_ref
+%type <na> funarglist
+%type <na> funarg
+%type <na> funargs
+%type <na> triplet
+%type <na> substring
+%type <na> opt_substring
+%type <na> opt_expr
+%type <na> optexpr
+%type <lnn> data_stmt_value_list
+%type <lnn> datanamelist
+%type <na> after_slash
+%type <na> after_equal
+%type <na> predefinedfunction
+%type <na> expr
+%type <na> ubound
+%type <na> operation
+%type <na> proper_lengspec
+%type <lnn> use_name_list
+%type <lnn> public
+
+%%
+input :
+      | input line
+      ;
+line :  line-break
+      | suite_line_list
+      | TOK_LABEL suite_line_list
+      | error {yyerrok;yyclearin;}
+      ;
+line-break:
+        '\n' fin_line
+      | TOK_SEMICOLON
+      | line-break '\n' fin_line
+      | line-break TOK_SEMICOLON
+      | line-break TOK_LABEL
+      ;
+suite_line_list :
+        suite_line
+      | suite_line_list TOK_SEMICOLON '\n'
+      | suite_line_list TOK_SEMICOLON suite_line
+      ;
+suite_line :
+        entry fin_line     /* subroutine, function, module                    */
+      | spec fin_line      /* declaration                                     */
+      | TOK_INCLUDE filename fin_line
+        {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+      | execution-part-construct
+      ;
+
+fin_line : { pos_cur = setposcur(); }
+      ;
+
+opt_recursive :         { isrecursive = 0; }
+      | TOK_RECURSIVE   { isrecursive = 1; }
+      ;
+
+opt_result :                                { is_result_present = 0; }
+      | TOK_RESULT arglist_after_result     { is_result_present = 1; }
+      ;
+
+entry : opt_recursive TOK_SUBROUTINE name_routine arglist
+        {
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1($4);
+            else
+                WriteBeginof_SubLoop();
+        }
+      | TOK_PROGRAM name_routine
+        {
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
+      | opt_recursive TOK_FUNCTION name_routine arglist opt_result
+        {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($4);
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1($3);
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
+      | TOK_MODULE TOK_NAME
+        {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,$2);
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1($2);
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
+      ;
+
+/* R312 : label */
+label: TOK_CSTINT
+     | label TOK_CSTINT
+     ;
+
+name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
+      ;
+filename :      TOK_CHAR_CONSTANT { Add_Include_1($1); }
+      ;
+arglist :               { if ( firstpass ) $$=NULL; }
+      | '(' ')'         { if ( firstpass ) $$=NULL; }
+      | '(' args ')'    { if ( firstpass ) $$=$2; }
+      ;
+arglist_after_result:
+      | '(' ')'
+      | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
+      ;
+args :  arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($1,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                $$ = settype("",curlistvar);
+            }
+        }
+      | args ',' arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($3,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                $$ = insertvar($1,curvar);
+            }
+        }
+      ;
+arg : TOK_NAME  { strcpy($$,$1);  }
+      | '*'     { strcpy($$,"*"); }
+      ;
+spec :  type after_type
+      | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; }
+      | TOK_ENDTYPE opt_name                { inside_type_declare = 0; }
+      | TOK_POINTER list_couple
+      | before_parameter '(' paramlist ')'
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($3);
+                    else                        Add_GlobalParameter_Var_1($3);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | before_parameter paramlist
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($2);
+                    else                        Add_GlobalParameter_Var_1($2);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | common
+      | save
+        {
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+      | implicit
+      | dimension
+        {
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1($1);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+      | public
+        {
+            if (firstpass == 0)
+            {
+                if ($1)
+                {
+                    removeglobfromlist(&($1));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic($1);
+                }
+            }
+        }
+      | private
+      | use_stat
+      | module_proc_stmt
+      | namelist
+      | TOK_BACKSPACE '(' expr ')'
+      | TOK_EXTERNAL opt_sep use_name_list
+      | TOK_INTRINSIC opt_sep use_intrinsic_list
+      | TOK_EQUIVALENCE list_expr_equi
+      | data_stmt '\n'
+        {
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+      ;
+opt_spec :
+      | access_spec
+        {
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+      ;
+name_intrinsic :
+        TOK_SUM
+      | TOK_TANH
+      | TOK_MAXVAL
+      | TOK_MIN
+      | TOK_MINVAL
+      | TOK_TRIM
+      | TOK_SQRT
+      | TOK_NINT
+      | TOK_FLOAT
+      | TOK_EXP
+      | TOK_COS
+      | TOK_COSH
+      | TOK_ACOS
+      | TOK_SIN
+      | TOK_SINH
+      | TOK_ASIN
+      | TOK_LOG
+      | TOK_TAN
+      | TOK_ATAN
+      | TOK_MOD
+      | TOK_SIGN
+      | TOK_MINLOC
+      | TOK_MAXLOC
+      | TOK_NAME
+      ;
+use_intrinsic_list :
+                               name_intrinsic
+      | use_intrinsic_list ',' name_intrinsic
+      ;
+list_couple :
+                        '(' list_expr ')'
+      | list_couple ',' '(' list_expr ')'
+      ;
+list_expr_equi :
+                           expr_equi
+      | list_expr_equi ',' expr_equi
+      ;
+expr_equi : '(' list_expr_equi1 ')'
+      ;
+list_expr_equi1 :
+                            ident dims
+      | list_expr_equi1 ',' ident dims
+      ;
+list_expr :
+                      expr
+      | list_expr ',' expr
+      ;
+opt_sep :
+      | TOK_FOURDOTS
+      ;
+after_type :
+        dcl nodimsgiven
+        {
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01($1);
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                $$ = $1;
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
+                        Add_Parameter_Var_1($1);
+                    }
+                    else
+                        Add_GlobalParameter_Var_1($1);
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
+                        else                Add_Save_Var_dcl_1($1);
+                    }
+                }
+            }
+            else
+            {
+                $$ = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+      | before_function name_routine arglist
+        {
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($3);
+                Add_FunctionType_Var_1($2);
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+      ;
+before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
+      ;
+before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+      ;
+
+data_stmt :             /* R534 */
+        TOK_DATA data_stmt_set_list
+
+data_stmt_set_list :
+        data_stmt_set
+      | data_stmt_set_list opt_comma data_stmt_set
+
+data_stmt_set :         /* R535 */
+        TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$3);
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
+        }
+      | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
+        }
+      | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$7);
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,$2,$4,ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+      ;
+
+data_stmt_value_list :
+        expr_data                           { $$ = Insertname(NULL,$1,0); }
+      | expr_data ',' data_stmt_value_list  { $$ = Insertname($3,$1,1);   }
+      ;
+
+save :  before_save varsave
+      | before_save comblock varsave
+      | save opt_comma comblock opt_comma varsave
+      | save ',' varsave
+      ;
+before_save :
+        TOK_SAVE        { pos_cursave = setposcur()-4; }
+      ;
+varsave :
+      | TOK_NAME dims   { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
+      ;
+datanamelist :
+        TOK_NAME                        { $$ = Insertname(NULL,$1,0); }
+      | TOK_NAME '(' expr ')'           { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+      | datanamelist ',' datanamelist   { $$ = concat_listname($1,$3); }
+      ;
+expr_data :
+        opt_signe simple_const      { sprintf($$,"%s%s",$1,$2);  }
+      | expr_data '+' expr_data     { sprintf($$,"%s+%s",$1,$3); }
+      | expr_data '-' expr_data     { sprintf($$,"%s-%s",$1,$3); }
+      | expr_data '*' expr_data     { sprintf($$,"%s*%s",$1,$3); }
+      | expr_data '/' expr_data     { sprintf($$,"%s/%s",$1,$3); }
+      ;
+opt_signe :     { strcpy($$,""); }
+      | signe   { strcpy($$,$1); }
+      ;
+namelist :
+        TOK_NAMELIST ident
+      | TOK_NAMELIST comblock ident
+      | namelist opt_comma comblock opt_comma ident
+      | namelist ',' ident
+      ;
+before_dimension :
+        TOK_DIMENSION
+        {
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+
+dimension :
+        before_dimension opt_comma TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            $$ = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+      | dimension ',' TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar($1, curvar);
+            $$ = curlistvar;
+            strcpy(vallengspec,"");
+        }
+      ;
+private :
+        TOK_PRIVATE '\n'
+      | TOK_PRIVATE opt_sep use_name_list
+      ;
+public :
+        TOK_PUBLIC '\n'                     { $$ = (listname *) NULL; }
+      | TOK_PUBLIC opt_sep use_name_list    { $$ = $3; }
+      ;
+use_name_list :
+        TOK_NAME                            { $$ = Insertname(NULL,$1,0); }
+      | TOK_ASSIGNTYPE                      { $$ = Insertname(NULL,$1,0); }
+      | use_name_list ',' TOK_NAME          { $$ = Insertname($1,$3,0);   }
+      | use_name_list ',' TOK_ASSIGNTYPE    { $$ = Insertname($1,$3,0);   }
+      ;
+common :
+        before_common var_common_list
+        {
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | before_common comblock var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$2);
+            Add_NameOfCommon_1($2,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | common opt_comma comblock opt_comma var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$3);
+            Add_NameOfCommon_1($3,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      ;
+before_common :
+        TOK_COMMON              { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+      | TOK_GLOBAL TOK_COMMON   { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+      ;
+var_common_list :
+        var_common                      { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      | var_common_list ',' var_common  { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      ;
+var_common :
+        TOK_NAME dims
+        {
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,$1);
+            commondim = $2;
+        }
+      ;
+comblock :
+        TOK_DSLASH
+        {
+            strcpy($$,"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+      | TOK_SLASH TOK_NAME TOK_SLASH
+        {
+            strcpy($$,$2);
+            positioninblock=0;
+            strcpy(commonblockname,$2);
+        }
+      ;
+opt_comma :
+      | ','
+      ;
+paramlist :
+        paramitem                   { $$=insertvar(NULL,$1); }
+      | paramlist ',' paramitem     { $$=insertvar($1,$3);   }
+      ;
+paramitem :
+        TOK_NAME '=' expr
+        {
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,$1);
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,$3);
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length($3,14);
+            $$ = curvar;
+        }
+      ;
+module_proc_stmt :
+        TOK_PROCEDURE proc_name_list
+      ;
+proc_name_list :
+        TOK_NAME
+      | proc_name_list ',' TOK_NAME
+      ;
+implicit :
+        TOK_IMPLICIT TOK_NONE
+        {
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+      | TOK_IMPLICIT TOK_REAL8
+      ;
+dcl :   options TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($2,curdim);
+                else                curvar = createvar($2,$3);
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+      | dcl ',' TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($3, curdim);
+                else                curvar = createvar($3, $4);
+                CreateAndFillin_Curvar($1->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, $1->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar($1, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+      ;
+nodimsgiven : { dimsgiven = 0; }
+      ;
+type :  typespec selector               { strcpy(DeclType,$1);  }
+      | before_character c_selector     { strcpy(DeclType,"character");  }
+      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
+      | TOK_TYPEPAR attribute ')'       { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+      ;
+c_selector :
+      | '*' TOK_CSTINT              { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
+      | '*' '(' c_attribute ')'     { c_star = 1;}
+      | '(' c_attribute ')'
+      ;
+c_attribute :
+        TOK_NAME clause opt_clause
+      | TOK_NAME '=' clause opt_clause
+      | clause opt_clause
+      ;
+before_character : TOK_CHARACTER    { pos_cur_decl = setposcur()-9; }
+      ;
+typespec :
+        TOK_INTEGER         { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
+      | TOK_LOGICAL         { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
+      | TOK_REAL            { strcpy($$,"real");    pos_cur_decl = setposcur()-4; }
+      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
+      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
+      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
+      ;
+lengspec :
+      | '*' proper_lengspec {strcpy(vallengspec,$2);}
+      ;
+proper_lengspec :
+        expr        { sprintf($$,"*%s",$1); }
+      | '(' '*' ')' { strcpy($$,"*(*)"); }
+      ;
+selector :
+      | '*' proper_selector
+      | '(' attribute ')'
+      ;
+proper_selector : expr
+      | '(' '*' ')'
+      ;
+attribute :
+        TOK_NAME clause
+      | TOK_NAME '=' clause
+        {
+            if ( strstr($3,"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",$1,$3);
+        }
+      | TOK_NAME        { strcpy(NamePrecision,$1); }
+      | TOK_CSTINT      { strcpy(NamePrecision,$1); }
+      | TOK_ASSIGNTYPE  { strcpy(NamePrecision,$1); }
+      ;
+clause :
+        expr   { strcpy(CharacterSize,$1);  strcpy($$,$1);  }
+      | '*'    { strcpy(CharacterSize,"*"); strcpy($$,"*"); }
+      ;
+opt_clause :
+      | ',' TOK_NAME clause
+      ;
+options :
+      | TOK_FOURDOTS
+      | ',' attr_spec_list TOK_FOURDOTS
+      ;
+attr_spec_list : attr_spec
+      | attr_spec_list ',' attr_spec
+      ;
+attr_spec :
+        TOK_PARAMETER       { VariableIsParameter = 1; }
+      | access_spec
+      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
+      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
+      | TOK_EXTERNAL        { ExternalDeclare = 1; }
+      | TOK_INTENT '(' intent_spec ')'
+                            { strcpy(IntentSpec,$3); }
+      | TOK_INTRINSIC
+      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
+      | TOK_POINTER         { pointerdeclare = 1 ; }
+      | TOK_SAVE            { SaveDeclare = 1 ; }
+      | TOK_TARGET          { Targetdeclare = 1; }
+      ;
+intent_spec :
+        TOK_IN          { strcpy($$,$1); }
+      | TOK_OUT         { strcpy($$,$1); }
+      | TOK_INOUT       { strcpy($$,$1); }
+      ;
+access_spec :
+        TOK_PUBLIC      { PublicDeclare = 1;  }
+      | TOK_PRIVATE     { PrivateDeclare = 1; }
+      ;
+dims :  { $$ = (listdim*) NULL; }
+      | '(' dimlist ')'
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
+        }
+      ;
+dimlist :
+        dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
+        }
+      | dimlist ',' dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
+        }
+      ;
+dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
+      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
+      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
+      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
+      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
+      ;
+ubound :
+        '*'                 { strcpy($$,"*"); }
+      | expr                { strcpy($$,$1);  }
+      ;
+expr :  uexpr               { strcpy($$,$1); }
+      | complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
+      ;
+
+predefinedfunction :
+        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
+      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
+      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
+      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
+      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
+      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
+      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
+      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
+      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
+      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
+      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
+      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
+      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
+      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
+      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
+      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
+      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
+      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
+      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
+      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
+      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
+      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
+      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
+      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
+      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
+      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
+      ;
+minmaxlist : expr {strcpy($$,$1);}
+      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
+      ;
+uexpr : lhs                     { strcpy($$,$1); }
+      | simple_const            { strcpy($$,$1); }
+      | vec                     { strcpy($$,$1); }
+      | expr operation          { sprintf($$,"%s%s",$1,$2); }
+      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
+      ;
+signe : '+'        { strcpy($$,"+"); }
+      | '-'        { strcpy($$,"-"); }
+      ;
+
+operation :
+        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
+      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
+      | '*' expr                    { sprintf($$,"*%s",$2); }
+      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
+      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
+      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
+      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
+      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
+      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
+      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
+      | '=' after_equal             { sprintf($$,"%s",$2); }
+
+after_slash :                   { strcpy($$,""); }
+      | expr                    { sprintf($$,"/%s",$1); }
+      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
+      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
+      ;
+after_equal :
+        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
+      | expr                    { sprintf($$,"= %s",$1); }
+      ;
+
+lhs :   ident                           { strcpy($$,$1); }
+      | structure_component             { strcpy($$,$1); }
+      | array_ele_substring_func_ref    { strcpy($$,$1); }
+      ;
+
+beforefunctionuse :
+        {
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+array_ele_substring_func_ref :
+        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
+      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
+      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
+      ;
+begin_array :
+        ident '(' funarglist ')'
+        {
+            if ( inside_type_declare ) break;
+            sprintf($$," %s ( %s )",$1,$3);
+            ModifyTheAgrifFunction_0($3);
+            agrif_parentcall = 0;
+        }
+      ;
+structure_component :
+        lhs '%' declare_after_percent lhs
+        {
+            sprintf($$," %s %% %s ",$1,$4);
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+      ;
+vec :
+        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
+      ;
+funarglist :
+        beforefunctionuse           { strcpy($$," "); }
+      | beforefunctionuse funargs   { strcpy($$,$2); }
+      ;
+funargs :
+        funarg              {  strcpy($$,$1); }
+      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
+      ;
+funarg :
+        expr       {strcpy($$,$1);}
+      | triplet    {strcpy($$,$1);}
+      ;
+triplet :
+        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
+      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
+      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
+      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
+      | ':' expr                {  sprintf($$,":%s",$2);}
+      | expr ':'                {  sprintf($$,"%s :",$1);}
+      | ':'                     {  sprintf($$,":");}
+      ;
+ident : TOK_NAME
+        {
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction($1) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp($1,identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,$1);
+                    pointedvar = 0;
+
+                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
+                    else                    strcpy(truename, $1);
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
+                            {
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
+                            }
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+      ;
+simple_const :
+        TOK_TRUE     { strcpy($$,".TRUE.");}
+      | TOK_FALSE    { strcpy($$,".FALSE.");}
+      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
+      | TOK_CSTINT   { strcpy($$,$1); }
+      | TOK_CSTREAL  { strcpy($$,$1); }
+      | TOK_HEXA     { strcpy($$,$1); }
+      | simple_const TOK_NAME
+                     { sprintf($$,"%s%s",$1,$2); }
+      | string_constant opt_substring
+      ;
+string_constant :
+        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
+      | string_constant TOK_CHAR_CONSTANT
+      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
+      | TOK_CHAR_CUT                        { strcpy($$,$1);}
+      ;
+opt_substring :     { strcpy($$," ");}
+      | substring   { strcpy($$,$1);}
+      ;
+substring :
+        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
+      ;
+optexpr :           { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+opt_expr :
+        '\n'        { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+initial_value :     { InitialValueGiven = 0; }
+      | '=' expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 1;
+        }
+      | TOK_POINT_TO expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 2;
+        }
+      ;
+complex_const :
+        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
+      ;
+use_stat :
+        word_use TOK_NAME
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", $2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use TOK_NAME ',' rename_list
+        {
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$4);
+                    coupletmp = $4;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+      | word_use TOK_NAME ',' TOK_ONLY ':' '\n'
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",$2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use  TOK_NAME ',' TOK_ONLY ':' only_list
+        {
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$6);
+                    coupletmp = $6;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
+                }
+            }
+        }
+      ;
+word_use :
+        TOK_USE
+        {
+            pos_curuse = setposcur()-strlen($1);
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+      ;
+rename_list :
+        rename_name
+        {
+            $$ = $1;
+        }
+      | rename_list ',' rename_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+only_list :
+        only_name   {  $$ = $1; }
+      | only_list ',' only_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+only_name :
+        TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1($1);
+        }
+      | TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+
+/* R209 : execution-part-construct */
+execution-part-construct:
+        executable-construct
+      | format-stmt
+      ;
+
+/* R213 : executable-construct */
+executable-construct:
+        action-stmt
+      | do-construct
+      | case-construct
+      | if-construct
+      | where-construct
+      ;
+
+/* R214 : action-stmt */
+action-stmt :
+        TOK_CONTINUE
+      | ident_dims after_ident_dims
+      | goto
+      | call
+      | iofctl ioctl
+      | read option_read
+      | TOK_WRITE ioctl
+      | TOK_WRITE ioctl outlist
+      | TOK_REWIND after_rewind
+      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; }
+      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; }
+      | TOK_EXIT optexpr
+      | TOK_RETURN opt_expr
+      | TOK_CYCLE opt_expr
+      | stop opt_expr
+      | int_list
+      | TOK_NULLIFY '(' pointer_name_list ')'
+      | word_endunit
+        {
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+      | word_endprogram opt_name
+        {
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | word_endsubroutine opt_name
+        {
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+      | word_endfunction opt_name
+        {
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | TOK_ENDMODULE opt_name
+        {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+      | if-stmt
+      | where-stmt
+      | TOK_CONTAINS
+        {
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+      ;
+
+/* R601 : variable */
+//variable : expr
+//       ;
+
+/* R734 : assignment-stmt */
+// assignment-stmt: variable '=' expr
+//       ;
+assignment-stmt: expr
+      ;
+
+/* R741 : where-stmt */
+where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
+      ;
+
+/* R742 : where-construct */
+where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
+      ;
+
+opt-where-body-construct:
+      | opt-where-body-construct where-body-construct line-break
+      ;
+
+opt-masked-elsewhere-construct :
+      | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+opt-elsewhere-construct:
+      | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+/* R743 : where-construct-stmt */
+where-construct-stmt:
+        TOK_WHERE '(' mask-expr ')'
+      ;
+
+/* R744 : where-body-construct */
+where-body-construct: where-assignment-stmt
+      | where-stmt
+      | where-construct
+      ;
+
+/* R745 : where-assignment-stmt */
+where-assignment-stmt: assignment-stmt
+      ;
+
+/* R746 : mask-expr */
+mask-expr: expr
+      ;
+
+/* R747 : masked-elsewhere-stmt */
+masked-elsewhere-stmt:
+        TOK_ELSEWHEREPAR mask-expr ')'
+      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
+      ;
+
+/* R748: elsewhere-stmt */
+elsewhere-stmt:
+        TOK_ELSEWHERE
+      | TOK_ELSEWHERE TOK_NAME
+      ;
+
+/* R749: end-where-stmt */
+end-where-stmt:
+        TOK_ENDWHERE
+      | TOK_ENDWHERE TOK_NAME
+      ;
+
+/* R752 : forall-header */
+forall-header :
+     ;
+
+/* R801 : block */
+block:
+      |block execution-part-construct
+      |block execution-part-construct line-break
+      ;
+
+/* R813 : do-construct */
+do-construct:
+        block-do-construct
+      ;
+
+/* R814 : block-do-construct */
+block-do-construct:
+        do-stmt line-break do-block end-do
+      ;
+
+/* R815 : do-stmt */
+do-stmt:
+        label-do-stmt
+      | nonlabel-do-stmt
+      ;
+
+/* R816 : label-do-stmt */
+label-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO label
+      |              TOK_PLAINDO label
+      | TOK_NAME ':' TOK_PLAINDO label loop-control
+      |              TOK_PLAINDO label loop-control
+      ;
+
+/* R817 : nonlabel-do-stmt */
+nonlabel-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO
+      |              TOK_PLAINDO
+      | TOK_NAME ':' TOK_PLAINDO loop-control
+      |              TOK_PLAINDO loop-control
+      ;
+
+/* R818 : loop-control */
+loop-control:
+        opt_comma do-variable '=' expr ',' expr
+      | opt_comma do-variable '=' expr ',' expr ',' expr
+      | opt_comma TOK_WHILE '(' expr ')'
+      | opt_comma TOK_CONCURRENT forall-header
+      ;
+
+/* R819 : do-variable */
+do-variable : ident
+     ;
+
+/* R820 : do-block */
+do-block: block
+     ;
+
+/* R821 : end-do */
+end-do: end-do-stmt
+     | continue-stmt
+     ;
+
+/* R822 : end-do-stmt */
+end-do-stmt:
+        TOK_ENDDO
+      | TOK_ENDDO TOK_NAME
+      ;
+
+/* R832 : if-construct */
+if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
+      ;
+
+opt-else-if-stmt-block:
+      | else-if-stmt-block
+      | opt-else-if-stmt-block else-if-stmt-block
+      ;
+
+else-if-stmt-block:
+        else-if-stmt line-break block
+      ;
+
+opt-else-stmt-block:
+      | else-stmt-block
+      | opt-else-stmt-block else-if-stmt-block
+      ;
+
+else-stmt-block: else-stmt line-break block
+        ;
+
+/* R833 : if-then-stmt */
+if-then-stmt:
+         TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
+      |               TOK_LOGICALIF '(' expr ')' TOK_THEN
+      ;
+
+/* R834 : else-if-stmt */
+else-if-stmt:
+        TOK_ELSEIF '(' expr ')' TOK_THEN
+      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
+      ;
+
+/* R835 : else-stmt */
+else-stmt:
+        TOK_ELSE
+      | TOK_ELSE TOK_NAME
+      ;
+
+/* R836 : end-if-stmt */
+end-if-stmt:
+        TOK_ENDIF
+      | TOK_ENDIF TOK_NAME
+      ;
+
+/* R837 : if-stmt */
+if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
+        ;
+
+/* R838 : case-construct */
+case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
+        ;
+
+opt_case-stmt-block:
+        | case-stmt-block
+        | opt_case-stmt-block case-stmt-block
+        ;
+
+case-stmt-block: case-stmt line-break block
+        ;
+
+/* R839 : select-case-stmt */
+select-case-stmt :
+          TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
+        |              TOK_SELECTCASE '(' expr ')'
+        ;
+
+/* R840 : case-stmt */
+case-stmt:
+          TOK_CASE case-selector
+        | TOK_CASE case-selector TOK_NAME
+        ;
+
+/* R840 : end-select-stmt */
+end-select-stmt:
+          TOK_ENDSELECT
+        | TOK_ENDSELECT TOK_NAME
+        ;
+
+/* R843 : case-selector */
+case-selector:
+          '(' case-value-range-list ')'
+        | TOK_DEFAULT
+        ;
+
+case-value-range-list:
+        case-value-range
+      | case-value-range-list ',' case-value-range
+      ;
+
+/* R844: case-value-range */
+case-value-range :
+        case-value
+      | case-value ':'
+      | ':' case-value
+      | case-value ':' case-value
+      ;
+
+/* R845 : case-value */
+case-value: expr
+        ;
+
+/* R854 : continue-stmt */
+continue-stmt: TOK_CONTINUE
+        ;
+
+/* R1001 : format-stmt */
+format-stmt: TOK_FORMAT
+        ;
+
+word_endsubroutine :
+        TOK_ENDSUBROUTINE
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+            functiondeclarationisdone = 0;
+        }
+      ;
+word_endunit :
+        TOK_ENDUNIT
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endprogram :
+        TOK_ENDPROGRAM
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endfunction :
+        TOK_ENDFUNCTION
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+
+opt_name : '\n'  {strcpy($$,"");}
+      | TOK_NAME {strcpy($$,$1);}
+      ;
+
+before_dims : { created_dimensionlist = 0; }
+      ;
+ident_dims :
+        ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+            if ( ($3 == NULL) || ($4 == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0($3->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+      | ident_dims '%' declare_after_percent ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+        }
+      ;
+int_list :
+        TOK_CSTINT
+      | int_list ',' TOK_CSTINT
+      ;
+after_ident_dims :
+        '=' expr
+      | TOK_POINT_TO expr
+      ;
+call :  keywordcall opt_call
+        {
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+      ;
+opt_call :
+      | '(' opt_callarglist  ')'
+      ;
+opt_callarglist :
+      | callarglist
+      ;
+keywordcall :
+        before_call TOK_FLUSH
+      | before_call TOK_NAME
+        {
+            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp($2,"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber($2) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
+      ;
+callarglist :
+        callarg
+      | callarglist ',' callarg
+      ;
+callarg :
+        expr
+        {
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,$1);
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+      | '*' TOK_CSTINT
+      ;
+
+stop :  TOK_PAUSE
+      | TOK_STOP
+      ;
+
+option_inlist :
+      | inlist
+      ;
+option_read :
+        ioctl option_inlist
+      | infmt opt_inlist
+      ;
+opt_inlist :
+      | ',' inlist
+      ;
+ioctl : '(' ctllist ')'
+      ;
+after_rewind :
+        '(' ident ')'
+      | '(' TOK_CSTINT ')'
+      | TOK_CSTINT
+      | '(' uexpr ')'
+      | TOK_NAME
+      ;
+ctllist :
+        ioclause
+      | ctllist ',' ioclause
+      ;
+ioclause :
+        fexpr
+      | '*'
+      | TOK_DASTER
+      | ident expr dims
+      | ident expr '%' declare_after_percent ident_dims
+      | ident '(' triplet ')'
+      | ident '*'
+      | ident TOK_DASTER
+      ;
+
+declare_after_percent:      { afterpercent = 1; }
+      ;
+iofctl :
+        TOK_OPEN
+      | TOK_CLOSE
+      | TOK_FLUSH
+      ;
+infmt :  unpar_fexpr
+      | '*'
+      ;
+
+read :  TOK_READ
+      | TOK_INQUIRE
+      | TOK_PRINT
+      ;
+
+fexpr : unpar_fexpr
+      | '(' fexpr ')'
+      ;
+unpar_fexpr :
+        lhs
+      | simple_const
+      | fexpr addop fexpr %prec '+'
+      | fexpr '*' fexpr
+      | fexpr TOK_SLASH fexpr
+      | fexpr TOK_DASTER fexpr
+      | addop fexpr %prec '*'
+      | fexpr TOK_DSLASH fexpr
+      | TOK_FILE expr
+      | TOK_UNIT expr
+      | TOK_NML expr
+      | TOK_FMT expr
+      | TOK_EXIST expr
+      | TOK_ERR expr
+      | TOK_END expr
+      | TOK_NAME '=' expr
+      | predefinedfunction
+      ;
+addop : '+'
+      | '-'
+      ;
+inlist : inelt
+      | inlist ',' inelt
+      ;
+// opt_lhs :
+//       | lhs
+//       ;
+inelt : //opt_lhs opt_operation
+        lhs opt_operation
+      | '(' inlist ')' opt_operation
+      | predefinedfunction opt_operation
+      | simple_const opt_operation
+      | '(' inlist ',' dospec ')'
+      ;
+opt_operation :
+      | operation
+      | opt_operation operation
+      ;
+outlist :
+        complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | uexpr               { strcpy($$,$1); }
+      | other               { strcpy($$,$1); }
+      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      ;
+other :
+        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+dospec :
+        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
+      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
+      ;
+goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
+      | TOK_PLAINGOTO TOK_CSTINT
+      ;
+allocation_list :
+        allocate_object
+      | allocation_list ',' allocate_object
+      ;
+allocate_object :
+        lhs     { Add_Allocate_Var_1($1,curmodulename); }
+      ;
+allocate_object_list :
+        allocate_object
+      | allocate_object_list ',' allocate_object
+      ;
+opt_stat_spec :
+      | ',' TOK_STAT '=' lhs
+      ;
+pointer_name_list :
+        ident
+      | pointer_name_list ',' ident
+      ;
+
+%%
+
+void process_fortran(const char *input_file)
+{
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
+/******************************************************************************/
+/*  1-  Open input file                                                       */
+/******************************************************************************/
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 8732)
@@ -0,0 +1,542 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                           Add_Common_var_1                                 */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/*     List_Common_Var                                                        */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Common_var_1()
+{
+    listvar *newvar;
+    listvar *newvar2;
+    variable *newvariable;
+    listdim *dims;
+    char listdimension[LONG_M];
+    char ligne[LONG_M];
+    int out;
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvariable = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvariable);
+
+        strcpy(newvariable->v_nomvar,commonvar);
+        strcpy(newvariable->v_commonname,commonblockname);
+        strcpy(newvariable->v_modulename,curmodulename);
+        strcpy(newvariable->v_subroutinename,subroutinename);
+        strcpy(newvariable->v_commoninfile,cur_filename);
+        newvariable->v_positioninblock = positioninblock;
+        newvariable->v_common = 1;
+        newvar->var = newvariable;
+
+        if ( commondim )
+        {
+            newvariable->v_dimension = commondim;
+            newvariable->v_dimensiongiven = 1;
+            newvariable->v_nbdim = get_num_dims(commondim);
+
+            /* Creation of the string for the dimension of this variable            */
+            dimsempty = 1;
+            strcpy(listdimension,"");
+
+            dims = commondim;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") ||
+                     strcasecmp(dims->dim.last,""))  dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv ) strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvariable->v_dimsempty = 1;
+
+            strcpy(newvariable->v_readedlistdimension,listdimension);
+            Save_Length(listdimension,15);
+        }
+
+        newvar->suiv = NULL;
+
+        if ( !List_Common_Var )
+        {
+            List_Common_Var = newvar;
+        }
+        else
+        {
+            newvar2 = List_Common_Var;
+            out = 0 ;
+            while ( newvar2 && out == 0 )
+            {
+                if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
+                     !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
+                     !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
+                   ) out = 1 ;
+                else newvar2 = newvar2->suiv;
+            }
+            if ( out == 0 )
+            {
+                newvar->suiv = List_Common_Var;
+                List_Common_Var = newvar;
+            }
+            else
+            {
+                free(newvar);
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                           Addtolistnom                                     */
+/******************************************************************************/
+/* This subroutine is used to add a variable to the list                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+listnom *Addtolistnom(const char *nom, listnom *listin, int value)
+{
+    listnom *newnom;
+    listnom *parcours;
+    int out;
+
+    newnom = (listnom*) calloc(1, sizeof(listnom));
+    strcpy(newnom->o_nom, nom);
+    newnom->o_val = value;
+    newnom->suiv = NULL;
+
+    if ( listin == NULL )
+    {
+        listin = newnom;
+    }
+    else
+    {
+        parcours = listin;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom->suiv = listin;
+            listin = newnom;
+        }
+        else
+        {
+            free(newnom);
+        }
+    }
+    return listin;
+}
+
+/******************************************************************************/
+/*                           Addtolistname                                    */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listname *Addtolistname(const char *nom, listname *input)
+{
+    listname *newnom;
+    listname *parcours;
+    int out;
+
+    if ( !input )
+    {
+        newnom = (listname*) calloc(1, sizeof(listname));
+        strcpy(newnom->n_name, nom);
+        newnom->suiv = NULL;
+        input = newnom;
+    }
+    else
+    {
+        parcours = input;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom = (listname*) calloc(1,sizeof(listname));
+            strcpy(newnom->n_name, nom);
+            newnom->suiv = input;
+            input = newnom;
+        }
+    }
+    return input;
+}
+
+/******************************************************************************/
+/*                    ModuleIsDefineInInputFile                               */
+/******************************************************************************/
+/* This subroutine is used to know if the module is defined in the input file */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int ModuleIsDefineInInputFile(const char *name)
+{
+    listnom *newnom;
+    int out;
+
+    out = 0;
+    if ( listofmodules )
+    {
+        newnom = listofmodules;
+        while( newnom && out == 0 )
+        {
+            if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
+            else newnom = newnom->suiv;
+        }
+    }
+    return out;
+}
+
+/******************************************************************************/
+/*                      Addmoduletothelisttmp                                 */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/* listusemodule                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... USE mod1 ===> insert in list                      */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  listofmoduletmp                                              */
+/*                                                                            */
+/******************************************************************************/
+void Addmoduletothelisttmp(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    if ( !listofmoduletmp )
+    {
+        newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newmodule->u_usemodule, name);
+        strcpy(newmodule->u_cursubroutine, subroutinename);
+        newmodule->suiv = NULL;
+        listofmoduletmp = newmodule ;
+    }
+    else
+    {
+        parcours = listofmoduletmp;
+        out = 0;
+        while( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+            strcpy(newmodule->u_usemodule, name);
+            strcpy(newmodule->u_cursubroutine, subroutinename);
+            newmodule->suiv = listofmoduletmp;
+            listofmoduletmp = newmodule;
+        }
+    }
+}
+
+/******************************************************************************/
+/*                          Add_NameOfModule_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfModule_1(const char *nom)
+{
+    listnom *newnom;
+
+    if ( firstpass == 1 )
+    {
+        newnom = (listnom *) calloc(1,sizeof(listnom));
+        strcpy(newnom->o_nom,nom);
+        newnom->suiv = List_NameOfModule;
+        List_NameOfModule = newnom;
+    }
+}
+
+/******************************************************************************/
+/*                          Add_NameOfCommon_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename)
+{
+    listnom *newnom;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = List_NameOfCommon;
+        while ( parcours && strcasecmp(parcours->o_nom,nom) )
+            parcours = parcours->suiv;
+        if ( !parcours )
+        {
+            newnom = (listnom *) calloc(1,sizeof(listnom));
+            strcpy(newnom->o_nom,nom);
+            strcpy(newnom->o_subroutinename,cursubroutinename);
+            newnom->suiv = List_NameOfCommon;
+            List_NameOfCommon = newnom;
+        }
+    }
+}
+
+/******************************************************************************/
+/*                     Add_CouplePointed_Var_1                                */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the listvarpointtovar                                   */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple)
+{
+    listvarpointtovar *pointtmp;
+
+    /* we should complete the List_CouplePointed_Var                        */
+    pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar));
+    strcpy(pointtmp->t_usemodule, namemodule);
+    strcpy(pointtmp->t_cursubroutine, subroutinename);
+    pointtmp->t_couple = couple;
+    if ( List_CouplePointed_Var )
+    {
+        pointtmp->suiv = List_CouplePointed_Var;
+    }
+    else
+    {
+        pointtmp->suiv = NULL;
+    }
+    List_CouplePointed_Var = pointtmp;
+}
+
+/******************************************************************************/
+/*                           Add_Include_1                                    */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/*  List_Include                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... include mod1 ===> insert in list                  */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  List_Include                                                 */
+/*                                                                            */
+/******************************************************************************/
+void Add_Include_1(const char *name)
+{
+    listusemodule *newinclude;
+
+    if ( firstpass == 1 )
+    {
+        newinclude = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newinclude->u_usemodule,name);
+        strcpy(newinclude->u_cursubroutine,subroutinename);
+
+        newinclude->suiv = List_Include;
+        List_Include  = newinclude ;
+    }
+}
+
+/******************************************************************************/
+/*                     Add_ImplicitNoneSubroutine_1                           */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_ImplicitNoneSubroutine_1()
+{
+    if ( firstpass == 1 )
+        List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine);
+}
+
+/******************************************************************************/
+/*                        WriteIncludeDeclaration                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteIncludeDeclaration(FILE* tofile)
+{
+  listusemodule *newinclude;
+
+  newinclude = List_Include;
+  fprintf(tofile,"\n");
+  while ( newinclude )
+  {
+     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
+     {
+        fprintf(tofile, "      include %s\n",newinclude->u_usemodule);
+     }
+     newinclude = newinclude ->suiv;
+  }
+}
+
+/******************************************************************************/
+/*                          Add_Save_Var_1                                    */
+/******************************************************************************/
+/* This subroutine is used to add a record to List_Save_Var                   */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ Save +--->+ Save +--->+ Save +--->+  Save+             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void Add_Save_Var_1 (const char *name, listdim *d)
+{
+    listvar *newvar;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        newvar->var->v_save = 1;
+        strcpy(newvar->var->v_nomvar,name);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+
+        newvar->var->v_dimension = d;
+
+        /* Creation of the string for the dimension of this variable             */
+        dimsempty = 1;
+
+        if ( d )
+        {
+            newvar->var->v_dimensiongiven = 1;
+            dims = d;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+                    dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv )   strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1;
+        }
+
+        newvar->suiv = List_Save_Var;
+        List_Save_Var = newvar;
+    }
+}
+
+void Add_Save_Var_dcl_1 (listvar *var)
+{
+    listvar *newvar;
+    listvar *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = var;
+        while ( parcours )
+        {
+            newvar = (listvar *) calloc(1,sizeof(listvar));
+            newvar->var = (variable *) calloc(1,sizeof(variable));
+
+            Init_Variable(newvar->var);
+
+            newvar->var->v_save = 1;
+            strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+            strcpy(newvar->var->v_modulename,curmodulename);
+            strcpy(newvar->var->v_subroutinename,subroutinename);
+            strcpy(newvar->var->v_commoninfile,cur_filename);
+            strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension);
+
+            newvar->var->v_nbdim = parcours->var->v_nbdim;
+            newvar->var->v_catvar = parcours->var->v_catvar;
+            newvar->var->v_dimension = parcours->var->v_dimension;
+            newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
+            newvar->suiv = List_Save_Var;
+            List_Save_Var = newvar;
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 8732)
@@ -0,0 +1,66 @@
+OBJS = main.o WriteInFile.o toamr.o fortran.o  \
+       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
+       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
+       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
+       UtilNotGridDep.o WorkWithlistdatavariable.o \
+       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
+       UtilCharacter.o UtilListe.o UtilFile.o \
+       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
+       WorkWithlistofcoupled.o
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+all: conv
+	@echo
+	@echo ===================================================
+	@echo   CONV is ok
+	@echo ===================================================
+	@echo
+
+#main.c: convert.y convert.lex
+#	@echo ===================================================
+#	@echo   Rebuilding main.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex main.c
+
+#fortran.c: fortran.y fortran.lex
+#	@echo ===================================================
+#	@echo   Rebuilding fortran.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex fortran.c
+
+conv: $(OBJS)
+	$(CC) $(CFLAGS) -g $(OBJS) -o ../$@
+
+%.o: %.c
+	$(CC) $(CFLAGS) -g -c $< -o $@
+
+main.o : main.c
+fortran.o : fortran.c	
+toamr.o : toamr.c decl.h
+WriteInFile.o : WriteInFile.c decl.h
+dependfile.o : dependfile.c decl.h
+SubLoopCreation.o : SubLoopCreation.c decl.h
+WorkWithglobliste.o : WorkWithglobliste.c decl.h
+WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
+WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
+Writedeclarations.o : Writedeclarations.c decl.h
+UtilFortran.o : UtilFortran.c decl.h
+WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
+UtilNotGridDep.o : UtilNotGridDep.c decl.h
+WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
+DiversListe.o : DiversListe.c decl.h
+UtilAgrif.o : UtilAgrif.c decl.h
+WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
+UtilCharacter.o : UtilCharacter.c decl.h
+UtilListe.o : UtilListe.c decl.h
+UtilFile.o : UtilFile.c decl.h
+WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
+WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
+WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
+
+clean:
+#	$(MAKE) -f Makefile.lex clean
+	$(RM) *.o conv
+	
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 8732)
@@ -0,0 +1,404 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+/******************************************************************************/
+/*     preparation and write of the argument list of a subroutine             */
+/******************************************************************************/
+
+
+/******************************************************************************/
+/*                           WriteBeginof_SubLoop                             */
+/******************************************************************************/
+/* We should write the head of the subroutine sub_loop_<subroutinename>       */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteBeginof_SubLoop()
+{
+   if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename);
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n");
+      /* we should add the use agrif_uti l if it is necessary                 */
+      WriteHeadofSubroutineLoop();
+      WriteUsemoduleDeclaration(subroutinename);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteIncludeDeclaration(fortran_out);
+      /*                                                                      */
+      /* We should write once the declaration of tables (extract              */
+      /*    from pointer) in the new subroutine                               */
+      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out);
+
+      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out);
+      WriteArgumentDeclaration_Sort(fortran_out);
+      WriteFunctionDeclaration(fortran_out, 1);
+   }
+   else
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n");
+      AddUseAgrifUtil_0(fortran_out);
+      WriteUsemoduleDeclaration(subroutinename);
+      WriteIncludeDeclaration(fortran_out);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
+      WriteArgumentDeclaration_beforecall();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1);
+/*    writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/
+   }
+   if ( todebug == 1 ) printf("<   out of WriteBeginof_SubLoop\n");
+   if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename);
+}
+
+/******************************************************************************/
+/*                    WriteVariablelist_subloop                               */
+/******************************************************************************/
+/* This subroutine is used to write the list of the variable which            */
+/* should be called by the sub_loop_<name> subroutine                         */
+/* The first part is composed by the list of the local variables              */
+/******************************************************************************/
+/*                                                                            */
+/*    List_SubroutineDeclaration_Var    a,b,c,  &                             */
+/*                                      d,e,f,  &                             */
+/*     a,b,c,d,e,f,g,h     ========>    g,h                                   */
+/*                                                                            */
+/******************************************************************************/
+void WriteVariablelist_subloop(char *ligne)
+{
+   listvar *parcours;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n");
+   parcours = List_SubroutineArgument_Var;
+   didvariableadded = 0;
+
+   while ( parcours )
+   {
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subroutinename we should write the name of this variable          */
+      /*    in the output file                                                */
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+      {
+         if ( didvariableadded == 1 )   strcat(ligne,",");
+         strcat(ligne,parcours->var->v_nomvar);
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   parcours = List_FunctionType_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+      {
+         if ( didvariableadded == 1 )   strcat(ligne,",");
+         strcat(ligne,parcours->var->v_nomvar);
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop\n");
+}
+
+
+/******************************************************************************/
+/*                     WriteVariablelist_subloop_Call                         */
+/******************************************************************************/
+/* This subroutine is used to write the list of the variable which            */
+/* should be called by the sub_loop_<name> subroutine into the called         */
+/* The second part is composed by the list of the global table                */
+/******************************************************************************/
+/*                                                                            */
+/*   List_UsedInSubroutine_Var SubloopScalar = 0 | SubloopScalar = 1          */
+/*                                a,b,c,  &      |  a,b(1,1),c,      &        */
+/*     a,b,c,d,e,f,g,h  =====>    d,e,f,  &      |  d(1),e(1,1,1),f, &        */
+/*                                g,h            |  g,h(1,1)                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteVariablelist_subloop_Call(char **ligne, size_t line_length)
+{
+   listvar *parcours;
+   char ligne2[LONG_M];
+   int i;
+   size_t cur_length;
+
+   cur_length = line_length;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n");
+   parcours = List_UsedInSubroutine_Var;
+
+   while ( parcours )
+   {
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subroutinename we should write the name of this variable          */
+      /*    in the output file                                                */
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
+         )
+      {
+         if ( didvariableadded == 1 )   strcat(*ligne,",");
+         const char *vres = vargridcurgridtabvars(parcours->var, 0);
+         if ( (strlen(*ligne)+strlen(vres)+100) > cur_length )
+         {
+            cur_length += LONG_M;
+            *ligne = realloc( *ligne, cur_length*sizeof(char) );
+         }
+         strcat(*ligne, vres);
+         /* if it is asked in the call of the conv we should give             */
+         /* scalar in argument, so we should put (1,1,1) after the            */
+         /* the name of the variable                                          */
+         if (  SubloopScalar != 0 &&
+               (
+               (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))) &&
+               parcours->var->v_nbdim != 0 )
+         {
+             i = 1;
+             while ( i <=  parcours->var->v_nbdim )
+             {
+                if ( i == 1 ) strcat(*ligne,"( ");
+                if ( SubloopScalar == 2 )
+                {
+                   strcat(*ligne,":");
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,",");
+                }
+                else
+                {
+                   sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i);
+                   strcat(*ligne,ligne2);
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),");
+                }
+                if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))");
+                i++;
+             }
+         }
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Call\n");
+}
+
+
+/******************************************************************************/
+/*                       WriteVariablelist_subloop_Def                        */
+/******************************************************************************/
+/* This subroutine is used to write the list of the variable which            */
+/* should be called by the sub_loop_<name> subroutine into the def            */
+/* The second part is composed by the list of the global table                */
+/* <name>_tmp                                                                 */
+/******************************************************************************/
+/*                                                                            */
+/*       List_UsedInSubroutine_Var                                            */
+/*                                a-tmp,b-tmp,c_tmp, &                        */
+/*     a,b,c,d,e,f,g,h  =====>    d_tmp,e_tmp,f_tmp, &                        */
+/*                                g_tmp,h_tmp                                 */
+/*                                                                            */
+/******************************************************************************/
+void WriteVariablelist_subloop_Def(char *ligne)
+{
+   listvar *parcours;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n");
+   parcours = List_UsedInSubroutine_Var;
+
+   while ( parcours )
+   {
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subrotinename we should write the name of this variable           */
+      /*    in the output file                                                */
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) )
+      {
+         if ( didvariableadded == 1 )   strcat(ligne,",");
+         strcat(ligne,parcours->var->v_nomvar);
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   Save_Length(ligne,41);
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Def\n");
+}
+
+/******************************************************************************/
+/*                      WriteHeadofSubroutineLoop                             */
+/******************************************************************************/
+/* This subroutine is used to write the head of the subroutine                */
+/* Sub_Loop_<name>                                                            */
+/******************************************************************************/
+/*                 Sub_loop_subroutine.h                                      */
+/*                                                                            */
+/*                 subroutine Sub_Loop_subroutine ( &                         */
+/*                 a,b,c, &                                                   */
+/* SubLoopScalar   d,e(1,1),f(1,1,1), &                                       */
+/*                 g,h  &                                                     */
+/*                 )                                                          */
+/******************************************************************************/
+void WriteHeadofSubroutineLoop()
+{
+   char ligne[LONG_M];
+   FILE * subloop;
+
+   if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n");
+   tofich(fortran_out,"\n",1);
+   /* Open this newfile                                                       */
+   sprintf(ligne,"Sub_Loop_%s.h",subroutinename);
+   subloop = open_for_write(ligne);
+   /*                                                                         */
+   if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename);
+   else             sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename);
+   /*                                                                         */
+   WriteVariablelist_subloop(ligne);
+   WriteVariablelist_subloop_Def(ligne);
+   /*                                                                         */
+   strcat(ligne,")");
+   tofich(subloop,ligne,1);
+   /* if USE agrif_Uti l should be add                                        */
+   AddUseAgrifUtil_0(subloop);
+   /*                                                                         */
+   oldfortran_out = fortran_out;
+   fortran_out = subloop;
+   if ( todebug == 1 ) printf("<   out of WriteHeadofSubroutineLoop\n");
+}
+
+/******************************************************************************/
+/*                closeandcallsubloopandincludeit_0                           */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should close the sub_loop subroutine, call it and close the             */
+/* function (suborfun = 0)                                                    */
+/* subroutine (suborfun = 1)                                                  */
+/* end (suborfun = 2)                                                         */
+/* end program (suborfun = 3)                                                 */
+/* and include the sub_loop subroutine after                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void closeandcallsubloopandincludeit_0(int suborfun)
+{
+   char *ligne;
+
+   if ( firstpass == 1 )    return;
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n");
+
+   ligne = (char*) calloc(LONG_M, sizeof(char));
+
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should remove the key word end subroutine                         */
+      RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine);
+      /* We should close the loop subroutine                                  */
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
+      WriteArgumentDeclaration_beforecall();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
+      if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
+            fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
+      /* Now we add the call af the new subroutine                            */
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
+      /* Write the list of the local variables used in this new subroutine    */
+      WriteVariablelist_subloop(ligne);
+      /* Write the list of the global tables used in this new subroutine      */
+      /*    in doloop                                                         */
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
+      /* Close the parenthesis of the new subroutine called                   */
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
+      /* we should include the above file in the original code                */
+
+      /* We should close the original subroutine                              */
+      if ( suborfun == 3 ) fprintf(fortran_out, "      end program %s\n"   , subroutinename);
+      if ( suborfun == 2 ) fprintf(fortran_out, "      end\n");
+      if ( suborfun == 1 ) fprintf(fortran_out, "      end subroutine %s\n", subroutinename);
+      if ( suborfun == 0 ) fprintf(fortran_out, "      end function %s\n"  , subroutinename);
+
+      fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename);
+    }
+    oldfortran_out = (FILE *)NULL;
+    if ( todebug == 1 ) printf("<   out of closeandcallsubloopandincludeit_0\n");
+}
+
+void closeandcallsubloop_contains_0()
+{
+   char *ligne;
+
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n");
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      ligne = (char*) calloc(LONG_M, sizeof(char));
+      RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
+
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
+      WriteArgumentDeclaration_beforecall();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
+/*      WriteSubroutineDeclaration(0);*/
+      if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
+          fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
+      /* Now we add the call af the new subroutine                            */
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
+      /* Write the list of the local variables used in this new subroutine    */
+      WriteVariablelist_subloop(ligne);
+      /* Write the list of the global tables used in this new subroutine      */
+      /*    in doloop                                                         */
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
+      /* Close the parenthesis of the new subroutine called                   */
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
+      /* We should close the original subroutine                              */
+      fprintf(fortran_out, "      contains\n");
+      /* we should include the above file in the original code                */
+      fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename);
+      }
+   oldfortran_out = (FILE *)NULL;
+   if ( todebug == 1 ) printf("<   out of closeandcallsubloop_contains_0\n");
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 8732)
@@ -0,0 +1,838 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+/******************************************************************************/
+/*                      Vartonumber                                           */
+/******************************************************************************/
+/* This subroutine is used to know if Agrif_ is locate in the char            */
+/* tokname                                                                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int Vartonumber(const char *tokname)
+{
+   int agrifintheword;
+
+   agrifintheword = 0;
+        if ( !strcasecmp(tokname,"Agrif_parent")         ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_type")       ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_raf")        ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_bc")         ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_bcinterp")   ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Root")           ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_CFixed")         ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Fixed")          ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_bc_variable")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_parent")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_interp_variable")) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_init_variable")  ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_update_variable")) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_interp")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_Update")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_init_grids")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_step")           ) agrifintheword = 1;
+/**************************************************/
+/* adding specific adjoint agrif subroutine names */
+/**************************************************/
+   else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1;
+
+   return agrifintheword;
+}
+
+/******************************************************************************/
+/*                              Agrif_in_Tok_NAME                             */
+/******************************************************************************/
+/* This subroutine is used to know if Agrif_ is locate in the char            */
+/* tokname                                                                    */
+/******************************************************************************/
+/*                                                                            */
+/*                 Agrif_name --------------> Agrif_in_Tok_NAME = 1           */
+/*                       name --------------> Agrif_in_Tok_NAME = 0           */
+/*                                                                            */
+/******************************************************************************/
+int Agrif_in_Tok_NAME(const char *tokname)
+{
+    return ( strncasecmp(tokname,"Agrif_",6) == 0 );
+}
+
+/******************************************************************************/
+/*                     ModifyTheVariableName_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheVariableName_0(const char *ident, int lengthname)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass )  return;
+
+    newvar = List_Global_Var;
+    out = 0;
+    while ( newvar && out == 0 )
+    {
+        if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1;
+        else newvar = newvar->suiv;
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return;
+
+    if ( out == 0 )
+    {
+        newvar = List_Common_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsedInModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+    {
+        // remove the variable
+        RemoveWordCUR_0(fortran_out,lengthname);
+        // then write the new name
+        if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
+            fprintf(fortran_out,"%d",newvar->var->v_indicetabvars);
+        else
+        {
+            if ( retour77 == 0 )
+                fprintf(fortran_out,"Agrif_%s & \n      ", tabvarsname(newvar->var));
+            else
+            {
+               fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var));
+               fprintf(fortran_out," \n     & ");
+            }
+            fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+        }
+    }
+    else
+    {
+        // we should look in the List_ModuleUsed_Var
+        if ( inagrifcallargument != 1 )
+        {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+            if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type"))
+            {
+                // remove the variable
+                RemoveWordCUR_0(fortran_out,lengthname);
+                // then write the new name
+                if ( retour77 == 0 )
+                    fprintf(fortran_out,"Agrif_%s & \n      ",tabvarsname(newvar->var));
+                else
+                {
+                    fprintf(fortran_out," \n     &Agrif_%s",tabvarsname(newvar->var));
+                }
+                fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                         Add_SubroutineWhereAgrifUsed_1                     */
+/******************************************************************************/
+/* This subroutine is used to add a record to                                 */
+/* List_SubroutineWhereAgrifUsed                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... Agrif_<something>                                 */
+/*                                                                            */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + list +--->+ list +--->+ list +--->+ list +--->+ sub  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list = List_SubroutineWhereAgrifUsed                                 */
+/*                                                                            */
+/******************************************************************************/
+void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod)
+{
+    listnom *listnomtmp;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        if ( !List_SubroutineWhereAgrifUsed )
+        {
+            listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+            strcpy(listnomtmp->o_nom, sub);
+            strcpy(listnomtmp->o_module, mod);
+            listnomtmp->suiv = NULL;
+            List_SubroutineWhereAgrifUsed = listnomtmp;
+        }
+        else
+        {
+            parcours = List_SubroutineWhereAgrifUsed;
+            while ( parcours && strcasecmp(parcours->o_nom,sub) )
+            {
+                parcours = parcours->suiv;
+            }
+            if ( !parcours )
+            {
+                listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+                strcpy(listnomtmp->o_nom, sub);
+                strcpy(listnomtmp->o_module, mod);
+                listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
+                List_SubroutineWhereAgrifUsed = listnomtmp;
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                                AddUseAgrifUtil_0                           */
+/******************************************************************************/
+/* Add use Agrif_Util at the beginning of the subroutine definition           */
+/* if it is necessary                                                         */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub            |  subroutine sub                          */
+/*                                 |  USE Agrif_Util                          */
+/*       implicit none             |  implicit none                           */
+/*       ...                       |  ...                                     */
+/*       ... Agrif_<something>     |  ... Agrif_<something>                   */
+/*       ...                       |  ...                                     */
+/*       end                       |  end                                     */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void  AddUseAgrifUtil_0(FILE *fileout)
+{
+  listnom *parcours;
+
+  if ( firstpass == 0 )
+  {
+     parcours = List_SubroutineWhereAgrifUsed;
+     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
+     {
+        parcours = parcours -> suiv;
+     }
+     if ( parcours && parcours->o_val != 0 )
+        fprintf(fileout,"\n      use Agrif_Util\n");
+     else
+        fprintf(fileout,"\n      use Agrif_Types, only : Agrif_tabvars\n");
+  }
+}
+
+void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
+{
+    listusemodule *parcours;
+
+    int out;
+
+    if ( firstpass == 0 )
+    {
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util")   &&
+                 !strcasecmp(parcours->u_modulename, curmodulename) &&
+                 !strcasecmp(parcours->u_cursubroutine, subroutinename) )
+                out = 1;
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            fprintf(fileout,"\n      use Agrif_Util\n");
+        }
+    }
+}
+
+/******************************************************************************/
+/*                         NotifyAgrifFunction_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void NotifyAgrifFunction_0(const char *ident)
+{
+    if ( firstpass == 1 )   return;
+
+    if ( !strcasecmp(ident,"Agrif_parent") )
+    {
+        InAgrifParentDef = 1;
+        pos_curagrifparent = setposcur()-12;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
+    {
+        InAgrifParentDef = 2;
+        pos_curagrifparent = setposcur()-21;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhox") )
+    {
+        InAgrifParentDef = 3;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
+    {
+        InAgrifParentDef = 4;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhox") )
+    {
+        InAgrifParentDef = 5;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
+    {
+        InAgrifParentDef = 6;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoy") )
+    {
+        InAgrifParentDef = 7;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
+    {
+        InAgrifParentDef = 8;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoy") )
+    {
+        InAgrifParentDef = 9;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
+    {
+        InAgrifParentDef = 10;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoz") )
+    {
+        InAgrifParentDef = 11;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
+    {
+        InAgrifParentDef = 12;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoz") )
+    {
+        InAgrifParentDef = 13;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
+    {
+        InAgrifParentDef = 14;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
+    {
+        InAgrifParentDef = 15;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
+    {
+        InAgrifParentDef = 16;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
+    {
+        InAgrifParentDef = 17;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
+    {
+        InAgrifParentDef = 18;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
+    {
+        InAgrifParentDef = 19;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
+    {
+        InAgrifParentDef = 20;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
+    {
+        InAgrifParentDef = 21;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
+    {
+        InAgrifParentDef = 22;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
+    {
+        InAgrifParentDef = 23;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
+    {
+        InAgrifParentDef = 24;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
+    {
+        InAgrifParentDef = 25;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iz") )
+    {
+        InAgrifParentDef = 26;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iy") )
+    {
+        InAgrifParentDef = 27;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Ix") )
+    {
+        InAgrifParentDef = 28;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-20;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
+    {
+        InAgrifParentDef = 30;
+        pos_curagrifparent = setposcur()-13;
+    }
+}
+
+/******************************************************************************/
+/*                       ModifyTheAgrifFunction_0                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheAgrifFunction_0(const char *ident)
+{
+   if ( InAgrifParentDef != 0 )
+          AgriffunctionModify_0(ident,InAgrifParentDef);
+   InAgrifParentDef = 0;
+}
+
+
+/******************************************************************************/
+/*                         AgriffunctionModify_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/* if whichone = 1 Agrif_parent ===>                                          */
+/*                                                                            */
+/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
+/*                                                                            */
+/* if whichone = 3 Agrif_Rhox ===>                                            */
+/*                                                                            */
+/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
+/*                                                                            */
+/* if whichone = 5 Agrif_IRhox ===>                                           */
+/*                                                                            */
+/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
+/*                                                                            */
+/* if whichone = 7 Agrif_Rhoy ===>                                            */
+/*                                                                            */
+/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
+/*                                                                            */
+/* if whichone = 9 Agrif_IRhoy ===>                                           */
+/*                                                                            */
+/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
+/*                                                                            */
+/* if whichone = 11 Agrif_Rhoz ===>                                           */
+/*                                                                            */
+/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
+/*                                                                            */
+/* if whichone = 13 Agrif_IRhoz ===>                                          */
+/*                                                                            */
+/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
+/*                                                                            */
+/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
+/*                                                                            */
+/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
+/*                                                                            */
+/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
+/*                                                                            */
+/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
+/*                                                                            */
+/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
+/*                                                                            */
+/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
+/*                                                                            */
+/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
+/*                                                                            */
+/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
+/*                                                                            */
+/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
+/*                                                                            */
+/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
+/*                                                                            */
+/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
+/*                                                                            */
+/* if whichone = 26 Agrif_Iz ===>                                             */
+/*                                                                            */
+/* if whichone = 27 Agrif_Iy ===>                                             */
+/*                                                                            */
+/* if whichone = 28 Agrif_Ix ===>                                             */
+/*                                                                            */
+/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
+/*                                                                            */
+/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
+/*                                                                            */
+/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void AgriffunctionModify_0(const char *ident,int whichone)
+{
+    char toprint[LONG_M];
+    if ( firstpass == 0 )
+    {
+        strcpy(toprint,"");
+        pos_end = setposcur();
+        fseek(fortran_out,pos_curagrifparent,SEEK_SET);
+        if ( whichone == 1 || whichone == 2 )
+        {
+            FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone);
+            }
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone);
+            }
+        }
+        else if ( whichone == 3 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % spaceref(1))");
+        }
+        else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
+        }
+        else if ( whichone == 5 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(1)");
+        }
+        else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(1)");
+        }
+        else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2))");
+        }
+        else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2))");
+        }
+        else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2)");
+        }
+        else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2)");
+        }
+        else if ( whichone == 11 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3))");
+        }
+        else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3))");
+        }
+        else if ( whichone == 13 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3)");
+        }
+        else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3)");
+        }
+        else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(1)");
+        }
+        else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(2)");
+        }
+        else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(3)");
+        }
+        else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+         strcat(toprint,"% DistantRootBorder(1)");
+        }
+        else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(2)");
+        }
+        else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(3)");
+        }
+        else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % grid_id");
+        }
+        else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% grid_id");
+        }
+        else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(3)");
+        }
+        else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(2)");
+        }
+        else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(1)");
+        }
+        else if ( whichone == 26 ) /* Agrif_Iz                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint," % ix(3)");
+        }
+        else if ( whichone == 27 ) /* Agrif_Iy                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(2)");
+        }
+        else if ( whichone == 28 ) /* Agrif_Ix                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(1)");
+        }
+        else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
+        {
+            sprintf(toprint,"Agrif_nbfixedgrids");
+        }
+        else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ngridstep");
+        }
+
+        Save_Length(toprint,43);
+
+        if ( whichone == 1 || whichone == 2 )   tofich(fortran_out,toprint,0);
+        else                                    fprintf(fortran_out,"%s",toprint);
+    }
+}
+
+/******************************************************************************/
+/*                             Instanciation_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void Instanciation_0(const char *ident)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass == 0 && sameagrifargument == 1 )
+    {
+        newvar = List_Global_Var;
+        out = 0;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+        if ( out == 0 )
+        {
+            newvar = List_Common_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+        if ( out == 0 )
+        {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+//         if ( out == 1 )
+//         {
+//             /* then write the instanciation                                      */
+//             fprintf(fortran_out,"\n      %s = %s",ident,vargridcurgridtabvars(newvar->var,3));
+//             printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3));
+//         }
+    }
+    sameagrifargument = 0;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 8732)
@@ -0,0 +1,387 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+
+
+/******************************************************************************/
+/*                         FindAndChangeNameToTabvars                         */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/* if  whichone = 0 ----> Agrif_tabvars(i) % array2                           */
+/*                                                                            */
+/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % array2               */
+/*                                                                            */
+/******************************************************************************/
+void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
+                                              listvar * listtosee, int whichone)
+{
+   listvar *newvar;
+   int out;
+   
+
+   if ( strcasecmp(name,"") )
+   {
+      newvar=listtosee;
+      out=0;
+      while( newvar && out == 0 )
+      {
+         if ( !strcasecmp(newvar->var->v_nomvar,name) )
+         {
+
+            if ( LookingForVariableInListName(
+                             List_SubroutineArgument_Var,name) == 0 )
+            {
+               out = 1;
+               strcat(toprint,vargridcurgridtabvars(newvar->var, whichone));
+            }
+            else newvar=newvar->suiv;
+         }
+         else newvar=newvar->suiv;
+      }
+      if ( out == 0 ) strcat(toprint,name);
+   }
+   Save_Length(toprint,44);
+}
+
+
+/******************************************************************************/
+/*                     ChangeTheInitalvaluebyTabvarsName                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+const char *ChangeTheInitalvaluebyTabvarsName(const char *nom, listvar *listtoread)
+{
+    char toprinttmp[LONG_M];
+    char chartmp[2];
+    size_t i = 0;
+
+    strcpy(toprintglob, "");
+    strcpy(toprinttmp,  "");
+
+    while ( i < strlen(nom) )
+    {
+        if ( (nom[i] == '+') || (nom[i] == '-') || (nom[i] == '*') || (nom[i] == '/') ||
+             (nom[i] == '(') || (nom[i] == ')') || (nom[i] == ':') || (nom[i] == ',') )
+        {
+            FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+            strcpy(toprinttmp, "");
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprintglob, chartmp);
+        }
+        else
+        {
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprinttmp, chartmp);
+        }
+        i += 1;
+    }
+    FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+    strcpy(toprinttmp,"");
+
+    Save_Length(toprinttmp,44);
+    Save_Length(toprintglob,39);
+
+    return toprintglob;
+}
+
+/******************************************************************************/
+/*                            IsVariableReal                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int IsVariableReal(const char *nom)
+{
+    return ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
+        ( nom[0] >= 'A' && nom[0] <= 'H' ) ||
+        ( nom[0] >= 'o' && nom[0] <= 'z' ) ||
+        ( nom[0] >= 'O' && nom[0] <= 'Z' ) );
+}
+/******************************************************************************/
+/*                         IsVarInUseFile                                     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void IsVarInUseFile(const char *nom)
+{
+   listvar *parcours;
+   listparameter *parcoursparam;
+   int out;
+
+   out = 0;
+
+   parcours = List_Global_Var;
+   while( parcours && out == 0 )
+   {
+      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+     else parcours=parcours->suiv;
+   }
+   if ( out == 0 )
+   {
+      parcours = List_Common_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_GlobalParameter_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_Parameter_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcoursparam = List_GlobParamModuleUsed_Var;
+      while( parcoursparam && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 2 ;
+         else parcoursparam=parcoursparam->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_ModuleUsed_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 2 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 || out == 2 )
+   {
+      parcoursparam = List_GlobParamModuleUsedInModuleUsed_Var;
+      while( parcoursparam && out != 1 )
+      {
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 1 ;
+         else parcoursparam=parcoursparam->suiv;
+      }
+      if ( out == 1 )
+      {
+         strcpy(charusemodule,parcoursparam->p_modulename);
+         Addmoduletothelist(parcoursparam->p_modulename);
+      }
+   }
+   if ( out == 0 &&
+        strcasecmp(nom,"MAX")             &&
+        strcasecmp(nom,"mpi_status_size")
+      )
+   {
+   /*   printf("--- in UtilCharacter we do not found the \n");
+      printf("---  variable %s, the module where this \n",nom);
+      printf("---  variable has been defined has not been\n");
+      printf("---  found.\n");*/
+   }
+}
+
+/******************************************************************************/
+/*                      DecomposeTheNameinlistnom                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout)
+{
+   char toprinttmp[LONG_M];
+   char chartmp[2];
+   size_t i = 0;
+
+   strcpy(toprinttmp,"");
+
+   while ( i < strlen(nom) )
+   {
+      if ( nom[i] == '+' ||
+           nom[i] == '-' ||
+           nom[i] == '*' ||
+           nom[i] == '/' ||
+           nom[i] == ')' ||
+           nom[i] == '(' ||
+           nom[i] == ',' ||
+           nom[i] == ':'
+         )
+      {
+         if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+         {
+             listout = Addtolistnom(toprinttmp,listout,0);
+         }
+         strcpy(toprinttmp,"");
+      }
+      else
+      {
+         sprintf(chartmp,"%c",nom[i]);
+         strcat(toprinttmp,chartmp);
+      }
+      i=i+1;
+   }
+   if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+   {
+      listout = Addtolistnom(toprinttmp,listout,0);
+   }
+   Save_Length(toprinttmp,44);
+   strcpy(toprinttmp,"");
+
+   return listout;
+}
+
+
+/******************************************************************************/
+/*                      DecomposeTheName                                      */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void DecomposeTheName(const char *nom)
+{
+   char toprinttmp[LONG_M];
+   char chartmp[2];
+   size_t i = 0;
+   
+   strcpy(toprinttmp,"");
+
+   while ( i < strlen(nom) )
+   {
+      if ( nom[i] == '+' ||
+           nom[i] == '-' ||
+           nom[i] == '*' ||
+           nom[i] == '/' ||
+           nom[i] == ')' ||
+           nom[i] == '(' ||
+           nom[i] == ',' ||
+           nom[i] == ':'
+         )
+      {
+         if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+         {
+            ajoutevarindoloop_definedimension (toprinttmp);
+            /* Is this variable present in globvarofusefile                   */
+            IsVarInUseFile(toprinttmp);
+         }
+         strcpy(toprinttmp,"");
+      }
+      else
+      {
+         sprintf(chartmp,"%c",nom[i]);
+         strcat(toprinttmp,chartmp);
+      }
+      i=i+1;
+   }
+   if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+   {
+      ajoutevarindoloop_definedimension (toprinttmp);
+      /* Is this variable present in globvarofusefile                         */
+      IsVarInUseFile(toprinttmp);
+   }
+   Save_Length(toprinttmp,44);
+   strcpy(toprinttmp,"");
+
+}
+
+void convert2lower(char *lowername, const char* inputname)
+{
+    int i, l, caractere;
+
+    strcpy(lowername, inputname);
+    l = strlen(lowername)-1;
+
+    for ( i=0 ; i<=l ; i++)
+    {
+        caractere = lowername[i];
+        if ( (caractere>=65 && caractere<=90) || (caractere>=192 && caractere<=221) )
+        {
+            lowername[i] += 32;
+        }
+    }
+}
+
+int convert2int(const char *name)
+{
+   int i;
+   int caractere;
+   int value;
+   int value_tmp;
+   int longueur;
+
+   value = 0;
+
+   longueur = strlen(name) - 1;
+   for (i=0;i<=longueur;i++)
+   {
+      caractere=name[i];
+      value_tmp = caractere -'0';
+      if ( value_tmp > 9 ) return 0;
+           if ( longueur+1-i == 6 ) value = value + value_tmp *100000;
+      else if ( longueur+1-i == 5 ) value = value + value_tmp *10000;
+      else if ( longueur+1-i == 4 ) value = value + value_tmp *1000;
+      else if ( longueur+1-i == 3 ) value = value + value_tmp *100;
+      else if ( longueur+1-i == 2 ) value = value + value_tmp *10;
+      else if ( longueur+1-i == 1 ) value = value + value_tmp *1;
+   }
+   return value;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 8732)
@@ -0,0 +1,128 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+/******************************************************************************/
+/*                         open_for_write                                     */
+/******************************************************************************/
+/* This subroutine is used to open a file                                     */
+/******************************************************************************/
+FILE* open_for_write (const char *filename)
+{
+    char filefich[LONG_FNAME];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "w");
+}
+
+/******************************************************************************/
+/*                          open_for_append                                   */
+/******************************************************************************/
+/* This subroutine is used to open a file with option a+                      */
+/******************************************************************************/
+FILE* open_for_append (const char *filename)
+{
+    char filefich[LONG_M];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "a+");
+}
+
+/******************************************************************************/
+/*                           setposcurname                                    */
+/******************************************************************************/
+/* This subroutine is used to know the current position in the file in argument    */
+/******************************************************************************/
+/*                                                                            */
+/*                      setposcur ---------> position in file                 */
+/*                                                                            */
+/******************************************************************************/
+long int setposcurname(FILE *fileout)
+{
+    fflush(fileout);
+    return ftell(fileout);
+}
+
+/******************************************************************************/
+/*                           setposcur                                        */
+/******************************************************************************/
+/* This subroutine is used to know the current position in the file           */
+/******************************************************************************/
+/*                                                                            */
+/*                      setposcur ---------> position in file                 */
+/*                                                                            */
+/******************************************************************************/
+long int setposcur()
+{
+    return setposcurname(fortran_out);
+}
+
+/******************************************************************************/
+/*                         copyuse_0                                          */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write in the fortran_out the USE tok_name                         */
+/* read in the original file                                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void copyuse_0(const char *namemodule)
+{
+    if ( IsTabvarsUseInArgument_0() == 1 )
+    {
+        /* We should write this declaration into the original subroutine too    */
+        fprintf(oldfortran_out,"      use %s\n", namemodule);
+    }
+}
+
+/******************************************************************************/
+/*                         copyuseonly_0                                      */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write in the fortran_out the USE tok_name, only                   */
+/* read in the original file                                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void copyuseonly_0(const char *namemodule)
+{
+   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should write this declaration into the original subroutine too    */
+      fprintf(oldfortran_out,"      use %s , only : \n", namemodule);
+   }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 8732)
@@ -0,0 +1,635 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                            initdimprob                                     */
+/******************************************************************************/
+/* This subroutine is used to initialized grid dimension variable             */
+/******************************************************************************/
+void initdimprob(int dimprobmod, const char * nx, const char * ny, const char* nz)
+{
+    dimprob = dimprobmod;
+
+    strcpy(nbmaillesX, nx);
+    strcpy(nbmaillesY, ny);
+    strcpy(nbmaillesZ, nz);
+}
+
+/******************************************************************************/
+/*                      Variableshouldberemoved                               */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+int Variableshouldberemoved(const char *nom)
+{
+    return Agrif_in_Tok_NAME(nom);
+}
+
+/******************************************************************************/
+/*                          variableisglobal                                  */
+/******************************************************************************/
+/* This subroutine is to know if a variable is global                         */
+/******************************************************************************/
+int variableisglobal(listvar *curvar, listvar *listin)
+{
+  int Globalite;
+  listvar *newvar;
+
+
+  Globalite = 0;
+  newvar = listin;
+  while ( newvar && Globalite == 0 )
+  {
+     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
+     {
+        Globalite = 1;
+        /* Now we should give the definition of the variable in the           */
+        /* table List_UsedInSubroutine_Var                                    */
+        strcpy(curvar->var->v_typevar, newvar->var->v_typevar);
+        strcpy(curvar->var->v_dimchar, newvar->var->v_dimchar);
+        curvar->var->v_nbdim          = newvar->var->v_nbdim;
+        curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven;
+        curvar->var->v_allocatable    = newvar->var->v_allocatable;
+        curvar->var->v_target         = newvar->var->v_target;
+        curvar->var->v_catvar         = newvar->var->v_catvar;
+        curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare;
+        curvar->var->v_indicetabvars  = newvar->var->v_indicetabvars;
+        strcpy(curvar->var->v_nameinttypename, newvar->var->v_nameinttypename);
+        strcpy(curvar->var->v_precision, newvar->var->v_precision);
+        strcpy(curvar->var->v_readedlistdimension, newvar->var->v_readedlistdimension);
+        strcpy(curvar->var->v_commoninfile, newvar->var->v_commoninfile);
+     }
+     else
+     {
+         newvar = newvar->suiv;
+     }
+  }
+
+  return Globalite ;
+}
+
+int VariableIsInListCommon(listvar *curvar,listvar *listin)
+{
+  int present;
+  listvar *newvar;
+
+  present = 0;
+  newvar = listin;
+
+  while ( newvar && present == 0 )
+  {
+     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) &&
+          !strcasecmp(newvar->var->v_subroutinename, curvar->var->v_subroutinename) )
+     {
+        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
+        Merge_Variables(curvar->var,newvar->var);
+        present = 1;
+     }
+     else newvar = newvar->suiv;
+  }
+
+  return present;
+}
+
+int VariableIsInList(listvar *curvar,listvar *listin)
+{
+  int present;
+  listvar *newvar;
+
+  present = 0;
+  newvar = listin;
+  while ( newvar && present == 0 )
+  {
+     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
+     {
+        Merge_Variables(curvar->var,newvar->var);
+        present = 1;
+     }
+     else newvar = newvar->suiv;
+  }
+
+  return present;
+}
+
+/******************************************************************************/
+/*                      variableisglobalinmodule                              */
+/******************************************************************************/
+/* This subroutine is to know if a variable is global                         */
+/******************************************************************************/
+void variableisglobalinmodule(listcouple *listin, const char *module, FILE *fileout, long int oldposcuruse)
+{
+  int Globalite;
+  listcouple *newvar;
+  listcouple *newvarprec;
+  listvar *tempo;
+  listvar *newvar2;
+  int out;
+  char truename[LONG_VNAME];
+
+  Globalite = 1;
+  newvarprec = (listcouple *)NULL;
+  tempo = (listvar *)NULL;
+  tempo = Readthedependfile(module,tempo);
+  newvar = listin;
+
+  while ( newvar )
+  {
+     if (!strcmp(newvar->c_namepointedvar,"")) {
+       strcpy(truename,newvar->c_namevar);
+     }
+     else
+     {
+       strcpy(truename,newvar->c_namepointedvar);
+     }
+
+     out = 0;
+     newvar2 = tempo;
+     while ( newvar2 && out == 0 )
+     {
+        if ( !strcasecmp(newvar2->var->v_nomvar,truename) ) out = 1;
+        else newvar2 = newvar2 ->suiv;
+     }
+     if ( out == 1 )
+     {
+        /* remove from the listin                                             */
+        if ( newvar == listin )
+        {
+           listin = listin->suiv;
+           newvar = listin;
+        }
+        else
+        {
+           newvarprec->suiv = newvar->suiv;
+           newvar = newvar->suiv;
+        }
+     }
+     else
+     {
+         newvarprec = newvar;
+         newvar = newvar->suiv;
+         Globalite = 0;
+     }
+  }
+  if ( Globalite == 0 || !newvar)
+  {
+     pos_end = setposcurname(fileout);
+     RemoveWordSET_0(fileout,oldposcuruse,pos_end-oldposcuruse);
+
+     newvar = listin;
+     while ( newvar )
+     {
+        fprintf(fileout,"      use %s, only : %s \n",module,newvar->c_namevar);
+        newvar = newvar->suiv;
+     }
+  }
+}
+
+void Write_Word_end_module_0()
+{
+    if ( firstpass == 0 )
+    {
+        fprintf(fortran_out,"\n      end module %s",curmodulename);
+    }
+}
+
+void Add_Subroutine_For_Alloc(const char *nom)
+{
+   listnom *parcours;
+   listnom *newvar;
+   int out;
+
+   newvar = (listnom*) calloc(1, sizeof(listnom));
+   strcpy(newvar->o_nom,nom);
+   newvar->suiv = NULL;
+
+   if ( !List_Subroutine_For_Alloc )
+   {
+      List_Subroutine_For_Alloc = newvar;
+   }
+   else
+   {
+      parcours = List_Subroutine_For_Alloc;
+      out = 0 ;
+      while ( parcours->suiv && out == 0 )
+      {
+         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
+         else parcours = parcours ->suiv;
+      }
+      /*                                                                      */
+      if ( out == 0 )
+      {
+         if ( strcasecmp(parcours->o_nom,nom) ) parcours->suiv = newvar;
+      }
+   }
+}
+
+void Write_Closing_Module(int forend)
+{
+    listvar *parcours;
+    listnom *parcours_nom;
+    listnom *parcours_nomprec;
+    variable *v;
+    int out = 0;
+    int headtypewritten = 0;
+    char ligne[LONG_M];
+    int changeval;
+
+    // Write Global Parameter Declaration
+    parcours = List_GlobalParameter_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename, curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, module_declar, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Global Type declaration
+    parcours = List_Global_Var;
+    while( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_modulename, curmodulename) &&
+             !strcasecmp(v->v_typevar, "type") )
+        {
+            if ( headtypewritten == 0 )
+            {
+                fprintf(fortran_out, "\n      type Agrif_%s\n", curmodulename);
+                headtypewritten = 1;
+            }
+            changeval = 0;
+            if ( v->v_allocatable )
+            {
+                changeval = 1;
+                v->v_allocatable = 0;
+                v->v_pointerdeclare = 1;
+            }
+            WriteVarDeclaration(v, fortran_out, 0, 0);
+            if ( changeval )
+            {
+                v->v_allocatable = 1;
+                v->v_pointerdeclare = 0;
+            }
+            out = 1;
+        }
+        parcours = parcours -> suiv;
+    }
+    if (out == 1)
+    {
+        fprintf(fortran_out, "      end type Agrif_%s\n", curmodulename);
+        sprintf(ligne, "type(Agrif_%s), dimension(:), allocatable :: Agrif_%s_var",curmodulename, curmodulename);
+        tofich(fortran_out,ligne,1);
+        fprintf(fortran_out, "      public :: Agrif_%s\n", curmodulename);
+        fprintf(fortran_out, "      public :: Agrif_%s_var\n", curmodulename);
+    }
+
+    // Write NotGridDepend declaration
+    parcours = List_NotGridDepend_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, fortran_out, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Alloc_agrif_'modulename' subroutine
+    parcours_nomprec = (listnom*) NULL;
+    parcours_nom = List_NameOfModule;
+    out = 0 ;
+    while ( parcours_nom && out == 0 )
+    {
+        if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
+        else parcours_nom = parcours_nom -> suiv;
+    }
+    if ( ! out )
+    {
+        printf("#\n# Write_Closing_Module : OUT == 0   *** /!\\ ***\n");
+        printf("# FIXME: POSSIBLE BUG in CONV !!!\n#\n");
+    }
+    if ( out )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out,"\n      public :: Alloc_agrif_%s\n",curmodulename);
+        }
+        if ( (forend == 0) || (parcours_nom->o_val == 1) )
+        {
+           fprintf(fortran_out,"\n      contains\n");
+        }
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", curmodulename);
+            fprintf(fortran_out, "          use Agrif_Util\n");
+            fprintf(fortran_out, "          type(Agrif_grid), pointer :: Agrif_Gr\n");
+            fprintf(fortran_out, "          integer :: i\n");
+            fprintf(fortran_out, "\n#include \"alloc_agrif_%s.h\"\n", curmodulename);
+            fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", curmodulename);
+            Add_Subroutine_For_Alloc(curmodulename);
+        }
+        else
+        {
+            parcours_nom = List_Subroutine_For_Alloc;
+            out = 0;
+            while ( parcours_nom && out == 0 )
+            {
+                if ( !strcasecmp(parcours_nom->o_nom, curmodulename) ) out = 1;
+                else
+                {
+                    parcours_nomprec = parcours_nom;
+                    parcours_nom = parcours_nom->suiv;
+                }
+            }
+            if ( out )
+            {
+                if ( parcours_nom == List_Subroutine_For_Alloc)
+                {
+                    List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
+                }
+                else
+                {
+                    parcours_nomprec->suiv = parcours_nom->suiv;
+                    parcours_nom = parcours_nomprec->suiv ;
+                }
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                          IsTabvarsUseInArgument_0                          */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int IsTabvarsUseInArgument_0()
+{
+   int out;
+   int doloopout;
+   listvar *parcours;
+
+   out=1;
+
+   if ( List_UsedInSubroutine_Var )
+   {
+      doloopout = 0;
+      parcours = List_UsedInSubroutine_Var;
+      while ( parcours && doloopout == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+                                                                  doloopout = 1;
+         else parcours = parcours->suiv;
+      }
+      if (  doloopout == 0 ) out = 0;
+      else out = 1 ;
+   }
+   else out = 0;
+
+   return out;
+}
+
+
+/******************************************************************************/
+/*                        ImplicitNoneInSubroutine                            */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int ImplicitNoneInSubroutine()
+{
+  listname *parcours;
+  int out;
+
+  parcours= List_ImplicitNoneSubroutine;
+  out = 0 ;
+  while ( parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->n_name,subroutinename) ) out = 1;
+     else parcours = parcours->suiv;
+  }
+  return out;
+}
+
+/******************************************************************************/
+/*                            Add_Pointer_Var_From_List_1                     */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Pointer_Var_From_List_1(listvar *listin)
+{
+   listvar *parcours;
+
+   if ( firstpass == 1 )
+   {
+       parcours = listin;
+       while ( parcours )
+       {
+          Add_Pointer_Var_1(parcours->var->v_nomvar);
+          parcours = parcours -> suiv ;
+       }
+   }
+}
+
+/******************************************************************************/
+/*                            Add_Pointer_Var_1                               */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Pointer_Var_1(char *nom)
+{
+   listname *newvar;
+   listname *parcours;
+   int out;
+
+   if ( firstpass == 1 )
+   {
+      if ( !List_Pointer_Var )
+      {
+         newvar = (listname*) calloc(1, sizeof(listname));
+         strcpy(newvar->n_name, nom);
+         newvar->suiv = NULL;
+         List_Pointer_Var = newvar;
+      }
+      else
+      {
+         parcours = List_Pointer_Var;
+         out = 0 ;
+         while ( parcours->suiv && out == 0 )
+         {
+            if (  !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else
+               parcours=parcours->suiv;
+         }
+         if ( out == 0 )
+         {
+            if (  !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else
+            {
+               /* add the record                                              */
+              newvar = (listname*) calloc(1, sizeof(listname));
+              strcpy(newvar->n_name,nom);
+              newvar->suiv = NULL;
+              parcours->suiv = newvar;
+            }
+         }
+      }
+   }
+}
+
+/******************************************************************************/
+/*                          varispointer_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int varispointer_0(char *ident)
+{
+   listname *newname;
+   int out;
+
+   out =0;
+   if ( firstpass == 0 )
+   {
+      newname = List_Pointer_Var;
+      while( newname && out == 0 )
+      {
+         if ( !strcasecmp(ident,newname->n_name) ) out = 1 ;
+         else newname = newname->suiv;
+      }
+   }
+   return out;
+}
+
+/******************************************************************************/
+/*                          varistyped_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int varistyped_0(char *ident)
+{
+   listvar *parcours;
+   int out;
+
+   out =0;
+   if ( firstpass == 0 )
+   {
+      parcours = List_Global_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(ident,parcours->var->v_nomvar) )
+             {
+             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1;
+             }
+         parcours = parcours->suiv;
+      }
+   }
+   return out;
+}
+
+
+/******************************************************************************/
+/*                          VariableIsFunction                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int VariableIsFunction(const char *ident)
+{
+    int out;
+    listvar *newvar;
+
+    out = 0;
+
+    if ( !strcasecmp(ident,"size") ||
+         !strcasecmp(ident,"if")   ||
+         !strcasecmp(ident,"max")  ||
+         !strcasecmp(ident,"min")  )
+    {
+        newvar = List_SubroutineDeclaration_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
+                 !strcasecmp(ident, newvar->var->v_nomvar) )
+            {
+                out = 1;
+            }
+            newvar = newvar -> suiv ;
+        }
+        if ( out == 0 ) /* if it has not been found */
+        {
+            newvar = List_Global_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+                newvar = newvar -> suiv ;
+            }
+        }
+    }
+    return (out == 0);
+}
+
+void dump_var(const variable* var)
+{
+    fprintf(stderr, "   var->v_nomvar : %s\n",var->v_nomvar);
+    fprintf(stderr, "   var->v_indice : %d\n",var->v_indicetabvars);
+    fprintf(stderr, "   var->v_typevar: %s\n",var->v_typevar);
+    fprintf(stderr, "   var->v_catvar : %d\n",var->v_catvar);
+    fprintf(stderr, "   var->v_modulename: %s\n",var->v_modulename);
+    fprintf(stderr, "   var->v_subroutinename: %s\n",var->v_subroutinename);
+    fprintf(stderr, "   var->v_commonname: %s\n",var->v_commonname);
+    fprintf(stderr, "   var->v_commoninfile: %s\n",var->v_commoninfile);
+    fprintf(stderr, "   var->v_nbdim: %d\n",var->v_nbdim);
+    fprintf(stderr, "   var->v_common: %d\n",var->v_common);
+    fprintf(stderr, "   var->v_module: %d\n",var->v_module);
+    fprintf(stderr, "   var->v_initialvalue: %s\n",var->v_initialvalue);
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 8732)
@@ -0,0 +1,706 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+void Init_Variable(variable *var)
+{
+   strcpy(var->v_typevar            , "");
+   strcpy(var->v_nomvar             , "");
+   strcpy(var->v_oldname            , "");
+   strcpy(var->v_dimchar            , "");
+   strcpy(var->v_modulename         , "");
+   strcpy(var->v_commonname         , "");
+   strcpy(var->v_vallengspec        , "");
+   strcpy(var->v_nameinttypename    , "");
+   strcpy(var->v_commoninfile       , "");
+   strcpy(var->v_subroutinename     , "");
+   strcpy(var->v_precision          , "");
+   strcpy(var->v_initialvalue       , "");
+   strcpy(var->v_IntentSpec         , "");
+   strcpy(var->v_readedlistdimension, "");
+   var->v_nbdim               = 0 ;
+   var->v_common              = 0 ;
+   var->v_positioninblock     = 0 ;
+   var->v_module              = 0 ;
+   var->v_save                = 0 ;
+   var->v_catvar              = 0 ;
+   var->v_VariableIsParameter = 0 ;
+   var->v_PublicDeclare       = 0 ;
+   var->v_PrivateDeclare      = 0 ;
+   var->v_ExternalDeclare     = 0 ;
+   var->v_pointedvar          = 0 ;
+   var->v_notgrid             = 0 ;
+   var->v_dimensiongiven      = 0 ;
+   var->v_c_star              = 0 ;
+   var->v_indicetabvars       = 0 ;
+   var->v_pointerdeclare      = 0 ;
+   var->v_optionaldeclare     = 0 ;
+   var->v_allocatable         = 0 ;
+   var->v_target              = 0 ;
+   var->v_dimsempty           = 0 ;
+   var->v_dimension = (listdim *) NULL;
+}
+/******************************************************************************/
+/*                            AddListvartolistvar                             */
+/******************************************************************************/
+/* This subroutine is used to add a listvar l at the end of a listvar         */
+/* glob.                                                                      */
+/*                                                                            */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + glob +--->+ glob +--->+ glob +--->+ glob +--->+  l   +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass )
+{
+    listvar *newvar;
+    if ( firstpass == ValueFirstpass )
+    {
+        if ( !glob ) glob = l;
+        else
+        {
+            newvar = glob;
+            while (newvar->suiv)
+                newvar = newvar->suiv;
+            newvar->suiv = l;
+        }
+    }
+    return glob;
+}
+
+/******************************************************************************/
+/*                       CreateAndFillin_Curvar                               */
+/******************************************************************************/
+/* This subroutine is used to create the record corresponding to the          */
+/* list of declaration                                                        */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void CreateAndFillin_Curvar(const char *type, variable *curvar)
+{
+    if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") )
+    {
+        strcpy(curvar->v_dimchar, CharacterSize);
+    }
+
+    /* On donne la precision de la variable si elle a ete donnee                */
+    curvar->v_c_star = 0;
+    if ( c_star == 1 )  curvar->v_c_star = 1;
+
+    strcpy(curvar->v_vallengspec,"");
+    if ( strcasecmp(vallengspec,"") )
+    {
+        strcpy(curvar->v_vallengspec,vallengspec);
+        Save_Length(vallengspec,8);
+    }
+
+    strcpy(curvar->v_precision,"");
+    if ( strcasecmp(NamePrecision,"") )
+    {
+        strcpy(curvar->v_precision,NamePrecision);
+        addprecision_derivedfromkind(curvar);
+        Save_Length(NamePrecision,12);
+    }
+    /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
+    if ( inmoduledeclare == 1 || SaveDeclare == 1 )
+    {
+        curvar->v_module = 1;
+    }
+    /* Puis on donne le nom du module dans curvar->v_modulename                */
+    strcpy(curvar->v_modulename,curmodulename);
+    /* Si cette variable a ete initialisee                                     */
+    if (InitialValueGiven == 1 )
+    {
+        strcpy(curvar->v_initialvalue,InitValue);
+        Save_Length(InitValue,14);
+    }
+    /* Si cette variable est declaree en save                                  */
+    if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1;
+
+    /* Si cette variable est v_allocatable                                     */
+    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
+
+    /* Si cette variable est v_target                                     */
+    if (Targetdeclare == 1 ) curvar->v_target=1;
+
+    /* if INTENT spec has been given                                           */
+    if ( strcasecmp(IntentSpec,"") )
+    {
+        strcpy(curvar->v_IntentSpec,IntentSpec);
+        Save_Length(IntentSpec,13);
+    }
+}
+
+
+void addprecision_derivedfromkind(variable *curvar)
+{
+    listnom *parcours;
+    char kind[LONG_VNAME];
+    char kind_val[LONG_C];
+
+    sscanf(curvar->v_precision, "%100s =", kind_val);
+
+    if ( !strcasecmp(kind_val, "kind") )
+        sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val);
+
+    parcours = listofkind;
+    while (parcours)
+    {
+        if ( !strcasecmp(parcours->o_nom, kind_val) )
+        {
+            sprintf(curvar->v_nameinttypename, "%d", parcours->o_val);
+        }
+        parcours=parcours->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                        duplicatelistvar                                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+// void duplicatelistvar(listvar *orig)
+// {
+//    listvar *parcours;
+//    listvar *tmplistvar;
+//    listvar *tmplistvarprec;
+//    listdim *tmplistdim;
+//    variable *tmpvar;
+//
+//    tmplistvarprec = (listvar *)NULL;
+//    parcours = orig;
+//    while ( parcours )
+//    {
+//       tmplistvar = (listvar *)calloc(1,sizeof(listvar));
+//       tmpvar = (variable *)calloc(1,sizeof(variable));
+//       /*                                                                      */
+//       Init_Variable(tmpvar);
+//       /*                                                                      */
+//       strcpy(tmpvar->v_typevar, parcours->var->v_typevar);
+//       strcpy(tmpvar->v_nomvar,  parcours->var->v_nomvar);
+//       strcpy(tmpvar->v_oldname, parcours->var->v_oldname);
+//       strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar);
+//       if ( parcours->var->v_dimension )
+//       {
+//          tmplistdim = (listdim*) calloc(1,sizeof(listdim));
+//          tmplistdim = parcours->var->v_dimension;
+//          tmpvar->v_dimension = tmplistdim;
+//       }
+//       tmpvar->v_nbdim  = parcours->var->v_nbdim;
+//       tmpvar->v_common = parcours->var->v_common;
+//       tmpvar->v_module = parcours->var->v_module;
+//       tmpvar->v_save   = parcours->var->v_save;
+//       tmpvar->v_positioninblock = parcours->var->v_positioninblock;
+//       tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter;
+//       tmpvar->v_indicetabvars = parcours->var->v_indicetabvars;
+//       tmpvar->v_pointedvar    = parcours->var->v_pointedvar;
+//       tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven;
+//       tmpvar->v_c_star = parcours->var->v_c_star;
+//       tmpvar->v_catvar = parcours->var->v_catvar;
+//       tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare;
+//       tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare;
+//       tmpvar->v_allocatable = parcours->var->v_allocatable;
+//       tmpvar->v_target      = parcours->var->v_target;
+//       tmpvar->v_dimsempty   = parcours->var->v_dimsempty;
+//       strcpy(tmpvar->v_modulename,  parcours->var->v_modulename);
+//       strcpy(tmpvar->v_commonname,  parcours->var->v_commonname);
+//       strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec);
+//       strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename);
+//       strcpy(tmpvar->v_commoninfile, cur_filename);
+//       strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename);
+//       strcpy(tmpvar->v_precision, parcours->var->v_precision);
+//       strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue);
+//       strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec);
+//       strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension);
+//
+//       tmplistvar->var = tmpvar;
+//       tmplistvar->suiv = NULL;
+//
+//       if ( !listduplicated )
+//       {
+//          listduplicated = tmplistvar;
+//          tmplistvarprec = listduplicated;
+//       }
+//       else
+//       {
+//          tmplistvarprec->suiv = tmplistvar;
+//          tmplistvarprec = tmplistvar;
+//       }
+//       parcours = parcours->suiv;
+//    }
+// }
+
+/******************************************************************************/
+/*                           insertdim                                        */
+/******************************************************************************/
+/* This subroutine is used to insert a record in a list of                    */
+/* struct : listdim                                                           */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ lin  +--->+ lin  +--->+ lin  +--->+  lin +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+listdim * insertdim(listdim *lin,typedim nom)
+{
+   listdim *newdim ;
+   listdim *parcours ;
+
+   newdim=(listdim *) calloc(1,sizeof(listdim));
+   newdim->dim=nom;
+   newdim->suiv=NULL;
+
+   if ( ! lin )
+   {
+      lin = newdim;
+   }
+   else
+   {
+      parcours = lin;
+      while ( parcours->suiv ) parcours=parcours->suiv;
+      parcours->suiv = newdim;
+   }
+
+   return lin;
+}
+
+/******************************************************************************/
+/*                            change_dim_char                                 */
+/******************************************************************************/
+/* This subroutine is used to change the dimension in the list lin            */
+/******************************************************************************/
+/*        _______     _______                 _______     _______             */
+/*       +  l   +    +  l   +                +  l   +    +   l  +             */
+/*       + old  +--->+ old  +--------------->+ lin  +--->+  lin +             */
+/*       +______+    +______+                +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void change_dim_char(listdim *lin,listvar * l)
+{
+   listvar *parcours_var;
+   variable *v;
+
+   parcours_var=l;
+   while(parcours_var)
+   {
+      v = parcours_var->var;
+      strcpy(v->v_dimchar,(lin->dim).last);
+      parcours_var=parcours_var->suiv;
+   }
+}
+
+
+/******************************************************************************/
+/*                              get_num_dims                                  */
+/******************************************************************************/
+/* This subroutine is used to know the dimension of a table                   */
+/******************************************************************************/
+/*                                                                            */
+/*             Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3            */
+/*                                                                            */
+/******************************************************************************/
+int get_num_dims ( const listdim *d )
+{
+    listdim *parcours;
+    int compteur = 0;
+
+    parcours = (listdim *) d;
+    while(parcours)
+    {
+        compteur++;
+        parcours = parcours->suiv;
+    }
+    return compteur;
+}
+
+
+/******************************************************************************/
+/*                          CREATEVAR                                         */
+/******************************************************************************/
+/* This subroutine is used to create and initialized a record of the          */
+/*      struct : variable                                                     */
+/******************************************************************************/
+variable * createvar(const char *nom, listdim *d)
+{
+    variable *var;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    var = (variable *) calloc(1,sizeof(variable));
+
+    Init_Variable(var);
+
+    strcpy(listdimension,"");
+    strcpy(var->v_nomvar,nom);
+    strcpy(var->v_modulename,curmodulename);
+    strcpy(var->v_commoninfile,cur_filename);
+    strcpy(var->v_subroutinename,subroutinename);
+
+    if ( strcasecmp(nameinttypename,"") )
+    {
+        strcpy(var->v_nameinttypename,nameinttypename);
+    }
+
+    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
+    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
+    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
+    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
+    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
+    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
+
+   var->v_dimension = d;
+
+   /* Creation of the string for the dimension of this variable               */
+    dimsempty = 1;
+    if ( d )
+    {
+        var->v_dimensiongiven = 1;
+        dims = d;
+        while (dims)
+        {
+            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+            {
+                dimsempty = 0;
+            }
+            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+            strcat(listdimension,ligne);
+            if ( dims->suiv )
+            {
+                strcat(listdimension,",");
+            }
+            dims = dims->suiv;
+        }
+        if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1;
+    }
+    strcpy(var->v_readedlistdimension,listdimension);
+    Save_Length(listdimension,15);
+    var->v_nbdim = get_num_dims(d);
+
+    return var;
+}
+
+/******************************************************************************/
+/*                            INSERTVAR                                       */
+/******************************************************************************/
+/* This subroutine is used to insert a record in a list of the                */
+/*      struct : listvar                                                      */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ NEW  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listvar * insertvar(listvar *lin,variable *v)
+{
+   listvar *newvar ;
+   listvar *tmpvar ;
+
+   newvar=(listvar *) calloc(1,sizeof(listvar));
+   newvar->var=v;
+   newvar->suiv = NULL;
+   if (!lin)
+   {
+      newvar->suiv=NULL;
+      lin = newvar;
+   }
+   else
+   {
+      tmpvar = lin ;
+      while (tmpvar->suiv)
+      {
+         tmpvar = tmpvar ->suiv ;
+      }
+      tmpvar -> suiv = newvar;
+   }
+   return lin;
+}
+
+/******************************************************************************/
+/*                             SETTYPE                                        */
+/******************************************************************************/
+/* This subroutine is used to give the same variable type at each             */
+/*      record of the list of the struct : listvar                            */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       + REAL +    + REAL +    + REAL +    + REAL +    + REAL +             */
+/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ lin  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listvar *settype(const char *nom, listvar *lin)
+{
+   listvar *newvar;
+   variable *v;
+
+   newvar = lin;
+   while (newvar)
+   {
+      v = newvar->var;
+      strcpy(v->v_typevar,nom);
+      v->v_catvar = get_cat_var(v);
+      newvar = newvar->suiv;
+   }
+   newvar = lin;
+   return newvar ;
+}
+
+/******************************************************************/
+/* printliste  */
+/* print the list given in argulent */
+/******************************************************************/
+
+void printliste(listvar * lin)
+{
+   listvar *newvar;
+   variable *v;
+
+   newvar=lin;
+   while (newvar)
+   {
+      v=newvar->var;
+      printf("nom = %s, allocatable = %d dim = %s\n",v->v_nomvar,v->v_allocatable,(v->v_dimension)->dim.last);
+      newvar=newvar->suiv;
+   }
+}
+
+/******************************************************************************/
+/*   IsinListe : return 1 if name nom is in list lin                          */
+/*                                                                            */
+/******************************************************************************/
+ int IsinListe(listvar *lin,char *nom)
+{
+   listvar *newvar;
+   variable *v;
+   int out ;
+
+   newvar=lin;
+   out = 0;
+   while (newvar && (out == 0))
+   {
+      v=newvar->var;
+      if (!strcasecmp(v->v_nomvar,nom) && !strcasecmp(v->v_subroutinename,subroutinename)) {
+      out = 1;
+      }
+      newvar=newvar->suiv;
+   }
+
+   return out ;
+}
+
+listname *Insertname(listname *lin,char *nom, int sens)
+{
+   listname *newvar ;
+   listname *tmpvar;
+
+   newvar=(listname *) calloc(1,sizeof(listname));
+   strcpy(newvar->n_name,nom);
+   newvar->suiv = NULL;
+   if (!lin)
+   {
+      newvar->suiv=NULL;
+      lin = newvar;
+   }
+   else
+   {
+      if (sens == 0)
+      {
+      tmpvar = lin ;
+      while (tmpvar->suiv)
+      {
+         tmpvar = tmpvar ->suiv ;
+      }
+      tmpvar -> suiv = newvar;
+      }
+      else
+      {
+      newvar->suiv = lin;
+      lin = newvar;
+      }
+   }
+   return lin;
+}
+
+listname *concat_listname(listname *l1, listname *l2)
+{
+   listname *tmpvar;
+
+   tmpvar = l1;
+   while (tmpvar->suiv)
+   {
+    tmpvar = tmpvar->suiv;
+   }
+
+   tmpvar->suiv = l2;
+
+   return l1;
+}
+
+void createstringfromlistname(char *ligne, listname *lin)
+{
+    listname *tmpvar;
+
+    strcpy(ligne,"");
+    tmpvar = lin;
+
+    while(tmpvar)
+    {
+        strcat(ligne,tmpvar->n_name);
+        if (tmpvar->suiv) strcat(ligne,",");
+        tmpvar=tmpvar->suiv;
+    }
+}
+
+/******************************************************************/
+/* printname  */
+/* print the list given in argulent */
+/******************************************************************/
+
+void printname(listname * lin)
+{
+   listname *newvar;
+
+   newvar=lin;
+   while (newvar)
+   {
+      printf("nom = %s \n",newvar->n_name);
+      newvar=newvar->suiv;
+   }
+}
+
+void removeglobfromlist(listname **lin)
+{
+  listname *parcours1;
+  listvar *parcours2;
+  listname * parcourspres;
+  int out;
+
+  parcours1 = *lin;
+  parcourspres = (listname *)NULL;
+
+  while (parcours1)
+  {
+  parcours2 = List_Global_Var;
+  out = 0;
+  while (parcours2 && out == 0)
+  {
+    if (!strcasecmp(parcours2->var->v_nomvar,parcours1->n_name))
+    {
+    out = 1;
+    }
+    parcours2 = parcours2->suiv;
+  }
+  if (out == 1)
+  {
+  if (parcours1 == *lin)
+   {
+   *lin = (*lin)->suiv;
+   parcours1 = *lin;
+   }
+   else
+   {
+   parcourspres->suiv = parcours1->suiv;
+   parcours1 = parcourspres->suiv;
+   }
+   }
+   else
+   {
+   parcourspres = parcours1;
+    parcours1 = parcours1->suiv;
+    }
+  }
+}
+
+void writelistpublic(listname *lin)
+{
+    listname *parcours1;
+    char ligne[LONG_M];
+
+    if (lin)
+    {
+        sprintf(ligne,"public :: ");
+        parcours1 = lin;
+
+        while ( parcours1 )
+        {
+            strcat(ligne, parcours1->n_name);
+            if ( parcours1->suiv ) strcat(ligne,", ");
+            parcours1 = parcours1->suiv;
+        }
+        tofich(fortran_out,ligne,1);
+    }
+}
+
+void Init_List_Data_Var()
+{
+    listvar *parcours;
+
+    parcours = List_Data_Var_Cur;
+
+    if (List_Data_Var_Cur)
+    {
+        while (parcours)
+        {
+            List_Data_Var_Cur = List_Data_Var_Cur->suiv;
+            free(parcours);
+            parcours = List_Data_Var_Cur;
+        }
+    }
+    List_Data_Var_Cur = NULL;
+}
+
+int get_cat_var(variable *var)
+{
+    if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        return 1;
+    else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL")))
+        return 2;
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        return 3;
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        return 4;
+    else
+        return 0;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 8732)
@@ -0,0 +1,107 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                     Add_NotGridDepend_Var_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a record into List_NotGridDepend_Var        */
+/*    This variable is add only if it is not present in the list              */
+/*    This variable is add at the end of the list                             */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       + not  +    + not  +    +  not +    +  not +    +      +             */
+/*       + grid +--->+ grid +--->+ grid +--->+ grid +--->+ NEW  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void Add_NotGridDepend_Var_1 (char *name)
+{
+   listvar *parcours;
+   listvar *newvar;
+   /*                                                                         */
+   /* look in the List_NotGridDepend_Var if this variable exist               */
+   parcours = List_NotGridDepend_Var;
+   while (parcours)
+   {
+     if (!strcasecmp(parcours->var->v_nomvar,name))
+     {
+        /* if this variable exist -> exit of the program                      */
+        printf(" The variable %s\n",name);
+        printf(" has been declared twice \n");
+        printf(" as a non grid dependent variable \n");
+        exit(1);
+     }
+     parcours= parcours->suiv;
+   }
+   /* if variable does not exist, we add it                                   */
+   newvar=(listvar *)calloc(1,sizeof(listvar));
+   newvar->var=(variable *)calloc(1,sizeof(variable));
+   strcpy(newvar->var->v_nomvar,name);
+   strcpy(newvar->var->v_commoninfile,cur_filename);
+   strcpy(newvar->var->v_subroutinename,subroutinename);
+   newvar->var->v_notgrid = 1 ;
+   newvar->suiv = List_NotGridDepend_Var;
+   List_NotGridDepend_Var = newvar;
+}
+
+/******************************************************************************/
+/*                      VarIsNonGridDepend                                    */
+/******************************************************************************/
+/* This subroutine is used to know if a variable has been declared as non     */
+/* grid dependent                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  notgriddepend variable;    ----------->  VarIsNonGridDepend = 1           */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int VarIsNonGridDepend(char *name)
+{
+   listvar *newvar;
+   int out;
+
+   newvar = List_NotGridDepend_Var;
+   out=0;
+   while (newvar && out == 0 )
+   {
+      if ( !strcasecmp(newvar->var->v_nomvar,name) ) out = 1;
+      else newvar = newvar->suiv;
+   }
+   return out;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 8732)
@@ -0,0 +1,122 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                               Add_Allocate_Var_1                           */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Allocate_Var_1(const char *nom, const char *nommodule)
+{
+   listallocate *newvar;
+   listallocate *parcours;
+   int out;
+
+   if ( firstpass == 1 )
+   {
+      if ( !List_Allocate_Var )
+      {
+         newvar = (listallocate *)calloc(1,sizeof(listallocate));
+         strcpy(newvar->a_nomvar,nom);
+         strcpy(newvar->a_subroutine,subroutinename);
+         strcpy(newvar->a_module,nommodule);
+         Save_Length(nom,25);
+         newvar->suiv = NULL;
+         List_Allocate_Var = newvar;
+      }
+      else
+      {
+         parcours = List_Allocate_Var;
+         out = 0 ;
+         while ( parcours->suiv && out == 0 )
+         {
+            if (  !strcasecmp(parcours->a_nomvar, nom) &&
+                  !strcasecmp(parcours->a_subroutine, subroutinename) &&
+                  !strcasecmp(parcours->a_module, nommodule) ) out = 1;
+            else
+               parcours=parcours->suiv;
+         }
+         if ( out == 0 )
+         {
+            if (  !strcasecmp(parcours->a_nomvar,nom) &&
+                  !strcasecmp(parcours->a_subroutine,subroutinename) &&
+                  !strcasecmp(parcours->a_module,nommodule) ) out = 1;
+            else
+            {
+               /* add the record                                              */
+              newvar = (listallocate *)calloc(1,sizeof(listallocate));
+              strcpy(newvar->a_nomvar, nom);
+              strcpy(newvar->a_subroutine, subroutinename);
+              strcpy(newvar->a_module, nommodule);
+              Save_Length(nom,25);
+              newvar->suiv = NULL;
+              parcours->suiv = newvar;
+            }
+         }
+      }
+   }
+}
+
+
+/******************************************************************************/
+/*                            IsVarAllocatable_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+// int IsVarAllocatable_0(const char *ident)
+// {
+//    listallocate *parcours;
+//    int out;
+// 
+//    out = 0 ;
+//    if ( firstpass == 0 )
+//    {
+//       parcours = List_Allocate_Var;
+//       while ( parcours && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
+//          else parcours=parcours->suiv;
+//       }
+//    }
+//    return out;
+// }
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 8732)
@@ -0,0 +1,101 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                       Add_GlobalParameter_Var_1                            */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_GlobalParameter_Var_1(listvar *listin)
+{
+    if ( VariableIsParameter )
+        List_GlobalParameter_Var =  AddListvarToListvar(listin, List_GlobalParameter_Var, 1);
+}
+
+/******************************************************************************/
+/*                       Add_Parameter_Var_1                                  */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Parameter_Var_1(listvar *listin)
+{
+    listvar *parcours;
+
+    if ( !VariableIsParameter )    return;
+
+    if ( List_Parameter_Var == NULL )
+    {
+        List_Parameter_Var = listin;
+    }
+    else
+    {
+        parcours = List_Parameter_Var;
+        while ( parcours->suiv )
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
+}
+
+/******************************************************************************/
+/*                       Add_Dimension_Var_1                                  */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Dimension_Var_1(listvar *listin)
+{
+   listvar *parcours;
+
+    if ( List_Dimension_Var == NULL )
+    {
+        List_Dimension_Var = listin;
+    }
+    else
+    {
+        parcours = List_Dimension_Var;
+        while (parcours->suiv)
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 8732)
@@ -0,0 +1,107 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                          Add_Globliste_1                                   */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should add this declaration to the List_Global_Var                      */
+/******************************************************************************/
+void Add_Globliste_1(listvar *listtoadd)
+{
+    if ( aftercontainsdeclare == 0 && VariableIsParameter == 0 )
+    {
+        List_Global_Var = AddListvarToListvar(listtoadd, List_Global_Var, 1);
+    }
+}
+
+/******************************************************************************/
+/*                  Add_SubroutineDeclarationSave_Var_1                       */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should add this declaration to the List_Global_Var. case SAVE           */
+/******************************************************************************/
+void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd)
+{
+   if ( firstpass == 1 )
+   {
+      if ( VariableIsParameter == 0 &&
+           SaveDeclare         == 1 )
+      {
+         List_Global_Var = AddListvarToListvar(listtoadd,List_Global_Var,1);
+      }
+   }
+}
+
+void checkandchangedims(listvar *listsecondpass)
+{
+listvar *parcours;
+listvar *parcours1;
+variable * newvar;
+variable * oldvar;
+
+int out ;
+
+printliste(List_Global_Var);
+printliste(List_SubroutineDeclaration_Var);
+
+parcours = listsecondpass;
+while (parcours)
+{
+newvar = parcours->var;
+parcours1 = List_SubroutineDeclaration_Var;
+out = 0;
+while (parcours1 && out == 0)
+{
+  oldvar = parcours1->var;
+  if (!strcasecmp(newvar->v_nomvar,oldvar->v_nomvar) && !strcasecmp(newvar->v_subroutinename,subroutinename))
+   {
+   if (newvar->v_dimensiongiven == 1)
+   {
+    strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last);
+    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);
+   }
+   out = 1;
+   }
+  parcours1 = parcours1->suiv;
+}
+parcours = parcours->suiv;
+}
+printliste(List_SubroutineDeclaration_Var);
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 8732)
@@ -0,0 +1,145 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+/******************************************************************************/
+/*                          Add_Data_Var_1                                    */
+/******************************************************************************/
+/* This subroutine is used to add a record to List_Data_Var                   */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ data +--->+ data +--->+ data +--->+  data+             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void Add_Data_Var_1 (listvar **curlist,char *name,char *values)
+{
+  listvar *newvar;
+  char ligne[LONG_M];
+
+//  if ( firstpass == 1 )
+//  {
+     newvar=(listvar *)calloc(1,sizeof(listvar));
+     newvar->var=(variable *)calloc(1,sizeof(variable));
+     /*                                                                       */
+     Init_Variable(newvar->var);
+     /*                                                                       */
+     if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
+     strcpy(newvar->var->v_nomvar,name);
+     strcpy(newvar->var->v_subroutinename,subroutinename);
+     strcpy(newvar->var->v_modulename,curmodulename);
+     strcpy(newvar->var->v_commoninfile,cur_filename);
+     if (strchr(values,',') && strncasecmp(values,"'",1))
+        sprintf(ligne,"(/%s/)",values);
+     else
+        strcpy(ligne,values);
+       
+     strcpy(newvar->var->v_initialvalue,ligne);
+     Save_Length(ligne,14);
+     newvar->suiv = NULL;
+     if ( ! (*curlist) )
+     {
+        *curlist  = newvar ;
+     }
+     else
+     {
+        newvar->suiv = *curlist;
+        *curlist = newvar;
+     }
+//  }
+}
+
+void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2)
+{
+    listvar *newvar;
+    listvar *tmpvar;
+    listname *tmpvar1;
+    listname *tmpvar2;  
+    variable *found_var = NULL;
+    
+    tmpvar1 = l1;
+    tmpvar2 = l2;
+  
+    while (tmpvar1)
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
+     
+        found_var = get_variable_in_list_from_name(List_Common_Var, tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_Global_Var,tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_SubroutineDeclaration_Var,tmpvar1->n_name);
+        
+        if ( found_var && found_var->v_nbdim > 0 )
+        {
+            printf("##############################################################################################################\n");
+            printf("## CONV Error : arrays in data_stmt_object lists not yet supported. Please complain to the proper authorities.\n");
+            printf("##   variable name : %s (in %s:%s:%s)\n", found_var->v_nomvar, found_var->v_modulename,
+                                                              found_var->v_subroutinename, found_var->v_commonname);
+            exit(1);
+        }
+        
+        strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+        strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
+
+        Save_Length(tmpvar2->n_name,14);
+
+        newvar->suiv = NULL;
+     
+        if ( *curlist != NULL )
+        {
+            tmpvar = *curlist;
+            while (tmpvar->suiv)
+                tmpvar = tmpvar->suiv;
+            tmpvar->suiv = newvar;
+        }
+        else
+        {
+            *curlist  = newvar ;
+        }
+     
+        tmpvar1 = tmpvar1->suiv;
+        tmpvar2 = tmpvar2->suiv;  
+    }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 8732)
@@ -0,0 +1,160 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+void Save_Length(const char *nom, int whichone)
+{
+    size_t len_nom = strlen(nom);
+    
+   if ( whichone == 1  && len_nom > length_last )
+   {
+      length_last = len_nom;
+      if ( length_last > LONG_M )
+            printf("WARNING 1 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_last+100);
+   }
+   if ( whichone == 2  && len_nom > length_first )
+   {
+      length_first = len_nom;
+      if ( length_first > LONG_M )
+           printf("WARNING 2 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_first+100);
+   }
+   if ( whichone == 8  && len_nom > length_v_vallengspec )
+   {
+      length_v_vallengspec = len_nom;
+      if ( length_v_vallengspec > LONG_M )
+           printf("WARNING 8 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_vallengspec+100);
+   }
+   if ( whichone == 12 && len_nom > length_v_precision )
+   {
+      length_v_precision = len_nom;
+      if ( length_v_precision > LONG_M )
+           printf("WARNING 12 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_precision+100);
+   }
+   if ( whichone == 13 && len_nom > length_v_IntentSpec )
+   {
+      length_v_IntentSpec = len_nom;
+      if ( length_v_IntentSpec > LONG_M )
+           printf("WARNING 13 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_IntentSpec+100);
+   }
+   if ( whichone == 14 && len_nom > length_v_initialvalue )
+   {
+      length_v_initialvalue = len_nom;
+      if ( length_v_initialvalue > LONG_M )
+           printf("WARNING 14 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_initialvalue+100);
+   }
+   if ( whichone == 15 && len_nom > length_v_readedlistdimension )
+   {
+      length_v_readedlistdimension = len_nom;
+      if ( length_v_readedlistdimension > LONG_M )
+           printf("WARNING 15 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_readedlistdimension+100);
+   }
+   if ( whichone == 25 && len_nom > length_a_nomvar )
+   {
+      length_a_nomvar = len_nom;
+      if ( length_a_nomvar > LONG_C )
+           printf("WARNING 25 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_a_nomvar+100);
+   }
+   if ( whichone == 39 && len_nom > length_toprintglob )
+   {
+      length_toprintglob = len_nom;
+      if ( length_toprintglob > LONG_M )
+           printf("WARNING 39 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprintglob+100);
+   }
+   if ( whichone == 40 && len_nom > length_tmpvargridname )
+   {
+      length_tmpvargridname = len_nom;
+      if ( length_tmpvargridname > LONG_M )
+           printf("WARNING 40 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpvargridname+100);
+   }
+   if ( whichone == 41 && len_nom > length_ligne_Subloop )
+   {
+       length_ligne_Subloop = len_nom;
+      if ( length_ligne_Subloop > LONG_M )
+           printf("WARNING 41 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n",length_ligne_Subloop+100);
+   }
+   if ( whichone == 43 && len_nom > length_toprint_utilagrif )
+   {
+      length_toprint_utilagrif = len_nom;
+      if ( length_toprint_utilagrif > LONG_M )
+           printf("WARNING 43 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprint_utilagrif+100);
+   }
+   if ( whichone == 44 && len_nom > length_toprinttmp_utilchar )
+   {
+      length_toprinttmp_utilchar = len_nom;
+      if ( length_toprinttmp_utilchar > LONG_M)
+           printf("WARNING 44 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprinttmp_utilchar+100);
+   }
+   if ( whichone == 45 && len_nom > length_ligne_writedecl )
+   {
+      length_ligne_writedecl = len_nom;
+      if ( length_ligne_writedecl > LONG_M )
+           printf("WARNING 45 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_writedecl+100);
+   }
+   if ( whichone == 46 && len_nom > length_newname_toamr )
+   {
+      length_newname_toamr = len_nom;
+      if ( length_newname_toamr > LONG_C )
+           printf("WARNING 46 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_newname_toamr+100);
+   }
+   if ( whichone == 47 && len_nom > length_newname_writedecl )
+   {
+      length_newname_writedecl = len_nom;
+      if ( length_newname_writedecl > LONG_M )
+           printf("WARNING 47 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_newname_writedecl +100);
+   }
+   if ( whichone == 48 && len_nom > length_ligne_toamr )
+   {
+      length_ligne_toamr = len_nom;
+      if ( length_ligne_toamr > LONG_M )
+           printf("WARNING 48 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_toamr +100);
+   }
+   if ( whichone == 49 && len_nom > length_tmpligne_writedecl )
+   {
+      length_tmpligne_writedecl = len_nom;
+      if ( length_tmpligne_writedecl > LONG_M )
+           printf("WARNING 49 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpligne_writedecl+100);
+   }
+}
+
+void Save_Length_int(int val, int whichone)
+{
+   if ( whichone == 1 && val > value_char_size )    value_char_size  = val;
+   if ( whichone == 2 && val > value_char_size1 )   value_char_size1 = val;
+   if ( whichone == 3 && val > value_char_size2 )   value_char_size2 = val;
+   if ( whichone == 4 && val > value_char_size3 )   value_char_size3 = val;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 8732)
@@ -0,0 +1,105 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or    or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)           */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "decl.h"
+
+/******************************************************************************/
+/*                          variscoupled_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int variscoupled_0(const char *ident)
+{
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(ident, coupletmp->c_namevar) &&
+                     !strcasecmp(subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    out = 1;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    return out;
+}
+
+const char * getcoupledname_0(const char *ident)
+{
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(coupletmp->c_namevar,ident) &&
+                     !strcasecmp(pointtmplist->t_cursubroutine,subroutinename) &&
+                      strcasecmp(coupletmp->c_namepointedvar,"") )
+                {
+                    return coupletmp->c_namepointedvar;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    printf("end of getcoupledname_0 -- you should not be there !!! \n");
+    return NULL;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 8732)
@@ -0,0 +1,303 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "decl.h"
+
+
+
+/******************************************************************************/
+/*                    RecordUseModulesVariables                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void RecordUseModulesVariables()
+{
+  listusemodule *tmplistmodule;
+
+  /* we should record all variables defined in modules used in this file      */
+  if ( List_NameOfModuleUsed )
+  {
+     tmplistmodule = List_NameOfModuleUsed;
+     while ( tmplistmodule )
+     {
+        if ( tmplistmodule->u_firstuse == 1 )
+        {
+           /* check if the file .depend<u_usemodule> exist                    */
+           List_ModuleUsed_Var = Readthedependfile
+                               (tmplistmodule->u_usemodule,List_ModuleUsed_Var);
+           List_GlobParamModuleUsed_Var = ReaddependParameterList
+                      (tmplistmodule->u_usemodule,List_GlobParamModuleUsed_Var);
+
+        }
+
+        tmplistmodule = tmplistmodule->suiv;
+     }
+  }
+}
+
+/******************************************************************************/
+/*                RecordUseModulesUseModulesVariables                         */
+/******************************************************************************/
+/******************************************************************************/
+void RecordUseModulesUseModulesVariables()
+{
+    listusemodule *tmplistmodule;
+    listusemodule *save_list;
+
+    if ( ! List_NameOfModuleUsed )  return;
+
+    /* we should record all variables defined in modules used in this file      */
+    /* and we should read the .depend of the module used by the module used  */
+    tmplistmodule = List_NameOfModuleUsed;
+    while ( tmplistmodule )
+    {
+        Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
+        while( tmpuselocallist )
+        {
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
+        }
+        tmplistmodule = tmplistmodule->suiv;
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
+        Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
+        while( tmpuselocallist )
+        {
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
+        }
+        tmplistmodule = tmplistmodule->suiv;
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
+        // check if the file .depend<u_usemodule> exists
+        List_ModuleUsedInModuleUsed_Var =
+            Readthedependfile(tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
+
+        List_GlobParamModuleUsedInModuleUsed_Var =
+            ReaddependParameterList(tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
+        tmplistmodule = tmplistmodule->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                      Add_NameOfModuleUsed_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/* listusemodule                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... USE mod1 ===> insert in list                      */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  List_NameOfModuleUsed                                        */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfModuleUsed_1(char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_modulename, curmodulename);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( List_NameOfModuleUsed == NULL )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours = parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
+}
+
+/******************************************************************************/
+/*                        Addmoduletothelist                                  */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/* listusemodule                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... USE mod1 ===> insert in list                      */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  List_NameOfModuleUsed                                     */
+/*                                                                            */
+/******************************************************************************/
+void Addmoduletothelist(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1,sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( !List_NameOfModuleUsed )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse == 1 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours=parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
+}
+
+
+/******************************************************************************/
+/*                        WriteUsemoduleDeclaration                           */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteUsemoduleDeclaration(const char *cursubroutinename)
+{
+    listusemodule     *newmodule;
+    listvarpointtovar *pointtmp;
+    long int          fictifpos;
+    int               findcoupled;
+
+    fprintf(fortran_out,"\n");
+    newmodule = List_NameOfModuleUsed;
+
+    while ( newmodule )
+    {
+        if ( !strcasecmp(newmodule->u_cursubroutine, cursubroutinename) )
+        {
+            if (strcmp(newmodule->u_charusemodule,""))
+            {
+/*
+                findcoupled = 0;
+                pointtmp = List_CouplePointed_Var;
+                while(pointtmp)
+                {
+                    if ((!strcasecmp(pointtmp->t_usemodule, newmodule->u_charusemodule)) && \
+                        (!strcasecmp(pointtmp->t_cursubroutine, cursubroutinename)))
+                    {
+                        fictifpos = setposcur();
+                        variableisglobalinmodule(pointtmp->t_couple,newmodule->u_charusemodule,fortran_out,fictifpos);
+                        findcoupled = 1;
+                    }
+                    pointtmp=pointtmp->suiv;
+                }
+                if (findcoupled == 0)   fprintf(fortran_out,"      use %s\n",newmodule->u_charusemodule);
+*/
+                fprintf(fortran_out,"      use %s\n", newmodule->u_charusemodule);
+            }
+        }
+        newmodule = newmodule ->suiv;
+    }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 8732)
@@ -0,0 +1,1870 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or    or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)           */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+//#include <stdlib.h>
+//#include <string.h>
+
+#include "decl.h"
+
+/******************************************************************************/
+/*                         Add_UsedInSubroutine_Var_1                         */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the List_UsedInSubroutine_Var                           */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_UsedInSubroutine_Var_1 (const char *ident)
+{
+  listvar *newvar;
+  listvar *tmpvar;
+  int out;
+
+   /* In the first pass we record all variables presents in the do loop       */
+   if (firstpass == 1 && insubroutinedeclare == 1 )
+   {
+
+  if ( !List_UsedInSubroutine_Var )
+  {
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
+      /*                                                                      */
+      Init_Variable(newvar->var);
+      /*                                                                      */
+      newvar->suiv = NULL;
+      strcpy(newvar->var->v_nomvar,ident);
+      strcpy(newvar->var->v_modulename,curmodulename);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
+      strcpy(newvar->var->v_subroutinename,subroutinename);
+      newvar->var->v_pointedvar=pointedvar;
+      List_UsedInSubroutine_Var = newvar ;
+  }
+  else
+  {
+      /* We should verify that this variable did not added                    */
+      tmpvar = List_UsedInSubroutine_Var;
+      out = 0 ;
+      while (tmpvar && out == 0 )
+      {
+         if ( !strcasecmp(tmpvar->var->v_nomvar,ident) &&
+              !strcasecmp(tmpvar->var->v_subroutinename,subroutinename))
+                                                                      out  = 1 ;
+         else tmpvar = tmpvar->suiv;
+      }
+      if ( out == 0 )
+      {
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         strcpy(newvar->var->v_nomvar,ident);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
+         strcpy(newvar->var->v_modulename,curmodulename);
+         strcpy(newvar->var->v_subroutinename,subroutinename);
+         newvar->var->v_pointedvar=pointedvar;
+         newvar->suiv = List_UsedInSubroutine_Var;
+         List_UsedInSubroutine_Var = newvar;
+      }
+  }
+
+   }
+}
+
+/******************************************************************************/
+/*                        AJOUTEVARINDOLOOP_DEFINEDIMENSION                   */
+/******************************************************************************/
+/* This subroutine is used to add a listvar to  List_UsedInSubroutine_Var     */
+/******************************************************************************/
+void ajoutevarindoloop_definedimension (char *name)
+{
+  listvar *newvar;
+  listvar *tmpvar;
+  listvar *tmpvarprec;
+  int out;
+  int tablemeet;
+
+  if ( !List_UsedInSubroutine_Var )
+  {
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
+      /*                                                                      */
+      Init_Variable(newvar->var);
+      /*                                                                      */
+      newvar->suiv = NULL;
+      strcpy(newvar->var->v_nomvar,name);
+      strcpy(newvar->var->v_modulename,curmodulename);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
+      strcpy(newvar->var->v_subroutinename,subroutinename);
+      newvar->var->v_pointedvar=pointedvar;
+      List_UsedInSubroutine_Var = newvar ;
+  }
+  else
+  {
+      /* We should verify that this variable did not added                    */
+      tmpvarprec = (listvar *)NULL;
+      tmpvar = List_UsedInSubroutine_Var;
+      out = 0 ;
+      tablemeet = 0 ;
+      while (tmpvar && out == 0 )
+      {
+         if ( tablemeet == 0 && tmpvar->var->v_nbdim != 0 ) tablemeet = 1 ;
+         /*                                                                   */
+         if ( !strcasecmp(tmpvar->var->v_nomvar,name) &&
+              !strcasecmp(tmpvar->var->v_subroutinename,subroutinename))
+         {
+            out  = 1 ;
+            /* if this variable has been define before a table we do nothing  */
+            /*    else we should remove it                                    */
+            if ( tablemeet == 1 )
+            {
+               tmpvarprec->suiv = tmpvar -> suiv;
+               out = 2;
+            }
+         }
+         else
+         {
+            tmpvarprec = tmpvar;
+            tmpvar = tmpvar->suiv;
+         }
+      }
+      if ( out == 2 || out == 0 )
+      {
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         strcpy(newvar->var->v_nomvar,name);
+         strcpy(newvar->var->v_modulename,curmodulename);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
+         strcpy(newvar->var->v_subroutinename,subroutinename);
+         newvar->var->v_pointedvar=pointedvar;
+
+         /* we should find this new variable to know the tabvars indice       */
+         if ( variableisglobal(newvar, List_Global_Var) == 1 )
+         {
+            newvar->suiv = List_UsedInSubroutine_Var;
+            List_UsedInSubroutine_Var = newvar;
+         }
+         else if ( variableisglobal(newvar, List_ModuleUsed_Var) == 1 )
+         {
+            newvar->suiv = List_UsedInSubroutine_Var;
+            List_UsedInSubroutine_Var = newvar;
+         }
+         else if ( variableisglobal(newvar, List_Common_Var) == 1 )
+         {
+            newvar->suiv = List_UsedInSubroutine_Var;
+            List_UsedInSubroutine_Var = newvar;
+         }
+         else
+         {
+            free(newvar);
+         }
+     }
+  }
+}
+
+/******************************************************************************/
+/*                        ModifyThelistvarindoloop                            */
+/******************************************************************************/
+/* This subroutine is to give the old name to the which has been              */
+/* declared as USE MOD, U => V in this case we should replace in the          */
+/* name V by the old name U in the List_UsedInSubroutine_Var                  */
+/******************************************************************************/
+void  ModifyThelistvarindoloop()
+{
+  listvar *newvar;
+
+  newvar = List_UsedInSubroutine_Var;
+  while ( newvar )
+  {
+     if ( strcasecmp(newvar->var->v_oldname,"") )
+     {
+        strcpy(newvar->var->v_nomvar,newvar->var->v_oldname);
+     }
+     newvar = newvar->suiv;
+  }
+}
+
+/******************************************************************************/
+/*                          CompleteThelistvarindoloop                        */
+/******************************************************************************/
+/* This subroutine is to add to the List_UsedInSubroutine_Var all variables   */
+/* which has been declared as USE MOD, U => V in this case we should replace  */
+/* in the List_UsedInSubroutine_Var the word U by the word V                  */
+/******************************************************************************/
+void  CompleteThelistvarindoloop()
+{
+    listvar *newvar;
+    listvarpointtovar *pointtmplist;
+    listcouple *coupletmp;
+    int outvar;
+
+    pointtmplist = List_CouplePointed_Var;
+    while ( pointtmplist )
+    {
+        coupletmp = pointtmplist->t_couple;
+        while ( coupletmp )
+        {
+            newvar = List_UsedInSubroutine_Var;
+            outvar = 0 ;
+            while ( newvar && outvar == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(newvar->var->v_nomvar, coupletmp->c_namevar) &&
+                     !strcasecmp(newvar->var->v_subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    outvar = 1;
+                    strcpy(newvar->var->v_oldname, newvar->var->v_nomvar);
+                    strcpy(newvar->var->v_nomvar, coupletmp->c_namepointedvar);
+                }
+                else
+                {
+                    newvar = newvar->suiv;
+                }
+            }
+            coupletmp = coupletmp->suiv;
+        }
+        pointtmplist = pointtmplist->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                             Merge_Variables                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Merge_Variables(variable *var1, variable *var2)
+{
+    if ( !strcasecmp(var1->v_typevar,"") )
+            strcpy(var1->v_typevar,var2->v_typevar);
+    else
+      {
+      strcpy(var2->v_typevar,var1->v_typevar);
+      }
+
+    if ( !strcasecmp(var1->v_oldname,"") )
+            strcpy(var1->v_oldname,var2->v_oldname);
+    else    strcpy(var2->v_oldname,var1->v_oldname);
+
+    if ( !strcasecmp(var1->v_dimchar,"") )
+            strcpy(var1->v_dimchar,var2->v_dimchar);
+    else    strcpy(var2->v_dimchar,var1->v_dimchar);
+
+    if ( !strcasecmp(var1->v_commonname,"") )
+            strcpy(var1->v_commonname,var2->v_commonname);
+    else    strcpy(var2->v_commonname,var1->v_commonname);
+
+    if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
+            strcpy(var1->v_modulename,var2->v_modulename);
+    else    strcpy(var2->v_modulename,var1->v_modulename);
+
+    if ( !strcasecmp(var1->v_vallengspec,"") )
+            strcpy(var1->v_vallengspec,var2->v_vallengspec);
+    else    strcpy(var2->v_vallengspec,var1->v_vallengspec);
+
+    if ( !strcasecmp(var1->v_nameinttypename,"") )
+            strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
+    else    strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
+
+    if ( !strcasecmp(var1->v_commoninfile,"") )
+            strcpy(var1->v_commoninfile,var2->v_commoninfile);
+    else    strcpy(var2->v_commoninfile,var1->v_commoninfile);
+
+    if ( !strcasecmp(var1->v_precision,"") )
+            strcpy(var1->v_precision,var2->v_precision);
+    else    strcpy(var2->v_precision,var1->v_precision);
+
+    if ( !strcasecmp(var1->v_initialvalue,"") )
+            strcpy(var1->v_initialvalue,var2->v_initialvalue);
+    else    strcpy(var2->v_initialvalue,var1->v_initialvalue);
+
+    if ( !strcasecmp(var1->v_IntentSpec,"") )
+            strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
+    else    strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
+
+    if ( !strcasecmp(var1->v_readedlistdimension,"") )
+            strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
+    else    strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
+
+    if ( var1->v_dimension )
+            var2->v_dimension = var1->v_dimension ;
+    else    var1->v_dimension = var2->v_dimension ;
+
+    if ( var1->v_nbdim == 0 )
+            var1->v_nbdim = var2->v_nbdim ;
+    else    var2->v_nbdim = var1->v_nbdim ;
+
+    if ( var1->v_common == 0 )
+            var1->v_common = var2->v_common ;
+    else    var2->v_common = var1->v_common ;
+
+    if ( var1->v_positioninblock == 0 )
+            var1->v_positioninblock = var2->v_positioninblock ;
+    else    var2->v_positioninblock = var1->v_positioninblock ;
+
+    if ( var1->v_module == 0 )
+            var1->v_module = var2->v_module ;
+    else    var2->v_module = var1->v_module ;
+
+    if ( var1->v_save == 0 )
+            var1->v_save = var2->v_save ;
+    else    var2->v_save = var1->v_save ;
+
+    if ( var1->v_VariableIsParameter == 0 )
+            var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
+    else    var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
+
+    if ( var1->v_indicetabvars == 0 )
+            var1->v_indicetabvars = var2->v_indicetabvars ;
+    else    var2->v_indicetabvars = var1->v_indicetabvars ;
+
+    if ( var1->v_ExternalDeclare == 0 )
+            var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
+    else    var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
+
+    if ( var1->v_pointedvar == 0 )
+            var1->v_pointedvar = var2->v_pointedvar ;
+    else    var2->v_pointedvar = var1->v_pointedvar ;
+
+    if ( var1->v_dimensiongiven == 0 )
+            var1->v_dimensiongiven = var2->v_dimensiongiven;
+    else    var2->v_dimensiongiven = var1->v_dimensiongiven ;
+
+    if ( var1->v_c_star == 0 )
+            var1->v_c_star = var2->v_c_star;
+    else    var2->v_c_star = var1->v_c_star ;
+
+    if ( var1->v_catvar == 0 )
+            var1->v_catvar = var2->v_catvar;
+    else    var2->v_catvar = var1->v_catvar ;
+
+    if ( var1->v_pointerdeclare == 0 )
+            var1->v_pointerdeclare = var2->v_pointerdeclare ;
+    else    var2->v_pointerdeclare = var1->v_pointerdeclare ;
+
+    if ( var1->v_notgrid == 0 )
+            var1->v_notgrid = var2->v_notgrid ;
+    else    var2->v_notgrid = var1->v_notgrid;
+
+    if ( var1->v_optionaldeclare == 0 )
+            var1->v_optionaldeclare = var2->v_optionaldeclare;
+    else    var2->v_optionaldeclare = var1->v_optionaldeclare ;
+
+    if ( var1->v_allocatable == 0 )
+            var1->v_allocatable = var2->v_allocatable ;
+    else    var2->v_allocatable = var1->v_allocatable ;
+
+    if ( var1->v_target == 0 )
+            var1->v_target = var2->v_target ;
+    else    var2->v_target = var1->v_target ;
+
+    if ( var1->v_dimsempty == 0 )
+            var1->v_dimsempty = var2->v_dimsempty ;
+    else    var2->v_dimsempty = var1->v_dimsempty ;
+}
+
+
+/******************************************************************************/
+/*                      Update_List_Subroutine_Var                            */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_Subroutine_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   listvar *parcours1;
+   int out;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = list_to_modify;
+   while( parcours )
+   {
+      /* looking in List_SubroutineDeclaration_Var                            */
+      parcours1 = List_SubroutineDeclaration_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar)         &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_modulename,     parcours1->var->v_modulename)
+            ) out = 1;
+         else parcours1 = parcours1->suiv;
+      }
+      /* if variable has been found                                           */
+
+      if ( out == 1 ) Merge_Variables(parcours->var,parcours1->var);
+
+      /* looking in List_Dimension_Var                                        */
+      if (out == 0 )
+      {
+        parcours1 = List_Dimension_Var;
+        out = 0;
+        while ( parcours1 && out == 0 )
+        {
+           if ( !strcasecmp(parcours->var->v_nomvar,
+                            parcours1->var->v_nomvar)         &&
+                !strcasecmp(parcours->var->v_subroutinename,
+                            parcours1->var->v_subroutinename) &&
+                !strcasecmp(parcours->var->v_modulename,
+                            parcours1->var->v_modulename)
+              ) out = 1;
+           else
+           {
+              parcoursprec = parcours1;
+              parcours1 = parcours1->suiv;
+           }
+        }
+        /* if variable has been found                                         */
+
+        if ( out == 1 )
+        {
+           Merge_Variables(parcours->var,parcours1->var);
+           /* we should remove this record from the List_Dimension_Var        */
+           if ( parcours1 == List_Dimension_Var )
+           {
+              List_Dimension_Var = List_Dimension_Var -> suiv;
+           }
+           else
+           {
+              parcoursprec->suiv = parcours1 -> suiv;
+           }
+        }
+      }
+      /*                                                                      */
+      parcours = parcours->suiv;
+   }
+}
+
+void Update_List_Global_Var_From_List_Save_Var()
+{
+   listvar *parcours;
+   listvar *newvar;
+   char tmpname[LONG_VNAME];
+
+   parcours = List_Save_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,"") )
+      /* Save in subroutine which is not defined in a module                  */
+      {
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         newvar->suiv = NULL;
+         Merge_Variables(parcours->var,newvar->var);
+         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+         newvar->var->v_catvar=parcours->var->v_catvar;
+         sprintf(tmpname,"save_%s",parcours->var->v_subroutinename);
+         Add_NameOfCommon_1(tmpname,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_commonname,tmpname);
+         List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1);
+      }
+      else
+      /* Save in subroutine which is defined in a module                      */
+      {
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         newvar->suiv = NULL;
+
+         Merge_Variables(parcours->var,newvar->var);
+         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
+
+         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+
+         newvar->var->v_catvar=parcours->var->v_catvar;
+         strcpy(newvar->var->v_modulename,parcours->var->v_modulename);
+         List_Global_Var = AddListvarToListvar(newvar,List_Global_Var,1);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+/******************************************************************************/
+/*                      Update_List_From_Common_Var                           */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_From_Common_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int out;
+   parcours = list_to_modify;
+   while( parcours )
+   {
+      /* looking in List_Global_Var                                           */
+      parcours1 = List_Common_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar) &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) )
+         {
+            out = 1;
+         }
+         else parcours1 = parcours1->suiv;
+      }
+      /* if variable has been found                                           */
+      if ( out == 1 )
+      {
+         strcpy(parcours->var->v_commoninfile,parcours1->var->v_commoninfile);
+
+         Merge_Variables(parcours->var,parcours1->var);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+/******************************************************************************/
+/*                          Update_List_Var                                   */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_Var(listvar *list_to_modify)
+{
+    listvar *parcours;
+    listvar *parcours1;
+    int out;
+
+    parcours = list_to_modify;
+
+    while( parcours )
+    {
+        /*printf("LE NOM EST %s\n",parcours->var->v_nomvar);*/
+        /* looking in List_Global_Var                                           */
+        out = 0;
+        parcours1 = List_Global_Var;
+
+        while ( parcours1 && out == 0 )
+        {
+            if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)         &&
+                 !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+            {
+                out = 1;
+            }
+            else parcours1 = parcours1->suiv;
+        }
+
+        /* if variable has been found                                           */
+        if ( out == 1 )
+        {
+            Merge_Variables(parcours->var,parcours1->var);
+        }
+        /* looking in List_SubroutineDeclaration_Var                            */
+        else
+        {
+            parcours1 = List_SubroutineDeclaration_Var ;
+            out = 0;
+            while ( parcours1 )
+            {
+                if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                     !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                     !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                {
+                    out = 1;
+                    break;
+                }
+                else parcours1 = parcours1->suiv;
+            }
+            /* if variable has been found                                        */
+            if ( out == 1 )
+            {
+                Merge_Variables(parcours->var,parcours1->var);
+            }
+            else
+            {
+                parcours1 = List_Common_Var ;
+                out = 0;
+                while ( parcours1 && out == 0 )
+                {
+                    if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                         !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                         !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                    {
+                        out = 1;
+                    }
+                    else parcours1 = parcours1->suiv;
+                }
+                /* if variable has been found                                     */
+                if ( out == 1 )
+                {
+                    Merge_Variables(parcours->var,parcours1->var);
+                }
+            }
+        }
+        parcours = parcours->suiv;
+    }
+}
+
+
+void List_UsedInSubroutine_Var_Update_From_Module_Used()
+{
+   listvar *parcours;
+   listvar *parcours3;
+   listusemodule *parcours2;
+   int out;
+
+
+   parcours = List_UsedInSubroutine_Var;
+   while( parcours )
+   {
+      out = 0 ;
+      if ( parcours->var->v_indicetabvars == 0 )
+      {
+         parcours2 = List_NameOfModuleUsed;
+         while( parcours2 )
+         {
+            if ( !strcasecmp(parcours2->u_cursubroutine, "") &&
+                 !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) )
+            {
+               parcours3 = List_Global_Var;
+               out = 0 ;
+               while ( parcours3 && out == 0 )
+               {
+                  if ( !strcasecmp(parcours->var->v_nomvar,
+                                   parcours3->var->v_nomvar)
+                     ) out = 1 ;
+                  else parcours3 = parcours3->suiv;
+               }
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
+            }
+            else if ( !strcasecmp(parcours2->u_cursubroutine, parcours->var->v_subroutinename) &&
+                      !strcasecmp(parcours2->u_modulename,    parcours->var->v_modulename) )
+            {
+               parcours3 = List_Global_Var;
+               out = 0 ;
+               while ( parcours3 && out == 0 )
+               {
+                  if ( !strcasecmp(parcours->var->v_nomvar,
+                                   parcours3->var->v_nomvar)
+                     ) out = 1 ;
+                  else parcours3 = parcours3->suiv;
+               }
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
+            }
+            parcours2 = parcours2->suiv;
+         }
+         /*                                                                   */
+         if ( out == 0 )
+         {
+            parcours3 = List_ModuleUsed_Var;
+            out = 0 ;
+            while ( parcours3 && out == 0 )
+            {
+               if ( !strcasecmp(parcours->var->v_nomvar,
+                                parcours3->var->v_nomvar)
+                  ) out = 1 ;
+               else parcours3 = parcours3->suiv;
+            }
+            if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
+         }
+         /*                                                                   */
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+
+
+/******************************************************************************/
+/*                       Update_NotGridDepend_Var                             */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_NotGridDepend_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int out;
+
+   parcours = list_to_modify;
+   while( parcours )
+   {
+      /* looking in List_Global_Var                                           */
+      parcours1 = List_Global_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                          parcours1->var->v_nomvar)
+            ) out = 1;
+         else parcours1 = parcours1->suiv;
+      }
+      /* if variable has been found                                           */
+      if ( out == 1 )
+      {
+         Merge_Variables(parcours->var,parcours1->var);
+         strcpy(parcours->var->v_subroutinename,
+                parcours1->var->v_subroutinename);
+         strcpy(parcours->var->v_modulename,parcours1->var->v_modulename);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+int LookingForVariableInList(listvar *listin,variable *var)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
+           !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&&
+           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)        &&
+                       var->v_save == 0                                       &&
+                       var->v_common == 0
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+int LookingForVariableInListGlobal(listvar *listin,variable *var)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
+           !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&&
+           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+int LookingForVariableInListName(listvar *listin,const char *name)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(name,parcours1->var->v_nomvar) &&
+           ( !strcasecmp(subroutinename,parcours1->var->v_subroutinename) ||
+             !strcasecmp(subroutinename,"") )
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+variable *get_variable_in_list_from_name( listvar *listin, const char *name )
+{
+    listvar *parcours = listin;
+    variable *var = NULL;
+
+    while ( parcours && (!var) )
+    {
+        if ( !strcasecmp(name,parcours->var->v_nomvar) &&
+           ( !strcasecmp(subroutinename,parcours->var->v_subroutinename) ||
+             !strcasecmp(subroutinename,"") ) )
+        {
+            var = parcours->var;
+        }
+        else parcours = parcours -> suiv;
+   }
+   return var;
+}
+
+int LookingForVariableInListGlob(listvar *listin,variable *var)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
+           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+int LookingForVariableInListParamGlob(listparameter *listin,variable *var)
+{
+   listparameter *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->p_name)
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+void UpdateListDeclarationWithDimensionList()
+{
+   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, List_SubroutineDeclaration_Var,1);
+}
+
+
+/* Remove from List_UsedInSubroutine_Var all variables comming from :         */
+/*       - List_SubroutineArgument_Var                                        */
+/*       - List_SubroutineDeclaration_Var                                     */
+/*       - List_Parameter_Var                                                 */
+/*       - List_FunctionType_Var                                              */
+/*       - List_GlobalParameter_Var                                           */
+/*       -                                                                    */
+/*       -                                                                    */
+void Clean_List_UsedInSubroutine_Var()
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   int remove;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = List_UsedInSubroutine_Var;
+   while ( parcours )
+   {
+      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,   parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInList(List_SubroutineDeclaration_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInList(List_Parameter_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInList(List_FunctionType_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInListGlob(List_GlobalParameter_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInListParamGlob(List_GlobParamModuleUsed_Var, parcours->var);
+      if ( remove == 0 )
+      {
+         if ( VariableIsInList(parcours,List_Global_Var)                 == 1 ||
+              VariableIsInListCommon(parcours,List_Common_Var)           == 1 ||
+              VariableIsInList(parcours,List_ModuleUsed_Var)             == 1 ||
+              VariableIsInList(parcours,List_ModuleUsedInModuleUsed_Var) == 1
+            ) remove = 0;
+         else remove = 1;
+      }
+
+      /************************************************************************/
+      /*                         Remove                                       */
+      /************************************************************************/
+
+      if ( remove == 1 )
+      {
+         if ( parcours == List_UsedInSubroutine_Var )
+         {
+           List_UsedInSubroutine_Var = List_UsedInSubroutine_Var -> suiv;
+           parcours = List_UsedInSubroutine_Var;
+         }
+         else
+         {
+            parcoursprec->suiv = parcours->suiv;
+            parcours = parcoursprec -> suiv ;
+         }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours -> suiv ;
+      }
+   }
+}
+
+
+void Clean_List_ModuleUsed_Var()
+{
+   listvar *parcours;
+   listvar *parcours1;
+   listvar *parcoursprec;
+   int remove;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = List_ModuleUsed_Var;
+   while ( parcours )
+   {
+      /*                                                                      */
+      parcours1 = List_GlobalParameter_Var;
+      remove = 0 ;
+      while ( parcours1 && remove == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+            ) remove = 1 ;
+         else parcours1 = parcours1 -> suiv;
+      }
+      /************************************************************************/
+      /*                         Remove                                       */
+      /************************************************************************/
+      if ( remove == 1 )
+      {
+         if ( parcours == List_ModuleUsed_Var )
+         {
+           List_ModuleUsed_Var = List_ModuleUsed_Var -> suiv;
+           parcours = List_ModuleUsed_Var;
+         }
+         else
+         {
+            parcoursprec->suiv = parcours->suiv;
+            parcours = parcoursprec -> suiv ;
+         }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours -> suiv ;
+      }
+   }
+}
+
+void Clean_List_SubroutineDeclaration_Var()
+{
+   listvar *parcours;
+   listvar *parcours1;
+   listvar *parcoursprec;
+   int out ;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = List_SubroutineDeclaration_Var;
+   while ( parcours )
+   {
+      parcours1 = List_FunctionType_Var;
+      out = 0 ;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+            ) out = 1;
+         else parcours1 = parcours1->suiv;
+      }
+      if ( out == 0 )
+      {
+         parcours1 = List_SubroutineArgument_Var;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+               ) out = 1;
+            else parcours1 = parcours1->suiv;
+         }
+      }
+
+      if ( out == 1 )
+      {
+          if ( parcours == List_SubroutineDeclaration_Var )
+          {
+             List_SubroutineDeclaration_Var =
+                                         List_SubroutineDeclaration_Var -> suiv;
+             parcours = List_SubroutineDeclaration_Var;
+          }
+          else
+          {
+             parcoursprec->suiv = parcours->suiv;
+             parcours = parcoursprec->suiv;
+          }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours -> suiv;
+      }
+   }
+}
+
+void Clean_List_Global_Var()
+{
+   listvar *parcours;
+   listvar *parcours2;
+   listvar *parcoursprec;
+   listvar *parcours2prec;
+
+   parcoursprec = (listvar *)NULL;
+   parcours2prec = (listvar *)NULL;
+   parcours = List_Global_Var;
+   while ( parcours )
+   {
+      if ( parcours->var->v_VariableIsParameter == 1 )
+      {
+         /* remove                                                            */
+         if ( parcours == List_Global_Var )
+         {
+            List_Global_Var = List_Global_Var->suiv;
+            free(parcours);
+            parcours = List_Global_Var;
+         }
+         else
+         {
+            parcoursprec->suiv = parcours->suiv;
+            free(parcours);
+            parcours = parcoursprec->suiv;
+         }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours->suiv;
+      }
+   }
+   /* looking for sevral declaration of the same variable                     */
+   parcours = List_Global_Var;
+   while ( parcours )
+   {
+      parcours2prec = parcours;
+      parcours2 = parcours->suiv;
+      while ( parcours2 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                         parcours2->var->v_nomvar)     &&
+              !strcasecmp(parcours->var->v_modulename,
+                         parcours2->var->v_modulename) )
+         {
+            Merge_Variables(parcours->var,parcours2->var);
+            /* remove var from the parcours2                                  */
+            parcours2prec ->suiv = parcours2->suiv;
+            free(parcours2);
+            parcours2 = parcours2prec ->suiv;
+         }
+         else
+         {
+            parcours2prec = parcours2;
+            parcours2 = parcours2->suiv;
+         }
+      }
+      parcours = parcours->suiv;
+   }
+}
+/******************************************************************************/
+/*                             ListClean                                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void ListClean()
+{
+   listvar *newvar;
+
+   Clean_List_ModuleUsed_Var();
+   Clean_List_UsedInSubroutine_Var();
+   Clean_List_SubroutineDeclaration_Var();
+
+   newvar = (listvar *)NULL;
+/*   newvar = List_Common_Var;*/
+   while(newvar)
+   {
+      printf("----- %s --- %s ---%s---%s---\n",newvar->var->v_nomvar,
+         newvar->var->v_commonname,
+         newvar->var->v_readedlistdimension,
+         newvar->var->v_subroutinename
+      );
+      newvar = newvar -> suiv;
+      printf("+++++++++++++++++++++++++\n");
+   }
+
+}
+
+
+/******************************************************************************/
+/*                             ListUpdate                                     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void ListUpdate()
+{
+    listvar *newvar;
+
+    Update_List_Subroutine_Var(List_SubroutineArgument_Var);
+    Update_List_Subroutine_Var(List_FunctionType_Var);
+    Update_List_Var(List_Parameter_Var);
+    Update_List_Var(List_Dimension_Var);
+    Update_List_Var(List_Data_Var);
+    Update_List_Var(List_Save_Var);
+    Update_List_Var(List_GlobalParameter_Var);
+    Update_List_Var(List_Common_Var);
+    Update_List_Var(List_SubroutineDeclaration_Var);
+    Update_List_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
+    Update_NotGridDepend_Var(List_NotGridDepend_Var);
+
+    newvar = (listvar * ) NULL;
+//   newvar = List_Common_Var;
+//   newvar = List_UsedInSubroutine_Var;
+//   newvar = List_Data_Var;
+    while ( newvar )
+    {
+        printf("++++ %s - %s - %s - %d - %s - %s\n",
+                newvar->var->v_modulename,
+                newvar->var->v_subroutinename,
+                newvar->var->v_nomvar,
+                newvar->var->v_VariableIsParameter,
+                newvar->var->v_typevar,
+                newvar->var->v_initialvalue );
+        newvar = newvar->suiv;
+    }
+}
+
+void GiveTypeOfVariables()
+{
+   listvar *parcours;
+
+   /*                                                                         */
+   parcours = List_Common_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+   /*                                                                         */
+   parcours = List_UsedInSubroutine_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+   /*                                                                         */
+   parcours = List_SubroutineArgument_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+   /*                                                                         */
+   parcours = List_SubroutineDeclaration_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+
+}
+
+
+
+void Sort_List_SubroutineArgument_Var()
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int position;
+   int out;
+   char name_sub[LONG_M];
+
+   parcours = List_SubroutineArgument_Var;
+   position = 1;
+   while ( parcours )
+   {
+      parcours1 = List_SubroutineDeclaration_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                         parcours1->var->v_nomvar)  &&
+              !strcasecmp(parcours->var->v_subroutinename,
+                         parcours1->var->v_subroutinename)
+             )
+         {
+            parcours1->var->v_positioninblock = position;
+            position = position +1 ;
+            out = 1;
+         }
+         else parcours1 = parcours1->suiv;
+      }
+      parcours = parcours->suiv;
+   }
+   /*                                                                         */
+   parcours = List_SubroutineDeclaration_Var;
+   strcpy(name_sub,"");
+   while ( parcours )
+   {
+      if ( !strcasecmp(name_sub,"") )
+      {
+         strcpy(name_sub,parcours->var->v_subroutinename);
+         position = 1;
+      }
+
+      if ( parcours->var->v_positioninblock != 0 )
+      {
+         parcours1 = List_SubroutineArgument_Var;
+         out = 0;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,
+                            parcours1->var->v_nomvar)  &&
+                 !strcasecmp(parcours->var->v_subroutinename,
+                            parcours1->var->v_subroutinename)
+                )
+            {
+               parcours1->var->v_positioninblock = position;
+               position = position +1 ;
+               out = 1;
+            }
+            else parcours1 = parcours1->suiv;
+         }
+      }
+      if ( parcours->suiv )
+         if ( strcasecmp(name_sub,parcours->suiv->var->v_subroutinename) )
+            strcpy(name_sub,"");
+      parcours = parcours->suiv;
+   }
+
+}
+
+
+
+/******************************************************************************/
+/*                      IndiceTabvars_Global_Var_Treated                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Global_Var_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   listvar *parcours1;
+   listvar *List_ModuleUsed_Var;
+   listindice *newindice;
+   int out;
+
+   parcoursprec = (listvar *)NULL;
+
+   if ( todebug == 1 ) printf("MODULE Treated %s \n",nom);
+
+   List_ModuleUsed_Var = (listvar *)NULL;
+   List_ModuleUsed_Var = Readthedependfile(nom,List_ModuleUsed_Var);
+
+   parcours = List_Global_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,nom) )
+      {
+         parcours1 = List_ModuleUsed_Var;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+               ) out = 1;
+            else
+            {
+               parcoursprec = parcours1 ;
+               parcours1 = parcours1->suiv;
+            }
+         }
+         /* if we found the var Module name in the old list                   */
+         if ( out == 1 )
+         {
+            Merge_Variables(parcours->var,parcours1->var);
+            /* Remove this variable from the List_ModuleUsed_Var              */
+            if ( parcours1 == List_ModuleUsed_Var )
+            {
+               List_ModuleUsed_Var = List_ModuleUsed_Var->suiv ;
+            }
+            else
+            {
+               parcoursprec->suiv = parcours1->suiv;
+               free(parcours1);
+               parcours1 = parcoursprec->suiv;
+            }
+         }
+         else
+         /* if we do not found the var Module name in the old list            */
+         {
+  //       update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+  //          if ( Listofavailableindices )
+  //          {
+  //             parcours->var->v_indicetabvars = Listofavailableindices ->
+  //                                                                     i_indice;
+  //             if ( Listofavailableindices->suiv )
+  //                        Listofavailableindices = Listofavailableindices->suiv;
+  //             else
+  //                        Listofavailableindices = (listindice *)NULL;
+  //          }
+  //          else
+  //          {
+  //             indicemaxtabvars = indicemaxtabvars + 1 ;
+  //             parcours->var->v_indicetabvars = indicemaxtabvars;
+  //          }
+         }
+      }
+      parcours = parcours->suiv;
+   }
+   /* if List_ModuleUsed_Var is not empty, some var have been removed from    */
+   /*    the last treatement                                                  */
+  parcours1 = List_ModuleUsed_Var;
+  while ( parcours1 )
+  {
+     newindice=(listindice *) calloc(1,sizeof(listindice));
+     newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
+     newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+     Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
+     parcours1 = parcours1->suiv;
+  }
+}
+/******************************************************************************/
+/*                       IndiceTabvars_Global_Var_No_Treated                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Global_Var_No_Treated(char *nom)
+{
+   listvar *parcours;
+
+   if ( todebug == 1 ) printf("MODULE No Treated %s \n",nom);
+
+   parcours = List_Global_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,nom) &&
+           parcours->var->v_VariableIsParameter == 0    &&
+           parcours->var->v_notgrid == 0
+          )
+      {
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+
+void UpdateTheRemainingList(listvar *record)
+{
+   listvar *parcours;
+
+   parcours = record;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_nomvar,record->var->v_nomvar) &&
+           !strcasecmp(parcours->var->v_commonname,record->var->v_commonname)
+         )
+      {
+         strcpy(parcours->var->v_commoninfile,record->var->v_commoninfile);
+         Merge_Variables(parcours->var,record->var);
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+
+
+/******************************************************************************/
+/*                      IndiceTabvars_Common_Var_Treated                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Common_Var_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   listvar *List_CommonUsed_Var;
+   listindice *newindice;
+   int out;
+
+   if ( todebug == 1 ) printf("COMMON Treated %s \n",nom);
+
+   List_CommonUsed_Var = (listvar *)NULL;
+   List_CommonUsed_Var = Readthedependfile(nom,List_CommonUsed_Var);
+
+   parcours = List_Common_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_commonname,nom) )
+      {
+         parcours1 = List_CommonUsed_Var;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+
+            if ( !strcasecmp(parcours1->var->v_commonname,nom) &&
+                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+               ) out = 1;
+            else
+            {
+               parcours1 = parcours1->suiv;
+            }
+         }
+         /* if we found the var common name in the old list                   */
+         if ( out == 1 )
+         {
+            strcpy(parcours->var->v_commoninfile,
+                   parcours1->var->v_commoninfile);
+            Merge_Variables(parcours->var,parcours1->var);
+         }
+         else
+         /* if we do not found the var common name in the old list            */
+         {
+    //     update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+    //        if ( Listofavailableindices )
+    //        {
+    //           parcours->var->v_indicetabvars = Listofavailableindices ->
+    //                                                                   i_indice;
+    //           if ( Listofavailableindices->suiv )
+    //                      Listofavailableindices = Listofavailableindices->suiv;
+    //           else
+    //                      Listofavailableindices = (listindice *)NULL;
+    //        }
+    //        else
+    //        {
+    //           indicemaxtabvars = indicemaxtabvars + 1 ;
+    //           parcours->var->v_indicetabvars = indicemaxtabvars;
+    //        }
+         }
+         /* Look in the remaining list in the variable is define              */
+         UpdateTheRemainingList(parcours);
+      }
+      parcours = parcours->suiv;
+   }
+   /* if List_CommonUsed_Var is not empty, some var have been removed from    */
+   /*    the last treatement                                                  */
+  parcours1 = List_CommonUsed_Var;
+  while ( parcours1 )
+  {
+     if ( parcours1 -> var -> v_indicetabvars == 0 )
+     {
+        newindice=(listindice *) calloc(1,sizeof(listindice));
+        newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
+        newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+        Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
+     }
+     parcours1 = parcours1->suiv;
+  }
+}
+
+void update_indicemaxtabvars(variable *var,listindice **Listofindices)
+{
+
+
+            if ( Listofindices[var->v_catvar] )
+            {
+               var->v_indicetabvars = Listofindices[var->v_catvar] -> i_indice;
+               if ( Listofindices[var->v_catvar]->suiv )
+                          Listofindices[var->v_catvar] = Listofindices[var->v_catvar]->suiv;
+               else
+                          Listofindices[var->v_catvar] = (listindice *)NULL;
+            }
+            else
+            {
+               indicemaxtabvars[var->v_catvar] = indicemaxtabvars[var->v_catvar] + 1 ;
+               var->v_indicetabvars = indicemaxtabvars[var->v_catvar];
+            }
+
+}
+
+/******************************************************************************/
+/*                     IndiceTabvars_Common_Var_No_Treated                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Common_Var_No_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcours2;
+
+   if ( todebug == 1 ) printf("COMMON No Treated %s \n",nom);
+
+   parcours = List_Common_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_commonname,nom) &&
+           strcasecmp(parcours->var->v_subroutinename,"") &&
+           parcours->var->v_indicetabvars == 0
+          )
+      {
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
+         parcours2 = parcours;
+         while ( parcours2 )
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,
+                             parcours2->var->v_nomvar) &&
+                 !strcasecmp(parcours->var->v_commonname,
+                             parcours2->var->v_commonname)
+               )
+               parcours2->var->v_indicetabvars = parcours->var->v_indicetabvars;
+            parcours2 = parcours2->suiv;
+         }
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+
+/******************************************************************************/
+/*                       IndiceTabvarsIdentification                          */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvarsIdentification()
+{
+   listnom *parcours_nom;
+
+   /* Identification of tabvars indices in List_Global_Var                    */
+   parcours_nom = List_NameOfModule;
+   while ( parcours_nom )
+   {
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
+      {
+         IndiceTabvars_Global_Var_Treated(parcours_nom->o_nom);
+      }
+      else
+      {
+         IndiceTabvars_Global_Var_No_Treated(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+   /* Identification of tabvars indices in List_Common_Var                    */
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
+      {
+         IndiceTabvars_Common_Var_Treated(parcours_nom->o_nom);
+      }
+      else
+      {
+         IndiceTabvars_Common_Var_No_Treated(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+
+}
+
+void New_Allocate_Subroutine_Is_Necessary()
+{
+   listnom *parcours_nom;
+   listvar *parcours;
+   int out;
+
+   parcours_nom = List_NameOfModule;
+   while ( parcours_nom )
+   {
+      /*                                                                      */
+      parcours = List_Global_Var;
+      out = 0 ;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+              !strcasecmp(parcours->var->v_subroutinename,"")            &&
+              parcours->var->v_VariableIsParameter == 0                  &&
+              ( parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type"))      &&
+              parcours->var->v_notgrid == 0                              &&
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
+         else parcours = parcours -> suiv;
+      }
+      if ( out )
+      {
+         parcours_nom->o_val = 1 ;
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+}
+
+void New_Allocate_Subroutine_For_Common_Is_Necessary()
+{
+   listnom *parcours_nom;
+   listvar *parcours;
+   int out;
+
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      parcours = List_Common_Var;
+      out = 0 ;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom)  &&
+              strcasecmp(parcours->var->v_subroutinename,"")                &&
+              !strcasecmp(parcours->var->v_commoninfile,cur_filename)       &&
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
+         else parcours = parcours -> suiv;
+      }
+      if ( out == 1 )
+      {
+         parcours_nom->o_val = 1 ;
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+}
+
+void NewModule_Creation_0()
+{
+   listnom *parcours_nom;
+
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      if ( parcours_nom->o_val == 1 )
+      {
+         fprintf(fortran_out, "      module %s\n\n", parcours_nom->o_nom);
+         WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
+         fprintf(fortran_out, "        implicit none\n");
+         fprintf(fortran_out, "        public :: Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      contains\n");
+         fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "        use Agrif_Util\n");
+         fprintf(fortran_out, "        type(Agrif_grid), pointer :: Agrif_Gr\n");
+         fprintf(fortran_out, "        integer :: i\n");
+         fprintf(fortran_out, "#include \"alloc_agrif_%s.h\"\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end module %s\n", parcours_nom->o_nom);
+         /* List all Call Alloc_agrif                                      */
+         Add_Subroutine_For_Alloc(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom->suiv;
+   }
+}
+
+void UpdateList_SubroutineWhereAgrifUsed()
+{
+   listnom *parcours;
+   listusemodule *parcours1;
+   listallocate *parcours2;
+   listname *parcours3;
+   listvar *parcours4;
+   int out;
+   char name_module[LONG_M];
+
+   /* We should integrate allocate and pointer variables                      */
+//    parcours2 = List_Allocate_Var;
+//    while ( parcours2 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours2 = parcours2->suiv;
+//    }
+//
+//    parcours3 = List_Pointer_Var;
+//    while ( parcours3 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours3->n_name, parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours3 = parcours3 -> suiv;
+//    }
+//    parcours4 = List_UsedInSubroutine_Var;
+//    while ( parcours4 )
+//    {
+//       if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
+//       {
+//          Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//       }
+//       parcours4 = parcours4 -> suiv ;
+//    }
+
+   parcours = List_SubroutineWhereAgrifUsed;
+   while ( parcours )
+   {
+      parcours1 = List_NameOfModuleUsed;
+      out = 0 ;
+      strcpy(name_module,"");
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) &&
+              !strcasecmp(parcours1->u_usemodule,"Agrif_Util")
+            ) out = 1;
+         else
+         {
+            if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) )
+            {
+               strcpy(name_module, parcours->o_module);
+            }
+            parcours1 = parcours1->suiv;
+         }
+      }
+      if ( out == 0 )   /* we should look in the module declaration */
+      {
+         parcours1 = List_NameOfModuleUsed;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(name_module,parcours1->u_modulename) &&
+                 !strcasecmp(parcours1->u_cursubroutine,"")&&
+                 !strcasecmp(parcours1->u_usemodule,"Agrif_Util")
+               ) out = 1;
+            else parcours1 = parcours1->suiv;
+         }
+      }
+      if ( out == 0 ) parcours->o_val = 1;
+
+      parcours = parcours->suiv;
+   }
+}
+
+
+void UpdateList_UsedInSubroutine_With_dimension()
+{
+   listvar *parcours;
+
+   parcours = List_UsedInSubroutine_Var;
+   while ( parcours )
+   {
+      if ( parcours->var->v_nbdim != 0 )
+      {
+         strcpy(subroutinename,parcours->var->v_subroutinename);
+         DecomposeTheName(parcours->var->v_readedlistdimension);
+         strcpy(subroutinename,"");
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+void Affiche(listvar *in_parcours)
+{
+/*   parcours = List_Global_Var;                  */
+/*   parcours = List_SubroutineDeclaration_Var;   */
+/*   parcours = List_SubroutineArgument_Var;      */
+/*   parcours = List_FunctionType_Var;            */
+/*   parcours = List_Data_Var;                    */
+/*   parcours = List_Save_Var;                    */
+/*   parcours = List_UsedInSubroutine_Var;        */
+/*   parcours = List_Parameter_Var;               */
+/*   parcours = List_GlobalParameter_Var;         */
+/*   parcours = List_NotGridDepend_Var;           */
+/*   parcours = List_Common_Var;                  */
+   listvar *parcours = in_parcours;
+
+   while( parcours )
+   {
+      printf("modulename     - %s \n", parcours->var->v_modulename);
+      printf("subroutinename - %s \n", parcours->var->v_subroutinename);
+      printf("nomvar         - %s \n", parcours->var->v_nomvar);
+      printf("commonname     - %s \n", parcours->var->v_commonname);
+      printf("commoninfile   - %s \n", parcours->var->v_commoninfile);
+      printf("typevar        - %s \n", parcours->var->v_typevar);
+      printf("catvar         - %d \n", parcours->var->v_catvar);
+      printf("indicetabvars  - %d \n", parcours->var->v_indicetabvars);
+      printf("isparameter    - %d \n", parcours->var->v_VariableIsParameter);
+      printf("module         - %d \n", parcours->var->v_module);
+      printf("save           - %d \n", parcours->var->v_save);
+      printf("notgrid        - %d \n", parcours->var->v_notgrid);
+      printf("nbdim          - %d \n", parcours->var->v_nbdim);
+      printf("common         - %d \n", parcours->var->v_common);
+      printf("dimensiongiven - %d \n", parcours->var->v_dimensiongiven);
+      printf("dimsempty      - %d \n", parcours->var->v_dimsempty);
+      printf("initialvalue   - %s \n", parcours->var->v_initialvalue);
+      printf("readedlistdim  - %s \n", parcours->var->v_readedlistdimension);
+      printf("-------------------------------------\n");
+
+      parcours = parcours -> suiv ;
+   }
+   if ( todebug == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars[0]);
+}
+
+int SubInList_ContainsSubroutine()
+{
+   int out;
+   listnom *parcours;
+
+   out = 0 ;
+   parcours = List_ContainsSubroutine;
+   while ( parcours && out == 0 )
+   {
+      if ( !strcasecmp(parcours->o_nom,subroutinename) ) out = 1 ;
+      else parcours = parcours -> suiv;
+   }
+
+   return out;
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 8732)
@@ -0,0 +1,78 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                      Add_SubroutineArgument_Var_1                          */
+/******************************************************************************/
+void Add_SubroutineArgument_Var_1(listvar *listtoadd)
+{
+    List_SubroutineArgument_Var = AddListvarToListvar(listtoadd, List_SubroutineArgument_Var, 1);
+}
+
+/******************************************************************************/
+/*                             Add_FunctionType_Var_1                         */
+/******************************************************************************/
+void Add_FunctionType_Var_1(const char *nom)
+{
+    listvar *newvar;
+
+    curvar = createvar(nom, NULL);
+    strcpy(curvar->v_typevar, DeclType);
+    newvar = insertvar(NULL, curvar);
+    List_FunctionType_Var = AddListvarToListvar(newvar,List_FunctionType_Var,1);
+}
+
+/******************************************************************************/
+/*                      Add_SubroutineDeclaration_Var_1                       */
+/******************************************************************************/
+/* We should complete the listvarofsubroutine                                 */
+/******************************************************************************/
+// void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
+// {
+//    if ( firstpass == 1 )
+//    {
+//       if ( VariableIsParameter == 0 &&
+//            SaveDeclare         == 0 )
+//       {
+//          listduplicated = (listvar *)NULL;
+//          duplicatelistvar(listtoadd);
+//          List_SubroutineDeclaration_Var = AddListvarToListvar(listduplicated,List_SubroutineDeclaration_Var,1);
+//       }
+//    }
+// }
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 8732)
@@ -0,0 +1,159 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                            tofich_reste                                    */
+/******************************************************************************/
+/* This subroutine is used to write the string s into the fileout             */
+/******************************************************************************/
+void tofich_reste (FILE * filout, const char *s, int do_returnline)
+{
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
+
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
+    {
+        if ( do_returnline ) fprintf(filout, "     &%s\n", s);
+        else                 fprintf(filout, "&%s", s);
+    }
+    else
+    {
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
+        if ( retour77 == 0 && (s_length-strlen(temp) > 0) )
+                fprintf(filout, "     &%s&\n", temp);
+        else    fprintf(filout, "     &%s\n", temp);
+
+        if ( s_length-strlen(temp) > 0 )
+            tofich_reste(filout, (char *) &s[line_length], do_returnline);
+    }
+}
+
+/******************************************************************************/
+/*                            tofich                                          */
+/******************************************************************************/
+/* This subroutine is used to write the string s into the fileout             */
+/******************************************************************************/
+void tofich (FILE * filout, const char *s, int do_returnline)
+{
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
+
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
+    {
+        if ( do_returnline ) fprintf(filout, "      %s\n", s);
+        else                 fprintf(filout, "%s", s);
+    }
+    else
+    {
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
+
+        if ( retour77 == 0 )    fprintf(filout, "      %s&\n", temp);
+        else                    fprintf(filout, "      %s\n", temp);
+
+        tofich_reste(filout, (char *) &s[line_length], do_returnline);
+    }
+}
+
+/******************************************************************************/
+/*                       tofich_blanc                                         */
+/******************************************************************************/
+/* This subroutine is used to write size blank into the fileout               */
+/******************************************************************************/
+void tofich_blanc (FILE * filout, int size)
+{
+    const char* empty_char = " ";
+    int i = 0;
+
+    if (size <= 65)
+        fprintf(filout, "%*s\n", size, empty_char);
+    else
+    {
+        do
+        {
+            fprintf(filout, "%*s\n", 65, empty_char);
+            i++;
+        }
+        while ( i <= size / 65 );
+
+        fprintf(filout, "%*s\n", size%65, empty_char);
+    }
+}
+
+/******************************************************************************/
+/*                           RemoveWordSET_0                                  */
+/******************************************************************************/
+/* This subroutine is used to remove a sentence in the file filout            */
+/******************************************************************************/
+void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove)
+{
+    if ( inside_type_declare || firstpass ) return;
+
+    fseek(filout, position, SEEK_SET);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, position, SEEK_SET);
+}
+
+/******************************************************************************/
+/*                         RemoveWordCUR_0                                    */
+/******************************************************************************/
+/* This subroutine is used to remove a sentence in the file filout            */
+/******************************************************************************/
+void RemoveWordCUR_0(FILE * filout, int sizetoremove)
+{
+    if ( inside_type_declare || firstpass ) return;
+
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    if ( strstr(fortran_text, "\n") )   fprintf(filout, "\n");
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 8732)
@@ -0,0 +1,668 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "decl.h"
+
+/******************************************************************************/
+/*                         WriteBeginDeclaration                              */
+/******************************************************************************/
+/* This subroutine is used to write the begin of a declaration                */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*       integer variable ----------->   INTEGER                              */
+/*                                                                            */
+/******************************************************************************/
+void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility)
+{
+  char tmpligne[LONG_M];
+  int precision_given ;
+
+  if ( !strcasecmp(v->v_typevar,"") )
+  {
+     printf("# WARNING : The type of the variable %s is unknown.\n", v->v_nomvar);
+     printf("#           CONV should define a type\n");
+  }
+
+  sprintf(line, "%s", v->v_typevar);
+  if ( v->v_c_star == 1 ) strcat(line, "*");
+
+  /* We should give the precision of the variable if it has been given        */
+  precision_given = 0;
+  if ( strcasecmp(v->v_precision,"") )
+  {
+     sprintf(tmpligne, "(%s)", v->v_precision);
+     Save_Length(tmpligne, 49);
+     strcat(line, tmpligne);
+     precision_given = 1;
+  }
+
+  if (strcasecmp(v->v_dimchar,""))
+  {
+     sprintf(tmpligne,"(%s)",v->v_dimchar);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+
+  if ((precision_given == 0) && ( strcasecmp(v->v_nameinttypename,"") ))
+  {
+     sprintf(tmpligne,"*%s",v->v_nameinttypename);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+  if (strcasecmp (v->v_IntentSpec, ""))
+  {
+     sprintf(tmpligne,", intent(%s)", v->v_IntentSpec);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+  if ( v->v_VariableIsParameter ) strcat(line, ", parameter");
+  if ( visibility )
+  {
+      if ( v->v_PublicDeclare  )  strcat(line, ", public");
+      if ( v->v_PrivateDeclare )  strcat(line, ", private");
+  }
+  if ( v->v_ExternalDeclare ) strcat(line, ", external");
+  if ( v->v_allocatable     ) strcat(line, ", allocatable");
+  if ( v->v_target          ) strcat(line, ", target");
+  if ( v->v_optionaldeclare ) strcat(line, ", optional");
+  if ( v->v_pointerdeclare  ) strcat(line, ", pointer");
+  Save_Length(line, 45);
+}
+
+
+/******************************************************************************/
+/*                         WriteScalarDeclaration                             */
+/******************************************************************************/
+/* This subroutine is used to write a scalar declaration                      */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*       integer variable ----------->   INTEGER :: VARIABLE                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteScalarDeclaration( variable *v, char line[LONG_M])
+{
+    strcat(line, " :: ");
+    strcat(line, v->v_nomvar);
+
+    if ( strcasecmp(v->v_vallengspec, "") ) strcat(line,v->v_vallengspec);
+    if ( v->v_VariableIsParameter )
+    {
+        strcat(line," = ");
+        strcat(line, v->v_initialvalue);
+    }
+    Save_Length(line, 45);
+}
+
+/******************************************************************************/
+/*                         WriteTableDeclaration                              */
+/******************************************************************************/
+/* This subroutine is used to write a Table declaration                       */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                      INTEGER, DIMENSION(1:nb) :: variable                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok)
+{
+    char newname[LONG_M];
+
+    strcat (ligne, ", dimension(");
+
+    if ( v->v_dimensiongiven == 1 && tmpok == 1 )   strcat(ligne,v->v_readedlistdimension);
+    if ( v->v_dimensiongiven == 1 && tmpok == 0 )
+    {
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(v->v_readedlistdimension,List_Global_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        Save_Length(newname,47);
+        strcat(ligne,newname);
+    }
+    strcat(ligne, ") :: ");
+    strcat(ligne, v->v_nomvar);
+    if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
+
+    if ( v->v_VariableIsParameter == 1 )
+    {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+    }
+    Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                        WriteVarDeclaration                                 */
+/******************************************************************************/
+/* This subroutine is used to write the initial declaration in the file       */
+/* fileout of a variable                                                      */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                      INTEGER, DIMENSION(1:nb),Pointer :: variable          */
+/*                                                                            */
+/******************************************************************************/
+void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility )
+{
+  FILE *filecommon;
+  char ligne[LONG_M];
+
+  filecommon = fileout;
+
+  if ( v->v_save == 0 || inmodulemeet == 0 )
+  {
+     WriteBeginDeclaration(v, ligne, visibility);
+
+     if ( v->v_nbdim == 0 )
+        WriteScalarDeclaration(v, ligne);
+     else
+        WriteTableDeclaration(v, ligne, value);
+
+     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
+     {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+     }
+     tofich(filecommon, ligne, 1);
+  }
+  else
+    printf("-- in writevardeclaration : |%s| -- MHCHECK\n", v->v_nomvar);
+  Save_Length(ligne,45);
+}
+
+
+void WriteLocalParamDeclaration(FILE* tofile)
+{
+    listvar *parcours;
+
+    parcours = List_Parameter_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteFunctionDeclaration(FILE* tofile, int value)
+{
+    listvar *parcours;
+
+    parcours = List_FunctionType_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+              strcasecmp(parcours->var->v_typevar, "") )
+        {
+            WriteVarDeclaration(parcours->var, tofile, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteSubroutineDeclaration(int value)
+{
+    listvar *parcours;
+    variable *v;
+
+    parcours = List_SubroutineDeclaration_Var;
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename)   &&
+             (v->v_save == 0)                                   &&
+             (v->v_pointerdeclare == 0)                         &&
+             (v->v_VariableIsParameter == 0)                    &&
+             (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        else if ( !strcasecmp(v->v_subroutinename, subroutinename)  &&
+                  (v->v_save == 0)                                  &&
+                  (v->v_VariableIsParameter == 0)                   &&
+                  (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteArgumentDeclaration_beforecall()
+{
+    int position;
+    listnom *neededparameter;
+    FILE *paramtoamr;
+    listvar *parcours;
+    variable *v;
+    char ligne[LONG_M];
+
+    fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename);
+
+    sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
+    paramtoamr = open_for_write(ligne);
+
+    neededparameter = (listnom * )NULL;
+    position = 1;
+    parcours = List_SubroutineArgument_Var;
+
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename) && (v->v_positioninblock == position) )
+        {
+            position++;
+            WriteVarDeclaration(v, fortran_out, 0, 1);
+            neededparameter = writedeclarationintoamr(List_Parameter_Var, paramtoamr,
+                                    v, v->v_subroutinename, neededparameter, subroutinename);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+    Save_Length(ligne,45);
+
+    // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module
+    if ( IsTabvarsUseInArgument_0() && (inmodulemeet == 0) && (inprogramdeclare == 0) )
+    {
+        fprintf(paramtoamr, "      interface\n");
+        if (isrecursive) sprintf(ligne,"  recursive subroutine Sub_Loop_%s(", subroutinename);
+        else             sprintf(ligne,"  subroutine Sub_Loop_%s(", subroutinename);
+        WriteVariablelist_subloop(ligne);
+        WriteVariablelist_subloop_Def(ligne);
+        strcat(ligne,")");
+        Save_Length(ligne,45);
+        tofich(paramtoamr,ligne,1);
+
+        listusemodule *parcours_mod;
+        parcours_mod = List_NameOfModuleUsed;
+        while ( parcours_mod )
+        {
+            if ( !strcasecmp(parcours_mod->u_cursubroutine, subroutinename) )
+            {
+                fprintf(paramtoamr, "          use %s\n", parcours_mod->u_usemodule);
+            }
+            parcours_mod = parcours_mod->suiv;
+        }
+        fprintf(paramtoamr, "          implicit none\n");
+        WriteLocalParamDeclaration(paramtoamr);
+        writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var, paramtoamr);
+        writesub_loopdeclaration_tab(List_UsedInSubroutine_Var, paramtoamr);
+        WriteArgumentDeclaration_Sort(paramtoamr);
+        WriteFunctionDeclaration(paramtoamr, 1);
+
+        sprintf(ligne,"  end subroutine Sub_Loop_%s\n", subroutinename);
+        tofich(paramtoamr, ligne, 1);
+        fprintf(paramtoamr, "      end interface\n");
+    }
+    fclose(paramtoamr);
+}
+
+void WriteArgumentDeclaration_Sort(FILE* tofile)
+{
+    int position = 1;
+    listvar *parcours;
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+                         parcours->var->v_positioninblock == position )
+        {
+            position = position + 1;
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                        parcours->var->v_nbdim == 0 )
+        {
+            WriteVarDeclaration(parcours->var,tofile,1,1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                         parcours->var->v_nbdim != 0 )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+/******************************************************************************/
+/*                      writedeclarationintoamr                               */
+/******************************************************************************/
+/* This subroutine is used to write the declaration of parameters needed in   */
+/*    allocation subroutines creates in toamr.c                               */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+                              variable *var , const char *commonname,
+                           listnom *neededparameter, const char *name_common)
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_M];
+  int changeval;
+  int out;
+  int writeit;
+  listnom *parcours;
+
+  /* we should list the needed parameter                                      */
+  if ( !strcasecmp(name_common,commonname) )
+     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter);
+  /*                                                                          */
+  parcours = neededparameter;
+  while (parcours)
+  {
+     newvar = deb_common;
+
+     out = 0 ;
+     while ( newvar && out == 0 )
+     {
+
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
+        {
+           out=1;
+        /* add the name to the list of needed parameter                       */
+           neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue,
+                 neededparameter );
+        }
+        else newvar=newvar->suiv;
+     }
+     parcours=parcours->suiv;
+   }
+  /*                                                                          */
+  parcours = neededparameter;
+  while (parcours)
+  {
+     newvar = deb_common;
+     out = 0 ;
+     while ( newvar && out == 0 )
+     {
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
+        {
+           out=1;
+        /* add the name to the list of needed parameter                       */
+           neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue,
+                 neededparameter );
+        }
+        else newvar=newvar->suiv;
+     }
+     parcours=parcours->suiv;
+   }
+  parcours = neededparameter;
+  while (parcours)
+  {
+     writeit = 0;
+     newvar = deb_common;
+     while ( newvar && writeit == 0 )
+     {
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) &&
+            !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename) && parcours->o_val == 0 )
+        {
+           writeit=1;
+           parcours->o_val = 1;
+        }
+        else newvar = newvar->suiv;
+     }
+
+     if ( writeit == 1  )
+     {
+        changeval = 0;
+        v = newvar->var;
+//        if ( v->v_allocatable == 1 && strcasecmp(v->v_typevar,"type") )
+//        {
+//           changeval = 1;
+//           v->v_allocatable = 0;
+//        }
+        WriteBeginDeclaration(v, ligne, 1);
+        if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
+        else WriteTableDeclaration(v, ligne, 1);
+
+        tofich(fileout, ligne, 1);
+        if ( changeval == 1 )
+        {
+           v->v_allocatable = 1;
+        }
+     }
+     else
+     {
+        if (  strncasecmp(parcours->o_nom,"mpi_",4) == 0 &&
+              shouldincludempif                     == 1 )
+        {
+           shouldincludempif = 0;
+           fprintf(fileout,"      include \'mpif.h\'\n");
+        }
+     }
+     parcours=parcours->suiv;
+  }
+  Save_Length(ligne,45);
+  return neededparameter;
+}
+
+
+/******************************************************************************/
+/*                       writesub_loopdeclaration_scalar                      */
+/******************************************************************************/
+/* This subroutine is used to write the declaration part of subloop           */
+/*    subroutines                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                                                                            */
+/*          INTEGER, DIMENSION(1:nb)         :: variable                      */
+/*                                                                            */
+/******************************************************************************/
+void writesub_loopdeclaration_scalar (listvar * deb_common, FILE *fileout)
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_M];
+
+//   tofich (fileout, "",1);
+  newvar = deb_common;
+
+  while (newvar)
+  {
+     if ( newvar->var->v_nbdim == 0 &&
+          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  &&
+           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) )
+     {
+        v = newvar->var;
+
+        WriteBeginDeclaration(v,ligne,1);
+        WriteScalarDeclaration(v,ligne);
+        tofich (fileout, ligne,1);
+     }
+     newvar = newvar->suiv;
+  }
+  Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                       writesub_loopdeclaration_tab                         */
+/******************************************************************************/
+/* This subroutine is used to write the declaration part of subloop           */
+/*    subroutines                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                                                                            */
+/*          INTEGER, DIMENSION(1:nb)         :: variable                      */
+/*                                                                            */
+/******************************************************************************/
+void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout)
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_M];
+  int changeval;
+
+  newvar = deb_common;
+  while (newvar)
+  {
+      v = newvar->var;
+//  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
+     if ( (v->v_nbdim != 0)  && !strcasecmp(v->v_subroutinename, subroutinename) &&
+          (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) )
+     {
+        changeval = 0;
+        if ( v->v_allocatable == 1)
+        {
+          if (strcasecmp(v->v_typevar,"type"))
+           {
+      //     changeval = 1;
+      //     v->v_allocatable = 0;
+           }
+          else
+           {
+           changeval = 2;
+           v->v_allocatable = 0;
+           v->v_pointerdeclare = 1;
+           }
+        }
+
+        WriteBeginDeclaration(v, ligne, 1);
+        WriteTableDeclaration(v, ligne, 1);
+        tofich (fileout, ligne,1);
+        if ( changeval >= 1 ) v->v_allocatable = 1;
+        if ( changeval == 2 ) v->v_pointerdeclare = 0;
+     }
+     newvar = newvar->suiv;
+  }
+  Save_Length(ligne,45);
+}
+
+void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl)
+{
+    listvar *parcours;
+    variable *v;
+    int out;
+
+    if ( insubroutinedeclare )
+    {
+        parcours = listdecl;
+        while ( parcours )
+        {
+            v = parcours->var;
+                          out = LookingForVariableInList(List_SubroutineArgument_Var, v);
+            if (out == 0) out = VariableIsInListCommon(parcours, List_Common_Var);
+            if (out == 0) out = LookingForVariableInList(List_Parameter_Var, v);
+            if (out == 0) out = LookingForVariableInList(List_FunctionType_Var, v);
+            if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var, v);
+
+            if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)
+            {
+                WriteVarDeclaration(v, fortran_out, 1, 1);
+            }
+            if (firstpass == 1)
+            {
+                if (VariableIsParameter == 0 && SaveDeclare == 0)
+                {
+                    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var, v);
+                }
+            }
+            parcours = parcours->suiv;
+        }
+    }
+}
+
+void ReWriteDataStatement_0(FILE * filout)
+{
+    listvar *parcours;
+    int out;
+    char ligne[LONG_M];
+    char initialvalue[LONG_M];
+
+    if (insubroutinedeclare == 1)
+    {
+        parcours = List_Data_Var_Cur ;
+        while (parcours)
+        {
+            out = VariableIsInListCommon(parcours,List_Common_Var);
+            if (out)   break;
+
+            out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
+            if (out)   break;
+
+            if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
+            {
+                strcpy(initialvalue,parcours->var->v_initialvalue);
+            }
+            else
+            {
+                strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
+                strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
+            }
+            sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
+            tofich(filout,ligne,1);
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 8732)
@@ -0,0 +1,662 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#define LONG_VNAME 80		// Max length for a variable name
+#define LONG_FNAME 1000		// Max length for a file name
+#define LONG_C     200
+#define LONG_M     1500
+
+#define NB_CAT_VARIABLES 5
+
+/******************************************************************************/
+/*********** Declaration of structures used in conv ***************************/
+/******************************************************************************/
+
+typedef struct
+{
+   char first[LONG_M];
+   char last[LONG_M];
+} typedim ;                /* fortran dimension as 'ndeb:nfin'                */
+
+typedef struct listdim
+{
+   typedim dim;
+   struct listdim *suiv;
+} listdim;                 /* list of the dimensions of a variable            */
+
+typedef struct variable
+{
+   char v_typevar[LONG_VNAME];
+   char v_nomvar[LONG_VNAME] ;
+   char v_oldname[LONG_VNAME] ;
+   char v_dimchar[LONG_VNAME];
+   char v_modulename[LONG_VNAME];
+   char v_commonname[LONG_VNAME];
+   char v_vallengspec[LONG_VNAME];
+   char v_nameinttypename[LONG_VNAME];
+   char v_commoninfile[LONG_FNAME];
+   char v_subroutinename[LONG_VNAME];
+   char v_precision[LONG_C];
+   char v_initialvalue[LONG_M];
+   char v_IntentSpec[LONG_M];
+   char v_readedlistdimension[LONG_M];
+   int  v_nbdim;
+   int  v_common;
+   int  v_positioninblock;
+   int  v_module;
+   int  v_save;
+   int  v_catvar;
+   int  v_VariableIsParameter;
+   int  v_PublicDeclare;
+   int  v_PrivateDeclare;
+   int  v_ExternalDeclare;
+   int  v_pointedvar;
+   int  v_notgrid;
+   int  v_dimensiongiven;
+   int  v_c_star;
+   int  v_indicetabvars;
+   int  v_pointerdeclare;
+   int  v_optionaldeclare;
+   int  v_allocatable;
+   int  v_target;
+   int  v_dimsempty;
+   listdim *v_dimension;
+} variable ;               /* type of a variable                              */
+                           /* v_typevar : type (integer, real, ...)           */
+                           /* v_nomvar : name of the variable                 */
+                           /* v_dimension : list of dimensions of the variable*/
+                           /* v_nbdim: 1 if the variable is 1d, etc ...       */
+                           /* precision : Name of the variable which          */
+                           /* determine the precision. example : wp in the    */
+                           /* case where REAL(wp)                             */
+
+typedef struct listvar
+{
+   variable *var ;
+   struct listvar * suiv;
+} listvar ;                /* list of variables                               */
+
+
+typedef struct listusemodule
+{
+   char u_usemodule[LONG_VNAME];
+   char u_charusemodule[LONG_VNAME];
+   char u_cursubroutine[LONG_VNAME];
+   char u_modulename[LONG_VNAME];
+   int  u_firstuse;
+   struct listusemodule * suiv;
+} listusemodule;           /* list of names                                   */
+
+typedef struct listparameter
+{
+   char p_name[LONG_M];
+   char p_modulename[LONG_M];
+   struct listparameter * suiv;
+} listparameter ;           /* list of names                                  */
+
+typedef struct listname
+{
+   char n_name[LONG_VNAME];
+   struct  listname* suiv;
+} listname ;            /* list of names                                  */
+
+typedef struct listcouple
+{
+   char c_namevar[LONG_VNAME];
+   char c_namepointedvar[LONG_VNAME];
+   struct listcouple * suiv;
+} listcouple;              /* list of names                                   */
+
+
+typedef struct listnom
+{
+   char o_nom[LONG_C];
+   char o_module[LONG_VNAME];
+   char o_subroutinename[LONG_M];
+   int  o_val;
+   listcouple *couple;
+   struct listnom * suiv;
+} listnom;                 /* list of names                                   */
+
+
+typedef struct listallocate
+{
+   char a_nomvar[LONG_C];
+   char a_subroutine[LONG_VNAME];
+   char a_module[LONG_VNAME];
+   struct listallocate * suiv;
+} listallocate ;
+
+
+typedef struct listvarpointtovar
+{
+   char t_usemodule[LONG_VNAME];
+   char t_cursubroutine[LONG_VNAME];
+   listcouple *t_couple;
+   struct  listvarpointtovar* suiv;
+}listvarpointtovar ;       /* list of names                                   */
+
+
+typedef struct listindice
+{
+   int i_indice;
+   struct  listindice * suiv;
+} listindice;              /* list of indiced                                 */
+
+ variable *curvar;
+
+ listvar *List_ModuleUsedInModuleUsed_Var;
+ listvar *List_ModuleUsed_Var;
+ listvar *listduplicated;
+
+ listvar *List_GlobalParameter_Var;
+ listvar *List_Global_Var;
+ listvar *List_Data_Var;
+ listvar *List_Data_Var_Cur;
+ listvar *List_Save_Var;
+ listvar *List_SubroutineArgument_Var;
+ listvar *List_SubroutineDeclaration_Var;
+ listvar *List_UsedInSubroutine_Var;
+ listvar *List_Parameter_Var;
+ listvar *List_Dimension_Var;
+ listvar *List_FunctionType_Var;
+ listvar *List_NotGridDepend_Var;
+ listvar *List_Common_Var;
+
+
+ listname *List_Pointer_Var;
+ listname *List_ImplicitNoneSubroutine;
+
+ listusemodule *List_NameOfModuleUsed;
+ listusemodule *List_Include;
+ listusemodule *listofmoduletmp;
+ listusemodule *tmpuselocallist;
+
+ listparameter *List_GlobParamModuleUsedInModuleUsed_Var;
+ listparameter *List_GlobParamModuleUsed_Var;
+
+ listnom *List_ContainsSubroutine;
+ listnom *List_Subroutine_For_Alloc;
+ listnom *listofmodules;
+ listnom *listofkind;
+ listnom *List_NameOfModule;
+ listnom *List_NameOfCommon;
+ listnom *List_SubroutineWhereAgrifUsed;
+
+ listallocate *List_Allocate_Var;
+
+ listvarpointtovar *List_CouplePointed_Var;
+                           /*  variables which are pointed to an other one    */
+
+ listindice *Listofavailableindices;
+                           /* List of available indices in the tabvars table  */
+ listindice **Listofavailableindices_glob;
+
+ listdim *curdim;
+ listdim *commondim;
+
+/******************************************************************************/
+/****************   *** COMMON Variables ***  *********************************/
+/******************************************************************************/
+
+ int positioninblock;
+ char commonvar[LONG_VNAME];
+ char commonblockname[LONG_VNAME];
+
+/******************************************************************************/
+/****************   *** AGRIF Variables ***   *********************************/
+/******************************************************************************/
+ int inagrifcallargument;
+ int afterpercent;
+ int sameagrifargument;
+ int InAgrifParentDef;
+ char sameagrifname[LONG_VNAME];
+/******************************************************************************/
+/****************   *** VAR DEF Variables ***   *******************************/
+/******************************************************************************/
+ int indicemaxtabvars[NB_CAT_VARIABLES];     /* Number of variables in the model i.e. last      */
+                           /*    indice used in  the tabvars table            */
+ int PublicDeclare;        /* Variable has been declared as PUBLIC */
+ int PrivateDeclare;       /* Variable has been declared as PRIVATE */
+ int ExternalDeclare;      /* Variable has been declared as EXTERNAL */
+ int InitialValueGiven;    /* An initial value has been given */
+ int Allocatabledeclare;
+ int Targetdeclare;
+ int SaveDeclare;
+ int functiondeclarationisdone;
+ int pointerdeclare;
+ int optionaldeclare;
+ int inside_type_declare;
+ int VariableIsParameter;
+ int dimsgiven;
+ int shouldincludempif;
+ int c_star;
+ char DeclType[LONG_VNAME];
+ char nameinttypename[LONG_VNAME];
+ char nameinttypenameback[LONG_VNAME];
+ int GlobalDeclaration;
+ int GlobalDeclarationType;
+ char InitValue[LONG_M];
+ char IntentSpec[LONG_M];
+ char NamePrecision[LONG_C];
+ char CharacterSize[LONG_VNAME];
+ char vallengspec[LONG_VNAME];
+ int isrecursive;
+ int is_result_present;
+
+/******************************************************************************/
+/****************   *** CONV Variables ***   **********************************/
+/******************************************************************************/
+ int dimprob ;             /* dimension of the problem : 1 for 1D,2 for 2D,   */
+                           /*    3 for 3D                                     */
+ int onlyfixedgrids;       /* = 1 if onlyfixedgrids is true                   */
+ int todebug;
+ int fixedgrids;           /* = 1 if fixedgrids is true                       */
+ char nbmaillesX[LONG_VNAME];	// number of cells in the x direction
+ char nbmaillesY[LONG_VNAME];	// number of cells in the y direction
+ char nbmaillesZ[LONG_VNAME];	// number of cells in the z direction
+ int IndicenbmaillesX;
+ int IndicenbmaillesY;
+ int IndicenbmaillesZ;
+
+ int inmodulemeet;
+ int incalldeclare;
+ int aftercontainsdeclare; /* Signale si l'on vient d'un contains ou non */
+ int retour77;
+ int callagrifinitgrids;
+ int callmpiinit;
+ int firstpass;
+ int pointedvar;
+ int NbMailleXDefined;
+ int agrif_parentcall;
+ int didvariableadded;
+ int SubloopScalar;        /* = 1 we should put in argument of sub_loop       */
+                           /*    only                                         */
+                           /*    scalar and not table u(1,1,1) in place of u  */
+ int inprogramdeclare;
+ int insubroutinedeclare;
+ int inmoduledeclare;
+ int dimsempty;
+ int created_dimensionlist;
+ int incontainssubroutine;
+
+ char meetagrifinitgrids[LONG_M];
+ char mpiinitvar[LONG_M];
+ char toprintglob[LONG_M];
+ char tmpvargridname[LONG_M];
+ char dependfilename[LONG_FNAME];
+ char charusemodule[LONG_VNAME];
+ char subofagrifinitgrids[LONG_M];
+ char curmodulename[LONG_VNAME];
+ char subroutinename[LONG_VNAME];
+ char cur_filename[LONG_FNAME];		// Name of the current parsed Fortran file
+ char config_file[LONG_FNAME];		// Name of conv configuration file (ex: amr.in)
+ char work_dir[LONG_FNAME];			// Work directory         (default: './')
+ char include_dir[LONG_FNAME];		// Include directory      (default: './AGRIF_INC')
+ char output_dir[LONG_FNAME];		// output directory       (default: './AGRIF_MODELFILES')
+ char input_dir[LONG_FNAME];		// source input directory (default: './')
+
+ FILE *fortran_out;          /* Output File                                    */
+ FILE *fortran_in;           /* Input File                                     */
+ FILE *oldfortran_out;
+ FILE *subloop;
+ FILE *module_declar;
+ FILE *allocationagrif;
+
+ long int pos_cur;         /* current position in the output file             */
+ long int pos_curagrifparent;
+                           /* current position in the output file             */
+ long int pos_curcall;     /* current position in the output file             */
+ long int pos_curuse;      /* current position in the output file             */
+ long int pos_curuseold;   /* current position in the output file             */
+ long int pos_curfunction; /* current position in the output file             */
+ long int pos_cur_decl;    /* current position in the output file             */
+ long int pos_curdata;     /* current position in the output file             */
+ long int pos_curparameter;/* current position in the output file             */
+ long int pos_curcommon;   /* current position in the output file             */
+ long int pos_cursave;     /* current position in the output file             */
+ long int pos_curdimension;/* current position in the output file             */
+ long int pos_curinclude;  /* final position of a line in file                */
+ long int pos_end;         /* final position of a line in file                */
+ long int pos_endsubroutine;
+                           /* final position of a line in file                */
+
+size_t length_last;
+size_t length_first;
+size_t length_v_vallengspec;
+size_t length_v_commoninfile;
+size_t length_v_precision;
+size_t length_v_IntentSpec;
+size_t length_v_initialvalue;
+size_t length_v_readedlistdimension;
+size_t length_a_nomvar;
+size_t length_toprintglob;
+size_t length_tmpvargridname;
+size_t length_ligne_Subloop;
+size_t length_toprint_utilagrif;
+size_t length_toprinttmp_utilchar;
+size_t length_ligne_writedecl;
+size_t length_newname_toamr;
+size_t length_newname_writedecl;
+size_t length_ligne_toamr;
+size_t length_tmpligne_writedecl;
+ int value_char_size;
+ int value_char_size1;
+ int value_char_size2;
+ int value_char_size3;
+
+
+ int inallocate;
+ int infixed;
+ int infree;
+/******************************************************************************/
+/*********** Declaration of externals subroutines *****************************/
+/***************************************************** ************************/
+extern char *fortran_text;
+/******************************************************************************/
+/*********** convert.y ********************************************************/
+/******************************************************************************/
+extern int main(int argc,char *argv[]);
+extern int convert_error(const char *s);
+/******************************************************************************/
+/*********** fortran.y ********************************************************/
+/******************************************************************************/
+extern void process_fortran(const char *input_file);
+extern int fortran_error(const char *s);
+/******************************************************************************/
+/*********** dependfile.c *****************************************************/
+/******************************************************************************/
+extern void Writethedependnbxnbyfile();
+extern void Readthedependnbxnbyfile();
+extern void Writethedependlistofmoduleused(const char *NameTampon );
+extern void Readthedependlistofmoduleused(const char *NameTampon);
+extern void WritedependParameterList(const char *NameTampon );
+extern listparameter *ReaddependParameterList(const char *NameTampon, listparameter *listout);
+extern void Writethedependfile(const char *NameTampon, listvar *input );
+extern listvar *Readthedependfile(const char *NameTampon , listvar *listout);
+extern void Write_Subroutine_For_Alloc();
+extern void Read_Subroutine_For_Alloc();
+extern void Writethedependavailablefile();
+extern void Readthedependavailablefile();
+extern int is_dependfile_created(const char *NameTampon);
+extern void Write_val_max();
+extern void Read_val_max();
+/******************************************************************************/
+/*********** DiversListe.c ****************************************************/
+/******************************************************************************/
+extern void Add_Common_var_1();
+extern listnom  *Addtolistnom(const char *nom, listnom *listin, int value);
+extern listname *Addtolistname(const char *nom, listname *input);
+extern int ModuleIsDefineInInputFile(const char *name);
+extern void Addmoduletothelisttmp(const char *name);
+extern void Add_NameOfModule_1(const char *nom);
+extern void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename);
+extern void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple);
+extern void Add_Include_1(const char *name);
+extern void Add_ImplicitNoneSubroutine_1();
+extern void WriteIncludeDeclaration(FILE* tofile);
+extern void Add_Save_Var_1 (const char *name,listdim *d);
+extern void Add_Save_Var_dcl_1 (listvar *var);
+/******************************************************************************/
+/*********** SubLoopCreation.c ************************************************/
+/******************************************************************************/
+extern void WriteBeginof_SubLoop();
+extern void WriteVariablelist_subloop(char *ligne);
+extern void WriteVariablelist_subloop_Call(char **ligne, size_t line_length);
+extern void WriteVariablelist_subloop_Def(char *ligne);
+extern void WriteHeadofSubroutineLoop();
+extern void closeandcallsubloopandincludeit_0(int suborfun);
+extern void closeandcallsubloop_contains_0();
+/******************************************************************************/
+/*********** toamr.c **********************************************************/
+/******************************************************************************/
+extern void WARNING_CharSize(const variable *var);
+extern const char * tabvarsname(const variable *var);
+extern const char * variablecurgridtabvars(int which_grid);
+extern const char * vargridnametabvars(const variable *var, int iorindice);
+extern const char * vargridcurgridtabvars(const variable *var, int which_grid);
+extern const char * vargridcurgridtabvarswithoutAgrif_Gr(const variable *var);
+extern const char * vargridparam(const variable *var);
+extern void write_probdimagrif_file();
+extern void write_keysagrif_file();
+extern void write_modtypeagrif_file();
+extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,int *InitEmpty);
+extern void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty);
+extern void write_Setnumberofcells_file();
+extern void write_Getnumberofcells_file();
+extern void Write_Alloc_Agrif_Files();
+extern int IndiceInlist(int indic, listindice *listin);
+extern void write_allocation_Common_0();
+extern void write_allocation_Global_0();
+extern void creefichieramr();
+/******************************************************************************/
+/*********** UtilAgrif.c ******************************************************/
+/******************************************************************************/
+extern int Vartonumber(const char *tokname);
+extern int Agrif_in_Tok_NAME(const char *tokname);
+extern void ModifyTheVariableName_0(const char *ident,int lengthname);
+extern void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod);
+extern void AddUseAgrifUtil_0(FILE *fileout);
+extern void AddUseAgrifUtilBeforeCall_0(FILE *fileout);
+extern void NotifyAgrifFunction_0(const char *ident);
+extern void ModifyTheAgrifFunction_0(const char *ident);
+extern void AgriffunctionModify_0(const char *ident,int whichone);
+extern void Instanciation_0(const char *ident);
+/******************************************************************************/
+/*********** UtilCharacter.c **************************************************/
+/******************************************************************************/
+extern void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
+                                             listvar * listtosee, int whichone);
+extern const char *ChangeTheInitalvaluebyTabvarsName(const char *nom,listvar *listtoread);
+extern int IsVariableReal(const char *nom);
+extern void IsVarInUseFile(const char *nom);
+extern listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout);
+extern void DecomposeTheName(const char *nom);
+extern void convert2lower(char *lowername, const char* inputname);
+extern int convert2int(const char *name);
+/******************************************************************************/
+/*********** UtilFile.c *******************************************************/
+/******************************************************************************/
+extern FILE * open_for_write (const char *filename);
+extern FILE * open_for_append (const char *filename);
+extern long int setposcur();
+extern long int setposcurname(FILE *fileout);
+extern void copyuse_0(const char *namemodule);
+extern void copyuseonly_0(const char *namemodule);
+/******************************************************************************/
+/*********** UtilFortran.c ****************************************************/
+/******************************************************************************/
+extern void initdimprob(int dimprobmod, const char *nx, const char *ny, const char *nz);
+extern int Variableshouldberemoved(const char *nom);
+extern int variableisglobal(listvar *curvar, listvar *listin);
+extern int VariableIsInListCommon(listvar *curvar,listvar *listin);
+extern int VariableIsInList(listvar *curvar,listvar *listin);
+extern void variableisglobalinmodule(listcouple *listin, const char *module,
+                                                                 FILE *fileout,long int oldposcuruse);
+extern void Write_Word_end_module_0();
+extern void Add_Subroutine_For_Alloc(const char *nom);
+extern void Write_Closing_Module();
+extern int IsTabvarsUseInArgument_0();
+extern int ImplicitNoneInSubroutine();
+extern void Add_Pointer_Var_From_List_1(listvar *listin);
+extern void Add_Pointer_Var_1(char *nom);
+extern int varispointer_0(char *ident);
+extern int VariableIsFunction(const char *ident);
+extern int varistyped_0(char *ident);
+extern void dump_var(const variable* var);
+/******************************************************************************/
+/*********** UtilListe.c ******************************************************/
+/******************************************************************************/
+extern void Init_Variable(variable *var);
+extern listvar * AddListvarToListvar(listvar *l,listvar *glob, int ValueFirstpass);
+extern void CreateAndFillin_Curvar(const char *type, variable *curvar);
+// extern void duplicatelistvar(listvar *orig);
+extern listdim * insertdim(listdim *lin,typedim nom);
+extern void change_dim_char(listdim *lin,listvar * l);
+extern int get_num_dims(const listdim *d);
+extern variable * createvar(const char *nom, listdim *d);
+extern listvar * insertvar(listvar *lin,variable *v);
+extern listvar * settype(const char *nom,listvar *lin);
+extern void printliste(listvar * lin);
+extern int IsinListe(listvar *lin,char *nom);
+extern listname *Insertname(listname *lin,char *nom,int sens);
+extern listname *concat_listname(listname *l1, listname *l2);
+extern void createstringfromlistname(char *ligne, listname *lin);
+extern void printname(listname * lin);
+extern void removeglobfromlist(listname **lin);
+extern void writelistpublic(listname *lin);
+extern void Init_List_Data_Var();
+extern void  addprecision_derivedfromkind(variable *curvar);
+extern int get_cat_var(variable *var);
+/******************************************************************************/
+/*********** UtilNotGridDep.c *************************************************/
+/******************************************************************************/
+extern void Add_NotGridDepend_Var_1 (char *name);
+extern int VarIsNonGridDepend(char *name);
+/******************************************************************************/
+/*********** WorkWithAllocatelist.c *******************************************/
+/******************************************************************************/
+extern void Add_Allocate_Var_1(const char *nom, const char *nommodule);
+extern int IsVarAllocatable_0(const char *ident);
+/******************************************************************************/
+/*********** WorkWithglobliste.c **********************************************/
+/******************************************************************************/
+extern void Add_Globliste_1(listvar *listtoadd);
+extern void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd);
+extern void checkandchangedims(listvar *listsecondpass);
+/******************************************************************************/
+/*********** WorkWithlistdatavariable.c ***************************************/
+/******************************************************************************/
+extern void Add_Data_Var_1 (listvar **curlist,char *name,char *values);
+extern void Add_Data_Var_Names_01 (listvar **curlist,listname *l1, listname *l2);
+/******************************************************************************/
+/*********** WorkWithlistmoduleinfile.c ***************************************/
+/******************************************************************************/
+extern void Save_Length(const char *nom, int whichone);
+extern void Save_Length_int(int val, int whichone);
+/******************************************************************************/
+/*********** WorkWithlistofmodulebysubroutine.c *******************************/
+/******************************************************************************/
+extern void RecordUseModulesVariables();
+extern void  RecordUseModulesUseModulesVariables();
+extern void Add_NameOfModuleUsed_1(char *name);
+extern void Addmoduletothelist(const char *name);
+extern void WriteUsemoduleDeclaration(const char *cursubroutinename);
+/******************************************************************************/
+/*********** WorkWithlistvarindoloop.c ****************************************/
+/******************************************************************************/
+extern void Add_UsedInSubroutine_Var_1 (const char *ident);
+extern void ajoutevarindoloop_definedimension (char *name);
+extern void  ModifyThelistvarindoloop();
+extern void  CompleteThelistvarindoloop();
+extern void Merge_Variables(variable *var1,variable *var2);
+extern void Update_List_Subroutine_Var(listvar *list_to_modify);
+extern void Update_List_Global_Var_From_List_Save_Var();
+extern void Update_List_From_Common_Var(listvar *list_to_modify);
+extern void Update_List_Var(listvar *list_to_modify);
+extern void List_UsedInSubroutine_Var_Update_From_Module_Used();
+extern void Update_NotGridDepend_Var(listvar *list_to_modify);
+extern int LookingForVariableInList(listvar *listin,variable *var);
+extern int LookingForVariableInListGlobal(listvar *listin,variable *var);
+extern int LookingForVariableInListName(listvar *listin,const char *var);
+extern int LookingForVariableInListGlob(listvar *listin,variable *var);
+extern int LookingForVariableInListParamGlob(listparameter *listin, variable *var);
+extern variable *get_variable_in_list_from_name(listvar *listin, const char *name);
+extern void UpdateListDeclarationWithDimensionList();
+extern void Clean_List_UsedInSubroutine_Var();
+extern void Clean_List_ModuleUsed_Var();
+extern void Clean_List_SubroutineDeclaration_Var();
+extern void Clean_List_Global_Var();
+extern void ListClean();
+extern void ListUpdate();
+extern void GiveTypeOfVariables();
+extern void Sort_List_SubroutineArgument_Var();
+extern void IndiceTabvars_Global_Var_Treated(char *nom);
+extern void IndiceTabvars_Global_Var_No_Treated(char *nom);
+extern void UpdateTheRemainingList(listvar *record);
+extern void IndiceTabvars_Common_Var_Treated(char *nom);
+extern void IndiceTabvars_Common_Var_No_Treated(char *nom);
+extern void IndiceTabvarsIdentification();
+extern void New_Allocate_Subroutine_Is_Necessary();
+extern void New_Allocate_Subroutine_For_Common_Is_Necessary();
+extern void NewModule_Creation_0();
+extern void UpdateList_SubroutineWhereAgrifUsed();
+extern void UpdateList_UsedInSubroutine_With_dimension();
+extern void Affiche(listvar *parcours);
+extern int SubInList_ContainsSubroutine();
+extern void update_indicemaxtabvars(variable *var,listindice **Listofindices);
+/******************************************************************************/
+/*********** WorkWithParameterlist.c ******************************************/
+/******************************************************************************/
+extern void Add_GlobalParameter_Var_1(listvar *listin);
+extern void Add_Parameter_Var_1(listvar *listin);
+extern void Add_Dimension_Var_1(listvar *listin);
+/******************************************************************************/
+/*********** WorkWithvarofsubroutineliste.c ***********************************/
+/******************************************************************************/
+extern void Add_SubroutineArgument_Var_1(listvar *listtoadd);
+extern void Add_FunctionType_Var_1(const char *nom);
+// extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
+/******************************************************************************/
+/*********** Writedeclarations.c **********************************************/
+/******************************************************************************/
+extern void WriteBeginDeclaration(variable *v,char ligne[LONG_M],int visibility);
+extern void WriteScalarDeclaration(variable *v,char ligne[LONG_M]);
+extern void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok);
+extern void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility );
+extern void WriteLocalParamDeclaration(FILE* tofile);
+extern void WriteFunctionDeclaration(FILE* tofile, int value);
+extern void WriteSubroutineDeclaration(int value);
+extern void WriteArgumentDeclaration_beforecall();
+extern void WriteArgumentDeclaration_Sort(FILE* tofile);
+extern listnom * writedeclarationintoamr(listvar *deb_common, FILE *fileout, variable *var,
+						const char *commonname, listnom *neededparameter, const char *name_common);
+extern void writesub_loopdeclaration_scalar(listvar *deb_common, FILE *fileout);
+extern void writesub_loopdeclaration_tab(listvar *deb_common, FILE *fileout);
+extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl);
+extern void ReWriteDataStatement_0(FILE * filout);
+/******************************************************************************/
+/*********** WriteInFile.c ****************************************************/
+/******************************************************************************/
+extern void tofich_reste (FILE * filout, const char *s, int do_returnline);
+extern void tofich (FILE * filout, const char *s, int do_returnline);
+extern void tofich_blanc (FILE * filout, int size);
+extern void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove);
+extern void RemoveWordCUR_0(FILE * filout, int sizetoremove);
+
+/******************************************************************************/
+/*********** WorkWithlistofcoupled.c **********************************************/
+/******************************************************************************/
+extern int variscoupled_0(const char *ident) ;
+extern const char * getcoupledname_0(const char *ident);
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 8732)
@@ -0,0 +1,974 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+/******************************************************************************/
+/*            Creation and modification of .dependfile                        */
+/******************************************************************************/
+/*  .dependnbxnby            : this file contains tabvars indices of variables*/
+/*                                given in agrif.in as number of cells        */
+/*  .dependuse<module>       : this file contains all modules used in the     */
+/*                                current file                                */
+/*  .dependparameter<module> : this file contains all parmeters defined in    */
+/*                                the current file                            */
+/*  .depend<module name>     : this file contains all globals variables       */
+/*                                informations (name, dim, etc ...)           */
+/*  .dependavailable         : this file contains all tabvars indices which   */
+/*                                are not used.                               */
+/******************************************************************************/
+
+
+/******************************************************************************/
+/*                 Writethedependnbxnbyfile                                   */
+/******************************************************************************/
+/* This subroutine is used to create the .dependnbxnby                        */
+/******************************************************************************/
+/*                                                                            */
+/*                     .dependnbxnby                                          */
+/*                                                                            */
+/*                     nbmaillesX                                             */
+/*                     nbmaillesY                                             */
+/*                     nbmaillesZ                                             */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependnbxnbyfile()
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  int out;
+
+  // We look in 'List_Global_Var' for all the variables of the current file to parse
+  parcours = List_Global_Var;
+  out = 0;
+  while (parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesX) ) out = 1;
+     else parcours = parcours->suiv;
+  }
+  if ( out == 0 )
+  {
+     parcours =List_Common_Var;
+     while (parcours && out == 0 )
+     {
+        if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesX) ) out = 1;
+        else parcours = parcours->suiv;
+     }
+  }
+  NbMailleXDefined = 0;
+  if ( out == 1 )
+  {
+     NbMailleXDefined = 1;
+     sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+     dependfileoutput = fopen(dependfilename, "w");
+
+     fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+     IndicenbmaillesX = parcours->var->v_indicetabvars;
+
+     if ( dimprob > 1 )
+     {
+        parcours =List_Global_Var;
+        out = 0;
+        while (parcours && out == 0 )
+        {
+           if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesY) ) out = 1;
+           else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+           parcours =List_Common_Var;
+           while (parcours && out == 0 )
+           {
+              if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesY) ) out = 1;
+              else parcours = parcours->suiv;
+           }
+        }
+        if ( out == 1 )
+        {
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+           IndicenbmaillesY = parcours->var->v_indicetabvars;
+        }
+     }
+
+     if ( dimprob > 2 )
+     {
+        parcours =List_Global_Var;
+        out = 0;
+        while (parcours && out == 0 )
+        {
+           if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesZ) ) out = 1;
+           else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+           parcours =List_Common_Var;
+           while (parcours && out == 0 )
+           {
+              if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesZ) ) out = 1;
+              else parcours = parcours->suiv;
+           }
+        }
+        if ( out == 1 )
+        {
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+           IndicenbmaillesZ = parcours->var->v_indicetabvars;
+        }
+     }
+
+     if ( out == 1 ) fclose(dependfileoutput);
+   }
+}
+
+/******************************************************************************/
+/*                 Readthedependnbxnbyfile                                    */
+/******************************************************************************/
+/* This subroutine is used to create the .dependnbxnby                        */
+/******************************************************************************/
+/*                                                                            */
+/*                     .dependnbxnby                                          */
+/*                                                                            */
+/*                     nbmaillesX                                             */
+/*                     nbmaillesY                                             */
+/*                     nbmaillesZ                                             */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependnbxnbyfile()
+{
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+    if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+    {
+        fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
+        if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
+        if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
+        fclose(dependfileoutput);
+    }
+}
+
+/******************************************************************************/
+/*                     Writethedependlistofmoduleused                         */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependlistofmoduleused(const char *NameTampon )
+{
+    FILE *dependfileoutput;
+    listusemodule *parcours;
+    char lowername[LONG_VNAME];
+
+    if ( ! List_NameOfModuleUsed ) return;
+
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+    dependfileoutput = fopen(dependfilename, "w");
+
+    parcours = List_NameOfModuleUsed;
+    while (parcours)
+    {
+    if ( !strcasecmp(lowername,parcours->u_modulename) &&
+         !strcasecmp(parcours->u_cursubroutine,"") )
+    {
+        // We look in 'List_NameOfModuleUsed' for all the variables of the current file to parse
+        fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+    }
+    parcours = parcours->suiv;
+    }
+    fclose(dependfileoutput);
+}
+
+/******************************************************************************/
+/*                    Readthedependlistofmoduleused                           */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependlistofmoduleused(const char *NameTampon)
+{
+  FILE *dependfileoutput;
+  listusemodule *parcours;
+  char lowername[LONG_VNAME];
+
+  tmpuselocallist = (listusemodule *)NULL;
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listusemodule *)calloc(1,sizeof(listusemodule));
+         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
+
+         parcours->suiv = tmpuselocallist;
+         tmpuselocallist = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                        WritedependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void WritedependParameterList(const char *NameTampon )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  char lowername[LONG_VNAME];
+
+  if ( List_GlobalParameter_Var )
+  {
+     convert2lower(lowername, NameTampon);
+     sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+     dependfileoutput = fopen(dependfilename, "w");
+     parcours = List_GlobalParameter_Var;
+     while (parcours)
+     {
+        if ( !strcasecmp(lowername, parcours->var->v_modulename) )
+        {
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+        }
+        parcours = parcours->suiv;
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                         ReaddependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+listparameter *ReaddependParameterList(const char *NameTampon,listparameter *listout)
+{
+  FILE *dependfileoutput;
+  listparameter *parcours;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename,"r"))!=NULL)
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listparameter *)calloc(1,sizeof(listparameter));
+         fscanf(dependfileoutput,"%s\n",parcours->p_name);
+         fscanf(dependfileoutput,"%s\n",parcours->p_modulename);
+
+         parcours->suiv = listout;
+         listout = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+  return listout;
+}
+
+/******************************************************************************/
+/*                   Writethedependfile                                       */
+/******************************************************************************/
+/* This subroutine is used to create the .depend<name>                        */
+/******************************************************************************/
+/*                                                                            */
+/*                     .depend<name>                                          */
+/*                                                                            */
+/*                      REAL                                                  */
+/*                      Variable                                              */
+/*                      char dimension or T                                   */
+/*                      table dimension                                       */
+/*                      is type given                                         */
+/*                      precision or T                                        */
+/*                      initial value or T                                    */
+/*                      indice in the tabvars                                 */
+/*                      listdimension or T                                    */
+/*                      -------------------------                             */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependfile(const char *NameTampon, listvar *input )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  listdim *dims;
+  char ligne[LONG_M];
+  char listdimension[LONG_M];
+  char curname[LONG_M];
+  char lowername[LONG_VNAME];
+  int out;
+
+  if ( input )
+  {
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename,"w");
+  // We look in 'input' for all the variables of the current file to parse
+  parcours =input;
+  out = 0;
+  strcpy(curname,"");
+  while (parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->var->v_modulename, lowername) ||
+          !strcasecmp(parcours->var->v_commonname, lowername) )
+     {
+        /*                                                                    */
+        if (  strcasecmp(curname,"") &&
+             !strcasecmp(curname,parcours->var->v_nomvar) ) out = 1 ;
+        if ( !strcasecmp(curname,"") ) strcpy(curname,parcours->var->v_nomvar);
+        /*                                                                    */
+        if ( out == 0 )
+        {
+           /********** TYPEVAR ************************************************/
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_catvar);
+           /********** NOMVAR *************************************************/
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           /********** DIMCHAR ************************************************/
+           if ( strcasecmp(parcours->var->v_dimchar, "") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_dimchar);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** COMMONINFILE *******************************************/
+           if ( strcasecmp(parcours->var->v_commoninfile,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_commoninfile);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** COMMONNAME *********************************************/
+           if ( strcasecmp(parcours->var->v_commonname,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_commonname);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** MODULENAME *********************************************/
+           if ( strcasecmp(parcours->var->v_modulename,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** NBDIM **************************************************/
+/*           fprintf(dependfileoutput,"%d\n",parcours->var->v_nbdim);*/
+           /********** DIMENSIONGIVEN *****************************************/
+/*           fprintf(dependfileoutput,"%d\n",parcours->var->v_dimensiongiven);*/
+           /********** ALLOCATABLE ********************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_allocatable);
+           /********** TARGET ********************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_target);
+           /********** POINTERDECLARE *****************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_pointerdeclare);
+           /********** PRECISION **********************************************/
+           if ( strcasecmp(parcours->var->v_precision,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_precision);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** INITIALVALUE *******************************************/
+/*           if ( strcasecmp(parcours->var->v_initialvalue,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_initialvalue);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }*/
+           /********** NAMEINTYPENAME *****************************************/
+           if ( strcasecmp(parcours->var->v_nameinttypename,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_nameinttypename);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** PRIVATE *****************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_PrivateDeclare);
+
+           /********** INDICETABVARS ******************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+           /********** READEDLISTDIMENSION ************************************/
+           if ( parcours->var->v_dimensiongiven == 1 )
+           {
+              dims = parcours->var->v_dimension;
+              strcpy(listdimension,"");
+              while (dims)
+              {
+                 sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                 strcat(listdimension,ligne);
+                 if ( dims->suiv )
+                 {
+                    strcat(listdimension,",");
+                 }
+                 dims = dims->suiv;
+              }
+              Save_Length(listdimension,15);
+              fprintf(dependfileoutput,"%s\n",listdimension);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /*******************************************************************/
+           fprintf(dependfileoutput,"------------------------\n");
+        }
+     }
+     parcours = parcours->suiv;
+  }
+  fclose(dependfileoutput);
+  }
+}
+
+/******************************************************************************/
+/*                         Readthedependfile                                  */
+/******************************************************************************/
+/* This subroutine is used to read the .dependfile<name> and to insert new    */
+/*    information in the listout list.                                        */
+/******************************************************************************/
+/*                                                                            */
+/*           .dependmodule -------->                      = list of var       */
+/*                                                                            */
+/*        not.dependmodule -------->                                          */
+/*                                                                            */
+/******************************************************************************/
+listvar *Readthedependfile(const char *NameTampon , listvar *listout)
+{
+  FILE *dependfileoutput;
+  listvar *parcours0;
+  listvar *parcours;
+  listvar *parcoursprec;
+  char nothing[LONG_M];
+  char lowername[LONG_VNAME];
+  size_t i;
+
+  parcoursprec = (listvar *)NULL;
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))==NULL)
+  {
+    /* if the file doesn't exist it means that it is the first time           */
+    /*    we tried to parse this file                                         */
+  }
+  else
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listvar *)calloc(1,sizeof(listvar));
+         parcours->var=(variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(parcours->var);
+         /*                                                                   */
+           /********** TYPEVAR ************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_catvar);
+           /********** NOMVAR *************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           /********** DIMCHAR ************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_dimchar);
+         if ( !strcasecmp(parcours->var->v_dimchar,"T") )
+         {
+            strcpy(parcours->var->v_dimchar,"");
+         }
+           /********** COMMONINFILE *******************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_commoninfile);
+         if ( !strcasecmp(parcours->var->v_commoninfile,"T") )
+         {
+            strcpy(parcours->var->v_commoninfile,"");
+         }
+           /********** COMMONNAME *********************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_commonname);
+         if ( !strcasecmp(parcours->var->v_commonname,"T") )
+         {
+            strcpy(parcours->var->v_commonname,"");
+         }
+           /********** MODULENAME *********************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+
+         if ( !strcasecmp(parcours->var->v_modulename,"T") )
+         {
+            strcpy(parcours->var->v_modulename,"");
+         }
+
+
+           /********** NBDIM **************************************************/
+/*         fscanf(dependfileoutput,"%d\n",&parcours->var->v_nbdim);*/
+           /********** DIMENSIONGIVEN *****************************************/
+/*         fscanf(dependfileoutput,"%d\n",&parcours->var->v_dimensiongiven);*/
+           /********** ALLOCATABLE ********************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_allocatable);
+         if ( parcours->var->v_allocatable == 1 )
+         {
+            Add_Allocate_Var_1(parcours->var->v_nomvar, parcours->var->v_commonname);
+         }
+           /********** TARGET ********************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_target);
+
+           /********** POINTERDECLARE *****************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_pointerdeclare);
+         if ( parcours->var->v_pointerdeclare == 1 )
+         {
+            Add_Pointer_Var_1(parcours->var->v_nomvar);
+         }
+           /********** PRECISION **********************************************/
+         fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_precision);
+         if ( !strcasecmp(parcours->var->v_precision,"T") )
+         {
+            strcpy(parcours->var->v_precision,"");
+         }
+           /********** INITIALVALUE *******************************************/
+/*         fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_initialvalue);
+         if ( !strcasecmp(parcours->var->v_initialvalue,"T") )
+         {
+            strcpy(parcours->var->v_initialvalue,"");
+         }*/
+           /********** NAMEINTYPENAME *****************************************/
+         fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_nameinttypename);
+         if ( !strcasecmp(parcours->var->v_nameinttypename,"T") )
+         {
+            strcpy(parcours->var->v_nameinttypename,"");
+         }
+           /********** PRIVATE *****************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_PrivateDeclare);
+
+           /********** INDICETABVARS ******************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_indicetabvars);
+           /********** READEDLISTDIMENSION ************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_readedlistdimension);
+         if ( !strcasecmp(parcours->var->v_readedlistdimension,"T") )
+         {
+            strcpy(parcours->var->v_readedlistdimension,"");
+         }
+         else
+         {
+            parcours->var->v_dimensiongiven = 1;
+            parcours->var->v_nbdim = 1;
+            i = 1;
+            /*                                                                */
+            while ( i < strlen(parcours->var->v_readedlistdimension) )
+            {
+               if ( parcours->var->v_readedlistdimension[i] == ',' )
+               {
+                  parcours->var->v_nbdim = parcours->var->v_nbdim + 1 ;
+               }
+               /*                                                             */
+               i=i+1;
+            }
+         }
+           /*******************************************************************/
+         fscanf(dependfileoutput,"%s\n",nothing);
+         parcours->suiv = NULL;
+         if (parcours->var->v_PrivateDeclare == 0)
+         {
+         if ( !listout )
+         {
+            listout = parcours;
+            parcoursprec = parcours;
+         }
+         else
+         {
+            if ( parcoursprec )
+            {
+               parcoursprec->suiv = parcours;
+               parcoursprec = parcours;
+            }
+            else
+            {
+               parcours0 = listout;
+               while ( parcours0->suiv ) parcours0=parcours0->suiv;
+               parcours0->suiv = parcours;
+               parcoursprec = parcours0->suiv;
+            }
+         }
+         }
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+  return listout;
+}
+
+void Write_Subroutine_For_Alloc()
+{
+   FILE *dependfileoutput;
+   listnom *parcours;
+
+   if ( List_Subroutine_For_Alloc )
+   {
+      sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+      if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+      {
+         parcours = List_Subroutine_For_Alloc;
+         while (parcours)
+         {
+            fprintf(dependfileoutput,"%s\n",parcours->o_nom);
+            parcours = parcours->suiv;
+         }
+         fclose(dependfileoutput);
+      }
+   }
+}
+
+void Read_Subroutine_For_Alloc()
+{
+    FILE *dependfileoutput;
+    listnom *parcours;
+    listnom *ref;
+
+    ref = (listnom*) NULL;
+    sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+    if ( (dependfileoutput=fopen(dependfilename, "r")) != NULL )
+    {
+        List_Subroutine_For_Alloc = (listnom*) NULL;
+        while ( !feof(dependfileoutput) )
+        {
+            parcours = (listnom*) calloc(1,sizeof(listnom));
+            strcpy(parcours->o_nom,"");
+
+            fscanf(dependfileoutput,"%s\n",parcours->o_nom);
+            parcours->suiv = NULL;
+
+            if ( !List_Subroutine_For_Alloc )
+            {
+                List_Subroutine_For_Alloc = parcours;
+            }
+            else
+            {
+                ref->suiv = parcours;
+            }
+            ref = parcours;
+        }
+        fclose(dependfileoutput);
+    }
+}
+
+/******************************************************************************/
+/*                        Writethedependavailablefile                         */
+/******************************************************************************/
+/* This subroutine is used to write the .dependfileavailable file             */
+/******************************************************************************/
+/*                                                                            */
+/*                                  .dependavailable                          */
+/*     tabvars(1) = var1                                                      */
+/*     tabvars(3) = var1                  2                                   */
+/*     tabvars(4) = var1         =====>   5                                   */
+/*     tabvars(6) = var1                                                      */
+/*     tabvars(7) = var1                                                      */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependavailablefile()
+{
+    FILE *dependfileoutput;
+    listindice *parcours;
+    int i;
+
+    sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        /* We are looking for all the indices of the Listofavailableindices      */
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            parcours = Listofavailableindices_glob[i];
+            while (parcours)
+            {
+                if ( parcours->i_indice != 0 )
+                {
+                    fprintf(dependfileoutput,"%d %d\n",i,parcours->i_indice);
+                }
+                parcours = parcours->suiv;
+            }
+        }
+        fclose(dependfileoutput);
+    }
+}
+
+/******************************************************************************/
+/*                        Readthedependavailablefile                          */
+/******************************************************************************/
+/* This subroutine is used to read the .dependfileavailable file              */
+/******************************************************************************/
+/*                                                                            */
+/*                                  .dependavailable                          */
+/*     tabvars(1) = var1                                                      */
+/*     tabvars(3) = var1                  2                                   */
+/*     tabvars(4) = var1         =====>   5  ==> Listofavailableindices       */
+/*     tabvars(6) = var1                                                      */
+/*     tabvars(7) = var1                                                      */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependavailablefile()
+{
+  FILE *dependfileoutput;
+  listindice *parcours;
+  int current_cat;
+
+  sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+  if ((dependfileoutput=fopen(dependfilename, "r"))!=NULL)
+  {
+     /* We are looking for all the indices of the Listofavailableindices      */
+     Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+     while (!feof(dependfileoutput))
+     {
+        parcours=(listindice *)calloc(1,sizeof(listindice));
+        fscanf(dependfileoutput,"%d %d\n",&current_cat,&parcours->i_indice);
+        if ( parcours->i_indice != 0 && parcours->i_indice < 10000000 )
+        {
+           parcours -> suiv = Listofavailableindices_glob[current_cat];
+           Listofavailableindices_glob[current_cat] = parcours;
+        }
+        else
+        {
+           free(parcours);
+        }
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                       is_dependfile_created                                */
+/******************************************************************************/
+/* This subroutine is used to know if the .depend<NameTampon> exist           */
+/*    it means if the file has been ever parsed                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int is_dependfile_created(const char *NameTampon)
+{
+  FILE *dependfileoutput;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename, "r");
+
+  if ( (dependfileoutput = fopen(dependfilename, "r")) != NULL )
+  {
+    fclose(dependfileoutput);
+    return 1;
+  }
+  else
+    return 0;
+}
+
+void Write_val_max()
+{
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        fprintf(dependfileoutput,"length_last\n");
+        fprintf(dependfileoutput,"%lu\n", length_last);
+        fprintf(dependfileoutput,"length_first\n");
+        fprintf(dependfileoutput,"%lu\n", length_first);
+        fprintf(dependfileoutput,"length_v_vallengspec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_vallengspec);
+        fprintf(dependfileoutput,"length_v_commoninfile\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_commoninfile);
+        fprintf(dependfileoutput,"length_v_precision\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_precision);
+        fprintf(dependfileoutput,"length_v_IntentSpec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_IntentSpec);
+        fprintf(dependfileoutput,"length_v_initialvalue\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_initialvalue);
+        fprintf(dependfileoutput,"length_v_readedlistdimension\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_readedlistdimension);
+        fprintf(dependfileoutput,"length_a_nomvar\n");
+        fprintf(dependfileoutput,"%lu\n", length_a_nomvar);
+        fprintf(dependfileoutput,"length_toprintglob\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprintglob);
+        fprintf(dependfileoutput,"Size_char0d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size);
+        fprintf(dependfileoutput,"Size_char1d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size1);
+        fprintf(dependfileoutput,"Size_char2d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size2);
+        fprintf(dependfileoutput,"Size_char3d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size3);
+        fprintf(dependfileoutput,"length_tmpvargridname\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpvargridname);
+        fprintf(dependfileoutput,"length_ligne_Subloop\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_Subloop);
+        fprintf(dependfileoutput,"length_toprint_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprint_utilagrif);
+        fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprinttmp_utilchar);
+        fprintf(dependfileoutput,"length_ligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_writedecl);
+        fprintf(dependfileoutput,"length_newname_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_toamr);
+        fprintf(dependfileoutput,"length_newname_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_writedecl);
+        fprintf(dependfileoutput,"length_ligne_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_toamr);
+        fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpligne_writedecl);
+
+        fclose(dependfileoutput);
+    }
+}
+
+
+void Read_val_max()
+{
+    char nothing[LONG_M];
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
+    {
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_last);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_first);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_vallengspec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_commoninfile);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_precision);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_IntentSpec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_initialvalue);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_readedlistdimension);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_a_nomvar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprintglob);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size1);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size2);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size3);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpvargridname);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_Subloop);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprint_utilagrif);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprinttmp_utilchar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpligne_writedecl);
+
+       fclose(dependfileoutput);
+    }
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 8732)
@@ -0,0 +1,10440 @@
+/* A Bison parser, made by GNU Bison 2.7.  */
+
+/* Bison implementation for Yacc-like parsers in C
+   
+      Copyright (C) 1984, 1989-1990, 2000-2012 Free Software Foundation, Inc.
+   
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+   
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+   
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+   
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Push parsers.  */
+#define YYPUSH 0
+
+/* Pull parsers.  */
+#define YYPULL 1
+
+
+/* Substitute the variable and function names.  */
+#define yyparse         fortran_parse
+#define yylex           fortran_lex
+#define yyerror         fortran_error
+#define yylval          fortran_lval
+#define yychar          fortran_char
+#define yydebug         fortran_debug
+#define yynerrs         fortran_nerrs
+
+/* Copy the first part of user declarations.  */
+/* Line 371 of yacc.c  */
+#line 36 "fortran.y"
+
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
+int c_selectorgiven=0;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+int removeline=0;
+listvar *test;
+
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+
+/* Line 371 of yacc.c  */
+#line 104 "fortran.tab.c"
+
+# ifndef YY_NULL
+#  if defined __cplusplus && 201103L <= __cplusplus
+#   define YY_NULL nullptr
+#  else
+#   define YY_NULL 0
+#  endif
+# endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+#if YYDEBUG
+extern int fortran_debug;
+#endif
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_NEQV = 258,
+     TOK_EQV = 259,
+     TOK_XOR = 260,
+     TOK_OR = 261,
+     TOK_AND = 262,
+     TOK_NOT = 263,
+     TOK_NE = 264,
+     TOK_EQ = 265,
+     TOK_GE = 266,
+     TOK_LE = 267,
+     TOK_GT = 268,
+     TOK_LT = 269,
+     TOK_DSLASH = 270,
+     TOK_SLASH = 271,
+     TOK_DASTER = 272,
+     TOK_SEMICOLON = 273,
+     TOK_PARAMETER = 274,
+     TOK_RESULT = 275,
+     TOK_ONLY = 276,
+     TOK_INCLUDE = 277,
+     TOK_SUBROUTINE = 278,
+     TOK_PROGRAM = 279,
+     TOK_FUNCTION = 280,
+     TOK_FORMAT = 281,
+     TOK_MAX = 282,
+     TOK_TANH = 283,
+     TOK_WHERE = 284,
+     TOK_ELSEWHEREPAR = 285,
+     TOK_ELSEWHERE = 286,
+     TOK_ENDWHERE = 287,
+     TOK_MAXVAL = 288,
+     TOK_TRIM = 289,
+     TOK_NULL_PTR = 290,
+     TOK_SUM = 291,
+     TOK_SQRT = 292,
+     TOK_CASE = 293,
+     TOK_SELECTCASE = 294,
+     TOK_FILE = 295,
+     TOK_UNIT = 296,
+     TOK_FMT = 297,
+     TOK_NML = 298,
+     TOK_END = 299,
+     TOK_EOR = 300,
+     TOK_ERR = 301,
+     TOK_EXIST = 302,
+     TOK_MIN = 303,
+     TOK_FLOAT = 304,
+     TOK_EXP = 305,
+     TOK_COS = 306,
+     TOK_COSH = 307,
+     TOK_ACOS = 308,
+     TOK_NINT = 309,
+     TOK_CYCLE = 310,
+     TOK_SIN = 311,
+     TOK_SINH = 312,
+     TOK_ASIN = 313,
+     TOK_EQUIVALENCE = 314,
+     TOK_BACKSPACE = 315,
+     TOK_LOG = 316,
+     TOK_TAN = 317,
+     TOK_ATAN = 318,
+     TOK_RECURSIVE = 319,
+     TOK_ABS = 320,
+     TOK_MOD = 321,
+     TOK_SIGN = 322,
+     TOK_MINLOC = 323,
+     TOK_MAXLOC = 324,
+     TOK_EXIT = 325,
+     TOK_MINVAL = 326,
+     TOK_PUBLIC = 327,
+     TOK_PRIVATE = 328,
+     TOK_ALLOCATABLE = 329,
+     TOK_RETURN = 330,
+     TOK_THEN = 331,
+     TOK_ELSEIF = 332,
+     TOK_ELSE = 333,
+     TOK_ENDIF = 334,
+     TOK_PRINT = 335,
+     TOK_PLAINGOTO = 336,
+     TOK_LOGICALIF = 337,
+     TOK_PLAINDO = 338,
+     TOK_CONTAINS = 339,
+     TOK_ENDDO = 340,
+     TOK_MODULE = 341,
+     TOK_ENDMODULE = 342,
+     TOK_WHILE = 343,
+     TOK_CONCURRENT = 344,
+     TOK_ALLOCATE = 345,
+     TOK_OPEN = 346,
+     TOK_CLOSE = 347,
+     TOK_INQUIRE = 348,
+     TOK_WRITE = 349,
+     TOK_FLUSH = 350,
+     TOK_READ = 351,
+     TOK_REWIND = 352,
+     TOK_DEALLOCATE = 353,
+     TOK_NULLIFY = 354,
+     TOK_DIMENSION = 355,
+     TOK_ENDSELECT = 356,
+     TOK_EXTERNAL = 357,
+     TOK_INTENT = 358,
+     TOK_INTRINSIC = 359,
+     TOK_NAMELIST = 360,
+     TOK_DEFAULT = 361,
+     TOK_OPTIONAL = 362,
+     TOK_POINTER = 363,
+     TOK_CONTINUE = 364,
+     TOK_SAVE = 365,
+     TOK_TARGET = 366,
+     TOK_IMPLICIT = 367,
+     TOK_NONE = 368,
+     TOK_CALL = 369,
+     TOK_STAT = 370,
+     TOK_POINT_TO = 371,
+     TOK_COMMON = 372,
+     TOK_GLOBAL = 373,
+     TOK_LEFTAB = 374,
+     TOK_RIGHTAB = 375,
+     TOK_PAUSE = 376,
+     TOK_PROCEDURE = 377,
+     TOK_STOP = 378,
+     TOK_REAL8 = 379,
+     TOK_FOURDOTS = 380,
+     TOK_HEXA = 381,
+     TOK_ASSIGNTYPE = 382,
+     TOK_OUT = 383,
+     TOK_INOUT = 384,
+     TOK_IN = 385,
+     TOK_USE = 386,
+     TOK_TRUE = 387,
+     TOK_FALSE = 388,
+     TOK_LABEL = 389,
+     TOK_TYPE = 390,
+     TOK_TYPEPAR = 391,
+     TOK_ENDTYPE = 392,
+     TOK_REAL = 393,
+     TOK_INTEGER = 394,
+     TOK_LOGICAL = 395,
+     TOK_DOUBLEPRECISION = 396,
+     TOK_ENDSUBROUTINE = 397,
+     TOK_ENDFUNCTION = 398,
+     TOK_ENDPROGRAM = 399,
+     TOK_ENDUNIT = 400,
+     TOK_CHARACTER = 401,
+     TOK_CHAR_CONSTANT = 402,
+     TOK_CHAR_CUT = 403,
+     TOK_DATA = 404,
+     TOK_CHAR_MESSAGE = 405,
+     TOK_CSTREAL = 406,
+     TOK_COMPLEX = 407,
+     TOK_DOUBLECOMPLEX = 408,
+     TOK_NAME = 409,
+     TOK_CSTINT = 410
+   };
+#endif
+
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+{
+/* Line 387 of yacc.c  */
+#line 65 "fortran.y"
+
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+
+
+/* Line 387 of yacc.c  */
+#line 310 "fortran.tab.c"
+} YYSTYPE;
+# define YYSTYPE_IS_TRIVIAL 1
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+#endif
+
+extern YYSTYPE fortran_lval;
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void *YYPARSE_PARAM);
+#else
+int fortran_parse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void);
+#else
+int fortran_parse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* Copy the second part of user declarations.  */
+
+/* Line 390 of yacc.c  */
+#line 338 "fortran.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(Msgid) Msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(E) ((void) (E))
+#else
+# define YYUSE(E) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(N) (N)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int yyi)
+#else
+static int
+YYID (yyi)
+    int yyi;
+#endif
+{
+  return yyi;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
+#     ifndef EXIT_SUCCESS
+#      define EXIT_SUCCESS 0
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef EXIT_SUCCESS
+#    define EXIT_SUCCESS 0
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss_alloc;
+  YYSTYPE yyvs_alloc;
+};
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+# define YYCOPY_NEEDED 1
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack_alloc, Stack)				\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack_alloc, Stack, yysize);			\
+	Stack = &yyptr->Stack_alloc;					\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
+/* Copy COUNT objects from SRC to DST.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(Dst, Src, Count) \
+      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
+#  else
+#   define YYCOPY(Dst, Src, Count)              \
+      do                                        \
+        {                                       \
+          YYSIZE_T yyi;                         \
+          for (yyi = 0; yyi < (Count); yyi++)   \
+            (Dst)[yyi] = (Src)[yyi];            \
+        }                                       \
+      while (YYID (0))
+#  endif
+# endif
+#endif /* !YYCOPY_NEEDED */
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   6268
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  169
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  206
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  597
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  1051
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   410
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     166,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,   168,     2,     2,
+     162,   163,    21,    19,     3,    20,     2,   167,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
+     164,     5,   165,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
+       8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
+      18,    22,    23,    24,    25,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
+      41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
+      51,    52,    53,    54,    55,    56,    57,    58,    59,    60,
+      61,    62,    63,    64,    65,    66,    67,    68,    69,    70,
+      71,    72,    73,    74,    75,    76,    77,    78,    79,    80,
+      81,    82,    83,    84,    85,    86,    87,    88,    89,    90,
+      91,    92,    93,    94,    95,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,   106,   107,   108,   109,   110,
+     111,   112,   113,   114,   115,   116,   117,   118,   119,   120,
+     121,   122,   123,   124,   125,   126,   127,   128,   129,   130,
+     131,   132,   133,   134,   135,   136,   137,   138,   139,   140,
+     141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
+     151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
+     161
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint16 yyprhs[] =
+{
+       0,     0,     3,     4,     7,     9,    11,    14,    16,    19,
+      21,    25,    28,    31,    33,    37,    41,    44,    47,    51,
+      53,    54,    55,    57,    58,    61,    66,    69,    75,    78,
+      80,    83,    85,    87,    88,    91,    95,    96,    99,   103,
+     105,   109,   111,   113,   116,   121,   124,   127,   132,   135,
+     137,   139,   141,   143,   145,   147,   149,   151,   153,   158,
+     162,   166,   169,   172,   173,   175,   177,   179,   181,   183,
+     185,   187,   189,   191,   193,   195,   197,   199,   201,   203,
+     205,   207,   209,   211,   213,   215,   217,   219,   221,   223,
+     225,   229,   233,   239,   241,   245,   249,   252,   257,   259,
+     263,   264,   266,   269,   273,   275,   277,   280,   282,   286,
+     291,   296,   305,   307,   311,   314,   318,   324,   328,   330,
+     331,   334,   336,   341,   345,   348,   352,   356,   360,   364,
+     365,   367,   370,   374,   380,   384,   386,   392,   398,   401,
+     405,   408,   412,   414,   416,   420,   424,   427,   431,   437,
+     439,   442,   444,   448,   451,   453,   457,   458,   460,   462,
+     466,   470,   473,   475,   479,   482,   485,   491,   498,   499,
+     502,   505,   509,   513,   514,   517,   522,   526,   530,   535,
+     538,   540,   542,   544,   546,   548,   550,   552,   553,   556,
+     558,   562,   563,   566,   570,   572,   576,   579,   583,   585,
+     587,   589,   591,   593,   594,   598,   599,   601,   605,   607,
+     611,   613,   615,   617,   620,   622,   627,   629,   631,   633,
+     635,   637,   639,   641,   643,   645,   647,   648,   652,   654,
+     658,   660,   662,   665,   668,   672,   674,   676,   678,   680,
+     682,   686,   690,   694,   699,   704,   708,   713,   718,   722,
+     727,   732,   737,   742,   747,   752,   757,   762,   767,   772,
+     777,   782,   787,   791,   796,   800,   805,   810,   812,   816,
+     818,   820,   822,   825,   828,   831,   833,   835,   838,   841,
+     844,   847,   850,   853,   856,   859,   862,   866,   870,   873,
+     876,   879,   882,   885,   888,   891,   894,   897,   900,   901,
+     903,   906,   909,   912,   914,   916,   918,   920,   921,   923,
+     926,   931,   937,   942,   947,   951,   953,   956,   958,   962,
+     964,   966,   970,   976,   981,   985,   988,   991,   993,   995,
+     997,   999,  1001,  1003,  1005,  1007,  1010,  1013,  1015,  1018,
+    1020,  1022,  1023,  1025,  1031,  1032,  1034,  1036,  1038,  1039,
+    1042,  1045,  1051,  1054,  1059,  1066,  1073,  1075,  1077,  1081,
+    1085,  1087,  1091,  1095,  1097,  1099,  1101,  1103,  1105,  1107,
+    1109,  1111,  1113,  1116,  1118,  1120,  1123,  1126,  1129,  1133,
+    1136,  1142,  1148,  1151,  1154,  1157,  1160,  1162,  1167,  1169,
+    1172,  1175,  1178,  1181,  1183,  1185,  1187,  1189,  1195,  1202,
+    1203,  1207,  1208,  1213,  1214,  1219,  1224,  1226,  1228,  1230,
+    1232,  1234,  1238,  1243,  1245,  1248,  1250,  1253,  1254,  1255,
+    1258,  1262,  1264,  1269,  1271,  1273,  1278,  1281,  1287,  1291,
+    1295,  1297,  1302,  1305,  1312,  1321,  1327,  1331,  1333,  1335,
+    1337,  1339,  1341,  1344,  1351,  1352,  1354,  1357,  1361,  1362,
+    1364,  1367,  1371,  1379,  1385,  1391,  1398,  1400,  1403,  1405,
+    1408,  1414,  1419,  1420,  1422,  1425,  1429,  1436,  1441,  1444,
+    1448,  1450,  1453,  1457,  1459,  1461,  1465,  1467,  1470,  1473,
+    1477,  1479,  1481,  1483,  1485,  1487,  1489,  1491,  1493,  1495,
+    1496,  1501,  1509,  1511,  1515,  1518,  1521,  1524,  1525,  1529,
+    1530,  1532,  1535,  1538,  1540,  1542,  1546,  1548,  1551,  1553,
+    1555,  1556,  1558,  1561,  1564,  1565,  1568,  1572,  1576,  1580,
+    1582,  1586,  1588,  1590,  1594,  1596,  1598,  1600,  1604,  1610,
+    1615,  1618,  1621,  1622,  1624,  1626,  1628,  1630,  1632,  1634,
+    1636,  1638,  1640,  1644,  1646,  1648,  1652,  1656,  1660,  1664,
+    1667,  1671,  1674,  1677,  1680,  1683,  1686,  1689,  1692,  1696,
+    1698,  1700,  1702,  1704,  1708,  1711,  1716,  1719,  1722,  1728,
+    1729,  1731,  1734,  1736,  1738,  1740,  1742,  1746,  1750,  1754,
+    1758,  1762,  1766,  1772,  1778,  1784,  1790,  1798,  1807,  1810,
+    1812,  1816,  1818,  1820,  1824,  1825,  1830,  1832
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int16 yyrhs[] =
+{
+     170,     0,    -1,    -1,   170,   171,    -1,   172,    -1,   173,
+      -1,   140,   173,    -1,     1,    -1,   166,   175,    -1,    24,
+      -1,   172,   166,   175,    -1,   172,    24,    -1,   172,   140,
+      -1,   174,    -1,   173,    24,   166,    -1,   173,    24,   174,
+      -1,   178,   175,    -1,   186,   175,    -1,    28,   181,   175,
+      -1,   282,    -1,    -1,    -1,    70,    -1,    -1,    26,   183,
+      -1,   176,    29,   180,   182,    -1,    30,   180,    -1,   176,
+      31,   180,   182,   177,    -1,    92,   160,    -1,   161,    -1,
+     179,   161,    -1,   160,    -1,   153,    -1,    -1,   162,   163,
+      -1,   162,   184,   163,    -1,    -1,   162,   163,    -1,   162,
+     184,   163,    -1,   185,    -1,   184,     3,   185,    -1,   160,
+      -1,    21,    -1,   228,   196,    -1,   141,   187,   195,   336,
+      -1,   143,   336,    -1,   114,   190,    -1,   198,   162,   221,
+     163,    -1,   198,   221,    -1,   215,    -1,   203,    -1,   225,
+      -1,   211,    -1,   213,    -1,   212,    -1,   276,    -1,   223,
+      -1,   209,    -1,    66,   162,   249,   163,    -1,   108,   195,
+     214,    -1,   110,   195,   189,    -1,    65,   191,    -1,   199,
+     166,    -1,    -1,   244,    -1,    42,    -1,    34,    -1,    39,
+      -1,    54,    -1,    77,    -1,    40,    -1,    43,    -1,    60,
+      -1,    55,    -1,    56,    -1,    57,    -1,    58,    -1,    59,
+      -1,    62,    -1,    63,    -1,    64,    -1,    67,    -1,    68,
+      -1,    69,    -1,    72,    -1,    73,    -1,    74,    -1,    75,
+      -1,   160,    -1,   188,    -1,   189,     3,   188,    -1,   162,
+     194,   163,    -1,   190,     3,   162,   194,   163,    -1,   192,
+      -1,   191,     3,   192,    -1,   162,   193,   163,    -1,   267,
+     245,    -1,   193,     3,   267,   245,    -1,   249,    -1,   194,
+       3,   249,    -1,    -1,   131,    -1,   226,   227,    -1,   197,
+     180,   182,    -1,    31,    -1,    25,    -1,   155,   200,    -1,
+     201,    -1,   200,   220,   201,    -1,   160,    22,   202,    22,
+      -1,   206,    22,   202,    22,    -1,   162,   257,     3,   368,
+     163,    22,   202,    22,    -1,   207,    -1,   207,     3,   202,
+      -1,   204,   205,    -1,   204,   219,   205,    -1,   203,   220,
+     219,   220,   205,    -1,   203,     3,   205,    -1,   116,    -1,
+      -1,   160,   245,    -1,   160,    -1,   160,   162,   249,   163,
+      -1,   206,     3,   206,    -1,   208,   268,    -1,   207,    19,
+     207,    -1,   207,    20,   207,    -1,   207,    21,   207,    -1,
+     207,   167,   207,    -1,    -1,   253,    -1,   111,   267,    -1,
+     111,   219,   267,    -1,   209,   220,   219,   220,   267,    -1,
+     209,     3,   267,    -1,   106,    -1,   210,   220,   160,   245,
+     233,    -1,   211,     3,   160,   245,   233,    -1,    79,   166,
+      -1,    79,   195,   214,    -1,    78,   166,    -1,    78,   195,
+     214,    -1,   160,    -1,   133,    -1,   214,     3,   160,    -1,
+     214,     3,   133,    -1,   216,   217,    -1,   216,   219,   217,
+      -1,   215,   220,   219,   220,   217,    -1,   123,    -1,   124,
+     123,    -1,   218,    -1,   217,     3,   218,    -1,   160,   245,
+      -1,    18,    -1,    22,   160,    22,    -1,    -1,     3,    -1,
+     222,    -1,   221,     3,   222,    -1,   160,     5,   249,    -1,
+     128,   224,    -1,   160,    -1,   224,     3,   160,    -1,   118,
+     119,    -1,   118,   130,    -1,   240,   160,   245,   233,   274,
+      -1,   226,     3,   160,   245,   233,   274,    -1,    -1,   232,
+     235,    -1,   231,   229,    -1,   232,    21,   161,    -1,   142,
+     237,   163,    -1,    -1,    21,   161,    -1,    21,   162,   230,
+     163,    -1,   162,   230,   163,    -1,   160,   238,   239,    -1,
+     160,     5,   238,   239,    -1,   238,   239,    -1,   152,    -1,
+     145,    -1,   146,    -1,   144,    -1,   158,    -1,   159,    -1,
+     147,    -1,    -1,    21,   234,    -1,   249,    -1,   162,    21,
+     163,    -1,    -1,    21,   236,    -1,   162,   237,   163,    -1,
+     249,    -1,   162,    21,   163,    -1,   160,   238,    -1,   160,
+       5,   238,    -1,   160,    -1,   161,    -1,   133,    -1,   249,
+      -1,    21,    -1,    -1,     3,   160,   238,    -1,    -1,   131,
+      -1,     3,   241,   131,    -1,   242,    -1,   241,     3,   242,
+      -1,    25,    -1,   244,    -1,    80,    -1,   106,   245,    -1,
+     108,    -1,   109,   162,   243,   163,    -1,   110,    -1,   113,
+      -1,   114,    -1,   116,    -1,   117,    -1,   136,    -1,   134,
+      -1,   135,    -1,    78,    -1,    79,    -1,    -1,   162,   246,
+     163,    -1,   247,    -1,   246,     3,   247,    -1,   248,    -1,
+       4,    -1,   249,     4,    -1,     4,   249,    -1,   249,     4,
+     248,    -1,    21,    -1,   249,    -1,   252,    -1,   275,    -1,
+     250,    -1,   162,   249,   163,    -1,    42,   251,   163,    -1,
+      33,   251,   163,    -1,    34,   162,   251,   163,    -1,    39,
+     162,   251,   163,    -1,    54,   251,   163,    -1,    77,   162,
+     251,   163,    -1,    40,   162,   249,   163,    -1,    43,   249,
+     163,    -1,   144,   162,   251,   163,    -1,    60,   162,   249,
+     163,    -1,    55,   162,   249,   163,    -1,    56,   162,   249,
+     163,    -1,    57,   162,   249,   163,    -1,    58,   162,   249,
+     163,    -1,    59,   162,   249,   163,    -1,    62,   162,   249,
+     163,    -1,    63,   162,   249,   163,    -1,    64,   162,   249,
+     163,    -1,    67,   162,   249,   163,    -1,    68,   162,   249,
+     163,    -1,    69,   162,   249,   163,    -1,    71,   249,   163,
+      -1,    72,   162,   251,   163,    -1,    73,   251,   163,    -1,
+      74,   162,   251,   163,    -1,    75,   162,   251,   163,    -1,
+     249,    -1,   251,     3,   249,    -1,   257,    -1,   268,    -1,
+     262,    -1,   249,   254,    -1,   253,   249,    -1,    11,   249,
+      -1,    19,    -1,    20,    -1,    19,   249,    -1,    20,   249,
+      -1,    21,   249,    -1,    23,   249,    -1,    13,   249,    -1,
+       7,   249,    -1,    16,   249,    -1,   165,   249,    -1,   164,
+     249,    -1,   165,     5,   249,    -1,   164,     5,   249,    -1,
+      17,   249,    -1,    14,   249,    -1,    15,   249,    -1,    12,
+     249,    -1,     6,   249,    -1,     8,   249,    -1,     9,   249,
+      -1,    10,   249,    -1,    22,   255,    -1,     5,   256,    -1,
+      -1,   249,    -1,     5,   249,    -1,    22,   249,    -1,     5,
+     249,    -1,   249,    -1,   267,    -1,   261,    -1,   259,    -1,
+      -1,   260,    -1,   260,   271,    -1,   261,   162,   263,   163,
+      -1,   261,   162,   263,   163,   271,    -1,   267,   162,   263,
+     163,    -1,   257,   168,   356,   257,    -1,   125,   366,   126,
+      -1,   258,    -1,   258,   264,    -1,   265,    -1,   264,     3,
+     265,    -1,   249,    -1,   266,    -1,   249,     4,   249,    -1,
+     249,     4,   249,     4,   249,    -1,     4,   249,     4,   249,
+      -1,     4,     4,   249,    -1,     4,   249,    -1,   249,     4,
+      -1,     4,    -1,   160,    -1,   138,    -1,   139,    -1,    41,
+      -1,   161,    -1,   157,    -1,   132,    -1,   268,   160,    -1,
+     269,   270,    -1,   153,    -1,   269,   153,    -1,   156,    -1,
+     154,    -1,    -1,   271,    -1,   162,   272,     4,   272,   163,
+      -1,    -1,   249,    -1,   166,    -1,   249,    -1,    -1,     5,
+     249,    -1,   122,   249,    -1,   162,   252,     3,   252,   163,
+      -1,   277,   160,    -1,   277,   160,     3,   278,    -1,   277,
+     160,     3,    27,     4,   166,    -1,   277,   160,     3,    27,
+       4,   280,    -1,   137,    -1,   279,    -1,   278,     3,   279,
+      -1,   160,   122,   160,    -1,   281,    -1,   280,     3,   281,
+      -1,   160,   122,   160,    -1,   160,    -1,   283,    -1,   331,
+      -1,   284,    -1,   300,    -1,   320,    -1,   310,    -1,   287,
+      -1,   115,    -1,   338,   340,    -1,   369,    -1,   341,    -1,
+     357,   352,    -1,   359,   350,    -1,   100,   352,    -1,   100,
+     352,   366,    -1,   103,   353,    -1,    96,   162,   370,   373,
+     163,    -1,   104,   162,   372,   373,   163,    -1,    76,   272,
+      -1,    81,   273,    -1,    61,   273,    -1,   348,   273,    -1,
+     339,    -1,   105,   162,   374,   163,    -1,   333,    -1,   334,
+     336,    -1,   332,   336,    -1,   335,   336,    -1,    93,   336,
+      -1,   319,    -1,   286,    -1,    90,    -1,   249,    -1,    35,
+     162,   294,   163,   293,    -1,   291,   172,   288,   289,   290,
+     297,    -1,    -1,   288,   292,   172,    -1,    -1,   289,   295,
+     172,   288,    -1,    -1,   290,   296,   172,   288,    -1,    35,
+     162,   294,   163,    -1,   293,    -1,   286,    -1,   287,    -1,
+     285,    -1,   249,    -1,    36,   294,   163,    -1,    36,   294,
+     163,   160,    -1,    37,    -1,    37,   160,    -1,    38,    -1,
+      38,   160,    -1,    -1,    -1,   299,   282,    -1,   299,   282,
+     172,    -1,   301,    -1,   302,   172,   307,   308,    -1,   303,
+      -1,   304,    -1,   160,     4,    89,   179,    -1,    89,   179,
+      -1,   160,     4,    89,   179,   305,    -1,    89,   179,   305,
+      -1,   160,     4,    89,    -1,    89,    -1,   160,     4,    89,
+     305,    -1,    89,   305,    -1,   220,   306,     5,   249,     3,
+     249,    -1,   220,   306,     5,   249,     3,   249,     3,   249,
+      -1,   220,    94,   162,   249,   163,    -1,   220,    95,   298,
+      -1,   267,    -1,   299,    -1,   309,    -1,   330,    -1,    91,
+      -1,    91,   160,    -1,   315,   172,   299,   311,   313,   318,
+      -1,    -1,   312,    -1,   311,   312,    -1,   316,   172,   299,
+      -1,    -1,   314,    -1,   313,   312,    -1,   317,   172,   299,
+      -1,   160,     4,    88,   162,   249,   163,    82,    -1,    88,
+     162,   249,   163,    82,    -1,    83,   162,   249,   163,    82,
+      -1,    83,   162,   249,   163,    82,   160,    -1,    84,    -1,
+      84,   160,    -1,    85,    -1,    85,   160,    -1,    88,   162,
+     249,   163,   284,    -1,   323,   172,   321,   325,    -1,    -1,
+     322,    -1,   321,   322,    -1,   324,   172,   299,    -1,   160,
+       4,    45,   162,   249,   163,    -1,    45,   162,   249,   163,
+      -1,    44,   326,    -1,    44,   326,   160,    -1,   107,    -1,
+     107,   160,    -1,   162,   327,   163,    -1,   112,    -1,   328,
+      -1,   327,     3,   328,    -1,   329,    -1,   329,     4,    -1,
+       4,   329,    -1,   329,     4,   329,    -1,   249,    -1,   115,
+      -1,    32,    -1,   148,    -1,   151,    -1,   150,    -1,   149,
+      -1,   166,    -1,   160,    -1,    -1,   267,   337,   245,   245,
+      -1,   338,   168,   356,   267,   337,   245,   245,    -1,   161,
+      -1,   339,     3,   161,    -1,     5,   249,    -1,   122,   249,
+      -1,   344,   342,    -1,    -1,   162,   343,   163,    -1,    -1,
+     346,    -1,   345,   101,    -1,   345,   160,    -1,   120,    -1,
+     347,    -1,   346,     3,   347,    -1,   249,    -1,    21,   161,
+      -1,   127,    -1,   129,    -1,    -1,   363,    -1,   352,   349,
+      -1,   358,   351,    -1,    -1,     3,   363,    -1,   162,   354,
+     163,    -1,   162,   267,   163,    -1,   162,   161,   163,    -1,
+     161,    -1,   162,   252,   163,    -1,   160,    -1,   355,    -1,
+     354,     3,   355,    -1,   360,    -1,    21,    -1,    23,    -1,
+     267,   249,   245,    -1,   267,   249,   168,   356,   338,    -1,
+     267,   162,   266,   163,    -1,   267,    21,    -1,   267,    23,
+      -1,    -1,    97,    -1,    98,    -1,   101,    -1,   361,    -1,
+      21,    -1,   102,    -1,    99,    -1,    86,    -1,   361,    -1,
+     162,   360,   163,    -1,   257,    -1,   268,    -1,   360,   362,
+     360,    -1,   360,    21,   360,    -1,   360,    22,   360,    -1,
+     360,    23,   360,    -1,   362,   360,    -1,   360,    18,   360,
+      -1,    46,   249,    -1,    47,   249,    -1,    49,   249,    -1,
+      48,   249,    -1,    53,   249,    -1,    52,   249,    -1,    50,
+     249,    -1,   160,     5,   249,    -1,   250,    -1,    19,    -1,
+      20,    -1,   364,    -1,   363,     3,   364,    -1,   257,   365,
+      -1,   162,   363,   163,   365,    -1,   250,   365,    -1,   268,
+     365,    -1,   162,   363,     3,   368,   163,    -1,    -1,   254,
+      -1,   365,   254,    -1,   275,    -1,   250,    -1,   252,    -1,
+     367,    -1,   252,     3,   249,    -1,   252,     3,   367,    -1,
+     367,     3,   249,    -1,   367,     3,   367,    -1,   366,     3,
+     249,    -1,   366,     3,   367,    -1,   162,   252,     3,   368,
+     163,    -1,   162,   366,     3,   368,   163,    -1,   162,   367,
+       3,   368,   163,    -1,   160,     5,   249,     3,   249,    -1,
+     160,     5,   249,     3,   249,     3,   249,    -1,    87,   162,
+     249,     3,   249,   163,     3,   249,    -1,    87,   161,    -1,
+     371,    -1,   370,     3,   371,    -1,   257,    -1,   371,    -1,
+     372,     3,   371,    -1,    -1,     3,   121,     5,   257,    -1,
+     267,    -1,   374,     3,   267,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint16 yyrline[] =
+{
+       0,   313,   313,   314,   316,   317,   318,   319,   322,   323,
+     324,   325,   326,   329,   330,   331,   334,   335,   336,   344,
+     347,   350,   351,   354,   355,   358,   366,   375,   392,   411,
+     412,   415,   417,   419,   420,   421,   423,   424,   425,   427,
+     439,   451,   452,   454,   455,   456,   457,   458,   475,   492,
+     493,   498,   499,   536,   549,   550,   551,   552,   553,   554,
+     555,   556,   557,   570,   571,   578,   579,   580,   581,   582,
+     583,   584,   585,   586,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   599,   600,   601,   604,
+     605,   608,   609,   612,   613,   615,   618,   619,   622,   623,
+     625,   626,   629,   695,   710,   712,   716,   719,   720,   723,
+     729,   734,   748,   749,   752,   753,   754,   755,   758,   760,
+     761,   764,   765,   766,   769,   770,   771,   772,   773,   775,
+     776,   779,   780,   781,   782,   785,   792,   802,   814,   815,
+     818,   819,   822,   823,   824,   825,   828,   834,   842,   852,
+     853,   856,   857,   860,   868,   874,   881,   882,   885,   886,
+     889,   905,   908,   909,   912,   921,   923,   945,   970,   972,
+     973,   974,   975,   977,   978,   979,   980,   983,   984,   985,
+     987,   990,   991,   992,   993,   994,   995,   997,   998,  1001,
+    1002,  1004,  1005,  1006,  1008,  1009,  1012,  1013,  1023,  1024,
+    1025,  1028,  1029,  1031,  1032,  1034,  1035,  1036,  1038,  1039,
+    1042,  1043,  1044,  1045,  1046,  1047,  1049,  1050,  1051,  1052,
+    1053,  1056,  1057,  1058,  1061,  1062,  1064,  1065,  1073,  1079,
+    1086,  1087,  1088,  1089,  1090,  1093,  1094,  1096,  1097,  1098,
+    1099,  1103,  1104,  1105,  1106,  1107,  1108,  1109,  1110,  1111,
+    1112,  1113,  1114,  1115,  1116,  1117,  1118,  1119,  1120,  1121,
+    1122,  1123,  1124,  1125,  1126,  1127,  1128,  1130,  1131,  1133,
+    1134,  1135,  1136,  1137,  1138,  1140,  1141,  1145,  1146,  1147,
+    1148,  1149,  1150,  1151,  1152,  1153,  1154,  1155,  1156,  1157,
+    1158,  1159,  1160,  1161,  1162,  1163,  1164,  1165,  1167,  1168,
+    1169,  1170,  1173,  1174,  1177,  1178,  1179,  1183,  1194,  1195,
+    1196,  1197,  1200,  1209,  1216,  1219,  1220,  1223,  1224,  1227,
+    1228,  1231,  1232,  1233,  1234,  1235,  1236,  1237,  1239,  1285,
+    1286,  1287,  1288,  1289,  1290,  1291,  1293,  1296,  1297,  1298,
+    1299,  1301,  1302,  1305,  1307,  1308,  1311,  1312,  1314,  1315,
+    1321,  1329,  1332,  1352,  1379,  1399,  1439,  1446,  1450,  1457,
+    1467,  1468,  1476,  1486,  1498,  1499,  1504,  1505,  1506,  1507,
+    1508,  1513,  1514,  1515,  1516,  1517,  1518,  1519,  1520,  1521,
+    1522,  1523,  1524,  1525,  1526,  1527,  1528,  1529,  1530,  1567,
+    1576,  1587,  1595,  1617,  1618,  1619,  1657,  1661,  1665,  1668,
+    1669,  1672,  1673,  1676,  1677,  1682,  1686,  1687,  1688,  1692,
+    1696,  1701,  1702,  1707,  1708,  1713,  1714,  1718,  1722,  1723,
+    1724,  1729,  1734,  1739,  1740,  1745,  1746,  1747,  1748,  1753,
+    1754,  1755,  1756,  1761,  1762,  1763,  1764,  1768,  1772,  1776,
+    1777,  1782,  1783,  1787,  1790,  1791,  1792,  1796,  1799,  1800,
+    1801,  1804,  1809,  1810,  1815,  1816,  1821,  1822,  1827,  1828,
+    1832,  1836,  1839,  1840,  1841,  1844,  1849,  1850,  1855,  1856,
+    1861,  1862,  1867,  1868,  1872,  1873,  1878,  1879,  1880,  1881,
+    1885,  1889,  1893,  1897,  1905,  1912,  1919,  1926,  1927,  1930,
+    1933,  1944,  1950,  1951,  1954,  1955,  1957,  1970,  1971,  1973,
+    1974,  1977,  1978,  2000,  2003,  2004,  2007,  2015,  2018,  2019,
+    2022,  2023,  2026,  2027,  2029,  2030,  2032,  2035,  2036,  2037,
+    2038,  2039,  2042,  2043,  2046,  2047,  2048,  2049,  2050,  2051,
+    2052,  2053,  2056,  2059,  2060,  2061,  2063,  2064,  2067,  2068,
+    2069,  2072,  2073,  2076,  2077,  2078,  2079,  2080,  2081,  2082,
+    2083,  2084,  2085,  2086,  2087,  2088,  2089,  2090,  2091,  2092,
+    2094,  2095,  2097,  2098,  2104,  2105,  2106,  2107,  2108,  2110,
+    2111,  2112,  2115,  2116,  2117,  2118,  2119,  2120,  2121,  2122,
+    2123,  2124,  2127,  2128,  2129,  2131,  2132,  2134,  2135,  2138,
+    2139,  2142,  2145,  2146,  2148,  2149,  2152,  2153
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || 0
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_NEQV",
+  "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT", "TOK_NE", "TOK_EQ",
+  "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT", "TOK_DSLASH", "'+'", "'-'",
+  "'*'", "TOK_SLASH", "TOK_DASTER", "TOK_SEMICOLON", "TOK_PARAMETER",
+  "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE", "TOK_SUBROUTINE", "TOK_PROGRAM",
+  "TOK_FUNCTION", "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE",
+  "TOK_ELSEWHEREPAR", "TOK_ELSEWHERE", "TOK_ENDWHERE", "TOK_MAXVAL",
+  "TOK_TRIM", "TOK_NULL_PTR", "TOK_SUM", "TOK_SQRT", "TOK_CASE",
+  "TOK_SELECTCASE", "TOK_FILE", "TOK_UNIT", "TOK_FMT", "TOK_NML",
+  "TOK_END", "TOK_EOR", "TOK_ERR", "TOK_EXIST", "TOK_MIN", "TOK_FLOAT",
+  "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT", "TOK_CYCLE",
+  "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE", "TOK_BACKSPACE",
+  "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE", "TOK_ABS", "TOK_MOD",
+  "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT", "TOK_MINVAL",
+  "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE", "TOK_RETURN", "TOK_THEN",
+  "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF", "TOK_PRINT", "TOK_PLAINGOTO",
+  "TOK_LOGICALIF", "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO",
+  "TOK_MODULE", "TOK_ENDMODULE", "TOK_WHILE", "TOK_CONCURRENT",
+  "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE", "TOK_INQUIRE", "TOK_WRITE",
+  "TOK_FLUSH", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE", "TOK_NULLIFY",
+  "TOK_DIMENSION", "TOK_ENDSELECT", "TOK_EXTERNAL", "TOK_INTENT",
+  "TOK_INTRINSIC", "TOK_NAMELIST", "TOK_DEFAULT", "TOK_OPTIONAL",
+  "TOK_POINTER", "TOK_CONTINUE", "TOK_SAVE", "TOK_TARGET", "TOK_IMPLICIT",
+  "TOK_NONE", "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON",
+  "TOK_GLOBAL", "TOK_LEFTAB", "TOK_RIGHTAB", "TOK_PAUSE", "TOK_PROCEDURE",
+  "TOK_STOP", "TOK_REAL8", "TOK_FOURDOTS", "TOK_HEXA", "TOK_ASSIGNTYPE",
+  "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
+  "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
+  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_ENDSUBROUTINE",
+  "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT", "TOK_CHARACTER",
+  "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA", "TOK_CHAR_MESSAGE",
+  "TOK_CSTREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX", "TOK_NAME",
+  "TOK_CSTINT", "'('", "')'", "'<'", "'>'", "'\\n'", "'/'", "'%'",
+  "$accept", "input", "line", "line-break", "suite_line_list",
+  "suite_line", "fin_line", "opt_recursive", "opt_result", "entry",
+  "label", "name_routine", "filename", "arglist", "arglist_after_result",
+  "args", "arg", "spec", "opt_spec", "name_intrinsic",
+  "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
+  "list_expr_equi1", "list_expr", "opt_sep", "after_type",
+  "before_function", "before_parameter", "data_stmt", "data_stmt_set_list",
+  "data_stmt_set", "data_stmt_value_list", "save", "before_save",
+  "varsave", "datanamelist", "expr_data", "opt_signe", "namelist",
+  "before_dimension", "dimension", "private", "public", "use_name_list",
+  "common", "before_common", "var_common_list", "var_common", "comblock",
+  "opt_comma", "paramlist", "paramitem", "module_proc_stmt",
+  "proc_name_list", "implicit", "dcl", "nodimsgiven", "type", "c_selector",
+  "c_attribute", "before_character", "typespec", "lengspec",
+  "proper_lengspec", "selector", "proper_selector", "attribute", "clause",
+  "opt_clause", "options", "attr_spec_list", "attr_spec", "intent_spec",
+  "access_spec", "dims", "dimlist", "dim", "ubound", "expr",
+  "predefinedfunction", "minmaxlist", "uexpr", "signe", "operation",
+  "after_slash", "after_equal", "lhs", "beforefunctionuse",
+  "array_ele_substring_func_ref", "begin_array", "structure_component",
+  "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
+  "simple_const", "string_constant", "opt_substring", "substring",
+  "optexpr", "opt_expr", "initial_value", "complex_const", "use_stat",
+  "word_use", "rename_list", "rename_name", "only_list", "only_name",
+  "execution-part-construct", "executable-construct", "action-stmt",
+  "assignment-stmt", "where-stmt", "where-construct",
+  "opt-where-body-construct", "opt-masked-elsewhere-construct",
+  "opt-elsewhere-construct", "where-construct-stmt",
+  "where-body-construct", "where-assignment-stmt", "mask-expr",
+  "masked-elsewhere-stmt", "elsewhere-stmt", "end-where-stmt",
+  "forall-header", "block", "do-construct", "block-do-construct",
+  "do-stmt", "label-do-stmt", "nonlabel-do-stmt", "loop-control",
+  "do-variable", "do-block", "end-do", "end-do-stmt", "if-construct",
+  "opt-else-if-stmt-block", "else-if-stmt-block", "opt-else-stmt-block",
+  "else-stmt-block", "if-then-stmt", "else-if-stmt", "else-stmt",
+  "end-if-stmt", "if-stmt", "case-construct", "opt_case-stmt-block",
+  "case-stmt-block", "select-case-stmt", "case-stmt", "end-select-stmt",
+  "case-selector", "case-value-range-list", "case-value-range",
+  "case-value", "continue-stmt", "format-stmt", "word_endsubroutine",
+  "word_endunit", "word_endprogram", "word_endfunction", "opt_name",
+  "before_dims", "ident_dims", "int_list", "after_ident_dims", "call",
+  "opt_call", "opt_callarglist", "keywordcall", "before_call",
+  "callarglist", "callarg", "stop", "option_inlist", "option_read",
+  "opt_inlist", "ioctl", "after_rewind", "ctllist", "ioclause",
+  "declare_after_percent", "iofctl", "infmt", "read", "fexpr",
+  "unpar_fexpr", "addop", "inlist", "inelt", "opt_operation", "outlist",
+  "other", "dospec", "goto", "allocation_list", "allocate_object",
+  "allocate_object_list", "opt_stat_spec", "pointer_name_list", YY_NULL
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
+     262,   263,   264,   265,   266,   267,   268,   269,   270,    43,
+      45,    42,   271,   272,   273,   274,   275,   276,   277,   278,
+     279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
+     289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
+     299,   300,   301,   302,   303,   304,   305,   306,   307,   308,
+     309,   310,   311,   312,   313,   314,   315,   316,   317,   318,
+     319,   320,   321,   322,   323,   324,   325,   326,   327,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   337,   338,
+     339,   340,   341,   342,   343,   344,   345,   346,   347,   348,
+     349,   350,   351,   352,   353,   354,   355,   356,   357,   358,
+     359,   360,   361,   362,   363,   364,   365,   366,   367,   368,
+     369,   370,   371,   372,   373,   374,   375,   376,   377,   378,
+     379,   380,   381,   382,   383,   384,   385,   386,   387,   388,
+     389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
+     399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
+     409,   410,    40,    41,    60,    62,    10,    47,    37
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint16 yyr1[] =
+{
+       0,   169,   170,   170,   171,   171,   171,   171,   172,   172,
+     172,   172,   172,   173,   173,   173,   174,   174,   174,   174,
+     175,   176,   176,   177,   177,   178,   178,   178,   178,   179,
+     179,   180,   181,   182,   182,   182,   183,   183,   183,   184,
+     184,   185,   185,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   187,   187,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   189,
+     189,   190,   190,   191,   191,   192,   193,   193,   194,   194,
+     195,   195,   196,   196,   197,   198,   199,   200,   200,   201,
+     201,   201,   202,   202,   203,   203,   203,   203,   204,   205,
+     205,   206,   206,   206,   207,   207,   207,   207,   207,   208,
+     208,   209,   209,   209,   209,   210,   211,   211,   212,   212,
+     213,   213,   214,   214,   214,   214,   215,   215,   215,   216,
+     216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
+     222,   223,   224,   224,   225,   225,   226,   226,   227,   228,
+     228,   228,   228,   229,   229,   229,   229,   230,   230,   230,
+     231,   232,   232,   232,   232,   232,   232,   233,   233,   234,
+     234,   235,   235,   235,   236,   236,   237,   237,   237,   237,
+     237,   238,   238,   239,   239,   240,   240,   240,   241,   241,
+     242,   242,   242,   242,   242,   242,   242,   242,   242,   242,
+     242,   243,   243,   243,   244,   244,   245,   245,   246,   246,
+     247,   247,   247,   247,   247,   248,   248,   249,   249,   249,
+     249,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   251,   251,   252,
+     252,   252,   252,   252,   252,   253,   253,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   255,   255,
+     255,   255,   256,   256,   257,   257,   257,   258,   259,   259,
+     259,   259,   260,   261,   262,   263,   263,   264,   264,   265,
+     265,   266,   266,   266,   266,   266,   266,   266,   267,   268,
+     268,   268,   268,   268,   268,   268,   268,   269,   269,   269,
+     269,   270,   270,   271,   272,   272,   273,   273,   274,   274,
+     274,   275,   276,   276,   276,   276,   277,   278,   278,   279,
+     280,   280,   281,   281,   282,   282,   283,   283,   283,   283,
+     283,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   285,   286,   287,   288,
+     288,   289,   289,   290,   290,   291,   292,   292,   292,   293,
+     294,   295,   295,   296,   296,   297,   297,   298,   299,   299,
+     299,   300,   301,   302,   302,   303,   303,   303,   303,   304,
+     304,   304,   304,   305,   305,   305,   305,   306,   307,   308,
+     308,   309,   309,   310,   311,   311,   311,   312,   313,   313,
+     313,   314,   315,   315,   316,   316,   317,   317,   318,   318,
+     319,   320,   321,   321,   321,   322,   323,   323,   324,   324,
+     325,   325,   326,   326,   327,   327,   328,   328,   328,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   336,   337,
+     338,   338,   339,   339,   340,   340,   341,   342,   342,   343,
+     343,   344,   344,   345,   346,   346,   347,   347,   348,   348,
+     349,   349,   350,   350,   351,   351,   352,   353,   353,   353,
+     353,   353,   354,   354,   355,   355,   355,   355,   355,   355,
+     355,   355,   356,   357,   357,   357,   358,   358,   359,   359,
+     359,   360,   360,   361,   361,   361,   361,   361,   361,   361,
+     361,   361,   361,   361,   361,   361,   361,   361,   361,   361,
+     362,   362,   363,   363,   364,   364,   364,   364,   364,   365,
+     365,   365,   366,   366,   366,   366,   366,   366,   366,   366,
+     366,   366,   367,   367,   367,   368,   368,   369,   369,   370,
+     370,   371,   372,   372,   373,   373,   374,   374
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     1,     1,     2,     1,     2,     1,
+       3,     2,     2,     1,     3,     3,     2,     2,     3,     1,
+       0,     0,     1,     0,     2,     4,     2,     5,     2,     1,
+       2,     1,     1,     0,     2,     3,     0,     2,     3,     1,
+       3,     1,     1,     2,     4,     2,     2,     4,     2,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     4,     3,
+       3,     2,     2,     0,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       3,     3,     5,     1,     3,     3,     2,     4,     1,     3,
+       0,     1,     2,     3,     1,     1,     2,     1,     3,     4,
+       4,     8,     1,     3,     2,     3,     5,     3,     1,     0,
+       2,     1,     4,     3,     2,     3,     3,     3,     3,     0,
+       1,     2,     3,     5,     3,     1,     5,     5,     2,     3,
+       2,     3,     1,     1,     3,     3,     2,     3,     5,     1,
+       2,     1,     3,     2,     1,     3,     0,     1,     1,     3,
+       3,     2,     1,     3,     2,     2,     5,     6,     0,     2,
+       2,     3,     3,     0,     2,     4,     3,     3,     4,     2,
+       1,     1,     1,     1,     1,     1,     1,     0,     2,     1,
+       3,     0,     2,     3,     1,     3,     2,     3,     1,     1,
+       1,     1,     1,     0,     3,     0,     1,     3,     1,     3,
+       1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
+       1,     1,     2,     2,     3,     1,     1,     1,     1,     1,
+       3,     3,     3,     4,     4,     3,     4,     4,     3,     4,
+       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
+       4,     4,     3,     4,     3,     4,     4,     1,     3,     1,
+       1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     3,     3,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     0,     1,
+       2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
+       4,     5,     4,     4,     3,     1,     2,     1,     3,     1,
+       1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
+       1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
+       1,     0,     1,     5,     0,     1,     1,     1,     0,     2,
+       2,     5,     2,     4,     6,     6,     1,     1,     3,     3,
+       1,     3,     3,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     2,     1,     1,     2,     2,     2,     3,     2,
+       5,     5,     2,     2,     2,     2,     1,     4,     1,     2,
+       2,     2,     2,     1,     1,     1,     1,     5,     6,     0,
+       3,     0,     4,     0,     4,     4,     1,     1,     1,     1,
+       1,     3,     4,     1,     2,     1,     2,     0,     0,     2,
+       3,     1,     4,     1,     1,     4,     2,     5,     3,     3,
+       1,     4,     2,     6,     8,     5,     3,     1,     1,     1,
+       1,     1,     2,     6,     0,     1,     2,     3,     0,     1,
+       2,     3,     7,     5,     5,     6,     1,     2,     1,     2,
+       5,     4,     0,     1,     2,     3,     6,     4,     2,     3,
+       1,     2,     3,     1,     1,     3,     1,     2,     2,     3,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     0,
+       4,     7,     1,     3,     2,     2,     2,     0,     3,     0,
+       1,     2,     2,     1,     1,     3,     1,     2,     1,     1,
+       0,     1,     2,     2,     0,     2,     3,     3,     3,     1,
+       3,     1,     1,     3,     1,     1,     1,     3,     5,     4,
+       2,     2,     0,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     3,     1,     1,     3,     3,     3,     3,     2,
+       3,     2,     2,     2,     2,     2,     2,     2,     3,     1,
+       1,     1,     1,     3,     2,     4,     2,     2,     5,     0,
+       1,     2,     1,     1,     1,     1,     3,     3,     3,     3,
+       3,     3,     5,     5,     5,     5,     7,     8,     2,     1,
+       3,     1,     1,     3,     0,     4,     1,     3
+};
+
+/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM.
+   Performed when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint16 yydefact[] =
+{
+       2,     0,     1,     7,     9,   105,     0,     0,   482,     0,
+       0,     0,     0,     0,    22,   344,   100,   100,     0,   540,
+       0,     0,   156,   395,     0,     0,     0,   533,   534,   539,
+       0,   535,   538,     0,     0,     0,   135,   100,   100,     0,
+       0,   371,   118,     0,   503,   149,     0,   508,     0,   509,
+     356,    21,    63,     0,     0,   183,   181,   182,   186,   483,
+     486,   485,   484,   180,     0,   184,   185,   328,   492,    20,
+       3,     4,     5,    13,     0,    20,    20,     0,     0,    50,
+     119,    57,   156,    52,    54,    53,    49,     0,    56,    51,
+     205,   173,   191,   489,    55,     0,    19,   364,   366,   394,
+     370,     0,   367,   421,     0,   423,   424,   369,     0,   393,
+     368,     0,   365,     0,   388,     0,     0,     0,   386,   374,
+     497,     0,     0,     0,     0,   373,    32,    20,    31,    26,
+       0,     0,     0,   275,   276,     0,     0,     0,     0,   331,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   334,   329,   330,     0,   337,   340,   339,   333,
+     328,   332,     0,   346,   347,   239,   237,     0,   269,   306,
+     308,   305,   271,   304,   270,   341,   384,   238,     0,    61,
+      93,     0,   345,   382,   101,   140,     0,   138,     0,   383,
+     588,     0,     0,   157,    29,   156,     0,   432,    28,   488,
+     487,   392,     0,     0,   377,   521,   519,     0,   379,     0,
+       0,     0,     0,   154,     0,     0,   131,     0,    46,   164,
+     165,   150,   162,   161,     6,   224,   225,   100,    64,   200,
+     198,   199,     0,    45,   121,     0,   156,   107,     0,     0,
+       8,    11,    12,    20,    21,     0,     0,    16,    17,     0,
+       0,    48,   158,    62,   119,     0,   226,   114,   119,   157,
+       0,     0,     0,     0,   226,   146,   151,     0,     0,   104,
+     206,    43,     0,   168,     0,     0,     0,   170,     0,     0,
+     169,   226,   352,   399,   418,   418,   462,   390,   389,   391,
+       0,     0,   532,   372,     0,   499,   496,   501,   502,   385,
+     375,   560,   561,   537,     0,     0,     0,     0,     0,     0,
+       0,   328,     0,   559,   543,   544,   376,   510,   514,     0,
+     536,     0,    18,   410,     0,     0,   274,   267,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   573,   574,   572,     0,   575,
+       0,     0,   237,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   298,     0,
+       0,     0,   272,   273,   532,   344,   309,   307,   307,   335,
+     338,   336,   342,     0,   226,     0,     0,   143,   142,   141,
+     139,     0,     0,    30,   428,     0,   417,   437,     0,   591,
+     594,   589,   525,   526,     0,   304,     0,   522,   524,   541,
+     378,   332,   237,   304,   592,   594,   596,     0,    59,    66,
+      67,    70,    65,    71,    68,    73,    74,    75,    76,    77,
+      72,    78,    79,    80,    81,    82,    83,    84,    85,    86,
+      87,    69,    88,    89,    60,     0,   132,     0,    98,     0,
+       0,     0,     0,   202,   196,   201,   172,   129,     0,     0,
+       0,     0,   129,     0,     0,   156,    10,    14,    15,    33,
+      33,     0,     0,     0,   117,   156,     0,   120,   115,   134,
+     156,   226,   226,   156,   153,     0,   147,   210,   212,   226,
+     214,     0,   216,   217,   218,   219,   220,     0,   208,   211,
+      33,     0,   102,   226,   174,     0,   328,     0,   203,   332,
+       0,   192,   194,     0,   226,     0,   401,   438,     0,   444,
+       0,     0,   463,     0,   494,   495,     0,   493,     0,   506,
+       0,   500,   504,   551,   552,   554,   553,   557,   556,   555,
+       0,   524,     0,   569,   569,   569,   512,   511,   562,     0,
+     513,     0,     0,     0,     0,     0,   549,   405,   467,     0,
+     242,     0,     0,     0,   241,   248,   245,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   262,
+       0,   264,     0,     0,     0,   237,     0,     0,     0,     0,
+     314,     0,     0,   240,     0,     0,   303,   297,   292,   282,
+     293,   294,   295,   291,   281,   289,   290,   283,   288,   277,
+     278,   279,     0,     0,   299,   296,   280,     0,   285,     0,
+     284,     0,     0,   315,     0,     0,     0,    95,    96,    94,
+      58,     0,     0,     0,     0,   436,     0,     0,     0,     0,
+     530,   531,   307,   226,     0,   516,   518,   520,   517,     0,
+       0,     0,   387,     0,   155,     0,    91,     0,   163,    44,
+     197,     0,   112,     0,   130,     0,     0,   108,   121,   123,
+       0,     0,     0,   156,   431,     0,    25,    23,   160,    47,
+     159,   119,   231,   235,     0,   228,   230,   236,     0,   187,
+     187,     0,   152,   213,     0,     0,   207,   103,   226,   187,
+       0,     0,   203,   176,     0,   179,     0,   193,   490,     0,
+       0,   353,   357,   396,   409,   407,   408,   403,     0,   406,
+     419,   441,   481,   422,   439,   440,     0,   448,   445,     0,
+     473,     0,   468,   470,   464,   461,   418,   489,   507,   498,
+       0,   558,   542,     0,   570,   566,   564,   567,     0,   515,
+     550,   546,   547,   548,   545,   397,   268,   243,   244,   247,
+     251,   252,   253,   254,   255,   250,   256,   257,   258,   259,
+     260,   261,   263,   265,   266,   246,     0,     0,     0,   576,
+     577,   580,   581,   578,   579,   249,   237,   302,   300,   301,
+     287,   286,   313,   344,   327,   319,   316,   317,   320,   310,
+     312,   226,   145,   144,     0,     0,   453,     0,   460,     0,
+       0,     0,   590,   380,     0,     0,   532,   527,   523,   593,
+     381,   597,    90,    99,     0,   109,   129,   129,   129,   129,
+     129,   124,   122,     0,     0,   110,     0,     0,   427,    42,
+      41,    34,     0,    39,    36,    27,   116,   233,     0,   227,
+     232,   133,     0,   136,   137,   148,   222,   223,   221,     0,
+     209,   187,   348,   175,   203,   177,     0,   195,     0,     0,
+       0,     0,     0,     0,   400,   420,   442,     0,   456,   446,
+       0,   449,     0,   418,     0,   480,     0,   474,   476,   469,
+     471,   465,   226,   505,     0,   569,   571,   563,   328,     0,
+       0,     0,   351,     0,     0,   325,   326,     0,   311,    97,
+       0,     0,     0,   435,     0,     0,   529,     0,    92,   113,
+     125,   126,   127,   128,     0,     0,   466,     0,     0,    35,
+       0,    24,   229,   234,   236,     0,   188,   189,   215,   348,
+       0,     0,   166,   178,   204,   363,   354,   355,   360,   359,
+     358,     0,   413,   415,     0,   398,   399,     0,   457,   458,
+     450,   443,   418,   447,   478,     0,   472,   477,   226,     0,
+     565,   582,   583,   584,   343,   324,     0,   321,   318,     0,
+       0,     0,   433,   595,   528,     0,   129,   452,    40,    37,
+       0,     0,   167,   349,   350,     0,     0,   411,   414,   416,
+     399,   402,     0,   459,   451,   475,   479,   491,   568,   323,
+       0,   587,     0,     0,     0,     0,     0,    38,   190,   362,
+     361,   412,   404,   454,   322,   434,   585,   111,   455,     0,
+     586
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int16 yydefgoto[] =
+{
+      -1,     1,    70,    71,    72,    73,   250,    74,   865,    75,
+     205,   129,   127,   696,   951,   862,   863,    76,   237,   463,
+     464,   228,   189,   190,   403,   467,   196,   281,   282,    77,
+      78,   246,   247,   681,    79,    80,   267,   248,   682,   683,
+      81,    82,    83,    84,    85,   409,    86,    87,   275,   276,
+     225,   206,   261,   262,    88,   233,    89,   283,   522,    90,
+     287,   527,    91,    92,   873,   956,   290,   531,   242,   528,
+     725,   284,   517,   518,   879,   519,   497,   704,   705,   706,
+     337,   175,   338,   176,   177,   392,   635,   617,   178,   643,
+     179,   180,   181,   182,   645,   816,   817,   818,   183,   184,
+     185,   401,   396,   193,   186,   962,   187,    94,    95,   731,
+     732,   967,   968,   740,    97,    98,   734,    99,   100,   536,
+     737,   892,   101,   738,   739,   334,   893,   974,   975,   655,
+     537,   102,   103,   104,   105,   106,   207,   418,   538,   743,
+     744,   107,   747,   748,   900,   901,   108,   749,   902,   981,
+     109,   110,   541,   542,   111,   543,   755,   752,   906,   907,
+     908,   745,   112,   113,   114,   115,   116,   211,   291,   117,
+     118,   303,   119,   306,   550,   120,   121,   551,   552,   122,
+     566,   326,   570,   214,   218,   426,   427,   546,   123,   328,
+     124,   428,   429,   331,   567,   568,   765,   368,   369,   854,
+     125,   420,   421,   435,   658,   437
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -845
+static const yytype_int16 yypact[] =
+{
+    -845,   967,  -845,  -845,  -845,  -845,   -22,    45,  -845,    94,
+     186,  3621,   199,   238,  -845,  4658,    16,    36,  3621,  -845,
+     369,   256,    56,  -845,   299,   280,   268,  -845,  -845,  -845,
+     306,  -845,  -845,   409,   311,   350,  -845,   357,   357,   119,
+     354,  -845,  -845,    53,  -845,  -845,   420,  -845,   386,  -845,
+    -845,  5758,   363,   274,   280,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   237,  -845,  -845,   549,  -845,  -845,
+    -845,   122,   563,  -845,   440,  -845,  -845,   319,   433,   436,
+     159,   495,   622,   624,  -845,  -845,   523,   329,  -845,  -845,
+     398,   102,   163,  -845,  -845,   471,  -845,  -845,  -845,  -845,
+    -845,   215,  -845,  -845,   215,  -845,  -845,  -845,   215,  -845,
+    -845,   215,  -845,   280,  -845,   280,   280,    20,   630,  -845,
+     472,    44,  3621,   306,  5477,  -845,  -845,  -845,  -845,  -845,
+    4658,  4658,  4658,  -845,  -845,  4658,   473,   474,   477,  -845,
+    4658,  4658,  4658,   478,   484,   486,   487,   488,   494,   496,
+     497,   498,   499,   500,   501,  4658,   505,  4658,   507,   508,
+     511,  4767,  -845,  -845,  -845,   512,  -845,  -845,  -845,  -845,
+    -845,  -845,  4658,  -845,  2490,  -845,  -845,  4658,   470,  -845,
+     513,   515,  -845,   516,   522,   270,  -845,  -845,   524,   654,
+    -845,  4658,  2490,  -845,  -845,  -845,   277,  -845,   277,  -845,
+    -845,  4658,  4658,  -845,  -845,   110,   326,  -845,  -845,  -845,
+    -845,  -845,   524,  5347,  4767,  -845,  -845,  4876,  -845,   524,
+     524,   277,  2573,  -845,   527,   524,  -845,  4658,   665,  -845,
+    -845,  -845,  -845,   680,   563,  -845,  -845,   357,  -845,  -845,
+    2967,  -845,   526,  -845,    88,   524,    32,  -845,   384,    82,
+    -845,  -845,  -845,  -845,  5621,    45,    45,  -845,  -845,   687,
+     533,   691,  -845,  -845,   535,   442,   534,  -845,   535,   524,
+     442,   537,   539,   442,   534,   699,  -845,   545,   847,  -845,
+    -845,  -845,    45,   714,   564,   434,  3874,  -845,  4985,   274,
+    -845,   534,   727,   122,   122,   122,   258,  -845,  -845,  -845,
+    4658,  4658,  -845,  -845,   571,  3983,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,   726,  5347,  -845,   470,   522,  -845,  1249,   730,   555,
+     561,  5523,  -845,  2490,   572,  1332,   875,  2490,    38,  4658,
+    4658,  4658,    48,  1353,    61,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  1514,  4658,    68,
+    4658,  4658,  4658,  4767,  2490,  1533,   753,  1552,   278,   731,
+    4658,  1616,   733,  3294,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  4658,  3076,  4658,
+    3403,  3512,  -845,   185,  -845,  4658,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,    69,   534,   199,  1635,  -845,  -845,   734,
+     734,  1129,  1713,  -845,  -845,   576,  -845,  -845,   736,   470,
+     739,  -845,  -845,  -845,  5523,  3765,    79,  -845,   555,  -845,
+     740,   581,   582,   439,  -845,   743,  -845,   105,   734,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   744,   717,  -845,   106,  2490,   588,
+     591,   280,  4092,  -845,  -845,  2490,  -845,   598,  4658,    31,
+     237,   594,   598,   595,   602,   125,  -845,  -845,  -845,   609,
+     609,  4658,   109,   533,  -845,   622,  2531,  -845,  -845,  -845,
+     622,   534,   534,   622,  -845,   545,   699,  -845,  -845,   534,
+    -845,   615,  -845,  -845,  -845,  -845,  -845,   123,  -845,  -845,
+     609,   618,  -845,   534,  -845,  3874,  3185,   585,   750,    34,
+    4201,  -845,  2490,   592,   534,    80,  4331,  5955,    78,  5879,
+      13,    85,  -845,   215,  2490,  2490,   524,  -845,   619,  2490,
+     616,   778,  -845,  2490,  2490,  2490,  2490,  2490,  2490,  2490,
+    4658,   337,  1249,  2490,   706,  1732,  -845,   779,  -845,  1249,
+    -845,  5523,  5523,  5523,  5523,  5523,   760,  4658,  -845,  4658,
+    -845,   111,   115,  1751,  -845,  -845,  -845,  1796,  1815,  1834,
+    1912,  1931,  1995,  2014,  2033,  2092,  2111,  2130,  2194,  -845,
+     121,  -845,   130,   136,   149,   781,   785,   786,  4767,  4767,
+    -845,  4767,   150,  -845,  4658,  4658,  2490,  -845,   542,   542,
+     806,   806,   875,   887,   887,   887,   887,   887,   887,   164,
+     164,   185,  4658,  4658,  2490,  -845,   185,  4658,   887,  4658,
+     887,   524,   787,  2640,   627,   629,   524,  -845,  -845,  -845,
+    -845,   295,  4658,  6031,  4658,  -845,  4658,    19,   631,   337,
+    -845,  -845,  2640,    83,  5347,  -845,  -845,  -845,  -845,    19,
+     632,   524,  -845,  2573,  -845,  4658,  -845,  4658,  -845,  -845,
+    -845,   771,    42,   547,  -845,  2213,   636,  -845,   637,  -845,
+     776,  4658,  4658,   135,  -845,   242,  -845,   774,  2490,  -845,
+    -845,   535,  4658,  -845,   151,  -845,  -845,  1253,   524,   780,
+     780,   545,  -845,  -845,   476,   847,  -845,  -845,   534,   780,
+     641,  4092,   750,  -845,   645,  -845,   644,  -845,  -845,   804,
+     688,   809,  -845,  2490,  -845,  -845,  -845,   773,   215,  -845,
+     215,   653,  -845,  -845,  -845,  -845,   652,   536,  -845,   215,
+    -845,  2749,   655,   664,  -845,  -845,   122,  -845,  -845,  -845,
+    3983,  2490,  -845,   152,  -845,  2490,  2490,  2490,  1249,   779,
+     570,   760,   760,   760,   593,  -845,  2490,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  5094,  5094,  5094,  2490,
+    -845,  2490,  -845,  2490,  -845,  -845,   667,   887,   887,   185,
+     887,   887,   470,  4658,  2858,  1415,   828,  -845,  -845,   513,
+    -845,   534,  -845,  -845,  2291,   670,  -845,   671,  -845,  2310,
+    1150,   829,  -845,  -845,  1233,   672,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  2490,   153,  -845,   598,   598,   598,   598,
+     598,   522,  -845,   832,   676,  -845,  2329,  2374,  -845,  -845,
+    -845,  -845,   154,  -845,   678,  -845,  -845,  2490,  2531,  -845,
+    4440,  -845,  5203,  -845,  -845,   699,  -845,  -845,  -845,   679,
+    -845,   780,   231,  -845,   750,  -845,  4092,  -845,   291,   681,
+     683,  4658,   586,   215,   122,   122,  -845,  4658,   685,  -845,
+     454,  -845,   215,   122,  4658,  2490,   155,  -845,   842,  -845,
+    -845,  5955,   534,  -845,  1831,  2490,  -845,  -845,   832,   684,
+     686,   689,  -845,   690,  4658,  1435,  4658,  2640,  -845,  -845,
+     845,  4658,  4658,  -845,  4658,   524,  -845,   524,  -845,  -845,
+      66,    66,   693,   143,  4658,   833,  -845,   768,    60,  -845,
+     259,  -845,  -845,  -845,  2490,  4549,  -845,  2490,  -845,   231,
+    4658,  4658,  -845,  -845,  -845,   729,  -845,   851,  -845,  -845,
+    -845,   695,   696,   702,   215,  -845,   122,  2393,  -845,   703,
+    -845,  -845,   122,  5955,  -845,  2749,  -845,  4658,   534,   701,
+    2490,  -845,  -845,  -845,  -845,  2490,  4658,  1455,  -845,  4658,
+     704,  2412,  1171,   470,   697,  1192,   598,  -845,  -845,  -845,
+     157,   705,  -845,  2490,  2490,   709,   713,   716,  -845,  -845,
+     122,  4331,   784,  -845,  5955,  -845,  -845,  -845,  -845,  2490,
+    4658,  2490,  4658,  6107,  4658,  4658,   855,  -845,  -845,  -845,
+    -845,  -845,  4331,   719,  2490,  2490,  1213,  -845,  -845,  4658,
+    2490
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int16 yypgoto[] =
+{
+    -845,  -845,  -845,   -96,   830,   628,   -26,  -845,  -845,  -845,
+     399,   156,  -845,   -94,  -845,   -67,   -63,  -845,  -845,   232,
+    -845,  -845,  -845,   509,  -845,   234,    30,  -845,  -845,  -845,
+    -845,  -845,   444,  -464,  -845,  -845,  -238,   438,  -242,  -845,
+    -845,  -845,  -845,  -845,  -845,   -47,  -845,  -845,  -263,   417,
+     -27,   -50,   668,   437,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,   404,  -845,  -845,  -671,  -845,  -845,  -845,   642,  -231,
+    -656,  -845,  -845,   217,  -845,   882,  -236,  -845,    67,    70,
+     -11,   -78,    55,  -144,  -458,  -507,  -845,  -845,   -97,  -845,
+    -845,  -845,  -845,  -845,   540,  -845,     9,   279,     1,   -70,
+    -845,  -845,  -182,  -382,   365,   -20,  -128,  -845,  -845,  -845,
+      52,  -845,   -73,    43,  -845,  -630,  -845,  -515,  -514,  -844,
+    -845,  -845,  -845,  -845,  -566,  -718,  -845,  -845,  -845,  -845,
+    -294,  -845,  -845,  -845,  -845,  -845,  -185,  -845,  -845,  -845,
+    -845,  -845,  -845,  -663,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,   405,  -845,  -845,  -845,  -845,  -845,   -40,
+    -787,  -845,  -845,  -845,  -845,  -845,  -845,   -38,   190,    11,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,   191,  -845,
+    -845,  -845,  -845,   506,  -845,  -845,   288,  -384,  -845,  -845,
+    -845,   -39,   834,  -250,  -126,  -699,  -522,  -140,  -287,  -465,
+    -845,  -845,  -213,  -845,   519,  -845
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -542
+static const yytype_int16 yytable[] =
+{
+     174,   539,    93,   402,   192,   293,   434,   174,   294,   474,
+     641,   775,   295,   642,   506,   296,   243,   366,   690,   684,
+     414,   735,   736,   828,   684,   300,   494,   324,   372,   265,
+     498,   270,   271,   367,   686,   203,   273,  -171,   504,   874,
+     226,   579,   766,   767,    96,   846,   323,   198,   882,   257,
+     258,   579,    93,   268,   325,   534,   764,   764,   764,   203,
+     277,   847,   848,   849,   579,  -171,   885,   221,   222,   917,
+     366,   579,   646,   432,   430,   297,   607,   298,   299,   575,
+    -430,   859,   664,   365,   899,   329,   367,   849,   373,   374,
+     375,   376,   377,   378,    96,   379,   380,   381,   382,   383,
+     384,   332,   385,   386,   387,   388,   389,   729,   671,   675,
+     477,   174,   493,   203,   579,   419,   324,   984,   579,   333,
+     335,   336,   419,   285,   579,   750,   715,   483,   203,   540,
+     343,   126,  1021,   579,  -426,   323,   365,   223,   203,   579,
+     831,   224,   301,   325,   357,   307,   251,   194,   479,  -429,
+     364,   410,   579,   579,   868,   914,   675,   948,   985,  -425,
+     948,   371,   847,   848,   849,  -171,   393,   194,   648,   741,
+     484,   485,   229,   971,   438,   751,  1042,   223,   575,   170,
+     406,   224,   195,   230,   288,   387,   388,   389,   302,   404,
+     411,   412,   753,   742,  -171,   342,   480,   344,  -106,   394,
+    1026,   580,   197,   364,   308,   128,   364,   417,   389,   850,
+     959,   584,   359,  1000,   425,   917,   468,   204,   433,   605,
+     860,   436,  -430,   606,   586,   324,   466,   486,   963,   475,
+     564,   601,   647,   850,   324,   367,   960,   980,   495,     4,
+     730,   680,   665,   500,   323,   496,   503,   390,   391,   563,
+     478,   836,   325,   323,   716,    93,   130,   565,   916,   916,
+     916,   325,   252,   859,   286,   709,   710,   471,   672,   676,
+     499,   413,   699,   713,   777,   475,  -426,   532,   778,   170,
+     859,   609,   251,   561,   792,   365,   204,   719,   253,   544,
+     545,  -429,   576,   793,   549,   722,   413,    96,   728,   794,
+     694,  -425,   540,   553,   554,   555,   556,   557,   558,   559,
+     850,   575,   795,   805,   869,   915,   938,   949,   986,   266,
+    1037,   800,   802,   425,   804,   289,   575,   324,   390,   391,
+     583,   919,   920,   921,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   323,   223,   131,   390,
+     391,   224,   371,   961,   325,   571,   311,   312,   572,   573,
+     574,   188,   616,   618,   619,   620,   621,   622,   623,   624,
+     625,   626,   627,   628,   629,   630,   631,   634,   636,   638,
+     640,    69,   939,   199,   192,   659,   372,   481,   684,   684,
+     684,   684,   684,   990,   581,   582,   697,   244,   252,   245,
+     191,   278,   860,   828,   610,   861,   482,   239,   764,   575,
+     407,   489,   490,   600,   663,   602,   603,   604,   202,   860,
+     415,   416,  1009,   400,   253,   612,   717,   837,   822,   279,
+     212,   923,   395,   679,   240,   241,   763,   408,   520,   264,
+     209,   235,   236,   769,   832,   701,   210,   756,   875,   989,
+     708,   965,   937,   711,  -156,   823,   839,   966,  -156,   208,
+     223,   475,   911,   866,   224,   564,   775,   685,   213,   255,
+     806,   256,   564,   219,   324,   324,   324,   324,   324,   259,
+     698,   260,   881,   916,   563,   707,   170,   309,   194,   274,
+     884,   563,   565,   323,   323,   323,   323,   323,   269,   565,
+     762,   325,   325,   325,   325,   325,   735,   736,   858,   800,
+     802,   804,   220,  -156,   475,   475,   227,  -156,   372,   371,
+     575,   575,   575,   575,   575,   733,   203,   735,   736,   280,
+     200,   201,   770,   771,   772,   773,   774,   746,    93,   979,
+      93,  -156,  1036,   231,   812,  -156,   232,   757,   684,   761,
+     376,   377,   378,   249,   379,   380,   381,   382,   383,   384,
+     419,   385,   386,   387,   388,   389,   733,   324,   776,   215,
+     216,   217,   419,   571,   311,   312,   572,   573,   574,  -541,
+    -541,  -541,  -541,  -541,  -541,   929,   323,   254,   139,   311,
+     312,   572,   573,   574,   325,   524,   525,   799,   801,   263,
+     803,   398,   668,   364,   807,   940,   941,   942,   943,   983,
+     876,   877,   878,   851,   572,   573,   574,   133,   134,   746,
+     898,   808,   809,   972,   973,   203,   810,   272,   811,   310,
+     327,   292,   815,   304,   305,   339,   340,   928,   394,   341,
+     345,   824,   894,   829,   895,   830,   346,   821,   347,   348,
+     349,   834,   806,   903,    93,   964,   350,   405,   351,   352,
+     353,   354,   355,   356,   843,   425,   468,   358,   469,   360,
+     361,   564,   841,   362,   370,   395,   988,   397,   398,   162,
+     856,   857,   399,   470,   170,   163,   164,   465,  1024,   476,
+     563,   867,   491,   259,   493,   266,   496,   501,   565,   502,
+     166,   167,   505,   168,   169,   274,   390,   391,   171,   871,
+     475,   373,   374,   375,   376,   377,   378,   521,   379,   380,
+     381,   382,   383,   384,   523,   385,   386,   387,   388,   389,
+     535,   560,   547,   569,   611,   577,   614,   651,   654,   674,
+     905,   656,   657,   609,   666,   667,   669,   673,   723,   549,
+     677,   678,  1027,   724,   688,   727,   608,   691,  -237,  -237,
+    -237,  -237,  -237,  -237,   692,  -237,  -237,  -237,  -237,  -237,
+    -237,   695,  -237,  -237,  -237,  -237,  -237,   714,   718,   759,
+     758,   760,   768,   574,   796,   799,   801,   803,   797,   798,
+     819,   813,   820,   845,   833,   840,   853,   976,   855,   478,
+     864,   872,   192,   925,   883,   886,   982,   887,   888,   891,
+     889,   372,   890,   896,   897,   909,   378,   564,   379,   380,
+     381,   382,   383,   384,   910,   385,   386,   387,   388,   389,
+     922,   927,   931,   932,   935,   936,   563,   944,  1003,   945,
+     950,   969,   958,   730,   565,   978,   987,   991,   999,   992,
+    1007,  1015,   993,   994,  1016,  1006,  1018,   707,  1017,   954,
+     850,   957,  1019,  1023,  1028,   302,  1043,  1032,  1038,  1039,
+     390,   391,   507,   965,   394,   475,  1041,  1047,  1020,  1048,
+     333,   234,   488,  1010,   693,  1008,   977,   379,   380,   381,
+     382,   383,   384,   905,   385,   386,   387,   388,   389,  -542,
+    -542,  -542,  -542,  -542,  -542,   842,   385,   386,   387,   388,
+     389,   844,    93,   995,   649,   997,   815,  -237,  -237,   689,
+     333,  1001,   712,  1002,   687,   235,   236,   508,   492,   720,
+     700,   533,   880,  1005,   238,   952,   998,   644,    93,  1012,
+     953,   835,   970,  1040,   371,  1025,   754,   912,  1004,  1013,
+    1014,   913,   838,   509,   670,   510,   511,   512,   330,     0,
+     513,   514,     0,   515,   516,     0,     0,     2,     3,     0,
+     390,   391,     0,     0,   905,     0,   905,     0,     0,     0,
+       0,     0,     0,     0,    93,  1029,     0,     0,  1031,     0,
+       0,     4,     5,     0,     0,     6,   -21,     7,   -21,     8,
+       0,     0,     9,     0,     0,     0,     0,     0,     0,     0,
+     733,     0,    10,     0,     0,     0,     0,     0,     0,  1044,
+       0,   733,     0,  1045,  1046,    93,     0,     0,    11,     0,
+       0,   733,    12,    13,    93,     0,     0,    14,  1050,   390,
+     391,     0,     0,    15,     0,    16,    17,     0,    18,     0,
+       0,   390,   391,    19,    20,    21,    22,    23,     0,    24,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,    36,     0,    37,     0,    38,    39,     0,
+       0,    40,    41,    42,     0,    43,     0,    44,     0,     0,
+      45,    46,     0,     0,    47,    48,    49,     0,     0,     0,
+       0,     0,     0,     0,    50,     0,     0,    51,    52,    53,
+      54,    55,    56,    57,    58,    59,    60,    61,    62,    63,
+       0,     0,    64,     0,     0,    65,    66,    67,    68,     0,
+       0,     0,   652,    69,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,   934,     0,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,  1034,     0,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,  1035,     0,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,  1049,     0,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   926,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   870,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,   135,   136,     0,     0,     0,     0,   137,   138,
+     139,   140,   141,   390,   391,     0,     0,     0,     0,     0,
+       0,     0,     0,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,   390,   391,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   390,   391,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   390,   391,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,     0,     0,   165,     0,     0,   613,   390,   391,     0,
+       0,     0,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   562,     0,     0,     0,     0,     0,   390,   391,   926,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   996,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,  1030,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   578,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   585,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,  -239,  -239,
+    -239,  -239,  -239,  -239,     0,  -239,  -239,  -239,  -239,  -239,
+    -239,     0,  -239,  -239,  -239,  -239,  -239,  -238,  -238,  -238,
+    -238,  -238,  -238,     0,  -238,  -238,  -238,  -238,  -238,  -238,
+       0,  -238,  -238,  -238,  -238,  -238,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   599,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,  -239,  -239,  -239,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,  -238,  -238,  -238,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   613,
+     390,   391,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   650,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,     0,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,   653,   390,   391,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,   399,   149,   150,   151,   390,   391,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,   779,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   780,
+     390,   391,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,   781,   390,
+     391,     0,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   918,   171,   562,     0,     0,     0,   782,   390,   391,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   783,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   784,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,   785,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   786,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   787,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   788,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   789,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   790,   390,   391,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,     0,     0,     0,     0,   791,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   852,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   930,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   933,   390,   391,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   946,   390,   391,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   702,     0,   947,   390,   391,
+       0,     0,   132,     0,     0,     0,     0,     0,     0,     0,
+     133,   134,   703,     0,     0,     0,  1022,   390,   391,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,  1033,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,   439,   160,     0,
+       0,     0,   440,   441,     0,   442,   443,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   444,   445,   446,
+     447,   448,   449,   450,     0,   451,   452,   453,     0,     0,
+     454,   455,   456,     0,   814,   457,   458,   459,   460,     0,
+     461,   132,     0,     0,   390,   391,   161,     0,     0,   133,
+     134,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   462,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   904,     0,     0,     0,     0,     0,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+       0,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   924,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   472,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,   473,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   632,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,   633,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   172,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     721,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,   473,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   171,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   615,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   172,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   637,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   170,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   639,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,     0,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,     0,     0,
+       0,     0,     0,     0,   166,   167,   132,   168,   169,     0,
+       0,   170,   171,   172,   133,   134,   660,   173,   661,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   135,   136,
+       0,     0,     0,     0,   137,   138,   139,   140,   141,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,   473,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   662,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,   548,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   526,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,   473,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,   726,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,   132,     0,     0,   165,     0,     0,     0,     0,
+     133,   134,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   135,   136,     9,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   132,     0,     0,     0,     0,   161,     0,     0,   133,
+     134,   703,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+    1011,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,     0,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   363,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,     0,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   431,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   529,   530,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   918,   171,   363,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   161,     0,
+       0,     0,     0,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,     0,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   955,   311,   312,   422,     0,
+     423,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,   311,   312,   313,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   424,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,   311,   312,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,   135,   136,     0,     0,
+       0,     0,   137,   138,   139,   140,   141,     0,     0,   314,
+     315,   316,   317,   318,     0,   319,   320,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,     0,     0,     0,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   322,
+       0,     0,     0,     0,     0,     0,     5,     0,     0,     6,
+       0,     7,     0,     8,     0,   162,     9,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,    10,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,    11,   321,   171,   424,    12,    13,     0,     0,
+       0,    14,     0,     0,     0,     0,     0,    15,     0,    16,
+      17,     0,    18,     0,     0,     0,     0,    19,    20,    21,
+      22,    23,     0,    24,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,    36,     0,    37,
+       0,    38,    39,     0,     0,    40,    41,    42,     0,    43,
+       0,    44,     0,     0,    45,    46,     0,     0,    47,    48,
+      49,     0,     0,     0,     0,     0,     0,     0,    50,     0,
+       0,     0,    52,    53,    54,    55,    56,    57,    58,    59,
+      60,    61,    62,    63,     0,     0,    64,     0,     0,    65,
+      66,    67,    68,     5,     0,     0,     6,   487,     7,     0,
+       8,     0,     0,     9,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    10,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    11,
+       0,     0,     0,    12,    13,     0,     0,     0,    14,     0,
+       0,     0,     0,     0,    15,     0,    16,    17,     0,    18,
+       0,     0,     0,     0,    19,    20,    21,    22,    23,     0,
+      24,    25,     0,     0,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,     0,    37,     0,    38,    39,
+       0,     0,    40,    41,    42,     0,    43,     0,    44,     0,
+       0,    45,    46,     0,     0,    47,    48,    49,     0,     0,
+       0,     0,     0,     0,     0,    50,     0,     0,     0,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    61,    62,
+      63,     8,     0,    64,     9,     0,    65,    66,    67,    68,
+       0,     0,     0,     0,    10,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+      11,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,    15,     0,     0,     0,     0,
+      18,     0,   746,     0,     0,    19,    20,    21,    22,    23,
+       0,     0,    25,     0,     0,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,     0,     0,     8,     0,     0,
+       9,     0,     0,     0,    41,     0,     0,     0,     0,    44,
+      10,     0,     0,     0,     0,     0,    47,     0,    49,     0,
+       0,     0,     0,     0,     0,     0,    11,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,    59,    60,    61,
+      62,    15,     0,     0,     0,     0,    18,     0,     0,    67,
+      68,    19,    20,    21,    22,    23,     0,     0,    25,     0,
+       0,    26,    27,    28,    29,    30,    31,    32,    33,    34,
+      35,     0,     0,     0,     0,     0,   825,     0,     0,     0,
+      41,     0,     0,     0,     0,    44,     0,     0,     0,     0,
+       0,     0,    47,     0,    49,     0,     0,     0,     0,     0,
+       0,     0,    11,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    59,    60,    61,    62,    15,     0,     0,
+       0,     0,    18,   826,     0,    67,    68,    19,    20,   827,
+       0,    23,     0,     0,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,     0,     0,     0,
+       0,     0,   825,     0,     0,     0,    41,     0,     0,     0,
+       0,    44,     0,     0,     0,     0,     0,     0,    47,     0,
+      49,     0,     0,     0,     0,     0,     0,     0,    11,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    59,
+      60,    61,    62,    15,     0,     0,     0,     0,    18,     0,
+       0,   170,    68,    19,    20,   827,     0,    23,     0,     0,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,    41,     0,     0,     0,     0,    44,     0,     0,
+       0,     0,     0,     0,    47,     0,    49,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,    59,    60,    61,    62,     0,
+       0,     0,     0,     0,     0,     0,     0,   170,    68
+};
+
+#define yypact_value_is_default(Yystate) \
+  (!!((Yystate) == (-845)))
+
+#define yytable_value_is_error(Yytable_value) \
+  (!!((Yytable_value) == (-542)))
+
+static const yytype_int16 yycheck[] =
+{
+      11,   295,     1,   185,    15,   101,   219,    18,   104,   240,
+     394,   577,   108,   395,   277,   111,    54,   161,   482,   477,
+     205,   536,   536,   653,   482,     5,   264,   124,   172,    79,
+     268,    81,    82,   161,     3,     3,    86,     3,   274,   710,
+      39,     3,   564,   565,     1,     3,   124,    17,   719,    75,
+      76,     3,    51,    80,   124,   291,   563,   564,   565,     3,
+      87,    19,    20,    21,     3,    31,   722,    37,    38,   768,
+     214,     3,     3,   217,   214,   113,   363,   115,   116,   329,
+      24,    21,     3,   161,   747,   124,   214,    21,     5,     6,
+       7,     8,     9,    10,    51,    12,    13,    14,    15,    16,
+      17,   127,    19,    20,    21,    22,    23,    27,     3,     3,
+      22,   122,     3,     3,     3,   212,   213,   904,     3,   130,
+     131,   132,   219,    21,     3,   112,     3,    45,     3,    44,
+     141,   153,   976,     3,    24,   213,   214,    18,     3,     3,
+     121,    22,   122,   213,   155,   101,    24,   131,   245,    24,
+     161,   198,     3,     3,     3,     3,     3,     3,     3,    24,
+       3,   172,    19,    20,    21,   131,   177,   131,   404,    91,
+      88,    89,   119,   891,   221,   162,  1020,    18,   428,   160,
+     191,    22,   166,   130,    21,    21,    22,    23,   168,   188,
+     201,   202,   107,   115,   160,   140,   246,   142,   166,   168,
+     987,   163,   166,   214,   160,   160,   217,   206,    23,   167,
+     881,   163,   157,   931,   213,   914,   227,   161,   217,   363,
+     160,   220,   166,   363,   163,   322,   225,   253,   884,   240,
+     327,   163,   163,   167,   331,   363,     5,   900,   265,    24,
+     160,   472,   163,   270,   322,   162,   273,   164,   165,   327,
+     162,   168,   322,   331,   131,   254,   162,   327,   765,   766,
+     767,   331,   140,    21,   162,   501,   502,   237,   163,   163,
+     269,   161,   163,   509,   163,   286,   166,   288,   163,   160,
+      21,     3,    24,   322,   163,   363,   161,   523,   166,   300,
+     301,   166,   331,   163,   305,   526,   161,   254,   534,   163,
+     485,   166,    44,   314,   315,   316,   317,   318,   319,   320,
+     167,   561,   163,   163,   163,   163,   163,   163,   163,   160,
+     163,   608,   609,   322,   611,   162,   576,   424,   164,   165,
+     341,   796,   797,   798,   345,   346,   347,   348,   349,   350,
+     351,   352,   353,   354,   355,   356,   424,    18,   162,   164,
+     165,    22,   363,   122,   424,    18,    19,    20,    21,    22,
+      23,   162,   373,   374,   375,   376,   377,   378,   379,   380,
+     381,   382,   383,   384,   385,   386,   387,   388,   389,   390,
+     391,   166,   846,    18,   395,   424,   530,     3,   846,   847,
+     848,   849,   850,   915,   339,   340,   490,   160,   140,   162,
+     162,     3,   160,  1033,   126,   163,    22,   133,   915,   659,
+     133,   255,   256,   358,   425,   360,   361,   362,   162,   160,
+      94,    95,   163,   153,   166,   370,   520,   663,   133,    31,
+     162,   813,   162,   471,   160,   161,   562,   160,   282,     3,
+     160,    78,    79,   569,   657,   495,   166,   543,   711,   914,
+     500,   160,   836,   503,    18,   160,   669,   166,    22,   160,
+      18,   472,   756,   701,    22,   562,  1032,   478,   162,    29,
+     614,    31,   569,   162,   571,   572,   573,   574,   575,   160,
+     491,   162,   718,   990,   562,   496,   160,   122,   131,   160,
+     721,   569,   562,   571,   572,   573,   574,   575,     3,   569,
+     163,   571,   572,   573,   574,   575,  1021,  1021,   693,   796,
+     797,   798,   162,    18,   525,   526,   162,    22,   662,   530,
+     770,   771,   772,   773,   774,   536,     3,  1042,  1042,   131,
+     161,   162,   571,   572,   573,   574,   575,    83,   537,    85,
+     539,    18,  1006,   123,   641,    22,   160,   546,  1006,   560,
+       8,     9,    10,     4,    12,    13,    14,    15,    16,    17,
+     657,    19,    20,    21,    22,    23,   577,   664,   579,   160,
+     161,   162,   669,    18,    19,    20,    21,    22,    23,    18,
+      19,    20,    21,    22,    23,   821,   664,    24,    41,    19,
+      20,    21,    22,    23,   664,   161,   162,   608,   609,   166,
+     611,   162,   163,   614,   615,   847,   848,   849,   850,   903,
+     134,   135,   136,   683,    21,    22,    23,    19,    20,    83,
+      84,   632,   633,    37,    38,     3,   637,     3,   639,   123,
+     124,   160,   643,     3,   162,   162,   162,   819,   168,   162,
+     162,   652,   738,   654,   740,   656,   162,   646,   162,   162,
+     162,   662,   796,   749,   653,   886,   162,     3,   162,   162,
+     162,   162,   162,   162,   675,   664,   677,   162,     3,   162,
+     162,   768,   671,   162,   162,   162,   912,   162,   162,   132,
+     691,   692,   160,     3,   160,   138,   139,   160,   982,   163,
+     768,   702,     5,   160,     3,   160,   162,   160,   768,   160,
+     153,   154,     3,   156,   157,   160,   164,   165,   161,   708,
+     721,     5,     6,     7,     8,     9,    10,     3,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+       3,     5,   161,     3,     3,   163,     3,     3,   162,    22,
+     751,     5,     3,     3,   163,   163,     3,     3,   163,   760,
+     162,   160,   988,     3,   160,   163,     3,   162,     5,     6,
+       7,     8,     9,    10,   162,    12,    13,    14,    15,    16,
+      17,   162,    19,    20,    21,    22,    23,   162,   160,   163,
+     161,     3,     3,    23,     3,   796,   797,   798,     3,     3,
+     163,     4,   163,    22,   163,   163,   160,   893,    22,   162,
+      26,    21,   813,   814,   163,   160,   902,   163,     4,    36,
+     122,   955,     3,   160,   162,   160,    10,   914,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+     163,     3,   162,   162,     5,   163,   914,     5,   935,   163,
+     162,   160,   163,   160,   914,   160,     4,   163,     3,   163,
+      82,   122,   163,   163,     3,    22,   160,   868,   163,   870,
+     167,   872,   160,   160,   163,   168,    82,   163,   163,   160,
+     164,   165,    25,   160,   168,   886,   160,    22,   974,   160,
+     891,    51,   254,   950,   485,   948,   897,    12,    13,    14,
+      15,    16,    17,   904,    19,    20,    21,    22,    23,    12,
+      13,    14,    15,    16,    17,   673,    19,    20,    21,    22,
+      23,   677,   911,   924,   405,   926,   927,   164,   165,   481,
+     931,   932,   505,   934,   480,    78,    79,    80,   260,   525,
+     493,   289,   715,   944,    52,   868,   927,   397,   937,   959,
+     870,   662,   890,  1016,   955,   985,   541,   757,   937,   960,
+     961,   760,   664,   106,   435,   108,   109,   110,   124,    -1,
+     113,   114,    -1,   116,   117,    -1,    -1,     0,     1,    -1,
+     164,   165,    -1,    -1,   985,    -1,   987,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   983,   996,    -1,    -1,   999,    -1,
+      -1,    24,    25,    -1,    -1,    28,    29,    30,    31,    32,
+      -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+    1021,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,  1030,
+      -1,  1032,    -1,  1034,  1035,  1024,    -1,    -1,    61,    -1,
+      -1,  1042,    65,    66,  1033,    -1,    -1,    70,  1049,   164,
+     165,    -1,    -1,    76,    -1,    78,    79,    -1,    81,    -1,
+      -1,   164,   165,    86,    87,    88,    89,    90,    -1,    92,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,   106,    -1,   108,    -1,   110,   111,    -1,
+      -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,    -1,
+     123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   137,    -1,    -1,   140,   141,   142,
+     143,   144,   145,   146,   147,   148,   149,   150,   151,   152,
+      -1,    -1,   155,    -1,    -1,   158,   159,   160,   161,    -1,
+      -1,    -1,     3,   166,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,     3,    -1,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     3,    -1,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     3,    -1,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     3,    -1,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    33,    34,    -1,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   164,   165,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,   164,   165,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,   164,   165,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    -1,    -1,   144,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    -1,    -1,    -1,    -1,    -1,   164,   165,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
+     164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,    -1,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,   160,    62,    63,    64,   164,   165,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
+     164,   165,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    -1,    -1,    -1,   163,   164,   165,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   163,   164,   165,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   163,   164,   165,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,     4,    -1,   163,   164,   165,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      19,    20,    21,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    34,    77,    -1,
+      -1,    -1,    39,    40,    -1,    42,    43,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,     4,    72,    73,    74,    75,    -1,
+      77,    11,    -1,    -1,   164,   165,   125,    -1,    -1,    19,
+      20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    21,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    22,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+       5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   153,   154,    11,   156,   157,    -1,
+      -1,   160,   161,   162,    19,    20,    21,   166,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    33,    34,
+      -1,    -1,    -1,    -1,    39,    40,    41,    42,    43,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    11,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      19,    20,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    33,    34,    35,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,
+      20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    -1,    -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    -1,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    19,    20,    21,    -1,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    19,    20,    21,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    19,    20,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    33,    34,    -1,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      -1,    -1,    -1,    -1,    -1,    -1,    25,    -1,    -1,    28,
+      -1,    30,    -1,    32,    -1,   132,    35,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    45,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    61,   160,   161,   162,    65,    66,    -1,    -1,
+      -1,    70,    -1,    -1,    -1,    -1,    -1,    76,    -1,    78,
+      79,    -1,    81,    -1,    -1,    -1,    -1,    86,    87,    88,
+      89,    90,    -1,    92,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,   106,    -1,   108,
+      -1,   110,   111,    -1,    -1,   114,   115,   116,    -1,   118,
+      -1,   120,    -1,    -1,   123,   124,    -1,    -1,   127,   128,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   137,    -1,
+      -1,    -1,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,    -1,    -1,   155,    -1,    -1,   158,
+     159,   160,   161,    25,    -1,    -1,    28,   166,    30,    -1,
+      32,    -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,
+      -1,    -1,    -1,    65,    66,    -1,    -1,    -1,    70,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    78,    79,    -1,    81,
+      -1,    -1,    -1,    -1,    86,    87,    88,    89,    90,    -1,
+      92,    93,    -1,    -1,    96,    97,    98,    99,   100,   101,
+     102,   103,   104,   105,   106,    -1,   108,    -1,   110,   111,
+      -1,    -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,
+      -1,   123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   137,    -1,    -1,    -1,   141,
+     142,   143,   144,   145,   146,   147,   148,   149,   150,   151,
+     152,    32,    -1,   155,    35,    -1,   158,   159,   160,   161,
+      -1,    -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,
+      81,    -1,    83,    -1,    -1,    86,    87,    88,    89,    90,
+      -1,    -1,    93,    -1,    -1,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,    -1,    -1,    32,    -1,    -1,
+      35,    -1,    -1,    -1,   115,    -1,    -1,    -1,    -1,   120,
+      45,    -1,    -1,    -1,    -1,    -1,   127,    -1,   129,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,   149,   150,
+     151,    76,    -1,    -1,    -1,    -1,    81,    -1,    -1,   160,
+     161,    86,    87,    88,    89,    90,    -1,    -1,    93,    -1,
+      -1,    96,    97,    98,    99,   100,   101,   102,   103,   104,
+     105,    -1,    -1,    -1,    -1,    -1,    35,    -1,    -1,    -1,
+     115,    -1,    -1,    -1,    -1,   120,    -1,    -1,    -1,    -1,
+      -1,    -1,   127,    -1,   129,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   148,   149,   150,   151,    76,    -1,    -1,
+      -1,    -1,    81,    82,    -1,   160,   161,    86,    87,    88,
+      -1,    90,    -1,    -1,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
+      -1,    -1,    35,    -1,    -1,    -1,   115,    -1,    -1,    -1,
+      -1,   120,    -1,    -1,    -1,    -1,    -1,    -1,   127,    -1,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,
+     149,   150,   151,    76,    -1,    -1,    -1,    -1,    81,    -1,
+      -1,   160,   161,    86,    87,    88,    -1,    90,    -1,    -1,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   115,    -1,    -1,    -1,    -1,   120,    -1,    -1,
+      -1,    -1,    -1,    -1,   127,    -1,   129,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   148,   149,   150,   151,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   160,   161
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint16 yystos[] =
+{
+       0,   170,     0,     1,    24,    25,    28,    30,    32,    35,
+      45,    61,    65,    66,    70,    76,    78,    79,    81,    86,
+      87,    88,    89,    90,    92,    93,    96,    97,    98,    99,
+     100,   101,   102,   103,   104,   105,   106,   108,   110,   111,
+     114,   115,   116,   118,   120,   123,   124,   127,   128,   129,
+     137,   140,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,   155,   158,   159,   160,   161,   166,
+     171,   172,   173,   174,   176,   178,   186,   198,   199,   203,
+     204,   209,   210,   211,   212,   213,   215,   216,   223,   225,
+     228,   231,   232,   267,   276,   277,   282,   283,   284,   286,
+     287,   291,   300,   301,   302,   303,   304,   310,   315,   319,
+     320,   323,   331,   332,   333,   334,   335,   338,   339,   341,
+     344,   345,   348,   357,   359,   369,   153,   181,   160,   180,
+     162,   162,    11,    19,    20,    33,    34,    39,    40,    41,
+      42,    43,    54,    55,    56,    57,    58,    59,    60,    62,
+      63,    64,    67,    68,    69,    71,    72,    73,    74,    75,
+      77,   125,   132,   138,   139,   144,   153,   154,   156,   157,
+     160,   161,   162,   166,   249,   250,   252,   253,   257,   259,
+     260,   261,   262,   267,   268,   269,   273,   275,   162,   191,
+     192,   162,   249,   272,   131,   166,   195,   166,   195,   273,
+     161,   162,   162,     3,   161,   179,   220,   305,   160,   160,
+     166,   336,   162,   162,   352,   160,   161,   162,   353,   162,
+     162,   195,   195,    18,    22,   219,   267,   162,   190,   119,
+     130,   123,   160,   224,   173,    78,    79,   187,   244,   133,
+     160,   161,   237,   336,   160,   162,   200,   201,   206,     4,
+     175,    24,   140,   166,    24,    29,    31,   175,   175,   160,
+     162,   221,   222,   166,     3,   220,   160,   205,   219,     3,
+     220,   220,     3,   220,   160,   217,   218,   219,     3,    31,
+     131,   196,   197,   226,   240,    21,   162,   229,    21,   162,
+     235,   337,   160,   172,   172,   172,   172,   336,   336,   336,
+       5,   122,   168,   340,     3,   162,   342,   101,   160,   273,
+     352,    19,    20,    21,    46,    47,    48,    49,    50,    52,
+      53,   160,   162,   250,   257,   268,   350,   352,   358,   360,
+     361,   362,   175,   249,   294,   249,   249,   249,   251,   162,
+     162,   162,   251,   249,   251,   162,   162,   162,   162,   162,
+     162,   162,   162,   162,   162,   162,   162,   249,   162,   251,
+     162,   162,   162,   162,   249,   250,   252,   275,   366,   367,
+     162,   249,   252,     5,     6,     7,     8,     9,    10,    12,
+      13,    14,    15,    16,    17,    19,    20,    21,    22,    23,
+     164,   165,   254,   249,   168,   162,   271,   162,   162,   160,
+     153,   270,   271,   193,   267,     3,   249,   133,   160,   214,
+     214,   249,   249,   161,   305,    94,    95,   267,   306,   257,
+     370,   371,    21,    23,   162,   267,   354,   355,   360,   361,
+     366,   161,   252,   267,   371,   372,   267,   374,   214,    34,
+      39,    40,    42,    43,    54,    55,    56,    57,    58,    59,
+      60,    62,    63,    64,    67,    68,    69,    72,    73,    74,
+      75,    77,   160,   188,   189,   160,   267,   194,   249,     3,
+       3,   195,     5,    21,   238,   249,   163,    22,   162,   257,
+     220,     3,    22,    45,    88,    89,   175,   166,   174,   180,
+     180,     5,   221,     3,   205,   219,   162,   245,   205,   267,
+     219,   160,   160,   219,   245,     3,   217,    25,    80,   106,
+     108,   109,   110,   113,   114,   116,   117,   241,   242,   244,
+     180,     3,   227,   160,   161,   162,   160,   230,   238,   161,
+     162,   236,   249,   237,   245,     3,   288,   299,   307,   299,
+      44,   321,   322,   324,   249,   249,   356,   161,    21,   249,
+     343,   346,   347,   249,   249,   249,   249,   249,   249,   249,
+       5,   360,   162,   250,   257,   268,   349,   363,   364,     3,
+     351,    18,    21,    22,    23,   362,   360,   163,   163,     3,
+     163,   251,   251,   249,   163,   163,   163,   249,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   163,
+     251,   163,   251,   251,   251,   252,   366,   367,     3,     3,
+     126,     3,   251,   163,     3,     5,   249,   256,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   249,
+     249,   249,     5,    22,   249,   255,   249,     5,   249,     5,
+     249,   356,   272,   258,   263,   263,     3,   163,   245,   192,
+     163,     3,     3,   163,   162,   298,     5,     3,   373,   360,
+      21,    23,   162,   249,     3,   163,   163,   163,   163,     3,
+     373,     3,   163,     3,    22,     3,   163,   162,   160,   336,
+     238,   202,   207,   208,   253,   249,     3,   201,   160,   206,
+     202,   162,   162,   179,   305,   162,   182,   182,   249,   163,
+     222,   220,     4,    21,   246,   247,   248,   249,   220,   245,
+     245,   220,   218,   245,   162,     3,   131,   182,   160,   245,
+     230,     5,   238,   163,     3,   239,    21,   163,   245,    27,
+     160,   278,   279,   249,   285,   286,   287,   289,   292,   293,
+     282,    91,   115,   308,   309,   330,    83,   311,   312,   316,
+     112,   162,   326,   107,   322,   325,   172,   267,   161,   163,
+       3,   249,   163,   363,   254,   365,   365,   365,     3,   363,
+     360,   360,   360,   360,   360,   293,   249,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,   163,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,     3,     3,     3,   249,
+     367,   249,   367,   249,   367,   163,   252,   249,   249,   249,
+     249,   249,   257,     4,     4,   249,   264,   265,   266,   163,
+     163,   267,   133,   160,   249,    35,    82,    88,   284,   249,
+     249,   121,   371,   163,   249,   266,   168,   245,   355,   371,
+     163,   267,   188,   249,   194,    22,     3,    19,    20,    21,
+     167,   268,   163,   160,   368,    22,   249,   249,   305,    21,
+     160,   163,   184,   185,    26,   177,   205,   249,     3,   163,
+       4,   267,    21,   233,   233,   217,   134,   135,   136,   243,
+     242,   245,   233,   163,   238,   239,   160,   163,     4,   122,
+       3,    36,   290,   295,   172,   172,   160,   162,    84,   312,
+     313,   314,   317,   172,     4,   249,   327,   328,   329,   160,
+     160,   299,   337,   347,     3,   163,   254,   364,   160,   368,
+     368,   368,   163,   272,     4,   249,     4,     3,   271,   245,
+     163,   162,   162,   163,     3,     5,   163,   356,   163,   202,
+     207,   207,   207,   207,     5,   163,   163,   163,     3,   163,
+     162,   183,   247,   248,   249,   162,   234,   249,   163,   233,
+       5,   122,   274,   239,   238,   160,   166,   280,   281,   160,
+     279,   294,    37,    38,   296,   297,   172,   249,   160,    85,
+     312,   318,   172,   299,   329,     3,   163,     4,   245,   368,
+     365,   163,   163,   163,   163,   249,     4,   249,   265,     3,
+     294,   249,   249,   257,   338,   249,    22,    82,   185,   163,
+     184,    21,   274,   249,   249,   122,     3,   163,   160,   160,
+     172,   288,   163,   160,   299,   328,   329,   245,   163,   249,
+       4,   249,   163,   163,     3,     3,   202,   163,   163,   160,
+     281,   160,   288,    82,   249,   249,   249,    22,   160,     3,
+     249
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  However,
+   YYFAIL appears to be in use.  Nevertheless, it is formally deprecated
+   in Bison 2.4.2's NEWS entry, where a plan to phase it out is
+   discussed.  */
+
+#define YYFAIL		goto yyerrlab
+#if defined YYFAIL
+  /* This is here to suppress warnings from the GCC cpp's
+     -Wunused-macros.  Normally we don't worry about that warning, but
+     some users do, and we want to make it easy for users to remove
+     YYFAIL uses, which will produce warnings from Bison 2.5.  */
+#endif
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)                                  \
+do                                                              \
+  if (yychar == YYEMPTY)                                        \
+    {                                                           \
+      yychar = (Token);                                         \
+      yylval = (Value);                                         \
+      YYPOPSTACK (yylen);                                       \
+      yystate = *yyssp;                                         \
+      goto yybackup;                                            \
+    }                                                           \
+  else                                                          \
+    {                                                           \
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+/* Error token number */
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* This macro is provided for backward compatibility. */
+#ifndef YY_LOCATION_PRINT
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  FILE *yyo = yyoutput;
+  YYUSE (yyo);
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+        break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
+#else
+static void
+yy_stack_print (yybottom, yytop)
+    yytype_int16 *yybottom;
+    yytype_int16 *yytop;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; yybottom <= yytop; yybottom++)
+    {
+      int yybot = *yybottom;
+      YYFPRINTF (stderr, " %d", yybot);
+    }
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      YYFPRINTF (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
+   about the unexpected token YYTOKEN for the state stack whose top is
+   YYSSP.
+
+   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
+   not large enough to hold the message.  In that case, also set
+   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
+   required number of bytes is too large to store.  */
+static int
+yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
+                yytype_int16 *yyssp, int yytoken)
+{
+  YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]);
+  YYSIZE_T yysize = yysize0;
+  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+  /* Internationalized format string. */
+  const char *yyformat = YY_NULL;
+  /* Arguments of yyformat. */
+  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+  /* Number of reported tokens (one for the "unexpected", one per
+     "expected"). */
+  int yycount = 0;
+
+  /* There are many possibilities here to consider:
+     - Assume YYFAIL is not used.  It's too flawed to consider.  See
+       <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html>
+       for details.  YYERROR is fine as it does not invoke this
+       function.
+     - If this state is a consistent state with a default action, then
+       the only way this function was invoked is if the default action
+       is an error action.  In that case, don't check for expected
+       tokens because there are none.
+     - The only way there can be no lookahead present (in yychar) is if
+       this state is a consistent state with a default action.  Thus,
+       detecting the absence of a lookahead is sufficient to determine
+       that there is no unexpected or expected token to report.  In that
+       case, just report a simple "syntax error".
+     - Don't assume there isn't a lookahead just because this state is a
+       consistent state with a default action.  There might have been a
+       previous inconsistent state, consistent state with a non-default
+       action, or user semantic action that manipulated yychar.
+     - Of course, the expected token list depends on states to have
+       correct lookahead information, and it depends on the parser not
+       to perform extra reductions after fetching a lookahead from the
+       scanner and before detecting a syntax error.  Thus, state merging
+       (from LALR or IELR) and default reductions corrupt the expected
+       token list.  However, the list is correct for canonical LR with
+       one exception: it will still contain any token that will not be
+       accepted due to an error action in a later state.
+  */
+  if (yytoken != YYEMPTY)
+    {
+      int yyn = yypact[*yyssp];
+      yyarg[yycount++] = yytname[yytoken];
+      if (!yypact_value_is_default (yyn))
+        {
+          /* Start YYX at -YYN if negative to avoid negative indexes in
+             YYCHECK.  In other words, skip the first -YYN actions for
+             this state because they are default actions.  */
+          int yyxbegin = yyn < 0 ? -yyn : 0;
+          /* Stay within bounds of both yycheck and yytname.  */
+          int yychecklim = YYLAST - yyn + 1;
+          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+          int yyx;
+
+          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
+                && !yytable_value_is_error (yytable[yyx + yyn]))
+              {
+                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+                  {
+                    yycount = 1;
+                    yysize = yysize0;
+                    break;
+                  }
+                yyarg[yycount++] = yytname[yyx];
+                {
+                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]);
+                  if (! (yysize <= yysize1
+                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+                    return 2;
+                  yysize = yysize1;
+                }
+              }
+        }
+    }
+
+  switch (yycount)
+    {
+# define YYCASE_(N, S)                      \
+      case N:                               \
+        yyformat = S;                       \
+      break
+      YYCASE_(0, YY_("syntax error"));
+      YYCASE_(1, YY_("syntax error, unexpected %s"));
+      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
+      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
+      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
+      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
+# undef YYCASE_
+    }
+
+  {
+    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
+    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+      return 2;
+    yysize = yysize1;
+  }
+
+  if (*yymsg_alloc < yysize)
+    {
+      *yymsg_alloc = 2 * yysize;
+      if (! (yysize <= *yymsg_alloc
+             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
+        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
+      return 1;
+    }
+
+  /* Avoid sprintf, as that infringes on the user's name space.
+     Don't have undefined behavior even if the translation
+     produced a string with the wrong number of "%s"s.  */
+  {
+    char *yyp = *yymsg;
+    int yyi = 0;
+    while ((*yyp = *yyformat) != '\0')
+      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
+        {
+          yyp += yytnamerr (yyp, yyarg[yyi++]);
+          yyformat += 2;
+        }
+      else
+        {
+          yyp++;
+          yyformat++;
+        }
+  }
+  return 0;
+}
+#endif /* YYERROR_VERBOSE */
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+        break;
+    }
+}
+
+
+
+
+/* The lookahead symbol.  */
+int yychar;
+
+
+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END
+#endif
+#ifndef YY_INITIAL_VALUE
+# define YY_INITIAL_VALUE(Value) /* Nothing. */
+#endif
+
+/* The semantic value of the lookahead symbol.  */
+YYSTYPE yylval YY_INITIAL_VALUE(yyval_default);
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+    int yystate;
+    /* Number of tokens to shift before error messages enabled.  */
+    int yyerrstatus;
+
+    /* The stacks and their tools:
+       `yyss': related to states.
+       `yyvs': related to semantic values.
+
+       Refer to the stacks through separate pointers, to allow yyoverflow
+       to reallocate them elsewhere.  */
+
+    /* The state stack.  */
+    yytype_int16 yyssa[YYINITDEPTH];
+    yytype_int16 *yyss;
+    yytype_int16 *yyssp;
+
+    /* The semantic value stack.  */
+    YYSTYPE yyvsa[YYINITDEPTH];
+    YYSTYPE *yyvs;
+    YYSTYPE *yyvsp;
+
+    YYSIZE_T yystacksize;
+
+  int yyn;
+  int yyresult;
+  /* Lookahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  yyssp = yyss = yyssa;
+  yyvsp = yyvs = yyvsa;
+  yystacksize = YYINITDEPTH;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY; /* Cause a token to be read.  */
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss_alloc, yyss);
+	YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  if (yystate == YYFINAL)
+    YYACCEPT;
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     lookahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to lookahead token.  */
+  yyn = yypact[yystate];
+  if (yypact_value_is_default (yyn))
+    goto yydefault;
+
+  /* Not known => get a lookahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yytable_value_is_error (yyn))
+        goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the lookahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token.  */
+  yychar = YYEMPTY;
+
+  yystate = yyn;
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+  *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 7:
+/* Line 1807 of yacc.c  */
+#line 319 "fortran.y"
+    {yyerrok;yyclearin;}
+    break;
+
+  case 18:
+/* Line 1807 of yacc.c  */
+#line 337 "fortran.y"
+    {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+    break;
+
+  case 20:
+/* Line 1807 of yacc.c  */
+#line 347 "fortran.y"
+    { pos_cur = setposcur(); }
+    break;
+
+  case 21:
+/* Line 1807 of yacc.c  */
+#line 350 "fortran.y"
+    { isrecursive = 0; }
+    break;
+
+  case 22:
+/* Line 1807 of yacc.c  */
+#line 351 "fortran.y"
+    { isrecursive = 1; }
+    break;
+
+  case 23:
+/* Line 1807 of yacc.c  */
+#line 354 "fortran.y"
+    { is_result_present = 0; }
+    break;
+
+  case 24:
+/* Line 1807 of yacc.c  */
+#line 355 "fortran.y"
+    { is_result_present = 1; }
+    break;
+
+  case 25:
+/* Line 1807 of yacc.c  */
+#line 359 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+            else
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 26:
+/* Line 1807 of yacc.c  */
+#line 367 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 27:
+/* Line 1807 of yacc.c  */
+#line 376 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (5)].l));
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1((yyvsp[(3) - (5)].na));
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 28:
+/* Line 1807 of yacc.c  */
+#line 393 "fortran.y"
+    {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,(yyvsp[(2) - (2)].na));
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1((yyvsp[(2) - (2)].na));
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
+    break;
+
+  case 31:
+/* Line 1807 of yacc.c  */
+#line 415 "fortran.y"
+    { strcpy((yyval.na), (yyvsp[(1) - (1)].na)); strcpy(subroutinename, (yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 32:
+/* Line 1807 of yacc.c  */
+#line 417 "fortran.y"
+    { Add_Include_1((yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 33:
+/* Line 1807 of yacc.c  */
+#line 419 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 34:
+/* Line 1807 of yacc.c  */
+#line 420 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 35:
+/* Line 1807 of yacc.c  */
+#line 421 "fortran.y"
+    { if ( firstpass ) (yyval.l)=(yyvsp[(2) - (3)].l); }
+    break;
+
+  case 38:
+/* Line 1807 of yacc.c  */
+#line 425 "fortran.y"
+    { if ( firstpass ) Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l)); }
+    break;
+
+  case 39:
+/* Line 1807 of yacc.c  */
+#line 428 "fortran.y"
+    {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(1) - (1)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                (yyval.l) = settype("",curlistvar);
+            }
+        }
+    break;
+
+  case 40:
+/* Line 1807 of yacc.c  */
+#line 440 "fortran.y"
+    {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(3) - (3)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                (yyval.l) = insertvar((yyvsp[(1) - (3)].l),curvar);
+            }
+        }
+    break;
+
+  case 41:
+/* Line 1807 of yacc.c  */
+#line 451 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 42:
+/* Line 1807 of yacc.c  */
+#line 452 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 44:
+/* Line 1807 of yacc.c  */
+#line 455 "fortran.y"
+    { inside_type_declare = 1; }
+    break;
+
+  case 45:
+/* Line 1807 of yacc.c  */
+#line 456 "fortran.y"
+    { inside_type_declare = 0; }
+    break;
+
+  case 47:
+/* Line 1807 of yacc.c  */
+#line 459 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 48:
+/* Line 1807 of yacc.c  */
+#line 476 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 50:
+/* Line 1807 of yacc.c  */
+#line 494 "fortran.y"
+    {
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+    break;
+
+  case 52:
+/* Line 1807 of yacc.c  */
+#line 500 "fortran.y"
+    {
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (1)].l));
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+    break;
+
+  case 53:
+/* Line 1807 of yacc.c  */
+#line 537 "fortran.y"
+    {
+            if (firstpass == 0)
+            {
+                if ((yyvsp[(1) - (1)].lnn))
+                {
+                    removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic((yyvsp[(1) - (1)].lnn));
+                }
+            }
+        }
+    break;
+
+  case 62:
+/* Line 1807 of yacc.c  */
+#line 558 "fortran.y"
+    {
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+    break;
+
+  case 64:
+/* Line 1807 of yacc.c  */
+#line 572 "fortran.y"
+    {
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+    break;
+
+  case 102:
+/* Line 1807 of yacc.c  */
+#line 630 "fortran.y"
+    {
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                (yyval.l) = (yyvsp[(1) - (2)].l);
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (2)].l));
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
+                        Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
+                    }
+                    else
+                        Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
+                        else                Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
+                    }
+                }
+            }
+            else
+            {
+                (yyval.l) = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+    break;
+
+  case 103:
+/* Line 1807 of yacc.c  */
+#line 696 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                Add_FunctionType_Var_1((yyvsp[(2) - (3)].na));
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+    break;
+
+  case 104:
+/* Line 1807 of yacc.c  */
+#line 710 "fortran.y"
+    { functiondeclarationisdone = 1; }
+    break;
+
+  case 105:
+/* Line 1807 of yacc.c  */
+#line 712 "fortran.y"
+    { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+    break;
+
+  case 109:
+/* Line 1807 of yacc.c  */
+#line 724 "fortran.y"
+    {
+            createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].na),ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].na),ligne);
+        }
+    break;
+
+  case 110:
+/* Line 1807 of yacc.c  */
+#line 730 "fortran.y"
+    {
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+        }
+    break;
+
+  case 111:
+/* Line 1807 of yacc.c  */
+#line 735 "fortran.y"
+    {
+            createstringfromlistname(ligne,(yyvsp[(7) - (8)].lnn));
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,(yyvsp[(2) - (8)].na),(yyvsp[(4) - (8)].na),ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+    break;
+
+  case 112:
+/* Line 1807 of yacc.c  */
+#line 748 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 113:
+/* Line 1807 of yacc.c  */
+#line 749 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);   }
+    break;
+
+  case 118:
+/* Line 1807 of yacc.c  */
+#line 758 "fortran.y"
+    { pos_cursave = setposcur()-4; }
+    break;
+
+  case 120:
+/* Line 1807 of yacc.c  */
+#line 761 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Save_Var_1((yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].d)); }
+    break;
+
+  case 121:
+/* Line 1807 of yacc.c  */
+#line 764 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 122:
+/* Line 1807 of yacc.c  */
+#line 765 "fortran.y"
+    { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+    break;
+
+  case 123:
+/* Line 1807 of yacc.c  */
+#line 766 "fortran.y"
+    { (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn)); }
+    break;
+
+  case 124:
+/* Line 1807 of yacc.c  */
+#line 769 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));  }
+    break;
+
+  case 125:
+/* Line 1807 of yacc.c  */
+#line 770 "fortran.y"
+    { sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 126:
+/* Line 1807 of yacc.c  */
+#line 771 "fortran.y"
+    { sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 127:
+/* Line 1807 of yacc.c  */
+#line 772 "fortran.y"
+    { sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 128:
+/* Line 1807 of yacc.c  */
+#line 773 "fortran.y"
+    { sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 129:
+/* Line 1807 of yacc.c  */
+#line 775 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 130:
+/* Line 1807 of yacc.c  */
+#line 776 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 135:
+/* Line 1807 of yacc.c  */
+#line 786 "fortran.y"
+    {
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+    break;
+
+  case 136:
+/* Line 1807 of yacc.c  */
+#line 793 "fortran.y"
+    {
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            (yyval.l) = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 137:
+/* Line 1807 of yacc.c  */
+#line 803 "fortran.y"
+    {
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar((yyvsp[(1) - (5)].l), curvar);
+            (yyval.l) = curlistvar;
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 140:
+/* Line 1807 of yacc.c  */
+#line 818 "fortran.y"
+    { (yyval.lnn) = (listname *) NULL; }
+    break;
+
+  case 141:
+/* Line 1807 of yacc.c  */
+#line 819 "fortran.y"
+    { (yyval.lnn) = (yyvsp[(3) - (3)].lnn); }
+    break;
+
+  case 142:
+/* Line 1807 of yacc.c  */
+#line 822 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 143:
+/* Line 1807 of yacc.c  */
+#line 823 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 144:
+/* Line 1807 of yacc.c  */
+#line 824 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 145:
+/* Line 1807 of yacc.c  */
+#line 825 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 146:
+/* Line 1807 of yacc.c  */
+#line 829 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 147:
+/* Line 1807 of yacc.c  */
+#line 835 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].na));
+            Add_NameOfCommon_1((yyvsp[(2) - (3)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 148:
+/* Line 1807 of yacc.c  */
+#line 843 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].na));
+            Add_NameOfCommon_1((yyvsp[(3) - (5)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 149:
+/* Line 1807 of yacc.c  */
+#line 852 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+    break;
+
+  case 150:
+/* Line 1807 of yacc.c  */
+#line 853 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+    break;
+
+  case 151:
+/* Line 1807 of yacc.c  */
+#line 856 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 152:
+/* Line 1807 of yacc.c  */
+#line 857 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 153:
+/* Line 1807 of yacc.c  */
+#line 861 "fortran.y"
+    {
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,(yyvsp[(1) - (2)].na));
+            commondim = (yyvsp[(2) - (2)].d);
+        }
+    break;
+
+  case 154:
+/* Line 1807 of yacc.c  */
+#line 869 "fortran.y"
+    {
+            strcpy((yyval.na),"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+    break;
+
+  case 155:
+/* Line 1807 of yacc.c  */
+#line 875 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(2) - (3)].na));
+            positioninblock=0;
+            strcpy(commonblockname,(yyvsp[(2) - (3)].na));
+        }
+    break;
+
+  case 158:
+/* Line 1807 of yacc.c  */
+#line 885 "fortran.y"
+    { (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v)); }
+    break;
+
+  case 159:
+/* Line 1807 of yacc.c  */
+#line 886 "fortran.y"
+    { (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));   }
+    break;
+
+  case 160:
+/* Line 1807 of yacc.c  */
+#line 890 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].na));
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length((yyvsp[(3) - (3)].na),14);
+            (yyval.v) = curvar;
+        }
+    break;
+
+  case 164:
+/* Line 1807 of yacc.c  */
+#line 913 "fortran.y"
+    {
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+    break;
+
+  case 166:
+/* Line 1807 of yacc.c  */
+#line 924 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(2) - (5)].na),curdim);
+                else                curvar = createvar((yyvsp[(2) - (5)].na),(yyvsp[(3) - (5)].d));
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 167:
+/* Line 1807 of yacc.c  */
+#line 946 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(3) - (6)].na), curdim);
+                else                curvar = createvar((yyvsp[(3) - (6)].na), (yyvsp[(4) - (6)].d));
+                CreateAndFillin_Curvar((yyvsp[(1) - (6)].l)->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, (yyvsp[(1) - (6)].l)->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar((yyvsp[(1) - (6)].l), curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 168:
+/* Line 1807 of yacc.c  */
+#line 970 "fortran.y"
+    { dimsgiven = 0; }
+    break;
+
+  case 169:
+/* Line 1807 of yacc.c  */
+#line 972 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (2)].na));  }
+    break;
+
+  case 170:
+/* Line 1807 of yacc.c  */
+#line 973 "fortran.y"
+    { strcpy(DeclType,"character");  }
+    break;
+
+  case 171:
+/* Line 1807 of yacc.c  */
+#line 974 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (3)].na)); strcpy(nameinttypename,(yyvsp[(3) - (3)].na));  }
+    break;
+
+  case 172:
+/* Line 1807 of yacc.c  */
+#line 975 "fortran.y"
+    { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+    break;
+
+  case 174:
+/* Line 1807 of yacc.c  */
+#line 978 "fortran.y"
+    { c_selectorgiven = 1; strcpy(c_selectorname,(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 175:
+/* Line 1807 of yacc.c  */
+#line 979 "fortran.y"
+    { c_star = 1;}
+    break;
+
+  case 180:
+/* Line 1807 of yacc.c  */
+#line 987 "fortran.y"
+    { pos_cur_decl = setposcur()-9; }
+    break;
+
+  case 181:
+/* Line 1807 of yacc.c  */
+#line 990 "fortran.y"
+    { strcpy((yyval.na),"integer"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 182:
+/* Line 1807 of yacc.c  */
+#line 991 "fortran.y"
+    { strcpy((yyval.na),"logical"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 183:
+/* Line 1807 of yacc.c  */
+#line 992 "fortran.y"
+    { strcpy((yyval.na),"real");    pos_cur_decl = setposcur()-4; }
+    break;
+
+  case 184:
+/* Line 1807 of yacc.c  */
+#line 993 "fortran.y"
+    { strcpy((yyval.na),"complex"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 185:
+/* Line 1807 of yacc.c  */
+#line 994 "fortran.y"
+    { strcpy((yyval.na),"double complex"); pos_cur_decl = setposcur()-14; }
+    break;
+
+  case 186:
+/* Line 1807 of yacc.c  */
+#line 995 "fortran.y"
+    { pos_cur_decl = setposcur()-16; strcpy((yyval.na),"real"); strcpy(nameinttypename,"8"); }
+    break;
+
+  case 188:
+/* Line 1807 of yacc.c  */
+#line 998 "fortran.y"
+    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 189:
+/* Line 1807 of yacc.c  */
+#line 1001 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 190:
+/* Line 1807 of yacc.c  */
+#line 1002 "fortran.y"
+    { strcpy((yyval.na),"*(*)"); }
+    break;
+
+  case 197:
+/* Line 1807 of yacc.c  */
+#line 1014 "fortran.y"
+    {
+            if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
+        }
+    break;
+
+  case 198:
+/* Line 1807 of yacc.c  */
+#line 1023 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 199:
+/* Line 1807 of yacc.c  */
+#line 1024 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 200:
+/* Line 1807 of yacc.c  */
+#line 1025 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 201:
+/* Line 1807 of yacc.c  */
+#line 1028 "fortran.y"
+    { strcpy(CharacterSize,(yyvsp[(1) - (1)].na));  strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 202:
+/* Line 1807 of yacc.c  */
+#line 1029 "fortran.y"
+    { strcpy(CharacterSize,"*"); strcpy((yyval.na),"*"); }
+    break;
+
+  case 210:
+/* Line 1807 of yacc.c  */
+#line 1042 "fortran.y"
+    { VariableIsParameter = 1; }
+    break;
+
+  case 212:
+/* Line 1807 of yacc.c  */
+#line 1044 "fortran.y"
+    { Allocatabledeclare = 1; }
+    break;
+
+  case 213:
+/* Line 1807 of yacc.c  */
+#line 1045 "fortran.y"
+    { dimsgiven = 1; curdim = (yyvsp[(2) - (2)].d); }
+    break;
+
+  case 214:
+/* Line 1807 of yacc.c  */
+#line 1046 "fortran.y"
+    { ExternalDeclare = 1; }
+    break;
+
+  case 215:
+/* Line 1807 of yacc.c  */
+#line 1048 "fortran.y"
+    { strcpy(IntentSpec,(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 217:
+/* Line 1807 of yacc.c  */
+#line 1050 "fortran.y"
+    { optionaldeclare = 1 ; }
+    break;
+
+  case 218:
+/* Line 1807 of yacc.c  */
+#line 1051 "fortran.y"
+    { pointerdeclare = 1 ; }
+    break;
+
+  case 219:
+/* Line 1807 of yacc.c  */
+#line 1052 "fortran.y"
+    { SaveDeclare = 1 ; }
+    break;
+
+  case 220:
+/* Line 1807 of yacc.c  */
+#line 1053 "fortran.y"
+    { Targetdeclare = 1; }
+    break;
+
+  case 221:
+/* Line 1807 of yacc.c  */
+#line 1056 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 222:
+/* Line 1807 of yacc.c  */
+#line 1057 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 223:
+/* Line 1807 of yacc.c  */
+#line 1058 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 224:
+/* Line 1807 of yacc.c  */
+#line 1061 "fortran.y"
+    { PublicDeclare = 1;  }
+    break;
+
+  case 225:
+/* Line 1807 of yacc.c  */
+#line 1062 "fortran.y"
+    { PrivateDeclare = 1; }
+    break;
+
+  case 226:
+/* Line 1807 of yacc.c  */
+#line 1064 "fortran.y"
+    { (yyval.d) = (listdim*) NULL; }
+    break;
+
+  case 227:
+/* Line 1807 of yacc.c  */
+#line 1066 "fortran.y"
+    {
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=(yyvsp[(2) - (3)].d);
+        }
+    break;
+
+  case 228:
+/* Line 1807 of yacc.c  */
+#line 1074 "fortran.y"
+    {
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));
+        }
+    break;
+
+  case 229:
+/* Line 1807 of yacc.c  */
+#line 1080 "fortran.y"
+    {
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));
+        }
+    break;
+
+  case 230:
+/* Line 1807 of yacc.c  */
+#line 1086 "fortran.y"
+    { strcpy((yyval.dim1).first,"1"); strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na)); Save_Length((yyvsp[(1) - (1)].na),1); }
+    break;
+
+  case 231:
+/* Line 1807 of yacc.c  */
+#line 1087 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,"");                    }
+    break;
+
+  case 232:
+/* Line 1807 of yacc.c  */
+#line 1088 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));  Save_Length((yyvsp[(1) - (2)].na),2); strcpy((yyval.dim1).last,""); }
+    break;
+
+  case 233:
+/* Line 1807 of yacc.c  */
+#line 1089 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na)); Save_Length((yyvsp[(2) - (2)].na),1); }
+    break;
+
+  case 234:
+/* Line 1807 of yacc.c  */
+#line 1090 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));  Save_Length((yyvsp[(1) - (3)].na),2); strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na)); Save_Length((yyvsp[(3) - (3)].na),1); }
+    break;
+
+  case 235:
+/* Line 1807 of yacc.c  */
+#line 1093 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 236:
+/* Line 1807 of yacc.c  */
+#line 1094 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 237:
+/* Line 1807 of yacc.c  */
+#line 1096 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 238:
+/* Line 1807 of yacc.c  */
+#line 1097 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 239:
+/* Line 1807 of yacc.c  */
+#line 1098 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 240:
+/* Line 1807 of yacc.c  */
+#line 1099 "fortran.y"
+    { sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 241:
+/* Line 1807 of yacc.c  */
+#line 1103 "fortran.y"
+    { sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 242:
+/* Line 1807 of yacc.c  */
+#line 1104 "fortran.y"
+    { sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 243:
+/* Line 1807 of yacc.c  */
+#line 1105 "fortran.y"
+    { sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 244:
+/* Line 1807 of yacc.c  */
+#line 1106 "fortran.y"
+    { sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 245:
+/* Line 1807 of yacc.c  */
+#line 1107 "fortran.y"
+    { sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 246:
+/* Line 1807 of yacc.c  */
+#line 1108 "fortran.y"
+    { sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 247:
+/* Line 1807 of yacc.c  */
+#line 1109 "fortran.y"
+    { sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 248:
+/* Line 1807 of yacc.c  */
+#line 1110 "fortran.y"
+    { sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 249:
+/* Line 1807 of yacc.c  */
+#line 1111 "fortran.y"
+    { sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 250:
+/* Line 1807 of yacc.c  */
+#line 1112 "fortran.y"
+    { sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 251:
+/* Line 1807 of yacc.c  */
+#line 1113 "fortran.y"
+    { sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 252:
+/* Line 1807 of yacc.c  */
+#line 1114 "fortran.y"
+    { sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 253:
+/* Line 1807 of yacc.c  */
+#line 1115 "fortran.y"
+    { sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 254:
+/* Line 1807 of yacc.c  */
+#line 1116 "fortran.y"
+    { sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 255:
+/* Line 1807 of yacc.c  */
+#line 1117 "fortran.y"
+    { sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 256:
+/* Line 1807 of yacc.c  */
+#line 1118 "fortran.y"
+    { sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 257:
+/* Line 1807 of yacc.c  */
+#line 1119 "fortran.y"
+    { sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 258:
+/* Line 1807 of yacc.c  */
+#line 1120 "fortran.y"
+    { sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 259:
+/* Line 1807 of yacc.c  */
+#line 1121 "fortran.y"
+    { sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 260:
+/* Line 1807 of yacc.c  */
+#line 1122 "fortran.y"
+    { sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 261:
+/* Line 1807 of yacc.c  */
+#line 1123 "fortran.y"
+    { sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 262:
+/* Line 1807 of yacc.c  */
+#line 1124 "fortran.y"
+    { sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 263:
+/* Line 1807 of yacc.c  */
+#line 1125 "fortran.y"
+    { sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 264:
+/* Line 1807 of yacc.c  */
+#line 1126 "fortran.y"
+    { sprintf((yyval.na),"SIGN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 265:
+/* Line 1807 of yacc.c  */
+#line 1127 "fortran.y"
+    { sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 266:
+/* Line 1807 of yacc.c  */
+#line 1128 "fortran.y"
+    { sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 267:
+/* Line 1807 of yacc.c  */
+#line 1130 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 268:
+/* Line 1807 of yacc.c  */
+#line 1131 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 269:
+/* Line 1807 of yacc.c  */
+#line 1133 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 270:
+/* Line 1807 of yacc.c  */
+#line 1134 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 271:
+/* Line 1807 of yacc.c  */
+#line 1135 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 272:
+/* Line 1807 of yacc.c  */
+#line 1136 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 273:
+/* Line 1807 of yacc.c  */
+#line 1137 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 274:
+/* Line 1807 of yacc.c  */
+#line 1138 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 275:
+/* Line 1807 of yacc.c  */
+#line 1140 "fortran.y"
+    { strcpy((yyval.na),"+"); }
+    break;
+
+  case 276:
+/* Line 1807 of yacc.c  */
+#line 1141 "fortran.y"
+    { strcpy((yyval.na),"-"); }
+    break;
+
+  case 277:
+/* Line 1807 of yacc.c  */
+#line 1145 "fortran.y"
+    { sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 278:
+/* Line 1807 of yacc.c  */
+#line 1146 "fortran.y"
+    { sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 279:
+/* Line 1807 of yacc.c  */
+#line 1147 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 280:
+/* Line 1807 of yacc.c  */
+#line 1148 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 281:
+/* Line 1807 of yacc.c  */
+#line 1149 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 282:
+/* Line 1807 of yacc.c  */
+#line 1150 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 283:
+/* Line 1807 of yacc.c  */
+#line 1151 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 284:
+/* Line 1807 of yacc.c  */
+#line 1152 "fortran.y"
+    { sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 285:
+/* Line 1807 of yacc.c  */
+#line 1153 "fortran.y"
+    { sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 286:
+/* Line 1807 of yacc.c  */
+#line 1154 "fortran.y"
+    { sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 287:
+/* Line 1807 of yacc.c  */
+#line 1155 "fortran.y"
+    { sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 288:
+/* Line 1807 of yacc.c  */
+#line 1156 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 289:
+/* Line 1807 of yacc.c  */
+#line 1157 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 290:
+/* Line 1807 of yacc.c  */
+#line 1158 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 291:
+/* Line 1807 of yacc.c  */
+#line 1159 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 292:
+/* Line 1807 of yacc.c  */
+#line 1160 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 293:
+/* Line 1807 of yacc.c  */
+#line 1161 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 294:
+/* Line 1807 of yacc.c  */
+#line 1162 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 295:
+/* Line 1807 of yacc.c  */
+#line 1163 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 296:
+/* Line 1807 of yacc.c  */
+#line 1164 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 297:
+/* Line 1807 of yacc.c  */
+#line 1165 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 298:
+/* Line 1807 of yacc.c  */
+#line 1167 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 299:
+/* Line 1807 of yacc.c  */
+#line 1168 "fortran.y"
+    { sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 300:
+/* Line 1807 of yacc.c  */
+#line 1169 "fortran.y"
+    { sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 301:
+/* Line 1807 of yacc.c  */
+#line 1170 "fortran.y"
+    { sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 302:
+/* Line 1807 of yacc.c  */
+#line 1173 "fortran.y"
+    { sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 303:
+/* Line 1807 of yacc.c  */
+#line 1174 "fortran.y"
+    { sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 304:
+/* Line 1807 of yacc.c  */
+#line 1177 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 305:
+/* Line 1807 of yacc.c  */
+#line 1178 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 306:
+/* Line 1807 of yacc.c  */
+#line 1179 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 307:
+/* Line 1807 of yacc.c  */
+#line 1183 "fortran.y"
+    {
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 308:
+/* Line 1807 of yacc.c  */
+#line 1194 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+    break;
+
+  case 309:
+/* Line 1807 of yacc.c  */
+#line 1195 "fortran.y"
+    { sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 310:
+/* Line 1807 of yacc.c  */
+#line 1196 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 311:
+/* Line 1807 of yacc.c  */
+#line 1197 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na)); }
+    break;
+
+  case 312:
+/* Line 1807 of yacc.c  */
+#line 1201 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));
+            ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
+            agrif_parentcall = 0;
+        }
+    break;
+
+  case 313:
+/* Line 1807 of yacc.c  */
+#line 1210 "fortran.y"
+    {
+            sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (4)].na),(yyvsp[(4) - (4)].na));
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+    break;
+
+  case 314:
+/* Line 1807 of yacc.c  */
+#line 1216 "fortran.y"
+    { sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 315:
+/* Line 1807 of yacc.c  */
+#line 1219 "fortran.y"
+    { strcpy((yyval.na)," "); }
+    break;
+
+  case 316:
+/* Line 1807 of yacc.c  */
+#line 1220 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 317:
+/* Line 1807 of yacc.c  */
+#line 1223 "fortran.y"
+    {  strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 318:
+/* Line 1807 of yacc.c  */
+#line 1224 "fortran.y"
+    {  sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 319:
+/* Line 1807 of yacc.c  */
+#line 1227 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 320:
+/* Line 1807 of yacc.c  */
+#line 1228 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 321:
+/* Line 1807 of yacc.c  */
+#line 1231 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 322:
+/* Line 1807 of yacc.c  */
+#line 1232 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 323:
+/* Line 1807 of yacc.c  */
+#line 1233 "fortran.y"
+    {  sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));}
+    break;
+
+  case 324:
+/* Line 1807 of yacc.c  */
+#line 1234 "fortran.y"
+    {  sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 325:
+/* Line 1807 of yacc.c  */
+#line 1235 "fortran.y"
+    {  sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 326:
+/* Line 1807 of yacc.c  */
+#line 1236 "fortran.y"
+    {  sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));}
+    break;
+
+  case 327:
+/* Line 1807 of yacc.c  */
+#line 1237 "fortran.y"
+    {  sprintf((yyval.na),":");}
+    break;
+
+  case 328:
+/* Line 1807 of yacc.c  */
+#line 1240 "fortran.y"
+    {
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME((yyvsp[(1) - (1)].na)) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp((yyvsp[(1) - (1)].na),"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction((yyvsp[(1) - (1)].na)) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp((yyvsp[(1) - (1)].na),identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,(yyvsp[(1) - (1)].na));
+                    pointedvar = 0;
+
+                    if (variscoupled_0((yyvsp[(1) - (1)].na))) strcpy(truename, getcoupledname_0((yyvsp[(1) - (1)].na)));
+                    else                    strcpy(truename, (yyvsp[(1) - (1)].na));
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].na)) == 1) || (inagrifcallargument == 1) )
+                            {
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].na)));
+                            }
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+    break;
+
+  case 329:
+/* Line 1807 of yacc.c  */
+#line 1285 "fortran.y"
+    { strcpy((yyval.na),".TRUE.");}
+    break;
+
+  case 330:
+/* Line 1807 of yacc.c  */
+#line 1286 "fortran.y"
+    { strcpy((yyval.na),".FALSE.");}
+    break;
+
+  case 331:
+/* Line 1807 of yacc.c  */
+#line 1287 "fortran.y"
+    { strcpy((yyval.na),"NULL()"); }
+    break;
+
+  case 332:
+/* Line 1807 of yacc.c  */
+#line 1288 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 333:
+/* Line 1807 of yacc.c  */
+#line 1289 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 334:
+/* Line 1807 of yacc.c  */
+#line 1290 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 335:
+/* Line 1807 of yacc.c  */
+#line 1292 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 337:
+/* Line 1807 of yacc.c  */
+#line 1296 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 339:
+/* Line 1807 of yacc.c  */
+#line 1298 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 340:
+/* Line 1807 of yacc.c  */
+#line 1299 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 341:
+/* Line 1807 of yacc.c  */
+#line 1301 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 342:
+/* Line 1807 of yacc.c  */
+#line 1302 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 343:
+/* Line 1807 of yacc.c  */
+#line 1305 "fortran.y"
+    { sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));}
+    break;
+
+  case 344:
+/* Line 1807 of yacc.c  */
+#line 1307 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 345:
+/* Line 1807 of yacc.c  */
+#line 1308 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 346:
+/* Line 1807 of yacc.c  */
+#line 1311 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 347:
+/* Line 1807 of yacc.c  */
+#line 1312 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 348:
+/* Line 1807 of yacc.c  */
+#line 1314 "fortran.y"
+    { InitialValueGiven = 0; }
+    break;
+
+  case 349:
+/* Line 1807 of yacc.c  */
+#line 1316 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 1;
+        }
+    break;
+
+  case 350:
+/* Line 1807 of yacc.c  */
+#line 1322 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 2;
+        }
+    break;
+
+  case 351:
+/* Line 1807 of yacc.c  */
+#line 1329 "fortran.y"
+    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 352:
+/* Line 1807 of yacc.c  */
+#line 1333 "fortran.y"
+    {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", (yyvsp[(2) - (2)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0((yyvsp[(2) - (2)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 353:
+/* Line 1807 of yacc.c  */
+#line 1353 "fortran.y"
+    {
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].lc));
+                    coupletmp = (yyvsp[(4) - (4)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].na));
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+    break;
+
+  case 354:
+/* Line 1807 of yacc.c  */
+#line 1380 "fortran.y"
+    {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0((yyvsp[(2) - (6)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 355:
+/* Line 1807 of yacc.c  */
+#line 1400 "fortran.y"
+    {
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (6)].na),(yyvsp[(6) - (6)].lc));
+                    coupletmp = (yyvsp[(6) - (6)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].na),oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].na), fortran_out,pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 356:
+/* Line 1807 of yacc.c  */
+#line 1440 "fortran.y"
+    {
+            pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+    break;
+
+  case 357:
+/* Line 1807 of yacc.c  */
+#line 1447 "fortran.y"
+    {
+            (yyval.lc) = (yyvsp[(1) - (1)].lc);
+        }
+    break;
+
+  case 358:
+/* Line 1807 of yacc.c  */
+#line 1451 "fortran.y"
+    {
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 359:
+/* Line 1807 of yacc.c  */
+#line 1458 "fortran.y"
+    {
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 360:
+/* Line 1807 of yacc.c  */
+#line 1467 "fortran.y"
+    {  (yyval.lc) = (yyvsp[(1) - (1)].lc); }
+    break;
+
+  case 361:
+/* Line 1807 of yacc.c  */
+#line 1469 "fortran.y"
+    {
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 362:
+/* Line 1807 of yacc.c  */
+#line 1477 "fortran.y"
+    {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].na));
+        }
+    break;
+
+  case 363:
+/* Line 1807 of yacc.c  */
+#line 1487 "fortran.y"
+    {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].na));
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 380:
+/* Line 1807 of yacc.c  */
+#line 1522 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 381:
+/* Line 1807 of yacc.c  */
+#line 1523 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 388:
+/* Line 1807 of yacc.c  */
+#line 1531 "fortran.y"
+    {
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 389:
+/* Line 1807 of yacc.c  */
+#line 1568 "fortran.y"
+    {
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 390:
+/* Line 1807 of yacc.c  */
+#line 1577 "fortran.y"
+    {
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+    break;
+
+  case 391:
+/* Line 1807 of yacc.c  */
+#line 1588 "fortran.y"
+    {
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 392:
+/* Line 1807 of yacc.c  */
+#line 1596 "fortran.y"
+    {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen((yyvsp[(2) - (2)].na))+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+    break;
+
+  case 395:
+/* Line 1807 of yacc.c  */
+#line 1620 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+    break;
+
+  case 483:
+/* Line 1807 of yacc.c  */
+#line 1898 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            functiondeclarationisdone = 0;
+        }
+    break;
+
+  case 484:
+/* Line 1807 of yacc.c  */
+#line 1906 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 485:
+/* Line 1807 of yacc.c  */
+#line 1913 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 486:
+/* Line 1807 of yacc.c  */
+#line 1920 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 487:
+/* Line 1807 of yacc.c  */
+#line 1926 "fortran.y"
+    {strcpy((yyval.na),"");}
+    break;
+
+  case 488:
+/* Line 1807 of yacc.c  */
+#line 1927 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 489:
+/* Line 1807 of yacc.c  */
+#line 1930 "fortran.y"
+    { created_dimensionlist = 0; }
+    break;
+
+  case 490:
+/* Line 1807 of yacc.c  */
+#line 1934 "fortran.y"
+    {
+            created_dimensionlist = 1;
+            if ( ((yyvsp[(3) - (4)].d) == NULL) || ((yyvsp[(4) - (4)].d) == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+    break;
+
+  case 491:
+/* Line 1807 of yacc.c  */
+#line 1945 "fortran.y"
+    {
+            created_dimensionlist = 1;
+        }
+    break;
+
+  case 496:
+/* Line 1807 of yacc.c  */
+#line 1958 "fortran.y"
+    {
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+    break;
+
+  case 502:
+/* Line 1807 of yacc.c  */
+#line 1979 "fortran.y"
+    {
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber((yyvsp[(2) - (2)].na)) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 503:
+/* Line 1807 of yacc.c  */
+#line 2000 "fortran.y"
+    { pos_curcall=setposcur()-4; }
+    break;
+
+  case 506:
+/* Line 1807 of yacc.c  */
+#line 2008 "fortran.y"
+    {
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+    break;
+
+  case 532:
+/* Line 1807 of yacc.c  */
+#line 2056 "fortran.y"
+    { afterpercent = 1; }
+    break;
+
+  case 572:
+/* Line 1807 of yacc.c  */
+#line 2115 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 573:
+/* Line 1807 of yacc.c  */
+#line 2116 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 574:
+/* Line 1807 of yacc.c  */
+#line 2117 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 575:
+/* Line 1807 of yacc.c  */
+#line 2118 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 576:
+/* Line 1807 of yacc.c  */
+#line 2119 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 577:
+/* Line 1807 of yacc.c  */
+#line 2120 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 578:
+/* Line 1807 of yacc.c  */
+#line 2121 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 579:
+/* Line 1807 of yacc.c  */
+#line 2122 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 580:
+/* Line 1807 of yacc.c  */
+#line 2123 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 581:
+/* Line 1807 of yacc.c  */
+#line 2124 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 582:
+/* Line 1807 of yacc.c  */
+#line 2127 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 583:
+/* Line 1807 of yacc.c  */
+#line 2128 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 584:
+/* Line 1807 of yacc.c  */
+#line 2129 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 585:
+/* Line 1807 of yacc.c  */
+#line 2131 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 586:
+/* Line 1807 of yacc.c  */
+#line 2132 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].na),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));}
+    break;
+
+  case 591:
+/* Line 1807 of yacc.c  */
+#line 2142 "fortran.y"
+    { Add_Allocate_Var_1((yyvsp[(1) - (1)].na),curmodulename); }
+    break;
+
+
+/* Line 1807 of yacc.c  */
+#line 6110 "fortran.tab.c"
+      default: break;
+    }
+  /* User semantic actions sometimes alter yychar, and that requires
+     that yytoken be updated with the new translation.  We take the
+     approach of translating immediately before every use of yytoken.
+     One alternative is translating here after every semantic action,
+     but that translation would be missed if the semantic action invokes
+     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
+     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
+     incorrect destructor might then be invoked immediately.  In the
+     case of YYERROR or YYBACKUP, subsequent parser actions might lead
+     to an incorrect destructor call or verbose syntax error message
+     before the lookahead is translated.  */
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* Make sure we have latest lookahead translation.  See comments at
+     user semantic actions for why this is necessary.  */
+  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
+
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
+                                        yyssp, yytoken)
+      {
+        char const *yymsgp = YY_("syntax error");
+        int yysyntax_error_status;
+        yysyntax_error_status = YYSYNTAX_ERROR;
+        if (yysyntax_error_status == 0)
+          yymsgp = yymsg;
+        else if (yysyntax_error_status == 1)
+          {
+            if (yymsg != yymsgbuf)
+              YYSTACK_FREE (yymsg);
+            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
+            if (!yymsg)
+              {
+                yymsg = yymsgbuf;
+                yymsg_alloc = sizeof yymsgbuf;
+                yysyntax_error_status = 2;
+              }
+            else
+              {
+                yysyntax_error_status = YYSYNTAX_ERROR;
+                yymsgp = yymsg;
+              }
+          }
+        yyerror (yymsgp);
+        if (yysyntax_error_status == 2)
+          goto yyexhaustedlab;
+      }
+# undef YYSYNTAX_ERROR
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse lookahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse lookahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (!yypact_value_is_default (yyn))
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+  *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#if !defined yyoverflow || YYERROR_VERBOSE
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEMPTY)
+    {
+      /* Make sure we have latest lookahead translation.  See comments at
+         user semantic actions for why this is necessary.  */
+      yytoken = YYTRANSLATE (yychar);
+      yydestruct ("Cleanup: discarding lookahead",
+                  yytoken, &yylval);
+    }
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+/* Line 2055 of yacc.c  */
+#line 2156 "fortran.y"
+
+
+void process_fortran(const char *input_file)
+{
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
+/******************************************************************************/
+/*  1-  Open input file                                                       */
+/******************************************************************************/
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
+}
+#line 2 "fortran.yy.c"
+
+#line 4 "fortran.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define yy_create_buffer fortran__create_buffer
+#define yy_delete_buffer fortran__delete_buffer
+#define yy_flex_debug fortran__flex_debug
+#define yy_init_buffer fortran__init_buffer
+#define yy_flush_buffer fortran__flush_buffer
+#define yy_load_buffer_state fortran__load_buffer_state
+#define yy_switch_to_buffer fortran__switch_to_buffer
+#define yyin fortran_in
+#define yyleng fortran_leng
+#define yylex fortran_lex
+#define yylineno fortran_lineno
+#define yyout fortran_out
+#define yyrestart fortran_restart
+#define yytext fortran_text
+#define yywrap fortran_wrap
+#define yyalloc fortran_alloc
+#define yyrealloc fortran_realloc
+#define yyfree fortran_free
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE fortran_restart(fortran_in  )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t fortran_leng;
+
+extern FILE *fortran_in, *fortran_out;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+    #define YY_LESS_LINENO(n)
+    
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortran_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		*yy_cp = (yy_hold_char); \
+		YY_RESTORE_YY_MORE_OFFSET \
+		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up fortran_text again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr)  )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	yy_size_t yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+    int yy_bs_lineno; /**< The line count. */
+    int yy_bs_column; /**< The column count. */
+    
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via fortran_restart()), so that the user can continue scanning by
+	 * just pointing fortran_in at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+
+	};
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+                          : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when fortran_text is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t fortran_leng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow fortran_wrap()'s to do buffer switches
+ * instead of setting up a fresh fortran_in.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void fortran_restart (FILE *input_file  );
+void fortran__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE fortran__create_buffer (FILE *file,int size  );
+void fortran__delete_buffer (YY_BUFFER_STATE b  );
+void fortran__flush_buffer (YY_BUFFER_STATE b  );
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void fortran_pop_buffer_state (void );
+
+static void fortran_ensure_buffer_stack (void );
+static void fortran__load_buffer_state (void );
+static void fortran__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER fortran__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE fortran__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE fortran__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE fortran__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *fortran_alloc (yy_size_t  );
+void *fortran_realloc (void *,yy_size_t  );
+void fortran_free (void *  );
+
+#define yy_new_buffer fortran__create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        fortran_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        fortran_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+#define fortran_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
+typedef unsigned char YY_CHAR;
+
+FILE *fortran_in = (FILE *) 0, *fortran_out = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int fortran_lineno;
+
+int fortran_lineno = 1;
+
+extern char *fortran_text;
+#define yytext_ptr fortran_text
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[]  );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up fortran_text.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	fortran_leng = (yy_size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 176
+#define YY_END_OF_BUFFER 177
+/* This struct is not used in this scanner,
+   but its presence is necessary. */
+struct yy_trans_info
+	{
+	flex_int32_t yy_verify;
+	flex_int32_t yy_nxt;
+	};
+static yyconst flex_int16_t yy_accept[1132] =
+    {   0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,  177,  176,  166,  164,  175,  176,  155,  158,
+      176,  176,  157,  157,  157,  160,  156,  144,  154,  157,
+      159,  162,  161,  163,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  166,  164,  166,  175,  154,  151,
+      151,  151,  151,  151,  151,  176,  176,  172,  176,  176,
+      176,  157,  151,    0,    0,  166,    0,    0,  175,  175,
+      175,    0,  148,    0,    0,    0,  168,    0,    0,    0,
+        0,    0,  147,    0,    0,  141,   25,    0,  153,    0,
+
+        0,    0,    0,    0,    0,    0,  142,    0,  154,    0,
+      140,   23,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,   42,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  100,  151,   89,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  166,  166,    0,  167,    0,
+        0,    0,    0,    0,    0,  165,  166,    0,  175,  174,
+      175,  175,  175,  167,  154,    0,  151,  151,  151,  151,
+
+       89,  151,  151,    0,  172,    0,    0,    0,    0,    0,
+        0,  173,   25,    0,    0,    0,  151,  151,  151,  151,
+      151,    0,    0,    0,  175,  175,    0,    0,    0,    0,
+        0,    0,    0,    0,  146,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,  152,  152,
+        0,  153,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  123,  151,  151,  151,
+      151,  151,  151,  151,   14,  151,  151,  151,  151,  122,
+      151,  151,  151,  151,  151,  151,  151,    0,  151,  151,
+      151,  151,  151,  151,  129,  151,  151,  134,  151,  151,
+
+      151,  151,  151,  151,  151,  151,   93,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  126,  151,  151,  151,  151,  151,  130,  151,  151,
+      151,  151,  151,  151,  151,    0,  166,  166,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,  166,    0,  167,
+      175,  175,  175,  154,    0,  151,  151,  151,  151,  151,
+      151,  151,    0,    0,    0,    0,  173,    0,    0,    0,
+      151,  151,  151,  151,  151,    0,    0,    0,  175,  175,
+        0,    0,    0,    0,    0,    0,    0,    0,  153,    0,
+       27,    0,   29,   28,   31,   30,   33,    0,    0,   35,
+
+        0,    0,  133,  125,  151,  151,  128,  151,  131,  151,
+      151,   20,  151,  151,  151,  151,  151,  151,  124,  151,
+      151,  151,  151,  151,  151,   98,    0,  115,  151,  151,
+      151,  151,  151,  151,  151,  151,    0,  116,  151,    0,
+      117,  151,  151,  151,  151,  151,  151,    0,  113,  151,
+      151,    0,   92,  151,  151,  151,  151,  151,  151,  151,
+        0,  102,  151,  151,    0,  119,  151,  151,  151,  151,
+      120,    0,  114,   19,  151,   63,   77,  151,  151,  151,
+      151,  151,  151,  151,  151,   82,   43,  151,  151,  151,
+      151,   72,  151,  151,  127,  151,   76,   57,  151,    0,
+
+      101,  103,  151,   96,  105,  151,  151,  151,  151,   47,
+      166,  166,    0,    0,    0,    0,    0,    0,    0,  166,
+        0,  167,  175,  175,  175,  154,    0,  108,  151,  151,
+      151,  151,  151,   16,    0,    0,    0,    0,    0,    0,
+      151,  151,  151,  151,    0,    0,    0,  175,  175,    0,
+        0,    0,    0,    0,    0,   37,   26,    0,   34,   36,
+      151,  151,  151,  151,  151,  151,   52,  151,  151,  151,
+      151,  132,  151,  151,  151,  151,  151,    0,  151,  151,
+        0,    0,    0,    0,    0,    0,    0,    0,   41,  151,
+       99,  151,  151,  151,  151,  151,  151,  151,  151,   79,
+
+       79,  151,    0,  111,  121,   85,  151,  151,   92,  151,
+      151,   94,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,    0,    0,  151,  151,  151,   55,  151,
+       80,  151,  151,  151,    0,  151,  151,  151,  151,  151,
+        0,  135,  106,  151,  151,    0,  112,   58,   39,   84,
+      166,  166,  108,    0,    0,    0,    0,    0,  166,    0,
+      167,  175,  175,  175,  154,    0,  108,  151,   90,  151,
+      151,   74,   73,   74,    0,    0,    0,    0,    0,  151,
+       52,  151,  132,    0,   21,    0,  175,   21,    0,   21,
+       21,    0,   21,    0,   21,   21,   21,   32,  151,  151,
+
+      151,   21,  151,  151,   66,  151,  151,  151,  151,  151,
+      151,  151,  145,    0,    0,   97,  151,   41,    0,   99,
+        0,    0,    0,    0,    0,    0,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  118,  151,  151,  151,  151,
+      151,  151,  151,   69,  151,  151,  137,  104,  136,  138,
+       38,  151,    0,    6,  151,  151,  151,  151,  151,  151,
+       87,    0,  151,    8,   78,   17,  151,  151,   86,  166,
+      166,    0,    0,    0,  166,  175,  175,   21,    0,  151,
+      151,  151,    0,    0,    0,   21,    0,  151,   21,   22,
+        0,  169,   22,   22,   22,   22,   22,   22,   22,   22,
+
+      151,  151,  151,  151,   50,  151,  151,  151,  109,  151,
+        0,  151,  151,   97,    0,  151,    0,    0,    0,    0,
+        0,    0,    0,  151,  151,  151,  151,  151,   75,  151,
+      151,  151,    0,    0,  151,  151,   15,   53,   44,  151,
+       45,    0,  151,  151,    5,  151,  151,   70,   88,    3,
+        0,    0,  151,    0,  151,  151,    0,    0,    0,  175,
+       22,    0,  151,   67,  151,    0,    0,   22,    0,   22,
+      151,    4,  151,  151,  151,  151,   91,  151,  151,    0,
+        0,  151,  151,    0,  151,    0,    0,    0,    0,    0,
+       75,    0,  151,  151,  151,  151,  151,   59,  151,   68,
+
+        0,    0,    0,    0,  143,    9,   18,  151,    0,  151,
+       83,   71,  151,    0,  151,    0,  151,  151,    0,    0,
+      175,    0,   62,  151,    0,    0,    0,  151,  151,  139,
+       46,  151,  151,   54,    0,    0,  151,  151,    0,   61,
+        0,    0,    0,    0,    0,   59,  151,   11,  151,  110,
+      151,  151,    0,    0,    0,    0,    0,  143,   95,    0,
+      151,   64,    0,   65,    0,  151,  151,   62,    0,  175,
+        0,  149,    0,    0,    0,  151,  151,   40,    7,    0,
+        0,  151,  151,   61,    0,   60,    0,   11,    0,  110,
+        0,  151,   10,  151,  151,    0,    0,    0,  151,    0,
+
+        0,  107,    2,  149,  175,    0,    0,    0,    0,   51,
+        0,    0,    0,    0,  151,  151,    0,   10,    0,   13,
+      151,   56,    0,    0,    0,  151,    0,  107,  175,    0,
+        0,    0,    0,    0,    0,    0,    0,  151,  151,   13,
+        0,  151,    0,    0,    0,  151,    0,  175,    0,    0,
+        0,    0,    0,   24,    0,    0,   49,  151,    0,   12,
+        0,    0,    0,  151,    0,  175,    0,    0,    0,  150,
+        0,   49,    0,  151,   12,    0,    0,    0,    0,  151,
+        0,  175,    0,    0,    0,    0,   48,    0,    0,    0,
+       81,    1,  175,    0,    0,    0,   48,   81,  175,    0,
+
+        0,    0,  175,    0,    0,    0,  175,    0,    0,    0,
+      175,    0,    0,    0,  175,    0,    0,    0,  175,  170,
+        0,  170,    0,    0,  170,    0,    0,    0,    0,  171,
+        0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    4,    5,    6,    7,    8,    9,   10,   11,   12,
+       13,   14,   15,   16,   17,   18,   19,   20,   21,   22,
+       23,   24,   25,   26,   27,   28,   29,   30,   31,   32,
+       33,   34,    1,    1,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+       51,   52,   53,   54,   55,   56,   57,   58,   59,   60,
+       61,    1,   62,    1,   63,    1,   64,   65,   66,   67,
+
+       68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
+       77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
+       87,   88,    1,   89,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[90] =
+    {   0,
+        1,    1,    2,    1,    1,    3,    1,    1,    1,    1,
+        1,    4,    1,    1,    1,    1,    1,    3,    1,    5,
+        5,    5,    5,    5,    5,    5,    5,    5,    5,    1,
+        1,    1,    1,    1,    6,    7,    7,    5,    5,    8,
+        9,   10,   11,   11,   11,    9,   11,    9,   12,   11,
+       13,    9,    9,    9,    9,   11,   11,   11,   11,   11,
+        1,    1,   11,    6,    7,    7,    5,    5,    8,    9,
+       10,   11,   11,    9,   11,    9,   12,   11,   13,    9,
+        9,    9,    9,   11,   11,   11,   11,   11,    3
+    } ;
+
+static yyconst flex_int16_t yy_base[1171] =
+    {   0,
+        0,   88,    0,    0,    0,    0,  984,   93,    0,   85,
+        0,    0,  891,   64,   98,  103,   80,  129,   96,   99,
+      134,  137,  145,  133,  168,  135,  249,  180,  318,  136,
+      156,  172,  212,  239,  246,  297,  366,  341,  414,  461,
+      247,  294,  398,  334,  407,  476,  506,  517,  459,  566,
+      572,  522,  571,  367,  653,  226,  656,  658,  737,  638,
+      785,  655,  698,  806,  652, 4012,  878, 4012,  241,  116,
+      124,  455,  893,   59,   76,  229,  253,  256,    0,  122,
+      127,  872, 4012,  157,  188,  869,  866,  327,  302,  349,
+      740,  416, 4012,  768,  592, 4012, 4012,  981,  730,  147,
+
+      184,  438,  495,  328,  184,  190, 4012, 1048,  335,  969,
+     4012, 4012,    0,  269,  315,  149,  319,  486,  462,  248,
+      318,  325,  269,  426,  736,  336,  767,  470,  500,  518,
+      512,  403,  516,  525,  535,  801,  544,  620,  565,  570,
+      589,  768,  483,  589,  810,  592,  613,  638,  650,  664,
+      678,  736,  737,  740,  741,  949,  736,  788,  646,  956,
+      756,  999,  739,  753,  804,  749, 1043,  972,  962,  769,
+      813,  963,  972,  969,    0, 1057,    0,  839,  238, 1044,
+      986,  789,  956, 1030,  965,  429, 1109, 1136,  830, 4012,
+     1061, 1087, 1091, 1162, 1188,  990, 1095, 1120, 1006, 1042,
+
+     1170, 1050, 1046,  823, 4012, 1201, 1099, 1115, 1190,  797,
+      483, 4012,  790, 1167, 1100, 1194, 1269, 1358, 1255, 1254,
+     1195, 1103, 1098,  625, 1148, 1163, 1217, 1237, 1222, 1238,
+     1095, 1305, 1325, 1234, 4012, 1334, 1302, 1326, 1107, 1182,
+      738,  735,  731,  730, 1244, 1166,  713, 1242, 4012, 1428,
+     1374, 1389, 1419, 1244, 1252, 1261, 1263, 1192, 1266, 1301,
+     1333, 1333, 1352, 1352, 1387, 1392, 1388, 1389, 1390, 1404,
+     1401, 1405, 1407, 1404, 1506, 1471, 1417, 1476, 1430,    0,
+     1422, 1437, 1442, 1432, 1484, 1440, 1454, 1497, 1444, 1448,
+     1451, 1443, 1445, 1475, 1459, 1530, 1536, 1464, 1477, 1470,
+
+     1531, 1490, 1491, 1482, 1509, 1511,    0, 1526, 1513, 1519,
+     1524, 1527, 1524, 1555, 1516, 1519, 1522, 1546, 1557, 1564,
+     1558, 1565, 1555, 1557, 1562, 1561, 1615, 1573, 1575, 1573,
+     1576, 1570, 1574, 1582, 1576,  719,  351,  666, 1572,  713,
+     1580, 1587, 1584, 1593, 1589, 1596, 1608, 1658, 1684, 1710,
+     1652, 1645, 1661, 1741, 1626, 1629, 1635, 1634, 1637, 1703,
+     1653,  709, 1654, 1744,  707,  998, 4012, 1712, 1674, 1715,
+     1664, 1708, 1725, 1738, 1749, 1622, 1684, 1379, 1672, 1735,
+     1743, 1771, 1723, 1772, 1787, 1804, 1815, 1807, 1821,  656,
+     4012,  646, 4012, 4012, 4012, 4012, 4012, 1735,  614, 4012,
+
+      613, 1849, 4012,    0, 1741, 1751,    0, 1796,    0, 1799,
+     1799,    0, 1820, 1819, 1811, 1816, 1808, 1821,    0, 1826,
+     1822, 1814, 1822, 1825, 1819, 1871, 1955, 4012, 1825, 1821,
+     1837, 1830, 1829, 1850, 1823, 1844, 1899, 4012, 1836, 1909,
+     4012, 1841, 2040, 1856, 1915, 1858, 1874, 1920, 4012, 1886,
+     1872, 1878,    0, 1886, 1879, 1881, 1888, 1896, 1895, 1902,
+     1967, 4012, 1897, 1906, 1971, 4012, 1900, 1912, 1906, 1915,
+        0, 1980, 4012,    0, 1988,    0,    0, 1929, 1939, 1926,
+     1933, 1936, 1946, 1939, 1953,    0,  602, 1949, 1958, 1955,
+     1963,    0, 1960, 2063,    0,  598,    0,    0, 1985, 2064,
+
+     4012,    0, 1960,    0,    0, 2019, 2022, 2024, 2025, 4012,
+      792,  880, 2030, 2023, 2043, 2043, 2041, 2042,  581, 2092,
+     2118, 2144, 2079, 2080, 2084, 2170, 2045, 1005, 2060, 1022,
+     2071, 2134, 2199,  574, 2082, 2174, 2108, 2147, 2148, 2101,
+     2154, 2184, 2187, 2190, 2087,    0, 1422, 2144,    0, 2200,
+      138, 2202,  571, 2221, 2233, 4012, 4012,  514, 4012, 4012,
+     2174, 2192, 2051, 2289, 2080, 2193,    0, 2109, 2194, 2193,
+     2199,    0, 2201, 2207, 2204, 2195, 2198, 2270, 2240, 2240,
+     2215, 2229, 2246, 2239, 2258, 2275, 2258, 2276,    0, 2276,
+        0, 2287, 2279, 2283, 2295, 2283, 2295, 2300, 2335, 4012,
+
+        0, 2293, 2342, 4012,    0,    0, 2294, 2293, 4012, 2316,
+     2321,    0, 2297, 2323, 2312, 2319, 2335, 2334, 2327, 2337,
+     2333, 2341, 2338,  197,  451, 2343, 2337, 2347,    0, 2348,
+        0, 2335, 2355, 2355,  477, 2343, 2343, 2350, 2355, 2348,
+     2275, 4012, 4012, 2349, 2351, 2404, 4012,    0,    0,    0,
+     1140, 1249, 1797, 2376, 2082, 2379, 2366, 2432, 2263,  424,
+      569, 2417, 2420,  499, 2486, 2384, 2087, 2385, 2427, 2389,
+     2398, 2437, 4012, 2448, 2444, 2439, 2452,  479, 2451, 2431,
+     2410, 2565, 2416,    0, 4012, 2653,    0,    0,  475,  445,
+     4012,  441,  436, 2458, 2462, 2468, 4012, 4012, 2682, 2404,
+
+     2428,    0, 2441, 2444,    0, 2442, 2449, 2447, 2480, 2465,
+     2479, 2553,    0, 2487, 2489,    0, 2493, 4012, 2486, 4012,
+     2497, 2509, 2513, 2527, 2535, 2549, 2552, 2538, 2550, 2555,
+     2548, 2562, 2552, 2559, 2604, 4012, 2572, 2480, 2561, 2568,
+     2573, 2575, 2564,    0, 2569, 2578,    0,    0,    0,    0,
+     2660, 2572,  508, 4012, 2583, 2594, 2591, 2650, 2664, 2658,
+        0, 2536, 2663,    0,    0,    0, 2715, 2654,    0, 2539,
+     2479, 2668, 2663, 2678, 2644, 2682,  426,  421, 2680, 2677,
+     2540, 2686, 2701, 2720,  411,  365, 2721, 2790, 2691, 4012,
+     2725, 4012,    0,  343, 4012,  307, 2753, 2755, 4012,    0,
+
+     2747, 2692, 2702, 2706,    0, 2707, 2709, 2719,    0, 2685,
+     2776, 2708, 2732, 4012, 2748, 2737, 2773, 2763, 2773, 2780,
+     2773, 2788, 2777, 2776, 2785, 2780, 2796, 2786,    0, 2797,
+     2798, 2794, 2647, 2867, 2796, 2791,    0,    0,    0, 2795,
+        0, 2845, 2798, 2801,    0, 2815, 2825,    0,    0,    0,
+     2872, 2840, 2825, 2883, 2847, 2843, 2840, 2548, 2855,  827,
+      303,  239, 2841, 2765, 2855, 1020, 2888,  288, 1687, 2861,
+     2861,    0, 2851, 2861, 2850, 2855,    0, 2851, 2858, 2858,
+     2856, 2863, 2873, 2862, 2878, 2870, 2882, 2880, 2881, 2888,
+     4012, 2904, 2901, 2906, 2913, 2885, 2895,    0, 2903,    0,
+
+     2951, 2978, 2955, 2982, 2994,    0,    0, 2933, 2910, 2917,
+        0,    0, 2923,  248, 2932, 2941, 2930, 2939, 2936, 2956,
+     2998, 2964,    0, 2967, 3005, 3006, 3007, 2966, 2959,    0,
+        0, 2960, 2979,    0, 2973, 2982, 2973, 2987, 2986, 3025,
+     2983, 2989, 2995, 2978, 2978, 4012, 2985,    0, 2991,    0,
+     2985, 3006, 3066, 3074, 3078, 3090, 3094, 3106,    0, 3009,
+     3019,    0, 3041,    0, 3018, 3050, 3056, 4012, 3062, 3076,
+     3056,    0, 3087, 3103, 3099, 3072, 3111,    0,    0, 3064,
+     3080, 3075, 3079, 3124, 3125, 4012, 3082, 4012, 3085, 4012,
+     3080, 3093,    0, 3096, 3104, 3152, 3171, 3113, 3118,  245,
+
+     3119,    0,    0, 4012, 1737,  184, 3142, 3141, 1922,    0,
+     3181, 3186, 3115, 3122, 3127, 3111, 3122, 4012, 3128,    0,
+     3129,    0, 3208, 3211, 3152, 3158, 3150, 4012, 3194, 3154,
+     2097, 3179, 3201, 3224, 3231, 3169, 3153, 3159, 3179, 4012,
+     3183, 3184, 3251, 3258, 3191, 3183,  207, 3229, 3207, 3237,
+      194, 3233, 3261, 4012, 3209, 3200,    0, 3220, 3211,    0,
+     3309, 3283, 3218, 3228, 3221, 3285, 3236, 3273,  142, 4012,
+     3286, 4012, 3243, 3250, 4012, 3339, 3342, 3367, 3248, 3286,
+      108, 2482,   40, 2606, 2838, 3273,    0, 3395, 3399, 3290,
+        0, 4012, 3302, 3294, 3311, 3350, 4012, 4012, 3299, 3320,
+
+     3357, 3358, 3375, 3318, 3359, 3380, 3404, 3376, 3300, 3412,
+     3362, 3363, 3370, 3415, 3418, 3423, 3420, 3426, 3433, 4012,
+     3447, 4012, 3428, 3451, 4012, 3430, 3439, 3454, 3457, 4012,
+     4012, 3521, 3534, 3547, 3560, 3573, 3586, 3595, 3608, 3621,
+     3634, 3647, 3656, 3669, 3678, 3686, 3699, 3712, 3725, 3738,
+     3751, 3764, 3777, 3790, 3803, 3816, 3829, 3842, 3855, 3868,
+     3881, 3894, 3907, 3920, 3933, 3946, 3959, 3972, 3985, 3998
+    } ;
+
+static yyconst flex_int16_t yy_def[1171] =
+    {   0,
+     1131,    1, 1132, 1132,    1,    2, 1133, 1133,    1,    2,
+        1,    2, 1131, 1131, 1131, 1131, 1134, 1135, 1131, 1131,
+     1136, 1137, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138,   40, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131,   55, 1139, 1131,   37,
+     1138, 1138, 1138, 1138, 1138, 1131, 1140, 1131, 1140, 1140,
+     1140, 1141, 1131, 1131, 1131, 1131, 1131, 1131, 1134, 1134,
+     1134, 1135, 1131, 1135, 1135, 1136, 1131, 1136, 1136, 1137,
+     1142, 1137, 1131, 1137, 1137, 1131, 1131, 1131, 1143, 1131,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,   29, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1145,   55,  176, 1146, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131,  176, 1131, 1139, 1131,
+     1139, 1139, 1139, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1140, 1131, 1140, 1140, 1140, 1140, 1147,
+     1147, 1131, 1147, 1147, 1147, 1147, 1148, 1148,  218,  218,
+      218, 1131, 1131, 1131, 1134, 1134, 1135, 1135, 1136, 1136,
+     1142, 1142, 1142, 1142, 1131, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1145,  176,  176, 1131, 1146,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131,  187, 1131, 1131,
+     1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1140, 1140, 1147, 1147, 1131, 1147, 1147, 1147,
+      218,  218,  218,  218,  218, 1131, 1131, 1131, 1134, 1134,
+     1135, 1135, 1136, 1136, 1142, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1131,
+     1131, 1138, 1149, 1138, 1138, 1138, 1138, 1131, 1131, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131, 1131,  187,
+     1131, 1131, 1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1140, 1140, 1140, 1147, 1147, 1147,
+      218,  218,  218,  218, 1131, 1150, 1131, 1134, 1151, 1135,
+     1152, 1136, 1153, 1137, 1154, 1131, 1131, 1131, 1131, 1131,
+     1138, 1138, 1138, 1155, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131,  176, 1131,
+     1131, 1139, 1139, 1156, 1131, 1131, 1131, 1138, 1131, 1138,
+     1138, 1131, 1131, 1131, 1140, 1140, 1147, 1157, 1147,  218,
+      218, 1158,  218, 1159, 1131, 1131, 1160, 1134, 1161, 1135,
+     1131, 1162, 1136, 1163, 1137, 1137, 1131, 1131, 1164, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,  176,
+      176, 1131, 1131, 1131,  176, 1139, 1165, 1139, 1131, 1138,
+     1138, 1138, 1140, 1140, 1166, 1147, 1147, 1167,  218, 1131,
+     1131, 1131, 1134, 1135, 1131, 1136, 1137, 1137, 1131, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1138, 1138, 1131, 1131, 1138, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1168, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1131, 1139,
+     1139, 1131, 1138, 1131, 1138, 1140, 1140, 1147, 1147,  218,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1138, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1168, 1168, 1131, 1169, 1168, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131,
+     1139, 1131, 1138, 1138, 1140, 1140, 1147, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1169, 1169, 1168, 1169, 1169, 1138, 1131,
+     1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1139,
+     1131, 1138, 1140, 1140, 1147, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1138, 1138, 1138, 1138, 1131, 1168, 1131, 1138, 1131,
+
+     1131, 1138, 1138, 1131, 1139, 1131, 1140, 1140, 1147, 1138,
+     1131, 1131, 1131, 1131, 1138, 1138, 1131, 1131, 1131, 1138,
+     1138, 1138, 1131, 1168, 1131, 1138, 1131, 1131, 1139, 1131,
+     1140, 1140, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131,
+     1131, 1138, 1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140,
+     1170, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140, 1170, 1131,
+     1147, 1131, 1131, 1138, 1131, 1131, 1168, 1168, 1131, 1138,
+     1131, 1139, 1131, 1140, 1147, 1131, 1138, 1168, 1169, 1131,
+     1138, 1131, 1139, 1131, 1140, 1147, 1131, 1131, 1139, 1131,
+
+     1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147,
+     1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131,
+     1131, 1131, 1140, 1147, 1131, 1140, 1140, 1140, 1140, 1131,
+        0, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131
+    } ;
+
+static yyconst flex_int16_t yy_nxt[4102] =
+    {   0,
+       14,   15,   16,   15,   17,   18,   14,   19,   20,   21,
+       22,   23,   24,   25,   24,   26,   24,   27,   28,   29,
+       29,   29,   29,   29,   29,   29,   29,   29,   29,   30,
+       31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
+       42,   49,   50,   51,   52,   42,   53,   42,   42,   54,
+       24,   24,   42,   35,   36,   37,   38,   39,   40,   41,
+       42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
+       50,   51,   52,   42,   53,   42,   42,   54,   14,   55,
+       56,   57,   58,  222,   69,   68,   69,   70,   72,   76,
+
+       77,   76, 1094,   74,   78,   77,   78,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   59,   75,  205,   80,
+     1092,   73,  222,  208,   60,   61,  205,  223,   62,   70,
+       63,   71,   74,   81,   83,   74,   87,   74,   74,   91,
+       82,   64,   65,  691, 1070,   75,   92,   93,   80,   75,
+       73,   75,   75,   60,   61,  223,  225,   62,   70,   63,
+       71,   81,   83,   96,   74,  111,   74,   74,   84,   64,
+       65,  209,   74,   88,   74,   74,   94,   75,  226,   75,
+       75,   97,   85,  255,   74,  225,   75,   89,   75,   75,
+       95,  227,  107,   83,  239,   74, 1070,   84,   75,  209,
+
+      624,   74,   88,   74,   74,   94,  226,   74,  625,   75,
+       85,   74,  255,   74,   75,   89,   75,   75,   95,   74,
+      227,   75,  239, 1065,   74,   75,   75,   78,   77,   78,
+       76,   77,   76,   75,  240,  247,   74,   75,  248,  228,
+       74,  179,  206,  205,  206,  112, 1030,  179,   74,   75,
+       98,   74,   98,   75,   78,   77,   78,  224,   77,  224,
+     1027,   75,  240,  247,  963,   75,  248,  228,   99,   99,
+       99,   99,   99,   99,   99,   99,   99,   99,   74,  207,
+       74,  114,  115,  100,  261,  116,  116,  101,   74,  102,
+      212,  117,   75,   75,  103,  142,  104,  105,  118,  119,
+
+      121,  922,   75,  263,   87,  190,  106,   74,  207,   87,
+      114,  115,  100,  261,  116,  116,  101,   74,  102,  117,
+       75,  253,  103,  142,  104,  105,  118,  119,  121,   87,
+       75,  120,  263,  116,  106,  108,  116,  109,  109,  109,
+      109,  109,  109,  109,  109,  109,  109,  121,   83,  253,
+      121,   91,  511,  230,  512,  110,  110,   74,   92,   93,
+      120,  229,  116,  254,  256,  116,  245,  212,  110,  260,
+      262,   75,  268,  116, 1131,  121,  246,  175,  121,  127,
+      116,  230,  146,  128,  110,  110,   74,  121, 1131,  129,
+      229,  254,  256,  130,  121,  245,  110,  260,  262,   75,
+
+      122,  268,  116, 1131,  246,  116,  116,  123,  127,  116,
+      146,  124,  128,  212,  125,  121, 1131,  129,   91,  121,
+      121,  130,  121,  190,  126,   92,   93,  179,  190,  122,
+       78,   77,   78,  179,  116,  116,  123,  143,   87,  124,
+      275,  147,  125,   87,  144,  145,  116,  121,  121,  148,
+       83,  121,  126,  116,  753,  149,  211,  212,  211,  131,
+      121,  132,  133,  754,  134,  135,  143,  121,  213,  275,
+      147,  136,  144,  145,  264,  116,  241,   82,  148,  121,
+      795,  212,  116,  149,  366,  367,  366,  131,  121,  132,
+      133,  242,  134,  135,  214,  121,  259,  162,  116,  136,
+
+      116,  190,  264,  137,  762,  241,  138,  139,  215,  140,
+      150,  753,  121,  260,  121,  141,  271,  255,  151,  242,
+      754,  113,  152,  214,  153,  259,  162,  116,  257,  116,
+      154,  698,  137,  243,  138,  139,  215,  140,  258,  150,
+      121,  260,  121,  141,  271,  116,  255,  151,  244,  113,
+      152,  158,  153,  155,  272,  156,  116,  257,  154,  121,
+      157,  116,  243,  273,  274,  159,  258,  276,  160,  172,
+      121,  161,  179,   87,  116,  121,  244,  534,  179,  277,
+      158,  155,  272,  156,  534,  116,  278,  121,  157,  282,
+      116,  273,  274,  159,   91,  276,  160,  172,  121,  161,
+
+      163,   92,   93,  121,  164,  116,  169,  277,  165,  643,
+      116,  116,  173,  170,  278,  635,  166,  282,  285,  167,
+      168,  286,  174,  171,  121,  121,  378,   77,  378,  163,
+      560,  559,  295,  164,  116,  169,  287,  165,  290,  116,
+      116,  173,  170,  237,  166,  196,  285,  167,  168,  286,
+      174,  171,  121,  121,  176,   77,  177,  178,  186,  187,
+      190,  295,  179,  557,  287,  191,  290,  511,  283,  512,
+      296,  237,  197,  556,  284,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  297,  198,  298,  310,  180,
+      181,  116,   74,  182,  116,  183,  283,  192,  296,  172,
+
+      200,  197,  284,  142,  203,  121,  184,  185,  121,  212,
+      299,  193,  534,  297,  198,  190,  298,  310,  180,  181,
+      116,   74,  182,  116,  183,  300,  192,  172,  200,  510,
+      400,  142,  203,  121,  184,  185,  121,  143,  299,  193,
+      194,  232,  233,  232,  144,  201,  179,  396,  395,  234,
+      235,  121,  394,  300,  108,  393,  195,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  143,  238,  238,  288,
+       91,  288,  144,  201,  110,  110,   74,   92,   93,  121,
+      238,  301,  265,  266,  302,  303,  304,  110,  267,  307,
+       75,  313,  212,  651,  319,  652,  238,  238,  320,  212,
+
+      323,  269,  236,  110,  110,   74,  270,  330,  238,  301,
+      265,  266,  302,  303,  304,  110,  267,  307,   75,  199,
+      313,  289,  319,  127,  116,  205,  320,  128,  323,  190,
+      269,  236,  190,  129,  344,  270,  330,  130,  121,  308,
+      169,  190,  309,  279,  321,  116,  291,  170,  199,  289,
+      280,  322,  127,  116,  281,  331,  128,  171,  292,  121,
+      293,  129,  344,  294,  202,  130,  121,  308,   87,  169,
+      309,   87,  279,  321,  116,  291,  170,   83,  280,  322,
+      205,  651,  281,  652,  331,  171,  292,  121,  293,  921,
+     1131,  294,  202,  210,  211,  212,  211,  210,  210,  210,
+
+      216,  210,  210,  210,  210,  210,  210,  210,  210,  210,
+      210,  210,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  210,  210,  210,  210,  210,  197,  217,  217,
+      217,  217,  218,  217,  123,  217,  217,  217,  219,  217,
+      217,  198,  217,  217,  217,  217,  220,  217,  217,  217,
+      217,  221,  217,  210,  210,  217,  197,  217,  217,  217,
+      217,  218,  217,  123,  217,  217,  219,  217,  217,  198,
+      217,  217,  217,  217,  220,  217,  217,  217,  217,  221,
+      217,  210,   98,  251,   98,  251,   68,  305,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  311,  366,
+
+      367,  366,  306,  345,  312,  332,  667,  326,  667,  328,
+      333,  335, 1131,  329,  334,  100,  305,  347,  327,  101,
+      343,  102,  205,  669,  355,  669,  103,  311,  104,  105,
+      306,  345,  312,  314,  332,  315,  326,  328,  106,  333,
+      335,  329, 1131,  334,  100,  347,  327, 1131,  101,  343,
+      102,  316,  317,  355,  103,  318,  104,  105,  337,  358,
+      338, 1131,  314,  190,  315, 1131,  106,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  324,  341,  316,
+      317,  223,  925,  318,  362,  110,  110,  358,  346,  190,
+      359,  325,  342,  190,  260,  351, 1131,  233,  110,  361,
+
+     1131,  205,  212, 1131,  385,  235,  324,  341, 1131,  223,
+      339,  186,  348,  362,  110,  110,  346,  205,  359,  325,
+      342,  352,  260, 1131,  351, 1131,  110,  361,  349,  349,
+      349,  349,  349,  349,  349,  349,  349,  349,  339,  350,
+      262,  770,  353,  771,  390,  179,  209,  356,  376,  363,
+      352,  369,  377, 1131, 1131,  349,  349,  349,  349,  349,
+      349,  349,  349,  349,  349,  350,  265,  357,  262,  212,
+      353,  179,  267,  390,  209,  356,  376, 1131,  363,  369,
+      377,  349,  349,  349,  349,  349,  349,  349,  349,  349,
+      349,  350,  205,  379,  265,  357,  212,  179, 1131,  391,
+
+      267,  368,  206,  205,  206,  108,  291,  354,  354,  354,
+      354,  354,  354,  354,  354,  354,  354,  380,  292,  399,
+      293,  379,   83,  360,   87,  110,  110,  364,  370,  371,
+      368,  375, 1131, 1131,  408,  291,  233,  392,  110,  207,
+       87, 1131,   83,  385,  235,  380,  292,  399,  293, 1131,
+      770,  360,  771, 1131,  110,  110,  364,  370,  371, 1131,
+      375,  397,  381,  408, 1131,  392,  110,  383,  207,  365,
+      365,  212,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  365,  371,  371,
+      381,  382,  384,  401,  398,  383,  404,  405,  365,  365,
+
+      365,  365,  365,  373,   91,  374,  232,  233,  232,  406,
+      407,   92,   93,  409,  234,  235, 1131,  371,  371,  382,
+      384,  401,  398, 1131,  404,  405,  232,  233,  232,  365,
+      365,  373, 1131,  374,  234,  235,   91,  406,  407, 1131,
+      388,  409,  388,   92,   93,  389,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  410,  387,  365,  365,  365,
+      212,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  411,  412,  386,
+      547,   77,  547,  410,  387, 1131, 1131,  365,  365,  365,
+      365,  365,  372,  252,  252,  252,  252,  252,  252,  252,
+
+      252,  252,  252,  413,  414,  411,  412,  386,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  365,  365,
+      402,  372,  402,  686,   77,  686, 1131, 1131,  417,  419,
+      403,  413,  414,  415,  420,  421,  416, 1131,  422,  423,
+      424,  425,  426, 1131, 1131,  418,  365,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  417,  419,  439,
+      444,  415,  420,  421,  416,  238,  238,  422,  423,  424,
+      425,  426,  437,  418,  437,  445,  446,  440,  238,  440,
+     1131, 1131,  442,  443,  447,  448,  450,  448,  439,  444,
+      451, 1131,  453,  454,  238,  238,  455,  456,  288,  457,
+
+      288,  460, 1131,  438,  445,  446,  238,  427,  441,  427,
+      442,  443,  447,  458,  450,  470,  449, 1131,  469,  451,
+      453,  454, 1131,  471,  455,  456,  459,  457,  474, 1131,
+      460,  461,  472,  461,  472, 1131,  475,  465,  428,  465,
+      476,  462,  458,  429,  470,  430,  469,  466,  431, 1131,
+      452,  471,  432,  478,  459,  433,  477,  474,  434,  435,
+      479, 1131,  436,  473,  475,  480,  481,  484,  476,  485,
+      488,  482,  429,  489,  430,  463,  490,  431,  452,  483,
+      432,  467,  478,  433,  477,  464,  434,  435,  491,  479,
+      436,  468,  486,  480,  481,  492,  484,  485,  488,  482,
+
+      487,  489,  493,  463,  490,  494,  495,  483,  496,  467,
+      497,  498,  499,  464,  502,  503,  500,  491,  500,  468,
+      504,  486,  505,  506,  492,  507,  501,  508,  487,  509,
+      346,  493,  513,  494,  514,  495,  496,  515,  497,  498,
+      499,  516,  517,  502,  503,  518,  519,  190,  504, 1131,
+      505,  506, 1131,  507,  190,  508,  205,  509,  346,  511,
+      513,  520,  514,  190, 1131,  515,  527,  528,  530,  516,
+      517,  417,  531,  518,  545,  519,  212,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,  529,  212,
+      524,  533,  523,  179,  535,  527,  528,  530,  371, 1131,
+
+      417,  531,  545,  521,  521,  521,  521,  521,  521,  521,
+      521,  521,  521,  522,  212,  525,  529,  212,  524,  179,
+      533,  523,  546,  535,  548,   87, 1131,  371,  539,  521,
+      521,  521,  521,  521,  521,  521,  521,  521,  521,  190,
+     1131,  532,  371,  525,  522,  536,  205,  536,   83,  927,
+      179,  546,  548,  541,  459,  540,  539,  538,  108,  371,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  526,
+      532,  371,  371,  549,   87,  552,   83,  542,  110,  110,
+     1131,  541,  459,  371,  540,  538,  537,  562,  371,  233,
+      558,  110,  543,  561,  544,  550,  385,  235,  667, 1029,
+
+      667,  371,  549,  552, 1131,  542,   91,  110,  110,  551,
+      553, 1131,  371,   92,   93,  537,  562,   91,  558,  110,
+      543,  561,  544,  550,   92,   93,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  389,  563,  564,  551,  553,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  565,  402,  555,  566, 1131,  554,  567, 1131,  568,
+      403,  569,  570,  571,  572,  563,  564,  573,  574,  575,
+      576,  577,  578,  589,  578,  590,  591, 1131,  592,  565,
+      593,  596,  555,  566,  554,  597,  567,  568,  594,  569,
+      570,  598,  571,  572,  599,  573,  574,  575,  576,  577,
+
+      437,  589,  437,  590,  595,  591,  592,  602,  593,  596,
+      440,  605,  440,  579,  597,  606,  603,  594,  603,  598,
+      607,  448,  599,  448,  212,  608,  609,  580,  610, 1131,
+      613,  438,  595,  611,  612,  602,  614,  616,  617,  605,
+      619,  441,  579,  615,  606,  618,  621,  604,  620,  607,
+     1131,  622,  449,  608,  609,  580,  427,  610,  427,  613,
+      623,  611,  612, 1131,  629,  614,  616,  617,  461,  619,
+      461,  615,  465,  618,  465,  621,  620,  627,  462,  622,
+      632,  472,  466,  472, 1033,  628,  630,  428,  623,  631,
+      633,  624,  581,  629,  582,  634,  640,  583,  645,  625,
+
+      636,  584, 1131,  637,  585,  627,  638,  586,  587,  632,
+      639,  588,  473,  628,  630, 1131, 1131,  631,  633, 1131,
+      646,  581,  646,  582,  634,  640,  583,  645,  636,  584,
+      626,  637,  585,  644,  638,  586,  587, 1131,  639,  588,
+      600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
+      600,  647,  600,  600,  600,  600,  600,  600,  600,  626,
+      648,  644,  649,  650,  641,  500,  641,  500,  653,  600,
+      600,  600,  600,  600,  642,  501,  654,  655,  656,  657,
+      658,  190,  190,  669,  205,  669,  190, 1131,  667,  648,
+      667,  649,  650,  651,  668,  659,  666,  653,  701,  205,
+
+      600,  600,  571,  212,  654,  670,  655,  656,  657,  658,
+      205,  660,  660,  660,  660,  660,  660,  660,  660,  660,
+      660,  661,  664,  668,  666,  684,  701,  179,  600,  703,
+      662,  571,  663,  675,  670, 1131, 1131,  660,  660,  660,
+      660,  660,  660,  660,  660,  660,  660,  661, 1131,  212,
+      212,  664,  679,  179,  684,  676,  705,  703,  662, 1050,
+      663,  675, 1131,  660,  660,  660,  660,  660,  660,  660,
+      660,  660,  660,  661,  614,  536,  205,  536, 1131,  179,
+      679,  615,  687,  676,  705,  671,  678,  108,  371,  665,
+      665,  665,  665,  665,  665,  665,  665,  665,  665,  677,
+
+      672, 1131,  672,  614,   87,   83,  680,  110,  110,  615,
+      673,  687,  699,  671,  674,  678,  537,  371,  371, 1131,
+      110,  371,  681,   91,  371,  682,  700,  677,  683,  704,
+       92,   93,  706,  712,  680,   91,  110,  110,  689,  713,
+      692,  699,  696,  697,  707,  537,  708,  371,  110,  709,
+      371,  681,  710,  371,  682,  700,  711,  683,  704,  694,
+     1131,  706,  712,  718,  770,  186,  775,  689,  713,  692,
+     1131,  578,  707,  578,  708, 1131,  641,  709,  641,  716,
+      710,  717, 1131,  719,  711,  720,  642,  721,  694,  685,
+      685,  718,  685,  685,  685,  685,  685,  685,  685,  685,
+
+      685,  685,  685,  685,  685,  685,  685,  685,  716,  722,
+      717,  719,  714,  723,  720,  721,  725,  726,  685,  685,
+      685,  685,  685,  727,  728, 1131,  715,  729,  730,  724,
+      731, 1131,  732,  733,  734,  739,  735,  722,  735, 1131,
+      737,  714,  723,  603,  725,  603,  726,  738,  742,  685,
+      685,  727,  740,  728,  715,  729,  730,  724,  741,  731,
+      732,  743,  733,  734,  739,  744,  745,  736,  737,  746,
+      747, 1131,  748,  749,  604,  738,  742,  685,  750,  751,
+      752,  740,  755, 1131,  756,  757,  758,  741,  759,  760,
+      743,  761,  766,  744,  745,  763,  764,  765,  746,  747,
+
+      748,  767,  749,  768,  769,  646,  750,  646,  751,  752,
+      772,  755,  756,  773,  757,  758,  759,  774,  760,  190,
+      761,  766,  190,  763,  764,  765,  779,  780,  669,  767,
+      669,  768,  769,  672,  781,  672,  647,  782,  672,  772,
+      672,  205,  773,  673,  371,  774,  205,  674,  673,  674,
+      371,  674,  674,  212,  212,  779,  780,  801,  777,  776,
+       91, 1131,  781,  674,   91,  371,  782,  798,  799,  788,
+       91,   92,   93,  371,  802,  803, 1131,   92,   93,  371,
+      770,  833,  771,  833,  190,  801,  783,  777,  776,  179,
+      785,  834,  784,  787,  371,  179, 1131,  804,  788,  805,
+
+      806,  807,  802,  108,  803,  109,  109,  109,  109,  109,
+      109,  109,  109,  109,  109,  783,  808, 1131,  809,  785,
+      784,  810,  787,  110,  110,  804,  814,  805,  806,  807,
+      815,  816, 1131,  817,  818, 1131,  110,  851, 1131,  851,
+      770,  864,  770,  864, 1093,  808,  809,  852, 1131,  864,
+      810,  864,  110,  110,  811,  814,  811,  819,  820,  815,
+      816,  817,  821,  818,  110,  786,  786,  212,  786,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  786,  786,  822,  819,  820,  823,  824,  812,
+      826,  821,  825,  827,  786,  786,  786,  786,  786,  828,
+
+      829, 1131,  813,  830,  831,  735,  832,  735,  205,  835,
+      836,  837,  822,  838, 1131,  839,  823,  824,  812,  826,
+      825,  840,  827,  841,  844,  786,  786,  828,  846,  829,
+      813,  830,  831, 1131, 1131,  832,  736,  835, 1131,  836,
+      837,  845,  838,  839,  847,  770,  186,  775,  833,  840,
+      833,  841,  844,  786,  791,   77,  791,  846,  834,  792,
+      792,  842,  792,  842, 1131, 1131,  792,  792, 1095,  845,
+      792, 1131,  847,  792,  792,  792,  792,  792,  792,  792,
+      792,  792,  790,  790,  190,  790,  790,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  790,  790,
+
+      790,  848,  849,  205,  850,  853, 1131,  856,  858,  843,
+      857,  790,  790,  790,  790,  790,  854,  859,  854,  862,
+      865,  860,  205,  212,  863,  371,  791,   77,  791,  848,
+      873,  849,  850,  879,  853,  856,  858,  843,  874,  857,
+      866, 1131,  790,  790,  875,  876,  859,  877,  862,  865,
+      860,  855,  863,  878,  371,   91,  882,   91,  867,  873,
+      869,  879,   92,   93,   92,   93,  864,  874,  864,  866,
+      790, 1131, 1131,  875,  876, 1131,  877,  811, 1131,  811,
+      855,  871,  878,  883,  882,  872,  884,  867,  885,  869,
+      868,  868,  212,  868,  868,  868,  868,  868,  868,  868,
+
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  886,
+      871,  883,  880,  888,  872,  884,  885,  887,  889,  868,
+      868,  868,  868,  868,  890,  881,  891, 1131,  892,  893,
+      894,  895,  896, 1131,  897,  898,  899,  908,  886,  900,
+      212,  880,  888,  906,  907,  887,  842,  889,  842,  910,
+      868,  868,  890,  881,  911,  891,  892,  893,  894,  895,
+      912,  896,  897,  913,  898,  899,  908,  900,  902,  903,
+      902,  906,  907,  851,  914,  851,  904,  910,  868,  905,
+      915,  917,  911,  852,  854,  918,  854,  919,  912,  920,
+      205,  924,  913,  923,  909,  371,  928, 1131,  929,  930,
+
+     1096,  931,  932,  914,  933,  934,  935,  936,  915,  937,
+      917,  938, 1131,  939,  918,  919,  940,  944,  920,  916,
+      924,  923,  909,  941,  371,  928,  929,  942,  930,  931,
+      932,  943,  933,  934,  935,  936,  945,  937,  950,  926,
+      938,  939,  946,  947,  948,  940,  944,  949,  916,  951,
+      952,  941,  902,  903,  902,  942,  953,  903,  953,  943,
+      904,  960, 1131,  905,  945,  961,  950,  926, 1131,  959,
+      964,  946,  947,  948,  962,  965,  949,  951,  952,  902,
+      903,  902,  966,  955,  956,  955,  967,  904,  968,  960,
+      905,  957,  969,  961,  958,  902,  903,  902,  959,  964,
+
+      190,  971,  962,  904,  965,  972,  905,  205,  205,  212,
+      966,  976,  977,  978,  967, 1131,  968,  979, 1131,  980,
+      981,  969,  982,  983,  984,  987,  985,  988,  985,  989,
+      971,  990,  991,  992,  972,  970,  986,  993,  994,  976,
+      977,  978,  995,  973,  975,  974,  979,  980, 1131,  981,
+      982, 1131,  983,  984,  987,  999,  988,  998,  989,  990,
+      991,  992, 1131, 1131,  970,  993,  994,  996,  903,  996,
+     1001,  995,  973,  975,  974,  955,  956,  955,  190,  955,
+      956,  955, 1000,  957,  999,  998,  958,  957, 1002,  205,
+      958,  997,  956,  997, 1003,  955,  956,  955, 1001,  904,
+
+     1004,  212,  905,  957, 1006,  205,  958,  955,  956,  955,
+     1010, 1000, 1011, 1013, 1011,  957, 1014, 1002,  958, 1131,
+     1015, 1016, 1012, 1003, 1005,  985,  985,  985,  985, 1004,
+     1017, 1018, 1006, 1019, 1007,  986,  986, 1008, 1021, 1010,
+     1020, 1013, 1022,  205,  205, 1014, 1131, 1009, 1015, 1025,
+     1016, 1131, 1005, 1023,  903, 1023, 1026, 1028, 1017, 1018,
+     1036, 1019, 1007, 1039, 1037, 1038, 1008, 1021, 1020, 1040,
+     1041, 1022, 1024,  903, 1024, 1009, 1042, 1032, 1025, 1031,
+      904,  205, 1011,  905, 1011, 1026, 1028, 1034, 1036, 1034,
+     1045, 1039, 1012, 1037, 1038, 1046,  190, 1040, 1047, 1041,
+
+     1035, 1049, 1035,  212, 1042, 1056, 1032, 1055, 1031, 1043,
+      903, 1043, 1044,  903, 1044, 1131, 1057, 1051, 1035, 1045,
+      904, 1058, 1060,  905, 1046, 1034, 1047, 1034, 1063, 1049,
+     1059,  190, 1053, 1056, 1053,  212, 1055, 1064, 1035,  205,
+     1035, 1048, 1073, 1054, 1057, 1035, 1051, 1035, 1052, 1075,
+     1058, 1060, 1061,  903, 1061, 1067, 1035, 1063, 1059, 1062,
+      903, 1062, 1053, 1035, 1053, 1064, 1072,  904, 1074, 1048,
+      905, 1073, 1079, 1054, 1068,  205, 1052, 1066, 1075, 1080,
+     1081, 1071, 1131, 1067, 1078,  903, 1078,  190,  212, 1083,
+     1131, 1086,  904, 1131, 1072,  905, 1074, 1087, 1131, 1090,
+
+     1079,  190,  205, 1068,  190, 1066, 1131, 1080, 1081, 1071,
+     1076,  903, 1076,  205, 1131, 1077, 1077, 1083, 1077, 1086,
+     1097, 1084, 1077, 1077, 1091, 1087, 1077, 1090, 1098, 1077,
+     1077, 1077, 1077, 1077, 1077, 1077, 1077, 1077, 1082, 1085,
+     1076,  903, 1076,  902,  903,  902, 1131, 1100, 1097, 1084,
+     1103,  904,  212, 1091,  905, 1099, 1108, 1098, 1101,  205,
+      212,  205, 1113, 1131,  190, 1131, 1082, 1085,  902,  903,
+      902, 1104,  205, 1088, 1088, 1100, 1089,  190, 1103,  905,
+     1088, 1088,  212, 1099, 1088, 1108, 1101, 1088, 1088, 1088,
+     1088, 1088, 1088, 1088, 1088, 1088,  902,  903,  902, 1104,
+
+      955,  956,  955, 1102,  904, 1105,  190,  905,  957, 1106,
+     1112,  958, 1109, 1107,  212, 1115, 1116,  212, 1110, 1119,
+     1120, 1119,  205, 1117, 1121, 1122, 1121, 1124, 1125, 1124,
+      205, 1102,  205, 1105, 1119, 1120, 1119, 1106, 1111, 1112,
+     1109,  205, 1107, 1115, 1116, 1131, 1114, 1110, 1121, 1122,
+     1121, 1117, 1124, 1125, 1124, 1129, 1130, 1129, 1129, 1130,
+     1129, 1131, 1131, 1131, 1127, 1131, 1126, 1111, 1118, 1131,
+     1131, 1123, 1131, 1131, 1131, 1114, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1128, 1127, 1131, 1126, 1118, 1131, 1131, 1123,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1128,   66,   66,   66,   66,   66,   66,   66,   66,   66,
+       66,   66,   66,   66,   67,   67,   67,   67,   67,   67,
+       67,   67,   67,   67,   67,   67,   67,   79, 1131,   79,
+       79,   79,   79,   79,   79,   79,   79,   79,   79,   79,
+       82,   82,   82,   82,   82,   82,   82,   82,   82,   82,
+       82,   82,   82,   86,   86,   86,   86,   86,   86,   86,
+       86,   86,   86,   86,   86,   86,   90,   90,   90,   90,
+       90,   90,   90,   90,   90,   90,   90,   90,   90,  113,
+
+      113,  113,  113,  113,  113,  113,  113,  113,  189,  189,
+      189,  189,  189,  189,  189,  189,  189,  189,  189,  189,
+      189,  204,  204,  204,  204,  204,  204,  204,  204,  204,
+      204,  204,  204,  204,  210,  210,  210,  210,  210, 1131,
+      210,  210,  210, 1131,  210, 1131,  210,  231,  231,  231,
+      231,  231,  231,  231,  231,  231,  231,  231,  231,  231,
+       99, 1131, 1131, 1131, 1131, 1131, 1131, 1131,   99,  249,
+      249, 1131,  249,  249, 1131,  249, 1131, 1131,  249,  249,
+     1131,  249,  336,  336,  336,  336,  340,  340,  340,  340,
+      340,  340,  340,  340,  340,  340,  340,  340,  340,  365,
+
+      365,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  371,  371,  371,  371,  371,  371,  371,  371,
+      371,  371,  371,  371,  371,  601,  601,  601, 1131,  601,
+      601,  601,  601,  601,  601,  601,  601,  601,  685, 1131,
+      685,  685,  685,  685,  685,  685,  685,  685,  685,  685,
+      685,  688, 1131,  688,  688,  688,  688,  688,  688,  688,
+      688,  688,  688,  688,  690,  690,  690,  690,  690,  690,
+      690,  690,  690,  690,  690,  690,  690,  693,  693,  693,
+      693,  693,  693,  693,  693,  693,  693,  693,  693,  693,
+      695,  695,  695,  695,  695,  695,  695,  695,  695,  695,
+
+      695,  695,  695,  702, 1131,  702,  702,  702,  702,  702,
+      702,  702,  702,  702,  702,  702,  778,  778,  778,  778,
+      778,  778,  778,  778,  778,  778,  778,  778,  778,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  789,  789,  789,  789,  789,  789,  789,  789,
+      789,  789,  789,  789,  789,  790, 1131,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  793, 1131,
+      793,  793,  793,  793,  793,  793,  793,  793,  793,  793,
+      793,  794,  794,  794,  794,  794,  794,  794,  794,  794,
+      794,  794,  794,  794,  796,  796,  796,  796,  796,  796,
+
+      796,  796,  796,  796,  796,  796,  796,  797,  797,  797,
+      797,  797,  797,  797,  797,  797,  797,  797,  797,  797,
+      800, 1131,  800,  800,  800,  800,  800,  800,  800,  800,
+      800,  800,  800,  861,  861,  861,  861,  861,  861,  861,
+      861,  861,  861,  861,  861,  861,  868,  868,  868,  868,
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  870,
+      870,  870,  870,  870,  870,  870,  870,  870,  870,  870,
+      870,  870,  901,  901,  901,  901,  901,  901,  901,  901,
+      901,  901,  901,  901,  901,  954,  954,  954,  954,  954,
+      954,  954,  954,  954,  954,  954,  954,  954, 1069, 1069,
+
+     1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069,
+     1069,   13, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
+    } ;
+
+static yyconst flex_int16_t yy_chk[4102] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
+        2,    2,    2,   74,    8,    8,    8,    8,   10,   15,
+
+       15,   15, 1083,   14,   16,   16,   16,    2,    2,    2,
+        2,    2,    2,    2,    2,    2,    2,   14,   70,   17,
+     1081,   10,   74,   70,    2,    2,   71,   75,    2,    8,
+        2,    8,   14,   17,   18,   19,   21,   15,   20,   22,
+      551,    2,    2,  551, 1069,   14,   22,   22,   17,   19,
+       10,   15,   20,    2,    2,   75,   80,    2,    8,    2,
+        8,   17,   84,   23,   19,   30,   15,   20,   18,    2,
+        2,   71,   24,   21,   26,   30,   22,   19,   81,   15,
+       20,   25,   18,  116,   23,   80,   24,   21,   26,   30,
+       22,   84,   28,   85,  100,   31, 1051,   18,   23,   71,
+
+      624,   24,   21,   26,   30,   22,   81,   25,  624,   31,
+       18,   32,  116,   23,   24,   21,   26,   30,   22,   28,
+       84,   25,  100, 1047,   31,   32,   23,   56,   56,   56,
+       76,   76,   76,   28,  101,  105,   25,   31,  106,   85,
+       32,  179,   69,   69,   69,   33, 1006,  179,   28,   25,
+       27,   33,   27,   32,   77,   77,   77,   78,   78,   78,
+     1000,   28,  101,  105,  914,   33,  106,   85,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   34,   69,
+       33,   35,   35,   27,  120,   35,   41,   27,   27,   27,
+      868,   35,   34,   33,   27,   41,   27,   27,   35,   35,
+
+       41,  862,   27,  123,   89,  861,   27,   34,   69,  796,
+       35,   35,   27,  120,   35,   41,   27,   27,   27,   35,
+       34,  114,   27,   41,   27,   27,   35,   35,   41,   88,
+       27,   36,  123,   42,   27,   29,   36,   29,   29,   29,
+       29,   29,   29,   29,   29,   29,   29,   42,  794,  114,
+       36,   90,  337,   89,  337,   29,   29,   29,   90,   90,
+       36,   88,   42,  115,  117,   36,  104,  786,   29,  121,
+      122,   29,  126,   44,  109,   42,  104,   54,   36,   38,
+       38,   89,   44,   38,   29,   29,   29,   44,  109,   38,
+       88,  115,  117,   38,   38,  104,   29,  121,  122,   29,
+
+       37,  126,   44,  109,  104,   37,   54,   37,   38,   38,
+       44,   37,   38,  785,   37,   44,  109,   38,   92,   37,
+       54,   38,   38,  778,   37,   92,   92,  660,  777,   37,
+      186,  186,  186,  660,   37,   54,   37,   43,  693,   37,
+      132,   45,   37,  692,   43,   43,   45,   37,   54,   45,
+      690,   43,   37,   39,  625,   45,   72,   72,   72,   39,
+       45,   39,   39,  625,   39,   39,   43,   39,   72,  132,
+       45,   39,   43,   43,  124,   45,  102,  689,   45,   43,
+      689,  678,   39,   45,  211,  211,  211,   39,   45,   39,
+       39,  102,   39,   39,   72,   39,  119,   49,   49,   39,
+
+       40,  664,  124,   40,  635,  102,   40,   40,   72,   40,
+       46,  753,   49,  119,   40,   40,  128,  143,   46,  102,
+      753,   46,   46,   72,   46,  119,   49,   49,  118,   40,
+       46,  558,   40,  103,   40,   40,   72,   40,  118,   46,
+       49,  119,   40,   40,  128,   47,  143,   46,  103,   46,
+       46,   48,   46,   47,  129,   47,   48,  118,   46,   47,
+       47,   52,  103,  130,  131,   48,  118,  133,   48,   52,
+       48,   48,  661,  553,   47,   52,  103,  534,  661,  134,
+       48,   47,  129,   47,  519,   48,  135,   47,   47,  137,
+       52,  130,  131,   48,   95,  133,   48,   52,   48,   48,
+
+       50,   95,   95,   52,   50,   50,   51,  134,   50,  496,
+       53,   51,   53,   51,  135,  487,   50,  137,  139,   50,
+       50,  140,   53,   51,   53,   51,  224,  224,  224,   50,
+      401,  399,  146,   50,   50,   51,  141,   50,  144,   53,
+       51,   53,   51,   95,   50,   60,  139,   50,   50,  140,
+       53,   51,   53,   51,   55,   55,   55,   55,   57,   57,
+       58,  146,   55,  392,  141,   58,  144,  338,  138,  338,
+      147,   95,   60,  390,  138,   57,   57,   57,   57,   57,
+       57,   57,   57,   57,   57,  148,   60,  149,  159,   55,
+       55,   65,   55,   55,   62,   55,  138,   58,  147,   65,
+
+       62,   60,  138,   62,   65,   65,   55,   55,   62,  365,
+      150,   58,  362,  148,   60,  340,  149,  159,   55,   55,
+       65,   55,   55,   62,   55,  151,   58,   65,   62,  336,
+      247,   62,   65,   65,   55,   55,   62,   63,  150,   58,
+       59,   91,   91,   91,   63,   63,   59,  244,  243,   91,
+       91,   63,  242,  151,   59,  241,   59,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   63,   99,   99,  142,
+       94,  142,   63,   63,   59,   59,   59,   94,   94,   63,
+       99,  152,  125,  125,  153,  154,  155,   59,  125,  157,
+       59,  161,  213,  511,  163,  511,   99,   99,  164,  210,
+
+      166,  127,   94,   59,   59,   59,  127,  170,   99,  152,
+      125,  125,  153,  154,  155,   59,  125,  157,   59,   61,
+      161,  142,  163,   61,   61,  204,  164,   61,  166,  860,
+      127,   94,  189,   61,  182,  127,  170,   61,   61,  158,
+       64,  178,  158,  136,  165,   64,  145,   64,   61,  142,
+      136,  165,   61,   61,  136,  171,   61,   64,  145,   64,
+      145,   61,  182,  145,   64,   61,   61,  158,   87,   64,
+      158,   86,  136,  165,   64,  145,   64,   82,  136,  165,
+       67,  512,  136,  512,  171,   64,  145,   64,  145,  860,
+       13,  145,   64,   73,   73,   73,   73,   73,   73,   73,
+
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   98,  110,   98,  110,    7,  156,  110,  110,
+      110,  110,  110,  110,  110,  110,  110,  110,  160,  366,
+
+      366,  366,  156,  183,  160,  172,  528,  168,  528,  169,
+      173,  174,    0,  169,  173,   98,  156,  185,  168,   98,
+      181,   98,  866,  530,  196,  530,   98,  160,   98,   98,
+      156,  183,  160,  162,  172,  162,  168,  169,   98,  173,
+      174,  169,    0,  173,   98,  185,  168,    0,   98,  181,
+       98,  162,  162,  196,   98,  162,   98,   98,  176,  199,
+      176,    0,  162,  191,  162,    0,   98,  108,  108,  108,
+      108,  108,  108,  108,  108,  108,  108,  167,  180,  162,
+      162,  184,  866,  162,  203,  108,  108,  199,  184,  192,
+      200,  167,  180,  193,  167,  191,  176,  231,  108,  202,
+
+        0,  207,  215,    0,  231,  231,  167,  180,    0,  184,
+      176,  187,  187,  203,  108,  108,  184,  208,  200,  167,
+      180,  192,  167,    0,  191,  176,  108,  202,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  187,  176,  188,
+      197,  651,  193,  651,  239,  188,  207,  197,  222,  208,
+      192,  215,  223,    0,    0,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  194,  198,  198,  197,  214,
+      193,  194,  198,  239,  207,  197,  222,    0,  208,  215,
+      223,  194,  194,  194,  194,  194,  194,  194,  194,  194,
+      194,  195,  209,  225,  198,  198,  216,  195,    0,  240,
+
+      198,  214,  206,  206,  206,  195,  201,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  195,  226,  201,  246,
+      201,  225,  227,  201,  229,  195,  195,  209,  216,  221,
+      214,  221,    0,    0,  258,  201,  234,  240,  195,  206,
+      230,    0,  228,  234,  234,  226,  201,  246,  201,    0,
+      652,  201,  652,    0,  195,  195,  209,  216,  221,    0,
+      221,  245,  227,  258,    0,  240,  195,  229,  206,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  220,  219,
+      227,  228,  230,  248,  245,  229,  254,  255,  217,  217,
+
+      217,  217,  217,  219,  237,  220,  232,  232,  232,  256,
+      257,  237,  237,  259,  232,  232,    0,  220,  219,  228,
+      230,  248,  245,    0,  254,  255,  233,  233,  233,  217,
+      217,  219,    0,  220,  233,  233,  236,  256,  257,    0,
+      238,  259,  238,  236,  236,  238,  238,  238,  238,  238,
+      238,  238,  238,  238,  238,  260,  237,  217,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  218,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  261,  262,  236,
+      378,  378,  378,  260,  237,    0,    0,  218,  218,  218,
+      218,  218,  218,  251,  251,  251,  251,  251,  251,  251,
+
+      251,  251,  251,  263,  264,  261,  262,  236,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  218,  218,
+      253,  218,  253,  547,  547,  547,    0,    0,  266,  267,
+      253,  263,  264,  265,  268,  269,  265,    0,  270,  271,
+      272,  273,  274,    0,    0,  266,  218,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  266,  267,  277,
+      281,  265,  268,  269,  265,  250,  250,  270,  271,  272,
+      273,  274,  276,  266,  276,  282,  283,  278,  250,  278,
+        0,    0,  279,  279,  284,  285,  286,  285,  277,  281,
+      287,    0,  289,  290,  250,  250,  291,  292,  288,  293,
+
+      288,  295,    0,  276,  282,  283,  250,  275,  278,  275,
+      279,  279,  284,  294,  286,  299,  285,    0,  298,  287,
+      289,  290,    0,  300,  291,  292,  294,  293,  302,    0,
+      295,  296,  301,  296,  301,    0,  303,  297,  275,  297,
+      304,  296,  294,  275,  299,  275,  298,  297,  275,    0,
+      288,  300,  275,  306,  294,  275,  305,  302,  275,  275,
+      308,    0,  275,  301,  303,  309,  310,  312,  304,  313,
+      315,  311,  275,  316,  275,  296,  317,  275,  288,  311,
+      275,  297,  306,  275,  305,  296,  275,  275,  318,  308,
+      275,  297,  314,  309,  310,  319,  312,  313,  315,  311,
+
+      314,  316,  320,  296,  317,  321,  322,  311,  323,  297,
+      324,  325,  326,  296,  328,  329,  327,  318,  327,  297,
+      330,  314,  331,  332,  319,  333,  327,  334,  314,  335,
+      339,  320,  341,  321,  342,  322,  323,  343,  324,  325,
+      326,  344,  345,  328,  329,  346,  347,  352,  330,    0,
+      331,  332,    0,  333,  351,  334,  363,  335,  339,  348,
+      341,  348,  342,  353,    0,  343,  355,  356,  358,  344,
+      345,  357,  359,  346,  376,  347,  369,  348,  348,  348,
+      348,  348,  348,  348,  348,  348,  348,  349,  357,  869,
+      352,  361,  351,  349,  363,  355,  356,  358,  371,    0,
+
+      357,  359,  376,  349,  349,  349,  349,  349,  349,  349,
+      349,  349,  349,  350,  368,  353,  357,  370,  352,  350,
+      361,  351,  377,  363,  379,  383,    0,  371,  369,  350,
+      350,  350,  350,  350,  350,  350,  350,  350,  350, 1005,
+        0,  360,  372,  353,  354,  364,  364,  364,  381,  869,
+      354,  377,  379,  372,  360,  370,  369,  368,  354,  373,
+      354,  354,  354,  354,  354,  354,  354,  354,  354,  354,
+      360,  372,  374,  380,  384,  383,  382,  373,  354,  354,
+        0,  372,  360,  375,  370,  368,  364,  406,  373,  385,
+      398,  354,  374,  405,  375,  381,  385,  385,  653, 1005,
+
+      653,  374,  380,  383,    0,  373,  386,  354,  354,  382,
+      384,    0,  375,  386,  386,  364,  406,  387,  398,  354,
+      374,  405,  375,  381,  387,  387,  388,  388,  388,  388,
+      388,  388,  388,  388,  388,  388,  408,  410,  382,  384,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  411,  402,  387,  413,    0,  386,  414,    0,  415,
+      402,  416,  417,  418,  420,  408,  410,  421,  422,  423,
+      424,  425,  426,  429,  426,  430,  431,    0,  432,  411,
+      433,  435,  387,  413,  386,  436,  414,  415,  434,  416,
+      417,  439,  418,  420,  442,  421,  422,  423,  424,  425,
+
+      437,  429,  437,  430,  434,  431,  432,  444,  433,  435,
+      440,  446,  440,  426,  436,  447,  445,  434,  445,  439,
+      450,  448,  442,  448, 1009,  451,  452,  426,  454,    0,
+      457,  437,  434,  455,  456,  444,  458,  459,  460,  446,
+      464,  440,  426,  458,  447,  463,  468,  445,  467,  450,
+        0,  469,  448,  451,  452,  426,  427,  454,  427,  457,
+      470,  455,  456,    0,  480,  458,  459,  460,  461,  464,
+      461,  458,  465,  463,  465,  468,  467,  478,  461,  469,
+      483,  472,  465,  472, 1009,  479,  481,  427,  470,  482,
+      484,  475,  427,  480,  427,  485,  493,  427,  503,  475,
+
+      488,  427,    0,  489,  427,  478,  490,  427,  427,  483,
+      491,  427,  472,  479,  481,    0,    0,  482,  484,    0,
+      506,  427,  506,  427,  485,  493,  427,  503,  488,  427,
+      475,  489,  427,  499,  490,  427,  427,    0,  491,  427,
+      443,  443,  443,  443,  443,  443,  443,  443,  443,  443,
+      443,  506,  443,  443,  443,  443,  443,  443,  443,  475,
+      507,  499,  508,  509,  494,  500,  494,  500,  513,  443,
+      443,  443,  443,  443,  494,  500,  514,  515,  516,  517,
+      518,  523,  524,  655,  535,  655,  525,    0,  667,  507,
+      667,  508,  509,  520,  529,  520,  527,  513,  563, 1031,
+
+      443,  443,  529,  540,  514,  531,  515,  516,  517,  518,
+      537,  520,  520,  520,  520,  520,  520,  520,  520,  520,
+      520,  521,  525,  529,  527,  545,  563,  521,  443,  565,
+      523,  529,  524,  535,  531,    0,    0,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,    0,  538,
+      539,  525,  540,  522,  545,  537,  568,  565,  523, 1031,
+      524,  535,    0,  522,  522,  522,  522,  522,  522,  522,
+      522,  522,  522,  526,  532,  536,  536,  536,    0,  526,
+      540,  532,  548,  537,  568,  532,  539,  526,  541,  526,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  538,
+
+      533,    0,  533,  532,  552,  550,  541,  526,  526,  532,
+      533,  548,  561,  532,  533,  539,  536,  541,  542,    0,
+      526,  543,  542,  554,  544,  543,  562,  538,  544,  566,
+      554,  554,  569,  576,  541,  555,  526,  526,  550,  577,
+      552,  561,  555,  555,  570,  536,  571,  542,  526,  573,
+      543,  542,  574,  544,  543,  562,  575,  544,  566,  554,
+        0,  569,  576,  581,  659,  659,  659,  550,  577,  552,
+        0,  578,  570,  578,  571,    0,  641,  573,  641,  579,
+      574,  580,    0,  582,  575,  583,  641,  584,  554,  564,
+      564,  581,  564,  564,  564,  564,  564,  564,  564,  564,
+
+      564,  564,  564,  564,  564,  564,  564,  564,  579,  585,
+      580,  582,  578,  586,  583,  584,  587,  588,  564,  564,
+      564,  564,  564,  590,  592,    0,  578,  593,  594,  586,
+      595,    0,  596,  597,  598,  608,  599,  585,  599,    0,
+      602,  578,  586,  603,  587,  603,  588,  607,  613,  564,
+      564,  590,  610,  592,  578,  593,  594,  586,  611,  595,
+      596,  614,  597,  598,  608,  615,  616,  599,  602,  617,
+      618,    0,  619,  620,  603,  607,  613,  564,  621,  622,
+      623,  610,  626,    0,  627,  628,  630,  611,  632,  633,
+      614,  634,  639,  615,  616,  636,  637,  638,  617,  618,
+
+      619,  640,  620,  644,  645,  646,  621,  646,  622,  623,
+      654,  626,  627,  656,  628,  630,  632,  657,  633,  662,
+      634,  639,  663,  636,  637,  638,  666,  668,  669,  640,
+      669,  644,  645,  658,  670,  658,  646,  671,  672,  654,
+      672,  676,  656,  658,  681,  657,  675,  658,  672,  674,
+      683,  674,  672,  679,  677,  666,  668,  700,  663,  662,
+      694,    0,  670,  674,  695,  680,  671,  694,  694,  680,
+      696,  695,  695,  681,  701,  703,    0,  696,  696,  683,
+      771,  738,  771,  738, 1082,  700,  675,  663,  662,  665,
+      677,  738,  676,  679,  680,  665,    0,  704,  680,  706,
+
+      707,  708,  701,  665,  703,  665,  665,  665,  665,  665,
+      665,  665,  665,  665,  665,  675,  709,    0,  710,  677,
+      676,  711,  679,  665,  665,  704,  714,  706,  707,  708,
+      715,  717,    0,  719,  721,    0,  665,  762,    0,  762,
+      770,  781,  770,  781, 1082,  709,  710,  762,  770,  858,
+      711,  858,  665,  665,  712,  714,  712,  722,  723,  715,
+      717,  719,  724,  721,  665,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  682,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  725,  722,  723,  726,  727,  712,
+      729,  724,  728,  730,  682,  682,  682,  682,  682,  731,
+
+      732,    0,  712,  733,  734,  735,  737,  735, 1084,  739,
+      740,  741,  725,  742,    0,  743,  726,  727,  712,  729,
+      728,  745,  730,  746,  752,  682,  682,  731,  756,  732,
+      712,  733,  734,    0,    0,  737,  735,  739,    0,  740,
+      741,  755,  742,  743,  757,  775,  775,  775,  833,  745,
+      833,  746,  752,  682,  686,  686,  686,  756,  833,  686,
+      686,  751,  686,  751,    0,    0,  686,  686, 1084,  755,
+      686,    0,  757,  686,  686,  686,  686,  686,  686,  686,
+      686,  686,  699,  699,  776,  699,  699,  699,  699,  699,
+      699,  699,  699,  699,  699,  699,  699,  699,  699,  699,
+
+      699,  758,  759,  783,  760,  763,    0,  768,  773,  751,
+      772,  699,  699,  699,  699,  699,  767,  774,  767,  779,
+      782,  776,  784,  787,  780,  789,  791,  791,  791,  758,
+      802,  759,  760,  810,  763,  768,  773,  751,  803,  772,
+      783,    0,  699,  699,  804,  806,  774,  807,  779,  782,
+      776,  767,  780,  808,  789,  797,  812,  798,  784,  802,
+      787,  810,  797,  797,  798,  798,  864,  803,  864,  783,
+      699,    0,    0,  804,  806,    0,  807,  811,    0,  811,
+      767,  801,  808,  813,  812,  801,  815,  784,  816,  787,
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  788,
+
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  817,
+      801,  813,  811,  819,  801,  815,  816,  818,  820,  788,
+      788,  788,  788,  788,  821,  811,  822,    0,  823,  824,
+      825,  826,  827,    0,  828,  830,  831,  840,  817,  832,
+     1085,  811,  819,  835,  836,  818,  842,  820,  842,  843,
+      788,  788,  821,  811,  844,  822,  823,  824,  825,  826,
+      846,  827,  828,  847,  830,  831,  840,  832,  834,  834,
+      834,  835,  836,  851,  852,  851,  834,  843,  788,  834,
+      853,  855,  844,  851,  854,  856,  854,  857,  846,  859,
+      867,  865,  847,  863,  842,  870,  871,    0,  873,  874,
+
+     1085,  875,  876,  852,  878,  879,  880,  881,  853,  882,
+      855,  883,    0,  884,  856,  857,  885,  889,  859,  854,
+      865,  863,  842,  886,  870,  871,  873,  887,  874,  875,
+      876,  888,  878,  879,  880,  881,  890,  882,  896,  867,
+      883,  884,  892,  893,  894,  885,  889,  895,  854,  897,
+      899,  886,  901,  901,  901,  887,  903,  903,  903,  888,
+      901,  909,    0,  901,  890,  910,  896,  867,    0,  908,
+      915,  892,  893,  894,  913,  916,  895,  897,  899,  902,
+      902,  902,  917,  904,  904,  904,  918,  902,  919,  909,
+      902,  904,  920,  910,  904,  905,  905,  905,  908,  915,
+
+      921,  922,  913,  905,  916,  924,  905,  925,  926,  927,
+      917,  928,  929,  932,  918,    0,  919,  933,    0,  935,
+      936,  920,  937,  938,  939,  941,  940,  942,  940,  943,
+      922,  944,  945,  947,  924,  921,  940,  949,  951,  928,
+      929,  932,  952,  925,  927,  926,  933,  935,    0,  936,
+      937,    0,  938,  939,  941,  961,  942,  960,  943,  944,
+      945,  947,    0,    0,  921,  949,  951,  953,  953,  953,
+      965,  952,  925,  927,  926,  954,  954,  954,  970,  955,
+      955,  955,  963,  954,  961,  960,  954,  955,  966,  973,
+      955,  956,  956,  956,  967,  957,  957,  957,  965,  956,
+
+      969,  975,  956,  957,  971,  974,  957,  958,  958,  958,
+      976,  963,  977,  980,  977,  958,  981,  966,  958,    0,
+      982,  983,  977,  967,  970,  984,  985,  984,  985,  969,
+      987,  989,  971,  991,  973,  984,  985,  974,  994,  976,
+      992,  980,  995, 1008, 1007,  981,    0,  975,  982,  998,
+      983,    0,  970,  996,  996,  996,  999, 1001,  987,  989,
+     1013,  991,  973, 1016, 1014, 1015,  974,  994,  992, 1017,
+     1019,  995,  997,  997,  997,  975, 1021, 1008,  998, 1007,
+      997, 1032, 1011,  997, 1011,  999, 1001, 1012, 1013, 1012,
+     1025, 1016, 1011, 1014, 1015, 1026, 1029, 1017, 1027, 1019,
+
+     1012, 1030, 1012, 1033, 1021, 1037, 1008, 1036, 1007, 1023,
+     1023, 1023, 1024, 1024, 1024,    0, 1038, 1032, 1012, 1025,
+     1024, 1039, 1042, 1024, 1026, 1034, 1027, 1034, 1045, 1030,
+     1041, 1048, 1035, 1037, 1035, 1052, 1036, 1046, 1034, 1050,
+     1034, 1029, 1056, 1035, 1038, 1035, 1032, 1035, 1033, 1059,
+     1039, 1042, 1043, 1043, 1043, 1049, 1034, 1045, 1041, 1044,
+     1044, 1044, 1053, 1035, 1053, 1046, 1055, 1044, 1058, 1029,
+     1044, 1056, 1063, 1053, 1050, 1068, 1033, 1048, 1059, 1064,
+     1065, 1052,    0, 1049, 1062, 1062, 1062, 1066, 1071, 1067,
+        0, 1073, 1062,    0, 1055, 1062, 1058, 1074,    0, 1079,
+
+     1063, 1099, 1109, 1050, 1093, 1048,    0, 1064, 1065, 1052,
+     1061, 1061, 1061, 1095,    0, 1061, 1061, 1067, 1061, 1073,
+     1086, 1068, 1061, 1061, 1080, 1074, 1061, 1079, 1090, 1061,
+     1061, 1061, 1061, 1061, 1061, 1061, 1061, 1061, 1066, 1071,
+     1076, 1076, 1076, 1077, 1077, 1077,    0, 1094, 1086, 1068,
+     1099, 1077, 1096, 1080, 1077, 1093, 1104, 1090, 1095, 1101,
+     1102, 1105, 1109,    0, 1111,    0, 1066, 1071, 1078, 1078,
+     1078, 1100, 1113, 1078, 1078, 1094, 1078, 1103, 1099, 1078,
+     1078, 1078, 1106, 1093, 1078, 1104, 1095, 1078, 1078, 1078,
+     1078, 1078, 1078, 1078, 1078, 1078, 1088, 1088, 1088, 1100,
+
+     1089, 1089, 1089, 1096, 1088, 1101, 1107, 1088, 1089, 1102,
+     1108, 1089, 1105, 1103, 1110, 1111, 1112, 1114, 1106, 1115,
+     1115, 1115, 1117, 1113, 1116, 1116, 1116, 1118, 1118, 1118,
+     1123, 1096, 1126, 1101, 1119, 1119, 1119, 1102, 1107, 1108,
+     1105, 1127, 1103, 1111, 1112,    0, 1110, 1106, 1121, 1121,
+     1121, 1113, 1124, 1124, 1124, 1128, 1128, 1128, 1129, 1129,
+     1129,    0,    0,    0, 1126,    0, 1123, 1107, 1114,    0,
+        0, 1117,    0,    0,    0, 1110,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0, 1127, 1126,    0, 1123, 1114,    0,    0, 1117,
+
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+     1127, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132,
+     1132, 1132, 1132, 1132, 1133, 1133, 1133, 1133, 1133, 1133,
+     1133, 1133, 1133, 1133, 1133, 1133, 1133, 1134,    0, 1134,
+     1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
+     1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135,
+     1135, 1135, 1135, 1136, 1136, 1136, 1136, 1136, 1136, 1136,
+     1136, 1136, 1136, 1136, 1136, 1136, 1137, 1137, 1137, 1137,
+     1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1139, 1139,
+     1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139,
+     1139, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140,
+     1140, 1140, 1140, 1140, 1141, 1141, 1141, 1141, 1141,    0,
+     1141, 1141, 1141,    0, 1141,    0, 1141, 1142, 1142, 1142,
+     1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142,
+     1143,    0,    0,    0,    0,    0,    0,    0, 1143, 1144,
+     1144,    0, 1144, 1144,    0, 1144,    0,    0, 1144, 1144,
+        0, 1144, 1145, 1145, 1145, 1145, 1146, 1146, 1146, 1146,
+     1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1147,
+
+     1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147,
+     1147, 1147, 1148, 1148, 1148, 1148, 1148, 1148, 1148, 1148,
+     1148, 1148, 1148, 1148, 1148, 1149, 1149, 1149,    0, 1149,
+     1149, 1149, 1149, 1149, 1149, 1149, 1149, 1149, 1150,    0,
+     1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150,
+     1150, 1151,    0, 1151, 1151, 1151, 1151, 1151, 1151, 1151,
+     1151, 1151, 1151, 1151, 1152, 1152, 1152, 1152, 1152, 1152,
+     1152, 1152, 1152, 1152, 1152, 1152, 1152, 1153, 1153, 1153,
+     1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153,
+     1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154,
+
+     1154, 1154, 1154, 1155,    0, 1155, 1155, 1155, 1155, 1155,
+     1155, 1155, 1155, 1155, 1155, 1155, 1156, 1156, 1156, 1156,
+     1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1157,
+     1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157,
+     1157, 1157, 1158, 1158, 1158, 1158, 1158, 1158, 1158, 1158,
+     1158, 1158, 1158, 1158, 1158, 1159,    0, 1159, 1159, 1159,
+     1159, 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1160,    0,
+     1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160,
+     1160, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1162, 1162, 1162, 1162, 1162, 1162,
+
+     1162, 1162, 1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163,
+     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163,
+     1164,    0, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164,
+     1164, 1164, 1164, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
+     1165, 1165, 1165, 1165, 1165, 1165, 1166, 1166, 1166, 1166,
+     1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1167,
+     1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
+     1167, 1167, 1168, 1168, 1168, 1168, 1168, 1168, 1168, 1168,
+     1168, 1168, 1168, 1168, 1168, 1169, 1169, 1169, 1169, 1169,
+     1169, 1169, 1169, 1169, 1169, 1169, 1169, 1169, 1170, 1170,
+
+     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170,
+     1170, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int fortran__flex_debug;
+int fortran__flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *fortran_text;
+#line 1 "fortran.lex"
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+
+
+
+
+#line 44 "fortran.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * fortran_in;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_input = 1;
+int newlinef90 = 0;
+char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+#line 1826 "fortran.yy.c"
+
+#define INITIAL 0
+#define parameter 1
+#define character 2
+#define donottreat 3
+#define fortran77style 4
+#define fortran90style 5
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+   These are made visible to non-reentrant scanners for convenience. */
+
+int fortran_lex_destroy (void );
+
+int fortran_get_debug (void );
+
+void fortran_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE fortran_get_extra (void );
+
+void fortran_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *fortran_get_in (void );
+
+void fortran_set_in  (FILE * in_str  );
+
+FILE *fortran_get_out (void );
+
+void fortran_set_out  (FILE * out_str  );
+
+yy_size_t fortran_get_leng (void );
+
+char *fortran_get_text (void );
+
+int fortran_get_lineno (void );
+
+void fortran_set_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int fortran_wrap (void );
+#else
+extern int fortran_wrap (void );
+#endif
+#endif
+
+    static void yyunput (int c,char *buf_ptr  );
+    
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( fortran_text, fortran_leng, 1, fortran_out )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+		{ \
+		int c = '*'; \
+		yy_size_t n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( fortran_in )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( fortran_in ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, fortran_in))==0 && ferror(fortran_in)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(fortran_in); \
+			} \
+		}\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int fortran_lex (void);
+
+#define YY_DECL int fortran_lex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after fortran_text and fortran_leng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	if ( fortran_leng > 0 ) \
+		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
+				(fortran_text[fortran_leng - 1] == '\n'); \
+	YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+    
+#line 97 "fortran.lex"
+
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree)  BEGIN(fortran90style) ;
+
+#line 2021 "fortran.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! (yy_start) )
+			(yy_start) = 1;	/* first start state */
+
+		if ( ! fortran_in )
+			fortran_in = stdin;
+
+		if ( ! fortran_out )
+			fortran_out = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			fortran_ensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				fortran__create_buffer(fortran_in,YY_BUF_SIZE );
+		}
+
+		fortran__load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of fortran_text. */
+		*yy_cp = (yy_hold_char);
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = (yy_start);
+		yy_current_state += YY_AT_BOL();
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 1132 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 4012 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 101 "fortran.lex"
+{ return TOK_REAL8; }
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 102 "fortran.lex"
+{ return TOK_SUBROUTINE; }
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 103 "fortran.lex"
+{ return TOK_PROGRAM; }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 104 "fortran.lex"
+{ inallocate = 1; return TOK_ALLOCATE; }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 105 "fortran.lex"
+{ return TOK_NULLIFY; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 106 "fortran.lex"
+{ return TOK_NULL_PTR; }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 107 "fortran.lex"
+{ inallocate = 1; return TOK_DEALLOCATE; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 108 "fortran.lex"
+{ return TOK_RESULT; }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 109 "fortran.lex"
+{ return TOK_FUNCTION; }
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 110 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 111 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 112 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+	YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 113 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 114 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 115 "fortran.lex"
+{ pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+	YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 116 "fortran.lex"
+{ strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+	YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 122 "fortran.lex"
+{ return TOK_REWIND; }
+	YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 123 "fortran.lex"
+{ return TOK_IMPLICIT; }
+	YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 124 "fortran.lex"
+{ return TOK_NONE; }
+	YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 125 "fortran.lex"
+{ return TOK_CALL; }
+	YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 126 "fortran.lex"
+{ return TOK_TRUE; }
+	YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 127 "fortran.lex"
+{ return TOK_FALSE; }
+	YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 128 "fortran.lex"
+{ return TOK_POINT_TO; }
+	YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 129 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 130 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 131 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQV; }
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 132 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 133 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GT;  }
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 134 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GE;  }
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 135 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LT;  }
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 136 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LE;  }
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 137 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 138 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NE;  }
+	YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 139 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NOT; }
+	YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 140 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OR;  }
+	YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 141 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_XOR; }
+	YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 142 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_AND; }
+	YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 143 "fortran.lex"
+{ return TOK_MODULE; }
+	YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 144 "fortran.lex"
+{ return TOK_WHILE; }
+	YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 145 "fortran.lex"
+{ return TOK_CONCURRENT; }
+	YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 146 "fortran.lex"
+{ return TOK_ENDDO; }
+	YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 147 "fortran.lex"
+{ return TOK_PLAINDO;}
+	YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 148 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_REAL; }
+	YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 149 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+	YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 150 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+	YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 151 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+	YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 152 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+	YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 153 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+	YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 154 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+	YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 155 "fortran.lex"
+{ return TOK_COMPLEX; }
+	YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 156 "fortran.lex"
+{ return TOK_ALLOCATABLE; }
+	YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 157 "fortran.lex"
+{ return TOK_CLOSE; }
+	YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 158 "fortran.lex"
+{ return TOK_INQUIRE; }
+	YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 159 "fortran.lex"
+{ return TOK_DIMENSION; }
+	YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 160 "fortran.lex"
+{ return TOK_PAUSE; }
+	YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 161 "fortran.lex"
+{ return TOK_EQUIVALENCE; }
+	YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 162 "fortran.lex"
+{ return TOK_STOP; }
+	YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 163 "fortran.lex"
+{ return TOK_WHERE; }
+	YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 164 "fortran.lex"
+{ return TOK_ENDWHERE; }
+	YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 165 "fortran.lex"
+{ return TOK_ELSEWHEREPAR; }
+	YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 166 "fortran.lex"
+{ return TOK_ELSEWHERE; }
+	YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 167 "fortran.lex"
+{ return TOK_CONTAINS; }
+	YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 168 "fortran.lex"
+{ return TOK_ONLY; }
+	YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 169 "fortran.lex"
+{ return TOK_PARAMETER; }
+	YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 170 "fortran.lex"
+{ return TOK_RECURSIVE; }
+	YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 171 "fortran.lex"
+{ return TOK_COMMON; }
+	YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 172 "fortran.lex"
+{ return TOK_GLOBAL; }
+	YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 173 "fortran.lex"
+{ return TOK_EXTERNAL; }
+	YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 174 "fortran.lex"
+{ return TOK_INTENT; }
+	YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 175 "fortran.lex"
+{ return TOK_POINTER; }
+	YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 176 "fortran.lex"
+{ return TOK_OPTIONAL; }
+	YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 177 "fortran.lex"
+{ return TOK_SAVE; }
+	YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 178 "fortran.lex"
+{ pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+	YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 179 "fortran.lex"
+{ return TOK_TYPE; }
+	YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 180 "fortran.lex"
+{ return TOK_ENDTYPE; }
+	YY_BREAK
+case 76:
+YY_RULE_SETUP
+#line 181 "fortran.lex"
+{ if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+	YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 182 "fortran.lex"
+{ return TOK_OPEN; }
+	YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 183 "fortran.lex"
+{ return TOK_RETURN; }
+	YY_BREAK
+case 79:
+/* rule 79 can match eol */
+YY_RULE_SETUP
+#line 184 "fortran.lex"
+{ return TOK_EXIT; }
+	YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 185 "fortran.lex"
+{ return TOK_PRINT; }
+	YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 186 "fortran.lex"
+{ return TOK_PROCEDURE; }
+	YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 187 "fortran.lex"
+{ return TOK_READ; }
+	YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 188 "fortran.lex"
+{ return TOK_NAMELIST; }
+	YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 189 "fortran.lex"
+{ return TOK_WRITE; }
+	YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 190 "fortran.lex"
+{ return TOK_FLUSH; }
+	YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 191 "fortran.lex"
+{ return TOK_TARGET; }
+	YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 192 "fortran.lex"
+{ return TOK_PUBLIC; }
+	YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 193 "fortran.lex"
+{ return TOK_PRIVATE; }
+	YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 194 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_IN; }
+	YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 195 "fortran.lex"
+{ pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+	YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 196 "fortran.lex"
+{ return TOK_CONTINUE; }
+	YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 197 "fortran.lex"
+{ return TOK_PLAINGOTO; }
+	YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 198 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OUT; }
+	YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 199 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+	YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 200 "fortran.lex"
+{ return TOK_INTRINSIC; }
+	YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 201 "fortran.lex"
+{ return TOK_THEN; }
+	YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 202 "fortran.lex"
+{ return TOK_ELSEIF; }
+	YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 203 "fortran.lex"
+{ return TOK_ELSE; }
+	YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 204 "fortran.lex"
+{ return TOK_ENDIF; }
+	YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 205 "fortran.lex"
+{ return TOK_LOGICALIF; }
+	YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 206 "fortran.lex"
+{ return TOK_SUM; }
+	YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 207 "fortran.lex"
+{ return TOK_MAX; }
+	YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 208 "fortran.lex"
+{ return TOK_TANH; }
+	YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 209 "fortran.lex"
+{ return TOK_MAXVAL; }
+	YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 210 "fortran.lex"
+{ return TOK_TRIM; }
+	YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 211 "fortran.lex"
+{ return TOK_SQRT; }
+	YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 212 "fortran.lex"
+{ return TOK_SELECTCASE; }
+	YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 213 "fortran.lex"
+{ return TOK_CASE; }
+	YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 214 "fortran.lex"
+{ return TOK_DEFAULT; }
+	YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 215 "fortran.lex"
+{ return TOK_ENDSELECT; }
+	YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 216 "fortran.lex"
+{ return TOK_FILE; }
+	YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 217 "fortran.lex"
+{ return TOK_UNIT; }
+	YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 218 "fortran.lex"
+{ return TOK_FMT; }
+	YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 219 "fortran.lex"
+{ return TOK_NML; }
+	YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 220 "fortran.lex"
+{ return TOK_END; }
+	YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 221 "fortran.lex"
+{ return TOK_EOR; }
+	YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 222 "fortran.lex"
+{ return TOK_ERR; }
+	YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 223 "fortran.lex"
+{ return TOK_EXIST; }
+	YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 224 "fortran.lex"
+{ return TOK_MIN; }
+	YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 225 "fortran.lex"
+{ return TOK_NINT; }
+	YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 226 "fortran.lex"
+{ return TOK_FLOAT; }
+	YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 227 "fortran.lex"
+{ return TOK_EXP; }
+	YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 228 "fortran.lex"
+{ return TOK_COS; }
+	YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 229 "fortran.lex"
+{ return TOK_COSH; }
+	YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 230 "fortran.lex"
+{ return TOK_ACOS; }
+	YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 231 "fortran.lex"
+{ return TOK_SIN; }
+	YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 232 "fortran.lex"
+{ return TOK_SINH; }
+	YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 233 "fortran.lex"
+{ return TOK_ASIN; }
+	YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 234 "fortran.lex"
+{ return TOK_LOG; }
+	YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 235 "fortran.lex"
+{ return TOK_TAN; }
+	YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 236 "fortran.lex"
+{ return TOK_ATAN; }
+	YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 237 "fortran.lex"
+{ return TOK_CYCLE; }
+	YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 238 "fortran.lex"
+{ return TOK_ABS; }
+	YY_BREAK
+case 134:
+YY_RULE_SETUP
+#line 239 "fortran.lex"
+{ return TOK_MOD; }
+	YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 240 "fortran.lex"
+{ return TOK_SIGN; }
+	YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 241 "fortran.lex"
+{ return TOK_MINLOC; }
+	YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 242 "fortran.lex"
+{ return TOK_MAXLOC; }
+	YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 243 "fortran.lex"
+{ return TOK_MINVAL; }
+	YY_BREAK
+case 139:
+YY_RULE_SETUP
+#line 244 "fortran.lex"
+{ return TOK_BACKSPACE; }
+	YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 245 "fortran.lex"
+{ return TOK_FOURDOTS;  }
+	YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 246 "fortran.lex"
+{ return TOK_LEFTAB; }
+	YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 247 "fortran.lex"
+{ return TOK_RIGHTAB; }
+	YY_BREAK
+case 143:
+/* rule 143 can match eol */
+YY_RULE_SETUP
+#line 248 "fortran.lex"
+{
+                              return TOK_FORMAT; }
+	YY_BREAK
+case 144:
+YY_RULE_SETUP
+#line 250 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+	YY_BREAK
+case 145:
+YY_RULE_SETUP
+#line 251 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+	YY_BREAK
+case 146:
+/* rule 146 can match eol */
+YY_RULE_SETUP
+#line 252 "fortran.lex"
+{
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+	YY_BREAK
+case 147:
+/* rule 147 can match eol */
+YY_RULE_SETUP
+#line 254 "fortran.lex"
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+	YY_BREAK
+case 148:
+/* rule 148 can match eol */
+YY_RULE_SETUP
+#line 255 "fortran.lex"
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+	YY_BREAK
+case 149:
+YY_RULE_SETUP
+#line 256 "fortran.lex"
+{ BEGIN(donottreat); }
+	YY_BREAK
+case 150:
+/* rule 150 can match eol */
+YY_RULE_SETUP
+#line 257 "fortran.lex"
+{ out_of_donottreat(); return '\n'; }
+	YY_BREAK
+case 151:
+YY_RULE_SETUP
+#line 258 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NAME; }
+	YY_BREAK
+case 152:
+/* rule 152 can match eol */
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
+YY_RULE_SETUP
+#line 259 "fortran.lex"
+{  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 153:
+YY_RULE_SETUP
+#line 261 "fortran.lex"
+{  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 154:
+YY_RULE_SETUP
+#line 263 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+	YY_BREAK
+case 155:
+YY_RULE_SETUP
+#line 264 "fortran.lex"
+{}
+	YY_BREAK
+case 156:
+YY_RULE_SETUP
+#line 265 "fortran.lex"
+{}
+	YY_BREAK
+case 157:
+YY_RULE_SETUP
+#line 266 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 158:
+YY_RULE_SETUP
+#line 267 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 159:
+YY_RULE_SETUP
+#line 268 "fortran.lex"
+{ return TOK_SEMICOLON; }
+	YY_BREAK
+case 160:
+YY_RULE_SETUP
+#line 269 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 161:
+YY_RULE_SETUP
+#line 270 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 162:
+YY_RULE_SETUP
+#line 271 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 272 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 164:
+/* rule 164 can match eol */
+YY_RULE_SETUP
+#line 273 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; return '\n'; }
+	YY_BREAK
+case 165:
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
+YY_RULE_SETUP
+#line 274 "fortran.lex"
+{}
+	YY_BREAK
+case 166:
+YY_RULE_SETUP
+#line 275 "fortran.lex"
+{}
+	YY_BREAK
+case 167:
+YY_RULE_SETUP
+#line 276 "fortran.lex"
+{ if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+	YY_BREAK
+case 168:
+/* rule 168 can match eol */
+YY_RULE_SETUP
+#line 277 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; newlinef90=1; }
+	YY_BREAK
+case 169:
+/* rule 169 can match eol */
+YY_RULE_SETUP
+#line 278 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 170:
+/* rule 170 can match eol */
+YY_RULE_SETUP
+#line 280 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+	YY_BREAK
+case 171:
+/* rule 171 can match eol */
+YY_RULE_SETUP
+#line 281 "fortran.lex"
+{ out_of_donottreat(); return '\n'; }
+	YY_BREAK
+case 172:
+/* rule 172 can match eol */
+YY_RULE_SETUP
+#line 282 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 173:
+/* rule 173 can match eol */
+YY_RULE_SETUP
+#line 283 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 174:
+/* rule 174 can match eol */
+YY_RULE_SETUP
+#line 284 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 175:
+YY_RULE_SETUP
+#line 285 "fortran.lex"
+{}
+	YY_BREAK
+case 176:
+YY_RULE_SETUP
+#line 286 "fortran.lex"
+ECHO;
+	YY_BREAK
+#line 3015 "fortran.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(parameter):
+case YY_STATE_EOF(character):
+case YY_STATE_EOF(donottreat):
+case YY_STATE_EOF(fortran77style):
+case YY_STATE_EOF(fortran90style):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = (yy_hold_char);
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed fortran_in at a new source and called
+			 * fortran_lex().  If so, then we have to assure
+			 * consistency between YY_CURRENT_BUFFER and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortran_in;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state(  );
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++(yy_c_buf_p);
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = (yy_c_buf_p);
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer(  ) )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				(yy_did_buffer_switch_on_eof) = 0;
+
+				if ( fortran_wrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * fortran_text, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				(yy_c_buf_p) =
+					(yytext_ptr) + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				(yy_c_buf_p) =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+} /* end of fortran_lex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+	register char *source = (yytext_ptr);
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+	else
+		{
+			yy_size_t num_to_read =
+			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					fortran_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+			(yy_n_chars), num_to_read );
+
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	if ( (yy_n_chars) == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			fortran_restart(fortran_in  );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+		/* Extend the array by 50%, plus the number we really need. */
+		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortran_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+	}
+
+	(yy_n_chars) += number_to_move;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+	return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+    static yy_state_type yy_get_previous_state (void)
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+    
+	yy_current_state = (yy_start);
+	yy_current_state += YY_AT_BOL();
+
+	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 1132 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
+{
+	register int yy_is_jam;
+    	register char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 1132 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 1131);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up fortran_text */
+	*yy_cp = (yy_hold_char);
+
+	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+		register char *source =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+	(yytext_ptr) = yy_bp;
+	(yy_hold_char) = *yy_cp;
+	(yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+    static int yyinput (void)
+#else
+    static int input  (void)
+#endif
+
+{
+	int c;
+    
+	*(yy_c_buf_p) = (yy_hold_char);
+
+	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			/* This was really a NUL. */
+			*(yy_c_buf_p) = '\0';
+
+		else
+			{ /* need more input */
+			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			++(yy_c_buf_p);
+
+			switch ( yy_get_next_buffer(  ) )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					fortran_restart(fortran_in );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( fortran_wrap( ) )
+						return 0;
+
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					(yy_c_buf_p) = (yytext_ptr) + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
+	*(yy_c_buf_p) = '\0';	/* preserve fortran_text */
+	(yy_hold_char) = *++(yy_c_buf_p);
+
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
+
+	return c;
+}
+#endif	/* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ * 
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+    void fortran_restart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        fortran_ensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE );
+	}
+
+	fortran__init_buffer(YY_CURRENT_BUFFER,input_file );
+	fortran__load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void fortran__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		fortran_pop_buffer_state();
+	 *		fortran_push_buffer_state(new_buffer);
+     */
+	fortran_ensure_buffer_stack ();
+	if ( YY_CURRENT_BUFFER == new_buffer )
+		return;
+
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+	fortran__load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (fortran_wrap()) processing, but the only time this flag
+	 * is looked at is after fortran_wrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void fortran__load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	fortran_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ * 
+ * @return the allocated buffer state.
+ */
+    YY_BUFFER_STATE fortran__create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) fortran_alloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	fortran__init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with fortran__create_buffer()
+ * 
+ */
+    void fortran__delete_buffer (YY_BUFFER_STATE  b )
+{
+    
+	if ( ! b )
+		return;
+
+	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		fortran_free((void *) b->yy_ch_buf  );
+
+	fortran_free((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a fortran_restart() or at EOF.
+ */
+    static void fortran__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	fortran__flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then fortran__init_buffer was _probably_
+     * called from fortran_restart() or through yy_get_next_buffer.
+     * In that case, we don't want to reset the lineno or column.
+     */
+    if (b != YY_CURRENT_BUFFER){
+        b->yy_bs_lineno = 1;
+        b->yy_bs_column = 0;
+    }
+
+        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+    
+	errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ * 
+ */
+    void fortran__flush_buffer (YY_BUFFER_STATE  b )
+{
+    	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == YY_CURRENT_BUFFER )
+		fortran__load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ *  the current state. This function will allocate the stack
+ *  if necessary.
+ *  @param new_buffer The new state.
+ *  
+ */
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	fortran_ensure_buffer_stack();
+
+	/* This block is copied from fortran__switch_to_buffer. */
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	/* Only push if top exists. Otherwise, replace top. */
+	if (YY_CURRENT_BUFFER)
+		(yy_buffer_stack_top)++;
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+	/* copied from fortran__switch_to_buffer. */
+	fortran__load_buffer_state( );
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ *  The next element becomes the new top.
+ *  
+ */
+void fortran_pop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	fortran__delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		fortran__load_buffer_state( );
+		(yy_did_buffer_switch_on_eof) = 1;
+	}
+}
+
+/* Allocates the stack if it does not exist.
+ *  Guarantees space for at least one push.
+ */
+static void fortran_ensure_buffer_stack (void)
+{
+	yy_size_t num_to_alloc;
+    
+	if (!(yy_buffer_stack)) {
+
+		/* First allocation is just for 2 elements, since we don't know if this
+		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
+		 * immediate realloc on the next call.
+         */
+		num_to_alloc = 1;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_alloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
+								  
+		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+				
+		(yy_buffer_stack_max) = num_to_alloc;
+		(yy_buffer_stack_top) = 0;
+		return;
+	}
+
+	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+		/* Increase the buffer to prepare for a possible push. */
+		int grow_size = 8 /* arbitrary grow size */;
+
+		num_to_alloc = (yy_buffer_stack_max) + grow_size;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_realloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
+
+		/* zero only the new slots.*/
+		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+		(yy_buffer_stack_max) = num_to_alloc;
+	}
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ * 
+ * @return the newly allocated buffer state object. 
+ */
+YY_BUFFER_STATE fortran__scan_buffer  (char * base, yy_size_t  size )
+{
+	YY_BUFFER_STATE b;
+    
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	fortran__switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to fortran_lex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ * 
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ *       fortran__scan_bytes() instead.
+ */
+YY_BUFFER_STATE fortran__scan_string (yyconst char * yystr )
+{
+    
+	return fortran__scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to fortran_lex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * 
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE fortran__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n, i;
+    
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = _yybytes_len + 2;
+	buf = (char *) fortran_alloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_bytes()" );
+
+	for ( i = 0; i < _yybytes_len; ++i )
+		buf[i] = yybytes[i];
+
+	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = fortran__scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in fortran__scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+    	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortran_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		fortran_text[fortran_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = fortran_text + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		fortran_leng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int fortran_get_lineno  (void)
+{
+        
+    return fortran_lineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *fortran_get_in  (void)
+{
+        return fortran_in;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *fortran_get_out  (void)
+{
+        return fortran_out;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t fortran_get_leng  (void)
+{
+        return fortran_leng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *fortran_get_text  (void)
+{
+        return fortran_text;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void fortran_set_lineno (int  line_number )
+{
+    
+    fortran_lineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see fortran__switch_to_buffer
+ */
+void fortran_set_in (FILE *  in_str )
+{
+        fortran_in = in_str ;
+}
+
+void fortran_set_out (FILE *  out_str )
+{
+        fortran_out = out_str ;
+}
+
+int fortran_get_debug  (void)
+{
+        return fortran__flex_debug;
+}
+
+void fortran_set_debug (int  bdebug )
+{
+        fortran__flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from fortran_lex_destroy(), so don't allocate here.
+     */
+
+    (yy_buffer_stack) = 0;
+    (yy_buffer_stack_top) = 0;
+    (yy_buffer_stack_max) = 0;
+    (yy_c_buf_p) = (char *) 0;
+    (yy_init) = 0;
+    (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+    fortran_in = stdin;
+    fortran_out = stdout;
+#else
+    fortran_in = (FILE *) 0;
+    fortran_out = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * fortran_lex_init()
+     */
+    return 0;
+}
+
+/* fortran_lex_destroy is for both reentrant and non-reentrant scanners. */
+int fortran_lex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		fortran__delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		fortran_pop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	fortran_free((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * fortran_lex() is called, initialization will occur. */
+    yy_init_globals( );
+
+    return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+}
+#endif
+
+void *fortran_alloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *fortran_realloc  (void * ptr, yy_size_t  size )
+{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+}
+
+void fortran_free (void * ptr )
+{
+	free( (char *) ptr );	/* see fortran_realloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 286 "fortran.lex"
+
+
+
+void out_of_donottreat ( void )
+{
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
+}
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 8732)
@@ -0,0 +1,3930 @@
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+#define YYBISON_VERSION "2.3"
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+/* Substitute the variable and function names.  */
+#define yyparse convert_parse
+#define yylex   convert_lex
+#define yyerror convert_error
+#define yylval  convert_lval
+#define yychar  convert_char
+#define yydebug convert_debug
+#define yynerrs convert_nerrs
+
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_SEP = 258,
+     TOK_KIND = 259,
+     TOK_EQUAL = 260,
+     TOK_USE = 261,
+     TOK_MODULEMAIN = 262,
+     TOK_NOTGRIDDEP = 263,
+     TOK_USEITEM = 264,
+     TOK_NAME = 265,
+     TOK_CSTINT = 266,
+     TOK_PROBTYPE = 267
+   };
+#endif
+/* Tokens.  */
+#define TOK_SEP 258
+#define TOK_KIND 259
+#define TOK_EQUAL 260
+#define TOK_USE 261
+#define TOK_MODULEMAIN 262
+#define TOK_NOTGRIDDEP 263
+#define TOK_USEITEM 264
+#define TOK_NAME 265
+#define TOK_CSTINT 266
+#define TOK_PROBTYPE 267
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 35 "convert.y"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+#line 52 "convert.y"
+{
+    char na[LONG_M];
+}
+/* Line 193 of yacc.c.  */
+#line 149 "convert.tab.c"
+	YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations.  */
+
+
+/* Line 216 of yacc.c.  */
+#line 162 "convert.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(msgid) msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+    int i;
+#endif
+{
+  return i;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined _STDLIB_H \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack)					\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   29
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  16
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  3
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  11
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  29
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   267
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+      15,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,    13,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,    14,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
+       5,     6,     7,     8,     9,    10,    11,    12
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint8 yyprhs[] =
+{
+       0,     0,     3,     4,     7,     9,    13,    19,    27,    31,
+      37,    42
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int8 yyrhs[] =
+{
+      17,     0,    -1,    -1,    17,    18,    -1,    15,    -1,    12,
+      10,    14,    -1,    12,    10,    13,    10,    14,    -1,    12,
+      10,    13,    10,    13,    10,    14,    -1,     7,    10,    14,
+      -1,     4,    10,     5,    11,    14,    -1,     8,     3,    10,
+      14,    -1,     6,     9,    14,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint8 yyrline[] =
+{
+       0,    71,    71,    72,    75,    76,    77,    78,    79,    84,
+     100,   104
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "TOK_SEP", "TOK_KIND", "TOK_EQUAL",
+  "TOK_USE", "TOK_MODULEMAIN", "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME",
+  "TOK_CSTINT", "TOK_PROBTYPE", "','", "';'", "'\\n'", "$accept", "input",
+  "line", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
+     265,   266,   267,    44,    59,    10
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint8 yyr1[] =
+{
+       0,    16,    17,    17,    18,    18,    18,    18,    18,    18,
+      18,    18
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     1,     3,     5,     7,     3,     5,
+       4,     3
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint8 yydefact[] =
+{
+       2,     0,     1,     0,     0,     0,     0,     0,     4,     3,
+       0,     0,     0,     0,     0,     0,    11,     8,     0,     0,
+       5,     0,    10,     0,     9,     0,     6,     0,     7
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int8 yydefgoto[] =
+{
+      -1,     1,     9
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -13
+static const yytype_int8 yypact[] =
+{
+     -13,     0,   -13,    -7,     2,    -5,    10,     4,   -13,   -13,
+      11,     3,     5,     8,   -12,     9,   -13,   -13,     7,    12,
+     -13,    13,   -13,    -4,   -13,    14,   -13,    15,   -13
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int8 yypgoto[] =
+{
+     -13,   -13,   -13
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -1
+static const yytype_uint8 yytable[] =
+{
+       2,    19,    20,    10,     3,    12,     4,     5,     6,    25,
+      26,    11,     7,    13,    14,     8,    15,    16,    18,    17,
+      21,    22,    23,     0,    27,     0,     0,    24,     0,    28
+};
+
+static const yytype_int8 yycheck[] =
+{
+       0,    13,    14,    10,     4,    10,     6,     7,     8,    13,
+      14,     9,    12,     3,    10,    15,     5,    14,    10,    14,
+      11,    14,    10,    -1,    10,    -1,    -1,    14,    -1,    14
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint8 yystos[] =
+{
+       0,    17,     0,     4,     6,     7,     8,    12,    15,    18,
+      10,     9,    10,     3,    10,     5,    14,    14,    10,    13,
+      14,    11,    14,    10,    14,    13,    14,    10,    14
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+
+#define YYFAIL		goto yyerrlab
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
+#ifndef YY_LOCATION_PRINT
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+	break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+#else
+static void
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      fprintf (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      fprintf (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
+    {
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
+    }
+}
+#endif /* YYERROR_VERBOSE */
+
+
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
+int yychar;
+
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+  
+  int yystate;
+  int yyn;
+  int yyresult;
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
+  yyn = yypact[yystate];
+  if (yyn == YYPACT_NINF)
+    goto yydefault;
+
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the look-ahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  yystate = yyn;
+  *++yyvsp = yylval;
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 5:
+#line 76 "convert.y"
+    { initdimprob(1,(yyvsp[(2) - (3)].na),"0","0"); ;}
+    break;
+
+  case 6:
+#line 77 "convert.y"
+    { initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0"); ;}
+    break;
+
+  case 7:
+#line 78 "convert.y"
+    { initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na)); ;}
+    break;
+
+  case 8:
+#line 80 "convert.y"
+    {
+            listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
+            Addmoduletothelist((yyvsp[(2) - (3)].na));
+        ;}
+    break;
+
+  case 9:
+#line 85 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(4) - (5)].na),"4"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,4);
+            }
+            else if (!strcasecmp((yyvsp[(4) - (5)].na),"8"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",(yyvsp[(4) - (5)].na));
+                exit(0);
+            }
+        ;}
+    break;
+
+  case 10:
+#line 101 "convert.y"
+    {
+            Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));
+        ;}
+    break;
+
+  case 11:
+#line 105 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        ;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 1420 "convert.tab.c"
+      default: break;
+    }
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+      {
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
+      }
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse look-ahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse look-ahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (yyn != YYPACT_NINF)
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  *++yyvsp = yylval;
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#ifndef yyoverflow
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+#line 110 "convert.y"
+
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
+
+int main(int argc,char *argv[])
+{
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
+
+/******************************************************************************/
+/*  3-  Parsing of the conv file <name>.in                                    */
+/******************************************************************************/
+
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
+
+#line 2 "convert.yy.c"
+
+#line 4 "convert.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define yy_create_buffer convert__create_buffer
+#define yy_delete_buffer convert__delete_buffer
+#define yy_flex_debug convert__flex_debug
+#define yy_init_buffer convert__init_buffer
+#define yy_flush_buffer convert__flush_buffer
+#define yy_load_buffer_state convert__load_buffer_state
+#define yy_switch_to_buffer convert__switch_to_buffer
+#define yyin convert_in
+#define yyleng convert_leng
+#define yylex convert_lex
+#define yylineno convert_lineno
+#define yyout convert_out
+#define yyrestart convert_restart
+#define yytext convert_text
+#define yywrap convert_wrap
+#define yyalloc convert_alloc
+#define yyrealloc convert_realloc
+#define yyfree convert_free
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE convert_restart(convert_in  )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t convert_leng;
+
+extern FILE *convert_in, *convert_out;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+    #define YY_LESS_LINENO(n)
+    
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up convert_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		*yy_cp = (yy_hold_char); \
+		YY_RESTORE_YY_MORE_OFFSET \
+		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up convert_text again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr)  )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	yy_size_t yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+    int yy_bs_lineno; /**< The line count. */
+    int yy_bs_column; /**< The column count. */
+    
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via convert_restart()), so that the user can continue scanning by
+	 * just pointing convert_in at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+
+	};
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+                          : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when convert_text is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t convert_leng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow convert_wrap()'s to do buffer switches
+ * instead of setting up a fresh convert_in.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void convert_restart (FILE *input_file  );
+void convert__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE convert__create_buffer (FILE *file,int size  );
+void convert__delete_buffer (YY_BUFFER_STATE b  );
+void convert__flush_buffer (YY_BUFFER_STATE b  );
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void convert_pop_buffer_state (void );
+
+static void convert_ensure_buffer_stack (void );
+static void convert__load_buffer_state (void );
+static void convert__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER convert__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE convert__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE convert__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE convert__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *convert_alloc (yy_size_t  );
+void *convert_realloc (void *,yy_size_t  );
+void convert_free (void *  );
+
+#define yy_new_buffer convert__create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        convert_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        convert_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+#define convert_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
+typedef unsigned char YY_CHAR;
+
+FILE *convert_in = (FILE *) 0, *convert_out = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int convert_lineno;
+
+int convert_lineno = 1;
+
+extern char *convert_text;
+#define yytext_ptr convert_text
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[]  );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up convert_text.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	convert_leng = (yy_size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 15
+#define YY_END_OF_BUFFER 16
+/* This struct is not used in this scanner,
+   but its presence is necessary. */
+struct yy_trans_info
+	{
+	flex_int32_t yy_verify;
+	flex_int32_t yy_nxt;
+	};
+static yyconst flex_int16_t yy_accept[84] =
+    {   0,
+        0,    0,    0,    0,   16,   15,   14,   13,   15,   12,
+       11,   11,   11,   11,   12,    7,   10,   10,   10,   10,
+       10,   10,   10,   14,    0,    4,   11,    9,    9,    9,
+        5,   10,   10,   10,   10,   10,   10,   10,   10,    8,
+       10,   10,   10,   10,   10,    3,   10,    6,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,    2,   10,   10,   10,    1,   10,   10,   10,
+       10,    8,    0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    2,    1,    1,    1,    1,    4,    1,    1,    5,
+        6,    1,    1,    7,    1,    1,    1,    8,    9,   10,
+       11,    8,    8,    8,   12,    8,    8,   13,   14,    1,
+       15,    1,    1,    1,   16,   17,   17,   18,   19,   20,
+       21,   17,   22,   17,   23,   24,   25,   26,   27,   28,
+       17,   29,   30,   31,   32,   17,   17,   33,   34,   17,
+       35,    1,   36,    1,   37,    1,   38,   17,   17,   39,
+
+       40,   41,   42,   17,   43,   17,   44,   45,   46,   47,
+       48,   49,   17,   50,   51,   52,   53,   17,   17,   54,
+       55,   17,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[56] =
+    {   0,
+        1,    1,    2,    1,    1,    1,    1,    3,    3,    3,
+        3,    3,    1,    1,    1,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    1,    1,    3,    3,    3,    3,
+        3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    3
+    } ;
+
+static yyconst flex_int16_t yy_base[86] =
+    {   0,
+        0,    0,    0,    0,  192,  194,  186,  194,  176,  194,
+       48,   53,   58,   69,  164,  194,    0,   60,   51,   47,
+       49,   67,   55,  173,  170,  169,   90,  194,  194,  194,
+      194,    0,  160,   53,   62,   58,   66,   62,   74,    0,
+       85,   95,   94,   82,  101,    0,  101,    0,   91,  134,
+       96,  133,  100,  103,   99,  105,  109,  106,  102,  101,
+      113,   99,  115,  113,  119,  127,  123,  139,  130,  142,
+      137,  132,    0,   81,  144,  143,    0,  136,  144,  150,
+      139,    0,  194,  190,   81
+    } ;
+
+static yyconst flex_int16_t yy_def[86] =
+    {   0,
+       83,    1,    1,    1,   83,   83,   83,   83,   84,   83,
+       83,   83,   83,   83,   83,   83,   85,   85,   85,   85,
+       85,   85,   85,   83,   84,   84,   83,   83,   83,   83,
+       83,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,    0,   83,   83
+    } ;
+
+static yyconst flex_int16_t yy_nxt[250] =
+    {   0,
+        6,    7,    8,    9,   10,   10,   10,   11,   12,   13,
+       14,   11,   15,   10,   16,   17,   17,   17,   17,   18,
+       17,   17,   19,   17,   17,   20,   21,   22,   17,   17,
+       17,   23,   17,   17,   10,   10,   17,   17,   17,   17,
+       18,   17,   17,   19,   17,   17,   20,   21,   22,   17,
+       17,   17,   23,   17,   17,   27,   27,   27,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   27,   27,
+       28,   33,   35,   36,   37,   29,   27,   27,   27,   27,
+       27,   34,   38,   32,   39,   41,   30,   42,   43,   44,
+       45,   28,   46,   35,   36,   37,   29,   27,   27,   27,
+
+       27,   27,   34,   47,   38,   39,   41,   30,   42,   43,
+       44,   45,   48,   46,   49,   50,   51,   76,   52,   53,
+       55,   57,   58,   59,   47,   60,   61,   62,   63,   64,
+       65,   66,   67,   48,   68,   49,   50,   69,   51,   52,
+       53,   55,   57,   58,   59,   70,   60,   61,   62,   63,
+       64,   65,   66,   67,   71,   68,   72,   73,   69,   74,
+       75,   40,   77,   78,   79,   80,   70,   81,   82,   56,
+       54,   40,   26,   26,   24,   71,   31,   72,   73,   26,
+       74,   75,   40,   77,   78,   79,   80,   24,   81,   82,
+       25,   83,   25,    5,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
+    } ;
+
+static yyconst flex_int16_t yy_chk[250] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,   11,   11,   11,   11,   11,
+       12,   12,   12,   12,   12,   13,   13,   13,   13,   13,
+       12,   18,   19,   20,   21,   13,   14,   14,   14,   14,
+       14,   18,   22,   85,   23,   34,   14,   35,   36,   37,
+       38,   12,   39,   19,   20,   21,   13,   27,   27,   27,
+
+       27,   27,   18,   41,   22,   23,   34,   14,   35,   36,
+       37,   38,   42,   39,   43,   44,   45,   74,   47,   49,
+       51,   53,   54,   55,   41,   56,   57,   58,   59,   60,
+       61,   62,   63,   42,   64,   43,   44,   65,   45,   47,
+       49,   51,   53,   54,   55,   66,   56,   57,   58,   59,
+       60,   61,   62,   63,   67,   64,   68,   69,   65,   70,
+       71,   72,   75,   76,   78,   79,   66,   80,   81,   52,
+       50,   33,   26,   25,   24,   67,   15,   68,   69,    9,
+       70,   71,   72,   75,   76,   78,   79,    7,   80,   81,
+       84,    5,   84,   83,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int convert__flex_debug;
+int convert__flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *convert_text;
+#line 1 "convert.lex"
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+#line 40 "convert.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define YY_NO_INPUT
+#line 595 "convert.yy.c"
+
+#define INITIAL 0
+#define character 1
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+   These are made visible to non-reentrant scanners for convenience. */
+
+int convert_lex_destroy (void );
+
+int convert_get_debug (void );
+
+void convert_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE convert_get_extra (void );
+
+void convert_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *convert_get_in (void );
+
+void convert_set_in  (FILE * in_str  );
+
+FILE *convert_get_out (void );
+
+void convert_set_out  (FILE * out_str  );
+
+yy_size_t convert_get_leng (void );
+
+char *convert_get_text (void );
+
+int convert_get_lineno (void );
+
+void convert_set_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int convert_wrap (void );
+#else
+extern int convert_wrap (void );
+#endif
+#endif
+
+    static void yyunput (int c,char *buf_ptr  );
+    
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( convert_text, convert_leng, 1, convert_out )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+		{ \
+		int c = '*'; \
+		yy_size_t n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( convert_in )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( convert_in ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, convert_in))==0 && ferror(convert_in)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(convert_in); \
+			} \
+		}\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int convert_lex (void);
+
+#define YY_DECL int convert_lex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after convert_text and convert_leng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+    
+#line 54 "convert.lex"
+
+#line 780 "convert.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! (yy_start) )
+			(yy_start) = 1;	/* first start state */
+
+		if ( ! convert_in )
+			convert_in = stdin;
+
+		if ( ! convert_out )
+			convert_out = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			convert_ensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				convert__create_buffer(convert_in,YY_BUF_SIZE );
+		}
+
+		convert__load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of convert_text. */
+		*yy_cp = (yy_hold_char);
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = (yy_start);
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 84 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 194 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 55 "convert.lex"
+{ return TOK_MODULEMAIN; } /* name of the module                      */
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 56 "convert.lex"
+{ return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 57 "convert.lex"
+{ return TOK_USE; }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 58 "convert.lex"
+{ }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 59 "convert.lex"
+{ return TOK_SEP; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 60 "convert.lex"
+{ return TOK_KIND; }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 61 "convert.lex"
+{ return TOK_EQUAL; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 62 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_USEITEM;  }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 63 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_PROBTYPE; }  /* dimension of the problem */
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 64 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_NAME; }
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 65 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_CSTINT; }
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 66 "convert.lex"
+{ return (int) *convert_text; }
+	YY_BREAK
+case 13:
+/* rule 13 can match eol */
+YY_RULE_SETUP
+#line 67 "convert.lex"
+{ line_num++; return (int) *convert_text; }
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 68 "convert.lex"
+;
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 69 "convert.lex"
+ECHO;
+	YY_BREAK
+#line 939 "convert.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(character):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = (yy_hold_char);
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed convert_in at a new source and called
+			 * convert_lex().  If so, then we have to assure
+			 * consistency between YY_CURRENT_BUFFER and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = convert_in;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state(  );
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++(yy_c_buf_p);
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = (yy_c_buf_p);
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer(  ) )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				(yy_did_buffer_switch_on_eof) = 0;
+
+				if ( convert_wrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * convert_text, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				(yy_c_buf_p) =
+					(yytext_ptr) + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				(yy_c_buf_p) =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+} /* end of convert_lex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+	register char *source = (yytext_ptr);
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+	else
+		{
+			yy_size_t num_to_read =
+			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					convert_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+			(yy_n_chars), num_to_read );
+
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	if ( (yy_n_chars) == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			convert_restart(convert_in  );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+		/* Extend the array by 50%, plus the number we really need. */
+		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) convert_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+	}
+
+	(yy_n_chars) += number_to_move;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+	return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+    static yy_state_type yy_get_previous_state (void)
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+    
+	yy_current_state = (yy_start);
+
+	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 84 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
+{
+	register int yy_is_jam;
+    	register char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 84 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 83);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up convert_text */
+	*yy_cp = (yy_hold_char);
+
+	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+		register char *source =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+	(yytext_ptr) = yy_bp;
+	(yy_hold_char) = *yy_cp;
+	(yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+    static int yyinput (void)
+#else
+    static int input  (void)
+#endif
+
+{
+	int c;
+    
+	*(yy_c_buf_p) = (yy_hold_char);
+
+	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			/* This was really a NUL. */
+			*(yy_c_buf_p) = '\0';
+
+		else
+			{ /* need more input */
+			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			++(yy_c_buf_p);
+
+			switch ( yy_get_next_buffer(  ) )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					convert_restart(convert_in );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( convert_wrap( ) )
+						return 0;
+
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					(yy_c_buf_p) = (yytext_ptr) + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
+	*(yy_c_buf_p) = '\0';	/* preserve convert_text */
+	(yy_hold_char) = *++(yy_c_buf_p);
+
+	return c;
+}
+#endif	/* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ * 
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+    void convert_restart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        convert_ensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            convert__create_buffer(convert_in,YY_BUF_SIZE );
+	}
+
+	convert__init_buffer(YY_CURRENT_BUFFER,input_file );
+	convert__load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void convert__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		convert_pop_buffer_state();
+	 *		convert_push_buffer_state(new_buffer);
+     */
+	convert_ensure_buffer_stack ();
+	if ( YY_CURRENT_BUFFER == new_buffer )
+		return;
+
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+	convert__load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (convert_wrap()) processing, but the only time this flag
+	 * is looked at is after convert_wrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void convert__load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	convert_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ * 
+ * @return the allocated buffer state.
+ */
+    YY_BUFFER_STATE convert__create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) convert_alloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	convert__init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with convert__create_buffer()
+ * 
+ */
+    void convert__delete_buffer (YY_BUFFER_STATE  b )
+{
+    
+	if ( ! b )
+		return;
+
+	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		convert_free((void *) b->yy_ch_buf  );
+
+	convert_free((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a convert_restart() or at EOF.
+ */
+    static void convert__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	convert__flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then convert__init_buffer was _probably_
+     * called from convert_restart() or through yy_get_next_buffer.
+     * In that case, we don't want to reset the lineno or column.
+     */
+    if (b != YY_CURRENT_BUFFER){
+        b->yy_bs_lineno = 1;
+        b->yy_bs_column = 0;
+    }
+
+        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+    
+	errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ * 
+ */
+    void convert__flush_buffer (YY_BUFFER_STATE  b )
+{
+    	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == YY_CURRENT_BUFFER )
+		convert__load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ *  the current state. This function will allocate the stack
+ *  if necessary.
+ *  @param new_buffer The new state.
+ *  
+ */
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	convert_ensure_buffer_stack();
+
+	/* This block is copied from convert__switch_to_buffer. */
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	/* Only push if top exists. Otherwise, replace top. */
+	if (YY_CURRENT_BUFFER)
+		(yy_buffer_stack_top)++;
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+	/* copied from convert__switch_to_buffer. */
+	convert__load_buffer_state( );
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ *  The next element becomes the new top.
+ *  
+ */
+void convert_pop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	convert__delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		convert__load_buffer_state( );
+		(yy_did_buffer_switch_on_eof) = 1;
+	}
+}
+
+/* Allocates the stack if it does not exist.
+ *  Guarantees space for at least one push.
+ */
+static void convert_ensure_buffer_stack (void)
+{
+	yy_size_t num_to_alloc;
+    
+	if (!(yy_buffer_stack)) {
+
+		/* First allocation is just for 2 elements, since we don't know if this
+		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
+		 * immediate realloc on the next call.
+         */
+		num_to_alloc = 1;
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_alloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
+								  
+		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+				
+		(yy_buffer_stack_max) = num_to_alloc;
+		(yy_buffer_stack_top) = 0;
+		return;
+	}
+
+	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+		/* Increase the buffer to prepare for a possible push. */
+		int grow_size = 8 /* arbitrary grow size */;
+
+		num_to_alloc = (yy_buffer_stack_max) + grow_size;
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_realloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
+
+		/* zero only the new slots.*/
+		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+		(yy_buffer_stack_max) = num_to_alloc;
+	}
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ * 
+ * @return the newly allocated buffer state object. 
+ */
+YY_BUFFER_STATE convert__scan_buffer  (char * base, yy_size_t  size )
+{
+	YY_BUFFER_STATE b;
+    
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	convert__switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to convert_lex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ * 
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ *       convert__scan_bytes() instead.
+ */
+YY_BUFFER_STATE convert__scan_string (yyconst char * yystr )
+{
+    
+	return convert__scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to convert_lex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * 
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE convert__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n, i;
+    
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = _yybytes_len + 2;
+	buf = (char *) convert_alloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_bytes()" );
+
+	for ( i = 0; i < _yybytes_len; ++i )
+		buf[i] = yybytes[i];
+
+	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = convert__scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in convert__scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+    	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up convert_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		convert_text[convert_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = convert_text + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		convert_leng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int convert_get_lineno  (void)
+{
+        
+    return convert_lineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *convert_get_in  (void)
+{
+        return convert_in;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *convert_get_out  (void)
+{
+        return convert_out;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t convert_get_leng  (void)
+{
+        return convert_leng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *convert_get_text  (void)
+{
+        return convert_text;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void convert_set_lineno (int  line_number )
+{
+    
+    convert_lineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see convert__switch_to_buffer
+ */
+void convert_set_in (FILE *  in_str )
+{
+        convert_in = in_str ;
+}
+
+void convert_set_out (FILE *  out_str )
+{
+        convert_out = out_str ;
+}
+
+int convert_get_debug  (void)
+{
+        return convert__flex_debug;
+}
+
+void convert_set_debug (int  bdebug )
+{
+        convert__flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from convert_lex_destroy(), so don't allocate here.
+     */
+
+    (yy_buffer_stack) = 0;
+    (yy_buffer_stack_top) = 0;
+    (yy_buffer_stack_max) = 0;
+    (yy_c_buf_p) = (char *) 0;
+    (yy_init) = 0;
+    (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+    convert_in = stdin;
+    convert_out = stdout;
+#else
+    convert_in = (FILE *) 0;
+    convert_out = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * convert_lex_init()
+     */
+    return 0;
+}
+
+/* convert_lex_destroy is for both reentrant and non-reentrant scanners. */
+int convert_lex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		convert__delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		convert_pop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	convert_free((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * convert_lex() is called, initialization will occur. */
+    yy_init_globals( );
+
+    return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+}
+#endif
+
+void *convert_alloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *convert_realloc  (void * ptr, yy_size_t  size )
+{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+}
+
+void convert_free (void * ptr )
+{
+	free( (char *) ptr );	/* see convert_realloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 69 "convert.lex"
+
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/run
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 8732)
@@ -0,0 +1,2 @@
+make -f Makefile.lex clean
+make -f Makefile.lex
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 8732)
@@ -0,0 +1,962 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+const char * tabvarsname(const variable *var)
+{
+    static char * tname[5] = {
+        "tabvars",      // v_catvar == 0
+        "tabvars_c",    // v_catvar == 1
+        "tabvars_r",    // v_catvar == 2
+        "tabvars_l",    // v_catvar == 3
+        "tabvars_i"     // v_catvar == 4
+    };
+    return tname[var->v_catvar];    // v_catvar should never be ouside the range [0:4].
+}
+
+/******************************************************************************/
+/*                        variablecurgridtabvars                              */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  ----------->  Agrif_Curgrid % tabvars (i)                                 */
+/*                                                                            */
+/******************************************************************************/
+const char * variablecurgridtabvars(int which_grid)
+{
+    static char * varname[4] = {
+        " Agrif_%s(%d)",                // which_grid == 0
+        " Agrif_%s(%d) %% parent_var",  // which_grid == 1
+        " Agrif_Mygrid %% %s(%d)",      // which_grid == 2
+        " Agrif_Curgrid %% %s(%d)",     // which_grid == 3
+    };
+
+    return varname[which_grid];
+}
+
+void WARNING_CharSize(const variable *var)
+{
+    if ( var->v_nbdim == 0 )
+    {
+        if ( convert2int(var->v_dimchar) > 2400 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 2400. You must change         \n");
+            printf("   the dimension of carray0                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 161. Replace 2400 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),1);
+    }
+    else if ( var->v_nbdim == 1 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray1                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 162. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),2);
+    }
+    else if ( var->v_nbdim == 2 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray2                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 163. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),3);
+    }
+    else if ( var->v_nbdim == 3 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray3                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 164. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),4);
+    }
+}
+/******************************************************************************/
+/*                           vargridnametabvars                               */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % array1           */
+/*                                                                            */
+/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % array1          */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridnametabvars (const variable * var, int iorindice)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars);
+    else                  sprintf(tname_1, "Agrif_Gr %% %s(i)",  tabvarsname(var));
+
+    if (!strcasecmp(var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d",  var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "integer"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "logical"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "character"))
+    {
+        WARNING_CharSize(var);
+        sprintf (tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                           vargridcurgridtabvars                            */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/* if which_grid == 0 -->  Agrif_Curgrid % tabvars (i) % array1               */
+/*                                                                            */
+/* if which_grid == 1 -->  Agrif_tabvars (i) % parent_var % array1            */
+/*                                                                            */
+/* if which_grid == 2 -->  Agrif_Gr % tabvars (i) % array1                    */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridcurgridtabvars(const variable *var, int which_grid)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if (!strcasecmp(var->v_typevar,"type"))
+    {
+        sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar);
+    }
+    else
+    {
+        sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars);
+
+        if (!strcasecmp(var->v_typevar, "REAL"))
+        {
+            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+            else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        {
+            sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        {
+            sprintf(tname_2, "%% larray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        {
+            WARNING_CharSize(var);
+            sprintf(tname_2, "%% carray%d", var->v_nbdim);
+        }
+        strcat(tname_1, tname_2);
+    }
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    sprintf(tname_1, "(%d)", var->v_indicetabvars);
+
+    if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+    {
+        WARNING_CharSize(var);
+        sprintf(tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                               vargridparam                                 */
+/******************************************************************************/
+/* This subroutine is used to create the string which contains                */
+/* dimension list                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj"                            */
+/*                                                                            */
+/******************************************************************************/
+const char * vargridparam(const variable *var)
+{
+    typedim dim;
+    listdim *newdim;
+    char newname[LONG_M];
+
+    newdim = var->v_dimension;
+    if (!newdim) return "";
+
+    strcpy (tmpvargridname, "(");
+    while (newdim)
+    {
+        dim = newdim->dim;
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        strcat(tmpvargridname, " : ");
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        newdim = newdim->suiv;
+        if (newdim) strcat(tmpvargridname, ",");
+    }
+    strcat(tmpvargridname, ")\0");
+    Save_Length(tmpvargridname,40);
+    return tmpvargridname;
+}
+
+/******************************************************************************/
+/*                        write_probdimagrif_file                             */
+/******************************************************************************/
+/* This subroutine is used to create the file probdim_agrif.h                 */
+/******************************************************************************/
+/*                                                                            */
+/*               probdim_agrif.h                                              */
+/*                                                                            */
+/*               Agrif_probdim = <number>                                     */
+/*                                                                            */
+/******************************************************************************/
+void write_probdimagrif_file()
+{
+  FILE *probdim;
+  char ligne[LONG_M];
+
+  probdim = open_for_write("probdim_agrif.h");
+  sprintf (ligne, "Agrif_Probdim = %d", dimprob);
+  tofich (probdim, ligne,1);
+  fclose (probdim);
+}
+
+/******************************************************************************/
+/*                             write_keysagrif_file                           */
+/******************************************************************************/
+/* This subroutine is used to create the file keys_agrif.h                    */
+/******************************************************************************/
+/*                                                                            */
+/*               keys_agrif.h                                                 */
+/*                                                                            */
+/*               AGRIF_USE_FIXED_GRIDS = 0                                    */
+/*               AGRIF_USE_ONLY_FIXED_GRIDS = 0                               */
+/*               AGRIF_USE_(ONLY)_FIXED_GRIDS = 1                             */
+/*                                                                            */
+/******************************************************************************/
+void write_keysagrif_file()
+{
+  FILE *keys;
+
+  keys = open_for_write("keys_agrif.h");
+  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids);
+  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids);
+  fclose(keys);
+}
+
+/******************************************************************************/
+/*                      write_modtypeagrif_file                               */
+/******************************************************************************/
+/* This subroutine is used to create the file typedata                        */
+/******************************************************************************/
+/*                                                                            */
+/*               modtype_agrif.h                                              */
+/*                                                                            */
+/*               Agrif_NbVariables =                                          */
+/*                                                                            */
+/******************************************************************************/
+void write_modtypeagrif_file()
+{
+  char ligne[LONG_M];
+  FILE *typedata;
+  int i;
+
+  typedata = open_for_write("modtype_agrif.h");
+  /* AGRIF_NbVariables : number of variables                                  */
+  for (i=0;i<NB_CAT_VARIABLES;i++)
+   {
+    sprintf (ligne, "Agrif_NbVariables(%d) = %d",i,indicemaxtabvars[i]);
+    tofich(typedata,ligne,1);
+   }
+  fclose (typedata);
+}
+
+/******************************************************************************/
+/*                   write_createvarnameagrif_file                            */
+/******************************************************************************/
+/* This subroutine is used to create the file  createvarname                  */
+/******************************************************************************/
+/*                                                                            */
+/*    Agrif_Gr % tabvars (i) % namevar = "variable"                           */
+/*                                                                            */
+/******************************************************************************/
+void write_createvarnameagrif_file(variable *v,FILE *createvarname, int *InitEmpty)
+{
+    char ligne[LONG_M];
+
+    *InitEmpty = 0 ;
+    sprintf(ligne, "Agrif_Gr %% %s(%d) %% namevar = \"%s\"",tabvarsname(v),v->v_indicetabvars,v->v_nomvar);
+    tofich(createvarname,ligne,1);
+}
+
+/******************************************************************************/
+/*                        write_Setnumberofcells_file                         */
+/******************************************************************************/
+/* This subroutine is used to create the file  setnumberofcells               */
+/******************************************************************************/
+/*                                                                            */
+/*              Agrif_Gr % n(i) = nbmailles                                   */
+/*                                                                            */
+/******************************************************************************/
+void write_Setnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *setnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )  return;
+
+    setnumberofcells = open_for_write("SetNumberofcells.h");
+
+    if ( onlyfixedgrids == 1 )
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0");
+    else
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0");
+
+    sprintf(ligne, cformat, 1, IndicenbmaillesX);
+    tofich(setnumberofcells, ligne, 1);
+
+    if ( dimprob > 1 )
+    {
+        sprintf(ligne, cformat, 2, IndicenbmaillesY);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    if ( dimprob > 2 )
+    {
+        sprintf(ligne, cformat, 3, IndicenbmaillesZ);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    fclose(setnumberofcells);
+}
+
+/******************************************************************************/
+/*                       write_Getnumberofcells_file                          */
+/******************************************************************************/
+/* This subroutine is used to create the file  getnumberofcells               */
+/******************************************************************************/
+/*                                                                            */
+/*              nbmailles = Agrif_Gr % n(i)                                   */
+/*                                                                            */
+/******************************************************************************/
+void write_Getnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *getnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )    return;
+
+    strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)");
+
+    getnumberofcells = open_for_write("GetNumberofcells.h");
+
+    sprintf(ligne, cformat, IndicenbmaillesX, 1);
+    tofich(getnumberofcells, ligne, 1);
+
+    if (dimprob > 1)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesY, 2);
+        tofich(getnumberofcells, ligne,1);
+    }
+    if (dimprob > 2)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesZ, 3);
+        tofich(getnumberofcells, ligne,1);
+    }
+    fclose(getnumberofcells);
+}
+
+
+/******************************************************************************/
+/*                      write_initialisationsagrif_file                       */
+/******************************************************************************/
+/* This subroutine is used to create the file initproc                        */
+/******************************************************************************/
+/*                                                                            */
+/*              ! variable                                                    */
+/*              Agrif_Gr % tabvars(i) % nbdim = 1                             */
+/*                                                                            */
+/******************************************************************************/
+void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty)
+{
+    char ligne[LONG_M];
+
+    if ( v->v_nbdim != 0 )
+    {
+        *VarnameEmpty = 0 ;
+        sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim);
+        tofich (initproc, ligne,1);
+    }
+}
+
+
+void Write_Alloc_Agrif_Files()
+{
+   listnom *parcours;
+   FILE *alloccalls;
+   FILE *AllocUSE;
+
+   AllocUSE= open_for_write("include_use_Alloc_agrif.h");
+   alloccalls = open_for_write("allocations_calls_agrif.h");
+
+   parcours = List_Subroutine_For_Alloc;
+   while ( parcours )
+   {
+      fprintf(AllocUSE,"      use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom );
+      fprintf (alloccalls,"      call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom );
+      parcours = parcours -> suiv;
+   }
+
+   fclose (AllocUSE);
+   fclose (alloccalls);
+}
+
+int IndiceInlist(int indic, listindice *listin)
+{
+   listindice *parcoursindic;
+   int out;
+
+   out = 0 ;
+
+   parcoursindic = listin;
+   while ( parcoursindic && out == 0 )
+   {
+      if ( parcoursindic->i_indice == indic ) out = 1;
+      else parcoursindic = parcoursindic -> suiv;
+   }
+
+   return out;
+}
+
+void write_allocation_Common_0()
+{
+    listnom *parcours_nom;
+    listnom *neededparameter;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    FILE *paramtoamr;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    listindice **list_indic;
+    listindice *parcoursindic;
+    int i;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfCommon;
+    ValeurMax = 2;
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+            fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom);
+
+            sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
+            paramtoamr = open_for_write(ligne);
+            neededparameter = (listnom *) NULL;
+            list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+
+//             shouldincludempif = 1 ;
+            parcours = List_Common_Var;
+            while ( parcours )
+            {
+                if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
+                    IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        i = parcours->var->v_indicetabvars;
+                                        do
+                                        {
+                                            parcoursindic =  (listindice *)calloc(1,sizeof(listindice));
+                                            parcoursindic -> i_indice = i;
+                                            parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                            list_indic[parcours->var->v_catvar] = parcoursindic;
+                                            i = i + 1;
+                                        } while ( i <= parcours->var->v_indicetabvars+compteur );
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        parcoursindic =  (listindice *) calloc(1,sizeof(listindice));
+                                        parcoursindic -> i_indice = parcours->var->v_indicetabvars;
+                                        parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                        list_indic[parcours->var->v_catvar] = parcoursindic;
+                                    }
+                                    neededparameter = writedeclarationintoamr(List_Parameter_Var,
+                                                        paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname);
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+
+                                if (v->v_nbdim == 0)
+                                {
+                                    strcpy(ligne2,initialvalue);
+                                }
+                                else
+                                {
+                                    sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0));
+                                }
+                                strcat(ligne,ligne2);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
+            }
+            /* Close the file Alloc_agrif                                        */
+            fclose(allocationagrif);
+            fclose(paramtoamr);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
+}
+
+void write_allocation_Global_0()
+{
+    listnom *parcours_nom;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    int typeiswritten ;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfModule;
+    ValeurMax = 2;
+
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            IndiceMax = 0;
+            IndiceMin = indicemaxtabvars[0];
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+
+//             if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+//             {
+//                 /* add the call to initworkspace         */
+//                 tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1);
+//                 tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"else",1);
+//                 tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"endif",1);
+//                 tofich(allocationagrif,"call Agrif_InitWorkspace",1);
+//             }
+
+            typeiswritten = 0;
+            parcours = List_Global_Var;
+            while ( parcours )
+            {
+                if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+                       parcours->var->v_VariableIsParameter == 0                  &&
+                       parcours->var->v_notgrid == 0  )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                    }
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+                                strcat (ligne,initialvalue);
+                                Save_Length(ligne,48);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        /* Case of structure types */
+                        if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") )
+                        {
+                            sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            sprintf(ligne,"    allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            tofich(allocationagrif, "endif", 1);
+                            typeiswritten = 1;
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
+            }
+            if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+            {
+                fprintf(allocationagrif, "      if ( .not.Agrif_Root() ) then\n");
+                fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      else\n");
+                fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      endif\n");
+                fprintf(allocationagrif, "      call Agrif_InitWorkspace\n");
+            }
+            fclose(allocationagrif);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
+}
+
+/******************************************************************************/
+/*                           creefichieramr                                   */
+/******************************************************************************/
+/* This subroutine is the main one to create AGRIF_INC files                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void creefichieramr ()
+{
+    listvar *newvar;
+    variable *v;
+    int erreur;
+    char filefich[LONG_M];
+
+    int InitEmpty;
+    int VarnameEmpty;
+    int donotwrite;
+
+    FILE *initproc;
+    FILE *initglobal;
+    FILE *createvarname;
+    FILE *createvarnameglobal;
+
+    if ( todebug == 1 ) printf("Enter in creefichieramr\n");
+
+    sprintf(filefich, "cd %s", include_dir);
+    erreur = system (filefich);
+    if (erreur)
+    {
+        sprintf(filefich, "mkdir -p %s", include_dir);
+        system(filefich);
+        printf("%s: Directory created\n", include_dir);
+    }
+
+/******************************************************************************/
+/******************** Creation of AGRIF_INC files *****************************/
+/******************************************************************************/
+
+    if ( todebug == 1 )
+    {
+        const char *NameTampon = "toto";
+        sprintf(filefich,"initialisations_agrif_%s.h", NameTampon);
+        initproc = open_for_write(filefich);
+
+        sprintf(filefich,"createvarname_agrif_%s.h", NameTampon);
+        createvarname = open_for_write(filefich);
+
+        InitEmpty = 1 ;
+        VarnameEmpty = 1 ;
+
+        newvar = List_Global_Var;
+        while ( newvar )
+        {
+            donotwrite = 0;
+            v = newvar->var;
+
+            if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
+            {
+                write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
+                write_initialisationsagrif_file(v,initproc,&InitEmpty);
+            }
+            newvar = newvar->suiv;
+        }
+        fclose (createvarname);
+        fclose (initproc);
+
+        if ( is_dependfile_created(curmodulename) == 0 )
+        {
+            if ( InitEmpty != 1  )
+            {
+                initglobal = open_for_append("initialisations_agrif.h");
+                fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon);
+                fclose(initglobal);
+            }
+            if ( VarnameEmpty != 1 )
+            {
+                createvarnameglobal= open_for_append("createvarname_agrif.h");
+                fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon);
+                fclose(createvarnameglobal);
+            }
+        }
+    }
+    write_allocation_Common_0();
+    write_allocation_Global_0();
+
+    Write_Alloc_Agrif_Files();
+    write_probdimagrif_file();
+    write_keysagrif_file();
+    write_modtypeagrif_file();
+
+    if ( NbMailleXDefined == 1 )
+    {
+        write_Setnumberofcells_file();
+        write_Getnumberofcells_file();
+    }
+
+    if ( todebug == 1 ) printf("Out of creefichieramr\n");
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/agrif_opa.in
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/agrif_opa.in	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/agrif_opa.in	(revision 8732)
@@ -0,0 +1,12 @@
+% Number of cells in each direction %
+ 2D nbcellsx,nbcellsy;
+% Name of the common file : an include file (paramfile) OR a module (parammodule) %  
+ parammodule par_oce ;
+
+USE ONLY_FIXED_GRIDS;
+
+% Variables which are not grid dependent %
+% notgriddep :: name of the variable; %
+notgriddep :: nstop;
+
+%USE DEBUG;%
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90	(revision 8732)
@@ -0,0 +1,1784 @@
+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
+!-------- Initialize to zero variables data 
+          ! approximate dimension
+          IF ( it == 1 .AND. l_cgd) THEN
+          ! Enter I*J I*J is larger thant total number of single files
+            if ( ((f_d_l(1)/(d_s_l(1,1)-3)) * (f_d_l(2)/(d_s_l(2,1)-3) )) .gt. d_n_t ) then 
+              CALL ZeroFill (f_id_o, f_v_nm(iv), f_d_l, v_d_nb(iv), v_type(iv), v_d_i(1:v_d_nb(iv),iv))
+            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
+!===
+SUBROUTINE ZeroFill(f_id_o,f_v_nm,f_d_l,v_d_nb,v_type,v_d_i)
+
+  IMPLICIT NONE
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+
+  INTEGER              :: v_d_nb, v_type ! variable # of dims, variable type, var Unlim dimension
+  INTEGER              :: f_id_o         ! Output file ID
+  INTEGER,DIMENSION(:) :: f_d_l, v_d_i    ! Global dimensions, variable dimensio ID
+  CHARACTER(LEN=chlen) :: f_v_nm         ! Variable name
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dims
+
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2), ALLOCATABLE :: i2_1d(:), i2_2d(:,:), i2_3d(:,:,:), i2_4d(:,:,:,:), i2_5d(:,:,:,:,:)
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4), ALLOCATABLE :: i4_1d(:), i4_2d(:,:), i4_3d(:,:,:), i4_4d(:,:,:,:), i4_5d(:,:,:,:,:)
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4), ALLOCATABLE    :: r4_1d(:), r4_2d(:,:), r4_3d(:,:,:), r4_4d(:,:,:,:), r4_5d(:,:,:,:,:)
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8), ALLOCATABLE    :: r8_1d(:), r8_2d(:,:), r8_3d(:,:,:), r8_4d(:,:,:,:), r8_5d(:,:,:,:,:)
+  
+  ! write(*,*) ' Into my sub... TOM'
+  ! write(*,*) f_id_o, TRIM(f_v_nm), v_d_nb , v_type
+  write(*,*) 'Variable: ',TRIM(f_v_nm), ' intiliazed to zero'
+  write(*,*)
+
+  ! define variable dimension
+  ALLOCATE(dims(v_d_nb)) 
+  dims=f_d_l(v_d_i)
+  SELECT CASE(v_type) 
+    ! INTEGER 1 and 2 
+    CASE (flio_i1,flio_i2)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(i2_1d(dims(1)))
+         i2_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_1d)
+         DEALLOCATE(i2_1d)
+       CASE(2)
+         ALLOCATE(i2_2d(dims(1),dims(2)))
+         i2_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_2d) 
+         DEALLOCATE(i2_2d)
+       CASE(3)
+         ALLOCATE(i2_3d(dims(1),dims(2),dims(3)))
+         i2_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_3d)
+         DEALLOCATE(i2_3d)
+       CASE(4)
+         ALLOCATE(i2_4d(dims(1),dims(2),dims(3),dims(4)))
+         i2_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_4d)
+         DEALLOCATE(i2_4d)
+       CASE(5)
+         ALLOCATE(i2_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         i2_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_5d)
+         DEALLOCATE(i2_5d)
+      END SELECT
+    ! INTEGER 4
+    CASE (flio_i4)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(i4_1d(dims(1)))
+         i4_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_1d)
+         DEALLOCATE(i4_1d)
+       CASE(2)
+         ALLOCATE(i4_2d(dims(1),dims(2)))
+         i4_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_2d)
+         DEALLOCATE(i4_2d)
+       CASE(3)
+         ALLOCATE(i4_3d(dims(1),dims(2),dims(3)))
+         i4_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_3d)
+         DEALLOCATE(i4_3d)
+       CASE(4)
+         ALLOCATE(i4_4d(dims(1),dims(2),dims(3),dims(4)))
+         i4_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_4d)
+         DEALLOCATE(i4_4d)
+       CASE(5)
+         ALLOCATE(i4_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         i4_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_5d)
+         DEALLOCATE(i4_5d)
+      END SELECT
+    ! FLOAT 4
+    CASE (flio_r4)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(r4_1d(dims(1)))
+         r4_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_1d) 
+         DEALLOCATE(r4_1d)
+       CASE(2)
+         ALLOCATE(r4_2d(dims(1),dims(2)))
+         r4_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_2d) 
+         DEALLOCATE(r4_2d)
+       CASE(3)
+         ALLOCATE(r4_3d(dims(1),dims(2),dims(3)))
+         r4_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_3d) 
+         DEALLOCATE(r4_3d)
+       CASE(4)
+         ALLOCATE(r4_4d(dims(1),dims(2),dims(3),dims(4)))
+         r4_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_4d)
+         DEALLOCATE(r4_4d)
+       CASE(5)
+         ALLOCATE(r4_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         r4_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_5d)
+         DEALLOCATE(r4_5d)
+      END SELECT
+    ! FLOAT 8
+    CASE (flio_r8)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(r8_1d(dims(1)))
+         r8_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_1d)
+         DEALLOCATE(r8_1d)
+       CASE(2)
+         ALLOCATE(r8_2d(dims(1),dims(2)))
+         r8_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_2d) 
+         DEALLOCATE(r8_2d)
+       CASE(3)
+         ALLOCATE(r8_3d(dims(1),dims(2),dims(3)))
+         r8_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_3d)
+         DEALLOCATE(r8_3d)
+       CASE(4)
+         ALLOCATE(r8_4d(dims(1),dims(2),dims(3),dims(4)))
+         r8_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_4d)
+         DEALLOCATE(r8_4d)
+       CASE(5)
+         ALLOCATE(r8_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         r8_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_5d)
+         DEALLOCATE(r8_5d)
+      END SELECT
+  END SELECT
+
+  DEALLOCATE (dims)
+
+END SUBROUTINE
+!===
+!--------------------
+END PROGRAM flio_rbld
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/LICENSE.html
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/LICENSE.html	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/LICENSE.html	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/README	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl	(revision 8732)
@@ -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 = `which 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh	(revision 8732)
@@ -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 r_53 114 smasson"
+    echo "./update_vendor.sh XMLIO_SERVER r_53 114 smasson"
+    echo "./update_vendor.sh AGRIF r_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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/License_CeCILL.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/License_CeCILL.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/License_CeCILL.txt	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90	(revision 8732)
@@ -0,0 +1,72 @@
+MODULE dom_ice_2
+   !!======================================================================
+   !!                   ***  MODULE  dom_ice  ***
+   !! LIM 2.0 Sea Ice :   Domain  variables
+   !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                       LIM2 sea-ice model
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE par_ice_2   ! LIM parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC    dom_ice_alloc_2    ! Called from nemogcm.F90
+
+   LOGICAL, PUBLIC ::   l_jeq     = .TRUE.     !: Equator inside the domain flag
+
+   INTEGER, PUBLIC ::   njeq , njeqm1          !: j-index of the equator if it is inside the domain
+      !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) )
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   covrai            !: sine of geographic latitude
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   area              !: surface of grid cell 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tms    , tmu      !: temperature and velocity points masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   wght              !: weight of the 4 neighbours to compute averages
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmv               !: y-velocity mask used for evp rheology 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   akappa , bkappa   !: first and third group of metric coefficients
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) ::   alambd            !: second group of metric coefficients
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmf               !: F-points masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmi               !: ice mask: =1 if ice thick > 0
+   !!----------------------------------------------------------------------
+   CONTAINS
+
+   INTEGER FUNCTION dom_ice_alloc_2()
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY:   ctl_warn   ! MPP library
+      INTEGER :: ierr(2)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( covrai(jpi,jpj)     , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) ,     &
+         &      wght  (jpi,jpj,2,2)                                               , STAT=ierr(1) )
+         !
+      ALLOCATE(                                                    &
+#if defined key_lim2_vp 
+         &        akappa(jpi,jpj,2,2)     , bkappa(jpi,jpj,2,2),   &
+         &        alambd(jpi,jpj,2,2,2,2) ,                        &
+#else
+         &        tmv(jpi,jpj) , tmf(jpi,jpj) , tmi(jpi,jpj) ,     &
+#endif
+         &        STAT=ierr(2) )
+         !
+      dom_ice_alloc_2 = MAXVAL(ierr)
+      IF( dom_ice_alloc_2 /= 0 )   CALL ctl_warn('dom_ice_alloc_2: failed to allocate arrays')
+      !
+   END FUNCTION dom_ice_alloc_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module         NO LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE dom_ice_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 8732)
@@ -0,0 +1,206 @@
+MODULE ice_2
+   !!======================================================================
+   !!                        ***  MODULE ice  ***
+   !! Sea Ice physics:  diagnostics variables of ice defined in memory
+   !!=====================================================================
+   !! History :  2.0  ! 2003-08  (C. Ethe)  F90: Free form and module
+   !!            3.3  ! 2009-05  (G.Garric) addition of the lim2_evp cas
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_ice_2      ! LIM sea-ice parameters
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC    ice_alloc_2  !  Called in iceini_2.F90
+
+   INTEGER , PUBLIC ::   numit        !: ice iteration index
+   REAL(wp), PUBLIC ::   rdt_ice      !: ice time step
+
+   !                                                   !!* namicerun read in iceini  *
+   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in     !: suffix of ice restart name (input)
+   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_indir  !: ice restart in directory
+   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out    !: suffix of ice restart name (output)
+   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_outdir !: ice restart out directory
+   LOGICAL               , PUBLIC ::   ln_limdyn        !: flag for ice dynamics (T) or not (F)
+   LOGICAL               , PUBLIC ::   ln_limdmp        !: Ice damping
+   REAL(wp)              , PUBLIC ::   hsndif           !: snow temp. computation (0) or not (9999)
+   REAL(wp)              , PUBLIC ::   hicdif           !: ice  temp. computation (0) or not (9999)
+   REAL(wp), DIMENSION(2), PUBLIC ::   acrit            !: minimum lead fraction in the 2 hemisphere
+   !
+   LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.     !: flag grid points output (T) or not (F)
+   !                                !!* ice-dynamic namelist (namicedyn) *
+   INTEGER , PUBLIC ::   nbiter      !: number of sub-time steps for relaxation
+   INTEGER , PUBLIC ::   nbitdr      !: maximum number of iterations for relaxation
+   INTEGER , PUBLIC ::   nn_nevp     !: number of EVP subcycling iterations
+   INTEGER , PUBLIC ::   telast      !: timescale for EVP elastic waves
+   REAL(wp), PUBLIC ::   epsd        !: tolerance parameter for dynamic
+   REAL(wp), PUBLIC ::   alpha       !: coefficient for semi-implicit coriolis
+   REAL(wp), PUBLIC ::   dm          !: diffusion constant for dynamics
+   REAL(wp), PUBLIC ::   om          !: relaxation constant
+   REAL(wp), PUBLIC ::   resl        !: maximum value for the residual of relaxation
+   REAL(wp), PUBLIC ::   cw          !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   angvg       !: turning angle for oceanic stress
+   REAL(wp), PUBLIC ::   pstar       !: first bulk-rheology parameter
+   REAL(wp), PUBLIC ::   c_rhg       !: second bulk-rhelogy parameter
+   REAL(wp), PUBLIC ::   etamn       !: minimun value for viscosity
+   REAL(wp), PUBLIC ::   rn_creepl   !: creep limit
+   REAL(wp), PUBLIC ::   rn_ecc      !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   ahi0        !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   REAL(wp), PUBLIC ::   alphaevp    !: coefficient for the solution of EVP int. stresses
+
+   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( rn_ecc * rn_ecc )
+   REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw
+   REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress
+   REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0
+
+   !                                !!** switch for presence of ice or not 
+   REAL(wp), PUBLIC ::   rswitch
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   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, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hsnm , hicm   !: mean snow and ice thicknesses
+   !
+# else
+   !                                                      !!* EVP rheology *
+   LOGICAL , PUBLIC::   lk_lim2_vp = .FALSE.               !: Visco-Plactic reology flag 
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i     !: first stress tensor element       
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress2_i     !: second stress tensor element
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress12_i    !: diagonal stress tensor element
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i          !: ice fraction
+   !
+   REAL(wp), PUBLIC, DIMENSION(:,:)    , POINTER :: vt_s ,vt_i    !: mean snow and ice thicknesses
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers 
+#endif
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif       !: ice volume change at ice surface (only used for outputs)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif       !: Total   ice volume change (only used for outputs)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif       !: Lateral ice volume change (only used for outputs)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist          !: Sea-Ice Surface Temperature [Kelvin]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicif         !: Ice thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hsnif         !: Snow thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp        !: Ice production/melting
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld          !: Leads fraction = 1-a/totalarea
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif        !: ice thickness  at previous time 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld         !: Leads fraction at previous time  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qstoif        !: Energy stored in the brine pockets
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif          !: Heat flux at the ice base
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw       !: Variation of snow mass over 1 time step           [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw       !: Heat content associated with rdm_snw              [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice       !: Variation of ice  mass over 1 time step           [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice       !: Heat content associated with rdm_ice              [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif         !: heat balance of the lead (or of the open ocean)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif         !: Energy needed to freeze the ocean surface layer
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn         !: net downward heat flux from the ice to the ocean
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thcm          !: part of the solar energy used in the lead heat budget
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric_mean   !: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric        !: Solar flux transmitted trough the ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif       !: linked with the max heat contained in brine pockets (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq        !: Linked with the solar flux below the ice (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq         !: Also linked with the solar flux below the ice (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi         !: Variation of the mass of snow ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tbif  !: Temperature inside the ice/snow layer
+
+   !!* moment used in the advection scheme
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume                  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area               
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow         
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets
+   !!----------------------------------------------------------------------
+   CONTAINS
+
+   INTEGER FUNCTION ice_alloc_2()
+      !!-----------------------------------------------------------------
+      !!               *** FUNCTION ice_alloc_2 ***
+      !!-----------------------------------------------------------------
+      USE lib_mpp, ONLY:   ctl_warn   ! MPP library
+      INTEGER :: ierr(9)              ! Local variables
+      !!-----------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( ahiu(jpi,jpj) , pahu(jpi,jpj) ,                      &
+         &      ahiv(jpi,jpj) , pahv(jpi,jpj) , ust2s(jpi,jpj) , STAT=ierr(1) )
+         !
+      !* Ice Rheology
+#if defined key_lim2_vp
+      ALLOCATE( hsnm(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) )
+#else
+      ALLOCATE( stress1_i (jpi,jpj) , delta_i(jpi,jpj) , at_i(jpi,jpj) ,     &
+                stress2_i (jpi,jpj) , divu_i (jpi,jpj) , hsnm(jpi,jpj) ,     &
+                stress12_i(jpi,jpj) , shear_i(jpi,jpj) , hicm(jpi,jpj) , STAT=ierr(2) )
+#endif
+      ALLOCATE( rdvosif(jpi,jpj) , rdvobif(jpi,jpj) ,                      &
+         &      fdvolif(jpi,jpj) , rdvonif(jpi,jpj) ,                      &
+         &      sist   (jpi,jpj) , tfu    (jpi,jpj) , hicif(jpi,jpj) ,     &
+         &      hsnif  (jpi,jpj) , hicifp (jpi,jpj) , frld (jpi,jpj) , STAT=ierr(3) )
+
+      ALLOCATE(phicif(jpi,jpj) , pfrld  (jpi,jpj) , qstoif (jpi,jpj) ,     &
+         &     fbif  (jpi,jpj) , rdm_snw(jpi,jpj) , rdq_snw(jpi,jpj) ,     &
+         &                       rdm_ice(jpi,jpj) , rdq_ice(jpi,jpj) ,     &
+         &     qldif (jpi,jpj) , qcmif  (jpi,jpj) , fdtcn  (jpi,jpj) ,     &
+         &     qdtcn (jpi,jpj) , thcm   (jpi,jpj)                    , STAT=ierr(4) )
+
+      ALLOCATE(fstric(jpi,jpj) , ffltbif(jpi,jpj) , fscmbq(jpi,jpj) ,     &
+         &     fsbbq (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi (jpi,jpj) ,     &
+         &     u_ice (jpi,jpj) , v_ice  (jpi,jpj) ,                       &
+         &     u_oce (jpi,jpj) , v_oce  (jpi,jpj) ,                       &
+         &     tbif  (jpi,jpj,jplayersp1)                           , STAT=ierr(5))
+
+      !* moment used in the advection scheme
+      ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     &
+         &     syyice(jpi,jpj) , sxyice(jpi,jpj) ,                       &
+         &     sxsn  (jpi,jpj) , sysn  (jpi,jpj) , sxxsn (jpi,jpj) ,     &
+         &     syysn (jpi,jpj) , sxysn (jpi,jpj)                   , STAT=ierr(6) )
+      ALLOCATE(sxa   (jpi,jpj) , sya   (jpi,jpj) , sxxa  (jpi,jpj) ,     &
+         &     syya  (jpi,jpj) , sxya  (jpi,jpj) ,                       & 
+         &     sxc0  (jpi,jpj) , syc0  (jpi,jpj) , sxxc0 (jpi,jpj) ,     &
+         &     syyc0 (jpi,jpj) , sxyc0 (jpi,jpj)                   , STAT=ierr(7))
+      ALLOCATE(sxc1  (jpi,jpj) , syc1  (jpi,jpj) , sxxc1 (jpi,jpj) ,     &
+         &     syyc1 (jpi,jpj) , sxyc1 (jpi,jpj) ,                       &
+         &     sxc2  (jpi,jpj) , syc2  (jpi,jpj) , sxxc2 (jpi,jpj) ,     &
+         &     syyc2 (jpi,jpj) , sxyc2 (jpi,jpj)                   , STAT=ierr(8))
+      ALLOCATE(sxst  (jpi,jpj) , syst  (jpi,jpj) , sxxst (jpi,jpj) ,     &
+         &     syyst (jpi,jpj) , sxyst (jpi,jpj)                   , STAT=ierr(9))
+         !
+      ice_alloc_2 = MAXVAL( ierr )
+      !
+      IF( ice_alloc_2 /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays')
+      !
+   END FUNCTION ice_alloc_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module        NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+#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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 8732)
@@ -0,0 +1,157 @@
+MODULE iceini_2
+   !!======================================================================
+   !!                       ***  MODULE iceini   ***
+   !!   Sea-ice model : LIM 2.0 Sea ice model Initialization
+   !!======================================================================
+   !! History :  1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!            2.0  ! 2003-08  (C. Ethe)  add ice_run
+   !!            3.3  ! 2009-05  (G. Garric, C. Bricaud) addition of the lim2_evp case
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_init_2    : sea-ice model initialization
+   !!   ice_run_2     : Definition some run parameter for ice model
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE sbc_ice        ! LIM2 surface boundary condition
+   USE dom_ice_2      ! LIM2 ice domain
+   USE par_ice_2      ! LIM2 parameters
+   USE thd_ice_2      ! LIM2 thermodynamical variables
+   USE ice_2          ! LIM2 ice variable
+   USE limmsh_2       ! LIM2 mesh
+   USE limistate_2    ! LIM2 initial state
+   USE limrst_2       ! LIM2 restart
+   USE limsbc_2       ! LIM2 surface boundary condition
+   USE limdia_2
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_init_2               ! called by sbcice_lim_2.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_init_2
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_init_2  ***
+      !!
+      !! ** purpose :   initialisation of LIM-2 domain and variables  
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_init_2 : LIM-2 sea-ice - initialization'
+         WRITE(numout,*) '~~~~~~~~~~~   '
+      ENDIF
+      !                                
+      !                                ! Allocate the ice arrays
+      ierr =        ice_alloc_2    ()       ! ice variables
+      ierr = ierr + dom_ice_alloc_2()       ! domain
+      ierr = ierr + sbc_ice_alloc  ()       ! surface forcing
+      ierr = ierr + thd_ice_alloc_2()       ! thermodynamics
+
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ice_init_2 : unable to allocate ice arrays' )
+
+      !                                ! adequation jpk versus ice/snow layers
+      IF( jpl > jpk  .OR.  jplayersp1 > jpk  )   CALL ctl_stop( 'STOP',           &
+         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   &
+         &     'use more ocean levels or less ice layers/categories.' )
+
+      !                                ! Open the reference and configuration namelist files and namelist output file 
+      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
+      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+
+      !                                ! Open the namelist file 
+      !    
+      CALL ice_run_2                   ! read in namelist some run parameters
+      !          
+      rdt_ice = nn_fsbc * rdt          ! 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
+      !
+      IF( .NOT.lk_mpp )               CALL lim_dia_init_2  ! online diagnostics in mono proc only
+      !
+      tn_ice(:,:,1) = sist(:,:)        ! ice temperature  known by the ocean
+      fr_i  (:,:)   = 1.0 - frld(:,:)  ! sea-ice fraction known by the ocean
+      !
+      CALL lim_sbc_init_2              ! ice surface boundary condition   
+      !
+      IF( lk_lim2_vp )   THEN   ;   IF(lwp) WRITE(numout,*) '                VP  rheology - B-grid case'
+      ELSE                      ;   IF(lwp) WRITE(numout,*) '                EVP rheology - C-grid case'
+      ENDIF
+      !
+   END SUBROUTINE ice_init_2
+
+
+   SUBROUTINE ice_run_2
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_run_2 ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for ice model
+      !!
+      !! ** Method  :   Read the namicerun namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicerun
+      !!-------------------------------------------------------------------
+      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, &
+                          ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!-------------------------------------------------------------------
+      !                    
+      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicerun )
+      !
+      IF(lwp) THEN                              ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
+         WRITE(numout,*) '   Ice damping                                 ln_limdmp   = ', ln_limdmp
+         WRITE(numout,*) '   minimum fraction for leads in the NH (SH)  acrit(1/2)   = ', acrit(:)
+         WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif
+         WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif
+      ENDIF
+      !
+   END SUBROUTINE ice_run_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :        Empty module       NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ice_init_2      ! Empty routine
+   END SUBROUTINE ice_init_2
+#endif
+
+   !!======================================================================
+END MODULE iceini_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90	(revision 8732)
@@ -0,0 +1,424 @@
+MODULE limadv_2 
+   !!======================================================================
+   !!                       ***  MODULE limadv_2   ***
+   !! LIM 2.0 sea-ice model : sea-ice advection
+   !!======================================================================
+   !! History :  OPA  ! 2000-01 (LIM)  Original code
+   !!                 ! 2001-05 (G. Madec, R. Hordoir) Doctor norm
+   !!   NEMO     1.0  ! 2003-10 (C. Ethe) F90, module
+   !!             -   ! 2003-12 (R. Hordoir, G. Madec) mpp
+   !!            3.2  ! 2009-06 (F. Dupont)  correct a error in the North fold b. c.
+   !!--------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_adv_x_2   : advection of sea ice on x axis
+   !!   lim_adv_y_2   : advection of sea ice on y axis
+   !!----------------------------------------------------------------------
+   USE dom_oce
+   USE dom_ice_2
+   USE ice_2
+   USE lbclnk
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_adv_x_2   ! called by lim_trp
+   PUBLIC   lim_adv_y_2   ! called by lim_trp
+
+   REAL(wp)  ::   epsi20 = 1.e-20   ! constant values
+   REAL(wp)  ::   rzero  = 0.e0     !    -       -
+   REAL(wp)  ::   rone   = 1.e0     !    -       -
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_adv_x_2( pdf, put , pcrh, psm , ps0 ,   &
+      &                    psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine lim_adv_x_2  **
+      !!  
+      !! ** purpose :   Computes and adds the advection trend to sea-ice
+      !!              variable on i-axis
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects tracers
+      !!              but also theirquadratic forms. The method preserves
+      !!              tracer structures by conserving second order moments.
+      !!
+      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
+      !!--------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
+      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   put                ! i-direction ice velocity at U-point [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
+      ! 
+      INTEGER  ::   ji, jj                               ! dummy loop indices
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
+      REAL(wp), DIMENSION(:,:), POINTER ::   zf0, zfx , zfy , zbet   ! 2D workspace
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfm, zfxx, zfyy, zfxy   !  -      -
+      REAL(wp), DIMENSION(:,:), POINTER ::   zalg, zalg1, zalg1q     !  -      -
+      !---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+
+      ! Limitation of moments.                                           
+
+      zrdt = rdt_ice * pdf      ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( rzero, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) )
+            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
+               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
+            zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+            !
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = zs1new      * zin0
+            psxx(ji,jj) = zs2new      * zin0
+            psy (ji,jj) = psy (ji,jj) * zin0
+            psyy(ji,jj) = psyy(ji,jj) * zin0
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+      psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+
+      !  Calculate fluxes and moments between boxes i<-->i+1              
+      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0 
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) )
+            zalf         =  MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  * psm(ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj)  ) )
+            zfx (ji,jj)  =  zalfq * ( psx(ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )
+            zfxx(ji,jj)  =  zalf  * zalfq * psxx(ji,jj)
+            zfy (ji,jj)  =  zalf  * ( psy(ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
+            zfyy(ji,jj)  =  zalf  * psyy(ji,jj)
+            !
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psx (ji,jj)  =  zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )
+            psxx(ji,jj)  =  zalf1  * zalf1q * psxx(ji,jj)
+            psy (ji,jj)  =  psy (ji,jj) - zfy(ji,jj)
+            psyy(ji,jj)  =  psyy(ji,jj) - zfyy(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0.
+         DO ji = 1, fs_jpim1
+            zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  * psm(ji+1,jj)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0(ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )
+            zfx   (ji,jj) = zfx (ji,jj) + zalfq * ( psx(ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  * zalfq * psxx(ji+1,jj)
+            zfy   (ji,jj) = zfy (ji,jj) + zalf  * ( psy(ji+1,jj) - zalf1 * psxy(ji+1,jj) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj)
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  * psyy(ji+1,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )
+            psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )
+            psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)
+            psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )
+            psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)
+            zalf        = zbt * zfm(ji-1,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)
+            !
+            ps0 (ji,jj) = zbt * (ps0(ji,jj) + zf0(ji-1,jj)) + zbt1 * ps0(ji,jj)
+            psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)
+            psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj)                               &
+               &                + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  )   &
+               &        + zbt1 * psxx(ji,jj)
+            psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj)             &
+               &                + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj) ) )   &
+               &         + zbt1 * psxy(ji,jj)
+            psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)
+            psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Flux from i+1 to i IF u LT 0.
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj)  = zbt * psm(ji,jj)  + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
+            !
+            ps0(ji,jj)  = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
+            psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * (  zalf * zalf * zfxx(ji,jj)  + zalf1 * zalf1 * psxx(ji,jj)   &
+               &                                      + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) )        &
+               &                                      + ( zalf1 - zalf ) * ztemp )                                 )
+            psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)          &
+               &                                      + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) )  )
+            psy(ji,jj)  = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. )
+      CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes
+      CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. )
+      CALL lbc_lnk( psxy, 'T',  1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_x: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
+         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_x: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
+         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_x: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
+         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :')
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+      !
+   END SUBROUTINE lim_adv_x_2
+
+
+   SUBROUTINE lim_adv_y_2( pdf, pvt , pcrh, psm , ps0 ,   &
+      &                    psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine lim_adv_y_2  **
+      !!            
+      !! ** purpose :   Computes and adds the advection trend to sea-ice 
+      !!              variable on j-axis
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects tracers
+      !!              but also their quadratic forms. The method preserves 
+      !!              tracer structures by conserving second order moments.
+      !!
+      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
+      !!---------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
+      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvt                ! j-direction ice velocity at V-point [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
+      !!
+      INTEGER  ::   ji, jj                               ! dummy loop indices
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
+      REAL(wp), DIMENSION(:,:), POINTER ::   zf0, zfx , zfy , zbet   ! 2D workspace
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfm, zfxx, zfyy, zfxy   !  -      -
+      REAL(wp), DIMENSION(:,:), POINTER ::   zalg, zalg1, zalg1q     !  -      -
+      !---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+
+      ! Limitation of moments.
+
+      zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( rzero, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) )
+            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
+               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
+            zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+            !
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = psx (ji,jj) * zin0
+            psxx(ji,jj) = psxx(ji,jj) * zin0
+            psy (ji,jj) = zs1new * zin0
+            psyy(ji,jj) = zs2new * zin0
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
+      psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
+
+      !  Calculate fluxes and moments between boxes j<-->j+1              
+      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0   
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) )
+            zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            zfm (ji,jj)  =  zalf  * psm(ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) ) 
+            zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) )
+            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj)
+            zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
+            zfxx(ji,jj)  =  zalf  * psxx(ji,jj)
+            !
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) )
+            psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj)
+            psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj)
+            psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+      !
+      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
+         DO ji = 1, jpi
+            zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  * psm(ji,jj+1)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0(ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) )
+            zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy(ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) )
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  * zalfq * psyy(ji,jj+1)
+            zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx(ji,jj+1) - zalf1 * psxy(ji,jj+1) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1)
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  * psxx(ji,jj+1)
+         END DO
+      END DO
+ 
+      !  Readjust moments remaining in the box. 
+      DO jj = 2, jpj
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            !
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) )
+            psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) )
+            psyy(ji,jj) = zalg1 (ji,jj-1)  * zalg1q(ji,jj-1) * psyy(ji,jj)
+            psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) )
+            psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 
+            zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj) 
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1)
+            !
+            ps0(ji,jj)  = zbt * (ps0(ji,jj) + zf0(ji,jj-1)) + zbt1 * ps0(ji,jj)
+            psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   &
+               &        + zbt1 * psy(ji,jj)  
+            psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             &
+               &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   & 
+               &        + zbt1 * psyy(ji,jj)
+            psxy(ji,jj) = zbt  * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)              &
+               &                 + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) )   &
+               &        + zbt1 * psxy(ji,jj)
+            psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj)
+            psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj)
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0.
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj)
+            zbt1 = ( 1.0 - zbet(ji,jj) )
+            psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
+            ps0(ji,jj)  = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
+            psy(ji,jj)  = zbt  * psy(ji,jj)  &
+               &        + zbt1 * ( zalf*zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp )
+            psyy(ji,jj) = zbt  * psyy(ji,jj)                                                                         &
+               &        + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)                           &
+               &                 + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj) = zbt  * psxy(ji,jj)                                  &
+               &        + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)   &
+               &                 + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) )
+            psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. )
+      CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes
+      CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. )
+      CALL lbc_lnk( psxy, 'T',  1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_y: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
+         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_y: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
+         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_y: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
+         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_y: psxy :')
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+      !
+   END SUBROUTINE lim_adv_y_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy module     NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limadv_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90	(revision 8732)
@@ -0,0 +1,286 @@
+MODULE limdia_2
+   !!======================================================================
+   !!                       ***  MODULE limdia_2   ***
+   !!                      diagnostics of ice model 
+   !!======================================================================
+   !! History :   8.0  !  97-06  (Louvain-La-Neuve)  Original code
+   !!             8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module
+   !!             9.0  !  06-08  (S. Masson)  change frequency output control
+   !!-------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_dia_2      : computation of the time evolution of keys var.
+   !!   lim_dia_init_2 : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! 
+   USE par_ice_2       ! ice parameters
+   USE sbc_oce         ! surface boundary condition variables
+   USE dom_ice_2       !
+   USE ice_2           !
+   USE limistate_2     !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2
+   PUBLIC               lim_dia_init_2     ! called by sbc_ice_lim_2
+
+   INTEGER, PUBLIC ::   ntmoy  ,   &  !: instantaneous values of ice evolution or averaging ntmoy
+      &                 ninfo         !: frequency of ouputs on file ice_evolu in case of averaging
+
+   INTEGER, PARAMETER ::   &  ! Parameters for outputs to files "evolu"
+      jpinfmx = 100         ,    &  ! maximum number of key variables
+      jpchinf = 5           ,    &  ! ???
+      jpchsep = jpchinf + 2         ! ???
+
+   INTEGER ::   &
+      nfrinf ,          &  ! number of variables written in one line 
+      nferme ,          &  ! last time step at which the var. are written on file
+      nvinfo ,          &  ! number of total variables 
+      nbvt   ,          &  ! number of time variables
+      naveg                ! number of step for accumulation before averaging
+
+   CHARACTER(len= 8) ::   fmtinf   ! format of the output values  
+   CHARACTER(len=30) ::   fmtw  ,           &  ! formats
+      &                   fmtr  ,           &  ! ???
+      &                   fmtitr               ! ???
+   CHARACTER(len=jpchsep), DIMENSION(jpinfmx) ::   titvar               ! title of key variables
+ 
+   REAL(wp)                     ::   epsi06 = 1.e-06      ! ???
+   REAL(wp), DIMENSION(jpinfmx) ::   vinfom               ! temporary working space
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   aire                 ! masked grid cell area
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_dia_2( kt )
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dia_2  ***
+      !!   
+      !! ** Purpose : Computation and outputs on file ice.evolu 
+      !!      the temporal evolution of some key variables
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  ::   jv,ji, jj   ! dummy loop indices
+      INTEGER  ::   nv          ! indice of variable 
+      REAL(wp) ::   zarea    , zldarea  ,    &  ! sea-ice and leads area
+         &          zextent15, zextent85,    &  ! sea-ice extent (15% and 85%)
+         &          zicevol  , zsnwvol  ,    &  ! sea-ice and snow volume volume
+         &          zicespd                     ! sea-ice velocity
+      REAL(wp), DIMENSION(jpinfmx) ::   vinfor  ! temporary working space 
+      !!-------------------------------------------------------------------
+
+      ! computation of key variables at each time step   
+
+      nv = 1 
+      vinfor(nv) = REAL( kt + nn_fsbc - 1 )
+      nv = nv + 1
+      vinfor(nv) = nyear
+ 
+      DO jv = nbvt + 1, nvinfo
+         vinfor(jv) = 0.e0
+      END DO
+
+      zextent15 = 0.e0
+      zextent85 = 0.e0
+      ! variables in northern Hemis
+      DO jj = njeq, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               zarea = ( 1.0 - frld(ji,jj) ) * aire(ji,jj)
+               IF (frld(ji,jj) <= 0.15 ) zextent15 = aire(ji,jj)    
+               IF (frld(ji,jj) <= 0.85 ) zextent85 = aire(ji,jj)   
+               zldarea = zarea   / MAX( ( 1 - frld(ji,jj) ) , epsi06 )
+               zicevol = zarea   * hicif(ji,jj)
+               zsnwvol = zarea   * hsnif(ji,jj)
+               zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj) + v_ice(ji,jj) * v_ice(ji,jj) )
+               vinfor(nv+ 1) = vinfor(nv+ 1) + zarea
+               vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15
+               vinfor(nv+ 5) = vinfor(nv+ 5) + zextent85
+               vinfor(nv+ 7) = vinfor(nv+ 7) + zldarea
+               vinfor(nv+ 9) = vinfor(nv+ 9) + zicevol
+               vinfor(nv+11) = vinfor(nv+11) + zsnwvol
+               vinfor(nv+13) = vinfor(nv+13) + zicespd
+            ENDIF
+         END DO
+      END DO
+      vinfor(nv+13) = SQRT( vinfor(nv+13) / MAX( vinfor(nv+9) , epsi06 ) )
+
+
+      ! variables in southern Hemis
+       nv = nv + 1
+       DO jj = 2, njeqm1
+          DO ji = fs_2, fs_jpim1   ! vector opt.
+             IF( tms(ji,jj) == 1 ) THEN
+                zarea = ( 1.0 - frld(ji,jj) ) * aire(ji,jj)
+                IF (frld(ji,jj) <= 0.15 ) zextent15 = aire(ji,jj)    
+                IF (frld(ji,jj) <= 0.85 ) zextent85 = aire(ji,jj)   
+                zldarea = zarea   / MAX( ( 1 - frld(ji,jj) ) , epsi06 )
+                zicevol = zarea   * hicif(ji,jj)
+                zsnwvol = zarea   * hsnif(ji,jj)
+                zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj) + v_ice(ji,jj) * v_ice(ji,jj) )
+                vinfor(nv+ 1) = vinfor(nv+ 1) + zarea
+                vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15
+                vinfor(nv+ 5) = vinfor(nv+ 5) + zextent85
+                vinfor(nv+ 7) = vinfor(nv+ 7) + zldarea
+                vinfor(nv+ 9) = vinfor(nv+ 9) + zicevol
+                vinfor(nv+11) = vinfor(nv+11) + zsnwvol
+                vinfor(nv+13) = vinfor(nv+13) + zicespd
+             ENDIF
+          END DO
+       END DO
+       vinfor(nv+13) = SQRT( vinfor(nv+13) / MAX( vinfor(nv+9) , epsi06 ) )    
+
+       !  Accumulation before averaging 
+       DO jv = 1, nvinfo
+          vinfom(jv) = vinfom(jv) + vinfor(jv)
+       END DO
+       naveg = naveg + 1  
+    
+       ! oututs on file ice_evolu    
+       IF( MOD( kt + nn_fsbc - 1, ninfo ) == 0 ) THEN
+          WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo )
+          naveg = 0
+          DO jv = 1, nvinfo
+             vinfom(jv) = 0.e0
+          END DO
+       ENDIF
+       !
+    END SUBROUTINE lim_dia_2
+ 
+
+    SUBROUTINE lim_dia_init_2
+       !!-------------------------------------------------------------------
+       !!                  ***  ROUTINE lim_dia_init_2  ***
+       !!             
+       !! ** Purpose : Preparation of the file ice_evolu for the output of
+       !!      the temporal evolution of key variables
+       !!
+       !! ** input   : Namelist namicedia
+       !!-------------------------------------------------------------------
+       CHARACTER(len=jpchinf) ::   titinf
+       INTEGER  ::   jv   ! dummy loop indice
+       INTEGER  ::   ntot , ndeb, nv, ierr   ! local integer
+       INTEGER  ::   ios                     ! Local integer output status for namelist read
+       REAL(wp) ::   zxx0, zxx1              ! local scalars
+
+       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy
+       !!-------------------------------------------------------------------
+                    
+       REWIND( numnam_ice_ref )              ! Namelist namicedia in reference namelist : Ice diagnostics in ice_evolu
+       READ  ( numnam_ice_ref, namicedia, IOSTAT = ios, ERR = 901)
+901    IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedia in reference namelist', lwp )
+
+       REWIND( numnam_ice_cfg )              ! Namelist namicedia in configuration namelist : Ice diagnostics in ice_evolu 
+       READ  ( numnam_ice_cfg, namicedia, IOSTAT = ios, ERR = 902 )
+902    IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedia in configuration namelist', lwp )
+       IF(lwm) WRITE ( numoni, namicedia )
+       
+       IF(lwp) THEN                             ! control print
+          WRITE(numout,*)
+          WRITE(numout,*) 'lim_dia_init_2 : ice parameters for ice diagnostics '
+          WRITE(numout,*) '~~~~~~~~~~~~~~'
+          WRITE(numout,*) '   format of the output values                                 fmtinf = ', fmtinf
+          WRITE(numout,*) '   number of variables written in one line                     nfrinf = ', nfrinf 
+          WRITE(numout,*) '   Instantaneous values of ice evolution or averaging          ntmoy  = ', ntmoy
+          WRITE(numout,*) '   frequency of ouputs on file ice_evolu in case of averaging  ninfo  = ', ninfo
+       ENDIF
+
+       ALLOCATE( aire(jpi,jpj) , STAT=ierr )    ! masked grid cell area
+       IF( lk_mpp    )   CALL mpp_sum( ierr )
+       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate standard arrays' )
+       aire(:,:) = area(:,:) * tms(:,:)
+
+       nv = 1                                   ! Titles of ice key variables
+       titvar(nv) = 'NoIt'  ! iteration number
+       nv = nv + 1
+       titvar(nv) = 'T yr'  ! time step in years
+       nbvt = nv - 1
+       nv = nv + 1   ;   titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'A15N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'A15S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'A85N'  ! sea ice extent (85%) in the northern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'A85S'  ! sea ice extent (85%) in the southern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'ALEN'  ! leads area in the northern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'ALES'  ! leads area in the southern Hemisp.(10^12 km2)
+       nv = nv + 1   ;   titvar(nv) = 'VOLN'  ! sea ice volume in the northern Hemisp.(10^3 km3)
+       nv = nv + 1   ;   titvar(nv) = 'VOLS'  ! sea ice volume in the southern Hemisp.(10^3 km3)
+       nv = nv + 1   ;   titvar(nv) = 'VONN'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
+       nv = nv + 1   ;   titvar(nv) = 'VONS'  ! snow volume over sea ice in the southern Hemisp.(10^3 km3)
+       nv = nv + 1   ;   titvar(nv) = 'ECGN'  ! mean sea ice velocity in the northern Hemisp.(m/s)
+       nv = nv + 1   ;   titvar(nv) = 'ECGS'  ! mean sea ice velocity in the southern Hemisp.(m/s)
+
+       nvinfo = nv
+
+       ! Definition et Ecriture de l'entete : nombre d'enregistrements 
+       ndeb   = ( nit000 - 1 + nn_fsbc - 1 ) / ninfo
+       IF( nit000 - 1 + nn_fsbc == 1 ) ndeb = -1
+
+       nferme = ( nitend + nn_fsbc - 1 ) / ninfo ! nit000 - 1 + nn_fsbc - 1 + nitend - nit000 + 1
+       ntot   = nferme - ndeb
+       ndeb   = ninfo * ( 1 + ndeb )
+       nferme = ninfo * nferme
+
+       ! definition of formats 
+       WRITE( fmtw  , '(A,I3,A2,I1,A)' )  '(', nfrinf, '(A', jpchsep, ','//fmtinf//'))'
+       WRITE( fmtr  , '(A,I3,A,I1,A)'  )  '(', nfrinf, '(', jpchsep, 'X,'//fmtinf//'))'
+       WRITE( fmtitr, '(A,I3,A,I1,A)'  )  '(', nvinfo, 'A', jpchinf, ')'
+
+       ! opening  "ice_evolu" file
+       CALL ctl_opn( numevo_ice, 'ice_evolu', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+
+       !- ecriture de 2 lignes d''entete :
+       WRITE(numevo_ice,1000) fmtr, fmtw, fmtitr, nvinfo, ntot, 0, nfrinf
+       zxx0 = 0.001 * REAL( ninfo )
+       zxx1 = 0.001 * REAL( ndeb  )
+       WRITE(numevo_ice,1111) REAL(jpchinf), 0., zxx1, zxx0, 0., 0., 0
+
+       !- ecriture de 2 lignes de titre :
+       WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                 &
+          'Evolution chronologique - Experience '//cexper   &
+          //'   de', ndeb, ' a', nferme, ' pas', ninfo
+       WRITE(numevo_ice,fmtitr) ( titvar(jv), jv = 1, nvinfo )
+
+
+       !--preparation de "titvar" pour l''ecriture parmi les valeurs numeriques :
+       DO  jv = 2 , nvinfo
+          titinf     = titvar(jv)(:jpchinf)
+          titvar(jv) = '  '//titinf
+       END DO
+
+       !--Initialisation of the arrays for the accumulation
+       DO  jv = 1, nvinfo
+          vinfom(jv) = 0.
+       END DO
+       naveg = 0
+
+1000   FORMAT( 3(A20),4(1x,I6) )
+1111   FORMAT( 3(F7.1,1X,F7.3,1X),I3,A )  
+      !
+    END SUBROUTINE lim_dia_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                           NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dia_2         ! Empty routine
+   END SUBROUTINE lim_dia_2
+#endif
+
+   !!======================================================================
+END MODULE limdia_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 8732)
@@ -0,0 +1,181 @@
+MODULE limdmp_2
+   !!======================================================================
+   !!                       ***  MODULE limdmp_2   ***
+   !!  LIM-2 ice model : restoring Ice thickness and Fraction leads
+   !!======================================================================
+   !! History :   2.0  !  2004-04 (S. Theetten) Original code
+   !!             3.3  !  2010-06 (J.-M. Molines) use of fldread
+   !!----------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_dmp_2     : ice model damping
+   !!----------------------------------------------------------------------
+   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
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_dmp_2     ! called by sbc_ice_lim2
+
+   INTEGER  , PARAMETER :: jp_hicif = 1 , jp_frld = 2
+   REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   resto_ice   ! restoring coeff. on ICE   [s-1]
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:)     ::   sf_icedmp   ! structure of ice damping input
+   
+   !! * Substitution
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM 3.3 , UCL-NEMO-consortium (2010) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_dmp_2( kt )
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_dmp_2  ***
+      !!
+      !! ** purpose :   restore ice thickness and lead fraction
+      !!
+      !! ** method  :   restore ice thickness and lead fraction using a restoring
+      !!              coefficient defined by the user in lim_dmp_init
+      !!
+      !! ** Action  : - update hicif and frld  
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   zfrld, zhice   ! local scalars
+      !!---------------------------------------------------------------------
+      !
+      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 )
+         !
+         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) )  ) 
+         frld (:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up
+            &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  )
+         !
+      ENDIF
+      !
+   END SUBROUTINE lim_dmp_2
+
+
+   SUBROUTINE lim_dmp_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_dmp_init  ***
+      !!
+      !! ** Purpose :   set the coefficient for the ice thickness and lead fraction restoring
+      !!
+      !! ** Method  :   restoring is used to mimic ice open boundaries.
+      !!              the restoring coef. (a 2D array) has to be defined by the user.
+      !!              here is given as an example a restoring along north and south boundaries
+      !!      
+      !! ** Action  :   define resto_ice(:,:,1)
+      !!----------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk       ! dummy loop indices
+      INTEGER  :: irelax, ierror   ! error flag for allocation
+      INTEGER  ::   ios            ! Local integer output status for namelist read
+      !
+      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 
+      !     --------------------------------------------
+                  
+      REWIND( numnam_ice_ref )              ! Namelist namice_dmp in reference namelist : Ice restoring
+      READ  ( numnam_ice_ref, namice_dmp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_dmp in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist  namice_dmp in configuration namelist : Ice restoring
+      READ  ( numnam_ice_cfg, namice_dmp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_dmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, 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
+         !
+         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 )
+
+         !    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(1), mj1( irelax)
+            zreltim = zdmpmin + zfactor * mjg(jj)
+            resto_ice(:,jj,:) = 1._wp / ( zreltim * 86400._wp )
+         END DO
+
+         ! North boundary restoring term
+         DO jj =  mj0(jpjglo - irelax), mj1(jpjglo)
+            zreltim = zdmpmin + zfactor * (jpjglo - mjg(jj))
+            resto_ice(:,jj,:) = 1.e0 / ( zreltim * 86400 )
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE lim_dmp_init
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module                  No ice damping
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dmp_2( kt )        ! Dummy routine
+      WRITE(*,*) 'lim_dmp_2: You should not see this print! error? ', kt
+   END SUBROUTINE lim_dmp_2
+#endif
+
+   !!======================================================================
+END MODULE limdmp_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 8732)
@@ -0,0 +1,295 @@
+MODULE limdyn_2
+   !!======================================================================
+   !!                     ***  MODULE  limdyn_2  ***
+   !!   Sea-Ice dynamics :  
+   !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_dyn_2      : computes ice velocities
+   !!    lim_dyn_init_2 : initialization and namelist read
+   !!----------------------------------------------------------------------
+   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 wrk_nemo         ! work arrays
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_dyn_2   ! routine called by sbc_ice_lim
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_dyn_2( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_dyn_2  ***
+      !!               
+      !! ** Purpose :   compute ice velocity and ocean-ice friction velocity
+      !!                
+      !! ** Method  : 
+      !!
+      !! ** Action  : - Initialisation
+      !!              - Call of the dynamic routine for each hemisphere
+      !!              - computation of the friction velocity at the sea-ice base
+      !!              - treatment of the case if no ice dynamic
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  ::   ji, jj             ! dummy loop indices
+      INTEGER  ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology
+      REAL(wp) ::   zcoef              ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:  ) ::   zind           ! i-averaged indicator of sea-ice
+      REAL(wp), POINTER, DIMENSION(:  ) ::   zmsk           ! i-averaged of tmask
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity
+      !!---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zu_io, zv_io )
+      CALL wrk_alloc(      jpj, zind , zmsk  )
+
+      IF( kt == nit000 )   CALL lim_dyn_init_2   ! Initialization (first time-step only)
+      
+      IF( ln_limdyn ) THEN
+         !
+         ! Mean ice and snow thicknesses.          
+         hsnm(:,:)  = ( 1.0 - frld(:,:) ) * hsnif(:,:)
+         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:)
+         !
+         !                                     ! Rheology (ice dynamics)
+         !                                     ! ========
+         
+         !  Define the j-limits where ice rheology is computed
+         ! ---------------------------------------------------
+         
+         IF( lk_mpp ) 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 )
+            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
+            !
+            DO jj = 1, jpj
+               zind(jj) = SUM( frld (:,jj  ) )   ! = REAL(jpj) if ocean everywhere on a j-line
+               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0         if land  everywhere on a j-line
+            END DO
+            !
+            IF( l_jeq ) THEN                     ! local domain include both hemisphere
+               !                                 ! Rheology is computed in each hemisphere
+               !                                 ! only over the ice cover latitude strip
+               ! Northern hemisphere
+               i_j1  = njeq
+               i_jpj = jpj
+               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
+                  i_j1 = i_j1 + 1
+               END DO
+               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 
+               i_jpj = njeq
+               DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
+                  i_jpj = i_jpj - 1
+               END DO
+               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
+               !                                 ! latitude strip
+               i_j1  = 1
+               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
+                  i_j1 = i_j1 + 1
+               END DO
+               i_j1 = MAX( 1, i_j1-1 )
+    
+               i_jpj  = jpj
+               DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
+                  i_jpj = i_jpj - 1
+               END DO
+               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
+               !
+            ENDIF
+            !
+         ENDIF
+
+         IF(ln_ctl)   CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_dyn  : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :')
+         
+         ! computation of friction velocity
+         ! --------------------------------
+         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) = 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
+         !
+      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean
+         !
+         zcoef = SQRT( 0.5 ) / rau0
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   &
+                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj)
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point
+      !
+      IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :')
+      !
+      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io )
+      CALL wrk_dealloc(      jpj, zind , zmsk  )
+      !
+   END SUBROUTINE lim_dyn_2
+
+
+   SUBROUTINE lim_dyn_init_2
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dyn_init_2  ***
+      !!
+      !! ** Purpose :   Physical constants and parameters linked to the ice
+      !!              dynamics
+      !!
+      !! ** Method  :   Read the namicedyn namelist and check the ice-dynamic
+      !!              parameter values
+      !!
+      !! ** input   :   Namelist namicedyn
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicedyn/ epsd, alpha,     &
+         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
+         &                c_rhg, etamn, rn_creepl, rn_ecc, ahi0,                  &
+         &                nn_nevp, telast, alphaevp
+      !!-------------------------------------------------------------------
+                    
+      REWIND( numnam_ice_ref )              ! Namelist namicedyn in reference namelist : Ice dynamics
+      READ  ( numnam_ice_ref, namicedyn, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicedyn in configuration namelist : Ice dynamics
+      READ  ( numnam_ice_cfg, namicedyn, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicedyn )
+
+      IF(lwp) THEN                                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_dyn_init_2: ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~~~'
+         WRITE(numout,*) '       tolerance parameter                              epsd   = ', epsd
+         WRITE(numout,*) '       coefficient for semi-implicit coriolis           alpha  = ', alpha
+         WRITE(numout,*) '       diffusion constant for dynamics                  dm     = ', dm
+         WRITE(numout,*) '       number of sub-time steps for relaxation          nbiter = ', nbiter
+         WRITE(numout,*) '       maximum number of iterations for relaxation      nbitdr = ', nbitdr
+         WRITE(numout,*) '       relaxation constant                              om     = ', om
+         WRITE(numout,*) '       maximum value for the residual of relaxation     resl   = ', resl
+         WRITE(numout,*) '       drag coefficient for oceanic stress              cw     = ', cw
+         WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg, ' degrees'
+         WRITE(numout,*) '       first bulk-rheology parameter                    pstar  = ', pstar
+         WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
+         WRITE(numout,*) '       minimun value for viscosity                      etamn  = ', etamn
+         WRITE(numout,*) '       creep limit                                      rn_creepl = ', rn_creepl
+         WRITE(numout,*) '       eccentricity of the elliptical yield curve       rn_ecc = ', rn_ecc
+         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
+         WRITE(numout,*) '       number of iterations for subcycling              nn_nevp= ', nn_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
+
+      !  Initialization
+      usecc2 = 1.0 / ( rn_ecc * rn_ecc )
+      rhoco  = rau0 * cw
+      angvg  = angvg * rad      ! convert angvg from degree to radian
+      sangvg = SIN( angvg )
+      cangvg = COS( angvg )
+      pstarh = pstar / 2.0
+      !
+      ahiu(:,:) = ahi0 * umask(:,:,1)            ! Ice eddy Diffusivity coefficients.
+      ahiv(:,:) = ahi0 * vmask(:,:,1)
+      !
+   END SUBROUTINE lim_dyn_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module       NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dyn_2         ! Empty routine
+   END SUBROUTINE lim_dyn_2
+#endif 
+
+   !!======================================================================
+END MODULE limdyn_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90	(revision 8732)
@@ -0,0 +1,160 @@
+MODULE limhdf_2
+   !!======================================================================
+   !!                    ***  MODULE limhdf_2   ***
+   !! LIM 2.0 ice model : horizontal diffusion of sea-ice quantities
+   !!======================================================================
+   !! History :  LIM  !  2000-01 (LIM) Original code
+   !!             -   !  2001-05 (G. Madec, R. Hordoir) opa norm
+   !!            1.0  !  2002-08 (C. Ethe)  F90, free form
+   !!----------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_hdf_2  : diffusion trend on sea-ice variable
+   !!----------------------------------------------------------------------
+   USE dom_oce          ! ocean domain
+   USE ice_2            ! LIM-2: ice variables
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE prtctl           ! Print control
+   USE in_out_manager   ! I/O manager
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_hdf_2         ! called by limtrp_2.F90
+
+   LOGICAL  ::   linit = .TRUE.   ! ! initialization flag (set to flase after the 1st call)
+   REAL(wp) ::   epsi04 = 1e-04   ! constant
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient
+
+   !! * Substitution 
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_hdf_2( ptab )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_hdf_2  ***
+      !!
+      !! ** purpose :   Compute and add the diffusive trend on sea-ice variables
+      !!
+      !! ** method  :   Second order diffusive operator evaluated using a
+      !!              Cranck-Nicholson time Scheme.
+      !!
+      !! ** Action  :    update ptab with the diffusive contribution
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab   ! Field on which the diffusion is applied  
+      !
+      INTEGER  ::   ji, jj            ! dummy loop indices
+      INTEGER  ::   its, iter, ierr   ! local integers
+      REAL(wp) ::   zalfa, zrlxint, zconv, zeps   ! local scalars
+      REAL(wp), DIMENSION(:,:), POINTER :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 
+      CHARACTER (len=55) :: charout
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 )
+
+      !                       !==  Initialisation  ==!
+      !
+      IF( linit ) THEN              ! Metric coefficient (compute at the first call and saved in efact)
+         ALLOCATE( efact(jpi,jpj) , STAT=ierr )
+         IF( lk_mpp    )   CALL mpp_sum( ierr )
+         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_hdf_2 : unable to allocate standard arrays' )
+         DO jj = 2, jpjm1  
+            DO ji = fs_2 , fs_jpim1   ! vector opt.
+               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) )
+            END DO
+         END DO
+         linit = .FALSE.
+      ENDIF
+      !
+      !                             ! Time integration parameters
+      zalfa = 0.5_wp                      ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
+      its   = 100                         ! Maximum number of iteration
+      zeps  =  2._wp * epsi04
+      !
+      ztab0(:, : ) = ptab(:,:)      ! Arrays initialization
+      zdiv0(:, 1 ) = 0._wp
+      zdiv0(:,jpj) = 0._wp
+      zflu (jpi,:) = 0._wp   
+      zflv (jpi,:) = 0._wp
+      zdiv0(1,  :) = 0._wp
+      zdiv0(jpi,:) = 0._wp
+
+      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==!
+      iter  = 0
+      !
+      DO WHILE (  zconv > zeps  .AND.  iter <= its  )    ! Sub-time step loop
+         !
+         iter = iter + 1                                       ! incrementation of the sub-time step number
+         !
+         DO jj = 1, jpjm1                                      ! diffusive fluxes in U- and V- direction
+            DO ji = 1 , fs_jpim1   ! vector opt.
+               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+            END DO
+         END DO
+         !
+         DO jj= 2, jpjm1                                       ! diffusive trend : divergence of the fluxes
+            DO ji = fs_2 , fs_jpim1   ! vector opt. 
+               zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   &
+                  &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) )
+            END DO
+         END DO
+         !
+         IF( iter == 1 )   zdiv0(:,:) = zdiv(:,:)              ! save the 1st evaluation of the diffusive trend in zdiv0
+         !
+         DO jj = 2, jpjm1                                      ! iterative evaluation
+            DO ji = fs_2 , fs_jpim1   ! vector opt.
+               zrlxint = (   ztab0(ji,jj)    &
+                  &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) )   &
+                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )  )                             & 
+                  &    / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
+               zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) )
+            END DO
+         END DO
+         CALL lbc_lnk( zrlx, 'T', 1. )                         ! lateral boundary condition
+
+         zconv = 0._wp                                         ! convergence test
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_max( zconv )                  ! max over the global domain
+
+         ptab(:,:) = zrlx(:,:)
+         !
+      END DO                                             ! end of sub-time step loop
+
+      IF(ln_ctl)   THEN
+         zrlx(:,:) = ptab(:,:) - ztab0(:,:)
+         WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter
+         CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 )
+      !
+   END SUBROUTINE lim_hdf_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module       NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_hdf_2       ! Empty routine
+   END SUBROUTINE lim_hdf_2
+#endif
+
+   !!======================================================================
+END MODULE limhdf_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 8732)
@@ -0,0 +1,228 @@
+MODULE limistate_2
+   !!======================================================================
+   !!                     ***  MODULE  limistate_2  ***
+   !!              Initialisation of diagnostics ice variables
+   !!======================================================================
+   !! History :   1.0  !  01-04  (C. Ethe, G. Madec)  Original code
+   !!             2.0  !  03-08  (G. Madec)  add lim_istate_init
+   !!                  !  04-04  (S. Theetten) initialization from a file
+   !!                  !  06-07  (S. Masson)  IOM to read the restart
+   !!                  !  07-10  (G. Madec)  surface module
+   !!--------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_istate_2      :  Initialisation of diagnostics ice variables
+   !!   lim_istate_init_2 :  initialization of ice state and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst
+   USE par_ice_2       ! ice parameters
+   USE dom_ice_2
+   USE eosbn2          ! equation of state
+   USE lbclnk
+   USE oce
+   USE ice_2
+   USE iom
+   USE in_out_manager
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_istate_2      ! routine called by lim_init_2.F90
+
+   !                        !! **  namelist (namiceini) **
+   LOGICAL  ::   ln_limini   ! Ice initialization state
+   REAL(wp) ::   ttest       ! threshold water temperature for initial sea ice
+   REAL(wp) ::   hninn       ! initial snow thickness in the north
+   REAL(wp) ::   hginn       ! initial ice thickness in the north
+   REAL(wp) ::   alinn       ! initial leads area in the north
+   REAL(wp) ::   hnins       ! initial snow thickness in the south
+   REAL(wp) ::   hgins       ! initial ice thickness in the south
+   REAL(wp) ::   alins       ! initial leads area in the south
+   
+   REAL(wp) ::   zero      = 0.e0     ! constant value = 0
+   REAL(wp) ::   zone      = 1.e0     ! constant value = 1
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_istate_2
+      !!-------------------------------------------------------------------
+      !!                    ***  ROUTINE lim_istate_2  ***
+      !!
+      !! ** Purpose :   defined the sea-ice initial state
+      !!
+      !! ** Method  :   restart from a state defined in a binary file
+      !!                or from arbitrary sea-ice conditions
+      !!--------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zidto                     ! temporary scalar
+      !--------------------------------------------------------------------
+ 
+      CALL lim_istate_init_2     !  reading the initials parameters of the ice
+
+      IF( .NOT. ln_limini ) THEN  
+         
+         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celsius]
+         tfu(:,:) = tfu(:,:) *  tmask(:,:,1)
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !                     ! ice if sst <= t-freez + ttest
+               IF( tsn(ji,jj,1,jp_tem)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice
+               ELSE                                                    ;   zidto = 1.e0      !    ice
+               ENDIF
+               !
+               IF( ff_t(ji,jj) >= 0._wp ) THEN     !--  Northern hemisphere.
+                  hicif(ji,jj)   = zidto * hginn
+                  frld(ji,jj)    = zidto * alinn + ( 1.0 - zidto ) * 1.0
+                  hsnif(ji,jj)   = zidto * hninn
+               ELSE                               !---  Southern hemisphere.
+                  hicif(ji,jj)   = zidto * hgins
+                  frld(ji,jj)    = zidto * alins + ( 1.0 - zidto ) * 1.0
+                  hsnif(ji,jj)   = zidto * hnins
+               ENDIF
+            END DO
+         END DO
+
+         tfu(:,:) = tfu(:,:) + rt0       ! ftu converted from Celsius to Kelvin (rt0 over land)
+         
+         sist  (:,:)   = tfu(:,:)
+         tbif  (:,:,1) = tfu(:,:)
+         tbif  (:,:,2) = tfu(:,:)
+         tbif  (:,:,3) = tfu(:,:)
+
+      ENDIF
+     
+      fsbbq (:,:)   = 0.e0
+      qstoif(:,:)   = 0.e0
+      u_ice (:,:)   = 0.e0
+      v_ice (:,:)   = 0.e0
+
+      !---  Moments for advection.             
+
+      sxice (:,:)  = 0.e0   ;   sxsn (:,:)  = 0.e0   ;   sxa  (:,:)  = 0.e0
+      syice (:,:)  = 0.e0   ;   sysn (:,:)  = 0.e0   ;   sya  (:,:)  = 0.e0
+      sxxice(:,:)  = 0.e0   ;   sxxsn(:,:)  = 0.e0   ;   sxxa (:,:)  = 0.e0
+      syyice(:,:)  = 0.e0   ;   syysn(:,:)  = 0.e0   ;   syya (:,:)  = 0.e0
+      sxyice(:,:)  = 0.e0   ;   sxysn(:,:)  = 0.e0   ;   sxya (:,:)  = 0.e0
+
+      sxc0  (:,:)  = 0.e0   ;   sxc1 (:,:)  = 0.e0   ;   sxc2 (:,:)  = 0.e0
+      syc0  (:,:)  = 0.e0   ;   syc1 (:,:)  = 0.e0   ;   syc2 (:,:)  = 0.e0
+      sxxc0 (:,:)  = 0.e0   ;   sxxc1(:,:)  = 0.e0   ;   sxxc2(:,:)  = 0.e0
+      syyc0 (:,:)  = 0.e0   ;   syyc1(:,:)  = 0.e0   ;   syyc2(:,:)  = 0.e0
+      sxyc0 (:,:)  = 0.e0   ;   sxyc1(:,:)  = 0.e0   ;   sxyc2(:,:)  = 0.e0
+
+      sxst  (:,:)  = 0.e0
+      syst  (:,:)  = 0.e0
+      sxxst (:,:)  = 0.e0
+      syyst (:,:)  = 0.e0
+      sxyst (:,:)  = 0.e0
+#if ! defined key_lim2_vp
+      stress1_i (:,:) = 0._wp                          ! EVP rheology
+      stress2_i (:,:) = 0._wp
+      stress12_i(:,:) = 0._wp
+#endif
+
+      !-- lateral boundary conditions
+      CALL lbc_lnk( hicif, 'T', 1. )
+      CALL lbc_lnk( frld , 'T', 1. )
+
+      ! C A U T I O N  frld = 1 over land and lbc_lnk put zero along 
+      ! *************  closed boundaries herefore we force to one over land
+      frld(:,:) = tms(:,:) * frld(:,:) + ( 1. - tms(:,:) )   
+
+      CALL lbc_lnk( hsnif, 'T', 1. )
+      CALL lbc_lnk( sist , 'T', 1. , pval = rt0 )      ! set rt0 on closed boundary (required by bulk formulation)
+      DO jk = 1, jplayersp1
+         CALL lbc_lnk(tbif(:,:,jk), 'T', 1. )
+      END DO
+      CALL lbc_lnk( fsbbq  , 'T', 1. )
+      CALL lbc_lnk( qstoif , 'T', 1. )
+
+   END SUBROUTINE lim_istate_2
+
+   
+   SUBROUTINE lim_istate_init_2
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_istate_init_2  ***
+      !!        
+      !! ** Purpose :   Definition of initial state of the ice 
+      !!
+      !! ** Method  :   Read the namiceini namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namiceini
+      !!-------------------------------------------------------------------
+      INTEGER :: inum_ice
+      INTEGER :: ji,jj
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      NAMELIST/namiceini/ ln_limini, ttest, hninn, hginn, alinn, &
+         &                hnins, hgins, alins
+      !!-------------------------------------------------------------------
+                   
+      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state
+      READ  ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceini in configuration namelist : Ice initial state
+      READ  ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceini )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_istate_init_2 : ice parameters inititialisation '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '         threshold water temp. for initial sea-ice    ttest      = ', ttest
+         WRITE(numout,*) '         initial snow thickness in the north          hninn      = ', hninn
+         WRITE(numout,*) '         initial ice thickness in the north           hginn      = ', hginn 
+         WRITE(numout,*) '         initial leads area in the north              alinn      = ', alinn            
+         WRITE(numout,*) '         initial snow thickness in the south          hnins      = ', hnins 
+         WRITE(numout,*) '         initial ice thickness in the south           hgins      = ', hgins
+         WRITE(numout,*) '         initial leads area in the south              alins      = ', alins
+         WRITE(numout,*) '         Ice state initialization using input file    ln_limini  = ', ln_limini
+      ENDIF
+
+      IF( ln_limini ) THEN                      ! Ice initialization using input file
+         !
+         CALL iom_open( 'Ice_initialization.nc', inum_ice )
+         !
+         IF( inum_ice > 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '                  ice state initialization with : Ice_initialization.nc'
+            
+            CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif )      
+            CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif )      
+            CALL iom_get( inum_ice, jpdom_data, 'frld' , frld  )     
+            CALL iom_get( inum_ice, jpdom_data, 'ts'   , sist  )
+            CALL iom_get( inum_ice, jpdom_unknown, 'tbif', tbif(1:nlci,1:nlcj,:),   &
+                 &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) )
+            ! put some values in the extra-halo...
+            DO jj = nlcj+1, jpj   ;   tbif(1:nlci,jj,:) = tbif(1:nlci,nlej,:)   ;   END DO
+            DO ji = nlci+1, jpi   ;   tbif(ji    ,: ,:) = tbif(nlei  ,:   ,:)   ;   END DO
+
+            CALL iom_close( inum_ice)
+            !
+         ENDIF
+      ENDIF
+      !     
+   END SUBROUTINE lim_istate_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_istate_2        ! Empty routine
+   END SUBROUTINE lim_istate_2
+#endif
+
+   !!======================================================================
+END MODULE limistate_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90	(revision 8732)
@@ -0,0 +1,297 @@
+MODULE limmsh_2
+   !!======================================================================
+   !!                     ***  MODULE  limmsh_2  ***
+   !! 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
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                     LIM 2.0sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_msh_2   : definition of the ice mesh
+   !!----------------------------------------------------------------------
+   USE phycst
+   USE dom_oce
+   USE dom_ice_2
+   USE lbclnk
+   USE in_out_manager
+   USE lib_mpp          ! MPP library
+#if defined key_lim2_vp
+   USE wrk_nemo         ! work arrays
+#endif
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_msh_2      ! routine called by ice_ini_2.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_msh_2
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_msh_2  ***
+      !!              
+      !! ** Purpose : Definition of the charact. of the numerical grid
+      !!       
+      !! ** Action  : - Initialisation of some variables
+      !!              - Definition of some constants linked with the grid
+      !!              - Definition of the metric coef. for the sea/ice
+      !!              - Initialization of the ice masks (tmsk, umsk)
+      !! 
+      !! ** Refer.  : Deleersnijder et al. Ocean Modelling 100, 7-10 
+      !!--------------------------------------------------------------------- 
+      INTEGER :: ji, jj      ! dummy loop indices
+      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), POINTER, DIMENSION(:,:) ::   zd2d1, zd1d2   ! 2D workspace
+#endif
+      !!---------------------------------------------------------------------
+
+#if defined key_lim2_vp
+      CALL wrk_alloc( jpi, jpj, zd2d1, zd1d2 )
+#endif
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_msh_2 : LIM 2.0 sea-ice model, mesh initialization'
+         WRITE(numout,*) '~~~~~~~~~'
+      ENDIF
+      
+      !----------------------------------------------------------                          
+      !    Initialization of local and some global (common) variables 
+      !------------------------------------------------------------------ 
+      
+      njeq   = INT( jpj / 2 )   !i bug mpp potentiel
+      njeqm1 = njeq - 1 
+ 
+!i    DO jj = 1, jpj
+!i       zmsk(jj) = SUM( tmask(:,jj,:) )   ! = 0          if land  everywhere on a j-line
+!!ii     write(numout,*) jj, zind(jj)
+!i    END DO
+
+      IF( ff_t(1,1) * ff_t(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere
+         l_jeq = .TRUE.
+         njeq  = 1
+         DO WHILE ( njeq <= jpj .AND. ff_t(1,njeq) < 0.e0 )
+            njeq = njeq + 1
+         END DO
+         IF(lwp ) WRITE(numout,*) '          the equator is inside the domain at about njeq = ', njeq
+      ELSEIF( ff_t(1,1) < 0.e0 ) THEN
+         l_jeq = .FALSE.
+         njeq = jpj
+         IF(lwp ) WRITE(numout,*) '          the model domain is entirely in the southern hemisphere: njeq = ', njeq
+      ELSE
+         l_jeq = .FALSE.
+         njeq = 2
+         IF(lwp ) WRITE(numout,*) '          the model domain is entirely in the northern hemisphere: njeq = ', njeq
+      ENDIF
+
+      njeqm1 = njeq - 1
+
+
+      !   For each grid, definition of geometric tables 
+      !------------------------------------------------------------------
+      
+      !-------------------
+      ! Conventions :    !
+      !-------------------
+      !  indices 1 \ 2 <-> localisation in the 2 direction x \ y
+      !  3rd indice <-> localisation on the mesh :
+      !  0 = Centre ;  1 = corner W x(i-1/2) ; 2 = corner S y(j-1/2) ;
+      !  3 = corner SW x(i-1/2),y(j-1/2)
+      !-------------------
+!!ibug ???
+      wght(:,:,:,:) = 0.e0
+      tmu(:,:)      = 0.e0
+#if defined key_lim2_vp 
+      akappa(:,:,:,:)     = 0.e0
+      alambd(:,:,:,:,:,:) = 0.e0
+#else
+      tmv(:,:) = 0.e0
+      tmf(:,:) = 0.e0
+#endif
+!!i
+      
+
+#if defined key_lim2_vp      
+      ! metric coefficients for sea ice dynamic
+      !----------------------------------------
+      !                                                       ! akappa
+      DO jj = 2, jpj
+         zd1d2(:,jj) = e1v(:,jj) - e1v(:,jj-1)
+      END DO
+      CALL lbc_lnk( zd1d2, 'T', -1. )
+
+      DO ji = 2, jpi
+         zd2d1(ji,:) = e2u(ji,:) - e2u(ji-1,:)
+      END DO
+      CALL lbc_lnk( zd2d1, 'T', -1. )
+
+      akappa(:,:,1,1) =        1.0 / ( 2.0 * e1t(:,:) )
+      akappa(:,:,1,2) = zd1d2(:,:) / ( 4.0 * e1t(:,:) * e2t(:,:) )
+      akappa(:,:,2,1) = zd2d1(:,:) / ( 4.0 * e1t(:,:) * e2t(:,:) )
+      akappa(:,:,2,2) =        1.0 / ( 2.0 * e2t(:,:) )
+      
+      !                                                      ! weights (wght)
+      DO jj = 2, jpj
+         DO ji = 2, jpi
+            zusden = 1. / (  ( e1t(ji,jj) + e1t(ji-1,jj  ) )   &
+               &           * ( e2t(ji,jj) + e2t(ji  ,jj-1) ) )
+            wght(ji,jj,1,1) = zusden * e1t(ji  ,jj) * e2t(ji,jj  )
+            wght(ji,jj,1,2) = zusden * e1t(ji  ,jj) * e2t(ji,jj-1)
+            wght(ji,jj,2,1) = zusden * e1t(ji-1,jj) * e2t(ji,jj  )
+            wght(ji,jj,2,2) = zusden * e1t(ji-1,jj) * e2t(ji,jj-1)
+         END DO
+      END DO
+      CALL lbc_lnk( wght(:,:,1,1), 'I', 1. )      ! CAUTION: even with the lbc_lnk at ice U-V-point
+      CALL lbc_lnk( wght(:,:,1,2), 'I', 1. )      ! the value of wght at jpj is wrong
+      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.
+            zh1p  =  e1t(ji  ,jj  ) * wght(ji,jj,2,2)   &
+               &   + e1t(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &   + e1t(ji  ,jj-1) * wght(ji,jj,2,1)   &
+               &   + e1t(ji-1,jj-1) * wght(ji,jj,1,1)
+
+            zh2p  =  e2t(ji  ,jj  ) * wght(ji,jj,2,2)   &
+               &   + e2t(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &   + e2t(ji  ,jj-1) * wght(ji,jj,2,1)   &
+               &   + e2t(ji-1,jj-1) * wght(ji,jj,1,1)
+
+! better written but change the last digit and thus solver in less than 100 timestep
+!           zh1p  = e1t(ji-1,jj  ) * wght(ji,jj,1,2) + e1t(ji,jj  ) * wght(ji,jj,2,2)   &
+!              &  + e1t(ji-1,jj-1) * wght(ji,jj,1,1) + e1t(ji,jj-1) * wght(ji,jj,2,1) 
+
+!           zh2p  = e2t(ji-1,jj  ) * wght(ji,jj,1,2) + e2t(ji,jj  ) * wght(ji,jj,2,2)   &
+!              &  + e2t(ji-1,jj-1) * wght(ji,jj,1,1) + e2t(ji,jj-1) * wght(ji,jj,2,1)
+
+!!ibug =0   zusden = 1.0 / ( zh1p * zh2p * 4.e0 )
+            zusden = 1.0 / MAX( zh1p * zh2p * 4.e0 , 1.e-20 )
+            zusden2 = zusden * 2.0 
+
+            zd1d2p = zusden * 0.5 * ( -e1t(ji-1,jj-1) + e1t(ji-1,jj  ) - e1t(ji,jj-1) + e1t(ji  ,jj)   )
+            zd2d1p = zusden * 0.5 * (  e2t(ji  ,jj-1) - e2t(ji-1,jj-1) + e2t(ji,jj  ) - e2t(ji-1,jj)   )
+
+            alambd(ji,jj,2,2,2,1) = zusden2 * e2t(ji  ,jj-1)
+            alambd(ji,jj,2,2,2,2) = zusden2 * e2t(ji  ,jj  )
+            alambd(ji,jj,2,2,1,1) = zusden2 * e2t(ji-1,jj-1)
+            alambd(ji,jj,2,2,1,2) = zusden2 * e2t(ji-1,jj  )
+
+            alambd(ji,jj,1,1,2,1) = zusden2 * e1t(ji  ,jj-1)
+            alambd(ji,jj,1,1,2,2) = zusden2 * e1t(ji  ,jj  )
+            alambd(ji,jj,1,1,1,1) = zusden2 * e1t(ji-1,jj-1)
+            alambd(ji,jj,1,1,1,2) = zusden2 * e1t(ji-1,jj  )
+
+            alambd(ji,jj,1,2,2,1) = zd1d2p
+            alambd(ji,jj,1,2,2,2) = zd1d2p
+            alambd(ji,jj,1,2,1,1) = zd1d2p
+            alambd(ji,jj,1,2,1,2) = zd1d2p
+
+            alambd(ji,jj,2,1,2,1) = zd2d1p
+            alambd(ji,jj,2,1,2,2) = zd2d1p
+            alambd(ji,jj,2,1,1,1) = zd2d1p
+            alambd(ji,jj,2,1,1,2) = zd2d1p
+         END DO
+      END DO
+
+      CALL lbc_lnk( alambd(:,:,2,2,2,1), 'I', 1. )      ! CAUTION: even with the lbc_lnk at ice U-V point
+      CALL lbc_lnk( alambd(:,:,2,2,2,2), 'I', 1. )      ! the value of wght at jpj is wrong
+      CALL lbc_lnk( alambd(:,:,2,2,1,1), 'I', 1. )      ! but it is never used
+      CALL lbc_lnk( alambd(:,:,2,2,1,2), 'I', 1. )      ! 
+
+      CALL lbc_lnk( alambd(:,:,1,1,2,1), 'I', 1. )      ! CAUTION: idem
+      CALL lbc_lnk( alambd(:,:,1,1,2,2), 'I', 1. )      ! 
+      CALL lbc_lnk( alambd(:,:,1,1,1,1), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,1,1,1,2), 'I', 1. )      !
+
+      CALL lbc_lnk( alambd(:,:,1,2,2,1), 'I', 1. )      ! CAUTION: idem
+      CALL lbc_lnk( alambd(:,:,1,2,2,2), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,1,2,1,1), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,1,2,1,2), 'I', 1. )      !
+
+      CALL lbc_lnk( alambd(:,:,2,1,2,1), 'I', 1. )      ! CAUTION: idem
+      CALL lbc_lnk( alambd(:,:,2,1,2,2), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. )      !
+#endif
+            
+
+      ! Initialization of ice masks
+      !----------------------------
+      
+      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
+      tmu(1,:) = 0.e0
+      DO jj = 2, jpj               ! ice U.V-point: computed from ice T-point mask
+         DO ji = 2, jpim1   ! NO vector opt.
+            tmu(ji,jj) =  tms(ji,jj) * tms(ji-1,jj) * tms(ji,jj-1) * tms(ji-1,jj-1)            
+         END DO
+      END DO
+      CALL lbc_lnk( 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(:,:)
+      !
+#if defined key_lim2_vp
+      CALL wrk_dealloc( jpi, jpj, zd2d1, zd1d2 )
+#endif
+      !
+   END SUBROUTINE lim_msh_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy Module         NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_msh_2           ! Dummy routine
+   END SUBROUTINE lim_msh_2
+#endif
+
+   !!======================================================================
+END MODULE limmsh_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90	(revision 8732)
@@ -0,0 +1,707 @@
+MODULE limrhg
+   !!======================================================================
+   !!                     ***  MODULE  limrhg  ***
+   !!   Ice rheology : sea ice rheology
+   !!======================================================================
+   !! History :   -   !  2007-03  (M.A. Morales Maqueda, S. Bouillon) Original code
+   !!            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
+   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation 
+   !!            3.5  !  2012-08  (R. Benshila)  AGRIF 
+   !!----------------------------------------------------------------------
+#if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp )
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'               OR                     LIM-3 sea-ice model
+   !!   'key_lim2' AND NOT 'key_lim2_vp'            EVP LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_rhg       : computes ice velocities
+   !!----------------------------------------------------------------------
+   USE phycst         ! Physical constant
+   USE oce     , ONLY :  snwice_mass, snwice_mass_b
+   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
+#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          ! LIM-2: ice variables
+   USE dom_ice_2      ! LIM-2: ice domain
+#endif
+   USE lbclnk         ! Lateral Boundary Condition / MPP link
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+#if defined key_agrif && defined key_lim2
+   USE agrif_lim2_interp
+#endif
+#if defined key_bdy
+   USE bdyice_lim
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limrhg.F90 5888 2015-11-13 16:47:32Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_rhg( k_j1, k_jpj )
+      !!-------------------------------------------------------------------
+      !!                 ***  SUBROUTINE lim_rhg  ***
+      !!                          EVP-C-grid
+      !!
+      !! ** purpose : determines sea ice drift from wind stress, ice-ocean
+      !!  stress and sea-surface slope. Ice-ice interaction is described by 
+      !!  a non-linear elasto-viscous-plastic (EVP) law including shear 
+      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).	
+      !!
+      !!  The points in the C-grid look like this, dear reader
+      !!
+      !!                              (ji,jj)
+      !!                                 |
+      !!                                 |
+      !!                      (ji-1,jj)  |  (ji,jj)
+      !!                             ---------   
+      !!                            |         |
+      !!                            | (ji,jj) |------(ji,jj)
+      !!                            |         |
+      !!                             ---------   
+      !!                     (ji-1,jj-1)     (ji,jj-1)
+      !!
+      !! ** Inputs  : - wind forcing (stress), oceanic currents
+      !!                ice total volume (vt_i) per unit area
+      !!                snow total volume (vt_s) per unit area
+      !!
+      !! ** Action  : - compute u_ice, v_ice : the components of the 
+      !!                sea-ice velocity vector
+      !!              - compute delta_i, shear_i, divu_i, which are inputs
+      !!                of the ice thickness distribution
+      !!
+      !! ** Steps   : 1) Compute ice snow mass, ice strength 
+      !!              2) Compute wind, oceanic stresses, mass terms and
+      !!                 coriolis terms of the momentum equation
+      !!              3) Solve the momentum equation (iterative procedure)
+      !!              4) Prevent high velocities if the ice is thin
+      !!              5) Recompute invariants of the strain rate tensor
+      !!                 which are inputs of the ITD, store stress
+      !!                 for the next time step
+      !!              6) Control prints of residual (convergence)
+      !!                 and charge ellipse.
+      !!                 The user should make sure that the parameters
+      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state
+      !!                 on the charge ellipse for plastic flow
+      !!                 e.g. in the Canadian Archipelago
+      !!
+      !! References : Hunke and Dukowicz, JPO97
+      !!              Bouillon et al., Ocean Modelling 2009
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation
+      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation
+      !!
+      INTEGER ::   ji, jj   ! dummy loop indices
+      INTEGER ::   jter     ! local integers
+      CHARACTER (len=50) ::   charout
+      REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         !
+      REAL(wp) ::   za, zstms          ! local scalars
+      REAL(wp) ::   zc1, zc2, zc3      ! ice mass
+
+      REAL(wp) ::   dtevp , z1_dtevp              ! time step for subcycling
+      REAL(wp) ::   dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity
+      REAL(wp) ::   z0, zr, zcca, zccb            ! temporary scalars
+      REAL(wp) ::   zu_ice2, zv_ice1              !
+      REAL(wp) ::   zddc, zdtc                    ! delta on corners and on centre
+      REAL(wp) ::   zdst                          ! shear at the center of the grid point
+      REAL(wp) ::   zdsshx, zdsshy                ! term for the gradient of ocean surface
+      REAL(wp) ::   sigma1, sigma2                ! internal ice stress
+
+      REAL(wp) ::   zresm         ! Maximal error on ice velocity
+      REAL(wp) ::   zintb, zintn  ! dummy argument
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zpreshc          ! Ice strength on grid cell corners (zpreshc)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld1, zfrld2   ! lead fraction on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmass1, zmass2   ! ice/snow mass on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays
+      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oce1           ! ocean u/v component on U points                           
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2           ! ocean u/v component on V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_ice2, v_ice1   ! ice u/v component on V/U point
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask            ! mask ocean grid points
+      
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice            ! array used for the calculation of ice surface slope:
+                                                              !   ocean surface (ssh_m) if ice is not embedded
+                                                              !   ice top surface if ice is embedded   
+
+      REAL(wp), PARAMETER               ::   zepsi = 1.0e-20_wp ! tolerance parameter
+      REAL(wp), PARAMETER               ::   zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
+      CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
+      CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
+      CALL wrk_alloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 )
+
+#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
+#if defined key_agrif && defined key_lim2 
+      CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
+#endif
+      !
+      !------------------------------------------------------------------------------!
+      ! 1) Ice strength (zpresh)                                !
+      !------------------------------------------------------------------------------!
+      !
+      ! Put every vector to 0
+      delta_i(:,:) = 0._wp   ;
+      zpresh (:,:) = 0._wp   ;  
+      zpreshc(:,:) = 0._wp
+      u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp
+      divu_i (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp
+      shear_i(:,:) = 0._wp
+
+#if defined key_lim3
+      CALL lim_itd_me_icestrength( nn_icestr )      ! LIM-3: Ice strength on T-points
+#endif
+
+      DO jj = k_j1 , k_jpj       ! Ice mass and temp variables
+         DO ji = 1 , jpi
+#if defined key_lim3
+            zpresh(ji,jj) = tmask(ji,jj,1) *  strength(ji,jj)
+#endif
+#if defined key_lim2
+            zpresh(ji,jj) = tmask(ji,jj,1) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
+#endif
+            ! zmask = 1 where there is ice or on land
+            zmask(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+      ! Ice strength on grid cell corners (zpreshc)
+      ! needed for calculation of shear stress 
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)
+            zstms          =  tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) +   &
+               &              tmask(ji+1,jj,1)   * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1)   * wght(ji+1,jj+1,1,1)
+            zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) +   &
+               &               zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + zpresh(ji,jj)   * wght(ji+1,jj+1,1,1)     &
+               &             ) / MAX( zstms, zepsi )
+         END DO
+      END DO
+      CALL lbc_lnk( zpreshc(:,:), 'F', 1. )
+      !
+      !------------------------------------------------------------------------------!
+      ! 2) Wind / ocean stress, mass terms, coriolis terms
+      !------------------------------------------------------------------------------!
+      !
+      !  Wind stress, coriolis and mass terms on the sides of the squares        
+      !  zfrld1: lead fraction on U-points                                      
+      !  zfrld2: lead fraction on V-points                                     
+      !  zmass1: ice/snow mass on U-points                                    
+      !  zmass2: ice/snow mass on V-points                                   
+      !  zcorl1: Coriolis parameter on U-points                             
+      !  zcorl2: Coriolis parameter on V-points                            
+      !  (ztagnx,ztagny): wind stress on U/V points                       
+      !  v_oce1: ocean v component on u points                          
+      !  u_oce2: ocean u component on v points                         
+
+      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+         !                                            
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
+         !
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+         !
+         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+         !
+      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
+         zpice(:,:) = ssh_m(:,:)
+      ENDIF
+
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = fs_2, fs_jpim1
+
+            zc1 = tmask(ji  ,jj  ,1) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
+            zc2 = tmask(ji+1,jj  ,1) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
+            zc3 = tmask(ji  ,jj+1,1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
+
+            zt11 = tmask(ji  ,jj,1) * e1t(ji  ,jj)
+            zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj)
+            zt21 = tmask(ji,jj  ,1) * e2t(ji,jj  )
+            zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1)
+
+            ! Leads area.
+            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi )
+            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi )
+
+            ! Mass, coriolis coeff. and currents
+            zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi )
+            zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi )
+            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * ff_f(ji,jj) + e1t(ji,jj) * ff_f(ji+1,jj) )   &
+               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi )
+            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * ff_f(ji,jj) + e2t(ji,jj) * ff_f(ji,jj+1) )   &
+               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi )
+            !
+            ! Ocean has no slip boundary condition
+            v_oce1(ji,jj)  = 0.5 * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji,jj)      &
+               &                   + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) )  &
+               &                   / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)  
+
+            u_oce2(ji,jj)  = 0.5 * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj)      &
+               &                   + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) )  &
+               &                   / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+
+            ! Wind stress at U,V-point
+            ztagnx = ( 1. - zfrld1(ji,jj) ) * utau_ice(ji,jj)
+            ztagny = ( 1. - zfrld2(ji,jj) ) * vtau_ice(ji,jj)
+
+            ! Computation of the velocity field taking into account the ice internal interaction.
+            ! Terms that are independent of the velocity field.
+
+            ! SB On utilise maintenant le gradient de la pente de l'ocean
+            ! include it later
+
+            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+
+            za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
+            za2ct(ji,jj) = ztagny - zmass2(ji,jj) * grav * zdsshy
+
+         END DO
+      END DO
+
+      !
+      !------------------------------------------------------------------------------!
+      ! 3) Solution of the momentum equation, iterative procedure
+      !------------------------------------------------------------------------------!
+      !
+      ! Time step for subcycling
+      dtevp  = rdt_ice / nn_nevp
+#if defined key_lim3
+      dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )
+#else
+      dtotel = dtevp / ( 2._wp * telast )
+#endif
+      z1_dtotel = 1._wp / ( 1._wp + dtotel )
+      z1_dtevp  = 1._wp / dtevp
+      !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)
+      ecc2 = rn_ecc * rn_ecc
+      ecci = 1. / ecc2
+
+      !-Initialise stress tensor 
+      zs1 (:,:) = stress1_i (:,:) 
+      zs2 (:,:) = stress2_i (:,:)
+      zs12(:,:) = stress12_i(:,:)
+
+      !                                               !----------------------!
+      DO jter = 1 , nn_nevp                           !    loop over jter    !
+         !                                            !----------------------!        
+         DO jj = k_j1, k_jpj-1
+            zu_ice(:,jj) = u_ice(:,jj)    ! velocity at previous time step
+            zv_ice(:,jj) = v_ice(:,jj)
+         END DO
+
+         DO jj = k_j1+1, k_jpj-1
+            DO ji = fs_2, fs_jpim1   !RB bug no vect opt due to zmask
+
+               !  
+               !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002)
+               !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells
+               !- zds(:,:): shear on northeast corner of grid cells
+               !
+               !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded, 
+               !                      there are many repeated calculations. 
+               !                      Speed could be improved by regrouping terms. For
+               !                      the moment, however, the stress is on clarity of coding to avoid
+               !                      bugs (Martin, for Miguel).
+               !
+               !- ALSO: arrays zdt, zds and delta could 
+               !  be removed in the future to minimise memory demand.
+               !
+               !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of
+               !              grid cells, exactly as in the B grid case. For simplicity, the indexation on
+               !              the corners is the same as in the B grid.
+               !
+               !
+               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+                  &            ) * r1_e1e2t(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+                  &         - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+                  &         ) * r1_e1e2t(ji,jj)
+
+               !
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+                  &         ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) )   &
+                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+
+               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     &
+                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   &
+                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 
+
+               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   &
+                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+            END DO
+         END DO
+
+         CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. )      ! lateral boundary cond.
+         
+         DO jj = k_j1+1, k_jpj-1
+            DO ji = fs_2, fs_jpim1
+
+               !- Calculate Delta at centre of grid cells
+               zdst          = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )   &
+                  &            + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1)   &
+                  &            ) * r1_e1e2t(ji,jj)
+
+               delta          = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
+               delta_i(ji,jj) = delta + rn_creepl
+
+               !- Calculate Delta on corners
+               zddc  = (  ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &    ) * r1_e1e2f(ji,jj)
+
+               zdtc  = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &     + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &    ) * r1_e1e2f(ji,jj)
+
+               zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl
+
+               !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide).
+               zs1(ji,jj)  = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj)   * zpresh(ji,jj)   &
+                  &          ) * z1_dtotel
+               zs2(ji,jj)  = ( zs2 (ji,jj) + dtotel *         ecci * zdt(ji,jj) / delta_i(ji,jj)   * zpresh(ji,jj)   &
+                  &          ) * z1_dtotel
+               !-Calculate stress tensor component zs12 at corners
+               zs12(ji,jj) = ( zs12(ji,jj) + dtotel *         ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj)  &
+                  &          ) * z1_dtotel 
+
+            END DO
+         END DO
+
+         CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+ 
+         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002)
+         DO jj = k_j1+1, k_jpj-1
+            DO ji = fs_2, fs_jpim1
+               !- contribution of zs1, zs2 and zs12 to zf1
+               zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)  &
+                  &             + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj)          &
+                  &             + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj)  &
+                  &                ) * r1_e1e2u(ji,jj)
+               ! contribution of zs1, zs2 and zs12 to zf2
+               zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)  &
+                  &             - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj)          &
+                  &             + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj)  &
+                  &               )  * r1_e1e2v(ji,jj)
+            END DO
+         END DO
+         !
+         ! Computation of ice velocity
+         !
+         ! Both the Coriolis term and the ice-ocean drag are solved semi-implicitly.
+         !
+         IF (MOD(jter,2).eq.0) THEN 
+
+            DO jj = k_j1+1, k_jpj-1
+               DO ji = fs_2, fs_jpim1
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+                  z0           = zmass1(ji,jj) * z1_dtevp
+
+                  ! SB modif because ocean has no slip boundary condition
+                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji  ,jj)     &
+                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   &
+                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  &
+                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+                  zcca         = z0 + za
+                  zccb         = zcorl1(ji,jj)
+                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 
+               END DO
+            END DO
+
+            CALL lbc_lnk( u_ice(:,:), 'U', -1. )
+#if defined key_agrif && defined key_lim2
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
+#endif
+#if defined key_bdy
+         CALL bdy_ice_lim_dyn( 'U' )
+#endif         
+
+            DO jj = k_j1+1, k_jpj-1
+               DO ji = fs_2, fs_jpim1
+
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+                  z0           = zmass2(ji,jj) * z1_dtevp
+                  ! SB modif because ocean has no slip boundary condition
+                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       &
+                     &                 + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   &
+                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  & 
+                     &                         ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) )
+                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+                  zcca         = z0 + za
+                  zccb         = zcorl2(ji,jj)
+                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
+               END DO
+            END DO
+
+            CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+#if defined key_agrif && defined key_lim2
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
+#endif
+#if defined key_bdy
+         CALL bdy_ice_lim_dyn( 'V' )
+#endif         
+
+         ELSE 
+            DO jj = k_j1+1, k_jpj-1
+               DO ji = fs_2, fs_jpim1
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+                  z0           = zmass2(ji,jj) * z1_dtevp
+                  ! SB modif because ocean has no slip boundary condition
+                  zu_ice2      = 0.5 * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj)       &
+                     &                  +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) )   &
+                     &                 / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)   
+
+                  za           = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 +  &
+                     &                         ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) )
+                  zr           = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+                  zcca         = z0 + za
+                  zccb         = zcorl2(ji,jj)
+                  v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
+               END DO
+            END DO
+
+            CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+#if defined key_agrif && defined key_lim2
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
+#endif
+#if defined key_bdy
+         CALL bdy_ice_lim_dyn( 'V' )
+#endif         
+
+            DO jj = k_j1+1, k_jpj-1
+               DO ji = fs_2, fs_jpim1
+                  rswitch      = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+                  z0           = zmass1(ji,jj) * z1_dtevp
+                  zv_ice1      = 0.5 * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji,jj)       &
+                     &                 + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) )   &
+                     &                 / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+                  za           = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 +  &
+                     &                         ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+                  zr           = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+                  zcca         = z0 + za
+                  zccb         = zcorl1(ji,jj)
+                  u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 
+               END DO
+            END DO
+
+            CALL lbc_lnk( u_ice(:,:), 'U', -1. )
+#if defined key_agrif && defined key_lim2
+            CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
+#endif
+#if defined key_bdy
+         CALL bdy_ice_lim_dyn( 'U' )
+#endif         
+
+         ENDIF
+         
+         IF(ln_ctl) THEN
+            !---  Convergence test.
+            DO jj = k_j1+1 , k_jpj-1
+               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) )
+            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
+         ENDIF
+
+         !                                                ! ==================== !
+      END DO                                              !  end loop over jter  !
+      !                                                   ! ==================== !
+      !
+      !------------------------------------------------------------------------------!
+      ! 4) Prevent ice velocities when the ice is thin
+      !------------------------------------------------------------------------------!
+      ! If the ice volume is below zvmin then ice velocity should equal the
+      ! ocean velocity. This prevents high velocity when ice is thin
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = fs_2, fs_jpim1
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+               u_ice(ji,jj) = u_oce(ji,jj)
+               v_ice(ji,jj) = v_oce(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+      CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. )
+
+#if defined key_agrif && defined key_lim2
+      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' )
+      CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' )
+#endif
+#if defined key_bdy
+      CALL bdy_ice_lim_dyn( 'U' )
+      CALL bdy_ice_lim_dyn( 'V' )
+#endif         
+
+      DO jj = k_j1+1, k_jpj-1 
+         DO ji = fs_2, fs_jpim1
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+               v_ice1(ji,jj)  = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji,  jj-1) ) * e1t(ji+1,jj)     &
+                  &                      + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) )   &
+                  &                      / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+               u_ice2(ji,jj)  = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                      + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) )   &
+                  &                      / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+            ENDIF 
+         END DO
+      END DO
+
+      CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. )
+
+      ! Recompute delta, shear and div, inputs for mechanical redistribution 
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = fs_2, jpim1   !RB bug no vect opt due to zmask
+            !- divu_i(:,:), zdt(:,:): divergence and tension at centre 
+            !- zds(:,:): shear on northeast corner of grid cells
+            IF ( vt_i(ji,jj) <= zvmin ) THEN
+
+               divu_i(ji,jj) = (  e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj  ) * u_ice(ji-1,jj  )   &
+                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji  ,jj-1) * v_ice(ji  ,jj-1)   &
+                  &            ) * r1_e1e2t(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)  &
+                  &          -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  &
+                  &         ) * r1_e1e2t(ji,jj)
+               !
+               ! SB modif because ocean has no slip boundary condition 
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)  &
+                  &          +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)  &
+                  &         ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) )                                     &
+                  &         * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+               zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj  ) * v_ice1(ji-1,jj  )    &
+                  &   + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji  ,jj-1) * u_ice2(ji  ,jj-1) ) * r1_e1e2t(ji,jj)
+
+               delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )  
+               delta_i(ji,jj) = delta + rn_creepl
+            
+            ENDIF
+         END DO
+      END DO
+      !
+      !------------------------------------------------------------------------------!
+      ! 5) Store stress tensor and its invariants
+      !------------------------------------------------------------------------------!
+      ! * Invariants of the stress tensor are required for limitd_me
+      !   (accelerates convergence and improves stability)
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = fs_2, fs_jpim1
+            zdst           = (  e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)  &   
+               &              + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 
+            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst )
+         END DO
+      END DO
+
+      ! Lateral boundary condition
+      CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1.,  shear_i(:,:), 'T', 1. )
+
+      ! * Store the stress tensor for the next time step
+      stress1_i (:,:) = zs1 (:,:)
+      stress2_i (:,:) = zs2 (:,:)
+      stress12_i(:,:) = zs12(:,:)
+
+      !
+      !------------------------------------------------------------------------------!
+      ! 6) Control prints of residual and charge ellipse
+      !------------------------------------------------------------------------------!
+      !
+      ! print the residual for convergence
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('lim_rhg  : res =',D23.16, ' iter =',I4)") zresm, jter
+         CALL prt_ctl_info(charout)
+         CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_rhg  : u_ice :', tab2d_2=v_ice, clinfo2=' v_ice :')
+      ENDIF
+
+      ! print charge ellipse
+      ! This can be desactivated once the user is sure that the stress state
+      ! lie on the charge ellipse. See Bouillon et al. 08 for more details
+      IF(ln_ctl) THEN
+         CALL prt_ctl_info('lim_rhg  : numit  :',ivar1=numit)
+         CALL prt_ctl_info('lim_rhg  : nwrite :',ivar1=nwrite)
+         CALL prt_ctl_info('lim_rhg  : MOD    :',ivar1=MOD(numit,nwrite))
+         IF( MOD(numit,nwrite) .EQ. 0 ) THEN
+            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 1000, numit, 0, 0, ' ch. ell. '
+            CALL prt_ctl_info(charout)
+            DO jj = k_j1+1, k_jpj-1
+               DO ji = 2, jpim1
+                  IF (zpresh(ji,jj) > 1.0) THEN
+                     sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 
+                     sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )
+                     WRITE(charout,FMT="('lim_rhg  :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)")
+                     CALL prt_ctl_info(charout)
+                  ENDIF
+               END DO
+            END DO
+            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 2000, numit, 0, 0, ' ch. ell. '
+            CALL prt_ctl_info(charout)
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
+      CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask               )
+      CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
+      CALL wrk_dealloc( jpi,jpj, zs1   , zs2   , zs12   , zresr , zpice                 )
+
+   END SUBROUTINE lim_rhg
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_rhg( k1 , k2 )         ! Dummy routine
+      WRITE(*,*) 'lim_rhg: You should not have seen this print! error?', k1, k2
+   END SUBROUTINE lim_rhg
+#endif
+
+   !!==============================================================================
+END MODULE limrhg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 8732)
@@ -0,0 +1,620 @@
+MODULE limrhg_2
+   !!======================================================================
+   !!                     ***  MODULE  limrhg_2  ***
+   !!   Ice rheology :  performs sea ice rheology
+   !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameter
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean variables
+   USE sbc_ice        ! surface boundary condition: ice variables
+   USE dom_ice_2      ! LIM2: ice domain
+   USE phycst         ! physical constant
+   USE ice_2          ! LIM2: ice variables
+   USE lbclnk         ! lateral boundary condition - MPP exchanges
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE oce     , ONLY : snwice_mass, snwice_mass_b
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+#if defined key_agrif
+   USE agrif_lim2_interp ! nesting
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_rhg_2         ! routine called by lim_dyn
+
+   REAL(wp) ::   rzero   = 0._wp   ! constant value: zero
+   REAL(wp) ::   rone    = 1._wp   !            and  one
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_rhg_2( k_j1, k_jpj )
+      !!-------------------------------------------------------------------
+      !!                 ***  SUBROUTINR lim_rhg_2  ***
+      !!
+      !! ** purpose :   determines the velocity field of sea ice by using
+      !!  atmospheric (wind stress) and oceanic (water stress and surface
+      !!  tilt) forcings. Ice-ice interaction is described by a non-linear
+      !!  viscous-plastic law including shear strength and a bulk rheology.
+      !!
+      !! ** Action  : - compute u_ice, v_ice the sea-ice velocity defined
+      !!              at I-point
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation
+      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation
+      !!
+      INTEGER ::   ji, jj              ! dummy loop indices
+      INTEGER ::   iter, jter          ! temporary integers
+      CHARACTER (len=50) ::   charout
+      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
+      REAL(wp) ::   ztrace2, zdeter, zdelta, zmask, zdgp, zdgi, zdiag
+      REAL(wp) ::   za1, zb1, zc1, zd1
+      REAL(wp) ::   za2, zb2, zc2, zd2, zden
+      REAL(wp) ::   zs11_11, zs11_12, zs11_21, zs11_22
+      REAL(wp) ::   zs12_11, zs12_12, zs12_21, zs12_22
+      REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22
+      REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22
+      REAL(wp) ::   zintb, zintn
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld, zmass, zcorl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct, za2ct, zresr
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zc1u, zc1v, zc2u, zc2v
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsang, zpice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu0, zv0
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_n, zv_n
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_a, zv_a
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zviszeta, zviseta
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zzfrld, zztms
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zi1, zi2, zmasst, zpresh
+      !!-------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )
+      CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )
+      CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
+      CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
+
+      !  Store initial velocities
+      !  ----------------
+      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._wp
+      zi2   (:,:) = 0._wp
+      zpresh(:,:) = 0._wp
+      zmasst(:,:) = 0._wp
+!i
+!!gm violant
+      zfrld(:,:) =0._wp
+      zcorl(:,:) =0._wp
+      zmass(:,:) =0._wp
+      za1ct(:,:) =0._wp
+      za2ct(:,:) =0._wp
+!!gm end
+
+      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
+
+      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+          !
+          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
+          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
+         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+          !
+         !
+      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
+         zpice(:,:) = ssh_m(:,:)
+      ENDIF
+#if defined key_agrif
+      ! load the boundary value of velocity in special array zuive and zvice
+      CALL agrif_rhg_lim2_load
+#endif
+
+      ! Ice mass, ice strength, and wind stress at the center            |
+      ! of the grid squares.                                             |
+      !-------------------------------------------------------------------
+
+      DO jj = k_j1 , k_jpj-1
+         DO ji = 1 , jpi
+            ! only the sinus changes its sign with the hemisphere
+            zsang(ji,jj)  = SIGN( 1._wp, ff_t(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._wp - frld(ji,jj) )
+            zi2(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) )
+         END DO
+      END DO
+
+
+      !---------------------------------------------------------------------------
+      !  Wind stress, coriolis and mass terms at the corners of the grid squares |
+      !  Gradient of ice strenght.                                               |
+      !---------------------------------------------------------------------------
+         
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = 2, jpi    ! NO vector opt.
+            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._wp / MAX( zstms, epsd )
+
+            zt11 = zztms(ji  ,jj  ) * zzfrld(ji  ,jj  ) 
+            zt12 = zztms(ji-1,jj  ) * zzfrld(ji-1,jj  ) 
+            zt21 = zztms(ji  ,jj-1) * zzfrld(ji  ,jj-1) 
+            zt22 = zztms(ji-1,jj-1) * zzfrld(ji-1,jj-1)
+
+            ! Leads area.
+            zfrld(ji,jj) =  (  zt11 * wght(ji,jj,2,2) + zt12 * wght(ji,jj,1,2)   &
+               &             + zt21 * wght(ji,jj,2,1) + zt22 * wght(ji,jj,1,1) ) * zusw
+
+            ! Mass and coriolis coeff. at I-point
+            zmass(ji,jj) = ( zmasst(ji,jj  ) * wght(ji,jj,2,2) + zmasst(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &           + zmasst(ji,jj-1) * wght(ji,jj,2,1) + zmasst(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw
+            zcorl(ji,jj) = zmass(ji,jj) &
+               &           *( ff_t(ji,jj  ) * wght(ji,jj,2,2) + ff_t(ji-1,jj  )*wght(ji,jj,1,2)   &
+               &            + ff_t(ji,jj-1) * wght(ji,jj,2,1) + ff_t(ji-1,jj-1)*wght(ji,jj,1,1) ) * zusw
+
+            ! Wind stress.
+            ! always provide stress at I-point
+            ztagnx = ( zi1(ji,jj  ) * wght(ji,jj,2,2) + zi1(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &     + zi1(ji,jj-1) * wght(ji,jj,2,1) + zi1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * utau_ice(ji,jj)
+            ztagny = ( zi2(ji,jj  ) * wght(ji,jj,2,2) + zi2(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &     + zi2(ji,jj-1) * wght(ji,jj,2,1) + zi2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * vtau_ice(ji,jj)
+
+            ! Gradient of ice strength
+            zgphsx =   ( alambd(ji,jj,2,2,2,1) - alambd(ji,jj,2,1,2,1) ) * zpresh(ji  ,jj-1)   &
+               &     + ( alambd(ji,jj,2,2,2,2) - alambd(ji,jj,2,1,2,2) ) * zpresh(ji  ,jj  )   &
+               &     - ( alambd(ji,jj,2,2,1,1) + alambd(ji,jj,2,1,1,1) ) * zpresh(ji-1,jj-1)   &
+               &     - ( alambd(ji,jj,2,2,1,2) + alambd(ji,jj,2,1,1,2) ) * zpresh(ji-1,jj  )
+
+            zgphsy = - ( alambd(ji,jj,1,1,2,1) + alambd(ji,jj,1,2,2,1) ) * zpresh(ji  ,jj-1)   &
+               &     - ( alambd(ji,jj,1,1,1,1) + alambd(ji,jj,1,2,1,1) ) * zpresh(ji-1,jj-1)   &
+               &     + ( alambd(ji,jj,1,1,2,2) - alambd(ji,jj,1,2,2,2) ) * zpresh(ji  ,jj  )   &
+               &     + ( alambd(ji,jj,1,1,1,2) - alambd(ji,jj,1,2,1,2) ) * zpresh(ji-1,jj  )
+
+            ! Gradient of the sea surface height
+            zgsshx =  (   (zpice(ji  ,jj  ) - zpice(ji-1,jj  ))/e1u(ji-1,jj  )   &
+               &       +  (zpice(ji  ,jj-1) - zpice(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
+            zgsshy =  (   (zpice(ji  ,jj  ) - zpice(ji  ,jj-1))/e2v(ji  ,jj-1)   &
+               &       +  (zpice(ji-1,jj  ) - zpice(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
+
+            ! Computation of the velocity field taking into account the ice-ice interaction.                                 
+            ! Terms that are independent of the ice velocity field.
+            za1ct(ji,jj) = ztagnx - zmass(ji,jj) * grav * zgsshx - zgphsx
+            za2ct(ji,jj) = ztagny - zmass(ji,jj) * grav * zgsshy - zgphsy
+         END DO
+      END DO
+
+
+      ! SOLUTION OF THE MOMENTUM EQUATION.
+      !------------------------------------------
+      !                                                   ! ==================== !
+      DO iter = 1 , 2 * nbiter                            !    loop over iter    !
+         !                                                ! ==================== !        
+         zindu = MOD( iter , 2 )
+         zusdtp = ( zindu * 2._wp + ( 1._wp - zindu ) * 1._wp )  * REAL( nbiter ) / rdt_ice
+
+         ! Computation of free drift field for free slip boundary conditions.
+
+         DO jj = k_j1, k_jpj-1
+            DO ji = 1, fs_jpim1
+               !- Rate of strain tensor.
+               zt11 =   akappa(ji,jj,1,1) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) - zu_a(ji,jj  ) - zu_a(ji  ,jj+1) )  &
+                  &   + akappa(ji,jj,1,2) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) + zv_a(ji,jj  ) + zv_a(ji  ,jj+1) )
+               zt12 = - akappa(ji,jj,2,2) * ( zu_a(ji  ,jj) + zu_a(ji+1,jj  ) - zu_a(ji,jj+1) - zu_a(ji+1,jj+1) )  &
+                  &   - akappa(ji,jj,2,1) * ( zv_a(ji  ,jj) + zv_a(ji+1,jj  ) + zv_a(ji,jj+1) + zv_a(ji+1,jj+1) )
+               zt22 = - akappa(ji,jj,2,2) * ( zv_a(ji  ,jj) + zv_a(ji+1,jj  ) - zv_a(ji,jj+1) - zv_a(ji+1,jj+1) )  &
+                  &   + akappa(ji,jj,2,1) * ( zu_a(ji  ,jj) + zu_a(ji+1,jj  ) + zu_a(ji,jj+1) + zu_a(ji+1,jj+1) )
+               zt21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji,jj  ) - 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  ) + zu_a(ji  ,jj+1) )
+
+               !- Rate of strain tensor. 
+               zdgp = zt11 + zt22
+               zdgi = zt12 + zt21
+               ztrace2 = zdgp * zdgp 
+               zdeter  = zt11 * zt22 - 0.25_wp * zdgi * zdgi
+
+               !  Creep limit depends on the size of the grid.
+               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  rn_creepl)
+
+               !-  Computation of viscosities.
+               zviszeta(ji,jj) = MAX( zpresh(ji,jj) / zdelta, etamn )
+               zviseta (ji,jj) = zviszeta(ji,jj) * usecc2
+            END DO
+         END DO
+
+         !-  Determination of zc1u, zc2u, zc1v and zc2v.
+         DO jj = k_j1+1, k_jpj-1
+            DO ji = 2, fs_jpim1   ! NO vector opt.
+               !* zc1u , zc2v
+               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
+               zs12_11 =  zvis12 * akappa(ji-1,jj-1,2,2) - zvis21 * akappa(ji-1,jj-1,1,2)
+               zs21_11 = -zvis12 * akappa(ji-1,jj-1,1,2) + zvis21 * akappa(ji-1,jj-1,2,2)
+               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,1) + zdiag
+
+               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
+               zs12_21 =  zvis12 * akappa(ji,jj-1,2,2) - zvis21 * akappa(ji,jj-1,1,2)
+               zs22_21 =  zvis11 * akappa(ji,jj-1,2,1) + zdiag
+               zs21_21 = -zvis12 * akappa(ji,jj-1,1,2) + zvis21 * akappa(ji,jj-1,2,2)
+
+               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)
+               zs22_12 =  zvis11 * akappa(ji-1,jj,2,1) + zdiag
+               zs21_12 = -zvis12 * akappa(ji-1,jj,1,2) - zvis21 * akappa(ji-1,jj,2,2)
+
+               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
+               zs12_22 = -zvis12 * akappa(ji,jj,2,2) - zvis21 * akappa(ji,jj,1,2)
+               zs22_22 =  zvis11 * akappa(ji,jj,2,1) + zdiag
+               zs21_22 = -zvis12 * akappa(ji,jj,1,2) - zvis21 * akappa(ji,jj,2,2)
+
+               zc1u(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22   &
+                  &          - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12   &
+                  &          - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11   &
+                  &          + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12   &
+                  &          + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21   &
+                  &          + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22   &
+                  &          - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21   &
+                  &          - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22
+
+               zc2u(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22   &
+                  &          - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12   &
+                  &          - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11   &
+                  &          + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12   &
+                  &          - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21   &
+                  &          - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22   &
+                  &          + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21   &
+                  &          + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22
+
+               !* zc1v , zc2v.
+               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
+               zs12_11 = -zvis12 * akappa(ji-1,jj-1,2,1) + zvis21 * akappa(ji-1,jj-1,1,1)
+               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,2) + zdiag
+               zs21_11 =  zvis12 * akappa(ji-1,jj-1,1,1) - zvis21 * akappa(ji-1,jj-1,2,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
+               zs12_21 = -zvis12 * akappa(ji,jj-1,2,1) - zvis21 * akappa(ji,jj-1,1,1)
+               zs22_21 =  zvis11 * akappa(ji,jj-1,2,2) + zdiag
+               zs21_21 = -zvis12 * akappa(ji,jj-1,1,1) - zvis21 * akappa(ji,jj-1,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,2) - akappa(ji-1,jj,2,2) )
+               zs11_12 =  zvis11 * akappa(ji-1,jj,1,2) + zdiag
+               zs12_12 = -zvis12 * akappa(ji-1,jj,2,1) + zvis21 * akappa(ji-1,jj,1,1)
+               zs22_12 = -zvis11 * akappa(ji-1,jj,2,2) + zdiag
+               zs21_12 =  zvis12 * akappa(ji-1,jj,1,1) - zvis21 * akappa(ji-1,jj,2,1)
+
+               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
+               zs12_22 = -zvis12 * akappa(ji,jj,2,1) - zvis21 * akappa(ji,jj,1,1)
+               zs22_22 = -zvis11 * akappa(ji,jj,2,2) + zdiag
+               zs21_22 = -zvis12 * akappa(ji,jj,1,1) - zvis21 * akappa(ji,jj,2,1)
+
+               zc1v(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22   &
+                  &          - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12   &
+                  &          - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11   &
+                  &          + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12   &
+                  &          + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21   &
+                  &          + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22   &
+                  &          - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21   &
+                  &          - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22
+
+               zc2v(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22   &
+                  &          - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12   &
+                  &          - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11   &
+                  &          + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12   &
+                  &          - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21   &
+                  &          - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22   &
+                  &          + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21   &
+                  &          + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22
+            END DO
+         END DO
+
+         ! GAUSS-SEIDEL method
+         !                                                      ! ================ !
+iflag:   DO jter = 1 , nbitdr                                   !    Relaxation    !
+            !                                                   ! ================ !
+            DO jj = k_j1+1, k_jpj-1
+               DO ji = 2, fs_jpim1   ! NO vector opt.
+                  !
+                  ze11 =   akappa(ji,jj-1,1,1) * zu_a(ji+1,jj) + akappa(ji,jj-1,1,2) * zv_a(ji+1,jj)
+                  ze12 = + akappa(ji,jj-1,2,2) * zu_a(ji+1,jj) - akappa(ji,jj-1,2,1) * zv_a(ji+1,jj)
+                  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._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
+                  zs12_21 =  zvis12 * ze12 + zvis21 * ze21
+                  zs22_21 =  zvis11 * ze22 + zdiag
+                  zs21_21 =  zvis12 * ze21 + zvis21 * ze12
+
+                  ze11 =   akappa(ji-1,jj,1,1) * ( zu_a(ji  ,jj+1) - zu_a(ji-1,jj+1) )   &
+                     &   + akappa(ji-1,jj,1,2) * ( zv_a(ji  ,jj+1) + zv_a(ji-1,jj+1) )
+                  ze12 = + akappa(ji-1,jj,2,2) * ( zu_a(ji-1,jj+1) + zu_a(ji  ,jj+1) )   &
+                     &   - akappa(ji-1,jj,2,1) * ( zv_a(ji-1,jj+1) + zv_a(ji  ,jj+1) )
+                  ze22 = + akappa(ji-1,jj,2,2) * ( zv_a(ji-1,jj+1) + zv_a(ji  ,jj+1) )   &
+                     &   + akappa(ji-1,jj,2,1) * ( zu_a(ji-1,jj+1) + zu_a(ji  ,jj+1) )
+                  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._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
+                  zs12_12 =  zvis12 * ze12 + zvis21 * ze21
+                  zs22_12 =  zvis11 * ze22 + zdiag
+                  zs21_12 =  zvis12 * ze21 + zvis21 * ze12
+
+                  ze11 =   akappa(ji,jj,1,1) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) - zu_a(ji  ,jj+1) )   &
+                     &   + akappa(ji,jj,1,2) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) + zv_a(ji  ,jj+1) )
+                  ze12 = - akappa(ji,jj,2,2) * ( zu_a(ji+1,jj) - zu_a(ji  ,jj+1) - zu_a(ji+1,jj+1) )   &
+                     &   - akappa(ji,jj,2,1) * ( zv_a(ji+1,jj) + zv_a(ji  ,jj+1) + zv_a(ji+1,jj+1) )
+                  ze22 = - akappa(ji,jj,2,2) * ( zv_a(ji+1,jj) - zv_a(ji  ,jj+1) - zv_a(ji+1,jj+1) )   &
+                     &   + akappa(ji,jj,2,1) * ( zu_a(ji+1,jj) + zu_a(ji  ,jj+1) + zu_a(ji+1,jj+1) )
+                  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._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
+                  zs12_22 =  zvis12 * ze12 + zvis21 * ze21
+                  zs22_22 =  zvis11 * ze22 + zdiag
+                  zs21_22 =  zvis12 * ze21 + zvis21 * ze12
+
+            ! 2nd part
+                  ze11 =   akappa(ji-1,jj-1,1,1) * ( zu_a(ji  ,jj-1) - zu_a(ji-1,jj-1) - zu_a(ji-1,jj) )   &
+                     &   + akappa(ji-1,jj-1,1,2) * ( zv_a(ji  ,jj-1) + zv_a(ji-1,jj-1) + zv_a(ji-1,jj) )
+                  ze12 = - akappa(ji-1,jj-1,2,2) * ( zu_a(ji-1,jj-1) + zu_a(ji  ,jj-1) - zu_a(ji-1,jj) )   &
+                     &   - akappa(ji-1,jj-1,2,1) * ( zv_a(ji-1,jj-1) + zv_a(ji  ,jj-1) + zv_a(ji-1,jj) )
+                  ze22 = - akappa(ji-1,jj-1,2,2) * ( zv_a(ji-1,jj-1) + zv_a(ji  ,jj-1) - zv_a(ji-1,jj) )   &
+                     &   + akappa(ji-1,jj-1,2,1) * ( zu_a(ji-1,jj-1) + zu_a(ji  ,jj-1) + zu_a(ji-1,jj) )
+                  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._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
+                  zs12_11 =  zvis12 * ze12 + zvis21 * ze21
+                  zs22_11 =  zvis11 * ze22 + zdiag
+                  zs21_11 =  zvis12 * ze21 + zvis21 * ze12
+
+                  ze11 =   akappa(ji,jj-1,1,1) * ( zu_a(ji+1,jj-1) - zu_a(ji  ,jj-1) )   &
+                     &   + akappa(ji,jj-1,1,2) * ( zv_a(ji+1,jj-1) + zv_a(ji  ,jj-1) )
+                  ze12 = - akappa(ji,jj-1,2,2) * ( zu_a(ji  ,jj-1) + zu_a(ji+1,jj-1) )   &
+                     &   - akappa(ji,jj-1,2,1) * ( zv_a(ji  ,jj-1) + zv_a(ji+1,jj-1) )
+                  ze22 = - akappa(ji,jj-1,2,2) * ( zv_a(ji  ,jj-1) + zv_a(ji+1,jj-1) )   &
+                     &   + akappa(ji,jj-1,2,1) * ( zu_a(ji  ,jj-1) + zu_a(ji+1,jj-1) )
+                  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._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
+                  zs12_21 =  zs12_21 + zvis12 * ze12 + zvis21 * ze21
+                  zs22_21 =  zs22_21 + zvis11 * ze22 + zdiag
+                  zs21_21 =  zs21_21 + zvis12 * ze21 + zvis21 * ze12
+
+                  ze11 = - akappa(ji-1,jj,1,1) * zu_a(ji-1,jj) + akappa(ji-1,jj,1,2) * zv_a(ji-1,jj)
+                  ze12 = - akappa(ji-1,jj,2,2) * zu_a(ji-1,jj) - akappa(ji-1,jj,2,1) * zv_a(ji-1,jj)
+                  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._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
+                  zs12_12 =  zs12_12 + zvis12 * ze12 + zvis21 * ze21
+                  zs22_12 =  zs22_12 + zvis11 * ze22 + zdiag
+                  zs21_12 =  zs21_12 + zvis12 * ze21 + zvis21 * ze12
+
+                  zd1 = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22  &
+                     &  - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12  &
+                     &  - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11  &
+                     &  + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12  &
+                     &  + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21  &
+                     &  + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22  &
+                     &  - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21  &
+                     &  - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22
+
+                  zd2 = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22  &
+                     &  - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12  &
+                     &  - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11  &
+                     &  + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12  &
+                     &  - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21  &
+                     &  - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22  &
+                     &  + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21  &
+                     &  + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22
+
+                  zur     = zu_a(ji,jj) - u_oce(ji,jj)
+                  zvr     = zv_a(ji,jj) - v_oce(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._wp - zfrld(ji,jj) )
+                  zac     = za * cangvg
+                  zmpzas  = alpha * zcorl(ji,jj) + za * zsang(ji,jj)
+                  zmassdt = zusdtp * zmass(ji,jj)
+                  zcorlal = ( 1._wp - alpha ) * zcorl(ji,jj)
+
+                  za1 =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   &
+                     &        + za * ( cangvg * u_oce(ji,jj) - zsang(ji,jj) * v_oce(ji,jj) )
+                  za2 =  zmassdt * zv0(ji,jj) - zcorlal * zu0(ji,jj) + za2ct(ji,jj)   &
+                     &        + za * ( cangvg * v_oce(ji,jj) + zsang(ji,jj) * u_oce(ji,jj) )
+                  zb1    = zmassdt + zac - zc1u(ji,jj)
+                  zb2    = zmpzas        - zc2u(ji,jj)
+                  zc1    = zmpzas        + zc1v(ji,jj)
+                  zc2    = zmassdt + zac - zc2v(ji,jj)
+                  zdeter = zc1 * zb2 + zc2 * zb1
+                  zden   = SIGN( rone, zdeter) / MAX( epsd , ABS( zdeter ) )
+                  zunw   = (  ( za1 + zd1 ) * zc2 + ( za2 + zd2 ) * zc1 ) * zden
+                  zvnw   = (  ( za2 + zd2 ) * zb1 - ( za1 + zd1 ) * zb2 ) * zden
+                  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
+                  zv_n(ji,jj) = ( zv_a(ji,jj) + om * ( zvnw - zv_a(ji,jj) ) * tmu(ji,jj) ) * zmask
+               END DO
+            END DO
+
+            CALL lbc_lnk( zu_n(:,1:jpj), 'I', -1. )
+            CALL lbc_lnk( zv_n(:,1:jpj), 'I', -1. )
+
+#if defined key_agrif
+            ! copy the boundary value from u_ice_nst and v_ice_nst to u_ice and v_ice
+            ! before next interations
+            CALL agrif_rhg_lim2(zu_n,zv_n)
+#endif
+
+            ! Test of Convergence
+            DO jj = k_j1+1 , k_jpj-1
+               zresr(:,jj) = MAX( ABS( zu_a(:,jj) - zu_n(:,jj) ) , ABS( zv_a(:,jj) - zv_n(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr(1:jpi,k_j1+1:k_jpj-1) )
+!!!! this should be faster on scalar processor
+!           zresm = MAXVAL(  MAX( ABS( zu_a(1:jpi,k_j1+1:k_jpj-1) - zu_n(1:jpi,k_j1+1:k_jpj-1) ),   &
+!              &                  ABS( zv_a(1:jpi,k_j1+1:k_jpj-1) - zv_n(1:jpi,k_j1+1:k_jpj-1) ) )  )
+!!!!
+            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
+
+            DO jj = k_j1, k_jpj
+               zu_a(:,jj) = zu_n(:,jj)
+               zv_a(:,jj) = zv_n(:,jj)
+            END DO
+
+            IF( zresm <= resl )   EXIT   iflag
+
+            !                                                   ! ================ !
+         END DO    iflag                                        !  end Relaxation  !
+         !                                                      ! ================ !
+
+         IF( zindu == 0 ) THEN      ! even iteration
+            DO jj = k_j1 , k_jpj-1
+               zu0(:,jj) = zu_a(:,jj)
+               zv0(:,jj) = zv_a(:,jj)
+            END DO
+         ENDIF
+         !                                                ! ==================== !
+      END DO                                              !  end loop over iter  !
+      !                                                   ! ==================== !
+
+      u_ice(:,:) = zu_a(:,1:jpj)
+      v_ice(:,:) = zv_a(:,1:jpj)
+
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('lim_rhg  : res =',D23.16, ' iter =',I4)") zresm, jter
+         CALL prt_ctl_info(charout)
+         CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_rhg  : u_ice :', tab2d_2=v_ice, clinfo2=' v_ice :')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr )
+      CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice )
+      CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
+      CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
+
+   END SUBROUTINE lim_rhg_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option        Dummy module      NO VP & LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_rhg_2( k1 , k2 )       ! Dummy routine
+      WRITE(*,*) 'lim_rhg_2: You should not have seen this print! error?', k1, k2
+   END SUBROUTINE lim_rhg_2
+#endif
+
+   !!==============================================================================
+END MODULE limrhg_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 8732)
@@ -0,0 +1,276 @@
+MODULE limrst_2
+   !!======================================================================
+   !!                     ***  MODULE  limrst_2  ***
+   !! Ice restart :  write the ice restart file
+   !!======================================================================
+   !! 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
+   !!   lim_rst_write_2 : write of the ice restart file 
+   !!   lim_rst_read_2  : read  the ice restart file 
+   !!----------------------------------------------------------------------
+   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
+   PRIVATE
+
+   PUBLIC   lim_rst_opn_2     ! routine called by sbcice_lim_2.F90
+   PUBLIC   lim_rst_write_2   ! routine called by sbcice_lim_2.F90
+   PUBLIC   lim_rst_read_2    ! routine called by iceini_2.F90
+
+   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write 
+   INTEGER, PUBLIC ::   numrir, numriw   !: logical unit for ice restart (read and write)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_rst_opn_2( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_opn_2  ***
+      !!
+      !! ** purpose  :   output of sea-ice variable in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      !
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=150)  ::   clpath   ! full path to ice output restart file
+      !!----------------------------------------------------------------------
+      !
+      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
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE lim_rst_opn_2
+
+
+   SUBROUTINE lim_rst_write_2( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_write_2  ***
+      !!
+      !! ** purpose  :   output of sea-ice variable in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !
+      INTEGER ::   iter   ! kt + nn_fsbc -1
+      !!----------------------------------------------------------------------
+
+      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+
+      IF( iter == nitrst ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'lim_rst_write_2 : write ice restart file  kt =', kt
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! Write in numriw (if iter == nitrst)
+      ! ------------------ 
+      !                                                                     ! calendar control
+      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 (:,:)   )
+#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
+         CALL iom_close( numriw )                         ! close the restart file
+         lrst_ice = .FALSE.
+      ENDIF
+      !
+   END SUBROUTINE lim_rst_write_2
+
+
+   SUBROUTINE lim_rst_read_2
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_read_2  ***
+      !!
+      !! ** purpose  :   read of sea-ice variable restart in a netcdf file
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   ziter
+      INTEGER  ::   jlibalt = jprstlib
+      LOGICAL  ::   llok
+      INTEGER  ::   itest
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_rst_read_2 : read ice NetCDF restart file'
+         WRITE(numout,*) '~~~~~~~~~~~~~~'
+      ENDIF
+
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt )
+
+      CALL iom_get( numrir, 'kt_ice' , ziter )
+      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', INT( ziter )
+      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
+
+      !Control of date
+      
+      IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',        &
+         &                   '   control of time parameter  nrstdt' )
+
+      CALL iom_get( numrir, jpdom_autoglo, 'hicif' , hicif  )    
+      CALL iom_get( numrir, jpdom_autoglo, 'hsnif' , hsnif  )    
+      CALL iom_get( numrir, jpdom_autoglo, 'frld'  , frld   )    
+      CALL iom_get( numrir, jpdom_autoglo, 'sist'  , sist   )    
+      CALL iom_get( numrir, jpdom_autoglo, 'tbif1' , tbif(:,:,1) )    
+      CALL iom_get( numrir, jpdom_autoglo, 'tbif2' , tbif(:,:,2) )    
+      CALL iom_get( numrir, jpdom_autoglo, 'tbif3' , tbif(:,:,3) )    
+
+      itest = iom_varid( numrir, 'u_ice', ldstop = .FALSE. )   ! test if the variable u_ice is included in the file
+      IF( itest > 0 ) THEN   ! yes -> new restart files (from NEMO 3.2)
+         CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice )  
+         CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice )    
+      ELSE                   ! no  -> old restart file with variable called [uv]i_ice (inroduced in NEMO 3.0)
+         CALL iom_get( numrir, jpdom_autoglo, 'ui_ice', u_ice )  
+         CALL iom_get( numrir, jpdom_autoglo, 'vi_ice', v_ice )    
+      ENDIF
+
+      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 )
+      !
+   END SUBROUTINE lim_rst_read_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :       Empty module        NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limrst_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 8732)
@@ -0,0 +1,513 @@
+MODULE limsbc_2
+   !!======================================================================
+   !!                       ***  MODULE limsbc_2   ***
+   !! LIM-2 :   updates the fluxes at the ocean surface with ice-ocean fluxes
+   !!======================================================================
+   !! 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
+   !!           3.3.1 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.5  ! 2012-11 ((G. Madec, Y. Aksenov, A. Coward) salt and heat fluxes associated with e-p
+   !!----------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_sbc_alloc_2 : allocate the limsbc arrays
+   !!   lim_sbc_init    : initialisation
+   !!   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 domvvl           ! ocean vertical scale factors
+   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 sbccpl           ! surface boundary condition: coupled interface
+   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
+   USE albedo           ! albedo parameters
+   !
+   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE in_out_manager   ! I/O manager
+   USE iom              ! I/O library
+   USE prtctl           ! Print control
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_sbc_init_2   ! called by ice_init_2
+   PUBLIC   lim_sbc_flx_2    ! called by sbc_ice_lim_2
+   PUBLIC   lim_sbc_tau_2    ! called by sbc_ice_lim_2
+
+   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), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0       ! fix SSS and ice salinity used in levitating case 0
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2]
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s]
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lim_sbc_alloc_2()
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE lim_sbc_alloc_2 ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) ,                       &
+         &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc_2)
+         !
+      IF( lk_mpp               )   CALL mpp_sum( lim_sbc_alloc_2 )
+      IF( lim_sbc_alloc_2 /= 0 )   CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.')
+      !
+   END FUNCTION lim_sbc_alloc_2
+
+
+   SUBROUTINE lim_sbc_flx_2( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_sbc_2 ***
+      !!  
+      !! ** Purpose :   Update surface ocean boundary condition over areas
+      !!              that are at least partially covered by sea-ice
+      !!         
+      !! ** Action  : - comput. of the momentum, heat and freshwater/salt
+      !!                fluxes at the ice-ocean interface.
+      !!              - Update the fluxes provided to the ocean
+      !!     
+      !! ** Outputs : - qsr     : sea heat flux    : solar 
+      !!              - qns     : sea heat flux    : non solar (including heat content of the mass flux)
+      !!              - emp     : freshwater budget: mass flux 
+      !!              - sfx     : freshwater budget: salt flux due to Freezing/Melting
+      !!              - fr_i    : ice fraction
+      !!              - tn_ice  : sea-ice surface temperature
+      !!              - alb_ice : sea-ice albedo (ln_cpl=T)
+      !!
+      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
+      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      !
+      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,   zfmm     ! local scalars
+      REAL(wp) ::   zinda,    zfsalt, zemp     !   -      -
+      REAL(wp) ::   zemp_snw, zqhc,   zcd      !   -      -
+      REAL(wp) ::   zswitch                    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zqnsoce       ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace
+      !!---------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, zqnsoce )
+      CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp )
+      !
+      SELECT CASE( nn_ice_embd )             ! levitating or embedded sea-ice option
+         CASE( 0    )   ;   zswitch = 1         ! (0) old levitating sea-ice : salt exchange only
+         CASE( 1, 2 )   ;   zswitch = 0         ! (1) levitating sea-ice: salt and volume exchange but no pressure effect
+         !                                      ! (2) embedded sea-ice : salt and volume fluxes and pressure
+      END SELECT
+
+      !------------------------------------------!
+      !      heat flux at the ocean surface      !
+      !------------------------------------------!
+
+      zqnsoce(:,:) = qns(:,:)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zinda   = 1.0   - MAX( rzero , SIGN( rone, - ( 1.0 - pfrld(ji,jj) )   ) )
+            ifvt    = zinda * MAX( rzero , SIGN( rone,  - phicif(ji,jj)           ) )
+            i1mfr   = 1.0   - MAX( rzero , SIGN( rone, - ( 1.0 - frld(ji,jj) )    ) )
+            idfr    = 1.0   - MAX( rzero , SIGN( rone, frld(ji,jj) - pfrld(ji,jj) ) )
+            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )
+            ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr
+            iadv    = ( 1  - i1mfr ) * zinda
+            ifral   = ( 1  - i1mfr * ( 1 - ial ) )   
+            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
+
+!!$            attempt to explain the tricky flags set above....
+!!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   ! = 0. if ice-free ocean else 1. (after ice adv, but before ice thermo)
+!!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   ! = 0. if ice-free ocean else 1. (after ice thermo)
+!!$
+!!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      ! = zinda if previous thermodynamic step overmelted the ice???
+!!$            ELSE                             ;   ifvt = 0.         ! 
+!!$            ENDIF
+!!$
+!!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases due to ice thermodynamics
+!!$            ELSE                                     ;   idfr = 1.   
+!!$            ENDIF
+!!$
+!!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous time and ice-free ocean currently
+!!$
+!!$            ial     = ifvt   * i1mfr    +    ( 1 - ifvt ) * idfr
+!!$                    = i1mfr if ifvt = 1 i.e. 
+!!$                    = idfr  if ifvt = 0
+!!$!                 snow no ice   ice         ice or nothing  lead fraction increases
+!!$!                 at previous   now           at previous
+!!$!                -> ice area increases  ???         -> ice area decreases ???
+!!$
+!!$            iadv    = ( 1  - i1mfr ) * zinda
+!!$!                     pure ocean      ice at
+!!$!                     at current      previous
+!!$!                        -> = 1. if ice disapear between previous and current
+!!$
+!!$            ifral   = ( 1  - i1mfr * ( 1 - ial ) )  
+!!$!                            ice at     ???
+!!$!                            current         
+!!$!                         -> ???
+!!$
+!!$            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv
+!!$!                                                    ice disapear
+!!$
+!!$
+
+            !   computation the solar flux at ocean surface
+            IF( ln_cpl ) THEN
+               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
+            ELSE
+               zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj)
+            ENDIF
+            !  computation the non solar heat flux at ocean surface
+            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) ) * r1_rdtice  &
+               &       + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice 
+
+            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! store residual heat flux (to put into the ocean at the next time-step)
+            zqhc = ( rdq_snw(ji,jj)                                     &
+                 & + rdq_ice(ji,jj) * ( 1.- zswitch) ) * r1_rdtice       ! heat flux due to snow ( & ice heat content, 
+            !                                                            !           if ice/ocean mass exchange active) 
+            qsr  (ji,jj) = zqsr                                          ! solar heat flux 
+            qns  (ji,jj) = zqns - fdtcn(ji,jj) + zqhc                    ! non solar heat flux 
+            !
+            !                          !------------------------------------------!
+            !                          !  mass and salt flux at the ocean surface !
+            !                          !------------------------------------------!
+            !
+            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area)
+            !                                                  ! coupled mode: 
+            IF( ln_cpl ) THEN
+               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area)
+                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice
+            ELSE
+               !                                                  ! forced  mode: 
+               zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction 
+                  &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean
+                  &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld)
+            ENDIF
+            !
+            ! mass flux at the ocean/ice interface (sea ice fraction)
+            zemp_snw = rdm_snw(ji,jj) * r1_rdtice                    ! snow melting = pure water that enters the ocean
+            zfmm     = rdm_ice(ji,jj) * r1_rdtice                    ! Freezing minus Melting (F-M)
+
+            fmmflx(ji,jj) = zfmm                                     ! F/M mass flux save at least for biogeochemical model
+
+            ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s]
+            zfsalt = - sice_0(ji,jj) * zfmm                          ! F-M salt exchange
+            zcd    =   soce_0(ji,jj) * zfmm                          ! concentration/dilution term due to F-M
+            !
+            ! salt flux only       : add concentration dilution term in salt flux  and no  F-M term in volume flux
+            ! salt and mass fluxes : non concentration dilution term in salt flux  and add F-M term in volume flux
+            sfx (ji,jj) = zfsalt +                  zswitch  * zcd   ! salt flux (+ C/D if no ice/ocean mass exchange)
+            emp (ji,jj) = zemp   + zemp_snw + ( 1.- zswitch) * zfmm  ! mass flux (+ F/M mass flux if ice/ocean mass exchange)
+            !
+         END DO
+      END DO
+      !                                !------------------------------------------!
+      !                                !    mass of snow and ice per unit area    !
+      !                                !------------------------------------------!
+      IF( nn_ice_embd /= 0 ) THEN      ! embedded sea-ice (mass required)
+         snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step
+         !                                                      ! new mass per unit area
+         snwice_mass  (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:)  ) * ( 1.0 - frld(:,:) )
+         !                                                      ! time evolution of snow+ice mass
+         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice
+      ENDIF
+
+      IF( iom_use('hflx_ice_cea' ) )   CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )      
+      IF( iom_use('qns_io_cea'   ) )   CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )      
+      IF( iom_use('qsr_io_cea'   ) )   CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) )
+
+      IF( iom_use('isnwmlt_cea'  ) )   CALL iom_put( 'isnwmlt_cea'  ,                 rdm_snw(:,:) * r1_rdtice )
+      IF( iom_use('fsal_virt_cea') )   CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdm_ice(:,:) * r1_rdtice )
+      IF( iom_use('fsal_real_cea') )   CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice )
+
+      !-----------------------------------------------!
+      !   Coupling variables                          !
+      !-----------------------------------------------!
+
+      IF( ln_cpl) THEN
+         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature       
+         ht_i(:,:,1) = hicif(:,:)
+         ht_s(:,:,1) = hsnif(:,:)
+         a_i(:,:,1) = fr_i(:,:)
+         !                                  ! Computation of snow/ice and ocean albedo
+         CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb )
+         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys)
+         IF( iom_use('icealb_cea' ) )   CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo
+      ENDIF
+
+      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=sfx   , clinfo2=' sfx     : ')
+         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ')
+      ENDIF 
+      !
+      CALL wrk_dealloc( jpi, jpj, zqnsoce )
+      CALL wrk_dealloc( jpi, jpj, 1, zalb, zalbp )
+      !
+   END SUBROUTINE lim_sbc_flx_2
+
+
+   SUBROUTINE lim_sbc_tau_2( kt , pu_oce, pv_oce )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_sbc_tau_2 ***
+      !!  
+      !! ** 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 approximation...
+      !!
+      !! ** 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), POINTER, DIMENSION(:,:) ::   ztio_u, ztio_v   ! ocean stress below sea-ice
+      !!---------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, ztio_u, ztio_v )
+      !
+      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)
+            !
+            DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point
+               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
+            DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
+               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  ,jj  )    &   
+                     &               + 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)
+            !
+            DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point
+               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 )
+      !  
+      CALL wrk_dealloc( jpi, jpj, ztio_u, ztio_v )
+      !
+   END SUBROUTINE lim_sbc_tau_2
+
+
+   SUBROUTINE lim_sbc_init_2
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_sbc_init  ***
+      !!             
+      !! ** Purpose : Preparation of the file ice_evolu for the output of
+      !!      the temporal evolution of key variables
+      !!
+      !! ** input   : Namelist namicedia
+      !!-------------------------------------------------------------------
+      INTEGER ::   jk   ! local integer
+      !!-------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   '
+
+      !                                      ! allocate lim_sbc arrays
+      IF( lim_sbc_alloc_2() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_flx_2 : unable to allocate arrays' )
+      !
+      r1_rdtice = 1._wp / rdt_ice
+      !
+      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case
+      sice_0(:,:) = sice
+      !                                      ! 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
+      !                                      ! embedded sea ice
+      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
+         snwice_mass  (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:)  ) * ( 1.0 - frld(:,:) )
+         snwice_mass_b(:,:) = snwice_mass(:,:)
+      ELSE
+         snwice_mass  (:,:) = 0.e0           ! no mass exchanges
+         snwice_mass_b(:,:) = 0.e0           ! no mass exchanges
+         snwice_fmass (:,:) = 0.e0           ! no mass exchanges
+      ENDIF
+      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart : 
+         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh below sea-ice area
+         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
+         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+!!gm I really don't like this staff here...  Find a way to put that elsewhere or differently
+!!gm
+         IF( .NOT.ln_linssh ) THEN
+            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
+               e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+            END DO
+            e3t_a(:,:,:) = e3t_b(:,:,:)
+            ! Reconstruction of all vertical scale factors at now and before time steps
+            !        ! Horizontal scale factor interpolations
+            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+            !        ! Vertical scale factor interpolations
+            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+            !        ! t- and w- points depth
+            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+            gdepw_n(:,:,1) = 0.0_wp
+            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+            DO jk = 2, jpk
+               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
+               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+            END DO
+         ENDIF
+!!gm end
+      ENDIF
+      !
+   END SUBROUTINE lim_sbc_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module        NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+#endif 
+
+   !!======================================================================
+END MODULE limsbc_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90	(revision 8732)
@@ -0,0 +1,69 @@
+MODULE limtab_2
+   !!======================================================================
+   !!                       ***  MODULE limtab_2   ***
+   !!   LIM : transform 1D (2D) array to a 2D (1D) table
+   !!======================================================================
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   tab_2d_1d  : 2-D <==> 1-D
+   !!   tab_1d_2d  : 1-D <==> 2-D
+   !!----------------------------------------------------------------------
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tab_2d_1d_2   ! called by limthd
+   PUBLIC   tab_1d_2d_2   ! called by limthd
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tab_2d_1d_2 ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1D & 2D sizes
+      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in   ) ::   tab2d                        ! input 2D field
+      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index
+      REAL(wp), DIMENSION(ndim1d)           , INTENT(  out) ::   tab1d                        ! output 1D field
+      !
+      INTEGER ::   jn , jid, jjd
+      !!----------------------------------------------------------------------
+      DO jn = 1, ndim1d
+         jid        = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1
+         jjd        =    ( tab_ind(jn) - 1 ) / ndim2d_x + 1
+         tab1d( jn) = tab2d( jid, jjd)
+      END DO 
+   END SUBROUTINE tab_2d_1d_2
+
+
+   SUBROUTINE tab_1d_2d_2 ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes
+      REAL(wp), DIMENSION(ndim1d)           , INTENT(in   ) ::   tab1d                        ! input 1D field
+      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index
+      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(  out) ::   tab2d                        ! output 2D field
+      !
+      INTEGER ::   jn , jid, jjd
+      !!----------------------------------------------------------------------
+      DO jn = 1, ndim1d
+         jid             = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1
+         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1
+         tab2d(jid, jjd) = tab1d( jn)
+      END DO
+   END SUBROUTINE tab_1d_2d_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option        Dummy module             NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE limtab_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 8732)
@@ -0,0 +1,604 @@
+MODULE limthd_2
+   !!======================================================================
+   !!                  ***  MODULE limthd_2   ***
+   !!              LIM thermo ice model : ice thermodynamic
+   !!======================================================================
+   !! History :  1.0  ! 2000-01 (LIM)
+   !!            2.0  ! 2002-07 (C. Ethe, G. Madec) F90
+   !!            2.0  ! 2003-08 (C. Ethe)  add lim_thd_init
+   !!             -   ! 2008-2008  (A. Caubel, G. Madec, E. Maisonnave, S. Masson ) generic coupled interface
+   !!---------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd_2       : thermodynamic of sea ice
+   !!   lim_thd_init_2  : initialisation of sea-ice thermodynamic
+   !!----------------------------------------------------------------------
+   USE phycst           ! physical constants
+   USE dom_oce          ! ocean space and time domain variables
+   USE domvvl           ! ocean domain
+   USE ice_2            ! LIM sea-ice variables
+   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbc_ice          ! surface boundary condition: sea-ice
+   USE thd_ice_2        ! LIM thermodynamic sea-ice variables
+   USE dom_ice_2        ! LIM sea-ice domain
+   USE limthd_zdf_2     !
+   USE limthd_lac_2     !
+   USE limtab_2         !
+   !
+   USE in_out_manager   ! I/O manager
+   USE lbclnk           !
+   USE lib_mpp          !
+   USE wrk_nemo         ! work arrays
+   USE iom              ! IOM library
+   USE prtctl           ! Print control
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_2  ! called by lim_step
+
+   REAL(wp) ::   epsi20 = 1.e-20   ! constant values
+   REAL(wp) ::   epsi16 = 1.e-16   !
+   REAL(wp) ::   epsi04 = 1.e-04   !
+   REAL(wp) ::   rzero  = 0._wp    !
+   REAL(wp) ::   rone   = 1._wp    !
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!-------- -------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_2( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd_2  ***       
+      !!  
+      !! ** Purpose : This routine manages the ice thermodynamic.
+      !!         
+      !! ** Action : - Initialisation of some variables
+      !!             - Some preliminary computation (oceanic heat flux
+      !!               at the ice base, snow acc.,heat budget of the leads)
+      !!             - selection of the icy points and put them in an array
+      !!             - call lim_vert_ther for vert ice thermodynamic
+      !!             - back to the geographic grid
+      !!             - selection of points for lateral accretion
+      !!             - call lim_lat_acc  for the ice accretion
+      !!             - back to the geographic grid
+      !!
+      !! References :   Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      INTEGER  ::   nbpb                 ! nb of icy pts for thermo. cal.
+      INTEGER  ::   nbpac                ! nb of pts for lateral accretion 
+      CHARACTER (len=22) :: charout
+      REAL(wp) ::   zfric_umin = 5e-03   ! lower bound for the friction velocity
+      REAL(wp) ::   zfric_umax = 2e-02   ! upper bound for the friction velocity
+      REAL(wp) ::   zinda                ! switch for test. the val. of concen.
+      REAL(wp) ::   zindb, zindg         ! switches for test. the val of arg
+      REAL(wp) ::   zfricp               ! temporary scalar
+      REAL(wp) ::   za , zh, zthsnice    !
+      REAL(wp) ::   zfric_u              ! friction velocity 
+      REAL(wp) ::   zfntlat, zpareff     ! test. the val. of lead heat budget
+
+      REAL(wp) ::   zuice_m, zvice_m     ! Sea-ice velocities at U & V-points
+      REAL(wp) ::   zhice_u, zhice_v     ! Sea-ice volume at U & V-points
+      REAL(wp) ::   ztr_fram             ! Sea-ice transport through Fram strait
+      REAL(wp) ::   zrhoij, zrhoijm1     ! temporary scalars
+      REAL(wp) ::   zztmp                ! temporary scalars within a loop
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   ztmp      ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   zqlbsbq   ! link with lead energy budget qldif
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   zlicegr   ! link with lateral ice growth 
+!!$      REAL(wp), DIMENSION(:,:) ::   firic         ! IR flux over the ice            (outputs only)
+!!$      REAL(wp), DIMENSION(:,:) ::   fcsic         ! Sensible heat flux over the ice (outputs only)
+!!$      REAL(wp), DIMENSION(:,:) ::   fleic         ! Latent heat flux over the ice   (outputs only)
+!!$      REAL(wp), DIMENSION(:,:) ::   qlatic        ! latent flux                     (outputs only)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdvosif       ! Variation of volume at surface                (outputs only)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdvobif       ! Variation of ice volume at the bottom ice     (outputs only)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdvolif       ! Total variation of ice volume                 (outputs only)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdvonif       ! Surface accretion Snow to Ice transformation  (outputs only)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdvomif       ! Bottom variation of ice volume due to melting (outputs only)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_imasstr    ! Sea-ice transport along i-axis at U-point     (outputs only) 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_imasstr    ! Sea-ice transport along j-axis at V-point     (outputs only) 
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmsk        ! 3D workspace
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, ztmp, zqlbsbq, zlicegr, zdvosif, zdvobif, zdvolif, zdvonif, zdvomif, zu_imasstr, zv_imasstr )
+      CALL wrk_alloc( jpi, jpj, jpk, zmsk )
+
+      IF( kt == nit000 )   CALL lim_thd_init_2   ! Initialization (first time-step only)
+   
+      !-------------------------------------------!
+      !   Initilization of diagnostic variables   !
+      !-------------------------------------------!
+      
+!!gm needed?  yes at least for some of these arrays 
+      zdvosif(:,:) = 0.e0   ! variation of ice volume at surface
+      zdvobif(:,:) = 0.e0   ! variation of ice volume at bottom
+      zdvolif(:,:) = 0.e0   ! total variation of ice volume
+      zdvonif(:,:) = 0.e0   ! transformation of snow to sea-ice volume
+      zlicegr(:,:) = 0.e0   ! lateral variation of ice volume
+      zdvomif(:,:) = 0.e0   ! variation of ice volume at bottom due to melting only
+      ztr_fram     = 0.e0   ! sea-ice transport through Fram strait
+      fstric (:,:) = 0.e0   ! part of solar radiation absorbing inside the ice
+      fscmbq (:,:) = 0.e0   ! linked with fstric
+      ffltbif(:,:) = 0.e0   ! linked with fstric
+      qfvbq  (:,:) = 0.e0   ! linked with fstric
+      rdm_snw(:,:) = 0.e0   ! variation of snow mass over 1 time step
+      rdq_snw(:,:) = 0.e0   ! heat content associated with rdm_snw
+      rdm_ice(:,:) = 0.e0   ! variation of ice mass over 1 time step
+      rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice
+      zmsk (:,:,:) = 0.e0
+
+      ! set to zero snow thickness smaller than epsi04
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            hsnif(ji,jj)  = hsnif(ji,jj) *  MAX( rzero, SIGN( rone , hsnif(ji,jj) - epsi04 ) )
+         END DO
+      END DO
+!!gm better coded (do not use SIGN...)
+!     WHERE( hsnif(:,:) < epsi04 )   hsnif(:,:) = 0.e0
+!!gm
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=hsnif, clinfo1=' lim_thd: hsnif   : ' )
+      
+      !-----------------------------------!
+      !   Treatment of particular cases   !
+      !-----------------------------------!
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !  snow is transformed into ice if the original ice cover disappears.
+            zindg         = tms(ji,jj) *  MAX( rzero , SIGN( rone , -hicif(ji,jj) ) )
+            hicif(ji,jj)  = hicif(ji,jj) + zindg * rhosn * hsnif(ji,jj) / rau0
+            hsnif(ji,jj)  = ( rone - zindg ) * hsnif(ji,jj) + zindg * hicif(ji,jj) * ( rau0 - rhoic ) / rhosn
+            dmgwi(ji,jj)  = zindg * (1.0 - frld(ji,jj)) * rhoic * hicif(ji,jj)   ! snow/ice mass
+            
+            !  the lead fraction, frld, must be little than or equal to amax (ice ridging).
+            zthsnice      = hsnif(ji,jj) + hicif(ji,jj)
+            zindb         = tms(ji,jj) * ( 1.0 - MAX( rzero , SIGN( rone , - zthsnice ) ) ) 
+            za            = zindb * MIN( rone, ( 1.0 - frld(ji,jj) ) * uscomi )
+            hsnif (ji,jj) = hsnif(ji,jj)  * za
+            hicif (ji,jj) = hicif(ji,jj)  * za
+            qstoif(ji,jj) = qstoif(ji,jj) * za
+            frld  (ji,jj) = 1.0 - zindb * ( 1.0 - frld(ji,jj) ) / MAX( za, epsi20 )
+            
+            !  the in situ ice thickness, hicif, must be equal to or greater than hiclim.
+            zh            = MAX( rone , zindb * hiclim  / MAX( hicif(ji,jj), epsi20 ) )
+            hsnif (ji,jj) = hsnif(ji,jj)  * zh
+            hicif (ji,jj) = hicif(ji,jj)  * zh
+            qstoif(ji,jj) = qstoif(ji,jj) * zh
+            frld  (ji,jj) = ( frld(ji,jj) + ( zh - 1.0 ) ) / zh
+         END DO
+      END DO
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab2d_1=hicif , clinfo1=' lim_thd: hicif   : ' )
+         CALL prt_ctl( tab2d_1=hsnif , clinfo1=' lim_thd: hsnif   : ' )
+         CALL prt_ctl( tab2d_1=dmgwi , clinfo1=' lim_thd: dmgwi   : ' )
+         CALL prt_ctl( tab2d_1=qstoif, clinfo1=' lim_thd: qstoif  : ' )
+         CALL prt_ctl( tab2d_1=frld  , clinfo1=' lim_thd: frld    : ' )
+      ENDIF
+
+      
+      !-------------------------------!
+      !   Thermodynamics of sea ice   !
+      !-------------------------------!
+      
+      !      Partial computation of forcing for the thermodynamic sea ice model.
+      !--------------------------------------------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zthsnice       = hsnif(ji,jj) + hicif(ji,jj)
+            zindb          = tms(ji,jj) * ( 1.0 - MAX( rzero , SIGN( rone , - zthsnice ) ) ) 
+            pfrld(ji,jj)   = frld(ji,jj)
+            zfricp         = 1.0 - frld(ji,jj)
+            zinda          = 1.0 - MAX( rzero , SIGN( rone , - zfricp ) )
+            
+            !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+            thcm(ji,jj)    = 0.e0 
+            
+            !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+            !  temperature and turbulent mixing (McPhee, 1992)
+            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  ! friction velocity
+            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_m(ji,jj) + rt0 - tfu(ji,jj) ) 
+            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice
+                        
+            !  partial computation of the lead energy budget (qldif)
+            IF( ln_cpl ) THEN 
+               qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  &
+                  &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   &
+                  &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           &
+                  &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   )
+            ELSE
+               qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    &
+                  &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    &
+                  &                           + qns(ji,jj)  +  fdtcn(ji,jj)           &
+                  &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      )
+            ENDIF
+            !  parlat : percentage of energy used for lateral ablation (0.0) 
+            zfntlat        = 1.0 - MAX( rzero , SIGN( rone ,  - qldif(ji,jj) ) )
+            zpareff        = 1.0 + ( parlat - 1.0 ) * zinda * zfntlat
+            zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / MAX( (1.0 - frld(ji,jj)) * rdt_ice , epsi16 )
+            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  (ji,jj) =  rau0 * rcp * e3t_m(ji,jj) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda )
+            
+            !  calculate oceanic heat flux.
+            fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( (1.0 - frld(ji,jj)) , epsi20 ) + fdtcn(ji,jj) )
+            
+            ! computation of the thermodynamic ice production (only needed for output)
+            hicifp(ji,jj) = hicif(ji,jj) * ( 1.0 - frld(ji,jj) )
+         END DO
+      END DO
+      
+      !         Select icy points and fulfill arrays for the vectorial grid.
+      !----------------------------------------------------------------------
+      nbpb = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( frld(ji,jj) < 1.0 ) THEN     
+               nbpb      = nbpb + 1
+               npb(nbpb) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=pfrld, clinfo1=' lim_thd: pfrld   : ', tab2d_2=thcm   , clinfo2='  thcm    : ')
+         CALL prt_ctl(tab2d_1=fdtcn, clinfo1=' lim_thd: fdtcn   : ', tab2d_2=qdtcn  , clinfo2='  qdtcn   : ')
+         CALL prt_ctl(tab2d_1=qldif, clinfo1=' lim_thd: qldif   : ', tab2d_2=zqlbsbq, clinfo2='  zqlbsbq : ')
+         CALL prt_ctl(tab2d_1=qcmif, clinfo1=' lim_thd: qcmif   : ', tab2d_2=fbif   , clinfo2='  fbif    : ')
+         zmsk(:,:,1) = tms(:,:)
+         CALL prt_ctl(tab2d_1=qcmif , clinfo1=' lim_thd: qcmif  : ', mask1=zmsk)
+         CALL prt_ctl(tab2d_1=hicifp, clinfo1=' lim_thd: hicifp : ')
+         WRITE(charout, FMT="('lim_thd: nbpb = ',I4)") nbpb
+         CALL prt_ctl_info(charout)
+      ENDIF
+      
+      
+      ! If there is no ice, do nothing. Otherwise, compute Top and Bottom accretion/ablation 
+      !------------------------------------------------------------------------------------ 
+
+      IF( nbpb > 0 ) THEN
+         !    
+         !  put the variable in a 1-D array for thermodynamics process
+         CALL tab_2d_1d_2( nbpb, frld_1d    (1:nbpb)     , frld           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, h_ice_1d   (1:nbpb)     , hicif          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, h_snow_1d  (1:nbpb)     , hsnif          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, sist_1d    (1:nbpb)     , sist           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 1 ), tbif(:,:,1)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 2 ), tbif(:,:,2)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, tbif_1d    (1:nbpb , 3 ), tbif(:,:,3)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb)     , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb,  qns_ice_1d(1:nbpb)     ,  qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
+         IF( .NOT. ln_cpl ) THEN 
+            CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     ,  qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
+         ENDIF
+         CALL tab_2d_1d_2( nbpb, tfu_1d     (1:nbpb)     , tfu        , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, sprecip_1d (1:nbpb)     , sprecip    , jpi, jpj, npb(1:nbpb) ) 
+         CALL tab_2d_1d_2( nbpb, fbif_1d    (1:nbpb)     , fbif       , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, thcm_1d    (1:nbpb)     , thcm       , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, qldif_1d   (1:nbpb)     , qldif      , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, qstbif_1d  (1:nbpb)     , qstoif     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdm_ice_1d (1:nbpb)     , rdm_ice    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdq_ice_1d (1:nbpb)     , rdq_ice    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, dmgwi_1d   (1:nbpb)     , dmgwi      , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdm_snw_1d (1:nbpb)     , rdm_snw    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, rdq_snw_1d (1:nbpb)     , rdq_snw    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d_2( nbpb, qlbbq_1d   (1:nbpb)     , zqlbsbq    , jpi, jpj, npb(1:nbpb) )
+         !
+         CALL lim_thd_zdf_2( 1, nbpb )       !  compute ice growth
+         !
+         !  back to the geographic grid.
+         CALL tab_1d_2d_2( nbpb, frld       , npb, frld_1d   (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, hicif      , npb, h_ice_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, hsnif      , npb, h_snow_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, sist       , npb, sist_1d   (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, tbif(:,:,1), npb, tbif_1d   (1:nbpb , 1 ), jpi, jpj )   
+         CALL tab_1d_2d_2( nbpb, tbif(:,:,2), npb, tbif_1d   (1:nbpb , 2 ), jpi, jpj )   
+         CALL tab_1d_2d_2( nbpb, tbif(:,:,3), npb, tbif_1d   (1:nbpb , 3 ), jpi, jpj )   
+         CALL tab_1d_2d_2( nbpb, fscmbq     , npb, fscbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, ffltbif    , npb, fltbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, fstric     , npb, fstbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, qldif      , npb, qldif_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, qfvbq      , npb, qfvbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, qstoif     , npb, qstbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdm_ice    , npb, rdm_ice_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdq_ice    , npb, rdq_ice_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, dmgwi      , npb, dmgwi_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdm_snw    , npb, rdm_snw_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, rdq_snw    , npb, rdq_snw_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, zdvosif    , npb, dvsbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, zdvobif    , npb, dvbbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, zdvomif    , npb, rdvomif_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, zdvolif    , npb, dvlbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, zdvonif    , npb, dvnbq_1d  (1:nbpb)     , jpi, jpj ) 
+         CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb)  , jpi, jpj )
+         CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb)  , jpi, jpj )
+         IF( .NOT. ln_cpl )   CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj )
+         !
+      ENDIF
+
+      ! Up-date sea ice thickness
+      !--------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            phicif(ji,jj) = hicif(ji,jj)  
+            hicif(ji,jj)  = hicif(ji,jj) *  ( rone -  MAX( rzero, SIGN( rone, - ( 1.0 - frld(ji,jj) ) ) ) )
+         END DO
+      END DO
+
+      
+      ! Tricky trick : add 2 to frld in the Southern Hemisphere
+      !--------------------------------------------------------
+      IF( ff_t(1,1) < 0._wp ) THEN
+         DO jj = 1, njeqm1
+            DO ji = 1, jpi
+               frld(ji,jj) = frld(ji,jj) + 2.0
+            END DO
+         END DO
+      ENDIF
+
+      CALL lbc_lnk( frld , 'T', 1. )      
+      
+      ! Select points for lateral accretion (this occurs when heat exchange
+      ! between ice and ocean is negative; ocean losing heat) 
+      !-----------------------------------------------------------------
+      nbpac = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+!i yes!     IF ( ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN
+            IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN
+               nbpac = nbpac + 1
+               npac( nbpac ) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+      
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=phicif, clinfo1=' lim_thd: phicif  : ', tab2d_2=hicif, clinfo2=' hicif : ')
+         WRITE(charout, FMT="('lim_thd: nbpac = ',I4)") nbpac
+         CALL prt_ctl_info(charout)
+      ENDIF
+
+
+      ! If ocean gains heat do nothing ; otherwise, one performs lateral accretion
+      !--------------------------------------------------------------------------------
+      IF( nbpac > 0 ) THEN
+         !
+         zlicegr(:,:) = rdm_ice(:,:)		! to output the lateral sea-ice growth 
+         !...Put the variable in a 1-D array for lateral accretion
+         CALL tab_2d_1d_2( nbpac, frld_1d   (1:nbpac)     , frld       , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, h_snow_1d (1:nbpac)     , hsnif      , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, h_ice_1d  (1:nbpac)     , hicif      , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, tbif_1d   (1:nbpac , 1 ), tbif(:,:,1), jpi, jpj, npac(1:nbpac) )   
+         CALL tab_2d_1d_2( nbpac, tbif_1d   (1:nbpac , 2 ), tbif(:,:,2), jpi, jpj, npac(1:nbpac) )   
+         CALL tab_2d_1d_2( nbpac, tbif_1d   (1:nbpac , 3 ), tbif(:,:,3), jpi, jpj, npac(1:nbpac) )   
+         CALL tab_2d_1d_2( nbpac, qldif_1d  (1:nbpac)     , qldif      , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, qcmif_1d  (1:nbpac)     , qcmif      , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac)     , qstoif     , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice    , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, rdq_ice_1d(1:nbpac)     , rdq_ice    , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, dvlbq_1d  (1:nbpac)     , zdvolif    , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d_2( nbpac, tfu_1d    (1:nbpac)     , tfu        , jpi, jpj, npac(1:nbpac) )
+         !
+         CALL lim_thd_lac_2( 1 , nbpac )         ! lateral accretion routine.
+         !
+         !   back to the geographic grid
+         CALL tab_1d_2d_2( nbpac, frld       , npac(1:nbpac), frld_1d   (1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, hsnif      , npac(1:nbpac), h_snow_1d (1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, hicif      , npac(1:nbpac), h_ice_1d  (1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, tbif(:,:,1), npac(1:nbpac), tbif_1d   (1:nbpac , 1 ), jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, tbif(:,:,2), npac(1:nbpac), tbif_1d   (1:nbpac , 2 ), jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d   (1:nbpac , 3 ), jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, qstoif     , npac(1:nbpac), qstbif_1d (1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, rdm_ice    , npac(1:nbpac), rdm_ice_1d(1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, rdq_ice    , npac(1:nbpac), rdq_ice_1d(1:nbpac)     , jpi, jpj )
+         CALL tab_1d_2d_2( nbpac, zdvolif    , npac(1:nbpac), dvlbq_1d  (1:nbpac)     , jpi, jpj )
+         !
+      ENDIF
+       
+       
+      ! Recover frld values between 0 and 1 in the Southern Hemisphere (tricky trick)
+      ! Update daily thermodynamic ice production.    
+      !------------------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            frld  (ji,jj) = MIN( frld(ji,jj), ABS( frld(ji,jj) - 2.0 ) )
+            fr_i  (ji,jj) = 1.0 - frld(ji,jj)  
+            hicifp(ji,jj) = hicif(ji,jj) * fr_i(ji,jj) - hicifp(ji,jj)
+         END DO
+      END DO
+
+      ! Outputs
+      !--------------------------------------------------------------------------------
+      ztmp(:,:) = 1. - pfrld(:,:)                                ! fraction of ice after the dynamic, before the thermodynamic
+      IF( iom_use('ist_cea'    ) )   CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) )   ! Ice surface temperature   [Celius]
+      IF( iom_use('qsr_ai_cea' ) )   CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice     [W/m2]
+      IF( iom_use('qns_ai_cea' ) )   CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice [W/m2]
+      IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) &
+         &                           CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )   ! Latent flux over the ice [W/m2]
+      !
+      IF( iom_use('snowthic_cea'))   CALL iom_put( 'snowthic_cea', hsnif  (:,:) * fr_i(:,:) )   ! Snow thickness           [m]
+      IF( iom_use('icethic_cea' ))   CALL iom_put( 'icethic_cea' , hicif  (:,:) * fr_i(:,:) )   ! Ice thickness            [m]
+      zztmp = 1.0 / rdt_ice
+      IF( iom_use('iceprod_cea') )   CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced             [m/s]
+      IF( iom_use('iiceconc'   ) )   CALL iom_put( 'iiceconc'    , fr_i(:,:)                )   ! Ice concentration        [-]
+      IF( iom_use('snowmel_cea') )   CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                [kg/m2/s]
+      zztmp = rhoic / rdt_ice
+      IF( iom_use('sntoice_cea') )   CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp     ) ! Snow to Ice transformation [kg/m2/s]
+      IF( iom_use('ticemel_cea') )   CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp     )   ! Melt at Sea Ice top      [kg/m2/s]
+      IF( iom_use('bicemel_cea') )   CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp     )   ! Melt at Sea Ice bottom   [kg/m2/s]
+      IF( iom_use('licepro_cea') ) THEN
+         zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) )
+                                     CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Lateral sea ice growth   [kg/m2/s]
+      ENDIF
+      !
+      ! Compute the Eastward & Northward sea-ice transport
+      IF( iom_use('u_imasstr') ) THEN
+         zztmp = 0.25 * rhoic
+         DO jj = 1, jpjm1 
+            DO ji = 1, jpim1   ! NO vector opt.
+               ! Ice velocities, volume & transport at U-points
+               zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj )
+               zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj  )*e2t(ji+1,jj  )*fr_i(ji+1,jj  )
+               zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 
+            END DO
+         END DO
+         CALL lbc_lnk( zu_imasstr, 'U', -1. )
+         CALL iom_put( 'u_imasstr',  zu_imasstr(:,:) )   ! Ice transport along i-axis at U-point [kg/s] 
+      ENDIF
+      IF( iom_use('v_imasstr') ) THEN
+         zztmp = 0.25 * rhoic
+         DO jj = 1, jpjm1 
+            DO ji = 1, jpim1   ! NO vector opt.
+               ! Ice velocities, volume & transport at V-points
+               zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1)
+               zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji  ,jj+1)*e1t(ji  ,jj+1)*fr_i(ji  ,jj+1)
+               zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 
+            END DO
+         END DO
+         CALL lbc_lnk( zv_imasstr, 'V', -1. )
+         CALL iom_put( 'v_imasstr',  zv_imasstr(:,:) )   ! Ice transport along j-axis at V-point [kg/s]
+      ENDIF
+
+      !! Fram Strait sea-ice transport (sea-ice + snow)  (in ORCA2 = 5 points)
+      IF( iom_use('fram_trans') .and. cn_cfg == "orca" .AND. nn_cfg == 2 ) THEN    ! ORCA R2 configuration
+         DO jj = mj0(137), mj1(137) ! B grid
+            IF( mj0(jj-1) >= nldj ) THEN
+               DO ji = MAX(mi0(134),nldi), MIN(mi1(138),nlei)
+                  zrhoij    = e1t(ji,jj  ) * fr_i(ji,jj  ) * ( rhoic*hicif(ji,jj  ) + rhosn*hsnif(ji,jj  ) ) 
+                  zrhoijm1  = e1t(ji,jj-1) * fr_i(ji,jj-1) * ( rhoic*hicif(ji,jj-1) + rhosn*hsnif(ji,jj-1) ) 
+                  ztr_fram  = ztr_fram - 0.25 * ( v_ice(ji,jj)+ v_ice(ji+1,jj) ) * ( zrhoij + zrhoijm1 )
+               END DO
+            ENDIF
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztr_fram )
+         CALL iom_put( 'fram_trans', ztr_fram )   ! Ice transport through Fram strait     [kg/s] 
+      ENDIF
+
+      IF( iom_use('ice_pres') .OR. iom_use('ist_ipa') .OR. iom_use('uice_ipa') .OR. iom_use('vice_ipa') ) THEN
+!! ce     ztmp(:,:) = 1. - AINT( frld(:,:), wp )                        ! return 1 as soon as there is ice
+!! ce     A big warning because the model crashes on IDRIS/IBM SP6 with xlf 13.1.0.3, see ticket #761
+!! ce     We Unroll the loop and everything works fine      
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp )                ! return 1 as soon as there is ice
+            END DO
+         END DO
+         !
+         IF( iom_use('ice_pres') ) CALL iom_put( 'ice_pres', ztmp                            )   ! Ice presence                 [-]
+         IF( iom_use('ist_ipa' ) ) CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) )   ! Ice surface temperature [Celius]
+         IF( iom_use('uice_ipa') ) CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point  [m/s] 
+         IF( iom_use('vice_ipa') ) CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point  [m/s]
+      ENDIF
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl_info(' lim_thd  end  ')
+         CALL prt_ctl( tab2d_1=hicif      , clinfo1=' lim_thd: hicif   : ', tab2d_2=hsnif , clinfo2=' hsnif  : ' )
+         CALL prt_ctl( tab2d_1=frld       , clinfo1=' lim_thd: frld    : ', tab2d_2=hicifp, clinfo2=' hicifp : ' )
+         CALL prt_ctl( tab2d_1=phicif     , clinfo1=' lim_thd: phicif  : ', tab2d_2=pfrld , clinfo2=' pfrld  : ' )
+         CALL prt_ctl( tab2d_1=sist       , clinfo1=' lim_thd: sist    : ' )
+         CALL prt_ctl( tab2d_1=tbif(:,:,1), clinfo1=' lim_thd: tbif 1  : ' )
+         CALL prt_ctl( tab2d_1=tbif(:,:,2), clinfo1=' lim_thd: tbif 2  : ' )
+         CALL prt_ctl( tab2d_1=tbif(:,:,3), clinfo1=' lim_thd: tbif 3  : ' )
+         CALL prt_ctl( tab2d_1=fdtcn      , clinfo1=' lim_thd: fdtcn   : ', tab2d_2=qdtcn , clinfo2=' qdtcn  : ' )
+         CALL prt_ctl( tab2d_1=qstoif     , clinfo1=' lim_thd: qstoif  : ', tab2d_2=fsbbq , clinfo2=' fsbbq  : ' )
+      ENDIF
+       !
+      CALL wrk_dealloc( jpi, jpj, ztmp, zqlbsbq, zlicegr, zdvosif, zdvobif, zdvolif, zdvonif, zdvomif, zu_imasstr, zv_imasstr )
+      CALL wrk_dealloc( jpi, jpj, jpk, zmsk )
+      !
+    END SUBROUTINE lim_thd_2
+
+
+    SUBROUTINE lim_thd_init_2
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_init_2 *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters linked to the ice 
+      !!      thermodynamics
+      !!
+      !! ** Method  :   Read the namicethd namelist and check the ice-thermo
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicether
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax  ,        &
+         &                swiqst, sbeta  , parlat, hakspl, hibspl, exld,  &
+         &                hakdif, hnzst  , thth  , parsub, alphs
+      !!-------------------------------------------------------------------
+                    
+      REWIND( numnam_ice_ref )              ! Namelist namicethd in reference namelist : Ice thermodynamics
+      READ  ( numnam_ice_ref, namicethd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicethd in configuration namelist : Ice thermodynamics
+      READ  ( numnam_ice_cfg, namicethd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicethd )
+
+      IF( ln_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'lim_thd_init_2: ice parameters for ice thermodynamic computation '
+         WRITE(numout,*)'~~~~~~~~~~~~~~'
+         WRITE(numout,*)'       maximum melting at the bottom                           hmelt        = ', hmelt
+         WRITE(numout,*)'       ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit
+         WRITE(numout,*)'       ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin  
+         WRITE(numout,*)'       minimum ice thickness                                   hiclim       = ', hiclim 
+         WRITE(numout,*)'       maximum lead fraction                                   amax         = ', amax 
+         WRITE(numout,*)'       energy stored in brine pocket (=1) or not (=0)          swiqst       = ', swiqst 
+         WRITE(numout,*)'       numerical carac. of the scheme for diffusion in ice '
+         WRITE(numout,*)'       Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta
+         WRITE(numout,*)'       percentage of energy used for lateral ablation          parlat       = ', parlat
+         WRITE(numout,*)'       slope of distr. for Hakkinen-Mellor lateral melting     hakspl       = ', hakspl  
+         WRITE(numout,*)'       slope of distribution for Hibler lateral melting        hibspl       = ', hibspl
+         WRITE(numout,*)'       exponent for leads-closure rate                         exld         = ', exld
+         WRITE(numout,*)'       coefficient for diffusions of ice and snow              hakdif       = ', hakdif
+         WRITE(numout,*)'       threshold thick. for comp. of eq. thermal conductivity  zhth         = ', thth 
+         WRITE(numout,*)'       thickness of the surf. layer in temp. computation       hnzst        = ', hnzst
+         WRITE(numout,*)'       switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub  
+         WRITE(numout,*)'       coefficient for snow density when snow ice formation    alphs        = ', alphs
+      ENDIF
+      !          
+      uscomi = 1.0 / ( 1.0 - amax )   ! inverse of minimum lead fraction
+      rcdsn = hakdif * rcdsn 
+      rcdic = hakdif * rcdic
+      !
+      IF( hsndif > 100.e0 .OR. hicdif > 100.e0 ) THEN
+         cnscg = 0.e0
+      ELSE
+         cnscg = rcpsn / rcpic   ! ratio  rcpsn/rcpic
+      ENDIF
+      !
+   END SUBROUTINE lim_thd_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module       NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_2         ! Dummy routine
+   END SUBROUTINE lim_thd_2
+#endif
+
+   !!======================================================================
+END MODULE limthd_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 8732)
@@ -0,0 +1,236 @@
+MODULE limthd_lac_2
+#if defined key_lim2
+   !!======================================================================
+   !!                       ***  MODULE limthd_lac_2   ***
+   !!                lateral thermodynamic growth of the ice 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_lat_acr_2 : lateral accretion of ice
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE phycst
+   USE thd_ice_2
+   USE ice_2
+   USE limistate_2 
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_lac_2   ! called by lim_thd_2
+
+   REAL(wp)  ::           &  ! constant values
+      epsi20 = 1.e-20  ,  &
+      epsi13 = 1.e-13  ,  &
+      zzero  = 0.e0    ,  &
+      zone   = 1.e0
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+    
+   SUBROUTINE lim_thd_lac_2( kideb, kiut )
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE lim_thd_lac_2  ***
+      !!  
+      !! ** Purpose : Computation of the evolution of the ice thickness and 
+      !!      concentration as a function of the heat balance in the leads.
+      !!      It is only used for lateral accretion
+      !!       
+      !! ** Method  : Ice is formed in the open water when ocean lose heat
+      !!      (heat budget of open water Bl is negative) .
+      !!      Computation of the increase of 1-A (ice concentration) fol-
+      !!      lowing the law :
+      !!      (dA/dt)acc = F[ (1-A)/(1-a) ] * [ Bl / (Li*h0) ]
+      !!       where - h0 is the thickness of ice created in the lead
+      !!             - a is a minimum fraction for leads
+      !!             - F is a monotonic non-increasing function defined as:
+      !!                  F(X)=( 1 - X**exld )**(1.0/exld)
+      !!             - exld is the exponent closure rate (=2 default val.)
+      !! 
+      !! ** Action : - Adjustment of snow and ice thicknesses and heat
+      !!                content in brine pockets
+      !!             - Updating ice internal temperature
+      !!             - Computation of variation of ice volume and mass
+      !!             - Computation of frldb after lateral accretion and 
+      !!               update h_snow_1d, h_ice_1d and tbif_1d(:,:)      
+      !! 
+      !! ** References :
+      !!      M. Maqueda, 1995, PhD Thesis, Univesidad Complutense Madrid
+      !!      Fichefet T. and M. Maqueda 1997, J. Geo. Res., 102(C6), 
+      !!                                                12609 -12646   
+      !! History :
+      !!   1.0  !  01-04 (LIM)  original code
+      !!   2.0  !  02-08 (C. Ethe, G. Madec)  F90, mpp
+      !!-------------------------------------------------------------------
+      INTEGER , INTENT(IN)::  &
+         kideb          ,   &  ! start point on which the the computation is applied
+         kiut                  ! end point on which the the computation is applied
+
+      ! * Local variables
+      INTEGER ::            &
+         ji             ,   &  !  dummy loop indices
+         iicefr         ,   &  !  1 = existing ice ; 0 = no ice
+         iiceform       ,   &  !  1 = ice formed   ; 0 = no ice formed
+         ihemis                !  dummy indice
+      REAL(wp), POINTER, DIMENSION(:) ::   zqbgow      !  heat budget of the open water (negative)
+      REAL(wp), POINTER, DIMENSION(:) ::   zfrl_old    !  previous sea/ice fraction
+      REAL(wp), POINTER, DIMENSION(:) ::   zhice_old   !  previous ice thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zhice0      !  thickness of newly formed ice in leads
+      REAL(wp), POINTER, DIMENSION(:) ::   zfrlmin     !  minimum fraction for leads
+      REAL(wp), POINTER, DIMENSION(:) ::   zdhicbot    !  part of thickness of newly formed ice in leads which 
+                                !  has been already used in transport for example
+      REAL(wp)  ::  &
+         zhemis           ,  &  !  hemisphere (0 = North, 1 = South)
+         zhicenew         ,  &  !  new ice thickness
+         zholds2          ,  &  !  ratio of previous ice thickness and 2 
+         zhnews2          ,  &  !  ratio of new ice thickness and 2 
+         zfrlnew          ,  &  !  new sea/ice fraction
+         zfrld            ,  &  !  ratio of sea/ice fraction and minimum fraction for leads
+         zfrrate          ,  &  !  leads-closure rate
+         zdfrl                  !  sea-ice fraction increment
+      REAL(wp)  ::  &
+         zdh1 , zdh2 , zdh3 , zdh4, zdh5   , &   ! tempory scalars
+         ztint , zta1 , zta2 , zta3 , zta4 , &
+         zah, zalpha , zbeta
+      !!---------------------------------------------------------------------      
+               
+      CALL wrk_alloc( jpij, zqbgow, zfrl_old, zhice_old, zhice0, zfrlmin, zdhicbot )
+      
+      !--------------------------------------------------------------
+      !   Computation of the heat budget of the open water (negative)
+      !--------------------------------------------------------------
+      
+      DO ji = kideb , kiut      
+         zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)
+      END DO
+      
+      !-----------------------------------------------------------------
+      !   Taking the appropriate values for the corresponding hemisphere
+      !-----------------------------------------------------------------
+      DO ji = kideb , kiut
+         zhemis       = MAX( zzero , SIGN( zone , frld_1d(ji) - 2.0 ) ) 
+         ihemis       = INT( 1 + zhemis )
+         zhice0  (ji) = hiccrit( ihemis ) 
+         zfrlmin (ji) = acrit  ( ihemis )   
+         frld_1d (ji) = frld_1d(ji) - 2.0 * zhemis
+         zfrl_old(ji) = frld_1d(ji)
+      END DO
+      
+      !-------------------------------------------------------------------
+      !     Lateral Accretion (modification of the fraction of open water)
+      !     The ice formed in the leads has always a thickness zhice0, but
+      !     only a fraction zfrrate of the ice formed contributes to the 
+      !     increase of the ice fraction. The remaining part (1-zfrrate)
+      !     is rather assumed to lead to an increase in the thickness of the
+      !     pre-existing ice (transport for example). 
+      !     Morales Maqueda, 1995 - Fichefet and Morales Maqueda, 1997
+      !---------------------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
+         !---computation of the leads-closure rate
+         zfrld        = MIN( zone , ( 1.0 - frld_1d(ji) ) / ( 1.0 - zfrlmin(ji) ) )
+         zfrrate      = ( 1.0 - zfrld**exld )**( 1.0 / exld )
+         !--computation of the sea-ice fraction increment and the new fraction 
+         zdfrl        = ( zfrrate / zhice0(ji) )  * ( zqbgow(ji) / xlic )
+         zfrlnew      = zfrl_old(ji) + zdfrl
+         !--update the sea-ice fraction 
+         frld_1d   (ji) = MAX( zfrlnew , zfrlmin(ji) )
+         !--computation of the remaining part of ice thickness which has been already used
+         zdhicbot(ji) =  ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) )   & 
+            &         -  (  ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) )  * ( zqbgow(ji) / xlic ) 
+      END DO
+ 
+      !----------------------------------------------------------------------------------------
+      !      Ajustement of snow and ice thicknesses and updating the total heat stored in brine pockets  
+      !      The thickness of newly formed ice is averaged with that of the pre-existing
+      !         (1-Anew) * hinew = (1-Aold) * hiold + ((1-Anew)-(1-Aold)) * h0
+      !      Snow is distributed over the new ice-covered area 
+      !         (1-Anew) * hsnew = (1-Aold) * hsold            
+      !--------------------------------------------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
+         zhice_old(ji) = h_ice_1d(ji)
+         zhicenew      = iicefr * zhice_old(ji) + ( 1 - iicefr ) * zhice0(ji)
+         zalpha        = ( 1. - zfrl_old(ji) ) / ( 1.- frld_1d(ji) )
+         h_snow_1d(ji) = zalpha * h_snow_1d(ji)
+         h_ice_1d (ji) = zalpha * zhicenew + ( 1.0 - zalpha ) * zhice0(ji)
+         qstbif_1d(ji) = zalpha * qstbif_1d(ji) 
+      END DO
+      
+      !-------------------------------------------------------
+      !   Ajustement of ice internal temperatures
+      !-------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         iicefr      = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
+         iiceform    = 1 - MAX( 0 ,INT( SIGN( 1.5 * zone , zhice0(ji) - h_ice_1d(ji) ) ) )
+         zholds2     = zhice_old(ji)/ 2.
+         zhnews2     = h_ice_1d(ji) / 2.
+         zdh1        = MAX( zzero ,  zhice_old(ji)   - zhnews2 )
+         zdh2        = MAX( zzero , -zhice_old(ji)   + zhnews2 )
+         zdh3        = MAX( zzero ,  h_ice_1d(ji) - zholds2 )
+         zdh4        = MAX( zzero , -h_ice_1d(ji) + zholds2 )
+         zdh5        = MAX( zzero , zhice0(ji)      - zholds2 )
+         ztint       =       iiceform   * (  ( zholds2 - zdh3 ) * tbif_1d(ji,3) + zdh4 * tbif_1d(ji,2) )      &
+            &                           / MAX( epsi20 , h_ice_1d(ji) - zhice0(ji) )                           &
+            &                 + ( 1 - iiceform ) * tfu_1d(ji)
+         zta1        = iicefr * ( 1.  - zfrl_old(ji) ) * tbif_1d(ji,2) 
+         zta2        = iicefr * ( 1.  - zfrl_old(ji) ) * tbif_1d(ji,3)
+         zta3        = iicefr * ( 1.  - zfrl_old(ji) ) * ztint
+         zta4        = ( zfrl_old(ji) - frld_1d   (ji) ) * tfu_1d(ji)
+         zah         = ( 1. - frld_1d(ji) ) * zhnews2 
+
+         tbif_1d(ji,2) = (  MIN( zhnews2 , zholds2 )                                              * zta1   &
+            &          + ( 1 - iiceform ) * ( zholds2 - zdh1 )                                    * zta2   &
+            &          + ( iiceform * ( zhnews2 - zhice0(ji) + zdh5 ) + ( 1 - iiceform ) * zdh2 ) * zta3   & 
+            &          + MIN ( zhnews2 , zhice0(ji) )                                             * zta4   &
+            &          ) / zah
+         
+         tbif_1d(ji,3) =     ( iiceform * ( zhnews2 - zdh3 )                                           * zta1  &
+            &              + ( iiceform * zdh3 + ( 1 - iiceform ) * zdh1 )                             * zta2  &
+            &              + ( iiceform * ( zhnews2 - zdh5 ) + ( 1 - iiceform ) * ( zhnews2 - zdh1 ) ) * zta3  & 
+            &              + ( iiceform * zdh5 + ( 1 - iiceform ) * zhnews2 )                          * zta4  &
+            &            ) / zah
+         !---removing the remaining part of ice formed which has been already used
+         zbeta         = h_ice_1d(ji) / ( h_ice_1d(ji) + zdhicbot(ji) )
+         h_ice_1d(ji)  = h_ice_1d(ji) + zdhicbot(ji)
+         tbif_1d (ji,2)= zbeta * tbif_1d(ji,2) + ( 1.0 - zbeta ) * tbif_1d(ji,3)
+         tbif_1d (ji,3)= ( 2. * zbeta - 1.0 ) * tbif_1d(ji,3) + ( 2. * zdhicbot(ji) / h_ice_1d(ji) ) * tfu_1d(ji)
+         
+      END DO
+      
+      !-------------------------------------------------------------
+      !    Computation of variation of ice volume and ice mass 
+      !           Vold = (1-Aold) * hiold ; Vnew = (1-Anew) * hinew
+      !           dV = Vnew - Vold
+      !-------------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         dvlbq_1d  (ji) = ( 1. - frld_1d(ji) ) * h_ice_1d(ji) - ( 1. - zfrl_old(ji) ) * zhice_old(ji)
+         rdm_ice_1d(ji) = rdm_ice_1d(ji) + rhoic * dvlbq_1d(ji)
+         rdq_ice_1d(ji) = rdq_ice_1d(ji) + rcpic * dvlbq_1d(ji) * ( tfu_1d(ji) - rt0 )      ! heat content relative to rt0
+      END DO
+      
+      CALL wrk_dealloc( jpij, zqbgow, zfrl_old, zhice_old, zhice0, zfrlmin, zdhicbot )
+      !
+   END SUBROUTINE lim_thd_lac_2
+#else
+   !!----------------------------------------------------------------------
+   !!                       ***  MODULE limthd_lac_2   ***
+   !!                           no sea ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_lac_2           ! Empty routine
+   END SUBROUTINE lim_thd_lac_2
+#endif
+   !!======================================================================
+END MODULE limthd_lac_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 8732)
@@ -0,0 +1,827 @@
+MODULE limthd_zdf_2
+   !!======================================================================
+   !!                       ***  MODULE limthd_zdf_2 ***
+   !!                thermodynamic growth and decay of the ice 
+   !!======================================================================
+   !! History :  1.0  !  01-04 (LIM) Original code
+   !!            2.0  !  02-08 (C. Ethe, G. Madec) F90
+   !!----------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE phycst           ! ???
+   USE thd_ice_2
+   USE ice_2
+   USE limistate_2
+   USE sbc_oce, ONLY : ln_cpl
+   USE in_out_manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+    
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_zdf_2        ! called by lim_thd_2
+
+   REAL(wp) ::   epsi20 = 1.e-20  ,  &  ! constant values
+      &          epsi13 = 1.e-13  ,  &
+      &          zzero  = 0.e0    ,  &
+      &          zone   = 1.e0
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_zdf_2( kideb , kiut )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd_zdf_2  ***
+      !!              
+      !! ** Purpose : This routine determines the time evolution of snow 
+      !!      and sea-ice thicknesses, concentration and heat content 
+      !!      due to the vertical and lateral thermodynamic accretion-
+      !!      ablation processes. One only treats the case of lat. abl.
+      !!      For lateral accretion, see routine lim_lat_accr 
+      !! 
+      !! ** Method  : The representation of vertical growth and decay of 
+      !!      the sea-ice model is based upon the diffusion of heat 
+      !!      through the external and internal boundaries of a 
+      !!      three-layer system (two layers of ice and one layer and 
+      !!      one layer of snow, if present, on top of the ice).
+      !! 
+      !! ** Action  : - Calculation of some intermediates variables
+      !!              - Calculation of surface temperature
+      !!              - Calculation of available heat for surface ablation
+      !!              - Calculation of the changes in internal temperature 
+      !!                of the three-layer system, due to vertical diffusion 
+      !!                processes
+      !!              - Performs surface ablation and bottom accretion-ablation
+      !!              - Performs snow-ice formation
+      !!              - Performs lateral ablation
+      !!
+      !! References : Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
+      !!              Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268  
+      !!------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb    ! Start point on which the  the computation is applied
+      INTEGER, INTENT(in) ::   kiut     ! End point on which the  the computation is applied
+      !!
+      INTEGER ::   ji       ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:) ::   zqcmlts        ! energy due to surface melting
+      REAL(wp), POINTER, DIMENSION(:) ::   zqcmltb        ! energy due to bottom melting
+      REAL(wp), POINTER, DIMENSION(:) ::   ztsmlt         ! snow/ice surface melting temperature
+      REAL(wp), POINTER, DIMENSION(:) ::   ztbif          ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. 
+      REAL(wp), POINTER, DIMENSION(:) ::   zksn           ! effective conductivity of snow
+      REAL(wp), POINTER, DIMENSION(:) ::   zkic           ! effective conductivity of ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zksndh         ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys. 
+      REAL(wp), POINTER, DIMENSION(:) ::   zfcsu          ! conductive heat flux at the surface of the snow/ice system 
+      REAL(wp), POINTER, DIMENSION(:) ::   zfcsudt        ! = zfcsu * dt
+      REAL(wp), POINTER, DIMENSION(:) ::   zi0            ! frac. of the net SW rad. which is not absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:) ::   z1mi0          ! fraction of the net SW radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:) ::   zqmax          ! maximum energy stored in brine pockets
+      REAL(wp), POINTER, DIMENSION(:) ::   zrcpdt         ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer)
+      REAL(wp), POINTER, DIMENSION(:) ::   zts_old        ! previous surface temperature
+      REAL(wp), POINTER, DIMENSION(:) ::   zidsn , z1midsn , zidsnic ! temporary variables
+      REAL(wp), POINTER, DIMENSION(:) ::   zfnet          ! net heat flux at the top surface( incl. conductive heat flux)
+      REAL(wp), POINTER, DIMENSION(:) ::   zsprecip       ! snow accumulation
+      REAL(wp), POINTER, DIMENSION(:) ::   zhsnw_old      ! previous snow thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zdhictop       ! change in ice thickness due to top surf ablation/accretion
+      REAL(wp), POINTER, DIMENSION(:) ::   zdhicbot       ! change in ice thickness due to bottom surf abl/acc
+      REAL(wp), POINTER, DIMENSION(:) ::   zqsup          ! energy transmitted to ocean (coming from top surf abl/acc)
+      REAL(wp), POINTER, DIMENSION(:) ::   zqocea         ! energy transmitted to ocean (coming from bottom sur abl/acc)
+      REAL(wp), POINTER, DIMENSION(:) ::   zfrl_old       ! previous sea/ice fraction
+      REAL(wp), POINTER, DIMENSION(:) ::   zfrld_1d       ! new sea/ice fraction
+      REAL(wp), POINTER, DIMENSION(:) ::   zep            ! internal temperature of the 2nd layer of the snow/ice system
+      REAL(wp), DIMENSION(3) :: & 
+            zplediag  &    ! principle diagonal, subdiag. and supdiag. of the 
+          , zsubdiag  &    ! tri-diagonal matrix coming from the computation
+          , zsupdiag  &    ! of the temperatures inside the snow-ice system
+          , zsmbr          ! second member
+       REAL(wp) ::    &
+            zhsu      &    ! thickness of surface layer
+          , zhe       &    ! effective thickness for compu. of equ. thermal conductivity
+          , zheshth   &    ! = zhe / thth
+          , zghe      &    ! correction factor of the thermal conductivity
+          , zumsb     &    ! parameter for numerical method to solve heat-diffusion eq.
+          , zkhsn     &    ! conductivity at the snow layer
+          , zkhic     &    ! conductivity at the ice layers
+          , zkint     &    ! equivalent conductivity at the snow-ice interface
+          , zkhsnint  &    ! = zkint*dt / (hsn*rhosn*cpsn)  
+          , zkhicint  &    ! = 2*zkint*dt / (hic*rhoic*cpic)
+          , zpiv1, zpiv2 & ! temporary scalars used to solve the tri-diagonal system
+          , zb2, zd2  &    ! temporary scalars used to solve the tri-diagonal system
+          , zb3, zd3  &    ! temporary scalars used to solve the tri-diagonal system
+          , ztint          ! equivalent temperature at the snow-ice interface
+       REAL(wp) ::    & 
+            zexp      &    ! exponential function of the ice thickness
+          , zfsab     &    ! part of solar radiation stored in brine pockets
+          , zfts      &    ! value of energy balance function when the temp. equal surf. temp.
+          , zdfts     &    ! value of derivative of ztfs when the temp. equal surf. temp.
+          , zdts      &    ! surface temperature increment
+          , zqsnw_mlt &    ! energy needed to melt snow
+          , zdhsmlt   &    ! change in snow thickness due to melt
+          , zhsn      &    ! snow thickness (previous+accumulation-melt)
+          , zqsn_mlt_rem & ! remaining heat coming from snow melting
+          , zqice_top_mlt &! energy used to melt ice at top surface
+          , zdhssub   &    ! change in snow thick. due to sublimation or evaporation
+          , zdhisub   &    ! change in ice thick. due to sublimation or evaporation    
+          , zdhsn     &    ! snow ice thickness increment
+          , zdtsn     &    ! snow internal temp. increment
+          , zdtic     &    ! ice internal temp. increment
+          , zqnes          ! conductive energy due to ice melting in the first ice layer
+       REAL(wp) ::    & 
+            ztbot     &    ! temperature at the bottom surface
+          , zfcbot    &    ! conductive heat flux at bottom surface
+          , zqice_bot &    ! energy used for bottom melting/growing
+          , zqice_bot_mlt &! energy used for bottom melting
+          , zqstbif_bot  & ! part of energy stored in brine pockets used for bottom melting
+          , zqstbif_old  & ! temporary var. for zqstbif_bot
+          , zdhicmlt  &    ! change in ice thickness due to bottom melting
+          , zdhicm    &    ! change in ice thickness var. 
+          , zdhsnm    &    ! change in snow thickness var. 
+          , zhsnfi    &    ! snow thickness var. 
+          , zc1, zpc1 &    ! temporary variables
+          , zc2, zpc2 &    ! temporary variables
+          , zp1, zp2  &    ! temporary variables
+          , ztb2, ztb3     ! temporary variables
+       REAL(wp) ::    & 
+            zdrmh     &    ! change in snow/ice thick. after snow-ice formation
+          , zhicnew   &    ! new ice thickness
+          , zhsnnew   &    ! new snow thickness
+          , zquot     &
+          , ztneq     &    ! temporary temp. variables
+          , zqice     &
+          , zqicetot  &    ! total heat inside the snow/ice system
+          , zdfrl     &    ! change in ice concentration
+          , zdvsnvol  &    ! change in snow volume
+          , zdrfrl1, zdrfrl2, zihsn, zidhb, zihic &  ! temporary scalars
+          , zihe, zihq, ziexp, ziqf, zihnf        &  ! temporary scalars
+          , zibmlt, ziqr, zihgnew, zind, ztmp        ! temporary scalars
+       !!----------------------------------------------------------------------
+       CALL wrk_alloc( jpij, ztsmlt, ztbif  , zksn    , zkic    , zksndh , zfcsu  , zfcsudt , zi0      , z1mi0   , zqmax    )
+       CALL wrk_alloc( jpij, zrcpdt, zts_old, zidsn   , z1midsn , zidsnic, zfnet  , zsprecip, zhsnw_old, zdhictop, zdhicbot )
+       CALL wrk_alloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep    , zqcmlts, zqcmltb                                 )
+
+       !-----------------------------------------------------------------------
+       !  1. Boundaries conditions for snow/ice system internal temperature
+       !       - If tbif_1d(ji,1) > rt0_snow, tbif_1d(ji,1) = rt0_snow 
+       !       - If tbif_1d(ji,2/3) > rt0_ice, tbif_1d(ji,2/3) = rt0_ice 
+       !     Computation of energies due to surface and bottom melting 
+       !-----------------------------------------------------------------------
+       
+       DO ji = kideb , kiut
+          ! do nothing if the snow (ice) thickness falls below its minimum thickness
+          zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
+          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) )
+          !--energy required to bring snow to its melting point (rt0_snow)
+          zqcmlts(ji) = ( MAX ( zzero , rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
+          !--energy required to bring ice to its melting point (rt0_ice)
+          zqcmltb(ji) = ( MAX( zzero , rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) )  &
+             &          + MAX( zzero , rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) )  &
+             &          ) * ( 1.0 - zihic  )
+          !--limitation of snow/ice system internal temperature
+          tbif_1d(ji,1)   = MIN( rt0_snow, tbif_1d(ji,1) )
+          tbif_1d(ji,2)   = MIN( rt0_ice , tbif_1d(ji,2) )
+          tbif_1d(ji,3)   = MIN( rt0_ice , tbif_1d(ji,3) )
+       END DO
+
+       !-------------------------------------------
+       !  2. Calculate some intermediate variables.  
+       !-------------------------------------------
+       
+       ! initialisation of the thickness of surface layer
+       zhsu = hnzst  
+
+       DO ji = kideb , kiut
+          zind   = MAX( zzero , SIGN( zone , zhsu - h_snow_1d(ji) ) )
+          zihsn  = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
+          zihsn  = MAX( zihsn , zind )
+          zihic  = MAX( zzero , sign( zone , hicdif - h_ice_1d(ji) ) )
+          !     2.1. Computation of surface melting temperature
+          !----------------------------------------------------
+          zind  = MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
+          ztsmlt(ji) = ( 1.0 - zind ) * rt0_snow + zind * rt0_ice
+          !
+          !     2.2. Effective conductivity of snow and ice
+          !-----------------------------------------------
+
+          !---computation of the correction factor on the thermal conductivity
+          !-- (Morales Maqueda, 1995 ; Fichefet and Morales Maqueda, 1997)
+          zhe      =  ( rcdsn / ( rcdsn + rcdic ) ) * h_ice_1d(ji)   &
+             &     + ( rcdic / ( rcdsn + rcdic ) ) * h_snow_1d(ji) 
+          zihe     = MAX( zzero , SIGN( zone , 2.0 * zhe - thth ) )
+          zheshth  = zhe / thth
+          zghe     = ( 1.0 - zihe ) * zheshth * ( 2.0 - zheshth )   &
+             &     +         zihe   * 0.5 * ( 1.5 + LOG( 2.0 * zheshth ) )
+
+          !---effective conductivities 
+          zksn(ji)  = zghe * rcdsn  
+          zkic(ji)  = zghe * rcdic
+
+          !
+          !     2.3. Computation of the conductive heat flux from the snow/ice 
+          !          system interior toward the top surface
+          !------------------------------------------------------------------
+
+          !---Thermal conductivity at the mid-point of the first snow/ice system layer
+          zksndh(ji) =   ( ( 1.0 - zihsn ) * 2.0 * zksn(ji) + zihsn * 4.0 * zkic(ji) )   &
+             &         / ( ( 1.0 - zihsn ) *  h_snow_1d(ji)                              &
+             &           +        zihsn   *  ( ( 1.0 + 3.0 * zihic ) * h_ice_1d(ji)      &
+             &           + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
+
+          !---internal temperature at the mid-point of the first snow/ice system layer
+          ztbif(ji)  = ( 1.0 - zihsn ) * tbif_1d(ji,1)                       &
+             &       +         zihsn   * ( ( 1.0 - zihic ) * tbif_1d(ji,2)   &
+             &       +         zihic   * tfu_1d(ji)   )
+          !---conductive heat flux 
+          zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+
+       END DO
+
+       !--------------------------------------------------------------------
+       !  3. Calculate : 
+       !     - fstbif_1d, part of solar radiation absorbing inside the ice
+       !       assuming an exponential absorption (Grenfell and Maykut, 1977)
+       !     - zqmax,  maximum energy stored in brine pockets
+       !     - qstbif_1d, total energy stored in brine pockets (updating)
+       !-------------------------------------------------------------------
+
+       DO ji = kideb , kiut
+          zihsn  = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
+          zihic  = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )     
+          zind   = MAX( zzero , SIGN (zone , hicdif - h_ice_1d(ji) ) )
+          !--Computation of the fraction of the net shortwave radiation which
+          !--penetrates inside the ice cover ( See Forcat)
+          zi0(ji)  = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
+          zexp     = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
+          fstbif_1d(ji) = zi0(ji) * qsr_ice_1d(ji) * zexp
+          !--Computation of maximum energy stored in brine pockets zqmax and update
+          !--the total energy stored in brine pockets, if less than zqmax
+          zqmax(ji) = MAX( zzero , 0.5 * xlic * ( h_ice_1d(ji) - hicmin ) )
+          zfsab   = zi0(ji) * qsr_ice_1d(ji) * ( 1.0 - zexp )
+          zihq    = ( 1.0 - zind ) * MAX(zzero, SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) ) &
+             &    +         zind   * zone
+          qstbif_1d(ji) = ( qstbif_1d(ji) + ( 1.0 - zihq ) * zfsab * rdt_ice ) * swiqst
+          !--fraction of shortwave radiation absorbed at surface
+          ziexp = zihq * zexp + ( 1.0 - zihq ) * ( swiqst + ( 1.0 - swiqst ) * zexp )
+          z1mi0(ji) = 1.0 - zi0(ji) * ziexp
+       END DO
+
+       !--------------------------------------------------------------------------------
+       !  4. Computation of the surface temperature : determined by considering the 
+       !     budget of a thin layer of thick. zhsu at the top surface (H. Grenier, 1995) 
+       !     and based on a surface energy balance : 
+       !     hsu * rcp * dT/dt = Fsr + Fnsr(T) + Fcs(T),
+       !     where - Fsr is the net absorbed solar radiation, 
+       !           - Fnsr is the total non solar radiation (incoming and outgoing long-wave,
+       !             sensible and latent heat fluxes)
+       !           - Fcs the conductive heat flux at the top of surface
+       !------------------------------------------------------------------------------
+
+       !     4.1. Computation of intermediate values
+       !---------------------------------------------
+       DO ji = kideb, kiut
+          zrcpdt(ji) = ( rcpsn * MIN( h_snow_1d(ji) , zhsu )    &
+             &       + rcpic * MAX( zhsu - h_snow_1d(ji) , zzero ) ) / rdt_ice
+          zts_old(ji) =  sist_1d(ji)
+       END DO
+
+       !     4.2. Computation of surface temperature by expanding the eq. of energy balance
+       !          with Ts = Tp + DT. One obtain , F(Tp) + DT * DF(Tp) = 0
+       !          where  - F(Tp) = Fsr + Fnsr(Tp) + Fcs(Tp) 
+       !                 - DF(Tp)= (dFnsr(Tp)/dT) + (dFcs(Tp)/dT) - hsu*rcp/dt
+       !---------------------------------------------------------------------------------
+
+       DO ji = kideb, kiut
+          !---computation of the derivative of energy balance function 
+          zdfts    =  zksndh(ji)   & ! contribution of the conductive heat flux
+             &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt
+             &      - dqns_ice_1d (ji)     ! contribution of the total non solar radiation 
+          !---computation of the energy balance function 
+          zfts    = - z1mi0 (ji) * qsr_ice_1d(ji)   & ! net absorbed solar radiation
+             &      - qns_ice_1d(ji)                & ! total non solar radiation
+             &      - zfcsu (ji)                      ! conductive heat flux from the surface
+          !---computation of surface temperature increment  
+          zdts    = -zfts / zdfts
+          !---computation of the new surface temperature 
+          sist_1d(ji) = sist_1d(ji) + zdts
+       END DO
+
+       !----------------------------------------------------------------------------
+       !  5. Boundary condition at the top surface
+       !--    IF Tsb < Tmelt, Fnet = Fcs (the net heat flux equal the conductive heat flux)
+       !      Otherwise Tsb = Tmelt and Qnet(Tmelt) > 0 
+       !      Fnet(Tmelt) is therefore the net surface flux needed for melting
+       !----------------------------------------------------------------------------
+       
+       
+       !     5.1.  Limitation of surface temperature and update total non solar fluxes,
+       !          latent heat flux and conductive flux at the top surface 
+       !----------------------------------------------------------------------  
+                     
+       IF ( .NOT. ln_cpl ) THEN   ! duplicate the loop for performances issues
+          DO ji = kideb, kiut
+             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
+             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
+             qla_ice_1d(ji) = qla_ice_1d(ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
+             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+          END DO
+       ELSE
+          DO ji = kideb, kiut
+             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
+             qla_ice_1d(ji) = -9999.   ! default definition, not used as parsub = 0. in this case
+             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+          END DO
+       ENDIF
+
+       !     5.2. Calculate available heat for surface ablation. 
+       !---------------------------------------------------------------------
+
+       DO ji = kideb, kiut
+          zfnet(ji) = qns_ice_1d(ji) + z1mi0(ji) * qsr_ice_1d(ji) + zfcsu(ji)          
+          zfnet(ji) = MAX( zzero , zfnet(ji) )
+          zfnet(ji) = zfnet(ji) * MAX( zzero , SIGN( zone , sist_1d(ji) - ztsmlt(ji) ) )
+       END DO
+
+       !-------------------------------------------------------------------------
+       !  6. Calculate changes in internal temperature due to vertical diffusion   
+       !     processes. The evolution of this temperature is governed by the one-
+       !     dimensionnal heat-diffusion equation. 
+       !     Given the temperature tbif(1/2/3), at time m we solve a set
+       !     of finite difference equations to obtain new tempe. Each tempe is coupled
+       !     to the temp. immediatly above and below by heat conduction terms. Thus 
+       !     we have a set of equations of the form A * T = B, where A is a tridiagonal
+       !     matrix, T a vector whose components are the unknown new temp.
+       !-------------------------------------------------------------------------
+       
+       !--parameter for the numerical methode use to solve the heat-diffusion equation
+       !- implicit, explicit or Crank-Nicholson
+       zumsb = 1.0 - sbeta  
+       DO ji = kideb, kiut
+          zidsn(ji)   = MAX ( zzero, SIGN( zone, hsndif - h_snow_1d(ji) ) ) 
+          z1midsn(ji) = 1.0 - zidsn(ji)
+          zihic       = MAX ( zzero, SIGN( zone, hicdif - h_ice_1d(ji) ) ) 
+          zidsnic(ji) = zidsn(ji) *  zihic 
+          zfcsudt(ji) = zfcsu(ji) * rdt_ice 
+       END DO 
+   
+       DO ji = kideb, kiut
+
+          !     6.1 Calculate intermediate variables.
+          !----------------------------------------
+
+          !--conductivity at the snow surface
+          zkhsn = 2.0 * zksn(ji) * rdt_ice / rcpsn
+          !--conductivity at the ice surface
+          zkhic = 4.0 * zkic(ji) * rdt_ice / MAX( h_ice_1d(ji) * h_ice_1d(ji) * rcpic , epsi20 )
+          !--conductivity at the snow/ice interface 
+          zkint = 4.0 * zksn(ji) * zkic(ji)  &
+             &        / ( zksn(ji) * h_ice_1d(ji) + 2.0 * zkic(ji) * h_snow_1d(ji) * z1midsn(ji)) 
+          zkhsnint = zkint * rdt_ice / rcpsn
+          zkhicint = zkint * 2.0 * rdt_ice / MAX( h_ice_1d(ji) * rcpic , epsi20 )
+          
+          !     6.2. Fulfill the linear system matrix.
+          !-----------------------------------------
+!$$$          zplediag(1) = 1 + sbeta * z1midsn(ji) * ( zkhsn + zkhsnint )       
+          zplediag(1) =   zidsn(ji) + z1midsn(ji) * h_snow_1d(ji)   &
+             &          + sbeta * z1midsn(ji) * zkhsnint 
+          zplediag(2) = 1 + sbeta * ( z1midsn(ji) * zkhicint + zkhic ) 
+          zplediag(3) = 1 + 3.0 * sbeta * zkhic   
+
+          zsubdiag(1) =  0.e0              
+          zsubdiag(2) = -1.e0 * z1midsn(ji) * sbeta * zkhicint
+          zsubdiag(3) = -1.e0 * sbeta * zkhic 
+
+          zsupdiag(1) = -1.e0 * z1midsn(ji) * sbeta * zkhsnint 
+          zsupdiag(2) = zsubdiag(3)
+          zsupdiag(3) =  0.e0
+          
+          !     6.3. Fulfill the idependent term vector.
+          !-------------------------------------------
+          
+!$$$          zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) *   &
+!$$$             &         ( tbif_1d(ji,1) + zkhsn * sist_1d(ji)
+!$$$             &         - zumsb * ( zkhsn * tbif_1d(ji,1)
+!$$$             &                   + zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) ) )
+          zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) *    &
+             &       ( h_snow_1d(ji) * tbif_1d(ji,1) - ( zfcsudt(ji) / rcpsn )  &
+             &       - zumsb * zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) )
+
+          zsmbr(2) =  tbif_1d(ji,2)  &
+             &      - zidsn(ji) * ( 1.0 - zidsnic(ji) ) &
+             &        * ( zfcsudt(ji) / MAX( h_ice_1d(ji) * rcpic , epsi20 ) ) &
+             &      + zumsb * ( zkhicint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) &
+             &                   - zkhic * ( tbif_1d(ji,2) - tbif_1d(ji,3) )  )
+
+          zsmbr(3) =  tbif_1d(ji,3)  &
+             &      + zkhic * ( 2.0 * tfu_1d(ji) &
+             &                + zumsb * ( tbif_1d(ji,2) - 3.0 * tbif_1d(ji,3) ) )
+          
+          !     6.4. Solve the system (Gauss elimination method).
+          !----------------------------------------------------
+          
+          zpiv1 = zsubdiag(2) / zplediag(1) 
+          zb2   = zplediag(2) - zpiv1 * zsupdiag(1)
+          zd2   = zsmbr(2) - zpiv1 * zsmbr(1)
+
+          zpiv2 = zsubdiag(3) / zb2
+          zb3   = zplediag(3) - zpiv2 * zsupdiag(2)
+          zd3   = zsmbr(3) - zpiv2 * zd2
+
+          tbif_1d(ji,3) = zd3 / zb3
+          tbif_1d(ji,2) = ( zd2 - zsupdiag(2) * tbif_1d(ji,3) ) / zb2
+          tbif_1d(ji,1) = ( zsmbr(1) - zsupdiag(1) * tbif_1d(ji,2) ) / zplediag(1)            
+
+          !--- taking into account the particular case of  zidsnic(ji) = 1
+          ztint =  (  zkic(ji) * h_snow_1d(ji) * tfu_1d (ji)    &
+             &      + zksn(ji) * h_ice_1d(ji) * sist_1d(ji) )   &
+             &   / ( zkic(ji) * h_snow_1d(ji) + zksn(ji) * h_ice_1d(ji) ) 
+
+          tbif_1d(ji,1) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,1)   &
+             &                + zidsnic(ji)   * ( ztint + sist_1d(ji) ) / 2.0
+          tbif_1d(ji,2) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,2)   &
+             &                + zidsnic(ji)   * ( 3.0 * ztint + tfu_1d(ji) ) / 4.0
+          tbif_1d(ji,3) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3)   &
+             &                + zidsnic(ji)   * ( ztint + 3.0 * tfu_1d(ji) ) / 4.0     
+       END DO
+ 
+       !----------------------------------------------------------------------
+       !  9. Take into account surface ablation and bottom accretion-ablation.|
+       !----------------------------------------------------------------------
+       
+       !---Snow accumulation in one thermodynamic time step
+       zsprecip(kideb:kiut) = sprecip_1d(kideb:kiut) * rdt_ice / rhosn
+
+
+       DO ji = kideb, kiut
+          
+          !      9.1. Surface ablation and update of snow thickness and qstbif_1d
+          !--------------------------------------------------------------------
+          
+          !--------------------------------------------------------------------------
+          !--      Melting snow processes :
+          !--      Melt at the upper surface is computed from the difference between 
+          !--      the net heat flux (including the conductive heat flux) at the upper 
+          !--      surface and the pre-existing energy due to surface melting
+          !------------------------------------------------------------------------------
+          
+          !-- store the snow thickness
+          zhsnw_old(ji) =  h_snow_1d(ji)
+          !--computation of the energy needed to melt snow
+          zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlts(ji)
+          !--change in snow thickness due to melt
+          zdhsmlt = - zqsnw_mlt / xlsn
+          
+          !-- compute new snow thickness, taking into account the part of snow accumulation
+          !   (as snow precipitation) and the part of snow lost due to melt
+          zhsn =  h_snow_1d(ji) + zsprecip(ji) + zdhsmlt
+          h_snow_1d(ji) = MAX( zzero , zhsn )
+          !-- compute the volume of snow lost after surface melting and the associated mass
+          dvsbq_1d(ji) =  ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) )
+          dvsbq_1d(ji) =  MIN( zzero , dvsbq_1d(ji) )
+          ztmp = rhosn * dvsbq_1d(ji)
+          rdm_snw_1d(ji) =  ztmp
+          !--heat content of the water provided to the ocean (referenced to rt0)
+          rdq_snw_1d(ji) =  cpic * ztmp * ( rt0_snow - rt0 )
+          !-- If the snow is completely melted the remaining heat is used to melt ice
+          zqsn_mlt_rem  = MAX( zzero , -zhsn ) * xlsn
+          zqice_top_mlt = zqsn_mlt_rem 
+          zqstbif_old   = qstbif_1d(ji)
+
+          !--------------------------------------------------------------------------
+          !--      Melting ice processes at the top surface :
+          !--      The energy used to melt ice, zqice_top_mlt, is taken from the energy
+          !--      stored in brine pockets qstbif_1d and the remaining energy coming 
+          !--      from the melting snow process zqsn_mlt_rem.
+          !--      If qstbif_1d > zqsn_mlt_rem then, one uses only a zqsn_mlt_rem part
+          !--      of qstbif_1d to melt ice,
+          !--         zqice_top_mlt = zqice_top_mlt + zqsn_mlt_rem
+          !--         qstbif_1d = qstbif_1d - zqsn_mlt_rem
+          !--      Otherwise one uses all qstbif_1d to melt ice
+          !--         zqice_top_mlt = zqice_top_mlt + qstbif_1d
+          !--         qstbif_1d = 0
+          !------------------------------------------------------
+          
+          ziqf =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqsn_mlt_rem  ) )
+          zqice_top_mlt =         ziqf   * ( zqice_top_mlt + zqsn_mlt_rem )   &
+             &          + ( 1.0 - ziqf ) * ( zqice_top_mlt + qstbif_1d(ji)  )
+
+          qstbif_1d(ji) =         ziqf   * ( qstbif_1d(ji) - zqsn_mlt_rem )   &
+             &          + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
+
+          !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
+          !--    ice is taking into account only when qstbif_1d is less than zqmax. 
+          !--    Otherwise, only the remaining energy coming from the melting snow 
+          !--    process is used 
+          zihq =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
+
+          zqice_top_mlt =         zihq   * zqice_top_mlt   &
+             &          + ( 1.0 - zihq ) * zqsn_mlt_rem
+
+          qstbif_1d(ji) =         zihq   * qstbif_1d(ji)   &
+             &          + ( 1.0 - zihq ) * zqstbif_old
+
+          !--change in ice thickness due to melt at the top surface
+          zdhictop(ji) = -zqice_top_mlt / xlic
+          !--compute the volume formed after surface melting
+          dvsbq_1d(ji) =  zdhictop(ji) * ( 1.0 - frld_1d(ji) )
+
+          !-------------------------------------------------------------------------
+          !--      A small variation at the surface also occurs because of sublimation
+          !--      associated with the latent flux. If qla_ice_1d is negative, snow condensates at 
+          !        the surface. Otherwise, snow evaporates
+          !-----------------------------------------------------------------------
+          !----change in snow and ice thicknesses due to sublimation or evaporation
+          zdhssub  = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice 
+          zhsn     = h_snow_1d(ji) - zdhssub
+          zdhisub  = MAX( zzero , -zhsn ) * rhosn/rhoic
+          zdhictop(ji) =  zdhictop(ji) - zdhisub
+          h_snow_1d(ji)  =  MAX( zzero , zhsn )
+          !-------------------------------------------------
+          !--  Update Internal temperature and qstbif_1d.
+          !-------------------------------------------
+          zihsn  =  MAX( zzero , SIGN( zone, -h_snow_1d(ji) ) )
+          tbif_1d(ji,1) = ( 1.0 - zihsn ) * tbif_1d(ji,1) + zihsn   * tfu_1d(ji)
+          !--change in snow internal temperature if snow has increased
+          zihnf = MAX( zzero , SIGN( zone , h_snow_1d(ji) - zhsnw_old(ji) ) )
+          zdhsn = 1.0 - zhsnw_old(ji) / MAX( h_snow_1d(ji) , epsi20 )
+          zdtsn = zdhsn * ( sist_1d(ji) - tbif_1d(ji,1) )
+          tbif_1d(ji,1) = tbif_1d(ji,1) + z1midsn(ji) * zihnf * zdtsn
+          !--energy created due to ice melting in the first ice layer
+          zqnes  = ( rt0_ice - tbif_1d(ji,2) ) * rcpic * ( h_ice_1d(ji) / 2. )
+          !--change in first ice layer internal temperature
+          ziqr  = MAX( zzero , SIGN( zone , qstbif_1d(ji) - zqnes ) )
+          zdtic = qstbif_1d(ji) / ( rcpic * ( h_ice_1d(ji) / 2. ) )
+          tbif_1d(ji,2) =  ziqr * rt0_ice + ( 1 - ziqr ) * ( tbif_1d(ji,2) + zdtic )
+          !--update qstbif_1d
+          qstbif_1d(ji) = ziqr * ( qstbif_1d(ji) - zqnes ) * swiqst
+
+
+          !--      9.2. Calculate bottom accretion-ablation and update qstbif_1d.
+          !             Growth and melting at bottom ice surface are governed by  
+          !                 -xlic * Dh = (Fcb - Fbot ) * Dt 
+          !             where Fbot is the net downward heat flux from ice to the ocean
+          !            and Fcb is the conductive heat flux at the bottom surface
+          !---------------------------------------------------------------------------
+          ztbot = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3) + zidsnic(ji) * sist_1d(ji)
+          !---computes conductive heat flux at bottom surface 
+          zfcbot =  4.0 * zkic(ji) * ( tfu_1d(ji) - ztbot )   &
+             &   / ( h_ice_1d(ji) + zidsnic(ji) * ( 3. * h_ice_1d(ji) &
+             &   + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
+          !---computation of net energy needed for bottom melting/growing
+          zqice_bot = ( zfcbot - ( fbif_1d(ji) + qlbbq_1d(ji) ) ) * rdt_ice
+          zqstbif_bot = qstbif_1d(ji)
+          !---switch to know if bottom surface melts ( = 1 ) or grows ( = 0 )occurs
+          zibmlt = MAX( zzero , SIGN( zone , -zqice_bot ) )
+          !--particular case of melting (in the same way as the top surface)
+          zqice_bot_mlt = zqice_bot 
+          zqstbif_old = zqstbif_bot
+
+          ziqf =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) + zqice_bot_mlt  ) )
+          zqice_bot_mlt =         ziqf   * ( zqice_bot_mlt + zqice_bot_mlt ) &
+             &          + ( 1.0 - ziqf ) * ( zqice_bot_mlt + qstbif_1d(ji)  )          
+          qstbif_1d(ji)   =         ziqf   * ( qstbif_1d(ji) + zqice_bot_mlt ) &
+             &          + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
+          !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
+          !--    ice is taking into account only when qstbif_1d is less than zqmax. 
+          zihq =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
+          zqice_bot_mlt =         zihq   * zqice_bot_mlt   &
+             &          + ( 1.0 - zihq ) * zqice_bot
+          qstbif_1d(ji)   =         zihq   * qstbif_1d(ji)   &
+             &             + ( 1.0 - zihq ) * zqstbif_old
+
+          !---treatment of the case of melting/growing
+          zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmltb(ji) )   &
+             &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji)  )
+          qstbif_1d(ji) =         zibmlt   * qstbif_1d(ji)   &
+             &           + ( 1.0 - zibmlt ) * zqstbif_bot
+
+          !--computes change in ice thickness due to melt or growth
+          zdhicbot(ji) = zqice_bot / xlic
+          !--limitation of bottom melting if so : hmelt maximum melting at bottom
+          zdhicmlt  = MAX( hmelt , zdhicbot(ji) ) 
+          !-- output part due to bottom melting only
+          IF( zdhicmlt < 0.e0 ) rdvomif_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicmlt
+          !--energy after bottom melting/growing
+          zqsup(ji) = ( 1.0 - frld_1d(ji) ) * xlic * ( zdhicmlt - zdhicbot(ji) )
+          !-- compute the new thickness and the newly formed volume after bottom melting/growing
+          zdhicbot(ji)  = zdhicmlt
+          dvbbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicbot(ji)
+
+
+          !        9.3.  Updating ice thickness after top surface ablation 
+          !              and bottom surface accretion/ablation
+          !---------------------------------------------------------------
+          zhicnew  = h_ice_1d(ji) + zdhictop(ji) + zdhicbot(ji)
+
+          !
+          !        9.4. Case of total ablation (ice is gone but snow may be left)
+          !-------------------------------------------------------------------
+          zhsn  = h_snow_1d(ji)
+          zihgnew = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
+          zihsn   = MAX( zzero , SIGN( zone , -zhsn ) )
+          !---convert 
+          zdhicm  = ( 1.0 - zihgnew ) * ( zhicnew - qstbif_1d(ji) / xlic )
+          zdhsnm  = ( 1.0 - zihsn ) * zdhicm * rhoic / rhosn
+          !---updating new ice thickness and computing the newly formed ice mass
+          zhicnew   =  zihgnew * zhicnew
+          ztmp    =  ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
+          rdm_ice_1d(ji) =  rdm_ice_1d(ji) + ztmp
+          !---heat content of the water provided to the ocean (referenced to rt0)
+          !   use of rt0_ice is OK for melting ice; in the case of freezing, tfu_1d should be used. 
+          !   This is done in 9.5 section (see below)
+          rdq_ice_1d(ji) =  cpic * ztmp * ( rt0_ice - rt0 )
+          !---updating new snow thickness and computing the newly formed snow mass
+          zhsnfi   = zhsn + zdhsnm
+          h_snow_1d(ji) = MAX( zzero , zhsnfi )
+          ztmp = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
+          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
+          !---updating the heat content of the water provided to the ocean (referenced to rt0)
+          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 )
+          !--remaining energy in case of total ablation
+          zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) )
+          qstbif_1d(ji) = zihgnew * qstbif_1d(ji)
+
+          !
+          !        9.5. Update internal temperature and ice thickness.
+          !-------------------------------------------------------
+          !
+          sist_1d(ji) = zihgnew * sist_1d(ji) + ( 1.0 - zihgnew ) * tfu_1d(ji)
+          zidhb  = MAX( zzero , SIGN( zone , - zdhicbot(ji) ) )
+          zc1    = - zhicnew * 0.5
+          zpc1   = MIN( 0.5 * zone , - h_ice_1d(ji) * 0.5 - zdhictop(ji) )
+          zc2    = - zhicnew
+          zpc2   =  zidhb * zc2 + ( 1.0 - zidhb ) * ( - h_ice_1d(ji) - zdhictop(ji) )
+          zp1    =  MAX( zpc1 , zc1 )
+          zp2    =  MAX( zpc2 , zc1 )
+          zep(ji) =  tbif_1d(ji,2)
+          ztb2  = 2.0 * (         - zp1   * tbif_1d(ji,2)  &
+             &  + ( zp1 - zp2 ) * tbif_1d(ji,3)  &
+             &  + ( zp2 - zc1 ) * tfu_1d(ji) ) / MAX( zhicnew , epsi20 ) 
+          tbif_1d(ji,2) = zihgnew * ztb2 + ( 1.0 - zihgnew ) * tfu_1d(ji)
+          !---
+          zp1  =  MIN( zpc1 , zc1 )
+          zp2  =  MIN( zpc2 , zc1 )
+          zp1  =  MAX( zc2  , zp1 )
+          ztb3 =  2.0 * (   ( 1.0 - zidhb ) * (  ( zc1 - zp2 ) * tbif_1d(ji,3)  &
+             &                                 + ( zp2 - zc2 ) * tfu_1d(ji) )   &
+             &               +      zidhb   * (  ( zc1 - zp1 ) * zep(ji)      &
+             &                                 + ( zp1 - zc2 ) * tbif_1d(ji,3))  ) / MAX( zhicnew , epsi20 )
+          tbif_1d(ji,3) =  zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji)
+          h_ice_1d(ji)  =  zhicnew
+          ! update the ice heat content given to the ocean in freezing case 
+          ! (part due to difference between rt0_ice and tfu_1d)
+          ztmp = ( 1. - zidhb ) * rhoic * dvbbq_1d(ji)
+          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0_ice )
+       END DO
+
+
+       !----------------------------------------------------------------------------
+       !  10. Surface accretion. 
+       !      The change of ice thickness after snow/ice formation is such that
+       !      the interface between snow and ice is located at the same height
+       !      as the ocean surface. It is given by (Fichefet and Morales Maqueda 1999)
+       !          D(h_ice) = (- D(hsn)/alph) =  [rhosn*hsn - (rau0 - rhoic)*hic]
+       !                                     / [alph*rhosn+rau0 - rhoic]
+       !----------------------------------------------------------------------------
+       !
+       DO ji = kideb , kiut
+
+          !--  Computation of the change of ice thickness after snow-ice formation
+          zdrmh =  ( rhosn * h_snow_1d(ji) + ( rhoic - rau0 ) * h_ice_1d(ji) )  &
+             &  / ( alphs * rhosn + rau0 - rhoic )
+          zdrmh = MAX( zzero , zdrmh )
+
+          !--New ice and snow thicknesses Fichefet and Morales Maqueda (1999)
+          zhicnew  = MAX( h_ice_1d(ji) , h_ice_1d(ji) + zdrmh )
+          zhsnnew  = MIN( h_snow_1d(ji) , h_snow_1d(ji) - alphs * zdrmh )
+          !---Compute new ice temperatures. snow temperature remains unchanged
+          !   Lepparanta (1983):
+          zihic = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
+          zquot  = ( 1.0 - zihic ) &
+             &   +         zihic * MIN( zone , h_ice_1d(ji) / MAX( zhicnew , epsi20 ) ) 
+          ztneq  =         alphs * cnscg * tbif_1d(ji,1)    &
+             &   + ( 1.0 - alphs * ( rhosn/rhoic ) ) * tfu_1d(ji)
+          zep(ji) = tbif_1d(ji,2)
+          tbif_1d(ji,2) = ztneq - zquot * zquot * ( ztneq - tbif_1d(ji,2) )
+          tbif_1d(ji,3) = 2.0 * ztneq &
+             &        + zquot * ( tbif_1d(ji,3) + zep(ji) - 2.0 * ztneq ) - tbif_1d(ji,2)
+
+          !---  Lepparanta (1983) (latent heat released during white ice formation
+          !     goes to the ocean -for lateral ablation-)
+          qldif_1d(ji)  = qldif_1d(ji) + zdrmh * ( 1.0 - alphs * ( rhosn/rhoic ) ) * xlic * ( 1.0 - frld_1d(ji) )
+          !--   Changes in ice volume and ice mass Lepparanta (1983):
+          dvnbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) )
+          dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn
+          !---  volume change of ice and snow (used for ocean-ice freshwater flux computation)
+          ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic
+          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
+          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0 )
+          !!gm BUG ??   snow ==>  only needed for nn_ice_embd == 0  (standard levitating sea-ice)
+          ztmp = ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn
+          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
+          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 )
+
+          !---  Actualize new snow and ice thickness.
+          h_snow_1d(ji)  = zhsnnew
+          h_ice_1d (ji)  = zhicnew
+
+       END DO
+
+       !----------------------------------------------------
+       !  11. Lateral ablation (Changes in sea/ice fraction) 
+       !----------------------------------------------------
+       DO ji = kideb , kiut
+          zfrl_old(ji)  = frld_1d(ji)
+          zihic   = 1.0 - MAX( zzero , SIGN( zone , -h_ice_1d(ji) ) )
+          zihsn   = 1.0 - MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
+          !--In the case of total ablation (all the ice ice has melted) frld = 1
+          frld_1d(ji)  = ( 1.0 - zihic ) + zihic * zfrl_old(ji)
+          !--Part of solar radiation absorbing inside the ice and going
+          !--through the ocean
+          fscbq_1d(ji) = ( 1.0 - zfrl_old(ji) ) * ( 1.0 - thcm_1d(ji) ) * fstbif_1d(ji)
+          !--Total remaining energy after bottom melting/growing 
+          qfvbq_1d(ji) = zqsup(ji) + ( 1.0 - zihic ) * zqocea(ji)
+          !--Updating of total heat from the ocean
+          qldif_1d(ji)  = qldif_1d(ji) + qfvbq_1d(ji) + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice
+          !--Computation of total heat inside the snow/ice system
+          zqice  = h_snow_1d(ji) * xlsn + h_ice_1d(ji) * xlic
+          zqicetot  = ( 1.0 - frld_1d(ji) ) * zqice
+          !--The concentration of ice is reduced (frld increases) if the heat 
+          !--exchange between ice and ocean is positive
+          ziqf = MAX( zzero , SIGN( zone ,  zqicetot - qldif_1d(ji) ) )
+          zdfrl = qldif_1d(ji) / MAX( epsi20 , zqice ) 
+          frld_1d(ji)  = ( 1.0 - ziqf )    &
+             &       +         ziqf * ( frld_1d(ji) + MAX( zzero , zdfrl ) ) 
+          fltbif_1d(ji) = ( ( 1.0 - zfrl_old(ji) ) * qstbif_1d(ji) - zqicetot  ) / rdt_ice
+          !--  Opening of leads: Hakkinen & Mellor, 1992.
+          zdfrl = - ( zdhictop(ji) + zdhicbot(ji) ) * hakspl * ( 1.0 - zfrl_old(ji) ) &
+             &  / MAX( epsi13 , h_ice_1d(ji) + h_snow_1d(ji) * rhosn/rhoic ) 
+          zfrld_1d(ji) =  frld_1d(ji) + MAX( zzero , zdfrl )
+          !--Limitation of sea-ice fraction <= 1
+          zfrld_1d(ji) = ziqf * MIN( 0.99 * zone , zfrld_1d(ji) ) + ( 1 - ziqf )
+          !---Update surface and internal temperature and snow/ice thicknesses.
+          sist_1d(ji)   = sist_1d(ji)   + ( 1.0 - ziqf ) * ( tfu_1d(ji) - sist_1d(ji)   )
+          tbif_1d(ji,1) = tbif_1d(ji,1) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,1) )
+          tbif_1d(ji,2) = tbif_1d(ji,2) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,2) )
+          tbif_1d(ji,3) = tbif_1d(ji,3) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,3) )
+          !--variation of ice volume and ice mass 
+          dvlbq_1d(ji)   = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji)
+          ztmp = dvlbq_1d(ji) * rhoic
+          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
+!!gm
+!!gm   This should be split in two parts:
+!!gm         1-  heat required to bring sea-ice to tfu  : this part should be added to the heat flux taken from the ocean
+!!gm                 cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0_ice )
+!!gm         2-  heat content of lateral ablation referenced to rt0 : this part only put in rdq_ice_1d
+!!gm                 cpic * ztmp * ( rt0_ice - rt0 )
+!!gm   Currently we put all the heat in rdq_ice_1d
+          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0 )
+          !
+          !--variation of snow volume and snow mass 
+          zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
+          ztmp     = zdvsnvol * rhosn
+          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
+!!gm
+!!gm   This should be split in two parts:
+!!gm         1-  heat required to bring snow to tfu  : this part should be added to the heat flux taken from the ocean
+!!gm                 cpic * ztmp * ( tbif_1d(ji,1) - rt0_snow )
+!!gm         2-  heat content of lateral ablation referenced to rt0 : this part only put in rdq_snw_1d
+!!gm                 cpic * ztmp * ( rt0_snow - rt0 )
+!!gm   Currently we put all the heat in rdq_snw_1d
+          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( tbif_1d(ji,1) - rt0 )
+
+          h_snow_1d(ji)  = ziqf * h_snow_1d(ji)
+
+          zdrfrl1 = ziqf * ( 1.0 -  frld_1d(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
+          zdrfrl2 = ziqf * ( 1.0 - zfrl_old(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
+
+          h_snow_1d (ji) = zdrfrl1 * h_snow_1d(ji)
+          h_ice_1d  (ji) = zdrfrl1 * h_ice_1d(ji)
+          qstbif_1d(ji) = zdrfrl2 * qstbif_1d(ji)
+          frld_1d(ji)    = zfrld_1d(ji)
+          !
+       END DO
+       ! 
+       CALL wrk_dealloc( jpij, ztsmlt, ztbif  , zksn    , zkic    , zksndh , zfcsu  , zfcsudt , zi0      , z1mi0   , zqmax    )
+       CALL wrk_dealloc( jpij, zrcpdt, zts_old, zidsn   , z1midsn , zidsnic, zfnet  , zsprecip, zhsnw_old, zdhictop, zdhicbot )
+       CALL wrk_dealloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep    , zqcmlts, zqcmltb                                 )
+       !
+    END SUBROUTINE lim_thd_zdf_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default Option                                     NO sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_zdf_2          ! Empty routine
+   END SUBROUTINE lim_thd_zdf_2
+#endif
+
+   !!======================================================================
+END MODULE limthd_zdf_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90	(revision 8732)
@@ -0,0 +1,331 @@
+MODULE limtrp_2
+   !!======================================================================
+   !!                       ***  MODULE limtrp_2   ***
+   !! LIM 2.0 transport ice model : sea-ice advection/diffusion
+   !!======================================================================
+   !! History :  LIM  !  2000-01 (UCL)  Original code
+   !!            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
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_trp_2      : advection/diffusion process of sea ice
+   !!   lim_trp_init_2 : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst          ! physical constant
+   USE sbc_oce         ! ocean surface boundary condition
+   USE dom_oce         ! ocean domain
+   USE in_out_manager  ! I/O manager
+   USE dom_ice_2       ! LIM-2 domain
+   USE ice_2           ! LIM-2 variables
+   USE limistate_2     ! LIM-2 initial state
+   USE limadv_2        ! LIM-2 advection
+   USE limhdf_2        ! LIM-2 horizontal diffusion
+   USE lbclnk          ! lateral boundary conditions -- MPP exchanges
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+# if defined key_agrif
+   USE agrif_lim2_interp ! nesting
+# endif
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_trp_2   ! called by sbc_ice_lim_2
+
+   REAL(wp), PUBLIC ::   bound      !: 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/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_trp_2( kt )
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_trp_2 ***
+      !!                    
+      !! ** purpose : advection/diffusion process of sea ice
+      !!
+      !! ** method  : variables included in the process are scalar,   
+      !!     other values are considered as second order. 
+      !!     For advection, a second order Prather scheme is used.  
+      !!
+      !! ** action :
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   initad       ! number of sub-timestep for the advection
+      REAL(wp) ::   zindb  , zindsn , zindic, zacrith   ! local scalars
+      REAL(wp) ::   zusvosn, zusvoic, zignm , zindhe    !   -      -
+      REAL(wp) ::   zvbord , zcfl   , zusnit            !   -      -
+      REAL(wp) ::   zrtt   , ztsn   , ztic1 , ztic2     !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:)  ::   zui_u , zvi_v , zsm             ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:)  ::   zs0ice, zs0sn , zs0a            !  -      -
+      REAL(wp), POINTER, DIMENSION(:,:)  ::   zs0c0 , zs0c1 , zs0c2 , zs0st   !  -      -
+      !---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st )
+
+      IF( kt == nit000  )   CALL lim_trp_init_2      ! Initialization (first time-step only)
+
+# if defined key_agrif
+      CALL agrif_trp_lim2_load      ! First interpolation
+# endif
+
+      zsm(:,:) = area(:,:)
+      
+      IF( ln_limdyn ) THEN
+         !-------------------------------------!
+         !   Advection of sea ice properties   !
+         !-------------------------------------!
+
+         ! ice velocities at ocean U- and V-points (zui_u,zvi_v)
+         ! ---------------------------------------
+         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._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) ) )
+         !
+         IF(lk_mpp)   CALL mpp_max( zcfl )
+         !
+         IF( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ', zcfl
+
+         ! content of properties
+         ! ---------------------
+         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.
+         zs0c1 (:,:) =  tbif(:,:,2) / rt0_ice  * zs0ice(:,:)  ! Heat content of the first ice layer.
+         zs0c2 (:,:) =  tbif(:,:,3) / rt0_ice  * zs0ice(:,:)  ! Heat content of the second ice layer.
+         zs0st (:,:) =  qstoif(:,:) / xlic     * zs0a  (:,:)  ! Heat reservoir for brine pockets.
+         
+ 
+         ! Advection (Prather scheme)
+         ! ---------
+         initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )   ! If ice drift field is too fast,          
+         zusnit = 1.0 / REAL( initad )                              ! split the ice time step in two
+         !
+         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN        !==  odd ice time step:  adv_x then adv_y  ==!
+            DO jk = 1, initad
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+            END DO
+         ELSE                                                 !==  even ice time step:  adv_x then adv_y  ==!
+            DO jk = 1, initad
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+               CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+            END DO
+         ENDIF
+                        
+         ! recover the properties from their contents
+         ! ------------------------------------------
+!!gm Define in limmsh one for all area = 1 /area  (CPU time saved !)
+         zs0ice(:,:) = zs0ice(:,:) / area(:,:)
+         zs0sn (:,:) = zs0sn (:,:) / area(:,:)
+         zs0a  (:,:) = zs0a  (:,:) / area(:,:)
+         zs0c0 (:,:) = zs0c0 (:,:) / area(:,:)
+         zs0c1 (:,:) = zs0c1 (:,:) / area(:,:)
+         zs0c2 (:,:) = zs0c2 (:,:) / area(:,:)
+         zs0st (:,:) = zs0st (:,:) / area(:,:)
+
+
+         !-------------------------------------!
+         !   Diffusion of sea ice properties   !
+         !-------------------------------------!
+
+         ! Masked eddy diffusivity coefficient at ocean U- and V-points
+         ! ------------------------------------------------------------
+         DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row
+            DO ji = 1 , fs_jpim1   ! vector opt.
+               pahu(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj) ) ) )   &
+                  &        * ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj) ) ) ) * ahiu(ji,jj)
+               pahv(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ) ) ) )   &
+                  &        * ( 1.0 - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1) ) ) ) * ahiv(ji,jj)
+            END DO
+         END DO
+!!gm more readable coding: (and avoid an error in F90 with sign of zero)
+!        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._wp
+!              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0._wp
+!           END DO
+!        END DO
+!!gm end
+
+         ! diffusion
+         ! ---------
+         CALL lim_hdf_2( zs0ice )
+         CALL lim_hdf_2( zs0sn  )
+         CALL lim_hdf_2( zs0a   )
+         CALL lim_hdf_2( zs0c0  )
+         CALL lim_hdf_2( zs0c1  )
+         CALL lim_hdf_2( zs0c2  )
+         CALL lim_hdf_2( zs0st  )
+
+!!gm see comment this can be skipped
+         zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) )    !!bug:  useless
+         zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) )    !!bug:  cf /area  just below
+         zs0a  (:,:) = MAX( rzero, zs0a  (:,:) * area(:,:) )    !! caution: the suppression of the 2 changes 
+         zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) )    !! the last digit of the results
+         zs0c1 (:,:) = MAX( rzero, zs0c1 (:,:) * area(:,:) )
+         zs0c2 (:,:) = MAX( rzero, zs0c2 (:,:) * area(:,:) )
+         zs0st (:,:) = MAX( rzero, zs0st (:,:) * area(:,:) )
+
+
+         !-------------------------------------------------------------------!
+         !   Updating and limitation of sea ice properties after transport   !
+         !-------------------------------------------------------------------!
+         DO jj = 1, jpj
+            zindhe = MAX( 0._wp, SIGN( 1._wp, ff_t(1,jj) ) )              ! = 0 for SH, =1 for NH
+            DO ji = 1, jpi
+               !
+               ! Recover mean values over the grid squares.
+               zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) )
+               zs0ice(ji,jj) = MAX( rzero, zs0ice(ji,jj)/area(ji,jj) )
+               zs0a  (ji,jj) = MAX( rzero, zs0a  (ji,jj)/area(ji,jj) )
+               zs0c0 (ji,jj) = MAX( rzero, zs0c0 (ji,jj)/area(ji,jj) )
+               zs0c1 (ji,jj) = MAX( rzero, zs0c1 (ji,jj)/area(ji,jj) )
+               zs0c2 (ji,jj) = MAX( rzero, zs0c2 (ji,jj)/area(ji,jj) )
+               zs0st (ji,jj) = MAX( rzero, zs0st (ji,jj)/area(ji,jj) )
+
+               ! Recover in situ values.
+               zindb         = MAX( rzero, SIGN( rone, zs0a(ji,jj) - epsi06 ) )
+               zacrith       = 1.0 - ( zindhe * acrit(1) + ( 1.0 - zindhe ) * acrit(2) )
+               zs0a (ji,jj)  = zindb * MIN( zs0a(ji,jj), zacrith )
+               hsnif(ji,jj)  = zindb * ( zs0sn(ji,jj) /MAX( zs0a(ji,jj), epsi16 ) )
+               hicif(ji,jj)  = zindb * ( zs0ice(ji,jj)/MAX( zs0a(ji,jj), epsi16 ) )
+               zindsn        = MAX( rzero, SIGN( rone, hsnif(ji,jj) - epsi06 ) )
+               zindic        = MAX( rzero, SIGN( rone, hicif(ji,jj) - epsi03 ) )
+               zindb         = MAX( zindsn, zindic )
+               zs0a (ji,jj)  = zindb * zs0a(ji,jj)
+               frld (ji,jj)  = 1.0 - zs0a(ji,jj)
+               hsnif(ji,jj)  = zindsn * hsnif(ji,jj)
+               hicif(ji,jj)  = zindic * hicif(ji,jj)
+               zusvosn       = 1.0/MAX( hsnif(ji,jj) * zs0a(ji,jj), epsi16 )
+               zusvoic       = 1.0/MAX( hicif(ji,jj) * zs0a(ji,jj), epsi16 )
+               zignm         = MAX( rzero,  SIGN( rone, hsndif - hsnif(ji,jj) ) )
+               zrtt          = 173.15 * rone 
+               ztsn          =          zignm   * tbif(ji,jj,1)  &
+                              + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) ) 
+               ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c1(ji,jj) ) , tfu(ji,jj) )
+               ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c2(ji,jj) ) , tfu(ji,jj) )
+ 
+               tbif(ji,jj,1) = zindsn * ztsn  + ( 1.0 - zindsn ) * tfu(ji,jj)               
+               tbif(ji,jj,2) = zindic * ztic1 + ( 1.0 - zindic ) * tfu(ji,jj)
+               tbif(ji,jj,3) = zindic * ztic2 + ( 1.0 - zindic ) * tfu(ji,jj)
+               qstoif(ji,jj) = zindb  * xlic * zs0st(ji,jj) /  MAX( zs0a(ji,jj), epsi16 )
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+# if defined key_agrif
+      CALL agrif_trp_lim2      ! Fill boundaries of the fine grid
+# endif
+      ! 
+      CALL wrk_dealloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st )
+      !
+   END SUBROUTINE lim_trp_2
+
+
+   SUBROUTINE lim_trp_init_2
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_trp_init_2  ***
+      !!
+      !! ** Purpose :   initialization of ice advection parameters
+      !!
+      !! ** Method  :   Read the namicetrp namelist and check the parameter 
+      !!              values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicetrp
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicetrp/ bound
+      !!-------------------------------------------------------------------
+                    
+      REWIND( numnam_ice_ref )              ! Namelist namicetrp in reference namelist : Ice advection
+      READ  ( numnam_ice_ref, namicetrp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicetrp in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicetrp in configuration namelist : Ice advection
+      READ  ( numnam_ice_cfg, namicetrp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicetrp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicetrp )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_trp_init_2 : Ice parameters for advection '
+         WRITE(numout,*) '~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   boundary conditions (0. no-slip, 1. free-slip) bound  = ', bound
+      ENDIF
+      !
+   END SUBROUTINE lim_trp_init_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module                No sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_trp_2        ! Empty routine
+   END SUBROUTINE lim_trp_2
+#endif
+
+   !!======================================================================
+END MODULE limtrp_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 8732)
@@ -0,0 +1,366 @@
+MODULE limwri_2
+   !!======================================================================
+   !!                     ***  MODULE  limwri_2  ***
+   !!         Ice diagnostics :  write ice output files
+   !!======================================================================
+   !! history :  2.0  ! 2003-08  (C. Ethe)      original code
+   !!            2.0  ! 2004-10  (C. Ethe )     1D configuration
+   !!             -   ! 2009-06  (B. Lemaire )  iom_put + lim_wri_state_2
+   !!-------------------------------------------------------------------
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   lim_wri_2       : write of the diagnostics variables in ouput file 
+   !!   lim_wri_init_2  : initialization and namelist read
+   !!   lim_wri_state_2 : write for initial state or/and abandon:
+   !!                     > output.init.nc (if ninist = 1 in namelist)
+   !!                     > output.abort.nc
+   !!----------------------------------------------------------------------
+   USE phycst
+   USE dom_oce
+   USE sbc_oce
+   USE sbc_ice
+   USE dom_ice_2
+   USE ice_2
+
+   USE dianam           ! build name of file (routine)
+   USE lbclnk
+   USE in_out_manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE iom
+   USE ioipsl
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+#if ! defined key_iomput
+   PUBLIC   lim_wri_2         ! called by sbc_ice_lim_2
+#endif
+   PUBLIC   lim_wri_state_2   ! called by dia_wri_state 
+   PUBLIC   lim_wri_alloc_2   ! called by nemogcm.F90
+
+   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output
+   INTEGER                                  ::   noumef          ! number of fields
+   REAL(wp)           , DIMENSION(jpnoumax) ::   cmulti ,     &  ! multiplicative constant
+      &                                          cadd            ! additive constant
+   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn            ! title of the field
+   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam             ! name of the field
+   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni             ! unit of the field
+   INTEGER            , DIMENSION(jpnoumax) ::   nc              ! switch for saving field ( = 1 ) or not ( = 0 )
+
+   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ????
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51   ! ????
+
+   REAL(wp) ::   epsi16 = 1.e-16_wp   ! constant values
+   REAL(wp) ::   zzero  = 0._wp       !     -      -
+   REAL(wp) ::   zone   = 1._wp       !     -      -
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zcmo      ! Workspace array for netcdf writer. 
+
+
+   !! * Substitutions
+#   include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lim_wri_alloc_2()
+      !!-------------------------------------------------------------------
+      !!                  ***   ROUTINE lim_wri_alloc_2  ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2)
+      !
+      IF( lk_mpp               )   CALL mpp_sum ( lim_wri_alloc_2 )
+      IF( lim_wri_alloc_2 /= 0 )   CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51')
+      !
+   END FUNCTION lim_wri_alloc_2
+
+
+#if ! defined key_iomput
+   SUBROUTINE lim_wri_2( kt )
+      !!-------------------------------------------------------------------
+      !!                    ***   ROUTINE lim_wri_2  ***
+      !!                
+      !! ** Purpose :   write the sea-ice output file in NetCDF
+      !!
+      !! ** Method  :   computes the average of some variables and write
+      !!      it in the NetCDF ouput files
+      !!      CAUTION: the sea-ice time-step must be an integer fraction
+      !!      of a day
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  ::   ji, jj, jf                      ! dummy loop indices
+      CHARACTER(len = 80)  ::   clhstnam, clop
+      REAL(wp) ::   zsto, zjulian, zout,   &  ! temporary scalars
+         &          zindh, zinda, zindb, ztmu
+      REAL(wp), DIMENSION(1)                ::   zdept
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zfield )
+                                                 !--------------------!
+      IF( kt == nit000 ) THEN                    !   Initialisation   !
+         !                                       !--------------------!
+
+         CALL lim_wri_init_2 
+                           
+         zsto     = rdt_ice
+         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     = nwrite * rdt_ice / nn_fsbc
+         niter    = ( nit000 - 1 ) / nn_fsbc
+         zdept(1) = 0.
+         
+         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
+         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
+         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, snc4chunks=snc4set)
+         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
+         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
+         
+         DO jf = 1, noumef
+            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
+               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
+         END DO
+         CALL histend( nice, snc4set )
+         !
+      ENDIF
+      !                                          !--------------------!
+      !                                          !   Cumulate at kt   !
+      !                                          !--------------------!
+
+      !-- Store instantaneous values in zcmo
+      
+      zcmo(:,:, 1:jpnoumax ) = 0.e0 
+      DO jj = 2 , jpjm1
+         DO ji = 2 , jpim1   ! NO vector opt.
+            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
+            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
+            zindb  = zindh * zinda
+            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
+            zcmo(ji,jj,1)  = hsnif (ji,jj)
+            zcmo(ji,jj,2)  = hicif (ji,jj)
+            zcmo(ji,jj,3)  = hicifp(ji,jj)
+            zcmo(ji,jj,4)  = frld  (ji,jj)
+            zcmo(ji,jj,5)  = sist  (ji,jj)
+            zcmo(ji,jj,6)  = fbif  (ji,jj)
+           IF (lk_lim2_vp) THEN
+            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                                  / ztmu 
+
+            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                                  / ztmu
+           ELSE
+
+            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj)                       &
+             &                        + u_ice(ji-1,jj) * tmu(ji-1,jj) )                   &
+             &                    / 2.0
+            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)                       &
+             &                        + v_ice(ji,jj-1) * tmv(ji,jj-1) )                   &
+             &                    / 2.0
+
+           ENDIF
+            zcmo(ji,jj,9)  = sst_m(ji,jj)
+            zcmo(ji,jj,10) = sss_m(ji,jj)
+            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
+            zcmo(ji,jj,12) = qsr(ji,jj)
+            zcmo(ji,jj,13) = qns(ji,jj)
+            ! See thersf for the coefficient
+            zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
+            zcmo(ji,jj,15) = utau_ice(ji,jj)
+            zcmo(ji,jj,16) = vtau_ice(ji,jj)
+            zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
+            zcmo(ji,jj,18) = qns_ice(ji,jj,1)
+            zcmo(ji,jj,19) = sprecip(ji,jj)
+         END DO
+      END DO
+      !
+      ! Write the netcdf file
+      !
+      niter = niter + 1
+      DO jf = 1 , noumef
+         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1)
+         SELECT CASE ( jf )
+         CASE ( 7, 8, 15, 16, 20, 21 )  ! velocity or stress fields (vectors)
+            CALL lbc_lnk( zfield, 'T', -1. )
+         CASE DEFAULT                   ! scalar fields
+            CALL lbc_lnk( zfield, 'T',  1. )
+         END SELECT
+
+         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
+
+      END DO
+
+      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice ) 
+
+      CALL wrk_dealloc( jpi, jpj, zfield )
+      !
+   END SUBROUTINE lim_wri_2
+
+   SUBROUTINE lim_wri_init_2
+      !!-------------------------------------------------------------------
+      !!                    ***   ROUTINE lim_wri_init_2  ***
+      !!                
+      !! ** Purpose :   intialisation of LIM sea-ice output
+      !!
+      !! ** Method  : Read the namicewri namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicewri
+      !!-------------------------------------------------------------------
+      INTEGER ::   nf      ! ???
+      INTEGER ::   ios     ! Local integer output status for namelist read
+      TYPE FIELD 
+         CHARACTER(len = 35) :: ztitle 
+         CHARACTER(len = 8 ) :: zname          
+         CHARACTER(len = 8 ) :: zunit
+         INTEGER             :: znc   
+         REAL                :: zcmulti 
+         REAL                :: zcadd        
+      END TYPE FIELD
+      TYPE(FIELD) ::  &
+         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
+         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
+         field_13, field_14, field_15, field_16, field_17, field_18,   &
+         field_19
+      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
+
+      NAMELIST/namiceout/ noumef, &
+         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
+         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
+         field_13, field_14, field_15, field_16, field_17, field_18,   &
+         field_19
+      !!-------------------------------------------------------------------
+      !
+      IF( lim_wri_alloc_2() /= 0 ) THEN      ! allocate lim_wri arrrays
+         CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' )   ;   RETURN
+      ENDIF
+                    
+      REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs
+      READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs
+      READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceout )
+      
+      zfield( 1) = field_1
+      zfield( 2) = field_2
+      zfield( 3) = field_3
+      zfield( 4) = field_4
+      zfield( 5) = field_5
+      zfield( 6) = field_6
+      zfield( 7) = field_7
+      zfield( 8) = field_8
+      zfield( 9) = field_9
+      zfield(10) = field_10
+      zfield(11) = field_11
+      zfield(12) = field_12
+      zfield(13) = field_13
+      zfield(14) = field_14
+      zfield(15) = field_15
+      zfield(16) = field_16
+      zfield(17) = field_17
+      zfield(18) = field_18
+      zfield(19) = field_19
+      
+      DO nf = 1, noumef
+         titn  (nf) = zfield(nf)%ztitle
+         nam   (nf) = zfield(nf)%zname
+         uni   (nf) = zfield(nf)%zunit
+         nc    (nf) = zfield(nf)%znc
+         cmulti(nf) = zfield(nf)%zcmulti
+         cadd  (nf) = zfield(nf)%zcadd
+      END DO
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_wri_init_2 : Ice parameters for outputs'
+         WRITE(numout,*) '~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
+         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
+            &            '    multiplicative constant       additive constant '
+         DO nf = 1 , noumef         
+            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
+               &       '        ', cadd(nf)
+         END DO
+      ENDIF
+      !    
+   END SUBROUTINE lim_wri_init_2
+
+#endif
+
+   SUBROUTINE lim_wri_state_2( kt, kid, kh_i )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lim_wri_state_2  ***
+      !!        
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!      the instantaneous ice state and forcing fields for ice model
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! History :
+      !!   2.0  !  2009-06  (B. Lemaire)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
+      INTEGER, INTENT( in ) ::   kid , kh_i       
+      !!----------------------------------------------------------------------
+
+      CALL histdef( kid, "isnowthi", "Snow thickness"          , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iiceprod", "Ice produced"            , "m/kt"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "ileadfra", "Ice concentration"       , "-"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicetemp", "Ice temperature"         , "K"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "isstempe", "Sea surface temperature" , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "isssalin", "Sea surface salinity"    , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicesflx", "Solar flux over ice"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicenflx", "Non-solar flux over ice" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      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, snc4set )   ! end of the file definition
+
+      CALL histwrite( kid, "isnowthi", kt, hsnif          , jpi*jpj, (/1/) )   
+      CALL histwrite( kid, "iicethic", kt, hicif          , jpi*jpj, (/1/) )    
+      CALL histwrite( kid, "iiceprod", kt, hicifp         , jpi*jpj, (/1/) )   
+      CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "isstempe", kt, sst_m          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "isssalin", kt, sss_m          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicesflx", kt, qsr_ice(:,:,1) , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "iicenflx", kt, qns_ice(:,:,1) , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
+
+    END SUBROUTINE lim_wri_state_2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_wri_2          ! Empty routine
+   END SUBROUTINE lim_wri_2
+#endif
+
+   !!======================================================================
+END MODULE limwri_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90	(revision 8732)
@@ -0,0 +1,30 @@
+MODULE par_ice_2
+   !!======================================================================
+   !!                       ***  MODULE par_ice_2   ***
+   !! Sea-Ice model : definition of the parameters
+   !!======================================================================
+#if defined key_lim2
+   !!----------------------------------------------------------------------
+   !!  'key_lim2'                                       LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_oce
+
+   IMPLICIT NONE
+   PUBLIC               ! allows par_oce and par_kind to be known in ice modules
+
+   INTEGER, PUBLIC, PARAMETER ::   jpl        = 1              !: number of ice categories (only 1 in LIM-2)
+
+   INTEGER, PUBLIC, PARAMETER ::   jplayers   = 2              !: number of vertical ice layers
+   INTEGER, PUBLIC, PARAMETER ::   jplayersp1 = jplayers + 1   !: ???
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Default option                                No LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_ice_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 8732)
@@ -0,0 +1,129 @@
+MODULE thd_ice_2
+#if defined key_lim2
+   !!======================================================================
+   !!                       ***  MODULE thd_ice_2  ***
+   !! LIM 2.0 sea-ice :   Ice thermodynamics in 1D
+   !!=====================================================================
+   !! History :
+   !!   2.0  !  02-11  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE par_ice_2
+   USE ice_2
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90
+
+   !! * Share Module variables
+   REAL(wp) , PUBLIC ::   & !!! ** ice-thermo namelist (namicethd) **
+      hmelt            ,  &  !: maximum melting at the bottom
+      hicmin           ,  &  !: ice th. corr. to max. ener. in brine pocket
+      hiclim           ,  &  !: minimum ice thickness
+      amax             ,  &  !: maximum lead fraction
+      swiqst           ,  &  !: energy stored in brine pocket (1) or not (0)
+      sbeta            ,  &  !: numerical scheme for diffusion in ice 
+      parlat           ,  &  !: percent. of energy used for lateral ablation
+      hakspl           ,  &  !: slope of distr. for Hakkinen-Mellro's lat. melt
+      hibspl           ,  &  !: slope of distribution for Hibler's lat. melt
+      exld             ,  &  !: exponent for leads-closure rate
+      hakdif           ,  &  !: coefficient for diffusions of ice and snow
+      thth             ,  &  !: thick. for comp. of eq. thermal conduct
+      hnzst            ,  &  !: thick. of the surf. layer in temp. comp.
+      parsub           ,  &  !: switch for snow sublimation or not
+      alphs                  !: coef. for snow density when snow-ice formation
+
+   REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !:   
+      hiccrit                !: ice th. for lateral accretion in the NH (SH) (m)
+
+   REAL(wp) , PUBLIC ::   &  !:
+      uscomi,             &  !: inverse of minimum lead fraction
+      cnscg                  !: ratio  rcpsn/rcpic
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:
+      npb     ,   &   !: number of points where computations has to be done
+      npac            !: correspondance between the points
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
+      qldif_1d    ,     &  !: corresponding to the 2D var  qldif
+      qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif
+      thcm_1d     ,     &  !:    "                  "      thcm
+      fstbif_1d   ,     &  !:    "                  "      fstric
+      fltbif_1d   ,     &  !:    "                  "      ffltbif
+      fscbq_1d    ,     &  !:    "                  "      fscmcbq
+      qsr_ice_1d  ,     &  !:    "                  "      qsr_ice
+      fr1_i0_1d   ,     &  !:    "                  "      fr1_i0
+      fr2_i0_1d   ,     &  !:    "                  "      fr2_i0
+      qns_ice_1d  ,     &  !:    "                  "      qns_ice
+      qfvbq_1d    ,     &  !:    "                  "      qfvbq
+      sist_1d     ,     &  !:    "                  "      sist
+      tfu_1d      ,     &  !:    "                  "      tfu
+      sprecip_1d  ,     &  !:    "                  "      sprecip
+      h_snow_1d   ,     &  !:    "                  "      h_snow
+      h_ice_1d    ,     &  !:    "                  "      h_ice
+      frld_1d     ,     &  !:    "                  "      frld
+      qstbif_1d   ,     &  !:    "                  "      qstoif
+      fbif_1d     ,     &  !:    "                  "      fbif
+      rdm_ice_1d  ,     &  !:    "                  "      rdm_ice
+      rdq_ice_1d  ,     &  !:    "                  "      rdq_ice
+      rdm_snw_1d  ,     &  !:    "                  "      rdm_snw
+      rdq_snw_1d  ,     &  !:    "                  "      rdq_snw
+      qlbbq_1d    ,     &  !:    "                  "      qlbsbq
+      dmgwi_1d    ,     &  !:    "                  "      dmgwi
+      dvsbq_1d    ,     &  !:    "                  "      rdvosif
+      rdvomif_1d  ,     &  !:    "                  "      rdvomif
+      dvbbq_1d    ,     &  !:    "                  "      rdvobif
+      dvlbq_1d    ,     &  !:    "                  "      rdvolif
+      dvnbq_1d    ,     &  !:    "                  "      rdvolif
+      dqns_ice_1d ,     &  !:    "                  "      dqns_ice
+      qla_ice_1d  ,     &  !:    "                  "      qla_ice
+      dqla_ice_1d          !:    "                  "      dqla_ice
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !:
+      tbif_1d              !: corresponding to the 2D var  tbif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+ CONTAINS
+
+   INTEGER FUNCTION thd_ice_alloc_2()
+      !!----------------------------------------------------------------------
+      USE lib_mpp        ! MPP library
+      INTEGER :: ierr(5)
+      !!----------------------------------------------------------------------
+      !
+      ierr(:) = 0
+      !
+      ALLOCATE( npb(jpij), npac(jpij),                             &
+         &      qldif_1d(jpij), qcmif_1d(jpij), thcm_1d(jpij),     &
+         &      fstbif_1d(jpij), fltbif_1d(jpij), fscbq_1d(jpij),  &
+         &      qsr_ice_1d(jpij),fr1_i0_1d(jpij), fr2_i0_1d(jpij), Stat=ierr(1))
+         !
+      ALLOCATE( qns_ice_1d(jpij), qfvbq_1d(jpij), sist_1d(jpij), tfu_1d(jpij), &
+         &      sprecip_1d(jpij), h_snow_1d(jpij),h_ice_1d(jpij),frld_1d(jpij),&
+         &      qstbif_1d(jpij),  fbif_1d(jpij),  Stat=ierr(2))
+         !
+      ALLOCATE( rdm_ice_1d(jpij), rdq_ice_1d(jpij)                  , &
+         &      rdm_snw_1d(jpij), rdq_snw_1d(jpij), qlbbq_1d(jpij)  , &
+         &      dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , rdvomif_1d(jpij), &
+         &      dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , &
+         &      Stat=ierr(3))
+         !
+      ALLOCATE( dqns_ice_1d(jpij) ,qla_ice_1d(jpij), dqla_ice_1d(jpij), &
+         &      tbif_1d(jpij, jplayersp1), Stat=ierr(4))
+         !
+      thd_ice_alloc_2 = MAXVAL(ierr)
+      IF( thd_ice_alloc_2 /= 0 )   CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays')
+      !
+   END FUNCTION thd_ice_alloc_2
+
+#endif
+   !!======================================================================
+END MODULE thd_ice_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 8732)
@@ -0,0 +1,558 @@
+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
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC    ice_alloc  !  Called in sbc_lim_init
+
+   !!======================================================================
+   !! LIM3 by the use of sweat, agile fingers and sometimes brain juice, 
+   !!  was developed in Louvain-la-Neuve by : 
+   !!    * Martin Vancoppenolle (UCL-ASTR, Belgium)
+   !!    * Sylvain Bouillon (UCL-ASTR, Belgium)
+   !!    * Miguel Angel Morales Maqueda (NOC-L, UK)
+   !! 
+   !! Based on extremely valuable earlier work by
+   !!    * Thierry Fichefet
+   !!    * Hugues Goosse
+   !!
+   !! The following persons also contributed to the code in various ways
+   !!    * Gurvan Madec, Claude Talandier, Christian Ethe (LOCEAN, France)
+   !!    * Xavier Fettweis (UCL-ASTR), Ralph Timmermann (AWI, Germany)
+   !!    * Bill Lipscomb (LANL), Cecilia Bitz (UWa) 
+   !!      and Elisabeth Hunke (LANL), USA.
+   !! 
+   !! For more info, the interested user is kindly invited to consult the following references
+   !!    For model description and validation :
+   !!    * Vancoppenolle et al., Ocean Modelling, 2008a.
+   !!    * Vancoppenolle et al., Ocean Modelling, 2008b.
+   !!    For a specific description of EVP :
+   !!    * Bouillon et al., Ocean Modelling 2009.
+   !!
+   !!    Or the reference manual, that should be available by 2011
+   !!======================================================================
+   !!                                                                     |
+   !!              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     |
+   !! thickness, the ice cover in divided in ice thickness categories.    |
+   !!                                                                     |
+   !! Sea ice state variables depend on the ice thickness category        |
+   !!                                                                     |
+   !! Those variables are divided into two groups                         |
+   !! * Extensive (or global) variables.                                  |
+   !!   These are the variables that are transported by all means         |
+   !! * Intensive (or equivalent) variables.                              |
+   !!   These are the variables that are either physically more           |
+   !!   meaningful and/or used in ice thermodynamics                      |
+   !!                                                                     |
+   !! Routines in limvar.F90 perform conversions                          |
+   !!  - lim_var_glo2eqv  : from global to equivalent variables           |
+   !!  - lim_var_eqv2glo  : from equivalent to global variables           |
+   !!                                                                     |
+   !! For various purposes, the sea ice state variables have sometimes    |
+   !! to be aggregated over all ice thickness categories. This operation  |
+   !! is done in :                                                        |
+   !!  - lim_var_agg                                                      |
+   !!                                                                     |
+   !! in icestp.F90, the routines that compute the changes in the ice     |
+   !! state variables are called                                          |
+   !! - lim_dyn : ice dynamics                                            |
+   !! - lim_trp : ice transport                                           |
+   !! - lim_itd_me : mechanical redistribution (ridging and rafting)      |
+   !! - lim_thd : ice halo-thermodynamics                                 |
+   !! - lim_itd_th : thermodynamic changes in ice thickness distribution  |
+   !!                and creation of new ice                              |
+   !!                                                                     |
+   !! See the associated routines for more information                    |
+   !!                                                                     |
+   !! List of ice state variables :                                       |
+   !! -----------------------------                                       |
+   !!                                                                     |
+   !!-------------|-------------|---------------------------------|-------|
+   !!   name in   |   name in   |              meaning            | units |
+   !! 2D routines | 1D routines |                                 |       |
+   !!-------------|-------------|---------------------------------|-------|
+   !!                                                                     |
+   !! ******************************************************************* |
+   !! ***         Dynamical variables (prognostic)                    *** |
+   !! ******************************************************************* |
+   !!                                                                     |
+   !! u_ice       |      -      |    Comp. U of the ice velocity  | m/s   |
+   !! v_ice       |      -      |    Comp. V of the ice velocity  | m/s   |
+   !!                                                                     |
+   !! ******************************************************************* |
+   !! ***         Category dependent state variables (prognostic)     *** |
+   !! ******************************************************************* |
+   !!                                                                     |
+   !! ** Global variables                                                 |
+   !!-------------|-------------|---------------------------------|-------|
+   !! a_i         | a_i_1d      |    Ice concentration            |       |
+   !! v_i         |      -      |    Ice volume per unit area     | m     |
+   !! v_s         |      -      |    Snow volume per unit area    | m     |
+   !! smv_i       |      -      |    Sea ice salt content         | ppt.m |
+   !! oa_i        !      -      !    Sea ice areal age content    | day   |
+   !! e_i         !      -      !    Ice enthalpy                 | J/m2  | 
+   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  | 
+   !! e_s         !      -      !    Snow enthalpy                | J/m2  | 
+   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  | 
+   !!                                                                     |
+   !!-------------|-------------|---------------------------------|-------|
+   !!                                                                     |
+   !! ** Equivalent variables                                             |
+   !!-------------|-------------|---------------------------------|-------|
+   !!                                                                     |
+   !! ht_i        | ht_i_1d     |    Ice thickness                | m     |
+   !! ht_s        ! ht_s_1d     |    Snow depth                   | m     |
+   !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   |
+   !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   |
+   !! o_i         !      -      |    Sea ice Age                  ! days  |
+   !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     |
+   !! t_s         ! t_s_1d      |    Snow temperature             ! K     |
+   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     |
+   !!                                                                     |
+   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   |
+   !!        salinity, except in thermodynamic computations, for which    |
+   !!        the salinity profile is computed as a function of bulk       |
+   !!        salinity                                                     |
+   !!                                                                     |
+   !!        the sea ice surface temperature is not associated to any     |
+   !!        heat content. Therefore, it is not a state variable and      |
+   !!        does not have to be advected. Nevertheless, it has to be     |
+   !!        computed to determine whether the ice is melting or not      |
+   !!                                                                     |
+   !! ******************************************************************* |
+   !! ***         Category-summed state variables (diagnostic)        *** |
+   !! ******************************************************************* |
+   !! at_i        | at_i_1d     |    Total ice concentration      |       |
+   !! vt_i        |      -      |    Total ice vol. per unit area | m     |
+   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     |
+   !! smt_i       |      -      |    Mean sea ice salinity        | ppt   |
+   !! tm_i        |      -      |    Mean sea ice temperature     | K     |
+   !! et_i        !      -      !    Total ice enthalpy           | J/m2  | 
+   !! et_s        !      -      !    Total snow enthalpy          | J/m2  | 
+   !! bv_i        !      -      !    relative brine volume        | ???   | 
+   !!=====================================================================
+
+   LOGICAL, PUBLIC ::   con_i = .false.   ! switch for conservation test
+
+   !!--------------------------------------------------------------------------
+   !! * Share Module variables
+   !!--------------------------------------------------------------------------
+   !                                     !!** ice-generic parameters namelist (namicerun) **
+   INTEGER           , PUBLIC ::   jpl             !: number of ice  categories 
+   INTEGER           , PUBLIC ::   nlay_i          !: number of ice  layers 
+   INTEGER           , PUBLIC ::   nlay_s          !: number of snow layers 
+   REAL(wp)          , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere
+   REAL(wp)          , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere
+   CHARACTER(len=32) , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
+   CHARACTER(len=32) , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
+   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory
+   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory
+   LOGICAL           , PUBLIC ::   ln_limthd       !: flag for ice thermo (T) or not (F)
+   LOGICAL           , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
+   INTEGER           , PUBLIC ::   nn_limdyn       !: flag for ice dynamics
+   REAL(wp)          , PUBLIC ::   rn_uice         !: prescribed u-vel (case nn_limdyn=0)
+   REAL(wp)          , PUBLIC ::   rn_vice         !: prescribed v-vel (case nn_limdyn=0)
+   
+   !                                     !!** ice-diagnostics namelist (namicediag) **
+   LOGICAL , PUBLIC ::   ln_limdiachk     !: flag for ice diag (T) or not (F)
+   LOGICAL , PUBLIC ::   ln_limdiahsb     !: flag for ice diag (T) or not (F)
+   LOGICAL , PUBLIC ::   ln_limctl        !: flag for sea-ice points output (T) or not (F)
+   INTEGER , PUBLIC ::   iiceprt          !: debug i-point
+   INTEGER , PUBLIC ::   jiceprt          !: debug j-point
+
+   !                                     !!** ice-init namelist (namiceini) **
+                                          ! -- limistate -- !
+   LOGICAL , PUBLIC ::   ln_limini        ! initialization or not
+   LOGICAL , PUBLIC ::   ln_limini_file   ! Ice initialization state from 2D netcdf file
+   REAL(wp), PUBLIC ::   rn_thres_sst     ! threshold water temperature for initial sea ice
+   REAL(wp), PUBLIC ::   rn_hts_ini_n     ! initial snow thickness in the north
+   REAL(wp), PUBLIC ::   rn_hts_ini_s     ! initial snow thickness in the south
+   REAL(wp), PUBLIC ::   rn_hti_ini_n     ! initial ice thickness in the north
+   REAL(wp), PUBLIC ::   rn_hti_ini_s     ! initial ice thickness in the south
+   REAL(wp), PUBLIC ::   rn_ati_ini_n     ! initial leads area in the north
+   REAL(wp), PUBLIC ::   rn_ati_ini_s     ! initial leads area in the south
+   REAL(wp), PUBLIC ::   rn_smi_ini_n     ! initial salinity 
+   REAL(wp), PUBLIC ::   rn_smi_ini_s     ! initial salinity
+   REAL(wp), PUBLIC ::   rn_tmi_ini_n     ! initial temperature
+   REAL(wp), PUBLIC ::   rn_tmi_ini_s     ! initial temperature
+   
+   !                                     !!** ice-thickness distribution namelist (namiceitd) **
+   INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2)
+   REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)
+
+   !                                     !!** ice-dynamics namelist (namicedyn) **
+                                          ! -- limtrp & limadv -- !
+   INTEGER , PUBLIC ::   nn_limadv        !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho)
+   INTEGER , PUBLIC ::   nn_limadv_ord    !: choose the order of the advection scheme (if Ultimate-Macho)   
+                                          ! -- limitd_me -- !
+   INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75)
+   REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1
+   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength, Hibler JPO79
+   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength
+   LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength
+                                          ! -- limdyn & limrhg -- !
+   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9
+   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve
+   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling
+   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
+   LOGICAL , PUBLIC ::   ln_landfast      !: landfast ice parameterization (T or F) 
+   REAL(wp), PUBLIC ::   rn_gamma         !: fraction of ocean depth that ice must reach to initiate landfast ice
+   REAL(wp), PUBLIC ::   rn_icebfr        !: maximum bottom stress per unit area of contact (landfast ice) 
+   REAL(wp), PUBLIC ::   rn_lfrelax       !: relaxation time scale (s-1) to reach static friction (landfast ice) 
+
+   !                                     !!** ice-diffusion namelist (namicehdf) **
+   INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)
+   REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+
+   !                                     !!** ice-thermodynamics namelist (namicethd) **
+                                          ! -- limthd_dif -- !
+   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion
+   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion
+   INTEGER , PUBLIC ::   nn_ice_thcon     !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+   LOGICAL , PUBLIC ::   ln_it_qnsice     !: iterate surface flux with changing surface temperature or not (F)
+   INTEGER , PUBLIC ::   nn_monocat       !: virtual ITD mono-category parameterizations (1) or not (0)
+   REAL(wp), PUBLIC ::   rn_cdsn          !: thermal conductivity of the snow [W/m/K]
+                                          ! -- limthd_dh -- !
+   LOGICAL , PUBLIC ::   ln_limdH         !: activate ice thickness change from growing/melting (T) or not (F)
+   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice
+                                          ! -- limthd_da -- !
+   LOGICAL , PUBLIC ::   ln_limdA         !: activate lateral melting param. (T) or not (F)
+   REAL(wp), PUBLIC ::   rn_beta          !: coef. beta for lateral melting param.
+   REAL(wp), PUBLIC ::   rn_dmin          !: minimum floe diameter for lateral melting param.
+                                          ! -- limthd_lac -- !
+   LOGICAL , PUBLIC ::   ln_limdO         !: activate ice growth in open-water (T) or not (F)
+   REAL(wp), PUBLIC ::   rn_hnewice       !: thickness for new ice formation (m)
+   LOGICAL , PUBLIC ::   ln_frazil        !: use of frazil ice collection as function of wind (T) or not (F)
+   REAL(wp), PUBLIC ::   rn_maxfrazb      !: maximum portion of frazil ice collecting at the ice bottom
+   REAL(wp), PUBLIC ::   rn_vfrazb        !: threshold drift speed for collection of bottom frazil ice
+   REAL(wp), PUBLIC ::   rn_Cfrazb        !: squeezing coefficient for collection of bottom frazil ice
+                                          ! -- limitd_th -- !
+   REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness
+
+   !                                     !!** ice-salinity namelist (namicesal) **
+   LOGICAL , PUBLIC ::   ln_limdS         !: activate gravity drainage and flushing (T) or not (F)
+   INTEGER , PUBLIC ::   nn_icesal        !: salinity configuration used in the model
+   !                                      ! 1 - constant salinity in both space and time
+   !                                      ! 2 - prognostic salinity (s(z,t))
+   !                                      ! 3 - salinity profile, constant in time
+   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity
+   REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU]
+   REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s]
+   REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU]
+   REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s]
+   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU]
+
+   !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
+   REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging            
+   INTEGER , PUBLIC ::   nn_partfun       !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
+   REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging
+   REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function
+   LOGICAL , PUBLIC ::   ln_ridging       !: ridging of ice or not                        
+   REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice
+   REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value)
+   REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging
+   LOGICAL , PUBLIC ::   ln_rafting       !: rafting of ice or not                        
+   REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging 
+   REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting
+   REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging
+
+   !                                     !!** some other parameters 
+   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 ::   rdt_ice          !: ice time step
+   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice
+   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i
+   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s 
+   REAL(wp), PUBLIC ::   rswitch          !: switch for the presence of ice (1) or not (0)
+   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number 
+   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number 
+   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number 
+
+   !                                     !!** define arrays
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce !: surface ocean velocity used in ice dynamics
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicol       !: ice collection thickness accreted in leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i     !: ice rheology elta factor (Flato & Hibler 95) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i      !: Divergence of the velocity field [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i     !: Shear of the velocity field [s-1]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: snow-ocean mass exchange   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice  [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: snow/ice sublimation       [kg.m-2.s-1]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: ice-ocean mass exchange                   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: snow ice growth component of wfx_ice      [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: lateral ice growth component of wfx_ice   [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: bottom ice growth component of wfx_ice    [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: dynamical ice growth component of wfx_ice [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: bottom melt component of wfx_ice          [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: surface melt component of wfx_ice         [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_lam     !: lateral melt component of wfx_ice         [kg.m-2.s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: residual component of wfx_ice             [kg.m-2.s-1]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics)       [s-1]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_lam     !: salt flux due to ice growth/melt                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                      [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sub     !: salt flux due to ice sublimation
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth        [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt          [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt         [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice   [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                          [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion             [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping             [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations   [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1]
+   
+   ! heat flux associated with ice-atmosphere mass exchange
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  [W.m-2]
+
+   ! heat flux associated with ice-ocean mass exchange
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  [W.m-2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points
+
+   !!--------------------------------------------------------------------------
+   !! * Ice global state variables
+   !!--------------------------------------------------------------------------
+   !! Variables defined for each ice category
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i      !: Ice thickness (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area(m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s      !: Snow thickness (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature (K)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i      !: Sea-Ice Bulk salinity (ppt)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m)
+   !                                                                    !  this is an extensive variable that has to be transported
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (days)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (days)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume
+
+   !! Variables summed over all categories, or associated to all the ice in a single grid cell
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity (m/s)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s  !: ice and snow total heat content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i        !: mean sea ice salinity averaged over all categories [PSU]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_i        !: mean ice  thickness over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_s        !: mean snow thickness over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction with bathy (landfast param activated)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow ...      
+      
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures          [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice thermal contents    [J/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i      !: ice salinities          [PSU]
+
+   !!--------------------------------------------------------------------------
+   !! * Moments for advection
+   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   !: open water in sea ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   !: ice thickness 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    !: snow thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     !: lead fraction
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    !: snow thermal content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   !: ice salinity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   !: ice age
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     !: ice layers heat content
+
+   !!--------------------------------------------------------------------------
+   !! * Old values of global variables
+   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total)
+            
+   !!--------------------------------------------------------------------------
+   !! * Ice thickness distribution variables
+   !!--------------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
+   !
+   !!--------------------------------------------------------------------------
+   !! * Ice diagnostics
+   !!--------------------------------------------------------------------------
+   ! thd refers to changes induced by thermodynamics
+   ! trp   ''         ''     ''       advection (transport of ice)
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vi   !: transport of ice volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_vs   !: transport of snw volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   [] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s] 
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION ice_alloc()
+      !!-----------------------------------------------------------------
+      !!               *** Routine ice_alloc ***
+      !!-----------------------------------------------------------------
+      INTEGER :: ice_alloc
+      !
+      INTEGER :: ierr(15), ii
+      !!-----------------------------------------------------------------
+
+      ierr(:) = 0
+
+      ! What could be one huge allocate statement is broken-up to try to
+      ! stay within Fortran's max-line length limit.
+      ii = 1
+      ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) ,                                             &
+         &      ahiu    (jpi,jpj) , ahiv     (jpi,jpj) , hicol    (jpi,jpj) ,                        &
+         &      strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,  &
+         &      delta_i (jpi,jpj) , divu_i   (jpi,jpj) , shear_i  (jpi,jpj) , STAT=ierr(ii) )
+
+      ii = ii + 1
+      ALLOCATE( t_bo   (jpi,jpj) , frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,     &
+         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) ,     &
+         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     &
+         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     &
+         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj),   &
+         &      fhtur  (jpi,jpj) , qlead  (jpi,jpj) ,                                           &
+         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  &
+         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  &
+         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     & 
+         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld   (jpi,jpj) ,                        &
+         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     &
+         &      hfx_opw(jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     &
+         &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)        ,  STAT=ierr(ii) )
+
+      ! * Ice global state variables
+      ii = ii + 1
+      ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , &
+         &      ht_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     &
+         &      v_s    (jpi,jpj,jpl) , ht_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     &
+         &      sm_i   (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     &
+         &      oa_i   (jpi,jpj,jpl) , bv_i  (jpi,jpj,jpl) ,  STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) ,                                       &
+         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) ,     &
+         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) ,     &
+         &      smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) ,     &
+         &      om_i (jpi,jpj) , tau_icebfr(jpi,jpj)                              , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
+
+      ! * Moments for advection
+      ii = ii + 1
+      ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   &
+         &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   &
+         &      STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( sxa  (jpi,jpj,jpl) , sya  (jpi,jpj,jpl) , sxxa  (jpi,jpj,jpl) , syya  (jpi,jpj,jpl) , sxya  (jpi,jpj,jpl) ,   &
+         &      sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) ,   &
+         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   &
+         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   &
+         &      STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     &
+         &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) )
+
+      ! * Old values of global variables
+      ii = ii + 1
+      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     &
+         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     &
+         &      oa_i_b (jpi,jpj,jpl)                                                    , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) )
+      
+      ! * Ice thickness distribution variables
+      ii = ii + 1
+      ALLOCATE( hi_max(0:jpl), hi_mean(jpl),  STAT=ierr(ii) )
+
+      ! * Ice diagnostics
+      ii = ii + 1
+      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),   & 
+         &      diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat  (jpi,jpj),   &
+         &      diag_smvi  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) )
+
+      ice_alloc = MAXVAL( ierr(:) )
+      IF( ice_alloc /= 0 )   CALL ctl_warn('ice_alloc: failed to allocate arrays.')
+      !
+   END FUNCTION ice_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE ice
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limadv_prather.F90	(revision 8732)
@@ -0,0 +1,418 @@
+MODULE limadv_prather 
+   !!======================================================================
+   !!                       ***  MODULE limadv_prather   ***
+   !! LIM sea-ice model : sea-ice advection => Prather scheme
+   !!======================================================================
+   !! History :  LIM  ! 2008-03 (M. Vancoppenolle)  LIM-3 from LIM-2 code
+   !!            3.2  ! 2009-06 (F. Dupont)  correct a error in the North fold b. c.
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!--------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                     LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_adv_x  : advection of sea ice on x axis
+   !!   lim_adv_y  : advection of sea ice on y axis
+   !!----------------------------------------------------------------------
+   USE dom_oce          ! ocean domain
+   USE ice              ! LIM-3 variables
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE lib_fortran      ! to use key_nosignedzero
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_adv_x   ! called by lim_trp
+   PUBLIC   lim_adv_y   ! called by lim_trp
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limadv.F90 6746 2016-06-27 17:20:57Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_adv_x( pdf, put , pcrh, psm , ps0 ,   &
+      &                  psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine lim_adv_x  **
+      !!  
+      !! ** purpose :   Computes and adds the advection trend to sea-ice
+      !!              variable on i-axis
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects tracers
+      !!              but also theirquadratic forms. The method preserves
+      !!              tracer structures by conserving second order moments.
+      !!
+      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
+      !!--------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
+      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   put                ! i-direction ice velocity at U-point [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
+      !! 
+      INTEGER  ::   ji, jj                               ! dummy loop indices
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zf0 , zfx  , zfy   , zbet   ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfm , zfxx , zfyy  , zfxy   !  -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zalg, zalg1, zalg1q         !  -      -
+      !---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+
+      ! Limitation of moments.                                           
+
+      zrdt = rdt_ice * pdf      ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( 0._wp, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) )
+            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
+               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = zs1new      * rswitch
+            psxx(ji,jj) = zs2new      * rswitch
+            psy (ji,jj) = psy (ji,jj) * rswitch
+            psyy(ji,jj) = psyy(ji,jj) * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+
+      !  Calculate fluxes and moments between boxes i<-->i+1              
+      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0 
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
+            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  *   psm (ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj) )  )
+            zfx (ji,jj)  =  zalfq * ( psx (ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )
+            zfxx(ji,jj)  =  zalf  *   psxx(ji,jj) * zalfq
+            zfy (ji,jj)  =  zalf  * ( psy (ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq *   psxy(ji,jj)
+            zfyy(ji,jj)  =  zalf  *   psyy(ji,jj)
+
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psx (ji,jj)  =  zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )
+            psxx(ji,jj)  =  zalf1  * zalf1q * psxx(ji,jj)
+            psy (ji,jj)  =  psy (ji,jj) - zfy(ji,jj)
+            psyy(ji,jj)  =  psyy(ji,jj) - zfyy(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0.
+         DO ji = 1, fs_jpim1
+            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            !
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji+1,jj)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )
+            zfx   (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji+1,jj) * zalfq
+            zfy   (ji,jj) = zfy (ji,jj) + zalf  * ( psy (ji+1,jj) - zalf1 * psxy(ji+1,jj) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji+1,jj)
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji+1,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            !
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )
+            psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )
+            psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)
+            psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )
+            psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)
+            zalf        = zbt * zfm(ji-1,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)
+            !
+            ps0 (ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj)
+            psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)
+            psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj)                               &
+               &                + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  )   &
+               &                                                + zbt1 * psxx(ji,jj)
+            psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj)             &
+               &                + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj) ) )   &
+               &                                                + zbt1 * psxy(ji,jj)
+            psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)
+            psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Flux from i+1 to i IF u LT 0.
+         DO ji = fs_2, fs_jpim1
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj)  = zbt * psm(ji,jj)  + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = - zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
+            !
+            ps0(ji,jj)  = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
+            psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( zalf * zalf * zfxx(ji,jj)  + zalf1 * zalf1 * psxx(ji,jj)  &
+               &                                      + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) )      &
+               &                                      + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)  &
+               &                                      + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) )  )
+            psy(ji,jj)  = zbt * psy (ji,jj)  + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj)  + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   &
+         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1., psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_x: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
+         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_x: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
+         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_x: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
+         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :')
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+      !
+   END SUBROUTINE lim_adv_x
+
+
+   SUBROUTINE lim_adv_y( pdf, pvt , pcrh, psm , ps0 ,   &
+      &                  psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine lim_adv_y  **
+      !!            
+      !! ** purpose :   Computes and adds the advection trend to sea-ice 
+      !!              variable on y axis
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects tracers
+      !!              but also their quadratic forms. The method preserves 
+      !!              tracer structures by conserving second order moments.
+      !! 
+      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681.
+      !!---------------------------------------------------------------------
+      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step
+      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvt                ! j-direction ice velocity at V-point [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
+      !!
+      INTEGER  ::   ji, jj                               ! dummy loop indices
+      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars
+      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         -
+      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zf0, zfx , zfy , zbet   ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfm, zfxx, zfyy, zfxy   !  -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zalg, zalg1, zalg1q     !  -      -
+      !---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_alloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+
+      ! Limitation of moments.
+
+      zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( 0._wp, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) )
+            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
+               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
+            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
+            !
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = psx (ji,jj) * rswitch
+            psxx(ji,jj) = psxx(ji,jj) * rswitch
+            psy (ji,jj) = zs1new * rswitch
+            psyy(ji,jj) = zs2new * rswitch
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
+      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  )
+
+      !  Calculate fluxes and moments between boxes j<-->j+1              
+      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0   
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
+            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            !
+            zfm (ji,jj)  =  zalf  * psm(ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) ) 
+            zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) )
+            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj)
+            zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
+            zfxx(ji,jj)  =  zalf  * psxx(ji,jj)
+            !
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) )
+            psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj)
+            psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj)
+            psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+      !
+      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
+         DO ji = 1, jpi
+            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            !
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji,jj+1)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) )
+            zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) )
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji,jj+1) * zalfq
+            zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx (ji,jj+1) - zalf1 * psxy(ji,jj+1) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji,jj+1)
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji,jj+1)
+         END DO
+      END DO
+
+      !  Readjust moments remaining in the box. 
+      DO jj = 2, jpj
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            !
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) )
+            psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) )
+            psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj)
+            psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) )
+            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) )
+            psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj-1)
+            zbt1 = ( 1.0 - zbet(ji,jj-1) )
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 
+            zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj) 
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1)
+            !
+            ps0(ji,jj)  = zbt  * ( ps0(ji,jj) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj)
+            psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   &
+               &                                               + zbt1 * psy(ji,jj)  
+            psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             &
+               &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   & 
+               &                                               + zbt1 * psyy(ji,jj)
+            psxy(ji,jj) = zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)               &
+               &                  + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) )  )   &
+               &                                                + zbt1 * psxy(ji,jj)
+            psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj)
+            psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0.
+         DO ji = 1, jpi
+            zbt  =         zbet(ji,jj)
+            zbt1 = ( 1.0 - zbet(ji,jj) )
+            psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = - zalf * ps0 (ji,jj) + zalf1 * zf0(ji,jj)
+            ps0 (ji,jj) =   zbt  * ps0 (ji,jj) + zbt1  * ( ps0(ji,jj) + zf0(ji,jj) )
+            psy (ji,jj) =   zbt  * psy (ji,jj) + zbt1  * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp )
+            psyy(ji,jj) =   zbt  * psyy(ji,jj) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   &
+               &                                         + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) )          &
+               &                                         + ( zalf1 - zalf ) * ztemp )                                )
+            psxy(ji,jj) =   zbt  * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)       &
+               &                                         + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) )  )
+            psx (ji,jj) =   zbt  * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) )
+            psxx(ji,jj) =   zbt  * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   &
+         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes
+         &              , psxx, 'T',  1.,  psyy, 'T',  1.   &
+         &              , psxy, 'T',  1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_y: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ')
+         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_y: psx  :', tab2d_2=psxx, clinfo2=' psxx : ')
+         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_y: psy  :', tab2d_2=psyy, clinfo2=' psyy : ')
+         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_y: psxy :')
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zf0 , zfx , zfy , zbet, zfm )
+      CALL wrk_dealloc( jpi, jpj, zfxx, zfyy, zfxy, zalg, zalg1, zalg1q )
+      !
+   END SUBROUTINE lim_adv_y
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy module         NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limadv_prather
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90	(revision 8732)
@@ -0,0 +1,587 @@
+MODULE limadv_umx
+   !!==============================================================================
+   !!                       ***  MODULE  limadv_umx  ***
+   !! LIM sea-ice model : sea-ice advection using the ULTIMATE-MACHO scheme
+   !!==============================================================================
+   !! History :  3.5  !  2014-11  (C. Rousset, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lim_adv_umx   : update the tracer trend with the 3D advection trends using a TVD scheme
+   !!   ultimate      : compute a tracer value at velocity points using ULTIMATE scheme at various orders
+   !!   macho         : 
+   !!   nonosc_2d     : compute monotonic tracer fluxes by a non-oscillatory algorithm 
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constant
+   USE dom_oce        ! ocean domain
+   USE sbc_oce        ! ocean surface boundary condition
+   USE ice            ! ice variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! lateral boundary conditions -- MPP exchanges
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_adv_umx    ! routine called by limtrp.F90
+      
+   REAL(wp) ::   z1_6   = 1._wp / 6._wp   ! =1/6
+   REAL(wp) ::   z1_120 = 1._wp / 120._wp ! =1/120
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: limadv_umx.F90 4499 2014-02-18 15:14:31Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_adv_umx( kt, pdt, puc, pvc, pubox, pvbox, ptc )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_adv_umx  ***
+      !! 
+      !! **  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 : - pt  the after advective tracer
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   )           ::   kt         ! number of iteration
+      REAL(wp)                    , INTENT(in   )           ::   pdt        ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   puc, pvc   ! 2 ice velocity components => u*e2
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   pubox, pvbox   ! upstream velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   ptc        ! tracer content field
+      !
+      INTEGER  ::   ji, jj           ! dummy loop indices  
+      REAL(wp) ::   ztra             ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('lim_adv_umx')
+      !
+      CALL wrk_alloc( jpi,jpj,   zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )
+      !
+      !
+      !  upstream advection with initial mass fluxes & intermediate update
+      ! --------------------------------------------------------------------
+      DO jj = 1, jpjm1         ! upstream tracer flux in the i and j direction
+         DO ji = 1, fs_jpim1   ! vector opt.
+            zfp_ui = puc(ji,jj) + ABS( puc(ji,jj) )
+            zfm_ui = puc(ji,jj) - ABS( puc(ji,jj) )
+            zfp_vj = pvc(ji,jj) + ABS( pvc(ji,jj) )
+            zfm_vj = pvc(ji,jj) - ABS( pvc(ji,jj) )
+            zfu_ups(ji,jj) = 0.5_wp * ( zfp_ui * ptc(ji,jj) + zfm_ui * ptc(ji+1,jj  ) )
+            zfv_ups(ji,jj) = 0.5_wp * ( zfp_vj * ptc(ji,jj) + zfm_vj * ptc(ji  ,jj+1) )
+         END DO
+      END DO
+      
+      DO jj = 2, jpjm1            ! total intermediate advective trends
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ztra = - (   zfu_ups(ji,jj) - zfu_ups(ji-1,jj  )   &
+               &       + zfv_ups(ji,jj) - zfv_ups(ji  ,jj-1)   ) * r1_e1e2t(ji,jj)
+            !
+            ztrd(ji,jj) =                         ztra                         ! upstream trend [ -div(uh) or -div(uhT) ]  
+            zt_ups (ji,jj) = ( ptc(ji,jj) + pdt * ztra ) * tmask(ji,jj,1)      ! guess after content field with monotonic scheme
+         END DO
+      END DO
+      CALL lbc_lnk( zt_ups, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign)
+      
+      ! High order (_ho) fluxes 
+      ! -----------------------
+      SELECT CASE( nn_limadv_ord )
+      CASE ( 20 )                          ! centered second order
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_ho(ji,jj) = 0.5 * puc(ji,jj) * ( ptc(ji,jj) + ptc(ji+1,jj) )
+               zfv_ho(ji,jj) = 0.5 * pvc(ji,jj) * ( ptc(ji,jj) + ptc(ji,jj+1) )
+            END DO
+         END DO
+         !
+      CASE ( 1:5 )                      ! 1st to 5th order ULTIMATE-MACHO scheme
+         CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v )
+         !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_ho(ji,jj) = puc(ji,jj) * zt_u(ji,jj)
+               zfv_ho(ji,jj) = pvc(ji,jj) * zt_v(ji,jj)
+            END DO
+         END DO
+         !
+      END SELECT
+         
+      ! antidiffusive flux : high order minus low order
+      ! --------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zfu_ho(ji,jj) = zfu_ho(ji,jj) - zfu_ups(ji,jj)
+            zfv_ho(ji,jj) = zfv_ho(ji,jj) - zfv_ups(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk_multi( zfu_ho, 'U', -1., zfv_ho, 'V', -1. )         ! Lateral bondary conditions
+      
+      ! monotonicity algorithm
+      ! -------------------------
+      CALL nonosc_2d( ptc, zfu_ho, zfv_ho, zt_ups, pdt )
+      
+      ! final trend with corrected fluxes
+      ! ------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.  
+            ztra       = ztrd(ji,jj)  - (  zfu_ho(ji,jj) - zfu_ho(ji-1,jj  )   &
+               &                         + zfv_ho(ji,jj) - zfv_ho(ji  ,jj-1) ) * r1_e1e2t(ji,jj)  
+            ptc(ji,jj) = ptc(ji,jj) + pdt * ztra
+         END DO
+      END DO
+      CALL lbc_lnk( ptc(:,:) , 'T',  1. )
+      !
+      !
+      CALL wrk_dealloc( jpi,jpj,   zt_ups, zfu_ups, zfv_ups, ztrd, zfu_ho, zfv_ho, zt_u, zt_v )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('lim_adv_umx')
+      !
+   END SUBROUTINE lim_adv_umx
+
+
+   SUBROUTINE macho( kt, k_order, pdt, ptc, puc, pvc, pubox, pvbox, pt_u, pt_v )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE ultimate_x  ***
+      !!     
+      !! **  Purpose :   compute  
+      !!
+      !! **  Method  :   ... ???
+      !!                 TIM = transient interpolation Modeling 
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   kt         ! number of iteration
+      INTEGER                     , INTENT(in   ) ::   k_order    ! order of the ULTIMATE scheme
+      REAL(wp)                    , INTENT(in   ) ::   pdt        ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptc        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc, pvc   ! 2 ice velocity components
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pubox, pvbox   ! upstream velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_u, pt_v ! tracer at u- and v-points 
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) ::   zc_box    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zzt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('macho')
+      !
+      CALL wrk_alloc( jpi,jpj,   zzt )
+      !
+      IF( MOD( (kt - 1) / nn_fsbc , 2 ) == 0 ) THEN         !==  odd ice time step:  adv_x then adv_y  ==!
+         !
+         !                                                           !--  ultimate interpolation of pt at u-point  --!
+         CALL ultimate_x( k_order, pdt, ptc, puc, pt_u )
+         !
+         !                                                           !--  advective form update in zzt  --!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zzt(ji,jj) = ptc(ji,jj) - pubox(ji,jj) * pdt * ( pt_u(ji,jj) - pt_u(ji-1,jj) ) * r1_e1t(ji,jj)  &
+                  &                    - ptc  (ji,jj) * pdt * ( puc (ji,jj) - puc (ji-1,jj) ) * r1_e1e2t(ji,jj)
+               zzt(ji,jj) = zzt(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( zzt, 'T', 1. )
+         !
+         !                                                           !--  ultimate interpolation of pt at v-point  --!
+         CALL ultimate_y( k_order, pdt, zzt, pvc, pt_v )
+         !
+      ELSE                                                  !==  even ice time step:  adv_y then adv_x  ==!
+         !
+         !                                                           !--  ultimate interpolation of pt at v-point  --!
+         CALL ultimate_y( k_order, pdt, ptc, pvc, pt_v )
+         !
+         !                                                           !--  advective form update in zzt  --!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zzt(ji,jj) = ptc(ji,jj) - pvbox(ji,jj) * pdt * ( pt_v(ji,jj) - pt_v(ji,jj-1) ) * r1_e2t(ji,jj)  &
+                  &                    - ptc  (ji,jj) * pdt * ( pvc (ji,jj) - pvc (ji,jj-1) ) * r1_e1e2t(ji,jj)
+               zzt(ji,jj) = zzt(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( zzt, 'T', 1. )
+         !
+         !                                                           !--  ultimate interpolation of pt at u-point  --!
+         CALL ultimate_x( k_order, pdt, zzt, puc, pt_u )
+         !      
+      ENDIF      
+      !
+      CALL wrk_dealloc( jpi,jpj,   zzt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('macho')
+      !
+   END SUBROUTINE macho
+
+
+   SUBROUTINE ultimate_x( k_order, pdt, pt, puc, pt_u )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE ultimate_x  ***
+      !!     
+      !! **  Purpose :   compute  
+      !!
+      !! **  Method  :   ... ???
+      !!                 TIM = transient interpolation Modeling 
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order   ! ocean time-step index
+      REAL(wp)                    , INTENT(in   ) ::   pdt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   puc       ! ice i-velocity component
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pt        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_u      ! tracer at u-point 
+      !
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      REAL(wp) ::   zcu, zdx2, zdx4    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztu1, ztu2, ztu3, ztu4
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ultimate_x')
+      !
+      CALL wrk_alloc( jpi,jpj,   ztu1, ztu2, ztu3, ztu4 )
+      !
+      !                                                     !--  Laplacian in i-direction  --!
+      DO jj = 2, jpjm1         ! First derivative (gradient)
+         DO ji = 1, fs_jpim1
+            ztu1(ji,jj) = ( pt(ji+1,jj) - pt(ji,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
+         END DO
+         !                     ! Second derivative (Laplacian)
+         DO ji = fs_2, fs_jpim1
+            ztu2(ji,jj) = ( ztu1(ji,jj) - ztu1(ji-1,jj) ) * r1_e1t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztu2, 'T', 1. )
+      !
+      !                                                     !--  BiLaplacian in i-direction  --!
+      DO jj = 2, jpjm1         ! Third derivative
+         DO ji = 1, fs_jpim1
+            ztu3(ji,jj) = ( ztu2(ji+1,jj) - ztu2(ji,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,1)
+         END DO
+         !                     ! Fourth derivative
+         DO ji = fs_2, fs_jpim1
+            ztu4(ji,jj) = ( ztu3(ji,jj) - ztu3(ji-1,jj) ) * r1_e1t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztu4, 'T', 1. )
+      !
+      !
+      SELECT CASE (k_order )
+      !
+      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21)
+         !        
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (                               pt(ji+1,jj) + pt(ji,jj)   &
+                  &                                    - SIGN( 1._wp, puc(ji,jj) ) * ( pt(ji+1,jj) - pt(ji,jj) ) )
+            END DO
+         END DO
+         !
+      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (                                   pt(ji+1,jj) + pt(ji,jj)   &
+                  &                                               -              zcu   * ( pt(ji+1,jj) - pt(ji,jj) ) ) 
+            END DO
+         END DO
+         CALL lbc_lnk( pt_u(:,:) , 'U',  1. )
+         !  
+      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
+!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (         (                         pt  (ji+1,jj) + pt  (ji,jj)        &
+                  &                                               -              zcu   * ( pt  (ji+1,jj) - pt  (ji,jj) )  )   &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                         ztu2(ji+1,jj) + ztu2(ji,jj)        &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj) - ztu2(ji,jj) )  )   )
+            END DO
+         END DO
+         !
+      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
+!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (         (                   pt  (ji+1,jj) + pt  (ji,jj)        &
+                  &                                               -          zcu * ( pt  (ji+1,jj) - pt  (ji,jj) )  )   &
+                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) * (                   ztu2(ji+1,jj) + ztu2(ji,jj)        &
+                  &                                               - 0.5_wp * zcu * ( ztu2(ji+1,jj) - ztu2(ji,jj) )  )   )
+            END DO
+         END DO
+         !
+      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29)
+         !
+         DO jj = 1, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcu  = puc(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
+               zdx2 = e1u(ji,jj) * e1u(ji,jj)
+!!rachid       zdx2 = e1u(ji,jj) * e1t(ji,jj)
+               zdx4 = zdx2 * zdx2
+               pt_u(ji,jj) = 0.5_wp * umask(ji,jj,1) * (               (                   pt  (ji+1,jj) + pt  (ji,jj)       &
+                  &                                                     -          zcu * ( pt  (ji+1,jj) - pt  (ji,jj) ) )   &
+                  &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) *     (                   ztu2(ji+1,jj) + ztu2(ji,jj)       &
+                  &                                                     - 0.5_wp * zcu * ( ztu2(ji+1,jj) - ztu2(ji,jj) ) )   &
+                  &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj) + ztu4(ji,jj)       &
+                  &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj) - ztu4(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi,jpj,   ztu1, ztu2, ztu3, ztu4 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ultimate_x')
+      !
+   END SUBROUTINE ultimate_x
+   
+ 
+   SUBROUTINE ultimate_y( k_order, pdt, pt, pvc, pt_v )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE ultimate_y  ***
+      !!     
+      !! **  Purpose :   compute  
+      !!
+      !! **  Method  :   ... ???
+      !!                 TIM = transient interpolation Modeling 
+      !!
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   k_order   ! ocean time-step index
+      REAL(wp)                    , INTENT(in   ) ::   pdt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvc       ! ice j-velocity component
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pt        ! tracer fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pt_v      ! tracer at v-point 
+      !
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      REAL(wp) ::   zcv, zdy2, zdy4    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztv1, ztv2, ztv3, ztv4
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ultimate_y')
+      !
+      CALL wrk_alloc( jpi,jpj,   ztv1, ztv2, ztv3, ztv4 )
+      !
+      !                                                     !--  Laplacian in j-direction  --!
+      DO jj = 1, jpjm1         ! First derivative (gradient)
+         DO ji = fs_2, fs_jpim1
+            ztv1(ji,jj) = ( pt(ji,jj+1) - pt(ji,jj) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END DO
+      END DO
+      DO jj = 2, jpjm1         ! Second derivative (Laplacian)
+         DO ji = fs_2, fs_jpim1
+            ztv2(ji,jj) = ( ztv1(ji,jj) - ztv1(ji,jj-1) ) * r1_e2t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztv2, 'T', 1. )
+      !
+      !                                                     !--  BiLaplacian in j-direction  --!
+      DO jj = 1, jpjm1         ! First derivative
+         DO ji = fs_2, fs_jpim1
+            ztv3(ji,jj) = ( ztv2(ji,jj+1) - ztv2(ji,jj) ) * r1_e2v(ji,jj) * vmask(ji,jj,1)
+         END DO
+      END DO
+      DO jj = 2, jpjm1         ! Second derivative
+         DO ji = fs_2, fs_jpim1
+            ztv4(ji,jj) = ( ztv3(ji,jj) - ztv3(ji,jj-1) ) * r1_e2t(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( ztv4, 'T', 1. )
+      !
+      !
+      SELECT CASE (k_order )
+         !
+      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21)
+         !        
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1) + pt(ji,jj) )  &
+                  &                                     - SIGN( 1._wp, pvc(ji,jj) ) * ( pt(ji,jj+1) - pt(ji,jj) ) )
+            END DO
+         END DO
+         !
+      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (        ( pt(ji,jj+1) + pt(ji,jj) )  &
+                  &                                     - zcv * ( pt(ji,jj+1) - pt(ji,jj) ) )
+            END DO
+         END DO
+         CALL lbc_lnk( pt_v(:,:) , 'V',  1. )
+         !
+      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
+!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                                 ( pt  (ji,jj+1) + pt  (ji,jj)       &
+                  &                                     -                        zcv   * ( pt  (ji,jj+1) - pt  (ji,jj) ) )   &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1) + ztv2(ji,jj)       &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27)
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
+!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                           ( pt  (ji,jj+1) + pt  (ji,jj)       &
+                  &                                               -          zcv * ( pt  (ji,jj+1) - pt  (ji,jj) ) )   &
+                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                   ztv2(ji,jj+1) + ztv2(ji,jj)       &
+                  &                                               - 0.5_wp * zcv * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29)
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               zcv  = pvc(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj)
+               zdy2 = e2v(ji,jj) * e2v(ji,jj)
+!!rachid       zdy2 = e2v(ji,jj) * e2t(ji,jj)
+               zdy4 = zdy2 * zdy2
+               pt_v(ji,jj) = 0.5_wp * vmask(ji,jj,1) * (                                 ( pt  (ji,jj+1) + pt  (ji,jj)      &
+                  &                                                     -          zcv * ( pt  (ji,jj+1) - pt  (ji,jj) ) )  &
+                  &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) *     (                   ztv2(ji,jj+1) + ztv2(ji,jj)      &
+                  &                                                     - 0.5_wp * zcv * ( ztv2(ji,jj+1) - ztv2(ji,jj) ) )  &
+                  &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1) + ztv4(ji,jj)      &
+                  &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1) - ztv4(ji,jj) ) ) )
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi,jpj,   ztv1, ztv2, ztv3, ztv4 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ultimate_y')
+      !
+   END SUBROUTINE ultimate_y
+   
+  
+   SUBROUTINE nonosc_2d( pbef, paa, pbb, paft, pdt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      REAL(wp)                     , INTENT(in   ) ::   pdt          ! tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pbef, paft   ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(inout) ::   paa, pbb     ! monotonic fluxes in the 2 directions
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      INTEGER  ::   ikm1      ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zsml, z1_dt   ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zbetup, zbetdo, zbup, zbdo, zmsk, zdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc_2d')
+      !
+      CALL wrk_alloc( jpi,jpj,   zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )
+      !
+      zbig = 1.e+40_wp
+      zsml = 1.e-15_wp
+
+      ! clem test
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.  
+            zdiv(ji,jj) =  - (  paa(ji,jj) - paa(ji-1,jj  )   &
+               &              + pbb(ji,jj) - pbb(ji  ,jj-1) )  
+         END DO
+      END DO
+      CALL lbc_lnk( zdiv, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign)
+
+      ! Determine ice masks for before and after tracers 
+      WHERE( pbef(:,:) == 0._wp .AND. paft(:,:) == 0._wp .AND. zdiv(:,:) == 0._wp )   ;   zmsk(:,:) = 0._wp
+      ELSEWHERE                                                                       ;   zmsk(:,:) = 1._wp * tmask(:,:,1)
+      END WHERE
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+!      zbup(:,:) = MAX( pbef(:,:) * tmask(:,:,1) - zbig * ( 1.e0 - tmask(:,:,1) ),   &
+!         &             paft(:,:) * tmask(:,:,1) - zbig * ( 1.e0 - tmask(:,:,1) )  )
+!      zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ),   &
+!         &             paft(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) )  )
+      zbup(:,:) = MAX( pbef(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ),   &
+         &             paft(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) )  )
+      zbdo(:,:) = MIN( pbef(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ),   &
+         &             paft(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) )  )
+
+      z1_dt = 1._wp / pdt
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            !
+            zup  = MAX(   zbup(ji,jj), zbup(ji-1,jj  ), zbup(ji+1,jj  ),   &        ! search max/min in neighbourhood
+               &                       zbup(ji  ,jj-1), zbup(ji  ,jj+1)    )
+            zdo  = MIN(   zbdo(ji,jj), zbdo(ji-1,jj  ), zbdo(ji+1,jj  ),   &
+               &                       zbdo(ji  ,jj-1), zbdo(ji  ,jj+1)    )
+               !
+            zpos = MAX( 0., paa(ji-1,jj  ) ) - MIN( 0., paa(ji  ,jj  ) )   &        ! positive/negative  part of the flux
+               & + MAX( 0., pbb(ji  ,jj-1) ) - MIN( 0., pbb(ji  ,jj  ) )
+            zneg = MAX( 0., paa(ji  ,jj  ) ) - MIN( 0., paa(ji-1,jj  ) )   &
+               & + MAX( 0., pbb(ji  ,jj  ) ) - MIN( 0., pbb(ji  ,jj-1) )
+               !
+            zbt = e1e2t(ji,jj) * z1_dt                                   ! up & down beta terms
+            zbetup(ji,jj) = ( zup         - paft(ji,jj) ) / ( zpos + zsml ) * zbt
+            zbetdo(ji,jj) = ( paft(ji,jj) - zdo         ) / ( zneg + zsml ) * zbt
+         END DO
+      END DO
+      CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! monotonic flux in the i & j direction (paa & pbb)
+      ! -------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zau = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji+1,jj) )
+            zbu = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji+1,jj) )
+            zcu = 0.5  + SIGN( 0.5 , paa(ji,jj) )
+            !
+            zav = MIN( 1._wp , zbetdo(ji,jj) , zbetup(ji,jj+1) )
+            zbv = MIN( 1._wp , zbetup(ji,jj) , zbetdo(ji,jj+1) )
+            zcv = 0.5  + SIGN( 0.5 , pbb(ji,jj) )
+            !
+            paa(ji,jj) = paa(ji,jj) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+            pbb(ji,jj) = pbb(ji,jj) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+            !
+         END DO
+      END DO
+      CALL lbc_lnk_multi( paa, 'U', -1., pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+      CALL wrk_dealloc( jpi,jpj,   zbetup, zbetdo, zbup, zbdo, zmsk, zdiv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc_2d')
+      !
+   END SUBROUTINE nonosc_2d
+
+   !!======================================================================
+END MODULE limadv_umx
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 8732)
@@ -0,0 +1,315 @@
+MODULE limcons
+   !!======================================================================
+   !!                   ***  MODULE  limcons  ***
+   !! LIM-3 Sea Ice :   conservation check
+   !!======================================================================
+   !! History :   -   ! Original code from William H. Lipscomb, LANL
+   !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation 
+   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations
+   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm
+   !!             -   ! 2015-03  (C. Rousset) add lim_cons_final
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_cons     :   checks whether energy, mass and salt are conserved 
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE ice            ! LIM-3 variables
+   USE dom_oce        ! ocean domain
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE sbc_oce , ONLY : sfx  ! Surface boundary condition: ocean fields
+   USE sbc_ice , ONLY : qevap_ice
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_column_sum
+   PUBLIC   lim_column_sum_energy
+   PUBLIC   lim_cons_check
+   PUBLIC   lim_cons_hsm
+   PUBLIC   lim_cons_final
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_column_sum( ksum, pin, pout )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_column_sum ***
+      !!
+      !! ** Purpose : Compute the sum of xin over nsum categories
+      !!
+      !! ** Method  : Arithmetics
+      !!
+      !! ** Action  : Gets xin(ji,jj,jl) and computes xout(ji,jj)
+      !!---------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   ksum   ! number of categories/layers
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pin    ! input field
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   pout   ! output field
+      !
+      INTEGER ::   jl   ! dummy loop indices
+      !!---------------------------------------------------------------------
+      !
+      pout(:,:) = pin(:,:,1)
+      DO jl = 2, ksum
+         pout(:,:) = pout(:,:) + pin(:,:,jl)
+      END DO
+      !
+   END SUBROUTINE lim_column_sum
+
+
+   SUBROUTINE lim_column_sum_energy( ksum, klay, pin, pout)
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_column_sum_energy ***
+      !!
+      !! ** Purpose : Compute the sum of xin over nsum categories
+      !!              and nlay layers
+      !!
+      !! ** Method  : Arithmetics
+      !!---------------------------------------------------------------------
+      INTEGER                                , INTENT(in   ) ::   ksum   !: number of categories
+      INTEGER                                , INTENT(in   ) ::   klay   !: number of vertical layers
+      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in   ) ::   pin    !: input field
+      REAL(wp), DIMENSION(jpi,jpj)           , INTENT(  out) ::   pout   !: output field
+      !
+      INTEGER ::   jk, jl   ! dummy loop indices
+      !!---------------------------------------------------------------------
+      !
+      pout(:,:) = 0._wp
+      DO jl = 1, ksum
+         DO jk = 2, klay 
+            pout(:,:) = pout(:,:) + pin(:,:,jk,jl)
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_column_sum_energy
+
+
+   SUBROUTINE lim_cons_check( px1, px2, pmax_err, cd_fieldid )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_cons_check ***
+      !!
+      !! ** Purpose : Test the conservation of a certain variable
+      !!              For each physical grid cell, check that initial 
+      !!              and final values
+      !!              of a conserved field are equal to within a small value.
+      !!
+      !! ** Method  :
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   px1          !: initial field
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   px2          !: final field
+      REAL(wp)                , INTENT(in   ) ::   pmax_err     !: max allowed error
+      CHARACTER(len=15)       , INTENT(in   ) ::   cd_fieldid   !: field identifyer
+      !
+      INTEGER  ::   ji, jj          ! dummy loop indices
+      INTEGER  ::   inb_error       ! number of g.c where there is a cons. error
+      LOGICAL  ::   llconserv_err   ! = .true. if conservation check failed
+      REAL(wp) ::   zmean_error     ! mean error on error points
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*) ' lim_cons_check '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+
+      llconserv_err = .FALSE.
+      inb_error     = 0
+      zmean_error   = 0._wp
+      IF( MAXVAL( px2(:,:) - px1(:,:) ) > pmax_err )   llconserv_err = .TRUE.
+
+      IF( llconserv_err ) THEN
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               IF( ABS( px2(ji,jj) - px1(ji,jj) ) > pmax_err ) THEN
+                  inb_error   = inb_error + 1
+                  zmean_error = zmean_error + ABS( px2(ji,jj) - px1(ji,jj) )
+                  !
+                  IF(lwp) THEN
+                     WRITE (numout,*) ' ALERTE 99 '
+                     WRITE (numout,*) ' Conservation error: ', cd_fieldid
+                     WRITE (numout,*) ' Point             : ', ji, jj 
+                     WRITE (numout,*) ' lat, lon          : ', gphit(ji,jj), glamt(ji,jj)
+                     WRITE (numout,*) ' Initial value     : ', px1(ji,jj)
+                     WRITE (numout,*) ' Final value       : ', px2(ji,jj)
+                     WRITE (numout,*) ' Difference        : ', px2(ji,jj) - px1(ji,jj)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         !
+      ENDIF
+      IF(lk_mpp)   CALL mpp_sum( inb_error   )
+      IF(lk_mpp)   CALL mpp_sum( zmean_error )
+      !
+      IF( inb_error > 0 .AND. lwp ) THEN
+         zmean_error = zmean_error / REAL( inb_error, wp )
+         WRITE(numout,*) ' Conservation check for : ', cd_fieldid
+         WRITE(numout,*) ' Number of error points : ', inb_error
+         WRITE(numout,*) ' Mean error on these pts: ', zmean_error
+      ENDIF
+      !
+   END SUBROUTINE lim_cons_check
+
+
+   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b )
+      !!--------------------------------------------------------------------------------------------------------
+      !!                                        ***  ROUTINE lim_cons_hsm ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
+      !!                     + test if ice concentration and volume are > 0
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!--------------------------------------------------------------------------------------------------------
+      INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1)
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
+      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft
+      REAL(wp)                        :: zvmin, zamin, zamax 
+      REAL(wp)                        :: zvtrp, zetrp
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
+
+      IF( icount == 0 ) THEN
+
+         ! salt flux
+         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         ! water flux
+         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +               &
+            &                  wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:)  &
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         ! heat flux
+         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv )
+
+         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
+            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
+                            ) * e1e2t * tmask(:,:,1) * zconv )
+
+      ELSEIF( icount == 1 ) THEN
+
+         ! salt flux
+         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
+            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
+
+         ! water flux
+         zfw  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +                &
+            &                wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) + wfx_lam(:,:)   &
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
+
+         ! heat flux
+         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
+            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b
+ 
+         ! outputs
+         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 )  &
+            &                    * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
+
+         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 )  &
+            &                    * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
+
+         zei  =   glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  &
+            &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    &
+            &                ) * e1e2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
+
+         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
+         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
+         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t * tmask(:,:,1) * zconv )
+
+         zvmin = glob_min( v_i )
+         zamax = glob_max( SUM( a_i, dim=3 ) )
+         zamin = glob_min( a_i )
+
+         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
+         zv_sill = zarea * 2.5e-5
+         zs_sill = zarea * 25.e-5
+         zh_sill = zarea * 10.e-5
+
+         IF(lwp) THEN
+            IF ( ABS( zvi  ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zvi
+            IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv
+            IF ( ABS( zei  ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zei
+            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN
+                                         WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp
+                                         WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp
+            ENDIF
+            IF (     zvmin   < -epsi10 ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin
+            IF (     zamax   > MAX( rn_amax_n, rn_amax_s ) + epsi10 .AND. &
+               &                         cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
+                                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax
+            IF (     zamax   > 1._wp   ) WRITE(numout,*) 'violation a_i>1               (',cd_routine,') = ',zamax
+            ENDIF
+            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE lim_cons_hsm
+
+   SUBROUTINE lim_cons_final( cd_routine )
+      !!---------------------------------------------------------------------------------------------------------
+      !!                                   ***  ROUTINE lim_cons_final ***
+      !!
+      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
+      !!
+      !! ** Method  : This is an online diagnostics which can be activated with ln_limdiachk=true
+      !!              It prints in ocean.output if there is a violation of conservation at each time-step
+      !!              The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to
+      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!--------------------------------------------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine
+      REAL(wp)                        :: zhfx, zsfx, zvfx
+      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill
+      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt
+
+      ! heat flux
+      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   &
+      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check)
+         &              ) * e1e2t * tmask(:,:,1) * zconv ) 
+      ! salt flux
+      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday
+      ! water flux
+      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday
+
+      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2
+      zv_sill = zarea * 2.5e-5
+      zs_sill = zarea * 25.e-5
+      zh_sill = zarea * 10.e-5
+
+      IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx)
+      IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx)
+      IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx)
+
+   END SUBROUTINE lim_cons_final
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE limcons
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90	(revision 8732)
@@ -0,0 +1,531 @@
+MODULE limctl
+   !!======================================================================
+   !!                     ***  MODULE  limctl  ***
+   !!   LIM-3 : control and printing
+   !!======================================================================
+   !! History :  3.5  !  2015-01  (M. Vancoppenolle) Original code
+   !!            3.7  !  2016-10  (C. Rousset)       Add routine lim_prt3D
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_ctl   : control prints in case of crash
+   !!    lim_prt   : ice control print at a given grid point
+   !!    lim_prt3D : control prints of ice arrays
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ice             ! LIM-3: ice variables
+   USE thd_ice         ! LIM-3: thermodynamical variables
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice   fields
+
+   USE phycst          ! Define parameters for the routines
+
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lib_fortran     ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_ctl
+   PUBLIC   lim_prt
+   PUBLIC   lim_prt3D
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limctl.F90 5043 2015-01-28 16:44:18Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_ctl( kt )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_ctl *** 
+      !!                 
+      !! ** Purpose :   Alerts in case of model crash
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices
+      INTEGER  ::   inb_altests       ! number of alert tests (max 20)
+      INTEGER  ::   ialert_id         ! number of the current alert
+      REAL(wp) ::   ztmelts           ! ice layer melting point
+      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert
+      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive
+      !!-------------------------------------------------------------------
+
+      inb_altests = 10
+      inb_alp(:)  =  0
+
+      ! Alert if incompatible volume and concentration
+      ialert_id = 2 ! reference number of this alert
+      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN
+                  !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration '
+                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj)
+                  !WRITE(numout,*) ' Point - category', ji, jj, jl
+                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl)
+                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl)
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Alerte if very thick ice
+      ialert_id = 3 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
+      jl = jpl 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN
+               !CALL lim_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' )
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if very fast ice
+      ialert_id = 4 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  &
+               &  at_i(ji,jj) > 0._wp   ) THEN
+               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
+               !WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
+               !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
+               !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
+               !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
+               !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
+               !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
+               !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
+               !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
+               !WRITE(numout,*) 
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if there is ice on continents
+      ialert_id = 6 ! reference number of this alert
+      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN 
+               !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
+               !WRITE(numout,*) ' masks s, u, v        : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1) 
+               !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+               !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
+               !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
+               !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
+               !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
+               !
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+!
+!     ! Alert if very fresh ice
+      ialert_id = 7 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+!                 CALL lim_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
+!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+!                 WRITE(numout,*) 
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+!
+
+!     ! Alert if too old ice
+      ialert_id = 9 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
+                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
+                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+                  !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ')
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+ 
+      ! Alert on salt flux
+      ialert_id = 5 ! reference number of this alert
+      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth
+               !CALL lim_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' )
+               !DO jl = 1, jpl
+                  !WRITE(numout,*) ' Category no: ', jl
+                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)   
+                  !WRITE(numout,*) ' '
+               !END DO
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if qns very big
+      ialert_id = 8 ! reference number of this alert
+      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+               !
+               !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux'
+               !WRITE(numout,*) ' ji, jj    : ', ji, jj
+               !WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj)
+               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj)
+               !
+               !CALL lim_prt( kt, ji, jj, 2, '   ')
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               !
+            ENDIF
+         END DO
+      END DO
+      !+++++
+ 
+      ! Alert if very warm ice
+      ialert_id = 10 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
+      inb_alp(ialert_id) = 0
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rt0
+                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   &
+                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN
+                     !WRITE(numout,*) ' ALERTE 10 :   Very warm ice'
+                     !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
+                     !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
+                     !WRITE(numout,*) ' ztmelts : ', ztmelts
+                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! sum of the alerts on all processors
+      IF( lk_mpp ) THEN
+         DO ialert_id = 1, inb_altests
+            CALL mpp_sum(inb_alp(ialert_id))
+         END DO
+      ENDIF
+
+      ! print alerts
+      IF( lwp ) THEN
+         ialert_id = 1                                 ! reference number of this alert
+         cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
+         WRITE(numout,*) ' time step ',kt
+         WRITE(numout,*) ' All alerts at the end of ice model '
+         DO ialert_id = 1, inb_altests
+            WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
+         END DO
+      ENDIF
+     !
+   END SUBROUTINE lim_ctl
+ 
+   
+   SUBROUTINE lim_prt( kt, ki, kj, kn, cd1 )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_prt *** 
+      !!                 
+      !! ** Purpose :   Writes global ice state on the (i,j) point 
+      !!                in ocean.ouput 
+      !!                3 possibilities exist 
+      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
+      !!                n = 2    -> exhaustive state
+      !!                n = 3    -> ice/ocean salt fluxes
+      !!
+      !! ** input   :   point coordinates (i,j) 
+      !!                n : number of the option
+      !!-------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt            ! ocean time step
+      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
+      CHARACTER(len=*), INTENT(in) ::   cd1           !
+      !!
+      INTEGER :: jl, ji, jj
+      !!-------------------------------------------------------------------
+
+      DO ji = mi0(ki), mi1(ki)
+         DO jj = mj0(kj), mj1(kj)
+
+            WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title
+
+            !----------------
+            !  Simple state
+            !----------------
+            
+            IF ( kn == 1 .OR. kn == -1 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Simple state '
+               WRITE(numout,*) ' masks s,u,v   : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
+               WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step     : ', numit
+               WRITE(numout,*) ' - Ice drift   '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (', jl,')'
+                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl)
+                  WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl)
+                  WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl)
+                  WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl)
+                  WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl)
+                  WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl)
+                  WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl)
+                  WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl)
+                  WRITE(numout,*)
+               END DO
+            ENDIF
+            IF( kn == -1 ) THEN
+               WRITE(numout,*) ' Mechanical Check ************** '
+               WRITE(numout,*) ' Check what means ice divergence '
+               WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
+               WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj)
+               WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj)
+               WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
+            ENDIF
+            
+
+            !--------------------
+            !  Exhaustive state
+            !--------------------
+            
+            IF ( kn .EQ. 2 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' Exhaustive state '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step ', numit
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Cell values '
+               WRITE(numout,*) '   ~~~~~~~~~~~ '
+               WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj)
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj)
+               WRITE(numout,*) ' strength      : ', strength(ji,jj)
+               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)  
+               WRITE(numout,*)
+               
+               DO jl = 1, jpl
+                  WRITE(numout,*) ' - Category (',jl,')'
+                  WRITE(numout,*) '   ~~~~~~~~         ' 
+                  WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl)
+                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
+                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl)
+                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl)
+                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
+                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)  
+                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
+                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl)
+               END DO !jl
+               
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat / FW fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
+               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
+               WRITE(numout,*)
+               WRITE(numout,*) 
+               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
+               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
+               WRITE(numout,*) 
+               WRITE(numout,*) ' - Stresses '
+               WRITE(numout,*) '   ~~~~~~~~ '
+               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
+               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
+               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
+               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
+               WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj)
+               WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj)
+            ENDIF
+            
+            !---------------------
+            ! Salt / heat fluxes
+            !---------------------
+            
+            IF ( kn .EQ. 3 ) THEN
+               WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+               WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' - Salt / Heat Fluxes '
+               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+               WRITE(numout,*) ' Time step ', numit
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+               WRITE(numout,*) ' qsr       : ', qsr(ji,jj)
+               WRITE(numout,*) ' qns       : ', qns(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
+               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj)
+               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj)
+               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)              
+               WRITE(numout,*)
+               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
+               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
+               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
+               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj) 
+               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+               WRITE(numout,*) ' emp       : ', emp    (ji,jj)
+               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj)
+               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj)
+               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj)
+               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj)
+               WRITE(numout,*)
+               WRITE(numout,*) ' - Momentum fluxes '
+               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
+               WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
+            ENDIF 
+            WRITE(numout,*) ' '
+            !
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_prt
+
+   SUBROUTINE lim_prt3D( cd_routine )
+      !!---------------------------------------------------------------------------------------------------------
+      !!                                   ***  ROUTINE lim_prt3D ***
+      !!
+      !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated 
+      !!
+      !!---------------------------------------------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)  :: cd_routine    ! name of the routine
+      INTEGER                       :: jk, jl        ! dummy loop indices
+      
+      CALL prt_ctl_info(' ========== ')
+      CALL prt_ctl_info( cd_routine )
+      CALL prt_ctl_info(' ========== ')
+      CALL prt_ctl_info(' - Cell values : ')
+      CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+      CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' cell area   :')
+      CALL prt_ctl(tab2d_1=at_i       , clinfo1=' at_i        :')
+      CALL prt_ctl(tab2d_1=ato_i      , clinfo1=' ato_i       :')
+      CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' vt_i        :')
+      CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' vt_s        :')
+      CALL prt_ctl(tab2d_1=divu_i     , clinfo1=' divu_i      :')
+      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
+      CALL prt_ctl(tab2d_1=stress1_i  , clinfo1=' stress1_i   :')
+      CALL prt_ctl(tab2d_1=stress2_i  , clinfo1=' stress2_i   :')
+      CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i  :')
+      CALL prt_ctl(tab2d_1=strength   , clinfo1=' strength    :')
+      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
+      CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
+       
+      DO jl = 1, jpl
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Category : ', ivar1=jl)
+         CALL prt_ctl_info('   ~~~~~~~~~~')
+         CALL prt_ctl(tab2d_1=ht_i       (:,:,jl)        , clinfo1= ' ht_i        : ')
+         CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' ht_s        : ')
+         CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' t_su        : ')
+         CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' t_snow      : ')
+         CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' sm_i        : ')
+         CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' o_i         : ')
+         CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' a_i         : ')
+         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ')
+         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ')
+         CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ')
+         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ')
+         CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' smv_i       : ')
+         CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' oa_i        : ')
+         
+         DO jk = 1, nlay_i
+            CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ')
+         END DO
+      END DO
+      
+      CALL prt_ctl_info(' ')
+      CALL prt_ctl_info(' - Heat / FW fluxes : ')
+      CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ')
+      CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ')
+      CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ')
+      CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ')
+      
+      CALL prt_ctl_info(' ')
+      CALL prt_ctl_info(' - Stresses : ')
+      CALL prt_ctl_info('   ~~~~~~~~~~ ')
+      CALL prt_ctl(tab2d_1=utau       , clinfo1= ' utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ')
+      CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ')
+      CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ')
+      
+   END SUBROUTINE lim_prt3D
+
+#else
+   !!--------------------------------------------------------------------------
+   !!   Default option         Empty Module               No LIM3 sea-ice model
+   !!--------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_ctl     ! Empty routine
+   END SUBROUTINE lim_ctl
+   SUBROUTINE lim_prt     ! Empty routine
+   END SUBROUTINE lim_prt
+   SUBROUTINE lim_prt3D   ! Empty routine
+   END SUBROUTINE lim_prt3D
+#endif
+   !!======================================================================
+END MODULE limctl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90	(revision 8732)
@@ -0,0 +1,247 @@
+MODULE limdiahsb
+   !!======================================================================
+   !!                       ***  MODULE limdia_hsb   ***
+   !!  LIM-3 sea ice model :   diagnostics of ice model 
+   !!======================================================================
+   !! History :  3.4  ! 2012-10  (C. Rousset)  original code
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_dia_hsb        : computation and output of the time evolution of keys variables
+   !!   lim_dia_hsb_init   : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE ice             ! LIM-3: sea-ice variable
+   USE dom_oce         ! ocean domain
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: sea-ice fields
+   USE daymod          ! model calendar
+   USE phycst          ! physical constant
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! preformance summary
+   USE iom             ! I/O manager
+   USE lib_fortran     ! glob_sum
+   USE limrst          ! ice restart
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_diahsb        ! routine called by ice_step.F90
+   PUBLIC   lim_diahsb_init   ! routine called in sbcice_lim.F90
+
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents
+   REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.4 , NEMO Consortium (2012)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_diahsb( kt )
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_diahsb  ***
+      !!     
+      !! ** Purpose: Compute the ice global heat content, salt content and volume conservation
+      !!	
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt    ! number of iteration
+      !!
+      real(wp)   ::   zbg_ivol, zbg_svol, zbg_area, zbg_isal, zbg_item ,zbg_stem
+      REAL(wp)   ::   z_frc_voltop, z_frc_volbot, z_frc_sal, z_frc_temtop, z_frc_tembot  
+      REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem  
+      !!---------------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('lim_diahsb')
+
+      ! ----------------------- !
+      ! 1 -  Contents !
+      ! ----------------------- !
+      zbg_ivol = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                  ! ice volume (km3)
+      zbg_svol = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                  ! snow volume (km3)
+      zbg_area = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-6 )                  ! area (km2)
+      zbg_isal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt content (pss*km3)
+      zbg_item = glob_sum( et_i * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                      ! heat content (1.e20 J)
+      zbg_stem = glob_sum( et_s * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                      ! heat content (1.e20 J)
+      
+      ! ---------------------------!
+      ! 2 - Trends due to forcing  !
+      ! ---------------------------!
+      z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )  ! freshwater flux ice/snow-ocean 
+      z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                     ! freshwater flux ice/snow-atm
+      z_frc_sal    = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )                                            ! salt fluxes ice/snow-ocean
+      z_frc_tembot =           glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                                         ! heat on top of ocean (and below ice)
+      z_frc_temtop =           glob_sum( hfx_in (:,:) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )                                         ! heat on top of ice-coean
+      !
+      frc_voltop  = frc_voltop  + z_frc_voltop  * rdt_ice ! km3
+      frc_volbot  = frc_volbot  + z_frc_volbot  * rdt_ice ! km3
+      frc_sal     = frc_sal     + z_frc_sal     * rdt_ice ! km3*pss
+      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J
+      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J
+            
+      ! ----------------------- !
+      ! 3 -  Content variations !
+      ! ----------------------- !
+      zdiff_vol = r1_rau0 * glob_sum( ( rhoic * vt_i(:,:) + rhosn * vt_s(:,:) - vol_loc_ini(:,:)  &  ! freshwater trend (km3) 
+         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 ) 
+      zdiff_sal = r1_rau0 * glob_sum( ( rhoic * SUM( smv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:)     &  ! salt content trend (km3*pss)
+         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-9 )
+      zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:)                  &  ! heat content trend (1.e20 J)
+      !  &                            + SUM( qevap_ice * a_i_b, dim=3 ) &     !! clem: I think this line should be commented (but needs a check)
+         &                            ) * e1e2t(:,:) * tmask(:,:,1) * 1.e-20 )
+
+      ! ----------------------- !
+      ! 4 -  Drifts             !
+      ! ----------------------- !
+      zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot )
+      zdiff_sal = zdiff_sal - frc_sal
+      zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop )
+
+      ! ----------------------- !
+      ! 5 - Diagnostics writing !
+      ! ----------------------- !
+      !
+      IF( iom_use('ibgvolume') )  CALL iom_put( 'ibgvolume' , zdiff_vol        )   ! ice/snow volume  drift            (km3 equivalent ocean water)         
+      IF( iom_use('ibgsaltco') )  CALL iom_put( 'ibgsaltco' , zdiff_sal        )   ! ice salt content drift            (psu*km3 equivalent ocean water)
+      IF( iom_use('ibgheatco') )  CALL iom_put( 'ibgheatco' , zdiff_tem        )   ! ice/snow heat content drift       (1.e20 J)
+      IF( iom_use('ibgheatfx') )  CALL iom_put( 'ibgheatfx' , zdiff_tem /      &   ! ice/snow heat flux drift          (W/m2)
+         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) )
+
+      IF( iom_use('ibgfrcvoltop') )  CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
+      IF( iom_use('ibgfrcvolbot') )  CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
+      IF( iom_use('ibgfrcsal') )     CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)   
+      IF( iom_use('ibgfrctemtop') )  CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)   
+      IF( iom_use('ibgfrctembot') )  CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)   
+      IF( iom_use('ibgfrchfxtop') )  CALL iom_put( 'ibgfrchfxtop' , frc_temtop / & ! heat on top of ice/snw/ocean      (W/m2) 
+         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) )
+      IF( iom_use('ibgfrchfxbot') )  CALL iom_put( 'ibgfrchfxbot' , frc_tembot / & ! heat on top of ocean(below ice)   (W/m2) 
+         &                                                    glob_sum( e1e2t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) )
+
+      IF( iom_use('ibgvol_tot' ) )  CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                        (km3)
+      IF( iom_use('sbgvol_tot' ) )  CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                       (km3)
+      IF( iom_use('ibgarea_tot') )  CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                          (km2)
+      IF( iom_use('ibgsalt_tot') )  CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content              (pss*km3)
+      IF( iom_use('ibgheat_tot') )  CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                  (1.e20 J)
+      IF( iom_use('sbgheat_tot') )  CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                 (1.e20 J)
+      !
+      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('lim_diahsb')
+      !
+   END SUBROUTINE lim_diahsb
+
+
+   SUBROUTINE lim_diahsb_init
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_diahsb_init  ***
+      !!     
+      !! ** 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
+      !!---------------------------------------------------------------------------
+      INTEGER            ::   ierror   ! local integer
+      !!
+      !!NAMELIST/namicehsb/ blabla
+      !!----------------------------------------------------------------------
+      !
+      !!REWIND ( numnam_ice )              ! Read Namelist namicehsb 
+      !!READ   ( numnam_ice, namicehsb )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_diahsb_init : check the heat and salt budgets'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !      
+      ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 )  THEN
+         CALL ctl_stop( 'lim_diahsb: unable to allocate vol_loc_ini' )
+         RETURN
+      ENDIF
+
+      CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE lim_diahsb_init
+
+   SUBROUTINE lim_diahsb_rst( kt, cdrw )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE limdia_rst  ***
+     !!                     
+     !! ** Purpose :   Read or write DIA file in restart file
+     !!
+     !! ** Method  :   use of IOM library
+     !!----------------------------------------------------------------------
+     INTEGER         , INTENT(in) ::   kt     ! ice time-step
+     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+     !
+     !!----------------------------------------------------------------------
+     !
+     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+        IF( ln_rstart ) THEN                   !* Read the restart file
+           !
+           IF(lwp) WRITE(numout,*) '~~~~~~~'
+           IF(lwp) WRITE(numout,*) ' lim_diahsb_rst read at it= ', kt,' date= ', ndastp
+           IF(lwp) WRITE(numout,*) '~~~~~~~'
+           CALL iom_get( numrir, 'frc_voltop' , frc_voltop  )
+           CALL iom_get( numrir, 'frc_volbot' , frc_volbot  )
+           CALL iom_get( numrir, 'frc_temtop' , frc_temtop  )
+           CALL iom_get( numrir, 'frc_tembot' , frc_tembot  )
+           CALL iom_get( numrir, 'frc_sal'    , frc_sal     )
+           CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini )
+           CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini )
+           CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini )
+        ELSE
+           IF(lwp) WRITE(numout,*) '~~~~~~~'
+           IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state '
+           IF(lwp) WRITE(numout,*) '~~~~~~~'
+           ! set trends to 0
+           frc_voltop  = 0._wp                                          
+           frc_volbot  = 0._wp                                          
+           frc_temtop  = 0._wp                                                 
+           frc_tembot  = 0._wp                                                 
+           frc_sal     = 0._wp                                                 
+           ! record initial ice volume, salt and temp
+           vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:)  ! ice/snow volume (kg/m2)
+           tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                  ! ice/snow heat content (J)
+           sal_loc_ini(:,:) = rhoic * SUM( smv_i(:,:,:), dim=3 )     ! ice salt content (pss*kg/m2)
+           
+       ENDIF
+
+     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+        !                                   ! -------------------
+        IF(lwp) WRITE(numout,*) '~~~~~~~'
+        IF(lwp) WRITE(numout,*) ' lim_diahsb_rst write at it= ', kt,' date= ', ndastp
+        IF(lwp) WRITE(numout,*) '~~~~~~~'
+        CALL iom_rstput( kt, nitrst, numriw, 'frc_voltop' , frc_voltop  )
+        CALL iom_rstput( kt, nitrst, numriw, 'frc_volbot' , frc_volbot  )
+        CALL iom_rstput( kt, nitrst, numriw, 'frc_temtop' , frc_temtop  )
+        CALL iom_rstput( kt, nitrst, numriw, 'frc_tembot' , frc_tembot  )
+        CALL iom_rstput( kt, nitrst, numriw, 'frc_sal'    , frc_sal     )
+        CALL iom_rstput( kt, nitrst, numriw, 'vol_loc_ini', vol_loc_ini )
+        CALL iom_rstput( kt, nitrst, numriw, 'tem_loc_ini', tem_loc_ini )
+        CALL iom_rstput( kt, nitrst, numriw, 'sal_loc_ini', sal_loc_ini )
+        !
+     ENDIF
+     !
+   END SUBROUTINE lim_diahsb_rst
+ 
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module          NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_diahsb          ! Empty routine
+   END SUBROUTINE lim_diahsb
+#endif
+   !!======================================================================
+END MODULE limdiahsb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 8732)
@@ -0,0 +1,161 @@
+MODULE limdyn
+   !!======================================================================
+   !!                     ***  MODULE  limdyn  ***
+   !!   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
+   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                 LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_dyn      : computes ice velocities
+   !!    lim_dyn_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst           ! physical constants
+   USE dom_oce          ! ocean space and time domain
+   USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE ice              ! LIM-3 variables
+   USE limrhg           ! LIM-3 rheology
+   USE lbclnk           ! lateral boundary conditions - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE in_out_manager   ! I/O manager
+   USE lib_fortran      ! glob_sum
+   USE timing           ! Timing
+   USE limcons          ! conservation tests
+   USE limctl           ! control prints
+   USE limvar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_dyn        ! routine called by sbcice_lim.F90
+   PUBLIC   lim_dyn_init   ! routine called by sbcice_lim.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_dyn( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_dyn  ***
+      !!               
+      !! ** Purpose :   compute ice velocity
+      !!                
+      !! ** Method  : 
+      !!
+      !! ** Action  : - Initialisation
+      !!              - Call of the dynamic routine for each hemisphere
+      !!------------------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  :: jl, jk ! dummy loop indices
+      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+     !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('limdyn')
+
+      CALL lim_var_agg(1)                      ! aggregate ice categories
+      !
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+      
+      ! ice velocities before rheology
+      u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1)
+      v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1)
+      
+      ! Landfast ice parameterization: define max bottom friction
+      tau_icebfr(:,:) = 0._wp
+      IF( ln_landfast ) THEN
+         DO jl = 1, jpl
+            WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma )  tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr
+         END DO
+      ENDIF
+      
+      ! Rheology (ice dynamics)
+      ! ========     
+      CALL lim_rhg
+      !
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! Control prints
+      IF( ln_ctl )       CALL lim_prt3D( 'limdyn' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('limdyn')
+
+   END SUBROUTINE lim_dyn
+
+
+   SUBROUTINE lim_dyn_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dyn_init  ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to the ice
+      !!      dynamics
+      !!
+      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicedyn
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicedyn/ nn_limadv, nn_limadv_ord,  &
+         &                nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, &
+         &                nn_nevp, rn_relast, ln_landfast, rn_gamma, rn_icebfr, rn_lfrelax
+      !!-------------------------------------------------------------------
+
+      REWIND( numnam_ice_ref )              ! Namelist namicedyn in reference namelist : Ice dynamics
+      READ  ( numnam_ice_ref, namicedyn, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicedyn in configuration namelist : Ice dynamics
+      READ  ( numnam_ice_cfg, namicedyn, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicedyn )
+      
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         ! limtrp
+         WRITE(numout,*)'    choose the advection scheme (-1=Prather, 0=Ulimate-Macho)   nn_limadv     = ', nn_limadv 
+         WRITE(numout,*)'    choose the order of the scheme (if ultimate)                nn_limadv_ord = ', nn_limadv_ord  
+         ! limrhg
+         WRITE(numout,*)'    ice strength parameterization (0=Hibler 1=Rothrock)         nn_icestr     = ', nn_icestr 
+         WRITE(numout,*)'    Including brine volume in ice strength comp.                ln_icestr_bvf = ', ln_icestr_bvf
+         WRITE(numout,*)'    Ratio of ridging work to PotEner change in ridging          rn_pe_rdg     = ', rn_pe_rdg 
+         WRITE(numout,*) '   drag coefficient for oceanic stress                         rn_cio        = ', rn_cio
+         WRITE(numout,*) '   first bulk-rheology parameter                               rn_pstar      = ', rn_pstar
+         WRITE(numout,*) '   second bulk-rhelogy parameter                               rn_crhg       = ', rn_crhg
+         WRITE(numout,*) '   creep limit                                                 rn_creepl     = ', rn_creepl
+         WRITE(numout,*) '   eccentricity of the elliptical yield curve                  rn_ecc        = ', rn_ecc
+         WRITE(numout,*) '   number of iterations for subcycling                         nn_nevp       = ', nn_nevp
+         WRITE(numout,*) '   ratio of elastic timescale over ice time step               rn_relast     = ', rn_relast
+         WRITE(numout,*) '   Landfast: param (T or F)                                    ln_landfast   = ', ln_landfast
+         WRITE(numout,*) '   Landfast: fraction of ocean depth that ice must reach       rn_gamma      = ', rn_gamma
+         WRITE(numout,*) '   Landfast: maximum bottom stress per unit area of contact    rn_icebfr     = ', rn_icebfr
+         WRITE(numout,*) '   Landfast: relax time scale (s-1) to reach static friction   rn_lfrelax    = ', rn_lfrelax
+      ENDIF
+      !
+   END SUBROUTINE lim_dyn_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dyn         ! Empty routine
+   END SUBROUTINE lim_dyn
+#endif 
+
+   !!======================================================================
+END MODULE limdyn
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 8732)
@@ -0,0 +1,303 @@
+MODULE limhdf
+   !!======================================================================
+   !!                    ***  MODULE limhdf   ***
+   !! LIM ice model : horizontal diffusion of sea-ice quantities
+   !!======================================================================
+   !! History :  LIM  !  2000-01 (LIM) Original code
+   !!             -   !  2001-05 (G. Madec, R. Hordoir) opa norm
+   !!            1.0  !  2002-08 (C. Ethe)  F90, free form
+   !!            3.6  !  2015-08 (O. Tintó and M. Castrillo)  added lim_hdf (multiple)
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_hdf       : diffusion trend on sea-ice variable
+   !!   lim_hdf_init  : initialisation of diffusion trend on sea-ice variable
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE ice            ! LIM-3: ice variables
+   USE lbclnk         ! lateral boundary condition - MPP exchanges
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_hdf         ! called by lim_trp
+   PUBLIC   lim_hdf_init    ! called by sbc_lim_init
+
+   LOGICAL  ::   linit = .TRUE.                             ! initialization flag (set to flase after the 1st call)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   efact   ! metric coefficient
+
+   !! * Substitution 
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_hdf( ptab, ihdf_vars )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_hdf  ***
+      !!
+      !! ** purpose :   Compute and add the diffusive trend on sea-ice variables
+      !!
+      !! ** method  :   Second order diffusive operator evaluated using a
+      !!              Cranck-Nicholson time Scheme.
+      !!
+      !! ** Action  :    update ptab with the diffusive contribution
+      !!-------------------------------------------------------------------
+      INTEGER,                    INTENT( in )            ::  ihdf_vars ! number of fields to diffuse
+      REAL(wp), DIMENSION(:,:,:), INTENT( inout ), TARGET ::  ptab      ! Field on which the diffusion is applied
+      !
+      INTEGER                             ::  ji, jj, jk, jl, jm        ! dummy loop indices
+      INTEGER                             ::  iter, ierr, isize         ! local integers
+      REAL(wp)                            ::  zrlxint
+      CHARACTER(lc)                       ::  charout                   ! local character
+      REAL(wp), PARAMETER                 ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure
+      REAL(wp), PARAMETER                 ::  zalfa  = 0.5_wp           ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
+      INTEGER , PARAMETER                 ::  num_iter_max = 100        ! Maximum number of iteration
+      INTEGER , PARAMETER                 ::  num_convfrq  = 5          ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization)
+      REAL(wp), POINTER, DIMENSION(:)     ::  zconv
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zrlx, zdiv0, ztab0
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zflu, zflv, zdiv
+      !!-------------------------------------------------------------------
+      TYPE(arrayptr)   , ALLOCATABLE, DIMENSION(:) ::   pt2d_array, zrlx_array
+      CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) ::   type_array      ! define the nature of ptab array grid-points
+      !                                                                 ! = T , U , V , F , W and I points
+      REAL(wp)         , ALLOCATABLE, DIMENSION(:) ::   psgn_array      ! =-1 the sign change across the north fold boundary
+      !!-------------------------------------------------------------------
+      
+      !                       !==  Initialisation  ==!
+      ! +1 open water diffusion
+      isize = jpl * ( ihdf_vars + nlay_i ) + 1
+      ALLOCATE( zconv (isize) )
+      ALLOCATE( pt2d_array(isize) , zrlx_array(isize) )
+      ALLOCATE( type_array(isize) )
+      ALLOCATE( psgn_array(isize) )
+
+      CALL wrk_alloc( jpi,jpj,       zflu, zflv, zdiv )
+      CALL wrk_alloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )
+      
+      DO jk= 1, isize
+         pt2d_array(jk)%pt2d => ptab(:,:,jk)
+         zrlx_array(jk)%pt2d => zrlx(:,:,jk)
+         type_array(jk) = 'T'
+         psgn_array(jk) = 1.
+      END DO
+
+      !
+      IF( linit ) THEN              ! Metric coefficient (compute at the first call and saved in efact)
+         ALLOCATE( efact(jpi,jpj) , STAT=ierr )
+         IF( lk_mpp    )   CALL mpp_sum( ierr )
+         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' )
+         DO jj = 2, jpjm1  
+            DO ji = fs_2 , fs_jpim1   ! vector opt.
+               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj)
+            END DO
+         END DO
+         linit = .FALSE.
+      ENDIF
+      !
+      ! Arrays initialization
+      zflu(jpi,:) = 0._wp   
+      zflv(jpi,:) = 0._wp
+      DO jk=1 , isize
+         ztab0(:, : , jk ) = ptab(:,:,jk)
+         zdiv0(:, 1 , jk ) = 0._wp
+         zdiv0(:,jpj, jk ) = 0._wp
+         zdiv0(1,  :, jk ) = 0._wp
+         zdiv0(jpi,:, jk ) = 0._wp
+      END DO
+
+      !                !==  horizontal diffusion using a Crant-Nicholson scheme  ==!
+      zconv(:) = 1._wp
+      iter     = 0
+      !
+      DO WHILE( MAXVAL( zconv(:) ) > ( 2._wp * 1.e-04 ) .AND. iter <= num_iter_max )   ! Sub-time step loop
+         !
+         iter = iter + 1                                 ! incrementation of the sub-time step number
+         !
+         DO jk = 1 , isize
+            jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1
+            IF ( zconv(jk) > ( 2._wp * 1.e-04 ) ) THEN
+               DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
+                  DO ji = 1 , fs_jpim1   ! vector opt.
+                     zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) )
+                     zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) )
+                  END DO
+               END DO
+               !
+               DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
+                  DO ji = fs_2 , fs_jpim1   ! vector opt. 
+                     zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
+                  END DO
+               END DO
+               !
+               IF( iter == 1 )   zdiv0(:,:,jk) = zdiv(:,:)        ! save the 1st evaluation of the diffusive trend in zdiv0
+               !
+               DO jj = 2, jpjm1                                ! iterative evaluation
+                  DO ji = fs_2 , fs_jpim1   ! vector opt.
+                     zrlxint = (   ztab0(ji,jj,jk)    &
+                        &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj,jk) )   &
+                        &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj,jk) )                               &
+                        &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
+                     zrlx(ji,jj,jk) = ptab(ji,jj,jk) + zrelax * ( zrlxint - ptab(ji,jj,jk) )
+                  END DO
+               END DO
+            END IF
+
+         END DO
+
+         CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
+         !
+
+         IF ( MOD( iter-1 , num_convfrq ) == 0 )  THEN   ! Convergence test every num_convfrq iterations (perf. optimization ) 
+            DO jk = 1, isize
+               zconv(jk) = 0._wp                                   ! convergence test
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zconv(jk) = MAX( zconv(jk), ABS( zrlx(ji,jj,jk) - ptab(ji,jj,jk) )  )
+                  END DO
+               END DO
+            END DO
+            IF( lk_mpp ) CALL mpp_max_multiple( zconv , isize )            ! max over the global domain for all the variables
+         ENDIF
+         !
+         DO jk=1,isize
+            ptab(:,:,jk) = zrlx(:,:,jk)
+         END DO
+         !
+      END DO  ! end of sub-time step loop
+
+     ! --- final step --- !
+      DO jk = 1, isize
+         jl = ( jk - 1 ) / ( ihdf_vars + nlay_i ) + 1
+         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction
+            DO ji = 1 , fs_jpim1   ! vector opt.
+               zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) )
+               zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) )
+            END DO
+         END DO
+         !
+         DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes
+            DO ji = fs_2 , fs_jpim1   ! vector opt. 
+               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj)
+               ptab(ji,jj,jk) = ztab0(ji,jj,jk) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables
+
+      !
+      IF(ln_ctl)   THEN
+         DO jk = 1 , isize
+            zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk)
+            WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter
+            CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout )
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,       zflu, zflv, zdiv )
+      CALL wrk_dealloc( jpi,jpj,isize, zrlx, zdiv0, ztab0 )
+      !
+      DEALLOCATE( zconv )
+      DEALLOCATE( pt2d_array , zrlx_array )
+      DEALLOCATE( type_array )
+      DEALLOCATE( psgn_array )
+      !
+   END SUBROUTINE lim_hdf
+
+   
+   SUBROUTINE lim_hdf_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_hdf_init  ***
+      !!
+      !! ** Purpose : Initialisation of horizontal diffusion of sea-ice 
+      !!
+      !! ** Method  : Read the namicehdf namelist
+      !!
+      !! ** input   : Namelist namicehdf
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicehdf/ nn_ahi0, rn_ahi0_ref
+      INTEGER  ::   ji, jj
+      REAL(wp) ::   za00, zd_max
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion
+      READ  ( numnam_ice_ref, namicehdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicehdf in configuration namelist : Ice horizontal diffusion
+      READ  ( numnam_ice_cfg, namicehdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicehdf )
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_hdf_init : Ice horizontal diffusion'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   horizontal diffusivity calculation                          nn_ahi0      = ', nn_ahi0
+         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)                  rn_ahi0_ref  = ', rn_ahi0_ref
+      ENDIF
+      !
+      !  Diffusion coefficients
+      SELECT CASE( nn_ahi0 )
+
+      CASE( 0 )
+         ahiu(:,:) = rn_ahi0_ref
+         ahiv(:,:) = rn_ahi0_ref
+
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref'
+
+      CASE( 1 ) 
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain
+         
+         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2
+                                                        !                    (60deg = min latitude for ice cover)  
+         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp
+
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'
+         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp 
+         
+      CASE( 2 ) 
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+         
+         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60deg latitude in orca2
+                                                 !                    (60deg = min latitude for ice cover)  
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)
+               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)
+            END DO
+         END DO
+         !
+         IF(lwp) WRITE(numout,*) ''
+         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1'
+         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max
+         
+      END SELECT
+      !
+   END SUBROUTINE lim_hdf_init
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limhdf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 8732)
@@ -0,0 +1,571 @@
+MODULE limistate
+   !!======================================================================
+   !!                     ***  MODULE  limistate  ***
+   !!              Initialisation of diagnostics ice variables
+   !!======================================================================
+   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
+   !!            3.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2014    (C. Rousset) add N/S initializations
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                    LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_istate      :  Initialisation of diagnostics ice variables
+   !!   lim_istate_init :  initialization of ice state and namelist read
+   !!----------------------------------------------------------------------
+   USE phycst           ! physical constant
+   USE oce              ! dynamics and tracers variables
+   USE dom_oce          ! ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE eosbn2           ! equation of state
+   USE ice              ! sea-ice variables
+   USE par_oce          ! ocean parameters
+   USE limvar           ! lim_var_salprof
+   !
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE wrk_nemo         ! work arrays
+   USE fldread          ! read input fields
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_istate      ! routine called by lim_init.F90
+
+   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read
+   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point
+   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point
+   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point
+   INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point
+   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point
+   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read)
+   !!----------------------------------------------------------------------
+   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_istate
+      !!-------------------------------------------------------------------
+      !!                    ***  ROUTINE lim_istate  ***
+      !!
+      !! ** Purpose :   defined the sea-ice initial state
+      !!
+      !! ** Method  :   This routine will put some ice where ocean
+      !!                is at the freezing point, then fill in ice 
+      !!                state variables using prescribed initial 
+      !!                values in the namelist            
+      !!
+      !! ** Steps   :   1) Read namelist
+      !!                2) Basal temperature; ice and hemisphere masks
+      !!                3) Fill in the ice thickness distribution using gaussian
+      !!                4) Fill in space-dependent arrays for state variables
+      !!                5) Diagnostic arrays
+      !!                6) Lateral boundary conditions
+      !!
+      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even
+      !!              where there is no ice (clem: I do not know why, is it mandatory?) 
+      !!
+      !! History :
+      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code
+      !!   3.0  !  2007   (M. Vancoppenolle)   Rewrite for ice cats
+      !!   4.0  !  09-11  (M. Vancoppenolle)   Enhanced version for ice cats
+      !!--------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) :: ztmelts, zdh
+      INTEGER  :: i_hemis, i_fill, jl0  
+      REAL(wp)   :: zarg, zV, zconv, zdv 
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini                         !data by cattegories to fill
+      INTEGER , POINTER, DIMENSION(:)     :: itest
+      !--------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini )
+      CALL wrk_alloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
+      CALL wrk_alloc( jpi, jpj,      zswitch )
+      Call wrk_alloc( 4,             itest )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~ '
+
+      !--------------------------------------------------------------------
+      ! 1) Read namelist
+      !--------------------------------------------------------------------
+      !
+      CALL lim_istate_init
+
+      ! init surface temperature
+      DO jl = 1, jpl
+         t_su  (:,:,jl) = rt0 * tmask(:,:,1)
+         tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
+      END DO
+
+      ! init basal temperature (considered at freezing point)
+      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
+      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
+
+
+      !--------------------------------------------------------------------
+      ! 2) Initialization of sea ice state variables
+      !--------------------------------------------------------------------
+      IF( ln_limini ) THEN
+         !
+         IF( ln_limini_file )THEN
+         !
+            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1)
+            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1)
+            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1)
+            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1)
+            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1)
+            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1)
+            !
+            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 
+            ELSEWHERE                       ; zswitch(:,:) = 0._wp
+            END WHERE
+            !
+         ELSE ! ln_limini_file = F
+
+            !--------------------------------------------------------------------
+            ! 3) Basal temperature, ice mask
+            !--------------------------------------------------------------------
+            ! no ice if sst <= t-freez + ttest
+            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 
+            ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1)
+            END WHERE
+
+            !-----------------------------
+            ! 3.1) Hemisphere-dependent arrays
+            !-----------------------------
+            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( ff_t(ji,jj) >= 0._wp ) THEN
+                     zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj)
+                     zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj)
+                     zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj)
+                     zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj)
+                     zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj)
+                     ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj)
+                  ELSE
+                     zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj)
+                     zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj)
+                     zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj)
+                     zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj)
+                     zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj)
+                     ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj)
+                  ENDIF
+               END DO
+            END DO
+            !
+         ENDIF ! ln_limini_file
+         
+         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume
+         !---------------------------------------------------------------------
+         ! 3.2) Distribute ice concentration and thickness into the categories
+         !---------------------------------------------------------------------
+         ! a gaussian distribution for ice concentration is used
+         ! then we check whether the distribution fullfills
+         ! volume and area conservation, positivity and ice categories bounds
+         zh_i_ini(:,:,:) = 0._wp 
+         za_i_ini(:,:,:) = 0._wp
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN
+
+                  !--- jl0: most likely index where cc will be maximum
+                  jl0 = jpl
+                  DO jl = 1, jpl
+                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN
+                        jl0 = jl
+                        CYCLE
+                     ENDIF
+                  END DO
+                  !
+                  ! initialisation of tests
+                  itest(:)  = 0
+                  
+                  i_fill = jpl + 1                                             !====================================
+                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories
+                     ! iteration                                               !====================================
+                     i_fill = i_fill - 1
+
+                     ! initialisation of ice variables for each try
+                     zh_i_ini(ji,jj,:) = 0._wp 
+                     za_i_ini(ji,jj,:) = 0._wp
+                     itest(:) = 0
+                     !
+                     ! *** case very thin ice: fill only category 1
+                     IF ( i_fill == 1 ) THEN
+                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj)
+                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj)
+
+                     ! *** case ice is thicker: fill categories >1
+                     ELSE
+
+                        ! Fill ice thicknesses in the (i_fill-1) cat by hmean 
+                        DO jl = 1, i_fill-1
+                           zh_i_ini(ji,jj,jl) = hi_mean(jl)
+                        END DO
+                        !
+                        !--- Concentrations
+                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl))
+                        DO jl = 1, i_fill - 1
+                           IF( jl /= jl0 )THEN
+                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) )
+                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2)
+                           ENDIF
+                        END DO
+                        !
+                        ! Concentration in the last (i_fill) category
+                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) )
+
+                        ! Ice thickness in the last (i_fill) category
+                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) )
+                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 
+
+                        ! clem: correction if concentration of upper cat is greater than lower cat
+                        !       (it should be a gaussian around jl0 but sometimes it is not)
+                        IF ( jl0 /= jpl ) THEN
+                           DO jl = jpl, jl0+1, -1
+                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN
+                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl)
+                                 zh_i_ini(ji,jj,jl    ) = 0._wp
+                                 za_i_ini(ji,jj,jl    ) = 0._wp
+                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  &
+                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 )
+                              END IF
+                           ENDDO
+                        ENDIF
+                        !
+                     ENDIF ! case ice is thick or thin
+
+                     !---------------------
+                     ! Compatibility tests
+                     !---------------------
+                     ! Test 1: area conservation
+                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) )
+                     IF ( zconv < epsi06 ) itest(1) = 1
+                     
+                     ! Test 2: volume conservation
+                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   &
+                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) )
+                     IF ( zconv < epsi06 ) itest(2) = 1
+                     
+                     ! Test 3: thickness of the last category is in-bounds ?
+                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
+                     
+                     ! Test 4: positivity of ice concentrations
+                     itest(4) = 1
+                     DO jl = 1, i_fill
+                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0
+                     END DO
+                     !                                      !============================
+                  END DO                                    ! end iteration on categories
+                  !                                         !============================
+                  !
+                  IF( lwp .AND. SUM(itest) /= 4 ) THEN 
+                     WRITE(numout,*)
+                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! '
+                     WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
+                     WRITE(numout,*)
+                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:)
+                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj)
+                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj)
+                  ENDIF
+               
+               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp
+               !
+            END DO   
+         END DO   
+
+         !---------------------------------------------------------------------
+         ! 3.3) Space-dependent arrays for ice state variables
+         !---------------------------------------------------------------------
+
+         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
+         DO jl = 1, jpl ! loop over categories
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration
+                  ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness
+                  sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity
+                  o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                                    ! age (1 day)
+                  t_su(ji,jj,jl)  = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
+
+                  IF( zht_i_ini(ji,jj) > 0._wp )THEN
+                    ht_s(ji,jj,jl)= ht_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth
+                  ELSE
+                    ht_s(ji,jj,jl)= 0._wp
+                  ENDIF
+
+                  ! This case below should not be used if (ht_s/ht_i) is ok in namelist
+                  ! In case snow load is in excess that would lead to transformation from snow to ice
+                  ! Then, transfer the snow excess into the ice (different from limthd_dh)
+                  zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 ) 
+                  ! recompute ht_i, ht_s avoiding out of bounds values
+                  ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
+                  ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
+
+                  ! ice volume, salt content, age content
+                  v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
+                  v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
+                  smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
+                  oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
+               END DO
+            END DO
+         END DO
+
+         ! for constant salinity in time
+         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
+            CALL lim_var_salprof
+            smv_i = sm_i * v_i
+         ENDIF
+            
+         ! Snow temperature and heat content
+         DO jk = 1, nlay_s
+            DO jl = 1, jpl ! loop over categories
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0
+                     ! Snow energy of melting
+                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+
+                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         ! Ice salinity, temperature and heat content
+         DO jk = 1, nlay_i
+            DO jl = 1, jpl ! loop over categories
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
+                     s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin
+                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
+
+                     ! heat content per unit volume
+                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                        +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                        -   rcp     * ( ztmelts - rt0 ) )
+
+                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         tn_ice (:,:,:) = t_su (:,:,:)
+
+      ELSE ! if ln_limini=false
+         a_i  (:,:,:) = 0._wp
+         v_i  (:,:,:) = 0._wp
+         v_s  (:,:,:) = 0._wp
+         smv_i(:,:,:) = 0._wp
+         oa_i (:,:,:) = 0._wp
+         ht_i (:,:,:) = 0._wp
+         ht_s (:,:,:) = 0._wp
+         sm_i (:,:,:) = 0._wp
+         o_i  (:,:,:) = 0._wp
+
+         e_i(:,:,:,:) = 0._wp
+         e_s(:,:,:,:) = 0._wp
+
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
+            END DO
+            DO jk = 1, nlay_s
+               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
+            END DO
+         END DO
+
+      ENDIF ! ln_limini
+      
+      at_i (:,:) = 0.0_wp
+      DO jl = 1, jpl
+         at_i (:,:) = at_i (:,:) + a_i (:,:,jl)
+      END DO
+      !
+      !--------------------------------------------------------------------
+      ! 4) Global ice variables for output diagnostics                    | 
+      !--------------------------------------------------------------------
+      u_ice (:,:)     = 0._wp
+      v_ice (:,:)     = 0._wp
+      stress1_i(:,:)  = 0._wp
+      stress2_i(:,:)  = 0._wp
+      stress12_i(:,:) = 0._wp
+
+      !--------------------------------------------------------------------
+      ! 5) Moments for advection
+      !--------------------------------------------------------------------
+
+      sxopw (:,:) = 0._wp 
+      syopw (:,:) = 0._wp 
+      sxxopw(:,:) = 0._wp 
+      syyopw(:,:) = 0._wp 
+      sxyopw(:,:) = 0._wp
+
+      sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp
+      syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp
+      sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp
+      syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp
+      sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp
+
+      sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp   
+      syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp   
+      sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp   
+      syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp   
+      sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp   
+
+      sxsal  (:,:,:)  = 0._wp
+      sysal  (:,:,:)  = 0._wp
+      sxxsal (:,:,:)  = 0._wp
+      syysal (:,:,:)  = 0._wp
+      sxysal (:,:,:)  = 0._wp
+
+      sxage  (:,:,:)  = 0._wp
+      syage  (:,:,:)  = 0._wp
+      sxxage (:,:,:)  = 0._wp
+      syyage (:,:,:)  = 0._wp
+      sxyage (:,:,:)  = 0._wp
+
+      !------------------------------------
+      ! 6) store fields at before time-step
+      !------------------------------------
+      ! it is only necessary for the 1st interpolation by Agrif
+      a_i_b  (:,:,:)   = a_i  (:,:,:)
+      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)
+      v_i_b  (:,:,:)   = v_i  (:,:,:)
+      v_s_b  (:,:,:)   = v_s  (:,:,:)
+      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)
+      smv_i_b(:,:,:)   = smv_i(:,:,:)
+      oa_i_b (:,:,:)   = oa_i (:,:,:)
+      u_ice_b(:,:)     = u_ice(:,:)
+      v_ice_b(:,:)     = v_ice(:,:)
+
+!!!clem
+!!      ! Output the initial state and forcings
+!!      CALL dia_wri_state( 'output.init', nit000 )
+!!!      
+
+      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini )
+      CALL wrk_dealloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
+      CALL wrk_dealloc( jpi, jpj,      zswitch )
+      Call wrk_dealloc( 4,             itest )
+
+   END SUBROUTINE lim_istate
+
+   SUBROUTINE lim_istate_init
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_istate_init  ***
+      !!        
+      !! ** Purpose : Definition of initial state of the ice 
+      !!
+      !! ** 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 
+      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
+      !!-----------------------------------------------------------------------------
+      !
+      INTEGER :: ios,ierr,inum_ice                 ! Local integer output status for namelist read
+      INTEGER :: ji,jj
+      INTEGER :: ifpr, ierror
+      !
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ice files
+      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi
+      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read
+      !
+      NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  &
+         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, &
+         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             &
+         &                sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir
+      !!-----------------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state
+      READ  ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceini in configuration namelist : Ice initial state
+      READ  ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceini )
+
+      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts
+      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu
+      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi
+
+      ! Define the initial parameters
+      ! -------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini     = ', ln_limini
+         WRITE(numout,*) '   ice initialization from a netcdf file      ln_limini_file  = ', ln_limini_file
+         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
+         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
+         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s 
+         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n
+         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s
+         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n
+         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s
+         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n
+         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s
+         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n
+         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s
+      ENDIF
+
+      IF( ln_limini_file ) THEN                      ! Ice initialization using input file
+         !
+         ! set si structure
+         ALLOCATE( si(jpfldi), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'Ice_ini in limistate: unable to allocate si structure' )   ;   RETURN
+         ENDIF
+
+         DO ifpr = 1, jpfldi
+            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
+            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
+
+         ! fill si with slf_i and control print
+         CALL fld_fill( si, slf_i, cn_dir, 'lim_istate', 'lim istate ini', 'numnam_ice' )
+
+         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step
+
+      ENDIF
+
+   END SUBROUTINE lim_istate_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module          NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_istate          ! Empty routine
+   END SUBROUTINE lim_istate
+#endif
+
+   !!======================================================================
+END MODULE limistate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 8732)
@@ -0,0 +1,962 @@
+MODULE limitd_me
+   !!======================================================================
+   !!                       ***  MODULE limitd_me ***
+   !! LIM-3 : Mechanical impact on ice thickness distribution      
+   !!======================================================================
+   !! History :  LIM  ! 2006-02  (M. Vancoppenolle) Original code 
+   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE dom_oce          ! ocean domain
+   USE phycst           ! physical constants (ocean directory) 
+   USE sbc_oce          ! surface boundary condition: ocean fields
+   USE thd_ice          ! LIM thermodynamics
+   USE ice              ! LIM variables
+   USE limvar           ! LIM
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   USE in_out_manager   ! I/O manager
+   USE iom              ! I/O manager
+   USE lib_fortran      ! glob_sum
+   USE timing           ! Timing
+   USE limcons          ! conservation tests
+   USE limctl           ! control prints
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_itd_me               ! called by ice_stp
+   PUBLIC   lim_itd_me_icestrength
+   PUBLIC   lim_itd_me_init
+   PUBLIC   lim_itd_me_alloc        ! called by sbc_lim_init 
+
+   !-----------------------------------------------------------------------
+   ! Variables shared among ridging subroutines
+   !-----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/closing associated w/ category n
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   hraft    ! thickness of rafted ice
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   krdg     ! thickness of ridging ice / mean ridge thickness
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   aridge   ! participating ice ridging
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   araft    ! participating ice rafting
+
+   REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier
+   REAL(wp), PARAMETER ::   kraft   = 0.5_wp    ! rafting multipliyer
+
+   REAL(wp) ::   Cp                             ! 
+   !
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lim_itd_me_alloc()
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE lim_itd_me_alloc ***
+      !!---------------------------------------------------------------------!
+      ALLOCATE(                                                                      &
+         !* Variables shared among ridging subroutines
+         &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,   &
+         &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl)    , aridge(jpi,jpj,jpl) ,   &
+         &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl)    , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc )
+         !
+      IF( lim_itd_me_alloc /= 0 )   CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' )
+      !
+   END FUNCTION lim_itd_me_alloc
+
+
+   SUBROUTINE lim_itd_me
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE lim_itd_me ***
+      !!
+      !! ** Purpose :   computes the mechanical redistribution of ice thickness
+      !!
+      !! ** Method  :   Steps :
+      !!       1) Thickness categories boundaries, ice / o.w. concentrations
+      !!          Ridge preparation
+      !!       2) Dynamical inputs (closing rate, divu_adv, opning)
+      !!       3) Ridging iteration
+      !!       4) Ridging diagnostics
+      !!       5) Heat, salt and freshwater fluxes
+      !!       6) Compute increments of tate variables and come back to old values
+      !!
+      !! References :   Flato, G. M., and W. D. Hibler III, 1995, JGR, 100, 18,611-18,626.
+      !!                Hibler, W. D. III, 1980, MWR, 108, 1943-1973, 1980.
+      !!                Rothrock, D. A., 1975: JGR, 80, 4514-4519.
+      !!                Thorndike et al., 1975, JGR, 80, 4501-4513. 
+      !!                Bitz et al., JGR, 2001
+      !!                Amundrud and Melling, JGR 2005
+      !!                Babko et al., JGR 2002 
+      !!
+      !!     This routine is based on CICE code and authors William H. Lipscomb,
+      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged
+      !!--------------------------------------------------------------------!
+      INTEGER  ::   ji, jj, jk, jl        ! dummy loop index
+      INTEGER  ::   niter                 ! local integer 
+      INTEGER  ::   iterate_ridging       ! if true, repeat the ridging
+      REAL(wp) ::   za, zfac              ! local scalar
+      CHARACTER (len = 15) ::   fieldid
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_net     ! net rate at which area is removed    (1/s)
+                                                               ! (ridging ice area - area of new ridges) / dt
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   divu_adv        ! divu as implied by transport scheme  (1/s)
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges
+      !
+      INTEGER, PARAMETER ::   nitermax = 20    
+      !
+      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      !!-----------------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('limitd_me')
+
+      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross )
+
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !-----------------------------------------------------------------------------!
+      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
+      !-----------------------------------------------------------------------------!
+      Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0             ! proport const for PE
+      !
+      CALL lim_itd_me_ridgeprep                                    ! prepare ridging
+      !
+
+      DO jj = 1, jpj                                     ! Initialize arrays.
+         DO ji = 1, jpi
+
+            !-----------------------------------------------------------------------------!
+            ! 2) Dynamical inputs (closing rate, divu_adv, opning)
+            !-----------------------------------------------------------------------------!
+            !
+            ! 2.1 closing_net
+            !-----------------
+            ! Compute the net rate of closing due to convergence 
+            ! and shear, based on Flato and Hibler (1995).
+            ! 
+            ! The energy dissipation rate is equal to the net closing rate
+            ! times the ice strength.
+            !
+            ! NOTE: The NET closing rate is equal to the rate that open water 
+            !  area is removed, plus the rate at which ice area is removed by 
+            !  ridging, minus the rate at which area is added in new ridges.
+            !  The GROSS closing rate is equal to the first two terms (open
+            !  water closing and thin ice ridging) without the third term
+            !  (thick, newly ridged ice).
+
+            closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
+
+            ! 2.2 divu_adv
+            !--------------
+            ! Compute divu_adv, the divergence rate given by the transport/
+            ! advection scheme, which may not be equal to divu as computed 
+            ! from the velocity field.
+            !
+            ! If divu_adv < 0, make sure the closing rate is large enough
+            ! to give asum = 1.0 after ridging.
+            
+            divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep
+
+            IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) )
+
+            ! 2.3 opning
+            !------------
+            ! Compute the (non-negative) opening rate that will give asum = 1.0 after ridging.
+            opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj)
+         END DO
+      END DO
+
+      !-----------------------------------------------------------------------------!
+      ! 3) Ridging iteration
+      !-----------------------------------------------------------------------------!
+      niter           = 1                 ! iteration counter
+      iterate_ridging = 1
+
+      DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax )
+
+         ! 3.2 closing_gross
+         !-----------------------------------------------------------------------------!
+         ! Based on the ITD of ridging and ridged ice, convert the net
+         !  closing rate to a gross closing rate.  
+         ! NOTE: 0 < aksum <= 1
+         closing_gross(:,:) = closing_net(:,:) / aksum(:,:)
+
+         ! correction to closing rate and opening if closing rate is excessive
+         !---------------------------------------------------------------------
+         ! Reduce the closing rate if more than 100% of the open water 
+         ! would be removed.  Reduce the opening rate proportionately.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               za   = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice
+               IF    ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN                  ! would lead to negative ato_i
+                  zfac          = - ato_i(ji,jj) / za
+                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 
+               ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum
+                  zfac          = ( asum(ji,jj) - ato_i(ji,jj) ) / za
+                  opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 
+               ENDIF
+            END DO
+         END DO
+
+         ! correction to closing rate / opening if excessive ice removal
+         !---------------------------------------------------------------
+         ! Reduce the closing rate if more than 100% of any ice category 
+         ! would be removed.  Reduce the opening rate proportionately.
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
+                  IF( za  >  a_i(ji,jj,jl) ) THEN
+                     zfac = a_i(ji,jj,jl) / za
+                     closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+         ! 3.3 Redistribute area, volume, and energy.
+         !-----------------------------------------------------------------------------!
+
+         CALL lim_itd_me_ridgeshift( opning, closing_gross )
+
+         
+         ! 3.4 Compute total area of ice plus open water after ridging.
+         !-----------------------------------------------------------------------------!
+         ! This is in general not equal to one because of divergence during transport
+         asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 )
+
+         ! 3.5 Do we keep on iterating ???
+         !-----------------------------------------------------------------------------!
+         ! Check whether asum = 1.  If not (because the closing and opening
+         ! rates were reduced above), ridge again with new rates.
+
+         iterate_ridging = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( ABS( asum(ji,jj) - 1._wp ) < epsi10 ) THEN
+                  closing_net(ji,jj) = 0._wp
+                  opning     (ji,jj) = 0._wp
+                  ato_i      (ji,jj) = MAX( 0._wp, 1._wp - SUM( a_i(ji,jj,:) ) )
+               ELSE
+                  iterate_ridging    = 1
+                  divu_adv   (ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice
+                  closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) )
+                  opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         IF( lk_mpp )   CALL mpp_max( iterate_ridging )
+
+         ! Repeat if necessary.
+         ! NOTE: If strength smoothing is turned on, the ridging must be
+         ! iterated globally because of the boundary update in the 
+         ! smoothing.
+
+         niter = niter + 1
+
+         IF( iterate_ridging == 1 ) THEN
+            CALL lim_itd_me_ridgeprep
+            IF( niter  >  nitermax ) THEN
+               WRITE(numout,*) ' ALERTE : non-converging ridging scheme '
+               WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging
+            ENDIF
+         ENDIF
+
+      END DO !! on the do while over iter
+
+      CALL lim_var_agg( 1 ) 
+
+      !-----------------------------------------------------------------------------!
+      ! control prints
+      !-----------------------------------------------------------------------------!
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! control prints
+      IF( ln_ctl )       CALL lim_prt3D( 'limitd_me' )
+
+      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('limitd_me')
+   END SUBROUTINE lim_itd_me
+
+   SUBROUTINE lim_itd_me_ridgeprep
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE lim_itd_me_ridgeprep ***
+      !!
+      !! ** Purpose :   preparation for ridging and strength calculations
+      !!
+      !! ** Method  :   Compute the thickness distribution of the ice and open water 
+      !!              participating in ridging and of the resulting ridges.
+      !!---------------------------------------------------------------------!
+      INTEGER ::   ji,jj, jl    ! dummy loop indices
+      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
+      !------------------------------------------------------------------------------!
+
+      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+
+      Gstari     = 1.0/rn_gstar    
+      astari     = 1.0/rn_astar    
+      aksum(:,:)    = 0.0
+      athorn(:,:,:) = 0.0
+      aridge(:,:,:) = 0.0
+      araft (:,:,:) = 0.0
+
+      ! Zero out categories with very small areas
+      CALL lim_var_zapsmall
+
+      ! Ice thickness needed for rafting
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+           END DO
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! 1) Participation function 
+      !------------------------------------------------------------------------------!
+
+      ! Compute total area of ice plus open water.
+      ! This is in general not equal to one because of divergence during transport
+      asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 )
+
+      ! Compute cumulative thickness distribution function
+      ! Compute the cumulative thickness distribution function Gsum,
+      ! where Gsum(n) is the fractional area in categories 0 to n.
+      ! initial value (in h = 0) equals open water area
+      Gsum(:,:,-1) = 0._wp
+      Gsum(:,:,0 ) = ato_i(:,:)
+      ! for each value of h, you have to add ice concentration then
+      DO jl = 1, jpl
+         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
+      END DO
+
+      ! Normalize the cumulative distribution to 1
+      DO jl = 0, jpl
+         Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:)
+      END DO
+
+      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)
+      !--------------------------------------------------------------------------------------------------
+      ! Compute the participation function athorn; this is analogous to
+      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
+      ! area lost from category n due to ridging/closing
+      ! athorn(n)   = total area lost due to ridging/closing
+      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
+      !
+      ! The expressions for athorn are found by integrating b(h)g(h) between
+      ! the category boundaries.
+      ! athorn is always >= 0 and SUM(athorn(0:jpl))=1
+      !-----------------------------------------------------------------
+
+      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
+         DO jl = 0, jpl    
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  IF    ( Gsum(ji,jj,jl)   < rn_gstar ) THEN
+                     athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
+                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
+                  ELSEIF( Gsum(ji,jj,jl-1) < rn_gstar ) THEN
+                     athorn(ji,jj,jl) = Gstari * ( rn_gstar       - Gsum(ji,jj,jl-1) ) *  &
+                        &                        ( 2._wp - ( Gsum(ji,jj,jl-1) + rn_gstar       ) * Gstari )
+                  ELSE
+                     athorn(ji,jj,jl) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
+         !                        
+         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
+         DO jl = -1, jpl
+            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
+         END DO
+         DO jl = 0, jpl
+             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
+         END DO
+         !
+      ENDIF
+
+      ! --- Ridging and rafting participation concentrations --- !
+      IF( ln_rafting .AND. ln_ridging ) THEN
+         !
+         DO jl = 1, jpl
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  zdummy           = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) )
+                  aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl)
+                  araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl)
+               END DO
+            END DO
+         END DO
+         !
+      ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN
+         !
+         DO jl = 1, jpl
+            aridge(:,:,jl) = athorn(:,:,jl)
+         END DO
+         !
+      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN
+         !
+         DO jl = 1, jpl
+            araft(:,:,jl) = athorn(:,:,jl)
+         END DO
+         !
+      ENDIF
+
+      !-----------------------------------------------------------------
+      ! 2) Transfer function
+      !-----------------------------------------------------------------
+      ! Compute max and min ridged ice thickness for each ridging category.
+      ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
+      ! 
+      ! This parameterization is a modified version of Hibler (1980).
+      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5)
+      !  and for very thick ridging ice must be >= krdgmin*hi
+      !
+      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
+      !  (i.e., rafting) and for very thick ridging ice is
+      !  constrained by hrmin <= (hrmean + hi)/2.
+      ! 
+      ! The maximum ridging thickness, hrmax, is determined by
+      !  hrmean and hrmin.
+      !
+      ! These modifications have the effect of reducing the ice strength
+      ! (relative to the Hibler formulation) when very thick ice is
+      ! ridging.
+      !
+      ! aksum = net area removed/ total area removed
+      ! where total area removed = area of ice that ridges
+      !         net area removed = total area removed - area of new ridges
+      !-----------------------------------------------------------------
+
+      aksum(:,:) = athorn(:,:,0)
+      ! Transfer function
+      DO jl = 1, jpl !all categories have a specific transfer function
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               
+               IF( athorn(ji,jj,jl) > 0._wp ) THEN
+                  hrmean          = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin )
+                  hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( hrmean + ht_i(ji,jj,jl) ) )
+                  hrmax(ji,jj,jl) = 2._wp * hrmean - hrmin(ji,jj,jl)
+                  hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft
+                  krdg(ji,jj,jl)  = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 )
+
+                  ! Normalization factor : aksum, ensures mass conservation
+                  aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) )    &
+                     &                        + araft (ji,jj,jl) * ( 1._wp - kraft          )
+
+               ELSE
+                  hrmin(ji,jj,jl)  = 0._wp 
+                  hrmax(ji,jj,jl)  = 0._wp 
+                  hraft(ji,jj,jl)  = 0._wp 
+                  krdg (ji,jj,jl)  = 1._wp
+               ENDIF
+
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+      !
+   END SUBROUTINE lim_itd_me_ridgeprep
+
+
+   SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_me_icestrength ***
+      !!
+      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness
+      !!
+      !! ** Method  :   Remove area, volume, and energy from each ridging category
+      !!              and add to thicker ice categories.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges
+      !
+      CHARACTER (len=80) ::   fieldid   ! field identifier
+      !
+      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
+      INTEGER ::   ij                ! horizontal index, combines i and j loops
+      INTEGER ::   icells            ! number of cells with a_i > puny
+      REAL(wp) ::   hL, hR, farea    ! left and right limits of integration
+
+      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
+      REAL(wp), POINTER, DIMENSION(:) ::   zswitch, fvol   ! new ridge volume going to n2
+
+      REAL(wp), POINTER, DIMENSION(:) ::   afrac            ! fraction of category area ridged 
+      REAL(wp), POINTER, DIMENSION(:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
+      REAL(wp), POINTER, DIMENSION(:) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2
+
+      REAL(wp), POINTER, DIMENSION(:) ::   vrdg1   ! volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:) ::   vrdg2   ! volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   vsw     ! volume of seawater trapped into ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   srdg1   ! sal*volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:) ::   srdg2   ! sal*volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   smsw    ! sal*volume of water trapped into ridges
+      REAL(wp), POINTER, DIMENSION(:) ::   oirdg1, oirdg2   ! ice age of ice ridged
+
+      REAL(wp), POINTER, DIMENSION(:) ::   afrft            ! fraction of category area rafted
+      REAL(wp), POINTER, DIMENSION(:) ::   arft1 , arft2    ! area of ice rafted and new rafted zone
+      REAL(wp), POINTER, DIMENSION(:) ::   virft , vsrft    ! ice & snow volume of rafting ice
+      REAL(wp), POINTER, DIMENSION(:) ::   esrft , smrft    ! snow energy & salinity of rafting ice
+      REAL(wp), POINTER, DIMENSION(:) ::   oirft1, oirft2   ! ice age of ice rafted
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   eirft      ! ice energy of rafting ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg1      ! enth*volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:,:) ::   erdg2      ! enth*volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ersw       ! enth of water trapped into ridges
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij,        indxi, indxj )
+      CALL wrk_alloc( jpij,        zswitch, fvol )
+      CALL wrk_alloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_alloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_alloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )
+
+      !-------------------------------------------------------------------------------
+      ! 1) Compute change in open water area due to closing and opening.
+      !-------------------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) +  &
+               &                     ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice )
+         END DO
+      END DO
+
+      !-----------------------------------------------------------------
+      ! 3) Pump everything from ice which is being ridged / rafted
+      !-----------------------------------------------------------------
+      ! Compute the area, volume, and energy of ice ridging in each
+      ! category, along with the area of the resulting ridge.
+
+      DO jl1 = 1, jpl !jl1 describes the ridging category
+
+         !------------------------------------------------
+         ! 3.1) Identify grid cells with nonzero ridging
+         !------------------------------------------------
+         icells = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( athorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN
+                  icells = icells + 1
+                  indxi(icells) = ji
+                  indxj(icells) = jj
+               ENDIF
+            END DO
+         END DO
+
+         DO ij = 1, icells
+            ji = indxi(ij) ; jj = indxj(ij)
+
+            !--------------------------------------------------------------------
+            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)
+            !--------------------------------------------------------------------
+            ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice
+            arft1(ij) = araft (ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice
+
+            !---------------------------------------------------------------
+            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
+            !---------------------------------------------------------------
+            afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging
+            afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting
+            ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1)
+            arft2(ij) = arft1(ij) * kraft
+
+            !--------------------------------------------------------------------------
+            ! 3.4) Subtract area, volume, and energy from ridging 
+            !     / rafting category n1.
+            !--------------------------------------------------------------------------
+            vrdg1(ij) = v_i(ji,jj,jl1) * afrac(ij)
+            vrdg2(ij) = vrdg1(ij) * ( 1. + rn_por_rdg )
+            vsw  (ij) = vrdg1(ij) * rn_por_rdg
+
+            vsrdg (ij) = v_s  (ji,jj,  jl1) * afrac(ij)
+            esrdg (ij) = e_s  (ji,jj,1,jl1) * afrac(ij)
+            srdg1 (ij) = smv_i(ji,jj,  jl1) * afrac(ij)
+            oirdg1(ij) = oa_i (ji,jj,  jl1) * afrac(ij)
+            oirdg2(ij) = oa_i (ji,jj,  jl1) * afrac(ij) * krdg(ji,jj,jl1) 
+
+            ! rafting volumes, heat contents ...
+            virft (ij) = v_i  (ji,jj,  jl1) * afrft(ij)
+            vsrft (ij) = v_s  (ji,jj,  jl1) * afrft(ij)
+            esrft (ij) = e_s  (ji,jj,1,jl1) * afrft(ij)
+            smrft (ij) = smv_i(ji,jj,  jl1) * afrft(ij) 
+            oirft1(ij) = oa_i (ji,jj,  jl1) * afrft(ij) 
+            oirft2(ij) = oa_i (ji,jj,  jl1) * afrft(ij) * kraft 
+
+            !-----------------------------------------------------------------
+            ! 3.5) Compute properties of new ridges
+            !-----------------------------------------------------------------
+            smsw(ij)  = vsw(ij) * sss_m(ji,jj)                   ! salt content of seawater frozen in voids
+            srdg2(ij) = srdg1(ij) + smsw(ij)                     ! salt content of new ridge
+            
+            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ij) * rhoic * r1_rdtice
+            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids
+
+            ! virtual salt flux to keep salinity constant
+            IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
+               srdg2(ij)      = srdg2(ij) - vsw(ij) * ( sss_m(ji,jj) - sm_i(ji,jj,jl1) )           ! ridge salinity = sm_i
+               sfx_bri(ji,jj) = sfx_bri(ji,jj) + sss_m(ji,jj)    * vsw(ij) * rhoic * r1_rdtice  &  ! put back sss_m into the ocean
+                  &                            - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice     ! and get  sm_i  from the ocean 
+            ENDIF
+               
+            !------------------------------------------            
+            ! 3.7 Put the snow somewhere in the ocean
+            !------------------------------------------            
+            !  Place part of the snow lost by ridging into the ocean. 
+            !  Note that esrdg > 0; the ocean must cool to melt snow.
+            !  If the ocean temp = Tf already, new ice must grow.
+            !  During the next time step, thermo_rates will determine whether
+            !  the ocean cools or new ice grows.
+            wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsnowrdg )   & 
+               &                              + rhosn * vsrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice  ! fresh water source for ocean
+
+            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg )         & 
+               &                                - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice        ! heat sink for ocean (<0, W.m-2)
+
+            !-----------------------------------------------------------------
+            ! 3.8 Compute quantities used to apportion ice among categories
+            ! in the n2 loop below
+            !-----------------------------------------------------------------
+            dhr (ij) = 1._wp / ( hrmax(ji,jj,jl1)                    - hrmin(ji,jj,jl1)                    )
+            dhr2(ij) = 1._wp / ( hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) )
+
+
+            ! update jl1 (removing ridged/rafted area)
+            a_i  (ji,jj,  jl1) = a_i  (ji,jj,  jl1) - ardg1 (ij) - arft1 (ij)
+            v_i  (ji,jj,  jl1) = v_i  (ji,jj,  jl1) - vrdg1 (ij) - virft (ij)
+            v_s  (ji,jj,  jl1) = v_s  (ji,jj,  jl1) - vsrdg (ij) - vsrft (ij)
+            e_s  (ji,jj,1,jl1) = e_s  (ji,jj,1,jl1) - esrdg (ij) - esrft (ij)
+            smv_i(ji,jj,  jl1) = smv_i(ji,jj,  jl1) - srdg1 (ij) - smrft (ij)
+            oa_i (ji,jj,  jl1) = oa_i (ji,jj,  jl1) - oirdg1(ij) - oirft1(ij)
+
+         END DO
+
+         !--------------------------------------------------------------------
+         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and
+         !      compute ridged ice enthalpy 
+         !--------------------------------------------------------------------
+         DO jk = 1, nlay_i
+            DO ij = 1, icells
+               ji = indxi(ij) ; jj = indxj(ij)
+               ! heat content of ridged ice
+               erdg1(ij,jk) = e_i(ji,jj,jk,jl1) * afrac(ij) 
+               eirft(ij,jk) = e_i(ji,jj,jk,jl1) * afrft(ij)               
+               
+               ! enthalpy of the trapped seawater (J/m2, >0)
+               ! clem: if sst>0, then ersw <0 (is that possible?)
+               ersw(ij,jk)  = - rhoic * vsw(ij) * rcp * sst_m(ji,jj) * r1_nlay_i
+
+               ! heat flux to the ocean
+               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ij,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux 
+
+               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
+               erdg2(ij,jk) = erdg1(ij,jk) + ersw(ij,jk)
+
+               ! update jl1
+               e_i  (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ij,jk) - eirft(ij,jk)
+
+            END DO
+         END DO
+
+         !-------------------------------------------------------------------------------
+         ! 4) Add area, volume, and energy of new ridge to each category jl2
+         !-------------------------------------------------------------------------------
+         DO jl2  = 1, jpl 
+            ! over categories to which ridged/rafted ice is transferred
+            DO ij = 1, icells
+               ji = indxi(ij) ; jj = indxj(ij)
+
+               ! Compute the fraction of ridged ice area and volume going to thickness category jl2.
+               IF( hrmin(ji,jj,jl1) <= hi_max(jl2) .AND. hrmax(ji,jj,jl1) > hi_max(jl2-1) ) THEN
+                  hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) )
+                  hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   )
+                  farea    = ( hR      - hL      ) * dhr(ij) 
+                  fvol(ij) = ( hR * hR - hL * hL ) * dhr2(ij)
+               ELSE
+                  farea    = 0._wp 
+                  fvol(ij) = 0._wp                  
+               ENDIF
+
+               ! Compute the fraction of rafted ice area and volume going to thickness category jl2
+               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN
+                  zswitch(ij) = 1._wp
+               ELSE
+                  zswitch(ij) = 0._wp                  
+               ENDIF
+
+               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ( ardg2 (ij) * farea    + arft2 (ij) * zswitch(ij) )
+               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + ( oirdg2(ij) * farea    + oirft2(ij) * zswitch(ij) )
+               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + ( vrdg2 (ij) * fvol(ij) + virft (ij) * zswitch(ij) )
+               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + ( srdg2 (ij) * fvol(ij) + smrft (ij) * zswitch(ij) )
+               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + ( vsrdg (ij) * rn_fsnowrdg * fvol(ij)  +  &
+                  &                                        vsrft (ij) * rn_fsnowrft * zswitch(ij) )
+               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnowrdg * fvol(ij)  +  &
+                  &                                        esrft (ij) * rn_fsnowrft * zswitch(ij) )
+
+            END DO
+
+            ! Transfer ice energy to category jl2 by ridging
+            DO jk = 1, nlay_i
+               DO ij = 1, icells
+                  ji = indxi(ij) ; jj = indxj(ij)
+                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + erdg2(ij,jk) * fvol(ij) + eirft(ij,jk) * zswitch(ij)                  
+               END DO
+            END DO
+            !
+         END DO ! jl2
+         
+      END DO ! jl1 (deforming categories)
+
+      !
+      CALL wrk_dealloc( jpij,        indxi, indxj )
+      CALL wrk_dealloc( jpij,        zswitch, fvol )
+      CALL wrk_dealloc( jpij,        afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+      CALL wrk_dealloc( jpij,        vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+      CALL wrk_dealloc( jpij,        afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw )
+      !
+   END SUBROUTINE lim_itd_me_ridgeshift
+
+   SUBROUTINE lim_itd_me_icestrength( kstrngth )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_me_icestrength ***
+      !!
+      !! ** Purpose :   computes ice strength used in dynamics routines of ice thickness
+      !!
+      !! ** Method  :   Compute the strength of the ice pack, defined as the energy (J m-2) 
+      !!              dissipated per unit area removed from the ice pack under compression,
+      !!              and assumed proportional to the change in potential energy caused
+      !!              by ridging. Note that only Hibler's formulation is stable and that
+      !!              ice strength has to be smoothed
+      !!
+      !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979)
+      INTEGER             ::   ji,jj, jl   ! dummy loop indices
+      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation
+      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing
+      REAL(wp)            ::   zp, z1_3    ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka           ! temporary array used here
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zstrp1, zstrp2   ! strength at previous time steps
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zworka, zstrp1, zstrp2 )
+
+      !------------------------------------------------------------------------------!
+      ! 1) Initialize
+      !------------------------------------------------------------------------------!
+      strength(:,:) = 0._wp
+
+      !------------------------------------------------------------------------------!
+      ! 2) Compute thickness distribution of ridging and ridged ice
+      !------------------------------------------------------------------------------!
+      CALL lim_itd_me_ridgeprep
+
+      !------------------------------------------------------------------------------!
+      ! 3) Rothrock(1975)'s method
+      !------------------------------------------------------------------------------!
+      IF( kstrngth == 1 ) THEN
+         z1_3 = 1._wp / 3._wp
+         DO jl = 1, jpl
+            DO jj= 1, jpj
+               DO ji = 1, jpi
+                  !
+                  IF( athorn(ji,jj,jl) > 0._wp ) THEN
+                     !----------------------------
+                     ! PE loss from deforming ice
+                     !----------------------------
+                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)
+
+                     !--------------------------
+                     ! PE gain from rafting ice
+                     !--------------------------
+                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)
+
+                     !----------------------------
+                     ! PE gain from ridging ice
+                     !----------------------------
+                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) * krdg(ji,jj,jl) * z1_3 *  &
+                        &                              ( hrmax(ji,jj,jl) * hrmax(ji,jj,jl) +         &
+                        &                                hrmin(ji,jj,jl) * hrmin(ji,jj,jl) +         &
+                        &                                hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )  
+                        !!(a**3-b**3)/(a-b) = a*a+ab+b*b                      
+                  ENDIF
+                  !
+               END DO
+            END DO
+         END DO
+   
+         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1)
+                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation
+         ksmooth = 1
+
+      !------------------------------------------------------------------------------!
+      ! 4) Hibler (1979)' method
+      !------------------------------------------------------------------------------!
+      ELSE                      ! kstrngth ne 1:  Hibler (1979) form
+         !
+         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) * tmask(:,:,1)
+         !
+         ksmooth = 1
+         !
+      ENDIF                     ! kstrngth
+      !
+      !------------------------------------------------------------------------------!
+      ! 5) Impact of brine volume
+      !------------------------------------------------------------------------------!
+      ! CAN BE REMOVED
+      IF( ln_icestr_bvf ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0)))
+            END DO
+         END DO
+      ENDIF
+      !
+      !------------------------------------------------------------------------------!
+      ! 6) Smoothing ice strength
+      !------------------------------------------------------------------------------!
+      !
+      !-------------------
+      ! Spatial smoothing
+      !-------------------
+      IF ( ksmooth == 1 ) THEN
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 
+                  zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
+                     &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                     &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+                     &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
+               ELSE
+                  zworka(ji,jj) = 0._wp
+               ENDIF
+            END DO
+         END DO
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               strength(ji,jj) = zworka(ji,jj)
+            END DO
+         END DO
+         CALL lbc_lnk( strength, 'T', 1. )
+
+      ENDIF
+
+      !--------------------
+      ! Temporal smoothing
+      !--------------------
+      IF ( ksmooth == 2 ) THEN
+
+         IF ( numit == nit000 + nn_fsbc - 1 ) THEN
+            zstrp1(:,:) = 0._wp
+            zstrp2(:,:) = 0._wp
+         ENDIF
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp ) THEN 
+                  numts_rm = 1 ! number of time steps for the running mean
+                  IF ( zstrp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1
+                  IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1
+                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm
+                  zstrp2(ji,jj) = zstrp1(ji,jj)
+                  zstrp1(ji,jj) = strength(ji,jj)
+                  strength(ji,jj) = zp
+               ENDIF
+            END DO
+         END DO
+
+         CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions
+
+      ENDIF ! ksmooth
+
+      CALL wrk_dealloc( jpi,jpj, zworka, zstrp1, zstrp2 )
+      !
+   END SUBROUTINE lim_itd_me_icestrength
+
+   SUBROUTINE lim_itd_me_init
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_itd_me_init ***
+      !!
+      !! ** Purpose :   Physical constants and parameters linked 
+      !!                to the mechanical ice redistribution
+      !!
+      !! ** Method  :   Read the namiceitdme namelist 
+      !!                and check the parameters values 
+      !!                called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namiceitdme
+      !!-------------------------------------------------------------------
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar,             & 
+        &                   ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, ln_rafting, rn_hraft, rn_craft, rn_fsnowrft
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution
+      READ  ( numnam_ice_ref, namiceitdme, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitdme in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceitdme in configuration namelist : Ice mechanical ice redistribution
+      READ  ( numnam_ice_cfg, namiceitdme, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitdme in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceitdme )
+      !
+      IF (lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'lim_itd_me_init : ice parameters for mechanical ice redistribution '
+         WRITE(numout,*)'~~~~~~~~~~~~~~~'
+         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        rn_cs       = ', rn_cs 
+         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    nn_partfun  = ', nn_partfun
+         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  rn_gstar    = ', rn_gstar
+         WRITE(numout,*)'   Equivalent to G* for an exponential part function       rn_astar    = ', rn_astar
+         WRITE(numout,*)'   Ridging of ice sheets or not                            ln_ridging  = ', ln_ridging
+         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     rn_hstar    = ', rn_hstar
+         WRITE(numout,*)'   Initial porosity of ridges                              rn_por_rdg  = ', rn_por_rdg
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrdg = ', rn_fsnowrdg 
+         WRITE(numout,*)'   Rafting of ice sheets or not                            ln_rafting  = ', ln_rafting
+         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       rn_hraft    = ', rn_hraft
+         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  rn_craft    = ', rn_craft  
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        rn_fsnowrft = ', rn_fsnowrft 
+      ENDIF
+      !
+   END SUBROUTINE lim_itd_me_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module          NO LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_itd_me           ! Empty routines
+   END SUBROUTINE lim_itd_me
+   SUBROUTINE lim_itd_me_icestrength
+   END SUBROUTINE lim_itd_me_icestrength
+   SUBROUTINE lim_itd_me_init
+   END SUBROUTINE lim_itd_me_init
+#endif
+   !!======================================================================
+END MODULE limitd_me
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 8732)
@@ -0,0 +1,795 @@
+MODULE limitd_th
+   !!======================================================================
+   !!                       ***  MODULE limitd_th ***
+   !!   LIM3 ice model : ice thickness distribution: Thermodynamics
+   !!======================================================================
+   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code
+   !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3
+   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age
+   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                   LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_itd_th_rem   :
+   !!   lim_itd_th_reb   :
+   !!   lim_itd_fitline  :
+   !!   lim_itd_shiftice :
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE dom_oce          ! ocean domain
+   USE phycst           ! physical constants (ocean directory) 
+   USE thd_ice          ! LIM-3 thermodynamic variables
+   USE ice              ! LIM-3 variables
+   USE limvar           ! LIM-3 variables
+   USE prtctl           ! Print control
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE lib_fortran      ! to use key_nosignedzero
+   USE limcons          ! conservation tests
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_itd_th_rem
+   PUBLIC   lim_itd_th_reb
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_th_rem ***
+      !!
+      !! ** Purpose :   computes the redistribution of ice thickness
+      !!              after thermodynamic growth of ice thickness
+      !!
+      !! ** Method  : Linear remapping 
+      !!
+      !! References : W.H. Lipscomb, JGR 2001
+      !!------------------------------------------------------------------
+      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
+      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
+      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
+      !
+      INTEGER  ::   ji, jj, jl     ! dummy loop index
+      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji
+      INTEGER  ::   nd             ! local integer
+      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
+      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
+      REAL(wp) ::   zx3        
+      CHARACTER (len = 15) :: fieldid
+
+      INTEGER , POINTER, DIMENSION(:,:,:) ::   zdonor   ! donor category index
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdhice      ! ice thickness increment
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   g0          ! coefficients for fitting the line of the ITD
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   g1          ! coefficients for fitting the line of the ITD
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume
+      REAL(wp), POINTER, DIMENSION(:)     ::   zvetamin, zvetamax      ! maximum values for etas
+      INTEGER , POINTER, DIMENSION(:)     ::   nind_i, nind_j          ! compressed indices for i/j directions
+      INTEGER                             ::   nbrem                   ! number of cells with ice to transfer
+      REAL(wp)                            ::   zslope                  ! used to compute local thermodynamic "speeds"
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zhb0, zhb1              ! category boundaries for thinnes categories
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_i_init, vt_i_final   !  ice volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   vt_s_init, vt_s_final   !  snow volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   et_i_init, et_i_final   !  ice energy summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   et_s_init, et_s_final   !  snow energy summed over categories
+      INTEGER , POINTER, DIMENSION(:,:)   ::   zremap_flag      ! compute remapping or not ????
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhbnew           ! new boundaries of ice categories
+      !!------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zremap_flag )
+      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )
+      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
+      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )   
+      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
+      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
+      CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
+
+      !!----------------------------------------------------------------------------------------------
+      !! 0) Conservation checkand changes in each ice category
+      !!----------------------------------------------------------------------------------------------
+      IF( con_i ) THEN
+         CALL lim_column_sum (jpl,   v_i, vt_i_init)
+         CALL lim_column_sum (jpl,   v_s, vt_s_init)
+         CALL lim_column_sum_energy (jpl, nlay_i,   e_i, et_i_init)
+         dummy_es(:,:,:) = e_s(:,:,1,:)
+         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init)
+      ENDIF
+
+      !!----------------------------------------------------------------------------------------------
+      !! 1) Compute thickness and changes in each ice category
+      !!----------------------------------------------------------------------------------------------
+      IF( kt == nit000 .AND. lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_itd_th_rem  : Remapping the ice thickness distribution'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) ' klbnd :       ', klbnd
+         WRITE(numout,*) ' kubnd :       ', kubnd
+      ENDIF
+
+      zdhice(:,:,:) = 0._wp
+      DO jl = klbnd, kubnd
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch
+               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )
+               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch
+               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement? 
+            END DO
+         END DO
+      END DO
+
+      !-----------------------------------------------------------------------------------------------
+      !  2) Compute fractional ice area in each grid cell
+      !-----------------------------------------------------------------------------------------------
+      at_i(:,:) = 0._wp
+      DO jl = klbnd, kubnd
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      !-----------------------------------------------------------------------------------------------
+      !  3) Identify grid cells with ice
+      !-----------------------------------------------------------------------------------------------
+      nbrem = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( at_i(ji,jj) > epsi10 ) THEN
+               nbrem         = nbrem + 1
+               nind_i(nbrem) = ji
+               nind_j(nbrem) = jj
+               zremap_flag(ji,jj) = 1
+            ELSE
+               zremap_flag(ji,jj) = 0
+            ENDIF
+         END DO
+      END DO
+
+      !-----------------------------------------------------------------------------------------------
+      !  4) Compute new category boundaries
+      !-----------------------------------------------------------------------------------------------
+      !- 4.1 Compute category boundaries
+      zhbnew(:,:,:) = 0._wp
+
+      DO jl = klbnd, kubnd - 1
+         DO ji = 1, nbrem
+            ii = nind_i(ji)
+            ij = nind_j(ji)
+            !
+            zhbnew(ii,ij,jl) = hi_max(jl)
+            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
+               !interpolate between adjacent category growth rates
+               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) )
+               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) )
+            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN
+               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl)
+            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN
+               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1)
+            ENDIF
+         END DO
+
+         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness
+         DO ji = 1, nbrem
+            ii = nind_i(ji)
+            ij = nind_j(ji)
+
+            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN
+               zremap_flag(ii,ij) = 0
+            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN
+               zremap_flag(ii,ij) = 0
+            ENDIF
+
+            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max  
+            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
+            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0
+            ! clem bug: why is not the following instead?
+            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
+            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0
+ 
+         END DO
+
+      END DO
+
+      !-----------------------------------------------------------------------------------------------
+      !  5) Identify cells where ITD is to be remapped
+      !-----------------------------------------------------------------------------------------------
+      nbrem = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( zremap_flag(ji,jj) == 1 ) THEN
+               nbrem         = nbrem + 1
+               nind_i(nbrem) = ji
+               nind_j(nbrem) = jj
+            ENDIF
+         END DO 
+      END DO 
+
+      !-----------------------------------------------------------------------------------------------
+      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories
+      !-----------------------------------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zhb0(ji,jj) = hi_max(0)
+            zhb1(ji,jj) = hi_max(1)
+
+            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN
+               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) )
+            ELSE
+!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)  
+               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway
+            ENDIF
+
+            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN
+               zremap_flag(ji,jj) = 0
+            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN
+               zremap_flag(ji,jj) = 0
+            ENDIF
+
+         END DO
+      END DO
+
+      !-----------------------------------------------------------------------------------------------
+      !  7) Compute g(h) 
+      !-----------------------------------------------------------------------------------------------
+      !- 7.1 g(h) for category 1 at start of time step
+      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
+         &                  hR(:,:,klbnd), zremap_flag )
+
+      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd)
+      DO ji = 1, nbrem
+         ii = nind_i(ji) 
+         ij = nind_j(ji) 
+
+         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN
+
+            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category
+
+            IF( zdh0 < 0.0 ) THEN      !remove area from category 1
+               zdh0 = MIN( -zdh0, hi_max(klbnd) )
+               !Integrate g(1) from 0 to dh0 to estimate area melted
+               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd)
+
+               IF( zetamax > 0.0 ) THEN
+                  zx1    = zetamax
+                  zx2    = 0.5 * zetamax * zetamax 
+                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed
+                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                
+                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting 
+                                                                                                !     of thin ice (zdamax > 0)
+                  ! Remove area, conserving volume
+                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
+                  a_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) - zda0
+                  v_i(ii,ij,klbnd)  = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ?
+               ENDIF
+
+            ELSE ! if ice accretion zdh0 > 0
+               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
+               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) ) 
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !- 7.3 g(h) for each thickness category  
+      DO jl = klbnd, kubnd
+         CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl),  &
+            &                  g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag )
+      END DO
+
+      !-----------------------------------------------------------------------------------------------
+      !  8) Compute area and volume to be shifted across each boundary
+      !-----------------------------------------------------------------------------------------------
+
+      DO jl = klbnd, kubnd - 1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdonor(ji,jj,jl) = 0
+               zdaice(ji,jj,jl) = 0.0
+               zdvice(ji,jj,jl) = 0.0
+            END DO
+         END DO
+
+         DO ji = 1, nbrem
+            ii = nind_i(ji)
+            ij = nind_j(ji)
+
+            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1
+               ! left and right integration limits in eta space
+               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl)
+               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl)
+               zdonor(ii,ij,jl) = jl
+
+            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
+               ! left and right integration limits in eta space
+               zvetamin(ji) = 0.0
+               zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1)
+               zdonor(ii,ij,jl) = jl + 1
+
+            ENDIF
+
+            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin
+            zetamin = zvetamin(ji)
+
+            zx1  = zetamax - zetamin
+            zwk1 = zetamin * zetamin
+            zwk2 = zetamax * zetamax
+            zx2  = 0.5 * ( zwk2 - zwk1 )
+            zwk1 = zwk1 * zetamin
+            zwk2 = zwk2 * zetamax
+            zx3  = 1.0 / 3.0 * ( zwk2 - zwk1 )
+            nd   = zdonor(ii,ij,jl)
+            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1
+            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd)
+
+         END DO
+      END DO
+
+      !!----------------------------------------------------------------------------------------------
+      !! 9) Shift ice between categories
+      !!----------------------------------------------------------------------------------------------
+      CALL lim_itd_shiftice ( klbnd, kubnd, zdonor, zdaice, zdvice )
+
+      !!----------------------------------------------------------------------------------------------
+      !! 10) Make sure ht_i >= minimum ice thickness hi_min
+      !!----------------------------------------------------------------------------------------------
+
+      DO ji = 1, nbrem
+         ii = nind_i(ji)
+         ij = nind_j(ji)
+         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN
+            a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin 
+            ht_i(ii,ij,1) = rn_himin
+         ENDIF
+      END DO
+
+      !!----------------------------------------------------------------------------------------------
+      !! 11) Conservation check
+      !!----------------------------------------------------------------------------------------------
+      IF ( con_i ) THEN
+         CALL lim_column_sum (jpl,   v_i, vt_i_final)
+         fieldid = ' v_i : limitd_th '
+         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 
+
+         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, et_i_final)
+         fieldid = ' e_i : limitd_th '
+         CALL lim_cons_check (et_i_init, et_i_final, 1.0e-3, fieldid) 
+
+         CALL lim_column_sum (jpl,   v_s, vt_s_final)
+         fieldid = ' v_s : limitd_th '
+         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 
+
+         dummy_es(:,:,:) = e_s(:,:,1,:)
+         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final)
+         fieldid = ' e_s : limitd_th '
+         CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid) 
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zremap_flag )
+      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )
+      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
+      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )   
+      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
+      CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
+
+   END SUBROUTINE lim_itd_th_rem
+
+
+   SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_fitline ***
+      !!
+      !! ** Purpose :   fit g(h) with a line using area, volume constraints
+      !!
+      !! ** Method  :   Fit g(h) with a line, satisfying area and volume constraints.
+      !!              To reduce roundoff errors caused by large values of g0 and g1,
+      !!              we actually compute g(eta), where eta = h - hL, and hL is the
+      !!              left boundary.
+      !!------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   num_cat      ! category index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   HbL, HbR     ! left and right category boundaries
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   hice         ! ice thickness
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   g0, g1       ! coefficients in linear equation for g(eta)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   hL           ! min value of range over which g(h) > 0
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   hR           ! max value of range over which g(h) > 0
+      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  !
+      !
+      INTEGER  ::   ji,jj        ! horizontal indices
+      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL)
+      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL)
+      REAL(wp) ::   zdhr         ! 1 / (hR - hL)
+      REAL(wp) ::   zwk1, zwk2   ! temporary variables
+      !!------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   &
+               &                        .AND. hice(ji,jj)        > 0._wp )  THEN
+
+               ! Initialize hL and hR
+               hL(ji,jj) = HbL(ji,jj)
+               hR(ji,jj) = HbR(ji,jj)
+
+               ! Change hL or hR if hice falls outside central third of range
+               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) )
+               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) )
+
+               IF    ( hice(ji,jj) < zh13 ) THEN   ;   hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj)
+               ELSEIF( hice(ji,jj) > zh23 ) THEN   ;   hL(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hR(ji,jj)
+               ENDIF
+
+               ! Compute coefficients of g(eta) = g0 + g1*eta
+               zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj))
+               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr
+               zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr
+               g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 )
+               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 )
+               !
+            ELSE  ! remap_flag = .false. or a_i < epsi10 
+               hL(ji,jj) = 0._wp
+               hR(ji,jj) = 0._wp
+               g0(ji,jj) = 0._wp
+               g1(ji,jj) = 0._wp
+            ENDIF
+            !
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_itd_fitline
+
+
+   SUBROUTINE lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_shiftice ***
+      !!
+      !! ** Purpose :   shift ice across category boundaries, conserving everything
+      !!              ( area, volume, energy, age*vol, and mass of salt )
+      !!
+      !! ** Method  :
+      !!------------------------------------------------------------------
+      INTEGER                           , INTENT(in   ) ::   klbnd    ! Start thickness category index point
+      INTEGER                           , INTENT(in   ) ::   kubnd    ! End point on which the  the computation is applied
+      INTEGER , DIMENSION(jpi,jpj,jpl-1), INTENT(in   ) ::   zdonor   ! donor category index
+      REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) ::   zdaice   ! ice area transferred across boundary
+      REAL(wp), DIMENSION(jpi,jpj,jpl-1), INTENT(inout) ::   zdvice   ! ice volume transferred across boundary
+
+      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices
+      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka            ! temporary array used here
+
+      REAL(wp) ::   zdvsnow, zdesnow   ! snow volume and energy transferred
+      REAL(wp) ::   zdeice             ! ice energy transferred
+      REAL(wp) ::   zdsm_vice          ! ice salinity times volume transferred
+      REAL(wp) ::   zdo_aice           ! ice age times volume transferred
+      REAL(wp) ::   zdaTsf             ! aicen*Tsfcn transferred
+
+      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions
+
+      INTEGER  ::   nbrem             ! number of cells with ice to transfer
+      !!------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )
+      CALL wrk_alloc( jpi,jpj, zworka )
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )
+
+      !----------------------------------------------------------------------------------------------
+      ! 1) Define a variable equal to a_i*T_su
+      !----------------------------------------------------------------------------------------------
+
+      DO jl = klbnd, kubnd
+         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl)
+      END DO
+
+      !-------------------------------------------------------------------------------
+      ! 2) Transfer volume and energy between categories
+      !-------------------------------------------------------------------------------
+
+      DO jl = klbnd, kubnd - 1
+         nbrem = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny
+                  nbrem = nbrem + 1
+                  nind_i(nbrem) = ji
+                  nind_j(nbrem) = jj
+               ENDIF
+            END DO
+         END DO
+
+         DO ji = 1, nbrem 
+            ii = nind_i(ji)
+            ij = nind_j(ji)
+
+            jl1 = zdonor(ii,ij,jl)
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) )
+            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch
+            IF( jl1 == jl) THEN   ;   jl2 = jl1+1
+            ELSE                  ;   jl2 = jl 
+            ENDIF
+
+            !--------------
+            ! Ice areas
+            !--------------
+            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl)
+            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl)
+
+            !--------------
+            ! Ice volumes
+            !--------------
+            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl) 
+            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl)
+
+            !--------------
+            ! Snow volumes
+            !--------------
+            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij)
+            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow
+            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow 
+
+            !--------------------
+            ! Snow heat content  
+            !--------------------
+            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij)
+            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow
+            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow
+
+            !--------------
+            ! Ice age 
+            !--------------
+            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl)
+            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice
+            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice
+
+            !--------------
+            ! Ice salinity
+            !--------------
+            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij)
+            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice
+            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice
+
+            !---------------------
+            ! Surface temperature
+            !---------------------
+            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl)
+            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf
+            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf 
+
+         END DO
+
+         !------------------
+         ! Ice heat content
+         !------------------
+
+         DO jk = 1, nlay_i
+            DO ji = 1, nbrem
+               ii = nind_i(ji)
+               ij = nind_j(ji)
+
+               jl1 = zdonor(ii,ij,jl)
+               IF (jl1 == jl) THEN
+                  jl2 = jl+1
+               ELSE             ! n1 = n+1
+                  jl2 = jl 
+               ENDIF
+
+               zdeice = e_i(ii,ij,jk,jl1) * zworka(ii,ij)
+               e_i(ii,ij,jk,jl1) =  e_i(ii,ij,jk,jl1) - zdeice
+               e_i(ii,ij,jk,jl2) =  e_i(ii,ij,jk,jl2) + zdeice 
+            END DO
+         END DO
+
+      END DO                   ! boundaries, 1 to ncat-1
+
+      !-----------------------------------------------------------------
+      ! Update ice thickness and temperature
+      !-----------------------------------------------------------------
+
+      DO jl = klbnd, kubnd
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
+                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl) 
+                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 
+               ELSE
+                  ht_i(ji,jj,jl)  = 0._wp
+                  t_su(ji,jj,jl)  = rt0
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )
+      CALL wrk_dealloc( jpi,jpj, zworka )
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )
+      !
+   END SUBROUTINE lim_itd_shiftice
+   
+
+   SUBROUTINE lim_itd_th_reb( klbnd, kubnd )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_th_reb ***
+      !!
+      !! ** Purpose : rebin - rebins thicknesses into defined categories
+      !!
+      !! ** Method  :
+      !!------------------------------------------------------------------
+      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
+      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
+      !
+      INTEGER ::   ji,jj, jl   ! dummy loop indices
+      INTEGER ::   zshiftflag          ! = .true. if ice must be shifted
+      CHARACTER (len = 15) :: fieldid
+
+      INTEGER , POINTER, DIMENSION(:,:,:) ::   zdonor           ! donor category index
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice   ! ice area and volume transferred
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories
+      !!------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger
+      CALL wrk_alloc( jpi,jpj,jpl, zdaice, zdvice )
+      CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
+      !     
+      IF( con_i ) THEN                 ! conservation check
+         CALL lim_column_sum (jpl,   v_i, vt_i_init)
+         CALL lim_column_sum (jpl,   v_s, vt_s_init)
+      ENDIF
+
+      !
+      !------------------------------------------------------------------------------
+      ! 1) Compute ice thickness.
+      !------------------------------------------------------------------------------
+      DO jl = klbnd, kubnd
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
+            END DO
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------
+      ! 2) If a category thickness is not in bounds, shift the
+      ! entire area, volume, and energy to the neighboring category
+      !------------------------------------------------------------------------------
+      !-------------------------
+      ! Initialize shift arrays
+      !-------------------------
+      DO jl = klbnd, kubnd
+         zdonor(:,:,jl) = 0
+         zdaice(:,:,jl) = 0._wp
+         zdvice(:,:,jl) = 0._wp
+      END DO
+
+      !-------------------------
+      ! Move thin categories up
+      !-------------------------
+
+      DO jl = klbnd, kubnd - 1  ! loop over category boundaries
+
+         !---------------------------------------
+         ! identify thicknesses that are too big
+         !---------------------------------------
+         zshiftflag = 0
+
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               IF( a_i(ji,jj,jl) > epsi10 .AND. ht_i(ji,jj,jl) > hi_max(jl) ) THEN 
+                  zshiftflag        = 1
+                  zdonor(ji,jj,jl)  = jl 
+                  ! begin TECLIM change
+                  !zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * 0.5_wp
+                  !zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp
+                  ! end TECLIM change 
+                  ! clem: how much of a_i you send in cat sup is somewhat arbitrary
+                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi20 ) / ht_i(ji,jj,jl)  
+                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi20 )
+               ENDIF
+            END DO
+         END DO
+         IF(lk_mpp)   CALL mpp_max( zshiftflag )
+
+         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories
+            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )
+            ! Reset shift parameters
+            zdonor(:,:,jl) = 0
+            zdaice(:,:,jl) = 0._wp
+            zdvice(:,:,jl) = 0._wp
+         ENDIF
+         !
+      END DO
+
+      !----------------------------
+      ! Move thick categories down
+      !----------------------------
+
+      DO jl = kubnd - 1, 1, -1       ! loop over category boundaries
+
+         !-----------------------------------------
+         ! Identify thicknesses that are too small
+         !-----------------------------------------
+         zshiftflag = 0
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN
+                  !
+                  zshiftflag = 1
+                  zdonor(ji,jj,jl) = jl + 1
+                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 
+                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1)
+               ENDIF
+            END DO
+         END DO
+
+         IF(lk_mpp)   CALL mpp_max( zshiftflag )
+         
+         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories
+            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )
+            ! Reset shift parameters
+            zdonor(:,:,jl) = 0
+            zdaice(:,:,jl) = 0._wp
+            zdvice(:,:,jl) = 0._wp
+         ENDIF
+
+      END DO
+
+      !------------------------------------------------------------------------------
+      ! 3) Conservation check
+      !------------------------------------------------------------------------------
+
+      IF( con_i ) THEN
+         CALL lim_column_sum (jpl,   v_i, vt_i_final)
+         fieldid = ' v_i : limitd_reb '
+         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 
+
+         CALL lim_column_sum (jpl,   v_s, vt_s_final)
+         fieldid = ' v_s : limitd_reb '
+         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpl, zdonor )
+      CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )
+      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
+
+   END SUBROUTINE lim_itd_th_reb
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy module         NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_itd_th_rem
+   END SUBROUTINE lim_itd_th_rem
+   SUBROUTINE lim_itd_fitline
+   END SUBROUTINE lim_itd_fitline
+   SUBROUTINE lim_itd_shiftice
+   END SUBROUTINE lim_itd_shiftice
+   SUBROUTINE lim_itd_th_reb
+   END SUBROUTINE lim_itd_th_reb
+#endif
+   !!======================================================================
+END MODULE limitd_th
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 8732)
@@ -0,0 +1,719 @@
+MODULE limrhg
+   !!======================================================================
+   !!                     ***  MODULE  limrhg  ***
+   !!   Ice rheology : sea ice rheology
+   !!======================================================================
+   !! History :   -   !  2007-03  (M.A. Morales Maqueda, S. Bouillon) Original code
+   !!            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
+   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation 
+   !!            3.5  !  2012-08  (R. Benshila)  AGRIF
+   !!            3.6  !  2016-06  (C. Rousset) Rewriting + landfast ice + possibility to use mEVP (Bouillon 2013)
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_rhg       : computes ice velocities
+   !!----------------------------------------------------------------------
+   USE phycst         ! Physical constant
+   USE oce     , ONLY :  snwice_mass, snwice_mass_b
+   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 ice            ! ice variables
+   USE limitd_me      ! ice strength
+   USE lbclnk         ! Lateral Boundary Condition / MPP link
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+#if defined key_agrif
+   USE agrif_lim3_interp
+#endif
+   USE bdy_oce   , ONLY: ln_bdy 
+   USE bdyice_lim 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_rhg        ! routine called by lim_dyn
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_rhg
+      !!-------------------------------------------------------------------
+      !!                 ***  SUBROUTINE lim_rhg  ***
+      !!                          EVP-C-grid
+      !!
+      !! ** purpose : determines sea ice drift from wind stress, ice-ocean
+      !!  stress and sea-surface slope. Ice-ice interaction is described by 
+      !!  a non-linear elasto-viscous-plastic (EVP) law including shear 
+      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).	
+      !!
+      !!  The points in the C-grid look like this, dear reader
+      !!
+      !!                              (ji,jj)
+      !!                                 |
+      !!                                 |
+      !!                      (ji-1,jj)  |  (ji,jj)
+      !!                             ---------   
+      !!                            |         |
+      !!                            | (ji,jj) |------(ji,jj)
+      !!                            |         |
+      !!                             ---------   
+      !!                     (ji-1,jj-1)     (ji,jj-1)
+      !!
+      !! ** Inputs  : - wind forcing (stress), oceanic currents
+      !!                ice total volume (vt_i) per unit area
+      !!                snow total volume (vt_s) per unit area
+      !!
+      !! ** Action  : - compute u_ice, v_ice : the components of the 
+      !!                sea-ice velocity vector
+      !!              - compute delta_i, shear_i, divu_i, which are inputs
+      !!                of the ice thickness distribution
+      !!
+      !! ** Steps   : 1) Compute ice snow mass, ice strength 
+      !!              2) Compute wind, oceanic stresses, mass terms and
+      !!                 coriolis terms of the momentum equation
+      !!              3) Solve the momentum equation (iterative procedure)
+      !!              4) Prevent high velocities if the ice is thin
+      !!              5) Recompute invariants of the strain rate tensor
+      !!                 which are inputs of the ITD, store stress
+      !!                 for the next time step
+      !!              6) Control prints of residual (convergence)
+      !!                 and charge ellipse.
+      !!                 The user should make sure that the parameters
+      !!                 nn_nevp, elastic time scale and rn_creepl maintain stress state
+      !!                 on the charge ellipse for plastic flow
+      !!                 e.g. in the Canadian Archipelago
+      !!
+      !! ** Notes   : There is the possibility to use mEVP from Bouillon 2013
+      !!              (by uncommenting some lines in part 3 and changing alpha and beta parameters)
+      !!              but this solution appears very unstable (see Kimmritz et al 2016)
+      !!
+      !! References : Hunke and Dukowicz, JPO97
+      !!              Bouillon et al., Ocean Modelling 2009
+      !!              Bouillon et al., Ocean Modelling 2013
+      !!-------------------------------------------------------------------
+      INTEGER ::   ji, jj       ! dummy loop indices
+      INTEGER ::   jter         ! local integers
+      CHARACTER (len=50) ::   charout
+
+      REAL(wp) ::   zrhoco                                                   ! rau0 * rn_cio
+      REAL(wp) ::   zdtevp, z1_dtevp                                         ! time step for subcycling
+      REAL(wp) ::   ecc2, z1_ecc2                                            ! square of yield ellipse eccenticity
+      REAL(wp) ::   zbeta, zalph1, z1_alph1, zalph2, z1_alph2                ! alpha and beta from Bouillon 2009 and 2013
+      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV                            ! ice/snow mass
+      REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2            ! temporary scalars
+      REAL(wp) ::   zTauO, zTauB, zTauE, zCor, zvel                          ! temporary scalars
+
+      REAL(wp) ::   zsig1, zsig2                                             ! internal ice stress
+      REAL(wp) ::   zresm                                                    ! Maximal error on ice velocity
+      REAL(wp) ::   zintb, zintn                                             ! dummy argument
+      
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_e1t0, z1_e2t0                ! scale factors
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zp_delt                         ! P/delta at T points
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zaU   , zaV                     ! ice fraction on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmU_t, zmV_t                    ! ice/snow mass/dt on U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmf                             ! coriolis parameter at T points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                           
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfU   , zfV                     ! internal stresses
+      
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zds                             ! shear
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zs1, zs2, zs12                  ! stress tensor components
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr           ! check convergence
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice                           ! array used for the calculation of ice surface slope:
+                                                                             !   ocean surface (ssh_m) if ice is not embedded
+                                                                             !   ice top surface if ice is embedded   
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitchU, zswitchV              ! dummy arrays
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmaskU, zmaskV                  ! mask for ice presence
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfmask, zwf                     ! mask at F points for the ice
+
+      REAL(wp), PARAMETER               ::   zepsi  = 1.0e-20_wp             ! tolerance parameter
+      REAL(wp), PARAMETER               ::   zmmin  = 1._wp                  ! ice mass (kg/m2) below which ice velocity equals ocean velocity
+      REAL(wp), PARAMETER               ::   zshlat = 2._wp                  ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip)
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )
+      CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )
+      CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )
+      CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )
+      CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )
+
+#if defined key_agrif 
+      CALL agrif_interp_lim3( 'U', 0, nn_nevp )   ! First interpolation of coarse values
+      CALL agrif_interp_lim3( 'V', 0, nn_nevp )
+#endif
+      !
+      !------------------------------------------------------------------------------!
+      ! 0) mask at F points for the ice
+      !------------------------------------------------------------------------------!
+      ! ocean/land mask
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1      ! NO vector opt.
+            zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
+         END DO
+      END DO
+      CALL lbc_lnk( zfmask, 'F', 1._wp )
+
+      ! Lateral boundary conditions on velocity (modify zfmask)
+      zwf(:,:) = zfmask(:,:)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( zfmask(ji,jj) == 0._wp ) THEN
+               zfmask(ji,jj) = zshlat * 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( zfmask(1,jj) == 0._wp ) THEN
+            zfmask(1  ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+         ENDIF
+         IF( zfmask(jpi,jj) == 0._wp ) THEN
+            zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+         ENDIF
+      END DO
+      DO ji = 2, jpim1
+         IF( zfmask(ji,1) == 0._wp ) THEN
+            zfmask(ji,1  ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+         ENDIF
+         IF( zfmask(ji,jpj) == 0._wp ) THEN
+            zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+         ENDIF
+      END DO
+      CALL lbc_lnk( zfmask, 'F', 1._wp )
+
+      !------------------------------------------------------------------------------!
+      ! 1) define some variables and initialize arrays
+      !------------------------------------------------------------------------------!
+      zrhoco = rau0 * rn_cio 
+
+      ! ecc2: square of yield ellipse eccenticrity
+      ecc2    = rn_ecc * rn_ecc
+      z1_ecc2 = 1._wp / ecc2
+
+      ! Time step for subcycling
+      zdtevp   = rdt_ice / REAL( nn_nevp )
+      z1_dtevp = 1._wp / zdtevp
+
+      ! alpha parameters (Bouillon 2009)
+      zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp
+      zalph2 = zalph1 * z1_ecc2
+
+      ! alpha and beta parameters (Bouillon 2013)
+      !!zalph1 = 40.
+      !!zalph2 = 40.
+      !!zbeta  = 3000.
+      !!zbeta = REAL( nn_nevp )   ! close to classical EVP of Hunke (2001)
+
+      z1_alph1 = 1._wp / ( zalph1 + 1._wp )
+      z1_alph2 = 1._wp / ( zalph2 + 1._wp )
+
+      ! Initialise stress tensor 
+      zs1 (:,:) = stress1_i (:,:) 
+      zs2 (:,:) = stress2_i (:,:)
+      zs12(:,:) = stress12_i(:,:)
+
+      ! Ice strength
+      CALL lim_itd_me_icestrength( nn_icestr )
+
+      ! scale factors
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj  ) + e1t(ji,jj  ) )
+            z1_e2t0(ji,jj) = 1._wp / ( e2t(ji  ,jj+1) + e2t(ji,jj  ) )
+         END DO
+      END DO
+            
+      !
+      !------------------------------------------------------------------------------!
+      ! 2) Wind / ocean stress, mass terms, coriolis terms
+      !------------------------------------------------------------------------------!
+
+      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+         !                                            
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
+         !
+         ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+         !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+         !
+         zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0
+         !
+      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
+         zpice(:,:) = ssh_m(:,:)
+      ENDIF
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+
+            ! ice fraction at U-V points
+            zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+            zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+            ! Ice/snow mass at U-V points
+            zm1 = ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
+            zm2 = ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
+            zm3 = ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
+            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
+            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
+
+            ! Ocean currents at U-V points
+            v_oceU(ji,jj)   = 0.5_wp * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji+1,jj)    &
+               &                       + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)
+            
+            u_oceV(ji,jj)   = 0.5_wp * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj+1)    &
+               &                       + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)
+
+            ! Coriolis at T points (m*f)
+            zmf(ji,jj)      = zm1 * ff_t(ji,jj)
+
+            ! m/dt
+            zmU_t(ji,jj)    = zmassU * z1_dtevp
+            zmV_t(ji,jj)    = zmassV * z1_dtevp
+
+            ! Drag ice-atm.
+            zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
+            zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
+
+            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
+            zspgU(ji,jj)    = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+            zspgV(ji,jj)    = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+
+            ! masks
+            zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
+            zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
+
+            ! switches
+            zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin
+            zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin
+
+         END DO
+      END DO
+      CALL lbc_lnk( zmf, 'T', 1. )
+      !
+      !------------------------------------------------------------------------------!
+      ! 3) Solution of the momentum equation, iterative procedure
+      !------------------------------------------------------------------------------!
+      !
+      !                                               !----------------------!
+      DO jter = 1 , nn_nevp                           !    loop over jter    !
+         !                                            !----------------------!        
+         IF(ln_ctl) THEN   ! Convergence test
+            DO jj = 1, jpjm1
+               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step
+               zv_ice(:,jj) = v_ice(:,jj)
+            END DO
+         ENDIF
+
+         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
+         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points
+            DO ji = 1, jpim1
+
+               ! shear at F points
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+                  &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+                  &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+            END DO
+         END DO
+         CALL lbc_lnk( zds, 'F', 1. )
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1 ! no vector loop
+
+               ! shear**2 at T points (doc eq. A16)
+               zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+                  &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+                  &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+              
+               ! divergence at T points
+               zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+                  &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+                  &    ) * r1_e1e2t(ji,jj)
+               zdiv2 = zdiv * zdiv
+               
+               ! tension at T points
+               zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+                  &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+                  &   ) * r1_e1e2t(ji,jj)
+               zdt2 = zdt * zdt
+               
+               ! delta at T points
+               zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
+
+               ! P/delta at T points
+               zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl )
+               
+               ! stress at T points
+               zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1
+               zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2
+             
+            END DO
+         END DO
+         CALL lbc_lnk( zp_delt, 'T', 1. )
+
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               ! P/delta at F points
+               zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
+               
+               ! stress at F points
+               zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2
+
+            END DO
+         END DO
+         CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+ 
+
+         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1               
+
+               ! U points
+               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
+                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    &
+                  &                    ) * r1_e2u(ji,jj)                                                                      &
+                  &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  &
+                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              &
+                  &                  ) * r1_e1e2u(ji,jj)
+
+               ! V points
+               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             &
+                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    &
+                  &                    ) * r1_e1v(ji,jj)                                                                      &
+                  &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  &
+                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              &
+                  &                  ) * r1_e1e2v(ji,jj)
+
+               ! u_ice at V point
+               u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     &
+                  &                     + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1)
+               
+               ! v_ice at U point
+               v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     &
+                  &                     + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1)
+
+            END DO
+         END DO
+         !
+         ! --- Computation of ice velocity --- !
+         !  Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp
+         !  Bouillon et al. 2009 (eq 34-35) => stable
+         IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations
+            
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+
+                  ! tau_io/(v_oce - v_ice)
+                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+
+                  ! tau_bottom/v_ice
+                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) )
+                  zTauB = - tau_icebfr(ji,jj) / zvel
+
+                  ! Coriolis at V-points (energy conserving formulation)
+                  zCor  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+
+                  ! landfast switch => 0 = static friction ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                   &  ! previous velocity
+                     &                                     + zTauE + zTauO * v_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
+                     &             + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin
+                     &           ) * zmaskV(ji,jj)
+                  ! Bouillon 2013
+                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  &
+                  !!   &           + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  &
+                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj)
+
+               END DO
+            END DO
+            CALL lbc_lnk( v_ice, 'V', -1. )
+            
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'V' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' )
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                               
+                  ! tau_io/(u_oce - u_ice)
+                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+
+                  ! tau_bottom/u_ice
+                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) )
+                  zTauB = - tau_icebfr(ji,jj) / zvel
+
+                  ! Coriolis at U-points (energy conserving formulation)
+                  zCor  =   0.25_wp * r1_e1u(ji,jj) *  &
+                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+                  
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+
+                  ! landfast switch => 0 = static friction ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                   &  ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
+                     &             + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &             ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin 
+                     &           ) * zmaskU(ji,jj)
+                  ! Bouillon 2013
+                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  &
+                  !!   &           + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  &
+                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( u_ice, 'U', -1. )
+            
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'U' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' )
+
+         ELSE ! odd iterations
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+
+                  ! tau_io/(u_oce - u_ice)
+                  zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                     &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+
+                  ! tau_bottom/u_ice
+                  zvel  = MAX( zepsi, SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) )
+                  zTauB = - tau_icebfr(ji,jj) / zvel
+
+                  ! Coriolis at U-points (energy conserving formulation)
+                  zCor  =   0.25_wp * r1_e1u(ji,jj) *  &
+                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+
+                  ! landfast switch => 0 = static friction ; 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                   &  ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
+                     &             + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &             ) * zswitchU(ji,jj) + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin
+                     &           ) * zmaskU(ji,jj)
+                  ! Bouillon 2013
+                  !!u_ice(ji,jj) = ( zmU_t(ji,jj) * ( zbeta * u_ice(ji,jj) + u_ice_b(ji,jj) )                  &
+                  !!   &           + zfU(ji,jj) + zCor + zTauU_ia(ji,jj) + zTauO * u_oce(ji,jj) + zspgU(ji,jj)  &
+                  !!   &           ) / MAX( zmU_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchU(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( u_ice, 'U', -1. )
+            
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'U', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'U' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' )
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+         
+                  ! tau_io/(v_oce - v_ice)
+                  zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
+                     &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
+
+                  ! tau_bottom/v_ice
+                  zvel  = MAX( zepsi, SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) )
+                  ztauB = - tau_icebfr(ji,jj) / zvel
+                  
+                  ! Coriolis at V-points (energy conserving formulation)
+                  zCor  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
+                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
+
+                  ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )
+
+                  ! landfast switch => 0 = static friction (tau_icebfr > zTauE); 1 = sliding friction
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - tau_icebfr(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  
+                  ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                   &  ! previous velocity
+                     &                                     + zTauE + zTauO * v_ice(ji,jj)                  &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )  &  ! m/dt + tau_io(only ice part) + landfast
+                     &             + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce if mass < zmmin
+                     &           ) * zmaskV(ji,jj)
+                  ! Bouillon 2013
+                  !!v_ice(ji,jj) = ( zmV_t(ji,jj) * ( zbeta * v_ice(ji,jj) + v_ice_b(ji,jj) )                  &
+                  !!   &           + zfV(ji,jj) + zCor + zTauV_ia(ji,jj) + zTauO * v_oce(ji,jj) + zspgV(ji,jj)  &
+                  !!   &           ) / MAX( zmV_t(ji,jj) * ( zbeta + 1._wp ) + zTauO - zTauB, zepsi ) * zswitchV(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( v_ice, 'V', -1. )
+            
+#if defined key_agrif
+!!            CALL agrif_interp_lim3( 'V', jter, nn_nevp )
+            CALL agrif_interp_lim3( 'V' )
+#endif
+            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' )
+
+         ENDIF
+         
+         IF(ln_ctl) THEN   ! Convergence test
+            DO jj = 2 , jpjm1
+               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) )
+            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain
+         ENDIF
+         !
+         !                                                ! ==================== !
+      END DO                                              !  end loop over jter  !
+      !                                                   ! ==================== !
+      !
+      !------------------------------------------------------------------------------!
+      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
+      !------------------------------------------------------------------------------!
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+
+            ! shear at F points
+            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   &
+               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   &
+               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj)
+
+         END DO
+      END DO           
+      CALL lbc_lnk( zds, 'F', 1. )
+      
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1 ! no vector loop
+            
+            ! tension**2 at T points
+            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
+               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
+               &   ) * r1_e1e2t(ji,jj)
+            zdt2 = zdt * zdt
+            
+            ! shear**2 at T points (doc eq. A16)
+            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
+               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
+               &   ) * 0.25_wp * r1_e1e2t(ji,jj)
+            
+            ! shear at T points
+            shear_i(ji,jj) = SQRT( zdt2 + zds2 )
+
+            ! divergence at T points
+            divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
+               &            + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
+               &            ) * r1_e1e2t(ji,jj)
+            
+            ! delta at T points
+            zdelta         = SQRT( divu_i(ji,jj) * divu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )  
+            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0
+            delta_i(ji,jj) = zdelta + rn_creepl * rswitch
+
+         END DO
+      END DO
+      CALL lbc_lnk_multi( shear_i, 'T', 1., divu_i, 'T', 1., delta_i, 'T', 1. )
+      
+      ! --- Store the stress tensor for the next time step --- !
+      stress1_i (:,:) = zs1 (:,:)
+      stress2_i (:,:) = zs2 (:,:)
+      stress12_i(:,:) = zs12(:,:)
+      !
+
+      !------------------------------------------------------------------------------!
+      ! 5) Control prints of residual and charge ellipse
+      !------------------------------------------------------------------------------!
+      !
+      ! print the residual for convergence
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('lim_rhg  : res =',D23.16, ' iter =',I4)") zresm, jter
+         CALL prt_ctl_info(charout)
+         CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_rhg  : u_ice :', tab2d_2=v_ice, clinfo2=' v_ice :')
+      ENDIF
+
+      ! print charge ellipse
+      ! This can be desactivated once the user is sure that the stress state
+      ! lie on the charge ellipse. See Bouillon et al. 08 for more details
+      IF(ln_ctl) THEN
+         CALL prt_ctl_info('lim_rhg  : numit  :',ivar1=numit)
+         CALL prt_ctl_info('lim_rhg  : nwrite :',ivar1=nwrite)
+         CALL prt_ctl_info('lim_rhg  : MOD    :',ivar1=MOD(numit,nwrite))
+         IF( MOD(numit,nwrite) .EQ. 0 ) THEN
+            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 1000, numit, 0, 0, ' ch. ell. '
+            CALL prt_ctl_info(charout)
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF (strength(ji,jj) > 1.0) THEN
+                     zsig1 = ( zs1(ji,jj) + SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) ) 
+                     zsig2 = ( zs1(ji,jj) - SQRT(zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 ) ) / ( 2*strength(ji,jj) )
+                     WRITE(charout,FMT="('lim_rhg  :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)")
+                     CALL prt_ctl_info(charout)
+                  ENDIF
+               END DO
+            END DO
+            WRITE(charout,FMT="('lim_rhg  :', I4, I6, I1, I1, A10)") 2000, numit, 0, 0, ' ch. ell. '
+            CALL prt_ctl_info(charout)
+         ENDIF
+      ENDIF
+      !     
+      
+      CALL wrk_dealloc( jpi,jpj, z1_e1t0, z1_e2t0, zp_delt )
+      CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia )
+      CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV )
+      CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice )
+      CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf )
+
+   END SUBROUTINE lim_rhg
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_rhg         ! Dummy routine
+      WRITE(*,*) 'lim_rhg: You should not have seen this print! error?'
+   END SUBROUTINE lim_rhg
+#endif
+
+   !!==============================================================================
+END MODULE limrhg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 8732)
@@ -0,0 +1,546 @@
+MODULE limrst
+   !!======================================================================
+   !!                     ***  MODULE  limrst  ***
+   !! 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
+   !!           4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_rst_opn   : open ice restart file
+   !!   lim_rst_write : write of the restart file 
+   !!   lim_rst_read  : read  the restart file 
+   !!----------------------------------------------------------------------
+   USE ice            ! sea-ice variables
+   USE oce     , ONLY :  snwice_mass, snwice_mass_b
+   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
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE limctl
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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 sbc_lim_init
+
+   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write 
+   INTEGER, PUBLIC ::   numrir, numriw   !: logical unit for ice restart (read and write)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_rst_opn( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_opn  ***
+      !!
+      !! ** purpose  :   output of sea-ice variable in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      !
+      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
+      CHARACTER(len=50)   ::   clname   ! ice output restart file name
+      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file 
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
+
+      ! 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
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+            clpath = TRIM(cn_icerst_outdir) 
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE DEFAULT
+                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_ice = .TRUE.
+         ENDIF
+      ENDIF
+      !
+      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
+   END SUBROUTINE lim_rst_opn
+
+
+   SUBROUTINE lim_rst_write( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_write  ***
+      !!
+      !! ** purpose  :   output of sea-ice variable in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER ::   ji, jj, jk ,jl   ! dummy loop indices
+      INTEGER ::   iter
+      CHARACTER(len=25) ::   znam
+      CHARACTER(len=2)  ::   zchar, zchar1
+      REAL(wp), POINTER, DIMENSION(:,:) :: z2d
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, z2d )
+
+      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
+
+      IF( iter == nitrst ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'lim_rst_write : write ice restart file  kt =', kt
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
+      ENDIF
+
+      ! Write in numriw (if iter == nitrst)
+      ! ------------------ 
+      !                                                                        ! 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
+
+      ! Prognostic variables 
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I2.2)') jl
+         znam = 'v_i'//'_htc'//zchar
+         z2d(:,:) = v_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         znam = 'v_s'//'_htc'//zchar
+         z2d(:,:) = v_s(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         znam = 'smv_i'//'_htc'//zchar
+         z2d(:,:) = smv_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         znam = 'oa_i'//'_htc'//zchar
+         z2d(:,:) = oa_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         znam = 'a_i'//'_htc'//zchar
+         z2d(:,:) = a_i(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         znam = 't_su'//'_htc'//zchar
+         z2d(:,:) = t_su(:,:,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         znam = 'tempt_sl1'//'_htc'//zchar
+         z2d(:,:) = e_s(:,:,1,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I2.2)') jk
+            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
+            z2d(:,:) = e_i(:,:,jk,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         END DO
+      END DO
+
+      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, 'stress1_i'    , stress1_i  )
+      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  )
+      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i )
+      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )
+      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
+
+      ! In case Prather scheme is used for advection, write second order moments
+      ! ------------------------------------------------------------------------
+      IF( nn_limadv == -1 ) THEN
+         
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            znam = 'sxice'//'_htc'//zchar
+            z2d(:,:) = sxice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syice'//'_htc'//zchar
+            z2d(:,:) = syice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxice'//'_htc'//zchar
+            z2d(:,:) = sxxice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syyice'//'_htc'//zchar
+            z2d(:,:) = syyice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxyice'//'_htc'//zchar
+            z2d(:,:) = sxyice(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxsn'//'_htc'//zchar
+            z2d(:,:) = sxsn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sysn'//'_htc'//zchar
+            z2d(:,:) = sysn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxsn'//'_htc'//zchar
+            z2d(:,:) = sxxsn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syysn'//'_htc'//zchar
+            z2d(:,:) = syysn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxysn'//'_htc'//zchar
+            z2d(:,:) = sxysn(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxa'//'_htc'//zchar
+            z2d(:,:) = sxa(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sya'//'_htc'//zchar
+            z2d(:,:) = sya(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxa'//'_htc'//zchar
+            z2d(:,:) = sxxa(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syya'//'_htc'//zchar
+            z2d(:,:) = syya(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxya'//'_htc'//zchar
+            z2d(:,:) = sxya(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxc0'//'_htc'//zchar
+            z2d(:,:) = sxc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syc0'//'_htc'//zchar
+            z2d(:,:) = syc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxc0'//'_htc'//zchar
+            z2d(:,:) = sxxc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syyc0'//'_htc'//zchar
+            z2d(:,:) = syyc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxyc0'//'_htc'//zchar
+            z2d(:,:) = sxyc0(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxsal'//'_htc'//zchar
+            z2d(:,:) = sxsal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sysal'//'_htc'//zchar
+            z2d(:,:) = sysal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxsal'//'_htc'//zchar
+            z2d(:,:) = sxxsal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syysal'//'_htc'//zchar
+            z2d(:,:) = syysal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxysal'//'_htc'//zchar
+            z2d(:,:) = sxysal(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxage'//'_htc'//zchar
+            z2d(:,:) = sxage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syage'//'_htc'//zchar
+            z2d(:,:) = syage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxxage'//'_htc'//zchar
+            z2d(:,:) = sxxage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'syyage'//'_htc'//zchar
+            z2d(:,:) = syyage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            znam = 'sxyage'//'_htc'//zchar
+            z2d(:,:) = sxyage(:,:,jl)
+            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+         END DO
+
+         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  )
+         CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  )
+         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw )
+         CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw )
+         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw )
+         
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            DO jk = 1, nlay_i 
+               WRITE(zchar1,'(I2.2)') jk
+               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sxe(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sye(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sxxe(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = syye(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
+               z2d(:,:) = sxye(:,:,jk,jl)
+               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+            END DO
+         END DO
+
+      ENDIF
+      
+      ! close restart file
+      ! ------------------
+      IF( iter == nitrst ) THEN
+         CALL iom_close( numriw )
+         lrst_ice = .FALSE.
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, z2d )
+      !
+   END SUBROUTINE lim_rst_write
+
+
+   SUBROUTINE lim_rst_read
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_read  ***
+      !!
+      !! ** purpose  :   read of sea-ice variable restart in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk, jl
+      REAL(wp) ::   zfice, ziter
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d
+      CHARACTER(len=25) ::   znam
+      CHARACTER(len=2)  ::   zchar, zchar1
+      INTEGER           ::   jlibalt = jprstlib
+      LOGICAL           ::   llok
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, z2d )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
+
+      CALL iom_get( numrir, 'nn_fsbc', zfice )
+      CALL iom_get( numrir, 'kt_ice' , ziter )    
+      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
+      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
+
+      !Control of date
+
+      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',        &
+         &                   '   control of time parameter  nrstdt' )
+      IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
+         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
+         &                   '   verify the file or rerun with the value 0 for the',         &
+         &                   '   control of time parameter  nrstdt' )
+
+      ! Prognostic variables 
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I2.2)') jl
+         znam = 'v_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         v_i(:,:,jl) = z2d(:,:)
+         znam = 'v_s'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         v_s(:,:,jl) = z2d(:,:) 
+         znam = 'smv_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         smv_i(:,:,jl) = z2d(:,:)
+         znam = 'oa_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         oa_i(:,:,jl) = z2d(:,:)
+         znam = 'a_i'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         a_i(:,:,jl) = z2d(:,:)
+         znam = 't_su'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         t_su(:,:,jl) = z2d(:,:)
+         znam = 'tempt_sl1'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         e_s(:,:,1,jl) = z2d(:,:)
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I2.2)') jk
+            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            e_i(:,:,jk,jl) = z2d(:,:)
+         END DO
+      END DO
+
+      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      )
+      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      )
+      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 )
+      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )
+      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
+
+      ! In case Prather scheme is used for advection, read second order moments
+      ! ------------------------------------------------------------------------
+      IF( nn_limadv == -1 ) THEN
+
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            znam = 'sxice'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxice(:,:,jl) = z2d(:,:)
+            znam = 'syice'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syice(:,:,jl) = z2d(:,:)
+            znam = 'sxxice'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxxice(:,:,jl) = z2d(:,:)
+            znam = 'syyice'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syyice(:,:,jl) = z2d(:,:)
+            znam = 'sxyice'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxyice(:,:,jl) = z2d(:,:)
+            znam = 'sxsn'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxsn(:,:,jl) = z2d(:,:)
+            znam = 'sysn'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sysn(:,:,jl) = z2d(:,:)
+            znam = 'sxxsn'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxxsn(:,:,jl) = z2d(:,:)
+            znam = 'syysn'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syysn(:,:,jl) = z2d(:,:)
+            znam = 'sxysn'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxysn(:,:,jl) = z2d(:,:)
+            znam = 'sxa'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxa(:,:,jl) = z2d(:,:)
+            znam = 'sya'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sya(:,:,jl) = z2d(:,:)
+            znam = 'sxxa'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxxa(:,:,jl) = z2d(:,:)
+            znam = 'syya'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syya(:,:,jl) = z2d(:,:)
+            znam = 'sxya'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxya(:,:,jl) = z2d(:,:)
+            znam = 'sxc0'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxc0(:,:,jl) = z2d(:,:)
+            znam = 'syc0'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syc0(:,:,jl) = z2d(:,:)
+            znam = 'sxxc0'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxxc0(:,:,jl) = z2d(:,:)
+            znam = 'syyc0'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syyc0(:,:,jl) = z2d(:,:)
+            znam = 'sxyc0'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxyc0(:,:,jl) = z2d(:,:)
+            znam = 'sxsal'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxsal(:,:,jl) = z2d(:,:)
+            znam = 'sysal'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sysal(:,:,jl) = z2d(:,:)
+            znam = 'sxxsal'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxxsal(:,:,jl) = z2d(:,:)
+            znam = 'syysal'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syysal(:,:,jl) = z2d(:,:)
+            znam = 'sxysal'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxysal(:,:,jl) = z2d(:,:)
+            znam = 'sxage'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxage(:,:,jl) = z2d(:,:)
+            znam = 'syage'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syage(:,:,jl) = z2d(:,:)
+            znam = 'sxxage'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxxage(:,:,jl) = z2d(:,:)
+            znam = 'syyage'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            syyage(:,:,jl) = z2d(:,:)
+            znam = 'sxyage'//'_htc'//zchar
+            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+            sxyage(:,:,jl)= z2d(:,:)
+         END DO
+
+         CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
+         CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
+         CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
+         CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
+         CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
+
+         DO jl = 1, jpl 
+            WRITE(zchar,'(I2.2)') jl
+            DO jk = 1, nlay_i 
+               WRITE(zchar1,'(I2.2)') jk
+               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
+               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+               sxe(:,:,jk,jl) = z2d(:,:)
+               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
+               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+               sye(:,:,jk,jl) = z2d(:,:)
+               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
+               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+               sxxe(:,:,jk,jl) = z2d(:,:)
+               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
+               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+               syye(:,:,jk,jl) = z2d(:,:)
+               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
+               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+               sxye(:,:,jk,jl) = z2d(:,:)
+            END DO
+         END DO
+         !
+      END IF
+      
+      ! clem: I do not understand why the following IF is needed
+      !       I suspect something inconsistent in the main code with option nn_icesal=1
+      IF( nn_icesal == 1 ) THEN
+         DO jl = 1, jpl 
+            sm_i(:,:,jl) = rn_icesal
+            DO jk = 1, nlay_i 
+               s_i(:,:,jk,jl) = rn_icesal
+            END DO
+         END DO
+      ENDIF
+      !
+      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90
+      !
+      CALL wrk_dealloc( jpi, jpj, z2d )
+      !
+   END SUBROUTINE lim_rst_read
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :       Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_rst_read             ! Empty routine
+   END SUBROUTINE lim_rst_read
+   SUBROUTINE lim_rst_write            ! Empty routine
+   END SUBROUTINE lim_rst_write
+#endif
+
+   !!======================================================================
+END MODULE limrst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 8732)
@@ -0,0 +1,394 @@
+MODULE limsbc
+   !!======================================================================
+   !!                       ***  MODULE limsbc   ***
+   !!           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
+   !!            3.3  ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea
+   !!                 !                  + simplification of the ice-ocean stress calculation
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2012    (D. Iovino) salt flux change
+   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
+   !!            3.5  ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                    LIM 3.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_sbc_alloc : allocate the limsbc arrays
+   !!   lim_sbc_init  : initialisation
+   !!   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 oce     , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean domain
+   USE ice            ! LIM sea-ice variables
+   USE sbc_ice        ! Surface boundary condition: sea-ice fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbccpl         ! Surface boundary condition: coupled interface
+   USE albedo         ! albedo parameters
+   USE traqsr         ! add penetration of solar flux in the calculation of heat budget
+   USE domvvl         ! Variable volume
+   USE limctl         !
+   USE limcons        !
+   USE bdy_oce  , ONLY: ln_bdy
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! xIO server
+   USE lbclnk         ! ocean lateral boundary condition - MPP exchanges
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_sbc_init   ! called by sbc_lim_init
+   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
+   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2]
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean velocity   [m/s]
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0  , sice_0     ! cst SSS and ice salinity (levitating sea-ice) 
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lim_sbc_alloc()
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE lim_sbc_alloc ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) ,                       &
+         &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc)
+         !
+      IF( lk_mpp             )   CALL mpp_sum( lim_sbc_alloc )
+      IF( lim_sbc_alloc /= 0 )   CALL ctl_warn('lim_sbc_alloc: failed to allocate arrays')
+   END FUNCTION lim_sbc_alloc
+
+
+   SUBROUTINE lim_sbc_flx( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_sbc_flx ***
+      !!  
+      !! ** Purpose :   Update the surface ocean boundary condition for heat 
+      !!              salt and mass over areas where sea-ice is non-zero
+      !!         
+      !! ** Action  : - computes the heat and freshwater/salt fluxes
+      !!              at the ice-ocean interface.
+      !!              - Update the ocean sbc
+      !!     
+      !! ** Outputs : - qsr     : sea heat flux:     solar 
+      !!              - qns     : sea heat flux: non solar
+      !!              - emp     : freshwater budget: volume flux 
+      !!              - sfx     : salt flux 
+      !!              - fr_i    : ice fraction
+      !!              - tn_ice  : sea-ice surface temperature
+      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode)
+      !!
+      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
+      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
+      !!              These refs are now obsolete since everything has been revised
+      !!              The ref should be Rousset et al., 2015
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+      REAL(wp) ::   zqsr             ! New solar flux received by the ocean
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace
+      !!---------------------------------------------------------------------
+
+      ! --- case we bypass ice thermodynamics --- !
+      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere
+         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
+         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:)
+         ftr_ice  (:,:,:) = 0._wp
+         emp_ice  (:,:)   = 0._wp
+         qemp_ice (:,:)   = 0._wp
+         qevap_ice(:,:,:) = 0._wp
+      ENDIF
+      
+      ! albedo output
+      CALL wrk_alloc( jpi,jpj, zalb )    
+
+      zalb(:,:) = 0._wp
+      WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = 0.066_wp
+      ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
+      END WHERE
+      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output
+
+      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )      
+      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output
+
+      CALL wrk_dealloc( jpi,jpj, zalb )    
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            !------------------------------------------!
+            !      heat flux at the ocean surface      !
+            !------------------------------------------!
+            ! Solar heat flux reaching the ocean = zqsr (W.m-2) 
+            !---------------------------------------------------
+            zqsr = qsr_tot(ji,jj)
+            DO jl = 1, jpl
+               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 
+            END DO
+
+            ! Total heat flux reaching the ocean = hfx_out (W.m-2) 
+            !---------------------------------------------------
+            zqmass         = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+            hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
+
+            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
+            !----------------------------------------------------------------------
+            hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) +   &
+               &           ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
+
+            ! New qsr and qns used to compute the oceanic heat flux at the next time step
+            !----------------------------------------------------------------------------
+            qsr(ji,jj) = zqsr                                      
+            qns(ji,jj) = hfx_out(ji,jj) - zqsr              
+
+            !------------------------------------------!
+            !      mass flux at the ocean surface      !
+            !------------------------------------------!
+            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
+            !  ------------------------------------------------------------------------------------- 
+            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
+            !  Thus  FW  flux  =  External ( E-P+snow melt)
+            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
+            !                     Associated to Ice formation AND Ice melting
+            !                     Even if i see Ice melting as a FW and SALT flux
+            !        
+            ! mass flux from ice/ocean
+            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
+                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 
+
+            ! mass flux at the ocean/ice interface
+            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
+            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+         END DO
+      END DO
+
+      !------------------------------------------!
+      !      salt flux at the ocean surface      !
+      !------------------------------------------!
+      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   &
+         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:)
+
+      !-------------------------------------------------------------!
+      !   mass of snow and ice per unit area for embedded sea-ice   !
+      !-------------------------------------------------------------!
+      IF( nn_ice_embd /= 0 ) THEN
+         ! save mass from the previous ice time step
+         snwice_mass_b(:,:) = snwice_mass(:,:)                  
+         ! new mass per unit area
+         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
+         ! time evolution of snow+ice mass
+         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice
+      ENDIF
+
+      !-----------------------------------------------!
+      !   Storing the transmitted variables           !
+      !-----------------------------------------------!
+      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction            
+      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
+
+      !------------------------------------------------------------------------!
+      !    Snow/ice albedo (only if sent to coupler, useless in forced mode)   !
+      !------------------------------------------------------------------------!
+      CALL wrk_alloc( jpi,jpj,jpl,   zalb_cs, zalb_os )    
+      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
+      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+      CALL wrk_dealloc( jpi,jpj,jpl,   zalb_cs, zalb_os )
+
+      ! conservation test
+      IF( ln_limdiachk .AND. .NOT. ln_bdy)  CALL lim_cons_final( 'limsbc' )
+
+      ! control prints
+      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )
+      IF( ln_ctl )      CALL lim_prt3D( 'limsbc' )
+
+   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, zrhoco  !   -      -
+      !!---------------------------------------------------------------------
+      zrhoco = rau0 * rn_cio
+      !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
+         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
+            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) * zrhoco * zmodt
+               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
+            END DO
+         END DO
+         CALL lbc_lnk_multi( taum, 'T', 1., 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_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition
+      !
+      !  
+   END SUBROUTINE lim_sbc_tau
+
+
+   SUBROUTINE lim_sbc_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_sbc_init  ***
+      !!             
+      !! ** Purpose : Preparation of the file ice_evolu for the output of
+      !!      the temporal evolution of key variables
+      !!
+      !! ** input   : Namelist namicedia
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff   ! local scalar
+      !!-------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   '
+
+      !                                      ! allocate lim_sbc array
+      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' )
+      !
+      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case
+      sice_0(:,:) = sice
+      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area
+      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
+      !
+      IF( .NOT. ln_rstart ) THEN
+         !                                      ! embedded sea ice
+         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
+            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )
+            snwice_mass_b(:,:) = snwice_mass(:,:)
+         ELSE
+            snwice_mass  (:,:) = 0._wp          ! no mass exchanges
+            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges
+         ENDIF
+         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area
+            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
+            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+
+!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently
+!!gm
+            IF( .NOT.ln_linssh ) THEN
+               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
+                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               END DO
+               e3t_a(:,:,:) = e3t_b(:,:,:)
+               ! Reconstruction of all vertical scale factors at now and before time-steps
+               ! =========================================================================
+               ! Horizontal scale factor interpolations
+               ! --------------------------------------
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+               ! Vertical scale factor interpolations
+                 ! ------------------------------------
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+               ! t- and w- points depth
+               ! ----------------------
+!!gm not sure of that....
+               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+               gdepw_n(:,:,1) = 0.0_wp
+               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+               DO jk = 2, jpk
+                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
+                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+               END DO
+            ENDIF
+         ENDIF
+      ENDIF ! .NOT. ln_rstart
+      !
+   END SUBROUTINE lim_sbc_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :        Dummy module       NO LIM 3.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_sbc           ! Dummy routine
+   END SUBROUTINE lim_sbc
+#endif 
+
+   !!======================================================================
+END MODULE limsbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 8732)
@@ -0,0 +1,71 @@
+MODULE limtab
+   !!======================================================================
+   !!                       ***  MODULE limtab   ***
+   !!   LIM ice model : transform 1D (2D) array to a 2D (1D) table
+   !!======================================================================
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   tab_2d_1d  : 2-D <==> 1-D
+   !!   tab_1d_2d  : 1-D <==> 2-D
+   !!----------------------------------------------------------------------
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tab_2d_1d   ! called by limthd
+   PUBLIC   tab_1d_2d   ! called by limthd
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tab_2d_1d( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes
+      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in   ) ::   tab2d                        ! input 2D field
+      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index
+      REAL(wp), DIMENSION(ndim1d)           , INTENT(  out) ::   tab1d                        ! output 1D field
+      !
+      INTEGER ::   jn , jid, jjd
+      !!----------------------------------------------------------------------
+      DO jn = 1, ndim1d
+         jid        = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1
+         jjd        =    ( tab_ind(jn) - 1 ) / ndim2d_x + 1
+         tab1d( jn) = tab2d( jid, jjd)
+      END DO
+   END SUBROUTINE tab_2d_1d
+
+
+   SUBROUTINE tab_1d_2d( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tab_2d_1d  ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes
+      REAL(wp), DIMENSION(ndim1d)           , INTENT(in   ) ::   tab1d                        ! input 1D field
+      INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index
+      REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(  out) ::   tab2d                        ! output 2D field
+      !
+      INTEGER ::   jn , jid, jjd
+      !!----------------------------------------------------------------------
+      DO jn = 1, ndim1d
+         jid             = MOD( tab_ind(jn) - 1 ,  ndim2d_x ) + 1
+         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1
+         tab2d(jid, jjd) = tab1d( jn)
+      END DO
+   END SUBROUTINE tab_1d_2d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option        Dummy module             NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE limtab
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 8732)
@@ -0,0 +1,633 @@
+MODULE limthd
+   !!======================================================================
+   !!                  ***  MODULE limthd   ***
+   !!  LIM-3 :   ice thermodynamic
+   !!======================================================================
+   !! History :  LIM  ! 2000-01 (M.A. Morales Maqueda, H. Goosse, T. Fichefet) LIM-1
+   !!            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, lim_thd_con_dh and lim_thd_con_dif
+   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw
+   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas)
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   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            ! sea-ice variables
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE thd_ice        ! thermodynamic sea-ice variables
+   USE limthd_dif     ! vertical diffusion
+   USE limthd_dh      ! ice-snow growth and melt
+   USE limthd_da      ! lateral melting
+   USE limthd_sal     ! ice salinity
+   USE limthd_ent     ! ice enthalpy redistribution
+   USE limthd_lac     ! lateral accretion
+   USE limitd_th      ! remapping thickness distribution
+   USE limtab         ! 1D <==> 2D transformation
+   USE limvar         !
+   USE limcons        ! conservation tests
+   USE limctl         ! control print
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! lateral boundary condition - MPP links
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd         ! called by limstp module
+   PUBLIC   lim_thd_init    ! called by sbc_lim_init
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd( kt )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd  ***       
+      !!  
+      !! ** Purpose : This routine manages ice thermodynamics
+      !!         
+      !! ** Action : - Initialisation of some variables
+      !!             - Some preliminary computation (oceanic heat flux
+      !!               at the ice base, snow acc.,heat budget of the leads)
+      !!             - selection of the icy points and put them in an array
+      !!             - call lim_thd_dif  for vertical heat diffusion
+      !!             - call lim_thd_dh   for vertical ice growth and melt
+      !!             - call lim_thd_ent  for enthalpy remapping
+      !!             - call lim_thd_sal  for ice desalination
+      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy
+      !!             - back to the geographic grid
+      !!     
+      !! ** References : 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt    ! number of iteration
+      !
+      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations
+      REAL(wp) :: zfric_u, zqld, zqfr
+      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04)
+      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)
+      !
+      !!-------------------------------------------------------------------
+
+      IF( nn_timing == 1 )   CALL timing_start('limthd')
+
+      CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric )
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)'' 
+         WRITE(numout,*)' lim_thd '
+         WRITE(numout,*)' ~~~~~~~~'
+      ENDIF
+      
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      CALL lim_var_glo2eqv
+
+      !---------------------------------------------!
+      ! computation of friction velocity at T points
+      !---------------------------------------------!
+      IF( ln_limdyn ) THEN
+         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
+         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1
+               zfric(ji,jj) = rn_cio * ( 0.5_wp *  &
+                  &                    (  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) ) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  &
+                  &                         (  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) ) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      CALL lbc_lnk( zfric, 'T',  1. )
+      !
+      !----------------------------------!
+      ! Initialization and units change
+      !----------------------------------!
+      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice
+
+      ! Change the units of heat content; from J/m2 to J/m3
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )
+                  !Energy of melting q(S,T) [J.m-3]
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i )
+               END DO
+            END DO
+         END DO
+         DO jk = 1, nlay_s
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch = MAX(  0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 )  )
+                  !Energy of melting q(S,T) [J.m-3]
+                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !--------------------------------------------------------------------!
+      ! Partial computation of forcing for the thermodynamic sea ice model
+      !--------------------------------------------------------------------!
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
+            !
+            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+            !           !  practically no "direct lateral ablation"
+            !           
+            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+            !           !  temperature and turbulent mixing (McPhee, 1992)
+            !
+            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
+            zqld =  tmask(ji,jj,1) * rdt_ice *  &
+               &    ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
+            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+
+            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- !
+            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
+            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2
+            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+            !                        the freezing point, so that we do not have SST < T_freeze
+            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
+
+            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice
+            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
+
+            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 
+            IF( zqld > 0._wp ) THEN
+               fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
+               qlead(ji,jj) = 0._wp
+            ELSE
+               fhld (ji,jj) = 0._wp
+            ENDIF
+            !
+            ! Net heat flux on top of the ice-ocean [W.m-2]
+            ! ---------------------------------------------
+            hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 
+         END DO
+      END DO
+      
+      ! In case we bypass open-water ice formation
+      IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp
+      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere
+      IF( .NOT. ln_limdH )  hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
+      IF( .NOT. ln_limdH )  fhtur (:,:) = 0._wp  ;  fhld  (:,:) = 0._wp
+
+      ! ---------------------------------------------------------------------
+      ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
+      ! ---------------------------------------------------------------------
+      !     First  step here              :  non solar + precip - qlead - qturb
+      !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema) 
+      !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            hfx_out(ji,jj) =   pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj)  &  ! Non solar heat flux received by the ocean               
+               &             - qlead(ji,jj) * r1_rdtice                         &  ! heat flux taken from the ocean where there is open water ice formation
+               &             - at_i(ji,jj) * fhtur(ji,jj)                       &  ! heat flux taken by turbulence
+               &             - at_i(ji,jj) *  fhld(ji,jj)                          ! heat flux taken during bottom growth/melt 
+                                                                                   !    (fhld should be 0 while bott growth)
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! Thermodynamic computation (only on grid points covered by ice)
+      !------------------------------------------------------------------------------!
+
+      DO jl = 1, jpl      !loop over ice categories
+
+         ! select ice covered grid points
+         nbpb = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
+                  nbpb      = nbpb  + 1
+                  npb(nbpb) = (jj - 1) * jpi + ji
+               ENDIF
+            END DO
+         END DO
+
+         ! debug point to follow
+         jiindex_1d = 0
+         IF( ln_limctl ) THEN
+            DO ji = mi0(iiceprt), mi1(iiceprt)
+               DO jj = mj0(jiceprt), mj1(jiceprt)
+                  jiindex_1d = (jj - 1) * jpi + ji
+                  WRITE(numout,*) ' lim_thd : Category no : ', jl 
+               END DO
+            END DO
+         ENDIF
+
+         IF( lk_mpp )         CALL mpp_ini_ice( nbpb , numout )
+
+         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing.
+            !                                                                
+            s_i_new   (:) = 0._wp ; dh_s_tot (:) = 0._wp                     ! --- some init --- !
+            dh_i_surf (:) = 0._wp ; dh_i_bott(:) = 0._wp
+            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp
+
+                              CALL lim_thd_1d2d( nbpb, jl, 1 )               ! --- Move to 1D arrays --- !
+            !
+            IF( ln_limdH )    CALL lim_thd_dif( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- !
+            !
+            IF( ln_limdH )    CALL lim_thd_dh( 1, nbpb )                     ! --- Ice/Snow thickness --- !    
+            !
+            IF( ln_limdH )    CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- !
+            !
+                              CALL lim_thd_sal( 1, nbpb )                    ! --- Ice salinity --- !    
+            !
+                              CALL lim_thd_temp( 1, nbpb )                   ! --- temperature update --- !
+            !
+            IF( ln_limdH ) THEN
+               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
+                              CALL lim_thd_lam( 1, nbpb )                    ! --- extra lateral melting if monocat --- !
+               END IF
+            END IF
+            !
+                              CALL lim_thd_1d2d( nbpb, jl, 2 )               ! --- Move to 2D arrays --- !
+            !
+            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
+         ENDIF
+         !
+      END DO !jl
+
+      IF( ln_limdA)           CALL lim_thd_da                                ! --- lateral melting --- !
+
+      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i
+         END DO
+         DO jk = 1, nlay_s
+            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s
+         END DO
+      END DO
+ 
+      ! Change thickness to volume
+      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
+      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
+      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
+
+      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
+      DO jl  = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) )
+               oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 )
+            END DO
+         END DO
+      END DO
+
+      CALL lim_var_zapsmall
+
+      ! control checks
+      IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' )   ! control print
+      !
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !------------------------------------------------!
+      !  Transport ice between thickness categories
+      !------------------------------------------------!
+      ! Given thermodynamic growth rates, transport ice between thickness categories.
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      IF( jpl > 1 )      CALL lim_itd_th_rem( 1, jpl, kt )
+
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !------------------------------------------------!
+      !  Add frazil ice growing in leads
+      !------------------------------------------------!
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      IF( ln_limdO )     CALL lim_thd_lac
+      
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! Control print
+      IF( ln_ctl )       CALL lim_prt3D( 'limthd' )
+      !
+      CALL wrk_dealloc( jpi,jpj, zu_io, zv_io, zfric )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('limthd')
+
+   END SUBROUTINE lim_thd 
+
+ 
+   SUBROUTINE lim_thd_temp( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_temp *** 
+      !!                 
+      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy
+      !!
+      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
+      !
+      INTEGER  ::   ji, jk   ! dummy loop indices
+      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar 
+      !!-------------------------------------------------------------------
+      ! Recover ice temperature
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0
+            ! Conversion q(S,T) -> T (second order equation)
+            zaaa          =  cpic
+            zbbb          =  ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus
+            zccc          =  lfus * ( ztmelts - rt0 )
+            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) )
+            t_i_1d(ji,jk) =  rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
+            
+            ! mask temperature
+            rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
+            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
+         END DO 
+      END DO 
+      !
+   END SUBROUTINE lim_thd_temp
+
+
+   SUBROUTINE lim_thd_lam( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_lam *** 
+      !!                 
+      !! ** Purpose :   Lateral melting in case monocategory
+      !!                          ( dA = A/2h dh )
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop
+      !
+      INTEGER  ::   ji                 ! dummy loop indices
+      REAL(wp) ::   zhi_bef            ! ice thickness before thermo
+      REAL(wp) ::   zdh_mel, zda_mel   ! net melting
+      REAL(wp) ::   zvi, zvs           ! ice/snow volumes 
+      !!-----------------------------------------------------------------------
+      !
+      DO ji = kideb, kiut
+         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) )
+         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN
+            zvi          = a_i_1d(ji) * ht_i_1d(ji)
+            zvs          = a_i_1d(ji) * ht_s_1d(ji)
+            ! lateral melting = concentration change
+            zhi_bef     = ht_i_1d(ji) - zdh_mel
+            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
+            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
+            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
+            ! adjust thickness
+            ht_i_1d(ji) = zvi / a_i_1d(ji)            
+            ht_s_1d(ji) = zvs / a_i_1d(ji)            
+            ! retrieve total concentration
+            at_i_1d(ji) = a_i_1d(ji)
+         END IF
+      END DO
+      !
+   END SUBROUTINE lim_thd_lam
+
+
+   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_1d2d *** 
+      !!                 
+      !! ** Purpose :   move arrays from 1d to 2d and the reverse
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D
+      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays
+      INTEGER, INTENT(in) ::   jl       ! ice cat
+      !
+      INTEGER             ::   jk       ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      SELECT CASE( kn )
+      !
+      CASE( 1 )            ! from 2D to 1D
+         !
+         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         !
+         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+         DO jk = 1, nlay_s
+            CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+         END DO
+         !
+         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) ) 
+         CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) )
+         !
+         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) )
+         !
+         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) )
+         !
+         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub         , jpi, jpj,npb(1:nbpb) )
+         !
+         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
+         !
+      CASE( 2 )            ! from 1D to 2D
+         !
+         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj )
+         DO jk = 1, nlay_s
+            CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj)
+         END DO
+         DO jk = 1, nlay_i
+            CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj)
+            CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj)
+         END DO
+         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj )
+         !
+         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj )
+         !
+         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj )
+         !
+         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sfx_sub       , npb, sfx_sub_1d(1:nbpb)   , jpi, jpj )        
+         !
+         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj )
+         CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj )
+         !
+         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
+         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+         !         
+      END SELECT
+      !
+   END SUBROUTINE lim_thd_1d2d
+
+
+   SUBROUTINE lim_thd_init
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_init *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters linked to the ice 
+      !!              thermodynamics
+      !!
+      !! ** Method  :   Read the namicethd namelist and check the ice-thermo
+      !!              parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicether
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, ln_it_qnsice, nn_monocat, rn_cdsn,  &
+         &                ln_limdH, rn_betas,                                                                     &
+         &                ln_limdA, rn_beta, rn_dmin,                                                             &
+         &                ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicethd in reference namelist : Ice thermodynamics
+      READ  ( numnam_ice_ref, namicethd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicethd in configuration namelist : Ice thermodynamics
+      READ  ( numnam_ice_cfg, namicethd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicethd )
+      !
+      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN 
+         nn_monocat = 0
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen'
+      ENDIF
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*) 'lim_thd_init : Ice Thermodynamics'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+         WRITE(numout,*)'   -- limthd_dif --'
+         WRITE(numout,*)'      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i
+         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nn_conv_dif  = ', nn_conv_dif
+         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif
+         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon
+         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice
+         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat
+         WRITE(numout,*)'      thermal conductivity of the snow                        rn_cdsn      = ', rn_cdsn
+         WRITE(numout,*)'   -- limthd_dh --'
+         WRITE(numout,*)'      activate ice thick change from top/bot (T) or not (F)   ln_limdH     = ', ln_limdH
+         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          rn_betas     = ', rn_betas
+         WRITE(numout,*)'   -- limthd_da --'
+         WRITE(numout,*)'      activate lateral melting (T) or not (F)                 ln_limdA     = ', ln_limdA
+         WRITE(numout,*)'      Coef. beta for lateral melting param.                   rn_beta      = ', rn_beta
+         WRITE(numout,*)'      Minimum floe diameter for lateral melting param.        rn_dmin      = ', rn_dmin
+         WRITE(numout,*)'   -- limthd_lac --'
+         WRITE(numout,*)'      activate ice growth in open-water (T) or not (F)        ln_limdO     = ', ln_limdO
+         WRITE(numout,*)'      ice thick. for lateral accretion                        rn_hnewice   = ', rn_hnewice
+         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       ln_frazil    = ', ln_frazil
+         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   rn_maxfrazb  = ', rn_maxfrazb
+         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  rn_vfrazb    = ', rn_vfrazb
+         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          rn_Cfrazb    = ', rn_Cfrazb
+         WRITE(numout,*)'   -- limitd_th --'
+         WRITE(numout,*)'      minimum ice thickness                                   rn_himin     = ', rn_himin 
+         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i
+      ENDIF
+      !
+   END SUBROUTINE lim_thd_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module          NO  LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limthd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90	(revision 8732)
@@ -0,0 +1,183 @@
+MODULE limthd_da
+   !!======================================================================
+   !!                       ***  MODULE limthd_da ***
+   !! LIM-3 sea-ice :  computation of lateral melting in the ice
+   !!======================================================================
+   !! History :   4.0   ! 2016-03 (C. Rousset) original code
+   !!---------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd_da   : sea ice lateral melting
+   !!----------------------------------------------------------------------
+   USE par_oce                ! ocean parameters
+   USE phycst                 ! physical constants (ocean directory)
+   USE sbc_oce, ONLY: sst_m   ! Surface boundary condition: ocean fields
+   USE ice                    ! LIM variables
+   USE lib_mpp                ! MPP library
+   USE wrk_nemo               ! work arrays
+   USE lib_fortran            ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_da        ! called by limthd module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id: limthd_da.F90 5123 2015-03-04 16:06:03Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_da
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd_da  ***    
+      !!   
+      !! ** Purpose :   computes sea ice lateral melting
+      !!
+      !! ** Method  :   dA/dt = - P * W   [s-1]
+      !!                   W = melting velocity [m.s-1]
+      !!                   P = perimeter of ice-ocean lateral interface normalized by grid cell area [m.m-2]
+      !!
+      !!                   W = m1 * (Tw -Tf)**m2                    --- originally from Josberger 1979 ---
+      !!                      (Tw - Tf) = elevation of water temp above freezing
+      !!                      m1 and m2 = (1.6e-6 , 1.36) best fit from field experiment near the coast of Prince Patrick Island (Perovich 1983) => static ice
+      !!                      m1 and m2 = (3.0e-6 , 1.36) best fit from MIZEX 84 experiment (Maykut and Perovich 1987) => moving ice
+      !!
+      !!                   P = N * pi * D                           --- from Rothrock and Thorndike 1984 ---
+      !!                      D = mean floe caliper diameter
+      !!                      N = number of floes = ice area / floe area(average) = A / (Cs * D**2)
+      !!                         A = ice concentration
+      !!                         Cs = deviation from a square (square:Cs=1 ; circle:Cs=pi/4 ; floe:Cs=0.66)
+      !!
+      !!                   D = Dmin * ( Astar / (Astar-A) )**beta   --- from Lupkes et al., 2012 (eq. 26-27) ---
+      !!                                                             
+      !!                      Astar = 1 / ( 1 - (Dmin/Dmax)**(1/beta) )
+      !!                      Dmin = minimum floe diameter (recommended to be 8m +- 20%)
+      !!                      Dmax = maximum floe diameter (recommended to be 300m, but it does not impact melting much except for Dmax<100m)
+      !!                      beta = 1.0 +-20% (recommended value)
+      !!                           = 0.3 best fit for western Fram Strait and Antarctica
+      !!                           = 1.4 best fit for eastern Fram Strait
+      !!
+      !! ** Tunable parameters  :   We propose to tune the lateral melting via 2 parameters
+      !!                               Dmin [6-10m]   => 6  vs 8m = +40% melting at the peak (A~0.5)
+      !!                                                 10 vs 8m = -20% melting
+      !!                               beta [0.8-1.2] => decrease = more melt and melt peaks toward higher concentration
+      !!                                                                  (A~0.5 for beta=1 ; A~0.8 for beta=0.2)
+      !!                                                 0.3 = best fit for western Fram Strait and Antarctica
+      !!                                                 1.4 = best fit for eastern Fram Strait
+      !!
+      !! ** Note   :   Former and more simple formulations for floe diameters can be found in Mai (1995), 
+      !!               Birnbaum and Lupkes (2002), Lupkes and Birnbaum (2005). They are reviewed in Lupkes et al 2012
+      !!               A simpler implementation for CICE can be found in Bitz et al (2001) and Tsamados et al (2015)
+      !!
+      !! ** References
+      !!    Bitz, C. M., Holland, M. M., Weaver, A. J., & Eby, M. (2001).
+      !!              Simulating the ice‐thickness distribution in a coupled climate model.
+      !!              Journal of Geophysical Research: Oceans, 106(C2), 2441-2463.
+      !!    Josberger, E. G. (1979).
+      !!              Laminar and turbulent boundary layers adjacent to melting vertical ice walls in salt water
+      !!              (No. SCIENTIFIC-16). WASHINGTON UNIV SEATTLE DEPT OF ATMOSPHERIC SCIENCES.
+      !!    Lüpkes, C., Gryanik, V. M., Hartmann, J., & Andreas, E. L. (2012).
+      !!              A parametrization, based on sea ice morphology, of the neutral atmospheric drag coefficients
+      !!              for weather prediction and climate models.
+      !!              Journal of Geophysical Research: Atmospheres, 117(D13).
+      !!    Maykut, G. A., & Perovich, D. K. (1987).
+      !!              The role of shortwave radiation in the summer decay of a sea ice cover.
+      !!              Journal of Geophysical Research: Oceans, 92(C7), 7032-7044.
+      !!    Perovich, D. K. (1983).
+      !!              On the summer decay of a sea ice cover. (Doctoral dissertation, University of Washington).
+      !!    Rothrock, D. A., & Thorndike, A. S. (1984).
+      !!              Measuring the sea ice floe size distribution.
+      !!              Journal of Geophysical Research: Oceans, 89(C4), 6477-6486.
+      !!    Tsamados, M., Feltham, D., Petty, A., Schroeder, D., & Flocco, D. (2015).
+      !!              Processes controlling surface, bottom and lateral melt of Arctic sea ice in a state of the art sea ice model.
+      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167.
+      !!---------------------------------------------------------------------
+      INTEGER             ::   ji, jj, jl      ! dummy loop indices
+      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda
+      REAL(wp), PARAMETER ::   zdmax = 300._wp
+      REAL(wp), PARAMETER ::   zcs   = 0.66_wp
+      REAL(wp), PARAMETER ::   zm1   = 3.e-6_wp
+      REAL(wp), PARAMETER ::   zm2   = 1.36_wp
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zda_tot
+      !!---------------------------------------------------------------------
+      CALL wrk_alloc( jpi,jpj, zda_tot )
+
+      !------------------------------------------------------------!
+      ! --- Calculate reduction of total sea ice concentration --- !
+      !------------------------------------------------------------!
+      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            
+            ! Mean floe caliper diameter [m]
+            zdfloe = rn_dmin * ( zastar / ( zastar - at_i(ji,jj) ) )**rn_beta
+            
+            ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2]
+            zperi = at_i(ji,jj) * rpi / ( zcs * zdfloe )
+            
+            ! Melt speed rate [m/s]
+            zwlat = zm1 * ( MAX( 0._wp, sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) )**zm2
+            
+            ! sea ice concentration decrease
+            zda_tot(ji,jj) = - MIN( zwlat * zperi * rdt_ice, at_i(ji,jj) )
+            
+         END DO
+      END DO
+      
+      !---------------------------------------------------------------------------------------------!
+      ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !
+      !---------------------------------------------------------------------------------------------!
+      DO jl = jpl, 1, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               
+               ! decrease of concentration for the category jl
+               !    1st option: each category contributes to melting in proportion to its concentration
+               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj) - epsi10 ) )
+               zda     = rswitch * zda_tot(ji,jj) * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi10 )
+               !    2d option: melting of the upper cat first
+               !!zda = MAX( zda_tot(ji,jj), - a_i(ji,jj,jl) )
+               !!zda_tot(ji,jj) = zda_tot(ji,jj) + zda
+               
+               ! Contribution to salt flux
+               sfx_lam(ji,jj) = sfx_lam(ji,jj) - rhoic *  ht_i(ji,jj,jl) * zda * sm_i(ji,jj,jl) * r1_rdtice
+               
+               ! Contribution to heat flux into the ocean [W.m-2], <0  
+               hfx_thd(ji,jj) = hfx_thd(ji,jj) + zda * r1_rdtice * ( ht_i(ji,jj,jl) * SUM( e_i(ji,jj,:,jl) ) * r1_nlay_i  &
+                  &                                                + ht_s(ji,jj,jl) *      e_s(ji,jj,1,jl)   * r1_nlay_s )
+               
+               ! Contribution to mass flux
+               wfx_lam(ji,jj) =  wfx_lam(ji,jj) - zda * r1_rdtice * ( rhoic * ht_i(ji,jj,jl) + rhosn * ht_s(ji,jj,jl) )
+               
+               ! new concentration
+               a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda
+            END DO
+         END DO
+      END DO
+      
+      ! total concentration
+      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
+      
+      ! --- ensure that ht_i = 0 where a_i = 0 ---
+      WHERE( a_i == 0._wp ) ht_i = 0._wp
+      !
+      CALL wrk_dealloc( jpi,jpj, zda_tot )
+      !
+   END SUBROUTINE lim_thd_da
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy Module          No LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_da          ! Empty routine
+   END SUBROUTINE lim_thd_da
+#endif
+   !!======================================================================
+END MODULE limthd_da
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 8732)
@@ -0,0 +1,719 @@
+MODULE limthd_dh
+   !!======================================================================
+   !!                       ***  MODULE limthd_dh ***
+   !!  LIM-3 :   thermodynamic growth and decay of the ice 
+   !!======================================================================
+   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D
+   !!                 ! 2005-06 (M. Vancoppenolle) 3D version 
+   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes 
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd_dh    : vertical accr./abl. and lateral ablation of sea ice
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE phycst         ! physical constants (OCE directory) 
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE ice            ! LIM variables
+   USE thd_ice        ! LIM thermodynamics
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_dh      ! called by lim_thd
+   PUBLIC   lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here
+
+   INTERFACE lim_thd_snwblow
+      MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d
+   END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_dh( kideb, kiut )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd_dh  ***
+      !!
+      !! ** Purpose :   determines variations of ice and snow thicknesses.
+      !!
+      !! ** Method  :   Ice/Snow surface melting arises from imbalance in surface fluxes
+      !!              Bottom accretion/ablation arises from flux budget
+      !!              Snow thickness can increase by precipitation and decrease by sublimation
+      !!              If snow load excesses Archmiede limit, snow-ice is formed by
+      !!              the flooding of sea-water in the snow
+      !!
+      !!                 1) Compute available flux of heat for surface ablation
+      !!                 2) Compute snow and sea ice enthalpies
+      !!                 3) Surface ablation and sublimation
+      !!                 4) Bottom accretion/ablation
+      !!                 5) Case of Total ablation
+      !!                 6) Snow ice formation
+      !!
+      !! References : Bitz and Lipscomb, 1999, J. Geophys. Res.
+      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
+      !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 
+      !!              Vancoppenolle et al.,2009, Ocean Modelling
+      !!------------------------------------------------------------------
+      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
+      !! 
+      INTEGER  ::   ji , jk        ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji
+      INTEGER  ::   iter
+
+      REAL(wp) ::   ztmelts             ! local scalar
+      REAL(wp) ::   zdum       
+      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
+      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity
+      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity
+      REAL(wp) ::   zswi2        ! switch for computation of bottom salinity
+      REAL(wp) ::   zgrr         ! bottom growth rate
+      REAL(wp) ::   zt_i_new     ! bottom formation temperature
+
+      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean
+      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg)
+      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg)
+      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg)
+      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean
+      REAL(wp) ::   zsstK        ! SST in Kelvin
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3)
+      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2)
+      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2)
+      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
+      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
+      REAL(wp), POINTER, DIMENSION(:) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt 
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre   ! snow precipitation 
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub   ! snow sublimation
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness
+      INTEGER , POINTER, DIMENSION(:,:) ::   icount    ! number of layers vanished by melting 
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2)
+      REAL(wp), POINTER, DIMENSION(:) ::   zsnw        ! distribution of snow after wind blowing
+
+      REAL(wp) :: zswitch_sal
+
+      ! Heat conservation 
+      INTEGER  ::   num_iter_max
+
+      !!------------------------------------------------------------------
+
+      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values)
+      SELECT CASE( nn_icesal )                  ! varying salinity or not
+         CASE( 1, 3 ) ;   zswitch_sal = 0       ! prescribed salinity profile
+         CASE( 2 )    ;   zswitch_sal = 1       ! varying salinity profile
+      END SELECT
+
+      CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
+      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )
+      CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
+      CALL wrk_alloc( jpij, nlay_i, icount )
+       
+      zqprec   (:) = 0._wp ; zq_su    (:) = 0._wp ; zq_bo    (:) = 0._wp ; zf_tt(:) = 0._wp
+      zq_rema  (:) = 0._wp ; zsnw     (:) = 0._wp ; zevap_rema(:) = 0._wp ;
+      zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp
+
+      zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp       
+      icount (:,:) = 0
+
+      ! Initialize enthalpy at nlay_i+1
+      DO ji = kideb, kiut
+         q_i_1d(ji,nlay_i+1) = 0._wp
+      END DO
+
+      ! initialize layer thicknesses and enthalpies
+      h_i_old (:,0:nlay_i+1) = 0._wp
+      qh_i_old(:,0:nlay_i+1) = 0._wp
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i
+            qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk)
+         ENDDO
+      ENDDO
+      !
+      !------------------------------------------------------------------------------!
+      !  1) Calculate available heat for surface and bottom ablation                 !
+      !------------------------------------------------------------------------------!
+      !
+      DO ji = kideb, kiut
+         zdum       = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
+         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
+
+         zq_su (ji) = MAX( 0._wp, zdum      * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
+         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
+      END DO
+
+      !
+      !------------------------------------------------------------------------------!
+      ! If snow temperature is above freezing point, then snow melts 
+      ! (should not happen but sometimes it does)
+      !------------------------------------------------------------------------------!
+      DO ji = kideb, kiut
+         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting
+            ! Contribution to heat flux to the ocean [W.m-2], < 0  
+            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
+            ! Contribution to mass flux
+            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
+            ! updates
+            ht_s_1d(ji)   = 0._wp
+            q_s_1d (ji,1) = 0._wp
+            t_s_1d (ji,1) = rt0
+         END IF
+      END DO
+
+      !------------------------------------------------------------!
+      !  2) Computing layer thicknesses and enthalpies.            !
+      !------------------------------------------------------------!
+      !
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i
+            zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk)
+         END DO
+      END DO
+      !
+      !------------------------------------------------------------------------------|
+      !  3) Surface ablation and sublimation                                         |
+      !------------------------------------------------------------------------------|
+      !
+      !-------------------------
+      ! 3.1 Snow precips / melt
+      !-------------------------
+      ! Snow accumulation in one thermodynamic time step
+      ! snowfall is partitionned between leads and ice
+      ! if snow fall was uniform, a fraction (1-at_i) would fall into leads
+      ! but because of the winds, more snow falls on leads than on sea ice
+      ! and a greater fraction (1-at_i)^beta of the total mass of snow 
+      ! (beta < 1) falls in leads.
+      ! In reality, beta depends on wind speed, 
+      ! and should decrease with increasing wind speed but here, it is 
+      ! considered as a constant. an average value is 0.66
+      ! Martin Vancoppenolle, December 2006
+
+      CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing
+
+      zdeltah(:,:) = 0._wp
+      DO ji = kideb, kiut
+         !-----------
+         ! Snow fall
+         !-----------
+         ! thickness change
+         zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)
+         ! enthalpy of the precip (>0, J.m-3)
+         zqprec   (ji) = - qprec_ice_1d(ji)   
+         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
+         ! heat flux from snow precip (>0, W.m-2)
+         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+         ! mass flux, <0
+         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
+
+         !---------------------
+         ! Melt of falling snow
+         !---------------------
+         ! thickness change
+         rswitch        = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )
+         zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
+         zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 
+         ! heat used to melt snow (W.m-2, >0)
+         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+         ! snow melting only = water into the ocean (then without snow precip), >0
+         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice    
+         ! updates available heat + precipitations after melting
+         zq_su     (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )      
+         zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+
+         ! update thickness
+         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
+      END DO
+
+      ! If heat still available (zq_su > 0), then melt more snow
+      zdeltah(:,:) = 0._wp
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            ! thickness change
+            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) 
+            rswitch          = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) ) 
+            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 )
+            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting
+            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)    
+            ! heat used to melt snow(W.m-2, >0)
+            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice 
+            ! snow melting only = water into the ocean (then without snow precip)
+            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+            ! updates available heat + thickness
+            zq_su (ji)  = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
+            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) )
+         END DO
+      END DO
+
+      !------------------------------
+      ! 3.2 Sublimation (part1: snow) 
+      !------------------------------
+      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
+      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
+      zdeltah(:,:) = 0._wp
+      DO ji = kideb, kiut
+         zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
+         ! remaining evap in kg.m-2 (used for ice melting later on)
+         zevap_rema(ji)  = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn
+         ! Heat flux by sublimation [W.m-2], < 0 (sublimate first snow that had fallen, then pre-existing snow)
+         zdeltah(ji,1)  = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
+         hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1)  &
+            &                              ) * a_i_1d(ji) * r1_rdtice
+         ! Mass flux by sublimation
+         wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
+         ! new snow thickness
+         ht_s_1d(ji)    =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
+         ! update precipitations after sublimation and correct sublimation
+         zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+         zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1)
+      END DO
+      
+      ! --- Update snow diags --- !
+      DO ji = kideb, kiut
+         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
+      END DO
+
+      !-------------------------------------------
+      ! 3.3 Update temperature, energy
+      !-------------------------------------------
+      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow)
+      DO jk = 1, nlay_s
+         DO ji = kideb,kiut
+            rswitch       = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) )
+            q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *           &
+              &            ( ( zdh_s_pre(ji)               ) * zqprec(ji) +  &
+              &              ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
+         END DO
+      END DO
+
+      !--------------------------
+      ! 3.4 Surface ice ablation 
+      !--------------------------
+      zdeltah(:,:) = 0._wp ! important
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K]
+            
+            IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
+
+               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]       
+               zdE            = 0._wp                                 ! Specific enthalpy difference   (J/kg, <0)
+                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted)
+               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing     
+                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this
+               zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0
+                         
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+
+               ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
+               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+               
+               ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+            ELSE                                !!! Surface melting
+               
+               zEi            = - q_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]
+               zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
+               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
+               
+               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0]
+               
+               zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0]
+               
+               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
+               
+               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
+               
+               dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt
+               
+               zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0]
+               
+               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
+               
+               ! Contribution to salt flux >0 (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+               
+               ! Contribution to heat flux [W.m-2], < 0
+               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+               
+               ! Total heat flux used in this process [W.m-2], > 0  
+               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+               
+               ! Contribution to mass flux
+               wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+               
+            END IF
+            ! ----------------------
+            ! Sublimation part2: ice
+            ! ----------------------
+            zdum      = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic )
+            zdeltah(ji,jk) = zdeltah(ji,jk) + zdum
+            dh_i_sub(ji)  = dh_i_sub(ji) + zdum
+            ! Salt flux > 0 (clem2016: flux is sent to the ocean for simplicity but salt should remain in the ice except if all ice is melted.
+            !                          It must be corrected at some point)
+            sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * sm_i_1d(ji) * r1_rdtice
+            ! Heat flux [W.m-2], < 0
+            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * q_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice
+            ! Mass flux > 0
+            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice
+            ! update remaining mass flux
+            zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoic
+            
+            ! record which layers have disappeared (for bottom melting) 
+            !    => icount=0 : no layer has vanished
+            !    => icount=5 : 5 layers have vanished
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
+            icount(ji,jk) = NINT( rswitch )
+            zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
+                        
+            ! update heat content (J.m-2) and layer thickness
+            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
+            h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
+         END DO
+      END DO
+      ! update ice thickness
+      DO ji = kideb, kiut
+         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) )
+      END DO
+
+      ! remaining "potential" evap is sent to ocean
+      DO ji = kideb, kiut
+         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
+         wfx_err_sub(ii,ij) = wfx_err_sub(ii,ij) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
+      END DO
+
+      !
+      !------------------------------------------------------------------------------!
+      ! 4) Basal growth / melt                                                       !
+      !------------------------------------------------------------------------------!
+      !
+      !------------------
+      ! 4.1 Basal growth 
+      !------------------
+      ! Basal growth is driven by heat imbalance at the ice-ocean interface,
+      ! between the inner conductive flux  (fc_bo_i), from the open water heat flux 
+      ! (fhld) and the turbulent ocean flux (fhtur). 
+      ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice 
+
+      ! If salinity varies in time, an iterative procedure is required, because
+      ! the involved quantities are inter-dependent.
+      ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi),
+      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott)
+      ! -> need for an iterative procedure, which converges quickly
+
+      num_iter_max = 1
+      IF( nn_icesal == 2 ) num_iter_max = 5
+
+      ! Iterative procedure
+      DO iter = 1, num_iter_max
+         DO ji = kideb, kiut
+            IF(  zf_tt(ji) < 0._wp  ) THEN
+
+               ! New bottom ice salinity (Cox & Weeks, JGR88 )
+               !--- zswi1  if dh/dt < 2.0e-8
+               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 
+               !--- zswi2  if dh/dt > 3.6e-7
+               zgrr               = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) )
+               zswi2              = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) )
+               zswi12             = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 )
+               zswi1              = 1. - zswi2 * zswi12
+               zfracs             = MIN ( zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   &
+                  &               + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 )
+
+               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
+
+               s_i_new(ji)        = zswitch_sal * zfracs * sss_m(ii,ij)  &  ! New ice salinity
+                                  + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
+               ! New ice growth
+               ztmelts            = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
+
+               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
+               
+               zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
+                  &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
+                  &               + rcp  * ( ztmelts-rt0 )          
+
+               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
+
+               zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
+
+               dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) )
+
+               q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0)
+               
+            ENDIF
+         END DO
+      END DO
+
+      ! Contribution to Energy and Salt Fluxes
+      DO ji = kideb, kiut
+         IF(  zf_tt(ji) < 0._wp  ) THEN
+            ! New ice growth
+                                    
+            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0)
+
+            ztmelts        = - tmut * s_i_new(ji) + rt0          ! New ice melting point (K)
+            
+            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
+            
+            zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
+               &               - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) )   &
+               &               + rcp  * ( ztmelts-rt0 )          
+            
+            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
+            
+            zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
+            
+            ! Contribution to heat flux to the ocean [W.m-2], >0  
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+
+            ! Total heat flux used in this process [W.m-2], <0  
+            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+            
+            ! Contribution to salt flux, <0
+            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice
+
+            ! Contribution to mass flux, <0
+            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice
+
+            ! update heat content (J.m-2) and layer thickness
+            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_1d(ji,nlay_i+1)
+            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji)
+         ENDIF
+      END DO
+
+      !----------------
+      ! 4.2 Basal melt
+      !----------------
+      zdeltah(:,:) = 0._wp ! important
+      DO jk = nlay_i, 1, -1
+         DO ji = kideb, kiut
+            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
+
+               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K)
+
+               IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
+
+                  zEi               = - q_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0)
+                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
+                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted)
+                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing     
+                                                                    ! this should normally not happen, but sometimes, heat diffusion leads to this
+
+                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk)
+
+                  zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0
+
+                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
+                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+
+                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+                                    
+                  ! Contribution to mass flux
+                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+                  ! update heat content (J.m-2) and layer thickness
+                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
+                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
+
+               ELSE                               !!! Basal melting
+
+                  zEi             = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
+                  zEw             = rcp * ( ztmelts - rt0 )    ! Specific enthalpy of meltwater (J/kg, <0)
+                  zdE             = zEi - zEw                  ! Specific enthalpy difference   (J/kg, <0)
+
+                  zfmdt           = - zq_bo(ji) / zdE          ! Mass flux x time step (kg/m2, >0)
+
+                  zdeltah(ji,jk)  = - zfmdt * r1_rhoic         ! Gross thickness change
+
+                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
+                  
+                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
+
+                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt
+
+                  zfmdt           = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0
+
+                  zQm             = zfmdt * zEw         ! Heat exchanged with ocean
+
+                  ! Contribution to heat flux to the ocean [W.m-2], <0  
+                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+
+                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+                  
+                  ! Total heat flux used in this process [W.m-2], >0  
+                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+                  
+                  ! Contribution to mass flux
+                  wfx_bom_1d(ji)  =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+                  ! update heat content (J.m-2) and layer thickness
+                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
+                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
+               ENDIF
+           
+            ENDIF
+         END DO
+      END DO
+
+      !-------------------------------------------
+      ! Update temperature, energy
+      !-------------------------------------------
+      DO ji = kideb, kiut
+         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) )
+      END DO  
+
+      !-------------------------------------------
+      ! 5. What to do with remaining energy
+      !-------------------------------------------
+      ! If heat still available for melting and snow remains, then melt more snow
+      !-------------------------------------------
+      zdeltah(:,:) = 0._wp ! important
+      DO ji = kideb, kiut
+         zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
+         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
+         rswitch         = rswitch * MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,1) - epsi20 ) )
+         zdeltah  (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 )
+         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
+         dh_s_tot (ji)   = dh_s_tot(ji)  + zdeltah(ji,1)
+         ht_s_1d   (ji)  = ht_s_1d(ji)   + zdeltah(ji,1)
+        
+         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * q_s_1d(ji,1)                ! update available heat (J.m-2)
+         ! heat used to melt snow
+         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0)
+         ! Contribution to mass flux
+         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+         !    
+         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
+         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
+         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
+
+         IF( ln_limctl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
+      END DO
+      
+      !
+      !------------------------------------------------------------------------------|
+      !  6) Snow-Ice formation                                                       |
+      !------------------------------------------------------------------------------|
+      ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level, 
+      ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice
+      DO ji = kideb, kiut
+         !
+         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  )
+
+         ht_i_1d(ji)    = ht_i_1d(ji) + dh_snowice(ji)
+         ht_s_1d(ji)    = ht_s_1d(ji) - dh_snowice(ji)
+
+         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0)
+         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
+         zfmdt          = ( rhosn - rhoic ) * dh_snowice(ji)    ! <0
+         zsstK          = sst_m(ii,ij) + rt0                                
+         zEw            = rcp * ( zsstK - rt0 )
+         zQm            = zfmdt * zEw 
+         
+         ! Contribution to heat flux
+         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
+
+         ! Contribution to salt flux
+         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 
+
+         ! virtual salt flux to keep salinity constant
+         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
+            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m     into the ocean
+               &                            - sm_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  rn_icesal from the ocean 
+         ENDIF
+
+         ! Contribution to mass flux
+         ! All snow is thrown in the ocean, and seawater is taken to replace the volume
+         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice
+         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice
+
+         ! update heat content (J.m-2) and layer thickness
+         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_1d(ji,1) + zfmdt * zEw
+         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
+         
+      END DO
+
+      !
+      !-------------------------------------------
+      ! Update temperature, energy
+      !-------------------------------------------
+      DO ji = kideb, kiut
+         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
+         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0
+      END DO
+
+      DO jk = 1, nlay_s
+         DO ji = kideb,kiut
+            ! mask enthalpy
+            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
+            q_s_1d(ji,jk) = rswitch * q_s_1d(ji,jk)
+            ! recalculate t_s_1d from q_s_1d
+            t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
+         END DO
+      END DO
+
+      ! --- ensure that a_i = 0 where ht_i = 0 ---
+      WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp
+      
+      CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema )
+      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i )
+      CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
+      CALL wrk_dealloc( jpij, nlay_i, icount )
+      !
+      !
+   END SUBROUTINE lim_thd_dh
+
+
+   !!--------------------------------------------------------------------------
+   !! INTERFACE lim_thd_snwblow
+   !! ** Purpose :   Compute distribution of precip over the ice
+   !!--------------------------------------------------------------------------
+   SUBROUTINE lim_thd_snwblow_2d( pin, pout )
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( pfrld or (1. - a_i_b) )
+      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_betas )
+   END SUBROUTINE lim_thd_snwblow_2d
+
+   SUBROUTINE lim_thd_snwblow_1d( pin, pout )
+      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin
+      REAL(wp), DIMENSION(:), INTENT(inout) :: pout
+      pout = ( 1._wp - ( pin )**rn_betas )
+   END SUBROUTINE lim_thd_snwblow_1d
+
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                               NO  LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_dh          ! Empty routine
+   END SUBROUTINE lim_thd_dh
+#endif
+
+   !!======================================================================
+END MODULE limthd_dh
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 8732)
@@ -0,0 +1,846 @@
+MODULE limthd_dif
+   !!======================================================================
+   !!                       ***  MODULE limthd_dif ***
+   !!                       heat diffusion in sea ice 
+   !!                   computation of surface and inner T  
+   !!======================================================================
+   !! History :  LIM  ! 02-2003 (M. Vancoppenolle) original 1D code
+   !!                 ! 06-2005 (M. Vancoppenolle) 3d version
+   !!                 ! 11-2006 (X Fettweis) Vectorization by Xavier
+   !!                 ! 04-2007 (M. Vancoppenolle) Energy conservation
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE phycst         ! physical constants (ocean directory) 
+   USE ice            ! LIM-3 variables
+   USE thd_ice        ! LIM-3: thermodynamics
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_dif   ! called by lim_thd
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_dif( kideb , kiut )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd_dif  ***
+      !! ** Purpose :
+      !!           This routine determines the time evolution of snow and sea-ice 
+      !!           temperature profiles.
+      !! ** Method  :
+      !!           This is done by solving the heat equation diffusion with
+      !!           a Neumann boundary condition at the surface and a Dirichlet one
+      !!           at the bottom. Solar radiation is partially absorbed into the ice.
+      !!           The specific heat and thermal conductivities depend on ice salinity
+      !!           and temperature to take into account brine pocket melting. The 
+      !!           numerical
+      !!           scheme is an iterative Crank-Nicolson on a non-uniform multilayer grid 
+      !!           in the ice and snow system.
+      !!
+      !!           The successive steps of this routine are
+      !!           1.  Thermal conductivity at the interfaces of the ice layers
+      !!           2.  Internal absorbed radiation
+      !!           3.  Scale factors due to non-uniform grid
+      !!           4.  Kappa factors
+      !!           Then iterative procedure begins
+      !!           5.  specific heat in the ice
+      !!           6.  eta factors
+      !!           7.  surface flux computation
+      !!           8.  tridiagonal system terms
+      !!           9.  solving the tridiagonal system with Gauss elimination
+      !!           Iterative procedure ends according to a criterion on evolution
+      !!           of temperature
+      !!
+      !! ** Arguments :
+      !!           kideb , kiut : Starting and ending points on which the 
+      !!                         the computation is applied
+      !!
+      !! ** Inputs / Ouputs : (global commons)
+      !!           surface temperature : t_su_1d
+      !!           ice/snow temperatures   : t_i_1d, t_s_1d
+      !!           ice salinities          : s_i_1d
+      !!           number of layers in the ice/snow: nlay_i, nlay_s
+      !!           profile of the ice/snow layers : z_i, z_s
+      !!           total ice/snow thickness : ht_i_1d, ht_s_1d
+      !!
+      !! ** External : 
+      !!
+      !! ** References :
+      !!
+      !! ** History :
+      !!           (02-2003) Martin Vancoppenolle, Louvain-la-Neuve, Belgium
+      !!           (06-2005) Martin Vancoppenolle, 3d version
+      !!           (11-2006) Vectorized by Xavier Fettweis (UCL-ASTR)
+      !!           (04-2007) Energy conservation tested by M. Vancoppenolle
+      !!------------------------------------------------------------------
+      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
+
+      !! * Local variables
+      INTEGER ::   ji          ! spatial loop index
+      INTEGER ::   ii, ij      ! temporary dummy loop index
+      INTEGER ::   numeq       ! current reference number of equation
+      INTEGER ::   jk       ! vertical dummy loop index 
+      INTEGER ::   nconv       ! number of iterations in iterative procedure
+      INTEGER ::   minnumeqmin, maxnumeqmax
+      
+      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation
+      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation
+      
+      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system
+      REAL(wp) ::   zg1       =  2._wp        !
+      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat
+      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13)
+      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow
+      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity
+      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C 
+      REAL(wp) ::   ztmelt_i    ! ice melting temperature
+      REAL(wp) ::   zerritmax   ! current maximal error on temperature 
+      REAL(wp) ::   zhsu
+      
+      REAL(wp), POINTER, DIMENSION(:)     ::   isnow       ! switch for presence (1) or absence (0) of snow
+      REAL(wp), POINTER, DIMENSION(:)     ::   ztsub       ! old surface temperature (before the iterative procedure )
+      REAL(wp), POINTER, DIMENSION(:)     ::   ztsubit     ! surface temperature at previous iteration
+      REAL(wp), POINTER, DIMENSION(:)     ::   zh_i        ! ice layer thickness
+      REAL(wp), POINTER, DIMENSION(:)     ::   zh_s        ! snow layer thickness
+      REAL(wp), POINTER, DIMENSION(:)     ::   zfsw        ! solar radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:)     ::   zqns_ice_b  ! solar radiation absorbed at the surface
+      REAL(wp), POINTER, DIMENSION(:)     ::   zf          ! surface flux function
+      REAL(wp), POINTER, DIMENSION(:)     ::   dzf         ! derivative of the surface flux function
+      REAL(wp), POINTER, DIMENSION(:)     ::   zerrit      ! current error on temperature
+      REAL(wp), POINTER, DIMENSION(:)     ::   zdifcase    ! case of the equation resolution (1->4)
+      REAL(wp), POINTER, DIMENSION(:)     ::   zftrice     ! solar radiation transmitted through the ice
+      REAL(wp), POINTER, DIMENSION(:)     ::   zihic
+      
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztcond_i    ! Ice thermal conductivity
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_i    ! Radiation transmitted through the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_i    ! Radiation absorbed in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_i    ! Kappa factor in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztib        ! Old temperature in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_i      ! Eta factor in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztitemp     ! Temporary temperature in the ice to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zspeche_i   ! Ice specific heat
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_i         ! Vertical cotes of the layers in the ice
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradtr_s    ! Radiation transmited through the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zradab_s    ! Radiation absorbed in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkappa_s    ! Kappa factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeta_s      ! Eta factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztstemp     ! Temporary temperature in the snow to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   ztsb        ! Temporary temperature in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z_s         ! Vertical cotes of the layers in the snow
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindterm    ! 'Ind'ependent term
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zindtbis    ! Temporary 'ind'ependent term
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdiagbis    ! Temporary 'dia'gonal term
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid       ! Tridiagonal system terms
+      
+      ! diag errors on heat
+      REAL(wp), POINTER, DIMENSION(:)     :: zdq, zq_ini, zhfx_err
+      
+      ! Mono-category
+      REAL(wp)                            :: zepsilon      ! determines thres. above which computation of G(h) is done
+      REAL(wp)                            :: zratio_s      ! dummy factor
+      REAL(wp)                            :: zratio_i      ! dummy factor
+      REAL(wp)                            :: zh_thres      ! thickness thres. for G(h) computation
+      REAL(wp)                            :: zhe           ! dummy factor
+      REAL(wp)                            :: zkimean       ! mean sea ice thermal conductivity
+      REAL(wp)                            :: zfac          ! dummy factor
+      REAL(wp)                            :: zihe          ! dummy factor
+      REAL(wp)                            :: zheshth       ! dummy factor
+      
+      REAL(wp), POINTER, DIMENSION(:)     :: zghe          ! G(he), th. conduct enhancement factor, mono-cat
+      
+      !!------------------------------------------------------------------     
+      ! 
+      CALL wrk_alloc( jpij, numeqmin, numeqmax )
+      CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+      CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
+      CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis  )
+      CALL wrk_alloc( jpij,nlay_i+3,3, ztrid )
+
+      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )
+
+      ! --- diag error on heat diffusion - PART 1 --- !
+      zdq(:) = 0._wp ; zq_ini(:) = 0._wp      
+      DO ji = kideb, kiut
+         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
+            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! 1) Initialization                                                            !
+      !------------------------------------------------------------------------------!
+      DO ji = kideb , kiut
+         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ! is there snow or not
+         ! layer thickness
+         zh_i(ji) = ht_i_1d(ji) * r1_nlay_i
+         zh_s(ji) = ht_s_1d(ji) * r1_nlay_s
+      END DO
+
+      !--------------------
+      ! Ice / snow layers
+      !--------------------
+
+      z_s(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st snow layer
+      z_i(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st ice layer
+
+      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
+         DO ji = kideb , kiut
+            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s
+         END DO
+      END DO
+
+      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
+         DO ji = kideb , kiut
+            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i
+         END DO
+      END DO
+      !
+      !------------------------------------------------------------------------------|
+      ! 2) Radiation								                                 |
+      !------------------------------------------------------------------------------|
+      !
+      !-------------------
+      ! Computation of i0
+      !-------------------
+      ! i0 describes the fraction of solar radiation which does not contribute
+      ! to the surface energy budget but rather penetrates inside the ice.
+      ! We assume that no radiation is transmitted through the snow
+      ! If there is no no snow
+      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface 
+      ! zftrice = io.qsr_ice       is below the surface 
+      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 
+      ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover
+      zhsu = 0.1_wp ! threshold for the computation of i0
+      DO ji = kideb , kiut
+         ! switches
+         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
+         ! hs > 0, isnow = 1
+         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) )     
+
+         i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
+      END DO
+
+      !-------------------------------------------------------
+      ! Solar radiation absorbed / transmitted at the surface
+      ! Derivative of the non solar flux
+      !-------------------------------------------------------
+      DO ji = kideb , kiut
+         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface
+         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer
+         dzf    (ji)    = dqns_ice_1d(ji)                    ! derivative of incoming nonsolar flux 
+         zqns_ice_b(ji) = qns_ice_1d(ji)                     ! store previous qns_ice_1d value
+      END DO
+
+      !---------------------------------------------------------
+      ! Transmission - absorption of solar radiation in the ice
+      !---------------------------------------------------------
+
+      DO ji = kideb, kiut           ! snow initialization
+         zradtr_s(ji,0) = zftrice(ji)     ! radiation penetrating through snow
+      END DO
+
+      DO jk = 1, nlay_s          ! Radiation through snow
+         DO ji = kideb, kiut
+            !                             ! radiation transmitted below the layer-th snow layer
+            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) )
+            !                             ! radiation absorbed by the layer-th snow layer
+            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk)
+         END DO
+      END DO
+
+      DO ji = kideb, kiut           ! ice initialization
+         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) )
+      END DO
+
+      DO jk = 1, nlay_i          ! Radiation through ice
+         DO ji = kideb, kiut
+            !                             ! radiation transmitted below the layer-th ice layer
+            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
+            !                             ! radiation absorbed by the layer-th ice layer
+            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
+         END DO
+      END DO
+
+      DO ji = kideb, kiut           ! Radiation transmitted below the ice
+         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 
+      END DO
+
+      !------------------------------------------------------------------------------|
+      !  3) Iterative procedure begins                                               |
+      !------------------------------------------------------------------------------|
+      !
+      DO ji = kideb, kiut        ! Old surface temperature
+         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr.
+         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter
+         t_su_1d(ji) =  MIN( t_su_1d(ji), rt0 - ztsu_err )       ! necessary
+         zerrit (ji) =  1000._wp                                 ! initial value of error
+      END DO
+
+      DO jk = 1, nlay_s       ! Old snow temperature
+         DO ji = kideb , kiut
+            ztsb(ji,jk) =  t_s_1d(ji,jk)
+         END DO
+      END DO
+
+      DO jk = 1, nlay_i       ! Old ice temperature
+         DO ji = kideb , kiut
+            ztib(ji,jk) =  t_i_1d(ji,jk)
+         END DO
+      END DO
+
+      nconv     =  0           ! number of iterations
+      zerritmax =  1000._wp    ! maximal value of error on all points
+
+      DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif )
+         !
+         nconv = nconv + 1
+         !
+         !------------------------------------------------------------------------------|
+         ! 4) Sea ice thermal conductivity                                              |
+         !------------------------------------------------------------------------------|
+         !
+         IF( nn_ice_thcon == 0 ) THEN      ! Untersteiner (1964) formula
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )
+               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
+            END DO
+            DO jk = 1, nlay_i-1
+               DO ji = kideb , kiut
+                  ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
+                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0)
+                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
+               END DO
+            END DO
+         ENDIF
+
+         IF( nn_ice_thcon == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )   &
+                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rt0 )  
+               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
+            END DO
+            DO jk = 1, nlay_i-1
+               DO ji = kideb , kiut
+                  ztcond_i(ji,jk) = rcdic +                                                                       & 
+                     &                 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                              &
+                     &                 / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 )   &
+                     &               - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 )  
+                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
+               END DO
+            END DO
+            DO ji = kideb , kiut
+               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )   &
+                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )  
+               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
+            END DO
+         ENDIF
+         
+         !
+         !------------------------------------------------------------------------------|
+         !  5) G(he) - enhancement of thermal conductivity in mono-category case        |
+         !------------------------------------------------------------------------------|
+         !
+         ! Computation of effective thermal conductivity G(h)
+         ! Used in mono-category case only to simulate an ITD implicitly
+         ! Fichefet and Morales Maqueda, JGR 1997
+
+         zghe(:) = 1._wp
+
+         SELECT CASE ( nn_monocat )
+
+         CASE (1,3) ! LIM3
+
+            zepsilon = 0.1_wp
+            zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp
+
+            DO ji = kideb, kiut
+   
+               ! Mean sea ice thermal conductivity
+               zkimean  = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp )
+
+               ! Effective thickness he (zhe)
+               zfac     = 1._wp / ( rn_cdsn + zkimean )
+               zratio_s = rn_cdsn   * zfac
+               zratio_i = zkimean * zfac
+               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji)
+
+               ! G(he)
+               rswitch  = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) )  ! =0 if zhe < zh_thres, if >
+               zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) )
+   
+               ! Impose G(he) < 2.
+               zghe(ji) = MIN( zghe(ji), 2._wp )
+
+            END DO
+
+         END SELECT
+
+         !
+         !------------------------------------------------------------------------------|
+         !  6) kappa factors                                                            |
+         !------------------------------------------------------------------------------|
+         !
+         !--- Snow
+         DO ji = kideb, kiut
+            zfac                  =  1. / MAX( epsi10 , zh_s(ji) )
+            zkappa_s(ji,0)        = zghe(ji) * rn_cdsn * zfac
+            zkappa_s(ji,nlay_s)   = zghe(ji) * rn_cdsn * zfac
+         END DO
+
+         DO jk = 1, nlay_s-1
+            DO ji = kideb , kiut
+               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rn_cdsn / MAX( epsi10, 2.0 * zh_s(ji) )
+            END DO
+         END DO
+
+         !--- Ice
+         DO jk = 1, nlay_i-1
+            DO ji = kideb , kiut
+               zkappa_i(ji,jk)    = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) )
+            END DO
+         END DO
+
+         !--- Snow-ice interface
+         DO ji = kideb , kiut
+            zfac                  = 1./ MAX( epsi10 , zh_i(ji) )
+            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac
+            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac
+            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rn_cdsn * ztcond_i(ji,0) / & 
+           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rn_cdsn * zh_i(ji) ) )
+            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) )
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 7) Sea ice specific heat, eta factors                                        |
+         !------------------------------------------------------------------------------|
+         !
+         DO jk = 1, nlay_i
+            DO ji = kideb , kiut
+               ztitemp(ji,jk)   = t_i_1d(ji,jk)
+               zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 )
+               zeta_i(ji,jk)    = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 )
+            END DO
+         END DO
+
+         DO jk = 1, nlay_s
+            DO ji = kideb , kiut
+               ztstemp(ji,jk) = t_s_1d(ji,jk)
+               zeta_s(ji,jk)  = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 )
+            END DO
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 8) surface flux computation                                                  |
+         !------------------------------------------------------------------------------|
+         !
+         IF ( ln_it_qnsice ) THEN 
+            DO ji = kideb , kiut
+               ! update of the non solar flux according to the update in T_su
+               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) )
+            END DO
+         ENDIF
+
+         ! Update incoming flux
+         DO ji = kideb , kiut
+            ! update incoming flux
+            zf(ji)    =          zfsw(ji)              & ! net absorbed solar radiation
+               &         + qns_ice_1d(ji)                ! non solar total flux (LWup, LWdw, SH, LH)
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 9) tridiagonal system terms                                                  |
+         !------------------------------------------------------------------------------|
+         !
+         !!layer denotes the number of the layer in the snow or in the ice
+         !!numeq denotes the reference number of the equation in the tridiagonal
+         !!system, terms of tridiagonal system are indexed as following :
+         !!1 is subdiagonal term, 2 is diagonal and 3 is superdiagonal one
+
+         !!ice interior terms (top equation has the same form as the others)
+
+         DO numeq=1,nlay_i+3
+            DO ji = kideb , kiut
+               ztrid(ji,numeq,1) = 0.
+               ztrid(ji,numeq,2) = 0.
+               ztrid(ji,numeq,3) = 0.
+               zindterm(ji,numeq)= 0.
+               zindtbis(ji,numeq)= 0.
+               zdiagbis(ji,numeq)= 0.
+            ENDDO
+         ENDDO
+
+         DO numeq = nlay_s + 2, nlay_s + nlay_i 
+            DO ji = kideb , kiut
+               jk                 = numeq - nlay_s - 1
+               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk-1)
+               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) )
+               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk)
+               zindterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk)
+            END DO
+         ENDDO
+
+         numeq =  nlay_s + nlay_i + 1
+         DO ji = kideb , kiut
+            !!ice bottom term
+            ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)   
+            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) )
+            ztrid(ji,numeq,3)  =  0.0
+            zindterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
+               &                  ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 *  t_bo_1d(ji) ) 
+         ENDDO
+
+
+         DO ji = kideb , kiut
+            IF ( ht_s_1d(ji) > 0.0 ) THEN
+               !
+               !------------------------------------------------------------------------------|
+               !  snow-covered cells                                                          |
+               !------------------------------------------------------------------------------|
+               !
+               !!snow interior terms (bottom equation has the same form as the others)
+               DO numeq = 3, nlay_s + 1
+                  jk                  =  numeq - 1
+                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk) * zkappa_s(ji,jk-1)
+                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) )
+                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk)
+                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
+               END DO
+
+               !!case of only one layer in the ice (ice equation is altered)
+               IF ( nlay_i.eq.1 ) THEN
+                  ztrid(ji,nlay_s+2,3)    =  0.0
+                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji) 
+               ENDIF
+
+               IF ( t_su_1d(ji) < rt0 ) THEN
+
+                  !------------------------------------------------------------------------------|
+                  !  case 1 : no surface melting - snow present                                  |
+                  !------------------------------------------------------------------------------|
+                  zdifcase(ji)    =  1.0
+                  numeqmin(ji)    =  1
+                  numeqmax(ji)    =  nlay_i + nlay_s + 1
+
+                  !!surface equation
+                  ztrid(ji,1,1)  = 0.0
+                  ztrid(ji,1,2)  = dzf(ji) - zg1s * zkappa_s(ji,0)
+                  ztrid(ji,1,3)  = zg1s * zkappa_s(ji,0)
+                  zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji)
+
+                  !!first layer of snow equation
+                  ztrid(ji,2,1)  =  - zkappa_s(ji,0) * zg1s * zeta_s(ji,1)
+                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
+                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1)
+                  zindterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1)
+
+               ELSE 
+                  !
+                  !------------------------------------------------------------------------------|
+                  !  case 2 : surface is melting - snow present                                  |
+                  !------------------------------------------------------------------------------|
+                  !
+                  zdifcase(ji)    =  2.0
+                  numeqmin(ji)    =  2
+                  numeqmax(ji)    =  nlay_i + nlay_s + 1
+
+                  !!first layer of snow equation
+                  ztrid(ji,2,1)  =  0.0
+                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
+                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1) 
+                  zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *  &
+                     &             ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
+               ENDIF
+            ELSE
+               !
+               !------------------------------------------------------------------------------|
+               !  cells without snow                                                          |
+               !------------------------------------------------------------------------------|
+               !
+               IF ( t_su_1d(ji) < rt0 ) THEN
+                  !
+                  !------------------------------------------------------------------------------|
+                  !  case 3 : no surface melting - no snow                                       |
+                  !------------------------------------------------------------------------------|
+                  !
+                  zdifcase(ji)      =  3.0
+                  numeqmin(ji)      =  nlay_s + 1
+                  numeqmax(ji)      =  nlay_i + nlay_s + 1
+
+                  !!surface equation	
+                  ztrid(ji,numeqmin(ji),1)   =  0.0
+                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1    
+                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1
+                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
+
+                  !!first layer of ice equation
+                  ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1)
+                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
+                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1) * zkappa_i(ji,1)  
+                  zindterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)  
+
+                  !!case of only one layer in the ice (surface & ice equations are altered)
+
+                  IF ( nlay_i == 1 ) THEN
+                     ztrid(ji,numeqmin(ji),1)    =  0.0
+                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0) * 2.0
+                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0) * 2.0
+                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1)
+                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
+                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0
+
+                     zindterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1) *  &
+                        &                          ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )
+                  ENDIF
+
+               ELSE
+
+                  !
+                  !------------------------------------------------------------------------------|
+                  ! case 4 : surface is melting - no snow                                        |
+                  !------------------------------------------------------------------------------|
+                  !
+                  zdifcase(ji)    =  4.0
+                  numeqmin(ji)    =  nlay_s + 2
+                  numeqmax(ji)    =  nlay_i + nlay_s + 1
+
+                  !!first layer of ice equation
+                  ztrid(ji,numeqmin(ji),1)      =  0.0
+                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )  
+                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1)
+                  zindterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1) *  &
+                     &                             ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
+
+                  !!case of only one layer in the ice (surface & ice equations are altered)
+                  IF ( nlay_i == 1 ) THEN
+                     ztrid(ji,numeqmin(ji),1)  =  0.0
+                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
+                     ztrid(ji,numeqmin(ji),3)  =  0.0
+                     zindterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )  &
+                        &                       + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0
+                  ENDIF
+
+               ENDIF
+            ENDIF
+
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 10) tridiagonal system solving                                               |
+         !------------------------------------------------------------------------------|
+         !
+
+         ! Solve the tridiagonal system with Gauss elimination method.
+         ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, 
+         ! McGraw-Hill 1984.	
+
+         maxnumeqmax = 0
+         minnumeqmin = nlay_i+5
+
+         DO ji = kideb , kiut
+            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji))
+            zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2)
+            minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin)
+            maxnumeqmax               =  MAX(numeqmax(ji),maxnumeqmax)
+         END DO
+
+         DO jk = minnumeqmin+1, maxnumeqmax
+            DO ji = kideb , kiut
+               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji))
+               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2)  - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3)  / zdiagbis(ji,numeq-1)
+               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1)
+            END DO
+         END DO
+
+         DO ji = kideb , kiut
+            ! ice temperatures
+            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji))
+         END DO
+
+         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1
+            DO ji = kideb , kiut
+               jk    =  numeq - nlay_s - 1
+               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq)
+            END DO
+         END DO
+
+         DO ji = kideb , kiut
+            ! snow temperatures      
+            IF (ht_s_1d(ji) > 0._wp) &
+               t_s_1d(ji,nlay_s)     =  ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) )  &
+               &                        / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) ) 
+
+            ! surface temperature
+            isnow(ji)   = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) )
+            ztsubit(ji) = t_su_1d(ji)
+            IF( t_su_1d(ji) < rt0 ) &
+               t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) *  &
+               &             ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
+         END DO
+         !
+         !--------------------------------------------------------------------------
+         !  11) Has the scheme converged ?, end of the iterative procedure         |
+         !--------------------------------------------------------------------------
+         !
+         ! check that nowhere it has started to melt
+         ! zerrit(ji) is a measure of error, it has to be under terr_dif
+         DO ji = kideb , kiut
+            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , rt0 ) , 190._wp  )
+            zerrit(ji)  =  ABS( t_su_1d(ji) - ztsubit(ji) )     
+         END DO
+
+         DO jk  =  1, nlay_s
+            DO ji = kideb , kiut
+               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rt0 ), 190._wp  )
+               zerrit(ji)    = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) )
+            END DO
+         END DO
+
+         DO jk  =  1, nlay_i
+            DO ji = kideb , kiut
+               ztmelt_i      = -tmut * s_i_1d(ji,jk) + rt0 
+               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp )
+               zerrit(ji)    =  MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) )
+            END DO
+         END DO
+
+         ! Compute spatial maximum over all errors
+         ! note that this could be optimized substantially by iterating only the non-converging points
+         zerritmax = 0._wp
+         DO ji = kideb, kiut
+            zerritmax = MAX( zerritmax, zerrit(ji) )   
+         END DO
+         IF( lk_mpp ) CALL mpp_max( zerritmax, kcom=ncomm_ice )
+
+      END DO  ! End of the do while iterative procedure
+
+      IF( ln_limctl .AND. lwp ) THEN
+         WRITE(numout,*) ' zerritmax : ', zerritmax
+         WRITE(numout,*) ' nconv     : ', nconv
+      ENDIF
+
+      !
+      !-------------------------------------------------------------------------!
+      !   12) Fluxes at the interfaces                                          !
+      !-------------------------------------------------------------------------!
+      DO ji = kideb, kiut
+         !                                ! surface ice conduction flux
+         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )
+         fc_su(ji)       =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
+            &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji))
+         !                                ! bottom ice conduction flux
+         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
+      END DO
+
+      ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
+      CALL lim_thd_enmelt( kideb, kiut )
+
+      ! --- diagnose the change in non-solar flux due to surface temperature change --- !
+      IF ( ln_it_qnsice ) THEN
+         DO ji = kideb, kiut
+            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji) 
+         END DO
+      END IF
+
+      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
+      DO ji = kideb, kiut
+         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  &
+            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
+            zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
+         ELSE                          ! case T_su = 0degC
+            zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice 
+         ENDIF
+         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+
+         ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation)
+         hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+      END DO 
+
+      !-----------------------------------------
+      ! Heat flux used to warm/cool ice in W.m-2
+      !-----------------------------------------
+      DO ji = kideb, kiut
+         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
+            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   &
+               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
+         ELSE                          ! case T_su = 0degC
+            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    &
+               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
+         ENDIF
+         ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
+         hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji)
+      END DO   
+      !
+      CALL wrk_dealloc( jpij, numeqmin, numeqmax )
+      CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+      CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+      CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
+      CALL wrk_dealloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
+      CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )
+      CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )
+      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )
+
+   END SUBROUTINE lim_thd_dif
+
+   SUBROUTINE lim_thd_enmelt( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_enmelt *** 
+      !!                 
+      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature
+      !!
+      !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
+      !
+      INTEGER  ::   ji, jk   ! dummy loop indices
+      REAL(wp) ::   ztmelts  ! local scalar 
+      !!-------------------------------------------------------------------
+      !
+      DO jk = 1, nlay_i             ! Sea ice energy of melting
+         DO ji = kideb, kiut
+            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0
+            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point
+                                                          !   (sometimes dif scheme produces abnormally high temperatures)   
+            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                           &
+               &                    + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) )   &
+               &                    - rcp  *         ( ztmelts-rt0 )  ) 
+         END DO
+      END DO
+      DO jk = 1, nlay_s             ! Snow energy of melting
+         DO ji = kideb, kiut
+            q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_thd_enmelt
+
+#else
+   !!----------------------------------------------------------------------
+   !!                   Dummy Module                 No LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_dif          ! Empty routine
+   END SUBROUTINE lim_thd_dif
+#endif
+   !!======================================================================
+END MODULE limthd_dif
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 8732)
@@ -0,0 +1,164 @@
+MODULE limthd_ent
+   !!======================================================================
+   !!                       ***  MODULE limthd_ent   ***
+   !!                  Redistribution of Enthalpy in the ice
+   !!                        on the new vertical grid
+   !!                       after vertical growth/decay
+   !!======================================================================
+   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D
+   !!                 ! 2005-07 (M. Vancoppenolle) 3D version 
+   !!                 ! 2006-11 (X. Fettweis) Vectorized 
+   !!            3.0  ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!             -   ! 2014-05 (C. Rousset) complete rewriting
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd_ent   : ice redistribution of enthalpy
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE dom_oce        ! domain variables
+   USE domain         !
+   USE phycst         ! physical constants
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE ice            ! LIM variables
+   USE thd_ice        ! LIM thermodynamics
+   USE limvar         ! LIM variables
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_ent         ! called by limthd and limthd_lac
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+   SUBROUTINE lim_thd_ent( kideb, kiut, qnew )
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE lim_thd_ent  ***
+      !!
+      !! ** Purpose :
+      !!           This routine computes new vertical grids in the ice, 
+      !!           and consistently redistributes temperatures. 
+      !!           Redistribution is made so as to ensure to energy conservation
+      !!
+      !!
+      !! ** Method  : linear conservative remapping
+      !!           
+      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses
+      !!            2) linear remapping on the new layers
+      !!
+      !! ------------ cum0(0)                        ------------- cum1(0)
+      !!                                    NEW      -------------
+      !! ------------ cum0(1)               ==>      -------------
+      !!     ...                                     -------------
+      !! ------------                                -------------
+      !! ------------ cum0(nlay_i+2)                 ------------- cum1(nlay_i)
+      !!
+      !!
+      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005
+      !!-------------------------------------------------------------------
+      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied
+
+      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (J.m-3, remapped)
+
+      INTEGER  :: ji         !  dummy loop indices
+      INTEGER  :: jk0, jk1   !  old/new layer indices
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
+      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces
+      REAL(wp), POINTER, DIMENSION(:)   :: zhnew               ! new layers thicknesses
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
+      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
+      CALL wrk_alloc( jpij, zhnew )
+
+      !--------------------------------------------------------------------------
+      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
+      !--------------------------------------------------------------------------
+      zqh_cum0(:,0:nlay_i+2) = 0._wp 
+      zh_cum0 (:,0:nlay_i+2) = 0._wp
+      DO jk0 = 1, nlay_i+2
+         DO ji = kideb, kiut
+            zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1)
+            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1)
+         ENDDO
+      ENDDO
+
+      !------------------------------------
+      !  2) Interpolation on the new layers
+      !------------------------------------
+      ! new layer thickesses
+      DO ji = kideb, kiut
+         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i  
+      ENDDO
+
+      ! new layers interfaces
+      zh_cum1(:,0:nlay_i) = 0._wp
+      DO jk1 = 1, nlay_i
+         DO ji = kideb, kiut
+            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji)
+         ENDDO
+      ENDDO
+
+      zqh_cum1(:,0:nlay_i) = 0._wp 
+      ! new cumulative q*h => linear interpolation
+      DO jk0 = 1, nlay_i+1
+         DO jk1 = 1, nlay_i-1
+            DO ji = kideb, kiut
+               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN
+                  zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  &
+                     &                 zqh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  &
+                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) )
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+      ! to ensure that total heat content is strictly conserved, set:
+      zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2) 
+
+      ! new enthalpies
+      DO jk1 = 1, nlay_i
+         DO ji = kideb, kiut
+            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
+            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
+         ENDDO
+      ENDDO
+
+      ! --- diag error on heat remapping --- !
+      ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac), 
+      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0
+      DO ji = kideb, kiut
+         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  &
+            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 
+      END DO
+      
+      !
+      CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
+      CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
+      CALL wrk_dealloc( jpij, zhnew )
+      !
+   END SUBROUTINE lim_thd_ent
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                               NO  LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_ent          ! Empty routine
+   END SUBROUTINE lim_thd_ent
+#endif
+
+   !!======================================================================
+END MODULE limthd_ent
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 8732)
@@ -0,0 +1,533 @@
+MODULE limthd_lac
+   !!======================================================================
+   !!                       ***  MODULE limthd_lac   ***
+   !!                lateral thermodynamic growth of the ice 
+   !!======================================================================
+   !! History :  LIM  ! 2005-12 (M. Vancoppenolle)  Original code
+   !!             -   ! 2006-01 (M. Vancoppenolle)  add ITD
+   !!            3.0  ! 2007-07 (M. Vancoppenolle)  Mass and energy conservation tested
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_lat_acr   : lateral accretion of ice
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE dom_oce        ! domain variables
+   USE phycst         ! physical constants
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE thd_ice        ! LIM thermodynamics
+   USE ice            ! LIM variables
+   USE limtab         ! LIM 2D <==> 1D
+   USE limcons        ! LIM conservation
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE limthd_ent
+   USE limvar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_thd_lac     ! called by lim_thd
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_lac
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE lim_thd_lac  ***
+      !!  
+      !! ** Purpose : Computation of the evolution of the ice thickness and 
+      !!      concentration as a function of the heat balance in the leads.
+      !!      It is only used for lateral accretion
+      !!       
+      !! ** Method  : Ice is formed in the open water when ocean lose heat
+      !!      (heat budget of open water Bl is negative) .
+      !!      Computation of the increase of 1-A (ice concentration) fol-
+      !!      lowing the law :
+      !!      (dA/dt)acc = F[ (1-A)/(1-a) ] * [ Bl / (Li*h0) ]
+      !!       where - h0 is the thickness of ice created in the lead
+      !!             - a is a minimum fraction for leads
+      !!             - F is a monotonic non-increasing function defined as:
+      !!                  F(X)=( 1 - X**exld )**(1.0/exld)
+      !!             - exld is the exponent closure rate (=2 default val.)
+      !! 
+      !! ** Action : - Adjustment of snow and ice thicknesses and heat
+      !!                content in brine pockets
+      !!             - Updating ice internal temperature
+      !!             - Computation of variation of ice volume and mass
+      !!             - Computation of frldb after lateral accretion and 
+      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)      
+      !!------------------------------------------------------------------------
+      INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices
+      INTEGER  ::   nbpac            ! local integers 
+      INTEGER  ::   ii, ij, iter     !   -       -
+      REAL(wp) ::   ztmelts, zdv, zfrazb, zweight, zde                          ! local scalars
+      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      -
+      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      -
+      CHARACTER (len = 15) :: fieldid
+
+      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean)
+      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg)
+      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg)
+      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean)
+     
+      REAL(wp) ::   zv_newfra
+  
+      INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows
+      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zv_newice   ! volume of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   za_newice   ! fractional area of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_newice   ! thickness of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   ze_newice   ! heat content of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zs_newice   ! salinity of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zo_newice   ! age of accreted ice
+      REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget
+      REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget
+      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction    
+      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom
+      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector)
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_b      ! old volume of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel     ! relative ice / frazil velocity
+
+      REAL(wp) :: zcai = 1.4e-3_wp                     ! ice-air drag (clem: should be dependent on coupling/forcing used)
+      !!-----------------------------------------------------------------------!
+
+      CALL wrk_alloc( jpij, jcat )   ! integer
+      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
+      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
+      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+      CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )
+      CALL wrk_alloc( jpi,jpj, zvrel )
+
+      CALL lim_var_agg(1)
+      CALL lim_var_glo2eqv
+      !------------------------------------------------------------------------------|
+      ! 2) Convert units for ice internal energy
+      !------------------------------------------------------------------------------|
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !Energy of melting q(S,T) [J.m-3]
+                  rswitch          = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )   !0 if no ice
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! 3) Collection thickness of ice formed in leads and polynyas
+      !------------------------------------------------------------------------------!    
+      ! hicol is the thickness of new ice formed in open water
+      ! hicol can be either prescribed (frazswi = 0) or computed (frazswi = 1)
+      ! Frazil ice forms in open water, is transported by wind
+      ! accumulates at the edge of the consolidated ice edge
+      ! where it forms aggregates of a specific thickness called
+      ! collection thickness.
+
+      ! Note : the following algorithm currently breaks vectorization
+      ! 
+
+      zvrel(:,:) = 0._wp
+
+      ! Default new ice thickness
+      WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice
+      ELSEWHERE                   ; hicol(:,:) = 0._wp
+      END WHERE
+
+      IF( ln_frazil ) THEN
+
+         !--------------------
+         ! Physical constants
+         !--------------------
+         hicol(:,:) = 0._wp
+
+         zhicrit = 0.04 ! frazil ice thickness
+         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
+         zsqcd   = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag)
+         zgamafr = 0.03
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast
+                  !-------------
+                  ! Wind stress
+                  !-------------
+                  ! C-grid wind stress components
+                  ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   &
+                     &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp
+                  ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   &
+                     &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp
+                  ! Square root of wind stress
+                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
+
+                  !---------------------
+                  ! Frazil ice velocity
+                  !---------------------
+                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
+                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
+                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
+
+                  !-------------------
+                  ! Pack ice velocity
+                  !-------------------
+                  ! C-grid ice velocity
+                  zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
+                  zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
+
+                  !-----------------------------------
+                  ! Relative frazil/pack ice velocity
+                  !-----------------------------------
+                  ! absolute relative velocity
+                  rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
+                  zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   &
+                     &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch
+                  zvrel(ji,jj) = SQRT( zvrel2 )
+
+                  !---------------------
+                  ! Iterative procedure
+                  !---------------------
+                  hicol(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    &
+                     &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2
+
+                  iter = 1
+                  DO WHILE ( iter < 20 ) 
+                     zf  = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) -   &
+                        &    hicol(ji,jj) * zhicrit * ztwogp * zvrel2
+                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2
+
+                     hicol(ji,jj) = hicol(ji,jj) - zf / MAX( zfp, epsi20 )
+                     iter = iter + 1
+                  END DO
+
+               ENDIF ! end of selection of pixels where ice forms
+
+            END DO 
+         END DO 
+         ! 
+         CALL lbc_lnk( zvrel, 'T', 1. )
+         CALL lbc_lnk( hicol, 'T', 1. )
+
+      ENDIF ! End of computation of frazil ice collection thickness
+
+      !------------------------------------------------------------------------------!
+      ! 4) Identify grid points where new ice forms
+      !------------------------------------------------------------------------------!
+
+      !-------------------------------------
+      ! Select points for new ice formation
+      !-------------------------------------
+      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice
+      nbpac = 0
+      npac(:) = 0
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN
+               nbpac = nbpac + 1
+               npac( nbpac ) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+
+      ! debug point to follow
+      jiindex_1d = 0
+      IF( ln_limctl ) THEN
+         DO ji = mi0(iiceprt), mi1(iiceprt)
+            DO jj = mj0(jiceprt), mj1(jiceprt)
+               IF ( qlead(ji,jj)  <  0._wp ) THEN
+                  jiindex_1d = (jj - 1) * jpi + ji
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+   
+      IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
+
+      !------------------------------
+      ! Move from 2-D to 1-D vectors
+      !------------------------------
+      ! If ocean gains heat do nothing. Otherwise compute new ice formation
+
+      IF ( nbpac > 0 ) THEN
+
+         CALL tab_2d_1d( nbpac, zat_i_1d  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) )
+         DO jl = 1, jpl
+            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
+            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) )
+            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )
+            DO jk = 1, nlay_i
+               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )
+            END DO
+         END DO
+
+         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead     , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo      , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol     , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel     , jpi, jpj, npac(1:nbpac) )
+
+         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, rn_amax_1d(1:nbpac)     , rn_amax_2d, jpi, jpj, npac(1:nbpac) )
+
+         !------------------------------------------------------------------------------!
+         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice
+         !------------------------------------------------------------------------------!
+
+         !-----------------------------------------
+         ! Keep old ice areas and volume in memory
+         !-----------------------------------------
+         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 
+         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:)
+
+         !----------------------
+         ! Thickness of new ice
+         !----------------------
+         zh_newice(1:nbpac) = hicol_1d(1:nbpac)
+
+         !----------------------
+         ! Salinity of new ice 
+         !----------------------
+         SELECT CASE ( nn_icesal )
+         CASE ( 1 )                    ! Sice = constant 
+            zs_newice(1:nbpac) = rn_icesal
+         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)]
+            DO ji = 1, nbpac
+               ii =   MOD( npac(ji) - 1 , jpi ) + 1
+               ij =      ( npac(ji) - 1 ) / jpi + 1
+               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij)  )
+            END DO
+         CASE ( 3 )                    ! Sice = F(z) [multiyear ice]
+            zs_newice(1:nbpac) =   2.3
+         END SELECT
+
+         !-------------------------
+         ! Heat content of new ice
+         !-------------------------
+         ! We assume that new ice is formed at the seawater freezing point
+         DO ji = 1, nbpac
+            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K)
+            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                                         &
+               &                       + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   &
+               &                       - rcp  *         ( ztmelts - rt0 )  )
+         END DO
+
+         !----------------
+         ! Age of new ice
+         !----------------
+         DO ji = 1, nbpac
+            zo_newice(ji) = 0._wp
+         END DO
+
+         !-------------------
+         ! Volume of new ice
+         !-------------------
+         DO ji = 1, nbpac
+
+            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg]
+
+            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg]
+                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 
+                                                                   
+            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg]
+                                              
+            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0) 
+                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point   
+            zv_newice(ji) = - zfmdt * r1_rhoic
+
+            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux  
+
+            ! Contribution to heat flux to the ocean [W.m-2], >0  
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice
+            ! Total heat flux used in this process [W.m-2]  
+            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice
+            ! mass flux
+            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice
+            ! salt flux
+            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice
+         END DO
+         
+         zv_frazb(:) = 0._wp
+         IF( ln_frazil ) THEN
+            ! A fraction zfrazb of frazil ice is accreted at the ice bottom
+            DO ji = 1, nbpac
+               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
+               zfrazb        = rswitch * ( TANH( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
+               zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
+               zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
+            END DO
+         END IF
+         
+         !-----------------
+         ! Area of new ice
+         !-----------------
+         DO ji = 1, nbpac
+            za_newice(ji) = zv_newice(ji) / zh_newice(ji)
+         END DO
+
+         !------------------------------------------------------------------------------!
+         ! 6) Redistribute new ice area and volume into ice categories                  !
+         !------------------------------------------------------------------------------!
+
+         !------------------------
+         ! 6.1) lateral ice growth
+         !------------------------
+         ! If lateral ice growth gives an ice concentration gt 1, then
+         ! we keep the excessive volume in memory and attribute it later to bottom accretion
+         DO ji = 1, nbpac
+            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - zat_i_1d(ji) ) ) THEN
+               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - zat_i_1d(ji) )
+               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji) 
+               za_newice(ji) = za_newice(ji) - zda_res  (ji)
+               zv_newice(ji) = zv_newice(ji) - zdv_res  (ji)
+            ELSE
+               zda_res(ji) = 0._wp
+               zdv_res(ji) = 0._wp
+            ENDIF
+         END DO
+
+         ! find which category to fill
+         zat_i_1d(:) = 0._wp
+         DO jl = 1, jpl
+            DO ji = 1, nbpac
+               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN
+                  za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji)
+                  zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji)
+                  jcat    (ji)    = jl
+               ENDIF
+               zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d  (ji,jl)
+            END DO
+         END DO
+
+         ! Heat content
+         DO ji = 1, nbpac
+            jl = jcat(ji)                                                    ! categroy in which new ice is put
+            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice
+         END DO
+
+         DO jk = 1, nlay_i
+            DO ji = 1, nbpac
+               jl = jcat(ji)
+               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) )
+               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                    &
+                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  &
+                  &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 )
+            END DO
+         END DO
+
+         !------------------------------------------------
+         ! 6.2) bottom ice growth + ice enthalpy remapping
+         !------------------------------------------------
+         DO jl = 1, jpl
+
+            ! for remapping
+            h_i_old (1:nbpac,0:nlay_i+1) = 0._wp
+            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp
+            DO jk = 1, nlay_i
+               DO ji = 1, nbpac
+                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i
+                  qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk)
+               END DO
+            END DO
+
+            ! new volumes including lateral/bottom accretion + residual
+            DO ji = 1, nbpac
+               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) )
+               zv_newfra      = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 )
+               za_i_1d(ji,jl) = rswitch * za_i_1d(ji,jl)               
+               zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra
+               ! for remapping
+               h_i_old (ji,nlay_i+1) = zv_newfra
+               qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra
+            ENDDO
+            ! --- Ice enthalpy remapping --- !
+            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 
+         ENDDO
+
+         !-----------------
+         ! Update salinity
+         !-----------------
+         DO jl = 1, jpl
+            DO ji = 1, nbpac
+               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl)
+               zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji)
+            END DO
+         END DO
+
+         !------------------------------------------------------------------------------!
+         ! 7) Change 2D vectors to 1D vectors 
+         !------------------------------------------------------------------------------!
+         DO jl = 1, jpl
+            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj )
+            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj )
+            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj )
+            DO jk = 1, nlay_i
+               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj )
+            END DO
+         END DO
+         CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj )
+         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj )
+
+         CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj )
+         CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj )
+         !
+      ENDIF ! nbpac > 0
+
+      !------------------------------------------------------------------------------!
+      ! 8) Change units for e_i
+      !------------------------------------------------------------------------------!    
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! heat content in J/m2
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !
+      CALL wrk_dealloc( jpij, jcat )   ! integer
+      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
+      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
+      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+      CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )
+      CALL wrk_dealloc( jpi,jpj, zvrel )
+      !
+   END SUBROUTINE lim_thd_lac
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                               NO  LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_thd_lac           ! Empty routine
+   END SUBROUTINE lim_thd_lac
+#endif
+
+   !!======================================================================
+END MODULE limthd_lac
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 8732)
@@ -0,0 +1,161 @@
+MODULE limthd_sal
+   !!======================================================================
+   !!                       ***  MODULE limthd_sal ***
+   !! 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
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!---------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd_sal   : salinity variations in the ice
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE phycst         ! physical constants (ocean directory)
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE ice            ! LIM variables
+   USE thd_ice        ! LIM thermodynamics
+   USE limvar         ! LIM variables
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_sal        ! called by limthd module
+   PUBLIC   lim_thd_sal_init   ! called by sbc_lim_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_sal( kideb, kiut )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd_sal  ***    
+      !!   
+      !! ** Purpose :   computes new salinities in the ice
+      !!
+      !! ** Method  :  3 possibilities
+      !!               -> nn_icesal = 1 -> Sice = cst    [ice salinity constant in both time & space] 
+      !!               -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
+      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice]
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
+      !
+      INTEGER  ::   ii, ij, ji, jk               ! dummy loop indices 
+      REAL(wp) ::   iflush, igravdr              ! local scalars
+      REAL(wp) ::   zs_sni, zsm_i_gd, zsm_i_fl, zsm_i_si, zsm_i_bg   ! local scalars
+      !!---------------------------------------------------------------------
+
+      !--------------------------------------------------------------------|
+      ! 1) salinity constant in time                                       |
+      !--------------------------------------------------------------------|
+      ! do nothing
+
+      !----------------------------------------------------------------------|
+      !  2) salinity varying in time                                         |
+      !----------------------------------------------------------------------|
+      IF(  nn_icesal == 2  ) THEN
+
+         DO ji = kideb, kiut
+
+            ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
+            !---------------------------------------------------------
+            !  Update ice salinity from snow-ice and bottom growth
+            !---------------------------------------------------------
+            zs_sni   = sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic   ! Salinity of snow ice
+            rswitch  = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
+            zsm_i_si = ( zs_sni      - sm_i_1d(ji) ) *             dh_snowice(ji)  / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! snow-ice    
+            zsm_i_bg = ( s_i_new(ji) - sm_i_1d(ji) ) * MAX( 0._wp, dh_i_bott(ji) ) / MAX( ht_i_1d(ji), epsi20 ) * rswitch ! bottom growth
+
+            ! Update salinity (nb: salt flux already included in limthd_dh)
+            sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_bg + zsm_i_si
+
+            IF( ln_limdS ) THEN
+               !---------------------------------------------------------
+               !  Update ice salinity from brine drainage and flushing
+               !---------------------------------------------------------
+               iflush   = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0         ) )  ! =1 if summer 
+               igravdr  = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )  ! =1 if t_su < t_bo
+               zsm_i_gd = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice  ! gravity drainage 
+               zsm_i_fl = - iflush  * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice  ! flushing
+               
+               ! Update salinity   
+               sm_i_1d(ji) = sm_i_1d(ji) + zsm_i_fl + zsm_i_gd
+               
+               ! Salt flux
+               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( zsm_i_fl + zsm_i_gd ) * r1_rdtice
+            ENDIF
+         END DO
+
+         ! Salinity profile
+         CALL lim_var_salprof1d( kideb, kiut )
+         !
+      ENDIF 
+
+      !------------------------------------------------------------------------------|
+      !  3) vertical profile of salinity, constant in time                           |
+      !------------------------------------------------------------------------------|
+      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut )
+
+      !
+   END SUBROUTINE lim_thd_sal
+
+
+   SUBROUTINE lim_thd_sal_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_thd_sal_init  ***
+      !!
+      !! ** Purpose :   initialization of ice salinity parameters
+      !!
+      !! ** Method  :   Read the namicesal namelist and check the parameter
+      !!              values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicesal
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicesal/ ln_limdS, nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd,   &
+         &                rn_sal_fl, rn_time_fl, rn_simax, rn_simin 
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicesal in reference namelist : Ice salinity
+      READ  ( numnam_ice_ref, namicesal, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicesal in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicesal in configuration namelist : Ice salinity
+      READ  ( numnam_ice_cfg, namicesal, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicesal in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicesal )
+      !
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   activate gravity drainage and flushing (T) or not (F)   ln_limdS   = ', ln_limdS
+         WRITE(numout,*) '   switch for salinity                                     nn_icesal  = ', nn_icesal
+         WRITE(numout,*) '   bulk salinity value if nn_icesal = 1                    rn_icesal  = ', rn_icesal
+         WRITE(numout,*) '   restoring salinity for gravity drainage                 rn_sal_gd  = ', rn_sal_gd
+         WRITE(numout,*) '   restoring time for for gravity drainage                 rn_time_gd = ', rn_time_gd
+         WRITE(numout,*) '   restoring salinity for flushing                         rn_sal_fl  = ', rn_sal_fl
+         WRITE(numout,*) '   restoring time for flushing                             rn_time_fl = ', rn_time_fl
+         WRITE(numout,*) '   Maximum tolerated ice salinity                          rn_simax   = ', rn_simax
+         WRITE(numout,*) '   Minimum tolerated ice salinity                          rn_simin   = ', rn_simin
+      ENDIF
+      !
+   END SUBROUTINE lim_thd_sal_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy Module          No LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE limthd_sal
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 8732)
@@ -0,0 +1,545 @@
+MODULE limtrp
+   !!======================================================================
+   !!                       ***  MODULE limtrp   ***
+   !! LIM transport ice model : sea-ice advection/diffusion
+   !!======================================================================
+   !! History : LIM-2 ! 2000-01 (M.A. Morales Maqueda, H. Goosse, and T. Fichefet)  Original code
+   !!            3.0  ! 2005-11 (M. Vancoppenolle)   Multi-layer sea ice, salinity variations
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_trp      : advection/diffusion process of sea ice
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constant
+   USE dom_oce        ! ocean domain
+   USE sbc_oce        ! ocean surface boundary condition
+   USE ice            ! ice variables
+   USE limhdf         ! ice horizontal diffusion
+   USE limvar         ! 
+   USE limadv_prather ! advection scheme (Prather)
+   USE limadv_umx     ! advection scheme (ultimate-macho)
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! lateral boundary conditions -- MPP exchanges
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE prtctl         ! Print control
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE timing         ! Timing
+   USE limcons        ! conservation tests
+   USE limctl         ! control prints
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_trp    ! called by sbcice_lim
+
+   INTEGER  ::   ncfl                 ! number of ice time step with CFL>1/2  
+
+   !! * Substitution
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_trp( kt ) 
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_trp ***
+      !!                    
+      !! ** purpose : advection/diffusion process of sea ice
+      !!
+      !! ** method  : variables included in the process are scalar,   
+      !!     other values are considered as second order. 
+      !!     For advection, one can choose between
+      !!     a) an Ultimate-Macho scheme (whose order is defined by nn_limadv_ord) => nn_limadv=0
+      !!     b) and a second order Prather scheme => nn_limadv=-1
+      !!
+      !! ** action :
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !
+      INTEGER  ::   ji, jj, jk, jm, jl, jt  ! dummy loop indices
+      INTEGER  ::   initad                  ! number of sub-timestep for the advection
+      REAL(wp) ::   zcfl , zusnit           !   -      -
+      CHARACTER(len=80) :: cltmp
+      !
+      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
+      REAL(wp) ::    zdv, zda
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold, zsmvold 
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax, zviold, zvsold
+      ! --- diffusion --- !
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhdfptab
+      INTEGER , PARAMETER                    ::   ihdf_vars  = 6 ! Number of variables in which we apply horizontal diffusion
+                                                                 !  inside limtrp for each ice category , not counting the 
+                                                                 !  variables corresponding to ice_layers 
+      ! --- ultimate macho only --- !
+      REAL(wp)                               ::   zdt
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zudy, zvdx, zcu_box, zcv_box
+      ! --- prather only --- !
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zarea
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0opw
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z0ice, z0snw, z0ai, z0es , z0smi , z0oi
+      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   z0ei
+      !!
+      !!---------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('limtrp')
+
+      CALL wrk_alloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold )
+      CALL wrk_alloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold )
+      CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)
+ 
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)''
+         WRITE(numout,*)'limtrp'
+         WRITE(numout,*)'~~~~~~'
+         ncfl = 0                ! nb of time step with CFL > 1/2
+      ENDIF
+      
+      CALL lim_var_agg( 1 ) ! integrated values + ato_i
+
+      !-------------------------------------!
+      !   Advection of sea ice properties   !
+      !-------------------------------------!
+
+      ! conservation test
+      IF( ln_limdiachk )   CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+      
+      ! store old values for diag
+      zviold = v_i
+      zvsold = v_s
+      zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 )
+      zeiold (:,:) = et_i
+      zesold (:,:) = et_s 
+
+      !--- Thickness correction init. --- !
+      zatold(:,:) = at_i
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+               ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+      ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- !
+      zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:)
+      DO jl = 1, jpl
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) )
+            END DO
+         END DO
+         CALL lbc_lnk(zhimax(:,:,jl),'T',1.)
+      END DO
+         
+      ! --- If ice drift field is too fast, use an appropriate time step for advection --- !        
+      zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) )    ! CFL test for stability
+      zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+      IF( lk_mpp )   CALL mpp_max( zcfl )
+      
+      IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
+      ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
+      ENDIF
+      
+!!      IF( zcfl > 0.5_wp .AND. lwp ) THEN
+!!         ncfl = ncfl + 1
+!!         IF( ncfl > 0 ) THEN   
+!!            WRITE(cltmp,'(i6.1)') ncfl
+!!            CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ')
+!!         ENDIF
+!!      ENDIF
+
+      SELECT CASE ( nn_limadv )
+         
+                       !=============================!
+      CASE ( 0 )       !==  Ultimate-MACHO scheme  ==!                   
+                       !=============================!
+      
+         CALL wrk_alloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )
+      
+         IF( kt == nit000 .AND. lwp ) THEN
+            WRITE(numout,*)''
+            WRITE(numout,*)'lim_adv_umx : Ultimate-MACHO advection scheme'
+            WRITE(numout,*)'~~~~~~~~~~~'
+         ENDIF
+         !
+         zdt = rdt_ice / REAL(initad)
+         
+         ! transport
+         zudy(:,:) = u_ice(:,:) * e2u(:,:)
+         zvdx(:,:) = v_ice(:,:) * e1v(:,:)
+         
+         ! define velocity for advection: u*grad(H)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               IF    ( u_ice(ji,jj) * u_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp
+               ELSEIF( u_ice(ji,jj)                  >  0._wp ) THEN   ;   zcu_box(ji,jj) = u_ice(ji-1,jj)
+               ELSE                                                    ;   zcu_box(ji,jj) = u_ice(ji  ,jj)
+               ENDIF
+               
+               IF    ( v_ice(ji,jj) * v_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp
+               ELSEIF( v_ice(ji,jj)                  >  0._wp ) THEN   ;   zcv_box(ji,jj) = v_ice(ji,jj-1)
+               ELSE                                                    ;   zcv_box(ji,jj) = v_ice(ji,jj  )
+               ENDIF
+            END DO
+         END DO
+         
+         ! advection
+         DO jt = 1, initad
+            CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, ato_i(:,:) )       ! Open water area 
+            DO jl = 1, jpl
+               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, a_i(:,:,jl) )      ! Ice area
+               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_i(:,:,jl) )      ! Ice  volume
+               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, smv_i(:,:,jl) )    ! Salt content
+               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, oa_i (:,:,jl) )    ! Age content
+               DO jk = 1, nlay_i
+                  CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_i(:,:,jk,jl) )   ! Ice  heat content
+               END DO
+               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, v_s(:,:,jl) )      ! Snow volume
+               CALL lim_adv_umx( kt, zdt, zudy, zvdx, zcu_box, zcv_box, e_s(:,:,1,jl) )    ! Snow heat content
+            END DO
+         END DO
+         !
+         at_i(:,:) = a_i(:,:,1)      ! total ice fraction
+         DO jl = 2, jpl
+            at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box )
+         
+                       !=============================!
+      CASE ( -1 )      !==     Prather scheme      ==!                   
+                       !=============================!
+
+         CALL wrk_alloc( jpi,jpj,            zarea )
+         CALL wrk_alloc( jpi,jpj,1,          z0opw )
+         CALL wrk_alloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+         CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )
+         
+         IF( kt == nit000 .AND. lwp ) THEN
+            WRITE(numout,*)''
+            WRITE(numout,*)'lim_adv_xy : Prather advection scheme'
+            WRITE(numout,*)'~~~~~~~~~~~'
+         ENDIF
+         
+         zarea(:,:) = e1e2t(:,:)
+         
+         !-------------------------
+         ! transported fields                                        
+         !-------------------------
+         z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area 
+         DO jl = 1, jpl
+            z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume
+            z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume
+            z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area
+            z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content
+            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content
+            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content
+            DO jk = 1, nlay_i
+               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content
+            END DO
+         END DO
+
+
+         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
+            DO jt = 1, initad
+               CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &
+                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               DO jl = 1, jpl
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &
+                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &
+                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &
+                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---     
+                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &
+                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations ---
+                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
+                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &    !--- snow heat contents ---
+                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &
+                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  DO jk = 1, nlay_i                                                                !--- ice heat contents ---
+                     CALL lim_adv_x( zusnit, u_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                  END DO
+               END DO
+            END DO
+         ELSE
+            DO jt = 1, initad
+               CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area
+                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &
+                  &                                         sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               DO jl = 1, jpl
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &
+                     &                                         sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &
+                     &                                         sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &
+                     &                                         sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
+                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &
+                     &                                         sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &
+                     &                                         sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0es  (:,:,jl), sxc0 (:,:,jl),   &
+                     &                                         sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  DO jk = 1, nlay_i                                                           !--- ice heat contents ---
+                     CALL lim_adv_y( zusnit, v_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                         sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                         syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         !-------------------------------------------
+         ! Recover the properties from their contents
+         !-------------------------------------------
+         ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:)
+         DO jl = 1, jpl
+            v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:)
+            v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:)
+            smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:)
+            oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:)
+            a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:)
+            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:)
+            DO jk = 1, nlay_i
+               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:)
+            END DO
+         END DO
+
+         at_i(:,:) = a_i(:,:,1)      ! total ice fraction
+         DO jl = 2, jpl
+            at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+         END DO
+         
+         CALL wrk_dealloc( jpi,jpj,            zarea )
+         CALL wrk_dealloc( jpi,jpj,1,          z0opw )
+         CALL wrk_dealloc( jpi,jpj,jpl,        z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+         CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )
+
+      END SELECT
+      
+      !------------------------------!
+      ! Diffusion of Ice fields                  
+      !------------------------------!
+      IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN
+         !
+         ! --- Prepare diffusion for variables with categories --- !
+         !     mask eddy diffusivity coefficient at ocean U- and V-points
+         jm=1
+         DO jl = 1, jpl
+            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row
+               DO ji = 1 , fs_jpim1
+                  pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,  jl ) ) ) )   &
+                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,  jl ) ) ) ) * ahiu(ji,jj)
+                  pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,  jj,  jl ) ) ) )   &
+                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,  jj+1,jl ) ) ) ) * ahiv(ji,jj)
+               END DO
+            END DO
+
+            zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1
+            zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1
+            zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1
+            zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1
+            zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1
+            zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1
+            ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased)
+            !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1  
+            !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 
+            DO jk = 1, nlay_i
+              zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1
+            END DO
+         END DO
+
+         ! --- Prepare diffusion for open water area --- !
+         !     mask eddy diffusivity coefficient at ocean U- and V-points
+         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row
+            DO ji = 1 , fs_jpim1
+               pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   &
+                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)
+               pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   &
+                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)
+            END DO
+         END DO
+         !
+         zhdfptab(:,:,jm)= ato_i  (:,:);
+
+         ! --- Apply diffusion --- !
+         CALL lim_hdf( zhdfptab, ihdf_vars )
+
+         ! --- Recover properties --- !
+         jm=1
+         DO jl = 1, jpl
+            a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
+            v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
+            v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
+            smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
+            oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1
+            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1
+            ! Sample of adding more variables to apply lim_hdf
+            !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
+            !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1
+            DO jk = 1, nlay_i
+               e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1
+            END DO
+         END DO
+         ato_i  (:,:) = zhdfptab(:,:,jm)
+              
+      ENDIF
+
+      ! --- diags ---
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            diag_trp_ei (ji,jj) = ( SUM( e_i  (ji,jj,1:nlay_i,:) ) -  zeiold(ji,jj) ) * r1_rdtice
+            diag_trp_es (ji,jj) = ( SUM( e_s  (ji,jj,1:nlay_s,:) ) -  zesold(ji,jj) ) * r1_rdtice
+            diag_trp_smv(ji,jj) = ( SUM( smv_i(ji,jj,:)          ) - zsmvold(ji,jj) ) * r1_rdtice
+            diag_trp_vi (ji,jj) =   SUM(   v_i(ji,jj,:)            -  zviold(ji,jj,:) ) * r1_rdtice
+            diag_trp_vs (ji,jj) =   SUM(   v_s(ji,jj,:)            -  zvsold(ji,jj,:) ) * r1_rdtice
+         END DO
+      END DO
+      
+      IF( nn_limdyn == 2) THEN
+
+         ! zap small areas
+         CALL lim_var_zapsmall
+           
+         !--- Thickness correction in case too high --- !
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  
+                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN
+                     
+                     rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+                     ht_i  (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                     ht_s  (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+                     
+                     zdv  = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)  
+                     
+                     IF ( ( zdv >  0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. &
+                        & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN
+                        
+                        rswitch        = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) )
+                        a_i(ji,jj,jl)  = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 )
+                        
+                        ! small correction due to *rswitch for a_i
+                        v_i  (ji,jj,jl)        = rswitch * v_i  (ji,jj,jl)
+                        v_s  (ji,jj,jl)        = rswitch * v_s  (ji,jj,jl)
+                        smv_i(ji,jj,jl)        = rswitch * smv_i(ji,jj,jl)
+                        e_s(ji,jj,1,jl)        = rswitch * e_s(ji,jj,1,jl)
+                        e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
+                                                
+                     ENDIF
+                     
+                  ENDIF
+                
+               END DO
+            END DO
+         END DO
+         ! -------------------------------------------------
+         
+         ! Force the upper limit of ht_i to always be < hi_max (99 m).
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch         = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) )
+               ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) )
+               a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch
+            END DO
+         END DO
+
+      ENDIF
+         
+      !------------------------------------------------------------
+      ! Impose a_i < amax if no ridging/rafting or in mono-category
+      !------------------------------------------------------------
+      !
+      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
+      IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch       = MAX( 0._wp, SIGN( 1._wp, at_i(ji,jj) - epsi20 ) )
+                  zda           = rswitch * MIN( rn_amax_2d(ji,jj) - at_i(ji,jj), 0._wp )  &
+                     &                    * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi20 )
+                  a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda
+               END DO
+            END DO
+         END DO
+      ENDIF
+      
+      ! --- agglomerate variables -----------------
+      vt_i(:,:) = SUM( v_i(:,:,:), dim=3 )
+      vt_s(:,:) = SUM( v_s(:,:,:), dim=3 )
+      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
+      
+      ! --- open water = 1 if at_i=0 --------------------------------
+      WHERE( at_i == 0._wp ) ato_i = 1._wp 
+      
+      ! conservation test
+      IF( ln_limdiachk )   CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+        
+      ! -------------------------------------------------
+      ! control prints
+      ! -------------------------------------------------
+      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )
+      !
+      CALL wrk_dealloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold )
+      CALL wrk_dealloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold )
+      CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('limtrp')
+      !
+   END SUBROUTINE lim_trp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module                No sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_trp        ! Empty routine
+   END SUBROUTINE lim_trp
+#endif
+   !!======================================================================
+END MODULE limtrp
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90	(revision 8732)
@@ -0,0 +1,156 @@
+MODULE limupdate1
+   !!======================================================================
+   !!                     ***  MODULE  limupdate1  ***
+   !!   LIM-3 : Update of sea-ice global variables at the end of the time step
+   !!======================================================================
+   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_update1   : computes update of sea-ice global variables from trend terms
+   !!----------------------------------------------------------------------
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE dom_oce
+   USE phycst          ! physical constants
+   USE ice
+   USE thd_ice         ! LIM thermodynamic sea-ice variables
+   USE limitd_th
+   USE limvar
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE limcons         ! conservation tests
+   USE limctl          ! control prints
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_update1
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_update1( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_update1  ***
+      !!               
+      !! ** Purpose :  Computes update of sea-ice global variables at 
+      !!               the end of the dynamics.
+      !!                
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zsal
+      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      !!-------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('limupdate1')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)'' 
+         WRITE(numout,*)' lim_update1 ' 
+         WRITE(numout,*)' ~~~~~~~~~~~ '
+      ENDIF
+
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !----------------------------------------------------
+      ! ice concentration should not exceed amax 
+      !-----------------------------------------------------
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      DO jl  = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+    
+      !---------------------
+      ! Ice salinity bounds
+      !---------------------
+      IF (  nn_icesal == 2  ) THEN 
+         DO jl = 1, jpl
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  zsal            = smv_i(ji,jj,jl)
+                  ! salinity stays in bounds
+                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
+                  ! associated salt flux
+                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !----------------------------------------------------
+      ! Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
+
+      !-----------------
+      ! zap small values
+      !-----------------
+      CALL lim_var_zapsmall
+
+      ! -------------------------------------------------
+      ! Diagnostics
+      ! -------------------------------------------------
+      DO jl  = 1, jpl
+         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi            
+            ! heat content variation (W.m-2)
+            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
+               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
+               &                 ) * r1_rdtice
+            ! salt, volume
+            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
+         END DO
+      END DO
+
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! control prints
+      IF( ln_ctl )       CALL lim_prt3D( 'limupdate1' )
+   
+      IF( nn_timing == 1 )  CALL timing_stop('limupdate1')
+
+   END SUBROUTINE lim_update1
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module               No sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_update1     ! Empty routine
+   END SUBROUTINE lim_update1
+
+#endif
+
+END MODULE limupdate1
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90	(revision 8732)
@@ -0,0 +1,197 @@
+MODULE limupdate2
+   !!======================================================================
+   !!                     ***  MODULE  limupdate2  ***
+   !!   LIM-3 : Update of sea-ice global variables at the end of the time step
+   !!======================================================================
+   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
+   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_update2   : computes update of sea-ice global variables from trend terms
+   !!----------------------------------------------------------------------
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE dom_oce
+   USE phycst          ! physical constants
+   USE ice
+   USE thd_ice         ! LIM thermodynamic sea-ice variables
+   USE limitd_th
+   USE limvar
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE limcons         ! conservation tests
+   USE limctl
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_update2   ! routine called by ice_step
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_update2( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_update2  ***
+      !!               
+      !! ** Purpose :  Computes update of sea-ice global variables at 
+      !!               the end of the time step.
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zsal
+      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      !!-------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('limupdate2')
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)''
+         WRITE(numout,*)' lim_update2 '
+         WRITE(numout,*)' ~~~~~~~~~~~ '
+      ENDIF
+
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      !----------------------------------------------------------------------
+      ! Constrain the thickness of the smallest category above himin
+      !----------------------------------------------------------------------
+      DO jj = 1, jpj 
+         DO ji = 1, jpi
+            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes
+            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch
+            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN
+               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin
+               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin
+            ENDIF
+         END DO
+      END DO
+      
+      !-----------------------------------------------------
+      ! ice concentration should not exceed amax 
+      !-----------------------------------------------------
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      DO jl  = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
+                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      !---------------------
+      ! Ice salinity
+      !---------------------
+      IF (  nn_icesal == 2  ) THEN 
+         DO jl = 1, jpl
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  zsal            = smv_i(ji,jj,jl)
+                  ! salinity stays in bounds
+                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
+                  ! associated salt flux
+                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !----------------------------------------------------
+      ! Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
+
+      !-----------------
+      ! zap small values
+      !-----------------
+      CALL lim_var_zapsmall
+
+      !------------------------------------------------------------------------------
+      ! Corrections to avoid wrong values                                        |
+      !------------------------------------------------------------------------------
+      ! Ice drift
+      !------------
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice
+               IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj)   = 0._wp ! right side
+               IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side
+               IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj)   = 0._wp ! upper side
+               IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side
+            ENDIF
+         END DO
+      END DO
+      !lateral boundary conditions
+      CALL lbc_lnk( u_ice(:,:), 'U', -1. )
+      CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+      !mask velocities
+      u_ice(:,:) = u_ice(:,:) * umask(:,:,1)
+      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1)
+ 
+      ! -------------------------------------------------
+      ! Diagnostics
+      ! -------------------------------------------------
+      DO jl  = 1, jpl
+         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging
+         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+      END DO
+      afx_tot = afx_thd + afx_dyn
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi            
+            ! heat content variation (W.m-2)
+            diag_heat(ji,jj) = diag_heat(ji,jj) -  &
+               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
+               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
+               &               ) * r1_rdtice   
+            ! salt, volume
+            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
+            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
+         END DO
+      END DO
+
+      ! conservation test
+      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+      ! control prints
+      IF( ln_limctl )    CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )
+      IF( ln_ctl )       CALL lim_prt3D( 'limupdate2' )
+   
+      IF( nn_timing == 1 )  CALL timing_stop('limupdate2')
+
+   END SUBROUTINE lim_update2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module               No sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_update2     ! Empty routine
+   END SUBROUTINE lim_update2
+
+#endif
+
+END MODULE limupdate2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 8732)
@@ -0,0 +1,796 @@
+MODULE limvar
+   !!======================================================================
+   !!                       ***  MODULE limvar ***
+   !!                 Different sets of ice model variables 
+   !!                   how to switch from one to another
+   !!
+   !!                 There are three sets of variables
+   !!                 VGLO : global variables of the model
+   !!                        - v_i (jpi,jpj,jpl)
+   !!                        - v_s (jpi,jpj,jpl)
+   !!                        - a_i (jpi,jpj,jpl)
+   !!                        - t_s (jpi,jpj,jpl)
+   !!                        - e_i (jpi,jpj,nlay_i,jpl)
+   !!                        - smv_i(jpi,jpj,jpl)
+   !!                        - oa_i (jpi,jpj,jpl)
+   !!                 VEQV : equivalent variables sometimes used in the model
+   !!                        - ht_i(jpi,jpj,jpl)
+   !!                        - ht_s(jpi,jpj,jpl)
+   !!                        - t_i (jpi,jpj,nlay_i,jpl)
+   !!                        ...
+   !!                 VAGG : aggregate variables, averaged/summed over all
+   !!                        thickness categories
+   !!                        - vt_i(jpi,jpj)
+   !!                        - vt_s(jpi,jpj)
+   !!                        - at_i(jpi,jpj)
+   !!                        - et_s(jpi,jpj)  !total snow heat content
+   !!                        - et_i(jpi,jpj)  !total ice thermal content 
+   !!                        - smt_i(jpi,jpj) !mean ice salinity
+   !!                        - tm_i (jpi,jpj) !mean ice temperature
+   !!======================================================================
+   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
+   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE phycst         ! physical constants (ocean directory) 
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE ice            ! ice variables
+   USE thd_ice        ! ice variables (thermodynamics)
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_var_agg          
+   PUBLIC   lim_var_glo2eqv      
+   PUBLIC   lim_var_eqv2glo      
+   PUBLIC   lim_var_salprof      
+   PUBLIC   lim_var_bv           
+   PUBLIC   lim_var_salprof1d    
+   PUBLIC   lim_var_zapsmall
+   PUBLIC   lim_var_itd
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_var_agg( kn )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_agg  ***
+      !!
+      !! ** Purpose :   aggregates ice-thickness-category variables to all-ice variables
+      !!              i.e. it turns VGLO into VAGG
+      !! ** Method  :
+      !!
+      !! ** Arguments : n = 1, at_i vt_i only
+      !!                n = 2 everything
+      !!
+      !! note : you could add an argument when you need only at_i, vt_i
+      !!        and when you need everything
+      !!------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kn     ! =1 at_i & vt only ; = what is needed
+      !
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      !!------------------------------------------------------------------
+
+      ! integrated values
+      vt_i (:,:) = SUM( v_i, dim=3 )
+      vt_s (:,:) = SUM( v_s, dim=3 )
+      at_i (:,:) = SUM( a_i, dim=3 )
+      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 )
+      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 )
+
+      ! open water fraction
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )   
+         END DO
+      END DO
+
+      IF( kn > 1 ) THEN
+
+         ! mean ice/snow thickness
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
+               htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch
+               htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch
+            ENDDO
+         ENDDO
+
+         ! mean temperature (K), salinity and age
+         smt_i(:,:) = 0._wp
+         tm_i(:,:)  = 0._wp
+         tm_su(:,:) = 0._wp
+         om_i (:,:) = 0._wp
+         DO jl = 1, jpl
+            
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
+                  tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 )
+                  om_i (ji,jj) = om_i (ji,jj) + rswitch *   oa_i(ji,jj,jl)                         / MAX( at_i(ji,jj) , epsi10 )
+               END DO
+            END DO
+            
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+                     tm_i(ji,jj)  = tm_i(ji,jj)  + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl)  &
+                        &            / MAX( vt_i(ji,jj) , epsi10 )
+                     smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl)  &
+                        &            / MAX( vt_i(ji,jj) , epsi10 )
+                  END DO
+               END DO
+            END DO
+         END DO
+         tm_i  = tm_i  + rt0
+         tm_su = tm_su + rt0
+         !
+      ENDIF
+      !
+   END SUBROUTINE lim_var_agg
+
+
+   SUBROUTINE lim_var_glo2eqv
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_glo2eqv ***
+      !!
+      !! ** Purpose :   computes equivalent variables as function of global variables 
+      !!              i.e. it turns VGLO into VEQV
+      !!------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars
+      REAL(wp) ::   ztmelts, zq_s, zfac1, zfac2   !   -      -
+      !!------------------------------------------------------------------
+
+      !-------------------------------------------------------
+      ! Ice thickness, snow thickness, ice salinity, ice age
+      !-------------------------------------------------------
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+      ! Force the upper limit of ht_i to always be < hi_max (99 m).
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) )
+            ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) )
+            a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch
+         END DO
+      END DO
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+            END DO
+         END DO
+      END DO
+      
+      IF(  nn_icesal == 2  )THEN
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) )   !0 if no ice and 1 if yes
+                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch
+                  !                                      ! bounding salinity
+                  sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin )
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      CALL lim_var_salprof      ! salinity profile
+
+      !-------------------
+      ! Ice temperatures
+      !-------------------
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !                                                              ! Energy of melting q(S,T) [J.m-3]
+                  rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp) 
+                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0              ! Ice layer melt temperature
+                  !
+                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation)
+                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus
+                  zccc       =  lfus * (ztmelts-rt0)
+                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
+                  t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
+                  t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) )  ! -100 < t_i < ztmelts
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !--------------------
+      ! Snow temperatures
+      !--------------------
+      zfac1 = 1._wp / ( rhosn * cpic )
+      zfac2 = lfus / cpic  
+      DO jl = 1, jpl
+         DO jk = 1, nlay_s
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !Energy of melting q(S,T) [J.m-3]
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp)
+                  !
+                  t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 )
+                  t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) )     ! -100 < t_s < rt0
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! integrated values
+      vt_i (:,:) = SUM( v_i, dim=3 )
+      vt_s (:,:) = SUM( v_s, dim=3 )
+      at_i (:,:) = SUM( a_i, dim=3 )
+
+      !
+   END SUBROUTINE lim_var_glo2eqv
+
+
+   SUBROUTINE lim_var_eqv2glo
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_eqv2glo ***
+      !!
+      !! ** Purpose :   computes global variables as function of equivalent variables
+      !!                i.e. it turns VEQV into VGLO
+      !! ** Method  :
+      !!
+      !! ** History :  (01-2006) Martin Vancoppenolle, UCL-ASTR
+      !!------------------------------------------------------------------
+      !
+      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
+      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
+      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
+      !
+   END SUBROUTINE lim_var_eqv2glo
+
+
+   SUBROUTINE lim_var_salprof
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_salprof ***
+      !!
+      !! ** Purpose :   computes salinity profile in function of bulk salinity     
+      !!
+      !! ** Method  : If bulk salinity greater than zsi1, 
+      !!              the profile is assumed to be constant (S_inf)
+      !!              If bulk salinity lower than zsi0,
+      !!              the profile is linear with 0 at the surface (S_zero)
+      !!              If it is between zsi0 and zsi1, it is a
+      !!              alpha-weighted linear combination of s_inf and s_zero
+      !!
+      !! ** References : Vancoppenolle et al., 2007
+      !!------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
+      REAL(wp) ::   zfac0, zfac1, zsal
+      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero   
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
+      !!------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )
+
+      !---------------------------------------
+      ! Vertically constant, constant in time
+      !---------------------------------------
+      IF(  nn_icesal == 1  )  THEN
+         s_i (:,:,:,:) = rn_icesal
+         sm_i(:,:,:)   = rn_icesal
+      ENDIF
+
+      !-----------------------------------
+      ! Salinity profile, varying in time
+      !-----------------------------------
+      IF(  nn_icesal == 2  ) THEN
+         !
+         DO jk = 1, nlay_i
+            s_i(:,:,jk,:)  = sm_i(:,:,:)
+         END DO
+         !
+         DO jl = 1, jpl                               ! Slope of the linear profile 
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) )
+                  z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) )
+               END DO
+            END DO
+         END DO
+         !
+         zfac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf
+         zfac1 = zsi1  / ( zsi1 - zsi0 )
+         !
+         zalpha(:,:,:) = 0._wp
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , zsi0 - sm_i(ji,jj,jl) ) ) 
+                  ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
+                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , zsi1 - sm_i(ji,jj,jl) ) ) 
+                  ! If 2.sm_i GE sss_m then rswitch = 1
+                  ! this is to force a constant salinity profile in the Baltic Sea
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
+                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 )
+                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch )
+               END DO
+            END DO
+         END DO
+
+         ! Computation of the profile
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !                                      ! linear profile with 0 at the surface
+                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i
+                     !                                      ! weighting the profile
+                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
+                     !                                      ! bounding salinity
+                     s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) )
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF ! nn_icesal
+
+      !-------------------------------------------------------
+      ! Vertically varying salinity profile, constant in time
+      !-------------------------------------------------------
+
+      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+         !
+         sm_i(:,:,:) = 2.30_wp
+         !
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
+               s_i(:,:,jk,jl) =  zsal
+            END DO
+         END DO
+         !
+      ENDIF ! nn_icesal
+      !
+      CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
+      !
+   END SUBROUTINE lim_var_salprof
+
+
+   SUBROUTINE lim_var_bv
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_bv ***
+      !!
+      !! ** Purpose :   computes mean brine volume (%) in sea ice
+      !!
+      !! ** Method  : e = - 0.054 * S (ppt) / T (C)
+      !!
+      !! References : Vancoppenolle et al., JGR, 2007
+      !!------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      !!------------------------------------------------------------------
+      !
+      bvm_i(:,:)   = 0._wp
+      bv_i (:,:,:) = 0._wp
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rswitch        = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) )  )
+                  bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i  &
+                     &                            / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )
+               END DO
+            END DO
+         END DO
+         
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rswitch      = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+               bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 )
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_var_bv
+
+
+   SUBROUTINE lim_var_salprof1d( kideb, kiut )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_thd_salprof1d  ***
+      !!
+      !! ** Purpose :   1d computation of the sea ice salinity profile
+      !!                Works with 1d vectors and is used by thermodynamic modules
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
+      !
+      INTEGER  ::   ji, jk    ! dummy loop indices
+      INTEGER  ::   ii, ij    ! local integers
+      REAL(wp) ::   zfac0, zfac1, zargtemp, zsal   ! local scalars
+      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
+      REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+      REAL(wp), PARAMETER :: zsi1 = 4.5_wp
+      !!---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij, z_slope_s )
+
+      !---------------------------------------
+      ! Vertically constant, constant in time
+      !---------------------------------------
+      IF( nn_icesal == 1 )   s_i_1d(:,:) = rn_icesal
+
+      !------------------------------------------------------
+      ! Vertically varying salinity profile, varying in time
+      !------------------------------------------------------
+
+      IF(  nn_icesal == 2  ) THEN
+         !
+         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
+            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
+            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) )
+         END DO
+
+         ! Weighting factor between zs_zero and zs_inf
+         !---------------------------------------------
+         zfac0 = 1._wp / ( zsi0 - zsi1 )
+         zfac1 = zsi1 / ( zsi1 - zsi0 )
+         DO jk = 1, nlay_i
+            DO ji = kideb, kiut
+               ii =  MOD( npb(ji) - 1 , jpi ) + 1
+               ij =     ( npb(ji) - 1 ) / jpi + 1
+               ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+               zswi0  = MAX( 0._wp , SIGN( 1._wp  , zsi0 - sm_i_1d(ji) ) ) 
+               ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws 
+               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) ) 
+               ! if 2.sm_i GE sss_m then rswitch = 1
+               ! this is to force a constant salinity profile in the Baltic Sea
+               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
+               !
+               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch )
+               !
+               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i
+               ! weighting the profile
+               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
+               ! bounding salinity
+               s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) )
+            END DO 
+         END DO 
+
+      ENDIF 
+
+      !-------------------------------------------------------
+      ! Vertically varying salinity profile, constant in time
+      !-------------------------------------------------------
+
+      IF( nn_icesal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+         !
+         sm_i_1d(:) = 2.30_wp
+         !
+         DO jk = 1, nlay_i
+            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
+            DO ji = kideb, kiut
+               s_i_1d(ji,jk) = zsal
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpij, z_slope_s )
+      !
+   END SUBROUTINE lim_var_salprof1d
+
+   SUBROUTINE lim_var_zapsmall
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_var_zapsmall ***
+      !!
+      !! ** Purpose :   Remove too small sea ice areas and correct fluxes
+      !!
+      !! history : LIM3.5 - 01-2014 (C. Rousset) original code
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
+      REAL(wp) ::   zsal, zvi, zvs, zei, zes
+      !!-------------------------------------------------------------------
+      at_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      DO jl = 1, jpl
+
+         !-----------------------------------------------------------------
+         ! Zap ice energy and use ocean heat to melt ice
+         !-----------------------------------------------------------------
+         DO jk = 1, nlay_i
+            DO jj = 1 , jpj
+               DO ji = 1 , jpi
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+                  rswitch          = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
+                     &                                       / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+                  zei              = e_i(ji,jj,jk,jl)
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
+                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+                  ! update exchanges with ocean
+                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch
+               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+               rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch  &
+                  &                              / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+               zsal = smv_i(ji,jj,  jl)
+               zvi  = v_i  (ji,jj,  jl)
+               zvs  = v_s  (ji,jj,  jl)
+               zes  = e_s  (ji,jj,1,jl)
+               !-----------------------------------------------------------------
+               ! Zap snow energy 
+               !-----------------------------------------------------------------
+               t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
+
+               !-----------------------------------------------------------------
+               ! zap ice and snow volume, add water and salt to ocean
+               !-----------------------------------------------------------------
+               ato_i(ji,jj)    = a_i  (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
+               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * rswitch
+               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * rswitch
+               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * rswitch
+               t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
+               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
+               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
+
+               ! update exchanges with ocean
+               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
+               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice
+               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice
+               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+            END DO
+         END DO
+      END DO 
+
+      ! to be sure that at_i is the sum of a_i(jl)
+      at_i (:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+      END DO
+
+      ! open water = 1 if at_i=0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
+            ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
+         END DO
+      END DO
+
+      !
+   END SUBROUTINE lim_var_zapsmall
+
+   SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_var_itd   ***
+      !!
+      !! ** Purpose :  converting 1-cat ice to multiple ice categories
+      !!
+      !!                  ice thickness distribution follows a gaussian law
+      !!               around the concentration of the most likely ice thickness
+      !!                           (similar as limistate.F90)
+      !!
+      !! ** Method:   Iterative procedure
+      !!                
+      !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
+      !!
+      !!               2) Check whether the distribution conserves area and volume, positivity and
+      !!                  category boundaries
+      !!              
+      !!               3) If not (input ice is too thin), the last category is empty and
+      !!                  the number of categories is reduced (jpl-1)
+      !!
+      !!               4) Iterate until ok (SUM(itest(:) = 4)
+      !!
+      !! ** Arguments : zhti: 1-cat ice thickness
+      !!                zhts: 1-cat snow depth
+      !!                zai : 1-cat ice concentration
+      !!
+      !! ** Output    : jpl-cat 
+      !!
+      !!  (Example of application: BDY forcings when input are cell averaged)  
+      !!
+      !!-------------------------------------------------------------------
+      !! History : LIM3.5 - 2012    (M. Vancoppenolle)  Original code
+      !!                    2014    (C. Rousset)        Rewriting
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER  :: ji, jk, jl             ! dummy loop indices
+      INTEGER  :: ijpij, i_fill, jl0  
+      REAL(wp) :: zarg, zV, zconv, zdh, zdv
+      REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zai    ! input ice/snow variables
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zht_i, zht_s, za_i ! output ice/snow variables
+      INTEGER , POINTER, DIMENSION(:)         ::   itest
+ 
+      CALL wrk_alloc( 4, itest )
+      !--------------------------------------------------------------------
+      ! initialisation of variables
+      !--------------------------------------------------------------------
+      ijpij = SIZE(zhti,1)
+      zht_i(1:ijpij,1:jpl) = 0._wp
+      zht_s(1:ijpij,1:jpl) = 0._wp
+      za_i (1:ijpij,1:jpl) = 0._wp
+
+      ! ----------------------------------------
+      ! distribution over the jpl ice categories
+      ! ----------------------------------------
+      DO ji = 1, ijpij
+         
+         IF( zhti(ji) > 0._wp ) THEN
+
+            ! find which category (jl0) the input ice thickness falls into
+            jl0 = jpl
+            DO jl = 1, jpl
+               IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
+                  jl0 = jl
+                  CYCLE
+               ENDIF
+            END DO
+
+            ! initialisation of tests
+            itest(:)  = 0
+         
+            i_fill = jpl + 1                                             !====================================
+            DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories
+               ! iteration                                               !====================================
+               i_fill = i_fill - 1
+               
+               ! initialisation of ice variables for each try
+               zht_i(ji,1:jpl) = 0._wp
+               za_i (ji,1:jpl) = 0._wp
+               itest(:)        = 0      
+               
+               ! *** case very thin ice: fill only category 1
+               IF ( i_fill == 1 ) THEN
+                  zht_i(ji,1) = zhti(ji)
+                  za_i (ji,1) = zai (ji)
+                  
+               ! *** case ice is thicker: fill categories >1
+               ELSE
+
+                  ! Fill ice thicknesses in the (i_fill-1) cat by hmean 
+                  DO jl = 1, i_fill - 1
+                     zht_i(ji,jl) = hi_mean(jl)
+                  END DO
+                  
+                  ! Concentrations in the (i_fill-1) categories 
+                  za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
+                  DO jl = 1, i_fill - 1
+                     IF ( jl /= jl0 ) THEN
+                        zarg        = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
+                        za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2)
+                     ENDIF
+                  END DO
+                  
+                  ! Concentration in the last (i_fill) category
+                  za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
+                  
+                  ! Ice thickness in the last (i_fill) category
+                  zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
+                  zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 ) 
+                  
+                  ! clem: correction if concentration of upper cat is greater than lower cat
+                  !       (it should be a gaussian around jl0 but sometimes it is not)
+                  IF ( jl0 /= jpl ) THEN
+                     DO jl = jpl, jl0+1, -1
+                        IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN
+                           zdv = zht_i(ji,jl) * za_i(ji,jl)
+                           zht_i(ji,jl    ) = 0._wp
+                           za_i (ji,jl    ) = 0._wp
+                           za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 )
+                        END IF
+                     ENDDO
+                  ENDIF
+               
+               ENDIF ! case ice is thick or thin
+            
+               !---------------------
+               ! Compatibility tests
+               !--------------------- 
+               ! Test 1: area conservation
+               zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
+               IF ( zconv < epsi06 ) itest(1) = 1
+            
+               ! Test 2: volume conservation
+               zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
+               IF ( zconv < epsi06 ) itest(2) = 1
+               
+               ! Test 3: thickness of the last category is in-bounds ?
+               IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
+               
+               ! Test 4: positivity of ice concentrations
+               itest(4) = 1
+               DO jl = 1, i_fill
+                  IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0
+               END DO
+               !                                         !============================
+            END DO                                       ! end iteration on categories
+               !                                         !============================
+         ENDIF ! if zhti > 0
+      END DO ! i loop
+
+      ! ------------------------------------------------
+      ! Adding Snow in each category where za_i is not 0
+      ! ------------------------------------------------ 
+      DO jl = 1, jpl
+         DO ji = 1, ijpij
+            IF( za_i(ji,jl) > 0._wp ) THEN
+               zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
+               ! In case snow load is in excess that would lead to transformation from snow to ice
+               ! Then, transfer the snow excess into the ice (different from limthd_dh)
+               zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 ) 
+               ! recompute ht_i, ht_s avoiding out of bounds values
+               zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh )
+               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      CALL wrk_dealloc( 4, itest )
+      !
+    END SUBROUTINE lim_var_itd
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module          NO  LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_var_agg          ! Empty routines
+   END SUBROUTINE lim_var_agg
+   SUBROUTINE lim_var_glo2eqv      ! Empty routines
+   END SUBROUTINE lim_var_glo2eqv
+   SUBROUTINE lim_var_eqv2glo      ! Empty routines
+   END SUBROUTINE lim_var_eqv2glo
+   SUBROUTINE lim_var_salprof      ! Empty routines
+   END SUBROUTINE lim_var_salprof
+   SUBROUTINE lim_var_bv           ! Emtpy routines
+   END SUBROUTINE lim_var_bv
+   SUBROUTINE lim_var_salprof1d    ! Emtpy routines
+   END SUBROUTINE lim_var_salprof1d
+   SUBROUTINE lim_var_zapsmall
+   END SUBROUTINE lim_var_zapsmall
+   SUBROUTINE lim_var_itd
+   END SUBROUTINE lim_var_itd
+#endif
+
+   !!======================================================================
+END MODULE limvar
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 8732)
@@ -0,0 +1,364 @@
+MODULE limwri
+   !!======================================================================
+   !!                     ***  MODULE  limwri  ***
+   !!         Ice diagnostics :  write ice output files
+   !!======================================================================
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_wri      : write of the diagnostics variables in ouput file 
+   !!   lim_wri_state : write for initial state or/and abandon
+   !!----------------------------------------------------------------------
+   USE ioipsl
+   USE dianam          ! build name of file (routine)
+   USE phycst
+   USE dom_oce
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE ice
+   USE limvar
+   USE in_out_manager
+   USE lbclnk
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE iom
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_wri        ! routine called by lim_step.F90
+   PUBLIC lim_wri_state  ! called by dia_wri_state 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   SUBROUTINE lim_wri( kindic )
+      !!-------------------------------------------------------------------
+      !!  This routine computes the average of some variables and write it
+      !!  on the ouput files.
+      !!  ATTENTION cette routine n'est valable que si le pas de temps est
+      !!  egale a une fraction entiere de 1 jours.
+      !!  Diff 1-D 3-D : suppress common also included in etat
+      !!                 suppress cmoymo 11-18
+      !!  modif : 03/06/98
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
+      !
+      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
+      REAL(wp) ::  z1_365
+      REAL(wp) ::  z2da, z2db, ztmp
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zswi2
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, zswi    ! 2D workspace
+      !!-------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('limwri')
+
+      CALL wrk_alloc( jpi,jpj,jpl, zswi2 )
+      CALL wrk_alloc( jpi,jpj    , z2d, zswi )
+
+      !-----------------------------
+      ! Mean category values
+      !-----------------------------
+      z1_365 = 1._wp / 365._wp
+
+      ! brine volume
+      CALL lim_var_bv 
+
+      ! tresholds for outputs
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) )
+         END DO
+      END DO
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
+            END DO
+         END DO
+      END DO
+      !
+      ! fluxes
+      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
+      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface
+      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface
+      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface
+      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
+      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice
+      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )  
+      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
+         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
+      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )  
+      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )  
+      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice)
+      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice)
+
+      ! velocity
+      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 
+         DO jj = 2 , jpjm1
+            DO ji = 2 , jpim1
+               z2da  = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp
+               z2db  = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp
+               z2d(ji,jj) = SQRT( z2da * z2da + z2db * z2db )
+           END DO
+         END DO
+         CALL lbc_lnk( z2d, 'T', 1. )
+         CALL iom_put( "uice_ipa"     , u_ice      )       ! ice velocity u component
+         CALL iom_put( "vice_ipa"     , v_ice      )       ! ice velocity v component
+         CALL iom_put( "icevel"       , z2d        )       ! ice velocity module
+      ENDIF
+
+      IF ( iom_use( "tau_icebfr" ) )    CALL iom_put( "tau_icebfr"  , tau_icebfr             )  ! ice friction with ocean bottom (landfast ice)  
+      !
+      IF ( iom_use( "miceage" ) )       CALL iom_put( "miceage"     , om_i * zswi * z1_365   )  ! mean ice age
+      IF ( iom_use( "icethic_cea" ) )   CALL iom_put( "icethic_cea" , htm_i * zswi           )  ! ice thickness mean
+      IF ( iom_use( "snowthic_cea" ) )  CALL iom_put( "snowthic_cea", htm_s * zswi           )  ! snow thickness mean
+      IF ( iom_use( "micet" ) )         CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature
+      IF ( iom_use( "icest" ) )         CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature
+      IF ( iom_use( "icecolf" ) )       CALL iom_put( "icecolf"     , hicol                  )  ! frazil ice collection thickness
+      !
+      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
+      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity
+      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration
+      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell
+      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content
+      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content
+      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume
+      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point
+      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point
+      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation 
+      CALL iom_put( "micesalt"    , smt_i   * zswi      )        ! mean ice salinity
+
+      CALL iom_put( "icestr"      , strength * zswi )    ! ice strength
+      CALL iom_put( "idive"       , divu_i * 1.0e8      )    ! divergence
+      CALL iom_put( "ishear"      , shear_i * 1.0e8     )    ! shear
+      CALL iom_put( "snowvol"     , vt_s   * zswi       )        ! snow volume
+      
+      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport
+      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport
+      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport
+      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2)
+      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2)
+
+      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth
+      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melting
+      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melting
+      CALL iom_put( "sfxlam"      , sfx_lam * rday      )        ! salt flux from lateral melting
+      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation
+      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation
+      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting
+      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant)
+      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines
+      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation
+      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux
+
+      ztmp = rday / rhoic
+      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to limupdate 
+      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production
+      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production
+      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production
+      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft)
+      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt 
+      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt 
+      CALL iom_put( "vfxlam"     , wfx_lam * ztmp       )        ! lateral melt 
+      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt 
+
+      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations  
+         WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog
+         ELSEWHERE                                       ; z2d = 0._wp
+         END WHERE
+         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp )
+      ENDIF
+
+      ztmp = rday / rhosn
+      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow)
+      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt 
+      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow/ice) 
+      CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp   )        ! "excess" of sublimation sent to ocean 
+      
+      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total)
+      CALL iom_put( "afxdyn"     , afx_dyn * rday       )        ! concentration tendency (dynamics)
+      CALL iom_put( "afxthd"     , afx_thd * rday       )        ! concentration tendency (thermo)
+
+      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !  
+      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !  
+      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !  
+      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !  
+      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !  
+      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !  
+      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !  
+      CALL iom_put ('hfxerr'     , hfx_err(:,:)         )   !  
+      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !  
+      
+      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !  
+      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !  
+      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !  
+      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !  
+      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !  
+      CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base 
+      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice 
+      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip 
+
+      
+      !--------------------------------
+      ! Output values for each category
+      !--------------------------------
+      IF ( iom_use( "iceconc_cat"  ) )  CALL iom_put( "iceconc_cat"      , a_i   * zswi2   )        ! area for categories
+      IF ( iom_use( "icethic_cat"  ) )  CALL iom_put( "icethic_cat"      , ht_i  * zswi2   )        ! thickness for categories
+      IF ( iom_use( "snowthic_cat" ) )  CALL iom_put( "snowthic_cat"     , ht_s  * zswi2   )        ! snow depth for categories
+      IF ( iom_use( "salinity_cat" ) )  CALL iom_put( "salinity_cat"     , sm_i  * zswi2   )        ! salinity for categories
+      ! ice temperature
+      IF ( iom_use( "icetemp_cat"  ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 )
+      ! snow temperature
+      IF ( iom_use( "snwtemp_cat"  ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 )
+      ! ice age
+      IF ( iom_use( "iceage_cat"   ) )  CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 )
+      ! brine volume
+      IF ( iom_use( "brinevol_cat" ) )  CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 )
+
+      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
+      !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' )
+      !     not yet implemented
+      
+      CALL wrk_dealloc( jpi, jpj, jpl, zswi2 )
+      CALL wrk_dealloc( jpi, jpj     , z2d, zswi )
+
+      IF( nn_timing == 1 )  CALL timing_stop('limwri')
+      
+   END SUBROUTINE lim_wri
+
+ 
+   SUBROUTINE lim_wri_state( kt, kid, kh_i )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lim_wri_state  ***
+      !!        
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!      the instantaneous ice state and forcing fields for ice model
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! History :
+      !!   4.0  !  2013-06  (C. Rousset)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )   ::   kt               ! ocean time-step index)
+      INTEGER, INTENT( in )   ::   kid , kh_i
+      INTEGER                 ::   nz_i, jl
+      REAL(wp), DIMENSION(jpl) :: jcat
+      !!----------------------------------------------------------------------
+      DO jl = 1, jpl
+         jcat(jl) = REAL(jl)
+      ENDDO
+      
+      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up")
+
+      CALL histdef( kid, "sithic", "Ice thickness"           , "m"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "siconc", "Ice concentration"       , "%"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sitemp", "Ice temperature"         , "C"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sivelu", "i-Ice speed "            , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sivelv", "j-Ice speed "            , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa"     ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa"     ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sisflx", "Solar flux over ocean"     , "w/m2" ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sisali", "Ice salinity"            , "PSU"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sivolu", "Ice volume"              , "m"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "sidive", "Ice divergence"          , "10-8s-1",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+
+      CALL histdef( kid, "vfxbog", "Ice bottom production"   , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxdyn", "Ice dynamic production"  , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxopw", "Ice open water prod"     , "m/s"    ,   &
+      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxsni", "Snow ice production "    , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxres", "Ice prod from limupdate" , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxbom", "Ice bottom melt"         , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "vfxsum", "Ice surface melt"        , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+
+      CALL histdef( kid, "sithicat", "Ice thickness"         , "m"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "siconcat", "Ice concentration"     , "%"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sisalcat", "Ice salinity"           , ""      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sitemcat", "Ice temperature"       , "C"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "snthicat", "Snw thickness"         , "m"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "sntemcat", "Snw temperature"       , "C"      ,   &
+      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
+
+      CALL histend( kid, snc4set )   ! end of the file definition
+
+      CALL histwrite( kid, "sithic", kt, htm_i         , jpi*jpj, (/1/) )    
+      CALL histwrite( kid, "siconc", kt, at_i          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sitemp", kt, tm_i - rt0    , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sivelu", kt, u_ice          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sivelv", kt, v_ice          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sistru", kt, utau_ice       , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sistrv", kt, vtau_ice       , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sisali", kt, smt_i          , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sivolu", kt, vt_i           , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
+
+      CALL histwrite( kid, "vfxbog", kt, wfx_bog        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxdyn", kt, wfx_dyn        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxopw", kt, wfx_opw        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxsni", kt, wfx_sni        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxres", kt, wfx_res        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxbom", kt, wfx_bom        , jpi*jpj, (/1/) )
+      CALL histwrite( kid, "vfxsum", kt, wfx_sum        , jpi*jpj, (/1/) )
+
+      CALL histwrite( kid, "sithicat", kt, ht_i        , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "sisalcat", kt, sm_i        , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "sitemcat", kt, tm_i - rt0  , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "snthicat", kt, ht_s        , jpi*jpj*jpl, (/1/) )    
+      CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) )    
+
+      ! Close the file
+      ! -----------------
+      !CALL histclo( kid )
+
+    END SUBROUTINE lim_wri_state
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module          NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_wri          ! Empty routine
+   END SUBROUTINE lim_wri
+#endif
+
+   !!======================================================================
+END MODULE limwri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 8732)
@@ -0,0 +1,184 @@
+MODULE thd_ice
+   !!======================================================================
+   !!                       ***  MODULE thd_ice  ***
+   !! LIM sea-ice :   Ice thermodynamics in 1D
+   !!=====================================================================
+   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE ice, ONLY :   nlay_i, nlay_s
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90
+
+   !!-----------------------------
+   !! * Share 1D Module variables
+   !!-----------------------------
+   !: In ice thermodynamics, to spare memory, the vectors are folded
+   !: from 1D to 2D vectors. The following variables, with ending _1d
+   !: are the variables corresponding to 2d vectors
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rn_amax_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d
+
+   ! heat flux associated with ice-atmosphere mass exchange
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d
+
+   ! heat flux associated with ice-ocean mass exchange
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d  
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   evap_ice_1d   !: <==> the 2D  evap_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qprec_ice_1d  !: <==> the 2D  qprec_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qevap_ice_1d  !: <==> the 3D  qevap_ice
+   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_sub      !: Ice surface sublimation [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m)
+
+   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION thd_ice_alloc()
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE thd_ice_alloc ***
+      !!---------------------------------------------------------------------!
+      INTEGER ::   thd_ice_alloc   ! return value
+      INTEGER ::   ierr(4), ii
+      !!---------------------------------------------------------------------!
+      ierr(:) = 0
+
+      ii = 1
+      ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   &
+         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   &
+         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   &
+         &      t_bo_1d   (jpij) ,                                         &
+         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,    & 
+         &      hfx_dif_1d(jpij) , hfx_opw_1d(jpij) ,                      &
+         &      rn_amax_1d(jpij) ,                                         &
+         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) ,                      &
+         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) ,   &
+         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d    (jpij) ,                     &
+         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,                     &
+         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) ,  &
+         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  &
+         &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         &
+         &      qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0         (jpij) ,                     &  
+         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  &
+         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  &
+         &      hicol_1d   (jpij) , STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( t_su_1d   (jpij) , a_i_1d    (jpij) , ht_i_1d  (jpij) ,                      &
+         &      ht_s_1d   (jpij) , fc_su     (jpij) , fc_bo_i  (jpij) ,                      &    
+         &      dh_s_tot  (jpij) , dh_i_surf (jpij) , dh_i_sub (jpij) ,                      &    
+         &      dh_i_bott (jpij) , dh_snowice(jpij) , sm_i_1d  (jpij) , s_i_new  (jpij) ,    &
+         &      STAT=ierr(ii) )
+      !
+      ii = ii + 1
+      ALLOCATE( t_s_1d  (jpij,nlay_s)     , t_i_1d (jpij,nlay_i)     , s_i_1d(jpij,nlay_i) ,  &            
+         &      q_i_1d  (jpij,nlay_i+1)   , q_s_1d (jpij,nlay_s)     ,                        &
+         &      qh_i_old(jpij,0:nlay_i+1) , h_i_old(jpij,0:nlay_i+1) , STAT=ierr(ii) )
+      !
+      thd_ice_alloc = MAXVAL( ierr(:) )
+      IF( thd_ice_alloc /= 0 )   CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' )
+      !
+   END FUNCTION thd_ice_alloc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module          NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE thd_ice_alloc          ! Empty routine
+   END SUBROUTINE thd_ice_alloc
+#endif
+ 
+   !!======================================================================
+END MODULE thd_ice
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 8732)
@@ -0,0 +1,89 @@
+#if defined key_agrif
+!!----------------------------------------------------------------------
+!! NEMO/NST 3.6 , NEMO Consortium (2010)
+!! $Id$
+!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+!!----------------------------------------------------------------------
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+END SUBROUTINE Agrif2model
+
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Set_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
+#include "SetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Set_numberofcells
+
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Get_numberofcells ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
+#include "GetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Get_numberofcells
+
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_Allocationscalls ***
+   !!--------------------------------------------- 
+   USE Agrif_Grids 
+#include "include_use_Alloc_agrif.h"
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+#include "allocations_calls_agrif.h"
+
+END SUBROUTINE Agrif_Allocationcalls
+
+SUBROUTINE Agrif_probdim_modtype_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_probdim_modtype_def ***
+   !!--------------------------------------------- 
+   USE Agrif_Types
+   IMPLICIT NONE
+
+#include "modtype_agrif.h"
+#include "probdim_agrif.h"
+#include "keys_agrif.h"
+
+   RETURN
+
+END SUBROUTINE Agrif_probdim_modtype_def
+
+SUBROUTINE Agrif_clustering_def()
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif_clustering_def ***
+   !!--------------------------------------------- 
+   IMPLICIT NONE
+
+   RETURN
+
+END SUBROUTINE Agrif_clustering_def
+
+#else
+SUBROUTINE Agrif2Model
+   !!---------------------------------------------
+   !!   *** ROUTINE Agrif2Model ***
+   !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
+#endif
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90	(revision 8732)
@@ -0,0 +1,80 @@
+MODULE agrif_ice
+   !!======================================================================
+   !!                       ***  MODULE agrif_ice  ***
+   !! AGRIF :   define in memory AGRIF variables for sea-ice
+   !!----------------------------------------------------------------------
+   !! History :  3.4  ! 2012-08  (R. Benshila)  Original code
+   !!            3.6  ! 2016-05  (C. Rousset)   Add LIM3 compatibility
+   !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!----------------------------------------------------------------------
+   USE par_oce      ! ocean parameters
+   
+   IMPLICIT NONE
+   PRIVATE 
+
+   PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90
+
+   INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id
+   REAL(wp), PUBLIC :: lim_nbstep = 0.    ! child time position in sea-ice model
+#if defined key_lim2_vp
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)     :: u_ice_nst, v_ice_nst   
+#else
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: u_ice_oe, u_ice_sn     !: boundaries arrays
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:  "          " 
+#endif
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:  "          "
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3.4 , NEMO Consortium (2012)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS 
+
+   INTEGER FUNCTION agrif_ice_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION agrif_ice_alloc  ***
+      !!----------------------------------------------------------------------
+#if defined key_lim2_vp
+      ALLOCATE( u_ice_nst(jpi,jpj), v_ice_nst(jpi,jpj) ,   &
+#else
+      ALLOCATE( u_ice_oe(4,jpj,2) , v_ice_oe(4,jpj,2) ,    &
+         &      u_ice_sn(jpi,4,2) , v_ice_sn(jpi,4,2) ,    &
+#endif
+         &      adv_ice_oe (4,jpj,7,2) , adv_ice_sn (jpi,4,7,2) ,   &
+         &      STAT = agrif_ice_alloc)
+
+#if ! defined key_lim2_vp
+      u_ice_oe(:,:,:) =  0.e0
+      v_ice_oe(:,:,:) =  0.e0
+      u_ice_sn(:,:,:) =  0.e0
+      v_ice_sn(:,:,:) =  0.e0
+#endif
+      adv_ice_oe (:,:,:,:) = 0.e0 
+      adv_ice_sn (:,:,:,:) = 0.e0 
+      !
+   END FUNCTION agrif_ice_alloc
+
+#elif defined key_agrif && defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!----------------------------------------------------------------------   
+   IMPLICIT NONE
+   PRIVATE 
+
+   INTEGER, PUBLIC ::  u_ice_id, v_ice_id, tra_ice_id
+   INTEGER, PUBLIC ::  lim_nbstep = 0    ! child time position in sea-ice model
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.6 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#endif
+   !!======================================================================
+END MODULE agrif_ice
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90	(revision 8732)
@@ -0,0 +1,662 @@
+MODULE agrif_lim2_interp
+   !!======================================================================
+   !!                       ***  MODULE agrif_lim2_update ***
+   !! Nesting module :  update surface ocean boundary condition over ice
+   !!                   from a child grif
+   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
+   !!======================================================================
+   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
+   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
+   !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_lim2 
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
+   !!   'key_agrif' :                                 AGRIF library
+   !!----------------------------------------------------------------------
+   !!   agrif_interp_lim2   : update sea-ice model on boundaries or total
+   !!                         sea-ice area
+   !!  agrif_rhg_lim2_load  : interpolcation of ice velocities using Agrif
+   !!  agrif_rhg_lim2       : sub-interpolation of ice velocities for both 
+   !!                         splitting time and sea-ice time step
+   !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice 
+   !!  agrif_interp_u_ice   : atomic routine to interpolate v_ice 
+   !!  agrif_trp_lim2_load  : interpolcation of ice properties using Agrif
+   !!  agrif_trp_lim2       : sub-interpolation of ice properties for  
+   !!                         sea-ice time step
+   !!  agrif_interp_u_ice   : atomic routine to interpolate ice properties 
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE dom_oce
+   USE sbc_oce
+   USE ice_2
+   USE dom_ice_2
+   USE agrif_ice
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC agrif_rhg_lim2_load, agrif_rhg_lim2
+   PUBLIC agrif_trp_lim2_load, agrif_trp_lim2
+   PUBLIC interp_u_ice, interp_v_ice
+   PUBLIC interp_adv_ice
+
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.4 , NEMO Consortium (2012)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_lim2_vp
+   SUBROUTINE agrif_rhg_lim2_load
+      !!-----------------------------------------------------------------------
+      !!              *** ROUTINE agrif_rhg_lim2_load ***
+      !!
+      !!  ** Method  : need a special routine for dealing with exchanging data
+      !! between the child and parent grid during ice step
+      !!
+      !!-----------------------------------------------------------------------
+      !
+      IF (Agrif_Root()) RETURN
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .FALSE.
+      u_ice_nst(:,:) = 0.
+      v_ice_nst(:,:) = 0.
+      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. )
+      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. )
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE agrif_rhg_lim2_load
+
+
+   SUBROUTINE agrif_rhg_lim2(pu_n,pv_n)
+      !!-----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_rhg_lim2 ***
+      !!
+      !!  ** Method  : we feel the boundaries with values stored above
+      !!-----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,0:jpj+1), INTENT(inout) :: pu_n, pv_n
+      !!
+      REAL(wp) :: zrhox, zrhoy
+      INTEGER :: ji,jj
+      !!-----------------------------------------------------------------------
+      !
+      IF (Agrif_Root()) RETURN
+
+      zrhox = Agrif_Rhox()
+      zrhoy = Agrif_Rhoy()
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=2,jpj
+            pu_n(3,jj) = u_ice_nst(3,jj)/(zrhoy*e2f(2,jj-1))*tmu(3,jj)
+         END DO
+         DO jj=2,jpj
+            pv_n(3,jj) = v_ice_nst(3,jj)/(zrhox*e1f(2,jj-1))*tmu(3,jj)
+         END DO
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=2,jpj
+            pu_n(nlci-1,jj) = u_ice_nst(nlci-1,jj)/(zrhoy*e2f(nlci-2,jj-1))*tmu(nlci-1,jj)
+         END DO
+         DO jj=2,jpj
+            pv_n(nlci-1,jj) = v_ice_nst(nlci-1,jj)/(zrhox*e1f(nlci-2,jj-1))*tmu(nlci-1,jj)
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=2,jpi
+            pv_n(ji,3) = v_ice_nst(ji,3)/(zrhox*e1f(ji-1,2))*tmu(ji,3)
+         END DO
+         DO ji=2,jpi
+            pu_n(ji,3) = u_ice_nst(ji,3)/(zrhoy*e2f(ji-1,2))*tmu(ji,3)
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=2,jpi
+            pv_n(ji,nlcj-1) = v_ice_nst(ji,nlcj-1)/(zrhox*e1f(ji-1,nlcj-2))*tmu(ji,nlcj-1)
+         END DO
+         DO ji=2,jpi
+            pu_n(ji,nlcj-1) = u_ice_nst(ji,nlcj-1)/(zrhoy*e2f(ji-1,nlcj-2))*tmu(ji,nlcj-1)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE agrif_rhg_lim2
+
+#else
+   SUBROUTINE agrif_rhg_lim2_load
+      !!-----------------------------------------------------------------------
+      !!              *** ROUTINE agrif_rhg_lim2_load ***
+      !!
+      !!  ** Method  : need a special routine for dealing with exchanging data
+      !!  between the child and parent grid during ice step
+      !!               we interpolate and store the boundary if needed, ie if
+      !!  we are in inside a new parent ice time step
+      !!-----------------------------------------------------------------------
+      INTEGER :: ji,jj
+      REAL(wp) :: zrhox, zrhoy
+      !!-----------------------------------------------------------------------
+      !
+      IF (Agrif_Root()) RETURN
+
+      IF( lim_nbstep == 1. ) THEN
+         !
+         ! switch old values by hand
+         u_ice_oe(:,:,1) =  u_ice_oe(:,:,2)
+         v_ice_oe(:,:,1) =  v_ice_oe(:,:,2)
+         u_ice_sn(:,:,1) =  u_ice_sn(:,:,2)
+         v_ice_sn(:,:,1) =  v_ice_sn(:,:,2)
+         ! interpolation of boundaries (called weight prevents AGRIF interpolation)
+         Agrif_SpecialValue=-9999.
+         Agrif_UseSpecialValue = .TRUE.
+         IF( .NOT. ALLOCATED(uice_agr) )THEN
+            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj))
+         ENDIF
+         uice_agr = 0.
+         vice_agr = 0.
+         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.)
+         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.)
+         Agrif_SpecialValue=0.
+         Agrif_UseSpecialValue = .FALSE.
+         !  
+         zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()      
+         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
+         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
+         ! fill  boundaries
+         DO jj = 1, jpj
+            DO ji = 1, 2
+               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj) 
+               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj)
+            END DO
+         END DO
+         DO jj = 1, jpj
+            v_ice_oe(2,jj,2) = vice_agr(2     ,jj) 
+            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)
+         END DO
+         DO ji = 1, jpi
+            u_ice_sn(ji,2,2) = uice_agr(ji,2     ) 
+            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)
+         END DO
+         DO jj = 1, 2
+            DO ji = 1, jpi
+               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       ) 
+               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3)
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE agrif_rhg_lim2_load
+
+
+   SUBROUTINE agrif_rhg_lim2( kiter, kitermax, cd_type)
+      !!-----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_rhg_lim2  ***
+      !!
+      !!  ** Method  : simple call to atomic routines using stored values to
+      !!  fill the boundaries depending of the position of the point and 
+      !!  computing factor for time interpolation 
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kiter, kitermax
+      CHARACTER(len=1), INTENT( in ) :: cd_type
+      !!    
+      REAL(wp) :: zalpha, zbeta
+      !!-----------------------------------------------------------------------
+      !
+      IF (Agrif_Root()) RETURN
+      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
+      zbeta  = REAL(kiter,wp) / kitermax
+      zbeta = zalpha * zbeta
+      SELECT CASE(cd_type)
+      CASE('U')
+         CALL ParcoursU( zbeta )
+      CASE('V')
+         CALL ParcoursV( zbeta )
+      END SELECT
+      !
+   END SUBROUTINE agrif_rhg_lim2
+
+
+   SUBROUTINE ParcoursU( pbeta )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE parcoursU ***
+      !!
+      !!  ** Method  : time and spatial interpolation for U-point using values
+      !!  interpolated from the coarse grid and inside dvalues     
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in) :: pbeta
+      !!
+      INTEGER :: ji, jj
+      !!-----------------------------------------------------------------------
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            DO ji=1,2
+               u_ice(ji,jj) = (1-pbeta) * u_ice_oe(ji,jj,1) + pbeta * u_ice_oe(ji,jj,2)
+            END DO
+         END DO
+         DO jj=1,jpj
+            u_ice(2,jj) = 0.25*(u_ice(1,jj)+2.*u_ice(2,jj)+u_ice(3,jj))
+            u_ice(2,jj) = u_ice(2,jj) * umask(2,jj,1)
+         END DO
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            DO ji=1,2
+               u_ice(nlci+ji-3,jj) = (1-pbeta) * u_ice_oe(ji+2,jj,1) + pbeta * u_ice_oe(ji+2,jj,2)
+            END DO
+         END DO
+         DO jj=1,jpj
+            u_ice(nlci-2,jj) = 0.25*(u_ice(nlci-3,jj)+2.*u_ice(nlci-2,jj)+u_ice(nlci-1,jj))
+            u_ice(nlci-2,jj) = u_ice(nlci-2,jj) * umask(nlci-2,jj,1)
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            u_ice(ji,2) = (1-pbeta) * u_ice_sn(ji,2,1) + pbeta * u_ice_sn(ji,2,2)
+            u_ice(ji,2) = u_ice(ji,2)*umask(ji,2,1)
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            u_ice(ji,nlcj-1) = (1-pbeta) * u_ice_sn(ji,4,1) + pbeta * u_ice_sn(ji,4,2)
+            u_ice(ji,nlcj-1) = u_ice(ji,nlcj-1)*umask(ji,nlcj-1,1)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE ParcoursU
+
+
+   SUBROUTINE ParcoursV( pbeta )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE parcoursV ***
+      !! 
+      !!  ** Method  : time and spatial interpolation for V-point using values
+      !!  interpolated from the coarse grid and inside dvalues     
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in) :: pbeta
+      !!
+      INTEGER :: ji, jj
+      !!-----------------------------------------------------------------------
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            v_ice(2,jj) = (1-pbeta) * v_ice_oe(2,jj,1) + pbeta * v_ice_oe(2,jj,2)
+            v_ice(2,jj) = v_ice(2,jj) * vmask(2,jj,1)
+         END DO
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            v_ice(nlci-1,jj) = (1-pbeta) * v_ice_oe(4,jj,1) + pbeta * v_ice_oe(4,jj,2)
+            v_ice(nlci-1,jj) = v_ice(nlci-1,jj)*vmask(nlci-1,jj,1)
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO jj=1,2
+            DO ji=1,jpi
+               v_ice(ji,jj) = (1-pbeta) * v_ice_sn(ji,jj,1) + pbeta * v_ice_sn(ji,jj,2)
+            END DO
+         END DO
+         DO ji=1,jpi
+            v_ice(ji,2)=0.25*(v_ice(ji,1)+2.*v_ice(ji,2)+v_ice(ji,3))
+            v_ice(ji,2)=v_ice(ji,2)*vmask(ji,2,1)
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO jj=1,2
+            DO ji=1,jpi
+               v_ice(ji,nlcj+jj-3) = (1-pbeta) * v_ice_sn(ji,jj+2,1) + pbeta * v_ice_sn(ji,jj+2,2)
+            END DO
+         END DO
+         DO ji=1,jpi
+            v_ice(ji,nlcj-2)=0.25*(v_ice(ji,nlcj-3)+2.*v_ice(ji,nlcj-2)+v_ice(ji,nlcj-1))
+            v_ice(ji,nlcj-2) = v_ice(ji,nlcj-2) * vmask(ji,nlcj-2,1)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE ParcoursV
+# endif
+   SUBROUTINE agrif_trp_lim2_load
+      !!-----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_trp_lim2_load ***
+      !!
+      !!  ** Method  : need a special routine for dealing with exchanging data
+      !!  between the child and parent grid during ice step
+      !!               we interpolate and store the boundary if needed, ie if
+      !!  we are in inside a new parent ice time step
+     !!-----------------------------------------------------------------------
+      INTEGER :: ji,jj,jn
+      !!-----------------------------------------------------------------------
+      !
+      IF (Agrif_Root()) RETURN
+      IF( lim_nbstep == 1. ) THEN
+         !
+         ! switch old values
+         adv_ice_oe(:,:,:,1) =  adv_ice_oe(:,:,:,2)
+         adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
+         ! interpolation of boundaries
+         IF(.NOT.ALLOCATED(tabice_agr))THEN
+            ALLOCATE(tabice_agr(jpi,jpj,7))   
+         ENDIF
+         tabice_agr(:,:,:) = 0.
+         Agrif_SpecialValue=-9999.
+         Agrif_UseSpecialValue = .TRUE.
+         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
+         Agrif_SpecialValue=0.
+         Agrif_UseSpecialValue = .FALSE.
+         !  
+         ! fill  boundaries
+         DO jn =1,7
+            DO jj = 1, jpj
+               DO ji=1,2
+                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn) 
+                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn)
+               END DO
+            END DO
+         END DO
+
+         Do jn =1,7
+            Do jj =1,2
+               DO ji = 1, jpi
+                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn) 
+                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn)
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE agrif_trp_lim2_load
+
+
+   SUBROUTINE agrif_trp_lim2
+      !!-----------------------------------------------------------------------
+      !!                  *** ROUTINE agrif_trp_lim2 ***
+      !!
+      !!  ** Method  : time coefficient and call to atomic routines
+      !!-----------------------------------------------------------------------
+      INTEGER :: ji,jj,jn
+      REAL(wp) :: zalpha
+      !!-----------------------------------------------------------------------      
+      !
+      IF (Agrif_Root()) RETURN
+
+      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
+      !
+      tabice_agr(:,:,:) = 0.e0
+      DO jn =1,7
+         DO jj =1,2
+            DO ji = 1, jpi
+               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
+               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
+            END DO
+         END DO
+      END DO
+
+      DO jn =1,7
+         DO jj = 1, jpj
+            DO ji=1,2
+               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
+               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
+            END DO
+         END DO
+      END DO
+      !
+      CALL parcoursT( tabice_agr(:,:, 1), frld  )
+      CALL parcoursT( tabice_agr(:,:, 2), hicif )
+      CALL parcoursT( tabice_agr(:,:, 3), hsnif )
+      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) )
+      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) )
+      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) )
+      CALL parcoursT( tabice_agr(:,:, 7), qstoif )
+      !
+   END SUBROUTINE agrif_trp_lim2
+
+
+   SUBROUTINE parcoursT ( pinterp, pfinal )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE parcoursT ***
+      !!
+      !!  ** Method  : fill boundaries for T points
+      !!-----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)    :: pinterp
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pfinal
+      !!
+      REAL(wp) :: zbound, zvbord
+      REAL(wp), DIMENSION(jpi,jpj) ::  zui_u, zvi_v
+      INTEGER :: ji, jj
+      !!-----------------------------------------------------------------------
+      !
+      zui_u = 0.e0
+      zvi_v = 0.e0
+      ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.
+      zbound=0.
+      zvbord = 1.0 + ( 1.0 - zbound )
+#if defined key_lim2_vp
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            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
+#else
+      zui_u(:,:) = u_ice(:,:)
+      zvi_v(:,:) = v_ice(:,:)
+#endif
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            !            IF (zui_u(2,jj).EQ.0.) THEN
+            !               pfinal (2,jj) = pfinal (1,jj) * tms(2,jj)
+            !            ELSE
+            pfinal(2,jj) = 0.25* pinterp(1,jj) + 0.5 *  pinterp(2,jj) + 0.25 *pfinal(3,jj)
+            !            ENDIF
+         END DO
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            !            IF (zvi_v(ji,2).EQ.0.) THEN
+            !               pfinal (ji,2) = pfinal (ji,1) * tms(ji,2)
+            !            ELSE
+            pfinal(ji,2) = 0.25* pinterp(ji,1) + 0.5 *  pinterp(ji,2) + 0.25 *pfinal(ji,3)
+            !            ENDIF 
+         END DO
+      ENDIF
+
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            !            IF (zui_u(nlci-2,jj).EQ.0.) THEN
+            !               pfinal(nlci-1,jj) = pfinal (nlci,jj) * tms(nlci-1,jj)
+            !            ELSE
+            pfinal(nlci-1,jj) = 0.25* pinterp(nlci,jj) + 0.5 *  pinterp(nlci-1,jj) + 0.25 *pfinal(nlci-2,jj)
+            !           ENDIF
+         END DO
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            !            IF (zvi_v(ji,nlcj-2).EQ.0.) THEN
+            !               pfinal (ji,nlcj-1) =  pfinal(ji,nlcj) * tms(ji,nlcj-1)
+            !            ELSE
+            pfinal(ji,nlcj-1) = 0.25* pinterp(ji,nlcj) + 0.5 *  pinterp(ji,nlcj-1) + 0.25 *pfinal(ji,nlcj-2)
+            !            ENDIF
+         END DO
+      ENDIF
+
+
+      pfinal (:,:) = pfinal (:,:) * tms(:,:)
+      ! 
+   END SUBROUTINE parcoursT
+
+
+   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                     *** ROUTINE interp_u_ice ***
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji,jj
+      !!-----------------------------------------------------------------------
+      !
+#if defined key_lim2_vp
+      IF( before ) THEN
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               IF( tmu(ji,jj) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ELSE
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               uice_agr(ji,jj) = tabres(ji,jj)
+            END DO
+         END DO
+      ENDIF
+#else
+      IF( before ) THEN
+         DO jj= j1, j2
+            DO ji= i1, i2
+               IF( umask(ji,jj,1) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ELSE
+         DO jj= j1, j2
+            DO ji= i1, i2
+               uice_agr(ji,jj) = tabres(ji,jj)
+            END DO
+         END DO
+      ENDIF
+#endif
+   END SUBROUTINE interp_u_ice
+
+
+   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE interp_v_ice ***
+      !!-----------------------------------------------------------------------      
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      !!-----------------------------------------------------------------------
+      !
+#if defined key_lim2_vp
+      IF( before ) THEN
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               IF( tmu(ji,jj) == 0. ) THEN
+                  tabres(ji,jj) = -9999.
+               ELSE
+                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      ELSE
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               vice_agr(ji,jj) = tabres(ji,jj)
+            END DO
+         END DO
+      ENDIF   
+#else
+      IF( before ) THEN
+	      DO jj= j1 ,j2
+	         DO ji = i1, i2
+	            IF( vmask(ji,jj,1) == 0. ) THEN
+	               tabres(ji,jj) = -9999.
+	            ELSE
+	               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
+	            ENDIF
+	         END DO
+	      END DO
+      ELSE
+	      DO jj= j1 ,j2
+	         DO ji = i1, i2
+	            vice_agr(ji,jj) = tabres(ji,jj)
+	         END DO
+	      END DO
+      ENDIF
+#endif
+   END SUBROUTINE interp_v_ice
+
+
+   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE interp_adv_ice ***                           
+      !!
+      !! ** Purpose : fill an array with  ice variables
+      !!              to be advected
+      !!              put -9999 where no ice for correct extrapolation             
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj, jk
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         DO jj=j1,j2
+	    DO ji=i1,i2
+	       IF( tms(ji,jj) == 0. ) THEN
+	          tabres(ji,jj,:) = -9999 
+	       ELSE
+	          tabres(ji,jj, 1) = frld  (ji,jj)
+	          tabres(ji,jj, 2) = hicif (ji,jj)
+	          tabres(ji,jj, 3) = hsnif (ji,jj)
+	          tabres(ji,jj, 4) = tbif  (ji,jj,1)
+	          tabres(ji,jj, 5) = tbif  (ji,jj,2)
+	          tabres(ji,jj, 6) = tbif  (ji,jj,3)
+	          tabres(ji,jj, 7) = qstoif(ji,jj)
+	       ENDIF
+	    END DO
+         END DO
+      ELSE
+	 DO jj=j1,j2
+	    DO ji=i1,i2
+               DO jk=k1, k2
+	          tabice_agr(ji,jj,jk) = tabres(ji,jj,jk)
+               END DO
+	    END DO
+	 END DO
+      ENDIF
+      !
+   END SUBROUTINE interp_adv_ice
+
+#else
+CONTAINS
+   SUBROUTINE agrif_lim2_interp_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_lim2_interp_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_lim2_interp : You should not have seen this print! error?'
+   END SUBROUTINE agrif_lim2_interp_empty
+#endif
+END MODULE agrif_lim2_interp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90	(revision 8732)
@@ -0,0 +1,264 @@
+#define TWO_WAY
+
+MODULE agrif_lim2_update
+   !!======================================================================
+   !!                       ***  MODULE agrif_lim2_update ***
+   !! Nesting module :  update surface ocean boundary condition over ice
+   !!                   from a child grif
+   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
+   !!======================================================================
+   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
+   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
+   !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
+   !!   'key_agrif' :                                 AGRIF library 
+   !!----------------------------------------------------------------------
+   !!   agrif_update_lim2  : update sea-ice model on boundaries or total
+   !!                        sea-ice area for velocities and ice properties
+   !!   update_adv_ice     : sea-ice properties
+   !!   update_u_ice       : zonal ice velocity
+   !!   update_v_ice       : meridional ice velocity
+   !!----------------------------------------------------------------------
+   USE ice_2
+   USE dom_ice_2
+   USE sbc_oce
+   USE dom_oce
+   USE agrif_oce
+   USE agrif_ice 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC agrif_update_lim2
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.4 , LOCEAN-IPSL (2012)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE agrif_update_lim2 ( kt )
+      !!----------------------------------------------------------------------
+      !!                     *** ROUTINE agrif_update_lim2 ***
+      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or
+      !!                the entire domain 
+      !!
+      !! ** Action : - Update (u_ice,v_ice) and ice tracers
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt
+      !!
+      !!----------------------------------------------------------------------
+      !
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+# if defined TWO_WAY
+      IF( MOD(nbcline,nbclineupdate) == 0) THEN
+         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
+      ELSE
+         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
+      ENDIF
+# endif
+      !
+   END SUBROUTINE agrif_update_lim2
+
+
+   SUBROUTINE update_adv_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                        *** ROUTINE update_adv_ice ***
+      !! ** Method  : Compute the mass properties on the fine grid and recover
+      !!              the properties per mass on the coarse grid
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhox, zrhoy
+      REAL(wp) :: z1_area
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhox = Agrif_Rhox()
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj, 1) = frld  (ji,jj  ) * area(ji,jj)
+               tabres(ji,jj, 2) = hicif (ji,jj  ) * area(ji,jj)
+               tabres(ji,jj, 3) = hsnif (ji,jj  ) * area(ji,jj)
+               tabres(ji,jj, 4) = tbif  (ji,jj,1) * area(ji,jj)
+               tabres(ji,jj, 5) = tbif  (ji,jj,2) * area(ji,jj)
+               tabres(ji,jj, 6) = tbif  (ji,jj,3) * area(ji,jj)
+               tabres(ji,jj, 7) = qstoif(ji,jj  ) * area(ji,jj)
+            END DO
+         END DO
+         tabres = zrhox * zrhoy * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               z1_area = 1. / area(ji,jj) * tms(ji,jj)
+               frld  (ji,jj)   = tabres(ji,jj, 1) * z1_area
+               hicif (ji,jj)   = tabres(ji,jj, 2) * z1_area
+               hsnif (ji,jj)   = tabres(ji,jj, 3) * z1_area
+               tbif  (ji,jj,1) = tabres(ji,jj, 4) * z1_area
+               tbif  (ji,jj,2) = tabres(ji,jj, 5) * z1_area
+               tbif  (ji,jj,3) = tabres(ji,jj, 6) * z1_area
+               qstoif(ji,jj)   = tabres(ji,jj, 7) * z1_area
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_adv_ice
+
+
+# if defined key_lim2_vp
+   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                        *** ROUTINE update_u_ice ***
+      !! ** Method  : Update the fluxes and recover the properties (B-grid)
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhoy
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
+            END DO
+         END DO
+         tabres = zrhoy * tabres
+      ELSE
+         DO jj= MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               u_ice(ji,jj) = tabres(ji,jj) / (e2f(ji-1,jj-1))
+               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_u_ice
+
+
+   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE update_v_ice ***
+      !! ** Method  : Update the fluxes and recover the properties (B-grid)
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhox
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhox = Agrif_Rhox()
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
+            END DO
+         END DO
+         tabres = zrhox * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               v_ice(ji,jj) = tabres(ji,jj) / (e1f(ji-1,jj-1))
+               v_ice(ji,jj) = v_ice(ji,jj) * tmu(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_v_ice
+# else
+   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                        *** ROUTINE update_u_ice ***
+      !! ** Method  : Update the fluxes and recover the properties (C-grid)
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhoy
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
+            END DO
+         END DO
+         tabres = zrhoy * tabres
+      ELSE
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj))
+               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE update_u_ice
+
+
+   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE update_v_ice ***
+      !! ** Method  : Update the fluxes and recover the properties (C-grid)
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhox
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhox = Agrif_Rhox()
+         DO jj=MAX(j1,2),j2
+            DO ji=MAX(i1,2),i2
+               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
+            END DO
+         END DO
+         tabres = zrhox * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               v_ice(ji,jj) = tabres(ji,jj) / (e1v(ji,jj))
+               v_ice(ji,jj) = v_ice(ji,jj) * tmv(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_v_ice
+# endif
+
+#else
+CONTAINS
+   SUBROUTINE agrif_lim2_update_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_lim2_update_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_lim2_update : You should not have seen this print! error?'
+   END SUBROUTINE agrif_lim2_update_empty
+#endif
+END MODULE agrif_lim2_update
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90	(revision 8732)
@@ -0,0 +1,337 @@
+MODULE agrif_lim3_interp
+   !!=====================================================================================
+   !!                       ***  MODULE agrif_lim3_interp ***
+   !! Nesting module :  interp surface ice boundary condition from a parent grid
+   !! Sea-Ice model  :  LIM 3.6 Sea ice model time-stepping
+   !!=====================================================================================
+   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
+   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
+   !!            3.6   !  05-2016  (C. Rousset)  Add LIM3 compatibility
+   !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_lim3 
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'  :                                 LIM 3.6 sea-ice model
+   !!   'key_agrif' :                                 AGRIF library
+   !!----------------------------------------------------------------------
+   !!  agrif_interp_lim3    : interpolation of ice at "after" sea-ice time step
+   !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice 
+   !!  agrif_interp_v_ice   : atomic routine to interpolate v_ice 
+   !!  agrif_interp_tra_ice : atomic routine to interpolate ice properties 
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE dom_oce
+   USE sbc_oce
+   USE ice
+   USE agrif_ice
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC agrif_interp_lim3
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.6 , NEMO Consortium (2016)
+   !! $Id: agrif_lim3_interp.F90 6204 2016-01-04 13:47:06Z cetlod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE agrif_interp_lim3( cd_type, kiter, kitermax )
+      !!-----------------------------------------------------------------------
+      !!                 *** ROUTINE agrif_rhg_lim3  ***
+      !!
+      !!  ** Method  : simple call to atomic routines using stored values to
+      !!  fill the boundaries depending of the position of the point and
+      !!  computing factor for time interpolation
+      !!-----------------------------------------------------------------------
+      CHARACTER(len=1), INTENT( in )           :: cd_type
+      INTEGER         , INTENT( in ), OPTIONAL :: kiter, kitermax
+      !!
+      REAL(wp) :: zbeta
+      !!-----------------------------------------------------------------------
+      !
+      IF( Agrif_Root() )  RETURN
+      !
+      SELECT CASE(cd_type)
+      CASE('U','V')
+         IF( PRESENT( kiter ) ) THEN  ! interpolation at the child sub-time step (only for ice rheology)
+            zbeta = ( REAL(lim_nbstep) - REAL(kitermax - kiter) / REAL(kitermax) ) /  &
+               &    ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
+         ELSE                         ! interpolation at the child time step
+            zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
+         ENDIF
+      CASE('T')
+            zbeta = REAL(lim_nbstep-1) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
+      END SELECT
+      !
+      Agrif_SpecialValue=-9999.
+      Agrif_UseSpecialValue = .TRUE.
+      SELECT CASE(cd_type)
+      CASE('U')
+         CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta )
+      CASE('V')
+         CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta )
+      CASE('T')
+         CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta )
+      END SELECT
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE agrif_interp_lim3
+
+   !!------------------
+   !! Local subroutines
+   !!------------------
+   SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                     *** ROUTINE interp_u_ice ***
+      !!
+      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
+      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
+      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL , INTENT(in) :: before
+      !!
+      REAL(wp) :: zrhoy
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN  ! parent grid
+         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2)
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+      ELSE               ! child grid
+         zrhoy = Agrif_Rhoy()
+         u_ice(i1:i2,j1:j2) = ptab(:,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
+      ENDIF
+      !
+   END SUBROUTINE interp_u_ice
+
+
+   SUBROUTINE interp_v_ice( ptab, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE interp_v_ice ***
+      !!
+      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
+      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
+      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !!-----------------------------------------------------------------------      
+      INTEGER , INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL , INTENT(in) :: before
+      !!
+      REAL(wp) :: zrhox
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN  ! parent grid
+         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2)
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+      ELSE               ! child grid
+         zrhox = Agrif_Rhox()
+         v_ice(i1:i2,j1:j2) = ptab(:,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
+      ENDIF
+      !
+   END SUBROUTINE interp_v_ice
+
+
+   SUBROUTINE interp_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE interp_tra_ice ***                           
+      !!
+      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
+      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
+      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
+      !!-----------------------------------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2
+      LOGICAL , INTENT(in) :: before
+      INTEGER , INTENT(in) :: nb, ndir
+      !!
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab
+      INTEGER  ::   ji, jj, jk, jl, jm
+      INTEGER  ::   imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
+      LOGICAL  ::   western_side, eastern_side, northern_side, southern_side
+
+      !!-----------------------------------------------------------------------
+      ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy
+      ! and it is ok since we conserve tracers (same as in the ocean).
+      ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )
+     
+      IF( before ) THEN  ! parent grid
+         jm = 1
+         DO jl = 1, jpl
+            ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1
+            DO jk = 1, nlay_s
+               ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+            ENDDO
+            DO jk = 1, nlay_i
+               ptab(i1:i2,j1:j2,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+            ENDDO
+         ENDDO
+         
+         DO jk = k1, k2
+            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999.
+         ENDDO
+         
+      ELSE               ! child grid
+!! ==> The easiest interpolation is the following commented lines
+         jm = 1
+         DO jl = 1, jpl
+            a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            DO jk = 1, nlay_s
+               e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            ENDDO
+            DO jk = 1, nlay_i
+               e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            ENDDO
+         ENDDO
+
+!! ==> this is a more complex interpolation since we mix solutions over a couple of grid points
+!!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
+!!        clem: for some reason (I don't know why), the following lines do not work 
+!!              with mpp (or in realistic configurations?). It makes the model crash
+!         ! record ztab
+!         jm = 1
+!         DO jl = 1, jpl
+!            ztab(:,:,jm) = a_i  (:,:,jl) ; jm = jm + 1
+!            ztab(:,:,jm) = v_i  (:,:,jl) ; jm = jm + 1
+!            ztab(:,:,jm) = v_s  (:,:,jl) ; jm = jm + 1
+!            ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1
+!            ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1
+!            DO jk = 1, nlay_s
+!               ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1
+!            ENDDO
+!            DO jk = 1, nlay_i
+!               ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1
+!            ENDDO
+!         ENDDO
+!         !
+!         ! borders of the domain
+!         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
+!         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
+!         !
+!         ! spatial smoothing
+!         zrhox = Agrif_Rhox()
+!         z1 =      ( zrhox - 1. ) * 0.5 
+!         z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
+!         z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+!         z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+!         z2 = 1. - z1
+!         z4 = 1. - z3
+!         z5 = 1. - z6 - z7
+!         !
+!         ! Remove corners
+!         imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
+!         IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
+!         IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2
+!         IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
+!         IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2
+!
+!         ! smoothed fields
+!         IF( eastern_side ) THEN
+!            ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:)
+!            DO jj = jmin, jmax
+!               rswitch = 0.
+!               IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1.
+!               ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  &
+!                  &                +      umask(nlci-2,jj,1)   *  &
+!                  &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  &
+!                  &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) )
+!               ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1)
+!            END DO
+!         ENDIF
+!         ! 
+!         IF( northern_side ) THEN
+!            ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:)
+!            DO ji = imin, imax
+!               rswitch = 0.
+!               IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1.
+!               ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  &
+!                  &                +      vmask(ji,nlcj-2,1)   *  &
+!                  &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) &
+!                  &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) )
+!               ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1)
+!            END DO
+!         END IF
+!         !
+!         IF( western_side) THEN
+!            ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
+!            DO jj = jmin, jmax
+!               rswitch = 0.
+!               IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
+!               ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
+!                  &           +      umask(2,jj,1)   *   &
+!                  &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
+!                  &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
+!               ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
+!            END DO
+!         ENDIF
+!         !
+!         IF( southern_side ) THEN
+!            ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
+!            DO ji = imin, imax
+!               rswitch = 0.
+!               IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
+!               ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
+!                  &           +      vmask(ji,2,1)   *  &
+!                  &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
+!                  &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
+!               ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
+!            END DO
+!         END IF
+!         !
+!         ! Treatment of corners
+!         IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south
+!         IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north
+!         IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south
+!         IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north
+!
+!         ! retrieve ice tracers
+!         jm = 1
+!         DO jl = 1, jpl
+!            a_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            v_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            v_s  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            DO jk = 1, nlay_s
+!               e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            ENDDO
+!            DO jk = 1, nlay_i
+!               e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1
+!            ENDDO
+!         ENDDO
+       
+         ! integrated values
+         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
+         vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 )
+         at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 )
+         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
+         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
+
+      ENDIF
+      
+      DEALLOCATE( ztab )
+      !
+   END SUBROUTINE interp_tra_ice
+
+#else
+CONTAINS
+   SUBROUTINE agrif_lim3_interp_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_lim3_interp_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_lim3_interp : You should not have seen this print! error?'
+   END SUBROUTINE agrif_lim3_interp_empty
+#endif
+END MODULE agrif_lim3_interp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90	(revision 8732)
@@ -0,0 +1,195 @@
+#define TWO_WAY
+
+MODULE agrif_lim3_update
+   !!=====================================================================================
+   !!                       ***  MODULE agrif_lim3_update ***
+   !! Nesting module :  update surface ocean boundary condition over ice from a child grid
+   !! Sea-Ice model  :  LIM 3.6 Sea ice model time-stepping
+   !!=====================================================================================
+   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
+   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
+   !!            3.6   !  05-2016  (C. Rousset)  Add LIM3 compatibility
+   !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'  :                                 LIM 3.6 sea-ice model
+   !!   'key_agrif' :                                 AGRIF library 
+   !!----------------------------------------------------------------------
+   !!   agrif_update_lim3  : update sea-ice on boundaries or total
+   !!                        child domain for velocities and ice properties
+   !!   update_tra_ice     : sea-ice properties
+   !!   update_u_ice       : zonal      ice velocity
+   !!   update_v_ice       : meridional ice velocity
+   !!----------------------------------------------------------------------
+   USE dom_oce
+   USE sbc_oce
+   USE agrif_oce
+   USE ice
+   USE agrif_ice 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC agrif_update_lim3
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.6 , LOCEAN-IPSL (2016)
+   !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE agrif_update_lim3( kt )
+      !!----------------------------------------------------------------------
+      !!                     *** ROUTINE agrif_update_lim3 ***
+      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or the entire domain 
+      !!
+      !! ** Action : - Update (u_ice,v_ice) and ice tracers
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !! clem: I think the update should take place each time the ocean sees the surface forcings
+      !!       (but maybe I am wrong and we should update every rhot time steps) 
+      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement
+                                                                                                                           ! i.e. update only at the parent time step
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = -9999.
+# if defined TWO_WAY
+      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
+                                                ! nbcline is incremented (+1) at the end of each parent time step from 0 (1st time step)
+         CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
+      ELSE                                      ! update only the boundaries defined par locupdate
+         CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  )
+         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
+         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
+      ENDIF
+# endif
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      !
+   END SUBROUTINE agrif_update_lim3
+
+
+   !!------------------
+   !! Local subroutines
+   !!------------------
+   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!-----------------------------------------------------------------------
+      !!                        *** ROUTINE update_tra_ice ***
+      !! ** Method  : Compute the mass properties on the fine grid and recover
+      !!              the properties per mass on the coarse grid
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL , INTENT(in) :: before
+      !!
+      INTEGER  :: jk, jl, jm
+      !!-----------------------------------------------------------------------
+      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
+      IF( before ) THEN
+         jm = 1
+         DO jl = 1, jpl
+            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1
+            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1
+            DO jk = 1, nlay_s
+               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+            ENDDO
+            DO jk = 1, nlay_i
+               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
+            ENDDO
+         ENDDO
+
+         DO jk = k1, k2
+            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
+         ENDDO
+                  
+      ELSE
+         jm = 1
+         DO jl = 1, jpl
+            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            DO jk = 1, nlay_s
+               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            ENDDO
+            DO jk = 1, nlay_i
+               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
+            ENDDO
+         ENDDO
+
+         ! integrated values
+         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
+         vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 )
+         at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 )
+         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
+         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
+         
+      ENDIF
+      !
+   END SUBROUTINE update_tra_ice
+
+
+   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                        *** ROUTINE update_u_ice ***
+      !! ** Method  : Update the fluxes and recover the properties (C-grid)
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
+      LOGICAL , INTENT(in) :: before
+      !!
+      REAL(wp) :: zrhoy
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhoy = Agrif_Rhoy()
+         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
+         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+      ELSE
+         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
+      ENDIF
+      ! 
+   END SUBROUTINE update_u_ice
+
+
+   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
+      !!-----------------------------------------------------------------------
+      !!                    *** ROUTINE update_v_ice ***
+      !! ** Method  : Update the fluxes and recover the properties (C-grid)
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab
+      LOGICAL , INTENT(in) :: before
+      !!
+      REAL(wp) :: zrhox
+      !!-----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         zrhox = Agrif_Rhox()
+         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
+         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
+      ELSE
+         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
+      ENDIF
+      !
+   END SUBROUTINE update_v_ice
+
+#else
+CONTAINS
+   SUBROUTINE agrif_lim3_update_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_lim3_update_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?'
+   END SUBROUTINE agrif_lim3_update_empty
+#endif
+END MODULE agrif_lim3_update
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 8732)
@@ -0,0 +1,108 @@
+MODULE agrif_oce
+   !!======================================================================
+   !!                       ***  MODULE agrif_oce  ***
+   !! AGRIF :   define in memory AGRIF variables
+   !!----------------------------------------------------------------------
+   !! History :  2.0  ! 2007-12  (R. Benshila)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!----------------------------------------------------------------------
+   USE par_oce      ! ocean parameters
+   USE dom_oce      ! domain parameters
+
+   IMPLICIT NONE
+   PRIVATE 
+
+   PUBLIC agrif_oce_alloc ! routine called by nemo_init in nemogcm.F90
+
+   !                                              !!* Namelist namagrif: AGRIF parameters
+   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !:
+   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency 
+   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points)
+   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
+   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry 
+
+   !                                              !!! OLD namelist names
+   INTEGER , PUBLIC ::   nbcline = 0               !: update counter
+   INTEGER , PUBLIC ::   nbclineupdate             !: update frequency 
+   REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics
+
+   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator
+   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator
+   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step
+   LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE.     !: if true: send update from current grid
+   LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info
+
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn
+# if defined key_top
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn
+# endif
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities
+
+   ! Barotropic arrays used to store open boundary data during
+   ! time-splitting loop:
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s
+
+   INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update
+   INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations
+   INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates
+   INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers
+# if defined key_top
+   INTEGER :: trn_id, trn_sponge_id
+# endif  
+   INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id
+   INTEGER :: ub2b_update_id, vb2b_update_id
+   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id
+   INTEGER :: scales_t_id
+# if defined key_zdftke
+   INTEGER :: avt_id, avm_id, en_id
+# endif  
+   INTEGER :: umsk_id, vmsk_id
+   INTEGER :: kindic_agr
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3.1 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS 
+
+   INTEGER FUNCTION agrif_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION agrif_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   &
+         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   &
+         &      tabspongedone_tsn(jpi,jpj),           &
+# if defined key_top         
+         &      tabspongedone_trn(jpi,jpj),           &
+# endif         
+         &      tabspongedone_u  (jpi,jpj),           &
+         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) )
+
+      ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj),   &
+         &      ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj),   & 
+         &      ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi),   & 
+         &      ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) )
+
+      agrif_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION agrif_oce_alloc
+
+#endif
+   !!======================================================================
+END MODULE agrif_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 8732)
@@ -0,0 +1,1209 @@
+MODULE agrif_opa_interp
+   !!======================================================================
+   !!                   ***  MODULE  agrif_opa_interp  ***
+   !! AGRIF: interpolation package
+   !!======================================================================
+   !! History :  2.0  !  2002-06  (XXX)  Original cade
+   !!             -   !  2005-11  (XXX) 
+   !!            3.2  !  2009-04  (R. Benshila) 
+   !!            3.6  !  2014-09  (R. Benshila) 
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!----------------------------------------------------------------------
+   !!   Agrif_tra     :
+   !!   Agrif_dyn     : 
+   !!   interpu       :
+   !!   interpv       :
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE oce
+   USE dom_oce      
+   USE zdf_oce
+   USE agrif_oce
+   USE phycst
+   !
+   USE in_out_manager
+   USE agrif_opa_sponge
+   USE lib_mpp
+   USE wrk_nemo
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
+   PUBLIC   interpun, interpvn
+   PUBLIC   interptsn,  interpsshn
+   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b
+   PUBLIC   interpe3t, interpumsk, interpvmsk
+# if defined key_zdftke
+   PUBLIC   Agrif_tke, interpavm
+# endif
+
+   INTEGER ::   bdy_tinterp = 0
+
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE Agrif_tra
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_tra  ***
+      !!----------------------------------------------------------------------
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      !
+      CALL Agrif_Bc_variable( tsn_id, procname=interptsn )
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_tra
+
+
+   SUBROUTINE Agrif_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   kt
+      !
+      INTEGER ::   ji, jj, jk       ! dummy loop indices
+      INTEGER ::   j1, j2, i1, i2
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zub, zvb
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      CALL wrk_alloc( jpi,jpj,   zub, zvb )
+      !
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = ln_spc_dyn
+      !
+      CALL Agrif_Bc_variable( un_interp_id, procname=interpun )
+      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn )
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      !
+      ! prevent smoothing in ghost cells
+      i1 =  1   ;   i2 = jpi
+      j1 =  1   ;   j2 = jpj
+      IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 3
+      IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj-2
+      IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 3
+      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2
+
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         !
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            ua_b(2,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+               END DO
+            END DO
+            DO jj = 1, jpj
+               ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)            
+            END DO
+         ENDIF
+         !
+         DO jk=1,jpkm1                 ! Smooth
+            DO jj=j1,j2
+               ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
+               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
+            END DO
+         END DO
+         !
+         zub(2,:) = 0._wp              ! Correct transport
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
+            END DO
+         END DO
+         DO jj=1,jpj
+            zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         ! Set tangential velocities to time splitting estimate
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zvb(2,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
+               END DO
+            END DO
+            DO jj = 1, jpj
+               zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
+            END DO
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(1,jj,jk) = 0._wp
+               va(1,jj,jk) = 0._wp
+            END DO
+         END DO         
+         !
+      ENDIF
+
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            ua_b(nlci-2,:) = 0._wp
+            DO jk=1,jpkm1
+               DO jj=1,jpj
+                  ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)            
+            END DO
+         ENDIF
+
+         DO jk = 1, jpkm1              ! Smooth
+            DO jj = j1, j2
+               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
+                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
+            END DO
+         END DO
+
+         zub(nlci-2,:) = 0._wp        ! Correct transport
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
+            END DO
+         END DO
+         DO jj = 1, jpj
+            zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
+         END DO
+
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
+            END DO
+         END DO
+         !
+         ! Set tangential velocities to time splitting estimate
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zvb(nlci-1,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
+               END DO
+            END DO
+            DO jj=1,jpj
+               zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
+            END DO
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(nlci-1,jj,jk) = 0._wp
+               va(nlci  ,jj,jk) = 0._wp
+            END DO
+         END DO 
+         !
+      ENDIF
+
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            va_b(:,2) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)
+               END DO
+            END DO
+            DO ji=1,jpi
+               va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)            
+            END DO
+         ENDIF
+         !
+         DO jk = 1, jpkm1              ! Smooth
+            DO ji = i1, i2
+               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
+                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
+            END DO
+         END DO
+         !
+         zvb(:,2) = 0._wp              ! Correct transport
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
+            END DO
+         END DO
+         DO ji = 1, jpi
+            zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
+         END DO
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
+            END DO
+         END DO
+
+         ! Set tangential velocities to time splitting estimate
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zub(:,2) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
+            END DO
+
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
+               END DO
+            END DO
+         ENDIF
+
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               ua(ji,1,jk) = 0._wp
+               va(ji,1,jk) = 0._wp
+            END DO
+         END DO 
+
+      ENDIF
+
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+         !
+         ! Smoothing
+         ! ---------
+         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport
+            va_b(:,nlcj-2) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)            
+            END DO
+         ENDIF
+         !
+         DO jk = 1, jpkm1              ! Smooth
+            DO ji = i1, i2
+               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
+                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
+            END DO
+         END DO
+         !
+         zvb(:,nlcj-2) = 0._wp         ! Correct transport
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+         DO ji = 1, jpi
+            zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
+         END DO
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+         !
+         ! Set tangential velocities to time splitting estimate
+         !-----------------------------------------------------
+         IF( ln_dynspg_ts ) THEN
+            zub(:,nlcj-1) = 0._wp
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
+               END DO
+            END DO
+            DO ji = 1, jpi
+               zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
+            END DO
+            !
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Mask domain edges:
+         !-------------------
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               ua(ji,nlcj  ,jk) = 0._wp
+               va(ji,nlcj-1,jk) = 0._wp
+            END DO
+         END DO 
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   zub, zvb )
+      !
+   END SUBROUTINE Agrif_dyn
+
+
+   SUBROUTINE Agrif_dyn_ts( jn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_dyn_ts  ***
+      !!----------------------------------------------------------------------  
+      !! 
+      INTEGER, INTENT(in) ::   jn
+      !!
+      INTEGER :: ji, jj
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
+            ! Specified fluxes:
+            ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
+            ! Characteristics method:
+            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
+            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
+         END DO
+      ENDIF
+      !
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj=1,jpj
+            va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
+            ! Specified fluxes:
+            ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
+            ! Characteristics method:
+            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
+            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
+         END DO
+      ENDIF
+      !
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
+            ! Specified fluxes:
+            va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
+            ! Characteristics method:
+            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
+            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
+         END DO
+      ENDIF
+      !
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji=1,jpi
+            ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
+            ! Specified fluxes:
+            va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
+            ! Characteristics method:
+            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) &
+            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE Agrif_dyn_ts
+
+
+   SUBROUTINE Agrif_dta_ts( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_dta_ts  ***
+      !!----------------------------------------------------------------------  
+      !! 
+      INTEGER, INTENT(in) ::   kt
+      !!
+      INTEGER :: ji, jj
+      LOGICAL :: ll_int_cons
+      REAL(wp) :: zrhot, zt
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only
+      !
+      zrhot = Agrif_rhot()
+      !
+      ! "Central" time index for interpolation:
+      IF( ln_bt_fw ) THEN
+         zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot
+      ELSE
+         zt = REAL( Agrif_NbStepint()       , wp ) / zrhot
+      ENDIF
+      !
+      ! Linear interpolation of sea level
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn )
+      Agrif_UseSpecialValue = .FALSE.
+      !
+      ! Interpolate barotropic fluxes
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      !
+      IF( ll_int_cons ) THEN  ! Conservative interpolation
+         ! orders matters here !!!!!!
+         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
+         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )
+         bdy_tinterp = 1
+         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After
+         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  )
+         bdy_tinterp = 2
+         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before
+         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )         
+      ELSE ! Linear interpolation
+         bdy_tinterp = 0
+         ubdy_w(:) = 0._wp   ;   vbdy_w(:) = 0._wp 
+         ubdy_e(:) = 0._wp   ;   vbdy_e(:) = 0._wp 
+         ubdy_n(:) = 0._wp   ;   vbdy_n(:) = 0._wp 
+         ubdy_s(:) = 0._wp   ;   vbdy_s(:) = 0._wp
+         CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb )
+         CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb )
+      ENDIF
+      Agrif_UseSpecialValue = .FALSE.
+      ! 
+   END SUBROUTINE Agrif_dta_ts
+
+
+   SUBROUTINE Agrif_ssh( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   kt
+      !!
+      !!----------------------------------------------------------------------  
+      !
+      IF( Agrif_Root() )   RETURN
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         ssha(2,:)=ssha(3,:)
+         sshn(2,:)=sshn(3,:)
+      ENDIF
+      !
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         ssha(nlci-1,:)=ssha(nlci-2,:)
+         sshn(nlci-1,:)=sshn(nlci-2,:)
+      ENDIF
+      !
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         ssha(:,2)=ssha(:,3)
+         sshn(:,2)=sshn(:,3)
+      ENDIF
+      !
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         ssha(:,nlcj-1)=ssha(:,nlcj-2)
+         sshn(:,nlcj-1)=sshn(:,nlcj-2)
+      ENDIF
+      !
+   END SUBROUTINE Agrif_ssh
+
+
+   SUBROUTINE Agrif_ssh_ts( jn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_ssh_ts  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) ::   jn
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+      !
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO jj = 1, jpj
+            ssha_e(2,jj) = hbdy_w(jj)
+         END DO
+      ENDIF
+      !
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO jj = 1, jpj
+            ssha_e(nlci-1,jj) = hbdy_e(jj)
+         END DO
+      ENDIF
+      !
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO ji = 1, jpi
+            ssha_e(ji,2) = hbdy_s(ji)
+         END DO
+      ENDIF
+      !
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO ji = 1, jpi
+            ssha_e(ji,nlcj-1) = hbdy_n(ji)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE Agrif_ssh_ts
+
+# if defined key_zdftke
+
+   SUBROUTINE Agrif_tke
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_tke  ***
+      !!----------------------------------------------------------------------  
+      REAL(wp) ::   zalpha
+      !!----------------------------------------------------------------------  
+      !
+      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp )
+      IF( zalpha > 1. )   zalpha = 1.
+      !
+      Agrif_SpecialValue    = 0.e0
+      Agrif_UseSpecialValue = .TRUE.
+      !
+      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)       
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_tke
+   
+# endif
+
+   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!   *** ROUTINE interptsn ***
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab
+      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      LOGICAL                                     , INTENT(in   ) ::   before
+      INTEGER                                     , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------
+      !
+      IF (before) THEN         
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         zrhox = Agrif_Rhox()
+         ! 
+         zalpha1 = ( zrhox - 1. ) * 0.5
+         zalpha2 = 1. - zalpha1
+         ! 
+         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha4 = 1. - zalpha3
+         ! 
+         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+         zalpha5 = 1. - zalpha6 - zalpha7
+         !
+         imin = i1
+         imax = i2
+         jmin = j1
+         jmax = j2
+         ! 
+         ! Remove CORNERS
+         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+         !
+         IF( eastern_side ) THEN
+            DO jn = 1, jpts
+               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(nlci-2,jj,jk) == 0._wp ) THEN
+                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0._wp ) THEN
+                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 
+                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+               tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
+            END DO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jpts
+               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN
+                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN
+                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+               tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
+            END DO
+         ENDIF
+         !
+         IF( western_side ) THEN            
+            DO jn = 1, jpts
+               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0._wp ) THEN
+                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0._wp ) THEN
+                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+               tsa(1,j1:j2,k1:k2,jn) = 0._wp
+            END DO
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jpts
+               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk = 1, jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0._wp ) THEN
+                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0._wp ) THEN
+                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+               tsa(i1:i2,1,k1:k2,jn) = 0._wp
+            END DO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tsa(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE interptsn
+
+
+   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
+         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
+         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
+      ENDIF
+      !
+   END SUBROUTINE interpsshn
+
+
+   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!----------------------------------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                               , INTENT(in   ) ::   before
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zrhoy	
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN 
+         DO jk = k1, jpk
+            ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk)
+         END DO
+      ELSE
+         zrhoy = Agrif_Rhoy()
+         DO jk = 1, jpkm1
+            DO jj=j1,j2
+               ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) )
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE interpun
+
+
+   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!----------------------------------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!----------------------------------------------------------------------
+      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                               , INTENT(in   ) ::   before
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zrhox	
+      !!----------------------------------------------------------------------
+      !      
+      IF( before ) THEN       !interpv entre 1 et k2 et interpv2d en jpkp1
+         DO jk = k1, jpk
+            ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk)
+         END DO
+      ELSE          
+         zrhox= Agrif_Rhox()
+         DO jk = 1, jpkm1
+            va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) )
+         END DO
+      ENDIF
+      !        
+   END SUBROUTINE interpvn
+   
+
+   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpunb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER  ::   ji, jj
+      REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN 
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhoy = Agrif_Rhoy()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         ! Polynomial interpolation coefficients:
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+               &               - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
+
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !   
+         IF(western_side) THEN
+            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         IF(northern_side) THEN
+            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      ! 
+   END SUBROUTINE interpunb
+
+
+   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvnb  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER  ::   ji,jj
+      REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff   
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      ! 
+      IF( before ) THEN 
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhox = Agrif_Rhox()
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot      
+         IF( bdy_tinterp == 1 ) THEN
+            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        &
+               &               - zt0**2._wp * (       zt0 - 1._wp)        )
+         ELSEIF( bdy_tinterp == 2 ) THEN
+            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp &
+               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
+         ELSE
+            ztcoeff = 1
+         ENDIF
+         !
+         IF(western_side) THEN
+            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(eastern_side) THEN
+            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)  
+         ENDIF
+         IF(southern_side) THEN
+            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
+         ENDIF
+         IF(northern_side) THEN
+            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
+         ENDIF
+         !            
+         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
+            IF(western_side) THEN
+               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(eastern_side) THEN
+               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   &
+                     &                                  * vmask(i1,j1:j2,1)
+            ENDIF
+            IF(southern_side) THEN
+               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+            IF(northern_side) THEN
+               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   &
+                     &                                  * vmask(i1:i2,j1,1)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE interpvnb
+
+
+   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpub2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER  ::   ji,jj
+      REAL(wp) ::   zrhot, zt0, zt1,zat
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+         ! Polynomial interpolation coefficients:
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    &
+            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
+         ! 
+         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      ! 
+   END SUBROUTINE interpub2b
+   
+
+   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvb2b  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER ::   ji,jj
+      REAL(wp) ::   zrhot, zt0, zt1,zat
+      LOGICAL ::   western_side, eastern_side,northern_side,southern_side
+      !!----------------------------------------------------------------------  
+      !
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
+      ELSE      
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         zrhot = Agrif_rhot()
+         ! Time indexes bounds for integration
+         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot
+         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
+         ! Polynomial interpolation coefficients:
+         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    &
+            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    ) 
+         !
+         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
+         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 
+         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 
+      ENDIF
+      !      
+   END SUBROUTINE interpvb2b
+
+
+   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpe3t  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL                              , INTENT(in   ) :: before
+      INTEGER                              , INTENT(in   ) :: nb , ndir
+      !
+      INTEGER :: ji, jj, jk
+      LOGICAL :: western_side, eastern_side, northern_side, southern_side
+      REAL(wp) :: ztmpmsk      
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2)
+      ELSE
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+         DO jk = k1, k2
+            DO jj = j1, j2
+               DO ji = i1, i2
+                  ! Get velocity mask at boundary edge points:
+                  IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1)
+                  IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1)
+                  IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1)
+                  IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1)
+                  !
+                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
+                     ENDIF
+                     WRITE(numout,*) '      ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)
+                     kindic_agr = kindic_agr + 1
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE interpe3t
+
+
+   SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpumsk  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                              , INTENT(in   ) ::   before
+      INTEGER                              , INTENT(in   ) ::   nb , ndir
+      !
+      INTEGER ::   ji, jj, jk
+      LOGICAL ::   western_side, eastern_side   
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2)
+      ELSE
+         western_side = (nb == 1).AND.(ndir == 1)
+         eastern_side = (nb == 1).AND.(ndir == 2)
+         DO jk = k1, k2
+            DO jj = j1, j2
+               DO ji = i1, i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (western_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (eastern_side) THEN
+                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE interpumsk
+
+
+   SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpvmsk  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                              , INTENT(in   ) ::   before
+      INTEGER                              , INTENT(in   ) :: nb , ndir
+      !
+      INTEGER ::   ji, jj, jk
+      LOGICAL ::   northern_side, southern_side     
+      !!----------------------------------------------------------------------  
+      !    
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2)
+      ELSE
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         DO jk = k1, k2
+            DO jj = j1, j2
+               DO ji = i1, i2
+                   ! Velocity mask at boundary edge points:
+                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
+                     IF (southern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ELSEIF (northern_side) THEN
+                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
+                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
+                        kindic_agr = kindic_agr + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE interpvmsk
+
+# if defined key_zdftke
+
+   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interavm  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                              , INTENT(in   ) ::   before
+      !!----------------------------------------------------------------------  
+      !      
+      IF( before ) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
+      ENDIF
+      !
+   END SUBROUTINE interpavm
+
+# endif /* key_zdftke */
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Empty module                                          no AGRIF zoom
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE Agrif_OPA_Interp_empty
+      WRITE(*,*)  'agrif_opa_interp : You should not have seen this print! error?'
+   END SUBROUTINE Agrif_OPA_Interp_empty
+#endif
+
+   !!======================================================================
+END MODULE agrif_opa_interp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 8732)
@@ -0,0 +1,449 @@
+#define SPONGE && define SPONGE_TOP
+
+MODULE agrif_opa_sponge
+   !!======================================================================
+   !!                ***  MODULE agrif_opa_update  ***
+   !! AGRIF :   
+   !!======================================================================
+   !! History :  
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE in_out_manager
+   USE agrif_oce
+   USE wrk_nemo  
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
+   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE Agrif_Sponge_Tra
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Sponge_Tra ***
+      !!---------------------------------------------
+      REAL(wp) :: timecoeff
+      !!---------------------------------------------
+      !
+#if defined SPONGE
+      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+
+      CALL Agrif_Sponge
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .TRUE.
+      tabspongedone_tsn = .FALSE.
+
+      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge)
+
+      Agrif_UseSpecialValue = .FALSE.
+#endif
+      !
+   END SUBROUTINE Agrif_Sponge_Tra
+
+
+   SUBROUTINE Agrif_Sponge_dyn
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Sponge_dyn ***
+      !!---------------------------------------------
+      REAL(wp) :: timecoeff
+      !!---------------------------------------------
+
+#if defined SPONGE
+      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.         
+      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge)
+
+      tabspongedone_u = .FALSE.
+      tabspongedone_v = .FALSE.
+      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge)
+
+      Agrif_UseSpecialValue = .FALSE.
+#endif
+      !
+   END SUBROUTINE Agrif_Sponge_dyn
+
+
+   SUBROUTINE Agrif_Sponge
+      !!---------------------------------------------
+      !!   *** ROUTINE  Agrif_Sponge ***
+      !!---------------------------------------------
+      INTEGER  :: ji,jj,jk
+      INTEGER  :: ispongearea, ilci, ilcj
+      LOGICAL  :: ll_spdone
+      REAL(wp) :: z1spongearea, zramp
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp
+
+#if defined SPONGE || defined SPONGE_TOP
+      ll_spdone=.TRUE.
+      IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
+         ! Define ramp from boundaries towards domain interior
+         ! at T-points
+         ! Store it in ztabramp
+         ll_spdone=.FALSE.
+
+         CALL wrk_alloc( jpi, jpj, ztabramp )
+
+         ispongearea  = 2 + nn_sponge_len * Agrif_irhox()
+         ilci = nlci - ispongearea
+         ilcj = nlcj - ispongearea 
+         z1spongearea = 1._wp / REAL( ispongearea - 2 )
+
+         ztabramp(:,:) = 0._wp
+
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            DO jj = 1, jpj
+               IF ( umask(2,jj,1) == 1._wp ) THEN
+                 DO ji = 2, ispongearea                  
+                    ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea
+                 END DO
+               ENDIF
+            ENDDO
+         ENDIF
+
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            DO jj = 1, jpj
+               IF ( umask(nlci-2,jj,1) == 1._wp ) THEN
+                  DO ji = ilci+1,nlci-1
+                     zramp = (ji - (ilci+1) ) * z1spongearea
+                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
+                  ENDDO
+               ENDIF
+            ENDDO
+         ENDIF
+
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            DO ji = 1, jpi
+               IF ( vmask(ji,2,1) == 1._wp ) THEN
+                  DO jj = 2, ispongearea
+                     zramp = ( ispongearea-jj ) * z1spongearea
+                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
+                  END DO
+               ENDIF
+            ENDDO
+         ENDIF
+
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            DO ji = 1, jpi
+               IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN
+                  DO jj = ilcj+1,nlcj-1
+                     zramp = (jj - (ilcj+1) ) * z1spongearea
+                     ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp )
+                  END DO
+               ENDIF
+            ENDDO
+         ENDIF
+
+      ENDIF
+
+      ! Tracers
+      IF( .NOT. spongedoneT ) THEN
+         fsaht_spu(:,:) = 0._wp
+         fsaht_spv(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  ))
+               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1))
+            END DO
+         END DO
+
+         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( fsaht_spv, 'V', 1. )
+         spongedoneT = .TRUE.
+      ENDIF
+
+      ! Dynamics
+      IF( .NOT. spongedoneU ) THEN
+         fsahm_spt(:,:) = 0._wp
+         fsahm_spf(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj)
+               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) &
+                                                     &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) )
+            END DO
+         END DO
+
+         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( fsahm_spf, 'F', 1. )
+         spongedoneU = .TRUE.
+      ENDIF
+      !
+      IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )
+      !
+#endif
+      !
+   END SUBROUTINE Agrif_Sponge
+
+
+   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn_sponge ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   iku, ikv
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff
+      !
+      IF( before ) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE   
+         !
+         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)    
+         DO jn = 1, jpts            
+            DO jk = 1, jpkm1
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)
+                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
+                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  END DO
+               END DO
+               !
+               IF( ln_zps ) THEN      ! set gradient at partial step level
+                  DO jj = j1,j2-1
+                     DO ji = i1,i2-1
+                        ! last level
+                        iku = mbku(ji,jj)
+                        ikv = mbkv(ji,jj)
+                        IF( iku == jk )   ztu(ji,jj,jk) = 0._wp
+                        IF( ikv == jk )   ztv(ji,jj,jk) = 0._wp
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            !
+            DO jk = 1, jpkm1
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 
+                        zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                        ! horizontal diffusive trends
+                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  )
+                        ! add it to the general tracer trends
+                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+         !
+         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+         !
+      ENDIF
+      !
+   END SUBROUTINE interptsn_sponge
+
+
+   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun_sponge ***
+      !!---------------------------------------------    
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER :: ji,jj,jk
+
+      ! sponge parameters 
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: jmax
+      !!---------------------------------------------    
+      !
+      IF( before ) THEN
+         tabres = un(i1:i2,j1:j2,:)
+      ELSE
+         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:)
+         !
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            !                                             ! --------
+            ! Horizontal divergence                       !   div
+            !                                             ! --------
+            DO jj = j1,j2
+               DO ji = i1+1,i2   ! vector opt.
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) &
+                                     &   -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr
+               END DO
+            END DO
+
+            DO jj = j1,j2-1
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
+                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) & 
+                                    & ) * fmask(ji,jj,jk) * zbtr 
+               END DO
+            END DO
+         END DO
+         !
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+
+               IF (.NOT. tabspongedone_u(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+                     ! horizontal diffusive trends
+                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj)
+
+                     ! add it to the general momentum trends
+                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+
+                  END DO
+               ENDIF
+
+            END DO
+         END DO
+
+         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+
+         jmax = j2-1
+         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3)
+
+         DO jj = j1+1, jmax
+            DO ji = i1+1, i2   ! vector opt.
+
+               IF (.NOT. tabspongedone_v(ji,jj)) THEN
+                  DO jk = 1, jpkm1                                 ! Horizontal slab
+                     ze2u = rotdiff (ji,jj,jk)
+                     ze1v = hdivdiff(ji,jj,jk)
+
+                     ! horizontal diffusive trends
+                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
+                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj)
+
+                     ! add it to the general momentum trends
+                     va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  END DO
+               ENDIF
+               !
+            END DO
+         END DO
+         !
+         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
+         !
+      ENDIF
+      !
+   END SUBROUTINE interpun_sponge
+
+
+   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn_sponge ***
+      !!--------------------------------------------- 
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff
+      INTEGER :: imax
+      !!--------------------------------------------- 
+
+      IF( before ) THEN 
+         tabres = vn(i1:i2,j1:j2,:)
+      ELSE
+         !
+         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:)
+         !
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+
+            !                                             ! --------
+            ! Horizontal divergence                       !   div
+            !                                             ! --------
+            DO jj = j1+1,j2
+               DO ji = i1,i2   ! vector opt.
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj)
+                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  &
+                                     &  -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr
+               END DO
+            END DO
+            DO jj = j1,j2
+               DO ji = i1,i2-1   ! vector opt.
+                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj)
+                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 
+                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk)  ) * fmask(ji,jj,jk) * zbtr
+               END DO
+            END DO
+         END DO
+
+         !                                                ! ===============
+         !                                                
+
+         imax = i2-1
+         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3)
+
+         DO jj = j1+1, j2
+            DO ji = i1+1, imax   ! vector opt.
+               IF( .NOT. tabspongedone_u(ji,jj) ) THEN
+                  DO jk = 1, jpkm1
+                     ua(ji,jj,jk) = ua(ji,jj,jk)                                                               &
+                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )  &
+                        & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+         !
+         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
+         !
+         DO jj = j1+1, j2-1
+            DO ji = i1+1, i2-1   ! vector opt.
+               IF( .NOT. tabspongedone_v(ji,jj) ) THEN
+                  DO jk = 1, jpkm1
+                     va(ji,jj,jk) = va(ji,jj,jk)                                                                  &
+                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   &
+                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !
+   END SUBROUTINE interpvn_sponge
+
+#else
+CONTAINS
+   SUBROUTINE agrif_opa_sponge_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_OPA_sponge_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_opa_sponge : You should not have seen this print! error?'
+   END SUBROUTINE agrif_opa_sponge_empty
+#endif
+
+   !!======================================================================
+END MODULE agrif_opa_sponge
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 8732)
@@ -0,0 +1,656 @@
+#define TWO_WAY        /* TWO WAY NESTING */
+#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
+ 
+MODULE agrif_opa_update
+#if defined key_agrif 
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE agrif_oce
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp
+   USE wrk_nemo  
+   USE zdf_oce        ! vertical physics: ocean variables 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales
+# if defined key_zdftke
+   PUBLIC Agrif_Update_Tke
+# endif
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   RECURSIVE SUBROUTINE Agrif_Update_Tra( )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Tra ***
+      !!---------------------------------------------
+      ! 
+      IF (Agrif_Root()) RETURN
+      !
+#if defined TWO_WAY  
+      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+      ! 
+      IF (MOD(nbcline,nbclineupdate) == 0) THEN
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
+# else
+         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
+# else
+         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
+# endif
+      ENDIF
+      !
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      !
+      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
+         CALL Agrif_ChildGrid_To_ParentGrid()
+         CALL Agrif_Update_Tra()
+         CALL Agrif_ParentGrid_To_ChildGrid()
+      ENDIF
+      !
+#endif
+      !
+   END SUBROUTINE Agrif_Update_Tra
+
+
+   RECURSIVE SUBROUTINE Agrif_Update_Dyn( )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Dyn ***
+      !!---------------------------------------------
+      ! 
+      IF (Agrif_Root()) RETURN
+      !
+#if defined TWO_WAY
+      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline
+
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      Agrif_SpecialValueFineGrid = 0.
+      !     
+      IF (mod(nbcline,nbclineupdate) == 0) THEN
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
+# else
+         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
+         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
+# endif
+      ENDIF
+
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)  
+# else
+      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
+      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)  
+# endif
+
+      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN
+         ! Update time integrated transports
+         IF (mod(nbcline,nbclineupdate) == 0) THEN
+#  if ! defined DECAL_FEEDBACK
+            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
+#  else
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
+#  endif
+         ELSE
+#  if ! defined DECAL_FEEDBACK
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b)
+#  else
+            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b)
+            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b)
+#  endif
+         ENDIF
+      END IF
+      !
+      nbcline = nbcline + 1
+      !
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+# if ! defined DECAL_FEEDBACK
+      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
+# else
+      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
+# endif
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      ! 
+#endif
+      !
+      ! Do recursive update:
+      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:
+         CALL Agrif_ChildGrid_To_ParentGrid()
+         CALL Agrif_Update_Dyn()
+         CALL Agrif_ParentGrid_To_ChildGrid()
+      ENDIF
+      !
+   END SUBROUTINE Agrif_Update_Dyn
+
+# if defined key_zdftke
+
+   SUBROUTINE Agrif_Update_Tke( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Tke ***
+      !!---------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: kt
+      !       
+      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
+#  if defined TWO_WAY
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+
+      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  )
+      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT )
+      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM )
+
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+
+#  endif
+      
+   END SUBROUTINE Agrif_Update_Tke
+   
+# endif /* key_zdftke */
+
+   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji,jj,jk,jn
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)
+                  END DO
+               END DO
+            END DO
+         END DO
+      ELSE
+         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+            ! Add asselin part
+            DO jn = n1,n2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
+                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 
+                                 & + atfp * ( tabres(ji,jj,jk,jn) &
+                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                        ENDIF
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
+         DO jn = n1,n2
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
+                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE updateTS
+
+
+   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateu ***
+      !!---------------------------------------------
+      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL                               , INTENT(in   ) :: before
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zrhoy
+      !!---------------------------------------------
+      ! 
+      IF( before ) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jk = k1, k2
+            tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk)
+         END DO
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)
+                  !
+                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
+                     ub(ji,jj,jk) = ub(ji,jj,jk) & 
+                           & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)
+                  ENDIF
+                  !
+                  un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE updateu
+
+
+   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updatev ***
+      !!---------------------------------------------
+      INTEGER :: i1,i2,j1,j2,k1,k2
+      INTEGER :: ji,jj,jk
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
+      LOGICAL :: before
+      !!
+      REAL(wp) :: zrhox
+      !!---------------------------------------------      
+      !
+      IF (before) THEN
+         zrhox = Agrif_Rhox()
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)
+                  !
+                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
+                     vb(ji,jj,jk) = vb(ji,jj,jk) & 
+                           & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)
+                  ENDIF
+                  !
+                  vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE updatev
+
+
+   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updateu2d ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !! 
+      INTEGER :: ji, jj, jk
+      REAL(wp) :: zrhoy
+      REAL(wp) :: zcorr
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) =  tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj)  
+               !    
+               ! Update "now" 3d velocities:
+               spgu(ji,jj) = 0._wp
+               DO jk=1,jpkm1
+                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk)
+               END DO
+               spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj)
+               !
+               zcorr = tabres(ji,jj) - spgu(ji,jj)
+               DO jk=1,jpkm1              
+                  un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
+               END DO
+               !
+               ! Update barotropic velocities:
+               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
+                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
+                     zcorr = tabres(ji,jj) - un_b(ji,jj)
+                     ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)
+                  END IF
+               ENDIF             
+               un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1)
+               !       
+               ! Correct "before" velocities to hold correct bt component:
+               spgu(ji,jj) = 0.e0
+               DO jk=1,jpkm1
+                  spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk)
+               END DO
+               spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj)
+               !
+               zcorr = ub_b(ji,jj) - spgu(ji,jj)
+               DO jk=1,jpkm1              
+                  ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
+               END DO
+               !
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updateu2d
+
+
+   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updatev2d ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !! 
+      INTEGER :: ji, jj, jk
+      REAL(wp) :: zrhox
+      REAL(wp) :: zcorr
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         zrhox = Agrif_Rhox()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 
+            END DO
+         END DO
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) =  tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj)  
+               !    
+               ! Update "now" 3d velocities:
+               spgv(ji,jj) = 0.e0
+               DO jk=1,jpkm1
+                  spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+               spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj)
+               !
+               zcorr = tabres(ji,jj) - spgv(ji,jj)
+               DO jk=1,jpkm1              
+                  vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
+               END DO
+               !
+               ! Update barotropic velocities:
+               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN
+                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
+                     zcorr = tabres(ji,jj) - vn_b(ji,jj)
+                     vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)
+                  END IF
+               ENDIF              
+               vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1)
+               !       
+               ! Correct "before" velocities to hold correct bt component:
+               spgv(ji,jj) = 0.e0
+               DO jk=1,jpkm1
+                  spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk)
+               END DO
+               spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj)
+               !
+               zcorr = vb_b(ji,jj) - spgv(ji,jj)
+               DO jk=1,jpkm1              
+                  vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
+               END DO
+               !
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE updatev2d
+
+
+   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updateSSH ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      !!---------------------------------------------
+      ! 
+      IF (before) THEN
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = sshn(ji,jj)
+            END DO
+         END DO
+      ELSE
+         IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN
+            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                     sshb(ji,jj) =   sshb(ji,jj) &
+                           & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         DO jj=j1,j2
+            DO ji=i1,i2
+               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updateSSH
+
+
+   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updateub2b ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhoy
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+         tabres = zrhoy * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updateub2b
+
+
+   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updatevb2b ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhox
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         zrhox = Agrif_Rhox()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj) 
+            END DO
+         END DO
+         tabres = zrhox * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE updatevb2b
+
+
+   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
+      ! currently not used
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, iNTENT(in) :: before
+      !
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: ztemp
+      !!---------------------------------------------
+
+      IF (before) THEN
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
+                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
+         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
+         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 
+                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
+                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
+                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
+                     print *,'CORR = ',ztemp-1.
+                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
+                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
+                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
+                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
+                  END IF
+               END DO
+            END DO
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE update_scales
+
+# if defined key_zdftke
+
+   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateen ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
+      ELSE
+         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateEN
+
+
+   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavt ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVT
+
+
+   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateavm ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
+      ELSE
+         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
+      ENDIF
+      !
+   END SUBROUTINE updateAVM
+
+# endif /* key_zdftke */ 
+
+#else
+CONTAINS
+   SUBROUTINE agrif_opa_update_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_opa_update_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_opa_update : You should not have seen this print! error?'
+   END SUBROUTINE agrif_opa_update_empty
+#endif
+END MODULE agrif_opa_update
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 8732)
@@ -0,0 +1,195 @@
+MODULE agrif_top_interp
+#if defined key_agrif && defined key_top
+   USE par_oce
+   USE oce
+   USE dom_oce      
+   USE agrif_oce
+   USE agrif_top_sponge
+   USE par_trc
+   USE trc
+   USE lib_mpp
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_trc, interptrn
+
+#  include "vectopt_loop_substitute.h90"
+  !!----------------------------------------------------------------------
+   !! NEMO/NST 3.6 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE Agrif_trc
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_trc  ***
+      !!----------------------------------------------------------------------
+      !
+      IF( Agrif_Root() )   RETURN
+
+      Agrif_SpecialValue    = 0.e0
+      Agrif_UseSpecialValue = .TRUE.
+
+      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
+      Agrif_UseSpecialValue = .FALSE.
+      !
+   END SUBROUTINE Agrif_trc
+
+
+   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptrn ***
+      !!---------------------------------------------
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER :: imin, imax, jmin, jmax
+      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
+      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
+      LOGICAL :: western_side, eastern_side,northern_side,southern_side
+
+      IF (before) THEN         
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+         !
+         zrhox = Agrif_Rhox()
+         ! 
+         zalpha1 = ( zrhox - 1. ) * 0.5
+         zalpha2 = 1. - zalpha1
+         ! 
+         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha4 = 1. - zalpha3
+         ! 
+         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+         zalpha5 = 1. - zalpha6 - zalpha7
+         !
+         imin = i1
+         imax = i2
+         jmin = j1
+         jmax = j2
+         ! 
+         ! Remove CORNERS
+         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
+         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
+         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
+         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2        
+         !
+         IF( eastern_side) THEN
+            DO jn = 1, jptra
+               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                     ELSE
+                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
+                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         ! 
+         IF( northern_side ) THEN            
+            DO jn = 1, jptra
+               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO ji = imin,imax
+                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                     ELSE
+                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
+                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         IF( western_side) THEN            
+            DO jn = 1, jptra
+               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
+               DO jk = 1, jpkm1
+                  DO jj = jmin,jmax
+                     IF( umask(2,jj,jk) == 0.e0 ) THEN
+                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                     ELSE
+                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
+                        IF( un(2,jj,jk) < 0.e0 ) THEN
+                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( southern_side ) THEN           
+            DO jn = 1, jptra
+               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
+               DO jk=1,jpk      
+                  DO ji=imin,imax
+                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                     ELSE
+                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                        IF( vn(ji,2,jk) < 0.e0 ) THEN
+                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            ENDDO
+         ENDIF
+         !
+         ! Treatment of corners
+         ! 
+         ! East south
+         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
+         ENDIF
+         ! East north
+         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
+         ENDIF
+         ! West south
+         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
+            tra(2,2,:,:) = ptab(2,2,:,:)
+         ENDIF
+         ! West north
+         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
+            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE interptrn
+
+#else
+CONTAINS
+   SUBROUTINE Agrif_TOP_Interp_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_Top_Interp_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_top_interp : You should not have seen this print! error?'
+   END SUBROUTINE Agrif_TOP_Interp_empty
+#endif
+END MODULE agrif_top_interp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 8732)
@@ -0,0 +1,117 @@
+#define SPONGE_TOP
+
+MODULE agrif_top_sponge
+   !!======================================================================
+   !!                ***  MODULE agrif_top_sponge  ***
+   !! AGRIF :   define in memory AGRIF variables for sea-ice
+   !!======================================================================
+   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Sponge_trc : 
+   !!   interptrn_sponge :  
+   !!----------------------------------------------------------------------
+#if defined key_agrif && defined key_top
+   USE par_oce
+   USE par_trc
+   USE oce
+   USE trc
+   USE dom_oce
+   USE agrif_oce
+   USE agrif_opa_sponge
+   !
+   USE in_out_manager
+   USE lib_mpp
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Sponge_trc, interptrn_sponge
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE Agrif_Sponge_trc
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Sponge_Trc ***
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   timecoeff
+      !!----------------------------------------------------------------------
+      !
+#if defined SPONGE_TOP
+      timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot()
+      CALL Agrif_sponge
+      Agrif_SpecialValue    = 0._wp
+      Agrif_UseSpecialValue = .TRUE.
+      tabspongedone_trn     = .FALSE.
+      CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge )
+      Agrif_UseSpecialValue = .FALSE.
+#endif
+      !
+   END SUBROUTINE Agrif_Sponge_Trc
+
+
+   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE interptrn_sponge ***
+      !!----------------------------------------------------------------------
+      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
+      LOGICAL                                     , INTENT(in   ) ::   before
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zabe1, zabe2
+      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE      
+!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected
+         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)      
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               DO jj = j1,j2-1
+                  DO ji = i1,i2-1
+                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
+                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
+                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
+                  END DO
+               END DO
+               !
+               DO jj = j1+1,j2-1
+                  DO ji = i1+1,i2-1
+                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
+                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
+                           &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+         !
+         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
+      ENDIF
+      !                 
+   END SUBROUTINE interptrn_sponge
+
+#else
+
+CONTAINS
+   SUBROUTINE agrif_top_sponge_empty
+      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
+   END SUBROUTINE agrif_top_sponge_empty
+#endif
+
+   !!======================================================================
+END MODULE agrif_top_sponge
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 8732)
@@ -0,0 +1,124 @@
+#define TWO_WAY
+#undef DECAL_FEEDBACK
+
+MODULE agrif_top_update
+   !!======================================================================
+   !!                ***  MODULE agrif_top_update  ***
+   !! AGRIF :   
+   !!----------------------------------------------------------------------
+   !! History :  
+   !!----------------------------------------------------------------------
+
+#if defined key_agrif && defined key_top
+   USE par_oce
+   USE oce
+   USE par_trc
+   USE trc
+   USE dom_oce
+   USE agrif_oce
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Update_Trc
+
+   INTEGER, PUBLIC ::   nbcline_trc = 0   !: ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE Agrif_Update_Trc( kt )
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Agrif_Update_Trc ***
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      !!----------------------------------------------------------------------
+      ! 
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+#if defined TWO_WAY   
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid    = 0._wp
+      ! 
+      IF( MOD(nbcline_trc,nbclineupdate) == 0 ) THEN
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable(trn_id, procname=updateTRC )
+# else
+         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC )
+# endif
+      ELSE
+# if ! defined DECAL_FEEDBACK
+         CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC )
+# else
+         CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC )
+# endif
+      ENDIF
+      !
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      nbcline_trc = nbcline_trc + 1
+#endif
+      !
+   END SUBROUTINE Agrif_Update_Trc
+
+
+   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE updateT ***
+      !!----------------------------------------------------------------------
+      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab
+      LOGICAL                                    , INTENT(in   ) ::   before
+      !!
+      INTEGER ::   ji, jj, jk, jn
+      !!----------------------------------------------------------------------
+      !
+      IF( before ) THEN
+         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
+      ELSE
+         IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN
+            ! Add asselin part
+            DO jn = n1,n2
+               DO jk = k1, k2
+                  DO jj = j1, j2
+                     DO ji = i1, i2
+                        IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN
+                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn)             & 
+                              &             + atfp * ( ptab(ji,jj,jk,jn)   &
+                                 &                    - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                        ENDIF
+                     END DO
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         DO jn = n1, n2
+            DO jk = k1, k2
+               DO jj = j1, j2
+                  DO ji = i1, i2
+                     IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 
+                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+      ! 
+   END SUBROUTINE updateTRC
+
+#else
+CONTAINS
+   SUBROUTINE agrif_top_update_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE agrif_Top_update_empty ***
+      !!---------------------------------------------
+      WRITE(*,*)  'agrif_top_update : You should not have seen this print! error?'
+   END SUBROUTINE agrif_top_update_empty
+#endif
+
+   !!======================================================================
+END MODULE agrif_top_update
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 8732)
@@ -0,0 +1,946 @@
+#if defined key_agrif
+!!----------------------------------------------------------------------
+!! NEMO/NST 3.7 , NEMO Consortium (2016)
+!! $Id$
+!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+!!----------------------------------------------------------------------
+SUBROUTINE agrif_user
+END SUBROUTINE agrif_user
+
+SUBROUTINE agrif_before_regridding
+END SUBROUTINE agrif_before_regridding
+
+SUBROUTINE Agrif_InitWorkspace
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitWorkspace ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE dom_oce
+   USE nemogcm
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !
+   IF( .NOT. Agrif_Root() ) THEN
+      jpni = Agrif_Parent(jpni)
+      jpnj = Agrif_Parent(jpnj)
+      jpnij = Agrif_Parent(jpnij)
+      jpiglo  = nbcellsx + 2 + 2*nbghostcells
+      jpjglo  = nbcellsy + 2 + 2*nbghostcells
+      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+! JC: change to allow for different vertical levels
+!     jpk is already set
+!     keep it jpk possibly different from jpkglo which 
+!     hold parent grid vertical levels number (set earlier)
+!      jpk     = jpkglo 
+      jpim1   = jpi-1 
+      jpjm1   = jpj-1 
+      jpkm1   = MAX( 1, jpk-1 )                                         
+      jpij    = jpi*jpj 
+      nperio  = 0
+      jperio  = 0
+   ENDIF
+   !
+END SUBROUTINE Agrif_InitWorkspace
+
+
+SUBROUTINE Agrif_InitValues
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitValues ***
+   !!
+   !! ** Purpose :: Declaration of variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE oce 
+   USE dom_oce
+   USE nemogcm
+   USE tradmp
+   USE bdy_oce   , ONLY: ln_bdy
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !
+!!gm  I think this is now useless ...   nn_cfg & cn_cfg are set to -999999 and "UNKNOWN" 
+!!gm                                    when reading the AGRIF domain configuration file
+   IF( cn_cfg == 'orca' ) THEN
+      IF ( nn_cfg == 2 .OR. nn_cfg == 025 .OR. nn_cfg == 05  .OR. nn_cfg == 4 ) THEN
+         nn_cfg = -1    ! set special value for nn_cfg on fine grids
+         cn_cfg = "default"
+      ENDIF
+   ENDIF
+   !                    !* Specific fine grid Initializations
+   ln_tradmp = .FALSE.        ! no tracer damping on fine grids
+   !
+   ln_bdy    = .FALSE.        ! no open boundary on fine grids
+
+   CALL nemo_init       !* Initializations of each fine grid
+
+   !                    !* Agrif initialization
+   CALL agrif_nemo_init
+   CALL Agrif_InitValues_cont_dom
+   CALL Agrif_InitValues_cont
+# if defined key_top
+   CALL Agrif_InitValues_cont_top
+# endif
+# if defined key_lim3
+   CALL Agrif_InitValues_cont_lim3
+# endif
+   !
+END SUBROUTINE Agrif_initvalues
+
+
+SUBROUTINE Agrif_InitValues_cont_dom
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitValues_cont ***
+   !!
+   !! ** Purpose ::   Declaration of variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE oce 
+   USE dom_oce
+   USE nemogcm
+   USE in_out_manager
+   USE agrif_opa_update
+   USE agrif_opa_interp
+   USE agrif_opa_sponge
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !
+   ! Declaration of the type of variable which have to be interpolated
+   !
+   CALL agrif_declare_var_dom
+   !
+END SUBROUTINE Agrif_InitValues_cont_dom
+
+
+SUBROUTINE agrif_declare_var_dom
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE agrif_declare_var ***
+   !!
+   !! ** Purpose :: Declaration of variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE agrif_util
+   USE par_oce       
+   USE oce
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
+
+   ! 2. Type of interpolation
+   !-------------------------
+   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   ! 3. Location of interpolation
+   !-----------------------------
+   CALL Agrif_Set_bc(e1u_id,(/0,0/))
+   CALL Agrif_Set_bc(e2v_id,(/0,0/))
+
+   ! 5. Update type
+   !--------------- 
+   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+
+! High order updates
+!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
+    !
+END SUBROUTINE agrif_declare_var_dom
+
+
+SUBROUTINE Agrif_InitValues_cont
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitValues_cont ***
+   !!
+   !! ** Purpose ::   Declaration of variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE oce 
+   USE dom_oce
+   USE nemogcm
+   USE lib_mpp
+   USE in_out_manager
+   USE agrif_opa_update
+   USE agrif_opa_interp
+   USE agrif_opa_sponge
+   !!
+   IMPLICIT NONE
+   !
+   LOGICAL :: check_namelist
+   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
+   !!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_var
+
+   ! 2. First interpolations of potentially non zero fields
+   !-------------------------------------------------------
+   Agrif_SpecialValue=0.
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
+   CALL Agrif_Sponge
+   tabspongedone_tsn = .FALSE.
+   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
+   ! reset tsa to zero
+   tsa(:,:,:,:) = 0.
+
+   Agrif_UseSpecialValue = ln_spc_dyn
+   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
+   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
+   tabspongedone_u = .FALSE.
+   tabspongedone_v = .FALSE.
+   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
+   tabspongedone_u = .FALSE.
+   tabspongedone_v = .FALSE.
+   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
+
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
+
+   IF ( ln_dynspg_ts ) THEN
+      Agrif_UseSpecialValue = ln_spc_dyn
+      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
+      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
+      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
+      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
+      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
+      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
+      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
+      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
+   ENDIF
+
+   Agrif_UseSpecialValue = .FALSE. 
+   ! reset velocities to zero
+   ua(:,:,:) = 0.
+   va(:,:,:) = 0.
+
+   ! 3. Some controls
+   !-----------------
+   check_namelist = .TRUE.
+
+   IF( check_namelist ) THEN 
+
+      ! Check time steps           
+      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
+         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
+         WRITE(cl_check2,*)  NINT(rdt)
+         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
+         CALL ctl_stop( 'incompatible time step between ocean grids',   &
+               &               'parent grid value : '//cl_check1    ,   & 
+               &               'child  grid value : '//cl_check2    ,   & 
+               &               'value on child grid should be changed to : '//cl_check3 )
+      ENDIF
+
+      ! Check run length
+      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
+            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+         CALL ctl_warn( 'incompatible run length between grids'               ,   &
+               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
+               &              ' nitend on fine grid will be change to : '//cl_check2    )
+         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
+      ENDIF
+
+      ! Check coordinates
+     !SF  IF( ln_zps ) THEN
+     !SF     ! check parameters for partial steps 
+     !SF     IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
+     !SF        WRITE(*,*) 'incompatible e3zps_min between grids'
+     !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
+     !SF        WRITE(*,*) 'child grid  :',e3zps_min
+     !SF        WRITE(*,*) 'those values should be identical'
+     !SF        STOP
+     !SF     ENDIF
+     !SF     IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
+     !SF        WRITE(*,*) 'incompatible e3zps_rat between grids'
+     !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
+     !SF        WRITE(*,*) 'child grid  :',e3zps_rat
+     !SF        WRITE(*,*) 'those values should be identical'                  
+     !SF        STOP
+     !SF     ENDIF
+     !SF  ENDIF
+
+      ! Check free surface scheme
+      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
+         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
+         WRITE(*,*) 'incompatible free surface scheme between grids'
+         WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts )
+         WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp)
+         WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts
+         WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp
+         WRITE(*,*) 'those logicals should be identical'                  
+         STOP
+      ENDIF
+
+      ! check if masks and bathymetries match
+      IF(ln_chk_bathy) THEN
+         !
+         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
+         !
+         kindic_agr = 0
+         ! check if umask agree with parent along western and eastern boundaries:
+         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
+         ! check if vmask agree with parent along northern and southern boundaries:
+         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
+         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
+         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
+         !
+         IF (lk_mpp) CALL mpp_sum( kindic_agr )
+         IF( kindic_agr /= 0 ) THEN
+            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
+         ELSE
+            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
+         END IF
+      ENDIF
+      !
+   ENDIF
+   ! 
+   ! Do update at initialisation because not done before writing restarts
+   ! This would indeed change boundary conditions values at initial time
+   ! hence produce restartability issues.
+   ! Note that update below is recursive (with lk_agrif_doupd=T):
+   ! 
+! JC: I am not sure if Agrif_MaxLevel() is the "relative"
+!     or the absolute maximum nesting level...TBC                        
+   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
+      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
+      CALL Agrif_Update_tra()
+      CALL Agrif_Update_dyn()
+   ENDIF
+   !
+# if defined key_zdftke
+   CALL Agrif_Update_tke(0)
+# endif
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
+   nbcline = 0
+   lk_agrif_doupd = .FALSE.
+   !
+END SUBROUTINE Agrif_InitValues_cont
+
+
+SUBROUTINE agrif_declare_var
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE agrif_declarE_var ***
+   !!
+   !! ** Purpose :: Declaration of variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE agrif_util
+   USE par_oce       !   ONLY : jpts
+   USE oce
+   USE agrif_oce
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
+
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
+
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
+   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
+   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
+
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
+
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
+
+   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
+
+# if defined key_zdftke
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
+# endif
+
+   ! 2. Type of interpolation
+   !-------------------------
+   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
+
+   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
+
+   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+
+   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
+   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
+   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
+
+# if defined key_zdftke
+   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
+# endif
+
+
+   ! 3. Location of interpolation
+   !-----------------------------
+   CALL Agrif_Set_bc(tsn_id,(/0,1/))
+   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
+   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
+
+!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
+!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
+!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+
+   CALL Agrif_Set_bc(sshn_id,(/0,0/))
+   CALL Agrif_Set_bc(unb_id ,(/0,0/))
+   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
+   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
+   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
+
+   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
+   CALL Agrif_Set_bc(umsk_id,(/0,0/))
+   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
+
+# if defined key_zdftke
+   CALL Agrif_Set_bc(avm_id ,(/0,1/))
+# endif
+
+   ! 5. Update type
+   !--------------- 
+   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
+
+   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+# if defined key_zdftke
+   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
+# endif
+
+! High order updates
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+!
+!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
+!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
+!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
+
+   !
+END SUBROUTINE agrif_declare_var
+
+#  if defined key_lim2
+SUBROUTINE Agrif_InitValues_cont_lim2
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
+   !!
+   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE ice_2
+   USE agrif_ice
+   USE in_out_manager
+   USE agrif_lim2_update
+   USE agrif_lim2_interp
+   USE lib_mpp
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_var_lim2
+
+   ! 2. First interpolations of potentially non zero fields
+   !-------------------------------------------------------
+   Agrif_SpecialValue=-9999.
+   Agrif_UseSpecialValue = .TRUE.
+   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
+   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
+   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
+   Agrif_SpecialValue=0.
+   Agrif_UseSpecialValue = .FALSE.
+
+   ! 3. Some controls
+   !-----------------
+
+#   if ! defined key_lim2_vp
+   lim_nbstep = 1.
+   CALL agrif_rhg_lim2_load
+   CALL agrif_trp_lim2_load
+   lim_nbstep = 0.
+#   endif
+   !RB mandatory but why ???
+   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
+   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
+   !         nbclineupdate = nn_fsbc
+   !       ENDIF
+   CALL Agrif_Update_lim2(0)
+   !
+END SUBROUTINE Agrif_InitValues_cont_lim2
+
+
+SUBROUTINE agrif_declare_var_lim2
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE agrif_declare_var_lim2 ***
+   !!
+   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
+   !!----------------------------------------------------------------------
+   USE agrif_util
+   USE ice_2
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
+#   if defined key_lim2_vp
+   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
+   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
+#   else
+   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
+   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
+#   endif
+
+   ! 2. Type of interpolation
+   !-------------------------
+   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+   ! 3. Location of interpolation
+   !-----------------------------
+   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
+   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
+   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
+
+   ! 5. Update type
+   !---------------
+   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+   ! 
+END SUBROUTINE agrif_declare_var_lim2
+#  endif
+
+#if defined key_lim3
+SUBROUTINE Agrif_InitValues_cont_lim3
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
+   !!
+   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
+   USE ice
+   USE agrif_ice
+   USE in_out_manager
+   USE agrif_lim3_update
+   USE agrif_lim3_interp
+   USE lib_mpp
+   !
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !
+   ! Declaration of the type of variable which have to be interpolated (parent=>child)
+   !----------------------------------------------------------------------------------
+   CALL agrif_declare_var_lim3
+
+   ! Controls
+
+   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
+   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
+   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
+   !       If a solution is found, the following stop could be removed
+   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
+
+   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
+   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
+      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
+   ENDIF
+
+   ! stop if update frequency is different from nn_fsbc
+   IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc')
+
+
+   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
+   !----------------------------------------------------------------------
+!!   lim_nbstep = 1
+   lim_nbstep = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
+   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
+   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
+   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
+   lim_nbstep = 0
+   
+   ! Update in case 2 ways
+   !----------------------
+   CALL agrif_update_lim3(0)
+
+   !
+END SUBROUTINE Agrif_InitValues_cont_lim3
+
+SUBROUTINE agrif_declare_var_lim3
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE agrif_declare_var_lim3 ***
+   !!
+   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE ice
+
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !
+   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
+   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
+   !           ex.:  position=> 1,1 = not-centered (in i and j)
+   !                            2,2 =     centered (    -     )
+   !                 index   => 1,1 = one ghost line
+   !                            2,2 = two ghost lines
+   !-------------------------------------------------------------------------------------
+   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
+   CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
+   CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
+
+   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
+   !-----------------------------------
+   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
+   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
+   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
+
+   ! 3. Set location of interpolations
+   !----------------------------------
+   CALL Agrif_Set_bc(tra_ice_id,(/0,1/))
+   CALL Agrif_Set_bc(u_ice_id  ,(/0,1/))
+   CALL Agrif_Set_bc(v_ice_id  ,(/0,1/))
+
+   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
+   !--------------------------------------------------
+   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
+   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
+   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
+
+END SUBROUTINE agrif_declare_var_lim3
+#endif
+
+
+# if defined key_top
+SUBROUTINE Agrif_InitValues_cont_top
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
+   !!
+   !! ** Purpose :: Declaration of variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE oce 
+   USE dom_oce
+   USE nemogcm
+   USE par_trc
+   USE lib_mpp
+   USE trc
+   USE in_out_manager
+   USE agrif_opa_sponge
+   USE agrif_top_update
+   USE agrif_top_interp
+   USE agrif_top_sponge
+   !!
+   IMPLICIT NONE
+   !
+   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
+   LOGICAL :: check_namelist
+   !!----------------------------------------------------------------------
+
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_var_top
+
+   ! 2. First interpolations of potentially non zero fields
+   !-------------------------------------------------------
+   Agrif_SpecialValue=0.
+   Agrif_UseSpecialValue = .TRUE.
+   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
+   Agrif_UseSpecialValue = .FALSE.
+   CALL Agrif_Sponge
+   tabspongedone_trn = .FALSE.
+   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
+   ! reset tsa to zero
+   tra(:,:,:,:) = 0.
+
+
+   ! 3. Some controls
+   !-----------------
+   check_namelist = .TRUE.
+
+   IF( check_namelist ) THEN
+      ! Check time steps
+      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
+         WRITE(cl_check1,*)  Agrif_Parent(rdt)
+         WRITE(cl_check2,*)  rdt
+         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
+         CALL ctl_stop( 'incompatible time step between grids',   &
+               &               'parent grid value : '//cl_check1    ,   & 
+               &               'child  grid value : '//cl_check2    ,   & 
+               &               'value on child grid should be changed to  &
+               &               :'//cl_check3  )
+      ENDIF
+
+      ! Check run length
+      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
+            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
+         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
+         CALL ctl_warn( 'incompatible run length between grids'               ,   &
+               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
+               &              ' nitend on fine grid will be change to : '//cl_check2    )
+         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
+         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
+      ENDIF
+
+      ! Check coordinates
+      IF( ln_zps ) THEN
+         ! check parameters for partial steps 
+         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
+            WRITE(*,*) 'incompatible e3zps_min between grids'
+            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
+            WRITE(*,*) 'child grid  :',e3zps_min
+            WRITE(*,*) 'those values should be identical'
+            STOP
+         ENDIF
+         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
+            WRITE(*,*) 'incompatible e3zps_rat between grids'
+            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
+            WRITE(*,*) 'child grid  :',e3zps_rat
+            WRITE(*,*) 'those values should be identical'                  
+            STOP
+         ENDIF
+      ENDIF
+      ! Check passive tracer cell
+      IF( nn_dttrc .NE. 1 ) THEN
+         WRITE(*,*) 'nn_dttrc should be equal to 1'
+      ENDIF
+   ENDIF
+
+   CALL Agrif_Update_trc(0)
+   !
+   Agrif_UseSpecialValueInUpdate = .FALSE.
+   nbcline_trc = 0
+   !
+END SUBROUTINE Agrif_InitValues_cont_top
+
+
+SUBROUTINE agrif_declare_var_top
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE agrif_declare_var_top ***
+   !!
+   !! ** Purpose :: Declaration of TOP variables to be interpolated
+   !!----------------------------------------------------------------------
+   USE agrif_util
+   USE agrif_oce
+   USE dom_oce
+   USE trc
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
+
+   ! 2. Type of interpolation
+   !-------------------------
+   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
+   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
+
+   ! 3. Location of interpolation
+   !-----------------------------
+   CALL Agrif_Set_bc(trn_id,(/0,1/))
+!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
+   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
+
+   ! 5. Update type
+   !--------------- 
+   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+
+!   Higher order update
+!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
+
+   !
+END SUBROUTINE agrif_declare_var_top
+# endif
+
+SUBROUTINE Agrif_detect( kg, ksizex )
+   !!----------------------------------------------------------------------
+   !!                      *** ROUTINE Agrif_detect ***
+   !!----------------------------------------------------------------------
+   INTEGER, DIMENSION(2) :: ksizex
+   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
+   !!----------------------------------------------------------------------
+   !
+   RETURN
+   !
+END SUBROUTINE Agrif_detect
+
+
+SUBROUTINE agrif_nemo_init
+   !!----------------------------------------------------------------------
+   !!                     *** ROUTINE agrif_init ***
+   !!----------------------------------------------------------------------
+   USE agrif_oce 
+   USE agrif_ice
+   USE in_out_manager
+   USE lib_mpp
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER  ::   ios                 ! Local integer output status for namelist read
+   INTEGER  ::   iminspon
+   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
+   !!--------------------------------------------------------------------------------------
+   !
+   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
+   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
+
+   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
+   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
+   IF(lwm) WRITE ( numond, namagrif )
+   !
+   IF(lwp) THEN                    ! control print
+      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
+      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
+      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
+      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
+      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
+      WRITE(numout,*) 
+   ENDIF
+   !
+   ! convert DOCTOR namelist name into OLD names
+   nbclineupdate = nn_cln_update
+   visc_tra      = rn_sponge_tra
+   visc_dyn      = rn_sponge_dyn
+   !
+   ! Check sponge length:
+   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
+   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
+   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
+   !
+   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
+# if defined key_lim2
+   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3)
+# endif
+   !
+END SUBROUTINE agrif_nemo_init
+
+# if defined key_mpp_mpi
+
+SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
+   !!----------------------------------------------------------------------
+   !!                     *** ROUTINE Agrif_detect ***
+   !!----------------------------------------------------------------------
+   USE dom_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER :: indglob, indloc, nprocloc, i
+   !!----------------------------------------------------------------------
+   !
+   SELECT CASE( i )
+   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+   CASE DEFAULT
+      indglob = indloc
+   END SELECT
+   !
+END SUBROUTINE Agrif_InvLoc
+
+
+SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_get_proc_info ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER, INTENT(out) :: imin, imax
+   INTEGER, INTENT(out) :: jmin, jmax
+   !!----------------------------------------------------------------------
+   !
+   imin = nimppt(Agrif_Procrank+1)  ! ?????
+   jmin = njmppt(Agrif_Procrank+1)  ! ?????
+   imax = imin + jpi - 1
+   jmax = jmin + jpj - 1
+   ! 
+END SUBROUTINE Agrif_get_proc_info
+
+
+SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
+   !!----------------------------------------------------------------------
+   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
+   !!----------------------------------------------------------------------
+   USE par_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER,  INTENT(in)  :: imin, imax
+   INTEGER,  INTENT(in)  :: jmin, jmax
+   INTEGER,  INTENT(in)  :: nbprocs
+   REAL(wp), INTENT(out) :: grid_cost
+   !!----------------------------------------------------------------------
+   !
+   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
+   !
+END SUBROUTINE Agrif_estimate_parallel_cost
+
+# endif
+
+#else
+SUBROUTINE Subcalledbyagrif
+   !!----------------------------------------------------------------------
+   !!                   *** ROUTINE Subcalledbyagrif ***
+   !!----------------------------------------------------------------------
+   WRITE(*,*) 'Impossible to be here'
+END SUBROUTINE Subcalledbyagrif
+#endif
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 8732)
@@ -0,0 +1,712 @@
+MODULE dtadyn
+   !!======================================================================
+   !!                       ***  MODULE  dtadyn  ***
+   !! 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
+   !!             3.3  ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line
+   !!             3.4  ! 2011-05 (C. Ethe) Use of fldread
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dta_dyn_init : initialization, namelist read, and SAVEs control
+   !!   dta_dyn      : Interpolation of the fields
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE c1d             ! 1D configuration: lk_c1d
+   USE dom_oce         ! ocean domain: variables
+   USE domvvl          ! variable volume
+   USE zdf_oce         ! ocean vertical physics: variables
+   USE sbc_oce         ! surface module: variables
+   USE trc_oce         ! share ocean/biogeo variables
+   USE phycst          ! physical constants
+   USE trabbl          ! active tracer: bottom boundary layer
+   USE ldfslp          ! lateral diffusion: iso-neutral slopes
+   USE sbcrnf          ! river runoffs
+   USE ldftra          ! 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 iom             ! I/O library
+   USE lib_mpp         ! distributed memory computing library
+   USE prtctl          ! print control
+   USE fldread         ! read input fields 
+   USE wrk_nemo        ! Memory allocation 
+   USE timing          ! Timing
+   USE trc, ONLY : ln_rsttr, numrtr, numrtw, lrst_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dta_dyn_init   ! called by opa.F90
+   PUBLIC   dta_dyn        ! called by step.F90
+   PUBLIC   dta_dyn_swp   ! called by step.F90
+
+   CHARACTER(len=100) ::   cn_dir          !: Root directory for location of ssr files
+   LOGICAL            ::   ln_dynrnf       !: read runoff data in file (T) or set to zero (F)
+   LOGICAL            ::   ln_dynrnf_depth       !: read runoff data in file (T) or set to zero (F)
+   REAL(wp)           ::   fwbcorr
+
+
+   INTEGER  , PARAMETER ::   jpfld = 20     ! maximum number of fields to read
+   INTEGER  , SAVE      ::   jf_tem         ! index of temperature
+   INTEGER  , SAVE      ::   jf_sal         ! index of salinity
+   INTEGER  , SAVE      ::   jf_uwd         ! index of u-transport
+   INTEGER  , SAVE      ::   jf_vwd         ! index of v-transport
+   INTEGER  , SAVE      ::   jf_wwd         ! index of v-transport
+   INTEGER  , SAVE      ::   jf_avt         ! index of Kz
+   INTEGER  , SAVE      ::   jf_mld         ! index of mixed layer deptht
+   INTEGER  , SAVE      ::   jf_emp         ! index of water flux
+   INTEGER  , SAVE      ::   jf_empb        ! index of water flux
+   INTEGER  , SAVE      ::   jf_qsr         ! index of solar radiation
+   INTEGER  , SAVE      ::   jf_wnd         ! index of wind speed
+   INTEGER  , SAVE      ::   jf_ice         ! index of sea ice cover
+   INTEGER  , SAVE      ::   jf_rnf         ! index of river runoff
+   INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux
+   INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef
+   INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef
+   INTEGER  , SAVE      ::   jf_div         ! index of e3t
+
+
+   TYPE(FLD), ALLOCATABLE, SAVE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read)
+   !                                               ! 
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta   ! zonal diapycnal slopes
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta   ! meridional diapycnal slopes
+
+   INTEGER, SAVE  :: nprevrec, nsecdyn
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dta_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_dyn  ***
+      !!
+      !! ** Purpose :  Prepares dynamics and physics fields from a NEMO run
+      !!               for an off-line simulation of passive tracers
+      !!
+      !! ** Method : calculates the position of data 
+      !!             - computes slopes if needed
+      !!             - interpolates data if needed
+      !!----------------------------------------------------------------------
+      !
+      USE oce, ONLY:  zhdivtr => ua
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER             ::   ji, jj, jk
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zemp
+      !
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'dta_dyn')
+      !
+      nsecdyn = nsec_year + nsec1jan000   ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
+      !
+      IF( kt == nit000 ) THEN    ;    nprevrec = 0
+      ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec_a(2)
+      ENDIF
+      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==!
+      !
+      IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt )    ! Computation of slopes
+      !
+      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature
+      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity
+      wndm(:,:)         = sf_dyn(jf_wnd)%fnow(:,:,1)  * tmask(:,:,1)    ! wind speed - needed for gas exchange
+      fmmflx(:,:)       = sf_dyn(jf_fmf)%fnow(:,:,1)  * tmask(:,:,1)    ! downward salt flux (v3.5+)
+      fr_i(:,:)         = sf_dyn(jf_ice)%fnow(:,:,1)  * tmask(:,:,1)    ! Sea-ice fraction
+      qsr (:,:)         = sf_dyn(jf_qsr)%fnow(:,:,1)  * tmask(:,:,1)    ! solar radiation
+      emp (:,:)         = sf_dyn(jf_emp)%fnow(:,:,1)  * tmask(:,:,1)    ! E-P
+      IF( ln_dynrnf ) THEN 
+         rnf (:,:)      = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! E-P
+         IF( ln_dynrnf_depth .AND. .NOT. ln_linssh )    CALL  dta_dyn_hrnf
+      ENDIF
+      !
+      un(:,:,:)        = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport
+      vn(:,:,:)        = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport
+      wn(:,:,:)        = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport
+      !
+      IF( .NOT.ln_linssh ) THEN
+         CALL wrk_alloc(jpi, jpj, zemp )
+         zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:)    ! effective u-transport
+         emp_b (:,:)    = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P
+         zemp   (:,:)   = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr * tmask(:,:,1)
+         CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) )  !=  ssh, vertical scale factor & vertical transport
+         CALL wrk_dealloc(jpi, jpj, zemp )
+         !                                           Write in the tracer restart file
+         !                                          *******************************
+         IF( lrst_trc ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file ',   &
+               &                    'at it= ', kt,' date= ', ndastp
+            IF(lwp) WRITE(numout,*) '~~~~'
+            CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssha )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sshb', sshn )
+         ENDIF
+      ENDIF
+      !
+      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+      CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points
+      CALL bn2    ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl
+
+      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
+      CALL zdf_mxl( kt )                                                   ! In any case, we need mxl
+      !
+      hmld(:,:)         = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht
+      avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient 
+      !
+#if defined key_trabbl && ! defined key_c1d
+      ahu_bbl(:,:)      = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)    ! bbl diffusive coef
+      ahv_bbl(:,:)      = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1)
+#endif
+      !
+      !
+      CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+      !
+      IF(ln_ctl) THEN                  ! print control
+         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=umask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab3d_1=vn               , clinfo1=' vn      - : ', mask1=vmask, 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(tab3d_1=uslp             , clinfo1=' slp  - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk)
+         CALL prt_ctl(tab3d_1=wslpi            , clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
+!         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=fmmflx           , clinfo1=' fmmflx  - : ', mask1=tmask, ovlap=1 )
+!         CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', 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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'dta_dyn')
+      !
+   END SUBROUTINE dta_dyn
+
+
+   SUBROUTINE dta_dyn_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_dyn_init  ***
+      !!
+      !! ** Purpose :   Initialisation of the dynamical data     
+      !! ** Method  : - read the data namdta_dyn namelist
+      !!
+      !! ** Action  : - read parameters
+      !!----------------------------------------------------------------------
+      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
+      INTEGER  :: ifpr                               ! dummy loop indice
+      INTEGER  :: jfld                               ! dummy loop arguments
+      INTEGER  :: inum, idv, idimv                   ! local integer
+      INTEGER  :: ios                                ! Local integer output status for namelist read
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcoef
+      INTEGER  :: nkrnf_max
+      REAL(wp) :: hrnf_max
+      !!
+      CHARACTER(len=100)            ::  cn_dir        !   Root directory for location of core files
+      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d         ! array of namelist informations on the fields to read
+      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_empb, sn_emp  ! informations about the fields to be read
+      TYPE(FLD_N) :: sn_tem , sn_sal , sn_avt   !   "                 "
+      TYPE(FLD_N) :: sn_mld, sn_qsr, sn_wnd , sn_ice , sn_fmf   !   "               "
+      TYPE(FLD_N) :: sn_ubl, sn_vbl, sn_rnf    !   "              "
+      TYPE(FLD_N) :: sn_div  ! informations about the fields to be read
+
+      !!----------------------------------------------------------------------
+      !
+      NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth,  fwbcorr, &
+         &                sn_uwd, sn_vwd, sn_wwd, sn_emp,    &
+         &                sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr ,   &
+         &                sn_wnd, sn_ice, sn_fmf,                    &
+         &                sn_ubl, sn_vbl, sn_rnf,                   &
+         &                sn_empb, sn_div 
+      !
+      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data
+      READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data
+      READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdta_dyn )
+      !                                         ! store namelist information in an array
+      !                                         ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dta_dyn : offline dynamics '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namdta_dyn'
+         WRITE(numout,*) '      runoffs option enabled (T) or not (F)            ln_dynrnf        = ', ln_dynrnf
+         WRITE(numout,*) '      runoffs is spread in vertical                    ln_dynrnf_depth  = ', ln_dynrnf_depth
+         WRITE(numout,*) '      annual global mean of empmr for ssh correction   fwbcorr          = ', fwbcorr
+         WRITE(numout,*)
+      ENDIF
+      ! 
+
+      jf_uwd  = 1     ;   jf_vwd  = 2    ;   jf_wwd = 3    ;   jf_emp = 4    ;   jf_avt = 5
+      jf_tem  = 6     ;   jf_sal  = 7    ;   jf_mld = 8    ;   jf_qsr = 9
+      jf_wnd  = 10    ;   jf_ice  = 11   ;   jf_fmf = 12   ;   jfld   = jf_fmf
+
+      !
+      slf_d(jf_uwd)  = sn_uwd    ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd
+      slf_d(jf_emp)  = sn_emp    ;   slf_d(jf_avt)  = sn_avt
+      slf_d(jf_tem)  = sn_tem    ;   slf_d(jf_sal)  = sn_sal   ;   slf_d(jf_mld) = sn_mld
+      slf_d(jf_qsr)  = sn_qsr    ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_ice) = sn_ice
+      slf_d(jf_fmf)  = sn_fmf
+
+      !
+      IF( .NOT.ln_linssh ) THEN
+                 jf_div  = jfld + 1    ;         jf_empb  = jfld + 2      ;      jfld = jf_empb
+           slf_d(jf_div) = sn_div      ;   slf_d(jf_empb) = sn_empb
+      ENDIF
+      !
+      IF( lk_trabbl ) THEN
+                 jf_ubl  = jfld + 1    ;         jf_vbl  = jfld + 2     ;      jfld = jf_vbl
+           slf_d(jf_ubl) = sn_ubl      ;   slf_d(jf_vbl) = sn_vbl
+      ENDIF
+      !
+      IF( ln_dynrnf ) THEN
+                jf_rnf  = jfld + 1     ;     jfld  = jf_rnf
+          slf_d(jf_rnf) = sn_rnf    
+      ELSE
+         rnf(:,:) = 0._wp
+      ENDIF
+
+  
+      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure
+      IF( ierr > 0 )  THEN
+         CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN
+      ENDIF
+      !                                         ! fill sf with slf_i and control print
+      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
+      !
+      ! Open file for each variable to get his number of dimension
+      DO ifpr = 1, jfld
+         CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday )
+         idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar
+         idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar
+         IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open
+         ierr1=0
+         IF( idimv == 3 ) THEN    ! 2D variable
+                                      ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
+            IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 )
+         ELSE                     ! 3D variable
+                                      ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk)  , STAT=ierr0 )
+            IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 )
+         ENDIF
+         IF( ierr0 + ierr1 > 0 ) THEN
+            CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' )   ;   RETURN
+         ENDIF
+      END DO
+      !
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
+         IF( sf_dyn(jf_tem)%ln_tint ) THEN      ! time interpolation
+            ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    &
+            &         wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 )
+            !
+            IF( ierr2 > 0 )  THEN
+               CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( .NOT.ln_linssh ) THEN
+        IF( .NOT. sf_dyn(jf_uwd)%ln_clim .AND. ln_rsttr .AND.    &                     ! Restart: read in restart file
+           iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN
+           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation'
+           CALL iom_get( numrtr, jpdom_autoglo, 'sshn', sshn(:,:)   )
+           CALL iom_get( numrtr, jpdom_autoglo, 'sshb', sshb(:,:)   )
+        ELSE
+           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation'
+           CALL iom_open( 'restart', inum )
+           CALL iom_get( inum, jpdom_autoglo, 'sshn', sshn(:,:)   )
+           CALL iom_get( inum, jpdom_autoglo, 'sshb', sshb(:,:)   )
+           CALL iom_close( inum )                                        ! close file
+        ENDIF
+        !
+        DO jk = 1, jpkm1
+           e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) )
+        ENDDO
+        e3t_a(:,:,jpk) = e3t_0(:,:,jpk)
+
+        ! Horizontal scale factor interpolations
+        ! --------------------------------------
+        CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+        CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+
+        ! Vertical scale factor interpolations
+        ! ------------------------------------
+        CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n(:,:,:), 'W' )
+  
+        e3t_b(:,:,:)  = e3t_n(:,:,:)
+        e3u_b(:,:,:)  = e3u_n(:,:,:)
+        e3v_b(:,:,:)  = e3v_n(:,:,:)
+
+        ! t- and w- points depth
+        ! ----------------------
+        gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+        gdepw_n(:,:,1) = 0.0_wp
+
+        DO jk = 2, jpk
+           DO jj = 1,jpj
+              DO ji = 1,jpi
+                !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere
+                !    tmask = wmask, ie everywhere expect at jk = mikt
+                                                                   ! 1 for jk =
+                                                                   ! mikt
+                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+                 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+                 gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
+                     &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk))
+              END DO
+           END DO
+        END DO
+
+        gdept_b(:,:,:) = gdept_n(:,:,:)
+        gdepw_b(:,:,:) = gdepw_n(:,:,:)
+        !
+      ENDIF
+      !
+      IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN       ! read depht over which runoffs are distributed
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed'
+         CALL iom_open ( "runoffs", inum )                           ! open file
+         CALL iom_get  ( inum, jpdom_data, 'rodepth', h_rnf )   ! read the river mouth array
+         CALL iom_close( inum )                                        ! close file
+         !
+         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( h_rnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+                  END DO
+                  nk_rnf(ji,jj) = jk
+               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+               ELSE
+                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE                                       ! runoffs applied at the surface
+         nk_rnf(:,:) = 1
+         h_rnf (:,:) = e3t_n(:,:,1)
+      ENDIF
+      nkrnf_max = MAXVAL( nk_rnf(:,:) )
+      hrnf_max = MAXVAL( h_rnf(:,:) )
+      IF( lk_mpp )  THEN
+         CALL mpp_max( nkrnf_max )                 ! max over the  global domain
+         CALL mpp_max( hrnf_max )                 ! max over the  global domain
+      ENDIF
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) ' max depht of runoff : ', hrnf_max,'    max level  : ', nkrnf_max
+      IF(lwp) WRITE(numout,*) ' '
+      !
+      CALL dta_dyn( nit000 )
+      !
+   END SUBROUTINE dta_dyn_init
+
+   SUBROUTINE dta_dyn_swp( kt )
+     !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE dta_dyn_swp  ***
+      !!
+      !! ** Purpose : Swap and the data and compute the vertical scale factor at U/V/W point
+      !!              and the depht
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt       ! time step
+      INTEGER             :: ji, jj, jk
+      REAL(wp)            :: zcoef
+      !
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:))  ! before <-- now filtered
+      sshn(:,:) = ssha(:,:)
+
+      e3t_n(:,:,:) = e3t_a(:,:,:)
+
+      ! Reconstruction of all vertical scale factors at now and before time steps
+      ! =============================================================================
+
+      ! Horizontal scale factor interpolations
+      ! --------------------------------------
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+
+      ! Vertical scale factor interpolations
+      ! ------------------------------------
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' )
+
+      e3t_b(:,:,:)  = e3t_n(:,:,:)
+      e3u_b(:,:,:)  = e3u_n(:,:,:)
+      e3v_b(:,:,:)  = e3v_n(:,:,:)
+
+      ! t- and w- points depth
+      ! ----------------------
+      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+      gdepw_n(:,:,1) = 0.0_wp
+
+      DO jk = 2, jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+                 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+                 gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
+                     &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk))
+              END DO
+           END DO
+        END DO
+
+      gdept_b(:,:,:) = gdept_n(:,:,:)
+      gdepw_b(:,:,:) = gdepw_n(:,:,:)
+
+      !
+   END SUBROUTINE dta_dyn_swp
+
+   SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb,  pemp, pssha, pe3ta )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dta_dyn_wzv  ***
+      !!                   
+      !! ** Purpose :   compute the after ssh (ssha) and the now vertical velocity
+      !!
+      !! ** Method  : Using the incompressibility hypothesis, 
+      !!        - the ssh increment is computed by integrating the horizontal divergence 
+      !!          and multiply by the time step.
+      !!
+      !!        - compute the after scale factor : repartition of ssh INCREMENT proportionnaly
+      !!                                           to the level thickness ( z-star case )
+      !!
+      !!        - the vertical velocity is computed by integrating the horizontal divergence  
+      !!          from the bottom to the surface minus the scale factor evolution.
+      !!          The boundary conditions are w=0 at the bottom (no flux)
+      !!
+      !! ** action  :   ssha / e3t_a / wn
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER,                                   INTENT(in )    :: kt        !  time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk)          , INTENT(in )   :: phdivtr   ! horizontal divergence transport
+      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(in )   :: psshb     ! now ssh
+      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(in )   :: pemp      ! evaporation minus precipitation
+      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(inout) :: pssha     ! after ssh
+      REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(out)   :: pe3ta     ! after vertical scale factor
+      !! * Local declarations
+      INTEGER                       :: jk
+      REAL(wp), DIMENSION(jpi,jpj)  :: zhdiv  
+      REAL(wp)  :: z2dt  
+      !!----------------------------------------------------------------------
+      
+      !
+      z2dt = 2._wp * rdt
+      !
+      zhdiv(:,:) = 0._wp
+      DO jk = 1, jpkm1
+         zhdiv(:,:) = zhdiv(:,:) +  phdivtr(:,:,jk) * tmask(:,:,jk)
+      END DO
+      !                                                ! Sea surface  elevation time-stepping
+      pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rau0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:)
+      !                                                 ! 
+      !                                                 ! After acale factors at t-points ( z_star coordinate )
+      DO jk = 1, jpkm1
+        pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) )
+      END DO
+      !
+   END SUBROUTINE dta_dyn_ssh
+
+
+   SUBROUTINE dta_dyn_hrnf
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      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) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box
+            END DO
+        END DO
+      END DO
+      !
+   END SUBROUTINE dta_dyn_hrnf
+
+
+
+   SUBROUTINE dta_dyn_slp( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE dta_dyn_slp  ***
+      !!
+      !! ** Purpose : Computation of slope
+      !!
+      !!---------------------------------------------------------------------
+      USE oce, ONLY:  zts => tsa 
+      !
+      INTEGER,  INTENT(in) :: kt       ! time step
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
+      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
+      INTEGER  ::   iswap 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuslp, zvslp, zwslpi, zwslpj
+      !!---------------------------------------------------------------------
+      !
+      CALL wrk_alloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj )
+      !
+      IF( sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                       
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt
+            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature
+            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity 
+            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef.
+            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+            uslpdta (:,:,:,1) = zuslp (:,:,:) 
+            vslpdta (:,:,:,1) = zvslp (:,:,:) 
+            wslpidta(:,:,:,1) = zwslpi(:,:,:) 
+            wslpjdta(:,:,:,1) = zwslpj(:,:,:) 
+            !
+            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature
+            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity 
+            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef.
+            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+            uslpdta (:,:,:,2) = zuslp (:,:,:) 
+            vslpdta (:,:,:,2) = zvslp (:,:,:) 
+            wslpidta(:,:,:,2) = zwslpi(:,:,:) 
+            wslpjdta(:,:,:,2) = zwslpj(:,:,:) 
+         ELSE
+           ! 
+           iswap = 0
+           IF( sf_dyn(jf_tem)%nrec_a(2) - nprevrec /= 0 )  iswap = 1
+           IF( nsecdyn > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap == 1 )  THEN    ! read/update the after data
+              IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt
+              uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data
+              vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)  
+              wslpidta(:,:,:,1) =  wslpidta(:,:,:,2) 
+              wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2) 
+              !
+              zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature
+              zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity 
+              avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef.
+              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+              !
+              uslpdta (:,:,:,2) = zuslp (:,:,:) 
+              vslpdta (:,:,:,2) = zvslp (:,:,:) 
+              wslpidta(:,:,:,2) = zwslpi(:,:,:) 
+              wslpjdta(:,:,:,2) = zwslpj(:,:,:) 
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( sf_dyn(jf_tem)%ln_tint )  THEN
+         ztinta =  REAL( nsecdyn - sf_dyn(jf_tem)%nrec_b(2), wp )  &
+            &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp )
+         ztintb =  1. - ztinta
+         IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)
+            uslp (:,:,:) = ztintb * uslpdta (:,:,:,1)  + ztinta * uslpdta (:,:,:,2)  
+            vslp (:,:,:) = ztintb * vslpdta (:,:,:,1)  + ztinta * vslpdta (:,:,:,2)  
+            wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1)  + ztinta * wslpidta(:,:,:,2)  
+            wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1)  + ztinta * wslpjdta(:,:,:,2)  
+         ENDIF
+      ELSE
+         zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)   ! temperature
+         zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)   ! salinity 
+         avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)   ! vertical diffusive coef.
+         CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+         !
+         IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)
+            uslp (:,:,:) = zuslp (:,:,:)
+            vslp (:,:,:) = zvslp (:,:,:)
+            wslpi(:,:,:) = zwslpi(:,:,:)
+            wslpj(:,:,:) = zwslpj(:,:,:)
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj )
+      !
+   END SUBROUTINE dta_dyn_slp
+
+   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE dta_dyn_slp  ***
+      !!
+      !! ** Purpose : Computation of slope
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER ,                              INTENT(in ) :: kt       ! time step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts      ! temperature/salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: puslp    ! zonal isopycnal slopes
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pvslp    ! meridional isopycnal slopes
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpi   ! zonal diapycnal slopes
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes
+      !!---------------------------------------------------------------------
+      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)
+         CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) )
+         CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points
+         CALL bn2    ( pts, rab_n, rn2  ) ! now    Brunt-Vaisala
+
+      ! Partial steps: before Horizontal DErivative
+      IF( ln_zps  .AND. .NOT. ln_isfcav)                            &
+         &            CALL zps_hde    ( kt, jpts, pts, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+         &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+      IF( ln_zps .AND.        ln_isfcav)                            &
+         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi, &  ! Partial steps for top cell (ISF)
+         &                                        rhd, gru , grv , grui, grvi )  ! of t, s, rd at the first ocean level
+
+         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl
+         CALL zdf_mxl( kt )            ! mixed layer depth
+         CALL ldf_slp( kt, rhd, rn2 )  ! slopes
+         puslp (:,:,:) = uslp (:,:,:)
+         pvslp (:,:,:) = vslp (:,:,:)
+         pwslpi(:,:,:) = wslpi(:,:,:)
+         pwslpj(:,:,:) = wslpj(:,:,:)
+     ELSE
+         puslp (:,:,:) = 0.            ! to avoid warning when compiling
+         pvslp (:,:,:) = 0.
+         pwslpi(:,:,:) = 0.
+         pwslpj(:,:,:) = 0.
+     ENDIF
+      !
+   END SUBROUTINE compute_slopes
+   !!======================================================================
+END MODULE dtadyn
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 8732)
@@ -0,0 +1,712 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! 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
+   !!            3.4  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            4.0  ! 2016-10  (C. Ethe, G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm        : off-line: solve ocean tracer only
+   !!   nemo_init       : initialization of the nemo model
+   !!   nemo_ctl        : initialisation of algorithm flag 
+   !!   nemo_closefile  : close remaining files
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space domain variables
+   USE oce             ! dynamics and tracers variables
+   USE trc_oce         ! Shared ocean/passive tracers variables
+   USE c1d             ! 1D configuration
+   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine)
+   USE usrdef_nam      ! user defined configuration
+   USE eosbn2          ! equation of state            (eos bn2 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 traldf          ! lateral physics                (tra_ldf_init routine)
+   USE zdfini          ! vertical physics: initialization
+   USE sbcmod          ! surface boundary condition       (sbc_init     routine)
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE dtadyn          ! Lecture and Interpolation of the dynamical fields
+   USE trcini          ! Initilization of the passive tracers
+   USE daymod          ! calendar                         (day     routine)
+   USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
+   USE dtadyn          ! Lecture and interpolation of the dynamical fields
+   !              ! Passive tracers needs
+   USE trc             ! passive tracer : variables
+   USE trcnam          ! passive tracer : namelist
+   USE trcrst          ! passive tracer restart
+   USE diaptr          ! Need to initialise this as some variables are used in if statements later
+   USE sbc_oce  , ONLY : ln_rnf
+   USE sbcrnf          ! surface boundary condition : runoffs
+   !              ! 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 xios
+#endif 
+   USE prtctl          ! Print control                    (prt_ctl_init routine)
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
+
+
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   nemo_gcm   ! called by nemo.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
+
+   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 (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
+      !!----------------------------------------------------------------------
+
+      CALL nemo_init  ! Initializations
+
+      ! 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 )
+
+      !                            !-----------------------!
+      !                            !==   time stepping   ==!
+      !                            !-----------------------!
+      istp = nit000
+      !
+      ! Initialize arrays of runoffs structures and read data from the namelist
+      IF ( ln_rnf ) CALL sbc_rnf(istp)
+      ! 
+      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      ! 
+      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 - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp
+                                CALL dta_dyn    ( istp )         ! Interpolation of the dynamical fields
+         IF( .NOT.ln_linssh )   CALL dta_dyn_swp( istp )         ! swap of sea  surface height and vertical scale factors
+
+                                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
+#if defined key_iomput
+      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+#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
+      !
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
+      CALL nemo_closefile
+      !
+# if defined key_iomput
+      CALL xios_finalize             ! end mpp communications
+# 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 model in off-line mode
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER ::   ilocal_comm   ! local integer
+      INTEGER ::   ios, inum
+      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   ! local scalars
+      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
+      !!
+      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_timing, nn_diacfl
+
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
+      !!----------------------------------------------------------------------
+      cltxt  = ''
+      cltxt2 = ''
+      clnam  = ''  
+      cxios_context = 'nemo'
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+
+      !                             !--------------------------!
+      !                             !  Set global domain size  !   (control print return in cltxt2)
+      !
+      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
+         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+         !
+      ELSE                                ! user-defined namelist
+         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+      ENDIF
+      jpk    = jpkglo
+      !
+      !
+      l_offline = .true.            !  passive tracers are run offline
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection
+#else
+      ilocal_comm = 0
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+#endif
+
+      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                      ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
+
+      IF(lwm) THEN
+         ! write merged namelists from earlier to output namelist now that the
+         ! file has been opened in call to mynode. nammpp has already been
+         ! written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+         IF( .NOT.ln_read_cfg ) THEN
+            DO ji = 1, SIZE(clnam)
+               IF( TRIM(clnam (ji)) /= '' )   WRITE(numond, * ) clnam(ji)    ! namusr_def print
+            END DO
+         ENDIF
+      ENDIF
+
+      ! If dimensions of processor grid weren't specified in the namelist file 
+      ! then we calculate them here now that we have our communicator size
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+#if   defined key_mpp_mpi
+         CALL nemo_partition(mppsize)
+#else
+         jpni = 1
+         jpnj = 1
+         jpnij = jpni*jpnj
+#endif
+      END IF
+
+      ! Calculate domain dimensions given calculated jpni and jpnj
+      ! This used to be done in par_oce.F90 when they were parameters rather
+      ! than variables
+      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
+      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = jpk-1                                            !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
+
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.6  (2015) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt) 
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set we can 
+      ! allocate arrays
+      CALL nemo_alloc()
+
+      !                             !--------------------------------!
+      !                             !  Model general initialization  !
+      !                             !--------------------------------!
+
+      CALL nemo_ctl                           ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+
+      !                                      ! General initialization
+      IF( nn_timing == 1 )  CALL timing_start( 'nemo_init')
+      !
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration
+
+                            CALL     dom_init   ! Domain
+
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
+
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+
+                            CALL     sbc_init   ! Forcings : surface module
+
+                            CALL ldf_tra_init   ! Lateral ocean tracer physics
+                            CALL ldf_eiv_init   ! Eddy induced velocity param
+                            CALL tra_ldf_init   ! lateral mixing
+      IF( l_ldfslp )        CALL ldf_slp_init   ! slope of lateral mixing
+
+                            CALL tra_qsr_init   ! penetrative solar radiation qsr
+      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+
+                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers
+                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar
+                            CALL dta_dyn_init   ! Initialization for the dynamics
+
+                            CALL     trc_init   ! Passive tracers initialization
+                            CALL dia_ptr_init   ! Initialise diaptr as some variables are used 
+      !                                         ! in various advection and diffusion routines
+      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init')
+      !
+   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'
+         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,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namcfg'
+         WRITE(numout,*) '      read domain configuration files             ln_read_cfg      = ', ln_read_cfg
+         WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '      write  configuration definition files       ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out)
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr
+      ENDIF
+
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF ( lk_mpp ) CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
+      IF( numnam_ref /= -1 )   CLOSE( numnam_ref )   ! oce reference namelist
+      IF( numnam_cfg /= -1 )   CLOSE( numnam_cfg )   ! oce configuration namelist
+      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE diawri,       ONLY: dia_wri_alloc
+      USE dom_oce,      ONLY: dom_oce_alloc
+      USE zdf_oce,      ONLY: zdf_oce_alloc
+      USE trc_oce,      ONLY: trc_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        oce_alloc       ()          ! ocean 
+      ierr = ierr + dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      !
+      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+
+      ierr = 0
+
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of 
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER :: ilfax(ntest)
+      !
+      ! lfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+
+      ! Clear the error flag and initialise output vars
+      kerr = 0
+      kfax = 1
+      knfax = 0
+
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+
+      inu   = kn
+      knfax = 0
+
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+#if defined key_mpp_mpi
+   SUBROUTINE nemo_northcomms
+      !!======================================================================
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
+      !!                       point-to-point messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S.
+      !Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+
+      njmppmax = MAXVAL( njmppt )
+
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto = 0
+
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+
+          DO jn = 1, jpni
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nfiimpp(jn, jpnj)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                END IF
+          END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
+      ENDIF
+      l_north_nogather = .TRUE.
+   END SUBROUTINE nemo_northcomms
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !!
+      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
+      !!----------------------------------------------------------------------
+      !
+      !     now fields         !     after fields      !
+      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
+      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
+      wn   (:,:,:)   = 0._wp   !                       !
+      hdivn(:,:,:)   = 0._wp   !                       !
+      tsn  (:,:,:,:) = 0._wp   !                       !
+      !
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0
+      !
+   END SUBROUTINE istate_init
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       ! --------------------------
+      !
+   END SUBROUTINE stp_ctl
+   !!======================================================================
+END MODULE nemogcm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90	(revision 8732)
@@ -0,0 +1,168 @@
+MODULE asmbkg
+   !!======================================================================
+   !!                       ***  MODULE asmtrj -> asmbkg  ***
+   !! 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
+   !!                 ! 2010-01 (A. Vidard) split asm_trj_wri into tam_trj_wri and asm_bkg_wri
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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             ! Lateral diffusion: eddy diffusivity coefficients
+   USE ldfslp             ! Lateral diffusion: 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 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_lim2
+   USE ice_2
+#endif
+#if defined key_lim3
+   USE ice
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   asm_bkg_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'     , tsn(:,:,:,jp_tem) )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
+            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_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'     , tsn(:,:,:,jp_tem) )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
+#if defined key_lim2 || defined key_lim3
+            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN
+	            IF( ALLOCATED(frld) ) THEN
+                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   )
+               ELSE
+		            CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')
+	            ENDIF
+            ENDIF
+#endif
+            !
+            CALL iom_close( inum )
+         ENDIF
+         !
+      ENDIF
+      !                    
+   END SUBROUTINE asm_bkg_wri
+
+   !!======================================================================
+END MODULE asmbkg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 8732)
@@ -0,0 +1,1008 @@
+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 
+   !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization
+   !!                 ! 2014-09  (D. Lea)  Local calc_date removed use routine from OBS
+   !!                 ! 2015-11  (D. Lea)  Handle non-zero initial time of day
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   asm_inc_init   : Initialize the increment arrays and IAU weights
+   !!   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
+   !!   seaice_asm_inc : Apply the seaice increment
+   !!----------------------------------------------------------------------
+   USE wrk_nemo         ! Memory Allocation
+   USE par_oce          ! Ocean space and time domain variables
+   USE dom_oce          ! Ocean space and time domain
+   USE domvvl           ! domain: variable volume level
+   USE oce              ! Dynamics and active tracers defined in memory
+   USE ldfdyn           ! lateral diffusion: eddy viscosity coefficients
+   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
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+#if defined key_lim2
+   USE ice_2            ! LIM2
+#endif
+   USE sbc_oce          ! Surface boundary condition variables.
+   USE diaobs, ONLY: calc_date     ! Compute the calendar date on a given step
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights
+   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
+   PUBLIC   seaice_asm_inc !: Apply the seaice 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     !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_asmiau     !: No applying forcing with an assimilation increment
+   LOGICAL, PUBLIC :: ln_asmdin     !: No direct initialization
+   LOGICAL, PUBLIC :: ln_trainc     !: No tracer (T and S) assimilation increments
+   LOGICAL, PUBLIC :: ln_dyninc     !: No dynamics (u and v) assimilation increments
+   LOGICAL, PUBLIC :: ln_sshinc     !: No sea surface height assimilation increment
+   LOGICAL, PUBLIC :: ln_seaiceinc  !: No sea ice concentration increment
+   LOGICAL, PUBLIC :: ln_salfix     !: Apply minimum salinity check
+   LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing
+   INTEGER, PUBLIC :: nn_divdmp     !: Apply divergence damping filter nn_divdmp times
+
+   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
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   seaice_bkginc         ! Increment to the background sea ice conc
+#if defined key_cice && defined key_asminc
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ndaice_da             ! ice increment tendency into CICE
+#endif
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 :: ji, jj, jk, jt  ! dummy loop indices
+      INTEGER :: imid, inum      ! local integers
+      INTEGER :: ios             ! Local integer output status for namelist read
+      INTEGER :: iiauper         ! Number of time steps in the IAU period
+      INTEGER :: icycper         ! Number of time steps in the cycle
+      REAL(KIND=dp) :: ditend_date     ! Date YYYYMMDD.HHMMSS of final time step
+      REAL(KIND=dp) :: ditbkg_date     ! Date YYYYMMDD.HHMMSS of background time step for Jb term
+      REAL(KIND=dp) :: ditdin_date     ! Date YYYYMMDD.HHMMSS of background time step for DI
+      REAL(KIND=dp) :: ditiaustr_date  ! Date YYYYMMDD.HHMMSS of IAU interval start time step
+      REAL(KIND=dp) :: ditiaufin_date  ! Date YYYYMMDD.HHMMSS of IAU interval final time step
+
+      REAL(wp) :: znorm        ! Normalization factor for IAU weights
+      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights (should be equal to one)
+      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
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) ::   hdiv   ! 2D workspace
+      !!
+      NAMELIST/nam_asminc/ ln_bkgwri,                                      &
+         &                 ln_trainc, ln_dyninc, ln_sshinc,                &
+         &                 ln_asmdin, ln_asmiau,                           &
+         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   &
+         &                 ln_salfix, salfixmin, nn_divdmp
+      !!----------------------------------------------------------------------
+
+      !-----------------------------------------------------------------------
+      ! Read Namelist nam_asminc : assimilation increment interface
+      !-----------------------------------------------------------------------
+      ln_seaiceinc   = .FALSE.
+      ln_temnofreeze = .FALSE.
+
+      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment
+      READ  ( numnam_ref, nam_asminc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nam_asminc in configuration namelist : Assimilation increment
+      READ  ( numnam_cfg, nam_asminc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, 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 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 applying sea ice increments        ln_seaiceinc = ', ln_seaiceinc
+         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,*) '      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( nitend, ditend_date )
+
+      ! Background time for Jb referenced to ndate0
+      CALL calc_date( nitbkg_r, ditbkg_date )
+
+      ! Background time for DI referenced to ndate0
+      CALL calc_date( nitdin_r, ditdin_date )
+
+      ! IAU start time referenced to ndate0
+      CALL calc_date( nitiaustr_r, ditiaustr_date )
+
+      ! IAU end time referenced to ndate0
+      CALL calc_date( nitiaufin_r, ditiaufin_date )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         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,*)
+         WRITE(numout,*) '   Dates referenced to current cycle:'
+         WRITE(numout,*) '       ndastp         = ', ndastp
+         WRITE(numout,*) '       ndate0         = ', ndate0
+         WRITE(numout,*) '       nn_time0       = ', nn_time0
+         WRITE(numout,*) '       ditend_date    = ', ditend_date
+         WRITE(numout,*) '       ditbkg_date    = ', ditbkg_date
+         WRITE(numout,*) '       ditdin_date    = ', ditdin_date
+         WRITE(numout,*) '       ditiaustr_date = ', ditiaustr_date
+         WRITE(numout,*) '       ditiaufin_date = ', ditiaufin_date
+      ENDIF
+
+
+      IF ( ( 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 ) .OR. ( ln_seaiceinc) )) &
+         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc is set to .true.', &
+         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', &
+         &                ' Inconsistent options')
+
+      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 ).AND.( .NOT. ln_seaiceinc ) &
+         &                     )  &
+         & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc 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)   )
+      ALLOCATE( seaice_bkginc(jpi,jpj))
+#if defined key_asminc
+      ALLOCATE( ssh_iau(jpi,jpj)      )
+#endif
+#if defined key_cice && defined key_asminc
+      ALLOCATE( ndaice_da(jpi,jpj)      )
+#endif
+      t_bkginc(:,:,:) = 0.0
+      s_bkginc(:,:,:) = 0.0
+      u_bkginc(:,:,:) = 0.0
+      v_bkginc(:,:,:) = 0.0
+      ssh_bkginc(:,:) = 0.0
+      seaice_bkginc(:,:) = 0.0
+#if defined key_asminc
+      ssh_iau(:,:)    = 0.0
+#endif
+#if defined key_cice && defined key_asminc
+      ndaice_da(:,:) = 0.0
+#endif
+      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) 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 ', z_inc_dateb,' and ',  &
+               &            z_inc_datef
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF (     ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) &
+            & .OR.( z_inc_datef > ditend_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments is ', &
+            &                ' outside the assimilation interval' )
+
+         IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_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
+
+         IF ( ln_seaiceinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'bckinseaice', seaice_bkginc, 1 )
+            ! Apply the masks
+            seaice_bkginc(:,:) = seaice_bkginc(:,:) * tmask(:,:,1)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( seaice_bkginc(:,:) ) > 1.0e+10 ) seaice_bkginc(:,:) = 0.0
+         ENDIF
+
+         CALL iom_close( inum )
+ 
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Apply divergence damping filter
+      !-----------------------------------------------------------------------
+
+      IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN
+         !
+         CALL wrk_alloc( jpi,jpj,   hdiv ) 
+         !
+         DO jt = 1, nn_divdmp
+            !
+            DO jk = 1, jpkm1           ! hdiv = e1e1 * div
+               hdiv(:,:) = 0._wp
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     hdiv(ji,jj) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)    &
+                        &           - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)    &
+                        &           + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)    &
+                        &           - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  ) / e3t_n(ji,jj,jk)
+                  END DO
+               END DO
+               CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change)
+               !
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk)                         &
+                        &               + 0.2_wp * ( hdiv(ji+1,jj) - hdiv(ji  ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk)                         &
+                        &               + 0.2_wp * ( hdiv(ji,jj+1) - hdiv(ji,jj  ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj,   hdiv ) 
+         !
+      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._wp
+         s_bkg(:,:,:) = 0._wp
+         u_bkg(:,:,:) = 0._wp
+         v_bkg(:,:,:) = 0._wp
+         ssh_bkg(:,:) = 0._wp
+         !
+         !--------------------------------------------------------------------
+         ! Read from file the background state at analysis time
+         !--------------------------------------------------------------------
+         !
+         CALL iom_open( c_asmdin, inum )
+         !
+         CALL iom_get( inum, 'rdastp', zdate_bkg ) 
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
+               &  zdate_bkg
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+         !
+         IF ( zdate_bkg /= ditdin_date ) &
+            & CALL ctl_warn( ' Validity time of assimilation background state does', &
+            &                ' not agree with Direct Initialization time' )
+         !
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg )
+            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 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
+      REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values
+      !!----------------------------------------------------------------------
+      !
+      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 
+      ! used to prevent the applied increments taking the temperature below the local freezing point 
+      DO jk = 1, jpkm1
+        CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), gdept_n(:,:,jk) )
+      END DO
+         !
+         !                             !--------------------------------------
+      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
+               IF (ln_temnofreeze) THEN
+                  ! Do not apply negative increments if the temperature will fall below freezing
+                  WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. &
+                     &   tsn(:,:,jk,jp_tem) + tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 
+                     tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
+                  END WHERE
+               ELSE
+                  tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
+               ENDIF
+               IF (ln_salfix) THEN
+                  ! Do not apply negative increments if the salinity will fall below a specified
+                  ! minimum value salfixmin
+                  WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. &
+                     &   tsn(:,:,jk,jp_sal) + tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 
+                     tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
+                  END WHERE
+               ELSE
+                  tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
+               ENDIF
+            END DO
+            !
+         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
+            IF (ln_temnofreeze) THEN
+               ! Do not apply negative increments if the temperature will fall below freezing
+               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 
+                  tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+               END WHERE
+            ELSE
+               tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+            ENDIF
+            IF (ln_salfix) THEN
+               ! Do not apply negative increments if the salinity will fall below a specified
+               ! minimum value salfixmin
+               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin ) 
+                  tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+               END WHERE
+            ELSE
+               tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+            ENDIF
+
+            tsb(:,:,:,:) = tsn(:,:,:,:)                 ! Update before fields
+
+            CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities
+!!gm  fabien
+!            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities
+!!gm
+
+            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)      &
+               &  CALL zps_hde    ( kt, jpts, tsb, gtsu, gtsv,        &  ! Partial steps: before horizontal gradient
+               &                              rhd, gru , grv          )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)      &
+               &  CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi,    &    ! Partial steps for top cell (ISF)
+               &                                  rhd, gru , grv , grui, grvi     )    ! of t, s, rd at the last ocean level
+
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+            DEALLOCATE( t_bkg    )
+            DEALLOCATE( s_bkg    )
+         ENDIF
+         !  
+      ENDIF
+      ! Perhaps the following call should be in step
+      IF ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment
+      !
+   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(:,:,:)
+            !
+            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
+      INTEGER :: jk
+      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
+            !
+            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment
+            !
+            sshb(:,:) = sshn(:,:)                        ! Update before fields
+            e3t_b(:,:,:) = e3t_n(:,:,:)
+!!gm why not e3u_b, e3v_b, gdept_b ????
+            !
+            DEALLOCATE( ssh_bkg    )
+            DEALLOCATE( ssh_bkginc )
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ssh_asm_inc
+
+
+   SUBROUTINE seaice_asm_inc( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE seaice_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the sea ice assimilation increment.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)           ::   kt       ! Current time step
+      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation
+      !
+      INTEGER  ::   it
+      REAL(wp) ::   zincwgt   ! IAU weight for current time step
+#if defined key_lim2
+      REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc  ! LIM
+      REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres
+#endif
+      !!----------------------------------------------------------------------
+      !
+      !                             !-----------------------------------------
+      IF ( ln_asmiau ) THEN         ! Incremental Analysis Updating
+         !                          !-----------------------------------------
+         !
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+            !
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it)      ! IAU weight for the current time step 
+            ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments)
+            !
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+            !
+            ! Sea-ice : LIM-3 case (to add)
+            !
+#if defined key_lim2
+            ! Sea-ice : LIM-2 case
+            zofrld (:,:) = frld(:,:)
+            zohicif(:,:) = hicif(:,:)
+            !
+            frld  = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
+            pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp)
+            fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction
+            !
+            zseaicendg(:,:) = zofrld(:,:) - frld(:,:)   ! find out actual sea ice nudge applied
+            !
+            ! Nudge sea ice depth to bring it up to a required minimum depth
+            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin ) 
+               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt    
+            ELSEWHERE
+               zhicifinc(:,:) = 0.0_wp
+            END WHERE
+            !
+            ! nudge ice depth
+            hicif (:,:) = hicif (:,:) + zhicifinc(:,:)
+            phicif(:,:) = phicif(:,:) + zhicifinc(:,:)       
+            !
+            ! seaice salinity balancing (to add)
+#endif
+
+#if defined key_cice && defined key_asminc
+            ! Sea-ice : CICE case. Pass ice increment tendency into CICE
+            ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt
+#endif
+
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( seaice_bkginc )
+            ENDIF
+
+         ELSE
+
+#if defined key_cice && defined key_asminc
+            ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+#endif
+
+         ENDIF
+         !                          !-----------------------------------------
+      ELSEIF ( ln_asmdin ) THEN     ! Direct Initialization
+         !                          !-----------------------------------------
+         !
+         IF ( kt == nitdin_r ) THEN
+            !
+            neuler = 0                    ! Force Euler forward step
+            !
+            ! Sea-ice : LIM-3 case (to add)
+            !
+#if defined key_lim2
+            ! Sea-ice : LIM-2 case.
+            zofrld(:,:)=frld(:,:)
+            zohicif(:,:)=hicif(:,:)
+            ! 
+            ! Initialize the now fields the background + increment
+            frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp)
+            pfrld(:,:) = frld(:,:) 
+            fr_i (:,:) = 1.0_wp - frld(:,:)                ! adjust ice fraction
+            zseaicendg(:,:) = zofrld(:,:) - frld(:,:)      ! find out actual sea ice nudge applied
+            !
+            ! Nudge sea ice depth to bring it up to a required minimum depth
+            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin ) 
+               zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt    
+            ELSEWHERE
+               zhicifinc(:,:) = 0._wp
+            END WHERE
+            !
+            ! nudge ice depth
+            hicif (:,:) = hicif (:,:) + zhicifinc(:,:)
+            phicif(:,:) = phicif(:,:)       
+            !
+            ! seaice salinity balancing (to add)
+#endif
+            !
+#if defined key_cice && defined key_asminc
+            ! Sea-ice : CICE case. Pass ice increment tendency into CICE
+           ndaice_da(:,:) = seaice_bkginc(:,:) / rdt
+#endif
+            IF ( .NOT. PRESENT(kindic) ) THEN
+               DEALLOCATE( seaice_bkginc )
+            END IF
+            !
+         ELSE
+            !
+#if defined key_cice && defined key_asminc
+            ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE
+
+#endif
+            !
+         ENDIF
+
+!#if defined defined key_lim2 || defined key_cice
+!
+!            IF (ln_seaicebal ) THEN       
+!             !! balancing salinity increments
+!             !! simple case from limflx.F90 (doesn't include a mass flux)
+!             !! assumption is that as ice concentration is reduced or increased
+!             !! the snow and ice depths remain constant
+!             !! note that snow is being created where ice concentration is being increased
+!             !! - could be more sophisticated and
+!             !! not do this (but would need to alter h_snow)
+!
+!             usave(:,:,:)=sb(:,:,:)   ! use array as a temporary store
+!
+!             DO jj = 1, jpj
+!               DO ji = 1, jpi 
+!           ! calculate change in ice and snow mass per unit area
+!           ! positive values imply adding salt to the ocean (results from ice formation)
+!           ! fwf : ice formation and melting
+!
+!                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rdt
+!
+!           ! change salinity down to mixed layer depth
+!                 mld=hmld_kara(ji,jj)
+!
+!           ! prevent small mld
+!           ! less than 10m can cause salinity instability 
+!                 IF (mld < 10) mld=10
+!
+!           ! set to bottom of a level 
+!                 DO jk = jpk-1, 2, -1
+!                   IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN 
+!                     mld=gdepw(ji,jj,jk+1)
+!                     jkmax=jk
+!                   ENDIF
+!                 ENDDO
+!
+!            ! avoid applying salinity balancing in shallow water or on land
+!            ! 
+!
+!            ! dsal_ocn (psu kg m^-2) / (kg m^-3 * m)
+!
+!                 dsal_ocn=0.0_wp
+!                 sal_thresh=5.0_wp        ! minimum salinity threshold for salinity balancing
+!
+!                 if (tmask(ji,jj,1) > 0 .AND. tmask(ji,jj,jkmax) > 0 ) &
+!                              dsal_ocn = zfons / (rhop(ji,jj,1) * mld)
+!
+!           ! put increments in for levels in the mixed layer
+!           ! but prevent salinity below a threshold value 
+!
+!                   DO jk = 1, jkmax              
+!
+!                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN 
+!                           sb(ji,jj,jk) = sb(ji,jj,jk) + dsal_ocn
+!                           sn(ji,jj,jk) = sn(ji,jj,jk) + dsal_ocn
+!                     ENDIF
+!
+!                   ENDDO
+!
+!      !            !  salt exchanges at the ice/ocean interface
+!      !            zpmess         = zfons / rdt_ice    ! rdt_ice is ice timestep
+!      !
+!      !! Adjust fsalt. A +ve fsalt means adding salt to ocean
+!      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt  
+!      !!               
+!      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d) 
+!      !!                                                     ! E-P (kg m-2 s-2)
+!      !            emp(ji,jj) = emp(ji,jj) + zpmess          ! E-P (kg m-2 s-2)
+!               ENDDO !ji
+!             ENDDO !jj!
+!
+!            ENDIF !ln_seaicebal
+!
+!#endif
+         !
+      ENDIF
+      !
+   END SUBROUTINE seaice_asm_inc
+   
+   !!======================================================================
+END MODULE asminc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 8732)
@@ -0,0 +1,29 @@
+MODULE asmpar
+   !!======================================================================
+   !!                       ***  MODULE asmpar  ***
+   !! Assimilation increment : Parameters for assimilation interface
+   !!======================================================================
+
+   IMPLICIT NONE
+   PRIVATE
+
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmbkg = 'assim_background_state_Jb'   !: Filename for storing the background state
+   !                                                                                  !  for use in the Jb term
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmdin = 'assim_background_state_DI'   !: Filename for storing the background state
+   !                                                                                  !  for direct initialization
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asmtrj = 'assim_trj'                   !: Filename for storing the reference trajectory
+   CHARACTER(LEN=40), PUBLIC, PARAMETER ::   c_asminc = 'assim_background_increments' !: Filename for storing the increments 
+   !                                                                                  !  to the background state
+
+   INTEGER, PUBLIC ::   nitbkg_r      !: Background time step referenced to nit000
+   INTEGER, PUBLIC ::   nitdin_r      !: Direct Initialization time step referenced to nit000
+   INTEGER, PUBLIC ::   nitiaustr_r   !: IAU starting time step referenced to nit000
+   INTEGER, PUBLIC ::   nitiaufin_r   !: IAU final time step referenced to nit000
+   INTEGER, PUBLIC ::   nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE asmpar
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 8732)
@@ -0,0 +1,176 @@
+MODULE bdy_oce
+   !!======================================================================
+   !!                       ***  MODULE bdy_oce   ***
+   !! Unstructured Open Boundary Cond. :   define related variables
+   !!======================================================================
+   !! 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
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for lim3
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PUBLIC
+
+   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V)
+
+   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblen
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv
+   END TYPE OBC_INDEX
+
+   !! Logicals in OBC_DATA structure are true if the chosen algorithm requires this
+   !! field as external data. If true the data can come from external files
+   !! or model initial conditions. If false then no "external" data array
+   !! is required for this field. 
+
+   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
+      INTEGER          , DIMENSION(2)   ::  nread
+      LOGICAL                           ::  ll_ssh
+      LOGICAL                           ::  ll_u2d
+      LOGICAL                           ::  ll_v2d
+      LOGICAL                           ::  ll_u3d
+      LOGICAL                           ::  ll_v3d
+      LOGICAL                           ::  ll_tem
+      LOGICAL                           ::  ll_sal
+      LOGICAL                           ::  ll_fvl
+      REAL(wp), POINTER, DIMENSION(:)   ::  ssh
+      REAL(wp), POINTER, DIMENSION(:)   ::  u2d
+      REAL(wp), POINTER, DIMENSION(:)   ::  v2d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  tem
+      REAL(wp), POINTER, DIMENSION(:,:) ::  sal
+#if defined key_lim2
+      LOGICAL                           ::   ll_frld
+      LOGICAL                           ::   ll_hicif
+      LOGICAL                           ::   ll_hsnif
+      REAL(wp), POINTER, DIMENSION(:)   ::   frld
+      REAL(wp), POINTER, DIMENSION(:)   ::   hicif
+      REAL(wp), POINTER, DIMENSION(:)   ::   hsnif
+#elif defined key_lim3
+      LOGICAL                           ::   ll_a_i
+      LOGICAL                           ::   ll_ht_i
+      LOGICAL                           ::   ll_ht_s
+      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness
+#endif
+#if defined key_top
+      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply
+      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor
+      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer
+      LOGICAL                             :: dmp     !: obc damping term
+#endif
+   END TYPE OBC_DATA
+
+   !!----------------------------------------------------------------------
+   !! Namelist variables
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition
+
+   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file
+   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file
+   !
+   LOGICAL, DIMENSION(jp_bdy) ::   ln_coords_file           !: =T read bdy coordinates from file; 
+   !                                                        !: =F read bdy coordinates from namelist
+   LOGICAL                    ::   ln_mask_file             !: =T read bdymask from file
+   LOGICAL                    ::   ln_vol                   !: =T volume correction             
+   !
+   INTEGER                    ::   nb_bdy                   !: number of open boundary sets
+   INTEGER                    ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run)
+   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme
+   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P 
+   !                                                        !  = 1 the volume will be constant during all the integration.
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn2d       ! Choice of boundary condition for barotropic variables (U,V,SSH)
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn2d_dta   !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+                                                            !: = 2 read tidal harmonic forcing from a NetCDF file
+                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn3d       ! Choice of boundary condition for baroclinic velocities 
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn3d_dta   !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_tra         ! Choice of boundary condition for active tracers (T and S)
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points
+
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables 
+   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ; 
+                                                              !: = 1 read it in a NetCDF file
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice
+   !
+   
+   !!----------------------------------------------------------------------
+   !! Global variables
+   !!----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdytmask   !: Mask defining computational domain at T-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyumask   !: Mask defining computational domain at U-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyvmask   !: Mask defining computational domain at V-points
+
+   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary
+
+   !!----------------------------------------------------------------------
+   !! open boundary data variables
+   !!----------------------------------------------------------------------
+
+   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
+                                                                          !: =1 => some data to be read in from data files
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy)
+!$AGRIF_DO_NOT_TREAT
+   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
+   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process)
+!$AGRIF_END_DO_NOT_TREAT
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION bdy_oce_alloc()
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn, mpp_sum
+      !
+      INTEGER :: bdy_oce_alloc
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),     &  
+         &      STAT=bdy_oce_alloc )
+      !
+      ! Initialize masks 
+      bdytmask(:,:) = 1._wp
+      bdyumask(:,:) = 1._wp
+      bdyvmask(:,:) = 1._wp
+      ! 
+      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc )
+      IF( bdy_oce_alloc /= 0 )   CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.')
+      !
+   END FUNCTION bdy_oce_alloc
+
+   !!======================================================================
+END MODULE bdy_oce
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 8732)
@@ -0,0 +1,903 @@
+MODULE bdydta
+   !!======================================================================
+   !!                       ***  MODULE bdydta  ***
+   !! Open boundary data : read the data for the unstructured open boundaries.
+   !!======================================================================
+   !! 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_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
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3
+   !!----------------------------------------------------------------------
+   !!    bdy_dta        : read external data along open boundaries from file
+   !!    bdy_dta_init   : initialise arrays etc for reading of external data
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE bdy_oce         ! ocean open boundary conditions  
+   USE bdytides        ! tidal forcing at boundaries
+   USE fldread         ! read input fields
+   USE iom             ! IOM library
+   USE in_out_manager  ! I/O logical units
+#if defined key_lim2
+   USE ice_2
+#elif defined key_lim3
+   USE ice
+   USE limvar          ! redistribute ice input into categories
+#endif
+   USE sbcapr
+   USE sbctide         ! Tidal forcing or not
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_dta          ! routine called by step.F90 and dynspg_ts.F90
+   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90
+
+   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set.
+   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets.
+   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions
+                                                               ! =F => baroclinic velocities in 3D boundary conditions
+!$AGRIF_DO_NOT_TREAT
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read)
+!$AGRIF_END_DO_NOT_TREAT
+   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap
+
+#if defined key_lim3
+   LOGICAL :: ll_bdylim3                  ! determine whether ice input is lim2 (F) or lim3 (T) type
+   INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+      SUBROUTINE bdy_dta( kt, jit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                   ***  SUBROUTINE bdy_dta  ***
+      !!                    
+      !! ** Purpose :   Update external data for open boundary conditions
+      !!
+      !! ** Method  :   Use fldread.F90
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index 
+      INTEGER, INTENT(in), OPTIONAL ::   jit          ! subcycle time-step index (for timesplitting option)
+      INTEGER, INTENT(in), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit
+      !                                               ! is present then units = subcycle timesteps.
+      !                                               ! time_offset = 0 => get data at "now" time level
+      !                                               ! time_offset = -1 => get data at "before" time level
+      !                                               ! time_offset = +1 => get data at "after" time level
+      !                                               ! etc.
+      !
+      INTEGER ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices
+      INTEGER,          DIMENSION(jpbgrd) ::   ilen1 
+      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts
+      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut
+      !!---------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dta')
+      !
+      ! Initialise data arrays once for all from initial conditions where required
+      !---------------------------------------------------------------------------
+      IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN
+
+         ! Calculate depth-mean currents
+         !-----------------------------
+         
+         DO ib_bdy = 1, nb_bdy
+            !
+            nblen => idx_bdy(ib_bdy)%nblen
+            nblenrim => idx_bdy(ib_bdy)%nblenrim
+            dta => dta_bdy(ib_bdy)
+
+            IF( nn_dyn2d_dta(ib_bdy) == 0 ) THEN 
+               ilen1(:) = nblen(:)
+               IF( dta%ll_ssh ) THEN 
+                  igrd = 1
+                  DO ib = 1, ilen1(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)         
+                  END DO 
+               END IF
+               IF( dta%ll_u2d ) THEN 
+                  igrd = 2
+                  DO ib = 1, ilen1(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)         
+                  END DO 
+               END IF
+               IF( dta%ll_v2d ) THEN 
+                  igrd = 3
+                  DO ib = 1, ilen1(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)         
+                  END DO 
+               END IF
+            ENDIF
+
+            IF( nn_dyn3d_dta(ib_bdy) == 0 ) THEN 
+               ilen1(:) = nblen(:)
+               IF( dta%ll_u3d ) THEN 
+                  igrd = 2 
+                  DO ib = 1, ilen1(igrd)
+                     DO ik = 1, jpkm1
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)         
+                     END DO
+                  END DO 
+               END IF
+               IF( dta%ll_v3d ) THEN 
+                  igrd = 3 
+                  DO ib = 1, ilen1(igrd)
+                     DO ik = 1, jpkm1
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)         
+                        END DO
+                  END DO 
+               END IF
+            ENDIF
+
+            IF( nn_tra_dta(ib_bdy) == 0 ) THEN 
+               ilen1(:) = nblen(:)
+               IF( dta%ll_tem ) THEN
+                  igrd = 1 
+                  DO ib = 1, ilen1(igrd)
+                     DO ik = 1, jpkm1
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)         
+                     END DO
+                  END DO 
+               END IF
+               IF( dta%ll_sal ) THEN
+                  igrd = 1 
+                  DO ib = 1, ilen1(igrd)
+                     DO ik = 1, jpkm1
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)         
+                     END DO
+                  END DO 
+               END IF
+            ENDIF
+
+#if defined key_lim2
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
+               ilen1(:) = nblen(:)
+               IF( dta%ll_frld ) THEN
+                  igrd = 1 
+                  DO ib = 1, ilen1(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)         
+                  END DO 
+               END IF
+               IF( dta%ll_hicif ) THEN
+                  igrd = 1 
+                  DO ib = 1, ilen1(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)         
+                  END DO 
+               END IF
+               IF( dta%ll_hsnif ) THEN
+                  igrd = 1 
+                  DO ib = 1, ilen1(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)         
+                  END DO 
+               END IF
+            ENDIF
+#elif defined key_lim3
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
+               ilen1(:) = nblen(:)
+               IF( dta%ll_a_i ) THEN
+                  igrd = 1   
+                  DO jl = 1, jpl
+                     DO ib = 1, ilen1(igrd)
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%a_i (ib,jl) =  a_i(ii,ij,jl) * tmask(ii,ij,1) 
+                     END DO
+                  END DO
+               ENDIF
+               IF( dta%ll_ht_i ) THEN
+                  igrd = 1   
+                  DO jl = 1, jpl
+                     DO ib = 1, ilen1(igrd)
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%ht_i (ib,jl) =  ht_i(ii,ij,jl) * tmask(ii,ij,1) 
+                     END DO
+                  END DO
+               ENDIF
+               IF( dta%ll_ht_s ) THEN
+                  igrd = 1   
+                  DO jl = 1, jpl
+                     DO ib = 1, ilen1(igrd)
+                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        dta_bdy(ib_bdy)%ht_s (ib,jl) =  ht_s(ii,ij,jl) * tmask(ii,ij,1) 
+                     END DO
+                  END DO
+               ENDIF
+            ENDIF
+#endif
+         END DO ! ib_bdy
+         !
+      ENDIF ! kt == nit000
+
+      ! update external data from files
+      !--------------------------------
+     
+      jstart = 1
+      DO ib_bdy = 1, nb_bdy   
+         dta => dta_bdy(ib_bdy)
+         IF( nn_dta(ib_bdy) == 1 ) THEN ! skip this bit if no external data required
+      
+            IF( PRESENT(jit) ) THEN
+               ! Update barotropic boundary conditions only
+               ! jit is optional argument for fld_read and bdytide_update
+               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
+                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
+                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
+                     IF( dta%ll_u3d ) dta%v2d(:) = 0._wp
+                  ENDIF
+                  IF (cn_tra(ib_bdy) /= 'runoff') THEN
+                     IF( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 ) THEN
+
+                        jend = jstart + dta%nread(2) - 1
+                        IF( ln_full_vel_array(ib_bdy) ) THEN
+                           CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  &
+                                     & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(ib_bdy)  )
+                        ELSE
+                           CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  &
+                                     & kit=jit, kt_offset=time_offset  )
+                        ENDIF
+
+                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields
+                        IF( ln_full_vel_array(ib_bdy) .AND.                                             &
+                          &    ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR.  &
+                          &      nn_dyn3d_dta(ib_bdy) == 1 ) )THEN
+
+                           igrd = 2                      ! zonal velocity
+                           dta%u2d(:) = 0._wp
+                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                              DO ik = 1, jpkm1
+                                 dta%u2d(ib) = dta%u2d(ib) &
+                       &                          + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
+                              END DO
+                              dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij)
+                           END DO
+                           igrd = 3                      ! meridional velocity
+                           dta%v2d(:) = 0._wp
+                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                              DO ik = 1, jpkm1
+                                 dta%v2d(ib) = dta%v2d(ib) &
+                       &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
+                              END DO
+                              dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij)
+                           END DO
+                        ENDIF                    
+                     ENDIF
+                     IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                        CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy),   & 
+                          &                 jit=jit, time_offset=time_offset )
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ELSE
+               IF (cn_tra(ib_bdy) == 'runoff') then      ! runoff condition
+                  jend = nb_bdy_fld(ib_bdy)
+                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  &
+                               & map=nbmap_ptr(jstart:jend), kt_offset=time_offset )
+                  !
+                  igrd = 2                      ! zonal velocity
+                  DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )
+                  END DO
+                  !
+                  igrd = 3                      ! meridional velocity
+                  DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )
+                  END DO
+               ELSE
+                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp
+                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp
+                     IF( dta%ll_v2d ) dta%v2d(:) = 0._wp
+                  ENDIF
+                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data
+                     jend = jstart + dta%nread(1) - 1
+                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), &
+                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(ib_bdy) )
+                  ENDIF
+                  ! If full velocities in boundary data then split into barotropic and baroclinic data
+                  IF( ln_full_vel_array(ib_bdy) .and.                                             &
+                    & ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. &
+                    &   nn_dyn3d_dta(ib_bdy) == 1 ) ) THEN
+                     igrd = 2                      ! zonal velocity
+                     dta%u2d(:) = 0._wp
+                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        DO ik = 1, jpkm1
+                           dta%u2d(ib) = dta%u2d(ib) &
+                 &                       + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik)
+                        END DO
+                        dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij)
+                        DO ik = 1, jpkm1
+                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib)
+                        END DO
+                     END DO
+                     igrd = 3                      ! meridional velocity
+                     dta%v2d(:) = 0._wp
+                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                        DO ik = 1, jpkm1
+                           dta%v2d(ib) = dta%v2d(ib) &
+                 &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik)
+                        END DO
+                        dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij)
+                        DO ik = 1, jpkm1
+                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib)
+                        END DO
+                     END DO
+                  ENDIF
+
+               ENDIF
+#if defined key_lim3
+               IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)
+     	          CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
+                                  & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     )
+               ENDIF
+#endif
+            ENDIF
+            jstart = jstart + dta%nread(1)
+         END IF ! nn_dta(ib_bdy) = 1
+      END DO  ! ib_bdy
+
+      IF ( ln_tide ) THEN
+         IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                           
+            DO ib_bdy = 1, nb_bdy    ! Tidal component added in ts loop
+               IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
+                  nblen => idx_bdy(ib_bdy)%nblen
+                  nblenrim => idx_bdy(ib_bdy)%nblenrim
+                  IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 
+                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1))
+                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2))
+                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3))
+               ENDIF
+            END DO
+         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop
+            !
+            CALL bdy_dta_tides( kt=kt, time_offset=time_offset )
+         ENDIF
+      ENDIF
+
+      IF ( ln_apr_obc ) THEN
+         DO ib_bdy = 1, nb_bdy
+            IF (cn_tra(ib_bdy) /= 'runoff')THEN
+               igrd = 1                      ! meridional velocity
+               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+                  ii   = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                  dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij)
+               END DO
+            ENDIF
+         END DO
+      ENDIF
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta')
+      !
+   END SUBROUTINE bdy_dta
+
+
+   SUBROUTINE bdy_dta_init
+      !!----------------------------------------------------------------------
+      !!                   ***  SUBROUTINE bdy_dta_init  ***
+      !!                    
+      !! ** Purpose :   Initialise arrays for reading of external data 
+      !!                for open boundary conditions
+      !!
+      !! ** Method  :   
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER ::   ib_bdy, jfld, jstart, jend, ierror, ios     ! Local integers
+      !
+      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files
+      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files
+      CHARACTER(len = 256)::   clname                           ! temporary file name
+      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data
+                                                                ! =F => baroclinic velocities in 3D boundary data
+      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V)
+      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts
+      TYPE(OBC_DATA), POINTER                ::   dta           ! short cut
+#if defined key_lim3
+      INTEGER               ::   zndims   ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)
+      INTEGER               ::   inum,id1 ! local integer
+#endif
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures
+      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! 
+      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read
+#if defined key_lim2
+      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      !
+#elif defined key_lim3
+      TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s      
+#endif
+      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 
+#if defined key_lim2
+      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif
+#elif defined key_lim3
+      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s
+#endif
+      NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy
+      !!---------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) ''
+
+      ! Set nn_dta
+      DO ib_bdy = 1, nb_bdy
+         nn_dta(ib_bdy) = MAX(  nn_dyn2d_dta(ib_bdy)       &
+                               ,nn_dyn3d_dta(ib_bdy)       &
+                               ,nn_tra_dta(ib_bdy)         &
+#if ( defined key_lim2 || defined key_lim3 )
+                              ,nn_ice_lim_dta(ib_bdy)    &
+#endif
+                              )
+         IF(nn_dta(ib_bdy) > 1) nn_dta(ib_bdy) = 1
+      END DO
+
+      ! Work out upper bound of how many fields there are to read in and allocate arrays
+      ! ---------------------------------------------------------------------------
+      ALLOCATE( nb_bdy_fld(nb_bdy) )
+      nb_bdy_fld(:) = 0
+      DO ib_bdy = 1, nb_bdy         
+         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
+         ENDIF
+         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) == 1 ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
+         ENDIF
+         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) == 1  ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
+         ENDIF
+#if ( defined key_lim2 || defined key_lim3 )
+         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
+         ENDIF
+#endif               
+         IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy)
+      END DO            
+
+      nb_bdy_fld_sum = SUM( nb_bdy_fld )
+
+      ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror )
+      IF( ierror > 0 ) THEN   
+         CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' )   ;   RETURN  
+      ENDIF
+      ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror )
+      IF( ierror > 0 ) THEN   
+         CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' )   ;   RETURN  
+      ENDIF
+      ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror )
+      IF( ierror > 0 ) THEN   
+         CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN  
+      ENDIF
+      ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 
+      ALLOCATE( ibdy(nb_bdy_fld_sum) ) 
+      ALLOCATE( igrid(nb_bdy_fld_sum) ) 
+
+      ! Read namelists
+      ! --------------
+      REWIND(numnam_ref)
+      REWIND(numnam_cfg)
+      jfld = 0 
+      DO ib_bdy = 1, nb_bdy         
+         IF( nn_dta(ib_bdy) == 1 ) THEN
+            READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901)
+901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )
+
+            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 )
+902         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )
+            IF(lwm) WRITE( numond, nambdy_dta )
+
+            cn_dir_array(ib_bdy) = cn_dir
+            ln_full_vel_array(ib_bdy) = ln_full_vel
+
+            nblen => idx_bdy(ib_bdy)%nblen
+            nblenrim => idx_bdy(ib_bdy)%nblenrim
+            dta => dta_bdy(ib_bdy)
+            dta%nread(2) = 0
+
+            ! Only read in necessary fields for this set.
+            ! Important that barotropic variables come first.
+            IF( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 
+
+               IF( dta%ll_ssh ) THEN 
+                  if(lwp) write(numout,*) '++++++ reading in ssh field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_ssh
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = 1
+                  dta%nread(2) = dta%nread(2) + 1
+               ENDIF
+
+               IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN
+                  if(lwp) write(numout,*) '++++++ reading in u2d field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_u2d
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 2
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = 1
+                  dta%nread(2) = dta%nread(2) + 1
+               ENDIF
+
+               IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN
+                  if(lwp) write(numout,*) '++++++ reading in v2d field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_v2d
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 3
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = 1
+                  dta%nread(2) = dta%nread(2) + 1
+               ENDIF
+
+            ENDIF
+
+            ! read 3D velocities if baroclinic velocities require OR if
+            ! barotropic velocities required and ln_full_vel set to .true.
+            IF( nn_dyn3d_dta(ib_bdy) == 1 .OR. &
+           &  ( ln_full_vel_array(ib_bdy) .AND. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN
+
+               IF( dta%ll_u3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
+                  if(lwp) write(numout,*) '++++++ reading in u3d field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_u3d
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 2
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = jpk
+                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1
+               ENDIF
+
+               IF( dta%ll_v3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN
+                  if(lwp) write(numout,*) '++++++ reading in v3d field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_v3d
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 3
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = jpk
+                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1
+               ENDIF
+
+            ENDIF
+
+            ! temperature and salinity
+            IF( nn_tra_dta(ib_bdy) == 1 ) THEN
+
+               IF( dta%ll_tem ) THEN
+                  if(lwp) write(numout,*) '++++++ reading in tem field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_tem
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = jpk
+               ENDIF
+
+               IF( dta%ll_sal ) THEN
+                  if(lwp) write(numout,*) '++++++ reading in sal field'
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_sal
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = jpk
+               ENDIF
+
+            ENDIF
+
+#if defined key_lim2
+            ! sea ice
+            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN
+
+               IF( dta%ll_frld ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_frld
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = 1
+               ENDIF
+
+               IF( dta%ll_hicif ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_hicif
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = 1
+               ENDIF
+
+               IF( dta%ll_hsnif ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_hsnif
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  ilen3(jfld) = 1
+               ENDIF
+
+            ENDIF
+#elif defined key_lim3
+            ! sea ice
+            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN
+               ! Test for types of ice input (lim2 or lim3) 
+               ! Build file name to find dimensions 
+               clname=TRIM( cn_dir )//TRIM(bn_a_i%clname)
+               IF( .NOT. bn_a_i%ln_clim ) THEN   
+                                                  WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear    ! add year
+                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth   ! add month
+               ELSE
+                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth   ! add month
+               ENDIF
+               IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) &
+               &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday     ! add day
+               !
+               CALL iom_open  ( clname, inum )
+               id1 = iom_varid( inum, bn_a_i%clvar, kndims=zndims, ldstop = .FALSE. )
+               CALL iom_close ( inum )
+
+      	       IF ( zndims == 4 ) THEN
+                 ll_bdylim3 = .TRUE.   ! lim3 input
+               ELSE
+                 ll_bdylim3 = .FALSE.  ! lim2 input      
+               ENDIF
+               ! End test
+
+               IF( dta%ll_a_i ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_a_i
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
+               ENDIF
+
+               IF( dta%ll_ht_i ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_ht_i
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
+               ENDIF
+
+               IF( dta%ll_ht_s ) THEN
+                  jfld = jfld + 1
+                   blf_i(jfld) = bn_ht_s
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblen(igrid(jfld))
+                  IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF
+               ENDIF
+
+            ENDIF
+#endif
+            ! Recalculate field counts
+            !-------------------------
+            IF( ib_bdy == 1 ) THEN 
+               nb_bdy_fld_sum = 0
+               nb_bdy_fld(ib_bdy) = jfld
+               nb_bdy_fld_sum     = jfld              
+            ELSE
+               nb_bdy_fld(ib_bdy) = jfld - nb_bdy_fld_sum
+               nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(ib_bdy)
+            ENDIF
+
+            dta%nread(1) = nb_bdy_fld(ib_bdy)
+
+         ENDIF ! nn_dta == 1
+      ENDDO ! ib_bdy
+
+      DO jfld = 1, nb_bdy_fld_sum
+         ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) )
+         IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
+         nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
+         nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld))
+      ENDDO
+
+      ! fill bf with blf_i and control print
+      !-------------------------------------
+      jstart = 1
+      DO ib_bdy = 1, nb_bdy
+         jend = jstart - 1 + nb_bdy_fld(ib_bdy) 
+         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta',   &
+         &              'open boundary conditions', 'nambdy_dta' )
+         jstart = jend + 1
+      ENDDO
+
+      ! Initialise local boundary data arrays
+      ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later
+      ! nn_xxx_dta=1 : point to "fnow" arrays
+      !-------------------------------------
+
+      jfld = 0
+      DO ib_bdy=1, nb_bdy
+
+         nblen => idx_bdy(ib_bdy)%nblen
+         dta => dta_bdy(ib_bdy)
+
+         if(lwp) then
+            write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh
+            write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d
+            write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d
+            write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d
+            write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d
+            write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem
+            write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal
+         endif
+
+         IF ( nn_dyn2d_dta(ib_bdy) == 0 .or. nn_dyn2d_dta(ib_bdy) == 2 ) THEN
+            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space'
+            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) )
+            IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) )
+            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) )
+         ENDIF
+         IF ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN
+            IF( dta%ll_ssh ) THEN
+               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow'
+               jfld = jfld + 1
+               dta%ssh => bf(jfld)%fnow(:,1,1)
+            ENDIF
+            IF ( dta%ll_u2d ) THEN
+               IF ( ln_full_vel_array(ib_bdy) ) THEN
+                  if(lwp) write(numout,*) '++++++ dta%u2d allocated space'
+                  ALLOCATE( dta%u2d(nblen(2)) )
+               ELSE
+                  if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow'
+                  jfld = jfld + 1
+                  dta%u2d => bf(jfld)%fnow(:,1,1)
+               ENDIF
+            ENDIF
+            IF ( dta%ll_v2d ) THEN
+               IF ( ln_full_vel_array(ib_bdy) ) THEN
+                  if(lwp) write(numout,*) '++++++ dta%v2d allocated space'
+                  ALLOCATE( dta%v2d(nblen(3)) )
+               ELSE
+                  if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow'
+                  jfld = jfld + 1
+                  dta%v2d => bf(jfld)%fnow(:,1,1)
+               ENDIF
+            ENDIF
+         ENDIF
+
+         IF ( nn_dyn3d_dta(ib_bdy) == 0 ) THEN
+            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space'
+            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) )
+            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) )
+         ENDIF
+         IF ( nn_dyn3d_dta(ib_bdy) == 1 .or. &
+           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN
+            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN
+               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow'
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:)
+            ENDIF
+            IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN
+               if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow'
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:)
+            ENDIF
+         ENDIF
+
+         IF( nn_tra_dta(ib_bdy) == 0 ) THEN
+            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space'
+            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) )
+            IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) )
+         ELSE
+            IF( dta%ll_tem ) THEN
+               if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow'
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:)
+            ENDIF
+            IF( dta%ll_sal ) THEN 
+               if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow'
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:)
+            ENDIF
+         ENDIF
+
+#if defined key_lim2
+         IF (cn_ice_lim(ib_bdy) /= 'none') THEN
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN
+               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) )
+               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) )
+               ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) )
+            ELSE
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1)
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1)
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1)
+            ENDIF
+         ENDIF
+#elif defined key_lim3
+         IF (cn_ice_lim(ib_bdy) /= 'none') THEN
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN
+               ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
+               ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
+               ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
+            ELSE
+               IF ( ll_bdylim3 ) THEN ! case input is lim3 type
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%a_i  => bf(jfld)%fnow(:,1,:)
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:)
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:)
+               ELSE ! case input is lim2 type
+                  jfld_ai  = jfld + 1
+                  jfld_hti = jfld + 2
+                  jfld_hts = jfld + 3
+                  jfld     = jfld + 3
+                  ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) )
+                  ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) )
+                  ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) )
+                  dta_bdy(ib_bdy)%a_i (:,:) = 0._wp
+                  dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp
+                  dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp
+               ENDIF
+
+            ENDIF
+         ENDIF
+#endif
+         !
+      END DO ! ib_bdy 
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
+      !
+   END SUBROUTINE bdy_dta_init
+
+   !!==============================================================================
+END MODULE bdydta
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 8732)
@@ -0,0 +1,136 @@
+MODULE bdydyn
+   !!======================================================================
+   !!                       ***  MODULE  bdydyn  ***
+   !! Unstructured Open Boundary Cond. :   Apply boundary conditions to velocities
+   !!======================================================================
+   !! History :  1.0  !  2005-02  (J. Chanut, A. Sellar)  Original code
+   !!             -   !  2007-07  (D. Storkey) Move Flather implementation to separate routine.
+   !!            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
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!----------------------------------------------------------------------
+   !!   bdy_dyn        : split velocities into barotropic and baroclinic parts
+   !!                    and call bdy_dyn2d and bdy_dyn3d to apply boundary
+   !!                    conditions
+   !!----------------------------------------------------------------------
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE bdy_oce         ! ocean open boundary conditions
+   USE bdydyn2d        ! open boundary conditions for barotropic solution
+   USE bdydyn3d        ! open boundary conditions for baroclinic velocities
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  !
+   USE domvvl          ! variable volume
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_dyn    ! routine called in dyn_nxt
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_dyn( kt, dyn3d_only )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn  ***
+      !!
+      !! ** Purpose : - Wrapper routine for bdy_dyn2d and bdy_dyn3d.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)           ::   kt           ! Main time step counter
+      LOGICAL, INTENT(in), OPTIONAL ::   dyn3d_only   ! T => only update baroclinic velocities
+      !
+      INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter
+      LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski
+      REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d     ! after barotropic velocities
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn')
+      !
+      ll_dyn2d = .true.
+      ll_dyn3d = .true.
+      !
+      IF( PRESENT(dyn3d_only) ) THEN
+         IF( dyn3d_only )   ll_dyn2d = .false.
+      ENDIF
+      !
+      ll_orlanski = .false.
+      DO ib_bdy = 1, nb_bdy
+         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' &
+     &   .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo')   ll_orlanski = .true.
+      END DO
+
+      !-------------------------------------------------------
+      ! Set pointers
+      !-------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,   pua2d, pva2d ) 
+
+      !-------------------------------------------------------
+      ! Split velocities into barotropic and baroclinic parts
+      !-------------------------------------------------------
+
+      !                          ! "After" velocities: 
+      pua2d(:,:) = 0._wp
+      pva2d(:,:) = 0._wp     
+      DO jk = 1, jpkm1
+         pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
+         pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
+      END DO
+      pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:)
+      pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:)
+
+      DO jk = 1 , jpkm1
+         ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk)
+         va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk)
+      END DO
+
+
+      IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only) 
+         DO jk = 1 , jpkm1
+            ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk)
+            vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk)
+         END DO
+      ENDIF
+
+      !-------------------------------------------------------
+      ! Apply boundary conditions to barotropic and baroclinic
+      ! parts separately
+      !-------------------------------------------------------
+
+      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha )
+
+      IF( ll_dyn3d )   CALL bdy_dyn3d( kt )
+
+      !-------------------------------------------------------
+      ! Recombine velocities
+      !-------------------------------------------------------
+      !
+      DO jk = 1 , jpkm1
+         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk)
+         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk)
+      END DO
+      !
+      IF ( ll_orlanski ) THEN
+         DO jk = 1 , jpkm1
+            ub(:,:,jk) = ( ub(:,:,jk) + ub_b(:,:) ) * umask(:,:,jk)
+            vb(:,:,jk) = ( vb(:,:,jk) + vb_b(:,:) ) * vmask(:,:,jk)
+         END DO
+      END IF
+      !
+      CALL wrk_dealloc( jpi,jpj,  pua2d, pva2d ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn')
+      !
+   END SUBROUTINE bdy_dyn
+
+   !!======================================================================
+END MODULE bdydyn
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 8732)
@@ -0,0 +1,310 @@
+MODULE bdydyn2d
+   !!======================================================================
+   !!                       ***  MODULE  bdydyn  ***
+   !! Unstructured Open Boundary Cond. :   Apply boundary conditions to barotropic solution
+   !!======================================================================
+   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
+   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
+   !!----------------------------------------------------------------------
+   !!   bdy_dyn2d          : Apply open boundary conditions to barotropic variables.
+   !!   bdy_dyn2d_frs      : Apply Flow Relaxation Scheme 
+   !!   bdy_dyn2d_fla      : Apply Flather condition
+   !!   bdy_dyn2d_orlanski : Orlanski Radiation
+   !!   bdy_ssh            : Duplicate sea level across open boundaries
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE bdy_oce         ! ocean open boundary conditions
+   USE bdylib          ! BDY library routines
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_dyn2d   ! routine called in dynspg_ts and bdy_dyn
+   PUBLIC   bdy_ssh       ! routine called in dynspg_ts or sshwzv
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh  )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn2d  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for barotropic variables
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                      INTENT(in) ::   kt   ! Main time step counter
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh
+      !!
+      INTEGER                                  ::   ib_bdy ! Loop counter
+
+      DO ib_bdy=1, nb_bdy
+
+         SELECT CASE( cn_dyn2d(ib_bdy) )
+         CASE('none')
+            CYCLE
+         CASE('frs')
+            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d )
+         CASE('flather')
+            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr )
+         CASE('orlanski')
+            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, &
+                                     & pua2d, pva2d, pub2d, pvb2d, ll_npo=.false.)
+         CASE('orlanski_npo')
+            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, &
+                                     & pua2d, pva2d, pub2d, pvb2d, ll_npo=.true. )
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' )
+         END SELECT
+      ENDDO
+
+   END SUBROUTINE bdy_dyn2d
+
+   SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn2d_frs  ***
+      !!
+      !! ** Purpose : - Apply the Flow Relaxation Scheme for barotropic velocities
+      !!                at open boundaries.
+      !!
+      !! References :- Engedahl H., 1995: Use of the flow relaxation scheme in 
+      !!               a three-dimensional baroclinic ocean model with realistic
+      !!               topography. Tellus, 365-382.
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
+      !!
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_frs')
+      !
+      igrd = 2                      ! Relaxation of zonal velocity
+      DO jb = 1, idx%nblen(igrd)
+         ii   = idx%nbi(jb,igrd)
+         ij   = idx%nbj(jb,igrd)
+         zwgt = idx%nbw(jb,igrd)
+         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1)
+      END DO
+      !
+      igrd = 3                      ! Relaxation of meridional velocity
+      DO jb = 1, idx%nblen(igrd)
+         ii   = idx%nbi(jb,igrd)
+         ij   = idx%nbj(jb,igrd)
+         zwgt = idx%nbw(jb,igrd)
+         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1)
+      END DO 
+      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) 
+      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy)   ! Boundary points should be updated
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs')
+      !
+
+   END SUBROUTINE bdy_dyn2d_frs
+
+
+   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_dyn2d_fla  ***
+      !!             
+      !!              - Apply Flather boundary conditions on normal barotropic velocities 
+      !!
+      !! ** WARNINGS about FLATHER implementation:
+      !!1. According to Palma and Matano, 1998 "after ssh" is used. 
+      !!   In ROMS and POM implementations, it is "now ssh". In the current 
+      !!   implementation (tested only in the EEL-R5 conf.), both cases were unstable. 
+      !!   So I use "before ssh" in the following.
+      !!
+      !!2. We assume that the normal ssh gradient at the bdy is zero. As a matter of 
+      !!   fact, the model ssh just inside the dynamical boundary is used (the outside  
+      !!   ssh in the code is not updated).
+      !!
+      !! References:  Flather, R. A., 1976: A tidal model of the northwest European
+      !!              continental shelf. Mem. Soc. R. Sci. Liege, Ser. 6,10, 141-164.     
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr 
+
+      INTEGER  ::   jb, igrd                         ! dummy loop indices
+      INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
+      REAL(wp), POINTER :: flagu, flagv              ! short cuts
+      REAL(wp) ::   zcorr                            ! Flather correction
+      REAL(wp) ::   zforc                            ! temporary scalar
+      REAL(wp) ::   zflag, z1_2                      !    "        "
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_fla')
+
+      z1_2 = 0.5_wp
+
+      ! ---------------------------------!
+      ! Flather boundary conditions     :!
+      ! ---------------------------------! 
+     
+!!! REPLACE spgu with nemo_wrk work space
+
+      ! Fill temporary array with ssh data (here spgu):
+      igrd = 1
+      spgu(:,:) = 0.0
+      DO jb = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(jb,igrd)
+         ij = idx%nbj(jb,igrd)
+         spgu(ii, ij) = dta%ssh(jb)
+      END DO
+
+      CALL lbc_bdy_lnk( spgu(:,:), 'T', 1., ib_bdy )
+      !
+      igrd = 2      ! Flather bc on u-velocity; 
+      !             ! remember that flagu=-1 if normal velocity direction is outward
+      !             ! I think we should rather use after ssh ?
+      DO jb = 1, idx%nblenrim(igrd)
+         ii  = idx%nbi(jb,igrd)
+         ij  = idx%nbj(jb,igrd) 
+         flagu => idx%flagu(jb,igrd)
+         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary
+         iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary 
+         !
+         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
+
+         ! jchanut tschanges: Set zflag to 0 below to revert to Flather scheme
+         ! Use characteristics method instead
+         zflag = ABS(flagu)
+         zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(iim1,ij)
+         pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1) 
+      END DO
+      !
+      igrd = 3      ! Flather bc on v-velocity
+      !             ! remember that flagv=-1 if normal velocity direction is outward
+      DO jb = 1, idx%nblenrim(igrd)
+         ii  = idx%nbi(jb,igrd)
+         ij  = idx%nbj(jb,igrd) 
+         flagv => idx%flagv(jb,igrd)
+         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary
+         ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary 
+         !
+         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
+
+         ! jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme
+         ! Use characteristics method instead
+         zflag = ABS(flagv)
+         zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1)
+         pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1)
+      END DO
+      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
+      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   !
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla')
+      !
+   END SUBROUTINE bdy_dyn2d_fla
+
+
+   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, ll_npo )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  ***
+      !!             
+      !!              - Apply Orlanski radiation condition adaptively:
+      !!                  - radiation plus weak nudging at outflow points
+      !!                  - no radiation and strong nudging at inflow points
+      !! 
+      !!
+      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d 
+      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version
+
+      INTEGER  ::   ib, igrd                               ! dummy loop indices
+      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_orlanski')
+      !
+      igrd = 2      ! Orlanski bc on u-velocity; 
+      !            
+      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo )
+
+      igrd = 3      ! Orlanski bc on v-velocity
+      !  
+      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski')
+      !
+      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated
+      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   !
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski')
+      !
+   END SUBROUTINE bdy_dyn2d_orlanski
+
+   SUBROUTINE bdy_ssh( zssh )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_ssh  ***
+      !!
+      !! ** Purpose : Duplicate sea level across open boundaries
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level
+      !!
+      INTEGER  ::   ib_bdy, ib, igrd                        ! local integers
+      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       "
+
+      igrd = 1                       ! Everything is at T-points here
+
+      DO ib_bdy = 1, nb_bdy
+         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+            ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+            ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+            ! Set gradient direction:
+            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  )
+            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1)
+            IF ( zcoef1+zcoef2 == 0 ) THEN
+               ! corner
+!               zcoef = tmask(ii-1,ij,1) + tmask(ii+1,ij,1) +  tmask(ii,ij-1,1) +  tmask(ii,ij+1,1)
+!               zssh(ii,ij) = zssh(ii-1,ij  ) * tmask(ii-1,ij  ,1) + &
+!                 &           zssh(ii+1,ij  ) * tmask(ii+1,ij  ,1) + &
+!                 &           zssh(ii  ,ij-1) * tmask(ii  ,ij-1,1) + &
+!                 &           zssh(ii  ,ij+1) * tmask(ii  ,ij+1,1)
+               zcoef = bdytmask(ii-1,ij) + bdytmask(ii+1,ij) +  bdytmask(ii,ij-1) +  bdytmask(ii,ij+1)
+               zssh(ii,ij) = zssh(ii-1,ij  ) * bdytmask(ii-1,ij  ) + &
+                 &           zssh(ii+1,ij  ) * bdytmask(ii+1,ij  ) + &
+                 &           zssh(ii  ,ij-1) * bdytmask(ii  ,ij-1) + &
+                 &           zssh(ii  ,ij+1) * bdytmask(ii  ,ij+1)
+               zssh(ii,ij) = ( zssh(ii,ij) / MAX( 1, zcoef) ) * tmask(ii,ij,1)
+            ELSE
+               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
+               zssh(ii,ij) = zssh(ii+ip,ij+jp) * tmask(ii+ip,ij+jp,1)
+            ENDIF
+         END DO
+
+         ! Boundary points should be updated
+         CALL lbc_bdy_lnk( zssh(:,:), 'T', 1., ib_bdy )
+      END DO
+
+   END SUBROUTINE bdy_ssh
+
+   !!======================================================================
+END MODULE bdydyn2d
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 8732)
@@ -0,0 +1,380 @@
+MODULE bdydyn3d
+   !!======================================================================
+   !!                       ***  MODULE  bdydyn3d  ***
+   !! Unstructured Open Boundary Cond. :   Flow relaxation scheme on baroclinic velocities
+   !!======================================================================
+   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite 
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
+   !!----------------------------------------------------------------------
+   !!   bdy_dyn3d        : apply open boundary conditions to baroclinic velocities
+   !!   bdy_dyn3d_frs    : apply Flow Relaxation Scheme
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE bdy_oce         ! ocean open boundary conditions
+   USE bdylib          ! for orlanski library routines
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  !
+   Use phycst
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_dyn3d     ! routine called by bdy_dyn
+   PUBLIC   bdy_dyn3d_dmp ! routine called by step
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_dyn3d( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for baroclinic velocities
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! loop index
+      !!----------------------------------------------------------------------
+      !
+      DO ib_bdy=1, nb_bdy
+         !
+         SELECT CASE( cn_dyn3d(ib_bdy) )
+         CASE('none')        ;   CYCLE
+         CASE('frs' )        ;   CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('specified')   ;   CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('zero')        ;   CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. )
+         CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. )
+         CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy )
+         CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
+         END SELECT
+      END DO
+      !
+   END SUBROUTINE bdy_dyn3d
+
+
+   SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_spe  ***
+      !!
+      !! ** Purpose : - Apply a specified value for baroclinic velocities
+      !!                at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER        , INTENT(in) ::   kt      ! time step index
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
+      INTEGER        , INTENT(in) ::   ib_bdy  ! BDY set index
+      !
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_spe')
+      !
+      igrd = 2                      ! Relaxation of zonal velocity
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk)
+         END DO
+      END DO
+      !
+      igrd = 3                      ! Relaxation of meridional velocity
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk)
+         END DO
+      END DO
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated  
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )   
+      !
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe')
+      !
+   END SUBROUTINE bdy_dyn3d_spe
+
+   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  ***
+      !!
+      !! ** Purpose : - Enforce a zero gradient of normal velocity
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                     ::   kt
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      !!
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   fu, fv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad')
+      !
+      igrd = 2                      ! Copying tangential velocity into bdy points
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 )
+            ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) &
+                        &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu )
+         END DO
+      END DO
+      !
+      igrd = 3                      ! Copying tangential velocity into bdy points
+      DO jb = 1, idx%nblenrim(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 )
+            va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) &
+                        &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv )
+         END DO
+      END DO
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated  
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )   
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad')
+
+   END SUBROUTINE bdy_dyn3d_zgrad
+
+   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_zro  ***
+      !!
+      !! ** Purpose : - baroclinic velocities = 0. at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER        , INTENT(in) ::   kt      ! time step index
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      !
+      INTEGER  ::   ib, ik         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zro')
+      !
+      igrd = 2                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            ua(ii,ij,ik) = 0._wp
+         END DO
+      END DO
+
+      igrd = 3                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            va(ii,ij,ik) = 0._wp
+         END DO
+      END DO
+      !
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated
+      !
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_zro')
+      !
+   END SUBROUTINE bdy_dyn3d_zro
+
+
+   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_frs  ***
+      !!
+      !! ** Purpose : - Apply the Flow Relaxation Scheme for baroclinic velocities
+      !!                at open boundaries.
+      !!
+      !! References :- 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      ! time step index
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      !
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_frs')
+      !
+      igrd = 2                      ! Relaxation of zonal velocity
+      DO jb = 1, idx%nblen(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            zwgt = idx%nbw(jb,igrd)
+            ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk)
+         END DO
+      END DO
+      !
+      igrd = 3                      ! Relaxation of meridional velocity
+      DO jb = 1, idx%nblen(igrd)
+         DO jk = 1, jpkm1
+            ii   = idx%nbi(jb,igrd)
+            ij   = idx%nbj(jb,igrd)
+            zwgt = idx%nbw(jb,igrd)
+            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk)
+         END DO
+      END DO 
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )   
+      !
+      IF( kt == nit000 )   CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_frs')
+      !
+   END SUBROUTINE bdy_dyn3d_frs
+
+
+   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  ***
+      !!             
+      !!              - Apply Orlanski radiation to baroclinic velocities. 
+      !!              - Wrapper routine for bdy_orlanski_3d
+      !! 
+      !!
+      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
+      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version
+
+      INTEGER  ::   jb, igrd                               ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_orlanski')
+      !
+      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 
+      !
+      igrd = 2      ! Orlanski bc on u-velocity; 
+      !            
+      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo )
+
+      igrd = 3      ! Orlanski bc on v-velocity
+      !  
+      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo )
+      !
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )   
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_orlanski')
+      !
+   END SUBROUTINE bdy_dyn3d_orlanski
+
+
+   SUBROUTINE bdy_dyn3d_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn3d_dmp  ***
+      !!
+      !! ** Purpose : Apply damping for baroclinic velocities at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ib_bdy         ! loop index
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn3d_dmp')
+      !
+      DO ib_bdy=1, nb_bdy
+         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN
+            igrd = 2                      ! Relaxation of zonal velocity
+            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
+               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
+               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
+               DO jk = 1, jpkm1
+                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - &
+                                   ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk)
+               END DO
+            END DO
+            !
+            igrd = 3                      ! Relaxation of meridional velocity
+            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
+               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
+               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd)
+               DO jk = 1, jpkm1
+                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  &
+                                   vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk)
+               END DO
+            END DO
+         ENDIF
+      END DO
+      !
+      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_dmp')
+      !
+   END SUBROUTINE bdy_dyn3d_dmp
+
+   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  ***
+      !!             
+      !!              - Apply Neumann condition to baroclinic velocities. 
+      !!              - Wrapper routine for bdy_nmn
+      !! 
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
+      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
+
+      INTEGER  ::   jb, igrd                               ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn')
+      !
+      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 
+      !
+      igrd = 2      ! Neumann bc on u-velocity; 
+      !            
+      CALL bdy_nmn( idx, igrd, ua )
+
+      igrd = 3      ! Neumann bc on v-velocity
+      !  
+      CALL bdy_nmn( idx, igrd, va )
+      !
+      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated
+      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn')
+      !
+   END SUBROUTINE bdy_dyn3d_nmn
+
+   !!======================================================================
+END MODULE bdydyn3d
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90	(revision 8732)
@@ -0,0 +1,402 @@
+MODULE bdyice_lim
+   !!======================================================================
+   !!                       ***  MODULE  bdyice_lim  ***
+   !! Unstructured Open Boundary Cond. :  Open boundary conditions for sea-ice (LIM2 and LIM3)
+   !!======================================================================
+   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
+   !!             3.4  !  2011    (D. Storkey)  rewrite in preparation for OBC-BDY merge
+   !!              -   !  2012-01 (C. Rousset)  add lim3 and remove useless jk loop 
+   !!----------------------------------------------------------------------
+#if defined key_lim2 || defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                                 LIM-2 sea ice model
+   !!   'key_lim3'                                                 LIM-3 sea ice model
+   !!----------------------------------------------------------------------
+   !!   bdy_ice_lim        : Application of open boundaries to ice
+   !!   bdy_ice_frs        : Application of Flow Relaxation Scheme
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE phycst          ! physical constant
+   USE eosbn2          ! equation of state
+   USE oce             ! ocean dynamics and tracers variables
+#if defined key_lim2
+   USE par_ice_2
+   USE ice_2           ! LIM_2 ice variables
+   USE dom_ice_2       ! sea-ice domain
+#elif defined key_lim3
+   USE ice             ! LIM_3 ice variables
+   USE limvar
+   USE limctl
+#endif 
+   USE par_oce         ! ocean parameters
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE bdy_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! write to numout file
+   USE lib_mpp         ! distributed memory computing
+   USE lib_fortran     ! to use key_nosignedzero
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_ice_lim     ! routine called in sbcmod
+   PUBLIC   bdy_ice_lim_dyn ! routine called in limrhg
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_ice_lim( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_ice_lim  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for ice (LIM2 and LIM3)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! Main time step counter
+      !
+      INTEGER ::   ib_bdy   ! Loop index
+      !!----------------------------------------------------------------------
+      !
+#if defined key_lim3
+      CALL lim_var_glo2eqv
+#endif
+      !
+      DO ib_bdy=1, nb_bdy
+         !
+         SELECT CASE( cn_ice_lim(ib_bdy) )
+         CASE('none')
+            CYCLE
+         CASE('frs')
+            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' )
+         END SELECT
+         !
+      END DO
+      !
+#if defined key_lim3
+                        CALL lim_var_zapsmall
+                        CALL lim_var_agg(1)
+      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )
+#endif
+      !
+   END SUBROUTINE bdy_ice_lim
+
+
+   SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice_frs  ***
+      !!                    
+      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 
+      !!              of unstructured open boundaries.
+      !! 
+      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three-
+      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
+      !!------------------------------------------------------------------------------
+      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data
+      INTEGER,         INTENT(in) ::   kt      ! main time-step counter
+      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
+      !
+      INTEGER  ::   jpbound            ! 0 = incoming ice
+      !                                ! 1 = outgoing ice
+      INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices
+      INTEGER  ::   ji, jj, ii, ij     ! local scalar
+      REAL(wp) ::   zwgt, zwgt1        ! local scalar
+      REAL(wp) ::   ztmelts, zdh
+#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif
+     USE ice_2, vt_s => hsnm
+     USE ice_2, vt_i => hicm
+#endif
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs')
+      !
+      jgrd = 1      ! Everything is at T-points here
+      !
+#if defined key_lim2
+      DO jb = 1, idx%nblenrim(jgrd)
+         ji    = idx%nbi(jb,jgrd)
+         jj    = idx%nbj(jb,jgrd)
+         zwgt  = idx%nbw(jb,jgrd)
+         zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
+         frld (ji,jj) = ( frld (ji,jj) * zwgt1 + dta%frld (jb) * zwgt ) * tmask(ji,jj,1)     ! Leads fraction 
+         hicif(ji,jj) = ( hicif(ji,jj) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ji,jj,1)     ! Ice depth 
+         hsnif(ji,jj) = ( hsnif(ji,jj) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ji,jj,1)     ! Snow depth
+      END DO 
+
+      CALL lbc_bdy_lnk( frld,  'T', 1., ib_bdy )                                         ! lateral boundary conditions
+      CALL lbc_bdy_lnk( hicif, 'T', 1., ib_bdy )
+      CALL lbc_bdy_lnk( hsnif, 'T', 1., ib_bdy )
+
+      vt_i(:,:) = hicif(:,:) * frld(:,:)
+      vt_s(:,:) = hsnif(:,:) * frld(:,:)
+      !
+#elif defined key_lim3
+
+      DO jl = 1, jpl
+         DO jb = 1, idx%nblenrim(jgrd)
+            ji    = idx%nbi(jb,jgrd)
+            jj    = idx%nbj(jb,jgrd)
+            zwgt  = idx%nbw(jb,jgrd)
+            zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
+            a_i (ji,jj,jl) = ( a_i (ji,jj,jl) * zwgt1 + dta%a_i (jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction 
+            ht_i(ji,jj,jl) = ( ht_i(ji,jj,jl) * zwgt1 + dta%ht_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth 
+            ht_s(ji,jj,jl) = ( ht_s(ji,jj,jl) * zwgt1 + dta%ht_s(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth
+
+            ! -----------------
+            ! Pathological case
+            ! -----------------
+            ! In case a) snow load would be in excess or b) ice is coming into a warmer environment that would lead to 
+            ! very large transformation from snow to ice (see limthd_dh.F90)
+
+            ! Then, a) transfer the snow excess into the ice (different from limthd_dh)
+            zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 )
+            ! Or, b) transfer all the snow into ice (if incoming ice is likely to melt as it comes into a warmer environment)
+            !zdh = MAX( 0._wp, ht_s(ji,jj,jl) * rhosn / rhoic )
+
+            ! recompute ht_i, ht_s
+            ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
+            ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn ) 
+
+         ENDDO
+         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy )
+      ENDDO
+      ! retrieve at_i
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      DO jl = 1, jpl
+         DO jb = 1, idx%nblenrim(jgrd)
+            ji    = idx%nbi(jb,jgrd)
+            jj    = idx%nbj(jb,jgrd)
+
+            ! condition on ice thickness depends on the ice velocity
+            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values
+            jpbound = 0   ;   ii = ji   ;   ij = jj
+            !
+            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
+            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
+            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1
+            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1
+            !
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions
+            !                                                                 !      do not make state variables dependent on velocity
+            !
+            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
+            !
+            ! concentration and thickness
+            a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch
+            ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch
+            ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch
+            !
+            ! Ice and snow volumes
+            v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl)
+            v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl)
+            !
+            SELECT CASE( jpbound )
+            !
+            CASE( 0 )   ! velocity is inward
+               !
+               ! Ice salinity, age, temperature
+               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin
+               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl)
+               t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy)
+               DO jk = 1, nlay_s
+                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0
+               END DO
+               DO jk = 1, nlay_i
+                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 
+                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
+               END DO
+               !
+            CASE( 1 )   ! velocity is outward
+               !
+               ! Ice salinity, age, temperature
+               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin
+               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl)
+               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0
+               DO jk = 1, nlay_s
+                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
+               END DO
+               DO jk = 1, nlay_i
+                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
+                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
+               END DO
+               !
+            END SELECT
+            !
+            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_icesal
+               sm_i(ji,jj  ,jl) = rn_icesal
+               s_i (ji,jj,:,jl) = rn_icesal
+            ENDIF
+            !
+            ! contents
+            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
+            DO jk = 1, nlay_s
+               ! Snow energy of melting
+               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+               ! Multiply by volume, so that heat content in J/m2
+               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+            END DO
+            DO jk = 1, nlay_i
+               ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                  
+               ! heat content per unit volume
+               e_i(ji,jj,jk,jl) = rswitch * rhoic * &
+                  (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                  +   lfus    * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+                  - rcp      * ( ztmelts - rt0 ) )
+               ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
+            END DO
+            !
+         END DO
+         !
+         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk(  v_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk(  v_s(:,:,jl), 'T', 1., ib_bdy )
+         !
+         CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk(  oa_i(:,:,jl), 'T', 1., ib_bdy )
+         CALL lbc_bdy_lnk(  t_su(:,:,jl), 'T', 1., ib_bdy )
+         DO jk = 1, nlay_s
+            CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy )
+            CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy )
+         END DO
+         DO jk = 1, nlay_i
+            CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy )
+            CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )
+         END DO
+         !
+      END DO !jl
+      !
+#endif
+      !      
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs')
+      !
+   END SUBROUTINE bdy_ice_frs
+
+
+   SUBROUTINE bdy_ice_lim_dyn( cd_type )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice_lim_dyn  ***
+      !!                    
+      !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries.
+      !!              u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free
+      !!              if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities
+      !!
+      !! 2013-06 : C. Rousset
+      !!------------------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points
+      !
+      INTEGER  ::   jb, jgrd           ! dummy loop indices
+      INTEGER  ::   ji, jj             ! local scalar
+      INTEGER  ::   ib_bdy             ! Loop index
+      REAL(wp) ::   zmsk1, zmsk2, zflag
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn')
+      !
+      DO ib_bdy=1, nb_bdy
+         !
+         SELECT CASE( cn_ice_lim(ib_bdy) )
+         !
+         CASE('none')
+            CYCLE
+            !
+         CASE('frs')
+            !
+            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions 
+            !                                                  !      do not change ice velocity (it is only computed by rheology)
+            SELECT CASE ( cd_type )
+            !     
+            CASE ( 'U' )  
+               jgrd = 2      ! u velocity
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
+                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
+                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
+                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd)
+                  !
+                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries
+                     ! one of the two zmsk is always 0 (because of zflag)
+                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice
+                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice
+                     !  
+                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
+                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
+                        &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
+                  ELSE                             ! everywhere else
+                     !u_ice(ji,jj) = u_oce(ji,jj)
+                     u_ice(ji,jj) = 0._wp
+                  ENDIF
+                  ! mask ice velocities
+                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
+                  u_ice(ji,jj) = rswitch * u_ice(ji,jj)
+                  !
+               END DO
+               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
+               !
+            CASE ( 'V' )
+               jgrd = 3      ! v velocity
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)
+                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd)
+                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd)
+                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd)
+                  !
+                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries
+                     ! one of the two zmsk is always 0 (because of zflag)
+                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice
+                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice
+                     !  
+                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
+                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
+                        &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
+                  ELSE                             ! everywhere else
+                     !v_ice(ji,jj) = v_oce(ji,jj)
+                     v_ice(ji,jj) = 0._wp
+                  ENDIF
+                  ! mask ice velocities
+                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
+                  v_ice(ji,jj) = rswitch * v_ice(ji,jj)
+                  !
+               END DO
+               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
+               !
+            END SELECT
+            !
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' )
+         END SELECT
+         !
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn')
+      !
+    END SUBROUTINE bdy_ice_lim_dyn
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_ice_lim( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_ice_lim: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_ice_lim
+#endif
+
+   !!=================================================================================
+END MODULE bdyice_lim
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 8732)
@@ -0,0 +1,1763 @@
+MODULE bdyini
+   !!======================================================================
+   !!                       ***  MODULE  bdyini  ***
+   !! Unstructured open boundaries : initialisation
+   !!======================================================================
+   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
+   !!             -   !  2007-01  (D. Storkey) Update to use IOM module
+   !!             -   !  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
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.4  !  2012     (J. Chanut) straight open boundary case update
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) optimization of BDY communications
+   !!            3.7  !  2016     (T. Lovato) Remove bdy macro, call here init for dta and tides
+   !!----------------------------------------------------------------------
+   !!   bdy_init      : Initialization of unstructured open boundaries
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! unstructured open boundary conditions
+   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine)
+   USE bdytides       ! open boundary cond. setting   (bdytide_init routine)
+   USE sbctide        ! Tidal forcing or not
+   USE phycst   , ONLY: rday
+   !
+   USE in_out_manager ! I/O units
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! for mpp_sum  
+   USE iom            ! I/O
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_init   ! routine called in nemo_init
+
+   INTEGER, PARAMETER ::   jp_nseg = 100   ! 
+   INTEGER, PARAMETER ::   nrimmax =  20   ! maximum rimwidth in structured
+                                               ! open boundary data files
+   ! Straight open boundary segment parameters:
+   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs 
+   INTEGER, DIMENSION(jp_nseg) ::   jpieob, jpjedt, jpjeft, npckge   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpiwob, jpjwdt, jpjwft, npckgw   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpjnob, jpindt, jpinft, npckgn   !
+   INTEGER, DIMENSION(jp_nseg) ::   jpjsob, jpisdt, jpisft, npckgs   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_init  ***
+      !!
+      !! ** Purpose :   Initialization of the dynamics and tracer fields with
+      !!              unstructured open boundaries.
+      !!
+      !! ** Method  :   Read initialization arrays (mask, indices) to identify
+      !!              an unstructured open boundary
+      !!
+      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
+      !!----------------------------------------------------------------------
+      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice_lim, nn_ice_lim_dta,                             &
+         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
+         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+         !
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_init')
+
+      ! ------------------------
+      ! Read namelist parameters
+      ! ------------------------
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nambdy )
+
+      ! -----------------------------------------
+      ! unstructured open boundaries use control
+      ! -----------------------------------------
+      IF ( ln_bdy ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+         ! Open boundaries definition (arrays and masks)
+         CALL bdy_segs
+         !
+         ! Open boundaries initialisation of external data arrays
+         CALL bdy_dta_init
+         !
+         ! Open boundaries initialisation of tidal harmonic forcing
+         IF( ln_tide ) CALL bdytide_init
+         !
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'bdy_init : open boundaries not used (ln_bdy = F)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_init')
+      !
+   END SUBROUTINE bdy_init
+   
+   SUBROUTINE bdy_segs
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_init  ***
+      !!         
+      !! ** Purpose :   Definition of unstructured open boundaries.
+      !!
+      !! ** Method  :   Read initialization arrays (mask, indices) to identify 
+      !!              an unstructured open boundary
+      !!
+      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
+      !!----------------------------------------------------------------------      
+
+      ! local variables
+      !-------------------
+      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices
+      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers
+      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       -
+      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
+      INTEGER  ::   jpbdtau, jpbdtas                       !   -       -
+      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       -
+      INTEGER  ::   i_offset, j_offset                     !   -       -
+      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts
+      REAL(wp), POINTER  ::  flagu, flagv                  !    -   -
+      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields
+      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars
+      INTEGER, DIMENSION (2)                  ::   kdimsz
+      INTEGER, DIMENSION(jpbgrd,jp_bdy)       ::   nblendta         ! Length of index arrays 
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points
+      CHARACTER(LEN=1),DIMENSION(jpbgrd)      ::   cgrid
+      INTEGER :: com_east, com_west, com_south, com_north          ! Flags for boundaries sending
+      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving
+      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates
+      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat)
+      !!
+      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        - 
+      INTEGER                              ::   nbdyind, nbdybeg, nbdyend
+      !!
+      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_segs')
+      !
+      cgrid = (/'t','u','v'/)
+
+      ! -----------------------------------------
+      ! Check and write out namelist parameters
+      ! -----------------------------------------
+      IF( jperio /= 0 )   CALL ctl_stop( 'bdy_segs: Cyclic or symmetric,',   &
+         &                               ' and general open boundary condition are not compatible' )
+
+      IF( nb_bdy == 0 ) THEN 
+        IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.'
+      ELSE
+        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy
+      ENDIF
+
+      DO ib_bdy = 1,nb_bdy
+        IF(lwp) WRITE(numout,*) ' ' 
+        IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------' 
+
+        IF( ln_coords_file(ib_bdy) ) THEN
+           IF(lwp) WRITE(numout,*) 'Boundary definition read from file '//TRIM(cn_coords_file(ib_bdy))
+        ELSE
+           IF(lwp) WRITE(numout,*) 'Boundary defined in namelist.'
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  '
+        SELECT CASE( cn_dyn2d(ib_bdy) )                  
+          CASE( 'none' )         
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .false.
+             dta_bdy(ib_bdy)%ll_v2d = .false.
+          CASE( 'frs' )          
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE( 'flather' )      
+             IF(lwp) WRITE(numout,*) '      Flather radiation condition'
+             dta_bdy(ib_bdy)%ll_ssh = .true.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE( 'orlanski' )     
+             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE( 'orlanski_npo' ) 
+             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_ssh = .false.
+             dta_bdy(ib_bdy)%ll_u2d = .true.
+             dta_bdy(ib_bdy)%ll_v2d = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' )
+        END SELECT
+        IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN
+           SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   ! 
+              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'        
+              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file'
+              CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      tidal harmonic forcing taken from file'
+              CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      boundary data AND tidal harmonic forcing taken from files'
+              CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' )
+           END SELECT
+           IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.ln_tide)) THEN
+             CALL ctl_stop( 'You must activate with ln_tide to add tidal forcing at open boundaries' )
+           ENDIF
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  '
+        SELECT CASE( cn_dyn3d(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('frs')       
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('specified')
+             IF(lwp) WRITE(numout,*) '      Specified value'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('neumann')
+             IF(lwp) WRITE(numout,*) '      Neumann conditions'
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('zerograd')
+             IF(lwp) WRITE(numout,*) '      Zero gradient for baroclinic velocities'
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('zero')
+             IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)'
+             dta_bdy(ib_bdy)%ll_u3d = .false.
+             dta_bdy(ib_bdy)%ll_v3d = .false.
+          CASE('orlanski')
+             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE('orlanski_npo')
+             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_u3d = .true.
+             dta_bdy(ib_bdy)%ll_v3d = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' )
+        END SELECT
+        IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
+           SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   ! 
+              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_dyn3d_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+
+        IF ( ln_dyn3d_dmp(ib_bdy) ) THEN
+           IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN
+              IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.'
+              ln_dyn3d_dmp(ib_bdy)=.false.
+           ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN
+              CALL ctl_stop( 'Use FRS OR relaxation' )
+           ELSE
+              IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone'
+              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days'
+              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' )
+              dta_bdy(ib_bdy)%ll_u3d = .true.
+              dta_bdy(ib_bdy)%ll_v3d = .true.
+           ENDIF
+        ELSE
+           IF(lwp) WRITE(numout,*) '      NO relaxation on baroclinic velocities'
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  '
+        SELECT CASE( cn_tra(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_tem = .false.
+             dta_bdy(ib_bdy)%ll_sal = .false.
+          CASE('frs')
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE('specified')
+             IF(lwp) WRITE(numout,*) '      Specified value'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE('neumann')
+             IF(lwp) WRITE(numout,*) '      Neumann conditions'
+             dta_bdy(ib_bdy)%ll_tem = .false.
+             dta_bdy(ib_bdy)%ll_sal = .false.
+          CASE('runoff')
+             IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity'
+             dta_bdy(ib_bdy)%ll_tem = .false.
+             dta_bdy(ib_bdy)%ll_sal = .false.
+          CASE('orlanski')
+             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE('orlanski_npo')
+             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging'
+             dta_bdy(ib_bdy)%ll_tem = .true.
+             dta_bdy(ib_bdy)%ll_sal = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_tra' )
+        END SELECT
+        IF( cn_tra(ib_bdy) /= 'none' ) THEN
+           SELECT CASE( nn_tra_dta(ib_bdy) )                   ! 
+              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_tra_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+
+        IF ( ln_tra_dmp(ib_bdy) ) THEN
+           IF ( cn_tra(ib_bdy) == 'none' ) THEN
+              IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.'
+              ln_tra_dmp(ib_bdy)=.false.
+           ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN
+              CALL ctl_stop( 'Use FRS OR relaxation' )
+           ELSE
+              IF(lwp) WRITE(numout,*) '      + T/S relaxation zone'
+              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days'
+              IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days'
+              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' )
+              dta_bdy(ib_bdy)%ll_tem = .true.
+              dta_bdy(ib_bdy)%ll_sal = .true.
+           ENDIF
+        ELSE
+           IF(lwp) WRITE(numout,*) '      NO T/S relaxation'
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+#if defined key_lim2
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
+        SELECT CASE( cn_ice_lim(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_frld  = .false.
+             dta_bdy(ib_bdy)%ll_hicif = .false.
+             dta_bdy(ib_bdy)%ll_hsnif = .false.
+          CASE('frs')
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_frld  = .true.
+             dta_bdy(ib_bdy)%ll_hicif = .true.
+             dta_bdy(ib_bdy)%ll_hsnif = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
+        END SELECT
+        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 
+           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   ! 
+              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_ice_lim_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+#elif defined key_lim3
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
+        SELECT CASE( cn_ice_lim(ib_bdy) )                  
+          CASE('none')
+             IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+             dta_bdy(ib_bdy)%ll_a_i  = .false.
+             dta_bdy(ib_bdy)%ll_ht_i = .false.
+             dta_bdy(ib_bdy)%ll_ht_s = .false.
+          CASE('frs')
+             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+             dta_bdy(ib_bdy)%ll_a_i  = .true.
+             dta_bdy(ib_bdy)%ll_ht_i = .true.
+             dta_bdy(ib_bdy)%ll_ht_s = .true.
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' )
+        END SELECT
+        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 
+           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   ! 
+              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_ice_lim_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+        IF(lwp) WRITE(numout,*) '      tem of bdy sea-ice = ', rn_ice_tem(ib_bdy)         
+        IF(lwp) WRITE(numout,*) '      sal of bdy sea-ice = ', rn_ice_sal(ib_bdy)         
+        IF(lwp) WRITE(numout,*) '      age of bdy sea-ice = ', rn_ice_age(ib_bdy)         
+#endif
+
+        IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy)
+        IF(lwp) WRITE(numout,*)
+
+      ENDDO
+
+     IF (nb_bdy .gt. 0) THEN
+        IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value)
+          IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries'
+          IF(lwp) WRITE(numout,*)
+          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 applied at open boundaries'
+          IF(lwp) WRITE(numout,*)
+        ENDIF
+        IF( nb_jpk_bdy > 0 ) THEN
+           IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***'
+        ELSE
+           IF(lwp) WRITE(numout,*) '*** open boundary will be read straight onto the native grid without vertical interpolation ***'
+        ENDIF
+     ENDIF
+
+      ! -------------------------------------------------
+      ! Initialise indices arrays for open boundaries
+      ! -------------------------------------------------
+
+      ! Work out global dimensions of boundary data
+      ! ---------------------------------------------
+      REWIND( numnam_cfg )     
+
+      nblendta(:,:) = 0
+      nbdysege = 0
+      nbdysegw = 0
+      nbdysegn = 0
+      nbdysegs = 0
+      icount   = 0 ! count user defined segments
+      ! Dimensions below are used to allocate arrays to read external data
+      jpbdtas = 1 ! Maximum size of boundary data (structured case)
+      jpbdtau = 1 ! Maximum size of boundary data (unstructured case)
+
+      DO ib_bdy = 1, nb_bdy
+
+         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters
+ 
+            icount = icount + 1
+            ! No REWIND here because may need to read more than one nambdy_index namelist.
+            ! Read only namelist_cfg to avoid unseccessfull overwrite
+!!          REWIND( numnam_ref )              ! Namelist nambdy_index in reference namelist : Open boundaries indexes
+!!          READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 903)
+!!903       IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in reference namelist', lwp )
+
+!!          REWIND( numnam_cfg )              ! Namelist nambdy_index in configuration namelist : Open boundaries indexes
+            READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 )
+904         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp )
+            IF(lwm) WRITE ( numond, nambdy_index )
+
+            SELECT CASE ( TRIM(ctypebdy) )
+              CASE( 'N' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = jpjglo - 2  ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpiglo - 1
+                 ENDIF
+                 nbdysegn = nbdysegn + 1
+                 npckgn(nbdysegn) = ib_bdy ! Save bdy package number
+                 jpjnob(nbdysegn) = nbdyind
+                 jpindt(nbdysegn) = nbdybeg
+                 jpinft(nbdysegn) = nbdyend
+                 !
+              CASE( 'S' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = 2           ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpiglo - 1
+                 ENDIF
+                 nbdysegs = nbdysegs + 1
+                 npckgs(nbdysegs) = ib_bdy ! Save bdy package number
+                 jpjsob(nbdysegs) = nbdyind
+                 jpisdt(nbdysegs) = nbdybeg
+                 jpisft(nbdysegs) = nbdyend
+                 !
+              CASE( 'E' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = jpiglo - 2  ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpjglo - 1
+                 ENDIF
+                 nbdysege = nbdysege + 1 
+                 npckge(nbdysege) = ib_bdy ! Save bdy package number
+                 jpieob(nbdysege) = nbdyind
+                 jpjedt(nbdysege) = nbdybeg
+                 jpjeft(nbdysege) = nbdyend
+                 !
+              CASE( 'W' )
+                 IF( nbdyind == -1 ) THEN  ! Automatic boundary definition: if nbdysegX = -1
+                    nbdyind  = 2           ! set boundary to whole side of model domain.
+                    nbdybeg  = 2
+                    nbdyend  = jpjglo - 1
+                 ENDIF
+                 nbdysegw = nbdysegw + 1
+                 npckgw(nbdysegw) = ib_bdy ! Save bdy package number
+                 jpiwob(nbdysegw) = nbdyind
+                 jpjwdt(nbdysegw) = nbdybeg
+                 jpjwft(nbdysegw) = nbdyend
+                 !
+              CASE DEFAULT   ;   CALL ctl_stop( 'ctypebdy must be N, S, E or W' )
+            END SELECT
+
+            ! For simplicity we assume that in case of straight bdy, arrays have the same length
+            ! (even if it is true that last tangential velocity points
+            ! are useless). This simplifies a little bit boundary data format (and agrees with format
+            ! used so far in obc package)
+
+            nblendta(1:jpbgrd,ib_bdy) =  (nbdyend - nbdybeg + 1) * nn_rimwidth(ib_bdy)
+            jpbdtas = MAX(jpbdtas, (nbdyend - nbdybeg + 1))
+            IF (lwp.and.(nn_rimwidth(ib_bdy)>nrimmax)) &
+            & CALL ctl_stop( 'rimwidth must be lower than nrimmax' )
+
+         ELSE            ! Read size of arrays in boundary coordinates file.
+            CALL iom_open( cn_coords_file(ib_bdy), inum )
+            DO igrd = 1, jpbgrd
+               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )  
+               !clem nblendta(igrd,ib_bdy) = kdimsz(1)
+               !clem jpbdtau = MAX(jpbdtau, kdimsz(1))
+               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz)
+               jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz))
+            END DO
+            CALL iom_close( inum )
+            !
+         ENDIF 
+         !
+      END DO ! ib_bdy
+
+      IF (nb_bdy>0) THEN
+         jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy))
+
+         ! Allocate arrays
+         !---------------
+         ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    &
+            &      nbrdta(jpbdta, jpbgrd, nb_bdy) )
+
+         IF( nb_jpk_bdy>0 ) THEN
+            ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) )
+            ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) )
+            ALLOCATE( dta_global_dz(jpbdtau, 1, nb_jpk_bdy) )
+         ELSE
+            ALLOCATE( dta_global(jpbdtau, 1, jpk) )
+            ALLOCATE( dta_global_z(jpbdtau, 1, jpk) ) ! needed ?? TODO
+            ALLOCATE( dta_global_dz(jpbdtau, 1, jpk) )! needed ?? TODO
+         ENDIF
+
+         IF ( icount>0 ) THEN
+            IF( nb_jpk_bdy>0 ) THEN
+               ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) )
+               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) )
+               ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, nb_jpk_bdy) )
+            ELSE
+               ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) )
+               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) ! needed ?? TODO
+               ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk) )! needed ?? TODO  
+            ENDIF
+         ENDIF
+         ! 
+      ENDIF
+
+      ! Now look for crossings in user (namelist) defined open boundary segments:
+      !--------------------------------------------------------------------------
+      IF( icount>0 )   CALL bdy_ctl_seg
+
+      ! Calculate global boundary index arrays or read in from file
+      !------------------------------------------------------------               
+      ! 1. Read global index arrays from boundary coordinates file.
+      DO ib_bdy = 1, nb_bdy
+         !
+         IF( ln_coords_file(ib_bdy) ) THEN
+            !
+            CALL iom_open( cn_coords_file(ib_bdy), inum )
+            DO igrd = 1, jpbgrd
+               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
+               DO ii = 1,nblendta(igrd,ib_bdy)
+                  nbidta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
+               END DO
+               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
+               DO ii = 1,nblendta(igrd,ib_bdy)
+                  nbjdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
+               END DO
+               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) )
+               DO ii = 1,nblendta(igrd,ib_bdy)
+                  nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) )
+               END DO
+               !
+               ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) )
+               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(ib_bdy)
+               IF (ibr_max < nn_rimwidth(ib_bdy))   &
+                     CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) )
+            END DO
+            CALL iom_close( inum )
+            !
+         ENDIF 
+         !
+      END DO      
+    
+      ! 2. Now fill indices corresponding to straight open boundary arrays:
+      ! East
+      !-----
+      DO iseg = 1, nbdysege
+         ib_bdy = npckge(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ij = jpjedt(iseg), jpjeft(iseg) - 1
+            DO ij = jpjedt(iseg), jpjeft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+      ENDDO
+      !
+      ! West
+      !-----
+      DO iseg = 1, nbdysegw
+         ib_bdy = npckgw(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ij = jpjwdt(iseg), jpjwft(iseg) - 1
+            DO ij = jpjwdt(iseg), jpjwft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1
+               nbjdta(icount, igrd, ib_bdy) = ij
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+      ENDDO
+      !
+      ! North
+      !-----
+      DO iseg = 1, nbdysegn
+         ib_bdy = npckgn(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ii = jpindt(iseg), jpinft(iseg) - 1
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpindt(iseg), jpinft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      ! South
+      !-----
+      DO iseg = 1, nbdysegs
+         ib_bdy = npckgs(iseg)
+         !
+         ! ------------ T points -------------
+         igrd=1
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+         !
+         ! ------------ U points -------------
+         igrd=2
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+!            DO ii = jpisdt(iseg), jpisft(iseg) - 1
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+            nbidta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+            nbjdta(icount, igrd, ib_bdy) = -ib_bdy ! Discount this point
+         ENDDO
+         !
+         ! ------------ V points -------------
+         igrd=3
+         icount=0
+         DO ir = 1, nn_rimwidth(ib_bdy)
+            DO ii = jpisdt(iseg), jpisft(iseg)
+               icount = icount + 1
+               nbidta(icount, igrd, ib_bdy) = ii
+               nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1
+               nbrdta(icount, igrd, ib_bdy) = ir
+            ENDDO
+         ENDDO
+      ENDDO
+
+      !  Deal with duplicated points
+      !-----------------------------
+      ! We assign negative indices to duplicated points (to remove them from bdy points to be updated)
+      ! if their distance to the bdy is greater than the other
+      ! If their distance are the same, just keep only one to avoid updating a point twice
+      DO igrd = 1, jpbgrd
+         DO ib_bdy1 = 1, nb_bdy
+            DO ib_bdy2 = 1, nb_bdy
+               IF (ib_bdy1/=ib_bdy2) THEN
+                  DO ib1 = 1, nblendta(igrd,ib_bdy1)
+                     DO ib2 = 1, nblendta(igrd,ib_bdy2)
+                        IF ((nbidta(ib1, igrd, ib_bdy1)==nbidta(ib2, igrd, ib_bdy2)).AND. &
+                        &   (nbjdta(ib1, igrd, ib_bdy1)==nbjdta(ib2, igrd, ib_bdy2))) THEN
+!                           IF ((lwp).AND.(igrd==1)) WRITE(numout,*) ' found coincident point ji, jj:', & 
+!                                                       &              nbidta(ib1, igrd, ib_bdy1),      & 
+!                                                       &              nbjdta(ib2, igrd, ib_bdy2)
+                           ! keep only points with the lowest distance to boundary:
+                           IF (nbrdta(ib1, igrd, ib_bdy1)<nbrdta(ib2, igrd, ib_bdy2)) THEN
+                             nbidta(ib2, igrd, ib_bdy2) =-ib_bdy2
+                             nbjdta(ib2, igrd, ib_bdy2) =-ib_bdy2
+                           ELSEIF (nbrdta(ib1, igrd, ib_bdy1)>nbrdta(ib2, igrd, ib_bdy2)) THEN
+                             nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                             nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                           ! Arbitrary choice if distances are the same:
+                           ELSE
+                             nbidta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                             nbjdta(ib1, igrd, ib_bdy1) =-ib_bdy1
+                           ENDIF
+                        END IF
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Work out dimensions of boundary data on each processor
+      ! ------------------------------------------------------
+
+      ! Rather assume that boundary data indices are given on global domain
+      ! TO BE DISCUSSED ?
+!      iw = mig(1) + 1            ! if monotasking and no zoom, iw=2
+!      ie = mig(1) + nlci-1 - 1   ! if monotasking and no zoom, ie=jpim1
+!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2
+!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1      
+      iwe = mig(1) - 1 + 2         ! if monotasking and no zoom, iw=2
+      ies = mig(1) + nlci-1 - 1  ! if monotasking and no zoom, ie=jpim1
+      iso = mjg(1) - 1 + 2         ! if monotasking and no zoom, is=2
+      ino = mjg(1) + nlcj-1 - 1  ! if monotasking and no zoom, in=jpjm1
+
+      ALLOCATE( nbondi_bdy(nb_bdy))
+      ALLOCATE( nbondj_bdy(nb_bdy))
+      nbondi_bdy(:)=2
+      nbondj_bdy(:)=2
+      ALLOCATE( nbondi_bdy_b(nb_bdy))
+      ALLOCATE( nbondj_bdy_b(nb_bdy))
+      nbondi_bdy_b(:)=2
+      nbondj_bdy_b(:)=2
+
+      ! Work out dimensions of boundary data on each neighbour process
+      IF(nbondi == 0) THEN
+         iw_b(1) = 1 + nimppt(nowe+1)
+         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3
+         is_b(1) = 1 + njmppt(nowe+1)
+         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3
+
+         iw_b(2) = 1 + nimppt(noea+1)
+         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3
+         is_b(2) = 1 + njmppt(noea+1)
+         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3
+      ELSEIF(nbondi == 1) THEN
+         iw_b(1) = 1 + nimppt(nowe+1)
+         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3
+         is_b(1) = 1 + njmppt(nowe+1)
+         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3
+      ELSEIF(nbondi == -1) THEN
+         iw_b(2) = 1 + nimppt(noea+1)
+         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3
+         is_b(2) = 1 + njmppt(noea+1)
+         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3
+      ENDIF
+
+      IF(nbondj == 0) THEN
+         iw_b(3) = 1 + nimppt(noso+1)
+         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3
+         is_b(3) = 1 + njmppt(noso+1)
+         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3
+
+         iw_b(4) = 1 + nimppt(nono+1)
+         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3
+         is_b(4) = 1 + njmppt(nono+1)
+         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3
+      ELSEIF(nbondj == 1) THEN
+         iw_b(3) = 1 + nimppt(noso+1)
+         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3
+         is_b(3) = 1 + njmppt(noso+1)
+         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3
+      ELSEIF(nbondj == -1) THEN
+         iw_b(4) = 1 + nimppt(nono+1)
+         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3
+         is_b(4) = 1 + njmppt(nono+1)
+         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3
+      ENDIF
+
+      DO ib_bdy = 1, nb_bdy
+         DO igrd = 1, jpbgrd
+            icount  = 0
+            icountr = 0
+            idx_bdy(ib_bdy)%nblen(igrd)    = 0
+            idx_bdy(ib_bdy)%nblenrim(igrd) = 0
+            DO ib = 1, nblendta(igrd,ib_bdy)
+               ! check that data is in correct order in file
+               ibm1 = MAX(1,ib-1)
+               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc...
+                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN
+                     CALL ctl_stop('bdy_segs : ERROR : boundary data in file must be defined ', &
+                          &        ' in order of distance from edge nbr A utility for re-ordering ', &
+                          &        ' boundary coordinates and data files exists in the TOOLS/OBC directory')
+                  ENDIF    
+               ENDIF
+               ! check if point is in local domain
+               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN
+                  !
+                  icount = icount  + 1
+                  !
+                  IF( nbrdta(ib,igrd,ib_bdy) == 1 )   icountr = icountr+1
+               ENDIF
+            ENDDO
+            idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc
+            idx_bdy(ib_bdy)%nblen   (igrd) = icount  !: length of boundary data on each proc        
+         ENDDO  ! igrd
+
+         ! Allocate index arrays for this boundary set
+         !--------------------------------------------
+         ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )
+
+         ! Dispatch mapping indices and discrete distances on each processor
+         ! -----------------------------------------------------------------
+
+         com_east  = 0
+         com_west  = 0
+         com_south = 0
+         com_north = 0
+
+         com_east_b  = 0
+         com_west_b  = 0
+         com_south_b = 0
+         com_north_b = 0
+
+         DO igrd = 1, jpbgrd
+            icount  = 0
+            ! Loop on rimwidth to ensure outermost points come first in the local arrays.
+            DO ir=1, nn_rimwidth(ib_bdy)
+               DO ib = 1, nblendta(igrd,ib_bdy)
+                  ! check if point is in local domain and equals ir
+                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   &
+                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   &
+                     & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                     !
+                     icount = icount  + 1
+
+                     ! Rather assume that boundary data indices are given on global domain
+                     ! TO BE DISCUSSED ?
+!                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1
+!                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1
+                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1
+                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1
+                     ! check if point has to be sent
+                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(icount,igrd)
+                     if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then
+                        com_east = 1
+                     elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then
+                        com_west = 1
+                     endif 
+                     if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then
+                        com_south = 1
+                     elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then
+                        com_north = 1
+                     endif 
+                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy)
+                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
+                  ENDIF
+                  ! check if point has to be received from a neighbour
+                  IF(nbondi == 0) THEN
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
+                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_west_b = 1
+                       endif 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
+                       if((com_east_b .ne. 1) .and. (ii == 2)) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_east_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondi == 1) THEN
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2
+                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_west_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondi == -1) THEN
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2
+                       if((com_east_b .ne. 1) .and. (ii == 2)) then
+                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2
+                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then
+                            com_south = 1
+                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then
+                            com_north = 1
+                          endif
+                          com_east_b = 1
+                       endif 
+                     ENDIF
+                  ENDIF
+                  IF(nbondj == 0) THEN
+                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
+                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_north_b = 1 
+                     ENDIF
+                     IF(com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1  &
+                       &.OR. nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_south_b = 1 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
+                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then
+                          com_south_b = 1
+                       endif 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
+                       if((com_north_b .ne. 1) .and. (ij == 2)) then
+                          com_north_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondj == 1) THEN
+                     IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. &
+                       & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == in_b(3) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_south_b = 1 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(3) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(3) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(3) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(3) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2
+                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then
+                          com_south_b = 1
+                       endif 
+                     ENDIF
+                  ELSEIF(nbondj == -1) THEN
+                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  &
+                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. &
+                       & nbjdta(ib,igrd,ib_bdy) == is_b(4) .AND. nbrdta(ib,igrd,ib_bdy) == ir) THEN
+                       com_north_b = 1 
+                     ENDIF
+                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(4) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(4) .AND.   &
+                       & nbjdta(ib,igrd,ib_bdy) >= is_b(4) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(4) .AND.   &
+                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2
+                       if((com_north_b .ne. 1) .and. (ij == 2)) then
+                          com_north_b = 1
+                       endif 
+                     ENDIF
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO 
+
+         ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries
+         IF(     (com_east  == 1) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  0
+         ELSEIF( (com_east  == 1) .and. (com_west  == 0) ) THEN   ;   nbondi_bdy(ib_bdy) = -1
+         ELSEIF( (com_east  == 0) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  1
+         ENDIF
+         IF(     (com_north == 1) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  0
+         ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN   ;   nbondj_bdy(ib_bdy) = -1
+         ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  1
+         ENDIF
+
+         ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries
+         IF(     (com_east_b  == 1) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  0
+         ELSEIF( (com_east_b  == 1) .and. (com_west_b  == 0) ) THEN   ;   nbondi_bdy_b(ib_bdy) = -1
+         ELSEIF( (com_east_b  == 0) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  1
+         ENDIF
+         IF(     (com_north_b == 1) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  0
+         ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN   ;   nbondj_bdy_b(ib_bdy) = -1
+         ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  1
+         ENDIF
+
+         ! Compute rim weights for FRS scheme
+         ! ----------------------------------
+         DO igrd = 1, jpbgrd
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
+               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 )      ! tanh formulation
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic
+!               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy))       ! linear
+            END DO
+         END DO 
+
+         ! Compute damping coefficients
+         ! ----------------------------
+         DO igrd = 1, jpbgrd
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd)
+               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) & 
+               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) & 
+               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic
+            END DO
+         END DO 
+
+      ENDDO
+
+      ! ------------------------------------------------------
+      ! Initialise masks and find normal/tangential directions
+      ! ------------------------------------------------------
+
+      ! Read global 2D mask at T-points: bdytmask
+      ! -----------------------------------------
+      ! bdytmask = 1  on the computational domain AND on open boundaries
+      !          = 0  elsewhere   
+ 
+      bdytmask(:,:) = ssmask(:,:)
+
+      IF( ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
+         CALL iom_close( inum )
+
+         ! Derive mask on U and V grid from mask on T grid
+         bdyumask(:,:) = 0._wp
+         bdyvmask(:,:) = 0._wp
+         DO ij=1, jpjm1
+            DO ii=1, jpim1
+               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij )
+               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
+            END DO
+         END DO
+         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+
+      ENDIF ! ln_mask_file=.TRUE.
+      
+      IF( .NOT.ln_mask_file ) THEN
+         ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here.
+         bdyumask(:,:) = 0._wp
+         bdyvmask(:,:) = 0._wp
+         DO ij = 1, jpjm1
+            DO ii = 1, jpim1
+               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij )
+               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
+            END DO
+         END DO
+         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+      ENDIF
+
+      ! bdy masks are now set to zero on boundary points:
+      !
+      igrd = 1
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)      
+          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        END DO
+      END DO
+      !
+      igrd = 2
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        END DO
+      END DO
+      !
+      igrd = 3
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp
+        ENDDO
+      ENDDO
+
+      ! For the flagu/flagv calculation below we require a version of fmask without
+      ! the land boundary condition (shlat) included:
+      CALL wrk_alloc(jpi,jpj,  zfmask ) 
+      DO ij = 2, jpjm1
+         DO ii = 2, jpim1
+            zfmask(ii,ij) = tmask(ii,ij  ,1) * tmask(ii+1,ij  ,1)   &
+           &              * tmask(ii,ij+1,1) * tmask(ii+1,ij+1,1)
+         END DO      
+      END DO
+
+      ! Lateral boundary conditions
+      CALL lbc_lnk( zfmask       , 'F', 1. )
+      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+
+      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components
+
+         idx_bdy(ib_bdy)%flagu(:,:) = 0._wp
+         idx_bdy(ib_bdy)%flagv(:,:) = 0._wp
+         icount = 0 
+
+         ! Calculate relationship of U direction to the local orientation of the boundary
+         ! flagu = -1 : u component is normal to the dynamical boundary and its direction is outward
+         ! flagu =  0 : u is tangential
+         ! flagu =  1 : u is normal to the boundary and is direction is inward
+  
+         DO igrd = 1,jpbgrd 
+            SELECT CASE( igrd )
+               CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0
+               CASE( 2 )   ;   pmask => bdytmask(:,:)     ;   i_offset = 1
+               CASE( 3 )   ;   pmask => zfmask  (:,:)     ;   i_offset = 0
+            END SELECT 
+            icount = 0
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)  
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               zefl = pmask(nbi+i_offset-1,nbj)
+               zwfl = pmask(nbi+i_offset,nbj)
+               ! This error check only works if you are using the bdyXmask arrays
+               IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN
+                  icount = icount + 1
+                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj)
+               ELSE
+                  idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl
+               ENDIF
+            END DO
+            IF( icount /= 0 ) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   &
+                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy
+               IF(lwp) WRITE(numout,*) ' ========== '
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ENDIF 
+         END DO
+
+         ! Calculate relationship of V direction to the local orientation of the boundary
+         ! flagv = -1 : v component is normal to the dynamical boundary but its direction is outward
+         ! flagv =  0 : v is tangential
+         ! flagv =  1 : v is normal to the boundary and is direction is inward
+
+         DO igrd = 1, jpbgrd 
+            SELECT CASE( igrd )
+               CASE( 1 )   ;   pmask => vmask (:,:,1)   ;   j_offset = 0
+               CASE( 2 )   ;   pmask => zfmask(:,:)     ;   j_offset = 0
+               CASE( 3 )   ;   pmask => bdytmask        ;   j_offset = 1
+            END SELECT 
+            icount = 0
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)  
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               znfl = pmask(nbi,nbj+j_offset-1)
+               zsfl = pmask(nbi,nbj+j_offset  )
+               ! This error check only works if you are using the bdyXmask arrays
+               IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN
+                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj)
+                  icount = icount + 1
+               ELSE
+                  idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl
+               END IF
+            END DO
+            IF( icount /= 0 ) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   &
+                  ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy
+               IF(lwp) WRITE(numout,*) ' ========== '
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ENDIF 
+         END DO
+         !
+      END DO
+
+      ! Compute total lateral surface for volume correction:
+      ! ----------------------------------------------------
+      ! JC: this must be done at each time step with non-linear free surface
+      bdysurftot = 0._wp 
+      IF( ln_vol ) THEN  
+         igrd = 2      ! Lateral surface at U-points
+         DO ib_bdy = 1, nb_bdy
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd)
+               bdysurftot = bdysurftot + hu_n   (nbi  , nbj)                           &
+                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) &
+                  &                    * tmask_i(nbi  , nbj)                           &
+                  &                    * tmask_i(nbi+1, nbj)                   
+            END DO
+         END DO
+
+         igrd=3 ! Add lateral surface at V-points
+         DO ib_bdy = 1, nb_bdy
+            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd)
+               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd)
+               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd)
+               bdysurftot = bdysurftot + hv_n   (nbi, nbj  )                           &
+                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) &
+                  &                    * tmask_i(nbi, nbj  )                           &
+                  &                    * tmask_i(nbi, nbj+1)
+            END DO
+         END DO
+         !
+         IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain
+      END IF   
+      !
+      ! Tidy up
+      !--------
+      IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta )
+      !
+      CALL wrk_dealloc(jpi,jpj,   zfmask ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_segs')
+      !
+   END SUBROUTINE bdy_segs
+
+   SUBROUTINE bdy_ctl_seg
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_ctl_seg  ***
+      !!
+      !! ** Purpose :   Check straight open boundary segments location
+      !!
+      !! ** Method  :   - Look for open boundary corners
+      !!                - Check that segments start or end on land 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ib, ib1, ib2, ji ,jj, itest  
+      INTEGER, DIMENSION(jp_nseg,2) :: icorne, icornw, icornn, icorns  
+      REAL(wp), DIMENSION(2) ::   ztestmask
+      !!----------------------------------------------------------------------
+      !
+      IF (lwp) WRITE(numout,*) ' '
+      IF (lwp) WRITE(numout,*) 'bdy_ctl_seg: Check analytical segments'
+      IF (lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
+      IF(lwp) WRITE(numout,*) 'Number of east  segments     : ', nbdysege
+      IF(lwp) WRITE(numout,*) 'Number of west  segments     : ', nbdysegw
+      IF(lwp) WRITE(numout,*) 'Number of north segments     : ', nbdysegn
+      IF(lwp) WRITE(numout,*) 'Number of south segments     : ', nbdysegs
+      ! 1. Check bounds
+      !----------------
+      DO ib = 1, nbdysegn
+         IF (lwp) WRITE(numout,*) '**check north seg bounds pckg: ', npckgn(ib)
+         IF ((jpjnob(ib).ge.jpjglo-1).or.& 
+            &(jpjnob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpindt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
+         IF (jpinft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' )
+      END DO
+      !
+      DO ib = 1, nbdysegs
+         IF (lwp) WRITE(numout,*) '**check south seg bounds pckg: ', npckgs(ib)
+         IF ((jpjsob(ib).ge.jpjglo-1).or.& 
+            &(jpjsob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpisdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
+         IF (jpisft(ib).ge.jpiglo)     CALL ctl_stop( 'End index out of domain' )
+      END DO
+      !
+      DO ib = 1, nbdysege
+         IF (lwp) WRITE(numout,*) '**check east  seg bounds pckg: ', npckge(ib)
+         IF ((jpieob(ib).ge.jpiglo-1).or.& 
+            &(jpieob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpjedt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
+         IF (jpjeft(ib).ge.jpjglo)     CALL ctl_stop( 'End index out of domain' )
+      END DO
+      !
+      DO ib = 1, nbdysegw
+         IF (lwp) WRITE(numout,*) '**check west  seg bounds pckg: ', npckgw(ib)
+         IF ((jpiwob(ib).ge.jpiglo-1).or.& 
+            &(jpiwob(ib).le.1))        CALL ctl_stop( 'nbdyind out of domain' )
+         IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' )
+         IF (jpjwdt(ib).le.1     )     CALL ctl_stop( 'Start index out of domain' )
+         IF (jpjwft(ib).ge.jpjglo)     CALL ctl_stop( 'End index out of domain' )
+      ENDDO
+      !
+      !      
+      ! 2. Look for segment crossings
+      !------------------------------ 
+      IF (lwp) WRITE(numout,*) '**Look for segments corners  :'
+      !
+      itest = 0 ! corner number
+      !
+      ! flag to detect if start or end of open boundary belongs to a corner
+      ! if not (=0), it must be on land.
+      ! if a corner is detected, save bdy package number for further tests
+      icorne(:,:)=0. ; icornw(:,:)=0. ; icornn(:,:)=0. ; icorns(:,:)=0.
+      ! South/West crossings
+      IF ((nbdysegw > 0).AND.(nbdysegs > 0)) THEN
+         DO ib1 = 1, nbdysegw        
+            DO ib2 = 1, nbdysegs
+               IF (( jpisdt(ib2)<=jpiwob(ib1)).AND. &
+                &  ( jpisft(ib2)>=jpiwob(ib1)).AND. &
+                &  ( jpjwdt(ib1)<=jpjsob(ib2)).AND. &
+                &  ( jpjwft(ib1)>=jpjsob(ib2))) THEN
+                  IF ((jpjwdt(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpiwob(ib1))) THEN 
+                     ! We have a possible South-West corner                      
+!                     WRITE(numout,*) ' Found a South-West corner at (i,j): ', jpisdt(ib2), jpjwdt(ib1) 
+!                     WRITE(numout,*) ' between segments: ', npckgw(ib1), npckgs(ib2)
+                     icornw(ib1,1) = npckgs(ib2)
+                     icorns(ib2,1) = npckgw(ib1)
+                  ELSEIF ((jpisft(ib2)==jpiwob(ib1)).AND.(jpjwft(ib1)==jpjsob(ib2))) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpisft(ib2), jpjwft(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with West segment: ',npckgw(ib1), & 
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check South and West Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1) , &
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop+1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! South/East crossings
+      IF ((nbdysege > 0).AND.(nbdysegs > 0)) THEN
+         DO ib1 = 1, nbdysege
+            DO ib2 = 1, nbdysegs
+               IF (( jpisdt(ib2)<=jpieob(ib1)+1).AND. &
+                &  ( jpisft(ib2)>=jpieob(ib1)+1).AND. &
+                &  ( jpjedt(ib1)<=jpjsob(ib2)  ).AND. &
+                &  ( jpjeft(ib1)>=jpjsob(ib2)  )) THEN
+                  IF ((jpjedt(ib1)==jpjsob(ib2)).AND.(jpisft(ib2)==jpieob(ib1)+1)) THEN
+                     ! We have a possible South-East corner 
+!                     WRITE(numout,*) ' Found a South-East corner at (i,j): ', jpisft(ib2), jpjedt(ib1) 
+!                     WRITE(numout,*) ' between segments: ', npckge(ib1), npckgs(ib2)
+                     icorne(ib1,1) = npckgs(ib2)
+                     icorns(ib2,2) = npckge(ib1)
+                  ELSEIF ((jpjeft(ib1)==jpjsob(ib2)).AND.(jpisdt(ib2)==jpieob(ib1)+1)) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpisdt(ib2), jpjeft(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check South and East Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and South segment: ',npckgs(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! North/West crossings
+      IF ((nbdysegn > 0).AND.(nbdysegw > 0)) THEN
+         DO ib1 = 1, nbdysegw        
+            DO ib2 = 1, nbdysegn
+               IF (( jpindt(ib2)<=jpiwob(ib1)  ).AND. &
+                &  ( jpinft(ib2)>=jpiwob(ib1)  ).AND. &
+                &  ( jpjwdt(ib1)<=jpjnob(ib2)+1).AND. &
+                &  ( jpjwft(ib1)>=jpjnob(ib2)+1)) THEN
+                  IF ((jpjwft(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpiwob(ib1))) THEN
+                     ! We have a possible North-West corner 
+!                     WRITE(numout,*) ' Found a North-West corner at (i,j): ', jpindt(ib2), jpjwft(ib1) 
+!                     WRITE(numout,*) ' between segments: ', npckgw(ib1), npckgn(ib2)
+                     icornw(ib1,2) = npckgn(ib2)
+                     icornn(ib2,1) = npckgw(ib1)
+                  ELSEIF ((jpjwdt(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpiwob(ib1))) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpinft(ib2), jpjwdt(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with West segment: ',npckgw(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check North and West Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with West segment: ',npckgw(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! North/East crossings
+      IF ((nbdysegn > 0).AND.(nbdysege > 0)) THEN
+         DO ib1 = 1, nbdysege        
+            DO ib2 = 1, nbdysegn
+               IF (( jpindt(ib2)<=jpieob(ib1)+1).AND. &
+                &  ( jpinft(ib2)>=jpieob(ib1)+1).AND. &
+                &  ( jpjedt(ib1)<=jpjnob(ib2)+1).AND. &
+                &  ( jpjeft(ib1)>=jpjnob(ib2)+1)) THEN
+                  IF ((jpjeft(ib1)==jpjnob(ib2)+1).AND.(jpinft(ib2)==jpieob(ib1)+1)) THEN
+                     ! We have a possible North-East corner 
+!                     WRITE(numout,*) ' Found a North-East corner at (i,j): ', jpinft(ib2), jpjeft(ib1)
+!                     WRITE(numout,*) ' between segments: ', npckge(ib1), npckgn(ib2)
+                     icorne(ib1,2) = npckgn(ib2)
+                     icornn(ib2,2) = npckge(ib1)
+                  ELSEIF ((jpjedt(ib1)==jpjnob(ib2)+1).AND.(jpindt(ib2)==jpieob(ib1)+1)) THEN
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Found an acute open boundary corner at point (i,j)= ', &
+                     &                                     jpindt(ib2), jpjedt(ib1)
+                     IF(lwp) WRITE(numout,*) ' ==========  Not allowed yet'
+                     IF(lwp) WRITE(numout,*) '             Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  ELSE
+                     IF(lwp) WRITE(numout,*)
+                     IF(lwp) WRITE(numout,*) ' E R R O R : Check North and East Open boundary indices'
+                     IF(lwp) WRITE(numout,*) ' ==========  Crossing problem with East segment: ',npckge(ib1), &
+                     &                                                    ' and North segment: ',npckgn(ib2)
+                     IF(lwp) WRITE(numout,*)
+                     nstop = nstop + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+      END IF
+      !
+      ! 3. Check if segment extremities are on land
+      !-------------------------------------------- 
+      !
+      ! West segments
+      DO ib = 1, nbdysegw
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 
+               &  ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 
+               &  ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF (ztestmask(1)==1) THEN 
+            IF (icornw(ib,1)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)
+               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1))
+               itest=itest+1
+            ENDIF
+         ENDIF
+         IF (ztestmask(2)==1) THEN
+            IF (icornw(ib,2)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgw(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)
+               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2))
+               itest=itest+1
+            ENDIF
+         ENDIF
+      END DO
+      !
+      ! East segments
+      DO ib = 1, nbdysege
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 
+               &  ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 
+               &  ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF (ztestmask(1)==1) THEN
+            IF (icorne(ib,1)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1 
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)
+               CALL bdy_ctl_corn(npckge(ib), icorne(ib,1))
+               itest=itest+1
+            ENDIF
+         ENDIF
+         IF (ztestmask(2)==1) THEN
+            IF (icorne(ib,2)==0) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckge(ib)
+               IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'                                                  
+               IF(lwp) WRITE(numout,*)
+               nstop = nstop + 1
+            ELSE
+               ! This is a corner
+               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)
+               CALL bdy_ctl_corn(npckge(ib), icorne(ib,2))
+               itest=itest+1
+            ENDIF
+         ENDIF
+      END DO
+      !
+      ! South segments
+      DO ib = 1, nbdysegs
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 
+               &  ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 
+               &  ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF ((ztestmask(1)==1).AND.(icorns(ib,1)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not start on land or on a corner'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+         IF ((ztestmask(2)==1).AND.(icorns(ib,2)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgs(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not end on land or on a corner'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+      END DO
+      !
+      ! North segments
+      DO ib = 1, nbdysegn
+         ! get mask at boundary extremities:
+         ztestmask(1:2)=0.
+         DO ji = 1, jpi
+            DO jj = 1, jpj             
+              IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 
+               &  ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1)
+              IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 
+               &  ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1)  
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF ((ztestmask(1)==1).AND.(icornn(ib,1)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not start on land'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+         IF ((ztestmask(2)==1).AND.(icornn(ib,2)==0)) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Open boundary segment ', npckgn(ib)
+            IF(lwp) WRITE(numout,*) ' ==========  does not end on land'                                                  
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF
+      END DO
+      !
+      IF ((itest==0).AND.(lwp)) WRITE(numout,*) 'NO open boundary corner found'
+      !
+      ! Other tests TBD: 
+      ! segments completly on land
+      ! optimized open boundary array length according to landmask
+      ! Nudging layers that overlap with interior domain
+      !
+   END SUBROUTINE bdy_ctl_seg
+
+   SUBROUTINE bdy_ctl_corn( ib1, ib2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bdy_ctl_corn  ***
+      !!
+      !! ** Purpose :   Check numerical schemes consistency between
+      !!                segments having a common corner
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::   ib1, ib2
+      INTEGER :: itest
+      !!----------------------------------------------------------------------
+      itest = 0
+
+      IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) )   itest = itest + 1
+      IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) )   itest = itest + 1
+      IF( cn_tra  (ib1) /= cn_tra  (ib2) )   itest = itest + 1
+      !
+      IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) )   itest = itest + 1
+      IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) )   itest = itest + 1
+      IF( nn_tra_dta  (ib1) /= nn_tra_dta  (ib2) )   itest = itest + 1
+      !
+      IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) )   itest = itest + 1   
+      !
+      IF( itest>0 ) THEN
+         IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2
+         IF(lwp) WRITE(numout,*) ' ==========  have different open bdy schemes'                                                  
+         IF(lwp) WRITE(numout,*)
+         nstop = nstop + 1
+      ENDIF
+      !
+   END SUBROUTINE bdy_ctl_corn
+
+   !!=================================================================================
+END MODULE bdyini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90	(revision 8732)
@@ -0,0 +1,521 @@
+MODULE bdylib
+   !!======================================================================
+   !!                       ***  MODULE  bdylib  ***
+   !! Unstructured Open Boundary Cond. :  Library module of generic boundary algorithms.
+   !!======================================================================
+   !! History :  3.6  !  2013     (D. Storkey) original code
+   !!            4.0  !  2014     (T. Lovato) Generalize OBC structure
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   bdy_orlanski_2d
+   !!   bdy_orlanski_3d
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! ocean open boundary conditions
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_frs, bdy_spe, bdy_nmn, bdy_orl
+   PUBLIC   bdy_orlanski_2d
+   PUBLIC   bdy_orlanski_3d
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_frs( idx, pta, dta )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_frs  ***
+      !!
+      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
+      !!
+      !! Reference : Engedahl H., 1995, Tellus, 365-382.
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
+      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      !!
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_frs')
+      ! 
+      igrd = 1                       ! Everything is at T-points here
+      DO ib = 1, idx%nblen(igrd)
+         DO ik = 1, jpkm1
+            ii = idx%nbi(ib,igrd) 
+            ij = idx%nbj(ib,igrd)
+            zwgt = idx%nbw(ib,igrd)
+            pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik)
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_frs')
+      !
+   END SUBROUTINE bdy_frs
+
+   SUBROUTINE bdy_spe( idx, pta, dta )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_spe  ***
+      !!
+      !! ** Purpose : Apply a specified value for tracers at open boundaries.
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
+      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      !!
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_spe')
+      !
+      igrd = 1                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik)
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_spe')
+      !
+   END SUBROUTINE bdy_spe
+
+   SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_orl  ***
+      !!
+      !! ** Purpose : Apply Orlanski radiation for tracers at open boundaries.
+      !!              This is a wrapper routine for bdy_orlanski_3d below
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
+      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version
+      !!
+      INTEGER  ::   igrd                                    ! grid index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_orl')
+      !
+      igrd = 1                       ! Everything is at T-points here
+      !
+      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_orl')
+      !
+   END SUBROUTINE bdy_orl
+
+   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_orlanski_2d  ***
+      !!             
+      !!              - Apply Orlanski radiation condition adaptively to 2D fields:
+      !!                  - radiation plus weak nudging at outflow points
+      !!                  - no radiation and strong nudging at inflow points
+      !! 
+      !!
+      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),          INTENT(in   ) ::   idx      ! BDY indices
+      INTEGER ,                 INTENT(in   ) ::   igrd     ! grid index
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   phib     ! model before 2D field
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   phia     ! model after 2D field (to be updated)
+      REAL(wp), DIMENSION(:)  , INTENT(in   ) ::   phi_ext  ! external forcing data
+      LOGICAL ,                 INTENT(in   ) ::   ll_npo   ! switch for NPO version
+      !
+      INTEGER  ::   jb                                     ! dummy loop indices
+      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses
+      INTEGER  ::   iijm1, iijp1, ijjm1, ijjp1             ! 2D addresses
+      INTEGER  ::   iibm1jp1, iibm1jm1, ijbm1jp1, ijbm1jm1 ! 2D addresses
+      INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices
+      INTEGER  ::   flagu, flagv                           ! short cuts
+      REAL(wp) ::   zmask_x, zmask_y1, zmask_y2
+      REAL(wp) ::   zex1, zex2, zey, zey1, zey2
+      REAL(wp) ::   zdt, zdx, zdy, znor2, zrx, zry         ! intermediate calculations
+      REAL(wp) ::   zout, zwgt, zdy_centred
+      REAL(wp) ::   zdy_1, zdy_2, zsign_ups
+      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pmask      ! land/sea mask for field
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pmask_xdif ! land/sea mask for x-derivatives
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pmask_ydif ! land/sea mask for y-derivatives
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_2d')
+      !
+      ! ----------------------------------!
+      ! Orlanski boundary conditions     :!
+      ! ----------------------------------! 
+     
+      SELECT CASE(igrd)
+         CASE(1)
+            pmask      => tmask(:,:,1)
+            pmask_xdif => umask(:,:,1)
+            pmask_ydif => vmask(:,:,1)
+            pe_xdif    => e1u(:,:)
+            pe_ydif    => e2v(:,:)
+            ii_offset = 0
+            ij_offset = 0
+         CASE(2)
+            pmask      => umask(:,:,1)
+            pmask_xdif => tmask(:,:,1)
+            pmask_ydif => fmask(:,:,1)
+            pe_xdif    => e1t(:,:)
+            pe_ydif    => e2f(:,:)
+            ii_offset = 1
+            ij_offset = 0
+         CASE(3)
+            pmask      => vmask(:,:,1)
+            pmask_xdif => fmask(:,:,1)
+            pmask_ydif => tmask(:,:,1)
+            pe_xdif    => e1f(:,:)
+            pe_ydif    => e2t(:,:)
+            ii_offset = 0
+            ij_offset = 1
+         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_orlanksi_2d' )
+      END SELECT
+      !
+      DO jb = 1, idx%nblenrim(igrd)
+         ii  = idx%nbi(jb,igrd)
+         ij  = idx%nbj(jb,igrd) 
+         flagu = int( idx%flagu(jb,igrd) )
+         flagv = int( idx%flagv(jb,igrd) )
+         !
+         ! Calculate positions of b-1 and b-2 points for this rim point
+         ! also (b-1,j-1) and (b-1,j+1) points
+         iibm1 = ii + flagu ; iibm2 = ii + 2*flagu 
+         ijbm1 = ij + flagv ; ijbm2 = ij + 2*flagv
+          !
+         iijm1 = ii - abs(flagv) ; iijp1 = ii + abs(flagv) 
+         ijjm1 = ij - abs(flagu) ; ijjp1 = ij + abs(flagu)
+         !
+         iibm1jm1 = ii + flagu - abs(flagv) ; iibm1jp1 = ii + flagu + abs(flagv) 
+         ijbm1jm1 = ij + flagv - abs(flagu) ; ijbm1jp1 = ij + flagv + abs(flagu) 
+         !
+         ! Calculate scale factors for calculation of spatial derivatives.        
+         zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1+ii_offset,ijbm1          )         &
+        &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1          ,ijbm1+ij_offset) ) 
+         zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2+ii_offset,ijbm2          )         &
+        &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2          ,ijbm2+ij_offset) ) 
+         zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )  & 
+        &      +  (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) ) 
+         zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1+ii_offset,ijbm1)                  &
+        &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1          ,ijbm1+ij_offset) ) 
+         ! make sure scale factors are nonzero
+         if( zey1 .lt. rsmall ) zey1 = zey2
+         if( zey2 .lt. rsmall ) zey2 = zey1
+         zex1 = max(zex1,rsmall); zex2 = max(zex2,rsmall)
+         zey1 = max(zey1,rsmall); zey2 = max(zey2,rsmall); 
+         !
+         ! Calculate masks for calculation of spatial derivatives.        
+         zmask_x = ( abs(iibm1-iibm2) * pmask_xdif(iibm2+ii_offset,ijbm2          )         &
+        &          + abs(ijbm1-ijbm2) * pmask_ydif(iibm2          ,ijbm2+ij_offset) ) 
+         zmask_y1 = ( (iibm1-iibm1jm1) * pmask_xdif(iibm1jm1+ii_offset,ijbm1jm1          )  & 
+        &          +  (ijbm1-ijbm1jm1) * pmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) ) 
+         zmask_y2 = ( (iibm1jp1-iibm1) * pmask_xdif(iibm1+ii_offset,ijbm1)                  &
+        &          +  (ijbm1jp1-ijbm1) * pmask_ydif(iibm1          ,ijbm1+ij_offset) ) 
+
+         ! Calculation of terms required for both versions of the scheme. 
+         ! Mask derivatives to ensure correct land boundary conditions for each variable.
+         ! Centred derivative is calculated as average of "left" and "right" derivatives for 
+         ! this reason. 
+         ! Note no rdt factor in expression for zdt because it cancels in the expressions for 
+         ! zrx and zry.
+         zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1)
+         zdx = ( ( phia(iibm1,ijbm1) - phia(iibm2,ijbm2) ) / zex2 ) * zmask_x 
+         zdy_1 = ( ( phib(iibm1   ,ijbm1   ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1    
+         zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1) - phib(iibm1   ,ijbm1)    ) / zey2 ) * zmask_y2 
+         zdy_centred = 0.5 * ( zdy_1 + zdy_2 )
+!!$         zdy_centred = phib(iibm1jp1,ijbm1jp1) - phib(iibm1jm1,ijbm1jm1)
+         ! upstream differencing for tangential derivatives
+         zsign_ups = sign( 1., zdt * zdy_centred )
+         zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
+         zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2
+         znor2 = zdx * zdx + zdy * zdy
+         znor2 = max(znor2,zepsilon)
+         !
+         zrx = zdt * zdx / ( zex1 * znor2 ) 
+!!$         zrx = min(zrx,2.0_wp)
+         zout = sign( 1., zrx )
+         zout = 0.5*( zout + abs(zout) )
+         zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
+         ! only apply radiation on outflow points 
+         if( ll_npo ) then     !! NPO version !!
+            phia(ii,ij) = (1.-zout) * ( phib(ii,ij) + zwgt * ( phi_ext(jb) - phib(ii,ij) ) )        &
+           &            + zout      * ( phib(ii,ij) + zrx*phia(iibm1,ijbm1)                         &
+           &                            + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 
+         else                  !! full oblique radiation !!
+            zsign_ups = sign( 1., zdt * zdy )
+            zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
+            zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2 
+            zry = zdt * zdy / ( zey * znor2 ) 
+            phia(ii,ij) = (1.-zout) * ( phib(ii,ij) + zwgt * ( phi_ext(jb) - phib(ii,ij) ) )        &
+           &            + zout      * ( phib(ii,ij) + zrx*phia(iibm1,ijbm1)                         &
+           &                    - zsign_ups      * zry * ( phib(ii   ,ij   ) - phib(iijm1,ijjm1 ) ) &
+           &                    - (1.-zsign_ups) * zry * ( phib(iijp1,ijjp1) - phib(ii   ,ij    ) ) &
+           &                    + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 
+         end if
+         phia(ii,ij) = phia(ii,ij) * pmask(ii,ij)
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_2d')
+      !
+   END SUBROUTINE bdy_orlanski_2d
+
+
+   SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext, ll_npo )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_orlanski_3d  ***
+      !!             
+      !!              - Apply Orlanski radiation condition adaptively to 3D fields:
+      !!                  - radiation plus weak nudging at outflow points
+      !!                  - no radiation and strong nudging at inflow points
+      !! 
+      !!
+      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),            INTENT(in   ) ::   idx      ! BDY indices
+      INTEGER ,                   INTENT(in   ) ::   igrd     ! grid index
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   phib     ! model before 3D field
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phia     ! model after 3D field (to be updated)
+      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   phi_ext  ! external forcing data
+      LOGICAL ,                   INTENT(in   ) ::   ll_npo   ! switch for NPO version
+      !
+      INTEGER  ::   jb, jk                                 ! dummy loop indices
+      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses
+      INTEGER  ::   iijm1, iijp1, ijjm1, ijjp1             ! 2D addresses
+      INTEGER  ::   iibm1jp1, iibm1jm1, ijbm1jp1, ijbm1jm1 ! 2D addresses
+      INTEGER  ::   ii_offset, ij_offset                   ! offsets for mask indices
+      INTEGER  ::   flagu, flagv                           ! short cuts
+      REAL(wp) ::   zmask_x, zmask_y1, zmask_y2
+      REAL(wp) ::   zex1, zex2, zey, zey1, zey2
+      REAL(wp) ::   zdt, zdx, zdy, znor2, zrx, zry         ! intermediate calculations
+      REAL(wp) ::   zout, zwgt, zdy_centred
+      REAL(wp) ::   zdy_1, zdy_2,  zsign_ups
+      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value
+      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field
+      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask_xdif ! land/sea mask for x-derivatives
+      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask_ydif ! land/sea mask for y-derivatives
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_xdif    ! scale factors for x-derivatives
+      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_3d')
+      !
+      ! ----------------------------------!
+      ! Orlanski boundary conditions     :!
+      ! ----------------------------------! 
+      !
+      SELECT CASE(igrd)
+         CASE(1)
+            pmask      => tmask(:,:,:)
+            pmask_xdif => umask(:,:,:)
+            pmask_ydif => vmask(:,:,:)
+            pe_xdif    => e1u(:,:)
+            pe_ydif    => e2v(:,:)
+            ii_offset = 0
+            ij_offset = 0
+         CASE(2)
+            pmask      => umask(:,:,:)
+            pmask_xdif => tmask(:,:,:)
+            pmask_ydif => fmask(:,:,:)
+            pe_xdif    => e1t(:,:)
+            pe_ydif    => e2f(:,:)
+            ii_offset = 1
+            ij_offset = 0
+         CASE(3)
+            pmask      => vmask(:,:,:)
+            pmask_xdif => fmask(:,:,:)
+            pmask_ydif => tmask(:,:,:)
+            pe_xdif    => e1f(:,:)
+            pe_ydif    => e2t(:,:)
+            ii_offset = 0
+            ij_offset = 1
+         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_orlanksi_2d' )
+      END SELECT
+
+      DO jk = 1, jpk
+         !            
+         DO jb = 1, idx%nblenrim(igrd)
+            ii  = idx%nbi(jb,igrd)
+            ij  = idx%nbj(jb,igrd) 
+            flagu = int( idx%flagu(jb,igrd) )
+            flagv = int( idx%flagv(jb,igrd) )
+            !
+            ! calculate positions of b-1 and b-2 points for this rim point
+            ! also (b-1,j-1) and (b-1,j+1) points
+            iibm1 = ii + flagu ; iibm2 = ii + 2*flagu 
+            ijbm1 = ij + flagv ; ijbm2 = ij + 2*flagv
+            !
+            iijm1 = ii - abs(flagv) ; iijp1 = ii + abs(flagv) 
+            ijjm1 = ij - abs(flagu) ; ijjp1 = ij + abs(flagu)
+            !
+            iibm1jm1 = ii + flagu - abs(flagv) ; iibm1jp1 = ii + flagu + abs(flagv) 
+            ijbm1jm1 = ij + flagv - abs(flagu) ; ijbm1jp1 = ij + flagv + abs(flagu) 
+            !
+            ! Calculate scale factors for calculation of spatial derivatives.        
+            zex1 = ( abs(iibm1-iibm2) * pe_xdif(iibm1+ii_offset,ijbm1          )         &
+           &       + abs(ijbm1-ijbm2) * pe_ydif(iibm1          ,ijbm1+ij_offset) ) 
+            zex2 = ( abs(iibm1-iibm2) * pe_xdif(iibm2+ii_offset,ijbm2          )         &
+           &       + abs(ijbm1-ijbm2) * pe_ydif(iibm2          ,ijbm2+ij_offset) ) 
+            zey1 = ( (iibm1-iibm1jm1) * pe_xdif(iibm1jm1+ii_offset,ijbm1jm1          )  & 
+           &      +  (ijbm1-ijbm1jm1) * pe_ydif(iibm1jm1          ,ijbm1jm1+ij_offset) ) 
+            zey2 = ( (iibm1jp1-iibm1) * pe_xdif(iibm1+ii_offset,ijbm1)                  &
+           &      +  (ijbm1jp1-ijbm1) * pe_ydif(iibm1          ,ijbm1+ij_offset) ) 
+            ! make sure scale factors are nonzero
+            if( zey1 .lt. rsmall ) zey1 = zey2
+            if( zey2 .lt. rsmall ) zey2 = zey1
+            zex1 = max(zex1,rsmall); zex2 = max(zex2,rsmall); 
+            zey1 = max(zey1,rsmall); zey2 = max(zey2,rsmall); 
+            !
+            ! Calculate masks for calculation of spatial derivatives.        
+            zmask_x = ( abs(iibm1-iibm2) * pmask_xdif(iibm2+ii_offset,ijbm2          ,jk)          &
+           &          + abs(ijbm1-ijbm2) * pmask_ydif(iibm2          ,ijbm2+ij_offset,jk) ) 
+            zmask_y1 = ( (iibm1-iibm1jm1) * pmask_xdif(iibm1jm1+ii_offset,ijbm1jm1          ,jk)   & 
+           &          +  (ijbm1-ijbm1jm1) * pmask_ydif(iibm1jm1          ,ijbm1jm1+ij_offset,jk) ) 
+            zmask_y2 = ( (iibm1jp1-iibm1) * pmask_xdif(iibm1+ii_offset,ijbm1          ,jk)         &
+           &          +  (ijbm1jp1-ijbm1) * pmask_ydif(iibm1          ,ijbm1+ij_offset,jk) ) 
+            !
+            ! Calculate normal (zrx) and tangential (zry) components of radiation velocities.
+            ! Mask derivatives to ensure correct land boundary conditions for each variable.
+            ! Centred derivative is calculated as average of "left" and "right" derivatives for 
+            ! this reason. 
+            zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk)
+            zdx = ( ( phia(iibm1,ijbm1,jk) - phia(iibm2,ijbm2,jk) ) / zex2 ) * zmask_x                  
+            zdy_1 = ( ( phib(iibm1   ,ijbm1   ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1  
+            zdy_2 = ( ( phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1   ,ijbm1   ,jk) ) / zey2 ) * zmask_y2      
+            zdy_centred = 0.5 * ( zdy_1 + zdy_2 )
+!!$            zdy_centred = phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1jm1,ijbm1jm1,jk)
+            ! upstream differencing for tangential derivatives
+            zsign_ups = sign( 1., zdt * zdy_centred )
+            zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
+            zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2
+            znor2 = zdx * zdx + zdy * zdy
+            znor2 = max(znor2,zepsilon)
+            !
+            ! update boundary value:
+            zrx = zdt * zdx / ( zex1 * znor2 )
+!!$            zrx = min(zrx,2.0_wp)
+            zout = sign( 1., zrx )
+            zout = 0.5*( zout + abs(zout) )
+            zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) )
+            ! only apply radiation on outflow points 
+            if( ll_npo ) then     !! NPO version !!
+               phia(ii,ij,jk) = (1.-zout) * ( phib(ii,ij,jk) + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) &
+              &               + zout      * ( phib(ii,ij,jk) + zrx*phia(iibm1,ijbm1,jk)                     &
+              &                            + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 
+            else                  !! full oblique radiation !!
+               zsign_ups = sign( 1., zdt * zdy )
+               zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) )
+               zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2 
+               zry = zdt * zdy / ( zey * znor2 ) 
+               phia(ii,ij,jk) = (1.-zout) * ( phib(ii,ij,jk) + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) )    &
+              &               + zout      * ( phib(ii,ij,jk) + zrx*phia(iibm1,ijbm1,jk)                        &
+              &                       - zsign_ups      * zry * ( phib(ii   ,ij   ,jk) - phib(iijm1,ijjm1,jk) ) &
+              &                       - (1.-zsign_ups) * zry * ( phib(iijp1,ijjp1,jk) - phib(ii   ,ij   ,jk) ) &
+              &                       + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 
+            end if
+            phia(ii,ij,jk) = phia(ii,ij,jk) * pmask(ii,ij,jk)
+         END DO
+         !
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_3d')
+      !
+   END SUBROUTINE bdy_orlanski_3d
+
+   SUBROUTINE bdy_nmn( idx, igrd, phia )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_nmn  ***
+      !!                    
+      !! ** Purpose : Duplicate the value at open boundaries, zero gradient.
+      !! 
+      !!----------------------------------------------------------------------
+      INTEGER,                    INTENT(in)     ::   igrd     ! grid index
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated)
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      !! 
+      REAL(wp) ::   zcoef, zcoef1, zcoef2
+      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field
+      REAL(wp), POINTER, DIMENSION(:,:)        :: bdypmask      ! land/sea mask for field
+      INTEGER  ::   ib, ik   ! dummy loop indices
+      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses
+      !!----------------------------------------------------------------------
+      !!
+      IF( nn_timing == 1 ) CALL timing_start('bdy_nmn')
+      !
+      SELECT CASE(igrd)
+         CASE(1)
+            pmask => tmask(:,:,:)
+            bdypmask => bdytmask(:,:)
+         CASE(2)
+            pmask => umask(:,:,:)
+            bdypmask => bdyumask(:,:)
+         CASE(3)
+            pmask => vmask(:,:,:)
+            bdypmask => bdyvmask(:,:)
+         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' )
+      END SELECT
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            ! search the sense of the gradient
+            zcoef1 = bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik) +  bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik)
+            zcoef2 = bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik) +  bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik)
+            IF ( nint(zcoef1+zcoef2) == 0) THEN
+               ! corner **** we probably only want to set the tangentail component for the dynamics here
+               zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) +  pmask(ii,ij-1,ik) +  pmask(ii,ij+1,ik)
+               IF (zcoef > .5_wp) THEN ! Only set none isolated points.
+                 phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik) + &
+                   &              phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik) + &
+                   &              phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik) + &
+                   &              phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik)
+                 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik)
+               ELSE
+                 phia(ii,ij,ik) = phia(ii,ij  ,ik) * pmask(ii,ij  ,ik)
+               ENDIF
+            ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN
+               ! oblique corner **** we probably only want to set the normal component for the dynamics here
+               zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij  ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij  ) + &
+                   &   pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) +  pmask(ii,ij+1,ik)*bdypmask(ii,ij+1  )
+               phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik)*bdypmask(ii-1,ij  ) + &
+                   &            phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik)*bdypmask(ii+1,ij  )  + &
+                   &            phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik)*bdypmask(ii,ij -1 ) + &
+                   &            phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik)*bdypmask(ii,ij+1  )
+ 
+               phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik)
+            ELSE
+               ip = nint(bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik))
+               jp = nint(bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik))
+               phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik)
+            ENDIF
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn')
+      !
+   END SUBROUTINE bdy_nmn
+
+   !!======================================================================
+END MODULE bdylib
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 8732)
@@ -0,0 +1,592 @@
+MODULE bdytides
+   !!======================================================================
+   !!                       ***  MODULE  bdytides  ***
+   !! Ocean dynamics:   Tidal forcing at open boundaries
+   !!======================================================================
+   !! History :  2.0  !  2007-01  (D.Storkey)  Original code
+   !!            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
+   !!            3.4  !  2012-09  (G. Reffray and J. Chanut) New inputs + mods
+   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
+   !!----------------------------------------------------------------------
+   !!   bdytide_init  : read of namelist and initialisation of tidal harmonics data
+   !!   tide_update   : calculation of tidal forcing at each timestep
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE bdy_oce        ! ocean open boundary conditions
+   USE tideini        ! 
+   USE daymod         ! calendar
+   !
+   USE in_out_manager ! I/O units
+   USE iom            ! xIO server
+   USE fldread        !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdytide_init     ! routine called in bdy_init
+   PUBLIC   bdytide_update   ! routine called in bdy_dta
+   PUBLIC   bdy_dta_tides    ! routine called in dyn_spg_ts
+
+   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0     !: Tidal constituents : SSH0   (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0, v0   !: Tidal constituents : U0, V0 (read in file)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh      !: Tidal constituents : SSH    (after nodal cor.)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u , v    !: Tidal constituents : U , V  (after nodal cor.)
+   END TYPE TIDES_DATA
+
+!$AGRIF_DO_NOT_TREAT
+   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data
+!$AGRIF_END_DO_NOT_TREAT
+   TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdytide_init
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE bdytide_init  ***
+      !!                     
+      !! ** Purpose : - Read in namelist for tides and initialise external
+      !!                tidal harmonics data
+      !!
+      !!----------------------------------------------------------------------
+      !! namelist variables
+      !!-------------------
+      CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files
+      LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data
+      LOGICAL                                   ::   ln_bdytide_conj     !: If true, assume complex conjugate tidal data
+      !!
+      INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices
+      INTEGER                                   ::   ii, ij              !: dummy loop indices
+      INTEGER                                   ::   inum, igrd
+      INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays)
+      INTEGER, POINTER, DIMENSION(:)            ::   nblen, nblenrim     ! short cuts
+      INTEGER                                   ::   ios                 ! Local integer output status for namelist read
+      CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file 
+      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data
+      REAL(wp), POINTER, DIMENSION(:,:)         ::   ztr, zti            !:  "     "    "   "   "   "        "      " 
+      !!
+      TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut   
+      TYPE(MAP_POINTER), DIMENSION(jpbgrd)      ::   ibmap_ptr           !: array of pointers to nbmap
+      !!
+      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdytide_init')
+      !
+      IF (nb_bdy>0) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'bdytide_init : initialization of tidal harmonic forcing at open boundaries'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      REWIND(numnam_cfg)
+
+      DO ib_bdy = 1, nb_bdy
+         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
+            !
+            td => tides(ib_bdy)
+            nblen => idx_bdy(ib_bdy)%nblen
+            nblenrim => idx_bdy(ib_bdy)%nblenrim
+
+            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
+            filtide(:) = ''
+
+            ! Don't REWIND here - may need to read more than one of these namelists. 
+            READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901)
+901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in reference namelist', lwp )
+            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 )
+902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp )
+            IF(lwm) WRITE ( numond, nambdy_tide )
+            !                                               ! Parameter control and print
+            IF(lwp) WRITE(numout,*) '  '
+            IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
+            IF(lwp) WRITE(numout,*) '             read tidal data in 2d files: ', ln_bdytide_2ddta
+            IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj
+            IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo
+            IF(lwp) THEN 
+                    WRITE(numout,*) '             Tidal components: ' 
+               DO itide = 1, nb_harmo
+                  WRITE(numout,*)  '                 ', Wave(ntide(itide))%cname_tide 
+               END DO
+            ENDIF 
+            IF(lwp) WRITE(numout,*) ' '
+
+            ! Allocate space for tidal harmonics data - get size from OBC data arrays
+            ! -----------------------------------------------------------------------
+
+            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole
+            ! relaxation area      
+            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:)
+            ELSE                                   ;   ilen0(:) = nblenrim(:)
+            ENDIF
+
+            ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) )
+            ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) )
+
+            ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) )
+            ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) )
+
+            ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) )
+            ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) )
+
+            td%ssh0(:,:,:) = 0._wp
+            td%ssh (:,:,:) = 0._wp
+            td%u0  (:,:,:) = 0._wp
+            td%u   (:,:,:) = 0._wp
+            td%v0  (:,:,:) = 0._wp
+            td%v   (:,:,:) = 0._wp
+
+            IF( ln_bdytide_2ddta ) THEN
+               ! It is assumed that each data file contains all complex harmonic amplitudes
+               ! given on the global domain (ie global, jpiglo x jpjglo)
+               !
+               CALL wrk_alloc( jpi,jpj,   zti, ztr )
+               !
+               ! SSH fields
+               clfile = TRIM(filtide)//'_grid_T.nc'
+               CALL iom_open( clfile , inum ) 
+               igrd = 1                       ! Everything is at T-points here
+               DO itide = 1, nb_harmo
+                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )
+                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) ) 
+                  DO ib = 1, ilen0(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     td%ssh0(ib,itide,1) = ztr(ii,ij)
+                     td%ssh0(ib,itide,2) = zti(ii,ij)
+                  END DO
+               END DO 
+               CALL iom_close( inum )
+               !
+               ! U fields
+               clfile = TRIM(filtide)//'_grid_U.nc'
+               CALL iom_open( clfile , inum ) 
+               igrd = 2                       ! Everything is at U-points here
+               DO itide = 1, nb_harmo
+                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) )
+                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) )
+                  DO ib = 1, ilen0(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     td%u0(ib,itide,1) = ztr(ii,ij)
+                     td%u0(ib,itide,2) = zti(ii,ij)
+                  END DO
+               END DO
+               CALL iom_close( inum )
+               !
+               ! V fields
+               clfile = TRIM(filtide)//'_grid_V.nc'
+               CALL iom_open( clfile , inum ) 
+               igrd = 3                       ! Everything is at V-points here
+               DO itide = 1, nb_harmo
+                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) )
+                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) )
+                  DO ib = 1, ilen0(igrd)
+                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                     td%v0(ib,itide,1) = ztr(ii,ij)
+                     td%v0(ib,itide,2) = zti(ii,ij)
+                  END DO
+               END DO  
+               CALL iom_close( inum )
+               !
+               CALL wrk_dealloc( jpi,jpj,   ztr, zti ) 
+               !
+            ELSE            
+               !
+               ! Read tidal data only on bdy segments
+               ! 
+               ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
+               !
+               ! Set map structure
+               ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)   ;   ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy)
+               ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)   ;   ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy)
+               ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)   ;   ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy)
+
+               ! Open files and read in tidal forcing data
+               ! -----------------------------------------
+
+               DO itide = 1, nb_harmo
+                  !                                                              ! SSH fields
+                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
+                  CALL iom_open( clfile, inum )
+                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) )
+                  td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
+                  CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1,  ibmap_ptr(1) )
+                  td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
+                  CALL iom_close( inum )
+                  !                                                              ! U fields
+                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
+                  CALL iom_open( clfile, inum )
+                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
+                  td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
+                  CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
+                  td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
+                  CALL iom_close( inum )
+                  !                                                              ! V fields
+                  clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
+                  CALL iom_open( clfile, inum )
+                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
+                  td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
+                  CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
+                  td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
+                  CALL iom_close( inum )
+                  !
+               END DO ! end loop on tidal components
+               !
+               DEALLOCATE( dta_read )
+               !
+            ENDIF ! ln_bdytide_2ddta=.true.
+            !
+            IF( ln_bdytide_conj ) THEN    ! assume complex conjugate in data files
+               td%ssh0(:,:,2) = - td%ssh0(:,:,2)
+               td%u0  (:,:,2) = - td%u0  (:,:,2)
+               td%v0  (:,:,2) = - td%v0  (:,:,2)
+            ENDIF
+            !
+            ! Allocate slow varying data in the case of time splitting:
+            ! Do it anyway because at this stage knowledge of free surface scheme is unknown
+            ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )
+            ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )
+            ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )
+            dta_bdy_s(ib_bdy)%ssh(:) = 0._wp
+            dta_bdy_s(ib_bdy)%u2d(:) = 0._wp
+            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp
+            !
+         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2
+         !
+      END DO ! loop on ib_bdy
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdytide_init')
+      !
+   END SUBROUTINE bdytide_init
+
+
+   SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdytide_update  ***
+      !!                
+      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays. 
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(in   ) ::   kt          ! Main timestep counter
+      TYPE(OBC_INDEX)  , INTENT(in   ) ::   idx         ! OBC indices
+      TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data
+      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data
+      INTEGER, OPTIONAL, INTENT(in   ) ::   jit         ! Barotropic timestep counter (for timesplitting option)
+      INTEGER, OPTIONAL, INTENT(in   ) ::   time_offset ! time offset in units of timesteps. NB. if jit
+      !                                                 ! is present then units = subcycle timesteps.
+      !                                                 ! time_offset = 0  => get data at "now"    time level
+      !                                                 ! time_offset = -1 => get data at "before" time level
+      !                                                 ! time_offset = +1 => get data at "after"  time level
+      !                                                 ! etc.
+      !
+      INTEGER  ::   itide, igrd, ib       ! dummy loop indices
+      INTEGER  ::   time_add              ! time offset in units of timesteps
+      INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays)
+      REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars    
+      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdytide_update')
+      !
+      ilen0(1) =  SIZE(td%ssh(:,1,1))
+      ilen0(2) =  SIZE(td%u(:,1,1))
+      ilen0(3) =  SIZE(td%v(:,1,1))
+
+      zflag=1
+      IF ( PRESENT(jit) ) THEN
+        IF ( jit /= 1 ) zflag=0
+      ENDIF
+
+      IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN
+        !
+        kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
+        !
+        IF(lwp) THEN
+           WRITE(numout,*)
+           WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt
+           WRITE(numout,*) '~~~~~~~~~~~~~~ '
+        ENDIF
+        !
+        CALL tide_init_elevation ( idx, td )
+        CALL tide_init_velocities( idx, td )
+        !
+      ENDIF 
+
+      time_add = 0
+      IF( PRESENT(time_offset) ) THEN
+         time_add = time_offset
+      ENDIF
+         
+      IF( PRESENT(jit) ) THEN  
+         z_arg = ((kt-kt_tide) * rdt + (jit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) )
+      ELSE                              
+         z_arg = ((kt-kt_tide)+time_add) * rdt
+      ENDIF
+
+      ! Linear ramp on tidal component at open boundaries 
+      zramp = 1._wp
+      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0._wp),1._wp)
+
+      DO itide = 1, nb_harmo
+         z_sarg = z_arg * omega_tide(itide)
+         z_cost(itide) = COS( z_sarg )
+         z_sist(itide) = SIN( z_sarg )
+      END DO
+
+      DO itide = 1, nb_harmo
+         igrd=1                              ! SSH on tracer grid
+         DO ib = 1, ilen0(igrd)
+            dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide))
+         END DO
+         igrd=2                              ! U grid
+         DO ib = 1, ilen0(igrd)
+            dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u  (ib,itide,1)*z_cost(itide) + td%u  (ib,itide,2)*z_sist(itide))
+         END DO
+         igrd=3                              ! V grid
+         DO ib = 1, ilen0(igrd) 
+            dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v  (ib,itide,1)*z_cost(itide) + td%v  (ib,itide,2)*z_sist(itide))
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdytide_update')
+      !
+   END SUBROUTINE bdytide_update
+
+
+   SUBROUTINE bdy_dta_tides( kt, kit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_dta_tides  ***
+      !!                
+      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays. 
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter
+      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option)
+      INTEGER, OPTIONAL, INTENT(in) ::   time_offset ! time offset in units of timesteps. NB. if kit
+      !                                              ! is present then units = subcycle timesteps.
+      !                                              ! time_offset = 0  => get data at "now"    time level
+      !                                              ! time_offset = -1 => get data at "before" time level
+      !                                              ! time_offset = +1 => get data at "after"  time level
+      !                                              ! etc.
+      !
+      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step
+      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices
+      INTEGER  ::   time_add                  ! time offset in units of timesteps
+      INTEGER, DIMENSION(jpbgrd)   ::   ilen0 
+      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts
+      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist      
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_tides')
+      !
+      lk_first_btstp=.TRUE.
+      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF
+
+      time_add = 0
+      IF( PRESENT(time_offset) ) THEN
+         time_add = time_offset
+      ENDIF
+      
+      ! Absolute time from model initialization:   
+      IF( PRESENT(kit) ) THEN  
+         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt
+      ELSE                              
+         z_arg = ( kt + time_add ) * rdt
+      ENDIF
+
+      ! Linear ramp on tidal component at open boundaries 
+      zramp = 1.
+      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.)
+
+      DO ib_bdy = 1,nb_bdy
+         !
+         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN
+            !
+            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)
+            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)
+            !
+            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:)
+            ELSE                                   ;   ilen0(:) = nblenrim(:)
+            ENDIF     
+            !
+            ! We refresh nodal factors every day below
+            ! This should be done somewhere else
+            IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN
+               !
+               kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
+               !
+               IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'bdy_tide_dta : Refresh nodal factors for tidal open bdy data at kt=',kt
+               WRITE(numout,*) '~~~~~~~~~~~~~~ '
+               ENDIF
+               !
+               CALL tide_init_elevation ( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
+               CALL tide_init_velocities( idx=idx_bdy(ib_bdy), td=tides(ib_bdy) )
+               !
+            ENDIF
+            zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time
+            !
+            ! If time splitting, initialize arrays from slow varying open boundary data:
+            IF ( PRESENT(kit) ) THEN           
+               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))
+               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))
+               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))
+            ENDIF
+            !
+            ! Update open boundary data arrays:
+            DO itide = 1, nb_harmo
+               !
+               z_sarg = (z_arg + zoff) * omega_tide(itide)
+               z_cost = zramp * COS( z_sarg )
+               z_sist = zramp * SIN( z_sarg )
+               !
+               IF ( dta_bdy(ib_bdy)%ll_ssh ) THEN
+                  igrd=1                              ! SSH on tracer grid
+                  DO ib = 1, ilen0(igrd)
+                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + &
+                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + &
+                        &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist )
+                  END DO
+               ENDIF
+               !
+               IF ( dta_bdy(ib_bdy)%ll_u2d ) THEN
+                  igrd=2                              ! U grid
+                  DO ib = 1, ilen0(igrd)
+                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + &
+                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + &
+                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist )
+                  END DO
+               ENDIF
+               !
+               IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN
+                  igrd=3                              ! V grid
+                  DO ib = 1, ilen0(igrd) 
+                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + &
+                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + &
+                        &                        tides(ib_bdy)%v(ib,itide,2)*z_sist )
+                  END DO
+               ENDIF
+            END DO             
+         END IF
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_tides')
+      !
+   END SUBROUTINE bdy_dta_tides
+
+
+   SUBROUTINE tide_init_elevation( idx, td )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_elevation  ***
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices
+      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
+      !
+      INTEGER ::   itide, igrd, ib       ! dummy loop indices
+      INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays)
+      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
+      !!----------------------------------------------------------------------
+      !
+      igrd=1   
+                              ! SSH on tracer grid.
+      ilen0(1) =  SIZE(td%ssh0(:,1,1))
+      !
+      ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) )
+      !
+      DO itide = 1, nb_harmo
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.)
+            phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1))
+         END DO
+         DO ib = 1 , ilen0(igrd)
+            mod_tide(ib)=mod_tide(ib)*ftide(itide)
+            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
+         ENDDO
+         DO ib = 1 , ilen0(igrd)
+            td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+            td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+         ENDDO
+      END DO
+      !
+      DEALLOCATE( mod_tide, phi_tide )
+      !
+   END SUBROUTINE tide_init_elevation
+
+
+   SUBROUTINE tide_init_velocities( idx, td )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_elevation  ***
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices
+      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data
+      !
+      INTEGER ::   itide, igrd, ib       ! dummy loop indices
+      INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays)
+      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide
+      !!----------------------------------------------------------------------
+      !
+      ilen0(2) =  SIZE(td%u0(:,1,1))
+      ilen0(3) =  SIZE(td%v0(:,1,1))
+      !
+      igrd=2                                 ! U grid.
+      !
+      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) )
+      !
+      DO itide = 1, nb_harmo
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.)
+            phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1))
+         END DO
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=mod_tide(ib)*ftide(itide)
+            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
+         ENDDO
+         DO ib = 1, ilen0(igrd)
+            td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+            td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+         ENDDO
+      END DO
+      !
+      DEALLOCATE( mod_tide , phi_tide )
+      !
+      igrd=3                                 ! V grid.
+      !
+      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) )
+
+      DO itide = 1, nb_harmo
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.)
+            phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1))
+         END DO
+         DO ib = 1, ilen0(igrd)
+            mod_tide(ib)=mod_tide(ib)*ftide(itide)
+            phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide)
+         ENDDO
+         DO ib = 1, ilen0(igrd)
+            td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib))
+            td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib))
+         ENDDO
+      END DO
+      !
+      DEALLOCATE( mod_tide, phi_tide )
+      !
+  END SUBROUTINE tide_init_velocities
+
+   !!======================================================================
+END MODULE bdytides
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 8732)
@@ -0,0 +1,156 @@
+MODULE bdytra
+   !!======================================================================
+   !!                       ***  MODULE  bdytra  ***
+   !! Ocean tracers:   Apply boundary conditions for tracers
+   !!======================================================================
+   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
+   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
+   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure
+   !!----------------------------------------------------------------------
+   !!   bdy_tra       : Apply open boundary conditions & damping to T and S
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE bdy_oce        ! ocean open boundary conditions
+   USE bdylib         ! for orlanski library routines
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   ! Local structure to rearrange tracers data
+   TYPE, PUBLIC ::   ztrabdy
+      REAL(wp), POINTER, DIMENSION(:,:) ::  tra
+   END TYPE
+
+   PUBLIC   bdy_tra      ! called in tranxt.F90 
+   PUBLIC   bdy_tra_dmp  ! called in step.F90 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0, NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_tra( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_tra  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for temperature and salinity
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      !
+      INTEGER                        :: ib_bdy, jn, igrd   ! Loop indeces
+      TYPE(ztrabdy), DIMENSION(jpts) :: zdta               ! Temporary data structure
+      !!----------------------------------------------------------------------
+      igrd = 1 
+
+      DO ib_bdy=1, nb_bdy
+         !
+         zdta(1)%tra => dta_bdy(ib_bdy)%tem
+         zdta(2)%tra => dta_bdy(ib_bdy)%sal
+         !
+         DO jn = 1, jpts
+            !
+            SELECT CASE( TRIM(cn_tra(ib_bdy)) )
+            CASE('none'        )   ;   CYCLE
+            CASE('frs'         )   ;   CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
+            CASE('specified'   )   ;   CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
+            CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn)               )
+            CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. )
+            CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. )
+            CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn),               jn )
+            CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
+            END SELECT
+            ! Boundary points should be updated
+            CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy )
+            ! 
+         END DO
+      END DO
+      !
+   END SUBROUTINE bdy_tra
+
+   SUBROUTINE bdy_rnf( idx, pta, jpa )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_rnf  ***
+      !!                    
+      !! ** Purpose : Specialized routine to apply TRA runoff values at OBs:
+      !!                  - duplicate the neighbour value for the temperature
+      !!                  - specified to 0.1 PSU for the salinity
+      !! 
+      !!----------------------------------------------------------------------
+      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend
+      INTEGER,                             INTENT(in) ::   jpa  ! TRA index
+      !
+      REAL(wp) ::   zwgt           ! boundary weight
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij, ip, jp ! 2D addresses
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_rnf')
+      !
+      igrd = 1                       ! Everything is at T-points here
+      DO ib = 1, idx%nblenrim(igrd)
+         ii = idx%nbi(ib,igrd)
+         ij = idx%nbj(ib,igrd)
+         DO ik = 1, jpkm1
+            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  )
+            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1)
+            if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik)
+            if (jpa == jp_sal) pta(ii,ij,ik) =                 0.1 * tmask(ii,ij,ik)
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_rnf')
+      !
+   END SUBROUTINE bdy_rnf
+
+   SUBROUTINE bdy_tra_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_tra_dmp  ***
+      !!                    
+      !! ** Purpose : Apply damping for tracers at open boundaries.
+      !! 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   !
+      !
+      REAL(wp) ::   zwgt           ! boundary weight
+      REAL(wp) ::   zta, zsa, ztime
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
+      INTEGER  ::   ib_bdy         ! Loop index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_dmp')
+      !
+      DO ib_bdy = 1, nb_bdy
+         IF( ln_tra_dmp(ib_bdy) ) THEN
+            igrd = 1                       ! Everything is at T-points here
+            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+               ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+               ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
+               DO ik = 1, jpkm1
+                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
+                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
+                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
+                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
+               END DO
+            END DO
+         ENDIF
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_dmp')
+      !
+   END SUBROUTINE bdy_tra_dmp
+ 
+   !!======================================================================
+END MODULE bdytra
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 8732)
@@ -0,0 +1,174 @@
+MODULE bdyvol
+   !!======================================================================
+   !!                       ***  MODULE  bdyvol  ***
+   !! Ocean dynamic :  Volume constraint when unstructured boundary 
+   !!                  and filtered free surface are used
+   !!======================================================================
+   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
+   !!             -   !  2006-01  (J. Chanut) Bug correction
+   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers 
+   USE bdy_oce        ! ocean open boundary conditions
+   USE sbc_oce        ! ocean surface boundary conditions
+   USE dom_oce        ! ocean space and time domain 
+   USE phycst         ! physical constants
+   USE sbcisf         ! ice shelf
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran routines library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_vol    ! called by ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_vol( kt )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE bdyvol  ***
+      !!
+      !! ** Purpose :   This routine controls the volume of the system. 
+      !!      A correction velocity is calculated to correct the total transport 
+      !!      through the unstructured OBC. 
+      !!      The total depth used is constant (H0) to be consistent with the 
+      !!      linear free surface coded in OPA 8.2    <<<=== !!gm  ???? true ????
+      !!
+      !! ** Method  :   The correction velocity (zubtpecor here) is defined calculating
+      !!      the total transport through all open boundaries (trans_bdy) minus
+      !!      the cumulate E-P flux (z_cflxemp) divided by the total lateral 
+      !!      surface (bdysurftot) of the unstructured boundary. 
+      !!         zubtpecor = [trans_bdy - z_cflxemp ]*(1./bdysurftot)
+      !!      with z_cflxemp => sum of (Evaporation minus Precipitation)
+      !!                       over all the domain in m3/s at each time step.
+      !!      z_cflxemp < 0 when precipitation dominate
+      !!      z_cflxemp > 0 when evaporation dominate
+      !!
+      !!      There are 2 options (user's desiderata): 
+      !!         1/ The volume changes according to E-P, this is the default
+      !!            option. In this case the cumulate E-P flux are setting to
+      !!            zero (z_cflxemp=0) to calculate the correction velocity. So
+      !!            it will only balance the flux through open boundaries.
+      !!            (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 nn_volctl to 1 in tne namelist for this option)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk, jb, jgrd
+      INTEGER  ::   ib_bdy, ii, ij
+      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst
+      TYPE(OBC_INDEX), POINTER :: idx
+      !!-----------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('bdy_vol')
+      !
+      IF( ln_vol ) THEN
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'bdy_vol : Correction of velocities along unstructured OBC'
+         IF(lwp) WRITE(numout,*)'~~~~~~~'
+      END IF 
+
+      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
+      ! -----------------------------------------------------------------------
+!!gm replace these lines :
+      z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0
+      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
+!!gm   by :
+!!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0
+!!gm
+
+      ! Transport through the unstructured open boundary
+      ! ------------------------------------------------
+      zubtpecor = 0._wp
+      DO ib_bdy = 1, nb_bdy
+         idx => idx_bdy(ib_bdy)
+         !
+         jgrd = 2                               ! cumulate u component contribution first 
+         DO jb = 1, idx%nblenrim(jgrd)
+            DO jk = 1, jpkm1
+               ii = idx%nbi(jb,jgrd)
+               ij = idx%nbj(jb,jgrd)
+               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk)
+            END DO
+         END DO
+         jgrd = 3                               ! then add v component contribution
+         DO jb = 1, idx%nblenrim(jgrd)
+            DO jk = 1, jpkm1
+               ii = idx%nbi(jb,jgrd)
+               ij = idx%nbj(jb,jgrd)
+               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 
+            END DO
+         END DO
+         !
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain
+
+      ! The normal velocity correction
+      ! ------------------------------
+      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot 
+      ELSE                      ;   zubtpecor =   zubtpecor               / bdysurftot
+      END IF
+
+      ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation
+      ! -------------------------------------------------------------
+      ztranst = 0._wp
+      DO ib_bdy = 1, nb_bdy
+         idx => idx_bdy(ib_bdy)
+         !
+         jgrd = 2                               ! correct u component
+         DO jb = 1, idx%nblenrim(jgrd)
+            DO jk = 1, jpkm1
+               ii = idx%nbi(jb,jgrd)
+               ij = idx%nbj(jb,jgrd)
+               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk)
+               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk)
+            END DO
+         END DO
+         jgrd = 3                              ! correct v component
+         DO jb = 1, idx%nblenrim(jgrd)
+            DO jk = 1, jpkm1
+               ii = idx%nbi(jb,jgrd)
+               ij = idx%nbj(jb,jgrd)
+               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk)
+               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk)
+            END DO
+         END DO
+         !
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain
+ 
+      ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
+      ! ------------------------------------------------------
+      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt
+         IF(lwp) WRITE(numout,*)'~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'          cumulate flux EMP             =', z_cflxemp  , ' (m3/s)'
+         IF(lwp) WRITE(numout,*)'          total lateral surface of OBC  =', bdysurftot, '(m2)'
+         IF(lwp) WRITE(numout,*)'          correction velocity zubtpecor =', zubtpecor , '(m/s)'
+         IF(lwp) WRITE(numout,*)'          cumulated transport ztranst   =', ztranst   , '(m3/s)'
+      END IF 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bdy_vol')
+      !
+      END IF ! ln_vol
+      !
+   END SUBROUTINE bdy_vol
+
+   !!======================================================================
+END MODULE bdyvol
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 8732)
@@ -0,0 +1,87 @@
+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
+   !!            3.5  !  2013-10 (D. Calvert)  add namelist
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                   1D column configuration
+   !!----------------------------------------------------------------------
+   !!   c1d_init      : read in the C1D namelist
+   !!----------------------------------------------------------------------
+   USE par_kind       ! kind parameters
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   c1d_init   ! called by nemogcm.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::  lk_c1d = .TRUE.   ! 1D config. flag
+
+   REAL(wp), PUBLIC ::  rn_lat1d     !: Column latitude
+   REAL(wp), PUBLIC ::  rn_lon1d     !: Column longitude
+   LOGICAL , PUBLIC ::  ln_c1d_locpt !: Localization (or not) of 1D column in a grid
+
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+CONTAINS
+
+   SUBROUTINE c1d_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE c1d_init  ***
+      !! 
+      !! ** Purpose :   Initialization of C1D options
+      !!
+      !! ** Method  :   Read namelist namc1d 
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios   ! Local integer
+      !!
+      NAMELIST/namc1d/ rn_lat1d, rn_lon1d , ln_c1d_locpt
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namc1d in reference namelist : Tracer advection scheme
+      READ  ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
+      READ  ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namc1d )
+      !
+      IF(lwp) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'c1d_init : Initialize 1D model configuration options'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namc1d : set options for the C1D model'
+         WRITE(numout,*) '      column latitude                 rn_lat1d     = ', rn_lat1d
+         WRITE(numout,*) '      column longitude                rn_lon1d     = ', rn_lon1d
+         WRITE(numout,*) '      column localization in a grid   ln_c1d_locpt = ', ln_c1d_locpt
+      ENDIF
+      !
+   END SUBROUTINE c1d_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                           No use of 1D configuration
+   !!----------------------------------------------------------------------
+   USE par_kind         ! kind parameters
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated
+   REAL(wp)                   ::   rn_lat1d, rn_lon1d
+   LOGICAL , PUBLIC           ::   ln_c1d_locpt = .FALSE. 
+CONTAINS
+   SUBROUTINE c1d_init               ! Dummy routine
+   END SUBROUTINE c1d_init
+#endif
+
+   !!======================================================================
+END MODULE c1d
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90	(revision 8732)
@@ -0,0 +1,216 @@
+MODULE domc1d
+   !!======================================================================
+   !!                     ***  MODULE  domc1d  ***
+   !! Ocean Domain : 1D column position from lat/lon namelist specification
+   !!======================================================================
+   !! History :  3.5  !  2013-04  (D. Calvert)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'   :                                      1D Configuration
+   !!----------------------------------------------------------------------
+   !!   dom_c1d     : Determine jpizoom/jpjzoom from a given lat/lon
+   !!----------------------------------------------------------------------
+   USE phycst         ! Physical constants (and par_oce)
+   USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting
+   !
+   USE iom            ! I/O library (iom_get)
+   USE in_out_manager ! I/O manager (ctmp1)
+   USE wrk_nemo                      ! Memory allocation
+   USE timing                        ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_c1d   ! called in domcfg.F90
+
+   INTEGER ::   jpizoom = 1      !: left bottom (i,j) indices of the zoom
+   INTEGER ::   jpjzoom = 1      !: in data domain indices
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE dom_c1d( plat, plon )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dom_c1d  ***
+      !! 
+      !! ** Purpose : Recalculate jpizoom/jpjzoom indices from lat/lon point
+      !!
+      !! ** Method  : Calculate global gphit and glamt as for dom_hgr.
+      !!              After, find closest grid point to lat/lon point as for 
+      !!              dom_ngb on T grid. From this infer jpizoom and jpjzoom.
+      !!
+      !! ** Action  : Recalculate jpizoom, jpjzoom (indices of C1D zoom)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::  plat, plon    ! Column latitude &  longitude
+      !
+      INTEGER  ::  ji, jj   ! Dummy loop indices
+      INTEGER  ::  inum     ! Coordinate file handle (case 0)
+      INTEGER  ::  ijeq     ! Index of equator T point (case 4)
+      INTEGER  ::  ios      ! Local integer output status for namelist read
+      INTEGER , DIMENSION(2) ::   iloc   ! Minloc returned indices
+      REAL(wp) ::  zlon                            ! Wraparound longitude
+      REAL(wp) ::  zti, ztj, zarg                  ! Local scalars
+      REAL(wp) ::  glam0, gphi0                    ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
+      REAL(wp) ::  zlam1, zcos_alpha, ze1, ze1deg  ! Case 5 local scalars
+      REAL(wp) ::  zphi1, zsin_alpha, zim05, zjm05 !          
+      REAL(wp) , POINTER, DIMENSION(:,:) ::  gphidta, glamdta, zdist ! Global lat/lon
+      !!
+      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
+         &             rn_atfp     , rn_rdt      ,nn_closea , ln_crs,  jphgr_msh, &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
+         &             ppa2, ppkth2, ppacr2
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 )   CALL timing_start('dom_c1d')
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+
+      CALL wrk_alloc( jpidta,jpjdta,   gphidta, glamdta, zdist )
+
+      ! ============================= !
+      !  Code from dom_hgr:           !
+      !  Calculate global horizontal  !
+      !  mesh, only glamt and gphit   !
+      ! ============================= !
+      !
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+      !
+      CASE ( 0 )                 !  curvilinear coordinate on the sphere read in coordinate.nc file
+         !
+         CALL iom_open( 'coordinates', inum )
+         CALL iom_get( inum, jpdom_unknown, 'glamt', glamdta ) ! mig, mjg undefined at this point
+         CALL iom_get( inum, jpdom_unknown, 'gphit', gphidta ) ! so use jpdom_unknown not jpdom_data
+         CALL iom_close ( inum )
+         !
+      CASE ( 1 )                 ! geographical mesh on the sphere with regular grid-spacing
+         !
+         DO jj = 1, jpjdta
+            DO ji = 1, jpidta
+               zti = FLOAT( ji - 1 + nimpp - 1 )
+               ztj = FLOAT( jj - 1 + njmpp - 1 )
+               !
+               glamdta(ji,jj) = ppglam0 + ppe1_deg * zti
+               gphidta(ji,jj) = ppgphi0 + ppe2_deg * ztj
+            END DO
+         END DO
+         !
+      CASE ( 2:3 )               ! f- or beta-plane with regular grid-spacing
+         !
+         glam0 = 0.e0
+         gphi0 = - ppe2_m * 1.e-3
+         !
+         DO jj = 1, jpjdta
+            DO ji = 1, jpidta
+               glamdta(ji,jj) = glam0 + ppe1_m * 1.e-3 * FLOAT( ji - 1 + nimpp - 1 )
+               gphidta(ji,jj) = gphi0 + ppe2_m * 1.e-3 * FLOAT( jj - 1 + njmpp - 1 )
+            END DO
+         END DO
+         !
+      CASE ( 4 )                 ! geographical mesh on the sphere, isotropic MERCATOR type
+         !
+         IF( ppgphi0 == -90 )   CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
+         !
+         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
+         ijeq = ABS( 180. / rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
+         IF( ppgphi0 > 0 )   ijeq = -ijeq
+         !
+         DO jj = 1, jpjdta
+            DO ji = 1, jpidta
+               zti = FLOAT( ji - 1    + nimpp - 1 )
+               ztj = FLOAT( jj - ijeq + njmpp - 1 )
+               !
+               glamdta(ji,jj) = ppglam0 + ppe1_deg * zti
+               gphidta(ji,jj) = 1. / rad * ASIN ( TANH( ppe1_deg * rad * ztj ) )
+            END DO
+         END DO
+         !
+      CASE ( 5 )                 ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+         !
+         zlam1 = -85
+         zphi1 = 29
+         ze1 = 106000. / REAL( nn_cfg , wp )
+         !
+         zsin_alpha = - SQRT( 2. ) / 2.
+         zcos_alpha =   SQRT( 2. ) / 2.
+         ze1deg = ze1 / (ra * rad)
+         !
+         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjdta-2 ) ! Force global
+         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjdta-2 )
+         !
+         DO jj = 1, jpjdta
+            DO ji = 1, jpidta
+               zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
+               zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5
+
+               glamdta(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphidta(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+            END DO
+         END DO
+         !
+      CASE DEFAULT
+         !
+         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+
+      ! ============================== !
+      !  Code from dom_ngb:            !
+      !  Calculate the nearest grid    !
+      !  point to the given lat/lon &  !
+      !  update jpizoom and jpjzoom    !
+      ! ============================== !
+
+      zlon         = MOD( plon         + 720., 360. )                                      ! plon    between    0 and 360
+      glamdta(:,:) = MOD( glamdta(:,:) + 720., 360. )                                      ! glamdta between    0 and 360
+      IF( zlon > 270. )   zlon = zlon - 360.                                               ! zlon    between  -90 and 270
+      IF( zlon <  90. )   WHERE( glamdta(:,:) > 180. ) glamdta(:,:) = glamdta(:,:) - 360.  ! glamdta between -180 and 180
+
+      glamdta(:,:) = glamdta(:,:) - zlon
+      gphidta(:,:) = gphidta(:,:) - plat
+      zdist(:,:)   = glamdta(:,:) * glamdta(:,:) + gphidta(:,:) * gphidta(:,:)
+      
+      iloc(:) = MINLOC( zdist(:,:) ) ! No mask; zoom indices freely defined
+      jpizoom = iloc(1) + nimpp - 2  ! Minloc index - 1; want the bottom-left
+      jpjzoom = iloc(2) + njmpp - 2  ! corner index of the zoom domain.
+
+      CALL wrk_dealloc( jpidta,jpjdta,   gphidta, glamdta, zdist )
+
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_c1d : compute jpizoom & jpjzoom from global mesh and given coordinates'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '      column i zoom index             jpizoom = ', jpizoom
+         WRITE(numout,*) '      column j zoom index             jpjzoom = ', jpjzoom
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_c1d')
+      !
+   END SUBROUTINE dom_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                  NO 1D Configuration
+   !!----------------------------------------------------------------------
+CONTAINS  
+   SUBROUTINE dom_c1d( plat, plon )     ! Empty routine
+      REAL :: plat, plon
+      WRITE(*,*) 'dom_c1d: You should not have seen this print! error?',plat,plon
+   END SUBROUTINE dom_c1d
+#endif
+
+   !!======================================================================
+END MODULE domc1d
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90	(revision 8732)
@@ -0,0 +1,230 @@
+MODULE dtauvd
+   !!======================================================================
+   !!                     ***  MODULE  dtauvd  ***
+   !! Ocean data  :  read ocean U & V current data from gridded data
+   !!======================================================================
+   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dta_uvd_init  : read namelist and allocate data structures
+   !!   dta_uvd       : read and time-interpolate ocean U & V current data
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   !
+   USE in_out_manager ! I/O manager
+   USE fldread        ! read input fields
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dta_uvd_init   ! called by nemogcm.F90
+   PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90
+
+   LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data
+   LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dta_uvd_init( ld_dyndmp )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_uvd_init  ***
+      !!                    
+      !! ** Purpose :   initialization of U & V current input data 
+      !! 
+      !! ** Method  : - read namc1d_uvd namelist
+      !!              - allocate U & V current data structure
+      !!              - fld_fill data structure with namelist information
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp   ! force the initialization when dyndmp is used
+      !
+      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3     ! local integers
+      CHARACTER(len=100)        ::   cn_dir            ! Root directory for location of files to be used
+      TYPE(FLD_N), DIMENSION(2) ::   suv_i             ! Combined U & V namelist information
+      TYPE(FLD_N)               ::   sn_ucur, sn_vcur  ! U & V data namelist information
+      !!
+      NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dta_uvd_init')
+      !
+      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0
+
+      REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist : 
+      READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namc1d_uvd )
+
+      !                             ! force the initialization when dyndmp is used
+      IF( PRESENT( ld_dyndmp ) )   ln_uvd_dyndmp = .TRUE.
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dta_uvd_init : U & V current data '
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namc1d_uvd : Set flags'
+         WRITE(numout,*) '      Initialization of ocean U & V current with input data   ln_uvd_init   = ', ln_uvd_init
+         WRITE(numout,*) '      Damping of ocean U & V current toward input data        ln_uvd_dyndmp = ', ln_uvd_dyndmp
+         WRITE(numout,*)
+         IF( .NOT. ln_uvd_init .AND. .NOT. ln_uvd_dyndmp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '   U & V current data not used'
+         ENDIF
+      ENDIF
+      !                             ! no initialization when restarting
+      IF( ln_rstart .AND. ln_uvd_init ) THEN
+         CALL ctl_warn( 'dta_uvd_init: ocean restart and U & V current data initialization, ',   &
+            &           'we keep the restart U & V current values and set ln_uvd_init to FALSE' )
+         ln_uvd_init = .FALSE.
+      ENDIF
+
+      !
+      IF(  ln_uvd_init .OR. ln_uvd_dyndmp  ) THEN
+         !                          !==   allocate the data arrays   ==!
+         ALLOCATE( sf_uvd(2), STAT=ierr0 )
+         IF( ierr0 > 0 ) THEN
+            CALL ctl_stop( 'dta_uvd_init: unable to allocate sf_uvd structure' )             ;   RETURN
+         ENDIF
+         !
+                                 ALLOCATE( sf_uvd(1)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
+         IF( sn_ucur%ln_tint )   ALLOCATE( sf_uvd(1)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+                                 ALLOCATE( sf_uvd(2)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
+         IF( sn_vcur%ln_tint )   ALLOCATE( sf_uvd(2)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+         !
+         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
+            CALL ctl_stop( 'dta_uvd_init : unable to allocate U & V current data arrays' )   ;   RETURN
+         ENDIF
+         !                          !==   fill sf_uvd with sn_ucur, sn_vcur and control print   ==!
+         suv_i(1) = sn_ucur   ;   suv_i(2) = sn_vcur
+         CALL fld_fill( sf_uvd, suv_i, cn_dir, 'dta_uvd', 'U & V current data', 'namc1d_uvd' )
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dta_uvd_init')
+      !
+   END SUBROUTINE dta_uvd_init
+
+
+   SUBROUTINE dta_uvd( kt, puvd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_uvd  ***
+      !!                    
+      !! ** Purpose :   provides U & V current data at time step kt
+      !! 
+      !! ** Method  : - call fldread routine
+      !!              - ORCA_R2: make some hand made alterations to the data (EMPTY)
+      !!              - s- or mixed s-zps coordinate: vertical interpolation onto model mesh
+      !!              - zps coordinate: vertical interpolation onto last partial level
+      !!              - ln_uvd_dyndmp=False: deallocate the U & V current data structure,
+      !!                                     as the data is no longer used
+      !!
+      !! ** Action  :   puvd,  U & V current data interpolated onto model mesh at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                           , INTENT(in   ) ::   kt     ! ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,2), INTENT(  out) ::   puvd   ! U & V current data
+      !
+      INTEGER ::   ji, jj, jk, jl, jkk               ! dummy loop indicies
+      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1  ! local integers
+      REAL(wp)::   zl, zi                            ! local floats
+      REAL(wp), POINTER, DIMENSION(:) ::  zup, zvp   ! 1D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dta_uvd')
+      !
+      CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==!
+      !
+      puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask
+      puvd(:,:,:,2) = sf_uvd(2)%fnow(:,:,:) 
+      !
+      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+         !
+         CALL wrk_alloc( jpk,   zup, zvp )
+         !
+         IF( kt == nit000 .AND. lwp )THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dta_uvd: interpolate U & V current data onto the s- or mixed s-z-coordinate mesh'
+         ENDIF
+         !
+         DO jj = 1, jpj                   ! vertical interpolation of U & V current:
+            DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point
+               DO jk = 1, jpk
+                  zl = gdept_n(ji,jj,jk)
+                  IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data
+                     zup(jk) =  puvd(ji,jj,1    ,1)
+                     zvp(jk) =  puvd(ji,jj,1    ,2)
+                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! extrapolate below the last level of data
+                     zup(jk) =  puvd(ji,jj,jpkm1,1)
+                     zvp(jk) =  puvd(ji,jj,jpkm1,2)
+                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                     DO jkk = 1, jpkm1                      ! when  gdept(jkk) < zl < gdept(jkk+1)
+                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                           zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 
+                           zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi
+                        ENDIF
+                     END DO
+                  ENDIF
+               END DO
+               DO jk = 1, jpkm1           ! apply mask
+                  puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk)
+                  puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk)
+               END DO
+               puvd(ji,jj,jpk,1) = 0._wp
+               puvd(ji,jj,jpk,2) = 0._wp
+            END DO
+         END DO
+         ! 
+         CALL wrk_dealloc( jpk,   zup, zvp )
+         ! 
+      ELSE                                !==   z- or zps- coordinate   ==!
+         !                             
+         puvd(:,:,:,1) = puvd(:,:,:,1) * umask(:,:,:)       ! apply mask
+         puvd(:,:,:,2) = puvd(:,:,:,2) * vmask(:,:,:)
+         !
+         IF( ln_zps ) THEN                ! zps-coordinate (partial steps) interpolation at the last ocean level
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ik = mbkt(ji,jj) 
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                     puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1)
+                     puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2)
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( .NOT. ln_uvd_dyndmp    ) THEN   !==   deallocate U & V current structure   ==! 
+         !                                !==   (data used only for initialization)  ==!
+         IF(lwp) WRITE(numout,*) 'dta_uvd: deallocate U & V current arrays as they are only used to initialize the run'
+                                   DEALLOCATE( sf_uvd(1)%fnow )     ! U current arrays in the structure
+         IF( sf_uvd(1)%ln_tint )   DEALLOCATE( sf_uvd(1)%fdta )
+                                   DEALLOCATE( sf_uvd(2)%fnow )     ! V current arrays in the structure
+         IF( sf_uvd(2)%ln_tint )   DEALLOCATE( sf_uvd(2)%fdta )
+                                   DEALLOCATE( sf_uvd         )     ! the structure itself
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dta_uvd')
+      !
+   END SUBROUTINE dta_uvd
+
+   !!======================================================================
+END MODULE dtauvd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 8732)
@@ -0,0 +1,100 @@
+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      ! called by nemogcm.F90
+   PUBLIC   dyn_cor_c1d  ! called by step1d.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! 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   ! local scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cor_c1d : Coriolis factor at T-point'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      !
+   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_t(ji,jj) * vn(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - ff_t(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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90	(revision 8732)
@@ -0,0 +1,234 @@
+MODULE dyndmp
+   !!======================================================================
+   !!                       ***  MODULE  dyndmp  ***
+   !! Ocean dynamics: internal restoring trend on momentum (U and V current)
+   !!                 This should only be used for C1D case in current form
+   !!======================================================================
+   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
+   !!            3.6  ! 2014-08  (T. Graham) Modified to use netcdf file of
+   !!                             restoration coefficients supplied to tradmp
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_dmp_alloc : allocate dyndmp arrays
+   !!   dyn_dmp_init  : namelist read, parameter control and resto coeff.
+   !!   dyn_dmp       : update the momentum trend with the internal damping
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean: variables
+   USE dom_oce        ! ocean: domain variables
+   USE c1d            ! 1D vertical configuration
+   USE tradmp         ! ocean: internal damping
+   USE zdf_oce        ! ocean: vertical physics
+   USE phycst         ! physical constants
+   USE dtauvd         ! data: U & V current
+   USE zdfmxl         ! vertical physics: mixed layer depth
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+   USE iom            ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_dmp_init ! routine called by nemogcm.F90
+   PUBLIC   dyn_dmp      ! routine called by step_c1d.F90
+
+   LOGICAL, PUBLIC ::   ln_dyndmp   !: Flag for Newtonian damping
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  utrdmp    !: damping U current trend (m/s2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  vtrdmp    !: damping V current trend (m/s2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  resto_uv  !: restoring coeff. on U & V current
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dyn_dmp_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION dyn_dmp_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( utrdmp(jpi,jpj,jpk), vtrdmp(jpi,jpj,jpk), resto_uv(jpi,jpj,jpk), STAT= dyn_dmp_alloc )
+      !
+      IF( lk_mpp            )   CALL mpp_sum ( dyn_dmp_alloc )
+      IF( dyn_dmp_alloc > 0 )   CALL ctl_warn('dyn_dmp_alloc: allocation of arrays failed')
+      !
+   END FUNCTION dyn_dmp_alloc
+
+
+   SUBROUTINE dyn_dmp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_dmp_init  ***
+      !! 
+      !! ** Purpose :   Initialization for the Newtonian damping 
+      !!
+      !! ** Method  : - read the ln_dyndmp parameter from the namc1d_dyndmp namelist
+      !!              - allocate damping arrays
+      !!              - check the parameters of the namtra_dmp namelist
+      !!              - calculate damping coefficient
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask   ! local integers
+      !!
+      NAMELIST/namc1d_dyndmp/ ln_dyndmp
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist : 
+      READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namc1d_dyndmp )
+      !
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_dmp_init : U and V current Newtonian damping'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namc1d_dyndmp : Set damping flag'
+         WRITE(numout,*) '      add a damping term or not       ln_dyndmp = ', ln_dyndmp
+         WRITE(numout,*) '   Namelist namtra_dmp    : Set damping parameters'
+         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
+         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
+         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( ln_dyndmp ) THEN
+         !                                   !==   allocate the data arrays   ==!
+         IF( dyn_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dyn_dmp_init: unable to allocate arrays' )
+         !
+         SELECT CASE ( nn_zdmp )             !==   control print of vertical option   ==!
+         CASE ( 0    )   ;   IF(lwp) WRITE(numout,*) '   momentum damping throughout the water column'
+         CASE ( 1    )   ;   IF(lwp) WRITE(numout,*) '   no momentum damping in the turbocline (avt > 5 cm2/s)'
+         CASE ( 2    )   ;   IF(lwp) WRITE(numout,*) '   no momentum damping in the mixed layer'
+         CASE DEFAULT
+            WRITE(ctmp1,*) '          bad flag value for nn_zdmp = ', nn_zdmp
+            CALL ctl_stop(ctmp1)
+         END SELECT
+         !
+         IF( .NOT. ln_uvd_dyndmp ) THEN      ! force the initialization of U & V current data for damping
+            CALL ctl_warn( 'dyn_dmp_init: U & V current read data not initialized, we force ln_uvd_dyndmp=T' )
+            CALL dta_uvd_init( ld_dyndmp=ln_dyndmp )
+         ENDIF
+         !
+         utrdmp(:,:,:) = 0._wp               ! internal damping trends
+         vtrdmp(:,:,:) = 0._wp
+         !
+         !Read in mask from file
+         CALL iom_open ( cn_resto, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto)
+         CALL iom_close( imask )
+      ENDIF
+      !
+   END SUBROUTINE dyn_dmp_init
+
+
+   SUBROUTINE dyn_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_dmp  ***
+      !!                  
+      !! ** Purpose :   Compute the momentum trends due to a newtonian damping
+      !!      of the ocean velocities towards the given data and add it to the 
+      !!      general momentum trends.
+      !!
+      !! ** Method  :   Compute Newtonian damping towards u_dta and v_dta 
+      !!      and add to the general momentum trends:
+      !!                     ua = ua + resto_uv * (u_dta - ub)
+      !!                     va = va + resto_uv * (v_dta - vb)
+      !!      The trend is computed either throughout the water column
+      !!      (nn_zdmp=0), where the vertical mixing is weak (nn_zdmp=1) or
+      !!      below the well mixed layer (nn_zdmp=2)
+      !!
+      !! ** Action  : - (ua,va)   momentum trends updated with the damping trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuv_dta   ! Read in data 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'dyn_dmp' )
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,2,   zuv_dta )
+      !
+      !                           !==   read and interpolate U & V current data at kt   ==!
+      CALL dta_uvd( kt, zuv_dta ) !!! NOTE: This subroutine must be altered for use outside
+                                  !!!       the C1D context (use of U,V grid variables)
+      !
+      SELECT CASE ( nn_zdmp )     !==   Calculate/add Newtonian damping to the momentum trend   ==!
+      !
+      CASE( 0 )                   ! Newtonian damping throughout the water column
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
+                  zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  utrdmp(ji,jj,jk) = zua           ! save the trends
+                  vtrdmp(ji,jj,jk) = zva      
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 1 )                  ! no damping above the turbocline (avt > 5 cm2/s)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
+                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
+                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
+                  ELSE
+                     zua = 0._wp
+                     zva = 0._wp  
+                  ENDIF
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  utrdmp(ji,jj,jk) = zua           ! save the trends
+                  vtrdmp(ji,jj,jk) = zva
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 2 )                  ! no damping in the mixed layer
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                     zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) )
+                     zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) )
+                  ELSE
+                     zua = 0._wp
+                     zva = 0._wp  
+                  ENDIF
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  utrdmp(ji,jj,jk) = zua           ! save the trends
+                  vtrdmp(ji,jj,jk) = zva
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      !                           ! Control print
+      IF( ln_ctl   )   CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp  - Ua: ', mask1=umask,   &
+         &                           tab3d_2=va(:,:,:), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,2,   zuv_dta )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'dyn_dmp')
+      !
+   END SUBROUTINE dyn_dmp
+
+   !!======================================================================
+END MODULE dyndmp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 8732)
@@ -0,0 +1,167 @@
+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          ! time-stepping                    (dyn_nxt routine)
+   USE dyndmp          ! U & V momentum damping           (dyn_dmp routine)
+   USE restart         ! restart 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_c1d      ! called by opa.F90
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! 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 iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update data, open boundaries, surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update                (ua, va, ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL eos_rab( tsb, rab_b )   ! before local thermal/haline expension ratio at T-points
+                         CALL eos_rab( tsn, rab_n )   ! now    local thermal/haline expension ratio at T-points
+                         CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
+                         CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+      !  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_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  )   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( lk_diahth  )   CALL dia_hth( kstp )       ! Thermocline depth (20°C)
+
+
+#if defined key_top
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                        CALL trc_stp( kstp )       ! time-stepping
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              (ua, va used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                        tsa(:,:,:,:) = 0._wp       ! set tracer trends to zero
+
+                        CALL tra_sbc( kstp )       ! surface boundary condition
+      IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr
+      IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers
+                        CALL tra_zdf( kstp )       ! vertical mixing
+                        CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl
+      IF( ln_zdfnpc )   CALL tra_npc( kstp )       ! applied non penetrative convective adjustment on (t,s)
+                        CALL tra_nxt( kstp )       ! tracer fields at next time step
+
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Dynamics                                    (ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                        ua(:,:,:) = 0._wp          ! set dynamics trends to zero
+                        va(:,:,:) = 0._wp
+
+      IF( ln_dyndmp )   CALL dyn_dmp    ( kstp )   ! internal damping trends- momentum
+                        CALL dyn_cor_c1d( kstp )   ! vorticity term including Coriolis
+                        CALL dyn_zdf    ( kstp )   ! vertical diffusion
+                        CALL dyn_nxt    ( 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
+      !
+#if defined key_iomput
+      IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS
+      !
+#endif
+   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 8732)
@@ -0,0 +1,357 @@
+MODULE crs   
+   !!======================================================================
+   !!                         ***  MODULE crs_dom  ***
+   !!        Declare the coarse grid domain and other public variables 
+   !!        then allocate them if needed.
+   !!======================================================================
+   !!  History     2012-06  Editing  (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
+   !!----------------------------------------------------------------------
+   USE par_oce  
+   USE dom_oce
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC crs_dom_alloc  ! Called from crsini.F90
+   PUBLIC crs_dom_alloc2  ! Called from crsini.F90
+   PUBLIC dom_grid_glo   
+   PUBLIC dom_grid_crs 
+
+      ! Domain variables
+      INTEGER  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
+                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
+      INTEGER  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
+                   jpj_crs                      !: 2nd dimension of local coarse grid domain
+      INTEGER  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
+                   jpj_full                     !: 2nd dimension of local parent grid domain
+
+      INTEGER  ::  nistr , njstr
+      INTEGER  ::  niend , njend
+
+      INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices      
+      INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices      
+      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
+      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
+      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
+      INTEGER  ::  npiglo, npjglo               !: jpjglo
+      INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
+      INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
+      INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
+      INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
+      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
+      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
+
+      INTEGER  ::  narea_full, narea_crs        !: node
+      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
+      INTEGER  ::  jpim1_full, jpjm1_full       !: 
+      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
+      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
+      INTEGER  ::  nreci_full, nrecj_full
+      INTEGER  ::  nreci_crs, nrecj_crs
+      !cc
+      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in
+      INTEGER ::   noso_full, nono_full        !: east, west, south and north directions
+      INTEGER ::   npne_full, npnw_full        !: index of north east and north west processor
+      INTEGER ::   npse_full, npsw_full        !: index of south east and south west processor
+      INTEGER ::   nbne_full, nbnw_full        !: logical of north east & north west processor
+      INTEGER ::   nbse_full, nbsw_full        !: logical of south east & south west processor
+      INTEGER ::   nidom_full                  !: ???
+      INTEGER ::   nproc_full                  !:number for local processor
+      INTEGER ::   nbondi_full, nbondj_full    !: mark of i- and j-direction local boundaries
+      INTEGER ::   noea_crs, nowe_crs          !: index of the local neighboring processors in
+      INTEGER ::   noso_crs, nono_crs          !: east, west, south and north directions
+      INTEGER ::   npne_crs, npnw_crs          !: index of north east and north west processor
+      INTEGER ::   npse_crs, npsw_crs          !: index of south east and south west processor
+      INTEGER ::   nbne_crs, nbnw_crs          !: logical of north east & north west processor
+      INTEGER ::   nbse_crs, nbsw_crs          !: logical of south east & south west processor
+      INTEGER ::   nidom_crs                   !: ???
+      INTEGER ::   nproc_crs                   !:number for local processor
+      INTEGER ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
+      
+
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs
+      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain
+
+ 
+      ! Masks
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
+      
+  !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol      
+
+      ! Scale factors
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs
+      
+      ! Surface
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk
+                                                                  ! vertical scale factors 
+      ! Coordinates
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs
+      INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
+
+      ! Weights
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
+
+      ! CRS Namelist
+      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
+      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
+      INTEGER           :: nn_binref  = 0       !: 0 = binning starts north fold (equator could be asymmetric)
+                                                !: 1 = binning centers at equator (north fold my have artifacts)     
+                                                !:    for even reduction factors, equator placed in bin biased south
+      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output
+                                                !: 0 = no mesh mask output
+                                                !: 1 = unified mesh mask output
+                                                !: 2 = 2 separate mesh mask output
+                                                !: 3 = 3 separate mesh mask output
+      INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 
+      LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence 
+      !
+      INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor
+
+
+      ! Grid reduction factors
+      REAL(wp)     ::  rfactx_r                !: inverse of x-dim reduction factor
+      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor
+      REAL(wp)     ::  rfactxy 
+
+      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs    
+      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs    
+      ! 
+      ! Surface fluxes to pass to TOP
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs
+
+      ! Vertical diffusion
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp  
+# if defined key_zdfddm
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
+# endif
+
+      ! Mixing and Mixed Layer Depth
+      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   INTEGER FUNCTION crs_dom_alloc()
+      !!-------------------------------------------------------------------
+      !!                     *** FUNCTION crs_dom_alloc ***
+      !!  ** Purpose :   Allocate public crs arrays  
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER, DIMENSION(17) :: ierr
+
+      ierr(:) = 0
+
+      ! Set up bins for coarse grid, horizontal only.
+     ALLOCATE( mis2_crs(jpiglo_crs), mie2_crs(jpiglo_crs),  &
+       &       mjs2_crs(jpjglo_crs), mje2_crs(jpjglo_crs),  &
+       &       mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs),  &
+       &       mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs),  &
+       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  STAT=ierr(1) ) 
+
+
+      ! Set up Mask and Mesh
+      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
+         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
+
+      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs)   , rnfmsk_crs(jpi_crs,jpj_crs), &
+      &         tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) )
+
+      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
+         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
+         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
+         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
+         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
+
+      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
+         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
+         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
+         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
+         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
+
+      ALLOCATE( e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)    , & 
+         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)    , &
+         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , e1e2w_msk(jpi_crs,jpj_crs,jpk)  , & 
+         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk)  , &
+         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)  , &
+         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , e3t_max_crs(jpi_crs,jpj_crs,jpk), &
+         &      e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk), &
+         &      e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6))
+
+
+      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk), facsurfu(jpi_crs,jpj_crs,jpk) , & 
+         &      facvol_t(jpi_crs,jpj_crs,jpk), facvol_w(jpi_crs,jpj_crs,jpk) , &
+         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk), ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
+         &      bt_crs(jpi_crs,jpj_crs,jpk)  , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
+
+
+      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk), crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
+         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk), crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
+
+
+      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs), mbkt_crs(jpi_crs,jpj_crs) , &
+         &      mbku_crs(jpi_crs,jpj_crs)  , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
+
+      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk), gdepu_crs(jpi_crs,jpj_crs,jpk) , &
+         &      gdepv_crs(jpi_crs,jpj_crs,jpk), gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
+
+
+      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
+         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),&
+         &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11))
+
+     ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), &
+         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
+         &     vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), &
+         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  )
+
+     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
+# if defined key_zdfddm
+         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
+# endif
+         &      STAT=ierr(13) )
+
+      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
+         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
+         
+      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
+       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
+                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
+       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
+
+         
+      crs_dom_alloc = MAXVAL(ierr)
+
+   END FUNCTION crs_dom_alloc
+
+
+   INTEGER FUNCTION crs_dom_alloc2()
+      !!-------------------------------------------------------------------
+      !!                     *** FUNCTION crs_dom_alloc ***
+      !!  ** Purpose :   Allocate public crs arrays  
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER, DIMENSION(1) :: ierr
+
+      ierr(:) = 0
+      
+      ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) )
+      crs_dom_alloc2 = MAXVAL(ierr)
+
+   END FUNCTION crs_dom_alloc2
+
+
+   SUBROUTINE dom_grid_glo
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE dom_grid_glo  ***
+      !!
+      !! ** Purpose : +Return back to parent grid domain 
+      !!---------------------------------------------------------------------
+
+      !                         Return to parent grid domain
+      jpi    = jpi_full
+      jpj    = jpj_full
+      jpim1  = jpim1_full
+      jpjm1  = jpjm1_full
+      nperio = nperio_full
+
+      npolj  = npolj_full
+      jpiglo = jpiglo_full
+      jpjglo = jpjglo_full
+
+      nlci   = nlci_full
+      nlcj   = nlcj_full
+      nldi   = nldi_full
+      nldj   = nldj_full
+      nlei   = nlei_full
+      nlej   = nlej_full
+      nimpp  = nimpp_full
+      njmpp  = njmpp_full
+      
+      nlcit(:)  = nlcit_full(:)
+      nldit(:)  = nldit_full(:)
+      nleit(:)  = nleit_full(:)
+      nimppt(:) = nimppt_full(:)
+      nlcjt(:)  = nlcjt_full(:)
+      nldjt(:)  = nldjt_full(:)
+      nlejt(:)  = nlejt_full(:)
+      njmppt(:) = njmppt_full(:)
+
+   END SUBROUTINE dom_grid_glo
+
+
+   SUBROUTINE dom_grid_crs
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE dom_grid_crs  ***
+      !!
+      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
+      !!---------------------------------------------------------------------
+      !
+      !                        Switch to coarse grid domain
+      jpi    = jpi_crs
+      jpj    = jpj_crs
+      jpim1  = jpi_crsm1
+      jpjm1  = jpj_crsm1
+      nperio = nperio_crs
+
+      npolj  = npolj_crs
+      jpiglo = jpiglo_crs
+      jpjglo = jpjglo_crs
+
+
+      nlci   = nlci_crs
+      nlcj   = nlcj_crs
+      nldi   = nldi_crs
+      nlei   = nlei_crs
+      nlej   = nlej_crs
+      nldj   = nldj_crs
+      nimpp  = nimpp_crs
+      njmpp  = njmpp_crs
+      
+      nlcit(:)  = nlcit_crs(:)
+      nldit(:)  = nldit_crs(:)
+      nleit(:)  = nleit_crs(:)
+      nimppt(:) = nimppt_crs(:)
+      nlcjt(:)  = nlcjt_crs(:)
+      nldjt(:)  = nldjt_crs(:)
+      nlejt(:)  = nlejt_crs(:)
+      njmppt(:) = njmppt_crs(:)
+      !
+   END SUBROUTINE dom_grid_crs
+   
+   !!======================================================================
+END MODULE crs
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 8732)
@@ -0,0 +1,2288 @@
+MODULE crsdom
+   !!===================================================================
+   !!                  ***  crs.F90 ***
+   !!  Purpose: Interface for calculating quantities from a  
+   !!           higher-resolution grid for the coarse grid.
+   !!
+   !!  Method:  Given the user-defined reduction factor, 
+   !!           the averaging bins are set: 
+   !!           - nn_binref = 0, starting from the north 
+   !!           to the south in the model interior domain, 
+   !!           in this way the north fold and redundant halo cells  
+   !!           could be handled in a consistent manner and 
+   !!           the irregularities of bin size can be handled
+   !!           more naturally by the presence of land
+   !!           in the southern boundary.  Thus the southernmost bin 
+   !!           could be of an irregular bin size.
+   !!           Information on the parent grid is retained, specifically,
+   !!           each coarse grid cell's volume and ocean surface 
+   !!           at the faces, relative to the parent grid.
+   !!           - nn_binref = 1 (not yet available), starting
+   !!           at a centralized bin at the equator, being only
+   !!           truly centered for odd-numbered j-direction reduction 
+   !!           factors.
+   !!  References:  Aumont, O., J.C. Orr, D. Jamous, P. Monfray
+   !!               O. Marti and G. Madec, 1998. A degradation 
+   !!               approach to accelerate simulations to steady-state 
+   !!               in a 3-D tracer transport model of the global ocean.
+   !!               Climate Dynamics, 14:101-116.
+   !!  History: 
+   !!       Original.   May 2012.  (J. Simeon, C. Calone, G. Madec, C. Ethe)
+   !!===================================================================
+   USE dom_oce        ! ocean space and time domain and to get jperio
+   USE crs            ! domain for coarse grid
+   !
+   USE in_out_manager 
+   USE par_kind
+   USE crslbclnk
+   USE wrk_nemo       ! work arrays
+   USE lib_mpp
+
+   IMPLICIT NONE
+
+   PRIVATE 
+
+   PUBLIC crs_dom_ope
+   PUBLIC crs_dom_e3, crs_dom_sfc, crs_dom_msk, crs_dom_hgr, crs_dom_coordinates
+   PUBLIC crs_dom_facvol, crs_dom_def, crs_dom_bat
+
+   INTERFACE crs_dom_ope
+      MODULE PROCEDURE crs_dom_ope_3d, crs_dom_ope_2d
+   END INTERFACE
+
+   REAL(wp) :: r_inf = 1e+36
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE crs_dom_msk
+      
+      INTEGER  ::  ji, jj, jk                   ! dummy loop indices
+      INTEGER  ::  ijie,ijis,ijje,ijjs,ij,je_2
+      REAL(wp) ::  zmask
+      
+      ! Initialize
+
+      tmask_crs(:,:,:) = 0.0
+      vmask_crs(:,:,:) = 0.0
+      umask_crs(:,:,:) = 0.0
+      fmask_crs(:,:,:) = 0.0
+  
+            
+      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+            je_2 = mje_crs(2)   ;  ij = je_2
+         ENDIF
+      ELSE
+         je_2 = mje_crs(2)      ;  ij = mjs_crs(2) 
+      ENDIF
+      DO jk = 1, jpkm1
+         DO ji = 2, nlei_crs  
+            ijis = mis_crs(ji)  ;  ijie = mie_crs(ji)    
+            !          
+            zmask = 0.0
+            zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) ) 
+            IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0
+               
+            zmask = 0.0
+            zmask = SUM( vmask(ijis:ijie,je_2     ,jk) )  
+            IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0
+               
+            zmask = 0.0
+            zmask = SUM(umask(ijie,ij:je_2,jk))   
+            IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0
+               
+            fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk)
+         ENDDO
+      ENDDO
+      !
+      DO jk = 1, jpkm1
+         DO ji = 2, nlei_crs  
+            ijis = mis_crs(ji)     ;   ijie = mie_crs(ji)       
+            DO jj = 3, nlej_crs
+               ijjs = mjs_crs(jj)  ;   ijje = mje_crs(jj)
+                          
+               zmask = 0.0
+               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
+               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )  
+               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )  
+               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0
+               
+               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)  
+            ENDDO
+         ENDDO
+      ENDDO
+
+      !
+      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )
+      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )
+      CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )
+      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )
+      !
+   END SUBROUTINE crs_dom_msk
+
+
+   SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_coordinates ***
+      !! ** Purpose :  Determine the coordinates for the coarse grid
+      !! 
+      !! ** Method  :  From the parent grid subset, search for the central
+      !!               point.  For an odd-numbered reduction factor,
+      !!               the coordinate will be that of the central T-cell.
+      !!               For an even-numbered reduction factor, of a non-square
+      !!               coarse grid box, the coordinate will be that of 
+      !!               the east or north face or more likely.  For a square
+      !!               coarse grid box, the coordinate will be that of
+      !!               the central f-corner.
+      !!
+      !! ** Input   :  p_gphi = parent grid gphi[t|u|v|f]
+      !!               p_glam = parent grid glam[t|u|v|f]
+      !!               cd_type  = grid type (T,U,V,F)
+      !! ** Output  :  p_gphi_crs = coarse grid gphi[t|u|v|f]
+      !!               p_glam_crs = coarse grid glam[t|u|v|f]
+      !!              
+      !! History. 1 Jun.
+      !!----------------------------------------------------------------
+      !! Arguments
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_gphi  ! Parent grid latitude
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_glam  ! Parent grid longitude
+      CHARACTER(len=1),                     INTENT(in)  :: cd_type   ! grid type (T,U,V,F) 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_gphi_crs  ! Coarse grid latitude
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_glam_crs  ! Coarse grid longitude
+
+      !! Local variables
+      INTEGER :: ji, jj, jk                   ! dummy loop indices
+      INTEGER :: ijis, ijjs
+
+  
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj) + mybinctr
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji) + mxbinctr 
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'U' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj) + mybinctr                  
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'V' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj)
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji) + mxbinctr 
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'F' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj)
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+      END SELECT
+
+      ! Retroactively add back the boundary halo cells.
+      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 )
+      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )
+         
+      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd
+      SELECT CASE ( cd_type )
+         CASE ( 'T', 'V' )
+            DO ji = 2, nlei_crs
+               ijis = mis_crs(ji) + mxbinctr 
+               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+               p_glam_crs(ji,1) = p_glam(ijis,1)
+            ENDDO
+         CASE ( 'U', 'F' )
+            DO ji = 2, nlei_crs
+               ijis = mis_crs(ji) 
+               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+               p_glam_crs(ji,1) = p_glam(ijis,1)
+            ENDDO
+      END SELECT
+      !
+   END SUBROUTINE crs_dom_coordinates
+
+  SUBROUTINE crs_dom_hgr( p_e1, p_e2, cd_type, p_e1_crs, p_e2_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_hgr ***
+      !!
+      !! ** Purpose :  Get coarse grid horizontal scale factors and unmasked fraction
+      !!
+      !! ** Method  :  For grid types T,U,V,Fthe 2D scale factors of 
+      !!               the coarse grid are the sum of the east or north faces of the 
+      !!               parent grid subset comprising the coarse grid box.     
+      !!               - e1,e2 Scale factors
+      !!                 Valid arguments: 
+      !! ** Inputs  : p_e1, p_e2  = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !! ** Outputs : p_e1_crs, p_e2_crs  = parent grid e1 or e2 (t,u,v,f)
+      !!
+      !! History.     4 Jun.  Write for WGT and scale factors only
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2)
+      CHARACTER(len=1)                    , INTENT(in)  :: cd_type  ! grid type U,V 
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e1_crs ! Coarse grid box 2D quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e2_crs ! Coarse grid box 2D quantity
+
+      !! Local variables
+      INTEGER :: ji, jj, jk     ! dummy loop indices
+      INTEGER :: ijie,ijje,ijrs
+  
+      !!----------------------------------------------------------------  
+      ! Initialize      
+
+      DO jk = 1, jpk    
+         DO ji = 2, nlei_crs
+            ijie = mie_crs(ji)
+            DO jj = nldj_crs, nlej_crs
+               ijje = mje_crs(jj)   ;   ijrs =  mje_crs(jj) - mjs_crs(jj)
+               ! Only for a factro 3 coarsening
+               SELECT CASE ( cd_type )
+                   CASE ( 'T' )
+                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
+                        ! Si à la frontière sud on a pas assez de maille de la grille mère
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                      ELSE
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje-1) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje-1) * nn_facty
+                      ENDIF
+                   CASE ( 'U' )
+                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
+                         ! Si à la frontière sud on a pas assez de maille de la grille mère
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+                      ELSE
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje-1) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje-1) * nn_facty
+                      ENDIF
+                   CASE ( 'V' )
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                   CASE ( 'F' )
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+               END SELECT
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pval=1.0 )
+
+   END SUBROUTINE crs_dom_hgr
+
+
+   SUBROUTINE crs_dom_facvol( p_mask, cd_type, p_e1, p_e2, p_e3, p_fld1_crs, p_fld2_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_wgt ***
+      !! ** Purpose :  Three applications.
+      !!               1) SUM. Get coarse grid horizontal scale factors and unmasked fraction
+      !!               2) VOL. Get coarse grid box volumes
+      !!               3) WGT. Weighting multiplier for volume-weighted and/or
+      !!                       area-weighted averages.
+      !!                       Weights (i.e. the denominator) calculated here 
+      !!                       to avoid IF-tests and division.
+      !! ** Method  :  1) SUM.  For grid types T,U,V,F (and W) the 2D scale factors of 
+      !!               the coarse grid are the sum of the east or north faces of the 
+      !!               parent grid subset comprising the coarse grid box.  
+      !!               The fractions of masked:total surface (3D) on the east, 
+      !!               north and top faces is, optionally, also output.
+      !!               - Top face area sum
+      !!                 Valid arguments: cd_type, cd_op='W', p_pmask, p_e1, p_e2 
+      !!               - Top face ocean surface fraction
+      !!                 Valid arguments: cd_type, cd_op='W', p_pmask, p_e1, p_e2       
+      !!               - e1,e2 Scale factors
+      !!                 Valid arguments: 
+      !!               2) VOL.  For grid types W and T, the coarse grid box
+      !!               volumes are output. Also optionally, the fraction of  
+      !!               masked:total volume of the parent grid subset is output (i.e. facvol).
+      !!               3) WGT. Based on the grid type, the denominator is pre-determined here to  
+      !!               perform area- or volume- weighted averages, 
+      !!               to avoid IF-tests and divisions.
+      !! ** Inputs  : p_e1, p_e2  = parent grid e1 or e2 (t,u,v,f)
+      !!              p_pmask     = parent grid mask (T,U,V,F) 
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              cd_op       = applied operation (SUM, VOL, WGT)
+      !!              p_e3      = (Optional) parent grid vertical level thickness (e3u or e3v)
+      !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid
+      !!              p_cfield2d_2 = (Optional) 2D field on coarse grid
+      !!              p_cfield3d_1 = (Optional) 3D field on coarse grid
+      !!              p_cfield3d_2 = (Optional) 3D field on coarse grid
+      !!
+      !! History.     4 Jun.  Write for WGT and scale factors only
+      !!----------------------------------------------------------------
+      CHARACTER(len=1),                         INTENT(in   ) ::   cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_mask     ! Parent grid U,V mask
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e1       ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in   ) ::   p_e2       ! Parent grid U,V scale factors (e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in   ) ::   p_e3       ! Parent grid vertical level thickness (e3u, e3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld1_crs ! Coarse grid box 3D quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out) ::   p_fld2_crs ! Coarse grid box 3D quantity 
+      !
+      INTEGER  ::   ji, jj, jk , ii, ij, je_2
+      REAL(wp) ::   zdAm
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zvol, zmask      
+      !!----------------------------------------------------------------  
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zvol, zmask )
+      !
+      p_fld1_crs(:,:,:) = 0._wp
+      p_fld2_crs(:,:,:) = 0._wp
+
+      DO jk = 1, jpk
+         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
+      END DO
+
+      zmask(:,:,:) = 0._wp
+      IF( cd_type == 'W' ) THEN
+         zmask(:,:,1) = p_mask(:,:,1) 
+         DO jk = 2, jpk
+            zmask(:,:,jk) = p_mask(:,:,jk-1) 
+         ENDDO
+      ELSE
+         DO jk = 1, jpk
+             zmask(:,:,jk) = p_mask(:,:,jk) 
+         ENDDO
+      ENDIF
+
+      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+            je_2 = mje_crs(2)
+            DO jk = 1, jpk           
+               DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  &
+                     &                 + zvol(ji,je_2-1,jk) + zvol(ji+1,je_2-1,jk) + zvol(ji+2,je_2-1,jk) 
+                  !
+                  zdAm =  zvol(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)  &
+                    &   + zvol(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)  &
+                    &   + zvol(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) 
+                  ! 
+                  p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk) 
+               ENDDO
+            ENDDO
+         ENDIF
+      ELSE
+         je_2 = mjs_crs(2)
+         DO jk = 1, jpk           
+            DO ji = nistr, niend, nn_factx
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+               p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  &
+                   &                + zvol(ji,je_2+1,jk) + zvol(ji+1,je_2+1,jk) + zvol(ji+2,je_2+1,jk)  &
+                   &                + zvol(ji,je_2+2,jk) + zvol(ji+1,je_2+2,jk) + zvol(ji+2,je_2+2,jk)  
+              !
+               zdAm = zvol(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)  &
+                 &  + zvol(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)  &
+                 &  + zvol(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)  &
+                 &  + zvol(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)  &
+                 &  + zvol(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)  &
+                 &  + zvol(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)  &
+                 &  + zvol(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)  &
+                 &  + zvol(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)  &
+                 &  + zvol(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk)
+                 ! 
+                 p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk) 
+            ENDDO
+         ENDDO
+      ENDIF
+
+      DO jk = 1, jpk           
+         DO jj  = njstr, njend, nn_facty
+            DO ji = nistr, niend, nn_factx
+               ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+               ij  = ( jj - njstr ) * rfacty_r + 3
+               !
+               p_fld1_crs(ii,ij,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  &
+                   &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  &
+                   &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk) 
+               !
+               zdAm =  zvol(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)  &
+                 &   + zvol(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)  &
+                 &   + zvol(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)  &
+                 &   + zvol(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)  &
+                 &   + zvol(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)  &
+                 &   + zvol(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)  &
+                 &   + zvol(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)  &
+                 &   + zvol(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)  &
+                 &   + zvol(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk)
+                 ! 
+                p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk) 
+            ENDDO
+         ENDDO
+      ENDDO
+      !                                             !  Retroactively add back the boundary halo cells.
+      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 ) 
+      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 ) 
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zvol, zmask )
+      !
+   END SUBROUTINE crs_dom_facvol
+
+
+   SUBROUTINE crs_dom_ope_3d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs, psgn )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_UV ***
+      !! ** Purpose :  Average, area-weighted, of U or V on the east and north faces 
+      !!
+      !! ** Method  :  The U and V velocities (3D) are determined as the area-weighted averages
+      !!               on the east and north faces, respectively,
+      !!               of the parent grid subset comprising the coarse grid box. 
+      !!               In the case of the V and F grid, the last jrow minus 1 is spurious.
+      !! ** Inputs  : p_e1_e2     = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              psgn        = sign change over north fold (See lbclnk.F90)
+      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
+      !!                                       for velocities (U or V)
+      !!              p_e3      = parent grid vertical level thickness (e3u or e3v)
+      !!              p_pfield    = U or V on the parent grid
+      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
+      !! ** Outputs : p_cfield3d = 3D field on coarse grid
+      !!
+      !! History.  29 May.  completed draft.
+      !!            4 Jun.  Revision for WGT
+      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
+      !!----------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld      ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op      ! Operation SUM, MAX or MIN
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask     ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12      ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3       ! Parent grid vertical level thickness (e3u, e3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska
+      REAL(wp),                                 INTENT(in)           :: psgn       ! sign 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(  out)        :: p_fld_crs  ! Coarse grid box 3D quantity 
+      !
+      INTEGER  ::   ji, jj, jk 
+      INTEGER  ::   ii, ij, ijie, ijje, je_2
+      REAL(wp) ::   zflcrs, zsfcrs   
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zsurf, zsurfmsk, zmask  
+      !!----------------------------------------------------------------  
+      !
+      p_fld_crs(:,:,:) = 0._wp
+      !
+      SELECT CASE ( cd_op )
+      !
+      CASE ( 'VOL' )
+         !
+         CALL wrk_alloc( jpi,jpj,jpk,   zsurf, zsurfmsk )
+         !   
+         SELECT CASE ( cd_type )
+         !   
+         CASE( 'T', 'W' )
+               IF( cd_type == 'T' ) THEN
+                     DO jk = 1, jpk
+                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk) 
+                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk) 
+                    ENDDO
+                  ELSE
+                     zsurf   (:,:,1) =  p_e12(:,:) * p_e3(:,:,1)
+                     zsurfmsk(:,:,1) =  zsurf(:,:,1) *  p_mask(:,:,1) 
+                     DO jk = 2, jpk
+                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk)
+                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk) * p_mask(:,:,jk-1) 
+                     ENDDO
+                  ENDIF
+         
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2       
+                              zflcrs =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   &
+                                &     + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   &
+                                &     + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk) 
+ 
+                              zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk) 
+                              !
+                              p_fld_crs(ii,2,jk) = zflcrs
+                              IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
+                           ENDDO
+                        ENDDO
+                     ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           zflcrs =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) &
+                             &     + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) &
+                             &     + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) &
+                             &     + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) &
+                             &     + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) &
+                             &     + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) &
+                             &     + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) &
+                             &     + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) &
+                             &     + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk) 
+
+                           zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) &
+                             &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) &
+                             &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk) 
+                            !
+                            p_fld_crs(ii,2,jk) = zflcrs
+                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij = ( jj - njstr ) * rfacty_r + 3
+                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk) 
+
+                           zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) &
+                             &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) &
+                             &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 
+                            !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+               CASE DEFAULT
+                    STOP
+               END SELECT
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+
+         CASE ( 'SUM' )
+         
+            CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk )
+
+            SELECT CASE ( cd_type )
+              CASE( 'W' )
+                  IF( PRESENT( p_e3 ) ) THEN
+                    zsurfmsk(:,:,1) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
+                    DO jk = 2, jpk
+                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1) 
+                    ENDDO
+                 ELSE
+                    zsurfmsk(:,:,1) =  p_e12(:,:) * p_mask(:,:,1) 
+                    DO jk = 2, jpk
+                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk-1) 
+                    ENDDO
+                 ENDIF
+              CASE DEFAULT
+                 IF( PRESENT( p_e3 ) ) THEN
+                    DO jk = 1, jpk
+                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) 
+                    ENDDO
+                 ELSE
+                    DO jk = 1, jpk
+                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk) 
+                    ENDDO
+                 ENDIF
+              END SELECT
+
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2          
+                              zflcrs  =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk) &
+                                &      + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk) &
+                                &      + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk) 
+                               !
+                              p_fld_crs(ii,2,jk) = zflcrs
+                           ENDDO
+                        ENDDO
+                      ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           zflcrs  =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk)  &
+                             &      + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk)  &
+                             &      + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk)  &
+                             &      + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk)  &
+                             &      + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk)  &
+                             &      + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk)  &
+                             &      + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk)  &
+                             &      + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk)  &
+                             &      + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)  
+                            !
+                            p_fld_crs(ii,2,jk) = zflcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij  = ( jj - njstr ) * rfacty_r + 3
+                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk)  &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk)  &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk)  &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk)  &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk)  &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk)  &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk)  &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk)  &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)  
+                            !
+                            p_fld_crs(ii,ij,jk) = zflcrs
+                            ! 
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'V' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        ijje = mje_crs(2)
+                     ENDIF
+                  ELSE
+                     ijje = mjs_crs(2)
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                        zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) &
+                          &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) &
+                          &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 
+                          !
+                        p_fld_crs(ii,2,jk) = zflcrs
+                     ENDDO
+                  ENDDO
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij   = ( jj - njstr ) * rfacty_r + 3
+                           ijje = mje_crs(ij)
+                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) &
+                             &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) &
+                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 
+                             !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           ! 
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'U' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
+                              ijie = mie_crs(ii)
+                              zflcrs  =  p_fld(ijie,je_2,jk) * zsurfmsk(ijie,je_2,jk)  
+                              p_fld_crs(ii,2,jk) = zflcrs
+                           ENDDO
+                        ENDDO
+                      ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           ijie = mie_crs(ii)
+                           zflcrs =  p_fld(ijie,je_2  ,jk) * zsurfmsk(ijie,je_2  ,jk)  &
+                             &     + p_fld(ijie,je_2+1,jk) * zsurfmsk(ijie,je_2+1,jk)  &
+                             &     + p_fld(ijie,je_2+2,jk) * zsurfmsk(ijie,je_2+2,jk) 
+
+                           p_fld_crs(ii,2,jk) = zflcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + 3
+                           ijie = mie_crs(ii)
+                           zflcrs =  p_fld(ijie,jj  ,jk) * zsurfmsk(ijie,jj  ,jk)  &
+                              &    + p_fld(ijie,jj+1,jk) * zsurfmsk(ijie,jj+1,jk)  &
+                              &    + p_fld(ijie,jj+2,jk) * zsurfmsk(ijie,jj+2,jk) 
+                             !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           ! 
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+              IF( PRESENT( p_surf_crs ) ) THEN
+                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:,:) = p_fld_crs(:,:,:) / p_surf_crs(:,:,:)
+              ENDIF
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk )
+
+         CASE ( 'MAX' )    !  search the max of unmasked grid cells
+
+            CALL wrk_alloc( jpi, jpj, jpk, zmask )
+
+            SELECT CASE ( cd_type )
+              CASE( 'W' )
+                  zmask(:,:,1) = p_mask(:,:,1) 
+                  DO jk = 2, jpk
+                     zmask(:,:,jk) = p_mask(:,:,jk-1) 
+                  ENDDO
+              CASE ( 'T' )
+                  DO jk = 1, jpk
+                     zmask(:,:,jk) = p_mask(:,:,jk) 
+                  ENDDO
+            END SELECT
+
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
+                              zflcrs =  &
+                                & MAX( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) - ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  &
+                                &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) - ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  &
+                                &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) - ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  )
+                              !
+                              p_fld_crs(ii,2,jk) = zflcrs
+                           ENDDO
+                        ENDDO
+                      ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           zflcrs =  &
+                             & MAX( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) - ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) - ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) - ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) - ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) - ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) - ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) - ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) - ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) - ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij  = ( jj - njstr ) * rfacty_r + 3
+                           zflcrs =  &
+                             & MAX( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) - ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) - ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) - ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) - ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) - ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) - ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) - ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) - ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) - ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'V' )
+
+                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        ijje = mje_crs(2)
+                      ENDIF
+                  ELSE
+                     ijje = mjs_crs(2)
+                  ENDIF
+
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        zflcrs = &
+                          & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
+                          !
+                        p_fld_crs(ii,2,jk) = zflcrs
+                     ENDDO
+                  ENDDO
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij  = ( jj - njstr ) * rfacty_r + 3
+                           ijje = mje_crs(ij)
+                           !                  
+                           zflcrs = &
+                             & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+
+                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
+                              ijie = mie_crs(ii)
+                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 
+                              !
+                              p_fld_crs(ii,2,jk) = zflcrs
+                            ENDDO
+                        ENDDO
+                      ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           ijie = mie_crs(ii)
+                           zflcrs = &
+                             & MAX( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  )
+                            !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + 3
+                           ijie = mie_crs(ii)
+                           zflcrs =  &
+                             & MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf  )
+                           ! 
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           ! 
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zmask )
+
+         CASE ( 'MIN' )      !   Search the min of unmasked grid cells
+
+            CALL wrk_alloc( jpi, jpj, jpk, zmask )
+
+            SELECT CASE ( cd_type )
+              CASE( 'W' )
+                  zmask(:,:,1) = p_mask(:,:,1) 
+                  DO jk = 2, jpk
+                     zmask(:,:,jk) = p_mask(:,:,jk-1) 
+                  ENDDO
+              CASE ( 'T' )
+                  DO jk = 1, jpk
+                     zmask(:,:,jk) = p_mask(:,:,jk) 
+                  ENDDO
+            END SELECT
+
+            SELECT CASE ( cd_type )
+
+               CASE( 'T', 'W' )
+         
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
+                              zflcrs =  &
+                                & MIN( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) + ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  &
+                                &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) + ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  &
+                                &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) + ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  )
+                              !
+                              p_fld_crs(ii,2,jk) = zflcrs
+                           ENDDO
+                        ENDDO
+                      ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           zflcrs =  &
+                             & MIN( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) + ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) + ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) + ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) + ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) + ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) + ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) + ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) + ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) + ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   )
+                           !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij  = ( jj - njstr ) * rfacty_r + 3
+                           zflcrs =  &
+                             & MIN( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) + ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) + ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) + ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) + ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) + ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) + ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  &
+                             &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) + ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) + ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) + ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'V' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        ijje = mje_crs(2)
+                      ENDIF
+                  ELSE
+                     ijje = mjs_crs(2)
+                  ENDIF
+
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        zflcrs = &
+                          & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
+                          !
+                        p_fld_crs(ii,2,jk) = zflcrs
+                     ENDDO
+                  ENDDO
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                           ij  = ( jj - njstr ) * rfacty_r + 3
+                           ijje = mje_crs(ij)
+                           zflcrs = &
+                             & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  &
+                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+
+                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO jk = 1, jpk           
+                           DO ji = nistr, niend, nn_factx
+                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
+                              ijie = mie_crs(ii)
+                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 
+                              !
+                              p_fld_crs(ii,2,jk) = zflcrs
+                            ENDDO
+                        ENDDO
+                      ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO jk = 1, jpk           
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                           ijie = mie_crs(ii)
+                           zflcrs = &
+                             & MIN( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  )
+                            !
+                           p_fld_crs(ii,2,jk) = zflcrs
+                        ENDDO
+                     ENDDO
+                  ENDIF
+                  !
+                  DO jk = 1, jpk           
+                     DO jj  = njstr, njend, nn_facty
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - njstr ) * rfacty_r + 3
+                           ijie = mie_crs(ii)
+                           zflcrs = &
+                             & MIN( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  &
+                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf  )
+                           ! 
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           ! 
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+          
+            END SELECT
+            !
+            CALL wrk_dealloc( jpi, jpj, jpk, zmask )
+            !
+         END SELECT
+         !
+         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn )
+         !
+    END SUBROUTINE crs_dom_ope_3d
+
+    SUBROUTINE crs_dom_ope_2d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs, psgn )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_UV ***
+      !! ** Purpose :  Average, area-weighted, of U or V on the east and north faces 
+      !!
+      !! ** Method  :  The U and V velocities (3D) are determined as the area-weighted averages
+      !!               on the east and north faces, respectively,
+      !!               of the parent grid subset comprising the coarse grid box. 
+      !!               In the case of the V and F grid, the last jrow minus 1 is spurious.
+      !! ** Inputs  : p_e1_e2     = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              psgn        = sign change over north fold (See lbclnk.F90)
+      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
+      !!                                       for velocities (U or V)
+      !!              p_e3      = parent grid vertical level thickness (e3u or e3v)
+      !!              p_pfield    = U or V on the parent grid
+      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
+      !! ** Outputs : p_cfield3d = 3D field on coarse grid
+      !!
+      !! History.  29 May.  completed draft.
+      !!            4 Jun.  Revision for WGT
+      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
+      !!----------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (e3u, e3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask
+      REAL(wp),                                 INTENT(in)           :: psgn   
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
+      !
+      INTEGER  :: ji, jj, jk                 ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij, je_2
+      REAL(wp) :: zflcrs, zsfcrs   
+      REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk   
+      !!----------------------------------------------------------------  
+      !
+      p_fld_crs(:,:) = 0._wp
+      !
+      SELECT CASE ( cd_op )
+      
+        CASE ( 'VOL' )
+      
+            CALL wrk_alloc( jpi, jpj, zsurfmsk )
+            zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
+
+            IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+               IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                  je_2 = mje_crs(2)
+                  DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2       
+                     zflcrs =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2)   &
+                       &     + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2)   &
+                       &     + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2) 
+
+                     zsfcrs =  zsurfmsk(ji,je_2) + zsurfmsk(ji+1,je_2) + zsurfmsk(ji+2,je_2) 
+                     !
+                     p_fld_crs(ii,2) = zflcrs
+                     IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs
+                  ENDDO
+               ENDIF
+            ELSE
+               je_2 = mjs_crs(2)
+               DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
+                  zflcrs =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  ) &
+                    &     + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  ) &
+                    &     + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  ) &
+                    &     + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1) &
+                    &     + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1) &
+                    &     + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1) &
+                    &     + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2) &
+                    &     + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2) &
+                    &     + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2) 
+
+                   zsfcrs =  zsurfmsk(ji,je_2  ) + zsurfmsk(ji+1,je_2  ) + zsurfmsk(ji+2,je_2  ) &
+                     &     + zsurfmsk(ji,je_2+1) + zsurfmsk(ji+1,je_2+1) + zsurfmsk(ji+2,je_2+1) &
+                     &     + zsurfmsk(ji,je_2+2) + zsurfmsk(ji+1,je_2+2) + zsurfmsk(ji+2,je_2+2) 
+                    !
+                    p_fld_crs(ii,2) = zflcrs
+                    IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs
+                ENDDO
+            ENDIF
+                  !
+            DO jj  = njstr, njend, nn_facty
+               DO ji = nistr, niend, nn_factx
+                  ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij  = ( jj - njstr ) * rfacty_r + 3
+                  zflcrs =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  ) &
+                    &     + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  ) &
+                    &     + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  ) &
+                    &     + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1) &
+                    &     + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1) &
+                    &     + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1) &
+                    &     + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2) &
+                    &     + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2) &
+                    &     + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2) 
+  
+                  zsfcrs =  zsurfmsk(ji,jj  ) + zsurfmsk(ji+1,jj  ) + zsurfmsk(ji+2,jj  ) &
+                    &     + zsurfmsk(ji,jj+1) + zsurfmsk(ji+1,jj+1) + zsurfmsk(ji+2,jj+1) &
+                    &     + zsurfmsk(ji,jj+2) + zsurfmsk(ji+1,jj+2) + zsurfmsk(ji+2,jj+2) 
+                   !
+                  p_fld_crs(ii,ij) = zflcrs
+                  IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs
+               ENDDO      
+            ENDDO
+
+            CALL wrk_dealloc( jpi, jpj, zsurfmsk )
+
+         CASE ( 'SUM' )
+         
+            CALL wrk_alloc( jpi, jpj, zsurfmsk )
+            IF( PRESENT( p_e3 ) ) THEN
+               zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
+            ELSE
+               zsurfmsk(:,:) =  p_e12(:,:) * p_mask(:,:,1)
+            ENDIF
+
+            SELECT CASE ( cd_type )
+
+               CASE( 'T', 'W' )
+
+                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                         je_2 = mje_crs(2)
+                         DO ji = nistr, niend, nn_factx
+                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                            zflcrs  =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2) &
+                              &      + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2) &
+                              &      + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2) 
+                              !
+                             p_fld_crs(ii,2) = zflcrs
+                         ENDDO
+                      ENDIF
+                   ELSE
+                      je_2 = mjs_crs(2)
+                      DO ji = nistr, niend, nn_factx
+                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                         zflcrs  =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  )  &
+                           &      + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  )  &
+                           &      + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  )  &
+                           &      + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1)  &
+                           &      + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1)  &
+                           &      + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1)  &
+                           &      + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2)  &
+                           &      + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2)  &
+                           &      + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2)  
+                            !
+                            p_fld_crs(ii,2) = zflcrs
+                      ENDDO
+                   ENDIF
+                     !
+                   DO jj = njstr, njend, nn_facty
+                      DO ji = nistr, niend, nn_factx
+                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                         ij   = ( jj - njstr ) * rfacty_r + 3
+                         zflcrs  =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  &
+                           &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  &
+                           &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  )  &
+                           &      + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1)  &
+                           &      + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1)  &
+                           &      + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1)  &
+                           &      + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2)  &
+                           &      + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2)  &
+                           &      + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)  
+                           !
+                          p_fld_crs(ii,ij) = zflcrs
+                          ! 
+                      ENDDO      
+                   ENDDO
+            
+               CASE( 'V' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        ijje = mje_crs(2)
+                      ENDIF
+                  ELSE
+                     ijje = mjs_crs(2)
+                  ENDIF
+
+                  DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                     zflcrs  =  p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje) &
+                       &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) &
+                       &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 
+                            !
+                     p_fld_crs(ii,2) = zflcrs
+                  ENDDO
+
+                  DO jj = njstr, njend, nn_facty
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - njstr ) * rfacty_r + 3
+                        ijje = mje_crs(ij)
+                        zflcrs  =  p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje) &
+                          &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) &
+                          &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 
+                          !
+                        p_fld_crs(ii,ij) = zflcrs
+                        ! 
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'U' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                           ijie = mie_crs(ii)
+                           zflcrs  =  p_fld(ijie,je_2) * zsurfmsk(ijie,je_2)  
+                           p_fld_crs(ii,2) = zflcrs
+                        ENDDO
+                     ENDIF
+                  ELSE
+                     je_2 = mjs_crs(2)
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                        ijie = mie_crs(ii)
+                        zflcrs =  p_fld(ijie,je_2  ) * zsurfmsk(ijie,je_2  )  &
+                          &     + p_fld(ijie,je_2+1) * zsurfmsk(ijie,je_2+1)  &
+                          &     + p_fld(ijie,je_2+2) * zsurfmsk(ijie,je_2+2) 
+   
+                        p_fld_crs(ii,2) = zflcrs
+                     ENDDO
+                 ENDIF
+
+                 DO jj = njstr, njend, nn_facty
+                    DO ji = nistr, niend, nn_factx
+                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                       ij   = ( jj - njstr ) * rfacty_r + 3
+                       ijie = mie_crs(ii)
+                       zflcrs =  p_fld(ijie,jj  ) * zsurfmsk(ijie,jj  )  &
+                          &    + p_fld(ijie,jj+1) * zsurfmsk(ijie,jj+1)  &
+                          &    + p_fld(ijie,jj+2) * zsurfmsk(ijie,jj+2) 
+                         !
+                       p_fld_crs(ii,ij) = zflcrs
+                       ! 
+                    ENDDO      
+                 ENDDO
+
+              END SELECT
+
+              IF( PRESENT( p_surf_crs ) ) THEN
+                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:) = p_fld_crs(:,:) / p_surf_crs(:,:)
+              ENDIF
+
+              CALL wrk_dealloc( jpi, jpj, zsurfmsk )
+
+         CASE ( 'MAX' )
+
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+  
+                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                         je_2 = mje_crs(2)
+                         DO ji = nistr, niend, nn_factx
+                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                            zflcrs =  &
+                              & MAX( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) - ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  &
+                             &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  &
+                             &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  )
+                            !
+                            p_fld_crs(ii,2) = zflcrs
+                         ENDDO
+                      ENDIF
+                   ELSE
+                      je_2 = mjs_crs(2) 
+                      zflcrs =  &
+                        &  MAX( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) - ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  &
+                        &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) - ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  &
+                        &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) - ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  &
+                        &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) - ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  &
+                        &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) - ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  &
+                        &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) - ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  &
+                        &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) - ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  &
+                        &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) - ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  &
+                        &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) - ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   )
+                      !
+                      p_fld_crs(ii,2) = zflcrs
+                   ENDIF
+
+                   DO jj = njstr, njend, nn_facty
+                      DO ji = nistr, niend, nn_factx
+                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                         ij   = ( jj - njstr ) * rfacty_r + 3
+                         zflcrs = &
+                          &  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) - ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  &
+                          &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) - ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  &
+                          &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) - ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  &
+                          &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) - ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  &
+                          &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) - ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  &
+                          &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) - ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  &
+                          &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) - ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  &
+                          &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) - ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  &
+                          &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) - ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   )
+                         !
+                         p_fld_crs(ii,ij) = zflcrs
+                         !
+                      ENDDO      
+                   ENDDO
+            
+               CASE( 'V' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        ijje = mje_crs(2)
+                      ENDIF
+                  ELSE
+                     ijje = mjs_crs(2)
+                  ENDIF
+
+                  DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                     zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf )
+                       !
+                     p_fld_crs(ii,2) = zflcrs
+                  ENDDO      
+                  DO jj = njstr, njend, nn_facty
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                        ij   = ( jj - njstr ) * rfacty_r + 3               
+                        ijje = mje_crs(ij) 
+                        !                  
+                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'U' )
+
+                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                           ijie = mie_crs(ii)
+                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf 
+                           p_fld_crs(ii,2) = zflcrs
+                        ENDDO
+                     ENDIF
+                 ELSE
+                     je_2 = mjs_crs(2)
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                        ijie = mie_crs(ii)
+                        zflcrs =  &
+                          &  MAX( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
+                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
+                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  )
+                        p_fld_crs(ii,2) = zflcrs
+                     ENDDO
+                 ENDIF
+                 DO jj = njstr, njend, nn_facty
+                    DO ji = nistr, niend, nn_factx
+                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                       ij   = ( jj - njstr ) * rfacty_r + 3
+                       ijie = mie_crs(ii)
+                       zflcrs =  &
+                         &  MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
+                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
+                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf  )
+                        p_fld_crs(ii,ij) = zflcrs
+                        ! 
+                     ENDDO      
+                  ENDDO
+
+              END SELECT
+
+         CASE ( 'MIN' )      !   Search the min of unmasked grid cells
+
+           SELECT CASE ( cd_type )
+
+              CASE( 'T', 'W' )
+  
+                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                         je_2 = mje_crs(2)
+                         DO ji = nistr, niend, nn_factx
+                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                            zflcrs =  &
+                              & MIN( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) + ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  &
+                             &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) + ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  &
+                             &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) + ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  )
+                            !
+                            p_fld_crs(ii,2) = zflcrs
+                         ENDDO
+                      ENDIF
+                   ELSE
+                      je_2 = mjs_crs(2) 
+                      zflcrs =  &
+                        &  MIN( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) + ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  &
+                        &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) + ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  &
+                        &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) + ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  &
+                        &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) + ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  &
+                        &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) + ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  &
+                        &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) + ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  &
+                        &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) + ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  &
+                        &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) + ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  &
+                        &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) + ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   )
+                      !
+                      p_fld_crs(ii,2) = zflcrs
+                   ENDIF
+
+                   DO jj = njstr, njend, nn_facty
+                      DO ji = nistr, niend, nn_factx
+                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                         ij   = ( jj - njstr ) * rfacty_r + 3
+                         zflcrs = &
+                          &  MIN( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) + ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  &
+                          &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) + ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  &
+                          &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) + ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  &
+                          &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) + ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  &
+                          &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) + ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  &
+                          &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) + ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  &
+                          &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) + ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  &
+                          &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) + ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  &
+                          &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) + ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   )
+                         !
+                         p_fld_crs(ii,ij) = zflcrs
+                         !
+                      ENDDO      
+                   ENDDO
+            
+               CASE( 'V' )
+
+                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        ijje = mje_crs(2)
+                      ENDIF
+                  ELSE
+                     ijje = mjs_crs(2)
+                  ENDIF
+
+                  DO ji = nistr, niend, nn_factx
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                     zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf )
+                       !
+                     p_fld_crs(ii,2) = zflcrs
+                  ENDDO      
+                  DO jj = njstr, njend, nn_facty
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                        ij   = ( jj - njstr ) * rfacty_r + 3               
+                        ijje = mje_crs(ij) 
+                        !                  
+                        zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  &
+                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'U' )
+
+                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+                        je_2 = mje_crs(2)
+                        DO ji = nistr, niend, nn_factx
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                           ijie = mie_crs(ii)
+                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf 
+ 
+                           p_fld_crs(ii,2) = zflcrs
+                        ENDDO
+                     ENDIF
+                 ELSE
+                     je_2 = mjs_crs(2)
+                     DO ji = nistr, niend, nn_factx
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
+                        ijie = mie_crs(ii)
+                        zflcrs =  &
+                          &  MIN( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
+                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  &
+                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  )
+                        p_fld_crs(ii,2) = zflcrs
+                     ENDDO
+                 ENDIF
+                 DO jj = njstr, njend, nn_facty
+                    DO ji = nistr, niend, nn_factx
+                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                       ij   = ( jj - njstr ) * rfacty_r + 3
+                       ijie = mie_crs(ii)
+                       zflcrs =  &
+                         &  MIN( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
+                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  &
+                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf  )
+                        p_fld_crs(ii,ij) = zflcrs
+                        ! 
+                     ENDDO      
+                  ENDDO
+
+              END SELECT
+             !
+         END SELECT
+         !
+         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn )
+         !
+   END SUBROUTINE crs_dom_ope_2d
+
+   SUBROUTINE crs_dom_e3( p_e1, p_e2, p_e3, p_sfc_crs, cd_type, p_mask, p_e3_crs, p_e3_max_crs)
+      !!----------------------------------------------------------------  
+      !!  Arguments
+      CHARACTER(len=1),                         INTENT(in) :: cd_type      ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_mask       ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in) :: p_e1, p_e2   ! 2D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_e3         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: p_sfc_crs ! Coarse grid box east or north face quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_crs ! Coarse grid box east or north face quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_max_crs ! Coarse grid box east or north face quantity 
+
+      !! Local variables
+      INTEGER ::  ji, jj, jk                   ! dummy loop indices
+      INTEGER ::  ijie, ijje, ii, ij, je_2
+      REAL(wp) :: ze3crs  
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf   
+
+      !!----------------------------------------------------------------  
+
+       p_e3_crs    (:,:,:) = 0.
+       p_e3_max_crs(:,:,:) = 1.
+   
+
+       CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf )
+
+       SELECT CASE ( cd_type )
+          CASE( 'W' )
+              zmask(:,:,1) = p_mask(:,:,1) 
+              DO jk = 2, jpk
+                 zmask(:,:,jk) = p_mask(:,:,jk-1) 
+              ENDDO
+           CASE DEFAULT
+              DO jk = 1, jpk
+                 zmask(:,:,jk) = p_mask(:,:,jk) 
+              ENDDO
+       END SELECT
+
+       DO jk = 1, jpk
+          zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
+       ENDDO
+
+       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+             je_2 = mje_crs(2)
+             DO jk = 1 , jpk
+                DO ji = nistr, niend, nn_factx
+                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                   ze3crs =   zsurf(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)   &
+                        &   + zsurf(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)   &
+                        &   + zsurf(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) 
+
+                   p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                   !
+                   ze3crs = MAX( p_e3(ji  ,je_2,jk) * zmask(ji  ,je_2,jk),  &
+                      &          p_e3(ji+1,je_2,jk) * zmask(ji+1,je_2,jk),  &
+                      &          p_e3(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  )
+                   !
+                   p_e3_max_crs(ii,2,jk) = ze3crs
+                ENDDO
+             ENDDO
+          ENDIF
+       ELSE
+          je_2 = mjs_crs(2)
+          DO jk = 1 , jpk
+             DO ji = nistr, niend, nn_factx
+                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                ze3crs =  zsurf(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)   &
+                   &    + zsurf(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)   &
+                   &    + zsurf(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)   &
+                   &    + zsurf(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)   &
+                   &    + zsurf(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)   &
+                   &    + zsurf(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)   &
+                   &    + zsurf(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)   &
+                   &    + zsurf(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)   &
+                   &    + zsurf(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk)
+
+                p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk)
+                !
+                ze3crs = MAX( p_e3(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk),  &
+                   &          p_e3(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk),  &
+                   &          p_e3(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk),  &
+                   &          p_e3(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk),  &
+                   &          p_e3(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk),  &
+                   &          p_e3(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk),  &
+                   &          p_e3(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk),  &
+                   &          p_e3(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk),  &
+                   &          p_e3(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) )
+               
+                p_e3_max_crs(ii,2,jk) = ze3crs
+                ENDDO
+             ENDDO
+          ENDIF
+          DO jk = 1 , jpk
+             DO jj = njstr, njend, nn_facty
+                DO ji = nistr, niend, nn_factx
+                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2          
+                   ij   = ( jj - njstr ) * rfacty_r + 3
+                   ze3crs =   zsurf(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)   &
+                   &        + zsurf(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)   &
+                   &        + zsurf(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)   &
+                   &        + zsurf(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)   &
+                   &        + zsurf(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)   &
+                   &        + zsurf(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)   &
+                   &        + zsurf(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)   &
+                   &        + zsurf(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)   &
+                   &        + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk)
+
+                p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                !
+                ze3crs = MAX( p_e3(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk),  &
+                   &          p_e3(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk),  &
+                   &          p_e3(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk),  &
+                   &          p_e3(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk),  &
+                   &          p_e3(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk),  &
+                   &          p_e3(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk),  &
+                   &          p_e3(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk),  &
+                   &          p_e3(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk),  &
+                   &          p_e3(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) )
+               
+                p_e3_max_crs(ii,ij,jk) = ze3crs
+             ENDDO
+          ENDDO
+       ENDDO
+                  
+       CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )  
+       CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )  
+       !              
+       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask )
+       !
+   END SUBROUTINE crs_dom_e3
+
+   SUBROUTINE crs_dom_sfc( p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 )
+
+      !!  Arguments
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type      ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)           :: p_mask       ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in), OPTIONAL :: p_e1, p_e2         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in), OPTIONAL :: p_e3         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_surf_crs ! Coarse grid box east or north face quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_surf_crs_msk ! Coarse grid box east or north face quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                   ! dummy loop indices
+      INTEGER  :: ii, ij, je_2
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk   
+      !!----------------------------------------------------------------  
+      ! Initialize
+
+
+      CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+      !
+      SELECT CASE ( cd_type )
+      
+         CASE ('W')    
+            DO jk = 1, jpk
+               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) 
+            ENDDO
+            zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1) 
+            DO jk = 2, jpk
+               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1) 
+            ENDDO
+
+         CASE ('V')     
+            DO jk = 1, jpk
+               zsurf(:,:,jk) = p_e1(:,:) * p_e3(:,:,jk) 
+            ENDDO
+            DO jk = 1, jpk
+               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
+            ENDDO
+
+         CASE ('U')     
+            DO jk = 1, jpk
+               zsurf(:,:,jk) = p_e2(:,:) * p_e3(:,:,jk) 
+            ENDDO
+            DO jk = 1, jpk
+               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
+            ENDDO
+
+         CASE DEFAULT
+            DO jk = 1, jpk
+               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) 
+            ENDDO
+            DO jk = 1, jpk
+               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk) 
+            ENDDO
+      END SELECT
+
+      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2
+         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN
+            je_2 = mje_crs(2)
+            DO jk = 1, jpk
+               DO ji = nistr, niend, nn_factx
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
+                  !    
+                  p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) &
+                    &                      + zsurf(ji,je_2-1,jk) + zsurf(ji+1,je_2-1,jk) + zsurf(ji+2,je_2-1,jk)  ! Why ?????
+                  !
+                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk) 
+                  !
+               ENDDO
+            ENDDO
+         ENDIF
+      ELSE
+         je_2 = mjs_crs(2)
+         DO jk = 1, jpk
+            DO ji = nistr, niend, nn_factx
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2 
+               !  
+               p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk)  &
+                    &                   + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk)  &
+                    &                   + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)  
+
+               p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2  ,jk) + zsurfmsk(ji+1,je_2  ,jk) + zsurfmsk(ji+2,je_2  ,jk)  &
+                    &                   + zsurfmsk(ji,je_2+1,jk) + zsurfmsk(ji+1,je_2+1,jk) + zsurfmsk(ji+2,je_2+1,jk)  &
+                    &                   + zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk)  
+                ENDDO
+            ENDDO
+      ENDIF
+         
+      DO jk = 1, jpk
+         DO jj = njstr, njend, nn_facty
+            DO ji = nistr, niend, nn_factx
+               ii = ( ji - mis_crs(2) ) * rfactx_r + 2  
+               ij = ( jj - njstr ) * rfacty_r + 3
+               !
+               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk)  &
+                    &                    + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk)  &
+                    &                    + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)  
+
+               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj  ,jk) + zsurfmsk(ji+1,jj  ,jk) + zsurfmsk(ji+2,jj  ,jk)  &
+                    &                    + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk)  &
+                    &                    + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)  
+            ENDDO      
+         ENDDO
+      ENDDO   
+
+      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 )
+
+      CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf )
+
+   END SUBROUTINE crs_dom_sfc
+   
+   SUBROUTINE crs_dom_def
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_def ***
+      !! ** Purpose :  Three applications.
+      !!               1) Define global domain indice of the croasening grid
+      !!               2) Define local domain indice of the croasening grid
+      !!               3) Define the processor domain indice for a croasening grid
+      !!----------------------------------------------------------------
+      !! 
+      !!  local variables
+   
+      INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices
+      INTEGER  :: ierr                                ! allocation error status
+ 
+  
+     ! 1.a. Define global domain indices  : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points 
+      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2
+  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj
+  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3
+      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3
+      jpiglo_crsm1 = jpiglo_crs - 1
+      jpjglo_crsm1 = jpjglo_crs - 1  
+
+      jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci
+      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj   
+              
+      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors  
+       
+      jpi_crsm1   = jpi_crs - 1
+      jpj_crsm1   = jpj_crs - 1
+      nperio_crs  = jperio
+      npolj_crs   = npolj
+      
+      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays
+
+      ! 2.a Define processor domain
+      IF( .NOT. lk_mpp ) THEN
+         nimpp_crs  = 1
+         njmpp_crs  = 1
+         nlci_crs   = jpi_crs
+         nlcj_crs   = jpj_crs
+         nldi_crs   = 1
+         nldj_crs   = 1
+         nlei_crs   = jpi_crs
+         nlej_crs   = jpj_crs
+      ELSE
+         ! Initialisation of most local variables -
+         nimpp_crs  = 1
+         njmpp_crs  = 1
+         nlci_crs   = jpi_crs
+         nlcj_crs   = jpj_crs
+         nldi_crs   = 1
+         nldj_crs   = 1
+         nlei_crs   = jpi_crs
+         nlej_crs   = jpj_crs
+         
+        ! Calculs suivant une découpage en j
+        DO jn = 1, jpnij, jpni
+           IF( jn < ( jpnij - jpni + 1 ) ) THEN
+              nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) &
+                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) )
+           ELSE                                             
+              nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1            
+           ENDIF
+           IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1             
+           SELECT CASE( ibonjt(jn) )
+              CASE ( -1 )
+                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1
+                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
+                nldjt_crs(jn) = nldjt(jn)
+              
+              CASE ( 0 )
+              
+                nldjt_crs(jn) = nldjt(jn)
+                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1
+                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
+                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
+                
+              CASE ( 1, 2 )
+              
+                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
+                nlcjt_crs(jn) = nlejt_crs(jn)
+                nldjt_crs(jn) = nldjt(jn)
+                
+              CASE DEFAULT
+                 STOP
+           END SELECT
+           IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1
+
+           IF(nldjt_crs(jn) == 1 ) THEN
+              njmppt_crs(jn) = 1
+           ELSE
+              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) )
+           ENDIF           
+           
+           DO jj = jn + 1, jn + jpni - 1
+              nlejt_crs(jj) = nlejt_crs(jn) 
+              nlcjt_crs(jj) = nlcjt_crs(jn)
+              nldjt_crs(jj) = nldjt_crs(jn)
+              njmppt_crs(jj)= njmppt_crs(jn)
+           ENDDO
+        ENDDO 
+        nlej_crs  = nlejt_crs(nproc + 1) 
+        nlcj_crs  = nlcjt_crs(nproc + 1)
+        nldj_crs  = nldjt_crs(nproc + 1)
+        njmpp_crs = njmppt_crs(nproc + 1)
+
+        ! Calcul suivant un decoupage en i
+        DO jn = 1, jpni
+           IF( jn == 1 ) THEN          
+              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) )
+           ELSE
+              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) &
+                 &          - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) )  / nn_factx, wp) )
+           ENDIF
+
+           SELECT CASE( ibonit(jn) )
+              CASE ( -1 )
+                 nleit_crs(jn) = nleit_crs(jn) + jpreci           
+                 nlcit_crs(jn) = nleit_crs(jn) + jpreci
+                 nldit_crs(jn) = nldit(jn) 
+              
+              CASE ( 0 )
+                 nleit_crs(jn) = nleit_crs(jn) + jpreci
+                 nlcit_crs(jn) = nleit_crs(jn) + jpreci
+                 nldit_crs(jn) = nldit(jn) 
+                
+              CASE ( 1, 2 )
+                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1
+                 nleit_crs(jn) = nleit_crs(jn) + jpreci
+                 nlcit_crs(jn) = nleit_crs(jn)
+                 nldit_crs(jn) = nldit(jn) 
+
+              CASE DEFAULT
+                 STOP
+           END SELECT
+
+           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1
+           DO jj = jn + jpni , jpnij, jpni
+              nleit_crs(jj) = nleit_crs(jn) 
+              nlcit_crs(jj) = nlcit_crs(jn)
+              nldit_crs(jj) = nldit_crs(jn)
+              nimppt_crs(jj)= nimppt_crs(jn)
+           ENDDO
+         ENDDO 
+        
+         nlei_crs  = nleit_crs(nproc + 1) 
+         nlci_crs  = nlcit_crs(nproc + 1)
+         nldi_crs  = nldit_crs(nproc + 1)
+         nimpp_crs = nimppt_crs(nproc + 1)
+
+         DO ji = 1, jpi_crs
+            mig_crs(ji) = ji + nimpp_crs - 1
+         ENDDO
+         DO jj = 1, jpj_crs
+            mjg_crs(jj) = jj + njmpp_crs - 1!
+         ENDDO
+       
+         DO ji = 1, jpiglo_crs
+            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) )
+            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) )
+         ENDDO
+         
+         DO jj = 1, jpjglo_crs
+            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) )
+            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) )
+         ENDDO
+
+      ENDIF
+      
+      !                         Save the parent grid information
+      jpi_full    = jpi
+      jpj_full    = jpj
+      jpim1_full  = jpim1
+      jpjm1_full  = jpjm1
+      nperio_full = nperio
+
+      npolj_full  = npolj
+      jpiglo_full = jpiglo
+      jpjglo_full = jpjglo
+
+      nlcj_full   = nlcj
+      nlci_full   = nlci
+      nldi_full   = nldi
+      nldj_full   = nldj
+      nlei_full   = nlei
+      nlej_full   = nlej
+      nimpp_full  = nimpp     
+      njmpp_full  = njmpp
+      
+      nlcit_full(:)  = nlcit(:)
+      nldit_full(:)  = nldit(:)
+      nleit_full(:)  = nleit(:)
+      nimppt_full(:) = nimppt(:)
+      nlcjt_full(:)  = nlcjt(:)
+      nldjt_full(:)  = nldjt(:)
+      nlejt_full(:)  = nlejt(:)
+      njmppt_full(:) = njmppt(:)
+      
+      CALL dom_grid_crs  !swich de grille
+     
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init : coarse grid dimensions'
+         WRITE(numout,*) '~~~~~~~   coarse domain global j-dimension           jpjglo = ', jpjglo
+         WRITE(numout,*) '~~~~~~~   coarse domain global i-dimension           jpiglo = ', jpiglo
+         WRITE(numout,*) '~~~~~~~   coarse domain local  i-dimension              jpi = ', jpi
+         WRITE(numout,*) '~~~~~~~   coarse domain local  j-dimension              jpj = ', jpj
+         WRITE(numout,*)
+         WRITE(numout,*) ' nproc  = '     , nproc
+         WRITE(numout,*) ' nlci   = '     , nlci
+         WRITE(numout,*) ' nlcj   = '     , nlcj
+         WRITE(numout,*) ' nldi   = '     , nldi
+         WRITE(numout,*) ' nldj   = '     , nldj
+         WRITE(numout,*) ' nlei   = '     , nlei
+         WRITE(numout,*) ' nlej   = '     , nlej
+         WRITE(numout,*) ' nlei_full='    , nlei_full
+         WRITE(numout,*) ' nldi_full='    , nldi_full
+         WRITE(numout,*) ' nimpp  = '     , nimpp
+         WRITE(numout,*) ' njmpp  = '     , njmpp
+         WRITE(numout,*) ' njmpp_full  = ', njmpp_full
+         WRITE(numout,*)
+      ENDIF
+      
+      CALL dom_grid_glo
+      
+      mxbinctr   = INT( nn_factx * 0.5 )
+      mybinctr   = INT( nn_facty * 0.5 )
+
+      nrestx = MOD( nn_factx, 2 )   ! check if even- or odd- numbered reduction factor
+      nresty = MOD( nn_facty, 2 )
+
+      IF ( nrestx == 0 ) THEN
+         mxbinctr = mxbinctr - 1
+      ENDIF
+
+      IF ( nresty == 0 ) THEN
+         mybinctr = mybinctr - 1
+         IF ( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2
+         IF ( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2 
+
+         IF ( npolj == 3 ) npolj_crs = 5
+         IF ( npolj == 5 ) npolj_crs = 3
+      ENDIF     
+      
+      rfactxy = nn_factx * nn_facty
+      
+      ! 2.b. Set up bins for coarse grid, horizontal only.
+      ierr = crs_dom_alloc2()
+     
+      mis2_crs(:) = 0      ;      mie2_crs(:) = 0
+      mjs2_crs(:) = 0      ;      mje2_crs(:) = 0
+
+      
+      SELECT CASE ( nn_binref )
+
+      CASE ( 0 ) 
+
+         SELECT CASE ( nperio )
+     
+ 
+        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold
+        
+            DO ji = 2, jpiglo_crsm1
+               ijie = ( ji * nn_factx ) - nn_factx   !cc
+               ijis = ijie - nn_factx + 1
+               mis2_crs(ji) = ijis
+               mie2_crs(ji) = ijie
+            ENDDO
+            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1) = jpiglo - 2  
+
+            ! Handle first the northernmost bin
+            IF ( nn_facty == 2 ) THEN   ;    ijjgloT = jpjglo - 1 
+            ELSE                        ;    ijjgloT = jpjglo
+            ENDIF
+
+            DO jj = 2, jpjglo_crs
+                ijje = ijjgloT - nn_facty * ( jj - 3 )
+                ijjs = ijje - nn_facty + 1                   
+                mjs2_crs(jpjglo_crs-jj+2) = ijjs
+                mje2_crs(jpjglo_crs-jj+2) = ijje
+            ENDDO
+
+         CASE ( 2 ) 
+            WRITE(numout,*)  'crs_init, jperio=2 not supported' 
+        
+         CASE ( 5, 6 )    ! F-pivot at North Fold
+
+            DO ji = 2, jpiglo_crsm1
+               ijie = ( ji * nn_factx ) - nn_factx 
+               ijis = ijie - nn_factx + 1
+               mis2_crs(ji) = ijis
+               mie2_crs(ji) = ijie
+            ENDDO
+            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo - 2 
+
+            ! Treat the northernmost bin separately.
+            jj = 2
+            ijje = jpj - nn_facty * ( jj - 2 )
+            IF ( nn_facty == 3 ) THEN   ;  ijjs = ijje - 1 
+            ELSE                        ;  ijjs = ijje - nn_facty + 1
+            ENDIF
+            mjs2_crs(jpj_crs-jj+1) = ijjs
+            mje2_crs(jpj_crs-jj+1) = ijje
+
+            ! Now bin the rest, any remainder at the south is lumped in the southern bin
+            DO jj = 3, jpjglo_crsm1
+                ijje = jpjglo - nn_facty * ( jj - 2 )
+                ijjs = ijje - nn_facty + 1                  
+                IF ( ijjs <= nn_facty )  ijjs = 2
+                mjs2_crs(jpj_crs-jj+1)   = ijjs
+                mje2_crs(jpj_crs-jj+1)   = ijje
+            ENDDO
+
+         CASE DEFAULT
+            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported' 
+ 
+         END SELECT
+
+      CASE (1 )
+         WRITE(numout,*) 'crs_init.  Equator-centered bins option not yet available' 
+
+      END SELECT
+
+     ! Pad the boundaries, do not know if it is necessary
+      mis2_crs(2) = 1             ;  mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1   
+      mie2_crs(2) = nn_factx      ;  mie2_crs(jpiglo_crs) = jpiglo                         
+      !
+      mjs2_crs(1) = 1
+      mje2_crs(1) = 1
+      !
+      mje2_crs(2) = mjs2_crs(3)-1 ;  mje2_crs(jpjglo_crs) = jpjglo
+      mjs2_crs(2) = 1             ;  mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1 
+ 
+      IF( .NOT. lk_mpp ) THEN     
+        mis_crs(:) = mis2_crs(:) 
+        mie_crs(:) = mie2_crs(:)
+        mjs_crs(:) = mjs2_crs(:) 
+        mje_crs(:) = mje2_crs(:) 
+      ELSE
+        DO jj = 1, nlej_crs
+           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1
+           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1
+        ENDDO
+        DO ji = 1, nlei_crs
+           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1
+           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1
+        ENDDO
+      ENDIF
+      !
+      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1)
+      njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1)
+      !
+   END SUBROUTINE crs_dom_def
+   
+   SUBROUTINE crs_dom_bat
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_bat ***
+      !! ** Purpose :  coarsenig bathy
+      !!----------------------------------------------------------------
+      !! 
+      !!  local variables
+      INTEGER  :: ji,jj,jk      ! dummy indices
+      REAL(wp), DIMENSION(:,:)  , POINTER :: zmbk
+      !!----------------------------------------------------------------
+   
+      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
+   
+      mbathy_crs(:,:) = jpkm1
+      mbkt_crs(:,:) = 1
+      mbku_crs(:,:) = 1
+      mbkv_crs(:,:) = 1
+
+
+      DO jj = 1, jpj_crs
+         DO ji = 1, jpi_crs
+            jk = 0
+            DO WHILE( tmask_crs(ji,jj,jk+1) > 0.)
+               jk = jk + 1
+            ENDDO
+            mbathy_crs(ji,jj) = float( jk )
+         ENDDO
+      ENDDO
+     
+      zmbk(:,:) = 0.0
+      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) )
+
+
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    crsini : mbkt is ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt_crs(:,:) = MAX( mbathy_crs(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !                                     ! bottom k-index of W-level = mbkt+1
+
+      DO jj = 1, jpj_crsm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpi_crsm1
+            mbku_crs(ji,jj) = MIN(  mbkt_crs(ji+1,jj  ) , mbkt_crs(ji,jj)  )
+            mbkv_crs(ji,jj) = MIN(  mbkt_crs(ji  ,jj+1) , mbkt_crs(ji,jj)  )
+         END DO
+      END DO
+
+      ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
+      zmbk(:,:) = 1.e0;    
+      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
+      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
+      !
+      CALL wrk_dealloc( jpi_crs, jpj_crs, zmbk )
+      !
+   END SUBROUTINE crs_dom_bat
+
+
+END MODULE crsdom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 8732)
@@ -0,0 +1,358 @@
+MODULE crsdomwri
+   !!======================================================================
+   !! Coarse Ocean initialization : write the coarse ocean domain mesh and mask files
+   !!======================================================================
+   !! 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
+   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq_crs
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!                 ! 2012-06  (J. Simeon, C. Calone, C Ethe )  Reduced and modified for coarse grid
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   crs_dom_wri    : create and write mesh and mask file(s)
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE par_kind, ONLY: wp
+   USE lib_mpp         ! MPP library
+   USE iom_def
+   USE iom
+   USE crs         ! coarse grid domain
+   USE crsdom         ! coarse grid domain
+   USE crslbclnk       ! crs mediator to lbclnk
+   USE wrk_nemo        ! Working array
+
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC crs_dom_wri        ! routine called by crsini.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE crs_dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dom_wri  ***
+      !!
+      !! ** Purpose :   Create 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  :   Write in a file all the arrays generated in routines
+      !!      crsini for meshes and mask. In three separate files: 
+      !!      domain size, horizontal grid-point position,
+      !!      masks, depth and vertical scale factors
+      !!      
+      !! ** Output files :   mesh_hgr_crs.nc, mesh_zgr_crs.nc, mesh_mask.nc
+      !!----------------------------------------------------------------------
+      !!
+      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           ::   iif, iil, ijf, ijl
+      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
+      !                                   !  workspaces
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ze3tp, ze3wp
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_dom_wri')
+      !
+      CALL wrk_alloc( jpi_crs, jpj_crs,      zprt , zprw  )
+      CALL wrk_alloc( jpi_crs, jpj_crs,      ze3tp, ze3wp )
+      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv )
+
+      ze3tp(:,:) = 0.0
+      ze3wp(:,:) = 0.0
+
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam0 = 'mesh_mask_crs'  ! filename (mesh and mask informations)
+      clnam1 = 'mesh_crs'       ! filename (mesh informations)
+      clnam2 = 'mask_crs'       ! filename (mask informations)
+      clnam3 = 'mesh_hgr_crs'   ! filename (horizontal mesh informations)
+      clnam4 = 'mesh_zgr_crs'   ! filename (vertical   mesh informations)
+      
+
+      SELECT CASE ( MOD(nn_msh_crs, 3) )
+         !                                  ! ============================
+      CASE ( 1 )                            !  create 'mesh_mask.nc' file
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         inum2 = inum0                                            ! put all the informations
+         inum3 = inum0                                            ! in unit inum0
+         inum4 = inum0
+         
+         !                                  ! ============================
+      CASE ( 2 )                            !  create 'mesh.nc' and 
+         !                                  !         'mask.nc' files
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         inum3 = inum1                                            ! put mesh informations 
+         inum4 = inum1                                            ! in unit inum1 
+         !                                  ! ============================
+      CASE ( 0 )                            !  create 'mesh_hgr.nc'
+         !                                  !         'mesh_zgr.nc' and
+         !                                  !         'mask.nc'     files
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
+         !
+      END SELECT
+ 
+      !========================================================
+      !                                                         ! masks (inum2) 
+      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask_crs, ktype = jp_i1 )     !    ! land-sea mask
+      CALL iom_rstput( 0, 0, inum2, 'umask', umask_crs, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask_crs, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask_crs, ktype = jp_i1 )
+      
+      
+      tmask_i_crs(:,:) = tmask_crs(:,:,1)
+      iif = jpreci
+      iil = nlci_crs - jpreci + 1
+      ijf = jpreci
+      ijl = nlcj_crs - jprecj + 1
+     
+      tmask_i_crs( 1:iif ,    :  ) = 0._wp
+      tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp
+      tmask_i_crs(   :   , 1:ijf ) = 0._wp
+      tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp
+      
+      
+      tpol_crs(1:jpiglo_crs,:) = 1._wp
+      fpol_crs(1:jpiglo_crs,:) = 1._wp
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp
+         fpol_crs(       1      :jpiglo_crs,:) = 0._wp
+         IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN
+            DO ji = iif+1, iil-1
+               tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) &
+               & * tpol_crs(mig_crs(ji),1)
+            ENDDO
+         ENDIF
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         tpol_crs(      1       :jpiglo_crs,:)=0._wp
+         fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp
+      ENDIF
+      
+      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 )
+                                   !    ! unique point mask
+      CALL dom_uniq_crs( zprw, 'U' )
+      zprt = umask_crs(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq_crs( zprw, 'V' )
+      zprt = vmask_crs(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq_crs( zprw, 'F' )
+      zprt = fmask_crs(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )  
+      !========================================================
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt_crs, ktype = jp_r4 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf_crs, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit_crs, ktype = jp_r4 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif_crs, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t_crs, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f_crs, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t_crs, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f_crs, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'ff', ff_crs, ktype = jp_r8 )           !    ! coriolis factor
+
+      !========================================================
+      !                                                         ! vertical mesh (inum4) 
+!     ! note that mbkt is set to 1 over land ==> use surface tmask_crs
+      zprt(:,:) = tmask_crs(:,:,1) * REAL( mbkt_crs(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
+
+      IF( ln_zps ) THEN                       ! z-coordinate - partial steps
+
+            
+         IF ( nn_msh_crs <= 6 ) THEN
+            CALL iom_rstput( 0, 0, inum4, 'e3t', e3t_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w', e3w_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_crs )      
+         ELSE
+            DO jj = 1,jpj_crs   
+               DO ji = 1,jpi_crs
+                  ze3tp(ji,jj) = e3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+                  ze3wp(ji,jj) = e3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+               END DO
+            END DO
+
+            CALL crs_lbc_lnk( ze3tp,'T', 1.0 )
+            CALL crs_lbc_lnk( ze3wp,'W', 1.0 )
+  
+            CALL iom_rstput( 0, 0, inum4, 'e3t_ps', ze3tp )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w_ps', ze3wp )
+         ENDIF
+
+         IF ( nn_msh_crs <= 3 ) THEN
+            CALL iom_rstput( 0, 0, inum4, 'gdept', gdept_crs, ktype = jp_r4 ) 
+            DO jk = 1,jpk   
+               DO jj = 1, jpj_crsm1   
+                  DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk)
+                     zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk)
+                  END DO   
+               END DO   
+            END DO
+
+            CALL crs_lbc_lnk( zdepu,'U', 1. )   ;   CALL crs_lbc_lnk( zdepv,'V', 1. ) 
+            CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw_crs, ktype = jp_r4 )
+         ELSE
+            DO jj = 1,jpj_crs   
+               DO ji = 1,jpi_crs
+                  zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1)
+                  zprw(ji,jj) = gdepw_0(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_1d', gdept_1d )     !    ! reference z-coord.
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )
+         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
+
+         CALL iom_rstput(  0, 0, inum4, 'ocean_volume_t', ocean_volume_crs_t ) 
+         CALL iom_rstput(  0, 0, inum4, 'facvol_t' , facvol_t  ) 
+         CALL iom_rstput(  0, 0, inum4, 'facvol_w' , facvol_w  ) 
+         CALL iom_rstput(  0, 0, inum4, 'facsurfu' , facsurfu  ) 
+         CALL iom_rstput(  0, 0, inum4, 'facsurfv' , facsurfv  ) 
+         CALL iom_rstput(  0, 0, inum4, 'e1e2w_msk', e1e2w_msk ) 
+         CALL iom_rstput(  0, 0, inum4, 'e2e3u_msk', e2e3u_msk ) 
+         CALL iom_rstput(  0, 0, inum4, 'e1e3v_msk', e1e3v_msk )
+         CALL iom_rstput(  0, 0, inum4, 'e1e2w'    , e1e2w_crs ) 
+         CALL iom_rstput(  0, 0, inum4, 'e2e3u'    , e2e3u_crs ) 
+         CALL iom_rstput(  0, 0, inum4, 'e1e3v'    , e1e3v_crs )
+         CALL iom_rstput(  0, 0, inum4, 'bt'       , bt_crs    )
+         CALL iom_rstput(  0, 0, inum4, 'r1_bt'    , r1_bt_crs )
+
+         CALL iom_rstput(  0, 0, inum4, 'crs_surfu_wgt', crs_surfu_wgt ) 
+         CALL iom_rstput(  0, 0, inum4, 'crs_surfv_wgt', crs_surfv_wgt ) 
+         CALL iom_rstput(  0, 0, inum4, 'crs_volt_wgt' , crs_volt_wgt  ) 
+
+      ENDIF
+      
+     IF( ln_zco ) THEN
+         !                                                      ! z-coordinate - full steps
+        CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )     !    ! depth
+        CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
+        CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )     !    ! scale factors
+        CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
+     ENDIF
+      !                                     ! ============================
+      !                                     !        close the files 
+      !                                     ! ============================
+      SELECT CASE ( MOD(nn_msh_crs, 3) )
+      CASE ( 1 )                
+         CALL iom_close( inum0 )
+      CASE ( 2 )
+         CALL iom_close( inum1 )
+         CALL iom_close( inum2 )
+      CASE ( 0 )
+         CALL iom_close( inum2 )
+         CALL iom_close( inum3 )
+         CALL iom_close( inum4 )
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi_crs, jpj_crs,      zprt , zprw  )
+      CALL wrk_dealloc( jpi_crs, jpj_crs,      ze3tp, ze3wp )
+      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zdepu, zdepv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_wri')
+      !
+      
+   END SUBROUTINE crs_dom_wri
+
+
+   SUBROUTINE dom_uniq_crs( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dom_uniq_crs  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** Method  :   1) apply crs_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(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_dom_uniq_crs')
+      !
+      CALL wrk_alloc( jpi_crs, jpj_crs, ztstref )
+      !
+      ! 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_crs * jpj_crs * ( narea - 1 )
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) )
+      !
+      puniq(:,:) = ztstref(:,:)                   ! default definition
+      CALL crs_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_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp )
+      !
+      CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_uniq_crs')
+      !
+      
+   END SUBROUTINE dom_uniq_crs
+
+   !!======================================================================
+
+END MODULE crsdomwri
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 8732)
@@ -0,0 +1,246 @@
+MODULE crsfld
+   !!======================================================================
+   !!                     ***  MODULE  crsdfld  ***
+   !!  Ocean coarsening :  coarse ocean fields
+   !!=====================================================================
+   !!   2012-07  (J. Simeon, C. Calone, G. Madec, C. Ethe)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   crs_fld       : create the standard output files for coarse grid and prep
+   !!                       other variables needed to be passed to TOP
+   !!----------------------------------------------------------------------
+   USE crs
+   USE crsdom
+   USE crslbclnk
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE zdf_oce         ! vertical  physics: ocean fields
+   USE ldftra          ! ocean active tracers: lateral diffusivity & EIV coefficients
+   USE zdfddm          ! vertical  physics: double diffusion
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working array
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   crs_fld                 ! routines called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE crs_fld( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_fld  ***
+      !!                   
+      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!      1. Accumulate in time the dimensionally-weighted fields
+      !!      2. At time of output, rescale [1] by dimension and time
+      !!         to yield the spatial and temporal average.
+      !!  See. sbcmod.F90
+      !!
+      !! ** Method  :  
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      REAL(wp) ::   z2dcrsu, z2dcrsv  ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t, ze3u, ze3v, ze3w   ! 3D workspace for e3
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zt, zt_crs
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zs, zs_crs  
+      !!----------------------------------------------------------------------
+      ! 
+      IF( nn_timing == 1 )   CALL timing_start('crs_fld')
+
+      !  Initialize arrays
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3w )
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3u, ze3v )
+      CALL wrk_alloc( jpi,jpj,jpk,   zt  , zs   )
+      !
+      CALL wrk_alloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
+
+      ! Depth work arrrays
+      ze3t(:,:,:) = e3t_n(:,:,:)
+      ze3u(:,:,:) = e3u_n(:,:,:)
+      ze3v(:,:,:) = e3v_n(:,:,:)
+      ze3w(:,:,:) = e3w_n(:,:,:)
+
+      IF( kt == nit000  ) THEN
+         tsn_crs  (:,:,:,:) = 0._wp    ! temp/sal  array, now 
+         un_crs   (:,:,:  ) = 0._wp    ! u-velocity
+         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
+         wn_crs   (:,:,:  ) = 0._wp    ! w
+         avt_crs  (:,:,:  ) = 0._wp    ! avt
+         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
+         rke_crs  (:,:,:  ) = 0._wp    ! rke
+         sshn_crs (:,:    ) = 0._wp    ! ssh
+         utau_crs (:,:    ) = 0._wp    ! taux
+         vtau_crs (:,:    ) = 0._wp    ! tauy
+         wndm_crs (:,:    ) = 0._wp    ! wind speed
+         qsr_crs  (:,:    ) = 0._wp    ! qsr
+         emp_crs  (:,:    ) = 0._wp    ! emp
+         emp_b_crs(:,:    ) = 0._wp    ! emp
+         rnf_crs  (:,:    ) = 0._wp    ! runoff
+         fr_i_crs (:,:    ) = 0._wp    ! ice cover
+      ENDIF
+
+      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
+
+      ! 2. Coarsen fields at each time step
+      ! --------------------------------------------------------
+
+      !  Temperature
+      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
+      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
+
+      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
+      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
+
+      
+      !  Salinity
+      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
+      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
+
+      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
+      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
+
+      !  U-velocity
+      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      !
+      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   
+               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
+               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
+            END DO
+         END DO
+      END DO
+      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )
+
+      CALL iom_put( "uoce"  , un_crs )   ! i-current 
+      CALL iom_put( "uocet" , zt_crs )   ! uT
+      CALL iom_put( "uoces" , zs_crs )   ! uS
+
+      !  V-velocity
+      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      !                                                                                 
+      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   
+               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
+               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
+            END DO
+         END DO
+      END DO
+      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )
+ 
+      CALL iom_put( "voce"  , vn_crs )   ! i-current 
+      CALL iom_put( "vocet" , zt_crs )   ! vT
+      CALL iom_put( "voces" , zs_crs )   ! vS
+
+     
+      !  Kinetic energy
+      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )
+      CALL iom_put( "eken", rke_crs )
+
+      !  Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 
+      DO jk = 1, jpkm1
+         DO ji = 2, jpi_crsm1
+            DO jj = 2, jpj_crsm1
+               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
+                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
+                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
+                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
+                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
+                   !
+                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )
+      !
+      CALL iom_put( "hdiv", hdivn_crs )  
+
+
+      !  W-velocity
+      IF( ln_crs_wn ) THEN
+         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )
+       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )
+      ELSE
+        wn_crs(:,:,jpk) = 0._wp
+        DO jk = jpkm1, 1, -1
+           wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
+        ENDDO
+      ENDIF
+      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
+      !  free memory
+
+      !  avt, avs
+!!gm BUG   TOP always uses avs !!!
+      SELECT CASE ( nn_crs_kz )
+         CASE ( 0 )
+            CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+         CASE ( 1 )
+            CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+         CASE ( 2 )
+            CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )
+      END SELECT
+      !
+      CALL iom_put( "avt", avt_crs )   !  Kz
+      
+      !  sbc fields  
+      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t           , psgn=1.0 )  
+      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 )
+      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 )
+      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 )
+      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )
+
+      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output 
+      CALL iom_put( "utau"     , utau_crs )   ! i-tau output 
+      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output 
+      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output 
+      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output 
+      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output 
+      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output 
+      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output 
+      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output 
+
+      !  free memory
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3w )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3u, ze3v )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zt  , zs   )
+      CALL wrk_dealloc( jpi_crs,jpj_crs,jpk,   zt_crs, zs_crs )
+      !
+      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('crs_fld')
+      !
+   END SUBROUTINE crs_fld
+
+   !!======================================================================
+END MODULE crsfld
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 8732)
@@ -0,0 +1,255 @@
+MODULE crsini   
+   !!======================================================================
+   !!                         ***  MODULE crsini  ***
+   !!            Manage the grid coarsening module initialization
+   !!======================================================================
+   !!  History     2012-05   (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  crs_init    : 
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY: wp
+   USE par_oce                  ! For parameter jpi,jpj
+   USE dom_oce                  ! For parameters in par_oce
+   USE crs                      ! Coarse grid domain
+   USE phycst, ONLY: omega, rad ! physical constants
+   USE crsdom
+   USE crsdomwri
+   USE crslbclnk
+   !
+   USE iom
+   USE in_out_manager
+   USE lib_mpp
+   USE wrk_nemo 
+   USE timing                   ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   crs_init   ! called by nemogcm.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE crs_init 
+      !!-------------------------------------------------------------------
+      !!                     *** SUBROUTINE crs_init
+      !!  ** Purpose : Initialization of the grid coarsening module  
+      !!               1. Read namelist
+      !!               X2. MOVE TO crs_dom.F90 Set the domain definitions for coarse grid
+      !!                 a. Define the coarse grid starting/ending indices on parent grid
+      !!                    Here is where the T-pivot or F-pivot grids are discerned
+      !!                 b. TODO.  Include option for north-centric or equator-centric binning.
+      !!                 (centered only for odd reduction factors; even reduction bins bias equator to the south)
+      !!               3. Mask and mesh creation. => calls to crsfun
+      !!                  a. Use crsfun_mask to generate tmask,umask, vmask, fmask.
+      !!                  b. Use crsfun_coordinates to get coordinates
+      !!                  c. Use crsfun_UV to get horizontal scale factors
+      !!                  d. Use crsfun_TW to get initial vertical scale factors   
+      !!               4. Volumes and weights jes.... TODO. Updates for vvl? Where to do this? crsstp.F90?
+      !!                  a. Calculate initial coarse grid box volumes: pvol_T, pvol_W
+      !!                  b. Calculate initial coarse grid surface-averaging weights
+      !!                  c. Calculate initial coarse grid volume-averaging weights
+      !!                  
+      !!               X5. MOVE TO crs_dom_wri.F90 Using iom_rstput output the initial meshmask.
+      !!               ?. Another set of "masks" to generate
+      !!                  are the u- and v- surface areas for U- and V- area-weighted means.
+      !!                  Need to put this somewhere in section 3?
+      !! jes. What do to about the vvl?  GM.  could separate the weighting (denominator), so
+      !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output.
+      !! As is, crsfun takes into account vvl.   
+      !!      Talked about pre-setting the surface array to avoid IF/ENDIF and division.
+      !!      But have then to make that preset array here and elsewhere.
+      !!      that is called every timestep...
+      !! 
+      !!               - Read in pertinent data ?
+      !!-------------------------------------------------------------------
+      INTEGER  :: ji,jj,jk      ! dummy indices
+      INTEGER  :: ierr                                ! allocation error status
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t, ze3u, ze3v, ze3w
+
+      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init : Initializing the grid coarsening module '
+      ENDIF
+
+     !---------------------------------------------------------
+     ! 1. Read Namelist file
+     !---------------------------------------------------------
+     !
+
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namcrs, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcrs in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcrs in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namcrs )
+
+     IF(lwp) THEN
+        WRITE(numout,*)
+        WRITE(numout,*) 'crs_init: Namelist namcrs '
+        WRITE(numout,*) '   coarsening factor in i-direction      nn_factx   = ', nn_factx
+        WRITE(numout,*) '   coarsening factor in j-direction      nn_facty   = ', nn_facty
+        WRITE(numout,*) '   bin centering preference              nn_binref  = ', nn_binref
+        WRITE(numout,*) '   create (=1) a mesh file or not (=0)   nn_msh_crs = ', nn_msh_crs
+        WRITE(numout,*) '   type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz
+        WRITE(numout,*) '   wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn
+     ENDIF
+              
+     rfactx_r = 1. / nn_factx
+     rfacty_r = 1. / nn_facty
+
+     !---------------------------------------------------------
+     ! 2. Define Global Dimensions of the coarsened grid
+     !---------------------------------------------------------
+     CALL crs_dom_def      
+
+     !---------------------------------------------------------
+     ! 3. Mask and Mesh
+     !---------------------------------------------------------
+
+     !     Set up the masks and meshes     
+
+     !  3.a. Get the masks   
+ 
+     CALL crs_dom_msk
+
+
+     !  3.b. Get the coordinates
+     !      Odd-numbered reduction factor, center coordinate on T-cell
+     !      Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner.
+     !      
+     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
+        CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
+        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
+        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
+     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
+        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
+        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ELSE 
+        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ENDIF
+
+
+     !  3.c. Get the horizontal mesh
+
+     !      3.c.1 Horizontal scale factors
+
+     CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
+     CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
+     CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
+     CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
+
+     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
+     
+     
+     !      3.c.2 Coriolis factor  
+
+!!gm  Not sure CRS needs Coriolis parameter....
+!!gm  If needed, then update this to have Coriolis at both f- and t-points
+
+      ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
+
+      CALL ctl_warn( 'crsini: CAUTION, CRS only designed for Coriolis defined on the sphere' ) 
+ 
+
+     !    3.d.1 mbathy ( vertical k-levels of bathymetry )     
+
+     CALL crs_dom_bat
+     
+     !
+     CALL wrk_alloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w )
+     !
+     ze3t(:,:,:) = e3t_n(:,:,:)
+     ze3u(:,:,:) = e3u_n(:,:,:)
+     ze3v(:,:,:) = e3v_n(:,:,:)
+     ze3w(:,:,:) = e3w_n(:,:,:)
+
+     !    3.d.2   Surfaces 
+     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t  )
+     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u )
+     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v )
+   
+     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
+     facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:)
+
+     !    3.d.3   Vertical scale factors
+     !
+     CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
+     CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
+     CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
+     CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
+
+     ! Replace 0 by e3t_0 or e3w_0
+     DO jk = 1, jpk
+        DO ji = 1, jpi_crs
+           DO jj = 1, jpj_crs
+              IF( e3t_crs(ji,jj,jk) == 0._wp ) e3t_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3w_crs(ji,jj,jk) == 0._wp ) e3w_crs(ji,jj,jk) = e3w_1d(jk)
+              IF( e3u_crs(ji,jj,jk) == 0._wp ) e3u_crs(ji,jj,jk) = e3t_1d(jk)
+              IF( e3v_crs(ji,jj,jk) == 0._wp ) e3v_crs(ji,jj,jk) = e3t_1d(jk)
+           ENDDO
+        ENDDO
+     ENDDO
+
+     !    3.d.3   Vertical depth (meters)
+     CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 ) 
+     CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 )
+
+
+     !---------------------------------------------------------
+     ! 4.  Coarse grid ocean volume and averaging weights
+     !---------------------------------------------------------
+     ! 4.a. Ocean volume or area unmasked and masked
+     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t )
+     !
+     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
+     !
+     r1_bt_crs(:,:,:) = 0._wp 
+     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
+
+     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w )
+     !
+     !---------------------------------------------------------
+     ! 5.  Write out coarse meshmask  (see OPA_SRC/DOM/domwri.F90 for ideas later)
+     !---------------------------------------------------------
+
+     IF( nn_msh_crs > 0 ) THEN 
+        CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+        CALL crs_dom_wri     
+        CALL dom_grid_glo   ! Return to parent grid domain
+     ENDIF
+     
+      !---------------------------------------------------------
+      ! 7. Finish and clean-up
+      !---------------------------------------------------------
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t, ze3u, ze3v, ze3w )
+      !
+   END SUBROUTINE crs_init
+    
+   !!======================================================================
+END MODULE crsini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 8732)
@@ -0,0 +1,132 @@
+MODULE crslbclnk
+   !!======================================================================
+   !!                       ***  MODULE  crslbclnk  ***
+   !!               A temporary solution for lbclnk for coarsened grid.
+   !! Ocean        : lateral boundary conditions for grid coarsening
+   !!=====================================================================
+   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY: wp
+   USE dom_oce
+   USE crs
+   !
+   USE lbclnk
+   USE in_out_manager
+   
+   INTERFACE crs_lbc_lnk
+      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
+   END INTERFACE
+   
+   PUBLIC crs_lbc_lnk
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE crs_lbc_lnk_3d( pt3d1, cd_type1, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions for coarsened grid
+      !!
+      !! ** Method  :   Swap domain indices from full to coarse domain
+      !!                before arguments are passed directly to lbc_lnk.
+      !!                Upon exiting, switch back to full domain indices.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1 ! grid type
+      REAL(wp)                                , INTENT(in   ) ::   psgn     ! control of the sign
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1    ! 3D array on which the lbc is applied
+      REAL(wp)                      , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)              , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
+      !
+      LOGICAL  ::   ll_grid_crs
+      REAL(wp) ::   zval   ! valeur sur les halo
+      !!----------------------------------------------------------------------
+      !
+      ll_grid_crs = ( jpi == jpi_crs )
+      !
+      IF( PRESENT(pval) ) THEN  ;  zval = pval
+      ELSE                      ;  zval = 0._wp
+      ENDIF
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      !
+      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
+      ENDIF
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+      !
+   END SUBROUTINE crs_lbc_lnk_3d
+   
+   
+   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions for coarsened grid
+      !!
+      !! ** Method  :   Swap domain indices from full to coarse domain
+      !!                before arguments are passed directly to lbc_lnk.
+      !!                Upon exiting, switch back to full domain indices.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type
+      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied
+      !
+      LOGICAL ::   ll_grid_crs
+      !!----------------------------------------------------------------------
+      !
+      ll_grid_crs = ( jpi == jpi_crs )
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      !
+      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+      !
+   END SUBROUTINE crs_lbc_lnk_3d_gather
+
+   
+   
+   SUBROUTINE crs_lbc_lnk_2d(pt2d, cd_type, psgn, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions for coarsened grid
+      !!
+      !! ** Method  :   Swap domain indices from full to coarse domain
+      !!                before arguments are passed directly to lbc_lnk.
+      !!                Upon exiting, switch back to full domain indices.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type
+      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied
+      REAL(wp)                  , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)          , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
+      !      
+      LOGICAL  ::   ll_grid_crs
+      REAL(wp) ::   zval     ! valeur sur les halo
+      !!----------------------------------------------------------------------
+      !
+      ll_grid_crs = ( jpi == jpi_crs )
+      !
+      IF( PRESENT(pval) ) THEN  ;  zval = pval
+      ELSE                      ;  zval = 0._wp
+      ENDIF
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+      !
+      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
+      ENDIF
+      !
+      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+      !
+   END SUBROUTINE crs_lbc_lnk_2d
+
+   !!======================================================================
+END MODULE crslbclnk
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90	(revision 8732)
@@ -0,0 +1,326 @@
+MODULE dia25h 
+   !!======================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents 
+   !!======================================================================
+   !! History :  3.6  !  2014  (E O'Dea)  Original code
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+#if defined key_zdftke 
+   USE zdf_oce, ONLY: en
+#endif
+   USE zdf_oce, ONLY: avt, avm
+#if defined key_zdfgls
+   USE zdf_oce, ONLY: en
+   USE zdfgls, ONLY: mxln
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL , PUBLIC ::   ln_dia25h     !:  25h mean output
+   PUBLIC   dia_25h_init               ! routine called by nemogcm.F90
+   PUBLIC   dia_25h                    ! routine called by diawri.F90
+
+  !! * variables for calculating 25-hourly means
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h 
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h
+#if defined key_zdfgls || key_zdftke
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h
+#endif
+#if defined key_zdfgls 
+   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h
+#endif
+   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means
+
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
+   !! $Id:$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_25h_init 
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_25h_init  ***
+      !!     
+      !! ** Purpose: Initialization of 25h mean namelist 
+      !!        
+      !! ** Method : Read namelist
+      !!   History
+      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_25h
+      !!---------------------------------------------------------------------------
+      !!
+      INTEGER ::   ios                 ! Local integer output status for namelist read
+      INTEGER ::   ierror              ! Local integer for memory allocation
+      !
+      NAMELIST/nam_dia25h/ ln_dia25h
+      !!----------------------------------------------------------------------
+      !
+      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics
+      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics
+      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_dia25h )
+
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Namelist nam_dia25h : set 25h outputs '
+         WRITE(numout,*) 'Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h
+      ENDIF
+      IF( .NOT. ln_dia25h )   RETURN
+      ! ------------------- !
+      ! 1 - Allocate memory !
+      ! ------------------- !
+      ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate un_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' )   ;   RETURN
+      ENDIF
+      ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' )   ;   RETURN
+      ENDIF
+# if defined key_zdfgls || defined key_zdftke
+      ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN
+      ENDIF
+#endif
+# if defined key_zdfgls 
+      ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN
+      ENDIF
+#endif
+      ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN
+      ENDIF
+      ! ------------------------- !
+      ! 2 - Assign Initial Values !
+      ! ------------------------- !
+      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 
+      tn_25h(:,:,:) = tsb(:,:,:,jp_tem)
+      sn_25h(:,:,:) = tsb(:,:,:,jp_sal)
+      sshn_25h(:,:) = sshb(:,:)
+      un_25h(:,:,:) = ub(:,:,:)
+      vn_25h(:,:,:) = vb(:,:,:)
+      wn_25h(:,:,:) = wn(:,:,:)
+      avt_25h(:,:,:) = avt(:,:,:)
+      avm_25h(:,:,:) = avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+         en_25h(:,:,:) = en(:,:,:)
+#endif
+# if defined key_zdfgls
+         rmxln_25h(:,:,:) = mxln(:,:,:)
+#endif
+#if defined key_lim3 || defined key_lim2
+         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
+#endif 
+
+      ! -------------------------- !
+      ! 3 - Return to dia_wri      !
+      ! -------------------------- !
+
+
+   END SUBROUTINE dia_25h_init
+
+
+   SUBROUTINE dia_25h( kt )  
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_25h  ***
+      !!         
+      !!
+      !!--------------------------------------------------------------------
+      !!                   
+      !! ** Purpose :   Write diagnostics with M2/S2 tide removed
+      !!
+      !! ** Method  :   
+      !!      25hr mean outputs for shelf seas
+      !!
+      !! History :
+      !!   ?.0  !  07-04  (A. Hines) New routine, developed from dia_wri_foam
+      !!   3.4  !  02-13  (J. Siddorn) Routine taken from old dia_wri_foam
+      !!   3.6  !  08-14  (E. O'Dea) adapted for VN3.6
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk
+
+      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
+      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zmdi       ! temporary reals
+      INTEGER                          ::   i_steps                               ! no of timesteps per hour
+      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                    ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
+      INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day
+
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialisation
+      ! -----------------
+      ! Define frequency of summing to create 25 h mean
+      IF( MOD( 3600,INT(rdt) ) == 0 ) THEN
+         i_steps = 3600/INT(rdt)
+      ELSE
+         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
+      ENDIF
+
+#if defined key_lim3 || defined key_lim2
+      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')
+#endif
+
+      ! local variable for debugging
+      ll_print = ll_print .AND. lwp
+
+      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours
+      ! every day
+      IF( MOD( kt, i_steps ) == 0  .and. kt .ne. nn_it000 ) THEN
+
+         IF (lwp) THEN
+              WRITE(numout,*) 'dia_wri_tide : Summing instantaneous hourly diagnostics at timestep ',kt
+              WRITE(numout,*) '~~~~~~~~~~~~ '
+         ENDIF
+
+         tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem)
+         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal)
+         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:)
+         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:)
+         vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:)
+         wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:)
+         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:)
+         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+         en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:)
+#endif
+# if defined key_zdfgls
+         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:)
+#endif
+         cnt_25h = cnt_25h + 1
+
+         IF (lwp) THEN
+            WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h
+         ENDIF
+
+      ENDIF ! MOD( kt, i_steps ) == 0
+
+         ! Write data for 25 hour mean output streams
+      IF( cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
+
+            IF(lwp) THEN
+               WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
+               WRITE(numout,*) '~~~~~~~~~~~~ '
+            ENDIF
+
+            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp
+            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp
+            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp
+            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp
+            vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp
+            wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp
+            avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp
+            avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp
+# if defined key_zdfgls || defined key_zdftke
+            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp
+#endif
+# if defined key_zdfgls
+            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp
+#endif
+
+            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
+            zmdi=1.e+20 !missing data indicator for masking
+            ! write tracers (instantaneous)
+            zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("temper25h", zw3d)   ! potential temperature
+            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put( "salin25h", zw3d  )   ! salinity
+            zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
+            CALL iom_put( "ssh25h", zw2d )   ! sea surface 
+
+
+            ! Write velocities (instantaneous)
+            zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))
+            CALL iom_put("vozocrtx25h", zw3d)    ! i-current
+            zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:))
+            CALL iom_put("vomecrty25h", zw3d  )   ! j-current
+
+            zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("vomecrtz25h", zw3d )   ! k-current
+            zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("avt25h", zw3d )   ! diffusivity
+            zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("avm25h", zw3d)   ! viscosity
+#if defined key_zdftke || defined key_zdfgls 
+            zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put("tke25h", zw3d)   ! tke
+#endif
+#if defined key_zdfgls 
+            zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
+            CALL iom_put( "mxln25h",zw3d)
+#endif
+
+            ! After the write reset the values to cnt=1 and sum values equal current value 
+            tn_25h(:,:,:) = tsn(:,:,:,jp_tem)
+            sn_25h(:,:,:) = tsn(:,:,:,jp_sal)
+            sshn_25h(:,:) = sshn (:,:)
+            un_25h(:,:,:) = un(:,:,:)
+            vn_25h(:,:,:) = vn(:,:,:)
+            wn_25h(:,:,:) = wn(:,:,:)
+            avt_25h(:,:,:) = avt(:,:,:)
+            avm_25h(:,:,:) = avm(:,:,:)
+# if defined key_zdfgls || defined key_zdftke
+            en_25h(:,:,:) = en(:,:,:)
+#endif
+# if defined key_zdfgls
+            rmxln_25h(:,:,:) = mxln(:,:,:)
+#endif
+            cnt_25h = 1
+            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h
+
+      ENDIF !  cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000
+
+
+   END SUBROUTINE dia_25h 
+
+   !!======================================================================
+END MODULE dia25h
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 8732)
@@ -0,0 +1,384 @@
+MODULE diaar5
+   !!======================================================================
+   !!                       ***  MODULE  diaar5  ***
+   !! AR5 diagnostics
+   !!======================================================================
+   !! History :  3.2  !  2009-11  (S. Masson)  Original code
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
+   !!----------------------------------------------------------------------
+   !!   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 lib_mpp        ! distribued memory computing library
+   USE iom            ! I/O manager library
+   USE timing         ! preformance summary
+   USE wrk_nemo       ! working arrays
+   USE fldread        ! type FLD_N
+   USE phycst         ! physical constant
+   USE in_out_manager  ! I/O manager
+   USE zdfddm
+   USE zdf_oce
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_ar5        ! routine called in step.F90 module
+   PUBLIC   dia_ar5_alloc  ! routine called in nemogcm.F90 module
+   PUBLIC   dia_ar5_hst    ! heat/salt transport
+
+   REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
+   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity
+
+   LOGICAL  :: l_ar5
+      
+   !! * Substitutions
+#  include "zdfddm_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
+
+   FUNCTION dia_ar5_alloc()
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ar5_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: dia_ar5_alloc
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( dia_ar5_alloc )
+      IF( dia_ar5_alloc /= 0 )   CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays')
+      !
+   END FUNCTION dia_ar5_alloc
+
+
+   SUBROUTINE dia_ar5( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ar5  ***
+      !!
+      !! ** Purpose :   compute and output some AR5 diagnostics
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
+      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass
+      REAL(wp) ::   zaw, zbw, zrw
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace 
+      REAL(wp), POINTER, DIMENSION(:,:)     :: zpe                         ! 2D workspace 
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace
+      !!--------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_ar5')
+ 
+      IF( kt == nit000 )     CALL dia_ar5_init
+
+      IF( l_ar5 ) THEN
+         CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres )
+         CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    )
+         CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
+         zarea_ssh(:,:) = area(:,:) * sshn(:,:)
+      ENDIF
+      !
+      IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' )  .OR. iom_use( 'sshdyn' )  ) THEN    
+         !                                         ! total volume of liquid seawater
+         zvolssh = SUM( zarea_ssh(:,:) ) 
+         IF( lk_mpp )   CALL mpp_sum( zvolssh )
+         zvol = vol0 + zvolssh
+      
+         CALL iom_put( 'voltot', zvol               )
+         CALL iom_put( 'sshtot', zvolssh / area_tot )
+         CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) )
+         !
+      ENDIF
+
+      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN    
+         !                     
+         ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh
+         ztsn(:,:,:,jp_sal) = sn0(:,:,:)
+         CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity
+         !
+         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
+         DO jk = 1, jpkm1
+            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk)
+         END DO
+         IF( ln_linssh ) THEN
+            IF( ln_isfcav ) THEN
+               DO ji = 1, jpi
+                  DO jj = 1, jpj
+                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+                  END DO
+               END DO
+            ELSE
+               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+            END IF
+!!gm
+!!gm   riceload should be added in both ln_linssh=T or F, no?
+!!gm
+         END IF
+         !                                         
+         zarho = SUM( area(:,:) * zbotpres(:,:) ) 
+         IF( lk_mpp )   CALL mpp_sum( zarho )
+         zssh_steric = - zarho / area_tot
+         CALL iom_put( 'sshthster', zssh_steric )
+      
+         !                                         ! steric sea surface height
+         CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density
+         zrhop(:,:,jpk) = 0._wp
+         CALL iom_put( 'rhop', zrhop )
+         !
+         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
+         DO jk = 1, jpkm1
+            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk)
+         END DO
+         IF( ln_linssh ) THEN
+            IF ( ln_isfcav ) THEN
+               DO ji = 1,jpi
+                  DO jj = 1,jpj
+                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+                  END DO
+               END DO
+            ELSE
+               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+            END IF
+         END IF
+         !    
+         zarho = SUM( area(:,:) * zbotpres(:,:) ) 
+         IF( lk_mpp )   CALL mpp_sum( zarho )
+         zssh_steric = - zarho / area_tot
+         CALL iom_put( 'sshsteric', zssh_steric )
+      
+         !                                         ! ocean bottom pressure
+         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 )
+         !
+      ENDIF
+
+      IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' )  .OR. iom_use( 'saltot' )  ) THEN    
+         !                                         ! Mean density anomalie, temperature and salinity
+         ztemp = 0._wp
+         zsal  = 0._wp
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zztmp = area(ji,jj) * e3t_n(ji,jj,jk)
+                  ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem)
+                  zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN
+            IF( ln_isfcav ) THEN
+               DO ji = 1, jpi
+                  DO jj = 1, jpj
+                     ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 
+                     zsal  = zsal  + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 
+                  END DO
+               END DO
+            ELSE
+               ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
+               zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
+            END IF
+         ENDIF
+         IF( lk_mpp ) THEN  
+            CALL mpp_sum( ztemp )
+            CALL mpp_sum( zsal  )
+         END IF
+         !
+         zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater
+         ztemp = ztemp / zvol                            ! potential temperature in liquid seawater
+         zsal  = zsal  / zvol                            ! Salinity of liquid seawater
+         !
+         CALL iom_put( 'masstot', zmass )
+         CALL iom_put( 'temptot', ztemp )
+         CALL iom_put( 'saltot' , zsal  )
+         !
+      ENDIF
+
+      IF( iom_use( 'tnpeo' )) THEN    
+      ! Work done against stratification by vertical mixing
+      ! Exclude points where rn2 is negative as convection kicks in here and
+      ! work is not being done against stratification
+         CALL wrk_alloc( jpi, jpj, zpe )
+         zpe(:,:) = 0._wp
+         IF( lk_zdfddm ) THEN
+            DO jk = 2, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( rn2(ji,jj,jk) > 0._wp ) THEN
+                        zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                           &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )
+                        !
+                        zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
+                        zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
+                        !
+                        zpe(ji, jj) = zpe(ji, jj)            &
+                           &        -  grav * (    avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  &
+                           &                   - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )
+                     ENDIF
+                  END DO
+               END DO
+             END DO
+          ELSE
+            DO jk = 1, jpk
+               DO ji = 1, jpi
+                  DO jj = 1, jpj
+                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         CALL lbc_lnk( zpe, 'T', 1._wp)         
+         CALL iom_put( 'tnpeo', zpe )
+         CALL wrk_dealloc( jpi, jpj, zpe )
+      ENDIF
+      !
+      IF( l_ar5 ) THEN
+        CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres )
+        CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    )
+        CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5')
+      !
+   END SUBROUTINE dia_ar5
+
+   SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva ) 
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ar5_htr ***
+      !!----------------------------------------------------------------------
+      !! Wrapper for heat transport calculations
+      !! Called from all advection and/or diffusion routines
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in )  :: ktra  ! tracer index
+      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pua   ! 3D input array of advection/diffusion
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion
+      !
+      INTEGER    ::  ji, jj, jk
+      REAL(wp), POINTER, DIMENSION(:,:)  :: z2d
+
+    
+
+      CALL wrk_alloc( jpi, jpj, z2d )
+      z2d(:,:) = pua(:,:,1) 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk) 
+            END DO
+         END DO
+       END DO
+       CALL lbc_lnk( z2d, 'U', -1. )
+       IF( cptr == 'adv' ) THEN
+          IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in i-direction
+          IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0     * z2d )  ! advective salt transport in i-direction
+       ENDIF
+       IF( cptr == 'ldf' ) THEN
+          IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction
+          IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0     * z2d ) ! diffusive salt transport in i-direction
+       ENDIF
+       !
+       z2d(:,:) = pva(:,:,1) 
+       DO jk = 1, jpkm1
+          DO jj = 2, jpjm1
+             DO ji = fs_2, fs_jpim1   ! vector opt.
+                z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk) 
+             END DO
+          END DO
+       END DO
+       CALL lbc_lnk( z2d, 'V', -1. )
+       IF( cptr == 'adv' ) THEN
+          IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in j-direction
+          IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0     * z2d )  ! advective salt transport in j-direction
+       ENDIF
+       IF( cptr == 'ldf' ) THEN
+          IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction
+          IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0     * z2d ) ! diffusive salt transport in j-direction
+       ENDIF
+          
+       CALL wrk_dealloc( jpi, jpj, z2d )
+
+   END SUBROUTINE dia_ar5_hst
+
+
+   SUBROUTINE dia_ar5_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ar5_init  ***
+      !!                   
+      !! ** Purpose :   initialization for AR5 diagnostic computation
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inum
+      INTEGER  ::   ik
+      INTEGER  ::   ji, jj, jk  ! dummy loop indices
+      REAL(wp) ::   zztmp  
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity
+      !
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dia_ar5_init')
+      !
+      l_ar5 = .FALSE.
+      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  & 
+         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &    
+         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE.
+  
+      IF( l_ar5 ) THEN
+         !
+         CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )
+         !                                      ! allocate dia_ar5 arrays
+         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' )
+
+         area(:,:) = e1e2t(:,:) * tmask_i(:,:)
+
+         area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )
+
+         vol0        = 0._wp
+         thick0(:,:) = 0._wp
+         DO jk = 1, jpkm1
+            vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) )
+            thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk)
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( vol0 )
+
+         CALL iom_open ( 'sali_ref_clim_monthly', inum )
+         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  )
+         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 )
+         CALL iom_close( inum )
+
+         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 = mbkt(ji,jj)
+                  IF( ik > 1 ) THEN
+                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5_init')
+      !
+   END SUBROUTINE dia_ar5_init
+
+   !!======================================================================
+END MODULE diaar5
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90	(revision 8732)
@@ -0,0 +1,206 @@
+MODULE diacfl
+   !!==============================================================================
+   !!                       ***  MODULE  diacfl  ***
+   !! Output CFL diagnostics to ascii file
+   !!==============================================================================
+   !! History :  1.0  !  2010-03  (E. Blockley)  Original code
+   !!                 !  2014-06  (T Graham) Removed CPP key & Updated to vn3.6
+   !! 
+   !!----------------------------------------------------------------------
+   !!   dia_cfl        : Compute and output Courant numbers at each timestep
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE domvvl     
+   USE timing          ! Performance output
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp) :: cu_max, cv_max, cw_max                      ! Run max U Courant number 
+   INTEGER, DIMENSION(3) :: cu_loc, cv_loc, cw_loc         ! Run max locations
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcu_cfl           ! Courant number arrays
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcv_cfl           ! Courant number arrays
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcw_cfl           ! Courant number arrays
+
+   INTEGER  :: numcfl                                       ! outfile unit
+   CHARACTER(LEN=50) :: clname="cfl_diagnostics.ascii"      ! ascii filename
+
+   PUBLIC   dia_cfl       ! routine called by step.F90
+   PUBLIC   dia_cfl_init  ! routine called by nemogcm
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+
+CONTAINS
+
+
+   SUBROUTINE dia_cfl ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_cfl  ***
+      !!
+      !! ** Purpose :  Compute the Courant numbers Cu=u*dt/dx and Cv=v*dt/dy
+      !!               and output to ascii file 'cfl_diagnostics.ascii'
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) ::  kt                            ! ocean time-step index
+
+      REAL(wp) :: zcu_max, zcv_max, zcw_max                 ! max Courant numbers per timestep
+      INTEGER, DIMENSION(3) :: zcu_loc, zcv_loc, zcw_loc    ! max Courant number locations
+
+      REAL(wp) :: dt                                        ! temporary scalars
+      INTEGER, DIMENSION(3) :: zlocu, zlocv, zlocw          ! temporary arrays 
+      INTEGER  :: ji, jj, jk                                ! dummy loop indices
+
+      
+      IF( nn_diacfl == 1) THEN
+         IF( nn_timing == 1 )   CALL timing_start('dia_cfl')
+         ! setup timestep multiplier to account for initial Eulerian timestep
+         IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    dt = rdt
+         ELSE                                        ;    dt = rdt * 2.0
+         ENDIF
+
+             ! calculate Courant numbers
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, fs_jpim1   ! vector opt.
+
+                  ! Courant number for x-direction (zonal current)
+                  zcu_cfl(ji,jj,jk) = ABS(un(ji,jj,jk))*dt/e1u(ji,jj)
+
+                  ! Courant number for y-direction (meridional current)
+                  zcv_cfl(ji,jj,jk) = ABS(vn(ji,jj,jk))*dt/e2v(ji,jj)
+
+                  ! Courant number for z-direction (vertical current)
+                  zcw_cfl(ji,jj,jk) = ABS(wn(ji,jj,jk))*dt/e3w_n(ji,jj,jk)
+               END DO
+            END DO         
+         END DO
+
+         ! calculate maximum values and locations
+         IF( lk_mpp ) THEN
+            CALL mpp_maxloc(zcu_cfl,umask,zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3))
+            CALL mpp_maxloc(zcv_cfl,vmask,zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3))
+            CALL mpp_maxloc(zcw_cfl,tmask,zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3))
+         ELSE
+            zlocu = MAXLOC( ABS( zcu_cfl(:,:,:) ) )
+            zcu_loc(1) = zlocu(1) + nimpp - 1
+            zcu_loc(2) = zlocu(2) + njmpp - 1
+            zcu_loc(3) = zlocu(3)
+            zcu_max = zcu_cfl(zcu_loc(1),zcu_loc(2),zcu_loc(3))
+
+            zlocv = MAXLOC( ABS( zcv_cfl(:,:,:) ) )
+            zcv_loc(1) = zlocv(1) + nimpp - 1
+            zcv_loc(2) = zlocv(2) + njmpp - 1
+            zcv_loc(3) = zlocv(3)
+            zcv_max = zcv_cfl(zcv_loc(1),zcv_loc(2),zcv_loc(3))
+
+            zlocw = MAXLOC( ABS( zcw_cfl(:,:,:) ) )
+            zcw_loc(1) = zlocw(1) + nimpp - 1
+            zcw_loc(2) = zlocw(2) + njmpp - 1
+            zcw_loc(3) = zlocw(3)
+            zcw_max = zcw_cfl(zcw_loc(1),zcw_loc(2),zcw_loc(3))
+         ENDIF
+      
+         ! write out to file
+         IF( lwp ) THEN
+            WRITE(numcfl,FMT='(2x,i4,5x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zcu_max, zcu_loc(1), zcu_loc(2), zcu_loc(3)
+            WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zcv_max, zcv_loc(1), zcv_loc(2), zcv_loc(3)
+            WRITE(numcfl,FMT='(11x,a6,5x,f6.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zcw_max, zcw_loc(1), zcw_loc(2), zcw_loc(3)
+         ENDIF
+
+         ! update maximum Courant numbers from whole run if applicable
+         IF( zcu_max > cu_max ) THEN
+            cu_max = zcu_max
+            cu_loc = zcu_loc
+         ENDIF
+         IF( zcv_max > cv_max ) THEN
+            cv_max = zcv_max
+            cv_loc = zcv_loc
+         ENDIF
+         IF( zcw_max > cw_max ) THEN
+            cw_max = zcw_max
+            cw_loc = zcw_loc
+         ENDIF
+
+         ! at end of run output max Cu and Cv and close ascii file
+         IF( kt == nitend .AND. lwp ) THEN
+            ! to ascii file
+            WRITE(numcfl,*) '******************************************'
+            WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', cu_max, cu_loc(1), cu_loc(2), cu_loc(3)
+            WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max)
+            WRITE(numcfl,*) '******************************************'
+            WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', cv_max, cv_loc(1), cv_loc(2), cv_loc(3)
+            WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max)
+            WRITE(numcfl,*) '******************************************'
+            WRITE(numcfl,FMT='(3x,a12,7x,f6.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', cw_max, cw_loc(1), cw_loc(2), cw_loc(3)
+            WRITE(numcfl,FMT='(3x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max)
+            CLOSE( numcfl ) 
+
+            ! to ocean output
+            WRITE(numout,*)
+            WRITE(numout,*) 'dia_cfl     : Maximum Courant number information for the run:'
+            WRITE(numout,*) '~~~~~~~~~~~~'
+            WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, 'at (i, j, k) = (', cu_loc(1), cu_loc(2), cu_loc(3), ')'
+            WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max)
+            WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, 'at (i, j, k) = (', cv_loc(1), cv_loc(2), cv_loc(3), ')'
+            WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max)
+            WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, 'at (i, j, k) = (', cw_loc(1), cw_loc(2), cw_loc(3), ')'
+            WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max)
+
+         ENDIF
+
+         IF( nn_timing == 1 )   CALL timing_stop('dia_cfl')
+      ENDIF
+
+   END SUBROUTINE dia_cfl
+
+   SUBROUTINE dia_cfl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_cfl_init  ***
+      !!                   
+      !! ** Purpose :   create output file, initialise arrays
+      !!----------------------------------------------------------------------
+
+
+      IF( nn_diacfl == 1 ) THEN
+         IF( nn_timing == 1 )   CALL timing_start('dia_cfl_init')
+
+         cu_max=0.0
+         cv_max=0.0
+         cw_max=0.0
+
+         ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) )
+
+         zcu_cfl(:,:,:)=0.0
+         zcv_cfl(:,:,:)=0.0
+         zcw_cfl(:,:,:)=0.0
+
+         IF( lwp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dia_cfl     : Outputting CFL diagnostics to '//TRIM(clname)
+            WRITE(numout,*) '~~~~~~~~~~~~'
+            WRITE(numout,*)
+
+            ! create output ascii file
+            CALL ctl_opn( numcfl, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+            WRITE(numcfl,*) 'Timestep  Direction  Max C     i    j    k'
+            WRITE(numcfl,*) '******************************************'
+         ENDIF
+
+         IF( nn_timing == 1 )   CALL timing_stop('dia_cfl_init')
+
+      ENDIF
+
+   END SUBROUTINE dia_cfl_init
+
+END MODULE diacfl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 8732)
@@ -0,0 +1,1295 @@
+MODULE diadct
+   !!======================================================================
+   !!                       ***  MODULE  diadct  ***
+   !! Ocean diagnostics: Compute the transport trough a sec.
+   !!======================================================================
+   !! History :  OPA  ! 02/1999 (Y Drillet)  original code
+   !!                 ! 10/2001 (Y Drillet, R Bourdalle Badie)
+   !!   NEMO     1.0  ! 10/2005 (M Laborie) F90
+   !!            3.0  ! 04/2007 (G Garric) Ice sections
+   !!             -   ! 04/2007 (C Bricaud) test on sec%nb_point, initialisation of ztransp1,ztransp2,...
+   !!            3.4  ! 09/2011 (C Bricaud)
+   !!----------------------------------------------------------------------
+#if defined key_diadct
+   !!----------------------------------------------------------------------
+   !!   'key_diadct' :
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   dia_dct      :  Compute the transport through a sec.
+   !!   dia_dct_init :  Read namelist.
+   !!   readsec      :  Read sections description and pathway
+   !!   removepoints :  Remove points which are common to 2 procs
+   !!   transport    :  Compute transport for each sections
+   !!   dia_dct_wri  :  Write tranports results in ascii files
+   !!   interp       :  Compute temperature/salinity/density at U-point or V-point
+   !!   
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE dianam          ! build name of file
+   USE lib_mpp         ! distributed memory computing library
+#if defined key_lim2
+   USE ice_2
+#endif
+#if defined key_lim3
+   USE ice
+#endif
+   USE domvvl
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_dct      ! routine called by step.F90
+   PUBLIC   dia_dct_init ! routine called by opa.F90
+   PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90 
+   PRIVATE  readsec
+   PRIVATE  removepoints
+   PRIVATE  transport
+   PRIVATE  dia_dct_wri
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag
+
+   INTEGER :: nn_dct        ! Frequency of computation
+   INTEGER :: nn_dctwri     ! Frequency of output
+   INTEGER :: nn_secdebug   ! Number of the section to debug
+   
+   INTEGER, PARAMETER :: nb_class_max  = 10
+   INTEGER, PARAMETER :: nb_sec_max    = 150
+   INTEGER, PARAMETER :: nb_point_max  = 2000
+   INTEGER, PARAMETER :: nb_type_class = 10
+   INTEGER, PARAMETER :: nb_3d_vars    = 3 
+   INTEGER, PARAMETER :: nb_2d_vars    = 2 
+   INTEGER            :: nb_sec 
+
+   TYPE POINT_SECTION
+      INTEGER :: I,J
+   END TYPE POINT_SECTION
+
+   TYPE COORD_SECTION
+      REAL(wp) :: lon,lat
+   END TYPE COORD_SECTION
+
+   TYPE SECTION
+      CHARACTER(len=60)                            :: name              ! name of the sec
+      LOGICAL                                      :: llstrpond         ! true if you want the computation of salt and
+                                                                       ! heat transports
+      LOGICAL                                      :: ll_ice_section    ! ice surface and ice volume computation
+      LOGICAL                                      :: ll_date_line      ! = T if the section crosses the date-line
+      TYPE(COORD_SECTION), DIMENSION(2)            :: coordSec          ! longitude and latitude of the extremities of the sec
+      INTEGER                                      :: nb_class          ! number of boundaries for density classes
+      INTEGER, DIMENSION(nb_point_max)             :: direction         ! vector direction of the point in the section
+      CHARACTER(len=40),DIMENSION(nb_class_max)    :: classname         ! characteristics of the class
+      REAL(wp), DIMENSION(nb_class_max)            :: zsigi           ,&! in-situ   density classes    (99 if you don't want)
+                                                      zsigp           ,&! potential density classes    (99 if you don't want)
+                                                      zsal            ,&! salinity classes   (99 if you don't want)
+                                                      ztem            ,&! temperature classes(99 if you don't want)
+                                                      zlay              ! level classes      (99 if you don't want)
+      REAL(wp), DIMENSION(nb_type_class,nb_class_max)  :: transport     ! transport output
+      REAL(wp)                                         :: slopeSection  ! slope of the section
+      INTEGER                                          :: nb_point      ! number of points in the section
+      TYPE(POINT_SECTION),DIMENSION(nb_point_max)      :: listPoint     ! list of points in the sections
+   END TYPE SECTION
+
+   TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
+ 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  transports_3d 
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d  
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+  INTEGER FUNCTION diadct_alloc() 
+     !!---------------------------------------------------------------------- 
+     !!                   ***  FUNCTION diadct_alloc  *** 
+     !!---------------------------------------------------------------------- 
+     INTEGER :: ierr(2) 
+     !!---------------------------------------------------------------------- 
+
+     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 
+     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(2) ) 
+
+     diadct_alloc = MAXVAL( ierr ) 
+     IF( diadct_alloc /= 0 )   CALL ctl_warn('diadct_alloc: failed to allocate arrays') 
+ 
+  END FUNCTION diadct_alloc 
+
+
+  SUBROUTINE dia_dct_init
+     !!---------------------------------------------------------------------
+     !!               ***  ROUTINE diadct  ***  
+     !!
+     !!  ** Purpose: Read the namelist parameters
+     !!              Open output files
+     !!
+     !!---------------------------------------------------------------------
+     NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug
+     INTEGER  ::   ios                 ! Local integer output status for namelist read
+
+     IF( nn_timing == 1 )   CALL timing_start('dia_dct_init')
+
+     REWIND( numnam_ref )              ! Namelist namdct in reference namelist : Diagnostic: transport through sections
+     READ  ( numnam_ref, namdct, IOSTAT = ios, ERR = 901)
+901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist', lwp )
+
+     REWIND( numnam_cfg )              ! Namelist namdct in configuration namelist : Diagnostic: transport through sections
+     READ  ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 )
+902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp )
+     IF(lwm) WRITE ( numond, namdct )
+
+     IF( lwp ) THEN
+        WRITE(numout,*) " "
+        WRITE(numout,*) "diadct_init: compute transports through sections "
+        WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
+        WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct
+        WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri
+
+        IF      ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN
+                                            WRITE(numout,*)"       Debug section number: ", nn_secdebug 
+        ELSE IF ( nn_secdebug ==  0 )THEN ; WRITE(numout,*)"       No section to debug"
+        ELSE IF ( nn_secdebug == -1 )THEN ; WRITE(numout,*)"       Debug all sections"
+        ELSE                              ; WRITE(numout,*)"       Wrong value for nn_secdebug : ",nn_secdebug
+        ENDIF
+
+        IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0)  &
+          &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' )
+
+     ENDIF
+
+     !Read section_ijglobal.diadct
+     CALL readsec
+
+     !open output file
+     IF( lwm ) THEN
+        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+     ENDIF
+
+     ! Initialise arrays to zero 
+     transports_3d(:,:,:,:)=0.0 
+     transports_2d(:,:,:)  =0.0 
+
+     IF( nn_timing == 1 )   CALL timing_stop('dia_dct_init')
+     !
+  END SUBROUTINE dia_dct_init
+ 
+ 
+  SUBROUTINE dia_dct(kt)
+     !!---------------------------------------------------------------------
+     !!               ***  ROUTINE diadct  ***  
+     !!
+     !!  Purpose :: Compute section transports and write it in numdct files 
+     !!   
+     !!  Method  :: All arrays initialised to zero in dct_init 
+     !!             Each nn_dct time step call subroutine 'transports' for 
+     !!               each section to sum the transports over each grid cell. 
+     !!             Each nn_dctwri time step: 
+     !!               Divide the arrays by the number of summations to gain 
+     !!               an average value 
+     !!               Call dia_dct_sum to sum relevant grid boxes to obtain 
+     !!               totals for each class (density, depth, temp or sal) 
+     !!               Call dia_dct_wri to write the transports into file 
+     !!               Reinitialise all relevant arrays to zero 
+     !!---------------------------------------------------------------------
+     INTEGER,INTENT(in)        ::kt
+     !
+     INTEGER             :: jsec,            &! loop on sections
+                            itotal            ! nb_sec_max*nb_type_class*nb_class_max
+     LOGICAL             :: lldebug =.FALSE.  ! debug a section  
+     
+     INTEGER , DIMENSION(1)             :: ish   ! tmp array for mpp_sum
+     INTEGER , DIMENSION(3)             :: ish2  !   "
+     REAL(wp), POINTER, DIMENSION(:)    :: zwork !   "  
+     REAL(wp), POINTER, DIMENSION(:,:,:):: zsum  !   "
+     !!---------------------------------------------------------------------    
+     !
+     IF( nn_timing == 1 )   CALL timing_start('dia_dct')
+
+     IF( lk_mpp )THEN
+        itotal = nb_sec_max*nb_type_class*nb_class_max
+        CALL wrk_alloc( itotal                                , zwork ) 
+        CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum  )
+     ENDIF    
+ 
+     ! Initialise arrays
+     zwork(:) = 0.0 
+     zsum(:,:,:) = 0.0
+
+     IF( lwp .AND. kt==nit000+nn_dct-1 ) THEN
+         WRITE(numout,*) " "
+         WRITE(numout,*) "diadct: compute transport"
+         WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~~~~~"
+         WRITE(numout,*) "nb_sec = ",nb_sec
+     ENDIF
+
+ 
+     ! Compute transport and write only at nn_dctwri
+     IF( MOD(kt,nn_dct)==0 ) THEN 
+
+        DO jsec=1,nb_sec
+
+           !debug this section computing ?
+           lldebug=.FALSE.
+           IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND.  kt==nit000+nn_dct-1 ) lldebug=.TRUE. 
+
+           !Compute transport through section  
+           CALL transport(secs(jsec),lldebug,jsec) 
+
+        ENDDO
+             
+        IF( MOD(kt,nn_dctwri)==0 )THEN
+
+           IF( kt==nit000+nn_dctwri-1 )WRITE(numout,*)"      diadct: average transports and write at kt = ",kt         
+  
+           !! divide arrays by nn_dctwri/nn_dct to obtain average 
+           transports_3d(:,:,:,:)=transports_3d(:,:,:,:)/(nn_dctwri/nn_dct) 
+           transports_2d(:,:,:)  =transports_2d(:,:,:)  /(nn_dctwri/nn_dct) 
+ 
+           ! Sum over each class 
+           DO jsec=1,nb_sec 
+              CALL dia_dct_sum(secs(jsec),jsec) 
+           ENDDO 
+
+           !Sum on all procs 
+           IF( lk_mpp )THEN
+              ish(1)  =  nb_sec_max*nb_type_class*nb_class_max 
+              ish2    = (/nb_sec_max,nb_type_class,nb_class_max/)
+              DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport(:,:) ; ENDDO
+              zwork(:)= RESHAPE(zsum(:,:,:), ish )
+              CALL mpp_sum(zwork, ish(1))
+              zsum(:,:,:)= RESHAPE(zwork,ish2)
+              DO jsec=1,nb_sec ; secs(jsec)%transport(:,:) = zsum(jsec,:,:) ; ENDDO
+           ENDIF
+
+           !Write the transport
+           DO jsec=1,nb_sec
+
+              IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec))
+            
+              !nullify transports values after writing
+              transports_3d(:,jsec,:,:)=0.
+              transports_2d(:,jsec,:  )=0.
+              secs(jsec)%transport(:,:)=0.  
+
+           ENDDO
+
+        ENDIF 
+
+     ENDIF
+
+     IF( lk_mpp )THEN
+        itotal = nb_sec_max*nb_type_class*nb_class_max
+        CALL wrk_dealloc( itotal                                , zwork ) 
+        CALL wrk_dealloc( nb_sec_max,nb_type_class,nb_class_max , zsum  )
+     ENDIF    
+
+     IF( nn_timing == 1 )   CALL timing_stop('dia_dct')
+     !
+  END SUBROUTINE dia_dct
+
+  SUBROUTINE readsec 
+     !!---------------------------------------------------------------------
+     !!               ***  ROUTINE readsec  ***
+     !!
+     !!  ** Purpose:
+     !!            Read a binary file(section_ijglobal.diadct) 
+     !!            generated by the tools "NEMOGCM/TOOLS/SECTIONS_DIADCT"
+     !!
+     !!
+     !!---------------------------------------------------------------------
+     !! * Local variables
+     INTEGER :: iptglo , iptloc                               ! Global and local number of points for a section
+     INTEGER :: isec, iiglo, ijglo, iiloc, ijloc,iost,i1 ,i2  ! temporary  integer
+     INTEGER :: jsec, jpt                                     ! dummy loop indices
+
+     INTEGER, DIMENSION(2) :: icoord 
+     CHARACTER(len=160)    :: clname                          !filename
+     CHARACTER(len=200)    :: cltmp
+     CHARACTER(len=200)    :: clformat                        !automatic format
+     TYPE(POINT_SECTION),DIMENSION(nb_point_max)  ::coordtemp !contains listpoints coordinates 
+                                                              !read in the file
+     INTEGER, POINTER, DIMENSION(:) :: directemp              !contains listpoints directions
+                                                              !read in the files
+     LOGICAL :: llbon                                       ,&!local logical
+                lldebug                                       !debug the section
+     !!-------------------------------------------------------------------------------------
+     CALL wrk_alloc( nb_point_max, directemp )
+
+     !open input file
+     !---------------
+     CALL ctl_opn( numdct_in, 'section_ijglobal.diadct', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+ 
+     !---------------
+     !Read input file
+     !---------------
+     
+     DO jsec=1,nb_sec_max      !loop on the nb_sec sections
+
+        IF (  jsec==nn_secdebug .OR. nn_secdebug==-1  ) &
+           & WRITE(numout,*)'debuging for section number: ',jsec 
+
+        !initialization
+        !---------------
+        secs(jsec)%name=''
+        secs(jsec)%llstrpond    = .FALSE.  ; secs(jsec)%ll_ice_section = .FALSE.
+        secs(jsec)%ll_date_line = .FALSE.  ; secs(jsec)%nb_class       = 0
+        secs(jsec)%zsigi        = 99._wp   ; secs(jsec)%zsigp          = 99._wp
+        secs(jsec)%zsal         = 99._wp   ; secs(jsec)%ztem           = 99._wp
+        secs(jsec)%zlay         = 99._wp         
+        secs(jsec)%transport    =  0._wp   ; secs(jsec)%nb_point       = 0
+
+        !read section's number / name / computing choices / classes / slopeSection / points number
+        !-----------------------------------------------------------------------------------------
+        READ(numdct_in,iostat=iost)isec
+        IF (iost .NE. 0 )EXIT !end of file 
+        WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec
+        IF( jsec .NE. isec )  CALL ctl_stop( cltmp )
+
+        IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )WRITE(numout,*)"isec ",isec 
+
+        READ(numdct_in)secs(jsec)%name
+        READ(numdct_in)secs(jsec)%llstrpond
+        READ(numdct_in)secs(jsec)%ll_ice_section
+        READ(numdct_in)secs(jsec)%ll_date_line
+        READ(numdct_in)secs(jsec)%coordSec
+        READ(numdct_in)secs(jsec)%nb_class
+        READ(numdct_in)secs(jsec)%zsigi
+        READ(numdct_in)secs(jsec)%zsigp
+        READ(numdct_in)secs(jsec)%zsal
+        READ(numdct_in)secs(jsec)%ztem
+        READ(numdct_in)secs(jsec)%zlay
+        READ(numdct_in)secs(jsec)%slopeSection
+        READ(numdct_in)iptglo
+
+        !debug
+        !-----
+
+        IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN
+          
+            WRITE(clformat,'(a,i2,a)') '(A40,', nb_class_max,'(f8.3,1X))' 
+
+            WRITE(numout,*)       "   Section name :                       ",TRIM(secs(jsec)%name)
+            WRITE(numout,*)       "      Compute heat and salt transport ? ",secs(jsec)%llstrpond
+            WRITE(numout,*)       "      Compute ice transport ?           ",secs(jsec)%ll_ice_section
+            WRITE(numout,*)       "      Section crosses date-line ?       ",secs(jsec)%ll_date_line
+            WRITE(numout,*)       "      Slope section :                   ",secs(jsec)%slopeSection
+            WRITE(numout,*)       "      Number of points in the section:  ",iptglo
+            WRITE(numout,*)       "      Number of classes                 ",secs(jsec)%nb_class
+            WRITE(numout,clformat)"      Insitu density classes :          ",secs(jsec)%zsigi
+            WRITE(numout,clformat)"      Potential density classes :       ",secs(jsec)%zsigp
+            WRITE(numout,clformat)"      Salinity classes :                ",secs(jsec)%zsal
+            WRITE(numout,clformat)"      Temperature classes :             ",secs(jsec)%ztem
+            WRITE(numout,clformat)"      Depth classes :                   ",secs(jsec)%zlay
+        ENDIF               
+
+        IF( iptglo /= 0 )THEN
+             
+           !read points'coordinates and directions 
+           !--------------------------------------
+           coordtemp(:) = POINT_SECTION(0,0) !list of points read
+           directemp(:) = 0                  !value of directions of each points
+           DO jpt=1,iptglo
+              READ(numdct_in) i1, i2
+              coordtemp(jpt)%I = i1 
+              coordtemp(jpt)%J = i2
+           ENDDO
+           READ(numdct_in) directemp(1:iptglo)
+    
+           !debug
+           !-----
+           IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN
+              WRITE(numout,*)"      List of points in global domain:"
+              DO jpt=1,iptglo
+                 WRITE(numout,*)'        # I J ',jpt,coordtemp(jpt),directemp(jpt)
+              ENDDO                  
+           ENDIF
+ 
+           !Now each proc selects only points that are in its domain:
+           !--------------------------------------------------------
+           iptloc = 0                    ! initialize number of points selected
+           DO jpt = 1, iptglo            ! loop on listpoint read in the file
+              !      
+              iiglo=coordtemp(jpt)%I          ! global coordinates of the point
+              ijglo=coordtemp(jpt)%J          !  " 
+
+              IF( iiglo==jpiglo .AND. nimpp==1 )   iiglo = 2         !!gm BUG: Hard coded periodicity !
+
+              iiloc=iiglo-nimpp+1   ! local coordinates of the point
+              ijloc=ijglo-njmpp+1   !  "
+
+              !verify if the point is on the local domain:(1,nlei)*(1,nlej)
+              IF( iiloc >= 1 .AND. iiloc <= nlei .AND. &
+                  ijloc >= 1 .AND. ijloc <= nlej       )THEN
+                 iptloc = iptloc + 1                                                 ! count local points
+                 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates
+                 secs(jsec)%direction(iptloc) = directemp(jpt)                       ! store local direction
+              ENDIF
+              !
+           END DO
+     
+           secs(jsec)%nb_point=iptloc !store number of section's points
+
+           !debug
+           !-----
+           IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN
+              WRITE(numout,*)"      List of points selected by the proc:"
+              DO jpt = 1,iptloc
+                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1
+                 WRITE(numout,*)'         # I J : ',iiglo,ijglo
+              ENDDO
+           ENDIF
+
+              IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN
+              DO jpt = 1,iptloc
+                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1
+              ENDDO
+              ENDIF
+
+           !remove redundant points between processors
+           !------------------------------------------
+           lldebug = .FALSE. ; IF ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) lldebug = .TRUE.
+           IF( iptloc .NE. 0 )THEN
+              CALL removepoints(secs(jsec),'I','top_list',lldebug)
+              CALL removepoints(secs(jsec),'I','bot_list',lldebug)
+              CALL removepoints(secs(jsec),'J','top_list',lldebug)
+              CALL removepoints(secs(jsec),'J','bot_list',lldebug)
+           ENDIF
+           IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN
+              DO jpt = 1,secs(jsec)%nb_point
+                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1
+              ENDDO
+           ENDIF
+
+           !debug
+           !-----
+           IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN
+              WRITE(numout,*)"      List of points after removepoints:"
+              iptloc = secs(jsec)%nb_point
+              DO jpt = 1,iptloc
+                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1
+                 WRITE(numout,*)'         # I J : ',iiglo,ijglo
+                 CALL FLUSH(numout)
+              ENDDO
+           ENDIF
+
+        ELSE  ! iptglo = 0
+           IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )&
+              WRITE(numout,*)'   No points for this section.'
+        ENDIF
+
+     ENDDO !end of the loop on jsec
+ 
+     nb_sec = jsec-1   !number of section read in the file
+
+     CALL wrk_dealloc( nb_point_max, directemp )
+     !
+  END SUBROUTINE readsec
+
+  SUBROUTINE removepoints(sec,cdind,cdextr,ld_debug)
+     !!---------------------------------------------------------------------------
+     !!             *** function removepoints
+     !!
+     !!   ** Purpose :: Remove points which are common to 2 procs
+     !!
+     !----------------------------------------------------------------------------
+     !! * arguments
+     TYPE(SECTION),INTENT(INOUT) :: sec
+     CHARACTER(len=1),INTENT(IN) :: cdind   ! = 'I'/'J'
+     CHARACTER(len=8),INTENT(IN) :: cdextr  ! = 'top_list'/'bot_list'
+     LOGICAL,INTENT(IN)          :: ld_debug                     
+
+     !! * Local variables
+     INTEGER :: iextr         ,& !extremity of listpoint that we verify
+                iind          ,& !coord     of listpoint that we verify
+                itest         ,& !indice value of the side of the domain 
+                                 !where points could be redundant
+                isgn          ,& ! isgn= 1 : scan listpoint from start to end
+                                 ! isgn=-1 : scan listpoint from end to start 
+                istart,iend      !first and last points selected in listpoint
+     INTEGER :: jpoint           !loop on list points
+     INTEGER, POINTER, DIMENSION(:)   :: idirec !contains temporary sec%direction
+     INTEGER, POINTER, DIMENSION(:,:) :: icoord !contains temporary sec%listpoint
+     !----------------------------------------------------------------------------
+     CALL wrk_alloc(    nb_point_max, idirec )
+     CALL wrk_alloc( 2, nb_point_max, icoord )
+
+     IF( ld_debug )WRITE(numout,*)'      -------------------------'
+     IF( ld_debug )WRITE(numout,*)'      removepoints in listpoint'
+
+     !iextr=extremity of list_point that we verify
+     IF      ( cdextr=='bot_list' )THEN ; iextr=1            ; isgn=1
+     ELSE IF ( cdextr=='top_list' )THEN ; iextr=sec%nb_point ; isgn=-1
+     ELSE    ; CALL ctl_stop("removepoints :Wrong value for cdextr")
+     ENDIF
+ 
+     !which coordinate shall we verify ?
+     IF      ( cdind=='I' )THEN   ; itest=nlei ; iind=1
+     ELSE IF ( cdind=='J' )THEN   ; itest=nlej ; iind=2
+     ELSE    ; CALL ctl_stop("removepoints :Wrong value for cdind") 
+     ENDIF
+
+     IF( ld_debug )THEN
+        WRITE(numout,*)'      case: coord/list extr/domain side'
+        WRITE(numout,*)'      ', cdind,' ',cdextr,' ',itest
+        WRITE(numout,*)'      Actual number of points: ',sec%nb_point
+     ENDIF
+
+     icoord(1,1:nb_point_max) = sec%listPoint%I
+     icoord(2,1:nb_point_max) = sec%listPoint%J
+     idirec                   = sec%direction
+     sec%listPoint            = POINT_SECTION(0,0)
+     sec%direction            = 0
+
+     jpoint=iextr+isgn
+     DO WHILE( jpoint .GE. 1 .AND. jpoint .LE. sec%nb_point )
+         IF( icoord( iind,jpoint-isgn ) == itest .AND. icoord( iind,jpoint ) == itest )THEN ; jpoint=jpoint+isgn
+         ELSE                                                                               ; EXIT
+         ENDIF
+     ENDDO 
+
+     IF( cdextr=='bot_list')THEN ; istart=jpoint-1 ; iend=sec%nb_point
+     ELSE                        ; istart=1        ; iend=jpoint+1
+     ENDIF
+
+     sec%listPoint(1:1+iend-istart)%I = icoord(1,istart:iend)
+     sec%listPoint(1:1+iend-istart)%J = icoord(2,istart:iend)
+     sec%direction(1:1+iend-istart)   = idirec(istart:iend)
+     sec%nb_point                     = iend-istart+1
+     
+     IF( ld_debug )THEN
+        WRITE(numout,*)'      Number of points after removepoints :',sec%nb_point
+        WRITE(numout,*)'      sec%direction after removepoints :',sec%direction(1:sec%nb_point)
+     ENDIF
+
+     CALL wrk_dealloc(    nb_point_max, idirec )
+     CALL wrk_dealloc( 2, nb_point_max, icoord )
+  END SUBROUTINE removepoints
+
+  SUBROUTINE transport(sec,ld_debug,jsec)
+     !!-------------------------------------------------------------------------------------------
+     !!                     ***  ROUTINE transport  ***
+     !!
+     !!  Purpose ::  Compute the transport for each point in a section 
+     !! 
+     !!  Method  ::  Loop over each segment, and each vertical level and add the transport 
+     !!              Be aware :           
+     !!              One section is a sum of segments 
+     !!              One segment is defined by 2 consecutive points in sec%listPoint 
+     !!              All points of sec%listPoint are positioned on the F-point of the cell 
+     !! 
+     !!              There are two loops:                  
+     !!              loop on the segment between 2 nodes 
+     !!              loop on the level jk !!
+     !! 
+     !!  Output  ::  Arrays containing the volume,density,heat,salt transports for each i
+     !!              point in a section, summed over each nn_dct. 
+     !!
+     !!-------------------------------------------------------------------------------------------
+     !! * Arguments
+     TYPE(SECTION),INTENT(INOUT) :: sec
+     LOGICAL      ,INTENT(IN)    :: ld_debug
+     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section
+    
+     !! * Local variables
+     INTEGER             :: jk, jseg, jclass,jl,                 &!loop on level/segment/classes/ice categories
+                            isgnu, isgnv                          ! 
+     REAL(wp)            :: zumid, zvmid,                        &!U/V velocity on a cell segment 
+                            zumid_ice, zvmid_ice,                &!U/V ice velocity 
+                            zTnorm                                !transport of velocity through one cell's sides 
+     REAL(wp)            :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point
+
+     TYPE(POINT_SECTION) :: k
+      !!--------------------------------------------------------
+      !
+      IF( ld_debug )WRITE(numout,*)'      Compute transport'
+
+      !---------------------------!
+      !  COMPUTE TRANSPORT        !
+      !---------------------------!
+      IF(sec%nb_point .NE. 0)THEN   
+
+         !----------------------------------------------------------------------------------------------------
+         !Compute sign for velocities:
+         !
+         !convention:
+         !   non horizontal section: direction + is toward left hand of section
+         !       horizontal section: direction + is toward north of section
+         !
+         !
+         !       slopeSection < 0     slopeSection > 0       slopeSection=inf            slopeSection=0
+         !       ----------------      -----------------     ---------------             --------------
+         !
+         !   isgnv=1         direction +      
+         !  ______         _____             ______                                                   
+         !        |           //|            |                  |                         direction +   
+         !        | isgnu=1  // |            |isgnu=1           |isgnu=1                     /|\
+         !        |_______  //         ______|    \\            | ---\                        |
+         !               |             | isgnv=-1  \\ |         | ---/ direction +       ____________
+         !               |             |          __\\|         |                    
+         !               |             |     direction +        |                      isgnv=1                                 
+         !                                                      
+         !----------------------------------------------------------------------------------------------------
+         isgnu = 1
+         IF( sec%slopeSection .GT. 0 ) THEN  ; isgnv = -1 
+         ELSE                                ; isgnv =  1
+         ENDIF
+         IF( sec%slopeSection .GE. 9999. )     isgnv =  1
+
+         IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv
+
+         !--------------------------------------!
+         ! LOOP ON THE SEGMENT BETWEEN 2 NODES  !
+         !--------------------------------------!
+         DO jseg=1,MAX(sec%nb_point-1,0)
+              
+            !-------------------------------------------------------------------------------------------
+            ! Select the appropriate coordinate for computing the velocity of the segment
+            !
+            !                      CASE(0)                                    Case (2)
+            !                      -------                                    --------
+            !  listPoint(jseg)                 listPoint(jseg+1)       listPoint(jseg)  F(i,j)      
+            !      F(i,j)----------V(i+1,j)-------F(i+1,j)                               |
+            !                                                                            |
+            !                                                                            |
+            !                                                                            |
+            !                      Case (3)                                            U(i,j)
+            !                      --------                                              |
+            !                                                                            |
+            !  listPoint(jseg+1) F(i,j+1)                                                |
+            !                        |                                                   |
+            !                        |                                                   |
+            !                        |                                 listPoint(jseg+1) F(i,j-1)
+            !                        |                                            
+            !                        |                                            
+            !                     U(i,j+1)                                            
+            !                        |                                       Case(1)     
+            !                        |                                       ------      
+            !                        |                                            
+            !                        |                 listPoint(jseg+1)             listPoint(jseg)                           
+            !                        |                 F(i-1,j)-----------V(i,j) -------f(jseg)                           
+            ! listPoint(jseg)     F(i,j)
+            ! 
+            !-------------------------------------------------------------------------------------------
+
+            SELECT CASE( sec%direction(jseg) )
+            CASE(0)   ;    k = sec%listPoint(jseg)
+            CASE(1)   ;    k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
+            CASE(2)   ;    k = sec%listPoint(jseg)
+            CASE(3)   ;    k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
+            END SELECT
+
+            !---------------------------| 
+            !     LOOP ON THE LEVEL     | 
+            !---------------------------| 
+            DO jk = 1, mbkt(k%I,k%J)            !Sum of the transport on the vertical
+            !           ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 
+            SELECT CASE( sec%direction(jseg) )
+               CASE(0,1) 
+                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
+                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
+                  zrhop = interp(k%I,k%J,jk,'V',rhop) 
+                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
+                  zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1) 
+               CASE(2,3) 
+                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
+                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
+                  zrhop = interp(k%I,k%J,jk,'U',rhop) 
+                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
+                  zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
+               END SELECT 
+               !
+               zdep= gdept_n(k%I,k%J,jk) 
+  
+               SELECT CASE( sec%direction(jseg) )                !compute velocity with the correct direction 
+               CASE(0,1)   
+                  zumid=0._wp
+                  zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk) 
+               CASE(2,3) 
+                  zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk) 
+                  zvmid=0._wp
+               END SELECT 
+ 
+               !zTnorm=transport through one cell; 
+               !velocity* cell's length * cell's thickness 
+               zTnorm = zumid*e2u(k%I,k%J) * e3u_n(k%I,k%J,jk)     & 
+                  &   + zvmid*e1v(k%I,k%J) * e3v_n(k%I,k%J,jk) 
+
+!!gm  THIS is WRONG  no transport due to ssh in linear free surface case !!!!!
+               IF( ln_linssh ) THEN              !add transport due to free surface 
+                  IF( jk==1 ) THEN 
+                     zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk)   & 
+                        &            + zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk) 
+                  ENDIF 
+               ENDIF
+!!gm end
+              !COMPUTE TRANSPORT  
+ 
+              transports_3d(1,jsec,jseg,jk) = transports_3d(1,jsec,jseg,jk) + zTnorm 
+  
+              IF( sec%llstrpond ) THEN 
+                 transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk)  + zTnorm * ztn * zrhop * rcp
+                 transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk)  + zTnorm * zsn * zrhop * 0.001
+              ENDIF
+   
+           END DO !end of loop on the level
+
+#if defined key_lim2 || defined key_lim3
+
+           !ICE CASE    
+           !------------
+           IF( sec%ll_ice_section )THEN
+              SELECT CASE (sec%direction(jseg))
+              CASE(0)
+                 zumid_ice = 0
+                 zvmid_ice =  isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
+              CASE(1)
+                 zumid_ice = 0
+                 zvmid_ice =  isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
+              CASE(2)
+                 zvmid_ice = 0
+                 zumid_ice =  isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
+              CASE(3)
+                 zvmid_ice = 0
+                 zumid_ice =  isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
+              END SELECT
+   
+              zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J)
+
+#if defined key_lim2   
+              transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*   & 
+                                   (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  & 
+                                  *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) +  & 
+                                    hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))
+              transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   & 
+                                    (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))
+#endif
+#if defined key_lim3
+              DO jl=1,jpl
+                 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*     &
+                                   a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * &
+                                  ( ht_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) +  &
+                                    ht_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) )
+                                   
+                 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   &
+                                   a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl)
+              END DO
+#endif
+   
+           ENDIF !end of ice case
+#endif
+ 
+        END DO !end of loop on the segment
+
+     ENDIF !end of sec%nb_point =0 case
+     !
+  END SUBROUTINE transport
+
+
+  SUBROUTINE dia_dct_sum(sec,jsec) 
+     !!------------------------------------------------------------- 
+     !! Purpose: Average the transport over nn_dctwri time steps  
+     !! and sum over the density/salinity/temperature/depth classes 
+     !! 
+     !! Method:   Sum over relevant grid cells to obtain values  
+     !!           for each class
+     !!              There are several loops:                  
+     !!              loop on the segment between 2 nodes 
+     !!              loop on the level jk 
+     !!              loop on the density/temperature/salinity/level classes 
+     !!              test on the density/temperature/salinity/level 
+     !! 
+     !!  Note:    Transport through a given section is equal to the sum of transports 
+     !!           computed on each proc. 
+     !!           On each proc,transport is equal to the sum of transport computed through 
+     !!           segments linking each point of sec%listPoint  with the next one.    
+     !! 
+     !!------------------------------------------------------------- 
+     TYPE(SECTION),INTENT(INOUT) :: sec 
+     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section 
+ 
+     TYPE(POINT_SECTION) :: k 
+     INTEGER  :: jk,jseg,jclass                        ! dummy variables for looping on level/segment/classes  
+     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/ssh/potential density /depth at u/v point 
+     !!------------------------------------------------------------- 
+ 
+     !! Sum the relevant segments to obtain values for each class 
+     IF(sec%nb_point .NE. 0)THEN    
+ 
+        !--------------------------------------! 
+        ! LOOP ON THE SEGMENT BETWEEN 2 NODES  ! 
+        !--------------------------------------! 
+        DO jseg=1,MAX(sec%nb_point-1,0) 
+            
+           !------------------------------------------------------------------------------------------- 
+           ! Select the appropriate coordinate for computing the velocity of the segment 
+           ! 
+           !                      CASE(0)                                    Case (2) 
+           !                      -------                                    -------- 
+           !  listPoint(jseg)                 listPoint(jseg+1)       listPoint(jseg)  F(i,j)       
+           !      F(i,j)----------V(i+1,j)-------F(i+1,j)                               | 
+           !                                                                            | 
+           !                                                                            | 
+           !                                                                            | 
+           !                      Case (3)                                            U(i,j) 
+           !                      --------                                              | 
+           !                                                                            | 
+           !  listPoint(jseg+1) F(i,j+1)                                                | 
+           !                        |                                                   | 
+           !                        |                                                   | 
+           !                        |                                 listPoint(jseg+1) F(i,j-1) 
+           !                        |                                             
+           !                        |                                             
+           !                     U(i,j+1)                                             
+           !                        |                                       Case(1)      
+           !                        |                                       ------       
+           !                        |                                             
+           !                        |                 listPoint(jseg+1)             listPoint(jseg)                            
+           !                        |                 F(i-1,j)-----------V(i,j) -------f(jseg)                            
+           ! listPoint(jseg)     F(i,j) 
+           !  
+           !------------------------------------------------------------------------------------------- 
+ 
+           SELECT CASE( sec%direction(jseg) ) 
+           CASE(0)  ;   k = sec%listPoint(jseg) 
+           CASE(1)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J) 
+           CASE(2)  ;   k = sec%listPoint(jseg) 
+           CASE(3)  ;   k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1) 
+           END SELECT 
+ 
+           !---------------------------| 
+           !     LOOP ON THE LEVEL     | 
+           !---------------------------| 
+           !Sum of the transport on the vertical  
+           DO jk=1,mbkt(k%I,k%J) 
+ 
+              ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 
+              SELECT CASE( sec%direction(jseg) ) 
+              CASE(0,1) 
+                 ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
+                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
+                 zrhop = interp(k%I,k%J,jk,'V',rhop) 
+                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
+
+              CASE(2,3) 
+                 ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
+                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
+                 zrhop = interp(k%I,k%J,jk,'U',rhop) 
+                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
+                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
+              END SELECT 
+ 
+              zdep= gdept_n(k%I,k%J,jk) 
+  
+              !------------------------------- 
+              !  LOOP ON THE DENSITY CLASSES | 
+              !------------------------------- 
+              !The computation is made for each density/temperature/salinity/depth class 
+              DO jclass=1,MAX(1,sec%nb_class-1) 
+ 
+                 !----------------------------------------------! 
+                 !TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL!  
+                 !----------------------------------------------! 
+
+                 IF ( (                                                    & 
+                    ((( zrhop .GE. (sec%zsigp(jclass)+1000.  )) .AND.      & 
+                    (   zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR.     & 
+                    ( sec%zsigp(jclass) .EQ. 99.)) .AND.                   & 
+ 
+                    ((( zrhoi .GE. (sec%zsigi(jclass) + 1000.  )) .AND.    & 
+                    (   zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR.     & 
+                    ( sec%zsigi(jclass) .EQ. 99.)) .AND.                   & 
+ 
+                    ((( zsn .GT. sec%zsal(jclass)) .AND.                   & 
+                    (   zsn .LE. sec%zsal(jclass+1))) .OR.                 & 
+                    ( sec%zsal(jclass) .EQ. 99.)) .AND.                    & 
+ 
+                    ((( ztn .GE. sec%ztem(jclass)) .AND.                   & 
+                    (   ztn .LE. sec%ztem(jclass+1))) .OR.                 & 
+                    ( sec%ztem(jclass) .EQ.99.)) .AND.                     & 
+ 
+                    ((( zdep .GE. sec%zlay(jclass)) .AND.                & 
+                    (   zdep .LE. sec%zlay(jclass+1))) .OR.              & 
+                    ( sec%zlay(jclass) .EQ. 99. ))                         & 
+                                                                   ))   THEN 
+ 
+                    !SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS 
+                    !---------------------------------------------------------------------------- 
+                    IF (transports_3d(1,jsec,jseg,jk) .GE. 0.0) THEN  
+                       sec%transport(1,jclass) = sec%transport(1,jclass)+transports_3d(1,jsec,jseg,jk)*1.E-6 
+                    ELSE 
+                       sec%transport(2,jclass) = sec%transport(2,jclass)+transports_3d(1,jsec,jseg,jk)*1.E-6 
+                    ENDIF 
+                    IF( sec%llstrpond )THEN 
+ 
+                       IF ( transports_3d(2,jsec,jseg,jk) .GE. 0.0 ) THEN 
+                          sec%transport(3,jclass) = sec%transport(3,jclass)+transports_3d(2,jsec,jseg,jk) 
+                       ELSE 
+                          sec%transport(4,jclass) = sec%transport(4,jclass)+transports_3d(2,jsec,jseg,jk) 
+                       ENDIF 
+ 
+                       IF ( transports_3d(3,jsec,jseg,jk) .GE. 0.0 ) THEN 
+                          sec%transport(5,jclass) = sec%transport(5,jclass)+transports_3d(3,jsec,jseg,jk) 
+                       ELSE 
+                          sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk) 
+                       ENDIF 
+ 
+                    ELSE 
+                       sec%transport( 3,jclass) = 0._wp 
+                       sec%transport( 4,jclass) = 0._wp 
+                       sec%transport( 5,jclass) = 0._wp 
+                       sec%transport( 6,jclass) = 0._wp 
+                    ENDIF 
+ 
+                 ENDIF ! end of test if point is in class 
+    
+              ENDDO ! end of loop on the classes 
+ 
+           ENDDO ! loop over jk 
+ 
+#if defined key_lim2 || defined key_lim3 
+ 
+           !ICE CASE     
+           IF( sec%ll_ice_section )THEN 
+ 
+              IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN 
+                 sec%transport( 7,1) = sec%transport( 7,1)+transports_2d(1,jsec,jseg)*1.E-6 
+              ELSE 
+                 sec%transport( 8,1) = sec%transport( 8,1)+transports_2d(1,jsec,jseg)*1.E-6 
+              ENDIF 
+ 
+              IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN 
+                 sec%transport( 9,1) = sec%transport( 9,1)+transports_2d(2,jsec,jseg)*1.E-6 
+              ELSE 
+                 sec%transport(10,1) = sec%transport(10,1)+transports_2d(2,jsec,jseg)*1.E-6 
+              ENDIF 
+ 
+           ENDIF !end of ice case 
+#endif 
+  
+        END DO !end of loop on the segment 
+ 
+     ELSE  !if sec%nb_point =0 
+        sec%transport(1:2,:)=0. 
+        IF (sec%llstrpond) sec%transport(3:6,:)=0. 
+        IF (sec%ll_ice_section) sec%transport(7:10,:)=0. 
+     ENDIF !end of sec%nb_point =0 case 
+ 
+  END SUBROUTINE dia_dct_sum 
+
+
+  SUBROUTINE dia_dct_wri(kt,ksec,sec)
+     !!-------------------------------------------------------------
+     !! Write transport output in numdct 
+     !! 
+     !! Purpose: Write  transports in ascii files
+     !! 
+     !! Method:
+     !!        1. Write volume transports in "volume_transport"
+     !!           Unit: Sv : area * Velocity / 1.e6 
+     !! 
+     !!        2. Write heat transports in "heat_transport"
+     !!           Unit: Peta W : area * Velocity * T * rhop * Cp * 1.e-15
+     !! 
+     !!        3. Write salt transports in "salt_transport"
+     !!           Unit: 10^9 Kg/m^2/s : area * Velocity * S * rhop * 1.e-9 
+     !!
+     !!------------------------------------------------------------- 
+     !!arguments
+     INTEGER, INTENT(IN)          :: kt          ! time-step
+     TYPE(SECTION), INTENT(INOUT) :: sec         ! section to write   
+     INTEGER ,INTENT(IN)          :: ksec        ! section number
+
+     !!local declarations
+     INTEGER               :: jclass             ! Dummy loop
+     CHARACTER(len=2)      :: classe             ! Classname 
+     REAL(wp)              :: zbnd1,zbnd2        ! Class bounds
+     REAL(wp)              :: zslope             ! section's slope coeff
+     !
+     REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 
+     !!------------------------------------------------------------- 
+     CALL wrk_alloc(nb_type_class , zsumclasses )  
+
+     zsumclasses(:)=0._wp
+     zslope = sec%slopeSection       
+
+ 
+     DO jclass=1,MAX(1,sec%nb_class-1)
+
+        classe   = 'N       '
+        zbnd1   = 0._wp
+        zbnd2   = 0._wp
+        zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass)
+
+   
+        !insitu density classes transports
+        IF( ( sec%zsigi(jclass)   .NE. 99._wp ) .AND. &
+            ( sec%zsigi(jclass+1) .NE. 99._wp )       )THEN
+           classe = 'DI       '
+           zbnd1 = sec%zsigi(jclass)
+           zbnd2 = sec%zsigi(jclass+1)
+        ENDIF
+        !potential density classes transports
+        IF( ( sec%zsigp(jclass)   .NE. 99._wp ) .AND. &
+            ( sec%zsigp(jclass+1) .NE. 99._wp )       )THEN
+           classe = 'DP      '
+           zbnd1 = sec%zsigp(jclass)
+           zbnd2 = sec%zsigp(jclass+1)
+        ENDIF
+        !depth classes transports
+        IF( ( sec%zlay(jclass)    .NE. 99._wp ) .AND. &
+            ( sec%zlay(jclass+1)  .NE. 99._wp )       )THEN 
+           classe = 'Z       '
+           zbnd1 = sec%zlay(jclass)
+           zbnd2 = sec%zlay(jclass+1)
+        ENDIF
+        !salinity classes transports
+        IF( ( sec%zsal(jclass) .NE. 99._wp    ) .AND. &
+            ( sec%zsal(jclass+1) .NE. 99._wp  )       )THEN
+           classe = 'S       '
+           zbnd1 = sec%zsal(jclass)
+           zbnd2 = sec%zsal(jclass+1)   
+        ENDIF
+        !temperature classes transports
+        IF( ( sec%ztem(jclass) .NE. 99._wp     ) .AND. &
+            ( sec%ztem(jclass+1) .NE. 99._wp     )       ) THEN
+           classe = 'T       '
+           zbnd1 = sec%ztem(jclass)
+           zbnd2 = sec%ztem(jclass+1)
+        ENDIF
+                  
+        !write volume transport per class
+        WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
+                              jclass,classe,zbnd1,zbnd2,&
+                              sec%transport(1,jclass),sec%transport(2,jclass), &
+                              sec%transport(1,jclass)+sec%transport(2,jclass)
+
+        IF( sec%llstrpond )THEN
+
+           !write heat transport per class:
+           WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope,  &
+                              jclass,classe,zbnd1,zbnd2,&
+                              sec%transport(3,jclass)*1.e-15,sec%transport(4,jclass)*1.e-15, &
+                              ( sec%transport(3,jclass)+sec%transport(4,jclass) )*1.e-15
+           !write salt transport per class
+           WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope,  &
+                              jclass,classe,zbnd1,zbnd2,&
+                              sec%transport(5,jclass)*1.e-9,sec%transport(6,jclass)*1.e-9,&
+                              (sec%transport(5,jclass)+sec%transport(6,jclass))*1.e-9
+        ENDIF
+
+     ENDDO
+
+     zbnd1 = 0._wp
+     zbnd2 = 0._wp
+     jclass=0
+
+     !write total volume transport
+     WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
+                           jclass,"total",zbnd1,zbnd2,&
+                           zsumclasses(1),zsumclasses(2),zsumclasses(1)+zsumclasses(2)
+
+     IF( sec%llstrpond )THEN
+
+        !write total heat transport
+        WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, &
+                           jclass,"total",zbnd1,zbnd2,&
+                           zsumclasses(3)*1.e-15,zsumclasses(4)*1.e-15,&
+                           (zsumclasses(3)+zsumclasses(4) )*1.e-15
+        !write total salt transport
+        WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, &
+                           jclass,"total",zbnd1,zbnd2,&
+                           zsumclasses(5)*1.e-9,zsumclasses(6)*1.e-9,&
+                           (zsumclasses(5)+zsumclasses(6))*1.e-9
+     ENDIF
+
+      
+     IF ( sec%ll_ice_section) THEN
+        !write total ice volume transport
+        WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
+                              jclass,"ice_vol",zbnd1,zbnd2,&
+                              sec%transport(7,1),sec%transport(8,1),&
+                              sec%transport(7,1)+sec%transport(8,1)
+        !write total ice surface transport
+        WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
+                              jclass,"ice_surf",zbnd1,zbnd2,&
+                              sec%transport(9,1),sec%transport(10,1), &
+                              sec%transport(9,1)+sec%transport(10,1) 
+      ENDIF
+                                              
+118   FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3F12.4)
+119   FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6)
+
+      CALL wrk_dealloc(nb_type_class , zsumclasses )  
+      !
+   END SUBROUTINE dia_dct_wri
+
+
+   FUNCTION interp(ki, kj, kk, cd_point, ptab)
+  !!----------------------------------------------------------------------
+  !!
+  !!   Purpose: compute temperature/salinity/density at U-point or V-point
+  !!   --------
+  !!
+  !!   Method:
+  !!   ------
+  !!
+  !!   ====> full step and partial step
+  !! 
+  !!
+  !!    |    I          |    I+1           |    Z=temperature/salinity/density at U-poinT
+  !!    |               |                  |
+  !!  ----------------------------------------  1. Veritcal interpolation: compute zbis
+  !!    |               |                  |       interpolation between ptab(I,J,K) and ptab(I,J,K+1)
+  !!    |               |                  |       zbis = 
+  !!    |               |                  |      [ e3w(I+1,J,K)*ptab(I,J,K) + ( e3w(I,J,K) - e3w(I+1,J,K) ) * ptab(I,J,K-1) ]
+  !!    |               |                  |      /[ e3w(I+1,J,K) + e3w(I,J,K) - e3w(I+1,J,K) ] 
+  !!    |               |                  | 
+  !!    |               |                  |    2. Horizontal interpolation: compute value at U/V point
+  !!K-1 | ptab(I,J,K-1) |                  |       interpolation between zbis and ptab(I+1,J,K)  
+  !!    |     .         |                  |
+  !!    |     .         |                  |       interp = ( 0.5*zet2*zbis + 0.5*zet1*ptab(I+1,J,K) )/(0.5*zet2+0.5*zet1) 
+  !!    |     .         |                  |
+  !!  ------------------------------------------
+  !!    |     .         |                  |
+  !!    |     .         |                  |
+  !!    |     .         |                  |
+  !!K   |    zbis.......U...ptab(I+1,J,K)  |
+  !!    |     .         |                  |
+  !!    | ptab(I,J,K)   |                  |
+  !!    |               |------------------|
+  !!    |               | partials         |
+  !!    |               |  steps           |
+  !!  -------------------------------------------
+  !!    <----zet1------><----zet2--------->
+  !!
+  !!
+  !!   ====>  s-coordinate
+  !!     
+  !!    |                |                  |   1. Compute distance between T1 and U points: SQRT( zdep1^2 + (0.5 * zet1 )^2
+  !!    |                |                  |      Compute distance between T2 and U points: SQRT( zdep2^2 + (0.5 * zet2 )^2
+  !!    |                | ptab(I+1,J,K)    | 
+  !!    |                |      T2          |   2. Interpolation between  T1 and T2 values at U point 
+  !!    |                |      ^           |    
+  !!    |                |      | zdep2     |    
+  !!    |                |      |           |    
+  !!    |       ^        U      v           |
+  !!    |       |        |                  |
+  !!    |       | zdep1  |                  |    
+  !!    |       v        |                  |
+  !!    |      T1        |                  |
+  !!    | ptab(I,J,K)    |                  | 
+  !!    |                |                  | 
+  !!    |                |                  | 
+  !!
+  !!    <----zet1--------><----zet2--------->
+  !!
+  !!----------------------------------------------------------------------
+  !*arguments
+  INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point
+  CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V)
+  REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab         ! variable to compute at (ki, kj, kk )
+  REAL(wp)                                     :: interp       ! interpolated variable 
+
+  !*local declations
+  INTEGER :: ii1, ij1, ii2, ij2                                ! local integer
+  REAL(wp):: ze3t, ze3, zwgt1, zwgt2, zbis, zdepu            ! local real
+  REAL(wp):: zet1, zet2                                        ! weight for interpolation 
+  REAL(wp):: zdep1,zdep2                                       ! differences of depth
+  REAL(wp):: zmsk                                              ! mask value
+  !!----------------------------------------------------------------------
+
+  IF( cd_point=='U' )THEN 
+     ii1 = ki    ; ij1 = kj 
+     ii2 = ki+1  ; ij2 = kj 
+
+     zet1=e1t(ii1,ij1)
+     zet2=e1t(ii2,ij2)
+     zmsk=umask(ii1,ij1,kk)
+  
+
+  ELSE ! cd_point=='V' 
+     ii1 = ki    ; ij1 = kj 
+     ii2 = ki    ; ij2 = kj+1  
+
+     zet1=e2t(ii1,ij1)
+     zet2=e2t(ii2,ij2)
+     zmsk=vmask(ii1,ij1,kk)
+
+  ENDIF
+
+  IF( ln_sco )THEN   ! s-coordinate case
+
+     zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp 
+     zdep1 = gdept_n(ii1,ij1,kk) - zdepu
+     zdep2 = gdept_n(ii2,ij2,kk) - zdepu
+
+     ! weights
+     zwgt1 = SQRT( ( 0.5 * zet1 ) * ( 0.5 * zet1 ) + ( zdep1 * zdep1 ) )
+     zwgt2 = SQRT( ( 0.5 * zet2 ) * ( 0.5 * zet2 ) + ( zdep2 * zdep2 ) )
+  
+     ! result
+     interp = zmsk * ( zwgt2 *  ptab(ii1,ij1,kk) + zwgt1 *  ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )   
+
+
+  ELSE       ! full step or partial step case 
+
+     ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk) 
+     zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk)
+     zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk)
+
+     IF(kk .NE. 1)THEN
+
+        IF( ze3t >= 0. )THEN 
+           ! zbis
+           zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) ) 
+           ! result
+            interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
+        ELSE
+           ! zbis
+           zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) )
+           ! result
+           interp = zmsk * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
+        ENDIF    
+
+     ELSE
+        interp = zmsk * (  zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
+     ENDIF
+
+  ENDIF
+      !
+   END FUNCTION interp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Dummy module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .FALSE.    !: diamht flag
+   PUBLIC 
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE dia_dct_init          ! Dummy routine
+      WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?', kt
+   END SUBROUTINE dia_dct_init
+
+   SUBROUTINE dia_dct( kt )         ! Dummy routine
+      INTEGER, INTENT( in ) :: kt   ! ocean time-step index
+      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt
+   END SUBROUTINE dia_dct
+#endif
+
+   !!======================================================================
+END MODULE diadct
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 8732)
@@ -0,0 +1,538 @@
+MODULE diaharm 
+   !!======================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents 
+   !!======================================================================
+   !! History :  3.1  !  2007  (O. Le Galloudec, J. Chanut)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_diaharm
+   !!----------------------------------------------------------------------
+   !!   'key_diaharm'
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE phycst
+   USE daymod
+   USE tide_mod
+   USE sbctide         ! Tidal forcing or not
+   !
+   USE in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE ioipsl          ! NetCDF IPSL library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL, PUBLIC, PARAMETER :: lk_diaharm  = .TRUE.
+   
+   INTEGER, PARAMETER :: jpincomax    = 2.*jpmax_harmo
+   INTEGER, PARAMETER :: jpdimsparse  = jpincomax*300*24
+
+   !                         !!** namelist variables **
+   INTEGER ::   nit000_han    ! First time step used for harmonic analysis
+   INTEGER ::   nitend_han    ! Last time step used for harmonic analysis
+   INTEGER ::   nstep_han     ! Time step frequency for harmonic analysis
+   INTEGER ::   nb_ana        ! Number of harmonics to analyse
+
+   INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ana_temp
+   REAL(wp), ALLOCATABLE, DIMENSION(:)       ::   ana_freq, ut   , vt   , ft
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   out_eta , out_u, out_v
+
+   INTEGER ::   ninco, nsparse
+   INTEGER ,       DIMENSION(jpdimsparse)         ::   njsparse, nisparse
+   INTEGER , SAVE, DIMENSION(jpincomax)           ::   ipos1
+   REAL(wp),       DIMENSION(jpdimsparse)         ::   valuesparse
+   REAL(wp),       DIMENSION(jpincomax)           ::   ztmp4 , ztmp7
+   REAL(wp), SAVE, DIMENSION(jpincomax,jpincomax) ::   ztmp3 , zpilier
+   REAL(wp), SAVE, DIMENSION(jpincomax)           ::   zpivot
+
+   CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   tname   ! Names of tidal constituents ('M2', 'K1',...)
+
+   PUBLIC   dia_harm   ! routine called by step.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_harm_init 
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_harm_init  ***
+      !!         
+      !! ** Purpose :   Initialization of tidal harmonic analysis
+      !!
+      !! ** Method  :   Initialize frequency array and  nodal factor for nit000_han
+      !!
+      !!--------------------------------------------------------------------
+      INTEGER :: jh, nhan, jk, ji
+      INTEGER ::   ios                 ! Local integer output status for namelist read
+
+      NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization'
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      IF( .NOT. ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis')
+      !
+      CALL tide_init_Wave
+      !
+      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis
+      READ  ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis
+      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_diaharm )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han
+         WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han
+         WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han
+      ENDIF
+
+      ! Basic checks on harmonic analysis time window:
+      ! ----------------------------------------------
+      IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   &
+         &                                       ' restart capability not implemented' )
+      IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   &
+         &                                       'restart capability not implemented' )
+
+      IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   &
+         &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' )
+
+      nb_ana = 0
+      DO jk=1,jpmax_harmo
+         DO ji=1,jpmax_harmo
+            IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN
+               nb_ana=nb_ana+1
+            ENDIF
+         END DO
+      END DO
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) '        Namelist nam_diaharm'
+         WRITE(numout,*) '        nb_ana    = ', nb_ana
+         CALL flush(numout)
+      ENDIF
+      !
+      IF (nb_ana > jpmax_harmo) THEN
+        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nb_ana must be lower than jpmax_harmo, stop'
+        IF(lwp) WRITE(numout,*) ' jpmax_harmo= ', jpmax_harmo
+        nstop = nstop + 1
+      ENDIF
+
+      ALLOCATE(name    (nb_ana))
+      DO jk=1,nb_ana
+       DO ji=1,jpmax_harmo
+          IF (TRIM(tname(jk)) ==  Wave(ji)%cname_tide) THEN
+             name(jk) = ji
+             EXIT
+          END IF
+       END DO
+      END DO
+
+      ! Initialize frequency array:
+      ! ---------------------------
+      ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) )
+
+      CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana )
+
+      IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency '
+
+      DO jh = 1, nb_ana
+        IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh)
+      END DO
+
+      ! Initialize temporary arrays:
+      ! ----------------------------
+      ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) )
+      ana_temp(:,:,:,:) = 0._wp
+
+   END SUBROUTINE dia_harm_init
+
+
+   SUBROUTINE dia_harm ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_harm  ***
+      !!         
+      !! ** Purpose :   Tidal harmonic analysis main routine
+      !!
+      !! ** Action  :   Sums ssh/u/v over time analysis [nit000_han,nitend_han]
+      !!
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT( IN ) :: kt
+      !
+      INTEGER  :: ji, jj, jh, jc, nhc
+      REAL(wp) :: ztime, ztemp
+      !!--------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_harm')
+
+      IF( kt == nit000 ) CALL dia_harm_init
+
+      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN
+
+         ztime = (kt-nit000+1) * rdt 
+       
+         nhc = 0
+         DO jh = 1, nb_ana
+            DO jc = 1, 2
+               nhc = nhc+1
+               ztemp =(     MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))  &
+                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh)))
+
+               DO jj = 1,jpj
+                  DO ji = 1,jpi
+                     ! Elevation
+                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)        
+                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj)
+                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj)
+                  END DO
+               END DO
+               !
+            END DO
+         END DO
+         !       
+      END IF
+
+      IF ( kt == nitend_han )   CALL dia_harm_end
+
+      IF( nn_timing == 1 )   CALL timing_stop('dia_harm')
+ 
+   END SUBROUTINE dia_harm
+
+
+   SUBROUTINE dia_harm_end
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE diaharm_end  ***
+      !!         
+      !! ** Purpose :  Compute the Real and Imaginary part of tidal constituents
+      !!
+      !! ** Action  :  Decompose the signal on the harmonic constituents 
+      !!
+      !!--------------------------------------------------------------------
+      INTEGER :: ji, jj, jh, jc, jn, nhan, jl
+      INTEGER :: ksp, kun, keq
+      REAL(wp) :: ztime, ztime_ini, ztime_end
+      REAL(wp) :: X1,X2
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ana_amp
+      !!--------------------------------------------------------------------
+      CALL wrk_alloc( jpi , jpj , jpmax_harmo , 2 , ana_amp )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'anharmo_end: kt=nitend_han: Perform harmonic analysis'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ztime_ini = nit000_han*rdt                 ! Initial time in seconds at the beginning of analysis
+      ztime_end = nitend_han*rdt                 ! Final time in seconds at the end of analysis
+      nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis
+
+      ninco = 2*nb_ana
+
+      ksp = 0
+      keq = 0        
+      DO jn = 1, nhan
+         ztime=( (nhan-jn)*ztime_ini + (jn-1)*ztime_end )/FLOAT(nhan-1)
+         keq = keq + 1
+         kun = 0
+         DO jh = 1, nb_ana
+            DO jc = 1, 2
+               kun = kun + 1
+               ksp = ksp + 1
+               nisparse(ksp) = keq
+               njsparse(ksp) = kun
+               valuesparse(ksp) = (   MOD(jc,2) * ft(jh) * COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))   &
+                  &             + (1.-MOD(jc,2))* ft(jh) * SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh)) )
+            END DO
+         END DO
+      END DO
+
+      nsparse = ksp
+
+      ! Elevation:
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! Fill input array
+            kun = 0
+            DO jh = 1, nb_ana
+               DO jc = 1, 2
+                  kun = kun + 1
+                  ztmp4(kun)=ana_temp(ji,jj,kun,1)
+               END DO
+            END DO
+
+            CALL SUR_DETERMINE(jj)
+
+            ! Fill output array
+            DO jh = 1, nb_ana
+               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)
+               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)
+            END DO
+         END DO
+      END DO
+
+      ALLOCATE( out_eta(jpi,jpj,2*nb_ana),   & 
+         &      out_u  (jpi,jpj,2*nb_ana),   &
+         &      out_v  (jpi,jpj,2*nb_ana)  )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jh = 1, nb_ana 
+               X1 = ana_amp(ji,jj,jh,1)
+               X2 =-ana_amp(ji,jj,jh,2)
+               out_eta(ji,jj,jh       ) = X1 * tmask_i(ji,jj)
+               out_eta(ji,jj,jh+nb_ana) = X2 * tmask_i(ji,jj)
+            END DO
+         END DO
+      END DO
+
+      ! ubar:
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! Fill input array
+            kun=0
+            DO jh = 1,nb_ana
+               DO jc = 1,2
+                  kun = kun + 1
+                  ztmp4(kun)=ana_temp(ji,jj,kun,2)
+               END DO
+            END DO
+
+            CALL SUR_DETERMINE(jj+1)
+
+            ! Fill output array
+            DO jh = 1, nb_ana
+               ana_amp(ji,jj,jh,1) = ztmp7((jh-1)*2+1)
+               ana_amp(ji,jj,jh,2) = ztmp7((jh-1)*2+2)
+            END DO
+
+         END DO
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jh = 1, nb_ana 
+               X1= ana_amp(ji,jj,jh,1)
+               X2=-ana_amp(ji,jj,jh,2)
+               out_u(ji,jj,       jh) = X1 * ssumask(ji,jj)
+               out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! vbar:
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! Fill input array
+            kun=0
+            DO jh = 1,nb_ana
+               DO jc = 1,2
+                  kun = kun + 1
+                  ztmp4(kun)=ana_temp(ji,jj,kun,3)
+               END DO
+            END DO
+
+            CALL SUR_DETERMINE(jj+1)
+
+            ! Fill output array
+            DO jh = 1, nb_ana
+               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)
+               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)
+            END DO
+
+         END DO
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jh = 1, nb_ana 
+               X1=ana_amp(ji,jj,jh,1)
+               X2=-ana_amp(ji,jj,jh,2)
+               out_v(ji,jj,       jh)=X1 * ssvmask(ji,jj)
+               out_v(ji,jj,nb_ana+jh)=X2 * ssvmask(ji,jj)
+            END DO
+         END DO
+      END DO
+
+      CALL dia_wri_harm ! Write results in files
+      CALL wrk_dealloc( jpi , jpj , jpmax_harmo , 2 , ana_amp )
+      !
+   END SUBROUTINE dia_harm_end
+
+
+   SUBROUTINE dia_wri_harm
+      !!--------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_wri_harm  ***
+      !!         
+      !! ** Purpose : Write tidal harmonic analysis results in a netcdf file
+      !!--------------------------------------------------------------------
+      CHARACTER(LEN=lc) :: cltext
+      CHARACTER(LEN=lc) ::   &
+         cdfile_name_T   ,   & ! name of the file created (T-points)
+         cdfile_name_U   ,   & ! name of the file created (U-points)
+         cdfile_name_V         ! name of the file created (V-points)
+      INTEGER  ::   jh
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) '  '
+      IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results'
+      IF(lwp) WRITE(numout,*) '  '
+
+      ! A) Elevation
+      !/////////////
+      !
+      DO jh = 1, nb_ana
+      CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) )
+      CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,nb_ana+jh) )
+      END DO
+
+      ! B) ubar
+      !/////////
+      !
+      DO jh = 1, nb_ana
+      CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) )
+      CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,nb_ana+jh) )
+      END DO
+
+      ! C) vbar
+      !/////////
+      !
+      DO jh = 1, nb_ana
+         CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) )
+         CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) )
+      END DO
+      !
+   END SUBROUTINE dia_wri_harm
+
+
+   SUBROUTINE SUR_DETERMINE(init)
+      !!---------------------------------------------------------------------------------
+      !!                      *** ROUTINE SUR_DETERMINE ***
+      !!    
+      !!    
+      !!       
+      !!---------------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   init 
+      !
+      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd
+      REAL(wp)                        :: zval1, zval2, zx1
+      REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2
+      INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot
+      !---------------------------------------------------------------------------------
+      CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 )
+      CALL wrk_alloc( jpincomax , ipos2 , ipivot        )
+            
+      IF( init == 1 ) THEN
+         IF( nsparse > jpdimsparse )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse')
+         IF( ninco   > jpincomax   )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax')
+         !
+         ztmp3(:,:) = 0._wp
+         !
+         DO jk1_sd = 1, nsparse
+            DO jk2_sd = 1, nsparse
+               nisparse(jk2_sd) = nisparse(jk2_sd)
+               njsparse(jk2_sd) = njsparse(jk2_sd)
+               IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN
+                  ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  &
+                     &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd)
+               ENDIF
+            END DO
+         END DO
+         !
+         DO jj_sd = 1 ,ninco
+            ipos1(jj_sd) = jj_sd
+            ipos2(jj_sd) = jj_sd
+         END DO
+         !
+         DO ji_sd = 1 , ninco
+            !
+            !find greatest non-zero pivot:
+            zval1 = ABS(ztmp3(ji_sd,ji_sd))
+            !
+            ipivot(ji_sd) = ji_sd
+            DO jj_sd = ji_sd, ninco
+               zval2 = ABS(ztmp3(ji_sd,jj_sd))
+               IF( zval2 >= zval1 )THEN
+                  ipivot(ji_sd) = jj_sd
+                  zval1         = zval2
+               ENDIF
+            END DO
+            !
+            DO ji1_sd = 1, ninco
+               zcol1(ji1_sd)               = ztmp3(ji1_sd,ji_sd)
+               zcol2(ji1_sd)               = ztmp3(ji1_sd,ipivot(ji_sd))
+               ztmp3(ji1_sd,ji_sd)         = zcol2(ji1_sd)
+               ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd)
+            END DO
+            !
+            ipos2(ji_sd)         = ipos1(ipivot(ji_sd))
+            ipos2(ipivot(ji_sd)) = ipos1(ji_sd)
+            ipos1(ji_sd)         = ipos2(ji_sd)
+            ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd))
+            zpivot(ji_sd)        = ztmp3(ji_sd,ji_sd)
+            DO jj_sd = 1, ninco
+               ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd)
+            END DO
+            !
+            DO ji2_sd = ji_sd+1, ninco
+               zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd)
+               DO jj_sd=1,ninco
+                  ztmp3(ji2_sd,jj_sd)=  ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd)
+               END DO
+            END DO
+            !
+         END DO
+         !
+      ENDIF ! End init==1
+
+      DO ji_sd = 1, ninco
+         ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd)
+         DO ji2_sd = ji_sd+1, ninco
+            ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd)
+         END DO
+      END DO
+
+      !system solving: 
+      ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco)
+      ji_sd = ninco
+      DO ji_sd = ninco-1, 1, -1
+         zx1 = 0._wp
+         DO jj_sd = ji_sd+1, ninco
+            zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd)
+         END DO
+         ztmpx(ji_sd) = ztmp4(ji_sd)-zx1
+      END DO
+
+      DO jj_sd =1, ninco
+         ztmp7(ipos1(jj_sd))=ztmpx(jj_sd)
+      END DO
+
+      CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 )
+      CALL wrk_dealloc( jpincomax , ipos2 , ipivot        )
+      !
+   END SUBROUTINE SUR_DETERMINE
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm = .FALSE.
+CONTAINS
+   SUBROUTINE dia_harm ( kt )     ! Empty routine
+      INTEGER, INTENT( IN ) :: kt  
+      WRITE(*,*) 'dia_harm: you should not have seen this print'
+   END SUBROUTINE dia_harm
+#endif
+
+   !!======================================================================
+END MODULE diaharm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 8732)
@@ -0,0 +1,399 @@
+MODULE diahsb
+   !!======================================================================
+   !!                       ***  MODULE  diahsb  ***
+   !! Ocean diagnostics: Heat, salt and volume budgets
+   !!======================================================================
+   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code 
+   !!                 ! 2012-10  (C. Rousset)  add iom_put
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dia_hsb       : Diagnose the conservation of ocean heat and salt contents, and volume
+   !!   dia_hsb_rst   : Read or write DIA file in restart file
+   !!   dia_hsb_init  : Initialization of the conservation diagnostic
+   !!----------------------------------------------------------------------
+   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 sbcrnf          ! river runoff
+   USE sbcisf          ! ice shelves
+   USE domvvl          ! vertical scale factors
+   USE traqsr          ! penetrative solar radiation
+   USE trabbc          ! bottom boundary condition 
+   USE trabbc          ! bottom boundary condition
+   USE restart         ! ocean restart
+   USE bdy_oce   , ONLY: ln_bdy
+   !
+   USE iom             ! I/O manager
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran     ! glob_sum
+   USE lib_mpp         ! distributed memory computing library
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_hsb        ! routine called by step.F90
+   PUBLIC   dia_hsb_init   ! routine called by nemogcm.F90
+
+   LOGICAL, PUBLIC ::   ln_diahsb   !: check the heat and salt budgets
+
+   REAL(wp) ::   surf_tot              ! ocean surface
+   REAL(wp) ::   frc_t, frc_s, frc_v   ! global forcing trends
+   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends
+   !
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf 
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          !
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   !
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
+
+   !! * Substitutions
+#  include "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
+      !!
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER    ::   ji, jj, jk                  ! dummy loop indice
+      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations
+      REAL(wp)   ::   zdiff_hc1   , zdiff_sc1     !  -         -     -        - 
+      REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation
+      REAL(wp)   ::   zerr_hc1    , zerr_sc1      ! heat and salt content misfit
+      REAL(wp)   ::   zvol_tot                    ! volume
+      REAL(wp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     -
+      REAL(wp)   ::   z_frc_trd_v                 !    -     -
+      REAL(wp)   ::   z_wn_trd_t , z_wn_trd_s     !    -     -
+      REAL(wp)   ::   z_ssh_hc , z_ssh_sc         !    -     -
+      REAL(wp), DIMENSION(:,:), POINTER ::   z2d0, z2d1
+      !!---------------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_hsb')      
+      !
+      CALL wrk_alloc( jpi,jpj,   z2d0, z2d1 )
+      !
+      tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ;
+      tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ;
+      ! ------------------------- !
+      ! 1 - Trends due to forcing !
+      ! ------------------------- !
+      z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes
+      z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )                               ! heat fluxes
+      z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )                               ! salt fluxes
+      ! Add runoff    heat & salt input
+      IF( ln_rnf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) )
+      IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) )
+      ! Add ice shelf heat & salt input
+      IF( ln_isf    ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )
+      ! Add penetrative solar radiation
+      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * surf(:,:) )
+      ! Add geothermal heat flux
+      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( qgh_trd0(:,:) * surf(:,:) )
+      !
+      IF( ln_linssh ) THEN
+         IF( ln_isfcav ) THEN
+            DO ji=1,jpi
+               DO jj=1,jpj
+                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
+                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
+               END DO
+            END DO
+         ELSE
+            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
+            z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
+         END IF
+         z_wn_trd_t = - glob_sum( z2d0 ) 
+         z_wn_trd_s = - glob_sum( z2d1 )
+      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
+      !                                          ! Advection flux through fixed surface (z=0)
+      IF( ln_linssh ) THEN
+         frc_wn_t = frc_wn_t + z_wn_trd_t * rdt
+         frc_wn_s = frc_wn_s + z_wn_trd_s * rdt
+      ENDIF
+
+      ! ------------------------ !
+      ! 2 -  Content variations !
+      ! ------------------------ !
+      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
+      zdiff_v2 = 0._wp
+      zdiff_hc = 0._wp
+      zdiff_sc = 0._wp
+
+      ! volume variation (calculated with ssh)
+      zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) )
+
+      ! heat & salt content variation (associated with ssh)
+      IF( ln_linssh ) THEN
+         IF( ln_isfcav ) THEN
+            DO ji = 1, jpi
+               DO jj = 1, jpj
+                  z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 
+                  z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 
+               END DO
+            END DO
+         ELSE
+            z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 
+            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 
+         END IF
+         z_ssh_hc = glob_sum_full( z2d0 ) 
+         z_ssh_sc = glob_sum_full( z2d1 ) 
+      ENDIF
+
+      DO jk = 1, jpkm1
+         ! volume variation (calculated with scale factors)
+         zdiff_v2 = zdiff_v2 + glob_sum_full( surf(:,:) * tmask(:,:,jk)            &
+            &                           * e3t_n(:,:,jk) - surf_ini(:,:) * e3t_ini(:,:,jk) )
+         ! heat content variation
+         zdiff_hc = zdiff_hc + glob_sum_full(  surf(:,:) * tmask(:,:,jk)                                   & 
+            &                           * e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) 
+         ! salt content variation
+         zdiff_sc = zdiff_sc + glob_sum_full( surf    (:,:) * tmask(:,:,jk)                           &
+                                        * e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - surf_ini(:,:) * sc_loc_ini(:,:,jk) )
+      ENDDO
+
+      ! ------------------------ !
+      ! 3 -  Drifts              !
+      ! ------------------------ !
+      zdiff_v1 = zdiff_v1 - frc_v
+      IF( .NOT.ln_linssh )   zdiff_v2 = zdiff_v2 - frc_v
+      zdiff_hc = zdiff_hc - frc_t
+      zdiff_sc = zdiff_sc - frc_s
+      IF( ln_linssh ) THEN
+         zdiff_hc1 = zdiff_hc + z_ssh_hc 
+         zdiff_sc1 = zdiff_sc + z_ssh_sc
+         zerr_hc1  = z_ssh_hc - frc_wn_t
+         zerr_sc1  = z_ssh_sc - frc_wn_s
+      ENDIF
+
+      ! ----------------------- !
+      ! 4 - Diagnostics writing !
+      ! ----------------------- !
+      zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors)
+      DO jk = 1, jpkm1
+         zvol_tot  = zvol_tot + glob_sum_full( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) )
+      END DO
+
+!!gm to be added ?
+!      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution
+!        zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) )
+!      ENDIF
+!!gm end
+
+      CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3) 
+      CALL iom_put(   'bgfrctem' , frc_t    * rau0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J) 
+      CALL iom_put(   'bgfrchfx' , frc_t    * rau0 * rcp /  &         ! hc  - surface forcing (W/m2) 
+         &                       ( surf_tot * kt * rdt )        )
+      CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3) 
+
+      IF( .NOT. ln_linssh ) THEN
+        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C) 
+        CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (pss)
+        CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content drift    (1.e20 J) 
+        CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp /  &         ! Heat flux drift       (W/m2) 
+           &                       ( surf_tot * kt * rdt )        )
+        CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3)
+        CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)  
+        CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9    )              ! volume e3t drift      (km3)  
+      ELSE
+        CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C) 
+        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (pss)
+        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content drift    (1.e20 J) 
+        CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp /  &        ! Heat flux drift       (W/m2) 
+           &                       ( surf_tot * kt * rdt )         )
+        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3)
+        CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)  
+        CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C)
+        CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu)
+      ENDIF
+      !
+      IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' )
+      !
+      CALL wrk_dealloc( jpi,jpj,   z2d0, z2d1 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb')
+      !
+   END SUBROUTINE dia_hsb
+
+
+   SUBROUTINE dia_hsb_rst( kt, cdrw )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE dia_hsb_rst  ***
+     !!                     
+     !! ** Purpose :   Read or write DIA file in restart file
+     !!
+     !! ** Method  :   use of IOM library
+     !!----------------------------------------------------------------------
+     INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+     !
+     INTEGER ::   ji, jj, jk   ! dummy loop indices
+     !!----------------------------------------------------------------------
+     !
+     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+        IF( ln_rstart ) THEN                   !* Read the restart file
+           !
+           IF(lwp) WRITE(numout,*) '~~~~~~~'
+           IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp
+           IF(lwp) WRITE(numout,*) '~~~~~~~'
+           CALL iom_get( numror, 'frc_v', frc_v )
+           CALL iom_get( numror, 'frc_t', frc_t )
+           CALL iom_get( numror, 'frc_s', frc_s )
+           IF( ln_linssh ) THEN
+              CALL iom_get( numror, 'frc_wn_t', frc_wn_t )
+              CALL iom_get( numror, 'frc_wn_s', frc_wn_s )
+           ENDIF
+           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling
+           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) )
+           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) )
+           CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) )
+           CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) )
+           IF( ln_linssh ) THEN
+              CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) )
+              CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) )
+           ENDIF
+       ELSE
+          IF(lwp) WRITE(numout,*) '~~~~~~~'
+          IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '
+          IF(lwp) WRITE(numout,*) '~~~~~~~'
+          surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface
+          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh
+          DO jk = 1, jpk
+             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
+             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors
+             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content
+             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content
+          END DO
+          frc_v = 0._wp                                           ! volume       trend due to forcing
+          frc_t = 0._wp                                           ! heat content   -    -   -    -   
+          frc_s = 0._wp                                           ! salt content   -    -   -    -        
+          IF( ln_linssh ) THEN
+             IF ( ln_isfcav ) THEN
+                DO ji=1,jpi
+                   DO jj=1,jpj
+                      ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj)   ! initial heat content in ssh
+                      ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj)   ! initial salt content in ssh
+                   ENDDO
+                ENDDO
+             ELSE
+                ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh
+                ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh
+             END IF
+             frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface
+             frc_wn_s = 0._wp                                       ! initial salt content misfit due to free surface
+          ENDIF
+       ENDIF
+
+     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+        !                                   ! -------------------
+        IF(lwp) WRITE(numout,*) '~~~~~~~'
+        IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp
+        IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+        CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     )
+        CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     )
+        CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     )
+        IF( ln_linssh ) THEN
+           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )
+           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )
+        ENDIF
+        CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling
+        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) )
+        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) )
+        CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) )
+        CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) )
+        IF( ln_linssh ) THEN
+           CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) )
+           CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) )
+        ENDIF
+        !
+     ENDIF
+     !
+   END SUBROUTINE dia_hsb_rst
+
+
+   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
+      !!---------------------------------------------------------------------------
+      INTEGER ::   ierror   ! local integer
+      INTEGER ::   ios
+      !!
+      NAMELIST/namhsb/ ln_diahsb
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namhsb in reference namelist
+      READ  ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namhsb in configuration namelist
+      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namhsb )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_hsb_init'
+         WRITE(numout,*) '~~~~~~~~ '
+         WRITE(numout,*) '  check the heat and salt budgets (T) or not (F)       ln_diahsb = ', ln_diahsb
+      ENDIF
+      !
+      IF( .NOT. ln_diahsb )   RETURN
+
+      ! ------------------- !
+      ! 1 - Allocate memory !
+      ! ------------------- !
+      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
+         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' )   ;   RETURN
+      ENDIF
+
+      IF( ln_linssh )   ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' )   ;   RETURN
+      ENDIF
+
+      ! ----------------------------------------------- !
+      ! 2 - Time independant variables and file opening !
+      ! ----------------------------------------------- !
+      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area
+      surf_tot  = glob_sum( surf(:,:) )                   ! total ocean surface area
+
+      IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )         
+      !
+      ! ---------------------------------- !
+      ! 4 - initial conservation variables !
+      ! ---------------------------------- !
+      CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE dia_hsb_init
+
+   !!======================================================================
+END MODULE diahsb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 8732)
@@ -0,0 +1,350 @@
+MODULE diahth
+   !!======================================================================
+   !!                       ***  MODULE  diahth  ***
+   !! Ocean diagnostics: thermocline and 20 degree depth
+   !!======================================================================
+   !! History :  OPA  !  1994-09  (J.-P. Boulanger)  Original code
+   !!                 !  1996-11  (E. Guilyardi)  OPA8 
+   !!                 !  1997-08  (G. Madec)  optimization
+   !!                 !  1999-07  (E. Guilyardi)  hd28 + heat content 
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
+   !!----------------------------------------------------------------------
+#if   defined key_diahth
+   !!----------------------------------------------------------------------
+   !!   'key_diahth' :                              thermocline depth diag.
+   !!----------------------------------------------------------------------
+   !!   dia_hth      : Compute varius diagnostics associated with the mixed layer
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE iom             ! I/O library
+   USE timing          ! preformance summary
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_hth       ! routine called by step.F90
+   PUBLIC   dia_hth_alloc ! routine called by nemogcm.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 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth    !: depth of the max vertical temperature gradient [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20   !: depth of 20 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28   !: depth of 28 C isotherm                         [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3   !: heat content of first 300 m                    [W]
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION dia_hth_alloc()
+      !!---------------------------------------------------------------------
+      INTEGER :: dia_hth_alloc
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc )
+      !
+      IF( lk_mpp           )   CALL mpp_sum ( dia_hth_alloc )
+      IF(dia_hth_alloc /= 0)   CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.')
+      !
+   END FUNCTION dia_hth_alloc
+
+
+   SUBROUTINE dia_hth( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hth  ***
+      !!
+      !! ** Purpose : Computes
+      !!      the mixing layer depth (turbocline): avt = 5.e-4
+      !!      the depth of strongest vertical temperature gradient
+      !!      the mixed layer depth with density     criteria: rho = rho(10m or surf) + 0.03(or 0.01)
+      !!      the mixed layer depth with temperature criteria: abs( tn - tn(10m) ) = 0.2       
+      !!      the top of the thermochine: tn = tn(10m) - ztem2 
+      !!      the pycnocline depth with density criteria equivalent to a temperature variation 
+      !!                rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 
+      !!      the barrier layer thickness
+      !!      the maximal verical inversion of temperature and its depth max( 0, max of tn - tn(10m) )
+      !!      the depth of the 20 degree isotherm (linear interpolation)
+      !!      the depth of the 28 degree isotherm (linear interpolation)
+      !!      the heat content of first 300 m
+      !!
+      !! ** Method : 
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER                          ::   ji, jj, jk            ! dummy loop arguments
+      INTEGER                          ::   iid, ilevel           ! temporary integers
+      INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ik20, ik28  ! levels
+      REAL(wp)                         ::   zavt5 = 5.e-4_wp      ! Kz criterion for the turbocline depth
+      REAL(wp)                         ::   zrho3 = 0.03_wp       ! density     criterion for mixed layer depth
+      REAL(wp)                         ::   zrho1 = 0.01_wp       ! density     criterion for mixed layer depth
+      REAL(wp)                         ::   ztem2 = 0.2_wp        ! temperature criterion for mixed layer depth
+      REAL(wp)                         ::   zthick_0, zcoef       ! temporary scalars
+      REAL(wp)                         ::   zztmp, zzdep          ! temporary scalars inside do loop
+      REAL(wp)                         ::   zu, zv, zw, zut, zvt  ! temporary workspace
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2     
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho10_3   ! MLD: rho = rho10m + zrho3      
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zpycn      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztinv      ! max of temperature inversion
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdepinv    ! depth of temperature inversion
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho0_3    ! MLD rho = rho(surf) = 0.03
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho0_1    ! MLD rho = rho(surf) = 0.01
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zmaxdzT    ! max of dT/dz
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zthick     ! vertical integration thickness 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdelr      ! delta rho equivalent to deltaT = 0.2
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_hth')
+
+      IF( kt == nit000 ) THEN
+         !                                      ! allocate dia_hth array
+         IF( dia_hth_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' )
+
+         IF(.NOT. ALLOCATED(ik20) ) THEN
+            ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), &
+               &      zabs2(jpi,jpj),   &
+               &      ztm2(jpi,jpj),    &
+               &      zrho10_3(jpi,jpj),&
+               &      zpycn(jpi,jpj),   &
+               &      ztinv(jpi,jpj),   &
+               &      zdepinv(jpi,jpj), &
+               &      zrho0_3(jpi,jpj), &
+               &      zrho0_1(jpi,jpj), &
+               &      zmaxdzT(jpi,jpj), &
+               &      zthick(jpi,jpj),  &
+               &      zdelr(jpi,jpj), STAT=ji)
+            IF( lk_mpp  )   CALL mpp_sum(ji)
+            IF( ji /= 0 )   CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' )
+         END IF
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! initialization
+      ztinv  (:,:) = 0._wp  
+      zdepinv(:,:) = 0._wp  
+      zmaxdzT(:,:) = 0._wp  
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zztmp = bathy(ji,jj)
+            hth     (ji,jj) = zztmp
+            zabs2   (ji,jj) = zztmp
+            ztm2    (ji,jj) = zztmp
+            zrho10_3(ji,jj) = zztmp
+            zpycn   (ji,jj) = zztmp
+        END DO
+      END DO
+      IF( nla10 > 1 ) THEN 
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zztmp = bathy(ji,jj)
+               zrho0_3(ji,jj) = zztmp
+               zrho0_1(ji,jj) = zztmp
+            END DO
+         END DO
+      ENDIF
+      
+      ! Preliminary computation
+      ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,nla10) == 1. ) THEN
+               zu  =  1779.50 + 11.250 * tsn(ji,jj,nla10,jp_tem) - 3.80   * tsn(ji,jj,nla10,jp_sal)                             &
+                  &                                              - 0.0745 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)   &
+                  &                                              - 0.0100 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal)
+               zv  =  5891.00 + 38.000 * tsn(ji,jj,nla10,jp_tem) + 3.00   * tsn(ji,jj,nla10,jp_sal)                             &
+                  &                                              - 0.3750 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)
+               zut =    11.25 -  0.149 * tsn(ji,jj,nla10,jp_tem) - 0.01   * tsn(ji,jj,nla10,jp_sal)
+               zvt =    38.00 -  0.750 * tsn(ji,jj,nla10,jp_tem)
+               zw  = (zu + 0.698*zv) * (zu + 0.698*zv)
+               zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw)
+            ELSE
+               zdelr(ji,jj) = 0._wp
+            ENDIF
+         END DO
+      END DO
+
+      ! ------------------------------------------------------------- !
+      ! thermocline depth: strongest vertical gradient of temperature !
+      ! turbocline depth (mixing layer depth): avt = zavt5            !
+      ! MLD: rho = rho(1) + zrho3                                     !
+      ! MLD: rho = rho(1) + zrho1                                     !
+      ! ------------------------------------------------------------- !
+      DO jk = jpkm1, 2, -1   ! loop from bottom to 2
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               zzdep = gdepw_n(ji,jj,jk)
+               zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz)
+               zzdep = zzdep * tmask(ji,jj,1)
+
+               IF( zztmp > zmaxdzT(ji,jj) ) THEN                        
+                  zmaxdzT(ji,jj) = zztmp   ;   hth    (ji,jj) = zzdep                ! max and depth of dT/dz
+               ENDIF
+               
+               IF( nla10 > 1 ) THEN 
+                  zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1)                             ! delta rho(1)
+                  IF( zztmp > zrho3 )          zrho0_3(ji,jj) = zzdep                ! > 0.03
+                  IF( zztmp > zrho1 )          zrho0_1(ji,jj) = zzdep                ! > 0.01
+               ENDIF
+
+            END DO
+         END DO
+      END DO
+      
+      CALL iom_put( "mlddzt", hth )            ! depth of the thermocline
+      IF( nla10 > 1 ) THEN 
+         CALL iom_put( "mldr0_3", zrho0_3 )   ! MLD delta rho(surf) = 0.03
+         CALL iom_put( "mldr0_1", zrho0_1 )   ! MLD delta rho(surf) = 0.01
+      ENDIF
+
+      ! ------------------------------------------------------------- !
+      ! MLD: abs( tn - tn(10m) ) = ztem2                              !
+      ! Top of thermocline: tn = tn(10m) - ztem2                      !
+      ! MLD: rho = rho10m + zrho3                                     !
+      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC)       !
+      ! temperature inversion: max( 0, max of tn - tn(10m) )          !
+      ! depth of temperature inversion                                !
+      ! ------------------------------------------------------------- !
+      DO jk = jpkm1, nlb10, -1   ! loop from bottom to nlb10
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               zzdep = gdepw_n(ji,jj,jk) * tmask(ji,jj,1)
+               !
+               zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m)
+               IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2
+               IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2
+               zztmp = -zztmp                                          ! delta T(10m)
+               IF( zztmp >  ztinv(ji,jj) ) THEN                        ! temperature inversion
+                  ztinv(ji,jj) = zztmp   ;   zdepinv (ji,jj) = zzdep   ! max value and depth
+               ENDIF
+
+               zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10)              ! delta rho(10m)
+               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
+      END DO
+
+      CALL iom_put( "mld_dt02", zabs2        )   ! MLD abs(delta t) - 0.2
+      CALL iom_put( "topthdep", ztm2         )   ! T(10) - 0.2
+      CALL iom_put( "mldr10_3", zrho10_3     )   ! MLD delta rho(10m) = 0.03
+      CALL iom_put( "pycndep" , zpycn        )   ! MLD delta rho equi. delta T(10m) = 0.2
+      CALL iom_put( "tinv"    , ztinv        )   ! max. temp. inv. (t10 ref) 
+      CALL iom_put( "depti"   , zdepinv      )   ! depth of max. temp. inv. (t10 ref) 
+
+
+      ! ----------------------------------- !
+      ! search deepest level above 20C/28C  !
+      ! ----------------------------------- !
+      ik20(:,:) = 1
+      ik28(:,:) = 1
+      DO jk = 1, jpkm1   ! beware temperature is not always decreasing with depth => loop from top to bottom
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zztmp = tsn(ji,jj,jk,jp_tem)
+               IF( zztmp >= 20. )   ik20(ji,jj) = jk
+               IF( zztmp >= 28. )   ik28(ji,jj) = jk
+            END DO
+         END DO
+      END DO
+
+      ! --------------------------- !
+      !  Depth of 20C/28C isotherm  !
+      ! --------------------------- !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zzdep = gdepw_n(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom
+            !
+            iid = ik20(ji,jj)
+            IF( iid /= 1 ) THEN 
+               zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation
+                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
+                  &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   &
+                  &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
+               hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth
+            ELSE 
+               hd20(ji,jj) = 0._wp
+            ENDIF
+            !
+            iid = ik28(ji,jj)
+            IF( iid /= 1 ) THEN 
+               zztmp =      gdept_n(ji,jj,iid  )   &                     ! linear interpolation
+                  &  + (    gdept_n(ji,jj,iid+1) - gdept_n(ji,jj,iid)                       )   &
+                  &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   &
+                  &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) )
+               hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1)      ! bound by the ocean depth
+            ELSE 
+               hd28(ji,jj) = 0._wp
+            ENDIF
+
+         END DO
+      END DO
+      CALL iom_put( "20d", hd20 )   ! depth of the 20 isotherm
+      CALL iom_put( "28d", hd28 )   ! depth of the 28 isotherm
+
+      ! ----------------------------- !
+      !  Heat content of first 300 m  !
+      ! ----------------------------- !
+
+      ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_1d to do this search...)
+      ilevel   = 0
+      zthick_0 = 0._wp
+      DO jk = 1, jpkm1                      
+         zthick_0 = zthick_0 + e3t_1d(jk)
+         IF( zthick_0 < 300. )   ilevel = jk
+      END DO
+      ! surface boundary condition
+      IF( ln_linssh ) THEN   ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)  
+      ELSE                   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                   
+      ENDIF
+      ! integration down to ilevel
+      DO jk = 1, ilevel
+         zthick(:,:) = zthick(:,:) + e3t_n(:,:,jk)
+         htc3  (:,:) = htc3  (:,:) + e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk)
+      END DO
+      ! deepest layer
+      zthick(:,:) = 300. - zthick(:,:)   !   remaining thickness to reach 300m
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem)                  &
+               &                      * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1)
+         END DO
+      END DO
+      ! from temperature to heat contain
+      zcoef = rau0 * rcp
+      htc3(:,:) = zcoef * htc3(:,:)
+      CALL iom_put( "hc300", htc3 )      ! first 300m heat content
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_hth')
+      !
+   END SUBROUTINE dia_hth
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_diahth = .FALSE.  !: thermocline-20d depths flag
+CONTAINS
+   SUBROUTINE dia_hth( kt )         ! Empty routine
+      WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt
+   END SUBROUTINE dia_hth
+#endif
+
+   !!======================================================================
+END MODULE diahth
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 8732)
@@ -0,0 +1,136 @@
+MODULE dianam
+   !!======================================================================
+   !!                       ***  MODULE  dianam  ***
+   !! Ocean diagnostics:  Builds output file name
+   !!=====================================================================
+   !! History :  OPA  ! 1999-02  (E. Guilyardi)  Creation for 30 days/month
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  ! 2009-11  (S. Masson) complete rewriting, works for all calendars...
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dia_nam       : Builds output file name
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE ioipsl, ONLY :  ju2ymds    ! for calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dia_nam
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_nam( cdfnam, kfreq, cdsuff, ldfsec )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_nam  ***
+      !!                   
+      !! ** Purpose :   Builds output file name
+      !!
+      !! ** Method  :   File name is a function of date and output frequency
+      !!      cdfnam=<cexper>_<clave>_<idtbeg>_<idtend>_<cdsuff>
+      !!      <clave> = averaging frequency (DA, MO, etc...)
+      !!      <idtbeg>,<idtend> date of beginning and end of run
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER (len=*), INTENT(  out)           ::   cdfnam   ! file name
+      CHARACTER (len=*), INTENT(in   )           ::   cdsuff   ! to be added at the end of the file name
+      INTEGER          , INTENT(in   )           ::   kfreq    ! output frequency: > 0 in time-step (or seconds see ldfsec)
+      !                                                                            < 0 in months
+      !                                                                            = 0 no frequency
+      LOGICAL          , INTENT(in   ), OPTIONAL ::   ldfsec   ! kfreq in second(in time-step) if .true.(.false. default)
+      !
+      CHARACTER (len=20) ::   clfmt, clfmt0                    ! writing format
+      CHARACTER (len=20) ::   clave                            ! name for output frequency
+      CHARACTER (len=20) ::   cldate1                          ! date of the beginning of run
+      CHARACTER (len=20) ::   cldate2                          ! date of the end       of run
+      LOGICAL            ::   llfsec                           ! local value of ldfsec
+      INTEGER            ::   iyear1, imonth1, iday1           ! year, month, day of the first day of the run
+      INTEGER            ::   iyear2, imonth2, iday2           ! year, month, day of the last  day of the run
+      INTEGER            ::   indg                             ! number of digits needed to write a number     
+      INTEGER            ::   inbsec, inbmn, inbhr             ! output frequency in seconds, minutes and hours
+      INTEGER            ::   inbday, inbmo, inbyr             ! output frequency in days, months and years
+      INTEGER            ::   iyyss, iddss, ihhss, immss       ! number of seconds in 1 year, 1 day, 1 hour and 1 minute
+      INTEGER            ::   iyymo                            ! number of months in 1 year
+      REAL(wp)           ::   zsec1, zsec2                     ! not used
+      REAL(wp)           ::   zdrun, zjul                      ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      ! name for output frequency
+
+      IF( PRESENT(ldfsec) ) THEN   ;   llfsec = ldfsec
+      ELSE                         ;   llfsec = .FALSE.
+      ENDIF
+
+      IF( llfsec .OR. kfreq < 0 ) THEN   ;   inbsec = kfreq                       ! output frequency already in seconds
+      ELSE                               ;   inbsec = kfreq * NINT( rdt )   ! from time-step to seconds
+      ENDIF
+      iddss = NINT( rday          )                                         ! number of seconds in 1 day
+      ihhss = NINT( rmmss * rhhmm )                                         ! number of seconds in 1 hour
+      immss = NINT( rmmss         )                                         ! number of seconds in 1 minute
+      iyymo = NINT( raamo         )                                         ! number of months  in 1 year
+      iyyss = iddss * nyear_len(1)                                          ! seconds in 1 year (not good: multi years with leap)
+      clfmt0 = "('(a,i',i1,',a)')"                                          ! format '(a,ix,a)' with x to be defined
+      ! 
+      IF(          inbsec == 0           ) THEN   ;   clave = ''            ! no frequency
+      ELSEIF(      inbsec <  0           ) THEN        
+         inbmo = -inbsec                                                    ! frequency in month
+         IF( MOD( inbmo, iyymo  ) == 0 ) THEN                               ! frequency in years
+            inbyr  = inbmo / iyymo
+            indg   = INT(LOG10(REAL(inbyr,wp))) + 1                         ! number of digits needed to write years   frequency
+            WRITE(clfmt, clfmt0) indg             ;   WRITE(clave, clfmt) '_', inbyr , 'y'
+         ELSE                                                               ! frequency in month
+            indg   = INT(LOG10(REAL(inbmo,wp))) + 1                         ! number of digits needed to write months  frequency
+            WRITE(clfmt, clfmt0) indg             ;   WRITE(clave, clfmt) '_', inbmo, 'm'
+         ENDIF
+      ELSEIF( MOD( inbsec, iyyss  ) == 0 ) THEN                             ! frequency in years
+         inbyr  = inbsec / iyyss
+         indg   = INT(LOG10(REAL(inbyr ,wp))) + 1                           ! number of digits needed to write years   frequency
+         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbyr , 'y'
+      ELSEIF( MOD( inbsec, iddss  ) == 0 ) THEN                             ! frequency in days
+         inbday = inbsec / iddss
+         indg   = INT(LOG10(REAL(inbday,wp))) + 1                           ! number of digits needed to write days    frequency
+         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbday, 'd'
+         IF( inbday == nmonth_len(nmonth) )           clave = '_1m'
+      ELSEIF( MOD( inbsec, ihhss ) == 0 ) THEN                              ! frequency in hours
+         inbhr  = inbsec / ihhss
+         indg   = INT(LOG10(REAL(inbhr ,wp))) + 1                           ! number of digits needed to write hours   frequency
+         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbhr , 'h'
+      ELSEIF( MOD( inbsec, immss ) == 0 ) THEN                              ! frequency in minutes
+         inbmn  = inbsec / immss
+         indg   = INT(LOG10(REAL(inbmn ,wp))) + 1                           ! number of digits needed to write minutes frequency
+         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbmn , 'mn'
+      ELSE                                                                  ! frequency in seconds
+         indg   = INT(LOG10(REAL(inbsec,wp))) + 1                           ! number of digits needed to write seconds frequency
+         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbsec, 's'
+      ENDIF
+
+      ! date of the beginning and the end of the run
+
+      zdrun = rdt / rday * REAL( nitend - nit000, wp )                ! length of the run in days
+      zjul  = fjulday - rdt / rday
+      CALL ju2ymds( zjul        , iyear1, imonth1, iday1, zsec1 )           ! year/month/day of the beginning of run
+      CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 )           ! year/month/day of the end       of run
+
+      IF( iyear2 < 10000 ) THEN   ;   clfmt = "(i4.4,2i2.2)"                ! format used to write the date 
+      ELSE                        ;   WRITE(clfmt, "('(i',i1,',2i2.2)')") INT(LOG10(REAL(iyear2,wp))) + 1
+      ENDIF
+
+      WRITE(cldate1, clfmt) iyear1, imonth1, iday1                          ! date of the beginning of run
+      WRITE(cldate2, clfmt) iyear2, imonth2, iday2                          ! date of the end       of run
+ 
+      cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff)
+      IF( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam)
+
+   END SUBROUTINE dia_nam
+
+   !!======================================================================
+END MODULE dianam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 8732)
@@ -0,0 +1,705 @@
+MODULE diaptr
+   !!======================================================================
+   !!                       ***  MODULE  diaptr  ***
+   !! Ocean physics:  Computes meridonal transports and zonal means
+   !!=====================================================================
+   !! History :  1.0  ! 2003-09  (C. Talandier, G. Madec)  Original code
+   !!            2.0  ! 2006-01  (A. Biastoch)  Allow sub-basins computation
+   !!            3.2  ! 2010-03  (O. Marti, S. Flavoni) Add fields
+   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation
+   !!            3.6  ! 2014-12  (C. Ethe) use of IOM
+   !!            3.6  ! 2016-06  (T. Graham) Addition of diagnostics for CMIP6
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dia_ptr      : Poleward Transport Diagnostics module
+   !!   dia_ptr_init : Initialization, namelist read
+   !!   ptr_sjk      : "zonal" mean computation of a field - tracer or flux array
+   !!   ptr_sj       : "zonal" and vertical sum computation of a "meridional" flux array
+   !!                   (Generic interface to ptr_sj_3d, ptr_sj_2d)
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and active tracers
+   USE dom_oce          ! ocean space and time domain
+   USE phycst           ! physical constants
+   !
+   USE iom              ! IOM library
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE timing           ! preformance summary
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE ptr_sj
+      MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d
+   END INTERFACE
+
+   PUBLIC   ptr_sj         ! call by tra_ldf & tra_adv routines
+   PUBLIC   ptr_sjk        ! 
+   PUBLIC   dia_ptr_init   ! call in step module
+   PUBLIC   dia_ptr        ! call in step module
+   PUBLIC   dia_ptr_hst    ! called from tra_ldf/tra_adv routines
+
+   !                                  !!** namelist  namptr  **
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv   !: Heat TRansports (adv, diff, Bolus.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv   !: Salt TRansports (adv, diff, Bolus.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic )
+
+   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F)
+   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation
+   INTEGER, PUBLIC ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 
+
+   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup
+   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
+
+   CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:)     :: clsubb
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk   ! T-point basin interior masks
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   :: btm30   ! mask out Southern Ocean (=0 south of 30°S)
+
+   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:)     :: p_fval1d
+   REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:)   :: p_fval2d
+
+   !! * Substitutions
+#  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_ptr( pvtr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr  ***
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zsfc,zvfc               ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace
+      REAL(wp), DIMENSION(jpj)     ::  vsum   ! 1D workspace
+      REAL(wp), DIMENSION(jpj,jpts)     ::  tssum   ! 1D workspace
+ 
+      !
+      !overturning calculation
+      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse
+      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace
+
+
+      CHARACTER( len = 12 )  :: cl1
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dia_ptr')
+
+      !
+      IF( PRESENT( pvtr ) ) THEN
+         IF( iom_use("zomsfglo") ) THEN    ! effective MSF
+            z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) )  ! zonal cumulative effective transport
+            DO jk = 2, jpkm1 
+              z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)   ! effective j-Stream-Function (MSF)
+            END DO
+            DO ji = 1, jpi
+               z3d(ji,:,:) = z3d(1,:,:)
+            ENDDO
+            cl1 = TRIM('zomsf'//clsubb(1) )
+            CALL iom_put( cl1, z3d * rc_sv )
+            DO jn = 2, nptr                                    ! by sub-basins
+               z3d(1,:,:) =  ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 
+               DO jk = 2, jpkm1 
+                  z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk)    ! effective j-Stream-Function (MSF)
+               END DO
+               DO ji = 1, jpi
+                  z3d(ji,:,:) = z3d(1,:,:)
+               ENDDO
+               cl1 = TRIM('zomsf'//clsubb(jn) )
+               CALL iom_put( cl1, z3d * rc_sv )
+            END DO
+         ENDIF
+         IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN
+            ! define fields multiplied by scalar
+            zmask(:,:,:) = 0._wp
+            zts(:,:,:,:) = 0._wp
+            zvn(:,:,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpi
+                     zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk)
+                     zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc
+                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid
+                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc
+                     zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc
+                  ENDDO
+               ENDDO
+             ENDDO
+         ENDIF
+         IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN
+             sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) )
+             r1_sjk(:,:,1) = 0._wp
+             WHERE( sjk(:,:,1) /= 0._wp )   r1_sjk(:,:,1) = 1._wp / sjk(:,:,1)
+
+             ! i-mean T and S, j-Stream-Function, global
+             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1)
+             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1)
+             v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) )
+
+             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 )
+             str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 )
+
+             z2d(1,:) = htr_ove(:,1) * rc_pwatt        !  (conversion in PW)
+             DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+             ENDDO
+             cl1 = 'sophtove'
+             CALL iom_put( TRIM(cl1), z2d )
+             z2d(1,:) = str_ove(:,1) * rc_ggram        !  (conversion in Gg)
+             DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+             ENDDO
+             cl1 = 'sopstove'
+             CALL iom_put( TRIM(cl1), z2d )
+             IF( ln_subbas ) THEN
+                DO jn = 2, nptr
+                    sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
+                    r1_sjk(:,:,jn) = 0._wp
+                    WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
+
+                    ! i-mean T and S, j-Stream-Function, basin
+                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
+                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
+                    v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 
+                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 )
+                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 )
+
+                    z2d(1,:) = htr_ove(:,jn) * rc_pwatt !  (conversion in PW)
+                    DO ji = 1, jpi
+                        z2d(ji,:) = z2d(1,:)
+                    ENDDO
+                    cl1 = TRIM('sophtove_'//clsubb(jn))
+                    CALL iom_put( cl1, z2d )
+                    z2d(1,:) = str_ove(:,jn) * rc_ggram        ! (conversion in Gg)
+                    DO ji = 1, jpi
+                        z2d(ji,:) = z2d(1,:)
+                    ENDDO
+                    cl1 = TRIM('sopstove_'//clsubb(jn))
+                    CALL iom_put( cl1, z2d )
+                END DO
+             ENDIF
+         ENDIF
+         IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN
+         ! Calculate barotropic heat and salt transport here 
+             sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) )
+             r1_sjk(:,1,1) = 0._wp
+             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1)
+            
+            vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1))
+            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) )
+            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) )
+            htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1)
+            str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1)
+            z2d(1,:) = htr_btr(:,1) * rc_pwatt        !  (conversion in PW)
+            DO ji = 2, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sophtbtr'
+            CALL iom_put( TRIM(cl1), z2d )
+            z2d(1,:) = str_btr(:,1) * rc_ggram        !  (conversion in Gg)
+            DO ji = 2, jpi
+              z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sopstbtr'
+            CALL iom_put( TRIM(cl1), z2d )
+            IF( ln_subbas ) THEN
+                DO jn = 2, nptr
+                    sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) )
+                    r1_sjk(:,1,jn) = 0._wp
+                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn)
+                    vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn))
+                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) )
+                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) )
+                    htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn)
+                    str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn)
+                    z2d(1,:) = htr_btr(:,jn) * rc_pwatt !  (conversion in PW)
+                    DO ji = 1, jpi
+                        z2d(ji,:) = z2d(1,:)
+                    ENDDO
+                    cl1 = TRIM('sophtbtr_'//clsubb(jn))
+                    CALL iom_put( cl1, z2d )
+                    z2d(1,:) = str_btr(:,jn) * rc_ggram        ! (conversion in Gg)
+                    DO ji = 1, jpi
+                        z2d(ji,:) = z2d(1,:)
+                    ENDDO
+                    cl1 = TRIM('sopstbtr_'//clsubb(jn))
+                    CALL iom_put( cl1, z2d )
+               ENDDO
+            ENDIF !ln_subbas
+         ENDIF !iom_use("sopstbtr....)
+         !
+      ELSE
+         !
+         IF( iom_use("zotemglo") ) THEN    ! i-mean i-k-surface 
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zsfc = e1t(ji,jj) * e3t_n(ji,jj,jk)
+                     zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc
+                     zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc
+                     zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc
+                  END DO
+               END DO
+            END DO
+            DO jn = 1, nptr
+               zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
+               cl1 = TRIM('zosrf'//clsubb(jn) )
+               CALL iom_put( cl1, zmask )
+               !
+               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) &
+                  &            / MAX( zmask(1,:,:), 10.e-15 )
+               DO ji = 1, jpi
+                  z3d(ji,:,:) = z3d(1,:,:)
+               ENDDO
+               cl1 = TRIM('zotem'//clsubb(jn) )
+               CALL iom_put( cl1, z3d )
+               !
+               z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) &
+                  &            / MAX( zmask(1,:,:), 10.e-15 )
+               DO ji = 1, jpi
+                  z3d(ji,:,:) = z3d(1,:,:)
+               ENDDO
+               cl1 = TRIM('zosal'//clsubb(jn) )
+               CALL iom_put( cl1, z3d )
+            END DO
+         ENDIF
+         !
+         !                                ! Advective and diffusive heat and salt transport
+         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN   
+            z2d(1,:) = htr_adv(:,1) * rc_pwatt        !  (conversion in PW)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sophtadv'                 
+            CALL iom_put( TRIM(cl1), z2d )
+            z2d(1,:) = str_adv(:,1) * rc_ggram        ! (conversion in Gg)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sopstadv'
+            CALL iom_put( TRIM(cl1), z2d )
+            IF( ln_subbas ) THEN
+              DO jn=2,nptr
+               z2d(1,:) = htr_adv(:,jn) * rc_pwatt        !  (conversion in PW)
+               DO ji = 1, jpi
+                 z2d(ji,:) = z2d(1,:)
+               ENDDO
+               cl1 = TRIM('sophtadv_'//clsubb(jn))                 
+               CALL iom_put( cl1, z2d )
+               z2d(1,:) = str_adv(:,jn) * rc_ggram        ! (conversion in Gg)
+               DO ji = 1, jpi
+                  z2d(ji,:) = z2d(1,:)
+               ENDDO
+               cl1 = TRIM('sopstadv_'//clsubb(jn))                 
+               CALL iom_put( cl1, z2d )              
+              ENDDO
+            ENDIF
+         ENDIF
+         !
+         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN   
+            z2d(1,:) = htr_ldf(:,1) * rc_pwatt        !  (conversion in PW) 
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sophtldf'
+            CALL iom_put( TRIM(cl1), z2d )
+            z2d(1,:) = str_ldf(:,1) * rc_ggram        !  (conversion in Gg)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sopstldf'
+            CALL iom_put( TRIM(cl1), z2d )
+            IF( ln_subbas ) THEN
+              DO jn=2,nptr
+               z2d(1,:) = htr_ldf(:,jn) * rc_pwatt        !  (conversion in PW)
+               DO ji = 1, jpi
+                 z2d(ji,:) = z2d(1,:)
+               ENDDO
+               cl1 = TRIM('sophtldf_'//clsubb(jn))                 
+               CALL iom_put( cl1, z2d )
+               z2d(1,:) = str_ldf(:,jn) * rc_ggram        ! (conversion in Gg)
+               DO ji = 1, jpi
+                  z2d(ji,:) = z2d(1,:)
+               ENDDO
+               cl1 = TRIM('sopstldf_'//clsubb(jn))                 
+               CALL iom_put( cl1, z2d )              
+              ENDDO
+            ENDIF
+         ENDIF
+
+         IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 
+            z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW) 
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sophteiv'
+            CALL iom_put( TRIM(cl1), z2d )
+            z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg)
+            DO ji = 1, jpi
+               z2d(ji,:) = z2d(1,:)
+            ENDDO
+            cl1 = 'sopsteiv'
+            CALL iom_put( TRIM(cl1), z2d )
+            IF( ln_subbas ) THEN
+               DO jn=2,nptr
+                  z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW)
+                  DO ji = 1, jpi
+                     z2d(ji,:) = z2d(1,:)
+                  ENDDO
+                  cl1 = TRIM('sophteiv_'//clsubb(jn))                 
+                  CALL iom_put( cl1, z2d )
+                  z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg)
+                  DO ji = 1, jpi
+                     z2d(ji,:) = z2d(1,:)
+                  ENDDO
+                  cl1 = TRIM('sopsteiv_'//clsubb(jn)) 
+                  CALL iom_put( cl1, z2d )              
+               ENDDO
+            ENDIF
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr')
+      !
+   END SUBROUTINE dia_ptr
+
+
+   SUBROUTINE dia_ptr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr_init  ***
+      !!                   
+      !! ** Purpose :   Initialization, namelist read
+      !!----------------------------------------------------------------------
+      INTEGER ::  jn           ! local integers
+      INTEGER ::  inum, ierr   ! local integers
+      INTEGER ::  ios          ! Local integer output status for namelist read
+      !!
+      NAMELIST/namptr/ ln_diaptr, ln_subbas
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namptr in reference namelist : Poleward transport
+      READ  ( numnam_ref, namptr, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport
+      READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, 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,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr
+         WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas
+      ENDIF
+
+      IF( ln_diaptr ) THEN  
+         !
+         IF( ln_subbas ) THEN 
+            nptr = 5            ! Global, Atlantic, Pacific, Indian, Indo-Pacific
+            ALLOCATE( clsubb(nptr) )
+            clsubb(1) = 'glo' ;  clsubb(2) = 'atl'  ;  clsubb(3) = 'pac'  ;  clsubb(4) = 'ind'  ;  clsubb(5) = 'ipc'
+         ELSE               
+            nptr = 1       ! Global only
+            ALLOCATE( clsubb(nptr) )
+            clsubb(1) = 'glo' 
+         ENDIF
+
+         !                                      ! allocate dia_ptr arrays
+         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' )
+
+         rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt
+
+         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum
+
+         IF( ln_subbas ) THEN                ! load sub-basin mask
+            CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  )
+            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(:,:) = ssmask(:,:)
+            END WHERE
+         ENDIF
+   
+         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean
+      
+         DO jn = 1, nptr
+            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only
+         END DO
+
+         ! Initialise arrays to zero because diatpr is called before they are first calculated
+         ! Note that this means diagnostics will not be exactly correct when model run is restarted.
+         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp 
+         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp 
+         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp 
+         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp
+         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp
+         !
+      ENDIF 
+      ! 
+   END SUBROUTINE dia_ptr_init
+
+   SUBROUTINE dia_ptr_hst( ktra, cptr, pva ) 
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ptr_hst ***
+      !!----------------------------------------------------------------------
+      !! Wrapper for heat and salt transport calculations to calculate them for each basin
+      !! Called from all advection and/or diffusion routines
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in )  :: ktra  ! tracer index
+      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv'
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion
+      INTEGER                                        :: jn    !
+
+      IF( cptr == 'adv' ) THEN
+         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) )
+         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) )
+      ENDIF
+      IF( cptr == 'ldf' ) THEN
+         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) )
+         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) )
+      ENDIF
+      IF( cptr == 'eiv' ) THEN
+         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) )
+         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) )
+      ENDIF
+      !
+      IF( ln_subbas ) THEN
+         !
+         IF( cptr == 'adv' ) THEN
+             IF( ktra == jp_tem ) THEN 
+                DO jn = 2, nptr
+                   htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+                END DO
+             ENDIF
+             IF( ktra == jp_sal ) THEN 
+                DO jn = 2, nptr
+                   str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+                END DO
+             ENDIF
+         ENDIF
+         IF( cptr == 'ldf' ) THEN
+             IF( ktra == jp_tem ) THEN 
+                DO jn = 2, nptr
+                    htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+                 END DO
+             ENDIF
+             IF( ktra == jp_sal ) THEN 
+                DO jn = 2, nptr
+                   str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+                END DO
+             ENDIF
+         ENDIF
+         IF( cptr == 'eiv' ) THEN
+             IF( ktra == jp_tem ) THEN 
+                DO jn = 2, nptr
+                    htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+                 END DO
+             ENDIF
+             IF( ktra == jp_sal ) THEN 
+                DO jn = 2, nptr
+                   str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) )
+                END DO
+             ENDIF
+         ENDIF
+         !
+      ENDIF
+   END SUBROUTINE dia_ptr_hst
+
+
+   FUNCTION dia_ptr_alloc()
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ptr_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER               ::   dia_ptr_alloc   ! return value
+      INTEGER, DIMENSION(3) ::   ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( btmsk(jpi,jpj,nptr) ,              &
+         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   &
+         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   &
+         &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   &
+         &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   &
+         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  )
+         !
+      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2))
+      !
+      ALLOCATE( btm30(jpi,jpj), STAT=ierr(3)  )
+
+         !
+      dia_ptr_alloc = MAXVAL( ierr )
+      IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc )
+      !
+   END FUNCTION dia_ptr_alloc
+
+
+   FUNCTION ptr_sj_3d( pva, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_sj_3d  ***
+      !!
+      !! ** Purpose :   i-k sum computation of a j-flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk)       ::   pva   ! mask flux array at V-point
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !
+      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
+      INTEGER                  ::   ijpj         ! ???
+      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value
+      !!--------------------------------------------------------------------
+      !
+      p_fval => p_fval1d
+
+      ijpj = jpj
+      p_fval(:) = 0._wp
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! Vector opt.
+                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj)
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! Vector opt.
+                  p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
+               END DO
+            END DO
+         END DO
+      ENDIF
+#if defined key_mpp_mpi
+      IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl)
+#endif
+      !
+   END FUNCTION ptr_sj_3d
+
+
+   FUNCTION ptr_sj_2d( pva, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_sj_2d  ***
+      !!
+      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)           ::   pva   ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !
+      INTEGER                  ::   ji,jj       ! dummy loop arguments
+      INTEGER                  ::   ijpj        ! ???
+      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
+      !!--------------------------------------------------------------------
+      ! 
+      p_fval => p_fval1d
+
+      ijpj = jpj
+      p_fval(:) = 0._wp
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jj = 2, jpjm1
+            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
+               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
+               p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+      ENDIF
+#if defined key_mpp_mpi
+      CALL mpp_sum( p_fval, ijpj, ncomm_znl )
+#endif
+      ! 
+   END FUNCTION ptr_sj_2d
+
+
+   FUNCTION ptr_sjk( pta, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_sjk  ***
+      !!
+      !! ** Purpose :   i-sum computation of an array
+      !!
+      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
+      !!
+      !! ** Action  : - p_fval: i-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      !!
+      IMPLICIT none
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pta    ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !!
+      INTEGER                           :: ji, jj, jk ! dummy loop arguments
+      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value
+#if defined key_mpp_mpi
+      INTEGER, DIMENSION(1) ::   ish
+      INTEGER, DIMENSION(2) ::   ish2
+      INTEGER               ::   ijpjjpk
+      REAL(wp), DIMENSION(jpj*jpk) ::   zwork    ! mask flux array at V-point
+#endif
+      !!--------------------------------------------------------------------
+      !
+      p_fval => p_fval2d
+
+      p_fval(:,:) = 0._wp
+      !
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei....
+               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj)
+               END DO
+            END DO
+         END DO
+      ELSE 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+                  p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+      END IF
+      !
+#if defined key_mpp_mpi
+      ijpjjpk = jpj*jpk
+      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk
+      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )
+      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
+      p_fval(:,:) = RESHAPE( zwork, ish2 )
+#endif
+      !
+   END FUNCTION ptr_sjk
+
+
+   !!======================================================================
+END MODULE diaptr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90	(revision 8732)
@@ -0,0 +1,143 @@
+MODULE diatmb 
+   !!======================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents 
+   !!======================================================================
+   !! History :  3.6  !  08-2014  (E O'Dea)  Original code
+   !!            3.7  !  05-2016  (G. Madec)  use mbkt, mikt to account for ocean cavities
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   !
+   USE in_out_manager  ! I/O units
+   USE iom             ! I/0 library
+   USE wrk_nemo        ! working arrays
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output 
+   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
+   PUBLIC   dia_tmb                 ! routine called by diawri.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
+   !! $Id:$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_tmb_init 
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_tmb_init  ***
+      !!     
+      !! ** Purpose :   Initialization of tmb namelist 
+      !!        
+      !! ** Method  :   Read namelist
+      !!---------------------------------------------------------------------------
+      INTEGER ::   ios                 ! Local integer output status for namelist read
+      !
+      NAMELIST/nam_diatmb/ ln_diatmb
+      !!----------------------------------------------------------------------
+      !
+      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
+      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
+ 
+      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
+      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_diatmb )
+
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
+         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
+      ENDIF
+      !
+   END SUBROUTINE dia_tmb_init
+
+
+   SUBROUTINE dia_calctmb( pfield, ptmb )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_tmb  ***
+      !!                   
+      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
+      !!
+      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of 
+      !!              model levels due to potential existence of ocean cavities
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) :: pfield   ! Input 3d field and mask
+      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) :: ptmb     ! top, middle, bottom extracted from pfield
+      !
+      INTEGER  ::   ji, jj  ! Dummy loop indices
+      INTEGER  ::   itop, imid, ibot  ! local integers
+      REAL(wp) ::   zmdi = 1.e+20_wp  ! land value
+      !!---------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            itop = mikt(ji,jj)                        ! top    ocean 
+            ibot = mbkt(ji,jj)                        ! bottom ocean 
+            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean          
+            !                    
+            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop)  + zmdi*( 1._wp-tmask(ji,jj,itop) )
+            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid)  + zmdi*( 1._wp-tmask(ji,jj,imid) )
+            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot)  + zmdi*( 1._wp-tmask(ji,jj,ibot) )
+         END DO
+      END DO
+      !
+   END SUBROUTINE dia_calctmb
+
+
+   SUBROUTINE dia_tmb
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_tmb  ***
+      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
+      !!
+      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels
+      !!      calls calctmb to retrieve TMB values before sending to iom_put
+      !!
+      !!--------------------------------------------------------------------
+      REAL(wp) ::   zmdi =1.e+20     ! land value
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! workspace 
+      !!--------------------------------------------------------------------
+      !
+      IF (ln_diatmb) THEN
+         CALL wrk_alloc( jpi,jpj,3   , zwtmb )
+         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
+         !ssh already output but here we output it masked
+         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
+         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
+         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
+         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
+!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
+
+         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
+         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity 
+         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
+         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
+
+         CALL dia_calctmb(  un(:,:,:),zwtmb )
+         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
+         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
+         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
+!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
+
+         CALL dia_calctmb(  vn(:,:,:),zwtmb )
+         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
+         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
+         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
+!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
+         CALL wrk_dealloc( jpi,jpj,3   , zwtmb )
+      ELSE
+         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
+      ENDIF
+      !
+   END SUBROUTINE dia_tmb
+   !!======================================================================
+END MODULE diatmb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 8732)
@@ -0,0 +1,1076 @@
+MODULE diawri
+   !!======================================================================
+   !!                     ***  MODULE  diawri  ***
+   !! Ocean diagnostics :  write ocean output files
+   !!=====================================================================
+   !! 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
+   !!            3.7  ! 2014-01  (G. Madec) remove eddy induced velocity from no-IOM output
+   !!                 !                     change name of output variables in dia_wri_state
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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
+   USE dynadv, ONLY: ln_dynadv_vec
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra          ! lateral physics: eddy diffusivity coef.
+   USE ldfdyn          ! lateral physics: eddy viscosity   coef.
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE icb_oce         ! Icebergs
+   USE icbdia          ! Iceberg budgets
+   USE sbcssr          ! restoring term toward SST/SSS climatology
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer
+   USE dianam          ! build name of file (routine)
+   USE zdfddm          ! vertical  physics: double diffusion
+   USE diahth          ! thermocline diagnostics
+   USE wet_dry         ! wetting and drying
+   USE sbcwave         ! wave parameters
+   !
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE diatmb          ! Top,middle,bottom output
+   USE dia25h          ! 25h Mean output
+   USE iom
+   USE ioipsl
+
+#if defined key_lim2
+   USE limwri_2 
+#elif defined key_lim3
+   USE limwri 
+#endif
+   USE lib_mpp         ! MPP library
+   USE timing          ! preformance summary
+   USE diurnal_bulk    ! diurnal warm layer
+   USE cool_skin       ! Cool skin
+   USE wrk_nemo        ! working array
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_wri                 ! routines called by step.F90
+   PUBLIC   dia_wri_state
+   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
+
+   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
+   INTEGER ::          nb_T              , ndim_bT   ! 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, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT
+
+   !! * Substitutions
+#  include "zdfddm_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
+
+   INTEGER FUNCTION dia_wri_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) :: ierr
+      !!----------------------------------------------------------------------
+      ierr = 0
+      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     &
+         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     &
+         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) )
+         !
+      dia_wri_alloc = MAXVAL(ierr)
+      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc )
+      !
+  END FUNCTION dia_wri_alloc
+
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NetCDF output file
+   !!----------------------------------------------------------------------
+#if defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_iomput'                                        use IOM library
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dia_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!                   
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!
+      !! ** Method  :  use iom_put
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER                      ::   ji, jj, jk              ! dummy loop indices
+      INTEGER                      ::   jkbot                   !
+      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   ! 
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace
+      !!----------------------------------------------------------------------
+      ! 
+      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
+      ! 
+      CALL wrk_alloc( jpi , jpj      , z2d )
+      CALL wrk_alloc( jpi , jpj, jpk , z3d )
+      !
+      ! Output the initial state and forcings
+      IF( ninist == 1 ) THEN                       
+         CALL dia_wri_state( 'output.init', kt )
+         ninist = 0
+      ENDIF
+
+      ! Output of initial vertical scale factor
+      CALL iom_put("e3t_0", e3t_0(:,:,:) )
+      CALL iom_put("e3u_0", e3t_0(:,:,:) )
+      CALL iom_put("e3v_0", e3t_0(:,:,:) )
+      !
+      CALL iom_put( "e3t" , e3t_n(:,:,:) )
+      CALL iom_put( "e3u" , e3u_n(:,:,:) )
+      CALL iom_put( "e3v" , e3v_n(:,:,:) )
+      CALL iom_put( "e3w" , e3w_n(:,:,:) )
+      IF( iom_use("e3tdef") )   &
+         CALL iom_put( "e3tdef"  , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
+
+      CALL iom_put( "ssh" , sshn )                 ! sea surface height
+      IF( iom_use("wetdep") )   &                  ! wet depth
+         CALL iom_put( "wetdep" , ht_wd(:,:) + sshn(:,:) )
+      
+      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature
+      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature
+      IF ( iom_use("sbt") ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               jkbot = mbkt(ji,jj)
+               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem)
+            END DO
+         END DO
+         CALL iom_put( "sbt", z2d )                ! bottom temperature
+      ENDIF
+      
+      CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity
+      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity
+      IF ( iom_use("sbs") ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               jkbot = mbkt(ji,jj)
+               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal)
+            END DO
+         END DO
+         CALL iom_put( "sbs", z2d )                ! bottom salinity
+      ENDIF
+
+      IF ( iom_use("taubot") ) THEN                ! bottom stress
+         z2d(:,:) = 0._wp
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  &
+                      &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )      
+               zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  &
+                      &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  ) 
+               z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 
+               !
+            ENDDO
+         ENDDO
+         CALL lbc_lnk( z2d, 'T', 1. )
+         CALL iom_put( "taubot", z2d )           
+      ENDIF
+         
+      CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current
+      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current
+      IF ( iom_use("sbu") ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               jkbot = mbku(ji,jj)
+               z2d(ji,jj) = un(ji,jj,jkbot)
+            END DO
+         END DO
+         CALL iom_put( "sbu", z2d )                ! bottom i-current
+      ENDIF
+      
+      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current
+      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current
+      IF ( iom_use("sbv") ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               jkbot = mbkv(ji,jj)
+               z2d(ji,jj) = vn(ji,jj,jkbot)
+            END DO
+         END DO
+         CALL iom_put( "sbv", z2d )                ! bottom j-current
+      ENDIF
+
+      CALL iom_put( "woce", wn )                   ! vertical velocity
+      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value
+         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
+         z2d(:,:) = rau0 * e1e2t(:,:)
+         DO jk = 1, jpk
+            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
+         END DO
+         CALL iom_put( "w_masstr" , z3d )  
+         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
+      ENDIF
+
+      CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef.
+      CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef.
+      CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm)
+
+      IF( iom_use('logavt') )   CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt  (:,:,:) ) ) )
+      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) )
+
+      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
+         DO jj = 2, jpjm1                                    ! sst gradient
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zztmp  = tsn(ji,jj,1,jp_tem)
+               zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) * r1_e1u(ji-1,jj)
+               zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)
+               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
+                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'T', 1. )
+         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient
+         z2d(:,:) = SQRT( z2d(:,:) )
+         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient
+      ENDIF
+         
+      ! clem: heat and salt content
+      IF( iom_use("heatc") ) THEN
+         z2d(:,:)  = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2)
+      ENDIF
+
+      IF( iom_use("saltc") ) THEN
+         z2d(:,:)  = 0._wp 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2)
+      ENDIF
+      !
+      IF ( iom_use("eken") ) THEN
+         rke(:,:,jk) = 0._wp                               !      kinetic energy 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zztmp   = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)    &
+                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) )  &
+                     &          *  zztmp 
+                  !
+                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk)    &
+                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) )  &
+                     &          *  zztmp 
+                  !
+                  rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy )
+                  !
+               ENDDO
+            ENDDO
+         ENDDO
+         CALL lbc_lnk( rke, 'T', 1. )
+         CALL iom_put( "eken", rke )           
+      ENDIF
+      !
+      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence
+      !
+      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
+         z3d(:,:,jpk) = 0.e0
+         z2d(:,:) = 0.e0
+         DO jk = 1, jpkm1
+            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)
+            z2d(:,:) = z2d(:,:) + z3d(:,:,jk)
+         END DO
+         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
+         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum
+      ENDIF
+      
+      IF( iom_use("u_heattr") ) THEN
+         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) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'U', -1. )
+         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction
+      ENDIF
+
+      IF( iom_use("u_salttr") ) THEN
+         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) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'U', -1. )
+         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction
+      ENDIF
+
+      
+      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
+         z3d(:,:,jpk) = 0.e0
+         DO jk = 1, jpkm1
+            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)
+         END DO
+         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
+      ENDIF
+      
+      IF( iom_use("v_heattr") ) THEN
+         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) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'V', -1. )
+         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction
+      ENDIF
+
+      IF( iom_use("v_salttr") ) THEN
+         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) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'V', -1. )
+         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction
+      ENDIF
+
+      ! Vertical integral of temperature
+      IF( iom_use("tosmint") ) THEN
+         z2d(:,:)=0._wp
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'T', -1. )
+         CALL iom_put( "tosmint", z2d ) 
+      ENDIF
+
+      ! Vertical integral of salinity
+      IF( iom_use("somint") ) THEN
+         z2d(:,:)=0._wp
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'T', -1. )
+         CALL iom_put( "somint", z2d ) 
+      ENDIF
+
+      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2)
+      !
+      CALL wrk_dealloc( jpi , jpj      , z2d )
+      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
+      !
+      ! If we want tmb values 
+
+      IF (ln_diatmb) THEN
+         CALL dia_tmb 
+      ENDIF 
+      IF (ln_dia25h) THEN
+         CALL dia_25h( kt )
+      ENDIF 
+
+      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
+      !
+   END SUBROUTINE dia_wri
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                  use IOIPSL  library
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dia_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!                   
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!
+      !! ** Method  :   At the beginning of the first time step (nit000), 
+      !!      define all the NETCDF files and fields
+      !!      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
+      !
+      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
+      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
+      INTEGER  ::   inum = 11                                ! temporary logical unit
+      INTEGER  ::   ji, jj, jk                               ! dummy loop indices
+      INTEGER  ::   ierr                                     ! error code return from allocation
+      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      INTEGER  ::   jn, ierror                               ! local integers
+      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zw2d       ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
+      !!----------------------------------------------------------------------
+      ! 
+      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
+      !
+                             CALL wrk_alloc( jpi,jpj      , zw2d )
+      IF( .NOT.ln_linssh )   CALL wrk_alloc( jpi,jpj,jpk  , zw3d )
+      !
+      ! Output the initial state and forcings
+      IF( ninist == 1 ) THEN                       
+         CALL dia_wri_state( 'output.init', kt )
+         ninist = 0
+      ENDIF
+      !
+      ! 0. Initialisation
+      ! -----------------
+
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes)
+#if defined key_diainstant
+      zsto = nwrite * rdt
+      clop = "inst("//TRIM(clop)//")"
+#else
+      zsto=rdt
+      clop = "ave("//TRIM(clop)//")"
+#endif
+      zout = nwrite * rdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      it = kt
+      itmod = kt - nit000 + 1
+
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! Define the NETCDF files (one per grid)
+
+         ! 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
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
+            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
+         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
+                                 ' limit storage in depth = ', ipk
+
+         ! WRITE root name in date.file for use by postpro
+         IF(lwp) THEN
+            CALL dia_nam( clhstnam, nwrite,' ' )
+            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+            WRITE(inum,*) clhstnam
+            CLOSE(inum)
+         ENDIF
+
+         ! Define the T grid FILE ( nid_T )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_1d, nz_T, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
+         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
+         !
+         IF( ln_icebergs ) THEN
+            !
+            !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after 
+            !! that routine is called from nemogcm, so do it here immediately before its needed
+            ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror )
+            IF( lk_mpp )   CALL mpp_sum( ierror )
+            IF( ierror /= 0 ) THEN
+               CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array')
+               RETURN
+            ENDIF
+            !
+            !! iceberg vertical coordinate is class number
+            CALL histvert( nid_T, "class", "Iceberg class",      &  ! Vertical grid: class
+               &           "number", nclasses, class_num, nb_T )
+            !
+            !! each class just needs the surface index pattern
+            ndim_bT = 3
+            DO jn = 1,nclasses
+               ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj)
+            ENDDO
+            !
+         ENDIF
+
+         ! Define the U grid FILE ( nid_U )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_1d, nz_U, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume
+         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
+
+         ! Define the V grid FILE ( nid_V )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
+            &          "m", ipk, gdept_1d, nz_V, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume
+         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
+
+         ! Define the W grid FILE ( nid_W )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_W' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
+            &          "m", ipk, gdepw_1d, nz_W, "down" )
+
+
+         ! Declare all the output fields as NETCDF variables
+
+         !                                                                                      !!! nid_T : 3D
+         CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn
+            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
+            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         IF(  .NOT.ln_linssh  ) THEN
+            CALL histdef( nid_T, "vovvle3t", "Level thickness"                    , "m"      ,&  ! e3t_n
+            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+            CALL histdef( nid_T, "vovvldep", "T point depth"                      , "m"      ,&  ! e3t_n
+            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+            CALL histdef( nid_T, "vovvldef", "Squared level deformation"          , "%^2"    ,&  ! e3t_n
+            &             jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_T : 2D
+         CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         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", "River runoffs"                      , "Kg/m2/s",   &  ! runoffs
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         IF(  ln_linssh  ) THEN
+            CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"     &  ! emp * tsn(:,:,1,jp_tem)
+            &                                                                  , "KgC/m2/s",  &  ! sosst_cd
+            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"        &  ! emp * tsn(:,:,1,jp_sal)
+            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd
+            &             jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ENDIF
+         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!
+         IF( ln_icebergs ) THEN
+            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "calving_heat"        , "calving heat flux"                        , "XXXX"   , &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "berg_floating_melt"  , "Melt rate of icebergs + bits"             , "kg/m2/s", &
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "berg_stored_ice"     , "Accumulated ice mass by class"            , "kg"     , &
+               &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
+            IF( ln_bergdia ) THEN
+               CALL histdef( nid_T, "berg_melt"           , "Melt rate of icebergs"                    , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_buoy_melt"      , "Buoyancy component of iceberg melt rate"  , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_eros_melt"      , "Erosion component of iceberg melt rate"   , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_conv_melt"      , "Convective component of iceberg melt rate", "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_virtual_area"   , "Virtual coverage by icebergs"             , "m2"     , &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "bits_src"           , "Mass source of bergy bits"                , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "bits_melt"          , "Melt rate of bergy bits"                  , "kg/m2/s", &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "bits_mass"          , "Bergy bit density field"                  , "kg/m2"  , &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_mass"           , "Iceberg density field"                    , "kg/m2"  , &
+                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+               CALL histdef( nid_T, "berg_real_calving"   , "Calving into iceberg class"               , "kg/s"   , &
+                  &          jpi, jpj, nh_T, nclasses  , 1, nclasses  , nb_T , 32, clop, zsto, zout )
+            ENDIF
+         ENDIF
+
+         IF( .NOT. ln_cpl ) THEN
+            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
+               &          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( ln_cpl .AND. nn_ice <= 1 ) THEN
+            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
+               &          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
+         
+         clmx ="l_max(only(x))"    ! max index on a period
+!         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
+!            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
+#if defined key_diahth
+         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "J/m2"   ,   & ! htc3
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+
+         IF( ln_cpl .AND. nn_ice == 2 ) THEN
+            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice
+               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ENDIF
+
+         CALL histend( nid_T, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_U : 3D
+         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
+            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+         IF( ln_wave .AND. ln_sdw) THEN
+            CALL histdef( nid_U, "sdzocrtx", "Stokes Drift Zonal Current"         , "m/s"    ,   &  ! usd
+               &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_U : 2D
+         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
+            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+
+         CALL histend( nid_U, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_V : 3D
+         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
+            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+         IF( ln_wave .AND. ln_sdw) THEN
+            CALL histdef( nid_V, "sdmecrty", "Stokes Drift Meridional Current"    , "m/s"    ,   &  ! vsd
+               &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_V : 2D
+         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
+            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+
+         CALL histend( nid_V, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_W : 3D
+         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity"             , "m2/s"  ,   &  ! avmu
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+
+         IF( lk_zdfddm ) THEN
+            CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs
+               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         ENDIF
+         
+         IF( ln_wave .AND. ln_sdw) THEN
+            CALL histdef( nid_W, "sdvecrtz", "Stokes Drift Vertical Current"   , "m/s"    ,   &  ! wsd
+               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_W : 2D
+         CALL histend( nid_W, snc4chunks=snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
+         IF(ll_print) CALL FLUSH(numout )
+
+      ENDIF
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      ! ndex(1) est utilise ssi l'avant dernier argument est different de 
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et ndex la liste des indices a sortir
+
+      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN 
+         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      IF( .NOT.ln_linssh ) THEN
+         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content
+         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T  )   ! salt content
+         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface heat content
+         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT )   ! sea surface salinity content
+      ELSE
+         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T  )   ! temperature
+         CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) , ndim_T , ndex_T  )   ! salinity
+         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature
+         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity
+      ENDIF
+      IF( .NOT.ln_linssh ) THEN
+         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
+         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness
+         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth
+         CALL histwrite( nid_T, "vovvldef", it, zw3d             , ndim_T , ndex_T  )   ! level thickness deformation
+      ENDIF
+      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
+      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
+      CALL histwrite( nid_T, "sorunoff", it, rnf           , ndim_hT, ndex_hT )   ! river runoffs
+      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux 
+                                                                                  ! (includes virtual salt flux beneath ice 
+                                                                                  ! in linear free surface case)
+      IF( ln_linssh ) THEN
+         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem)
+         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst
+         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal)
+         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss
+      ENDIF
+      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
+      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
+      CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth
+      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth
+      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
+      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
+!
+      IF( ln_icebergs ) THEN
+         !
+         CALL histwrite( nid_T, "calving"             , it, berg_grid%calving      , ndim_hT, ndex_hT )  
+         CALL histwrite( nid_T, "calving_heat"        , it, berg_grid%calving_hflx , ndim_hT, ndex_hT )         
+         CALL histwrite( nid_T, "berg_floating_melt"  , it, berg_grid%floating_melt, ndim_hT, ndex_hT )  
+         !
+         CALL histwrite( nid_T, "berg_stored_ice"     , it, berg_grid%stored_ice   , ndim_bT, ndex_bT )
+         !
+         IF( ln_bergdia ) THEN
+            CALL histwrite( nid_T, "berg_melt"           , it, berg_melt        , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "berg_buoy_melt"      , it, buoy_melt        , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "berg_eros_melt"      , it, eros_melt        , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "berg_conv_melt"      , it, conv_melt        , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "berg_virtual_area"   , it, virtual_area     , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "bits_src"            , it, bits_src         , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "bits_melt"           , it, bits_melt        , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "bits_mass"           , it, bits_mass        , ndim_hT, ndex_hT   )  
+            CALL histwrite( nid_T, "berg_mass"           , it, berg_mass        , ndim_hT, ndex_hT   )  
+            !
+            CALL histwrite( nid_T, "berg_real_calving"   , it, real_calving     , ndim_bT, ndex_bT   )
+         ENDIF
+      ENDIF
+
+      IF( .NOT. ln_cpl ) THEN
+         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+      ENDIF
+      IF( ln_cpl .AND. nn_ice <= 1 ) THEN
+         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+      ENDIF
+!      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
+!      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
+
+#if defined key_diahth
+      CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline
+      CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm
+      CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm
+      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content
+#endif
+
+      IF( ln_cpl .AND. nn_ice == 2 ) THEN
+         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature
+         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo
+      ENDIF
+
+      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
+      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
+
+      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
+      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
+
+      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
+      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
+      CALL histwrite( nid_W, "votkeavm", it, avmu           , ndim_T, ndex_T )    ! T vert. eddy visc. coef.
+      IF( lk_zdfddm ) THEN
+         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
+      ENDIF
+
+      IF( ln_wave .AND. ln_sdw ) THEN
+         CALL histwrite( nid_U, "sdzocrtx", it, usd           , ndim_U , ndex_U )    ! i-StokesDrift-current
+         CALL histwrite( nid_V, "sdmecrty", it, vsd           , ndim_V , ndex_V )    ! j-StokesDrift-current
+         CALL histwrite( nid_W, "sdvecrtz", it, wsd           , ndim_T , ndex_T )    ! StokesDrift vert. current
+      ENDIF
+
+      ! 3. Close all files
+      ! ---------------------------------------
+      IF( kt == nitend ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+         CALL histclo( nid_W )
+      ENDIF
+      !
+                             CALL wrk_dealloc( jpi , jpj        , zw2d )
+      IF( .NOT.ln_linssh )   CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
+      !
+   END SUBROUTINE dia_wri
+#endif
+
+   SUBROUTINE dia_wri_state( cdfile_name, kt )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_wri_state  ***
+      !!        
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!      the instantaneous ocean state and forcing fields.
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! ** Method  :   NetCDF files using ioipsl
+      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
+      !!      File 'output.abort.nc' is created in case of abnormal job end
+      !!----------------------------------------------------------------------
+      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
+      INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index
+      !! 
+      CHARACTER (len=32) :: clname
+      CHARACTER (len=40) :: clop
+      INTEGER  ::   id_i , nz_i, nh_i       
+      INTEGER, DIMENSION(1) ::   idex             ! local workspace
+      REAL(wp) ::   zsto, zout, zmax, zjulian
+      !!----------------------------------------------------------------------
+      ! 
+      ! 0. Initialisation
+      ! -----------------
+
+      ! Define name, frequency of output and means
+      clname = cdfile_name
+      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      zsto = rdt
+      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
+      zout = rdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
+      IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc'
+
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      ! Compute julian date from starting date of the run
+      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis 
+      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, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
+      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
+          "m", jpk, gdept_1d, nz_i, "down")
+
+      ! Declare all the output fields as NetCDF variables
+
+      CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "sossheig", "Sea Surface Height"    , "m"      ,   &  ! ssh
+         &          jpi, jpj, nh_i, 1  , 1, 1  , nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+      CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+         !
+      IF( ALLOCATED(ahtu) ) THEN
+         CALL histdef( id_i, "ahtu"    , "u-eddy diffusivity"    , "m2/s"    ,   &   ! zonal current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+         CALL histdef( id_i, "ahtv"    , "v-eddy diffusivity"    , "m2/s"    ,   &   ! meridonal current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+      ENDIF
+      IF( ALLOCATED(ahmt) ) THEN 
+         CALL histdef( id_i, "ahmt"    , "t-eddy viscosity"      , "m2/s"    ,   &   ! zonal current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+         CALL histdef( id_i, "ahmf"    , "f-eddy viscosity"      , "m2/s"    ,   &   ! meridonal current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+      ENDIF
+         !
+      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater 
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      IF( .NOT.ln_linssh ) THEN
+         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      , &   ! t-point depth
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+         CALL histdef( id_i, "vovvle3t", "T point thickness"     , "m"      , &   ! t-point depth
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      ENDIF
+      !
+      IF( ln_wave .AND. ln_sdw ) THEN
+         CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal"    , "m/s"    , &   ! StokesDrift zonal current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+         CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid"    , "m/s"    , &   ! StokesDrift meridonal current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+         CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert"     , "m/s"    , &   ! StokesDrift vertical current
+            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      ENDIF
+
+#if defined key_lim2
+      CALL lim_wri_state_2( kt, id_i, nh_i )
+#elif defined key_lim3
+      CALL lim_wri_state( kt, id_i, nh_i )
+#else
+      CALL histend( id_i, snc4chunks=snc4set )
+#endif
+
+      ! 2. Start writing data
+      ! ---------------------
+      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et idex la liste des indices a sortir
+      idex(1) = 1   ! init to avoid compil warning
+
+      ! Write all fields on T grid
+      CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature
+      CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity
+      CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height
+      CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity
+      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
+      !
+      IF( ALLOCATED(ahtu) ) THEN
+         CALL histwrite( id_i, "ahtu"    , kt, ahtu             , jpi*jpj*jpk, idex )    ! aht at u-point
+         CALL histwrite( id_i, "ahtv"    , kt, ahtv             , jpi*jpj*jpk, idex )    !  -  at v-point
+      ENDIF
+      IF( ALLOCATED(ahmt) ) THEN
+         CALL histwrite( id_i, "ahmt"    , kt, ahmt             , jpi*jpj*jpk, idex )    ! ahm at t-point
+         CALL histwrite( id_i, "ahmf"    , kt, ahmf             , jpi*jpj*jpk, idex )    !  -  at f-point
+      ENDIF
+      !
+      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
+      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction
+      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
+      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
+
+      IF(  .NOT.ln_linssh  ) THEN             
+         CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth 
+         CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )!  T-cell thickness  
+      END IF 
+ 
+      IF( ln_wave .AND. ln_sdw ) THEN
+         CALL histwrite( id_i, "sdzocrtx", kt, usd           , jpi*jpj*jpk, idex)     ! now StokesDrift i-velocity
+         CALL histwrite( id_i, "sdmecrty", kt, vsd           , jpi*jpj*jpk, idex)     ! now StokesDrift j-velocity
+         CALL histwrite( id_i, "sdvecrtz", kt, wsd           , jpi*jpj*jpk, idex)     ! now StokesDrift k-velocity
+      ENDIF
+
+      ! 3. Close the file
+      ! -----------------
+      CALL histclo( id_i )
+#if ! defined key_iomput
+      IF( ninist /= 1  ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+         CALL histclo( nid_W )
+      ENDIF
+#endif
+      ! 
+   END SUBROUTINE dia_wri_state
+
+   !!======================================================================
+END MODULE diawri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90	(revision 8732)
@@ -0,0 +1,146 @@
+MODULE cool_skin
+   !!======================================================================
+   !!                    ***  MODULE  cool_skin  ***
+   !!     Cool skin thickness and delta T correction using Artele et al. (2002)
+   !!     [see also Tu and Tsuang (2005)]
+   !!
+   !!=====================================================================
+   !! History :        !  2012-01  (P. Sykes)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_coolskin_init : initialisation of the cool skin
+   !!   diurnal_sst_coolskin_step : time-stepping  of the cool skin corrections
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE in_out_manager
+   USE sbc_oce
+   USE lib_mpp
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   ! Namelist parameters
+
+   ! Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_k = 0.596_wp          ! Thermal conductivity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_v = 1.05e-6_wp        ! Kinematic viscosity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_C = 86400             ! seconds [see Tu and Tsuang (2005)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_cw = 3993._wp         ! specific heat capacity of seawater
+   REAL(wp), PRIVATE, PARAMETER :: pp_h = 10._wp            ! reference depth [using 10m from Artale et al. (2002)]
+   REAL(wp), PRIVATE, PARAMETER :: pp_rhoa = 1.20421_wp     ! density of air (at 20C)
+   REAL(wp), PRIVATE, PARAMETER :: pp_cda = 1.45e-3_wp      ! assumed air-sea drag coefficient for calculating wind speed
+   
+   ! Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst    ! Cool skin delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick   ! Cool skin thickness
+
+   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init
+
+      !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO-consortium (2016) 
+   !! $Id:  $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_coolskin_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_coolskin_init ***
+      !!
+      !! ** Purpose :   initialise the cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference :
+      !! 
+      !!----------------------------------------------------------------------
+      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) )
+      x_csdsst = 0.
+      x_csthick = 0.
+      !
+   END SUBROUTINE diurnal_sst_coolskin_init
+
+
+   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Time-step the Artale cool skin model
+      !!
+      !! ** Method : 
+      !!
+      !! ** Reference : 
+      !!----------------------------------------------------------------------
+      ! Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     ! Heat (non-solar)(Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   ! Wind stress (kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3)
+      REAL(wp), INTENT(IN) :: rdt                             ! Time-step
+     
+      ! Local variables
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fv                    ! Friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: z_gamma                 ! Dimensionless function of wind speed
+      REAL(wp), DIMENSION(jpi,jpj) :: z_lamda                 ! Sauders (dimensionless) proportionality constant
+      REAL(wp), DIMENSION(jpi,jpj) :: z_wspd                  ! Wind speed (m/s)
+      REAL(wp) :: z_ztx                                       ! Temporary u wind stress
+      REAL(wp) :: z_zty                                       ! Temporary v wind stress
+      REAL(wp) :: z_zmod                                      ! Temporary total wind stress
+     
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_blk )   CALL ctl_stop("cool_skin.f90: diurnal flux processing only implemented for bulk forcing")
+      !
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            !
+            ! Calcualte wind speed from wind stress and friction velocity
+            IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
+               z_fv(ji,jj) = SQRT( pstauflux(ji,jj) / psrho(ji,jj) )
+               z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) )
+            ELSE
+               z_fv(ji,jj) = 0.
+               z_wspd(ji,jj) = 0.     
+            ENDIF
+            !
+            ! Calculate gamma function which is dependent upon wind speed
+            IF( tmask(ji,jj,1) == 1. ) THEN
+               IF( ( z_wspd(ji,jj) <= 7.5 ) ) z_gamma(ji,jj) = ( 0.2 * z_wspd(ji,jj) ) + 0.5
+               IF( ( z_wspd(ji,jj) > 7.5 ) .AND. ( z_wspd(ji,jj) < 10. ) ) z_gamma(ji,jj) = ( 1.6 * z_wspd(ji,jj) ) - 10.
+               IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6.
+            ENDIF
+            !
+            ! Calculate lamda function
+            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
+               z_lamda(ji,jj) = ( z_fv(ji,jj) * pp_k * pp_C ) / ( z_gamma(ji,jj) * psrho(ji,jj) * pp_cw * pp_h * pp_v )
+            ELSE
+               z_lamda(ji,jj) = 0.
+            ENDIF
+            !
+            ! Calculate the cool skin thickness - only when heat flux is out of the ocean
+            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
+               x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj)
+            ELSE
+               x_csthick(ji,jj) = 0.
+            ENDIF
+            !
+            ! Calculate the cool skin correction - only when the heat flux is out of the ocean
+            IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
+               x_csdsst(ji,jj) = ( psqflux(ji,jj) * x_csthick(ji,jj) ) / pp_k
+             ELSE
+               x_csdsst(ji,jj) = 0.
+            ENDIF
+            !
+         END DO
+      END DO
+      !
+   END SUBROUTINE diurnal_sst_coolskin_step
+
+   !!======================================================================
+END MODULE cool_skin
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/diurnal_bulk.F90	(revision 8732)
@@ -0,0 +1,297 @@
+MODULE diurnal_bulk
+   !!======================================================================
+   !!                    ***  MODULE  diurnal_bulk  ***
+   !!     Takaya model of diurnal warming (Takaya, 2010)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   diurnal_sst_bulk_init  : initialise diurnal model
+   !!   diurnal_sst_bulk_step  : time-step the diurnal model
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE phycst
+   USE dom_oce
+   USE lib_mpp
+   USE solfrac_mod
+   USE in_out_manager
+   
+   IMPLICIT NONE
+   
+   ! Namelist parameters
+   LOGICAL, PUBLIC :: ln_diurnal
+   LOGICAL, PUBLIC :: ln_diurnal_only
+
+   ! Parameters
+   REAL(wp), PRIVATE, PARAMETER :: pp_alpha = 2.0e-4_wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_veltol = 0._wp
+   REAL(wp), PRIVATE, PARAMETER :: pp_min_fvel = 1.e-10_wp 
+   
+   ! Key variables
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_dsst     ! Delta SST
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_solfrac  ! Fraction of 
+   !                                                           ! absorbed radiation
+
+   PRIVATE
+   PUBLIC diurnal_sst_bulk_init, diurnal_sst_takaya_step
+   
+   CONTAINS 
+   
+   SUBROUTINE diurnal_sst_bulk_init
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_init ***
+      !!
+      !! ** Purpose : Initialise the Takaya diurnal model
+      
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      INTEGER :: ios
+      
+      NAMELIST /namdiu/ ln_diurnal, ln_diurnal_only
+      
+      ! Read the namelist
+      REWIND( numnam_ref )
+      READ( numnam_ref, namdiu, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in reference namelist', lwp )
+      REWIND( numnam_cfg )
+      READ( numnam_cfg, namdiu, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdiu in configuration namelist', lwp )      
+      
+      IF ( ln_diurnal_only .AND. ( .NOT. ln_diurnal ) ) THEN
+         CALL ctl_stop( "ln_diurnal_only set, but ln_diurnal = FALSE !" )
+      ENDIF
+      
+      IF ( ln_diurnal ) THEN      
+         
+         ! Allocate arrays
+         ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) )
+         
+         ! Initialise the solar fraction
+         x_solfrac = 0._wp
+         x_dsst = 0._wp
+
+         IF ( ln_diurnal_only ) THEN
+            CALL ctl_warn( "ln_diurnal_only set; only the diurnal component of SST will be calculated" )
+         ENDIF
+      ENDIF
+      
+   END SUBROUTINE diurnal_sst_bulk_init
+   
+   SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,&
+            &                  pla, pthick, pcoolthick, pmu, &
+            &                  p_fvel_bkginc, p_hflux_bkginc)
+      !!----------------------------------------------------------------------
+      !! *** ROUTINE diurnal_sst_takaya_step ***
+      !!
+      !! ** Purpose :   Time-step the Takaya diurnal model
+      !!
+      !! ** Method :    1) Calculate the Obukhov length
+      !!                2) Calculate the Similarity function
+      !!                2) Calculate the increment to dsst
+      !!                3) Apply the increment
+      !! ** Reference : Refinements to a prognostic scheme of skin sea surface
+      !!                temperature, Takaya et al, JGR, 2010 
+      !!----------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ! Dummy variables
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psolflux  ! solar flux (Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pqflux    ! heat (non-solar) 
+      !                                                     ! flux (Watts)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: ptauflux  ! wind stress 
+      !                                                     ! (kg/ m s^2)
+      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: prho      ! water density 
+      !                                                     ! (kg/m^3)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pLa    
+      !                                                     ! Langmuir number
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pthick 
+      !                                                     ! warm layer thickness (m)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pcoolthick 
+      !                                                     ! cool skin thickness (m)
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: pmu    
+      !                                                     ! mu parameter
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_hflux_bkginc  
+      !                                                     ! optional increment to the
+      !                                                     ! heat flux
+      REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(jpi,jpj) :: p_fvel_bkginc  
+      !                                                     ! optional increment to the
+      !                                                     ! friction velocity
+      REAL(wp), INTENT(IN) :: p_rdt                         ! time-step
+      
+      ! Local variables 
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel              ! friction velocity     
+      REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla
+      REAL(wp), DIMENSION(jpi,jpj) :: z_abflux            ! absorbed flux           
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fla               ! Langmuir function value 
+      
+      LOGICAL  :: ll_calcfrac
+      
+      INTEGER :: ji,jj
+      INTEGER, INTENT(IN) :: kt                           ! time step
+
+      ! Set optional arguments to their defaults
+      IF ( .NOT. PRESENT(pthick) ) THEN 
+         zthick(:,:) = 3._wp
+      ELSE
+         zthick(:,:) = pthick(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pcoolthick) ) THEN 
+         zcoolthick(:,:) = 0._wp
+      ELSE
+         zcoolthick(:,:) = pcoolthick(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pmu) ) THEN
+         zmu(:,:) = 0.3_wp
+      ELSE
+         zmu(:,:) = pmu(:,:)
+      ENDIF
+      IF ( .NOT. PRESENT(pla) ) THEN
+         zla(:,:) = 0.3_wp
+      ELSE
+         zla(:,:) = pla(:,:)
+      ENDIF
+      
+      ! If not done already, calculate the solar fraction
+      IF ( kt==nit000 ) THEN
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               IF(  ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) &
+               &   x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) )
+            END DO
+         END DO   
+      ENDIF   
+
+      ! convert solar flux and heat flux to absorbed flux   
+      WHERE ( tmask(:,:,1) == 1._wp) 
+         z_abflux(:,:) = (  x_solfrac(:,:) *  psolflux (:,:)) + pqflux(:,:)     
+      ELSEWHERE
+         z_abflux(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_hflux_bkginc) ) z_abflux(:,:) = z_abflux(:,:) + p_hflux_bkginc   ! Optional increment
+      WHERE ( ABS( z_abflux(:,:) ) < rsmall )
+         z_abflux(:,:) = rsmall
+      ENDWHERE 
+      
+      ! Calculate the friction velocity
+      WHERE ( (ptauflux /= 0) .AND. ( tmask(:,:,1) == 1.) )   
+         z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(:,:) )
+      ELSEWHERE
+         z_fvel(:,:) = 0._wp
+      ENDWHERE
+      IF( PRESENT(p_fvel_bkginc) ) z_fvel(:,:) = z_fvel(:,:) + p_fvel_bkginc   ! Optional increment
+      
+       
+       
+      ! Calculate the Langmuir function value
+      WHERE ( tmask(:,:,1) == 1.)
+         z_fla(:,:) = MAX( 1._wp, zla(:,:)**( -2._wp / 3._wp ) )  
+      ELSEWHERE
+         z_fla(:,:) = 0._wp
+      ENDWHERE     
+      
+      ! Increment the temperature using the implicit solution
+      x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:), &
+                                 z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:))
+      
+                                
+      
+   END SUBROUTINE diurnal_sst_takaya_step
+
+   
+   FUNCTION t_imp(p_dsst, p_rdt, p_abflux, p_fvel, &
+                          p_fla, pmu, pthick, prho )
+                          
+      IMPLICIT NONE
+      
+      ! Function definition
+      REAL(wp), DIMENSION(jpi,jpj) :: t_imp
+      ! Dummy variables
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst     ! Delta SST
+      REAL(wp), INTENT(IN)                     :: p_rdt      ! Time-step
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux   ! Heat forcing
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel     ! Friction velocity
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla      ! Langmuir number
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu        ! Structure parameter
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick     ! Layer thickness
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho       ! Water density
+   
+      ! Local variables
+      REAL(wp) :: z_olength          ! Obukhov length
+      REAL(wp) :: z_sigma, z_sigma2
+      REAL(wp) :: z_term1, z_term2     
+      REAL(wp) :: z_stabfunc         ! stability function value
+      REAL(wp) :: z_fvel      
+      
+      CHARACTER(200) :: warn_string
+       
+      INTEGER :: ji,jj
+                     
+      DO jj = 1, jpj
+         DO ji = 1, jpi   
+            
+            ! Only calculate outside tmask
+            IF ( tmask(ji,jj,1) /= 1._wp ) THEN
+               t_imp(ji,jj) = 0._wp
+               CYCLE   
+            END IF
+            
+            IF (p_fvel(ji,jj) < pp_min_fvel) THEN
+               z_fvel = pp_min_fvel
+               WRITE(warn_string,*) "diurnal_sst_takaya step: "&
+               &//"friction velocity < minimum\n" &
+               &//"Setting friction velocity =",pp_min_fvel
+               CALL ctl_warn(warn_string)
+               
+            ELSE
+               z_fvel = p_fvel(ji,jj)
+            ENDIF
+                 
+            ! Calculate the Obukhov length
+            IF ( (z_fvel < pp_veltol ) .AND. &
+            &    (p_dsst(ji,jj) > 0._wp) ) THEN
+               z_olength =  z_fvel  / &
+               &     SQRT( p_dsst(ji,jj) * vkarmn * grav * &
+               &             pp_alpha / ( 5._wp * pthick(ji,jj) ) )
+            ELSE
+               z_olength = &
+               &   ( prho(ji,jj) * rcp * z_fvel**3._wp ) / &
+               &   ( vkarmn * grav * pp_alpha *&
+               &     p_abflux(ji,jj) )
+            ENDIF
+             
+            ! Calculate the stability function          
+            z_sigma = pthick(ji,jj) / z_olength
+            z_sigma2 = z_sigma * z_sigma
+  
+            IF ( z_sigma >= 0. ) THEN
+               z_stabfunc = 1._wp + &
+               &  ( ( 5._wp * z_sigma + 4._wp * z_sigma2 ) / &
+               &  ( 1._wp + 3._wp * z_sigma + 0.25_wp * &
+               &    z_sigma2 ) )
+            ELSE
+               z_stabfunc = 1._wp / &
+               &                   SQRT( 1._wp - 16._wp * z_sigma )
+            ENDIF
+
+            ! Calculate the T increment
+            z_term1 = ( p_abflux(ji,jj) * ( pmu(ji,jj) + 1._wp)  / &
+            & ( pmu(ji,jj) * pthick(ji,jj) * prho(ji,jj) * rcp ) )
+            
+             
+            z_term2 = -( ( pmu(ji,jj) + 1._wp) * &
+            &                       ( vkarmn * z_fvel * p_fla(ji,jj) ) / &
+            &      ( pthick(ji,jj) * z_stabfunc ) )     
+          
+            t_imp(ji,jj) = ( p_dsst(ji,jj) + p_rdt * z_term1 ) / &
+                           ( 1._wp - p_rdt * z_term2 )
+
+         END DO
+      END DO
+      
+      END FUNCTION t_imp
+
+END MODULE diurnal_bulk
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/solfrac_mod.F90	(revision 8732)
@@ -0,0 +1,56 @@
+MODULE solfrac_mod
+   !!======================================================================
+   !!                    ***  MODULE  solfrac  ***
+   !!     POSH representation of solar absorption (Gntermann, 2009)
+   !!=====================================================================
+   !! History :        !  11-10  (J. While)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   solfrac  : function to calculate the solar fraction
+   !!----------------------------------------------------------------------
+   
+   USE par_kind
+   IMPLICIT NONE
+     
+   ! Parameters 
+   REAL(wp), PRIVATE, PARAMETER, DIMENSION(9) :: &
+   &                                     pp_wgt = (/0.2370, 0.36,  0.1790, &
+   &                                                0.087,  0.08,  0.025,  &
+   &                                                0.025,  0.007, 0.0004/)
+   REAL(wp), PRIVATE, PARAMETER, DIMENSION(9) :: &
+   &                                    pp_len = (/34.84,   2.266,   0.0315,  &
+   &                                               0.0055,  8.32e-4, 1.26e-4, &
+   &                                                3.13e-4, 7.82e-4, 1.44e-5/)
+   
+   PUBLIC solfrac
+                                                   
+CONTAINS
+
+   REAL(dp) FUNCTION solfrac(ptop,pbottom)
+       !!----------------------------------------------------------------------
+      !! *** ROUTINE solfrac ***
+      !!
+      !! ** Purpose :   Calculate the solar fraction absorbed between two 
+      !!                layers
+      !!
+      !! ** Reference : POSH a model of diurnal warming, Gentemann et al, 
+      !!                 JGR, 2009 
+      !!----------------------------------------------------------------------
+      
+      ! Dummy variabes
+      REAL(wp), INTENT(IN) :: ptop, pbottom   ! Top and bottom of layer
+      
+      ! local variables
+      INTEGER :: jt
+      
+      ! Calculate the solar fraction absorbed between the two layers
+      solfrac = 0._wp
+      DO jt = 1, 9
+           solfrac = solfrac + pp_wgt(jt) * ( exp ( -ptop / pp_len(jt) ) &
+            &                                 - exp ( -pbottom / pp_len(jt) ) )
+      END DO
+      
+   END FUNCTION
+   
+END MODULE solfrac_mod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90	(revision 8732)
@@ -0,0 +1,93 @@
+MODULE step_diu
+   !!======================================================================
+   !!                       ***  MODULE stp_diu  ***
+   !! Time-stepping of diurnal cycle models
+   !!======================================================================
+   !! History :  3.7  ! 2015-11  (J. While)  Original code
+
+   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
+   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE iom
+   USE sbc_oce
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE diaobs           ! Observation operator
+   USE oce
+   USE daymod
+   USE restart          ! ocean restart                    (rst_wri routine)
+   USE timing           ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp_diurnal   ! called by nemogcm.F90 or step.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id:$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+
+   SUBROUTINE stp_diurnal( kstp ) 
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index 
+      !!---------------------------------------------------------------------- 
+      !!                     ***  ROUTINE stp_diurnal  *** 
+      !!                       
+      !! ** Purpose : - Time stepping of diurnal SST model only 
+      !!   
+      !! ** Method  : -1- Update forcings and data   
+      !!              -2- Update ocean physics   
+      !!              -3- Compute the t and s trends   
+      !!              -4- Update t and s   
+      !!              -5- Compute the momentum trends 
+      !!              -6- Update the horizontal velocity 
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w) 
+      !!              -8- Outputs and diagnostics 
+      !!---------------------------------------------------------------------- 
+      INTEGER ::   jk       ! dummy loop indices
+      INTEGER ::   indic    ! error indicator if < 0 
+      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel_bkginc, z_hflux_bkginc     
+      !! --------------------------------------------------------------------- 
+      
+      IF(ln_diurnal_only) THEN
+         indic = 0                                 ! reset to no error condition 
+         IF( kstp /= nit000 )   CALL day( kstp )   ! Calendar (day was already called at nit000 in day_init) 
+ 
+         CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp
+         IF( ln_crs ) THEN
+            CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp
+         ENDIF
+       
+            CALL sbc    ( kstp )                      ! Sea Boundary Conditions 
+      ENDIF
+     
+      ! Cool skin
+      IF( .NOT.ln_diurnal )   CALL ctl_stop( "stp_diurnal: ln_diurnal not set" )
+         
+      IF( .NOT. ln_blk    )   CALL ctl_stop( "stp_diurnal: diurnal flux processing only implemented for bulk forcing" ) 
+
+      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt)
+
+      CALL iom_put( "sst_wl"   , x_dsst               )    ! warm layer (write out before update below).
+      CALL iom_put( "sst_cs"   , x_csdsst             )    ! cool skin
+
+      ! Diurnal warm layer model       
+      CALL diurnal_sst_takaya_step( kstp, & 
+      &    qsr, qns, taum, rhop(:,:,1), rdt) 
+
+      IF(ln_diurnal_only) THEN
+         IF( ln_diaobs )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+     
+         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
+         ! Control and restarts 
+         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
+         IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file 
+         IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+     
+         IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
+      ENDIF
+       
+   END SUBROUTINE stp_diurnal  
+   
+END MODULE step_diu
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 8732)
@@ -0,0 +1,410 @@
+MODULE daymod
+   !!======================================================================
+   !!                       ***  MODULE  daymod  ***
+   !! Ocean :   management of the model calendar
+   !!=====================================================================
+   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
+   !!                 ! 1997-03  (O. Marti)
+   !!                 ! 1997-05  (G. Madec)
+   !!                 ! 1997-08  (M. Imbard)
+   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
+   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
+   !!                 ! 2006-08  (G. Madec)  surface module major update
+   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   day        : calendar
+   !!----------------------------------------------------------------------
+   !!                    ----------- WARNING -----------
+   !!                    -------------------------------
+   !!   sbcmod assume that the time step is dividing the number of second of 
+   !!   in a day, i.e. ===> MOD( rday, rdt ) == 0 
+   !!   except when user defined forcing is used (see sbcmod.F90)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE ioipsl  , ONLY :   ymds2ju      ! for calendar
+   USE trc_oce , ONLY :   l_offline   ! offline flag
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            !
+   USE timing         ! Timing
+   USE restart        ! restart
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   day        ! called by step.F90
+   PUBLIC   day_init   ! called by istate.F90
+   PUBLIC   day_mth    ! Needed by TAM
+
+   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE day_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE day_init  ***
+      !!
+      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
+      !!                because day will be called at the beginning of step
+      !!
+      !! ** Action  : - nyear        : current year
+      !!              - nmonth       : current month of the year nyear
+      !!              - nday         : current day of the month nmonth
+      !!              - nday_year    : current day of the year nyear
+      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
+      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
+      !!              - nsec_day     : current time step counted in second since 00h of the current day
+      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
+      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inbday, idweek   ! local integers
+      REAL(wp) ::   zjul             ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
+      nsecd   = NINT( rday       )
+      nsecd05 = NINT( 0.5 * rday )
+      ndt     = NINT(       rdt  )
+      ndt05   = NINT( 0.5 * rdt  )
+
+      IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' )
+
+      ! set the calandar from ndastp (read in restart file and namelist)
+      nyear   =   ndastp / 10000
+      nmonth  = ( ndastp - (nyear * 10000) ) / 100
+      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
+
+      nhour   =   nn_time0 / 100
+      nminute = ( nn_time0 - nhour * 100 )
+
+      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )  
+      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
+      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
+
+      nsec1jan000 = 0
+      CALL day_mth
+
+      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
+         nmonth = nmonth - 1
+         nday = nmonth_len(nmonth)
+      ENDIF
+      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
+         nmonth = 12
+         nyear = nyear - 1
+         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
+         IF( nleapy == 1 )   CALL day_mth
+      ENDIF
+
+      ! day since january 1st
+      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
+
+      !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 = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
+      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
+      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
+
+      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
+      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
+         ! 1 timestep before current middle of first time step is still the same day
+         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
+         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05    
+      ELSE
+         ! 1 time step before the middle of the first time step is the previous day 
+         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
+         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
+      ENDIF
+      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
+      nsec_day   =             nhour*3600+nminute*60 - ndt05 
+      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
+      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
+
+      ! control print
+      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
+           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
+
+      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
+      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
+      CALL day( nit000 )
+      !
+   END SUBROUTINE day_init
+
+
+   SUBROUTINE day_mth
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE day_init  ***
+      !!
+      !! ** Purpose :   calendar values related to the months
+      !!
+      !! ** Action  : - nmonth_len    : length in days of the months of the current year
+      !!              - nyear_len     : length in days of the previous/current year
+      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
+      !!              - nmonth_end    : second since the beginning of the year and the end of the months
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jm               ! dummy loop indice
+      !!----------------------------------------------------------------------
+
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN
+         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
+         nyear_len(:) = 365
+         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
+            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
+               nyear_len(0)  = 366
+            ENDIF
+            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
+               nmonth_len(2) = 29
+               nyear_len(1)  = 366
+            ENDIF
+            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
+               nyear_len(2)  = 366
+            ENDIF
+         ENDIF
+      ELSE
+         nmonth_len(:) = nleapy   ! all months with nleapy days per year
+         nyear_len(:) = 12 * nleapy
+      ENDIF
+
+      ! half month in second since the begining of the year:
+      ! time since Jan 1st   0     1     2    ...    11    12    13
+      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
+      !                 <---> <---> <--->  ...  <---> <---> <--->
+      ! month number      0     1     2    ...    11    12    13
+      !
+      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
+      nmonth_half(0) = - nsecd05 * nmonth_len(0)
+      DO jm = 1, 13
+         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
+      END DO
+
+      nmonth_end(0) = 0
+      DO jm = 1, 13
+         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
+      END DO
+      !
+   END SUBROUTINE
+
+
+   SUBROUTINE day( kt )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE day  ***
+      !!
+      !! ** Purpose :   Compute the date with a day iteration IF necessary.
+      !!
+      !! ** Method  : - ???
+      !!
+      !! ** Action  : - nyear     : current year
+      !!              - nmonth    : current month of the year nyear
+      !!              - nday      : current day of the month nmonth
+      !!              - nday_year : current day of the year nyear
+      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
+      !!              - adatrj    : date in days since the beginning of the run
+      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
+      !
+      CHARACTER (len=25) ::   charout
+      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('day')
+      !
+      zprec = 0.1 / rday
+      !                                                 ! New time-step
+      nsec_year  = nsec_year  + ndt
+      nsec_month = nsec_month + ndt
+      nsec_week  = nsec_week  + ndt
+      nsec_day   = nsec_day   + ndt
+      adatrj  = adatrj  + rdt / rday
+      fjulday = fjulday + rdt / rday
+      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
+      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
+
+      IF( nsec_day > nsecd ) THEN                       ! New day
+         !
+         nday      = nday + 1
+         nday_year = nday_year + 1
+         nsec_day  = ndt05
+         !
+         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
+            nday   = 1
+            nmonth = nmonth + 1
+            nsec_month = ndt05
+            IF( nmonth == 13 ) THEN                     ! New year
+               nyear     = nyear + 1
+               nmonth    = 1
+               nday_year = 1
+               nsec_year = ndt05
+               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
+               IF( nleapy == 1 )   CALL day_mth
+            ENDIF
+         ENDIF
+         !
+         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, '   nsec_week = ', nsec_week
+      ENDIF
+
+      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
+
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+         CALL prt_ctl_info(charout)
+      ENDIF
+
+      IF( .NOT. l_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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('day')
+      !
+   END SUBROUTINE day
+
+
+   SUBROUTINE day_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !!  ** Purpose : Read or write calendar in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
+      !!                   end of the current(previous) run (REAL -> keep fractions of day)
+      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
+      !!       nrstdt = 1  we verify that nit000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime
+      INTEGER  ::   ihour, iminute
+      !!----------------------------------------------------------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+
+         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
+            ! Get Calendar informations
+            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nrstdt )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date
+            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
+                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
+                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
+            ! define ndastp and adatrj
+            IF ( nrstdt == 2 ) THEN
+               ! read the parameters corresponding to nit000 - 1 (last time step of previous run)
+               CALL iom_get( numror, 'ndastp', zndastp )
+               ndastp = NINT( zndastp )
+               CALL iom_get( numror, 'adatrj', adatrj  )
+	       CALL iom_get( numror, 'ntime', ktime )
+	       nn_time0=INT(ktime)
+               ! calculate start time in hours and minutes
+	       zdayfrac=adatrj-INT(adatrj)
+	       ksecs = NINT(zdayfrac*86400)	       ! Nearest second to catch rounding errors in adatrj	       
+	       ihour = INT(ksecs/3600)
+	       iminute = ksecs/60-ihour*60
+ 	        
+               ! Add to nn_time0
+               nhour   =   nn_time0 / 100
+               nminute = ( nn_time0 - nhour * 100 )
+	       nminute=nminute+iminute
+	       
+	       IF( nminute >= 60 ) THEN
+	          nminute=nminute-60
+		  nhour=nhour+1
+	       ENDIF
+	       nhour=nhour+ihour
+	       IF( nhour >= 24 ) THEN
+		  nhour=nhour-24
+	          adatrj=adatrj+1
+	       ENDIF	       
+	       nn_time0 = nhour * 100 + nminute
+	       adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated	       
+            ELSE
+               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
+               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam
+               nhour   =   nn_time0 / 100
+               nminute = ( nn_time0 - nhour * 100 )
+               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
+               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+         ELSE
+            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
+            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam
+            nhour   =   nn_time0 / 100
+	    nminute = ( nn_time0 - nhour * 100 )
+            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
+            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+         ENDIF
+         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
+         !
+         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,*) '   nn_time0                                         : ',nn_time0
+            WRITE(numout,*)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF( kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         ! calendar control
+         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
+         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+	 CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time
+      ENDIF
+      !
+   END SUBROUTINE day_rst
+
+   !!======================================================================
+END MODULE daymod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90	(revision 8732)
@@ -0,0 +1,165 @@
+MODULE depth_e3
+   !!======================================================================
+   !!                       ***  MODULE  depth_e3  ***
+   !!
+   !! zgr : vertical coordinate system 
+   !!======================================================================
+   !! History :  4.0  ! 2016-11  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   depth_to_e3   : use the depth of t- and w-points to calculate e3t & e3w
+   !!                   (generic interface for 1D and 3D fields)
+   !!   e3_to_depth   : use e3t & e3w to calculate the depth of t- and w-points
+   !!                   (generic interface for 1D and 3D fields)
+   !!---------------------------------------------------------------------
+   USE oce               ! ocean variables
+   USE dom_oce           ! ocean domain
+   !
+   USE in_out_manager    ! I/O manager
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE wrk_nemo          ! Memory allocation
+   USE timing            ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+  
+   INTERFACE depth_to_e3
+      MODULE PROCEDURE depth_to_e3_1d, depth_to_e3_3d
+   END INTERFACE
+
+   INTERFACE e3_to_depth
+      MODULE PROCEDURE e3_to_depth_1d, e3_to_depth_3d
+   END INTERFACE
+
+   PUBLIC   depth_to_e3        ! called by usrdef_zgr
+   PUBLIC   e3_to_depth        ! called by domzgr.F90
+      
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE depth_to_e3_1d( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE depth_to_e3_1d  ***
+      !!
+      !! ** Purpose :   compute e3t & e3w scale factors from t- & w-depths of model levels
+      !!
+      !! ** Method  :   The scale factors are given by the discrete derivative 
+      !!              of the depth:
+      !!                               e3w(jk) = dk[ dept_1d ] 
+      !!                               e3t(jk) = dk[ depw_1d ]
+      !!              with, at top and bottom :
+      !!                      e3w( 1 ) = 2 * ( dept( 1 ) - depw( 1 ) )
+      !!                      e3t(jpk) = 2 * ( dept(jpk) - depw(jpk) )   
+      !!
+      !! ** Action  : - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   pdept_1d, pdepw_1d   ! depths          [m]
+      REAL(wp), DIMENSION(:), INTENT(  out) ::   pe3t_1d , pe3w_1d    ! e3.=dk[depth]   [m]
+      !
+      INTEGER  ::   jk           ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      ! use pdep. at w- and t-points to compute e3. (e3. = dk[depth])
+      !
+      pe3w_1d( 1 ) = 2._wp * ( pdept_1d(1) - pdepw_1d(1) ) 
+      DO jk = 1, jpkm1
+         pe3w_1d(jk+1) = pdept_1d(jk+1) - pdept_1d(jk) 
+         pe3t_1d(jk  ) = pdepw_1d(jk+1) - pdepw_1d(jk) 
+      END DO
+      pe3t_1d(jpk) = 2._wp * ( pdept_1d(jpk) - pdepw_1d(jpk) )
+      !
+   END SUBROUTINE depth_to_e3_1d
+   
+      
+   SUBROUTINE depth_to_e3_3d( pdept_3d, pdepw_3d, pe3t_3d, pe3w_3d )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE depth_to_e3_3d  ***
+      !!
+      !! ** Purpose :   compute e3t & e3w scale factors from t- & w-depths of model levels
+      !!
+      !! ** Method  :   The scale factors are given by the discrete derivative 
+      !!              of the depth:
+      !!                               e3w(jk) = dk[ dept_1d ] 
+      !!                               e3t(jk) = dk[ depw_1d ]
+      !!              with, at top and bottom :
+      !!                      e3w( 1 ) = 2 * ( dept( 1 ) - depw( 1 ) )
+      !!                      e3t(jpk) = 2 * ( dept(jpk) - depw(jpk) )   
+      !!
+      !! ** Action  : - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdept_3d, pdepw_3d   ! depth           [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t_3d , pe3w_3d    ! e3.=dk[depth]   [m]
+      !
+      INTEGER  ::   jk           ! dummy loop indices
+      !!----------------------------------------------------------------------      
+      pe3w_3d(:,:, 1 ) = 2._wp * ( pdept_3d(:,:,1) - pdepw_3d(:,:,1) ) 
+      DO jk = 1, jpkm1
+         pe3w_3d(:,:,jk+1) = pdept_3d(:,:,jk+1) - pdept_3d(:,:,jk) 
+         pe3t_3d(:,:,jk  ) = pdepw_3d(:,:,jk+1) - pdepw_3d(:,:,jk) 
+      END DO
+      pe3t_3d(:,:,jpk) = 2._wp * ( pdept_3d(:,:,jpk) - pdepw_3d(:,:,jpk) )   
+      !
+   END SUBROUTINE depth_to_e3_3d
+
+
+   SUBROUTINE e3_to_depth_1d( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE e3_to_depth_1d  ***
+      !!
+      !! ** Purpose :   compute t- & w-depths of model levels from e3t & e3w scale factors
+      !!
+      !! ** Method  :   The t- & w-depth are given by the summation of e3w & e3t, resp. 
+      !!
+      !! ** Action  : - pe3t_1d, pe3w_1d : scale factor of t- and w-point (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   pe3t_1d , pe3w_1d    ! vert. scale factors   [m]
+      REAL(wp), DIMENSION(:), INTENT(  out) ::   pdept_1d, pdepw_1d   ! depth = SUM( e3 )     [m]
+      !
+      INTEGER  ::   jk           ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      pdepw_1d(1) = 0.0_wp
+      pdept_1d(1) = 0.5_wp * pe3w_1d(1)
+      DO jk = 2, jpk
+         pdepw_1d(jk) = pdepw_1d(jk-1) + pe3t_1d(jk-1) 
+         pdept_1d(jk) = pdept_1d(jk-1) + pe3w_1d(jk  ) 
+      END DO
+      !
+   END SUBROUTINE e3_to_depth_1d
+   
+      
+   SUBROUTINE e3_to_depth_3d( pe3t_3d, pe3w_3d, pdept_3d, pdepw_3d )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE e3_to_depth_3d  ***
+      !!
+      !! ** Purpose :   compute t- & w-depths of model levels from e3t & e3w scale factors
+      !!
+      !! ** Method  :   The t- & w-depth are given by the summation of e3w & e3t, resp. 
+      !!
+      !! ** Action  : - pe3t_1d, pe3w_1d : scale factor of t- and w-point (m)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pe3t_3d , pe3w_3d    ! vert. scale factors   [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept_3d, pdepw_3d   ! depth = SUM( e3 )     [m]
+      !
+      INTEGER  ::   jk           ! dummy loop indices
+      !!----------------------------------------------------------------------      
+      !
+      pdepw_3d(:,:,1) = 0.0_wp
+      pdept_3d(:,:,1) = 0.5_wp * pe3w_3d(:,:,1)
+      DO jk = 2, jpk
+         pdepw_3d(:,:,jk) = pdepw_3d(:,:,jk-1) + pe3t_3d(:,:,jk-1) 
+         pdept_3d(:,:,jk) = pdept_3d(:,:,jk-1) + pe3w_3d(:,:,jk  ) 
+      END DO
+      !
+   END SUBROUTINE e3_to_depth_3d
+
+   !!======================================================================
+END MODULE depth_e3
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 8732)
@@ -0,0 +1,304 @@
+MODULE dom_oce
+   !!======================================================================
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!======================================================================
+   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
+   !!                             to the optimization of BDY communications
+   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
+   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Root    : dummy function used when lk_agrif=F
+   !!   Agrif_CFixed  : dummy function used when lk_agrif=F
+   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
+
+   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! time & space domain namelist
+   !! ----------------------------
+   !                                   !!* Namelist namdom : time & space domain *
+   LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time
+   INTEGER , PUBLIC ::   nn_closea      !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+   INTEGER , PUBLIC ::   nn_msh         !: >0  create a mesh-mask file (mesh_mask.nc)
+   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice
+   REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer
+   REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter
+   INTEGER , PUBLIC ::   nn_euler       !: =0 start with forward time step or not (=1)
+   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
+   LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers
+
+   !! Free surface parameters
+   !! =======================
+   LOGICAL , PUBLIC :: ln_dynspg_exp    !: Explicit free surface flag
+   LOGICAL , PUBLIC :: ln_dynspg_ts     !: Split-Explicit free surface flag
+
+   !! Time splitting parameters
+   !! =========================
+   LOGICAL,  PUBLIC :: ln_bt_fw         !: Forward integration of barotropic sub-stepping
+   LOGICAL,  PUBLIC :: ln_bt_av         !: Time averaging of barotropic variables
+   LOGICAL,  PUBLIC :: ln_bt_auto       !: Set number of barotropic iterations automatically
+   INTEGER,  PUBLIC :: nn_bt_flt        !: Filter choice
+   INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt)
+   REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T)
+
+
+   !                                   !! old non-DOCTOR names still used in the model
+   REAL(wp), PUBLIC ::   atfp           !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt            !: time step for the dynamics and tracer
+
+   !                                   !!! associated variables
+   INTEGER , PUBLIC ::   neuler         !: restart euler forward option (0=Euler)
+   REAL(wp), PUBLIC ::   r2dt           !: = 2*rdt except at nit000 (=rdt) if neuler=0
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC ::   jperio   !: Global domain lateral boundary type (between 0 and 6)
+   !                                !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                !  = 5 North fold F-point pivot
+   !                                !  = 6 cyclic East-West AND North fold F-point pivot
+   INTEGER, PUBLIC ::   nperio   !: Local domain lateral boundary type (deduced from jperio and MPP decomposition)
+
+   !                                 !  domain MPP decomposition parameters
+   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom
+   INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j
+   INTEGER             , PUBLIC ::   nproc            !: number for local processor
+   INTEGER             , PUBLIC ::   narea            !: number for local area
+   INTEGER             , PUBLIC ::   nbondi, nbondj   !: mark of i- and j-direction local boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries  
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries  
+
+   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
+   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
+   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
+   INTEGER, PUBLIC ::   npne, npnw        !: index of north east and north west processor
+   INTEGER, PUBLIC ::   npse, npsw        !: index of south east and south west processor
+   INTEGER, PUBLIC ::   nbne, nbnw        !: logical of north east & north west processor
+   INTEGER, PUBLIC ::   nbse, nbsw        !: logical of south east & south west processor
+   INTEGER, PUBLIC ::   nidom             !: ???
+
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index (mi0=1 and mi1=0 if the global index
+   !                                                                !                                             is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index (mj0=1 and mj1=0 if the global index
+   !                                                                !                                             is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f, ff_t                      !: Coriolis factor at f- & t-points  [1/s]
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
+   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
+   !                                                        !  ref.   ! before  !   now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m]
+
+   !                                                        !  ref.   ! before  !   now   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m]
+   
+   !                                                      !  ref. ! before  !   now   !  after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0            ,    ht_n             !: t-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  ,    hu_b ,    hu_n ,    hu_a   !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  ,    hv_b ,    hv_n ,    hv_a   !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m]
+
+
+   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
+   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
+
+   !! 1D reference  vertical coordinate
+   !! =-----------------====------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m)
+
+
+   !!----------------------------------------------------------------------
+   !! masks, top and bottom ocean point position
+   !! ---------------------------------------------------------------------
+!!gm Proposition of new name for top/bottom vertical indices
+!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top first wet T-, U-, V-, F-level (ISF)
+!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last wet T-, U- and V-level
+!!gm
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+   !!----------------------------------------------------------------------
+   !! calendar variables
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   nhour         !: current hour
+   INTEGER , PUBLIC ::   nminute       !: current minute
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   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: 2) ::   nyear_len     !: length in days of the previous/current/next year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
+   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+
+   !!----------------------------------------------------------------------
+   !! agrif domain
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom
+   !!----------------------------------------------------------------------
+   LOGICAL FUNCTION Agrif_Root()
+      Agrif_Root = .TRUE.
+   END FUNCTION Agrif_Root
+
+   CHARACTER(len=3) FUNCTION Agrif_CFixed()
+      Agrif_CFixed = '0' 
+   END FUNCTION Agrif_CFixed
+#endif
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(12) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
+         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) )
+         !
+      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
+         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     &
+         &                                      nleit(jpnij) , nlejt(jpnij) ,     &
+         &      mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     &
+         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) )
+         !
+      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
+         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
+         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
+         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
+         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
+         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
+         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
+         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
+         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
+         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
+         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) )
+         !
+      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,      &
+         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             &
+         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
+         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   & 
+         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   & 
+         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             &
+         !                                                          !
+         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         &
+         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &               
+         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                       
+         !
+      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           &
+         &                      hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) ,     &
+         &      ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) ,     &
+         &                      hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6)  )
+         !
+         !
+      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(7) )
+         !
+      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
+         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     &
+         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) )
+         !
+      ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) ,     &
+         &      risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) )
+         !
+      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
+         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(11) )
+         !
+      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
+      !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+
+   !!======================================================================
+END MODULE dom_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 8732)
@@ -0,0 +1,695 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dom_init      : initialize the space and time domain
+   !!   dom_glo       : initialize global domain <--> local domain indices
+   !!   dom_nam       : read and contral domain namelists
+   !!   dom_ctl       : control print for the ocean domain
+   !!   domain_cfg    : read the global domain size in domain configuration file
+   !!   cfg_write     : create the domain configuration file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! domain: ocean
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trc_oce        ! shared ocean & passive tracers variab
+   USE phycst         ! physical constants
+   USE usrdef_closea  ! closed seas
+   USE domhgr         ! domain: set the horizontal mesh
+   USE domzgr         ! domain: set the vertical mesh
+   USE dommsk         ! domain: set the mask system
+   USE domwri         ! domain: write the meshmask file
+   USE domvvl         ! variable volume
+   USE c1d            ! 1D configuration
+   USE domc1d         ! 1D configuration: column location
+   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
+   USE wet_dry        ! wetting and drying
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init     ! called by nemogcm.F90
+   PUBLIC   domain_cfg   ! called by nemogcm.F90
+
+   !!-------------------------------------------------------------------------
+   !! NEMO/OPA 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_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - dom_wri: create the meshmask file if nn_msh=1
+      !!              - 1D configuration, move Coriolis, u and v at T-point
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
+      INTEGER ::   iconf = 0    ! local integers
+      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
+      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
+      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_init')
+      !
+      IF(lwp) THEN         ! Ocean domain Parameters (control print)
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+         !
+         WRITE(numout,*)     '   Domain info'
+         WRITE(numout,*)     '      dimension of model:'
+         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
+         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
+         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
+         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
+         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
+         WRITE(numout,*)     '      mpp local domain info (mpp):'
+         WRITE(numout,*)     '              jpni    : ', jpni, '   jpreci  : ', jpreci
+         WRITE(numout,*)     '              jpnj    : ', jpnj, '   jprecj  : ', jprecj
+         WRITE(numout,*)     '              jpnij   : ', jpnij
+         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
+         SELECT CASE ( jperio )
+         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
+         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
+         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
+         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
+         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
+         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
+         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
+         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
+         CASE DEFAULT
+            CALL ctl_stop( 'jperio is out of range' )
+         END SELECT
+         WRITE(numout,*)     '      Ocean model configuration used:'
+         WRITE(numout,*)     '              cn_cfg = ', cn_cfg
+         WRITE(numout,*)     '              nn_cfg = ', nn_cfg
+      ENDIF
+      !
+      !      
+!!gm  This should be removed with the new configuration interface
+      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d )
+!!gm end
+      !
+      !           !==  Reference coordinate system  ==!
+      !
+      CALL dom_glo                     ! global domain versus local domain
+      CALL dom_nam                     ! read namelist ( namrun, namdom )
+      CALL dom_clo( cn_cfg, nn_cfg )   ! Closed seas and lake
+      CALL dom_hgr                     ! Horizontal mesh
+      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
+      IF( nn_closea == 0 )   CALL clo_bat( ik_top, ik_bot )    !==  remove closed seas or lakes  ==!
+      CALL dom_msk( ik_top, ik_bot )   ! Masks
+      !
+      DO jj = 1, jpj                   ! depth of the iceshelves
+         DO ji = 1, jpi
+            ik = mikt(ji,jj)
+            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
+         END DO
+      END DO
+      !
+      ht_0(:,:) = 0._wp  ! Reference ocean thickness
+      hu_0(:,:) = 0._wp
+      hv_0(:,:) = 0._wp
+      DO jk = 1, jpk
+         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
+         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
+         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !
+      !           !==  time varying part of coordinate system  ==!
+      !
+      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
+      !
+         !       before        !          now          !       after         !
+            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
+            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
+                                   gde3w_n = gde3w_0   !        ---          !
+         !                                                                  
+              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
+              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
+              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
+                                     e3f_n =   e3f_0   !        ---          !
+              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
+             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
+             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
+         !
+         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
+         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
+         !
+         !        before       !          now          !       after         !
+                                      ht_n =    ht_0   !                     ! water column thickness
+               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   ! 
+               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
+            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
+            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
+         !
+         !
+      ELSE                       != time varying : initialize before/now/after variables
+         !
+         IF( .NOT.l_offline )  CALL dom_vvl_init 
+         !
+      ENDIF
+      !
+      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
+      !
+      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
+      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
+      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
+      !
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
+         WRITE(numout,*) 
+      ENDIF
+      !
+      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
+      !
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization of global domain <--> local domain indices
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
+      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
+      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop argument
+      !!----------------------------------------------------------------------
+      !
+      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
+        mig(ji) = ji + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + njmpp - 1
+      END DO
+      !                              ! global domain indices ==> local domain indices
+      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
+      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
+      DO ji = 1, jpiglo
+        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
+        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
+      END DO
+      DO jj = 1, jpjglo
+        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
+        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
+      END DO
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
+         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
+         IF( nn_print >= 1 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global i-index domain'
+            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  i-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global j-index domain'
+            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  j-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
+         ENDIF
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+      !
+   END SUBROUTINE dom_glo
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl
+      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
+         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
+         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
+         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
+         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,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         IF( ln_rst_list ) THEN
+            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
+         ELSE
+            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         ENDIF
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
+      ENDIF
+
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+      neuler = nn_euler
+      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
+         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
+         CALL ctl_warn( ctmp1 )
+         neuler = 0
+      ENDIF
+      !                             ! 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
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
+         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea
+         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,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
+         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
+         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
+      ENDIF
+      
+      call flush( numout )
+      !
+!     !          ! conversion DOCTOR names into model names (this should disappear soon)
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
+      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
+      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namnc4 )
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc   ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         !
+         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read the domain size in domain configuration file
+      !!
+      !! ** Method  :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   inum, ii   ! local integer
+      REAL(wp) ::   zorca_res                     ! local scalars
+      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
+      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
+      !
+      CALL iom_open( cn_domcfg, inum )
+      !
+      !                                   !- ORCA family specificity
+      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
+         !
+         cd_cfg = 'ORCA'
+         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
+         !
+         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
+         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
+         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
+         !
+      ELSE                                !- cd_cfg & k_cfg are not used
+         cd_cfg = 'UNKNOWN'
+         kk_cfg = -9999999
+                                          !- or they may be present as global attributes 
+                                          !- (netcdf only)  
+         IF( iom_file(inum)%iolib == jpnf90 ) THEN
+            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
+            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
+            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
+            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
+         ENDIF
+         !
+      ENDIF
+      !
+      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
+      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
+      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
+      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
+      CALL iom_close( inum )
+      !
+      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
+      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
+      !        
+   END SUBROUTINE domain_cfg
+   
+   
+   SUBROUTINE cfg_write
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE cfg_write  ***
+      !!                   
+      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which 
+      !!              contains all the ocean domain informations required to 
+      !!              define an ocean configuration.
+      !!
+      !! ** Method  :   Write in a file all the arrays required to set up an
+      !!              ocean configuration.
+      !!
+      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal 
+      !!                       mesh, Coriolis parameter, and vertical scale factors
+      !!                    NB: also contain ORCA family information
+      !!----------------------------------------------------------------------
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      INTEGER           ::   inum     ! local units
+      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                       ! ============================= !
+      !                       !  create 'domcfg_out.nc' file  !
+      !                       ! ============================= !
+      !         
+      clnam = 'domcfg_out'  ! filename (configuration information)
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
+      
+      !
+      !                             !==  ORCA family specificities  ==!
+      IF( cn_cfg == "ORCA" ) THEN
+         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
+      ENDIF
+      !
+      !                             !==  global domain size  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
+      !
+      !                             !==  domain characteristics  ==!
+      !
+      !                                   ! lateral boundary of the global domain
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !
+      !                                   ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !
+      !                                   ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+      !
+      !                             !==  horizontal mesh  !
+      !
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
+      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
+      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
+      !
+      !                             !==  vertical mesh  ==!
+      !                                                     
+      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
+      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
+      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
+      !                                         
+      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
+      !
+      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
+      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
+      !
+      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
+         CALL dom_stiff( z2d )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
+      ENDIF
+      !
+      IF( ln_wd ) THEN              ! wetting and drying domain
+         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
+         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
+      ENDIF
+      !
+      ! Add some global attributes ( netcdf only )
+      IF( iom_file(inum)%iolib == jpnf90 ) THEN
+         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
+         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
+      ENDIF
+      !
+      !                                ! ============================
+      !                                !        close the files 
+      !                                ! ============================
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE cfg_write
+
+   !!======================================================================
+END MODULE domain
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 8732)
@@ -0,0 +1,235 @@
+MODULE domhgr
+   !!==============================================================================
+   !!                       ***  MODULE domhgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! 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 
+   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
+   !!                                       add optional read of e1e2u & e1e2v
+   !!             -   ! 2016-04  (S. Flavoni, G. Madec) new configuration interface: read or usrdef.F90
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_hgr       : initialize the horizontal mesh 
+   !!   hgr_read      : read horizontal information in the domain configuration file 
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE usrdef_hgr     ! User defined routine
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_hgr   ! called by domain.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_hgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_hgr  ***
+      !!
+      !! ** Purpose :   Read or compute the geographical position (in degrees)  
+      !!      of the model grid-points, the horizontal scale factors (in meters), 
+      !!      the associated horizontal metrics, and the Coriolis factor (in s-1).
+      !!
+      !! ** Method  :   Controlled by ln_read_cfg logical
+      !!              =T : all needed arrays are read in mesh_mask.nc file 
+      !!              =F : user-defined configuration, all needed arrays 
+      !!                   are computed in usr-def_hgr subroutine 
+      !!
+      !!                If Coriolis factor is neither read nor computed (iff=0)
+      !!              it is computed from gphit assuming that the mesh is
+      !!              defined on the sphere :
+      !!                   ff = 2.*omega*sin(gphif)      (in s-1)
+      !!    
+      !!                If u- & v-surfaces are neither read nor computed (ie1e2u_v=0)
+      !!              (i.e. no use of reduced scale factors in some straits)
+      !!              they are computed from e1u, e2u, e1v and e2v as:
+      !!                   e1e2u = e1u*e2u   and   e1e2v = e1v*e2v  
+      !!    
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees)
+      !!              - define Coriolis parameter at f-point                   (in 1/s)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define associated horizontal metrics at t-, u-, v- and f-points
+      !!                (inverse of scale factors 1/e1 & 1/e2, surface e1*e2, ratios e1/e2 & e2/e1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj     ! dummy loop indices
+      INTEGER ::   ie1e2u_v   ! flag for u- & v-surfaces 
+      INTEGER ::   iff        ! flag for Coriolis parameter
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_hgr')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
+         WRITE(numout,*) '~~~~~~~   '
+         WRITE(numout,*) '   namcfg : read (=T) or user defined (=F) configuration    ln_read_cfg  = ', ln_read_cfg
+      ENDIF
+      !
+      !
+      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          read horizontal mesh in ', TRIM( cn_domcfg ), ' file'
+         !
+         CALL hgr_read   ( glamt , glamu , glamv , glamf ,   &    ! geographic position (required)
+            &              gphit , gphiu , gphiv , gphif ,   &    !     -        -
+            &              iff   , ff_f  , ff_t  ,           &    ! Coriolis parameter (if not on the sphere)
+            &              e1t   , e1u   , e1v   , e1f   ,   &    ! scale factors (required)
+            &              e2t   , e2u   , e2v   , e2f   ,   &    !    -     -        -
+            &              ie1e2u_v      , e1e2u , e1e2v     )    ! u- & v-surfaces (if gridsize reduction in some straits)
+         !
+      ELSE                          !==  User defined configuration  ==! 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          User defined horizontal mesh (usr_def_hgr)'
+         !
+         CALL usr_def_hgr( glamt , glamu , glamv , glamf ,   &    ! geographic position (required)
+            &              gphit , gphiu , gphiv , gphif ,   &    !
+            &              iff   , ff_f  , ff_t  ,           &    ! Coriolis parameter  (if domain not on the sphere)
+            &              e1t   , e1u   , e1v   , e1f   ,   &    ! scale factors       (required)
+            &              e2t   , e2u   , e2v   , e2f   ,   &    !
+            &              ie1e2u_v      , e1e2u , e1e2v     )    ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+         !
+      ENDIF
+      !
+      !                             !==  Coriolis parameter  ==!   (if necessary)
+      !
+      IF( iff == 0 ) THEN                 ! Coriolis parameter has not been defined 
+         IF(lwp) WRITE(numout,*) '          Coriolis parameter calculated on the sphere from gphif & gphit'
+         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) )     ! compute it on the sphere at f-point
+         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       -    at t-point
+      ELSE
+         IF( ln_read_cfg ) THEN
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter have been read in ', TRIM( cn_domcfg ), ' file'
+         ELSE
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter have been set in usr_def_hgr routine'
+         ENDIF
+      ENDIF
+
+      !
+      !                             !==  associated horizontal metrics  ==!
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      IF( ie1e2u_v == 0 ) THEN               ! u- & v-surfaces have not been defined
+         IF(lwp) WRITE(numout,*) '          u- & v-surfaces calculated as e1 e2 product'
+         e1e2u (:,:) = e1u(:,:) * e2u(:,:)         ! compute them
+         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+      ELSE
+         IF(lwp) WRITE(numout,*) '          u- & v-surfaces have been read in "mesh_mask" file:'
+         IF(lwp) WRITE(numout,*) '                     grid size reduction in strait(s) is used'
+      ENDIF
+      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in any cases
+      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+      !
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_hgr')
+      !
+   END SUBROUTINE dom_hgr
+
+
+   SUBROUTINE hgr_read( plamt , plamu , plamv  , plamf  ,   &    ! gridpoints position (required)
+      &                 pphit , pphiu , pphiv  , pphif  ,   &     
+      &                 kff   , pff_f , pff_t  ,            &    ! Coriolis parameter  (if not on the sphere)
+      &                 pe1t  , pe1u  , pe1v   , pe1f   ,   &    ! scale factors       (required)
+      &                 pe2t  , pe2u  , pe2v   , pe2f   ,   &
+      &                 ke1e2u_v      , pe1e2u , pe1e2v     )    ! u- & v-surfaces (if gridsize reduction in some straits)
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE hgr_read  ***
+      !!
+      !! ** Purpose :   Read a mesh_mask file in NetCDF format using IOM
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter read here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point (if found in file)
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces read here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v              ! u- & v-surfaces (if found in file)
+      !
+      INTEGER  ::   inum                  ! logical unit
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'hgr_read : read the horizontal coordinates in mesh_mask'
+         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
+      ENDIF
+      !
+      CALL iom_open( cn_domcfg, inum )
+      !
+      CALL iom_get( inum, jpdom_data, 'glamt', plamt, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamu', plamu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamv', plamv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamf', plamf, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'gphit', pphit, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiu', pphiu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiv', pphiv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphif', pphif, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e1t'  , pe1t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u'  , pe1u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v'  , pe1v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f'  , pe1f  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e2t'  , pe2t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u'  , pe2u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v'  , pe2v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f'  , pe2f  , lrowattr=ln_use_jattr )
+      !
+      IF(  iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0    ) THEN
+         IF(lwp) WRITE(numout,*) '           Coriolis factor at f- and t-points read in ', TRIM( cn_domcfg ), ' file'
+         CALL iom_get( inum, jpdom_data, 'ff_f'  , pff_f  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'ff_t'  , pff_t  , lrowattr=ln_use_jattr )
+         kff = 1
+      ELSE
+         kff = 0
+      ENDIF
+      !
+      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file'
+         CALL iom_get( inum, jpdom_data, 'e1e2u'  , pe1e2u  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'e1e2v'  , pe1e2v  , lrowattr=ln_use_jattr )
+         ke1e2u_v = 1
+      ELSE
+         ke1e2u_v = 0
+      ENDIF
+      !
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE hgr_read
+    
+   !!======================================================================
+END MODULE domhgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 8732)
@@ -0,0 +1,299 @@
+MODULE dommsk
+   !!======================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask 
+   !!======================================================================
+   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
+   !!            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
+   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
+   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask
+   !!             -   ! 1998-05  (G. Roullet)  free surface
+   !!            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
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
+   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk       : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE usrdef_fmask   ! user defined fmask
+   USE bdy_oce      
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! Massively Parallel Processing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+   !                            !!* Namelist namlbc : lateral boundary condition *
+   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
+   !                                            with analytical eqs.
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_msk( k_top, k_bot )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) points.
+      !!
+      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top 
+      !!      and ko_bot, the indices of the fist and last ocean t-levels which 
+      !!      are either defined in usrdef_zgr or read in zgr_read.
+      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask) 
+      !!      are deduced from a product of the two neighboring tmask.
+      !!                The vorticity mask (fmask) is deduced from tmask taking
+      !!      into account the choice of lateral boundary condition (rn_shlat) :
+      !!         rn_shlat = 0, free slip  (no shear along the coast)
+      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      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.
+      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
+      !!                due to cyclic or North Fold boundaries as well as MPP halos.
+      !!
+      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask 
+      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
+      !!               fmask   : land/ocean mask at f-point (=0., or =1., or 
+      !!                         =rn_shlat along lateral boundaries)
+      !!               tmask_i : interior ocean mask 
+      !!               tmask_h : halo mask
+      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level
+      !
+      INTEGER  ::   ji, jj, jk     ! dummy loop indices
+      INTEGER  ::   iif, iil       ! local integers
+      INTEGER  ::   ijf, ijl       !   -       -
+      INTEGER  ::   iktop, ikbot   !   -       -
+      INTEGER  ::   ios, inum
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace
+      !!
+      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice_lim, nn_ice_lim_dta,                           &
+         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 &
+         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_msk')
+      !
+      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
+      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namlbc )
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dommsk : ocean mask '
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '   Namelist namlbc'
+         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
+         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
+      ENDIF
+
+      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 '
+      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  strong-slip '
+      ELSE
+         WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat
+         CALL ctl_stop( ctmp1 )
+      ENDIF
+
+
+      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot)
+      ! ----------------------------
+      !
+      tmask(:,:,:) = 0._wp
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            iktop = k_top(ji,jj)
+            ikbot = k_bot(ji,jj)
+            IF( iktop /= 0 ) THEN       ! water in the column
+               tmask(ji,jj,iktop:ikbot  ) = 1._wp
+            ENDIF
+         END DO  
+      END DO  
+!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read !
+!!gm I don't understand why...  
+      CALL lbc_lnk( tmask  , 'T', 1._wp )      ! Lateral boundary conditions
+
+     ! Mask corrections for bdy (read in mppini2)
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
+      ! ------------------------
+      IF ( ln_bdy .AND. ln_mask_file ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
+               END DO
+            END DO
+         END DO
+      ENDIF
+         
+      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
+      ! ----------------------------------------
+      ! NB: at this point, fmask is designed for free slip lateral boundary condition
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector loop
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+            END DO
+            DO ji = 1, jpim1      ! NO vector opt.
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( vmask  , 'V', 1._wp )
+      CALL lbc_lnk( fmask  , 'F', 1._wp )
+
+ 
+      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
+      !-----------------------------------------
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      wumask(:,:,1) = umask(:,:,1)
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
+      END DO
+
+
+      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
+      ! ----------------------------------------------
+      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
+      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
+      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
+
+
+      ! Interior domain mask  (used for global sum)
+      ! --------------------
+      !
+      iif = jpreci   ;   iil = nlci - jpreci + 1
+      ijf = jprecj   ;   ijl = nlcj - jprecj + 1
+      !
+      !                          ! halo mask : 0 on the halo and 1 elsewhere
+      tmask_h(:,:) = 1._wp                  
+      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+      !
+      !                          ! north fold mask
+      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._wp
+         fpol(     1    :jpiglo) = 0._wp
+         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
+            DO ji = iif+1, iil-1
+               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0._wp
+         fpol(jpiglo/2+1:jpiglo) = 0._wp
+      ENDIF
+      !
+      !                          ! interior mask : 2D ocean mask x halo mask 
+      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
+
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------  
+      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
+         !
+         CALL wrk_alloc( jpi,jpj,   zwf )
+         !
+         DO jk = 1, jpk
+            zwf(:,:) = fmask(:,:,jk)         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  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._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._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
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj,   zwf )
+         !
+         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+         !
+         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
+         !
+      ENDIF
+      
+      ! User defined alteration of fmask (use to reduce ocean transport in specified straits)
+      ! -------------------------------- 
+      !
+      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask )
+      !
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_msk')
+      !
+   END SUBROUTINE dom_msk
+   
+   !!======================================================================
+END MODULE dommsk
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 8732)
@@ -0,0 +1,88 @@
+MODULE domngb
+   !!======================================================================
+   !!                       ***  MODULE  domngb  ***
+   !! Grid search:  find the closest grid point from a given on/lat position
+   !!======================================================================
+   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_ngb       : find the closest grid point from a given lon/lat position
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_ngb   ! routine called in iom.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_ngb  ***
+      !!
+      !! ** Purpose :   find the closest grid point from a given lon/lat position
+      !!
+      !! ** Method  :   look for minimum distance in cylindrical projection 
+      !!                -> not good if located at too high latitude...
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
+      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
+      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
+      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
+      !
+      INTEGER :: ik         ! working level
+      INTEGER , DIMENSION(2) ::   iloc
+      REAL(wp)               ::   zlon, zmini
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
+      !
+      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
+      !
+      zmask(:,:) = 0._wp
+      ik = 1
+      IF ( PRESENT(kkk) ) ik=kkk
+      SELECT CASE( cdgrid )
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
+      END SELECT
+
+      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
+      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
+      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
+      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
+      zglam(:,:) = zglam(:,:) - zlon
+
+      zgphi(:,:) = zgphi(:,:) - plat
+      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
+      
+      IF( lk_mpp ) THEN  
+         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
+      ELSE
+         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
+         kii = iloc(1) + nimpp - 1
+         kjj = iloc(2) + njmpp - 1
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
+      !
+   END SUBROUTINE dom_ngb
+
+   !!======================================================================
+END MODULE domngb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 8732)
@@ -0,0 +1,1037 @@
+MODULE domvvl
+   !!======================================================================
+   !!                       ***  MODULE domvvl   ***
+   !! Ocean : 
+   !!======================================================================
+   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code
+   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate
+   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl:
+   !!                                          vvl option includes z_star and z_tilde coordinates
+   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
+   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors
+   !!   dom_vvl_sf_swp   : Swap vertical scale factors and update the vertical grid
+   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another
+   !!   dom_vvl_rst      : read/write restart file
+   !!   dom_vvl_ctl      : Check the vvl options
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE phycst          ! physical constant
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! ocean surface boundary condition
+   USE wet_dry         ! wetting and drying
+   USE usrdef_istate   ! user defined initial state (wad only)
+   USE restart         ! ocean restart
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  dom_vvl_init       ! called by domain.F90
+   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90
+   PUBLIC  dom_vvl_sf_swp     ! called by step.F90
+   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90
+
+   !                                                      !!* Namelist nam_vvl
+   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer
+   !                                                       ! conservation: not used yet
+   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient
+   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days]
+   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days]
+   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation
+   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dom_vvl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION dom_vvl_alloc  ***
+      !!----------------------------------------------------------------------
+      IF( ln_vvl_zstar )   dom_vvl_alloc = 0
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+         ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   &
+            &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   &
+            &      STAT = dom_vvl_alloc        )
+         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
+         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
+         un_td = 0._wp
+         vn_td = 0._wp
+      ENDIF
+      IF( ln_vvl_ztilde ) THEN
+         ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc )
+         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
+         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
+      ENDIF
+      !
+   END FUNCTION dom_vvl_alloc
+
+
+   SUBROUTINE dom_vvl_init
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_init  ***
+      !!                   
+      !! ** Purpose :  Initialization of all scale factors, depths
+      !!               and water column heights
+      !!
+      !! ** Method  :  - use restart file and/or initialize
+      !!               - interpolate scale factors
+      !!
+      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
+      !!              - Regrid: e3(u/v)_n
+      !!                        e3(u/v)_b       
+      !!                        e3w_n           
+      !!                        e3(u/v)w_b      
+      !!                        e3(u/v)w_n      
+      !!                        gdept_n, gdepw_n and gde3w_n
+      !!              - h(t/u/v)_0
+      !!              - frq_rst_e3t and frq_rst_hdv
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk
+      INTEGER ::   ii0, ii1, ij0, ij1
+      REAL(wp)::   zcoef
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
+      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
+      !
+      !                    ! Allocate module arrays
+      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
+      !
+      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
+      CALL dom_vvl_rst( nit000, 'READ' )
+      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
+      !
+      !                    !== Set of all other vertical scale factors  ==!  (now and before)
+      !                                ! Horizontal interpolation of e3t
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V 
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F
+      !                                ! Vertical interpolation of e3t,u,v 
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW
+      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW
+      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+      !
+      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep)
+      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration)
+      gdepw_n(:,:,1) = 0.0_wp
+      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg
+      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1)
+      gdepw_b(:,:,1) = 0.0_wp
+      DO jk = 2, jpk                               ! vertical sum
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+               !                             ! 0.5 where jk = mikt     
+!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
+               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
+               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
+                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
+               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
+               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
+               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
+                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
+            END DO
+         END DO
+      END DO
+      !
+      !                    !==  thickness of the water column  !!   (ocean portion only)
+      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
+      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
+      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)
+      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
+      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
+         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
+         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !
+      !                    !==  inverse of water column thickness   ==!   (u- and v- points)
+      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
+      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
+      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
+
+      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies)
+      IF( ln_vvl_ztilde ) THEN
+!!gm : idea: add here a READ in a file of custumized restoring frequency
+         !                                   ! Values in days provided via the namelist
+         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings
+         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp )
+         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp )
+         !
+         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile
+            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings
+            frq_rst_hdv(:,:) = 1._wp / rdt
+         ENDIF
+         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
+                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
+                     ! values outside the equatorial band and transition zone (ztilde)
+                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
+                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
+                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
+                     ! values inside the equatorial band (ztilde as zstar)
+                     frq_rst_e3t(ji,jj) =  0.0_wp
+                     frq_rst_hdv(ji,jj) =  1.0_wp / rdt
+                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
+                     !                                      ! (linearly transition from z-tilde to z-star)
+                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
+                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                        &                                          * 180._wp / 3.5_wp ) )
+                     frq_rst_hdv(ji,jj) = (1.0_wp / rdt)                                &
+                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp   &
+                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                        &                                          * 180._wp / 3.5_wp ) )
+                  ENDIF
+               END DO
+            END DO
+            IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
+               ii0 = 103   ;   ii1 = 111       
+               ij0 = 128   ;   ij1 = 135   ;   
+               frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp
+               frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init')
+      !
+   END SUBROUTINE dom_vvl_init
+
+
+   SUBROUTINE dom_vvl_sf_nxt( kt, kcall ) 
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_sf_nxt  ***
+      !!                   
+      !! ** Purpose :  - compute the after scale factors used in tra_zdf, dynnxt,
+      !!                 tranxt and dynspg routines
+      !!
+      !! ** Method  :  - z_star case:  Repartition of ssh INCREMENT proportionnaly to the level thickness.
+      !!               - z_tilde_case: after scale factor increment = 
+      !!                                    high frequency part of horizontal divergence
+      !!                                  + retsoring towards the background grid
+      !!                                  + thickness difusion
+      !!                               Then repartition of ssh INCREMENT proportionnaly
+      !!                               to the "baroclinic" level thickness.
+      !!
+      !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case
+      !!               - tilde_e3t_a: after increment of vertical scale factor 
+      !!                              in z_tilde case
+      !!               - e3(t/u/v)_a
+      !!
+      !! Reference  : Leclair, M., and Madec, G. 2011, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )           ::   kt      ! time step
+      INTEGER, INTENT( in ), OPTIONAL ::   kcall   ! optional argument indicating call sequence
+      !
+      INTEGER                ::   ji, jj, jk            ! dummy loop indices
+      INTEGER , DIMENSION(3) ::   ijk_max, ijk_min      ! temporary integers
+      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars
+      LOGICAL                ::   ll_do_bclinic         ! local logical
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_linssh )   RETURN      ! No calculation in linear free surface
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt')
+      !
+      CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv )
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3t )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_nxt : compute after scale factors'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+      ENDIF
+
+      ll_do_bclinic = .TRUE.
+      IF( PRESENT(kcall) ) THEN
+         IF( kcall == 2 .AND. ln_vvl_ztilde )   ll_do_bclinic = .FALSE.
+      ENDIF
+
+      ! ******************************* !
+      ! After acale factors at t-points !
+      ! ******************************* !
+      !                                                ! --------------------------------------------- !
+      !                                                ! z_star coordinate and barotropic z-tilde part !
+      !                                                ! --------------------------------------------- !
+      !
+      z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
+      DO jk = 1, jpkm1
+         ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0)
+         e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
+      END DO
+      !
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate !
+         !                                                            ! ------baroclinic part------ !
+         ! I - initialization
+         ! ==================
+
+         ! 1 - barotropic divergence
+         ! -------------------------
+         zhdiv(:,:) = 0._wp
+         zht(:,:)   = 0._wp
+         DO jk = 1, jpkm1
+            zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
+            zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         END DO
+         zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) )
+
+         ! 2 - Low frequency baroclinic horizontal divergence  (z-tilde case only)
+         ! --------------------------------------------------
+         IF( ln_vvl_ztilde ) THEN
+            IF( kt > nit000 ) THEN
+               DO jk = 1, jpkm1
+                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   &
+                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) )
+               END DO
+            ENDIF
+         ENDIF
+
+         ! II - after z_tilde increments of vertical scale factors
+         ! =======================================================
+         tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms
+
+         ! 1 - High frequency divergence term
+         ! ----------------------------------
+         IF( ln_vvl_ztilde ) THEN     ! z_tilde case
+            DO jk = 1, jpkm1
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) )
+            END DO
+         ELSE                         ! layer case
+            DO jk = 1, jpkm1
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk)
+            END DO
+         ENDIF
+
+         ! 2 - Restoring term (z-tilde case only)
+         ! ------------------
+         IF( ln_vvl_ztilde ) THEN
+            DO jk = 1, jpk
+               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk)
+            END DO
+         ENDIF
+
+         ! 3 - Thickness diffusion term
+         ! ----------------------------
+         zwu(:,:) = 0._wp
+         zwv(:,:) = 0._wp
+         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           &
+                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) )
+                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           & 
+                     &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) )
+                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk)
+                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         DO jj = 1, jpj          ! b - correction for last oceanic u-v points
+            DO ji = 1, jpi
+               un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj)
+               vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj)
+            END DO
+         END DO
+         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    &
+                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    &
+                     &                                            ) * r1_e1e2t(ji,jj)
+               END DO
+            END DO
+         END DO
+         !                       ! d - thickness diffusion transport: boundary conditions
+         !                             (stored for tracer advction and continuity equation)
+         CALL lbc_lnk( un_td , 'U' , -1._wp)
+         CALL lbc_lnk( vn_td , 'V' , -1._wp)
+
+         ! 4 - Time stepping of baroclinic scale factors
+         ! ---------------------------------------------
+         ! Leapfrog time stepping
+         ! ~~~~~~~~~~~~~~~~~~~~~~
+         IF( neuler == 0 .AND. kt == nit000 ) THEN
+            z2dt =  rdt
+         ELSE
+            z2dt = 2.0_wp * rdt
+         ENDIF
+         CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )
+         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:)
+
+         ! Maximum deformation control
+         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         ze3t(:,:,jpk) = 0._wp
+         DO jk = 1, jpkm1
+            ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
+         END DO
+         z_tmax = MAXVAL( ze3t(:,:,:) )
+         IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain
+         z_tmin = MINVAL( ze3t(:,:,:) )
+         IF( lk_mpp )   CALL mpp_min( z_tmin )                 ! min over the global domain
+         ! - ML - test: for the moment, stop simulation for too large e3_t variations
+         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN
+            IF( lk_mpp ) THEN
+               CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3) )
+               CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3) )
+            ELSE
+               ijk_max = MAXLOC( ze3t(:,:,:) )
+               ijk_max(1) = ijk_max(1) + nimpp - 1
+               ijk_max(2) = ijk_max(2) + njmpp - 1
+               ijk_min = MINLOC( ze3t(:,:,:) )
+               ijk_min(1) = ijk_min(1) + nimpp - 1
+               ijk_min(2) = ijk_min(2) + njmpp - 1
+            ENDIF
+            IF (lwp) THEN
+               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax
+               WRITE(numout, *) 'at i, j, k=', ijk_max
+               WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin
+               WRITE(numout, *) 'at i, j, k=', ijk_min            
+               CALL ctl_warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')
+            ENDIF
+         ENDIF
+         ! - ML - end test
+         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below
+         tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) )
+         tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) )
+
+         !
+         ! "tilda" change in the after scale factor
+         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         DO jk = 1, jpkm1
+            dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk)
+         END DO
+         ! III - Barotropic repartition of the sea surface height over the baroclinic profile
+         ! ==================================================================================
+         ! add ( ssh increment + "baroclinicity error" ) proportionly to e3t(n)
+         ! - ML - baroclinicity error should be better treated in the future
+         !        i.e. locally and not spread over the water column.
+         !        (keep in mind that the idea is to reduce Eulerian velocity as much as possible)
+         zht(:,:) = 0.
+         DO jk = 1, jpkm1
+            zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk)
+         END DO
+         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) )
+         DO jk = 1, jpkm1
+            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk)
+         END DO
+
+      ENDIF
+
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer )  THEN   ! z_tilde or layer coordinate !
+      !                                           ! ---baroclinic part--------- !
+         DO jk = 1, jpkm1
+            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk)
+         END DO
+      ENDIF
+
+      IF( ln_vvl_dbg .AND. .NOT. ll_do_bclinic ) THEN   ! - ML - test: control prints for debuging
+         !
+         IF( lwp ) WRITE(numout, *) 'kt =', kt
+         IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+            z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) )
+            IF( lk_mpp ) CALL mpp_max( z_tmax )                             ! max over the global domain
+            IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax
+         END IF
+         !
+         zht(:,:) = 0.0_wp
+         DO jk = 1, jpkm1
+            zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         END DO
+         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) )
+         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax
+         !
+         zht(:,:) = 0.0_wp
+         DO jk = 1, jpkm1
+            zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk)
+         END DO
+         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) )
+         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax
+         !
+         zht(:,:) = 0.0_wp
+         DO jk = 1, jpkm1
+            zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk)
+         END DO
+         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) )
+         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax
+         !
+         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshb(:,:) ) )
+         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax
+         !
+         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( sshn(:,:) ) )
+         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax
+         !
+         z_tmax = MAXVAL( tmask(:,:,1) *  ABS( ssha(:,:) ) )
+         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain
+         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax
+      END IF
+
+      ! *********************************** !
+      ! After scale factors at u- v- points !
+      ! *********************************** !
+
+      CALL dom_vvl_interpol( e3t_a(:,:,:), e3u_a(:,:,:), 'U' )
+      CALL dom_vvl_interpol( e3t_a(:,:,:), e3v_a(:,:,:), 'V' )
+
+      ! *********************************** !
+      ! After depths at u- v points         !
+      ! *********************************** !
+
+      hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1)
+      hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk)
+         hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !                                        ! Inverse of the local depth
+!!gm BUG ?  don't understand the use of umask_i here .....
+      r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) )
+      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) )
+      !
+      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv )
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3t )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt')
+      !
+   END SUBROUTINE dom_vvl_sf_nxt
+
+
+   SUBROUTINE dom_vvl_sf_swp( kt )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_sf_swp  ***
+      !!                   
+      !! ** Purpose :  compute time filter and swap of scale factors 
+      !!               compute all depths and related variables for next time step
+      !!               write outputs and restart file
+      !!
+      !! ** Method  :  - swap of e3t with trick for volume/tracer conservation
+      !!               - reconstruct scale factor at other grid points (interpolate)
+      !!               - recompute depths and water height fields
+      !!
+      !! ** Action  :  - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step
+      !!               - Recompute:
+      !!                    e3(u/v)_b       
+      !!                    e3w_n           
+      !!                    e3(u/v)w_b      
+      !!                    e3(u/v)w_n      
+      !!                    gdept_n, gdepw_n  and gde3w_n
+      !!                    h(u/v) and h(u/v)r
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!              Leclair, M., and G. Madec, 2011, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcoef        ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_linssh )   RETURN      ! No calculation in linear free surface
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp')
+      !
+      IF( kt == nit000 )   THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dom_vvl_sf_swp : - time filter and swap of scale factors'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   - interpolate scale factors and compute depths for next time step'
+      ENDIF
+      !
+      ! Time filter and swap of scale factors
+      ! =====================================
+      ! - ML - e3(t/u/v)_b are allready computed in dynnxt.
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+         IF( neuler == 0 .AND. kt == nit000 ) THEN
+            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:)
+         ELSE
+            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 
+            &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )
+         ENDIF
+         tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)
+      ENDIF
+      gdept_b(:,:,:) = gdept_n(:,:,:)
+      gdepw_b(:,:,:) = gdepw_n(:,:,:)
+
+      e3t_n(:,:,:) = e3t_a(:,:,:)
+      e3u_n(:,:,:) = e3u_a(:,:,:)
+      e3v_n(:,:,:) = e3v_a(:,:,:)
+
+      ! Compute all missing vertical scale factor and depths
+      ! ====================================================
+      ! Horizontal scale factor interpolations
+      ! --------------------------------------
+      ! - ML - e3u_b and e3v_b are allready computed in dynnxt
+      ! - JC - hu_b, hv_b, hur_b, hvr_b also
+      
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F'  )
+      
+      ! Vertical scale factor interpolations
+      CALL dom_vvl_interpol( e3t_n(:,:,:),  e3w_n(:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+      CALL dom_vvl_interpol( e3t_b(:,:,:),  e3w_b(:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+
+      ! t- and w- points depth (set the isf depth as it is in the initial step)
+      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+      gdepw_n(:,:,1) = 0.0_wp
+      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+      DO jk = 2, jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+              !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+                                                                 ! 1 for jk = mikt
+               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
+               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+               gdept_n(ji,jj,jk) =    zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk) )  &
+                   &             + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk) ) 
+               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
+            END DO
+         END DO
+      END DO
+
+      ! Local depth and Inverse of the local depth of the water
+      ! -------------------------------------------------------
+      hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:)
+      hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:)
+      !
+      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)
+      DO jk = 2, jpkm1
+         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+      END DO
+
+      ! write restart file
+      ! ==================
+      IF( lrst_oce )   CALL dom_vvl_rst( kt, 'WRITE' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_sf_swp')
+      !
+   END SUBROUTINE dom_vvl_sf_swp
+
+
+   SUBROUTINE dom_vvl_interpol( pe3_in, pe3_out, pout )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_vvl__interpol  ***
+      !!
+      !! ** Purpose :   interpolate scale factors from one grid point to another
+      !!
+      !! ** Method  :   e3_out = e3_0 + interpolation(e3_in - e3_0)
+      !!                - horizontal interpolation: grid cell surface averaging
+      !!                - vertical interpolation: simple averaging
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3
+      CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors
+      !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
+      !
+      INTEGER ::   ji, jj, jk                                       ! dummy loop indices
+      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd = T/F
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol')
+      !
+      IF(ln_wd) THEN
+        zlnwd = 1.0_wp
+      ELSE
+        zlnwd = 0.0_wp
+      END IF
+      !
+      SELECT CASE ( pout )    !==  type of interpolation  ==!
+         !
+      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
+                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
+         !
+      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
+                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
+         !
+      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+                     &                       *    r1_e1e2f(ji,jj)                                                  &
+                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
+         !
+      CASE( 'W' )                   !* from T- to W-point : vertical simple mean
+         !
+         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)
+         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing
+!!gm BUG? use here wmask in case of ISF ?  to be checked
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   &
+               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               &
+               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     &
+               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
+         END DO
+         !
+      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean
+         !
+         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)
+         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wumask in case of ISF ?  to be checked
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
+         END DO
+         !
+      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean
+         !
+         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)
+         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wvmask in case of ISF ?  to be checked
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
+         END DO
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol')
+      !
+   END SUBROUTINE dom_vvl_interpol
+
+
+   SUBROUTINE dom_vvl_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE dom_vvl_rst  ***
+      !!                     
+      !! ** Purpose :   Read or write VVL file in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!                if the restart does not contain vertical scale factors,
+      !!                they are set to the _0 values
+      !!                if the restart does not contain vertical scale factors increments (z_tilde),
+      !!                they are set to 0.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt     ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
+      !
+      INTEGER ::   ji, jj, jk
+      INTEGER ::   id1, id2, id3, id4, id5     ! local integers
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_rst')
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+         !                                   ! ===============
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            CALL rst_read_open                  !  open the restart file if necessary
+            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+            !
+            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. )
+            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. )
+            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. )
+            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. )
+            !                             ! --------- !
+            !                             ! all cases !
+            !                             ! --------- !
+            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )
+               ! needed to restart if land processor not computed 
+               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files'
+               WHERE ( tmask(:,:,:) == 0.0_wp ) 
+                  e3t_n(:,:,:) = e3t_0(:,:,:)
+                  e3t_b(:,:,:) = e3t_0(:,:,:)
+               END WHERE
+               IF( neuler == 0 ) THEN
+                  e3t_b(:,:,:) = e3t_n(:,:,:)
+               ENDIF
+            ELSE IF( id1 > 0 ) THEN
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files'
+               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'
+               IF(lwp) write(numout,*) 'neuler is forced to 0'
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )
+               e3t_n(:,:,:) = e3t_b(:,:,:)
+               neuler = 0
+            ELSE IF( id2 > 0 ) THEN
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files'
+               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'
+               IF(lwp) write(numout,*) 'neuler is forced to 0'
+               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )
+               e3t_b(:,:,:) = e3t_n(:,:,:)
+               neuler = 0
+            ELSE
+               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file'
+               IF(lwp) write(numout,*) 'Compute scale factor from sshn'
+               IF(lwp) write(numout,*) 'neuler is forced to 0'
+               DO jk = 1, jpk
+                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
+                      &                          / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
+                      &          + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
+               END DO
+               e3t_b(:,:,:) = e3t_n(:,:,:)
+               neuler = 0
+            ENDIF
+            !                             ! ----------- !
+            IF( ln_vvl_zstar ) THEN       ! z_star case !
+               !                          ! ----------- !
+               IF( MIN( id3, id4 ) > 0 ) THEN
+                  CALL ctl_stop( 'dom_vvl_rst: z_star cannot restart from a z_tilde or layer run' )
+               ENDIF
+               !                          ! ----------------------- !
+            ELSE                          ! z_tilde and layer cases !
+               !                          ! ----------------------- !
+               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist
+                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )
+                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )
+               ELSE                            ! one at least array is missing
+                  tilde_e3t_b(:,:,:) = 0.0_wp
+                  tilde_e3t_n(:,:,:) = 0.0_wp
+               ENDIF
+               !                          ! ------------ !
+               IF( ln_vvl_ztilde ) THEN   ! z_tilde case !
+                  !                       ! ------------ !
+                  IF( id5 > 0 ) THEN  ! required array exists
+                     CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) )
+                  ELSE                ! array is missing
+                     hdiv_lf(:,:,:) = 0.0_wp
+                  ENDIF
+               ENDIF
+            ENDIF
+            !
+         ELSE                                   !* Initialize at "rest"
+            !
+            IF( ln_wd .AND. ( cn_cfg == 'wad' ) ) THEN
+              ! Wetting and drying test case
+              CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )
+                       tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
+                       sshn (:,:)     = sshb(:,:)
+                       un   (:,:,:)   = ub  (:,:,:)
+                       vn   (:,:,:)   = vb  (:,:,:)
+                                                ! uniform T-S fields and initial ssh slope
+               ! needs to be called here and in istate which is called later.
+               ! Adjust vertical metrics
+               DO jk = 1, jpk
+                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) &
+                    &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   &
+                    &            + e3t_0(:,:,jk)                               * (1._wp -tmask(:,:,jk))
+               END DO
+               e3t_b(:,:,:) = e3t_n(:,:,:)
+               !
+            ELSEIF( ln_wd ) THEN
+               !
+              DO jj = 1, jpj
+                DO ji = 1, jpi
+                  IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1 ) THEN
+                     ! potential bug
+                     ! Warning this assumes 2 layers only over wetting locations. needs investigating
+                     e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1
+                     e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1
+                     e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1
+                     sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)           !!gm I don't understand that !
+                     sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
+                     ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
+                  ENDIF
+                ENDDO
+              ENDDO
+               !
+            ELSE
+               !
+               e3t_b(:,:,:) = e3t_0(:,:,:)
+               e3t_n(:,:,:) = e3t_0(:,:,:)
+               sshn(:,:) = 0.0_wp
+               !
+            END IF
+
+            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN
+               tilde_e3t_b(:,:,:) = 0._wp
+               tilde_e3t_n(:,:,:) = 0._wp
+               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp
+            END IF
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! ===================
+         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----'
+         !                                           ! --------- !
+         !                                           ! all cases !
+         !                                           ! --------- !
+         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) )
+         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )
+         !                                           ! ----------------------- !
+         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases !
+            !                                        ! ----------------------- !
+            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )
+         END IF
+         !                                           ! -------------!    
+         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case !
+            !                                        ! ------------ !
+            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) )
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst')
+      !
+   END SUBROUTINE dom_vvl_rst
+
+
+   SUBROUTINE dom_vvl_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_vvl_ctl  ***
+      !!                
+      !! ** Purpose :   Control the consistency between namelist options
+      !!                for vertical coordinate
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios
+      !!
+      NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, &
+         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
+         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
+      !!---------------------------------------------------------------------- 
+      !
+      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
+      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_vvl )
+      !
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_vvl_ctl : choice/control of the variable vertical coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '           Namelist nam_vvl : chose a vertical coordinate'
+         WRITE(numout,*) '              zstar                      ln_vvl_zstar   = ', ln_vvl_zstar
+         WRITE(numout,*) '              ztilde                     ln_vvl_ztilde  = ', ln_vvl_ztilde
+         WRITE(numout,*) '              layer                      ln_vvl_layer   = ', ln_vvl_layer
+         WRITE(numout,*) '              ztilde as zstar   ln_vvl_ztilde_as_zstar  = ', ln_vvl_ztilde_as_zstar
+         WRITE(numout,*) '      ztilde near the equator    ln_vvl_zstar_at_eqtor  = ', ln_vvl_zstar_at_eqtor
+         ! WRITE(numout,*) '           Namelist nam_vvl : chose kinetic-to-potential energy conservation'
+         ! WRITE(numout,*) '                                         ln_vvl_kepe    = ', ln_vvl_kepe
+         WRITE(numout,*) '           Namelist nam_vvl : thickness diffusion coefficient'
+         WRITE(numout,*) '                                         rn_ahe3        = ', rn_ahe3
+         WRITE(numout,*) '           Namelist nam_vvl : maximum e3t deformation fractional change'
+         WRITE(numout,*) '                                         rn_zdef_max    = ', rn_zdef_max
+         IF( ln_vvl_ztilde_as_zstar ) THEN
+            WRITE(numout,*) '           ztilde running in zstar emulation mode; '
+            WRITE(numout,*) '           ignoring namelist timescale parameters and using:'
+            WRITE(numout,*) '                 hard-wired : z-tilde to zstar restoration timescale (days)'
+            WRITE(numout,*) '                                         rn_rst_e3t     =    0.0'
+            WRITE(numout,*) '                 hard-wired : z-tilde cutoff frequency of low-pass filter (days)'
+            WRITE(numout,*) '                                         rn_lf_cutoff   =    1.0/rdt'
+         ELSE
+            WRITE(numout,*) '           Namelist nam_vvl : z-tilde to zstar restoration timescale (days)'
+            WRITE(numout,*) '                                         rn_rst_e3t     = ', rn_rst_e3t
+            WRITE(numout,*) '           Namelist nam_vvl : z-tilde cutoff frequency of low-pass filter (days)'
+            WRITE(numout,*) '                                         rn_lf_cutoff   = ', rn_lf_cutoff
+         ENDIF
+         WRITE(numout,*) '           Namelist nam_vvl : debug prints'
+         WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg
+      ENDIF
+      !
+      ioptio = 0                      ! Parameter control
+      IF( ln_vvl_ztilde_as_zstar )   ln_vvl_ztilde = .true.
+      IF( ln_vvl_zstar           )   ioptio = ioptio + 1
+      IF( ln_vvl_ztilde          )   ioptio = ioptio + 1
+      IF( ln_vvl_layer           )   ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
+      IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
+      !
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( ln_vvl_zstar           ) WRITE(numout,*) '              zstar vertical coordinate is used'
+         IF( ln_vvl_ztilde          ) WRITE(numout,*) '              ztilde vertical coordinate is used'
+         IF( ln_vvl_layer           ) WRITE(numout,*) '              layer vertical coordinate is used'
+         IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) '              to emulate a zstar coordinate'
+         ! - ML - Option not developed yet
+         ! IF(       ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option used'
+         ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used'
+      ENDIF
+      !
+#if defined key_agrif
+      IF(.NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented with non-linear free surface' )
+#endif
+      !
+   END SUBROUTINE dom_vvl_ctl
+
+   !!======================================================================
+END MODULE domvvl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 8732)
@@ -0,0 +1,327 @@
+MODULE domwri
+   !!======================================================================
+   !!                       ***  MODULE domwri  ***
+   !! Ocean initialization : write the ocean domain mesh 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
+   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
+   !!            4.0  ! 2016-01  (G. Madec)  simplified mesh_mask.nc file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_wri        : create and write mesh and mask file(s)
+   !!   dom_uniq       : identify unique point of a grid (TUVF)
+   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst ,   ONLY :   rsmall
+   USE wet_dry,   ONLY :   ln_wd, ht_wd
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lbclnk          ! lateral boundary conditions - mpp exchanges
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_wri              ! routine called by inidom.F90
+   PUBLIC   dom_stiff            ! routine called by inidom.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri  ***
+      !!                   
+      !! ** Purpose :   Create 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  :   Write 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)
+      !!            MOD(nn_msh, 3) = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your 
+      !!      vertical coordinate.
+      !!
+      !!      if     nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
+      !!      if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 
+      !!                        corresponding to the depth of the bottom t- and w-points
+      !!      if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the
+      !!                        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           ::   inum    ! temprary units for 'mesh_mask.nc' file
+      CHARACTER(len=21) ::   clnam   ! filename (mesh and mask informations)
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      !                               
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_wri')
+      !
+      CALL wrk_alloc( jpi,jpj,       zprt , zprw  )
+      CALL wrk_alloc( jpi,jpj,jpk,   zdepu, zdepv )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam = 'mesh_mask'  ! filename (mesh and mask informations)
+      
+      !                                  ! ============================
+      !                                  !  create 'mesh_mask.nc' file
+      !                                  ! ============================
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
+      !
+      !                                                         ! global domain size
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 )
+
+      !                                                         ! domain characteristics
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !                                                         ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !                                                         ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+  
+      !                                                         ! masks
+      CALL iom_rstput( 0, 0, inum, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
+      CALL iom_rstput( 0, 0, inum, 'umask', umask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'vmask', vmask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'fmask', fmask, ktype = jp_i1 )
+      
+      CALL dom_uniq( zprw, 'T' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO                             !    ! unique point mask
+      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'U' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'V' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )  
+!!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil
+!!    Here we just remove the output of fmaskutil.
+!      CALL dom_uniq( zprw, 'F' )
+!      DO jj = 1, jpj
+!         DO ji = 1, jpi
+!            zprt(ji,jj) = ssfmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+!         END DO
+!      END DO
+!      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )  
+!!gm
+
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 )       !    ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t', ff_t, ktype = jp_r8 )
+      
+      ! note that mbkt is set to 1 over land ==> use surface tmask
+      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )     !    ! nb of ocean T-points
+      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )       !    ! nb of ocean T-points
+      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 )   !    ! nb of ocean T-points
+      !															             ! vertical mesh
+      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8  )    !    ! scale factors
+      CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0, ktype = jp_r8  )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0, ktype = jp_r8  )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0, ktype = jp_r8  )
+      !
+      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 )  ! stretched system
+      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gdept_0'  , gdept_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gdepw_0'  , gdepw_0  , ktype = jp_r8 )
+      !
+      IF( ln_sco ) THEN                                         ! s-coordinate stiffness
+         CALL dom_stiff( zprt )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )       ! Max. grid stiffness ratio
+      ENDIF
+      !
+      IF( ln_wd ) THEN                                          ! wetting and drying domain
+         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
+         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
+      ENDIF
+      !                                     ! ============================
+      CALL iom_close( inum )                !        close the files 
+      !                                     ! ============================
+      !
+      CALL wrk_dealloc( jpi, jpj, zprt, zprw )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_wri')
+      !
+   END SUBROUTINE dom_wri
+
+
+   SUBROUTINE dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** 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(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_uniq')
+      !
+      CALL wrk_alloc( jpi, jpj, ztstref )
+      !
+      ! 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 /) )
+      !
+      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 )
+      !
+      CALL wrk_dealloc( jpi, jpj, ztstref )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_uniq')
+      !
+   END SUBROUTINE dom_uniq
+
+
+   SUBROUTINE dom_stiff( px1 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_stiff  ***
+      !!                     
+      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
+      !!
+      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
+      !!                Save the maximum in the vertical direction
+      !!                (this number is only relevant in s-coordinates)
+      !!
+      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness
+      !
+      INTEGER  ::   ji, jj, jk 
+      REAL(wp) ::   zrxmax
+      REAL(wp), DIMENSION(4) ::   zr1
+      REAL(wp), DIMENSION(jpi,jpj) ::   zx1
+      !!----------------------------------------------------------------------
+      zx1(:,:) = 0._wp
+      zrxmax   = 0._wp
+      zr1(:)   = 0._wp
+      !
+      DO ji = 2, jpim1
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation....
+!!             especially since it is gde3w which is used to compute the pressure gradient
+!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator
+!!             so that the ratio is computed at the same point (i.e. uw and vw) ....
+               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
+                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
+                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
+               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
+                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
+                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
+               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
+                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
+                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
+               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
+                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
+                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
+               zrxmax = MAXVAL( zr1(1:4) )
+               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zx1, 'T', 1. )
+      !
+      IF( PRESENT( px1 ) )    px1 = zx1
+      !
+      zrxmax = MAXVAL( zx1 )
+      !
+      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
+         WRITE(numout,*) '~~~~~~~~~'
+      ENDIF
+      !
+   END SUBROUTINE dom_stiff
+
+   !!======================================================================
+END MODULE domwri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 8732)
@@ -0,0 +1,328 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean domain : definition of the vertical coordinate system
+   !!==============================================================================
+   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
+   !!                 ! 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
+   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
+   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
+   !!            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
+   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
+   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye  
+   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_zgr       : read or set the ocean vertical coordinate system
+   !!   zgr_read      : read the vertical information in the domain configuration file
+   !!   zgr_top_bot   : ocean top and bottom level for t-, u, and v-points with 1 as minimum value
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! ocean domain
+   USE usrdef_zgr     ! user defined vertical coordinate system
+   USE depth_e3       ! depth <=> e3
+   USE wet_dry, ONLY: ln_wd, ht_wd
+   !
+   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
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_zgr        ! called by dom_init.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS       
+
+   SUBROUTINE dom_zgr( k_top, k_bot )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!              vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate   
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:,:), INTENT(out) ::   k_top, k_bot   ! ocean first and last level indices
+      !
+      INTEGER  ::   jk                  ! dummy loop index
+      INTEGER  ::   ioptio, ibat, ios   ! local integer
+      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m)
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_zgr')
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
+
+
+      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          Read vertical mesh in ', TRIM( cn_domcfg ), ' file'
+         !
+         CALL zgr_read   ( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   & 
+            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth
+            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth 
+            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors
+            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors
+            &              k_top   , k_bot            )                  ! 1st & last ocean level
+         !
+      ELSE                          !==  User defined configuration  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          User defined vertical mesh (usr_def_zgr)'
+         !
+         CALL usr_def_zgr( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   & 
+            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth
+            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth 
+            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors
+            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors
+            &              k_top   , k_bot            )                  ! 1st & last ocean level
+         !
+      ENDIF
+      !
+!!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears
+      ! Compute gde3w_0 (vertical sum of e3w)
+      gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
+      DO jk = 2, jpk
+         gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk)
+      END DO
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_nam) :'
+         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
+      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' )
+
+
+      !                                ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top)
+      CALL zgr_top_bot( k_top, k_bot )      ! with a minimum value set to 1
+      
+
+      !                                ! deepest/shallowest W level Above/Below ~10m
+!!gm BUG in s-coordinate this does not work!
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+      !
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MIN val k_top   ', MINVAL(   k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) )
+         WRITE(numout,*) ' MIN val k_bot   ', MINVAL(   k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
+            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
+            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_zgr')
+      !
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE zgr_read( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,   &   ! type of vertical coordinate
+      &                 pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,   &   ! 1D reference vertical coordinate
+      &                 pdept , pdepw ,                            &   ! 3D t & w-points depth
+      &                 pe3t  , pe3u  , pe3v   , pe3f ,            &   ! vertical scale factors
+      &                 pe3w  , pe3uw , pe3vw         ,            &   !     -      -      -
+      &                 k_top  , k_bot    )                            ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE zgr_read  ***
+      !!
+      !! ** Purpose :   Read the vertical information in the domain configuration file
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth          [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level
+      !
+      INTEGER  ::   jk     ! dummy loop index
+      INTEGER  ::   inum   ! local logical unit
+      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   zgr_read : read the vertical coordinates in ', TRIM( cn_domcfg ), ' file'
+         WRITE(numout,*) '   ~~~~~~~~'
+      ENDIF
+      !
+      CALL iom_open( cn_domcfg, inum )
+      !
+      !                          !* type of vertical coordinate
+      CALL iom_get( inum, 'ln_zco'   , z_zco )
+      CALL iom_get( inum, 'ln_zps'   , z_zps )
+      CALL iom_get( inum, 'ln_sco'   , z_sco )
+      IF( z_zco == 0._wp ) THEN   ;   ld_zco = .false.   ;   ELSE   ;   ld_zco = .true.   ;   ENDIF
+      IF( z_zps == 0._wp ) THEN   ;   ld_zps = .false.   ;   ELSE   ;   ld_zps = .true.   ;   ENDIF
+      IF( z_sco == 0._wp ) THEN   ;   ld_sco = .false.   ;   ELSE   ;   ld_sco = .true.   ;   ENDIF
+      !
+      !                          !* ocean cavities under iceshelves
+      CALL iom_get( inum, 'ln_isfcav', z_cav )
+      IF( z_cav == 0._wp ) THEN   ;   ld_isfcav = .false.   ;   ELSE   ;   ld_isfcav = .true.   ;   ENDIF
+      !
+      !                          !* vertical scale factors
+      CALL iom_get( inum, jpdom_unknown, 'e3t_1d'  , pe3t_1d  )                     ! 1D reference coordinate
+      CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  )
+      !
+      CALL iom_get( inum, jpdom_data, 'e3t_0'  , pe3t  , lrowattr=ln_use_jattr )    ! 3D coordinate
+      CALL iom_get( inum, jpdom_data, 'e3u_0'  , pe3u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e3v_0'  , pe3v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e3f_0'  , pe3f  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e3w_0'  , pe3w  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr )
+      !
+      !                          !* depths
+      !                                   !- old depth definition (obsolescent feature)
+      IF(  iom_varid( inum, 'gdept_1d', ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'gdepw_1d', ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'gdept_0' , ldstop = .FALSE. ) > 0  .AND.  &
+         & iom_varid( inum, 'gdepw_0' , ldstop = .FALSE. ) > 0    ) THEN
+         CALL ctl_warn( 'zgr_read : old definition of depths and scale factors used ', & 
+            &           '           depths at t- and w-points read in the domain configuration file')
+         CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )   
+         CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d )
+         CALL iom_get( inum, jpdom_data   , 'gdept_0' , pdept , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data   , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr )
+         !
+      ELSE                                !- depths computed from e3. scale factors
+         CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )    ! 1D reference depth
+         CALL e3_to_depth( pe3t   , pe3w   , pdept   , pdepw    )    ! 3D depths
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+            WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+            WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+         ENDIF
+      ENDIF
+      !
+      !                          !* ocean top and bottom level
+      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF)
+      k_top(:,:) = INT( z2d(:,:) )
+      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points
+      k_bot(:,:) = INT( z2d(:,:) )
+      !
+      ! bathymetry with orography (wetting and drying only)
+      IF( ln_wd )  CALL iom_get( inum, jpdom_data, 'ht_wd' , ht_wd  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE zgr_read
+
+
+   SUBROUTINE zgr_top_bot( k_top, k_bot )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_top_bot  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from k_top and k_bot with a minimum value of 1 over land
+      !!
+      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1)
+      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1 over land)
+      !!----------------------------------------------------------------------
+      INTEGER , DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! top & bottom ocean level indices
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zk
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_top_bot')
+      !
+      CALL wrk_alloc( jpi,jpj,   zk )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_top_bot : ocean top and bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+      !
+      mikt(:,:) = MAX( k_top(:,:) , 1 )    ! top    ocean k-index of T-level (=1 over land)
+      !
+      mbkt(:,:) = MAX( k_bot(:,:) , 1 )    ! bottom ocean k-index of T-level (=1 over land)
+ 
+      !                                    ! N.B.  top     k-index of W-level = mikt
+      !                                    !       bottom  k-index of W-level = mbkt+1
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
+            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
+            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
+            !
+            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 
+      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   miku(:,:) = MAX( INT( zk(:,:) ), 1 )
+      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mikv(:,:) = MAX( INT( zk(:,:) ), 1 )
+      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( zk, 'F', 1. )   ;   mikf(:,:) = MAX( INT( zk(:,:) ), 1 )
+      !
+      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   mbku(:,:) = MAX( INT( zk(:,:) ), 1 )
+      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zk )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_top_bot')
+      !
+   END SUBROUTINE zgr_top_bot
+
+   !!======================================================================
+END MODULE domzgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 8732)
@@ -0,0 +1,267 @@
+MODULE dtatsd
+   !!======================================================================
+   !!                     ***  MODULE  dtatsd  ***
+   !! Ocean data  :  read ocean Temperature & Salinity Data from gridded 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
+   !!            3.4  ! 2010-11  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dta_tsd      : read and time interpolated ocean Temperature & Salinity Data
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE fldread         ! read input fields
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dta_tsd_init   ! called by opa.F90
+   PUBLIC   dta_tsd        ! called by istate.F90 and tradmp.90
+
+   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag
+   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dta_tsd_init( ld_tradmp )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_tsd_init  ***
+      !!                    
+      !! ** Purpose :   initialisation of T & S input data 
+      !! 
+      !! ** Method  : - Read namtsd namelist
+      !!              - allocates T & S data structure 
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used
+      !
+      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers
+      !!
+      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read
+      TYPE(FLD_N)                   ::   sn_tem, sn_sal
+      !!
+      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init')
+      !
+      !  Initialisation
+      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
+      !
+      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist : 
+      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namtsd )
+
+      IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namtsd'
+         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init   = ', ln_tsd_init
+         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_tradmp = ', ln_tsd_tradmp
+         WRITE(numout,*)
+         IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_tradmp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '   T & S data not used'
+         ENDIF
+      ENDIF
+      !
+      IF( ln_rstart .AND. ln_tsd_init ) THEN
+         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
+            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
+         ln_tsd_init = .FALSE.
+      ENDIF
+      !
+      !                             ! allocate the arrays (if necessary)
+      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN
+         !
+         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
+         IF( ierr0 > 0 ) THEN
+            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
+         ENDIF
+         !
+                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
+         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
+         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+         !
+         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
+            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
+         ENDIF
+         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
+         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
+         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print )
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init')
+      !
+   END SUBROUTINE dta_tsd_init
+
+
+   SUBROUTINE dta_tsd( kt, ptsd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_tsd  ***
+      !!                    
+      !! ** Purpose :   provides T and S data at kt
+      !! 
+      !! ** Method  : - call fldread routine
+      !!              - ORCA_R2: add some hand made alteration to read data  
+      !!              - 'key_orca_lev10' interpolates on 10 times more levels
+      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
+      !!              - ln_tsd_tradmp=F: deallocates the T-S data structure
+      !!                as T-S data are no are used
+      !!
+      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
+      !
+      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
+      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
+      REAL(wp)::   zl, zi
+      REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dta_tsd')
+      !
+      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
+      !
+      !
+!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed
+      !
+      !                                   !==   ORCA_R2 configuration and T & S damping   ==! 
+      IF( cn_cfg == "orca" .AND. nn_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations
+         !
+         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
+         ii0 = 141   ;   ii1 = 155
+         DO jj = mj0(ij0), mj1(ij1)
+            DO ji = mi0(ii0), mi1(ii1)
+               sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
+               sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
+               sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
+               !
+               sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
+               sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
+               sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
+               sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
+            END DO
+         END DO
+         ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
+         ii0 = 148   ;   ii1 = 160
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
+      ENDIF
+!!gm end
+      !
+      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
+      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
+      !
+      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+         !
+         CALL wrk_alloc( jpk, ztp, zsp )
+         !
+         IF( kt == nit000 .AND. lwp )THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
+         ENDIF
+         !
+         DO jj = 1, jpj                         ! vertical interpolation of T & S
+            DO ji = 1, jpi
+               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
+                  zl = gdept_0(ji,jj,jk)
+                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
+                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
+                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
+                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
+                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
+                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
+                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
+                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
+                        ENDIF
+                     END DO
+                  ENDIF
+               END DO
+               DO jk = 1, jpkm1
+                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
+               END DO
+               ptsd(ji,jj,jpk,jp_tem) = 0._wp
+               ptsd(ji,jj,jpk,jp_sal) = 0._wp
+            END DO
+         END DO
+         ! 
+         CALL wrk_dealloc( jpk, ztp, zsp )
+         ! 
+      ELSE                                !==   z- or zps- coordinate   ==!
+         !                             
+         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
+         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
+         !
+         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ik = mbkt(ji,jj) 
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
+                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
+                  ENDIF
+                  ik = mikt(ji,jj)
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
+                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
+                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
+                  END IF
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==! 
+         !                                              (data used only for initialisation)
+         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
+                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
+         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
+                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
+         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
+                                        DEALLOCATE( sf_tsd              )     ! the structure itself
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd')
+      !
+   END SUBROUTINE dta_tsd
+
+   !!======================================================================
+END MODULE dtatsd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90	(revision 8732)
@@ -0,0 +1,321 @@
+MODULE iscplhsb
+   !!======================================================================
+   !!                       ***  MODULE  iscplhsb  ***
+   !! Ocean forcing: ice sheet/ocean coupling (conservation)
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_alloc    : variable allocation
+   !!   iscpl_hsb      : compute and store the input of heat/salt/volume 
+   !!                    into the system due to the coupling process
+   !!   iscpl_div      : correction of divergence to keep volume conservation
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domwri          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface boundary condition variables
+   USE oce             ! global tra/dyn variable
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE lbclnk          !
+   USE domngb          !
+   USE iscplini
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_div   
+   PUBLIC   iscpl_cons       
+   !! * Substitutions  
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iscpl_cons(ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_cons  ***
+      !! 
+      !! ** Purpose :   compute input into the system during the coupling step
+      !!                compute the correction term
+      !!                compute where the correction have to be applied
+      !! 
+      !! ** Method  :   compute tsn*e3t-tsb*e3tb and e3t-e3t_b
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b      !! scale factor before
+      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pts_flx     !! corrective flux to have tracer conservation
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation
+      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period 
+      !!
+      INTEGER :: ji, jj, jk                                    !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1
+      !!
+      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
+      REAL(wp):: r1_rdtiscpl
+      REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio
+      !!
+      REAL(wp):: zde3t, zdtem, zdsal
+      REAL(wp), DIMENSION(:,:), POINTER :: zdssh
+      !!
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
+      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
+      INTEGER :: jpts, npts
+
+      CALL wrk_alloc(jpi,jpj, zdssh )
+
+      ! get imbalance (volume heat and salt)
+      ! initialisation difference
+      zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp
+
+      ! initialisation correction term
+      pvol_flx(:,:,:  ) = 0.0_wp
+      pts_flx (:,:,:,:) = 0.0_wp
+      
+      r1_rdtiscpl = 1._wp / prdt_iscpl 
+
+      ! mask tsn and tsb 
+      tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:);
+      tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:);
+
+      !==============================================================================
+      ! diagnose the heat, salt and volume input and compute the correction variable
+      !==============================================================================
+
+      ! 
+      zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)
+      IF (.NOT. ln_linssh ) zdssh = 0.0_wp ! already included in the levels by definition
+      
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2,fs_jpim1
+               IF (tmask_h(ji,jj) == 1._wp) THEN
+
+                  ! volume differences
+                  zde3t = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk)
+
+                  ! heat diff
+                  zdtem = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
+                        - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
+                  ! salt diff
+                  zdsal = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
+                        - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
+               
+                  ! shh changes
+                  IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN 
+                     zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl
+                     zdssh(ji,jj) = 0._wp
+                  END IF
+
+                  ! volume, heat and salt differences in each cell 
+                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl
+                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl 
+                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl
+
+                  ! case where we close a cell: check if the neighbour cells are wet 
+                  IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
+
+                     jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;
+
+                     zsum =   e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) + e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) &
+                       &    + e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk)
+
+                     IF ( zsum /= 0._wp ) THEN
+                        zjip1_ratio   = e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum
+                        zjim1_ratio   = e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum
+                        zjjp1_ratio   = e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) / zsum
+                        zjjm1_ratio   = e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) / zsum
+
+                        pvol_flx(ji  ,jjp1,jk       ) = pvol_flx(ji  ,jjp1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjp1_ratio
+                        pvol_flx(ji  ,jjm1,jk       ) = pvol_flx(ji  ,jjm1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjm1_ratio
+                        pvol_flx(jip1,jj  ,jk       ) = pvol_flx(jip1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjip1_ratio
+                        pvol_flx(jim1,jj  ,jk       ) = pvol_flx(jim1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjim1_ratio
+                        pts_flx (ji  ,jjp1,jk,jp_sal) = pts_flx (ji  ,jjp1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjp1_ratio
+                        pts_flx (ji  ,jjm1,jk,jp_sal) = pts_flx (ji  ,jjm1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjm1_ratio
+                        pts_flx (jip1,jj  ,jk,jp_sal) = pts_flx (jip1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjip1_ratio
+                        pts_flx (jim1,jj  ,jk,jp_sal) = pts_flx (jim1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjim1_ratio
+                        pts_flx (ji  ,jjp1,jk,jp_tem) = pts_flx (ji  ,jjp1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjp1_ratio
+                        pts_flx (ji  ,jjm1,jk,jp_tem) = pts_flx (ji  ,jjm1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjm1_ratio
+                        pts_flx (jip1,jj  ,jk,jp_tem) = pts_flx (jip1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjip1_ratio
+                        pts_flx (jim1,jj  ,jk,jp_tem) = pts_flx (jim1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjim1_ratio
+
+                        ! set to 0 the cell we distributed over neigbourg cells
+                        pvol_flx(ji,jj,jk       ) = 0._wp
+                        pts_flx (ji,jj,jk,jp_sal) = 0._wp
+                        pts_flx (ji,jj,jk,jp_tem) = 0._wp
+
+                     ELSE IF (zsum == 0._wp ) THEN
+                        ! case where we close a cell and no adjacent cell open
+                        ! check if the cell beneath is wet
+                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
+                           pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk)
+                           pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
+                           pts_flx (ji,jj,jk+1,jp_tem)=  pts_flx (ji,jj,jk+1,jp_tem) + pts_flx (ji,jj,jk,jp_tem)
+
+                           ! set to 0 the cell we distributed over neigbourg cells
+                           pvol_flx(ji,jj,jk       ) = 0._wp
+                           pts_flx (ji,jj,jk,jp_sal) = 0._wp
+                           pts_flx (ji,jj,jk,jp_tem) = 0._wp
+                        ELSE
+                        ! case no adjacent cell on the horizontal and on the vertical
+                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
+                                             ! open for narea== 1 (lwp=T)
+                           WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
+                           WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk
+                           WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea
+                           WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
+                           ENDIF
+                        ! We deal with these points later.
+                        END IF
+                     END IF
+                  END IF
+               END IF
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
+      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
+      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
+
+      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
+      ! allocation and initialisation of the list of problematic point
+      ALLOCATE(inpts(jpnij))
+      inpts(:)=0
+
+      ! fill narea location with the number of problematic point
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2,fs_jpim1
+               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
+                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
+                  inpts(narea) = inpts(narea) + 1 
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! build array of total problematic point on each cpu (share to each cpu)
+      CALL mpp_max(inpts,jpnij) 
+
+      ! size of the new variable
+      npts  = SUM(inpts)    
+      
+      ! allocation of the coordinates, correction, index vector for the problematic points 
+      ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
+      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
+      zcorr_vol(:) = -1.0e20_wp
+      zcorr_sal(:) = -1.0e20_wp
+      zcorr_tem(:) = -1.0e20_wp
+
+      ! fill new variable
+      jpts = SUM(inpts(1:narea-1))
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2,fs_jpim1
+               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
+                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
+                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea
+                  ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk
+                  zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
+                  zcorr_vol(jpts) = pvol_flx(ji,jj,jk)
+                  zcorr_sal(jpts) = pts_flx (ji,jj,jk,jp_sal)
+                  zcorr_tem(jpts) = pts_flx (ji,jj,jk,jp_tem)
+
+                  ! set flx to 0 (safer)
+                  pvol_flx(ji,jj,jk       ) = 0.0_wp
+                  pts_flx (ji,jj,jk,jp_sal) = 0.0_wp
+                  pts_flx (ji,jj,jk,jp_tem) = 0.0_wp
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! build array of total problematic point on each cpu (share to each cpu)
+      ! point coordinates
+      CALL mpp_max(zlat ,npts)
+      CALL mpp_max(zlon ,npts)
+      CALL mpp_max(izpts,npts)
+
+      ! correction values 
+      CALL mpp_max(zcorr_vol,npts)
+      CALL mpp_max(zcorr_sal,npts)
+      CALL mpp_max(zcorr_tem,npts)
+
+      ! put correction term in the closest cell          
+      DO jpts = 1,npts
+         CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts),'T', izpts(jpts))
+         DO jj = mj0(iypts(jpts)),mj1(iypts(jpts))
+            DO ji = mi0(ixpts(jpts)),mi1(ixpts(jpts))
+               jk = izpts(jpts)
+
+               IF (tmask_h(ji,jj) == 1._wp) THEN
+                  ! correct the vol_flx in the closest cell
+                  pvol_flx(ji,jj,jk)        =  pvol_flx(ji,jj,jk       ) + zcorr_vol(jpts)
+                  pts_flx (ji,jj,jk,jp_sal) =  pts_flx (ji,jj,jk,jp_sal) + zcorr_sal(jpts)
+                  pts_flx (ji,jj,jk,jp_tem) =  pts_flx (ji,jj,jk,jp_tem) + zcorr_tem(jpts)
+
+                  ! set correction to 0
+                  zcorr_vol(jpts) = 0.0_wp
+                  zcorr_sal(jpts) = 0.0_wp
+                  zcorr_tem(jpts) = 0.0_wp
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! deallocate variables 
+      DEALLOCATE(inpts)
+      DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
+    
+      ! add contribution store on the hallo (lbclnk remove one of the contribution)
+      pvol_flx(:,:,:       ) = pvol_flx(:,:,:       ) * tmask(:,:,:)
+      pts_flx (:,:,:,jp_sal) = pts_flx (:,:,:,jp_sal) * tmask(:,:,:)
+      pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
+
+      ! compute sum over the halo and set it to 0.
+      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
+      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
+      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+
+      ! deallocate variables
+      CALL wrk_dealloc(jpi,jpj, zdssh ) 
+
+   END SUBROUTINE iscpl_cons
+
+   SUBROUTINE iscpl_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE iscpl_div  ***
+      !!
+      !! ** Purpose :   update the horizontal divergenc
+      !!
+      !! ** Method  :
+      !!                CAUTION : iscpl is positive (inflow) and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   increase by the iscpl correction term
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + hdiv_iscpl(ji,jj,jk) / e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE iscpl_div
+
+END MODULE iscplhsb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90	(revision 8732)
@@ -0,0 +1,85 @@
+MODULE iscplini
+   !!======================================================================
+   !!                       ***  MODULE  sbciscpl  ***
+   !! Ocean forcing:  river runoff
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_init     : initialisation routine (namelist)
+   !!   iscpl_alloc    : allocation of correction variables
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE oce             ! global tra/dyn variable
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_init      
+   PUBLIC   iscpl_alloc 
+   !!                                                      !!* namsbc_iscpl namelist *
+   LOGICAL , PUBLIC                                        ::   ln_hsb
+   INTEGER , PUBLIC                                        ::   nn_fiscpl, nstp_iscpl
+   INTEGER , PUBLIC                                        ::   nn_drown
+   REAL(wp), PUBLIC                                        ::   rdt_iscpl
+   !!                                                      !!* namsbc_iscpl namelist *
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::   hdiv_iscpl
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION iscpl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE sbc_iscpl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc )
+         !
+      IF( lk_mpp          )   CALL mpp_sum ( iscpl_alloc )
+      IF( iscpl_alloc > 0 )   CALL ctl_warn('iscpl_alloc: allocation of arrays failed')
+   END FUNCTION iscpl_alloc
+
+   SUBROUTINE iscpl_init()
+      INTEGER ::   ios           ! Local integer output status for namelist read
+      NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown
+      !!----------------------------------------------------------------------
+      !                                   ! ============
+      !                                   !   Namelist
+      !                                   ! ============
+      !
+      nn_fiscpl = 0
+      ln_hsb    = .FALSE.
+      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling
+      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling
+      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_iscpl )
+      !
+      nstp_iscpl=MIN(nn_fiscpl, nitend-nit000+1) ! the coupling period have to be less or egal than the total number of time step
+      rdt_iscpl = nstp_iscpl * rn_rdt
+      !
+      IF (lwp) THEN
+         WRITE(numout,*) 'iscpl_rst:'
+         WRITE(numout,*) '~~~~~~~~~'
+         WRITE(numout,*) ' coupling     flag (ln_iscpl )            = ', ln_iscpl
+         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb
+         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl
+         IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &
+            &                                           (larger than run length)'
+         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl
+         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
+      END IF
+
+   END SUBROUTINE iscpl_init
+
+END MODULE iscplini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90	(revision 8732)
@@ -0,0 +1,443 @@
+MODULE iscplrst
+   !!======================================================================
+   !!                       ***  MODULE  iscplrst  ***
+   !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_stp          : step management
+   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domwri          ! ocean space and time domain
+   USE domvvl, ONLY : dom_vvl_interpol
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface boundary condition variables
+   USE oce             ! global tra/dyn variable
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE lbclnk          ! communication
+   USE iscplini        ! ice sheet coupling: initialisation
+   USE iscplhsb        ! ice sheet coupling: conservation
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_stp          ! step management 
+   !!
+   !! * Substitutions  
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iscpl_stp
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_stp  ***
+      !! 
+      !! ** Purpose : compute initialisation
+      !!              compute extrapolation of restart variable un, vn, tsn, sshn (wetting/drying)   
+      !!              compute correction term if needed
+      !! 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inum0
+      REAL(wp), DIMENSION(:,:  ), POINTER ::   zsmask_b
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   ztmask_b, zumask_b, zvmask_b
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   ze3t_b  , ze3u_b  , ze3v_b  
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zdepw_b
+      CHARACTER(20) :: cfile
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc(jpi,jpj,jpk,   ztmask_b, zumask_b, zvmask_b) ! mask before
+      CALL wrk_alloc(jpi,jpj,jpk,   ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before
+      CALL wrk_alloc(jpi,jpj,jpk,   zdepw_b )
+      CALL wrk_alloc(jpi,jpj,       zsmask_b                    )
+
+
+      !! get restart variable
+      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S
+      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:) )  ! need to compute temperature correction
+      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)
+
+      !! read namelist
+      CALL iscpl_init()
+
+      !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl)
+      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b )
+
+      !! compute correction if conservation needed
+      IF ( ln_hsb ) THEN
+         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' )
+         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl)
+      END IF
+         
+      !! print mesh/mask
+      IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file
+
+      IF ( ln_hsb ) THEN
+         cfile='correction'
+         cfile = TRIM( cfile )
+         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) )
+         CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) )
+         CALL iom_rstput( 0, 0, inum0, 'sal_cor', htsc_iscpl(:,:,:,jp_sal) )
+         CALL iom_close ( inum0 )
+      END IF
+
+      CALL wrk_dealloc(jpi,jpj,jpk,   ztmask_b,zumask_b,zvmask_b )  
+      CALL wrk_dealloc(jpi,jpj,jpk,   ze3t_b  ,ze3u_b  ,ze3v_b   )  
+      CALL wrk_dealloc(jpi,jpj,jpk,   zdepw_b                    )
+      CALL wrk_dealloc(jpi,jpj,       zsmask_b                   )
+
+      !! next step is an euler time step
+      neuler = 0
+
+      !! set _b and _n variables equal
+      tsb (:,:,:,:) = tsn (:,:,:,:)
+      ub  (:,:,:)   = un  (:,:,:)
+      vb  (:,:,:)   = vn  (:,:,:)
+      sshb(:,:)     = sshn(:,:)
+
+      !! set _b and _n vertical scale factor equal
+      e3t_b (:,:,:) = e3t_n (:,:,:)
+      e3u_b (:,:,:) = e3u_n (:,:,:)
+      e3v_b (:,:,:) = e3v_n (:,:,:)
+
+      e3uw_b (:,:,:) = e3uw_n (:,:,:)
+      e3vw_b (:,:,:) = e3vw_n (:,:,:)
+      gdept_b(:,:,:) = gdept_n(:,:,:)
+      gdepw_b(:,:,:) = gdepw_n(:,:,:)
+      hu_b   (:,:)   = hu_n   (:,:)
+      hv_b   (:,:)   = hv_n   (:,:)
+      r1_hu_b(:,:)   = r1_hu_n(:,:)
+      r1_hv_b(:,:)   = r1_hv_n(:,:)
+      !
+   END SUBROUTINE iscpl_stp
+
+
+   SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_rst_interpol  ***
+      !! 
+      !! ** Purpose :   compute new tn, sn, un, vn and sshn in case of evolving geometry of ice shelves 
+      !!                compute 2d fields of heat, salt and volume correction
+      !! 
+      !! ** Method  :   tn, sn : extrapolation from neigbourg cells
+      !!                un, vn : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
+      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b                        !! mask before
+      !!
+      INTEGER :: ji, jj, jk, iz          !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
+      !!
+      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
+      REAL(wp):: zdz, zdzm1, zdzp1
+      !!
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1
+      REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp
+      REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d
+      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0
+      !!----------------------------------------------------------------------
+
+      !! allocate variables
+      CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   )
+      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        ) 
+      CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       ) 
+      CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       ) 
+      CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
+      CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         ) 
+      CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             ) 
+
+      !! mask value to be sure
+      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:)
+      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:)
+      
+      ! compute wmask
+      zwmaskn(:,:,1) = tmask   (:,:,1)
+      zwmaskb(:,:,1) = ptmask_b(:,:,1)
+      DO jk = 2,jpk
+         zwmaskn(:,:,jk) =  tmask  (:,:,jk) *  tmask  (:,:,jk-1)
+         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1)
+      END DO
+           
+      ! compute new ssh if we open a full water column (average of the closest neigbourgs)  
+      sshb (:,:)=sshn(:,:)
+      zssh0(:,:)=sshn(:,:)
+      zsmask0(:,:) = psmask_b(:,:)
+      zsmask1(:,:) = psmask_b(:,:)
+      DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+)
+         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
+         DO jj = 2,jpj-1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               jip1=ji+1; jim1=ji-1;
+               jjp1=jj+1; jjm1=jj-1;
+               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1))
+               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
+                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     &
+                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     &
+                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     &
+                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk
+                  zsmask1(ji,jj)=1._wp
+               END IF
+            END DO
+         END DO
+         CALL lbc_lnk(sshn,'T',1._wp)
+         CALL lbc_lnk(zsmask1,'T',1._wp)
+         zssh0   = sshn
+         zsmask0 = zsmask1
+      END DO
+      sshn(:,:) = sshn(:,:) * ssmask(:,:)
+
+!=============================================================================
+!PM: Is this needed since introduction of VVL by default?
+      IF (.NOT.ln_linssh) THEN
+      ! Reconstruction of all vertical scale factors at now time steps
+      ! =============================================================================
+      ! Horizontal scale factor interpolations
+      ! --------------------------------------
+         DO jk = 1,jpk
+            DO jj=1,jpj
+               DO ji=1,jpi
+                  IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN
+                     e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + sshn(ji,jj) / ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+
+      ! Vertical scale factor interpolations
+      ! ------------------------------------
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+
+      ! t- and w- points depth
+      ! ----------------------
+         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+         gdepw_n(:,:,1) = 0.0_wp
+         gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               DO jk = 2,mikt(ji,jj)-1
+                  gdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
+                  gde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
+               END DO
+               IF (mikt(ji,jj) > 1) THEN
+                  jk = mikt(ji,jj)
+                  gdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w_n(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
+                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj)
+               END IF
+               DO jk = mikt(ji,jj)+1, jpk
+                  gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn (ji,jj)
+               END DO
+            END DO
+         END DO
+
+      ! t-, u- and v- water column thickness
+      ! ------------------------------------
+         ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp
+         DO jk = 1, jpkm1
+            hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+            hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+            ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         END DO
+         !                                        ! Inverse of the local depth
+         r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:)
+         r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:)
+
+      END IF
+
+!=============================================================================
+! compute velocity
+! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor).
+      ub(:,:,:)=un(:,:,:)
+      vb(:,:,:)=vn(:,:,:)
+      DO jk = 1,jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u_n(ji,jj,jk)*umask(ji,jj,jk);
+               vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v_n(ji,jj,jk)*vmask(ji,jj,jk);
+            END DO
+         END DO
+      END DO
+
+! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column)
+! compute barotropic velocity now and after 
+      ztrp(:,:,:) = ub(:,:,:)*pe3u_b(:,:,:); 
+      zbub(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = vb(:,:,:)*pe3v_b(:,:,:); 
+      zbvb(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = un(:,:,:)*e3u_n(:,:,:); 
+      zbun(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = vn(:,:,:)*e3v_n(:,:,:); 
+      zbvn(:,:)   = SUM(ztrp,DIM=3)
+
+      ! new water column
+      zhu1=0.0_wp ;
+      zhv1=0.0_wp ;
+      DO jk  = 1,jpk
+        zhu1(:,:) = zhu1(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+        zhv1(:,:) = zhv1(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      
+      ! compute correction      
+      zucorr = 0._wp
+      zvcorr = 0._wp
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN
+               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj)
+            END IF
+            IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN
+               zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj)
+            END IF
+         END DO
+      END DO 
+      
+      ! update velocity
+      DO jk  = 1,jpk
+         un(:,:,jk)=(un(:,:,jk) - zucorr(:,:))*umask(:,:,jk)
+         vn(:,:,jk)=(vn(:,:,jk) - zvcorr(:,:))*vmask(:,:,jk)
+      END DO
+
+!=============================================================================
+      ! compute temp and salt
+      ! compute new tn and sn if we open a new cell
+      tsb (:,:,:,:) = tsn(:,:,:,:)
+      zts0(:,:,:,:) = tsn(:,:,:,:)
+      ztmask1(:,:,:) = ptmask_b(:,:,:)
+      ztmask0(:,:,:) = ptmask_b(:,:,:)
+      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
+          DO jk = 1,jpk-1
+              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
+              DO jj = 2,jpj-1
+                 DO ji = fs_2,fs_jpim1
+                      jip1=ji+1; jim1=ji-1;
+                      jjp1=jj+1; jjm1=jj-1;
+                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk))
+                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
+                      !! horizontal basic extrapolation
+                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) &
+                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) &
+                         &                +zts0(ji  ,jjp1,jk,1)*ztmask0(ji  ,jjp1,jk) &
+                         &                +zts0(ji  ,jjm1,jk,1)*ztmask0(ji  ,jjm1,jk) ) / summsk
+                         tsn(ji,jj,jk,2)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) &
+                         &                +zts0(jim1,jj  ,jk,2)*ztmask0(jim1,jj  ,jk) &
+                         &                +zts0(ji  ,jjp1,jk,2)*ztmask0(ji  ,jjp1,jk) &
+                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk
+                         ztmask1(ji,jj,jk)=1
+                      ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN
+                      !! vertical extrapolation if horizontal extrapolation failed
+                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
+                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))
+                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN
+                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
+                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk
+                            tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
+                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk
+                            ztmask1(ji,jj,jk)=1._wp
+                         END IF
+                      END IF
+                  END DO
+              END DO
+          END DO
+          
+          CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp)
+          CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp)
+          CALL lbc_lnk(ztmask1,     'T',1._wp)
+
+          ! update
+          zts0(:,:,:,:) = tsn(:,:,:,:)
+          ztmask0 = ztmask1
+
+      END DO
+
+      ! mask new tsn field
+      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)
+      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)
+
+      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+      !PM: Is this IF needed since change to VVL by default
+      IF (.NOT.ln_linssh) THEN
+         DO jk = 2,jpk-1
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN
+                     !compute weight
+                     zdzp1 = MAX(0._wp,gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1))
+                     zdz   =           gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  ) 
+                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw_n(ji,jj,jk  ))
+                     IF (zdz .LT. 0._wp) THEN 
+                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
+                     END IF
+                     tsn(ji,jj,jk,jp_tem) = ( zdzp1*tsb(ji,jj,jk+1,jp_tem)      &
+                        &                   + zdz  *tsb(ji,jj,jk  ,jp_tem)      &
+                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_tem)      )/e3t_n(ji,jj,jk)
+                     tsn(ji,jj,jk,jp_sal) = ( zdzp1*tsb(ji,jj,jk+1,jp_sal)      &
+                        &                   + zdz  *tsb(ji,jj,jk  ,jp_sal)      &
+                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_sal)      )/e3t_n(ji,jj,jk)
+                  END IF
+               END DO
+            END DO
+         END DO               
+      END IF
+
+      ! closed pool
+      ! -----------------------------------------------------------------------------------------
+      ! case we open a cell but no neigbour cells available to get an estimate of T and S
+      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 
+         tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init)
+         tmask(:,:,:) = 0._wp    ! set mask to 0 to run
+         umask(:,:,:) = 0._wp
+         vmask(:,:,:) = 0._wp
+      END WHERE
+      
+      ! set mbkt and mikt to 1 in thiese location
+      WHERE (SUM(tmask,dim=3) == 0)
+         mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1
+         mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1
+      END WHERE
+      ! -------------------------------------------------------------------------------------------
+      ! compute new tn and sn if we close cell 
+      ! nothing to do
+      ! 
+      ! deallocation tmp arrays
+      CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   )
+      CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                ) 
+      CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              ) 
+      CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       ) 
+      CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
+      CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        ) 
+      CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          ) 
+      !
+   END SUBROUTINE iscpl_rst_interpol
+
+   !!======================================================================
+END MODULE iscplrst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 8732)
@@ -0,0 +1,171 @@
+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
+   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn 
+   !!            3.7  !  2016-04  (S. Flavoni) introduce user defined initial state 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   istate_init   : initial state setting
+   !!   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 divhor         ! horizontal divergence            (div_hor routine)
+   USE dtatsd         ! data temperature and salinity   (dta_tsd routine)
+   USE dtauvd         ! data: U & V current             (dta_uvd routine)
+   USE domvvl          ! varying vertical mesh
+   USE iscplrst        ! ice sheet coupling
+   USE wet_dry         ! wetting and drying (needed for wad_istate)
+   USE usrdef_istate   ! User defined initial state
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE restart         ! restart
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracer fields.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('istate_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_init : Initialization of the dynamics and tracers'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+!!gm  Why not include in the first call of dta_tsd ?  
+!!gm  probably associated with the use of internal damping...
+                     CALL dta_tsd_init        ! Initialisation of T & S input data
+!!gm to be moved in usrdef of C1D case
+!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
+!!gm
+
+      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
+      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
+      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
+      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
+
+      IF( ln_rstart ) THEN                    ! Restart from a file
+         !                                    ! -------------------
+         CALL rst_read                        ! Read the restart file
+         IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry
+         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
+         !
+         IF( ln_tsd_init ) THEN               
+            CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000
+            !
+            sshb(:,:)   = 0._wp               ! set the ocean at rest
+            ub  (:,:,:) = 0._wp
+            vb  (:,:,:) = 0._wp  
+            !
+         ELSE                                 ! user defined initial T and S
+            CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )         
+         ENDIF
+         tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
+         sshn (:,:)     = sshb(:,:)   
+         un   (:,:,:)   = ub  (:,:,:)
+         vn   (:,:,:)   = vb  (:,:,:)
+         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level
+         CALL div_hor( 0 )                    ! compute interior hdivn value  
+!!gm                                    hdivn(:,:,:) = 0._wp
+
+!!gm POTENTIAL BUG :
+!!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed
+!!             as well as gdept and gdepw....   !!!!! 
+!!      ===>>>>   probably a call to domvvl initialisation here....
+
+
+         !
+!!gm to be moved in usrdef of C1D case
+!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
+!            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd )
+!            CALL dta_uvd( nit000, zuvd )
+!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
+!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
+!            CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd )
+!         ENDIF
+         !
+!!gm This is to be changed !!!!
+!         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here
+!         IF( .NOT.ln_linssh ) THEN
+!            DO jk = 1, jpk
+!               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+!            END DO
+!         ENDIF
+!!gm 
+         ! 
+      ENDIF 
+      ! 
+      ! Initialize "now" and "before" barotropic velocities:
+      ! Do it whatever the free surface method, these arrays being eventually used
+      !
+      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
+      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
+      !
+!!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
+               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
+               !
+               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
+               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
+      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
+      !
+      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
+      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('istate_init')
+      !
+   END SUBROUTINE istate_init
+
+   !!======================================================================
+END MODULE istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 8732)
@@ -0,0 +1,194 @@
+MODULE phycst
+   !!======================================================================
+   !!                    ***  MODULE  phycst  ***
+   !!     Definition of of both ocean and ice parameters used in the code
+   !!=====================================================================
+   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes
+   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants
+   !!              -   !  2006-08  (G. Madec)  style 
+   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
+   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   phy_cst  : define and print physical constant and domain parameters
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   phy_cst     ! routine called by inipar.F90
+
+   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi
+   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian
+   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value
+   
+   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
+   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
+   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s]
+   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year
+   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day
+   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour
+   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute
+   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1]
+   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m]
+   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2]
+   
+   REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin]
+   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
+   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
+#if defined key_lim3
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.15_wp        !: melting point of ice          [Kelvin]
+#else
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin]
+#endif
+   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
+   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
+   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
+   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
+   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
+
+   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3]
+   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice
+   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu]
+   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu]
+   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water)
+   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974)
+   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
+   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
+
+#if defined key_lim3 || defined key_cice
+   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K]
+   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K]
+   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg]
+   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg]
+   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity
+   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3]
+#else
+   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K]
+   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K]
+   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K]
+   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K]
+   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K]
+   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3]
+   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg]
+   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3]
+   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3]
+#endif
+#if defined key_cice
+   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K], now namelist parameter for LIM3
+#endif
+#if defined key_lim3
+   REAL(wp), PUBLIC ::   r1_rhoic                    !: 1 / rhoic
+   REAL(wp), PUBLIC ::   r1_rhosn                    !: 1 / rhosn
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+   
+   SUBROUTINE phy_cst
+      !!----------------------------------------------------------------------
+      !!                       ***  ROUTINE phy_cst  ***
+      !!
+      !! ** Purpose :   set and print the constants
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      ! Define & print constants
+      ! ------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '       Constants'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
+
+      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
+      rsiday = rday / ( 1._wp + rday / rsiyea )
+#if defined key_cice
+      omega  = 7.292116e-05
+#else
+      omega  = 2._wp * rpi / rsiday 
+#endif
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
+      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
+      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
+      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
+      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
+      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
+      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+
+      IF(lwp) WRITE(numout,*) '          reference density and heat capacity now defined in eosbn2.f90'
+              
+#if defined key_lim3 || defined key_cice
+      xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3]
+#else
+      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K]
+      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice
+#endif
+#if defined key_lim3
+      r1_rhoic = 1._wp / rhoic
+      r1_rhosn = 1._wp / rhosn
+#endif
+      IF(lwp) THEN
+         WRITE(numout,*)
+#if defined key_cice
+         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K'
+#endif
+         WRITE(numout,*) '          thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K'
+         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K'
+         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg'
+#if defined key_lim3 || defined key_cice
+         WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg'
+#else
+         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K' 
+         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K'
+         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m' 
+         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg' 
+#endif
+         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3' 
+         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
+         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'
+         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic  
+         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu'
+         WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu'
+         WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3' 
+         WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma 
+         WRITE(numout,*) '          von Karman constant                       = ', vkarmn 
+         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad
+         WRITE(numout,*)
+         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall
+      ENDIF
+
+   END SUBROUTINE phy_cst
+
+   !!======================================================================
+END MODULE phycst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90	(revision 8732)
@@ -0,0 +1,105 @@
+MODULE divhor
+   !!==============================================================================
+   !!                       ***  MODULE  divhor  ***
+   !! Ocean diagnostic variable : now horizontal divergence
+   !!==============================================================================
+   !! History :  1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!            3.7  ! 2014-01  (G. Madec) suppression of velocity curl from in-core memory
+   !!             -   ! 2014-12  (G. Madec) suppression of cross land advection option
+   !!             -   ! 2015-10  (G. Madec) add velocity and rnf flag in argument of div_hor
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   div_hor    : Compute the horizontal divergence field
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoff 
+   USE sbcisf          ! ice shelf
+   USE iscplhsb        ! ice sheet / ocean coupling
+   USE iscplini        ! ice sheet / ocean coupling
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   div_hor    ! routine called by step.F90 and istate.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE div_hor( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_hor  ***
+      !!                    
+      !! ** Purpose :   compute the horizontal divergence at now time-step
+      !!
+      !! ** Method  :   the now divergence is computed as :
+      !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 
+      !!
+      !! ** Action  : - update hdivn, the now horizontal divergence
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zraur, zdep   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('div_hor')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence '
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+      !
+      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)        &
+                  &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)        &
+                  &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)        &
+                  &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)   )    &
+                  &            / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+            END DO  
+         END DO  
+         IF( .NOT. AGRIF_Root() ) THEN
+            IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east
+            IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west
+            IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north
+            IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south
+         ENDIF
+      END DO
+      !
+      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field)
+      !
+      IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field)
+      !
+      IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn )  !==  ice sheet  ==!   (update hdivn field)
+      !
+      CALL lbc_lnk( hdivn, 'T', 1. )                !==  lateral boundary cond.  ==!   (no sign change)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('div_hor')
+      !
+   END SUBROUTINE div_hor
+   
+   !!======================================================================
+END MODULE divhor
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 8732)
@@ -0,0 +1,149 @@
+MODULE dynadv
+   !!==============================================================================
+   !!                       ***  MODULE  dynadv  ***
+   !! Ocean active tracers:  advection scheme control
+   !!==============================================================================
+   !! History :  1.0  !  2006-11  (G. Madec)  Original code
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase
+   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_adv      : compute the momentum advection trend 
+   !!   dyn_adv_init : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE dynadv_cen2     ! centred flux form advection      (dyn_adv_cen2 routine)
+   USE dynadv_ubs      ! UBS flux form advection          (dyn_adv_ubs  routine)
+   USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine)
+   USE dynzad          ! vertical advection               (dyn_zad      routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_adv       ! routine called by step module
+   PUBLIC dyn_adv_init  ! routine called by opa  module
+ 
+   !                                    !* namdyn_adv namelist *
+   LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag
+   INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth
+   LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag
+   LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag
+   LOGICAL, PUBLIC ::   ln_dynzad_zts   !: vertical advection with sub-timestepping (requires vector form)
+   
+   INTEGER ::   nadv   ! choice of the formulation and scheme for the advection
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_adv( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_adv  ***
+      !!                
+      !! ** Purpose :   compute the ocean momentum advection trend.
+      !!
+      !! ** Method  : - Update (ua,va) with the advection term following nadv
+      !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T) 
+      !!      a metric term is add to the coriolis term while in vector form 
+      !!      it is the relative vorticity which is added to coriolis term
+      !!      (see dynvor module).
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_adv')
+      !
+      SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend
+      CASE ( 0 )     
+                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
+                      CALL dyn_zad     ( kt )               ! vector form : vertical advection
+      CASE ( 1 )     
+                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
+                      CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping
+      CASE ( 2 ) 
+                      CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme
+      CASE ( 3 )   
+                      CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme
+      END SELECT
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv')
+      !
+   END SUBROUTINE dyn_adv
+
+   
+   SUBROUTINE dyn_adv_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_adv_init  ***
+      !!                
+      !! ** Purpose :   Control the consistency between namelist options for 
+      !!              momentum advection formulation & scheme and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios   ! Local integer
+      !
+      NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
+      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
+      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdyn_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         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'
+         WRITE(numout,*) '      Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec
+         WRITE(numout,*) '      = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg
+         WRITE(numout,*) '      2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2
+         WRITE(numout,*) '      3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs
+         WRITE(numout,*) '      Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts
+      ENDIF
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_dynadv_vec  )   ioptio = ioptio + 1
+      IF( ln_dynadv_cen2 )   ioptio = ioptio + 1
+      IF( ln_dynadv_ubs  )   ioptio = ioptio + 1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
+      IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   &
+         CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' )
+      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   &  
+         CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' )
+
+      !                               ! Set nadv
+      IF( ln_dynadv_vec  )   nadv =  0 
+      IF( ln_dynzad_zts  )   nadv =  1
+      IF( ln_dynadv_cen2 )   nadv =  2
+      IF( ln_dynadv_ubs  )   nadv =  3
+
+      IF(lwp) THEN                    ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  0 )   WRITE(numout,*) '      ===>>   vector form : keg + zad + vor is used' 
+         IF( nadv ==  1 )   WRITE(numout,*) '      ===>>   vector form : keg + zad_zts + vor is used'
+         IF( nadv ==  0 .OR. nadv ==  1 ) THEN
+            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) '              with Centered standard keg scheme'
+            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) '              with Hollingsworth keg scheme'
+         ENDIF
+         IF( nadv ==  2 )   WRITE(numout,*) '      ===>>   flux form   : 2nd order scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '      ===>>   flux form   : UBS       scheme is used'
+      ENDIF
+      !
+   END SUBROUTINE dyn_adv_init
+
+  !!======================================================================
+END MODULE dynadv
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 8732)
@@ -0,0 +1,157 @@
+MODULE dynadv_cen2
+   !!======================================================================
+   !!                       ***  MODULE  dynadv  ***
+   !! Ocean dynamics: Update the momentum trend with the flux form advection
+   !!                 using a 2nd order centred scheme
+   !!======================================================================
+   !! History :  2.0  ! 2006-08  (G. Madec, S. Theetten)  Original code
+   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_adv_cen2  : flux form momentum advection (ln_dynadv_cen2=T) using a 2nd order centred scheme  
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_adv_cen2   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_adv_cen2( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_adv_cen2  ***
+      !!
+      !! ** Purpose :   Compute the now momentum advection trend in flux form
+      !!              and the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time) 
+      !!
+      !! ** Action  :   (ua,va) updated with the now vorticity term trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_adv_cen2')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( l_trddyn ) THEN           ! trends: store the input trends
+         zfu_uw(:,:,:) = ua(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:)
+      ENDIF
+      !
+      !                             !==  Horizontal advection  ==!
+      !
+      DO jk = 1, jpkm1                    ! horizontal transport
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point)
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
+               zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) )
+               zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) )
+               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
+            END DO
+         END DO
+         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic
+         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
+         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt )
+         zfu_t(:,:,:) = ua(:,:,:)
+         zfv_t(:,:,:) = va(:,:,:)
+      ENDIF
+      !
+      !                             !==  Vertical advection  ==!
+      !
+      DO jj = 2, jpjm1                    ! surface/bottom advective fluxes set to zero
+         DO ji = fs_2, fs_jpim1
+            zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(jj,jj,jpk) = 0._wp
+            zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(jj,jj, 1 ) = 0._wp
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                ! linear free surface: advection through the surface
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
+               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      DO jk = 2, jpkm1                    ! interior advective fluxes
+         DO jj = 2, jpj                       ! 1/4 * Vertical transport
+            DO ji = 2, jpi
+               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
+               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
+            END DO
+         END DO
+      END DO
+      DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic
+         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
+         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
+         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
+      ENDIF
+      !                                   ! Control print
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_cen2')
+      !
+   END SUBROUTINE dyn_adv_cen2
+
+   !!==============================================================================
+END MODULE dynadv_cen2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 8732)
@@ -0,0 +1,251 @@
+MODULE dynadv_ubs
+   !!======================================================================
+   !!                       ***  MODULE  dynadv_ubs  ***
+   !! Ocean dynamics: Update the momentum trend with the flux form advection
+   !!                 trend using a 3rd order upstream biased scheme
+   !!======================================================================
+   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
+   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_adv_ubs   : flux form momentum advection using    (ln_dynadv=T)
+   !!                   an 3rd order Upstream Biased Scheme or Quick scheme
+   !!                   combined with 2nd or 4th order finite differences 
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp), PARAMETER :: gamma1 = 1._wp/3._wp  ! =1/4 quick      ; =1/3  3rd order UBS
+   REAL(wp), PARAMETER :: gamma2 = 1._wp/32._wp ! =0   2nd order  ; =1/32 4th order centred
+
+   PUBLIC   dyn_adv_ubs   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_adv_ubs( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_adv_ubs  ***
+      !!
+      !! ** Purpose :   Compute the now momentum advection trend in flux form
+      !!              and the general trend of the momentum equation.
+      !!
+      !! ** Method  :   The scheme is the one implemeted in ROMS. It depends 
+      !!      on two parameter gamma1 and gamma2. The former control the 
+      !!      upstream baised part of the scheme and the later the centred 
+      !!      part:     gamma1 = 0    pure centered  (no diffusive part)
+      !!                       = 1/4  Quick scheme
+      !!                       = 1/3  3rd order Upstream biased scheme
+      !!                gamma2 = 0    2nd order finite differencing 
+      !!                       = 1/32 4th order finite differencing
+      !!      For stability reasons, the first term of the fluxes which cor-
+      !!      responds to a second order centered scheme is evaluated using  
+      !!      the now velocity (centered in time) while the second term which  
+      !!      is the diffusive part of the scheme, is evaluated using the 
+      !!      before velocity (forward in time). 
+      !!      Default value (hard coded in the begining of the module) are 
+      !!      gamma1=1/3 and gamma2=1/32.
+      !!
+      !! ** Action : - (ua,va) updated with the 3D advective momentum trends
+      !!
+      !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu, zfv
+      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zlu_uu, zlv_vv, zlu_uv, zlv_vu
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_adv_ubs')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      zfu_t(:,:,:) = 0._wp
+      zfv_t(:,:,:) = 0._wp
+      zfu_f(:,:,:) = 0._wp
+      zfv_f(:,:,:) = 0._wp
+      !
+      zlu_uu(:,:,:,:) = 0._wp
+      zlv_vv(:,:,:,:) = 0._wp 
+      zlu_uv(:,:,:,:) = 0._wp 
+      zlv_vu(:,:,:,:) = 0._wp 
+      !
+      IF( l_trddyn ) THEN           ! trends: store the input trends
+         zfu_uw(:,:,:) = ua(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:)
+      ENDIF
+      !                                      ! =========================== !
+      DO jk = 1, jpkm1                       !  Laplacian of the velocity  !
+         !                                   ! =========================== !
+         !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         !            
+         DO jj = 2, jpjm1                          ! laplacian
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj  ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj  ,jk) ) * umask(ji,jj,jk)
+               zlv_vv(ji,jj,jk,1) = ( vb (ji  ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
+               zlu_uv(ji,jj,jk,1) = ( ub (ji  ,jj+1,jk) - ub (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+                  &               - ( ub (ji  ,jj  ,jk) - ub (ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
+               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj  ,jk) - vb (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+                  &               - ( vb (ji  ,jj  ,jk) - vb (ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
+               !
+               zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk)
+               zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk)
+               zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+                  &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk)
+               zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   &
+                  &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. )
+      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', 1. )
+      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', 1. )
+      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', 1. ) 
+      !
+      !                                      ! ====================== !
+      !                                      !  Horizontal advection  !
+      DO jk = 1, jpkm1                       ! ====================== !
+         !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+         !
+         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zui = ( un(ji,jj,jk) + un(ji+1,jj  ,jk) )
+               zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) )
+               !
+               IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1)
+               ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1)
+               ENDIF
+               IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1)
+               ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1)
+               ENDIF
+               !
+               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               &
+                  &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   &
+                  &                * ( zui - gamma1 * zl_u)
+               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               &
+                  &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   &
+                  &                * ( zvj - gamma1 * zl_v)
+               !
+               zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) )
+               zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) )
+               IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1)
+               ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1)
+               ENDIF
+               IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1)
+               ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1)
+               ENDIF
+               !
+               zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   &
+                  &                * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) - gamma1 * zl_u )
+               zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   &
+                  &                * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) - gamma1 * zl_v )
+            END DO
+         END DO
+         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
+                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
+                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      IF( l_trddyn ) THEN                          ! trends: send trends to trddyn for diagnostic
+         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
+         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt )
+         zfu_t(:,:,:) = ua(:,:,:)
+         zfv_t(:,:,:) = va(:,:,:)
+      ENDIF
+      !                                      ! ==================== !
+      !                                      !  Vertical advection  !
+      !                                      ! ==================== !
+      DO jj = 2, jpjm1                             ! surface/bottom advective fluxes set to zero                  
+         DO ji = fs_2, fs_jpim1
+            zfu_uw(ji,jj,jpk) = 0._wp
+            zfv_vw(ji,jj,jpk) = 0._wp
+            zfu_uw(ji,jj, 1 ) = 0._wp
+            zfv_vw(ji,jj, 1 ) = 0._wp
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1)
+               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      DO jk = 2, jpkm1                          ! interior fluxes
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) )
+               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) )
+            END DO
+         END DO
+      END DO
+      DO jk = 1, jpkm1                          ! divergence of vertical momentum flux divergence
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( l_trddyn ) THEN                       ! save the vertical advection trend for diagnostic
+         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:)
+         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:)
+         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt )
+      ENDIF
+      !                                         ! Control print
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ubs2 adv - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,        zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )
+      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zlu_uu, zlv_vv, zlu_uv, zlv_vu                               )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs')
+      !
+   END SUBROUTINE dyn_adv_ubs
+
+   !!==============================================================================
+END MODULE dynadv_ubs
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 8732)
@@ -0,0 +1,117 @@
+MODULE dynbfr
+   !!==============================================================================
+   !!                 ***  MODULE  dynbfr  ***
+   !! Ocean dynamics :  bottom friction component of the momentum mixing trend
+   !!==============================================================================
+   !! History :  3.2  ! 2008-11  (A. C. Coward)  Original code
+   !!            3.4  ! 2011-09  (H. Liu) Make it consistent with semi-implicit
+   !!                            Bottom friction (ln_bfrimp = .true.) 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_bfr       : Update the momentum trend with the bottom friction contribution
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE zdf_oce        ! ocean vertical physics variables
+   USE zdfbfr         ! ocean bottom friction variables
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE timing         ! Timing
+   USE wrk_nemo       ! Memory Allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_bfr   !  routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE dyn_bfr( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_bfr  ***
+      !!
+      !! ** Purpose :   compute the bottom friction ocean dynamics physics.
+      !!
+      !! ** Action  :   (ua,va)   momentum trend increased by bottom friction trend
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !! 
+      INTEGER  ::   ji, jj       ! dummy loop indexes
+      INTEGER  ::   ikbu, ikbv   ! local integers
+      REAL(wp) ::   zm1_2dt      ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_bfr')
+      !
+!!gm issue: better to put the logical in step to control the call of zdf_bfr
+!!          ==> change the logical from ln_bfrimp to ln_bfr_exp !!
+      IF( .NOT.ln_bfrimp) THEN     ! only for explicit bottom friction form
+                                    ! implicit bfr is implemented in dynzdf_imp
+
+!!gm bug : time step is only rdt (not 2 rdt if euler start !)
+        zm1_2dt = - 1._wp / ( 2._wp * rdt )
+
+        IF( l_trddyn ) THEN      ! trends: store the input trends
+           CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+           ztrdu(:,:,:) = ua(:,:,:)
+           ztrdv(:,:,:) = va(:,:,:)
+        ENDIF
+
+
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1
+              ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
+              ikbv = mbkv(ji,jj)
+              !
+              ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+              ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
+              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
+           END DO
+        END DO
+        !
+        IF( ln_isfcav ) THEN        ! ocean cavities
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 ! (ISF) stability criteria for top friction
+                 ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
+                 ikbv = mikv(ji,jj)
+                 !
+                 ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
+                    &             * (1.-umask(ji,jj,1))
+                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
+                    &             * (1.-vmask(ji,jj,1))
+                 ! (ISF)
+              END DO
+           END DO
+        END IF
+        !
+        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics
+           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
+           CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+        ENDIF
+        !                                          ! print mean trends (used for debugging)
+        IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr  - Ua: ', mask1=umask,               &
+           &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+        !
+      ENDIF     ! end explicit bottom friction
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_bfr')
+      !
+   END SUBROUTINE dyn_bfr
+
+   !!==============================================================================
+END MODULE dynbfr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 8732)
@@ -0,0 +1,1499 @@
+MODULE dynhpg
+   !!======================================================================
+   !!                       ***  MODULE  dynhpg  ***
+   !! Ocean dynamics:  hydrostatic pressure gradient trend
+   !!======================================================================
+   !! 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
+   !!            3.4  !  2011-11  (H. Liu) hpg_prj: Original code for s-coordinates
+   !!                 !           (A. Coward) suppression of hel, wdj and rot options
+   !!            3.6  !  2014-11  (P. Mathiot) hpg_isf: original code for ice shelf cavity
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_hpg      : update the momentum trend with the now horizontal
+   !!                  gradient of the hydrostatic pressure
+   !!   dyn_hpg_init : initialisation and control of options
+   !!       hpg_zco  : z-coordinate scheme
+   !!       hpg_zps  : z-coordinate plus partial steps (interpolation)
+   !!       hpg_sco  : s-coordinate (standard jacobian formulation)
+   !!       hpg_isf  : s-coordinate (sco formulation) adapted to ice shelf
+   !!       hpg_djc  : s-coordinate (Density Jacobian with Cubic polynomial)
+   !!       hpg_prj  : s-coordinate (Pressure Jacobian with Cubic polynomial)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE sbc_oce         ! surface variable (only for the flag with ice shelf)
+   USE dom_oce         ! ocean space and time domain
+   USE wet_dry         ! wetting and drying
+   USE phycst          ! physical constants
+   USE trd_oce         ! trends: ocean variables
+   USE trddyn          ! trend manager: dynamics
+!jc   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lbclnk          ! lateral boundary condition 
+   USE lib_mpp         ! MPP library
+   USE eosbn2          ! compute density
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_hpg        ! routine called by step module
+   PUBLIC   dyn_hpg_init   ! routine called by opa module
+
+   !                                 !!* Namelist namdyn_hpg : hydrostatic pressure gradient
+   LOGICAL , PUBLIC ::   ln_hpg_zco   !: z-coordinate - full steps
+   LOGICAL , PUBLIC ::   ln_hpg_zps   !: z-coordinate - partial steps (interpolation)
+   LOGICAL , PUBLIC ::   ln_hpg_sco   !: s-coordinate (standard jacobian formulation)
+   LOGICAL , PUBLIC ::   ln_hpg_djc   !: s-coordinate (Density Jacobian with Cubic polynomial)
+   LOGICAL , PUBLIC ::   ln_hpg_prj   !: s-coordinate (Pressure Jacobian scheme)
+   LOGICAL , PUBLIC ::   ln_hpg_isf   !: s-coordinate similar to sco modify for isf
+
+   INTEGER , PUBLIC ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) (PUBLIC for TAM)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_hpg( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_hpg  ***
+      !!
+      !! ** Method  :   Call the hydrostatic pressure gradient routine
+      !!              using the scheme defined in the namelist
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_hpg')
+      !
+      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn)
+         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
+         ztrdu(:,:,:) = ua(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:)
+      ENDIF
+      !
+      SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation
+      CASE (  0 )   ;   CALL hpg_zco    ( kt )      ! z-coordinate
+      CASE (  1 )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation)
+      CASE (  2 )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation)
+      CASE (  3 )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial)
+      CASE (  4 )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme)
+      CASE (  5 )   ;   CALL hpg_isf    ( kt )      ! s-coordinate similar to sco modify for ice shelf
+      END SELECT
+      !
+      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt )
+         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_hpg')
+      !
+   END SUBROUTINE dyn_hpg
+
+
+   SUBROUTINE dyn_hpg_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_hpg_init  ***
+      !!
+      !! ** Purpose :   initializations for the hydrostatic pressure gradient
+      !!              computation and consistency control
+      !!
+      !! ** Action  :   Read the namelist namdyn_hpg and check the consistency
+      !!      with the type of vertical coordinate used (zco, zps, sco)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0      ! temporary integer
+      INTEGER ::   ios             ! Local integer output status for namelist read
+      !!
+      INTEGER  ::   ji, jj, jk, ikt    ! dummy loop indices      ISF
+      REAL(wp) ::   znad
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop, zrhd ! hypothesys on isf density
+      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_isf  ! density at bottom of ISF
+      REAL(wp), POINTER, DIMENSION(:,:)     ::  ziceload     ! density at bottom of ISF
+      !!
+      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     &
+         &                 ln_hpg_djc, ln_hpg_prj, ln_hpg_isf
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient
+      READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient
+      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdyn_hpg )
+      !
+      IF(lwp) THEN                   ! Control print
+         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
+         WRITE(numout,*) '      z-coord. - partial steps (interpolation)          ln_hpg_zps    = ', ln_hpg_zps
+         WRITE(numout,*) '      s-coord. (standard jacobian formulation)          ln_hpg_sco    = ', ln_hpg_sco
+         WRITE(numout,*) '      s-coord. (standard jacobian formulation) for isf  ln_hpg_isf    = ', ln_hpg_isf
+         WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc
+         WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj
+      ENDIF
+      !
+      IF( ln_hpg_djc )   &
+         &   CALL ctl_stop('dyn_hpg_init : Density Jacobian: Cubic polynominal method &
+                           & currently disabled (bugs under investigation). Please select &
+                           & either  ln_hpg_sco or  ln_hpg_prj instead')
+      !
+      IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )        &
+         &   CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', &
+         &                 '   the standard jacobian formulation hpg_sco    or '    , &
+         &                 '   the pressure jacobian formulation hpg_prj'            )
+
+      IF(       ln_hpg_isf .AND. .NOT. ln_isfcav )   &
+         &   CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' )
+      IF( .NOT. ln_hpg_isf .AND.       ln_isfcav )   &
+         &   CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' )
+      !
+      !                               ! Set nhpg from ln_hpg_... flags
+      IF( ln_hpg_zco )   nhpg = 0
+      IF( ln_hpg_zps )   nhpg = 1
+      IF( ln_hpg_sco )   nhpg = 2
+      IF( ln_hpg_djc )   nhpg = 3
+      IF( ln_hpg_prj )   nhpg = 4
+      IF( ln_hpg_isf )   nhpg = 5
+      !
+      !                               ! Consistency check
+      ioptio = 0
+      IF( ln_hpg_zco )   ioptio = ioptio + 1
+      IF( ln_hpg_zps )   ioptio = ioptio + 1
+      IF( ln_hpg_sco )   ioptio = ioptio + 1
+      IF( ln_hpg_djc )   ioptio = ioptio + 1
+      IF( ln_hpg_prj )   ioptio = ioptio + 1
+      IF( ln_hpg_isf )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' )
+      ! 
+      ! initialisation of ice shelf load
+      IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0
+      IF (       ln_isfcav ) THEN
+         CALL wrk_alloc( jpi,jpj, 2,  ztstop) 
+         CALL wrk_alloc( jpi,jpj,jpk, zrhd  )
+         CALL wrk_alloc( jpi,jpj,     zrhdtop_isf, ziceload) 
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'  
+
+         ! To use density and not density anomaly
+         znad=1._wp
+         
+         ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude)
+         ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp
+
+         ! compute density of the water displaced by the ice shelf 
+         DO jk = 1, jpk
+            CALL eos(ztstop(:,:,:),gdept_n(:,:,jk),zrhd(:,:,jk))
+         END DO
+      
+         ! compute rhd at the ice/oce interface (ice shelf side)
+         CALL eos(ztstop,risfdep,zrhdtop_isf)
+
+         ! Surface value + ice shelf gradient
+         ! compute pressure due to ice shelf load (used to compute hpgi/j for all the level from 1 to miku/v)
+         ! divided by 2 later
+         ziceload = 0._wp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt=mikt(ji,jj)
+               ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1))
+               DO jk=2,ikt-1
+                  ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) &
+                     &                              * (1._wp - tmask(ji,jj,jk))
+               END DO
+               IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
+                                  &                              * ( risfdep(ji,jj) - gdept_1d(ikt-1) )
+            END DO
+         END DO
+         riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5
+
+         CALL wrk_dealloc( jpi,jpj, 2,  ztstop) 
+         CALL wrk_dealloc( jpi,jpj,jpk, zrhd  )
+         CALL wrk_dealloc( jpi,jpj,     zrhdtop_isf, ziceload) 
+      END IF
+      !
+   END SUBROUTINE dyn_hpg_init
+
+
+   SUBROUTINE hpg_zco( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE hpg_zco  ***
+      !!
+      !! ** Method  :   z-coordinate case, levels are horizontal surfaces.
+      !!      The now hydrostatic pressure gradient at a given level, jk,
+      !!      is computed by taking the vertical integral of the in-situ
+      !!      density gradient along the model level from the suface to that
+      !!      level:    zhpi = grav .....
+      !!                zhpj = grav .....
+      !!      add it to the general momentum trend (ua,va).
+      !!            ua = ua - 1/e1u * zhpi
+      !!            va = va - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case '
+      ENDIF
+
+      zcoef0 = - grav * 0.5_wp      ! Local constant initialization
+
+      ! Surface value
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+         END DO
+      END DO
+
+      !
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
+               ! hydrostatic pressure gradient
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    &
+                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
+
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    &
+                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj )
+      !
+   END SUBROUTINE hpg_zco
+
+
+   SUBROUTINE hpg_zps( kt )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE hpg_zps  ***
+      !!
+      !! ** Method  :   z-coordinate plus partial steps case.  blahblah...
+      !!
+      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
+      INTEGER  ::   iku, ikv                         ! temporary integers
+      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zhpj )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization'
+      ENDIF
+
+      ! Partial steps: bottom before horizontal gradient of t, s, rd at the last ocean level
+!jc      CALL zps_hde    ( kt, jpts, tsn, gtsu, gtsv, rhd, gru , grv )
+
+      ! Local constant initialization
+      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.
+            zcoef1 = zcoef0 * e3w_n(ji,jj,1)
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+         END DO
+      END DO
+
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef1 = zcoef0 * e3w_n(ji,jj,jk)
+               ! hydrostatic pressure gradient
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
+                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj)
+
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
+                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90)
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) )
+            zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) )
+            IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
+               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value
+               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
+                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj)
+               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
+            ENDIF
+            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) ) * r1_e2v(ji,jj)
+               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
+            ENDIF
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj )
+      !
+   END SUBROUTINE hpg_zps
+
+
+   SUBROUTINE hpg_sco( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE hpg_sco  ***
+      !!
+      !! ** Method  :   s-coordinate case. Jacobian scheme.
+      !!      The now hydrostatic pressure gradient at a given level, jk,
+      !!      is computed by taking the vertical integral of the in-situ
+      !!      density gradient along the model level from the suface to that
+      !!      level. s-coordinates (ln_sco): a corrective term is added
+      !!      to the horizontal pressure gradient :
+      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
+      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
+      !!      add it to the general momentum trend (ua,va).
+      !!         ua = ua - 1/e1u * zhpi
+      !!         va = va - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices
+      REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars
+      LOGICAL  ::   ll_tmp1, ll_tmp2                     ! local logical variables
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy !W/D pressure filter
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
+      ENDIF
+      !
+      zcoef0 = - grav * 0.5_wp
+      IF ( ln_linssh ) THEN   ;   znad = 0._wp         ! Fixed    volume: density anomaly
+      ELSE                    ;   znad = 1._wp         ! Variable volume: density
+      ENDIF
+      !
+      IF( ln_wd ) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                  &                                                         > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
+                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+             IF(ll_tmp1) THEN
+               zcpx(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+             ELSE
+               zcpx(ji,jj) = 0._wp
+             END IF
+      
+             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                  &                                                         > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
+                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+             IF(ll_tmp1) THEN
+               zcpy(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+             ELSE
+               zcpy(ji,jj) = 0._wp
+             END IF
+           END DO
+        END DO
+        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+      END IF
+
+      ! Surface value
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! hydrostatic pressure gradient along s-surfaces
+            zhpi(ji,jj,1) = zcoef0 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    &
+               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    &
+               &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj)
+            ! s-coordinate pressure gradient correction
+            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
+
+
+            IF( ln_wd ) THEN
+
+              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+              zuap = zuap * zcpx(ji,jj)
+              zvap = zvap * zcpy(ji,jj)
+            ENDIF
+
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
+         END DO
+      END DO
+
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   &
+                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   &
+                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   &
+                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
+                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
+               ! s-coordinate pressure gradient correction
+               zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj)
+
+               IF( ln_wd ) THEN
+                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+                 zuap = zuap * zcpx(ji,jj)
+                 zvap = zvap * zcpy(ji,jj)
+               ENDIF
+
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
+      IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
+      !
+   END SUBROUTINE hpg_sco
+
+
+   SUBROUTINE hpg_isf( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE hpg_isf  ***
+      !!
+      !! ** Method  :   s-coordinate case. Jacobian scheme.
+      !!      The now hydrostatic pressure gradient at a given level, jk,
+      !!      is computed by taking the vertical integral of the in-situ
+      !!      density gradient along the model level from the suface to that
+      !!      level. s-coordinates (ln_sco): a corrective term is added
+      !!      to the horizontal pressure gradient :
+      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ]
+      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ]
+      !!      add it to the general momentum trend (ua,va).
+      !!         ua = ua - 1/e1u * zhpi
+      !!         va = va - 1/e2v * zhpj
+      !!      iceload is added and partial cell case are added to the top and bottom
+      !!      
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices
+      REAL(wp) ::   zcoef0, zuap, zvap, znad          ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zhpi, zhpj
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztstop
+      REAL(wp), POINTER, DIMENSION(:,:)     ::  zrhdtop_oce
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,  2, ztstop) 
+      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj)
+      CALL wrk_alloc( jpi,jpj,     zrhdtop_oce )
+      !
+      ! Local constant initialization
+      zcoef0 = - grav * 0.5_wp
+  
+      ! To use density and not density anomaly
+      znad=1._wp
+
+      ! iniitialised to 0. zhpi zhpi 
+      zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp
+
+      ! compute rhd at the ice/oce interface (ocean side)
+      ! usefull to reduce residual current in the test case ISOMIP with no melting
+      DO ji=1,jpi
+        DO jj=1,jpj
+          ikt=mikt(ji,jj)
+          ztstop(ji,jj,1)=tsn(ji,jj,ikt,1)
+          ztstop(ji,jj,2)=tsn(ji,jj,ikt,2)
+        END DO
+      END DO
+      CALL eos( ztstop, risfdep, zrhdtop_oce )
+
+!==================================================================================     
+!===== Compute surface value ===================================================== 
+!==================================================================================
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ikt    = mikt(ji,jj)
+            iktp1i = mikt(ji+1,jj)
+            iktp1j = mikt(ji,jj+1)
+            ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure
+            ! we assume ISF is in isostatic equilibrium
+            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    &
+               &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   &
+               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &
+               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+               &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            ) 
+            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    &
+               &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   &
+               &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
+               &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          &
+               &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            ) 
+            ! s-coordinate pressure gradient correction (=0 if z coordinate)
+            zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   &
+               &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1)
+         END DO
+      END DO
+!==================================================================================     
+!===== Compute interior value ===================================================== 
+!==================================================================================
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+                  &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   &
+                  &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+                  &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   &
+                  &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   )
+               ! s-coordinate pressure gradient correction
+               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+     !
+      CALL wrk_dealloc( jpi,jpj,2  , ztstop)
+      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj)
+      CALL wrk_dealloc( jpi,jpj    , zrhdtop_oce )
+      !
+   END SUBROUTINE hpg_isf
+
+
+   SUBROUTINE hpg_djc( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE hpg_djc  ***
+      !!
+      !! ** Method  :   Density Jacobian with Cubic polynomial scheme
+      !!
+      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      REAL(wp) ::   zcoef0, zep, cffw   ! temporary scalars
+      REAL(wp) ::   z1_10, cffu, cffx   !    "         "
+      REAL(wp) ::   z1_12, cffv, cffy   !    "         "
+      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  dzx, dzy, dzz, dzu, dzv, dzw
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  drhox, drhoy, drhoz, drhou, drhov, drhow
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  rho_i, rho_j, rho_k
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   )
+      CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )
+      CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )
+      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
+      !
+      !
+      IF( ln_wd ) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                  &                                                         > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
+                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+             IF(ll_tmp1) THEN
+               zcpx(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+             ELSE
+               zcpx(ji,jj) = 0._wp
+             END IF
+      
+             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                  &                                                         > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
+                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+             IF(ll_tmp1) THEN
+               zcpy(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+             ELSE
+               zcpy(ji,jj) = 0._wp
+             END IF
+           END DO
+        END DO
+        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+      END IF
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme'
+      ENDIF
+
+      ! Local constant initialization
+      zcoef0 = - grav * 0.5_wp
+      z1_10  = 1._wp / 10._wp
+      z1_12  = 1._wp / 12._wp
+
+      !----------------------------------------------------------------------------------------
+      !  compute and store in provisional arrays elementary vertical and horizontal differences
+      !----------------------------------------------------------------------------------------
+
+!!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1)
+               dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1)
+               drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  )
+               dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  )
+               drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  )
+               dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  )
+            END DO
+         END DO
+      END DO
+
+      !-------------------------------------------------------------------------
+      ! compute harmonic averages using eq. 5.18
+      !-------------------------------------------------------------------------
+      zep = 1.e-15
+
+!!bug  gm  drhoz not defined at level 1 and used (jk-1 with jk=2)
+!!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               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._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._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._wp
+               ENDIF
+
+               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._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._wp
+               ENDIF
+
+               IF( cffx > zep ) THEN
+                  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._wp
+               ENDIF
+
+               IF( cffv > zep ) THEN
+                  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._wp
+               ENDIF
+
+               IF( cffy > zep ) THEN
+                  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._wp
+               ENDIF
+
+            END DO
+         END DO
+      END DO
+
+      !----------------------------------------------------------------------------------
+      ! apply boundary conditions at top and bottom using 5.36-5.37
+      !----------------------------------------------------------------------------------
+      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)
+
+
+      !--------------------------------------------------------------
+      ! Upper half of top-most grid box, compute and store
+      !-------------------------------------------------------------
+
+!!bug gm   :  e3w-gde3w = 0.5*e3w  ....  and gde3w(2)-gde3w(1)=e3w(2) ....   to be verified
+!          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               &
+               &                   * (  rhd(ji,jj,1)                                     &
+               &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  &
+               &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  &
+               &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  )
+         END DO
+      END DO
+
+!!bug gm    : here also, simplification is possible
+!!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   &
+                  &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   &
+                  &            - grav * z1_10 * (                                                                   &
+                  &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     &
+                  &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   &
+                  &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     &
+                  &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   &
+                  &                             )
+
+               rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   &
+                  &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   &
+                  &            - grav* z1_10 * (                                                                    &
+                  &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     &
+                  &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   &
+                  &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     &
+                  &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   &
+                  &                            )
+
+               rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 &
+                  &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   &
+                  &            - grav* z1_10 * (                                                                    &
+                  &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     &
+                  &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   &
+                  &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     &
+                  &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   &
+                  &                            )
+
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk(rho_k,'W',1.)
+      CALL lbc_lnk(rho_i,'U',1.)
+      CALL lbc_lnk(rho_j,'V',1.)
+
+
+      ! ---------------
+      !  Surface value
+      ! ---------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj)
+            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj)
+            IF( ln_wd ) THEN
+              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj)
+              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 
+            ENDIF
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+         END DO
+      END DO
+
+      ! ----------------
+      !  interior value   (2=<jk=<jpkm1)
+      ! ----------------
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                &
+                  &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    &
+                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj)
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                &
+                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    &
+                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj)
+               IF( ln_wd ) THEN
+                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj)
+                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 
+               ENDIF
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, dzx  , dzy  , dzz  , dzu  , dzv  , dzw   )
+      CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow )
+      CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k,  zhpi,  zhpj        )
+      IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
+      !
+   END SUBROUTINE hpg_djc
+
+
+   SUBROUTINE hpg_prj( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE hpg_prj  ***
+      !!
+      !! ** Method  :   s-coordinate case.
+      !!      A Pressure-Jacobian horizontal pressure gradient method
+      !!      based on the constrained cubic-spline interpolation for
+      !!      all vertical coordinate systems
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!----------------------------------------------------------------------
+      INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear
+      INTEGER, INTENT(in) ::   kt                   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices
+      REAL(wp) ::   zcoef0, znad                    ! local scalars
+      !
+      !! The local variables for the correction term
+      INTEGER  :: jk1, jis, jid, jjs, jjd
+      LOGICAL  :: ll_tmp1, ll_tmp2                  ! local logical variables
+      REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps
+      REAL(wp) :: zrhdt1
+      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdept, zrhh
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsshu_n, zsshv_n
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy    !W/D pressure filter
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
+      CALL wrk_alloc( jpi,jpj,jpk,   zdept, zrhh )
+      CALL wrk_alloc( jpi,jpj,       zsshu_n, zsshv_n )
+      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian'
+      ENDIF
+
+      ! Local constant initialization
+      zcoef0 = - grav
+      znad = 1._wp
+      IF( ln_linssh )   znad = 0._wp
+
+      IF( ln_wd ) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1 
+             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                  &                                                         > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji+1,jj) ) > 1.E-12 ) .AND. (             &
+                  &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+
+             IF(ll_tmp1) THEN
+               zcpx(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+               zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                           &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+             ELSE
+               zcpx(ji,jj) = 0._wp
+             END IF
+      
+             ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
+                  &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                  &                                                         > rn_wdmin1 + rn_wdmin2
+             ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1) ) > 1.E-12 ) .AND. (             &
+                  &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                  &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+
+             IF(ll_tmp1) THEN
+               zcpy(ji,jj) = 1.0_wp
+             ELSE IF(ll_tmp2) THEN
+               ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
+               zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                           &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+             ELSE
+               zcpy(ji,jj) = 0._wp
+             END IF
+           END DO
+        END DO
+        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp )
+      END IF
+
+      ! Clean 3-D work arrays
+      zhpi(:,:,:) = 0._wp
+      zrhh(:,:,:) = rhd(:,:,:)
+
+      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate
+      DO jj = 1, jpj
+        DO ji = 1, jpi
+          jk = mbkt(ji,jj)+1
+          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp
+          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk)
+          ELSEIF( jk < jpkm1 ) THEN
+             DO jkk = jk+1, jpk
+                zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),   &
+                   &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2))
+             END DO
+          ENDIF
+        END DO
+      END DO
+
+      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)"
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad
+         END DO
+      END DO
+
+      DO jk = 2, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      fsp(:,:,:) = zrhh (:,:,:)
+      xsp(:,:,:) = zdept(:,:,:)
+
+      ! Construct the vertical density profile with the
+      ! constrained cubic spline interpolation
+      ! rho(z) = asp + bsp*z + csp*z^2 + dsp*z^3
+      CALL cspline( fsp, xsp, asp, bsp, csp, dsp, polynomial_type )
+
+      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)"
+      DO jj = 2, jpj
+        DO ji = 2, jpi
+          zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  &
+             &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1)
+
+          ! assuming linear profile across the top half surface layer
+          zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1
+        END DO
+      END DO
+
+      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)"
+      DO jk = 2, jpkm1
+        DO jj = 2, jpj
+          DO ji = 2, jpi
+            zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  &
+               &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   &
+               &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), &
+               &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  )
+          END DO
+        END DO
+      END DO
+
+      ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1)
+
+      ! Prepare zsshu_n and zsshv_n
+      DO jj = 2, jpjm1
+        DO ji = 2, jpim1
+!!gm BUG ?    if it is ssh at u- & v-point then it should be:
+!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj) * sshn(ji+1,jj)) * &
+!                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji,jj+1) * sshn(ji,jj+1)) * &
+!                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+!!gm not this:
+          zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * &
+                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
+          zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * &
+                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
+        END DO
+      END DO
+
+      CALL lbc_lnk (zsshu_n, 'U', 1.)
+      CALL lbc_lnk (zsshv_n, 'V', 1.)
+
+      DO jj = 2, jpjm1
+        DO ji = 2, jpim1
+          zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad) 
+          zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad)
+        END DO
+      END DO
+
+      DO jk = 2, jpkm1
+        DO jj = 2, jpjm1
+          DO ji = 2, jpim1
+            zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u_n(ji,jj,jk)
+            zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v_n(ji,jj,jk)
+          END DO
+        END DO
+      END DO
+
+      DO jk = 1, jpkm1
+        DO jj = 2, jpjm1
+          DO ji = 2, jpim1
+            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk)
+            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk)
+          END DO
+        END DO
+      END DO
+
+      DO jk = 1, jpkm1
+        DO jj = 2, jpjm1
+          DO ji = 2, jpim1
+            zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+            zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  )
+            zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+            zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  )
+          END DO
+        END DO
+      END DO
+
+
+      DO jk = 1, jpkm1
+        DO jj = 2, jpjm1
+          DO ji = 2, jpim1
+            zpwes = 0._wp; zpwed = 0._wp
+            zpnss = 0._wp; zpnsd = 0._wp
+            zuijk = zu(ji,jj,jk)
+            zvijk = zv(ji,jj,jk)
+
+            !!!!!     for u equation
+            IF( jk <= mbku(ji,jj) ) THEN
+               IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN
+                 jis = ji + 1; jid = ji
+               ELSE
+                 jis = ji;     jid = ji +1
+               ENDIF
+
+               ! integrate the pressure on the shallow side
+               jk1 = jk
+               DO WHILE ( -zdept(jis,jj,jk1) > zuijk )
+                 IF( jk1 == mbku(ji,jj) ) THEN
+                   zuijk = -zdept(jis,jj,jk1)
+                   EXIT
+                 ENDIF
+                 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk)
+                 zpwes = zpwes +                                    &
+                      integ_spline(zdept(jis,jj,jk1), zdeps,            &
+                             asp(jis,jj,jk1),    bsp(jis,jj,jk1), &
+                             csp(jis,jj,jk1),    dsp(jis,jj,jk1))
+                 jk1 = jk1 + 1
+               END DO
+
+               ! integrate the pressure on the deep side
+               jk1 = jk
+               DO WHILE ( -zdept(jid,jj,jk1) < zuijk )
+                 IF( jk1 == 1 ) THEN
+                   zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad)
+                   zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), &
+                                                     bsp(jid,jj,1),   csp(jid,jj,1), &
+                                                     dsp(jid,jj,1)) * zdeps
+                   zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps
+                   EXIT
+                 ENDIF
+                 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk)
+                 zpwed = zpwed +                                        &
+                        integ_spline(zdeps,              zdept(jid,jj,jk1), &
+                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  &
+                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) )
+                 jk1 = jk1 - 1
+               END DO
+
+               ! update the momentum trends in u direction
+
+               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) )
+               IF( .NOT.ln_linssh ) THEN
+                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * &
+                    &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) )
+                ELSE
+                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)
+               ENDIF
+               IF( ln_wd ) THEN
+                  zdpdx1 = zdpdx1 * zcpx(ji,jj)
+                  zdpdx2 = zdpdx2 * zcpx(ji,jj)
+               ENDIF
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 
+            ENDIF
+
+            !!!!!     for v equation
+            IF( jk <= mbkv(ji,jj) ) THEN
+               IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN
+                 jjs = jj + 1; jjd = jj
+               ELSE
+                 jjs = jj    ; jjd = jj + 1
+               ENDIF
+
+               ! integrate the pressure on the shallow side
+               jk1 = jk
+               DO WHILE ( -zdept(ji,jjs,jk1) > zvijk )
+                 IF( jk1 == mbkv(ji,jj) ) THEN
+                   zvijk = -zdept(ji,jjs,jk1)
+                   EXIT
+                 ENDIF
+                 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk)
+                 zpnss = zpnss +                                      &
+                        integ_spline(zdept(ji,jjs,jk1), zdeps,            &
+                               asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), &
+                               csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) )
+                 jk1 = jk1 + 1
+               END DO
+
+               ! integrate the pressure on the deep side
+               jk1 = jk
+               DO WHILE ( -zdept(ji,jjd,jk1) < zvijk )
+                 IF( jk1 == 1 ) THEN
+                   zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad)
+                   zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), &
+                                                     bsp(ji,jjd,1),   csp(ji,jjd,1), &
+                                                     dsp(ji,jjd,1) ) * zdeps
+                   zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps
+                   EXIT
+                 ENDIF
+                 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk)
+                 zpnsd = zpnsd +                                        &
+                        integ_spline(zdeps,              zdept(ji,jjd,jk1), &
+                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), &
+                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) )
+                 jk1 = jk1 - 1
+               END DO
+
+
+               ! update the momentum trends in v direction
+
+               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) )
+               IF( .NOT.ln_linssh ) THEN
+                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * &
+                          ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) )
+               ELSE
+                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd )
+               ENDIF
+               IF( ln_wd ) THEN
+                  zdpdy1 = zdpdy1 * zcpy(ji,jj)
+                  zdpdy2 = zdpdy2 * zcpy(ji,jj)
+               ENDIF
+
+               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk)
+            ENDIF
+               !
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zdept, zrhh )
+      CALL wrk_dealloc( jpi,jpj,       zsshu_n, zsshv_n )
+      IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )
+      !
+   END SUBROUTINE hpg_prj
+
+
+   SUBROUTINE cspline( fsp, xsp, asp, bsp, csp, dsp, polynomial_type )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cspline  ***
+      !!
+      !! ** Purpose :   constrained cubic spline interpolation
+      !!
+      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3
+      !!
+      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function
+      INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear
+      !
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      INTEGER  ::   jpi, jpj, jpkm1
+      REAL(wp) ::   zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp
+      REAL(wp) ::   zdxtmp1, zdxtmp2, zalpha
+      REAL(wp) ::   zdf(size(fsp,3))
+      !!----------------------------------------------------------------------
+      !
+!!gm  WHAT !!!!!   THIS IS VERY DANGEROUS !!!!!  
+      jpi   = size(fsp,1)
+      jpj   = size(fsp,2)
+      jpkm1 = MAX( 1, size(fsp,3) - 1 )
+      !
+      IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+           !!Fritsch&Butland's method, 1984 (preferred, but more computation)
+           !    DO jk = 2, jpkm1-1
+           !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1)
+           !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+           !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1
+           !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2
+           !
+           !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp
+           !
+           !       IF(zdf1 * zdf2 <= 0._wp) THEN
+           !           zdf(jk) = 0._wp
+           !       ELSE
+           !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 )
+           !       ENDIF
+           !    END DO
+
+           !!Simply geometric average
+               DO jk = 2, jpkm1-1
+                  zdf1 = (fsp(ji,jj,jk) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk) - xsp(ji,jj,jk-1))
+                  zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk))
+
+                  IF(zdf1 * zdf2 <= 0._wp) THEN
+                     zdf(jk) = 0._wp
+                  ELSE
+                     zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2)
+                  ENDIF
+               END DO
+
+               zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / &
+                          &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2)
+               zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / &
+                          &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpkm1 - 1)
+
+               DO jk = 1, jpkm1 - 1
+                 zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+                 ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp
+                 ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp
+                 zddf1  = -2._wp * ztmp1 + ztmp2
+                 ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp
+                 zddf2  =  2._wp * ztmp1 - ztmp2
+
+                 dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp
+                 csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp
+                 bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - &
+                               & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - &
+                               & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - &
+                               &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk))
+                 asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + &
+                               &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + &
+                               &                 dsp(ji,jj,jk) * xsp(ji,jj,jk))))
+               END DO
+            END DO
+         END DO
+
+      ELSEIF ( polynomial_type == 2 ) THEN     ! Linear
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+               DO jk = 1, jpkm1-1
+                  zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk)
+                  ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk)
+
+                  dsp(ji,jj,jk) = 0._wp
+                  csp(ji,jj,jk) = 0._wp
+                  bsp(ji,jj,jk) = ztmp1 / zdxtmp
+                  asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+           CALL ctl_stop( 'invalid polynomial type in cspline' )
+      ENDIF
+
+   END SUBROUTINE cspline
+
+
+   FUNCTION interp1(x, xl, xr, fl, fr)  RESULT(f)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE interp1  ***
+      !!
+      !! ** Purpose :   1-d linear interpolation
+      !!
+      !! ** Method  :   interpolation is straight forward
+      !!                extrapolation is also permitted (no value limit)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::  x, xl, xr, fl, fr
+      REAL(wp)             ::  f ! result of the interpolation (extrapolation)
+      REAL(wp)             ::  zdeltx
+      !!----------------------------------------------------------------------
+      !
+      zdeltx = xr - xl
+      IF( abs(zdeltx) <= 10._wp * EPSILON(x) ) THEN
+         f = 0.5_wp * (fl + fr)
+      ELSE
+         f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx
+      ENDIF
+      !
+   END FUNCTION interp1
+
+
+   FUNCTION interp2( x, a, b, c, d )  RESULT(f)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE interp1  ***
+      !!
+      !! ** Purpose :   1-d constrained cubic spline interpolation
+      !!
+      !! ** Method  :  cubic spline interpolation
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::  x, a, b, c, d
+      REAL(wp)             ::  f ! value from the interpolation
+      !!----------------------------------------------------------------------
+      !
+      f = a + x* ( b + x * ( c + d * x ) )
+      !
+   END FUNCTION interp2
+
+
+   FUNCTION interp3( x, a, b, c, d )  RESULT(f)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE interp1  ***
+      !!
+      !! ** Purpose :   Calculate the first order of deriavtive of
+      !!                a cubic spline function y=a+b*x+c*x^2+d*x^3
+      !!
+      !! ** Method  :   f=dy/dx=b+2*c*x+3*d*x^2
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::  x, a, b, c, d
+      REAL(wp)             ::  f ! value from the interpolation
+      !!----------------------------------------------------------------------
+      !
+      f = b + x * ( 2._wp * c + 3._wp * d * x)
+      !
+   END FUNCTION interp3
+
+
+   FUNCTION integ_spline( xl, xr, a, b, c, d )  RESULT(f)
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE interp1  ***
+      !!
+      !! ** Purpose :   1-d constrained cubic spline integration
+      !!
+      !! ** Method  :  integrate polynomial a+bx+cx^2+dx^3 from xl to xr
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::  xl, xr, a, b, c, d
+      REAL(wp)             ::  za1, za2, za3
+      REAL(wp)             ::  f                   ! integration result
+      !!----------------------------------------------------------------------
+      !
+      za1 = 0.5_wp * b
+      za2 = c / 3.0_wp
+      za3 = 0.25_wp * d
+      !
+      f  = xr * ( a + xr * ( za1 + xr * ( za2 + za3 * xr ) ) ) - &
+         & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) )
+      !
+   END FUNCTION integ_spline
+
+   !!======================================================================
+END MODULE dynhpg
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 8732)
@@ -0,0 +1,202 @@
+MODULE dynkeg
+   !!======================================================================
+   !!                       ***  MODULE  dynkeg  ***
+   !! Ocean dynamics:  kinetic energy gradient trend
+   !!======================================================================
+   !! History :  1.0  !  1987-09  (P. Andrich, M.-A. Foujols)  Original code
+   !!            7.0  !  1997-05  (G. Madec)  Split dynber into dynkeg and dynhpg
+   !!  NEMO      1.0  !  2002-07  (G. Madec)  F90: Free form and module
+   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option 
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dyn_keg      : update the momentum trend with the horizontal tke
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trd_oce         ! trends: ocean variables
+   USE trddyn          ! trend manager: dynamics
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE bdy_oce         ! ocean open boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_keg    ! routine called by step module
+   
+   INTEGER, PARAMETER, PUBLIC  ::   nkeg_C2  = 0   !: 2nd order centered scheme (standard scheme)
+   INTEGER, PARAMETER, PUBLIC  ::   nkeg_HW  = 1   !: Hollingsworth et al., QJRMS, 1983
+   !
+   REAL(wp) ::   r1_48 = 1._wp / 48._wp   !: =1/(4*2*6)
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_keg( kt, kscheme )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_keg  ***
+      !!
+      !! ** Purpose :   Compute the now momentum trend due to the horizontal
+      !!      gradient of the horizontal kinetic energy and add it to the 
+      !!      general momentum trend.
+      !!
+      !! ** Method  : * kscheme = nkeg_C2 : 2nd order centered scheme that 
+      !!      conserve kinetic energy. Compute the now horizontal kinetic energy 
+      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ]
+      !!              * kscheme = nkeg_HW : Hollingsworth correction following
+      !!      Arakawa (2001). The now horizontal kinetic energy is given by:
+      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  )
+      !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ]
+      !!      
+      !!      Take its horizontal gradient and add it to the general momentum
+      !!      trend (ua,va).
+      !!         ua = ua - 1/e1u di[ zhke ]
+      !!         va = va - 1/e2v dj[ zhke ]
+      !!
+      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend
+      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing
+      !!
+      !! ** References : Arakawa, A., International Geophysics 2001.
+      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme 
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zu, zv       ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 
+      INTEGER  ::   jb                 ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd, ib_bdy   ! local integers
+      INTEGER  ::   fu, fv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_keg')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zhke )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF( l_trddyn ) THEN           ! Save ua and va trends
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+         ztrdu(:,:,:) = ua(:,:,:) 
+         ztrdv(:,:,:) = va(:,:,:) 
+      ENDIF
+      
+      zhke(:,:,jpk) = 0._wp
+      
+      IF (ln_bdy) THEN
+         ! Maria Luneva & Fred Wobus: July-2016
+         ! compensate for lack of turbulent kinetic energy on liquid bdy points
+         DO ib_bdy = 1, nb_bdy
+            IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
+               igrd = 2           ! Copying normal velocity into points outside bdy
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+                  DO jk = 1, jpkm1
+                     ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
+                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
+                     fu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) )
+                     un(ii-fu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk)
+                  END DO
+               END DO
+               !
+               igrd = 3           ! Copying normal velocity into points outside bdy
+               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
+                  DO jk = 1, jpkm1
+                     ii   = idx_bdy(ib_bdy)%nbi(jb,igrd)
+                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd)
+                     fv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) )
+                     vn(ii,ij-fv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk)
+                  END DO
+               END DO
+            ENDIF
+         ENDDO  
+      ENDIF 
+
+      SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==!
+      !
+      CASE ( nkeg_C2 )                          !--  Standard scheme  --!
+         DO jk = 1, jpkm1
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)
+                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)
+                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
+               END DO  
+            END DO
+         END DO
+         !
+      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1       
+               DO ji = fs_2, jpim1   ! vector opt.
+                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    &
+                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  &
+                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   &
+                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) )
+                     !
+                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    &
+                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  &
+                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   &
+                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) )
+                  zhke(ji,jj,jk) = r1_48 * ( zv + zu )
+               END DO  
+            END DO
+         END DO
+         CALL lbc_lnk( zhke, 'T', 1. )
+         !
+      END SELECT
+
+      IF (ln_bdy) THEN
+         ! restore velocity masks at points outside boundary
+         un(:,:,:) = un(:,:,:) * umask(:,:,:)
+         vn(:,:,:) = vn(:,:,:) * vmask(:,:,:)
+      ENDIF      
+
+
+      !
+      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
+               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
+            END DO 
+         END DO
+      END DO
+      !
+      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zhke )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_keg')
+      !
+   END SUBROUTINE dyn_keg
+
+   !!======================================================================
+END MODULE dynkeg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 8732)
@@ -0,0 +1,191 @@
+MODULE dynldf
+   !!======================================================================
+   !!                       ***  MODULE  dynldf  ***
+   !! Ocean physics:  lateral diffusivity trends 
+   !!=====================================================================
+   !! History :  2.0  ! 2005-11  (G. Madec)  Original code (new step architecture)
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! lateral diffusion: slopes of mixing orientation
+   USE dynldf_lap_blp ! lateral mixing   (dyn_ldf_lap & dyn_ldf_blp routines)
+   USE dynldf_iso     ! lateral mixing                 (dyn_ldf_iso routine )
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics   (trd_dyn      routine)
+   !
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_ldf       ! called by step module 
+   PUBLIC   dyn_ldf_init  ! called by opa  module 
+
+   !                      ! Parameter to control the type of lateral viscous operator
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in setting the operator
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral viscous trend)
+   !                          !!      laplacian     !    bilaplacian    !
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11                       ! iso-neutral or geopotential operator
+
+   INTEGER ::   nldf   ! type of lateral diffusion used defined from ln_dynldf_... (namlist logicals)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_ldf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_ldf  ***
+      !! 
+      !! ** Purpose :   compute the lateral ocean dynamics physics.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf')
+      !
+      IF( l_trddyn )   THEN                      ! temporary save of momentum trends
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+         ztrdu(:,:,:) = ua(:,:,:) 
+         ztrdv(:,:,:) = va(:,:,:) 
+      ENDIF
+
+      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
+      !
+      CASE ( np_lap   )    ;   CALL dyn_ldf_lap  ( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian
+      CASE ( np_lap_i )    ;   CALL dyn_ldf_iso  ( kt )                         ! rotated      laplacian
+      CASE ( np_blp   )    ;   CALL dyn_ldf_blp  ( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian
+      !
+      END SELECT
+
+      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )
+      ENDIF
+      !                                          ! print sum trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf  - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf')
+      !
+   END SUBROUTINE dyn_ldf
+
+
+   SUBROUTINE dyn_ldf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_ldf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the horizontal ocean dynamics physics
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers 
+      !!----------------------------------------------------------------------
+      !
+      !                                   ! Namelist nam_dynldf: already read in ldfdyn module
+      !
+      IF(lwp) THEN                        ! Namelist print
+         WRITE(numout,*)
+         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)'
+         WRITE(numout,*) '      laplacian operator          ln_dynldf_lap = ', ln_dynldf_lap
+         WRITE(numout,*) '      bilaplacian operator        ln_dynldf_blp = ', ln_dynldf_blp
+         WRITE(numout,*) '      iso-level                   ln_dynldf_lev = ', ln_dynldf_lev
+         WRITE(numout,*) '      horizontal (geopotential)   ln_dynldf_hor = ', ln_dynldf_hor
+         WRITE(numout,*) '      iso-neutral                 ln_dynldf_iso = ', ln_dynldf_iso
+      ENDIF
+      !                                   ! use of lateral operator or not
+      nldf = np_ERROR
+      ioptio = 0
+      IF( ln_dynldf_lap )   ioptio = ioptio + 1
+      IF( ln_dynldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on momentum' )
+      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral mixing operator
+      !
+      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
+         ioptio = 0
+         IF( ln_dynldf_lev )   ioptio = ioptio + 1
+         IF( ln_dynldf_hor )   ioptio = ioptio + 1
+         IF( ln_dynldf_iso )   ioptio = ioptio + 1
+         IF( ioptio >  1   )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+         IF( ioptio == 0   )   CALL ctl_stop( '          use at least ONE direction (level/hor/iso)' )
+         !
+         !                                   ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals
+         ierr = 0
+         IF ( ln_dynldf_lap ) THEN      ! laplacian operator
+            IF ( ln_zco ) THEN                ! z-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN             ! z-coordinate with partial step
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN             ! s-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_lap_i   ! horizontal             (   rotation)
+               IF ( ln_dynldf_iso )   nldf = np_lap_i   ! iso-neutral            (   rotation)
+            ENDIF
+         ENDIF
+         !
+         IF( ln_dynldf_blp ) THEN          ! bilaplacian operator
+            IF ( ln_zco ) THEN                ! z-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN             ! z-coordinate with partial step
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN             ! s-coordinate
+               IF ( ln_dynldf_lev )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_dynldf_hor )   ierr = 2          ! horizontal             (   rotation)
+               IF ( ln_dynldf_iso )   ierr = 2          ! iso-neutral            (   rotation)
+            ENDIF
+         ENDIF
+         !
+         IF( ierr == 2 )   CALL ctl_stop( 'rotated bi-laplacian operator does not exist' )
+         !
+         IF( nldf == np_lap_i )   l_ldfslp = .TRUE.      ! rotation require the computation of the slopes
+         !
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == np_no_ldf )   WRITE(numout,*) '      ===>>   NO lateral viscosity'
+         IF( nldf == np_lap    )   WRITE(numout,*) '      ===>>   iso-level laplacian operator'
+         IF( nldf == np_lap_i  )   WRITE(numout,*) '      ===>>   rotated laplacian operator with iso-level background'
+         IF( nldf == np_blp    )   WRITE(numout,*) '      ===>>   iso-level bi-laplacian operator'
+      ENDIF
+      !
+   END SUBROUTINE dyn_ldf_init
+
+   !!======================================================================
+END MODULE dynldf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 8732)
@@ -0,0 +1,418 @@
+MODULE dynldf_iso
+   !!======================================================================
+   !!                     ***  MODULE  dynldf_iso  ***
+   !! Ocean dynamics:   lateral viscosity trend (rotated laplacian operator)
+   !!======================================================================
+   !! History :  OPA  !  97-07  (G. Madec)  Original code
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2004-08  (C. Talandier) New trends organization
+   !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion
+   !!            3.7  !  2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                   add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_iso  : update the momentum trend with the horizontal part
+   !!                  of the lateral diffusion using isopycnal or horizon-
+   !!                  tal s-coordinate laplacian operator.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn          ! lateral diffusion: eddy viscosity coef.
+   USE ldftra          ! lateral physics: eddy diffusivity
+   USE zdf_oce         ! ocean vertical physics
+   USE ldfslp          ! iso-neutral slopes 
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_ldf_iso           ! called by step.F90
+   PUBLIC   dyn_ldf_iso_alloc     ! called by nemogcm.F90
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u   ! 2D workspace (dyn_ldf_iso) 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v   !  -      -
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dyn_ldf_iso_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_ldf_iso_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     & 
+         &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc )
+         !
+      IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.')
+   END FUNCTION dyn_ldf_iso_alloc
+
+
+   SUBROUTINE dyn_ldf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_iso  ***
+      !!                       
+      !! ** Purpose :   Compute the before trend of the rotated laplacian
+      !!      operator of lateral momentum diffusion except the diagonal
+      !!      vertical term that will be computed in dynzdf module. Add it
+      !!      to the general trend of momentum equation.
+      !!
+      !! ** Method :
+      !!        The momentum lateral diffusive trend is provided by a 2nd
+      !!      order operator rotated along neutral or geopotential surfaces
+      !!      (in s-coordinates).
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!      Here, u and v components are considered as 2 independent scalar
+      !!      fields. Therefore, the property of splitting divergent and rota-
+      !!      tional part of the flow of the standard, z-coordinate laplacian
+      !!      momentum diffusion is lost.
+      !!      horizontal fluxes associated with the rotated lateral mixing:
+      !!      u-component:
+      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ]
+      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
+      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
+      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!      v-component:
+      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ]
+      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ]
+      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ]
+      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  }
+      !!         diffv = 1/(e1v*e2v*e3v) {  di-1[ zivf ] + dj  [ zjvt ]  }
+      !!      Add this trend to the general trend (ua,va):
+      !!         ua = ua + diffu
+      !!      CAUTION: here the isopycnal part is with a coeff. of aht. This
+      !!      should be modified for applications others than orca_r2 (!!bug)
+      !!
+      !! ** Action :
+      !!        Update (ua,va) arrays with the before geopotential biharmonic
+      !!      mixing trend.
+      !!        Update (avmu,avmv) to accompt for the diagonal vertical component
+      !!      of the rotated operator in dynzdf module
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars
+      REAL(wp) ::   zmskt, zmskf                                     !   -      -
+      REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      -
+      REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_iso')
+      !
+      CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator'
+         !                                      ! allocate dyn_ldf_bilap arrays
+         IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays')
+      ENDIF
+
+!!gm bug is dyn_ldf_iso called before tra_ldf_iso ....   <<<<<===== TO BE CHECKED
+      ! s-coordinate: Iso-level diffusion on momentum but not on tracer
+      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN
+         !
+         DO jk = 1, jpk         ! set the slopes of iso-level
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+                  vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+                  wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5
+                  wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5
+               END DO
+            END DO
+         END DO
+         ! Lateral boundary conditions on the slopes
+         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
+         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+ 
+!!bug
+         IF( kt == nit000 ) then
+            IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  &
+               &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj))
+         endif
+!!end
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! Vertical u- and v-shears at level jk and jk+1
+         ! ---------------------------------------------
+         ! surface boundary condition: zdku(jk=1)=zdku(jk=2)
+         !                             zdkv(jk=1)=zdkv(jk=2)
+
+         zdk1u(:,:) = ( ub(:,:,jk) -ub(:,:,jk+1) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( vb(:,:,jk) -vb(:,:,jk+1) ) * vmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdku(:,:) = zdk1u(:,:)
+            zdkv(:,:) = zdk1v(:,:)
+         ELSE
+            zdku(:,:) = ( ub(:,:,jk-1) - ub(:,:,jk) ) * umask(:,:,jk)
+            zdkv(:,:) = ( vb(:,:,jk-1) - vb(:,:,jk) ) * vmask(:,:,jk)
+         ENDIF
+
+         !                               -----f-----
+         ! Horizontal fluxes on U             |  
+         ! --------------------===        t   u   t
+         !                                    |  
+         ! i-flux at t-point             -----f-----
+
+         IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, jpi   ! vector opt.
+                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj)
+
+                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     &
+                     &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+   
+                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )    &
+                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      &
+                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ELSE                   ! other coordinate system (zco or sco) : e3t
+            DO jj = 2, jpjm1
+               DO ji = fs_2, jpi   ! vector opt.
+                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj)
+
+                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     &
+                     &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp )
+
+                  zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+                  ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
+                     &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
+                     &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+         ! j-flux at f-point
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj)
+
+               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     &
+                  &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp )
+
+               zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+
+               zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   &
+                  &           + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
+                  &                      +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) * fmask(ji,jj,jk)
+            END DO
+         END DO
+
+         !                                |   t   |
+         ! Horizontal fluxes on V         |       |
+         ! --------------------===        f---v---f
+         !                                |       |
+         ! i-flux at f-point              |   t   |
+
+         DO jj = 2, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj)
+
+               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     &
+                  &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+               zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+               zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )    &
+                  &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      &
+                  &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk)
+            END DO
+         END DO
+
+         ! j-flux at t-point
+         IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u)
+            DO jj = 2, jpj
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj)
+
+                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     &
+                     &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp )
+
+                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )    &
+                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      &
+                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ELSE                   ! other coordinate system (zco or sco) : e3t
+            DO jj = 2, jpj
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj)
+
+                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
+                     &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+                  zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+                  zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
+                     &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
+                     &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+
+         ! Second derivative (divergence) and add to the general trend
+         ! -----------------------------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (  ziut(ji+1,jj) - ziut(ji,jj  )    &
+                  &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    &
+                  &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! print sum trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldfh - Ua: ', mask1=umask, &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+
+
+      !                                                ! ===============
+      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 momentum gradient
+         ! --------------------------------
+
+         DO jk = 1, jpk
+            DO ji = 2, jpi
+               ! i-gradient of u at jj
+               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( ub(ji,jj  ,jk) - ub(ji-1,jj  ,jk) )
+               ! j-gradient of u and v at jj
+               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( ub(ji,jj+1,jk) - ub(ji  ,jj  ,jk) )
+               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( vb(ji,jj  ,jk) - vb(ji  ,jj-1,jk) )
+               ! j-gradient of u and v at jj+1
+               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( ub(ji,jj  ,jk) - ub(ji  ,jj-1,jk) )
+               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( vb(ji,jj+1,jk) - vb(ji  ,jj  ,jk) )
+            END DO
+         END DO
+         DO jk = 1, jpk
+            DO ji = 1, jpim1
+               ! i-gradient of v at jj
+               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( vb(ji+1,jj,jk) - vb(ji  ,jj  ,jk) )
+            END DO
+         END DO
+
+
+         ! I.2 Vertical fluxes
+         ! -------------------
+
+         ! Surface and bottom vertical fluxes set to zero
+         DO ji = 1, jpi
+            zfuw(ji, 1 ) = 0.e0
+            zfvw(ji, 1 ) = 0.e0
+            zfuw(ji,jpk) = 0.e0
+            zfvw(ji,jpk) = 0.e0
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on U field
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk)
+               !
+               zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
+               zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
+               !
+               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
+                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
+               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1)   &
+                             + fmask(ji,jj-1,jk  ) + fmask(ji,jj,jk  ), 1. )
+
+               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
+               zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj
+               ! vertical flux on u field
+               zfuw(ji,jk) = zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     &
+                                       +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   &
+                           + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     &
+                                       +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) )
+               ! update avmu (add isopycnal vertical coefficient to avmu)
+               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0
+            END DO
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on V field
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk)
+
+               zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
+               zvwslpj = zcoef0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )
+
+               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   &
+                             + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. )
+               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   &
+                             + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. )
+
+               zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi
+               zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj
+               ! vertical flux on v field
+               zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
+                  &                    +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
+                  &        + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
+                  &                    +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
+               ! update avmv (add isopycnal vertical coefficient to avmv)
+               ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0
+            END DO
+         END DO
+
+
+         ! I.3 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_iso')
+      !
+   END SUBROUTINE dyn_ldf_iso
+
+   !!======================================================================
+END MODULE dynldf_iso
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90	(revision 8732)
@@ -0,0 +1,163 @@
+MODULE dynldf_lap_blp
+   !!======================================================================
+   !!                   ***  MODULE  dynldf_lap_blp  ***
+   !! Ocean dynamics:  lateral viscosity trend (laplacian and bilaplacian)
+   !!======================================================================
+   !! History : 3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_lap   : update the momentum trend with the lateral viscosity using an iso-level   laplacian operator
+   !!   dyn_ldf_blp   : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE ldfslp         ! iso-neutral slopes 
+   USE zdf_oce        ! ocean vertical physics
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_ldf_lap  ! called by dynldf.F90
+   PUBLIC dyn_ldf_blp  ! called by dynldf.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_lap  ***
+      !!                       
+      !! ** Purpose :   Compute the before horizontal momentum diffusive 
+      !!      trend and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The Laplacian operator apply on horizontal velocity is 
+      !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 
+      !!
+      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb.
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zsign        ! local scalars
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zcur, zdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_ldf_lap')
+      !
+      CALL wrk_alloc( jpi, jpj, zcur, zdiv ) 
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign
+      ELSE                    ;   zsign = -1._wp      !  (eddy viscosity coef. >0)
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1)
+!!gm open question here : e3f  at before or now ?    probably now...
+!!gm note that ahmf has already been multiplied by fmask
+               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &
+                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)  &
+                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  )
+               !                                      ! ahm * div        (computed from 2 to jpi/jpj)
+!!gm note that ahmt has already been multiplied by tmask
+               zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t_b(ji,jj,jk)                                         &
+                  &     * (  e2u(ji,jj)*e3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk)  &
+                  &        + e1v(ji,jj)*e3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk)  )
+            END DO  
+         END DO  
+         !
+         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div )
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                 &
+                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)   &
+                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     )
+                  !
+               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                 &
+                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)   &
+                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     )
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap')
+      !
+   END SUBROUTINE dyn_ldf_lap
+
+
+   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_ldf_blp  ***
+      !!                    
+      !! ** Purpose :   Compute the before lateral momentum viscous trend 
+      !!              and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The lateral viscous trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to dyn_ldf_lap routine
+      !!
+      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zulap, zvlap   ! laplacian at u- and v-point
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_blp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap ) 
+      !
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      zulap(:,:,:) = 0._wp
+      zvlap(:,:,:) = 0._wp
+      !
+      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap)
+      !
+      CALL lbc_lnk( zulap(:,:,:) , 'U', -1. )             ! Lateral boundary conditions
+      CALL lbc_lnk( zvlap(:,:,:) , 'V', -1. )
+      !
+      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_blp')
+      !
+   END SUBROUTINE dyn_ldf_blp
+
+   !!======================================================================
+END MODULE dynldf_lap_blp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 8732)
@@ -0,0 +1,356 @@
+MODULE dynnxt
+   !!=========================================================================
+   !!                       ***  MODULE  dynnxt  ***
+   !! Ocean dynamics: time stepping
+   !!=========================================================================
+   !! History :  OPA  !  1987-02  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  1990-10  (C. Levy, G. Madec)
+   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
+   !!            8.0  !  1997-02  (G. Madec & M. Imbard)  opa, release 8.0
+   !!            8.2  !  1997-04  (A. Weaver)  Euler forward step
+   !!             -   !  1997-06  (G. Madec)  lateral boudary cond., lbc routine
+   !!    NEMO    1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2002-10  (C. Talandier, A-M. Treguier) Open boundary cond.
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            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
+   !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL
+   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
+   !!            3.6  !  2014-04  (G. Madec) add the diagnostic of the time filter trends
+   !!            3.7  !  2015-11  (J. Chanut) Free surface simplification
+   !!-------------------------------------------------------------------------
+  
+   !!-------------------------------------------------------------------------
+   !!   dyn_nxt       : obtain the next (after) horizontal velocity
+   !!-------------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE phycst         ! physical constants
+   USE dynadv         ! dynamics: vector invariant versus flux form
+   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme
+   USE domvvl         ! variable volume
+   USE bdy_oce   , ONLY: ln_bdy
+   USE bdydta         ! ocean open boundary conditions
+   USE bdydyn         ! ocean open boundary conditions
+   USE bdyvol         ! ocean open boundary condition (bdy_vol routines)
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   USE trdken         ! trend manager: kinetic energy
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lbclnk         ! lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE prtctl         ! Print control
+   USE timing         ! Timing
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC    dyn_nxt   ! 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 dyn_nxt ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nxt  ***
+      !!                   
+      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary 
+      !!             condition on the after velocity, achieve the time stepping 
+      !!             by applying the Asselin filter on now fields and swapping 
+      !!             the fields.
+      !!
+      !! ** Method  : * Ensure after velocities transport matches time splitting
+      !!             estimate (ln_dynspg_ts=T)
+      !!
+      !!              * Apply lateral boundary conditions on after velocity 
+      !!             at the local domain boundaries through lbc_lnk call,
+      !!             at the one-way open boundaries (ln_bdy=T),
+      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
+      !!
+      !!              * Apply the time filter applied and swap of the dynamics
+      !!             arrays to start the next time step:
+      !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
+      !!                (un,vn) = (ua,va).
+      !!             Note that with flux form advection and non linear free surface,
+      !!             the time filter is applied on thickness weighted velocity.
+      !!             As a result, dyn_nxt MUST be called after tra_nxt.
+      !!
+      !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step
+      !!               un,vn   now horizontal velocity of next time-step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikt          ! local integers
+      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars
+      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zue, zve
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f, zua, zva 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_nxt')
+      !
+      IF( ln_dynspg_ts       )   CALL wrk_alloc( jpi,jpj,       zue, zve)
+      IF( l_trddyn           )   CALL wrk_alloc( jpi,jpj,jpk,   zua, zva)
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_nxt : time stepping'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF ( ln_dynspg_ts ) THEN
+         ! Ensure below that barotropic velocities match time splitting estimate
+         ! Compute actual transport and replace it with ts estimate at "after" time step
+         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1)
+         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1)
+         DO jk = 2, jpkm1
+            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
+            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
+         END DO
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)
+            va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)
+         END DO
+         !
+         IF( .NOT.ln_bt_fw ) THEN
+            ! Remove advective velocity from "now velocities" 
+            ! prior to asselin filtering     
+            ! In the forward case, this is done below after asselin filtering   
+            ! so that asselin contribution is removed at the same time 
+            DO jk = 1, jpkm1
+               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk)
+               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk)
+            END DO  
+         ENDIF
+      ENDIF
+
+      ! Update after velocity on domain lateral boundaries
+      ! --------------------------------------------------      
+# if defined key_agrif
+      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries
+# endif
+      !
+      CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries
+      CALL lbc_lnk( va, 'V', -1. ) 
+      !
+      !                                !* BDY open boundaries
+      IF( ln_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt )
+      IF( ln_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, dyn3d_only=.true. )
+
+!!$   Do we need a call to bdy_vol here??
+      !
+      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics
+         z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step 
+         IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt
+         !
+         !                                  ! Kinetic energy and Conversion
+         IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt )
+         !
+         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends
+            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt
+            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt
+            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter
+            CALL iom_put( "vtrd_tot", zva )
+         ENDIF
+         !
+         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter
+         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the
+         !                                  !  computation of the asselin filter trends)
+      ENDIF
+
+      ! Time filter and swap of dynamics arrays
+      ! ------------------------------------------
+      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap
+         DO jk = 1, jpkm1
+            un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua
+            vn(:,:,jk) = va(:,:,jk)
+         END DO
+         IF(.NOT.ln_linssh ) THEN
+            DO jk = 1, jpkm1
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+               e3u_b(:,:,jk) = e3u_n(:,:,jk)
+               e3v_b(:,:,jk) = e3v_n(:,:,jk)
+            END DO
+         ENDIF
+      ELSE                                             !* Leap-Frog : Asselin filter and swap
+         !                                ! =============!
+         IF( ln_linssh ) THEN             ! Fixed volume !
+            !                             ! =============!
+            DO jk = 1, jpkm1                              
+               DO jj = 1, jpj
+                  DO ji = 1, jpi    
+                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
+                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * 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                             ! Variable volume !
+            !                             ! ================!
+            ! Before scale factor at t-points
+            ! (used as a now filtered scale factor until the swap)
+            ! ----------------------------------------------------
+            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting
+               e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1)
+            ELSE
+               DO jk = 1, jpkm1
+                  e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )
+               END DO
+               ! Add volume filter correction: compatibility with tracer advection scheme
+               ! => time filter + conservation correction (only at the first level)
+               zcoef = atfp * rdt * r1_rau0
+               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting
+                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) &
+                                 &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
+               ELSE                     ! if ice shelf melting
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ikt = mikt(ji,jj)
+                        e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  &
+                           &                                           - rnf_b   (ji,jj) + rnf   (ji,jj)  &
+                           &                                           + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,ikt)
+                     END DO
+                  END DO
+               END IF
+            ENDIF
+            !
+            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
+               ! Before filtered scale factor at (u/v)-points
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
+                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * 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                          ! Asselin filter applied on thickness weighted velocity
+               !
+               CALL wrk_alloc( jpi,jpj,jpk,   ze3u_f, ze3v_f )
+               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
+               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' )
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi                  
+                        zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk)
+                        zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk)
+                        zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk)
+                        zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk)
+                        zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk)
+                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk)
+                        !
+                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
+                        zvf = ( zve3n + atfp * ( zve3b - 2._wp * 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
+               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor
+               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
+               !
+               CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f )
+            ENDIF
+            !
+         ENDIF
+         !
+         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN
+            ! Revert "before" velocities to time split estimate
+            ! Doing it here also means that asselin filter contribution is removed  
+            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
+            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)    
+            DO jk = 2, jpkm1
+               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
+               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)    
+            END DO
+            DO jk = 1, jpkm1
+               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk)
+               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk)
+            END DO
+         ENDIF
+         !
+      ENDIF ! neuler =/0
+      !
+      ! Set "now" and "before" barotropic velocities for next time step:
+      ! JC: Would be more clever to swap variables than to make a full vertical
+      ! integration
+      !
+      !
+      IF(.NOT.ln_linssh ) THEN
+         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
+         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
+         DO jk = 2, jpkm1
+            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
+            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
+         END DO
+         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )
+         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
+      ENDIF
+      !
+      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1)
+      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
+      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1)
+      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
+         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
+         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
+         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)
+      END DO
+      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:)
+      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:)
+      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
+      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
+      !
+      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents
+         CALL iom_put(  "ubar", un_b(:,:) )
+         CALL iom_put(  "vbar", vn_b(:,:) )
+      ENDIF
+      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum
+         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt
+         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt
+         CALL trd_dyn( zua, zva, jpdyn_atf, kt )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   &
+         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask )
+      ! 
+      IF( ln_dynspg_ts )   CALL wrk_dealloc( jpi,jpj,       zue, zve )
+      IF( l_trddyn     )   CALL wrk_dealloc( jpi,jpj,jpk,   zua, zva )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt')
+      !
+   END SUBROUTINE dyn_nxt
+
+   !!=========================================================================
+END MODULE dynnxt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 8732)
@@ -0,0 +1,234 @@
+MODULE dynspg
+   !!======================================================================
+   !!                       ***  MODULE  dynspg  ***
+   !! Ocean dynamics:  surface pressure gradient control
+   !!======================================================================
+   !! History :  1.0  ! 2005-12  (C. Talandier, G. Madec, V. Garnier)  Original code
+   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_spg     : update the dynamics trend with surface pressure gradient 
+   !!   dyn_spg_init: initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE c1d            ! 1D vertical configuration
+   USE phycst         ! physical constants
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE sbcapr         ! surface boundary condition: atmospheric pressure
+   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
+   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
+   USE sbctide        ! 
+   USE updtide        ! 
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE prtctl         ! Print control                     (prt_ctl routine)
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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_... 
+
+   !                       ! Parameter to control the surface pressure gradient scheme
+   INTEGER, PARAMETER ::   np_TS  = 1   ! split-explicit time stepping (Time-Splitting)
+   INTEGER, PARAMETER ::   np_EXP = 0   !       explicit time stepping
+   INTEGER, PARAMETER ::   np_NO  =-1   ! no surface pressure gradient, no scheme
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_spg( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_spg  ***
+      !!
+      !! ** Purpose :   compute surface pressure gradient including the 
+      !!              atmospheric pressure forcing (ln_apr_dyn=T).
+      !!
+      !! ** Method  :   Two schemes:
+      !!              - explicit       : the spg is evaluated at now
+      !!              - split-explicit : a time splitting technique is used
+      !!
+      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
+      !!             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.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk                             ! dummy loop indices
+      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg')
+      !
+      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
+         ztrdu(:,:,:) = ua(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:)
+      ENDIF
+      !
+      IF(      ln_apr_dyn                                                &   ! atmos. pressure
+         .OR.  ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. ln_tide) )   &   ! tide potential (no time slitting)
+         .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice
+         !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               spgu(ji,jj) = 0._wp
+               spgv(ji,jj) = 0._wp
+            END DO
+         END DO         
+         !
+         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==!
+            zg_2 = grav * 0.5
+            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
+                     &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
+                     &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+               END DO
+            END DO
+         ENDIF
+         !
+         !                                    !==  tide potential forcing term  ==!
+         IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case
+            !
+            CALL upd_tide( kt )                      ! update tide potential
+            !
+            DO jj = 2, jpjm1                         ! add tide potential forcing
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+               END DO 
+            END DO
+         ENDIF
+         !
+         IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==!
+            CALL wrk_alloc( jpi,jpj,   zpice )
+            !                                            
+            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc )
+            zgrau0r     = - grav * r1_rau0
+            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
+               END DO
+            END DO
+            !
+            CALL wrk_dealloc( jpi,jpj,   zpice )         
+         ENDIF
+         !
+         DO jk = 1, jpkm1                    !== Add all terms 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    
+         !
+!!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ????
+         !    
+      ENDIF
+      !
+      SELECT CASE ( nspg )                   !== surface pressure gradient computed and add to the general trend ==!
+      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt )              ! explicit
+      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting
+      END SELECT
+      !                    
+      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
+      ENDIF
+      !                                      ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg')
+      !
+   END SUBROUTINE dyn_spg
+
+
+   SUBROUTINE dyn_spg_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_spg_init  ***
+      !!                
+      !! ** Purpose :   Control the consistency between namelist options for 
+      !!              surface pressure gradient schemes
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios   ! local integers
+      !
+      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   &
+      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   &
+      &                    nn_baro , rn_bt_cmax, nn_bt_flt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface
+      READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface
+      READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdyn_spg )
+      !
+      IF(lwp) THEN             ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '     Explicit free surface                  ln_dynspg_exp = ', ln_dynspg_exp
+         WRITE(numout,*) '     Free surface with time splitting       ln_dynspg_ts  = ', ln_dynspg_ts
+      ENDIF
+      !                          ! Control of surface pressure gradient scheme options
+                                     nspg =  np_NO    ;   ioptio = 0
+      IF( ln_dynspg_exp ) THEN   ;   nspg =  np_EXP   ;   ioptio = ioptio + 1   ;   ENDIF
+      IF( ln_dynspg_ts  ) THEN   ;   nspg =  np_TS    ;   ioptio = ioptio + 1   ;   ENDIF
+      !
+      IF( ioptio  > 1 )   CALL ctl_stop( 'Choose only one surface pressure gradient scheme' )
+      IF( ioptio == 0 )   CALL ctl_warn( 'NO surface pressure gradient trend in momentum Eqs.' )
+      IF( ln_dynspg_exp .AND. ln_isfcav )   &
+           &   CALL ctl_stop( ' dynspg_exp not tested with ice shelf cavity ' )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nspg == np_EXP )   WRITE(numout,*) '      ===>>   explicit free surface'
+         IF( nspg == np_TS  )   WRITE(numout,*) '      ===>>   free surface with time splitting scheme'
+         IF( nspg == np_NO  )   WRITE(numout,*) '      ===>>   No surface surface pressure gradient trend in momentum Eqs.'
+      ENDIF
+      !
+      IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation
+         CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on
+         IF( dyn_spg_ts_alloc() /= 0  )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays' )
+         IF( neuler/=0 .AND. ln_bt_fw )   CALL ts_rst( nit000, 'READ' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init')
+      !
+   END SUBROUTINE dyn_spg_init
+
+  !!======================================================================
+END MODULE dynspg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 8732)
@@ -0,0 +1,100 @@
+MODULE dynspg_exp
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_exp  ***
+   !! Ocean dynamics:  surface pressure gradient trend, explicit scheme
+   !!======================================================================
+   !! History :  2.0  !  2005-11  (V. Garnier, G. Madec, L. Bessieres) Original code
+   !!            3.2  !  2009-06  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_exp  : update the momentum trend with the surface 
+   !!                      pressure gradient in the free surface constant  
+   !!                      volume case with vector optimization
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE phycst          ! physical constants
+   !
+   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 iom             ! I/O library
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_spg_exp   ! routine called by dynspg.F90 
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_spg_exp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_exp  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the surface pressure
+      !!              gradient in case of explicit free surface formulation and 
+      !!              add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   Explicit free surface formulation. Add to the general
+      !!              momentum trend the surface pressure gradient :
+      !!                      (ua,va) = (ua,va) + (spgu,spgv)
+      !!              where spgu = -1/rau0 d/dx(ps) = -g/e1u di( sshn )
+      !!                    spgv = -1/rau0 d/dy(ps) = -g/e2v dj( sshn )
+      !!
+      !! ** Action :   (ua,va)   trend of horizontal velocity increased by 
+      !!                         the surf. pressure gradient trend
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      !!
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_exp')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_spg_exp : surface pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (explicit free surface)'
+         !
+         spgu(:,:) = 0._wp   ;   spgv(:,:) = 0._wp
+         !
+         IF( .NOT.ln_linssh .AND. lwp ) WRITE(numout,*) '      non linear free surface: spg is included in dynhpg'
+      ENDIF
+
+      IF( ln_linssh ) THEN          !* linear free surface : add the surface pressure gradient trend
+         !
+         DO jj = 2, jpjm1                    ! now surface pressure gradient
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj)
+               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj)
+            END DO 
+         END DO
+         !
+         DO jk = 1, jpkm1                    ! Add it 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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_exp')
+      !
+   END SUBROUTINE dyn_spg_exp
+
+   !!======================================================================
+END MODULE dynspg_exp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 8732)
@@ -0,0 +1,1327 @@
+MODULE dynspg_ts
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_ts  ***
+   !! Ocean dynamics:  surface pressure gradient trend, split-explicit scheme
+   !!======================================================================
+   !! History :   1.0  ! 2004-12  (L. Bessieres, G. Madec)  Original code
+   !!              -   ! 2005-11  (V. Garnier, G. Madec)  optimization
+   !!              -   ! 2006-08  (S. Masson)  distributed restart using iom
+   !!             2.0  ! 2007-07  (D. Storkey) calls to BDY routines
+   !!              -   ! 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
+   !!             3.3  ! 2011-03  (R. Benshila, R. Hordoir, P. Oddo) update calculation of ub_b
+   !!             3.5  ! 2013-07  (J. Chanut) Switch to Forward-backward time stepping
+   !!             3.6  ! 2013-11  (A. Coward) Update for z-tilde compatibility
+   !!             3.7  ! 2015-11  (J. Chanut) free surface simplification
+   !!              -   ! 2016-12  (G. Madec, E. Clementi) update for Stoke-Drift divergence
+   !!---------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_ts     : compute surface pressure gradient trend using a time-splitting scheme 
+   !!   dyn_spg_ts_init: initialisation of the time-splitting scheme
+   !!   ts_wgt         : set time-splitting weights for temporal averaging (or not)
+   !!   ts_rst         : read/write time-splitting fields in restart file
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE zdf_oce         ! Bottom friction coefts
+   USE sbcisf          ! ice shelf variable (fwfisf)
+   USE sbcapr          ! surface boundary condition: atmospheric pressure
+   USE dynadv    , ONLY: ln_dynadv_vec
+   USE phycst          ! physical constants
+   USE dynvor          ! vorticity term
+   USE wet_dry         ! wetting/drying flux limter
+   USE bdy_oce         ! open boundary
+   USE bdytides        ! open boundary condition data
+   USE bdydyn2d        ! open boundary conditions on barotropic variables
+   USE sbctide         ! tides
+   USE updtide         ! tide potential
+   USE sbcwave         ! surface wave
+   !
+   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 iom             ! IOM library
+   USE restart         ! only for lrst_oce
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing    
+   USE diatmb          ! Top,middle,bottom output
+#if defined key_agrif
+   USE agrif_opa_interp ! agrif
+#endif
+#if defined key_asminc   
+   USE asminc          ! Assimilation increment
+#endif
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_spg_ts        ! routine called in dynspg.F90 
+   PUBLIC dyn_spg_ts_alloc  !    "      "     "    "
+   PUBLIC dyn_spg_ts_init   !    "      "     "    "
+   PUBLIC ts_rst            !    "      "     "    "
+
+   INTEGER, SAVE :: icycle  ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro
+   REAL(wp),SAVE :: rdtbt   ! Barotropic time step
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff_f/h at F points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   !: triad of coriolis parameter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   !: (only used with een vorticity scheme)
+
+   !! Time filtered arrays at baroclinic time step:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv     !: Advection vel. at "now" barocl. step
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dyn_spg_ts_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_ts_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(3)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )
+      !
+      IF( ln_dynvor_een )   ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 
+         &                            ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(2) )
+         !
+      ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj)                    , STAT=ierr(3) )
+      !
+      dyn_spg_ts_alloc = MAXVAL( ierr(:) )
+      !
+      IF( lk_mpp                )   CALL mpp_sum( dyn_spg_ts_alloc )
+      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays')
+      !
+   END FUNCTION dyn_spg_ts_alloc
+
+
+   SUBROUTINE dyn_spg_ts( kt )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose : - Compute the now trend due to the explicit time stepping
+      !!              of the quasi-linear barotropic system, and add it to the
+      !!              general momentum trend. 
+      !!
+      !! ** Method  : - split-explicit schem (time splitting) :
+      !!      Barotropic variables are advanced from internal time steps
+      !!      "n"   to "n+1" if ln_bt_fw=T
+      !!      or from 
+      !!      "n-1" to "n+1" if ln_bt_fw=F
+      !!      thanks to a generalized forward-backward time stepping (see ref. below).
+      !!
+      !! ** Action :
+      !!      -Update the filtered free surface at step "n+1"      : ssha
+      !!      -Update filtered barotropic velocities at step "n+1" : ua_b, va_b
+      !!      -Compute barotropic advective velocities at step "n" : un_adv, vn_adv
+      !!      These are used to advect tracers and are compliant with discrete
+      !!      continuity equation taken at the baroclinic time steps. This 
+      !!      ensures tracers conservation.
+      !!      - (ua, va) momentum trend updated with barotropic component.
+      !!
+      !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      !
+      LOGICAL  ::   ll_fw_start			! if true, forward integration 
+      LOGICAL  ::   ll_init			    ! if true, special startup of 2d equations
+      LOGICAL  ::   ll_tmp1, ll_tmp2            ! local logical variables used in W/D
+      INTEGER  ::   ji, jj, jk, jn   		! dummy loop indices
+      INTEGER  ::   ikbu, ikbv, noffset    	! local integers
+      INTEGER  ::   iktu, iktv             	! local integers
+      REAL(wp) ::   zmdi
+      REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf  	! local scalars
+      REAL(wp) ::   zx1, zy1, zx2, zy2          !   -      -
+      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2 	!   -      -
+      REAL(wp) ::   zu_spg, zv_spg              !   -      -
+      REAL(wp) ::   zhura, zhvra         	!   -      -
+      REAL(wp) ::   za0, za1, za2, za3		!   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e
+      REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc
+      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv
+      REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a
+      REAL(wp), POINTER, DIMENSION(:,:) :: zhf
+      REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy                 ! Wetting/Dying gravity filter coef.
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_ts')
+      !
+      !                                         !* Allocate temporary arrays
+      CALL wrk_alloc( jpi,jpj,   zsshp2_e, zhdiv )
+      CALL wrk_alloc( jpi,jpj,   zu_trd, zv_trd)
+      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc)
+      CALL wrk_alloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e)
+      CALL wrk_alloc( jpi,jpj,   zsshu_a, zsshv_a                  )
+      CALL wrk_alloc( jpi,jpj,   zhf )
+      IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy )
+      !
+      zmdi=1.e+20                               !  missing data indicator for masking
+      !                                         !* Local constant initialization
+      z1_12 = 1._wp / 12._wp 
+      z1_8  = 0.125_wp                                   
+      z1_4  = 0.25_wp
+      z1_2  = 0.5_wp     
+      zraur = 1._wp / rau0
+      !  	                                       ! reciprocal of baroclinic time step 
+      IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt
+      ELSE                                        ;   z2dt_bf = 2.0_wp * rdt
+      ENDIF
+      z1_2dt_b = 1.0_wp / z2dt_bf 
+      !
+      ll_init     = ln_bt_av                       ! if no time averaging, then no specific restart 
+      ll_fw_start = .FALSE.
+      !                              	            ! time offset in steps for bdy data update
+      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro
+      ELSE                       ;   noffset =   0 
+      ENDIF
+      !
+      IF( kt == nit000 ) THEN             	!* initialisation
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_spg_ts : surface pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~   free surface with time splitting'
+         IF(lwp) WRITE(numout,*)
+         !
+         IF( neuler == 0 )   ll_init=.TRUE.
+         !
+         IF( ln_bt_fw .OR. neuler == 0 ) THEN
+            ll_fw_start =.TRUE.
+            noffset     = 0
+         ELSE
+            ll_fw_start =.FALSE.
+         ENDIF
+         !
+         ! Set averaging weights and cycle length:
+         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 )
+         !
+      ENDIF
+      !
+      ! Set arrays to remove/compute coriolis trend.
+      ! Do it once at kt=nit000 if volume is fixed, else at each long time step.
+      ! Note that these arrays are also used during barotropic loop. These are however frozen
+      ! although they should be updated in the variable volume case. Not a big approximation.
+      ! To remove this approximation, copy lines below inside barotropic loop
+      ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step
+      !
+      IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN
+         IF( ln_dynvor_een ) THEN               !==  EEN scheme  ==!
+            SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
+            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
+                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
+                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+                  END DO
+               END DO
+            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                     &
+                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   )                   &
+                        &       / ( MAX( 1._wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    &
+                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) )
+                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
+                  END DO
+               END DO
+            END SELECT
+            CALL lbc_lnk( zwz, 'F', 1._wp )
+            !
+            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
+            DO jj = 2, jpj
+               DO ji = 2, jpi
+                  ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
+                  ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
+                  ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
+                  ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
+               END DO
+            END DO
+            !
+         ELSE                                !== all other schemes (ENE, ENS, MIX)
+            zwz(:,:) = 0._wp
+            zhf(:,:) = 0._wp
+            
+!!gm  assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed 
+!!gm    A priori a better value should be something like :
+!!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1) 
+!!gm                     divided by the sum of the corresponding mask 
+!!gm 
+!!            
+              IF ( .not. ln_sco ) THEN
+  
+   !!gm  agree the JC comment  : this should be done in a much clear way
+  
+   ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case
+   !     Set it to zero for the time being 
+   !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level
+   !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
+   !              ENDIF
+   !              zhf(:,:) = gdepw_0(:,:,jk+1)
+               ELSE
+                 !zhf(:,:) = hbatf(:,:)
+                 DO jj = 1, jpjm1
+                   DO ji = 1, jpim1
+                     zhf(ji,jj) = MAX( 0._wp,                                &
+                                & ( ht_0(ji  ,jj  )*tmask(ji  ,jj  ,1) +     &
+                                &   ht_0(ji+1,jj  )*tmask(ji+1,jj  ,1) +     &
+                                &   ht_0(ji  ,jj+1)*tmask(ji  ,jj+1,1) +     &
+                                &   ht_0(ji+1,jj+1)*tmask(ji+1,jj+1,1) ) /   &
+                                & ( tmask(ji  ,jj  ,1) + tmask(ji+1,jj  ,1) +&
+                                &   tmask(ji  ,jj+1,1) + tmask(ji+1,jj+1,1) +&
+                                &   rsmall  ) )
+                   END DO
+                 END DO
+              END IF
+  
+              DO jj = 1, jpjm1
+                 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))
+              END DO
+!!gm end
+
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)
+               END DO
+            END DO
+            CALL lbc_lnk( zhf, 'F', 1._wp )
+            ! JC: TBC. hf should be greater than 0 
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) ! zhf is actually hf here but it saves an array
+               END DO
+            END DO
+            zwz(:,:) = ff_f(:,:) * zwz(:,:)
+         ENDIF
+      ENDIF
+      !
+      ! If forward start at previous time step, and centered integration, 
+      ! then update averaging weights:
+      IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN
+         ll_fw_start=.FALSE.
+         CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)
+      ENDIF
+                          
+      ! -----------------------------------------------------------------------------
+      !  Phase 1 : Coupling between general trend and barotropic estimates (1st step)
+      ! -----------------------------------------------------------------------------
+      !      
+      !
+      !                                   !* e3*d/dt(Ua) (Vertically integrated)
+      !                                   ! --------------------------------------------------
+      zu_frc(:,:) = 0._wp
+      zv_frc(:,:) = 0._wp
+      !
+      DO jk = 1, jpkm1
+         zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
+         zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)         
+      END DO
+      !
+      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:)
+      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:)
+      !
+      !
+      !                                   !* baroclinic momentum trend (remove the vertical mean trend)
+      DO jk = 1, jpkm1                    ! -----------------------------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) - zu_frc(ji,jj) * umask(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - zv_frc(ji,jj) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      
+!!gm  Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum....
+!!gm  Is it correct to do so ?   I think so...
+      
+      
+      !                                   !* barotropic Coriolis trends (vorticity scheme dependent)
+      !                                   ! --------------------------------------------------------
+      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
+      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)
+      !
+      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
+               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
+               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
+               ! energy conserving formulation for planetary vorticity term
+               zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+            END DO
+         END DO
+         !
+      ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
+                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+               zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
+                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
+               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+            END DO
+         END DO
+         !
+      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
+                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) &
+                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &
+                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
+                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &
+                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
+            END DO
+         END DO
+         !
+      ENDIF 
+      !
+      !                                   !* Right-Hand-Side of the barotropic momentum equation
+      !                                   ! ----------------------------------------------------
+      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient
+        IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1 
+                ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) .AND.            &
+                     &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                     &                                                         > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = ( ABS( sshn(ji+1,jj)             -   sshn(ji  ,jj))  > 1.E-12 ).AND.( &
+                     &    MAX(   sshn(ji,jj)               ,   sshn(ji+1,jj) ) >                &
+                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+   
+                IF(ll_tmp1) THEN
+                  zcpx(ji,jj) = 1.0_wp
+                ELSE IF(ll_tmp2) THEN
+                  ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here
+                  zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                              &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) )
+                ELSE
+                  zcpx(ji,jj) = 0._wp
+                END IF
+         
+                ll_tmp1 = MIN(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) .AND.            &
+                     &    MAX(   sshn(ji,jj) + ht_wd(ji,jj),   sshn(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                     &                                                         > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = ( ABS( sshn(ji,jj)               -   sshn(ji,jj+1))  > 1.E-12 ).AND.( &
+                     &    MAX(   sshn(ji,jj)               ,   sshn(ji,jj+1) ) >                &
+                     &    MAX( -ht_wd(ji,jj)               , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+   
+                IF(ll_tmp1) THEN
+                  zcpy(ji,jj) = 1.0_wp
+                ELSE IF(ll_tmp2) THEN
+                  ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here
+                  zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &
+                              &    / (sshn(ji,jj+1) -  sshn(ji,jj  )) )
+                ELSE
+                  zcpy(ji,jj) = 0._wp
+                END IF
+              END DO
+           END DO
+ 
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   &
+                        &                        * r1_e1u(ji,jj) * zcpx(ji,jj)
+                 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   &
+                        &                        * r1_e2v(ji,jj) * zcpy(ji,jj)
+              END DO
+           END DO
+
+         ELSE
+
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj)
+                 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
+              END DO
+           END DO
+        ENDIF
+
+      ENDIF
+
+      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend
+         DO ji = fs_2, fs_jpim1
+             zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj)
+             zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj)
+          END DO
+      END DO 
+      !
+      !						! Add bottom stress contribution from baroclinic velocities:      
+      IF (ln_bt_fw) THEN
+         DO jj = 2, jpjm1                          
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ikbu = mbku(ji,jj)       
+               ikbv = mbkv(ji,jj)    
+               zwx(ji,jj) = un(ji,jj,ikbu) - un_b(ji,jj) ! NOW bottom baroclinic velocities
+               zwy(ji,jj) = vn(ji,jj,ikbv) - vn_b(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ikbu = mbku(ji,jj)       
+               ikbv = mbkv(ji,jj)    
+               zwx(ji,jj) = ub(ji,jj,ikbu) - ub_b(ji,jj) ! BEFORE bottom baroclinic velocities
+               zwy(ji,jj) = vb(ji,jj,ikbv) - vb_b(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag
+      IF( ln_wd ) THEN
+        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:)
+        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:)
+      ELSE
+        zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:)
+        zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:)
+      END IF
+      !
+      !                                         ! Add top stress contribution from baroclinic velocities:      
+      IF( ln_bt_fw ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities
+               zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj)
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               iktu = miku(ji,jj)
+               iktv = mikv(ji,jj)
+               zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities
+               zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      ! Note that the "unclipped" top friction parameter is used even with explicit drag
+      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:)
+      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:)
+      !       
+      IF (ln_bt_fw) THEN                        ! Add wind forcing
+         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:)
+         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:)
+      ELSE
+         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:)
+         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:)
+      ENDIF  
+      !
+      IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing
+         IF (ln_bt_fw) THEN
+            DO jj = 2, jpjm1              
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj)
+                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj)
+                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
+                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
+               END DO
+            END DO
+         ELSE
+            DO jj = 2, jpjm1              
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
+                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj)
+                  zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
+                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj)
+                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
+                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
+               END DO
+            END DO
+         ENDIF 
+      ENDIF
+      !                                   !* Right-Hand-Side of the barotropic ssh equation
+      !                                   ! -----------------------------------------------
+      !                                         ! Surface net water flux and rivers
+      IF (ln_bt_fw) THEN
+         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )
+      ELSE
+         zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   &
+                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     )
+      ENDIF
+      !
+      IF( ln_sdw ) THEN                         ! Stokes drift divergence added if necessary
+         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
+      ENDIF
+      !
+#if defined key_asminc
+      !                                         ! Include the IAU weighted SSH increment
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
+      ENDIF
+#endif
+      !                                   !* Fill boundary data arrays for AGRIF
+      !                                   ! ------------------------------------
+#if defined key_agrif
+         IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
+#endif
+      !
+      ! -----------------------------------------------------------------------
+      !  Phase 2 : Integration of the barotropic equations 
+      ! -----------------------------------------------------------------------
+      !
+      !                                             ! ==================== !
+      !                                             !    Initialisations   !
+      !                                             ! ==================== !  
+      ! Initialize barotropic variables:      
+      IF( ll_init )THEN
+         sshbb_e(:,:) = 0._wp
+         ubb_e  (:,:) = 0._wp
+         vbb_e  (:,:) = 0._wp
+         sshb_e (:,:) = 0._wp
+         ub_e   (:,:) = 0._wp
+         vb_e   (:,:) = 0._wp
+      ENDIF
+
+      !
+      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                    
+         sshn_e(:,:) =    sshn(:,:)            
+         un_e  (:,:) =    un_b(:,:)            
+         vn_e  (:,:) =    vn_b(:,:)
+         !
+         hu_e  (:,:) =    hu_n(:,:)       
+         hv_e  (:,:) =    hv_n(:,:) 
+         hur_e (:,:) = r1_hu_n(:,:)    
+         hvr_e (:,:) = r1_hv_n(:,:)
+      ELSE                                ! CENTRED integration: start from BEFORE fields
+         sshn_e(:,:) =    sshb(:,:)
+         un_e  (:,:) =    ub_b(:,:)         
+         vn_e  (:,:) =    vb_b(:,:)
+         !
+         hu_e  (:,:) =    hu_b(:,:)       
+         hv_e  (:,:) =    hv_b(:,:) 
+         hur_e (:,:) = r1_hu_b(:,:)    
+         hvr_e (:,:) = r1_hv_b(:,:)
+      ENDIF
+      !
+      !
+      !
+      ! Initialize sums:
+      ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)          
+      va_b  (:,:) = 0._wp
+      ssha  (:,:) = 0._wp       ! Sum for after averaged sea level
+      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop
+      vn_adv(:,:) = 0._wp
+      !                                             ! ==================== !
+      DO jn = 1, icycle                             !  sub-time-step loop  !
+         !                                          ! ==================== !
+         !                                                !* Update the forcing (BDY and tides)
+         !                                                !  ------------------
+         ! Update only tidal forcing at open boundaries
+         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, time_offset= noffset+1 )
+         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, time_offset= noffset   )
+         !
+         ! Set extrapolation coefficients for predictor step:
+         IF ((jn<3).AND.ll_init) THEN      ! Forward           
+           za1 = 1._wp                                          
+           za2 = 0._wp                        
+           za3 = 0._wp                        
+         ELSE                              ! AB3-AM4 Coefficients: bet=0.281105 
+           za1 =  1.781105_wp              ! za1 =   3/2 +   bet
+           za2 = -1.06221_wp               ! za2 = -(1/2 + 2*bet)
+           za3 =  0.281105_wp              ! za3 = bet
+         ENDIF
+
+         ! Extrapolate barotropic velocities at step jit+0.5:
+         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)
+         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)
+
+         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only)
+            !                                             !  ------------------
+            ! Extrapolate Sea Level at step jit+0.5:
+            zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:)
+            !
+            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points
+               DO ji = 2, fs_jpim1   ! Vector opt.
+                  zwx(ji,jj) = z1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     &
+                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )
+                  zwy(ji,jj) = z1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     &
+                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp )
+            !
+            zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points
+            zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:)
+         ELSE
+            zhup2_e (:,:) = hu_n(:,:)
+            zhvp2_e (:,:) = hv_n(:,:)
+         ENDIF
+         !                                                !* after ssh
+         !                                                !  -----------
+         ! One should enforce volume conservation at open boundaries here
+         ! considering fluxes below:
+         !
+         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5
+         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
+         !
+#if defined key_agrif
+         ! Set fluxes during predictor step to ensure volume conservation
+         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
+            IF((nbondi == -1).OR.(nbondi == 2)) THEN
+               DO jj=1,jpj
+                  zwx(2,jj) = ubdy_w(jj) * e2u(2,jj)
+               END DO
+            ENDIF
+            IF((nbondi ==  1).OR.(nbondi == 2)) THEN
+               DO jj=1,jpj
+                  zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj)
+               END DO
+            ENDIF
+            IF((nbondj == -1).OR.(nbondj == 2)) THEN
+               DO ji=1,jpi
+                  zwy(ji,2) = vbdy_s(ji) * e1v(ji,2)
+               END DO
+            ENDIF
+            IF((nbondj ==  1).OR.(nbondj == 2)) THEN
+               DO ji=1,jpi
+                  zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2)
+               END DO
+            ENDIF
+         ENDIF
+#endif
+         IF( ln_wd ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt)
+         !
+         ! Sum over sub-time-steps to compute advective velocities
+         za2 = wgtbtp2(jn)
+         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)
+         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)
+         !
+         ! Set next sea level:
+         DO jj = 2, jpjm1                                 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   &
+                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj)
+            END DO
+         END DO
+         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:)
+         
+         CALL lbc_lnk( ssha_e, 'T',  1._wp )
+
+         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
+         IF( ln_bdy )   CALL bdy_ssh( ssha_e )
+#if defined key_agrif
+         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn )
+#endif
+         !  
+         ! Sea Surface Height at u-,v-points (vvl case only)
+         IF( .NOT.ln_linssh ) THEN                                
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1      ! NO Vector Opt.
+                  zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
+                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
+                  zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
+                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp )
+         ENDIF   
+         !                                 
+         ! Half-step back interpolation of SSH for surface pressure computation:
+         !----------------------------------------------------------------------
+         IF ((jn==1).AND.ll_init) THEN
+           za0=1._wp                        ! Forward-backward
+           za1=0._wp                           
+           za2=0._wp
+           za3=0._wp
+         ELSEIF ((jn==2).AND.ll_init) THEN  ! AB2-AM3 Coefficients; bet=0 ; gam=-1/6 ; eps=1/12
+           za0= 1.0833333333333_wp          ! za0 = 1-gam-eps
+           za1=-0.1666666666666_wp          ! za1 = gam
+           za2= 0.0833333333333_wp          ! za2 = eps
+           za3= 0._wp              
+         ELSE                               ! AB3-AM4 Coefficients; bet=0.281105 ; eps=0.013 ; gam=0.0880 
+           za0=0.614_wp                     ! za0 = 1/2 +   gam + 2*eps    
+           za1=0.285_wp                     ! za1 = 1/2 - 2*gam - 3*eps 
+           za2=0.088_wp                     ! za2 = gam
+           za3=0.013_wp                     ! za3 = eps
+         ENDIF
+         !
+         zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:) &
+          &            + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:)
+         IF( ln_wd ) THEN                   ! Calculating and applying W/D gravity filters
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1 
+                ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
+                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji+1,jj) ) .AND.            &
+                     &    MAX( zsshp2_e(ji,jj) + ht_wd(ji,jj), zsshp2_e(ji+1,jj) + ht_wd(ji+1,jj) ) &
+                     &                                                             > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji+1,jj))  > 1.E-12 ).AND.( &
+                     &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji+1,jj) ) >                &
+                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )
+   
+                IF(ll_tmp1) THEN
+                  zcpx(ji,jj) = 1.0_wp
+                ELSE IF(ll_tmp2) THEN
+                  ! no worries about  zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj) = 0, it won't happen ! here
+                  zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) +    ht_wd(ji+1,jj) - zsshp2_e(ji,jj) - ht_wd(ji,jj)) &
+                              &    / (zsshp2_e(ji+1,jj) - zsshp2_e(ji  ,jj)) )
+                ELSE
+                  zcpx(ji,jj) = 0._wp
+                END IF
+         
+                ll_tmp1 = MIN( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
+                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji,jj+1) ) .AND.            &
+                     &    MAX( zsshp2_e(ji,jj) + ht_wd(ji,jj), zsshp2_e(ji,jj+1) + ht_wd(ji,jj+1) ) &
+                     &                                                             > rn_wdmin1 + rn_wdmin2
+                ll_tmp2 = (ABS(zsshp2_e(ji,jj)               - zsshp2_e(ji,jj+1))  > 1.E-12 ).AND.( &
+                     &    MAX( zsshp2_e(ji,jj)               , zsshp2_e(ji,jj+1) ) >                &
+                     &    MAX(   -ht_wd(ji,jj)               ,   -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )
+   
+                IF(ll_tmp1) THEN
+                  zcpy(ji,jj) = 1.0_wp
+                ELSE IF(ll_tmp2) THEN
+                  ! no worries about  zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  ) = 0, it won't happen ! here
+                  zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) +    ht_wd(ji,jj+1) - zsshp2_e(ji,jj) - ht_wd(ji,jj)) &
+                              &    / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj  )) )
+                ELSE
+                  zcpy(ji,jj) = 0._wp
+                END IF
+              END DO
+           END DO
+         END IF
+         !
+         ! Compute associated depths at U and V points:
+         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN 	!* Vector form
+            !                                        
+            DO jj = 2, jpjm1                            
+               DO ji = 2, jpim1
+                  zx1 = z1_2 * ssumask(ji  ,jj) *  r1_e1e2u(ji  ,jj)    &
+                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    &
+                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) )
+                  zy1 = z1_2 * ssvmask(ji  ,jj) *  r1_e1e2v(ji  ,jj  )  &
+                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  &
+                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) )
+                  zhust_e(ji,jj) = hu_0(ji,jj) + zx1 
+                  zhvst_e(ji,jj) = hv_0(ji,jj) + zy1
+               END DO
+            END DO
+
+         ENDIF
+         !
+         ! Add Coriolis trend:
+         ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated
+         ! at each time step. We however keep them constant here for optimization.
+         ! Recall that zwx and zwy arrays hold fluxes at this stage:
+         ! zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)   ! fluxes at jn+0.5
+         ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:)
+         !
+         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)
+                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)
+                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
+                  zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+                  zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+               END DO
+            END DO
+            !
+         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) &
+                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj)
+                  zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) &
+                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj)
+                  zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+                  zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+               END DO
+            END DO
+            !
+         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) &
+                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) &
+                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
+                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )
+                  zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
+                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) &
+                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
+                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  ) )
+               END DO
+            END DO
+            ! 
+         ENDIF
+         !
+         ! Add tidal astronomical forcing if defined
+         IF ( ln_tide .AND. ln_tide_pot ) THEN
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj)
+                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj)
+                  zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg
+                  zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Add bottom stresses:
+         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:)
+         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
+         !
+         ! Add top stresses:
+         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:)
+         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:)
+         !
+         ! Surface pressure trend:
+
+         IF( ln_wd ) THEN
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1 
+                 ! Add surface pressure gradient
+                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+                 zwx(ji,jj) = zu_spg * zcpx(ji,jj) 
+                 zwy(ji,jj) = zv_spg * zcpy(ji,jj)
+              END DO
+           END DO
+         ELSE
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 ! Add surface pressure gradient
+                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
+                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+                 zwx(ji,jj) = zu_spg
+                 zwy(ji,jj) = zv_spg
+              END DO
+           END DO
+         END IF
+
+         !
+         ! Set next velocities:
+         IF( ln_dynadv_vec .OR. ln_linssh ) THEN 	!* Vector form
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
+                            &     + rdtbt * (                      zwx(ji,jj)   &
+                            &                                 + zu_trd(ji,jj)   &
+                            &                                 + zu_frc(ji,jj) ) & 
+                            &   ) * ssumask(ji,jj)
+
+                  va_e(ji,jj) = (                                 vn_e(ji,jj)   &
+                            &     + rdtbt * (                      zwy(ji,jj)   &
+                            &                                 + zv_trd(ji,jj)   &
+                            &                                 + zv_frc(ji,jj) ) &
+                            &   ) * ssvmask(ji,jj)
+               END DO
+            END DO
+            !
+         ELSE					 	                     !* Flux form
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+
+                  IF( ln_wd ) THEN
+                    zhura = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1)
+                    zhvra = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1)
+                  ELSE
+                    zhura = hu_0(ji,jj) + zsshu_a(ji,jj)
+                    zhvra = hv_0(ji,jj) + zsshv_a(ji,jj)
+                  END IF
+                  zhura = ssumask(ji,jj)/(zhura + 1._wp - ssumask(ji,jj))
+                  zhvra = ssvmask(ji,jj)/(zhvra + 1._wp - ssvmask(ji,jj))
+
+                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)   & 
+                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   & 
+                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   &
+                            &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) &
+                            &   ) * zhura
+
+                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)   &
+                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   &
+                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   &
+                            &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) &
+                            &   ) * zhvra
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only)
+            IF( ln_wd ) THEN
+              hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1)
+              hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1)
+            ELSE
+              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:)
+              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:)
+            END IF
+            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) )
+            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) )
+            !
+         ENDIF
+         !                                             !* domain lateral boundary
+         CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp )
+         !
+         !                                                 ! open boundaries
+         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
+#if defined key_agrif                                                           
+         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif
+#endif
+         !                                             !* Swap
+         !                                             !  ----
+         ubb_e  (:,:) = ub_e  (:,:)
+         ub_e   (:,:) = un_e  (:,:)
+         un_e   (:,:) = ua_e  (:,:)
+         !
+         vbb_e  (:,:) = vb_e  (:,:)
+         vb_e   (:,:) = vn_e  (:,:)
+         vn_e   (:,:) = va_e  (:,:)
+         !
+         sshbb_e(:,:) = sshb_e(:,:)
+         sshb_e (:,:) = sshn_e(:,:)
+         sshn_e (:,:) = ssha_e(:,:)
+
+         !                                             !* Sum over whole bt loop
+         !                                             !  ----------------------
+         za1 = wgtbtp1(jn)                                    
+         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities
+            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) 
+            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
+         ELSE                                              ! Sum transports
+            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
+            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
+         ENDIF
+         !                       			   ! Sum sea level
+         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:)
+         !                                                 ! ==================== !
+      END DO                                               !        end loop      !
+      !                                                    ! ==================== !
+      ! -----------------------------------------------------------------------------
+      ! Phase 3. update the general trend with the barotropic trend
+      ! -----------------------------------------------------------------------------
+      !
+      ! Set advection velocity correction:
+      zwx(:,:) = un_adv(:,:)
+      zwy(:,:) = vn_adv(:,:)
+      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN     
+         un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:)
+         vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:)
+      ELSE
+         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:)
+         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:)
+      END IF
+
+      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation
+         ub2_b(:,:) = zwx(:,:)
+         vb2_b(:,:) = zwy(:,:)
+      ENDIF
+      !
+      ! Update barotropic trend:
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN
+         DO jk=1,jpkm1
+            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b
+            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b
+         END DO
+      ELSE
+         ! At this stage, ssha has been corrected: compute new depths at velocity points
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1      ! NO Vector Opt.
+               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) &
+                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    &
+                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) )
+               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) &
+                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    &
+                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
+            END DO
+         END DO
+         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
+         !
+         DO jk=1,jpkm1
+            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b
+            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b
+         END DO
+         ! Save barotropic velocities not transport:
+         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
+         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
+      ENDIF
+      !
+      DO jk = 1, jpkm1
+         ! Correct velocities:
+         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk)
+         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk)
+         !
+      END DO
+      !
+      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current
+      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic i-current
+      !
+#if defined key_agrif
+      ! Save time integrated fluxes during child grid integration
+      ! (used to update coarse grid transports at next time step)
+      !
+      IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN
+         IF( Agrif_NbStepint() == 0 ) THEN
+            ub2_i_b(:,:) = 0._wp
+            vb2_i_b(:,:) = 0._wp
+         END IF
+         !
+         za1 = 1._wp / REAL(Agrif_rhot(), wp)
+         ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:)
+         vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:)
+      ENDIF
+#endif      
+      !                                   !* write time-spliting arrays in the restart
+      IF( lrst_oce .AND.ln_bt_fw )   CALL ts_rst( kt, 'WRITE' )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zsshp2_e, zhdiv )
+      CALL wrk_dealloc( jpi,jpj,   zu_trd, zv_trd )
+      CALL wrk_dealloc( jpi,jpj,   zwx, zwy, zssh_frc, zu_frc, zv_frc )
+      CALL wrk_dealloc( jpi,jpj,   zhup2_e, zhvp2_e, zhust_e, zhvst_e )
+      CALL wrk_dealloc( jpi,jpj,   zsshu_a, zsshv_a                                   )
+      CALL wrk_dealloc( jpi,jpj,   zhf )
+      IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy )
+      !
+      IF ( ln_diatmb ) THEN
+         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity
+         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity
+      ENDIF
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts')
+      !
+   END SUBROUTINE dyn_spg_ts
+
+
+   SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2)
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_wgt  ***
+      !!
+      !! ** Purpose : Set time-splitting weights for temporal averaging (or not)
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in) ::   ll_av      ! temporal averaging=.true.
+      LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true.
+      INTEGER, INTENT(inout) :: jpit      ! cycle length    
+      REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights
+                                                         zwgt2    ! Secondary weights
+      
+      INTEGER ::  jic, jn, ji                      ! temporary integers
+      REAL(wp) :: za1, za2
+      !!----------------------------------------------------------------------
+
+      zwgt1(:) = 0._wp
+      zwgt2(:) = 0._wp
+
+      ! Set time index when averaged value is requested
+      IF (ll_fw) THEN 
+         jic = nn_baro
+      ELSE
+         jic = 2 * nn_baro
+      ENDIF
+
+      ! Set primary weights:
+      IF (ll_av) THEN
+           ! Define simple boxcar window for primary weights 
+           ! (width = nn_baro, centered around jic)     
+         SELECT CASE ( nn_bt_flt )
+              CASE( 0 )  ! No averaging
+                 zwgt1(jic) = 1._wp
+                 jpit = jic
+
+              CASE( 1 )  ! Boxcar, width = nn_baro
+                 DO jn = 1, 3*nn_baro
+                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+                    IF (za1 < 0.5_wp) THEN
+                      zwgt1(jn) = 1._wp
+                      jpit = jn
+                    ENDIF
+                 ENDDO
+
+              CASE( 2 )  ! Boxcar, width = 2 * nn_baro
+                 DO jn = 1, 3*nn_baro
+                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+                    IF (za1 < 1._wp) THEN
+                      zwgt1(jn) = 1._wp
+                      jpit = jn
+                    ENDIF
+                 ENDDO
+              CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt' )
+         END SELECT
+
+      ELSE ! No time averaging
+         zwgt1(jic) = 1._wp
+         jpit = jic
+      ENDIF
+    
+      ! Set secondary weights
+      DO jn = 1, jpit
+        DO ji = jn, jpit
+             zwgt2(jn) = zwgt2(jn) + zwgt1(ji)
+        END DO
+      END DO
+
+      ! Normalize weigths:
+      za1 = 1._wp / SUM(zwgt1(1:jpit))
+      za2 = 1._wp / SUM(zwgt2(1:jpit))
+      DO jn = 1, jpit
+        zwgt1(jn) = zwgt1(jn) * za1
+        zwgt2(jn) = zwgt2(jn) * za2
+      END DO
+      !
+   END SUBROUTINE ts_wgt
+
+
+   SUBROUTINE ts_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !! ** Purpose : Read or write time-splitting arrays in restart file
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:) )   
+         CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:) ) 
+         IF( .NOT.ln_bt_av ) THEN
+            CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:) )   
+            CALL iom_get( numror, jpdom_autoglo, 'ubb_e'    ,   ubb_e(:,:) )   
+            CALL iom_get( numror, jpdom_autoglo, 'vbb_e'    ,   vbb_e(:,:) )
+            CALL iom_get( numror, jpdom_autoglo, 'sshb_e'   ,  sshb_e(:,:) ) 
+            CALL iom_get( numror, jpdom_autoglo, 'ub_e'     ,    ub_e(:,:) )   
+            CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:) )
+         ENDIF
+#if defined key_agrif
+         ! Read time integrated fluxes
+         IF ( .NOT.Agrif_Root() ) THEN
+            CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:) )   
+            CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:) )
+         ENDIF
+#endif
+      !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         CALL iom_rstput( kt, nitrst, numrow, 'ub2_b'   , ub2_b  (:,:) )
+         CALL iom_rstput( kt, nitrst, numrow, 'vb2_b'   , vb2_b  (:,:) )
+         !
+         IF (.NOT.ln_bt_av) THEN
+            CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e'  , sshbb_e(:,:) ) 
+            CALL iom_rstput( kt, nitrst, numrow, 'ubb_e'    ,   ubb_e(:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'vbb_e'    ,   vbb_e(:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'sshb_e'   ,  sshb_e(:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'ub_e'     ,    ub_e(:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'vb_e'     ,    vb_e(:,:) )
+         ENDIF
+#if defined key_agrif
+         ! Save time integrated fluxes
+         IF ( .NOT.Agrif_Root() ) THEN
+            CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b'  , ub2_i_b(:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b'  , vb2_i_b(:,:) )
+         ENDIF
+#endif
+      ENDIF
+      !
+   END SUBROUTINE ts_rst
+
+
+   SUBROUTINE dyn_spg_ts_init
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_spg_ts_init  ***
+      !!
+      !! ** Purpose : Set time splitting options
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji ,jj              ! dummy loop indices
+      REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zcu
+      !!----------------------------------------------------------------------
+      !
+      ! Max courant number for ext. grav. waves
+      !
+      CALL wrk_alloc( jpi,jpj,   zcu )
+      !
+      DO jj = 1, jpj
+         DO ji =1, jpi
+            zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj)
+            zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj)
+            zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) )
+         END DO
+      END DO
+      !
+      zcmax = MAXVAL( zcu(:,:) )
+      IF( lk_mpp )   CALL mpp_max( zcmax )
+
+      ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax
+      IF( ln_bt_auto )   nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)
+      
+      rdtbt = rdt / REAL( nn_baro , wp )
+      zcmax = zcmax * rdtbt
+							! Print results
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      IF( ln_bt_auto ) THEN
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.true. Automatically set nn_baro '
+         IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax
+      ELSE
+         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist '
+      ENDIF
+
+      IF(ln_bt_av) THEN
+         IF(lwp) WRITE(numout,*) '     ln_bt_av=.true.  => Time averaging over nn_baro time steps is on '
+      ELSE
+         IF(lwp) WRITE(numout,*) '     ln_bt_av=.false. => No time averaging of barotropic variables '
+      ENDIF
+      !
+      !
+      IF(ln_bt_fw) THEN
+         IF(lwp) WRITE(numout,*) '     ln_bt_fw=.true.  => Forward integration of barotropic variables '
+      ELSE
+         IF(lwp) WRITE(numout,*) '     ln_bt_fw =.false.=> Centred integration of barotropic variables '
+      ENDIF
+      !
+#if defined key_agrif
+      ! Restrict the use of Agrif to the forward case only
+      IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() )   CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )
+#endif
+      !
+      IF(lwp) WRITE(numout,*)    '     Time filter choice, nn_bt_flt: ', nn_bt_flt
+      SELECT CASE ( nn_bt_flt )
+         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac'
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro'
+         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro' 
+         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' )
+      END SELECT
+      !
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) '     nn_baro = ', nn_baro
+      IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rdtbt
+      IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax
+      !
+      IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN
+         CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' )
+      ENDIF
+      IF( zcmax>0.9_wp ) THEN
+         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )          
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   zcu )
+      !
+   END SUBROUTINE dyn_spg_ts_init
+
+   !!======================================================================
+END MODULE dynspg_ts
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 8732)
@@ -0,0 +1,696 @@
+MODULE dynvor
+   !!======================================================================
+   !!                       ***  MODULE  dynvor  ***
+   !! Ocean dynamics: Update the momentum trend with the relative and
+   !!                 planetary vorticity trends
+   !!======================================================================
+   !! History :  OPA  ! 1989-12  (P. Andrich)  vor_ens: Original code
+   !!            5.0  ! 1991-11  (G. Madec) vor_ene, vor_mix: Original code
+   !!            6.0  ! 1996-01  (G. Madec)  s-coord, suppress work arrays
+   !!   NEMO     0.5  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!            1.0  ! 2004-02  (G. Madec)  vor_een: Original code
+   !!             -   ! 2003-08  (G. Madec)  add vor_ctl
+   !!             -   ! 2005-11  (G. Madec)  add dyn_vor (new step architecture)
+   !!            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
+   !!            3.7  ! 2014-04  (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 
+   !!             -   ! 2014-06  (G. Madec) suppression of velocity curl from in-core memory
+   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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_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
+   USE dom_oce        ! ocean space and time domain
+   USE dommsk         ! ocean mask
+   USE dynadv         ! momentum advection (use ln_dynadv_vec value)
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   USE sbcwave        ! Surface Waves (add Stokes-Coriolis force)
+   USE sbc_oce , ONLY : ln_stcor    ! use Stoke-Coriolis force
+   !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_vor        ! routine called by step.F90
+   PUBLIC   dyn_vor_init   ! routine called by nemogcm.F90
+
+   !                                   !!* Namelist namdyn_vor: vorticity term
+   LOGICAL, PUBLIC ::   ln_dynvor_ene   !: energy conserving scheme    (ENE)
+   LOGICAL, PUBLIC ::   ln_dynvor_ens   !: enstrophy conserving scheme (ENS)
+   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme                (MIX)
+   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy and enstrophy conserving scheme (EEN)
+   INTEGER, PUBLIC ::      nn_een_e3f      !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   LOGICAL, PUBLIC ::   ln_dynvor_msk   !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)
+
+   INTEGER ::   nvor_scheme        ! choice of the type of advection scheme
+   !                               ! associated indices:
+   INTEGER, PUBLIC, PARAMETER ::   np_ENE = 1   ! ENE scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_ENS = 2   ! ENS scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 3   ! MIX scheme
+   INTEGER, PUBLIC, PARAMETER ::   np_EEN = 4   ! EEN scheme
+
+   INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity 
+   !                               ! associated indices:
+   INTEGER, PARAMETER ::   np_COR = 1         ! Coriolis (planetary)
+   INTEGER, PARAMETER ::   np_RVO = 2         ! relative vorticity
+   INTEGER, PARAMETER ::   np_MET = 3         ! metric term
+   INTEGER, PARAMETER ::   np_CRV = 4         ! relative + planetary (total vorticity)
+   INTEGER, PARAMETER ::   np_CME = 5         ! Coriolis + metric term
+   
+   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4
+   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_vor( kt )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!
+      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative
+      !!               and planetary vorticity trends) and send them to trd_dyn 
+      !!               for futher diagnostics (l_trddyn=T)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_vor')
+      !
+      IF( l_trddyn )   CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
+      !
+      SELECT CASE ( nvor_scheme )               !==  vorticity trend added to the general trend  ==!
+      !
+      CASE ( np_ENE )                                 !* energy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, nrvm, un , vn , ua, va )                    ! relative vorticity or metric trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, ncor, un , vn , ua, va )                    ! planetary vorticity trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
+         ELSE                                               ! total vorticity trend
+                             CALL vor_ene( kt, ntot, un , vn , ua, va )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+         ENDIF
+         !
+      CASE ( np_ENS )                                 !* enstrophy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two    
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
+         ELSE                                               ! total vorticity trend
+                             CALL vor_ens( kt, ntot, un , vn , ua, va )  ! total vorticity trend
+            IF( ln_stcor )   CALL vor_ens( kt, ncor, usd, vsd, ua, va )  ! add the Stokes-Coriolis trend
+         ENDIF
+         !
+      CASE ( np_MIX )                                 !* mixed ene-ens scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend (ens)
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend (ene)
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
+         ELSE                                               ! total vorticity trend
+                             CALL vor_ens( kt, nrvm, un , vn , ua, va )   ! relative vorticity or metric trend (ens)
+                             CALL vor_ene( kt, ncor, un , vn , ua, va )   ! planetary vorticity trend (ene)
+            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+        ENDIF
+         !
+      CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme
+         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_een( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_een( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt )
+         ELSE                                               ! total vorticity trend
+                             CALL vor_een( kt, ntot, un , vn , ua, va )   ! total vorticity trend
+            IF( ln_stcor )   CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend
+         ENDIF
+         !
+      END SELECT
+      !
+      !                       ! print sum trends (used for debugging)
+      IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor  - Ua: ', mask1=umask,               &
+         &                     tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      IF( l_trddyn )   CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_vor')
+      !
+   END SUBROUTINE dyn_vor
+
+
+   SUBROUTINE vor_ene( kt, kvor, pun, pvn, pua, pva )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE vor_ene  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to 
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time) 
+      !!       and the Sadourny (1975) flux form formulation : conserves the
+      !!       horizontal kinetic energy.
+      !!         The general trend of momentum is increased due to the vorticity 
+      !!       term which is given by:
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ]
+      !!       where rvor is the relative vorticity
+      !!
+      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!
+      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index
+      INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ;
+      !                                                                ! =nrvm (relative vorticity or metric)
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('vor_ene')
+      !
+      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zwz ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff_f(:,:) 
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (   ( pvn(ji+1,jj  ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( pun(ji  ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
+                     &                      - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
+                     &                   * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff_f(ji,jj)                                                                        &
+                       &     + (   ( pvn(ji+1,jj  ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( pun(ji  ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+         IF( ln_sco ) THEN
+            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+         ELSE
+            zwx(:,:) = e2u(:,:) * pun(:,:,jk)
+            zwy(:,:) = e1v(:,:) * pvn(:,:,jk)
+         ENDIF
+         !                                   !==  compute and add the vorticity term trend  =!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1)
+               zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  )
+               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
+               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
+               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('vor_ene')
+      !
+   END SUBROUTINE vor_ene
+
+
+   SUBROUTINE vor_ens( kt, kvor, pun, pvn, pua, pva )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE vor_ens  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!      and the Sadourny (1975) flux FORM formulation : conserves the
+      !!      potential enstrophy of a horizontally non-divergent flow. the
+      !!      trend of the vorticity term is given by:
+      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
+      !!      Add this trend to the general momentum trend (ua,va):
+      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend
+      !!
+      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index
+      INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ;
+         !                                                             ! =nrvm (relative vorticity or metric)
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zuav, zvau   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, zwy, zwz, zww   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('vor_ens')
+      !
+      CALL wrk_alloc( jpi,jpj,   zwx, zwy, zwz ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            zwz(:,:) = ff_f(:,:) 
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (   ( pvn(ji+1,jj  ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( pun(ji  ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
+                     &                      - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
+                     &                   * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff_f(ji,jj)                                                                       &
+                       &     + (   ( pvn(ji+1,jj  ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( pun(ji  ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN           !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==!
+            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk)
+            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
+            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+         ELSE
+            zwx(:,:) = e2u(:,:) * pun(:,:,jk)
+            zwy(:,:) = e1v(:,:) * pvn(:,:,jk)
+         ENDIF
+         !                                   !==  compute and add the vorticity term trend  =!
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zuav = r1_8 * r1_e1u(ji,jj) * (  zwy(ji  ,jj-1) + zwy(ji+1,jj-1)  &
+                  &                           + zwy(ji  ,jj  ) + zwy(ji+1,jj  )  )
+               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  &
+                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  )
+               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('vor_ens')
+      !
+   END SUBROUTINE vor_ens
+
+
+   SUBROUTINE vor_een( kt, kvor, pun, pvn, pua, pva )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE vor_een  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to 
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time) 
+      !!      and the Arakawa and Lamb (1980) flux form formulation : conserves 
+      !!      both the horizontal kinetic energy and the potential enstrophy
+      !!      when horizontal divergence is zero (see the NEMO documentation)
+      !!      Add this trend to the general momentum trend (ua,va).
+      !!
+      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!
+      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                         ::   kt          ! ocean time-step index
+      INTEGER , INTENT(in   )                         ::   kvor        ! =ncor (planetary) ; =ntot (total) ;
+         !                                                             ! =nrvm (relative vorticity or metric)
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun, pvn    ! now velocities
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua, pva    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ierr         ! local integer
+      REAL(wp) ::   zua, zva     ! local scalars
+      REAL(wp) ::   zmsk, ze3    ! local scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zwx, zwy, zwz, z1_e3f
+      REAL(wp), POINTER, DIMENSION(:,:)   :: ztnw, ztne, ztsw, ztse
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('vor_een')
+      !
+      CALL wrk_alloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f ) 
+      CALL wrk_alloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point
+         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
+                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3
+                  ELSE                      ;   z1_e3f(ji,jj) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ze3  = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  )
+                  zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   &
+                     &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  )
+                  IF( ze3 /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = zmsk / ze3
+                  ELSE                      ;   z1_e3f(ji,jj) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         END SELECT
+         !
+         SELECT CASE( kvor )                 !==  vorticity considered  ==!
+         CASE ( np_COR )                           !* Coriolis (planetary vorticity)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ff_f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_RVO )                           !* relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
+                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
+                     &       * r1_e1e2f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_MET )                           !* metric term
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (   ( pvn(ji+1,jj  ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( pun(ji  ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 * r1_e1e2f(ji,jj) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CRV )                           !* Coriolis + relative vorticity
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    &
+                     &                           - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) &
+                     &                      * r1_e1e2f(ji,jj)    ) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE ( np_CME )                           !* Coriolis + metric
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (  ff_f(ji,jj)                                                                        &
+                       &        + (   ( pvn(ji+1,jj  ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &            - ( pun(ji  ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &        * 0.5 * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj)
+               END DO
+            END DO
+         CASE DEFAULT                                             ! error
+            CALL ctl_stop('STOP','dyn_vor: wrong value for kvor'  )
+         END SELECT
+         !
+         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL lbc_lnk( zwz, 'F', 1. )
+         !
+         !                                   !==  horizontal fluxes  ==!
+         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk)
+         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk)
+
+         !                                   !==  compute and add the vorticity term trend  =!
+         jj = 2
+         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0
+         DO ji = 2, jpi          ! split in 2 parts due to vector opt.
+               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
+               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
+               ztse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
+               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
+         END DO
+         DO jj = 3, jpj
+            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3
+               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
+               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
+               ztse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1)
+               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  )
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   &
+                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   &
+                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) )
+               pua(ji,jj,jk) = pua(ji,jj,jk) + zua
+               pva(ji,jj,jk) = pva(ji,jj,jk) + zva
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      !
+      CALL wrk_dealloc( jpi,jpj,   zwx , zwy , zwz , z1_e3f ) 
+      CALL wrk_dealloc( jpi,jpj,   ztnw, ztne, ztsw, ztse   ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('vor_een')
+      !
+   END SUBROUTINE vor_een
+
+
+   SUBROUTINE dyn_vor_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_vor_init  ***
+      !!
+      !! ** Purpose :   Control the consistency between cpp options for
+      !!              tracer advection schemes
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio          ! local integer
+      INTEGER ::   ji, jj, jk      ! dummy loop indices
+      INTEGER ::   ios             ! Local integer output status for namelist read
+      !!
+      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, nn_een_e3f, ln_dynvor_msk
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namdyn_vor in reference namelist : Vorticity scheme options
+      READ  ( numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_vor in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdyn_vor in configuration namelist : Vorticity scheme options
+      READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdyn_vor )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_vor_init : vorticity term : read namelist and control the consistency'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namdyn_vor : choice of the vorticity term scheme'
+         WRITE(numout,*) '      energy    conserving scheme                    ln_dynvor_ene = ', ln_dynvor_ene
+         WRITE(numout,*) '      enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens
+         WRITE(numout,*) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix
+         WRITE(numout,*) '      enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een
+         WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f
+         WRITE(numout,*) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk
+      ENDIF
+
+!!gm  this should be removed when choosing a unique strategy for fmask at the coast
+      ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks
+      ! at angles with three ocean points and one land point
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat
+      IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF( tmask(ji,jj,jk)+tmask(ji+1,jj,jk)+tmask(ji,jj+1,jk)+tmask(ji+1,jj+1,jk) == 3._wp ) &
+                      fmask(ji,jj,jk) = 1._wp
+               END DO
+            END DO
+         END DO
+          !
+          CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+          !
+      ENDIF
+!!gm end
+
+      ioptio = 0                     ! type of scheme for vorticity (set nvor_scheme)
+      IF( ln_dynvor_ene ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_ENE   ;   ENDIF
+      IF( ln_dynvor_ens ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_ENS   ;   ENDIF
+      IF( ln_dynvor_mix ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_MIX   ;   ENDIF
+      IF( ln_dynvor_een ) THEN   ;   ioptio = ioptio + 1   ;    nvor_scheme = np_EEN   ;   ENDIF
+      !
+      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' )
+      !                      
+      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot)
+      ncor = np_COR
+      IF( ln_dynadv_vec ) THEN     
+         IF(lwp) WRITE(numout,*) '      ===>>   Vector form advection : vorticity = Coriolis + relative vorticity'
+         nrvm = np_RVO        ! relative vorticity
+         ntot = np_CRV        ! relative + planetary vorticity
+      ELSE                        
+         IF(lwp) WRITE(numout,*) '      ===>>   Flux form advection   : vorticity = Coriolis + metric term'
+         nrvm = np_MET        ! metric term
+         ntot = np_CME        ! Coriolis + metric term
+      ENDIF
+      
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nvor_scheme ==  np_ENE )   WRITE(numout,*) '      ===>>   energy conserving scheme'
+         IF( nvor_scheme ==  np_ENS )   WRITE(numout,*) '      ===>>   enstrophy conserving scheme'
+         IF( nvor_scheme ==  np_MIX )   WRITE(numout,*) '      ===>>   mixed enstrophy/energy conserving scheme'
+         IF( nvor_scheme ==  np_EEN )   WRITE(numout,*) '      ===>>   energy and enstrophy conserving scheme'
+      ENDIF
+      !
+   END SUBROUTINE dyn_vor_init
+
+   !!==============================================================================
+END MODULE dynvor
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 8732)
@@ -0,0 +1,293 @@
+MODULE dynzad
+   !!======================================================================
+   !!                       ***  MODULE  dynzad  ***
+   !! Ocean dynamics : vertical advection trend
+   !!======================================================================
+   !! History :  OPA  ! 1991-01  (G. Madec) Original code
+   !!            7.0  ! 1991-11  (G. Madec)
+   !!            7.5  ! 1996-01  (G. Madec) statement function for e3
+   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dyn_zad       : vertical advection momentum trend
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   dyn_zad       ! routine called by dynadv.F90
+   PUBLIC   dyn_zad_zts   ! routine called by dynadv.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_zad ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dynzad  ***
+      !! 
+      !! ** Purpose :   Compute the now vertical momentum advection trend and 
+      !!      add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The now vertical advection of momentum is given by:
+      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ]
+      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ]
+      !!      Add this trend to the general trend (ua,va):
+      !!         (ua,va) = (ua,va) + w dz(u,v)
+      !!
+      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends
+      !!              - Send the trends to trddyn for diagnostics (l_trddyn=T)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   zua, zva        ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zww
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_zad')
+      !
+      CALL wrk_alloc( jpi,jpj, zww ) 
+      CALL wrk_alloc( jpi,jpj,jpk, zwuw , zwvw ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'dyn_zad : arakawa advection scheme'
+      ENDIF
+
+      IF( l_trddyn )   THEN         ! Save ua and va trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+         ztrdu(:,:,:) = ua(:,:,:) 
+         ztrdv(:,:,:) = va(:,:,:) 
+      ENDIF
+      
+      DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical
+         DO jj = 2, jpj                   ! vertical fluxes 
+            DO ji = fs_2, jpi             ! vector opt.
+               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
+            DO ji = fs_2, fs_jpim1        ! vector opt.
+               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )
+               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )
+            END DO  
+         END DO   
+      END DO
+      !
+      ! Surface and bottom advective fluxes set to zero
+      IF ( ln_isfcav ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1           ! vector opt.
+               zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
+               zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
+               zwuw(ji,jj,jpk) = 0._wp
+               zwvw(ji,jj,jpk) = 0._wp
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1        
+            DO ji = fs_2, fs_jpim1           ! vector opt.
+               zwuw(ji,jj, 1 ) = 0._wp
+               zwvw(ji,jj, 1 ) = 0._wp
+               zwuw(ji,jj,jpk) = 0._wp
+               zwvw(ji,jj,jpk) = 0._wp
+            END DO  
+         END DO
+      END IF
+
+      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1       ! vector opt.
+               !                         ! vertical momentum advective trends
+               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+               !                         ! add the trends to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+            END DO  
+         END DO  
+      END DO
+
+      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+      ENDIF
+      !                             ! Control print
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CALL wrk_dealloc( jpi,jpj, zww ) 
+      CALL wrk_dealloc( jpi,jpj,jpk, zwuw , zwvw ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_zad')
+      !
+   END SUBROUTINE dyn_zad
+
+
+   SUBROUTINE dyn_zad_zts ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dynzad_zts  ***
+      !! 
+      !! ** Purpose :   Compute the now vertical momentum advection trend and 
+      !!      add it to the general trend of momentum equation. This version
+      !!      uses sub-timesteps for improved numerical stability with small
+      !!      vertical grid sizes. This is especially relevant when using 
+      !!      embedded ice with thin surface boxes.
+      !!
+      !! ** Method  :   The now vertical advection of momentum is given by:
+      !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]
+      !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]
+      !!      Add this trend to the general trend (ua,va):
+      !!         (ua,va) = (ua,va) + w dz(u,v)
+      !!
+      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends
+      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn')
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
+      !
+      INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices
+      INTEGER  ::   jnzts = 5       ! number of sub-timesteps for vertical advection
+      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
+      REAL(wp) ::   zua, zva        ! temporary scalars
+      REAL(wp) ::   zr_rdt          ! temporary scalar
+      REAL(wp) ::   z2dtzts         ! length of Euler forward sub-timestep for vertical advection
+      REAL(wp) ::   zts             ! length of sub-timestep for vertical advection
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  zwuw , zwvw, zww
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::  ztrdu, ztrdv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zus , zvs
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_zad_zts')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,     zwuw, zwvw, zww ) 
+      CALL wrk_alloc( jpi,jpj,jpk,3,   zus , zvs ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'dyn_zad_zts : arakawa advection scheme with sub-timesteps'
+      ENDIF
+
+      IF( l_trddyn )   THEN         ! Save ua and va trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+         ztrdu(:,:,:) = ua(:,:,:) 
+         ztrdv(:,:,:) = va(:,:,:) 
+      ENDIF
+      
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+          z2dtzts =         rdt / REAL( jnzts, wp )   ! = rdt (restart with Euler time stepping)
+      ELSE
+          z2dtzts = 2._wp * rdt / REAL( jnzts, wp )   ! = 2 rdt (leapfrog)
+      ENDIF
+      
+      DO jk = 2, jpkm1                    ! Calculate and store vertical fluxes
+         DO jj = 2, jpj                   
+            DO ji = fs_2, jpi             ! vector opt.
+               zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                    ! Surface and bottom advective fluxes set to zero
+         DO ji = fs_2, fs_jpim1           ! vector opt.
+ !!gm missing ISF boundary condition
+            zwuw(ji,jj, 1 ) = 0._wp
+            zwvw(ji,jj, 1 ) = 0._wp
+            zwuw(ji,jj,jpk) = 0._wp
+            zwvw(ji,jj,jpk) = 0._wp
+         END DO  
+      END DO
+
+! Start with before values and use sub timestepping to reach after values
+
+      zus(:,:,:,1) = ub(:,:,:)
+      zvs(:,:,:,1) = vb(:,:,:)
+
+      DO jl = 1, jnzts                   ! Start of sub timestepping loop
+
+         IF( jl == 1 ) THEN              ! Euler forward to kick things off
+           jtb = 1   ;   jtn = 1   ;   jta = 2
+           zts = z2dtzts
+         ELSEIF( jl == 2 ) THEN          ! First leapfrog step
+           jtb = 1   ;   jtn = 2   ;   jta = 3
+           zts = 2._wp * z2dtzts
+         ELSE                            ! Shuffle pointers for subsequent leapfrog steps
+           jtb = MOD(jtb,3) + 1
+           jtn = MOD(jtn,3) + 1
+           jta = MOD(jta,3) + 1
+         ENDIF
+
+         DO jk = 2, jpkm1           ! Vertical momentum advection at level w and u- and v- vertical
+            DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
+               DO ji = fs_2, fs_jpim1        ! vector opt.
+                  zwuw(ji,jj,jk) = ( zww(ji+1,jj  ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) ) !* wumask(ji,jj,jk)
+                  zwvw(ji,jj,jk) = ( zww(ji  ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) ) !* wvmask(ji,jj,jk)
+               END DO  
+            END DO   
+         END DO
+         DO jk = 1, jpkm1           ! Vertical momentum advection at u- and v-points
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1       ! vector opt.
+                  !                         ! vertical momentum advective trends
+                  zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+                  zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+                  zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts
+                  zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts
+               END DO  
+            END DO  
+         END DO
+
+      END DO      ! End of sub timestepping loop
+
+      zr_rdt = 1._wp / ( REAL( jnzts, wp ) * z2dtzts )
+      DO jk = 1, jpkm1              ! Recover trends over the outer timestep
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1       ! vector opt.
+               !                         ! vertical momentum advective trends
+               !                         ! add the trends to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zus(ji,jj,jk,jta) - ub(ji,jj,jk)) * zr_rdt
+               va(ji,jj,jk) = va(ji,jj,jk) + ( zvs(ji,jj,jk,jta) - vb(ji,jj,jk)) * zr_rdt
+            END DO  
+         END DO  
+      END DO
+
+      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+      ENDIF
+      !                             ! Control print
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,     zwuw, zwvw, zww ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,3,   zus , zvs ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_zad_zts')
+      !
+   END SUBROUTINE dyn_zad_zts
+
+   !!======================================================================
+END MODULE dynzad
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 8732)
@@ -0,0 +1,128 @@
+MODULE dynzdf
+   !!==============================================================================
+   !!                 ***  MODULE  dynzdf  ***
+   !! Ocean dynamics :  vertical component of the momentum mixing trend
+   !!==============================================================================
+   !! 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
+   !!   dyn_zdf_init  : initializations of the vertical diffusion scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE zdf_oce        ! ocean vertical physics variables
+   USE dynzdf_exp     ! vertical diffusion: explicit (dyn_zdf_exp     routine)
+   USE dynzdf_imp     ! vertical diffusion: implicit (dyn_zdf_imp     routine)
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE trd_oce        ! trends: ocean variables
+   USE trddyn         ! trend manager: dynamics
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE dyn_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf  ***
+      !!
+      !! ** Purpose :   compute the vertical ocean dynamics physics.
+      !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_zdf')
+      !
+      !                                          ! set time step
+      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdt (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdt (leapfrog)
+      ENDIF
+
+      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+         ztrdu(:,:,:) = ua(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:)
+      ENDIF
+
+      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
+      !
+      END SELECT
+
+      IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:)
+         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:)
+         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               &
+         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf')
+      !
+   END SUBROUTINE dyn_zdf
+
+
+   SUBROUTINE dyn_zdf_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_zdf_init  ***
+      !!
+      !! ** Purpose :   initializations of the vertical diffusion scheme
+      !!
+      !! ** Method  :   implicit (euler backward) scheme (default)
+      !!                explicit (time-splitting) scheme if ln_zdfexp=T
+      !!----------------------------------------------------------------------
+      USE zdftke
+      USE zdfgls
+      !!----------------------------------------------------------------------
+      !
+      ! 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 .OR. lk_zdfgls   )   nzdf = 1   ! TKE or GLS physics
+      IF( ln_dynldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_dynldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      !
+      IF(lwp) THEN                                  ! Print the choice
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf ==  0 )   WRITE(numout,*) '      ===>>   Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '      ===>>   Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE dyn_zdf_init
+
+   !!==============================================================================
+END MODULE dynzdf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 8732)
@@ -0,0 +1,149 @@
+MODULE dynzdf_exp
+   !!==============================================================================
+   !!                     ***  MODULE  dynzdf_exp  ***
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal
+   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!            3.7  !  2015-11  (J. Chanut) output velocities instead of trends
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_exp   : update the momentum trend with the vertical diffusion using a split-explicit scheme
+   !!                   and perform the Leap-Frog time integration.
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE zdf_oce        ! ocean vertical physics
+   USE dynadv   , ONLY: ln_dynadv_vec ! Momentum advection form
+   USE sbc_oce        ! surface boundary condition: ocean
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_zdf_exp   ! called by step.F90
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_zdf_exp( kt, p2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_exp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!              and perform the Leap-Frog time stepping.
+      !!
+      !! ** Method  : - Split-explicit forward time stepping.
+      !!      The vertical mixing of momentum is given by:
+      !!         diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) )
+      !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2)
+      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F90)
+      !!      Add this trend to the general trend ua :
+      !!         ua = ua + dz( avmu dz(u) )
+      !!              - Leap-Frog time stepping (Asselin filter will be applied in dyn_nxt) 
+      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
+      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
+      !!
+      !! ** Action : - (ua,va) after velocity
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in) ::   kt     ! ocean time-step index
+      REAL(wp), INTENT(in) ::   p2dt   ! time-step 
+      !
+      INTEGER  ::   ji, jj, jk, jl     ! dummy loop indices
+      REAL(wp) ::   zlavmr, zua, zva   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dyn_zdf_exp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, zww ) 
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_zdf_exp : vertical momentum diffusion - explicit operator'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !
+      !                 !==  vertical mixing trend  ==!
+      !
+      zlavmr = 1. / REAL( nn_zdfexp )
+      !
+      DO jj = 2, jpjm1           ! Surface boundary condition
+         DO ji = 2, jpim1
+            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0
+            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_rau0
+         END DO  
+      END DO  
+      DO jk = 1, jpk             ! Initialization of x, z and contingently trends array
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1
+               zwx(ji,jj,jk) = ub(ji,jj,jk)
+               zwz(ji,jj,jk) = vb(ji,jj,jk)
+            END DO  
+         END DO  
+      END DO  
+      !
+      DO jl = 1, nn_zdfexp       ! Time splitting loop
+         !
+         DO jk = 2, jpk                ! First vertical derivative
+            DO jj = 2, jpjm1 
+               DO ji = 2, jpim1
+                  zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / e3uw_n(ji,jj,jk) 
+                  zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / e3vw_n(ji,jj,jk)
+               END DO  
+            END DO  
+         END DO  
+         DO jk = 1, jpkm1              ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
+            DO jj = 2, jpjm1 
+               DO ji = 2, jpim1
+                  zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / e3u_n(ji,jj,jk)
+                  zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / e3v_n(ji,jj,jk)
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  !
+                  zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt * zua * umask(ji,jj,jk)
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) + p2dt * zva * vmask(ji,jj,jk)
+               END DO  
+            END DO  
+         END DO  
+      END DO                     ! End of time splitting
+      !
+      !
+      !                 !==  Leap-Frog time integration  ==!
+      !
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk)
+         END DO
+      ELSE                                      ! applied on thickness weighted velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = (          e3u_b(:,:,jk) * ub(:,:,jk)    &
+               &           + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
+            va(:,:,jk) = (          e3v_b(:,:,jk) * vb(:,:,jk)    &
+               &           + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, zww ) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf_exp')
+      !
+   END SUBROUTINE dyn_zdf_exp
+
+   !!==============================================================================
+END MODULE dynzdf_exp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 8732)
@@ -0,0 +1,351 @@
+MODULE dynzdf_imp
+   !!======================================================================
+   !!                    ***  MODULE  dynzdf_imp  ***
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend, implicit scheme
+   !!======================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal
+   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!            3.4  !  2012-01  (H. Liu) Semi-implicit bottom friction
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_imp   : compute the vertical diffusion using a implicit scheme
+   !!                   together with the Leap-Frog time integration.
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! variable volume
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dynadv   , ONLY: ln_dynadv_vec ! Momentum advection form
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfbfr         ! Bottom friction setup
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_zdf_imp   ! called by step.F90
+
+   REAL(wp) ::  r_vvl     ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise 
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_zdf_imp( kt, p2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_imp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!              together with the Leap-Frog time stepping using an 
+      !!              implicit scheme.
+      !!
+      !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing
+      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf.
+      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise
+      !!               - update the after velocity with the implicit vertical mixing.
+      !!      This requires to solver the following system: 
+      !!         ua = ua + 1/e3u_a dk+1[ avmu / e3uw_a dk[ua] ]
+      !!      with the following surface/top/bottom boundary condition:
+      !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2)
+      !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfbfr.F)
+      !!
+      !! ** Action :   (ua,va) after velocity 
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in) ::  kt     ! ocean time-step index
+      REAL(wp), INTENT(in) ::  p2dt   ! vertical profile of tracer time-step
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv    ! local integers
+      REAL(wp) ::   zzwi, ze3ua   ! local scalars
+      REAL(wp) ::   zzws, ze3va   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_zdf_imp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator
+         ELSE                   ;    r_vvl = 1._wp
+         ENDIF
+      ENDIF
+      !
+      !              !==  Time step dynamics  ==!
+      !
+      IF( ln_dynadv_vec .OR. ln_linssh ) THEN      ! applied on velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk)
+         END DO
+      ELSE                                         ! applied on thickness weighted velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  &
+               &          + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk)
+            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  &
+               &          + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk)
+         END DO
+      ENDIF
+      !
+      !              !==  Apply semi-implicit bottom friction  ==!
+      !
+      ! Only needed for semi-implicit bottom friction setup. The explicit
+      ! bottom friction has been included in "u(v)a" which act as the R.H.S
+      ! column vector of the tri-diagonal matrix equation
+      !
+      IF( ln_bfrimp ) THEN
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ikbu = mbku(ji,jj)       ! ocean bottom level at u- and v-points 
+               ikbv = mbkv(ji,jj)       ! (deepest ocean u- and v-points)
+               avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * e3uw_n(ji,jj,ikbu+1)
+               avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * e3vw_n(ji,jj,ikbv+1)
+            END DO
+         END DO
+         IF ( ln_isfcav ) THEN
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ikbu = miku(ji,jj)       ! ocean top level at u- and v-points 
+                  ikbv = mikv(ji,jj)       ! (first wet ocean u- and v-points)
+                  IF( ikbu >= 2 )   avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu)
+                  IF( ikbv >= 2 )   avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv)
+               END DO
+            END DO
+         END IF
+      ENDIF
+      !
+      ! With split-explicit free surface, barotropic stress is treated explicitly
+      ! Update velocities at the bottom.
+      ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does 
+      !            not lead to the effective stress seen over the whole barotropic loop. 
+      ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a
+      IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN
+         DO jk = 1, jpkm1        ! remove barotropic velocities
+            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk)
+            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk)
+         END DO
+         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu)
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv)
+               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua
+               va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va
+            END DO
+         END DO
+         IF( ln_isfcav ) THEN    ! Ocean cavities (ISF)
+            DO jj = 2, jpjm1        
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ikbu = miku(ji,jj)         ! top ocean level at u- and v-points 
+                  ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu)
+                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv)
+                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua
+                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va
+               END DO
+            END DO
+         END IF
+      ENDIF
+      !
+      !              !==  Vertical diffusion on u  ==!
+      !
+      ! Matrix and second member construction
+      ! bottom boundary condition: both zwi and zws must be masked as avmu can take
+      ! non zero value at the ocean bottom depending on the bottom friction used.
+      !
+      DO jk = 1, jpkm1        ! Matrix
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point
+               zzwi = - p2dt * avmu(ji,jj,jk  ) / ( ze3ua * e3uw_n(ji,jj,jk  ) )
+               zzws = - p2dt * avmu(ji,jj,jk+1) / ( ze3ua * e3uw_n(ji,jj,jk+1) )
+               zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk  )
+               zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boundary 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
+
+      ! Matrix inversion starting 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 a lower triangular matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The solution (the after velocity) is in ua
+      !-----------------------------------------------------------------------
+      !
+      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.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
+            ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1) 
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      !              !==  Vertical diffusion on v  ==!
+      !
+      ! Matrix and second member construction
+      ! bottom boundary condition: both zwi and zws must be masked as avmv can take
+      ! non zero value at the ocean bottom depending on the bottom friction used
+      !
+      DO jk = 1, jpkm1        ! Matrix
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point
+               zzwi = - p2dt * avmv (ji,jj,jk  ) / ( ze3va * e3vw_n(ji,jj,jk  ) )
+               zzws = - p2dt * avmv (ji,jj,jk+1) / ( ze3va * e3vw_n(ji,jj,jk+1) )
+               zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  )
+               zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zzwi - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boundary 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
+
+      ! Matrix inversion
+      !-----------------------------------------------------------------------
+      !   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 solution (after velocity) is in 2d array va
+      !-----------------------------------------------------------------------
+      !
+      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.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.          
+            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
+            va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1) 
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      
+      ! J. Chanut: Lines below are useless ?
+      !! restore bottom layer avmu(v) 
+      !!gm  I almost sure it is !!!!
+      IF( ln_bfrimp ) THEN
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1
+              ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+              ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+              avmu(ji,jj,ikbu+1) = 0._wp
+              avmv(ji,jj,ikbv+1) = 0._wp
+           END DO
+        END DO
+        IF (ln_isfcav) THEN
+           DO jj = 2, jpjm1
+              DO ji = 2, jpim1
+                 ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
+                 ikbv = mikv(ji,jj)         ! (first wet ocean u- and v-points)
+                 IF( ikbu > 1 )   avmu(ji,jj,ikbu) = 0._wp
+                 IF( ikbv > 1 )   avmv(ji,jj,ikbv) = 0._wp
+              END DO
+           END DO
+        ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwd, zws) 
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dyn_zdf_imp')
+      !
+   END SUBROUTINE dyn_zdf_imp
+
+   !!==============================================================================
+END MODULE dynzdf_imp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 8732)
@@ -0,0 +1,278 @@
+MODULE sshwzv   
+   !!==============================================================================
+   !!                       ***  MODULE  sshwzv  ***
+   !! Ocean dynamics : sea surface height and vertical velocity
+   !!==============================================================================
+   !! 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
+   !!            3.3  !  2011-10  (M. Leclair) split former ssh_wzv routine and remove all vvl related work
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ssh_nxt       : after ssh
+   !!   ssh_swp       : filter ans swap the ssh arrays
+   !!   wzv           : compute now vertical velocity
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE domvvl         ! Variable volume
+   USE divhor         ! horizontal divergence
+   USE phycst         ! physical constants
+   USE bdy_oce   , ONLY: ln_bdy, bdytmask
+   USE bdydyn2d       ! bdy_ssh routine
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
+#if defined key_asminc   
+   USE   asminc       ! Assimilation increment
+#endif
+   !
+   USE in_out_manager ! I/O manager
+   USE restart        ! only for lrst_oce
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE wet_dry         ! Wetting/Drying flux limting
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ssh_nxt    ! called by step.F90
+   PUBLIC   wzv        ! called by step.F90
+   PUBLIC   ssh_swp    ! called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ssh_nxt( kt )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE ssh_nxt  ***
+      !!                   
+      !! ** Purpose :   compute the after ssh (ssha)
+      !!
+      !! ** Method  : - Using the incompressibility hypothesis, the ssh increment
+      !!      is computed by integrating the horizontal divergence and multiply by
+      !!      by the time step.
+      !!
+      !! ** action  :   ssha, after sea surface height
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step
+      ! 
+      INTEGER  ::   jk            ! dummy loop indice
+      REAL(wp) ::   z2dt, zcoef   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ssh_nxt')
+      !
+      CALL wrk_alloc( jpi,jpj,   zhdiv ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ssh_nxt : after sea surface height'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      z2dt = 2._wp * rdt                          ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
+      zcoef = 0.5_wp * r1_rau0
+
+      !                                           !------------------------------!
+      !                                           !   After Sea Surface Height   !
+      !                                           !------------------------------!
+      IF(ln_wd) THEN
+         CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt)
+      ENDIF
+
+      CALL div_hor( kt )                               ! Horizontal divergence
+      !
+      zhdiv(:,:) = 0._wp
+      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
+        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
+      END DO
+      !                                                ! Sea surface elevation time stepping
+      ! In time-split case we need a first guess of the ssh after (using the baroclinic timestep) in order to
+      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations.
+      ! 
+      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:)
+
+      IF ( .NOT.ln_dynspg_ts ) THEN
+         ! These lines are not necessary with time splitting since
+         ! boundary condition on sea level is set during ts loop
+# if defined key_agrif
+         CALL agrif_ssh( kt )
+# endif
+         IF( ln_bdy ) THEN
+            CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary
+            CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries
+         ENDIF
+      ENDIF
+
+#if defined key_asminc
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment
+         CALL ssh_asm_inc( kt )
+         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
+      ENDIF
+#endif
+      !                                           !------------------------------!
+      !                                           !           outputs            !
+      !                                           !------------------------------!
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 )
+      !
+      CALL wrk_dealloc( jpi, jpj, zhdiv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ssh_nxt')
+      !
+   END SUBROUTINE ssh_nxt
+
+   
+   SUBROUTINE wzv( kt )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE wzv  ***
+      !!                   
+      !! ** Purpose :   compute the now vertical velocity
+      !!
+      !! ** 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.
+      !!        The boundary conditions are w=0 at the bottom (no flux) and.
+      !!
+      !! ** action  :   wn      : now vertical velocity
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z1_2dt       ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('wzv')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'wzv : now vertical velocity '
+         IF(lwp) WRITE(numout,*) '~~~~~ '
+         !
+         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
+      ENDIF
+      !                                           !------------------------------!
+      !                                           !     Now Vertical Velocity    !
+      !                                           !------------------------------!
+      z1_2dt = 1. / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1. / rdt
+      !
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases
+         CALL wrk_alloc( jpi, jpj, jpk, zhdiv ) 
+         !
+         DO jk = 1, jpkm1
+            ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t)
+            ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk(zhdiv, 'T', 1.)  ! - ML - Perhaps not necessary: not used for horizontal "connexions"
+         !                             ! Is it problematic to have a wrong vertical velocity in boundary cells?
+         !                             ! Same question holds for hdivn. Perhaps just for security
+         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
+            ! computation of w
+            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    &
+               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk)
+         END DO
+         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0
+         CALL wrk_dealloc( jpi, jpj, jpk, zhdiv ) 
+      ELSE   ! z_star and linear free surface cases
+         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence
+            ! computation of w
+            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 &
+               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk)
+         END DO
+      ENDIF
+
+      IF( ln_bdy ) THEN
+         DO jk = 1, jpkm1
+            wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+         END DO
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('wzv')
+      !
+   END SUBROUTINE wzv
+
+
+   SUBROUTINE ssh_swp( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ssh_nxt  ***
+      !!
+      !! ** Purpose :   achieve the sea surface  height time stepping by 
+      !!              applying Asselin time filter and swapping the arrays
+      !!              ssha  already computed in ssh_nxt  
+      !!
+      !! ** 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
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      REAL(wp) ::   zcoef   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ssh_swp')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !              !==  Euler time-stepping: no filter, just swap  ==!
+      IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    &
+         & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN 
+         sshb(:,:) = sshn(:,:)                              ! before <-- now
+         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now)
+         !
+      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==!
+         !                                                  ! before <-- now filtered
+         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )
+         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed
+            zcoef = atfp * rdt * r1_rau0
+            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   &
+               &                             -    rnf_b(:,:) + rnf   (:,:)   &
+               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:)
+         ENDIF
+         sshn(:,:) = ssha(:,:)                              ! now <-- after
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ssh_swp')
+      !
+   END SUBROUTINE ssh_swp
+
+   !!======================================================================
+END MODULE sshwzv
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90	(revision 8732)
@@ -0,0 +1,412 @@
+MODULE wet_dry
+   !!==============================================================================
+   !!                       ***  MODULE  wet_dry  ***
+   !! Wetting and drying includes initialisation routine and routines to
+   !! compute and apply flux limiters and preserve water depth positivity
+   !! only effects if wetting/drying is on (ln_wd == .true.)
+   !!==============================================================================
+   !! History :  3.6  ! 2014-09  ((H.Liu)  Original code
+   !!                 ! will add the runoff and periodic BC case later
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   wad_lmt    : Compute the horizontal flux limiter and the limited velocity
+   !!                when wetting and drying happens 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoff 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !!----------------------------------------------------------------------
+   !! critical depths,filters, limiters,and masks for  Wetting and Drying
+   !! ---------------------------------------------------------------------
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask         !: u- and v- limiter 
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   ht_wd          !: wetting and drying t-pt depths
+                                                                     !  (can include negative depths)
+
+   LOGICAL,  PUBLIC  ::   ln_wd       !: Wetting/drying activation switch (T:on,F:off)
+   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells
+   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerrance of minimum water depth on dried cells
+   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying 
+                                           !: will be considered
+   INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter
+
+   PUBLIC   wad_init                  ! initialisation routine called by step.F90
+   PUBLIC   wad_lmt                   ! routine called by sshwzv.F90
+   PUBLIC   wad_lmt_bt                ! routine called by dynspg_ts.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+CONTAINS
+
+   SUBROUTINE wad_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE wad_init  ***
+      !!                    
+      !! ** Purpose :   read wetting and drying namelist and print the variables.
+      !!
+      !! ** input   : - namwad namelist
+      !!----------------------------------------------------------------------
+      NAMELIST/namwad/ ln_wd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      INTEGER  ::   ierr                ! Local integer status array allocation 
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namwad in reference namelist 
+                                        ! : Parameters for Wetting/Drying
+      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.) 
+      REWIND( numnam_cfg )              ! Namelist namwad in configuration namelist 
+                                        ! : Parameters for Wetting/Drying
+      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. )
+      IF(lwm) WRITE ( numond, namwad )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'wad_init : Wetting and drying initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namwad'
+         WRITE(numout,*) '      Logical activation                 ln_wd      = ', ln_wd
+         WRITE(numout,*) '      Minimum wet depth on dried cells rn_wdmin1    = ', rn_wdmin1
+         WRITE(numout,*) '      Tolerance of min wet depth     rn_wdmin2      = ', rn_wdmin2
+         WRITE(numout,*) '      land elevation threshold         rn_wdld      = ', rn_wdld
+         WRITE(numout,*) '      Max iteration for W/D limiter    nn_wdit      = ', nn_wdit
+      ENDIF
+      !
+      IF(ln_wd) THEN
+         ALLOCATE( wdmask(jpi,jpj), ht_wd(jpi,jpj),  STAT=ierr )
+         IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error')
+      ENDIF
+      !
+   END SUBROUTINE wad_init
+
+
+   SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE wad_lmt  ***
+      !!                    
+      !! ** Purpose :   generate flux limiters for wetting/drying
+      !!
+      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif) 
+      !!
+      !! ** Action  : - calculate flux limiter and W/D flag
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1
+      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   sshemp
+      REAL(wp), INTENT(in) :: z2dt
+      !
+      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
+      INTEGER  ::   jflag               ! local scalar
+      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
+      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
+      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
+      REAL(wp) ::   ztmp                ! local scalars
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
+      !!----------------------------------------------------------------------
+      !
+
+      IF( nn_timing == 1 )  CALL timing_start('wad_lmt')
+
+      IF(ln_wd) THEN
+
+        CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
+        CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        !
+       
+        !IF(lwp) WRITE(numout,*)
+        !IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting'
+       
+        jflag  = 0
+        zdepwd = 50._wp   !maximum depth on which that W/D could possibly happen
+
+       
+        zflxp(:,:)   = 0._wp
+        zflxn(:,:)   = 0._wp
+        zflxu(:,:)   = 0._wp
+        zflxv(:,:)   = 0._wp
+
+        zwdlmtu(:,:)  = 1._wp
+        zwdlmtv(:,:)  = 1._wp
+       
+        ! Horizontal Flux in u and v direction
+        DO jk = 1, jpkm1  
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
+                 zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
+              END DO  
+           END DO  
+        END DO
+       
+        zflxu(:,:) = zflxu(:,:) * e2u(:,:)
+        zflxv(:,:) = zflxv(:,:) * e1v(:,:)
+       
+        wdmask(:,:) = 1
+        DO jj = 2, jpj
+           DO ji = 2, jpi 
+
+             IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE   ! we don't care about land cells
+             IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
+
+              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
+                           & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp) 
+              zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + &
+                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
+
+              zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1
+              IF(zdep2 .le. 0._wp) THEN  !add more safty, but not necessary
+                sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
+                IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
+                IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
+                IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
+                IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
+                wdmask(ji,jj) = 0._wp
+              END IF
+           ENDDO
+        END DO
+
+      
+        !! start limiter iterations 
+        DO jk1 = 1, nn_wdit + 1
+       
+          
+           zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
+           zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
+           jflag = 0     ! flag indicating if any further iterations are needed
+          
+           DO jj = 2, jpj
+              DO ji = 2, jpi 
+        
+                 IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 
+                 IF( ht_wd(ji,jj) > zdepwd )      CYCLE
+        
+                 ztmp = e1e2t(ji,jj)
+
+                 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + &
+                        & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
+                 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + &
+                        & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
+          
+                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+                 zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
+          
+                 IF( zdep1 > zdep2 ) THEN
+                   wdmask(ji, jj) = 0
+                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+                   !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
+                   ! flag if the limiter has been used but stop flagging if the only
+                   ! changes have zeroed the coefficient since further iterations will
+                   ! not change anything
+                   IF( zcoef > 0._wp ) THEN
+                      jflag = 1 
+                   ELSE
+                      zcoef = 0._wp
+                   ENDIF
+                   IF(jk1 > nn_wdit) zcoef = 0._wp
+                   IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
+                   IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
+                   IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
+                   IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
+                 END IF
+              END DO ! ji loop
+           END DO  ! jj loop
+
+           CALL lbc_lnk( zwdlmtu, 'U', 1. )
+           CALL lbc_lnk( zwdlmtv, 'V', 1. )
+
+           IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain
+
+           IF(jflag == 0) EXIT
+          
+        END DO  ! jk1 loop
+       
+        DO jk = 1, jpkm1
+          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :) 
+          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :) 
+        END DO
+
+        CALL lbc_lnk( un, 'U', -1. )
+        CALL lbc_lnk( vn, 'V', -1. )
+      !
+        un_b(:,:) = un_b(:,:) * zwdlmtu(:, :)
+        vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)
+        CALL lbc_lnk( un_b, 'U', -1. )
+        CALL lbc_lnk( vn_b, 'V', -1. )
+       
+        IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
+       
+        !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+        !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
+        !
+        !
+        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
+        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
+      !
+   END SUBROUTINE wad_lmt
+
+
+   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE wad_lmt  ***
+      !!                    
+      !! ** Purpose :   limiting flux in the barotropic stepping (dynspg_ts)
+      !!
+      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif) 
+      !!
+      !! ** Action  : - calculate flux limiter and W/D flag
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in)    ::   rdtbt    ! ocean time-step index
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc  
+      !
+      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
+      INTEGER  ::   jflag               ! local scalar
+      REAL(wp) ::   z2dt
+      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
+      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
+      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
+      REAL(wp) ::   ztmp                ! local scalars
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt')
+
+      IF(ln_wd) THEN
+
+        CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
+        CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        !
+       
+        !IF(lwp) WRITE(numout,*)
+        !IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting'
+       
+        jflag  = 0
+        zdepwd = 50._wp   !maximum depth that ocean cells can have W/D processes
+
+        z2dt = rdtbt   
+       
+        zflxp(:,:)   = 0._wp
+        zflxn(:,:)   = 0._wp
+
+        zwdlmtu(:,:)  = 1._wp
+        zwdlmtv(:,:)  = 1._wp
+       
+        ! Horizontal Flux in u and v direction
+       
+        DO jj = 2, jpj
+           DO ji = 2, jpi 
+
+             IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
+             IF( ht_wd(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
+
+              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + &
+                           & max(zflxv(ji,jj), 0._wp) - min(zflxv(ji,  jj-1), 0._wp) 
+              zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj),   0._wp) + &
+                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp) 
+
+              zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
+              IF(zdep2 .le. 0._wp) THEN  !add more safety, but not necessary
+                sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
+                IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
+                IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
+                IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
+                IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
+              END IF
+           ENDDO
+        END DO
+
+      
+        !! start limiter iterations 
+        DO jk1 = 1, nn_wdit + 1
+       
+          
+           zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
+           zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
+           jflag = 0     ! flag indicating if any further iterations are needed
+          
+           DO jj = 2, jpj
+              DO ji = 2, jpi 
+        
+                 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE 
+                 IF( ht_wd(ji,jj) > zdepwd )      CYCLE
+        
+                 ztmp = e1e2t(ji,jj)
+
+                 zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp) + &
+                        & max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
+                 zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp) + &
+                        & min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
+          
+                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
+                 zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
+          
+                 IF(zdep1 > zdep2) THEN
+                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
+                   !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
+                   ! flag if the limiter has been used but stop flagging if the only
+                   ! changes have zeroed the coefficient since further iterations will
+                   ! not change anything
+                   IF( zcoef > 0._wp ) THEN
+                      jflag = 1 
+                   ELSE
+                      zcoef = 0._wp
+                   ENDIF
+                   IF(jk1 > nn_wdit) zcoef = 0._wp
+                   IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
+                   IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
+                   IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
+                   IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
+                 END IF
+              END DO ! ji loop
+           END DO  ! jj loop
+
+           CALL lbc_lnk( zwdlmtu, 'U', 1. )
+           CALL lbc_lnk( zwdlmtv, 'V', 1. )
+
+           IF(lk_mpp) CALL mpp_max(jflag)   !max over the global domain
+
+           IF(jflag == 0) EXIT
+          
+        END DO  ! jk1 loop
+       
+        zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :) 
+        zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :) 
+
+        CALL lbc_lnk( zflxu, 'U', -1. )
+        CALL lbc_lnk( zflxv, 'V', -1. )
+       
+        IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
+       
+        !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+        !IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
+        !
+        !
+        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
+        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
+        !
+      END IF
+
+      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt')
+   END SUBROUTINE wad_lmt_bt
+
+   !!==============================================================================
+END MODULE wet_dry
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 8732)
@@ -0,0 +1,467 @@
+MODULE flo4rk
+   !!======================================================================
+   !!                    ***  MODULE  flo4rk  ***
+   !! Ocean floats :   trajectory computation using a 4th order Runge-Kutta
+   !!======================================================================
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!   flo_4rk        : Compute the geographical position of floats
+   !!   flo_interp     : interpolation
+   !!----------------------------------------------------------------------
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE wrk_nemo        ! working array
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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  /)           !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE flo_4rk( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_4rk  ***
+      !!
+      !!  ** Purpose :   Compute the geographical position (lat,lon,depth)
+      !!       of each float at each time step.
+      !! 
+      !!  ** Method  :   The position of a float is computed with a 4th order
+      !!       Runge-Kutta scheme and and Lagrange interpolation.
+      !!         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
+      !!
+      INTEGER ::  jfl, jind           ! dummy loop indices
+      INTEGER ::  ierror              ! error value
+
+      REAL(wp), POINTER, DIMENSION(:)   ::   zgifl , zgjfl , zgkfl    ! index RK  positions
+      REAL(wp), POINTER, DIMENSION(:)   ::   zufl  , zvfl  , zwfl     ! interpolated velocity at the float position 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zrkxfl, zrkyfl, zrkzfl   ! RK coefficients
+      !!---------------------------------------------------------------------
+      CALL wrk_alloc( jpnfl,    zgifl , zgjfl , zgkfl  , zufl, zvfl, zwfl)
+      CALL wrk_alloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl )
+      !
+      IF( ierror /= 0 ) THEN
+         WRITE(numout,*) 'flo_4rk: allocation of workspace arrays failed'
+      ENDIF
+
+    
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flo_4rk : compute Runge Kutta trajectories for floats '
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Verification of the floats positions. If one of them leave the domain
+      ! domain we replace the float near the border.
+      DO jfl = 1, jpnfl
+         ! i-direction
+         IF( tpifl(jfl) <= 1.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the WEST border.'
+            tpifl(jfl) = tpifl(jfl) + 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at i=',tpifl(jfl)
+         ENDIF
+          
+         IF( tpifl(jfl) >= jpi-.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the EAST border.'
+            tpifl(jfl) = tpifl(jfl) - 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at i=', tpifl(jfl)
+         ENDIF
+         ! j-direction
+         IF( tpjfl(jfl) <= 1.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the SOUTH border.'
+            tpjfl(jfl) = tpjfl(jfl) + 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at j=', tpjfl(jfl)
+         ENDIF
+           
+         IF( tpjfl(jfl) >= jpj-.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the NORTH border.'
+            tpjfl(jfl) = tpjfl(jfl) - 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at j=', tpjfl(jfl)
+         ENDIF
+         ! k-direction
+         IF( tpkfl(jfl) <= .5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the TOP border.'
+            tpkfl(jfl) = tpkfl(jfl) + 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at k=', tpkfl(jfl)
+         ENDIF
+         
+         IF( tpkfl(jfl) >= jpk-.5 )  THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the BOTTOM border.'
+            tpkfl(jfl) = tpkfl(jfl) - 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at k=', tpkfl(jfl)
+         ENDIF
+      END DO
+      
+      ! 4 steps of Runge-Kutta algorithme
+      ! initialisation of the positions 
+      
+      DO jfl = 1, jpnfl
+         zgifl(jfl) = tpifl(jfl)
+         zgjfl(jfl) = tpjfl(jfl)
+         zgkfl(jfl) = tpkfl(jfl)
+      END DO
+       
+      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 )
+         
+         ! computation of Runge-Kutta factor
+         DO jfl = 1, jpnfl
+            zrkxfl(jfl,jind) = rdt*zufl(jfl)
+            zrkyfl(jfl,jind) = rdt*zvfl(jfl)
+            zrkzfl(jfl,jind) = rdt*zwfl(jfl)
+         END DO
+         IF( jind /= 4 ) THEN
+            DO jfl = 1, jpnfl
+               zgifl(jfl) = (tpifl(jfl)) + scoef1(jind)*zrkxfl(jfl,jind)
+               zgjfl(jfl) = (tpjfl(jfl)) + scoef1(jind)*zrkyfl(jfl,jind)
+               zgkfl(jfl) = (tpkfl(jfl)) + scoef1(jind)*zrkzfl(jfl,jind)
+            END DO
+         ENDIF
+      END DO
+      DO jind = 1, 4
+         DO jfl = 1, jpnfl
+            tpifl(jfl) = tpifl(jfl) + scoef2(jind)*zrkxfl(jfl,jind)/6.
+            tpjfl(jfl) = tpjfl(jfl) + scoef2(jind)*zrkyfl(jfl,jind)/6.
+            tpkfl(jfl) = tpkfl(jfl) + scoef2(jind)*zrkzfl(jfl,jind)/6.
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpnfl,    zgifl , zgjfl , zgkfl  , zufl, zvfl, zwfl)
+      CALL wrk_dealloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl )
+      !
+   END SUBROUTINE flo_4rk
+
+
+   SUBROUTINE flo_interp( pxt , pyt , pzt ,      &
+      &                   pufl, pvfl, pwfl, ki )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE flointerp  ***
+      !!
+      !! ** Purpose :   Interpolation of the velocity on the float position
+      !! 
+      !! ** Method  :   Lagrange interpolation with the 64 neighboring
+      !!      points. This routine is call 4 time at each time step to
+      !!      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                 !
+      !!
+      INTEGER  ::   jfl, jind1, jind2, jind3   ! dummy loop indices
+      REAL(wp) ::   zsumu, zsumv, zsumw        ! local scalar
+      INTEGER  , POINTER, DIMENSION(:)       ::   iilu, ijlu, iklu   ! nearest neighbour INDEX-u
+      INTEGER  , POINTER, DIMENSION(:)       ::   iilv, ijlv, iklv   ! nearest neighbour INDEX-v
+      INTEGER  , POINTER, DIMENSION(:)       ::   iilw, ijlw, iklw   ! nearest neighbour INDEX-w
+      INTEGER  , POINTER, DIMENSION(:,:)     ::   iidu, ijdu, ikdu   ! 64 nearest neighbour INDEX-u
+      INTEGER  , POINTER, DIMENSION(:,:)     ::   iidv, ijdv, ikdv   ! 64 nearest neighbour INDEX-v
+      INTEGER  , POINTER, DIMENSION(:,:)     ::   iidw, ijdw, ikdw   ! 64 nearest neighbour INDEX-w
+      REAL(wp) , POINTER, DIMENSION(:,:)     ::   zlagxu, zlagyu, zlagzu   ! Lagrange  coefficients
+      REAL(wp) , POINTER, DIMENSION(:,:)     ::   zlagxv, zlagyv, zlagzv   !    -           -
+      REAL(wp) , POINTER, DIMENSION(:,:)     ::   zlagxw, zlagyw, zlagzw   !    -           -
+      REAL(wp) , POINTER, DIMENSION(:,:,:,:) ::   ztufl , ztvfl , ztwfl   ! velocity at choosen time step
+      !!---------------------------------------------------------------------
+      CALL wrk_alloc( jpnfl,    iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw )
+      CALL wrk_alloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw )
+      CALL wrk_alloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw )
+      CALL wrk_alloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl )
+ 
+      ! Interpolation of U velocity
+
+      ! nearest neightboring point for computation of u       
+      DO jfl = 1, jpnfl
+         iilu(jfl) = INT(pxt(jfl)-.5)
+         ijlu(jfl) = INT(pyt(jfl)-.5)
+         iklu(jfl) = INT(pzt(jfl))
+      END DO
+      
+      !  64 neightboring points for computation of u 
+      DO jind1 = 1, 4
+         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
+               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
+               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
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      
+      ! Lagrange coefficients
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            zlagxu(jfl,jind1) = 1.
+            zlagyu(jfl,jind1) = 1.
+            zlagzu(jfl,jind1) = 1.
+         END DO
+      END DO
+      DO jind1 = 1, 4
+         DO jind2 = 1, 4
+            DO jfl= 1, jpnfl
+               IF( jind1 /= jind2 ) THEN
+                  zlagxu(jfl,jind1) = zlagxu(jfl,jind1) * ( pxt(jfl)-(float(iidu(jfl,jind2))+.5) )
+                  zlagyu(jfl,jind1) = zlagyu(jfl,jind1) * ( pyt(jfl)-(float(ijdu(jfl,jind2))) )
+                  zlagzu(jfl,jind1) = zlagzu(jfl,jind1) * ( pzt(jfl)-(float(ikdu(jfl,jind2))) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! velocity when we compute at middle time step
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  ztufl(jfl,jind1,jind2,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
+            END DO
+         END DO
+         
+         zsumu = 0.
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  zsumu = zsumu + ztufl(jfl,jind1,jind2,jind3) * zlagxu(jfl,jind1) * zlagyu(jfl,jind2)   &
+                     &  * zlagzu(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3) 
+               END DO
+            END DO
+         END DO
+         pufl(jfl) = zsumu
+      END DO
+      
+      ! Interpolation of V velocity 
+
+      ! nearest neightboring point for computation of v 
+      DO jfl = 1, jpnfl
+         iilv(jfl) = INT(pxt(jfl)-.5)
+         ijlv(jfl) = INT(pyt(jfl)-.5)
+         iklv(jfl) = INT(pzt(jfl))
+      END DO
+      
+      ! 64 neightboring points for computation of v 
+      DO jind1 = 1, 4
+         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
+               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
+               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
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      
+      ! Lagrange coefficients
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            zlagxv(jfl,jind1) = 1.
+            zlagyv(jfl,jind1) = 1.
+            zlagzv(jfl,jind1) = 1.
+         END DO
+      END DO
+      
+      DO jind1 = 1, 4
+         DO jind2 = 1, 4
+            DO jfl = 1, jpnfl
+               IF( jind1 /= jind2 ) THEN
+                  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))   ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! velocity when we compute at middle time step
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1 ,4
+                  ztvfl(jfl,jind1,jind2,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
+            END DO
+         END DO
+         
+         zsumv=0.
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  zsumv = zsumv + ztvfl(jfl,jind1,jind2,jind3) * zlagxv(jfl,jind1) * zlagyv(jfl,jind2)   &
+                     &  * zlagzv(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
+               END DO
+            END DO
+         END DO
+         pvfl(jfl) = zsumv
+      END DO
+      
+      ! Interpolation of W velocity
+
+      ! 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)
+      END DO
+      
+      ! 64 neightboring points for computation of w 
+      DO jind1 = 1, 4
+         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
+               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
+               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
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      
+      ! Lagrange coefficients  for w interpolation
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            zlagxw(jfl,jind1) = 1.
+            zlagyw(jfl,jind1) = 1.
+            zlagzw(jfl,jind1) = 1.
+         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))   ) )
+                  zlagzw(jfl,jind1) = zlagzw(jfl,jind1) * (pzt(jfl) - (float(ikdw(jfl,jind2))-.5) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! velocity w  when we compute at middle time step
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  ztwfl(jfl,jind1,jind2,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)) )  &
+                     &   / e3w_n(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))
+               END DO
+            END DO
+         END DO
+         
+         zsumw = 0.e0
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  zsumw = zsumw + ztwfl(jfl,jind1,jind2,jind3) * zlagxw(jfl,jind1) * zlagyw(jfl,jind2)   &
+                     &  * zlagzw(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
+               END DO
+            END DO
+         END DO
+         pwfl(jfl) = zsumw
+      END DO
+      !   
+      CALL wrk_dealloc( jpnfl,    iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw )
+      CALL wrk_dealloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw )
+      CALL wrk_dealloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw )
+      CALL wrk_dealloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl )
+      !   
+   END SUBROUTINE flo_interp
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   No floats                                              Dummy module
+   !!----------------------------------------------------------------------
+#endif
+   
+   !!======================================================================
+END MODULE flo4rk
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 8732)
@@ -0,0 +1,78 @@
+MODULE flo_oce
+   !!======================================================================
+   !!                     ***  MODULE flo_oce  ***
+   !! lagrangian floats :   define in memory all floats parameters and variables
+   !!======================================================================
+   !! History :   OPA  ! 1999-10  (CLIPPER projet)
+   !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                        drifting floats
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   flo_oce_alloc   ! Routine called in floats.F90
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    !: float flag
+
+   !! float parameters
+   !! ----------------
+   INTEGER, PUBLIC ::   jpnfl       !: total number of floats during the run
+   INTEGER, PUBLIC ::   jpnnewflo   !: number of floats added in a new run
+   INTEGER, PUBLIC ::   jpnrstflo   !: number of floats for the restart
+
+   !! float variables
+   !! ---------------
+   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   nisobfl   !: =0 for a isobar float , =1 for a float following the w velocity
+   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ngrpfl    !: number to identify searcher group
+   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   nfloat    !: number to identify searcher group
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   flxx , flyy , flzz    !: long, lat, depth of float (decimal degree, m >0)
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wb   !: vertical velocity at previous time step (m s-1).
+   
+   !                                   !! * namelist namflo : langrangian floats *
+   LOGICAL, PUBLIC  ::   ln_rstflo      !: T/F float restart 
+   LOGICAL, PUBLIC  ::   ln_argo        !: T/F argo type floats
+   LOGICAL, PUBLIC  ::   ln_flork4      !: T/F 4th order Runge-Kutta
+   LOGICAL, PUBLIC  ::   ln_ariane      !: handle ariane input/output convention
+   LOGICAL, PUBLIC  ::   ln_flo_ascii   !: write in ascii (T) or in Netcdf (F)
+
+   INTEGER, PUBLIC  ::   nn_writefl     !: frequency of float output file 
+   INTEGER, PUBLIC  ::   nn_stockfl     !: frequency of float restart file
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION flo_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION flo_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( wb(jpi,jpj,jpk) , nfloat(jpnfl) , nisobfl(jpnfl) , ngrpfl(jpnfl) , &
+                flxx(jpnfl)     , flyy(jpnfl)   , flzz(jpnfl)    ,                 & 
+                tpifl(jpnfl)    , tpjfl(jpnfl)  , tpkfl(jpnfl)   , STAT=flo_oce_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( flo_oce_alloc )
+      IF( flo_oce_alloc /= 0 )   CALL ctl_warn('flo_oce_alloc: failed to allocate arrays')
+   END FUNCTION flo_oce_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                 NO drifting floats
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .FALSE.   !: float flag
+#endif
+
+   !!======================================================================
+END MODULE flo_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 8732)
@@ -0,0 +1,155 @@
+MODULE floats
+   !!======================================================================
+   !!                       ***  MODULE  floats  ***
+   !! Ocean floats : floats
+   !!======================================================================
+   !! History :  OPA  !          (CLIPPER)   original Code
+   !!   NEMO     1.0  ! 2002-06  (A. Bozec)  F90, Free form and module
+   !!----------------------------------------------------------------------
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!   flo_stp   : float trajectories computation
+   !!   flo_init  : initialization of float trajectories computation
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean variables
+   USE flo_oce         ! floats variables
+   USE lib_mpp         ! distributed memory computing
+   USE flodom          ! initialisation Module 
+   USE flowri          ! float output                     (flo_wri routine)
+   USE florst          ! float restart                    (flo_rst routine)
+   USE flo4rk          ! Trajectories, Runge Kutta scheme (flo_4rk routine)
+   USE floblk          ! Trajectories, Blanke scheme      (flo_blk routine)
+   USE in_out_manager  ! I/O manager
+   USE timing          ! preformance summary
+
+   IMPLICIT NONE
+   PRIVATE  
+
+   PUBLIC   flo_stp    ! routine called by step.F90
+   PUBLIC   flo_init   ! routine called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE flo_stp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE flo_stp  ***
+      !!                    
+      !! ** Purpose :   Compute the geographical position (lat., long., depth)
+      !!      of each float at each time step with one of the algorithm.
+      !! 
+      !! ** Method  :   The position of a float is computed with Bruno Blanke 
+      !!        algorithm by default and with a 4th order Runge-Kutta scheme
+      !!        if ln_flork4 =T
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('flo_stp')
+      !
+      IF( ln_flork4 ) THEN   ;   CALL flo_4rk( kt )        ! Trajectories using a 4th order Runge Kutta scheme
+      ELSE                   ;   CALL flo_blk( kt )        ! Trajectories using Blanke' algorithme
+      ENDIF
+      !
+      IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor
+      !
+      CALL flo_wri( kt )      ! trajectories ouput 
+      !
+      CALL flo_rst( kt )      ! trajectories restart
+      !
+      wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('flo_stp')
+      !
+   END SUBROUTINE flo_stp
+
+
+   SUBROUTINE flo_init
+      !!----------------------------------------------------------------
+      !!                 ***  ROUTINE flo_init  ***
+      !!                   
+      !! ** Purpose :   Read the namelist of floats
+      !!----------------------------------------------------------------------
+      INTEGER :: jfl
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !
+      NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('flo_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'flo_stp : call floats routine '
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      REWIND( numnam_ref )              ! Namelist namflo in reference namelist : Floats
+      READ  ( numnam_ref, namflo, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namflo in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namflo in configuration namelist : Floats
+      READ  ( numnam_cfg, namflo, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namflo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namflo )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '         Namelist floats :'
+         WRITE(numout,*) '            number of floats                      jpnfl        = ', jpnfl
+         WRITE(numout,*) '            number of new floats                  jpnflnewflo  = ', jpnnewflo
+         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,*) '            Use of ariane convention              ln_ariane    = ', ln_ariane
+         WRITE(numout,*) '            ascii output (T) or netcdf output (F) ln_flo_ascii = ', ln_flo_ascii
+
+      ENDIF
+      !
+      !                             ! allocate floats arrays
+      IF( flo_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_init : unable to allocate arrays' )
+      !
+      !                             ! allocate flodom arrays
+      IF( flo_dom_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_dom : unable to allocate arrays' )
+      !
+      !                             ! allocate flowri arrays
+      IF( flo_wri_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' )
+      !
+      !                             ! allocate florst arrays
+      IF( flo_rst_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'flo_rst : unable to allocate arrays' )
+      !
+      !memory allocation 
+      jpnrstflo = jpnfl-jpnnewflo
+
+      !vertical axe for netcdf IOM ouput
+      DO jfl=1,jpnfl ; nfloat(jfl)=jfl ; ENDDO
+
+      !
+      CALL flo_dom                  ! compute/read initial position of floats
+
+      wb(:,:,:) = wn(:,:,:)         ! set wb for computation of floats trajectories at the first time step
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('flo_init')
+      !
+   END SUBROUTINE flo_init
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_stp( kt )          ! Empty routine
+      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
+
+   !!======================================================================
+ END MODULE floats
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 8732)
@@ -0,0 +1,390 @@
+MODULE floblk
+   !!======================================================================
+   !!                     ***  MODULE  floblk  ***
+   !! Ocean floats :   trajectory computation
+   !!======================================================================
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!    flotblk     : compute float trajectories with Blanke algorithme
+   !!----------------------------------------------------------------------
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE wrk_nemo        ! working array
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   flo_blk    ! routine called by floats.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE flo_blk( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_blk  ***
+      !!           
+      !! ** Purpose :   Compute the geographical position,latitude, longitude
+      !!      and depth of each float at each time step.
+      !! 
+      !! ** Method  :   The position of a float is computed with Bruno Blanke
+      !!      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
+      !!
+      INTEGER :: jfl              ! dummy loop arguments
+      INTEGER :: ind, ifin, iloop
+      REAL(wp)   ::       &
+         zuinfl,zvinfl,zwinfl,      &     ! transport across the input face
+         zuoutfl,zvoutfl,zwoutfl,   &     ! transport across the ouput face
+         zvol,                      &     ! volume of the mesh
+         zsurfz,                    &     ! surface of the face of the mesh 
+         zind
+
+      REAL(wp), DIMENSION ( 2 )  ::   zsurfx, zsurfy   ! surface of the face of the mesh
+
+      INTEGER  , POINTER, DIMENSION ( : )  ::   iil, ijl, ikl                   ! index of nearest mesh
+      INTEGER  , POINTER, DIMENSION ( : )  ::   iiloc , ijloc              
+      INTEGER  , POINTER, DIMENSION ( : )  ::   iiinfl, ijinfl, ikinfl          ! index of input mesh of the float.
+      INTEGER  , POINTER, DIMENSION ( : )  ::   iioutfl, ijoutfl, ikoutfl       ! index of output mesh of the float.
+      REAL(wp) , POINTER, DIMENSION ( : )  ::   zgifl, zgjfl, zgkfl             ! position of floats, index on 
+      !                                                                         ! velocity mesh.
+      REAL(wp) , POINTER, DIMENSION ( : )  ::    ztxfl, ztyfl, ztzfl            ! time for a float to quit the mesh
+      !                                                                         ! across one of the face x,y and z 
+      REAL(wp) , POINTER, DIMENSION ( : )  ::    zttfl                          ! time for a float to quit the mesh 
+      REAL(wp) , POINTER, DIMENSION ( : )  ::    zagefl                         ! time during which, trajectorie of 
+      !                                                                         ! the float has been computed
+      REAL(wp) , POINTER, DIMENSION ( : )  ::   zagenewfl                       ! new age of float after calculation 
+      !                                                                         ! of new position
+      REAL(wp) , POINTER, DIMENSION ( : )  ::   zufl, zvfl, zwfl                ! interpolated vel. at float position
+      REAL(wp) , POINTER, DIMENSION ( : )  ::   zudfl, zvdfl, zwdfl             ! velocity diff input/output of mesh
+      REAL(wp) , POINTER, DIMENSION ( : )  ::   zgidfl, zgjdfl, zgkdfl          ! direction index of float
+      !!---------------------------------------------------------------------
+      CALL wrk_alloc( jpnfl , iil   , ijl   , ikl   , iiloc  ,  ijloc           )
+      CALL wrk_alloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl )
+      CALL wrk_alloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl  , ztyfl  , ztzfl   , zttfl , zagefl, zagenewfl) 
+      CALL wrk_alloc( jpnfl , zufl  , zvfl  , zwfl  , zudfl  , zvdfl  , zwdfl   , zgidfl, zgjdfl, zgkdfl   )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flo_blk : compute Blanke trajectories for floats '
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! Initialisation of parameters
+      
+      DO jfl = 1, jpnfl
+         ! ages of floats are put at zero
+         zagefl(jfl) = 0.
+         ! index on the velocity grid 
+         ! We considere k coordinate negative, with this transformation 
+         ! the computation in the 3 direction is the same. 
+         zgifl(jfl) = tpifl(jfl) - 0.5
+         zgjfl(jfl) = tpjfl(jfl) - 0.5
+         zgkfl(jfl) = MIN(-1.,-(tpkfl(jfl)))
+         ! surface drift every 10 days 
+         IF( ln_argo ) THEN
+            IF( MOD(kt,150) >= 146 .OR. MOD(kt,150) == 0 )  zgkfl(jfl) = -1.
+         ENDIF
+         ! index of T mesh
+         iil(jfl) = 1 + INT(zgifl(jfl))
+         ijl(jfl) = 1 + INT(zgjfl(jfl))
+         ikl(jfl) =     INT(zgkfl(jfl))
+      END DO
+       
+      iloop = 0
+222   DO jfl = 1, jpnfl
+# if   defined key_mpp_mpi
+         IF( iil(jfl) >= mig(nldi) .AND. iil(jfl) <= mig(nlei) .AND.   &
+             ijl(jfl) >= mjg(nldj) .AND. ijl(jfl) <= mjg(nlej)   ) THEN
+            iiloc(jfl) = iil(jfl) - mig(1) + 1
+            ijloc(jfl) = ijl(jfl) - mjg(1) + 1
+# else 
+            iiloc(jfl) = iil(jfl)
+            ijloc(jfl) = ijl(jfl)
+# endif
+            
+            ! compute the transport across the mesh where the float is.            
+!!bug (gm) change e3t into e3. but never checked 
+            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3u_n(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl))
+            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3u_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3v_n(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl))
+            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3v_n(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+
+            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
+            zsurfz =          e1e2t(iiloc(jfl),ijloc(jfl))
+            zvol   = zsurfz * e3t_n(iiloc(jfl),ijloc(jfl),-ikl(jfl))
+
+            !
+            zuinfl =( ub(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(1)
+            zuoutfl=( ub(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(2)
+            zvinfl =( vb(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) )/2.*zsurfy(1)
+            zvoutfl=( vb(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) )/2.*zsurfy(2)
+            zwinfl =-(wb(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1))    &
+               &   +  wn(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1)) )/2. *  zsurfz*nisobfl(jfl)
+            zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl)   )   &
+               &   +  wn(iiloc(jfl),ijloc(jfl),- ikl(jfl)   ) )/2. *  zsurfz*nisobfl(jfl)
+            
+            ! interpolation of velocity field on the float initial position            
+            zufl(jfl)=  zuinfl  + ( zgifl(jfl) - float(iil(jfl)-1) ) * ( zuoutfl - zuinfl)
+            zvfl(jfl)=  zvinfl  + ( zgjfl(jfl) - float(ijl(jfl)-1) ) * ( zvoutfl - zvinfl)
+            zwfl(jfl)=  zwinfl  + ( zgkfl(jfl) - float(ikl(jfl)-1) ) * ( zwoutfl - zwinfl)
+            
+            ! faces of input and output
+            ! u-direction
+            IF( zufl(jfl) < 0. ) THEN
+               iioutfl(jfl) = iil(jfl) - 1.
+               iiinfl (jfl) = iil(jfl)
+               zind   = zuinfl
+               zuinfl = zuoutfl
+               zuoutfl= zind
+            ELSE
+               iioutfl(jfl) = iil(jfl)
+               iiinfl (jfl) = iil(jfl) - 1
+            ENDIF
+            ! v-direction       
+            IF( zvfl(jfl) < 0. ) THEN
+               ijoutfl(jfl) = ijl(jfl) - 1.
+               ijinfl (jfl) = ijl(jfl)
+               zind    = zvinfl
+               zvinfl  = zvoutfl
+               zvoutfl = zind
+            ELSE
+               ijoutfl(jfl) = ijl(jfl)
+               ijinfl (jfl) = ijl(jfl) - 1.
+            ENDIF
+            ! w-direction
+            IF( zwfl(jfl) < 0. ) THEN
+               ikoutfl(jfl) = ikl(jfl) - 1.
+               ikinfl (jfl) = ikl(jfl)
+               zind    = zwinfl
+               zwinfl  = zwoutfl
+               zwoutfl = zind
+            ELSE
+               ikoutfl(jfl) = ikl(jfl)
+               ikinfl (jfl) = ikl(jfl) - 1.
+            ENDIF
+            
+            ! compute the time to go out the mesh across a face
+            ! u-direction
+            zudfl (jfl) = zuoutfl - zuinfl
+            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl))
+            IF( zufl(jfl)*zuoutfl <= 0. ) THEN
+               ztxfl(jfl) = 1.E99
+            ELSE
+               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN
+                  ztxfl(jfl)= zgidfl(jfl)/zudfl(jfl) * LOG(zuoutfl/zufl (jfl))
+               ELSE
+                  ztxfl(jfl)=(float(iioutfl(jfl))-zgifl(jfl))/zufl(jfl)
+               ENDIF
+               IF( (ABS(zgifl(jfl)-float(iiinfl (jfl))) <=  1.E-7) .OR.   &
+                   (ABS(zgifl(jfl)-float(iioutfl(jfl))) <=  1.E-7) ) THEN
+                  ztxfl(jfl)=(zgidfl(jfl))/zufl(jfl)
+               ENDIF
+            ENDIF
+            ! v-direction
+            zvdfl (jfl) = zvoutfl - zvinfl
+            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl))
+            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN
+               ztyfl(jfl) = 1.E99
+            ELSE
+               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN
+                  ztyfl(jfl) = zgjdfl(jfl)/zvdfl(jfl) * LOG(zvoutfl/zvfl (jfl))
+               ELSE
+                  ztyfl(jfl) = (float(ijoutfl(jfl)) - zgjfl(jfl))/zvfl(jfl)
+               ENDIF
+               IF( (ABS(zgjfl(jfl)-float(ijinfl (jfl))) <= 1.E-7) .OR.   &
+                   (ABS(zgjfl(jfl)-float(ijoutfl(jfl))) <=  1.E-7) ) THEN
+                  ztyfl(jfl) = (zgjdfl(jfl)) / zvfl(jfl)
+               ENDIF
+            ENDIF
+            ! w-direction        
+            IF( nisobfl(jfl) == 1. ) THEN 
+               zwdfl (jfl) = zwoutfl - zwinfl
+               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl))
+               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN
+                  ztzfl(jfl) = 1.E99
+               ELSE
+                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN
+                     ztzfl(jfl) = zgkdfl(jfl)/zwdfl(jfl) * LOG(zwoutfl/zwfl (jfl))
+                  ELSE
+                     ztzfl(jfl) = (float(ikoutfl(jfl)) - zgkfl(jfl))/zwfl(jfl)
+                  ENDIF
+                  IF( (ABS(zgkfl(jfl)-float(ikinfl (jfl))) <=  1.E-7) .OR.   &
+                      (ABS(zgkfl(jfl)-float(ikoutfl(jfl))) <= 1.E-7) ) THEN
+                     ztzfl(jfl) = (zgkdfl(jfl)) / zwfl(jfl)
+                  ENDIF
+               ENDIF
+            ENDIF
+            
+            ! the time to go leave the mesh is the smallest time
+                   
+            IF( nisobfl(jfl) == 1. ) THEN 
+               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl),ztzfl(jfl))
+            ELSE
+               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl))
+            ENDIF
+            ! new age of the FLOAT
+            zagenewfl(jfl) = zagefl(jfl) + zttfl(jfl)*zvol
+            ! test to know if the "age" of the float is not bigger than the 
+            ! time step
+            IF( zagenewfl(jfl) > rdt ) THEN
+               zttfl(jfl) = (rdt-zagefl(jfl)) / zvol
+               zagenewfl(jfl) = rdt
+            ENDIF
+            
+            ! In the "minimal" direction we compute the index of new mesh
+            ! on i-direction
+            IF( ztxfl(jfl) <=  zttfl(jfl) ) THEN
+               zgifl(jfl) = float(iioutfl(jfl))
+               ind = iioutfl(jfl)
+               IF( iioutfl(jfl) >= iiinfl(jfl) ) THEN
+                  iioutfl(jfl) = iioutfl(jfl) + 1
+               ELSE
+                  iioutfl(jfl) = iioutfl(jfl) - 1
+               ENDIF
+               iiinfl(jfl) = ind
+            ELSE
+               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
+                  zgifl(jfl) = zgifl(jfl) + zgidfl(jfl)*zufl(jfl)    &
+                     &       * ( EXP( zudfl(jfl)/zgidfl(jfl)*zttfl(jfl) ) - 1. ) /  zudfl(jfl)
+               ELSE
+                  zgifl(jfl) = zgifl(jfl) + zufl(jfl) * zttfl(jfl)
+               ENDIF
+            ENDIF
+            ! on j-direction
+            IF( ztyfl(jfl) <= zttfl(jfl) ) THEN
+               zgjfl(jfl) = float(ijoutfl(jfl))
+               ind = ijoutfl(jfl)
+               IF( ijoutfl(jfl) >= ijinfl(jfl) ) THEN
+                  ijoutfl(jfl) = ijoutfl(jfl) + 1
+               ELSE
+                  ijoutfl(jfl) = ijoutfl(jfl) - 1
+               ENDIF
+               ijinfl(jfl) = ind
+            ELSE
+               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
+                  zgjfl(jfl) = zgjfl(jfl)+zgjdfl(jfl)*zvfl(jfl)   &
+                     &       * ( EXP(zvdfl(jfl)/zgjdfl(jfl)*zttfl(jfl)) - 1. ) /  zvdfl(jfl)
+               ELSE
+                  zgjfl(jfl) = zgjfl(jfl)+zvfl(jfl)*zttfl(jfl)
+               ENDIF
+            ENDIF
+            ! on k-direction
+            IF( nisobfl(jfl) == 1. ) THEN
+               IF( ztzfl(jfl) <= zttfl(jfl) ) THEN
+                  zgkfl(jfl) = float(ikoutfl(jfl))
+                  ind = ikoutfl(jfl)
+                  IF( ikoutfl(jfl) >= ikinfl(jfl) ) THEN
+                     ikoutfl(jfl) = ikoutfl(jfl)+1
+                  ELSE
+                     ikoutfl(jfl) = ikoutfl(jfl)-1
+                  ENDIF
+                  ikinfl(jfl) = ind
+               ELSE
+                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 
+                     zgkfl(jfl) = zgkfl(jfl)+zgkdfl(jfl)*zwfl(jfl)    &
+                        &       * ( EXP(zwdfl(jfl)/zgkdfl(jfl)*zttfl(jfl)) - 1. ) /  zwdfl(jfl)
+                  ELSE
+                     zgkfl(jfl) = zgkfl(jfl)+zwfl(jfl)*zttfl(jfl)
+                  ENDIF
+               ENDIF
+            ENDIF
+            
+            ! coordinate of the new point on the temperature grid
+            
+            iil(jfl) = MAX(iiinfl(jfl),iioutfl(jfl))
+            ijl(jfl) = MAX(ijinfl(jfl),ijoutfl(jfl))
+            IF( nisobfl(jfl) ==  1 ) ikl(jfl) = MAX(ikinfl(jfl),ikoutfl(jfl))
+!!Alexcadm	 write(*,*)'PE ',narea,
+!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl)
+!!Alexcadm     .		,ijoutfl(jfl),ikinfl(jfl),
+!!Alexcadm     .	  ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl)
+!!Alexcadm     .		,ztzfl(jfl),zgifl(jfl),
+!!Alexcadm     .  zgjfl(jfl) 
+!!Alexcadm	IF (jfl == 910) write(*,*)'Flotteur 910',
+!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl)
+!!Alexcadm     .		,ijoutfl(jfl),ikinfl(jfl),
+!!Alexcadm     .	  ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl)
+!!Alexcadm     .		,ztzfl(jfl),zgifl(jfl),
+!!Alexcadm     .  zgjfl(jfl) 
+            ! reinitialisation of the age of FLOAT
+            zagefl(jfl) = zagenewfl(jfl)
+# if   defined key_mpp_mpi
+         ELSE
+            ! we put zgifl, zgjfl, zgkfl, zagefl
+            zgifl (jfl) = 0.
+            zgjfl (jfl) = 0.
+            zgkfl (jfl) = 0.
+            zagefl(jfl) = 0.
+            iil(jfl) = 0
+            ijl(jfl) = 0
+         ENDIF
+# endif
+      END DO
+      
+      ! synchronisation
+      IF( lk_mpp )   CALL mpp_sum( zgifl , jpnfl )   ! sums over the global domain
+      IF( lk_mpp )   CALL mpp_sum( zgjfl , jpnfl )
+      IF( lk_mpp )   CALL mpp_sum( zgkfl , jpnfl )
+      IF( lk_mpp )   CALL mpp_sum( zagefl, jpnfl )
+      IF( lk_mpp )   CALL mpp_sum( iil   , jpnfl )
+      IF( lk_mpp )   CALL mpp_sum( ijl   , jpnfl )
+      
+      ! Test to know if a  float hasn't integrated enought time
+      IF( ln_argo ) THEN
+         ifin = 1
+         DO jfl = 1, jpnfl
+            IF( zagefl(jfl) < rdt )   ifin = 0
+            tpifl(jfl) = zgifl(jfl) + 0.5
+            tpjfl(jfl) = zgjfl(jfl) + 0.5
+         END DO
+      ELSE
+         ifin = 1
+         DO jfl = 1, jpnfl
+            IF( zagefl(jfl) < rdt )   ifin = 0
+            tpifl(jfl) = zgifl(jfl) + 0.5
+            tpjfl(jfl) = zgjfl(jfl) + 0.5
+            IF( nisobfl(jfl) == 1 ) tpkfl(jfl) = -(zgkfl(jfl))
+         END DO
+      ENDIF
+!!Alexcadm	IF (lwp) write(numout,*) '---------'
+!!Alexcadm	IF (lwp) write(numout,*) 'before Erika:',tpifl(880),tpjfl(880),
+!!Alexcadm     .       tpkfl(880),zufl(880),zvfl(880),zwfl(880)
+!!Alexcadm	IF (lwp) write(numout,*) 'first Erika:',tpifl(900),tpjfl(900),
+!!Alexcadm     .       tpkfl(900),zufl(900),zvfl(900),zwfl(900)
+!!Alexcadm	IF (lwp) write(numout,*) 'last Erika:',tpifl(jpnfl),tpjfl(jpnfl),
+!!Alexcadm     .       tpkfl(jpnfl),zufl(jpnfl),zvfl(jpnfl),zwfl(jpnfl)
+      IF( ifin == 0 ) THEN
+         iloop = iloop + 1 
+         GO TO 222
+      ENDIF
+      !
+      CALL wrk_dealloc( jpnfl , iil   , ijl   , ikl   , iiloc  ,  ijloc           )
+      CALL wrk_dealloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl )
+      CALL wrk_dealloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl  , ztyfl  , ztzfl   , zttfl , zagefl, zagenewfl) 
+      CALL wrk_dealloc( jpnfl , zufl  , zvfl  , zwfl  , zudfl  , zvdfl  , zwdfl   , zgidfl, zgjdfl, zgkdfl   )
+      !
+   END SUBROUTINE flo_blk
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_blk                  ! Empty routine
+   END SUBROUTINE flo_blk 
+#endif
+   
+   !!======================================================================
+END MODULE floblk 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 8732)
@@ -0,0 +1,469 @@
+MODULE flodom
+   !!======================================================================
+   !!                       ***  MODULE  flodom  ***
+   !! Ocean floats :   domain
+   !!======================================================================
+   !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code
+   !!  NEMO      3.3  ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add ARIANE convention + comsecitc changes
+   !!----------------------------------------------------------------------
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!   flo_dom               : initialization of floats
+   !!   add_new_floats        : add new floats (long/lat/depth)
+   !!   add_new_ariane_floats : add new floats with araine convention (i/j/k)
+   !!   findmesh              : compute index of position 
+   !!   dstnce                : compute distance between face mesh and floats 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE flo_oce         ! ocean drifting floats
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   flo_dom         ! routine called by floats.F90
+   PUBLIC   flo_dom_alloc   ! Routine called in floats.F90
+
+   CHARACTER (len=21) ::  clname1 = 'init_float'              ! floats initialisation filename
+   CHARACTER (len=21) ::  clname2 = 'init_float_ariane'       ! ariane floats initialisation filename
+
+
+   INTEGER , ALLOCATABLE, DIMENSION(:) ::   iimfl, ijmfl, ikmfl       ! index mesh of floats
+   INTEGER , ALLOCATABLE, DIMENSION(:) ::   idomfl, ivtest, ihtest    !   -     
+   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zgifl, zgjfl,  zgkfl      ! distances in indexes
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE flo_dom
+      !! ---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_dom  ***
+      !!                 
+      !!  ** Purpose :   Initialisation of floats
+      !!
+      !!  ** Method  :   We put the floats  in the domain with the latitude,
+      !!               the longitude (degree) and the depth (m).
+      !!----------------------------------------------------------------------      
+      INTEGER            ::   jfl    ! dummy loop  
+      INTEGER            ::   inum   ! logical unit for file read
+      !!---------------------------------------------------------------------
+      
+      ! Initialisation with the geographical position or restart
+      
+      IF(lwp) WRITE(numout,*) 'flo_dom : compute initial position of floats'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '           jpnfl = ',jpnfl
+      
+      !-------------------------!
+      ! FLOAT RESTART FILE READ !
+      !-------------------------!
+      IF( ln_rstflo )THEN
+
+         IF(lwp) WRITE(numout,*) '        float restart file read'
+         
+         ! open the restart file 
+         !----------------------
+         CALL ctl_opn( inum, 'restart_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+
+         ! read of the restart file
+         READ(inum,*)   ( tpifl  (jfl), jfl=1, jpnrstflo),   & 
+                        ( tpjfl  (jfl), jfl=1, jpnrstflo),   &
+                        ( tpkfl  (jfl), jfl=1, jpnrstflo),   &
+                        ( nisobfl(jfl), jfl=1, jpnrstflo),   &
+                        ( ngrpfl (jfl), jfl=1, jpnrstflo)    
+         CLOSE(inum)
+
+         ! if we want a  surface drift  ( like PROVOR floats )
+         IF( ln_argo ) nisobfl(1:jpnrstflo) = 0
+         
+         ! It is possible to add new floats.          
+         !---------------------------------
+         IF( jpnfl > jpnrstflo )THEN
+
+            IF(lwp) WRITE(numout,*) '        add new floats'
+
+            IF( ln_ariane )THEN  !Add new floats with ariane convention
+                CALL flo_add_new_ariane_floats(jpnrstflo+1,jpnfl) 
+            ELSE                 !Add new floats with long/lat convention
+                CALL flo_add_new_floats(jpnrstflo+1,jpnfl)
+            ENDIF
+         ENDIF
+
+      !--------------------------------------!
+      ! FLOAT INITILISATION: NO RESTART FILE !
+      !--------------------------------------!
+      ELSE    !ln_rstflo
+
+         IF( ln_ariane )THEN       !Add new floats with ariane convention
+            CALL flo_add_new_ariane_floats(1,jpnfl)
+         ELSE                      !Add new floats with long/lat convention
+            CALL flo_add_new_floats(1,jpnfl)
+         ENDIF
+
+      ENDIF
+            
+   END SUBROUTINE flo_dom
+
+   SUBROUTINE flo_add_new_floats(kfl_start, kfl_end)
+      !! -------------------------------------------------------------
+      !!                 ***  SUBROUTINE add_new_arianefloats  ***
+      !!          
+      !! ** Purpose :   
+      !!
+      !!       First initialisation of floats
+      !!       the initials positions of floats are written in a file
+      !!       with a variable to know if it is a isobar float a number 
+      !!       to identified who want the trajectories of this float and 
+      !!       an index for the number of the float         
+      !!       open the init file 
+      !!               
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kfl_start, kfl_end
+      !!
+      INTEGER           :: inum ! file unit
+      INTEGER           :: jfl,ji, jj, jk ! dummy loop indices
+      INTEGER           :: itrash         ! trash var for reading
+      INTEGER           :: ifl            ! number of floats to read
+      REAL(wp)          :: zdxab, zdyad
+      LOGICAL           :: llinmesh
+      CHARACTER(len=80) :: cltmp
+      !!---------------------------------------------------------------------
+      ifl = kfl_end-kfl_start+1
+
+      ! we get the init values 
+      !-----------------------
+      CALL ctl_opn( inum , clname1, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      DO jfl = kfl_start,kfl_end
+         READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash
+         if(lwp)write(numout,*)'read:',jfl,flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash ; call flush(numout)
+      END DO
+      CLOSE(inum)
+            
+      ! Test to find the grid point coordonate with the geographical position            
+      !----------------------------------------------------------------------
+      DO jfl = kfl_start,kfl_end
+         ihtest(jfl) = 0
+         ivtest(jfl) = 0
+         ikmfl(jfl) = 0
+# if   defined key_mpp_mpi
+         DO ji = MAX(nldi,2), nlei
+            DO jj = MAX(nldj,2), nlej   ! NO vector opt.
+# else         
+         DO ji = 2, jpi
+            DO jj = 2, jpj   ! NO vector opt.
+# endif                     
+               ! For each float we find the indexes of the mesh                      
+               CALL flo_findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   &
+                                 glamf(ji-1,jj  ),gphif(ji-1,jj  ),   &
+                                 glamf(ji  ,jj  ),gphif(ji  ,jj  ),   &
+                                 glamf(ji  ,jj-1),gphif(ji  ,jj-1),   &
+                                 flxx(jfl)       ,flyy(jfl)       ,   &
+                                 glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh)
+               IF( llinmesh )THEN
+                  iimfl(jfl) = ji
+                  ijmfl(jfl) = jj
+                  ihtest(jfl) = ihtest(jfl)+1
+                  DO jk = 1, jpk-1
+                     IF( (gdepw_n(ji,jj,jk) <= flzz(jfl)) .AND. (gdepw_n(ji,jj,jk+1) > flzz(jfl)) ) THEN
+                        ikmfl(jfl) = jk
+                        ivtest(jfl) = ivtest(jfl) + 1
+                     ENDIF
+                  END DO
+               ENDIF
+            END DO
+         END DO
+
+         ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1               
+         IF( ihtest(jfl) ==  0 ) THEN
+            iimfl(jfl) = -1
+            ijmfl(jfl) = -1
+         ENDIF
+      END DO
+
+      !Test if each float is in one and only one proc
+      !----------------------------------------------
+      IF( lk_mpp )   THEN 
+         CALL mpp_sum(ihtest,jpnfl)
+         CALL mpp_sum(ivtest,jpnfl)
+      ENDIF
+      DO jfl = kfl_start,kfl_end
+
+         IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN
+             WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH'
+             CALL ctl_stop('STOP',TRIM(cltmp) )
+         ENDIF
+         IF( (ihtest(jfl) == 0) ) THEN
+             WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS IN NO MESH'
+             CALL ctl_stop('STOP',TRIM(cltmp) )
+         ENDIF
+      END DO
+
+      ! We compute the distance between the float and the face of the mesh            
+      !-------------------------------------------------------------------
+      DO jfl = kfl_start,kfl_end
+
+         ! Made only if the float is in the domain of the processor              
+         IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN
+
+            ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST
+            idomfl(jfl) = 0
+            IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1
+
+            ! Computation of the distance between the float and the faces of the mesh
+            !            zdxab
+            !             .
+            !        B----.---------C
+            !        |    .         |
+            !        |<------>flo   |
+            !        |        ^     |
+            !        |        |.....|....zdyad
+            !        |        |     |
+            !        A--------|-----D
+            !
+            zdxab = flo_dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) )
+            zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) )
+
+            ! Translation of this distances (in meter) in indexes
+            zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-1)
+            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-1)
+            zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   &
+               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
+               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             &
+               &                 + (( flzz(jfl)-gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   &
+               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
+               &                    - gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) )
+         ELSE
+            zgifl(jfl) = 0.e0
+            zgjfl(jfl) = 0.e0
+            zgkfl(jfl) = 0.e0
+         ENDIF
+
+      END DO
+                  
+      ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats.
+      IF( lk_mpp )   THEN 
+         CALL mpp_sum( zgjfl, ifl )   ! sums over the global domain
+         CALL mpp_sum( zgkfl, ifl )
+      ENDIF
+            
+      DO jfl = kfl_start,kfl_end
+         tpifl(jfl) = zgifl(jfl)
+         tpjfl(jfl) = zgjfl(jfl)
+         tpkfl(jfl) = zgkfl(jfl)
+      END DO
+
+      ! WARNING : initial position not in the sea         
+      IF( .NOT. ln_rstflo ) THEN 
+         DO jfl =  kfl_start,kfl_end
+            IF( idomfl(jfl) == 1 ) THEN
+               IF(lwp) WRITE(numout,*)'*****************************'
+               IF(lwp) WRITE(numout,*)'!!!!!!!  WARNING   !!!!!!!!!!'
+               IF(lwp) WRITE(numout,*)'*****************************'
+               IF(lwp) WRITE(numout,*)'The float number',jfl,'is out of the sea.'
+               IF(lwp) WRITE(numout,*)'geographical position',flxx(jfl),flyy(jfl),flzz(jfl)
+               IF(lwp) WRITE(numout,*)'index position',tpifl(jfl),tpjfl(jfl),tpkfl(jfl)
+            ENDIF
+         END DO
+      ENDIF
+
+   END SUBROUTINE flo_add_new_floats
+
+   SUBROUTINE flo_add_new_ariane_floats(kfl_start, kfl_end)
+      !! -------------------------------------------------------------
+      !!                 ***  SUBROUTINE add_new_arianefloats  ***
+      !!          
+      !! ** Purpose :   
+      !!       First initialisation of floats with ariane convention
+      !!       
+      !!       The indexes are read directly from file (warning ariane
+      !!       convention, are refered to 
+      !!       U,V,W grids - and not T-) 
+      !!       The isobar advection is managed with the sign of tpkfl ( >0 -> 3D
+      !!       advection, <0 -> 2D) 
+      !!       Some variables are not read, as - gl         : time index; 4th
+      !!       column        
+      !!                                       - transport  : transport ; 5th
+      !!                                       column
+      !!       and paste in the jtrash var
+      !!       At the end, ones need to replace the indexes on T grid
+      !!       RMQ : there is no float groups identification !
+      !!
+      !!               
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kfl_start, kfl_end
+      !!
+      INTEGER  :: inum         ! file unit
+      INTEGER  :: ierr, ifl
+      INTEGER  :: jfl, jfl1    ! dummy loop indices
+      INTEGER  :: itrash       ! trash var for reading  
+      CHARACTER(len=80) :: cltmp
+
+      !!----------------------------------------------------------------------
+      nisobfl(kfl_start:kfl_end) = 1 ! we assume that by default we want 3D advection
+
+      ifl = kfl_end - kfl_start + 1  ! number of floats to read  
+
+      ! we check that the number of floats in the init_file are consistant with the namelist
+      IF( lwp ) THEN
+
+         jfl1=0
+         ierr=0
+         CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL',  1, numout, .TRUE., 1 )
+         DO WHILE (ierr .EQ. 0)
+            jfl1=jfl1+1
+            READ(inum,*, iostat=ierr)
+         END DO
+         CLOSE(inum)
+         IF( (jfl1-1) .NE. ifl )THEN 
+            WRITE(cltmp,'(A25,A20,A3,i4.4,A10,i4.4)')"the number of floats in ",TRIM(clname2), &
+                                                     " = ",jfl1," is not equal to jfl= ",ifl
+            CALL ctl_stop('STOP',TRIM(cltmp) )
+         ENDIF
+
+      ENDIF
+            
+      ! we get the init values 
+      CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 )
+      DO jfl = kfl_start, kfl_end
+          READ(inum,*) tpifl(jfl),tpjfl(jfl),tpkfl(jfl),itrash, itrash
+              
+          IF ( tpkfl(jfl) .LT. 0. ) nisobfl(jfl) = 0 !set the 2D advection according to init_float
+          ngrpfl(jfl)=jfl
+      END DO
+
+      ! conversion from ariane index to T grid index
+      tpkfl(kfl_start:kfl_end) = abs(tpkfl)-0.5 ! reversed vertical axis
+      tpifl(kfl_start:kfl_end) = tpifl+0.5
+      tpjfl(kfl_start:kfl_end) = tpjfl+0.5
+
+
+   END SUBROUTINE flo_add_new_ariane_floats
+
+
+   SUBROUTINE flo_findmesh( pax, pay, pbx, pby,   &
+                            pcx, pcy, pdx, pdy,   &
+                            px  ,py  ,ptx, pty, ldinmesh )
+      !! -------------------------------------------------------------
+      !!                ***  ROUTINE findmesh  ***
+      !!      
+      !! ** Purpose :   Find the index of mesh for the point spx spy
+      !!
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   &
+         pax, pay, pbx, pby,    &     ! ???
+         pcx, pcy, pdx, pdy,    &     ! ???
+         px, py,                &     ! longitude and latitude
+         ptx, pty                     ! ???
+      LOGICAL ::  ldinmesh            ! ???
+      !!
+      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
+      !!---------------------------------------------------------------------
+      
+      ! 4 semi plane defined by the 4 points and including the T point
+      zabt = fsline(pax,pay,pbx,pby,ptx,pty)
+      zbct = fsline(pbx,pby,pcx,pcy,ptx,pty)
+      zcdt = fsline(pcx,pcy,pdx,pdy,ptx,pty)
+      zdat = fsline(pdx,pdy,pax,pay,ptx,pty)
+      
+      ! 4 semi plane defined by the 4 points and including the extrememity
+      zabpt = fsline(pax,pay,pbx,pby,px,py)
+      zbcpt = fsline(pbx,pby,pcx,pcy,px,py)
+      zcdpt = fsline(pcx,pcy,pdx,pdy,px,py)
+      zdapt = fsline(pdx,pdy,pax,pay,px,py)
+       
+      ! We compare the semi plane T with the semi plane including the point
+      ! to know if it is in this  mesh.
+      ! For numerical reasons it is possible that for a point which is on
+      ! the line we don't have exactly zero with fsline function. We want 
+      ! that a point can't be in 2 mesh in the same time, so we put the 
+      ! coefficient to zero if it is smaller than 1.E-12
+      
+      IF( ABS(zabpt) <= 1.E-12 ) zabpt = 0.
+      IF( ABS(zbcpt) <= 1.E-12 ) zbcpt = 0.
+      IF( ABS(zcdpt) <= 1.E-12 ) zcdpt = 0.
+      IF( ABS(zdapt) <= 1.E-12 ) zdapt = 0.
+      IF( (zabt*zabpt >  0.) .AND. (zbct*zbcpt >= 0. ) .AND. ( zcdt*zcdpt >= 0. ) .AND. ( zdat*zdapt > 0. )   &
+         .AND. ( px <= MAX(pcx,pdx) ) .AND. ( px >= MIN(pax,pbx) )    &
+         .AND. ( py <= MAX(pby,pcy) ) .AND. ( py >= MIN(pay,pdy) ) ) THEN
+         ldinmesh=.TRUE.
+      ELSE
+         ldinmesh=.FALSE.
+      ENDIF
+      !
+   END SUBROUTINE flo_findmesh
+
+
+   FUNCTION flo_dstnce( pla1, phi1, pla2, phi2 )
+      !! -------------------------------------------------------------
+      !!                 ***  Function dstnce  ***
+      !!          
+      !! ** Purpose :   returns distance (in m) between two geographical
+      !!                points
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pla1, phi1, pla2, phi2   ! ???
+      !!
+      REAL(wp) :: dly1, dly2, dlx1, dlx2, dlx, dls, dld, dpi
+      REAL(wp) :: flo_dstnce
+      !!---------------------------------------------------------------------
+      !
+      dpi  = 2._wp * ASIN(1._wp)
+      dls  = dpi / 180._wp
+      dly1 = phi1 * dls
+      dly2 = phi2 * dls
+      dlx1 = pla1 * dls
+      dlx2 = pla2 * dls
+      !
+      dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1)
+      !
+      IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp
+      !
+      dld = ATAN(DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls
+      flo_dstnce = dld * 1000._wp
+      !
+   END FUNCTION flo_dstnce
+
+   INTEGER FUNCTION flo_dom_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION flo_dom_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( iimfl(jpnfl) , ijmfl(jpnfl) , ikmfl(jpnfl) ,                          &  
+                idomfl(jpnfl), ivtest(jpnfl), ihtest(jpnfl),                 &
+                zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl)   , STAT=flo_dom_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( flo_dom_alloc )
+      IF( flo_dom_alloc /= 0 )   CALL ctl_warn('flo_dom_alloc: failed to allocate arrays')
+   END FUNCTION flo_dom_alloc
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_dom                 ! Empty routine
+         WRITE(*,*) 'flo_dom: : You should not have seen this print! error?'
+   END SUBROUTINE flo_dom
+#endif
+
+   !!======================================================================
+END MODULE flodom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 8732)
@@ -0,0 +1,137 @@
+MODULE florst
+   !!======================================================================
+   !!                       ***  MODULE  florst  ***
+   !! Ocean floats : write floats restart files
+   !!======================================================================
+   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
+   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
+   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others 
+   !!----------------------------------------------------------------------
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   USE flo_oce         ! ocean drifting floats
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC flo_rst         ! routine called by floats.F90
+   PUBLIC flo_rst_alloc   ! routine called by floats.F90
+
+   INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc   ! 1D workspace
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION flo_rst_alloc()
+      !!-------------------------------------------------------------------
+      !!                ***  FUNCTION flo_rst_alloc  ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( iperproc(jpnij), STAT=flo_rst_alloc )
+      !  
+      IF( lk_mpp             )   CALL mpp_sum ( flo_rst_alloc )
+      IF( flo_rst_alloc /= 0 )   CALL ctl_warn('flo_rst_alloc: failed to allocate arrays.')
+   END FUNCTION flo_rst_alloc
+
+
+   SUBROUTINE flo_rst( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_rst ***
+      !!             
+      !! ** Purpose :  
+      !!             
+      !!      
+      !! ** Method  :   The frequency of  ??? is nwritefl
+      !!      
+      !!----------------------------------------------------------------------
+      INTEGER  :: kt                            ! time step
+      !
+      CHARACTER (len=80)       :: clname             ! restart filename
+      INTEGER                  :: ic , jc , jpn ,jfl ! temporary integer
+      INTEGER                  :: inum               ! temporary logical unit for restart file
+      !!----------------------------------------------------------------------
+
+      IF(  ( MOD(kt,nn_stockfl) == 0 ) .OR. ( kt == nitend )  )THEN      
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'flo_rst : write in  restart_float file '
+            WRITE(numout,*) '~~~~~~~    '
+         ENDIF
+
+         ! file is opened and closed every time it is used.
+
+         clname = 'restart.float.'
+         ic = 1
+         DO jc = 1, 16
+            IF( cexper(jc:jc) /= ' ' ) ic = jc
+         END DO
+         clname = clname(1:14)//cexper(1:ic)
+         ic = 1
+         DO jc = 1, 48
+            IF( clname(jc:jc) /= ' ' ) ic = jc
+         END DO
+
+         inum=0
+         IF( lwp )THEN
+            CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+            REWIND inum
+         ENDIF
+         !
+         DO jpn = 1, jpnij
+            iperproc(jpn) = 0
+         END DO
+         !
+         IF(lwp) THEN
+            REWIND(inum)
+            WRITE (inum,*) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl
+            CLOSE (inum)
+         ENDIF
+         !
+         ! Compute the number of trajectories for each processor
+         !
+         IF( lk_mpp ) THEN
+            DO jfl = 1, jpnfl
+               IF( (INT(tpifl(jfl)) >= mig(nldi)) .AND.   &
+                  &(INT(tpifl(jfl)) <= mig(nlei)) .AND.   &
+                  &(INT(tpjfl(jfl)) >= mjg(nldj)) .AND.   &
+                  &(INT(tpjfl(jfl)) <= mjg(nlej)) ) THEN
+                  iperproc(narea) = iperproc(narea)+1
+               ENDIF
+            END DO
+            CALL mpp_sum( iperproc, jpnij )
+            !
+            IF(lwp) THEN
+               WRITE(numout,*) 'DATE',adatrj
+               DO jpn = 1, jpnij
+                  IF( iperproc(jpn) /= 0 ) THEN
+                     WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iperproc(jpn), 'trajectories.'
+                  ENDIF
+               END DO
+            ENDIF
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE flo_rst
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_rst                 ! Empty routine
+   END SUBROUTINE flo_rst
+#endif
+
+   !!=======================================================================
+END MODULE florst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 8732)
@@ -0,0 +1,293 @@
+MODULE flowri
+   !!======================================================================
+   !!                       ***  MODULE  flowri  ***
+   !!
+   !! Ocean floats: write floats trajectory in ascii                    ln_flo_ascii = T
+   !!                                    or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F           
+   !!======================================================================
+   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
+   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
+   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others 
+   !!----------------------------------------------------------------------
+#if   defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physic constants
+   USE dianam          ! build name of file (routine)
+   USE ioipsl
+   USE iom             ! I/O library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC flo_wri         ! routine called by floats.F90
+   PUBLIC flo_wri_alloc   ! routine called by floats.F90
+
+   INTEGER :: jfl                            ! number of floats
+   CHARACTER (len=80)  :: clname             ! netcdf output filename
+
+   ! Following are only workspace arrays but shape is not (jpi,jpj) and
+   ! therefore make them module arrays rather than replacing with wrk_nemo
+   ! member arrays.
+   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zlon , zlat, zdep   ! 2D workspace
+   REAL(wp), ALLOCATABLE, DIMENSION(:) ::   ztem , zsal, zrho   ! 2D workspace
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION flo_wri_alloc()
+      !!-------------------------------------------------------------------
+      !!                ***  FUNCTION flo_wri_alloc  ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , &
+                zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc)
+      !  
+      IF( lk_mpp             )   CALL mpp_sum ( flo_wri_alloc )
+      IF( flo_wri_alloc /= 0 )   CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.')
+   END FUNCTION flo_wri_alloc
+
+   SUBROUTINE flo_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_wri ***
+      !!             
+      !! ** Purpose :   Write position of floats in "trajec_float.nc",according
+      !!                to ARIANE TOOLS (http://stockage.univ-brest.fr/~grima/Ariane/ )  n
+      !!                nomenclature
+      !!    
+      !!      
+      !! ** Method  :   The frequency of  ??? is nwritefl
+      !!      
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER  :: kt                               ! time step
+
+      !! * Local declarations
+      INTEGER  :: iafl , ibfl , icfl             ! temporary integer
+      INTEGER  :: ia1fl, ib1fl, ic1fl            !   "
+      INTEGER  :: iafloc,ibfloc,ia1floc,ib1floc  !   "
+      INTEGER  :: irec, irecflo
+
+      REAL(wp) :: zafl,zbfl,zcfl                 ! temporary real
+      REAL(wp) :: ztime                          !   "
+
+      INTEGER, DIMENSION(2)          :: icount
+      INTEGER, DIMENSION(2)          :: istart
+      INTEGER, DIMENSION(1)          :: ish
+      INTEGER, DIMENSION(2)          :: ish2
+      !!----------------------------------------------------------------------
+      
+      !-----------------------------------------------------
+      ! I- Save positions, temperature, salinty and density 
+      !-----------------------------------------------------
+      zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 
+      ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 
+
+      DO jfl = 1, jpnfl
+
+         iafl  = INT (tpifl(jfl))            ! I-index of the nearest point before
+         ibfl  = INT (tpjfl(jfl))            ! J-index of the nearest point before
+         icfl  = INT (tpkfl(jfl))            ! K-index of the nearest point before
+         ia1fl = iafl + 1                    ! I-index of the nearest point after
+         ib1fl = ibfl + 1                    ! J-index of the nearest point after
+         ic1fl = icfl + 1                    ! K-index of the nearest point after
+         zafl  = tpifl(jfl) - REAL(iafl,wp)  ! distance  ?????
+         zbfl  = tpjfl(jfl) - REAL(ibfl,wp)  ! distance  ?????
+         zcfl  = tpkfl(jfl) - REAL(icfl,wp)  ! distance  ?????
+
+         IF( lk_mpp ) THEN
+               
+            iafloc = mi1( iafl )
+            ibfloc = mj1( ibfl )
+ 
+            IF( nldi <= iafloc .AND. iafloc <= nlei .AND. &
+              & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN 
+
+               !the float is inside of current proc's area
+               ia1floc = iafloc + 1
+               ib1floc = ibfloc + 1
+     
+               !save position of the float
+               zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
+                     +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)   
+               zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
+                     +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
+               zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)     
+
+               !save temperature, salinity and density at this position
+               ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
+               zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal)
+               zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
+
+            ENDIF
+
+         ELSE  ! mono proc case  
+
+            iafloc  = iafl
+            ibfloc  = ibfl
+            ia1floc = iafloc + 1
+            ib1floc = ibfloc + 1
+
+            !save position of the float               
+            zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
+                      +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)
+            zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
+                      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
+            zdep(jfl) = (1.-zcfl)*gdepw_n(iafloc,ibfloc,icfl ) + zcfl * gdepw_n(iafloc,ibfloc,ic1fl)
+
+            ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
+            zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal)
+            zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
+          
+         ENDIF
+
+      END DO ! loop on float
+
+      !Only proc 0 writes all positions : SUM of positions on all procs
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( zlon, jpnfl )   ! sums over the global domain
+         CALL mpp_sum( zlat, jpnfl )   ! sums over the global domain
+         CALL mpp_sum( zdep, jpnfl )   ! sums over the global domain
+         CALL mpp_sum( ztem, jpnfl )   ! sums over the global domain
+         CALL mpp_sum( zsal, jpnfl )   ! sums over the global domain
+         CALL mpp_sum( zrho, jpnfl )   ! sums over the global domain
+      ENDIF
+
+
+      !-------------------------------------!
+      ! II- WRITE WRITE WRITE WRITE WRITE   !
+      !-------------------------------------!
+
+      !--------------------------!
+      ! II-1 Write in ascii file !
+      !--------------------------!
+
+      IF( ln_flo_ascii )THEN
+
+         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
+
+            !II-1-a Open ascii file
+            !----------------------
+            IF( kt == nn_it000 ) THEN
+               CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+               irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) )
+               WRITE(numflo,*)cexper,no,irecflo,jpnfl,nn_writefl
+            ENDIF
+
+            !II-1-b Write in ascii file
+            !-----------------------------
+            WRITE(numflo,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)
+
+
+            !II-1-c Close netcdf file
+            !-------------------------
+            IF( kt == nitend )   CLOSE( numflo )
+
+         ENDIF
+
+      !-----------------------------------------------------
+      ! II-2 Write in netcdf file
+      !-----------------------------------------------------
+
+      ELSE
+
+      !II-2-a Write with IOM
+      !----------------------
+
+#if defined key_iomput
+         CALL iom_put( "traj_lon"     , zlon )
+         CALL iom_put( "traj_lat"     , zlat )
+         CALL iom_put( "traj_dep"     , zdep )
+         CALL iom_put( "traj_temp"    , ztem )
+         CALL iom_put( "traj_salt"    , zsal  )
+         CALL iom_put( "traj_dens"    , zrho )
+         CALL iom_put( "traj_group"   , REAL(ngrpfl,wp) )
+#else
+
+      !II-2-b Write with IOIPSL
+      !------------------------
+
+         IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
+
+
+            !II-2-b-1 Open netcdf file
+            !-------------------------
+            IF( kt==nn_it000 )THEN   ! Create and open
+
+               CALL dia_nam( clname, nn_writefl, 'trajec_float' )
+               clname=TRIM(clname)//".nc"
+
+               CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1  /) , numflo )
+   
+               CALL fliodefv( numflo, 'traj_lon'    , (/1,2/), v_t=flio_r8, long_name="Longitude"           , units="degrees_east"  )
+               CALL fliodefv( numflo, 'traj_lat'    , (/1,2/), v_t=flio_r8, long_name="Latitude"            , units="degrees_north" )
+               CALL fliodefv( numflo, 'traj_depth'  , (/1,2/), v_t=flio_r8, long_name="Depth"               , units="meters" )
+               CALL fliodefv( numflo, 'time_counter', (/2/)  , v_t=flio_r8, long_name="Time axis"           & 
+                         & , units="seconds since start of the run " )
+               CALL fliodefv( numflo, 'traj_temp'   , (/1,2/), v_t=flio_r8, long_name="Temperature"         , units="C" )
+               CALL fliodefv( numflo, 'traj_salt'   , (/1,2/), v_t=flio_r8, long_name="Salinity"            , units="PSU" )
+               CALL fliodefv( numflo, 'traj_dens'   , (/1,2/), v_t=flio_r8, long_name="Density"             , units="kg/m3" )
+               CALL fliodefv( numflo, 'traj_group'  , (/1/)  , v_t=flio_r8, long_name="number of the group" , units="no unit" )
+
+               CALL flioputv( numflo , 'traj_group' , REAL(ngrpfl,wp) )
+  
+            ELSE  ! Re-open
+       
+               CALL flioopfd( TRIM(clname), numflo , "WRITE" )
+
+            ENDIF
+
+            !II-2-b-2 Write in  netcdf file
+            !-------------------------------
+            irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1
+            ztime = ( kt-nn_it000 + 1 ) * rdt
+
+            CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) )
+
+            DO jfl = 1, jpnfl
+
+               istart = (/jfl,irec/)
+               icfl   = INT( tpkfl(jfl) )            ! K-index of the nearest point before
+
+               CALL flioputv( numflo , 'traj_lon'    , zlon(jfl)        , start=istart )
+               CALL flioputv( numflo , 'traj_lat'    , zlat(jfl)        , start=istart )  
+               CALL flioputv( numflo , 'traj_depth'  , zdep(jfl)        , start=istart )  
+               CALL flioputv( numflo , 'traj_temp'   , ztemp(icfl,jfl)  , start=istart )  
+               CALL flioputv( numflo , 'traj_salt'   , zsal(icfl,jfl)   , start=istart )  
+               CALL flioputv( numflo , 'traj_dens'   , zrho(icfl,jfl)   , start=istart )  
+
+            ENDDO
+
+            !II-2-b-3 Close netcdf file
+            !---------------------------
+            CALL flioclo( numflo )
+
+         ENDIF
+
+#endif
+      ENDIF ! netcdf writing
+   
+   END SUBROUTINE flo_wri
+
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_wri                 ! Empty routine
+   END SUBROUTINE flo_wri
+#endif
+
+   !!=======================================================================
+END MODULE flowri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90	(revision 8732)
@@ -0,0 +1,197 @@
+MODULE icb_oce
+
+   !!======================================================================
+   !!                       ***  MODULE  icb_oce  ***
+   !! Icebergs:  declare variables for iceberg tracking
+   !!======================================================================
+   !! History :  3.3  !  2010-01  (T. Martin & A. Adcroft)  Original code
+   !!             -   !  2011-03  (G. Madec)  Part conversion to NEMO form
+   !!             -   !                       Removal of mapping from another grid
+   !!             -   !  2011-04  (S. Alderson) Extensive rewrite ; Split into separate modules
+   !!----------------------------------------------------------------------
+   !!
+   !! Track Icebergs as Lagrangian objects within the model domain
+   !! Interaction with the other model variables through 'icebergs_gridded'
+   !!
+   !! A single iceberg is held as an instance of type 'iceberg'
+   !! This type defines a linked list, so each instance contains a pointer 
+   !! to the previous and next icebergs in the list
+   !!
+   !! Type 'icebergs' is a convenience container for all relevant arrays
+   !! It contains one pointer to an 'iceberg' instance representing all icebergs in the processor
+   !!
+   !! Each iceberg has a position represented as a real cartesian coordinate which is 
+   !! fractional grid cell, centred on T-points; so an iceberg position of (1.0,1.0) lies 
+   !! exactly on the first T-point and the T-cell spans 0.5 to 1.5 in each direction
+   !!
+   !! Each iceberg is assigned a unique id even in MPI
+   !! This consists of an array of integers: the first element is used to label, the second
+   !! and subsequent elements are used to count the number of times the first element wraps
+   !! around all possible values within the valid size for this datatype.
+   !! Labelling is done by starting the first label in each processor (even when only one)
+   !! as narea, and then incrementing by jpnij (i.e. the total number of processors.
+   !! This means that the source processor for each iceberg can be identified by arithmetic
+   !! modulo jpnij.
+   !! 
+   !!----------------------------------------------------------------------
+   USE par_oce   ! ocean parameters
+   USE lib_mpp   ! MPP library
+
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   icb_alloc   ! routine called by icb_init in icbini.F90 module
+
+   INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes   
+   INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming
+
+   TYPE, PUBLIC ::   icebergs_gridded   !: various icebergs properties on model grid
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   calving         ! Calving mass rate  (into stored ice)         [kg/s]
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   calving_hflx    ! Calving heat flux [heat content of calving]  [W/m2]
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   floating_melt   ! Net melting rate to icebergs + bits      [kg/s/m^2]
+      INTEGER , DIMENSION(:,:)  , ALLOCATABLE ::   maxclass        ! maximum class number at calving source point
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmp             ! Temporary work space
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   stored_ice      ! Accumulated ice mass flux at calving locations [kg]
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   stored_heat     ! Heat content of stored ice                      [J]
+   END TYPE icebergs_gridded
+
+   TYPE, PUBLIC ::   point              !: properties of an individual iceberg (position, mass, size, etc...)
+      INTEGER  ::   year
+      REAL(wp) ::   xi , yj                                              ! iceberg coordinates in the (i,j) referential (global)
+      REAL(wp) ::   e1 , e2                                              ! horizontal scale factors at the iceberg position
+      REAL(wp) ::   lon, lat, day                                        ! geographic position
+      REAL(wp) ::   mass, thickness, width, length, uvel, vvel           ! iceberg physical properties
+      REAL(wp) ::   uo, vo, ui, vi, ua, va, ssh_x, ssh_y, sst, cn, hi    ! properties of iceberg environment 
+      REAL(wp) ::   mass_of_bits, heat_density
+   END TYPE point
+
+   TYPE, PUBLIC ::   iceberg            !: linked list defining all the icebergs present in the model domain
+      TYPE(iceberg), POINTER      ::   prev=>NULL(), next=>NULL()   ! pointers to previous and next unique icebergs in linked list
+      INTEGER, DIMENSION(nkounts) ::   number                       ! variables which do not change for this iceberg
+      REAL(wp)                    ::   mass_scaling                 !    -        -            -                -  
+      TYPE(point), POINTER        ::   current_point => NULL()      ! variables which change with time are held in a separate type
+   END TYPE iceberg
+
+
+   TYPE(icebergs_gridded), POINTER ::   berg_grid                 !: master instance of gridded iceberg type
+   TYPE(iceberg)         , POINTER ::   first_berg => NULL()      !: master instance of linked list iceberg type
+
+   !                                                             !!! parameters controlling iceberg characteristics and modelling
+   REAL(wp)                            ::   berg_dt                   !: Time-step between iceberg CALLs (should make adaptive?)
+   REAL(wp), DIMENSION(:), ALLOCATABLE ::   first_width, first_length !: 
+   LOGICAL                             ::   l_restarted_bergs=.FALSE.  ! Indicate whether we read state from a restart or not
+   !                                                               ! arbitrary numbers for diawri entry
+   REAL(wp), DIMENSION(nclasses), PUBLIC ::   class_num=(/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 /)
+
+   ! Extra arrays with bigger halo, needed when interpolating forcing onto iceberg position
+   ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   uo_e, vo_e
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, hicth
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e
+#if defined key_lim2 || defined key_lim3 || defined key_cice
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ui_e, vi_e
+#endif
+
+   !!gm almost all those PARAM ARE defined in NEMO
+   REAL(wp), PUBLIC, PARAMETER :: pp_rho_ice      = 916.7_wp   !: Density of fresh ice   @ 0oC [kg/m^3]
+   REAL(wp), PUBLIC, PARAMETER :: pp_rho_water    = 999.8_wp   !: Density of fresh water @ 0oC [kg/m^3]
+   REAL(wp), PUBLIC, PARAMETER :: pp_rho_air      = 1.1_wp     !: Density of air         @ 0oC [kg/m^3]
+   REAL(wp), PUBLIC, PARAMETER :: pp_rho_seawater = 1025._wp   !: Approx. density of surface sea water @ 0oC [kg/m^3]
+   !!gm end
+   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_av = 1.3_wp      !: (Vertical) Drag coefficient between bergs and atmos 
+   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_ah = 0.0055_wp   !: (lateral ) Drag coefficient between bergs and atmos 
+   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_wv = 0.9_wp      !: (Vertical) Drag coefficient between bergs and ocean
+   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_wh = 0.0012_wp   !: (lateral ) Drag coefficient between bergs and ocean 
+   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_iv = 0.9_wp      !: (Vertical) Drag coefficient between bergs and sea-ice
+!TOM> no horizontal drag for sea ice! real, PARAMETER :: pp_Cd_ih=0.0012 ! (lateral) Drag coeff. between bergs and sea-ice
+
+   !                                                         !!* namberg namelist parameters (and defaults) **
+   LOGICAL , PUBLIC ::   ln_bergdia                      !: Calculate budgets
+   INTEGER , PUBLIC ::   nn_verbose_level                !: Turn on debugging when level > 0
+   INTEGER , PUBLIC ::   nn_test_icebergs                !: Create icebergs in absence of a restart file from the supplied class nb
+   REAL(wp), PUBLIC, DIMENSION(4) ::   rn_test_box       !: lon1,lon2,lat1,lat2 box to create them in
+   INTEGER , PUBLIC ::   nn_sample_rate                  !: Timesteps between sampling of position for trajectory storage
+   INTEGER , PUBLIC ::   nn_verbose_write                !: timesteps between verbose messages
+   REAL(wp), PUBLIC ::   rn_rho_bergs                    !: Density of icebergs
+   REAL(wp), PUBLIC ::   rn_LoW_ratio                    !: Initial ratio L/W for newly calved icebergs
+   REAL(wp), PUBLIC ::   rn_bits_erosion_fraction        !: Fraction of erosion melt flux to divert to bergy bits
+   REAL(wp), PUBLIC ::   rn_sicn_shift                   !: Shift of sea-ice concentration in erosion flux modulation (0<sicn_shift<1)
+   LOGICAL , PUBLIC ::   ln_operator_splitting           !: Use first order operator splitting for thermodynamics
+   LOGICAL , PUBLIC ::   ln_passive_mode                 !: iceberg - ocean decoupling
+   LOGICAL , PUBLIC ::   ln_time_average_weight          !: Time average the weight on the ocean    !!gm I don't understand that !
+   REAL(wp), PUBLIC ::   rn_speed_limit                  !: CFL speed limit for a berg
+   !
+   !                                     ! Mass thresholds between iceberg classes [kg]
+   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_initial_mass      ! Fraction of calving to apply to this class [non-dim]
+   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_distribution      ! Ratio between effective and real iceberg mass (non-dim)
+   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_mass_scaling      ! Total thickness of newly calved bergs [m]
+   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_initial_thickness !  Single instance of an icebergs type initialised in icebergs_init and updated in icebergs_run
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   src_calving, src_calving_hflx    !: accumulate input ice
+   INTEGER , PUBLIC             , SAVE                     ::   numicb                           !: iceberg IO
+   INTEGER , PUBLIC             , SAVE, DIMENSION(nkounts) ::   num_bergs                        !: iceberg counter
+   INTEGER , PUBLIC             , SAVE                     ::   nicbdi, nicbei, nicbdj, nicbej   !: processor bounds
+   REAL(wp), PUBLIC             , SAVE                     ::   ricb_left, ricb_right            !: cyclical bounds
+   INTEGER , PUBLIC             , SAVE                     ::   nicbpack                         !: packing integer
+   INTEGER , PUBLIC             , SAVE                     ::   nktberg, nknberg                 !: helpers
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldpts                       !: nfold packed points
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbflddest                      !: nfold destination proc
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldproc                      !: nfold destination proc
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldnsend                     !: nfold number of bergs to send to nfold neighbour
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldexpect                    !: nfold expected number of bergs
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldreq                       !: nfold message handle (immediate send)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: griddata                           !: work array for icbrst
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   INTEGER FUNCTION icb_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE icb_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER ::   ill
+      !!----------------------------------------------------------------------
+      !
+      icb_alloc = 0
+      ALLOCATE( berg_grid, STAT=ill )
+      icb_alloc = icb_alloc + ill
+      ALLOCATE( berg_grid%calving    (jpi,jpj) , berg_grid%calving_hflx (jpi,jpj)          ,   &
+         &      berg_grid%stored_heat(jpi,jpj) , berg_grid%floating_melt(jpi,jpj)          ,   &
+         &      berg_grid%maxclass   (jpi,jpj) , berg_grid%stored_ice   (jpi,jpj,nclasses) ,   &
+         &      berg_grid%tmp        (jpi,jpj) , STAT=ill)
+      icb_alloc = icb_alloc + ill
+      !
+      ! expanded arrays for bilinear interpolation
+      ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   &
+         &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   &
+#if defined key_lim2 || defined key_lim3 || defined key_cice
+         &      ui_e(0:jpi+1,0:jpj+1) ,                            &
+         &      vi_e(0:jpi+1,0:jpj+1) ,                            &
+#endif
+         &      ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1)  ,   &
+         &      tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   &
+         &      hicth(0:jpi+1,0:jpj+1),                            &
+         &      first_width(nclasses) , first_length(nclasses) ,   &
+         &      src_calving (jpi,jpj) ,                            &
+         &      src_calving_hflx(jpi,jpj) , STAT=ill)
+      icb_alloc = icb_alloc + ill
+
+      ALLOCATE( nicbfldpts(jpi) , nicbflddest(jpi) , nicbfldproc(jpni) , &
+         &      nicbfldnsend(jpni), nicbfldexpect(jpni) , nicbfldreq(jpni), STAT=ill)
+      icb_alloc = icb_alloc + ill
+
+      ALLOCATE( griddata(jpi,jpj,1), STAT=ill )
+      icb_alloc = icb_alloc + ill
+
+      IF( lk_mpp        )   CALL mpp_sum ( icb_alloc )
+      IF( icb_alloc > 0 )   CALL ctl_warn('icb_alloc: allocation of arrays failed')
+      !
+   END FUNCTION icb_alloc
+
+   !!======================================================================
+END MODULE icb_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90	(revision 8732)
@@ -0,0 +1,183 @@
+MODULE icbclv
+
+   !!======================================================================
+   !!                       ***  MODULE  icbclv  ***
+   !! Icebergs:  calving routines for iceberg calving
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!            -    !  2011-05  (Alderson)       budgets into separate module
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_clv_flx   : transfer input flux of ice into iceberg classes
+   !!   icb_clv       : calve icebergs from stored ice
+   !!----------------------------------------------------------------------
+   USE par_oce        ! NEMO parameters
+   USE dom_oce        ! NEMO ocean domain
+   USE phycst         ! NEMO physical constants
+   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
+   USE lbclnk         ! NEMO boundary exchanges for gridded data
+
+   USE icb_oce        ! iceberg variables
+   USE icbdia         ! iceberg diagnostics
+   USE icbutl         ! iceberg utility routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_clv_flx  ! routine called in icbstp.F90 module
+   PUBLIC   icb_clv      ! routine called in icbstp.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_clv_flx( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_clv_flx  ***
+      !!
+      !! ** Purpose :   accumulate ice available for calving into class arrays
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)             :: kt
+      !
+      REAL(wp)                        :: zcalving_used, zdist, zfact
+      INTEGER                         :: jn, ji, jj                    ! loop counters
+      INTEGER                         :: imx                           ! temporary integer for max berg class
+      LOGICAL, SAVE                   :: ll_first_call = .TRUE.
+      !!----------------------------------------------------------------------
+      !
+      ! Adapt calving flux and calving heat flux from coupler for use here
+      ! Use interior mask: so no bergs in overlap areas and convert from km^3/year to kg/s
+      ! this assumes that input is given as equivalent water flux so that pure water density is appropriate
+
+      zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * 850._wp
+      berg_grid%calving(:,:) = src_calving(:,:) * tmask_i(:,:) * zfact
+
+      ! Heat in units of W/m2, and mask (just in case)
+      berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:)
+
+      IF( ll_first_call .AND. .NOT. l_restarted_bergs) THEN      ! This is a hack to simplify initialization
+         ll_first_call = .FALSE.
+         !do jn=1, nclasses
+         !  where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0.
+         !end do
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF( berg_grid%calving(ji,jj) /= 0._wp )                                  &    ! Need units of J
+                  berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) *         &  ! initial stored ice in kg
+                                         berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) /   &  ! J/s/m2 x m^2 = J/s
+                                         berg_grid%calving(ji,jj)                            ! /calving in kg/s
+            END DO
+         END DO
+      ENDIF
+
+      ! assume that all calving flux must be distributed even if distribution array does not sum
+      ! to one - this may not be what is intended, but it's what you've got
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            imx = berg_grid%maxclass(ji,jj)
+            zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) )
+            DO jn = 1, imx
+               berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) + &
+                                          berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist
+            END DO
+         END DO
+      END DO
+
+      ! before changing the calving, save the amount we're about to use and do budget
+      zcalving_used = SUM( berg_grid%calving(:,:) )
+      berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:)
+      berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:)
+      CALL icb_dia_income( kt,  zcalving_used, berg_grid%tmp )
+      !
+   END SUBROUTINE icb_clv_flx
+
+   SUBROUTINE icb_clv()
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_clv  ***
+      !!
+      !! ** Purpose :   This routine takes a stored ice field and calves to the ocean,
+      !!                so the gridded array stored_ice has only non-zero entries at selected
+      !!                wet points adjacent to known land based calving points
+      !!
+      !! ** method  : - Look at each grid point and see if there's enough for each size class to calve
+      !!                If there is, a new iceberg is calved.  This happens in the order determined by
+      !!                the class definition arrays (which in the default case is smallest first)
+      !!                Note that only the non-overlapping part of the processor where icebergs are allowed
+      !!                is considered
+      !!----------------------------------------------------------------------
+      INTEGER       ::   ji, jj, jn   ! dummy loop indices
+      INTEGER       ::   icnt, icntmax
+      TYPE(iceberg) ::   newberg
+      TYPE(point)   ::   newpt
+      REAL(wp)      ::   zday, zcalved_to_berg, zheat_to_berg
+      !!----------------------------------------------------------------------
+      !
+      icntmax = 0
+      zday    = REAL(nday_year,wp) + REAL(nsec_day,wp)/86400.0_wp
+      !
+      DO jn = 1, nclasses
+         DO jj = nicbdj, nicbej
+            DO ji = nicbdi, nicbei
+               !
+               icnt = 0
+               !
+               DO WHILE (berg_grid%stored_ice(ji,jj,jn) >= rn_initial_mass(jn) * rn_mass_scaling(jn) )
+                  !
+                  newpt%lon = glamt(ji,jj)         ! at t-point (centre of the cell)
+                  newpt%lat = gphit(ji,jj)
+                  newpt%xi  = REAL( mig(ji), wp )
+                  newpt%yj  = REAL( mjg(jj), wp )
+                  !
+                  newpt%uvel = 0._wp               ! initially at rest
+                  newpt%vvel = 0._wp
+                  !                                ! set berg characteristics
+                  newpt%mass           = rn_initial_mass     (jn)
+                  newpt%thickness      = rn_initial_thickness(jn)
+                  newpt%width          = first_width         (jn)
+                  newpt%length         = first_length        (jn)
+                  newberg%mass_scaling = rn_mass_scaling     (jn)
+                  newpt%mass_of_bits   = 0._wp                          ! no bergy
+                  !
+                  newpt%year   = nyear
+                  newpt%day    = zday
+                  newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn)   ! This is in J/kg
+                  !
+                  CALL icb_utl_incr()
+                  newberg%number(:) = num_bergs(:)
+                  !
+                  CALL icb_utl_add( newberg, newpt )
+                  !
+                  zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn)           ! Units of kg
+                  !                                ! Heat content
+                  zheat_to_berg           = zcalved_to_berg * newpt%heat_density             ! Units of J
+                  berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - zheat_to_berg
+                  !                                ! Stored mass
+                  berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) - zcalved_to_berg
+                  !
+                  icnt = icnt + 1
+                  !
+                  CALL icb_dia_calve(ji, jj, jn,  zcalved_to_berg, zheat_to_berg )
+               END DO
+               icntmax = MAX( icntmax, icnt )
+            END DO
+         END DO
+      END DO
+      !
+      DO jn = 1,nclasses
+         CALL lbc_lnk( berg_grid%stored_ice(:,:,jn), 'T', 1._wp )
+      END DO
+      CALL lbc_lnk( berg_grid%stored_heat, 'T', 1._wp )
+      !
+      IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea
+      !
+   END SUBROUTINE  icb_clv
+
+   !!======================================================================
+END MODULE icbclv
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90	(revision 8732)
@@ -0,0 +1,580 @@
+MODULE icbdia
+
+   !!======================================================================
+   !!                       ***  MODULE  icbdia  ***
+   !! Icebergs:  initialise variables for iceberg budgets and diagnostics
+   !!======================================================================
+   !! History : 3.3 !  2010-01  (Martin, Adcroft) Original code
+   !!            -  !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -  !                            Removal of mapping from another grid
+   !!            -  !  2011-04  (Alderson)       Split into separate modules
+   !!            -  !  2011-05  (Alderson)       Budgets are now all here with lots
+   !!            -  !                            of silly routines to call to get values in
+   !!            -  !                            from the right points in the code
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! icb_dia_init : initialise iceberg budgeting
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE dom_oce        ! ocean domain
+   USE in_out_manager ! nemo IO
+   USE lib_mpp        ! MPP library
+   USE iom            ! I/O library
+   USE icb_oce        ! iceberg variables
+   USE icbutl         ! iceberg utility routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_dia_init      ! routine called in icbini.F90 module
+   PUBLIC   icb_dia           ! routine called in icbstp.F90 module
+   PUBLIC   icb_dia_step      ! routine called in icbstp.F90 module
+   PUBLIC   icb_dia_put       ! routine called in icbstp.F90 module
+   PUBLIC   icb_dia_melt      ! routine called in icbthm.F90 module
+   PUBLIC   icb_dia_size      ! routine called in icbthm.F90 module
+   PUBLIC   icb_dia_speed     ! routine called in icbdyn.F90 module
+   PUBLIC   icb_dia_calve     ! routine called in icbclv.F90 module
+   PUBLIC   icb_dia_income    ! routine called in icbclv.F90 module
+
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_melt       ! Melting+erosion rate of icebergs     [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   buoy_melt       ! Buoyancy component of melting rate   [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   eros_melt       ! Erosion component of melting rate    [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   conv_melt       ! Convective component of melting rate [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_src        ! Mass flux from berg erosion into bergy bits [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_melt       ! Melting rate of bergy bits           [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_mass       ! Mass distribution of bergy bits      [kg/s/m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   virtual_area    ! Virtual surface coverage by icebergs [m2]
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_mass       ! Mass distribution                    [kg/m2]
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PUBLIC  ::   real_calving    ! Calving rate into iceberg class at
+   !                                                                          ! calving locations                    [kg/s]
+   
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmpc                     ! Temporary work space
+   REAL(wp), DIMENSION(:)    , ALLOCATABLE ::   rsumbuf                  ! Temporary work space to reduce mpp exchanges
+   INTEGER , DIMENSION(:)    , ALLOCATABLE ::   nsumbuf                  ! Temporary work space to reduce mpp exchanges
+
+   REAL(wp)                      ::  berg_melt_net
+   REAL(wp)                      ::  bits_src_net
+   REAL(wp)                      ::  bits_melt_net
+   REAL(wp)                      ::  bits_mass_start     , bits_mass_end
+   REAL(wp)                      ::  floating_heat_start , floating_heat_end
+   REAL(wp)                      ::  floating_mass_start , floating_mass_end
+   REAL(wp)                      ::  bergs_mass_start    , bergs_mass_end
+   REAL(wp)                      ::  stored_start        , stored_heat_start
+   REAL(wp)                      ::  stored_end          , stored_heat_end
+   REAL(wp)                      ::  calving_src_net     , calving_out_net
+   REAL(wp)                      ::  calving_src_heat_net, calving_out_heat_net
+   REAL(wp)                      ::  calving_src_heat_used_net
+   REAL(wp)                      ::  calving_rcv_net  , calving_ret_net  , calving_used_net
+   REAL(wp)                      ::  heat_to_bergs_net, heat_to_ocean_net, melt_net
+   REAL(wp)                      ::  calving_to_bergs_net
+
+   INTEGER                       ::  nbergs_start, nbergs_end, nbergs_calved
+   INTEGER                       ::  nbergs_melted
+   INTEGER                       ::  nspeeding_tickets
+   INTEGER , DIMENSION(nclasses) ::  nbergs_calved_by_class
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_dia_init( )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+
+      ALLOCATE( berg_melt    (jpi,jpj)   )           ;   berg_melt   (:,:)   = 0._wp
+      ALLOCATE( buoy_melt    (jpi,jpj)   )           ;   buoy_melt   (:,:)   = 0._wp
+      ALLOCATE( eros_melt    (jpi,jpj)   )           ;   eros_melt   (:,:)   = 0._wp
+      ALLOCATE( conv_melt    (jpi,jpj)   )           ;   conv_melt   (:,:)   = 0._wp
+      ALLOCATE( bits_src     (jpi,jpj)   )           ;   bits_src    (:,:)   = 0._wp
+      ALLOCATE( bits_melt    (jpi,jpj)   )           ;   bits_melt   (:,:)   = 0._wp
+      ALLOCATE( bits_mass    (jpi,jpj)   )           ;   bits_mass   (:,:)   = 0._wp
+      ALLOCATE( virtual_area (jpi,jpj)   )           ;   virtual_area(:,:)   = 0._wp
+      ALLOCATE( berg_mass    (jpi,jpj)   )           ;   berg_mass   (:,:)   = 0._wp
+      ALLOCATE( real_calving (jpi,jpj,nclasses) )    ;   real_calving(:,:,:) = 0._wp
+      ALLOCATE( tmpc(jpi,jpj) )                      ;   tmpc        (:,:)   = 0._wp
+
+      nbergs_start              = 0
+      nbergs_end                = 0
+      stored_end                = 0._wp
+      nbergs_start              = 0._wp
+      stored_start              = 0._wp
+      nbergs_melted             = 0
+      nbergs_calved             = 0
+      nbergs_calved_by_class(:) = 0
+      nspeeding_tickets         = 0
+      stored_heat_end           = 0._wp
+      floating_heat_end         = 0._wp
+      floating_mass_end         = 0._wp
+      bergs_mass_end            = 0._wp
+      bits_mass_end             = 0._wp
+      stored_heat_start         = 0._wp
+      floating_heat_start       = 0._wp
+      floating_mass_start       = 0._wp
+      bergs_mass_start          = 0._wp
+      bits_mass_start           = 0._wp
+      bits_mass_end             = 0._wp
+      calving_used_net          = 0._wp
+      calving_to_bergs_net      = 0._wp
+      heat_to_bergs_net         = 0._wp
+      heat_to_ocean_net         = 0._wp
+      calving_rcv_net           = 0._wp
+      calving_ret_net           = 0._wp
+      calving_src_net           = 0._wp
+      calving_out_net           = 0._wp
+      calving_src_heat_net      = 0._wp
+      calving_src_heat_used_net = 0._wp
+      calving_out_heat_net      = 0._wp
+      melt_net                  = 0._wp
+      berg_melt_net             = 0._wp
+      bits_melt_net             = 0._wp
+      bits_src_net              = 0._wp
+
+      floating_mass_start       = icb_utl_mass( first_berg )
+      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.true. )
+      bits_mass_start           = icb_utl_mass( first_berg, justbits=.true. )
+      IF( lk_mpp ) THEN
+         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp
+         ALLOCATE( nsumbuf(4+nclasses) )  ; nsumbuf(:) = 0
+         rsumbuf(1) = floating_mass_start
+         rsumbuf(2) = bergs_mass_start
+         rsumbuf(3) = bits_mass_start
+         CALL mpp_sum( rsumbuf(1:3), 3 )
+         floating_mass_start = rsumbuf(1)
+         bergs_mass_start = rsumbuf(2)
+         bits_mass_start = rsumbuf(3)
+      ENDIF
+      !
+   END SUBROUTINE icb_dia_init
+
+
+   SUBROUTINE icb_dia( ld_budge )
+      !!----------------------------------------------------------------------
+      !! sum all the things we've accumulated so far in the current processor
+      !! in MPP case then add these sums across all processors
+      !! for this we pack variables into buffer so we only need one mpp_sum
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in) ::   ld_budge
+      !
+      INTEGER             ::   ik
+      REAL(wp)            ::   zunused_calving, ztmpsum, zgrdd_berg_mass, zgrdd_bits_mass
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia )   RETURN
+
+      zunused_calving      = SUM( berg_grid%calving(:,:) )
+      ztmpsum              = SUM( berg_grid%floating_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
+      melt_net             = melt_net + ztmpsum * berg_dt
+      calving_out_net      = calving_out_net + ( zunused_calving + ztmpsum ) * berg_dt
+      ztmpsum              = SUM( berg_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
+      berg_melt_net        = berg_melt_net + ztmpsum * berg_dt
+      ztmpsum              = SUM( bits_src(:,:) * e1e2t(:,:) * tmask_i(:,:) )
+      bits_src_net         = bits_src_net + ztmpsum * berg_dt
+      ztmpsum              = SUM( bits_melt(:,:) * e1e2t(:,:) * tmask_i(:,:) )
+      bits_melt_net        = bits_melt_net + ztmpsum * berg_dt
+      ztmpsum              = SUM( src_calving(:,:) * tmask_i(:,:) )
+      calving_ret_net      = calving_ret_net + ztmpsum * berg_dt
+      ztmpsum              = SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) )
+      calving_out_heat_net = calving_out_heat_net + ztmpsum * berg_dt   ! Units of J
+
+      IF( ld_budge ) THEN
+         stored_end        = SUM( berg_grid%stored_ice(:,:,:) )
+         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) )
+         floating_mass_end = icb_utl_mass( first_berg )
+         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.true. )
+         bits_mass_end     = icb_utl_mass( first_berg,justbits=.true. )
+         floating_heat_end = icb_utl_heat( first_berg )
+
+         nbergs_end        = icb_utl_count()
+         zgrdd_berg_mass   = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
+         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) )
+
+         IF( lk_mpp ) THEN
+            rsumbuf( 1) = stored_end
+            rsumbuf( 2) = stored_heat_end
+            rsumbuf( 3) = floating_mass_end
+            rsumbuf( 4) = bergs_mass_end
+            rsumbuf( 5) = bits_mass_end
+            rsumbuf( 6) = floating_heat_end
+            rsumbuf( 7) = calving_ret_net
+            rsumbuf( 8) = calving_out_net
+            rsumbuf( 9) = calving_rcv_net
+            rsumbuf(10) = calving_src_net
+            rsumbuf(11) = calving_src_heat_net
+            rsumbuf(12) = calving_src_heat_used_net
+            rsumbuf(13) = calving_out_heat_net
+            rsumbuf(14) = calving_used_net
+            rsumbuf(15) = calving_to_bergs_net
+            rsumbuf(16) = heat_to_bergs_net
+            rsumbuf(17) = heat_to_ocean_net
+            rsumbuf(18) = melt_net
+            rsumbuf(19) = berg_melt_net
+            rsumbuf(20) = bits_src_net
+            rsumbuf(21) = bits_melt_net
+            rsumbuf(22) = zgrdd_berg_mass
+            rsumbuf(23) = zgrdd_bits_mass
+
+            CALL mpp_sum( rsumbuf(1:23), 23)
+
+            stored_end                = rsumbuf( 1)
+            stored_heat_end           = rsumbuf( 2)
+            floating_mass_end         = rsumbuf( 3)
+            bergs_mass_end            = rsumbuf( 4)
+            bits_mass_end             = rsumbuf( 5)
+            floating_heat_end         = rsumbuf( 6)
+            calving_ret_net           = rsumbuf( 7)
+            calving_out_net           = rsumbuf( 8)
+            calving_rcv_net           = rsumbuf( 9)
+            calving_src_net           = rsumbuf(10)
+            calving_src_heat_net      = rsumbuf(11)
+            calving_src_heat_used_net = rsumbuf(12)
+            calving_out_heat_net      = rsumbuf(13)
+            calving_used_net          = rsumbuf(14)
+            calving_to_bergs_net      = rsumbuf(15)
+            heat_to_bergs_net         = rsumbuf(16)
+            heat_to_ocean_net         = rsumbuf(17)
+            melt_net                  = rsumbuf(18)
+            berg_melt_net             = rsumbuf(19)
+            bits_src_net              = rsumbuf(20)
+            bits_melt_net             = rsumbuf(21)
+            zgrdd_berg_mass           = rsumbuf(22)
+            zgrdd_bits_mass           = rsumbuf(23)
+
+            nsumbuf(1) = nbergs_end
+            nsumbuf(2) = nbergs_calved
+            nsumbuf(3) = nbergs_melted
+            nsumbuf(4) = nspeeding_tickets
+            DO ik = 1, nclasses
+               nsumbuf(4+ik) = nbergs_calved_by_class(ik)
+            END DO
+
+            CALL mpp_sum( nsumbuf(1:nclasses+4), nclasses+4 )
+
+            nbergs_end        = nsumbuf(1)
+            nbergs_calved     = nsumbuf(2)
+            nbergs_melted     = nsumbuf(3)
+            nspeeding_tickets = nsumbuf(4)
+            DO ik = 1,nclasses
+               nbergs_calved_by_class(ik)= nsumbuf(4+ik)
+            ENDDO
+
+         ENDIF
+
+         CALL report_state( 'stored ice','kg','',stored_start,'',stored_end,'')
+         CALL report_state( 'floating','kg','',floating_mass_start,'',floating_mass_end,'',nbergs_end)
+         CALL report_state( 'icebergs','kg','',bergs_mass_start,'',bergs_mass_end,'')
+         CALL report_state( 'bits','kg','',bits_mass_start,'',bits_mass_end,'')
+         CALL report_istate( 'berg #','',nbergs_start,'',nbergs_end,'')
+         CALL report_ibudget( 'berg #','calved',nbergs_calved, &
+                                       'melted',nbergs_melted, &
+                                       '#',nbergs_start,nbergs_end)
+         CALL report_budget( 'stored mass','kg','calving used',calving_used_net, &
+                                           'bergs',calving_to_bergs_net, &
+                                           'stored mass',stored_start,stored_end)
+         CALL report_budget( 'floating mass','kg','calving used',calving_to_bergs_net, &
+                                             'bergs',melt_net, &
+                                             'stored mass',floating_mass_start,floating_mass_end)
+         CALL report_budget( 'berg mass','kg','calving',calving_to_bergs_net, &
+                                              'melt+eros',berg_melt_net, &
+                                              'berg mass',bergs_mass_start,bergs_mass_end)
+         CALL report_budget( 'bits mass','kg','eros used',bits_src_net, &
+                                              'bergs',bits_melt_net, &
+                                              'stored mass',bits_mass_start,bits_mass_end)
+         CALL report_budget( 'net mass','kg','recvd',calving_rcv_net, &
+                                             'rtrnd',calving_ret_net, &
+                                             'net mass',stored_start+floating_mass_start, &
+                                                        stored_end+floating_mass_end)
+         CALL report_consistant( 'iceberg mass','kg','gridded',zgrdd_berg_mass,'bergs',bergs_mass_end)
+         CALL report_consistant( 'bits mass','kg','gridded',zgrdd_bits_mass,'bits',bits_mass_end)
+         CALL report_state( 'net heat','J','',stored_heat_start+floating_heat_start,'', &
+                                              stored_heat_end+floating_heat_end,'')
+         CALL report_state( 'stored heat','J','',stored_heat_start,'',stored_heat_end,'')
+         CALL report_state( 'floating heat','J','',floating_heat_start,'',floating_heat_end,'')
+         CALL report_budget( 'net heat','J','net heat',calving_src_heat_net, &
+                                            'net heat',calving_out_heat_net, &
+                                            'net heat',stored_heat_start+floating_heat_start, &
+                                                       stored_heat_end+floating_heat_end)
+         CALL report_budget( 'stored heat','J','calving used',calving_src_heat_used_net, &
+                                               'bergs',heat_to_bergs_net, &
+                                               'net heat',stored_heat_start,stored_heat_end)
+         CALL report_budget( 'flting heat','J','calved',heat_to_bergs_net, &
+                                               'melt',heat_to_ocean_net, &
+                                               'net heat',floating_heat_start,floating_heat_end)
+         IF (nn_verbose_level >= 1) THEN
+            CALL report_consistant( 'top interface','kg','from SIS',calving_src_net, &
+                                    'received',calving_rcv_net)
+            CALL report_consistant( 'bot interface','kg','sent',calving_out_net, &
+                                    'returned',calving_ret_net)
+         ENDIF
+         WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses)
+         IF ( nspeeding_tickets > 0 ) WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets
+
+         nbergs_start              = nbergs_end
+         stored_start              = stored_end
+         nbergs_melted             = 0
+         nbergs_calved             = 0
+         nbergs_calved_by_class(:) = 0
+         nspeeding_tickets         = 0
+         stored_heat_start         = stored_heat_end
+         floating_heat_start       = floating_heat_end
+         floating_mass_start       = floating_mass_end
+         bergs_mass_start          = bergs_mass_end
+         bits_mass_start           = bits_mass_end
+         calving_used_net          = 0._wp
+         calving_to_bergs_net      = 0._wp
+         heat_to_bergs_net         = 0._wp
+         heat_to_ocean_net         = 0._wp
+         calving_rcv_net           = 0._wp
+         calving_ret_net           = 0._wp
+         calving_src_net           = 0._wp
+         calving_out_net           = 0._wp
+         calving_src_heat_net      = 0._wp
+         calving_src_heat_used_net = 0._wp
+         calving_out_heat_net      = 0._wp
+         melt_net                  = 0._wp
+         berg_melt_net             = 0._wp
+         bits_melt_net             = 0._wp
+         bits_src_net              = 0._wp
+      ENDIF
+      !
+   END SUBROUTINE icb_dia
+
+
+   SUBROUTINE icb_dia_step
+      !!----------------------------------------------------------------------
+      !! things to reset at the beginning of each timestep
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+      berg_melt    (:,:)   = 0._wp
+      buoy_melt    (:,:)   = 0._wp
+      eros_melt    (:,:)   = 0._wp
+      conv_melt    (:,:)   = 0._wp
+      bits_src     (:,:)   = 0._wp
+      bits_melt    (:,:)   = 0._wp
+      bits_mass    (:,:)   = 0._wp
+      berg_mass    (:,:)   = 0._wp
+      virtual_area (:,:)   = 0._wp
+      real_calving (:,:,:) = 0._wp
+      !
+   END SUBROUTINE icb_dia_step
+
+
+   SUBROUTINE icb_dia_put
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia )   RETURN            !!gm useless iom will control whether it is output or not
+      !
+      CALL iom_put( "berg_melt"        , berg_melt   (:,:)   )   ! Melt rate of icebergs                     [kg/m2/s]
+      CALL iom_put( "berg_buoy_melt"   , buoy_melt   (:,:)   )   ! Buoyancy component of iceberg melt rate   [kg/m2/s]
+      CALL iom_put( "berg_eros_melt"   , eros_melt   (:,:)   )   ! Erosion component of iceberg melt rate    [kg/m2/s]
+      CALL iom_put( "berg_conv_melt"   , conv_melt   (:,:)   )   ! Convective component of iceberg melt rate [kg/m2/s]
+      CALL iom_put( "berg_virtual_area", virtual_area(:,:)   )   ! Virtual coverage by icebergs              [m2]
+      CALL iom_put( "bits_src"         , bits_src    (:,:)   )   ! Mass source of bergy bits                 [kg/m2/s]
+      CALL iom_put( "bits_melt"        , bits_melt   (:,:)   )   ! Melt rate of bergy bits                   [kg/m2/s]
+      CALL iom_put( "bits_mass"        , bits_mass   (:,:)   )   ! Bergy bit density field                   [kg/m2]
+      CALL iom_put( "berg_mass"        , berg_mass   (:,:)   )   ! Iceberg density field                     [kg/m2]
+      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s]
+      !
+   END SUBROUTINE icb_dia_put
+
+
+   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER,  INTENT(in)  ::   ki, kj, kn
+      REAL(wp), INTENT(in)  ::   pcalved
+      REAL(wp), INTENT(in)  ::   pheated
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+      real_calving(ki,kj,kn)     = real_calving(ki,kj,kn) + pcalved / berg_dt
+      nbergs_calved              = nbergs_calved              + 1
+      nbergs_calved_by_class(kn) = nbergs_calved_by_class(kn) + 1
+      calving_to_bergs_net       = calving_to_bergs_net + pcalved
+      heat_to_bergs_net          = heat_to_bergs_net    + pheated
+      !
+   END SUBROUTINE icb_dia_calve
+
+
+   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER ,                 INTENT(in)  :: kt
+      REAL(wp),                 INTENT(in)  :: pcalving_used
+      REAL(wp), DIMENSION(:,:), INTENT(in)  :: pheat_used
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+      !
+      IF( kt == nit000 ) THEN
+         stored_start = SUM( berg_grid%stored_ice(:,:,:) )
+         IF( lk_mpp ) CALL mpp_sum( stored_start )
+         WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg'
+         !
+         stored_heat_start = SUM( berg_grid%stored_heat(:,:) )
+         IF( lk_mpp ) CALL mpp_sum( stored_heat_start )
+         WRITE(numicb,'(a,es13.6,a)')    'icb_dia_income: initial stored heat=',stored_heat_start,' J'
+      ENDIF
+      !
+      calving_rcv_net = calving_rcv_net + SUM( berg_grid%calving(:,:) ) * berg_dt
+      calving_src_net = calving_rcv_net
+      calving_src_heat_net = calving_src_heat_net +  &
+         &                      SUM( berg_grid%calving_hflx(:,:) * e1e2t(:,:) ) * berg_dt   ! Units of J
+      calving_used_net = calving_used_net + pcalving_used * berg_dt
+      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) )
+      !
+   END SUBROUTINE icb_dia_income
+
+
+   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   &
+      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER,  INTENT(in) :: ki, kj
+      REAL(wp), INTENT(in) :: pWn, pLn, pAbits, pmass_scale, pMnew, pnMbits, pz1_e1e2
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+      virtual_area(ki,kj) = virtual_area(ki,kj) + ( pWn * pLn + pAbits ) * pmass_scale      ! m^2
+      berg_mass(ki,kj)    = berg_mass(ki,kj) + pMnew * pz1_e1e2                             ! kg/m2
+      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2
+      !
+   END SUBROUTINE icb_dia_size
+
+
+   SUBROUTINE icb_dia_speed()
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+      nspeeding_tickets = nspeeding_tickets + 1
+      !
+   END SUBROUTINE icb_dia_speed
+
+
+   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,   &
+      &                   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   &
+      &                   pdMv, pz1_dt_e1e2 )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in) ::   ki, kj
+      REAL(wp), INTENT(in) ::   pmnew, pheat, pmass_scale
+      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ln_bergdia ) RETURN
+
+      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s
+      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s
+      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s
+      buoy_melt (ki,kj) = buoy_melt (ki,kj) + pdMb     * pz1_dt_e1e2   ! kg/m2/s
+      eros_melt (ki,kj) = eros_melt (ki,kj) + pdMe     * pz1_dt_e1e2   ! erosion rate kg/m2/s
+      conv_melt (ki,kj) = conv_melt (ki,kj) + pdMv     * pz1_dt_e1e2   ! kg/m2/s
+      heat_to_ocean_net = heat_to_ocean_net + pheat * pmass_scale * berg_dt         ! J
+      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted
+      !
+   END SUBROUTINE icb_dia_melt
+
+
+   SUBROUTINE report_state( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr,   &
+      &                     pendval, cd_delstr, kbergs )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER*(*), INTENT(in)           :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr, cd_delstr
+      REAL(wp),      INTENT(in)           :: pstartval, pendval
+      INTEGER,       INTENT(in), OPTIONAL :: kbergs
+      !!----------------------------------------------------------------------
+      !
+      IF ( PRESENT(kbergs) ) THEN
+         WRITE(numicb,100) cd_budgetstr // ' state:',                                    &
+                           cd_startstr  // ' start',  pstartval,         cd_budgetunits, &
+                           cd_endstr    // ' end',    pendval,           cd_budgetunits, &
+                           'Delta '     // cd_delstr, pendval-pstartval, cd_budgetunits, &
+                           '# of bergs', kbergs
+      ELSE
+         WRITE(numicb,100) cd_budgetstr // ' state:',                                   &
+                           cd_startstr  // ' start', pstartval,         cd_budgetunits, &
+                           cd_endstr    // ' end',   pendval,           cd_budgetunits, &
+                           cd_delstr    // 'Delta',  pendval-pstartval, cd_budgetunits
+      ENDIF
+      100 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a12,i8)
+   END SUBROUTINE report_state
+
+
+   SUBROUTINE report_consistant( cd_budgetstr, cd_budgetunits, cd_startstr, pstartval, cd_endstr, pendval)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_startstr, cd_endstr
+      REAL(wp),      INTENT(in) :: pstartval, pendval
+      !!----------------------------------------------------------------------
+      !
+      WRITE(numicb,200) cd_budgetstr // ' check:',                 &
+                        cd_startstr,    pstartval, cd_budgetunits, &
+                        cd_endstr,      pendval,   cd_budgetunits, &
+                        'error',        (pendval-pstartval)/((pendval+pstartval)+1e-30), 'nd'
+      200 FORMAT(a19,10(a18,"=",es14.7,x,a2,:,","))
+   END SUBROUTINE report_consistant
+
+
+   SUBROUTINE report_budget( cd_budgetstr, cd_budgetunits, cd_instr, pinval, cd_outstr,   &
+      &                      poutval, cd_delstr, pstartval, pendval)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_budgetunits, cd_instr, cd_outstr, cd_delstr
+      REAL(wp),      INTENT(in) :: pinval, poutval, pstartval, pendval
+      !
+      REAL(wp)                  :: zval
+      !!----------------------------------------------------------------------
+      !
+      zval = ( ( pendval - pstartval ) - ( pinval - poutval ) ) /   &
+         &   MAX( 1.e-30, MAX( abs( pendval - pstartval ) , ABS( pinval - poutval ) ) )
+
+      WRITE(numicb,200) cd_budgetstr // ' budget:', &
+         &              cd_instr     // ' in',      pinval,         cd_budgetunits, &
+         &              cd_outstr    // ' out',     poutval,        cd_budgetunits, &
+         &              'Delta '     // cd_delstr,  pinval-poutval, cd_budgetunits, &
+         &              'error',        zval,                       'nd'
+  200 FORMAT(a19,3(a18,"=",es14.7,x,a2,:,","),a8,"=",es10.3,x,a2)
+      !
+   END SUBROUTINE report_budget
+
+
+   SUBROUTINE report_istate( cd_budgetstr, cd_startstr, pstartval, cd_endstr, pendval, cd_delstr)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_startstr, cd_endstr, cd_delstr
+      INTEGER,       INTENT(in) :: pstartval, pendval
+      !
+      WRITE(numicb,100) cd_budgetstr // ' state:',           &
+         &              cd_startstr  // ' start', pstartval, &
+         &              cd_endstr    // ' end',   pendval,   &
+         &              cd_delstr    // 'Delta',  pendval-pstartval
+  100 FORMAT(a19,3(a18,"=",i14,x,:,","))
+      !
+   END SUBROUTINE report_istate
+
+
+   SUBROUTINE report_ibudget( cd_budgetstr, cd_instr, pinval, cd_outstr, poutval,   &
+      &                       cd_delstr, pstartval, pendval)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER*(*), INTENT(in) :: cd_budgetstr, cd_instr, cd_outstr, cd_delstr
+      INTEGER,       INTENT(in) :: pinval, poutval, pstartval, pendval
+      !!----------------------------------------------------------------------
+      !
+      WRITE(numicb,200) cd_budgetstr // ' budget:', &
+                        cd_instr     // ' in',      pinval, &
+                        cd_outstr    // ' out',     poutval, &
+                        'Delta '     // cd_delstr,  pinval-poutval, &
+                        'error',                    ( ( pendval - pstartval ) - ( pinval - poutval ) )
+      200 FORMAT(a19,10(a18,"=",i14,x,:,","))
+   END SUBROUTINE report_ibudget
+
+   !!======================================================================
+END MODULE icbdia
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90	(revision 8732)
@@ -0,0 +1,381 @@
+MODULE icbdyn
+
+   !!======================================================================
+   !!                       ***  MODULE  icbdyn  ***
+   !! Iceberg:  time stepping routine for iceberg tracking
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!            -    !  2011-05  (Alderson)       Replace broken grounding routine
+   !!            -    !                            with one of Gurvan's suggestions (just like
+   !!            -    !                            the broken one)
+   !!----------------------------------------------------------------------
+   USE par_oce        ! NEMO parameters
+   USE dom_oce        ! NEMO ocean domain
+   USE phycst         ! NEMO physical constants
+   !
+   USE icb_oce        ! define iceberg arrays
+   USE icbutl         ! iceberg utility routines
+   USE icbdia         ! iceberg budget routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_dyn  ! routine called in icbstp.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_dyn  ***
+      !!
+      !! ** Purpose :   iceberg evolution.
+      !!
+      !! ** Method  : - See Martin & Adcroft, Ocean Modelling 34, 2010
+      !!----------------------------------------------------------------------
+      REAL(wp)                        ::   zuvel1 , zvvel1 , zu1, zv1, zax1, zay1, zxi1 , zyj1
+      REAL(wp)                        ::   zuvel2 , zvvel2 , zu2, zv2, zax2, zay2, zxi2 , zyj2
+      REAL(wp)                        ::   zuvel3 , zvvel3 , zu3, zv3, zax3, zay3, zxi3 , zyj3
+      REAL(wp)                        ::   zuvel4 , zvvel4 , zu4, zv4, zax4, zay4, zxi4 , zyj4
+      REAL(wp)                        ::   zuvel_n, zvvel_n, zxi_n   , zyj_n
+      REAL(wp)                        ::   zdt, zdt_2, zdt_6, ze1, ze2
+      LOGICAL                         ::   ll_bounced
+      TYPE(iceberg), POINTER          ::   berg
+      TYPE(point)  , POINTER          ::   pt
+      INTEGER                         ::   kt
+      !!----------------------------------------------------------------------
+
+      ! 4th order Runge-Kutta to solve:   d/dt X = V,  d/dt V = A
+      !                    with I.C.'s:   X=X1 and V=V1
+      !
+      !                                    ; A1=A(X1,V1)
+      !  X2 = X1+dt/2*V1 ; V2 = V1+dt/2*A1 ; A2=A(X2,V2)
+      !  X3 = X1+dt/2*V2 ; V3 = V1+dt/2*A2 ; A3=A(X3,V3)
+      !  X4 = X1+  dt*V3 ; V4 = V1+  dt*A3 ; A4=A(X4,V4)
+      !
+      !  Xn = X1+dt*(V1+2*V2+2*V3+V4)/6
+      !  Vn = V1+dt*(A1+2*A2+2*A3+A4)/6
+
+      ! time steps
+      zdt   = berg_dt
+      zdt_2 = zdt * 0.5_wp
+      zdt_6 = zdt / 6._wp
+
+      berg => first_berg                    ! start from the first berg
+      !
+      DO WHILE ( ASSOCIATED(berg) )          !==  loop over all bergs  ==!
+         !
+         pt => berg%current_point
+
+         ll_bounced = .false.
+
+
+         ! STEP 1 !
+         ! ====== !
+         zxi1 = pt%xi   ;   zuvel1 = pt%uvel     !**   X1 in (i,j)  ;  V1 in m/s
+         zyj1 = pt%yj   ;   zvvel1 = pt%vvel
+
+
+         !                                         !**   A1 = A(X1,V1)
+         CALL icb_accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1,     &
+            &                   zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 )
+         !
+         zu1 = zuvel1 / ze1                           !**   V1 in d(i,j)/dt
+         zv1 = zvvel1 / ze2
+
+         ! STEP 2 !
+         ! ====== !
+         !                                         !**   X2 = X1+dt/2*V1   ;   V2 = V1+dt/2*A1
+         ! position using di/dt & djdt   !   V2  in m/s
+         zxi2 = zxi1 + zdt_2 * zu1          ;   zuvel2 = zuvel1 + zdt_2 * zax1
+         zyj2 = zyj1 + zdt_2 * zv1          ;   zvvel2 = zvvel1 + zdt_2 * zay1
+         !
+         CALL icb_ground( zxi2, zxi1, zu1,   &
+         &                zyj2, zyj1, zv1, ll_bounced )
+
+         !                                         !**   A2 = A(X2,V2)
+         CALL icb_accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2,    &
+            &                   zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 )
+         !
+         zu2 = zuvel2 / ze1                           !**   V2 in d(i,j)/dt
+         zv2 = zvvel2 / ze2
+         !
+         ! STEP 3 !
+         ! ====== !
+         !                                         !**  X3 = X1+dt/2*V2  ;   V3 = V1+dt/2*A2; A3=A(X3)
+         zxi3  = zxi1  + zdt_2 * zu2   ;   zuvel3 = zuvel1 + zdt_2 * zax2
+         zyj3  = zyj1  + zdt_2 * zv2   ;   zvvel3 = zvvel1 + zdt_2 * zay2
+         !
+         CALL icb_ground( zxi3, zxi1, zu3,   &
+         &                zyj3, zyj1, zv3, ll_bounced )
+
+         !                                         !**   A3 = A(X3,V3)
+         CALL icb_accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3,    &
+            &                   zyj3, ze2, zvvel3, zvvel1, zay3, zdt )
+         !
+         zu3 = zuvel3 / ze1                           !**   V3 in d(i,j)/dt
+         zv3 = zvvel3 / ze2
+
+         ! STEP 4 !
+         ! ====== !
+         !                                         !**   X4 = X1+dt*V3   ;   V4 = V1+dt*A3
+         zxi4 = zxi1 + zdt * zu3   ;   zuvel4 = zuvel1 + zdt * zax3
+         zyj4 = zyj1 + zdt * zv3   ;   zvvel4 = zvvel1 + zdt * zay3
+
+         CALL icb_ground( zxi4, zxi1, zu4,   &
+         &                zyj4, zyj1, zv4, ll_bounced )
+
+         !                                         !**   A4 = A(X4,V4)
+         CALL icb_accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4,    &
+            &                   zyj4, ze2, zvvel4, zvvel1, zay4, zdt )
+
+         zu4 = zuvel4 / ze1                           !**   V4 in d(i,j)/dt
+         zv4 = zvvel4 / ze2
+
+         ! FINAL STEP !
+         ! ========== !
+         !                                         !**   Xn = X1+dt*(V1+2*V2+2*V3+V4)/6
+         !                                         !**   Vn = V1+dt*(A1+2*A2+2*A3+A4)/6
+         zxi_n   = pt%xi   + zdt_6 * (  zu1  + 2.*(zu2  + zu3 ) + zu4  )
+         zyj_n   = pt%yj   + zdt_6 * (  zv1  + 2.*(zv2  + zv3 ) + zv4  )
+         zuvel_n = pt%uvel + zdt_6 * (  zax1 + 2.*(zax2 + zax3) + zax4 )
+         zvvel_n = pt%vvel + zdt_6 * (  zay1 + 2.*(zay2 + zay3) + zay4 )
+
+         CALL icb_ground( zxi_n, zxi1, zuvel_n,   &
+         &                      zyj_n, zyj1, zvvel_n, ll_bounced )
+
+         pt%uvel = zuvel_n                        !** save in berg structure
+         pt%vvel = zvvel_n
+         pt%xi   = zxi_n
+         pt%yj   = zyj_n
+
+         ! update actual position
+         pt%lon  = icb_utl_bilin_x(glamt, pt%xi, pt%yj )
+         pt%lat  = icb_utl_bilin(gphit, pt%xi, pt%yj, 'T' )
+
+         berg => berg%next                         ! switch to the next berg
+         !
+      END DO                                  !==  end loop over all bergs  ==!
+      !
+   END SUBROUTINE icb_dyn
+
+
+   SUBROUTINE icb_ground( pi, pi0, pu,   &
+      &                         pj, pj0, pv, ld_bounced )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_ground  ***
+      !!
+      !! ** Purpose :   iceberg grounding.
+      !!
+      !! ** Method  : - adjust velocity and then put iceberg back to start position
+      !!                NB two possibilities available one of which is hard-coded here
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pi , pj      ! current iceberg position
+      REAL(wp), INTENT(in   ) ::   pi0, pj0     ! previous iceberg position
+      REAL(wp), INTENT(inout) ::   pu  , pv     ! current iceberg velocities
+      LOGICAL , INTENT(  out) ::   ld_bounced   ! bounced indicator
+      !
+      INTEGER  ::   ii, ii0
+      INTEGER  ::   ij, ij0
+      INTEGER  ::   ibounce_method
+      !!----------------------------------------------------------------------
+      !
+      ld_bounced = .FALSE.
+      !
+      ii0 = INT( pi0+0.5 )   ;   ij0 = INT( pj0+0.5 )       ! initial gridpoint position (T-cell)
+      ii  = INT( pi +0.5 )   ;   ij  = INT( pj +0.5 )       ! current     -         -
+      !
+      IF( ii == ii0  .AND.  ij == ij0  )   RETURN           ! berg remains in the same cell
+      !
+      ! map into current processor
+      ii0 = mi1( ii0 )
+      ij0 = mj1( ij0 )
+      ii  = mi1( ii  )
+      ij  = mj1( ij  )
+      !
+      IF(  tmask(ii,ij,1)  /=   0._wp  )   RETURN           ! berg reach a new t-cell, but an ocean one
+      !
+      ! From here, berg have reach land: treat grounding/bouncing
+      ! -------------------------------
+      ld_bounced = .TRUE.
+
+      !! not obvious what should happen now
+      !! if berg tries to enter a land box, the only location we can return it to is the start 
+      !! position (pi0,pj0), since it has to be in a wet box to do any melting;
+      !! first option is simply to set whole velocity to zero and move back to start point
+      !! second option (suggested by gm) is only to set the velocity component in the (i,j) direction
+      !! of travel to zero; at a coastal boundary this has the effect of sliding the berg along the coast
+
+      ibounce_method = 2
+      SELECT CASE ( ibounce_method )
+         CASE ( 1 )
+            pi = pi0
+            pj = pj0
+            pu = 0._wp
+            pv = 0._wp
+         CASE ( 2 )
+            IF( ii0 /= ii ) THEN
+               pi = pi0                   ! return back to the initial position
+               pu = 0._wp                 ! zeroing of velocity in the direction of the grounding
+            ENDIF
+            IF( ij0 /= ij ) THEN
+               pj = pj0                   ! return back to the initial position
+               pv = 0._wp                 ! zeroing of velocity in the direction of the grounding
+            ENDIF
+      END SELECT
+      !
+   END SUBROUTINE icb_ground
+
+
+   SUBROUTINE icb_accel( berg , pxi, pe1, puvel, puvel0, pax,                &
+      &                         pyj, pe2, pvvel, pvvel0, pay, pdt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_accel  ***
+      !!
+      !! ** Purpose :   compute the iceberg acceleration.
+      !!
+      !! ** Method  : - sum the terms in the momentum budget
+      !!----------------------------------------------------------------------
+      TYPE(iceberg ), POINTER, INTENT(in   ) ::   berg             ! berg
+      REAL(wp)               , INTENT(in   ) ::   pxi   , pyj      ! berg position in (i,j) referential
+      REAL(wp)               , INTENT(in   ) ::   puvel , pvvel    ! berg velocity [m/s]
+      REAL(wp)               , INTENT(in   ) ::   puvel0, pvvel0   ! initial berg velocity [m/s]
+      REAL(wp)               , INTENT(  out) ::   pe1, pe2         ! horizontal scale factor at (xi,yj)
+      REAL(wp)               , INTENT(inout) ::   pax, pay         ! berg acceleration
+      REAL(wp)               , INTENT(in   ) ::   pdt              ! berg time step
+      !
+      REAL(wp), PARAMETER ::   pp_alpha     = 0._wp      !
+      REAL(wp), PARAMETER ::   pp_beta      = 1._wp      !
+      REAL(wp), PARAMETER ::   pp_vel_lim   =15._wp      ! max allowed berg speed
+      REAL(wp), PARAMETER ::   pp_accel_lim = 1.e-2_wp   ! max allowed berg acceleration
+      REAL(wp), PARAMETER ::   pp_Cr0       = 0.06_wp    !
+      !
+      INTEGER  ::   itloop
+      REAL(wp) ::   zuo, zvo, zui, zvi, zua, zva, zuwave, zvwave, zssh_x, zssh_y, zsst, zcn, zhi
+      REAL(wp) ::   zff, zT, zD, zW, zL, zM, zF
+      REAL(wp) ::   zdrag_ocn, zdrag_atm, zdrag_ice, zwave_rad
+      REAL(wp) ::   z_ocn, z_atm, z_ice
+      REAL(wp) ::   zampl, zwmod, zCr, zLwavelength, zLcutoff, zLtop
+      REAL(wp) ::   zlambda, zdetA, zA11, zA12, zaxe, zaye, zD_hi
+      REAL(wp) ::   zuveln, zvveln, zus, zvs, zspeed, zloc_dx, zspeed_new
+      !!----------------------------------------------------------------------
+
+      ! Interpolate gridded fields to berg
+      nknberg = berg%number(1)
+      CALL icb_utl_interp( pxi, pe1, zuo, zui, zua, zssh_x,                     &
+         &                 pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff )
+
+      zM = berg%current_point%mass
+      zT = berg%current_point%thickness               ! total thickness
+      zD = ( rn_rho_bergs / pp_rho_seawater ) * zT    ! draught (keel depth)
+      zF = zT - zD                                    ! freeboard
+      zW = berg%current_point%width
+      zL = berg%current_point%length
+
+      zhi   = MIN( zhi   , zD    )
+      zD_hi = MAX( 0._wp, zD-zhi )
+
+      ! Wave radiation
+      zuwave = zua - zuo   ;   zvwave = zva - zvo     ! Use wind speed rel. to ocean for wave model
+      zwmod  = zuwave*zuwave + zvwave*zvwave          ! The wave amplitude and length depend on the  current;
+      !                                               ! wind speed relative to the ocean. Actually wmod is wmod**2 here.
+      zampl        = 0.5 * 0.02025 * zwmod            ! This is "a", the wave amplitude
+      zLwavelength =       0.32    * zwmod            ! Surface wave length fitted to data in table at
+      !                                               ! http://www4.ncsu.edu/eos/users/c/ceknowle/public/chapter10/part2.html
+      zLcutoff     = 0.125 * zLwavelength
+      zLtop        = 0.25  * zLwavelength
+      zCr          = pp_Cr0 * MIN(  MAX( 0., (zL-zLcutoff) / ((zLtop-zLcutoff)+1.e-30)) , 1.)  ! Wave radiation coefficient
+      !                                               ! fitted to graph from Carrieres et al.,  POAC Drift Model.
+      zwave_rad    = 0.5 * pp_rho_seawater / zM * zCr * grav * zampl * MIN( zampl,zF ) * (2.*zW*zL) / (zW+zL)
+      zwmod        = SQRT( zua*zua + zva*zva )        ! Wind speed
+      IF( zwmod /= 0._wp ) THEN
+         zuwave = zua/zwmod   ! Wave radiation force acts in wind direction ...       !!gm  this should be the wind rel. to ocean ?
+         zvwave = zva/zwmod
+      ELSE
+         zuwave = 0.   ;    zvwave=0.   ;    zwave_rad=0. ! ... and only when wind is present.     !!gm  wave_rad=0. is useless
+      ENDIF
+
+      ! Weighted drag coefficients
+      z_ocn = pp_rho_seawater / zM * (0.5*pp_Cd_wv*zW*(zD_hi)+pp_Cd_wh*zW*zL)
+      z_atm = pp_rho_air      / zM * (0.5*pp_Cd_av*zW*zF     +pp_Cd_ah*zW*zL)
+      z_ice = pp_rho_ice      / zM * (0.5*pp_Cd_iv*zW*zhi              )
+      IF( abs(zui) + abs(zvi) == 0._wp )   z_ice = 0._wp
+
+      zuveln = puvel   ;   zvveln = pvvel ! Copy starting uvel, vvel
+      !
+      DO itloop = 1, 2  ! Iterate on drag coefficients
+         !
+         zus = 0.5 * ( zuveln + puvel )
+         zvs = 0.5 * ( zvveln + pvvel )
+         zdrag_ocn = z_ocn * SQRT( (zus-zuo)*(zus-zuo) + (zvs-zvo)*(zvs-zvo) )
+         zdrag_atm = z_atm * SQRT( (zus-zua)*(zus-zua) + (zvs-zva)*(zvs-zva) )
+         zdrag_ice = z_ice * SQRT( (zus-zui)*(zus-zui) + (zvs-zvi)*(zvs-zvi) )
+         !
+         ! Explicit accelerations
+         !zaxe= zff*pvvel -grav*zssh_x +zwave_rad*zuwave &
+         !    -zdrag_ocn*(puvel-zuo) -zdrag_atm*(puvel-zua) -zdrag_ice*(puvel-zui)
+         !zaye=-zff*puvel -grav*zssh_y +zwave_rad*zvwave &
+         !    -zdrag_ocn*(pvvel-zvo) -zdrag_atm*(pvvel-zva) -zdrag_ice*(pvvel-zvi)
+         zaxe = -grav * zssh_x + zwave_rad * zuwave
+         zaye = -grav * zssh_y + zwave_rad * zvwave
+         IF( pp_alpha > 0._wp ) THEN   ! If implicit, use time-level (n) rather than RK4 latest
+            zaxe = zaxe + zff*pvvel0
+            zaye = zaye - zff*puvel0
+         ELSE
+            zaxe = zaxe + zff*pvvel
+            zaye = zaye - zff*puvel
+         ENDIF
+         IF( pp_beta > 0._wp ) THEN    ! If implicit, use time-level (n) rather than RK4 latest
+            zaxe = zaxe - zdrag_ocn*(puvel0-zuo) - zdrag_atm*(puvel0-zua) -zdrag_ice*(puvel0-zui)
+            zaye = zaye - zdrag_ocn*(pvvel0-zvo) - zdrag_atm*(pvvel0-zva) -zdrag_ice*(pvvel0-zvi)
+         ELSE
+            zaxe = zaxe - zdrag_ocn*(puvel -zuo) - zdrag_atm*(puvel -zua) -zdrag_ice*(puvel -zui)
+            zaye = zaye - zdrag_ocn*(pvvel -zvo) - zdrag_atm*(pvvel -zva) -zdrag_ice*(pvvel -zvi)
+         endif
+
+         ! Solve for implicit accelerations
+         IF( pp_alpha + pp_beta > 0._wp ) THEN
+            zlambda = zdrag_ocn + zdrag_atm + zdrag_ice
+            zA11    = 1._wp + pp_beta *pdt*zlambda
+            zA12    =         pp_alpha*pdt*zff
+            zdetA   = 1._wp / ( zA11*zA11 + zA12*zA12 )
+            pax     = zdetA * ( zA11*zaxe + zA12*zaye )
+            pay     = zdetA * ( zA11*zaye - zA12*zaxe )
+         else
+            pax = zaxe   ;   pay = zaye
+         endif
+
+         zuveln = puvel0 + pdt*pax
+         zvveln = pvvel0 + pdt*pay
+         !
+      END DO      ! itloop
+
+      IF( rn_speed_limit > 0._wp ) THEN       ! Limit speed of bergs based on a CFL criteria (if asked)
+         zspeed = SQRT( zuveln*zuveln + zvveln*zvveln )    ! Speed of berg
+         IF( zspeed > 0._wp ) THEN
+            zloc_dx = MIN( pe1, pe2 )                          ! minimum grid spacing
+            zspeed_new = zloc_dx / pdt * rn_speed_limit     ! Speed limit as a factor of dx / dt
+            IF( zspeed_new < zspeed ) THEN
+               zuveln = zuveln * ( zspeed_new / zspeed )        ! Scale velocity to reduce speed
+               zvveln = zvveln * ( zspeed_new / zspeed )        ! without changing the direction
+               CALL icb_dia_speed()
+            ENDIF
+         ENDIF
+      ENDIF
+      !                                      ! check the speed and acceleration limits
+      IF( ABS( zuveln ) > pp_vel_lim   .OR. ABS( zvveln ) > pp_vel_lim   )   &
+         WRITE(numicb,'("pe=",i3,x,a)') narea,'Dump triggered by excessive velocity'
+      IF( ABS( pax    ) > pp_accel_lim .OR. ABS( pay    ) > pp_accel_lim )   &
+         WRITE(numicb,'("pe=",i3,x,a)') narea,'Dump triggered by excessive acceleration'
+      !
+   END SUBROUTINE icb_accel
+
+   !!======================================================================
+END MODULE icbdyn
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90	(revision 8732)
@@ -0,0 +1,454 @@
+MODULE icbini
+   !!======================================================================
+   !!                       ***  MODULE  icbini  ***
+   !! Icebergs:  initialise variables for iceberg tracking
+   !!======================================================================
+   !! History :   -   !  2010-01  (T. Martin & A. Adcroft)  Original code
+   !!            3.3  !  2011-03  (G. Madec)  Part conversion to NEMO form ; Removal of mapping from another grid
+   !!             -   !  2011-04  (S. Alderson)  Split into separate modules ; Restore restart routines
+   !!             -   !  2011-05  (S. Alderson)  generate_test_icebergs restored ; new forcing arrays with extra halo ;
+   !!             -   !                          north fold exchange arrays added
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_init     : initialise icebergs
+   !!   icb_ini_gen  : generate test icebergs
+   !!   icb_nam      : read iceberg namelist
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE in_out_manager ! IO routines and numout in particular
+   USE lib_mpp        ! mpi library and lk_mpp in particular
+   USE sbc_oce        ! ocean  : surface boundary condition
+   USE sbc_ice        ! sea-ice: surface boundary condition
+   USE iom            ! IOM library
+   USE fldread        ! field read
+   USE lbclnk         ! lateral boundary condition - MPP link
+   !
+   USE icb_oce        ! define iceberg arrays
+   USE icbutl         ! iceberg utility routines
+   USE icbrst         ! iceberg restart routines
+   USE icbtrj         ! iceberg trajectory I/O routines
+   USE icbdia         ! iceberg budget routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_init  ! routine called in nemogcm.F90 module
+
+   CHARACTER(len=100)                                 ::   cn_dir = './'   !: Root directory for location of icb files
+   TYPE(FLD_N)                                        ::   sn_icb          !: information about the calving file to be read
+   TYPE(FLD), PUBLIC, ALLOCATABLE     , DIMENSION(:)  ::   sf_icb          !: structure: file information, fields read
+                                                                           !: used in icbini and icbstp
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_init( pdt, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!
+      !! ** Purpose :   iceberg initialization.
+      !!
+      !! ** Method  : - read the iceberg namelist
+      !!              - find non-overlapping processor interior since we can only
+      !!                have one instance of a particular iceberg
+      !!              - calculate the destinations for north fold exchanges
+      !!              - setup either test icebergs or calving file
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rdt*nn_fsbc)
+      INTEGER , INTENT(in) ::   kt    ! time step number
+      !
+      INTEGER ::   ji, jj, jn               ! dummy loop indices
+      INTEGER ::   i1, i2, i3               ! local integers
+      INTEGER ::   ii, inum, ivar           !   -       -
+      INTEGER ::   istat1, istat2, istat3   !   -       -
+      CHARACTER(len=300) ::   cl_sdist      ! local character
+      !!----------------------------------------------------------------------
+      !
+      CALL icb_nam               ! Read and print namelist parameters
+      !
+      IF( .NOT. ln_icebergs )   RETURN
+
+      !                          ! allocate gridded fields
+      IF( icb_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'icb_alloc : unable to allocate arrays' )
+
+      !                          ! open ascii output file or files for iceberg status information
+      !                          ! note that we choose to do this on all processors since we cannot
+      !                          ! predict where icebergs will be ahead of time
+      CALL ctl_opn( numicb, 'icebergs.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+
+      ! set parameters (mostly from namelist)
+      !
+      berg_dt         = pdt
+      first_width (:) = SQRT(  rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) )  )
+      first_length(:) = rn_LoW_ratio * first_width(:)
+
+      berg_grid%calving      (:,:)   = 0._wp
+      berg_grid%calving_hflx (:,:)   = 0._wp
+      berg_grid%stored_heat  (:,:)   = 0._wp
+      berg_grid%floating_melt(:,:)   = 0._wp
+      berg_grid%maxclass     (:,:)   = nclasses
+      berg_grid%stored_ice   (:,:,:) = 0._wp
+      berg_grid%tmp          (:,:)   = 0._wp
+      src_calving            (:,:)   = 0._wp
+      src_calving_hflx       (:,:)   = 0._wp
+
+      !                          ! domain for icebergs
+      IF( lk_mpp .AND. jpni == 1 )   CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' )
+      ! NB: the issue here is simply that cyclic east-west boundary condition have not been coded in mpp case
+      ! for the north fold we work out which points communicate by asking
+      ! lbc_lnk to pass processor number (valid even in single processor case)
+      ! borrow src_calving arrays for this
+      !
+      ! pack i and j together using a scaling of a power of 10
+      nicbpack = 10000
+      IF( jpiglo >= nicbpack )   CALL ctl_stop( 'icbini: processor index packing failure' )
+      nicbfldproc(:) = -1
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            src_calving_hflx(ji,jj) = narea
+            src_calving     (ji,jj) = nicbpack * mjg(jj) + mig(ji)
+         END DO
+      END DO
+      CALL lbc_lnk( src_calving_hflx, 'T', 1._wp )
+      CALL lbc_lnk( src_calving     , 'T', 1._wp )
+
+      ! work out interior of processor from exchange array
+      ! first entry with narea for this processor is left hand interior index
+      ! last  entry                               is right hand interior index
+      jj = nlcj/2
+      nicbdi = -1
+      nicbei = -1
+      DO ji = 1, jpi
+         i3 = INT( src_calving(ji,jj) )
+         i2 = INT( i3/nicbpack )
+         i1 = i3 - i2*nicbpack
+         i3 = INT( src_calving_hflx(ji,jj) )
+         IF( i1 == mig(ji) .AND. i3 == narea ) THEN
+            IF( nicbdi < 0 ) THEN   ;   nicbdi = ji
+            ELSE                    ;   nicbei = ji
+            ENDIF
+         ENDIF
+      END DO
+      !
+      ! repeat for j direction
+      ji = nlci/2
+      nicbdj = -1
+      nicbej = -1
+      DO jj = 1, jpj
+         i3 = INT( src_calving(ji,jj) )
+         i2 = INT( i3/nicbpack )
+         i1 = i3 - i2*nicbpack
+         i3 = INT( src_calving_hflx(ji,jj) )
+         IF( i2 == mjg(jj) .AND. i3 == narea ) THEN
+            IF( nicbdj < 0 ) THEN   ;   nicbdj = jj
+            ELSE                    ;   nicbej = jj
+            ENDIF
+         ENDIF
+      END DO
+      !   
+      ! special for east-west boundary exchange we save the destination index
+      i1 = MAX( nicbdi-1, 1)
+      i3 = INT( src_calving(i1,nlcj/2) )
+      jj = INT( i3/nicbpack )
+      ricb_left = REAL( i3 - nicbpack*jj, wp )
+      i1 = MIN( nicbei+1, jpi )
+      i3 = INT( src_calving(i1,nlcj/2) )
+      jj = INT( i3/nicbpack )
+      ricb_right = REAL( i3 - nicbpack*jj, wp )
+      
+      ! north fold
+      IF( npolj > 0 ) THEN
+         !
+         ! icebergs in row nicbej+1 get passed across fold
+         nicbfldpts(:)  = INT( src_calving(:,nicbej+1) )
+         nicbflddest(:) = INT( src_calving_hflx(:,nicbej+1) )
+         !
+         ! work out list of unique processors to talk to
+         ! pack them into a fixed size array where empty slots are marked by a -1
+         DO ji = nicbdi, nicbei
+            ii = nicbflddest(ji)
+            IF( ii .GT. 0 ) THEN     ! Needed because land suppression can mean
+                                     ! that unused points are not set in edge haloes
+               DO jn = 1, jpni
+                  ! work along array until we find an empty slot
+                  IF( nicbfldproc(jn) == -1 ) THEN
+                     nicbfldproc(jn) = ii
+                     EXIT                             !!gm EXIT should be avoided: use DO WHILE expression instead
+                  ENDIF
+                  ! before we find an empty slot, we may find processor number is already here so we exit
+                  IF( nicbfldproc(jn) == ii ) EXIT
+               END DO
+            ENDIF
+         END DO
+      ENDIF
+      !
+      IF( nn_verbose_level > 0) THEN
+         WRITE(numicb,*) 'processor ', narea
+         WRITE(numicb,*) 'jpi, jpj   ', jpi, jpj
+         WRITE(numicb,*) 'nldi, nlei ', nldi, nlei
+         WRITE(numicb,*) 'nldj, nlej ', nldj, nlej
+         WRITE(numicb,*) 'berg i interior ', nicbdi, nicbei
+         WRITE(numicb,*) 'berg j interior ', nicbdj, nicbej
+         WRITE(numicb,*) 'berg left       ', ricb_left
+         WRITE(numicb,*) 'berg right      ', ricb_right
+         jj = nlcj/2
+         WRITE(numicb,*) "central j line:"
+         WRITE(numicb,*) "i processor"
+         WRITE(numicb,*) (INT(src_calving_hflx(ji,jj)), ji=1,jpi)
+         WRITE(numicb,*) "i point"
+         WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi)
+         ji = nlci/2
+         WRITE(numicb,*) "central i line:"
+         WRITE(numicb,*) "j processor"
+         WRITE(numicb,*) (INT(src_calving_hflx(ji,jj)), jj=1,jpj)
+         WRITE(numicb,*) "j point"
+         WRITE(numicb,*) (INT(src_calving(ji,jj)), jj=1,jpj)
+         IF( npolj > 0 ) THEN
+            WRITE(numicb,*) 'north fold destination points '
+            WRITE(numicb,*) nicbfldpts
+            WRITE(numicb,*) 'north fold destination procs  '
+            WRITE(numicb,*) nicbflddest
+            WRITE(numicb,*) 'north fold destination proclist  '
+            WRITE(numicb,*) nicbfldproc
+         ENDIF
+         CALL flush(numicb)
+      ENDIF
+      
+      src_calving     (:,:) = 0._wp
+      src_calving_hflx(:,:) = 0._wp
+
+      ! assign each new iceberg with a unique number constructed from the processor number
+      ! and incremented by the total number of processors
+      num_bergs(:) = 0
+      num_bergs(1) = narea - jpnij
+
+      ! when not generating test icebergs we need to setup calving file
+      IF( nn_test_icebergs < 0 ) THEN
+         !
+         ! maximum distribution class array does not change in time so read it once
+         cl_sdist = TRIM( cn_dir )//TRIM( sn_icb%clname )
+         CALL iom_open ( cl_sdist, inum )                              ! open file
+         ivar = iom_varid( inum, 'maxclass', ldstop=.FALSE. )
+         IF( ivar > 0 ) THEN
+            CALL iom_get  ( inum, jpdom_data, 'maxclass', src_calving )   ! read the max distribution array
+            berg_grid%maxclass(:,:) = INT( src_calving )
+            src_calving(:,:) = 0._wp
+         ENDIF
+         CALL iom_close( inum )                                     ! close file
+         !
+         WRITE(numicb,*)
+         WRITE(numicb,*) '          calving read in a file'
+         ALLOCATE( sf_icb(1), STAT=istat1 )         ! Create sf_icb structure (calving)
+         ALLOCATE( sf_icb(1)%fnow(jpi,jpj,1), STAT=istat2 )
+         ALLOCATE( sf_icb(1)%fdta(jpi,jpj,1,2), STAT=istat3 )
+         IF( istat1+istat2+istat3 > 0 ) THEN
+            CALL ctl_stop( 'sbc_icb: unable to allocate sf_icb structure' )   ;   RETURN
+         ENDIF
+         !                                          ! fill sf_icb with the namelist (sn_icb) and control print
+         CALL fld_fill( sf_icb, (/ sn_icb /), cn_dir, 'icb_init', 'read calving data', 'namicb' )
+         !
+      ENDIF
+
+      IF( .NOT.ln_rstart ) THEN
+         IF( nn_test_icebergs > 0 )   CALL icb_ini_gen()
+      ELSE
+         IF( nn_test_icebergs > 0 ) THEN
+            CALL icb_ini_gen()
+         ELSE
+            CALL icb_rst_read()
+            l_restarted_bergs = .TRUE.
+         ENDIF
+      ENDIF
+      !
+      IF( nn_sample_rate .GT. 0 ) CALL icb_trj_init( nitend )
+      !
+      CALL icb_dia_init()
+      !
+      IF( nn_verbose_level >= 2 )   CALL icb_utl_print('icb_init, initial status', nit000-1)
+      !
+   END SUBROUTINE icb_init
+
+
+   SUBROUTINE icb_ini_gen()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_ini_gen  ***
+      !!
+      !! ** Purpose :   iceberg generation
+      !!
+      !! ** Method  : - at each grid point of the test box supplied in the namelist
+      !!                generate an iceberg in one class determined by the value of
+      !!                parameter nn_test_icebergs
+      !!----------------------------------------------------------------------
+      INTEGER                         ::   ji, jj, ibergs
+      TYPE(iceberg)                   ::   localberg ! NOT a pointer but an actual local variable
+      TYPE(point)                     ::   localpt
+      INTEGER                         ::   iyr, imon, iday, ihr, imin, isec
+      INTEGER                         ::   iberg
+      !!----------------------------------------------------------------------
+
+      ! For convenience
+      iberg = nn_test_icebergs
+
+      ! call get_date(Time, iyr, imon, iday, ihr, imin, isec)
+      ! Convert nemo time variables from dom_oce into local versions
+      iyr  = nyear
+      imon = nmonth
+      iday = nday
+      ihr = INT(nsec_day/3600)
+      imin = INT((nsec_day-ihr*3600)/60)
+      isec = nsec_day - ihr*3600 - imin*60
+
+      ! no overlap for icebergs since we want only one instance of each across the whole domain
+      ! so restrict area of interest
+      ! use tmask here because tmask_i has been doctored on one side of the north fold line
+
+      DO jj = nicbdj, nicbej
+         DO ji = nicbdi, nicbei
+            IF( tmask(ji,jj,1) > 0._wp        .AND.                                       &
+                rn_test_box(1) < glamt(ji,jj) .AND. glamt(ji,jj) < rn_test_box(2) .AND.   &
+                rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN
+               localberg%mass_scaling = rn_mass_scaling(iberg)
+               localpt%xi = REAL( mig(ji), wp )
+               localpt%yj = REAL( mjg(jj), wp )
+               localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T' )
+               localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T' )
+               localpt%mass      = rn_initial_mass     (iberg)
+               localpt%thickness = rn_initial_thickness(iberg)
+               localpt%width  = first_width (iberg)
+               localpt%length = first_length(iberg)
+               localpt%year = iyr
+               localpt%day = REAL(iday,wp)+(REAL(ihr,wp)+REAL(imin,wp)/60._wp)/24._wp
+               localpt%mass_of_bits = 0._wp
+               localpt%heat_density = 0._wp
+               localpt%uvel = 0._wp
+               localpt%vvel = 0._wp
+               CALL icb_utl_incr()
+               localberg%number(:) = num_bergs(:)
+               call icb_utl_add(localberg, localpt)
+            ENDIF
+         END DO
+      END DO
+      !
+      ibergs = icb_utl_count()
+      IF( lk_mpp ) CALL mpp_sum(ibergs)
+      WRITE(numicb,'(a,i6,a)') 'diamonds, icb_ini_gen: ',ibergs,' were generated'
+      !
+   END SUBROUTINE icb_ini_gen
+
+
+   SUBROUTINE icb_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE icb_nam  ***
+      !!
+      !! ** Purpose :   read iceberg namelist and print the variables.
+      !!
+      !! ** input   : - namberg namelist
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jn      ! dummy loop indices
+      INTEGER  ::   ios     ! Local integer output status for namelist read
+      REAL(wp) ::   zfact   ! local scalar
+      !
+      NAMELIST/namberg/ ln_icebergs    , ln_bergdia     , nn_sample_rate      , rn_initial_mass      ,   &
+         &              rn_distribution, rn_mass_scaling, rn_initial_thickness, nn_verbose_write     ,   &
+         &              rn_rho_bergs   , rn_LoW_ratio   , nn_verbose_level    , ln_operator_splitting,   &
+         &              rn_bits_erosion_fraction        , rn_sicn_shift       , ln_passive_mode      ,   &
+         &              ln_time_average_weight          , nn_test_icebergs    , rn_test_box          ,   &
+         &              rn_speed_limit , cn_dir, sn_icb
+      !!----------------------------------------------------------------------
+
+#if !defined key_agrif
+      REWIND( numnam_ref )              ! Namelist namberg in reference namelist : Iceberg parameters
+      READ  ( numnam_ref, namberg, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namberg in configuration namelist : Iceberg parameters
+      READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namberg )
+#else
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'icbini : AGRIF is not compatible with namelist namberg :  '
+         WRITE(numout,*) '~~~~~~   definition of rn_initial_mass(nclasses) with nclasses as PARAMETER '
+         WRITE(numout,*) '         ==>>>   force  NO icebergs used. The namelist namberg is not read'
+      ENDIF
+      ln_icebergs = .false.      
+#endif   
+      IF( .NOT. ln_icebergs ) THEN   ! no icebergs
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'icbini : Namelist namberg ln_icebergs = F , NO icebergs used'
+            WRITE(numout,*) '~~~~~~ '
+         ENDIF
+         RETURN
+      ENDIF
+
+      IF( nn_test_icebergs > nclasses ) THEN
+          IF(lwp) WRITE(numout,*) 'Resetting nn_test_icebergs to ', nclasses
+          nn_test_icebergs = nclasses
+      ENDIF
+
+      zfact = SUM( rn_distribution )
+      IF( zfact < 1._wp ) THEN
+         IF( zfact <= 0._wp ) THEN
+            
+         ELSE
+            rn_distribution(:) = rn_distribution(:) / zfact
+            CALL ctl_warn( 'icb_nam: sum of berg input distribution not equal to one and so RESCALED' )
+         ENDIF
+      ENDIF
+
+!     IF( lk_lim3 .AND. ln_icebergs ) THEN
+!        CALL ctl_stop( 'icb_nam: the use of ICB with LIM3 not allowed. ice thickness missing in ICB' )
+!     ENDIF
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'icb_nam : iceberg initialization through namberg namelist read'
+         WRITE(numout,*) '~~~~~~~~ '
+         WRITE(numout,*) '   Calculate budgets                                            ln_bergdia       = ', ln_bergdia
+         WRITE(numout,*) '   Period between sampling of position for trajectory storage   nn_sample_rate = ', nn_sample_rate
+         WRITE(numout,*) '   Mass thresholds between iceberg classes (kg)                 rn_initial_mass     ='
+         DO jn=1,nclasses
+            WRITE(numout,'(a,f15.2)') '                                                                ',rn_initial_mass(jn)
+         ENDDO
+         WRITE(numout,*) '   Fraction of calving to apply to this class (non-dim)         rn_distribution     ='
+         DO jn = 1, nclasses
+            WRITE(numout,'(a,f10.2)') '                                                                ',rn_distribution(jn)
+         END DO
+         WRITE(numout,*) '   Ratio between effective and real iceberg mass (non-dim)      rn_mass_scaling     = '
+         DO jn = 1, nclasses
+            WRITE(numout,'(a,f10.2)') '                                                                ',rn_mass_scaling(jn)
+         END DO
+         WRITE(numout,*) '   Total thickness of newly calved bergs (m)                    rn_initial_thickness = '
+         DO jn = 1, nclasses
+            WRITE(numout,'(a,f10.2)') '                                                                ',rn_initial_thickness(jn)
+         END DO
+         WRITE(numout,*) '   Timesteps between verbose messages                           nn_verbose_write    = ', nn_verbose_write
+
+         WRITE(numout,*) '   Density of icebergs                           rn_rho_bergs  = ', rn_rho_bergs
+         WRITE(numout,*) '   Initial ratio L/W for newly calved icebergs   rn_LoW_ratio  = ', rn_LoW_ratio
+         WRITE(numout,*) '   Turn on more verbose output                          level  = ', nn_verbose_level
+         WRITE(numout,*) '   Use first order operator splitting for thermodynamics    ',   &
+            &                    'use_operator_splitting = ', ln_operator_splitting
+         WRITE(numout,*) '   Fraction of erosion melt flux to divert to bergy bits    ',   &
+            &                    'bits_erosion_fraction = ', rn_bits_erosion_fraction
+
+         WRITE(numout,*) '   Shift of sea-ice concentration in erosion flux modulation ',   &
+            &                    '(0<sicn_shift<1)    rn_sicn_shift  = ', rn_sicn_shift
+         WRITE(numout,*) '   Do not add freshwater flux from icebergs to ocean                ',   &
+            &                    '                  passive_mode            = ', ln_passive_mode
+         WRITE(numout,*) '   Time average the weight on the ocean   time_average_weight       = ', ln_time_average_weight
+         WRITE(numout,*) '   Create icebergs in absence of a restart file   nn_test_icebergs  = ', nn_test_icebergs
+         WRITE(numout,*) '                   in lon/lat box                                   = ', rn_test_box
+         WRITE(numout,*) '   CFL speed limit for a berg            speed_limit                = ', rn_speed_limit
+         WRITE(numout,*) '   Writing Iceberg status information to icebergs.stat file        '
+      ENDIF
+      !
+   END SUBROUTINE icb_nam
+
+   !!======================================================================
+END MODULE icbini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90	(revision 8732)
@@ -0,0 +1,932 @@
+MODULE icblbc
+
+   !!======================================================================
+   !!                       ***  MODULE  icblbc  ***
+   !! Ocean physics:  routines to handle boundary exchanges for icebergs
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!            -    !  2011-05  (Alderson)       MPP exchanges written based on lib_mpp
+   !!            -    !  2011-05  (Alderson)       MPP and single processor boundary
+   !!            -    !                            conditions added
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_lbc       : -  Pass icebergs across cyclic boundaries
+   !!   icb_lbc_mpp   : -  In MPP pass icebergs from linked list between processors
+   !!                      as they advect around
+   !!                   -  Lagrangian processes cannot be handled by existing NEMO MPP
+   !!                      routines because they do not lie on regular jpi,jpj grids
+   !!                   -  Processor exchanges are handled as in lib_mpp whenever icebergs step 
+   !!                      across boundary of interior domain (nicbdi-nicbei, nicbdj-nicbej)
+   !!                      so that iceberg does not exist in more than one processor
+   !!                   -  North fold exchanges controlled by three arrays:
+   !!                         nicbflddest - unique processor numbers that current one exchanges with
+   !!                         nicbfldproc - processor number that current grid point exchanges with
+   !!                         nicbfldpts  - packed i,j point in exchanging processor
+   !!----------------------------------------------------------------------
+
+   USE par_oce                             ! ocean parameters
+   USE dom_oce                             ! ocean domain
+   USE in_out_manager                      ! IO parameters
+   USE lib_mpp                             ! MPI code and lk_mpp in particular
+   USE icb_oce                             ! define iceberg arrays
+   USE icbutl                              ! iceberg utility routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+#if defined key_mpp_mpi
+
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+
+   TYPE, PUBLIC :: buffer
+      INTEGER :: size=0
+      REAL(wp), DIMENSION(:,:), POINTER :: data
+   END TYPE buffer
+
+   TYPE(buffer), POINTER           ::   obuffer_n=>NULL() , ibuffer_n=>NULL()
+   TYPE(buffer), POINTER           ::   obuffer_s=>NULL() , ibuffer_s=>NULL()
+   TYPE(buffer), POINTER           ::   obuffer_e=>NULL() , ibuffer_e=>NULL()
+   TYPE(buffer), POINTER           ::   obuffer_w=>NULL() , ibuffer_w=>NULL()
+
+   ! north fold exchange buffers
+   TYPE(buffer), POINTER           ::   obuffer_f=>NULL() , ibuffer_f=>NULL()
+
+   INTEGER, PARAMETER, PRIVATE     ::   jp_delta_buf = 25             ! Size by which to increment buffers
+   INTEGER, PARAMETER, PRIVATE     ::   jp_buffer_width = 15+nkounts  ! items to store for each berg
+
+#endif
+
+   PUBLIC   icb_lbc
+   PUBLIC   icb_lbc_mpp
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_lbc()
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE icb_lbc  ***
+      !!
+      !! ** Purpose :   in non-mpp case need to deal with cyclic conditions
+      !!                including north-fold
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER ::   this
+      TYPE(point)  , POINTER ::   pt
+      INTEGER                ::   iine
+      !!----------------------------------------------------------------------
+
+      !! periodic east/west boundaries
+      !! =============================
+
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+
+         this => first_berg
+         DO WHILE( ASSOCIATED(this) )
+            pt => this%current_point
+            iine = INT( pt%xi + 0.5 )
+            IF( iine > mig(nicbei) ) THEN
+               pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp
+            ELSE IF( iine < mig(nicbdi) ) THEN
+               pt%xi = ricb_left + MOD(pt%xi, 1._wp )
+            ENDIF
+            this => this%next
+         END DO
+         !
+      ENDIF
+
+      !! north/south boundaries
+      !! ======================
+      ! south symmetric
+      IF( nperio == 2 )   CALL ctl_stop(' south symmetric condition not implemented for icebergs')
+      ! north fold
+      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   CALL icb_lbc_nfld()
+      !
+   END SUBROUTINE icb_lbc
+
+
+   SUBROUTINE icb_lbc_nfld()
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE icb_lbc_nfld  ***
+      !!
+      !! ** Purpose :   single processor north fold exchange
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER ::   this
+      TYPE(point)  , POINTER ::   pt
+      INTEGER                ::   iine, ijne, ipts
+      INTEGER                ::   iiglo, ijglo
+      !!----------------------------------------------------------------------
+      !
+      this => first_berg
+      DO WHILE( ASSOCIATED(this) )
+         pt => this%current_point
+         ijne = INT( pt%yj + 0.5 )
+         IF( ijne .GT. mjg(nicbej) ) THEN
+            !
+            iine = INT( pt%xi + 0.5 )
+            ipts  = nicbfldpts (mi1(iine))
+            !
+            ! moving across the cut line means both position and
+            ! velocity must change
+            ijglo = INT( ipts/nicbpack )
+            iiglo = ipts - nicbpack*ijglo
+            pt%xi = iiglo - ( pt%xi - REAL(iine,wp) )
+            pt%yj = ijglo - ( pt%yj - REAL(ijne,wp) )
+            pt%uvel = -1._wp * pt%uvel
+            pt%vvel = -1._wp * pt%vvel
+         ENDIF
+         this => this%next
+      END DO
+      !
+   END SUBROUTINE icb_lbc_nfld
+
+#if defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE icb_lbc_mpp()
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE icb_lbc_mpp  ***
+      !!
+      !! ** Purpose :   multi processor exchange
+      !!
+      !! ** Method  :   identify direction for exchange, pack into a buffer
+      !!                which is basically a real array and delete from linked list
+      !!                length of buffer is exchanged first with receiving processor
+      !!                then buffer is sent if necessary
+      !!----------------------------------------------------------------------
+      TYPE(iceberg)         , POINTER     ::   tmpberg, this
+      TYPE(point)           , POINTER     ::   pt
+      INTEGER                             ::   ibergs_to_send_e, ibergs_to_send_w
+      INTEGER                             ::   ibergs_to_send_n, ibergs_to_send_s
+      INTEGER                             ::   ibergs_rcvd_from_e, ibergs_rcvd_from_w
+      INTEGER                             ::   ibergs_rcvd_from_n, ibergs_rcvd_from_s
+      INTEGER                             ::   i, ibergs_start, ibergs_end
+      INTEGER                             ::   iine, ijne
+      INTEGER                             ::   ipe_N, ipe_S, ipe_W, ipe_E
+      REAL(wp), DIMENSION(2)              ::   zewbergs, zwebergs, znsbergs, zsnbergs
+      INTEGER                             ::   iml_req1, iml_req2, iml_req3, iml_req4
+      INTEGER                             ::   iml_req5, iml_req6, iml_req7, iml_req8, iml_err
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   iml_stat
+
+      ! set up indices of neighbouring processors
+      ipe_N = -1
+      ipe_S = -1
+      ipe_W = -1
+      ipe_E = -1
+      IF( nbondi .EQ.  0 .OR. nbondi .EQ. 1) ipe_W = nowe
+      IF( nbondi .EQ. -1 .OR. nbondi .EQ. 0) ipe_E = noea
+      IF( nbondj .EQ.  0 .OR. nbondj .EQ. 1) ipe_S = noso
+      IF( nbondj .EQ. -1 .OR. nbondj .EQ. 0) ipe_N = nono
+      !
+      ! at northern line of processors with north fold handle bergs differently
+      IF( npolj > 0 ) ipe_N = -1
+
+      ! if there's only one processor in x direction then don't let mpp try to handle periodicity
+      IF( jpni == 1 ) THEN
+         ipe_E = -1
+         ipe_W = -1
+      ENDIF
+
+      IF( nn_verbose_level >= 2 ) THEN
+         WRITE(numicb,*) 'processor west  : ', ipe_W
+         WRITE(numicb,*) 'processor east  : ', ipe_E
+         WRITE(numicb,*) 'processor north : ', ipe_N
+         WRITE(numicb,*) 'processor south : ', ipe_S
+         WRITE(numicb,*) 'processor nimpp : ', nimpp
+         WRITE(numicb,*) 'processor njmpp : ', njmpp
+         WRITE(numicb,*) 'processor nbondi: ', nbondi
+         WRITE(numicb,*) 'processor nbondj: ', nbondj
+         CALL flush( numicb )
+      ENDIF
+
+      ! periodicity is handled here when using mpp when there is more than one processor in
+      ! the i direction, but it also has to happen when jpni=1 case so this is dealt with
+      ! in icb_lbc and called here
+
+      IF( jpni == 1 ) CALL icb_lbc()
+
+      ! Note that xi is adjusted when swapping because of periodic condition
+
+      IF( nn_verbose_level > 0 ) THEN
+         ! store the number of icebergs on this processor at start
+         ibergs_start = icb_utl_count()
+      ENDIF
+
+      ibergs_to_send_e   = 0
+      ibergs_to_send_w   = 0
+      ibergs_to_send_n   = 0
+      ibergs_to_send_s   = 0
+      ibergs_rcvd_from_e = 0
+      ibergs_rcvd_from_w = 0
+      ibergs_rcvd_from_n = 0
+      ibergs_rcvd_from_s = 0
+
+      IF( ASSOCIATED(first_berg) ) THEN      ! Find number of bergs that headed east/west
+         this => first_berg
+         DO WHILE (ASSOCIATED(this))
+            pt => this%current_point
+            iine = INT( pt%xi + 0.5 )
+            IF( ipe_E >= 0 .AND. iine > mig(nicbei) ) THEN
+               tmpberg => this
+               this => this%next
+               ibergs_to_send_e = ibergs_to_send_e + 1
+               IF( nn_verbose_level >= 4 ) THEN
+                  WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to east'
+                  CALL flush( numicb )
+               ENDIF
+               ! deal with periodic case
+               tmpberg%current_point%xi = ricb_right + MOD(tmpberg%current_point%xi, 1._wp ) - 1._wp
+               ! now pack it into buffer and delete from list
+               CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e)
+               CALL icb_utl_delete(first_berg, tmpberg)
+            ELSE IF( ipe_W >= 0 .AND. iine < mig(nicbdi) ) THEN
+               tmpberg => this
+               this => this%next
+               ibergs_to_send_w = ibergs_to_send_w + 1
+               IF( nn_verbose_level >= 4 ) THEN
+                  WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to west'
+                  CALL flush( numicb )
+               ENDIF
+               ! deal with periodic case
+               tmpberg%current_point%xi = ricb_left + MOD(tmpberg%current_point%xi, 1._wp )
+               ! now pack it into buffer and delete from list
+               CALL icb_pack_into_buffer( tmpberg, obuffer_w, ibergs_to_send_w)
+               CALL icb_utl_delete(first_berg, tmpberg)
+            ELSE
+               this => this%next
+            ENDIF
+         END DO
+      ENDIF
+      IF( nn_verbose_level >= 3) THEN
+         WRITE(numicb,*) 'bergstep ',nktberg,' send ew: ', ibergs_to_send_e, ibergs_to_send_w
+         CALL flush(numicb)
+      ENDIF
+
+      ! send bergs east and receive bergs from west (ie ones that were sent east) and vice versa
+
+      ! pattern here is copied from lib_mpp code
+
+      SELECT CASE ( nbondi )
+      CASE( -1 )
+         zwebergs(1) = ibergs_to_send_e
+         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req1)
+         CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
+         IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
+         ibergs_rcvd_from_e = INT( zewbergs(2) )
+      CASE(  0 )
+         zewbergs(1) = ibergs_to_send_w
+         zwebergs(1) = ibergs_to_send_e
+         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2)
+         CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3)
+         CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
+         CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
+         IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+         IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
+         ibergs_rcvd_from_e = INT( zewbergs(2) )
+         ibergs_rcvd_from_w = INT( zwebergs(2) )
+      CASE(  1 )
+         zewbergs(1) = ibergs_to_send_w
+         CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req4)
+         CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
+         IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
+         ibergs_rcvd_from_w = INT( zwebergs(2) )
+      END SELECT
+      IF( nn_verbose_level >= 3) THEN
+         WRITE(numicb,*) 'bergstep ',nktberg,' recv ew: ', ibergs_rcvd_from_w, ibergs_rcvd_from_e
+         CALL flush(numicb)
+      ENDIF
+
+      SELECT CASE ( nbondi )
+      CASE( -1 )
+         IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req1 )
+         IF( ibergs_rcvd_from_e > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e)
+            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width )
+         ENDIF
+         IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
+         DO i = 1, ibergs_rcvd_from_e
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i)
+         ENDDO
+      CASE(  0 )
+         IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 )
+         IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 )
+         IF( ibergs_rcvd_from_e > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e)
+            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width )
+         ENDIF
+         IF( ibergs_rcvd_from_w > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w)
+            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width )
+         ENDIF
+         IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+         IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
+         DO i = 1, ibergs_rcvd_from_e
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i)
+         END DO
+         DO i = 1, ibergs_rcvd_from_w
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i)
+         ENDDO
+      CASE(  1 )
+         IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req4 )
+         IF( ibergs_rcvd_from_w > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w)
+            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width )
+         ENDIF
+         IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
+         DO i = 1, ibergs_rcvd_from_w
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i)
+         END DO
+      END SELECT
+
+      ! Find number of bergs that headed north/south
+      ! (note: this block should technically go ahead of the E/W recv block above
+      !  to handle arbitrary orientation of PEs. But for simplicity, it is
+      !  here to accomodate diagonal transfer of bergs between PEs -AJA)
+
+      IF( ASSOCIATED(first_berg) ) THEN
+         this => first_berg
+         DO WHILE (ASSOCIATED(this))
+            pt => this%current_point
+            ijne = INT( pt%yj + 0.5 )
+            IF( ipe_N >= 0 .AND. ijne .GT. mjg(nicbej) ) THEN
+               tmpberg => this
+               this => this%next
+               ibergs_to_send_n = ibergs_to_send_n + 1
+               IF( nn_verbose_level >= 4 ) THEN
+                  WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to north'
+                  CALL flush( numicb )
+               ENDIF
+               CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n)
+               CALL icb_utl_delete(first_berg, tmpberg)
+            ELSE IF( ipe_S >= 0 .AND. ijne .LT. mjg(nicbdj) ) THEN
+               tmpberg => this
+               this => this%next
+               ibergs_to_send_s = ibergs_to_send_s + 1
+               IF( nn_verbose_level >= 4 ) THEN
+                  WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to south'
+                  CALL flush( numicb )
+               ENDIF
+               CALL icb_pack_into_buffer( tmpberg, obuffer_s, ibergs_to_send_s)
+               CALL icb_utl_delete(first_berg, tmpberg)
+            ELSE
+               this => this%next
+            ENDIF
+         END DO
+      ENDIF
+      if( nn_verbose_level >= 3) then
+         write(numicb,*) 'bergstep ',nktberg,' send ns: ', ibergs_to_send_n, ibergs_to_send_s
+         call flush(numicb)
+      endif
+
+      ! send bergs north
+      ! and receive bergs from south (ie ones sent north)
+
+      SELECT CASE ( nbondj )
+      CASE( -1 )
+         zsnbergs(1) = ibergs_to_send_n
+         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req1)
+         CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
+         IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
+         ibergs_rcvd_from_n = INT( znsbergs(2) )
+      CASE(  0 )
+         znsbergs(1) = ibergs_to_send_s
+         zsnbergs(1) = ibergs_to_send_n
+         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2)
+         CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3)
+         CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
+         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
+         IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+         IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
+         ibergs_rcvd_from_n = INT( znsbergs(2) )
+         ibergs_rcvd_from_s = INT( zsnbergs(2) )
+      CASE(  1 )
+         znsbergs(1) = ibergs_to_send_s
+         CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req4)
+         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
+         IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
+         ibergs_rcvd_from_s = INT( zsnbergs(2) )
+      END SELECT
+      if( nn_verbose_level >= 3) then
+         write(numicb,*) 'bergstep ',nktberg,' recv ns: ', ibergs_rcvd_from_s, ibergs_rcvd_from_n
+         call flush(numicb)
+      endif
+
+      SELECT CASE ( nbondj )
+      CASE( -1 )
+         IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req1 )
+         IF( ibergs_rcvd_from_n > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n)
+            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width )
+         ENDIF
+         IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
+         DO i = 1, ibergs_rcvd_from_n
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i)
+         END DO
+      CASE(  0 )
+         IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 )
+         IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 )
+         IF( ibergs_rcvd_from_n > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n)
+            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width )
+         ENDIF
+         IF( ibergs_rcvd_from_s > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s)
+            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width )
+         ENDIF
+         IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+         IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
+         DO i = 1, ibergs_rcvd_from_n
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i)
+         END DO
+         DO i = 1, ibergs_rcvd_from_s
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i)
+         ENDDO
+      CASE(  1 )
+         IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req4 )
+         IF( ibergs_rcvd_from_s > 0 ) THEN
+            CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s)
+            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width )
+         ENDIF
+         IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
+         DO i = 1, ibergs_rcvd_from_s
+            IF( nn_verbose_level >= 4 ) THEN
+               WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south'
+               CALL flush( numicb )
+            ENDIF
+            CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i)
+         END DO
+      END SELECT
+
+      IF( nn_verbose_level > 0 ) THEN
+         ! compare the number of icebergs on this processor from the start to the end
+         ibergs_end = icb_utl_count()
+         i = ( ibergs_rcvd_from_n + ibergs_rcvd_from_s + ibergs_rcvd_from_e + ibergs_rcvd_from_w ) - &
+             ( ibergs_to_send_n + ibergs_to_send_s + ibergs_to_send_e + ibergs_to_send_w )
+         IF( ibergs_end-(ibergs_start+i) .NE. 0 ) THEN
+            WRITE( numicb,*   ) 'send_bergs_to_other_pes: net change in number of icebergs'
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_end=', &
+                                ibergs_end,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_start=', &
+                                ibergs_start,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: delta=', &
+                                i,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: error=', &
+                                ibergs_end-(ibergs_start+i),' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_to_send_n=', &
+                                ibergs_to_send_n,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_to_send_s=', &
+                                ibergs_to_send_s,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_to_send_e=', &
+                                ibergs_to_send_e,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_to_send_w=', &
+                                ibergs_to_send_w,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_rcvd_from_n=', &
+                                ibergs_rcvd_from_n,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_rcvd_from_s=', &
+                                ibergs_rcvd_from_s,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_rcvd_from_e=', &
+                                ibergs_rcvd_from_e,' on PE',narea
+            WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_rcvd_from_w=', &
+                                ibergs_rcvd_from_w,' on PE',narea
+  1000      FORMAT(a,i5,a,i4)
+            CALL ctl_stop('send_bergs_to_other_pes: lost or gained an iceberg or two')
+         ENDIF
+      ENDIF
+
+      ! deal with north fold if we necessary when there is more than one top row processor
+      ! note that for jpni=1 north fold has been dealt with above in call to icb_lbc
+      IF( npolj /= 0 .AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( )
+
+      IF( nn_verbose_level > 0 ) THEN
+         i = 0
+         this => first_berg
+         DO WHILE (ASSOCIATED(this))
+            pt => this%current_point
+            iine = INT( pt%xi + 0.5 )
+            ijne = INT( pt%yj + 0.5 )
+            IF( iine .LT. mig(nicbdi) .OR. &
+                iine .GT. mig(nicbei) .OR. &
+                ijne .LT. mjg(nicbdj) .OR. &
+                ijne .GT. mjg(nicbej)) THEN
+               i = i + 1
+               WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne
+               WRITE(numicb,*) '                   ', nimpp, njmpp
+               WRITE(numicb,*) '                   ', nicbdi, nicbei, nicbdj, nicbej
+               CALL flush( numicb )
+            ENDIF
+            this => this%next
+         ENDDO ! WHILE
+         CALL mpp_sum(i)
+         IF( i .GT. 0 ) THEN
+            WRITE( numicb,'(a,i4)') 'send_bergs_to_other_pes: # of bergs outside computational domain = ',i
+            CALL ctl_stop('send_bergs_to_other_pes:  there are bergs still in halos!')
+         ENDIF ! root_pe
+      ENDIF ! debug
+      !
+      CALL mppsync()
+      !
+   END SUBROUTINE icb_lbc_mpp
+
+
+   SUBROUTINE icb_lbc_mpp_nfld()
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE icb_lbc_mpp_nfld  ***
+      !!
+      !! ** Purpose :   north fold treatment in multi processor exchange
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      TYPE(iceberg)         , POINTER     :: tmpberg, this
+      TYPE(point)           , POINTER     :: pt
+      INTEGER                             :: ibergs_to_send
+      INTEGER                             :: ibergs_to_rcv
+      INTEGER                             :: iiglo, ijglo, jk, jn
+      INTEGER                             :: ifldproc, iproc, ipts
+      INTEGER                             :: iine, ijne
+      INTEGER                             :: jjn
+      REAL(wp), DIMENSION(0:3)            :: zsbergs, znbergs
+      INTEGER                             :: iml_req1, iml_req2, iml_err
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) :: iml_stat
+
+      ! set up indices of neighbouring processors
+
+      ! nicbfldproc is a list of unique processor numbers that this processor
+      ! exchanges with (including itself), so we loop over this array; since
+      ! its of fixed size, the first -1 marks end of list of processors
+      !
+      nicbfldnsend(:) = 0
+      nicbfldexpect(:) = 0
+      nicbfldreq(:) = 0
+      !
+      ! Since each processor may be communicating with more than one northern
+      ! neighbour, cycle through the sends so that the receive order can be
+      ! controlled.
+      !
+      ! First compute how many icebergs each active neighbour should expect
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            nicbfldnsend(jn) = 0
+
+            ! Find number of bergs that need to be exchanged
+            ! Pick out exchanges with processor ifldproc
+            ! if ifldproc is this processor then don't send
+            !
+            IF( ASSOCIATED(first_berg) ) THEN
+               this => first_berg
+               DO WHILE (ASSOCIATED(this))
+                  pt => this%current_point
+                  iine = INT( pt%xi + 0.5 )
+                  ijne = INT( pt%yj + 0.5 )
+                  iproc = nicbflddest(mi1(iine))
+                  IF( ijne .GT. mjg(nicbej) ) THEN
+                     IF( iproc == ifldproc ) THEN
+                        !
+                        IF( iproc /= narea ) THEN
+                           tmpberg => this
+                           nicbfldnsend(jn) = nicbfldnsend(jn) + 1
+                        ENDIF
+                        !
+                     ENDIF
+                  ENDIF
+                  this => this%next
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
+      END DO
+      !
+      ! Now tell each active neighbour how many icebergs to expect
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+   
+            zsbergs(0) = narea
+            zsbergs(1) = nicbfldnsend(jn)
+            !IF ( nicbfldnsend(jn) .GT. 0) write(numicb,*) 'ICB sending ',nicbfldnsend(jn),' to ', ifldproc
+            CALL mppsend( 21, zsbergs(0:1), 2, ifldproc-1, nicbfldreq(jn))
+         ENDIF
+         !
+      END DO
+      !
+      ! and receive the heads-up from active neighbours preparing to send
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+
+            CALL mpprecv( 21, znbergs(1:2), 2 )
+            DO jjn = 1,jpni
+             IF( nicbfldproc(jjn) .eq. INT(znbergs(1)) ) EXIT
+            END DO
+            IF( jjn .GT. jpni ) write(numicb,*) 'ICB ERROR'
+            nicbfldexpect(jjn) = INT( znbergs(2) )
+            !IF ( nicbfldexpect(jjn) .GT. 0) write(numicb,*) 'ICB expecting ',nicbfldexpect(jjn),' from ', nicbfldproc(jjn)
+            !CALL FLUSH(numicb)
+         ENDIF
+         !
+      END DO
+      !
+      ! post the mpi waits if using immediate send protocol
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+
+            IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err )
+         ENDIF
+         !
+      END DO
+   
+         !
+         ! Cycle through the icebergs again, this time packing and sending any
+         ! going through the north fold. They will be expected.
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            ibergs_to_send = 0
+   
+            ! Find number of bergs that need to be exchanged
+            ! Pick out exchanges with processor ifldproc
+            ! if ifldproc is this processor then don't send
+            !
+            IF( ASSOCIATED(first_berg) ) THEN
+               this => first_berg
+               DO WHILE (ASSOCIATED(this))
+                  pt => this%current_point
+                  iine = INT( pt%xi + 0.5 )
+                  ijne = INT( pt%yj + 0.5 )
+                  ipts  = nicbfldpts (mi1(iine))
+                  iproc = nicbflddest(mi1(iine))
+                  IF( ijne .GT. mjg(nicbej) ) THEN
+                     IF( iproc == ifldproc ) THEN
+                        !
+                        ! moving across the cut line means both position and
+                        ! velocity must change
+                        ijglo = INT( ipts/nicbpack )
+                        iiglo = ipts - nicbpack*ijglo
+                        pt%xi = iiglo - ( pt%xi - REAL(iine,wp) )
+                        pt%yj = ijglo - ( pt%yj - REAL(ijne,wp) )
+                        pt%uvel = -1._wp * pt%uvel
+                        pt%vvel = -1._wp * pt%vvel
+                        !
+                        ! now remove berg from list and pack it into a buffer
+                        IF( iproc /= narea ) THEN
+                           tmpberg => this
+                           ibergs_to_send = ibergs_to_send + 1
+                           IF( nn_verbose_level >= 4 ) THEN
+                              WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for north fold'
+                              CALL flush( numicb )
+                           ENDIF
+                           CALL icb_pack_into_buffer( tmpberg, obuffer_f, ibergs_to_send)
+                           CALL icb_utl_delete(first_berg, tmpberg)
+                        ENDIF
+                        !
+                     ENDIF
+                  ENDIF
+                  this => this%next
+               END DO
+            ENDIF
+            if( nn_verbose_level >= 3) then
+               write(numicb,*) 'bergstep ',nktberg,' send nfld: ', ibergs_to_send
+               call flush(numicb)
+            endif
+            !
+            ! if we're in this processor, then we've done everything we need to
+            ! so go on to next element of loop
+            IF( ifldproc == narea ) CYCLE
+   
+            ! send bergs
+   
+            IF( ibergs_to_send > 0 )  &
+                CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, nicbfldreq(jn) )
+            !
+         ENDIF
+         !
+      END DO
+      !
+      ! Now receive the expected number of bergs from the active neighbours
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+            ibergs_to_rcv = nicbfldexpect(jn)
+
+            IF( ibergs_to_rcv  > 0 ) THEN
+               CALL icb_increase_ibuffer(ibuffer_f, ibergs_to_rcv)
+               CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width, ifldproc-1 )
+            ENDIF
+            !
+            DO jk = 1, ibergs_to_rcv
+               IF( nn_verbose_level >= 4 ) THEN
+                  WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_f%data(16,jk)),' from north fold'
+                  CALL flush( numicb )
+               ENDIF
+               CALL icb_unpack_from_buffer(first_berg, ibuffer_f, jk )
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+      ! Finally post the mpi waits if using immediate send protocol
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+
+            IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err )
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE icb_lbc_mpp_nfld
+
+
+   SUBROUTINE icb_pack_into_buffer( berg, pbuff, kb )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER :: berg
+      TYPE(buffer) , POINTER :: pbuff
+      INTEGER               , INTENT(in) :: kb
+      ! 
+      INTEGER ::   k   ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ASSOCIATED(pbuff) ) CALL icb_increase_buffer( pbuff, jp_delta_buf )
+      IF( kb .GT. pbuff%size ) CALL icb_increase_buffer( pbuff, jp_delta_buf )
+
+      !! pack points into buffer
+
+      pbuff%data( 1,kb) = berg%current_point%lon
+      pbuff%data( 2,kb) = berg%current_point%lat
+      pbuff%data( 3,kb) = berg%current_point%uvel
+      pbuff%data( 4,kb) = berg%current_point%vvel
+      pbuff%data( 5,kb) = berg%current_point%xi
+      pbuff%data( 6,kb) = berg%current_point%yj
+      pbuff%data( 7,kb) = float(berg%current_point%year)
+      pbuff%data( 8,kb) = berg%current_point%day
+      pbuff%data( 9,kb) = berg%current_point%mass
+      pbuff%data(10,kb) = berg%current_point%thickness
+      pbuff%data(11,kb) = berg%current_point%width
+      pbuff%data(12,kb) = berg%current_point%length
+      pbuff%data(13,kb) = berg%current_point%mass_of_bits
+      pbuff%data(14,kb) = berg%current_point%heat_density
+
+      pbuff%data(15,kb) = berg%mass_scaling
+      DO k=1,nkounts
+         pbuff%data(15+k,kb) = REAL( berg%number(k), wp )
+      END DO
+      !
+   END SUBROUTINE icb_pack_into_buffer
+
+
+   SUBROUTINE icb_unpack_from_buffer(first, pbuff, kb)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      TYPE(iceberg),             POINTER :: first
+      TYPE(buffer) ,             POINTER :: pbuff
+      INTEGER      , INTENT(in)          :: kb
+      ! 
+      TYPE(iceberg)                      :: currentberg
+      TYPE(point)                        :: pt
+      INTEGER                            :: ik
+      !!----------------------------------------------------------------------
+      !
+      pt%lon            =      pbuff%data( 1,kb)
+      pt%lat            =      pbuff%data( 2,kb)
+      pt%uvel           =      pbuff%data( 3,kb)
+      pt%vvel           =      pbuff%data( 4,kb)
+      pt%xi             =      pbuff%data( 5,kb)
+      pt%yj             =      pbuff%data( 6,kb)
+      pt%year           = INT( pbuff%data( 7,kb) )
+      pt%day            =      pbuff%data( 8,kb)
+      pt%mass           =      pbuff%data( 9,kb)
+      pt%thickness      =      pbuff%data(10,kb)
+      pt%width          =      pbuff%data(11,kb)
+      pt%length         =      pbuff%data(12,kb)
+      pt%mass_of_bits   =      pbuff%data(13,kb)
+      pt%heat_density   =      pbuff%data(14,kb)
+
+      currentberg%mass_scaling =      pbuff%data(15,kb)
+      DO ik = 1, nkounts
+         currentberg%number(ik) = INT( pbuff%data(15+ik,kb) )
+      END DO
+      !
+      CALL icb_utl_add(currentberg, pt )
+      !
+   END SUBROUTINE icb_unpack_from_buffer
+
+
+   SUBROUTINE icb_increase_buffer(old,kdelta)
+      !!----------------------------------------------------------------------
+      TYPE(buffer), POINTER    :: old
+      INTEGER     , INTENT(in) :: kdelta
+      ! 
+      TYPE(buffer), POINTER ::   new
+      INTEGER ::   inew_size
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ASSOCIATED(old) ) THEN   ;   inew_size = kdelta
+      ELSE                               ;   inew_size = old%size + kdelta
+      ENDIF
+      ALLOCATE( new )
+      ALLOCATE( new%data( jp_buffer_width, inew_size) )
+      new%size = inew_size
+      IF( ASSOCIATED(old) ) THEN
+         new%data(:,1:old%size) = old%data(:,1:old%size)
+         DEALLOCATE(old%data)
+         DEALLOCATE(old)
+      ENDIF
+      old => new
+      !
+   END SUBROUTINE icb_increase_buffer
+
+
+   SUBROUTINE icb_increase_ibuffer(old,kdelta)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      TYPE(buffer),            POINTER :: old
+      INTEGER     , INTENT(in)         :: kdelta
+      !
+      TYPE(buffer),            POINTER :: new
+      INTEGER                          :: inew_size, iold_size
+      !!----------------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(old) ) THEN
+         inew_size = kdelta + jp_delta_buf
+         iold_size = 0
+      ELSE
+         iold_size = old%size
+         IF( kdelta .LT. old%size ) THEN
+            inew_size = old%size + kdelta
+         ELSE
+            inew_size = kdelta + jp_delta_buf
+         ENDIF
+      ENDIF
+
+      IF( iold_size .NE. inew_size ) THEN
+         ALLOCATE( new )
+         ALLOCATE( new%data( jp_buffer_width, inew_size) )
+         new%size = inew_size
+         IF( ASSOCIATED(old) ) THEN
+            new%data(:,1:old%size) = old%data(:,1:old%size)
+            DEALLOCATE(old%data)
+            DEALLOCATE(old)
+         ENDIF
+         old => new
+        !WRITE( numicb,*) 'icb_increase_ibuffer',narea,' increased to',inew_size
+      ENDIF
+      !
+   END SUBROUTINE icb_increase_ibuffer
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+   SUBROUTINE icb_lbc_mpp()
+      WRITE(numout,*) 'icb_lbc_mpp: You should not have seen this message!!'
+   END SUBROUTINE icb_lbc_mpp
+
+#endif
+
+   !!======================================================================
+END MODULE icblbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90	(revision 8732)
@@ -0,0 +1,363 @@
+MODULE icbrst
+
+   !!======================================================================
+   !!                       ***  MODULE  icbrst  ***
+   !! Ocean physics:  read and write iceberg restart files
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!            -    !  2011-04  (Alderson)       Restore restart routine
+   !!            -    !                            Currently needs a fixed processor
+   !!            -    !                            layout between restarts
+   !!            -    !  2015-11  Dave Storkey     Convert icb_rst_read to use IOM so can
+   !!                                              read single restart files
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_rst_read    : read restart file
+   !!   icb_rst_write   : write restart file
+   !!----------------------------------------------------------------------
+   USE par_oce        ! NEMO parameters
+   USE dom_oce        ! NEMO domain
+   USE in_out_manager ! NEMO IO routines
+   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
+   USE netcdf         ! netcdf routines for IO
+   USE iom
+   USE icb_oce        ! define iceberg arrays
+   USE icbutl         ! iceberg utility routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_rst_read    ! routine called in icbini.F90 module
+   PUBLIC   icb_rst_write   ! routine called in icbstp.F90 module
+   
+   INTEGER ::   nlonid, nlatid, nxid, nyid, nuvelid, nvvelid
+   INTEGER ::   nmassid, nthicknessid, nwidthid, nlengthid
+   INTEGER ::   nyearid, ndayid
+   INTEGER ::   nscaling_id, nmass_of_bits_id, nheat_density_id, numberid
+   INTEGER ::   nsiceid, nsheatid, ncalvid, ncalvhid, nkountid
+   INTEGER ::   nret, ncid, nc_dim
+   
+   INTEGER,  DIMENSION(3)                  :: nstrt3, nlngth3
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_rst_read()
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE icb_rst_read  ***
+      !!
+      !! ** Purpose :   read a iceberg restart file
+      !!      NB: for this version, we just read back in the restart for this processor
+      !!      so we cannot change the processor layout currently with iceberg code
+      !!----------------------------------------------------------------------
+      INTEGER                      ::   idim, ivar, iatt
+      INTEGER                      ::   jn, iunlim_dim, ibergs_in_file
+      INTEGER                      ::   ii,ij,iclass
+      REAL(wp), DIMENSION(nkounts) ::   zdata      
+      LOGICAL                      ::   ll_found_restart
+      CHARACTER(len=256)           ::   cl_path
+      CHARACTER(len=256)           ::   cl_filename
+      CHARACTER(len=NF90_MAX_NAME) ::   cl_dname
+      TYPE(iceberg)                ::   localberg ! NOT a pointer but an actual local variable
+      TYPE(point)                  ::   localpt   ! NOT a pointer but an actual local variable
+      !!----------------------------------------------------------------------
+
+      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts
+      ! and are called TRIM(cn_ocerst)//'_icebergs'
+      cl_path = TRIM(cn_ocerst_indir)
+      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
+      cl_filename = TRIM(cn_ocerst_in)//'_icebergs'
+      CALL iom_open( TRIM(cl_path)//cl_filename, ncid )
+
+      IF( iom_file(ncid)%iduld .GE. 0) THEN
+
+         ibergs_in_file = iom_file(ncid)%lenuld
+         DO jn = 1,ibergs_in_file
+
+            ! iom_get treats the unlimited dimension as time. Here the unlimited dimension 
+            ! is the iceberg index, but we can still use the ktime keyword to get the iceberg we want. 
+
+            CALL iom_get( ncid, 'xi'     ,localpt%xi  , ktime=jn )
+            CALL iom_get( ncid, 'yj'     ,localpt%yj  , ktime=jn )
+
+            ii = INT( localpt%xi + 0.5 )
+            ij = INT( localpt%yj + 0.5 )
+            ! Only proceed if this iceberg is on the local processor (excluding halos).
+            IF ( ii .GE. nldi+nimpp-1 .AND. ii .LE. nlei+nimpp-1 .AND. &
+           &     ij .GE. nldj+njmpp-1 .AND. ij .LE. nlej+njmpp-1 ) THEN           
+
+               CALL iom_get( ncid, jpdom_unknown, 'number'       , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) )
+               localberg%number(:) = INT(zdata(:))
+               CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn )
+               CALL iom_get( ncid, 'lon'          , localpt%lon           , ktime=jn )
+               CALL iom_get( ncid, 'lat'          , localpt%lat           , ktime=jn )
+               CALL iom_get( ncid, 'uvel'         , localpt%uvel          , ktime=jn )
+               CALL iom_get( ncid, 'vvel'         , localpt%vvel          , ktime=jn )
+               CALL iom_get( ncid, 'mass'         , localpt%mass          , ktime=jn )
+               CALL iom_get( ncid, 'thickness'    , localpt%thickness     , ktime=jn )
+               CALL iom_get( ncid, 'width'        , localpt%width         , ktime=jn )
+               CALL iom_get( ncid, 'length'       , localpt%length        , ktime=jn )
+               CALL iom_get( ncid, 'year'         , zdata(1)              , ktime=jn )
+               localpt%year = INT(zdata(1))
+               CALL iom_get( ncid, 'day'          , localpt%day           , ktime=jn )
+               CALL iom_get( ncid, 'mass_of_bits' , localpt%mass_of_bits  , ktime=jn )
+               CALL iom_get( ncid, 'heat_density' , localpt%heat_density  , ktime=jn )
+
+               !
+               CALL icb_utl_add( localberg, localpt )
+
+            ENDIF
+
+         END DO
+
+      ENDIF 
+
+      ! Gridded variables
+      CALL iom_get( ncid, jpdom_autoglo,    'calving'     , src_calving  )
+      CALL iom_get( ncid, jpdom_autoglo,    'calving_hflx', src_calving_hflx  )
+      CALL iom_get( ncid, jpdom_autoglo,    'stored_heat' , berg_grid%stored_heat  )
+      CALL iom_get( ncid, jpdom_autoglo_xy, 'stored_ice'  , berg_grid%stored_ice, kstart=(/1,1,1/), kcount=(/1,1,nclasses/) )
+      
+      CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) )
+      num_bergs(:) = INT(zdata(:))
+
+      ! Sanity check
+      jn = icb_utl_count()
+      IF (nn_verbose_level >= 0)   &
+         WRITE(numout,'(2(a,i5))') 'icebergs, read_restart_bergs: # bergs =',jn,' on PE',narea-1
+      IF( lk_mpp ) THEN
+         ! Only mpp_sum ibergs_in_file if we are reading from multiple restart files. 
+         IF( INDEX(iom_file(ncid)%name,'icebergs.nc' ) .EQ. 0 ) CALL mpp_sum(ibergs_in_file)
+         CALL mpp_sum(jn)
+      ENDIF
+      IF(lwp)   WRITE(numout,'(a,i5,a,i5,a)') 'icebergs, read_restart_bergs: there were',ibergs_in_file,   &
+         &                                    ' bergs in the restart file and', jn,' bergs have been read'
+      !
+      ! Finish up
+      CALL iom_close( ncid )
+      !
+      IF( lwp .and. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed'
+      !
+   END SUBROUTINE icb_rst_read
+
+
+   SUBROUTINE icb_rst_write( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE icb_rst_write  ***
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt
+      !
+      INTEGER ::   jn   ! dummy loop index
+      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim
+      CHARACTER(len=256)     :: cl_path
+      CHARACTER(len=256)     :: cl_filename
+      TYPE(iceberg), POINTER :: this
+      TYPE(point)  , POINTER :: pt
+      !!----------------------------------------------------------------------
+
+      ! Assume we write iceberg restarts to same directory as ocean restarts.
+      cl_path = TRIM(cn_ocerst_outdir)
+      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
+      IF( lk_mpp ) THEN
+         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1
+      ELSE
+         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt
+      ENDIF
+      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename)
+
+      nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid)
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed')
+
+      ! Dimensions
+      nret = NF90_DEF_DIM(ncid, 'x', jpi, ix_dim)
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim x failed')
+
+      nret = NF90_DEF_DIM(ncid, 'y', jpj, iy_dim)
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim y failed')
+
+      nret = NF90_DEF_DIM(ncid, 'c', nclasses, nc_dim)
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim c failed')
+
+      nret = NF90_DEF_DIM(ncid, 'k', nkounts, ik_dim)
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim k failed')
+
+      ! global attributes
+      IF( lk_mpp ) THEN
+         ! Set domain parameters (assume jpdom_local_full)
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local'     , (/jpi   , jpj   /) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/nimpp , njmpp /) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last'  , (/nimpp + jpi - 1 , njmpp + jpj - 1  /) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/nldi - 1        , nldj - 1         /) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/jpi - nlei      , jpj - nlej       /) )
+         nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              )
+      ENDIF
+      
+      IF (associated(first_berg)) then
+         nret = NF90_DEF_DIM(ncid, 'n', NF90_UNLIMITED, in_dim)
+         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim n failed')
+      ENDIF
+
+      ! Variables
+      nret = NF90_DEF_VAR(ncid, 'kount'       , NF90_INT   , (/ ik_dim /), nkountid)
+      nret = NF90_DEF_VAR(ncid, 'calving'     , NF90_DOUBLE, (/ ix_dim, iy_dim /), ncalvid)
+      nret = NF90_DEF_VAR(ncid, 'calving_hflx', NF90_DOUBLE, (/ ix_dim, iy_dim /), ncalvhid)
+      nret = NF90_DEF_VAR(ncid, 'stored_ice'  , NF90_DOUBLE, (/ ix_dim, iy_dim, nc_dim /), nsiceid)
+      nret = NF90_DEF_VAR(ncid, 'stored_heat' , NF90_DOUBLE, (/ ix_dim, iy_dim /), nsheatid)
+
+      ! Attributes
+      nret = NF90_PUT_ATT(ncid, ncalvid , 'long_name', 'iceberg calving')
+      nret = NF90_PUT_ATT(ncid, ncalvid , 'units', 'some')
+      nret = NF90_PUT_ATT(ncid, ncalvhid, 'long_name', 'heat flux associated with iceberg calving')
+      nret = NF90_PUT_ATT(ncid, ncalvhid, 'units', 'some')
+      nret = NF90_PUT_ATT(ncid, nsiceid , 'long_name', 'stored ice used to calve icebergs')
+      nret = NF90_PUT_ATT(ncid, nsiceid , 'units', 'kg/s')
+      nret = NF90_PUT_ATT(ncid, nsheatid, 'long_name', 'heat in stored ice used to calve icebergs')
+      nret = NF90_PUT_ATT(ncid, nsheatid, 'units', 'J/kg/s')
+
+      IF ( ASSOCIATED(first_berg) ) THEN
+
+         ! Only add berg variables for this PE if we have anything to say
+
+         ! Variables
+         nret = NF90_DEF_VAR(ncid, 'lon', NF90_DOUBLE, in_dim, nlonid)
+         nret = NF90_DEF_VAR(ncid, 'lat', NF90_DOUBLE, in_dim, nlatid)
+         nret = NF90_DEF_VAR(ncid, 'xi', NF90_DOUBLE, in_dim, nxid)
+         nret = NF90_DEF_VAR(ncid, 'yj', NF90_DOUBLE, in_dim, nyid)
+         nret = NF90_DEF_VAR(ncid, 'uvel', NF90_DOUBLE, in_dim, nuvelid)
+         nret = NF90_DEF_VAR(ncid, 'vvel', NF90_DOUBLE, in_dim, nvvelid)
+         nret = NF90_DEF_VAR(ncid, 'mass', NF90_DOUBLE, in_dim, nmassid)
+         nret = NF90_DEF_VAR(ncid, 'thickness', NF90_DOUBLE, in_dim, nthicknessid)
+         nret = NF90_DEF_VAR(ncid, 'width', NF90_DOUBLE, in_dim, nwidthid)
+         nret = NF90_DEF_VAR(ncid, 'length', NF90_DOUBLE, in_dim, nlengthid)
+         nret = NF90_DEF_VAR(ncid, 'number', NF90_INT, (/ik_dim,in_dim/), numberid)
+         nret = NF90_DEF_VAR(ncid, 'year', NF90_INT, in_dim, nyearid)
+         nret = NF90_DEF_VAR(ncid, 'day', NF90_DOUBLE, in_dim, ndayid)
+         nret = NF90_DEF_VAR(ncid, 'mass_scaling', NF90_DOUBLE, in_dim, nscaling_id)
+         nret = NF90_DEF_VAR(ncid, 'mass_of_bits', NF90_DOUBLE, in_dim, nmass_of_bits_id)
+         nret = NF90_DEF_VAR(ncid, 'heat_density', NF90_DOUBLE, in_dim, nheat_density_id)
+
+         ! Attributes
+         nret = NF90_PUT_ATT(ncid, nlonid, 'long_name', 'longitude')
+         nret = NF90_PUT_ATT(ncid, nlonid, 'units', 'degrees_E')
+         nret = NF90_PUT_ATT(ncid, nlatid, 'long_name', 'latitude')
+         nret = NF90_PUT_ATT(ncid, nlatid, 'units', 'degrees_N')
+         nret = NF90_PUT_ATT(ncid, nxid, 'long_name', 'x grid box position')
+         nret = NF90_PUT_ATT(ncid, nxid, 'units', 'fractional')
+         nret = NF90_PUT_ATT(ncid, nyid, 'long_name', 'y grid box position')
+         nret = NF90_PUT_ATT(ncid, nyid, 'units', 'fractional')
+         nret = NF90_PUT_ATT(ncid, nuvelid, 'long_name', 'zonal velocity')
+         nret = NF90_PUT_ATT(ncid, nuvelid, 'units', 'm/s')
+         nret = NF90_PUT_ATT(ncid, nvvelid, 'long_name', 'meridional velocity')
+         nret = NF90_PUT_ATT(ncid, nvvelid, 'units', 'm/s')
+         nret = NF90_PUT_ATT(ncid, nmassid, 'long_name', 'mass')
+         nret = NF90_PUT_ATT(ncid, nmassid, 'units', 'kg')
+         nret = NF90_PUT_ATT(ncid, nthicknessid, 'long_name', 'thickness')
+         nret = NF90_PUT_ATT(ncid, nthicknessid, 'units', 'm')
+         nret = NF90_PUT_ATT(ncid, nwidthid, 'long_name', 'width')
+         nret = NF90_PUT_ATT(ncid, nwidthid, 'units', 'm')
+         nret = NF90_PUT_ATT(ncid, nlengthid, 'long_name', 'length')
+         nret = NF90_PUT_ATT(ncid, nlengthid, 'units', 'm')
+         nret = NF90_PUT_ATT(ncid, numberid, 'long_name', 'iceberg number on this processor')
+         nret = NF90_PUT_ATT(ncid, numberid, 'units', 'count')
+         nret = NF90_PUT_ATT(ncid, nyearid, 'long_name', 'calendar year of calving event')
+         nret = NF90_PUT_ATT(ncid, nyearid, 'units', 'years')
+         nret = NF90_PUT_ATT(ncid, ndayid, 'long_name', 'year day of calving event')
+         nret = NF90_PUT_ATT(ncid, ndayid, 'units', 'days')
+         nret = NF90_PUT_ATT(ncid, nscaling_id, 'long_name', 'scaling factor for mass of calving berg')
+         nret = NF90_PUT_ATT(ncid, nscaling_id, 'units', 'none')
+         nret = NF90_PUT_ATT(ncid, nmass_of_bits_id, 'long_name', 'mass of bergy bits')
+         nret = NF90_PUT_ATT(ncid, nmass_of_bits_id, 'units', 'kg')
+         nret = NF90_PUT_ATT(ncid, nheat_density_id, 'long_name', 'heat density')
+         nret = NF90_PUT_ATT(ncid, nheat_density_id, 'units', 'J/kg')
+
+      ENDIF ! associated(first_berg)
+
+      ! End define mode
+      nret = NF90_ENDDEF(ncid)
+
+      ! --------------------------------
+      ! now write some data
+
+      nstrt3(1) = 1
+      nstrt3(2) = 1
+      nlngth3(1) = jpi
+      nlngth3(2) = jpj
+      nlngth3(3) = 1
+
+      DO jn=1,nclasses
+         griddata(:,:,1) = berg_grid%stored_ice(:,:,jn)
+         nstrt3(3) = jn
+         nret = NF90_PUT_VAR( ncid, nsiceid, griddata, nstrt3, nlngth3 )
+         IF (nret .ne. NF90_NOERR) THEN
+            IF( lwp ) WRITE(numout,*) TRIM(NF90_STRERROR( nret ))
+            CALL ctl_stop('icebergs, write_restart: nf_put_var stored_ice failed')
+         ENDIF
+      ENDDO
+      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice  written'
+
+      nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) )
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var kount failed')
+
+      nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) )
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed')
+      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written'
+
+      nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) )
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving failed')
+      nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) )
+      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed')
+      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written'
+
+      IF ( ASSOCIATED(first_berg) ) THEN
+
+         ! Write variables
+         ! just write out the current point of the trajectory
+
+         this => first_berg
+         jn = 0
+         DO WHILE (ASSOCIATED(this))
+            pt => this%current_point
+            jn=jn+1
+
+            nret = NF90_PUT_VAR(ncid, numberid, this%number, (/1,jn/), (/nkounts,1/) )
+            nret = NF90_PUT_VAR(ncid, nscaling_id, this%mass_scaling, (/ jn /) )
+
+            nret = NF90_PUT_VAR(ncid, nlonid, pt%lon, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nlatid, pt%lat, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nxid, pt%xi, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nyid, pt%yj, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nuvelid, pt%uvel, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nvvelid, pt%vvel, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nmassid, pt%mass, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nthicknessid, pt%thickness, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nwidthid, pt%width, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nlengthid, pt%length, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nyearid, pt%year, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, ndayid, pt%day, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nmass_of_bits_id, pt%mass_of_bits, (/ jn /) )
+            nret = NF90_PUT_VAR(ncid, nheat_density_id, pt%heat_density, (/ jn /) )
+
+            this=>this%next
+         END DO
+         !
+      ENDIF ! associated(first_berg)
+
+      ! Finish up
+      nret = NF90_CLOSE(ncid)
+      IF (nret /= NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_close failed')
+      !
+   END SUBROUTINE icb_rst_write
+   !
+END MODULE icbrst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90	(revision 8732)
@@ -0,0 +1,176 @@
+MODULE icbstp
+
+   !!======================================================================
+   !!                       ***  MODULE  icbstp  ***
+   !! Icebergs:  initialise variables for iceberg tracking
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!            -    !                            Move budgets to icbdia routine
+   !!            -    !  2011-05  (Alderson)       Add call to copy forcing arrays
+   !!            -    !                            into icb copies with haloes
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_stp       : start iceberg tracking
+   !!   icb_end       : end   iceberg tracking
+   !!----------------------------------------------------------------------
+   USE par_oce        ! nemo parameters
+   USE dom_oce        ! ocean domain
+   USE sbc_oce        ! ocean surface forcing
+   USE phycst
+   USE in_out_manager ! nemo IO
+   USE lib_mpp
+   USE iom
+   USE fldread
+   USE timing         ! timing
+
+   USE icb_oce        ! define iceberg arrays
+   USE icbini         ! iceberg initialisation routines
+   USE icbutl         ! iceberg utility routines
+   USE icbrst         ! iceberg restart routines
+   USE icbdyn         ! iceberg dynamics (ie advection) routines
+   USE icbclv         ! iceberg calving routines
+   USE icbthm         ! iceberg thermodynamics routines
+   USE icblbc         ! iceberg lateral boundary routines (including mpp)
+   USE icbtrj         ! iceberg trajectory I/O routines
+   USE icbdia         ! iceberg budget
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_stp        ! routine called in sbcmod.F90 module
+   PUBLIC   icb_end        ! routine called in nemogcm.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE icb_stp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_stp  ***
+      !!
+      !! ** Purpose :   iceberg time stepping.
+      !!
+      !! ** Method  : - top level routine to do things in the correct order
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
+      LOGICAL ::   ll_sample_traj, ll_budget, ll_verbose   ! local logical
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('icb_stp')
+
+      !! start of timestep housekeeping
+
+      nktberg = kt
+
+      IF( nn_test_icebergs < 0 ) THEN      ! read calving data
+         !
+         CALL fld_read ( kt, 1, sf_icb )
+         src_calving(:,:)      = sf_icb(1)%fnow(:,:,1)    ! calving in km^3/year (water equivalent)
+         src_calving_hflx(:,:) = 0._wp                    ! NO heat flux for now
+         !
+      ENDIF
+
+      berg_grid%floating_melt(:,:) = 0._wp
+
+      ! anything that needs to be reset to zero each timestep for budgets is dealt with here
+      CALL icb_dia_step()
+
+      ll_verbose = .FALSE.
+      IF( nn_verbose_write > 0 .AND. &
+          MOD(kt-1,nn_verbose_write ) == 0 )   ll_verbose = nn_verbose_level >= 0
+
+      ! write out time
+      IF( ll_verbose ) WRITE(numicb,9100) nktberg, ndastp, nsec_day
+ 9100 FORMAT('kt= ',i8, ' day= ',i8,' secs=',i8)
+
+      ! copy nemo forcing arrays into iceberg versions with extra halo
+      ! only necessary for variables not on T points
+      CALL icb_utl_copy()
+
+      !!----------------------------------------------------------------------
+      !! process icebergs
+
+                                     CALL icb_clv_flx( kt )   ! Accumulate ice from calving
+
+                                     CALL icb_clv()           ! Calve excess stored ice into icebergs
+
+
+!                               !==  For each berg, evolve  ==!
+      !
+      IF( ASSOCIATED(first_berg) )   CALL icb_dyn( kt )       ! ice berg dynamics
+
+      IF( lk_mpp ) THEN          ;   CALL icb_lbc_mpp()       ! Send bergs to other PEs
+      ELSE                       ;   CALL icb_lbc()           ! Deal with any cyclic boundaries in non-mpp case
+      ENDIF
+
+      IF( ASSOCIATED(first_berg) )   CALL icb_thm( kt )       ! Ice berg thermodynamics (melting) + rolling
+
+      !!----------------------------------------------------------------------
+      !! end of timestep housekeeping
+
+      ll_sample_traj = .FALSE.
+      IF( nn_sample_rate > 0 .AND. MOD(kt-1,nn_sample_rate) == 0 )   ll_sample_traj = .TRUE.
+      IF( ll_sample_traj .AND.   &
+          ASSOCIATED(first_berg) )   CALL icb_trj_write( kt )  ! For each berg, record trajectory
+
+      ! Gridded diagnostics
+      ! To get these iom_put's and those preceding to actually do something
+      ! use key_iomput in cpp file and create content for XML file
+
+      CALL iom_put( "calving"           , berg_grid%calving      (:,:)   )  ! 'calving mass input'
+      CALL iom_put( "berg_floating_melt", berg_grid%floating_melt(:,:)   )  ! 'Melt rate of icebergs + bits' , 'kg/m2/s'
+      CALL iom_put( "berg_stored_ice"   , berg_grid%stored_ice   (:,:,:) )  ! 'Accumulated ice mass by class', 'kg'
+
+      ! store mean budgets
+      CALL icb_dia_put()
+
+      ! Dump icebergs to screen
+      if ( nn_verbose_level >= 2 )   CALL icb_utl_print( 'icb_stp, status', kt )
+
+      ! Diagnose budgets
+      ll_budget = .FALSE.
+      IF( nn_verbose_write > 0 .AND. MOD(kt-1,nn_verbose_write) == 0 )   ll_budget = ln_bergdia
+      CALL icb_dia( ll_budget )
+
+      IF( MOD(kt,nn_stock) == 0 ) THEN
+         CALL icb_rst_write( kt )
+         IF( nn_sample_rate > 0 )   CALL icb_trj_sync()
+      ENDIF
+
+      IF( nn_timing == 1 ) CALL timing_stop('icb_stp')
+      !
+   END SUBROUTINE icb_stp
+
+
+   SUBROUTINE icb_end( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_end  ***
+      !!
+      !! ** Purpose :   close iceberg files
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )  :: kt
+      !!----------------------------------------------------------------------
+
+      ! only write a restart if not done in icb_stp
+      IF( MOD(kt,nn_stock) .NE. 0 ) CALL icb_rst_write( kt )
+
+      ! finish with trajectories if they were written
+      IF( nn_sample_rate .GT. 0 ) CALL icb_trj_end()
+
+      IF(lwp)   WRITE(numout,'(a,i6)') 'icebergs: icb_end complete', narea
+      CALL flush( numicb )
+      CLOSE( numicb )
+      !
+   END SUBROUTINE icb_end
+
+   !!-------------------------------------------------------------------------
+
+END MODULE icbstp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90	(revision 8732)
@@ -0,0 +1,216 @@
+MODULE icbthm
+
+   !!======================================================================
+   !!                       ***  MODULE  icbthm  ***
+   !! Icebergs:  thermodynamics routines for icebergs
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!            -    !  2011-05  (Alderson)       Use tmask instead of tmask_i
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_thm : initialise
+   !!             reference for equations - M = Martin + Adcroft, OM 34, 2010
+   !!----------------------------------------------------------------------
+   USE par_oce        ! NEMO parameters
+   USE dom_oce        ! NEMO domain
+   USE in_out_manager ! NEMO IO routines, numout in particular
+   USE lib_mpp        ! NEMO MPI routines, ctl_stop in particular
+   USE phycst         ! NEMO physical constants
+   USE sbc_oce
+
+   USE icb_oce        ! define iceberg arrays
+   USE icbutl         ! iceberg utility routines
+   USE icbdia         ! iceberg budget routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_thm ! routine called in icbstp.F90 module
+
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE icb_thm( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_thm  ***
+      !!
+      !! ** Purpose :   compute the iceberg thermodynamics.
+      !!
+      !! ** Method  : - See Martin & Adcroft, Ocean Modelling 34, 2010
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! timestep number, just passed to icb_utl_print_berg
+      !
+      INTEGER  ::   ii, ij
+      REAL(wp) ::   zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn
+      REAL(wp) ::   zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv
+      REAL(wp) ::   zMnew, zMnew1, zMnew2, zheat
+      REAL(wp) ::   zMbits, znMbits, zdMbitsE, zdMbitsM, zLbits, zAbits, zMbb
+      REAL(wp) ::   zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2
+      TYPE(iceberg), POINTER ::   this, next
+      TYPE(point)  , POINTER ::   pt
+      !!----------------------------------------------------------------------
+      !
+      z1_rday = 1._wp / rday
+      
+      ! we're either going to ignore berg fresh water melt flux and associated heat
+      ! or we pass it into the ocean, so at this point we set them both to zero,
+      ! accumulate the contributions to them from each iceberg in the while loop following
+      ! and then pass them (or not) to the ocean
+      !
+      berg_grid%floating_melt(:,:) = 0._wp
+      berg_grid%calving_hflx(:,:)  = 0._wp
+    
+      this => first_berg
+      DO WHILE( associated(this) )
+         !
+         pt => this%current_point
+         nknberg = this%number(1)
+         CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x, &
+         &                    pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y, &
+         &                 pt%sst, pt%cn, pt%hi, zff )
+         !
+         zSST = pt%sst
+         zIC  = MIN( 1._wp, pt%cn + rn_sicn_shift )     ! Shift sea-ice concentration       !!gm ???
+         zM   = pt%mass
+         zT   = pt%thickness                               ! total thickness
+       ! D   = (rn_rho_bergs/pp_rho_seawater)*zT ! draught (keel depth)
+       ! F   = zT - D ! freeboard
+         zW   = pt%width
+         zL   = pt%length
+         zxi  = pt%xi                                      ! position in (i,j) referential
+         zyj  = pt%yj
+         ii  = INT( zxi + 0.5 )                            ! T-cell of the berg
+         ii  = mi1( ii )
+         ij  = INT( zyj + 0.5 )              
+         ij  = mj1( ij )
+         zVol = zT * zW * zL
+         zdt = berg_dt   ;   z1_dt = 1._wp / zdt
+
+         ! Environment
+         zdvo = SQRT( (pt%uvel-pt%uo)**2 + (pt%vvel-pt%vo)**2 )
+         zdva = SQRT( (pt%ua  -pt%uo)**2 + (pt%va  -pt%vo)**2 )
+         zSs  = 1.5 * SQRT( zdva ) + 0.1 * zdva                ! Sea state      (eqn M.A9)
+
+         ! Melt rates in m/s (i.e. division by rday)
+         zMv = MAX( 7.62e-3*zSST+1.29e-3*(zSST**2)            , 0._wp ) * z1_rday   ! Buoyant convection at sides (eqn M.A10)
+         zMb = MAX( 0.58*(zdvo**0.8)*(zSST+4.0)/(zL**0.2)      , 0._wp ) * z1_rday   ! Basal turbulent melting     (eqn M.A7 )
+         zMe = MAX( 1./12.*(zSST+2.)*zSs*(1+cos(rpi*(zIC**3))) , 0._wp ) * z1_rday   ! Wave erosion                (eqn M.A8 )
+
+         IF( ln_operator_splitting ) THEN      ! Operator split update of volume/mass
+            zTn    = MAX( zT - zMb*zdt , 0._wp )         ! new total thickness (m)
+            znVol  = zTn * zW * zL                        ! new volume (m^3)
+            zMnew1 = (znVol/zVol) * zM                    ! new mass (kg)
+            zdMb   = zM - zMnew1                         ! mass lost to basal melting (>0) (kg)
+            !
+            zLn    = MAX( zL - zMv*zdt , 0._wp )         ! new length (m)
+            zWn    = MAX( zW - zMv*zdt , 0._wp )         ! new width (m)
+            znVol  = zTn * zWn * zLn                      ! new volume (m^3)
+            zMnew2 = (znVol/zVol) * zM                    ! new mass (kg)
+            zdMv   = zMnew1 - zMnew2                     ! mass lost to buoyant convection (>0) (kg)
+            !
+            zLn    = MAX( zLn - zMe*zdt , 0._wp )        ! new length (m)
+            zWn    = MAX( zWn - zMe*zdt , 0._wp )        ! new width (m)
+            znVol  = zTn * zWn * zLn                      ! new volume (m^3)
+            zMnew  = ( znVol / zVol ) * zM                ! new mass (kg)
+            zdMe   = zMnew2 - zMnew                      ! mass lost to erosion (>0) (kg)
+            zdM    = zM - zMnew                          ! mass lost to all erosion and melting (>0) (kg)
+            !
+         ELSE                                         ! Update dimensions of berg
+            zLn = MAX( zL -(zMv+zMe)*zdt ,0._wp )         ! (m)
+            zWn = MAX( zW -(zMv+zMe)*zdt ,0._wp )         ! (m)
+            zTn = MAX( zT - zMb    *zdt ,0._wp )         ! (m)
+            ! Update volume and mass of berg
+            znVol = zTn*zWn*zLn                           ! (m^3)
+            zMnew = (znVol/zVol)*zM                       ! (kg)
+            zdM   = zM - zMnew                           ! (kg)
+            zdMb = (zM/zVol) * (zW*   zL ) *zMb*zdt         ! approx. mass loss to basal melting (kg)
+            zdMe = (zM/zVol) * (zT*(zW+zL)) *zMe*zdt         ! approx. mass lost to erosion (kg)
+            zdMv = (zM/zVol) * (zT*(zW+zL)) *zMv*zdt         ! approx. mass loss to buoyant convection (kg)
+         ENDIF
+
+         IF( rn_bits_erosion_fraction > 0._wp ) THEN      ! Bergy bits
+            !
+            zMbits   = pt%mass_of_bits                                               ! mass of bergy bits (kg)
+            zdMbitsE = rn_bits_erosion_fraction * zdMe                        ! change in mass of bits (kg)
+            znMbits  = zMbits + zdMbitsE                                               ! add new bergy bits to mass (kg)
+            zLbits   = MIN( zL, zW, zT, 40._wp )                                        ! assume bergy bits are smallest dimension or 40 meters
+            zAbits   = ( zMbits / rn_rho_bergs ) / zLbits                           ! Effective bottom area (assuming T=Lbits)
+            zMbb     = MAX( 0.58*(zdvo**0.8)*(zSST+2.0)/(zLbits**0.2), 0.) * z1_rday    ! Basal turbulent melting (for bits)
+            zMbb     = rn_rho_bergs * zAbits * zMbb                                 ! in kg/s
+            zdMbitsM = MIN( zMbb*zdt , znMbits )                                       ! bergy bits mass lost to melting (kg)
+            znMbits  = znMbits-zdMbitsM                                                ! remove mass lost to bergy bits melt
+            IF( zMnew == 0._wp ) THEN                                                ! if parent berg has completely melted then
+               zdMbitsM = zdMbitsM + znMbits                                           ! instantly melt all the bergy bits
+               znMbits  = 0._wp
+            ENDIF
+         ELSE                                                     ! No bergy bits
+            zAbits   = 0._wp
+            zdMbitsE = 0._wp
+            zdMbitsM = 0._wp
+            znMbits  = pt%mass_of_bits                             ! retain previous value incase non-zero
+         ENDIF
+
+         ! use tmask rather than tmask_i when dealing with icebergs
+         IF( tmask(ii,ij,1) /= 0._wp ) THEN    ! Add melting to the grid and field diagnostics
+            z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling
+            z1_dt_e1e2 = z1_dt * z1_e1e2
+            zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s
+            berg_grid%floating_melt(ii,ij) = berg_grid%floating_melt(ii,ij) + zmelt    * z1_e1e2    ! kg/m2/s
+            zheat = zmelt * pt%heat_density              ! kg/s x J/kg = J/s
+            berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + zheat    * z1_e1e2    ! W/m2
+            CALL icb_dia_melt( ii, ij, zMnew, zheat, this%mass_scaling,       &
+            &                          zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   &
+            &                          zdMv, z1_dt_e1e2 )
+         ELSE
+            WRITE(numout,*) 'icb_thm: berg ',this%number(:),' appears to have grounded  at ',narea,ii,ij
+            CALL icb_utl_print_berg( this, kt )
+            WRITE(numout,*) 'msk=',tmask(ii,ij,1), e1e2t(ii,ij)
+            CALL ctl_stop('icb_thm', 'berg appears to have grounded!')
+         ENDIF
+
+         ! Rolling
+         zDn = ( rn_rho_bergs / pp_rho_seawater ) * zTn       ! draught (keel depth)
+         IF( zDn > 0._wp .AND. MAX(zWn,zLn) < SQRT( 0.92*(zDn**2) + 58.32*zDn ) ) THEN
+            zT  = zTn
+            zTn = zWn
+            zWn = zT
+         endif
+
+         ! Store the new state of iceberg (with L>W)
+         pt%mass         = zMnew
+         pt%mass_of_bits = znMbits
+         pt%thickness    = zTn
+         pt%width        = min(zWn,zLn)
+         pt%length       = max(zWn,zLn)
+
+         next=>this%next
+
+!!gm  add a test to avoid over melting ?
+
+         IF( zMnew <= 0._wp ) THEN       ! Delete the berg if completely melted
+            CALL icb_utl_delete( first_berg, this )
+            !
+         ELSE                            ! Diagnose mass distribution on grid
+            z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling
+            CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   &
+            &                  this%mass_scaling, zMnew, znMbits, z1_e1e2)
+         ENDIF
+         !
+         this=>next
+         !
+      END DO
+      
+      ! now use melt and associated heat flux in ocean (or not)
+      !
+      IF(.NOT. ln_passive_mode ) THEN
+         emp (:,:) = emp (:,:) - berg_grid%floating_melt(:,:)
+!!       qns (:,:) = qns (:,:) + berg_grid%calving_hflx (:,:)  !!gm heat flux not yet properly coded ==>> need it, SOLVE that!
+      ENDIF
+      !
+   END SUBROUTINE icb_thm
+
+   !!======================================================================
+END MODULE icbthm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90	(revision 8732)
@@ -0,0 +1,282 @@
+MODULE icbtrj
+
+   !!======================================================================
+   !!                       ***  MODULE  icbtrj  ***
+   !! Ocean physics:  trajectory I/O routines
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-05  (Alderson)       New module to handle trajectory output
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_trj_init          :
+   !!----------------------------------------------------------------------
+   USE par_oce        ! NEMO parameters
+   USE dom_oce        ! NEMO ocean domain
+   USE phycst         ! NEMO physical constants
+   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
+   USE in_out_manager ! NEMO IO, numout in particular
+   USE ioipsl, ONLY : ju2ymds    ! for calendar
+   USE netcdf
+   !
+   USE icb_oce        ! define iceberg arrays
+   USE icbutl         ! iceberg utility routines
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_trj_init    ! routine called in icbini.F90 module
+   PUBLIC   icb_trj_write   ! routine called in icbstp.F90 module
+   PUBLIC   icb_trj_sync    ! routine called in icbstp.F90 module
+   PUBLIC   icb_trj_end     ! routine called in icbstp.F90 module
+
+   INTEGER ::   num_traj
+   INTEGER ::   n_dim, m_dim
+   INTEGER ::   ntrajid
+   INTEGER ::   numberid, nstepid, nscaling_id
+   INTEGER ::   nlonid, nlatid, nxid, nyid, nuvelid, nvvelid, nmassid
+   INTEGER ::   nuoid, nvoid, nuaid, nvaid, nuiid, nviid
+   INTEGER ::   nsshxid, nsshyid, nsstid, ncntid, nthkid
+   INTEGER ::   nthicknessid, nwidthid, nlengthid
+   INTEGER ::   nyearid, ndayid
+   INTEGER ::   nmass_of_bits_id, nheat_density_id
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!-------------------------------------------------------------------------
+
+   SUBROUTINE icb_trj_init( ktend )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_trj_init  ***
+      !!
+      !! ** Purpose :   initialise iceberg trajectory output files
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )                 :: ktend
+      !
+      INTEGER                               :: iret
+      INTEGER                               :: iyear, imonth, iday
+      REAL(wp)                              :: zfjulday, zsec
+      CHARACTER(len=80)                     :: cl_filename
+      TYPE(iceberg), POINTER                :: this
+      TYPE(point)  , POINTER                :: pt
+      CHARACTER(LEN=20)                     :: cldate_ini, cldate_end
+      !!----------------------------------------------------------------------
+
+      ! compute initial time step date
+      CALL ju2ymds( fjulday, iyear, imonth, iday, zsec )
+      WRITE(cldate_ini, '(i4.4,2i2.2)') iyear, imonth, iday
+
+      ! compute end time step date
+      zfjulday = fjulday + rdt / rday * REAL( nitend - nit000 + 1 , wp)
+      IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
+      CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )
+      WRITE(cldate_end, '(i4.4,2i2.2)') iyear, imonth, iday
+
+      ! define trajectory output name
+      IF( lk_mpp ) THEN   ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")') TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1
+      ELSE                ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A         ,".nc")') TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end))
+      ENDIF
+      IF ( lwp .AND. nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename)
+
+      iret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ntrajid)
+      IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_create failed')
+
+      ! Dimensions
+      iret = NF90_DEF_DIM(ntrajid, 'n', NF90_UNLIMITED, n_dim)
+      IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim n failed')
+      iret = NF90_DEF_DIM(ntrajid, 'k', nkounts, m_dim)
+      IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim k failed')
+
+      ! Variables
+      iret = NF90_DEF_VAR(ntrajid, 'iceberg_number', NF90_INT, (/m_dim,n_dim/), numberid)
+      iret = NF90_DEF_VAR(ntrajid, 'timestep', NF90_INT, n_dim, nstepid)
+      iret = NF90_DEF_VAR(ntrajid, 'mass_scaling', NF90_DOUBLE, n_dim, nscaling_id)
+      iret = NF90_DEF_VAR(ntrajid, 'lon', NF90_DOUBLE, n_dim, nlonid)
+      iret = NF90_DEF_VAR(ntrajid, 'lat', NF90_DOUBLE, n_dim, nlatid)
+      iret = NF90_DEF_VAR(ntrajid, 'xi', NF90_DOUBLE, n_dim, nxid)
+      iret = NF90_DEF_VAR(ntrajid, 'yj', NF90_DOUBLE, n_dim, nyid)
+      iret = NF90_DEF_VAR(ntrajid, 'uvel', NF90_DOUBLE, n_dim, nuvelid)
+      iret = NF90_DEF_VAR(ntrajid, 'vvel', NF90_DOUBLE, n_dim, nvvelid)
+      iret = NF90_DEF_VAR(ntrajid, 'uto', NF90_DOUBLE, n_dim, nuoid)
+      iret = NF90_DEF_VAR(ntrajid, 'vto', NF90_DOUBLE, n_dim, nvoid)
+      iret = NF90_DEF_VAR(ntrajid, 'uta', NF90_DOUBLE, n_dim, nuaid)
+      iret = NF90_DEF_VAR(ntrajid, 'vta', NF90_DOUBLE, n_dim, nvaid)
+      iret = NF90_DEF_VAR(ntrajid, 'uti', NF90_DOUBLE, n_dim, nuiid)
+      iret = NF90_DEF_VAR(ntrajid, 'vti', NF90_DOUBLE, n_dim, nviid)
+      iret = NF90_DEF_VAR(ntrajid, 'ssh_x', NF90_DOUBLE, n_dim, nsshyid)
+      iret = NF90_DEF_VAR(ntrajid, 'ssh_y', NF90_DOUBLE, n_dim, nsshxid)
+      iret = NF90_DEF_VAR(ntrajid, 'sst', NF90_DOUBLE, n_dim, nsstid)
+      iret = NF90_DEF_VAR(ntrajid, 'icnt', NF90_DOUBLE, n_dim, ncntid)
+      iret = NF90_DEF_VAR(ntrajid, 'ithk', NF90_DOUBLE, n_dim, nthkid)
+      iret = NF90_DEF_VAR(ntrajid, 'mass', NF90_DOUBLE, n_dim, nmassid)
+      iret = NF90_DEF_VAR(ntrajid, 'thickness', NF90_DOUBLE, n_dim, nthicknessid)
+      iret = NF90_DEF_VAR(ntrajid, 'width', NF90_DOUBLE, n_dim, nwidthid)
+      iret = NF90_DEF_VAR(ntrajid, 'length', NF90_DOUBLE, n_dim, nlengthid)
+      iret = NF90_DEF_VAR(ntrajid, 'year', NF90_INT, n_dim, nyearid)
+      iret = NF90_DEF_VAR(ntrajid, 'day', NF90_DOUBLE, n_dim, ndayid)
+      iret = NF90_DEF_VAR(ntrajid, 'mass_of_bits', NF90_DOUBLE, n_dim, nmass_of_bits_id)
+      iret = NF90_DEF_VAR(ntrajid, 'heat_density', NF90_DOUBLE, n_dim, nheat_density_id)
+
+      ! Attributes
+      iret = NF90_PUT_ATT(ntrajid, numberid, 'long_name', 'iceberg number on this processor')
+      iret = NF90_PUT_ATT(ntrajid, numberid, 'units', 'count')
+      iret = NF90_PUT_ATT(ntrajid, nstepid, 'long_name', 'timestep number kt')
+      iret = NF90_PUT_ATT(ntrajid, nstepid, 'units', 'count')
+      iret = NF90_PUT_ATT(ntrajid, nlonid, 'long_name', 'longitude')
+      iret = NF90_PUT_ATT(ntrajid, nlonid, 'units', 'degrees_E')
+      iret = NF90_PUT_ATT(ntrajid, nlatid, 'long_name', 'latitude')
+      iret = NF90_PUT_ATT(ntrajid, nlatid, 'units', 'degrees_N')
+      iret = NF90_PUT_ATT(ntrajid, nxid, 'long_name', 'x grid box position')
+      iret = NF90_PUT_ATT(ntrajid, nxid, 'units', 'fractional')
+      iret = NF90_PUT_ATT(ntrajid, nyid, 'long_name', 'y grid box position')
+      iret = NF90_PUT_ATT(ntrajid, nyid, 'units', 'fractional')
+      iret = NF90_PUT_ATT(ntrajid, nuvelid, 'long_name', 'zonal velocity')
+      iret = NF90_PUT_ATT(ntrajid, nuvelid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nvvelid, 'long_name', 'meridional velocity')
+      iret = NF90_PUT_ATT(ntrajid, nvvelid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nuoid, 'long_name', 'ocean u component')
+      iret = NF90_PUT_ATT(ntrajid, nuoid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nvoid, 'long_name', 'ocean v component')
+      iret = NF90_PUT_ATT(ntrajid, nvoid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nuaid, 'long_name', 'atmosphere u component')
+      iret = NF90_PUT_ATT(ntrajid, nuaid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nvaid, 'long_name', 'atmosphere v component')
+      iret = NF90_PUT_ATT(ntrajid, nvaid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nuiid, 'long_name', 'sea ice u component')
+      iret = NF90_PUT_ATT(ntrajid, nuiid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nviid, 'long_name', 'sea ice v component')
+      iret = NF90_PUT_ATT(ntrajid, nviid, 'units', 'm/s')
+      iret = NF90_PUT_ATT(ntrajid, nsshxid, 'long_name', 'sea surface height gradient from x points')
+      iret = NF90_PUT_ATT(ntrajid, nsshxid, 'units', 'm/m')
+      iret = NF90_PUT_ATT(ntrajid, nsshyid, 'long_name', 'sea surface height gradient from y points')
+      iret = NF90_PUT_ATT(ntrajid, nsshyid, 'units', 'm/m')
+      iret = NF90_PUT_ATT(ntrajid, nsstid, 'long_name', 'sea surface temperature')
+      iret = NF90_PUT_ATT(ntrajid, nsstid, 'units', 'degC')
+      iret = NF90_PUT_ATT(ntrajid, ncntid, 'long_name', 'sea ice concentration')
+      iret = NF90_PUT_ATT(ntrajid, ncntid, 'units', 'degC')
+      iret = NF90_PUT_ATT(ntrajid, nthkid, 'long_name', 'sea ice thickness')
+      iret = NF90_PUT_ATT(ntrajid, nthkid, 'units', 'm')
+      iret = NF90_PUT_ATT(ntrajid, nmassid, 'long_name', 'mass')
+      iret = NF90_PUT_ATT(ntrajid, nmassid, 'units', 'kg')
+      iret = NF90_PUT_ATT(ntrajid, nthicknessid, 'long_name', 'thickness')
+      iret = NF90_PUT_ATT(ntrajid, nthicknessid, 'units', 'm')
+      iret = NF90_PUT_ATT(ntrajid, nwidthid, 'long_name', 'width')
+      iret = NF90_PUT_ATT(ntrajid, nwidthid, 'units', 'm')
+      iret = NF90_PUT_ATT(ntrajid, nlengthid, 'long_name', 'length')
+      iret = NF90_PUT_ATT(ntrajid, nlengthid, 'units', 'm')
+      iret = NF90_PUT_ATT(ntrajid, nyearid, 'long_name', 'calendar year')
+      iret = NF90_PUT_ATT(ntrajid, nyearid, 'units', 'years')
+      iret = NF90_PUT_ATT(ntrajid, ndayid, 'long_name', 'day of year')
+      iret = NF90_PUT_ATT(ntrajid, ndayid, 'units', 'days')
+      iret = NF90_PUT_ATT(ntrajid, nscaling_id, 'long_name', 'scaling factor for mass of berg')
+      iret = NF90_PUT_ATT(ntrajid, nscaling_id, 'units', 'none')
+      iret = NF90_PUT_ATT(ntrajid, nmass_of_bits_id, 'long_name', 'mass of bergy bits')
+      iret = NF90_PUT_ATT(ntrajid, nmass_of_bits_id, 'units', 'kg')
+      iret = NF90_PUT_ATT(ntrajid, nheat_density_id, 'long_name', 'heat density')
+      iret = NF90_PUT_ATT(ntrajid, nheat_density_id, 'units', 'J/kg')
+
+      ! End define mode
+      iret = NF90_ENDDEF(ntrajid)
+      !
+   END SUBROUTINE icb_trj_init
+
+
+   SUBROUTINE icb_trj_write( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_trj_write  ***
+      !!
+      !! ** Purpose :   write out iceberg trajectories
+      !!
+      !! ** Method  : - for the moment write out each snapshot of positions later
+      !!                can rewrite so that it is buffered and written out more efficiently
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt
+      !
+      INTEGER                ::   iret, jn
+      CHARACTER(len=80)      ::   cl_filename
+      TYPE(iceberg), POINTER ::   this
+      TYPE(point)  , POINTER ::   pt
+      !!----------------------------------------------------------------------
+
+      ! Write variables
+      ! sga - just write out the current point of the trajectory
+
+      this => first_berg
+      jn = num_traj
+      DO WHILE (ASSOCIATED(this))
+         pt => this%current_point
+         jn=jn+1
+
+         iret = NF90_PUT_VAR(ntrajid, numberid, this%number, (/1,jn/), (/nkounts,1/) )
+         iret = NF90_PUT_VAR(ntrajid, nstepid, kt, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nscaling_id, this%mass_scaling, (/ jn /) )
+
+         iret = NF90_PUT_VAR(ntrajid, nlonid, pt%lon, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nlatid, pt%lat, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nxid, pt%xi, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nyid, pt%yj, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nuvelid, pt%uvel, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nvvelid, pt%vvel, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nuoid, pt%uo, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nvoid, pt%vo, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nuaid, pt%ua, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nvaid, pt%va, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nuiid, pt%ui, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nviid, pt%vi, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nsshxid, pt%ssh_x, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nsshyid, pt%ssh_y, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nsstid, pt%sst, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, ncntid, pt%cn, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nthkid, pt%hi, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nmassid, pt%mass, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nthicknessid, pt%thickness, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nwidthid, pt%width, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nlengthid, pt%length, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nyearid, pt%year, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, ndayid, pt%day, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nmass_of_bits_id, pt%mass_of_bits, (/ jn /) )
+         iret = NF90_PUT_VAR(ntrajid, nheat_density_id, pt%heat_density, (/ jn /) )
+
+         this=>this%next
+      END DO
+      IF( lwp .and. nn_verbose_level > 0 ) WRITE(numout,*) 'trajectory write to frame ', jn
+      num_traj = jn
+      !
+   END SUBROUTINE icb_trj_write
+
+   !!-------------------------------------------------------------------------
+
+   SUBROUTINE icb_trj_sync()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_trj_sync  ***
+      !!
+      !! ** Purpose :   
+      !!----------------------------------------------------------------------
+      INTEGER                               :: iret
+      !!----------------------------------------------------------------------
+      ! flush to file
+      iret = NF90_SYNC(ntrajid)
+      IF(iret /= NF90_NOERR)   CALL ctl_stop( 'icebergs, icb_trj_sync: nf_sync failed' )
+      !
+   END SUBROUTINE icb_trj_sync
+
+
+   SUBROUTINE icb_trj_end()
+      ! Local variables
+      INTEGER                               :: iret
+      !!----------------------------------------------------------------------
+      ! Finish up
+      iret = NF90_CLOSE(ntrajid)
+      IF (iret /= NF90_NOERR)   CALL ctl_stop( 'icebergs, icb_trj_end: nf_close failed' )
+      !
+   END SUBROUTINE icb_trj_end
+
+   !!-------------------------------------------------------------------------
+
+END MODULE icbtrj
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90	(revision 8732)
@@ -0,0 +1,835 @@
+MODULE icbutl
+   !!======================================================================
+   !!                       ***  MODULE  icbutl  ***
+   !! Icebergs:  various iceberg utility routines
+   !!======================================================================
+   !! History : 3.3.1 !  2010-01  (Martin&Adcroft) Original code
+   !!            -    !  2011-03  (Madec)          Part conversion to NEMO form
+   !!            -    !                            Removal of mapping from another grid
+   !!            -    !  2011-04  (Alderson)       Split into separate modules
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   icb_utl_interp   :
+   !!   icb_utl_bilin    :
+   !!   icb_utl_bilin_e  :
+   !!----------------------------------------------------------------------
+   USE par_oce                             ! ocean parameters
+   USE dom_oce                             ! ocean domain
+   USE in_out_manager                      ! IO parameters
+   USE lbclnk                              ! lateral boundary condition
+   USE lib_mpp                             ! MPI code and lk_mpp in particular
+   USE icb_oce                             ! define iceberg arrays
+   USE sbc_oce                             ! ocean surface boundary conditions
+#if defined key_lim2
+   USE ice_2,         ONLY: u_ice, v_ice   ! LIM-2 ice velocities  (CAUTION in C-grid do not use key_vp option)
+   USE ice_2,         ONLY: hicif          ! LIM-2 ice thickness
+#elif defined key_lim3
+   USE ice,           ONLY: u_ice, v_ice   ! LIM-3 variables  (always in C-grid)
+                                           ! gm  LIM3 case the mean ice thickness (i.e. averaged over categories)
+                                           ! gm            has to be computed somewhere in the ice and accessed here
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   icb_utl_copy          ! routine called in icbstp module
+   PUBLIC   icb_utl_interp        ! routine called in icbdyn, icbthm modules
+   PUBLIC   icb_utl_bilin         ! routine called in icbini, icbdyn modules
+   PUBLIC   icb_utl_bilin_x       ! routine called in icbdyn module
+   PUBLIC   icb_utl_add           ! routine called in icbini.F90, icbclv, icblbc and icbrst modules
+   PUBLIC   icb_utl_delete        ! routine called in icblbc, icbthm modules
+   PUBLIC   icb_utl_destroy       ! routine called in icbstp module
+   PUBLIC   icb_utl_track         ! routine not currently used, retain just in case
+   PUBLIC   icb_utl_print_berg    ! routine called in icbthm module
+   PUBLIC   icb_utl_print         ! routine called in icbini, icbstp module
+   PUBLIC   icb_utl_count         ! routine called in icbdia, icbini, icblbc, icbrst modules
+   PUBLIC   icb_utl_incr          ! routine called in icbini, icbclv modules
+   PUBLIC   icb_utl_yearday       ! routine called in icbclv, icbstp module
+   PUBLIC   icb_utl_mass          ! routine called in icbdia module
+   PUBLIC   icb_utl_heat          ! routine called in icbdia module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!-------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE icb_utl_copy()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_utl_copy  ***
+      !!
+      !! ** Purpose :   iceberg initialization.
+      !!
+      !! ** Method  : - blah blah
+      !!----------------------------------------------------------------------
+
+      ! copy nemo forcing arrays into iceberg versions with extra halo
+      ! only necessary for variables not on T points
+      ! and ssh which is used to calculate gradients
+
+      uo_e(:,:) = 0._wp ;   uo_e(1:jpi, 1:jpj) = ssu_m(:,:) * umask(:,:,1)
+      vo_e(:,:) = 0._wp ;   vo_e(1:jpi, 1:jpj) = ssv_m(:,:) * vmask(:,:,1)
+      ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff_f (:,:) 
+      tt_e(:,:) = 0._wp ;   tt_e(1:jpi, 1:jpj) = sst_m(:,:)
+      fr_e(:,:) = 0._wp ;   fr_e(1:jpi, 1:jpj) = fr_i (:,:)
+      ua_e(:,:) = 0._wp ;   ua_e(1:jpi, 1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk
+      va_e(:,:) = 0._wp ;   va_e(1:jpi, 1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk
+
+      CALL lbc_lnk_icb( uo_e, 'U', -1._wp, 1, 1 )
+      CALL lbc_lnk_icb( vo_e, 'V', -1._wp, 1, 1 )
+      CALL lbc_lnk_icb( ff_e, 'F', +1._wp, 1, 1 )
+      CALL lbc_lnk_icb( ua_e, 'U', -1._wp, 1, 1 )
+      CALL lbc_lnk_icb( va_e, 'V', -1._wp, 1, 1 )
+      CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 )
+      CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 )
+#if defined key_lim2
+      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hicif(:,:)  
+      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )  
+#endif
+
+#if defined key_lim2 || defined key_lim3
+      ui_e(:,:) = 0._wp ;   ui_e(1:jpi, 1:jpj) = u_ice(:,:)
+      vi_e(:,:) = 0._wp ;   vi_e(1:jpi, 1:jpj) = v_ice(:,:)
+
+      CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 )
+      CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 )
+#endif
+
+      !! special for ssh which is used to calculate slope
+      !! so fudge some numbers all the way around the boundary
+
+      ssh_e(:,:) = 0._wp ;   ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1)
+      ssh_e(0    ,    :) = ssh_e(1  ,  :)
+      ssh_e(jpi+1,    :) = ssh_e(jpi,  :)
+      ssh_e(:    ,    0) = ssh_e(:  ,  1)
+      ssh_e(:    ,jpj+1) = ssh_e(:  ,jpj)
+      ssh_e(0,0)         = ssh_e(1,1)
+      ssh_e(jpi+1,0)     = ssh_e(jpi,1)
+      ssh_e(0,jpj+1)     = ssh_e(1,jpj)
+      ssh_e(jpi+1,jpj+1) = ssh_e(jpi,jpj)
+      CALL lbc_lnk_icb( ssh_e, 'T', +1._wp, 1, 1 )
+      !
+   END SUBROUTINE icb_utl_copy
+
+
+   SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i,   &
+      &                       pj, pe2, pvo, pvi, pva, pssh_j,   &
+      &                       psst, pcn, phi, pff            )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE icb_utl_interp  ***
+      !!
+      !! ** Purpose :   interpolation
+      !!
+      !! ** Method  : - interpolate from various ocean arrays onto iceberg position
+      !!
+      !!       !!gm  CAUTION here I do not care of the slip/no-slip conditions
+      !!             this can be done later (not that easy to do...)
+      !!             right now, U is 0 in land so that the coastal value of velocity parallel to the coast
+      !!             is half the off shore value, wile the normal-to-the-coast value is zero.
+      !!             This is OK as a starting point.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pi , pj                        ! position in (i,j) referential
+      REAL(wp), INTENT(  out) ::   pe1, pe2                       ! i- and j scale factors
+      REAL(wp), INTENT(  out) ::   puo, pvo, pui, pvi, pua, pva   ! ocean, ice and wind speeds
+      REAL(wp), INTENT(  out) ::   pssh_i, pssh_j                 ! ssh i- & j-gradients
+      REAL(wp), INTENT(  out) ::   psst, pcn, phi, pff            ! SST, ice concentration, ice thickness, Coriolis
+      !
+      REAL(wp) ::   zcd, zmod       ! local scalars
+      !!----------------------------------------------------------------------
+
+      pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )     ! scale factors
+      pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj )
+      !
+      puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U' )             ! ocean velocities
+      pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V' )
+      psst = icb_utl_bilin_h( tt_e, pi, pj, 'T' )             ! SST
+      pcn  = icb_utl_bilin_h( fr_e , pi, pj, 'T' )            ! ice concentration
+      pff  = icb_utl_bilin_h( ff_e , pi, pj, 'F' )            ! Coriolis parameter
+      !
+      pua  = icb_utl_bilin_h( ua_e , pi, pj, 'U' )            ! 10m wind
+      pva  = icb_utl_bilin_h( va_e , pi, pj, 'V' )            ! here (ua,va) are stress => rough conversion from stress to speed
+      zcd  = 1.22_wp * 1.5e-3_wp                              ! air density * drag coefficient
+      zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  )
+      pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0
+      pva  = pva * zmod
+
+#if defined key_lim2 || defined key_lim3
+      pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' )              ! sea-ice velocities
+      pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' )
+# if defined key_lim3
+      phi = 0._wp                                             ! LIM-3 case (to do)
+# else
+      phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness
+# endif
+#else
+      pui = 0._wp
+      pvi = 0._wp
+      phi = 0._wp
+#endif
+
+      ! Estimate SSH gradient in i- and j-direction (centred evaluation)
+      pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T' ) -   &
+          &      icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T' )  ) / ( 0.2_wp * pe1 )
+      pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T' ) -   &
+          &      icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T' )  ) / ( 0.2_wp * pe2 )
+      !
+   END SUBROUTINE icb_utl_interp
+
+
+   REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION icb_utl_bilin  ***
+      !!
+      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type
+      !!                this version deals with extra halo points
+      !!
+      !!       !!gm  CAUTION an optional argument should be added to handle
+      !!             the slip/no-slip conditions  ==>>> to be done later
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) ::   pfld      ! field to be interpolated
+      REAL(wp)                            , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential
+      CHARACTER(len=1)                    , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points
+      !
+      INTEGER  ::   ii, ij   ! local integer
+      REAL(wp) ::   zi, zj   ! local real
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            ! note that here there is no +0.5 added
+            ! since we're looking for four T points containing quadrant we're in of 
+            ! current T cell
+            ii = MAX(1, INT( pi     ))
+            ij = MAX(1, INT( pj     ))    ! T-point
+            zi = pi - REAL(ii,wp)
+            zj = pj - REAL(ij,wp)
+         CASE ( 'U' )
+            ii = MAX(1, INT( pi-0.5 ))
+            ij = MAX(1, INT( pj     ))    ! U-point
+            zi = pi - 0.5 - REAL(ii,wp)
+            zj = pj - REAL(ij,wp)
+         CASE ( 'V' )
+            ii = MAX(1, INT( pi     ))
+            ij = MAX(1, INT( pj-0.5 ))    ! V-point
+            zi = pi - REAL(ii,wp)
+            zj = pj - 0.5 - REAL(ij,wp)
+         CASE ( 'F' )
+            ii = MAX(1, INT( pi-0.5 ))
+            ij = MAX(1, INT( pj-0.5 ))    ! F-point
+            zi = pi - 0.5 - REAL(ii,wp)
+            zj = pj - 0.5 - REAL(ij,wp)
+      END SELECT
+      !
+      ! find position in this processor. Prevent near edge problems (see #1389)
+
+      if (ii.lt.mig(1)) then
+        ii = 1
+      else if (ii.gt.mig(jpi)) then
+        ii = jpi
+      else
+        ii  = mi1( ii  )
+      end if
+
+      if (ij.lt.mjg(1)) then
+        ij = 1
+      else if (ij.gt.mjg(jpj)) then
+        ij = jpj
+      else
+        ij  = mj1( ij  )
+      end if
+
+      if (ij.eq.jpj) ij=ij-1
+      if (ii.eq.jpi) ii=ii-1      
+
+      !
+      icb_utl_bilin_h = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   &
+         &            + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj
+      !
+   END FUNCTION icb_utl_bilin_h
+
+
+   REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION icb_utl_bilin  ***
+      !!
+      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type
+      !!
+      !!       !!gm  CAUTION an optional argument should be added to handle
+      !!             the slip/no-slip conditions  ==>>> to be done later
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated
+      REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential
+      CHARACTER(len=1)            , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points
+      !
+      INTEGER  ::   ii, ij   ! local integer
+      REAL(wp) ::   zi, zj   ! local real
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            ! note that here there is no +0.5 added
+            ! since we're looking for four T points containing quadrant we're in of 
+            ! current T cell
+            ii = MAX(1, INT( pi     ))
+            ij = MAX(1, INT( pj     ))    ! T-point
+            zi = pi - REAL(ii,wp)
+            zj = pj - REAL(ij,wp)
+         CASE ( 'U' )
+            ii = MAX(1, INT( pi-0.5 ))
+            ij = MAX(1, INT( pj     ))    ! U-point
+            zi = pi - 0.5 - REAL(ii,wp)
+            zj = pj - REAL(ij,wp)
+         CASE ( 'V' )
+            ii = MAX(1, INT( pi     ))
+            ij = MAX(1, INT( pj-0.5 ))    ! V-point
+            zi = pi - REAL(ii,wp)
+            zj = pj - 0.5 - REAL(ij,wp)
+         CASE ( 'F' )
+            ii = MAX(1, INT( pi-0.5 ))
+            ij = MAX(1, INT( pj-0.5 ))    ! F-point
+            zi = pi - 0.5 - REAL(ii,wp)
+            zj = pj - 0.5 - REAL(ij,wp)
+      END SELECT
+      !
+      ! find position in this processor. Prevent near edge problems (see #1389)
+
+      if (ii.lt.mig(1)) then
+        ii = 1
+      else if (ii.gt.mig(jpi)) then
+        ii = jpi
+      else
+        ii  = mi1( ii  )
+      end if
+
+      if (ij.lt.mjg(1)) then
+        ij = 1
+      else if (ij.gt.mjg(jpj)) then
+        ij = jpj
+      else
+        ij  = mj1( ij  )
+      end if
+
+      if (ij.eq.jpj) ij=ij-1
+      if (ii.eq.jpi) ii=ii-1
+
+      icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   &
+         &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj
+      !
+   END FUNCTION icb_utl_bilin
+
+
+   REAL(wp) FUNCTION icb_utl_bilin_x( pfld, pi, pj )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION icb_utl_bilin_x  ***
+      !!
+      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type
+      !!                Special case for interpolating longitude
+      !!
+      !!       !!gm  CAUTION an optional argument should be added to handle
+      !!             the slip/no-slip conditions  ==>>> to be done later
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated
+      REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential
+      !
+      INTEGER                                  ::   ii, ij   ! local integer
+      REAL(wp)                                 ::   zi, zj   ! local real
+      REAL(wp)                                 ::   zret     ! local real
+      REAL(wp), DIMENSION(4)                   ::   z4
+      !!----------------------------------------------------------------------
+      !
+      ! note that here there is no +0.5 added
+      ! since we're looking for four T points containing quadrant we're in of 
+      ! current T cell
+      ii = MAX(1, INT( pi     ))
+      ij = MAX(1, INT( pj     ))    ! T-point
+      zi = pi - REAL(ii,wp)
+      zj = pj - REAL(ij,wp)
+      !
+      ! find position in this processor. Prevent near edge problems (see #1389)
+
+      if (ii.lt.mig(1)) then
+        ii = 1
+      else if (ii.gt.mig(jpi)) then
+        ii = jpi
+      else
+        ii  = mi1( ii  )
+      end if
+
+      if (ij.lt.mjg(1)) then
+        ij = 1
+      else if (ij.gt.mjg(jpj)) then
+        ij = jpj
+      else
+        ij  = mj1( ij  )
+      end if
+
+      if (ij.eq.jpj) ij=ij-1
+      if (ii.eq.jpi) ii=ii-1
+
+      z4(1) = pfld(ii  ,ij  )
+      z4(2) = pfld(ii+1,ij  )
+      z4(3) = pfld(ii  ,ij+1)
+      z4(4) = pfld(ii+1,ij+1)
+      IF( MAXVAL(z4) - MINVAL(z4) > 90._wp ) THEN
+         WHERE( z4 < 0._wp ) z4 = z4 + 360._wp
+      ENDIF
+      !
+      zret = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj
+      IF( zret > 180._wp ) zret = zret - 360._wp
+      icb_utl_bilin_x = zret
+      !
+   END FUNCTION icb_utl_bilin_x
+
+
+   REAL(wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION dom_init  ***
+      !!
+      !! ** Purpose :   bilinear interpolation at berg location of horizontal scale factor
+      !! ** Method  :   interpolation done using the 4 nearest grid points among
+      !!                t-, u-, v-, and f-points.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pet, peu, pev, pef   ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts
+      REAL(wp)                , INTENT(in) ::   pi, pj               ! targeted coordinates in (i,j) referential
+      !
+      INTEGER  ::   ii, ij, icase   ! local integer
+      !
+      ! weights corresponding to corner points of a T cell quadrant
+      REAL(wp) ::   zi, zj          ! local real
+      !
+      ! values at corner points of a T cell quadrant
+      ! 00 = bottom left, 10 = bottom right, 01 = top left, 11 = top right
+      REAL(wp) ::   ze00, ze10, ze01, ze11
+      !!----------------------------------------------------------------------
+      !
+      ii = MAX(1, INT( pi ))   ;   ij = MAX(1, INT( pj ))            ! left bottom T-point (i,j) indices
+
+      ! fractional box spacing
+      ! 0   <= zi < 0.5, 0   <= zj < 0.5   -->  NW quadrant of current T cell
+      ! 0.5 <= zi < 1  , 0   <= zj < 0.5   -->  NE quadrant
+      ! 0   <= zi < 0.5, 0.5 <= zj < 1     -->  SE quadrant
+      ! 0.5 <= zi < 1  , 0.5 <= zj < 1     -->  SW quadrant
+
+      zi = pi - REAL(ii,wp)          !!gm use here mig, mjg arrays
+      zj = pj - REAL(ij,wp)
+
+      ! find position in this processor. Prevent near edge problems (see #1389)
+
+      if (ii.lt.mig(1)) then
+        ii = 1
+      else if (ii.gt.mig(jpi)) then
+        ii = jpi
+      else
+        ii  = mi1( ii  )
+      end if
+
+      if (ij.lt.mjg(1)) then
+        ij = 1
+      else if (ij.gt.mjg(jpj)) then
+        ij = jpj
+      else
+        ij  = mj1( ij  )
+      end if
+
+      if (ij.eq.jpj) ij=ij-1
+      if (ii.eq.jpi) ii=ii-1
+
+      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN
+         IF( 0.0_wp <= zj .AND. zj < 0.5_wp        )   THEN        !  NE quadrant
+            !                                                      !             i=I       i=I+1/2
+            ze01 = pev(ii  ,ij  )   ;   ze11 = pef(ii  ,ij  )      !   j=J+1/2    V ------- F
+            ze00 = pet(ii  ,ij  )   ;   ze10 = peu(ii  ,ij  )      !   j=J        T ------- U
+            zi = 2._wp * zi
+            zj = 2._wp * zj
+         ELSE                                                      !  SE quadrant
+            !                                                                    !             i=I       i=I+1/2
+            ze01 = pet(ii  ,ij+1)   ;   ze11 = peu(ii  ,ij+1)      !   j=J+1      T ------- U
+            ze00 = pev(ii  ,ij  )   ;   ze10 = pef(ii  ,ij  )      !   j=J+1/2    V ------- F
+            zi = 2._wp *  zi
+            zj = 2._wp * (zj-0.5_wp)
+         ENDIF
+      ELSE
+         IF( 0.0_wp <= zj .AND. zj < 0.5_wp        )   THEN        !  NW quadrant
+            !                                                                    !             i=I       i=I+1/2
+            ze01 = pef(ii  ,ij  )   ;   ze11 = pev(ii+1,ij)        !   j=J+1/2    F ------- V
+            ze00 = peu(ii  ,ij  )   ;   ze10 = pet(ii+1,ij)        !   j=J        U ------- T
+            zi = 2._wp * (zi-0.5_wp)
+            zj = 2._wp *  zj
+         ELSE                                                      !  SW quadrant
+            !                                                                    !             i=I+1/2   i=I+1
+            ze01 = peu(ii  ,ij+1)   ;   ze11 = pet(ii+1,ij+1)      !   j=J+1      U ------- T
+            ze00 = pef(ii  ,ij  )   ;   ze10 = pev(ii+1,ij  )      !   j=J+1/2    F ------- V
+            zi = 2._wp * (zi-0.5_wp)
+            zj = 2._wp * (zj-0.5_wp)
+         ENDIF
+      ENDIF
+      !
+      icb_utl_bilin_e = ( ze01 * (1.-zi) + ze11 * zi ) *     zj    &
+         &            + ( ze00 * (1.-zi) + ze10 * zi ) * (1.-zj)
+      !
+   END FUNCTION icb_utl_bilin_e
+
+
+   SUBROUTINE icb_utl_add( bergvals, ptvals )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE icb_utl_add           ***
+      !!
+      !! ** Purpose :   add a new berg to the iceberg list
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), INTENT(in)           ::   bergvals
+      TYPE(point)  , INTENT(in)           ::   ptvals
+      !
+      TYPE(iceberg), POINTER ::   new => NULL()
+      !!----------------------------------------------------------------------
+      !
+      new => NULL()
+      CALL icb_utl_create( new, bergvals, ptvals )
+      CALL icb_utl_insert( new )
+      new => NULL()     ! Clear new
+      !
+   END SUBROUTINE icb_utl_add         
+
+
+   SUBROUTINE icb_utl_create( berg, bergvals, ptvals )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE icb_utl_create  ***
+      !!
+      !! ** Purpose :   add a new berg to the iceberg list
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), INTENT(in) ::   bergvals
+      TYPE(point)  , INTENT(in) ::   ptvals
+      TYPE(iceberg), POINTER    ::   berg
+      !
+      TYPE(point)  , POINTER    ::   pt
+      INTEGER                   ::   istat
+      !!----------------------------------------------------------------------
+      !
+      IF( ASSOCIATED(berg) )   CALL ctl_stop( 'icebergs, icb_utl_create: berg already associated' )
+      ALLOCATE(berg, STAT=istat)
+      IF( istat /= 0 ) CALL ctl_stop( 'failed to allocate iceberg' )
+      berg%number(:) = bergvals%number(:)
+      berg%mass_scaling = bergvals%mass_scaling
+      berg%prev => NULL()
+      berg%next => NULL()
+      !
+      ALLOCATE(pt, STAT=istat)
+      IF( istat /= 0 ) CALL ctl_stop( 'failed to allocate first iceberg point' )
+      pt = ptvals
+      berg%current_point => pt
+      !
+   END SUBROUTINE icb_utl_create
+
+
+   SUBROUTINE icb_utl_insert( newberg )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_insert  ***
+      !!
+      !! ** Purpose :   add a new berg to the iceberg list
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER  ::   newberg
+      !
+      TYPE(iceberg), POINTER  ::   this, prev, last
+      !!----------------------------------------------------------------------
+      !
+      IF( ASSOCIATED( first_berg ) ) THEN
+         last => first_berg
+         DO WHILE (ASSOCIATED(last%next))
+            last => last%next
+         ENDDO
+         newberg%prev => last
+         last%next    => newberg
+         last         => newberg
+      ELSE                       ! list is empty so create it
+         first_berg => newberg
+      ENDIF
+      !
+   END SUBROUTINE icb_utl_insert
+
+
+   REAL(wp) FUNCTION icb_utl_yearday(kmon, kday, khr, kmin, ksec)
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION icb_utl_yearday  ***
+      !!
+      !! ** Purpose :   
+      !!
+      ! sga - improved but still only applies to 365 day year, need to do this properly
+      !
+      !!gm  all these info are already known in daymod, no???
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)     :: kmon, kday, khr, kmin, ksec
+      ! 
+      INTEGER, DIMENSION(12)  :: imonths = (/ 0,31,28,31,30,31,30,31,31,30,31,30 /)
+      !!----------------------------------------------------------------------
+      !
+      icb_utl_yearday = REAL( SUM( imonths(1:kmon) ), wp )
+      icb_utl_yearday = icb_utl_yearday + REAL(kday-1,wp) + (REAL(khr,wp) + (REAL(kmin,wp) + REAL(ksec,wp)/60.)/60.)/24.
+      !
+   END FUNCTION icb_utl_yearday
+
+   !!-------------------------------------------------------------------------
+
+   SUBROUTINE icb_utl_delete( first, berg )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_delete  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER :: first, berg
+      !!----------------------------------------------------------------------
+      ! Connect neighbors to each other
+      IF ( ASSOCIATED(berg%prev) ) THEN
+        berg%prev%next => berg%next
+      ELSE
+        first => berg%next
+      ENDIF
+      IF (ASSOCIATED(berg%next)) berg%next%prev => berg%prev
+      !
+      CALL icb_utl_destroy(berg)
+      !
+   END SUBROUTINE icb_utl_delete
+
+
+   SUBROUTINE icb_utl_destroy( berg )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_destroy  ***
+      !!
+      !! ** Purpose :   remove a single iceberg instance
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER :: berg
+      !!----------------------------------------------------------------------
+      !
+      ! Remove any points
+      IF( ASSOCIATED( berg%current_point ) )   DEALLOCATE( berg%current_point )
+      !
+      DEALLOCATE(berg)
+      !
+   END SUBROUTINE icb_utl_destroy
+
+
+   SUBROUTINE icb_utl_track( knum, cd_label, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_track  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(nkounts)    :: knum       ! iceberg number
+      CHARACTER(len=*)               :: cd_label   ! 
+      INTEGER                        :: kt         ! timestep number
+      ! 
+      TYPE(iceberg), POINTER         :: this
+      LOGICAL                        :: match
+      INTEGER                        :: k
+      !!----------------------------------------------------------------------
+      !
+      this => first_berg
+      DO WHILE( ASSOCIATED(this) )
+         match = .TRUE.
+         DO k = 1, nkounts
+            IF( this%number(k) /= knum(k) ) match = .FALSE.
+         END DO
+         IF( match )   CALL icb_utl_print_berg(this, kt)
+         this => this%next
+      END DO
+      !
+   END SUBROUTINE icb_utl_track
+
+
+   SUBROUTINE icb_utl_print_berg( berg, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_print_berg  ***
+      !!
+      !! ** Purpose :   print one
+      !!
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER :: berg
+      TYPE(point)  , POINTER :: pt
+      INTEGER                :: kt      ! timestep number
+      !!----------------------------------------------------------------------
+      !
+      pt => berg%current_point
+      WRITE(numicb, 9200) kt, berg%number(1), &
+                   pt%xi, pt%yj, pt%lon, pt%lat, pt%uvel, pt%vvel,  &
+                   pt%uo, pt%vo, pt%ua, pt%va, pt%ui, pt%vi
+      CALL flush( numicb )
+ 9200 FORMAT(5x,i5,2x,i10,6(2x,2f10.4))
+      !
+   END SUBROUTINE icb_utl_print_berg
+
+
+   SUBROUTINE icb_utl_print( cd_label, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_print  ***
+      !!
+      !! ** Purpose :   print many
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)       :: cd_label
+      INTEGER                :: kt             ! timestep number
+      ! 
+      INTEGER                :: ibergs, inbergs
+      TYPE(iceberg), POINTER :: this
+      !!----------------------------------------------------------------------
+      !
+      this => first_berg
+      IF( ASSOCIATED(this) ) THEN
+         WRITE(numicb,'(a," pe=(",i3,")")' ) cd_label, narea
+         WRITE(numicb,'(a8,4x,a6,12x,a5,15x,a7,19x,a3,17x,a5,17x,a5,17x,a5)' )   &
+            &         'timestep', 'number', 'xi,yj','lon,lat','u,v','uo,vo','ua,va','ui,vi'
+      ENDIF
+      DO WHILE( ASSOCIATED(this) )
+        CALL icb_utl_print_berg(this, kt)
+        this => this%next
+      END DO
+      ibergs = icb_utl_count()
+      inbergs = ibergs
+      IF( lk_mpp )   CALL mpp_sum(inbergs)
+      IF( ibergs > 0 )   WRITE(numicb,'(a," there are",i5," bergs out of",i6," on PE ",i4)')   &
+         &                                  cd_label, ibergs, inbergs, narea
+      !
+   END SUBROUTINE icb_utl_print
+
+
+   SUBROUTINE icb_utl_incr()
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE icb_utl_incr  ***
+      !!
+      !! ** Purpose :   
+      !!
+      ! Small routine for coping with very large integer values labelling icebergs
+      ! num_bergs is a array of integers
+      ! the first member is incremented in steps of jpnij starting from narea
+      ! this means each iceberg is labelled with a unique number
+      ! when this gets to the maximum allowed integer the second and subsequent members are 
+      ! used to count how many times the member before cycles
+      !!----------------------------------------------------------------------
+      INTEGER ::   ii, ibig
+      !!----------------------------------------------------------------------
+
+      ibig = HUGE(num_bergs(1))
+      IF( ibig-jpnij < num_bergs(1) ) THEN
+         num_bergs(1) = narea
+         DO ii = 2,nkounts
+            IF( num_bergs(ii) == ibig ) THEN
+               num_bergs(ii) = 0
+               IF( ii == nkounts ) CALL ctl_stop('Sorry, run out of iceberg number space')
+            ELSE
+               num_bergs(ii) = num_bergs(ii) + 1
+               EXIT
+            ENDIF
+         END DO
+      ELSE
+         num_bergs(1) = num_bergs(1) + jpnij
+      ENDIF
+      !
+   END SUBROUTINE icb_utl_incr
+
+
+   INTEGER FUNCTION icb_utl_count()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION icb_utl_count  ***
+      !!
+      !! ** Purpose :   
+      !!----------------------------------------------------------------------
+      TYPE(iceberg), POINTER :: this
+      !!----------------------------------------------------------------------
+      !
+      icb_utl_count = 0
+      this => first_berg
+      DO WHILE( ASSOCIATED(this) )
+         icb_utl_count = icb_utl_count+1
+         this => this%next
+      END DO
+      !
+   END FUNCTION icb_utl_count
+
+
+   REAL(wp) FUNCTION icb_utl_mass( first, justbits, justbergs )
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION icb_utl_mass  ***
+      !!
+      !! ** Purpose :   compute the mass all iceberg, all berg bits or all bergs.
+      !!----------------------------------------------------------------------
+      TYPE(iceberg)      , POINTER  ::   first
+      TYPE(point)        , POINTER  ::   pt
+      LOGICAL, INTENT(in), OPTIONAL ::   justbits, justbergs
+      !
+      TYPE(iceberg), POINTER ::   this
+      !!----------------------------------------------------------------------
+      icb_utl_mass = 0._wp
+      this => first
+      !
+      IF( PRESENT( justbergs  ) ) THEN
+         DO WHILE( ASSOCIATED( this ) )
+            pt => this%current_point
+            icb_utl_mass = icb_utl_mass + pt%mass         * this%mass_scaling
+            this => this%next
+         END DO
+      ELSEIF( PRESENT(justbits) ) THEN
+         DO WHILE( ASSOCIATED( this ) )
+            pt => this%current_point
+            icb_utl_mass = icb_utl_mass + pt%mass_of_bits * this%mass_scaling
+            this => this%next
+         END DO
+      ELSE
+         DO WHILE( ASSOCIATED( this ) )
+            pt => this%current_point
+            icb_utl_mass = icb_utl_mass + ( pt%mass + pt%mass_of_bits ) * this%mass_scaling
+            this => this%next
+         END DO
+      ENDIF
+      !
+   END FUNCTION icb_utl_mass
+
+
+   REAL(wp) FUNCTION icb_utl_heat( first, justbits, justbergs )
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION icb_utl_heat  ***
+      !!
+      !! ** Purpose :   compute the heat in all iceberg, all bergies or all bergs.
+      !!----------------------------------------------------------------------
+      TYPE(iceberg)      , POINTER  ::   first
+      LOGICAL, INTENT(in), OPTIONAL ::   justbits, justbergs
+      !
+      TYPE(iceberg)      , POINTER  ::   this
+      TYPE(point)        , POINTER  ::   pt
+      !!----------------------------------------------------------------------
+      icb_utl_heat = 0._wp
+      this => first
+      !
+      IF( PRESENT( justbergs  ) ) THEN
+         DO WHILE( ASSOCIATED( this ) )
+            pt => this%current_point
+            icb_utl_heat = icb_utl_heat + pt%mass         * this%mass_scaling * pt%heat_density
+            this => this%next
+         END DO
+      ELSEIF( PRESENT(justbits) ) THEN
+         DO WHILE( ASSOCIATED( this ) )
+            pt => this%current_point
+            icb_utl_heat = icb_utl_heat + pt%mass_of_bits * this%mass_scaling * pt%heat_density
+            this => this%next
+         END DO
+      ELSE
+         DO WHILE( ASSOCIATED( this ) )
+            pt => this%current_point
+            icb_utl_heat = icb_utl_heat + ( pt%mass + pt%mass_of_bits ) * this%mass_scaling * pt%heat_density
+            this => this%next
+         END DO
+      ENDIF
+      !
+   END FUNCTION icb_utl_heat
+
+   !!======================================================================
+END MODULE icbutl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 8732)
@@ -0,0 +1,158 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! I/O manager utilities : Defines run parameters together with logical units
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory
+   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output)
+   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
+   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
+   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
+   INTEGER       ::   nn_no            !: job number
+   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh   = 0  !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000         !: index of the first time step
+   INTEGER       ::   nn_itend         !: index of the last time step
+   INTEGER       ::   nn_date0         !: initial calendar date aammjj
+   INTEGER       ::   nn_time0         !: initial time of day in hhmm
+   INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate        !: initial state output flag (0/1)
+   INTEGER       ::   nn_write         !: model standard output frequency
+   INTEGER       ::   nn_stock         !: restart file frequency
+   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
+   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
+   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+
+#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   !: number of chunks required in the i-dimension 
+   INTEGER ::   nn_nchunks_j   !: number of chunks required in the j-dimension 
+   INTEGER ::   nn_nchunks_k   !: number of chunks required in the k-dimension 
+   INTEGER ::   nn_nchunks_t   !: number of chunks required in the t-dimension 
+   LOGICAL ::   ln_nc4zip      !: 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(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
+   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times
+
+   !!----------------------------------------------------------------------
+   !! 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
+   LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
+   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+   INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   nrst_lst              !: number of restart to output next
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_ctl           !: run control for debugging
+   INTEGER ::   nn_timing        !: run control for timing
+   INTEGER ::   nn_diacfl        !: flag whether to create CFL diagnostics
+   INTEGER ::   nn_print         !: level of print (0 no print)
+   INTEGER ::   nn_ictls         !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle         !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls         !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle         !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt         !: number of processors following i
+   INTEGER ::   nn_jsplt         !: number of processors following j
+   INTEGER ::   nn_bench         !: benchmark parameter (0/1)
+   INTEGER ::   nn_bit_cmp = 0   !: bit reproducibility  (0/1)
+   !                                          
+   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names
+
+   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
+
+   !!----------------------------------------------------------------------
+   !!                        logical units
+   !!----------------------------------------------------------------------
+   INTEGER ::   numstp          =   -1      !: logical unit for time step
+   INTEGER ::   numtime         =   -1      !: logical unit for timing
+   INTEGER ::   numout          =    6      !: logical unit for output print; Set to stdout to ensure any early
+                                            !  output can be collected; do not change
+   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist
+   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist
+   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics
+   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
+   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics
+   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
+   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
+   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
+   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
+   INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
+   INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
+
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print)
+   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       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always)
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+   CHARACTER(lc) ::   cxios_context         !: context name used in xios
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!=====================================================================
+END MODULE in_out_manager
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 8732)
@@ -0,0 +1,1898 @@
+MODULE iom
+   !!=====================================================================
+   !!                    ***  MODULE  iom ***
+   !! Input/Output manager :  Library to read input files
+   !!====================================================================
+   !! History :  2.0  ! 2005-12  (J. Belier) Original code
+   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
+   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
+   !!            3.6  ! 2014-15  DIMG format removed
+   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
+   !!--------------------------------------------------------------------
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis cdvar in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE c1d             ! 1D vertical configuration
+   USE flo_oce         ! floats module declarations
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE iom_nf90        ! NetCDF format with native NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp           ! MPP library
+#if defined key_iomput
+   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain
+   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
+   USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes
+#if defined key_lim3
+   USE ice    , ONLY :   jpl
+#elif defined key_lim2
+   USE par_ice_2
+#endif
+   USE domngb          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE dianam          ! build name of file
+   USE xios
+# endif
+   USE ioipsl, ONLY :  ju2ymds    ! for calendar
+   USE crs             ! Grid coarsening
+
+   IMPLICIT NONE
+   PUBLIC   !   must be public to be able to access iom_def through iom
+   
+#if defined key_iomput
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
+#endif
+   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get
+   PUBLIC iom_getatt, iom_putatt, iom_gettime, iom_rstput, iom_put
+   PUBLIC iom_use, iom_context_finalize
+
+   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
+   PRIVATE iom_p1d, iom_p2d, iom_p3d
+#if defined key_iomput
+   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
+   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+# endif
+
+   INTERFACE iom_get
+      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
+   END INTERFACE
+   INTERFACE iom_getatt
+      MODULE PROCEDURE iom_g0d_iatt, iom_g0d_ratt, iom_g0d_catt
+   END INTERFACE
+   INTERFACE iom_putatt
+      MODULE PROCEDURE iom_p0d_iatt, iom_p0d_ratt, iom_p0d_catt
+   END INTERFACE
+   INTERFACE iom_rstput
+      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   END INTERFACE
+  INTERFACE iom_put
+     MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+  END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_init( cdname ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)  :: cdname
+#if defined key_iomput
+
+      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
+      TYPE(xios_date)     :: start_date
+      CHARACTER(len=10) :: clname
+      INTEGER           :: ji, jkmin
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
+
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
+      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
+      CALL iom_swap( cdname )
+
+
+      ! Calendar type is now defined in xml file 
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      END SELECT
+
+      ! horizontal grid definition
+      CALL set_scalar
+
+      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
+         CALL set_grid( "T", glamt, gphit ) 
+         CALL set_grid( "U", glamu, gphiu )
+         CALL set_grid( "V", glamv, gphiv )
+         CALL set_grid( "W", glamt, gphit )
+         CALL set_grid_znl( gphit )
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
+            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
+            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
+         ENDIF
+      ENDIF
+
+      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN  
+         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+         !
+         CALL set_grid( "T", glamt_crs, gphit_crs ) 
+         CALL set_grid( "U", glamu_crs, gphiu_crs ) 
+         CALL set_grid( "V", glamv_crs, gphiv_crs ) 
+         CALL set_grid( "W", glamt_crs, gphit_crs ) 
+         CALL set_grid_znl( gphit_crs )
+          !
+         CALL dom_grid_glo   ! Return to parent grid domain
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
+            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
+            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+         ENDIF
+      ENDIF
+
+      ! vertical grid definition
+      CALL iom_set_axis_attr( "deptht", gdept_1d )
+      CALL iom_set_axis_attr( "depthu", gdept_1d )
+      CALL iom_set_axis_attr( "depthv", gdept_1d )
+      CALL iom_set_axis_attr( "depthw", gdepw_1d )
+
+      ! Add vertical grid bounds
+      jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D)
+      zt_bnds(2,:        ) = gdept_1d(:)
+      zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1)
+      zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1)
+      zw_bnds(1,:        ) = gdepw_1d(:)
+      zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk)
+      zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk)
+      CALL iom_set_axis_attr( "deptht", bounds=zt_bnds )
+      CALL iom_set_axis_attr( "depthu", bounds=zt_bnds )
+      CALL iom_set_axis_attr( "depthv", bounds=zt_bnds )
+      CALL iom_set_axis_attr( "depthw", bounds=zw_bnds )
+
+
+# if defined key_floats
+      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
+# endif
+#if defined key_lim3 || defined key_lim2
+      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
+#endif
+      CALL iom_set_axis_attr( "icbcla", class_num )
+      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
+      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
+      
+      ! automatic definitions of some of the xml attributs
+      CALL set_xmlatt
+
+      ! end file definition
+      dtime%second = rdt
+      CALL xios_set_timestep(dtime)
+      CALL xios_close_context_definition()
+      
+      CALL xios_update_calendar(0)
+
+      DEALLOCATE( zt_bnds, zw_bnds )
+
+#endif
+      
+   END SUBROUTINE iom_init
+
+
+   SUBROUTINE iom_swap( cdname )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdname
+#if defined key_iomput
+      TYPE(xios_context) :: nemo_hdl
+
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
+      ELSE
+        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
+      ENDIF
+      !
+      CALL xios_set_current_context(nemo_hdl)
+#endif
+      !
+   END SUBROUTINE iom_swap
+
+
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
+      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90) 
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
+
+      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
+      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" 
+      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
+      CHARACTER(LEN=256)    ::   clinfo    ! info character
+      LOGICAL               ::   llok      ! check the existence 
+      LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
+      LOGICAL               ::   llstop    ! local definition of ldstop
+      LOGICAL               ::   lliof     ! local definition of ldiof
+      INTEGER               ::   iolib     ! library do we use to open the file
+      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
+      INTEGER               ::   iln, ils  ! lengths of character
+      INTEGER               ::   idom      ! type of domain
+      INTEGER               ::   istop     ! 
+      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters: 
+      ! local number of points for x,y dimensions
+      ! position of first local point for x,y dimensions
+      ! position of last local point for x,y dimensions
+      ! start halo size for x,y dimensions
+      ! end halo size for x,y dimensions
+      !---------------------------------------------------------------------
+      ! Initializations and control
+      ! =============
+      kiomid = -1
+      clinfo = '                    iom_open ~~~  '
+      istop = nstop
+      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
+      ! (could be done when defining iom_file in f95 but not in f90)
+      IF( Agrif_Root() ) THEN
+         IF( iom_open_init == 0 ) THEN
+            iom_file(:)%nfid = 0
+            iom_open_init = 1
+         ENDIF
+      ENDIF
+      ! do we read or write the file?
+      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
+      ELSE                        ;   llwrt = .FALSE.
+      ENDIF
+      ! do we call ctl_stop if we try to open a non-existing file in read mode?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      ! what library do we use to open the file?
+      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib
+      ELSE                         ;   iolib = jpnf90
+      ENDIF
+      ! are we using interpolation on the fly?
+      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
+      ELSE                        ;   lliof = .FALSE.
+      ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
+      ! =============
+      clname   = trim(cdname)
+      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
+      ! which suffix should we use?
+      SELECT CASE (iolib)
+      CASE (jpnf90   ) ;   clsuffix = '.nc'
+      CASE DEFAULT     ;   clsuffix = ''
+         CALL ctl_stop( TRIM(clinfo), 'accepted IO library is only jpnf90 (jpioipsl option has been removed) ' )
+      END SELECT
+      ! Add the suffix if needed
+      iln = LEN_TRIM(clname)
+      ils = LEN_TRIM(clsuffix)
+      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
+         &   clname = TRIM(clname)//TRIM(clsuffix)
+      cltmpn = clname   ! store this name
+      ! try to find if the file to be opened already exist
+      ! =============
+      INQUIRE( FILE = clname, EXIST = llok )
+      IF( .NOT.llok ) THEN
+         ! we try to add the cpu number to the name
+         WRITE(clcpu,*) narea-1
+
+         clcpu  = TRIM(ADJUSTL(clcpu))
+         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
+         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+         icnt = 0
+         INQUIRE( FILE = clname, EXIST = llok ) 
+         ! we try different formats for the cpu number by adding 0
+         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
+            clcpu  = "0"//trim(clcpu)
+            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+            INQUIRE( FILE = clname, EXIST = llok )
+            icnt = icnt + 1
+         END DO
+      ENDIF
+      IF( llwrt ) THEN
+         ! check the domain definition
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         idom = jpdom_local_noovlap   ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
+         ENDIF
+         IF( PRESENT(kdom) )   idom = kdom
+         ! create the domain informations
+         ! =============
+         SELECT CASE (idom)
+         CASE (jpdom_local_full)
+            idompar(:,1) = (/ jpi             , jpj              /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
+         CASE (jpdom_local_noextra)
+            idompar(:,1) = (/ nlci            , nlcj             /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
+         CASE (jpdom_local_noovlap)
+            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
+            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
+            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
+            idompar(:,4) = (/ 0               , 0                /)
+            idompar(:,5) = (/ 0               , 0                /)
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
+         END SELECT
+      ENDIF
+      ! Open the NetCDF file
+      ! =============
+      ! do we have some free file identifier?
+      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
+         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
+      ! if no file was found...
+      IF( .NOT. llok ) THEN
+         IF( .NOT. llwrt ) THEN   ! we are in read mode 
+            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
+            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
+            ENDIF
+         ELSE                     ! we are in write mode so we 
+            clname = cltmpn       ! get back the file name without the cpu number
+         ENDIF
+      ELSE
+         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
+            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
+            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
+         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
+            clname = cltmpn       ! overwrite so get back the file name without the cpu number
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN   ! no error within this routine
+         SELECT CASE (iolib)
+         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' )
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE iom_open
+
+
+   SUBROUTINE iom_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_close  ***
+      !!
+      !! ** Purpose : close an input file, or all files opened by iom
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
+      !                                              ! return 0 when file is properly closed
+      !                                              ! No argument: all files opened by iom are closed
+
+      INTEGER ::   jf         ! dummy loop indices
+      INTEGER ::   i_s, i_e   ! temporary integer
+      CHARACTER(LEN=100)    ::   clinfo    ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_close ~~~  '
+      IF( PRESENT(kiomid) ) THEN
+         i_s = kiomid
+         i_e = kiomid
+      ELSE
+         i_s = 1
+         i_e = jpmax_files
+      ENDIF
+
+      IF( i_s > 0 ) THEN
+         DO jf = i_s, i_e
+            IF( iom_file(jf)%nfid > 0 ) THEN
+               SELECT CASE (iom_file(jf)%iolib)
+               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
+               CASE DEFAULT
+                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+               END SELECT
+               iom_file(jf)%nfid       = 0          ! free the id 
+               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
+            ELSEIF( PRESENT(kiomid) ) THEN
+               WRITE(ctmp1,*) '--->',  kiomid
+               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
+            ENDIF
+         END DO
+      ENDIF
+      !    
+   END SUBROUTINE iom_close
+
+
+   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
+      !
+      INTEGER                        ::   iom_varid, iiv, i_nvd
+      LOGICAL                        ::   ll_fnd
+      CHARACTER(LEN=100)             ::   clinfo                   ! info character
+      LOGICAL                        ::   llstop                   ! local definition of ldstop
+      !!-----------------------------------------------------------------------
+      iom_varid = 0                         ! default definition
+      ! do we call ctl_stop if we look for non-existing variable?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      !
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+         IF( iom_file(kiomid)%nfid == 0 ) THEN 
+            CALL ctl_stop( trim(clinfo), 'the file is not open' )
+         ELSE
+            ll_fnd  = .FALSE.
+            iiv = 0
+            !
+            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
+               iiv = iiv + 1
+               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
+            END DO
+            !
+            IF( .NOT.ll_fnd ) THEN
+               iiv = iiv + 1
+               IF( iiv <= jpmax_vars ) THEN
+                  SELECT CASE (iom_file(kiomid)%iolib)
+                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims )
+                  CASE DEFAULT
+                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+                  END SELECT
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
+                        &                         'increase the parameter jpmax_vars')
+               ENDIF
+               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
+            ELSE
+               iom_varid = iiv
+               IF( PRESENT(kdimsz) ) THEN 
+                  i_nvd = iom_file(kiomid)%ndims(iiv)
+                  IF( i_nvd == size(kdimsz) ) THEN
+                     kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
+                  ELSE
+                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
+                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
+                  ENDIF
+               ENDIF
+               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END FUNCTION iom_varid
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_get
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
+      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
+      !
+      INTEGER                                         ::   idvar     ! variable id
+      INTEGER                                         ::   idmspc    ! number of spatial dimensions
+      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
+      CHARACTER(LEN=100)                              ::   clinfo    ! info character
+      CHARACTER(LEN=100)                              ::   clname    ! file name
+      CHARACTER(LEN=1)                                ::   cldmspc   !
+      !
+      itime = 1
+      IF( PRESENT(ktime) ) itime = ktime
+      !
+      clname = iom_file(kiomid)%name
+      clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
+      !
+      IF( kiomid > 0 ) THEN
+         idvar = iom_varid( kiomid, cdvar )
+         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+            idmspc = iom_file ( kiomid )%ndims( idvar )
+            IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
+            WRITE(cldmspc , fmt='(i1)') idmspc
+            IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
+                                 &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
+                                 &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d
+
+   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+      ENDIF
+   END SUBROUTINE iom_g1d
+
+   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
+      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                               ! look for and use a file attribute
+                                                                               ! called open_ocean_jstart to set the start
+                                                                               ! value for the 2nd dimension (netcdf only)
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr )
+      ENDIF
+   END SUBROUTINE iom_g2d
+
+   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
+      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                                 ! look for and use a file attribute
+                                                                                 ! called open_ocean_jstart to set the start
+                                                                                 ! value for the 2nd dimension (netcdf only)
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr )
+      ENDIF
+   END SUBROUTINE iom_g3d
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
+         &                  pv_r1d, pv_r2d, pv_r3d,   &
+         &                  ktime , kstart, kcount,   &
+         &                  lrowattr                )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_get_123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
+                                                                           ! look for and use a file attribute
+                                                                           ! called open_ocean_jstart to set the start
+                                                                           ! value for the 2nd dimension (netcdf only)
+      !
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
+      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
+      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
+      INTEGER                        ::   jl          ! loop on number of dimension 
+      INTEGER                        ::   idom        ! type of domain
+      INTEGER                        ::   idvar       ! id of the variable
+      INTEGER                        ::   inbdim      ! number of dimensions of the variable
+      INTEGER                        ::   idmspc      ! number of spatial dimensions 
+      INTEGER                        ::   itime       ! record number
+      INTEGER                        ::   istop       ! temporary value of nstop
+      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER                        ::   ji, jj      ! loop counters
+      INTEGER                        ::   irankpv     ! 
+      INTEGER                        ::   ind1, ind2  ! substring index
+      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
+      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
+      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
+      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
+      INTEGER                        ::   itmp        ! temporary integer
+      CHARACTER(LEN=256)             ::   clinfo      ! info character
+      CHARACTER(LEN=256)             ::   clname      ! file name
+      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
+      !---------------------------------------------------------------------
+      !
+      clname = iom_file(kiomid)%name   !   esier to read
+      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
+      ! local definition of the domain ?
+      idom = kdom
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      ! check kcount and kstart optionals parameters...
+      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
+      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
+      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) &
+     &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
+
+      luse_jattr = .false.
+      IF( PRESENT(lrowattr) ) THEN
+         IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
+         IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true.
+      ENDIF
+      IF( luse_jattr ) THEN
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpnf90   )   
+             ! Ok
+         CASE DEFAULT    
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+         END SELECT
+      ENDIF
+
+      ! Search for the variable in the data base (eventually actualize data)
+      istop = nstop
+      idvar = iom_varid( kiomid, cdvar )
+      !
+      IF( idvar > 0 ) THEN
+         ! to write iom_file(kiomid)%dimsz in a shorter way !
+         idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
+         inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
+         idmspc = inbdim                                   ! number of spatial dimensions in the file
+         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
+         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
+         !
+         ! update idom definition...
+         ! Identify the domain in case of jpdom_auto(glo/dta) definition
+         IF( idom == jpdom_autoglo_xy ) THEN
+            ll_depth_spec = .TRUE.
+            idom = jpdom_autoglo
+         ELSE
+            ll_depth_spec = .FALSE.
+         ENDIF
+         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
+            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
+            ELSE                               ;   idom = jpdom_data
+            ENDIF
+            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
+            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
+            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
+         ENDIF
+         ! Identify the domain in case of jpdom_local definition
+         IF( idom == jpdom_local ) THEN
+            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
+            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
+            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
+            ENDIF
+         ENDIF
+         !
+         ! check the consistency between input array and data rank in the file
+         !
+         ! initializations
+         itime = 1
+         IF( PRESENT(ktime) ) itime = ktime
+
+         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
+         WRITE(clrankpv, fmt='(i1)') irankpv
+         WRITE(cldmspc , fmt='(i1)') idmspc
+         !
+         IF(     idmspc <  irankpv ) THEN 
+            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+               &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+         ELSEIF( idmspc == irankpv ) THEN
+            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
+               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
+         ELSEIF( idmspc >  irankpv ) THEN
+               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
+                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
+                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
+                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
+                  idmspc = idmspc - 1
+               ELSE
+                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
+                     &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
+                     &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+               ENDIF
+         ENDIF
+
+         !
+         ! definition of istart and icnt
+         !
+         icnt  (:) = 1
+         istart(:) = 1
+         istart(idmspc+1) = itime
+
+         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
+         ELSE
+            IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc)
+            ELSE 
+               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
+                  IF(     idom == jpdom_data    ) THEN
+                     jstartrow = 1
+                     IF( luse_jattr ) THEN
+                        CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+                        jstartrow = MAX(1,jstartrow)
+                     ENDIF
+                     istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below
+                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below
+                  ENDIF
+                  ! we do not read the overlap                     -> we start to read at nldi, nldj
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                  ENDIF
+                  IF( PRESENT(pv_r3d) ) THEN
+                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkglo
+                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3)
+                     ELSE                                                           ; icnt(3) = jpk
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+
+         ! check that istart and icnt can be used with this file
+         !-
+         DO jl = 1, jpmax_dims
+            itmp = istart(jl)+icnt(jl)-1
+            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
+               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
+               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
+               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
+            ENDIF
+         END DO
+
+         ! check that icnt matches the input array
+         !-     
+         IF( idom == jpdom_unknown ) THEN
+            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
+            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
+            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
+            ctmp1 = 'd'
+         ELSE
+            IF( irankpv == 2 ) THEN
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
+               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+               ENDIF
+            ENDIF
+            IF( irankpv == 3 ) THEN 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
+               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+               ENDIF
+            ENDIF
+         ENDIF
+         
+         DO jl = 1, irankpv
+            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
+            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
+         END DO
+
+      ENDIF
+
+      ! read the data
+      !-     
+      IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
+         !
+         ! find the right index of the array to be read
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+!         ENDIF
+         IF( llnoov ) THEN
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+            ENDIF
+         ELSE
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+            ENDIF
+         ENDIF
+      
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+         END SELECT
+
+         IF( istop == nstop ) THEN   ! no additional errors until this point...
+            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+          
+            !--- overlap areas and extra hallows (mpp)
+            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
+               CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
+            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
+               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
+               IF( icnt(3) == jpk ) THEN
+                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
+               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
+                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
+                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
+               ENDIF
+            ENDIF
+            
+            ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
+            IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( pv_r2d,'Z',1. )
+            IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( pv_r3d,'Z',1. )
+    
+            !--- Apply scale_factor and offset
+            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
+            zofs = iom_file(kiomid)%ofs(idvar)      ! offset
+            IF(     PRESENT(pv_r1d) ) THEN
+               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
+               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
+            ELSEIF( PRESENT(pv_r2d) ) THEN
+               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
+               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
+            ELSEIF( PRESENT(pv_r3d) ) THEN
+               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
+               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE iom_get_123d
+
+
+   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier
+      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name
+      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file
+      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate
+      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of 
+      !
+      INTEGER, DIMENSION(1) :: kdimsz
+      INTEGER            ::   idvar    ! id of the variable
+      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate
+      CHARACTER(LEN=100) ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      IF ( PRESENT(cdvar) ) THEN
+         tname = cdvar
+      ELSE
+         tname = iom_file(kiomid)%uldname
+      ENDIF
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
+         IF ( PRESENT(kntime) ) THEN
+            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz )
+            kntime = kdimsz(1)
+         ELSE
+            idvar = iom_varid( kiomid, tname )
+         ENDIF
+         !
+         ptime(:) = 0. ! default definition
+         IF( idvar > 0 ) THEN
+            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
+               IF( iom_file(kiomid)%luld(idvar) ) THEN
+                  IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
+                     SELECT CASE (iom_file(kiomid)%iolib)
+                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
+                     CASE DEFAULT
+                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+                     END SELECT
+                  ELSE
+                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
+                     CALL ctl_stop( trim(clinfo), trim(ctmp1) )
+                  ENDIF
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
+               ENDIF
+            ELSE
+               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
+            ENDIF
+         ELSE
+            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE iom_gettime
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_getatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d_iatt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+                                   ENDIF
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d_iatt: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_iatt
+
+   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! written field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+                                   ENDIF
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d_ratt: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_ratt
+
+   SUBROUTINE iom_g0d_catt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      CHARACTER(len=*), INTENT(  out)                 ::   pvar      ! written field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+                                   ENDIF
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d_ratt: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_catt
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_putatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d_iatt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      INTEGER         , INTENT(in   )                 ::   pvar      ! write field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar )
+                                   ENDIF
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_p0d_iatt: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_p0d_iatt
+
+   SUBROUTINE iom_p0d_ratt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      REAL(wp)        , INTENT(in   )                 ::   pvar      ! write field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar )
+                                   ENDIF
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_p0d_ratt
+
+   SUBROUTINE iom_p0d_catt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      CHARACTER(len=*), INTENT(in   )                 ::   pvar      ! write field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_putatt( kiomid, cdatt, pvar )
+                                   ENDIF
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_p0d_catt
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_rstput
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp0d
+
+   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp1d
+
+   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp2d
+
+   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp3d
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_put
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d( cdname, pfield0d )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      REAL(wp)        , INTENT(in) ::   pfield0d
+      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+#if defined key_iomput
+      zz(:,:)=pfield0d
+      CALL xios_send_field(cdname, zz)
+      !CALL xios_send_field(cdname, (/pfield0d/)) 
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p0d
+
+   SUBROUTINE iom_p1d( cdname, pfield1d )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
+#if defined key_iomput
+      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p1d
+
+   SUBROUTINE iom_p2d( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+#if defined key_iomput
+      CALL xios_send_field(cdname, pfield2d)
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p2d
+
+   SUBROUTINE iom_p3d( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+#if defined key_iomput
+      CALL xios_send_field(cdname, pfield3d)
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p3d
+   !!----------------------------------------------------------------------
+
+#if defined key_iomput
+
+   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   &
+      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
+      &                                    nvertex, bounds_lon, bounds_lat, area )
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
+      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
+      LOGICAL, DIMENSION(:)   , OPTIONAL, INTENT(in) ::   mask
+
+
+      IF ( xios_is_valid_domain     (cdid) ) THEN
+         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
+     ENDIF
+      IF ( xios_is_valid_domaingroup(cdid) ) THEN
+         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
+      ENDIF
+
+      CALL xios_solve_inheritance()
+
+   END SUBROUTINE iom_set_domain_attr
+
+
+   SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj)
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj
+
+      IF ( xios_is_valid_zoom_domain     (cdid) ) THEN
+          CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    &
+            &   nj=nj)
+     ENDIF
+   END SUBROUTINE iom_set_zoom_domain_attr
+
+
+   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
+      CHARACTER(LEN=*)      , INTENT(in) ::   cdid
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
+
+      IF ( PRESENT(paxis) ) THEN
+         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis )
+         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
+      ENDIF
+      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
+      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_axis_attr
+
+
+   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op
+      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset
+      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
+    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
+    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_field_attr
+
+
+   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
+      IF ( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix )
+      IF ( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_file_attr
+
+
+   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
+      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
+      TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq
+      LOGICAL                                 ::   llexist1,llexist2,llexist3
+      !---------------------------------------------------------------------
+      IF( PRESENT( name        ) )   name = ''          ! default values
+      IF( PRESENT( name_suffix ) )   name_suffix = ''
+      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
+      IF ( xios_is_valid_file     (cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name )
+         IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq )
+      ENDIF
+      IF ( xios_is_valid_filegroup(cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name )
+         IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
+      ENDIF
+   END SUBROUTINE iom_get_file_attr
+
+
+   SUBROUTINE iom_set_grid_attr( cdid, mask )
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
+      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask )
+      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_grid_attr
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in) ::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !     
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_update_calendar(kt)
+      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+      !
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) :: cdname
+      !
+      IF( xios_is_valid_context(cdname) ) THEN
+         CALL iom_swap( cdname )   ! swap to cdname context
+         CALL xios_context_finalize() ! finalize the context
+         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+      ENDIF
+      !
+   END SUBROUTINE iom_context_finalize
+
+
+   SUBROUTINE set_grid( cdgrd, plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid  ***
+      !!
+      !! ** Purpose :   define horizontal grids
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
+      INTEGER  :: ni,nj
+      
+      ni=nlei-nldi+1 ; nj=nlej-nldj+1
+
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
+         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+
+      IF ( ln_mskland ) THEN
+         ! mask land points, keep values on coast line -> specific mask for U, V and W points
+         SELECT CASE ( cdgrd )
+         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:)
+         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( zmask, 'U', 1. )
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( zmask, 'V', 1. )
+         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
+         END SELECT
+         !
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. )
+         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
+      ENDIF
+      
+   END SUBROUTINE set_grid
+
+
+   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE set_grid_bounds  ***
+      !!
+      !! ** Purpose :   define horizontal grid corners
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1) , INTENT(in) :: cdgrd
+      !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j)
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells
+      !
+      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                          ! represents the bottom-left corner of cell (i,j)
+      INTEGER :: ji, jj, jn, ni, nj
+
+      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
+
+      ! Offset of coordinate representing bottom-left corner
+      SELECT CASE ( TRIM(cdgrd) )
+         CASE ('T', 'W')
+            icnr = -1 ; jcnr = -1
+         CASE ('U')
+            icnr =  0 ; jcnr = -1
+         CASE ('V')
+            icnr = -1 ; jcnr =  0
+      END SELECT
+
+      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior
+
+      z_fld(:,:) = 1._wp
+      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold
+
+      ! Cell vertices that can be defined
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+         END DO
+      END DO
+
+      ! Cell vertices on boundries
+      DO jn = 1, 4
+         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
+         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
+      END DO
+
+      ! Zero-size cells at closed boundaries if cell points provided,
+      ! otherwise they are closed cells with unrealistic bounds
+      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
+         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (West or jpni = 1), closed E-W
+               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:)
+            END DO
+         ENDIF
+         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (East or jpni = 1), closed E-W
+               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
+            END DO
+         ENDIF
+         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
+            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric)
+               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1)
+            END DO
+         ENDIF
+         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN
+            DO jn = 1, 4        ! (North or jpnj = 1), no north fold
+               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
+            END DO
+         ENDIF
+      ENDIF
+
+      ! Rotate cells at the north fold
+      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( z_fld(ji,jj) == -1. ) THEN
+                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
+                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
+                  z_bnds(:,ji,jj,:) = z_rot(:,:)
+               ENDIF
+            END DO
+         END DO
+
+      ! Invert cells at the symmetric equator
+      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
+         DO ji = 1, jpi
+            z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
+            z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
+            z_bnds(:,ji,1,:) = z_rot(:,:)
+         END DO
+      ENDIF
+
+      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           &
+                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
+
+      DEALLOCATE( z_bnds, z_fld, z_rot ) 
+
+   END SUBROUTINE set_grid_bounds
+
+
+   SUBROUTINE set_grid_znl( plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid_znl  ***
+      !!
+      !! ** Purpose :   define grids for zonal mean
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
+      INTEGER  :: ni,nj, ix, iy
+
+      
+      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk)
+      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0.
+
+      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
+         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+      !
+      CALL iom_update_file_name('ptr')
+      !
+   END SUBROUTINE set_grid_znl
+
+   SUBROUTINE set_scalar
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_scalar  ***
+      !!
+      !! ** Purpose :   define fake grids for scalar point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1)   ::   zz = 1.
+      !!----------------------------------------------------------------------
+
+      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
+      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+      
+      zz=REAL(narea,wp)
+      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
+
+   END SUBROUTINE set_scalar
+
+
+   SUBROUTINE set_xmlatt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_xmlatt  ***
+      !!
+      !! ** Purpose :   automatic definitions of some of the xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
+      CHARACTER(len=256)             ::   clsuff                   ! suffix name
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 2 characters
+      CHARACTER(len=3)               ::   cl3                      ! 3 characters
+      INTEGER                        ::   ji, jg                   ! loop counters
+      INTEGER                        ::   ix, iy                   ! i-,j- index
+      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
+      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
+      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
+      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
+      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
+      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
+      TYPE(xios_duration)            ::   f_op, f_of
+      !!----------------------------------------------------------------------
+      ! 
+      ! frequency of the call of iom_put (attribut: freq_op)
+      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
+
+      ! output file names (attribut: name)
+      DO ji = 1, 9
+         WRITE(cl1,'(i1)') ji 
+         CALL iom_update_file_name('file'//cl1)
+      END DO
+      DO ji = 1, 99
+         WRITE(cl2,'(i2.2)') ji 
+         CALL iom_update_file_name('file'//cl2)
+      END DO
+      DO ji = 1, 999
+         WRITE(cl3,'(i3.3)') ji 
+         CALL iom_update_file_name('file'//cl3)
+      END DO
+
+      ! Zooms...
+      clgrd = (/ 'T', 'U', 'W' /) 
+      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
+         cl1 = clgrd(jg)
+         ! Equatorial section (attributs: jbegin, ni, name_suffix)
+         CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
+         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
+         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
+         CALL iom_update_file_name('Eq'//cl1)
+      END DO
+      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
+      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
+      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
+      CALL set_mooring( zlontao, zlattao )
+      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
+      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
+      CALL set_mooring( zlonrama, zlatrama )
+      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonpira = (/ -38.0, -23.0, -10.0 /)
+      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
+      CALL set_mooring( zlonpira, zlatpira )
+
+      
+   END SUBROUTINE set_xmlatt
+
+
+   SUBROUTINE set_mooring( plon, plat)
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_mooring  ***
+      !!
+      !! ** Purpose :   automatic definitions of moorings xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in) ::  plon, plat           ! longitudes/latitudes oft the mooring
+      !
+!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
+      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
+      CHARACTER(len=256)            ::   clname                   ! file name
+      CHARACTER(len=256)            ::   clsuff                   ! suffix name
+      CHARACTER(len=1)              ::   cl1                      ! 1 character
+      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
+      INTEGER                       ::   ji, jj, jg               ! loop counters
+      INTEGER                       ::   ix, iy                   ! i-,j- index
+      REAL(wp)                      ::   zlon, zlat
+      !!----------------------------------------------------------------------
+      DO jg = 1, SIZE(clgrd)
+         cl1 = clgrd(jg)
+         DO ji = 1, SIZE(plon)
+            DO jj = 1, SIZE(plat)
+               zlon = plon(ji)
+               zlat = plat(jj)
+               ! modifications for RAMA moorings
+               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
+               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
+               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
+               ! modifications for PIRATA moorings
+               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
+               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
+               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
+               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
+               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
+               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
+               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
+               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
+               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
+               IF( zlon >= 0. ) THEN  
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
+                  ENDIF
+               ELSE             
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
+                  ENDIF
+               ENDIF
+               IF( zlat >= 0. ) THEN  
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
+                  ENDIF
+               ELSE             
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
+                  ENDIF
+               ENDIF
+               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
+
+               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
+               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
+               CALL iom_update_file_name(TRIM(clname)//cl1)
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE set_mooring
+
+   
+   SUBROUTINE iom_update_file_name( cdid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_update_file_name  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      !
+      CHARACTER(LEN=256) ::   clname
+      CHARACTER(LEN=20)  ::   clfreq
+      CHARACTER(LEN=20)  ::   cldate
+      INTEGER            ::   idx
+      INTEGER            ::   jn
+      INTEGER            ::   itrlen
+      INTEGER            ::   iyear, imonth, iday, isec
+      REAL(wp)           ::   zsec
+      LOGICAL            ::   llexist
+      TYPE(xios_duration)   ::   output_freq 
+      !!----------------------------------------------------------------------
+
+      DO jn = 1,2
+
+         output_freq = xios_duration(0,0,0,0,0,0)
+         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
+         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
+
+         IF ( TRIM(clname) /= '' ) THEN 
+
+            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            DO WHILE ( idx /= 0 ) 
+               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            END DO
+
+            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            DO WHILE ( idx /= 0 ) 
+              IF ( output_freq%timestep /= 0) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%second /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%minute /= 0 ) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%hour /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%day /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%month /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%year /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE
+                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
+                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
+              ENDIF
+              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
+              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            END DO
+
+            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            END DO
+
+            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            END DO
+
+            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            END DO
+
+            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            END DO
+
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
+            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
+
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE iom_update_file_name
+
+
+   FUNCTION iom_sdate( pjday, ld24, ldfull )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_sdate  ***
+      !!
+      !! ** Purpose :   send back the date corresponding to the given julian day
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )           ::   pjday         ! julian day
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24          ! true to force 24:00 instead of 00:00
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull        ! true to get the compleate date: yyyymmdd_hh:mm:ss
+      !
+      CHARACTER(LEN=20) ::   iom_sdate
+      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date 
+      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec
+      REAL(wp)          ::   zsec
+      LOGICAL           ::   ll24, llfull
+      !
+      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24
+      ELSE                       ;   ll24 = .FALSE.
+      ENDIF
+
+      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull
+      ELSE                         ;   llfull = .FALSE.
+      ENDIF
+
+      CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
+      isec = NINT(zsec)
+
+      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
+         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
+         isec = 86400
+      ENDIF
+
+      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date 
+      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
+      ENDIF
+      
+!$AGRIF_DO_NOT_TREAT      
+! Should be fixed in the conv
+      IF( llfull ) THEN 
+         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
+         ihour   = isec / 3600
+         isec    = MOD(isec, 3600)
+         iminute = isec / 60
+         isec    = MOD(isec, 60)
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run
+      ELSE
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
+      ENDIF
+!$AGRIF_END_DO_NOT_TREAT      
+
+   END FUNCTION iom_sdate
+
+#else
+
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in)::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_context_finalize
+
+#endif
+
+   LOGICAL FUNCTION iom_use( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+#if defined key_iomput
+      iom_use = xios_field_is_active( cdname )
+#else
+      iom_use = .FALSE.
+#endif
+   END FUNCTION iom_use
+   
+   !!======================================================================
+END MODULE iom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 8732)
@@ -0,0 +1,71 @@
+MODULE iom_def
+   !!=====================================================================
+   !!                    ***  MODULE  iom_def ***
+   !! IOM variables definitions
+   !!====================================================================
+   !! History :  9.0  ! 06 09  (S. Masson) Original code
+   !!             "   ! 07 07  (D. Storkey) Add uldname
+   !!--------------------------------------------------------------------
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo)
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !: 
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !: 
+
+   INTEGER, PARAMETER, PUBLIC ::   jpnf90      = 101      !: Use nf90 library
+
+   INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jpnf90     !: restarts io library
+
+   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
+   INTEGER, PARAMETER, PUBLIC ::   jp_r4    = 201      !: write REAL(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i4    = 202      !: write INTEGER(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i2    = 203      !: write INTEGER(2)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
+
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100  !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name
+
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0
+
+   TYPE, PUBLIC ::   file_descriptor
+      CHARACTER(LEN=240)                        ::   name     !: name of the file
+      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
+      INTEGER                                   ::   iolib    !: library used to read the file (jpnf90 or new formats,
+                                                              !: jpioipsl option has been removed)
+      INTEGER                                   ::   nvars    !: number of identified varibles in the file
+      INTEGER                                   ::   iduld    !: id of the unlimited dimension
+      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file)
+      INTEGER                                   ::   irec     !: writing record position  
+      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension
+      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   nvid     !: id of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables
+      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     !: variable using the unlimited dimension
+      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions 
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables
+   END TYPE file_descriptor
+   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files
+!$AGRIF_END_DO_NOT_TREAT
+
+   !!=====================================================================
+END MODULE iom_def
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 8732)
@@ -0,0 +1,869 @@
+MODULE iom_nf90
+   !!=====================================================================
+   !!                    ***  MODULE  iom_nf90 ***
+   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
+   !!====================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
+   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
+   !!--------------------------------------------------------------------
+   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis kvid in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE netcdf          ! NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput
+   PUBLIC iom_nf90_getatt, iom_nf90_putatt
+
+   INTERFACE iom_nf90_get
+      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
+   END INTERFACE
+   INTERFACE iom_nf90_getatt
+      MODULE PROCEDURE iom_nf90_giatt, iom_nf90_gratt, iom_nf90_gcatt
+   END INTERFACE
+   INTERFACE iom_nf90_putatt
+      MODULE PROCEDURE iom_nf90_piatt, iom_nf90_pratt, iom_nf90_pcatt
+   END INTERFACE
+   INTERFACE iom_nf90_rstput
+      MODULE PROCEDURE iom_nf90_rp0123d
+   END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+
+      CHARACTER(LEN=256) ::   clinfo           ! info character
+      CHARACTER(LEN=256) ::   cltmp            ! temporary character
+      INTEGER            ::   iln              ! lengths of character
+      INTEGER            ::   istop            ! temporary storage of nstop
+      INTEGER            ::   if90id           ! nf90 identifier of the opened file
+      INTEGER            ::   idmy             ! dummy variable
+      INTEGER            ::   jl               ! loop variable
+      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
+      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
+      !---------------------------------------------------------------------
+
+      clinfo = '                    iom_nf90_open ~~~  '
+      istop = nstop   ! store the actual value of nstop
+      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
+      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
+      ENDIF
+      !
+      llclobber = ldwrt .AND. ln_clobber
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
+         !                 ! =============
+         IF( ldwrt ) THEN  ! ... in write mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
+            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
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
+         ENDIF
+      ELSE                                       ! the file does not exist (or we overwrite it)
+         !                 ! =============
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
+
+            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
+            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
+            ENDIF
+            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
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo)
+            ! global attributes
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo)
+         ELSE              ! the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      ! start to fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%nfid   = if90id
+         iom_file(kiomid)%iolib  = jpnf90
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
+         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
+         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN
+           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     & 
+        &                                               name = iom_file(kiomid)%uldname,  &
+        &                                               len  = iom_file(kiomid)%lenuld ), clinfo )
+         ENDIF
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_open
+
+
+   SUBROUTINE iom_nf90_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_close  ***
+      !!
+      !! ** Purpose : close an input file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      CHARACTER(LEN=100)  ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
+      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
+      !    
+   END SUBROUTINE iom_nf90_close
+
+
+   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER              , INTENT(in   )           ::   kiv   ! 
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      !
+      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
+      INTEGER                        ::   if90id           ! nf90 file identifier
+      INTEGER                        ::   ji               ! dummy loop index
+      INTEGER                        ::   ivarid           ! NetCDF  variable Id
+      INTEGER                        ::   i_nvd            ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
+      LOGICAL                        ::   llok             ! ok  test
+      CHARACTER(LEN=100)             ::   clinfo           ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      iom_nf90_varid = 0                    ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
+      !
+      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
+      IF( llok ) THEN
+         iom_nf90_varid = kiv
+         iom_file(kiomid)%nvars       = kiv
+         iom_file(kiomid)%nvid(kiv)   = ivarid
+         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
+         iom_file(kiomid)%ndims(kiv)  = i_nvd
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
+         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used
+         DO ji = 1, i_nvd                       ! dimensions size
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
+            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
+         END DO
+         !---------- Deal with scale_factor and add_offset
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
+         IF( llok) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%scf(kiv) = 1.
+         END IF
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
+         IF( llok ) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%ofs(kiv) = 0.
+         END IF
+         ! return the simension size
+         IF( PRESENT(kdimsz) ) THEN 
+            IF( i_nvd == SIZE(kdimsz) ) THEN
+               kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
+            ELSE
+               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
+               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
+            ENDIF
+         ENDIF
+         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv)
+      ELSE  
+         iom_nf90_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_nf90_varid
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_get
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file
+      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id
+      REAL(wp),               INTENT(  out)            ::   pvar     ! read field
+      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis
+      !
+      CHARACTER(LEN=100)      ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo )
+      ! 
+   END SUBROUTINE iom_nf90_g0d
+
+
+   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                    pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with NF90
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
+      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
+      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
+      !
+      CHARACTER(LEN=100) ::   clinfo               ! info character
+      INTEGER            ::   if90id               ! nf90 identifier of the opened file
+      INTEGER            ::   ivid                 ! nf90 variable id
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
+      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
+      !
+      IF(     PRESENT(pv_r1d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_g123d
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_getatt
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_giatt( kiomid, cdatt, pv_i0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_giatt  ***
+      !!
+      !! ** Purpose : read an integer attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      INTEGER         , INTENT(  out) ::   pv_i0d   ! read field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) THEN
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr
+         ELSE
+            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+         ivarid = NF90_GLOBAL
+      ENDIF
+!
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', giatt: '//TRIM(cdatt)
+         CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
+         pv_i0d = -999
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_giatt
+
+   SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_gratt  ***
+      !!
+      !! ** Purpose : read a real attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      REAL(wp)        , INTENT(  out) ::   pv_r0d   ! read field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) THEN
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr
+         ELSE
+            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+         ivarid = NF90_GLOBAL
+      ENDIF
+!
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gratt: '//TRIM(cdatt)
+         CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
+         pv_r0d = -999._wp
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_gratt
+
+   SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_gcatt  ***
+      !!
+      !! ** Purpose : read a character attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      CHARACTER(len=*), INTENT(  out) ::   pv_c0d   ! read field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) THEN
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr
+         ELSE
+            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+         ivarid = NF90_GLOBAL
+      ENDIF
+!
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gcatt: '//TRIM(cdatt)
+         CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_c0d), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
+         pv_c0d = '!'
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_gcatt
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_putatt
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_piatt( kiomid, cdatt, pv_i0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_piatt  ***
+      !!
+      !! ** Purpose : write an integer attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      INTEGER         , INTENT(in   ) ::   pv_i0d   ! write field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      LOGICAL                         ::   lenddef  ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      lenddef = .false.
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( .NOT. llok ) THEN
+            CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = .true.
+         ivarid = NF90_GLOBAL
+      ENDIF
+!
+      IF( llok) THEN
+         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', piatt: '//TRIM(cdatt)
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   
+            ! trick: irec used to know if the file is in define mode or not
+            ! if it is not then temporarily put it into define mode
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)
+            lenddef = .true.
+         ENDIF
+         !
+         CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo)
+         !
+         IF( lenddef ) THEN   
+            ! file was in data mode on entry; put it back in that mode
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)
+         ENDIF
+      ELSE
+         CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written')
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_piatt
+
+   SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_pratt  ***
+      !!
+      !! ** Purpose : write a real attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      REAL(wp)        , INTENT(in   ) ::   pv_r0d   ! write field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      LOGICAL                         ::   lenddef  ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      lenddef = .false.
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( .NOT. llok ) THEN
+            CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = .true.
+         ivarid = NF90_GLOBAL
+      ENDIF
+!
+      IF( llok) THEN
+         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pratt: '//TRIM(cdatt)
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   
+            ! trick: irec used to know if the file is in define mode or not
+            ! if it is not then temporarily put it into define mode
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)
+            lenddef = .true.
+         ENDIF
+         !
+         CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo)
+         !
+         IF( lenddef ) THEN   
+            ! file was in data mode on entry; put it back in that mode
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)
+         ENDIF
+      ELSE
+         CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written')
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_pratt
+
+   SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_pcatt  ***
+      !!
+      !! ** Purpose : write a character attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      CHARACTER(len=*), INTENT(in   ) ::   pv_c0d   ! write field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      LOGICAL                         ::   lenddef  ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      lenddef = .false.
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( .NOT. llok ) THEN
+            CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found')
+         ENDIF
+      ELSE
+         llok = .true.
+         ivarid = NF90_GLOBAL
+      ENDIF
+!
+      IF( llok) THEN
+         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pcatt: '//TRIM(cdatt)
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   
+            ! trick: irec used to know if the file is in define mode or not
+            ! if it is not then temporarily put it into define mode
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)
+            lenddef = .true.
+         ENDIF
+         !
+         CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_c0d), clinfo)
+         !
+         IF( lenddef ) THEN   
+            ! file was in data mode on entry; put it back in that mode
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)
+         ENDIF
+      ELSE
+         CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written')
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_pcatt
+
+
+   SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis kvid in the file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
+      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
+      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
+      !
+      CHARACTER(LEN=100) ::   clinfo     ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_gettime, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   &
+            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo)
+      IF ( PRESENT(cdunits) ) THEN 
+         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", &
+            &                           values=cdunits), clinfo)
+      ENDIF
+      IF ( PRESENT(cdcalendar) ) THEN 
+         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", &
+            &                           values=cdcalendar), clinfo)
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_gettime
+
+
+   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      INTEGER               :: idims                ! number of dimension
+      INTEGER               :: idvar                ! variable id
+      INTEGER               :: jd                   ! dimension loop counter   
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=256)    :: clinfo               ! info character
+      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character
+      INTEGER               :: if90id               ! nf90 file identifier
+      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)
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      if90id = iom_file(kiomid)%nfid
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! define the dimension variables if it is not already done
+         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
+         ! update informations structure related the dimension variable we just added...
+         iom_file(kiomid)%nvars       = 4
+         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
+         iom_file(kiomid)%cn_var(1:4) = cltmp
+         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)  
+         ! trick: defined to 0 to say that dimension variables are defined but not yet written
+         iom_file(kiomid)%dimsz(1, 1)  = 0   
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
+      ENDIF
+      ! define the data if it is not already done
+      ! ===============
+      IF( kvid <= 0 ) THEN
+         !
+         ! 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?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! variable definition
+         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
+         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
+         ENDIF
+         IF( PRESENT(ktype) ) THEN   ! variable external type
+            SELECT CASE (ktype)
+            CASE (jp_r8)  ;   itype = NF90_DOUBLE
+            CASE (jp_r4)  ;   itype = NF90_FLOAT
+            CASE (jp_i4)  ;   itype = NF90_INT
+            CASE (jp_i2)  ;   itype = NF90_SHORT
+            CASE (jp_i1)  ;   itype = NF90_BYTE
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = NF90_DOUBLE
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
+                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
+         ELSE
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
+                 &                            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
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%scf(idvar)    = 1.
+         iom_file(kiomid)%ofs(idvar)    = 0.
+         iom_file(kiomid)%ndims(idvar)  = idims
+         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
+         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         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
+         idvar = kvid
+      ENDIF
+
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! are we in write mode?
+         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
+         ENDIF
+         ! on what kind of domain must the data be written?
+         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
+            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
+            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
+               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
+               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSE 
+               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
+            ENDIF
+
+            ! write dimension variables if it is not already done
+            ! =============
+            ! trick: is defined to 0 => dimension variable are defined but not yet written
+            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo)
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo)
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d                ), clinfo)
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)   
+               ! update the values of the variables dimensions size
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)
+               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)
+               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d                      ), clinfo)
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d(                  :) ), clinfo)
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2   ) ), clinfo)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)
+         ENDIF
+         ! add 1 to the size of the temporal dimension (not really useful...)
+         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
+               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !     
+   END SUBROUTINE iom_nf90_rp0123d
+
+
+   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_nf90_check  ***
+      !!
+      !! ** Purpose :   check nf90 errors
+      !!--------------------------------------------------------------------
+      INTEGER,          INTENT(in) :: kstatus
+      CHARACTER(LEN=*), INTENT(in) :: cdinfo
+      !---------------------------------------------------------------------
+      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
+   END SUBROUTINE iom_nf90_check
+
+   !!======================================================================
+END MODULE iom_nf90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 8732)
@@ -0,0 +1,586 @@
+MODULE prtctl
+   !!======================================================================
+   !!                       ***  MODULE prtctl   ***
+   !! Ocean system : print all SUM trends for each processor domain
+   !!======================================================================
+   !! History :  9.0  !  05-07  (C. Talandier) original code
+   !!            3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
+   !!----------------------------------------------------------------------
+   USE dom_oce          ! ocean space and time domain variables
+#if defined key_nemocice_decomp
+   USE ice_domain_size, only: nx_global, ny_global
+#endif
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! distributed memory computing
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   !
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values
+
+   INTEGER ::   ktime   ! time step
+
+   PUBLIC prt_ctl         ! called by all subroutines
+   PUBLIC prt_ctl_info    ! called by all subroutines
+   PUBLIC prt_ctl_init    ! called by opa.F90
+   PUBLIC sub_dom         ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/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 
+      !!----------------------------------------------------------------------
+      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
+      !
+      CHARACTER (len=15) :: cl2
+      INTEGER ::   overlap, jn, sind, eind, kdir,j_id
+      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
+      REAL(wp), POINTER, DIMENSION(:,:)   :: ztab2d_1, ztab2d_2
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 )
+      CALL wrk_alloc( 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(:,:,1:kdir) = tab3d_1(:,:,1:kdir)
+      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir)
+      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:)
+      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:)
+
+      IF( lk_mpp .AND. jpnij > 1 ) 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 .AND. jpnij > 1)   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( PRESENT(clinfo3)) THEN
+            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
+         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
+
+      CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 )
+      CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )
+      !
+   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
+      !!----------------------------------------------------------------------
+      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
+      !
+      INTEGER :: jn, sind, eind, iltime, j_id
+      !!----------------------------------------------------------------------
+
+      IF( lk_mpp .AND. jpnij > 1 ) 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
+         !
+         j_id = numid(jn - narea + 1)         ! Set logical unit
+         !
+         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
+         !
+      END DO
+      !
+   END SUBROUTINE prt_ctl_info
+
+
+   SUBROUTINE prt_ctl_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE prt_ctl_init  ***
+      !!
+      !! ** Purpose :   open ASCII files & compute indices
+      !!----------------------------------------------------------------------
+      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) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   &
+         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   &
+         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     &
+         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       )
+
+      ! Initialization 
+      t_ctll(:) = 0.e0
+      s_ctll(:) = 0.e0
+      u_ctll(:) = 0.e0
+      v_ctll(:) = 0.e0
+      ktime = 1
+
+      IF( lk_mpp .AND. jpnij > 1 ) 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(1:jpnij) = nldit(:) 
+         nleitl(1:jpnij) = nleit(:) 
+         nldjtl(1:jpnij) = nldjt(:) 
+         nlejtl(1:jpnij) = nlejt(:) 
+         !
+         nimpptl(1:jpnij) = nimppt(:)
+         njmpptl(1:jpnij) = njmppt(:)
+         !
+         nlcitl(1:jpnij) = nlcit(:)
+         nlcjtl(1:jpnij) = nlcjt(:)
+         !
+         ibonitl(1:jpnij) = ibonit(:)
+         ibonjtl(1:jpnij) = 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 ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+         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)
+      END DO
+      !
+   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
+      !!----------------------------------------------------------------------
+      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, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      !
+      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+      !  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).
+
+#if defined key_nemocice_decomp
+      ijpi = ( nx_global+2-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
+      ijpj = ( ny_global+2-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
+#else
+      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
+      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
+#endif
+
+
+      nrecil  = 2 * jpreci
+      nrecjl  = 2 * jprecj
+      irestil = MOD( jpiglo - nrecil , isplt )
+      irestjl = MOD( jpjglo - nrecjl , jsplt )
+
+      IF(  irestil == 0 )   irestil = isplt
+#if defined key_nemocice_decomp
+
+      ! In order to match CICE the size of domains in NEMO has to be changed
+      ! The last line of blocks (west) will have fewer points 
+      DO jj = 1, jsplt 
+         DO ji=1, isplt-1 
+            ilcitl(ji,jj) = ijpi 
+         END DO 
+         ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil)
+      END DO 
+
+#else 
+
+      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
+
+#endif
+      
+      IF( irestjl == 0 )   irestjl = jsplt
+#if defined key_nemocice_decomp 
+
+      ! Same change to domains in North-South direction as in East-West. 
+      DO ji = 1, isplt 
+         DO jj=1, jsplt-1 
+            ilcjtl(ji,jj) = ijpj 
+         END DO 
+         ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl)
+      END DO 
+
+#else 
+
+      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
+
+#endif
+      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
+      ! -------------------------------
+
+      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
+      !
+      !
+      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+      !
+   END SUBROUTINE sub_dom
+
+   !!======================================================================
+END MODULE prtctl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 8732)
@@ -0,0 +1,271 @@
+MODULE restart
+   !!======================================================================
+   !!                     ***  MODULE  restart  ***
+   !! Ocean restart :  write the ocean restart file
+   !!======================================================================
+   !! 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)
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   rst_opn    : open the ocean restart file
+   !!   rst_write  : write the ocean restart file
+   !!   rst_read   : read the ocean restart file
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_ice         ! only lk_lim3 
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE diurnal_bulk
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   rst_opn         ! routine called by step module
+   PUBLIC   rst_write       ! routine called by step module
+   PUBLIC   rst_read        ! routine called by istate module
+   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE rst_opn( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rst_opn  ***
+      !!                     
+      !! ** Purpose : + initialization (should be read in the namelist) of nitrst 
+      !!              + open the restart when we are one time step before nitrst
+      !!                   - restart header is defined when kt = nitrst-1
+      !!                   - restart data  are written when kt = nitrst
+      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !!
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
+      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN   ! default definitions
+         lrst_oce = .FALSE.   
+         IF( ln_rst_list ) THEN
+            nrst_lst = 1
+            nitrst = nstocklist( nrst_lst )
+         ELSE
+            nitrst = nitend
+         ENDIF
+      ENDIF
+
+      ! frequency-based restart dumping (nn_stock)
+      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN   
+         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
+         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
+         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
+      ENDIF
+      ! to get better performances with NetCDF format:
+      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
+      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
+      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
+            clpath = TRIM(cn_ocerst_outdir)
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE DEFAULT         ;   WRITE(numout,*)                            &
+                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
+               IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
+               ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_oce = .TRUE.
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE rst_opn
+
+
+   SUBROUTINE rst_write( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rstwrite  ***
+      !!                     
+      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
+      !!
+      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
+      !!              file, save fields which are necessary for restart
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step
+      !!----------------------------------------------------------------------
+
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics and tracer time step
+
+      IF ( .NOT. ln_diurnal_only ) THEN
+                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
+                     CALL iom_rstput( kt, nitrst, numrow, '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'     , tsn(:,:,:,jp_tem) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
+
+                  ! extra variable needed for the ice sheet coupling
+                  IF ( ln_iscpl ) THEN 
+                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask     ) ! need to extrapolate T/S
+                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask     ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask     ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask    ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )   ! need to compute temperature correction
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) )   ! need to compute bt conservation
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) )   ! need to compute bt conservation
+                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) ) ! need to compute extrapolation if vvl
+                  END IF
+      ENDIF
+      
+      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst    )  
+
+      IF( kt == nitrst ) THEN
+         CALL iom_close( numrow )     ! close the restart file (only at last time step)
+!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
+!!gm  not sure what to do here   ===>>>  ask to Sebastian
+         lrst_oce = .FALSE.
+            IF( ln_rst_list ) THEN
+               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
+               nitrst = nstocklist( nrst_lst )
+            ENDIF
+            lrst_oce = .FALSE.
+      ENDIF
+      !
+   END SUBROUTINE rst_write
+
+
+   SUBROUTINE rst_read_open
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE rst_read_open  ***
+      !! 
+      !! ** Purpose :   Open read files for restart (format fixed by jprstlib )
+      !! 
+      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
+      !!                the file has already been opened
+      !!----------------------------------------------------------------------
+      INTEGER        ::   jlibalt = jprstlib
+      LOGICAL        ::   llok
+      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
+      !!----------------------------------------------------------------------
+      !
+      IF( numror <= 0 ) THEN
+         IF(lwp) THEN                                             ! Contol prints
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
+            END SELECT
+            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
+            WRITE(numout,*) '~~~~~~~~'
+         ENDIF
+
+         clpath = TRIM(cn_ocerst_indir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
+      ENDIF
+   END SUBROUTINE rst_read_open
+
+
+   SUBROUTINE rst_read
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE rst_read  ***
+      !! 
+      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
+      !! 
+      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zrdt
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+
+      CALL rst_read_open           ! open restart for reading (if not already opened)
+
+      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
+      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
+         CALL iom_get( numror, 'rdt', zrdt )
+         IF( zrdt /= rdt )   neuler = 0
+      ENDIF
+
+      ! Diurnal DSST 
+      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  ) 
+      IF ( ln_diurnal_only ) THEN 
+         IF(lwp) WRITE( numout, * ) &
+         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
+         rhop = rau0
+         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) ) 
+         RETURN 
+      ENDIF  
+      
+      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
+         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
+         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
+         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
+         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
+      ELSE
+         neuler = 0
+      ENDIF
+      !
+      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'     , tsn(:,:,:,jp_tem) )
+      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
+      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
+      ELSE
+         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
+      ENDIF
+      !
+      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
+         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
+         ub   (:,:,:)   = un   (:,:,:)
+         vb   (:,:,:)   = vn   (:,:,:)
+         sshb (:,:)     = sshn (:,:)
+         !
+         IF( .NOT.ln_linssh ) THEN
+            DO jk = 1, jpk
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE rst_read
+
+   !!=====================================================================
+END MODULE restart
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 8732)
@@ -0,0 +1,682 @@
+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  
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
+   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
+   !!----------------------------------------------------------------------
+#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_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE lib_mpp        ! distributed memory computing library
+
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+   !
+   INTERFACE lbc_sum
+      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
+   END INTERFACE
+   !
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE mpp_lnk_2d_icb
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_sum
+   PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   !
+
+   !!----------------------------------------------------------------------
+   !! 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_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d 
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
+   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers   
+   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_sum
+      MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d_e
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple
+   END INTERFACE
+
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE lbc_lnk_2d_e
+   END INTERFACE
+   
+   TYPE arrayptr
+      REAL , DIMENSION (:,:),  POINTER :: pt2d
+   END TYPE arrayptr
+   PUBLIC   arrayptr
+
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region)
+   PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   !
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+# if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                          1D configuration
+   !!----------------------------------------------------------------------
+
+   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 (C1D case)
+      !!
+      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
+      !!----------------------------------------------------------------------
+      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 (C1D case)
+      !!
+      !! ** Method  :   1D case, the central water column is set everywhere
+      !!----------------------------------------------------------------------
+      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)
+      !
+      INTEGER  ::   jk     ! dummy loop index
+      REAL(wp) ::   ztab   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         ztab = pt3d(2,2,jk)
+         pt3d(:,:,jk) = ztab
+      END DO
+      !
+   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  :   1D case, the central water column is set everywhere
+      !!----------------------------------------------------------------------
+      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) ::   ztab   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      ztab = pt2d(2,2)
+      pt2d(:,:) = ztab
+      !
+   END SUBROUTINE lbc_lnk_2d
+   
+   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
+      !!
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      !
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      !
+      DO ii = 1, num_fields
+        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
+      END DO     
+      !
+   END SUBROUTINE lbc_lnk_2d_multiple
+
+   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      !!---------------------------------------------------------------------
+
+      !!The first array
+      CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 
+
+      !! Look if more arrays to process
+      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )
+      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
+      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
+      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
+      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
+      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
+      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
+      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
+
+   END SUBROUTINE lbc_lnk_2d_9
+
+
+
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                           3D shared memory computing
+   !!----------------------------------------------------------------------
+
+   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._wp
+      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
+            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._wp
+      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
+            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
+   
+   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )
+      !!
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      !
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      !
+      DO ii = 1, num_fields
+        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )
+      END DO     
+      !
+   END SUBROUTINE lbc_lnk_2d_multiple
+
+   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      !!---------------------------------------------------------------------
+
+      !!The first array
+      CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 
+
+      !! Look if more arrays to process
+      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )
+      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 
+      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 
+      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 
+      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 
+      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 
+      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 
+      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 
+
+   END SUBROUTINE lbc_lnk_2d_9
+
+   SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_sum_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
+      !!
+      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean 
+      !!                coupling if conservation option activated. As no ice shelf are present along
+      !!                this line, nothing is done along the north fold.
+      !!----------------------------------------------------------------------
+      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._wp
+      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(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:)
+            pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d(jpi,:)
+            pt2d( 1 ,:) = 0.0_wp               ! all points
+            pt2d(jpi,:) = 0.0_wp
+            !
+         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
+         !                                     ! ======================
+         ! Nothing to do for the north fold, there is no ice shelf along this line.
+         !
+      END IF
+
+   END SUBROUTINE
+
+   SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_sum_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
+      !!
+      !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean 
+      !!                coupling if conservation option activated. As no ice shelf are present along
+      !!                this line, nothing is done along the north fold.
+      !!----------------------------------------------------------------------
+      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._wp
+      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(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:)
+            pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:) 
+            pt3d( 1 ,:,:) = 0.0_wp            ! all points
+            pt3d(jpi,:,:) = 0.0_wp
+            !
+         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
+         !                                     ! ======================
+         ! Nothing to do for the north fold, there is no ice shelf along this line.
+         !
+      END IF
+   END SUBROUTINE
+
+
+#endif
+
+   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_bdy_lnk  ***
+      !!
+      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+      !!              to maintain the same interface with regards to the mpp case
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign 
+      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
+      !
+   END SUBROUTINE lbc_bdy_lnk_3d
+
+
+   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_bdy_lnk  ***
+      !!
+      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+      !!              to maintain the same interface with regards to the mpp case
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign 
+      INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
+      !
+   END SUBROUTINE lbc_bdy_lnk_2d
+
+
+   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
+      !!                special dummy routine to allow for use of halo indexing in 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 
+      INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp)
+      INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
+      !    
+   END SUBROUTINE lbc_lnk_2d_e
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 8732)
@@ -0,0 +1,971 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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)
+   !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP
+   !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP
+   !!----------------------------------------------------------------------
+   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
+   !
+   INTERFACE mpp_lbc_nfd
+      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   lbc_nfd       ! north fold conditions
+   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case)
+
+   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
+   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
+   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
+
+   !!----------------------------------------------------------------------
+   !! 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
+               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
+               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
+               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
+               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
+               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
+            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
+               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
+            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
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
+            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
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
+               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
+            pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2)
+            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
+            pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2)
+            pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2)
+            pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)   
+            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
+            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
+         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
+            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
+            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
+            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)      
+            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)      
+         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
+         CASE ( 'J' )                                     ! first 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
+         CASE ( 'K' )                                     ! second 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' )                               ! 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
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
+         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
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
+            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
+         CASE ( 'J' )                                  ! first 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)= pt2d(ji,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'K' )                                  ! second 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)= 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
+         CASE ( 'J' )                                   ! first ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'K' )                                   ! second 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
+
+
+   SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_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) ::   pt3dl     ! 3D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               IF (nimpp .ne. 1) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+
+               DO jk = 1, jpk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)
+                  ENDIF
+               END DO
+
+               IF(nimpp .ge. (jpiglo/2+1)) THEN
+                 startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+                 startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                 startloop = nlci + 1
+               ENDIF
+               IF(startloop .le. nlci) THEN
+                 DO jk = 1, jpk
+                    DO ji = startloop, nlci
+                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                       jia = ji + nimpp - 1
+                       ijta = jpiglo - jia + 2
+                       IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
+                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
+                       ELSE
+                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
+                       ENDIF
+                    END DO
+                 END DO
+               ENDIF
+
+
+            CASE ( 'U' )                               ! U-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk)
+                  ENDIF
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)
+                  ENDIF
+               END DO
+
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF(nimpp .ge. (jpiglo/2)) THEN
+                  startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
+                  startloop = jpiglo/2 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF (startloop .le. endloop) THEN
+                 DO jk = 1, jpk
+                    DO ji = startloop, endloop
+                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                      jia = ji + nimpp - 1
+                      ijua = jpiglo - jia + 1
+                      IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
+                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
+                      ELSE
+                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
+                      ENDIF
+                    END DO
+                 END DO
+               ENDIF
+
+            CASE ( 'V' )                               ! V-point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)
+                  ENDIF
+               END DO
+            CASE ( 'F' )                               ! F-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk)
+                  ENDIF
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)
+                  ENDIF
+               END DO
+            END SELECT
+            !
+
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'U' )                               ! U-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
+                  END DO
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)
+                  ENDIF
+               END DO
+
+            CASE ( 'V' )                               ! V-point
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                  END DO
+               END DO
+
+               IF(nimpp .ge. (jpiglo/2+1)) THEN
+                  startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = nlci + 1
+               ENDIF
+               IF(startloop .le. nlci) THEN
+                 DO jk = 1, jpk
+                    DO ji = startloop, nlci
+                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
+                    END DO
+                 END DO
+               ENDIF
+
+            CASE ( 'F' )                               ! F-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                  END DO
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)
+                  ENDIF
+               END DO
+
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF(nimpp .ge. (jpiglo/2+1)) THEN
+                  startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF (startloop .le. endloop) THEN
+                  DO jk = 1, jpk
+                     DO ji = startloop, endloop
+                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
+                     END DO
+                  END DO
+               ENDIF
+
+            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
+               pt3dl(:, 1  ,jk) = 0.e0
+               pt3dl(:,ijpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3dl(:,ijpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      !
+   END SUBROUTINE mpp_lbc_nfd_3d
+
+
+   SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_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) ::   pt2dl     ! 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
+      !!----------------------------------------------------------------------
+
+      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
+
+
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            IF (nimpp .ne. 1) THEN
+              startloop = 1
+            ELSE
+              startloop = 2
+            ENDIF
+            DO ji = startloop, nlci
+              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
+            END DO
+            IF (nimpp .eq. 1) THEN
+              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2)
+            ENDIF
+
+            IF(nimpp .ge. (jpiglo/2+1)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               startloop = jpiglo/2+1 - nimpp + 1
+            ELSE
+               startloop = nlci + 1
+            ENDIF
+            DO ji = startloop, nlci
+               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+               jia = ji + nimpp - 1
+               ijta = jpiglo - jia + 2
+               IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
+                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
+               ELSE
+                  pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
+               ENDIF
+            END DO
+
+         CASE ( 'U' )                                     ! U-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
+            END DO
+
+            IF (nimpp .eq. 1) THEN
+              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2)
+              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)
+            ENDIF
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2)
+            ENDIF
+
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            IF(nimpp .ge. (jpiglo/2)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
+               startloop = jpiglo/2 - nimpp + 1
+            ELSE
+               startloop = endloop + 1
+            ENDIF
+            DO ji = startloop, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               jia = ji + nimpp - 1
+               ijua = jpiglo - jia + 1
+               IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
+                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
+               ELSE
+                  pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
+               ENDIF
+            END DO
+
+         CASE ( 'V' )                                     ! V-point
+            IF (nimpp .ne. 1) THEN
+              startloop = 1
+            ELSE
+              startloop = 2
+            ENDIF
+            DO ji = startloop, nlci
+              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
+              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
+            END DO
+            IF (nimpp .eq. 1) THEN
+              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3) 
+            ENDIF
+
+         CASE ( 'F' )                                     ! F-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
+            END DO
+            IF (nimpp .eq. 1) THEN
+              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3)
+              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2)
+            ENDIF
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3)
+              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 
+            ENDIF
+
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'J' )                                     ! first ice U-V point
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'K' )                                     ! second ice U-V point
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            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, nlci
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
+            END DO
+
+         CASE ( 'U' )                                     ! U-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
+            ENDIF
+
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, nlci
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
+            END DO
+            IF(nimpp .ge. (jpiglo/2+1)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               startloop = jpiglo/2+1 - nimpp + 1
+            ELSE
+               startloop = nlci + 1
+            ENDIF
+            DO ji = startloop, nlci
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
+            END DO
+
+         CASE ( 'F' )                               ! F-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
+            END DO
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
+            ENDIF
+
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            IF(nimpp .ge. (jpiglo/2+1)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               startloop = jpiglo/2+1 - nimpp + 1
+            ELSE
+               startloop = endloop + 1
+            ENDIF
+
+            DO ji = startloop, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
+               END DO
+
+         CASE ( 'J' )                                  ! first ice U-V point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1)
+               END DO
+
+         CASE ( 'K' )                                  ! second ice U-V point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop, endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
+               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
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'I' )                                   ! ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'J' )                                   ! first ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'K' )                                   ! second ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         END SELECT
+         !
+      END SELECT
+      !
+   END SUBROUTINE mpp_lbc_nfd_2d
+
+   !!======================================================================
+END MODULE lbcnfd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 8732)
@@ -0,0 +1,4394 @@
+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
+   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
+   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d', 
+   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
+   !!                          the mppobc routine to optimize the BDY and OBC communications
+   !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
+   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
+   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn      : initialization, namelist read, and parameters control
+   !!   ctl_opn       : Open file and check if required file is available.
+   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   get_unit      : give the index of an unused logical unit
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lib_mpp_alloc : allocate mpp arrays
+   !!   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)
+   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
+   !!   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       :
+   !!   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
+   !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
+   USE wrk_nemo       ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
+   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_max_multiple
+   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple 
+   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
+   PUBLIC   mppscatter, mppgather
+   PUBLIC   mpp_ini_ice, mpp_ini_znl
+   PUBLIC   mppsize
+   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
+   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
+   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
+   PUBLIC   mpprank
+
+   TYPE arrayptr
+      REAL , DIMENSION (:,:),  POINTER :: pt2d
+   END TYPE arrayptr
+   PUBLIC   arrayptr
+   
+   !! * 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,   &
+                       mppsum_realdd, mppsum_a_realdd
+   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
+
+   INTERFACE mpp_max_multiple
+      MODULE PROCEDURE mppmax_real_multiple
+   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
+
+   INTEGER :: MPI_SUMDD
+
+   ! variables used in case of sea-ice
+   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)
+   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology)
+   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, SAVE ::   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, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+
+   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
+   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send   ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
+   INTEGER, PUBLIC          ::   nn_buffer     ! size of the buffer in case of mpi_bsend
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
+
+   LOGICAL, PUBLIC                                  ::   ln_nnogather       ! namelist control of northfold comms
+   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
+   INTEGER, PUBLIC                                  ::   ityp
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!
+      !! ** Purpose :   Find processor unit
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
+      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
+      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
+      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
+      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
+      !
+      INTEGER ::   mynode, ierr, code, ji, ii, ios
+      LOGICAL ::   mpi_was_called
+      !
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
+      !
+
+      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
+      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
+
+      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
+      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
+
+      !                              ! 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 exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
+
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         jpni  = Agrif_Parent(jpni )
+         jpnj  = Agrif_Parent(jpnj )
+         jpnij = Agrif_Parent(jpnij)
+      ENDIF
+#endif
+
+      IF(jpnij < 1)THEN
+         ! If jpnij is not specified in namelist then we calculate it - this
+         ! means there will be no land cutting out.
+         jpnij = jpni * jpnj
+      END IF
+
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1
+      ELSE
+         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
+      END IF
+
+      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; 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
+            kstop = kstop + 1
+         END SELECT
+      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
+         kstop = kstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
+            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
+            kstop = kstop + 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
+
+#if defined key_agrif
+      IF (Agrif_Root()) THEN
+         CALL Agrif_MPI_Init(mpi_comm_opa)
+      ELSE
+         CALL Agrif_MPI_set_grid_comm(mpi_comm_opa)
+      ENDIF
+#endif
+
+      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
+      mynode = mpprank
+
+      IF( mynode == 0 ) THEN
+         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+         WRITE(kumond, nammpp)      
+      ENDIF
+      !
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+      !
+   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
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! 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 cyclic
+         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude
+            ptab(:,1 , :) = ptab(:, jpjm1,:)
+            ptab(:,jpj,:) = ptab(:,     2,:)
+         ELSE   !                                   ! North-South boundaries (closed)
+            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         ENDIF
+         !
+      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
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_3d
+
+
+   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_multiple  ***
+      !!
+      !! ** Purpose :   Message passing management for multiple 2d arrays
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
+      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      REAL(wp) ::   zland
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
+         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+            !
+            ! WARNING pt2d is defined only between nld and nle
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
+               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
+               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
+               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
+               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
+            END DO
+            !
+         ELSE                              ! standard close or cyclic treatment
+            !
+            !                                   ! East-West boundaries
+            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
+               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
+            ELSE                                     ! closed
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
+            ENDIF
+                                                ! Noth-South boundaries
+            IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+               pt2d_array(ii)%pt2d(:, 1   ) =   pt2d_array(ii)%pt2d(:, jpjm1 )
+               pt2d_array(ii)%pt2d(:, jpj ) =   pt2d_array(ii)%pt2d(:, 2 )          
+            ELSE   !             
+               !                                   ! North-South boundaries (closed)
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
+            !
+            ENDIF
+          ENDIF
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
+               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
+            END DO
+         END SELECT
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
+            END DO
+         END SELECT
+      END DO
+      
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
+               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
+            END DO
+         ENDIF
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+
+      DO ii = 1 , num_fields
+         !First Array
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
+               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
+            END DO
+         END SELECT
+      END DO
+      
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+         !First Array
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   
+             DO ii = 1 , num_fields  
+                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
+             END DO
+         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+        !
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_2d_multiple
+
+   
+   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
+      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER                            , INTENT (inout) :: num_fields 
+      !!---------------------------------------------------------------------
+      num_fields = num_fields + 1
+      pt2d_array(num_fields)%pt2d => pt2d
+      type_array(num_fields)      =  cd_type
+      psgn_array(num_fields)      =  psgn
+   END SUBROUTINE load_array
+   
+   
+   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER :: num_fields
+      !!---------------------------------------------------------------------
+      !
+      num_fields = 0
+      !
+      ! Load the first array
+      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
+      !
+      ! Look if more arrays are added
+      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+      !
+      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
+      !
+   END SUBROUTINE mpp_lnk_2d_9
+
+
+   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
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! 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 boudaries
+         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+            pt2d(:,  1 ) = pt2d(:,jpjm1)
+            pt2d(:, jpj) = pt2d(:,    2)
+         ELSE    
+         !                                   ! North-South boundaries (closed)
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         ENDIF     
+      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
+            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            zt2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_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
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
+         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
+      !
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                      ! 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 ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+         ptab1(:,     1       ,:) = ptab1(: ,  jpjm1 , :)
+         ptab1(:,   jpj       ,:) = ptab1(: ,      2 , :)
+         ptab2(:,     1       ,:) = ptab2(: ,  jpjm1 , :)
+         ptab2(:,   jpj       ,:) = ptab2(: ,      2 , :)
+      ELSE     
+      !                                      ! North-South boundaries closed
+      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
+      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
+            zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk *2
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
+         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,:,:) = zt4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = zt4we(:,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
+            zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk * 2
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
+         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,:) = zt4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab1(:,jl,:) = zt4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = zt4sn(:,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
+      !
+      DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we )
+      !
+   END SUBROUTINE mpp_lnk_3d_gather
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !!                    jpri   : number of rows for extra outer halo
+      !!                    jprj   : 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
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                             , INTENT(in   ) ::   jpri
+      INTEGER                                             , INTENT(in   ) ::   jprj
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), 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
+      !!
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jprj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+                                           ! North-South cyclic
+      IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south
+         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1)
+         pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj)
+      ELSE
+        
+      !                                      !* North-South boundaries (closed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
+      ENDIF
+                                
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+         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-jpri
+         DO jl = 1, ipreci
+            r2dew(:,jl,1) = pt2d(jpreci+jl,:)
+            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jprj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         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,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,jl,2)
+            pt2d( iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,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-jprj
+         DO jl = 1, iprecj
+            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
+            r2dns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpri )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         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) = r2dns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+            pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE mpp_lnk_2d_e
+
+   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_sum_3d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement (sum the overlap region)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+      iihom = nlci-jpreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
+            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp 
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      iihom = nlci-nreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
+            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
+         ijhom = nlcj-jprecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
+            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      ijhom = nlcj-nrecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)
+            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_sum_3d
+
+   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_sum_2d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci - jpreci
+         DO jl = 1, jpreci
+            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp
+            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      iihom = nlci-nreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
+            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
+         ijhom = nlcj - jprecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp
+            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      ijhom = nlcj-nrecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
+            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_sum_2d
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  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, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  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, OPTIONAL, INTENT(in) :: ksource    ! source process number
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      INTEGER :: use_source
+      !!----------------------------------------------------------------------
+      !
+      ! If a specific process number has been passed to the receive call,
+      ! use that one. Default is to use mpi_any_source
+      use_source = mpi_any_source
+      IF( PRESENT(ksource) )   use_source = ksource
+      !
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_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 mppmax_real_multiple( ptab, NUM , kcom  )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_real  ***
+      !!
+      !! ** Purpose :   Maximum
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ???
+      INTEGER , INTENT(in   )           ::   NUM
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      !!
+      INTEGER  ::   ierror, localcomm
+      REAL(wp) , POINTER , DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc(NUM , zwork)
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab = zwork
+      CALL wrk_dealloc(NUM , zwork)
+      !
+   END SUBROUTINE mppmax_real_multiple
+
+
+   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 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
+      !
+      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    , OPTIONAL       , INTENT(in   ) ::   kcom
+      !
+      INTEGER:: ierror, localcomm    ! local integer
+      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
+      ytab(:) = zwork(:)
+      !
+   END SUBROUTINE mppsum_a_realdd
+
+
+   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 :: ierror
+      INTEGER , DIMENSION(2)   ::   ilocs
+      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 massively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      !
+      CALL mppsync
+      CALL mpi_finalize( info )
+      !
+   END SUBROUTINE mppstop
+
+
+   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, kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  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_iworld = 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, INTENT(in) ::   kumout   ! ocean.output logical unit
+      !!
+      INTEGER :: jjproc
+      INTEGER :: ii, ierr
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kice
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      ! Since this is just an init routine and these arrays are of length jpnij
+      ! then don't use wrk_nemo module - just allocate and deallocate.
+      ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)'
+         CALL mppstop
+      ENDIF
+
+      ! 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( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
+      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_iworld, ierr )
+
+      ! Create the ice group from the world group
+      CALL MPI_GROUP_INCL( ngrp_iworld, 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_iworld,n_ice_root,ierr)
+      !
+      CALL MPI_GROUP_FREE(ngrp_ice, ierr)
+      CALL MPI_GROUP_FREE(ngrp_iworld, ierr)
+
+      DEALLOCATE(kice, zwork)
+      !
+   END SUBROUTINE mpp_ini_ice
+
+
+   SUBROUTINE mpp_ini_znl( kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  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, INTENT(in) ::   kumout   ! ocean.output logical units
+      !
+      INTEGER :: jproc      ! dummy loop integer
+      INTEGER :: ierr, ii   ! local integer
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   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
+      !
+      ALLOCATE( kwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
+         CALL mppstop
+      ENDIF
+
+      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 (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+         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
+
+      DEALLOCATE(kwork)
+
+   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 (ALLOCATED (nrank_north)) DEALLOCATE(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 )
+      !
+   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, jk
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
+
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
+      ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) ) 
+
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      znorthloc(:,:,:) = 0
+      DO jk = 1, jpk
+         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
+            ij = jj - nlcj + ijpj
+            znorthloc(:,ij,jk) = pt3d(:,jj,jk)
+         END DO
+      END DO
+      !
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * jpk * ijpj
+
+      IF ( l_north_nogather ) THEN
+         !
+        ztabr(:,:,:) = 0
+        ztabl(:,:,:) = 0
+
+        DO jk = 1, jpk
+           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+              ij = jj - nlcj + ijpj
+              DO ji = nfsloop, nfeloop
+                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+
+         DO jr = 1,nsndto
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
+              DO jk = 1, jpk
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)
+                    END DO
+                 END DO
+              END DO
+           ELSE IF (iproc .eq. (narea-1)) THEN
+              DO jk = 1, jpk
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)
+                    END DO
+                 END DO
+              END DO
+           ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF    
+            END DO
+         ENDIF
+         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
+         DO jk = 1, jpk
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+               ij = jj - nlcj + ijpj
+               DO ji= 1, nlci
+                  pt3d(ji,jj,jk) = ztabl(ji,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+
+      ELSE
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:) = 0.e0
+         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 jk = 1, jpk
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                    ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
+                  END DO
+               END DO
+            END DO
+         END DO
+         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+         !
+         DO jk = 1, jpk
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+               ij = jj - nlcj + ijpj
+               DO ji= 1, nlci
+                  pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      ! The ztab array has been either:
+      !  a. Fully populated by the mpi_allgather operation or
+      !  b. Had the active points for this domain and northern neighbours populated
+      !     by peer to peer exchanges
+      ! Either way the array may be folded by lbc_nfd and the result for the span of
+      ! this domain will be identical.
+      !
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
+      DEALLOCATE( ztabl, ztabr ) 
+      !
+   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      ! 2D array on which the b.c. is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d 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
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztabl, ztabr
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )
+      ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) ) 
+      !
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      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
+      IF ( l_north_nogather ) THEN
+         !
+         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
+         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
+         !
+         ztabr(:,:) = 0
+         ztabl(:,:) = 0
+
+         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+            ij = jj - nlcj + ijpj
+              DO ji = nfsloop, nfeloop
+               ztabl(ji,ij) = pt2d(ji,jj)
+            END DO
+         END DO
+
+         DO jr = 1,nsndto
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
+              DO jj = 1, ijpj
+                 DO ji = ildi, ilei
+                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj)
+                 END DO
+              END DO
+            ELSE IF (iproc .eq. (narea-1)) THEN
+              DO jj = 1, ijpj
+                 DO ji = ildi, ilei
+                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
+                 END DO
+              END DO
+            ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF
+            END DO
+         ENDIF
+         CALL mpp_lbc_nfd( ztabl, ztabr, 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) = ztabl(ji,ij)
+            END DO
+         END DO
+         !
+      ELSE
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:) = 0.e0
+         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
+               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
+         !
+      ENDIF
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
+      DEALLOCATE( ztabl, ztabr ) 
+      !
+   END SUBROUTINE mpp_lbc_north_2d
+
+   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
+      !!              in mpp configuration in case of jpn1 > 1
+      !!              (for multiple 2d arrays )
+      !!
+      !! ** 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.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
+      !                                                          !   = T ,  U , V , F or W  gridpoints
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr, jk
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields),   &
+            &   znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions
+      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )
+      !
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      
+      DO jk = 1, num_fields
+         DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable)
+            ij = jj - nlcj + ijpj
+            znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj)
+         END DO
+      END DO
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * ijpj
+                                                                  
+      IF ( l_north_nogather ) THEN
+         !
+         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
+         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
+         !
+         ztabr(:,:,:) = 0
+         ztabl(:,:,:) = 0
+
+         DO jk = 1, num_fields
+            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+               ij = jj - nlcj + ijpj
+               DO ji = nfsloop, nfeloop
+                  ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj)
+               END DO
+            END DO
+         END DO
+
+         DO jr = 1,nsndto
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+               CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times
+              DO jk = 1 , num_fields
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D
+                    END DO
+                 END DO
+              END DO
+            ELSE IF (iproc .eq. (narea-1)) THEN
+              DO jk = 1, num_fields
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                          ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D
+                    END DO
+                 END DO
+              END DO
+            ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF
+            END DO
+         ENDIF
+         !
+         DO ji = 1, num_fields     ! Loop to manage 3D variables
+            CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition
+         END DO
+         !
+         DO jk = 1, num_fields
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
+               ij = jj - nlcj + ijpj
+               DO ji = 1, nlci
+                  pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D
+               END DO
+            END DO
+         END DO
+         
+         !
+      ELSE
+         !
+         CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:) = 0.e0
+         DO jk = 1, num_fields
+            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
+                  DO ji = ildi, ilei
+                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
+                  END DO
+               END DO
+            END DO
+         END DO
+         
+         DO ji = 1, num_fields
+            CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition
+         END DO
+         !
+         DO jk = 1, num_fields
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
+               ij = jj - nlcj + ijpj
+               DO ji = 1, nlci
+                  pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+         !
+      ENDIF
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
+      DEALLOCATE( ztabl, ztabr )
+      !
+   END SUBROUTINE mpp_lbc_north_2d_multiple
+
+   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(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
+
+      !
+      ijpj=4
+      ztab_e(:,:) = 0.e0
+
+      ij=0
+      ! put in znorthloc_e the last 4 jlines of pt2d
+      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
+         ij = ij + 1
+         DO ji = 1, jpi
+            znorthloc_e(ji,ij)=pt2d(ji,jj)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * jpr2dj )
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(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_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,:), 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_e(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
+      !
+   END SUBROUTINE mpp_lbc_north_e
+
+
+   SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_3d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : 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
+      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland                      ! local scalar
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                   ! East-West boundaries
+      !                                        !* Cyclic east-west
+      IF( nbondi == 2) THEN
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE
+            IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
+            ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
+         ENDIF
+      ELSEIF(nbondi == -1) THEN
+         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
+      ELSEIF(nbondi == 1) THEN
+         ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
+      ENDIF                                     !* closed
+
+      IF (nbondj == 2 .OR. nbondj == -1) THEN
+        IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point
+      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+        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_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+      CASE ( 0 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+      CASE ( 1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(      jl,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(      jl,:,:) = zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+      CASE ( 0 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+      CASE ( 1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
+      !
+   END SUBROUTINE mpp_lnk_bdy_3d
+
+
+   SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_2d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : 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), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                   ! East-West boundaries
+      !                                      !* Cyclic east-west
+      IF( nbondi == 2 ) THEN
+         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+            ptab( 1 ,:) = ptab(jpim1,:)
+            ptab(jpi,:) = ptab(  2  ,:)
+         ELSE
+            IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
+                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+      ELSEIF(nbondi == -1) THEN
+         IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
+      ELSEIF(nbondi == 1) THEN
+                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+      ENDIF
+      !                                      !* closed
+      IF( nbondj == 2 .OR. nbondj == -1 ) THEN
+         IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point
+      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+                                      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_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt2ew(:,jl,1) = ptab(jpreci+jl,:)
+            zt2we(:,jl,1) = ptab(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+      CASE ( 0 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+      CASE ( 1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:) = zt2we(:,jl,2)
+            ptab(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:) = zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = ptab(:,ijhom +jl)
+            zt2ns(:,jl,1) = ptab(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+      CASE ( 0 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+      CASE ( 1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ) = zt2sn(:,jl,2)
+            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl) = zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  )
+      !
+   END SUBROUTINE mpp_lnk_bdy_2d
+
+
+   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
+
+   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
+
+
+   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_icb  ***
+      !!
+      !! ** 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.
+      !!              This version accounts for an extra halo with icebergs.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), 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, OPTIONAL       , INTENT(in   ) ::   pr2dj
+      !
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ij, iproc, ipr2dj
+      !
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+      !!----------------------------------------------------------------------
+      !
+      ijpj=4
+      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
+         ipr2dj = pr2dj
+      ELSE
+         ipr2dj = 0
+      ENDIF
+      ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) )
+      !
+      ztab_e(:,:) = 0._wp
+      !
+      ij = 0
+      ! put in znorthloc_e the last 4 jlines of pt2d
+      DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj
+         ij = ij + 1
+         DO ji = 1, jpi
+            znorthloc_e(ji,ij)=pt2d(ji,jj)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * ipr2dj )
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(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*ipr2dj
+            DO ji = ildi, ilei
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )
+
+      ij = ipr2dj
+      !! Scatter back to pt2d
+      DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj
+      ij  = ij +1
+         DO ji= 1, nlci
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
+      !
+   END SUBROUTINE mpp_lbc_north_icb
+
+
+   SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_icb  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array (with extra halo and icebergs)
+      !!
+      !! ** 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
+      !!                    jpri   : number of rows for extra outer halo
+      !!                    jprj   : 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
+      !!----------------------------------------------------------------------
+      INTEGER                                             , INTENT(in   ) ::   jpri
+      INTEGER                                             , INTENT(in   ) ::   jprj
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), 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
+      !!
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jprj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
+         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-jpri
+         DO jl = 1, ipreci
+            r2dew(:,jl,1) = pt2d(jpreci+jl,:)
+            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jprj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         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,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,jl,2)
+            pt2d( iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,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-jprj
+         DO jl = 1, iprecj
+            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
+            r2dns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpri )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         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) = r2dns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+            pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+         END DO
+      END SELECT
+
+   END SUBROUTINE mpp_lnk_2d_icb
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+   USE in_out_manager
+
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i, mppsum_realdd, mppsum_a_realdd
+   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_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
+   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
+   INTEGER :: ncomm_ice
+   INTEGER, PUBLIC            ::   mpi_comm_opa          ! opa local communicator
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lib_mpp_alloc(kumout)          ! Dummy function
+      INTEGER, INTENT(in) ::   kumout
+      lib_mpp_alloc = 0
+   END FUNCTION lib_mpp_alloc
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:) ::   ldtxt
+      CHARACTER(len=*) ::   ldname
+      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop
+      IF( PRESENT( localComm ) ) mpi_comm_opa = localComm
+      function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+   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 mppsum_realdd( ytab, kcom )
+      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+      WRITE(*,*) 'mppsum_realdd: You should not have seen this print! error?', ytab
+   END SUBROUTINE mppsum_realdd
+
+   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
+      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
+      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+      WRITE(*,*) 'mppsum_a_realdd: You should not have seen this print! error?', kdim, ytab(1), kcom
+   END SUBROUTINE mppsum_a_realdd
+
+   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 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
+      STOP      ! non MPP case, just stop the run
+   END SUBROUTINE mppstop
+
+   SUBROUTINE mpp_ini_ice( kcom, knum )
+      INTEGER :: kcom, knum
+      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom, knum
+   END SUBROUTINE mpp_ini_ice
+
+   SUBROUTINE mpp_ini_znl( knum )
+      INTEGER :: knum
+      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?', knum
+   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
+
+   !!----------------------------------------------------------------------
+   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_opa  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the error number (nstop) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nstop = nstop + 1
+      IF(lwp) THEN
+         WRITE(numout,cform_err)
+         IF( PRESENT(cd1 ) )   WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) )   WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) )   WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) )   WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) )   WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) )   WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) )   WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) )   WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) )   WRITE(numout,*) cd9
+         IF( PRESENT(cd10) )   WRITE(numout,*) cd10
+      ENDIF
+                               CALL FLUSH(numout    )
+      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
+      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
+      IF( cd1 == 'STOP' ) THEN
+         IF(lwp) WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
+         CALL mppstop()
+      ENDIF
+      !
+   END SUBROUTINE ctl_stop
+
+
+   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_warn  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the warning number (nwarn) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nwarn = nwarn + 1
+      IF(lwp) THEN
+         WRITE(numout,cform_war)
+         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
+         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
+      ENDIF
+      CALL FLUSH(numout)
+      !
+   END SUBROUTINE ctl_warn
+
+
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+      !!----------------------------------------------------------------------
+      !
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
+      knum=Agrif_Get_Unit()
+#else
+      knum=get_unit()
+#endif
+      !
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', clfile,' 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: ', clfile
+            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
+         CALL FLUSH(kout) 
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      !
+   END SUBROUTINE ctl_opn
+
+
+   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_nam  ***
+      !!
+      !! ** Purpose :   Informations when error while reading a namelist
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      CHARACTER(len=5)                ::   clios   ! string to convert iostat in character for print
+      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      !!----------------------------------------------------------------------
+      !
+      WRITE (clios, '(I5.0)')   kios
+      IF( kios < 0 ) THEN         
+         CALL ctl_warn( 'end of record or file while reading namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      !
+      IF( kios > 0 ) THEN
+         CALL ctl_stop( 'misspelled variable in namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      kios = 0
+      RETURN
+      !
+   END SUBROUTINE ctl_nam
+
+
+   INTEGER FUNCTION get_unit()
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  get_unit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      LOGICAL :: llopn
+      !!----------------------------------------------------------------------
+      !
+      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (get_unit < 998) .AND. llopn )
+         get_unit = get_unit + 1
+         INQUIRE( unit = get_unit, opened = llopn )
+      END DO
+      IF( (get_unit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
+         get_unit = -1
+      ENDIF
+      !
+   END FUNCTION get_unit
+
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 8732)
@@ -0,0 +1,508 @@
+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
+   !!----------------------------------------------------------------------
+   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
+
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! 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! ' )
+
+      IF( jperio == 7 ) CALL ctl_stop( ' jperio = 7 needs distributed memory computing ',   &
+          &              ' with 1 process. Add key_mpp_mpi in the list of active cpp keys ' )
+   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
+      !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers
+      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      -
+      REAL(wp) ::   zidom, zjdom                       ! local scalars
+      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace
+      !!----------------------------------------------------------------------
+
+      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
+
+#if defined key_nemocice_decomp
+      ! In order to match CICE the size of domains in NEMO has to be changed
+      ! The last line of blocks (west) will have fewer points
+
+      DO jj = 1, jpnj
+         DO ji=1, jpni-1
+            ilcit(ji,jj) = jpi
+         END DO
+         ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci)
+      END DO
+
+#else
+
+      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
+      
+#endif
+      nfilcit(:,:) = ilcit(:,:)
+      IF( irestj == 0 )   irestj = jpnj
+
+#if defined key_nemocice_decomp
+      ! Same change to domains in North-South direction as in East-West. 
+      DO ji=1,jpni
+         DO jj=1,jpnj-1
+            ilcjt(ji,jj) = jpj
+         END DO
+         ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
+      END DO
+
+#else
+
+      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
+      
+#endif
+
+      !  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
+      nfiimpp(:,:)=iimppt(:,:)
+
+      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
+         nfipproc(ii,ij) = jn - 1
+         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. Subdomain print
+      ! ------------------
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) '      jpni=', jpni, ' iresti=', iresti
+      IF(lwp) WRITE(numout,*) '      jpnj=', jpnj, ' irestj=', irestj
+      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) THEN
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200     FORMAT('     ***',20('*************',a3))
+ 9203     FORMAT('     *     ',20('         *   ',a3))
+ 9201     FORMAT('        ',20('   ',i3,'          '))
+ 9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9204     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+      ! 5. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 6. 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 .OR. jperio == 7 ) 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, '      nbondj = ', nbondj
+         WRITE(numout,*) '      npolj  = ', npolj
+         WRITE(numout,*) '      nperio = ', nperio
+         WRITE(numout,*) '      nlci   = ', nlci  , '      nlcj   = ', nlcj
+         WRITE(numout,*) '      nimpp  = ', nimpp , '      njmpp  = ', njmpp
+         WRITE(numout,*) '      nreci  = ', nreci , '      npse   = ', npse
+         WRITE(numout,*) '      nrecj  = ', nrecj , '      npsw   = ', npsw
+         WRITE(numout,*) '      jpreci = ', jpreci, '      npne   = ', npne
+         WRITE(numout,*) '      jprecj = ', jprecj, '      npnw   = ', npnw
+         WRITE(numout,*)
+      ENDIF
+
+      IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) &
+         &                  CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' )
+      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
+         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+#  include "mppini_2.h90"
+
+   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
+      !!----------------------------------------------------------------------
+      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
+
+   !!======================================================================
+END MODULE mppini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 8732)
@@ -0,0 +1,572 @@
+   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 requires the presence of the domain configuration 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 :       !  1994-11  (M. Guyon)  Original code
+      !!  OPA            !  1995-04  (J. Escobar, M. Imbard)
+      !!                 !  1998-02  (M. Guyon)  FETI method
+      !!                 !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+      !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file
+      !!----------------------------------------------------------------------
+      USE in_out_manager  ! I/O Manager
+      USE iom
+      USE bdy_oce
+      !! 
+      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
+      INTEGER ::  inum                        ! temporary logical unit
+      INTEGER ::  idir                        ! temporary integers
+      INTEGER ::  jstartrow                   ! temporary integers
+      INTEGER ::   ios                        ! Local integer output status for namelist read
+      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               ! global workspace
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, ztop, zbdy          ! global workspace
+      REAL(wp) ::   zidom , zjdom          ! local scalars
+      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &  
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice_lim, nn_ice_lim_dta,                           &
+         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 &
+         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+      !!----------------------------------------------------------------------
+      !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+      !! $Id$
+      !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+      !!----------------------------------------------------------------------
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init_2 : 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
+      ! -----------------
+      CALL iom_open( cn_domcfg, inum )
+      !
+      !                                   ! ocean top and bottom level
+      CALL iom_get( inum, jpdom_unknown, 'bottom_level' , zbot    )  ! nb of ocean T-points
+      CALL iom_get( inum, jpdom_unknown, 'top_level'    , ztop    )  ! nb of ocean T-points (ISF)
+      !
+      CALL iom_close( inum )
+      !
+      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)
+      WHERE( zbot(:,:) > 0 )                   ;   imask(:,:) = 1
+      ELSEWHERE                                ;   imask(:,:) = 0
+      END WHERE
+
+      ! Adjust imask with bdy_msk if exists
+
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini_2)', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini_2)', lwp )
+
+      IF( ln_bdy .AND. ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy)
+         CALL iom_close( inum )
+         WHERE ( zbdy(:,:) <= 0. ) imask = 0
+      ENDIF
+
+      !  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 )
+
+#if defined key_nemocice_decomp
+      ! Change padding to be consistent with CICE
+      ilci(1:jpni-1      ,:) = jpi
+      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
+
+      ilcj(:,      1:jpnj-1) = jpj
+      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
+#else
+      ilci(1:iresti      ,:) = jpi
+      ilci(iresti+1:jpni ,:) = jpi-1
+
+      ilcj(:,      1:irestj) = jpj
+      ilcj(:, irestj+1:jpnj) = jpj-1
+#endif
+
+      nfilcit(:,:) = ilci(:,:)
+
+      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
+      nfiimpp(:,:) = iimppt(:,:)
+
+      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   ! MPI rank of northern neighbour
+         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    ! MPI rank of northern neighbour
+         ENDIF
+
+         ! Check wet points over the entire domain to preserve the MPI communication stencil
+         isurf = 0
+         DO jj = 1, ilj
+            DO  ji = 1, ili
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1)   isurf = isurf+1
+            END DO
+         END DO
+
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      nfipproc(:,:) = ipproc(:,:)
+
+      ! 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
+              ! Need to reverse the logical direction of communication 
+              ! for northern neighbours of northern row processors (north-fold)
+              ! i.e. need to check that the northern neighbour only communicates
+              ! to the SOUTH (or not at all) if this area is land-only (#1057)
+            idir = 1
+            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1    
+            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
+         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)
+
+      ! set default neighbours
+      noso = ioso(ii,ij)
+      nowe = iowe(ii,ij)
+      noea = ioea(ii,ij)
+      nono = iono(ii,ij) 
+      npse = iose(ii,ij)
+      npsw = iosw(ii,ij)
+      npne = ione(ii,ij)
+      npnw = ionw(ii,ij)
+
+      ! check neighbours location
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         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,'(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  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
+
+      ! 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
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
+         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
+         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
+         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
+         WRITE(numout,*)
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+
+   END SUBROUTINE mpp_init2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90	(revision 8732)
@@ -0,0 +1,215 @@
+MODULE ldfc1d_c2d
+   !!======================================================================
+   !!                    ***  MODULE  ldfc1d_c2d  ***
+   !! Ocean physics:  profile and horizontal shape of lateral eddy coefficients 
+   !!=====================================================================
+   !! History :  3.7  ! 2013-12  (G. Madec)  restructuration/simplification of aht/aeiv specification,
+   !!                 !                      add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_c1d       : ah reduced by 1/4 on the vertical (tanh profile, inflection at 300m) 
+   !!   ldf_c2d       : ah = F(e1,e2) (laplacian or = F(e1^3,e2^3) (bilaplacian)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_c1d   ! called by ldftra and ldfdyn modules
+   PUBLIC   ldf_c2d   ! called by ldftra and ldfdyn modules
+
+ 
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_c1d( cd_type, prat, pahs1, pahs2, pah1, pah2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_c1d  ***
+      !!              
+      !! ** Purpose :   1D eddy diffusivity/viscosity coefficients
+      !!
+      !! ** Method  :   1D eddy diffusivity coefficients F( depth )
+      !!                Reduction by prat from surface to bottom 
+      !!                hyperbolic tangent profile with inflection point 
+      !!                at zh=500m and a width of zw=200m
+      !!
+      !!   cd_type = TRA      pah1, pah2 defined at U- and V-points
+      !!             DYN      pah1, pah2 defined at T- and F-points
+      !!----------------------------------------------------------------------
+      CHARACTER(len=2)                , INTENT(in   ) ::   cd_type        ! DYNamique or TRAcers
+      REAL(wp)                        , INTENT(in   ) ::   prat           ! ratio surface/deep values           [-]
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) ::   pahs1, pahs2   ! surface value of eddy coefficient   [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pah1 , pah2    ! eddy coefficient                    [m2/s]
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   zh, zc, zdep1   ! local scalars
+      REAL(wp) ::   zw    , zdep2   !   -      -
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   ldf_c1d : set a given profile to eddy diffusivity/viscosity coefficients'
+         WRITE(numout,*) '   ~~~~~~~'
+      ENDIF
+
+      ! initialization of the profile
+      zh =  500._wp              ! depth    of the inflection point [m]
+      zw =  1._wp / 200._wp      ! width^-1     -        -      -   [1/m]
+      !                          ! associated coefficient           [-]
+      zc = ( 1._wp - prat ) / ( 1._wp + TANH( zh * zw) )
+      !
+      !
+      SELECT CASE( cd_type )        ! point of calculation
+      !
+      CASE( 'DYN' )                     ! T- and F-points
+         DO jk = 1, jpk                      ! pah1 at T-point
+            pah1(:,:,jk) = pahs1(:,:) * (  prat + zc * ( 1._wp + TANH( - ( gdept_n(:,:,jk) - zh ) * zw) )  ) * tmask(:,:,jk)
+         END DO
+         DO jk = 1, jpk                      ! pah2 at F-point (zdep2 is an approximation in zps-coord.)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  zdep2 = (  gdept_n(ji,jj+1,jk) + gdept_n(ji+1,jj+1,jk)   &
+                     &     + gdept_n(ji,jj  ,jk) + gdept_n(ji+1,jj  ,jk)  ) * 0.25_wp
+                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * fmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pah2, 'F', 1. )   ! Lateral boundary conditions
+         !
+      CASE( 'TRA' )                     ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.)
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  zdep1 = (  gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk)  ) * 0.5_wp
+                  zdep2 = (  gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk)  ) * 0.5_wp
+                  pah1(ji,jj,jk) = pahs1(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep1 - zh ) * zw) )  ) * umask(ji,jj,jk)
+                  pah2(ji,jj,jk) = pahs2(ji,jj) * (  prat + zc * ( 1._wp + TANH( - ( zdep2 - zh ) * zw) )  ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pah1, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( pah2, 'V', 1. )   
+         !
+      END SELECT
+      !
+   END SUBROUTINE ldf_c1d
+
+
+   SUBROUTINE ldf_c2d( cd_type, cd_op, pah0, pah1, pah2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_c2d  ***
+      !!              
+      !! ** Purpose :   2D eddy diffusivity/viscosity coefficients
+      !!
+      !! ** Method  :   2D eddy diffusivity coefficients F( e1 , e2 )
+      !!       laplacian   operator :   ah proportional to the scale factor      [m2/s]
+      !!       bilaplacian operator :   ah proportional to the (scale factor)^3  [m4/s]
+      !!       In both cases, pah0 is the maximum value reached by the coefficient 
+      !!       at the Equator in case of e1=ra*rad= ~111km, not over the whole domain.
+      !!
+      !!   cd_type = TRA      pah1, pah2 defined at U- and V-points
+      !!             DYN      pah1, pah2 defined at T- and F-points
+      !!----------------------------------------------------------------------
+      CHARACTER(len=3)                , INTENT(in   ) ::   cd_type      ! DYNamique or TRAcers
+      CHARACTER(len=3)                , INTENT(in   ) ::   cd_op        ! operator: LAPlacian BiLaPlacian
+      REAL(wp)                        , INTENT(in   ) ::   pah0         ! eddy coefficient   [m2/s or m4/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pah1, pah2   ! eddy coefficient   [m2/s or m4/s]
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   za00, zd_max, zemax1, zemax2   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zd_max = ra * rad       ! = 1 degree at the equator in meters
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   ldf_c2d :     aht = rn_aht0 *  max(e1,e2)/e_equator     (  laplacian) '
+         WRITE(numout,*) '   ~~~~~~~       or  = rn_bht0 * [max(e1,e2)/e_equator]**3 (bilaplacian)'
+         WRITE(numout,*)
+      ENDIF
+      !
+      SELECT CASE( cd_type )        !==  surface values  ==!  (depending on DYN/TRA)
+      !
+      CASE( 'DYN' )                     ! T- and F-points
+         IF( cd_op == 'LAP' ) THEN            ! laplacian operator
+            IF(lwp) WRITE(numout,*) '              momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)'
+            za00 = pah0 / zd_max
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  zemax1 = MAX( e1t(ji,jj), e2t(ji,jj) ) * tmask(ji,jj,1)
+                  zemax2 = MAX( e1f(ji,jj), e2f(ji,jj) ) * fmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1
+                  pah2(ji,jj,1) = za00 * zemax2
+               END DO
+            END DO
+         ELSEIF( cd_op == 'BLP' ) THEN     ! bilaplacian operator
+            IF(lwp) WRITE(numout,*) '              momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3'
+            za00 = pah0 / ( zd_max * zd_max * zd_max )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zemax1 = MAX( e1t(ji,jj), e2t(ji,jj) ) * tmask(ji,jj,1)
+                  zemax2 = MAX( e1f(ji,jj), e2f(ji,jj) ) * fmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1 * zemax1 * zemax1 
+                  pah2(ji,jj,1) = za00 * zemax2 * zemax2 * zemax2 
+               END DO
+            END DO
+         ELSE                                ! NO diffusion/viscosity
+            CALL ctl_stop( 'ldf_c2d: ', cd_op, ' case. Unknown lateral operator ' )
+         ENDIF
+         !                                !  deeper values  (LAP and BLP cases)
+         DO jk = 2, jpk
+            pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk) 
+            pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk) 
+         END DO
+         !
+      CASE( 'TRA' )                     ! U- and V-points (approximation in zps-coord.)
+         IF( cd_op == 'LAP' ) THEN            ! laplacian operator
+            IF(lwp) WRITE(numout,*) '              tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)'
+            za00 = pah0 / zd_max
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  zemax1 = MAX( e1u(ji,jj), e2u(ji,jj) ) * umask(ji,jj,1)
+                  zemax2 = MAX( e1v(ji,jj), e2v(ji,jj) ) * vmask(ji,jj,1)
+                  pah1(ji,jj,1) = za00 * zemax1
+                  pah2(ji,jj,1) = za00 * zemax2
+               END DO
+            END DO
+         ELSEIF( cd_op == 'BLP' ) THEN      ! bilaplacian operator (NB: square root of the coeff)
+            IF(lwp) WRITE(numout,*) '              tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3'
+            za00 = pah0 / ( zd_max * zd_max * zd_max )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zemax1 = MAX( e1u(ji,jj), e2u(ji,jj) ) * umask(ji,jj,1) 
+                  zemax2 = MAX( e1v(ji,jj), e2v(ji,jj) ) * vmask(ji,jj,1) 
+                  pah1(ji,jj,1) = za00 * zemax1 * zemax1 * zemax1 
+                  pah2(ji,jj,1) = za00 * zemax2 * zemax2 * zemax2 
+               END DO
+            END DO
+         ELSE                                ! NO diffusion/viscosity
+            CALL ctl_stop( 'ldf_c2d: ', cd_op, ' case. Unknown lateral operator ' )
+         ENDIF
+         !                                !  deeper values  (LAP and BLP cases)
+         DO jk = 2, jpk
+            pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk) 
+            pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk) 
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE ldf_c2d
+
+   !!======================================================================
+END MODULE ldfc1d_c2d
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 8732)
@@ -0,0 +1,418 @@
+MODULE ldfdyn
+   !!======================================================================
+   !!                       ***  MODULE  ldfdyn  ***
+   !! Ocean physics:  lateral viscosity coefficient 
+   !!=====================================================================
+   !! History :  OPA  ! 1997-07  (G. Madec)  multi dimensional coefficients
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_init  : initialization, namelist read, and parameters control
+   !!   ldf_dyn       : update lateral eddy viscosity coefficients at each time step 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE phycst          ! physical constants
+   USE ldfc1d_c2d      ! lateral diffusion: 1D and 2D cases
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module for ehanced bottom friction file
+   USE timing          ! Timing
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory Allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_dyn_init   ! called by nemogcm.F90
+   PUBLIC   ldf_dyn        ! called by step.F90
+
+   !                                                !!* Namelist namdyn_ldf : lateral mixing on momentum *
+   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_lev   !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_dynldf_hor   !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_dynldf_iso   !: iso-neutral direction
+   INTEGER , PUBLIC ::   nn_ahm_ijk_t    !: choice of time & space variations of the lateral eddy viscosity coef.
+   REAL(wp), PUBLIC ::   rn_ahm_0        !: lateral laplacian eddy viscosity            [m2/s]
+   REAL(wp), PUBLIC ::   rn_ahm_b        !: lateral laplacian background eddy viscosity [m2/s]
+   REAL(wp), PUBLIC ::   rn_bhm_0        !: lateral bilaplacian eddy viscosity          [m4/s]
+                                         !! If nn_ahm_ijk_t = 32 a time and space varying Smagorinsky viscosity
+                                         !! will be computed.
+   REAL(wp), PUBLIC ::   rn_csmc         !: Smagorinsky constant of proportionality 
+   REAL(wp), PUBLIC ::   rn_minfac       !: Multiplicative factor of theorectical minimum Smagorinsky viscosity
+   REAL(wp), PUBLIC ::   rn_maxfac       !: Multiplicative factor of theorectical maximum Smagorinsky viscosity
+
+   LOGICAL , PUBLIC ::   l_ldfdyn_time   !: flag for time variation of the lateral eddy viscosity coef.
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahmt, ahmf   !: eddy diffusivity coef. at U- and V-points   [m2/s or m4/s]
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dtensq       !: horizontal tension squared         (Smagorinsky only)
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dshesq       !: horizontal shearing strain squared (Smagorinsky only)
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   esqt, esqf   !: Square of the local gridscale (e1e2/(e1+e2))**2           
+
+   REAL(wp) ::   r1_12   = 1._wp / 12._wp    ! =1/12
+   REAL(wp) ::   r1_4    = 0.25_wp           ! =1/4
+   REAL(wp) ::   r1_8    = 0.125_wp          ! =1/8
+   REAL(wp) ::   r1_288  = 1._wp / 288._wp   ! =1/( 12^2 * 2 )
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_dyn_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_init  ***
+      !!                   
+      !! ** Purpose :   set the horizontal ocean dynamics physics
+      !!
+      !! ** Method  :   the eddy viscosity coef. specification depends on:
+      !!              - the operator:
+      !!             ln_dynldf_lap = T     laplacian operator
+      !!             ln_dynldf_blp = T   bilaplacian operator
+      !!              - the parameter nn_ahm_ijk_t:
+      !!    nn_ahm_ijk_t  =  0 => = constant
+      !!                  = 10 => = F(z) :     = constant with a reduction of 1/4 with depth 
+      !!                  =-20 => = F(i,j)     = shape read in 'eddy_viscosity.nc' file
+      !!                  = 20    = F(i,j)     = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
+      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_viscosity.nc'  file
+      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
+      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                           or |u|e^3/12 bilaplacian operator )
+      !!                  = 32    = F(i,j,k,t) = F(local deformation rate and gridscale) (D and L) (Smagorinsky)  
+      !!                                                           (   L^2|D|      laplacian operator
+      !!                                                           or  L^4|D|/8  bilaplacian operator )
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      REAL(wp) ::   zah0              ! local scalar
+      !
+      NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp,                  &
+         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   &
+         &                 nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0,   &
+         &                 rn_csmc      , rn_minfac, rn_maxfac
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namdyn_ldf in reference namelist : Lateral physics
+      READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdyn_ldf in configuration namelist : Lateral physics
+      READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdyn_ldf )
+
+      IF(lwp) THEN                      ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_dyn : lateral momentum physics'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namdyn_ldf : set lateral mixing parameters'
+         !
+         WRITE(numout,*) '      type :'
+         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap
+         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp
+         !
+         WRITE(numout,*) '      direction of action :'
+         WRITE(numout,*) '         iso-level                            ln_dynldf_lev = ', ln_dynldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)            ln_dynldf_hor = ', ln_dynldf_hor
+         WRITE(numout,*) '         iso-neutral                          ln_dynldf_iso = ', ln_dynldf_iso
+         !
+         WRITE(numout,*) '      coefficients :'
+         WRITE(numout,*) '         type of time-space variation         nn_ahm_ijk_t  = ', nn_ahm_ijk_t
+         WRITE(numout,*) '         lateral laplacian eddy viscosity     rn_ahm_0      = ', rn_ahm_0, ' m2/s'
+         WRITE(numout,*) '         background viscosity (iso case)      rn_ahm_b      = ', rn_ahm_b, ' m2/s'
+         WRITE(numout,*) '         lateral bilaplacian eddy viscosity   rn_bhm_0      = ', rn_bhm_0, ' m4/s'
+         WRITE(numout,*) '      smagorinsky settings (nn_ahm_ijk_t  = 32) :'
+         WRITE(numout,*) '         Smagorinsky coefficient              rn_csmc       = ', rn_csmc
+         WRITE(numout,*) '         factor multiplier for theorectical lower limit for '
+         WRITE(numout,*) '           Smagorinsky eddy visc (def. 1.0)   rn_minfac    = ', rn_minfac
+         WRITE(numout,*) '         factor multiplier for theorectical lower upper for '
+         WRITE(numout,*) '           Smagorinsky eddy visc (def. 1.0)   rn_maxfac    = ', rn_maxfac
+      ENDIF
+
+      !                                ! Parameter control
+      IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp ) THEN
+         IF(lwp) WRITE(numout,*) '   No viscous operator selected. ahmt and ahmf are not allocated'
+         l_ldfdyn_time = .FALSE.
+         RETURN
+      ENDIF
+      !
+      IF( ln_dynldf_blp .AND. ln_dynldf_iso ) THEN     ! iso-neutral bilaplacian not implemented
+         CALL ctl_stop( 'dyn_ldf_init: iso-neutral bilaplacian not coded yet' ) 
+      ENDIF
+
+      ! ... Space/Time variation of eddy coefficients
+      !                                               ! allocate the ahm arrays
+      ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays')
+      !
+      ahmt(:,:,jpk) = 0._wp                           ! last level always 0  
+      ahmf(:,:,jpk) = 0._wp
+      !
+      !                                               ! value of eddy mixing coef.
+      IF    ( ln_dynldf_lap ) THEN   ;   zah0 =      rn_ahm_0         !   laplacian operator
+      ELSEIF( ln_dynldf_blp ) THEN   ;   zah0 = ABS( rn_bhm_0 )       ! bilaplacian operator
+      ELSE                                                                  ! NO viscous  operator
+         CALL ctl_warn( 'ldf_dyn_init: No lateral viscous operator used ' )
+      ENDIF
+      !
+      l_ldfdyn_time = .FALSE.                         ! no time variation except in case defined below
+      !
+      IF( ln_dynldf_lap .OR. ln_dynldf_blp ) THEN     ! only if a lateral diffusion operator is used
+         !
+         SELECT CASE(  nn_ahm_ijk_t  )                ! Specification of space time variations of ahmt, ahmf
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant '
+            ahmt(:,:,:) = zah0 * tmask(:,:,:)
+            ahmf(:,:,:) = zah0 * fmask(:,:,:)
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )'
+            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value
+            ahmf(:,:,1) = zah0 * fmask(:,:,1)
+            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file'
+            CALL iom_open( 'eddy_viscosity_2D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) )
+            CALL iom_get ( inum, jpdom_data, 'ahmf_2d', ahmf(:,:,1) )
+            CALL iom_close( inum )
+!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???
+!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ????
+!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension
+            DO jk = 2, jpkm1
+               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk)
+               ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)'
+            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor^3
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file'
+            CALL iom_open( 'eddy_viscosity_3D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt )
+            CALL iom_get ( inum, jpdom_data, 'ahmf_3d', ahmf )
+            CALL iom_close( inum )
+!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ????
+!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ????
+            DO jk = 1, jpkm1
+               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk)
+               ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk)
+            END DO
+            !
+         CASE(  30  )       !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth )'
+            IF( ln_dynldf_lap )   CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            IF( ln_dynldf_blp )   CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf )    ! surface value proportional to scale factor
+            !                                                    ! reduction with depth
+            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
+            !
+         CASE(  31  )       !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12'
+            !
+            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90
+            !
+         CASE(  32  )       !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '             proportional to the local deformation rate and gridscale (Smagorinsky)'
+            IF(lwp) WRITE(numout,*) '                                                             : L^2|D| or L^4|D|/8'
+            !
+            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90
+            !
+            ! allocate arrays used in ldf_dyn. 
+            ALLOCATE( dtensq(jpi,jpj) , dshesq(jpi,jpj) , esqt(jpi,jpj) ,  esqf(jpi,jpj) , STAT=ierr )
+            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays')
+            !
+            ! Set local gridscale values
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  esqt(ji,jj) = ( e1e2t(ji,jj) /( e1t(ji,jj) + e2t(ji,jj) ) )**2 
+                  esqf(ji,jj) = ( e1e2f(ji,jj) /( e1f(ji,jj) + e2f(ji,jj) ) )**2 
+               END DO
+            END DO
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm')
+         END SELECT
+         !
+         IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN       ! bilapcian and no time variation:
+            ahmt(:,:,:) = SQRT( ahmt(:,:,:) )                     ! take the square root of the coefficient
+            ahmf(:,:,:) = SQRT( ahmf(:,:,:) )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ldf_dyn_init
+
+
+   SUBROUTINE ldf_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn  ***
+      !! 
+      !! ** Purpose :   update at kt the momentum lateral mixing coeff. (ahmt and ahmf)
+      !!
+      !! ** Method  :   time varying eddy viscosity coefficients:
+      !!
+      !!    nn_ahm_ijk_t = 31    ahmt, ahmf = F(i,j,k,t) = F(local velocity) 
+      !!                         ( |u|e /12  or  |u|e^3/12 for laplacian or bilaplacian operator )
+      !!
+      !!    nn_ahm_ijk_t = 32    ahmt, ahmf = F(i,j,k,t) = F(local deformation rate and gridscale) (D and L) (Smagorinsky)  
+      !!                         ( L^2|D|    or  L^4|D|/8  for laplacian or bilaplacian operator )
+      !!
+      !! ** note    :    in BLP cases the sqrt of the eddy coef is returned, since bilaplacian is en re-entrant laplacian
+      !! ** action  :    ahmt, ahmf   updated at each time step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zu2pv2_ij_p1, zu2pv2_ij, zu2pv2_ij_m1, zetmax, zefmax   ! local scalar
+      REAL(wp) ::   zcmsmag, zstabf_lo, zstabf_up, zdelta, zdb              ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_dyn')
+      !
+      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==!
+      !
+      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
+         !
+         IF( ln_dynldf_lap   ) THEN        ! laplacian operator : |u| e /12 = |u/144| e
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                     ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax * tmask(ji,jj,jk)      ! 288= 12*12 * 2
+                     ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax * fmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                     zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) )
+                     zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) )
+                     ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax  ) * zetmax * tmask(ji,jj,jk)
+                     ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax  ) * zefmax * fmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL lbc_lnk( ahmt, 'T', 1. )   ;   CALL lbc_lnk( ahmf, 'F', 1. )
+         !
+         !
+      CASE(  32  )       !==  time varying 3D field  ==!   = F( local deformation rate and gridscale ) (Smagorinsky)
+         !
+         IF( ln_dynldf_lap .OR. ln_dynldf_blp  ) THEN        ! laplacian operator : (C_smag/pi)^2 L^2 |D|
+            !
+            zcmsmag = (rn_csmc/rpi)**2                                              ! (C_smag/pi)^2
+            zstabf_lo  = rn_minfac * rn_minfac / ( 2._wp * 4._wp * zcmsmag )        ! lower limit stability factor scaling
+            zstabf_up  = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rdt )              ! upper limit stability factor scaling
+            IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo          ! provide |U|L^3/12 lower limit instead 
+            !                                                                       ! of |U|L^3/16 in blp case
+            DO jk = 1, jpkm1
+               !
+               DO jj = 2, jpj
+                  DO ji = 2, jpi
+                     zdb = ( (  ub(ji,jj,jk) * r1_e2u(ji,jj) -  ub(ji-1,jj,jk) * r1_e2u(ji-1,jj) )  &
+                          &                  * r1_e1t(ji,jj) * e2t(ji,jj)                           &
+                          & - ( vb(ji,jj,jk) * r1_e1v(ji,jj) -  vb(ji,jj-1,jk) * r1_e1v(ji,jj-1) )  &
+                          &                  * r1_e2t(ji,jj) * e1t(ji,jj)    ) * tmask(ji,jj,jk)
+                     dtensq(ji,jj) = zdb*zdb
+                  END DO
+               END DO
+               !
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zdb = ( (  ub(ji,jj+1,jk) * r1_e1u(ji,jj+1) -  ub(ji,jj,jk) * r1_e1u(ji,jj) )  &
+                          &                    * r1_e2f(ji,jj)   * e1f(ji,jj)                       &
+                          & + ( vb(ji+1,jj,jk) * r1_e2v(ji+1,jj) -  vb(ji,jj,jk) * r1_e2v(ji,jj) )  &
+                          &                    * r1_e1f(ji,jj)   * e2f(ji,jj)  ) * fmask(ji,jj,jk)
+                     dshesq(ji,jj) = zdb*zdb
+                  END DO
+               END DO
+               !
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     !
+                     zu2pv2_ij_p1 = ub(ji  ,jj+1,jk) * ub(ji  ,jj+1,jk) + vb(ji+1,jj  ,jk) * vb(ji+1,jj  ,jk)
+                     zu2pv2_ij    = ub(ji  ,jj  ,jk) * ub(ji  ,jj  ,jk) + vb(ji  ,jj  ,jk) * vb(ji  ,jj  ,jk)
+                     zu2pv2_ij_m1 = ub(ji-1,jj  ,jk) * ub(ji-1,jj  ,jk) + vb(ji  ,jj-1,jk) * vb(ji  ,jj-1,jk)
+                                                     ! T-point value
+                     zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2
+                     ahmt(ji,jj,jk) = zdelta * sqrt(          dtensq(ji,jj)   +                        &
+                                     &               r1_4 * ( dshesq(ji,jj)   + dshesq(ji,jj-1)   +    &
+                                     &                        dshesq(ji-1,jj) + dshesq(ji-1,jj-1) ) )
+                     ahmt(ji,jj,jk) =   MAX( ahmt(ji,jj,jk),   &
+                                     &   SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
+                     ahmt(ji,jj,jk) = MIN( ahmt(ji,jj,jk), zdelta * zstabf_up )                    ! Impose upper limit == maxfac  * L^2/(4*2dt)
+                                                     ! F-point value
+                     zdelta         = zcmsmag * esqf(ji,jj)                                        ! L^2 * (C_smag/pi)^2
+                     ahmf(ji,jj,jk) = zdelta * sqrt(          dshesq(ji,jj)   +                        &
+                                     &               r1_4 * ( dtensq(ji,jj)   + dtensq(ji,jj+1)   +    &
+                                     &                        dtensq(ji+1,jj) + dtensq(ji+1,jj+1) ) )
+                     ahmf(ji,jj,jk) =   MAX( ahmf(ji,jj,jk),   &
+                                     &   SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
+                     ahmf(ji,jj,jk) = MIN( ahmf(ji,jj,jk), zdelta * zstabf_up )                    ! Impose upper limit == maxfac  * L^2/(4*2dt)
+                     !
+                  END DO
+               END DO
+            END DO
+            !
+         ENDIF
+         !
+         IF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( (C_smag/pi)^2 L^4 |D|/8)
+                                       !                      = sqrt( A_lap_smag L^2/8 )
+                                       ! stability limits already applied to laplacian values
+                                       ! effective default limits are |U|L^3/12 < B_hm < L^4/(32*2dt)
+            !
+            DO jk = 1, jpkm1
+               !
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     !
+                     ahmt(ji,jj,jk) = sqrt( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) )
+                     ahmf(ji,jj,jk) = sqrt( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) )
+                     !
+                  END DO
+               END DO
+            END DO
+            !
+         ENDIF
+         !
+         CALL lbc_lnk( ahmt, 'T', 1. )   ;   CALL lbc_lnk( ahmf, 'F', 1. )
+         !
+      END SELECT
+      !
+      CALL iom_put( "ahmt_2d", ahmt(:,:,1) )   ! surface u-eddy diffusivity coeff.
+      CALL iom_put( "ahmf_2d", ahmf(:,:,1) )   ! surface v-eddy diffusivity coeff.
+      CALL iom_put( "ahmt_3d", ahmt(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
+      CALL iom_put( "ahmf_3d", ahmf(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_dyn')
+      !
+   END SUBROUTINE ldf_dyn
+
+   !!======================================================================
+END MODULE ldfdyn
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 8732)
@@ -0,0 +1,828 @@
+MODULE ldfslp
+   !!======================================================================
+   !!                       ***  MODULE  ldfslp  ***
+   !! Ocean physics: slopes of neutral surfaces
+   !!======================================================================
+   !! History :  OPA  ! 1994-12  (G. Madec, M. Imbard)  Original code
+   !!            8.0  ! 1997-06  (G. Madec)  optimization, lbc
+   !!            8.1  ! 1999-10  (A. Jouzeau)  NEW profile in the mixed layer
+   !!   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
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  add limiter on triad slopes
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_triad : calculates the triads of isoneutral slopes (Griffies operator)
+   !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator)
+   !!   ldf_slp_init  : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldfdyn         ! lateral diffusion: eddy viscosity coef.
+   USE phycst         ! physical constants
+   USE zdfmxl         ! mixed layer depth
+   USE eosbn2         ! equation of states
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distribued memory computing library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_slp         ! routine called by step.F90
+   PUBLIC   ldf_slp_triad   ! routine called by step.F90
+   PUBLIC   ldf_slp_init    ! routine called by nemogcm.F90
+
+   LOGICAL , PUBLIC ::   l_ldfslp = .FALSE.     !: slopes flag
+
+   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.       !: iso-neutral direction
+   LOGICAL , PUBLIC ::   ln_traldf_triad = .FALSE.      !: griffies triad scheme
+
+   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.      !: pure horizontal mixing in ML
+   LOGICAL , PUBLIC ::   ln_botmix_triad = .FALSE.      !: mixing on bottom
+   REAL(wp), PUBLIC ::   rn_sw_triad     = 1._wp        !: =1 switching triads ; =0 all four triads used 
+   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp      !: slope limit
+
+   LOGICAL , PUBLIC ::   l_grad_zps = .FALSE.           !: special treatment for Horz Tgradients w partial steps (triad operator)
+   
+   !                                                     !! Classic operator (Madec)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   uslp, wslpi          !: i_slope at U- and W-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   vslp, wslpj          !: j-slope at V- and W-points
+   !                                                     !! triad operator (Griffies)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wslp2                !: wslp**2 from Griffies quarter cells
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
+   !                                                     !! both operators
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   ah_wslp2             !: ah * slope^2 at w-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   akz                  !: stabilizing vertical diffusivity
+   
+   !                                                     !! Madec operator
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   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 "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_slp( kt, prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp  ***
+      !!
+      !! ** Purpose :   Compute the slopes of neutral surface (slope of isopycnal
+      !!              surfaces referenced locally) (ln_traldf_iso=T).
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at U- and
+      !!      W-points (uslp, wslpi) and the slope in the j-direction is
+      !!      computed at V- and W-points (vslp, wslpj).
+      !!      They are bounded by 1/100 over the whole ocean, and within the
+      !!      surface layer they are bounded by the distance to the surface
+      !!      ( slope<= depth/l  where l is the length scale of horizontal
+      !!      diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!      of 10cm/s)
+      !!        A horizontal shapiro filter is applied to the slopes
+      !!        ln_sco=T, s-coordinate, add to the previously computed slopes
+      !!      the slope of the model level surface.
+      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1)
+      !!      [slopes already set to zero at level 1, and to zero or the ocean
+      !!      bottom slope (ln_sco=T) at level jpk in inildf]
+      !!
+      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes
+      !!               of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
+      !!
+      INTEGER  ::   ji , jj , jk    ! dummy loop indices
+      INTEGER  ::   ii0, ii1        ! temporary integer
+      INTEGER  ::   ij0, ij1        ! temporary integer
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      REAL(wp) ::   zdepu, zdepv                   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zslpml_hmlpu, zslpml_hmlpv
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwz, zww
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdzr
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
+      CALL wrk_alloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv )
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      z1_slpmax = 1._wp / rn_slpmax
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) )
+               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 
+               IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
+         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
+         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
+            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+
+
+      ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
+      ! ===========================      | vslp = d/dj( prd ) / d/dz( prd )
+      !
+      IF ( ln_isfcav ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt  (ji,jj), hmlpt  (ji+1,jj  ), 5._wp) &
+                  &                                  - MAX(risfdep(ji,jj), risfdep(ji+1,jj  )       ) ) 
+               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt  (ji,jj), hmlpt  (ji  ,jj+1), 5._wp) &
+                  &                                  - MAX(risfdep(ji,jj), risfdep(ji  ,jj+1)       ) )
+            END DO
+         END DO
+      ELSE
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp)
+               zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp)
+            END DO
+         END DO
+      END IF
+
+      DO jk = 2, jpkm1                            !* Slopes at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                      ! horizontal and vertical density gradient at u- and v-points
+               zau = zgru(ji,jj,jk) * r1_e1u(ji,jj)
+               zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN(  zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,jk)* ABS( zav )  )
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               ! thickness of water column between surface and level k at u/v point
+               zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj,jk) )                            &
+                                - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj))   )
+               zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) )                            &
+                                - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj))   )
+               !
+               zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps )                                     &
+                  &                      + zfi  * zdepu * zslpml_hmlpu(ji,jj) ) * umask(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1._wp - zfj) * zav / ( zbv - zeps )                                     &
+                  &                      + zfj  * zdepv * zslpml_hmlpv(ji,jj) ) * vmask(ji,jj,jk)
+!!gm  modif to suppress omlmask.... (as in Griffies case)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
+      !
+      !                                            !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+         !                                        !* decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp
+            END DO
+         END DO
+      END DO
+
+
+      ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd )
+      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
+      !
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !                                  !* Local vertical density gradient evaluated from N^2
+               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+               !                                  !* Slopes at w point
+               !                                        ! i- & j-gradient of density at w-points
+               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
+                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
+               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
+                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) * e2t(ji,jj)
+               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * wmask (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * wmask (ji,jj,jk)
+               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = ( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj) - gdepw_n(ji,jj,mikt(ji,jj)), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk)
+
+!!gm  modif to suppress omlmask....  (as in Griffies operator)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = gdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
+      !
+      !                                           !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               zcofw = wmask(ji,jj,jk) * z1_16
+               wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &               +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &               + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &               +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj(ji,jj,jk) = (         zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &               +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &               + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &               +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         DO jj = 3, jpj-2                               ! other rows
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = wmask(ji,jj,jk) * z1_16
+               wslpi(ji,jj,jk) = (         zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                    &               +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                    &               + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                    &               +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw
+
+               wslpj(ji,jj,jk) = (         zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                    &               +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                    &               + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                    &               +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                    &               + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw
+            END DO
+         END DO
+         !                                        !* decrease in vicinity of topography
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
+                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
+            END DO
+         END DO
+      END DO
+
+      ! IV. Lateral boundary conditions
+      ! ===============================
+      CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
+      CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp  - u : ', tab3d_2=vslp,  clinfo2=' v : ', kdim=jpk)
+         CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv )
+      CALL wrk_dealloc( jpi,jpj, zslpml_hmlpu, zslpml_hmlpv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
+      !
+   END SUBROUTINE ldf_slp
+
+
+   SUBROUTINE ldf_slp_triad ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_triad  ***
+      !!
+      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_triad=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.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices
+      INTEGER  ::   iku, ikv                    ! local integer
+      REAL(wp) ::   zfacti, zfactj              ! local scalars
+      REAL(wp) ::   znot_thru_surface           ! local scalars
+      REAL(wp) ::   zdit, zdis, zdkt, zbu, zbti, zisw
+      REAL(wp) ::   zdjt, zdjs, zdks, zbv, zbtj, zjsw
+      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim
+      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim
+      REAL(wp) ::   zdzrho_raw
+      REAL(wp) ::   zbeta0, ze3_e1, ze3_e2
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   z1_mlbw
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalbet
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zdxrho , zdyrho, zdzrho     ! Horizontal and vertical density gradients
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_triad')
+      !
+      CALL wrk_alloc( jpi,jpj, z1_mlbw )
+      CALL wrk_alloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      !--------------------------------!
+      !  Some preliminary calculation  !
+      !--------------------------------!
+      !
+      DO jl = 0, 1                            !==  unmasked before density i- j-, 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 ==>  a minimum value is set
+               DO ji = 1, fs_jpim1            ! vector opt.
+                  zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! i-gradient of T & S at u-point
+                  zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point
+                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,jk,jp_tem) * zdit + rab_b(ji+ip,jj   ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj)
+                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji   ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw  )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw  )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points)
+                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature
+                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity
+                  zdxrho_raw = ( - rab_b(ji+ip,jj   ,iku,jp_tem) * zdit + rab_b(ji+ip,jj   ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj)
+                  zdyrho_raw = ( - rab_b(ji   ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji   ,jj+jp,ikv,jp_sal) * zdjs ) * r1_e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign
+                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+
+      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==!
+         DO jk = 1, jpkm1                     ! done each pair of triad
+            DO jj = 1, jpj                    ! NB: not masked ==>  a minimum value is set
+               DO ji = 1, jpi                 ! vector opt.
+                  IF( jk+kp > 1 ) THEN        ! k-gradient of T & S a jk+kp
+                     zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) )
+                     zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) )
+                  ELSE
+                     zdkt = 0._wp                                             ! 1st level gradient set to zero
+                     zdks = 0._wp
+                  ENDIF
+                  zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / e3w_n(ji,jj,jk+kp)
+                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln
+                 END DO
+            END DO
+         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 / gdepw_n(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 = nmln(ji+ip,jj) + 1
+                  IF( jk > mbkt(ji+ip,jj) ) THEN   ! ML reaches bottom
+                     zti_mlb(ji+ip,jj   ,1-ip,kp) = 0.0_wp
+                  ELSE                             
+                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth)
+                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                        &          - ( gdept_n(ji+1,jj,jk-kp) - gdept_n(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk)
+                     ze3_e1    =  e3w_n(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 
+                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw )
+                  ENDIF
+                  !
+                  jk = nmln(ji,jj+jp) + 1
+                  IF( jk >  mbkt(ji,jj+jp) ) THEN  !ML reaches bottom
+                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = 0.0_wp
+                  ELSE
+                     ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                        &      - ( gdept_n(ji,jj+1,jk-kp) - gdept_n(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                     ze3_e2    =  e3w_n(ji,jj+jp,jk-kp) / e2v(ji,jj)
+                     ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2  , ABS( ztj_g_raw ) ), ztj_g_raw )
+                  ENDIF
+               END DO
+            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
+               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface
+               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1         ! vector opt.
+                     !
+                     ! Calculate slope relative to geopotentials used for GM skew fluxes
+                     ! Add s-coordinate slope at t-points (do this by *subtracting* 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)
+                     !
+                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface
+                     zti_coord = znot_thru_surface * ( gdept_n(ji+1,jj  ,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj)
+                     ztj_coord = znot_thru_surface * ( gdept_n(ji  ,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked
+                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
+                     ztj_g_raw = ztj_raw - ztj_coord
+                     ! additional limit required in bilaplacian case
+                     ze3_e1    = e3w_n(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj)
+                     ze3_e2    = e3w_n(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj)
+                     ! NB: hard coded factor 5 (can be a namelist parameter...)
+                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     !
+                     ! Below  ML use limited zti_g as is & mask
+                     ! Inside ML replace by linearly reducing sx_mlb towards surface & mask
+                     !
+                     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)   &
+                        &                           * gdepw_n(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp)
+                     ztj_g_lim =          ( zfactj   * ztj_g_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
+                        &                           * gdepw_n(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp)
+                     !
+                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim
+                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim
+                     !
+                     ! 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 ) * umask(ji,jj,jk+kp)    ! remove coordinate slope => relative to coordinate surfaces
+                     ztj_lim  = ( ztj_g_lim + ztj_coord ) * vmask(ji,jj,jk+kp)
+                     !
+                     IF( ln_triad_iso ) THEN
+                        zti_raw = zti_lim*zti_lim / zti_raw
+                        ztj_raw = ztj_lim*ztj_lim / ztj_raw
+                        zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw )
+                        ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw )
+                        zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw
+                        ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw
+                     ENDIF
+                     !                                      ! switching triad scheme 
+                     zisw = (rn_sw_triad - 1._wp ) + rn_sw_triad    &
+                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) )  )
+                     zjsw = (rn_sw_triad - 1._wp ) + rn_sw_triad    &
+                        &            * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) )  )
+                     !
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim * zisw
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw
+                     !
+                     zbu  = e1e2u(ji   ,jj   ) * e3u_n(ji   ,jj   ,jk   )
+                     zbv  = e1e2v(ji   ,jj   ) * e3v_n(ji   ,jj   ,jk   )
+                     zbti = e1e2t(ji+ip,jj   ) * e3w_n(ji+ip,jj   ,jk+kp)
+                     zbtj = e1e2t(ji   ,jj+jp) * e3w_n(ji   ,jj+jp,jk+kp)
+                     !
+                     wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim      ! masked
+                     wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim
+                  END DO
+               END DO
+            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
+      !
+      CALL wrk_dealloc( jpi,jpj, z1_mlbw )
+      CALL wrk_dealloc( jpi,jpj,jpk, zalbet )
+      CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+      CALL wrk_dealloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_triad')
+      !
+   END SUBROUTINE ldf_slp_triad
+
+
+   SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_mxl  ***
+      !!
+      !! ** Purpose :   Compute the slopes of iso-neutral surface just below
+      !!              the mixed layer.
+      !!
+      !! ** 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
+      !!                vslpml, wslpjml    just below the mixed layer
+      !!                omlmask         :  mixed layer mask
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts)
+      REAL(wp), DIMENSION(:,:,:), 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, z1_slpmax ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_mxl')
+      !
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      z1_slpmax = 1._wp / rn_slpmax
+      !
+      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
+      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
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = nmln(ji,jj) - 1
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+
+      ! Slopes of isopycnal surfaces just before bottom of mixed layer
+      ! --------------------------------------------------------------
+      ! The slope are computed as in the 3D case.
+      ! A key point here is the definition of the mixed layer at u- and v-points.
+      ! It is assumed to be the maximum of the two neighbouring T-point mixed layer depth.
+      ! Otherwise, a n2 value inside the mixed layer can be involved in the computation
+      ! of the slope, resulting in a too steep diagnosed slope and thus a spurious eddy
+      ! induce velocity field near the base of the mixed layer.
+      !-----------------------------------------------------------------------
+      !
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            !                        !==   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) * r1_e1u(ji,jj)
+            zav = p_grv(ji,jj,ikv) * r1_e2v(ji,jj)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN(  zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u_n(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v_n(ji,jj,ikv)* ABS( zav )  )
+            !                        !- Slope at u- & v-points (uslpml, vslpml)
+            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku)
+            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ikv)
+            !
+            !                        !==   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/e3w_n(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/e3w_n(ji,jj,ik)* ABS( zaj )  )
+            !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * 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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_mxl')
+      !
+   END SUBROUTINE ldf_slp_mxl
+
+
+   SUBROUTINE ldf_slp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the isopycnal slopes computation
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ierr         ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_slp_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' )
+      !
+      IF( ln_traldf_triad ) THEN        ! Griffies operator : triad of slopes
+         IF(lwp) WRITE(numout,*) '              Griffies (triad) operator initialisation'
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) ,     &
+            &      triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1) ,     &
+            &      wslp2   (jpi,jpj,jpk)                                         , STAT=ierr )
+         IF( ierr > 0      )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' )
+         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )
+         !
+      ELSE                             ! Madec operator : slopes at u-, v-, and w-points
+         IF(lwp) WRITE(numout,*) '              Madec operator initialisation'
+         ALLOCATE( omlmask(jpi,jpj,jpk) ,                                                                        &
+            &      uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) ,     &
+            &      vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr )
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' )
+
+         ! 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.....
+!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN
+!            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+!
+!            ! geopotential diffusion in s-coordinates on tracers and/or momentum
+!            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+!            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+!
+!            ! set the slope of diffusion to the slope of s-surfaces
+!            !      ( c a u t i o n : minus sign as dep has positive value )
+!            DO jk = 1, jpk
+!               DO jj = 2, jpjm1
+!                  DO ji = fs_2, fs_jpim1   ! vector opt.
+!                     uslp (ji,jj,jk) = - ( gdept_n(ji+1,jj,jk) - gdept_n(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)
+!                     vslp (ji,jj,jk) = - ( gdept_n(ji,jj+1,jk) - gdept_n(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)
+!                     wslpi(ji,jj,jk) = - ( gdepw_n(ji+1,jj,jk) - gdepw_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                     wslpj(ji,jj,jk) = - ( gdepw_n(ji,jj+1,jk) - gdepw_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5
+!                  END DO
+!               END DO
+!            END DO
+!            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions
+!            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. )
+!!gm         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init')
+      !
+   END SUBROUTINE ldf_slp_init
+
+   !!======================================================================
+END MODULE ldfslp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 8732)
@@ -0,0 +1,802 @@
+MODULE ldftra
+   !!======================================================================
+   !!                       ***  MODULE  ldftra  ***
+   !! Ocean physics:  lateral diffusivity coefficients 
+   !!=====================================================================
+   !! History :       ! 1997-07  (G. Madec)  from inimix.F split in 2 routines
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2005-11  (G. Madec)  
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  restructuration/simplification of aht/aeiv specification,
+   !!                 !                                  add velocity dependent coefficient and optional read in file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_tra_init : initialization, namelist read, and parameters control
+   !!   ldf_tra      : update lateral eddy diffusivity coefficients at each time step 
+   !!   ldf_eiv_init : initialization of the eiv coeff. from namelist choices 
+   !!   ldf_eiv      : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability)
+   !!   ldf_eiv_trp  : add to the input ocean transport the contribution of the EIV parametrization
+   !!   ldf_eiv_dia  : diagnose the eddy induced velocity from the eiv streamfunction
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces
+   USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases 
+   USE diaptr
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module for ehanced bottom friction file
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
+   USE timing          ! timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_tra_init   ! called by nemogcm.F90
+   PUBLIC   ldf_tra        ! called by step.F90
+   PUBLIC   ldf_eiv_init   ! called by nemogcm.F90
+   PUBLIC   ldf_eiv        ! called by step.F90
+   PUBLIC   ldf_eiv_trp    ! called by traadv.F90
+   PUBLIC   ldf_eiv_dia    ! called by traldf_iso and traldf_iso_triad.F90
+   
+   !                                   !!* Namelist namtra_ldf : lateral mixing on tracers * 
+   !                                    != Operator type =!
+   LOGICAL , PUBLIC ::   ln_traldf_lap       !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_traldf_blp       !: bilaplacian operator
+   !                                    != Direction of action =!
+   LOGICAL , PUBLIC ::   ln_traldf_lev       !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_traldf_hor       !: horizontal (geopotential) direction
+!  LOGICAL , PUBLIC ::   ln_traldf_iso       !: iso-neutral direction                    (see ldfslp)
+!  LOGICAL , PUBLIC ::   ln_traldf_triad     !: griffies triad scheme                    (see ldfslp)
+   LOGICAL , PUBLIC ::   ln_traldf_msc       !: Method of Stabilizing Correction 
+!  LOGICAL , PUBLIC ::   ln_triad_iso        !: pure horizontal mixing in ML             (see ldfslp)
+!  LOGICAL , PUBLIC ::   ln_botmix_triad     !: mixing on bottom                         (see ldfslp)
+!  REAL(wp), PUBLIC ::   rn_sw_triad         !: =1/0 switching triad / all 4 triads used (see ldfslp)
+!  REAL(wp), PUBLIC ::   rn_slpmax           !: slope limit                              (see ldfslp)
+   !                                    !=  Coefficients =!
+   INTEGER , PUBLIC ::   nn_aht_ijk_t        !: choice of time & space variations of the lateral eddy diffusivity coef.
+   REAL(wp), PUBLIC ::   rn_aht_0            !:   laplacian lateral eddy diffusivity [m2/s]
+   REAL(wp), PUBLIC ::   rn_bht_0            !: bilaplacian lateral eddy diffusivity [m4/s]
+
+   !                                   !!* Namelist namtra_ldfeiv : eddy induced velocity param. *
+   !                                    != Use/diagnose eiv =!
+   LOGICAL , PUBLIC ::   ln_ldfeiv           !: eddy induced velocity flag
+   LOGICAL , PUBLIC ::   ln_ldfeiv_dia       !: diagnose & output eiv streamfunction and velocity (IOM)
+   !                                    != Coefficients =!
+   INTEGER , PUBLIC ::   nn_aei_ijk_t        !: choice of time/space variation of the eiv coeff.
+   REAL(wp), PUBLIC ::   rn_aeiv_0           !: eddy induced velocity coefficient [m2/s]
+   
+   LOGICAL , PUBLIC ::   l_ldftra_time = .FALSE.   !: flag for time variation of the lateral eddy diffusivity coef.
+   LOGICAL , PUBLIC ::   l_ldfeiv_time = .FALSE.   ! flag for time variation of the eiv coef.
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtu, ahtv   !: eddy diffusivity coef. at U- and V-points   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu, aeiv   !: eddy induced velocity coeff.                [m2/s]
+
+   REAL(wp) ::   r1_4  = 0.25_wp          ! =1/4
+   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! =1/12
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_tra_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra_init  ***
+      !! 
+      !! ** Purpose :   initializations of the tracer lateral mixing coeff.
+      !!
+      !! ** Method  : * the eddy diffusivity coef. specification depends on:
+      !!
+      !!    ln_traldf_lap = T     laplacian operator
+      !!    ln_traldf_blp = T   bilaplacian operator
+      !!
+      !!    nn_aht_ijk_t  =  0 => = constant
+      !!                  !
+      !!                  = 10 => = F(z) : constant with a reduction of 1/4 with depth 
+      !!                  !
+      !!                  =-20 => = F(i,j)   = shape read in 'eddy_diffusivity.nc' file
+      !!                  = 20    = F(i,j)   = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
+      !!                  = 21    = F(i,j,t) = F(growth rate of baroclinic instability)
+      !!                  !
+      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_diffusivity.nc' file
+      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
+      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                          or |u|e^3/12 bilaplacian operator )
+      !!              * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init 
+      !!            
+      !! ** action  : ahtu, ahtv initialized once for all or l_ldftra_time set to true
+      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      REAL(wp) ::   zah0              ! local scalar
+      !
+      NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp  ,                   &   ! type of operator
+         &                 ln_traldf_lev, ln_traldf_hor  , ln_traldf_triad,  &   ! acting direction of the operator
+         &                 ln_traldf_iso, ln_traldf_msc  ,  rn_slpmax     ,  &   ! option for iso-neutral operator
+         &                 ln_triad_iso , ln_botmix_triad, rn_sw_triad    ,  &   ! option for triad operator
+         &                 rn_aht_0     , rn_bht_0       , nn_aht_ijk_t          ! lateral eddy coefficient
+      !!----------------------------------------------------------------------
+      !
+      !  Choice of lateral tracer physics
+      ! =================================
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers
+      READ  ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers
+      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namtra_ldf )
+      !
+      IF(lwp) THEN                      ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_tra_init : lateral tracer physics'
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)'
+         !
+         WRITE(numout,*) '      type :'
+         WRITE(numout,*) '         laplacian operator                      ln_traldf_lap   = ', ln_traldf_lap
+         WRITE(numout,*) '         bilaplacian operator                    ln_traldf_blp   = ', ln_traldf_blp
+         !
+         WRITE(numout,*) '      direction of action :'
+         WRITE(numout,*) '         iso-level                               ln_traldf_lev   = ', ln_traldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)               ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '         iso-neutral Madec operator              ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '         iso-neutral triad operator              ln_traldf_triad = ', ln_traldf_triad
+         WRITE(numout,*) '            iso-neutral (Method of Stab. Corr.)  ln_traldf_msc   = ', ln_traldf_msc
+         WRITE(numout,*) '            maximum isoppycnal slope             rn_slpmax       = ', rn_slpmax
+         WRITE(numout,*) '            pure lateral mixing in ML            ln_triad_iso    = ', ln_triad_iso
+         WRITE(numout,*) '            switching triad or not               rn_sw_triad     = ', rn_sw_triad
+         WRITE(numout,*) '            lateral mixing on bottom             ln_botmix_triad = ', ln_botmix_triad
+         !
+         WRITE(numout,*) '      coefficients :'
+         WRITE(numout,*) '         lateral eddy diffusivity   (lap case)   rn_aht_0        = ', rn_aht_0
+         WRITE(numout,*) '         lateral eddy diffusivity (bilap case)   rn_bht_0        = ', rn_bht_0
+         WRITE(numout,*) '         type of time-space variation            nn_aht_ijk_t    = ', nn_aht_ijk_t
+      ENDIF
+      !
+      !                                ! Parameter control
+      !
+      IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN
+         IF(lwp) WRITE(numout,*) '   No diffusive operator selected. ahtu and ahtv are not allocated'
+         l_ldftra_time = .FALSE.
+         RETURN
+      ENDIF
+      !
+      IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN     ! iso-neutral bilaplacian need MSC
+         IF( .NOT.ln_traldf_msc )   CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' )
+      ENDIF
+      !
+      !  Space/time variation of eddy coefficients 
+      ! ===========================================
+      !                                               ! allocate the aht arrays
+      ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays')
+      !
+      ahtu(:,:,jpk) = 0._wp                           ! last level always 0  
+      ahtv(:,:,jpk) = 0._wp
+      !
+      !                                               ! value of eddy mixing coef.
+      IF    ( ln_traldf_lap ) THEN   ;   zah0 =      rn_aht_0        !   laplacian operator
+      ELSEIF( ln_traldf_blp ) THEN   ;   zah0 = ABS( rn_bht_0 )      ! bilaplacian operator
+      ENDIF
+      !
+      l_ldftra_time = .FALSE.                         ! no time variation except in case defined below
+      !
+      IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN     ! only if a lateral diffusion operator is used
+         !
+         SELECT CASE(  nn_aht_ijk_t  )                   ! Specification of space time variations of ehtu, ahtv
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0
+            ahtu(:,:,:) = zah0 * umask(:,:,:)
+            ahtv(:,:,:) = zah0 * vmask(:,:,:)
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
+            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value
+            ahtv(:,:,1) = zah0 * vmask(:,:,1)
+            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file'
+            CALL iom_open( 'eddy_diffusivity_2D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) )
+            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) )
+            CALL iom_close( inum )
+            DO jk = 2, jpkm1
+               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
+               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)'
+            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            !
+         CASE(  21  )      !==  time varying 2D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )'
+            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )'
+            IF(lwp) WRITE(numout,*) '                              min value = 0.1 * rn_aht_0'
+            IF(lwp) WRITE(numout,*) '                              max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)'
+            IF(lwp) WRITE(numout,*) '                              increased to rn_aht_0 within 20N-20S'
+            !
+            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+            IF( ln_traldf_blp ) THEN
+               CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' )
+            ENDIF
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file'
+            CALL iom_open( 'eddy_diffusivity_3D.nc', inum )
+            CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu )
+            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv )
+            CALL iom_close( inum )
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk)
+               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk)
+            END DO
+            !
+         CASE(  30  )      !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )'
+            IF( ln_traldf_lap )   CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            IF( ln_traldf_blp )   CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv )    ! surface value proportional to scale factor
+            !                                                    ! reduction with depth
+            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv )
+            !
+         CASE(  31  )      !==  time varying 3D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth , time )'
+            IF(lwp) WRITE(numout,*) '                                proportional to the velocity : |u|e/12 or |u|e^3/12'
+            !
+            l_ldftra_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht')
+         END SELECT
+         !
+         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN
+            ahtu(:,:,:) = SQRT( ahtu(:,:,:) )
+            ahtv(:,:,:) = SQRT( ahtv(:,:,:) )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra_init
+
+
+   SUBROUTINE ldf_tra( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra  ***
+      !! 
+      !! ** Purpose :   update at kt the tracer lateral mixing coeff. (aht and aeiv)
+      !!
+      !! ** Method  :   time varying eddy diffusivity coefficients:
+      !!
+      !!    nn_aei_ijk_t = 21    aeiu, aeiv = F(i,j,  t) = F(growth rate of baroclinic instability)
+      !!                                                   with a reduction to 0 in vicinity of the Equator
+      !!    nn_aht_ijk_t = 21    ahtu, ahtv = F(i,j,  t) = F(growth rate of baroclinic instability)
+      !!
+      !!                 = 31    ahtu, ahtv = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
+      !!                                                                     or |u|e^3/12 bilaplacian operator )
+      !!
+      !! ** action  :   ahtu, ahtv   update at each time step   
+      !!                aeiu, aeiv      -       -     -    -   (if ln_ldfeiv=T) 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zaht, zahf, zaht_min, z1_f20       ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN       ! eddy induced velocity coefficients
+         !                                ! =F(growth rate of baroclinic instability)
+         !                                ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S
+         CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv )
+      ENDIF
+      !
+      SELECT CASE(  nn_aht_ijk_t  )       ! Eddy diffusivity coefficients
+      !
+      CASE(  21  )       !==  time varying 2D field  ==!   = F( growth rate of baroclinic instability )
+         !                                             !   min value rn_aht_0 / 10 
+         !                                             !   max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)
+         !                                             !   increase to rn_aht_0 within 20N-20S
+         IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN   ! use the already computed aei.
+            ahtu(:,:,1) = aeiu(:,:,1)
+            ahtv(:,:,1) = aeiv(:,:,1)
+         ELSE                                            ! compute aht. 
+            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv )
+         ENDIF
+         !
+         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)   
+         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg)
+               !!     ==>>>   The Coriolis value is identical for t- & u_points, and for v- and f-points
+               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff_t(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min )
+               zahf = ( 1._wp -  MIN( 1._wp , ABS( ff_f(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min )
+               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  ) * umask(ji,jj,1)     ! min value zaht_min
+               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zahf  ) * vmask(ji,jj,1)     ! increase within 20S-20N
+            END DO
+         END DO
+         DO jk = 2, jpkm1                             ! deeper value = surface value
+            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk)
+            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk)
+         END DO
+         !
+      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
+         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12
+               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12
+            END DO
+         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e
+            DO jk = 1, jpkm1
+               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:)
+               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:)
+            END DO
+         ENDIF
+         !
+      END SELECT
+      !
+      CALL iom_put( "ahtu_2d", ahtu(:,:,1) )   ! surface u-eddy diffusivity coeff.
+      CALL iom_put( "ahtv_2d", ahtv(:,:,1) )   ! surface v-eddy diffusivity coeff.
+      CALL iom_put( "ahtu_3d", ahtu(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
+      CALL iom_put( "ahtv_3d", ahtv(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
+      !
+!!gm  : THE IF below is to be checked (comes from Seb)
+      IF( ln_ldfeiv ) THEN
+        CALL iom_put( "aeiu_2d", aeiu(:,:,1) )   ! surface u-EIV coeff.
+        CALL iom_put( "aeiv_2d", aeiv(:,:,1) )   ! surface v-EIV coeff.
+        CALL iom_put( "aeiu_3d", aeiu(:,:,:) )   ! 3D      u-EIV coeff.
+        CALL iom_put( "aeiv_3d", aeiv(:,:,:) )   ! 3D      v-EIV coeff.
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra
+
+
+   SUBROUTINE ldf_eiv_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_init  ***
+      !!
+      !! ** Purpose :   initialization of the eiv coeff. from namelist choices.
+      !!
+      !! ** Method :
+      !!
+      !! ** Action :   aeiu , aeiv   : EIV coeff. at u- & v-points
+      !!               l_ldfeiv_time : =T if EIV coefficients vary with time
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                ! dummy loop indices
+      INTEGER  ::   ierr, inum, ios   ! local integer
+      !
+      NAMELIST/namtra_ldfeiv/ ln_ldfeiv   , ln_ldfeiv_dia,   &    ! eddy induced velocity (eiv)
+         &                    nn_aei_ijk_t, rn_aeiv_0             ! eiv  coefficient
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param.
+      READ  ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param.
+      READ  ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp )
+      IF(lwm)  WRITE ( numond, namtra_ldfeiv )
+
+      IF(lwp) THEN                      ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization'
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namtra_ldfeiv : '
+         WRITE(numout,*) '      Eddy Induced Velocity (eiv) param.      ln_ldfeiv     = ', ln_ldfeiv
+         WRITE(numout,*) '      eiv streamfunction & velocity diag.     ln_ldfeiv_dia = ', ln_ldfeiv_dia
+         WRITE(numout,*) '      eddy induced velocity coef.             rn_aeiv_0     = ', rn_aeiv_0
+         WRITE(numout,*) '      type of time-space variation            nn_aei_ijk_t  = ', nn_aei_ijk_t
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( ln_ldfeiv .AND. ln_traldf_blp )   CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' )
+
+      !                                 ! Parameter control
+      l_ldfeiv_time = .FALSE.    
+      !
+      IF( ln_ldfeiv ) THEN                         ! allocate the aei arrays
+         ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr )
+         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays')
+         !
+         SELECT CASE( nn_aei_ijk_t )               ! Specification of space time variations of eaiu, aeiv
+         !
+         CASE(   0  )      !==  constant  ==!
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0
+            aeiu(:,:,:) = rn_aeiv_0
+            aeiv(:,:,:) = rn_aeiv_0
+            !
+         CASE(  10  )      !==  fixed profile  ==!
+            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )'
+            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value
+            aeiv(:,:,1) = rn_aeiv_0
+            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv )
+            !
+         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file'
+            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) )
+            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) )
+            CALL iom_close( inum )
+            DO jk = 2, jpk
+               aeiu(:,:,jk) = aeiu(:,:,1)
+               aeiv(:,:,jk) = aeiv(:,:,1)
+            END DO
+            !
+         CASE(  20  )      !== fixed horizontal shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)'
+            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor
+            !
+         CASE(  21  )       !==  time varying 2D field  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, time )'
+            IF(lwp) WRITE(numout,*) '                              = F( growth rate of baroclinic instability )'
+            !
+            l_ldfeiv_time = .TRUE.     ! will be calculated by call to ldf_tra routine in step.F90
+            !
+         CASE( -30  )      !== fixed 3D shape read in file  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file'
+            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu )
+            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv )
+            CALL iom_close( inum )
+            !
+         CASE(  30  )       !==  fixed 3D shape  ==!
+            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth )'
+            CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv )    ! surface value proportional to scale factor
+            !                                                 ! reduction with depth
+            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv )
+            !
+         CASE DEFAULT
+            CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei')
+         END SELECT
+         !
+      ELSE
+          IF(lwp) WRITE(numout,*) '   eddy induced velocity param is NOT used neither diagnosed'
+          ln_ldfeiv_dia = .FALSE.
+      ENDIF
+      !                    
+   END SUBROUTINE ldf_eiv_init
+
+
+   SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!              growth rate of baroclinic instability.
+      !!
+      !! ** Method  :   coefficient function of the growth rate of baroclinic instability
+      !!
+      !! Reference : Treguier et al. JPO 1997   ; Held and Larichev JAS 1996
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index
+      REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s]
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei   ! local scalars
+      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross, zaeiw   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('ldf_eiv')
+      !
+      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw )
+      !      
+      zn   (:,:) = 0._wp      ! Local initialization
+      zhw  (:,:) = 5._wp
+      zah  (:,:) = 0._wp
+      zross(:,:) = 0._wp
+      !                       ! Compute lateral diffusive coefficient at T-point
+      IF( ln_traldf_triad ) THEN
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * e3w_n(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+         END DO
+      END IF
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
+            ! Rossby radius at w-point taken < 40km and  > 2km
+            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
+            ! Compute aeiw by multiplying Ro^2 and T^-1
+            zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+      !                                         !==  Bound on eiv coeff.  ==!
+      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease
+            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0
+         END DO
+      END DO
+      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition
+      !               
+      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==!
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1)
+            paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1)
+         END DO 
+      END DO 
+      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition
+
+      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==!
+         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk)
+         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk)
+      END DO
+      !  
+      CALL wrk_dealloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('ldf_eiv')
+      !
+   END SUBROUTINE ldf_eiv
+
+
+   SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_trp  ***
+      !! 
+      !! ** Purpose :   add to the input ocean transport the contribution of 
+      !!              the eddy induced velocity parametrization.
+      !!
+      !! ** Method  :   The eddy induced transport is computed from a flux stream-
+      !!              function which depends on the slope of iso-neutral surfaces
+      !!              (see ldf_slp). For example, in the i-k plan : 
+      !!                   psi_uw = mk(aeiu) e2u mi(wslpi)   [in m3/s]
+      !!                   Utr_eiv = - dk[psi_uw]
+      !!                   Vtr_eiv = + di[psi_uw]
+      !!                ln_ldfeiv_dia = T : output the associated streamfunction,
+      !!                                    velocity and heat transport (call ldf_eiv_dia)
+      !!
+      !! ** Action  : pun, pvn increased by the eiv transport
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean transport components   [m3/s]
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv                [m3/s]
+      !!
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
+      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start( 'ldf_eiv_trp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw )
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
+      ENDIF
+
+      
+      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp
+      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp
+      !
+      DO jk = 2, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   &
+                  &                                       * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * umask(ji,jj,jk)
+               zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk) )   &
+                  &                                       * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj  ,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.               
+               pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
+               pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
+            END DO
+         END DO
+      END DO
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pwn(ji,jj,jk) = pwn(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   &
+                  &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      !                              ! diagnose the eddy induced velocity and associated heat transport
+      IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zpsi_uw, zpsi_vw )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop( 'ldf_eiv_trp')
+      !
+    END SUBROUTINE ldf_eiv_trp
+
+
+   SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv_dia  ***
+      !!
+      !! ** Purpose :   diagnose the eddy induced velocity and its associated
+      !!              vertically integrated heat transport.
+      !!
+      !! ** Method :
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s]
+      !
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zztmp   ! local scalar
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zw2d   ! 2D workspace
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zw3d   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'ldf_eiv_dia')
+      !
+      !                                                  !==  eiv stream function: output  ==!
+      CALL lbc_lnk( psi_uw, 'U', -1. )                         ! lateral boundary condition
+      CALL lbc_lnk( psi_vw, 'V', -1. )
+      !
+!!gm      CALL iom_put( "psi_eiv_uw", psi_uw )                 ! output
+!!gm      CALL iom_put( "psi_eiv_vw", psi_vw )
+      !
+      !                                                  !==  eiv velocities: calculate and output  ==!
+      CALL wrk_alloc( jpi,jpj,jpk,   zw3d )
+      !
+      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0
+      !
+      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw]
+         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) )
+      END DO
+      CALL iom_put( "uoce_eiv", zw3d )
+      !
+      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw]
+         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) )
+      END DO
+      CALL iom_put( "voce_eiv", zw3d )
+      !
+      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix]
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               zw3d(ji,jj,jk) = (  psi_vw(ji,jj,jk) - psi_vw(ji  ,jj-1,jk)    &
+                  &              + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj  ,jk)  ) / e1e2t(ji,jj)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw3d, 'T', 1. )      ! lateral boundary condition
+      CALL iom_put( "woce_eiv", zw3d )
+      !
+      !      
+      !
+      CALL wrk_alloc( jpi,jpj,   zw2d )
+      !
+      zztmp = 0.5_wp * rau0 * rcp 
+      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN
+        zw2d(:,:)   = 0._wp 
+        zw3d(:,:,:) = 0._wp 
+        DO jk = 1, jpkm1
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
+                    &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) ) 
+                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+        CALL lbc_lnk( zw2d, 'U', -1. )
+        CALL lbc_lnk( zw3d, 'U', -1. )
+        CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction
+        CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction
+      ENDIF
+      zw2d(:,:)   = 0._wp 
+      zw3d(:,:,:) = 0._wp 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
+                  &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) ) 
+               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw2d, 'V', -1. )
+      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction
+      CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in j-direction
+      !
+      IF( ln_diaptr )  CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
+      !
+      zztmp = 0.5_wp * 0.5
+      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN
+        zw2d(:,:) = 0._wp 
+        zw3d(:,:,:) = 0._wp 
+        DO jk = 1, jpkm1
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
+                    &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) ) 
+                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+        CALL lbc_lnk( zw2d, 'U', -1. )
+        CALL lbc_lnk( zw3d, 'U', -1. )
+        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction
+        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction
+      ENDIF
+      zw2d(:,:) = 0._wp 
+      zw3d(:,:,:) = 0._wp 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
+                  &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji,jj+1,jk,jp_sal) ) 
+               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw2d, 'V', -1. )
+      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction
+      CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction
+      !
+      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zw2d )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zw3d )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')      
+      !
+   END SUBROUTINE ldf_eiv_dia
+
+   !!======================================================================
+END MODULE ldftra
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 8732)
@@ -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(wp), 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 8732)
@@ -0,0 +1,972 @@
+MODULE diaobs
+   !!======================================================================
+   !!                       ***  MODULE diaobs  ***
+   !! Observation diagnostics: Computation of the misfit between data and
+   !!                          their model equivalent 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dia_obs_init : Reading and prepare observations
+   !!   dia_obs      : Compute model equivalent to observations
+   !!   dia_obs_wri  : Write observational diagnostics
+   !!   calc_date    : Compute the date of timestep in YYYYMMDD.HHMMSS format
+   !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS
+   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE wrk_nemo                 ! Memory Allocation
+   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 profile obs
+   USE obs_read_surf            ! Reading and allocation of surface obs
+   USE obs_sstbias              ! Bias correction routine for SST 
+   USE obs_readmdt              ! Reading and allocation of MDT for SLA.
+   USE obs_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_surf_def             ! Surface data definitions
+   USE obs_types                ! Definitions for observation types
+   USE mpp_map                  ! MPP mapping
+   USE lib_mpp                  ! For ctl_warn/stop
+
+   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
+      &   dia_obs_dealloc, &  ! Deallocate dia_obs data
+      &   calc_date           ! Compute the date of a timestep
+
+   !! * Module variables
+   LOGICAL, PUBLIC :: ln_diaobs   !: Logical switch for the obs operator
+   LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs
+   
+   INTEGER :: nn_1dint       !: Vertical interpolation method
+   INTEGER :: nn_2dint       !: Horizontal interpolation method
+   INTEGER, DIMENSION(imaxavtypes) :: &
+      & nn_profdavtypes      !: Profile data types representing a daily average
+   INTEGER :: nproftypes     !: Number of profile obs types
+   INTEGER :: nsurftypes     !: Number of surface obs types
+   INTEGER, DIMENSION(:), ALLOCATABLE :: &
+      & nvarsprof, &         !: Number of profile variables
+      & nvarssurf            !: Number of surface variables
+   INTEGER, DIMENSION(:), ALLOCATABLE :: &
+      & nextrprof, &         !: Number of profile extra variables
+      & nextrsurf            !: Number of surface extra variables
+   INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sstbias_type !SST bias type    
+   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: &
+      & surfdata, &          !: Initial surface data
+      & surfdataqc           !: Surface data after quality control
+   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: &
+      & profdata, &          !: Initial profile data
+      & profdataqc           !: Profile data after quality control
+
+   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: &
+      & cobstypesprof, &     !: Profile obs types
+      & cobstypessurf        !: Surface obs types
+
+   !!----------------------------------------------------------------------
+   !! 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
+      !!        !  14-08  (J.While) Incorporated SST bias correction  
+      !!        !  15-02  (M. Martin) Simplification of namelist and code
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpmaxnfiles = 1000    ! Maximum number of files for each obs type
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & ifilesprof, &         ! Number of profile files
+         & ifilessurf            ! Number of surface files
+      INTEGER :: ios             ! Local integer output status for namelist read
+      INTEGER :: jtype           ! Counter for obs types
+      INTEGER :: jvar            ! Counter for variables
+      INTEGER :: jfile           ! Counter for files
+
+      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: &
+         & cn_profbfiles, &      ! T/S profile input filenames
+         & cn_sstfbfiles, &      ! Sea surface temperature input filenames
+         & cn_slafbfiles, &      ! Sea level anomaly input filenames
+         & cn_sicfbfiles, &      ! Seaice concentration input filenames
+         & cn_velfbfiles, &      ! Velocity profile input filenames
+         & cn_sstbias_files      ! SST bias input filenames
+      CHARACTER(LEN=128) :: &
+         & cn_altbiasfile        ! Altimeter bias input filename
+      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: &
+         & clproffiles, &        ! Profile filenames
+         & clsurffiles           ! Surface filenames
+
+      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles
+      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles
+      LOGICAL :: ln_sla          ! Logical switch for sea level anomalies 
+      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature
+      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration
+      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs
+      LOGICAL :: ln_nea          ! Logical switch to remove obs near land
+      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias
+      LOGICAL :: ln_sstbias     !: Logical switch for bias corection of SST 
+      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files
+      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs
+      LOGICAL :: llvar1          ! Logical for profile variable 1
+      LOGICAL :: llvar2          ! Logical for profile variable 1
+      LOGICAL :: llnightav       ! Logical for calculating night-time averages
+      LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files
+
+      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS
+      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zglam1, &             ! Model longitudes for profile variable 1
+         & zglam2                ! Model longitudes for profile variable 2
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zgphi1, &             ! Model latitudes for profile variable 1
+         & zgphi2                ! Model latitudes for profile variable 2
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: &
+         & zmask1, &             ! Model land/sea mask associated with variable 1
+         & zmask2                ! Model land/sea mask associated with variable 2
+
+      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              &
+         &            ln_sst, ln_sic, ln_vel3d,                       &
+         &            ln_altbias, ln_nea, ln_grid_global,             &
+         &            ln_grid_search_lookup,                          &
+         &            ln_ignmis, ln_s_at_t, ln_sstnight,              &
+         &            cn_profbfiles, cn_slafbfiles,                   &
+         &            cn_sstfbfiles, cn_sicfbfiles,                   &
+         &            cn_velfbfiles, cn_altbiasfile,                  &
+         &            cn_gridsearchfile, rn_gridsearchres,            &
+         &            rn_dobsini, rn_dobsend, nn_1dint, nn_2dint,     &
+         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             &
+         &            nn_profdavtypes, ln_sstbias, cn_sstbias_files
+
+      INTEGER :: jnumsstbias
+      CALL wrk_alloc( jpi, jpj, zglam1 )
+      CALL wrk_alloc( jpi, jpj, zglam2 )
+      CALL wrk_alloc( jpi, jpj, zgphi1 )
+      CALL wrk_alloc( jpi, jpj, zgphi2 )
+      CALL wrk_alloc( jpi, jpj, jpk, zmask1 )
+      CALL wrk_alloc( jpi, jpj, jpk, zmask2 )
+
+      !-----------------------------------------------------------------------
+      ! Read namelist parameters
+      !-----------------------------------------------------------------------
+      
+      !Initalise all values in namelist arrays
+      ALLOCATE(sstbias_type(jpmaxnfiles))
+      ! Some namelist arrays need initialising
+      cn_profbfiles(:) = ''
+      cn_slafbfiles(:) = ''
+      cn_sstfbfiles(:) = ''
+      cn_sicfbfiles(:) = ''
+      cn_velfbfiles(:) = ''
+      cn_sstbias_files(:) = ''
+      nn_profdavtypes(:) = -1
+
+      CALL ini_date( rn_dobsini )
+      CALL fin_date( rn_dobsend )
+
+      ! Read namelist namobs : control observation diagnostics
+      REWIND( numnam_ref )   ! Namelist namobs in reference namelist
+      READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp )
+
+      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist
+      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namobs )
+
+      IF ( .NOT. ln_diaobs ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*)' ln_diaobs is set to false so not calling dia_obs'
+         RETURN
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Set up list of observation types to be used
+      ! and the files associated with each type
+      !-----------------------------------------------------------------------
+
+      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) )
+      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic /) )
+
+      IF (ln_sstbias) THEN 
+         lmask(:) = .FALSE. 
+         WHERE (cn_sstbias_files(:) /= '') lmask(:) = .TRUE. 
+         jnumsstbias = COUNT(lmask) 
+         lmask(:) = .FALSE. 
+      ENDIF      
+
+      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', &
+            &                    ' ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d', &
+            &                    ' are set to .FALSE. so turning off calls to dia_obs'
+         nwarn = nwarn + 1
+         ln_diaobs = .FALSE.
+         RETURN
+      ENDIF
+
+      IF ( nproftypes > 0 ) THEN
+
+         ALLOCATE( cobstypesprof(nproftypes) )
+         ALLOCATE( ifilesprof(nproftypes) )
+         ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) )
+
+         jtype = 0
+         IF (ln_t3d .OR. ln_s3d) THEN
+            jtype = jtype + 1
+            clproffiles(jtype,:) = cn_profbfiles(:)
+            cobstypesprof(jtype) = 'prof  '
+            ifilesprof(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clproffiles(jtype,jfile)) /= '' ) &
+                  ifilesprof(jtype) = ifilesprof(jtype) + 1
+            END DO
+         ENDIF
+         IF (ln_vel3d) THEN
+            jtype = jtype + 1
+            clproffiles(jtype,:) = cn_velfbfiles(:)
+            cobstypesprof(jtype) = 'vel   '
+            ifilesprof(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clproffiles(jtype,jfile)) /= '' ) &
+                  ifilesprof(jtype) = ifilesprof(jtype) + 1
+            END DO
+         ENDIF
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         ALLOCATE( cobstypessurf(nsurftypes) )
+         ALLOCATE( ifilessurf(nsurftypes) )
+         ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) )
+
+         jtype = 0
+         IF (ln_sla) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_slafbfiles(:)
+            cobstypessurf(jtype) = 'sla   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+         IF (ln_sst) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_sstfbfiles(:)
+            cobstypessurf(jtype) = 'sst   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+#if defined key_lim2 || defined key_lim3
+         IF (ln_sic) THEN
+            jtype = jtype + 1
+            clsurffiles(jtype,:) = cn_sicfbfiles(:)
+            cobstypessurf(jtype) = 'sic   '
+            ifilessurf(jtype) = 0
+            DO jfile = 1, jpmaxnfiles
+               IF ( trim(clsurffiles(jtype,jfile)) /= '' ) &
+                  ifilessurf(jtype) = ifilessurf(jtype) + 1
+            END DO
+         ENDIF
+#endif
+
+      ENDIF
+
+      !Write namelist settings to stdout
+      IF(lwp) THEN
+         WRITE(numout,*)
+         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 SLA observations                      ln_sla = ', ln_sla
+         WRITE(numout,*) '             Logical switch for SST observations                      ln_sst = ', ln_sst
+         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic
+         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d
+         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ',ln_grid_global
+         WRITE(numout,*) '             Logical switch for SST bias correction         ln_sstbias = ', ln_sstbias 
+         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ',ln_grid_search_lookup
+         IF (ln_grid_search_lookup) &
+            WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile
+         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini
+         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend
+         WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint
+         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint
+         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea
+         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc
+         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr
+         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff
+         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias
+         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis
+         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes
+         WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight
+         WRITE(numout,*) '          Number of profile obs types: ',nproftypes
+
+         IF ( nproftypes > 0 ) THEN
+            DO jtype = 1, nproftypes
+               DO jfile = 1, ifilesprof(jtype)
+                  WRITE(numout,'(1X,2A)') '             '//cobstypesprof(jtype)//' input observation file names  = ', &
+                     TRIM(clproffiles(jtype,jfile))
+               END DO
+            END DO
+         ENDIF
+
+         WRITE(numout,*)'          Number of surface obs types: ',nsurftypes
+         IF ( nsurftypes > 0 ) THEN
+            DO jtype = 1, nsurftypes
+               DO jfile = 1, ifilessurf(jtype)
+                  WRITE(numout,'(1X,2A)') '             '//cobstypessurf(jtype)//' input observation file names  = ', &
+                     TRIM(clsurffiles(jtype,jfile))
+               END DO
+            END DO
+         ENDIF
+         WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Obs operator parameter checking and initialisations
+      !-----------------------------------------------------------------------
+
+      IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
+         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
+         RETURN
+      ENDIF
+
+      IF ( ln_grid_global ) THEN
+         CALL ctl_warn( 'ln_grid_global=T may cause memory issues when used with a large number of processors' )
+      ENDIF
+
+      IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN
+         CALL ctl_stop(' Choice of vertical (1D) interpolation method', &
+            &                    ' is not available')
+      ENDIF
+
+      IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 4 ) ) THEN
+         CALL ctl_stop(' Choice of horizontal (2D) interpolation method', &
+            &                    ' is not available')
+      ENDIF
+
+      CALL obs_typ_init
+      IF(ln_grid_global) THEN
+         CALL mppmap_init
+      ENDIF
+
+      CALL obs_grid_setup( )
+
+      !-----------------------------------------------------------------------
+      ! Depending on switches read the various observation types
+      !-----------------------------------------------------------------------
+
+      IF ( nproftypes > 0 ) THEN
+
+         ALLOCATE(profdata(nproftypes))
+         ALLOCATE(profdataqc(nproftypes))
+         ALLOCATE(nvarsprof(nproftypes))
+         ALLOCATE(nextrprof(nproftypes))
+
+         DO jtype = 1, nproftypes
+
+            nvarsprof(jtype) = 2
+            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN
+               nextrprof(jtype) = 1
+               llvar1 = ln_t3d
+               llvar2 = ln_s3d
+               zglam1 = glamt
+               zgphi1 = gphit
+               zmask1 = tmask
+               zglam2 = glamt
+               zgphi2 = gphit
+               zmask2 = tmask
+            ENDIF
+            IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN
+               nextrprof(jtype) = 2
+               llvar1 = ln_vel3d
+               llvar2 = ln_vel3d
+               zglam1 = glamu
+               zgphi1 = gphiu
+               zmask1 = umask
+               zglam2 = glamv
+               zgphi2 = gphiv
+               zmask2 = vmask
+            ENDIF
+
+            !Read in profile or profile obs types
+            CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       &
+               &               clproffiles(jtype,1:ifilesprof(jtype)), &
+               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, &
+               &               rn_dobsini, rn_dobsend, llvar1, llvar2, &
+               &               ln_ignmis, ln_s_at_t, .FALSE., &
+               &               kdailyavtypes = nn_profdavtypes )
+
+            DO jvar = 1, nvarsprof(jtype)
+               CALL obs_prof_staend( profdata(jtype), jvar )
+            END DO
+
+            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), &
+               &               llvar1, llvar2, &
+               &               jpi, jpj, jpk, &
+               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  &
+               &               ln_nea, kdailyavtypes = nn_profdavtypes )
+
+         END DO
+
+         DEALLOCATE( ifilesprof, clproffiles )
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         ALLOCATE(surfdata(nsurftypes))
+         ALLOCATE(surfdataqc(nsurftypes))
+         ALLOCATE(nvarssurf(nsurftypes))
+         ALLOCATE(nextrsurf(nsurftypes))
+
+         DO jtype = 1, nsurftypes
+
+            nvarssurf(jtype) = 1
+            nextrsurf(jtype) = 0
+            llnightav = .FALSE.
+            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2
+            IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav = ln_sstnight
+
+            !Read in surface obs types
+            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), &
+               &               clsurffiles(jtype,1:ifilessurf(jtype)), &
+               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, &
+               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav )
+         
+         
+            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea )
+
+            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
+               CALL obs_rea_mdt( surfdataqc(jtype), nn_2dint )
+               IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile )
+            ENDIF
+            IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN
+               !Read in bias field and correct SST.
+               IF ( jnumsstbias == 0 ) CALL ctl_stop("ln_sstbias set,"// &
+                                                     "  but no bias"// &
+                                                     " files to read in")   
+                  CALL obs_app_sstbias( surfdataqc(jtype), nn_2dint, &
+                                        jnumsstbias, cn_sstbias_files(1:jnumsstbias) )
+            ENDIF
+         END DO
+
+         DEALLOCATE( ifilessurf, clsurffiles )
+
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, zglam1 )
+      CALL wrk_dealloc( jpi, jpj, zglam2 )
+      CALL wrk_dealloc( jpi, jpj, zgphi1 )
+      CALL wrk_dealloc( jpi, jpj, zgphi2 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zmask1 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zmask2 )
+
+   END SUBROUTINE dia_obs_init
+
+   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 data:
+      !!               - Profile data, currently T/S or U/V
+      !!               - Surface data, currently SST, SLA or sea-ice concentration.
+      !!
+      !! ** 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
+      !!        !  14-08  (J. While) observation operator for profiles in 
+      !!                             generalised vertical coordinates
+      !!        !  15-08  (M. Martin) Combined surface/profile routines.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &             ! Ocean space and time domain variables
+         & gdept_n,       &      
+         & gdept_1d      
+      USE phycst, ONLY : &              ! Physical constants
+         & rday                         
+      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables
+         & tsn,  &             
+         & un, vn, &
+         & sshn  
+      USE phycst, ONLY : &         ! Physical constants
+         & rday
+#if defined  key_lim3
+      USE ice, ONLY : &            ! LIM3 Ice model variables
+         & frld
+#endif
+#if defined key_lim2
+      USE ice_2, ONLY : &          ! LIM2 Ice model variables
+         & frld
+#endif
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kstp  ! Current timestep
+      !! * Local declarations
+      INTEGER :: idaystp           ! Number of timesteps per day
+      INTEGER :: jtype             ! Data loop variable
+      INTEGER :: jvar              ! Variable number
+      INTEGER :: ji, jj            ! Loop counters
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: &
+         & zprofvar1, &            ! Model values for 1st variable in a prof ob
+         & zprofvar2               ! Model values for 2nd variable in a prof ob
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: &
+         & zprofmask1, &           ! Mask associated with zprofvar1
+         & zprofmask2              ! Mask associated with zprofvar2
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zsurfvar                ! Model values equivalent to surface ob.
+      REAL(wp), POINTER, DIMENSION(:,:) :: &
+         & zglam1,    &            ! Model longitudes for prof variable 1
+         & zglam2,    &            ! Model longitudes for prof variable 2
+         & zgphi1,    &            ! Model latitudes for prof variable 1
+         & zgphi2                  ! Model latitudes for prof variable 2
+#if ! defined key_lim2 && ! defined key_lim3
+      REAL(wp), POINTER, DIMENSION(:,:) :: frld
+#endif
+      LOGICAL :: llnightav        ! Logical for calculating night-time average
+
+      !Allocate local work arrays
+      CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 )
+      CALL wrk_alloc( jpi, jpj, zsurfvar )
+      CALL wrk_alloc( jpi, jpj, zglam1 )
+      CALL wrk_alloc( jpi, jpj, zglam2 )
+      CALL wrk_alloc( jpi, jpj, zgphi1 )
+      CALL wrk_alloc( jpi, jpj, zgphi2 )
+#if ! defined key_lim2 && ! defined key_lim3
+      CALL wrk_alloc(jpi,jpj,frld) 
+#endif
+
+      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_lim2 && ! defined key_lim3
+      frld(:,:) = 0.0_wp
+#endif
+      !-----------------------------------------------------------------------
+      ! Call the profile and surface observation operators
+      !-----------------------------------------------------------------------
+
+      IF ( nproftypes > 0 ) THEN
+
+         DO jtype = 1, nproftypes
+
+            SELECT CASE ( TRIM(cobstypesprof(jtype)) )
+            CASE('prof')
+               zprofvar1(:,:,:) = tsn(:,:,:,jp_tem)
+               zprofvar2(:,:,:) = tsn(:,:,:,jp_sal)
+               zprofmask1(:,:,:) = tmask(:,:,:)
+               zprofmask2(:,:,:) = tmask(:,:,:)
+               zglam1(:,:) = glamt(:,:)
+               zglam2(:,:) = glamt(:,:)
+               zgphi1(:,:) = gphit(:,:)
+               zgphi2(:,:) = gphit(:,:)
+            CASE('vel')
+               zprofvar1(:,:,:) = un(:,:,:)
+               zprofvar2(:,:,:) = vn(:,:,:)
+               zprofmask1(:,:,:) = umask(:,:,:)
+               zprofmask2(:,:,:) = vmask(:,:,:)
+               zglam1(:,:) = glamu(:,:)
+               zglam2(:,:) = glamv(:,:)
+               zgphi1(:,:) = gphiu(:,:)
+               zgphi2(:,:) = gphiv(:,:)
+            END SELECT
+
+            IF( ln_zco .OR. ln_zps ) THEN 
+               CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  &
+                  &               nit000, idaystp,                         &
+                  &               zprofvar1, zprofvar2,                    &
+                  &               gdept_1d, zprofmask1, zprofmask2,        &
+                  &               zglam1, zglam2, zgphi1, zgphi2,          &
+                  &               nn_1dint, nn_2dint,                      &
+                  &               kdailyavtypes = nn_profdavtypes )
+            ELSE IF(TRIM(cobstypesprof(jtype)) == 'prof') THEN
+               !TG - THIS NEEDS MODIFICATION TO MATCH SIMPLIFICATION
+               CALL obs_pro_sco_opt( profdataqc(jtype),                    & 
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
+                  &              zprofvar1, zprofvar2,                   & 
+                  &              gdept_n(:,:,:), gdepw_n(:,:,:),           &
+                  &              tmask, nn_1dint, nn_2dint,              & 
+                  &              kdailyavtypes = nn_profdavtypes ) 
+            ELSE
+               CALL ctl_stop('DIA_OBS: Generalised vertical interpolation not'// &
+                         'yet working for velocity data (turn off velocity observations')
+            ENDIF
+
+         END DO
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         DO jtype = 1, nsurftypes
+
+            SELECT CASE ( TRIM(cobstypessurf(jtype)) )
+            CASE('sst')
+               zsurfvar(:,:) = tsn(:,:,1,jp_tem)
+               llnightav = ln_sstnight
+            CASE('sla')
+               zsurfvar(:,:) = sshn(:,:)
+               llnightav = .FALSE.
+#if defined key_lim2 || defined key_lim3
+            CASE('sic')
+               IF ( kstp == 0 ) THEN
+                  IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN
+                     CALL ctl_warn( 'Sea-ice not initialised on zeroth '// &
+                        &           'time-step but some obs are valid then.' )
+                     WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), &
+                        &           ' sea-ice obs will be missed'
+                  ENDIF
+                  surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + &
+                     &                        surfdataqc(jtype)%nsstp(1)
+                  CYCLE
+               ELSE
+                  zsurfvar(:,:) = 1._wp - frld(:,:)
+               ENDIF
+
+               llnightav = .FALSE.
+#endif
+            END SELECT
+
+            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       &
+               &               nit000, idaystp, zsurfvar, tmask(:,:,1), &
+               &               nn_2dint, llnightav )
+
+         END DO
+
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 )
+      CALL wrk_dealloc( jpi, jpj, zsurfvar )
+      CALL wrk_dealloc( jpi, jpj, zglam1 )
+      CALL wrk_dealloc( jpi, jpj, zglam2 )
+      CALL wrk_dealloc( jpi, jpj, zgphi1 )
+      CALL wrk_dealloc( jpi, jpj, zgphi2 )
+#if ! defined key_lim2 && ! defined key_lim3
+      CALL wrk_dealloc(jpi,jpj,frld)
+#endif
+
+   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
+      !!        !  15-08  (M. Martin) Combined writing for prof and surf types
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE obs_rot_vel          ! Rotation of velocities
+
+      IMPLICIT NONE
+
+      !! * Local declarations
+      INTEGER :: jtype                    ! Data set loop variable
+      INTEGER :: jo, jvar, jk
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zu, &
+         & zv
+
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation output routines
+      !-----------------------------------------------------------------------
+
+      IF ( nproftypes > 0 ) THEN
+
+         DO jtype = 1, nproftypes
+
+            IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN
+
+               ! For velocity data, rotate the model velocities to N/S, E/W
+               ! using the compressed data structure.
+               ALLOCATE( &
+                  & zu(profdataqc(jtype)%nvprot(1)), &
+                  & zv(profdataqc(jtype)%nvprot(2))  &
+                  & )
+
+               CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv )
+
+               DO jo = 1, profdataqc(jtype)%nprof
+                  DO jvar = 1, 2
+                     DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar)
+
+                        IF ( jvar == 1 ) THEN
+                           profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk)
+                        ELSE
+                           profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk)
+                        ENDIF
+
+                     END DO
+                  END DO
+               END DO
+
+               DEALLOCATE( zu )
+               DEALLOCATE( zv )
+
+            END IF
+
+            CALL obs_prof_decompress( profdataqc(jtype), &
+               &                      profdata(jtype), .TRUE., numout )
+
+            CALL obs_wri_prof( profdata(jtype) )
+
+         END DO
+
+      ENDIF
+
+      IF ( nsurftypes > 0 ) THEN
+
+         DO jtype = 1, nsurftypes
+
+            CALL obs_surf_decompress( surfdataqc(jtype), &
+               &                      surfdata(jtype), .TRUE., numout )
+
+            CALL obs_wri_surf( surfdata(jtype) )
+
+         END DO
+
+      ENDIF
+
+   END SUBROUTINE dia_obs_wri
+
+   SUBROUTINE dia_obs_dealloc
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    *** ROUTINE dia_obs_dealloc ***
+      !!
+      !!  ** Purpose : To deallocate data to enable the obs_oper online loop.
+      !!               Specifically: dia_obs_init --> dia_obs --> dia_obs_wri
+      !!
+      !!  ** Method : Clean up various arrays left behind by the obs_oper.
+      !!
+      !!  ** Action :
+      !!
+      !!----------------------------------------------------------------------
+      ! obs_grid deallocation
+      CALL obs_grid_deallocate
+
+      ! diaobs deallocation
+      IF ( nproftypes > 0 ) &
+         &   DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof )
+
+      IF ( nsurftypes > 0 ) &
+         &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf )
+
+   END SUBROUTINE dia_obs_dealloc
+
+   SUBROUTINE calc_date( kstp, ddobs )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_date  ***
+      !!          
+      !! ** Purpose : Get date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get initial date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! History :
+      !!        !  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
+      !!        !  2014-09  (D. Lea) New generic routine now deals with arbitrary initial time of day
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobs                        ! Date in YYYYMMDD.HHMMSS
+      INTEGER :: kstp
+
+      !! * 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(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)
+      !!----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou =   nn_time0 / 100
+      imin = ( nn_time0 - ihou * 100 ) 
+
+      !!----------------------------------------------------------------------
+      !! Compute number of days + number of hours + min since initial time
+      !!----------------------------------------------------------------------
+      zdayfrc = kstp * rdt / rday
+      zdayfrc = zdayfrc - aint(zdayfrc)
+      imin = imin + int( zdayfrc * 24 * 60 ) 
+      DO WHILE (imin >= 60) 
+        imin=imin-60
+        ihou=ihou+1
+      END DO
+      DO WHILE (ihou >= 24)
+        ihou=ihou-24
+        iday=iday+1
+      END DO 
+      iday = iday + kstp * rdt / rday 
+
+      !-----------------------------------------------------------------------
+      ! Convert number of days (iday) into a real date
+      !----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         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.
+      !----------------------------------------------------------------------
+      ddobs = iyea * 10000_dp + imon * 100_dp + &
+         &    iday + ihou * 0.01_dp + imin * 0.0001_dp
+
+   END SUBROUTINE calc_date
+
+   SUBROUTINE ini_date( ddobsini )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ini_date  ***
+      !!          
+      !! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsini                   ! Initial date in YYYYMMDD.HHMMSS
+
+      CALL calc_date( nit000 - 1, ddobsini )
+
+   END SUBROUTINE ini_date
+
+   SUBROUTINE fin_date( ddobsfin )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE fin_date  ***
+      !!          
+      !! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
+
+      CALL calc_date( nitend, ddobsfin )
+
+   END SUBROUTINE fin_date
+   
+END MODULE diaobs
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90	(revision 8732)
@@ -0,0 +1,115 @@
+   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
+      !!      ! 2014-09 (D. Lea) Change to use FLOOR to deal with negative prelday
+      !!-----------------------------------------------------------------------
+
+      ! * 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 = FLOOR( 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90	(revision 8732)
@@ -0,0 +1,33 @@
+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
+   USE lib_mpp,  ONLY : &
+      & ctl_warn, ctl_stop
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC jul2greg,        &  ! Convert relative time to date
+      &   greg2jul            ! Convert date to relative time 
+  
+   !! $Id$
+CONTAINS
+ 
+#include "jul2greg.h90"
+
+#include "greg2jul.h90"
+   
+END MODULE julian
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 8732)
@@ -0,0 +1,85 @@
+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
+      !!----------------------------------------------------------------------
+
+      IF (.NOT. ALLOCATED(mppmap)) THEN
+         ALLOCATE( &
+            & mppmap(jpiglo,jpjglo) &
+            & )
+      ENDIF
+      ! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 8732)
@@ -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 Celsius
+      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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 8732)
@@ -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, 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 8732)
@@ -0,0 +1,1182 @@
+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   
+   USE lib_mpp, ONLY :   &
+      & ctl_warn, ctl_stop
+
+   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 :: rn_gridsearchres = 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 :: &
+      & cn_gridsearchfile    ! 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 (.NOT. llfourflag) THEN
+            IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found
+         ENDIF
+         
+         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, 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 : ', rn_gridsearchres
+         
+         gsearch_nlons_def  = NINT( 360.0_wp / rn_gridsearchres ) 
+         gsearch_nlats_def  = NINT( 180.0_wp / rn_gridsearchres )
+         gsearch_lonmin_def = -180.0_wp + 0.5_wp * rn_gridsearchres
+         gsearch_latmin_def =  -90.0_wp + 0.5_wp * rn_gridsearchres
+         gsearch_dlon_def   = rn_gridsearchres
+         gsearch_dlat_def   = rn_gridsearchres
+         
+         IF (lwp) THEN
+            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(cn_gridsearchfile), 'global.nc'
+         ELSE
+            WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
+               &          TRIM(cn_gridsearchfile), 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 < limydiff ) 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 < limydiff ) 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 8732)
@@ -0,0 +1,58 @@
+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
+      USE lib_mpp,ONLY : &
+      & ctl_warn, ctl_stop
+
+   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 8732)
@@ -0,0 +1,393 @@
+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 wrk_nemo        ! Memory Allocation
+   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, kpi, kpj, 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) :: kpi       ! Number of points in i direction
+      INTEGER, INTENT(IN) :: kpj       ! Number of points in j direction
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & 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(kpi,kpj,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, kpi, kpj, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval, kproc=kproc )
+
+         ELSE
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval )
+
+         ENDIF
+
+      ELSE
+
+         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, &
+            &                        pval, pgval )
+
+      ENDIF
+
+   END SUBROUTINE obs_int_comm_3d
+
+   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kpi, kpj, 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, INTENT(IN) :: kpi          ! Number of model grid points in i direction
+      INTEGER, INTENT(IN) :: kpj          ! Number of model grid points in j direction
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) ::&
+         & pval             ! Local 3D array to extra data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) ::   zval
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::&
+         & zgval 
+
+      ! Check workspace array and set-up pointer
+      CALL wrk_alloc(jpi,jpj,1,zval) 
+
+      ! Set up local "3D" buffer
+
+      zval(:,:,1) = pval(:,:)
+
+      ! Call the 3D version
+
+      IF (PRESENT(kproc)) THEN
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, &
+            &                  zgval, kproc=kproc )
+      ELSE
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, &
+            &                  zgval )
+
+      ENDIF
+
+      ! Copy "3D" data back to 2D
+
+      pgval(:,:,:) = zgval(:,:,1,:)
+
+      ! 'Release' workspace array back to pool
+      CALL wrk_dealloc(jpi,jpj,1,zval) 
+
+   END SUBROUTINE obs_int_comm_2d
+
+   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, 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) :: kpi       ! Number of model points in i direction
+      INTEGER, INTENT(IN) :: kpj       ! Number of model points in j direction
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & 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, kpi, kpj, 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) :: kpi          ! Number of model points in i direction
+      INTEGER, INTENT(IN) :: kpj          ! Number of model points in j direction
+      INTEGER, INTENT(IN) :: kpk          ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      REAL(KIND=wp), DIMENSION(kpi,kpj,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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 8732)
@@ -0,0 +1,445 @@
+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
+   !!            3.6  ! 2015-01  (J. Waters) obs_mpp_find_obs_proc 
+   !!                            rewritten to avoid global arrays
+   !!----------------------------------------------------------------------
+#  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, avoiding global arrays
+   !! 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,kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_find_obs_proc  ***
+      !!         
+      !! ** Purpose : From the array kobsp containing the results of the
+      !!              grid search on each processor the processor return a
+      !!              decision of which processors should hold the observation.
+      !!
+      !! ** Method  : Synchronize the processor number for each obs using
+      !!              obs_mpp_max_integer. If an observation exists on two 
+      !!              processors it will be allocated to the lower numbered
+      !!              processor.
+      !!
+      !! ** Action  : This does only work for MPI.
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp
+      !
+#if defined key_mpp_mpi
+      !
+      !
+      INTEGER :: ji, isum
+      INTEGER, DIMENSION(kno) ::   iobsp
+      !!
+      !!
+
+      iobsp=kobsp
+
+      WHERE( iobsp(:) == -1 )
+         iobsp(:) = 9999999
+      END WHERE
+
+      iobsp=-1*iobsp
+
+      CALL obs_mpp_max_integer( iobsp, kno )
+
+      kobsp=-1*iobsp
+
+      isum=0
+      DO ji = 1, kno
+         IF ( kobsp(ji) == 9999999 ) THEN
+            isum=isum+1
+            kobsp(ji)=-1
+         ENDIF
+      ENDDO
+
+
+      IF ( isum > 0 ) THEN
+         IF (lwp) WRITE(numout,*) isum, ' observations failed the grid search.'
+         IF (lwp) WRITE(numout,*)'If ln_grid_search_lookup=.TRUE., try reducing grid_search_res'
+      ENDIF
+
+#else
+      ! no MPI: empty routine
+#endif     
+      
+   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 8732)
@@ -0,0 +1,1338 @@
+MODULE obs_oper
+   !!======================================================================
+   !!                       ***  MODULE obs_oper  ***
+   !! Observation diagnostics: Observation operators for various observation
+   !!                          types
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_prof_opt :    Compute the model counterpart of profile data
+   !!   obs_surf_opt :    Compute the model counterpart of surface data
+   !!   obs_pro_sco_opt: Compute the model counterpart of temperature and 
+   !!                    salinity observations from profiles in generalised 
+   !!                    vertical coordinates 
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   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 obs pt
+      & obs_int_h2d, &
+      & obs_int_h2d_init
+   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the obs pt
+      & obs_int_z1d,    &
+      & obs_int_z1d_spl
+   USE obs_const,  ONLY :     &
+      & obfillflt		  ! Fillvalue   
+   USE dom_oce,       ONLY : &
+      & glamt, glamu, glamv, &
+      & gphit, gphiu, gphiv, & 
+      & gdept_n, gdept_0 
+   USE lib_mpp,       ONLY : &
+      & ctl_warn, ctl_stop
+   USE obs_grid,      ONLY : & 
+      & obs_level_search     
+   USE sbcdcy,        ONLY : &    ! For calculation of where it is night-time
+      & sbc_dcy, nday_qsr
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile obs
+      &   obs_pro_sco_opt, &  ! Compute the model counterpart of profile observations 
+      &   obs_surf_opt     ! Compute the model counterpart of surface obs
+
+   INTEGER, PARAMETER, PUBLIC :: &
+      & imaxavtypes = 20   ! Max number of daily avgd obs types
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          &
+      &                     kit000, kdaystp,                      &
+      &                     pvar1, pvar2, pgdept, pmask1, pmask2, &
+      &                     plam1, plam2, pphi1, pphi2,           &
+      &                     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 values 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 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.
+      !!
+      !!    If the logical is switched on, the model equivalent is
+      !!    a daily mean model temperature field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !!    Note: in situ temperature observations must be converted
+      !!    to potential temperature (the model variable) prior to
+      !!    assimilation. 
+      !!
+      !! ** 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
+      !!      ! 15-02 (M. Martin) Combined routine for all profile types
+      !!-----------------------------------------------------------------------
+
+      !! * 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 passing QC
+      INTEGER, INTENT(IN) :: kt      ! Time step
+      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+      INTEGER, INTENT(IN) :: kit000  ! Number of the first time step
+                                     !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint  ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & pvar1,    &               ! Model field 1
+         & pvar2,    &               ! Model field 2
+         & pmask1,   &               ! Land-sea mask 1
+         & pmask2                    ! Land-sea mask 2
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & plam1,    &               ! Model longitudes for variable 1
+         & plam2,    &               ! Model longitudes for variable 2
+         & pphi1,    &               ! Model latitudes for variable 1
+         & pphi2                     ! Model latitudes for variable 2
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept                    ! Model array of depth levels
+      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
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi1, &
+         & igrdi2, &
+         & igrdj1, &
+         & igrdj2
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmask1, &
+         & zobsmask2, &
+         & zobsk,    &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweig1, &
+         & zweig2
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zmask1, &
+         & zmask2, &
+         & zint1, &
+         & zint2, &
+         & zinm1, &
+         & zinm2
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglam1, &
+         & zglam2, &
+         & zgphi1, &
+         & zgphi2
+      LOGICAL :: ld_dailyav
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+
+      ! Daily average types
+      ld_dailyav = .FALSE.
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+         IF ( ANY (idailyavtypes(:) /= -1) ) ld_dailyav = .TRUE.
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      ! Daily means are calculated for values over timesteps:
+      !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ...
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      IF ( ld_dailyav ) THEN
+
+         ! Initialize daily mean for first timestep of the day
+         IF ( idayend == 1 .OR. kt == 0 ) THEN
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     prodatqc%vdmean(ji,jj,jk,1) = 0.0
+                     prodatqc%vdmean(ji,jj,jk,2) = 0.0
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! Increment field 1 for computing daily mean
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                     &                        + pvar1(ji,jj,jk)
+                  ! Increment field 2 for computing daily mean
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                     &                        + pvar2(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! Compute the daily mean at the end of day
+         zdaystp = 1.0 / REAL( kdaystp )
+         IF ( idayend == 0 ) THEN
+            IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt
+            CALL FLUSH(numout)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                        &                        * zdaystp
+                     prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                        &                        * zdaystp
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdi1(2,2,ipro),      &
+         & igrdi2(2,2,ipro),      &
+         & igrdj1(2,2,ipro),      &
+         & igrdj2(2,2,ipro),      &
+         & zglam1(2,2,ipro),      &
+         & zglam2(2,2,ipro),      &
+         & zgphi1(2,2,ipro),      &
+         & zgphi2(2,2,ipro),      &
+         & zmask1(2,2,kpk,ipro),  &
+         & zmask2(2,2,kpk,ipro),  &
+         & zint1(2,2,kpk,ipro),  &
+         & zint2(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdi1(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj1(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi1(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj1(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi1(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdj1(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi1(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdj1(2,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi2(1,1,iobs) = prodatqc%mi(jobs,2)-1
+         igrdj2(1,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdi2(1,2,iobs) = prodatqc%mi(jobs,2)-1
+         igrdj2(1,2,iobs) = prodatqc%mj(jobs,2)
+         igrdi2(2,1,iobs) = prodatqc%mi(jobs,2)
+         igrdj2(2,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdi2(2,2,iobs) = prodatqc%mi(jobs,2)
+         igrdj2(2,2,iobs) = prodatqc%mj(jobs,2)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 )
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 )
+      
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 )
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 )
+
+      ! At the end of the day also get interpolated means
+      IF ( ld_dailyav .AND. idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinm1(2,2,kpk,ipro),  &
+            & zinm2(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, &
+            &                  prodatqc%vdmean(:,:,:,1), zinm1 )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, &
+            &                  prodatqc%vdmean(:,:,:,2), zinm2 )
+
+      ENDIF
+
+      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,     &
+               &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), &
+               &                   zmask1(:,:,:,iobs), zweig1, zobsmask1 )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), &
+               &                   zmask2(:,:,:,iobs), zweig2, zobsmask2 )
+ 
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  ! Daily averaged data
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig1, zinm1(:,:,:,iobs), zobsk )
+
+               ENDIF
+
+            ELSE 
+
+               ! Point data
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig1, zint1(:,:,:,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, zobsmask1 )
+            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, zobsmask1 )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged data
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig2, zinm2(:,:,:,iobs), zobsk )
+
+               ENDIF
+
+            ELSE
+
+               ! Point data
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig2, zint2(:,:,:,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, zobsmask2 )
+            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, zobsmask2 )
+
+         ENDIF
+
+      END DO
+
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi1, &
+         & igrdi2, &
+         & igrdj1, &
+         & igrdj2, &
+         & zglam1, &
+         & zglam2, &
+         & zgphi1, &
+         & zgphi2, &
+         & zmask1, &
+         & zmask2, &
+         & zint1,  &
+         & zint2   &
+         & )
+
+      ! At the end of the day also get interpolated means
+      IF ( ld_dailyav .AND. idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinm1,  &
+            & zinm2   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+
+   END SUBROUTINE obs_prof_opt
+
+   SUBROUTINE obs_pro_sco_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, & 
+      &                    ptn, psn, pgdept, pgdepw, ptmask, k1dint, k2dint, & 
+      &                    kdailyavtypes ) 
+      !!----------------------------------------------------------------------- 
+      !! 
+      !!                     ***  ROUTINE obs_pro_opt  *** 
+      !! 
+      !! ** Purpose : Compute the model counterpart of profiles 
+      !!              data by interpolating from the model grid to the  
+      !!              observation point. Generalised vertical coordinate version 
+      !! 
+      !! ** Method  : Linearly interpolate to each observation point using  
+      !!              the model values at the corners of the surrounding grid box. 
+      !! 
+      !!          First, model values on the model grid are interpolated vertically to the 
+      !!          Depths of the profile observations.  Two vertical interpolation schemes are 
+      !!          available: 
+      !!          - linear       (k1dint = 0) 
+      !!          - Cubic spline (k1dint = 1)    
+      !! 
+      !! 
+      !!         Secondly the interpolated values are interpolated horizontally to the  
+      !!         obs (lon, lat) point. 
+      !!         Several horizontal interpolation schemes are available: 
+      !!        - distance-weighted (great circle) (k2dint = 0) 
+      !!        - distance-weighted (small angle)  (k2dint = 1) 
+      !!        - bilinear (geographical grid)     (k2dint = 2) 
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
+      !! 
+      !!    For the cubic spline the 2nd derivative of the interpolating  
+      !!    polynomial is computed before entering the vertical interpolation  
+      !!    routine. 
+      !! 
+      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is 
+      !!    a daily mean model temperature field. So, we first compute 
+      !!    the mean, then interpolate only at the end of the day. 
+      !! 
+      !!    This is the procedure to be used with generalised vertical model  
+      !!    coordinates (ie s-coordinates. It is ~4x slower than the equivalent 
+      !!    horizontal then vertical interpolation algorithm, but can deal with situations 
+      !!    where the model levels are not flat. 
+      !!    ONLY PERFORMED if ln_sco=.TRUE.  
+      !!       
+      !!    Note: the in situ temperature observations must be converted 
+      !!    to potential temperature (the model variable) prior to 
+      !!    assimilation.  
+      !!?????????????????????????????????????????????????????????????? 
+      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR??? 
+      !!?????????????????????????????????????????????????????????????? 
+      !! 
+      !! ** Action  : 
+      !! 
+      !! History : 
+      !!      ! 2014-08 (J. While) Adapted from obs_pro_opt to handel generalised 
+      !!                           vertical coordinates
+      !!----------------------------------------------------------------------- 
+   
+      !! * Modules used 
+      USE obs_profiles_def   ! Definition of storage space for profile obs. 
+       
+      IMPLICIT NONE 
+ 
+      !! * Arguments 
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
+      INTEGER, INTENT(IN) :: kt        ! Time step 
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
+      INTEGER, INTENT(IN) :: kpj 
+      INTEGER, INTENT(IN) :: kpk 
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
+                                       !   (kit000-1 = restart time) 
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
+         & ptn,    &    ! Model temperature field 
+         & psn,    &    ! Model salinity field 
+         & ptmask       ! Land-sea mask 
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
+         & pgdept,  &    ! Model array of depth T levels    
+         & pgdepw       ! Model array of depth W levels 
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
+         & kdailyavtypes   ! Types for daily averages 
+      
+      !! * Local declarations 
+      INTEGER ::   ji 
+      INTEGER ::   jj 
+      INTEGER ::   jk 
+      INTEGER ::   iico, ijco 
+      INTEGER ::   jobs 
+      INTEGER ::   inrc 
+      INTEGER ::   ipro 
+      INTEGER ::   idayend 
+      INTEGER ::   ista 
+      INTEGER ::   iend 
+      INTEGER ::   iobs 
+      INTEGER ::   iin, ijn, ikn, ik   ! looping indices over interpolation nodes 
+      INTEGER, DIMENSION(imaxavtypes) :: & 
+         & idailyavtypes 
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
+         & igrdi, & 
+         & igrdj 
+      INTEGER :: & 
+         & inum_obs
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic    
+      REAL(KIND=wp) :: zlam 
+      REAL(KIND=wp) :: zphi 
+      REAL(KIND=wp) :: zdaystp 
+      REAL(KIND=wp), DIMENSION(kpk) :: & 
+         & zobsmask, & 
+         & zobsk,    & 
+         & zobs2k 
+      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
+         & zweig, & 
+         & l_zweig 
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
+         & zmask, & 
+         & zintt, & 
+         & zints, & 
+         & zinmt, & 
+         & zgdept,& 
+         & zgdepw,& 
+         & zinms 
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
+         & zglam, & 
+         & zgphi    
+      REAL(KIND=wp), DIMENSION(1) :: zmsk_1       
+      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner       
+ 
+      !------------------------------------------------------------------------ 
+      ! Local initialization  
+      !------------------------------------------------------------------------ 
+      ! ... Record and data counters 
+      inrc = kt - kit000 + 2 
+      ipro = prodatqc%npstp(inrc) 
+  
+      ! Daily average types 
+      IF ( PRESENT(kdailyavtypes) ) THEN 
+         idailyavtypes(:) = kdailyavtypes(:) 
+      ELSE 
+         idailyavtypes(:) = -1 
+      ENDIF 
+ 
+      ! Initialize daily mean for first time-step 
+      idayend = MOD( kt - kit000 + 1, kdaystp ) 
+ 
+      ! Added kt == 0 test to catch restart case  
+      IF ( idayend == 1 .OR. kt == 0) THEN 
+          
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt 
+         DO jk = 1, jpk 
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  prodatqc%vdmean(ji,jj,jk,1) = 0.0 
+                  prodatqc%vdmean(ji,jj,jk,2) = 0.0 
+               END DO 
+            END DO 
+         END DO 
+       
+      ENDIF 
+       
+      DO jk = 1, jpk 
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               ! Increment the temperature field for computing daily mean 
+               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
+               &                        + ptn(ji,jj,jk) 
+               ! Increment the salinity field for computing daily mean 
+               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
+               &                        + psn(ji,jj,jk) 
+            END DO 
+         END DO 
+      END DO 
+    
+      ! Compute the daily mean at the end of day 
+      zdaystp = 1.0 / REAL( kdaystp ) 
+      IF ( idayend == 0 ) THEN 
+         DO jk = 1, jpk 
+            DO jj = 1, jpj 
+               DO ji = 1, jpi 
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
+                  &                        * zdaystp 
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
+                  &                           * zdaystp 
+               END DO 
+            END DO 
+         END DO 
+      ENDIF 
+ 
+      ! Get the data for interpolation 
+      ALLOCATE( & 
+         & igrdi(2,2,ipro),      & 
+         & igrdj(2,2,ipro),      & 
+         & zglam(2,2,ipro),      & 
+         & zgphi(2,2,ipro),      & 
+         & zmask(2,2,kpk,ipro),  & 
+         & zintt(2,2,kpk,ipro),  & 
+         & zints(2,2,kpk,ipro),  & 
+         & zgdept(2,2,kpk,ipro), & 
+         & zgdepw(2,2,kpk,ipro)  & 
+         & ) 
+ 
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
+         iobs = jobs - prodatqc%nprofup 
+         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1 
+         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1 
+         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1 
+         igrdj(1,2,iobs) = prodatqc%mj(jobs,1) 
+         igrdi(2,1,iobs) = prodatqc%mi(jobs,1) 
+         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1 
+         igrdi(2,2,iobs) = prodatqc%mi(jobs,1) 
+         igrdj(2,2,iobs) = prodatqc%mj(jobs,1) 
+      END DO 
+     
+      ! Initialise depth arrays
+      zgdept = 0.0
+      zgdepw = 0.0
+ 
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, glamt, zglam ) 
+      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, gphit, zgphi ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, ptmask,zmask ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, ptn,   zintt ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, psn,   zints ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdept(:,:,:), & 
+        &                     zgdept ) 
+      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw(:,:,:), & 
+        &                     zgdepw ) 
+ 
+      ! At the end of the day also get interpolated means 
+      IF ( idayend == 0 ) THEN 
+ 
+         ALLOCATE( & 
+            & zinmt(2,2,kpk,ipro),  & 
+            & zinms(2,2,kpk,ipro)   & 
+            & ) 
+ 
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
+            &                  prodatqc%vdmean(:,:,:,1), zinmt ) 
+         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
+            &                  prodatqc%vdmean(:,:,:,2), zinms ) 
+ 
+      ENDIF 
+       
+      ! Return if no observations to process 
+      ! Has to be done after comm commands to ensure processors 
+      ! stay in sync 
+      IF ( ipro == 0 ) RETURN 
+ 
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
+    
+         iobs = jobs - prodatqc%nprofup 
+    
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN 
+             
+            IF(lwp) THEN 
+               WRITE(numout,*) 
+               WRITE(numout,*) ' E R R O R : Observation',              & 
+                  &            ' time step is not consistent with the', & 
+                  &            ' model time step' 
+               WRITE(numout,*) ' =========' 
+               WRITE(numout,*) 
+               WRITE(numout,*) ' Record  = ', jobs,                    & 
+                  &            ' kt      = ', kt,                      & 
+                  &            ' mstp    = ', prodatqc%mstp(jobs), & 
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs) 
+            ENDIF 
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' ) 
+         ENDIF 
+          
+         zlam = prodatqc%rlam(jobs) 
+         zphi = prodatqc%rphi(jobs) 
+          
+         ! Horizontal weights 
+         ! Only calculated once, for both T and S. 
+         ! Masked values are calculated later.  
+ 
+         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. & 
+            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN 
+ 
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
+               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
+               &                   zmask(:,:,1,iobs), zweig, zmsk_1 ) 
+ 
+         ENDIF 
+         
+         ! IF zmsk_1 = 0; then ob is on land 
+         IF (zmsk_1(1) < 0.1) THEN 
+            WRITE(numout,*) 'WARNING (obs_oper) :- profile found within landmask' 
+   
+         ELSE  
+             
+            ! Temperature 
+             
+            IF ( prodatqc%npvend(jobs,1) > 0 ) THEN  
+    
+               zobsk(:) = obfillflt 
+    
+               IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
+    
+                  IF ( idayend == 0 )  THEN 
+                   
+                     ! Daily averaged moored buoy (MRB) data 
+                   
+                     ! vertically interpolate all 4 corners 
+                     ista = prodatqc%npvsta(jobs,1) 
+                     iend = prodatqc%npvend(jobs,1) 
+                     inum_obs = iend - ista + 1 
+                     ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 
+      
+                     DO iin=1,2 
+                        DO ijn=1,2 
+                                       
+                                       
+           
+                           IF ( k1dint == 1 ) THEN 
+                              CALL obs_int_z1d_spl( kpk, & 
+                                 &     zinmt(iin,ijn,:,iobs), & 
+                                 &     zobs2k, zgdept(iin,ijn,:,iobs), & 
+                                 &     zmask(iin,ijn,:,iobs)) 
+                           ENDIF 
+       
+                           CALL obs_level_search(kpk, & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    inum_obs, prodatqc%var(1)%vdep(ista:iend), & 
+                              &    iv_indic) 
+                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 
+                              &    prodatqc%var(1)%vdep(ista:iend), & 
+                              &    zinmt(iin,ijn,:,iobs), & 
+                              &    zobs2k, interp_corner(iin,ijn,:), & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+       
+                        ENDDO 
+                     ENDDO 
+                   
+                   
+                  ELSE 
+                
+                     CALL ctl_stop( ' A nonzero' //     & 
+                        &           ' number of profile T BUOY data should' // & 
+                        &           ' only occur at the end of a given day' ) 
+    
+                  ENDIF 
+         
+               ELSE  
+                
+                  ! Point data 
+     
+                  ! vertically interpolate all 4 corners 
+                  ista = prodatqc%npvsta(jobs,1) 
+                  iend = prodatqc%npvend(jobs,1) 
+                  inum_obs = iend - ista + 1 
+                  ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) 
+                  DO iin=1,2  
+                     DO ijn=1,2 
+                                    
+                                    
+                        IF ( k1dint == 1 ) THEN 
+                           CALL obs_int_z1d_spl( kpk, & 
+                              &    zintt(iin,ijn,:,iobs),& 
+                              &    zobs2k, zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+  
+                        ENDIF 
+       
+                        CALL obs_level_search(kpk, & 
+                            &        zgdept(iin,ijn,:,iobs),& 
+                            &        inum_obs, prodatqc%var(1)%vdep(ista:iend), & 
+                            &         iv_indic) 
+                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     & 
+                            &          prodatqc%var(1)%vdep(ista:iend),     & 
+                            &          zintt(iin,ijn,:,iobs),            & 
+                            &          zobs2k,interp_corner(iin,ijn,:), & 
+                            &          zgdept(iin,ijn,:,iobs),         & 
+                            &          zmask(iin,ijn,:,iobs) )      
+         
+                     ENDDO 
+                  ENDDO 
+             
+               ENDIF 
+       
+               !------------------------------------------------------------- 
+               ! Compute the horizontal interpolation for every profile level 
+               !------------------------------------------------------------- 
+             
+               DO ikn=1,inum_obs 
+                  iend=ista+ikn-1 
+
+                  l_zweig(:,:,1) = 0._wp 
+
+                  ! This code forces the horizontal weights to be  
+                  ! zero IF the observation is below the bottom of the  
+                  ! corners of the interpolation nodes, Or if it is in  
+                  ! the mask. This is important for observations are near  
+                  ! steep bathymetry 
+                  DO iin=1,2 
+                     DO ijn=1,2 
+     
+                        depth_loop1: DO ik=kpk,2,-1 
+                           IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN   
+                            
+                              l_zweig(iin,ijn,1) = &  
+                                 & zweig(iin,ijn,1) * & 
+                                 & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) & 
+                                 &  - prodatqc%var(1)%vdep(iend)),0._wp) 
+                            
+                              EXIT depth_loop1 
+                           ENDIF 
+                        ENDDO depth_loop1 
+     
+                     ENDDO 
+                  ENDDO 
+   
+                  CALL obs_int_h2d( 1, 1, l_zweig, interp_corner(:,:,ikn), & 
+                  &          prodatqc%var(1)%vmod(iend:iend) ) 
+ 
+               ENDDO 
+ 
+ 
+               DEALLOCATE(interp_corner,iv_indic) 
+          
+            ENDIF 
+       
+ 
+            ! Salinity  
+          
+            IF ( prodatqc%npvend(jobs,2) > 0 ) THEN  
+    
+               zobsk(:) = obfillflt 
+    
+               IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
+    
+                  IF ( idayend == 0 )  THEN 
+                   
+                     ! Daily averaged moored buoy (MRB) data 
+                   
+                     ! vertically interpolate all 4 corners 
+                     ista = prodatqc%npvsta(iobs,2) 
+                     iend = prodatqc%npvend(iobs,2) 
+                     inum_obs = iend - ista + 1 
+                     ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 
+      
+                     DO iin=1,2 
+                        DO ijn=1,2 
+                                       
+                                       
+           
+                           IF ( k1dint == 1 ) THEN 
+                              CALL obs_int_z1d_spl( kpk, & 
+                                 &     zinms(iin,ijn,:,iobs), & 
+                                 &     zobs2k, zgdept(iin,ijn,:,iobs), & 
+                                 &     zmask(iin,ijn,:,iobs)) 
+                           ENDIF 
+       
+                           CALL obs_level_search(kpk, & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    inum_obs, prodatqc%var(2)%vdep(ista:iend), & 
+                              &    iv_indic) 
+                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 
+                              &    prodatqc%var(2)%vdep(ista:iend), & 
+                              &    zinms(iin,ijn,:,iobs), & 
+                              &    zobs2k, interp_corner(iin,ijn,:), & 
+                              &    zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+       
+                        ENDDO 
+                     ENDDO 
+                   
+                   
+                  ELSE 
+                
+                     CALL ctl_stop( ' A nonzero' //     & 
+                        &           ' number of profile T BUOY data should' // & 
+                        &           ' only occur at the end of a given day' ) 
+    
+                  ENDIF 
+         
+               ELSE  
+                
+                  ! Point data 
+     
+                  ! vertically interpolate all 4 corners 
+                  ista = prodatqc%npvsta(jobs,2) 
+                  iend = prodatqc%npvend(jobs,2) 
+                  inum_obs = iend - ista + 1 
+                  ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) 
+                   
+                  DO iin=1,2     
+                     DO ijn=1,2  
+                                 
+                                 
+                        IF ( k1dint == 1 ) THEN 
+                           CALL obs_int_z1d_spl( kpk, & 
+                              &    zints(iin,ijn,:,iobs),& 
+                              &    zobs2k, zgdept(iin,ijn,:,iobs), & 
+                              &    zmask(iin,ijn,:,iobs)) 
+  
+                        ENDIF 
+       
+                        CALL obs_level_search(kpk, & 
+                           &        zgdept(iin,ijn,:,iobs),& 
+                           &        inum_obs, prodatqc%var(2)%vdep(ista:iend), & 
+                           &         iv_indic) 
+                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,  & 
+                           &          prodatqc%var(2)%vdep(ista:iend),     & 
+                           &          zints(iin,ijn,:,iobs),               & 
+                           &          zobs2k,interp_corner(iin,ijn,:),     & 
+                           &          zgdept(iin,ijn,:,iobs),              & 
+                           &          zmask(iin,ijn,:,iobs) )      
+         
+                     ENDDO 
+                  ENDDO 
+             
+               ENDIF 
+       
+               !------------------------------------------------------------- 
+               ! Compute the horizontal interpolation for every profile level 
+               !------------------------------------------------------------- 
+             
+               DO ikn=1,inum_obs 
+                  iend=ista+ikn-1 
+
+                  l_zweig(:,:,1) = 0._wp
+   
+                  ! This code forces the horizontal weights to be  
+                  ! zero IF the observation is below the bottom of the  
+                  ! corners of the interpolation nodes, Or if it is in  
+                  ! the mask. This is important for observations are near  
+                  ! steep bathymetry 
+                  DO iin=1,2 
+                     DO ijn=1,2 
+     
+                        depth_loop2: DO ik=kpk,2,-1 
+                           IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN   
+                            
+                              l_zweig(iin,ijn,1) = &  
+                                 &  zweig(iin,ijn,1) * & 
+                                 &  MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) & 
+                                 &  - prodatqc%var(2)%vdep(iend)),0._wp) 
+                            
+                              EXIT depth_loop2 
+                           ENDIF 
+                        ENDDO depth_loop2 
+     
+                     ENDDO 
+                  ENDDO 
+   
+                  CALL obs_int_h2d( 1, 1, l_zweig, interp_corner(:,:,ikn), & 
+                  &          prodatqc%var(2)%vmod(iend:iend) ) 
+ 
+               ENDDO 
+ 
+ 
+               DEALLOCATE(interp_corner,iv_indic) 
+          
+            ENDIF 
+          
+         ENDIF 
+       
+      END DO 
+     
+      ! Deallocate the data for interpolation 
+      DEALLOCATE( & 
+         & igrdi, & 
+         & igrdj, & 
+         & zglam, & 
+         & zgphi, & 
+         & zmask, & 
+         & zintt, & 
+         & zints, & 
+         & zgdept,&
+         & zgdepw &
+         & ) 
+      ! At the end of the day also get interpolated means 
+      IF ( idayend == 0 ) THEN 
+         DEALLOCATE( & 
+            & zinmt,  & 
+            & zinms   & 
+            & ) 
+      ENDIF 
+    
+      prodatqc%nprofup = prodatqc%nprofup + ipro  
+       
+   END SUBROUTINE obs_pro_sco_opt 
+ 
+   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,         &
+      &                    kit000, kdaystp, psurf, psurfmask, &
+      &                    k2dint, ldnightav )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_surf_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface
+      !!              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 new model value 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-03 (A. Weaver)
+      !!      ! 15-02 (M. Martin) Combined routine for surface types
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surfdataqc                  ! Subset of surface data passing QC
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psurf,  &                   ! Model surface field
+         & psurfmask                   ! Land-sea mask
+      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data
+
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isurf
+      INTEGER :: iobs
+      INTEGER :: idayend
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: &
+         & icount_night,      &
+         & imask_night
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      REAL(wp), DIMENSION(1) :: zext, zobsmask
+      REAL(wp) :: zdaystp
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask,  &
+         & zsurf,  &
+         & zsurfm, &
+         & zglam,  &
+         & zgphi
+      REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: &
+         & zintmp,  &
+         & zouttmp, &
+         & zmeanday    ! to compute model sst in region of 24h daylight (pole)
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! Record and data counters
+      inrc = kt - kit000 + 2
+      isurf = surfdataqc%nsstp(inrc)
+
+      IF ( ldnightav ) THEN
+
+      ! Initialize array for night mean
+         IF ( kt == 0 ) THEN
+            ALLOCATE ( icount_night(kpi,kpj) )
+            ALLOCATE ( imask_night(kpi,kpj) )
+            ALLOCATE ( zintmp(kpi,kpj) )
+            ALLOCATE ( zouttmp(kpi,kpj) )
+            ALLOCATE ( zmeanday(kpi,kpj) )
+            nday_qsr = -1   ! initialisation flag for nbc_dcy
+         ENDIF
+
+         ! Night-time means are calculated for night-time values over timesteps:
+         !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], .....
+         idayend = MOD( kt - kit000 + 1, kdaystp )
+
+         ! Initialize night-time mean for first timestep of the day
+         IF ( idayend == 1 .OR. kt == 0 ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  surfdataqc%vdmean(ji,jj) = 0.0
+                  zmeanday(ji,jj) = 0.0
+                  icount_night(ji,jj) = 0
+               END DO
+            END DO
+         ENDIF
+
+         zintmp(:,:) = 0.0
+         zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. )
+         imask_night(:,:) = INT( zouttmp(:,:) )
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Increment the temperature field for computing night mean and counter
+               surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  &
+                      &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) )
+               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj)
+               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj)
+            END DO
+         END DO
+
+         ! Compute the night-time mean at the end of the day
+         zdaystp = 1.0 / REAL( kdaystp )
+         IF ( idayend == 0 ) THEN
+            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! Test if "no night" point
+                  IF ( icount_night(ji,jj) > 0 ) THEN
+                     surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) &
+                       &                        / REAL( icount_night(ji,jj) )
+                  ELSE
+                     !At locations where there is no night (e.g. poles),
+                     ! calculate daily mean instead of night-time mean.
+                     surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! Get the data for interpolation
+
+      ALLOCATE( &
+         & igrdi(2,2,isurf), &
+         & igrdj(2,2,isurf), &
+         & zglam(2,2,isurf), &
+         & zgphi(2,2,isurf), &
+         & zmask(2,2,isurf), &
+         & zsurf(2,2,isurf)  &
+         & )
+
+      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf
+         iobs = jobs - surfdataqc%nsurfup
+         igrdi(1,1,iobs) = surfdataqc%mi(jobs)-1
+         igrdj(1,1,iobs) = surfdataqc%mj(jobs)-1
+         igrdi(1,2,iobs) = surfdataqc%mi(jobs)-1
+         igrdj(1,2,iobs) = surfdataqc%mj(jobs)
+         igrdi(2,1,iobs) = surfdataqc%mi(jobs)
+         igrdj(2,1,iobs) = surfdataqc%mj(jobs)-1
+         igrdi(2,2,iobs) = surfdataqc%mi(jobs)
+         igrdj(2,2,iobs) = surfdataqc%mj(jobs)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
+         &                  igrdi, igrdj, psurfmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, &
+         &                  igrdi, igrdj, psurf, zsurf )
+
+      ! At the end of the day get interpolated means
+      IF (ldnightav ) THEN
+         IF ( idayend == 0 ) THEN
+
+            ALLOCATE( &
+               & zsurfm(2,2,isurf)  &
+               & )
+
+            CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, igrdi, igrdj, &
+               &               surfdataqc%vdmean(:,:), zsurfm )
+
+         ENDIF
+      ENDIF
+
+      ! Loop over observations
+      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf
+
+         iobs = jobs - surfdataqc%nsurfup
+
+         IF ( kt /= surfdataqc%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    = ', surfdataqc%mstp(jobs), &
+                  &            ' ntyp    = ', surfdataqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_surf_opt', 'Inconsistent time' )
+
+         ENDIF
+
+         zlam = surfdataqc%rlam(jobs)
+         zphi = surfdataqc%rphi(jobs)
+
+         ! Get weights to interpolate the model value to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+
+         ! Interpolate the model field to the observation point
+         IF ( ldnightav .AND. idayend == 0 ) THEN
+            ! Night-time averaged data
+            CALL obs_int_h2d( 1, 1, zweig, zsurfm(:,:,iobs), zext )
+         ELSE
+            CALL obs_int_h2d( 1, 1, zweig, zsurf(:,:,iobs),  zext )
+         ENDIF
+
+         IF ( TRIM(surfdataqc%cvars(1)) == 'SLA' .AND. surfdataqc%nextra == 2 ) THEN
+            ! ... Remove the MDT from the SSH at the observation point to get the SLA
+            surfdataqc%rext(jobs,1) = zext(1)
+            surfdataqc%rmod(jobs,1) = surfdataqc%rext(jobs,1) - surfdataqc%rext(jobs,2)
+         ELSE
+            surfdataqc%rmod(jobs,1) = zext(1)
+         ENDIF
+
+      END DO
+
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsurf  &
+         & )
+
+      ! At the end of the day also deallocate night-time mean array
+      IF ( ldnightav ) THEN
+         IF ( idayend == 0 ) THEN
+            DEALLOCATE( &
+               & zsurfm  &
+               & )
+         ENDIF
+      ENDIF
+
+      surfdataqc%nsurfup = surfdataqc%nsurfup + isurf
+
+   END SUBROUTINE obs_surf_opt
+
+END MODULE obs_oper
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 8732)
@@ -0,0 +1,1360 @@
+MODULE obs_prep
+   !!=====================================================================
+   !!                       ***  MODULE  obs_prep  ***
+   !! Observation diagnostics: Prepare observation arrays: screening, 
+   !!                          sorting, coordinate search
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !!   obs_pre_prof  : First level check and screening of profile observations
+   !!   obs_pre_surf  : First level check and screening of surface observations
+   !!   obs_scr       : Basic screening of the observations
+   !!   obs_coo_tim   : Compute number of time steps to the observation time
+   !!   obs_sor       : Sort the observation arrays
+   !!---------------------------------------------------------------------
+   USE par_kind, ONLY : wp ! Precision variables
+   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
+   USE lib_mpp, ONLY :   ctl_warn, ctl_stop
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obs_pre_prof     ! First level check and screening of profile obs
+   PUBLIC   obs_pre_surf     ! First level check and screening of surface obs
+   PUBLIC   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_surf( surfdata, surfdataqc, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sla  ***
+      !!
+      !! ** Purpose : First level check and screening of surface observations
+      !!
+      !! ** Method  : First level check and screening of surface observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen) Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!        !  2015-02  (M. Martin) Combined routine for surface types.
+      !!----------------------------------------------------------------------
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY       :   glamt, gphit, tmask, nproc   ! Geographical information
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data
+      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      !
+      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_surf : Preparing the surface observations...'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = nn_time0 / 100
+      imin0 = ( nn_time0 - ihou0 * 100 )
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for surface data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              surfdata%nsurf,   surfdata%nyea, surfdata%nmon, &
+         &              surfdata%nday,    surfdata%nhou, surfdata%nmin, &
+         &              surfdata%nqc,     surfdata%mstp, iotdobs        )
+
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for surface data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( surfdata%nsurf,   surfdata%mi, surfdata%mj, &
+         &              surfdata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( surfdata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 surfdata%mi,   surfdata%mj,   & 
+         &                 surfdata%rlam, surfdata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), surfdata%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 surfdata data structure to
+      ! the surfdataqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(surfdata%nsurf) )
+      
+      ! We want all data which has qc flags <= 10
+
+      llvalid(:)  = ( surfdata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( surfdata,     surfdataqc,       .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,*) ' '//surfdataqc%cvars(1)//' data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', &
+            &            surfdataqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,'(10X,A,10X,A)')'Time step',surfdataqc%cvars(1)
+         WRITE(numout,'(10X,A,5X,A)')'---------','-----------------'
+         CALL FLUSH(numout)
+      ENDIF
+      
+      DO jobs = 1, surfdataqc%nsurf
+         inrc = surfdataqc%mstp(jobs) + 2 - nit000
+         surfdataqc%nsstp(inrc)  = surfdataqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( surfdataqc%nsstp, surfdataqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, surfdataqc%nsstpmpp(inrc)
+            CALL FLUSH(numout)
+         END DO
+      ENDIF
+
+1999  FORMAT(10X,I9,5X,I17)
+
+   END SUBROUTINE obs_pre_surf
+
+
+   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, &
+      &                     kpi, kpj, kpk, &
+      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  &
+      &                     ld_nea, kdailyavtypes )
+
+!!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_prof  ***
+      !!
+      !! ** Purpose : First level check and screening of profiles
+      !!
+      !! ** Method  : First level check and screening of profiles
+      !!
+      !! History :
+      !!        !  2007-06  (K. Mogensen) original : T and S profile data
+      !!        !  2008-09  (M. Valdivieso) : TAO velocity data
+      !!        !  2009-01  (K. Mogensen) : New feedback stricture
+      !!        !  2015-02  (M. Martin) : Combined profile routine.
+      !!
+      !!----------------------------------------------------------------------
+      USE par_oce           ! Ocean parameters
+      USE dom_oce, ONLY :   gdept_1d, nproc   ! Geographical information
+
+      !! * 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_var1              ! Observed variables switches
+      LOGICAL, INTENT(IN) :: ld_var2
+      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land
+      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes                          ! Types for daily averages
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & zmask1, &
+         & zmask2
+      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & pglam1, &
+         & pglam2, &
+         & pgphi1, &
+         & pgphi2
+
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that are
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdv1obs    !  - outside space domain (variable 1)
+      INTEGER :: iosdv2obs    !  - outside space domain (variable 2)
+      INTEGER :: ilanv1obs    !  - within a model land cell (variable 1)
+      INTEGER :: ilanv2obs    !  - within a model land cell (variable 2)
+      INTEGER :: inlav1obs    !  - close to land (variable 1)
+      INTEGER :: inlav2obs    !  - close to land (variable 2)
+      INTEGER :: igrdobs      !  - fail the grid search
+      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkv      !
+                              ! Global counters for observations that are
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1)
+      INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2)
+      INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1)
+      INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2)
+      INTEGER :: inlav1obsmpp !  - close to land (variable 1)
+      INTEGER :: inlav2obsmpp !  - close to land (variable 2)
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa
+      INTEGER :: iuvchkvmpp   !
+      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid           ! var1,var2 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_prof: Preparing the profile data...'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = nn_time0 / 100
+      imin0 = ( nn_time0 - ihou0 * 100 )
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdv1obs = 0
+      iosdv2obs = 0
+      ilanv1obs = 0
+      ilanv2obs = 0
+      inlav1obs = 0
+      inlav2obs = 0
+      iuvchku  = 0
+      iuvchkv = 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(:,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
+      ! -----------------------------------------------------------------------
+
+      ! Variable 1
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          &
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 pglam1,                pgphi1,               &
+         &                 gdept_1d,              zmask1,               &
+         &                 profdata%nqc,          profdata%var(1)%nvqc, &
+         &                 iosdv1obs,              ilanv1obs,           &
+         &                 inlav1obs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp )
+      CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp )
+      CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp )
+
+      ! Variable 2
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 pglam2,                pgphi2,               &
+         &                 gdept_1d,              zmask2,               &
+         &                 profdata%nqc,          profdata%var(2)%nvqc, &
+         &                 iosdv2obs,              ilanv2obs,           &
+         &                 inlav2obs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp )
+      CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp )
+      CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject u if v is rejected and vice versa
+      ! -----------------------------------------------------------------------
+
+      IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+         CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
+         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
+         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+      ENDIF
+
+      ! -----------------------------------------------------------------------
+      ! 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,*) ' Profiles outside time domain                     = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining profiles that failed grid search       = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', &
+            &            iosdv1obsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', &
+            &            ilanv1obsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',&
+               &            inlav1obsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',&
+               &            inlav1obsmpp
+         ENDIF
+         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+            WRITE(numout,*) ' U observation rejected since V rejected     = ', &
+               &            iuvchku
+         ENDIF
+         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', &
+            &            iosdv2obsmpp
+         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', &
+            &            ilanv2obsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',&
+               &            inlav2obsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',&
+               &            inlav2obsmpp
+         ENDIF
+         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN
+            WRITE(numout,*) ' V observation rejected since U rejected     = ', &
+               &            iuvchkv
+         ENDIF
+         WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', &
+            &                               '     '//prodatqc%cvars(1)//'     ', &
+            &                               '     '//prodatqc%cvars(2)//'     '
+         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
+
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+
+   END SUBROUTINE obs_pre_prof
+
+   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 )
+      !!----------------------------------------------------------------------
+      !!                    ***  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
+      !! * 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
+
+
+   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, kpi, kpj, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kobsno
+
+         ! 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_1d,      &
+         & gdepw_0,       &                       
+         & gdepw_n,       &
+         & gdept_n,       &
+         & ln_zco,        &
+         & ln_zps             
+
+      !! * 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,kpk,kprofno) :: &
+         & zgdepw
+      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.
+      LOGICAL :: ll_next_to_land    ! Is a profile next to land 
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, jobsp, jk, ji, jj
+
+      ! 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, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi )
+      IF ( .NOT.( ln_zps .OR. ln_zco ) ) THEN
+        ! Need to know the bathy depth for each observation for sco
+        CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw_n(:,:,:), &
+        &                     zgdepw )
+      ENDIF
+
+      DO jobs = 1, kprofno
+
+         ! 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
+
+         ! Check if next to land
+         IF (  ANY( zgmsk(1:2,1:2,1,jobs) == 0.0_wp ) ) THEN
+            ll_next_to_land=.TRUE.
+         ELSE
+            ll_next_to_land=.FALSE.
+         ENDIF 
+
+         ! Reject observations
+
+         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_1d(kpk)) ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 11
+               kosdobs = kosdobs + 1
+               CYCLE
+            ENDIF
+
+            ! To check if an observations falls within land there are two cases:
+            ! 1: z-coordibnates, where the check uses the mask
+            ! 2: terrain following (eg s-coordinates), 
+            !    where we use the depth of the bottom cell to mask observations
+             
+            IF( ln_zps .OR. ln_zco ) THEN !(CASE 1)
+               
+               ! Flag if the observation falls with a model land cell
+               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+                  &  == 0.0_wp ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+             
+               ! Flag if the observation is close to land
+              IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &
+                  &  0.0_wp) THEN
+                  knlaobs = knlaobs + 1
+                  IF (ld_nea) THEN   
+                     kobsqc(jobsp) = kobsqc(jobsp) + 14 
+                  ENDIF 
+               ENDIF
+             
+            ELSE ! Case 2
+ 
+               ! Flag if the observation is deeper than the bathymetry
+               ! Or if it is within the mask
+               IF ( ALL( zgdepw(1:2,1:2,kpk,jobs) < pobsdep(jobsp) ) &
+                  &     .OR. &
+                  &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+                  &  == 0.0_wp) ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+               
+               ! Flag if the observation is close to land
+               IF ( ll_next_to_land ) THEN
+                  knlaobs = knlaobs + 1
+                  IF (ld_nea) THEN   
+                     kobsqc(jobsp) = kobsqc(jobsp) + 14 
+                  ENDIF 
+               ENDIF
+            ENDIF
+            
+            ! For observations on the grid reject them if their are at
+            ! a masked point
+            
+            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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 8732)
@@ -0,0 +1,39 @@
+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
+   TYPE(obs_prof), POINTER ::  profdata(:) ! Initial profile data
+   TYPE(obs_prof), POINTER ::  prodatqc(:) ! Profile data after quality control
+
+   INTEGER :: nvelosets                     ! Total number of velocity profile data sets
+   INTEGER :: nvelovars                     ! Total number of variables for profiles
+   INTEGER :: nveloextr                     ! Extra fields for each variable
+   TYPE(obs_prof), POINTER ::  velodata(:)  ! Initial velocity profile data
+   TYPE(obs_prof), POINTER ::  veldatqc(:)  ! Velocity profile data after quality control
+END MODULE obs_profiles
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 8732)
@@ -0,0 +1,928 @@
+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
+   USE lib_mpp, ONLY : &
+      & ctl_warn, ctl_stop
+
+   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
+
+      CHARACTER(len=6), POINTER, DIMENSION(:) :: &
+         & cvars          !: Variable names
+
+      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%cvars(kvar),    &
+         & prof%nvprot(kvar),   &
+         & prof%nvprotmpp(kvar) &
+         )
+         
+      DO jvar = 1, kvar
+         prof%cvars    (jvar) = "NotSet"
+         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%cvars,    &
+         & 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
+      newprof%cvars(:) = prof%cvars(:)
+ 
+      ! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 8732)
@@ -0,0 +1,209 @@
+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
+   USE wrk_nemo                ! Memory Allocation
+
+   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( 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
+      TYPE(obs_surf), 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 :: 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(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zbias, &
+         & zglam, &
+         & zgphi
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z_altbias
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER :: numaltbias
+
+      CALL wrk_alloc(jpi,jpj,z_altbias) 
+
+      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
+  
+      ALLOCATE( &
+         & igrdi(2,2,sladata%nsurf), &
+         & igrdj(2,2,sladata%nsurf), &
+         & zglam(2,2,sladata%nsurf), &
+         & zgphi(2,2,sladata%nsurf), &
+         & zmask(2,2,sladata%nsurf), &
+         & zbias(2,2,sladata%nsurf)  &
+         & )
+         
+      DO jobs = 1, sladata%nsurf
+
+         igrdi(1,1,jobs) = sladata%mi(jobs)-1
+         igrdj(1,1,jobs) = sladata%mj(jobs)-1
+         igrdi(1,2,jobs) = sladata%mi(jobs)-1
+         igrdj(1,2,jobs) = sladata%mj(jobs)
+         igrdi(2,1,jobs) = sladata%mi(jobs)
+         igrdj(2,1,jobs) = sladata%mj(jobs)-1
+         igrdi(2,2,jobs) = sladata%mi(jobs)
+         igrdj(2,2,jobs) = sladata%mj(jobs)
+
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, tmask(:,:,1), zmask )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, z_altbias, zbias )
+
+      DO jobs = 1, sladata%nsurf
+
+         zlam = sladata%rlam(jobs)
+         zphi = sladata%rphi(jobs)
+         iico = sladata%mi(jobs)
+         ijco = sladata%mj(jobs)
+            
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+            &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zbias(:,:,jobs),  zext )
+
+         ! adjust mdt with bias field
+         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1)
+            
+      END DO
+
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zbias  &
+         & )
+         
+      CALL wrk_dealloc(jpi,jpj,z_altbias) 
+
+   END SUBROUTINE obs_rea_altbias
+
+
+ 
+END MODULE obs_read_altbias
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 8732)
@@ -0,0 +1,865 @@
+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 lib_mpp                  ! For ctl_warn/stop
+   USE obs_fbm                  ! Feedback routines
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_prof  ! 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_prof( profdata, knumfiles, cdfilenames, &
+      &                     kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                     ldvar1, ldvar2, ldignmis, ldsatt, &
+      &                     ldmod, kdailyavtypes )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_prof ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Read feedback data in and transform to NEMO internal 
+      !!              profile data structure
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines
+      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(OUT) :: &
+         & profdata                     ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles  ! Number of files to read
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cdfilenames(knumfiles)        ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches
+      LOGICAL, INTENT(IN) :: ldvar2
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes                ! Types of daily average observations
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof'
+      CHARACTER(len=8) :: clrefdate
+      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars
+      INTEGER :: jvar
+      INTEGER :: ji
+      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 :: iprof
+      INTEGER :: iproftot
+      INTEGER :: ivar1t0
+      INTEGER :: ivar2t0
+      INTEGER :: ivar1t
+      INTEGER :: ivar2t
+      INTEGER :: ip3dt
+      INTEGER :: ios
+      INTEGER :: ioserrcount
+      INTEGER :: ivar1tmpp
+      INTEGER :: ivar2tmpp
+      INTEGER :: ip3dtmpp
+      INTEGER :: itype
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypvar1,    &
+         & itypvar1mpp, &
+         & itypvar2,    &
+         & itypvar2mpp 
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi1,    &
+         & iobsj1,    &
+         & iproc1,    &
+         & iobsi2,    &
+         & iobsj2,    &
+         & iproc2,    &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      INTEGER, DIMENSION(kvars) :: &
+         & iv3dt
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      REAL(wp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      LOGICAL :: llvalprof
+      LOGICAL :: lldavtimset
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+
+      ! Local initialization
+      iprof = 0
+      ivar1t0 = 0
+      ivar2t0 = 0
+      ip3dt = 0
+
+      ! Daily average types
+      lldavtimset = .FALSE.
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE.
+      ELSE
+         idailyavtypes(:) = -1
+      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( cdfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+
+         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, &
+            &                      i_file_id )
+
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_obfbdata
+            !------------------------------------------------------------------
+
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            CALL init_obfbdata( inpfiles(jj) )
+            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
+               &                ldgrid = .TRUE. )
+
+            IF ( inpfiles(jj)%nvar < 2 ) THEN
+               CALL ctl_stop( 'Feedback format error: ', &
+                  &           ' less than 2 vars in profile file' )
+            ENDIF
+
+            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+               CALL ctl_stop( 'Model not in input data' )
+            ENDIF
+
+            IF ( jj == 1 ) THEN
+               ALLOCATE( clvars( inpfiles(jj)%nvar ) )
+               DO ji = 1, inpfiles(jj)%nvar
+                 clvars(ji) = inpfiles(jj)%cname(ji)
+               END DO
+            ELSE
+               DO ji = 1, inpfiles(jj)%nvar
+                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN
+                     CALL ctl_stop( 'Feedback file variables not consistent', &
+                        &           ' with previous files for this type' )
+                  ENDIF
+               END DO
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            clrefdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(clrefdate,'(I8)') irefdate(jj)
+
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            ioserrcount=0
+            IF ( lldavtimset ) THEN
+
+               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN
+                  WRITE(numout,*)' Resetting time of daily averaged', &
+                     &           ' observations to the end of the day'
+               ENDIF
+
+               DO ji = 1, inpfiles(jj)%nobs
+                  READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype
+900               IF ( ios /= 0 ) THEN
+                     ! Set type to zero if there is a problem in the string conversion
+                     itype = 0
+                  ENDIF
+
+                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN
+                  !  for daily averaged data force the time
+                  !  to be the last time-step of the day, but still within the day.
+                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
+                        inpfiles(jj)%ptim(ji) = &
+                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999
+                     ELSE
+                        inpfiles(jj)%ptim(ji) = &
+                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001
+                     ENDIF
+                  ENDIF
+
+               END DO
+
+            ENDIF
+
+            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( iobsi1(inowin) )
+            ALLOCATE( iobsj1(inowin) )
+            ALLOCATE( iproc1(inowin) )
+            ALLOCATE( iobsi2(inowin) )
+            ALLOCATE( iobsj2(inowin) )
+            ALLOCATE( iproc2(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               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
+
+            IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN
+               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, &
+                  &                  iproc1, 'T' )
+               iobsi2(:) = iobsi1(:)
+               iobsj2(:) = iobsj1(:)
+               iproc2(:) = iproc1(:)
+            ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN
+               CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, &
+                  &                  iproc1, 'U' )
+               CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, &
+                  &                  iproc2, 'V' )
+            ENDIF
+
+            inowin = 0
+            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) = iproc1(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin)
+                  inpfiles(jj)%iproc(ji,2) = iproc2(inowin)
+                  inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin)
+                  inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin)
+                  IF ( inpfiles(jj)%iproc(ji,1) /= &
+                     & inpfiles(jj)%iproc(ji,2) ) THEN
+                     CALL ctl_stop( 'Error in obs_read_prof:', &
+                        & 'var1 and var2 observation on different processors')
+                  ENDIF
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 )
+
+            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 ( ldvar1 ) 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
+                           ivar1t0 = ivar1t0 + 1
+                        ENDIF
+                     END DO loop_t_count
+                  ENDIF
+                  IF ( ldvar2 ) 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
+                           ivar2t0 = ivar2t0 + 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. &
+                        &     ldvar1 ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldvar2 ) ) 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) = ivar1t0
+         iv3dt(2) = ivar2t0
+      ENDIF
+      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
+         &                 kstp, jpi, jpj, jpk )
+
+      ! * Read obs/positions, QC, all variable and assign to profdata
+
+      profdata%nprof     = 0
+      profdata%nvprot(:) = 0
+      profdata%cvars(:)  = clvars(:)
+      iprof = 0
+
+      ip3dt = 0
+      ivar1t = 0
+      ivar2t = 0
+      itypvar1   (:) = 0
+      itypvar1mpp(:) = 0
+
+      itypvar2   (:) = 0
+      itypvar2mpp(:) = 0
+
+      ioserrcount = 0
+      DO jk = 1, iproftot
+
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+
+         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,1) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
+               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
+               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
+
+               ! Profile WMO number
+               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
+
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
+901            IF ( ios /= 0 ) THEN
+                  IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' )
+                  ioserrcount = ioserrcount + 1
+                  itype = 0
+               ENDIF
+
+               profdata%ntyp(iprof) = itype
+
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_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. &
+                        &     ldvar1 ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldvar2 ) ) THEN
+                        ip3dt = ip3dt + 1
+                     ELSE
+                        CYCLE
+                     ENDIF
+
+                  ENDIF
+
+                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                     &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                     &       ldvar1 ) .OR. ldsatt ) THEN
+
+                     IF (ldsatt) THEN
+
+                        ivar1t = ip3dt
+
+                     ELSE
+
+                        ivar1t = ivar1t + 1
+
+                     ENDIF
+
+                     ! Depth of var1 observation
+                     profdata%var(1)%vdep(ivar1t) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+
+                     ! Depth of var1 observation QC
+                     profdata%var(1)%idqc(ivar1t) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+
+                     ! Depth of var1 observation QC flags
+                     profdata%var(1)%idqcf(:,ivar1t) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+
+                     ! Profile index
+                     profdata%var(1)%nvpidx(ivar1t) = iprof
+
+                     ! Vertical index in original profile
+                     profdata%var(1)%nvlidx(ivar1t) = ij
+
+                     ! Profile var1 value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(1)%vobs(ivar1t) = &
+                           &                inpfiles(jj)%pob(ij,ji,1)
+                        IF ( ldmod ) THEN
+                           profdata%var(1)%vmod(ivar1t) = &
+                              &                inpfiles(jj)%padd(ij,ji,1,1)
+                        ENDIF
+                        ! Count number of profile var1 data as function of type
+                        itypvar1( profdata%ntyp(iprof) + 1 ) = &
+                           & itypvar1( profdata%ntyp(iprof) + 1 ) + 1
+                     ELSE
+                        profdata%var(1)%vobs(ivar1t) = fbrmdi
+                     ENDIF
+
+                     ! Profile var1 qc
+                     profdata%var(1)%nvqc(ivar1t) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,1)
+
+                     ! Profile var1 qc flags
+                     profdata%var(1)%nvqcf(:,ivar1t) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+
+                     ! Profile insitu T value
+                     IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN
+                        profdata%var(1)%vext(ivar1t,1) = &
+                           &                inpfiles(jj)%pext(ij,ji,1)
+                     ENDIF
+
+                  ENDIF
+
+                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                     &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                     &   ldvar2 ) .OR. ldsatt ) THEN
+
+                     IF (ldsatt) THEN
+
+                        ivar2t = ip3dt
+
+                     ELSE
+
+                        ivar2t = ivar2t + 1
+
+                     ENDIF
+
+                     ! Depth of var2 observation
+                     profdata%var(2)%vdep(ivar2t) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+
+                     ! Depth of var2 observation QC
+                     profdata%var(2)%idqc(ivar2t) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+
+                     ! Depth of var2 observation QC flags
+                     profdata%var(2)%idqcf(:,ivar2t) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+
+                     ! Profile index
+                     profdata%var(2)%nvpidx(ivar2t) = iprof
+
+                     ! Vertical index in original profile
+                     profdata%var(2)%nvlidx(ivar2t) = ij
+
+                     ! Profile var2 value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(2)%vobs(ivar2t) = &
+                           &                inpfiles(jj)%pob(ij,ji,2)
+                        IF ( ldmod ) THEN
+                           profdata%var(2)%vmod(ivar2t) = &
+                              &                inpfiles(jj)%padd(ij,ji,1,2)
+                        ENDIF
+                        ! Count number of profile var2 data as function of type
+                        itypvar2( profdata%ntyp(iprof) + 1 ) = &
+                           & itypvar2( profdata%ntyp(iprof) + 1 ) + 1
+                     ELSE
+                        profdata%var(2)%vobs(ivar2t) = fbrmdi
+                     ENDIF
+
+                     ! Profile var2 qc
+                     profdata%var(2)%nvqc(ivar2t) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,2)
+
+                     ! Profile var2 qc flags
+                     profdata%var(2)%nvqcf(:,ivar2t) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+
+                  ENDIF
+
+               END DO loop_p
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+
+      CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp )
+      CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp )
+      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  )
+
+      CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 )
+      CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 )
+
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(A)') ' Profile data'
+         WRITE(numout,'(1X,A)') '------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) )
+         WRITE(numout,'(1X,A)') '------------------------'
+         DO ji = 0, ntyp1770
+            IF ( itypvar1mpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & itypvar1mpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// &
+            & '             = ', ivar1tmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) )
+         WRITE(numout,'(1X,A)') '------------------------'
+         DO ji = 0, ntyp1770
+            IF ( itypvar2mpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & itypvar2mpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// &
+            & '             = ', ivar2tmpp
+         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)    = ivar1t
+         profdata%nvprot(2)    = ivar2t
+         profdata%nvprotmpp(1) = ivar1tmpp
+         profdata%nvprotmpp(2) = ivar2tmpp
+      ENDIF
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      IF ( ldvar1 ) THEN
+         CALL obs_level_search( jpk, gdept_1d, &
+            & profdata%nvprot(1), profdata%var(1)%vdep, &
+            & profdata%var(1)%mvk )
+      ENDIF
+      IF ( ldvar2 ) THEN
+         CALL obs_level_search( jpk, gdept_1d, &
+            & profdata%nvprot(2), profdata%var(2)%vdep, &
+            & profdata%var(2)%mvk )
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat, clvars )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_prof
+
+END MODULE obs_read_prof
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90	(revision 8732)
@@ -0,0 +1,498 @@
+MODULE obs_read_surf
+   !!======================================================================
+   !!                       ***  MODULE obs_read_surf  ***
+   !! Observation diagnostics: Read the surface data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_surf : Driver for reading surface data from feedback files
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_fbm                  ! Feedback routines
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_surf      ! Read the surface observations from the point data
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_read_surf.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, &
+      &                     kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                     ldignmis, ldmod, ldnightav )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_surf ***
+      !!
+      !! ** Purpose : Read from file the surface data
+      !!
+      !! ** Method  : Read in the data from feedback format files and 
+      !!              put into the NEMO internal surface data structure
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!      ! :  2015-02 (M. Martin)   Unify the different surface data type reading.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surfdata                     ! Surface data to be read
+      INTEGER, INTENT(IN) :: knumfiles  ! Number of corio format files to read
+      CHARACTER(LEN=128), INTENT(IN) :: &
+         & cdfilenames(knumfiles)       ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in surfdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      LOGICAL, INTENT(IN) :: ldnightav  ! Observations represent a night-time average
+      REAL(dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf'
+      CHARACTER(len=8) :: clrefdate
+      CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER :: itype
+      INTEGER :: iobsmpp
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      INTEGER :: ios
+      INTEGER :: ioserrcount
+      INTEGER, PARAMETER :: jpsurfmaxtype = 1024
+      INTEGER, DIMENSION(knumfiles) :: irefdate
+      INTEGER, DIMENSION(jpsurfmaxtype+1) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & isurfidx
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      REAL(wp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+
+      ! Local initialization
+      iobs = 0
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+
+      inobf = knumfiles
+
+      ALLOCATE( inpfiles(inobf) )
+
+      surf_files : DO jj = 1, inobf
+
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_surf : Reading from file = ', &
+               & TRIM( TRIM( cdfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+
+         iflag = nf90_open( TRIM( TRIM( cdfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_obfbdata
+            !------------------------------------------------------------------
+
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            CALL init_obfbdata( inpfiles(jj) )
+            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), &
+               &                ldgrid = .TRUE. )
+
+            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+               CALL ctl_stop( 'Model not in input data' )
+               RETURN
+            ENDIF
+
+            IF ( jj == 1 ) THEN
+               ALLOCATE( clvars( inpfiles(jj)%nvar ) )
+               DO ji = 1, inpfiles(jj)%nvar
+                 clvars(ji) = inpfiles(jj)%cname(ji)
+               END DO
+            ELSE
+               DO ji = 1, inpfiles(jj)%nvar
+                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN
+                     CALL ctl_stop( 'Feedback file variables not consistent', &
+                        &           ' with previous files for this type' )
+                  ENDIF
+               END DO
+            ENDIF
+
+            IF (lwp) WRITE(numout,*)'Observation file contains ',inpfiles(jj)%nobs,' observations'
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            clrefdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(clrefdate,'(I8)') irefdate(jj)
+
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldnightav ) THEN
+
+               IF ( lwp ) THEN
+                  WRITE(numout,*)'Resetting time of night-time averaged observations', &
+                     &             ' to the end of the day'
+               ENDIF
+
+               DO ji = 1, inpfiles(jj)%nobs
+                  !  for night-time averaged data force the time
+                  !  to be the last time-step of the day, but still within the day.
+                  IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN
+                     inpfiles(jj)%ptim(ji) = &
+                        & INT(inpfiles(jj)%ptim(ji)) + 0.9999
+                  ELSE
+                     inpfiles(jj)%ptim(ji) = &
+                        & INT(inpfiles(jj)%ptim(ji)) - 0.0001
+                  ENDIF
+               END DO
+            ENDIF
+
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO surf_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      isurfidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               isurfidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+
+      CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj )
+
+      ! Read obs/positions, QC, all variable and assign to surfdata
+
+      iobs = 0
+
+      surfdata%cvars(:)  = clvars(:)
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+
+      ioserrcount = 0
+
+      DO jk = 1, iobstot
+
+         jj = ifileidx(iindx(jk))
+         ji = isurfidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+
+            ! Set observation information
+
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Surface time coordinates
+               surfdata%nyea(iobs) = iyea
+               surfdata%nmon(iobs) = imon
+               surfdata%nday(iobs) = iday
+               surfdata%nhou(iobs) = ihou
+               surfdata%nmin(iobs) = imin
+
+               ! Surface space coordinates
+               surfdata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               surfdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               surfdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+
+               ! WMO number
+               surfdata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
+
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype
+901            IF ( ios /= 0 ) THEN
+                  IF (ioserrcount == 0) THEN
+                     CALL ctl_warn ( 'Problem converting an instrument type ', &
+                        &            'to integer. Setting type to zero' )
+                  ENDIF
+                  ioserrcount = ioserrcount + 1
+                  itype = 0
+               ENDIF
+               surfdata%ntyp(iobs) = itype
+               IF ( itype < jpsurfmaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase jpsurfmaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               surfdata%nsidx(iobs) = iobs
+               surfdata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               surfdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN
+                     surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
+                     surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
+                  ENDIF
+                ELSE
+                  surfdata%rmod(iobs,1) = fbrmdi
+                  IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      CALL obs_mpp_sum_integers( ityp, itypmpp, jpsurfmaxtype + 1 )
+
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1) )//' data'
+         WRITE(numout,'(1X,A)')'--------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A,I8)') &
+            & 'Total data for variable '//TRIM( surfdata%cvars(1) )// &
+            & '           = ', iobsmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, isurfidx, zdat, clvars )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         IF ( inpfiles(jj)%lalloc ) THEN
+            CALL dealloc_obfbdata( inpfiles(jj) )
+         ENDIF
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_surf
+
+END MODULE obs_read_surf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 8732)
@@ -0,0 +1,265 @@
+MODULE obs_readmdt
+   !!======================================================================
+   !!                       ***  MODULE obs_readmdt  ***
+   !! Observation diagnostics: Read the MDT for SLA data (skeleton for now)
+   !!======================================================================
+   !! History :      ! 2007-03 (K. Mogensen) Initial skeleton version
+   !!                ! 2007-04 (E. Remy) migration and improvement from OPAVAR
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_mdt    : Driver for reading MDT
+   !!   obs_offset_mdt : Remove the offset between the model MDT and the used one
+   !!----------------------------------------------------------------------
+   USE wrk_nemo         ! Memory Allocation
+   USE par_kind         ! Precision variables
+   USE par_oce          ! Domain parameters
+   USE in_out_manager   ! I/O manager
+   USE obs_surf_def     ! Surface observation definitions
+   USE obs_inter_sup    ! Interpolation support routines
+   USE obs_inter_h2d    ! 2D interpolation
+   USE obs_utils        ! Various observation tools
+   USE iom_nf90         ! IOM NetCDF
+   USE netcdf           ! NetCDF library
+   USE lib_mpp          ! MPP library
+   USE dom_oce, ONLY : &                  ! Domain variables
+      &                    tmask, tmask_i, e1e2t, gphit, glamt
+   USE obs_const, ONLY :   obfillflt      ! Fillvalue
+   USE oce      , ONLY :   sshn           ! Model variables
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   obs_rea_mdt     ! called by dia_obs_init
+   PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt
+
+   INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme
+   REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction
+   REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE obs_rea_mdt( sladata, k2dint )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_mdt ***
+      !!
+      !! ** Purpose : Read from file the MDT data (skeleton)
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      USE iom
+      !
+      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data
+      INTEGER       , INTENT(in)    ::   k2dint    ! ?
+      !
+      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt'
+      CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc'
+
+      INTEGER ::   jobs                ! Obs loop variable
+      INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT
+      INTEGER ::   iico, ijco          ! Grid point indicies
+      INTEGER ::   i_nx_id, i_ny_id, i_file_id, i_var_id, i_stat
+      INTEGER ::   nummdt
+      !
+      REAL(wp), DIMENSION(1)     ::   zext, zobsmask
+      REAL(wp), DIMENSION(2,2,1) ::   zweig
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zmask, zmdtl, zglam, zgphi
+      INTEGER , DIMENSION(:,:,:), ALLOCATABLE ::   igrdi, igrdj
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) ::  z_mdt, mdtmask
+         
+      REAL(wp) :: zlam, zphi, zfill, zinfill    ! local scalar
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc(jpi,jpj,z_mdt,mdtmask) 
+
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies'
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      CALL FLUSH(numout)
+
+      CALL iom_open( mdtname, nummdt )       ! Open the file
+      !                                      ! Get the MDT data
+      CALL iom_get ( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 )
+      CALL iom_close(nummdt)                 ! Close the file
+      
+      ! 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)
+      ELSE WHERE                   ;   mdtmask(:,:) = 0
+      END WHERE
+
+      ! Remove the offset between the MDT used with the sla and the model MDT
+      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) &
+         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill )
+
+      ! Intepolate the MDT already on the model grid at the observation point
+  
+      ALLOCATE( &
+         & igrdi(2,2,sladata%nsurf), &
+         & igrdj(2,2,sladata%nsurf), &
+         & zglam(2,2,sladata%nsurf), &
+         & zgphi(2,2,sladata%nsurf), &
+         & zmask(2,2,sladata%nsurf), &
+         & zmdtl(2,2,sladata%nsurf)  &
+         & )
+         
+      DO jobs = 1, sladata%nsurf
+
+         igrdi(1,1,jobs) = sladata%mi(jobs)-1
+         igrdj(1,1,jobs) = sladata%mj(jobs)-1
+         igrdi(1,2,jobs) = sladata%mi(jobs)-1
+         igrdj(1,2,jobs) = sladata%mj(jobs)
+         igrdi(2,1,jobs) = sladata%mi(jobs)
+         igrdj(2,1,jobs) = sladata%mj(jobs)-1
+         igrdi(2,2,jobs) = sladata%mi(jobs)
+         igrdj(2,2,jobs) = sladata%mj(jobs)
+
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt  , zmdtl )
+
+      DO jobs = 1, sladata%nsurf
+            
+         zlam = sladata%rlam(jobs)
+         zphi = sladata%rphi(jobs)
+
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+            &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+         CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
+ 
+         sladata%rext(jobs,2) = zext(1)
+
+! mark any masked data with a QC flag
+         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = 11
+
+         END DO
+         
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zmdtl  &
+         & )
+
+      CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      !
+   END SUBROUTINE obs_rea_mdt
+
+
+   SUBROUTINE obs_offset_mdt( kpi, kpj, 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  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) ::  kpi, kpj
+      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid
+      REAL(wp)                    , INTENT(IN   ) ::   zfill 
+      ! 
+      INTEGER  :: ji, jj
+      REAL(wp) :: zdxdy, zarea, zeta1, zeta2, zcorr_mdt, zcorr_bcketa, zcorr     ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) :: zpromsk
+      CHARACTER(LEN=14), PARAMETER ::   cpname = 'obs_offset_mdt'
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zpromsk )
+
+      !  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.  rn_mdtcutoff ) &
+              &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) &
+              &.OR.( mdt(ji,jj) .EQ. zfill ) ) &
+              &        zpromsk(ji,jj) = 0.0
+        END DO
+      END DO 
+
+      ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff]
+
+      zarea = 0.0
+      zeta1 = 0.0
+      zeta2 = 0.0
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+          zdxdy = e1e2t(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( nn_msshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr  
+
+      ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT
+
+      IF( nn_msshc == 2 )   mdt(:,:) = mdt(:,:) - rn_mdtcorr
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff     = ', rn_mdtcutoff
+         WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt
+         WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa
+         WRITE(numout,*) '               zcorr         = ', zcorr
+         WRITE(numout,*) '               nn_msshc        = ', nn_msshc
+      ENDIF
+
+      IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
+      IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
+      IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
+
+      CALL wrk_dealloc( jpi,jpj, zpromsk )
+      !
+   END SUBROUTINE obs_offset_mdt
+ 
+   !!======================================================================
+END MODULE obs_readmdt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 8732)
@@ -0,0 +1,232 @@
+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 wrk_nemo                 ! Memory Allocation
+   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(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
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsingu,zcosgu,zsingv,zcosgv
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv
+      INTEGER :: ji
+      INTEGER :: jk
+
+      CALL wrk_alloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 
+
+      !-----------------------------------------------------------------------
+      ! 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, jpi, jpj, igrdiu, igrdju, &
+         &                  glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
+         &                  gphiu, zgphiu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
+         &                  umask(:,:,1), zmasku )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
+         &                  zsingu, zsinlu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, &
+         &                  zcosgu, zcoslu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
+         &                  glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
+         &                  gphiv, zgphiv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
+         &                  vmask(:,:,1), zmaskv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, &
+         &                  zsingv, zsinlv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, 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(2)%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  &
+         & )
+
+      CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 
+
+   END SUBROUTINE obs_rotvel
+
+END MODULE obs_rot_vel
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sstbias.F90	(revision 8732)
@@ -0,0 +1,244 @@
+MODULE obs_sstbias
+   !!======================================================================
+   !!                       ***  MODULE obs_readsstbias  ***
+   !! Observation diagnostics: Read the bias for SLA data
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sstbias : Driver for reading altimeter bias
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit, &
+      & glamt
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_h2d
+   USE obs_utils               ! Various observation tools
+   USE obs_inter_sup
+   IMPLICIT NONE
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC obs_app_sstbias     ! Read the altimeter bias
+CONTAINS
+   SUBROUTINE obs_app_sstbias( sstdata, k2dint, knumtypes, &
+                               cl_bias_files )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_app_sstbias ***
+      !!
+      !! ** Purpose : Read SST bias data from files and apply correction to
+      !!             observations
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! References :
+      !!
+      !! History : 
+      !!      ! :  2014-08 (J. While) Bias correction code for SST obs,
+      !!      !                      based on obs_rea_altbias
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+      USE netcdf
+      !! * Arguments
+
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata       ! SST data
+      INTEGER, INTENT(IN) :: k2dint
+      INTEGER, INTENT(IN) :: knumtypes !number of bias types to read in
+      CHARACTER(LEN=128), DIMENSION(knumtypes), INTENT(IN) :: &
+                          cl_bias_files !List of files to read
+      !! * Local declarations
+      INTEGER :: jobs         ! Obs loop variable
+      INTEGER :: jpisstbias   ! Number of grid point in latitude for the bias
+      INTEGER :: jpjsstbias   ! Number of grid point in longitude for the bias
+      INTEGER :: iico         ! Grid point indices
+      INTEGER :: ijco
+      INTEGER :: jt
+      INTEGER :: i_nx_id      ! Index to read the NetCDF file
+      INTEGER :: i_ny_id      !
+      INTEGER :: i_file_id    !
+      INTEGER :: i_var_id
+      INTEGER, DIMENSION(knumtypes) :: &
+         & ibiastypes             ! Array of the bias types in each file
+      REAL(wp), DIMENSION(jpi,jpj,knumtypes) :: & 
+         & z_sstbias              ! Array to store the SST bias values
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         & z_sstbias_2d           ! Array to store the SST bias values   
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zglam, &
+         & zgphi
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask_tmp, &
+         & zglam_tmp, &
+         & zgphi_tmp   
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zbias   
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi_tmp, &
+         & igrdj_tmp   
+      INTEGER :: numsstbias
+      INTEGER(KIND=NF90_INT) :: ifile_source
+     
+      INTEGER :: incfile
+      INTEGER :: jtype
+      INTEGER :: iret 
+      INTEGER :: inumtype
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) 'obs_rea_sstbias : '
+      IF(lwp)WRITE(numout,*) '----------------- '
+      IF(lwp)WRITE(numout,*) 'Read SST bias '
+      ! Open and read the files
+      z_sstbias(:,:,:)=0.0_wp
+      DO jtype = 1, knumtypes
+     
+         numsstbias=0
+         IF(lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype)
+         CALL iom_open( cl_bias_files(jtype), numsstbias, ldstop=.FALSE. )       
+         IF (numsstbias > 0) THEN
+     
+            !Read the bias type from the file
+            !No IOM get attribute command at time of writing, 
+            !so have to use NETCDF
+            !routines directly - should be upgraded in the future
+            iret=NF90_OPEN(TRIM(cl_bias_files(jtype)), NF90_NOWRITE, incfile)
+            iret=NF90_GET_ATT( incfile, NF90_GLOBAL, "SST_source", &
+                              ifile_source )
+            ibiastypes(jtype) = ifile_source                 
+            iret=NF90_CLOSE(incfile)       
+           
+            IF ( iret /= 0  ) CALL ctl_stop( &
+               'obs_rea_sstbias : Cannot read bias type from file '// &
+               cl_bias_files(jtype) )
+            ! Get the SST bias data
+            CALL iom_get( numsstbias, jpdom_data, 'sst', z_sstbias_2d(:,:), 1 )
+            z_sstbias(:,:,jtype) = z_sstbias_2d(:,:)       
+            ! Close the file
+            CALL iom_close(numsstbias)       
+         ELSE
+            CALL ctl_stop('obs_read_sstbias: File '// & 
+                           TRIM( cl_bias_files(jtype) )//' Not found')
+         ENDIF
+      END DO
+           
+      ! Interpolate the bias already on the model grid at the observation point
+      ALLOCATE( &
+         & igrdi(2,2,sstdata%nsurf), &
+         & igrdj(2,2,sstdata%nsurf), &
+         & zglam(2,2,sstdata%nsurf), &
+         & zgphi(2,2,sstdata%nsurf), &
+         & zmask(2,2,sstdata%nsurf)  )
+       
+      DO jobs = 1, sstdata%nsurf 
+         igrdi(1,1,jobs) = sstdata%mi(jobs)-1
+         igrdj(1,1,jobs) = sstdata%mj(jobs)-1
+         igrdi(1,2,jobs) = sstdata%mi(jobs)-1
+         igrdj(1,2,jobs) = sstdata%mj(jobs)
+         igrdi(2,1,jobs) = sstdata%mi(jobs)
+         igrdj(2,1,jobs) = sstdata%mj(jobs)-1
+         igrdi(2,2,jobs) = sstdata%mi(jobs)
+         igrdj(2,2,jobs) = sstdata%mj(jobs)
+      END DO
+      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, sstdata%nsurf, jpi, jpj, &
+         &                  igrdi, igrdj, tmask(:,:,1), zmask )
+      DO jtype = 1, knumtypes
+         
+         !Find the number observations of type and allocate tempory arrays
+         inumtype = COUNT( sstdata%ntyp(:) == ibiastypes(jtype) )
+         ALLOCATE( &
+            & igrdi_tmp(2,2,inumtype), &
+            & igrdj_tmp(2,2,inumtype), &
+            & zglam_tmp(2,2,inumtype), &
+            & zgphi_tmp(2,2,inumtype), &
+            & zmask_tmp(2,2,inumtype), &
+            & zbias( 2,2,inumtype ) )
+         jt=1
+         DO jobs = 1, sstdata%nsurf 
+            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
+               igrdi_tmp(:,:,jt) = igrdi(:,:,jobs) 
+               igrdj_tmp(:,:,jt) = igrdj(:,:,jobs)
+               zglam_tmp(:,:,jt) = zglam(:,:,jobs)
+               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs)
+               zgphi_tmp(:,:,jt) = zgphi(:,:,jobs)
+               zmask_tmp(:,:,jt) = zmask(:,:,jobs)
+               jt = jt +1
+            ENDIF
+         END DO
+                         
+         CALL obs_int_comm_2d( 2, 2, inumtype, jpi, jpj, &
+               &           igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), &
+               &           z_sstbias(:,:,jtype), zbias(:,:,:) )
+         jt=1
+         DO jobs = 1, sstdata%nsurf
+            IF ( sstdata%ntyp(jobs) == ibiastypes(jtype) ) THEN
+               zlam = sstdata%rlam(jobs)
+               zphi = sstdata%rphi(jobs)
+               iico = sstdata%mi(jobs)
+               ijco = sstdata%mj(jobs)         
+               CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+                  &                   zglam_tmp(:,:,jt), &
+                  &                   zgphi_tmp(:,:,jt), &
+                  &                   zmask_tmp(:,:,jt), zweig, zobsmask )
+               CALL obs_int_h2d( 1, 1, zweig, zbias(:,:,jt),  zext )
+               ! adjust sst with bias field
+               sstdata%robs(jobs,1) = sstdata%robs(jobs,1) - zext(1)
+               jt=jt+1
+            ENDIF
+         END DO 
+               
+         !Deallocate arrays
+         DEALLOCATE( &
+         & igrdi_tmp, &
+         & igrdj_tmp, &
+         & zglam_tmp, &
+         & zgphi_tmp, &
+         & zmask_tmp, &
+         & zbias )           
+      END DO
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask )
+
+      IF(lwp) THEN
+         WRITE(numout,*) " "
+         WRITE(numout,*) "SST bias correction applied successfully"
+         WRITE(numout,*) "Obs types: ",ibiastypes(:), &
+                              " Have all been bias corrected\n"
+      ENDIF
+   END SUBROUTINE obs_app_sstbias
+ 
+END MODULE obs_sstbias
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 8732)
@@ -0,0 +1,504 @@
+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 :: npi        !: Number of 3D grid points
+      INTEGER :: npj
+      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=6), POINTER, DIMENSION(:) :: &
+         & cvars          !: Variable names
+
+      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
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & vdmean         !: Time averaged of model field
+
+      ! 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, kpi, kpj )
+      !!----------------------------------------------------------------------
+      !!                     ***  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
+      INTEGER, INTENT(IN) :: kpi     ! Number of 3D grid points
+      INTEGER, INTENT(IN) :: kpj
+
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: jvar
+
+      ! Set bookkeeping variables
+
+      surf%nsurf    = ksurf
+      surf%nsurfmpp = 0
+      surf%nextra   = kextra
+      surf%nvar     = kvar
+      surf%nstp     = kstp
+      surf%npi      = kpi
+      surf%npj      = kpj
+
+      ! Allocate arrays of size number of variables
+
+      ALLOCATE( &
+         & surf%cvars(kvar)    &
+         & )
+
+      DO jvar = 1, kvar
+         surf%cvars(jvar) = "NotSet"
+      END DO
+      
+      ! Allocate arrays of number of surface data size
+
+      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)   &
+         & )
+
+      ! Allocate arrays of size number of grid points
+
+      ALLOCATE( &
+         & surf%vdmean(kpi,kpj) &
+         & )
+
+      ! 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 size number of grid points size times
+      ! number of variables
+
+      DEALLOCATE( &
+         & surf%vdmean &
+         & )
+
+      ! Deallocate arrays of number of time step size
+
+      DEALLOCATE( &
+         & surf%nsstp,     &
+         & surf%nsstpmpp   &
+         & )
+
+      ! Dellocate arrays of size number of variables
+
+      DEALLOCATE( &
+         & surf%cvars     &
+         & )
+
+   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, surf%npi, surf%npj )
+      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
+      newsurf%cvars(:) = surf%cvars(:)
+ 
+      ! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 8732)
@@ -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) = '---'
+
+!         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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 8732)
@@ -0,0 +1,213 @@
+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
+   USE lib_mpp                  ! For ctl_warn/stop
+
+   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 8732)
@@ -0,0 +1,575 @@
+MODULE obs_write
+   !!======================================================================
+   !!                       ***  MODULE obs_write   ***
+   !! Observation diagnosticss: Write observation related diagnostics
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_wri_prof   : Write profile observations in feedback format
+   !!   obs_wri_surf   : Write surface observations in feedback format
+   !!   obs_wri_stats : Print basic statistics on the data being written out
+   !!----------------------------------------------------------------------
+
+   !! * 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_mpp              ! MPP support routines for observation diagnostics
+   USE lib_mpp		    ! MPP routines
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC obs_wri_prof, &    ! Write profile observation files
+      &   obs_wri_surf, &    ! Write surface observation files
+      &   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_prof( profdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_prof  ***
+      !!
+      !! ** Purpose : Write profile feedback files
+      !!
+      !! ** 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
+      !!      ! 15-02  (M. Martin) Combined routine for writing profiles
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      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) :: clfname
+      CHARACTER(LEN=6) :: clfiletype
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: iadd
+      INTEGER :: iext
+      REAL(wp) :: zpres
+
+      IF ( PRESENT( padd ) ) THEN
+         iadd = padd%inum
+      ELSE
+         iadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         iext = pext%inum
+      ELSE
+         iext = 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
+
+      SELECT CASE ( TRIM(profdata%cvars(1)) )
+      CASE('POTM')
+
+         clfiletype='profb'
+         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
+            &                 1 + iadd, 1 + iext, .TRUE. )
+         fbdata%cname(1)      = profdata%cvars(1)
+         fbdata%cname(2)      = profdata%cvars(2)
+         fbdata%coblong(1)    = 'Potential temperature'
+         fbdata%coblong(2)    = 'Practical salinity'
+         fbdata%cobunit(1)    = 'Degrees centigrade'
+         fbdata%cobunit(2)    = 'PSU'
+         fbdata%cextname(1)   = 'TEMP'
+         fbdata%cextlong(1)   = 'Insitu temperature'
+         fbdata%cextunit(1)   = 'Degrees centigrade'
+         fbdata%caddlong(1,1) = 'Model interpolated potential temperature'
+         fbdata%caddlong(1,2) = 'Model interpolated practical salinity'
+         fbdata%caddunit(1,1) = 'Degrees centigrade'
+         fbdata%caddunit(1,2) = 'PSU'
+         fbdata%cgrid(:)      = 'T'
+         DO je = 1, iext
+            fbdata%cextname(1+je) = pext%cdname(je)
+            fbdata%cextlong(1+je) = pext%cdlong(je,1)
+            fbdata%cextunit(1+je) = pext%cdunit(je,1)
+         END DO
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            DO jvar = 1, 2
+               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
+               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
+            END DO
+         END DO
+
+      CASE('UVEL')
+
+         clfiletype='velfb'
+         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. )
+         fbdata%cname(1)      = profdata%cvars(1)
+         fbdata%cname(2)      = profdata%cvars(2)
+         fbdata%coblong(1)    = 'Zonal velocity'
+         fbdata%coblong(2)    = 'Meridional velocity'
+         fbdata%cobunit(1)    = 'm/s'
+         fbdata%cobunit(2)    = 'm/s'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated zonal velocity'
+         fbdata%caddlong(1,2) = 'Model interpolated meridional velocity'
+         fbdata%caddunit(1,1) = 'm/s'
+         fbdata%caddunit(1,2) = 'm/s'
+         fbdata%cgrid(1)      = 'U' 
+         fbdata%cgrid(2)      = 'V'
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      END SELECT
+
+      fbdata%caddname(1)   = 'Hx'
+
+      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_prof :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfb data structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         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, iadd
+                  fbdata%padd(ik,jo,1+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, iext
+                  fbdata%pext(ik,jo,1+je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+               IF ( ( jvar == 1 ) .AND. &
+                  & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN
+                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1)
+               ENDIF 
+            END DO
+         END DO
+      END DO
+
+      IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN
+         ! Convert insitu temperature to potential temperature using the model
+         ! salinity if no potential temperature
+         DO jo = 1, fbdata%nobs
+            IF ( fbdata%pphi(jo) < 9999.0 ) THEN
+               DO jk = 1, fbdata%nlev
+                  IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. &
+                     & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
+                     & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. &
+                     & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN
+                     zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
+                        &              REAL(fbdata%pphi(jo),wp) )
+                     fbdata%pob(jk,jo,1) = potemp( &
+                        &                     REAL(fbdata%padd(jk,jo,1,2), wp),  &
+                        &                     REAL(fbdata%pext(jk,jo,1), wp), &
+                        &                     zpres, 0.0_wp )
+                  ENDIF
+               END DO
+            ENDIF
+         END DO
+      ENDIF
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( clfname, fbdata )
+
+      ! Output some basic statistics
+      CALL obs_wri_stats( fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_prof
+
+   SUBROUTINE obs_wri_surf( surfdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_surf  ***
+      !!
+      !! ** Purpose : Write surface observation files
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-03  (K. Mogensen) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!      ! 15-02  (M. Martin) Combined surface writing routine.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data
+      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info
+
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: clfname         ! netCDF filename
+      CHARACTER(LEN=6)  :: clfiletype
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: iadd
+      INTEGER :: iext
+
+      IF ( PRESENT( padd ) ) THEN
+         iadd = padd%inum
+      ELSE
+         iadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         iext = pext%inum
+      ELSE
+         iext = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      SELECT CASE ( TRIM(surfdata%cvars(1)) )
+      CASE('SLA')
+
+         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
+            &                 2 + iadd, 1 + iext, .TRUE. )
+
+         clfiletype = 'slafb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea level anomaly'
+         fbdata%cobunit(1)    = 'Metres'
+         fbdata%cextname(1)   = 'MDT'
+         fbdata%cextlong(1)   = 'Mean dynamic topography'
+         fbdata%cextunit(1)   = 'Metres'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT'
+         fbdata%caddunit(1,1) = 'Metres' 
+         fbdata%caddname(2)   = 'SSH'
+         fbdata%caddlong(2,1) = 'Model Sea surface height'
+         fbdata%caddunit(2,1) = 'Metres'
+         fbdata%cgrid(1)      = 'T'
+         DO ja = 1, iadd
+            fbdata%caddname(2+ja) = padd%cdname(ja)
+            fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      CASE('SST')
+
+         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
+            &                 1 + iadd, iext, .TRUE. )
+
+         clfiletype = 'sstfb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea surface temperature'
+         fbdata%cobunit(1)    = 'Degree centigrade'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated SST'
+         fbdata%caddunit(1,1) = 'Degree centigrade'
+         fbdata%cgrid(1)      = 'T'
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      CASE('ICECON')
+
+         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &
+            &                 1 + iadd, iext, .TRUE. )
+
+         clfiletype = 'sicfb'
+         fbdata%cname(1)      = surfdata%cvars(1)
+         fbdata%coblong(1)    = 'Sea ice'
+         fbdata%cobunit(1)    = 'Fraction'
+         DO je = 1, iext
+            fbdata%cextname(je) = pext%cdname(je)
+            fbdata%cextlong(je) = pext%cdlong(je,1)
+            fbdata%cextunit(je) = pext%cdunit(je,1)
+         END DO
+         fbdata%caddlong(1,1) = 'Model interpolated ICE'
+         fbdata%caddunit(1,1) = 'Fraction'
+         fbdata%cgrid(1)      = 'T'
+         DO ja = 1, iadd
+            fbdata%caddname(1+ja) = padd%cdname(ja)
+            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+         END DO
+
+      END SELECT
+
+      fbdata%caddname(1)   = 'Hx'
+
+      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_surf :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname)
+      ENDIF
+
+      ! Transform surf data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, surfdata%nsurf
+         fbdata%plam(jo)      = surfdata%rlam(jo)
+         fbdata%pphi(jo)      = surfdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') surfdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( surfdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = surfdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = surfdata%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)     = surfdata%cwmo(jo)
+         fbdata%kindex(jo)    = surfdata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = surfdata%mi(jo)
+            fbdata%iobsj(jo,1) = surfdata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(surfdata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           surfdata%nmin(jo), &
+            &           surfdata%nhou(jo), &
+            &           surfdata%nday(jo), &
+            &           surfdata%nmon(jo), &
+            &           surfdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1)
+         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1)
+         fbdata%pob(1,jo,1)    = surfdata%robs(jo,1) 
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( surfdata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = surfdata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = surfdata%nqc(jo)
+            fbdata%ivlqc(1,jo,1)    = surfdata%nqc(jo)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2)
+         DO ja = 1, iadd
+            fbdata%padd(1,jo,2+ja,1) = &
+               & surfdata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, iext
+            fbdata%pext(1,jo,1+je) = &
+               & surfdata%rext(jo,pext%ipoint(je))
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( clfname, fbdata )
+
+      ! Output some basic statistics
+      CALL obs_wri_stats( fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_surf
+
+   SUBROUTINE obs_wri_stats( fbdata )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_stats  ***
+      !!
+      !! ** Purpose : Output some basic statistics of the data being written out
+      !!
+      !! ** Method  :
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 2014-08  (D. Lea) Initial version 
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata
+
+      !! * Local declarations
+      INTEGER :: jvar
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: inumgoodobs
+      INTEGER :: inumgoodobsmpp
+      REAL(wp) :: zsumx
+      REAL(wp) :: zsumx2
+      REAL(wp) :: zomb
+      
+
+      IF (lwp) THEN
+         WRITE(numout,*) ''
+         WRITE(numout,*) 'obs_wri_stats :'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      ENDIF
+
+      DO jvar = 1, fbdata%nvar
+         zsumx=0.0_wp
+         zsumx2=0.0_wp
+         inumgoodobs=0
+         DO jo = 1, fbdata%nobs
+            DO jk = 1, fbdata%nlev
+               IF ( ( fbdata%pob(jk,jo,jvar) < 9999.0 ) .AND. &
+                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
+                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN
+
+                  zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)
+                  zsumx=zsumx+zomb
+                  zsumx2=zsumx2+zomb**2
+                  inumgoodobs=inumgoodobs+1
+               ENDIF
+            ENDDO
+         ENDDO
+
+         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp )
+         CALL mpp_sum(zsumx)
+         CALL mpp_sum(zsumx2)
+
+         IF (lwp) THEN
+            WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp 
+            WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp
+            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp )
+            WRITE(numout,*) ''
+         ENDIF
+
+      ENDDO
+
+   END SUBROUTINE obs_wri_stats
+
+END MODULE obs_write
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 8732)
@@ -0,0 +1,270 @@
+MODULE albedo
+   !!======================================================================
+   !!                       ***  MODULE  albedo  ***
+   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
+   !!=====================================================================
+   !! History :  8.0  ! 2001-04  (LIM 1.0)
+   !!   NEMO     1.0  ! 2003-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
+   !!             -   ! 2004-11  (C. Talandier)  add albedo_init
+   !!             -   ! 2001-06  (M. Vancoppenolle) LIM 3.0
+   !!             -   ! 2006-08  (G. Madec)  cleaning for surface module
+   !!            3.6  ! 2016-01  (C. Rousset) new parameterization for sea ice albedo
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   albedo_ice    : albedo for   ice (clear and overcast skies)
+   !!   albedo_oce    : albedo for ocean (clear and overcast skies)
+   !!   albedo_init   : initialisation of albedo computation
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   albedo_ice   ! routine called sbcice_lim.F90
+   PUBLIC   albedo_oce   ! routine called by ???
+
+   INTEGER  ::   albd_init = 0      !: control flag for initialization
+  
+   REAL(wp) ::   rmue     = 0.40    !  cosine of local solar altitude
+   REAL(wp) ::   ralb_oce = 0.066   ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001)
+   REAL(wp) ::   c1       = 0.05    ! snow thickness (only for nn_ice_alb=0)
+   REAL(wp) ::   c2       = 0.10    !  "        "
+   REAL(wp) ::   rcloud   = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0)
+ 
+   !                             !!* namelist namsbc_alb
+   INTEGER  ::   nn_ice_alb
+   REAL(wp) ::   rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pa_ice_cs, pa_ice_os )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE albedo_ice  ***
+      !!          
+      !! ** Purpose :   Computation of the albedo of the snow/ice system 
+      !!       
+      !! ** Method  :   Two schemes are available (from namelist parameter nn_ice_alb)
+      !!                  0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies
+      !!                  1: the scheme is "home made" (for cloudy skies) and based on Brandt et al. (J. Climate 2005)
+      !!                                                                           and Grenfell & Perovich (JGR 2004)
+      !!                Description of scheme 1:
+      !!                  1) Albedo dependency on ice thickness follows the findings from Brandt et al (2005)
+      !!                     which are an update of Allison et al. (JGR 1993) ; Brandt et al. 1999
+      !!                     0-5cm  : linear function of ice thickness
+      !!                     5-150cm: log    function of ice thickness
+      !!                     > 150cm: constant
+      !!                  2) Albedo dependency on snow thickness follows the findings from Grenfell & Perovich (2004)
+      !!                     i.e. it increases as -EXP(-snw_thick/0.02) during freezing and -EXP(-snw_thick/0.03) during melting
+      !!                  3) Albedo dependency on clouds is speculated from measurements of Grenfell and Perovich (2004)
+      !!                     i.e. cloudy-clear albedo depend on cloudy albedo following a 2d order polynomial law
+      !!                  4) The needed 4 parameters are: dry and melting snow, freezing ice and bare puddled ice
+      !!
+      !! ** Note    :   The parameterization from Shine & Henderson-Sellers presents several misconstructions:
+      !!                  1) ice albedo when ice thick. tends to 0 is different than ocean albedo
+      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger 
+      !!                     under melting conditions than under freezing conditions
+      !!                  3) the evolution of ice albedo as a function of ice thickness shows  
+      !!                     3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic
+      !!
+      !! References :   Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250.
+      !!                Brandt et al. 2005, J. Climate, vol 18
+      !!                Grenfell & Perovich 2004, JGR, vol 109 
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin)
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_snw      !  snow thickness
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_cs   !  albedo of ice under clear    sky
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os   !  albedo of ice under overcast sky
+      !!
+      INTEGER  ::   ji, jj, jl         ! dummy loop indices
+      INTEGER  ::   ijpl               ! number of ice categories (3rd dim of ice input arrays)
+      REAL(wp)            ::   zswitch, z1_c1, z1_c2
+      REAL(wp)                            ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalb_it             ! intermediate variable & albedo of ice (snow free)
+      !!---------------------------------------------------------------------
+
+      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories
+      
+      CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it )
+
+      IF( albd_init == 0 )   CALL albedo_init      ! initialization 
+      
+      SELECT CASE ( nn_ice_alb )
+
+      !------------------------------------------
+      !  Shine and Henderson-Sellers (1985)
+      !------------------------------------------
+      CASE( 0 )
+       
+         !  Computation of ice albedo (free of snow)
+         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = rn_alb_imlt
+         ELSE WHERE                                              ;   zalb(:,:,:) = rn_alb_idry
+         END  WHERE
+      
+         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
+         ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 )
+         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zalb_it = 0.2467 + 0.7049 * ph_ice              &
+            &                                                                 - 0.8608 * ph_ice * ph_ice     &
+            &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice
+         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice
+         END WHERE
+     
+         DO jl = 1, ijpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! freezing snow
+                  ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2
+                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) )
+                  zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  &
+                     &                           + ph_snw(ji,jj,jl) * ( rn_alb_sdry - zalb_it(ji,jj,jl) ) / c1  )   &
+                     &        +         zswitch   * rn_alb_sdry  
+
+                  ! melting snow
+                  ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2
+                  zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) )
+                  zalb_sm = ( 1._wp - zswitch ) * ( rn_alb_imlt + ph_snw(ji,jj,jl) * ( rn_alb_smlt - rn_alb_imlt ) / c2 )   &
+                      &     +         zswitch   *   rn_alb_smlt 
+                  !
+                  ! snow albedo
+                  zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zalb_st  =  zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
+               
+                  ! Ice/snow albedo
+                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
+                  pa_ice_cs(ji,jj,jl) =  zswitch * zalb_st + ( 1._wp - zswitch ) * zalb_it(ji,jj,jl)
+                  !
+               END DO
+            END DO
+         END DO
+
+         pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud       ! Oberhuber correction for overcast sky
+
+      !------------------------------------------
+      !  New parameterization (2016)
+      !------------------------------------------
+      CASE( 1 ) 
+
+! compilation of values from literature
+!        rn_alb_sdry = 0.85      ! dry snow
+!        rn_alb_smlt = 0.75      ! melting snow
+!        rn_alb_idry = 0.60      ! bare frozen ice
+! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved
+!        rn_alb_sdry = 0.85      ! dry snow
+!        rn_alb_smlt = 0.72      ! melting snow
+!        rn_alb_idry = 0.65      ! bare frozen ice
+! Brandt et al 2005 (East Antarctica)
+!        rn_alb_sdry = 0.87      ! dry snow
+!        rn_alb_smlt = 0.82      ! melting snow
+!        rn_alb_idry = 0.54      ! bare frozen ice
+! 
+         !  Computation of ice albedo (free of snow)
+         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
+         z1_c2 = 1. / 0.05
+         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = rn_alb_imlt
+         ELSE WHERE                                              ;   zalb = rn_alb_idry
+         END  WHERE
+         
+         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb
+         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = zalb     + ( 0.18 - zalb     ) * z1_c1 *  &
+            &                                                                     ( LOG(1.5) - LOG(ph_ice) )
+         ELSE WHERE                                       ;  zalb_it = ralb_oce + ( 0.18 - ralb_oce ) * z1_c2 * ph_ice
+         END WHERE
+
+         z1_c1 = 1. / 0.02
+         z1_c2 = 1. / 0.03
+         !  Computation of the snow/ice albedo
+         DO jl = 1, ijpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zalb_sf = rn_alb_sdry - ( rn_alb_sdry - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 );
+                  zalb_sm = rn_alb_smlt - ( rn_alb_smlt - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 );
+
+                  ! snow albedo
+                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )   
+                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf
+
+                  ! Ice/snow albedo   
+                  zswitch             = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) )
+                  pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch *  zalb_it(ji,jj,jl)
+
+              END DO
+            END DO
+         END DO
+         ! Effect of the clouds (2d order polynomial)
+         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 
+
+      END SELECT
+      
+      CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it )
+      !
+   END SUBROUTINE albedo_ice
+
+
+   SUBROUTINE albedo_oce( pa_oce_os , pa_oce_cs )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE albedo_oce  ***
+      !! 
+      !! ** Purpose :   Computation of the albedo of the ocean
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky
+      !!
+      REAL(wp) :: zcoef 
+      !!----------------------------------------------------------------------
+      !
+      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982
+      pa_oce_cs(:,:) = zcoef 
+      pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972
+      !
+   END SUBROUTINE albedo_oce
+
+
+   SUBROUTINE albedo_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE albedo_init  ***
+      !!
+      !! ** Purpose :   initializations for the albedo parameters
+      !!
+      !! ** Method  :   Read the namelist namsbc_alb
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt
+      !!----------------------------------------------------------------------
+      !
+      albd_init = 1                     ! indicate that the initialization has been done
+      !
+      REWIND( numnam_ref )              ! Namelist namsbc_alb in reference namelist : Albedo parameters
+      READ  ( numnam_ref, namsbc_alb, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_alb in configuration namelist : Albedo parameters
+      READ  ( numnam_cfg, namsbc_alb, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_alb )
+      !
+      IF(lwp) THEN                      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'albedo : set albedo parameters'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namsbc_alb : albedo '
+         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb  = ', nn_ice_alb
+         WRITE(numout,*) '      albedo of dry snow                                  rn_alb_sdry = ', rn_alb_sdry
+         WRITE(numout,*) '      albedo of melting snow                              rn_alb_smlt = ', rn_alb_smlt
+         WRITE(numout,*) '      albedo of dry ice                                   rn_alb_idry = ', rn_alb_idry
+         WRITE(numout,*) '      albedo of bare puddled ice                          rn_alb_imlt = ', rn_alb_imlt
+      ENDIF
+      !
+   END SUBROUTINE albedo_init
+
+   !!======================================================================
+END MODULE albedo
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 8732)
@@ -0,0 +1,571 @@
+MODULE cpl_oasis3
+   !!======================================================================
+   !!                    ***  MODULE cpl_oasis  ***
+   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
+   !!=====================================================================
+   !! History :  1.0  !  2004-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
+   !!             -   !  2004-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
+   !!             -   !  2004-11  (V. Gayler, MPI M&D) Grid writing
+   !!            2.0  !  2005-08  (R. Redler, W. Park) frld initialization, paral(2) revision
+   !!             -   !  2005-09  (R. Redler) extended to allow for communication over root only
+   !!             -   !  2006-01  (W. Park) modification of physical part
+   !!             -   !  2006-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!            3.4  !  2011-11  (C. Harris) Changes to allow mutiple category fields
+   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT
+   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3
+   !!----------------------------------------------------------------------
+   !!   cpl_init     : initialization of coupled mode communication
+   !!   cpl_define   : definition of grid and fields
+   !!   cpl_snd      : snd out fields in coupled mode
+   !!   cpl_rcv      : receive fields in coupled mode
+   !!   cpl_finalize : finalize the coupled mode communication
+   !!----------------------------------------------------------------------
+#if defined key_oasis3
+   USE mod_oasis                    ! OASIS3-MCT module
+#endif
+   USE par_oce                      ! ocean parameters
+   USE dom_oce                      ! ocean space and time domain
+   USE in_out_manager               ! I/O manager
+   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   cpl_init
+   PUBLIC   cpl_define
+   PUBLIC   cpl_snd
+   PUBLIC   cpl_rcv
+   PUBLIC   cpl_freq
+   PUBLIC   cpl_finalize
+
+   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field
+   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis
+   INTEGER                    ::   ncomp_id          ! id returned by oasis_init_comp
+   INTEGER                    ::   nerror            ! return error code
+#if ! defined key_oasis3
+   ! OASIS Variables not used. defined only for compilation purpose
+   INTEGER                    ::   OASIS_Out         = -1
+   INTEGER                    ::   OASIS_REAL        = -1
+   INTEGER                    ::   OASIS_Ok          = -1
+   INTEGER                    ::   OASIS_In          = -1
+   INTEGER                    ::   OASIS_Sent        = -1
+   INTEGER                    ::   OASIS_SentOut     = -1
+   INTEGER                    ::   OASIS_ToRest      = -1
+   INTEGER                    ::   OASIS_ToRestOut   = -1
+   INTEGER                    ::   OASIS_Recvd       = -1
+   INTEGER                    ::   OASIS_RecvOut     = -1
+   INTEGER                    ::   OASIS_FromRest    = -1
+   INTEGER                    ::   OASIS_FromRestOut = -1
+#endif
+
+   INTEGER                    ::   nrcv         ! total number of fields received 
+   INTEGER                    ::   nsnd         ! total number of fields sent 
+   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=55   ! Maximum number of coupling fields
+   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields
+   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields
+   
+   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, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models)
+      INTEGER               ::   nct       ! Number of categories in field
+      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received
+   END TYPE FLD_CPL
+
+   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields
+
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cpl_init( cd_modname, kl_comm )
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE cpl_init  ***
+      !!
+      !! ** Purpose :   Initialize coupled mode communication for ocean
+      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
+      !!
+      !! ** Method  :   OASIS3 MPI communication 
+      !!--------------------------------------------------------------------
+      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file
+      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model
+      !!--------------------------------------------------------------------
+
+      ! WARNING: No write in numout in this routine
+      !============================================
+
+      !------------------------------------------------------------------
+      ! 1st Initialize the OASIS system for the application
+      !------------------------------------------------------------------
+      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
+      IF ( nerror /= OASIS_Ok ) &
+         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
+
+      !------------------------------------------------------------------
+      ! 3rd Get an MPI communicator for OPA local communication
+      !------------------------------------------------------------------
+
+      CALL oasis_get_localcomm ( kl_comm, nerror )
+      IF ( nerror /= OASIS_Ok ) &
+         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
+      !
+   END SUBROUTINE cpl_init
+
+
+   SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE cpl_define  ***
+      !!
+      !! ** Purpose :   Define grid and field information for ocean
+      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
+      !!
+      !! ** Method  :   OASIS3 MPI communication 
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields
+      INTEGER, INTENT(in) ::   kcplmodel      ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+      !
+      INTEGER :: id_part
+      INTEGER :: paral(5)       ! OASIS3 box partition
+      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe
+      INTEGER :: ji,jc,jm       ! local loop indicees
+      CHARACTER(LEN=64) :: zclname
+      CHARACTER(LEN=2) :: cli2
+      !!--------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      ncplmodel = kcplmodel
+      IF( kcplmodel > nmaxcpl ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
+      ENDIF
+
+      nrcv = krcv
+      IF( nrcv > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
+
+      nsnd = ksnd
+      IF( nsnd > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
+      !
+      ! ... Define the shape for the area that excludes the halo
+      !     For serial configuration (key_mpp_mpi not being active)
+      !     nl* is set to the global values 1 and jp*glo.
+      !
+      ishape(:,1) = (/ 1, nlei-nldi+1 /)
+      ishape(:,2) = (/ 1, nlej-nldj+1 /)
+      !
+      ! ... Allocate memory for data exchange
+      !
+      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
+      IF( nerror > 0 ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN
+      ENDIF
+      !
+      ! -----------------------------------------------------------------
+      ! ... Define the partition 
+      ! -----------------------------------------------------------------
+      
+      paral(1) = 2                                              ! box partitioning
+      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset    
+      paral(3) = nlei-nldi+1                                    ! local extent in i 
+      paral(4) = nlej-nldj+1                                    ! local extent in j
+      paral(5) = jpiglo                                         ! global extent in x
+      
+      IF( ln_ctl ) THEN
+         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
+         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
+         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
+         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
+      ENDIF
+   
+      CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo )
+      !
+      ! ... Announce send variables. 
+      !
+      ssnd(:)%ncplmodel = kcplmodel
+      !
+      DO ji = 1, ksnd
+         IF ( ssnd(ji)%laction ) THEN
+
+            IF( ssnd(ji)%nct > nmaxcat ) THEN
+               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
+                  &              TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
+               RETURN
+            ENDIF
+            
+            DO jc = 1, ssnd(ji)%nct
+               DO jm = 1, kcplmodel
+
+                  IF ( ssnd(ji)%nct .GT. 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jc
+                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
+                  ELSE
+                     zclname = ssnd(ji)%clname
+                  ENDIF
+                  IF ( kcplmodel  > 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jm
+                     zclname = 'model'//cli2//'_'//TRIM(zclname)
+                  ENDIF
+#if defined key_agrif
+                  IF( agrif_fixed() /= 0 ) THEN 
+                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
+                  END IF
+#endif
+                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
+                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
+                     &                OASIS_Out          , ishape , OASIS_REAL, nerror )
+                  IF ( nerror /= OASIS_Ok ) THEN
+                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
+                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
+                  ENDIF
+                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+               END DO
+            END DO
+         ENDIF
+      END DO
+      !
+      ! ... Announce received variables. 
+      !
+      srcv(:)%ncplmodel = kcplmodel
+      !
+      DO ji = 1, krcv
+         IF ( srcv(ji)%laction ) THEN 
+            
+            IF( srcv(ji)%nct > nmaxcat ) THEN
+               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   &
+                  &              TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
+               RETURN
+            ENDIF
+            
+            DO jc = 1, srcv(ji)%nct
+               DO jm = 1, kcplmodel
+                  
+                  IF ( srcv(ji)%nct .GT. 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jc
+                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
+                  ELSE
+                     zclname = srcv(ji)%clname
+                  ENDIF
+                  IF ( kcplmodel  > 1 ) THEN
+                     WRITE(cli2,'(i2.2)') jm
+                     zclname = 'model'//cli2//'_'//TRIM(zclname)
+                  ENDIF
+#if defined key_agrif
+                  IF( agrif_fixed() /= 0 ) THEN 
+                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
+                  END IF
+#endif
+                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
+                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   &
+                     &                OASIS_In           , ishape , OASIS_REAL, nerror )
+                  IF ( nerror /= OASIS_Ok ) THEN
+                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
+                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
+                  ENDIF
+                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
+                  IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
+
+               END DO
+            END DO
+         ENDIF
+      END DO
+      
+      !------------------------------------------------------------------
+      ! End of definition phase
+      !------------------------------------------------------------------
+      
+      CALL oasis_enddef(nerror)
+      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
+      !
+   END SUBROUTINE cpl_define
+   
+   
+   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_snd  ***
+      !!
+      !! ** Purpose : - At each coupling time-step,this routine sends fields
+      !!      like sst or ice cover to the coupler or remote application.
+      !!----------------------------------------------------------------------
+      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
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata
+      !!
+      INTEGER                                   ::   jc,jm     ! local loop index
+      !!--------------------------------------------------------------------
+      !
+      ! snd data to OASIS3
+      !
+      DO jc = 1, ssnd(kid)%nct
+         DO jm = 1, ssnd(kid)%ncplmodel
+        
+            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
+               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
+               
+               IF ( ln_ctl ) THEN        
+                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   &
+                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN
+                     WRITE(numout,*) '****************'
+                     WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
+                     WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
+                     WRITE(numout,*) 'oasis_put:  kstep ', kstep
+                     WRITE(numout,*) 'oasis_put:   info ', kinfo
+                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
+                     WRITE(numout,*) '****************'
+                  ENDIF
+               ENDIF
+               
+            ENDIF
+            
+         ENDDO
+      ENDDO
+      !
+    END SUBROUTINE cpl_snd
+
+
+   SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_rcv  ***
+      !!
+      !! ** Purpose : - At each coupling time-step,this routine receives fields
+      !!      like stresses and fluxes from the coupler or remote application.
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
+      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask     ! coupling mask
+      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
+      !!
+      INTEGER                                   ::   jc,jm     ! local loop index
+      LOGICAL                                   ::   llaction, llfisrt
+      !!--------------------------------------------------------------------
+      !
+      ! receive local data from OASIS3 on every process
+      !
+      kinfo = OASIS_idle
+      !
+      DO jc = 1, srcv(kid)%nct
+         llfisrt = .TRUE.
+
+         DO jm = 1, srcv(kid)%ncplmodel
+
+            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
+
+               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )         
+               
+               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   &
+                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
+               
+               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
+               
+               IF ( llaction ) THEN
+                  
+                  kinfo = OASIS_Rcv
+                  IF( llfisrt ) THEN 
+                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
+                     llfisrt = .FALSE.
+                  ELSE
+                     pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
+                  ENDIF
+                  
+                  IF ( ln_ctl ) THEN        
+                     WRITE(numout,*) '****************'
+                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
+                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm)
+                     WRITE(numout,*) 'oasis_get:   kstep', kstep
+                     WRITE(numout,*) 'oasis_get:   info ', kinfo
+                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
+                     WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
+                     WRITE(numout,*) '****************'
+                  ENDIF
+                  
+               ENDIF
+               
+            ENDIF
+            
+         ENDDO
+
+         !--- Fill the overlap areas and extra hallows (mpp)
+         !--- check periodicity conditions (all cases)
+         IF( .not. llfisrt )   CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
+ 
+      ENDDO
+      !
+   END SUBROUTINE cpl_rcv
+
+
+   INTEGER FUNCTION cpl_freq( cdfieldname )  
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_freq  ***
+      !!
+      !! ** Purpose : - send back the coupling frequency for a particular field
+      !!----------------------------------------------------------------------
+      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file
+      !!
+      INTEGER               :: id
+      INTEGER               :: info
+      INTEGER, DIMENSION(1) :: itmp
+      INTEGER               :: ji,jm     ! local loop index
+      INTEGER               :: mop
+      !!----------------------------------------------------------------------
+      cpl_freq = 0   ! defaut definition
+      id = -1        ! defaut definition
+      !
+      DO ji = 1, nsnd
+         IF (ssnd(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
+                     id = ssnd(ji)%nid(1,jm)
+                     mop = OASIS_Out
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      DO ji = 1, nrcv
+         IF (srcv(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
+                     id = srcv(ji)%nid(1,jm)
+                     mop = OASIS_In
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      !
+      IF( id /= -1 ) THEN
+#if defined key_oa3mct_v3
+         CALL oasis_get_freqs(id, mop, 1, itmp, info)
+#else
+         CALL oasis_get_freqs(id,      1, itmp, info)
+#endif
+         cpl_freq = itmp(1)
+      ENDIF
+      !
+   END FUNCTION cpl_freq
+
+
+   SUBROUTINE cpl_finalize
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_finalize  ***
+      !!
+      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
+      !!      called explicitly before cpl_init it will also close
+      !!      MPI communication.
+      !!----------------------------------------------------------------------
+      !
+      DEALLOCATE( exfld )
+      IF (nstop == 0) THEN
+         CALL oasis_terminate( nerror )         
+      ELSE
+         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
+      ENDIF       
+      !
+   END SUBROUTINE cpl_finalize
+
+#if ! defined key_oasis3
+
+   !!----------------------------------------------------------------------
+   !!   No OASIS Library          OASIS3 Dummy module...
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE oasis_init_comp(k1,cd1,k2)
+      CHARACTER(*), INTENT(in   ) ::  cd1
+      INTEGER     , INTENT(  out) ::  k1,k2
+      k1 = -1 ; k2 = -1
+      WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
+   END SUBROUTINE oasis_init_comp
+
+   SUBROUTINE oasis_abort(k1,cd1,cd2)
+      INTEGER     , INTENT(in   ) ::  k1
+      CHARACTER(*), INTENT(in   ) ::  cd1,cd2
+      WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
+   END SUBROUTINE oasis_abort
+
+   SUBROUTINE oasis_get_localcomm(k1,k2)
+      INTEGER     , INTENT(  out) ::  k1,k2
+      k1 = -1 ; k2 = -1
+      WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
+   END SUBROUTINE oasis_get_localcomm
+
+   SUBROUTINE oasis_def_partition(k1,k2,k3,k4)
+      INTEGER     , INTENT(  out) ::  k1,k3
+      INTEGER     , INTENT(in   ) ::  k2(5)
+      INTEGER     , INTENT(in   ) ::  k4
+      k1 = k2(1) ; k3 = k2(5)+k4
+      WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
+   END SUBROUTINE oasis_def_partition
+
+   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
+      CHARACTER(*), INTENT(in   ) ::  cd1
+      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6
+      INTEGER     , INTENT(  out) ::  k1,k7
+      k1 = -1 ; k7 = -1
+      WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
+   END SUBROUTINE oasis_def_var
+
+   SUBROUTINE oasis_enddef(k1)
+      INTEGER     , INTENT(  out) ::  k1
+      k1 = -1
+      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
+   END SUBROUTINE oasis_enddef
+  
+   SUBROUTINE oasis_put(k1,k2,p1,k3)
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1
+      INTEGER                 , INTENT(in   ) ::  k1,k2
+      INTEGER                 , INTENT(  out) ::  k3
+      k3 = -1
+      WRITE(numout,*) 'oasis_put: Error you sould not be there...'
+   END SUBROUTINE oasis_put
+
+   SUBROUTINE oasis_get(k1,k2,p1,k3)
+      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1
+      INTEGER                 , INTENT(in   ) ::  k1,k2
+      INTEGER                 , INTENT(  out) ::  k3
+      p1(1,1) = -1. ; k3 = -1
+      WRITE(numout,*) 'oasis_get: Error you sould not be there...'
+   END SUBROUTINE oasis_get
+
+   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
+      INTEGER              , INTENT(in   ) ::  k1,k2
+      INTEGER, DIMENSION(1), INTENT(  out) ::  k3
+      INTEGER              , INTENT(  out) ::  k4
+      k3(1) = k1 ; k4 = k2
+      WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
+   END SUBROUTINE oasis_get_freqs
+
+   SUBROUTINE oasis_terminate(k1)
+      INTEGER     , INTENT(  out) ::  k1
+      k1 = -1
+      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
+   END SUBROUTINE oasis_terminate
+   
+#endif
+
+   !!=====================================================================
+END MODULE cpl_oasis3
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90	(revision 8732)
@@ -0,0 +1,280 @@
+MODULE cyclone
+   !!======================================================================
+   !!                       ***  MODULE  cyclone  ***
+   !! add the Tropical Cyclones along tracks to the surface wind forcing
+   !!                 
+   !!======================================================================
+   !! History : 3.3  ! 2010-05  (E Vincent, G Madec, S Masson)  Original code
+   !!----------------------------------------------------------------------
+
+#if defined key_cyclone
+   !!----------------------------------------------------------------------
+   !!  'key_cyclone' : key option add Tropical Cyclones in the wind forcing
+   !!----------------------------------------------------------------------
+   !!   wnd_cyc      : 1 module subroutine
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE dom_oce         ! ocean space domain variables
+   USE phycst          ! physical constant
+   USE fldread         ! read input fields
+   USE in_out_manager  ! I/O manager
+   USE geo2ocean       ! tools for projection on ORCA grid
+   USE wrk_nemo        ! work arrays
+   USE lib_mpp       
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   wnd_cyc   ! routine called in sbcblk.F90 module
+
+   INTEGER , PARAMETER ::   jp_is1  = 1   ! index of presence 1 or absence 0 of a TC record
+   INTEGER , PARAMETER ::   jp_lon  = 2   ! index of longitude for present TCs
+   INTEGER , PARAMETER ::   jp_lat  = 3   ! index of latitude  for present TCs
+   INTEGER , PARAMETER ::   jp_vmax = 4   ! index of max wind  for present TCs
+   INTEGER , PARAMETER ::   jp_pres = 5   ! index of eye-pres  for present TCs
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE wnd_cyc( kt, pwnd_i, pwnd_j )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE wnd_cyc  ***
+      !!
+      !! ** Purpose :  Add cyclone winds on the ORCA grid
+      !!
+      !! ** Action  : - open TC data, find TCs for the current timestep
+      !!              - for each potential TC, add the winds on the grid
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in)                      ::   kt       ! time step index 
+      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   pwnd_i   ! wind speed i-components at T-point ORCA direction
+      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   pwnd_j   ! wind speed j-components at T-point ORCA direction
+      ! 
+      !!
+      INTEGER  ::   ji, jj , jtc        ! loop arguments
+      INTEGER  ::   ierror              ! loop arguments
+      INTEGER  ::   vortex=1            ! vortex shape to be used: 0=Holland 1=Willoughby
+      REAL(wp) ::   zrout1=1.5e6        ! distance from center where we begin to kill vortex (m)
+      REAL(wp) ::   zrout2=2.5e6        ! distance from center where we bring vortex to zero (m)
+      REAL(wp) ::   zb                  ! power in Holland vortex shape
+      REAL(wp) ::   zA                  ! shape parameter in Willoughby vortex : A transtion between first and second outter exp
+      REAL(wp) ::   zn                  ! shape parameter in Willoughby vortex : n power law in the eye
+      REAL(wp) ::   zXX1                ! shape parameter in Willoughby vortex : decay length second outter exponential
+      REAL(wp) ::   zXX2                ! shape parameter in Willoughby vortex : decay length first  outter exponential
+      REAL(wp) ::   zztmp               ! temporary 
+      REAL(wp) ::   zzrglam, zzrgphi    ! temporary 
+      REAL(wp) ::   ztheta              ! azimuthal angle
+      REAL(wp) ::   zdist               ! dist to the TC center
+      REAL(wp) ::   zhemi               ! 1 for NH ;  -1 for SH
+      REAL(wp) ::   zinfl               ! clim inflow angle in TCs
+      REAL(wp) ::   zrmw                ! mean radius of Max wind of a tropical cyclone (Willoughby 2004) [m]
+      REAL(wp) ::   zwnd_r, zwnd_t      ! radial and tangential components of the wind
+      REAL(wp) ::   zvmax               ! timestep interpolated vmax
+      REAL(wp) ::   zrlon, zrlat        ! temporary 
+      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_x, zwnd_y   ! zonal and meridional components of the wind
+      REAL(wp), DIMENSION(14,5)    ::   ztct                ! tropical cyclone track data at kt
+      !
+      CHARACTER(len=100) ::  cn_dir            ! Root directory for location of files
+      TYPE(FLD_N), DIMENSION(1) ::   slf_i     ! array of namelist informations on the TC position
+      TYPE(FLD_N) ::   sn_tc                   ! informations about the fields to be read
+      !!--------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zwnd_x, zwnd_y )
+
+      !                                         ! ====================== !
+      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
+         !                                      ! ====================== !
+         ! set file information (default values)
+         cn_dir = './'       ! directory in which the model is executed
+         !
+         ! (NB: frequency positive => hours, negative => months)
+         !          !    file     ! frequency !  variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! land/sea mask !
+         !          !    name     !  (hours)  !   name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! filename      !
+         sn_tc = FLD_N( 'tc_track',     6     ,  'tc'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         , ''            )
+         !
+         !  Namelist is read in namsbc_blk
+         ! set sf structure
+         ALLOCATE( sf(1), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'wnd_cyc: unable to allocate sf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf(1)%fnow(14,5,1) )
+         ALLOCATE( sf(1)%fdta(14,5,1,2) )
+         slf_i(1) = sn_tc
+         !
+         ! fill sf with slf_i and control print
+         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_tc', 'tropical cyclone track', 'namsbc_tc' )
+         !
+      ENDIF
+
+
+      !       Interpolation of lon lat vmax... at the current timestep
+      !       ***************************************************************
+
+      CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step
+
+      ztct(:,:) = sf(1)%fnow(:,:,1)
+
+      !       Add TC wind on the grid
+      !       ***************************************************************
+
+      zwnd_x(:,:) = 0.e0  
+      zwnd_y(:,:) = 0.e0 
+      
+      DO jtc = 1, 14
+         !
+         IF( ztct(jtc,jp_is1) == 1 ) THEN                ! cyclone is defined in this slot ? yes--> begin
+
+            zvmax =       ztct(jtc,jp_vmax)
+            zrlon = rad * ztct(jtc,jp_lon )
+            zrlat = rad * ztct(jtc,jp_lat )
+            zhemi = SIGN( 1. , zrlat )
+            zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones
+         IF ( vortex == 0 ) THEN
+
+            ! Vortex Holland reconstruct wind at each lon-lat position
+            ! ********************************************************
+            zrmw = 51.6 * EXP( -0.0223*zvmax + 0.0281* ABS( ztct(jtc,jp_lat) ) ) * 1000.
+            ! climatological ZRMW of cyclones as a function of wind and latitude (Willoughby 2004)             
+            ! zb = 1.0036 + 0.0173 * zvmax - 0.0313 * LOG(zrmw/1000.) + 0.0087 * ABS( ztct(jtc,jp_lat) ) 
+            ! fitted B parameter (Willoughby 2004)
+            zb = 2.
+
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+
+                  ! calc distance between TC center and any point following great circle
+                  ! source : http://www.movable-type.co.uk/scripts/latlong.html
+                  zzrglam = rad * glamt(ji,jj) - zrlon
+                  zzrgphi = rad * gphit(ji,jj)
+                  zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
+                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
+
+                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
+                  ! shape of the wind profile
+                  zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb
+                  zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )    
+
+                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
+                  ENDIF
+
+                  ! !!! KILL EQ WINDS
+                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
+                  !    zztmp = 0.                              ! winds in other hemisphere
+                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+                  ! ENDIF
+                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
+                  !    !linear to zero between 10 and 5
+                  ! ENDIF
+                  ! !!! / KILL EQ
+
+                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+
+                  zwnd_t =   COS( zinfl ) * zztmp    
+                  zwnd_r = - SIN( zinfl ) * zztmp
+
+                  ! Project radial-tangential components on zonal-meridional components
+                  ! -------------------------------------------------------------------
+                  
+                  ! ztheta = azimuthal angle of the great circle between two points
+                  zztmp = COS( zrlat ) * SIN( zzrgphi ) &
+                     &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
+                  ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
+
+                  zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
+                  zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
+                 ENDIF
+               END DO
+            END DO
+         
+         ELSE IF ( vortex == 1 ) THEN
+
+            ! Vortex Willoughby reconstruct wind at each lon-lat position
+            ! ***********************************************************
+            zrmw = 46.4 * EXP( -0.0155*zvmax + 0.0169* ABS( ztct(jtc,jp_lat) ) )*1000.
+            ! climatological ZRMW of cyclones as a function of wind and latitude (Willoughby 2006)
+            zXX2 = 25.*1000.                                              ! 25km fixed "near-eye" exponential decay
+            zXX1 = ( 287.6  - 1.942 *zvmax + 7.799 *LOG(zrmw/1000.) + 1.819 *ABS( ztct(jtc,jp_lat) ) )*1000.    
+            zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )            
+            zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )  
+            IF (zA < 0) THEN 
+               zA=0
+            ENDIF           
+        
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                                  
+                  zzrglam = rad * glamt(ji,jj) - zrlon
+                  zzrgphi = rad * gphit(ji,jj)
+                  zdist = ra * ACOS(  SIN( zrlat ) * SIN( zzrgphi )   &
+                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) )
+
+                 IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius
+               
+                  ! shape of the wind profile                     
+                  IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind
+                     zztmp  = zvmax * (zdist/zrmw)**zn
+                  ELSE 
+                     zztmp  = zvmax * ( (1-zA) * EXP(- (zdist-zrmw)/zXX1 ) + zA * EXP(- (zdist-zrmw)/zXX2 ) )
+                  ENDIF
+
+                  IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2
+                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 )
+                  ENDIF
+
+                  ! !!! KILL EQ WINDS
+                  ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN
+                  !    zztmp = 0.                              ! winds in other hemisphere
+                  !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S
+                  ! ENDIF
+                  ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN
+                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) ) 
+                  !    !linear to zero between 10 and 5
+                  ! ENDIF
+                  ! !!! / KILL EQ
+
+                  IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude
+
+                  zwnd_t =   COS( zinfl ) * zztmp    
+                  zwnd_r = - SIN( zinfl ) * zztmp
+
+                  ! Project radial-tangential components on zonal-meridional components
+                  ! -------------------------------------------------------------------
+                  
+                  ! ztheta = azimuthal angle of the great circle between two points
+                  zztmp = COS( zrlat ) * SIN( zzrgphi ) &
+                     &  - SIN( zrlat ) * COS( zzrgphi ) * COS( zzrglam )
+                  ztheta = ATAN2(        COS( zzrgphi ) * SIN( zzrglam ) , zztmp )
+
+                  zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r
+                  zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r
+                  
+                 ENDIF
+               END DO
+            END DO
+         ENDIF                                         ! / vortex Holland or Wiloughby
+         ENDIF                                           ! / cyclone is defined in this slot ? yes--> begin
+      END DO ! / end simultaneous cyclones loop
+
+      CALL rot_rep ( zwnd_x, zwnd_y, 'T', 'en->i', pwnd_i ) !rotation of components on ORCA grid
+      CALL rot_rep ( zwnd_x, zwnd_y, 'T', 'en->j', pwnd_j ) !rotation of components on ORCA grid
+
+      CALL wrk_dealloc( jpi,jpj, zwnd_x, zwnd_y )
+
+   END SUBROUTINE wnd_cyc
+
+#endif
+
+   !!======================================================================
+END MODULE cyclone
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 8732)
@@ -0,0 +1,1922 @@
+MODULE fldread
+   !!======================================================================
+   !!                       ***  MODULE  fldread  ***
+   !! Ocean forcing:  read input field for surface boundary condition
+   !!=====================================================================
+   !! History :  2.0  !  2006-06  (S. Masson, G. Madec)  Original code
+   !!            3.0  !  2008-05  (S. Alderson)  Modified for Interpolation in memory from input grid to model grid
+   !!            3.4  !  2013-10  (D. Delrosso, P. Oddo)  suppression of land point prior to interpolation
+   !!                 !  12-2015  (J. Harle) Adding BDY on-the-fly interpolation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   fld_read      : read input fields used for the computation of the surface boundary condition
+   !!   fld_init      : initialization of field read
+   !!   fld_rec       : determined the record(s) to be read
+   !!   fld_get       : read the data
+   !!   fld_map       : read global data from file and map onto local data using a general mapping (use for open boundaries)
+   !!   fld_rot       : rotate the vector fields onto the local grid direction
+   !!   fld_clopn     : update the data file name and close/open the files
+   !!   fld_fill      : fill the data structure with the associated information read in namelist
+   !!   wgt_list      : manage the weights used for interpolation
+   !!   wgt_print     : print the list of known weights
+   !!   fld_weight    : create a WGT structure and fill in data from file, restructuring as required
+   !!   apply_seaoverland : fill land with ocean values
+   !!   seaoverland   : create shifted matrices for seaoverland application
+   !!   fld_interp    : apply weights to input gridded data to create data on model grid
+   !!   ksec_week     : function returning the first 3 letters of the first day of the weekly file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE sbc_oce        ! surface boundary conditions : fields
+   USE geo2ocean      ! for vector rotation on to model grid
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE ioipsl  , ONLY : ymds2ju, ju2ymds   ! for calendar
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE lbclnk         ! ocean lateral boundary conditions (C1D case)
+   
+   IMPLICIT NONE
+   PRIVATE   
+ 
+   PUBLIC   fld_map    ! routine called by tides_init
+   PUBLIC   fld_read, fld_fill   ! called by sbc... modules
+   PUBLIC   fld_clopn
+
+   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
+      CHARACTER(len = 256) ::   clname      ! generic name of the NetCDF flux file
+      REAL(wp)             ::   nfreqh      ! frequency of each flux file
+      CHARACTER(len = 34)  ::   clvar       ! generic name of the variable in the NetCDF flux file
+      LOGICAL              ::   ln_tint     ! time interpolation or not (T/F)
+      LOGICAL              ::   ln_clim     ! climatology or not (T/F)
+      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 256) ::   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  
+      CHARACTER(len = 34)  ::   lname       ! generic name of a NetCDF land/sea mask file to be used, blank if not 
+      !                                     ! 0=sea 1=land
+   END TYPE FLD_N
+
+   TYPE, PUBLIC ::   FLD        !: Input field related variables
+      CHARACTER(len = 256)            ::   clrootname   ! generic name of the NetCDF file
+      CHARACTER(len = 256)            ::   clname       ! current name of the NetCDF file
+      REAL(wp)                        ::   nfreqh       ! frequency of each flux file
+      CHARACTER(len = 34)             ::   clvar        ! generic name of the variable in the NetCDF flux file
+      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F)
+      LOGICAL                         ::   ln_clim      ! climatology or not (T/F)
+      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
+      INTEGER                         ::   num          ! iom id of the jpfld files to be read
+      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
+      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 before/after field has been rotated
+      INTEGER                         ::   nreclast     ! last record to be read in the current file
+      CHARACTER(len = 256)            ::   lsmname      ! current name of the NetCDF mask file acting as a key
+      INTEGER                         ::   igrd         ! grid type for bdy data
+      INTEGER                         ::   ibdy         ! bdy set id number
+   END TYPE FLD
+
+   TYPE, PUBLIC ::   MAP_POINTER      !: Map from input data file to local domain
+      INTEGER, POINTER, DIMENSION(:)  ::  ptr           ! Array of integer pointers to 1D arrays
+      LOGICAL                         ::  ll_unstruc    ! Unstructured (T) or structured (F) boundary data file
+   END TYPE MAP_POINTER
+
+!$AGRIF_DO_NOT_TREAT
+
+   !! keep list of all weights variables so they're only read in once
+   !! need to add AGRIF directives not to process this structure
+   !! also need to force wgtname to include AGRIF nest number
+   TYPE         ::   WGT        !: Input weights related variables
+      CHARACTER(len = 256)                    ::   wgtname      ! current name of the NetCDF weight file
+      INTEGER , DIMENSION(2)                  ::   ddims        ! shape of input grid
+      INTEGER , DIMENSION(2)                  ::   botleft      ! top left corner of box in input grid containing 
+      !                                                         ! current processor grid
+      INTEGER , DIMENSION(2)                  ::   topright     ! top right corner of box 
+      INTEGER                                 ::   jpiwgt       ! width of box on input grid
+      INTEGER                                 ::   jpjwgt       ! height of box on input grid
+      INTEGER                                 ::   numwgt       ! number of weights (4=bilinear, 16=bicubic)
+      INTEGER                                 ::   nestid       ! for agrif, keep track of nest we're in
+      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
+      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     ::   col          ! temporary array for reading in columns
+   END TYPE WGT
+
+   INTEGER,     PARAMETER             ::   tot_wgts = 10
+   TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts
+   INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array
+   REAL(wp), PARAMETER                ::   undeff_lsm = -999.00_wp
+
+!$AGRIF_END_DO_NOT_TREAT
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy, fvl )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_read  ***
+      !!                   
+      !! ** Purpose :   provide at each time step the surface ocean fluxes
+      !!                (momentum, heat, freshwater and runoff) 
+      !!
+      !! ** Method  :   READ each input fields in NetCDF files using IOM
+      !!      and intepolate it to the model time-step.
+      !!         Several assumptions are made on the input file:
+      !!      blahblahblah....
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
+      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
+      TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping indices
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   kit       ! subcycle timestep for timesplitting option
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   kt_offset ! provide fields at time other than "now"
+      !                                                     !   kt_offset = -1 => fields at "before" time level
+      !                                                     !   kt_offset = +1 => fields at "after"  time level
+      !                                                     !   etc.
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   jpk_bdy   ! number of vertical levels in the BDY data
+      LOGICAL  , INTENT(in   ), OPTIONAL     ::   fvl   ! number of vertical levels in the BDY data
+      !!
+      INTEGER  ::   itmp         ! local variable
+      INTEGER  ::   imf          ! size of the structure sd
+      INTEGER  ::   jf           ! dummy indices
+      INTEGER  ::   isecend      ! number of second since Jan. 1st 00h of nit000 year at nitend
+      INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
+      INTEGER  ::   it_offset    ! local time offset variable
+      LOGICAL  ::   llnxtyr      ! open next year  file?
+      LOGICAL  ::   llnxtmth     ! open next month file?
+      LOGICAL  ::   llstop       ! stop is the file does not exist
+      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields
+      REAL(wp) ::   ztinta       ! ratio applied to after  records when doing time interpolation
+      REAL(wp) ::   ztintb       ! ratio applied to before records when doing time interpolation
+      CHARACTER(LEN=1000) ::   clfmt  ! write format
+      TYPE(MAP_POINTER)   ::   imap   ! global-to-local mapping indices
+      !!---------------------------------------------------------------------
+      ll_firstcall = kt == nit000
+      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1
+
+      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      ELSE                                      ;   it_offset = 0
+      ENDIF
+      IF( PRESENT(kt_offset) )   it_offset = kt_offset
+
+      imap%ptr => NULL()
+
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      IF( present(kit) ) THEN   ! ignore kn_fsbc in this case
+         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) )
+      ELSE                      ! middle of sbc time step
+         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt)
+      ENDIF
+      imf = SIZE( sd )
+      !
+      IF( ll_firstcall ) THEN                      ! initialization
+         DO jf = 1, imf 
+            IF( PRESENT(map) ) imap = map(jf)
+               IF( PRESENT(jpk_bdy) ) THEN
+                  CALL fld_init( kn_fsbc, sd(jf), imap, jpk_bdy, fvl )  ! read each before field (put them in after as they will be swapped)
+               ELSE
+                  CALL fld_init( kn_fsbc, sd(jf), imap )  ! read each before field (put them in after as they will be swapped)
+               ENDIF
+         END DO
+         IF( lwp ) CALL wgt_print()                ! control print
+      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. ll_firstcall ) THEN    ! read/update the after data?
+
+               IF( PRESENT(map) )   imap = map(jf)   ! temporary definition of map
+
+               sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)                                  ! swap before record informations
+               sd(jf)%rotn(1) = sd(jf)%rotn(2)                                      ! swap before rotate informations
+               IF( sd(jf)%ln_tint )   sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! swap before record field
+
+               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations
+
+               ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd),
+               ! it is possible that the before value is no more the good one... we have to re-read it
+               ! if before is not the last record of the file currently opened and after is the first record to be read
+               ! in a new file which means after = 1 (the file to be opened corresponds to the current time)
+               ! or after = nreclast + 1 (the file to be opened corresponds to a future time step)
+               IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast &
+                  &                   .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN
+                  itmp = sd(jf)%nrec_a(1)                       ! temporary storage
+                  sd(jf)%nrec_a(1) = sd(jf)%nreclast            ! read the last record of the file currently opened
+                  CALL fld_get( sd(jf), imap )                  ! read after data
+                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
+                  sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
+                  sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%nfreqh * 3600 )  ! assume freq to be in hours in this case
+                  sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
+                  sd(jf)%nrec_a(1) = itmp                       ! move back to after record 
+               ENDIF
+
+               CALL fld_clopn( sd(jf) )   ! Do we need to open a new year/month/week/day file?
+               
+               IF( sd(jf)%ln_tint ) THEN
+                  
+                  ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd),
+                  ! it is possible that the before value is no more the good one... we have to re-read it
+                  ! if before record is not just just before the after record...
+                  IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 &
+                     &                   .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN   
+                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1       ! move back to before record
+                     CALL fld_get( sd(jf), imap )                  ! read after data
+                     sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field
+                     sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations
+                     sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%nfreqh * 3600 )  ! assume freq to be in hours in this case
+                     sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations
+                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record
+                  ENDIF
+
+                  ! do we have to change the year/month/week/day of the forcing field?? 
+                  ! 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
+                  ! do we need next file data?
+                  IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN
+                     
+                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast   ! 
+                     
+                     IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN   ! close/open the current/new file
+                        
+                        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(rdt)   ! second at the end of the run
+                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
+                        ! we suppose that the date of next file is next day (should be ok even for weekly files...)
+                        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) )       ! back to the current year/month/day
+                           sd(jf)%nrec_a(1) = sd(jf)%nreclast     ! force to read the last record in the current year file
+                        ENDIF
+                        
+                     ENDIF
+                  ENDIF   ! open need next file?
+                  
+               ENDIF   ! temporal interpolation?
+
+               ! read after data
+               IF( PRESENT(jpk_bdy) ) THEN
+                  CALL fld_get( sd(jf), imap, jpk_bdy, fvl)
+               ELSE
+                  CALL fld_get( sd(jf), imap )
+               ENDIF
+            ENDIF   ! read new data?
+         END DO                                    ! --- end loop over field --- !
+
+         CALL fld_rot( kt, sd )                    ! rotate vector before/now/after fields if needed
+
+         DO jf = 1, imf                            ! ---   loop over field   --- !
+            !
+            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation
+               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
+                  clfmt = "('   fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')"
+                  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
+                  WRITE(numout, *) '      it_offset is : ',it_offset
+               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
+               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,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')"
+                  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
+            ENDIF
+            !
+            IF( kt == nitend - kn_fsbc + 1 )   CALL iom_close( sd(jf)%num )   ! Close the input files
+
+         END DO                                    ! --- end loop over field --- !
+         !
+      ENDIF
+      !
+   END SUBROUTINE fld_read
+
+
+   SUBROUTINE fld_init( kn_fsbc, sdjf, map , jpk_bdy, fvl)
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_init  ***
+      !!
+      !! ** Purpose :  - first call to fld_rec to define before values
+      !!               - if time interpolation, read before data 
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   ) ::   kn_fsbc      ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout) ::   sdjf         ! input field related variables
+      TYPE(MAP_POINTER),INTENT(in) ::   map      ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL :: jpk_bdy ! number of vertical levels in the BDY data
+      LOGICAL  , INTENT(in), OPTIONAL :: fvl     ! number of vertical levels in the BDY data
+      !!
+      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
+      !!---------------------------------------------------------------------
+      llprevyr   = .FALSE.
+      llprevmth  = .FALSE.
+      llprevweek = .FALSE.
+      llprevday  = .FALSE.
+      isec_week  = 0
+      !
+      ! define record informations
+      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
+      !
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      !
+      IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
+         !
+         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
+            IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean
+               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%clrootname) )
+               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_a(1) = 12                                                      ! force to read december mean
+                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
+               ENDIF
+            ELSE                                ! higher frequency mean (in hours) 
+               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file
+                  sdjf%nrec_a(1) = NINT( 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(1:4) == 'week'    ) THEN   ! weekly file
+                  llprevweek = .TRUE.                                                      ! use previous week  file?
+                  sdjf%nrec_a(1) = NINT( 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) = NINT( 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_a(1) = NINT( 24 * nyear_len(0) / sdjf%nfreqh )                 ! last record of previous year 
+                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
+               ENDIF
+            ENDIF
+         ENDIF
+         !
+         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/week/day file: '//TRIM(sdjf%clrootname)//   &
+               &           ' 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_a(1) = 1
+            CALL fld_clopn( sdjf )
+         ENDIF
+         !
+         IF( llprev ) THEN   ! check if the record sdjf%nrec_a(1) exists in the file
+            idvar = iom_varid( sdjf%num, sdjf%clvar )                                        ! id of the variable sdjf%clvar
+            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_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
+         ENDIF
+         !
+         ! read before data in after arrays(as we will swap it later)
+         IF( PRESENT(jpk_bdy) ) THEN
+            CALL fld_get( sdjf, map, jpk_bdy, fvl )
+         ELSE
+            CALL fld_get( sdjf, map )
+         ENDIF
+         !
+         clfmt = "('   fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')"
+         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
+         !
+      ENDIF
+      !
+   END SUBROUTINE fld_init
+
+
+   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset )
+      !!---------------------------------------------------------------------
+      !!                    ***  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)
+      !!----------------------------------------------------------------------
+      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.)
+      INTEGER  , INTENT(in   ), OPTIONAL ::   kit       ! index of barotropic subcycle
+      !                                                 ! used only if sdjf%ln_tint = .TRUE.
+      INTEGER  , INTENT(in   ), OPTIONAL ::   kt_offset ! Offset of required time level compared to "now"
+      !                                                 !   time level in units of time steps.
+      !
+      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
+      INTEGER  ::   it_offset   ! local time offset variable
+      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 ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc
+      ELSE                                      ;   it_offset = 0
+      ENDIF
+      IF( PRESENT(kt_offset) )   it_offset = kt_offset
+      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
+      ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            )
+      ENDIF
+      !
+      !                                      ! =========== !
+      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( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 &
+           &       + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday )
+            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ! swap at the middle of the year
+            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + &
+                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 
+            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + &
+                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 
+            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
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    1 |    *----
+            !                    0 |----(              
+            !                      |----+----|--> time
+            !                      0   /|\   1   (nday/nmonth_len(nmonth))
+            !                           |   
+            !                           |   
+            !       forcing record :  nmonth 
+            !                            
+            ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 &
+           &       + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday )
+            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 = NINT( 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 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) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step
+         ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error 
+         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
+            !
+            !          INT( ztmp/ifreq_sec + 0.5 )
+            !                     /|\
+            !                    2 |        *-----(
+            !                    1 |  *-----(
+            !                    0 |--(              
+            !                      |--+--|--+--|--+--|--> time
+            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
+            !                         |     |     |
+            !                         |     |     |
+            !       forcing record :  1     2     3
+            !                   
+            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
+         ELSE                                   ! no time interpolation
+            !
+            !           INT( ztmp/ifreq_sec )
+            !                     /|\
+            !                    2 |           *-----(
+            !                    1 |     *-----(
+            !                    0 |-----(              
+            !                      |--+--|--+--|--+--|--> time
+            !                      0 /|\ 1 /|\ 2 /|\ 3    (ztmp/ifreq_sec)
+            !                         |     |     |
+            !                         |     |     |
+            !       forcing record :  1     2     3
+            !                            
+            ztmp= ztmp / REAL(ifreq_sec, wp)
+         ENDIF
+         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record number 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
+      !
+   END SUBROUTINE fld_rec
+
+
+   SUBROUTINE fld_get( sdjf, map, jpk_bdy, fvl )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_get  ***
+      !!
+      !! ** Purpose :   read the data
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf   ! input field related variables
+      TYPE(MAP_POINTER), INTENT(in   ) ::   map    ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL  ::   jpk_bdy ! number of vertical levels in the bdy data
+      LOGICAL  , INTENT(in), OPTIONAL  ::   fvl     ! number of vertical levels in the bdy data
+      !
+      INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER ::   iw       ! index into wgts array
+      INTEGER ::   ipdom    ! index of the domain
+      INTEGER ::   idvar    ! variable ID
+      INTEGER ::   idmspc   ! number of spatial dimensions
+      LOGICAL ::   lmoor    ! C1D case: point data
+      !!---------------------------------------------------------------------
+      !
+      ipk = SIZE( sdjf%fnow, 3 )
+      !
+      IF( ASSOCIATED(map%ptr) ) THEN
+         IF( PRESENT(jpk_bdy) ) THEN
+            IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2),                &
+                                                        sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl )
+            ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ),                &
+                                                        sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl )
+            ENDIF
+         ELSE
+            IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )
+            ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map )
+            ENDIF
+         ENDIF        
+      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
+         CALL wgt_list( sdjf, iw )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2),          & 
+            &                                                                          sdjf%nrec_a(1), sdjf%lsmname )
+         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,:  ),          &
+            &                                                                          sdjf%nrec_a(1), sdjf%lsmname )
+         ENDIF
+      ELSE
+         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN   ;   ipdom = jpdom_data
+         ELSE                                   ;   ipdom = jpdom_unknown
+         ENDIF
+         ! C1D case: If product of spatial dimensions == ipk, then x,y are of
+         ! size 1 (point/mooring data): this must be read onto the central grid point
+         idvar  = iom_varid( sdjf%num, sdjf%clvar )
+         idmspc = iom_file ( sdjf%num )%ndims( idvar )
+         IF( iom_file( sdjf%num )%luld( idvar ) )   idmspc = idmspc - 1
+         lmoor  = (  idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk  )
+         !
+         SELECT CASE( ipk )
+         CASE(1)
+            IF( lk_c1d .AND. lmoor ) THEN
+               IF( sdjf%ln_tint ) THEN
+                  CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,2), sdjf%nrec_a(1) )
+                  CALL lbc_lnk( sdjf%fdta(:,:,1,2),'Z',1. )
+               ELSE
+                  CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1  ), sdjf%nrec_a(1) )
+                  CALL lbc_lnk( sdjf%fnow(:,:,1  ),'Z',1. )
+               ENDIF
+            ELSE
+               IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
+               ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
+               ENDIF
+            ENDIF
+         CASE DEFAULT
+            IF (lk_c1d .AND. lmoor ) THEN
+               IF( sdjf%ln_tint ) THEN
+                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) )
+                  CALL lbc_lnk( sdjf%fdta(:,:,:,2),'Z',1. )
+               ELSE
+                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,:  ), sdjf%nrec_a(1) )
+                  CALL lbc_lnk( sdjf%fnow(:,:,:  ),'Z',1. )
+               ENDIF
+            ELSE
+               IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+               ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+               ENDIF
+            ENDIF
+         END SELECT
+      ENDIF
+      !
+      sdjf%rotn(2) = .false.   ! vector not yet rotated
+      !
+   END SUBROUTINE fld_get
+
+   SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy, fvl )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_map  ***
+      !!
+      !! ** Purpose :   read global data from file and map onto local data
+      !!                using a general mapping (for open boundaries)
+      !!----------------------------------------------------------------------
+
+      USE bdy_oce, ONLY: ln_bdy, idx_bdy, dta_global, dta_global_z, dta_global_dz, dta_global2, dta_global2_z, dta_global2_dz                 ! workspace to read in global data arrays
+
+      INTEGER                   , INTENT(in ) ::   num     ! stream number
+      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta     ! output field on model grid (2 dimensional)
+      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice)
+      TYPE(MAP_POINTER)         , INTENT(in ) ::   map     ! global-to-local mapping indices
+      INTEGER  , INTENT(in), OPTIONAL         ::   igrd, ibdy, jpk_bdy  ! grid type, set number and number of vertical levels in the bdy data
+      LOGICAL  , INTENT(in), OPTIONAL         ::   fvl     ! grid type, set number and number of vertical levels in the bdy data
+      INTEGER                                 ::   jpkm1_bdy! number of vertical levels in the bdy data minus 1
+      !!
+      INTEGER                                 ::   ipi      ! length of boundary data on local process
+      INTEGER                                 ::   ipj      ! length of dummy dimension ( = 1 )
+      INTEGER                                 ::   ipk      ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                                 ::   ilendta  ! length of data in file
+      INTEGER                                 ::   idvar    ! variable ID
+      INTEGER                                 ::   ib, ik, ji, jj   ! loop counters
+      INTEGER                                 ::   ierr
+      REAL(wp)                                ::   fv          ! fillvalue 
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read    ! work space for global data
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_z  ! work space for global data
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_dz ! work space for global data
+      !!---------------------------------------------------------------------
+      !
+      ipi = SIZE( dta, 1 )
+      ipj = 1
+      ipk = SIZE( dta, 3 )
+      !
+      idvar   = iom_varid( num, clvar )
+      ilendta = iom_file(num)%dimsz(1,idvar)
+
+      IF ( ln_bdy ) THEN
+         ipj = iom_file(num)%dimsz(2,idvar)
+         IF( map%ll_unstruc) THEN   ! unstructured open boundary data file
+            dta_read => dta_global
+            IF( PRESENT(jpk_bdy) ) THEN
+               IF( jpk_bdy>0 ) THEN
+                  dta_read_z => dta_global_z
+                  dta_read_dz => dta_global_dz
+                  jpkm1_bdy = jpk_bdy-1
+               ENDIF
+            ENDIF
+         ELSE                       ! structured open boundary file
+            dta_read => dta_global2
+            IF( PRESENT(jpk_bdy) ) THEN
+               IF( jpk_bdy>0 ) THEN
+                  dta_read_z => dta_global2_z
+                  dta_read_dz => dta_global2_dz
+                  jpkm1_bdy = jpk_bdy-1
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+      IF(lwp) WRITE(numout,*) 'Dim size for ',        TRIM(clvar),' is ', ilendta
+      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk
+      !
+      SELECT CASE( ipk )
+      CASE(1)        ;   
+      CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec )
+         IF ( map%ll_unstruc) THEN ! unstructured open boundary data file
+            DO ib = 1, ipi
+              DO ik = 1, ipk
+                dta(ib,1,ik) =  dta_read(map%ptr(ib),1,ik)
+              END DO
+            END DO
+         ELSE ! we assume that this is a structured open boundary file
+            DO ib = 1, ipi
+               jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+               ji=map%ptr(ib)-(jj-1)*ilendta
+               DO ik = 1, ipk
+                  dta(ib,1,ik) =  dta_read(ji,jj,ik)
+               END DO
+            END DO
+         ENDIF
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Do we include something here to adjust barotropic velocities !
+      ! in case of a depth difference between bdy files and          !
+      ! bathymetry in the case ln_full_vel = .false. and jpk_bdy>0?  !
+      ! [as the enveloping and parital cells could change H]         !
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      CASE DEFAULT   ;
+
+      IF( PRESENT(jpk_bdy) .AND. jpk_bdy>0 ) THEN       ! boundary data not on model grid: vertical interpolation
+         CALL iom_getatt(num, '_FillValue', fv, cdvar=clvar )
+         dta_read(:,:,:) = -ABS(fv)
+         dta_read_z(:,:,:) = 0._wp
+         dta_read_dz(:,:,:) = 0._wp
+         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:jpk_bdy), nrec )
+         SELECT CASE( igrd )                  
+            CASE(1)
+               CALL iom_get ( num, jpdom_unknown, 'gdept', dta_read_z(1:ilendta,1:ipj,1:jpk_bdy) )
+               CALL iom_get ( num, jpdom_unknown, 'e3t',  dta_read_dz(1:ilendta,1:ipj,1:jpk_bdy) )
+            CASE(2)  
+               CALL iom_get ( num, jpdom_unknown, 'gdepu', dta_read_z(1:ilendta,1:ipj,1:jpk_bdy) )
+               CALL iom_get ( num, jpdom_unknown, 'e3u',  dta_read_dz(1:ilendta,1:ipj,1:jpk_bdy) )
+            CASE(3)
+               CALL iom_get ( num, jpdom_unknown, 'gdepv', dta_read_z(1:ilendta,1:ipj,1:jpk_bdy) )
+               CALL iom_get ( num, jpdom_unknown, 'e3v',  dta_read_dz(1:ilendta,1:ipj,1:jpk_bdy) )
+         END SELECT
+
+      IF ( ln_bdy ) & 
+         CALL fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta)
+
+      ELSE ! boundary data assumed to be on model grid
+         
+         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )                    
+         IF ( map%ll_unstruc) THEN ! unstructured open boundary data file
+            DO ib = 1, ipi
+              DO ik = 1, ipk
+                dta(ib,1,ik) =  dta_read(map%ptr(ib),1,ik)
+              END DO
+            END DO
+         ELSE ! we assume that this is a structured open boundary file
+            DO ib = 1, ipi
+               jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+               ji=map%ptr(ib)-(jj-1)*ilendta
+               DO ik = 1, ipk
+                  dta(ib,1,ik) =  dta_read(ji,jj,ik)
+               END DO
+            END DO
+         ENDIF
+      ENDIF ! PRESENT(jpk_bdy)
+      END SELECT
+
+   END SUBROUTINE fld_map
+   
+   SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta)
+
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_bdy_interp  ***
+      !!
+      !! ** Purpose :   on the fly vertical interpolation to allow the use of
+      !!                boundary data from non-native vertical grid
+      !!----------------------------------------------------------------------
+      USE bdy_oce, ONLY:  idx_bdy         ! indexing for map <-> ij transformation
+
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read      ! work space for global data
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read_z    ! work space for global data
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read_dz   ! work space for global data
+      REAL(wp) , INTENT(in)                                ::   fv            ! fillvalue and alternative -ABS(fv)
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta                        ! output field on model grid (2 dimensional)
+      TYPE(MAP_POINTER)         , INTENT(in ) ::   map                        ! global-to-local mapping indices
+      LOGICAL  , INTENT(in), OPTIONAL         ::   fvl                        ! grid type, set number and number of vertical levels in the bdy data
+      INTEGER  , INTENT(in)                   ::   igrd, ibdy, jpk_bdy        ! number of levels in bdy data
+      INTEGER  , INTENT(in)                   ::   ilendta                    ! length of data in file
+      !!
+      INTEGER                                 ::   ipi                        ! length of boundary data on local process
+      INTEGER                                 ::   ipj                        ! length of dummy dimension ( = 1 )
+      INTEGER                                 ::   ipk                        ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                                 ::   jpkm1_bdy                  ! number of levels in bdy data minus 1
+      INTEGER                                 ::   ib, ik, ikk                ! loop counters
+      INTEGER                                 ::   ji, jj, zij, zjj           ! temporary indices
+      REAL(wp)                                ::   zl, zi, zh                 ! tmp variable for current depth and interpolation factor
+      REAL(wp)                                ::   fv_alt, ztrans, ztrans_new ! fillvalue and alternative -ABS(fv)
+      CHARACTER (LEN=10)                      ::   ibstr
+      !!---------------------------------------------------------------------
+     
+
+      ipi       = SIZE( dta, 1 )
+      ipj       = SIZE( dta_read, 2 )
+      ipk       = SIZE( dta, 3 )
+      jpkm1_bdy = jpk_bdy-1
+      
+      fv_alt = -ABS(fv)  ! set _FillValue < 0 as we make use of MAXVAL and MAXLOC later
+      DO ib = 1, ipi
+            zij = idx_bdy(ibdy)%nbi(ib,igrd)
+            zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+         IF(narea==2) WRITE(*,*) 'MAPI', ib, igrd, map%ptr(ib), narea-1, zij, zjj
+      ENDDO
+      !
+      IF ( map%ll_unstruc ) THEN                            ! unstructured open boundary data file
+
+         DO ib = 1, ipi
+            DO ik = 1, jpk_bdy
+               IF( ( dta_read(map%ptr(ib),1,ik) == fv ) ) THEN
+                  dta_read_z(map%ptr(ib),1,ik)  = fv_alt ! safety: put fillvalue into external depth field so consistent with data
+                  dta_read_dz(map%ptr(ib),1,ik) = 0._wp  ! safety: put 0._wp into external thickness factors to ensure transport is correct
+               ENDIF
+            ENDDO
+         ENDDO 
+
+         DO ib = 1, ipi
+            zij = idx_bdy(ibdy)%nbi(ib,igrd)
+            zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+            zh  = SUM(dta_read_dz(map%ptr(ib),1,:) )
+            ! Warnings to flag differences in the input and model topgraphy - is this useful/necessary?
+            SELECT CASE( igrd )                         
+               CASE(1)
+                  IF( ABS( (zh - ht_n(zij,zjj)) / ht_n(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN
+                     WRITE(ibstr,"(I10.10)") map%ptr(ib) 
+                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%')
+                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t_n(zij,zjj,:), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj
+                  ENDIF
+               CASE(2)
+                  IF( ABS( (zh - hu_n(zij,zjj)) * r1_hu_n(zij,zjj)) * umask(zij,zjj,1) > 0.01_wp ) THEN
+                     WRITE(ibstr,"(I10.10)") map%ptr(ib) 
+                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%')
+                     IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u_n(zij,zjj,:), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), &
+                       &                hu_n(zij,zjj), map%ptr(ib), ib, zij, zjj, narea-1  , &
+                        &                dta_read(map%ptr(ib),1,:)
+                  ENDIF
+               CASE(3)
+                  IF( ABS( (zh - hv_n(zij,zjj)) * r1_hv_n(zij,zjj)) * vmask(zij,zjj,1) > 0.01_wp ) THEN
+                     WRITE(ibstr,"(I10.10)") map%ptr(ib) 
+                     CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%')
+                  ENDIF
+            END SELECT
+            DO ik = 1, ipk                      
+               SELECT CASE( igrd )                       
+                  CASE(1)
+                     zl =  gdept_n(zij,zjj,ik)                                          ! if using in step could use fsdept instead of gdept_n?
+                  CASE(2)
+                     IF(ln_sco) THEN
+                        zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij+1,zjj,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n?
+                     ELSE
+                        zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij+1,zjj,ik) ) 
+                     ENDIF
+                  CASE(3)
+                     IF(ln_sco) THEN
+                        zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij,zjj+1,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n?
+                     ELSE
+                        zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij,zjj+1,ik) )
+                     ENDIF
+               END SELECT
+               IF( zl < dta_read_z(map%ptr(ib),1,1) ) THEN                                         ! above the first level of external data
+                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,1)
+               ELSEIF( zl > MAXVAL(dta_read_z(map%ptr(ib),1,:),1) ) THEN                           ! below the last level of external data 
+                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,MAXLOC(dta_read_z(map%ptr(ib),1,:),1))
+               ELSE                                                                                ! inbetween : vertical interpolation between ikk & ikk+1
+                  DO ikk = 1, jpkm1_bdy                                                            ! when  gdept_n(ikk) < zl < gdept_n(ikk+1)
+                     IF( ( (zl-dta_read_z(map%ptr(ib),1,ikk)) * (zl-dta_read_z(map%ptr(ib),1,ikk+1)) <= 0._wp) &
+                    &    .AND. (dta_read_z(map%ptr(ib),1,ikk+1) /= fv_alt)) THEN
+                        zi           = ( zl - dta_read_z(map%ptr(ib),1,ikk) ) / &
+                       &               ( dta_read_z(map%ptr(ib),1,ikk+1) - dta_read_z(map%ptr(ib),1,ikk) )
+                        dta(ib,1,ik) = dta_read(map%ptr(ib),1,ikk) + &
+                       &               ( dta_read(map%ptr(ib),1,ikk+1) - dta_read(map%ptr(ib),1,ikk) ) * zi
+                     ENDIF
+                  END DO
+               ENDIF
+            END DO
+         END DO
+
+         IF(igrd == 2) THEN                                 ! do we need to adjust the transport term?
+            DO ib = 1, ipi
+              zij = idx_bdy(ibdy)%nbi(ib,igrd)
+              zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+              zh  = SUM(dta_read_dz(map%ptr(ib),1,:) )
+              ztrans = 0._wp
+              ztrans_new = 0._wp
+              DO ik = 1, jpk_bdy                            ! calculate transport on input grid
+                  ztrans     = ztrans     + dta_read(map%ptr(ib),1,ik) * dta_read_dz(map%ptr(ib),1,ik)
+              ENDDO
+              DO ik = 1, ipk                                ! calculate transport on model grid
+                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u_n(zij,zjj,ik) * umask(zij,zjj,ik)
+              ENDDO
+              DO ik = 1, ipk                                ! make transport correction
+                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data
+                    dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik)
+                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero
+                    IF( ABS(ztrans * r1_hu_n(zij,zjj)) > 0.01_wp ) &
+                   &   CALL ctl_warn('fld_bdy_interp: barotropic component of > 0.01 ms-1 found in baroclinic velocities at')
+                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hu_n(zij,zjj) * umask(zij,zjj,ik)
+                 ENDIF
+              ENDDO
+            ENDDO
+         ENDIF
+
+         IF(igrd == 3) THEN                                 ! do we need to adjust the transport term?
+            DO ib = 1, ipi
+              zij = idx_bdy(ibdy)%nbi(ib,igrd)
+              zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+              zh  = SUM(dta_read_dz(map%ptr(ib),1,:) )
+              ztrans = 0._wp
+              ztrans_new = 0._wp
+              DO ik = 1, jpk_bdy                            ! calculate transport on input grid
+                  ztrans     = ztrans     + dta_read(map%ptr(ib),1,ik) * dta_read_dz(map%ptr(ib),1,ik)
+              ENDDO
+              DO ik = 1, ipk                                ! calculate transport on model grid
+                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v_n(zij,zjj,ik) * vmask(zij,zjj,ik)
+              ENDDO
+              DO ik = 1, ipk                                ! make transport correction
+                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data
+                    dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik)
+                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero
+                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hv_n(zij,zjj) * vmask(zij,zjj,ik)
+                 ENDIF
+              ENDDO
+            ENDDO
+         ENDIF
+  
+      ELSE ! structured open boundary file
+
+         DO ib = 1, ipi
+            jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+            ji=map%ptr(ib)-(jj-1)*ilendta
+            DO ik = 1, jpk_bdy                      
+               IF( ( dta_read(ji,jj,ik) == fv ) ) THEN
+                  dta_read_z(ji,jj,ik)  = fv_alt ! safety: put fillvalue into external depth field so consistent with data
+                  dta_read_dz(ji,jj,ik) = 0._wp  ! safety: put 0._wp into external thickness factors to ensure transport is correct
+               ENDIF
+            ENDDO
+         ENDDO 
+       
+
+         DO ib = 1, ipi
+            jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+            ji=map%ptr(ib)-(jj-1)*ilendta
+            zij = idx_bdy(ibdy)%nbi(ib,igrd)
+            zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+            zh  = SUM(dta_read_dz(ji,jj,:) )
+            ! Warnings to flag differences in the input and model topgraphy - is this useful/necessary?
+            SELECT CASE( igrd )                         
+               CASE(1)
+                  IF( ABS( (zh - ht_n(zij,zjj)) / ht_n(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN
+                     WRITE(ibstr,"(I10.10)") map%ptr(ib) 
+                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%')
+                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t_n(zij,zjj,:), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj
+                  ENDIF
+               CASE(2)
+                  IF( ABS( (zh - hu_n(zij,zjj)) * r1_hu_n(zij,zjj)) * umask(zij,zjj,1) > 0.01_wp ) THEN
+                     WRITE(ibstr,"(I10.10)") map%ptr(ib) 
+                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%')
+                  ENDIF
+               CASE(3)
+                  IF( ABS( (zh - hv_n(zij,zjj)) * r1_hv_n(zij,zjj)) * vmask(zij,zjj,1) > 0.01_wp ) THEN
+                     WRITE(ibstr,"(I10.10)") map%ptr(ib) 
+                     CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%')
+                  ENDIF
+            END SELECT
+            DO ik = 1, ipk                      
+               SELECT CASE( igrd )                          ! coded for sco - need zco and zps option using min
+                  CASE(1)
+                     zl =  gdept_n(zij,zjj,ik)              ! if using in step could use fsdept instead of gdept_n?
+                  CASE(2)
+                     IF(ln_sco) THEN
+                        zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij+1,zjj,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n?
+                     ELSE
+                        zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij+1,zjj,ik) )
+                     ENDIF
+                  CASE(3)
+                     IF(ln_sco) THEN
+                        zl =  ( gdept_n(zij,zjj,ik) + gdept_n(zij,zjj+1,ik) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n?
+                     ELSE
+                        zl =  MIN( gdept_n(zij,zjj,ik), gdept_n(zij,zjj+1,ik) )
+                     ENDIF
+               END SELECT
+               IF( zl < dta_read_z(ji,jj,1) ) THEN                                      ! above the first level of external data
+                  dta(ib,1,ik) =  dta_read(ji,jj,1)
+               ELSEIF( zl > MAXVAL(dta_read_z(ji,jj,:),1) ) THEN                        ! below the last level of external data 
+                  dta(ib,1,ik) =  dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1))
+               ELSE                                                                     ! inbetween : vertical interpolation between ikk & ikk+1
+                  DO ikk = 1, jpkm1_bdy                                                 ! when  gdept_n(ikk) < zl < gdept_n(ikk+1)
+                     IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp) &
+                    &    .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN
+                        zi           = ( zl - dta_read_z(ji,jj,ikk) ) / &
+                       &               ( dta_read_z(ji,jj,ikk+1) - dta_read_z(ji,jj,ikk) )
+                        dta(ib,1,ik) = dta_read(ji,jj,ikk) + &
+                       &               ( dta_read(ji,jj,ikk+1) - dta_read(ji,jj,ikk) ) * zi
+                     ENDIF
+                  END DO
+               ENDIF
+            END DO
+         END DO
+
+         IF(igrd == 2) THEN                                 ! do we need to adjust the transport term?
+            DO ib = 1, ipi
+               jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+               ji=map%ptr(ib)-(jj-1)*ilendta
+               zij = idx_bdy(ibdy)%nbi(ib,igrd)
+               zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+               zh = SUM(dta_read_dz(ji,jj,:) )
+               ztrans = 0._wp
+               ztrans_new = 0._wp
+               DO ik = 1, jpk_bdy                            ! calculate transport on input grid
+                  ztrans = ztrans + dta_read(ji,jj,ik) * dta_read_dz(ji,jj,ik)
+               ENDDO
+               DO ik = 1, ipk                                ! calculate transport on model grid
+                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u_n(zij,zjj,ik) * umask(zij,zjj,ik)
+               ENDDO
+               DO ik = 1, ipk                                ! make transport correction
+                  IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data
+                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik)
+                  ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero
+                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik)
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+
+         IF(igrd == 3) THEN                                 ! do we need to adjust the transport term?
+            DO ib = 1, ipi
+               jj  = 1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+               ji  = map%ptr(ib)-(jj-1)*ilendta
+               zij = idx_bdy(ibdy)%nbi(ib,igrd)
+               zjj = idx_bdy(ibdy)%nbj(ib,igrd)
+               zh  = SUM(dta_read_dz(ji,jj,:) )
+               ztrans = 0._wp
+               ztrans_new = 0._wp
+               DO ik = 1, jpk_bdy                            ! calculate transport on input grid
+                  ztrans     = ztrans     + dta_read(ji,jj,ik) * dta_read_dz(ji,jj,ik)
+               ENDDO
+               DO ik = 1, ipk                                ! calculate transport on model grid
+                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v_n(zij,zjj,ik) * vmask(zij,zjj,ik)
+               ENDDO
+               DO ik = 1, ipk                                ! make transport correction
+                  IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data
+                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik)
+                  ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero
+                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik)
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+
+      ENDIF ! endif unstructured or structured
+
+   END SUBROUTINE fld_bdy_interp
+
+
+   SUBROUTINE fld_rot( kt, sd )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_rot  ***
+      !!
+      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kt   ! ocean time step
+      TYPE(FLD), DIMENSION(:), INTENT(inout) ::   sd   ! input field related variables
+      !
+      INTEGER ::   ju, jv, jk, jn  ! loop indices
+      INTEGER ::   imf             ! size of the structure sd
+      INTEGER ::   ill             ! character length
+      INTEGER ::   iv              ! indice of V component
+      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name
+      REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation
+      !!---------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,   utmp, vtmp )
+      !
+      !! (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 )
+         DO jn = 2-COUNT((/sd(ju)%ln_tint/)), 2
+            IF( ill > 0 .AND. .NOT. sd(ju)%rotn(jn) ) 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,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) )
+                           CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) )
+                           sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = 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(jn) = .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 DO
+      !
+      CALL wrk_dealloc( jpi,jpj,   utmp, vtmp )
+      !
+   END SUBROUTINE fld_rot
+
+
+   SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_clopn  ***
+      !!
+      !! ** Purpose :   update the file name and close/open the files
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kyear    ! year value
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kmonth   ! month value
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kday     ! day value
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      !
+      LOGICAL :: llprevyr              ! are we reading previous year  file?
+      LOGICAL :: llprevmth             ! are we reading previous month file?
+      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
+      INTEGER :: indexyr               ! year undex (O/1/2: previous/current/next)
+      INTEGER :: iyear_len, imonth_len ! length (days) of iyear and imonth             ! 
+      CHARACTER(len = 256)::   clname  ! temporary file name
+      !!----------------------------------------------------------------------
+      IF( PRESENT(kyear) ) THEN                             ! use given values 
+         iyear = kyear
+         imonth = kmonth
+         iday = kday
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
+            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )  
+            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
+            llprevyr   = llprevmth .AND. nmonth == 1
+            iyear  = nyear  - COUNT((/llprevyr /))
+            imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+            iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         ENDIF
+      ELSE                                                  ! use current day values
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week
+            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
+            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)
+      ENDIF
+
+      ! build the new filename if not climatological data
+      clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name
+      IF( .NOT. sdjf%ln_clim ) THEN   
+                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname          ), imonth   ! add month
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth   ! add month
+      ENDIF
+      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+            &                            WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), iday     ! add day
+      !
+      IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN   ! new file to be open 
+         !
+         sdjf%clname = TRIM(clname)
+         IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
+         CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
+         !
+         ! find the last record to be read -> update sdjf%nreclast
+         indexyr = iyear - nyear + 1
+         iyear_len = nyear_len( indexyr )
+         SELECT CASE ( indexyr )
+         CASE ( 0 )   ;   imonth_len = 31   ! previous year -> imonth = 12
+         CASE ( 1 )   ;   imonth_len = nmonth_len(imonth) 
+         CASE ( 2 )   ;   imonth_len = 31   ! next     year -> imonth = 1
+         END SELECT
+         !
+         ! last record to be read in the current file
+         IF    ( sdjf%nfreqh == -12 ) THEN                 ;   sdjf%nreclast = 1    !  yearly mean
+         ELSEIF( sdjf%nfreqh ==  -1 ) THEN                                          ! monthly mean
+            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 1
+            ELSE                                           ;   sdjf%nreclast = 12
+            ENDIF
+         ELSE                                                                       ! higher frequency mean (in hours)
+            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = NINT( 24 * imonth_len / sdjf%nfreqh )
+            ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = NINT( 24 * 7          / sdjf%nfreqh )
+            ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = NINT( 24              / sdjf%nfreqh )
+            ELSE                                           ;   sdjf%nreclast = NINT( 24 * iyear_len  / sdjf%nfreqh )
+            ENDIF
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE fld_clopn
+
+
+   SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam, knoprint )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_fill  ***
+      !!
+      !! ** Purpose :   fill the data structure (sdf) with the associated information 
+      !!              read in namelist (sdf_n) and control print
+      !!----------------------------------------------------------------------
+      TYPE(FLD)  , DIMENSION(:)          , INTENT(inout) ::   sdf        ! structure of input fields (file informations, fields read)
+      TYPE(FLD_N), DIMENSION(:)          , INTENT(in   ) ::   sdf_n      ! array of namelist information structures
+      CHARACTER(len=*)                   , INTENT(in   ) ::   cdir       ! Root directory for location of flx files
+      CHARACTER(len=*)                   , INTENT(in   ) ::   cdcaller   ! name of the calling routine
+      CHARACTER(len=*)                   , INTENT(in   ) ::   cdtitle    ! description of the calling routine 
+      CHARACTER(len=*)                   , INTENT(in   ) ::   cdnam      ! name of the namelist from which sdf_n comes
+      INTEGER                  , OPTIONAL, INTENT(in   ) ::   knoprint   ! no calling routine information printed
+      !
+      INTEGER  ::   jf   ! dummy indices
+      !!---------------------------------------------------------------------
+      !
+      DO jf = 1, SIZE(sdf)
+         sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname )
+         sdf(jf)%clname     = "not yet defined"
+         sdf(jf)%nfreqh     = sdf_n(jf)%nfreqh
+         sdf(jf)%clvar      = sdf_n(jf)%clvar
+         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint
+         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim
+         sdf(jf)%cltype     = sdf_n(jf)%cltype
+         sdf(jf)%num        = -1
+         sdf(jf)%wgtname    = " "
+         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname )
+         sdf(jf)%lsmname = " "
+         IF( LEN( TRIM(sdf_n(jf)%lname) ) > 0 )   sdf(jf)%lsmname = TRIM( cdir )//TRIM( sdf_n(jf)%lname )
+         sdf(jf)%vcomp      = sdf_n(jf)%vcomp
+         sdf(jf)%rotn(:)    = .TRUE.   ! pretend to be rotated -> won't try to rotate data before the first call to fld_get
+         IF( sdf(jf)%cltype(1:4) == 'week' .AND. nn_leapy == 0  )   &
+            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1')
+         IF( sdf(jf)%cltype(1:4) == 'week' .AND. sdf(jf)%ln_clim )   &
+            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.')
+         sdf(jf)%nreclast = -1 ! Set to non zero default value to avoid errors, is updated to meaningful value during fld_clopn
+      END DO
+      !
+      IF(lwp) THEN      ! control print
+         WRITE(numout,*)
+         IF( .NOT.PRESENT( knoprint) ) THEN
+            WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle )
+            WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /)
+         ENDIF
+         WRITE(numout,*) '   fld_fill : fill data structure with information from namelist '//TRIM( cdnam )
+         WRITE(numout,*) '   ~~~~~~~~'
+         WRITE(numout,*) '      list of files and frequency (>0: in hours ; <0 in months)'
+         DO jf = 1, SIZE(sdf)
+            WRITE(numout,*) '      root filename: '  , TRIM( sdf(jf)%clrootname ), '   variable name: ', TRIM( sdf(jf)%clvar )
+            WRITE(numout,*) '         frequency: '      ,       sdf(jf)%nfreqh      ,   &
+               &                  '   time interp: '    ,       sdf(jf)%ln_tint     ,   &
+               &                  '   climatology: '    ,       sdf(jf)%ln_clim
+            WRITE(numout,*) '         weights: '        , TRIM( sdf(jf)%wgtname    ),   &
+               &                  '   pairing: '        , TRIM( sdf(jf)%vcomp      ),   &
+               &                  '   data type: '      ,       sdf(jf)%cltype      ,   &
+               &                  '   land/sea mask:'   , TRIM( sdf(jf)%lsmname    )
+            call flush(numout)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE fld_fill
+
+
+   SUBROUTINE wgt_list( sd, kwgt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE wgt_list  ***
+      !!
+      !! ** Purpose :   search array of WGTs and find a weights file entry,
+      !!                or return a new one adding it to the end if new entry.
+      !!                the weights data is read in and restructured (fld_weight)
+      !!----------------------------------------------------------------------
+      TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file
+      INTEGER    , INTENT(inout) ::   kwgt      ! index of weights
+      !
+      INTEGER ::   kw, nestid   ! local integer
+      LOGICAL ::   found        ! local logical
+      !!----------------------------------------------------------------------
+      !
+      !! search down linked list 
+      !! weights filename is either present or we hit the end of the list
+      found = .FALSE.
+      !
+      !! because agrif nest part of filenames are now added in iom_open
+      !! to distinguish between weights files on the different grids, need to track
+      !! nest number explicitly
+      nestid = 0
+#if defined key_agrif
+      nestid = Agrif_Fixed()
+#endif
+      DO kw = 1, nxt_wgt-1
+         IF( TRIM(ref_wgts(kw)%wgtname) == TRIM(sd%wgtname) .AND. &
+             ref_wgts(kw)%nestid == nestid) THEN
+            kwgt = kw
+            found = .TRUE.
+            EXIT
+         ENDIF
+      END DO
+      IF( .NOT.found ) THEN
+         kwgt = nxt_wgt
+         CALL fld_weight( sd )
+      ENDIF
+      !
+   END SUBROUTINE wgt_list
+
+
+   SUBROUTINE wgt_print( )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE wgt_print  ***
+      !!
+      !! ** Purpose :   print the list of known weights
+      !!----------------------------------------------------------------------
+      INTEGER ::   kw   !
+      !!----------------------------------------------------------------------
+      !
+      DO kw = 1, nxt_wgt-1
+         WRITE(numout,*) 'weight file:  ',TRIM(ref_wgts(kw)%wgtname)
+         WRITE(numout,*) '      ddims:  ',ref_wgts(kw)%ddims(1),ref_wgts(kw)%ddims(2)
+         WRITE(numout,*) '     numwgt:  ',ref_wgts(kw)%numwgt
+         WRITE(numout,*) '     jpiwgt:  ',ref_wgts(kw)%jpiwgt
+         WRITE(numout,*) '     jpjwgt:  ',ref_wgts(kw)%jpjwgt
+         WRITE(numout,*) '    botleft:  ',ref_wgts(kw)%botleft
+         WRITE(numout,*) '   topright:  ',ref_wgts(kw)%topright
+         IF( ref_wgts(kw)%cyclic ) THEN
+            WRITE(numout,*) '       cyclical'
+            IF( ref_wgts(kw)%overlap > 0 ) WRITE(numout,*) '              with overlap of ', ref_wgts(kw)%overlap
+         ELSE
+            WRITE(numout,*) '       not cyclical'
+         ENDIF
+         IF( ASSOCIATED(ref_wgts(kw)%data_wgt) )  WRITE(numout,*) '       allocated'
+      END DO
+      !
+   END SUBROUTINE wgt_print
+
+
+   SUBROUTINE fld_weight( sd )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_weight  ***
+      !!
+      !! ** Purpose :   create a new WGT structure and fill in data from file,
+      !!              restructuring as required
+      !!----------------------------------------------------------------------
+      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file
+      !!
+      INTEGER ::   jn         ! dummy loop indices
+      INTEGER ::   inum       ! local logical unit
+      INTEGER ::   id         ! local variable id
+      INTEGER ::   ipk        ! local vertical dimension
+      INTEGER ::   zwrap      ! local integer
+      LOGICAL ::   cyclical   ! 
+      CHARACTER (len=5) ::   aname   !
+      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims
+      INTEGER , POINTER, DIMENSION(:,:) ::   data_src
+      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,   data_src )   ! integer
+      CALL wrk_alloc( jpi,jpj,   data_tmp )
+      !
+      IF( nxt_wgt > tot_wgts ) THEN
+        CALL ctl_stop("fld_weight: weights array size exceeded, increase tot_wgts")
+      ENDIF
+      !
+      !! new weights file entry, add in extra information
+      !! a weights file represents a 2D grid of a certain shape, so we assume that the current
+      !! input data file is representative of all other files to be opened and processed with the
+      !! current weights file
+
+      !! open input data file (non-model grid)
+      CALL iom_open( sd%clname, inum, ldiof =  LEN(TRIM(sd%wgtname)) > 0 )
+
+      !! get dimensions
+      IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+         ALLOCATE( ddims(4) )
+      ELSE
+         ALLOCATE( ddims(3) )
+      ENDIF
+      id = iom_varid( inum, sd%clvar, ddims )
+
+      !! close it
+      CALL iom_close( inum )
+
+      !! now open the weights file
+
+      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)%overlap = zwrap
+         ref_wgts(nxt_wgt)%cyclic = cyclical
+         ref_wgts(nxt_wgt)%nestid = 0
+#if defined key_agrif
+         ref_wgts(nxt_wgt)%nestid = Agrif_Fixed()
+#endif
+         !! weights file is stored as a set of weights (wgt01->wgt04 or wgt01->wgt16)
+         !! for each weight wgtNN there is an integer array srcNN which gives the point in
+         !! the input data grid which is to be multiplied by the weight
+         !! they are both arrays on the model grid so the result of the multiplication is
+         !! added into an output array on the model grid as a running sum
+
+         !! two possible cases: bilinear (4 weights) or bicubic (16 weights)
+         id = iom_varid(inum, 'src05', ldstop=.FALSE.)
+         IF( id <= 0) THEN
+            ref_wgts(nxt_wgt)%numwgt = 4
+         ELSE
+            ref_wgts(nxt_wgt)%numwgt = 16
+         ENDIF
+
+         ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(jpi,jpj,4) )
+         ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(jpi,jpj,4) )
+         ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(jpi,jpj,ref_wgts(nxt_wgt)%numwgt) )
+
+         DO jn = 1,4
+            aname = ' '
+            WRITE(aname,'(a3,i2.2)') 'src',jn
+            data_tmp(:,:) = 0
+            CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) )
+            data_src(:,:) = INT(data_tmp(:,:))
+            ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1)
+            ref_wgts(nxt_wgt)%data_jpi(:,:,jn) = data_src(:,:) - ref_wgts(nxt_wgt)%ddims(1)*(ref_wgts(nxt_wgt)%data_jpj(:,:,jn)-1)
+         END DO
+
+         DO jn = 1, ref_wgts(nxt_wgt)%numwgt
+            aname = ' '
+            WRITE(aname,'(a3,i2.2)') 'wgt',jn
+            ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0
+            CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) )
+         END DO
+         CALL iom_close (inum)
+ 
+         ! find min and max indices in grid
+         ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:))
+         ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:))
+         ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:))
+         ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:))
+
+         ! and therefore dimensions of the input box
+         ref_wgts(nxt_wgt)%jpiwgt = ref_wgts(nxt_wgt)%topright(1) - ref_wgts(nxt_wgt)%botleft(1) + 1
+         ref_wgts(nxt_wgt)%jpjwgt = ref_wgts(nxt_wgt)%topright(2) - ref_wgts(nxt_wgt)%botleft(2) + 1
+
+         ! shift indexing of source grid
+         ref_wgts(nxt_wgt)%data_jpi(:,:,:) = ref_wgts(nxt_wgt)%data_jpi(:,:,:) - ref_wgts(nxt_wgt)%botleft(1) + 1
+         ref_wgts(nxt_wgt)%data_jpj(:,:,:) = ref_wgts(nxt_wgt)%data_jpj(:,:,:) - ref_wgts(nxt_wgt)%botleft(2) + 1
+
+         ! create input grid, give it a halo to allow gradient calculations
+         ! 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
+         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
+         !
+      ELSE 
+         CALL ctl_stop( '    fld_weight : unable to read the file ' )
+      ENDIF
+
+      DEALLOCATE (ddims )
+
+      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer
+      CALL wrk_dealloc( jpi,jpj, data_tmp )
+      !
+   END SUBROUTINE fld_weight
+
+
+   SUBROUTINE apply_seaoverland( clmaskfile, zfieldo, jpi1_lsm, jpi2_lsm, jpj1_lsm,   &
+      &                          jpj2_lsm, itmpi, itmpj, itmpz, rec1_lsm, recn_lsm )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE apply_seaoverland  ***
+      !!
+      !! ** Purpose :   avoid spurious fluxes in coastal or near-coastal areas
+      !!                due to the wrong usage of "land" values from the coarse
+      !!                atmospheric model when spatial interpolation is required
+      !!      D. Delrosso INGV          
+      !!---------------------------------------------------------------------- 
+      INTEGER,                   INTENT(in   ) :: itmpi,itmpj,itmpz                    ! lengths
+      INTEGER,                   INTENT(in   ) :: jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm  ! temporary indices
+      INTEGER, DIMENSION(3),     INTENT(in   ) :: rec1_lsm,recn_lsm                    ! temporary arrays for start and length
+      REAL(wp),DIMENSION (:,:,:),INTENT(inout) :: zfieldo                              ! input/output array for seaoverland application
+      CHARACTER (len=100),       INTENT(in   ) :: clmaskfile                           ! land/sea mask file name
+      !
+      INTEGER :: inum,jni,jnj,jnz,jc   ! local indices
+      REAL(wp),DIMENSION (:,:,:),ALLOCATABLE :: zslmec1             ! local array for land point detection
+      REAL(wp),DIMENSION (:,:),  ALLOCATABLE :: zfieldn   ! array of forcing field with undeff for land points
+      REAL(wp),DIMENSION (:,:),  ALLOCATABLE :: zfield    ! array of forcing field
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE ( zslmec1(itmpi,itmpj,itmpz), zfieldn(itmpi,itmpj), zfield(itmpi,itmpj) )
+      !
+      ! Retrieve the land sea mask data
+      CALL iom_open( clmaskfile, inum )
+      SELECT CASE( SIZE(zfieldo(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) )
+      CASE(1)
+         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm)
+      CASE DEFAULT
+         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm)
+      END SELECT
+      CALL iom_close( inum )
+      !
+      DO jnz=1,rec1_lsm(3)             !! Loop over k dimension
+         !
+         DO jni = 1, itmpi                               !! copy the original field into a tmp array
+            DO jnj = 1, itmpj                            !! substituting undeff over land points
+               zfieldn(jni,jnj) = zfieldo(jni,jnj,jnz)
+               IF( zslmec1(jni,jnj,jnz) == 1. )   zfieldn(jni,jnj) = undeff_lsm
+            END DO
+         END DO
+         !
+         CALL seaoverland( zfieldn, itmpi, itmpj, zfield )
+         DO jc = 1, nn_lsm
+            CALL seaoverland( zfield, itmpi, itmpj, zfield )
+         END DO
+         !
+         !   Check for Undeff and substitute original values
+         IF( ANY(zfield==undeff_lsm) ) THEN
+            DO jni = 1, itmpi
+               DO jnj = 1, itmpj
+                  IF( zfield(jni,jnj)==undeff_lsm )   zfield(jni,jnj) = zfieldo(jni,jnj,jnz)
+               END DO
+            END DO
+         ENDIF
+         !
+         zfieldo(:,:,jnz) = zfield(:,:)
+         !
+      END DO                           !! End Loop over k dimension
+      !
+      DEALLOCATE ( zslmec1, zfieldn, zfield )
+      !
+   END SUBROUTINE apply_seaoverland 
+
+
+   SUBROUTINE seaoverland( zfieldn, ileni, ilenj, zfield )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE seaoverland  ***
+      !!
+      !! ** Purpose :   create shifted matrices for seaoverland application  
+      !!      D. Delrosso INGV
+      !!---------------------------------------------------------------------- 
+      INTEGER                      , INTENT(in   ) :: ileni,ilenj   ! lengths 
+      REAL, DIMENSION (ileni,ilenj), INTENT(in   ) :: zfieldn       ! array of forcing field with undeff for land points
+      REAL, DIMENSION (ileni,ilenj), INTENT(  out) :: zfield        ! array of forcing field
+      !
+      REAL   , DIMENSION (ileni,ilenj)   :: zmat1, zmat2, zmat3, zmat4  ! local arrays 
+      REAL   , DIMENSION (ileni,ilenj)   :: zmat5, zmat6, zmat7, zmat8  !   -     - 
+      REAL   , DIMENSION (ileni,ilenj)   :: zlsm2d                      !   -     - 
+      REAL   , DIMENSION (ileni,ilenj,8) :: zlsm3d                      !   -     -
+      LOGICAL, DIMENSION (ileni,ilenj,8) :: ll_msknan3d                 ! logical mask for undeff detection
+      LOGICAL, DIMENSION (ileni,ilenj)   :: ll_msknan2d                 ! logical mask for undeff detection
+      !!---------------------------------------------------------------------- 
+      zmat8 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(:,1)/)     , DIM=2 )
+      zmat1 = eoshift( zmat8   , SHIFT=-1 , BOUNDARY = (/zmat8(1,:)/)       , DIM=1 )
+      zmat2 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(1,:)/)     , DIM=1 )
+      zmat4 = eoshift( zfieldn , SHIFT= 1 , BOUNDARY = (/zfieldn(:,ilenj)/) , DIM=2 )
+      zmat3 = eoshift( zmat4   , SHIFT=-1 , BOUNDARY = (/zmat4(1,:)/)       , DIM=1 )
+      zmat5 = eoshift( zmat4   , SHIFT= 1 , BOUNDARY = (/zmat4(ileni,:)/)   , DIM=1 )
+      zmat6 = eoshift( zfieldn , SHIFT= 1 , BOUNDARY = (/zfieldn(ileni,:)/) , DIM=1 )
+      zmat7 = eoshift( zmat8   , SHIFT= 1 , BOUNDARY = (/zmat8(ileni,:)/)   , DIM=1 )
+      !
+      zlsm3d  = RESHAPE( (/ zmat1, zmat2, zmat3, zmat4, zmat5, zmat6, zmat7, zmat8 /), (/ ileni, ilenj, 8 /))
+      ll_msknan3d = .NOT.( zlsm3d  == undeff_lsm )
+      ll_msknan2d = .NOT.( zfieldn == undeff_lsm )  ! FALSE where is Undeff (land)
+      zlsm2d = SUM( zlsm3d, 3 , ll_msknan3d ) / MAX( 1 , COUNT( ll_msknan3d , 3 ) )
+      WHERE( COUNT( ll_msknan3d , 3 ) == 0._wp )   zlsm2d = undeff_lsm
+      zfield = MERGE( zfieldn, zlsm2d, ll_msknan2d )
+      !
+   END SUBROUTINE seaoverland
+
+
+   SUBROUTINE fld_interp( num, clvar, kw, kk, dta,  &
+                          &         nrec, lsmfile)      
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_interp  ***
+      !!
+      !! ** Purpose :   apply weights to input gridded data to create data
+      !!                on model grid
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   num     ! stream number
+      CHARACTER(LEN=*)          , INTENT(in   ) ::   clvar   ! variable name
+      INTEGER                   , INTENT(in   ) ::   kw      ! weights number
+      INTEGER                   , INTENT(in   ) ::   kk      ! vertical dimension of kk
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   dta     ! output field on model grid
+      INTEGER                   , INTENT(in   ) ::   nrec    ! record number to read (ie time slice)
+      CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name
+      !
+      INTEGER, DIMENSION(3) ::   rec1, recn           ! temporary arrays for start and length
+      INTEGER, DIMENSION(3) ::   rec1_lsm, recn_lsm   ! temporary arrays for start and length in case of seaoverland
+      INTEGER ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2    ! temporary indices
+      INTEGER ::   jk, jn, jm, jir, jjr               ! loop counters
+      INTEGER ::   ni, nj                             ! lengths
+      INTEGER ::   jpimin,jpiwid                      ! temporary indices
+      INTEGER ::   jpimin_lsm,jpiwid_lsm              ! temporary indices
+      INTEGER ::   jpjmin,jpjwid                      ! temporary indices
+      INTEGER ::   jpjmin_lsm,jpjwid_lsm              ! temporary indices
+      INTEGER ::   jpi1,jpi2,jpj1,jpj2                ! temporary indices
+      INTEGER ::   jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm   ! temporary indices
+      INTEGER ::   itmpi,itmpj,itmpz                     ! lengths
+      REAL(wp),DIMENSION(:,:,:), ALLOCATABLE ::   ztmp_fly_dta                 ! local array of values on input grid     
+      !!----------------------------------------------------------------------
+      !
+      !! for weighted interpolation we have weights at four corners of a box surrounding 
+      !! a model grid point, each weight is multiplied by a grid value (bilinear case)
+      !! or by a grid value and gradients at the corner point (bicubic case) 
+      !! so we need to have a 4 by 4 subgrid surrounding each model point to cover both cases
+
+      !! 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)
+      jpiwid = ref_wgts(kw)%jpiwgt
+      jpjwid = ref_wgts(kw)%jpjwgt
+
+      !! 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 )
+      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
+      jpi2 = jpi1 + recn(1) - 1
+      jpj2 = jpj1 + recn(2) - 1
+
+
+      IF( LEN( TRIM(lsmfile) ) > 0 ) THEN
+      !! indeces for ztmp_fly_dta
+      ! --------------------------
+         rec1_lsm(1)=MAX(rec1(1)-nn_lsm,1)  ! starting index for enlarged external data, x direction
+         rec1_lsm(2)=MAX(rec1(2)-nn_lsm,1)  ! starting index for enlarged external data, y direction
+         rec1_lsm(3) = 1                    ! vertical dimension
+         recn_lsm(1)=MIN(rec1(1)-rec1_lsm(1)+recn(1)+nn_lsm,ref_wgts(kw)%ddims(1)-rec1_lsm(1)) ! n points in x direction
+         recn_lsm(2)=MIN(rec1(2)-rec1_lsm(2)+recn(2)+nn_lsm,ref_wgts(kw)%ddims(2)-rec1_lsm(2)) ! n points in y direction
+         recn_lsm(3) = kk                   ! number of vertical levels in the input file
+
+      !  Avoid out of bound
+         jpimin_lsm = MAX( rec1_lsm(1)+1, 1 )
+         jpjmin_lsm = MAX( rec1_lsm(2)+1, 1 )
+         jpiwid_lsm = MIN( recn_lsm(1)-2,ref_wgts(kw)%ddims(1)-rec1(1)+1)
+         jpjwid_lsm = MIN( recn_lsm(2)-2,ref_wgts(kw)%ddims(2)-rec1(2)+1)
+
+         jpi1_lsm = 2+rec1_lsm(1)-jpimin_lsm
+         jpj1_lsm = 2+rec1_lsm(2)-jpjmin_lsm
+         jpi2_lsm = jpi1_lsm + recn_lsm(1) - 1
+         jpj2_lsm = jpj1_lsm + recn_lsm(2) - 1
+
+
+         itmpi=jpi2_lsm-jpi1_lsm+1
+         itmpj=jpj2_lsm-jpj1_lsm+1
+         itmpz=kk
+         ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz))
+         ztmp_fly_dta(:,:,:) = 0.0
+         SELECT CASE( SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) )
+         CASE(1)
+              CALL iom_get( num, jpdom_unknown, clvar, ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1),   &
+                 &                                                                nrec, rec1_lsm, recn_lsm)
+         CASE DEFAULT
+              CALL iom_get( num, jpdom_unknown, clvar, ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),   &
+                 &                                                                nrec, rec1_lsm, recn_lsm)
+         END SELECT
+         CALL apply_seaoverland(lsmfile,ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),                  &
+                 &                                      jpi1_lsm,jpi2_lsm,jpj1_lsm,jpj2_lsm,                  &
+                 &                                      itmpi,itmpj,itmpz,rec1_lsm,recn_lsm)
+
+
+         ! Relative indeces for remapping
+         ii_lsm1 = (rec1(1)-rec1_lsm(1))+1
+         ii_lsm2 = (ii_lsm1+recn(1))-1
+         ij_lsm1 = (rec1(2)-rec1_lsm(2))+1
+         ij_lsm2 = (ij_lsm1+recn(2))-1
+
+         ref_wgts(kw)%fly_dta(:,:,:) = 0.0
+         ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:) = ztmp_fly_dta(ii_lsm1:ii_lsm2,ij_lsm1:ij_lsm2,:)
+         DEALLOCATE(ztmp_fly_dta)
+
+      ELSE
+         
+         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 
+      ENDIF
+      
+
+      !! 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
+      DO jk = 1,4
+        DO jn = 1, jpj
+          DO jm = 1,jpi
+            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,:)
+          END DO
+        END DO
+      END DO
+
+      IF (ref_wgts(kw)%numwgt .EQ. 16) THEN
+
+        !! 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,:,:)
+        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,:,:)
+        ENDIF
+        IF( jpj1 == 2 ) THEN
+           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,:)
+        ENDIF
+
+        !! if data grid is cyclic we can do better on east-west edges
+        !! but have to allow for whether first and last columns are coincident
+        IF( ref_wgts(kw)%cyclic ) THEN
+           rec1(2) = MAX( jpjmin-1, 1 )
+           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) - 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 + 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
+
+        ! gradient in the i direction
+        DO jk = 1,4
+          DO jn = 1, jpj
+            DO jm = 1,jpi
+              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,:))
+            END DO
+          END DO
+        END DO
+
+        ! gradient in the j direction
+        DO jk = 1,4
+          DO jn = 1, jpj
+            DO jm = 1,jpi
+              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,:))
+            END DO
+          END DO
+        END DO
+
+         ! gradient in the ij direction
+         DO jk = 1,4
+            DO jn = 1, jpj
+               DO jm = 1,jpi
+                  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  ,:)))
+               END DO
+            END DO
+         END DO
+         !
+      END IF
+      !
+   END SUBROUTINE fld_interp
+
+
+   FUNCTION ksec_week( cdday )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION kshift_week *** 
+      !!
+      !! ** Purpose :   return the first 3 letters of the first day of the weekly file
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)   ::   cdday   ! first 3 letters of the first day of the weekly file
+      !!
+      INTEGER                        ::   ksec_week      ! output variable
+      INTEGER                        ::   ijul, ishift   ! local integer
+      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
+      END DO
+      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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 8732)
@@ -0,0 +1,466 @@
+MODULE geo2ocean
+   !!======================================================================
+   !!                     ***  MODULE  geo2ocean  ***
+   !! Ocean mesh    :  ???
+   !!======================================================================
+   !! History :  OPA  !  07-1996  (O. Marti)  Original code
+   !!   NEMO     1.0  !  06-2006  (G. Madec )  Free form, F90 + opt.
+   !!                 !  04-2007  (S. Masson)  angle: Add T, F points and bugfix in cos lateral boundary
+   !!            3.0  !  07-2008  (G. Madec)  geo2oce suppress lon/lat agruments
+   !!            3.7  !  11-2015  (G. Madec)  remove the unused repere and repcmo routines
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   rot_rep       : Rotate the Repere: geographic grid <==> stretched coordinates grid
+   !!   angle         :
+   !!   geo2oce       :
+   !!   oce2geo       :
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! mesh and scale factors
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   rot_rep   ! called in sbccpl, fldread, and cyclone
+   PUBLIC   geo2oce   ! called in sbccpl
+   PUBLIC   oce2geo   ! called in sbccpl
+   PUBLIC   obs_rot   ! called in obs_rot_vel and obs_write
+
+   !                                         ! cos/sin between model grid lines and NP direction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsint, gcost   ! at T point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsinu, gcosu   ! at U point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsinv, gcosv   ! at V point
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gsinf, gcosf   ! at F point
+
+   LOGICAL ,              SAVE, DIMENSION(4)     ::   linit = .FALSE.
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsinlon, gcoslon, gsinlat, gcoslat
+
+   LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (see above)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE rot_rep ( pxin, pyin, cd_type, cdtodo, prot )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE rot_rep  ***
+      !!
+      !! ** Purpose :   Rotate the Repere: Change vector componantes between
+      !!                geographic grid <--> stretched coordinates grid.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pxin, pyin   ! vector componantes
+      CHARACTER(len=1),             INTENT(in   ) ::   cd_type      ! define the nature of pt2d array grid-points
+      CHARACTER(len=5),             INTENT(in   ) ::   cdtodo       ! type of transpormation:
+      !                                                             ! 'en->i' = east-north to i-component
+      !                                                             ! 'en->j' = east-north to j-component
+      !                                                             ! 'ij->e' = (i,j) components to east
+      !                                                             ! 'ij->n' = (i,j) components to north
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prot      
+      !!----------------------------------------------------------------------
+      !
+      IF( lmust_init ) THEN      ! at 1st call only: set  gsin. & gcos.
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' rot_rep: coordinate transformation : geographic <==> model (i,j)-components'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~    '
+         !
+         CALL angle       ! initialization of the transformation
+         lmust_init = .FALSE.
+      ENDIF
+      !
+      SELECT CASE( cdtodo )      ! type of rotation
+      !
+      CASE( 'en->i' )                  ! east-north to i-component
+         SELECT CASE (cd_type)
+         CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) + pyin(:,:) * gsint(:,:)
+         CASE ('U')   ;   prot(:,:) = pxin(:,:) * gcosu(:,:) + pyin(:,:) * gsinu(:,:)
+         CASE ('V')   ;   prot(:,:) = pxin(:,:) * gcosv(:,:) + pyin(:,:) * gsinv(:,:)
+         CASE ('F')   ;   prot(:,:) = pxin(:,:) * gcosf(:,:) + pyin(:,:) * gsinf(:,:)
+         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
+         END SELECT
+      CASE ('en->j')                   ! east-north to j-component
+         SELECT CASE (cd_type)
+         CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) - pxin(:,:) * gsint(:,:)
+         CASE ('U')   ;   prot(:,:) = pyin(:,:) * gcosu(:,:) - pxin(:,:) * gsinu(:,:)
+         CASE ('V')   ;   prot(:,:) = pyin(:,:) * gcosv(:,:) - pxin(:,:) * gsinv(:,:)   
+         CASE ('F')   ;   prot(:,:) = pyin(:,:) * gcosf(:,:) - pxin(:,:) * gsinf(:,:)   
+         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
+         END SELECT
+      CASE ('ij->e')                   ! (i,j)-components to east
+         SELECT CASE (cd_type)
+         CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) - pyin(:,:) * gsint(:,:)
+         CASE ('U')   ;   prot(:,:) = pxin(:,:) * gcosu(:,:) - pyin(:,:) * gsinu(:,:)
+         CASE ('V')   ;   prot(:,:) = pxin(:,:) * gcosv(:,:) - pyin(:,:) * gsinv(:,:)
+         CASE ('F')   ;   prot(:,:) = pxin(:,:) * gcosf(:,:) - pyin(:,:) * gsinf(:,:)
+         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
+         END SELECT
+      CASE ('ij->n')                   ! (i,j)-components to north 
+         SELECT CASE (cd_type)
+         CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) + pxin(:,:) * gsint(:,:)
+         CASE ('U')   ;   prot(:,:) = pyin(:,:) * gcosu(:,:) + pxin(:,:) * gsinu(:,:)
+         CASE ('V')   ;   prot(:,:) = pyin(:,:) * gcosv(:,:) + pxin(:,:) * gsinv(:,:)
+         CASE ('F')   ;   prot(:,:) = pyin(:,:) * gcosf(:,:) + pxin(:,:) * gsinf(:,:)
+         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
+         END SELECT
+      CASE DEFAULT   ;   CALL ctl_stop( 'rot_rep: Syntax Error in the definition of cdtodo' )
+      !
+      END SELECT
+      !
+   END SUBROUTINE rot_rep
+
+
+   SUBROUTINE angle
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE angle  ***
+      !! 
+      !! ** Purpose :   Compute angles between model grid lines and the North direction
+      !!
+      !! ** Method  :   sinus and cosinus of the angle between the north-south axe 
+      !!              and the j-direction at t, u, v and f-points
+      !!                dot and cross products are used to obtain cos and sin, resp.
+      !!
+      !! ** Action  : - gsint, gcost, gsinu, gcosu, gsinv, gcosv, gsinf, gcosf
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      INTEGER  ::   ierr     ! local integer
+      REAL(wp) ::   zlam, zphi            ! local scalars
+      REAL(wp) ::   zlan, zphh            !   -      -
+      REAL(wp) ::   zxnpt, zynpt, znnpt   ! x,y components and norm of the vector: T point to North Pole
+      REAL(wp) ::   zxnpu, zynpu, znnpu   ! x,y components and norm of the vector: U point to North Pole
+      REAL(wp) ::   zxnpv, zynpv, znnpv   ! x,y components and norm of the vector: V point to North Pole
+      REAL(wp) ::   zxnpf, zynpf, znnpf   ! x,y components and norm of the vector: F point to North Pole
+      REAL(wp) ::   zxvvt, zyvvt, znvvt   ! x,y components and norm of the vector: between V points below and above a T point
+      REAL(wp) ::   zxffu, zyffu, znffu   ! x,y components and norm of the vector: between F points below and above a U point
+      REAL(wp) ::   zxffv, zyffv, znffv   ! x,y components and norm of the vector: between F points left  and right a V point
+      REAL(wp) ::   zxuuf, zyuuf, znuuf   ! x,y components and norm of the vector: between U points below and above a F point
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( gsint(jpi,jpj), gcost(jpi,jpj),   & 
+         &      gsinu(jpi,jpj), gcosu(jpi,jpj),   & 
+         &      gsinv(jpi,jpj), gcosv(jpi,jpj),   &  
+         &      gsinf(jpi,jpj), gcosf(jpi,jpj), STAT=ierr )
+      IF(lk_mpp)   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'angle: unable to allocate arrays' )
+      !
+      ! ============================= !
+      ! Compute the cosinus and sinus !
+      ! ============================= !
+      ! (computation done on the north stereographic polar plane)
+      !
+      DO jj = 2, jpjm1
+         DO ji = fs_2, jpi   ! vector opt.
+            !                  
+            zlam = glamt(ji,jj)     ! north pole direction & modulous (at t-point)
+            zphi = gphit(ji,jj)
+            zxnpt = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            zynpt = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            znnpt = zxnpt*zxnpt + zynpt*zynpt
+            !
+            zlam = glamu(ji,jj)     ! north pole direction & modulous (at u-point)
+            zphi = gphiu(ji,jj)
+            zxnpu = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            zynpu = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            znnpu = zxnpu*zxnpu + zynpu*zynpu
+            !
+            zlam = glamv(ji,jj)     ! north pole direction & modulous (at v-point)
+            zphi = gphiv(ji,jj)
+            zxnpv = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            zynpv = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            znnpv = zxnpv*zxnpv + zynpv*zynpv
+            !
+            zlam = glamf(ji,jj)     ! north pole direction & modulous (at f-point)
+            zphi = gphif(ji,jj)
+            zxnpf = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            zynpf = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            znnpf = zxnpf*zxnpf + zynpf*zynpf
+            !
+            zlam = glamv(ji,jj  )   ! j-direction: v-point segment direction (around t-point)
+            zphi = gphiv(ji,jj  )
+            zlan = glamv(ji,jj-1)
+            zphh = gphiv(ji,jj-1)
+            zxvvt =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zyvvt =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
+            znvvt = MAX( znvvt, 1.e-14 )
+            !
+            zlam = glamf(ji,jj  )   ! j-direction: f-point segment direction (around u-point)
+            zphi = gphif(ji,jj  )
+            zlan = glamf(ji,jj-1)
+            zphh = gphif(ji,jj-1)
+            zxffu =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zyffu =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
+            znffu = MAX( znffu, 1.e-14 )
+            !
+            zlam = glamf(ji  ,jj)   ! i-direction: f-point segment direction (around v-point)
+            zphi = gphif(ji  ,jj)
+            zlan = glamf(ji-1,jj)
+            zphh = gphif(ji-1,jj)
+            zxffv =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zyffv =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
+            znffv = MAX( znffv, 1.e-14 )
+            !
+            zlam = glamu(ji,jj+1)   ! j-direction: u-point segment direction (around f-point)
+            zphi = gphiu(ji,jj+1)
+            zlan = glamu(ji,jj  )
+            zphh = gphiu(ji,jj  )
+            zxuuf =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zyuuf =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
+            znuuf = MAX( znuuf, 1.e-14 )
+            !
+            !                       ! cosinus and sinus using dot and cross products
+            gsint(ji,jj) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
+            gcost(ji,jj) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
+            !
+            gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
+            gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
+            !
+            gsinf(ji,jj) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
+            gcosf(ji,jj) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
+            !
+            gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
+            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv     ! (caution, rotation of 90 degres)
+            !
+         END DO
+      END DO
+
+      ! =============== !
+      ! Geographic mesh !
+      ! =============== !
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, jpi   ! vector opt.
+            IF( MOD( ABS( glamv(ji,jj) - glamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
+               gsint(ji,jj) = 0.
+               gcost(ji,jj) = 1.
+            ENDIF
+            IF( MOD( ABS( glamf(ji,jj) - glamf(ji,jj-1) ), 360. ) < 1.e-8 ) THEN
+               gsinu(ji,jj) = 0.
+               gcosu(ji,jj) = 1.
+            ENDIF
+            IF(      ABS( gphif(ji,jj) - gphif(ji-1,jj) )         < 1.e-8 ) THEN
+               gsinv(ji,jj) = 0.
+               gcosv(ji,jj) = 1.
+            ENDIF
+            IF( MOD( ABS( glamu(ji,jj) - glamu(ji,jj+1) ), 360. ) < 1.e-8 ) THEN
+               gsinf(ji,jj) = 0.
+               gcosf(ji,jj) = 1.
+            ENDIF
+         END DO
+      END DO
+
+      ! =========================== !
+      ! Lateral boundary conditions !
+      ! =========================== !
+      !           ! lateral boundary cond.: T-, U-, V-, F-pts, sgn
+      CALL lbc_lnk( gcost, 'T', -1. )   ;   CALL lbc_lnk( gsint, 'T', -1. )
+      CALL lbc_lnk( gcosu, 'U', -1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. )
+      CALL lbc_lnk( gcosv, 'V', -1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. )
+      CALL lbc_lnk( gcosf, 'F', -1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. )
+      !
+   END SUBROUTINE angle
+
+
+   SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid, pte, ptn )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE geo2oce  ***
+      !!      
+      !! ** Purpose :
+      !!
+      !! ** Method  :   Change a vector from geocentric to east/north 
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::  pxx, pyy, pzz
+      CHARACTER(len=1)            , INTENT(in   ) ::  cgrid
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::  pte, ptn
+      !
+      REAL(wp), PARAMETER :: rpi = 3.141592653e0
+      REAL(wp), PARAMETER :: rad = rpi / 180.e0
+      INTEGER ::   ig     !
+      INTEGER ::   ierr   ! local integer
+      !!----------------------------------------------------------------------
+      !
+      IF( .NOT. ALLOCATED( gsinlon ) ) THEN
+         ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) ,   &
+            &      gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr )
+         IF( lk_mpp    )   CALL mpp_sum( ierr )
+         IF( ierr /= 0 )   CALL ctl_stop('geo2oce: unable to allocate arrays' )
+      ENDIF
+      !
+      SELECT CASE( cgrid)
+      CASE ( 'T' )   
+         ig = 1
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamt(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamt(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphit(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphit(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE ( 'U' )   
+         ig = 2
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamu(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamu(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphiu(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphiu(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE ( 'V' )   
+         ig = 3
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamv(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamv(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphiv(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphiv(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE ( 'F' )   
+         ig = 4
+         IF( .NOT. linit(ig) ) THEN 
+            gsinlon(:,:,ig) = SIN( rad * glamf(:,:) )
+            gcoslon(:,:,ig) = COS( rad * glamf(:,:) )
+            gsinlat(:,:,ig) = SIN( rad * gphif(:,:) )
+            gcoslat(:,:,ig) = COS( rad * gphif(:,:) )
+            linit(ig) = .TRUE.
+         ENDIF
+      CASE default   
+         WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid
+         CALL ctl_stop( ctmp1 )
+      END SELECT
+      !
+      pte = - gsinlon(:,:,ig) * pxx + gcoslon(:,:,ig) * pyy
+      ptn = - gcoslon(:,:,ig) * gsinlat(:,:,ig) * pxx    &
+         &  - gsinlon(:,:,ig) * gsinlat(:,:,ig) * pyy    &
+         &  + gcoslat(:,:,ig) * pzz
+      !
+   END SUBROUTINE geo2oce
+
+
+   SUBROUTINE oce2geo ( pte, ptn, cgrid, pxx , pyy , pzz )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE oce2geo  ***
+      !!      
+      !! ** Purpose :
+      !!
+      !! ** Method  :   Change vector from east/north to geocentric
+      !!
+      !! History :     ! (A. Caubel)  oce2geo - Original code
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn
+      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz
+      !!
+      REAL(wp), PARAMETER :: rpi = 3.141592653E0
+      REAL(wp), PARAMETER :: rad = rpi / 180.e0
+      INTEGER ::   ig     !
+      INTEGER ::   ierr   ! local integer
+      !!----------------------------------------------------------------------
+
+      IF( .NOT. ALLOCATED( gsinlon ) ) THEN
+         ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) ,   &
+            &      gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr )
+         IF( lk_mpp    )   CALL mpp_sum( ierr )
+         IF( ierr /= 0 )   CALL ctl_stop('oce2geo: unable to allocate arrays' )
+      ENDIF
+
+      SELECT CASE( cgrid)
+         CASE ( 'T' )   
+            ig = 1
+            IF( .NOT. linit(ig) ) THEN 
+               gsinlon(:,:,ig) = SIN( rad * glamt(:,:) )
+               gcoslon(:,:,ig) = COS( rad * glamt(:,:) )
+               gsinlat(:,:,ig) = SIN( rad * gphit(:,:) )
+               gcoslat(:,:,ig) = COS( rad * gphit(:,:) )
+               linit(ig) = .TRUE.
+            ENDIF
+         CASE ( 'U' )   
+            ig = 2
+            IF( .NOT. linit(ig) ) THEN 
+               gsinlon(:,:,ig) = SIN( rad * glamu(:,:) )
+               gcoslon(:,:,ig) = COS( rad * glamu(:,:) )
+               gsinlat(:,:,ig) = SIN( rad * gphiu(:,:) )
+               gcoslat(:,:,ig) = COS( rad * gphiu(:,:) )
+               linit(ig) = .TRUE.
+            ENDIF
+         CASE ( 'V' )   
+            ig = 3
+            IF( .NOT. linit(ig) ) THEN 
+               gsinlon(:,:,ig) = SIN( rad * glamv(:,:) )
+               gcoslon(:,:,ig) = COS( rad * glamv(:,:) )
+               gsinlat(:,:,ig) = SIN( rad * gphiv(:,:) )
+               gcoslat(:,:,ig) = COS( rad * gphiv(:,:) )
+               linit(ig) = .TRUE.
+            ENDIF
+         CASE ( 'F' )   
+            ig = 4
+            IF( .NOT. linit(ig) ) THEN 
+               gsinlon(:,:,ig) = SIN( rad * glamf(:,:) )
+               gcoslon(:,:,ig) = COS( rad * glamf(:,:) )
+               gsinlat(:,:,ig) = SIN( rad * gphif(:,:) )
+               gcoslat(:,:,ig) = COS( rad * gphif(:,:) )
+               linit(ig) = .TRUE.
+            ENDIF
+         CASE default   
+            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid
+            CALL ctl_stop( ctmp1 )
+      END SELECT
+      !
+      pxx = - gsinlon(:,:,ig) * pte - gcoslon(:,:,ig) * gsinlat(:,:,ig) * ptn 
+      pyy =   gcoslon(:,:,ig) * pte - gsinlon(:,:,ig) * gsinlat(:,:,ig) * ptn
+      pzz =   gcoslat(:,:,ig) * ptn
+      !
+   END SUBROUTINE oce2geo
+
+
+   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 8732)
@@ -0,0 +1,198 @@
+MODULE sbc_ice
+   !!======================================================================
+   !!                 ***  MODULE  sbc_ice  ***
+   !! Surface module - LIM-3: parameters & variables defined in memory
+   !!======================================================================
+   !! History :  3.0  ! 2006-08  (G. Madec)  Surface module
+   !!            3.2  ! 2009-06  (S. Masson) merge with ice_oce
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
+   !!----------------------------------------------------------------------
+#if defined key_lim3 || defined key_lim2 || defined key_cice
+   !!----------------------------------------------------------------------
+   !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE sbc_oce          ! surface boundary condition: ocean
+# if defined key_lim3
+   USE ice              ! LIM-3 parameters
+# endif
+# if defined key_lim2
+   USE par_ice_2        ! LIM-2 parameters
+   USE ice_2
+# endif
+# if defined key_cice
+   USE ice_domain_size, only: ncat 
+#endif
+   USE lib_mpp          ! MPP library
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_ice_alloc ! called in iceini(_2).F90
+
+# if defined  key_lim2
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE 
+#  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
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE 
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: 'C'-grid ice-velocity
+# endif
+# if defined  key_cice
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model
+   CHARACTER(len=1), PUBLIC            ::   cp_ice_msh = 'F'      !: 'F'-grid ice-velocity
+# endif
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice       !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice         !: ice surface temperature                          [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt
+
+#if defined  key_lim3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   evap_ice       !: sublimation                              [kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   devap_ice      !: sublimation sensitivity                [kg/m2/s/K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qns_oce        !: non solar heat flux over ocean              [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsr_oce        !: non solar heat flux over ocean              [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qevap_ice      !: heat flux of evap over ice                  [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: enthalpy of precip over ice                 [J/m3]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s]
+#endif
+#if defined key_lim3 || defined key_lim2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s]
+#endif
+
+#if defined key_cice
+   !
+   ! for consistency with LIM, these are declared with three dimensions
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qlw_ice            !: incoming long-wave
+   !
+   ! other forcing arrays are two dimensional
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iou             !: x ice-ocean surface stress at NEMO U point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iov             !: y ice-ocean surface stress at NEMO V point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qatm_ice           !: specific humidity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndi_ice           !: i wind at T point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndj_ice           !: j wind at T point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfrzmlt            !: NEMO frzmlt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point
+   
+   ! variables used in the coupled interface
+   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj
+#endif
+   
+#if defined key_lim2 || defined key_cice
+   ! already defined in ice.F90 for LIM3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s
+#endif
+
+#if defined key_cice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K]
+#endif
+
+   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-]
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sbc_ice_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  FUNCTION sbc_ice_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(5)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+
+#if defined key_lim3 || defined key_lim2
+      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     &
+         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     &
+         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   &
+         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   &
+         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     &
+#if defined key_lim2
+         &      a_i(jpi,jpj,jpl)      ,                             &
+#endif
+#if defined key_lim3
+         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   &
+         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   &
+         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   &
+#endif
+         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) )
+#endif
+
+#if defined key_cice
+      ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , &
+                wndi_ice(jpi,jpj)     , tatm_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , &
+                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , &
+                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , &
+                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
+                STAT= ierr(1) )
+      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , &
+         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , &
+         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , &
+         &                     STAT= ierr(2) )
+      
+#endif
+         !
+#if defined key_cice || defined key_lim2
+      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
+#endif
+
+      sbc_ice_alloc = MAXVAL( ierr )
+      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc )
+      IF( sbc_ice_alloc > 0 )   CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed')
+   END FUNCTION sbc_ice_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model
+   !!----------------------------------------------------------------------
+   USE in_out_manager   ! I/O manager
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity
+   REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-]
+   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt
+#endif
+
+   !!======================================================================
+END MODULE sbc_ice
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 8732)
@@ -0,0 +1,209 @@
+MODULE sbc_oce
+   !!======================================================================
+   !!                       ***  MODULE  sbc_oce  ***
+   !! Surface module :   variables defined in core memory 
+   !!======================================================================
+   !! 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
+   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model 
+   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_oce_alloc : allocation of sbc arrays
+   !!   sbc_tau2wnd   : wind speed estimated from wind stress
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_oce_alloc   ! routine called in sbcmod.F90
+   PUBLIC   sbc_tau2wnd     ! routine called in several sbc modules
+   
+   !!----------------------------------------------------------------------
+   !!           Namelist for the Ocean Surface Boundary Condition
+   !!----------------------------------------------------------------------
+   !                                   !!* namsbc namelist *
+   LOGICAL , PUBLIC ::   ln_usr         !: user defined formulation
+   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
+   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation
+#if defined key_oasis3
+   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
+#else
+   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused
+#endif
+   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation
+   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation
+   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
+   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
+   LOGICAL , PUBLIC ::   ln_isf         !: ice shelf melting
+   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS      
+   LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
+   INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
+   INTEGER , PUBLIC ::   nn_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
+   !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect)
+   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect
+   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure)
+   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 
+   INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation
+   !                                             !: =-1  Use of per-category fluxes
+   !                                             !: = 0  Average per-category fluxes
+   !                                             !: = 1  Average then redistribute per-category fluxes
+   !                                             !: = 2  Redistribute a single flux over categories
+   INTEGER , PUBLIC ::   nn_fwb         !: 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
+   LOGICAL , PUBLIC ::   ln_wave        !: true if some coupling with wave model
+   LOGICAL , PUBLIC ::   ln_cdgw        !: true if neutral drag coefficient from wave model
+   LOGICAL , PUBLIC ::   ln_sdw         !: true if 3d stokes drift from wave model
+   LOGICAL , PUBLIC ::   ln_tauoc       !: true if normalized stress from wave is used
+   LOGICAL , PUBLIC ::   ln_stcor       !: true if Stokes-Coriolis term is used
+   !
+   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs
+   !
+   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied
+   !!----------------------------------------------------------------------
+   !!           switch definition (improve readability)
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC, PARAMETER ::   jp_usr     = 1        !: user defined                  formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation
+   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module
+   
+   !!----------------------------------------------------------------------
+   !!           component definition
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration 
+                                                         !  (no internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component
+                                                         !  (internal OASIS coupling)
+   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
+                                                         !  (internal OASIS coupling)
+   !!----------------------------------------------------------------------
+   !!              Ocean Surface Boundary Condition fields
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere
+   !
+   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
+   !!                                   !!   now    ! before   !!
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
+   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx    , sfx_b    !: salt flux                                    [PSU/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s]  
+
+   !!
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk
+   !!
+   !!
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
+
+   !!----------------------------------------------------------------------
+   !!                     Sea Surface Mean fields
+   !!----------------------------------------------------------------------
+   INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sbc_oce_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION sbc_oce_alloc  ***
+      !!---------------------------------------------------------------------
+      INTEGER :: ierr(5)
+      !!---------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
+         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 
+         !
+      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
+         &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
+         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
+         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
+         !
+      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
+         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
+         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
+         !
+      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
+         &      atm_co2(jpi,jpj) ,                                        &
+         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
+         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
+         !
+      sbc_oce_alloc = MAXVAL( ierr )
+      IF( lk_mpp            )   CALL mpp_sum ( sbc_oce_alloc )
+      IF( sbc_oce_alloc > 0 )   CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed')
+      !
+   END FUNCTION sbc_oce_alloc
+
+
+   SUBROUTINE sbc_tau2wnd
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_tau2wnd  ***
+      !!                   
+      !! ** Purpose : Estimation of wind speed as a function of wind stress   
+      !!
+      !! ** Method  : |tau|=rhoa*Cd*|U|^2
+      !!---------------------------------------------------------------------
+      USE dom_oce         ! ocean space and time domain
+      USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+      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
+      !!---------------------------------------------------------------------
+      zcoef = 0.5 / ( zrhoa * zcdrag ) 
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+            ztau = SQRT( ztx * ztx + zty * zty )
+            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
+         END DO
+      END DO
+      CALL lbc_lnk( wndm(:,:) , 'T', 1. )
+      !
+   END SUBROUTINE sbc_tau2wnd
+
+   !!======================================================================
+END MODULE sbc_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 8732)
@@ -0,0 +1,160 @@
+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 dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition
+   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             ! IOM library
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_apr    ! routine called in sbcmod
+   
+   !                                !!* namsbc_apr namelist (Atmospheric PRessure) *
+   LOGICAL, PUBLIC ::   ln_apr_obc   !: inverse barometer added to OBC ssh data 
+   LOGICAL, PUBLIC ::   ln_ref_apr   !: ref. pressure: global mean Patm (F) or a constant (F)
+   REAL(wp)        ::   rn_pref      !  reference atmospheric pressure   [N/m2]
+
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m]
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ibb   ! Inverse barometer before sea surface height   [m]
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [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)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/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 
+      INTEGER            ::   ios     ! Local integer output status for namelist read
+      !!
+      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, rn_pref, ln_apr_obc
+      !!----------------------------------------------------------------------
+      !
+      !                                         ! -------------------- !
+      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
+         !                                      ! -------------------- !
+         REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
+         READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp )
+
+         REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
+         READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp )
+         IF(lwm) WRITE ( numond, namsbc_apr )
+         !
+         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
+         !
+         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( e1e2t(:,:) )
+            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 : ', rn_pref, ' N/m2'
+         ENDIF
+         !
+         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
+         !
+         !                                            !* control check
+         IF ( ln_apr_obc  ) THEN
+            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
+         ENDIF
+!jc: stop below should rather be a warning 
+         IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   &
+            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
+      ENDIF
+
+      !                                         ! ========================== !
+      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 )   rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
+         !
+         !                                                  !* Patm related forcing at kt
+         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90	(revision 8732)
@@ -0,0 +1,1028 @@
+MODULE sbcblk
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk  ***
+   !! Ocean forcing:  momentum, heat and freshwater flux formulation
+   !!                         Aerodynamic Bulk Formulas
+   !!                        SUCCESSOR OF "sbcblk_core"
+   !!=====================================================================
+   !! History :  1.0  !  2004-08  (U. Schweckendiek)  Original CORE code
+   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier)  improved CORE bulk and its user interface
+   !!            3.0  !  2006-06  (G. Madec)  sbc rewritting
+   !!             -   !  2006-12  (L. Brodeau)  Original code for turb_core
+   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
+   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
+   !!            3.4  !  2011-11  (C. Harris)  Fill arrays required by CICE
+   !!            3.7  !  2014-06  (L. Brodeau)  simplification and optimization of CORE bulk
+   !!            4.0  !  2016-06  (L. Brodeau)  sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore
+   !!                                          ==> based on AeroBulk (http://aerobulk.sourceforge.net/)
+   !!            4.0  !  2016-10  (G. Madec)  introduce a sbc_blk_init routine
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_blk_init  : initialisation of the chosen bulk formulation as ocean surface boundary condition
+   !!   sbc_blk       : bulk formulation as ocean surface boundary condition
+   !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean
+   !!   blk_ice       : computes momentum, heat and freshwater fluxes over sea ice
+   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP
+   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air)
+   !!   q_sat         : saturation humidity as a function of SLP and temperature
+   !!   L_vap         : latent heat of vaporization of water as a function of temperature
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE fldread        ! read input fields
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE cyclone        ! Cyclone 10m wind form trac of cyclone centres
+   USE sbcdcy         ! surface boundary condition: diurnal cycle
+   USE sbcwave , ONLY :   cdn_wave ! wave module
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE lib_fortran    ! to use key_nosignedzero
+#if defined key_lim3
+   USE ice     , ONLY :   u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b
+   USE limthd_dh      ! for CALL lim_thd_snwblow
+#elif defined key_lim2
+   USE ice_2   , ONLY :   u_ice, v_ice
+   USE par_ice_2      ! LIM-2 parameters
+#endif
+   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009) 
+   USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003) 
+   USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013)
+   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31) 
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_blk_init  ! called in sbcmod
+   PUBLIC   sbc_blk       ! called in sbcmod
+#if defined key_lim2 || defined key_lim3
+   PUBLIC   blk_ice_tau   ! routine called in sbc_ice_lim module
+   PUBLIC   blk_ice_flx   ! routine called in sbc_ice_lim module
+#endif
+
+!!Lolo: should ultimately be moved in the module with all physical constants ?
+!!gm  : In principle, yes.
+   REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg]
+   REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg]
+   REAL(wp), PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg]
+   REAL(wp), PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg]
+   REAL(wp), PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622
+   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608
+
+   INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read
+   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_tair = 3           ! index of 10m air temperature             (Kelvin)
+   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % )
+   INTEGER , PARAMETER ::   jp_qsr  = 5           ! index of solar heat                      (W/m2)
+   INTEGER , PARAMETER ::   jp_qlw  = 6           ! index of Long wave                       (W/m2)
+   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
+   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s)
+   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa)
+   INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read)
+
+   !                                             !!! Bulk parameters
+   REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...)
+   REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation
+   REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant
+   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice
+   REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant
+   !
+   !                           !!* Namelist namsbc_blk : bulk parameters
+   LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008)
+   LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
+   LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013)
+   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31)
+   !
+   LOGICAL  ::   ln_taudif      ! logical flag to use the "mean of stress module - module of mean stress" data
+   REAL(wp) ::   rn_pfac        ! multiplication factor for precipitation
+   REAL(wp) ::   rn_efac        ! multiplication factor for evaporation (clem)
+   REAL(wp) ::   rn_vfac        ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)
+   REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements
+   REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements
+   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012)
+   !
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_oce   ! air-ocean drag (clem)
+
+   INTEGER  ::   nblk           ! choice of the bulk algorithm
+   !                            ! associated indices:
+   INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008)
+   INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003)
+   INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013)
+   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-consortium (2014)
+   !! $Id: sbcblk.F90 6416 2016-04-01 12:22:17Z clem $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sbc_blk_alloc()
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_blk_alloc ***
+      !!-------------------------------------------------------------------
+      ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( sbc_blk_alloc )
+      IF( sbc_blk_alloc /= 0 )   CALL ctl_warn('sbc_blk_alloc: failed to allocate arrays')
+   END FUNCTION sbc_blk_alloc
+
+   SUBROUTINE sbc_blk_init
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_blk_init  ***
+      !!
+      !! ** Purpose :   choose and initialize a bulk formulae formulation
+      !!
+      !! ** Method  : 
+      !!
+      !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the (i,j) mesh referential
+      !!
+      !! ** Action  :   
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument
+      INTEGER  ::   ios, ierror, ioptio   ! Local integer
+      !!
+      CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files
+      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read
+      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        "
+      TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        "
+      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields
+         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                &
+         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm
+         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         & 
+         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12
+      !!---------------------------------------------------------------------
+      !
+      !                                      ! allocate sbc_blk_core array
+      IF( sbc_blk_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' )
+      !
+      !                             !** read bulk namelist  
+      REWIND( numnam_ref )                !* Namelist namsbc_blk in reference namelist : bulk parameters
+      READ  ( numnam_ref, namsbc_blk, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )                !* Namelist namsbc_blk in configuration namelist : bulk parameters
+      READ  ( numnam_cfg, namsbc_blk, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_blk in configuration namelist', lwp )
+      !
+      IF(lwm) WRITE( numond, namsbc_blk )
+      !
+      !                             !** initialization of the chosen bulk formulae (+ check)
+      !                                   !* select the bulk chosen in the namelist and check the choice
+      ;                                                        ioptio = 0
+      IF( ln_NCAR      ) THEN   ;   nblk =  np_NCAR        ;   ioptio = ioptio + 1   ;   ENDIF
+      IF( ln_COARE_3p0 ) THEN   ;   nblk =  np_COARE_3p0   ;   ioptio = ioptio + 1   ;   ENDIF
+      IF( ln_COARE_3p5 ) THEN   ;   nblk =  np_COARE_3p5   ;   ioptio = ioptio + 1   ;   ENDIF
+      IF( ln_ECMWF     ) THEN   ;   nblk =  np_ECMWF       ;   ioptio = ioptio + 1   ;   ENDIF
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'sbc_blk_init: Choose one and only one bulk algorithm' )
+      !
+      IF( ln_dm2dc ) THEN                 !* check: diurnal cycle on Qsr
+         IF( sn_qsr%nfreqh /= 24 )   CALL ctl_stop( 'sbc_blk_init: ln_dm2dc=T only with daily short-wave input' )
+         IF( sn_qsr%ln_tint ) THEN 
+            CALL ctl_warn( 'sbc_blk_init: ln_dm2dc=T daily qsr time interpolation done by sbcdcy module',   &
+               &           '              ==> We force time interpolation = .false. for qsr' )
+            sn_qsr%ln_tint = .false.
+         ENDIF
+      ENDIF
+      !                                   !* set the bulk structure
+      !                                      !- 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
+      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi
+      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
+      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif
+      !
+      lhftau = ln_taudif                     !- add an extra field if HF stress is used
+      jfld = jpfld - COUNT( (/.NOT.lhftau/) )
+      !
+      !                                      !- allocate the bulk structure
+      ALLOCATE( sf(jfld), STAT=ierror )
+      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' )
+      DO ifpr= 1, jfld
+         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
+      END DO
+      !                                      !- fill the bulk structure with namelist informations
+      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' )
+      !
+      IF ( ln_wave ) THEN
+      !Activated wave module but neither drag nor stokes drift activated
+         IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor ) )   THEN
+            CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F')
+      !drag coefficient read from wave model definable only with mfs bulk formulae and core 
+         ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN       
+             CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
+         ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN
+             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')
+         ENDIF
+      ELSE
+      IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor )                & 
+         &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    &
+         &                  'with drag coefficient (ln_cdgw =T) '  ,                        &
+         &                  'or Stokes Drift (ln_sdw=T) ' ,                                 &
+         &                  'or ocean stress modification due to waves (ln_tauoc=T) ',      &  
+         &                  'or Stokes-Coriolis term (ln_stcori=T)'  )
+      ENDIF 
+      !
+      !           
+      IF(lwp) THEN                     !** Control print
+         !
+         WRITE(numout,*)                  !* namelist 
+         WRITE(numout,*) '   Namelist namsbc_blk (other than data information):'
+         WRITE(numout,*) '      "NCAR"      algorithm   (Large and Yeager 2008)     ln_NCAR      = ', ln_NCAR
+         WRITE(numout,*) '      "COARE 3.0" algorithm   (Fairall et al. 2003)       ln_COARE_3p0 = ', ln_COARE_3p0
+         WRITE(numout,*) '      "COARE 3.5" algorithm   (Edson et al. 2013)         ln_COARE_3p5 = ', ln_COARE_3p0
+         WRITE(numout,*) '      "ECMWF"     algorithm   (IFS cycle 31)              ln_ECMWF     = ', ln_ECMWF
+         WRITE(numout,*) '      add High freq.contribution to the stress module     ln_taudif    = ', ln_taudif
+         WRITE(numout,*) '      Air temperature and humidity reference height (m)   rn_zqt       = ', rn_zqt
+         WRITE(numout,*) '      Wind vector reference height (m)                    rn_zu        = ', rn_zu
+         WRITE(numout,*) '      factor applied on precipitation (total & snow)      rn_pfac      = ', rn_pfac
+         WRITE(numout,*) '      factor applied on evaporation                       rn_efac      = ', rn_efac
+         WRITE(numout,*) '      factor applied on ocean/ice velocity                rn_vfac      = ', rn_vfac
+         WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))'
+         !
+         WRITE(numout,*)
+         SELECT CASE( nblk )              !* Print the choice of bulk algorithm
+         CASE( np_NCAR      )   ;   WRITE(numout,*) '      ===>>   "NCAR" algorithm        (Large and Yeager 2008)'
+         CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '      ===>>   "COARE 3.0" algorithm   (Fairall et al. 2003)'
+         CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '      ===>>   "COARE 3.5" algorithm   (Edson et al. 2013)'
+         CASE( np_ECMWF     )   ;   WRITE(numout,*) '      ===>>   "ECMWF" algorithm       (IFS cycle 31)'
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_blk_init
+
+
+   SUBROUTINE sbc_blk( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_blk  ***
+      !!
+      !! ** Purpose :   provide at each time step the surface ocean fluxes
+      !!      (momentum, heat, freshwater and runoff)
+      !!
+      !! ** Method  : (1) READ each fluxes in NetCDF files:
+      !!      the 10m wind velocity (i-component) (m/s)    at T-point
+      !!      the 10m wind velocity (j-component) (m/s)    at T-point
+      !!      the 10m or 2m specific humidity     ( % )
+      !!      the solar heat                      (W/m2)
+      !!      the Long wave                       (W/m2)
+      !!      the 10m or 2m air temperature       (Kelvin)
+      !!      the total precipitation (rain+snow) (Kg/m2/s)
+      !!      the snow (solid prcipitation)       (kg/m2/s)
+      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T)
+      !!              (2) CALL blk_oce
+      !!
+      !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the (i,j) mesh referential
+      !!
+      !! ** Action  :   defined at each time-step at the air-sea interface
+      !!              - utau, vtau  i- and j-component of the wind stress
+      !!              - taum        wind stress module at T-point
+      !!              - wndm        wind speed  module at T-point over free ocean or leads in presence of sea-ice
+      !!              - qns, qsr    non-solar and solar heat fluxes
+      !!              - emp         upward mass flux (evapo. - precip.)
+      !!              - sfx         salt flux due to freezing/melting (non-zero only if ice is present)
+      !!                            (set in limsbc(_2).F90)
+      !!
+      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
+      !!                   Brodeau et al. Ocean Modelling 2010
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step
+      !
+      !                                            ! compute the surface ocean fluxes using bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m )
+
+#if defined key_cice
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
+         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1)
+         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )
+         ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
+         ENDIF 
+         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)
+         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1)
+         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac
+         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac
+         wndi_ice(:,:)    = sf(jp_wndi)%fnow(:,:,1)
+         wndj_ice(:,:)    = sf(jp_wndj)%fnow(:,:,1)
+      ENDIF
+#endif
+      !
+   END SUBROUTINE sbc_blk
+
+
+   SUBROUTINE blk_oce( kt, sf, pst, pu, pv )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce  ***
+      !!
+      !! ** Purpose :   provide the momentum, heat and freshwater fluxes at
+      !!      the ocean surface at each time step
+      !!
+      !! ** Method  :   bulk formulea for the ocean using atmospheric
+      !!      fields read in sbc_read
+      !!
+      !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2)
+      !!              - vtau    : j-component of the stress at V-point  (N/m2)
+      !!              - taum    : Wind stress module at T-point         (N/m2)
+      !!              - wndm    : Wind speed module at T-point          (m/s)
+      !!              - qsr     : Solar heat flux over the ocean        (W/m2)
+      !!              - qns     : Non Solar heat flux over the ocean    (W/m2)
+      !!              - emp     : evaporation minus precipitation       (kg/m2/s)
+      !!
+      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC
+      !!---------------------------------------------------------------------
+      INTEGER  , INTENT(in   )                 ::   kt    ! time step index
+      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data
+      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius]
+      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s]
+      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zztmp                ! local variable
+      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point
+      REAL(wp), DIMENSION(:,:), POINTER ::   zsq               ! specific humidity at pst
+      REAL(wp), DIMENSION(:,:), POINTER ::   zqlw, zqsb        ! long wave and sensible heat fluxes
+      REAL(wp), DIMENSION(:,:), POINTER ::   zqla, zevap       ! latent heat fluxes and evaporation
+      REAL(wp), DIMENSION(:,:), POINTER ::   Cd                ! transfer coefficient for momentum      (tau)
+      REAL(wp), DIMENSION(:,:), POINTER ::   Ch                ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), DIMENSION(:,:), POINTER ::   Ce                ! tansfert coefficient for evaporation   (Q_lat)
+      REAL(wp), DIMENSION(:,:), POINTER ::   zst               ! surface temperature in Kelvin
+      REAL(wp), DIMENSION(:,:), POINTER ::   zt_zu             ! air temperature at wind speed height
+      REAL(wp), DIMENSION(:,:), POINTER ::   zq_zu             ! air spec. hum.  at wind speed height
+      REAL(wp), DIMENSION(:,:), POINTER ::   zU_zu             ! bulk wind speed at height zu  [m/s]
+      REAL(wp), DIMENSION(:,:), POINTER ::   ztpot             ! potential temperature of air at z=rn_zqt [K]
+      REAL(wp), DIMENSION(:,:), POINTER ::   zrhoa             ! density of air   [kg/m^3]
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_oce')
+      !
+      CALL wrk_alloc( jpi,jpj,   zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap )
+      CALL wrk_alloc( jpi,jpj,   Cd, Ch, Ce, zst, zt_zu, zq_zu )
+      CALL wrk_alloc( jpi,jpj,   zU_zu, ztpot, zrhoa )
+      !
+
+      ! local scalars ( place there for vector optimisation purposes)
+      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K)
+
+      ! ----------------------------------------------------------------------------- !
+      !      0   Wind components and module at T-point relative to the moving ocean   !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ... components ( U10m - U_oce ) at T-point (unmasked)
+!!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ???
+      zwnd_i(:,:) = 0._wp
+      zwnd_j(:,:) = 0._wp
+#if defined key_cyclone
+      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj)
+            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj)
+         END DO
+      END DO
+#endif
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+         END DO
+      END DO
+      CALL lbc_lnk( zwnd_i(:,:) , 'T', -1. )
+      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. )
+      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
+      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   &
+         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1)
+
+      ! ----------------------------------------------------------------------------- !
+      !      I   Radiative FLUXES                                                     !
+      ! ----------------------------------------------------------------------------- !
+
+      ! 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
+
+      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
+
+
+
+      ! ----------------------------------------------------------------------------- !
+      !     II    Turbulent FLUXES                                                    !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ... specific humidity at SST and IST tmask(
+      zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) )
+      !!
+      !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate
+      !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2
+      !!    (since reanalysis products provide T at z, not theta !)
+      ztpot = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1) ) * rn_zqt
+
+      SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point
+      !
+      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2
+         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0
+         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5
+         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF
+         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu )
+      CASE DEFAULT
+         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
+      END SELECT
+
+      !                          ! Compute true air density :
+      IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...)
+         zrhoa(:,:) = rho_air( zt_zu(:,:)             , zq_zu(:,:)             , sf(jp_slp)%fnow(:,:,1) )
+      ELSE                                      ! At zt:
+         zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+      END IF
+
+      Cd_oce(:,:) = Cd(:,:)  ! record value of pure ocean-atm. drag (clem)
+
+      DO jj = 1, jpj             ! tau module, i and j component
+         DO ji = 1, jpi
+            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd(ji,jj)   ! using bulk wind speed
+            taum  (ji,jj) = zztmp * wndm  (ji,jj)
+            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj)
+            zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj)
+         END DO
+      END DO
+
+      !                          ! add the HF tau contribution to the wind stress module
+      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
+
+      CALL iom_put( "taum_oce", taum )   ! output wind stress module
+
+      ! ... utau, vtau at U- and V_points, resp.
+      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
+      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
+      DO jj = 1, jpjm1
+         DO ji = 1, fs_jpim1
+            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))
+            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) &
+               &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))
+         END DO
+      END DO
+      CALL lbc_lnk( utau(:,:), 'U', -1. )
+      CALL lbc_lnk( vtau(:,:), 'V', -1. )
+
+
+      !  Turbulent fluxes over ocean
+      ! -----------------------------
+
+      ! zqla used as temporary array, for rho*U (common term of bulk formulae):
+      zqla(:,:) = zrhoa(:,:) * zU_zu(:,:)
+
+      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN
+         !! q_air and t_air are given at 10m (wind reference height)
+         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed
+         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed
+      ELSE
+         !! q_air and t_air are not given at 10m (wind reference height)
+         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!!
+         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed
+         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) )   ! Sensible Heat ! using bulk wind speed
+      ENDIF
+
+      zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux
+
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce , clinfo2=' Ce  : ' )
+         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch , clinfo2=' Ch  : ' )
+         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
+         CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' )
+         CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
+            &          tab2d_2=vtau  , clinfo2=           ' vtau : ', mask2=vmask )
+         CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce: wndm   : ')
+         CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce: zst    : ')
+      ENDIF
+
+      ! ----------------------------------------------------------------------------- !
+      !     III    Total FLUXES                                                       !
+      ! ----------------------------------------------------------------------------- !
+      !
+      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.)
+         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1)
+      !
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar
+         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip
+         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST
+         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair
+         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          &
+         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow)
+         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1)
+      !
+#if defined key_lim3
+      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3)
+      qsr_oce(:,:) = qsr(:,:)
+#endif
+      !
+      IF ( nn_ice == 0 ) THEN
+         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean
+         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean
+         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean
+         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean
+         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean
+         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean
+         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean
+         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s]
+         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s]
+         CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow
+         CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation
+      ENDIF
+      !
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ')
+         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
+         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ')
+         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce: utau   : ', mask1=umask,   &
+            &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap )
+      CALL wrk_dealloc( jpi,jpj,   Cd, Ch, Ce, zst, zt_zu, zq_zu )
+      CALL wrk_dealloc( jpi,jpj,   zU_zu, ztpot, zrhoa )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_oce')
+      !
+   END SUBROUTINE blk_oce
+
+#if defined key_lim2 || defined key_lim3
+
+   SUBROUTINE blk_ice_tau
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_tau  ***
+      !!
+      !! ** Purpose :   provide the surface boundary condition over sea-ice
+      !!
+      !! ** Method  :   compute momentum using bulk formulation
+      !!                formulea, ice variables and read atmospheric fields.
+      !!                NB: ice drag coefficient is assumed to be a constant
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      !
+      REAL(wp), DIMENSION(:,:)  , POINTER :: zrhoa
+      !
+      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point
+      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point
+      REAL(wp), DIMENSION(:,:), POINTER ::   Cd               ! transfer coefficient for momentum      (tau)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_tau')
+      !
+      CALL wrk_alloc( jpi,jpj, zrhoa )
+      CALL wrk_alloc( jpi,jpj, Cd )
+
+      Cd(:,:) = Cd_ice
+
+      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem)
+#if defined key_lim3
+      IF( ln_Cd_L12 ) THEN
+         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations
+      ENDIF
+#endif
+
+      ! local scalars ( place there for vector optimisation purposes)
+      ! Computing density of air! Way denser that 1.2 over sea-ice !!!
+      !!
+      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1))
+
+      !!gm brutal....
+      utau_ice  (:,:) = 0._wp
+      vtau_ice  (:,:) = 0._wp
+      wndm_ice  (:,:) = 0._wp
+      !!gm end
+
+      ! ----------------------------------------------------------------------------- !
+      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   !
+      ! ----------------------------------------------------------------------------- !
+      SELECT CASE( cp_ice_msh )
+      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
+         DO jj = 2, jpjm1
+            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  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj)
+               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj)
+               zwnorm_f = zrhoa(ji,jj) * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
+               ! ... ice stress at I-point
+               utau_ice(ji,jj) = zwnorm_f * zwndi_f
+               vtau_ice(ji,jj) = zwnorm_f * zwndj_f
+               ! ... scalar wind at T-point (fld being at T-point)
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   &
+                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   &
+                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  )
+               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( utau_ice, 'I', -1. )
+         CALL lbc_lnk( vtau_ice, 'I', -1. )
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
+         !
+      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vect. opt.
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  )
+               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vect. opt.
+               utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
+               vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
+            END DO
+         END DO
+         CALL lbc_lnk( utau_ice, 'U', -1. )
+         CALL lbc_lnk( vtau_ice, 'V', -1. )
+         CALL lbc_lnk( wndm_ice, 'T',  1. )
+         !
+      END SELECT
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ')
+         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice: wndm_ice : ')
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_tau')
+
+   END SUBROUTINE blk_ice_tau
+
+
+   SUBROUTINE blk_ice_flx( ptsu, palb )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_flx  ***
+      !!
+      !! ** Purpose :   provide the surface boundary condition over sea-ice
+      !!
+      !! ** Method  :   compute heat and freshwater exchanged
+      !!                between atmosphere and sea-ice using bulk formulation
+      !!                formulea, ice variables and read atmmospheric fields.
+      !!
+      !! caution : the net upward water flux has with mm/day unit
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies)
+      !!
+      INTEGER  ::   ji, jj, jl               ! dummy loop indices
+      REAL(wp) ::   zst2, zst3               ! local variable
+      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      -
+      REAL(wp) ::   zztmp, z1_lsub           !   -      -
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw         ! long wave heat flux over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb         ! sensible  heat flux over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw        ! long wave heat sensitivity over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb        ! sensible  heat sensitivity over ice
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (LIM3)
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   Cd            ! transfer coefficient for momentum      (tau)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_flx')
+      !
+      CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb )
+      CALL wrk_alloc( jpi,jpj,       zrhoa)
+      CALL wrk_alloc( jpi,jpj, Cd )
+
+      Cd(:,:) = Cd_ice
+
+      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al.  2012) (clem)
+#if defined key_lim3
+      IF( ln_Cd_L12 ) THEN
+         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations
+      ENDIF
+#endif
+
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      zcoef_dqlw   = 4.0 * 0.95 * Stef
+      zcoef_dqla   = -Ls * 11637800. * (-5897.8)
+      !
+      zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) )
+      !
+      zztmp = 1. / ( 1. - albo )
+      !                                     ! ========================== !
+      DO jl = 1, jpl                        !  Loop over ice categories  !
+         !                                  ! ========================== !
+         DO jj = 1 , jpj
+            DO ji = 1, jpi
+               ! ----------------------------!
+               !      I   Radiative FLUXES   !
+               ! ----------------------------!
+               zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
+               zst3 = ptsu(ji,jj,jl) * zst2
+               ! Short Wave (sw)
+               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
+               ! Long  Wave (lw)
+               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
+               ! lw sensitivity
+               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
+
+               ! ----------------------------!
+               !     II    Turbulent FLUXES  !
+               ! ----------------------------!
+
+               ! ... turbulent heat fluxes
+               ! Sensible Heat
+               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
+               ! Latent Heat
+               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Cd(ji,jj) * wndm_ice(ji,jj)   &
+                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1)  ) )
+               ! Latent heat sensitivity for ice (Dqla/Dt)
+               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
+                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Cd(ji,jj) * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) )
+               ELSE
+                  dqla_ice(ji,jj,jl) = 0._wp
+               ENDIF
+
+               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
+               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj)
+
+               ! ----------------------------!
+               !     III    Total FLUXES     !
+               ! ----------------------------!
+               ! Downward Non Solar flux
+               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl)
+               ! Total non solar heat flux sensitivity for ice
+               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) )
+            END DO
+            !
+         END DO
+         !
+      END DO
+      !
+      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
+      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation
+      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation
+
+#if defined  key_lim3
+      CALL wrk_alloc( jpi,jpj,   zevap, zsnw )
+
+      ! --- evaporation --- !
+      z1_lsub = 1._wp / Lsub
+      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub    ! sublimation
+      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub    ! d(sublimation)/dT
+      zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )  ! evaporation over ocean
+
+      ! --- evaporation minus precipitation --- !
+      zsnw(:,:) = 0._wp
+      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing
+      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
+      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
+      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
+
+      ! --- heat flux associated with emp --- !
+      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst
+         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair
+         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only)
+         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- total solar and non solar fluxes --- !
+      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+
+      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
+      DO jl = 1, jpl
+         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) )
+                                   ! But we do not have Tice => consider it at 0degC => evap=0 
+      END DO
+
+      CALL wrk_dealloc( jpi,jpj,   zevap, zsnw )
+#endif
+
+      !--------------------------------------------------------------------
+      ! FRACTIONs of net shortwave radiation which is not absorbed in the
+      ! thin surface layer and penetrates inside the ice cover
+      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
+      !
+      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+      !
+      !
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice: z_dqsb   : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw   : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab3d_1=ptsu    , clinfo1=' blk_ice: ptsu     : ', tab3d_2=qns_ice , clinfo2=' qns_ice  : ', kdim=jpl)
+         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb )
+      CALL wrk_dealloc( jpi,jpj,       zrhoa )
+      CALL wrk_dealloc( jpi,jpj, Cd )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_flx')
+
+   END SUBROUTINE blk_ice_flx
+   
+#endif
+
+   FUNCTION rho_air( ptak, pqa, pslp )
+      !!-------------------------------------------------------------------------------
+      !!                           ***  FUNCTION rho_air  ***
+      !!
+      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
+      !!-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3]
+      !!-------------------------------------------------------------------------------
+      !
+      rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  )
+      !
+   END FUNCTION rho_air
+
+
+   FUNCTION cp_air( pqa )
+      !!-------------------------------------------------------------------------------
+      !!                           ***  FUNCTION cp_air  ***
+      !!
+      !! ** Purpose : Compute specific heat (Cp) of moist air
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity         [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air   [J/K/kg]
+      !!-------------------------------------------------------------------------------
+      !
+      Cp_air = Cp_dry + Cp_vap * pqa
+      !
+   END FUNCTION cp_air
+
+
+   FUNCTION q_sat( ptak, pslp )
+      !!----------------------------------------------------------------------------------
+      !!                           ***  FUNCTION q_sat  ***
+      !!
+      !! ** Purpose : Specific humidity at saturation in [kg/kg]
+      !!              Based on accurate estimate of "e_sat"
+      !!              aka saturation water vapor (Goff, 1957)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg]
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   ze_sat, ztmp   ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            ztmp = rt0 / ptak(ji,jj)
+            !
+            ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957)
+            ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        &
+               &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  &
+               &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  )
+               !
+            q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa]
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION q_sat
+
+
+   FUNCTION gamma_moist( ptak, pqa )
+      !!----------------------------------------------------------------------------------
+      !!                           ***  FUNCTION gamma_moist  ***
+      !!
+      !! ** Purpose : Compute the moist adiabatic lapse-rate.
+      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate
+      !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) :: zrv, ziRT        ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zrv = pqa(ji,jj) / (1. - pqa(ji,jj))
+            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT
+            gamma_moist(ji,jj) = grav * ( 1. + cevap*zrv*ziRT ) / ( Cp_dry + cevap*cevap*zrv*reps0*ziRT/ptak(ji,jj) )
+         END DO
+      END DO
+      !
+   END FUNCTION gamma_moist
+
+
+   FUNCTION L_vap( psst )
+      !!---------------------------------------------------------------------------------
+      !!                           ***  FUNCTION L_vap  ***
+      !!
+      !! ** Purpose : Compute the latent heat of vaporization of water from temperature
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization   [J/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K]
+      !!----------------------------------------------------------------------------------
+      !
+      L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6
+      !
+   END FUNCTION L_vap
+
+
+#if defined key_lim3
+   SUBROUTINE Cdn10_Lupkes2012( Cd )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  Cdn10_Lupkes2012  ***
+      !!
+      !! ** Purpose :    Recompute the ice-atm drag at 10m height to make
+      !!                 it dependent on edges at leads, melt ponds and flows.
+      !!                 After some approximations, this can be resumed to a dependency
+      !!                 on ice concentration.
+      !!                
+      !! ** Method :     The parameterization is taken from Lupkes et al. (2012) eq.(50)
+      !!                 with the highest level of approximation: level4, eq.(59)
+      !!                 The generic drag over a cell partly covered by ice can be re-written as follows:
+      !!
+      !!                 Cd = Cdw * (1-A) + Cdi * A + Ce * (1-A)**(nu+1/(10*beta)) * A**mu
+      !!
+      !!                    Ce = 2.23e-3       , as suggested by Lupkes (eq. 59)
+      !!                    nu = mu = beta = 1 , as suggested by Lupkes (eq. 59)
+      !!                    A is the concentration of ice minus melt ponds (if any)
+      !!
+      !!                 This new drag has a parabolic shape (as a function of A) starting at
+      !!                 Cdw(say 1.5e-3) for A=0, reaching 1.97e-3 for A~0.5 
+      !!                 and going down to Cdi(say 1.4e-3) for A=1
+      !!
+      !!                 It is theoretically applicable to all ice conditions (not only MIZ)
+      !!                 => see Lupkes et al (2013)
+      !!
+      !! ** References : Lupkes et al. JGR 2012 (theory)
+      !!                 Lupkes et al. GRL 2013 (application to GCM)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd
+      REAL(wp), PARAMETER ::   zCe   = 2.23e-03_wp
+      REAL(wp), PARAMETER ::   znu   = 1._wp
+      REAL(wp), PARAMETER ::   zmu   = 1._wp
+      REAL(wp), PARAMETER ::   zbeta = 1._wp
+      REAL(wp)            ::   zcoef
+      !!----------------------------------------------------------------------
+      zcoef = znu + 1._wp / ( 10._wp * zbeta )
+
+      ! generic drag over a cell partly covered by ice
+      !!Cd(:,:) = Cd_oce(:,:) * ( 1._wp - at_i_b(:,:) ) +  &                        ! pure ocean drag
+      !!   &      Cd_ice      *           at_i_b(:,:)   +  &                        ! pure ice drag
+      !!   &      zCe         * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**zmu   ! change due to sea-ice morphology
+
+      ! ice-atm drag
+      Cd(:,:) = Cd_ice +  &                                                         ! pure ice drag
+         &      zCe    * ( 1._wp - at_i_b(:,:) )**zcoef * at_i_b(:,:)**(zmu-1._wp)  ! change due to sea-ice morphology
+      
+   END SUBROUTINE Cdn10_Lupkes2012
+#endif
+   
+
+   !!======================================================================
+END MODULE sbcblk
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90	(revision 8732)
@@ -0,0 +1,454 @@
+MODULE sbcblk_algo_coare
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk_algo_coare  ***
+   !! Computes turbulent components of surface fluxes
+   !!         according to Fairall et al. 2003 (COARE v3)
+   !!
+   !!   * bulk transfer coefficients C_D, C_E and C_H
+   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
+   !!   * the effective bulk wind speed at 10m U_blk
+   !!   => all these are used in bulk formulas in sbcblk.F90
+   !!
+   !!    Using the bulk formulation/param. of COARE v3, Fairall et al. 2003
+   !!
+   !!
+   !!       Routine turb_coare maintained and developed in AeroBulk
+   !!                     (http://aerobulk.sourceforge.net/)
+   !!
+   !!            Author: Laurent Brodeau, 2016, brodeau@gmail.com
+   !!
+   !!======================================================================
+   !! History :  3.6  !  2016-02  (L.Brodeau)   Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   turb_coare  : computes the bulk turbulent transfer coefficients
+   !!                   adjusts t_air and q_air from zt to zu m
+   !!                   returns the effective bulk wind speed at 10m
+   !!----------------------------------------------------------------------
+   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 sbcwave, ONLY  :  cdn_wave ! wave module
+#if defined key_lim3 || defined key_cice
+   USE sbc_ice        ! Surface boundary condition: ice fields
+#endif
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE prtctl         ! Print control
+   USE lib_fortran    ! to use key_nosignedzero
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ::   TURB_COARE   ! called by sbcblk.F90
+
+   !! COARE own values for given constants:
+   REAL(wp), PARAMETER :: &
+      &   zi0     = 600.,  &   !: scale height of the atmospheric boundary layer...1
+      &  Beta0    = 1.25, &   !: gustiness parameter
+      &  rctv0    = 0.608     !: constant to obtain virtual temperature...
+
+
+CONTAINS
+
+   SUBROUTINE turb_coare( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
+      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_coare  ***
+      !!
+      !!            2015: L. Brodeau (brodeau@gmail.com)
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to Fairall et al. (2003)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!
+      !! ** Method : Monin Obukhov Similarity Theory
+      !!----------------------------------------------------------------------
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  zt   : height for temperature and spec. hum. of air            [m]
+      !!    *  zu   : height for wind speed (generally 10m)                   [m]
+      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
+      !!    *  sst  : SST                                                     [K]
+      !!    *  t_zt : potential air temperature at zt                         [K]
+      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
+      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!
+      !!
+      !! OUTPUT :
+      !! --------
+      !!    *  Cd     : drag coefficient
+      !!    *  Ch     : sensible heat coefficient
+      !!    *  Ce     : evaporation coefficient
+      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
+      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
+      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      !
+      INTEGER :: j_itt
+      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+
+      REAL(wp), DIMENSION(:,:), POINTER  ::  &
+         &  u_star, t_star, q_star, &
+         &  dt_zu, dq_zu,    &
+         &  znu_a,           & !: Nu_air, Viscosity of air
+         &  z0, z0t
+      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu
+      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt
+      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('turb_coare')
+
+      CALL wrk_alloc( jpi,jpj,   u_star, t_star, q_star, zeta_u, dt_zu, dq_zu)
+      CALL wrk_alloc( jpi,jpj,   znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )
+
+      l_zt_equal_zu = .FALSE.
+      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      IF( .NOT. l_zt_equal_zu )   CALL wrk_alloc( jpi,jpj, zeta_t )
+
+      !! First guess of temperature and humidity at height zu:
+      t_zu = MAX(t_zt , 0.0)    ! who knows what's given on masked-continental regions...
+      q_zu = MAX(q_zt , 1.e-6)  !               "
+
+      !! Pot. temp. difference (and we don't want it to be 0!)
+      dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+      dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+
+      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      ztmp2 = 0.5*0.5  ! initial guess for wind gustiness contribution
+      U_blk = SQRT(U_zu*U_zu + ztmp2)
+
+      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0 (with z0 first guess == 0.0001)
+      ztmp0   = LOG(zu*ztmp2)
+      ztmp1   = LOG(10.*ztmp2)
+      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+
+      z0     = alfa_charn(U_blk)*u_star*u_star/grav + 0.11*znu_a/u_star
+      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
+
+      ztmp2  = vkarmn/ztmp0
+      Cd     = ztmp2*ztmp2    ! first guess of Cd
+
+      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
+
+      !Ribcu = -zu/(zi0*0.004*Beta0**3) !! Saturation Rib, zi0 = tropicalbound. layer depth
+      ztmp2  = grav*zu*(dt_zu + rctv0*t_zu*dq_zu)/(t_zu*U_blk*U_blk)  !! Ribu Bulk Richardson number
+      ztmp1 = 0.5 + sign(0.5 , ztmp2)
+      ztmp0 = ztmp0*ztmp2
+      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
+      zeta_u = (1.-ztmp1) * (ztmp0/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &
+         &  +     ztmp1   * (ztmp0*(1. + 27./9.*ztmp2/ztmp0))
+
+      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
+      ztmp0  =  vkarmn/(LOG(zu*z0t) - psi_h_coare(zeta_u))
+
+      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u))
+      t_star = dt_zu*ztmp0
+      q_star = dq_zu*ztmp0
+
+      ! What's need to be done if zt /= zu:
+      IF( .NOT. l_zt_equal_zu ) THEN
+
+         zeta_t = zt*zeta_u/zu
+
+         !! First update of values at zu (or zt for wind)
+         ztmp0 = psi_h_coare(zeta_u) - psi_h_coare(zeta_t)
+         ztmp1 = log(zt/zu) + ztmp0
+         t_zu = t_zt - t_star/vkarmn*ztmp1
+         q_zu = q_zt - q_star/vkarmn*ztmp1
+         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
+
+         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+
+      END IF
+
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
+
+         !!Inverse of Monin-Obukov length (1/L) :
+         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length]
+
+         ztmp1 = u_star*u_star   ! u*^2
+
+         !! Update wind at 10m taking into acount convection-related wind gustiness:
+         ! Ug = Beta*w*  (Beta = 1.25, Fairall et al. 2003, Eq.8):
+         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0.))**(2./3.)   ! => ztmp2 == Ug^2
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before 600.
+         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)        ! include gustiness in bulk wind speed
+         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
+
+         !! Updating Charnock parameter, increases with the wind (Fairall et al., 2003 p. 577-578)
+         ztmp2 = alfa_charn(U_blk)  ! alpha Charnock parameter
+
+         !! Roughness lengthes z0, z0t (z0q = z0t) :
+         z0   = ztmp2*ztmp1/grav + 0.11*znu_a/u_star ! Roughness length (eq.6)
+         ztmp1 = z0*u_star/znu_a                             ! Re_r: roughness Reynolds number
+         z0t  = min( 1.1E-4 , 5.5E-5*ztmp1**(-0.6) )         ! Scalar roughness for both theta and q (eq.28)
+
+         !! Stability parameters:
+         zeta_u = zu*ztmp0 ; zeta_u = sign( min(abs(zeta_u),50.0), zeta_u )
+         IF( .NOT. l_zt_equal_zu ) THEN
+            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),50.0), zeta_t )
+         END IF
+
+         !! Turbulent scales at zu=10m :
+         ztmp0   = psi_h_coare(zeta_u)
+         ztmp1   = vkarmn/(LOG(zu) -LOG(z0t) - ztmp0)
+
+         t_star = dt_zu*ztmp1
+         q_star = dq_zu*ztmp1
+         u_star = U_blk*vkarmn/(LOG(zu) -LOG(z0) - psi_m_coare(zeta_u))
+
+         IF( .NOT. l_zt_equal_zu ) THEN
+            ! What's need to be done if zt /= zu
+            !! Re-updating temperature and humidity at zu :
+            ztmp2 = ztmp0 - psi_h_coare(zeta_t)
+            ztmp1 = log(zt/zu) + ztmp2
+            t_zu = t_zt - t_star/vkarmn*ztmp1
+            q_zu = q_zt - q_star/vkarmn*ztmp1
+            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+         END IF
+
+      END DO
+      !
+      ! compute transfer coefficients at zu :
+      ztmp0 = u_star/U_blk
+      Cd   = ztmp0*ztmp0
+      Ch   = ztmp0*t_star/dt_zu
+      Ce   = ztmp0*q_star/dq_zu
+      !
+      CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu )
+      CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )
+      IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t )
+
+      IF( nn_timing == 1 )  CALL timing_stop('turb_coare')
+
+   END SUBROUTINE turb_coare
+
+
+   FUNCTION alfa_charn( pwnd )
+      !!-------------------------------------------------------------------
+      !! Compute the Charnock parameter as a function of the wind speed
+      !!
+      !! (Fairall et al., 2003 p.577-578)
+      !!
+      !! Wind below 10 m/s :  alfa = 0.011
+      !! Wind between 10 and 18 m/s : linear increase from 0.011 to 0.018
+      !! Wind greater than 18 m/s :  alfa = 0.018
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk  (https://sourceforge.net/p/aerobulk)
+      !!-------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd   ! wind speed
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) :: zw, zgt10, zgt18
+      !!-------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zw = pwnd(ji,jj)   ! wind speed
+            !
+            ! Charnock's constant, increases with the wind :
+            zgt10 = 0.5 + SIGN(0.5,(zw - 10.)) ! If zw<10. --> 0, else --> 1
+            zgt18 = 0.5 + SIGN(0.5,(zw - 18.)) ! If zw<18. --> 0, else --> 1
+            !
+            alfa_charn(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s
+               &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) &
+               &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999)
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION alfa_charn
+
+
+   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs )
+      !!------------------------------------------------------------------------
+      !!
+      !! Evaluates the 1./(Monin Obukhov length) from air temperature and
+      !!  specific humidity, and frictional scales u*, t* and q*
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk
+      !!         (https://sourceforge.net/p/aerobulk)
+      !!------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L         !: 1./(Monin Obukhov length) [m^-1]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha,  &  !: average potetntial air temperature [K]
+         &                                        pqa,   &  !: average specific humidity of air   [kg/kg]
+         &                                      pus, pts, pqs   !: frictional velocity, temperature and humidity
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::     zqa          ! local scalar
+      !!-------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zqa = (1. + rctv0*pqa(ji,jj))
+            !
+            One_on_L(ji,jj) =  grav*vkarmn*(pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj)) &
+               &                      / ( pus(ji,jj)*pus(ji,jj) * ptha(ji,jj)*zqa )
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION One_on_L
+
+
+   FUNCTION psi_m_coare( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! ** Purpose: compute the universal profile stability function for momentum
+      !!             COARE 3.0, Fairall et al. 2003
+      !!             pzeta : stability paramenter, z/L where z is altitude
+      !!                     measurement and L is M-O length
+      !!       Stability function for wind speed and scalars matching Kansas and free
+      !!       convection forms with weighting f convective form, follows Fairall et
+      !!       al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !!       form from Beljaars and Holtslag (1991)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zta = pzeta(ji,jj)
+            !
+            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable
+            !
+            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   &
+               & - 2.*ATAN(zphi_m) + 0.5*rpi
+            !
+            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective
+            !
+            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+            !
+            zf = zta*zta
+            zf = zf/(1. + zf)
+            zc = MIN(50., 0.35*zta)
+            zstab = 0.5 + SIGN(0.5, zta)
+            !
+            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0)
+               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0)
+               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     "
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_m_coare
+
+
+   FUNCTION psi_h_coare( pzeta )
+      !!---------------------------------------------------------------------
+      !! Universal profile stability function for temperature and humidity
+      !! COARE 3.0, Fairall et al. 2003
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
+      !!         and L is M-O length
+      !!
+      !! Stability function for wind speed and scalars matching Kansas and free
+      !! convection forms with weighting f convective form, follows Fairall et
+      !! al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !! form from Beljaars and Holtslag (1991)
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk
+      !!         (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zta = pzeta(ji,jj)
+            !
+            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable)
+            !
+            zpsi_k = 2.*LOG((1. + zphi_h)/2.)
+            !
+            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective
+            !
+            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+            !
+            zf = zta*zta
+            zf = zf/(1. + zf)
+            zc = MIN(50.,0.35*zta)
+            zstab = 0.5 + SIGN(0.5, zta)
+            !
+            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) &
+               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     &
+               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 )
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_h_coare
+
+
+   FUNCTION visc_air( ptak )
+      !!---------------------------------------------------------------------
+      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk
+      !!         (https://sourceforge.net/p/aerobulk)
+      !!---------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) :: visc_air
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak  ! air temperature in (K)
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   ztc, ztc2      ! local scalar
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
+            ztc2 = ztc*ztc
+            visc_air(ji,jj) = 1.326E-5*(1. + 6.542E-3*ztc + 8.301E-6*ztc2 - 4.84E-9*ztc2*ztc)
+         END DO
+      END DO
+      !
+   END FUNCTION visc_air
+
+
+END MODULE sbcblk_algo_coare
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90	(revision 8732)
@@ -0,0 +1,421 @@
+MODULE sbcblk_algo_coare3p5
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk_algo_coare3p5  ***
+   !! Computes turbulent components of surface fluxes
+   !!         according to Edson et al. 2013 (COARE v3.5) /JPO
+   !!
+   !!   * bulk transfer coefficients C_D, C_E and C_H
+   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
+   !!   * the effective bulk wind speed at 10m U_blk
+   !!   => all these are used in bulk formulas in sbcblk.F90
+   !!
+   !!    Using the bulk formulation/param. of COARE v3.5, Edson et al. 2013
+   !!
+   !!
+   !!       Routine turb_coare3p5 maintained and developed in AeroBulk
+   !!                     (http://aerobulk.sourceforge.net/)
+   !!
+   !!            Author: Laurent Brodeau, 2016, brodeau@gmail.com
+   !!
+   !!======================================================================
+   !! History :  3.6  !  2016-02  (L.Brodeau)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   turb_coare3p5  : computes the bulk turbulent transfer coefficients
+   !!                   adjusts t_air and q_air from zt to zu m
+   !!                   returns the effective bulk wind speed at 10m
+   !!----------------------------------------------------------------------
+   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 sbcwave, ONLY   :  cdn_wave ! wave module
+#if defined key_lim3 || defined key_cice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#endif
+   !
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distribued memory computing library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lib_fortran     ! to use key_nosignedzero
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ::   TURB_COARE3P5   ! called by sbcblk.F90
+
+   !                                   ! COARE own values for given constants:
+   REAL(wp), PARAMETER ::   charn0_max =   0.028   ! value above which the Charnock paramter levels off for winds > 18
+   REAL(wp), PARAMETER ::   zi0        = 600.      ! scale height of the atmospheric boundary layer...1
+   REAL(wp), PARAMETER ::   Beta0      =   1.25    ! gustiness parameter
+   REAL(wp), PARAMETER ::   rctv0      =   0.608   ! constant to obtain virtual temperature...
+
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
+      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk )
+      !!----------------------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_coare3p5  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to Fairall et al. (2003)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!
+      !! ** Method : Monin Obukhov Similarity Theory
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  zt   : height for temperature and spec. hum. of air            [m]
+      !!    *  zu   : height for wind speed (generally 10m)                   [m]
+      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
+      !!    *  sst  : SST                                                     [K]
+      !!    *  t_zt : potential air temperature at zt                         [K]
+      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
+      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!
+      !!
+      !! OUTPUT :
+      !! --------
+      !!    *  Cd     : drag coefficient
+      !!    *  Ch     : sensible heat coefficient
+      !!    *  Ce     : evaporation coefficient
+      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
+      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
+      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!
+      !!----------------------------------------------------------------------------------
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                   [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                              [m]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature              [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature            [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity         [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu            [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu             [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu             [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      !
+      INTEGER :: j_itt
+      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+      !
+      REAL(wp), DIMENSION(:,:), POINTER  ::  &
+         &  u_star, t_star, q_star, &
+         &  dt_zu, dq_zu,    &
+         &  znu_a,           & !: Nu_air, Viscosity of air
+         &  z0, z0t
+      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu
+      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt
+      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2
+      !!----------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('turb_coare3p5')
+
+      CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu)
+      CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )
+
+      l_zt_equal_zu = .FALSE.
+      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      IF( .NOT. l_zt_equal_zu )   CALL wrk_alloc( jpi,jpj, zeta_t )
+
+      !! First guess of temperature and humidity at height zu:
+      t_zu = MAX(t_zt , 0.0)    ! who knows what's given on masked-continental regions...
+      q_zu = MAX(q_zt , 1.E-6)  !               "
+
+      !! Pot. temp. difference (and we don't want it to be 0!)
+      dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+      dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+
+      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      ztmp2 = 0.5*0.5  ! initial guess for wind gustiness contribution
+      U_blk = SQRT(U_zu*U_zu + ztmp2)
+
+      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0 (with z0 first guess == 0.0001)
+      ztmp0   = LOG(zu*ztmp2)
+      ztmp1   = LOG(10.*ztmp2)
+      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      !! COARE 3.5 first guess of UN10 is U_zu
+      ztmp2 = MIN( 0.0017*U_zu - 0.005 , charn0_max)  ! alpha Charnock parameter (Eq. 13 Edson al. 2013)
+      ztmp2 = MAX( ztmp2 , 0. )                       ! alpha Charnock parameter (Eq. 13 Edson al. 2013)
+      z0     = ztmp2*u_star*u_star/grav + 0.11*znu_a/u_star
+      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
+
+      ztmp2  = vkarmn/ztmp0
+      Cd     = ztmp2*ztmp2    ! first guess of Cd
+
+      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
+
+      !Ribcu = -zu/(zi0*0.004*Beta0**3) !! Saturation Rib, zi0 = tropicalbound. layer depth
+      ztmp2  = grav*zu*(dt_zu + rctv0*t_zu*dq_zu)/(t_zu*U_blk*U_blk)  !! Ribu Bulk Richardson number
+      ztmp1 = 0.5 + sign(0.5 , ztmp2)
+      ztmp0 = ztmp0*ztmp2
+      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
+      zeta_u = (1.-ztmp1) * (ztmp0/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &
+         &  +     ztmp1   * (ztmp0*(1. + 27./9.*ztmp2/ztmp0))
+
+      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
+      ztmp0  =  vkarmn/(LOG(zu*z0t) - psi_h_coare(zeta_u))
+
+      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_coare(zeta_u))
+      t_star = dt_zu*ztmp0
+      q_star = dq_zu*ztmp0
+
+      ! What's need to be done if zt /= zu:
+      IF( .NOT. l_zt_equal_zu ) THEN
+
+         zeta_t = zt*zeta_u/zu
+
+         !! First update of values at zu (or zt for wind)
+         ztmp0 = psi_h_coare(zeta_u) - psi_h_coare(zeta_t)
+         ztmp1 = log(zt/zu) + ztmp0
+         t_zu = t_zt - t_star/vkarmn*ztmp1
+         q_zu = q_zt - q_star/vkarmn*ztmp1
+         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
+
+         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+
+      END IF
+
+      !! ITERATION BLOCK
+      DO j_itt = 1, nb_itt
+
+         !!Inverse of Monin-Obukov length (1/L) :
+         ztmp0 = One_on_L(t_zu, q_zu, u_star, t_star, q_star)  ! 1/L == 1/[Monin-Obukhov length]
+
+         ztmp1 = u_star*u_star   ! u*^2
+
+         !! Update wind at 10m taking into acount convection-related wind gustiness:
+         ! Ug = Beta*w*  (Beta = 1.25, Fairall et al. 2003, Eq.8):
+         ztmp2 = Beta0*Beta0*ztmp1*(MAX(-zi0*ztmp0/vkarmn,0.))**(2./3.)   ! => ztmp2 == Ug^2
+         !!   ! Only true when unstable (L<0) => when ztmp0 < 0 => explains "-" before 600.
+         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)        ! include gustiness in bulk wind speed
+         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
+
+         !! COARE 3.5: Charnock parameter is computed from the neutral wind speed at 10m: Eq. 13 (Edson al. 2013)
+         ztmp2 = u_star/vkarmn*LOG(10./z0)   ! UN10 Neutral wind at 10m!
+         ztmp2 = MIN( 0.0017*ztmp2 - 0.005 , charn0_max)  ! alpha Charnock parameter (Eq. 13 Edson al. 2013)
+         ztmp2 = MAX( ztmp2 , 0. )
+
+         !! Roughness lengthes z0, z0t (z0q = z0t) :
+         z0   = ztmp2*ztmp1/grav + 0.11*znu_a/u_star ! Roughness length (eq.6)
+         ztmp1 = z0*u_star/znu_a                             ! Re_r: roughness Reynolds number
+         !z0t  = MIN( 1.1E-4 , 5.5E-5*ztmp1**(-0.6) )   ! COARE 3.0
+         !! Chris Fairall and Jim Edsson, private communication, March 2016 / COARE 3.5 :
+         z0t   = MIN( 1.6e-4 , 5.8E-5*ztmp1**(-0.72)) ! These thermal roughness lengths give Stanton and
+         !z0q = z0t                                   ! Dalton numbers that closely approximate COARE3.0
+
+         !! Stability parameters:
+         zeta_u = zu*ztmp0 ; zeta_u = sign( min(abs(zeta_u),50.0), zeta_u )
+         IF( .NOT. l_zt_equal_zu ) THEN
+            zeta_t = zt*ztmp0 ;  zeta_t = sign( min(abs(zeta_t),50.0), zeta_t )
+         END IF
+
+         !! Turbulent scales at zu=10m :
+         ztmp0   = psi_h_coare(zeta_u)
+         ztmp1   = vkarmn/(LOG(zu) -LOG(z0t) - ztmp0)
+
+         t_star = dt_zu*ztmp1
+         q_star = dq_zu*ztmp1
+         u_star = U_blk*vkarmn/(LOG(zu) -LOG(z0) - psi_m_coare(zeta_u))
+
+         IF( .NOT. l_zt_equal_zu ) THEN
+            ! What's need to be done if zt /= zu
+            !! Re-updating temperature and humidity at zu :
+            ztmp2 = ztmp0 - psi_h_coare(zeta_t)
+            ztmp1 = log(zt/zu) + ztmp2
+            t_zu = t_zt - t_star/vkarmn*ztmp1
+            q_zu = q_zt - q_star/vkarmn*ztmp1
+            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+         END IF
+
+      END DO
+      !
+      ! compute transfer coefficients at zu :
+      ztmp0 = u_star/U_blk
+      Cd   = ztmp0*ztmp0
+      Ch   = ztmp0*t_star/dt_zu
+      Ce   = ztmp0*q_star/dq_zu
+      !
+      CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu )
+      CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 )
+      IF( .NOT. l_zt_equal_zu ) CALL wrk_dealloc( jpi,jpj, zeta_t )
+
+      IF( nn_timing == 1 )  CALL timing_stop('turb_coare3p5')
+
+   END SUBROUTINE turb_coare3p5
+
+
+
+   FUNCTION One_on_L( ptha, pqa, pus, pts, pqs )
+      !!------------------------------------------------------------------------
+      !!
+      !! Evaluates the 1./(Monin Obukhov length) from air temperature and
+      !!  specific humidity, and frictional scales u*, t* and q*
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk
+      !!         (https://sourceforge.net/p/aerobulk)
+      !!------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             :: One_on_L         !: 1./(Monin Obukhov length) [m^-1]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha,  &  !: average potetntial air temperature [K]
+         &                                        pqa,   &  !: average specific humidity of air   [kg/kg]
+         &                                      pus, pts, pqs   !: frictional velocity, temperature and humidity
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::     zqa          ! local scalar
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zqa = (1. + rctv0*pqa(ji,jj))
+            !
+            One_on_L(ji,jj) =  grav*vkarmn*(pts(ji,jj)*zqa + rctv0*ptha(ji,jj)*pqs(ji,jj)) &
+               &                      / ( pus(ji,jj)*pus(ji,jj) * ptha(ji,jj)*zqa )
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION One_on_L
+
+
+   FUNCTION psi_m_coare( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! ** Purpose: compute the universal profile stability function for momentum
+      !!             COARE 3.0, Fairall et al. 2003
+      !!             pzeta : stability paramenter, z/L where z is altitude
+      !!                     measurement and L is M-O length
+      !!       Stability function for wind speed and scalars matching Kansas and free
+      !!       convection forms with weighting f convective form, follows Fairall et
+      !!       al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !!       form from Beljaars and Holtslag (1991)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zta = pzeta(ji,jj)
+            !
+            zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable
+            !
+            zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   &
+               & - 2.*ATAN(zphi_m) + 0.5*rpi
+            !
+            zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective
+            !
+            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+               &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+            !
+            zf = zta*zta
+            zf = zf/(1. + zf)
+            zc = MIN(50., 0.35*zta)
+            zstab = 0.5 + SIGN(0.5, zta)
+            !
+            psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0)
+               &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0)
+               &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     "
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_m_coare
+
+
+   FUNCTION psi_h_coare( pzeta )
+      !!---------------------------------------------------------------------
+      !! Universal profile stability function for temperature and humidity
+      !! COARE 3.0, Fairall et al. 2003
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
+      !!         and L is M-O length
+      !!
+      !! Stability function for wind speed and scalars matching Kansas and free
+      !! convection forms with weighting f convective form, follows Fairall et
+      !! al (1996) with profile constants from Grachev et al (2000) BLM stable
+      !! form from Beljaars and Holtslag (1991)
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk
+      !!         (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zta = pzeta(ji,jj)
+            !
+            zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable)
+            !
+            zpsi_k = 2.*LOG((1. + zphi_h)/2.)
+            !
+            zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective
+            !
+            zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) &
+               &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447
+            !
+            zf = zta*zta
+            zf = zf/(1. + zf)
+            zc = MIN(50.,0.35*zta)
+            zstab = 0.5 + SIGN(0.5, zta)
+            !
+            psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) &
+               &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     &
+               &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 )
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_h_coare
+
+
+   FUNCTION visc_air( ptak )
+      !!---------------------------------------------------------------------
+      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
+      !!
+      !! Author: L. Brodeau, june 2016 / AeroBulk
+      !!         (https://sourceforge.net/p/aerobulk)
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature   [K]
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   ztc, ztc2      ! local scalar
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
+            ztc2 = ztc*ztc
+            visc_air(ji,jj) = 1.326E-5*(1. + 6.542E-3*ztc + 8.301E-6*ztc2 - 4.84E-9*ztc2*ztc)
+         END DO
+      END DO
+      !
+   END FUNCTION visc_air
+
+   !!======================================================================
+END MODULE sbcblk_algo_coare3p5
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90	(revision 8732)
@@ -0,0 +1,431 @@
+MODULE sbcblk_algo_ecmwf
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk_algo_ecmwf  ***
+   !! Computes turbulent components of surface fluxes
+   !!         according to the method in IFS of the ECMWF model
+   !!
+   !!   * bulk transfer coefficients C_D, C_E and C_H
+   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
+   !!   * the effective bulk wind speed at 10m U_blk
+   !!   => all these are used in bulk formulas in sbcblk.F90
+   !!
+   !!    Using the bulk formulation/param. of IFS of ECMWF (cycle 31r2)
+   !!         based on IFS doc (avaible online on the ECMWF's website)
+   !!
+   !!
+   !!       Routine turb_ecmwf maintained and developed in AeroBulk
+   !!                     (http://aerobulk.sourceforge.net/)
+   !!
+   !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+   !!----------------------------------------------------------------------
+   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   turb_ecmwf  : computes the bulk turbulent transfer coefficients
+   !!                   adjusts t_air and q_air from zt to zu m
+   !!                   returns the effective bulk wind speed at 10m
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distribued memory computing library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE sbcwave, ONLY   :  cdn_wave ! wave module
+#if defined key_lim3 || defined key_cice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#endif
+   USE lib_fortran     ! to use key_nosignedzero
+
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90
+
+   !                   !! ECMWF own values for given constants, taken form IFS documentation...
+   REAL(wp), PARAMETER ::   charn0 = 0.018    ! Charnock constant (pretty high value here !!!
+   !                                          !    =>  Usually 0.011 for moderate winds)
+   REAL(wp), PARAMETER ::   zi0     = 1000.   ! scale height of the atmospheric boundary layer...1
+   REAL(wp), PARAMETER ::   Beta0    = 1.     ! gustiness parameter ( = 1.25 in COAREv3)
+   REAL(wp), PARAMETER ::   rctv0    = 0.608  ! constant to obtain virtual temperature...
+   REAL(wp), PARAMETER ::   Cp_dry = 1005.0   ! Specic heat of dry air, constant pressure      [J/K/kg]
+   REAL(wp), PARAMETER ::   Cp_vap = 1860.0   ! Specic heat of water vapor, constant pressure  [J/K/kg]
+   REAL(wp), PARAMETER ::   alpha_M = 0.11    ! For roughness length (smooth surface term)
+   REAL(wp), PARAMETER ::   alpha_H = 0.40    ! (Chapter 3, p.34, IFS doc Cy31r1)
+   REAL(wp), PARAMETER ::   alpha_Q = 0.62    !
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   &
+      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk )
+      !!----------------------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_ecmwf  ***
+      !!
+      !!            2015: L. Brodeau (brodeau@gmail.com)
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to IFS doc. (cycle 31)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!
+      !! ** Method : Monin Obukhov Similarity Theory
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  zt   : height for temperature and spec. hum. of air            [m]
+      !!    *  zu   : height for wind speed (generally 10m)                   [m]
+      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
+      !!    *  sst  : SST                                                     [K]
+      !!    *  t_zt : potential air temperature at zt                         [K]
+      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
+      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!
+      !!
+      !! OUTPUT :
+      !! --------
+      !!    *  Cd     : drag coefficient
+      !!    *  Ch     : sensible heat coefficient
+      !!    *  Ce     : evaporation coefficient
+      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
+      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
+      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      !
+      INTEGER :: j_itt
+      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+      !
+      REAL(wp), DIMENSION(:,:), POINTER  ::   u_star, t_star, q_star,   &
+         &  dt_zu, dq_zu,    &
+         &  znu_a,           & !: Nu_air, Viscosity of air
+         &  Linv,            & !: 1/L (inverse of Monin Obukhov length...
+         &  z0, z0t, z0q
+      REAL(wp), DIMENSION(:,:), POINTER ::   func_m, func_h
+      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2
+      !!----------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('turb_ecmwf')
+      !
+      CALL wrk_alloc( jpi,jpj,   u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv )
+      CALL wrk_alloc( jpi,jpj,   znu_a, z0, z0t, z0q, ztmp0, ztmp1, ztmp2 )
+      !
+      ! Identical first gess as in COARE, with IFS parameter values though
+      !
+      l_zt_equal_zu = .FALSE.
+      IF( ABS(zu - zt) < 0.01 )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+
+      !! First guess of temperature and humidity at height zu:
+      t_zu = MAX( t_zt , 0.0  )   ! who knows what's given on masked-continental regions...
+      q_zu = MAX( q_zt , 1.e-6)   !               "
+
+      !! Pot. temp. difference (and we don't want it to be 0!)
+      dt_zu = t_zu - sst   ;   dt_zu = SIGN( MAX(ABS(dt_zu),1.e-6), dt_zu )
+      dq_zu = q_zu - ssq   ;   dq_zu = SIGN( MAX(ABS(dq_zu),1.e-9), dq_zu )
+
+      znu_a = visc_air(t_zt) ! Air viscosity (m^2/s) at zt given from temperature in (K)
+
+      ztmp2 = 0.5 * 0.5  ! initial guess for wind gustiness contribution
+      U_blk = SQRT(U_zu*U_zu + ztmp2)
+
+      ! z0     = 0.0001
+      ztmp2   = 10000.     ! optimization: ztmp2 == 1/z0
+      ztmp0   = LOG(zu*ztmp2)
+      ztmp1   = LOG(10.*ztmp2)
+      u_star = 0.035*U_blk*ztmp1/ztmp0       ! (u* = 0.035*Un10)
+
+      z0     = charn0*u_star*u_star/grav + 0.11*znu_a/u_star
+      z0t    = 0.1*EXP(vkarmn/(0.00115/(vkarmn/ztmp1)))   !  WARNING: 1/z0t !
+
+      Cd     = (vkarmn/ztmp0)**2    ! first guess of Cd
+
+      ztmp0 = vkarmn*vkarmn/LOG(zt*z0t)/Cd
+
+      ztmp2 = Ri_bulk( zu, t_zu, dt_zu, q_zu, dq_zu, U_blk )   ! Ribu = Bulk Richardson number
+
+      !! First estimate of zeta_u, depending on the stability, ie sign of Ribu (ztmp2):
+      ztmp1 = 0.5 + SIGN( 0.5 , ztmp2 )
+      func_m = ztmp0*ztmp2 ! temporary array !!
+      !!             Ribu < 0                                 Ribu > 0   Beta = 1.25
+      func_h = (1.-ztmp1)*(func_m/(1.+ztmp2/(-zu/(zi0*0.004*Beta0**3)))) &  ! temporary array !!! func_h == zeta_u
+         &  +     ztmp1*(func_m*(1. + 27./9.*ztmp2/ztmp0))
+
+      !! First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate z0 and z/L
+      ztmp0   =        vkarmn/(LOG(zu*z0t) - psi_h_ecmwf(func_h))
+
+      u_star = U_blk*vkarmn/(LOG(zu) - LOG(z0)  - psi_m_ecmwf(func_h))
+      t_star = dt_zu*ztmp0
+      q_star = dq_zu*ztmp0
+
+      ! What's need to be done if zt /= zu:
+      IF( .NOT. l_zt_equal_zu ) THEN
+         !
+         !! First update of values at zu (or zt for wind)
+         ztmp0 = psi_h_ecmwf(func_h) - psi_h_ecmwf(zt*func_h/zu)    ! zt*func_h/zu == zeta_t
+         ztmp1 = log(zt/zu) + ztmp0
+         t_zu = t_zt - t_star/vkarmn*ztmp1
+         q_zu = q_zt - q_star/vkarmn*ztmp1
+         q_zu = (0.5 + sign(0.5,q_zu))*q_zu !Makes it impossible to have negative humidity :
+
+         dt_zu = t_zu - sst  ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+         dq_zu = q_zu - ssq  ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+         !
+      ENDIF
+
+
+      !! => that was same first guess as in COARE...
+
+
+      !! First guess of inverse of Monin-Obukov length (1/L) :
+      ztmp0 = (1. + rctv0*q_zu)  ! the factor to apply to temp. to get virt. temp...
+      Linv  =  grav*vkarmn*(t_star*ztmp0 + rctv0*t_zu*q_star) / ( u_star*u_star * t_zu*ztmp0 )
+
+      !! Functions such as  u* = U_blk*vkarmn/func_m
+      ztmp1 = zu + z0
+      ztmp0 = ztmp1*Linv
+      func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)
+      func_h = LOG(ztmp1*z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(1./z0t*Linv)
+
+
+      !! ITERATION BLOCK
+      !! ***************
+
+      DO j_itt = 1, nb_itt
+
+         !! Bulk Richardson Number at z=zu (Eq. 3.25)
+         ztmp0 = Ri_bulk(zu, t_zu, dt_zu, q_zu, dq_zu, U_blk)
+
+         !! New estimate of the inverse of the Monin-Obukhon length (Linv == zeta/zu) :
+         Linv = ztmp0*func_m*func_m/func_h / zu     ! From Eq. 3.23, Chap.3, p.33, IFS doc - Cy31r1
+
+         !! Update func_m with new Linv:
+         ztmp1 = zu + z0
+         func_m = LOG(ztmp1) -LOG(z0) - psi_m_ecmwf(ztmp1*Linv) + psi_m_ecmwf(z0*Linv)
+
+         !! Need to update roughness lengthes:
+         u_star = U_blk*vkarmn/func_m
+         ztmp2  = u_star*u_star
+         ztmp1  = znu_a/u_star
+         z0    = alpha_M*ztmp1 + charn0*ztmp2/grav
+         z0t    = alpha_H*ztmp1                              ! eq.3.26, Chap.3, p.34, IFS doc - Cy31r1
+         z0q    = alpha_Q*ztmp1
+
+         !! Update wind at 10m taking into acount convection-related wind gustiness:
+         ! Only true when unstable (L<0) => when ztmp0 < 0 => - !!!
+         ztmp2 = ztmp2 * (MAX(-zi0*Linv/vkarmn,0.))**(2./3.) ! => w*^2  (combining Eq. 3.8 and 3.18, hap.3, IFS doc - Cy31r1)
+         !! => equivalent using Beta=1 (gustiness parameter, 1.25 for COARE, also zi0=600 in COARE..)
+         U_blk = MAX(sqrt(U_zu*U_zu + ztmp2), 0.2)              ! eq.3.17, Chap.3, p.32, IFS doc - Cy31r1
+         ! => 0.2 prevents U_blk to be 0 in stable case when U_zu=0.
+
+
+         !! Need to update "theta" and "q" at zu in case they are given at different heights
+         !! as well the air-sea differences:
+         IF( .NOT. l_zt_equal_zu ) THEN
+
+            !! Arrays func_m and func_h are free for a while so using them as temporary arrays...
+            func_h = psi_h_ecmwf((zu+z0)*Linv) ! temporary array !!!
+            func_m = psi_h_ecmwf((zt+z0)*Linv) ! temporary array !!!
+
+            ztmp2  = psi_h_ecmwf(z0t*Linv)
+            ztmp0  = func_h - ztmp2
+            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0t) - ztmp0)
+            t_star = dt_zu*ztmp1
+            ztmp2  = ztmp0 - func_m + ztmp2
+            ztmp1  = LOG(zt/zu) + ztmp2
+            t_zu   = t_zt - t_star/vkarmn*ztmp1
+
+            ztmp2  = psi_h_ecmwf(z0q*Linv)
+            ztmp0  = func_h - ztmp2
+            ztmp1  = vkarmn/(LOG(zu+z0) - LOG(z0q) - ztmp0)
+            q_star = dq_zu*ztmp1
+            ztmp2  = ztmp0 - func_m + ztmp2
+            ztmp1  = log(zt/zu) + ztmp2
+            q_zu   = q_zt - q_star/vkarmn*ztmp1
+
+            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu )
+            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu )
+         END IF
+
+         !! Updating because of updated z0 and z0t and new Linv...
+         ztmp1 = zu + z0
+         ztmp0 = ztmp1*Linv
+         func_m = log(ztmp1) - LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)
+         func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv)
+
+      END DO
+
+      Cd = vkarmn*vkarmn/(func_m*func_m)
+      Ch = vkarmn*vkarmn/(func_m*func_h)
+      ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q
+      Ce = vkarmn*vkarmn/(func_m*ztmp1)
+
+      CALL wrk_dealloc( jpi,jpj,   u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv )
+      CALL wrk_dealloc( jpi,jpj,   znu_a, z0, z0t, z0q, ztmp0, ztmp1, ztmp2 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('turb_ecmwf')
+      !
+   END SUBROUTINE TURB_ECMWF
+
+
+   FUNCTION psi_m_ecmwf( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! Universal profile stability function for momentum
+      !!     ECMWF / as in IFS cy31r1 documentation, available online
+      !!     at ecmwf.int
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
+      !!         and L is M-O length
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zzeta = MIN( pzeta(ji,jj) , 5. ) !! Very stable conditions (L positif and big!):
+            !
+            ! Unstable (Paulson 1970):
+            !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+            zx = SQRT(ABS(1. - 16.*zzeta))
+            ztmp = 1. + SQRT(zx)
+            ztmp = ztmp*ztmp
+            psi_unst = LOG( 0.125*ztmp*(1. + zx) )   &
+               &       -2.*ATAN( SQRT(zx) ) + 0.5*rpi
+            !
+            ! Unstable:
+            ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
+            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) &
+               &       - zzeta - 2./3.*5./0.35
+            !
+            ! Combining:
+            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
+            !
+            psi_m_ecmwf(ji,jj) = (1. - stab) * psi_unst & ! (zzeta < 0) Unstable
+               &                +      stab  * psi_stab   ! (zzeta > 0) Stable
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_m_ecmwf
+
+   
+   FUNCTION psi_h_ecmwf( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! Universal profile stability function for temperature and humidity
+      !!     ECMWF / as in IFS cy31r1 documentation, available online
+      !!     at ecmwf.int
+      !!
+      !! pzeta : stability paramenter, z/L where z is altitude measurement
+      !!         and L is M-O length
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) ::  zzeta, zx, psi_unst, psi_stab, stab
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zzeta = MIN(pzeta(ji,jj) , 5.)   ! Very stable conditions (L positif and big!):
+            !
+            zx  = ABS(1. - 16.*zzeta)**.25        ! this is actually (1/phi_m)**2  !!!
+            !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1
+            ! Unstable (Paulson 1970) :
+            psi_unst = 2.*LOG(0.5*(1. + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1
+            !
+            ! Stable:
+            psi_stab = -2./3.*(zzeta - 5./0.35)*EXP(-0.35*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1
+               &       - ABS(1. + 2./3.*zzeta)**1.5 - 2./3.*5./0.35 + 1. 
+            ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution...
+            !
+            stab = 0.5 + SIGN(0.5, zzeta) ! zzeta > 0 => stab = 1
+            !
+            !
+            psi_h_ecmwf(ji,jj) = (1. - stab) * psi_unst &   ! (zzeta < 0) Unstable
+               &                +    stab    * psi_stab     ! (zzeta > 0) Stable
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_h_ecmwf
+
+
+   FUNCTION Ri_bulk( pz, ptz, pdt, pqz, pdq, pub )
+      !!----------------------------------------------------------------------------------
+      !! Bulk Richardson number (Eq. 3.25 IFS doc)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj) ::   Ri_bulk   !
+      !
+      REAL(wp)                    , INTENT(in) ::   pz    ! height above the sea        [m]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptz   ! air temperature at pz m     [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdt   ! ptz - sst                   [K]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqz   ! air temperature at pz m [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pdq   ! pqz - ssq               [kg/kg]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pub   ! bulk wind speed           [m/s]
+      !!----------------------------------------------------------------------------------
+      !
+      Ri_bulk =   grav*pz/(pub*pub)                                          &
+         &      * ( pdt/(ptz - 0.5_wp*(pdt + grav*pz/(Cp_dry+Cp_vap*pqz)))   &
+         &          + rctv0*pdq )
+      !
+   END FUNCTION Ri_bulk
+
+
+   FUNCTION visc_air(ptak)
+      !!----------------------------------------------------------------------------------
+      !! Air kinetic viscosity (m^2/s) given from temperature in degrees...
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)             ::   visc_air   !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak       ! air temperature in (K)
+      !
+      INTEGER  ::   ji, jj      ! dummy loop indices
+      REAL(wp) ::   ztc, ztc2   ! local scalar
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztc  = ptak(ji,jj) - rt0   ! air temp, in deg. C
+            ztc2 = ztc*ztc
+            visc_air(ji,jj) = 1.326e-5*(1. + 6.542E-3*ztc + 8.301e-6*ztc2 - 4.84e-9*ztc2*ztc)
+         END DO
+      END DO
+      !
+   END FUNCTION visc_air
+
+   !!======================================================================
+END MODULE sbcblk_algo_ecmwf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90	(revision 8732)
@@ -0,0 +1,335 @@
+MODULE sbcblk_algo_ncar
+   !!======================================================================
+   !!                   ***  MODULE  sbcblk_algo_ncar  ***
+   !! Computes:
+   !!   * bulk transfer coefficients C_D, C_E and C_H
+   !!   * air temp. and spec. hum. adjusted from zt (2m) to zu (10m) if needed
+   !!   * the effective bulk wind speed at 10m U_blk
+   !!   => all these are used in bulk formulas in sbcblk.F90
+   !!
+   !!    Using the bulk formulation/param. of Large & Yeager 2008
+   !!
+   !!       Routine turb_ncar maintained and developed in AeroBulk
+   !!                     (http://aerobulk.sourceforge.net/)
+   !!
+   !!                         L. Brodeau, 2015
+   !!=====================================================================
+   !! History :  3.6  !  2016-02  (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   turb_ncar  : computes the bulk turbulent transfer coefficients
+   !!                   adjusts t_air and q_air from zt to zu m
+   !!                   returns the effective bulk wind speed at 10m
+   !!----------------------------------------------------------------------
+   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 sbcwave, ONLY   :  cdn_wave ! wave module
+#if defined key_lim3 || defined key_cice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#endif
+   !
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distribued memory computing library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lib_fortran     ! to use key_nosignedzero
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90
+
+   !                              ! NCAR own values for given constants:
+   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature...
+   
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, &
+      &                  Cd, Ch, Ce, t_zu, q_zu, U_blk )
+      !!----------------------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_ncar  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to Large & Yeager (2004) and Large & Yeager (2008)
+      !!                If relevant (zt /= zu), adjust temperature and humidity from height zt to zu
+      !!                Returns the effective bulk wind speed at 10m to be used in the bulk formulas
+      !!
+      !! ** Method : Monin Obukhov Similarity Theory
+      !!             + Large & Yeager (2004,2008) closure: CD_n10 = f(U_n10)
+      !!
+      !! ** References :   Large & Yeager, 2004 / Large & Yeager, 2008
+      !!
+      !! ** Last update: Laurent Brodeau, June 2014:
+      !!    - handles both cases zt=zu and zt/=zu
+      !!    - optimized: less 2D arrays allocated and less operations
+      !!    - better first guess of stability by checking air-sea difference of virtual temperature
+      !!       rather than temperature difference only...
+      !!    - added function "cd_neutral_10m" that uses the improved parametrization of
+      !!      Large & Yeager 2008. Drag-coefficient reduction for Cyclone conditions!
+      !!    - using code-wide physical constants defined into "phycst.mod" rather than redifining them
+      !!      => 'vkarmn' and 'grav'
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!
+      !! INPUT :
+      !! -------
+      !!    *  zt   : height for temperature and spec. hum. of air            [m]
+      !!    *  zu   : height for wind speed (generally 10m)                   [m]
+      !!    *  U_zu : scalar wind speed at 10m                                [m/s]
+      !!    *  sst  : SST                                                     [K]
+      !!    *  t_zt : potential air temperature at zt                         [K]
+      !!    *  ssq  : specific humidity at saturation at SST                  [kg/kg]
+      !!    *  q_zt : specific humidity of air at zt                          [kg/kg]
+      !!
+      !!
+      !! OUTPUT :
+      !! --------
+      !!    *  Cd     : drag coefficient
+      !!    *  Ch     : sensible heat coefficient
+      !!    *  Ce     : evaporation coefficient
+      !!    *  t_zu   : pot. air temperature adjusted at wind height zu       [K]
+      !!    *  q_zu   : specific humidity of air        //                    [kg/kg]
+      !!    *  U_blk  : bulk wind at 10m                                      [m/s]
+      !!----------------------------------------------------------------------------------
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                   [kg/kg]
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s]
+      !
+      INTEGER ::   j_itt
+      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U
+      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations
+      !
+      REAL(wp), DIMENSION(:,:), POINTER ::   Cx_n10        ! 10m neutral latent/sensible coefficient
+      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10
+      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu
+      REAL(wp), DIMENSION(:,:), POINTER ::   zpsi_h_u
+      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2
+      REAL(wp), DIMENSION(:,:), POINTER ::   stab          ! stability test integer
+      !!----------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('turb_ncar')
+      !
+      CALL wrk_alloc( jpi,jpj,   Cx_n10, sqrt_Cd_n10, zeta_u, stab )
+      CALL wrk_alloc( jpi,jpj,   zpsi_h_u, ztmp0, ztmp1, ztmp2 )
+      !
+      l_zt_equal_zu = .FALSE.
+      IF( ABS(zu - zt) < 0.01 ) l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision
+
+      U_blk = MAX( 0.5 , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s
+
+      !! First guess of stability:
+      ztmp0 = t_zt*(1. + rctv0*q_zt) - sst*(1. + rctv0*ssq) ! air-sea difference of virtual pot. temp. at zt
+      stab  = 0.5 + sign(0.5,ztmp0)                           ! stab = 1 if dTv > 0  => STABLE, 0 if unstable
+
+      !! Neutral coefficients at 10m:
+      IF( ln_cdgw ) THEN      ! wave drag case
+         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) )
+         ztmp0   (:,:) = cdn_wave(:,:)
+      ELSE
+         ztmp0 = cd_neutral_10m( U_blk )
+      ENDIF
+
+      sqrt_Cd_n10 = SQRT( ztmp0 )
+
+      !! Initializing transf. coeff. with their first guess neutral equivalents :
+      Cd = ztmp0
+      Ce = 1.e-3*( 34.6 * sqrt_Cd_n10 )
+      Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))
+      stab = sqrt_Cd_n10   ! Temporaty array !!! stab == SQRT(Cd)
+
+      !! Initializing values at z_u with z_t values:
+      t_zu = t_zt   ;   q_zu = q_zt
+
+      !!  * Now starting iteration loop
+      DO j_itt=1, nb_itt
+         !
+         ztmp1 = t_zu - sst   ! Updating air/sea differences
+         ztmp2 = q_zu - ssq
+
+         ! Updating turbulent scales :   (L&Y 2004 eq. (7))
+         ztmp1  = Ch/stab*ztmp1    ! theta*   (stab == SQRT(Cd))
+         ztmp2  = Ce/stab*ztmp2    ! q*       (stab == SQRT(Cd))
+
+         ztmp0 = 1. + rctv0*q_zu      ! multiply this with t and you have the virtual temperature
+
+         ! Estimate the inverse of Monin-Obukov length (1/L) at height zu:
+         ztmp0 =  (grav*vkarmn/(t_zu*ztmp0)*(ztmp1*ztmp0 + rctv0*t_zu*ztmp2)) / (Cd*U_blk*U_blk)
+         !                                                      ( Cd*U_blk*U_blk is U*^2 at zu )
+
+         !! Stability parameters :
+         zeta_u   = zu*ztmp0   ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
+         zpsi_h_u = psi_h( zeta_u )
+
+         !! Shifting temperature and humidity at zu (L&Y 2004 eq. (9b-9c))
+         IF( .NOT. l_zt_equal_zu ) THEN
+            !! Array 'stab' is free for the moment so using it to store 'zeta_t'
+            stab = zt*ztmp0 ;  stab = SIGN( MIN(ABS(stab),10.0), stab )  ! Temporaty array stab == zeta_t !!!
+            stab = LOG(zt/zu) + zpsi_h_u - psi_h(stab)                   ! stab just used as temp array again!
+            t_zu = t_zt - ztmp1/vkarmn*stab    ! ztmp1 is still theta*  L&Y 2004 eq.(9b)
+            q_zu = q_zt - ztmp2/vkarmn*stab    ! ztmp2 is still q*      L&Y 2004 eq.(9c)
+            q_zu = max(0., q_zu)
+         END IF
+
+         ztmp2 = psi_m(zeta_u)
+         IF( ln_cdgw ) THEN      ! surface wave case
+            stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 )  ! (stab == SQRT(Cd))
+            Cd      = stab * stab
+         ELSE
+            ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)...
+            !   In very rare low-wind conditions, the old way of estimating the
+            !   neutral wind speed at 10m leads to a negative value that causes the code
+            !   to crash. To prevent this a threshold of 0.25m/s is imposed.
+            ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u))
+            ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10
+            sqrt_Cd_n10 = sqrt(ztmp0)
+
+            stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability
+            Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10)
+
+            !! Update of transfer coefficients:
+            ztmp1 = 1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)   ! L&Y 2004 eq. (10a) (ztmp2 == psi_m(zeta_u))
+            Cd      = ztmp0 / ( ztmp1*ztmp1 )
+            stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd))
+         ENDIF
+
+         ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10
+         ztmp2 = stab / sqrt_Cd_n10   ! (stab == SQRT(Cd))
+         ztmp1 = 1. + Cx_n10*ztmp0    ! (Cx_n10 == Ch_n10)
+         Ch  = Cx_n10*ztmp2 / ztmp1   ! L&Y 2004 eq. (10b)
+
+         Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10
+         ztmp1 = 1. + Cx_n10*ztmp0
+         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c)
+
+      END DO
+
+      CALL wrk_dealloc( jpi,jpj,   Cx_n10, sqrt_Cd_n10, zeta_u, stab )
+      CALL wrk_dealloc( jpi,jpj,   zpsi_h_u, ztmp0, ztmp1, ztmp2 )
+
+      IF( nn_timing == 1 )   CALL timing_stop('turb_ncar')
+
+   END SUBROUTINE turb_ncar
+
+
+   FUNCTION cd_neutral_10m( pw10 )
+      !!----------------------------------------------------------------------------------      
+      !! Estimate of the neutral drag coefficient at 10m as a function
+      !! of neutral wind  speed at 10m
+      !!
+      !! Origin: Large & Yeager 2008 eq.(11a) and eq.(11b)
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10           ! scalar wind speed at 10m (m/s)
+      REAL(wp), DIMENSION(jpi,jpj)             :: cd_neutral_10m
+      !
+      INTEGER  ::     ji, jj     ! dummy loop indices
+      REAL(wp) :: zgt33, zw, zw6 ! local scalars
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zw  = pw10(ji,jj)
+            zw6 = zw*zw*zw
+            zw6 = zw6*zw6
+            !
+            ! When wind speed > 33 m/s => Cyclone conditions => special treatment
+            zgt33 = 0.5 + SIGN( 0.5, (zw - 33.) )   ! If pw10 < 33. => 0, else => 1
+            !
+            cd_neutral_10m(ji,jj) = 1.e-3 * ( &
+               &       (1. - zgt33)*( 2.7/zw + 0.142 + zw/13.09 - 3.14807E-10*zw6) & ! wind <  33 m/s
+               &      +    zgt33   *      2.34 )                                     ! wind >= 33 m/s
+            !
+            cd_neutral_10m(ji,jj) = MAX(cd_neutral_10m(ji,jj), 1.E-6)
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION cd_neutral_10m
+
+
+   FUNCTION psi_m( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! Universal profile stability function for momentum
+      !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
+      !!     
+      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !!         and L is M-O length
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pzeta
+      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_m
+      !
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) :: zx2, zx, zstab   ! local scalars
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
+            zx2 = MAX ( zx2 , 1. )
+            zx  = SQRT( zx2 )
+            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
+            !
+            psi_m(ji,jj) =        zstab  * (-5.*pzeta(ji,jj))       &          ! Stable
+               &          + (1. - zstab) * (2.*LOG((1. + zx)*0.5)   &          ! Unstable
+               &               + LOG((1. + zx2)*0.5) - 2.*ATAN(zx) + rpi*0.5)  !    "
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_m
+
+
+   FUNCTION psi_h( pzeta )
+      !!----------------------------------------------------------------------------------
+      !! Universal profile stability function for temperature and humidity
+      !!    !! Psis, L&Y 2004 eq. (8c), (8d), (8e)
+      !!
+      !! pzet0 : stability paramenter, z/L where z is altitude measurement                                          
+      !!         and L is M-O length
+      !!
+      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)
+      !!----------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp) :: zx2, zstab  ! local scalars
+      !!----------------------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zx2 = SQRT( ABS( 1. - 16.*pzeta(ji,jj) ) )
+            zx2 = MAX ( zx2 , 1. )
+            zstab = 0.5 + SIGN( 0.5 , pzeta(ji,jj) )
+            !
+            psi_h(ji,jj) =         zstab  * (-5.*pzeta(ji,jj))        &  ! Stable
+               &           + (1. - zstab) * (2.*LOG( (1. + zx2)*0.5 ))   ! Unstable
+            !
+         END DO
+      END DO
+      !
+   END FUNCTION psi_h
+
+   !!======================================================================
+END MODULE sbcblk_algo_ncar
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 8732)
@@ -0,0 +1,2476 @@
+MODULE sbccpl
+   !!======================================================================
+   !!                       ***  MODULE  sbccpl  ***
+   !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
+   !!======================================================================
+   !! 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
+   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   namsbc_cpl      : coupled formulation namlist
+   !!   sbc_cpl_init    : initialisation of the coupled exchanges
+   !!   sbc_cpl_rcv     : receive fields from the atmosphere over the ocean (ocean only)
+   !!                     receive stress from the atmosphere over the ocean (ocean-ice case)
+   !!   sbc_cpl_ice_tau : receive stress from the atmosphere over ice
+   !!   sbc_cpl_ice_flx : receive fluxes from the atmosphere over ice
+   !!   sbc_cpl_snd     : send     fields to the atmosphere
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE trc_oce         ! share SMS/Ocean variables
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcapr          ! Stochastic param. : ???
+   USE sbcdcy          ! surface boundary condition: diurnal cycle
+   USE sbcwave         ! surface boundary condition: waves
+   USE phycst          ! physical constants
+#if defined key_lim3
+   USE ice            ! ice variables
+#endif
+#if defined key_lim2
+   USE par_ice_2      ! ice parameters
+   USE ice_2          ! ice variables
+#endif
+   USE cpl_oasis3     ! OASIS3 coupling
+   USE geo2ocean      ! 
+   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
+   USE albedo         ! 
+   USE eosbn2         ! 
+   USE sbcrnf, ONLY : l_rnfcpl
+   USE sbcisf   , ONLY : l_isfcpl
+#if defined key_cice
+   USE ice_domain_size, only: ncat
+#endif
+#if defined key_lim3
+   USE limthd_dh      ! for CALL lim_thd_snwblow
+#endif
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! NetCDF library
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90
+   PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_snd       ! routine called by step.F90
+   PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90
+   PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90
+
+   INTEGER, PARAMETER ::   jpr_otx1   =  1   ! 3 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jpr_oty1   =  2   ! 
+   INTEGER, PARAMETER ::   jpr_otz1   =  3   ! 
+   INTEGER, PARAMETER ::   jpr_otx2   =  4   ! 3 atmosphere-ocean stress components on grid 2
+   INTEGER, PARAMETER ::   jpr_oty2   =  5   ! 
+   INTEGER, PARAMETER ::   jpr_otz2   =  6   ! 
+   INTEGER, PARAMETER ::   jpr_itx1   =  7   ! 3 atmosphere-ice   stress components on grid 1
+   INTEGER, PARAMETER ::   jpr_ity1   =  8   ! 
+   INTEGER, PARAMETER ::   jpr_itz1   =  9   ! 
+   INTEGER, PARAMETER ::   jpr_itx2   = 10   ! 3 atmosphere-ice   stress components on grid 2
+   INTEGER, PARAMETER ::   jpr_ity2   = 11   ! 
+   INTEGER, PARAMETER ::   jpr_itz2   = 12   ! 
+   INTEGER, PARAMETER ::   jpr_qsroce = 13   ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jpr_qsrice = 14   ! Qsr above the ice
+   INTEGER, PARAMETER ::   jpr_qsrmix = 15 
+   INTEGER, PARAMETER ::   jpr_qnsoce = 16   ! Qns above the ocean
+   INTEGER, PARAMETER ::   jpr_qnsice = 17   ! Qns above the ice
+   INTEGER, PARAMETER ::   jpr_qnsmix = 18
+   INTEGER, PARAMETER ::   jpr_rain   = 19   ! total liquid precipitation (rain)
+   INTEGER, PARAMETER ::   jpr_snow   = 20   ! solid precipitation over the ocean (snow)
+   INTEGER, PARAMETER ::   jpr_tevp   = 21   ! total evaporation
+   INTEGER, PARAMETER ::   jpr_ievp   = 22   ! solid evaporation (sublimation)
+   INTEGER, PARAMETER ::   jpr_sbpr   = 23   ! sublimation - liquid precipitation - solid precipitation
+   INTEGER, PARAMETER ::   jpr_semp   = 24   ! solid freshwater budget (sublimation - snow)
+   INTEGER, PARAMETER ::   jpr_oemp   = 25   ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jpr_w10m   = 26   ! 10m wind
+   INTEGER, PARAMETER ::   jpr_dqnsdt = 27   ! d(Q non solar)/d(temperature)
+   INTEGER, PARAMETER ::   jpr_rnf    = 28   ! runoffs
+   INTEGER, PARAMETER ::   jpr_cal    = 29   ! calving
+   INTEGER, PARAMETER ::   jpr_taum   = 30   ! wind stress module
+   INTEGER, PARAMETER ::   jpr_co2    = 31
+   INTEGER, PARAMETER ::   jpr_topm   = 32   ! topmeltn
+   INTEGER, PARAMETER ::   jpr_botm   = 33   ! botmeltn
+   INTEGER, PARAMETER ::   jpr_sflx   = 34   ! salt flux
+   INTEGER, PARAMETER ::   jpr_toce   = 35   ! ocean temperature
+   INTEGER, PARAMETER ::   jpr_soce   = 36   ! ocean salinity
+   INTEGER, PARAMETER ::   jpr_ocx1   = 37   ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jpr_ocy1   = 38   !
+   INTEGER, PARAMETER ::   jpr_ssh    = 39   ! sea surface height
+   INTEGER, PARAMETER ::   jpr_fice   = 40   ! ice fraction          
+   INTEGER, PARAMETER ::   jpr_e3t1st = 41   ! first T level thickness 
+   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure 
+   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig 
+   INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux 
+   INTEGER, PARAMETER ::   jpr_sdrftx = 46   ! Stokes drift on grid 1 
+   INTEGER, PARAMETER ::   jpr_sdrfty = 47   ! Stokes drift on grid 2 
+   INTEGER, PARAMETER ::   jpr_wper   = 48   ! Mean wave period
+   INTEGER, PARAMETER ::   jpr_wnum   = 49   ! Mean wavenumber
+   INTEGER, PARAMETER ::   jpr_wstrf  = 50   ! Stress fraction adsorbed by waves
+   INTEGER, PARAMETER ::   jpr_wdrag  = 51   ! Neutral surface drag coefficient
+   INTEGER, PARAMETER ::   jpr_isf    = 52
+   INTEGER, PARAMETER ::   jpr_icb    = 53
+
+   INTEGER, PARAMETER ::   jprcv      = 53   ! total number of fields received  
+
+   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
+   INTEGER, PARAMETER ::   jps_toce   =  2   ! ocean temperature
+   INTEGER, PARAMETER ::   jps_tice   =  3   ! ice   temperature
+   INTEGER, PARAMETER ::   jps_tmix   =  4   ! mixed temperature (ocean+ice)
+   INTEGER, PARAMETER ::   jps_albice =  5   ! ice   albedo
+   INTEGER, PARAMETER ::   jps_albmix =  6   ! mixed albedo
+   INTEGER, PARAMETER ::   jps_hice   =  7   ! ice  thickness
+   INTEGER, PARAMETER ::   jps_hsnw   =  8   ! snow thickness
+   INTEGER, PARAMETER ::   jps_ocx1   =  9   ! ocean current on grid 1
+   INTEGER, PARAMETER ::   jps_ocy1   = 10   !
+   INTEGER, PARAMETER ::   jps_ocz1   = 11   !
+   INTEGER, PARAMETER ::   jps_ivx1   = 12   ! ice   current on grid 1
+   INTEGER, PARAMETER ::   jps_ivy1   = 13   !
+   INTEGER, PARAMETER ::   jps_ivz1   = 14   !
+   INTEGER, PARAMETER ::   jps_co2    = 15
+   INTEGER, PARAMETER ::   jps_soce   = 16   ! ocean salinity
+   INTEGER, PARAMETER ::   jps_ssh    = 17   ! sea surface height
+   INTEGER, PARAMETER ::   jps_qsroce = 18   ! Qsr above the ocean
+   INTEGER, PARAMETER ::   jps_qnsoce = 19   ! Qns above the ocean
+   INTEGER, PARAMETER ::   jps_oemp   = 20   ! ocean freshwater budget (evap - precip)
+   INTEGER, PARAMETER ::   jps_sflx   = 21   ! salt flux
+   INTEGER, PARAMETER ::   jps_otx1   = 22   ! 2 atmosphere-ocean stress components on grid 1
+   INTEGER, PARAMETER ::   jps_oty1   = 23   ! 
+   INTEGER, PARAMETER ::   jps_rnf    = 24   ! runoffs
+   INTEGER, PARAMETER ::   jps_taum   = 25   ! wind stress module
+   INTEGER, PARAMETER ::   jps_fice2  = 26   ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
+   INTEGER, PARAMETER ::   jps_e3t1st = 27   ! first level depth (vvl)
+   INTEGER, PARAMETER ::   jps_fraqsr = 28   ! fraction of solar net radiation absorbed in the first ocean level
+   INTEGER, PARAMETER ::   jps_ficet  = 29   ! total ice fraction  
+   INTEGER, PARAMETER ::   jps_ocxw   = 30   ! currents on grid 1  
+   INTEGER, PARAMETER ::   jps_ocyw   = 31   ! currents on grid 2
+   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level 
+   INTEGER, PARAMETER ::   jpsnd      = 32   ! total number of fields sent 
+
+   !                                  !!** namelist namsbc_cpl **
+   TYPE ::   FLD_C                     !   
+      CHARACTER(len = 32) ::   cldes      ! desciption of the coupling strategy
+      CHARACTER(len = 32) ::   clcat      ! multiple ice categories strategy
+      CHARACTER(len = 32) ::   clvref     ! reference of vector ('spherical' or 'cartesian')
+      CHARACTER(len = 32) ::   clvor      ! orientation of vector fields ('eastward-northward' or 'local grid')
+      CHARACTER(len = 32) ::   clvgrd     ! grids on which is located the vector fields
+   END TYPE FLD_C
+   !                                   ! Send to the atmosphere  
+   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                        
+   !                                   ! Received from the atmosphere
+   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf
+   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf                              
+   ! Send to waves 
+   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 
+   ! Received from waves 
+   TYPE(FLD_C) ::   sn_rcv_hsig,sn_rcv_phioc,sn_rcv_sdrfx,sn_rcv_sdrfy,sn_rcv_wper,sn_rcv_wnum,sn_rcv_wstrf,sn_rcv_wdrag
+   !                                   ! Other namelist parameters
+   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models
+                                         !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+   TYPE ::   DYNARR     
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3   
+   END TYPE DYNARR
+
+   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                     ! all fields recieved from the atmosphere
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky)
+
+   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2] 
+   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0) 
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument
+
+   !! Substitution
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   INTEGER FUNCTION sbc_cpl_alloc()
+      !!----------------------------------------------------------------------
+      !!             ***  FUNCTION sbc_cpl_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(4)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
+      
+#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice
+      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
+#endif
+      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
+      !
+      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 
+
+      sbc_cpl_alloc = MAXVAL( ierr )
+      IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc )
+      IF( sbc_cpl_alloc > 0 )   CALL ctl_warn('sbc_cpl_alloc: allocation of arrays failed')
+      !
+   END FUNCTION sbc_cpl_alloc
+
+
+   SUBROUTINE sbc_cpl_init( k_ice )     
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_init  ***
+      !!
+      !! ** Purpose :   Initialisation of send and received information from
+      !!                the atmospheric component
+      !!
+      !! ** Method  : * Read namsbc_cpl namelist 
+      !!              * define the receive interface
+      !!              * define the send    interface
+      !!              * initialise the OASIS coupler
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   k_ice   ! ice management in the sbc (=0/1/2/3)
+      !
+      INTEGER ::   jn          ! dummy loop index
+      INTEGER ::   ios, inum   ! Local integer
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos
+      !!
+      NAMELIST/namsbc_cpl/  sn_snd_temp , sn_snd_alb  , sn_snd_thick , sn_snd_crt   , sn_snd_co2,      & 
+         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau   , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
+         &                  sn_snd_ifrac, sn_snd_crtw , sn_snd_wlev  , sn_rcv_hsig  , sn_rcv_phioc ,   & 
+         &                  sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper  , sn_rcv_wnum  , sn_rcv_wstrf ,   &
+         &                  sn_rcv_wdrag, sn_rcv_qns  , sn_rcv_emp   , sn_rcv_rnf   , sn_rcv_cal   ,   &
+         &                  sn_rcv_iceflx,sn_rcv_co2  , nn_cplmodel  , ln_usecplmask, sn_rcv_mslp  ,   &
+         &                  sn_rcv_icb , sn_rcv_isf
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_init')
+      !
+      CALL wrk_alloc( jpi,jpj,   zacs, zaos )
+
+      ! ================================ !
+      !      Namelist informations       !
+      ! ================================ !
+      !
+      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling
+      READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling
+      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_cpl )
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
+         WRITE(numout,*)'~~~~~~~~~~~~'
+      ENDIF
+      IF( lwp .AND. ln_cpl ) THEN                        ! control print
+         WRITE(numout,*)'  received fields (mutiple ice categogies)'
+         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')'
+         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')'
+         WRITE(numout,*)'      surface stress                  = ', TRIM(sn_rcv_tau%cldes   ), ' (', TRIM(sn_rcv_tau%clcat   ), ')'
+         WRITE(numout,*)'                     - referential    = ', sn_rcv_tau%clvref
+         WRITE(numout,*)'                     - orientation    = ', sn_rcv_tau%clvor
+         WRITE(numout,*)'                     - mesh           = ', sn_rcv_tau%clvgrd
+         WRITE(numout,*)'      non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')'
+         WRITE(numout,*)'      solar heat flux                 = ', TRIM(sn_rcv_qsr%cldes   ), ' (', TRIM(sn_rcv_qsr%clcat   ), ')'
+         WRITE(numout,*)'      non-solar heat flux             = ', TRIM(sn_rcv_qns%cldes   ), ' (', TRIM(sn_rcv_qns%clcat   ), ')'
+         WRITE(numout,*)'      freshwater budget               = ', TRIM(sn_rcv_emp%cldes   ), ' (', TRIM(sn_rcv_emp%clcat   ), ')'
+         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')'
+         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')'
+         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')'
+         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')'
+         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
+         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')'
+         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
+         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
+         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
+         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
+         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
+         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
+         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
+         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
+         WRITE(numout,*)'  sent fields (multiple ice categories)'
+         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')'
+         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')'
+         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')'
+         WRITE(numout,*)'      total ice fraction              = ', TRIM(sn_snd_ifrac%cldes ), ' (', TRIM(sn_snd_ifrac%clcat ), ')' 
+         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')'
+         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref 
+         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor
+         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd
+         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')'
+         WRITE(numout,*)'      water level                     = ', TRIM(sn_snd_wlev%cldes  ), ' (', TRIM(sn_snd_wlev%clcat  ), ')' 
+         WRITE(numout,*)'      mean sea level pressure         = ', TRIM(sn_rcv_mslp%cldes  ), ' (', TRIM(sn_rcv_mslp%clcat  ), ')' 
+         WRITE(numout,*)'      surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
+         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
+         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
+         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
+         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel
+         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask
+      ENDIF
+
+      !                                   ! allocate sbccpl arrays
+      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
+     
+      ! ================================ !
+      !   Define the receive interface   !
+      ! ================================ !
+      nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress 
+
+      ! for each field: define the OASIS name                              (srcv(:)%clname)
+      !                 define receive or not from the namelist parameters (srcv(:)%laction)
+      !                 define the north fold type of lbc                  (srcv(:)%nsgn)
+
+      ! default definitions of srcv
+      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1
+
+      !                                                      ! ------------------------- !
+      !                                                      ! ice and ocean wind stress !   
+      !                                                      ! ------------------------- !
+      !                                                           ! Name 
+      srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U)
+      srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     - 
+      srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     - 
+      srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V)
+      srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     - 
+      srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     - 
+      !
+      srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U)
+      srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     - 
+      srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     - 
+      srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V)
+      srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     - 
+      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     - 
+      ! 
+      ! Vectors: change of sign at north fold ONLY if on the local grid
+      IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled
+      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1.
+      
+      !                                                           ! Set grid and action
+      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'
+      CASE( 'T' ) 
+         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
+      CASE( 'U,V' ) 
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
+         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_otx1:jpr_itz2)%laction = .TRUE.     ! receive oce and ice components on both grid 1 & 2
+      CASE( 'U,V,T' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'T'        ! ice components given at T-point
+         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
+      CASE( 'U,V,I' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
+         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
+      CASE( 'U,V,F' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point
+         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
+         srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only
+      CASE( 'T,I' ) 
+         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
+      CASE( 'T,F' ) 
+         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 
+         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 
+      CASE( 'T,U,V' )
+         srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point
+         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point
+         srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point
+         srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only
+         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2
+      CASE default   
+         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' )
+      END SELECT
+      !
+      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received
+         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 
+      !
+      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid
+            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 
+            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 
+            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner...
+            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner...
+      ENDIF
+      !
+      IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used
+         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received
+         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation
+         srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp.
+      ENDIF
+      ENDIF
+
+      !                                                      ! ------------------------- !
+      !                                                      !    freshwater budget      !   E-P
+      !                                                      ! ------------------------- !
+      ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid)
+      ! over ice of free ocean within the same atmospheric cell.cd 
+      srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation
+      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation
+      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation)
+      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation
+      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation 
+      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation
+      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip
+      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
+      CASE( 'none'          )       ! nothing to do
+      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE. 
+      CASE( 'conservative'  )
+         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
+         IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE.
+      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE.
+      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
+      END SELECT
+      !
+      !                                                      ! ------------------------- !
+      !                                                      !     Runoffs & Calving     !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_rnf   )%clname = 'O_Runoff'
+      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
+         srcv(jpr_rnf)%laction = .TRUE.
+         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf
+         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf
+      ENDIF
+      !
+      srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
+      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE.
+      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE.
+
+      IF( srcv(jpr_isf)%laction .AND. ln_isf ) THEN
+         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   iceshelf received from oasis '
+      ENDIF
+      !
+      !                                                      ! ------------------------- !
+      !                                                      !    non solar radiation    !   Qns
+      !                                                      ! ------------------------- !
+      srcv(jpr_qnsoce)%clname = 'O_QnsOce'
+      srcv(jpr_qnsice)%clname = 'O_QnsIce'
+      srcv(jpr_qnsmix)%clname = 'O_QnsMix'
+      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
+      CASE( 'none'          )       ! nothing to do
+      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE.
+      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
+      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE.
+      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE. 
+      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' )
+      END SELECT
+      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
+         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
+      !                                                      ! ------------------------- !
+      !                                                      !    solar radiation        !   Qsr
+      !                                                      ! ------------------------- !
+      srcv(jpr_qsroce)%clname = 'O_QsrOce'
+      srcv(jpr_qsrice)%clname = 'O_QsrIce'
+      srcv(jpr_qsrmix)%clname = 'O_QsrMix'
+      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
+      CASE( 'none'          )       ! nothing to do
+      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE.
+      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
+      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE.
+      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE. 
+      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' )
+      END SELECT
+      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) &
+         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' )
+      !                                                      ! ------------------------- !
+      !                                                      !   non solar sensitivity   !   d(Qns)/d(T)
+      !                                                      ! ------------------------- !
+      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'   
+      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE.
+      !
+      ! non solar sensitivity mandatory for LIM ice model
+      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
+         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
+      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
+      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) &
+         CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' )
+      !                                                      ! ------------------------- !
+      !                                                      !      10m wind module      !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE. 
+      !
+      !                                                      ! ------------------------- !
+      !                                                      !   wind stress module      !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE.
+      lhftau = srcv(jpr_taum)%laction
+
+      !                                                      ! ------------------------- !
+      !                                                      !      Atmospheric CO2      !
+      !                                                      ! ------------------------- !
+      srcv(jpr_co2 )%clname = 'O_AtmCO2'   
+      IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )  THEN
+         srcv(jpr_co2 )%laction = .TRUE.
+         l_co2cpl = .TRUE.
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   Atmospheric pco2 received from oasis '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      !                                                      ! ------------------------- ! 
+      !                                                      ! Mean Sea Level Pressure   ! 
+      !                                                      ! ------------------------- ! 
+      srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE. 
+
+      !                                                      ! ------------------------- !
+      !                                                      !   topmelt and botmelt     !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_topm )%clname = 'OTopMlt'
+      srcv(jpr_botm )%clname = 'OBotMlt'
+      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN
+         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN
+            srcv(jpr_topm:jpr_botm)%nct = jpl
+         ELSE
+            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' )
+         ENDIF
+         srcv(jpr_topm:jpr_botm)%laction = .TRUE.
+      ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !      Wave breaking        !    
+      !                                                      ! ------------------------- ! 
+      srcv(jpr_hsig)%clname  = 'O_Hsigwa'    ! significant wave height
+      IF( TRIM(sn_rcv_hsig%cldes  ) == 'coupled' )  THEN
+         srcv(jpr_hsig)%laction = .TRUE.
+         cpl_hsig = .TRUE.
+      ENDIF
+      srcv(jpr_phioc)%clname = 'O_PhiOce'    ! wave to ocean energy
+      IF( TRIM(sn_rcv_phioc%cldes ) == 'coupled' )  THEN
+         srcv(jpr_phioc)%laction = .TRUE.
+         cpl_phioc = .TRUE.
+      ENDIF
+      srcv(jpr_sdrftx)%clname = 'O_Sdrfx'    ! Stokes drift in the u direction
+      IF( TRIM(sn_rcv_sdrfx%cldes ) == 'coupled' )  THEN
+         srcv(jpr_sdrftx)%laction = .TRUE.
+         cpl_sdrftx = .TRUE.
+      ENDIF
+      srcv(jpr_sdrfty)%clname = 'O_Sdrfy'    ! Stokes drift in the v direction
+      IF( TRIM(sn_rcv_sdrfy%cldes ) == 'coupled' )  THEN
+         srcv(jpr_sdrfty)%laction = .TRUE.
+         cpl_sdrfty = .TRUE.
+      ENDIF
+      srcv(jpr_wper)%clname = 'O_WPer'       ! mean wave period
+      IF( TRIM(sn_rcv_wper%cldes  ) == 'coupled' )  THEN
+         srcv(jpr_wper)%laction = .TRUE.
+         cpl_wper = .TRUE.
+      ENDIF
+      srcv(jpr_wnum)%clname = 'O_WNum'       ! mean wave number
+      IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' )  THEN
+         srcv(jpr_wnum)%laction = .TRUE.
+         cpl_wnum = .TRUE.
+      ENDIF
+      srcv(jpr_wstrf)%clname = 'O_WStrf'     ! stress fraction adsorbed by the wave
+      IF( TRIM(sn_rcv_wstrf%cldes ) == 'coupled' )  THEN
+         srcv(jpr_wstrf)%laction = .TRUE.
+         cpl_wstrf = .TRUE.
+      ENDIF
+      srcv(jpr_wdrag)%clname = 'O_WDrag'     ! neutral surface drag coefficient
+      IF( TRIM(sn_rcv_wdrag%cldes ) == 'coupled' )  THEN
+         srcv(jpr_wdrag)%laction = .TRUE.
+         cpl_wdrag = .TRUE.
+      ENDIF
+      ! 
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - rcv by opa !   
+      !                                                      ! ------------------------------- !
+      srcv(jpr_sflx)%clname = 'O_SFLX'
+      srcv(jpr_fice)%clname = 'RIceFrc'
+      !
+      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
+         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
+         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
+         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
+         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point
+         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point
+         ! Vectors: change of sign at north fold ONLY if on the local grid
+         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
+         sn_rcv_tau%clvgrd = 'U,V'
+         sn_rcv_tau%clvor = 'local grid'
+         sn_rcv_tau%clvref = 'spherical'
+         sn_rcv_emp%cldes = 'oce only'
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
+            WRITE(numout,*)'               OPA component  '
+            WRITE(numout,*)
+            WRITE(numout,*)'  received fields from SAS component '
+            WRITE(numout,*)'                  ice cover '
+            WRITE(numout,*)'                  oce only EMP  '
+            WRITE(numout,*)'                  salt flux  '
+            WRITE(numout,*)'                  mixed oce-ice solar flux  '
+            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
+            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates '
+            WRITE(numout,*)'                  wind stress module'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                                                      ! -------------------------------- !
+      !                                                      !   OPA-SAS coupling - rcv by sas  !   
+      !                                                      ! -------------------------------- !
+      srcv(jpr_toce  )%clname = 'I_SSTSST'
+      srcv(jpr_soce  )%clname = 'I_SSSal'
+      srcv(jpr_ocx1  )%clname = 'I_OCurx1'
+      srcv(jpr_ocy1  )%clname = 'I_OCury1'
+      srcv(jpr_ssh   )%clname = 'I_SSHght'
+      srcv(jpr_e3t1st)%clname = 'I_E3T1st'   
+      srcv(jpr_fraqsr)%clname = 'I_FraQsr'   
+      !
+      IF( nn_components == jp_iam_sas ) THEN
+         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling
+         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling
+         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
+         srcv( jpr_e3t1st )%laction = .NOT.ln_linssh
+         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point
+         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point
+         ! Vectors: change of sign at north fold ONLY if on the local grid
+         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
+         ! Change first letter to couple with atmosphere if already coupled OPA
+         ! this is nedeed as each variable name used in the namcouple must be unique:
+         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
+         DO jn = 1, jprcv
+            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+         END DO
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  '
+            WRITE(numout,*)'               SAS component  '
+            WRITE(numout,*)
+            IF( .NOT. ln_cpl ) THEN
+               WRITE(numout,*)'  received fields from OPA component '
+            ELSE
+               WRITE(numout,*)'  Additional received fields from OPA component : '
+            ENDIF
+            WRITE(numout,*)'               sea surface temperature (Celsius) '
+            WRITE(numout,*)'               sea surface salinity ' 
+            WRITE(numout,*)'               surface currents ' 
+            WRITE(numout,*)'               sea surface height ' 
+            WRITE(numout,*)'               thickness of first ocean T level '        
+            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      
+      ! =================================================== !
+      ! Allocate all parts of frcv used for received fields !
+      ! =================================================== !
+      DO jn = 1, jprcv
+         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
+      END DO
+      ! Allocate taum part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+      ! Allocate w10m part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
+      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
+      IF( k_ice /= 0 ) THEN
+         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
+         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
+      END IF
+
+      ! ================================ !
+      !     Define the send interface    !
+      ! ================================ !
+      ! for each field: define the OASIS name                           (ssnd(:)%clname)
+      !                 define send or not from the namelist parameters (ssnd(:)%laction)
+      !                 define the north fold type of lbc               (ssnd(:)%nsgn)
+      
+      ! default definitions of nsnd
+      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1
+         
+      !                                                      ! ------------------------- !
+      !                                                      !    Surface temperature    !
+      !                                                      ! ------------------------- !
+      ssnd(jps_toce)%clname = 'O_SSTSST'
+      ssnd(jps_tice)%clname = 'O_TepIce'
+      ssnd(jps_tmix)%clname = 'O_TepMix'
+      SELECT CASE( TRIM( sn_snd_temp%cldes ) )
+      CASE( 'none'                                 )       ! nothing to do
+      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE.
+      CASE( 'oce and ice' , 'weighted oce and ice' )
+         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
+         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl
+      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE.
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
+      END SELECT
+           
+      !                                                      ! ------------------------- !
+      !                                                      !          Albedo           !
+      !                                                      ! ------------------------- !
+      ssnd(jps_albice)%clname = 'O_AlbIce' 
+      ssnd(jps_albmix)%clname = 'O_AlbMix'
+      SELECT CASE( TRIM( sn_snd_alb%cldes ) )
+      CASE( 'none'                 )     ! nothing to do
+      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE.
+      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE.
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
+      END SELECT
+      !
+      ! Need to calculate oceanic albedo if
+      !     1. sending mixed oce-ice albedo or
+      !     2. receiving mixed oce-ice solar radiation 
+      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN
+         CALL albedo_oce( zaos, zacs )
+         ! Due to lack of information on nebulosity : mean clear/overcast sky
+         albedo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5
+      ENDIF
+
+      !                                                      ! ------------------------- !
+      !                                                      !  Ice fraction & Thickness ! 
+      !                                                      ! ------------------------- !
+      ssnd(jps_fice)%clname = 'OIceFrc'
+      ssnd(jps_ficet)%clname = 'OIceFrcT' 
+      ssnd(jps_hice)%clname = 'OIceTck'
+      ssnd(jps_hsnw)%clname = 'OSnwTck'
+      IF( k_ice /= 0 ) THEN
+         ssnd(jps_fice)%laction = .TRUE.                  ! if ice treated in the ocean (even in climato case)
+! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now
+         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
+      ENDIF
+      
+      IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE. 
+
+      SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
+      CASE( 'none'         )       ! nothing to do
+      CASE( 'ice and snow' ) 
+         ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
+         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
+            ssnd(jps_hice:jps_hsnw)%nct = jpl
+         ENDIF
+      CASE ( 'weighted ice and snow' ) 
+         ssnd(jps_hice:jps_hsnw)%laction = .TRUE.
+         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' )
+      END SELECT
+
+      !                                                      ! ------------------------- !
+      !                                                      !      Surface current      !
+      !                                                      ! ------------------------- !
+      !        ocean currents              !            ice velocities
+      ssnd(jps_ocx1)%clname = 'O_OCurx1'   ;   ssnd(jps_ivx1)%clname = 'O_IVelx1'
+      ssnd(jps_ocy1)%clname = 'O_OCury1'   ;   ssnd(jps_ivy1)%clname = 'O_IVely1'
+      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1'
+      ssnd(jps_ocxw)%clname = 'O_OCurxw' 
+      ssnd(jps_ocyw)%clname = 'O_OCuryw' 
+      !
+      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold
+
+      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN
+         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V'
+      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN  
+         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' )
+         ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid
+      ENDIF
+      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send
+      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 
+      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1.
+      SELECT CASE( TRIM( sn_snd_crt%cldes ) )
+      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE.
+      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
+      CASE( 'weighted oce and ice' )   !   nothing to do
+      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE.
+      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' )
+      END SELECT
+
+      ssnd(jps_ocxw:jps_ocyw)%nsgn = -1.   ! vectors: change of the sign at the north fold 
+        
+      IF( sn_snd_crtw%clvgrd == 'U,V' ) THEN 
+         ssnd(jps_ocxw)%clgrid = 'U' ; ssnd(jps_ocyw)%clgrid = 'V' 
+      ELSE IF( sn_snd_crtw%clvgrd /= 'T' ) THEN 
+         CALL ctl_stop( 'sn_snd_crtw%clvgrd must be equal to T' ) 
+      ENDIF 
+      IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) ssnd(jps_ocxw:jps_ocyw)%nsgn = 1. 
+      SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
+         CASE( 'none'                 )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .FALSE. 
+         CASE( 'oce only'             )   ; ssnd(jps_ocxw:jps_ocyw)%laction = .TRUE. 
+         CASE( 'weighted oce and ice' )   !   nothing to do 
+         CASE( 'mixed oce-ice'        )   ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
+         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crtw%cldes' ) 
+      END SELECT 
+
+      !                                                      ! ------------------------- !
+      !                                                      !          CO2 flux         !
+      !                                                      ! ------------------------- !
+      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
+
+      !                                                      ! ------------------------- ! 
+      !                                                      !     Sea surface height    ! 
+      !                                                      ! ------------------------- ! 
+      ssnd(jps_wlev)%clname = 'O_Wlevel' ;  IF( TRIM(sn_snd_wlev%cldes) == 'coupled' )   ssnd(jps_wlev)%laction = .TRUE. 
+
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - snd by opa !   
+      !                                                      ! ------------------------------- !
+      ssnd(jps_ssh   )%clname = 'O_SSHght' 
+      ssnd(jps_soce  )%clname = 'O_SSSal' 
+      ssnd(jps_e3t1st)%clname = 'O_E3T1st'   
+      ssnd(jps_fraqsr)%clname = 'O_FraQsr'
+      !
+      IF( nn_components == jp_iam_opa ) THEN
+         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
+         ssnd( jps_e3t1st )%laction = .NOT.ln_linssh
+         ! vector definition: not used but cleaner...
+         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point
+         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point
+         sn_snd_crt%clvgrd = 'U,V'
+         sn_snd_crt%clvor = 'local grid'
+         sn_snd_crt%clvref = 'spherical'
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            WRITE(numout,*)'  sent fields to SAS component '
+            WRITE(numout,*)'               sea surface temperature (T before, Celsius) '
+            WRITE(numout,*)'               sea surface salinity ' 
+            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates' 
+            WRITE(numout,*)'               sea surface height ' 
+            WRITE(numout,*)'               thickness of first ocean T level '        
+            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                                                      ! ------------------------------- !
+      !                                                      !   OPA-SAS coupling - snd by sas !   
+      !                                                      ! ------------------------------- !
+      ssnd(jps_sflx  )%clname = 'I_SFLX'     
+      ssnd(jps_fice2 )%clname = 'IIceFrc'
+      ssnd(jps_qsroce)%clname = 'I_QsrOce'   
+      ssnd(jps_qnsoce)%clname = 'I_QnsOce'   
+      ssnd(jps_oemp  )%clname = 'IOEvaMPr' 
+      ssnd(jps_otx1  )%clname = 'I_OTaux1'   
+      ssnd(jps_oty1  )%clname = 'I_OTauy1'   
+      ssnd(jps_rnf   )%clname = 'I_Runoff'   
+      ssnd(jps_taum  )%clname = 'I_TauMod'   
+      !
+      IF( nn_components == jp_iam_sas ) THEN
+         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling
+         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
+         !
+         ! Change first letter to couple with atmosphere if already coupled with sea_ice
+         ! this is nedeed as each variable name used in the namcouple must be unique:
+         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
+         DO jn = 1, jpsnd
+            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+         END DO
+         !
+         IF(lwp) THEN                        ! control print
+            WRITE(numout,*)
+            IF( .NOT. ln_cpl ) THEN
+               WRITE(numout,*)'  sent fields to OPA component '
+            ELSE
+               WRITE(numout,*)'  Additional sent fields to OPA component : '
+            ENDIF
+            WRITE(numout,*)'                  ice cover '
+            WRITE(numout,*)'                  oce only EMP  '
+            WRITE(numout,*)'                  salt flux  '
+            WRITE(numout,*)'                  mixed oce-ice solar flux  '
+            WRITE(numout,*)'                  mixed oce-ice non solar flux  '
+            WRITE(numout,*)'                  wind stress U,V components'
+            WRITE(numout,*)'                  wind stress module'
+         ENDIF
+      ENDIF
+
+      !
+      ! ================================ !
+      !   initialisation of the coupler  !
+      ! ================================ !
+
+      CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
+      
+      IF (ln_usecplmask) THEN 
+         xcplmask(:,:,:) = 0.
+         CALL iom_open( 'cplmask', inum )
+         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   &
+            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )
+         CALL iom_close( inum )
+      ELSE
+         xcplmask(:,:,:) = 1.
+      ENDIF
+      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
+      !
+      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
+      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   &
+         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+      IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq
+
+      CALL wrk_dealloc( jpi,jpj,   zacs, zaos )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_init')
+      !
+   END SUBROUTINE sbc_cpl_init
+
+
+   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_rcv  ***
+      !!
+      !! ** Purpose :   provide the stress over the ocean and, if no sea-ice,
+      !!                provide the ocean heat and freshwater fluxes.
+      !!
+      !! ** Method  : - Receive all the atmospheric fields (stored in frcv array). called at each time step.
+      !!                OASIS controls if there is something do receive or not. nrcvinfo contains the info
+      !!                to know if the field was really received or not
+      !!
+      !!              --> If ocean stress was really received:
+      !!
+      !!                  - transform the received ocean stress vector from the received
+      !!                 referential and grid into an atmosphere-ocean stress in 
+      !!                 the (i,j) ocean referencial and at the ocean velocity point. 
+      !!                    The received stress are :
+      !!                     - defined by 3 components (if cartesian coordinate)
+      !!                            or by 2 components (if spherical)
+      !!                     - oriented along geographical   coordinate (if eastward-northward)
+      !!                            or  along the local grid coordinate (if local grid)
+      !!                     - given at U- and V-point, resp.   if received on 2 grids
+      !!                            or at T-point               if received on 1 grid
+      !!                    Therefore and if necessary, they are successively 
+      !!                  processed in order to obtain them 
+      !!                     first  as  2 components on the sphere 
+      !!                     second as  2 components oriented along the local grid
+      !!                     third  as  2 components on the U,V grid 
+      !!
+      !!              --> 
+      !!
+      !!              - In 'ocean only' case, non solar and solar ocean heat fluxes 
+      !!             and total ocean freshwater fluxes  
+      !!
+      !! ** Method  :   receive all fields from the atmosphere and transform 
+      !!              them into ocean surface boundary condition fields 
+      !!
+      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid 
+      !!                        taum         wind stress module at T-point
+      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice
+      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case)
+      !!                                     and the latent heat flux of solid precip. melting
+      !!                        qsr          solar ocean heat fluxes   (ocean only case)
+      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
+      !!----------------------------------------------------------------------
+      USE zdf_oce,  ONLY : ln_zdfqiao
+
+      IMPLICIT NONE
+
+      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index
+      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation 
+      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3)
+      !!
+      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module??
+      INTEGER  ::   ji, jj, jn             ! dummy loop indices
+      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000)
+      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars     
+      REAL(wp) ::   zcoef                  ! temporary scalar
+      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient
+      REAL(wp) ::   zzx, zzy               ! temporary variables
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_rcv')
+      !
+      CALL wrk_alloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr )
+      !
+      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
+      !
+      !                                                      ! ======================================================= !
+      !                                                      ! Receive all the atmos. fields (including ice information)
+      !                                                      ! ======================================================= !
+      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges
+      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
+         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
+      END DO
+
+      !                                                      ! ========================= !
+      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  !
+         !                                                   ! ========================= !
+         ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid
+         ! => need to be done only when we receive the field
+         IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN
+            !
+            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
+               !                                                       ! (cartesian to spherical -> 3 to 2 components)
+               !
+               CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1),   &
+                  &          srcv(jpr_otx1)%clgrid, ztx, zty )
+               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
+               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
+               !
+               IF( srcv(jpr_otx2)%laction ) THEN
+                  CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1),   &
+                     &          srcv(jpr_otx2)%clgrid, ztx, zty )
+                  frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
+                  frcv(jpr_oty2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
+               ENDIF
+               !
+            ENDIF
+            !
+            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
+               !                                                       ! (geographical to local grid -> rotate the components)
+               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )   
+               IF( srcv(jpr_otx2)%laction ) THEN
+                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )   
+               ELSE
+                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )  
+               ENDIF
+               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
+               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid
+            ENDIF
+            !                              
+            IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN
+               DO jj = 2, jpjm1                                          ! T ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) )
+                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) )
+                  END DO
+               END DO
+               CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. )
+            ENDIF
+            llnewtx = .TRUE.
+         ELSE
+            llnewtx = .FALSE.
+         ENDIF
+         !                                                   ! ========================= !
+      ELSE                                                   !   No dynamical coupling   !
+         !                                                   ! ========================= !
+         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero 
+         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead
+         llnewtx = .TRUE.
+         !
+      ENDIF
+      !                                                      ! ========================= !
+      !                                                      !    wind stress module     !   (taum)
+      !                                                      ! ========================= !
+      !
+      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received 
+         ! => need to be done only when otx1 was changed
+         IF( llnewtx ) THEN
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vect. opt.
+                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1)
+                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1)
+                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
+               END DO
+            END DO
+            CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. )
+            llnewtau = .TRUE.
+         ELSE
+            llnewtau = .FALSE.
+         ENDIF
+      ELSE
+         llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
+         ! Stress module can be negative when received (interpolation problem)
+         IF( llnewtau ) THEN 
+            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
+         ENDIF
+      ENDIF
+      !
+      !                                                      ! ========================= !
+      !                                                      !      10 m wind speed      !   (wndm)
+      !                                                      ! ========================= !
+      !
+      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received  
+         ! => need to be done only when taumod was changed
+         IF( llnewtau ) THEN 
+            zcoef = 1. / ( zrhoa * zcdrag ) 
+            DO jj = 1, jpj
+               DO ji = 1, jpi 
+                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+               END DO
+            END DO
+         ENDIF
+      ENDIF
+
+      ! u(v)tau and taum will be modified by ice model
+      ! -> need to be reset before each call of the ice/fsbc      
+      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
+         !
+         IF( ln_mixcpl ) THEN
+            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
+            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
+            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
+            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
+         ELSE
+            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
+            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
+            taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
+         ENDIF
+         CALL iom_put( "taum_oce", taum )   ! output wind stress module
+         !  
+      ENDIF
+
+      !                                                      ! ================== !
+      !                                                      ! atmosph. CO2 (ppm) !
+      !                                                      ! ================== !
+      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
+      ! 
+      !                                                      ! ========================= ! 
+      !                                                      ! Mean Sea Level Pressure   !   (taum) 
+      !                                                      ! ========================= ! 
+      ! 
+      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH 
+          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
+
+          r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization 
+          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer) 
+          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure 
+    
+          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
+      END IF 
+      !
+      IF( ln_sdw ) THEN  ! Stokes Drift correction activated
+      !                                                      ! ========================= ! 
+      !                                                      !       Stokes drift u      !
+      !                                                      ! ========================= ! 
+         IF( srcv(jpr_sdrftx)%laction ) ut0sd(:,:) = frcv(jpr_sdrftx)%z3(:,:,1)
+      !
+      !                                                      ! ========================= ! 
+      !                                                      !       Stokes drift v      !
+      !                                                      ! ========================= ! 
+         IF( srcv(jpr_sdrfty)%laction ) vt0sd(:,:) = frcv(jpr_sdrfty)%z3(:,:,1)
+      !
+      !                                                      ! ========================= ! 
+      !                                                      !      Wave mean period     !
+      !                                                      ! ========================= ! 
+         IF( srcv(jpr_wper)%laction ) wmp(:,:) = frcv(jpr_wper)%z3(:,:,1)
+      !
+      !                                                      ! ========================= ! 
+      !                                                      !  Significant wave height  !
+      !                                                      ! ========================= ! 
+         IF( srcv(jpr_hsig)%laction ) hsw(:,:) = frcv(jpr_hsig)%z3(:,:,1)
+      !
+      !                                                      ! ========================= ! 
+      !                                                      !    Vertical mixing Qiao   !
+      !                                                      ! ========================= ! 
+         IF( srcv(jpr_wnum)%laction .AND. ln_zdfqiao ) wnum(:,:) = frcv(jpr_wnum)%z3(:,:,1)
+
+         ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode
+         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction &
+                                                                    .OR. srcv(jpr_hsig)%laction ) THEN
+            CALL sbc_stokes()
+         ENDIF
+      ENDIF
+      !                                                      ! ========================= ! 
+      !                                                      ! Stress adsorbed by waves  !
+      !                                                      ! ========================= ! 
+      IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1)
+
+      !                                                      ! ========================= ! 
+      !                                                      !   Wave drag coefficient   !
+      !                                                      ! ========================= ! 
+      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1)
+
+      !  Fields received by SAS when OASIS coupling
+      !  (arrays no more filled at sbcssm stage)
+      !                                                      ! ================== !
+      !                                                      !        SSS         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
+         CALL iom_put( 'sss_m', sss_m )
+      ENDIF
+      !                                               
+      !                                                      ! ================== !
+      !                                                      !        SST         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
+         IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN    ! make sure that sst_m is the potential temperature
+            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
+         ENDIF
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !        SSH         !
+      !                                                      ! ================== !
+      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
+         CALL iom_put( 'ssh_m', ssh_m )
+      ENDIF
+      !                                                      ! ================== !
+      !                                                      !  surface currents  !
+      !                                                      ! ================== !
+      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling
+         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
+         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         CALL iom_put( 'ssu_m', ssu_m )
+      ENDIF
+      IF( srcv(jpr_ocy1)%laction ) THEN
+         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
+         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau
+         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling
+         CALL iom_put( 'ssv_m', ssv_m )
+      ENDIF
+      !                                                      ! ======================== !
+      !                                                      !  first T level thickness !
+      !                                                      ! ======================== !
+      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling
+         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
+         CALL iom_put( 'e3t_m', e3t_m(:,:) )
+      ENDIF
+      !                                                      ! ================================ !
+      !                                                      !  fraction of solar net radiation !
+      !                                                      ! ================================ !
+      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling
+         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
+         CALL iom_put( 'frq_m', frq_m )
+      ENDIF
+      
+      !                                                      ! ========================= !
+      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case)
+         !                                                   ! ========================= !
+         !
+         !                                                       ! total freshwater fluxes over the ocean (emp)
+         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
+            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
+            CASE( 'conservative' )
+               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
+            CASE( 'oce only', 'oce and ice' )
+               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
+            CASE default
+               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
+            END SELECT
+         ELSE
+            zemp(:,:) = 0._wp
+         ENDIF
+         !
+         !                                                        ! runoffs and calving (added in emp)
+         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
+ 
+         IF( srcv(jpr_icb)%laction )  THEN 
+             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
+             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs
+         ENDIF
+         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)  
+        
+         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
+         ELSE                   ;   emp(:,:) =                              zemp(:,:)
+         ENDIF
+         !
+         !                                                       ! non solar heat flux over the ocean (qns)
+         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         ELSE                                       ;   zqns(:,:) = 0._wp
+         END IF
+         ! update qns over the free ocean with:
+         IF( nn_components /= jp_iam_opa ) THEN
+            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST)
+            IF( srcv(jpr_snow  )%laction ) THEN
+               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean
+            ENDIF
+         ENDIF
+         !
+         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting
+         !
+         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
+         ELSE                   ;   qns(:,:) =                              zqns(:,:)
+         ENDIF
+
+         !                                                       ! solar flux over the ocean          (qsr)
+         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+         ELSE                                       ;   zqsr(:,:) = 0._wp
+         ENDIF
+         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle
+         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
+         ELSE                   ;   qsr(:,:) =                              zqsr(:,:)
+         ENDIF
+         !
+         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
+         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1)
+         ! Ice cover  (received by opa in case of opa <-> sas coupling)
+         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_rcv')
+      !
+   END SUBROUTINE sbc_cpl_rcv
+   
+
+   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_ice_tau  ***
+      !!
+      !! ** Purpose :   provide the stress over sea-ice in coupled mode 
+      !!
+      !! ** 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 (cp_ice_msh):
+      !!                'C'-grid : i- (j-) components given at U- (V-) point 
+      !!                'I'-grid : B-grid lower-left corner: both components given at I-point 
+      !!
+      !!                The received stress are :
+      !!                 - defined by 3 components (if cartesian coordinate)
+      !!                        or by 2 components (if spherical)
+      !!                 - oriented along geographical   coordinate (if eastward-northward)
+      !!                        or  along the local grid coordinate (if local grid)
+      !!                 - given at U- and V-point, resp.   if received on 2 grids
+      !!                        or at a same point (T or I) if received on 1 grid
+      !!                Therefore and if necessary, they are successively 
+      !!             processed in order to obtain them 
+      !!                 first  as  2 components on the sphere 
+      !!                 second as  2 components oriented along the local grid
+      !!                 third  as  2 components on the cp_ice_msh point 
+      !!
+      !!                Except in 'oce and ice' case, only one vector stress field 
+      !!             is received. It has already been processed in sbc_cpl_rcv
+      !!             so that it is now defined as (i,j) components given at U-
+      !!             and V-points, respectively. Therefore, only the third
+      !!             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(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
+      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid)
+      !!
+      INTEGER ::   ji, jj   ! dummy loop indices
+      INTEGER ::   itx      ! index of taux over ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_ice_tau')
+      !
+      CALL wrk_alloc( jpi,jpj,   ztx, zty )
+
+      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1   
+      ELSE                                ;   itx =  jpr_otx1
+      ENDIF
+
+      ! do something only if we just received the stress from atmosphere
+      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN
+         !                                                      ! ======================= !
+         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   !
+            !                                                   ! ======================= !
+            !  
+            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere
+               !                                                       ! (cartesian to spherical -> 3 to 2 components)
+               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   &
+                  &          srcv(jpr_itx1)%clgrid, ztx, zty )
+               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid
+               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid
+               !
+               IF( srcv(jpr_itx2)%laction ) THEN
+                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   &
+                     &          srcv(jpr_itx2)%clgrid, ztx, zty )
+                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid
+                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid
+               ENDIF
+               !
+            ENDIF
+            !
+            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid
+               !                                                       ! (geographical to local grid -> rotate the components)
+               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )   
+               IF( srcv(jpr_itx2)%laction ) THEN
+                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )   
+               ELSE
+                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )  
+               ENDIF
+               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid
+               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid
+            ENDIF
+            !                                                   ! ======================= !
+         ELSE                                                   !     use ocean stress    !
+            !                                                   ! ======================= !
+            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1)
+            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1)
+            !
+         ENDIF
+         !                                                      ! ======================= !
+         !                                                      !     put on ice grid     !
+         !                                                      ! ======================= !
+         !    
+         !                                                  j+1   j     -----V---F
+         ! ice stress on ice velocity point (cp_ice_msh)                 !       |
+         ! (C-grid ==>(U,V) or B-grid ==> I or F)                 j      |   T   U
+         !                                                               |       |
+         !                                                   j    j-1   -I-------|
+         !                                               (for I)         |       |
+         !                                                              i-1  i   i
+         !                                                               i      i+1 (for I)
+         SELECT CASE ( cp_ice_msh )
+            !
+         CASE( 'I' )                                         ! B-grid ==> I
+            SELECT CASE ( srcv(jpr_itx1)%clgrid )
+            CASE( 'U' )
+               DO jj = 2, jpjm1                                   ! (U,V) ==> I
+                  DO ji = 2, jpim1   ! NO vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
+                  END DO
+               END DO
+            CASE( 'F' )
+               DO jj = 2, jpjm1                                   ! F ==> I
+                  DO ji = 2, jpim1   ! NO vector opt.
+                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1)
+                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1)
+                  END DO
+               END DO
+            CASE( 'T' )
+               DO jj = 2, jpjm1                                   ! T ==> I
+                  DO ji = 2, jpim1   ! NO vector opt.
+                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj  ,1)   &
+                        &                   + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 
+                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1)   &
+                        &                   + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) )
+                  END DO
+               END DO
+            CASE( 'I' )
+               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! I ==> I
+               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
+            END SELECT
+            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN 
+               CALL lbc_lnk( p_taui, 'I',  -1. )   ;   CALL lbc_lnk( p_tauj, 'I',  -1. )
+            ENDIF
+            !
+         CASE( 'F' )                                         ! B-grid ==> F
+            SELECT CASE ( srcv(jpr_itx1)%clgrid )
+            CASE( 'U' )
+               DO jj = 2, jpjm1                                   ! (U,V) ==> F
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj+1,1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1) )
+                  END DO
+               END DO
+            CASE( 'I' )
+               DO jj = 2, jpjm1                                   ! I ==> F
+                  DO ji = 2, jpim1   ! NO vector opt.
+                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1)
+                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1)
+                  END DO
+               END DO
+            CASE( 'T' )
+               DO jj = 2, jpjm1                                   ! T ==> F
+                  DO ji = 2, jpim1   ! NO vector opt.
+                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1)   &
+                        &                   + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 
+                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1)   &
+                        &                   + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) )
+                  END DO
+               END DO
+            CASE( 'F' )
+               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! F ==> F
+               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
+            END SELECT
+            IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN 
+               CALL lbc_lnk( p_taui, 'F',  -1. )   ;   CALL lbc_lnk( p_tauj, 'F',  -1. )
+            ENDIF
+            !
+         CASE( 'C' )                                         ! C-grid ==> U,V
+            SELECT CASE ( srcv(jpr_itx1)%clgrid )
+            CASE( 'U' )
+               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V)
+               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1)
+            CASE( 'F' )
+               DO jj = 2, jpjm1                                   ! F ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) )
+                  END DO
+               END DO
+            CASE( 'T' )
+               DO jj = 2, jpjm1                                   ! T ==> (U,V)
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) )
+                  END DO
+               END DO
+            CASE( 'I' )
+               DO jj = 2, jpjm1                                   ! I ==> (U,V)
+                  DO ji = 2, jpim1   ! NO vector opt.
+                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) )
+                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) )
+                  END DO
+               END DO
+            END SELECT
+            IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN 
+               CALL lbc_lnk( p_taui, 'U',  -1. )   ;   CALL lbc_lnk( p_tauj, 'V',  -1. )
+            ENDIF
+         END SELECT
+
+      ENDIF
+      !   
+      CALL wrk_dealloc( jpi,jpj,   ztx, zty )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_tau')
+      !
+   END SUBROUTINE sbc_cpl_ice_tau
+   
+
+   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_ice_flx  ***
+      !!
+      !! ** Purpose :   provide the heat and freshwater fluxes of the ocean-ice system
+      !!
+      !! ** Method  :   transform the fields received from the atmosphere into
+      !!             surface heat and fresh water boundary condition for the 
+      !!             ice-ocean system. The following fields are provided:
+      !!               * total non solar, solar and freshwater fluxes (qns_tot, 
+      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux)
+      !!             NB: emp_tot include runoffs and calving.
+      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where
+      !!             emp_ice = sublimation - solid precipitation as liquid
+      !!             precipitation are re-routed directly to the ocean and 
+      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90)
+      !!               * solid precipitation (sprecip), used to add to qns_tot 
+      !!             the heat lost associated to melting solid precipitation
+      !!             over the ocean fraction.
+      !!               * heat content of rain, snow and evap can also be provided,
+      !!             otherwise heat flux associated with these mass flux are
+      !!             guessed (qemp_oce, qemp_ice)
+      !!
+      !!             - the fluxes have been separated from the stress as
+      !!               (a) they are updated at each ice time step compare to
+      !!               an update at each coupled time step for the stress, and
+      !!               (b) the conservative computation of the fluxes over the
+      !!               sea-ice area requires the knowledge of the ice fraction
+      !!               after the ice advection and before the ice thermodynamics,
+      !!               so that the stress is updated before the ice dynamics
+      !!               while the fluxes are updated after it.
+      !!
+      !! ** Details
+      !!             qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice   => provided
+      !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns
+      !!
+      !!             qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice   => provided
+      !!
+      !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce).
+      !!                                                                      runoff (which includes rivers+icebergs) and iceshelf
+      !!                                                                      are provided but not included in emp here. Only runoff will
+      !!                                                                      be included in emp in other parts of NEMO code
+      !! ** Action  :   update at each nf_ice time step:
+      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes
+      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice
+      !!                   emp_tot           total evaporation - precipitation(liquid and solid) (-calving)
+      !!                   emp_ice           ice sublimation - solid precipitation over the ice
+      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice
+      !!                   sprecip           solid precipitation over the ocean  
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
+      ! optional arguments, used only in 'mixed oce-ice' case
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo 
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin]
+      !
+      INTEGER ::   jl         ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
+      !
+      CALL wrk_alloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
+      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
+      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
+      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
+
+      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0)
+      zicefr(:,:) = 1.- p_frld(:,:)
+      zcptn(:,:) = rcp * sst_m(:,:)
+      !
+      !                                                      ! ========================= !
+      !                                                      !    freshwater budget      !   (emp_tot)
+      !                                                      ! ========================= !
+      !
+      !                                                           ! solid Precipitation                                (sprecip)
+      !                                                           ! liquid + solid Precipitation                       (tprecip)
+      !                                                           ! total Evaporation - total Precipitation            (emp_tot)
+      !                                                           ! sublimation - solid precipitation (cell average)   (emp_ice)
+      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
+      CASE( 'conservative' )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
+         zsprecip(:,:) =   frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
+         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
+         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
+         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)
+      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
+         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
+         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)
+         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
+         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
+      END SELECT
+
+#if defined key_lim3
+      ! zsnw = snow fraction over ice after wind blowing (=zicefr if no blowing)
+      zsnw(:,:) = 0._wp  ;  CALL lim_thd_snwblow( p_frld, zsnw )
+      
+      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- !
+      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip
+      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice
+
+      ! --- evaporation over ocean (used later for qemp) --- !
+      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
+
+      ! --- evaporation over ice (kg/m2/s) --- !
+      zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1)
+      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
+      ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm.
+      zdevap_ice(:,:) = 0._wp
+      
+      ! --- Continental fluxes --- !
+      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
+         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+      ENDIF
+      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce)
+         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
+      ENDIF
+      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
+         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
+         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
+      ENDIF
+      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
+        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  
+      ENDIF
+
+      IF( ln_mixcpl ) THEN
+         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
+         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
+         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:)
+         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
+         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
+         DO jl=1,jpl
+            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:)
+            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:)
+         ENDDO
+      ELSE
+         emp_tot(:,:) =         zemp_tot(:,:)
+         emp_ice(:,:) =         zemp_ice(:,:)
+         emp_oce(:,:) =         zemp_oce(:,:)     
+         sprecip(:,:) =         zsprecip(:,:)
+         tprecip(:,:) =         ztprecip(:,:)
+         DO jl=1,jpl
+            evap_ice (:,:,jl) = zevap_ice (:,:)
+            devap_ice(:,:,jl) = zdevap_ice(:,:)
+         ENDDO
+      ENDIF
+
+#else
+      zsnw(:,:) = zicefr(:,:)
+      ! --- Continental fluxes --- !
+      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on)
+         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+      ENDIF
+      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot)
+         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+      ENDIF
+      IF( srcv(jpr_icb)%laction ) THEN   ! iceberg added to runoffs
+         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
+         rnf(:,:)    = rnf(:,:) + fwficb(:,:)
+      ENDIF
+      IF( srcv(jpr_isf)%laction ) THEN   ! iceshelf (fwfisf <0 mean melting)
+        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)
+      ENDIF
+
+      IF( ln_mixcpl ) THEN
+         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
+         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
+         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
+         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
+      ELSE
+         emp_tot(:,:) =                                  zemp_tot(:,:)
+         emp_ice(:,:) =                                  zemp_ice(:,:)
+         sprecip(:,:) =                                  zsprecip(:,:)
+         tprecip(:,:) =                                  ztprecip(:,:)
+      ENDIF
+
+#endif
+      ! outputs
+!!      IF( srcv(jpr_rnf)%laction )   CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1)                                 )  ! runoff
+!!      IF( srcv(jpr_isf)%laction )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1)                         )  ! iceshelf
+      IF( srcv(jpr_cal)%laction )   CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1)                )  ! calving
+      IF( srcv(jpr_icb)%laction )   CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1)                )  ! icebergs
+      IF( iom_use('snowpre') )      CALL iom_put( 'snowpre'     , sprecip(:,:)                                          )  ! Snow
+      IF( iom_use('precip') )       CALL iom_put( 'precip'      , tprecip(:,:)                                          )  ! total  precipitation
+      IF( iom_use('rain') )         CALL iom_put( 'rain'        , tprecip(:,:) - sprecip(:,:)                           )  ! liquid precipitation 
+      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average)
+      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average)
+      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average)
+      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
+         &                                                        - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average)
+      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
+      !
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
+      !                                                      ! ========================= !
+      CASE( 'oce only' )         ! the required field is directly provided
+         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+      CASE( 'conservative' )     ! the required fields are directly provided
+         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
+         ELSE
+            DO jl=1,jpl
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal
+            ENDDO
+         ENDIF
+      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes
+         zqns_tot(:,:) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+            DO jl=1,jpl
+               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
+            ENDDO
+         ELSE
+            qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+            DO jl=1,jpl
+               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      CASE( 'mixed oce-ice' )    ! the ice flux is cumputed from the total flux, the SST and ice informations
+! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
+         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
+            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
+            &                                           + pist(:,:,1) * zicefr(:,:) ) )
+      END SELECT
+      !                                     
+      ! --- calving (removed from qns_tot) --- !
+      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus  ! remove latent heat of calving
+                                                                                                    ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
+      ! --- iceberg (removed from qns_tot) --- !
+      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus  ! remove latent heat of iceberg melting
+
+#if defined key_lim3      
+      ! --- non solar flux over ocean --- !
+      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      zqns_oce = 0._wp
+      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
+
+      ! Heat content per unit mass of snow (J/kg)
+      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = cpic * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
+      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:)
+      ENDWHERE
+      ! Heat content per unit mass of rain (J/kg)
+      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) ) 
+
+      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
+      zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus )
+
+      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- !
+      DO jl = 1, jpl
+         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but atm. does not take it into account
+      END DO
+
+      ! --- heat flux associated with emp (W/m2) --- !
+      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn   (:,:)   &        ! evap
+         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &        ! liquid precip
+         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus )   ! solid precip over ocean + snow melting
+      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - lfus )   ! solid precip over ice (qevap_ice=0 since atm. does not take it into account)
+!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap
+!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice
+      
+      ! --- total non solar flux (including evap/precip) --- !
+      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:)
+
+      ! --- in case both coupled/forced are active, we must mix values --- ! 
+      IF( ln_mixcpl ) THEN
+         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
+         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qns_ice  (:,:,jl) = qns_ice  (:,:,jl) * xcplmask(:,:,0) +  zqns_ice  (:,:,jl)* zmsk(:,:)
+            qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) +  zqevap_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
+         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:)
+         qemp_ice (:,:) =  qemp_ice(:,:) * xcplmask(:,:,0) +  zqemp_ice(:,:)* zmsk(:,:)
+      ELSE
+         qns_tot  (:,:  ) = zqns_tot  (:,:  )
+         qns_oce  (:,:  ) = zqns_oce  (:,:  )
+         qns_ice  (:,:,:) = zqns_ice  (:,:,:)
+         qevap_ice(:,:,:) = zqevap_ice(:,:,:)
+         qprec_ice(:,:  ) = zqprec_ice(:,:  )
+         qemp_oce (:,:  ) = zqemp_oce (:,:  )
+         qemp_ice (:,:  ) = zqemp_ice (:,:  )
+      ENDIF
+
+#else
+      zcptsnw (:,:) = zcptn(:,:)
+      zcptrain(:,:) = zcptn(:,:)
+      
+      ! clem: this formulation is certainly wrong... but better than it was...
+      zqns_tot(:,:) = zqns_tot(:,:)                            &          ! zqns_tot update over free ocean with:
+         &          - (  p_frld(:,:) * zsprecip(:,:) * lfus )  &          ! remove the latent heat flux of solid precip. melting
+         &          - (  zemp_tot(:,:)                         &          ! remove the heat content of mass flux (assumed to be at SST)
+         &             - zemp_ice(:,:) ) * zcptn(:,:) 
+
+     IF( ln_mixcpl ) THEN
+         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+      ELSE
+         qns_tot(:,:  ) = zqns_tot(:,:  )
+         qns_ice(:,:,:) = zqns_ice(:,:,:)
+      ENDIF
+
+#endif
+      ! outputs
+      IF( srcv(jpr_cal)%laction )    CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus                                  ) ! latent heat from calving
+      IF( srcv(jpr_icb)%laction )    CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus                                  ) ! latent heat from icebergs melting
+      IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea',  sprecip(:,:) * ( zcptsnw(:,:) - Lfus )                           ) ! heat flux from snow (cell average)
+      IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:)                    ) ! heat flux from rain (cell average)
+      IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average)
+         &                                                        ) * zcptn(:,:) * tmask(:,:,1) )
+      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:))   ) ! heat flux from snow (over ocean)
+      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) *          zsnw(:,:)    ) ! heat flux from snow (over ice)
+      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
+      !
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
+      !                                                      ! ========================= !
+      CASE( 'oce only' )
+         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
+      CASE( 'conservative' )
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
+         ELSE
+            ! Set all category values equal for the moment
+            DO jl=1,jpl
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
+      CASE( 'oce and ice' )
+         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+            DO jl=1,jpl
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
+            ENDDO
+         ELSE
+            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+            DO jl=1,jpl
+               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      CASE( 'mixed oce-ice' )
+         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
+!       Create solar heat flux over ice using incoming solar heat flux and albedos
+!       ( see OASIS3 user guide, 5th edition, p39 )
+         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
+            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
+            &                     + palbi         (:,:,1) * zicefr(:,:) ) )
+      END SELECT
+      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle
+         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) )
+         DO jl=1,jpl
+            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
+         ENDDO
+      ENDIF
+
+#if defined key_lim3
+      ! --- solar flux over ocean --- !
+      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax
+      zqsr_oce = 0._wp
+      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
+
+      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:)
+      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF
+#endif
+
+      IF( ln_mixcpl ) THEN
+         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk
+         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:)
+         DO jl=1,jpl
+            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:)
+         ENDDO
+      ELSE
+         qsr_tot(:,:  ) = zqsr_tot(:,:  )
+         qsr_ice(:,:,:) = zqsr_ice(:,:,:)
+      ENDIF
+
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        !
+      !                                                      ! ========================= !
+      CASE ('coupled')
+         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
+            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
+         ELSE
+            ! Set all category values equal for the moment
+            DO jl=1,jpl
+               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      END SELECT
+      
+      IF( ln_mixcpl ) THEN
+         DO jl=1,jpl
+            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
+         ENDDO
+      ELSE
+         dqns_ice(:,:,:) = zdqns_ice(:,:,:)
+      ENDIF
+      
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    !
+      !                                                      ! ========================= !
+      CASE ('coupled')
+         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
+         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
+      END SELECT
+
+      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 )
+      ! Used for LIM2 and LIM3
+      ! Coupled case: since cloud cover is not received from atmosphere 
+      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
+      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+
+      CALL wrk_dealloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw )
+      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )
+      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )
+      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_flx')
+      !
+   END SUBROUTINE sbc_cpl_ice_flx
+   
+   
+   SUBROUTINE sbc_cpl_snd( kt )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE sbc_cpl_snd  ***
+      !!
+      !! ** Purpose :   provide the ocean-ice informations to the atmosphere
+      !!
+      !! ** Method  :   send to the atmosphere through a call to cpl_snd
+      !!              all the needed fields (as defined in sbc_cpl_init)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      !
+      INTEGER ::   ji, jj, jl   ! dummy loop indices
+      INTEGER ::   isec, info   ! local integer
+      REAL(wp) ::   zumax, zvmax
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4   
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_snd')
+      !
+      CALL wrk_alloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
+      CALL wrk_alloc( jpi,jpj,jpl,   ztmp3, ztmp4 )
+
+      isec = ( kt - nit000 ) * NINT( rdt )        ! date of exchanges
+
+      zfr_l(:,:) = 1.- fr_i(:,:)
+      !                                                      ! ------------------------- !
+      !                                                      !    Surface temperature    !   in Kelvin
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
+         
+         IF ( nn_components == jp_iam_opa ) THEN
+            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
+         ELSE
+            ! we must send the surface potential temperature 
+            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem)
+            ENDIF
+            !
+            SELECT CASE( sn_snd_temp%cldes)
+            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
+            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0
+               SELECT CASE( sn_snd_temp%clcat )
+               CASE( 'yes' )   
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
+               CASE( 'no' )
+                  WHERE( SUM( a_i, dim=3 ) /= 0. )
+                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ELSEWHERE
+                     ztmp3(:,:,1) = rt0
+                  END WHERE
+               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+               END SELECT
+            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)   
+               SELECT CASE( sn_snd_temp%clcat )
+               CASE( 'yes' )   
+                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+               CASE( 'no' )
+                  ztmp3(:,:,:) = 0.0
+                  DO jl=1,jpl
+                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+                  ENDDO
+               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+               END SELECT
+            CASE( 'mixed oce-ice'        )   
+               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 
+               DO jl=1,jpl
+                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
+               ENDDO
+            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
+            END SELECT
+         ENDIF
+         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info )
+         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !           Albedo          !
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
+          SELECT CASE( sn_snd_alb%cldes )
+          CASE( 'ice' )
+             SELECT CASE( sn_snd_alb%clcat )
+             CASE( 'yes' )   
+                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
+             CASE( 'no' )
+                WHERE( SUM( a_i, dim=3 ) /= 0. )
+                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
+                ELSEWHERE
+                   ztmp1(:,:) = albedo_oce_mix(:,:)
+                END WHERE
+             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' )
+             END SELECT
+          CASE( 'weighted ice' )   ;
+             SELECT CASE( sn_snd_alb%clcat )
+             CASE( 'yes' )   
+                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+             CASE( 'no' )
+                WHERE( fr_i (:,:) > 0. )
+                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
+                ELSEWHERE
+                   ztmp1(:,:) = 0.
+                END WHERE
+             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' )
+             END SELECT
+          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
+         END SELECT
+
+         SELECT CASE( sn_snd_alb%clcat )
+            CASE( 'yes' )   
+               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode
+            CASE( 'no'  )   
+               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
+         END SELECT
+      ENDIF
+
+      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean
+         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:)
+         DO jl=1,jpl
+            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
+         ENDDO
+         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !  Ice fraction & Thickness ! 
+      !                                                      ! ------------------------- !
+      ! Send ice fraction field to atmosphere
+      IF( ssnd(jps_fice)%laction ) THEN
+         SELECT CASE( sn_snd_thick%clcat )
+         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl)
+         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      )
+         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+         END SELECT
+         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info )
+      ENDIF
+      
+      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
+      IF( ssnd(jps_fice2)%laction ) THEN
+         ztmp3(:,:,1) = fr_i(:,:)
+         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info )
+      ENDIF
+
+      ! Send ice and snow thickness field 
+      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN 
+         SELECT CASE( sn_snd_thick%cldes)
+         CASE( 'none'                  )       ! nothing to do
+         CASE( 'weighted ice and snow' )   
+            SELECT CASE( sn_snd_thick%clcat )
+            CASE( 'yes' )   
+               ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl)
+            CASE( 'no' )
+               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0
+               DO jl=1,jpl
+                  ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl)
+                  ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl)
+               ENDDO
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+            END SELECT
+         CASE( 'ice and snow'         )   
+            SELECT CASE( sn_snd_thick%clcat )
+            CASE( 'yes' )
+               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+            CASE( 'no' )
+               WHERE( SUM( a_i, dim=3 ) /= 0. )
+                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
+                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
+               ELSEWHERE
+                 ztmp3(:,:,1) = 0.
+                 ztmp4(:,:,1) = 0.
+               END WHERE
+            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+            END SELECT
+         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
+         END SELECT
+         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info )
+         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info )
+      ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !  CO2 flux from PISCES     ! 
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_co2)%laction .AND. l_co2cpl )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
+      !
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      !
+         !                                                   ! ------------------------- !
+         !    
+         !                                                  j+1   j     -----V---F
+         ! surface velocity always sent from T point                     !       |
+         !                                                        j      |   T   U
+         !                                                               |       |
+         !                                                   j    j-1   -I-------|
+         !                                               (for I)         |       |
+         !                                                              i-1  i   i
+         !                                                               i      i+1 (for I)
+         IF( nn_components == jp_iam_opa ) THEN
+            zotx1(:,:) = un(:,:,1)  
+            zoty1(:,:) = vn(:,:,1)  
+         ELSE        
+            SELECT CASE( TRIM( sn_snd_crt%cldes ) )
+            CASE( 'oce only'             )      ! C-grid ==> T
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) )
+                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) ) 
+                  END DO
+               END DO
+            CASE( 'weighted oce and ice' )   
+               SELECT CASE ( cp_ice_msh )
+               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)
+                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
+                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
+                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
+                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)  
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)  
+                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
+                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
+                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               END SELECT
+               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
+            CASE( 'mixed oce-ice'        )
+               SELECT CASE ( cp_ice_msh )
+               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   &
+                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   &
+                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
+                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     &
+                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     &
+                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1   ! NO vector opt.
+                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &   
+                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     &
+                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     &
+                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj)
+                     END DO
+                  END DO
+               END SELECT
+            END SELECT
+            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+            !
+         ENDIF
+         !
+         !
+         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components
+            !                                                                     ! Ocean component
+            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
+            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
+            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
+            zoty1(:,:) = ztmp2(:,:)
+            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component
+               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
+               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
+               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
+               zity1(:,:) = ztmp2(:,:)
+            ENDIF
+         ENDIF
+         !
+         ! spherical coordinates to cartesian -> 2 components to 3 components
+         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
+            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents
+            ztmp2(:,:) = zoty1(:,:)
+            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
+            !
+            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities
+               ztmp1(:,:) = zitx1(:,:)
+               ztmp1(:,:) = zity1(:,:)
+               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
+            ENDIF
+         ENDIF
+         !
+         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
+         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
+         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
+         !
+         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
+         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
+         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
+         ! 
+      ENDIF
+      !
+      !                                                      ! ------------------------- ! 
+      !                                                      !  Surface current to waves ! 
+      !                                                      ! ------------------------- ! 
+      IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN 
+          !     
+          !                                                  j+1  j     -----V---F 
+          ! surface velocity always sent from T point                    !       | 
+          !                                                       j      |   T   U 
+          !                                                              |       | 
+          !                                                   j   j-1   -I-------| 
+          !                                               (for I)        |       | 
+          !                                                             i-1  i   i 
+          !                                                              i      i+1 (for I) 
+          SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 
+          CASE( 'oce only'             )      ! C-grid ==> T 
+             DO jj = 2, jpjm1 
+                DO ji = fs_2, fs_jpim1   ! vector opt. 
+                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
+                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji , jj-1,1) )  
+                END DO 
+             END DO 
+          CASE( 'weighted oce and ice' )    
+             SELECT CASE ( cp_ice_msh ) 
+             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
+                DO jj = 2, jpjm1 
+                   DO ji = fs_2, fs_jpim1   ! vector opt. 
+                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
+                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
+                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+                   END DO 
+                END DO 
+             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
+                DO jj = 2, jpjm1 
+                   DO ji = 2, jpim1   ! NO vector opt. 
+                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
+                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
+                      zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
+                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                      zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
+                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                   END DO 
+                END DO 
+             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
+                DO jj = 2, jpjm1 
+                   DO ji = 2, jpim1   ! NO vector opt. 
+                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
+                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
+                      zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
+                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                      zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
+                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                   END DO 
+                END DO 
+             END SELECT 
+             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
+          CASE( 'mixed oce-ice'        ) 
+             SELECT CASE ( cp_ice_msh ) 
+             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
+                DO jj = 2, jpjm1 
+                   DO ji = fs_2, fs_jpim1   ! vector opt. 
+                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
+                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
+                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
+                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
+                   END DO 
+                END DO 
+             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
+                DO jj = 2, jpjm1 
+                   DO ji = 2, jpim1   ! NO vector opt. 
+                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
+                         &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
+                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
+                         &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
+                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                   END DO 
+                END DO 
+             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
+                DO jj = 2, jpjm1 
+                   DO ji = 2, jpim1   ! NO vector opt. 
+                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
+                         &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
+                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
+                         &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
+                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
+                   END DO 
+                END DO 
+             END SELECT 
+          END SELECT 
+         CALL lbc_lnk( zotx1, ssnd(jps_ocxw)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocyw)%clgrid, -1. ) 
+         ! 
+         ! 
+         IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
+         !                                                                        ! Ocean component 
+            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
+            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
+            zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
+            zoty1(:,:) = ztmp2(:,:)  
+            IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
+               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
+               CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
+               zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
+               zity1(:,:) = ztmp2(:,:) 
+            ENDIF 
+         ENDIF 
+         ! 
+!         ! spherical coordinates to cartesian -> 2 components to 3 components 
+!         IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN 
+!            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents 
+!            ztmp2(:,:) = zoty1(:,:) 
+!            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 
+!            ! 
+!            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities 
+!               ztmp1(:,:) = zitx1(:,:) 
+!               ztmp1(:,:) = zity1(:,:) 
+!               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 
+!            ENDIF 
+!         ENDIF 
+         ! 
+         IF( ssnd(jps_ocxw)%laction )   CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
+         IF( ssnd(jps_ocyw)%laction )   CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
+         !  
+      ENDIF 
+      ! 
+      IF( ssnd(jps_ficet)%laction ) THEN 
+         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info ) 
+      END IF 
+      !                                                      ! ------------------------- ! 
+      !                                                      !   Water levels to waves   ! 
+      !                                                      ! ------------------------- ! 
+      IF( ssnd(jps_wlev)%laction ) THEN 
+         IF( ln_apr_dyn ) THEN  
+            IF( kt /= nit000 ) THEN  
+               ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )  
+            ELSE  
+               ztmp1(:,:) = sshb(:,:)  
+            ENDIF  
+         ELSE  
+            ztmp1(:,:) = sshn(:,:)  
+         ENDIF  
+         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
+      END IF 
+      !
+      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling
+      !                                                        ! SSH
+      IF( ssnd(jps_ssh )%laction )  THEN
+         !                          ! removed inverse barometer ssh when Patm
+         !                          forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ztmp1(:,:) = sshn(:,:)
+         ENDIF
+         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info )
+
+      ENDIF
+      !                                                        ! SSS
+      IF( ssnd(jps_soce  )%laction )  THEN
+         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                        ! first T level thickness 
+      IF( ssnd(jps_e3t1st )%laction )  THEN
+         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t_n(:,:,1)   , (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                        ! Qsr fraction
+      IF( ssnd(jps_fraqsr)%laction )  THEN
+         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
+      ENDIF
+      !
+      !  Fields sent by SAS to OPA when OASIS coupling
+      !                                                        ! Solar heat flux
+      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
+
+      CALL wrk_dealloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
+      CALL wrk_dealloc( jpi,jpj,jpl,   ztmp3, ztmp4 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_snd')
+      !
+   END SUBROUTINE sbc_cpl_snd
+   
+   !!======================================================================
+END MODULE sbccpl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 8732)
@@ -0,0 +1,252 @@
+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 : 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
+   USE lib_mpp          ! MPP library
+   USE timing           ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   INTEGER, PUBLIC ::   nday_qsr   !: day when parameters were computed
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! diurnal cycle parameters
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   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
+
+      INTEGER FUNCTION sbc_dcy_alloc()
+         !!----------------------------------------------------------------------
+         !!                ***  FUNCTION sbc_dcy_alloc  ***
+         !!----------------------------------------------------------------------
+         ALLOCATE( raa (jpi,jpj) , rbb  (jpi,jpj) , rcc  (jpi,jpj) , rab  (jpi,jpj) ,     &
+            &      rtmd(jpi,jpj) , rdawn(jpi,jpj) , rdusk(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
+            !
+         IF( lk_mpp             )   CALL mpp_sum ( sbc_dcy_alloc )
+         IF( sbc_dcy_alloc /= 0 )   CALL ctl_warn('sbc_dcy_alloc: failed to allocate arrays')
+      END FUNCTION sbc_dcy_alloc
+
+
+   FUNCTION sbc_dcy( pqsrin, l_mask ) 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.
+      !!----------------------------------------------------------------------
+      LOGICAL, OPTIONAL, INTENT(in) :: l_mask ! use the routine for night mask computation
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
+      !!
+      INTEGER  ::   ji, jj                                       ! dummy loop indices
+      INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
+      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) ::   ztmpm, ztmpm1, ztmpm2
+      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)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_dcy')
+      !
+      ! Initialization
+      ! --------------
+      ztwopi    = 2._wp * rpi
+      zinvtwopi = 1._wp / ztwopi
+      zconvrad  = ztwopi / 360._wp
+
+      ! When are we during the day (from 0 to 1)
+      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday
+      zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday
+      !                                          
+      IF( nday_qsr == -1 ) THEN       ! first time step only  
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sbc_dcy : introduce diurnal cycle from daily mean qsr'
+            WRITE(numout,*) '~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+         ! allocate sbcdcy arrays
+         IF( sbc_dcy_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_dcy_alloc : unable to allocate arrays' )
+         ! Compute rcc needed to compute the time integral of the diurnal cycle
+         rcc(:,:) = zconvrad * glamt(:,:) - rpi
+         ! time of midday
+         rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp
+         rtmd(:,:) = MOD( (rtmd(:,:) + 1._wp) , 1._wp)
+      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_wp * 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._wp ) 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._wp ) 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_wp
+                  rdusk(ji,jj) = rdawn(ji,jj)
+               ENDIF
+             END DO  
+         END DO  
+         rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp )
+         rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp )
+         !     2.2 Compute the scaling function:
+         !         S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
+         !         Avoid possible infinite scaling factor, associated with very short daylight
+         !         periods, by ignoring periods less than 1/1000th of a day (ticket #1040)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h
+                  rscal(ji,jj) = 0.0_wp
+                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part
+                     IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN
+                       rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                       rscal(ji,jj) = 1._wp / rscal(ji,jj)
+                     ENDIF
+                  ELSE                                         ! day time in two parts
+                     IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN
+                       rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                          &         + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                       rscal(ji,jj) = 1. / rscal(ji,jj)
+                     ENDIF
+                  ENDIF
+               ELSE
+                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
+                     rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1._wp / rscal(ji,jj)
+                  ELSE                                          ! No day
+                     rscal(ji,jj) = 0.0_wp
+                  ENDIF
+               ENDIF
+            END DO  
+         END DO  
+         !
+         ztmp = rday / ( rdt * REAL(nn_fsbc, wp) )
+         rscal(:,:) = rscal(:,:) * ztmp
+         !
+      ENDIF 
+         !     3. update qsr with the diurnal cycle
+         !     ------------------------------------
+
+      imask_night(:,:) = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztmpm = 0.0
+            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)
+                  ztmpm = zupusd - zlousd
+                  IF ( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1
+                  !
+               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)) 
+                  ztmpm1=zupusd-zlousd
+                  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)) 
+                  ztmpm2 =zupusd-zlousd
+                  ztmp = ztmp1 + ztmp2
+                  ztmpm = ztmpm1 + ztmpm2
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  IF (ztmpm .EQ. 0.) imask_night(ji,jj) = 1
+               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)
+                  imask_night(ji,jj) = 0
+                  !
+               ELSE                                         ! No day
+                  zqsrout(ji,jj) = 0.0_wp
+                  imask_night(ji,jj) = 1
+               ENDIF
+            ENDIF
+         END DO  
+      END DO  
+      !
+      IF ( PRESENT(l_mask) .AND. l_mask ) THEN
+         zqsrout(:,:) = float(imask_night(:,:))
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_dcy')
+      !
+   END FUNCTION sbc_dcy
+
+   !!======================================================================
+END MODULE sbcdcy
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 8732)
@@ -0,0 +1,175 @@
+MODULE sbcflx
+   !!======================================================================
+   !!                       ***  MODULE  sbcflx  ***
+   !! Ocean forcing:  momentum, heat and freshwater flux formulation
+   !!=====================================================================
+   !! 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)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   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
+   USE iom             ! IOM library
+   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 sbc_flx       ! routine called by step.F90
+
+   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read 
+   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
+   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
+   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
+   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
+   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_flx( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_flx  ***
+      !!                   
+      !! ** Purpose :   provide at each time step the surface ocean fluxes
+      !!                (momentum, heat, freshwater and runoff) 
+      !!
+      !! ** Method  : - READ each fluxes in NetCDF files:
+      !!                   i-component of the stress              utau  (N/m2)
+      !!                   j-component of the stress              vtau  (N/m2)
+      !!                   net downward heat flux                 qtot  (watt/m2)
+      !!                   net downward radiative flux            qsr   (watt/m2)
+      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
+      !!
+      !!      CAUTION :  - never mask the surface stress fields
+      !!                 - the stress is assumed to be in the (i,j) mesh referential
+      !!
+      !! ** Action  :   update at each time-step
+      !!              - utau, vtau  i- and j-component of the wind stress
+      !!              - taum        wind stress module at T-point
+      !!              - wndm        10m wind module at T-point
+      !!              - qns         non solar heat flux including heat flux due to emp
+      !!              - qsr         solar heat flux
+      !!              - emp         upward mass flux (evap. - precip.)
+      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero
+      !!                            if ice is present (computed in limsbc(_2).F90)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ji, jj, jf            ! dummy indices
+      INTEGER  ::   ierror                ! return error code
+      INTEGER  ::   ios                   ! Local integer output status for namelist read
+      REAL(wp) ::   zfact                 ! temporary scalar
+      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
+      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
+      !!
+      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
+      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
+      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
+      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN                ! First call kt=nit000  
+         ! set file information
+         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes
+         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx in reference namelist', lwp )
+
+         REWIND( numnam_cfg )              ! Namelist namsbc_flx in configuration namelist : Files for fluxes
+         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist', lwp )
+         IF(lwm) WRITE ( numond, namsbc_flx ) 
+         !
+         !                                         ! 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
+         !
+         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,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
+         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
+         !
+         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90)
+         !
+      ENDIF
+
+      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( 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
+         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
+            DO ji = 1, jpi
+               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
+         !                                                        ! add to qns the heat due to e-p
+         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
+         !
+         !                                                        ! module of wind stress and wind speed at T-point
+         zcoef = 1. / ( zrhoa * zcdrag )
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vect. opt.
+               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
+               taum(ji,jj) = zmod
+               wndm(ji,jj) = SQRT( zmod * zcoef )
+            END DO
+         END DO
+         taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)
+         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
+
+         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'
+            DO jf = 1, jpfld
+               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
+               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
+               IF( jf == jp_emp                     )   zfact = 86400.
+               WRITE(numout,*) 
+               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_flx
+
+   !!======================================================================
+END MODULE sbcflx
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 8732)
@@ -0,0 +1,217 @@
+MODULE sbcfwb
+   !!======================================================================
+   !!                       ***  MODULE  sbcfwb  ***
+   !! Ocean fluxes   : domain averaged freshwater budget
+   !!======================================================================
+   !! 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 
+   !!            3.6  ! 2014-11  (P. Mathiot  ) add ice shelf melting
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_fwb       : freshwater budget for global ocean configurations (free surface & forced mode)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface ocean boundary condition
+   USE phycst         ! physical constants
+   USE sbcrnf         ! ocean runoffs
+   USE sbcisf         ! ice shelf melting contribution
+   USE sbcssr         ! Sea-Surface damping terms
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE lib_fortran    ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_fwb    ! routine called by step
+
+   REAL(wp) ::   a_fwb_b   ! annual domain averaged freshwater budget
+   REAL(wp) ::   a_fwb     ! for 2 year before (_b) and before year.
+   REAL(wp) ::   fwfold    ! fwfold to be suppressed
+   REAL(wp) ::   area      ! global mean ocean surface (interior domain)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_fwb  ***
+      !!
+      !! ** Purpose :   Control the mean sea surface drift
+      !!
+      !! ** Method  :   several ways  depending on kn_fwb
+      !!                =0 no control 
+      !!                =1 global mean of emp set to zero at each nn_fsbc time step
+      !!                =2 annual global mean corrected from previous year
+      !!                =3 global mean of emp set to zero at each nn_fsbc time step
+      !!                   & spread out over erp area depending its sign
+      !! Note: if sea ice is embedded it is taken into account when computing the budget 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kn_fsbc  ! 
+      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index
+      !
+      INTEGER  ::   inum, ikty, iyear     ! local integers
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars
+      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_fwb')
+      !
+      CALL wrk_alloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sbc_fwb : FreshWater Budget correction'
+            WRITE(numout,*) '~~~~~~~'
+            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,*) '          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 ' )
+         IF( kn_fwb == 3 .AND. ln_isfcav    )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
+         !
+         area = glob_sum( e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface
+         ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
+         ! and in case of no melt, it can generate HSSW.
+         !
+#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice
+         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass
+         snwice_mass  (:,:) = 0.e0
+#endif
+         !
+      ENDIF
+      
+
+      SELECT CASE ( kn_fwb )
+      !
+      CASE ( 1 )                             !==  global mean fwf set to zero  ==!
+         !
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area   ! sum over the global domain
+            zcoef = z_fwf * rcp
+            emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1)
+            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+         ENDIF
+         !
+      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 )
+            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 = ', 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 fwfold if new year start
+         ikty = 365 * 86400 / rdt                  !!bug  use of 365 days leap year or 360d year !!!!!!!
+         IF( MOD( kt, ikty ) == 0 ) THEN
+            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow
+                                                      ! sum over the global domain
+            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) )
+            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s
+!!gm        !                                                      !!bug 365d year 
+            fwfold =  a_fwb                           ! current year freshwater budget correction
+            !                                         ! estimate from the previous year budget
+         ENDIF
+         ! 
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes
+            zcoef = fwfold * rcp
+            emp(:,:) = emp(:,:) + fwfold             * tmask(:,:,1)
+            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+         ENDIF
+         !
+         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
+            CLOSE( inum )
+         ENDIF
+         !
+      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==!
+         !
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+            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(:,:)
+            !
+            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp 
+            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
+            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges) 
+            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
+            !            
+            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
+                zsurf_tospread      = zsurf_pos
+                ztmsk_tospread(:,:) = ztmsk_pos(:,:)
+            ELSE                             ! spread out over <0 erp area to increase precipitation
+                zsurf_tospread      = zsurf_neg
+                ztmsk_tospread(:,:) = ztmsk_neg(:,:)
+            ENDIF
+            !
+            zsum_fwf   = glob_sum( e1e2t(:,:) * 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(:,:) * e1e2t(:,:) )
+            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
+            !                                                  ! 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(:,:)
+            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction
+            erp(:,:) = erp(:,:) + zerp_cor(:,:)
+            !
+            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(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ELSE
+                  WRITE(numout,*)'   z_fwf >= 0'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+               ENDIF
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*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  ==!
+         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
+         !
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_fwb')
+      !
+   END SUBROUTINE sbc_fwb
+
+   !!======================================================================
+END MODULE sbcfwb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 8732)
@@ -0,0 +1,1115 @@
+MODULE sbcice_cice
+   !!======================================================================
+   !!                       ***  MODULE  sbcice_cice  ***
+   !! To couple with sea ice model CICE (LANL)
+   !!=====================================================================
+#if defined key_cice
+   !!----------------------------------------------------------------------
+   !!   'key_cice' :                                     CICE sea-ice model
+   !!----------------------------------------------------------------------
+   !!   sbc_ice_cice  : 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 domvvl
+   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic
+   USE in_out_manager  ! I/O manager
+   USE iom, ONLY : iom_put,iom_use              ! I/O manager library !!Joakim edit
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE daymod          ! calendar
+   USE fldread         ! read input fields
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice   fields
+   USE sbcblk          ! Surface boundary condition: bulk
+   USE sbccpl
+
+   USE ice_kinds_mod
+   USE ice_blocks
+   USE ice_domain
+   USE ice_domain_size
+   USE ice_boundary
+   USE ice_constants
+   USE ice_gather_scatter
+   USE ice_calendar, only: dt
+   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen
+# if defined key_cice4
+   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
+                strocnxT,strocnyT,                               & 
+                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     &
+                fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt,          &
+                flatn_f,fsurfn_f,fcondtopn_f,                    &
+                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   &
+                swvdr,swvdf,swidr,swidf
+   USE ice_therm_vertical, only: calc_Tsfc
+#else
+   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
+                strocnxT,strocnyT,                               & 
+                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     &
+                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          &
+                flatn_f,fsurfn_f,fcondtopn_f,                    &
+                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   &
+                swvdr,swvdf,swidr,swidf
+   USE ice_therm_shared, only: calc_Tsfc
+#endif
+   USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf
+   USE ice_atmo, only: calc_strair
+
+   USE CICE_InitMod
+   USE CICE_RunMod
+   USE CICE_FinalMod
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC cice_sbc_init   ! routine called by sbc_init
+   PUBLIC cice_sbc_final  ! routine called by sbc_final
+   PUBLIC sbc_ice_cice    ! routine called by sbc
+
+   INTEGER             ::   ji_off
+   INTEGER             ::   jj_off
+
+   INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read 
+   INTEGER , PARAMETER ::   jp_snow = 1    ! index of snow file
+   INTEGER , PARAMETER ::   jp_rain = 2    ! index of rain file
+   INTEGER , PARAMETER ::   jp_sblm = 3    ! index of sublimation file
+   INTEGER , PARAMETER ::   jp_top1 = 4    ! index of category 1 topmelt file
+   INTEGER , PARAMETER ::   jp_top2 = 5    ! index of category 2 topmelt file
+   INTEGER , PARAMETER ::   jp_top3 = 6    ! index of category 3 topmelt file
+   INTEGER , PARAMETER ::   jp_top4 = 7    ! index of category 4 topmelt file
+   INTEGER , PARAMETER ::   jp_top5 = 8    ! index of category 5 topmelt file
+   INTEGER , PARAMETER ::   jp_bot1 = 9    ! index of category 1 botmelt file
+   INTEGER , PARAMETER ::   jp_bot2 = 10   ! index of category 2 botmelt file
+   INTEGER , PARAMETER ::   jp_bot3 = 11   ! index of category 3 botmelt file
+   INTEGER , PARAMETER ::   jp_bot4 = 12   ! index of category 4 botmelt file
+   INTEGER , PARAMETER ::   jp_bot5 = 13   ! index of category 5 botmelt file
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-consortium (2015) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sbc_ice_cice_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION sbc_ice_cice_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( png(jpi,jpj,jpnij), STAT=sbc_ice_cice_alloc )
+      IF( lk_mpp                 )   CALL mpp_sum ( sbc_ice_cice_alloc )
+      IF( sbc_ice_cice_alloc > 0 )   CALL ctl_warn('sbc_ice_cice_alloc: allocation of arrays failed.')
+   END FUNCTION sbc_ice_cice_alloc
+
+   SUBROUTINE sbc_ice_cice( kt, ksbc )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ice_cice  ***
+      !!                   
+      !! ** Purpose :   update the ocean surface boundary condition via the 
+      !!                CICE Sea Ice Model time stepping 
+      !!
+      !! ** Method  : - Get any extra forcing fields for CICE  
+      !!              - Prepare forcing fields
+      !!              - CICE model time stepping
+      !!              - call the routine that computes mass and 
+      !!                heat fluxes at the ice/ocean interface
+      !!
+      !! ** Action  : - time evolution of the CICE sea-ice model
+      !!              - update all sbc variables below sea-ice:
+      !!                utau, vtau, qns , qsr, emp , sfx
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc    ! surface forcing type
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_cice')
+      !
+      !                                        !----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
+         !                                     !----------------------!
+
+         ! Make sure any fluxes required for CICE are set
+         IF      ( ksbc == jp_flx ) THEN
+            CALL cice_sbc_force(kt)
+         ELSE IF ( ksbc == jp_purecpl ) THEN
+            CALL sbc_cpl_ice_flx( 1.0-fr_i  )
+         ENDIF
+
+         CALL cice_sbc_in  ( kt, ksbc )
+         CALL CICE_Run
+         CALL cice_sbc_out ( kt, ksbc )
+
+         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1)
+
+      ENDIF                                          ! End sea-ice time step only
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_cice')
+
+   END SUBROUTINE sbc_ice_cice
+
+
+   SUBROUTINE cice_sbc_init( ksbc )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_init  ***
+      !! ** Purpose: Initialise ice related fields for NEMO and coupling
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar
+      INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_init')
+      !
+      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )
+      !
+      IF(lwp) WRITE(numout,*)'cice_sbc_init'
+
+      ji_off = INT ( (jpiglo - nx_global) / 2 )
+      jj_off = INT ( (jpjglo - ny_global) / 2 )
+
+#if defined key_nemocice_decomp
+      ! Pass initial SST from NEMO to CICE so ice is initialised correctly if
+      ! there is no restart file.
+      ! Values from a CICE restart file would overwrite this
+      IF ( .NOT. ln_rstart ) THEN    
+         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 
+      ENDIF  
+#endif
+
+! Initialize CICE
+      CALL CICE_Initialize
+
+! Do some CICE consistency checks
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+         IF ( calc_strair .OR. calc_Tsfc ) THEN
+            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
+         ENDIF
+      ELSEIF (ksbc == jp_blk) THEN
+         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
+            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )
+         ENDIF
+      ENDIF
+
+
+! allocate sbc_ice and sbc_cice arrays
+      IF( sbc_ice_alloc()      /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate arrays' )
+      IF( sbc_ice_cice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' )
+
+! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart
+      IF( .NOT. ln_rstart ) THEN
+         tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz)
+         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
+      ENDIF
+
+      fr_iu(:,:)=0.0
+      fr_iv(:,:)=0.0
+
+      CALL cice2nemo(aice,fr_i, 'T', 1. )
+      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
+         DO jl=1,ncat
+            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
+         ENDDO
+      ENDIF
+
+! T point to U point
+! T point to V point
+      DO jj=1,jpjm1
+         DO ji=1,jpim1
+            fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
+            fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
+         ENDDO
+      ENDDO
+
+      CALL lbc_lnk ( fr_iu , 'U', 1. )
+      CALL lbc_lnk ( fr_iv , 'V', 1. )
+
+      !                                      ! embedded sea ice
+      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
+         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
+         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
+         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
+         snwice_mass_b(:,:) = snwice_mass(:,:)
+      ELSE
+         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges
+         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges
+      ENDIF
+      IF( .NOT.ln_rstart ) THEN
+         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area
+            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
+            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
+
+!!gm This should be put elsewhere....   (same remark for limsbc)
+!!gm especially here it is assumed zstar coordinate, but it can be ztilde....
+            IF( .NOT.ln_linssh ) THEN
+               !
+               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors
+                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
+               ENDDO
+               e3t_a(:,:,:) = e3t_b(:,:,:)
+               ! Reconstruction of all vertical scale factors at now and before time-steps
+               ! =============================================================================
+               ! Horizontal scale factor interpolations
+               ! --------------------------------------
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+               ! Vertical scale factor interpolations
+               ! ------------------------------------
+               CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+               CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+               CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+               CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+               ! t- and w- points depth
+               ! ----------------------
+               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+               gdepw_n(:,:,1) = 0.0_wp
+               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+               DO jk = 2, jpk
+                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk)
+                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
+                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:)
+               END DO
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init')
+      !
+   END SUBROUTINE cice_sbc_init
+
+   
+   SUBROUTINE cice_sbc_in( kt, ksbc )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_in  ***
+      !! ** Purpose: Set coupling fields and pass to CICE
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      INTEGER, INTENT(in   ) ::   ksbc ! surface forcing type
+      !
+      INTEGER  ::   ji, jj, jl                   ! dummy loop indices      
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn
+      REAL(wp) ::   zintb, zintn  ! dummy argument
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_in')
+      !
+      CALL wrk_alloc( jpi,jpj, ztmp, zpice )
+      CALL wrk_alloc( jpi,jpj,ncat, ztmpn )
+
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)'cice_sbc_in'
+      ENDIF
+
+      ztmp(:,:)=0.0
+
+! Aggregate ice concentration already set in cice_sbc_out (or cice_sbc_init on 
+! the first time-step)
+
+! forced and coupled case 
+
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+
+         ztmpn(:,:,:)=0.0
+
+! x comp of wind stress (CI_1)
+! U point to F point
+         DO jj=1,jpjm1
+            DO ji=1,jpi
+               ztmp(ji,jj) = 0.5 * (  fr_iu(ji,jj) * utau(ji,jj)      &
+                                    + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1)
+            ENDDO
+         ENDDO
+         CALL nemo2cice(ztmp,strax,'F', -1. )
+
+! y comp of wind stress (CI_2)
+! V point to F point
+         DO jj=1,jpj
+            DO ji=1,jpim1
+               ztmp(ji,jj) = 0.5 * (  fr_iv(ji,jj) * vtau(ji,jj)      &
+                                    + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1)
+            ENDDO
+         ENDDO
+         CALL nemo2cice(ztmp,stray,'F', -1. )
+
+! Surface downward latent heat flux (CI_5)
+         IF (ksbc == jp_flx) THEN
+            DO jl=1,ncat
+               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
+            ENDDO
+         ELSE
+! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow
+            qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub
+! End of temporary code
+            DO jj=1,jpj
+               DO ji=1,jpi
+                  IF (fr_i(ji,jj).eq.0.0) THEN
+                     DO jl=1,ncat
+                        ztmpn(ji,jj,jl)=0.0
+                     ENDDO
+                     ! This will then be conserved in CICE
+                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
+                  ELSE
+                     DO jl=1,ncat
+                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
+                     ENDDO
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+         DO jl=1,ncat
+            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. )
+
+! GBM conductive flux through ice (CI_6)
+!  Convert to GBM
+            IF (ksbc == jp_flx) THEN
+               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
+            ELSE
+               ztmp(:,:) = botmelt(:,:,jl)
+            ENDIF
+            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. )
+
+! GBM surface heat flux (CI_7)
+!  Convert to GBM
+            IF (ksbc == jp_flx) THEN
+               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 
+            ELSE
+               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))
+            ENDIF
+            CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. )
+         ENDDO
+
+      ELSE IF (ksbc == jp_blk) THEN
+
+! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself)
+! x comp and y comp of atmosphere surface wind (CICE expects on T points)
+         ztmp(:,:) = wndi_ice(:,:)
+         CALL nemo2cice(ztmp,uatm,'T', -1. )
+         ztmp(:,:) = wndj_ice(:,:)
+         CALL nemo2cice(ztmp,vatm,'T', -1. )
+         ztmp(:,:) = SQRT ( wndi_ice(:,:)**2 + wndj_ice(:,:)**2 )
+         CALL nemo2cice(ztmp,wind,'T', 1. )    ! Wind speed (m/s)
+         ztmp(:,:) = qsr_ice(:,:,1)
+         CALL nemo2cice(ztmp,fsw,'T', 1. )     ! Incoming short-wave (W/m^2)
+         ztmp(:,:) = qlw_ice(:,:,1)
+         CALL nemo2cice(ztmp,flw,'T', 1. )     ! Incoming long-wave (W/m^2)
+         ztmp(:,:) = tatm_ice(:,:)
+         CALL nemo2cice(ztmp,Tair,'T', 1. )    ! Air temperature (K)
+         CALL nemo2cice(ztmp,potT,'T', 1. )    ! Potential temp (K)
+! Following line uses MAX(....) to avoid problems if tatm_ice has unset halo rows  
+         ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) )    
+                                               ! Constant (101000.) atm pressure assumed
+         CALL nemo2cice(ztmp,rhoa,'T', 1. )    ! Air density (kg/m^3)
+         ztmp(:,:) = qatm_ice(:,:)
+         CALL nemo2cice(ztmp,Qa,'T', 1. )      ! Specific humidity (kg/kg)
+         ztmp(:,:)=10.0
+         CALL nemo2cice(ztmp,zlvl,'T', 1. )    ! Atmos level height (m)
+
+! May want to check all values are physically realistic (as in CICE routine 
+! prepare_forcing)?
+
+! Divide shortwave into spectral bands (as in prepare_forcing)
+         ztmp(:,:)=qsr_ice(:,:,1)*frcvdr       ! visible direct
+         CALL nemo2cice(ztmp,swvdr,'T', 1. )             
+         ztmp(:,:)=qsr_ice(:,:,1)*frcvdf       ! visible diffuse
+         CALL nemo2cice(ztmp,swvdf,'T', 1. )              
+         ztmp(:,:)=qsr_ice(:,:,1)*frcidr       ! near IR direct
+         CALL nemo2cice(ztmp,swidr,'T', 1. )
+         ztmp(:,:)=qsr_ice(:,:,1)*frcidf       ! near IR diffuse
+         CALL nemo2cice(ztmp,swidf,'T', 1. )
+
+      ENDIF
+
+! Snowfall
+! Ensure fsnow is positive (as in CICE routine prepare_forcing)
+      IF( iom_use('snowpre') )   CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit  
+      ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)  
+      CALL nemo2cice(ztmp,fsnow,'T', 1. ) 
+
+! Rainfall
+      IF( iom_use('precip') )   CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit
+      ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
+      CALL nemo2cice(ztmp,frain,'T', 1. ) 
+
+! Freezing/melting potential
+! Calculated over NEMO leapfrog timestep (hence 2*dt)
+      nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )
+
+      ztmp(:,:) = nfrzmlt(:,:)
+      CALL nemo2cice(ztmp,frzmlt,'T', 1. )
+
+! SST  and SSS
+
+      CALL nemo2cice(sst_m,sst,'T', 1. )
+      CALL nemo2cice(sss_m,sss,'T', 1. )
+
+! x comp and y comp of surface ocean current
+! U point to F point
+      DO jj=1,jpjm1
+         DO ji=1,jpi
+            ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1)
+         ENDDO
+      ENDDO
+      CALL nemo2cice(ztmp,uocn,'F', -1. )
+
+! V point to F point
+      DO jj=1,jpj
+         DO ji=1,jpim1
+            ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1)
+         ENDDO
+      ENDDO
+      CALL nemo2cice(ztmp,vocn,'F', -1. )
+
+      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
+          !
+          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
+          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
+          !
+         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
+          !
+         !
+      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
+         zpice(:,:) = ssh_m(:,:)
+      ENDIF
+
+! x comp and y comp of sea surface slope (on F points)
+! T point to F point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    &
+               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1)
+         END DO
+      END DO
+      CALL nemo2cice( ztmp,ss_tltx,'F', -1. )
+
+! T point to F point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    &
+               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1)
+         END DO
+      END DO
+      CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
+
+      CALL wrk_dealloc( jpi,jpj, ztmp, zpice )
+      CALL wrk_dealloc( jpi,jpj,ncat, ztmpn )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_in')
+      !
+   END SUBROUTINE cice_sbc_in
+
+
+   SUBROUTINE cice_sbc_out( kt, ksbc )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_out  ***
+      !! ** Purpose: Get fields from CICE and set surface fields for NEMO
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      INTEGER, INTENT( in  ) ::   ksbc ! surface forcing type
+      
+      INTEGER  ::   ji, jj, jl                 ! dummy loop indices
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_out')
+      !
+      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 )
+      
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)'cice_sbc_out'
+      ENDIF
+      
+! x comp of ocean-ice stress 
+      CALL cice2nemo(strocnx,ztmp1,'F', -1. )
+      ss_iou(:,:)=0.0
+! F point to U point
+      DO jj=2,jpjm1
+         DO ji=2,jpim1
+            ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
+         ENDDO
+      ENDDO
+      CALL lbc_lnk( ss_iou , 'U', -1. )
+
+! y comp of ocean-ice stress 
+      CALL cice2nemo(strocny,ztmp1,'F', -1. )
+      ss_iov(:,:)=0.0
+! F point to V point
+
+      DO jj=1,jpjm1
+         DO ji=2,jpim1
+            ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
+         ENDDO
+      ENDDO
+      CALL lbc_lnk( ss_iov , 'V', -1. )
+
+! x and y comps of surface stress
+! Combine wind stress and ocean-ice stress
+! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep]
+! strocnx and strocny already weighted by ice fraction in CICE so not done here 
+
+      utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)
+      vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)     
+ 
+! Also need ice/ocean stress on T points so that taum can be updated 
+! This interpolation is already done in CICE so best to use those values 
+      CALL cice2nemo(strocnxT,ztmp1,'T',-1.) 
+      CALL cice2nemo(strocnyT,ztmp2,'T',-1.) 
+ 
+! Update taum with modulus of ice-ocean stress 
+! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 
+taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) 
+
+! Freshwater fluxes 
+
+      IF (ksbc == jp_flx) THEN
+! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip)
+! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below
+! Not ideal since aice won't be the same as in the atmosphere.  
+! Better to use evap and tprecip? (but for now don't read in evap in this case)
+         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
+      ELSE IF (ksbc == jp_blk) THEN
+         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
+      ELSE IF (ksbc == jp_purecpl) THEN
+! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 
+! This is currently as required with the coupling fields from the UM atmosphere
+         emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:) 
+      ENDIF
+
+#if defined key_cice4
+      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. )
+      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. )
+#else
+      CALL cice2nemo(fresh_ai,ztmp1,'T', 1. )
+      CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. )
+#endif
+
+! Check to avoid unphysical expression when ice is forming (ztmp1 negative)
+! Otherwise we are effectively allowing ice of higher salinity than the ocean to form
+! which has to be compensated for by the ocean salinity potentially going negative
+! This check breaks conservation but seems reasonable until we have prognostic ice salinity
+! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU)
+      WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0)
+      sfx(:,:)=ztmp2(:,:)*1000.0
+      emp(:,:)=emp(:,:)-ztmp1(:,:)
+      fmmflx(:,:) = ztmp1(:,:) !!Joakim edit
+      
+      CALL lbc_lnk( emp , 'T', 1. )
+      CALL lbc_lnk( sfx , 'T', 1. )
+
+! Solar penetrative radiation and non solar surface heat flux
+
+! Scale qsr and qns according to ice fraction (bulk formulae only)
+
+      IF (ksbc == jp_blk) THEN
+         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))
+         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))
+      ENDIF
+! Take into account snow melting except for fully coupled when already in qns_tot
+      IF (ksbc == jp_purecpl) THEN
+         qsr(:,:)= qsr_tot(:,:)
+         qns(:,:)= qns_tot(:,:)
+      ELSE
+         qns(:,:)= qns(:,:)-sprecip(:,:)*Lfresh*(1.0-fr_i(:,:))
+      ENDIF
+
+! Now add in ice / snow related terms
+! [fswthru will be zero unless running with calc_Tsfc=T in CICE]
+#if defined key_cice4
+      CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. )
+#else
+      CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. )
+#endif
+      qsr(:,:)=qsr(:,:)+ztmp1(:,:)
+      CALL lbc_lnk( qsr , 'T', 1. )
+
+      DO jj=1,jpj
+         DO ji=1,jpi
+            nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0)
+         ENDDO
+      ENDDO
+
+#if defined key_cice4
+      CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. )
+#else
+      CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. )
+#endif
+      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:)
+
+      CALL lbc_lnk( qns , 'T', 1. )
+
+! Prepare for the following CICE time-step
+
+      CALL cice2nemo(aice,fr_i,'T', 1. )
+      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
+         DO jl=1,ncat
+            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
+         ENDDO
+      ENDIF
+
+! T point to U point
+! T point to V point
+      DO jj=1,jpjm1
+         DO ji=1,jpim1
+            fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1)
+            fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1)
+         ENDDO
+      ENDDO
+
+      CALL lbc_lnk ( fr_iu , 'U', 1. )
+      CALL lbc_lnk ( fr_iv , 'V', 1. )
+
+      !                                      ! embedded sea ice
+      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
+         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
+         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
+         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  )
+         snwice_mass_b(:,:) = snwice_mass(:,:)
+         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt
+      ENDIF
+
+! Release work space
+
+      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_out')
+      !
+   END SUBROUTINE cice_sbc_out
+
+
+   SUBROUTINE cice_sbc_hadgam( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_hadgam  ***
+      !! ** Purpose: Prepare fields needed to pass to HadGAM3 atmosphere
+      !! 
+      !!
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+
+      INTEGER  ::   jl                        ! dummy loop index
+      INTEGER  ::   ierror
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_hadgam')
+      !
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)'cice_sbc_hadgam'
+         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
+      ENDIF
+
+      !                                         ! =========================== !
+      !                                         !   Prepare Coupling fields   !
+      !                                         ! =========================== !
+
+! x and y comp of ice velocity
+
+      CALL cice2nemo(uvel,u_ice,'F', -1. )
+      CALL cice2nemo(vvel,v_ice,'F', -1. )
+
+! Ice concentration (CO_1) = a_i calculated at end of cice_sbc_out  
+
+! Snow and ice thicknesses (CO_2 and CO_3)
+
+      DO jl = 1,ncat
+         CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. )
+         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. )
+      ENDDO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_hadgam')
+      !
+   END SUBROUTINE cice_sbc_hadgam
+
+
+   SUBROUTINE cice_sbc_final
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_final  ***
+      !! ** Purpose: Finalize CICE
+      !!---------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)'cice_sbc_final'
+
+      CALL CICE_Finalize
+
+   END SUBROUTINE cice_sbc_final
+
+   SUBROUTINE cice_sbc_force (kt)
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_force  ***
+      !! ** Purpose : Provide CICE forcing from files
+      !!
+      !!---------------------------------------------------------------------
+      !! ** Method  :   READ monthly flux file in NetCDF files
+      !!      
+      !!  snowfall    
+      !!  rainfall    
+      !!  sublimation rate    
+      !!  topmelt (category)
+      !!  botmelt (category)
+      !!
+      !! History :
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      INTEGER  ::   ierror             ! return error code
+      INTEGER  ::   ifpr               ! dummy loop index
+      !!
+      CHARACTER(len=100) ::  cn_dir                            !   Root directory for location of CICE forcing files
+      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read
+      TYPE(FLD_N) ::   sn_snow, sn_rain, sn_sblm               ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_top1, sn_top2, sn_top3, sn_top4, sn_top5
+      TYPE(FLD_N) ::   sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5 
+
+      !!
+      NAMELIST/namsbc_cice/ cn_dir, sn_snow, sn_rain, sn_sblm,   &
+         &                          sn_top1, sn_top2, sn_top3, sn_top4, sn_top5,  &
+         &                          sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5
+      INTEGER :: ios
+      !!---------------------------------------------------------------------
+
+      !                                         ! ====================== !
+      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
+         !                                      ! ====================== !
+         ! namsbc_cice is not yet in the reference namelist
+         ! set file information (default values)
+         cn_dir = './'       ! directory in which the model is executed
+
+         ! (NB: frequency positive => hours, negative => months)
+         !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! landmask
+         !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! file
+         sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
+         sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    ) 
+         sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+         sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ,  ''    )
+
+         REWIND( numnam_ref )              ! Namelist namsbc_cice in reference namelist : 
+         READ  ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in reference namelist', lwp )
+
+         REWIND( numnam_cfg )              ! Namelist namsbc_cice in configuration namelist : Parameters of the run
+         READ  ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist', lwp )
+         IF(lwm) WRITE ( numond, namsbc_cice )
+
+         ! store namelist information in an array
+         slf_i(jp_snow) = sn_snow   ;   slf_i(jp_rain) = sn_rain   ;   slf_i(jp_sblm) = sn_sblm
+         slf_i(jp_top1) = sn_top1   ;   slf_i(jp_top2) = sn_top2   ;   slf_i(jp_top3) = sn_top3
+         slf_i(jp_top4) = sn_top4   ;   slf_i(jp_top5) = sn_top5   ;   slf_i(jp_bot1) = sn_bot1
+         slf_i(jp_bot2) = sn_bot2   ;   slf_i(jp_bot3) = sn_bot3   ;   slf_i(jp_bot4) = sn_bot4
+         slf_i(jp_bot5) = sn_bot5
+         
+         ! set sf structure
+         ALLOCATE( sf(jpfld), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'cice_sbc_force: unable to allocate sf structure' )   ;   RETURN
+         ENDIF
+
+         DO ifpr= 1, jpfld
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            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, 'cice_sbc_force', 'flux formulation for CICE', 'namsbc_cice' )
+         !
+      ENDIF
+
+      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the
+      !                                          ! input fields at the current time-step
+
+      ! set the fluxes from read fields
+      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1)
+      tprecip(:,:) = sf(jp_snow)%fnow(:,:,1)+sf(jp_rain)%fnow(:,:,1)
+! May be better to do this conversion somewhere else
+      qla_ice(:,:,1) = -Lsub*sf(jp_sblm)%fnow(:,:,1)
+      topmelt(:,:,1) = sf(jp_top1)%fnow(:,:,1)
+      topmelt(:,:,2) = sf(jp_top2)%fnow(:,:,1)
+      topmelt(:,:,3) = sf(jp_top3)%fnow(:,:,1)
+      topmelt(:,:,4) = sf(jp_top4)%fnow(:,:,1)
+      topmelt(:,:,5) = sf(jp_top5)%fnow(:,:,1)
+      botmelt(:,:,1) = sf(jp_bot1)%fnow(:,:,1)
+      botmelt(:,:,2) = sf(jp_bot2)%fnow(:,:,1)
+      botmelt(:,:,3) = sf(jp_bot3)%fnow(:,:,1)
+      botmelt(:,:,4) = sf(jp_bot4)%fnow(:,:,1)
+      botmelt(:,:,5) = sf(jp_bot5)%fnow(:,:,1)
+
+      ! control print (if less than 100 time-step asked)
+      IF( nitend-nit000 <= 100 .AND. lwp ) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '        read forcing fluxes for CICE OK'
+         CALL FLUSH(numout)
+      ENDIF
+
+   END SUBROUTINE cice_sbc_force
+
+   SUBROUTINE nemo2cice( pn, pc, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nemo2cice  ***
+      !! ** Purpose :   Transfer field in NEMO array to field in CICE array.  
+#if defined key_nemocice_decomp
+      !!             
+      !!                NEMO and CICE PE sub domains are identical, hence
+      !!                there is no need to gather or scatter data from 
+      !!                one PE configuration to another.
+#else
+      !!                Automatically gather/scatter between 
+      !!                different processors and blocks
+      !! ** Method :    A. Ensure all haloes are filled in NEMO field (pn)
+      !!                B. Gather pn into global array (png)
+      !!                C. Map png into CICE global array (pcg)
+      !!                D. Scatter pcg to CICE blocks (pc) + update haloes  
+#endif
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT( in ) ::   &
+          cd_type       ! nature of pn grid-point
+          !             !   = T or F gridpoints
+      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) :: pn
+#if !defined key_nemocice_decomp
+      REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2
+      REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg
+#endif
+      REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc
+      INTEGER (int_kind) :: &
+         field_type,        &! id for type of field (scalar, vector, angle)
+         grid_loc            ! id for location on horizontal grid
+                            !  (center, NEcorner, Nface, Eface)
+
+      INTEGER  ::   ji, jj, jn                      ! dummy loop indices
+      !!---------------------------------------------------------------------
+
+!     A. Ensure all haloes are filled in NEMO field (pn)
+
+      CALL lbc_lnk( pn , cd_type, psgn )
+
+#if defined key_nemocice_decomp
+
+      ! Copy local domain data from NEMO to CICE field
+      pc(:,:,1)=0.0
+      DO jj=2,ny_block-1
+         DO ji=2,nx_block-1
+            pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off)
+         ENDDO
+      ENDDO
+
+#else
+
+!     B. Gather pn into global array (png)
+
+      IF ( jpnij > 1) THEN
+         CALL mppsync
+         CALL mppgather (pn,0,png) 
+         CALL mppsync
+      ELSE
+         png(:,:,1)=pn(:,:)
+      ENDIF
+
+!     C. Map png into CICE global array (pcg)
+
+! Need to make sure this is robust to changes in NEMO halo rows....
+! (may be OK but not 100% sure)
+
+      IF (nproc==0) THEN     
+!        pcg(:,:)=0.0
+         DO jn=1,jpnij
+            DO jj=nldjt(jn),nlejt(jn)
+               DO ji=nldit(jn),nleit(jn)
+                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn)
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jj=1,ny_global
+            DO ji=1,nx_global
+               pcg(ji,jj)=png2(ji+ji_off,jj+jj_off)
+            ENDDO
+         ENDDO
+      ENDIF
+
+#endif
+
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            grid_loc=field_loc_center
+         CASE ( 'F' )                              
+            grid_loc=field_loc_NEcorner
+      END SELECT
+
+      SELECT CASE ( NINT(psgn) )
+         CASE ( -1 )
+            field_type=field_type_vector
+         CASE ( 1 )                              
+            field_type=field_type_scalar
+      END SELECT
+
+#if defined key_nemocice_decomp
+      ! Ensure CICE halos are up to date
+      CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type)
+#else
+!     D. Scatter pcg to CICE blocks (pc) + update halos
+      CALL scatter_global(pc, pcg, 0, distrb_info, grid_loc, field_type)
+#endif
+
+   END SUBROUTINE nemo2cice
+
+   SUBROUTINE cice2nemo ( pc, pn, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice2nemo  ***
+      !! ** Purpose :   Transfer field in CICE array to field in NEMO array.
+#if defined key_nemocice_decomp
+      !!             
+      !!                NEMO and CICE PE sub domains are identical, hence
+      !!                there is no need to gather or scatter data from 
+      !!                one PE configuration to another.
+#else 
+      !!                Automatically deal with scatter/gather between
+      !!                different processors and blocks
+      !! ** Method :    A. Gather CICE blocks (pc) into global array (pcg)
+      !!                B. Map pcg into NEMO global array (png)
+      !!                C. Scatter png into NEMO field (pn) for each processor
+      !!                D. Ensure all haloes are filled in pn 
+#endif
+      !!---------------------------------------------------------------------
+
+      CHARACTER(len=1), INTENT( in ) ::   &
+          cd_type       ! nature of pn grid-point
+          !             !   = T or F gridpoints
+      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) :: pn
+
+#if defined key_nemocice_decomp
+      INTEGER (int_kind) :: &
+         field_type,        & ! id for type of field (scalar, vector, angle)
+         grid_loc             ! id for location on horizontal grid
+                              ! (center, NEcorner, Nface, Eface)
+#else
+      REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg
+#endif
+
+      REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc
+
+      INTEGER  ::   ji, jj, jn                      ! dummy loop indices
+
+
+#if defined key_nemocice_decomp
+
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            grid_loc=field_loc_center
+         CASE ( 'F' )                              
+            grid_loc=field_loc_NEcorner
+      END SELECT
+
+      SELECT CASE ( NINT(psgn) )
+         CASE ( -1 )
+            field_type=field_type_vector
+         CASE ( 1 )                              
+            field_type=field_type_scalar
+      END SELECT
+
+      CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type)
+
+
+      pn(:,:)=0.0
+      DO jj=1,jpjm1
+         DO ji=1,jpim1
+            pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
+         ENDDO
+      ENDDO
+
+#else
+
+!      A. Gather CICE blocks (pc) into global array (pcg) 
+
+      CALL gather_global(pcg, pc, 0, distrb_info)
+
+!     B. Map pcg into NEMO global array (png)
+
+! Need to make sure this is robust to changes in NEMO halo rows....
+! (may be OK but not spent much time thinking about it)
+! Note that non-existent pcg elements may be used below, but
+! the lbclnk call on pn will replace these with sensible values
+
+      IF (nproc==0) THEN
+         png(:,:,:)=0.0
+         DO jn=1,jpnij
+            DO jj=nldjt(jn),nlejt(jn)
+               DO ji=nldit(jn),nleit(jn)
+                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+
+!     C. Scatter png into NEMO field (pn) for each processor
+
+      IF ( jpnij > 1) THEN
+         CALL mppsync
+         CALL mppscatter (png,0,pn) 
+         CALL mppsync
+      ELSE
+         pn(:,:)=png(:,:,1)
+      ENDIF
+
+#endif
+
+!     D. Ensure all haloes are filled in pn
+
+      CALL lbc_lnk( pn , cd_type, psgn )
+
+   END SUBROUTINE cice2nemo
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module         NO CICE sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ice_cice ( kt, ksbc )     ! Dummy routine
+      WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt
+   END SUBROUTINE sbc_ice_cice
+
+   SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine
+      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?'
+   END SUBROUTINE cice_sbc_init
+
+   SUBROUTINE cice_sbc_final     ! Dummy routine
+      WRITE(*,*) 'cice_sbc_final: You should not have seen this print! error?'
+   END SUBROUTINE cice_sbc_final
+
+#endif
+
+   !!======================================================================
+END MODULE sbcice_cice
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 8732)
@@ -0,0 +1,148 @@
+MODULE sbcice_if
+   !!======================================================================
+   !!                       ***  MODULE  sbcice  ***
+   !! Surface module :  update surface ocean boundary condition over ice
+   !!                   covered area using ice-if model
+   !!======================================================================
+   !! History :  3.0  !  2006-06  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_ice_if    : update sbc in ice-covered area
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE eosbn2         ! equation of state
+   USE sbc_oce        ! surface boundary condition: ocean fields
+#if defined key_lim3
+   USE ice    , ONLY :   a_i 
+#else
+   USE sbc_ice, ONLY :   a_i 
+#endif
+   USE fldread        ! read input field
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_ice_if      ! routine called in sbcmod
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ice   ! structure of input ice-cover (file informations, fields read)
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ice_if( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_ice_if  ***
+      !!
+      !! ** Purpose :   handle surface boundary condition over ice cover area
+      !!      when sea-ice model are not used
+      !!
+      !! ** Method  : - read sea-ice cover climatology
+      !!              - blah blah blah, ...
+      !!
+      !! ** Action  :   utau, vtau : remain unchanged
+      !!                taum, wndm : remain unchanged
+      !!                qns, qsr   : update heat flux below sea-ice
+      !!                emp, sfx   : update freshwater flux below sea-ice
+      !!                fr_i       : update the ice fraction
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      INTEGER  ::   ierror     ! return error code
+      INTEGER  ::   ios        ! Local integer output status for namelist read
+      REAL(wp) ::   ztrp, zsice, zt_fzp, zfr_obs
+      REAL(wp) ::   zqri, zqrj, zqrp, zqi
+      !!
+      CHARACTER(len=100) ::   cn_dir              ! Root directory for location of ice-if files
+      TYPE(FLD_N)        ::   sn_ice              ! informations about the fields to be read
+      NAMELIST/namsbc_iif/ cn_dir, sn_ice
+      !!---------------------------------------------------------------------
+      !                                         ! ====================== !
+      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
+         !                                      ! ====================== !
+         ! set file information
+         REWIND( numnam_ref )              ! Namelist namsbc_iif in reference namelist : Ice if file
+         READ  ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in reference namelist', lwp )
+
+         REWIND( numnam_cfg )              ! Namelist Namelist namsbc_iif in configuration namelist : Ice if file
+         READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist', lwp )
+         IF(lwm) WRITE ( numond, namsbc_iif )
+
+         ALLOCATE( sf_ice(1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_if: unable to allocate sf_ice structure' )
+         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
+         IF( sn_ice%ln_tint )   ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
+
+         ! fill sf_ice with sn_ice and control print
+         CALL fld_fill( sf_ice, (/ sn_ice /), cn_dir, 'sbc_ice_if', 'ice-if sea-ice model', 'namsbc_iif' )
+         !
+      ENDIF
+
+      CALL fld_read( kt, nn_fsbc, sf_ice )           ! Read input fields and provides the
+      !                                              ! input fields at the current time-step
+      
+      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
+         !
+         ztrp = -40.             ! restoring terme for temperature (w/m2/k)
+         zsice = - 0.04 / 0.8    ! ratio of isohaline compressibility over isotherme compressibility
+                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
+         
+         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celsius]
+         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1)
+
+         IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)         
+
+         ! Flux and ice fraction computation
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
+               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
+               ELSE                                ;   fr_i(ji,jj) = 0.e0
+               ENDIF
+
+               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature
+
+               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover
+
+               !                                            ! non solar heat flux : add a damping term 
+               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0)
+               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1)
+               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) )
+               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp )
+               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    &
+                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1)
+
+               !                                            ! non-solar heat flux 
+               !      # qns unchanged              if no climatological ice              (zfr_obs=0)
+               !      # qns = zqrp                 if climatological ice and no opa ice  (zfr_obs=1, fr_i=0)
+               !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1)
+               !                                   (-2=arctic, -4=antarctic)   
+               zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
+               qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             &
+                  &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   &
+                  &       + zqrp
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_ice_if
+
+   !!======================================================================
+END MODULE sbcice_if
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 8732)
@@ -0,0 +1,688 @@
+MODULE sbcice_lim
+   !!======================================================================
+   !!                       ***  MODULE  sbcice_lim  ***
+   !! Surface module :  update the ocean surface boundary condition over ice
+   !!       &           covered area using LIM sea-ice model
+   !! Sea-Ice model  :  LIM-3 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
+   !!             -   ! 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
+   !!            3.4  ! 2011-01  (A Porter)  dynamical allocation
+   !!             -   ! 2012-10  (C. Rousset)  add lim_diahsb
+   !!            3.6  ! 2014-07  (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface
+   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                  LIM 3.0 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   sbc_ice_lim  : 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             ! LIM-3: ice variables
+   USE thd_ice         ! LIM-3: thermodynamical variables
+   !
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice   fields
+   USE usrdef_sbc      ! user defined: surface boundary condition
+   USE sbcblk          ! Surface boundary condition: bulk
+   USE sbccpl          ! Surface boundary condition: coupled interface
+   USE albedo          ! ocean & ice albedo
+   !
+   USE phycst          ! Define parameters for the routines
+   USE eosbn2          ! equation of state
+   USE limdyn          ! Ice dynamics
+   USE limtrp          ! Ice transport
+   USE limhdf          ! Ice horizontal diffusion
+   USE limthd          ! Ice thermodynamics
+   USE limitd_me       ! Mechanics on ice thickness distribution
+   USE limsbc          ! sea surface boundary condition
+   USE limdiahsb       ! Ice budget diagnostics
+   USE limwri          ! Ice outputs
+   USE limrst          ! Ice restarts
+   USE limupdate1      ! update of global variables
+   USE limupdate2      ! update of global variables
+   USE limvar          ! Ice variables switch
+   USE limctl          !
+   USE limistate       ! LIM initial state
+   USE limthd_sal      ! LIM ice thermodynamics: salinity
+   !
+   USE c1d             ! 1D vertical configuration
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE prtctl          ! Print control
+   USE lib_fortran     !
+   USE lbclnk          ! lateral boundary condition - MPP link
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   USE bdy_oce   , ONLY: ln_bdy
+   USE bdyice_lim      ! unstructured open boundary data  (bdy_ice_lim routine)
+# if defined key_agrif
+   USE agrif_ice
+   USE agrif_lim3_update
+   USE agrif_lim3_interp
+# endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
+   PUBLIC sbc_lim_init ! routine called by sbcmod.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , UCL NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ice_lim( kt, ksbc )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ice_lim  ***
+      !!
+      !! ** Purpose :   update the ocean surface boundary condition via the
+      !!                Louvain la Neuve Sea Ice Model time stepping
+      !!
+      !! ** Method  :   ice model time stepping
+      !!              - call the ice dynamics routine
+      !!              - call the ice advection/diffusion routine
+      !!              - call the ice thermodynamics routine
+      !!              - call the routine that computes mass and
+      !!                heat fluxes at the ice/ocean interface
+      !!              - save the outputs
+      !!              - save the outputs for restart when necessary
+      !!
+      !! ** Action  : - time evolution of the LIM sea-ice model
+      !!              - update all sbc variables below sea-ice:
+      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc    ! type of sbc flux ( 1 = user defined formulation, 
+                                       !                    3 = bulk formulation,
+                                       !                    4 = Pure Coupled formulation)
+      !!
+      INTEGER  ::   jl                 ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
+      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice 
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 )   CALL timing_start('sbc_ice_lim')
+
+      !-----------------------!
+      ! --- Ice time step --- !
+      !-----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
+
+# if defined key_agrif
+         IF( .NOT. Agrif_Root() )  lim_nbstep = MOD( lim_nbstep, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1
+# endif
+
+         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean)
+         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)
+         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
+
+         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
+         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) )
+         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+
+         ! Mask sea ice surface temperature (set to rt0 over land)
+         DO jl = 1, jpl
+            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+         END DO
+         !
+         !------------------------------------------------!
+         ! --- Dynamical coupling with the atmosphere --- !
+         !------------------------------------------------!
+         ! It provides the following fields:
+         ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2]
+         !-----------------------------------------------------------------
+                                      CALL sbc_lim_bef         ! Store previous ice values
+         SELECT CASE( ksbc )
+            CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation
+            CASE( jp_blk     )   ;    CALL blk_ice_tau                              ! Bulk formulation
+            CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation
+         END SELECT
+
+         IF( ln_mixcpl) THEN                                                       ! Case of a mixed Bulk/Coupled formulation
+            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice)
+                                      CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         ENDIF
+
+         !-------------------------------------------------------!
+         ! --- ice dynamics and transport (except in 1D case) ---!
+         !-------------------------------------------------------!
+         numit = numit + nn_fsbc                  ! Ice model time step
+         !
+                                      CALL sbc_lim_diag0       ! set diag of mass, heat and salt fluxes to 0
+                                      CALL lim_rst_opn( kt )   ! Open Ice restart file
+         !
+         ! --- zap this if no ice dynamics --- !
+         IF( .NOT. lk_c1d .AND. ln_limdyn ) THEN
+            !
+            IF( nn_limdyn /= 0 ) THEN                          ! -- Ice dynamics
+                                      CALL lim_dyn( kt )       !     rheology  
+            ELSE
+               u_ice(:,:) = rn_uice * umask(:,:,1)             !     or prescribed velocity
+               v_ice(:,:) = rn_vice * vmask(:,:,1)
+            ENDIF
+                                      CALL lim_trp( kt )       ! -- Ice transport (Advection/diffusion)
+            IF( nn_limdyn == 2 .AND. nn_monocat /= 2 )  &      ! -- Mechanical redistribution (ridging/rafting)
+               &                      CALL lim_itd_me         
+            IF( nn_limdyn == 2 )      CALL lim_update1( kt )   ! -- Corrections
+            !
+         ENDIF
+
+         ! ---
+#if defined key_agrif
+         IF( .NOT. Agrif_Root() )     CALL agrif_interp_lim3('T')
+#endif
+         IF( ln_limthd .AND. ln_bdy ) CALL bdy_ice_lim( kt )   ! -- bdy ice thermo 
+         ! previous lead fraction and ice volume for flux calculations
+                                      CALL sbc_lim_bef                        
+                                      CALL lim_var_glo2eqv     ! ht_i and ht_s for ice albedo calculation
+                                      CALL lim_var_agg(1)      ! at_i for coupling (via pfrld) 
+         !
+         pfrld(:,:)   = 1._wp - at_i(:,:)
+         phicif(:,:)  = vt_i(:,:)
+
+         !------------------------------------------------------!
+         ! --- Thermodynamical coupling with the atmosphere --- !
+         !------------------------------------------------------!
+         ! It provides the following fields:
+         ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2]
+         ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2]
+         ! dqns_ice, dqla_ice : non solar & latent heat sensistivity   (T-point)         [W/m2]
+         ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s]
+         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%]
+         !----------------------------------------------------------------------------------------
+         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs )
+         
+                                      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
+         SELECT CASE( ksbc )
+            CASE( jp_usr )   ;        CALL usrdef_sbc_ice_flx( kt ) ! user defined formulation
+            CASE( jp_blk )                                          ! bulk formulation
+               ! albedo depends on cloud fraction because of non-linear spectral effects
+               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+                                      CALL blk_ice_flx( t_su, alb_ice )
+               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
+               IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+            CASE ( jp_purecpl )
+               ! albedo depends on cloud fraction because of non-linear spectral effects
+               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+                                      CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su )
+               IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+         END SELECT
+
+         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs )
+
+         !----------------------------!
+         ! --- ice thermodynamics --- !
+         !----------------------------!
+         ! --- zap this if no ice thermo --- !
+         IF( ln_limthd )              CALL lim_thd( kt )        ! -- Ice thermodynamics      
+         IF( ln_limthd )              CALL lim_update2( kt )    ! -- Corrections
+         ! ---
+# if defined key_agrif
+         IF( .NOT. Agrif_Root() )     CALL agrif_update_lim3( kt )
+# endif
+                                      CALL lim_var_glo2eqv      ! necessary calls (at least for coupling)
+                                      CALL lim_var_agg( 2 )     ! necessary calls (at least for coupling)
+                                      !
+!! clem: one should switch the calculation of the fluxes onto the parent grid but the following calls do not work
+!!       moreover it should only be called at the update frequency (as in agrif_lim3_update.F90)
+!!# if defined key_agrif
+!!         IF( .NOT. Agrif_Root() )   CALL Agrif_ChildGrid_To_ParentGrid()
+!!# endif
+                                      CALL lim_sbc_flx( kt )    ! -- Update surface ocean mass, heat and salt fluxes
+!!# if defined key_agrif
+!!         IF( .NOT. Agrif_Root() )   CALL Agrif_ParentGrid_To_ChildGrid()
+!!# endif
+         IF( ln_limdiahsb )           CALL lim_diahsb( kt )     ! -- Diagnostics and outputs 
+         !
+                                      CALL lim_wri( 1 )         ! -- Ice outputs 
+         !
+         IF( kt == nit000 .AND. ln_rstart )   &
+            &                         CALL iom_close( numrir )  ! close input ice restart file
+         !
+         IF( lrst_ice )               CALL lim_rst_write( kt )  ! -- Ice restart file 
+         !
+         IF( ln_limctl )              CALL lim_ctl( kt )        ! alerts in case of model crash
+         !
+      ENDIF   ! End sea-ice time step only
+
+      !-------------------------!
+      ! --- Ocean time step --- !
+      !-------------------------!
+      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere
+      !    using before instantaneous surf. currents
+      IF( ln_limdyn )                 CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )
+!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
+      !
+   END SUBROUTINE sbc_ice_lim
+
+
+   SUBROUTINE sbc_lim_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_init  ***
+      !!
+      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, ierr
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'sbc_lim_init : update ocean surface boudary condition' 
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
+      !
+      !                                ! Open the reference and configuration namelist files and namelist output file
+      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+      !
+      CALL lim_run_init                ! set some ice run parameters
+      !
+      !                                ! Allocate the ice arrays
+      ierr =        ice_alloc        ()      ! ice variables
+      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
+      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
+      IF( ln_limdyn )   ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays')
+      !
+      CALL lim_dyn_init                ! set ice dynamics parameters
+      !
+      CALL lim_itd_init                ! ice thickness distribution initialization
+      !
+      CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters
+      !
+      CALL lim_thd_init                ! set ice thermodynics parameters
+      !
+      CALL lim_thd_sal_init            ! set ice salinity parameters
+      !
+      IF( ln_limdyn )   CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation
+      !                                ! Initial sea-ice state
+      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst
+         numit = 0
+         numit = nit000 - 1
+         CALL lim_istate
+      ELSE                                    ! start from a restart file
+         CALL lim_rst_read
+         numit = nit000 - 1
+      ENDIF
+      CALL lim_var_agg(2)
+      CALL lim_var_glo2eqv
+      !
+      CALL lim_sbc_init                 ! ice surface boundary condition
+      !
+      IF( ln_limdiahsb) CALL lim_diahsb_init  ! initialization for diags
+      !
+      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction
+      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( gphit(ji,jj) > 0._wp ) THEN  ;  rn_amax_2d(ji,jj) = rn_amax_n  ! NH
+            ELSE                             ;  rn_amax_2d(ji,jj) = rn_amax_s  ! SH
+            ENDIF
+         END DO
+      END DO
+      !
+      nstart = numit  + nn_fsbc
+      nitrun = nitend - nit000 + 1
+      nlast  = numit  + nitrun
+      !
+      IF( nstock == 0 )   nstock = nlast + 1
+      !
+   END SUBROUTINE sbc_lim_init
+
+
+   SUBROUTINE lim_run_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_run_init ***
+      !!
+      !! ** Purpose :   Definition some run parameter for ice model
+      !!
+      !! ** Method  :   Read the namicerun namelist and check the parameter
+      !!              values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicerun
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, rn_amax_n, rn_amax_s, cn_icerst_in, cn_icerst_indir,   &
+         &                cn_icerst_out, cn_icerst_outdir, ln_limthd, ln_limdyn, nn_limdyn, rn_uice, rn_vice  
+      NAMELIST/namicediag/ ln_limdiachk, ln_limdiahsb, ln_limctl, iiceprt, jiceprt  
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicerun )
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namicediag in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namicediag, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namicediag in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namicediag, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicediag in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namicediag )
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_run_init : ice share parameters for dynamics/advection/thermo of sea-ice'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   number of ice  categories                               = ', jpl
+         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i
+         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s
+         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n 
+         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s
+         WRITE(numout,*) '   Ice thermodynamics (T) or not (F)            ln_limthd  = ', ln_limthd
+         WRITE(numout,*) '   Ice dynamics       (T) or not (F)            ln_limdyn  = ', ln_limdyn
+         WRITE(numout,*) '     (ln_limdyn=T) Ice dynamics switch          nn_limdyn  = ', nn_limdyn
+         WRITE(numout,*) '       2: total'
+         WRITE(numout,*) '       1: advection only (no diffusion, no ridging/rafting)'
+         WRITE(numout,*) '       0: advection only (as 1 + prescribed velocity, bypass rheology)'
+         WRITE(numout,*) '     (ln_limdyn=T) prescribed u-vel (case nn_limdyn=0)     = ', rn_uice
+         WRITE(numout,*) '     (ln_limdyn=T) prescribed v-vel (case nn_limdyn=0)     = ', rn_vice
+         WRITE(numout,*)
+         WRITE(numout,*) '...and ice diagnostics'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Diagnose online heat/mass/salt budget     ln_limdiachk  = ', ln_limdiachk
+         WRITE(numout,*) '   Output          heat/mass/salt budget     ln_limdiahsb  = ', ln_limdiahsb
+         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_limctl
+         WRITE(numout,*) '   i-index for control prints (ln_limctl=true)             = ', iiceprt
+         WRITE(numout,*) '   j-index for control prints (ln_limctl=true)             = ', jiceprt
+      ENDIF
+      !
+      ! sea-ice timestep and inverse
+      rdt_ice   = REAL(nn_fsbc) * rdt  
+      r1_rdtice = 1._wp / rdt_ice 
+
+      ! inverse of nlay_i and nlay_s
+      r1_nlay_i = 1._wp / REAL( nlay_i, wp )
+      r1_nlay_s = 1._wp / REAL( nlay_s, wp )
+      !
+      IF( lwp .AND. ln_bdy .AND. ln_limdiachk )  &
+         &   CALL ctl_warn('online conservation check activated but it does not work with BDY')
+      !
+      IF( lwp ) WRITE(numout,*) '   ice timestep rdt_ice  = ', rdt_ice
+      !
+   END SUBROUTINE lim_run_init
+
+
+   SUBROUTINE lim_itd_init
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_init ***
+      !!
+      !! ** Purpose :   Initializes the ice thickness distribution
+      !! ** Method  :   ...
+      !! ** input   :   Namelist namiceitd
+      !!-------------------------------------------------------------------
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      NAMELIST/namiceitd/ nn_catbnd, rn_himean
+      !
+      INTEGER  ::   jl                   ! dummy loop index
+      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
+      REAL(wp) ::   zhmax, znum, zden, zalpha !
+      !!------------------------------------------------------------------
+      !
+      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice
+      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
+
+      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice
+      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numoni, namiceitd )
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd
+         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean
+      ENDIF
+      !
+      !----------------------------------
+      !- Thickness categories boundaries
+      !----------------------------------
+      !
+      hi_max(:) = 0._wp
+      !
+      SELECT CASE ( nn_catbnd  )    ! type of ice categories distribution
+      !
+      CASE (1)                            !==  tanh function (CICE)  ==!
+         zc1 =  3._wp / REAL( jpl, wp )
+         zc2 = 10._wp * zc1
+         zc3 =  3._wp
+         DO jl = 1, jpl
+            zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
+            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
+         END DO
+         !
+      CASE (2)                            !==  h^(-alpha) function  ==!
+         zalpha = 0.05_wp
+         zhmax  = 3._wp * rn_himean
+         DO jl = 1, jpl
+            znum = jpl * ( zhmax+1 )**zalpha
+            zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp )
+            hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
+         END DO
+         !
+      END SELECT
+      !
+      DO jl = 1, jpl                ! mean thickness by category
+         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+      END DO
+      !
+      hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl)
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '      Thickness category boundaries '
+      IF(lwp) WRITE(numout,*) '         hi_max ', hi_max(0:jpl)
+      !
+   END SUBROUTINE lim_itd_init
+
+
+   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_lim_flx  ***
+      !!
+      !! ** Purpose :   update the ice surface boundary condition by averaging and / or
+      !!                redistributing fluxes on ice categories
+      !!
+      !! ** Method  :   average then redistribute
+      !!
+      !! ** Action  :
+      !!---------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ;
+      !                                                         ! = 1 average and redistribute ; =2 redistribute
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqns_ice   ! non solar flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity
+      !
+      INTEGER  ::   jl      ! dummy loop index
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m    ! Mean albedo over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztem_m    ! Mean temperature over all categories
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories
+      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ice_lim_flx')
+      !
+      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==!
+      CASE( 0 , 1 )
+         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
+         !
+         z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
+         z_qsr_m  (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
+         z_dqn_m  (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
+         z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )
+         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) )
+         DO jl = 1, jpl
+            pdqn_ice  (:,:,jl) = z_dqn_m(:,:)
+            pdevap_ice(:,:,jl) = z_devap_m(:,:)
+         END DO
+         !
+         DO jl = 1, jpl
+            pqns_ice (:,:,jl) = z_qns_m(:,:)
+            pqsr_ice (:,:,jl) = z_qsr_m(:,:)
+            pevap_ice(:,:,jl) = z_evap_m(:,:)
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
+      END SELECT
+      !
+      SELECT CASE( k_limflx )                              !==  redistribution on all ice categories  ==!
+      CASE( 1 , 2 )
+         CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m )
+         !
+         zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) )
+         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) )
+         DO jl = 1, jpl
+            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
+            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
+            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj, zalb_m, ztem_m )
+      END SELECT
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ice_lim_flx')
+      !
+   END SUBROUTINE ice_lim_flx
+
+
+   SUBROUTINE sbc_lim_bef
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_bef  ***
+      !!
+      !! ** purpose :  store ice variables at "before" time step
+      !!----------------------------------------------------------------------
+      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area
+      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
+      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume
+      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume
+      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
+      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content
+      oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content
+      u_ice_b(:,:)     = u_ice(:,:)
+      v_ice_b(:,:)     = v_ice(:,:)
+      !
+      at_i_b (:,:)     = SUM( a_i_b(:,:,:), dim=3 )
+      
+   END SUBROUTINE sbc_lim_bef
+
+
+   SUBROUTINE sbc_lim_diag0
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_lim_diag0  ***
+      !!
+      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining
+      !!               of the time step
+      !!----------------------------------------------------------------------
+      sfx    (:,:) = 0._wp   ;
+      sfx_bri(:,:) = 0._wp   ;   sfx_lam(:,:) = 0._wp
+      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp
+      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp
+      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp
+      sfx_res(:,:) = 0._wp   ;   sfx_sub(:,:) = 0._wp
+      !
+      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp
+      wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp
+      wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp
+      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp
+      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp
+      wfx_spr(:,:) = 0._wp   ;   wfx_lam(:,:) = 0._wp  
+      
+      hfx_thd(:,:) = 0._wp   ;
+      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp
+      hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp
+      hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp
+      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp
+      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp
+      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp
+      hfx_err_dif(:,:) = 0._wp
+      wfx_err_sub(:,:) = 0._wp
+      !
+      afx_tot(:,:) = 0._wp   ;
+      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp
+      !
+      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp
+      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp
+
+      tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here)
+      
+   END SUBROUTINE sbc_lim_diag0
+
+
+   FUNCTION fice_cell_ave ( ptab )
+      !!--------------------------------------------------------------------------
+      !! * Compute average over categories, for grid cell (ice covered and free ocean)
+      !!--------------------------------------------------------------------------
+      REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave
+      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab
+      INTEGER :: jl ! Dummy loop index
+
+      fice_cell_ave (:,:) = 0._wp
+      DO jl = 1, jpl
+         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)
+      END DO
+
+   END FUNCTION fice_cell_ave
+
+
+   FUNCTION fice_ice_ave ( ptab )
+      !!--------------------------------------------------------------------------
+      !! * Compute average over categories, for ice covered part of grid cell
+      !!--------------------------------------------------------------------------
+      REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave
+      REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab
+
+      fice_ice_ave (:,:) = 0.0_wp
+      WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
+
+   END FUNCTION fice_ice_ave
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module      NO LIM 3.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   !
+   SUBROUTINE sbc_ice_lim ( kt, ksbc )     ! Dummy routine
+      INTEGER, INTENT(in) ::   kt, ksbc
+      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt
+   END SUBROUTINE sbc_ice_lim
+   !
+   SUBROUTINE sbc_lim_init                 ! Dummy routine
+   END SUBROUTINE sbc_lim_init
+#endif
+
+   !!======================================================================
+END MODULE sbcice_lim
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 8732)
@@ -0,0 +1,274 @@
+MODULE sbcice_lim_2
+   !!======================================================================
+   !!                       ***  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 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 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
+   USE iceini_2
+   USE dom_ice_2
+
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE sbcblk           ! Surface boundary condition: bulk
+   USE sbccpl           ! Surface boundary condition: coupled interface
+   USE albedo
+
+   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 limdia_2
+   USE limwri_2
+   USE limrst_2
+
+   USE c1d              ! 1D vertical configuration
+
+   USE lbclnk           ! lateral boundary condition - MPP link
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE iom              ! I/O manager library
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+
+# if defined key_agrif
+   USE agrif_ice
+   USE agrif_lim2_update
+# endif
+
+   USE bdy_oce   , ONLY: ln_bdy
+   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ice_lim_2( kt, ksbc )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ice_lim_2  ***
+      !!                   
+      !! ** Purpose :   update the ocean surface boundary condition via the 
+      !!                Louvain la Neuve Sea Ice Model time stepping 
+      !!
+      !! ** Method  :   ice model time stepping
+      !!              - call the ice dynamics routine 
+      !!              - call the ice advection/diffusion routine 
+      !!              - call the ice thermodynamics routine 
+      !!              - call the routine that computes mass and 
+      !!                heat fluxes at the ice/ocean interface
+      !!              - save the outputs 
+      !!              - save the outputs for restart when necessary
+      !!
+      !! ** Action  : - time evolution of the LIM sea-ice model
+      !!              - update all sbc variables below sea-ice:
+      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =4 bulk ; =5 coupled )
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K)
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice 
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         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
+         !
+# if defined key_agrif
+         IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2   ! AGRIF: set the meshes
+# endif
+      ENDIF
+
+      !                                        !----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
+         !                                     !----------------------!
+# if defined key_agrif
+         IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()&
+         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
+# endif
+
+         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
+
+         !  Bulk Formulea !
+         !----------------!
+         ! ... mean surface ocean current at ice dynamics point
+         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  ) * umask(ji-1,jj  ,1) &
+                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
+                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) &
+                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
+               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)
+            !
+         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
+            u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
+            v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
+            !
+         END SELECT
+
+         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
+         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
+         tfu(:,:) = tfu(:,:) + rt0
+
+         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
+
+         ! Ice albedo
+
+         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
+                                 reshape( hsnif, (/jpi,jpj,1/) ), &
+                          zalb_cs, zalb_os )
+
+         SELECT CASE( ksbc )
+         CASE( jp_blk , jp_purecpl )   ! BULK and COUPLED bulk formulations
+
+            ! albedo depends on cloud fraction because of non-linear spectral effects
+            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+
+         END SELECT
+
+         ! ... Sea-ice surface boundary conditions output from bulk formulae :
+         !     - utau_ice   ! surface ice stress i-component (I-point)   [N/m2]
+         !     - vtau_ice   ! surface ice stress j-component (I-point)   [N/m2]
+         !     - qns_ice    ! non solar heat flux over ice   (T-point)   [W/m2]
+         !     - qsr_ice    !     solar heat flux over ice   (T-point)   [W/m2]
+         !     - qla_ice    ! latent    heat flux over ice   (T-point)   [W/m2]
+         !     - dqns_ice   ! non solar heat sensistivity    (T-point)   [W/m2]
+         !     - dqla_ice   ! latent    heat sensistivity    (T-point)   [W/m2]
+         !     - tprecip    ! total precipitation            (T-point)   [Kg/m2/s]
+         !     - sprecip    ! solid precipitation            (T-point)   [Kg/m2/s]
+         !     - fr1_i0     ! 1sr fraction of qsr penetration in ice     [%]
+         !     - fr2_i0     ! 2nd fraction of qsr penetration in ice     [%]
+         !
+         SELECT CASE( ksbc )
+         !
+         CASE( jp_blk )           ! Bulk formulation
+            CALL blk_ice_tau
+            CALL blk_ice_flx( zsist, zalb_ice )
+            !
+         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
+            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
+            !
+         END SELECT
+         
+         IF( ln_mixcpl) THEN
+            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+         ENDIF
+
+         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point
+         CALL iom_put( 'vtau_ice', vtau_ice )     ! Wind stress over ice along j-axis at I-point
+
+         IF(ln_ctl) THEN         ! print mean trends (used for debugging)
+            CALL prt_ctl_info( 'Ice Forcings ' )
+            CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip  : ', tab2d_2=sprecip , clinfo2=' Snow    : ' )
+            CALL prt_ctl( tab2d_1=utau_ice,clinfo1=' sbc_ice_lim: utau_ice: ', tab2d_2=vtau_ice, clinfo2=' vtau_ice: ' )
+            CALL prt_ctl( tab2d_1=sst_m   ,clinfo1=' sbc_ice_lim: sst     : ', tab2d_2=sss_m   , clinfo2=' sss     : ' )
+            CALL prt_ctl( tab2d_1=u_oce   ,clinfo1=' sbc_ice_lim: u_io    : ', tab2d_2=v_oce   , clinfo2=' v_io    : ' )
+            CALL prt_ctl( tab2d_1=hsnif   ,clinfo1=' sbc_ice_lim: hsnif  1: ', tab2d_2=hicif   , clinfo2=' hicif   : ' )
+            CALL prt_ctl( tab2d_1=frld    ,clinfo1=' sbc_ice_lim: frld   1: ', tab2d_2=sist    , clinfo2=' sist    : ' )
+         ENDIF
+
+         ! ---------------- !
+         !  Ice model step  !
+         ! ---------------- !
+         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 
+           IF( ln_bdy    ) CALL bdy_ice_lim( kt ) ! bdy ice thermo
+         END IF
+         !                                             ! Ice surface fluxes in coupled mode 
+         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations
+            a_i(:,:,1)=fr_i
+            CALL sbc_cpl_ice_flx( frld,                                              &
+            !                                optional arguments, used only in 'mixed oce-ice' case
+            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist )
+            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
+         ENDIF
+                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
+                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
+
+         IF(  .NOT. lk_mpp )THEN
+            IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 )   &
+            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
+         ENDIF
+# if ! defined key_iomput
+                           CALL lim_wri_2      ( kt )      ! Ice outputs
+# endif
+         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
+         !
+# if defined key_agrif && defined key_lim2
+         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
+# endif
+         !
+         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
+         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
+         !
+      ENDIF                                    ! End sea-ice time step only
+      !
+      !                                        !--------------------------!
+      !                                        !  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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module      NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine
+      INTEGER, INTENT(in) ::   kt, ksbc    
+      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc
+   END SUBROUTINE sbc_ice_lim_2
+#endif
+
+   !!======================================================================
+END MODULE sbcice_lim_2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90	(revision 8732)
@@ -0,0 +1,887 @@
+MODULE sbcisf
+   !!======================================================================
+   !!                       ***  MODULE  sbcisf  ***
+   !! Surface module :  update surface ocean boundary condition under ice
+   !!                   shelf
+   !!======================================================================
+   !! History :  3.2   !  2011-02  (C.Harris  ) Original code isf cav
+   !!            X.X   !  2006-02  (C. Wang   ) Original code bg03
+   !!            3.4   !  2013-03  (P. Mathiot) Merging + parametrization
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_isf        : update sbc under ice shelf
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE zdfbfr          !
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE fldread         ! read input field at current time step
+   USE lbclnk          !
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+   USE lib_fortran     ! glob_sum
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_isf, sbc_isf_init, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divhor
+
+   ! public in order to be able to output then 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc  !: before and now T & S isf contents [K.m/s & PSU.m/s]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf                  !: net heat flux from ice shelf      [W/m2]
+   REAL(wp), PUBLIC ::   rn_hisf_tbl                 !: thickness of top boundary layer [m]
+   INTEGER , PUBLIC ::   nn_isf                      !: flag to choose between explicit/param/specified  
+   INTEGER , PUBLIC ::   nn_isfblk                   !: flag to choose the bulk formulation to compute the ice shelf melting
+   INTEGER , PUBLIC ::   nn_gammablk                 !: flag to choose how the exchange coefficient is computed
+   REAL(wp), PUBLIC ::   rn_gammat0                  !: temperature exchange coeficient []
+   REAL(wp), PUBLIC ::   rn_gammas0                  !: salinity    exchange coeficient []
+
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rzisf_tbl              !:depth of calving front (shallowest point) nn_isf ==2/3
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  rhisf_tbl, rhisf_tbl_0 !:thickness of tbl  [m]
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  r1_hisf_tbl            !:1/thickness of tbl
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ralpha                 !:proportion of bottom cell influenced by tbl 
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2
+   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point
+   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)      ::  misfkt, misfkb         !:Level of ice shelf base
+
+   LOGICAL, PUBLIC ::   l_isfcpl = .false.       ! isf recieved from oasis
+
+   REAL(wp), PUBLIC, SAVE ::   rcpi     = 2000.0_wp     ! specific heat of ice shelf             [J/kg/K]
+   REAL(wp), PUBLIC, SAVE ::   rkappa   = 1.54e-6_wp    ! heat diffusivity through the ice-shelf [m2/s]
+   REAL(wp), PUBLIC, SAVE ::   rhoisf   = 920.0_wp      ! volumic mass of ice shelf              [kg/m3]
+   REAL(wp), PUBLIC, SAVE ::   tsurf    = -20.0_wp      ! air temperature on top of ice shelf    [C]
+   REAL(wp), PUBLIC, SAVE ::   rlfusisf = 0.334e6_wp    ! latent heat of fusion of ice shelf     [J/kg]
+
+!: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3)
+   CHARACTER(len=100), PUBLIC           :: cn_dirisf  = './' !: Root directory for location of ssr files
+   TYPE(FLD_N)       , PUBLIC           :: sn_fwfisf         !: information about the isf melting file to be read
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_fwfisf
+   TYPE(FLD_N)       , PUBLIC           :: sn_rnfisf         !: information about the isf melting param.   file to be read
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnfisf           
+   TYPE(FLD_N)       , PUBLIC           :: sn_depmax_isf     !: information about the grounding line depth file to be read
+   TYPE(FLD_N)       , PUBLIC           :: sn_depmin_isf     !: information about the calving   line depth file to be read
+   TYPE(FLD_N)       , PUBLIC           :: sn_Leff_isf       !: information about the effective length     file to be read
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+  SUBROUTINE sbc_isf(kt)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_isf  ***
+      !!
+      !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf 
+      !!              melting and freezing 
+      !!
+      !! ** Method  :  4 parameterizations are available according to nn_isf 
+      !!               nn_isf = 1 : Realistic ice_shelf formulation
+      !!                        2 : Beckmann & Goose parameterization
+      !!                        3 : Specified runoff in deptht (Mathiot & al. )
+      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt                   ! ocean time step
+      !
+      INTEGER               :: ji, jj, jk           ! loop index
+      INTEGER               :: ikt, ikb             ! loop index
+      REAL(wp), DIMENSION (:,:), POINTER :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d
+      !!---------------------------------------------------------------------
+      !
+      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
+         ! allocation
+         CALL wrk_alloc( jpi,jpj, zt_frz, zdep  )
+
+         ! compute salt and heat flux
+         SELECT CASE ( nn_isf )
+         CASE ( 1 )    ! realistic ice shelf formulation
+            ! compute T/S/U/V for the top boundary layer
+            CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T')
+            CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T')
+            CALL sbc_isf_tbl(un(:,:,:)        ,utbl(:,:),'U')
+            CALL sbc_isf_tbl(vn(:,:,:)        ,vtbl(:,:),'V')
+            ! iom print
+            CALL iom_put('ttbl',ttbl(:,:))
+            CALL iom_put('stbl',stbl(:,:))
+            CALL iom_put('utbl',utbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
+            CALL iom_put('vtbl',vtbl(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:))
+            ! compute fwf and heat flux
+            ! compute fwf and heat flux
+            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt)
+            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * rlfusisf  ! heat        flux
+            ENDIF
+
+         CASE ( 2 )    ! Beckmann and Goosse parametrisation 
+            stbl(:,:)   = soce
+            CALL sbc_isf_bg03(kt)
+
+         CASE ( 3 )    ! specified runoff in depth (Mathiot et al., XXXX in preparation)
+            ! specified runoff in depth (Mathiot et al., XXXX in preparation)
+            IF( .NOT.l_isfcpl ) THEN
+               CALL fld_read ( kt, nn_fsbc, sf_rnfisf   )
+               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting) 
+            ENDIF
+            qisf(:,:)   = fwfisf(:,:) * rlfusisf             ! heat flux
+            stbl(:,:)   = soce
+
+         CASE ( 4 )    ! specified fwf and heat flux forcing beneath the ice shelf
+           ! specified fwf and heat flux forcing beneath the ice shelf
+            IF( .NOT.l_isfcpl ) THEN
+               CALL fld_read ( kt, nn_fsbc, sf_fwfisf   )
+               !CALL fld_read ( kt, nn_fsbc, sf_qisf   )
+               fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1)            ! fwf
+            ENDIF
+            qisf(:,:)   = fwfisf(:,:) * rlfusisf               ! heat flux
+            stbl(:,:)   = soce
+
+         END SELECT
+
+         ! compute tsc due to isf
+         ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU.
+         ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rau0).
+         ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3)
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               zdep(ji,jj)=gdepw_n(ji,jj,misfkt(ji,jj))
+            END DO
+         END DO
+         CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) )
+         
+         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 !
+         risf_tsc(:,:,jp_sal) = 0.0_wp
+
+         ! lbclnk
+         CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.)
+         CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.)
+         CALL lbc_lnk(fwfisf(:,:)   ,'T',1.)
+         CALL lbc_lnk(qisf(:,:)     ,'T',1.)
+
+         ! output
+         IF( iom_use('iceshelf_cea') )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:)                      )   ! isf mass flux
+         IF( iom_use('hflx_isf_cea') )   CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * rau0 * rcp )   ! isf sensible+latent heat (W/m2)
+         IF( iom_use('qlatisf' ) )       CALL iom_put( 'qlatisf'     , qisf(:,:)                         )   ! isf latent heat
+         IF( iom_use('fwfisf'  ) )       CALL iom_put( 'fwfisf'      , fwfisf(:,:)                       )   ! isf mass flux (opposite sign)
+
+        ! Diagnostics
+        IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN
+            CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d )
+            CALL wrk_alloc( jpi,jpj,     zqhcisf2d                        )
+
+            zfwfisf3d(:,:,:) = 0.0_wp                         ! 3d ice shelf melting (kg/m2/s)
+            zqhcisf3d(:,:,:) = 0.0_wp                         ! 3d heat content flux (W/m2)
+            zqlatisf3d(:,:,:)= 0.0_wp                         ! 3d ice shelf melting latent heat flux (W/m2)
+            zqhcisf2d(:,:)   = fwfisf(:,:) * zt_frz * rcp     ! 2d heat content flux (W/m2)
+
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  ikt = misfkt(ji,jj)
+                  ikb = misfkb(ji,jj)
+                  DO jk = ikt, ikb - 1
+                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk)
+                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk)
+                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * e3t_n(ji,jj,jk)
+                  END DO
+                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * e3t_n(ji,jj,jk)
+                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * e3t_n(ji,jj,jk)
+                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * e3t_n(ji,jj,jk)
+               END DO
+            END DO
+
+            CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:))
+            CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:))
+            CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:))
+            CALL iom_put('qhcisf'   , zqhcisf2d (:,:  ))
+
+            CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d )
+            CALL wrk_dealloc( jpi,jpj,     zqhcisf2d                        )
+          END IF
+          ! deallocation
+          CALL wrk_dealloc( jpi,jpj, zt_frz, zdep  )
+          !
+        END IF
+
+        IF( kt == nit000 ) THEN                         !   set the forcing field at nit000 - 1    !
+           IF( ln_rstart .AND.    &                     ! Restart: read in restart file
+                 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN
+               IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file'
+               CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) )   ! before salt content isf_tsc trend
+               CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend
+               CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend
+           ELSE
+               fwfisf_b(:,:)    = fwfisf(:,:)
+               risf_tsc_b(:,:,:)= risf_tsc(:,:,:)
+           END IF
+         END IF
+         ! 
+         IF( lrst_oce ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   &
+               &                    'at it= ', kt,' date= ', ndastp
+            IF(lwp) WRITE(numout,*) '~~~~'
+            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) )
+            CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) )
+            CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) )
+         ENDIF
+         !
+  END SUBROUTINE sbc_isf
+
+
+  INTEGER FUNCTION sbc_isf_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION sbc_isf_rnf_alloc  ***
+      !!----------------------------------------------------------------------
+      sbc_isf_alloc = 0       ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( qisf ) ) THEN
+         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj)   , &
+               &    rhisf_tbl(jpi,jpj)    , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , &
+               &    ttbl(jpi,jpj)         , stbl(jpi,jpj)       , utbl(jpi,jpj)       , &
+               &    vtbl(jpi, jpj)        , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), &
+               &    ralpha(jpi,jpj)       , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , &
+               &    STAT= sbc_isf_alloc )
+         !
+         IF( lk_mpp             )   CALL mpp_sum ( sbc_isf_alloc )
+         IF( sbc_isf_alloc /= 0 )   CALL ctl_warn('sbc_isf_alloc: failed to allocate arrays.')
+         !
+      END IF
+  END FUNCTION
+
+  SUBROUTINE sbc_isf_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_isf_init  ***
+      !!
+      !! ** Purpose : Initialisation of variables for iceshelf fluxes formulation
+      !!
+      !! ** Method  :  4 parameterizations are available according to nn_isf 
+      !!               nn_isf = 1 : Realistic ice_shelf formulation
+      !!                        2 : Beckmann & Goose parameterization
+      !!                        3 : Specified runoff in deptht (Mathiot & al. )
+      !!                        4 : specified fwf and heat flux forcing beneath the ice shelf
+      !!----------------------------------------------------------------------
+      INTEGER               :: ji, jj, jk           ! loop index
+      INTEGER               :: ik                   ! current level index
+      INTEGER               :: ikt, ikb             ! top and bottom level of the isf boundary layer
+      INTEGER               :: inum, ierror
+      INTEGER               :: ios                  ! Local integer output status for namelist read
+      REAL(wp)              :: zhk
+      CHARACTER(len=256)    :: cvarzisf, cvarhisf   ! name for isf file
+      CHARACTER(LEN=32 )    :: cvarLeff             ! variable name for efficient Length scale
+      !!----------------------------------------------------------------------
+      NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, rn_gammat0, rn_gammas0, nn_gammablk, nn_isf, &
+                         & sn_fwfisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
+      READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
+      READ  ( numnam_cfg, namsbc_isf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_isf )
+
+      IF ( lwp ) WRITE(numout,*)
+      IF ( lwp ) WRITE(numout,*) 'sbc_isf: heat flux of the ice shelf'
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~~'
+      IF ( lwp ) WRITE(numout,*) 'sbcisf :' 
+      IF ( lwp ) WRITE(numout,*) '~~~~~~~~'
+      IF ( lwp ) WRITE(numout,*) '        nn_isf      = ', nn_isf
+      IF ( lwp ) WRITE(numout,*) '        nn_isfblk   = ', nn_isfblk
+      IF ( lwp ) WRITE(numout,*) '        rn_hisf_tbl = ', rn_hisf_tbl
+      IF ( lwp ) WRITE(numout,*) '        nn_gammablk = ', nn_gammablk 
+      IF ( lwp ) WRITE(numout,*) '        rn_gammat0  = ', rn_gammat0  
+      IF ( lwp ) WRITE(numout,*) '        rn_gammas0  = ', rn_gammas0  
+      IF ( lwp ) WRITE(numout,*) '        rn_tfri2    = ', rn_tfri2 
+      !
+      ! Allocate public variable
+      IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' )
+      !
+      ! initialisation
+      qisf(:,:)        = 0._wp  ; fwfisf  (:,:) = 0._wp
+      risf_tsc(:,:,:)  = 0._wp  ; fwfisf_b(:,:) = 0._wp
+      !
+      ! define isf tbl tickness, top and bottom indice
+      SELECT CASE ( nn_isf )
+      CASE ( 1 ) 
+         rhisf_tbl(:,:) = rn_hisf_tbl
+         misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+
+      CASE ( 2 , 3 )
+         IF( .NOT.l_isfcpl ) THEN
+             ALLOCATE( sf_rnfisf(1), STAT=ierror )
+             ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) )
+             CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
+          ENDIF
+          !  read effective lenght (BG03)
+          IF (nn_isf == 2) THEN
+            CALL iom_open( sn_Leff_isf%clname, inum )
+            cvarLeff = TRIM(sn_Leff_isf%clvar)
+            CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1)
+            CALL iom_close(inum)
+            !
+            risfLeff = risfLeff*1000.0_wp           !: convertion in m
+          END IF
+         ! read depth of the top and bottom of the isf top boundary layer (in this case, isf front depth and grounding line depth)
+         CALL iom_open( sn_depmax_isf%clname, inum )
+         cvarhisf = TRIM(sn_depmax_isf%clvar)
+         CALL iom_get( inum, jpdom_data, cvarhisf, rhisf_tbl, 1) !: depth of deepest point of the ice shelf base
+         CALL iom_close(inum)
+         !
+         CALL iom_open( sn_depmin_isf%clname, inum )
+         cvarzisf = TRIM(sn_depmin_isf%clvar)
+         CALL iom_get( inum, jpdom_data, cvarzisf, rzisf_tbl, 1) !: depth of shallowest point of the ice shelves base
+         CALL iom_close(inum)
+         !
+         rhisf_tbl(:,:) = rhisf_tbl(:,:) - rzisf_tbl(:,:)        !: tickness isf boundary layer
+
+         !! compute first level of the top boundary layer
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+                ik = 2
+                DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw_n(ji,jj,ik) < rzisf_tbl(ji,jj) ) ;  ik = ik + 1 ;  END DO
+                misfkt(ji,jj) = ik-1
+            END DO
+         END DO
+
+      CASE ( 4 ) 
+         ! as in nn_isf == 1
+         rhisf_tbl(:,:) = rn_hisf_tbl
+         misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv
+         
+         ! load variable used in fldread (use for temporal interpolation of isf fwf forcing)
+         IF( .NOT.l_isfcpl ) THEN
+           ALLOCATE( sf_fwfisf(1), STAT=ierror )
+           ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) )
+           CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' )
+         ENDIF
+
+      END SELECT
+         
+      rhisf_tbl_0(:,:) = rhisf_tbl(:,:)
+
+      ! compute bottom level of isf tbl and thickness of tbl below the ice shelf
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            ikt = misfkt(ji,jj)
+            ikb = misfkt(ji,jj)
+            ! thickness of boundary layer at least the top level thickness
+            rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt))
+
+            ! determine the deepest level influenced by the boundary layer
+            DO jk = ikt+1, mbkt(ji,jj)
+               IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+            END DO
+            rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness.
+            misfkb(ji,jj) = ikb                                                   ! last wet level of the tbl
+            r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
+
+            zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) ! proportion of tbl cover by cell from ikt to ikb - 1
+            ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+         END DO
+      END DO
+
+  END SUBROUTINE sbc_isf_init
+
+  SUBROUTINE sbc_isf_bg03(kt)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_isf_bg03  ***
+      !!
+      !! ** Purpose : add net heat and fresh water flux from ice shelf melting
+      !!          into the adjacent ocean
+      !!
+      !! ** Method  :   See reference
+      !!
+      !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
+      !!         interaction for climate models", Ocean Modelling 5(2003) 157-170.
+      !!         (hereafter BG)
+      !! History :
+      !!         06-02  (C. Wang) Original code
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT ( in ) :: kt
+      !
+      INTEGER  :: ji, jj, jk ! dummy loop index
+      INTEGER  :: ik         ! current level
+      REAL(wp) :: zt_sum     ! sum of the temperature between 200m and 600m
+      REAL(wp) :: zt_ave     ! averaged temperature between 200m and 600m
+      REAL(wp) :: zt_frz     ! freezing point temperature at depth z
+      REAL(wp) :: zpress     ! pressure to compute the freezing point in depth
+      !!----------------------------------------------------------------------
+
+      IF ( nn_timing == 1 ) CALL timing_start('sbc_isf_bg03')
+      !
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            ik = misfkt(ji,jj)
+            !! Initialize arrays to 0 (each step)
+            zt_sum = 0.e0_wp
+            IF ( ik > 1 ) THEN
+               ! 1. -----------the average temperature between 200m and 600m ---------------------
+               DO jk = misfkt(ji,jj),misfkb(ji,jj)
+                  ! freezing point temperature  at ice shelf base BG eq. 2 (JMM sign pb ??? +7.64e-4 !!!)
+                  ! after verif with UNESCO, wrong sign in BG eq. 2
+                  ! Calculate freezing temperature
+                  CALL eos_fzp(stbl(ji,jj), zt_frz, zpress) 
+                  zt_sum = zt_sum + (tsn(ji,jj,jk,jp_tem)-zt_frz) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! sum temp
+               END DO
+               zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value
+               ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
+               ! For those corresponding to zonal boundary    
+               qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  &
+                           & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk)
+             
+               fwfisf(ji,jj) = qisf(ji,jj) / rlfusisf          !fresh water flux kg/(m2s)                  
+               fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) )
+               !add to salinity trend
+            ELSE
+               qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp
+            END IF
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_bg03')
+      !
+  END SUBROUTINE sbc_isf_bg03
+
+  SUBROUTINE sbc_isf_cav( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_isf_cav  ***
+      !!
+      !! ** Purpose :   handle surface boundary condition under ice shelf
+      !!
+      !! ** Method  : -
+      !!
+      !! ** Action  :   utau, vtau : remain unchanged
+      !!                taum, wndm : remain unchanged
+      !!                qns        : update heat flux below ice shelf
+      !!                emp, emps  : update freshwater flux below ice shelf
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)          ::   kt         ! ocean time step
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      INTEGER  ::   nit
+      REAL(wp) ::   zlamb1, zlamb2, zlamb3
+      REAL(wp) ::   zeps1,zeps2,zeps3,zeps4,zeps6,zeps7
+      REAL(wp) ::   zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac
+      REAL(wp) ::   zeps = 1.e-20_wp        
+      REAL(wp) ::   zerr
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfrz
+      REAL(wp), DIMENSION(:,:), POINTER ::   zgammat, zgammas 
+      REAL(wp), DIMENSION(:,:), POINTER ::   zfwflx, zhtflx, zhtflx_b
+      LOGICAL  ::   lit
+      !!---------------------------------------------------------------------
+      ! coeficient for linearisation of potential tfreez
+      ! Crude approximation for pressure (but commonly used)
+      zlamb1 =-0.0573_wp
+      zlamb2 = 0.0832_wp
+      zlamb3 =-7.53e-08_wp * grav * rau0
+      IF( nn_timing == 1 )  CALL timing_start('sbc_isf_cav')
+      !
+      CALL wrk_alloc( jpi,jpj, zfrz  , zgammat, zgammas  )
+      CALL wrk_alloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )
+
+      ! initialisation
+      zgammat(:,:) = rn_gammat0 ; zgammas (:,:) = rn_gammas0
+      zhtflx (:,:) = 0.0_wp     ; zhtflx_b(:,:) = 0.0_wp    
+      zfwflx (:,:) = 0.0_wp
+
+      ! compute ice shelf melting
+      nit = 1 ; lit = .TRUE.
+      DO WHILE ( lit )    ! maybe just a constant number of iteration as in blk_core is fine
+         SELECT CASE ( nn_isfblk )
+         CASE ( 1 )   !  ISOMIP formulation (2 equations) for volume flux (Hunter et al., 2006)
+            ! Calculate freezing temperature
+            CALL eos_fzp( stbl(:,:), zfrz(:,:), risfdep(:,:) )
+
+            ! compute gammat every where (2d)
+            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx)
+            
+            ! compute upward heat flux zhtflx and upward water flux zwflx
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zhtflx(ji,jj) =   zgammat(ji,jj)*rcp*rau0*(ttbl(ji,jj)-zfrz(ji,jj))
+                  zfwflx(ji,jj) = - zhtflx(ji,jj)/rlfusisf
+               END DO
+            END DO
+
+            ! Compute heat flux and upward fresh water flux
+            qisf  (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+            fwfisf(:,:) =   zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+
+         CASE ( 2 )  ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015)
+            ! compute gammat every where (2d)
+            CALL sbc_isf_gammats(zgammat, zgammas, zhtflx, zfwflx)
+
+            ! compute upward heat flux zhtflx and upward water flux zwflx
+            ! Resolution of a 2d equation from equation 21, 22 and 23 to find Sb (Asay-Davis et al., 2015)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! compute coeficient to solve the 2nd order equation
+                  zeps1 = rcp*rau0*zgammat(ji,jj)
+                  zeps2 = rlfusisf*rau0*zgammas(ji,jj)
+                  zeps3 = rhoisf*rcpi*rkappa/MAX(risfdep(ji,jj),zeps)
+                  zeps4 = zlamb2+zlamb3*risfdep(ji,jj)
+                  zeps6 = zeps4-ttbl(ji,jj)
+                  zeps7 = zeps4-tsurf
+                  zaqe  = zlamb1 * (zeps1 + zeps3)
+                  zaqer = 0.5_wp/MIN(zaqe,-zeps)
+                  zbqe  = zeps1*zeps6+zeps3*zeps7-zeps2
+                  zcqe  = zeps2*stbl(ji,jj)
+                  zdis  = zbqe*zbqe-4.0_wp*zaqe*zcqe               
+
+                  ! Presumably zdis can never be negative because gammas is very small compared to gammat
+                  ! compute s freeze
+                  zsfrz=(-zbqe-SQRT(zdis))*zaqer
+                  IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer
+
+                  ! compute t freeze (eq. 22)
+                  zfrz(ji,jj)=zeps4+zlamb1*zsfrz
+  
+                  ! zfwflx is upward water flux
+                  ! zhtflx is upward heat flux (out of ocean)
+                  ! compute the upward water and heat flux (eq. 28 and eq. 29)
+                  zfwflx(ji,jj) = rau0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps)
+                  zhtflx(ji,jj) = zgammat(ji,jj) * rau0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) ) 
+               END DO
+            END DO
+
+            ! compute heat and water flux
+            qisf  (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+            fwfisf(:,:) =   zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)
+
+         END SELECT
+
+         ! define if we need to iterate (nn_gammablk 0/1 do not need iteration)
+         IF ( nn_gammablk <  2 ) THEN ; lit = .FALSE.
+         ELSE                           
+            ! check total number of iteration
+            IF (nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' )
+            ELSE                 ; nit = nit + 1
+            END IF
+
+            ! compute error between 2 iterations
+            ! if needed save gammat and compute zhtflx_b for next iteration
+            zerr = MAXVAL(ABS(zhtflx-zhtflx_b))
+            IF ( zerr <= 0.01_wp ) THEN ; lit = .FALSE.
+            ELSE                        ; zhtflx_b(:,:) = zhtflx(:,:)
+            END IF
+         END IF
+      END DO
+      !
+      CALL iom_put('isfgammat', zgammat)
+      CALL iom_put('isfgammas', zgammas)
+      ! 
+      CALL wrk_dealloc( jpi,jpj, zfrz  , zgammat, zgammas  )
+      CALL wrk_dealloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_isf_cav')
+      !
+   END SUBROUTINE sbc_isf_cav
+
+
+   SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf )
+      !!----------------------------------------------------------------------
+      !! ** Purpose    : compute the coefficient echange for heat flux
+      !!
+      !! ** Method     : gamma assume constant or depends of u* and stability
+      !!
+      !! ** References : Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
+      !!                Jenkins et al., 2010, JPO, p2298-2312
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) :: pgt, pgs
+      REAL(wp), DIMENSION(:,:), INTENT(in ) :: pqhisf, pqwisf
+      !
+      INTEGER  :: ikt                        
+      INTEGER  :: ji, jj                     ! loop index
+      REAL(wp), DIMENSION(:,:), POINTER :: zustar           ! U, V at T point and friction velocity
+      REAL(wp) :: zdku, zdkv                 ! U, V shear 
+      REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number 
+      REAL(wp) :: zmob, zmols                ! Monin Obukov length, coriolis factor at T point
+      REAL(wp) :: zbuofdep, zhnu             ! Bouyancy length scale, sublayer tickness
+      REAL(wp) :: zhmax                      ! limitation of mol
+      REAL(wp) :: zetastar                   ! stability parameter
+      REAL(wp) :: zgmolet, zgmoles, zgturb   ! contribution of modelecular sublayer and turbulence 
+      REAL(wp) :: zcoef                      ! temporary coef
+      REAL(wp) :: zdep
+      REAL(wp) :: zeps = 1.0e-20_wp    
+      REAL(wp), PARAMETER :: zxsiN = 0.052_wp   ! dimensionless constant
+      REAL(wp), PARAMETER :: znu   = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
+      REAL(wp), DIMENSION(2) :: zts, zab
+      !!---------------------------------------------------------------------
+      CALL wrk_alloc( jpi,jpj, zustar )
+      !
+      SELECT CASE ( nn_gammablk )
+      CASE ( 0 ) ! gamma is constant (specified in namelist)
+         !! ISOMIP formulation (Hunter et al, 2006)
+         pgt(:,:) = rn_gammat0
+         pgs(:,:) = rn_gammas0
+
+      CASE ( 1 ) ! gamma is assume to be proportional to u*
+         !! Jenkins et al., 2010, JPO, p2298-2312
+         !! Adopted by Asay-Davis et al. (2015)
+
+         !! compute ustar (eq. 24)
+         zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )
+
+         !! Compute gammats
+         pgt(:,:) = zustar(:,:) * rn_gammat0
+         pgs(:,:) = zustar(:,:) * rn_gammas0
+      
+      CASE ( 2 ) ! gamma depends of stability of boundary layer
+         !! Holland and Jenkins, 1999, JPO, p1787-1800, eq 14
+         !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO)
+         !! compute ustar
+         zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )
+
+         !! compute Pr and Sc number (can be improved)
+         zPr =   13.8_wp
+         zSc = 2432.0_wp
+
+         !! compute gamma mole
+         zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
+         zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
+
+         !! compute gamma
+         DO ji=2,jpi
+            DO jj=2,jpj
+               ikt = mikt(ji,jj)
+
+               IF (zustar(ji,jj) == 0._wp) THEN           ! only for kt = 1 I think
+                  pgt = rn_gammat0
+                  pgs = rn_gammas0
+               ELSE
+                  !! compute Rc number (as done in zdfric.F90)
+                  zcoef = 0.5_wp / e3w_n(ji,jj,ikt)
+                  !                                            ! shear of horizontal velocity
+                  zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )  &
+                     &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  )
+                  zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )  &
+                     &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  )
+                  !                                            ! richardson number (minimum value set to zero)
+                  zRc = rn2(ji,jj,ikt+1) / MAX( zdku*zdku + zdkv*zdkv, zeps )
+
+                  !! compute bouyancy 
+                  zts(jp_tem) = ttbl(ji,jj)
+                  zts(jp_sal) = stbl(ji,jj)
+                  zdep        = gdepw_n(ji,jj,ikt)
+                  !
+                  CALL eos_rab( zts, zdep, zab )
+                  !
+                  !! compute length scale 
+                  zbuofdep = grav * ( zab(jp_tem) * pqhisf(ji,jj) - zab(jp_sal) * pqwisf(ji,jj) )  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+                  !! compute Monin Obukov Length
+                  ! Maximum boundary layer depth
+                  zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001_wp
+                  ! Compute Monin obukhov length scale at the surface and Ekman depth:
+                  zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
+                  zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
+
+                  !! compute eta* (stability parameter)
+                  zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
+
+                  !! compute the sublayer thickness
+                  zhnu = 5 * znu / zustar(ji,jj)
+
+                  !! compute gamma turb
+                  zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
+                  &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
+
+                  !! compute gammats
+                  pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
+                  pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
+               END IF
+            END DO
+         END DO
+         CALL lbc_lnk(pgt(:,:),'T',1.)
+         CALL lbc_lnk(pgs(:,:),'T',1.)
+      END SELECT
+      CALL wrk_dealloc( jpi,jpj, zustar )
+      !
+   END SUBROUTINE sbc_isf_gammats
+
+   SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE sbc_isf_tbl  ***
+      !!
+      !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT( in  ) :: pvarin
+      REAL(wp), DIMENSION(:,:)  , INTENT( out ) :: pvarout
+      CHARACTER(len=1),           INTENT( in  ) :: cd_ptin ! point of variable in/out
+      !
+      REAL(wp) :: ze3, zhk
+      REAL(wp), DIMENSION(:,:), POINTER :: zhisf_tbl ! thickness of the tbl
+
+      INTEGER :: ji, jj, jk                  ! loop index
+      INTEGER :: ikt, ikb                    ! top and bottom index of the tbl
+      !!----------------------------------------------------------------------
+      ! allocation
+      CALL wrk_alloc( jpi,jpj, zhisf_tbl)
+      
+      ! initialisation
+      pvarout(:,:)=0._wp
+   
+      SELECT CASE ( cd_ptin )
+      CASE ( 'U' ) ! compute U in the top boundary layer at T- point 
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = miku(ji,jj) ; ikb = miku(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3u_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               DO jk = ikt+1, mbku(ji,jj)
+                  IF ( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  ze3 = e3u_n(ji,jj,jk)
+                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
+               END DO
+
+               ! level partially include in ice shelf boundary layer 
+               zhk = SUM( e3u_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj)
+               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
+            END DO
+         END DO
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj))
+            END DO
+         END DO
+         CALL lbc_lnk(pvarout,'T',-1.)
+      
+      CASE ( 'V' ) ! compute V in the top boundary layer at T- point 
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = mikv(ji,jj) ; ikb = mikv(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3v_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               DO jk = ikt+1, mbkv(ji,jj)
+                  IF ( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  ze3 = e3v_n(ji,jj,jk)
+                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3
+               END DO
+
+               ! level partially include in ice shelf boundary layer 
+               zhk = SUM( e3v_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj)
+               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
+            END DO
+         END DO
+         DO jj = 2,jpj
+            DO ji = 2,jpi
+               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1))
+            END DO
+         END DO
+         CALL lbc_lnk(pvarout,'T',-1.)
+
+      CASE ( 'T' ) ! compute T in the top boundary layer at T- point 
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkb(ji,jj)
+
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  ze3 = e3t_n(ji,jj,jk)
+                  pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3
+               END DO
+
+               ! level partially include in ice shelf boundary layer 
+               zhk = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)
+               pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * (1._wp - zhk)
+            END DO
+         END DO
+      END SELECT
+
+      ! mask mean tbl value
+      pvarout(:,:) = pvarout(:,:) * ssmask(:,:)
+
+      ! deallocation
+      CALL wrk_dealloc( jpi,jpj, zhisf_tbl )      
+      !
+   END SUBROUTINE sbc_isf_tbl
+      
+
+   SUBROUTINE sbc_isf_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE sbc_isf_div  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the runoff inflow
+      !!
+      !! ** Method  :   
+      !!                CAUTION : risf_tsc(:,:,jp_sal) is negative (outflow) increase the 
+      !!                          divergence and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   decreased by the runoff inflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdivn   ! horizontal divergence
+      ! 
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikt, ikb 
+      REAL(wp) ::   zhk
+      REAL(wp) ::   zfact     ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zfact   = 0.5_wp
+      !
+      IF(.NOT.ln_linssh ) THEN     ! need to re compute level distribution of isf fresh water
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkt(ji,jj)
+               ! thickness of boundary layer at least the top level thickness
+               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), e3t_n(ji,jj,ikt))
+
+               ! determine the deepest level influenced by the boundary layer
+               DO jk = ikt, mbkt(ji,jj)
+                  IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk
+               END DO
+               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness.
+               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl
+               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj)
+
+               zhk           = SUM( e3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1
+               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / e3t_n(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer
+            END DO
+         END DO
+      END IF 
+      !
+      !==   ice shelf melting distributed over several levels   ==!
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+               ikt = misfkt(ji,jj)
+               ikb = misfkb(ji,jj)
+               ! level fully include in the ice shelf boundary layer
+               DO jk = ikt, ikb - 1
+                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) &
+                    &              * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact
+               END DO
+               ! level partially include in ice shelf boundary layer 
+               phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) &
+                    &            + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj) 
+         END DO
+      END DO
+      !
+   END SUBROUTINE sbc_isf_div
+   !!======================================================================
+END MODULE sbcisf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 8732)
@@ -0,0 +1,543 @@
+MODULE sbcmod
+   !!======================================================================
+   !!                       ***  MODULE  sbcmod  ***
+   !! Surface module :  provide to the ocean its surface boundary condition
+   !!======================================================================
+   !! 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
+   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
+   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
+   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting
+   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_init      : read namsbc namelist
+   !!   sbc           : surface ocean momentum, heat and freshwater boundary conditions
+   !!   sbc_final     : Finalize CICE ice model (if used)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE sbc_oce        ! Surface boundary condition: ocean fields
+   USE trc_oce        ! shared ocean-passive tracers variables
+   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE sbcdcy         ! surface boundary condition: diurnal cycle
+   USE sbcssm         ! surface boundary condition: sea-surface mean variables
+   USE sbcflx         ! surface boundary condition: flux formulation
+   USE sbcblk         ! surface boundary condition: bulk formulation
+   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model
+   USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model
+   USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model
+   USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model
+   USE sbcisf         ! surface boundary condition: ice-shelf
+   USE sbccpl         ! surface boundary condition: coupled formulation
+   USE cpl_oasis3     ! OASIS routines for coupling
+   USE sbcssr         ! surface boundary condition: sea surface restoring
+   USE sbcrnf         ! surface boundary condition: runoffs
+   USE sbcisf         ! surface boundary condition: ice shelf
+   USE sbcfwb         ! surface boundary condition: freshwater budget
+   USE icbstp         ! Icebergs
+   USE traqsr         ! active tracers: light penetration
+   USE sbcwave        ! Wave module
+   USE bdy_oce   , ONLY: ln_bdy
+   USE usrdef_sbc     ! user defined: surface boundary condition
+   USE usrdef_closea  ! user defined: closed sea
+   !
+   USE prtctl         ! Print control                    (prt_ctl routine)
+   USE iom            ! IOM library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+
+   USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc        ! routine called by step.F90
+   PUBLIC   sbc_init   ! routine called by opa.F90
+
+   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO-consortium (2016) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_init
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_init ***
+      !!
+      !! ** Purpose :   Initialisation of the ocean surface boundary computation
+      !!
+      !! ** Method  :   Read the namsbc namelist and set derived parameters
+      !!                Call init routines for all other SBC modules that have one
+      !!
+      !! ** Action  : - read namsbc parameters
+      !!              - nsbc: type of sbc
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios, icpt                         ! local integer
+      LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical
+      !!
+      NAMELIST/namsbc/ nn_fsbc  ,                                                    &
+         &             ln_usr   , ln_flx   , ln_blk       ,                          &
+         &             ln_cpl   , ln_mixcpl, nn_components, nn_limflx,               &
+         &             nn_ice   , nn_ice_embd,                                       &
+         &             ln_traqsr, ln_dm2dc ,                                         &
+         &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     &
+         &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauoc  , ln_stcor   ,     &
+         &             nn_lsm
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_init : surface boundary condition setting'
+         WRITE(numout,*) '~~~~~~~~ '
+      ENDIF
+      !
+      !                       !**  read Surface Module namelist
+      REWIND( numnam_ref )          !* Namelist namsbc in reference namelist : Surface boundary
+      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )          !* Namelist namsbc in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namsbc )
+      !
+      !                             !* overwrite namelist parameter using CPP key information
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid)
+         IF( lk_lim2 )   nn_ice      = 2
+         IF( lk_lim3 )   nn_ice      = 3
+         IF( lk_cice )   nn_ice      = 4
+      ENDIF
+#else
+      IF( lk_lim2 )   nn_ice      = 2
+      IF( lk_lim3 )   nn_ice      = 3
+      IF( lk_cice )   nn_ice      = 4
+#endif
+      !
+      IF(lwp) THEN                  !* Control print
+         WRITE(numout,*) '   Namelist namsbc (partly overwritten with CPP key setting)'
+         WRITE(numout,*) '      frequency update of sbc (and ice)             nn_fsbc       = ', nn_fsbc
+         WRITE(numout,*) '      Type of air-sea fluxes : '
+         WRITE(numout,*) '         user defined formulation                   ln_usr        = ', ln_usr
+         WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx
+         WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk
+         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : '
+         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl
+         WRITE(numout,*) '         mixed forced-coupled     formulation       ln_mixcpl     = ', ln_mixcpl
+!!gm  lk_oasis is controlled by key_oasis3  ===>>>  It shoud be removed from the namelist 
+         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis
+         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components
+         WRITE(numout,*) '         Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx
+         WRITE(numout,*) '      Sea-ice : '
+         WRITE(numout,*) '         ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice
+         WRITE(numout,*) '         ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd
+         WRITE(numout,*) '      Misc. options of sbc : '
+         WRITE(numout,*) '         Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr
+         WRITE(numout,*) '            daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc
+         WRITE(numout,*) '         Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr
+         WRITE(numout,*) '         FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb
+         WRITE(numout,*) '         Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn
+         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf
+         WRITE(numout,*) '         iceshelf formulation                       ln_isf        = ', ln_isf
+         WRITE(numout,*) '         closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea
+         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm
+         WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave
+         WRITE(numout,*) '               Stokes drift corr. to vert. velocity ln_sdw        = ', ln_sdw
+         WRITE(numout,*) '               wave modified ocean stress           ln_tauoc      = ', ln_tauoc
+         WRITE(numout,*) '               Stokes coriolis term                 ln_stcor      = ', ln_stcor
+         WRITE(numout,*) '               neutral drag coefficient (CORE, MFS) ln_cdgw       = ', ln_cdgw
+      ENDIF
+      !
+      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case)
+         IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+         IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
+         IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
+      ENDIF
+      !                       !**  check option consistency
+      !
+      IF(lwp) WRITE(numout,*)       !* Single / Multi - executable (NEMO / OPA+SAS) 
+      SELECT CASE( nn_components )
+      CASE( jp_iam_nemo )
+         IF(lwp) WRITE(numout,*) '   NEMO configured as a single executable (i.e. including both OPA and Surface module'
+      CASE( jp_iam_opa  )
+         IF(lwp) WRITE(numout,*) '   Multi executable configuration. Here, OPA component'
+         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
+         IF( ln_cpl        )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA'   )
+         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
+      CASE( jp_iam_sas  )
+         IF(lwp) WRITE(numout,*) '   Multi executable configuration. Here, SAS component'
+         IF( .NOT.lk_oasis )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
+         IF( ln_mixcpl     )   CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
+      CASE DEFAULT
+         CALL ctl_stop( 'sbc_init : unsupported value for nn_components' )
+      END SELECT
+      !                             !* coupled options
+      IF( ln_cpl ) THEN
+         IF( .NOT. lk_oasis )   CALL ctl_stop( 'sbc_init : coupled mode with an atmosphere model (ln_cpl=T)',   &
+            &                                  '           required to defined key_oasis3' )
+      ENDIF
+      IF( ln_mixcpl ) THEN
+         IF( .NOT. lk_oasis )   CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) ',   &
+            &                                  '           required to defined key_oasis3' )
+         IF( .NOT.ln_cpl    )   CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) requires ln_cpl = T' )
+         IF( nn_components /= jp_iam_nemo )    &
+            &                   CALL ctl_stop( 'sbc_init : the mixed forced-coupled mode (ln_mixcpl=T) ',   &
+            &                                   '          not yet working with sas-opa coupling via oasis' )
+      ENDIF
+      !                             !* sea-ice
+      SELECT CASE( nn_ice )
+      CASE( 0 )                        !- no ice in the domain
+      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)  
+      CASE( 2 )                        !- LIM2 ice model
+         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : LIM2 sea-ice model requires ln_blk or ln_cpl = T' )
+      CASE( 3 )                        !- LIM3 ice model
+         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : LIM3 sea-ice models require nn_ice_embd = 1 or 2' )
+      CASE( 4 )                        !- CICE ice model
+         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
+         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : CICE sea-ice models require nn_ice_embd = 1 or 2' )
+         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 
+      CASE DEFAULT                     !- not supported
+      END SELECT
+      !
+      IF( nn_ice == 3 ) THEN           !- LIM3 case: multi-category flux option
+         IF(lwp) WRITE(numout,*)
+         SELECT CASE( nn_limflx )         ! LIM3 Multi-category heat flux formulation
+         CASE ( -1 )
+            IF(lwp) WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) '
+            IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
+         CASE ( 0  )
+            IF(lwp) WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) '
+         CASE ( 1  )
+            IF(lwp) WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) '
+            IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
+         CASE ( 2  )
+            IF(lwp) WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) '
+            IF( .NOT.ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in forced mode cannot be 2' )
+         CASE DEFAULT
+            CALL ctl_stop( 'sbcmod: LIM3 option, nn_limflx, should be between -1 and 2' )
+         END SELECT
+      ELSE                             ! other sea-ice model
+         IF( nn_limflx >= 0  )   CALL ctl_warn( 'sbc_init : multi-category flux option (nn_limflx) only available in LIM3' )
+      ENDIF
+      !
+      !                       !**  allocate and set required variables
+      !
+      !                             !* allocate sbc arrays
+      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' )
+      !
+      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero
+         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
+         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp
+         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp
+      END IF
+      IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero
+         IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case
+      ENDIF
+      !
+      sfx   (:,:) = 0._wp           !* salt flux due to freezing/melting
+      fmmflx(:,:) = 0._wp           !* freezing minus melting flux
+
+      taum(:,:) = 0._wp             !* wind stress module (needed in GLS in case of reduced restart)
+
+      !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      IF( ln_dm2dc ) THEN           !* daily mean to diurnal cycle
+         nday_qsr = -1   ! allow initialization at the 1st call
+         IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   &
+            &   CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' )
+      ENDIF
+      !                             !* Choice of the Surface Boudary Condition
+      !                             (set nsbc)
+      !
+      ll_purecpl  = ln_cpl .AND. .NOT.ln_mixcpl
+      ll_opa      = nn_components == jp_iam_opa
+      ll_not_nemo = nn_components /= jp_iam_nemo
+      icpt = 0
+      !
+      IF( ln_usr          ) THEN   ;   nsbc = jp_usr     ; icpt = icpt + 1   ;   ENDIF       ! user defined         formulation
+      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
+      IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation
+      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
+      IF( ll_opa          ) THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
+      !
+      IF( icpt /= 1 )    CALL ctl_stop( 'sbc_init : choose ONE and only ONE sbc option' )
+      !
+      IF(lwp) THEN                     !- print the choice of surface flux formulation
+         WRITE(numout,*)
+         SELECT CASE( nsbc )
+         CASE( jp_usr     )   ;   WRITE(numout,*) '   user defined formulation'
+         CASE( jp_flx     )   ;   WRITE(numout,*) '      ===>>   flux formulation'
+         CASE( jp_blk     )   ;   WRITE(numout,*) '      ===>>   bulk formulation'
+         CASE( jp_purecpl )   ;   WRITE(numout,*) '      ===>>   pure coupled formulation'
+!!gm abusive use of jp_none ??   ===>>> need to be check and changed by adding a jp_sas parameter
+         CASE( jp_none    )   ;   WRITE(numout,*) '      ===>>   OPA coupled to SAS via oasis'
+            IF( ln_mixcpl )       WRITE(numout,*) '                  + forced-coupled mixed formulation'
+         END SELECT
+         IF( ll_not_nemo  )       WRITE(numout,*) '                  + OASIS coupled SAS'
+      ENDIF
+      !
+      !                             !* OASIS initialization
+      !
+      IF( lk_oasis )   CALL sbc_cpl_init( nn_ice )   ! Must be done before: (1) first time step
+      !                                              !                      (2) the use of nn_fsbc
+      !     nn_fsbc initialization if OPA-SAS coupling via OASIS
+      !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
+      IF( nn_components /= jp_iam_nemo ) THEN
+         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
+         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
+         !
+         IF(lwp)THEN
+            WRITE(numout,*)
+            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !
+      !                             !* check consistency between model timeline and nn_fsbc
+      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
+          MOD( nstock             , nn_fsbc) /= 0 ) THEN
+         WRITE(ctmp1,*) 'sbc_init : experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
+            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
+         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
+      ENDIF
+      !
+      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
+         &  CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' )
+      !
+      IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rdt) ) < 8  )   &
+         &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+      !
+   
+      !                       !**  associated modules : initialization
+      !
+                          CALL sbc_ssm_init            ! Sea-surface mean fields initialization
+      !
+      IF( ln_blk      )   CALL sbc_blk_init            ! bulk formulae initialization
+
+      IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization
+      !
+      IF( ln_isf      )   CALL sbc_isf_init               ! Compute iceshelves
+      !
+                          CALL sbc_rnf_init            ! Runof initialization
+      !
+      IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization
+      !
+      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )   ! CICE initialization
+      !
+      IF( ln_wave     )   CALL sbc_wave_init              ! surface wave initialisation
+      !
+   END SUBROUTINE sbc_init
+
+
+   SUBROUTINE sbc( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc  ***
+      !!
+      !! ** Purpose :   provide at each time-step the ocean surface boundary
+      !!                condition (momentum, heat and freshwater fluxes)
+      !!
+      !! ** Method  :   blah blah  to be written ?????????
+      !!                CAUTION : never mask the surface stress field (tke sbc)
+      !!
+      !! ** 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, sfx_b, qrp_b, erp_b
+      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp
+      !!              - updte the ice fraction : fr_i
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !
+      LOGICAL ::   ll_sas, ll_opa   ! local logical
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc')
+      !
+      !                                            ! ---------------------------------------- !
+      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)
+         emp_b (:,:) = emp (:,:)
+         sfx_b (:,:) = sfx (:,:)
+         IF ( ln_rnf ) THEN
+            rnf_b    (:,:  ) = rnf    (:,:  )
+            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
+         ENDIF
+         IF( ln_isf )  THEN
+            fwfisf_b  (:,:  ) = fwfisf  (:,:  )               
+            risf_tsc_b(:,:,:) = risf_tsc(:,:,:)              
+         ENDIF
+        !
+      ENDIF
+      !                                            ! ---------------------------------------- !
+      !                                            !        forcing field computation         !
+      !                                            ! ---------------------------------------- !
+      !
+      ll_sas = nn_components == jp_iam_sas               ! component flags
+      ll_opa = nn_components == jp_iam_opa
+      !
+      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt )            ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      IF( ln_wave     )   CALL sbc_wave( kt )            ! surface waves
+
+      !
+      !                                            !==  sbc formulation  ==!
+      !                                                   
+      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
+      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
+      CASE( jp_usr   )     ;   CALL usrdef_sbc_oce( kt )                    ! user defined formulation 
+      CASE( jp_flx     )   ;   CALL sbc_flx       ( kt )                    ! flux formulation
+      CASE( jp_blk     )
+         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA
+                               CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean
+                               !
+      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation
+      CASE( jp_none    )
+         IF( ll_opa    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
+      END SELECT
+      IF ( ln_wave .AND. ln_tauoc) THEN                                 ! Wave stress subctracted
+            utau(:,:) = utau(:,:)*tauoc_wave(:,:)
+            vtau(:,:) = vtau(:,:)*tauoc_wave(:,:)
+            taum(:,:) = taum(:,:)*tauoc_wave(:,:)
+      !
+            SELECT CASE( nsbc )
+            CASE(  0,1,2,3,5,-1 )  ;
+                IF(lwp .AND. kt == nit000 ) WRITE(numout,*) 'WARNING: You are subtracting the wave stress to the ocean. &
+                        & If not requested select ln_tauoc=.false'
+            END SELECT
+      !
+      END IF
+      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
+
+      !
+      !                                            !==  Misc. Options  ==!
+      !
+      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
+      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model)
+      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model
+      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model
+      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model
+      END SELECT
+
+      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs
+
+      IF( ln_isf         )   CALL sbc_isf( kt )                   ! compute iceshelves
+
+      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
+
+      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term
+
+      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
+
+      ! treatment of closed sea in the model domain   (update freshwater fluxes)
+      ! Should not be ran if ln_diurnal_only
+      IF( .NOT.ln_diurnal_only .AND. nn_closea == 1 )   CALL sbc_clo( kt, cn_cfg, nn_cfg )   
+
+!RBbug do not understand why see ticket 667
+!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
+      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)
+            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6
+            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point)
+            ELSE
+               sfx_b (:,:) = sfx(:,:)
+            ENDIF
+         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 (:,:)
+            emp_b (:,:) = emp (:,:)
+            sfx_b (:,:) = sfx (:,:)
+         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, 'sfx_b'  , sfx  )
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      !                                                !        Outputs and control print         !
+      !                                                ! ---------------------------------------- !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
+         CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux
+         CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
+         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case)
+         CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux
+         CALL iom_put( "qt"    , 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 .OR. ll_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction
+         CALL iom_put( "taum"  , taum       )                   ! wind stress module
+         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice
+      ENDIF
+      !
+      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at each time step in sea-ice)
+      CALL iom_put( "vtau", vtau )   ! j-wind stress
+      !
+      IF(ln_ctl) THEN         ! print mean trends (used for debugging)
+         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=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=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   )
+         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), 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
+
+      IF( kt == nitend )   CALL sbc_final         ! Close down surface module if necessary
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc')
+      !
+   END SUBROUTINE sbc
+
+
+   SUBROUTINE sbc_final
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_final  ***
+      !!
+      !! ** Purpose :   Finalize CICE (if used)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_ice == 4 )   CALL cice_sbc_final
+      !
+   END SUBROUTINE sbc_final
+
+   !!======================================================================
+END MODULE sbcmod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 8732)
@@ -0,0 +1,527 @@
+MODULE sbcrnf
+   !!======================================================================
+   !!                       ***  MODULE  sbcrnf  ***
+   !! 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
+   !!            3.3  ! 2010-10  (R. Furner, G. Madec) runoff distributed over ocean levels
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_rnf       : monthly runoffs read in a NetCDF file
+   !!   sbc_rnf_init  : runoffs initialisation
+   !!   rnf_mouth     : set river mouth mask
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE sbc_oce        ! surface boundary condition variables
+   USE sbcisf         ! PM we could remove it I think
+   USE eosbn2         ! Equation Of State
+   USE usrdef_closea  ! closed seas
+   !
+   USE in_out_manager ! I/O manager
+   USE fldread        ! read input field at current time step
+   USE iom            ! I/O module
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_rnf       ! called in sbcmod module
+   PUBLIC   sbc_rnf_div   ! called in divhor module
+   PUBLIC   sbc_rnf_alloc ! called in sbcmod module
+   PUBLIC   sbc_rnf_init  ! called in sbcmod module
+   
+   !                                                !!* namsbc_rnf namelist *
+   CHARACTER(len=100)         ::   cn_dir            !: Root directory for location of rnf files
+   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file
+   LOGICAL                    ::      ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation
+   REAL(wp)                   ::      rn_rnf_max        !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T)
+   REAL(wp)                   ::      rn_dep_max        !: depth over which runoffs is spread       (ln_rnf_depth_ini =T)
+   INTEGER                    ::      nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
+   LOGICAL                    ::   ln_rnf_tem        !: temperature river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_sal        !: salinity    river runoffs attribute specified in a file
+   TYPE(FLD_N)       , PUBLIC ::   sn_rnf            !: information about the runoff file to be read
+   TYPE(FLD_N)                ::   sn_cnf            !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_s_rnf          !: information about the salinities of runoff file to be read
+   TYPE(FLD_N)                ::   sn_t_rnf          !: information about the temperatures of runoff file to be read
+   TYPE(FLD_N)                ::   sn_dep_rnf        !: information about the depth which river inflow affects
+   LOGICAL           , PUBLIC ::   ln_rnf_mouth      !: specific treatment in mouths vicinity
+   REAL(wp)                   ::   rn_hrnf           !: runoffs, depth over which enhanced vertical mixing is used
+   REAL(wp)          , PUBLIC ::   rn_avt_rnf        !: runoffs, value of the additional vertical mixing coef. [m2/s]
+   REAL(wp)          , PUBLIC ::   rn_rfact          !: multiplicative factor for runoff
+
+   LOGICAL , PUBLIC ::   l_rnfcpl = .false.   !: runoffs recieved from oasis
+   INTEGER , PUBLIC ::   nkrnf = 0            !: nb of levels over which Kz is increased at river mouths
+   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m
+   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]   
+
+   TYPE(FLD),        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)  
+ 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sbc_rnf_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE sbc_rnf_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( rnfmsk(jpi,jpj)         , rnfmsk_z(jpk)          ,     &
+         &      h_rnf (jpi,jpj)         , nk_rnf  (jpi,jpj)      ,     &
+         &      rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc )
+         !
+      IF( lk_mpp            )   CALL mpp_sum ( sbc_rnf_alloc )
+      IF( sbc_rnf_alloc > 0 )   CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed')
+   END FUNCTION sbc_rnf_alloc
+
+
+   SUBROUTINE sbc_rnf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf  ***
+      !!
+      !! ** Purpose :   Introduce a climatological run off forcing
+      !!
+      !! ** Method  :   Set each river mouth with a monthly climatology
+      !!                provided from different data.
+      !!                CAUTION : upward water flux, runoff forced to be < 0
+      !!
+      !! ** Action  :   runoff updated runoff field at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt          ! ocean time step
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      INTEGER  ::   z_err = 0 ! dummy integer for error handling
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), POINTER       ::   ztfrz   ! freezing point used for temperature correction
+      !
+      CALL wrk_alloc( jpi,jpj, ztfrz)
+      !
+      !                                            !-------------------!
+      !                                            !   Update runoff   !
+      !                                            !-------------------!
+      !
+      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt
+      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
+      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
+      !
+      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+         !
+         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt
+         !
+         !                                                     ! set temperature & salinity content of runoffs
+         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
+            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            CALL eos_fzp( sss_m(:,:), ztfrz(:,:) )
+            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature
+               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+            END WHERE
+            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg
+               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp
+            END WHERE
+         ELSE                                                        ! use SST as runoffs temperature
+            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+         ENDIF
+         !                                                           ! use runoffs salinity data
+         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+         !                                                           ! else use S=0 for runoffs (done one for all in the init)
+         IF( iom_use('runoffs') )        CALL iom_put( 'runoffs'     , rnf(:,:)                         )   ! output runoff mass flux
+         IF( iom_use('hflx_rnf_cea') )   CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rau0 * rcp )   ! output runoff sensible heat (W/m2)
+      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
+      !
+      CALL wrk_dealloc( jpi,jpj, ztfrz)
+      !
+   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(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zfact     ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zfact = 0.5_wp
+      !
+      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==!
+         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ELSE                    !* variable volume case
+            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
+               DO ji = 1, jpi
+                  h_rnf(ji,jj) = 0._wp
+                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(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
+         ENDIF
+      ELSE                       !==   runoff put only at the surface   ==!
+         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1)
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf_div
+
+
+   SUBROUTINE sbc_rnf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf_init  ***
+      !!
+      !! ** Purpose :   Initialisation of the runoffs if (ln_rnf=T)
+      !!
+      !! ** Method  : - read the runoff namsbc_rnf namelist
+      !!
+      !! ** Action  : - read parameters
+      !!----------------------------------------------------------------------
+      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name
+      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices
+      INTEGER           ::   ierror, inum  ! temporary integer
+      INTEGER           ::   ios           ! Local integer output status for namelist read
+      INTEGER           ::   nbrec         ! temporary integer
+      REAL(wp)          ::   zacoef  
+      REAL(wp), DIMENSION(12)                 :: zrec             ! times records
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl    
+      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf
+      !
+      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
+         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &
+         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     &
+         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file
+      !!----------------------------------------------------------------------
+      !
+      !                                         !==  allocate runoff arrays
+      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
+      !
+      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
+         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl
+         nkrnf         = 0
+         rnf     (:,:) = 0.0_wp
+         rnf_b   (:,:) = 0.0_wp
+         rnfmsk  (:,:) = 0.0_wp
+         rnfmsk_z(:)   = 0.0_wp
+         RETURN
+      ENDIF
+      !
+      !                                   ! ============
+      !                                   !   Namelist
+      !                                   ! ============
+      !
+      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs 
+      READ  ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
+      READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_rnf )
+      !
+      !                                         ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_rnf_init : runoff '
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namsbc_rnf'
+         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth
+         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf
+         WRITE(numout,*) '      depth of river mouth additional mixing     rn_hrnf      = ', rn_hrnf
+         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact
+      ENDIF
+      !                                   ! ==================
+      !                                   !   Type of runoff
+      !                                   ! ==================
+      !
+      IF( .NOT. l_rnfcpl ) THEN                    
+         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_init: 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) )
+         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print )
+      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', no_print )
+      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', no_print )
+      ENDIF
+      !
+      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
+         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
+         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year 
+            IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month 
+         ENDIF
+         CALL iom_open ( rn_dep_file, inum )                           ! open file
+         CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array
+         CALL iom_close( inum )                                        ! close file
+         !
+         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( h_rnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+                  END DO
+                  nk_rnf(ji,jj) = jk
+               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1
+               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+               ELSE
+                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )
+                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff'
+         IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max
+         IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max
+         IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file
+
+         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file
+         CALL iom_gettime( inum, zrec, kntime=nbrec)
+         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) )
+         DO jm = 1, nbrec
+            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm )
+         END DO
+         CALL iom_close( inum )
+         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time
+         DEALLOCATE( zrnfcl )
+         !
+         h_rnf(:,:) = 1.
+         !
+         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff)
+         !
+         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs
+         !
+         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin
+            DO ji = 1, jpi
+               IF( zrnf(ji,jj) > 0._wp ) THEN
+                  jk = mbkt(ji,jj)
+                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
+               ENDIF
+            END DO
+         END DO
+         !
+         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zrnf(ji,jj) > 0._wp ) THEN
+                  jk = 2
+                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1
+                  END DO
+                  nk_rnf(ji,jj) = jk
+               ELSE
+                  nk_rnf(ji,jj) = 1
+               ENDIF
+            END DO
+         END DO
+         !
+         DEALLOCATE( zrnf )
+         !
+         DO jj = 1, jpj                                ! set the associated depth
+            DO ji = 1, jpi
+               h_rnf(ji,jj) = 0._wp
+               DO jk = 1, nk_rnf(ji,jj)
+                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff
+            IF(lwp) WRITE(numout,*) '              create runoff depht file'
+            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib )
+            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf )
+            CALL iom_close ( inum )
+         ENDIF
+      ELSE                                       ! runoffs applied at the surface
+         nk_rnf(:,:) = 1
+         h_rnf (:,:) = e3t_n(:,:,1)
+      ENDIF
+      !
+      rnf(:,:) =  0._wp                         ! runoff initialisation
+      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation
+      !
+      !                                   ! ========================
+      !                                   !   River mouth vicinity
+      !                                   ! ========================
+      !
+      IF( ln_rnf_mouth ) THEN                   ! Specific treatment in vicinity of river mouths :
+         !                                      !    - Increase Kz in surface layers ( rn_hrnf > 0 )
+         !                                      !    - set to zero SSS damping (ln_ssr=T)
+         !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
+         !
+         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_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1
+            END DO
+            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf_init: number of levels over which Kz is increased is computed for zco...' )
+         ENDIF
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          Specific treatment used in vicinity of river mouths :'
+         IF(lwp) WRITE(numout,*) '             - Increase Kz in surface layers (if rn_hrnf > 0 )'
+         IF(lwp) WRITE(numout,*) '               by ', rn_avt_rnf,' m2/s  over ', nkrnf, ' w-levels'
+         IF(lwp) WRITE(numout,*) '             - set to zero SSS damping       (if ln_ssr=T)'
+         IF(lwp) WRITE(numout,*) '             - mixed upstream-centered       (if ln_traadv_cen2=T)'
+         !
+         CALL rnf_mouth                             ! set river mouth mask
+         !
+      ELSE                                      ! No treatment at river mouths
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths'
+         rnfmsk  (:,:) = 0._wp
+         rnfmsk_z(:)   = 0._wp
+         nkrnf = 0
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf_init
+
+
+   SUBROUTINE rnf_mouth
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE rnf_mouth  ***
+      !!
+      !! ** Purpose :   define the river mouths mask
+      !!
+      !! ** Method  :   read the river mouth mask (=0/1) in the river runoff
+      !!                climatological file. Defined a given vertical structure.
+      !!                CAUTION, the vertical structure is hard coded on the
+      !!                first 5 levels.
+      !!                This fields can be used to:
+      !!                 - set an upstream advection scheme
+      !!                   (ln_rnf_mouth=T and ln_traadv_cen2=T)
+      !!                 - increase vertical on the top nn_krnf vertical levels
+      !!                   at river runoff input grid point (nn_krnf>=2, see step.F90)
+      !!                 - set to zero SSS restoring flux at river mouth grid points
+      !!
+      !! ** Action  :   rnfmsk   set to 1 at river runoff input, 0 elsewhere
+      !!                rnfmsk_z vertical structure
+      !!----------------------------------------------------------------------
+      INTEGER            ::   inum        ! temporary integers
+      CHARACTER(len=140) ::   cl_rnfile   ! runoff file name
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   rnf_mouth : river mouth mask'
+      IF(lwp) WRITE(numout,*) '   ~~~~~~~~~ '
+      !
+      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname )
+      IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year
+         IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month
+      ENDIF
+      !
+      ! horizontal mask (read in NetCDF file)
+      CALL iom_open ( cl_rnfile, inum )                           ! open file
+      CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array
+      CALL iom_close( inum )                                      ! close file
+      !
+      IF( nn_closea == 1 )   CALL clo_rnf( rnfmsk )               ! closed sea inflow set as ruver mouth
+      !
+      rnfmsk_z(:)   = 0._wp                                       ! vertical structure
+      rnfmsk_z(1)   = 1.0
+      rnfmsk_z(2)   = 1.0                                         ! **********
+      rnfmsk_z(3)   = 0.5                                         ! HARD CODED on the 5 first levels
+      rnfmsk_z(4)   = 0.25                                        ! **********
+      rnfmsk_z(5)   = 0.125
+      !
+   END SUBROUTINE rnf_mouth
+
+   !!======================================================================
+END MODULE sbcrnf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 8732)
@@ -0,0 +1,256 @@
+MODULE sbcssm
+   !!======================================================================
+   !!                       ***  MODULE  sbcssm  ***
+   !! Surface module :  provide time-mean ocean surface variables
+   !!======================================================================
+   !! History :  9.0  ! 2006-07  (G. Madec)  Original code
+   !!            3.3  ! 2010-10  (C. Bricaud, G. Madec)  add the Patm forcing for sea-ice
+   !!            3.7  ! 2015-11  (G. Madec)  non linear free surface by default: e3t_m always computed
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_ssm       : calculate sea surface mean currents, temperature,  
+   !!                   and salinity over nn_fsbc time-step
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean fields
+   USE sbcapr         ! surface boundary condition: atmospheric pressure
+   USE eosbn2         ! equation of state and related derivatives
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! IOM library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_ssm        ! routine called by step.F90
+   PUBLIC   sbc_ssm_init   ! routine called by sbcmod.F90
+
+   LOGICAL, SAVE ::   l_ssm_mean = .FALSE.   ! keep track of whether means have been read from restart file
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ssm( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_oce  ***
+      !!                     
+      !! ** Purpose :   provide ocean surface variable to sea-surface boundary
+      !!                condition computation 
+      !!                
+      !! ** Method  :   compute mean surface velocity (2 components at U and 
+      !!      V-points) [m/s], temperature [Celsius] 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
+      !
+      INTEGER  ::   ji, jj               ! loop index
+      REAL(wp) ::   zcoef, zf_sbc       ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts
+      !!---------------------------------------------------------------------
+      !
+      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
+            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
+         END DO
+      END DO
+      !
+      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        !
+         !                                                ! ---------------------------------------- !
+         ssu_m(:,:) = ub(:,:,1)
+         ssv_m(:,:) = vb(:,:,1)
+         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
+         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem)
+         ENDIF
+         sss_m(:,:) = zts(:,:,jp_sal)
+         !                          ! 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
+         !
+         e3t_m(:,:) = e3t_n(:,:,1)
+         !
+         frq_m(:,:) = fraqsr_1lev(:,:)
+         !
+      ELSE
+         !                                                ! ----------------------------------------------- !
+         IF( kt == nit000 .AND. .NOT. l_ssm_mean ) THEN   !   Initialisation: 1st time-step, no input means !
+            !                                             ! ----------------------------------------------- !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'sbc_ssm : mean fields initialised to instantaneous values'
+            IF(lwp) WRITE(numout,*) '~~~~~~~   '
+            zcoef = REAL( nn_fsbc - 1, wp )
+            ssu_m(:,:) = zcoef * ub(:,:,1)
+            ssv_m(:,:) = zcoef * vb(:,:,1)
+            IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
+            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem)
+            ENDIF
+            sss_m(:,:) = zcoef * zts(:,:,jp_sal)
+            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
+            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:)
+            ENDIF
+            !
+            e3t_m(:,:) = zcoef * e3t_n(:,:,1)
+            !
+            frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
+            !                                             ! ---------------------------------------- !
+         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
+            !                                             ! ---------------------------------------- !
+            ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields
+            ssv_m(:,:) = 0._wp
+            sst_m(:,:) = 0._wp
+            sss_m(:,:) = 0._wp
+            ssh_m(:,:) = 0._wp
+            e3t_m(:,:) = 0._wp
+            frq_m(:,:) = 0._wp
+         ENDIF
+         !                                                ! ---------------------------------------- !
+         !                                                !        Cumulate at each time step        !
+         !                                                ! ---------------------------------------- !
+         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
+         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
+         IF( l_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
+         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
+         ENDIF
+         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal)
+         !                          ! 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
+         !
+         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1)
+         !
+         frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:)
+
+         !                                                ! ---------------------------------------- !
+         IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
+            !                                             ! ---------------------------------------- !
+            zcoef = 1. / REAL( nn_fsbc, wp )
+            sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celsius]
+            sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu]
+            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s]
+            ssv_m(:,:) = ssv_m(:,:) * zcoef     !
+            ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m]
+            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m]
+            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-]
+            !
+         ENDIF
+         !                                                ! ---------------------------------------- !
+         IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+            !                                             ! ---------------------------------------- !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields written in ocean restart file ',   &
+               &                    'at it= ', kt,' date= ', ndastp
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+            zf_sbc = REAL( nn_fsbc, wp )
+            CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc )    ! sbc frequency
+            CALL iom_rstput( kt, nitrst, numrow, 'ssu_m'  , ssu_m  )    ! sea surface mean fields
+            CALL iom_rstput( kt, nitrst, numrow, 'ssv_m'  , ssv_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'sst_m'  , sst_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  )
+            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  )
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !
+         CALL iom_put( 'ssu_m', ssu_m )
+         CALL iom_put( 'ssv_m', ssv_m )
+         CALL iom_put( 'sst_m', sst_m )
+         CALL iom_put( 'sss_m', sss_m )
+         CALL iom_put( 'ssh_m', ssh_m )
+         CALL iom_put( 'e3t_m', e3t_m )
+         CALL iom_put( 'frq_m', frq_m )
+      ENDIF
+      !
+   END SUBROUTINE sbc_ssm
+
+
+   SUBROUTINE sbc_ssm_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ssm_init  ***
+      !!
+      !! ** Purpose :   Initialisation of the sbc data
+      !!
+      !! ** Action  : - read parameters
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zcoef, zf_sbc   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_fsbc == 1 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc_ssm_init : sea surface mean fields, nn_fsbc=1 : instantaneous values'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+      ELSE
+         !               
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc_ssm_init : sea surface mean fields'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+         !
+         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN
+            l_ssm_mean = .TRUE.
+            CALL iom_get( numror               , 'nn_fsbc', zf_sbc )    ! sbc frequency of previous run
+            CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )    ! sea surface mean velocity    (U-point)
+            CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m  )    !   "         "    velocity    (V-point)
+            CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m  )    !   "         "    temperature (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )    !   "         "    salinity    (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )    !   "         "    height      (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'e3t_m'  , e3t_m  )    ! 1st level thickness          (T-point)
+            ! fraction of solar net radiation absorbed in 1st T level
+            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  )
+            ELSE
+               frq_m(:,:) = 1._wp   ! default definition
+            ENDIF
+            !
+            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs
+               IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc 
+               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 
+               ssu_m(:,:) = zcoef * ssu_m(:,:) 
+               ssv_m(:,:) = zcoef * ssv_m(:,:)
+               sst_m(:,:) = zcoef * sst_m(:,:)
+               sss_m(:,:) = zcoef * sss_m(:,:)
+               ssh_m(:,:) = zcoef * ssh_m(:,:)
+               e3t_m(:,:) = zcoef * e3t_m(:,:)
+               frq_m(:,:) = zcoef * frq_m(:,:)
+            ELSE
+               IF(lwp) WRITE(numout,*) '   mean fields read in the ocean restart file'
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate
+         !
+         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays'
+         ssu_m(:,:) = ub(:,:,1)
+         ssv_m(:,:) = vb(:,:,1)
+         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem)
+         ENDIF
+         sss_m(:,:) = tsn  (:,:,1,jp_sal)
+         ssh_m(:,:) = sshn (:,:)
+         e3t_m(:,:) = e3t_n(:,:,1)
+         frq_m(:,:) = 1._wp
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_ssm_init
+
+   !!======================================================================
+END MODULE sbcssm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 8732)
@@ -0,0 +1,228 @@
+MODULE sbcssr
+   !!======================================================================
+   !!                       ***  MODULE  sbcssr  ***
+   !! Surface module :  heat and fresh water fluxes a restoring term toward observed SST/SSS
+   !!======================================================================
+   !! History :  3.0  !  2006-06  (G. Madec)  Original code
+   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology
+   !!   sbc_ssr_init  : initialisation of surface restoring
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition
+   USE phycst         ! physical constants
+   USE sbcrnf         ! surface boundary condition : runoffs
+   !
+   USE fldread        ! read input fields
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_ssr        ! routine called in sbcmod
+   PUBLIC   sbc_ssr_init   ! routine called in sbcmod
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2]
+
+   !                                   !!* Namelist namsbc_ssr *
+   INTEGER, PUBLIC ::   nn_sstr         ! SST/SSS restoring indicator
+   INTEGER, PUBLIC ::   nn_sssr         ! SST/SSS restoring indicator
+   REAL(wp)        ::   rn_dqdt         ! restoring factor on SST and SSS
+   REAL(wp)        ::   rn_deds         ! restoring factor on SST and SSS
+   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term 
+   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day]
+
+   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ssr( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_ssr  ***
+      !!
+      !! ** Purpose :   Add to heat and/or freshwater fluxes a damping term
+      !!                toward observed SST and/or SSS.
+      !!
+      !! ** Method  : - Read namelist namsbc_ssr
+      !!              - Read observed SST and/or SSS
+      !!              - at each nscb time step
+      !!                   add a retroaction term on qns    (nn_sstr = 1)
+      !!                   add a damping term on sfx        (nn_sssr = 1)
+      !!                   add a damping term on emp        (nn_sssr = 2)
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zerp     ! local scalar for evaporation damping
+      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
+      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
+      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
+      INTEGER  ::   ierror   ! return error code
+      !!
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_ssr')
+      !
+      IF( nn_sstr + nn_sssr /= 0 ) THEN
+         !
+         IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it at kt
+         IF( nn_sssr >= 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it at kt
+         !
+         !                                         ! ========================= !
+         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     !
+            !                                      ! ========================= !
+            !
+            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     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
+                  END DO
+               END DO
+               CALL iom_put( "qrp", qrp )                             ! heat flux damping
+            ENDIF
+            !
+            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx))
+               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+               DO jj = 1, jpj
+                  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,1) ) 
+                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux
+                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
+                  END DO
+               END DO
+               CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               !
+            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
+               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+               zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
+               DO jj = 1, jpj
+                  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,1) )   &
+                        &        / MAX(  sss_m(ji,jj), 1.e-20   )
+                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
+                     emp(ji,jj) = emp (ji,jj) + zerp
+                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
+                     erp(ji,jj) = zerp
+                  END DO
+               END DO
+               CALL iom_put( "erp", erp )                             ! freshwater flux damping
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_ssr')
+      !
+   END SUBROUTINE sbc_ssr
+
+ 
+   SUBROUTINE sbc_ssr_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ssr_init  ***
+      !!
+      !! ** Purpose :   initialisation of surface damping term
+      !!
+      !! ** Method  : - Read namelist namsbc_ssr
+      !!              - Read observed SST and/or SSS if required
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zerp     ! local scalar for evaporation damping
+      REAL(wp) ::   zqrp     ! local scalar for heat flux damping
+      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor
+      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor
+      INTEGER  ::   ierror   ! return error code
+      !!
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read
+      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
+      INTEGER     ::  ios
+      !!----------------------------------------------------------------------
+      !
+ 
+      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist : 
+      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist :
+      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_ssr )
+
+      IF(lwp) THEN                 !* control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namsbc_ssr :'
+         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr
+         WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr
+         WRITE(numout,*) '                       (Yes=2, volume flux) '
+         WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K'
+         WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day'
+         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd
+         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'
+      ENDIF
+      !
+      !                            !* Allocate erp and qrp array
+      ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )
+      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )
+      !
+      IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays
+         !
+         ALLOCATE( sf_sst(1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' )
+         ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' )
+         !
+         ! 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', no_print )
+         IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' )
+         !
+      ENDIF
+      !
+      IF( nn_sssr >= 1 ) THEN      !* set sf_sss structure & allocate arrays
+         !
+         ALLOCATE( sf_sss(1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' )
+         ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' )
+         !
+         ! 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', no_print )
+         IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' )
+         !
+      ENDIF
+      !
+      !                            !* Initialize qrp and erp if no restoring 
+      IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp
+      IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp
+      !
+   END SUBROUTINE sbc_ssr_init
+      
+   !!======================================================================
+END MODULE sbcssr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 8732)
@@ -0,0 +1,126 @@
+MODULE sbctide
+   !!======================================================================
+   !!                       ***  MODULE  sbctide  ***
+   !! Initialization of tidal forcing
+   !!======================================================================
+   !! History :  9.0  !  2007  (O. Le Galloudec)  Original code
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE daymod         ! calandar
+   USE tideini        ! 
+   !
+   USE in_out_manager ! I/O units
+   USE iom            ! xIOs server
+   USE ioipsl         ! NetCDF IPSL library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PUBLIC
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   pot_astro   !
+
+   !!----------------------------------------------------------------------
+   !!   tidal potential
+   !!----------------------------------------------------------------------
+   !!   sbc_tide            : 
+   !!   tide_init_potential :
+   !!----------------------------------------------------------------------
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   amp_pot, phi_pot
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_tide( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE sbc_tide  ***
+      !!----------------------------------------------------------------------      
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
+      INTEGER               ::   jk     ! dummy loop index
+      INTEGER               ::   nsec_day_orig     ! Temporary variable
+      !!----------------------------------------------------------------------
+      
+      IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day
+         !
+         IF( kt == nit000 ) THEN
+            ALLOCATE( amp_pot(jpi,jpj,nb_harmo),                      &
+               &      phi_pot(jpi,jpj,nb_harmo), pot_astro(jpi,jpj)   )
+         ENDIF
+         !
+         amp_pot(:,:,:) = 0._wp
+         phi_pot(:,:,:) = 0._wp
+         pot_astro(:,:) = 0._wp
+         !
+         ! If the run does not start from midnight then need to initialise tides
+         ! at the start of the current day (only occurs when kt==nit000)
+         ! Temporarily set nsec_day to beginning of day.
+         nsec_day_orig = nsec_day
+         IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN 
+            kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt
+            nsec_day = NINT(0.5_wp * rdt)
+         ELSE
+            kt_tide = kt 
+         ENDIF
+         CALL tide_harmo( omega_tide, v0tide, utide, ftide, ntide, nb_harmo )
+         !
+         !
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sbc_tide : Update of the components and (re)Init. the potential at kt=', kt
+            WRITE(numout,*) '~~~~~~~~ '
+            DO jk = 1, nb_harmo
+               WRITE(numout,*) Wave(ntide(jk))%cname_tide, utide(jk), ftide(jk), v0tide(jk), omega_tide(jk)
+            END DO
+         ENDIF
+         !
+         IF( ln_tide_pot )   CALL tide_init_potential
+         !
+         ! Reset nsec_day
+         nsec_day = nsec_day_orig 
+      ENDIF
+      !
+   END SUBROUTINE sbc_tide
+
+
+   SUBROUTINE tide_init_potential
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init_potential  ***
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcons, ztmp1, ztmp2, zlat, zlon, ztmp, zamp, zcs   ! local scalar
+      !!----------------------------------------------------------------------
+
+      DO jk = 1, nb_harmo
+         zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk)
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+               ztmp1 =  amp_pot(ji,jj,jk) * COS( phi_pot(ji,jj,jk) )
+               ztmp2 = -amp_pot(ji,jj,jk) * SIN( phi_pot(ji,jj,jk) )
+               zlat = gphit(ji,jj)*rad !! latitude en radian
+               zlon = glamt(ji,jj)*rad !! longitude en radian
+               ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon
+               ! le potentiel est composé des effets des astres:
+               IF    ( Wave(ntide(jk))%nutide == 1 )  THEN  ;  zcs = zcons * SIN( 2._wp*zlat )
+               ELSEIF( Wave(ntide(jk))%nutide == 2 )  THEN  ;  zcs = zcons * COS( zlat )**2
+               ELSE                                         ;  zcs = 0._wp
+               ENDIF
+               ztmp1 = ztmp1 + zcs * COS( ztmp )
+               ztmp2 = ztmp2 - zcs * SIN( ztmp )
+               zamp = SQRT( ztmp1*ztmp1 + ztmp2*ztmp2 )
+               amp_pot(ji,jj,jk) = zamp
+               phi_pot(ji,jj,jk) = ATAN2( -ztmp2 / MAX( 1.e-10_wp , zamp ) ,   &
+                  &                        ztmp1 / MAX( 1.e-10_wp,  zamp )   )
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE tide_init_potential
+
+  !!======================================================================
+END MODULE sbctide
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 8732)
@@ -0,0 +1,361 @@
+MODULE sbcwave
+   !!======================================================================
+   !!                       ***  MODULE  sbcwave  ***
+   !! Wave module 
+   !!======================================================================
+   !! History :  3.3  !  2011-09  (M. Adani)  Original code: Drag Coefficient 
+   !!         :  3.4  !  2012-10  (M. Adani)  Stokes Drift 
+   !!            3.6  !  2014-09  (E. Clementi,P. Oddo) New Stokes Drift Computation
+   !!             -   !  2016-12  (G. Madec, E. Clementi) update Stoke drift computation
+   !!                                                    + add sbc_wave_ini routine
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_stokes    : calculate 3D Stokes-drift velocities
+   !!   sbc_wave      : wave data from wave model in netcdf files 
+   !!   sbc_wave_init : initialisation fo surface waves 
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants 
+   USE oce            ! ocean variables
+   USE sbc_oce	       ! Surface boundary condition: ocean fields
+   USE zdf_oce,  ONLY : ln_zdfqiao
+   USE bdy_oce        ! open boundary condition variables
+   USE domvvl         ! domain: variable volume layers
+   !
+   USE iom            ! I/O manager library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE fldread	       ! read input fields
+   USE wrk_nemo       !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_stokes      ! routine called in sbccpl
+   PUBLIC   sbc_wave        ! routine called in sbcmod
+   PUBLIC   sbc_wave_init   ! routine called in sbcmod
+   
+   ! Variables checking if the wave parameters are coupled (if not, they are read from file)
+   LOGICAL, PUBLIC ::   cpl_hsig   = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_phioc  = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_sdrftx = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_sdrfty = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_wper   = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_wnum   = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_wstrf  = .FALSE.
+   LOGICAL, PUBLIC ::   cpl_wdrag  = .FALSE.
+
+   INTEGER ::   jpfld    ! number of files to read for stokes drift
+   INTEGER ::   jp_usd   ! index of stokes drift  (i-component) (m/s)    at T-point
+   INTEGER ::   jp_vsd   ! index of stokes drift  (j-component) (m/s)    at T-point
+   INTEGER ::   jp_hsw   ! index of significant wave hight      (m)      at T-point
+   INTEGER ::   jp_wmp   ! index of mean wave period            (s)      at T-point
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_cd      ! structure of input fields (file informations, fields read) Drag Coefficient
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sd      ! structure of input fields (file informations, fields read) Stokes Drift
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_wn      ! structure of input fields (file informations, fields read) wave number for Qiao
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauoc   ! structure of input fields (file informations, fields read) normalized wave stress into the ocean
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   cdn_wave            !:
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   hsw, wmp, wnum      !: 
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wave          !:  
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tsd2d               !: 
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   div_sd              !: barotropic stokes drift divergence
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ut0sd, vt0sd        !: surface Stokes drift velocities at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd  , vsd  , wsd   !: Stokes drift velocities at u-, v- & w-points, resp.
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_stokes( )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_stokes  ***
+      !!
+      !! ** Purpose :   compute the 3d Stokes Drift according to Breivik et al.,
+      !!                2014 (DOI: 10.1175/JPO-D-14-0020.1)
+      !!
+      !! ** Method  : - Calculate Stokes transport speed 
+      !!              - Calculate horizontal divergence 
+      !!              - Integrate the horizontal divergenze from the bottom 
+      !! ** action  
+      !!---------------------------------------------------------------------
+      INTEGER  ::   jj, ji, jk   ! dummy loop argument
+      INTEGER  ::   ik           ! local integer 
+      REAL(wp) ::  ztransp, zfac, ztemp, zsp0
+      REAL(wp) ::  zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zk_t, zk_u, zk_v, zu0_sd, zv0_sd   ! 2D workspace
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   ze3divh                            ! 3D workspace
+      !!---------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   ze3divh )
+      CALL wrk_alloc( jpi,jpj,       zk_t, zk_u, zk_v, zu0_sd, zv0_sd )
+      !
+      !
+      zfac =  2.0_wp * rpi / 16.0_wp
+      DO jj = 1, jpj                ! exp. wave number at t-point    (Eq. (19) in Breivick et al. (2014) )
+         DO ji = 1, jpi
+               ! Stokes drift velocity estimated from Hs and Tmean
+               ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj) , 0.0000001_wp )
+               ! Stokes surface speed
+               zsp0 = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj) )
+               tsd2d(ji,jj) = zsp0
+               ! Wavenumber scale
+               zk_t(ji,jj) = ABS( zsp0 ) / MAX( ABS( 5.97_wp*ztransp ) , 0.0000001_wp )
+         END DO
+      END DO      
+      DO jj = 1, jpjm1              ! exp. wave number & Stokes drift velocity at u- & v-points
+         DO ji = 1, jpim1
+            zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
+            zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
+            !
+            zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) )
+            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) )
+         END DO
+      END DO
+      !
+      !                       !==  horizontal Stokes Drift 3D velocity  ==!
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zdep_u = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) )
+               zdep_v = 0.5_wp * ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) )
+               !                          
+               zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth
+               zkh_v = zk_v(ji,jj) * zdep_v
+               !                                ! Depth attenuation
+               zda_u = EXP( -2.0_wp*zkh_u ) / ( 1.0_wp + 8.0_wp*zkh_u )
+               zda_v = EXP( -2.0_wp*zkh_v ) / ( 1.0_wp + 8.0_wp*zkh_v )
+               !
+               usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)
+               vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO   
+      CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. )
+      !
+      !                       !==  vertical Stokes Drift 3D velocity  ==!
+      !
+      DO jk = 1, jpkm1               ! Horizontal e3*divergence
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi
+               ze3divh(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * usd(ji  ,jj,jk)    &
+                  &                 - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * usd(ji-1,jj,jk)    &
+                  &                 + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vsd(ji,jj  ,jk)    &
+                  &                 - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vsd(ji,jj-1,jk)  ) * r1_e1e2t(ji,jj)
+            END DO
+         END DO
+      END DO
+      !
+      IF( .NOT. AGRIF_Root() ) THEN
+         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh(nlci-1,   :  ,:) = 0._wp      ! east
+         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh(  2   ,   :  ,:) = 0._wp      ! west
+         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh(  :   ,nlcj-1,:) = 0._wp      ! north
+         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh(  :   ,  2   ,:) = 0._wp      ! south
+      ENDIF
+      !
+      CALL lbc_lnk( ze3divh, 'T', 1. )
+      !
+      IF( ln_linssh ) THEN   ;   ik = 1   ! none zero velocity through the sea surface
+      ELSE                   ;   ik = 2   ! w=0 at the surface (set one for all in sbc_wave_init)
+      ENDIF
+      DO jk = jpkm1, ik, -1          ! integrate from the bottom the hor. divergence (NB: at k=jpk w is always zero)
+         wsd(:,:,jk) = wsd(:,:,jk+1) - ze3divh(:,:,jk)
+      END DO
+      !
+      IF( ln_bdy ) THEN
+         DO jk = 1, jpkm1
+            wsd(:,:,jk) = wsd(:,:,jk) * bdytmask(:,:)
+         END DO
+      ENDIF
+      !                       !==  Horizontal divergence of barotropic Stokes transport  ==!
+      div_sd(:,:) = 0._wp
+      DO jk = 1, jpkm1                                 ! 
+        div_sd(:,:) = div_sd(:,:) + ze3divh(:,:,jk)
+      END DO
+      !
+      CALL iom_put( "ustokes",  usd  )
+      CALL iom_put( "vstokes",  vsd  )
+      CALL iom_put( "wstokes",  wsd  )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   ze3divh )
+      CALL wrk_dealloc( jpi,jpj,       zk_t, zk_u, zk_v, zu0_sd, zv0_sd )
+      !
+   END SUBROUTINE sbc_stokes
+
+
+   SUBROUTINE sbc_wave( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_wave  ***
+      !!
+      !! ** Purpose :   read wave parameters from wave model  in netcdf files.
+      !!
+      !! ** Method  : - Read namelist namsbc_wave
+      !!              - Read Cd_n10 fields in netcdf files 
+      !!              - Read stokes drift 2d in netcdf files 
+      !!              - Read wave number in netcdf files 
+      !!              - Compute 3d stokes drift using Breivik et al.,2014
+      !!                formulation
+      !! ** action  
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN     !==  Neutral drag coefficient  ==!
+         CALL fld_read( kt, nn_fsbc, sf_cd )             ! read from external forcing
+         cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1)
+      ENDIF
+
+      IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN    !==  Wave induced stress  ==!
+         CALL fld_read( kt, nn_fsbc, sf_tauoc )          ! read wave norm stress from external forcing
+         tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1)
+      ENDIF
+
+      IF( ln_sdw )  THEN                           !==  Computation of the 3d Stokes Drift  ==! 
+         !
+         IF( jpfld > 0 ) THEN                            ! Read from file only if the field is not coupled
+            CALL fld_read( kt, nn_fsbc, sf_sd )          ! read wave parameters from external forcing
+            IF( jp_hsw > 0 )   hsw  (:,:) = sf_sd(jp_hsw)%fnow(:,:,1)   ! significant wave height
+            IF( jp_wmp > 0 )   wmp  (:,:) = sf_sd(jp_wmp)%fnow(:,:,1)   ! wave mean period
+            IF( jp_usd > 0 )   ut0sd(:,:) = sf_sd(jp_usd)%fnow(:,:,1)   ! 2D zonal Stokes Drift at T point
+            IF( jp_vsd > 0 )   vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1)   ! 2D meridional Stokes Drift at T point
+         ENDIF
+         !
+         ! Read also wave number if needed, so that it is available in coupling routines
+         IF( ln_zdfqiao .AND. .NOT.cpl_wnum ) THEN
+            CALL fld_read( kt, nn_fsbc, sf_wn )          ! read wave parameters from external forcing
+            wnum(:,:) = sf_wn(1)%fnow(:,:,1)
+         ENDIF
+           
+         !                                         !==  Computation of the 3d Stokes Drift  ==! 
+         !
+         IF( jpfld == 4 )   CALL sbc_stokes()            ! Calculate only if required fields are read
+         !                                               ! In coupled wave model-NEMO case the call is done after coupling
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_wave
+
+
+   SUBROUTINE sbc_wave_init
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_wave_init  ***
+      !!
+      !! ** Purpose :   read wave parameters from wave model  in netcdf files.
+      !!
+      !! ** Method  : - Read namelist namsbc_wave
+      !!              - Read Cd_n10 fields in netcdf files 
+      !!              - Read stokes drift 2d in netcdf files 
+      !!              - Read wave number in netcdf files 
+      !!              - Compute 3d stokes drift using Breivik et al.,2014
+      !!                formulation
+      !! ** action  
+      !!---------------------------------------------------------------------
+      INTEGER ::   ierror, ios   ! local integer
+      INTEGER ::   ifpr
+      !!
+      CHARACTER(len=100)     ::  cn_dir                          ! Root directory for location of drag coefficient files
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i     ! array of namelist informations on the fields to read
+      TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd,  &
+                             &   sn_hsw, sn_wmp, sn_wnum, sn_tauoc      ! informations about the fields to be read
+      !
+      NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wnum, sn_tauoc
+      !!---------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namsbc_wave in reference namelist : File for drag coeff. from wave model
+      READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist', lwp )
+         
+      REWIND( numnam_cfg )              ! Namelist namsbc_wave in configuration namelist : File for drag coeff. from wave model
+      READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_wave )
+      !
+      IF( ln_cdgw ) THEN
+         IF( .NOT. cpl_wdrag ) THEN
+            ALLOCATE( sf_cd(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
+            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
+            !
+                                   ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   )
+            IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
+         ENDIF
+         ALLOCATE( cdn_wave(jpi,jpj) )
+      ENDIF
+
+      IF( ln_tauoc ) THEN
+         IF( .NOT. cpl_wstrf ) THEN
+            ALLOCATE( sf_tauoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauoc
+            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
+            !
+                                    ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1)   )
+            IF( sn_tauoc%ln_tint )  ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' )
+         ENDIF
+         ALLOCATE( tauoc_wave(jpi,jpj) )
+      ENDIF
+
+      IF( ln_sdw ) THEN   ! Find out how many fields have to be read from file if not coupled
+         jpfld=0
+         jp_usd=0   ;   jp_vsd=0   ;   jp_hsw=0   ;   jp_wmp=0
+         IF( .NOT. cpl_sdrftx ) THEN
+            jpfld  = jpfld + 1
+            jp_usd = jpfld
+         ENDIF
+         IF( .NOT. cpl_sdrfty ) THEN
+            jpfld  = jpfld + 1
+            jp_vsd = jpfld
+         ENDIF
+         IF( .NOT. cpl_hsig ) THEN
+            jpfld  = jpfld + 1
+            jp_hsw = jpfld
+         ENDIF
+         IF( .NOT. cpl_wper ) THEN
+            jpfld  = jpfld + 1
+            jp_wmp = jpfld
+         ENDIF
+
+         ! Read from file only the non-coupled fields 
+         IF( jpfld > 0 ) THEN
+            ALLOCATE( slf_i(jpfld) )
+            IF( jp_usd > 0 )   slf_i(jp_usd) = sn_usd
+            IF( jp_vsd > 0 )   slf_i(jp_vsd) = sn_vsd
+            IF( jp_hsw > 0 )   slf_i(jp_hsw) = sn_hsw
+            IF( jp_wmp > 0 )   slf_i(jp_wmp) = sn_wmp
+            ALLOCATE( sf_sd(jpfld), STAT=ierror )   !* allocate and fill sf_sd with stokes drift
+            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
+            !
+            DO ifpr= 1, jpfld
+               ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) )
+               IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) )
+            END DO
+            !
+            CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
+         ENDIF
+         ALLOCATE( usd  (jpi,jpj,jpk), vsd  (jpi,jpj,jpk), wsd(jpi,jpj,jpk) )
+         ALLOCATE( hsw  (jpi,jpj)    , wmp  (jpi,jpj)     )
+         ALLOCATE( ut0sd(jpi,jpj)    , vt0sd(jpi,jpj)     )
+         ALLOCATE( div_sd(jpi,jpj) )
+         ALLOCATE( tsd2d (jpi,jpj) )
+         usd(:,:,:) = 0._wp
+         vsd(:,:,:) = 0._wp
+         wsd(:,:,:) = 0._wp
+         ! Wave number needed only if ln_zdfqiao=T
+         IF( .NOT. cpl_wnum ) THEN
+            ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum
+            IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable toallocate sf_wave structure' )
+                                   ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1)   )
+            IF( sn_wnum%ln_tint )  ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' )
+         ENDIF
+         ALLOCATE( wnum(jpi,jpj) )
+      ENDIF
+      !
+   END SUBROUTINE sbc_wave_init
+
+   !!======================================================================
+END MODULE sbcwave
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 8732)
@@ -0,0 +1,29 @@
+   !!----------------------------------------------------------------------
+   !! History :  3.2  !  2007  (O. Le Galloudec)  Original code
+   !!----------------------------------------------------------------------
+
+   !             !! name_tide , equitide , nutide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !!
+   !             !!           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !!
+   Wave( 1) = tide(  'M2'     , 0.242297 ,    2   ,  2 , -2 ,  2 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
+   Wave( 2) = tide(  'N2'     , 0.046313 ,    2   ,  2 , -3 ,  2 ,  1 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
+   Wave( 3) = tide( '2N2'     , 0.006184 ,    2   ,  2 , -4 ,  2 ,  2 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,    78   )
+   Wave( 4) = tide(  'S2'     , 0.113572 ,    2   ,  2 ,  0 ,  0 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,     0   )
+   Wave( 5) = tide(  'K2'     , 0.030875 ,    2   ,  2 ,  0 ,  2 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   , -2   , 0 ,   235   )
+   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
+   Wave( 6) = tide(  'K1'     , 0.142408 ,    1   ,  1 ,  0 ,  1 ,  0 ,  0  ,  -90  ,  0   ,  0   , -1   ,  0   , 0 ,   227   )
+   Wave( 7) = tide(  'O1'     , 0.101266 ,    1   ,  1 , -2 ,  1 ,  0 ,  0  ,  +90  ,  2   , -1   ,  0   ,  0   , 0 ,    75   )
+   Wave( 8) = tide(  'Q1'     , 0.019387 ,    1   ,  1 , -3 ,  1 ,  1 ,  0  ,  +90  ,  2   , -1   ,  0   ,  0   , 0 ,    75   )
+   Wave( 9) = tide(  'P1'     , 0.047129 ,    1   ,  1 ,  0 , -1 ,  0 ,  0  ,  +90  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
+   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
+   Wave(10) = tide(  'M4'     , 0.000000 ,    4   ,  4 , -4 ,  4 ,  0 ,  0  ,    0  ,  4   , -4   ,  0   ,  0   , 0 ,    1    )
+   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
+   Wave(11) = tide(  'Mf'     , 0.042017 ,    0   ,  0 ,  2 ,  0 ,  0 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
+   Wave(12) = tide(  'Mm'     , 0.022191 ,    0   ,  0 ,  1 ,  0 , -1 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,   73    )
+   Wave(13) = tide(  'Msqm'   , 0.000667 ,    0   ,  0 ,  4 , -2 ,  0 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
+   Wave(14) = tide(  'Mtm'    , 0.008049 ,    0   ,  0 ,  3 ,  0 , -1 ,  0  ,    0  , -2   ,  0   ,  0   ,  0   , 0 ,   74    )
+   !              !           !          !        !    !    !    !    !     !       !      !      !      !      !   !         !
+   Wave(15) = tide(  'S1'     , 0.000000 ,    1   ,  1 ,  0 ,  0 ,  0 ,  0  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )   
+   Wave(16) = tide(  'MU2'    , 0.005841 ,    2   ,  2 , -4 ,  4 ,  0 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,   78    )
+   Wave(17) = tide(  'NU2'    , 0.009094 ,    2   ,  2 , -3 ,  4 , -1 ,  0  ,    0  ,  2   , -2   ,  0   ,  0   , 0 ,   78    ) 
+   Wave(18) = tide(  'L2'     , 0.006694 ,    2   ,  2 , -1 ,  2 , -1 ,  0  , +180  ,  2   , -2   ,  0   ,  0   , 0 ,  215    )
+   Wave(19) = tide(  'T2'     , 0.006614 ,    2   ,  2 ,  0 , -1 ,  0 ,  1  ,    0  ,  0   ,  0   ,  0   ,  0   , 0 ,    0    )
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 8732)
@@ -0,0 +1,411 @@
+MODULE tide_mod
+   !!======================================================================
+   !!                       ***  MODULE  tide_mod  ***
+   !! Compute nodal modulations corrections and pulsations
+   !!======================================================================
+   !! History :  1.0  !  2007  (O. Le Galloudec)  Original code
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE daymod         ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tide_harmo       ! called by tideini and diaharm modules
+   PUBLIC   tide_init_Wave   ! called by tideini and diaharm modules
+
+   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 19   !: maximum number of harmonic
+
+   TYPE, PUBLIC ::    tide
+      CHARACTER(LEN=4) ::   cname_tide
+      REAL(wp)         ::   equitide
+      INTEGER          ::   nutide
+      INTEGER          ::   nt, ns, nh, np, np1, shift
+      INTEGER          ::   nksi, nnu0, nnu1, nnu2, R
+      INTEGER          ::   nformula
+   END TYPE tide
+
+   TYPE(tide), PUBLIC, DIMENSION(jpmax_harmo) ::   Wave   !:
+
+   REAL(wp) ::   sh_T, sh_s, sh_h, sh_p, sh_p1             ! astronomic angles
+   REAL(wp) ::   sh_xi, sh_nu, sh_nuprim, sh_nusec, sh_R   !
+   REAL(wp) ::   sh_I, sh_x1ra, sh_N                       !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tide_init_Wave
+#     include "tide.h90"
+   END SUBROUTINE tide_init_Wave
+
+
+   SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc)
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER , DIMENSION(kc), INTENT(in ) ::   ktide            ! Indice of tidal constituents
+      INTEGER                , INTENT(in ) ::   kc               ! Total number of tidal constituents
+      REAL(wp), DIMENSION(kc), INTENT(out) ::   pomega           ! pulsation in radians/s
+      REAL(wp), DIMENSION(kc), INTENT(out) ::   pvt, put, pcor   !
+      !!----------------------------------------------------------------------
+      !
+      CALL astronomic_angle
+      CALL tide_pulse( pomega, ktide ,kc )
+      CALL tide_vuf  ( pvt, put, pcor, ktide ,kc )
+      !
+   END SUBROUTINE tide_harmo
+
+
+   SUBROUTINE astronomic_angle
+      !!----------------------------------------------------------------------
+      !!  tj is time elapsed since 1st January 1900, 0 hour, counted in julian
+      !!  century (e.g. time in days divide by 36525)
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   cosI, p, q, t2, t4, sin2I, s2, tgI2, P1, sh_tgn2, at1, at2
+      REAL(wp) ::   zqy , zsy, zday, zdj, zhfrac
+      !!----------------------------------------------------------------------
+      !
+      zqy = AINT( (nyear-1901.)/4. )
+      zsy = nyear - 1900.
+      !
+      zdj  = dayjul( nyear, nmonth, nday )
+      zday = zdj + zqy - 1.
+      !
+      zhfrac = nsec_day / 3600.
+      !
+      !----------------------------------------------------------------------
+      !  Sh_n Longitude of ascending lunar node
+      !----------------------------------------------------------------------
+      sh_N=(259.1560564-19.328185764*zsy-.0529539336*zday-.0022064139*zhfrac)*rad
+      !----------------------------------------------------------------------
+      ! T mean solar angle (Greenwhich time)
+      !----------------------------------------------------------------------
+      sh_T=(180.+zhfrac*(360./24.))*rad
+      !----------------------------------------------------------------------
+      ! h mean solar Longitude
+      !----------------------------------------------------------------------
+      sh_h=(280.1895014-.238724988*zsy+.9856473288*zday+.0410686387*zhfrac)*rad
+      !----------------------------------------------------------------------
+      ! s mean lunar Longitude
+      !----------------------------------------------------------------------
+      sh_s=(277.0256206+129.38482032*zsy+13.176396768*zday+.549016532*zhfrac)*rad
+      !----------------------------------------------------------------------
+      ! p1 Longitude of solar perigee
+      !----------------------------------------------------------------------
+      sh_p1=(281.2208569+.01717836*zsy+.000047064*zday+.000001961*zhfrac)*rad
+      !----------------------------------------------------------------------
+      ! p Longitude of lunar perigee
+      !----------------------------------------------------------------------
+      sh_p=(334.3837214+40.66246584*zsy+.111404016*zday+.004641834*zhfrac)*rad
+
+      sh_N = MOD( sh_N ,2*rpi )
+      sh_s = MOD( sh_s ,2*rpi )
+      sh_h = MOD( sh_h, 2*rpi )
+      sh_p = MOD( sh_p, 2*rpi )
+      sh_p1= MOD( sh_p1,2*rpi )
+
+      cosI = 0.913694997 -0.035692561 *cos(sh_N)
+
+      sh_I = ACOS( cosI )
+
+      sin2I   = sin(sh_I)
+      sh_tgn2 = tan(sh_N/2.0)
+
+      at1=atan(1.01883*sh_tgn2)
+      at2=atan(0.64412*sh_tgn2)
+
+      sh_xi=-at1-at2+sh_N
+
+      IF( sh_N > rpi )   sh_xi=sh_xi-2.0*rpi
+
+      sh_nu = at1 - at2
+
+      !----------------------------------------------------------------------
+      ! For constituents l2 k1 k2
+      !----------------------------------------------------------------------
+
+      tgI2 = tan(sh_I/2.0)
+      P1   = sh_p-sh_xi
+
+      t2 = tgI2*tgI2
+      t4 = t2*t2
+      sh_x1ra = sqrt( 1.0-12.0*t2*cos(2.0*P1)+36.0*t4 )
+
+      p = sin(2.0*P1)
+      q = 1.0/(6.0*t2)-cos(2.0*P1)
+      sh_R = atan(p/q)
+
+      p = sin(2.0*sh_I)*sin(sh_nu)
+      q = sin(2.0*sh_I)*cos(sh_nu)+0.3347
+      sh_nuprim = atan(p/q)
+
+      s2 = sin(sh_I)*sin(sh_I)
+      p  = s2*sin(2.0*sh_nu)
+      q  = s2*cos(2.0*sh_nu)+0.0727
+      sh_nusec = 0.5*atan(p/q)
+      !
+   END SUBROUTINE astronomic_angle
+
+
+   SUBROUTINE tide_pulse( pomega, ktide ,kc )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE tide_pulse  ***
+      !!                      
+      !! ** Purpose : Compute tidal frequencies
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in ) ::   kc       ! Total number of tidal constituents
+      INTEGER , DIMENSION(kc), INTENT(in ) ::   ktide    ! Indice of tidal constituents
+      REAL(wp), DIMENSION(kc), INTENT(out) ::   pomega   ! pulsation in radians/s
+      !
+      INTEGER  ::   jh
+      REAL(wp) ::   zscale
+      REAL(wp) ::   zomega_T =  13149000.0_wp
+      REAL(wp) ::   zomega_s =    481267.892_wp
+      REAL(wp) ::   zomega_h =     36000.76892_wp
+      REAL(wp) ::   zomega_p =      4069.0322056_wp
+      REAL(wp) ::   zomega_n =      1934.1423972_wp
+      REAL(wp) ::   zomega_p1=         1.719175_wp
+      !!----------------------------------------------------------------------
+      !
+      zscale =  rad / ( 36525._wp * 86400._wp ) 
+      !
+      DO jh = 1, kc
+         pomega(jh) = (  zomega_T * Wave( ktide(jh) )%nT   &
+            &          + zomega_s * Wave( ktide(jh) )%ns   &
+            &          + zomega_h * Wave( ktide(jh) )%nh   &
+            &          + zomega_p * Wave( ktide(jh) )%np   &
+            &          + zomega_p1* Wave( ktide(jh) )%np1  ) * zscale
+      END DO
+      !
+   END SUBROUTINE tide_pulse
+
+
+   SUBROUTINE tide_vuf( pvt, put, pcor, ktide ,kc )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE tide_vuf  ***
+      !!                      
+      !! ** Purpose : Compute nodal modulation corrections
+      !!
+      !! ** Outputs : vt: Phase of tidal potential relative to Greenwich (radians)
+      !!              ut: Phase correction u due to nodal motion (radians)
+      !!              ft: Nodal correction factor
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in ) ::   kc               ! Total number of tidal constituents
+      INTEGER , DIMENSION(kc), INTENT(in ) ::   ktide            ! Indice of tidal constituents
+      REAL(wp), DIMENSION(kc), INTENT(out) ::   pvt, put, pcor   !
+      !
+      INTEGER ::   jh   ! dummy loop index
+      !!----------------------------------------------------------------------
+      !
+      DO jh = 1, kc
+         !  Phase of the tidal potential relative to the Greenwhich 
+         !  meridian (e.g. the position of the fictuous celestial body). Units are radian:
+         pvt(jh) = sh_T * Wave( ktide(jh) )%nT    &
+            &    + sh_s * Wave( ktide(jh) )%ns    &
+            &    + sh_h * Wave( ktide(jh) )%nh    &
+            &    + sh_p * Wave( ktide(jh) )%np    &
+            &    + sh_p1* Wave( ktide(jh) )%np1   &
+            &    +        Wave( ktide(jh) )%shift * rad
+         !
+         !  Phase correction u due to nodal motion. Units are radian:
+         put(jh) = sh_xi     * Wave( ktide(jh) )%nksi   &
+            &    + sh_nu     * Wave( ktide(jh) )%nnu0   &
+            &    + sh_nuprim * Wave( ktide(jh) )%nnu1   &
+            &    + sh_nusec  * Wave( ktide(jh) )%nnu2   &
+            &    + sh_R      * Wave( ktide(jh) )%R
+
+         !  Nodal correction factor:
+         pcor(jh) = nodal_factort( Wave( ktide(jh) )%nformula )
+      END DO
+      !
+   END SUBROUTINE tide_vuf
+
+
+   RECURSIVE FUNCTION nodal_factort( kformula ) RESULT( zf )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kformula
+      !
+      REAL(wp) :: zf
+      REAL(wp) :: zs, zf1, zf2
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE( kformula )
+      !
+      CASE( 0 )                  !==  formule 0, solar waves
+         zf = 1.0
+         !
+      CASE( 1 )                  !==  formule 1, compound waves (78 x 78)
+         zf=nodal_factort(78)
+         zf = zf * zf
+         !
+      CASE ( 2 )                 !==  formule 2, compound waves (78 x 0)  ===  (78) 
+       zf1= nodal_factort(78)
+       zf = nodal_factort( 0)
+       zf = zf1 * zf
+       !
+      CASE ( 4 )                 !==  formule 4,  compound waves (78 x 235) 
+         zf1 = nodal_factort( 78)
+         zf  = nodal_factort(235)
+         zf  = zf1 * zf
+         !
+      CASE ( 5 )                 !==  formule 5,  compound waves (78 *78 x 235)
+         zf1 = nodal_factort( 78)
+         zf  = nodal_factort(235)
+         zf  = zf * zf1 * zf1
+         !
+      CASE ( 6 )                 !==  formule 6,  compound waves (78 *78 x 0)
+         zf1 = nodal_factort(78)
+         zf  = nodal_factort( 0)
+         zf  = zf * zf1 * zf1 
+         !
+      CASE( 7 )                  !==  formule 7, compound waves (75 x 75)
+         zf = nodal_factort(75)
+         zf = zf * zf
+         !
+      CASE( 8 )                  !==  formule 8,  compound waves (78 x 0 x 235)
+         zf  = nodal_factort( 78)
+         zf1 = nodal_factort(  0)
+         zf2 = nodal_factort(235)
+         zf  = zf * zf1 * zf2
+         !
+      CASE( 9 )                  !==  formule 9,  compound waves (78 x 0 x 227)
+         zf  = nodal_factort( 78)
+         zf1 = nodal_factort(  0)
+         zf2 = nodal_factort(227)
+         zf  = zf * zf1 * zf2
+         !
+      CASE( 10 )                 !==  formule 10,  compound waves (78 x 227)
+         zf  = nodal_factort( 78)
+         zf1 = nodal_factort(227)
+         zf  = zf * zf1
+         !
+      CASE( 11 )                 !==  formule 11,  compound waves (75 x 0)
+!!gm bug???? zf 2 fois !
+         zf = nodal_factort(75)
+         zf = nodal_factort( 0)
+         zf = zf * zf1
+         !
+      CASE( 12 )                 !==  formule 12,  compound waves (78 x 78 x 78 x 0) 
+         zf1 = nodal_factort(78)
+         zf  = nodal_factort( 0)
+         zf  = zf * zf1 * zf1 * zf1
+         !
+      CASE( 13 )                 !==  formule 13, compound waves (78 x 75)
+         zf1 = nodal_factort(78)
+         zf  = nodal_factort(75)
+         zf  = zf * zf1
+         !
+      CASE( 14 )                 !==  formule 14, compound waves (235 x 0)  ===  (235)
+         zf  = nodal_factort(235)
+         zf1 = nodal_factort(  0)
+         zf  = zf * zf1
+         !
+      CASE( 15 )                 !==  formule 15, compound waves (235 x 75) 
+         zf  = nodal_factort(235)
+         zf1 = nodal_factort( 75)
+         zf  = zf * zf1
+         !
+      CASE( 16 )                 !==  formule 16, compound waves (78 x 0 x 0)  ===  (78)
+         zf  = nodal_factort(78)
+         zf1 = nodal_factort( 0)
+         zf  = zf * zf1 * zf1
+         !
+      CASE( 17 )                 !==  formule 17,  compound waves (227 x 0) 
+         zf1 = nodal_factort(227)
+         zf  = nodal_factort(  0)
+         zf  = zf * zf1
+         !
+      CASE( 18 )                 !==  formule 18,  compound waves (78 x 78 x 78 )
+         zf1 = nodal_factort(78)
+         zf  = zf1 * zf1 * zf1
+         !
+      CASE( 19 )                 !==  formule 19, compound waves (78 x 0 x 0 x 0)  ===  (78)
+!!gm bug2 ==>>>   here identical to formule 16,  a third multiplication by zf1 is missing
+         zf  = nodal_factort(78)
+         zf1 = nodal_factort( 0)
+         zf = zf * zf1 * zf1
+         !
+      CASE( 73 )                 !==  formule 73
+         zs = sin(sh_I)
+         zf = (2./3.-zs*zs)/0.5021
+         !
+      CASE( 74 )                 !==  formule 74
+         zs = sin(sh_I)
+         zf = zs * zs / 0.1578
+         !
+      CASE( 75 )                 !==  formule 75
+         zs = cos(sh_I/2)
+         zf = sin(sh_I) * zs * zs / 0.3800
+         !
+      CASE( 76 )                 !==  formule 76
+         zf = sin(2*sh_I) / 0.7214
+         !
+      CASE( 77 )                 !==  formule 77
+         zs = sin(sh_I/2)
+         zf = sin(sh_I) * zs * zs / 0.0164
+         !
+      CASE( 78 )                 !==  formule 78
+         zs = cos(sh_I/2)
+         zf = zs * zs * zs * zs / 0.9154
+         !
+      CASE( 79 )                 !==  formule 79
+         zs = sin(sh_I)
+         zf = zs * zs / 0.1565
+         !
+      CASE( 144 )                !==  formule 144
+         zs = sin(sh_I/2)
+         zf = ( 1-10*zs*zs+15*zs*zs*zs*zs ) * cos(sh_I/2) / 0.5873
+         !
+      CASE( 149 )                !==  formule 149
+         zs = cos(sh_I/2)
+         zf = zs*zs*zs*zs*zs*zs / 0.8758
+         !
+      CASE( 215 )                !==  formule 215
+         zs = cos(sh_I/2)
+         zf = zs*zs*zs*zs / 0.9154 * sh_x1ra
+         !
+      CASE( 227 )                !==  formule 227 
+         zs = sin(2*sh_I)
+         zf = sqrt( 0.8965*zs*zs+0.6001*zs*cos (sh_nu)+0.1006 )
+         !
+      CASE ( 235 )               !==  formule 235 
+         zs = sin(sh_I)
+         zf = sqrt( 19.0444*zs*zs*zs*zs + 2.7702*zs*zs*cos(2*sh_nu) + .0981 )
+         !
+      END SELECT
+      !
+   END FUNCTION nodal_factort
+
+
+   FUNCTION dayjul( kyr, kmonth, kday )
+      !!----------------------------------------------------------------------
+      !!  *** THIS ROUTINE COMPUTES THE JULIAN DAY (AS A REAL VARIABLE)
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT(in) ::   kyr, kmonth, kday
+      !
+      INTEGER,DIMENSION(12) ::  idayt, idays
+      INTEGER  ::   inc, ji
+      REAL(wp) ::   dayjul, zyq
+      !
+      DATA idayt/0.,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334./
+      !!----------------------------------------------------------------------
+      !
+      idays(1) = 0.
+      idays(2) = 31.
+      inc = 0.
+      zyq = MOD( kyr-1900. , 4. )
+      IF( zyq == 0.)   inc = 1.
+      DO ji = 3, 12
+         idays(ji)=idayt(ji)+inc
+      END DO
+      dayjul = idays(kmonth) + kday
+      !
+   END FUNCTION dayjul
+
+   !!======================================================================
+END MODULE tide_mod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90	(revision 8732)
@@ -0,0 +1,117 @@
+MODULE tideini
+   !!======================================================================
+   !!                       ***  MODULE  tideini  ***
+   !! Initialization of tidal forcing
+   !!======================================================================
+   !! History :  1.0  !  2007  (O. Le Galloudec)  Original code
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE daymod         ! calandar
+   USE tide_mod       ! 
+   !
+   USE in_out_manager ! I/O units
+   USE iom            ! xIOs server
+   USE ioipsl         ! NetCDF IPSL library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PUBLIC
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   omega_tide   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   v0tide       !:
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   utide        !:
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ftide        !:
+
+   LOGICAL , PUBLIC ::   ln_tide         !:
+   LOGICAL , PUBLIC ::   ln_tide_pot     !:
+   LOGICAL , PUBLIC ::   ln_tide_ramp    !:
+   INTEGER , PUBLIC ::   nb_harmo        !:
+   INTEGER , PUBLIC ::   kt_tide         !:
+   REAL(wp), PUBLIC ::   rdttideramp     !:
+   
+   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !:
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.5 , NEMO Consortium (2013)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE tide_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tide_init  ***
+      !!----------------------------------------------------------------------      
+      INTEGER  :: ji, jk
+      CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !
+      NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_tide_ramp, rdttideramp, clname
+      !!----------------------------------------------------------------------
+      !
+      ! Read Namelist nam_tide
+      REWIND( numnam_ref )              ! Namelist nam_tide in reference namelist : Tides
+      READ  ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nam_tide in configuration namelist : Tides
+      READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_tide )
+      !
+      IF (ln_tide) THEN
+         IF (lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'tide_init : Initialization of the tidal components'
+            WRITE(numout,*) '~~~~~~~~~ '
+            WRITE(numout,*) '   Namelist nam_tide'
+            WRITE(numout,*) '              Use tidal components : ln_tide      = ', ln_tide
+            WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  = ', ln_tide_pot
+            WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo
+            WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp
+            WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp
+         ENDIF
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
+         RETURN
+      ENDIF
+      !
+      CALL tide_init_Wave
+      !
+      nb_harmo=0
+      DO jk = 1, jpmax_harmo
+         DO ji = 1,jpmax_harmo
+            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide )   nb_harmo = nb_harmo + 1
+         END DO
+      END DO
+      !       
+      ! Ensure that tidal components have been set in namelist_cfg
+      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
+      !
+      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   &
+         &   CALL ctl_stop('rdttideramp must be lower than run duration')
+      IF( ln_tide_ramp.AND.(rdttideramp<0.) ) &
+         &   CALL ctl_stop('rdttideramp must be positive')
+      !
+      ALLOCATE( ntide(nb_harmo) )
+      DO jk = 1, nb_harmo
+         DO ji = 1, jpmax_harmo
+            IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN
+               ntide(jk) = ji
+               EXIT
+            ENDIF
+         END DO
+      END DO
+      !
+      ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   &
+         &      utide     (nb_harmo), ftide     (nb_harmo)  )
+      kt_tide = nit000
+      !
+   END SUBROUTINE tide_init
+     
+   !!======================================================================
+END MODULE tideini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 8732)
@@ -0,0 +1,81 @@
+MODULE updtide
+   !!======================================================================
+   !!                       ***  MODULE  updtide  ***
+   !! Initialization of tidal forcing
+   !!======================================================================
+   !! History :  9.0  !  07  (O. Le Galloudec)  Original code
+   !!----------------------------------------------------------------------
+   !!   upd_tide       : update tidal potential
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O units
+   USE phycst          ! physical constant
+   USE sbctide         ! tide potential variable
+   USE tideini, ONLY: ln_tide_ramp, rdttideramp
+
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   upd_tide   ! called in dynspg_... modules
+  
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE upd_tide( kt, kit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE upd_tide  ***
+      !!
+      !! ** Purpose :   provide at each time step the astronomical potential
+      !!
+      !! ** Method  :   computed from pulsation and amplitude of all tide components
+      !!
+      !! ** Action  :   pot_astro   actronomical potential
+      !!----------------------------------------------------------------------      
+      INTEGER, INTENT(in)           ::   kt      ! ocean time-step index
+      INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T)
+      INTEGER, INTENT(in), OPTIONAL ::   time_offset ! time offset in number 
+                                                     ! of internal steps             (lk_dynspg_ts=F)
+                                                     ! of external steps             (lk_dynspg_ts=T)
+      !
+      INTEGER  ::   joffset      ! local integer
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zramp    ! local scalar
+      REAL(wp), DIMENSION(nb_harmo) ::   zwt 
+      !!----------------------------------------------------------------------      
+      !
+      !                               ! tide pulsation at model time step (or sub-time-step)
+      zt = ( kt - kt_tide ) * rdt
+      !
+      joffset = 0
+      IF( PRESENT( time_offset ) )   joffset = time_offset
+      !
+      IF( PRESENT( kit ) )   THEN
+         zt = zt + ( kit +  joffset - 1 ) * rdt / REAL( nn_baro, wp )
+      ELSE
+         zt = zt + joffset * rdt
+      ENDIF
+      !
+      zwt(:) = omega_tide(:) * zt
+
+      pot_astro(:,:) = 0._wp          ! update tidal potential (sum of all harmonics)
+      DO jk = 1, nb_harmo   
+         pot_astro(:,:) = pot_astro(:,:) + amp_pot(:,:,jk) * COS( zwt(jk) + phi_pot(:,:,jk) )      
+      END DO
+      !
+      IF( ln_tide_ramp ) THEN         ! linear increase if asked
+         zt = ( kt - nit000 ) * rdt
+         IF( PRESENT( kit ) )   zt = zt + ( kit + joffset -1) * rdt / REAL( nn_baro, wp )
+         zramp = MIN(  MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp  )
+         pot_astro(:,:) = zramp * pot_astro(:,:)
+      ENDIF
+      !
+   END SUBROUTINE upd_tide
+
+  !!======================================================================
+
+END MODULE updtide
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90	(revision 8732)
@@ -0,0 +1,903 @@
+MODULE stopar
+   !!======================================================================
+   !!                       ***  MODULE  stopar  ***
+   !! Stochastic parameters : definition and time stepping
+   !!=====================================================================
+   !! History :  3.3  ! 2011-10 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sto_par       : update the stochastic parameters
+   !!   sto_par_init  : define the stochastic parameterization
+   !!   sto_rst_read  : read restart file for stochastic parameters
+   !!   sto_rst_write : write restart file for stochastic parameters
+   !!   sto_par_white : fill input array with white Gaussian noise
+   !!   sto_par_flt   : apply horizontal Laplacian filter to input array
+   !!----------------------------------------------------------------------
+   USE storng          ! random number generator (external module)
+   USE par_oce         ! ocean parameters
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE lib_mpp
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sto_par_init    ! called by nemogcm.F90
+   PUBLIC   sto_par         ! called by step.F90
+   PUBLIC   sto_rst_write   ! called by step.F90
+
+   LOGICAL           :: ln_rststo = .FALSE.  ! restart stochastic parameters from restart file
+   LOGICAL           :: ln_rstseed = .FALSE. ! read seed of RNG from restart file
+   CHARACTER(len=32) :: cn_storst_in = "restart_sto"     ! suffix of sto restart name (input)
+   CHARACTER(len=32) :: cn_storst_out = "restart_sto"    ! suffix of sto restart name (output)
+   INTEGER           :: numstor, numstow     ! logical unit for restart (read and write)
+
+   INTEGER           :: jpsto2d = 0          ! number of 2D stochastic parameters
+   INTEGER           :: jpsto3d = 0          ! number of 3D stochastic parameters
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:),   ALLOCATABLE :: sto2d      ! 2D stochastic parameters
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: sto3d      ! 3D stochastic parameters
+   REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto_tmp    ! temporary workspace
+   REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto2d_abc  ! a, b, c parameters (for 2D arrays)
+   REAL(wp),         DIMENSION(:,:),     ALLOCATABLE :: sto3d_abc  ! a, b, c parameters (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_ave  ! mean value (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_ave  ! mean value (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_std  ! standard deviation (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_std  ! standard deviation (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_lim  ! limitation factor (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_lim  ! limitation factor (for 3D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_tcor ! time correlation (for 2D arrays)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_tcor ! time correlation (for 3D arrays)
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto2d_ord  ! order of autoregressive process
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_ord  ! order of autoregressive process
+
+   CHARACTER(len=1), DIMENSION(:),       ALLOCATABLE :: sto2d_typ  ! nature of grid point (T, U, V, W, F, I)
+   CHARACTER(len=1), DIMENSION(:),       ALLOCATABLE :: sto3d_typ  ! nature of grid point (T, U, V, W, F, I)
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_sgn  ! control of the sign accross the north fold
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_sgn  ! control of the sign accross the north fold
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto2d_flt  ! number of passes of Laplacian filter
+   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_flt  ! number of passes of Laplacian filter
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_fac  ! factor to restore std after filtering
+   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_fac  ! factor to restore std after filtering
+
+   LOGICAL, PUBLIC :: ln_sto_ldf = .FALSE.    ! stochastic lateral diffusion
+   INTEGER, PUBLIC :: jsto_ldf                ! index of lateral diffusion stochastic parameter
+   REAL(wp)        :: rn_ldf_std              ! lateral diffusion standard deviation (in percent)
+   REAL(wp)        :: rn_ldf_tcor             ! lateral diffusion correlation timescale (in timesteps)
+
+   LOGICAL, PUBLIC :: ln_sto_hpg = .FALSE.    ! stochastic horizontal pressure gradient
+   INTEGER, PUBLIC :: jsto_hpgi               ! index of stochastic hpg parameter (i direction)
+   INTEGER, PUBLIC :: jsto_hpgj               ! index of stochastic hpg parameter (j direction)
+   REAL(wp)        :: rn_hpg_std              ! density gradient standard deviation (in percent)
+   REAL(wp)        :: rn_hpg_tcor             ! density gradient correlation timescale (in timesteps)
+
+   LOGICAL, PUBLIC :: ln_sto_pstar = .FALSE.  ! stochastic ice strength
+   INTEGER, PUBLIC :: jsto_pstar              ! index of stochastic ice strength
+   REAL(wp), PUBLIC:: rn_pstar_std            ! ice strength standard deviation (in percent)
+   REAL(wp)        :: rn_pstar_tcor           ! ice strength correlation timescale (in timesteps)
+   INTEGER         :: nn_pstar_flt = 0        ! number of passes of Laplacian filter
+   INTEGER         :: nn_pstar_ord = 1        ! order of autoregressive processes
+
+   LOGICAL, PUBLIC :: ln_sto_trd = .FALSE.    ! stochastic model trend
+   INTEGER, PUBLIC :: jsto_trd                ! index of stochastic trend parameter
+   REAL(wp)        :: rn_trd_std              ! trend standard deviation (in percent)
+   REAL(wp)        :: rn_trd_tcor             ! trend correlation timescale (in timesteps)
+
+   LOGICAL, PUBLIC :: ln_sto_eos = .FALSE.    ! stochastic equation of state
+   INTEGER, PUBLIC :: nn_sto_eos = 1          ! number of degrees of freedom in stochastic equation of state
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosi ! index of stochastic eos parameter (i direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosj ! index of stochastic eos parameter (j direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosk ! index of stochastic eos parameter (k direction)
+   REAL(wp)        :: rn_eos_stdxy            ! random walk horz. standard deviation (in grid points)
+   REAL(wp)        :: rn_eos_stdz             ! random walk vert. standard deviation (in grid points)
+   REAL(wp)        :: rn_eos_tcor             ! random walk correlation timescale (in timesteps)
+   REAL(wp)        :: rn_eos_lim = 3.0_wp     ! limitation factor
+   INTEGER         :: nn_eos_flt = 0          ! number of passes of Laplacian filter
+   INTEGER         :: nn_eos_ord = 1          ! order of autoregressive processes
+
+   LOGICAL, PUBLIC :: ln_sto_trc = .FALSE.    ! stochastic tracer dynamics
+   INTEGER, PUBLIC :: nn_sto_trc = 1          ! number of degrees of freedom in stochastic tracer dynamics
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trci ! index of stochastic trc parameter (i direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trcj ! index of stochastic trc parameter (j direction)
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trck ! index of stochastic trc parameter (k direction)
+   REAL(wp)        :: rn_trc_stdxy            ! random walk horz. standard deviation (in grid points)
+   REAL(wp)        :: rn_trc_stdz             ! random walk vert. standard deviation (in grid points)
+   REAL(wp)        :: rn_trc_tcor             ! random walk correlation timescale (in timesteps)
+   REAL(wp)        :: rn_trc_lim = 3.0_wp     ! limitation factor
+   INTEGER         :: nn_trc_flt = 0          ! number of passes of Laplacian filter
+   INTEGER         :: nn_trc_ord = 1          ! order of autoregressive processes
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sto_par( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par  ***
+      !!
+      !! ** Purpose :   update the stochastic parameters
+      !!
+      !! ** Method  :   model basic stochastic parameters
+      !!                as a first order autoregressive process AR(1),
+      !!                governed by the equation:
+      !!                   X(t) = a * X(t-1) + b * w + c
+      !!                where the parameters a, b and c are related
+      !!                to expected value, standard deviation
+      !!                and time correlation (all stationary in time) by:
+      !!                   E   [X(t)]        = c / ( 1 - a )
+      !!                   STD [X(t)]        = b / SQRT( 1 - a * a )
+      !!                   COR [X(t),X(t-k)] = a ** k
+      !!                and w is a Gaussian white noise.
+      !!
+      !!                Higher order autoregressive proces can be optionally generated
+      !!                by replacing the white noise by a lower order process.
+      !!
+      !!                1) The statistics of the stochastic parameters (X) are assumed
+      !!                constant in space (homogeneous) and time (stationary).
+      !!                This could be generalized by replacing the constant
+      !!                a, b, c parameters by functions of space and time.
+      !!
+      !!                2) The computation is performed independently for every model
+      !!                grid point, which corresponds to assume that the stochastic
+      !!                parameters are uncorrelated in space.
+      !!                This could be generalized by including a spatial filter: Y = Filt[ X ]
+      !!                (possibly non-homgeneous and non-stationary) in the computation,
+      !!                or by solving an elliptic equation: L[ Y ] = X.
+      !!
+      !!                3) The stochastic model for the parameters could also
+      !!                be generalized to depend on the current state of the ocean (not done here).
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  :: ji, jj, jk, jsto, jflt
+      REAL(wp) :: stomax
+
+      !
+      ! Update 2D stochastic arrays
+      !
+      DO jsto = 1, jpsto2d
+        ! Store array from previous time step
+        sto_tmp(:,:) = sto2d(:,:,jsto)
+
+        IF ( sto2d_ord(jsto) == 1 ) THEN
+          ! Draw new random numbers from N(0,1) --> w
+          CALL sto_par_white( sto2d(:,:,jsto) )
+          ! Apply horizontal Laplacian filter to w
+          DO jflt = 1, sto2d_flt(jsto)
+            CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+            CALL sto_par_flt( sto2d(:,:,jsto) )
+          END DO
+          ! Factor to restore standard deviation after filtering
+          sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_fac(jsto)
+        ELSE
+          ! Use previous process (one order lower) instead of white noise
+          sto2d(:,:,jsto) = sto2d(:,:,jsto-1)
+        ENDIF
+
+        ! Multiply white noise (or lower order process) by b --> b * w
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_abc(jsto,2)
+        ! Update autoregressive processes --> a * X(t-1) + b * w
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto_tmp(:,:) * sto2d_abc(jsto,1)
+        ! Add parameter c --> a * X(t-1) + b * w + c
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto2d_abc(jsto,3)
+        ! Limit random parameter anomalies to std times the limitation factor
+        stomax = sto2d_std(jsto) * sto2d_lim(jsto)
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) - sto2d_ave(jsto)
+        sto2d(:,:,jsto) = SIGN(MIN(stomax,ABS(sto2d(:,:,jsto))),sto2d(:,:,jsto))
+        sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto2d_ave(jsto)
+
+        ! Lateral boundary conditions on sto2d
+        CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+      END DO
+      !
+      ! Update 3D stochastic arrays
+      !
+      DO jsto = 1, jpsto3d
+         DO jk = 1, jpk
+           ! Store array from previous time step
+           sto_tmp(:,:) = sto3d(:,:,jk,jsto)
+
+           IF ( sto3d_ord(jsto) == 1 ) THEN
+             ! Draw new random numbers from N(0,1) --> w
+             CALL sto_par_white( sto3d(:,:,jk,jsto) )
+             ! Apply horizontal Laplacian filter to w
+             DO jflt = 1, sto3d_flt(jsto)
+               CALL lbc_lnk( sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+               CALL sto_par_flt( sto3d(:,:,jk,jsto) )
+             END DO
+             ! Factor to restore standard deviation after filtering
+             sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_fac(jsto)
+           ELSE
+             ! Use previous process (one order lower) instead of white noise
+             sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto-1)
+           ENDIF
+
+           ! Multiply white noise by b --> b * w
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_abc(jsto,2)
+           ! Update autoregressive processes --> a * X(t-1) + b * w
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto_tmp(:,:) * sto3d_abc(jsto,1)
+           ! Add parameter c --> a * X(t-1) + b * w + c
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto3d_abc(jsto,3)
+           ! Limit random parameters anomalies to std times the limitation factor
+           stomax = sto3d_std(jsto) * sto3d_lim(jsto)
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) - sto3d_ave(jsto)
+           sto3d(:,:,jk,jsto) = SIGN(MIN(stomax,ABS(sto3d(:,:,jk,jsto))),sto3d(:,:,jk,jsto))
+           sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto3d_ave(jsto)
+         END DO
+         ! Lateral boundary conditions on sto3d
+         CALL lbc_lnk( sto3d(:,:,:,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+      END DO
+
+   END SUBROUTINE sto_par
+
+
+   SUBROUTINE sto_par_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par_init  ***
+      !!
+      !! ** Purpose :   define the stochastic parameterization
+      !!----------------------------------------------------------------------
+      NAMELIST/namsto/ ln_sto_ldf, rn_ldf_std, rn_ldf_tcor, &
+        &              ln_sto_hpg, rn_hpg_std, rn_hpg_tcor, &
+        &              ln_sto_pstar, rn_pstar_std, rn_pstar_tcor, nn_pstar_flt, nn_pstar_ord, &
+        &              ln_sto_trd, rn_trd_std, rn_trd_tcor, &
+        &              ln_sto_eos, nn_sto_eos, rn_eos_stdxy, rn_eos_stdz, &
+        &              rn_eos_tcor, nn_eos_ord, nn_eos_flt, rn_eos_lim, &
+        &              ln_sto_trc, nn_sto_trc, rn_trc_stdxy, rn_trc_stdz, &
+        &              rn_trc_tcor, nn_trc_ord, nn_trc_flt, rn_trc_lim, &
+        &              ln_rststo, ln_rstseed, cn_storst_in, cn_storst_out
+      !!----------------------------------------------------------------------
+      INTEGER :: jsto, jmem, jarea, jdof, jord, jordm1, jk, jflt
+      INTEGER(KIND=8) :: zseed1, zseed2, zseed3, zseed4
+      REAL(wp) :: rinflate
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+
+      ! Read namsto namelist : stochastic parameterization
+      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
+      READ  ( numnam_ref, namsto, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
+      READ  ( numnam_cfg, namsto, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsto )
+
+      !IF(ln_ens_rst_in) cn_storst_in = cn_mem//cn_storst_in
+
+      ! Parameter print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sto_par_init : stochastic parameterization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namsto : stochastic parameterization'
+         WRITE(numout,*) '      restart stochastic parameters           ln_rststo     = ', ln_rststo
+         WRITE(numout,*) '      read seed of RNG from restart file      ln_rstseed    = ', ln_rstseed
+         WRITE(numout,*) '      suffix of sto restart name (input)      cn_storst_in  = ', cn_storst_in
+         WRITE(numout,*) '      suffix of sto restart name (output)     cn_storst_out = ', cn_storst_out
+
+         ! WRITE(numout,*) '      stochastic lateral diffusion            ln_sto_ldf    = ', ln_sto_ldf
+         ! WRITE(numout,*) '      lateral diffusion std (in percent)      rn_ldf_std    = ', rn_ldf_std
+         ! WRITE(numout,*) '      lateral diffusion tcor (in timesteps)   rn_ldf_tcor   = ', rn_ldf_tcor
+
+         ! WRITE(numout,*) '      stochastic horizontal pressure gradient ln_sto_hpg    = ', ln_sto_hpg
+         ! WRITE(numout,*) '      density gradient std (in percent)       rn_hpg_std    = ', rn_hpg_std
+         ! WRITE(numout,*) '      density gradient tcor (in timesteps)    rn_hpg_tcor   = ', rn_hpg_tcor
+
+         ! WRITE(numout,*) '      stochastic ice strength                 ln_sto_pstar  = ', ln_sto_pstar
+         ! WRITE(numout,*) '      ice strength std (in percent)           rn_pstar_std  = ', rn_pstar_std
+         ! WRITE(numout,*) '      ice strength tcor (in timesteps)        rn_pstar_tcor = ', rn_pstar_tcor
+         ! WRITE(numout,*) '      order of autoregressive  processes      nn_pstar_ord  = ', nn_pstar_ord
+         ! WRITE(numout,*) '      passes of Laplacian filter              nn_pstar_flt  = ', nn_pstar_flt
+
+         !WRITE(numout,*) '      stochastic trend                        ln_sto_trd    = ', ln_sto_trd
+         !WRITE(numout,*) '      trend std (in percent)                  rn_trd_std    = ', rn_trd_std
+         !WRITE(numout,*) '      trend tcor (in timesteps)               rn_trd_tcor   = ', rn_trd_tcor
+
+         WRITE(numout,*) '      stochastic equation of state            ln_sto_eos    = ', ln_sto_eos
+         WRITE(numout,*) '      number of degrees of freedom            nn_sto_eos    = ', nn_sto_eos
+         WRITE(numout,*) '      random walk horz. std (in grid points)  rn_eos_stdxy  = ', rn_eos_stdxy
+         WRITE(numout,*) '      random walk vert. std (in grid points)  rn_eos_stdz   = ', rn_eos_stdz
+         WRITE(numout,*) '      random walk tcor (in timesteps)         rn_eos_tcor   = ', rn_eos_tcor
+         WRITE(numout,*) '      order of autoregressive  processes      nn_eos_ord    = ', nn_eos_ord
+         WRITE(numout,*) '      passes of Laplacian filter              nn_eos_flt    = ', nn_eos_flt
+         WRITE(numout,*) '      limitation factor                       rn_eos_lim    = ', rn_eos_lim
+
+         ! WRITE(numout,*) '      stochastic tracers dynamics             ln_sto_trc    = ', ln_sto_trc
+         ! WRITE(numout,*) '      number of degrees of freedom            nn_sto_trc    = ', nn_sto_trc
+         ! WRITE(numout,*) '      random walk horz. std (in grid points)  rn_trc_stdxy  = ', rn_trc_stdxy
+         ! WRITE(numout,*) '      random walk vert. std (in grid points)  rn_trc_stdz   = ', rn_trc_stdz
+         ! WRITE(numout,*) '      random walk tcor (in timesteps)         rn_trc_tcor   = ', rn_trc_tcor
+         ! WRITE(numout,*) '      order of autoregressive  processes      nn_trc_ord    = ', nn_trc_ord
+         ! WRITE(numout,*) '      passes of Laplacian filter              nn_trc_flt    = ', nn_trc_flt
+         ! WRITE(numout,*) '      limitation factor                       rn_trc_lim    = ', rn_trc_lim
+
+      ENDIF
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   stochastic parameterization :'
+
+      ! Set number of 2D stochastic arrays
+      jpsto2d = 0
+      IF( ln_sto_ldf ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic lateral diffusion'
+         jpsto2d   = jpsto2d + 1
+         jsto_ldf  = jpsto2d
+      ENDIF
+      IF( ln_sto_pstar ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic ice strength'
+         jpsto2d    = jpsto2d + 1 * nn_pstar_ord
+         jsto_pstar = jpsto2d
+      ENDIF
+      IF( ln_sto_eos ) THEN
+         IF ( lk_agrif ) CALL ctl_stop('EOS stochastic parametrization is not compatible with AGRIF')
+         IF(lwp) WRITE(numout,*) '       - stochastic equation of state'
+         ALLOCATE(jsto_eosi(nn_sto_eos))
+         ALLOCATE(jsto_eosj(nn_sto_eos))
+         ALLOCATE(jsto_eosk(nn_sto_eos))
+         DO jdof = 1, nn_sto_eos
+            jpsto2d   = jpsto2d + 3 * nn_eos_ord
+            jsto_eosi(jdof) = jpsto2d - 2 * nn_eos_ord
+            jsto_eosj(jdof) = jpsto2d - 1 * nn_eos_ord
+            jsto_eosk(jdof) = jpsto2d
+         END DO
+      ELSE
+         nn_sto_eos = 0
+      ENDIF
+      IF( ln_sto_trc ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic tracers dynamics'
+         ALLOCATE(jsto_trci(nn_sto_trc))
+         ALLOCATE(jsto_trcj(nn_sto_trc))
+         ALLOCATE(jsto_trck(nn_sto_trc))
+         DO jdof = 1, nn_sto_trc
+            jpsto2d   = jpsto2d + 3 * nn_trc_ord
+            jsto_trci(jdof) = jpsto2d - 2 * nn_trc_ord
+            jsto_trcj(jdof) = jpsto2d - 1 * nn_trc_ord
+            jsto_trck(jdof) = jpsto2d
+         END DO
+      ELSE
+         nn_sto_trc = 0
+      ENDIF
+
+      ! Set number of 3D stochastic arrays
+      jpsto3d = 0
+      IF( ln_sto_hpg ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic horizontal pressure gradient'
+         jpsto3d   = jpsto3d + 2
+         jsto_hpgi = jpsto3d - 1
+         jsto_hpgj = jpsto3d
+      ENDIF
+      IF( ln_sto_trd ) THEN
+         IF(lwp) WRITE(numout,*) '       - stochastic trend'
+         jpsto3d   = jpsto3d + 1
+         jsto_trd  = jpsto3d
+      ENDIF
+
+      ! Allocate 2D stochastic arrays
+      IF ( jpsto2d > 0 ) THEN
+         ALLOCATE ( sto2d(jpi,jpj,jpsto2d) )
+         ALLOCATE ( sto2d_abc(jpsto2d,3) )
+         ALLOCATE ( sto2d_ave(jpsto2d) )
+         ALLOCATE ( sto2d_std(jpsto2d) )
+         ALLOCATE ( sto2d_lim(jpsto2d) )
+         ALLOCATE ( sto2d_tcor(jpsto2d) )
+         ALLOCATE ( sto2d_ord(jpsto2d) )
+         ALLOCATE ( sto2d_typ(jpsto2d) )
+         ALLOCATE ( sto2d_sgn(jpsto2d) )
+         ALLOCATE ( sto2d_flt(jpsto2d) )
+         ALLOCATE ( sto2d_fac(jpsto2d) )
+      ENDIF
+
+      ! Allocate 3D stochastic arrays
+      IF ( jpsto3d > 0 ) THEN
+         ALLOCATE ( sto3d(jpi,jpj,jpk,jpsto3d) )
+         ALLOCATE ( sto3d_abc(jpsto3d,3) )
+         ALLOCATE ( sto3d_ave(jpsto3d) )
+         ALLOCATE ( sto3d_std(jpsto3d) )
+         ALLOCATE ( sto3d_lim(jpsto3d) )
+         ALLOCATE ( sto3d_tcor(jpsto3d) )
+         ALLOCATE ( sto3d_ord(jpsto3d) )
+         ALLOCATE ( sto3d_typ(jpsto3d) )
+         ALLOCATE ( sto3d_sgn(jpsto3d) )
+         ALLOCATE ( sto3d_flt(jpsto3d) )
+         ALLOCATE ( sto3d_fac(jpsto3d) )
+      ENDIF
+
+      ! Allocate temporary workspace
+      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+         ALLOCATE ( sto_tmp(jpi,jpj) ) ; sto_tmp(:,:) = 0._wp
+      ENDIF
+
+      ! 1) For every stochastic parameter:
+      ! ----------------------------------
+      ! - set nature of grid point and control of the sign
+      !       across the north fold (sto2d_typ, sto2d_sgn)
+      ! - set number of passes of Laplacian filter (sto2d_flt)
+      ! - set order of every autoregressive process (sto2d_ord)
+      DO jsto = 1, jpsto2d
+         sto2d_typ(jsto) = 'T'
+         sto2d_sgn(jsto) = 1._wp
+         sto2d_flt(jsto) = 0
+         sto2d_ord(jsto) = 1
+         DO jord = 0, nn_pstar_ord-1
+            IF ( jsto+jord == jsto_pstar ) THEN ! Stochastic ice strength (ave=1)
+               sto2d_ord(jsto) = nn_pstar_ord - jord
+               sto2d_flt(jsto) = nn_pstar_flt
+            ENDIF
+         ENDDO
+         DO jdof = 1, nn_sto_eos
+         DO jord = 0, nn_eos_ord-1
+            IF ( jsto+jord == jsto_eosi(jdof) ) THEN ! Stochastic equation of state i (ave=0)
+               sto2d_ord(jsto) = nn_eos_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_eos_flt
+            ENDIF
+            IF ( jsto+jord == jsto_eosj(jdof) ) THEN ! Stochastic equation of state j (ave=0)
+               sto2d_ord(jsto) = nn_eos_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_eos_flt
+            ENDIF
+            IF ( jsto+jord == jsto_eosk(jdof) ) THEN ! Stochastic equation of state k (ave=0)
+               sto2d_ord(jsto) = nn_eos_ord - jord
+               sto2d_flt(jsto) = nn_eos_flt
+            ENDIF
+         END DO
+         END DO
+         DO jdof = 1, nn_sto_trc
+         DO jord = 0, nn_trc_ord-1
+            IF ( jsto+jord == jsto_trci(jdof) ) THEN ! Stochastic tracers dynamics i (ave=0)
+               sto2d_ord(jsto) = nn_trc_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_trc_flt
+            ENDIF
+            IF ( jsto+jord == jsto_trcj(jdof) ) THEN ! Stochastic tracers dynamics j (ave=0)
+               sto2d_ord(jsto) = nn_trc_ord - jord
+               sto2d_sgn(jsto) = -1._wp
+               sto2d_flt(jsto) = nn_trc_flt
+            ENDIF
+            IF ( jsto+jord == jsto_trck(jdof) ) THEN ! Stochastic tracers dynamics k (ave=0)
+               sto2d_ord(jsto) = nn_trc_ord - jord
+               sto2d_flt(jsto) = nn_trc_flt
+            ENDIF
+         END DO
+         END DO
+
+         sto2d_fac(jsto) = sto_par_flt_fac ( sto2d_flt(jsto) )
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         sto3d_typ(jsto) = 'T'
+         sto3d_sgn(jsto) = 1._wp
+         sto3d_flt(jsto) = 0
+         sto3d_ord(jsto) = 1
+         IF ( jsto == jsto_hpgi ) THEN ! Stochastic density gradient i (ave=1)
+            sto3d_typ(jsto) = 'U'
+         ENDIF
+         IF ( jsto == jsto_hpgj ) THEN ! Stochastic density gradient j (ave=1)
+            sto3d_typ(jsto) = 'V'
+         ENDIF
+         sto3d_fac(jsto) = sto_par_flt_fac ( sto3d_flt(jsto) )
+      END DO
+
+      ! 2) For every stochastic parameter:
+      ! ----------------------------------
+      ! set average, standard deviation and time correlation
+      DO jsto = 1, jpsto2d
+         sto2d_ave(jsto)  = 0._wp
+         sto2d_std(jsto)  = 1._wp
+         sto2d_tcor(jsto) = 1._wp
+         sto2d_lim(jsto)  = 3._wp
+         IF ( jsto == jsto_ldf  ) THEN ! Stochastic lateral diffusion (ave=1)
+            sto2d_ave(jsto)  = 1._wp
+            sto2d_std(jsto)  = rn_ldf_std
+            sto2d_tcor(jsto) = rn_ldf_tcor
+         ENDIF
+         DO jord = 0, nn_pstar_ord-1
+            IF ( jsto+jord == jsto_pstar ) THEN ! Stochastic ice strength (ave=1)
+               sto2d_std(jsto) = 1._wp
+               sto2d_tcor(jsto) = rn_pstar_tcor
+            ENDIF
+         ENDDO
+         DO jdof = 1, nn_sto_eos
+         DO jord = 0, nn_eos_ord-1
+            IF ( jsto+jord == jsto_eosi(jdof) ) THEN ! Stochastic equation of state i (ave=0)
+               sto2d_std(jsto)  = rn_eos_stdxy
+               sto2d_tcor(jsto) = rn_eos_tcor
+               sto2d_lim(jsto)  = rn_eos_lim
+            ENDIF
+            IF ( jsto+jord == jsto_eosj(jdof) ) THEN ! Stochastic equation of state j (ave=0)
+               sto2d_std(jsto)  = rn_eos_stdxy
+               sto2d_tcor(jsto) = rn_eos_tcor
+               sto2d_lim(jsto)  = rn_eos_lim
+            ENDIF
+            IF ( jsto+jord == jsto_eosk(jdof) ) THEN ! Stochastic equation of state k (ave=0)
+               sto2d_std(jsto)  = rn_eos_stdz
+               sto2d_tcor(jsto) = rn_eos_tcor
+               sto2d_lim(jsto)  = rn_eos_lim
+            ENDIF
+         END DO
+         END DO
+         DO jdof = 1, nn_sto_trc
+         DO jord = 0, nn_trc_ord-1
+            IF ( jsto+jord == jsto_trci(jdof) ) THEN ! Stochastic tracer dynamics i (ave=0)
+               sto2d_std(jsto)  = rn_trc_stdxy
+               sto2d_tcor(jsto) = rn_trc_tcor
+               sto2d_lim(jsto)  = rn_trc_lim
+            ENDIF
+            IF ( jsto+jord == jsto_trcj(jdof) ) THEN ! Stochastic tracer dynamics j (ave=0)
+               sto2d_std(jsto)  = rn_trc_stdxy
+               sto2d_tcor(jsto) = rn_trc_tcor
+               sto2d_lim(jsto)  = rn_trc_lim
+            ENDIF
+            IF ( jsto+jord == jsto_trck(jdof) ) THEN ! Stochastic tracer dynamics k (ave=0)
+               sto2d_std(jsto)  = rn_trc_stdz
+               sto2d_tcor(jsto) = rn_trc_tcor
+               sto2d_lim(jsto)  = rn_trc_lim
+            ENDIF
+         END DO
+         END DO
+
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         sto3d_ave(jsto)  = 0._wp
+         sto3d_std(jsto)  = 1._wp
+         sto3d_tcor(jsto) = 1._wp
+         sto3d_lim(jsto)  = 3._wp
+         IF ( jsto == jsto_hpgi ) THEN ! Stochastic density gradient i (ave=1)
+            sto3d_ave(jsto)  = 1._wp
+            sto3d_std(jsto)  = rn_hpg_std
+            sto3d_tcor(jsto) = rn_hpg_tcor
+         ENDIF
+         IF ( jsto == jsto_hpgj ) THEN ! Stochastic density gradient j (ave=1)
+            sto3d_ave(jsto)  = 1._wp
+            sto3d_std(jsto)  = rn_hpg_std
+            sto3d_tcor(jsto) = rn_hpg_tcor
+         ENDIF
+         IF ( jsto == jsto_trd ) THEN ! Stochastic trend (ave=1)
+            sto3d_ave(jsto)  = 1._wp
+            sto3d_std(jsto)  = rn_trd_std
+            sto3d_tcor(jsto) = rn_trd_tcor
+         ENDIF
+      END DO
+
+      ! 3) For every stochastic parameter:
+      ! ----------------------------------
+      ! - compute parameters (a, b, c) of the AR1 autoregressive process
+      !   from expected value (ave), standard deviation (std)
+      !   and time correlation (tcor):
+      !     a = EXP ( - 1 / tcor )           --> sto2d_abc(:,1)
+      !     b = std * SQRT( 1 - a * a )      --> sto2d_abc(:,2)
+      !     c = ave * ( 1 - a )              --> sto2d_abc(:,3)
+      ! - for higher order processes (ARn, n>1), use approximate formula
+      !   for the b parameter (valid for tcor>>1 time step)
+      DO jsto = 1, jpsto2d
+         IF ( sto2d_tcor(jsto) == 0._wp ) THEN
+            sto2d_abc(jsto,1) = 0._wp
+         ELSE
+            sto2d_abc(jsto,1) = EXP ( - 1._wp / sto2d_tcor(jsto) )
+         ENDIF
+         IF ( sto2d_ord(jsto) == 1 ) THEN      ! Exact formula for 1st order process
+            rinflate = sto2d_std(jsto)
+         ELSE
+            ! Approximate formula, valid for tcor >> 1
+            jordm1 = sto2d_ord(jsto) - 1
+            rinflate = SQRT ( REAL( jordm1 , wp ) / REAL( 2*(2*jordm1-1) , wp ) )
+         ENDIF
+         sto2d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto2d_abc(jsto,1) &
+                                                     * sto2d_abc(jsto,1) )
+         sto2d_abc(jsto,3) = sto2d_ave(jsto) * ( 1._wp - sto2d_abc(jsto,1) )
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         IF ( sto3d_tcor(jsto) == 0._wp ) THEN
+            sto3d_abc(jsto,1) = 0._wp
+         ELSE
+            sto3d_abc(jsto,1) = EXP ( - 1._wp / sto3d_tcor(jsto) )
+         ENDIF
+         IF ( sto3d_ord(jsto) == 1 ) THEN      ! Exact formula for 1st order process
+            rinflate = sto3d_std(jsto)
+         ELSE
+            ! Approximate formula, valid for tcor >> 1
+            jordm1 = sto3d_ord(jsto) - 1
+            rinflate = SQRT ( REAL( jordm1 , wp ) / REAL( 2*(2*jordm1-1) , wp ) )
+         ENDIF
+         sto3d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto3d_abc(jsto,1) &
+                                                     * sto3d_abc(jsto,1) )
+         sto3d_abc(jsto,3) = sto3d_ave(jsto) * ( 1._wp - sto3d_abc(jsto,1) )
+      END DO
+
+      ! 4) Initialize seeds for random number generator
+      ! -----------------------------------------------
+      ! using different seeds for different processors (jarea)
+      ! and different ensemble members (jmem)
+      CALL kiss_reset( )
+      DO jarea = 1, narea
+         !DO jmem = 0, nmember
+         zseed1 = kiss() ; zseed2 = kiss() ; zseed3 = kiss() ; zseed4 = kiss()
+         !END DO
+      END DO
+      CALL kiss_seed( zseed1, zseed2, zseed3, zseed4 )
+
+      ! 5) Initialize stochastic parameters to: ave + std * w
+      ! -----------------------------------------------------
+      DO jsto = 1, jpsto2d
+         ! Draw random numbers from N(0,1) --> w
+         CALL sto_par_white( sto2d(:,:,jsto) )
+         ! Apply horizontal Laplacian filter to w
+         DO jflt = 1, sto2d_flt(jsto)
+            CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+            CALL sto_par_flt( sto2d(:,:,jsto) )
+         END DO
+         ! Factor to restore standard deviation after filtering
+         sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_fac(jsto)
+         ! Limit random parameter to the limitation factor
+         sto2d(:,:,jsto) = SIGN(MIN(sto2d_lim(jsto),ABS(sto2d(:,:,jsto))),sto2d(:,:,jsto))
+         ! Multiply by standard devation and add average value
+         sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_std(jsto) + sto2d_ave(jsto)
+      END DO
+      !
+      DO jsto = 1, jpsto3d
+         DO jk = 1, jpk
+            ! Draw random numbers from N(0,1) --> w
+            CALL sto_par_white( sto3d(:,:,jk,jsto) )
+            ! Apply horizontal Laplacian filter to w
+            DO jflt = 1, sto3d_flt(jsto)
+               CALL lbc_lnk( sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+               CALL sto_par_flt( sto3d(:,:,jk,jsto) )
+            END DO
+            ! Factor to restore standard deviation after filtering
+            sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_fac(jsto)
+            ! Limit random parameter to the limitation factor
+            sto3d(:,:,jk,jsto) = SIGN(MIN(sto3d_lim(jsto),ABS(sto3d(:,:,jk,jsto))),sto3d(:,:,jk,jsto))
+            ! Multiply by standard devation and add average value
+            sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_std(jsto) + sto3d_ave(jsto)
+         END DO
+      END DO
+
+      ! 6) Restart stochastic parameters from file
+      ! ------------------------------------------
+      IF( ln_rststo ) CALL sto_rst_read
+
+   END SUBROUTINE sto_par_init
+
+
+   SUBROUTINE sto_rst_read
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_rst_read  ***
+      !!
+
+      !! ** Purpose :   read stochastic parameters from restart file
+      !!----------------------------------------------------------------------
+
+      INTEGER  :: jsto, jseed
+      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type
+      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart)
+      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name
+
+      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sto_rst_read : read stochastic parameters from restart file'
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         ! Open the restart file
+         CALL iom_open( cn_storst_in, numstor, kiolib = jprstlib )
+
+         ! Get stochastic parameters from restart file:
+         ! 2D stochastic parameters
+         DO jsto = 1 , jpsto2d
+            WRITE(clsto2d(7:9),'(i3.3)') jsto
+            CALL iom_get( numstor, jpdom_autoglo, clsto2d , sto2d(:,:,jsto) )
+         END DO
+         ! 3D stochastic parameters
+         DO jsto = 1 , jpsto3d
+            WRITE(clsto3d(7:9),'(i3.3)') jsto
+            CALL iom_get( numstor, jpdom_autoglo, clsto3d , sto3d(:,:,:,jsto) )
+         END DO
+
+         IF (ln_rstseed) THEN
+            ! Get saved state of the random number generator
+            DO jseed = 1 , 4
+               WRITE(clseed(5:5) ,'(i1.1)') jseed
+               WRITE(clseed(7:10),'(i4.4)') narea
+               CALL iom_get( numstor, clseed , zrseed(jseed) )
+            END DO
+            ziseed = TRANSFER( zrseed , ziseed)
+            CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+         ENDIF
+
+         ! Close the restart file
+         CALL iom_close( numstor )
+
+      ENDIF
+
+   END SUBROUTINE sto_rst_read
+
+
+   SUBROUTINE sto_rst_write( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_rst_write  ***
+      !!
+      !! ** Purpose :   write stochastic parameters in restart file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !!
+      INTEGER  :: jsto, jseed
+      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type
+      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart)
+      CHARACTER(LEN=20)   ::   clkt                ! ocean time-step defined as a character
+      CHARACTER(LEN=50)   ::   clname              ! restart file name
+      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name
+      CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name
+
+      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+
+         IF( kt == nitrst .OR. kt == nitend ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'sto_rst_write : write stochastic parameters in restart file'
+               WRITE(numout,*) '~~~~~~~~~~~~~'
+            ENDIF
+         ENDIF
+
+         ! Put stochastic parameters in restart files
+         ! (as opened at previous timestep, see below)
+         IF( kt > nit000) THEN
+         IF( kt == nitrst .OR. kt == nitend ) THEN
+            ! get and save current state of the random number generator
+            CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+            zrseed = TRANSFER( ziseed , zrseed)
+            DO jseed = 1 , 4
+               WRITE(clseed(5:5) ,'(i1.1)') jseed
+               WRITE(clseed(7:10),'(i4.4)') narea
+               CALL iom_rstput( kt, nitrst, numstow, clseed , zrseed(jseed) )
+            END DO
+            ! 2D stochastic parameters
+            DO jsto = 1 , jpsto2d
+               WRITE(clsto2d(7:9),'(i3.3)') jsto
+               CALL iom_rstput( kt, nitrst, numstow, clsto2d , sto2d(:,:,jsto) )
+            END DO
+            ! 3D stochastic parameters
+            DO jsto = 1 , jpsto3d
+               WRITE(clsto3d(7:9),'(i3.3)') jsto
+               CALL iom_rstput( kt, nitrst, numstow, clsto3d , sto3d(:,:,:,jsto) )
+            END DO
+            ! close the restart file
+            CALL iom_close( numstow )
+         ENDIF
+         ENDIF
+
+         ! Open the restart file one timestep before writing restart
+         IF( kt < nitend) THEN
+         IF( kt == nitrst - 1 .OR. nstock == 1 .OR. kt == nitend-1 ) THEN
+            ! create the filename
+            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_storst_out)
+            ! print information
+            IF(lwp) THEN
+               WRITE(numout,*) '             open stochastic parameters restart file: '//clname
+               IF( kt == nitrst - 1 ) THEN
+                  WRITE(numout,*) '             kt = nitrst - 1 = ', kt
+               ELSE
+                  WRITE(numout,*) '             kt = '             , kt
+               ENDIF
+            ENDIF
+            ! open the restart file
+            CALL iom_open( clname, numstow, ldwrt = .TRUE., kiolib = jprstlib )
+         ENDIF
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE sto_rst_write
+
+
+   SUBROUTINE sto_par_white( psto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par_white  ***
+      !!
+      !! ** Purpose :   fill input array with white Gaussian noise
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto
+      !!
+      INTEGER  :: ji, jj
+      REAL(KIND=8) :: gran   ! Gaussian random number (forced KIND=8 as in kiss_gaussian)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            CALL kiss_gaussian( gran )
+            psto(ji,jj) = gran
+         END DO
+      END DO
+
+   END SUBROUTINE sto_par_white
+
+
+   SUBROUTINE sto_par_flt( psto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_par_flt  ***
+      !!
+      !! ** Purpose :   apply horizontal Laplacian filter to input array
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out)           ::   psto
+      !!
+      INTEGER  :: ji, jj
+
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi-1
+            psto(ji,jj) = 0.5_wp * psto(ji,jj) + 0.125_wp * &
+                              &  ( psto(ji-1,jj) + psto(ji+1,jj) +  &
+                              &    psto(ji,jj-1) + psto(ji,jj+1) )
+         END DO
+      END DO
+
+   END SUBROUTINE sto_par_flt
+
+
+   FUNCTION sto_par_flt_fac( kpasses )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION sto_par_flt_fac  ***
+      !!
+      !! ** Purpose :   compute factor to restore standard deviation
+      !!                as a function of the number of passes
+      !!                of the Laplacian filter
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kpasses
+      REAL(wp) :: sto_par_flt_fac
+      !!
+      INTEGER :: jpasses, ji, jj, jflti, jfltj
+      INTEGER, DIMENSION(-1:1,-1:1) :: pflt0
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pfltb
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pflta
+      REAL(wp) :: ratio
+
+      pflt0(-1,-1) = 0 ; pflt0(-1,0) = 1 ; pflt0(-1,1) = 0
+      pflt0( 0,-1) = 1 ; pflt0( 0,0) = 4 ; pflt0( 0,1) = 1
+      pflt0( 1,-1) = 0 ; pflt0( 1,0) = 1 ; pflt0( 1,1) = 0
+
+      ALLOCATE(pfltb(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+      ALLOCATE(pflta(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+
+      pfltb(:,:) = 0
+      pfltb(0,0) = 1
+      DO jpasses = 1, kpasses
+        pflta(:,:) = 0
+        DO jflti= -1, 1
+        DO jfltj= -1, 1
+          DO ji= -kpasses, kpasses
+          DO jj= -kpasses, kpasses
+            pflta(ji,jj) = pflta(ji,jj) + pfltb(ji+jflti,jj+jfltj) * pflt0(jflti,jfltj)
+          ENDDO
+          ENDDO
+        ENDDO
+        ENDDO
+        pfltb(:,:) = pflta(:,:)
+      ENDDO
+
+      ratio = SUM(pfltb(:,:))
+      ratio = ratio * ratio / SUM(pfltb(:,:)*pfltb(:,:))
+      ratio = SQRT(ratio)
+
+      DEALLOCATE(pfltb,pflta)
+
+      sto_par_flt_fac = ratio
+
+   END FUNCTION sto_par_flt_fac
+
+
+END MODULE stopar
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90	(revision 8732)
@@ -0,0 +1,146 @@
+MODULE stopts
+   !!==============================================================================
+   !!                       ***  MODULE  stopts  ***
+   !! Stochastic parameterization: compute stochastic tracer fluctuations
+   !!==============================================================================
+   !! History :  3.3  ! 2011-12 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sto_pts        : compute current stochastic tracer fluctuations
+   !!   sto_pts_init   : initialisation for stochastic tracer fluctuations
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE stopar          ! stochastic parameterization
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sto_pts         ! called by step.F90
+   PUBLIC   sto_pts_init    ! called by nemogcm.F90
+
+   ! Public array with random tracer fluctuations
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: eosbn2.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sto_pts( pts )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_pts  ***
+      !!
+      !! ** Purpose :   Compute current stochastic tracer fluctuations
+      !!
+      !! ** Method  :   Compute tracer differences from a random walk
+      !!                around every model grid point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) ::   pts   ! 1 : potential temperature  [Celsius]
+      !                                                               ! 2 : salinity               [psu]
+      INTEGER  ::   ji, jj, jk, jts, jdof ! dummy loop indices
+      INTEGER  ::   jim1, jjm1, jkm1  ! incremented indices
+      INTEGER  ::   jip1, jjp1, jkp1  !     -          -
+      REAL(wp) ::   zdtsim, zdtsjm, zdtskm         ! temporary scalars
+      REAL(wp) ::   zdtsip, zdtsjp, zdtskp, zdts   !     -        -
+      !!----------------------------------------------------------------------
+
+      DO jts = 1, jpts
+        CALL lbc_lnk( pts(:,:,:,jts), 'T' , 1._wp )
+      ENDDO
+
+      DO jdof = 1, nn_sto_eos
+        DO jts = 1, jpts
+           DO jk = 1, jpkm1
+              jkm1 = MAX(jk-1,1) ; jkp1 = MIN(jk+1,jpkm1)
+              DO jj = 1, jpj
+                 jjm1 = MAX(jj-1,1) ; jjp1 = MIN(jj+1,jpj)
+                 DO ji = 1, jpi
+                    jim1 = MAX(ji-1,1) ; jip1 = MIN(ji+1,jpi)
+                    !
+                    ! compute tracer gradient
+                    zdtsip = ( pts(jip1,jj,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(jip1,jj,jk)
+                    zdtsim = ( pts(ji,jj,jk,jts) - pts(jim1,jj,jk,jts) ) * tmask(jim1,jj,jk)
+                    zdtsjp = ( pts(ji,jjp1,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jjp1,jk)
+                    zdtsjm = ( pts(ji,jj,jk,jts) - pts(ji,jjm1,jk,jts) ) * tmask(ji,jjm1,jk)
+                    zdtskp = ( pts(ji,jj,jkp1,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jj,jkp1)
+                    zdtskm = ( pts(ji,jj,jk,jts) - pts(ji,jj,jkm1,jts) ) * tmask(ji,jj,jkm1)
+                    !
+                    ! compute random tracer fluctuation (zdts)
+                    zdts   = ( zdtsip + zdtsim ) * sto2d(ji,jj,jsto_eosi(jdof)) + &
+                           & ( zdtsjp + zdtsjm ) * sto2d(ji,jj,jsto_eosj(jdof)) + &
+                           & ( zdtskp + zdtskm ) * sto2d(ji,jj,jsto_eosk(jdof))
+!                   zdts   = zdtsip * MAX(sto2d(ji,jj,jsto_eosi),0._wp) + &
+!                          & zdtsim * MIN(sto2d(ji,jj,jsto_eosi),0._wp) + &
+!                          & zdtsjp * MAX(sto2d(ji,jj,jsto_eosj),0._wp) + &
+!                          & zdtsjm * MIN(sto2d(ji,jj,jsto_eosj),0._wp) + &
+!                          & zdtskp * MAX(sto2d(ji,jj,jsto_eosk),0._wp) + &
+!                          & zdtskm * MIN(sto2d(ji,jj,jsto_eosk),0._wp)
+                    zdts   = zdts  * tmask(ji,jj,jk) *SIN( gphit(ji,jj) * rad )
+                    pts_ran(ji,jj,jk,jts,jdof) = zdts * 0.5_wp
+                    !
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Eliminate any possible negative salinity
+      DO jdof = 1, nn_sto_eos
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) ,  &
+                                                &      MAX(pts(ji,jj,jk,jp_sal),0._wp) )     &
+                                                &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Eliminate any temperature lower than -2 degC
+!     DO jdof = 1, nn_sto_eos
+!        DO jk = 1, jpkm1
+!           DO jj = 1, jpj
+!              DO ji = 1, jpi
+!                 pts_ran(ji,jj,jk,jp_tem,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_tem,jdof)) ,    &
+!                                               &      MAX(pts(ji,jj,jk,jp_tem)+2._wp,0._wp) ) &
+!                                               &  * SIGN(1._wp,pts_ran(ji,jj,jk,jp_tem,jdof))
+!              END DO
+!           END DO
+!        END DO
+!     END DO
+
+
+      ! Lateral boundary conditions on pts_ran
+      DO jdof = 1, nn_sto_eos
+         DO jts = 1, jpts
+            CALL lbc_lnk( pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
+         END DO
+      END DO
+
+   END SUBROUTINE sto_pts
+
+
+   SUBROUTINE sto_pts_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sto_pts_init  ***
+      !!
+      !! ** Purpose :   Initialisation for stochastic tracer fluctuations
+      !!
+      !! ** Method  :   Allocate required array
+      !!
+      !!----------------------------------------------------------------------
+
+      ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
+
+   END SUBROUTINE sto_pts_init
+
+END MODULE stopts
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90	(revision 8732)
@@ -0,0 +1,407 @@
+MODULE storng
+!$AGRIF_DO_NOT_TREAT
+   !!======================================================================
+   !!                       ***  MODULE  storng  ***
+   !! Random number generator, used in NEMO stochastic parameterization
+   !!
+   !!=====================================================================
+   !! History :  3.3  ! 2011-10 (J.-M. Brankart)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! The module is based on (and includes) the
+   !! 64-bit KISS (Keep It Simple Stupid) random number generator
+   !! distributed by George Marsaglia :
+   !! http://groups.google.com/group/comp.lang.fortran/
+   !!        browse_thread/thread/a85bf5f2a97f5a55
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   kiss          : 64-bit KISS random number generator (period ~ 2^250)
+   !!   kiss_seed     : Define seeds for KISS random number generator
+   !!   kiss_state    : Get current state of KISS random number generator
+   !!   kiss_save     : Save current state of KISS (for future restart)
+   !!   kiss_load     : Load the saved state of KISS
+   !!   kiss_reset    : Reset the default seeds
+   !!   kiss_check    : Check the KISS pseudo-random sequence
+   !!   kiss_uniform  : Real random numbers with uniform distribution in [0,1]
+   !!   kiss_gaussian : Real random numbers with Gaussian distribution N(0,1)
+   !!   kiss_gamma    : Real random numbers with Gamma distribution Gamma(k,1)
+   !!   kiss_sample   : Select a random sample from a set of integers
+   !!
+   !!   ---CURRENTLY NOT USED IN NEMO :
+   !!   kiss_save, kiss_load, kiss_check, kiss_gamma, kiss_sample
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   ! Public functions/subroutines
+   PUBLIC :: kiss, kiss_seed, kiss_state, kiss_reset ! kiss_save, kiss_load, kiss_check
+   PUBLIC :: kiss_uniform, kiss_gaussian, kiss_gamma, kiss_sample
+
+   ! Default/initial seeds
+   INTEGER(KIND=i8) :: x=1234567890987654321_8
+   INTEGER(KIND=i8) :: y=362436362436362436_8
+   INTEGER(KIND=i8) :: z=1066149217761810_8
+   INTEGER(KIND=i8) :: w=123456123456123456_8
+
+   ! Parameters to generate real random variates
+   REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0  ! +1
+   REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0
+
+   ! Variables to store 2 Gaussian random numbers with current index (ig)
+   INTEGER(KIND=i8), SAVE :: ig=1
+   REAL(KIND=wp), SAVE :: gran1, gran2
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION kiss()
+      !! --------------------------------------------------------------------
+      !!                  ***  FUNCTION kiss  ***
+      !!
+      !! ** Purpose :   64-bit KISS random number generator
+      !!
+      !! ** Method  :   combine several random number generators:
+      !!                (1) Xorshift (XSH), period 2^64-1,
+      !!                (2) Multiply-with-carry (MWC), period (2^121+2^63-1)
+      !!                (3) Congruential generator (CNG), period 2^64.
+      !!
+      !!                overall period:
+      !!                (2^250+2^192+2^64-2^186-2^129)/6
+      !!                            ~= 2^(247.42) or 10^(74.48)
+      !!
+      !!                set your own seeds with 'kiss_seed'
+      ! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: kiss, t
+
+      t = ISHFT(x,58) + w
+      IF (s(x).eq.s(t)) THEN
+         w = ISHFT(x,-6) + s(x)
+      ELSE
+         w = ISHFT(x,-6) + 1 - s(x+t)
+      ENDIF
+      x = t + x
+      y = m( m( m(y,13_8), -17_8 ), 43_8 )
+      z = 6906969069_8 * z + 1234567_8
+
+      kiss = x + y + z
+
+      CONTAINS
+
+         FUNCTION s(k)
+            INTEGER(KIND=i8) :: s, k
+            s = ISHFT(k,-63)
+         END FUNCTION s
+
+         FUNCTION m(k, n)
+            INTEGER(KIND=i8) :: m, k, n
+            m =  IEOR(k, ISHFT(k, n) )
+         END FUNCTION m
+
+   END FUNCTION kiss
+
+
+   SUBROUTINE kiss_seed(ix, iy, iz, iw)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_seed  ***
+      !!
+      !! ** Purpose :   Define seeds for KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+      x = ix
+      y = iy
+      z = iz
+      w = iw
+
+   END SUBROUTINE kiss_seed
+
+
+   SUBROUTINE kiss_state(ix, iy, iz, iw)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_state  ***
+      !!
+      !! ** Purpose :   Get current state of KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+      ix = x
+      iy = y
+      iz = z
+      iw = w
+
+   END SUBROUTINE kiss_state
+
+
+   SUBROUTINE kiss_reset()
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_reset  ***
+      !!
+      !! ** Purpose :   Reset the default seeds for KISS random number generator
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+
+      x=1234567890987654321_8
+      y=362436362436362436_8
+      z=1066149217761810_8
+      w=123456123456123456_8
+
+    END SUBROUTINE kiss_reset
+
+
+   !  SUBROUTINE kiss_check(check_type)
+   !    !! --------------------------------------------------------------------
+   !    !!                  ***  ROUTINE kiss_check  ***
+   !    !!
+   !    !! ** Purpose :   Check the KISS pseudo-random sequence
+   !    !!
+   !    !! ** Method  :   Check that it reproduces the correct sequence
+   !    !!                from the default seed
+   !    !!
+   !    !! --------------------------------------------------------------------
+   !    IMPLICIT NONE
+   !    INTEGER(KIND=i8) :: iter, niter, correct, iran
+   !    CHARACTER(LEN=*) :: check_type
+   !    LOGICAL :: print_success
+
+   !    ! Save current state of KISS
+   !    CALL kiss_save()
+   !    ! Reset the default seed
+   !    CALL kiss_reset()
+
+   !    ! Select check type
+   !    SELECT CASE(check_type)
+   !    CASE('short')
+   !       niter = 5_8
+   !       correct = 542381058189297533
+   !       print_success = .FALSE.
+   !    CASE('long')
+   !       niter = 100000000_8
+   !       correct = 1666297717051644203 ! Check provided by G. Marsaglia
+   !       print_success = .TRUE.
+   !    CASE('default')
+   !    CASE DEFAULT
+   !       STOP 'Bad check type in kiss_check'
+   !    END SELECT
+
+   !    ! Run kiss for the required number of iterations (niter)
+   !    DO iter=1,niter
+   !       iran = kiss()
+   !    ENDDO
+
+   !    ! Check that last iterate is correct
+   !    IF (iran.NE.correct) THEN
+   !       STOP 'Check failed: KISS internal error !!'
+   !    ELSE
+   !       IF (print_success) PRINT *, 'Check successful: 100 million calls to KISS OK'
+   !    ENDIF
+
+   !    ! Reload the previous state of KISS
+   !    CALL kiss_load()
+
+   ! END SUBROUTINE kiss_check
+
+
+   ! SUBROUTINE kiss_save
+   !    !! --------------------------------------------------------------------
+   !    !!                  ***  ROUTINE kiss_save  ***
+   !    !!
+   !    !! ** Purpose :   Save current state of KISS random number generator
+   !    !!
+   !    !! --------------------------------------------------------------------
+   !    INTEGER :: inum     !! Local integer
+
+   !    IMPLICIT NONE
+
+   !    CALL ctl_opn( inum, '.kiss_restart', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+
+   !    ! OPEN(UNIT=30,FILE='.kiss_restart')
+   !    WRITE(inum,*) x
+   !    WRITE(inum,*) y
+   !    WRITE(inum,*) z
+   !    WRITE(inum,*) w
+   !    CALL flush(inum)
+
+   !  END SUBROUTINE kiss_save
+
+
+   !  SUBROUTINE kiss_load
+   !    !! --------------------------------------------------------------------
+   !    !!                  ***  ROUTINE kiss_load  ***
+   !    !!
+   !    !! ** Purpose :   Load the saved state of KISS random number generator
+   !    !!
+   !    !! --------------------------------------------------------------------
+   !    IMPLICIT NONE
+   !    LOGICAL :: filexists
+   ! Use ctl_opn routine rather than fortran intrinsic functions
+   !    INQUIRE(FILE='.kiss_restart',EXIST=filexists)
+   !    IF (filexists) THEN
+   !       OPEN(UNIT=30,FILE='.kiss_restart')
+   !       READ(30,*) x
+   !       READ(30,*) y
+   !       READ(30,*) z
+   !       READ(30,*) w
+   !       CLOSE(30)
+   !    ENDIF
+
+   ! END SUBROUTINE kiss_load
+
+
+   SUBROUTINE kiss_uniform(uran)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_uniform  ***
+      !!
+      !! ** Purpose :   Real random numbers with uniform distribution in [0,1]
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp) :: uran
+
+      uran = half * ( one + REAL(kiss(),wp) / huge64 )
+
+   END SUBROUTINE kiss_uniform
+
+
+   SUBROUTINE kiss_gaussian(gran)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_gaussian  ***
+      !!
+      !! ** Purpose :   Real random numbers with Gaussian distribution N(0,1)
+      !!
+      !! ** Method  :   Generate 2 new Gaussian draws (gran1 and gran2)
+      !!                from 2 uniform draws on [-1,1] (u1 and u2),
+      !!                using the Marsaglia polar method
+      !!                (see Devroye, Non-Uniform Random Variate Generation, p. 235-236)
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp) :: gran, u1, u2, rsq, fac
+
+      IF (ig.EQ.1) THEN
+         rsq = two
+         DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) )
+            u1 = REAL(kiss(),wp) / huge64
+            u2 = REAL(kiss(),wp) / huge64
+            rsq = u1*u1 + u2*u2
+         ENDDO
+         fac = SQRT(-two*LOG(rsq)/rsq)
+         gran1 = u1 * fac
+         gran2 = u2 * fac
+      ENDIF
+
+      ! Output one of the 2 draws
+      IF (ig.EQ.1) THEN
+         gran = gran1 ; ig = 2
+      ELSE
+         gran = gran2 ; ig = 1
+      ENDIF
+
+   END SUBROUTINE kiss_gaussian
+
+
+   SUBROUTINE kiss_gamma(gamr,k)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_gamma  ***
+      !!
+      !! ** Purpose :   Real random numbers with Gamma distribution Gamma(k,1)
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL(KIND=wp), PARAMETER :: p1 = 4.5_8
+      REAL(KIND=wp), PARAMETER :: p2 = 2.50407739677627_8  ! 1+LOG(9/2)
+      REAL(KIND=wp), PARAMETER :: p3 = 1.38629436111989_8  ! LOG(4)
+      REAL(KIND=wp) :: gamr, k, u1, u2, b, c, d, xx, yy, zz, rr, ee
+      LOGICAL :: accepted
+
+      IF (k.GT.one) THEN
+         ! Cheng's rejection algorithm
+         ! (see Devroye, Non-Uniform Random Variate Generation, p. 413)
+         b = k - p3 ; d = SQRT(two*k-one) ; c = k + d
+
+         accepted=.FALSE.
+         DO WHILE (.NOT.accepted)
+            CALL kiss_uniform(u1)
+            yy = LOG(u1/(one-u1)) / d  ! Mistake in Devroye: "* k" instead of "/ d"
+            xx = k * EXP(yy)
+            rr = b + c * yy - xx
+            CALL kiss_uniform(u2)
+            zz = u1 * u1 * u2
+
+            accepted = rr .GE. (zz*p1-p2)
+            IF (.NOT.accepted) accepted =  rr .GE. LOG(zz)
+         ENDDO
+
+         gamr = xx
+
+      ELSEIF (k.LT.one) THEN
+        ! Rejection from the Weibull density
+        ! (see Devroye, Non-Uniform Random Variate Generation, p. 415)
+        c = one/k ; d = (one-k) * EXP( (k/(one-k)) * LOG(k) )
+
+        accepted=.FALSE.
+        DO WHILE (.NOT.accepted)
+           CALL kiss_uniform(u1)
+           zz = -LOG(u1)
+           xx = EXP( c * LOG(zz) )
+           CALL kiss_uniform(u2)
+           ee = -LOG(u2)
+
+           accepted = (zz+ee) .GE. (d+xx)  ! Mistake in Devroye: "LE" instead of "GE"
+        ENDDO
+
+        gamr = xx
+
+      ELSE
+         ! Exponential distribution
+         CALL kiss_uniform(u1)
+         gamr = -LOG(u1)
+
+      ENDIF
+
+   END SUBROUTINE kiss_gamma
+
+
+   SUBROUTINE kiss_sample(a,n,k)
+      !! --------------------------------------------------------------------
+      !!                  ***  ROUTINE kiss_sample  ***
+      !!
+      !! ** Purpose :   Select a random sample of size k from a set of n integers
+      !!
+      !! ** Method  :   The sample is output in the first k elements of a
+      !!                Set k equal to n to obtain a random permutation
+      !!                  of the whole set of integers
+      !!
+      !! --------------------------------------------------------------------
+      IMPLICIT NONE
+      INTEGER(KIND=i8), DIMENSION(:) :: a
+      INTEGER(KIND=i8) :: n, k, i, j, atmp
+      REAL(KIND=wp) :: uran
+
+      ! Select the sample using the swapping method
+      ! (see Devroye, Non-Uniform Random Variate Generation, p. 612)
+      DO i=1,k
+         ! Randomly select the swapping element between i and n (inclusive)
+         CALL kiss_uniform(uran)
+         j = i - 1 + CEILING( REAL(n-i+1,8) * uran )
+         ! Swap elements i and j
+         atmp = a(i) ; a(i) = a(j) ; a(j) = atmp
+      ENDDO
+
+   END SUBROUTINE kiss_sample
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE storng
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 8732)
@@ -0,0 +1,1704 @@
+MODULE eosbn2
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
+   !!==============================================================================
+   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
+   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
+   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
+   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
+   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
+   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
+   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
+   !!             -   ! 2003-08  (G. Madec)  F90, free form
+   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function (now eos_fzp function)
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add alpha/beta used in ldfslp
+   !!            3.7  ! 2012-03  (F. Roquet, G. Madec)  add primitive of alpha and beta used in PE computation
+   !!             -   ! 2012-05  (F. Roquet)  add Vallis and original JM95 equation of state
+   !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module
+   !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80
+   !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   eos           : generic interface of the equation of state
+   !!   eos_insitu    : Compute the in situ density
+   !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
+   !!   eos_insitu_2d : Compute the in situ density for 2d fields
+   !!   bn2           : Compute the Brunt-Vaisala frequency
+   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio 
+   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio
+   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields
+   !!   eos_fzp_2d    : freezing temperature for 2d fields
+   !!   eos_fzp_0d    : freezing temperature for scalar
+   !!   eos_init      : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE stopar         ! Stochastic T/S fluctuations
+   USE stopts         ! Stochastic T/S fluctuations
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !                  !! * Interface
+   INTERFACE eos
+      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+   END INTERFACE
+   !
+   INTERFACE eos_rab
+      MODULE PROCEDURE rab_3d, rab_2d, rab_0d
+   END INTERFACE
+   !
+   INTERFACE eos_fzp 
+      MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d
+   END INTERFACE
+   !
+   PUBLIC   eos            ! called by step, istate, tranpc and zpsgrd modules
+   PUBLIC   bn2            ! called by step module
+   PUBLIC   eos_rab        ! called by ldfslp, zdfddm, trabbl
+   PUBLIC   eos_pt_from_ct ! called by sbcssm
+   PUBLIC   eos_fzp        ! called by traadv_cen2 and sbcice_... modules
+   PUBLIC   eos_pen        ! used for pe diagnostics in trdpen module
+   PUBLIC   eos_init       ! called by istate module
+
+   !                               !!** Namelist nameos **
+   LOGICAL , PUBLIC ::   ln_TEOS10   ! determine if eos_pt_from_ct is used to compute sst_m
+   LOGICAL , PUBLIC ::   ln_EOS80   ! determine if eos_pt_from_ct is used to compute sst_m
+   LOGICAL , PUBLIC ::   ln_SEOS   ! determine if eos_pt_from_ct is used to compute sst_m
+
+   ! Parameters
+   LOGICAL , PUBLIC    ::   l_useCT         ! =T in ln_TEOS10=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise
+   INTEGER , PUBLIC    ::   neos            ! Identifier for equation of state used
+
+   INTEGER , PARAMETER ::   np_teos10 = -1  ! parameter for using TEOS10
+   INTEGER , PARAMETER ::   np_eos80  =  0  ! parameter for using EOS80
+   INTEGER , PARAMETER ::   np_seos   = 1   ! parameter for using Simplified Equation of state
+
+   !                               !!!  simplified eos coefficients (default value: Vallis 2006)
+   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff. 
+   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff. 
+   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2        
+   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2        
+   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T  
+   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S  
+   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt  
+   
+   ! TEOS10/EOS80 parameters
+   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS
+   
+   ! EOS parameters
+   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600
+   REAL(wp) ::   EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510
+   REAL(wp) ::   EOS020 , EOS120 , EOS220 , EOS320 , EOS420
+   REAL(wp) ::   EOS030 , EOS130 , EOS230 , EOS330
+   REAL(wp) ::   EOS040 , EOS140 , EOS240
+   REAL(wp) ::   EOS050 , EOS150
+   REAL(wp) ::   EOS060
+   REAL(wp) ::   EOS001 , EOS101 , EOS201 , EOS301 , EOS401
+   REAL(wp) ::   EOS011 , EOS111 , EOS211 , EOS311
+   REAL(wp) ::   EOS021 , EOS121 , EOS221
+   REAL(wp) ::   EOS031 , EOS131
+   REAL(wp) ::   EOS041
+   REAL(wp) ::   EOS002 , EOS102 , EOS202
+   REAL(wp) ::   EOS012 , EOS112
+   REAL(wp) ::   EOS022
+   REAL(wp) ::   EOS003 , EOS103
+   REAL(wp) ::   EOS013 
+   
+   ! ALPHA parameters
+   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500
+   REAL(wp) ::   ALP010 , ALP110 , ALP210 , ALP310 , ALP410
+   REAL(wp) ::   ALP020 , ALP120 , ALP220 , ALP320
+   REAL(wp) ::   ALP030 , ALP130 , ALP230
+   REAL(wp) ::   ALP040 , ALP140
+   REAL(wp) ::   ALP050
+   REAL(wp) ::   ALP001 , ALP101 , ALP201 , ALP301
+   REAL(wp) ::   ALP011 , ALP111 , ALP211
+   REAL(wp) ::   ALP021 , ALP121
+   REAL(wp) ::   ALP031
+   REAL(wp) ::   ALP002 , ALP102
+   REAL(wp) ::   ALP012
+   REAL(wp) ::   ALP003
+   
+   ! BETA parameters
+   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500
+   REAL(wp) ::   BET010 , BET110 , BET210 , BET310 , BET410
+   REAL(wp) ::   BET020 , BET120 , BET220 , BET320
+   REAL(wp) ::   BET030 , BET130 , BET230
+   REAL(wp) ::   BET040 , BET140
+   REAL(wp) ::   BET050
+   REAL(wp) ::   BET001 , BET101 , BET201 , BET301
+   REAL(wp) ::   BET011 , BET111 , BET211
+   REAL(wp) ::   BET021 , BET121
+   REAL(wp) ::   BET031
+   REAL(wp) ::   BET002 , BET102
+   REAL(wp) ::   BET012
+   REAL(wp) ::   BET003
+
+   ! PEN parameters
+   REAL(wp) ::   PEN000 , PEN100 , PEN200 , PEN300 , PEN400
+   REAL(wp) ::   PEN010 , PEN110 , PEN210 , PEN310
+   REAL(wp) ::   PEN020 , PEN120 , PEN220
+   REAL(wp) ::   PEN030 , PEN130
+   REAL(wp) ::   PEN040
+   REAL(wp) ::   PEN001 , PEN101 , PEN201
+   REAL(wp) ::   PEN011 , PEN111
+   REAL(wp) ::   PEN021
+   REAL(wp) ::   PEN002 , PEN102
+   REAL(wp) ::   PEN012
+   
+   ! ALPHA_PEN parameters
+   REAL(wp) ::   APE000 , APE100 , APE200 , APE300
+   REAL(wp) ::   APE010 , APE110 , APE210
+   REAL(wp) ::   APE020 , APE120
+   REAL(wp) ::   APE030
+   REAL(wp) ::   APE001 , APE101
+   REAL(wp) ::   APE011
+   REAL(wp) ::   APE002
+
+   ! BETA_PEN parameters
+   REAL(wp) ::   BPE000 , BPE100 , BPE200 , BPE300
+   REAL(wp) ::   BPE010 , BPE110 , BPE210
+   REAL(wp) ::   BPE020 , BPE120
+   REAL(wp) ::   BPE030
+   REAL(wp) ::   BPE001 , BPE101
+   REAL(wp) ::   BPE011
+   REAL(wp) ::   BPE002
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE eos_insitu( pts, prd, pdep )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!       potential temperature and salinity using an equation of state
+      !!       selected in the nameos namelist
+      !!
+      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0
+      !!         with   prd    in situ density anomaly      no units
+      !!                t      TEOS10: CT or EOS80: PT      Celsius
+      !!                s      TEOS10: SA or EOS80: SP      TEOS10: g/kg or EOS80: psu
+      !!                z      depth                        meters
+      !!                rho    in situ density              kg/m^3
+      !!                rau0   reference density            kg/m^3
+      !!
+      !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
+      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg
+      !!
+      !!     ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
+      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu
+      !!
+      !!     ln_seos : simplified equation of state
+      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0
+      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0
+      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
+      !!              Vallis like equation: use default values of coefficients
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :   Roquet et al, Ocean Modelling, in preparation (2014)
+      !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
+      !!                TEOS-10 Manual, 2010
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m]
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos-insitu')
+      !
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm = tmask(ji,jj,jk)                                         ! tmask
+                  !
+                  zn3 = EOS013*zt   &
+                     &   + EOS103*zs+EOS003
+                     !
+                  zn2 = (EOS022*zt   &
+                     &   + EOS112*zs+EOS012)*zt   &
+                     &   + (EOS202*zs+EOS102)*zs+EOS002
+                     !
+                  zn1 = (((EOS041*zt   &
+                     &   + EOS131*zs+EOS031)*zt   &
+                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                     !
+                  zn0 = (((((EOS060*zt   &
+                     &   + EOS150*zs+EOS050)*zt   &
+                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                     !
+                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  !
+                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked)
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
+                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
+                  zh  = pdep (ji,jj,jk)
+                  ztm = tmask(ji,jj,jk)
+                  !
+                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
+                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
+                     &  - rn_nu * zt * zs
+                     !                                 
+                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked)
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos-insitu')
+      !
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
+      !!----------------------------------------------------------------------
+      !!                  ***  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 selected in the
+      !!     namelist.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      !                                                                ! 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)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m]
+      !
+      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
+      INTEGER  ::   jdof
+      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      -
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos-pot')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         ! Stochastic equation of state
+         IF ( ln_sto_eos ) THEN
+            ALLOCATE(zn0_sto(1:2*nn_sto_eos))
+            ALLOCATE(zn_sto(1:2*nn_sto_eos))
+            ALLOCATE(zsign(1:2*nn_sto_eos))
+            DO jsmp = 1, 2*nn_sto_eos, 2
+              zsign(jsmp)   = 1._wp
+              zsign(jsmp+1) = -1._wp
+            END DO
+            !
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !
+                     ! compute density (2*nn_sto_eos) times:
+                     ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts)
+                     ! (2) for t-dt, s-ds (with the opposite fluctuation)
+                     DO jsmp = 1, nn_sto_eos*2
+                        jdof   = (jsmp + 1) / 2
+                        zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                        zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature
+                        zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp)
+                        zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity
+                        ztm    = tmask(ji,jj,jk)                                         ! tmask
+                        !
+                        zn3 = EOS013*zt   &
+                           &   + EOS103*zs+EOS003
+                           !
+                        zn2 = (EOS022*zt   &
+                           &   + EOS112*zs+EOS012)*zt   &
+                           &   + (EOS202*zs+EOS102)*zs+EOS002
+                           !
+                        zn1 = (((EOS041*zt   &
+                           &   + EOS131*zs+EOS031)*zt   &
+                           &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                           &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                           &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                           !
+                        zn0_sto(jsmp) = (((((EOS060*zt   &
+                           &   + EOS150*zs+EOS050)*zt   &
+                           &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                           &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                           &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                           &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                           &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                           !
+                        zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp)
+                     END DO
+                     !
+                     ! compute stochastic density as the mean of the (2*nn_sto_eos) densities
+                     prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp
+                     DO jsmp = 1, nn_sto_eos*2
+                        prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface
+                        !
+                        prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rau0 - 1._wp  )   ! density anomaly (masked)
+                     END DO
+                     prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos
+                     prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos
+                  END DO
+               END DO
+            END DO
+            DEALLOCATE(zn0_sto,zn_sto,zsign)
+         ! Non-stochastic equation of state
+         ELSE
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !
+                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                     ztm = tmask(ji,jj,jk)                                         ! tmask
+                     !
+                     zn3 = EOS013*zt   &
+                        &   + EOS103*zs+EOS003
+                        !
+                     zn2 = (EOS022*zt   &
+                        &   + EOS112*zs+EOS012)*zt   &
+                        &   + (EOS202*zs+EOS102)*zs+EOS002
+                        !
+                     zn1 = (((EOS041*zt   &
+                        &   + EOS131*zs+EOS031)*zt   &
+                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                        !
+                     zn0 = (((((EOS060*zt   &
+                        &   + EOS150*zs+EOS050)*zt   &
+                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                        !
+                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                     !
+                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
+                     !
+                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
+                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
+                  zh  = pdep (ji,jj,jk)
+                  ztm = tmask(ji,jj,jk)
+                  !                                                     ! potential density referenced at the surface
+                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   &
+                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   &
+                     &  - rn_nu * zt * zs
+                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm
+                  !                                                     ! density anomaly (masked)
+                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
+                  prd(ji,jj,jk) = zn * r1_rau0 * ztm
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos-pot')
+      !
+   END SUBROUTINE eos_insitu_pot
+
+
+   SUBROUTINE eos_insitu_2d( pts, 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
+      !!      selected in the nameos namelist. * 2D field case
+      !!
+      !! ** Action  : - prd , the in situ density (no units) (unmasked)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius]
+      !                                                           ! 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, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos2d')
+      !
+      prd(:,:) = 0._wp
+      !
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               !
+               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
+               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+               !
+               zn3 = EOS013*zt   &
+                  &   + EOS103*zs+EOS003
+                  !
+               zn2 = (EOS022*zt   &
+                  &   + EOS112*zs+EOS012)*zt   &
+                  &   + (EOS202*zs+EOS102)*zs+EOS002
+                  !
+               zn1 = (((EOS041*zt   &
+                  &   + EOS131*zs+EOS031)*zt   &
+                  &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                  &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                  &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                  !
+               zn0 = (((((EOS060*zt   &
+                  &   + EOS150*zs+EOS050)*zt   &
+                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                  !
+               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+               !
+               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
+         !
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               !
+               zt    = pts  (ji,jj,jp_tem)  - 10._wp
+               zs    = pts  (ji,jj,jp_sal)  - 35._wp
+               zh    = pdep (ji,jj)                         ! depth at the partial step level
+               !
+               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
+                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
+                  &  - rn_nu * zt * zs
+                  !
+               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos2d')
+      !
+   END SUBROUTINE eos_insitu_2d
+
+
+   SUBROUTINE rab_3d( pts, pab )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE rab_3d  ***
+      !!
+      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points
+      !!
+      !! ** Method  :   calculates alpha / beta at T-points
+      !!
+      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('rab_3d')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
+                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm = tmask(ji,jj,jk)                                         ! tmask
+                  !
+                  ! alpha
+                  zn3 = ALP003
+                  !
+                  zn2 = ALP012*zt + ALP102*zs+ALP002
+                  !
+                  zn1 = ((ALP031*zt   &
+                     &   + ALP121*zs+ALP021)*zt   &
+                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+                     !
+                  zn0 = ((((ALP050*zt   &
+                     &   + ALP140*zs+ALP040)*zt   &
+                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+                     !
+                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  !
+                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm
+                  !
+                  ! beta
+                  zn3 = BET003
+                  !
+                  zn2 = BET012*zt + BET102*zs+BET002
+                  !
+                  zn1 = ((BET031*zt   &
+                     &   + BET121*zs+BET021)*zt   &
+                     &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+                     !
+                  zn0 = ((((BET050*zt   &
+                     &   + BET140*zs+BET040)*zt   &
+                     &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+                     !
+                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  !
+                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE( np_seos )                  !==  simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point
+                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
+                  !
+                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha
+                  !
+                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
+         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('rab_3d')
+      !
+   END SUBROUTINE rab_3d
+
+
+   SUBROUTINE rab_2d( pts, pdep, pab )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE rab_2d  ***
+      !!
+      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked)
+      !!
+      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('rab_2d')
+      !
+      pab(:,:,:) = 0._wp
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               !
+               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
+               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+               !
+               ! alpha
+               zn3 = ALP003
+               !
+               zn2 = ALP012*zt + ALP102*zs+ALP002
+               !
+               zn1 = ((ALP031*zt   &
+                  &   + ALP121*zs+ALP021)*zt   &
+                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+                  !
+               zn0 = ((((ALP050*zt   &
+                  &   + ALP140*zs+ALP040)*zt   &
+                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+                  !
+               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+               !
+               pab(ji,jj,jp_tem) = zn * r1_rau0
+               !
+               ! beta
+               zn3 = BET003
+               !
+               zn2 = BET012*zt + BET102*zs+BET002
+               !
+               zn1 = ((BET031*zt   &
+                  &   + BET121*zs+BET021)*zt   &
+                  &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+                  !
+               zn0 = ((((BET050*zt   &
+                  &   + BET140*zs+BET040)*zt   &
+                  &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+                  !
+               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+               !
+               pab(ji,jj,jp_sal) = zn / zs * r1_rau0
+               !
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions
+         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
+         !
+      CASE( np_seos )                  !==  simplified EOS  ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               !
+               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+               zh    = pdep (ji,jj)                   ! depth at the partial step level
+               !
+               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha
+               !
+               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions
+         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
+         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('rab_2d')
+      !
+   END SUBROUTINE rab_2d
+
+
+   SUBROUTINE rab_0d( pts, pdep, pab )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE rab_0d  ***
+      !!
+      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked)
+      !!
+      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
+      REAL(wp),                      INTENT(in   ) ::   pdep   ! depth                  [m]
+      REAL(wp), DIMENSION(jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio
+      !
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('rab_2d')
+      !
+      pab(:) = 0._wp
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )      !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         !
+         zh  = pdep * r1_Z0                                  ! depth
+         zt  = pts (jp_tem) * r1_T0                           ! temperature
+         zs  = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+         !
+         ! alpha
+         zn3 = ALP003
+         !
+         zn2 = ALP012*zt + ALP102*zs+ALP002
+         !
+         zn1 = ((ALP031*zt   &
+            &   + ALP121*zs+ALP021)*zt   &
+            &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+            &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+            !
+         zn0 = ((((ALP050*zt   &
+            &   + ALP140*zs+ALP040)*zt   &
+            &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+            &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+            &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+            &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+            !
+         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+         !
+         pab(jp_tem) = zn * r1_rau0
+         !
+         ! beta
+         zn3 = BET003
+         !
+         zn2 = BET012*zt + BET102*zs+BET002
+         !
+         zn1 = ((BET031*zt   &
+            &   + BET121*zs+BET021)*zt   &
+            &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+            &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+            !
+         zn0 = ((((BET050*zt   &
+            &   + BET140*zs+BET040)*zt   &
+            &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+            &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+            &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+            &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+            !
+         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+         !
+         pab(jp_sal) = zn / zs * r1_rau0
+         !
+         !
+         !
+      CASE( np_seos )                  !==  simplified EOS  ==!
+         !
+         zt    = pts(jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+         zs    = pts(jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+         zh    = pdep                   ! depth at the partial step level
+         !
+         zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+         pab(jp_tem) = zn * r1_rau0   ! alpha
+         !
+         zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+         pab(jp_sal) = zn * r1_rau0   ! beta
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('rab_2d')
+      !
+   END SUBROUTINE rab_0d
+
+
+   SUBROUTINE bn2( pts, pab, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the 
+      !!                time-step of the input arguments
+      !!
+      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w
+      !!      where alpha and beta are given in pab, and computed on T-points.
+      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module.
+      !!
+      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point 
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2]
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   zaw, zbw, zrw   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bn2')
+      !
+      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 )
+         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90
+            DO ji = 1, jpi
+               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
+                  !
+               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
+               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
+               !
+               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
+                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
+                  &            / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bn2')
+      !
+   END SUBROUTINE bn2
+
+
+   FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_pt_from_ct  ***
+      !!
+      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celsius]
+      !!
+      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm
+      !!       checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC
+      !!
+      !! Reference  :   TEOS-10, UNESCO
+      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp   [Celsius]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity     [psu]
+      ! Leave result array automatic rather than making explicitly allocated
+      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celsius]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zt , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zd              ! local scalars
+      REAL(wp) ::   zdeltaS , z1_S0 , z1_T0
+      !!----------------------------------------------------------------------
+      !
+      IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct')
+      !
+      zdeltaS = 5._wp
+      z1_S0   = 0.875_wp/35.16504_wp
+      z1_T0   = 1._wp/40._wp
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zt  = ctmp   (ji,jj) * z1_T0
+            zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 )
+            ztm = tmask(ji,jj,1)
+            !
+            zn = ((((-2.1385727895e-01_wp*zt   &
+               &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   &
+               &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   &
+               &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   &
+               &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   &
+               &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   &
+               &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   &
+               &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
+               !
+            zd = (2.0035003456_wp*zt   &
+               &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   &
+               &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
+               !
+            ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
+               !
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct')
+      !
+   END FUNCTION eos_pt_from_ct
+
+
+   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_fzp  ***
+      !!
+      !! ** Purpose :   Compute the freezing point temperature [Celsius]
+      !!
+      !! ** Method  :   UNESCO freezing point (ptf) in Celsius is given by
+      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
+      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
+      !!
+      !! 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), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius]
+      !
+      INTEGER  ::   ji, jj          ! dummy loop indices
+      REAL(wp) ::   zt, zs, z1_S0   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( neos )
+      !
+      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
+         !
+         z1_S0 = 1._wp / 35.16504_wp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity
+               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+            END DO
+         END DO
+         ptf(:,:) = ptf(:,:) * psal(:,:)
+         !
+         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+         !
+      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
+         !
+         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
+            !
+         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT      
+      !
+  END SUBROUTINE eos_fzp_2d
+
+
+  SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_fzp  ***
+      !!
+      !! ** Purpose :   Compute the freezing point temperature [Celsius]
+      !!
+      !! ** Method  :   UNESCO freezing point (ptf) in Celsius is given by
+      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
+      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
+      !!
+      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu]
+      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m]
+      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celsius]
+      !
+      REAL(wp) :: zs   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( neos )
+      !
+      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
+         !
+         zs  = SQRT( ABS( psal ) / 35.16504_wp )           ! square root salinity
+         ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+         ptf = ptf * psal
+         !
+         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
+         !
+      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
+         !
+         ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   &
+            &                - 2.154996e-4_wp *       psal   ) * psal
+            !
+         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_fzp_0d
+
+
+   SUBROUTINE eos_pen( pts, pab_pe, ppen )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_pen  ***
+      !!
+      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points
+      !!
+      !! ** Method  :   PE is defined analytically as the vertical 
+      !!                   primitive of EOS times -g integrated between 0 and z>0.
+      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd
+      !!                                                      = 1/z * /int_0^z rd dz - rd 
+      !!                                where rd is the density anomaly (see eos_rhd function)
+      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S:
+      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT
+      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS
+      !!
+      !! ** Action  : - pen         : PE anomaly given at T-points
+      !!            : - pab_pe  : given at T-points
+      !!                    pab_pe(:,:,:,jp_tem) is alpha_pe
+      !!                    pab_pe(:,:,:,jp_sal) is beta_pe
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   ppen     ! potential energy anomaly
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos_pen')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
+                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm = tmask(ji,jj,jk)                                         ! tmask
+                  !
+                  ! potential energy non-linear anomaly
+                  zn2 = (PEN012)*zt   &
+                     &   + PEN102*zs+PEN002
+                     !
+                  zn1 = ((PEN021)*zt   &
+                     &   + PEN111*zs+PEN011)*zt   &
+                     &   + (PEN201*zs+PEN101)*zs+PEN001
+                     !
+                  zn0 = ((((PEN040)*zt   &
+                     &   + PEN130*zs+PEN030)*zt   &
+                     &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   &
+                     &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   &
+                     &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
+                     !
+                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
+                  !
+                  ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm
+                  !
+                  ! alphaPE non-linear anomaly
+                  zn2 = APE002
+                  !
+                  zn1 = (APE011)*zt   &
+                     &   + APE101*zs+APE001
+                     !
+                  zn0 = (((APE030)*zt   &
+                     &   + APE120*zs+APE020)*zt   &
+                     &   + (APE210*zs+APE110)*zs+APE010)*zt   &
+                     &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
+                     !
+                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
+                  !                              
+                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm
+                  !
+                  ! betaPE non-linear anomaly
+                  zn2 = BPE002
+                  !
+                  zn1 = (BPE011)*zt   &
+                     &   + BPE101*zs+BPE001
+                     !
+                  zn0 = (((BPE030)*zt   &
+                     &   + BPE120*zs+BPE020)*zt   &
+                     &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   &
+                     &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
+                     !
+                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
+                  !                              
+                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
+                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
+                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point
+                  ztm = tmask(ji,jj,jk)                ! tmask
+                  zn  = 0.5_wp * zh * r1_rau0 * ztm
+                  !                                    ! Potential Energy
+                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
+                  !                                    ! alphaPE
+                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
+                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos_pen')
+      !
+   END SUBROUTINE eos_pen
+
+
+   SUBROUTINE eos_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos and control the parameters
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ios   ! local integer
+      INTEGER  ::   ioptio   ! local integer
+      !!
+      NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, rn_a0, rn_b0, rn_lambda1, rn_mu1,   &
+         &                                             rn_lambda2, rn_mu2, rn_nu
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state
+      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state
+      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, nameos )
+      !
+      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
+      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K]
+      !
+      IF(lwp) THEN                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist nameos : Chosen the Equation Of Seawater (EOS)'
+         WRITE(numout,*) '      TEOS-10 : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_TEOS10 = ', ln_TEOS10
+         WRITE(numout,*) '      EOS-80  : rho=F(Potential    Temperature, Practical Salinity, depth)   ln_EOS80  = ', ln_EOS80
+         WRITE(numout,*) '      S-EOS   : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_SEOS   = ', ln_SEOS
+      ENDIF
+
+      ! Check options for equation of state & set neos based on logical flags
+      ioptio = 0
+      IF( ln_TEOS10 ) THEN   ;   ioptio = ioptio+1   ;   neos = np_teos10   ;   ENDIF
+      IF( ln_EOS80  ) THEN   ;   ioptio = ioptio+1   ;   neos = np_eos80    ;   ENDIF
+      IF( ln_SEOS   ) THEN   ;   ioptio = ioptio+1   ;   neos = np_seos     ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop("Exactly one equation of state option must be selected")
+      !
+      SELECT CASE( neos )         ! check option
+      !
+      CASE( np_teos10 )                       !==  polynomial TEOS-10  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)'
+         !
+         l_useCT = .TRUE.                          ! model temperature is Conservative temperature 
+         !
+         rdeltaS = 32._wp
+         r1_S0  = 0.875_wp/35.16504_wp
+         r1_T0  = 1._wp/40._wp
+         r1_Z0  = 1.e-4_wp
+         !
+         EOS000 = 8.0189615746e+02_wp
+         EOS100 = 8.6672408165e+02_wp
+         EOS200 = -1.7864682637e+03_wp
+         EOS300 = 2.0375295546e+03_wp
+         EOS400 = -1.2849161071e+03_wp
+         EOS500 = 4.3227585684e+02_wp
+         EOS600 = -6.0579916612e+01_wp
+         EOS010 = 2.6010145068e+01_wp
+         EOS110 = -6.5281885265e+01_wp
+         EOS210 = 8.1770425108e+01_wp
+         EOS310 = -5.6888046321e+01_wp
+         EOS410 = 1.7681814114e+01_wp
+         EOS510 = -1.9193502195_wp
+         EOS020 = -3.7074170417e+01_wp
+         EOS120 = 6.1548258127e+01_wp
+         EOS220 = -6.0362551501e+01_wp
+         EOS320 = 2.9130021253e+01_wp
+         EOS420 = -5.4723692739_wp
+         EOS030 = 2.1661789529e+01_wp
+         EOS130 = -3.3449108469e+01_wp
+         EOS230 = 1.9717078466e+01_wp
+         EOS330 = -3.1742946532_wp
+         EOS040 = -8.3627885467_wp
+         EOS140 = 1.1311538584e+01_wp
+         EOS240 = -5.3563304045_wp
+         EOS050 = 5.4048723791e-01_wp
+         EOS150 = 4.8169980163e-01_wp
+         EOS060 = -1.9083568888e-01_wp
+         EOS001 = 1.9681925209e+01_wp
+         EOS101 = -4.2549998214e+01_wp
+         EOS201 = 5.0774768218e+01_wp
+         EOS301 = -3.0938076334e+01_wp
+         EOS401 = 6.6051753097_wp
+         EOS011 = -1.3336301113e+01_wp
+         EOS111 = -4.4870114575_wp
+         EOS211 = 5.0042598061_wp
+         EOS311 = -6.5399043664e-01_wp
+         EOS021 = 6.7080479603_wp
+         EOS121 = 3.5063081279_wp
+         EOS221 = -1.8795372996_wp
+         EOS031 = -2.4649669534_wp
+         EOS131 = -5.5077101279e-01_wp
+         EOS041 = 5.5927935970e-01_wp
+         EOS002 = 2.0660924175_wp
+         EOS102 = -4.9527603989_wp
+         EOS202 = 2.5019633244_wp
+         EOS012 = 2.0564311499_wp
+         EOS112 = -2.1311365518e-01_wp
+         EOS022 = -1.2419983026_wp
+         EOS003 = -2.3342758797e-02_wp
+         EOS103 = -1.8507636718e-02_wp
+         EOS013 = 3.7969820455e-01_wp
+         !
+         ALP000 = -6.5025362670e-01_wp
+         ALP100 = 1.6320471316_wp
+         ALP200 = -2.0442606277_wp
+         ALP300 = 1.4222011580_wp
+         ALP400 = -4.4204535284e-01_wp
+         ALP500 = 4.7983755487e-02_wp
+         ALP010 = 1.8537085209_wp
+         ALP110 = -3.0774129064_wp
+         ALP210 = 3.0181275751_wp
+         ALP310 = -1.4565010626_wp
+         ALP410 = 2.7361846370e-01_wp
+         ALP020 = -1.6246342147_wp
+         ALP120 = 2.5086831352_wp
+         ALP220 = -1.4787808849_wp
+         ALP320 = 2.3807209899e-01_wp
+         ALP030 = 8.3627885467e-01_wp
+         ALP130 = -1.1311538584_wp
+         ALP230 = 5.3563304045e-01_wp
+         ALP040 = -6.7560904739e-02_wp
+         ALP140 = -6.0212475204e-02_wp
+         ALP050 = 2.8625353333e-02_wp
+         ALP001 = 3.3340752782e-01_wp
+         ALP101 = 1.1217528644e-01_wp
+         ALP201 = -1.2510649515e-01_wp
+         ALP301 = 1.6349760916e-02_wp
+         ALP011 = -3.3540239802e-01_wp
+         ALP111 = -1.7531540640e-01_wp
+         ALP211 = 9.3976864981e-02_wp
+         ALP021 = 1.8487252150e-01_wp
+         ALP121 = 4.1307825959e-02_wp
+         ALP031 = -5.5927935970e-02_wp
+         ALP002 = -5.1410778748e-02_wp
+         ALP102 = 5.3278413794e-03_wp
+         ALP012 = 6.2099915132e-02_wp
+         ALP003 = -9.4924551138e-03_wp
+         !
+         BET000 = 1.0783203594e+01_wp
+         BET100 = -4.4452095908e+01_wp
+         BET200 = 7.6048755820e+01_wp
+         BET300 = -6.3944280668e+01_wp
+         BET400 = 2.6890441098e+01_wp
+         BET500 = -4.5221697773_wp
+         BET010 = -8.1219372432e-01_wp
+         BET110 = 2.0346663041_wp
+         BET210 = -2.1232895170_wp
+         BET310 = 8.7994140485e-01_wp
+         BET410 = -1.1939638360e-01_wp
+         BET020 = 7.6574242289e-01_wp
+         BET120 = -1.5019813020_wp
+         BET220 = 1.0872489522_wp
+         BET320 = -2.7233429080e-01_wp
+         BET030 = -4.1615152308e-01_wp
+         BET130 = 4.9061350869e-01_wp
+         BET230 = -1.1847737788e-01_wp
+         BET040 = 1.4073062708e-01_wp
+         BET140 = -1.3327978879e-01_wp
+         BET050 = 5.9929880134e-03_wp
+         BET001 = -5.2937873009e-01_wp
+         BET101 = 1.2634116779_wp
+         BET201 = -1.1547328025_wp
+         BET301 = 3.2870876279e-01_wp
+         BET011 = -5.5824407214e-02_wp
+         BET111 = 1.2451933313e-01_wp
+         BET211 = -2.4409539932e-02_wp
+         BET021 = 4.3623149752e-02_wp
+         BET121 = -4.6767901790e-02_wp
+         BET031 = -6.8523260060e-03_wp
+         BET002 = -6.1618945251e-02_wp
+         BET102 = 6.2255521644e-02_wp
+         BET012 = -2.6514181169e-03_wp
+         BET003 = -2.3025968587e-04_wp
+         !
+         PEN000 = -9.8409626043_wp
+         PEN100 = 2.1274999107e+01_wp
+         PEN200 = -2.5387384109e+01_wp
+         PEN300 = 1.5469038167e+01_wp
+         PEN400 = -3.3025876549_wp
+         PEN010 = 6.6681505563_wp
+         PEN110 = 2.2435057288_wp
+         PEN210 = -2.5021299030_wp
+         PEN310 = 3.2699521832e-01_wp
+         PEN020 = -3.3540239802_wp
+         PEN120 = -1.7531540640_wp
+         PEN220 = 9.3976864981e-01_wp
+         PEN030 = 1.2324834767_wp
+         PEN130 = 2.7538550639e-01_wp
+         PEN040 = -2.7963967985e-01_wp
+         PEN001 = -1.3773949450_wp
+         PEN101 = 3.3018402659_wp
+         PEN201 = -1.6679755496_wp
+         PEN011 = -1.3709540999_wp
+         PEN111 = 1.4207577012e-01_wp
+         PEN021 = 8.2799886843e-01_wp
+         PEN002 = 1.7507069098e-02_wp
+         PEN102 = 1.3880727538e-02_wp
+         PEN012 = -2.8477365341e-01_wp
+         !
+         APE000 = -1.6670376391e-01_wp
+         APE100 = -5.6087643219e-02_wp
+         APE200 = 6.2553247576e-02_wp
+         APE300 = -8.1748804580e-03_wp
+         APE010 = 1.6770119901e-01_wp
+         APE110 = 8.7657703198e-02_wp
+         APE210 = -4.6988432490e-02_wp
+         APE020 = -9.2436260751e-02_wp
+         APE120 = -2.0653912979e-02_wp
+         APE030 = 2.7963967985e-02_wp
+         APE001 = 3.4273852498e-02_wp
+         APE101 = -3.5518942529e-03_wp
+         APE011 = -4.1399943421e-02_wp
+         APE002 = 7.1193413354e-03_wp
+         !
+         BPE000 = 2.6468936504e-01_wp
+         BPE100 = -6.3170583896e-01_wp
+         BPE200 = 5.7736640125e-01_wp
+         BPE300 = -1.6435438140e-01_wp
+         BPE010 = 2.7912203607e-02_wp
+         BPE110 = -6.2259666565e-02_wp
+         BPE210 = 1.2204769966e-02_wp
+         BPE020 = -2.1811574876e-02_wp
+         BPE120 = 2.3383950895e-02_wp
+         BPE030 = 3.4261630030e-03_wp
+         BPE001 = 4.1079296834e-02_wp
+         BPE101 = -4.1503681096e-02_wp
+         BPE011 = 1.7676120780e-03_wp
+         BPE002 = 1.7269476440e-04_wp
+         !
+      CASE( np_eos80 )                        !==  polynomial EOS-80 formulation  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)'
+         !
+         l_useCT = .FALSE.                         ! model temperature is Potential temperature
+         rdeltaS = 20._wp
+         r1_S0  = 1._wp/40._wp
+         r1_T0  = 1._wp/40._wp
+         r1_Z0  = 1.e-4_wp
+         !
+         EOS000 = 9.5356891948e+02_wp
+         EOS100 = 1.7136499189e+02_wp
+         EOS200 = -3.7501039454e+02_wp
+         EOS300 = 5.1856810420e+02_wp
+         EOS400 = -3.7264470465e+02_wp
+         EOS500 = 1.4302533998e+02_wp
+         EOS600 = -2.2856621162e+01_wp
+         EOS010 = 1.0087518651e+01_wp
+         EOS110 = -1.3647741861e+01_wp
+         EOS210 = 8.8478359933_wp
+         EOS310 = -7.2329388377_wp
+         EOS410 = 1.4774410611_wp
+         EOS510 = 2.0036720553e-01_wp
+         EOS020 = -2.5579830599e+01_wp
+         EOS120 = 2.4043512327e+01_wp
+         EOS220 = -1.6807503990e+01_wp
+         EOS320 = 8.3811577084_wp
+         EOS420 = -1.9771060192_wp
+         EOS030 = 1.6846451198e+01_wp
+         EOS130 = -2.1482926901e+01_wp
+         EOS230 = 1.0108954054e+01_wp
+         EOS330 = -6.2675951440e-01_wp
+         EOS040 = -8.0812310102_wp
+         EOS140 = 1.0102374985e+01_wp
+         EOS240 = -4.8340368631_wp
+         EOS050 = 1.2079167803_wp
+         EOS150 = 1.1515380987e-01_wp
+         EOS060 = -2.4520288837e-01_wp
+         EOS001 = 1.0748601068e+01_wp
+         EOS101 = -1.7817043500e+01_wp
+         EOS201 = 2.2181366768e+01_wp
+         EOS301 = -1.6750916338e+01_wp
+         EOS401 = 4.1202230403_wp
+         EOS011 = -1.5852644587e+01_wp
+         EOS111 = -7.6639383522e-01_wp
+         EOS211 = 4.1144627302_wp
+         EOS311 = -6.6955877448e-01_wp
+         EOS021 = 9.9994861860_wp
+         EOS121 = -1.9467067787e-01_wp
+         EOS221 = -1.2177554330_wp
+         EOS031 = -3.4866102017_wp
+         EOS131 = 2.2229155620e-01_wp
+         EOS041 = 5.9503008642e-01_wp
+         EOS002 = 1.0375676547_wp
+         EOS102 = -3.4249470629_wp
+         EOS202 = 2.0542026429_wp
+         EOS012 = 2.1836324814_wp
+         EOS112 = -3.4453674320e-01_wp
+         EOS022 = -1.2548163097_wp
+         EOS003 = 1.8729078427e-02_wp
+         EOS103 = -5.7238495240e-02_wp
+         EOS013 = 3.8306136687e-01_wp
+         !
+         ALP000 = -2.5218796628e-01_wp
+         ALP100 = 3.4119354654e-01_wp
+         ALP200 = -2.2119589983e-01_wp
+         ALP300 = 1.8082347094e-01_wp
+         ALP400 = -3.6936026529e-02_wp
+         ALP500 = -5.0091801383e-03_wp
+         ALP010 = 1.2789915300_wp
+         ALP110 = -1.2021756164_wp
+         ALP210 = 8.4037519952e-01_wp
+         ALP310 = -4.1905788542e-01_wp
+         ALP410 = 9.8855300959e-02_wp
+         ALP020 = -1.2634838399_wp
+         ALP120 = 1.6112195176_wp
+         ALP220 = -7.5817155402e-01_wp
+         ALP320 = 4.7006963580e-02_wp
+         ALP030 = 8.0812310102e-01_wp
+         ALP130 = -1.0102374985_wp
+         ALP230 = 4.8340368631e-01_wp
+         ALP040 = -1.5098959754e-01_wp
+         ALP140 = -1.4394226233e-02_wp
+         ALP050 = 3.6780433255e-02_wp
+         ALP001 = 3.9631611467e-01_wp
+         ALP101 = 1.9159845880e-02_wp
+         ALP201 = -1.0286156825e-01_wp
+         ALP301 = 1.6738969362e-02_wp
+         ALP011 = -4.9997430930e-01_wp
+         ALP111 = 9.7335338937e-03_wp
+         ALP211 = 6.0887771651e-02_wp
+         ALP021 = 2.6149576513e-01_wp
+         ALP121 = -1.6671866715e-02_wp
+         ALP031 = -5.9503008642e-02_wp
+         ALP002 = -5.4590812035e-02_wp
+         ALP102 = 8.6134185799e-03_wp
+         ALP012 = 6.2740815484e-02_wp
+         ALP003 = -9.5765341718e-03_wp
+         !
+         BET000 = 2.1420623987_wp
+         BET100 = -9.3752598635_wp
+         BET200 = 1.9446303907e+01_wp
+         BET300 = -1.8632235232e+01_wp
+         BET400 = 8.9390837485_wp
+         BET500 = -1.7142465871_wp
+         BET010 = -1.7059677327e-01_wp
+         BET110 = 2.2119589983e-01_wp
+         BET210 = -2.7123520642e-01_wp
+         BET310 = 7.3872053057e-02_wp
+         BET410 = 1.2522950346e-02_wp
+         BET020 = 3.0054390409e-01_wp
+         BET120 = -4.2018759976e-01_wp
+         BET220 = 3.1429341406e-01_wp
+         BET320 = -9.8855300959e-02_wp
+         BET030 = -2.6853658626e-01_wp
+         BET130 = 2.5272385134e-01_wp
+         BET230 = -2.3503481790e-02_wp
+         BET040 = 1.2627968731e-01_wp
+         BET140 = -1.2085092158e-01_wp
+         BET050 = 1.4394226233e-03_wp
+         BET001 = -2.2271304375e-01_wp
+         BET101 = 5.5453416919e-01_wp
+         BET201 = -6.2815936268e-01_wp
+         BET301 = 2.0601115202e-01_wp
+         BET011 = -9.5799229402e-03_wp
+         BET111 = 1.0286156825e-01_wp
+         BET211 = -2.5108454043e-02_wp
+         BET021 = -2.4333834734e-03_wp
+         BET121 = -3.0443885826e-02_wp
+         BET031 = 2.7786444526e-03_wp
+         BET002 = -4.2811838287e-02_wp
+         BET102 = 5.1355066072e-02_wp
+         BET012 = -4.3067092900e-03_wp
+         BET003 = -7.1548119050e-04_wp
+         !
+         PEN000 = -5.3743005340_wp
+         PEN100 = 8.9085217499_wp
+         PEN200 = -1.1090683384e+01_wp
+         PEN300 = 8.3754581690_wp
+         PEN400 = -2.0601115202_wp
+         PEN010 = 7.9263222935_wp
+         PEN110 = 3.8319691761e-01_wp
+         PEN210 = -2.0572313651_wp
+         PEN310 = 3.3477938724e-01_wp
+         PEN020 = -4.9997430930_wp
+         PEN120 = 9.7335338937e-02_wp
+         PEN220 = 6.0887771651e-01_wp
+         PEN030 = 1.7433051009_wp
+         PEN130 = -1.1114577810e-01_wp
+         PEN040 = -2.9751504321e-01_wp
+         PEN001 = -6.9171176978e-01_wp
+         PEN101 = 2.2832980419_wp
+         PEN201 = -1.3694684286_wp
+         PEN011 = -1.4557549876_wp
+         PEN111 = 2.2969116213e-01_wp
+         PEN021 = 8.3654420645e-01_wp
+         PEN002 = -1.4046808820e-02_wp
+         PEN102 = 4.2928871430e-02_wp
+         PEN012 = -2.8729602515e-01_wp
+         !
+         APE000 = -1.9815805734e-01_wp
+         APE100 = -9.5799229402e-03_wp
+         APE200 = 5.1430784127e-02_wp
+         APE300 = -8.3694846809e-03_wp
+         APE010 = 2.4998715465e-01_wp
+         APE110 = -4.8667669469e-03_wp
+         APE210 = -3.0443885826e-02_wp
+         APE020 = -1.3074788257e-01_wp
+         APE120 = 8.3359333577e-03_wp
+         APE030 = 2.9751504321e-02_wp
+         APE001 = 3.6393874690e-02_wp
+         APE101 = -5.7422790533e-03_wp
+         APE011 = -4.1827210323e-02_wp
+         APE002 = 7.1824006288e-03_wp
+         !
+         BPE000 = 1.1135652187e-01_wp
+         BPE100 = -2.7726708459e-01_wp
+         BPE200 = 3.1407968134e-01_wp
+         BPE300 = -1.0300557601e-01_wp
+         BPE010 = 4.7899614701e-03_wp
+         BPE110 = -5.1430784127e-02_wp
+         BPE210 = 1.2554227021e-02_wp
+         BPE020 = 1.2166917367e-03_wp
+         BPE120 = 1.5221942913e-02_wp
+         BPE030 = -1.3893222263e-03_wp
+         BPE001 = 2.8541225524e-02_wp
+         BPE101 = -3.4236710714e-02_wp
+         BPE011 = 2.8711395266e-03_wp
+         BPE002 = 5.3661089288e-04_wp
+         !
+      CASE( np_seos )                        !==  Simplified EOS     ==!
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = '
+            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0'
+            WRITE(numout,*)
+            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0
+            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0
+            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1
+            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2
+            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1
+            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2
+            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu
+            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization '
+         ENDIF
+         l_useCT = .TRUE.          ! Use conservative temperature
+         !
+      CASE DEFAULT                     !==  ERROR in neos  ==!
+         WRITE(ctmp1,*) '          bad flag value for neos = ', neos, '. You should never see this error'
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+      rau0_rcp    = rau0 * rcp 
+      r1_rau0     = 1._wp / rau0
+      r1_rcp      = 1._wp / rcp
+      r1_rau0_rcp = 1._wp / rau0_rcp 
+      !
+      IF(lwp) THEN
+         IF( l_useCT )   THEN
+            WRITE(numout,*) '             model uses Conservative Temperature'
+            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields'
+         ELSE
+            WRITE(numout,*) '             model does not use Conservative Temperature'
+         ENDIF
+      ENDIF
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
+      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
+      IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp
+      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
+      !
+   END SUBROUTINE eos_init
+
+   !!======================================================================
+END MODULE eosbn2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 8732)
@@ -0,0 +1,306 @@
+MODULE traadv
+   !!==============================================================================
+   !!                       ***  MODULE  traadv  ***
+   !! Ocean active tracers:  advection trend 
+   !!==============================================================================
+   !! 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
+   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
+   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes 
+   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option
+   !!            3.6  !  2015-06  (E. Clementi) Addition of Stokes drift in case of wave coupling
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv       : compute ocean tracer advection trend
+   !!   tra_adv_ctl   : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! variable vertical scale factors
+   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
+   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
+   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
+   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
+   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
+   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O module
+   USE prtctl         ! Print control
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE sbcwave        ! wave module
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE diaptr         ! Poleward heat transport 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv        ! routine called by step module
+   PUBLIC   tra_adv_init   ! routine called by opa module
+
+   !                            !!* Namelist namtra_adv *
+   LOGICAL ::   ln_traadv_cen    ! centered scheme flag
+   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
+   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag
+   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
+   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
+   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag
+   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
+   LOGICAL ::   ln_traadv_ubs    ! UBS scheme flag
+   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
+   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
+
+   INTEGER ::              nadv             ! choice of the type of advection scheme
+   !
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
+   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
+   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv  ***
+      !!
+      !! ** Purpose :   compute the ocean tracer advection trend.
+      !!
+      !! ** Method  : - Update (ua,va) with the advection term following nadv
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk   ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !
+      !                                          ! set time step
+      zun(:,:,:) = 0.0
+      zvn(:,:,:) = 0.0
+      zwn(:,:,:) = 0.0
+      !    
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dt = rdt                                 ! = rdt (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog)
+      ENDIF
+      !
+      !                                         !==  effective transport  ==!
+      IF( ln_wave .AND. ln_sdw )  THEN
+         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
+            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
+            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
+            zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) )
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only
+            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
+         END DO
+      ENDIF
+      !
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
+         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
+         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
+      ENDIF
+      !
+      zun(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp
+      zwn(:,:,jpk) = 0._wp
+      !
+      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
+         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary)
+      !
+      IF( ln_mle    )   CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the mle transport (if necessary)
+      !
+      CALL iom_put( "uocetr_eff", zun )                                        ! output effective transport      
+      CALL iom_put( "vocetr_eff", zvn )
+      CALL iom_put( "wocetr_eff", zwn )
+      !
+!!gm ???
+      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF 
+!!gm ???
+      !
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+      !
+      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+      !
+      CASE ( np_CEN )                                    ! Centered scheme : 2nd / 4th order
+         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v )
+      CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order
+         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )
+      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
+         CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts )
+      CASE ( np_MUS )                                    ! MUSCL
+         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups ) 
+      CASE ( np_UBS )                                    ! UBS
+         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   )
+      CASE ( np_QCK )                                    ! QUICKEST
+         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
+      !
+      END SELECT
+      !
+      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk)
+         END DO
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+      ENDIF
+      !                                              ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !                                          
+   END SUBROUTINE tra_adv
+
+
+   SUBROUTINE tra_adv_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_init  ***
+      !!                
+      !! ** Purpose :   Control the consistency between namelist options for 
+      !!              tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios   ! Local integers
+      !
+      NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
+         &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
+         &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL
+         &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS
+         &                 ln_traadv_qck                                        ! QCK
+      !!----------------------------------------------------------------------
+      !
+      !                                !==  Namelist  ==!
+      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme
+      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
+      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namtra_adv )
+      !
+      IF(lwp) THEN                           ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
+         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
+         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
+         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
+         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
+         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
+         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
+      ENDIF
+      !
+      ioptio = 0                       !==  Parameter control  ==!
+      IF( ln_traadv_cen )   ioptio = ioptio + 1
+      IF( ln_traadv_fct )   ioptio = ioptio + 1
+      IF( ln_traadv_mus )   ioptio = ioptio + 1
+      IF( ln_traadv_ubs )   ioptio = ioptio + 1
+      IF( ln_traadv_qck )   ioptio = ioptio + 1
+      !
+      IF( ioptio == 0 ) THEN
+         nadv = np_NO_adv
+         CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' )
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' )
+      !
+      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
+                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
+        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
+                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
+        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN
+         IF( nn_fct_h == 4 ) THEN
+            nn_fct_h = 2
+            CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
+         ENDIF
+         IF( .NOT.ln_linssh ) THEN
+            CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
+         ENDIF
+         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
+      ENDIF
+      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
+        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
+         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
+      ENDIF
+      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
+         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
+            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
+      ENDIF
+      !
+      !                                !==  used advection scheme  ==!  
+      !                                      ! set nadv
+      IF( ln_traadv_cen                      )   nadv = np_CEN
+      IF( ln_traadv_fct                      )   nadv = np_FCT
+      IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
+      IF( ln_traadv_mus                      )   nadv = np_MUS
+      IF( ln_traadv_ubs                      )   nadv = np_UBS
+      IF( ln_traadv_qck                      )   nadv = np_QCK
+      !
+      IF(lwp) THEN                           ! Print the choice
+         WRITE(numout,*)
+         SELECT CASE ( nadv )
+         CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO T-S advection'
+         CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                     ' Vertical   order: ', nn_cen_v
+         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                      ' Vertical   order: ', nn_fct_v
+         CASE( np_FCT_zts )   ;   WRITE(numout,*) '      ===>>   use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used'
+         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used'
+         CASE( np_QCK     )   ;   WRITE(numout,*) '      ===>>   QUICKEST scheme is used'
+         END SELECT
+      ENDIF
+      !
+      CALL tra_adv_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
+      !
+   END SUBROUTINE tra_adv_init
+
+  !!======================================================================
+END MODULE traadv
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90	(revision 8732)
@@ -0,0 +1,218 @@
+MODULE traadv_cen
+   !!======================================================================
+   !!                     ***  MODULE  traadv_cen  ***
+   !! Ocean  tracers:   advective trend (2nd/4th order centered)
+   !!======================================================================
+   !! History :  3.7  ! 2014-05  (G. Madec)  original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen   : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)
+   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used
+   !!----------------------------------------------------------------------
+   USE oce      , ONLY: tsn ! now ocean temperature and salinity
+   USE dom_oce        ! ocean space and time domain
+   USE eosbn2         ! equation of state
+   USE traadv_fct     ! acces to routine interp_4th_cpt 
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_cen       ! routine called by step.F90
+   
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   LOGICAL :: l_trd   ! flag to compute trends
+   LOGICAL :: l_ptr   ! flag to compute poleward transport
+   LOGICAL :: l_hst   ! flag to compute heat/salt transport
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     &
+      &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_cen  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a 2nd or 4th order scheme
+      !!               using now fields (leap-frog scheme). 
+      !!       kn_cen_h = 2  ==>> 2nd order centered scheme on the horizontal
+      !!                = 4  ==>> 4th order    -        -       -      -
+      !!       kn_cen_v = 2  ==>> 2nd order centered scheme on the vertical
+      !!                = 4  ==>> 4th order COMPACT  scheme     -      -
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
+      INTEGER                              , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   ierr             ! local integer
+      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars
+      REAL(wp) ::   zC2t_v, zC4t_v   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+      ENDIF
+      !
+      l_trd = .FALSE.
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )        l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
+      !
+      !                    
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         SELECT CASE( kn_cen_h )       !--  Horizontal fluxes  --!
+         !
+         CASE(  2  )                         !* 2nd order centered
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                         !* 4th order centered
+            ztu(:,:,jpk) = 0._wp                   ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                       ! masked gradient
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                       ! Horizontal advective fluxes
+               DO jj = 2, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2)
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
+                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) )
+                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) )
+                     !                                                  ! C4 fluxes
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v
+                  END DO
+               END DO
+            END DO         
+            !
+         CASE DEFAULT
+            CALL ctl_stop( 'traadv_fct: wrong value for nn_fct' )
+         END SELECT
+         !
+         SELECT CASE( kn_cen_v )       !--  Vertical fluxes  --!   (interior)
+         !
+         CASE(  2  )                         !* 2nd order centered
+            DO jk = 2, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                         !* 4th order compact
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !
+         IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn) 
+                  END DO
+               END DO   
+            ELSE                                   ! no ice-shelf cavities (only ocean surface)
+               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !               
+         DO jk = 1, jpkm1              !--  Divergence of advective fluxes  --!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    &
+                     &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    &
+                     &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    &
+                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                             ! trend diagnostics
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports 
+         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+         !                                 !  heat and salt transport
+         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen')
+      !
+   END SUBROUTINE tra_adv_cen
+   
+   !!======================================================================
+END MODULE traadv_cen
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90	(revision 8732)
@@ -0,0 +1,1001 @@
+MODULE traadv_fct
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_fct  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order Flux Corrected Transport method)
+   !!==============================================================================
+   !! History :  3.7  !  2015-09  (L. Debreu, G. Madec)  original code (inspired from traadv_tvd.F90)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme
+   !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme 
+   !!                   with sub-time-stepping in the vertical direction
+   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm 
+   !!  interp_4th_cpt : 4th order compact scheme for the vertical component of the advection
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracers trends
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   USE phycst, ONLY: rau0_rcp
+   !
+   USE in_out_manager ! I/O manager
+   USE iom
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_fct        ! routine called by traadv.F90
+   PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90
+   PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90
+
+   LOGICAL  ::   l_trd   ! flag to compute trends
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   !                                        ! tridiag solver associated indices:
+   INTEGER, PARAMETER ::   np_NH   = 0   ! Neumann homogeneous boundary condition
+   INTEGER, PARAMETER ::   np_CEN2 = 1   ! 2nd order centered  boundary condition
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       &
+      &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of tracers
+      !!               and add it to the general trend of tracer equations
+      !!
+      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
+      !!               (choice through the value of kn_fct)
+      !!               - on the vertical the 4th order is a compact scheme 
+      !!               - corrected flux (monotonic correction) 
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
+      INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices  
+      REAL(wp) ::   ztra                                     ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz, zptry
+      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( ( cdtype == 'TRA'   .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )     l_trd = .TRUE.
+      IF(   cdtype == 'TRA'   .AND. ln_diaptr )                                              l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
+      !
+      IF( l_trd .OR. l_hst )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      IF( l_ptr ) THEN  
+         CALL wrk_alloc( jpi, jpj, jpk, zptry )
+         zptry(:,:,:) = 0._wp
+      ENDIF
+      !                          ! surface & bottom value : flux set to zero one for all
+      zwz(:,:, 1 ) = 0._wp            
+      zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp
+      !
+      zwi(:,:,:) = 0._wp        
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
+         !                    !* upstream tracer flux in the i and j direction 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !                    !* upstream tracer flux in the k direction *!
+         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN    ! top ocean value (only in linear free surface as zwz has been w-masked)
+            IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                             ! no cavities: only at the ocean surface
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !               
+         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                             ! total intermediate advective trends
+                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+                  !                             ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign)
+         !                
+         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:) 
+         !
+         !        !==  anti-diffusive flux : high order minus low order  ==!
+         !
+         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                   !- 4th order centered
+            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! Laplacian
+               DO jj = 1, jpjm1                    ! 1st derivative (gradient)
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+               DO jj = 2, jpjm1                    ! 2nd derivative * 1/ 6
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                     zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                 ! Horizontal advective fluxes
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 minus upstream advective fluxes 
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO         
+            !
+         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
+            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! 1st derivative (gradient)
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO jk = 1, jpkm1                 ! Horizontal advective fluxes
+               DO jj = 2, jpjm1
+                  DO ji = 2, fs_jpim1   ! vector opt.
+                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2)
+                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn)
+                     !                                                  ! C4 interpolation of T at u- & v-points (x2)
+                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
+                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+                     !                                                  ! C4 minus upstream advective fluxes 
+                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
+                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         !                      
+         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO jk = 2, jpkm1    
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
+                        &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         CASE(  4  )                   !- 4th order COMPACT
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = ( pwn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END SELECT
+         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
+            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
+         ENDIF
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+         !
+         !        !==  monotonicity algorithm  ==!
+         !
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+         !
+         !        !==  final trend with corrected fluxes  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) &
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+         ENDIF
+            !
+         IF( l_trd ) THEN 
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )
+            !
+         END IF
+         !                                !  heat/salt transport
+         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) )
+
+         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr ) THEN  
+            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
+         ENDIF
+         !
+      END DO                     ! end of tracer loop
+      !
+                              CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct')
+      !
+   END SUBROUTINE tra_adv_fct
+
+
+   SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                                  ptb, ptn, pta, kjpt, kn_fct_zts )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct_zts  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction). This version use sub-
+      !!       timestepping for the vertical advection which increases stability
+      !!       when vertical metrics are small.
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_fct_zts      ! number of number of vertical sub-timesteps
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection
+      REAL(wp)                                             ::   zr_p2dt         ! reciprocal of tracer timestep
+      INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices  
+      INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps
+      INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps
+      REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection
+      REAL(wp) ::   ztra            ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts')
+      !
+      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
+      CALL wrk_alloc( jpi,jpj,jpk,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
+      !
+      IF( l_trd .OR. l_hst )  THEN
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      IF( l_ptr ) THEN  
+         CALL wrk_alloc( jpi, jpj,jpk, zptry )
+         zptry(:,:,:) = 0._wp
+      ENDIF
+      zwi(:,:,:) = 0._wp
+      z_rzts = 1._wp / REAL( kn_fct_zts, wp )
+      zr_p2dt = 1._wp / p2dt
+      !
+      ! surface & Bottom value : flux set to zero for all tracers
+      zwz(:,:, 1 ) = 0._wp
+      zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp
+      zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !
+         ! Upstream advection with initial mass fluxes & intermediate update
+         DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !                       ! upstream tracer flux in the k direction
+         DO jk = 2, jpkm1              ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) 
+                  END DO
+               END DO   
+            ELSE                             ! no cavities, surface value
+               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1         ! total advective trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                             ! total intermediate advective trends
+                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj)
+                  !                             ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                           
+         CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign)
+         !                
+         IF( l_trd .OR. l_hst )  THEN                ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)
+
+         ! 3. anti-diffusive flux : high order minus low order
+         ! ---------------------------------------------------
+
+         DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx_sav(ji,jj) = zwx(ji,jj,jk)
+                  zwy_sav(ji,jj) = zwy(ji,jj,jk)
+                  !
+                  zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) )
+               END DO
+            END DO
+            !
+            DO jj = 2, jpjm1                    ! partial horizontal divergence
+               DO ji = fs_2, fs_jpim1
+                  zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                     &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+               END DO
+            END DO
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj)
+                  zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj)
+               END DO
+            END DO
+         END DO
+         !
+         !                                !* vertical anti-diffusive flux
+         zwz_sav(:,:,:)   = zwz(:,:,:)
+         ztrs   (:,:,:,1) = ptb(:,:,:,jn)
+         ztrs   (:,:,1,2) = ptb(:,:,1,jn)
+         ztrs   (:,:,1,3) = ptb(:,:,1,jn)
+         zwzts  (:,:,:)   = 0._wp
+         !
+         DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop
+            !
+            IF( jl == 1 ) THEN                        ! Euler forward to kick things off
+               jtb = 1   ;   jtn = 1   ;   jta = 2
+               zts(:) = p2dt * z_rzts
+               jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux
+               !                                            ! starting at jl =1 if kn_fct_zts is odd; 
+               !                                            ! starting at jl =2 otherwise
+            ELSEIF( jl == 2 ) THEN                    ! First leapfrog step
+               jtb = 1   ;   jtn = 2   ;   jta = 3
+               zts(:) = 2._wp * p2dt * z_rzts
+            ELSE                                      ! Shuffle pointers for subsequent leapfrog steps
+               jtb = MOD(jtb,3) + 1
+               jtn = MOD(jtn,3) + 1
+               jta = MOD(jta,3) + 1
+            ENDIF
+            DO jk = 2, jpkm1                          ! interior value
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk)
+                     IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux
+                  END DO
+               END DO
+            END DO
+            IF( ln_linssh ) THEN                    ! top value (only in linear free surface case)
+               IF( ln_isfcav ) THEN                      ! ice-shelf cavities
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                     END DO
+                  END DO   
+               ELSE                                      ! no ocean cavities
+                  zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               ENDIF
+            ENDIF
+            !
+            jtaken = MOD( jtaken + 1 , 2 )
+            !
+            DO jk = 2, jpkm1                             ! total advective trends
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 &
+                        &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+                        &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+
+         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       &
+                     &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   &
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+        !
+         IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+         ENDIF
+            !
+         IF( l_trd ) THEN 
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )
+            !
+         END IF
+         !                                             ! heat/salt transport
+         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) )
+
+         !                                            ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr ) THEN  
+            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
+         ENDIF
+         !
+      END DO
+      !
+                              CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav )
+                              CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav )
+                              CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs )
+      IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts')
+      !
+   END SUBROUTINE tra_adv_fct_zts
+
+
+   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
+      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
+         &        paft * tmask - zbig * ( 1._wp - tmask )  )
+      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
+         &        paft * tmask + zbig * ( 1._wp - tmask )  )
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+                  &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+                  &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+               ! search minimum in neighbourhood
+               zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+                  &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+                  &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+                  &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+               ! positive part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+               ! negative part of the flux
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
+               ! up & down beta terms
+               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
+               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+               zcu =       ( 0.5  + SIGN( 0.5 , paa(ji,jj,jk) ) )
+               paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+
+               zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+               zcv =       ( 0.5  + SIGN( 0.5 , pbb(ji,jj,jk) ) )
+               pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+               za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+               zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+               zc =       ( 0.5  + SIGN( 0.5 , pcc(ji,jj,jk+1) ) )
+               pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc')
+      !
+   END SUBROUTINE nonosc
+
+
+   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt_org  ***
+      !! 
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
+      !
+      INTEGER :: ji, jj, jk   ! dummy loop integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      
+      DO jk = 3, jpkm1        !==  build the three diagonal matrix  ==!
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwd (ji,jj,jk) = 4._wp
+               zwi (ji,jj,jk) = 1._wp
+               zws (ji,jj,jk) = 1._wp
+               zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+               !
+               IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
+                  zwd (ji,jj,jk) = 1._wp
+                  zwi (ji,jj,jk) = 0._wp
+                  zws (ji,jj,jk) = 0._wp
+                  zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )    
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      jk = 2                                          ! Switch to second order centered at top
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zwd (ji,jj,jk) = 1._wp
+            zwi (ji,jj,jk) = 0._wp
+            zws (ji,jj,jk) = 0._wp
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         END DO
+      END DO   
+      !
+      !                       !==  tridiagonal solve  ==!
+      DO jj = 1, jpj                ! first recurrence
+         DO ji = 1, jpi
+            zwt(ji,jj,2) = zwd(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO ji = 1, jpi
+            pt_out(ji,jj,2) = zwrm(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+            END DO
+         END DO
+      END DO
+
+      DO jj = 1, jpj                ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         DO ji = 1, jpi
+            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !    
+   END SUBROUTINE interp_4th_cpt_org
+   
+
+   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt  ***
+      !! 
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   ikt, ikb     ! local integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      !
+      !                      !==  build the three diagonal matrix & the RHS  ==!
+      !
+      DO jk = 3, jpkm1                 ! interior (from jk=3 to jpk-1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
+               zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
+               zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
+               zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
+                  &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
+            END DO
+         END DO
+      END DO
+      !
+!!gm
+!      SELECT CASE( kbc )               !* boundary condition
+!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom
+!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom
+!      END SELECT
+!!gm  
+      !
+      DO jj = 2, jpjm1                 ! 2nd order centered at top & bottom
+         DO ji = fs_2, fs_jpim1
+            ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
+            ikb = mbkt(ji,jj)                !     -   above the last wet point
+            !
+            zwd (ji,jj,ikt) = 1._wp          ! top
+            zwi (ji,jj,ikt) = 0._wp
+            zws (ji,jj,ikt) = 0._wp
+            zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+            !
+            zwd (ji,jj,ikb) = 1._wp          ! bottom
+            zwi (ji,jj,ikb) = 0._wp
+            zws (ji,jj,ikb) = 0._wp
+            zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )            
+         END DO
+      END DO   
+      !
+      !                       !==  tridiagonal solver  ==!
+      !
+      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         DO ji = fs_2, fs_jpim1
+            zwt(ji,jj,2) = zwd(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, 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 jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO ji = fs_2, fs_jpim1
+            pt_out(ji,jj,2) = zwrm(ji,jj,2)
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+            END DO
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         DO ji = fs_2, fs_jpim1
+            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 2, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !    
+   END SUBROUTINE interp_4th_cpt
+
+
+   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tridia_solver  ***
+      !! 
+      !! **  Purpose :   solve a symmetric 3diagonal system
+      !!
+      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk )
+      !!     
+      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 )
+      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 )
+      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 )
+      !!             (        ...          )( ... )   ( ...  )
+      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k )
+      !!     
+      !!        M is decomposed in the product of an upper and lower triangular matrix.
+      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL 
+      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal).
+      !!        The solution is pta.
+      !!        The 3d array zwt is used as a work space array.
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix
+      REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pRHS          ! Right-Hand-Side
+      REAL(wp),DIMENSION(:,:,:), INTENT(  out) ::   pt_out        !!gm field at level=F(klev)
+      INTEGER                  , INTENT(in   ) ::   klev          ! =1 pt_out at w-level 
+      !                                                           ! =0 pt at t-level
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   kstart       ! local indices
+      REAL(wp),DIMENSION(jpi,jpj,jpk) ::   zwt   ! 3D work array
+      !!----------------------------------------------------------------------
+      !
+      kstart =  1  + klev
+      !
+      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         DO ji = fs_2, fs_jpim1
+            zwt(ji,jj,kstart) = pD(ji,jj,kstart)
+         END DO
+      END DO
+      DO jk = kstart+1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO ji = fs_2, fs_jpim1
+            pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
+         END DO
+      END DO
+      DO jk = kstart+1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)             
+            END DO
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         DO ji = fs_2, fs_jpim1
+            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, kstart, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE tridia_solver
+
+   !!======================================================================
+END MODULE traadv_fct
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90	(revision 8732)
@@ -0,0 +1,356 @@
+MODULE traadv_mle
+   !!======================================================================
+   !!                    ***  MODULE  traadv_mle  ***
+   !! Ocean tracers: Mixed Layer Eddy induced transport
+   !!======================================================================
+   !! History :  3.3  !  2010-08  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_mle      : update the effective transport with the Mixed Layer Eddy induced transport
+   !!   tra_adv_mle_init : initialisation of the Mixed Layer Eddy induced transport computation
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE phycst         ! physical constant
+   USE zdfmxl         ! mixed layer depth
+   USE lbclnk         ! lateral boundary condition / mpp link
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_mle        ! routine called in traadv.F90
+   PUBLIC   tra_adv_mle_init   ! routine called in traadv.F90
+
+   !                                       !!* namelist namtra_adv_mle *
+   LOGICAL, PUBLIC ::   ln_mle              ! flag to activate the Mixed Layer Eddy (MLE) parameterisation
+   INTEGER         ::   nn_mle              ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
+   INTEGER         ::   nn_mld_uv           ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
+   INTEGER         ::   nn_conv             ! =1 no MLE in case of convection ; =0 always MLE
+   REAL(wp)        ::   rn_ce               ! MLE coefficient
+   !                                        ! parameters used in nn_mle = 0 case
+   REAL(wp)        ::   rn_lf                  ! typical scale of mixed layer front
+   REAL(wp)        ::   rn_time                ! time scale for mixing momentum across the mixed layer
+   !                                        ! parameters used in nn_mle = 1 case
+   REAL(wp)        ::   rn_lat                 ! reference latitude for a 5 km scale of ML front
+   REAL(wp)        ::   rn_rho_c_mle           ! Density criterion for definition of MLD used by FK
+
+   REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation
+   REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rau0 where rho_c is defined in zdfmld
+   REAL(wp) ::   rc_f                   ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_mle=1 case
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rfu, rfv   ! modified Coriolis parameter (f+tau) at u- & v-pts
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_ft      ! inverse of the modified Coriolis parameter at t-pts
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_mle( kt, kit000, pu, pv, pw, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE adv_mle  ***
+      !!
+      !! ** Purpose :   Add to the transport the Mixed Layer Eddy induced transport
+      !!
+      !! ** Method  :   The 3 components of the Mixed Layer Eddy (MLE) induced
+      !!              transport are computed as follows :
+      !!                zu_mle = dk[ zpsi_uw ]
+      !!                zv_mle = dk[ zpsi_vw ]
+      !!                zw_mle = - di[ zpsi_uw ] - dj[ zpsi_vw ]
+      !!                where zpsi is the MLE streamfunction at uw and vw points (see the doc)
+      !!              and added to the input velocity :
+      !!                p.n = p.n + z._mle
+      !!
+      !! ** Action  : - (pun,pvn,pwn) increased by the mle transport
+      !!                CAUTION, the transport is not updated at the last line/raw
+      !!                         this may be a problem for some advection schemes
+      !!
+      !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008
+      !!             Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                         , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikmax        ! temporary integer
+      REAL(wp) ::   zcuw, zmuw   ! local scalar
+      REAL(wp) ::   zcvw, zmvw   !   -      -
+      REAL(wp) ::   zc                                     !   -      -
+      !
+      INTEGER  ::   ii, ij, ik              ! local integers
+      INTEGER, DIMENSION(3) ::   ilocu      !
+      INTEGER, DIMENSION(2) ::   ilocs      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw
+      INTEGER, POINTER, DIMENSION(:,:) :: inml_mle
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle')
+      CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)
+      CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw)
+      CALL wrk_alloc( jpi, jpj, inml_mle)
+      !
+      !                                      !==  MLD used for MLE  ==!
+      !                                                ! compute from the 10m density to deal with the diurnal cycle
+      inml_mle(:,:) = mbkt(:,:) + 1                    ! init. to number of ocean w-level (T-level + 1)
+      DO jk = jpkm1, nlb10, -1                         ! from the bottom to nlb10 (10m)
+         DO jj = 1, jpj
+            DO ji = 1, jpi                             ! index of the w-level at the ML based
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer
+            END DO
+         END DO
+      END DO
+      ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 )                  ! max level of the computation
+      !
+      !
+      zmld(:,:) = 0._wp                      !==   Horizontal shape of the MLE  ==!
+      zbm (:,:) = 0._wp
+      zn2 (:,:) = 0._wp
+      DO jk = 1, ikmax                                 ! MLD and mean buoyancy and N2 over the mixed layer
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
+               zmld(ji,jj) = zmld(ji,jj) + zc
+               zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0
+               zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp
+            END DO
+         END DO
+      END DO
+
+      SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
+      CASE ( 0 )                                               != min of the 2 neighbour MLDs
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) )
+               zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) )
+            END DO
+         END DO
+      CASE ( 1 )                                               != average of the 2 neighbour MLDs
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp
+               zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp
+            END DO
+         END DO
+      CASE ( 2 )                                               != max of the 2 neighbour MLDs
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) )
+               zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) )
+            END DO
+         END DO
+      END SELECT
+      !                                                ! convert density into buoyancy
+      zbm(:,:) = + grav * zbm(:,:) / MAX( e3t_n(:,:,1), zmld(:,:) )
+      !
+      !
+      !                                      !==  Magnitude of the MLE stream function  ==!
+      !
+      !                 di[bm]  Ds
+      ! Psi = Ce  H^2 ---------------- e2u  mu(z)   where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 )
+      !                  e1u   Lf fu                      and the e2u for the "transport"
+      !                                                      (not *e3u as divided by e3u at the end)
+      !
+      IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
+                  &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) )   )
+                  !
+               zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj)  * e1_e2v(ji,jj)                                            &
+                  &           * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )   &
+                  &           / (  MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) )   )
+            END DO
+         END DO
+         !
+      ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
+                  &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
+                  !
+               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               &
+                  &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) )
+            END DO
+         END DO
+      ENDIF
+      !
+      IF( nn_conv == 1 ) THEN              ! No MLE in case of convection
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp
+               IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp
+            END DO
+         END DO
+      ENDIF
+      !
+      !                                      !==  structure function value at uw- and vw-points  ==!
+      DO jj = 1, jpjm1
+         DO ji = 1, fs_jpim1   ! vector opt.
+            zhu(ji,jj) = 1._wp / zhu(ji,jj)                   ! hu --> 1/hu
+            zhv(ji,jj) = 1._wp / zhv(ji,jj)
+         END DO
+      END DO
+      !
+      zpsi_uw(:,:,:) = 0._wp
+      zpsi_vw(:,:,:) = 0._wp
+      !
+      DO jk = 2, ikmax                                ! start from 2 : surface value = 0
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zcuw = 1._wp - ( gdepw_n(ji+1,jj,jk) + gdepw_n(ji,jj,jk) ) * zhu(ji,jj)
+               zcvw = 1._wp - ( gdepw_n(ji,jj+1,jk) + gdepw_n(ji,jj,jk) ) * zhv(ji,jj)
+               zcuw = zcuw * zcuw
+               zcvw = zcvw * zcvw
+               zmuw = MAX(  0._wp , ( 1._wp - zcuw ) * ( 1._wp + r5_21 * zcuw )  )
+               zmvw = MAX(  0._wp , ( 1._wp - zcvw ) * ( 1._wp + r5_21 * zcvw )  )
+               !
+               zpsi_uw(ji,jj,jk) = zpsim_u(ji,jj) * zmuw * umask(ji,jj,jk)
+               zpsi_vw(ji,jj,jk) = zpsim_v(ji,jj) * zmvw * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      !                                      !==  transport increased by the MLE induced transport ==!
+      DO jk = 1, ikmax
+         DO jj = 1, jpjm1                          ! CAUTION pu,pv must be defined at row/column i=1 / j=1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
+               pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
+            END DO
+         END DO
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   &
+                  &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) )
+            END DO
+         END DO
+      END DO
+
+      IF( cdtype == 'TRA') THEN              !==  outputs  ==!
+         !
+         zLf_NH(:,:) = SQRT( rb_c * zmld(:,:) ) * r1_ft(:,:)      ! Lf = N H / f
+         CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f
+         !
+         ! divide by cross distance to give streamfunction with dimensions m^2/s
+         DO jk = 1, ikmax+1
+            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:)
+            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:)
+         END DO
+         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction
+         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction
+      ENDIF
+      CALL wrk_dealloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH)
+      CALL wrk_dealloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw)
+      CALL wrk_dealloc( jpi, jpj, inml_mle)
+
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mle')
+      !
+   END SUBROUTINE tra_adv_mle
+
+
+   SUBROUTINE tra_adv_mle_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_mle_init  ***
+      !!
+      !! ** Purpose :   Control the consistency between namelist options for
+      !!              tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ierr
+      INTEGER ::    ios                 ! Local integer output status for namelist read
+      REAL(wp) ::   z1_t2, zfu, zfv                                !    -         -
+      !
+      NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme
+      READ  ( numnam_ref, namtra_adv_mle, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namtra_adv_mle in configuration namelist : Tracer advection scheme
+      READ  ( numnam_cfg, namtra_adv_mle, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namtra_adv_mle )
+
+      IF(lwp) THEN                     ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv_mle_init : mixed layer eddy (MLE) advection acting on tracers'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_adv_mle : mixed layer eddy advection on tracers'
+         WRITE(numout,*) '      use mixed layer eddy (MLE, i.e. Fox-Kemper param) (T/F)      ln_mle    = ', ln_mle
+         WRITE(numout,*) '      MLE type: =0 standard Fox-Kemper ; =1 new formulation        nn_mle    = ', nn_mle
+         WRITE(numout,*) '      magnitude of the MLE (typical value: 0.06 to 0.08)           rn_ce     = ', rn_ce
+         WRITE(numout,*) '      scale of ML front (ML radius of deformation) (rn_mle=0)      rn_lf     = ', rn_lf, 'm'
+         WRITE(numout,*) '      maximum time scale of MLE                    (rn_mle=0)      rn_time   = ', rn_time, 's'
+         WRITE(numout,*) '      reference latitude (degrees) of MLE coef.    (rn_mle=1)      rn_lat    = ', rn_lat, 'deg'
+         WRITE(numout,*) '      space interp. of MLD at u-(v-)pts (0=min,1=averaged,2=max)   nn_mld_uv = ', nn_mld_uv
+         WRITE(numout,*) '      =1 no MLE in case of convection ; =0 always MLE              nn_conv   = ', nn_conv
+         WRITE(numout,*) '      Density difference used to define ML for FK              rn_rho_c_mle  = ', rn_rho_c_mle
+      ENDIF
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( ln_mle ) THEN
+            WRITE(numout,*) '      ===>>   Mixed Layer Eddy induced transport added to tracer advection'
+            IF( nn_mle == 0 )   WRITE(numout,*) '              Fox-Kemper et al 2010 formulation'
+            IF( nn_mle == 1 )   WRITE(numout,*) '              New formulation'
+         ELSE
+            WRITE(numout,*) '      ===>>   Mixed Layer Eddy parametrisation NOT used'
+         ENDIF
+      ENDIF
+      !
+      IF( ln_mle ) THEN                ! MLE initialisation
+         !
+         rb_c = grav * rn_rho_c_mle /rau0        ! Mixed Layer buoyancy criteria
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 '
+         IF(lwp) WRITE(numout,*) '      associated ML density criteria defined in zdfmxl = ', rho_c, 'kg/m3'
+         !
+         IF( nn_mle == 0 ) THEN           ! MLE array allocation & initialisation
+            ALLOCATE( rfu(jpi,jpj) , rfv(jpi,jpj) , STAT= ierr )
+            IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' )
+            z1_t2 = 1._wp / ( rn_time * rn_time )
+            DO jj = 2, jpj                           ! "coriolis+ time^-1" at u- & v-points
+               DO ji = fs_2, jpi   ! vector opt.
+                  zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp
+                  zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp
+                  rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 )
+                  rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 )
+               END DO
+            END DO
+            CALL lbc_lnk( rfu, 'U', 1. )   ;   CALL lbc_lnk( rfv, 'V', 1. )
+            !
+         ELSEIF( nn_mle == 1 ) THEN           ! MLE array allocation & initialisation
+            rc_f = rn_ce / (  5.e3_wp * 2._wp * omega * SIN( rad * rn_lat )  )
+            !
+         ENDIF
+         !
+         !                                ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_mle case)
+         ALLOCATE( r1_ft(jpi,jpj) , STAT= ierr )
+         IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate r1_ft array' )
+         !
+         z1_t2 = 1._wp / ( rn_time * rn_time )
+         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  )
+         !
+      ENDIF
+      !
+   END SUBROUTINE tra_adv_mle_init
+
+   !!==============================================================================
+END MODULE traadv_mle
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90	(revision 8732)
@@ -0,0 +1,288 @@
+MODULE traadv_mus
+   !!======================================================================
+   !!                       ***  MODULE  traadv_mus  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!======================================================================
+   !! History :       !  2000-06  (A.Estublier)  for passive tracers
+   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
+   !!            3.7  !  2015-09  (G. Madec) add the ice-shelf cavities boundary condition
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_mus   : update the tracer trend with the horizontal
+   !!                   and vertical advection trends using MUSCL scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE dom_oce        ! ocean space and time domain
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! tracers trends manager
+   USE sbcrnf         ! river runoffs
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+
+   !
+   USE iom
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_mus   ! routine called by traadv.F90
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
+   !                                                           !  and in closed seas (orca 2 and 1 configurations)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
+   
+   LOGICAL  ::   l_trd   ! flag to compute trends
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             &
+      &                                              ptb, pta, kjpt, ld_msc_ups )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_adv_mus  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of tracers
+      !!              using a MUSCL scheme (Monotone Upstream-centered Scheme for
+      !!              Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
+      !!              ld_msc_ups=T : 
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!
+      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   ierr                 ! local integer
+      REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars
+      REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      -
+      REAL(wp) ::   zalpha               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      - 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         IF(lwp) WRITE(numout,*)
+         !
+         ! Upstream / MUSCL scheme indicator
+         !
+         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
+         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed
+         !
+         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked)
+            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
+            upsmsk(:,:) = 0._wp                             ! not upstream by default
+            !
+            DO jk = 1, jpkm1
+               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
+                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
+                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area
+            END DO
+         ENDIF 
+         !
+      ENDIF 
+      !      
+      l_trd = .FALSE.
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !                          !* Horizontal advective fluxes
+         !
+         !                                !-- first guess of the slopes
+         zwx(:,:,jpk) = 0._wp                   ! bottom values
+         zwy(:,:,jpk) = 0._wp  
+         DO jk = 1, jpkm1                       ! interior values
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )          ! lateral boundary conditions   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0._wp                 ! bottom values
+         zslpy(:,:,jpk) = 0._wp
+         DO jk = 1, jpkm1                       ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                 !-- Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                 !-- MUSCL horizontal advective fluxes
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)
+                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)
+                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk)
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign)
+         !
+         DO jk = 1, jpkm1                 !-- Tracer advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       &
+                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
+                  &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+           END DO
+         END DO        
+         !                                ! trend diagnostics
+         IF( l_trd )  THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports 
+         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+         !                                 !  heat transport
+         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
+         !
+         !                          !* Vertical advective fluxes
+         !
+         !                                !-- first guess of the slopes
+         zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions
+         zwx(:,:,jpk) = 0._wp
+         DO jk = 2, jpkm1                       ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+         !                                !-- Slopes of tracer
+         zslpx(:,:,1) = 0._wp                   ! surface values
+         DO jk = 2, jpkm1                       ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  &
+                     &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  )
+               END DO
+            END DO
+         END DO
+         DO jk = 2, jpkm1                 !-- Slopes limitation
+            DO jj = 1, jpj                      ! interior values
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         DO jk = 1, jpk-2                 !-- vertical advective flux
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1)
+                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)
+               END DO 
+            END DO
+         END DO
+         IF( ln_linssh ) THEN                   ! top values, linear free surface only
+            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)
+                  END DO
+               END DO   
+            ELSE                                      ! no cavities: only at the ocean surface
+               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1                 !-- vertical advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                ! send trends for diagnostic
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
+      END DO                     ! end of tracer loop
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus')
+      !
+   END SUBROUTINE tra_adv_mus
+
+   !!======================================================================
+END MODULE traadv_mus
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 8732)
@@ -0,0 +1,482 @@
+MODULE traadv_qck
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_qck  ***
+   !! 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  : 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 trc_oce         ! share passive tracers/Ocean variables
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
+   USE diaptr          ! poleward transport diagnostics
+   !
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_qck   ! routine called by step.F90
+
+   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio
+
+   LOGICAL  ::   l_trd   ! flag to compute trends
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_qck  ***
+      !!
+      !! ** 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 third order scheme
+      !!             For a positive velocity u :              u(i)>0
+      !!                                          |--FU--|--FC--|--FD--|------|
+      !!                                             i-1    i      i+1   i+2
+      !!
+      !!             For a negative velocity u :              u(i)<0
+      !!                                          |------|--FD--|--FC--|--FU--|
+      !!                                             i-1    i      i+1   i+2
+      !!             where  FU is the second upwind point
+      !!                    FD is the first douwning point
+      !!                    FC is the central point (or the first upwind point)
+      !!
+      !!      Flux(i) = u(i) * { 0.5(FC+FD)  -0.5C(i)(FD-FC)  -((1-C(i))/6)(FU+FD-2FC) }
+      !!                with C(i)=|u(i)|dx(i)/dt (=Courant number)
+      !!
+      !!         dt = 2*rdtra and the scalar values are tb and sb
+      !!
+      !!       On the vertical, the simple centered scheme used ptn
+      !!
+      !!               The fluxes are bounded by the ULTIMATE limiter to
+      !!             guarantee the monotonicity of the solution and to
+      !!            prevent the appearance of spurious numerical oscillations
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!
+      !! ** Reference : Leonard (1979, 1991)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_qck')
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+      !
+      l_trd = .FALSE.
+      l_ptr = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      !
+      !
+      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
+      CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 
+      CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 
+
+      !        ! vertical fluxes are computed with the 2nd order centered scheme
+      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_qck')
+      !
+   END SUBROUTINE tra_adv_qck
+
+
+   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,                  &
+      &                                        ptb, ptn, pta, kjpt   )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      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(in   ) ::   p2dt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd
+      !----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd )
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp 
+         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp   
+         !
+!!gm why not using a SHIFT instruction...
+         DO jk = 1, jpkm1     !--- Computation of the ustream and downstream value of the tracer and the mask
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
+         
+         !
+         ! Horizontal advective fluxes
+         ! ---------------------------
+         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  
+            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) * e3u_n(ji,jj,jk)
+                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T
+               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.
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions 
+
+         !
+         ! 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, 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
+         END DO
+         !
+         CALL lbc_lnk( zwx(:,:,:), 'T', 1. ) ! Lateral boundary conditions
+         !
+         ! Computation of the trend
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(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
+         IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd )
+      !
+   END SUBROUTINE tra_adv_qck_i
+
+
+   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                &
+      &                                        ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      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(in   ) ::   p2dt       ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd
+      !----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd )
+      !
+      !                                                          ! ===========
+      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.
+                  ! 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
+         ! ---------------------------
+         !
+         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  
+            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) * e3v_n(ji,jj,jk)
+                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T
+               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
+         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
+         END DO
+         !
+         CALL lbc_lnk( zwy(:,:,:), 'T', 1. ) ! Lateral boundary conditions
+         !
+         ! Computation of the trend
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = r1_e1e2t(ji,jj) / e3t_n(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
+         IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )                     CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd )
+      !
+   END SUBROUTINE tra_adv_qck_j
+
+
+   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           &
+     &                                    ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      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), POINTER, DIMENSION(:,:,:) :: zwz
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwz )
+      !
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !
+         DO jk = 2, jpkm1                    !* Interior point   (w-masked 2nd order centered flux)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                  END DO
+               END DO   
+            ELSE                                   ! no ocean cavities (only ocean surface)
+               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn)
+            ENDIF
+         ENDIF
+         !
+         DO jk = 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,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                 ! Send trends for diagnostic
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwz )
+      !
+   END SUBROUTINE tra_adv_cen2_k
+
+
+   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          !   -      -
+      !----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('quickest')
+      !
+      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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('quickest')
+      !
+   END SUBROUTINE quickest
+
+   !!======================================================================
+END MODULE traadv_qck
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 8732)
@@ -0,0 +1,396 @@
+MODULE traadv_ubs
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_ubs  ***
+   !! Ocean active tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_ubs : update the tracer trend with the horizontal
+   !!                 advection trends using a third order biaised scheme  
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE trd_oce        ! trends: ocean variables
+   USE traadv_fct      ! acces to routine interp_4th_cpt 
+   USE trdtra         ! trends manager: tracers 
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+
+   !
+   USE iom
+   USE lib_mpp        ! I/O library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE in_out_manager ! I/O manager
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_ubs   ! routine called by traadv module
+
+   LOGICAL :: l_trd   ! flag to compute trends
+   LOGICAL :: l_ptr   ! flag to compute poleward transport
+   LOGICAL :: l_hst   ! flag to compute heat transport
+
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          &
+      &                                                ptb, ptn, pta, kjpt, kn_ubs_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_ubs  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The 3rd order Upstream Biased Scheme (UBS) is based on an
+      !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
+      !!      It is only used in the horizontal direction.
+      !!      For example the i-component of the advective fluxes are given by :
+      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0
+      !!          ztu = !  or 
+      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0
+      !!      where zltu is the second derivative of the before temperature field:
+      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
+      !!        This results in a dissipatively dominant (i.e. hyper-diffusive) 
+      !!      truncation error. The overall performance of the advection scheme 
+      !!      is similar to that reported in (Farrow and Stevens, 1995). 
+      !!        For stability reasons, the first term of the fluxes which corresponds
+      !!      to a second order centered scheme is evaluated using the now velocity 
+      !!      (centered in time) while the second term which is the diffusive part 
+      !!      of the scheme, is evaluated using the before velocity (forward in time). 
+      !!      Note that UBS is not positive. Do not use it on passive tracers.
+      !!                On the vertical, the advection is evaluated using a FCT scheme,
+      !!      as the UBS have been found to be too diffusive. 
+      !!                kn_ubs_v argument controles whether the FCT is based on 
+      !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact 
+      !!      scheme (kn_ubs_v=4).
+      !!
+      !! ** Action : - update pta  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)
+      !!
+      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
+      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
+      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      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, ztak, zfp_wk, zfm_wk   !   -      -
+      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      !
+      l_trd = .FALSE.
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE. 
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
+      !
+      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers
+      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp
+      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                              
+         DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==!
+            DO jj = 1, jpjm1              ! First derivative (masked gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
+                  zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
+                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+            DO jj = 2, jpjm1              ! Second derivative (divergence)
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) )
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
+               END DO
+            END DO
+            !                                    
+         END DO         
+         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
+         !    
+         DO jk = 1, jpkm1        !==  Horizontal advective fluxes  ==!     (UBS)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2)
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  !                                                  ! 2nd order centered advective fluxes (x2)
+                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  !                                                  ! UBS advective fluxes
+                  ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )
+                  ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )
+               END DO
+            END DO
+         END DO         
+         !
+         zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update
+         !
+         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        &
+                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    &
+                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+            !                                             
+         END DO
+         !
+         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case
+         !                                            ! and/or in trend diagnostic (l_trd=T) 
+         !                
+         IF( l_trd ) THEN                  ! trend diagnostics
+             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) )
+             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) )
+         END IF
+         !     
+         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) )
+         !                                !  heati/salt transport
+         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) )
+         !
+         !
+         !                       !== vertical advective trend  ==!
+         !
+         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme
+         !
+         CASE(  2  )                   ! 2nd order FCT 
+            !         
+            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
+            !
+            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==!
+            DO jk = 2, jpkm1                 ! Interior value (w-masked)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                     zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO 
+            IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked)
+               IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface 
+                     END DO
+                  END DO   
+               ELSE                                ! no cavities: only at the ocean surface
+                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)
+               ENDIF
+            ENDIF
+            !
+            DO jk = 1, jpkm1           !* trend and after field with monotonic scheme
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
+                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+            !
+            !                          !*  anti-diffusive flux : high order minus low order
+            DO jk = 2, jpkm1        ! Interior value  (w-masked)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   &
+                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !                                            ! top ocean value: high order == upstream  ==>>  zwz=0
+            IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked
+            !
+            CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
+            !
+         CASE(  4  )                               ! 4th order COMPACT
+            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztw(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work
+            !
+         END SELECT
+         !
+         DO jk = 1, jpkm1        !  final trend with corrected fluxes
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( l_trd )  THEN       ! vertical advective trend diagnostics
+            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          &
+                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   &
+                        &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            CALL trd_tra( kt, cdtype, jn, jptra_zad, zltv )
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs')
+      !
+   END SUBROUTINE tra_adv_ubs
+
+
+   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc_z  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step
+      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   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
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('nonosc_z')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo )
+      !
+      zbig  = 1.e+40_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
+      !
+      ! Search local extrema
+      ! --------------------
+      !                    ! large negative value (-zbig) inside land
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
+      !
+      DO jk = 1, jpkm1     ! search maximum in neighbourhood
+         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  ,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(:,:,:) )
+      !
+      DO jk = 1, jpkm1     ! search minimum in neighbourhood
+         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  ,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(:,:,:)
+      !
+      ! Positive and negative part of fluxes and beta terms
+      ! ---------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! positive & negative part of the flux
+               zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+               ! up & down beta terms
+               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt
+               zbetup(ji,jj,jk) = ( 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
+      !
+      ! 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.
+               za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
+               zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
+               zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) )
+               pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('nonosc_z')
+      !
+   END SUBROUTINE nonosc_z
+
+   !!======================================================================
+END MODULE traadv_ubs
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 8732)
@@ -0,0 +1,195 @@
+MODULE trabbc
+   !!==============================================================================
+   !!                       ***  MODULE  trabbc  ***
+   !! Ocean active tracers:  bottom boundary condition (geothermal heat flux)
+   !!==============================================================================
+   !! 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)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_bbc       : update the tracer trend at ocean bottom 
+   !!   tra_bbc_init  : initialization of geothermal heat flux trend
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! domain: ocean
+   USE phycst         ! physical constants
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! xIOS 
+   USE fldread        ! read input fields
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC tra_bbc          ! routine called by step.F90
+   PUBLIC tra_bbc_init     ! routine called by opa.F90
+
+   !                                 !!* Namelist nambbc: bottom boundary condition *
+   LOGICAL, PUBLIC ::   ln_trabbc     !: Geothermal heat flux flag
+   INTEGER         ::   nn_geoflx     !  Geothermal flux (=1:constant flux, =2:read in file )
+   REAL(wp)        ::   rn_geoflx_cst !  Constant value of geothermal heat flux
+
+   REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) ::   qgh_trd0   ! geothermal heating trend
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh   ! structure of input qgh (file informations, fields read)
+ 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_bbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbc  ***
+      !!
+      !! ** Purpose :   Compute the bottom boundary contition on temperature 
+      !!              associated with geothermal heating and add it to the 
+      !!              general trend of temperature 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:
+      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
+      !!       Where Qsf is the geothermal heat flux.
+      !!
+      !! ** Action  : - update the temperature trends with geothermal heating trend
+      !!              - send the trend for further diagnostics (ln_trdtra=T)
+      !!
+      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
+      !!              Emile-Geay and Madec, 2009, Ocean Science.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj    ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
+      !
+      IF( l_trdtra )   THEN         ! Save the input temperature trend
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+      ENDIF
+      !                             !  Add the geothermal trend on temperature
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj))
+         END DO
+      END DO
+      !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
+      !
+      IF( l_trdtra ) THEN        ! Send the trend for diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_bbc')
+      !
+   END SUBROUTINE tra_bbc
+
+
+   SUBROUTINE tra_bbc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbc_init  ***
+      !!
+      !! ** Purpose :   Compute once for all the trend associated with geothermal
+      !!              heating that will be applied at each time step at the
+      !!              last ocean level
+      !!
+      !! ** Method  :   Read the nambbc namelist and check the parameters.
+      !!
+      !! ** Input   : - Namlist nambbc
+      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
+      !!
+      !! ** Action  : - read/fix the geothermal heat qgh_trd0
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj              ! dummy loop indices
+      INTEGER  ::   inum                ! temporary logical unit
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      INTEGER  ::   ierror              ! local integer
+      !
+      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
+      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
+      !
+      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist nambbc in reference namelist : Bottom momentum boundary condition
+      READ  ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition
+      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nambbc )
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
+         WRITE(numout,*) '~~~~~~~   '
+         WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
+         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
+      !
+      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(:,:) = r1_rau0_rcp * rn_geoflx_cst
+            !
+         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
+            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
+            !
+            ALLOCATE( sf_qgh(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
+               RETURN
+            ENDIF
+            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
+            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
+            ! fill sf_chl with sn_chl and control print
+            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
+               &          'bottom temperature boundary condition', 'nambbc', no_print )
+
+            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
+            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
+            !
+         CASE DEFAULT
+            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'
+      ENDIF
+      !
+   END SUBROUTINE tra_bbc_init
+
+   !!======================================================================
+END MODULE trabbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 8732)
@@ -0,0 +1,587 @@
+MODULE trabbl
+   !!==============================================================================
+   !!                       ***  MODULE  trabbl  ***
+   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
+   !!==============================================================================
+   !! 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
+   !!             -   ! 2013-04  (F. Roquet, G. Madec)  use of eosbn2 instead of local hard coded alpha and beta
+   !!----------------------------------------------------------------------
+#if   defined key_trabbl
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl'   or                             bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl_alloc : allocate trabbl arrays
+   !!   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 trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends: active tracers
+   !
+   USE iom            ! IOM library               
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_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  !: =1   : diffusive bbl or not (=0)
+   INTEGER , PUBLIC ::   nn_bbl_adv  !: =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   !: along slope bbl diffusive coefficient [m2/s]
+   REAL(wp), PUBLIC ::   rn_gambbl   !: lateral coeff. for bottom boundary layer scheme [s]
+
+   LOGICAL , PUBLIC ::   l_bbl       !: flag to compute bbl diffu. flux coef and transport
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level (PUBLIC for TAM)
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION tra_bbl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION tra_bbl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     &
+         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     &
+         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          &
+         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc )
+         !
+      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc )
+      IF( tra_bbl_alloc > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.')
+   END FUNCTION tra_bbl_alloc
+
+
+   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.
+      !!
+      !! ** 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), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl')
+      !
+      IF( l_trdtra )   THEN                         !* Save the input trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      IF( l_bbl )   CALL bbl( kt, nit000, '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                      ! send the trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl')
+      !
+   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 only (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)
+      !!
+      !! ** Action  :   pta   increased by the bbl diffusive trend
+      !!
+      !! 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, jn   ! dummy loop indices
+      INTEGER  ::   ik           ! local integers
+      REAL(wp) ::   zbtr         ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zptb
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif')
+      !
+      CALL wrk_alloc( jpi, jpj, zptb )
+      !
+      DO jn = 1, kjpt                                     ! tracer loop
+         !                                                ! ===========
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = mbkt(ji,jj)                             ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S
+            END DO
+         END DO
+         !               
+         DO jj = 2, jpjm1                                    ! Compute the trend
+            DO ji = 2, jpim1
+               ik = mbkt(ji,jj)                            ! bottom T-level index
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  &
+                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     &
+                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     &
+                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     &
+                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  &
+                  &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik)
+            END DO
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      CALL wrk_dealloc( jpi, jpj, zptb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif')
+      !
+   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           !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv')
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+               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 = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus)
+                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
+                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
+                  !
+                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk)
+                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
+                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
+                  END DO
+                  !
+                  zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud)
+                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
+                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
+               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 = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs)
+                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
+                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
+                  !
+                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk)
+                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
+                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
+                  END DO
+                  !                                               ! down-slope T-point (deep bottom point)
+                  zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd)
+                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
+                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
+               ENDIF
+            END DO
+            !
+         END DO
+         !                                                       ! ===========
+      END DO                                                     ! end tracer
+      !                                                          ! ===========
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv')
+      !
+   END SUBROUTINE tra_bbl_adv
+
+
+   SUBROUTINE bbl( kt, kit000, 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
+      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      !
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      INTEGER  ::   ik                        ! local integers
+      INTEGER  ::   iis, iid, ikus, ikud      !   -       -
+      INTEGER  ::   ijs, ijd, ikvs, ikvd      !   -       -
+      REAL(wp) ::   za, zb, zgdrho            ! local scalars
+      REAL(wp) ::   zsign, zsigna, zgbbl      !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zts, zab         ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj)        :: zub, zvb, zdep   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'bbl')
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp)  WRITE(numout,*)
+         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
+         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbkt(ji,jj)                             ! bottom T-level index
+            zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S
+            zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal)
+            !
+            zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth
+            zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity
+            zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj))
+         END DO
+      END DO
+      !
+      CALL eos_rab( zts, zdep, zab )
+      !
+      !                                   !-------------------!
+      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, fs_jpim1   ! vector opt.
+               !                                                   ! i-direction
+               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
+               zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
+               !                                                         ! 2*masked bottom density gradient
+               zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
+                  &      - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * 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.
+               !
+               !                                                   ! j-direction
+               za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at v-point
+               zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
+               !                                                         ! 2*masked bottom density gradient
+               zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
+                  &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * 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
+         !
+      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
+                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
+                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
+                  !                                                          ! 2*masked bottom density gradient 
+                  zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
+                            - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * 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
+                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
+                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
+                  !                                                          ! 2*masked bottom density gradient
+                  zgdrho = (  za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) )    &
+                     &      - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) )  ) * 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 transport
+                  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)
+                  !
+                  za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
+                  zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
+                  !                                                          !   masked bottom density gradient
+                  zgdrho = 0.5 * (  za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) )    &
+                     &            - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) )  ) * 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)
+                  !
+                  za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at v-point
+                  zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal)
+                  !                                                          !   masked bottom density gradient
+                  zgdrho = 0.5 * (  za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) )    &
+                     &            - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) )  ) * 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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'bbl')
+      !
+   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 nemo_init at the first timestep (kit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj               ! dummy loop indices
+      INTEGER ::   ii0, ii1, ij0, ij1   ! local integer
+      INTEGER ::   ios                  !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
+      !
+      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init')
+      !
+      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme
+      READ  ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme
+      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, 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
+
+      !                              ! allocate trabbl arrays
+      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' )
+
+      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)'
+
+      !                             !* 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
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
+      CALL wrk_alloc( jpi, jpj, zmbk )
+      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      CALL wrk_dealloc( jpi, jpj, zmbk )
+
+      !                                 !* sign of grad(H) at u- and v-points
+      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, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
+         END DO
+      END DO
+      !
+      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( e3u_0(ji,jj,mbkt(ji+1,jj  )), e3u_0(ji,jj,mbkt(ji,jj)) )
+            e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji  ,jj+1)), e3v_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 * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1)
+
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init')
+      !
+   END SUBROUTINE tra_bbl_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag
+CONTAINS
+   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
+
+   !!======================================================================
+END MODULE trabbl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 8732)
@@ -0,0 +1,231 @@
+MODULE tradmp
+   !!======================================================================
+   !!                       ***  MODULE  tradmp  ***
+   !! Ocean physics: internal restoring trend on active tracers (T and S)
+   !!======================================================================
+   !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code
+   !!                 ! 1992-06  (M. Imbard)  doctor norme
+   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
+   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code
+   !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning
+   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
+   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter
+   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
+   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
+   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file
+   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_dmp_alloc : allocate tradmp arrays
+   !!   tra_dmp       : update the tracer trend with the internal damping
+   !!   tra_dmp_init  : initialization, namlist read, parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean: variables
+   USE dom_oce        ! ocean: domain variables
+   USE c1d            ! 1D vertical configuration
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   USE zdf_oce        ! ocean: vertical physics
+   USE phycst         ! physical constants
+   USE dtatsd         ! data: temperature & salinity
+   USE zdfmxl         ! vertical physics: mixed layer depth
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_dmp        ! called by step.F90
+   PUBLIC   tra_dmp_init   ! called by nemogcm.F90
+
+   !                                           !!* Namelist namtra_dmp : T & S newtonian damping *
+   LOGICAL            , PUBLIC ::   ln_tradmp   !: internal damping flag
+   INTEGER            , PUBLIC ::   nn_zdmp     !: = 0/1/2 flag for damping in the mixed layer
+   CHARACTER(LEN=200) , PUBLIC ::   cn_resto    !: name of netcdf file containing restoration coefficient field
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION tra_dmp_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION tra_dmp_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
+      !
+      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc )
+      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
+      !
+   END FUNCTION tra_dmp_alloc
+
+
+   SUBROUTINE tra_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_dmp  ***
+      !!                  
+      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
+      !!      of the tracer field towards given data field and add it to the
+      !!      general tracer trends.
+      !!
+      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed 
+      !!      and add to the general tracer trends:
+      !!                     ta = ta + resto * (t_dta - tb)
+      !!                     sa = sa + resto * (s_dta - sb)
+      !!         The trend is computed either throughout the water column
+      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
+      !!      below the well mixed layer (nlmdmp=2)
+      !!
+      !! ** Action  : - tsa: tracer trends updated with the damping trend
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_dmp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta )
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts ) 
+         ztrdts(:,:,:,:) = tsa(:,:,:,:) 
+      ENDIF
+      !                           !==  input T-S data at kt  ==!
+      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt
+      !
+      SELECT CASE ( nn_zdmp )     !==  type of damping  ==!
+      !
+      CASE( 0 )                        !*  newtonian damping throughout the water column  *!
+         DO jn = 1, jpts
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *!
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 2 )                       !*  no damping in the mixed layer   *!
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      IF( l_trdtra )   THEN       ! trend diagnostic
+         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
+         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   ztrdts ) 
+      ENDIF
+      !                           ! Control print
+      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' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp')
+      !
+   END SUBROUTINE tra_dmp
+
+
+   SUBROUTINE tra_dmp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_dmp_init  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the namtra_dmp namelist and check the parameters
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask   ! local integers 
+      !
+      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )   ! Namelist namtra_dmp in reference namelist : T & S relaxation
+      READ  ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )   ! Namelist namtra_dmp in configuration namelist : T & S relaxation
+      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namtra_dmp )
+      !
+      IF(lwp) THEN                  ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters'
+         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp
+         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp
+         WRITE(numout,*) '      Damping file name               cn_resto  = ', cn_resto
+         WRITE(numout,*)
+      ENDIF
+      !
+      IF( ln_tradmp) THEN
+         !                          ! Allocate arrays
+         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
+         !
+         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp
+         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask'
+         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)'
+         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer'
+         CASE DEFAULT
+            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
+         END SELECT
+         !
+         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
+         !    so can damp to something other than intitial conditions files?
+         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
+         IF( .NOT.ln_tsd_tradmp ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T'
+            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
+         ENDIF
+         !                          ! Read in mask from file
+         CALL iom_open ( cn_resto, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto )
+         CALL iom_close( imask )
+      ENDIF
+      !
+   END SUBROUTINE tra_dmp_init
+
+   !!======================================================================
+END MODULE tradmp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 8732)
@@ -0,0 +1,201 @@
+MODULE traldf
+   !!======================================================================
+   !!                       ***  MODULE  traldf  ***
+   !! Ocean Active tracers : lateral diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11  (G. Madec)  Original code
+   !!  NEMO      3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!            3.7  ! 2013-12  (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg
+   !!             -   ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!             -   ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of lateral diffusive operators
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf       : update the tracer trend with the lateral diffusion trend
+   !!   tra_ldf_init  : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfslp         ! lateral diffusion: iso-neutral slope
+   USE traldf_lap_blp ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap/_blp   routines)
+   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine )
+   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad      routine )
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! ocean active tracers trends
+   !
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distribued memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf        ! called by step.F90 
+   PUBLIC   tra_ldf_init   ! called by nemogcm.F90 
+   !
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals)
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf  ***
+      !! 
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_ldf')
+      !
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+      !
+      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend
+      CASE ( np_lap   )                                  ! laplacian: iso-level operator
+         CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb,      tsa, jpts,  1   )
+      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   )
+      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
+         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf )
+      END SELECT
+      !
+      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt, ztrds ) 
+      ENDIF
+      !                                        !* print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_ldf')
+      !
+   END SUBROUTINE tra_ldf
+
+
+   SUBROUTINE tra_ldf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_init  ***
+      !! 
+      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr   ! temporary integers 
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                     ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_ldf: already read in ldftra module'
+         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters'
+      ENDIF
+      !                                   ! use of lateral operator or not
+      nldf   = np_ERROR
+      ioptio = 0
+      IF( ln_traldf_lap )   ioptio = ioptio + 1
+      IF( ln_traldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion
+      !
+      IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator  
+         ioptio = 0
+         IF( ln_traldf_lev )   ioptio = ioptio + 1
+         IF( ln_traldf_hor )   ioptio = ioptio + 1
+         IF( ln_traldf_iso )   ioptio = ioptio + 1
+         IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' )
+         !
+         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals
+         ierr = 0
+         IF( ln_traldf_lap ) THEN         ! laplacian operator
+            IF ( ln_zco ) THEN               ! z-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN               ! z-coordinate with partial step
+               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
+               IF ( ln_traldf_hor   )   nldf = np_lap     ! horizontal             (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard     (rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad        (rotation)
+            ENDIF
+            IF ( ln_sco ) THEN               ! s-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_lap     ! iso-level              (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_lap_i   ! horizontal             (   rotation)
+               IF ( ln_traldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+         ENDIF
+         !
+         IF( ln_traldf_blp ) THEN         ! bilaplacian operator
+            IF ( ln_zco ) THEN               ! z-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_zps ) THEN               ! z-coordinate with partial step
+               IF ( ln_traldf_lev   )   ierr = 1          ! iso-level not allowed 
+               IF ( ln_traldf_hor   )   nldf = np_blp     ! horizontal             (no rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+            IF ( ln_sco ) THEN               ! s-coordinate
+               IF ( ln_traldf_lev   )   nldf = np_blp     ! iso-level              (no rotation)
+               IF ( ln_traldf_hor   )   nldf = np_blp_it  ! horizontal             (   rotation)
+               IF ( ln_traldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard  (   rotation)
+               IF ( ln_traldf_triad )   nldf = np_blp_it  ! iso-neutral: triad     (   rotation)
+            ENDIF
+         ENDIF
+         IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-partial step, not allowed' )
+      ENDIF
+      !
+      IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) )                                    &
+           &            CALL ctl_stop( 'eddy induced velocity on tracers requires iso-neutral laplacian diffusion' )
+      IF( ln_isfcav .AND. ln_traldf_triad ) &
+           &            CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' )
+           !
+      IF(  nldf == np_lap_i .OR. nldf == np_lap_it .OR. &
+         & nldf == np_blp_i .OR. nldf == np_blp_it  )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         SELECT CASE( nldf )
+         CASE( np_no_ldf )   ;   WRITE(numout,*) '      ===>>   NO lateral diffusion'
+         CASE( np_lap    )   ;   WRITE(numout,*) '      ===>>   laplacian iso-level operator'
+         CASE( np_lap_i  )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (standard)'
+         CASE( np_lap_it )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (triad)'
+         CASE( np_blp    )   ;   WRITE(numout,*) '      ===>>   bilaplacian iso-level operator'
+         CASE( np_blp_i  )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (standard)'
+         CASE( np_blp_it )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (triad)'
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE tra_ldf_init
+
+   !!======================================================================
+END MODULE traldf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 8732)
@@ -0,0 +1,398 @@
+MODULE traldf_iso
+   !!======================================================================
+   !!                   ***  MODULE  traldf_iso  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History :  OPA  ! 1994-08  (G. Madec, M. Imbard)
+   !!            8.0  ! 1997-05  (G. Madec)  split into traldf and trazdf
+   !!            NEMO ! 2002-08  (G. Madec)  Free form, F90
+   !!            1.0  ! 2005-11  (G. Madec)  merge traldf and trazdf :-)
+   !!            3.3  ! 2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!            3.7  ! 2014-01  (G. Madec, S. Masson)  restructuration/simplification of aht/aeiv specification
+   !!             -   ! 2014-02  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso   : update the tracer trend with the horizontal component of a iso-neutral laplacian operator
+   !!                   and with the vertical part of the isopycnal or geopotential s-coord. operator 
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zdf_oce        ! ocean vertical physics
+   USE ldftra         ! lateral diffusion: tracer eddy coefficients
+   USE ldfslp         ! iso-neutral slopes
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE phycst         ! physical constants
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_iso   ! routine called by step.F90
+
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL  ::   l_hst   ! flag to compute heat transport
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                   pgui, pgvi,   &
+      &                                       ptb , ptbb, pta , kjpt, kpass )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso  ***
+      !!
+      !! ** 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
+      !!                  with top     cell update if ln_isfcav
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========    
+      !!         zftu =  pahu e2u*e3u/e1u di[ tb ]
+      !!               - pahu e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv =  pahv e1v*e3v/e2v dj[ tb ]
+      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1e2t*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 = - {  mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ]
+      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ikt
+      INTEGER  ::  ierr             ! local integer
+      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso')
+      !
+      CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         akz     (:,:,:) = 0._wp      
+         ah_wslp2(:,:,:) = 0._wp
+      ENDIF
+      !   
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE. 
+      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
+      !
+      !                                            ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
+      ENDIF
+      z1_2dt = 1._wp / z2dt
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+         
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2 and akz
+      !!----------------------------------------------------------------------
+      !
+      IF( kpass == 1 ) THEN                  !==  first pass only  ==!
+         !
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !
+                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+                     !
+                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+                     !
+                  ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &               + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     akz(ji,jj,jk) = 0.25_wp * (                                                                     &
+                        &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
+                        &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
+                        &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
+                        &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
+                  END DO
+               END DO
+            END DO
+            !
+            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
+                     END DO
+                  END DO
+               END DO
+            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk)
+                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
+                     END DO
+                  END DO
+               END DO
+           ENDIF
+           !
+         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
+            akz(:,:,:) = ah_wslp2(:,:,:)      
+         ENDIF
+      ENDIF
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         !!----------------------------------------------------------------------
+         !!   I - masked horizontal derivative 
+         !!----------------------------------------------------------------------
+!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp
+         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp
+         !!end
+
+         ! 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
+         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
+            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+               END DO
+            END DO
+            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)          
+                     IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)     
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !
+            !                             !== Vertical tracer gradient
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk)
+            ENDIF
+            DO jj = 1 , jpjm1            !==  Horizontal fluxes
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)
+                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)
+                  !
+                  zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   &
+                     &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. )
+                  !
+                  zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  !
+                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
+                     &               + zcof1 * (  zdkt (ji+1,jj) + 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
+            !
+            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      &
+                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
+                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO                                        !   End of slab  
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend (full)
+         !!----------------------------------------------------------------------
+         !
+         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp
+         !
+         ! Vertical fluxes
+         ! ---------------
+         !                          ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
+         
+         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !
+                  zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
+                     &                           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk) , 1._wp  )
+                  zmskv = wmask(ji,jj,jk) / MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)          &
+                     &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
+                     !
+                  zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
+                     &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
+                  zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
+                     &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+                     !
+                  zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)   !wslpi & j are already w-masked
+                  zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  !
+                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+                     &                        + 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
+         !                                !==  add the vertical 33 flux  ==!
+         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
+            DO jk = 2, jpkm1       
+               DO jj = 1, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)   &
+                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+            !
+         ELSE                                   ! bilaplacian 
+            SELECT CASE( kpass )
+            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    &
+                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   &
+                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO 
+            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)                      &
+                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
+                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
+                     END DO
+                  END DO
+               END DO
+            END SELECT
+         ENDIF
+         !         
+         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   &
+                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
+            !
+            !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
+               ! note sign is reversed to give down-gradient diffusive transports )
+            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:)  )
+            !                          ! Diffusive heat transports
+            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) )
+            !
+         ENDIF                                                    !== end pass selection  ==!
+         !
+         !                                                        ! ===============
+      END DO                                                      ! end tracer loop
+      !                                                           ! ===============
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
+      !
+   END SUBROUTINE tra_ldf_iso
+
+   !!==============================================================================
+END MODULE traldf_iso
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90	(revision 8732)
@@ -0,0 +1,263 @@
+MODULE traldf_lap_blp
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap_blp  ***
+   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
+   !!==============================================================================
+   !! History :  3.7  ! 2014-01  (G. Madec, S. Masson)  Original code, re-entrant laplacian 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap   : tracer trend update with iso-level laplacian diffusive operator
+   !!   tra_ldf_blp   : tracer trend update with iso-level or iso-neutral bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE ldftra         ! lateral physics: eddy diffusivity
+   USE traldf_iso     ! iso-neutral lateral diffusion (standard operator)     (tra_ldf_iso   routine)
+   USE traldf_triad   ! iso-neutral lateral diffusion (triad    operator)     (tra_ldf_triad routine)
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distribued memory computing library
+   USE timing         ! Timing
+   USE wrk_nemo       ! Memory allocation
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_lap   ! called by traldf.F90
+   PUBLIC   tra_ldf_blp   ! called by traldf.F90
+
+   !                      ! Flag to control the type of lateral diffusive operator
+   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10   ! error in specification of lateral diffusion
+   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00   ! without operator (i.e. no lateral diffusive trend)
+   !                          !!      laplacian     !    bilaplacian    !
+   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  ! iso-level operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11   ,   np_blp_i  = 21  ! standard iso-neutral or geopotential operator
+   INTEGER, PARAMETER, PUBLIC ::   np_lap_it = 12   ,   np_blp_it = 22  ! triad    iso-neutral or geopotential operator
+
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL  ::   l_hst   ! flag to compute heat transport
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                        ptb , pta , kjpt, kpass ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      the tracer is given by:
+      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ]
+      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
+      !!      Add this trend to the general tracer trend pta :
+      !!          pta = pta + difft
+      !!
+      !! ** Action  : - Update pta arrays with the before iso-level 
+      !!                harmonic mixing trend.
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zsign            ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
+      !
+      IF( kt == nit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
+      !
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE. 
+      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
+      !
+      !                                !==  Initialization of metric arrays used for all tracers  ==!
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
+               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      !                             ! =========== !
+      DO jn = 1, kjpt               ! tracer loop !
+         !                          ! =========== !    
+         !                               
+         DO jk = 1, jpkm1              !== First derivative (gradient)  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO  
+         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level
+            DO jj = 1, jpjm1                    ! bottom
+               DO ji = 1, fs_jpim1
+                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
+                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
+               END DO
+            END DO  
+            IF( ln_isfcav ) THEN                ! top in ocean cavities only
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
+                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
+                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
+                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO  
+         !
+         !                             !== "Poleward" diffusive heat or salt transports  ==!
+         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==!
+
+            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:)  )
+            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) )
+         ENDIF
+         !                          ! ==================
+      END DO                        ! end of tracer loop
+      !                             ! ==================
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap')
+      !
+   END SUBROUTINE tra_ldf_lap
+   
+
+   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                    pgui, pgvi,   &
+      &                                                    ptb , pta , kjpt, kldf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_ldf_blp  ***
+      !!                    
+      !! ** Purpose :   Compute the before lateral tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The lateral diffusive trends is provided by a bilaplacian
+      !!      operator applied to before field (forward in time).
+      !!      It is computed by two successive calls to laplacian routine
+      !!
+      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kldf       ! type of operator used
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      !
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points)
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap ) 
+      CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi ) 
+      !
+      IF( kt == kit000 .AND. lwp )  THEN
+         WRITE(numout,*)
+         SELECT CASE ( kldf )
+         CASE ( np_blp    )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-level   bilaplacian operator on ', cdtype
+         CASE ( np_blp_i  )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)'
+         CASE ( np_blp_it )   ;   WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)'
+         END SELECT
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      zlap(:,:,:,:) = 0._wp
+      !
+      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==!
+      !
+      CASE ( np_blp    )               ! iso-level bilaplacian
+         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 )
+      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
+         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
+         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )
+      END SELECT
+      !
+      DO jn = 1, kjpt
+         CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. )     ! Lateral boundary conditions (unchanged sign)
+      END DO
+      !                                               ! Partial top/bottom cell: GRADh( zlap )  
+      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
+      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, kjpt, zlap, zglu, zglv )              ! only bottom 
+      ENDIF
+      !
+      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==!
+      !
+      CASE ( np_blp    )               ! iso-level bilaplacian
+         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 )
+      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec)
+         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies)
+         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap ) 
+      CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp')
+      !
+   END SUBROUTINE tra_ldf_blp
+
+   !!==============================================================================
+END MODULE traldf_lap_blp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90	(revision 8732)
@@ -0,0 +1,445 @@
+MODULE traldf_triad
+   !!======================================================================
+   !!                   ***  MODULE  traldf_triad  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History :  3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  Griffies operator (original code)
+   !!            3.7  ! 2013-12  (F. Lemarie, G. Madec)  triad operator (Griffies) + Method of Stabilizing Correction
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_triad : update the tracer trend with the iso-neutral laplacian triad-operator
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE zdf_oce        ! ocean vertical physics
+   USE ldftra         ! lateral physics: eddy diffusivity
+   USE ldfslp         ! lateral physics: iso-neutral slopes
+   USE traldf_iso     ! lateral diffusion (Madec operator)         (tra_ldf_iso routine)
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   USE zpshde         ! partial step: hor. derivative     (zps_hde routine)
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_triad   ! routine called by traldf.F90
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d   !: vertical tracer gradient at 2 levels
+
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL  ::   l_hst   ! flag to compute heat transport
+
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
+      &                                                     pgui, pgvi,   &
+      &                                         ptb , ptbb, pta , kjpt, kpass )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_triad  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
+      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      see documentation for the desciption
+      !!
+      !! ** Action :   pta   updated with the before rotated diffusion
+      !!               ah_wslp2 ....
+      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp)
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::  ip,jp,kp         ! dummy loop indices
+      INTEGER  ::  ierr            ! local integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3          ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4          !   -      -
+      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt  !   -      -
+      !
+      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
+      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt
+      REAL(wp) ::   zah, zah_slp, zaei_slp
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad')
+      !
+      CALL wrk_alloc( jpi,jpj,       z2d ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
+      !
+      IF( .NOT.ALLOCATED(zdkt3d) )  THEN
+         ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr )
+         IF( lk_mpp   )   CALL mpp_sum ( ierr )
+         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays')
+      ENDIF
+     !
+      IF( kpass == 1 .AND. kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !   
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE. 
+      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE.
+      !
+      !                                                        ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler)
+      ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog)
+      ENDIF
+      z1_2dt = 1._wp / z2dt
+      !
+      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
+      ELSE                    ;   zsign = -1._wp
+      ENDIF
+      !    
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw
+      !!----------------------------------------------------------------------
+      !
+      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==!
+         !
+         akz     (:,:,:) = 0._wp      
+         ah_wslp2(:,:,:) = 0._wp
+         IF( ln_ldfeiv_dia ) THEN
+            zpsi_uw(:,:,:) = 0._wp
+            zpsi_vw(:,:,:) = 0._wp
+         ENDIF
+         !
+         DO ip = 0, 1                            ! i-k triads
+            DO kp = 0, 1
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                        zbu   = e1e2u(ji,jj) * e3u_n(ji,jj,jk)
+                        zah   = 0.25_wp * pahu(ji,jj,jk)
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+                        zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                        zslope2 = zslope2 *zslope2
+                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2
+                        akz     (ji+ip,jj,jk+kp) = akz     (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj)       &
+                           &                                                      * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+                           !
+                       IF( ln_ldfeiv_dia )   zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)   &
+                           &                                       + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         DO jp = 0, 1                            ! j-k triads 
+            DO kp = 0, 1
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp)
+                        zbv   = e1e2v(ji,jj) * e3v_n(ji,jj,jk)
+                        zah   = 0.25_wp * pahv(ji,jj,jk)
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+                        !    (do this by *adding* gradient of depth)
+                        zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                        zslope2 = zslope2 * zslope2
+                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2
+                        akz     (ji,jj+jp,jk+kp) = akz     (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj)     &
+                           &                                                      * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+                        !
+                        IF( ln_ldfeiv_dia )   zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)   &
+                           &                                       + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
+            !
+            IF( ln_traldf_blp ) THEN                ! bilaplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   &
+                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  )
+                     END DO
+                  END DO
+               END DO
+            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
+               DO jk = 2, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk)
+                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
+                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt
+                     END DO
+                  END DO
+               END DO
+           ENDIF
+           !
+         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
+            akz(:,:,:) = ah_wslp2(:,:,:)      
+         ENDIF
+         !
+         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' )   CALL ldf_eiv_dia( zpsi_uw, zpsi_vw )
+         !
+      ENDIF                                  !==  end 1st pass only  ==!
+      !
+      !                                                           ! ===========
+      DO jn = 1, kjpt                                             ! tracer loop
+         !                                                        ! ===========
+         ! Zero fluxes for each tracer
+!!gm  this should probably be done outside the jn loop
+         ztfw(:,:,:) = 0._wp
+         zftu(:,:,:) = 0._wp
+         zftv(:,:,:) = 0._wp
+         !
+         DO jk = 1, jpkm1        !==  before lateral T & S gradients at T-level jk  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level
+            DO jj = 1, jpjm1                       ! bottom level
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+               END DO
+            END DO
+            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only)
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
+                     IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1
+            !                    !==  Vertical tracer gradient at level jk and jk+1
+            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            !
+            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1)
+            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
+            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+            !
+            zaei_slp = 0._wp
+            !
+            IF( ln_botmix_triad ) THEN
+               DO ip = 0, 1              !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = r1_e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
+                           !
+                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk)
+                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                           zah = pahu(ji,jj,jk)
+                           zah_slp  = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
+                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+               !
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = r1_e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp)
+                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk)
+                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
+                           zah = pahv(ji,jj,jk)
+                           zah_slp = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
+                           zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+               !
+            ELSE
+               !
+               DO ip = 0, 1               !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = r1_e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp)
+                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
+                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
+                           !
+                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk)
+                           ! ln_botmix_triad is .F. mask zah for bottom half cells
+                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                           zah_slp  = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew
+                           zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+               !
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = r1_e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp)
+                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
+                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk)
+                           ! ln_botmix_triad is .F. mask zah for bottom half cells
+                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                           zah_slp = zah * zslope_iso
+                           IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew
+                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+            !                             !==  horizontal divergence and add to the general trend  ==!
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       &
+                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
+                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  )
+               END DO
+            END DO
+            !
+         END DO
+         !
+         !                                !==  add the vertical 33 flux  ==!
+         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
+            DO jk = 2, jpkm1       
+               DO jj = 1, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   &
+                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
+                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+         ELSE                                   ! bilaplacian 
+            SELECT CASE( kpass )
+            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)             &
+                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) )
+                     END DO
+                  END DO
+               END DO 
+            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp.
+               DO jk = 2, jpkm1 
+                  DO jj = 1, jpjm1
+                     DO ji = fs_2, fs_jpim1
+                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      &
+                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   &
+                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   )
+                     END DO
+                  END DO
+               END DO
+            END SELECT 
+         ENDIF
+         !
+         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
+                     &                                        / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR.  &     !==  first pass only (  laplacian)  ==!
+             ( kpass == 2 .AND. ln_traldf_blp ) ) THEN      !==  2nd   pass      (bilaplacian)  ==!
+            !
+            !                          ! "Poleward" diffusive heat or salt transports (T-S case only)
+            IF( l_ptr )  CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:)  )
+            !                          ! Diffusive heat transports
+            IF( l_hst )  CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) )
+            !
+         ENDIF                                                    !== end pass selection  ==!
+         !
+         !                                                        ! ===============
+      END DO                                                      ! end tracer loop
+      !                                                           ! ===============
+      !
+      CALL wrk_dealloc( jpi,jpj,       z2d ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad')
+      !
+   END SUBROUTINE tra_ldf_triad
+
+   !!==============================================================================
+END MODULE traldf_triad
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 8732)
@@ -0,0 +1,337 @@
+MODULE tranpc
+   !!==============================================================================
+   !!                       ***  MODULE  tranpc  ***
+   !! Ocean active tracers:  non penetrative convective adjustment scheme
+   !!==============================================================================
+   !! History :  1.0  ! 1990-09  (G. Madec)  Original code
+   !!                 ! 1996-01  (G. Madec)  statement function for e3
+   !!   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
+   !!            3.6  ! 2015-05  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq.
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_npc       : apply the non penetrative convection scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE zdf_oce        ! ocean vertical physics
+   USE trd_oce        ! ocean active tracer trends
+   USE trdtra         ! ocean active tracer trends
+   USE eosbn2         ! equation of state (eos routine)
+   !
+   USE lbclnk         ! lateral boundary conditions (or mpp link)
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_npc    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_npc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tranpc  ***
+      !!
+      !! ** Purpose : Non-penetrative convective adjustment scheme. solve
+      !!      the static instability of the water column on after fields
+      !!      while conserving heat and salt contents.
+      !!
+      !! ** Method  : updated algorithm able to deal with non-linear equation of state
+      !!              (i.e. static stability computed locally)
+      !!
+      !! ** Action  : - tsa: after tracers with the application of the npc scheme
+      !!              - send the associated trends for on-line diagnostics (l_trdtra=T)
+      !!
+      !! References :     Madec, et al., 1991, JPO, 21, 9, 1349-1371.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   inpcc        ! number of statically instable water column
+      INTEGER  ::   jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low   ! local integers
+      LOGICAL  ::   l_bottom_reached, l_column_treated
+      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z
+      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt
+      REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0)
+      REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point...
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point...
+      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2 
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace
+      !
+      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
+      INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1"
+      LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu"
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_npc')
+      !
+      IF( MOD( kt, nn_npc ) == 0 ) THEN
+         !
+         CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2
+         CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta
+         CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj
+         CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj
+
+         IF( l_trdtra )   THEN                    !* Save initial after fields
+            CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+            ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+         ENDIF
+
+         IF( l_LB_debug ) THEN
+            ! Location of 1 known convection site to follow what's happening in the water column
+            ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column...           
+            nncpu = 1  ;            ! the CPU domain contains the convection spot
+            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...          
+         ENDIF
+         
+         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points)
+         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points)
+        
+         inpcc = 0
+
+         DO jj = 2, jpjm1                 ! interior column only
+            DO ji = fs_2, fs_jpim1
+               !
+               IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points
+                  !                                     ! consider one ocean column 
+                  zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem)      ! temperature
+                  zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal)      ! salinity
+                  !
+                  zvab(:,jp_tem)  = zab(ji,jj,:,jp_tem)     ! Alpha 
+                  zvab(:,jp_sal)  = zab(ji,jj,:,jp_sal)     ! Beta  
+                  zvn2(:)         = zn2(ji,jj,:)            ! N^2 
+                  !
+                  IF( l_LB_debug ) THEN                  !LB debug:
+                     lp_monitor_point = .FALSE.
+                     IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE.
+                     ! writing only if on CPU domain where conv region is:
+                     lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                      
+                  ENDIF                                  !LB debug  end
+                  !
+                  ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level
+                  ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2)
+                  ilayer = 0
+                  jiter  = 0
+                  l_column_treated = .FALSE.
+                  !
+                  DO WHILE ( .NOT. l_column_treated )
+                     !
+                     jiter = jiter + 1
+                     ! 
+                     IF( jiter >= 400 ) EXIT
+                     !
+                     l_bottom_reached = .FALSE.
+                     !
+                     DO WHILE ( .NOT. l_bottom_reached )
+                        !
+                        ikp = ikp + 1
+                        !
+                        !! Testing level ikp for instability
+                        !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+                        IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found!
+                           !
+                           ilayer = ilayer + 1    ! yet another instable portion of the water column found....
+                           !
+                           IF( lp_monitor_point ) THEN 
+                              WRITE(numout,*)
+                              IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability
+                                 WRITE(numout,*)
+                                 WRITE(numout,*) 'Time step = ',kt,' !!!'
+                              ENDIF
+                              WRITE(numout,*)  ' * Iteration #',jiter,': found instable portion #',ilayer,   &
+                                 &                                    ' in column! Starting at ikp =', ikp
+                              WRITE(numout,*)  ' *** N2 for point (i,j) = ',ji,' , ',jj
+                              DO jk = 1, klc1
+                                 WRITE(numout,*) jk, zvn2(jk)
+                              END DO
+                              WRITE(numout,*)
+                           ENDIF
+                           !
+                           IF( jiter == 1 )   inpcc = inpcc + 1 
+                           !
+                           IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
+                           !
+                           !! ikup is the uppermost point where mixing will start:
+                           ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
+                           !
+                           !! If the points above ikp-1 have N2 == 0 they must also be mixed:
+                           IF( ikp > 2 ) THEN
+                              DO jk = ikp-1, 2, -1
+                                 IF( ABS(zvn2(jk)) < zn2_zero ) THEN
+                                    ikup = ikup - 1  ! 1 more upper level has N2=0 and must be added for the mixing
+                                 ELSE
+                                    EXIT
+                                 ENDIF
+                              END DO
+                           ENDIF
+                           !
+                           IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1')
+                           !
+                           zsum_temp = 0._wp
+                           zsum_sali = 0._wp
+                           zsum_alfa = 0._wp
+                           zsum_beta = 0._wp
+                           zsum_z    = 0._wp
+                                                    
+                           DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column
+                              !
+                              zdz       = e3t_n(ji,jj,jk)
+                              zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz
+                              zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz
+                              zsum_alfa = zsum_alfa + zvab(jk,jp_tem)*zdz
+                              zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz
+                              zsum_z    = zsum_z    + zdz
+                              !                              
+                              IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line
+                              !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0):
+                              IF( zvn2(jk+1) > zn2_zero ) EXIT
+                           END DO
+                          
+                           ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2
+                           IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2')
+
+                           ! Mixing Temperature, salinity, alpha and beta from ikup to ikdown included:
+                           zta   = zsum_temp/zsum_z
+                           zsa   = zsum_sali/zsum_z
+                           zalfa = zsum_alfa/zsum_z
+                           zbeta = zsum_beta/zsum_z
+
+                           IF( lp_monitor_point ) THEN
+                              WRITE(numout,*) 'MIXED T, S, alfa and beta between ikup =',ikup,   &
+                                 &            ' and ikdown =',ikdown,', in layer #',ilayer
+                              WRITE(numout,*) '  => Mean temp. in that portion =', zta
+                              WRITE(numout,*) '  => Mean sali. in that portion =', zsa
+                              WRITE(numout,*) '  => Mean Alfa  in that portion =', zalfa
+                              WRITE(numout,*) '  => Mean Beta  in that portion =', zbeta
+                           ENDIF
+
+                           !! Homogenaizing the temperature, salinity, alpha and beta in this portion of the column
+                           DO jk = ikup, ikdown
+                              zvts(jk,jp_tem) = zta
+                              zvts(jk,jp_sal) = zsa
+                              zvab(jk,jp_tem) = zalfa
+                              zvab(jk,jp_sal) = zbeta
+                           END DO
+                           
+                           
+                           !! Updating N2 in the relvant portion of the water column
+                           !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
+                           !! => Need to re-compute N2! will use Alpha and Beta!
+                           
+                           ikup   = MAX(2,ikup)         ! ikup can never be 1 !
+                           ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown!
+                           
+                           DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown!
+
+                              !! Interpolating alfa and beta at W point:
+                              zrw =  (gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk)) &
+                                 & / (gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk))
+                              zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
+                              zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
+
+                              !! N2 at W point, doing exactly as in eosbn2.F90:
+                              zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
+                                 &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  &
+                                 &       / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+
+                              !! OR, faster  => just considering the vertical gradient of density
+                              !! as only the signa maters...
+                              !zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     &
+                              !     &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )
+
+                           END DO
+                        
+                           ikp = MIN(ikdown+1,ikbot)
+                           
+
+                        ENDIF  !IF( zvn2(ikp) < 0. )
+
+
+                        IF( ikp == ikbot ) l_bottom_reached = .TRUE.
+                        !
+                     END DO ! DO WHILE ( .NOT. l_bottom_reached )
+
+                     IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3')
+                    
+                     ! ******* At this stage ikp == ikbot ! *******
+                    
+                     IF( ilayer > 0 ) THEN      !! least an unstable layer has been found
+                        !
+                        IF( lp_monitor_point ) THEN
+                           WRITE(numout,*)
+                           WRITE(numout,*) 'After ',jiter,' iteration(s), we neutralized ',ilayer,' instable layer(s)'
+                           WRITE(numout,*) '   ==> N2 at i,j=',ji,',',jj,' now looks like this:'
+                           DO jk = 1, klc1
+                              WRITE(numout,*) jk, zvn2(jk)
+                           END DO
+                           WRITE(numout,*)
+                        ENDIF
+                        !
+                        ikp    = 1     ! starting again at the surface for the next iteration
+                        ilayer = 0
+                     ENDIF
+                     !
+                     IF( ikp >= ikbot )   l_column_treated = .TRUE.
+                     !
+                  END DO ! DO WHILE ( .NOT. l_column_treated )
+
+                  !! Updating tsa:
+                  tsa(ji,jj,:,jp_tem) = zvts(:,jp_tem)
+                  tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal)
+
+                  !! LB:  Potentially some other global variable beside theta and S can be treated here
+                  !!      like BGC tracers.
+
+                  IF( lp_monitor_point )   WRITE(numout,*)
+
+               ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN
+
+            END DO ! ji
+         END DO ! jj
+         !
+         IF( l_trdtra ) THEN         ! send the Non penetrative mixing trends for diagnostic
+            z1_r2dt = 1._wp / (2._wp * rdt)
+            ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt
+            ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt
+            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt )
+            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds )
+            CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ENDIF
+         !
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+         !
+         IF( lwp .AND. l_LB_debug ) THEN
+            WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc
+            WRITE(numout,*)
+         ENDIF
+         !
+         CALL wrk_dealloc(jpi, jpj, jpk, zn2 )
+         CALL wrk_dealloc(jpi, jpj, jpk, 2, zab )
+         CALL wrk_dealloc(jpk, zvn2 )
+         CALL wrk_dealloc(jpk, 2, zvts, zvab )
+         !
+      ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_npc')
+      !
+   END SUBROUTINE tra_npc
+
+   !!======================================================================
+END MODULE tranpc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 8732)
@@ -0,0 +1,342 @@
+MODULE tranxt
+   !!======================================================================
+   !!                       ***  MODULE  tranxt  ***
+   !! Ocean active tracers:  time stepping on temperature and salinity
+   !!======================================================================
+   !! History :  OPA  !  1991-11  (G. Madec)  Original code
+   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
+   !!            8.0  !  1996-02  (G. Madec & M. Imbard)  opa release 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-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!             -   !  2005-04  (C. Deltel) Add Asselin trend in the ML budget
+   !!            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-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 sbcrnf          ! river runoffs
+   USE sbcisf          ! ice shelf melting
+   USE zdf_oce         ! ocean vertical mixing
+   USE domvvl          ! variable volume
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
+   USE traqsr          ! penetrative solar radiation (needed for nksr)
+   USE phycst          ! physical constant
+   USE ldftra          ! lateral physics on tracers
+   USE ldfslp
+   USE bdy_oce   , ONLY: ln_bdy
+   USE bdytra          ! open boundary condition (bdy_tra routine)
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_nxt( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tranxt  ***
+      !!
+      !! ** Purpose :   Apply the boundary condition on the after temperature  
+      !!             and salinity fields, achieved the time stepping by adding
+      !!             the Asselin filter on now fields and swapping the fields.
+      !! 
+      !! ** Method  :   At this stage of the computation, ta and sa are the 
+      !!             after temperature and salinity as the time stepping has
+      !!             been performed in trazdf_imp or trazdf_exp module.
+      !!
+      !!              - Apply lateral boundary conditions on (ta,sa) 
+      !!             at the local domain   boundaries through lbc_lnk call, 
+      !!             at the one-way open boundaries (ln_bdy=T), 
+      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
+      !!
+      !!              - Update lateral boundary conditions on AGRIF children
+      !!             domains (lk_agrif=T)
+      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Update after tracer on domain lateral boundaries
+      ! 
+#if defined key_agrif
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+      !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
+      !
+      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
+ 
+      ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =     rdt      ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
+      ENDIF
+
+      ! trends computation initialisation
+      IF( l_trdtra )   THEN                    
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ztrdt(:,:,jk) = 0._wp
+         ztrds(:,:,jk) = 0._wp
+         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend 
+            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
+            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
+         ENDIF
+         ! total trend for the non-time-filtered variables. 
+            zfact = 1.0 / rdt
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 
+            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 
+         END DO
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
+         ! Store now fields before applying the Asselin filter 
+         ! in order to calculate Asselin filter trend later.
+         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
+         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( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface 
+         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
+           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
+         ENDIF
+         !
+         DO jn = 1, jpts
+            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 
+            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
+            CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
+         END DO
+      ENDIF     
+      !
+      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
+         DO jk = 1, jpkm1
+            zfact = 1._wp / r2dt             
+            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
+            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
+         END DO
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+      END IF
+      !
+      !                        ! control print
+      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 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
+      !
+   END SUBROUTINE tra_nxt
+
+
+   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_fix  ***
+      !!
+      !! ** Purpose :   fixed volume: apply the Asselin time filter and 
+      !!                swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a Asselin time filter on now fields.
+      !!              - swap tracer fields to prepare the next time_step.
+      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztn, ztd         ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      DO jn = 1, kjpt
+         !
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ztn = ptn(ji,jj,jk,jn)                                    
+                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
+                  !
+                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn 
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
+               END DO
+           END DO
+         END DO
+         !
+      END DO
+      !
+   END SUBROUTINE tra_nxt_fix
+
+
+   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_vvl  ***
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !!                and swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!              - swap tracer fields to prepare the next time_step.
+      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
+      !!             tn  = ta 
+      !!
+      !! ** Action  : - tsb & tsn ready for the next time step
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
+      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
+      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
+      !
+      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( cdtype == 'TRA' )  THEN   
+         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
+         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
+         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
+      ELSE                          ! passive tracers case
+         ll_traqsr  = .FALSE.          ! NO solar penetration
+         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?  
+         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ?? 
+      ENDIF
+      !
+      DO jn = 1, kjpt      
+         DO jk = 1, jpkm1
+            zfact1 = atfp * p2dt
+            zfact2 = zfact1 * r1_rau0
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ze3t_b = e3t_b(ji,jj,jk)
+                  ze3t_n = e3t_n(ji,jj,jk)
+                  ze3t_a = e3t_a(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
+                  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( jk == mikt(ji,jj) ) THEN           ! first level 
+                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
+                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
+                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
+                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
+                  ENDIF
+                  !
+                  ! solar penetration (temperature only)
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
+                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
+                     !
+                  ! river runoff
+                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
+                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
+                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
+                     !
+                  ! ice shelf
+                  IF( ll_isf ) THEN
+                     ! level fully include in the Losch_2008 ice shelf boundary layer
+                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
+                     ! level partially include in Losch_2008 ice shelf boundary layer 
+                     IF ( jk == misfkb(ji,jj) )                                                   &
+                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
+                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
+                  END IF
+                  !
+                  ze3t_f = 1.e0 / ze3t_f
+                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
+                  !
+               END DO
+            END DO
+         END DO
+         ! 
+      END DO
+      !
+   END SUBROUTINE tra_nxt_vvl
+
+   !!======================================================================
+END MODULE tranxt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 8732)
@@ -0,0 +1,442 @@
+MODULE traqsr
+   !!======================================================================
+   !!                       ***  MODULE  traqsr  ***
+   !! Ocean physics:   solar radiation penetration in the top ocean levels
+   !!======================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            7.0  !  1991-11  (G. Madec)
+   !!                 !  1996-01  (G. Madec)  s-coordinates
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate
+   !!            3.2  !  2009-04  (G. Madec & NEMO team) 
+   !!            3.6  !  2012-05  (C. Rousset) store attenuation coef for use in ice model 
+   !!            3.6  !  2015-12  (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  remove optimisation for fix volume 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_qsr       : temperature trend due to the penetration of solar radiation 
+   !!   tra_qsr_init  : initialization of the qsr penetration 
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE trc_oce        ! share SMS/Ocean variables
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! I/O manager
+   USE fldread        ! read input fields
+   USE restart        ! ocean restart
+   USE lib_mpp        ! MPP library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
+   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90
+
+   !                                 !!* Namelist namtra_qsr: penetrative solar radiation
+   LOGICAL , PUBLIC ::   ln_traqsr    !: light absorption (qsr) flag
+   LOGICAL , PUBLIC ::   ln_qsr_rgb   !: Red-Green-Blue light absorption flag  
+   LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag
+   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag
+   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem)
+   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0)
+   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands)
+   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands)
+   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands)
+   !
+   INTEGER , PUBLIC ::   nksr         !: levels below which the light cannot penetrate (depth larger than 391 m)
+ 
+   INTEGER, PARAMETER ::   np_RGB  = 1   ! R-G-B     light penetration with constant Chlorophyll
+   INTEGER, PARAMETER ::   np_RGBc = 2   ! R-G-B     light penetration with Chlorophyll data
+   INTEGER, PARAMETER ::   np_2BD  = 3   ! 2 bands   light penetration
+   INTEGER, PARAMETER ::   np_BIO  = 4   ! bio-model light penetration
+   !
+   INTEGER  ::   nqsr    ! user choice of the type of light penetration
+   REAL(wp) ::   xsi0r   ! inverse of rn_si0
+   REAL(wp) ::   xsi1r   ! inverse of rn_si1
+   !
+   REAL(wp) , DIMENSION(3,61)           ::   rkrgb    ! tabulated attenuation coefficients for RGB absorption
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_qsr( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_qsr  ***
+      !!
+      !! ** Purpose :   Compute the temperature trend due to the solar radiation
+      !!              penetration and add it to the general temperature trend.
+      !!
+      !! ** Method  : The profile of the solar radiation within the ocean is defined
+      !!      through 2 wavebands (rn_si0,rn_si1) or 3 wavebands (RGB) and a ratio rn_abs
+      !!      Considering the 2 wavebands case:
+      !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) )
+      !!         The temperature trend associated with the solar radiation penetration 
+      !!         is given by : zta = 1/e3t dk[ I ] / (rau0*Cp)
+      !!         At the bottom, boudary condition for the radiation is no flux :
+      !!      all heat which has not been absorbed in the above levels is put
+      !!      in the last ocean level.
+      !!         The computation is only done down to the level where 
+      !!      I(k) < 1.e-15 W/m2 (i.e. over the top nksr levels) . 
+      !!
+      !! ** Action  : - update ta with the penetrative solar radiation trend
+      !!              - send  trend for further diagnostics (l_trdtra=T)
+      !!
+      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+      !!              Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      INTEGER  ::   irgb                     ! local integers
+      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
+      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
+      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         -
+      REAL(wp) ::   zz0 , zz1                !    -         -
+      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze
+      REAL(wp) ::   zlogc, zlogc2, zlogc3 
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      !
+      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend
+         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+      ENDIF
+      !
+      !                         !-----------------------------------!
+      !                         !  before qsr induced heat content  !
+      !                         !-----------------------------------!
+      IF( kt == nit000 ) THEN          !==  1st time step  ==!
+!!gm case neuler  not taken into account....
+         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart
+            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
+            z1_2 = 0.5_wp
+            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
+         ELSE                                           ! No restart or restart not found: Euler forward time stepping
+            z1_2 = 1._wp
+            qsr_hc_b(:,:,:) = 0._wp
+         ENDIF
+      ELSE                             !==  Swap of qsr heat content  ==!
+         z1_2 = 0.5_wp
+         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
+      ENDIF
+      !
+      !                         !--------------------------------!
+      SELECT CASE( nqsr )       !  now qsr induced heat content  !
+      !                         !--------------------------------!
+      !
+      CASE( np_BIO )                   !==  bio-model fluxes  ==!
+         !
+         DO jk = 1, nksr
+            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
+         END DO
+         !
+      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==!
+         !
+         CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        ) 
+         CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
+         !
+         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
+            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
+            DO jk = 1, nksr + 1
+               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl
+                  DO ji = fs_2, fs_jpim1
+                     zchl    = sf_chl(1)%fnow(ji,jj,1)
+                     zCtot   = 40.6  * zchl**0.459
+                     zze     = 568.2 * zCtot**(-0.746)
+                     IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293)
+                     zpsi    = gdepw_n(ji,jj,jk) / zze
+                     !
+                     zlogc   = LOG( zchl )
+                     zlogc2  = zlogc * zlogc
+                     zlogc3  = zlogc * zlogc * zlogc
+                     zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3
+                     zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2
+                     zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3
+                     zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2
+                     zCze    = 1.12  * (zchl)**0.803 
+                     !
+                     zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) )
+                  END DO
+                  !
+               END DO
+            END DO
+         ELSE                                !* constant chrlorophyll
+           DO jk = 1, nksr + 1
+              zchl3d(:,:,jk) = 0.05 
+            ENDDO
+         ENDIF
+         !
+         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ze0(ji,jj,1) = rn_abs * qsr(ji,jj)
+               ze1(ji,jj,1) = zcoef  * qsr(ji,jj)
+               ze2(ji,jj,1) = zcoef  * qsr(ji,jj)
+               ze3(ji,jj,1) = zcoef  * qsr(ji,jj)
+               zea(ji,jj,1) =          qsr(ji,jj)
+            END DO
+         END DO
+         !
+         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) )
+                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                  zekb(ji,jj) = rkrgb(1,irgb)
+                  zekg(ji,jj) = rkrgb(2,irgb)
+                  zekr(ji,jj) = rkrgb(3,irgb)
+               END DO
+            END DO
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * xsi0r       )
+                  zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekb(ji,jj) )
+                  zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekg(ji,jj) )
+                  zc3 = ze3(ji,jj,jk-1) * EXP( - e3t_n(ji,jj,jk-1) * zekr(ji,jj) )
+                  ze0(ji,jj,jk) = zc0
+                  ze1(ji,jj,jk) = zc1
+                  ze2(ji,jj,jk) = zc2
+                  ze3(ji,jj,jk) = zc3
+                  zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, nksr                     !* now qsr induced heat content
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) )
+               END DO
+            END DO
+         END DO
+         !
+         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        ) 
+         CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d ) 
+         !
+      CASE( np_2BD  )            !==  2-bands fluxes  ==!
+         !
+         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands
+         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp
+         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m 
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zc0 = zz0 * EXP( -gdepw_n(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk  )*xsi1r )
+                  zc1 = zz0 * EXP( -gdepw_n(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -gdepw_n(ji,jj,jk+1)*xsi1r )
+                  qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) ) 
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      !                          !-----------------------------!
+      DO jk = 1, nksr            !  update to the temp. trend  !
+         DO jj = 2, jpjm1        !-----------------------------!
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                  &                 + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) )
+               ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
+               ENDIF
+            END DO
+         END DO
+         ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere
+         CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp )
+      ENDIF
+      !
+      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
+         CALL wrk_alloc( jpi,jpj,jpk,   zetot )
+         !
+         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
+         DO jk = nksr, 1, -1
+            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp
+         END DO         
+         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
+         !
+         CALL wrk_dealloc( jpi,jpj,jpk,   zetot ) 
+      ENDIF
+      !
+      IF( lrst_oce ) THEN     ! write in the ocean restart file
+         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
+         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 
+      ENDIF
+      !
+      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt )
+         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt ) 
+      ENDIF
+      !                       ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr')
+      !
+   END SUBROUTINE tra_qsr
+
+
+   SUBROUTINE tra_qsr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_qsr_init  ***
+      !!
+      !! ** Purpose :   Initialization for the penetrative solar radiation
+      !!
+      !! ** Method  :   The profile of solar radiation within the ocean is set
+      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
+      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
+      !!      default values correspond to clear water (type I in Jerlov' 
+      !!      (1968) classification.
+      !!         called by tra_qsr at the first timestep (nit000)
+      !!
+      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
+      !!
+      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
+      INTEGER  ::   ios, irgb, ierror, ioptio   ! local integer
+      REAL(wp) ::   zz0, zc0 , zc1, zcoef      ! local scalars
+      REAL(wp) ::   zz1, zc2 , zc3, zchl       !   -      -
+      !
+      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
+      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
+      !!
+      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  &
+         &                  nn_chldta, rn_abs, rn_si0, rn_si1
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist
+      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtra_qsr in configuration namelist
+      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namtra_qsr )
+      !
+      IF(lwp) THEN                ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration'
+         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration       ln_qsr_rgb = ', ln_qsr_rgb
+         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd
+         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio
+         WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice
+         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta
+         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs
+         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0     = ', rn_si0
+         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1     = ', rn_si1
+         WRITE(numout,*)
+      ENDIF
+      !
+      ioptio = 0                    ! Parameter control
+      IF( ln_qsr_rgb  )   ioptio = ioptio + 1
+      IF( ln_qsr_2bd  )   ioptio = ioptio + 1
+      IF( ln_qsr_bio  )   ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE type of light penetration in namelist namtra_qsr',  &
+         &                               ' 2 bands, 3 RGB bands or bio-model light penetration' )
+      !
+      IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr = np_RGB 
+      IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr = np_RGBc
+      IF( ln_qsr_2bd                      )   nqsr = np_2BD
+      IF( ln_qsr_bio                      )   nqsr = np_BIO
+      !
+      !                             ! Initialisation
+      xsi0r = 1._wp / rn_si0
+      xsi1r = 1._wp / rn_si1
+      !
+      SELECT CASE( nqsr )
+      !                               
+      CASE( np_RGB , np_RGBc )         !==  Red-Green-Blue light penetration  ==!
+         !                             
+         IF(lwp)   WRITE(numout,*) '   R-G-B   light penetration '
+         !
+         CALL trc_oce_rgb( rkrgb )                 ! tabulated attenuation coef.
+         !                                   
+         nksr = trc_oce_ext_lev( r_si2, 33._wp )   ! level of light extinction
+         !
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
+         IF( nqsr == np_RGBc ) THEN                ! Chl data : set sf_chl structure
+            IF(lwp) WRITE(numout,*) '        Chlorophyll read in a file'
+            ALLOCATE( sf_chl(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
+            IF( sn_chl%ln_tint )   ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
+            !                                        ! fill sf_chl with sn_chl and control print
+            CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
+               &           'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print )
+         ENDIF
+         IF( nqsr == np_RGB ) THEN                 ! constant Chl
+            IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
+         ENDIF
+         !
+      CASE( np_2BD )                   !==  2 bands light penetration  ==!
+         !
+         IF(lwp)  WRITE(numout,*) '   2 bands light penetration'
+         !
+         nksr = trc_oce_ext_lev( rn_si1, 100._wp )    ! level of light extinction
+         IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m'
+         !
+      CASE( np_BIO )                   !==  BIO light penetration  ==!
+         !
+         IF(lwp) WRITE(numout,*) '   bio-model light penetration'
+         IF( .NOT.lk_top )   CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )
+         !
+      END SELECT
+      !
+      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed
+      !
+      ! 1st ocean level attenuation coefficient (used in sbcssm)
+      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  )
+      ELSE
+         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init')
+      !
+   END SUBROUTINE tra_qsr_init
+
+   !!======================================================================
+END MODULE traqsr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 8732)
@@ -0,0 +1,245 @@
+MODULE trasbc
+   !!==============================================================================
+   !!                       ***  MODULE  trasbc  ***
+   !! Ocean active tracers:  surface boundary condition
+   !!==============================================================================
+   !! 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
+   !!            3.6  !  2014-11  (P. Mathiot) isf melting forcing 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_sbc       : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dom_oce        ! ocean space domain variables
+   USE phycst         ! physical constant
+   USE eosbn2         ! Equation Of State
+   USE sbcmod         ! ln_rnf  
+   USE sbcrnf         ! River runoff  
+   USE sbcisf         ! Ice shelf   
+   USE iscplini       ! Ice sheet coupling
+   USE traqsr         ! solar radiation penetration
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers 
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE iom            ! xIOS server
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_sbc   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_sbc ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_sbc  ***
+      !!                   
+      !! ** Purpose :   Compute the tracer surface boundary condition trend of
+      !!      (flux through the interface, concentration/dilution effect)
+      !!      and add it to the general trend of tracer equations.
+      !!
+      !! ** Method :   The (air+ice)-sea flux has two components: 
+      !!      (1) Fext, external forcing (i.e. flux through the (air+ice)-sea interface); 
+      !!      (2) Fwe , tracer carried with the water that is exchanged with air+ice. 
+      !!               The input forcing fields (emp, rnf, sfx, isf) contain Fext+Fwe,
+      !!             they are simply added to the tracer trend (tsa).
+      !!               In linear free surface case (ln_linssh=T), the volume of the
+      !!             ocean does not change with the water exchanges at the (air+ice)-sea
+      !!             interface. Therefore another term has to be added, to mimic the
+      !!             concentration/dilution effect associated with water exchanges.
+      !!
+      !! ** Action  : - Update tsa with the surface boundary condition trend 
+      !!              - send trends to trdtra module for further diagnostics(l_trdtra=T)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices  
+      INTEGER  ::   ikt, ikb              ! local integers
+      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_sbc')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !
+      IF( l_trdtra ) THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+      !
+!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
+      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
+         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
+         qsr(:,:) = 0._wp                     ! qsr set to zero
+      ENDIF
+
+      !----------------------------------------
+      !        EMP, SFX and QNS effects
+      !----------------------------------------
+      !                             !==  Set before sbc tracer content fields  ==!
+      IF( kt == nit000 ) THEN             !* 1st time-step
+         IF( ln_rstart .AND.    &               ! Restart: read in restart file
+              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
+            zfact = 0.5_wp
+            sbc_tsc(:,:,:) = 0._wp
+            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
+            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
+         ELSE                                   ! No restart or restart not found: Euler forward time stepping
+            zfact = 1._wp
+            sbc_tsc(:,:,:) = 0._wp
+            sbc_tsc_b(:,:,:) = 0._wp
+         ENDIF
+      ELSE                                !* other time-steps: swap of forcing fields
+         zfact = 0.5_wp
+         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
+      ENDIF
+      !                             !==  Now sbc tracer content fields  ==!
+      DO jj = 2, jpj
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux
+            sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting
+         END DO
+      END DO
+      IF( ln_linssh ) THEN                !* linear free surface  
+         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
+               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal)
+            END DO
+         END DO                                 !==>> output c./d. term
+         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )
+         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )
+      ENDIF
+      !
+      DO jn = 1, jpts               !==  update tracer trend  ==!
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.  
+               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) / e3t_n(ji,jj,1)
+            END DO
+         END DO
+      END DO
+      !                  
+      IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
+         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
+         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
+      ENDIF
+      !
+      !----------------------------------------
+      !       Ice Shelf effects (ISF)
+      !     tbl treated as in Losh (2008) JGR
+      !----------------------------------------
+      !
+!!gm BUG ?   Why no differences between non-linear and linear free surface ?
+!!gm         probably taken into account in r1_hisf_tbl : to be verified
+      IF( ln_isf ) THEN
+         zfact = 0.5_wp
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1
+               !
+               ikt = misfkt(ji,jj)
+               ikb = misfkb(ji,jj)
+               !
+               ! level fully include in the ice shelf boundary layer
+               ! sign - because fwf sign of evapo (rnf sign of precip)
+               DO jk = ikt, ikb - 1
+               ! compute trend
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                                &
+                     &           + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             &
+                     &           * r1_hisf_tbl(ji,jj)
+               END DO
+   
+               ! level partially include in ice shelf boundary layer 
+               ! compute trend
+               tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem)                                                 &
+                  &              + zfact * ( risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) )             &
+                  &              * r1_hisf_tbl(ji,jj) * ralpha(ji,jj)
+
+            END DO
+         END DO
+      END IF
+      !
+      !----------------------------------------
+      !        River Runoff effects
+      !----------------------------------------
+      !
+      IF( ln_rnf ) THEN         ! input of heat and salt due to river runoff 
+         zfact = 0.5_wp
+         DO jj = 2, jpj 
+            DO ji = fs_2, fs_jpim1
+               IF( rnf(ji,jj) /= 0._wp ) THEN
+                  zdep = zfact / h_rnf(ji,jj)
+                  DO jk = 1, nk_rnf(ji,jj)
+                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)                                 &
+                                           &                 +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
+                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)                                 &
+                                           &                 +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
+                  END DO
+               ENDIF
+            END DO  
+         END DO  
+      ENDIF
+
+      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) )   ! runoff term on sst
+      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss
+
+      !
+      !----------------------------------------
+      !        Ice Sheet coupling imbalance correction to have conservation
+      !----------------------------------------
+      !
+      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff 
+         DO jk = 1,jpk
+            DO jj = 2, jpj 
+               DO ji = fs_2, fs_jpim1
+                  zdep = 1._wp / e3t_n(ji,jj,jk) 
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - htsc_iscpl(ji,jj,jk,jp_tem)                       &
+                      &                                         * zdep
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - htsc_iscpl(ji,jj,jk,jp_sal)                       &
+                      &                                         * zdep  
+               END DO  
+            END DO  
+         END DO
+      ENDIF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, 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' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_sbc')
+      !
+   END SUBROUTINE tra_sbc
+
+   !!======================================================================
+END MODULE trasbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 8732)
@@ -0,0 +1,150 @@
+MODULE trazdf
+   !!==============================================================================
+   !!                 ***  MODULE  trazdf  ***
+   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+   !! 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
+   !!   tra_zdf_init  : initialisation of the computation
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE domvvl         ! variable volume
+   USE phycst         ! physical constant
+   USE zdf_oce        ! ocean vertical physics variables
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE ldftra         ! lateral diffusion: eddy diffusivity
+   USE ldfslp         ! lateral diffusion: iso-neutral slope 
+   USE trazdf_exp     ! vertical diffusion: explicit (tra_zdf_exp routine)
+   USE trazdf_imp     ! vertical diffusion: implicit (tra_zdf_imp routine)
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends: tracer trend manager
+   !
+   USE in_out_manager ! I/O manager
+   USE prtctl         ! Print control
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf        ! routine called by step.F90
+   PUBLIC   tra_zdf_init   ! routine called by nemogcm.F90
+
+   INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals)
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf  ***
+      !!
+      !! ** Purpose :   compute the vertical ocean tracer physics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !
+      INTEGER  ::   jk                   ! Dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf')
+      !
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dt =  rdt                          ! = rdt (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dt = 2. * rdt                      ! = 2 rdt (leapfrog)
+      ENDIF
+      !
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+      !
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, nit000, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme 
+      END SELECT
+!!gm WHY here !   and I don't like that !
+      ! DRAKKAR SSS control {
+      ! JMM avoid negative salinities near river outlet ! Ugly fix
+      ! JMM : restore negative salinities to small salinities:
+      WHERE( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp
+!!gm
+
+      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk)
+         END DO
+!!gm this should be moved in trdtra.F90 and done on all trends
+         CALL lbc_lnk( ztrdt, 'T', 1. )
+         CALL lbc_lnk( ztrds, 'T', 1. )
+!!gm
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf')
+      !
+   END SUBROUTINE tra_zdf
+
+
+   SUBROUTINE tra_zdf_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_zdf_init  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_zdfexp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_zdfexp=F)
+      !!      NB: rotation of lateral mixing operator or TKE & GLS schemes,
+      !!          an implicit scheme is required.
+      !!----------------------------------------------------------------------
+      USE zdftke
+      USE zdfgls
+      !!----------------------------------------------------------------------
+      !
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
+      ELSE                   ;   nzdf = 1           ! use implicit scheme
+      ENDIF
+      !
+      ! Force implicit schemes
+      IF( lk_zdftke .OR. lk_zdfgls   )   nzdf = 1   ! TKE, or GLS physics
+      IF( ln_traldf_iso              )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
+            &                         ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
+            !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf ==  0 )   WRITE(numout,*) '      ===>>   Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '      ===>>   Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE tra_zdf_init
+
+   !!==============================================================================
+END MODULE trazdf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 8732)
@@ -0,0 +1,153 @@
+MODULE trazdf_exp
+   !!==============================================================================
+   !!                    ***  MODULE  trazdf_exp  ***
+   !! Ocean  tracers:  vertical component of the tracer mixing trend using
+   !!                  a split-explicit time-stepping 
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            7.0  !  1991-11  (G. Madec)
+   !!                 !  1992-06  (M. Imbard)  correction on tracer trend loops
+   !!                 !  1996-01  (G. Madec)  statement function for e3
+   !!                 !  1997-05  (G. Madec)  vertical component of isopycnal
+   !!                 !  1997-07  (G. Madec)  geopotential diffusion in s-coord
+   !!                 !  2000-08  (G. Madec)  double diffusive mixing
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2004-08  (C. Talandier) New trends organisation
+   !!             -   !  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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_exp   : compute the tracer the vertical diffusion trend using a
+   !!                   split-explicit time stepping and provide the after tracer
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers 
+   USE dom_oce        ! ocean space and time domain 
+   USE domvvl         ! variable volume levels
+   USE zdf_oce        ! ocean vertical physics
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE trc_oce        ! share passive tracers/Ocean variables
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf_exp   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts,   &
+      &                                        ptb , pta , kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_exp  ***
+      !!                   
+      !! ** Purpose :   Compute the after tracer fields due to the vertical
+      !!      tracer mixing alone, and then due to the whole tracer trend.
+      !!
+      !! ** Method  : - The after tracer fields due to the vertical diffusion
+      !!      of tracers alone is given by:
+      !!                ztb = ptb + p2dt difft
+      !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
+      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
+      !!      difft is evaluated with an Euler split-explit scheme using a
+      !!      no flux boundary condition at both surface and bottomi boundaries.
+      !!      (N.B. bottom condition is applied through the masked field avt).
+      !!              - the after tracer fields due to the whole trend is 
+      !!      obtained in leap-frog environment applied on thickness weighted tracer by :
+      !!          pta = [ ptb*e3tb + e3tn*( ztb - ptb + p2dt pta ) ] / e3tn
+      !!
+      !! ** Action : - after tracer fields pta
+      !!---------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   ksts     ! number of sub-time step
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field 
+      !
+      INTEGER  ::  ji, jj, jk, jn, jl   ! dummy loop indices
+      REAL(wp) ::  z1_ksts, ze3tr       ! local scalars
+      REAL(wp) ::  ztra, ze3tb    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztb, zwf
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   ztb, zwf ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      ! Initializations
+      ! ---------------
+      z1_ksts = 1._wp / REAL( ksts, wp )
+      zwf(:,:, 1 ) = 0._wp    ! no flux at the surface and at bottom level
+      zwf(:,:,jpk) = 0._wp
+      !
+      !
+      DO jn = 1, kjpt         !==  loop over tracers  ==!
+         !
+         ztb(:,:,:) = ptb(:,:,:,jn)    ! initial before value for tracer
+         ! 
+         DO jl = 1, ksts         !==  Split-explicit loop  ==!
+            !              
+            DO jk = 2, jpk             ! 1st vertical derivative (w-flux)
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
+                        zwf(ji,jj,jk) =   avt(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
+                     ELSE                                           ! salinity or pass. tracer : use of avs
+                        zwf(ji,jj,jk) = fsavs(ji,jj,jk) * ( ztb(ji,jj,jk-1) - ztb(ji,jj,jk) ) / e3w_b(ji,jj,jk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+            !
+            DO jk = 1, jpkm1           ! 2nd vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ztb(ji,jj,jk) = ztb(ji,jj,jk) + p2dt * ( zwf(ji,jj,jk) - zwf(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         END DO                  ! end sub-time stepping
+
+         DO jk = 1, jpkm1        !==  After tracer due to all trends
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ze3tb = e3t_b(ji,jj,jk) / e3t_n(ji,jj,jk)
+                  ztra  = ( ztb(ji,jj,jk) - ptb(ji,jj,jk,jn) ) + p2dt * pta(ji,jj,jk,jn)  ! total trend * 2dt 
+                  pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)    ! after tracer
+               END DO
+            END DO
+         END DO
+         !
+      END DO                     ! end of tracer loop
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   ztb, zwf ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp')
+      !
+   END SUBROUTINE tra_zdf_exp
+
+   !!==============================================================================
+END MODULE trazdf_exp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 8732)
@@ -0,0 +1,217 @@
+MODULE trazdf_imp
+   !!======================================================================
+   !!                 ***  MODULE  trazdf_imp  ***
+   !! Ocean  tracers:  vertical component of the tracer mixing trend
+   !!======================================================================
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            7.0  !  1991-11  (G. Madec)
+   !!                 !  1992-06  (M. Imbard) correction on tracer trend loops
+   !!                 !  1996-01  (G. Madec) statement function for e3
+   !!                 !  1997-05  (G. Madec) vertical component of isopycnal
+   !!                 !  1997-07  (G. Madec) geopotential diffusion in s-coord
+   !!                 !  2000-08  (G. Madec) double diffusive mixing
+   !!   NEMO     1.0  !  2002-08  (G. Madec) F90: Free form and module
+   !!            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
+   !!             -   !  2011-02  (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  non linear free surface by default 
+   !!----------------------------------------------------------------------
+  
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_imp   : Update the tracer trend with vertical mixing, nad compute the after tracer field
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables 
+   USE zdf_oce        ! ocean vertical physics variables
+   USE trc_oce        ! share passive tracers/ocean variables
+   USE domvvl         ! variable volume
+   USE ldftra         ! lateral mixing type
+   USE ldfslp         ! lateral physics: slope of diffusion
+   USE zdfddm         ! ocean vertical physics: double diffusion
+   USE traldf_triad   ! active tracers: Method of Stabilizing Correction
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf_imp   !  routine called by step.F90
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+ 
+   SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_imp  ***
+      !!
+      !! ** Purpose :   Compute the after tracer through a implicit computation
+      !!     of 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) 
+      !!
+      !! ** Method  :  The vertical diffusion of a tracer ,t , is given by:
+      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=after field)
+      !!      which provide directly the after tracer field.
+      !!      If lk_zdfddm=T, use avs for salinity or for passive tracers
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      If iso-neutral mixing, add to avt the contribution due to lateral mixing.
+      !!
+      !! ** Action  : - pta  becomes the after tracer
+      !!---------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                              , INTENT(in   ) ::   kit000   ! first time step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp)                             , INTENT(in   ) ::   p2dt     ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! in: tracer trend ; out: after tracer field
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zrhs             ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt, zwd, zws
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !                                               ! ============= !
+      DO jn = 1, kjpt                                 !  tracer loop  !
+         !                                            ! ============= !
+         !  Matrix construction
+         ! --------------------
+         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
+         !
+         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR.   &
+            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN
+            !
+            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
+            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk)
+            ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk)
+            ENDIF
+            zwt(:,:,1) = 0._wp
+            !
+            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution 
+               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator 
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)  
+                        END DO
+                     END DO
+                  END DO
+               ELSE                          ! standard or triad iso-neutral operator
+                  DO jk = 2, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            ENDIF
+            !
+            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+!!gm BUG  I think, use e3w_a instead of e3w_n
+                     zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  )
+                     zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1)
+                     zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+               END DO
+            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 3d arrays: zwd, zws, zwi.
+            !   Suffices i,s and d indicate "inferior" (below diagonal), diagonal
+            !   and "superior" (above diagonal) components of the tridiagonal system.
+            !   The solution will be in the 4d array pta.
+            !   The 3d array zwt is used as a work space array.
+            !   En route to the solution pta is used a to evaluate the rhs and then 
+            !   used as a work space array: its value is modified.
+            !
+            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction)
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+               END DO
+            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
+            !
+         ENDIF 
+         !         
+         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+            DO ji = fs_2, fs_jpim1
+               pta(ji,jj,1,jn) = e3t_b(ji,jj,1) * ptb(ji,jj,1,jn) + p2dt * e3t_n(ji,jj,1) * pta(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zrhs = e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * e3t_n(ji,jj,jk) * pta(ji,jj,jk,jn)   ! zrhs=right hand side
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+         !
+         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
+            DO ji = fs_2, fs_jpim1
+               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+            END DO
+         END DO
+         DO jk = jpk-2, 1, -1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) )   &
+                     &             / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                                            ! ================= !
+      END DO                                          !  end tracer loop  !
+      !                                               ! ================= !
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwi, zwt, zwd, zws ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
+      !
+   END SUBROUTINE tra_zdf_imp
+
+   !!==============================================================================
+END MODULE trazdf_imp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 8732)
@@ -0,0 +1,459 @@
+MODULE zpshde
+   !!======================================================================
+   !!                       ***  MODULE zpshde   ***
+   !! 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 
+   !!            3.6  !  2014-11  (P. Mathiot) Add zps_hde_isf (needed to open a cavity)
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!----------------------------------------------------------------------
+   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 lbclnk          ! lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zps_hde     ! routine called by step.F90
+   PUBLIC   zps_hde_isf ! routine called by step.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   &
+      &                          prd, pgru, pgrv    )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos which will compute rd~(t~,s~) at the right
+      !!      depth zh from interpolated T and S for the different formulations
+      !!      of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
+      !!
+      !! ** Action  : compute for top interfaces
+      !!              - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
+      !
+      INTEGER  ::   ji, jj, jn                  ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1      ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::   ze3wu, ze3wv, zmaxu, zmaxv  ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
+      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj             ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde')
+      !
+      pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp
+      pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+!!gm BUG ? when applied to before fields, e3w_b should be used....
+               ze3wu = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = 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 / e3w_n(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+      !                
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         pgru(:,:) = 0._wp
+         pgrv(:,:) = 0._wp                ! depth of the partial step level
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+            END DO
+         END DO
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+         !
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu  = e3w_n(ji+1,jj  ,iku) - e3w_n(ji,jj,iku)
+               ze3wv  = e3w_n(ji  ,jj+1,ikv) - e3w_n(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde')
+      !
+   END SUBROUTINE zps_hde
+   !
+   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  &
+      &                          prd, pgru, pgrv, pgrui, pgrvi )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde_isf  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rho
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps for top (ice shelf) and bottom.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth :
+      !!      For the bottom case:
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos which will compute rd~(t~,s~) at the right
+      !!      depth zh from interpolated T and S for the different formulations
+      !!      of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k)   or   rd(i+1,j,k) - rd~
+      !!
+      !!      For the top case (ice shelf): As for the bottom case but upside down
+      !!
+      !! ** Action  : compute for top and bottom interfaces
+      !!              - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   )           ::  kt           ! ocean time-step index
+      INTEGER                              , INTENT(in   )           ::  kjpt         ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta          ! 4D tracers fields
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
+      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
+      !
+      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1,ikup1, ikvp1   ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv             ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj)      ::  zri, zrj, zhi, zhj   ! NB: 3rd dim=1 to use eos
+      REAL(wp), DIMENSION(jpi,jpj,kjpt) ::  zti, ztj             ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf')
+      !
+      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp
+      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp
+      zti  (:,:,:) = 0._wp   ;   ztj  (:,:,:) =0._wp
+      zhi  (:,:  ) = 0._wp   ;   zhj  (:,:  ) =0._wp
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / e3w_n(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / e3w_n(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / e3w_n(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+
+      ! horizontal derivative of density anomalies (rd)
+      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
+         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ; 
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+               !
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
+               ENDIF
+
+            END DO
+         END DO
+
+         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
+         ! step and store it in  zri, zrj for each  case
+         CALL eos( zti, zhi, zri )
+         CALL eos( ztj, zhj, zrj )
+
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
+            DO ji = 1, jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku)
+               ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv)
+
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2
+               ENDIF
+
+            END DO
+         END DO
+
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      !     !==  (ISH)  compute grui and gruvi  ==!
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
+               ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
+               !
+               ! (ISF) case partial step top and bottom in adjacent cell in vertical
+               ! cannot used e3w because if 2 cell water column, we have ps at top and bottom
+               ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj
+               ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = - ze3wu / e3w_n(ji,jj,ikup1)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / e3w_n(ji,jj+1,ikvp1)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  - ze3wv / e3w_n(ji,jj,ikvp1)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ); CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
+      END DO
+
+      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
+         !
+         pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp;
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+
+               iku = miku(ji,jj)
+               ikv = mikv(ji,jj)
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+               !
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept_n(ji  ,jj,iku)    ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = gdept_n(ji+1,jj,iku)    ! -     -      case 2
+               ENDIF
+
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept_n(ji,jj  ,ikv)    ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = gdept_n(ji,jj+1,ikv)    ! -     -      case 2
+               ENDIF
+
+            END DO
+         END DO
+         !
+         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj 
+         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
+         !
+         DO jj = 1, jpjm1                 ! Gradient of density at the last level 
+            DO ji = 1, jpim1
+               iku = miku(ji,jj) 
+               ikv = mikv(ji,jj) 
+               ze3wu  =  gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku)
+               ze3wv  =  gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) 
+
+               IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1
+               ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1
+               ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2
+               ENDIF
+
+            END DO
+         END DO
+         CALL lbc_lnk( pgrui   , 'U', -1. ); CALL lbc_lnk( pgrvi   , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF  
+      !
+      IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf')
+      !
+   END SUBROUTINE zps_hde_isf
+   !!======================================================================
+END MODULE zpshde
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90	(revision 8732)
@@ -0,0 +1,82 @@
+MODULE trd_oce
+   !!======================================================================
+   !!                   ***  MODULE trd_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
+   !!----------------------------------------------------------------------
+   USE par_oce                 ! ocean parameters
+   USE trdmxl_oce              ! ocean active mixed layer tracers trends variables
+   USE trdvor_oce              ! ocean vorticity trends variables
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !                                                   !!* Namelist namtrd:  diagnostics on dynamics/tracer trends *
+   LOGICAL , PUBLIC  ::   ln_dyn_trd   = .FALSE.        !: (T) 3D momentum             trends or (F) not
+   LOGICAL , PUBLIC  ::   ln_tra_trd   = .FALSE.        !: (T) 3D tracer               trends or (F) not
+   LOGICAL , PUBLIC  ::   ln_KE_trd    = .FALSE.        !: (T) 3D Kinetic   Energy     trends or (F) not
+   LOGICAL , PUBLIC  ::   ln_PE_trd    = .FALSE.        !: (T) 3D Potential Energy     trends or (F) not
+   LOGICAL , PUBLIC  ::   ln_vor_trd   = .FALSE.        !: (T) 3D barotropic vorticity trends or (F) not
+   LOGICAL , PUBLIC  ::   ln_glo_trd   = .FALSE.        !: (T) global domain averaged diag for T, T^2, KE, and PE
+   LOGICAL , PUBLIC  ::   ln_dyn_mxl   = .FALSE.        !: (T) 2D tracer   trends averaged over the mixed layer 
+   LOGICAL , PUBLIC  ::   ln_tra_mxl   = .FALSE.        !: (T) 2D momentum trends averaged over the mixed layer 
+   INTEGER , PUBLIC  ::   nn_trd       = 10             !: time step frequency for ln_glo_trd=T only
+
+   LOGICAL , PUBLIC ::   l_trdtra        !: tracers  trend flag (set from namelist in trdini)
+   LOGICAL , PUBLIC ::   l_trddyn        !: momentum trend flag (set from namelist in trdini)
+   
+# if ( defined key_trdtrc && defined key_iomput )  ||  defined key_trdmxl_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 ::   jptot_tra  = 20     !: Total trend nb: change it when adding/removing one indice below
+   !                               ===============     !  
+   INTEGER, PUBLIC, PARAMETER ::   jptra_xad  =  1     !: x- horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_yad  =  2     !: y- horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_zad  =  3     !: z- vertical   advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_sad  =  4     !: z- vertical   advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_totad  =  5   !: total         advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_ldf  =  6     !: lateral       diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jptra_zdf  =  7     !: vertical      diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jptra_zdfp =  8     !: "PURE" vert.  diffusion (ln_traldf_iso=T)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_evd  =  9     !: EVD term (convection)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_bbc  = 10     !: Bottom Boundary Condition (geoth. heating) 
+   INTEGER, PUBLIC, PARAMETER ::   jptra_bbl  = 11     !: Bottom Boundary Layer (diffusive and/or advective)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_npc  = 12     !: non-penetrative convection treatment
+   INTEGER, PUBLIC, PARAMETER ::   jptra_dmp  = 13     !: internal restoring (damping)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_qsr  = 14     !: penetrative solar radiation
+   INTEGER, PUBLIC, PARAMETER ::   jptra_nsr  = 15     !: non solar radiation / C/D on salinity  (+runoff if ln_rnf=T)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_atf  = 16     !: Asselin time filter
+   INTEGER, PUBLIC, PARAMETER ::   jptra_tot  = 17     !: Model total trend
+   !
+   !                                                  !!!* Passive tracers trends indices (use if "key_top" defined)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_sms  = 18     !: sources m. sinks
+   INTEGER, PUBLIC, PARAMETER ::   jptra_radn = 19     !: corr. trn<0 in trcrad
+   INTEGER, PUBLIC, PARAMETER ::   jptra_radb = 20     !: corr. trb<0 in trcrad (like atf)
+   !
+   !                                                  !!!* Momentum trends indices
+   INTEGER, PUBLIC, PARAMETER ::   jptot_dyn  = 13     !: Total trend nb: change it when adding/removing one indice below
+   !                               ===============     !  
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_hpg  =  1     !: hydrostatic pressure gradient 
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_spg  =  2     !: surface     pressure gradient
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_keg  =  3     !: kinetic energy gradient  or horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_rvo  =  4     !: relative  vorticity      or metric term
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_pvo  =  5     !: planetary vorticity
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_zad  =  6     !: vertical advection
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_ldf  =  7     !: horizontal diffusion   
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_zdf  =  8     !: vertical   diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_bfr  =  9     !: bottom  stress 
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_atf  = 10     !: Asselin time filter
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_tau  = 11     !: surface stress
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_bfri = 12     !: implicit bottom friction (ln_bfrimp=.TRUE.)
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_ken  = 13     !: use for calculation of KE
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trd_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 8732)
@@ -0,0 +1,177 @@
+MODULE trddyn
+   !!======================================================================
+   !!                       ***  MODULE  trddyn  ***
+   !! Ocean diagnostics:  ocean dynamic trends
+   !!=====================================================================
+   !! History :  3.5  !  2012-02  (G. Madec) creation from trdmod: split DYN and TRA trends
+   !!                                        and manage  3D trends output for U, V, and KE
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_dyn       : manage the type of momentum trend diagnostics (3D I/O, domain averaged, KE)
+   !!   trd_dyn_iom   : output 3D momentum and/or tracer trends using IOM
+   !!   trd_dyn_init  : initialization step
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics variables
+   USE trd_oce        ! trends: ocean variables
+   USE zdfbfr         ! bottom friction
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE phycst         ! physical constants
+   USE trdken         ! trends: Kinetic ENergy 
+   USE trdglo         ! trends: global domain averaged
+   USE trdvor         ! trends: vertical averaged vorticity 
+   USE trdmxl         ! trends: mixed layer averaged 
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! lateral boundary condition 
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trd_dyn        ! called by all dynXX modules
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod  ***
+      !! 
+      !! ** Purpose :   Dispatch momentum trend computation, e.g. 3D output, 
+      !!              integral constraints, barotropic vorticity, kinetic enrgy, 
+      !!              and/or mixed layer budget.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends 
+      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
+      INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      !!----------------------------------------------------------------------
+      !
+      putrd(:,:,:) = putrd(:,:,:) * umask(:,:,:)                       ! mask the trends
+      pvtrd(:,:,:) = pvtrd(:,:,:) * vmask(:,:,:)
+      !
+
+!!gm NB : here a lbc_lnk should probably be added
+
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !   3D output of momentum and/or tracers trends using IOM interface
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt )
+         
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !  Integral Constraints Properties for momentum and/or tracers trends
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_glo_trd )   CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )
+
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !  Kinetic Energy trends
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      IF( ln_KE_trd  )   CALL trd_ken( putrd, pvtrd, ktrd, kt )
+
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !  Vorticity trends
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      IF( ln_vor_trd )   CALL trd_vor( putrd, pvtrd, ktrd, kt )
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Mixed layer trends for active tracers
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!gm      IF( ln_dyn_mxl )   CALL trd_mxl_dyn   
+      !
+   END SUBROUTINE trd_dyn
+
+
+   SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_dyn_iom  ***
+      !! 
+      !! ** Purpose :   output 3D trends using IOM
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends
+      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
+      INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikbu, ikbv   ! local integers
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace 
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3dx, z3dy   ! 3D workspace 
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE( ktrd )
+      CASE( jpdyn_hpg )   ;   CALL iom_put( "utrd_hpg", putrd )    ! hydrostatic pressure gradient
+                              CALL iom_put( "vtrd_hpg", pvtrd )
+      CASE( jpdyn_spg )   ;   CALL iom_put( "utrd_spg", putrd )    ! surface pressure gradient
+                              CALL iom_put( "vtrd_spg", pvtrd )
+      CASE( jpdyn_pvo )   ;   CALL iom_put( "utrd_pvo", putrd )    ! planetary vorticity
+                              CALL iom_put( "vtrd_pvo", pvtrd )
+      CASE( jpdyn_rvo )   ;   CALL iom_put( "utrd_rvo", putrd )    ! relative  vorticity     (or metric term)
+                              CALL iom_put( "vtrd_rvo", pvtrd )
+      CASE( jpdyn_keg )   ;   CALL iom_put( "utrd_keg", putrd )    ! Kinetic Energy gradient (or had)
+                              CALL iom_put( "vtrd_keg", pvtrd )
+                              CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )
+                              z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation)
+                              z3dy(:,:,:) = 0._wp
+                              DO jk = 1, jpkm1					   ! no mask as un,vn are masked
+                                 DO jj = 2, jpjm1
+                                    DO ji = 2, jpim1
+                                       z3dx(ji,jj,jk) = un(ji,jj,jk) * ( un(ji+1,jj,jk) - un(ji-1,jj,jk) ) / ( 2._wp * e1u(ji,jj) )
+                                       z3dy(ji,jj,jk) = vn(ji,jj,jk) * ( vn(ji,jj+1,jk) - vn(ji,jj-1,jk) ) / ( 2._wp * e2v(ji,jj) )
+                                    END DO
+                                 END DO
+                              END DO
+                              CALL lbc_lnk( z3dx, 'U', -1. )
+                              CALL lbc_lnk( z3dy, 'V', -1. )
+                              CALL iom_put( "utrd_udx", z3dx  )
+                              CALL iom_put( "vtrd_vdy", z3dy  )
+                              CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )
+      CASE( jpdyn_zad )   ;   CALL iom_put( "utrd_zad", putrd )    ! vertical   advection
+                              CALL iom_put( "vtrd_zad", pvtrd )
+      CASE( jpdyn_ldf )   ;   CALL iom_put( "utrd_ldf", putrd )    ! lateral diffusion
+                              CALL iom_put( "vtrd_ldf", pvtrd )
+      CASE( jpdyn_zdf )   ;   CALL iom_put( "utrd_zdf", putrd )    ! vertical diffusion 
+                              CALL iom_put( "vtrd_zdf", pvtrd )
+                              !                                    ! wind stress trends
+                              CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
+                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 )
+                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 )
+                              CALL iom_put( "utrd_tau", z2dx )
+                              CALL iom_put( "vtrd_tau", z2dy )
+                              CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )
+      CASE( jpdyn_bfr )       ! called if ln_bfrimp=T
+                              CALL iom_put( "utrd_bfr", putrd )    ! bottom friction (explicit case)
+                              CALL iom_put( "vtrd_bfr", pvtrd )
+      CASE( jpdyn_atf )   ;   CALL iom_put( "utrd_atf", putrd )        ! asselin filter trends 
+                              CALL iom_put( "vtrd_atf", pvtrd )
+      CASE( jpdyn_bfri )  ;   IF( ln_bfrimp ) THEN                     ! bottom friction (implicit case)
+                              	CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )
+                              	z3dx(:,:,:) = 0._wp   ;   z3dy(:,:,:) = 0._wp  ! after velocity known (now filed at this stage)
+                              	DO jk = 1, jpkm1
+                                    DO jj = 2, jpjm1
+                                       DO ji = 2, jpim1
+                              	         ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
+                                          ikbv = mbkv(ji,jj)
+                                          z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
+                                          z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
+                              	      END DO
+                              	   END DO
+                              	END DO
+                              	CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. )
+                              	CALL iom_put( "utrd_bfri", z3dx )
+                              	CALL iom_put( "vtrd_bfri", z3dy )
+                              	CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )
+         					      ENDIF
+      END SELECT
+      !
+   END SUBROUTINE trd_dyn_iom
+
+   !!======================================================================
+END MODULE trddyn
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90	(revision 8732)
@@ -0,0 +1,564 @@
+MODULE trdglo
+   !!======================================================================
+   !!                       ***  MODULE  trdglo  ***
+   !! Ocean diagnostics:  global domain averaged tracer and momentum trends
+   !!=====================================================================
+   !! History :  1.0  !  2004-08  (C. Talandier) New trends organization
+   !!            3.5  !  2012-02  (G. Madec)  add 3D tracer zdf trend output using iom
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_glo      : domain averaged budget of trends (including kinetic energy and T^2 trends)
+   !!   glo_dyn_wri  : print dynamic trends in ocean.output file
+   !!   glo_tra_wri  : print global T & T^2 trends in ocean.output file
+   !!   trd_glo_init : initialization step
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE trd_oce         ! trends: ocean variables
+   USE phycst          ! physical constants
+   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE ldfdyn          ! ocean dynamics: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE zdfbfr          ! bottom friction
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE eosbn2          ! equation of state
+   USE phycst          ! physical constants
+   !
+   USE lib_mpp         ! distibuted memory computing library
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE wrk_nemo        ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_glo       ! called by trdtra and trddyn modules
+   PUBLIC   trd_glo_init  ! called by trdini module
+
+   !                     !!! Variables used for diagnostics
+   REAL(wp) ::   tvolt    ! volume of the whole ocean computed at t-points
+   REAL(wp) ::   tvolu    ! volume of the whole ocean computed at u-points
+   REAL(wp) ::   tvolv    ! volume of the whole ocean computed at v-points
+   REAL(wp) ::   rpktrd   ! potential to kinetic energy conversion
+   REAL(wp) ::   peke     ! conversion potential energy - kinetic energy trend
+
+   !                     !!! domain averaged trends
+   REAL(wp), DIMENSION(jptot_tra) ::   tmo, smo   ! temperature and salinity trends 
+   REAL(wp), DIMENSION(jptot_tra) ::   t2 , s2    ! T^2 and S^2 trends 
+   REAL(wp), DIMENSION(jptot_dyn) ::   umo, vmo   ! momentum trends 
+   REAL(wp), DIMENSION(jptot_dyn) ::   hke        ! kinetic energy trends (u^2+v^2) 
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_glo  ***
+      !! 
+      !! ** Purpose :   compute and print global domain averaged trends for 
+      !!              T, T^2, momentum, KE, and KE<->PE
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type (='DYN'/'TRA')
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step
+      !!
+      INTEGER ::   ji, jj, jk      ! dummy loop indices
+      INTEGER ::   ikbu, ikbv      ! local integers
+      REAL(wp)::   zvm, zvt, zvs, z1_2rau0   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace 
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )
+
+      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
+         !
+      	SELECT CASE( ctype )
+      	!
+      	CASE( 'TRA' )          !==  Tracers (T & S)  ==!
+      	   DO jk = 1, jpkm1       ! global sum of mask volume trend and trend*T (including interior mask)
+      	      DO jj = 1, jpj
+      	         DO ji = 1, jpi        
+      	            zvm = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+      	            zvt = ptrdx(ji,jj,jk) * zvm
+      	            zvs = ptrdy(ji,jj,jk) * zvm
+         	         tmo(ktrd) = tmo(ktrd) + zvt   
+         	         smo(ktrd) = smo(ktrd) + zvs
+         	         t2 (ktrd) = t2(ktrd)  + zvt * tsn(ji,jj,jk,jp_tem)
+         	         s2 (ktrd) = s2(ktrd)  + zvs * tsn(ji,jj,jk,jp_sal)
+                  END DO
+               END DO
+            END DO
+            !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface
+            IF( ln_linssh .AND. ktrd == jptra_zad ) THEN  
+               tmo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )
+               smo(jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  )
+               t2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:)  )
+               s2 (jptra_sad) = SUM( wn(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:)  )
+            ENDIF
+            !
+            IF( ktrd == jptra_atf ) THEN     ! last trend (asselin time filter)
+               ! 
+               CALL glo_tra_wri( kt )             ! print the results in ocean.output
+               !                
+	            tmo(:) = 0._wp                     ! prepare the next time step (domain averaged array reset to zero)
+   	         smo(:) = 0._wp
+               t2 (:) = 0._wp
+               s2 (:) = 0._wp
+               !
+            ENDIF
+            !
+         CASE( 'DYN' )          !==  Momentum and KE  ==!        
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
+                        &                  * e1u    (ji  ,jj  ) * e2u    (ji,jj) * e3u_n(ji,jj,jk)
+                     zvs = ptrdy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
+                        &                  * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk)
+                     umo(ktrd) = umo(ktrd) + zvt
+                     vmo(ktrd) = vmo(ktrd) + zvs
+                     hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs
+                  END DO
+               END DO
+            END DO
+            !                 
+            IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend
+               z1_2rau0 = 0.5_wp / rau0
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)   &
+                        &                       * z1_2rau0 * e1u    (ji  ,jj  ) * e2u    (ji,jj)
+                     zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   &
+                        &                       * z1_2rau0 * e1v    (ji  ,jj  ) * e2v    (ji,jj) * e3u_n(ji,jj,jk)
+                     umo(jpdyn_tau) = umo(jpdyn_tau) + zvt
+                     vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs
+                     hke(jpdyn_tau) = hke(jpdyn_tau) + un(ji,jj,1) * zvt + vn(ji,jj,1) * zvs
+                  END DO
+               END DO
+            ENDIF
+            !                       
+            IF( ktrd == jpdyn_atf ) THEN     ! last trend (asselin time filter)
+               !
+               IF( ln_bfrimp ) THEN                   ! implicit bfr case: compute separately the bottom friction 
+                  z1_2rau0 = 0.5_wp / rau0
+                  DO jj = 1, jpjm1
+                     DO ji = 1, jpim1
+                        ikbu = mbku(ji,jj)                  ! deepest ocean u- & v-levels
+                        ikbv = mbkv(ji,jj)
+                        zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj)
+                        zvs = bfrva(ji,jj) * vn(ji,jj,ikbv) * e1v(ji,jj) * e2v(ji,jj)
+                        umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt
+                        vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs
+                        hke(jpdyn_bfri) = hke(jpdyn_bfri) + un(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs
+                     END DO
+                  END DO
+               ENDIF
+               ! 
+               CALL glo_dyn_wri( kt )                 ! print the results in ocean.output
+               !                
+               umo(:) = 0._wp                         ! reset for the next time step
+               vmo(:) = 0._wp
+               hke(:) = 0._wp
+               !
+            ENDIF
+            !
+         END SELECT
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )
+      !
+   END SUBROUTINE trd_glo
+
+
+   SUBROUTINE glo_dyn_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE glo_dyn_wri  ***
+      !! 
+      !! ** Purpose :  write global averaged U, KE, PE<->KE trends in ocean.output 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcof         ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:)  ::  zkx, zky, zkz, zkepe  
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )
+
+      ! I. Momentum trends
+      ! -------------------
+
+      IF( MOD( kt, nn_trd ) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
+
+         ! I.1 Conversion potential energy - kinetic energy
+         ! --------------------------------------------------
+         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap)
+         zkx  (:,:,:) = 0._wp
+         zky  (:,:,:) = 0._wp
+         zkz  (:,:,:) = 0._wp
+         zkepe(:,:,:) = 0._wp
+   
+         CALL eos( tsn, rhd, rhop )       ! now potential density
+
+         zcof = 0.5_wp / rau0             ! Density flux at w-point
+         zkz(:,:,1) = 0._wp
+         DO jk = 2, jpk
+            zkz(:,:,jk) = zcof * e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)
+         END DO
+         
+         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
+                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
+               END DO
+            END DO
+         END DO
+         
+         DO jk = 1, jpkm1                 ! Density flux divergence at t-point
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               &
+                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               &
+                     &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           &
+                     &              / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+
+         ! I.2 Basin averaged kinetic energy trend
+         ! ----------------------------------------
+         peke = 0._wp
+         DO jk = 1, jpkm1
+            peke = peke + SUM( zkepe(:,:,jk) * gdept_n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) )
+         END DO
+         peke = grav * peke
+
+         ! I.3 Sums over the global domain
+         ! ---------------------------------
+         IF( lk_mpp ) THEN
+            CALL mpp_sum( peke )
+            CALL mpp_sum( umo , jptot_dyn )
+            CALL mpp_sum( vmo , jptot_dyn )
+            CALL mpp_sum( hke , jptot_dyn )
+         ENDIF
+
+         ! I.2 Print dynamic trends in the ocean.output file
+         ! --------------------------------------------------
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9500) kt
+            WRITE (numout,9501) umo(jpdyn_hpg) / tvolu, vmo(jpdyn_hpg) / tvolv
+            WRITE (numout,9502) umo(jpdyn_keg) / tvolu, vmo(jpdyn_keg) / tvolv
+            WRITE (numout,9503) umo(jpdyn_rvo) / tvolu, vmo(jpdyn_rvo) / tvolv
+            WRITE (numout,9504) umo(jpdyn_pvo) / tvolu, vmo(jpdyn_pvo) / tvolv
+            WRITE (numout,9505) umo(jpdyn_zad) / tvolu, vmo(jpdyn_zad) / tvolv
+            WRITE (numout,9506) umo(jpdyn_ldf) / tvolu, vmo(jpdyn_ldf) / tvolv
+            WRITE (numout,9507) umo(jpdyn_zdf) / tvolu, vmo(jpdyn_zdf) / tvolv
+            WRITE (numout,9508) umo(jpdyn_spg) / tvolu, vmo(jpdyn_spg) / tvolv
+            WRITE (numout,9509) umo(jpdyn_bfr) / tvolu, vmo(jpdyn_bfr) / tvolv
+            WRITE (numout,9510) umo(jpdyn_atf) / tvolu, vmo(jpdyn_atf) / tvolv
+            WRITE (numout,9511)
+            WRITE (numout,9512)                                                 &
+            &     (  umo(jpdyn_hpg) + umo(jpdyn_keg) + umo(jpdyn_rvo) + umo(jpdyn_pvo)   &
+            &      + umo(jpdyn_zad) + umo(jpdyn_ldf) + umo(jpdyn_zdf) + umo(jpdyn_spg)   &
+            &      + umo(jpdyn_bfr) + umo(jpdyn_atf) ) / tvolu,   &
+            &     (  vmo(jpdyn_hpg) + vmo(jpdyn_keg) + vmo(jpdyn_rvo) + vmo(jpdyn_pvo)   &
+            &      + vmo(jpdyn_zad) + vmo(jpdyn_ldf) + vmo(jpdyn_zdf) + vmo(jpdyn_spg)   &
+            &      + vmo(jpdyn_bfr) + vmo(jpdyn_atf) ) / tvolv
+            WRITE (numout,9513) umo(jpdyn_tau) / tvolu, vmo(jpdyn_tau) / tvolv
+            IF( ln_bfrimp )   WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv
+         ENDIF
+
+ 9500    FORMAT(' momentum trend at it= ', i6, ' :', /' ==============================')
+ 9501    FORMAT(' hydro pressure gradient    u= ', e20.13, '    v= ', e20.13)
+ 9502    FORMAT(' ke gradient                u= ', e20.13, '    v= ', e20.13)
+ 9503    FORMAT(' relative vorticity term    u= ', e20.13, '    v= ', e20.13)
+ 9504    FORMAT(' planetary vorticity term   u= ', e20.13, '    v= ', e20.13)
+ 9505    FORMAT(' vertical advection         u= ', e20.13, '    v= ', e20.13)
+ 9506    FORMAT(' horizontal diffusion       u= ', e20.13, '    v= ', e20.13)
+ 9507    FORMAT(' vertical diffusion         u= ', e20.13, '    v= ', e20.13)
+ 9508    FORMAT(' surface pressure gradient  u= ', e20.13, '    v= ', e20.13)
+ 9509    FORMAT(' explicit bottom friction   u= ', e20.13, '    v= ', e20.13)
+ 9510    FORMAT(' Asselin time filter        u= ', e20.13, '    v= ', e20.13)
+ 9511    FORMAT(' -----------------------------------------------------------------------------')
+ 9512    FORMAT(' total trend                u= ', e20.13, '    v= ', e20.13)
+ 9513    FORMAT(' incl. surface wind stress  u= ', e20.13, '    v= ', e20.13)
+ 9514    FORMAT('       bottom stress        u= ', e20.13, '    v= ', e20.13)
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9520) kt
+            WRITE (numout,9521) hke(jpdyn_hpg) / tvolt
+            WRITE (numout,9522) hke(jpdyn_keg) / tvolt
+            WRITE (numout,9523) hke(jpdyn_rvo) / tvolt
+            WRITE (numout,9524) hke(jpdyn_pvo) / tvolt
+            WRITE (numout,9525) hke(jpdyn_zad) / tvolt
+            WRITE (numout,9526) hke(jpdyn_ldf) / tvolt
+            WRITE (numout,9527) hke(jpdyn_zdf) / tvolt
+            WRITE (numout,9528) hke(jpdyn_spg) / tvolt
+            WRITE (numout,9529) hke(jpdyn_bfr) / tvolt
+            WRITE (numout,9530) hke(jpdyn_atf) / tvolt
+            WRITE (numout,9531)
+            WRITE (numout,9532)   &
+            &     (  hke(jpdyn_hpg) + hke(jpdyn_keg) + hke(jpdyn_rvo) + hke(jpdyn_pvo)   &
+            &      + hke(jpdyn_zad) + hke(jpdyn_ldf) + hke(jpdyn_zdf) + hke(jpdyn_spg)   &
+            &      + hke(jpdyn_bfr) + hke(jpdyn_atf) ) / tvolt
+            WRITE (numout,9533) hke(jpdyn_tau) / tvolt
+            IF( ln_bfrimp )   WRITE (numout,9534) hke(jpdyn_bfri) / tvolt
+         ENDIF
+
+ 9520    FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================')
+ 9521    FORMAT(' hydro pressure gradient   u2= ', e20.13)
+ 9522    FORMAT(' ke gradient               u2= ', e20.13)
+ 9523    FORMAT(' relative vorticity term   u2= ', e20.13)
+ 9524    FORMAT(' planetary vorticity term  u2= ', e20.13)
+ 9525    FORMAT(' vertical advection        u2= ', e20.13)
+ 9526    FORMAT(' horizontal diffusion      u2= ', e20.13)
+ 9527    FORMAT(' vertical diffusion        u2= ', e20.13)
+ 9528    FORMAT(' surface pressure gradient u2= ', e20.13)
+ 9529    FORMAT(' explicit bottom friction  u2= ', e20.13)
+ 9530    FORMAT(' Asselin time filter       u2= ', e20.13)
+ 9531    FORMAT(' --------------------------------------------------')
+ 9532    FORMAT(' total trend               u2= ', e20.13)
+ 9533    FORMAT(' incl. surface wind stress u2= ', e20.13)
+ 9534    FORMAT('       bottom stress       u2= ', e20.13)
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9540) kt
+            WRITE (numout,9541) ( hke(jpdyn_keg) + hke(jpdyn_rvo) + hke(jpdyn_zad) ) / tvolt
+            WRITE (numout,9542) ( hke(jpdyn_keg) + hke(jpdyn_zad) ) / tvolt
+            WRITE (numout,9543) ( hke(jpdyn_pvo) ) / tvolt
+            WRITE (numout,9544) ( hke(jpdyn_rvo) ) / tvolt
+            WRITE (numout,9545) ( hke(jpdyn_spg) ) / tvolt
+            WRITE (numout,9546) ( hke(jpdyn_ldf) ) / tvolt
+            WRITE (numout,9547) ( hke(jpdyn_zdf) ) / tvolt
+            WRITE (numout,9548) ( hke(jpdyn_hpg) ) / tvolt, rpktrd / tvolt
+            WRITE (numout,*)
+            WRITE (numout,*)
+         ENDIF
+
+ 9540    FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================')
+ 9541    FORMAT(' 0 = non linear term (true if KE conserved)                : ', e20.13)
+ 9542    FORMAT(' 0 = ke gradient + vertical advection                      : ', e20.13)
+ 9543    FORMAT(' 0 = coriolis term  (true if KE conserving scheme)         : ', e20.13)
+ 9544    FORMAT(' 0 = vorticity term (true if KE conserving scheme)         : ', e20.13)
+ 9545    FORMAT(' 0 = surface pressure gradient  ???                        : ', e20.13)
+ 9546    FORMAT(' 0 < horizontal diffusion                                  : ', e20.13)
+ 9547    FORMAT(' 0 < vertical diffusion                                    : ', e20.13)
+ 9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)                : ', e20.13, '  u.dz(rhop) =', e20.13)
+         !
+         ! Save potential to kinetic energy conversion for next time step
+         rpktrd = peke
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )
+      !
+   END SUBROUTINE glo_dyn_wri
+
+
+   SUBROUTINE glo_tra_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE glo_tra_wri  ***
+      !! 
+      !! ** Purpose :  write global domain averaged of T and T^2 trends in ocean.output 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   jk   ! loop indices
+      !!----------------------------------------------------------------------
+
+      ! I. Tracers trends
+      ! -----------------
+
+      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
+
+         ! I.1 Sums over the global domain
+         ! -------------------------------
+         IF( lk_mpp ) THEN
+            CALL mpp_sum( tmo, jptot_tra )   
+            CALL mpp_sum( smo, jptot_tra )
+            CALL mpp_sum( t2 , jptot_tra )
+            CALL mpp_sum( s2 , jptot_tra )
+         ENDIF
+
+         ! I.2 Print tracers trends in the ocean.output file
+         ! --------------------------------------------------
+         
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9400) kt
+            WRITE (numout,9401)  tmo(jptra_xad) / tvolt, smo(jptra_xad) / tvolt
+            WRITE (numout,9411)  tmo(jptra_yad) / tvolt, smo(jptra_yad) / tvolt
+            WRITE (numout,9402)  tmo(jptra_zad) / tvolt, smo(jptra_zad) / tvolt
+            WRITE (numout,9403)  tmo(jptra_ldf) / tvolt, smo(jptra_ldf) / tvolt
+            WRITE (numout,9404)  tmo(jptra_zdf) / tvolt, smo(jptra_zdf) / tvolt
+            WRITE (numout,9405)  tmo(jptra_npc) / tvolt, smo(jptra_npc) / tvolt
+            WRITE (numout,9406)  tmo(jptra_dmp) / tvolt, smo(jptra_dmp) / tvolt
+            WRITE (numout,9407)  tmo(jptra_qsr) / tvolt
+            WRITE (numout,9408)  tmo(jptra_nsr) / tvolt, smo(jptra_nsr) / tvolt
+            WRITE (numout,9409) 
+            WRITE (numout,9410) (  tmo(jptra_xad) + tmo(jptra_yad) + tmo(jptra_zad) + tmo(jptra_ldf) + tmo(jptra_zdf)   &
+            &                    + tmo(jptra_npc) + tmo(jptra_dmp) + tmo(jptra_qsr) + tmo(jptra_nsr) ) / tvolt,   &
+            &                   (  smo(jptra_xad) + smo(jptra_yad) + smo(jptra_zad) + smo(jptra_ldf) + smo(jptra_zdf)   &
+            &                    + smo(jptra_npc) + smo(jptra_dmp)                   + smo(jptra_nsr) ) / tvolt
+         ENDIF
+
+9400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   &
+              '              salinity',/' ============================')
+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)
+9404     FORMAT(' vertical diffusion          ',e20.13,'     ',e20.13)
+9405     FORMAT(' static instability mixing   ',e20.13,'     ',e20.13)
+9406     FORMAT(' damping term                ',e20.13,'     ',e20.13)
+9407     FORMAT(' penetrative qsr             ',e20.13)
+9408     FORMAT(' non solar radiation         ',e20.13,'     ',e20.13)
+9409     FORMAT(' -------------------------------------------------------------------------')
+9410     FORMAT(' total trend                 ',e20.13,'     ',e20.13)
+
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9420) kt
+            WRITE (numout,9421)   t2(jptra_xad) / tvolt, s2(jptra_xad) / tvolt
+            WRITE (numout,9431)   t2(jptra_yad) / tvolt, s2(jptra_yad) / tvolt
+            WRITE (numout,9422)   t2(jptra_zad) / tvolt, s2(jptra_zad) / tvolt
+            WRITE (numout,9423)   t2(jptra_ldf) / tvolt, s2(jptra_ldf) / tvolt
+            WRITE (numout,9424)   t2(jptra_zdf) / tvolt, s2(jptra_zdf) / tvolt
+            WRITE (numout,9425)   t2(jptra_npc) / tvolt, s2(jptra_npc) / tvolt
+            WRITE (numout,9426)   t2(jptra_dmp) / tvolt, s2(jptra_dmp) / tvolt
+            WRITE (numout,9427)   t2(jptra_qsr) / tvolt
+            WRITE (numout,9428)   t2(jptra_nsr) / tvolt, s2(jptra_nsr) / tvolt
+            WRITE (numout,9429)
+            WRITE (numout,9430) (  t2(jptra_xad) + t2(jptra_yad) + t2(jptra_zad) + t2(jptra_ldf) + t2(jptra_zdf)   &
+            &                    + t2(jptra_npc) + t2(jptra_dmp) + t2(jptra_qsr) + t2(jptra_nsr) ) / tvolt,   &
+            &                   (  s2(jptra_xad) + s2(jptra_yad) + s2(jptra_zad) + s2(jptra_ldf) + s2(jptra_zdf)   &
+            &                    + s2(jptra_npc) + s2(jptra_dmp)                  + s2(jptra_nsr) ) / tvolt
+         ENDIF
+
+9420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   &
+            '               salinity', /, ' ===============================')
+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)
+9424     FORMAT(' vertical diffusion        * t   ', e20.13, '     ', e20.13)
+9425     FORMAT(' static instability mixing * t   ', e20.13, '     ', e20.13)
+9426     FORMAT(' damping term              * t   ', e20.13, '     ', e20.13)
+9427     FORMAT(' penetrative qsr           * t   ', e20.13)
+9428     FORMAT(' non solar radiation       * t   ', e20.13, '     ', e20.13)
+9429     FORMAT(' -----------------------------------------------------------------------------')
+9430     FORMAT(' total trend                *t = ', e20.13, '  *s = ', e20.13)
+
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9440) kt
+            WRITE (numout,9441) ( tmo(jptra_xad)+tmo(jptra_yad)+tmo(jptra_zad) )/tvolt,   &
+            &                   ( smo(jptra_xad)+smo(jptra_yad)+smo(jptra_zad) )/tvolt
+            WRITE (numout,9442)   tmo(jptra_sad)/tvolt,  smo(jptra_sad)/tvolt
+            WRITE (numout,9443)   tmo(jptra_ldf)/tvolt,  smo(jptra_ldf)/tvolt
+            WRITE (numout,9444)   tmo(jptra_zdf)/tvolt,  smo(jptra_zdf)/tvolt
+            WRITE (numout,9445)   tmo(jptra_npc)/tvolt,  smo(jptra_npc)/tvolt
+            WRITE (numout,9446) ( t2(jptra_xad)+t2(jptra_yad)+t2(jptra_zad) )/tvolt,    &
+            &                   ( s2(jptra_xad)+s2(jptra_yad)+s2(jptra_zad) )/tvolt
+            WRITE (numout,9447)   t2(jptra_ldf)/tvolt,   s2(jptra_ldf)/tvolt
+            WRITE (numout,9448)   t2(jptra_zdf)/tvolt,   s2(jptra_zdf)/tvolt
+            WRITE (numout,9449)   t2(jptra_npc)/tvolt,   s2(jptra_npc)/tvolt
+         ENDIF
+
+9440     FORMAT(' tracer consistency at it= ',i6,   &
+            ' :         temperature','                salinity',/,   &
+            ' ==================================')
+9441     FORMAT(' 0 = horizontal+vertical advection +    ',e20.13,'       ',e20.13)
+9442     FORMAT('     1st lev vertical advection         ',e20.13,'       ',e20.13)
+9443     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13)
+9444     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13)
+9445     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13)
+9446     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13)
+9447     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13)
+9448     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13)
+9449     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13)
+         !
+      ENDIF
+      !
+   END SUBROUTINE glo_tra_wri
+
+
+   SUBROUTINE trd_glo_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_glo_init  ***
+      !! 
+      !! ** Purpose :   Read the namtrd namelist
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_glo_init : integral constraints properties trends'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      ! Total volume at t-points:
+      tvolt = 0._wp
+      DO jk = 1, jpkm1
+         tvolt = tvolt + SUM( e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain
+
+      IF(lwp) WRITE(numout,*) '                total ocean volume at T-point   tvolt = ',tvolt
+
+      ! Initialization of potential to kinetic energy conversion
+      rpktrd = 0._wp
+
+      ! Total volume at u-, v- points:
+!!gm :  bug?  je suis quasi sur que le produit des tmask_i ne correspond pas exactement au umask_i et vmask_i !
+      tvolu = 0._wp
+      tvolv = 0._wp
+
+      DO jk = 1, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u_n(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v_n(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( tvolu )   ! sums over the global domain
+      IF( lk_mpp )   CALL mpp_sum( tvolv )
+
+      IF(lwp) THEN
+         WRITE(numout,*) '                total ocean volume at U-point   tvolu = ',tvolu
+         WRITE(numout,*) '                total ocean volume at V-point   tvolv = ',tvolv
+      ENDIF
+      !
+   END SUBROUTINE trd_glo_init
+
+   !!======================================================================
+END MODULE trdglo
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90	(revision 8732)
@@ -0,0 +1,107 @@
+MODULE trdini
+   !!======================================================================
+   !!                       ***  MODULE  trdini  ***
+   !! Ocean diagnostics:  ocean tracers and dynamic trends
+   !!=====================================================================
+   !! History :   3.5  !  2012-02  (G. Madec) add 3D trends output for T, S, U, V, PE and KE
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_init      : initialization step
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean domain
+   USE trd_oce        ! trends: ocean variables
+   USE trdken         ! trends: 3D kinetic   energy
+   USE trdpen         ! trends: 3D potential energy
+   USE trdglo         ! trends: global domain averaged tracers and dynamics
+   USE trdmxl         ! trends: mixed layer averaged trends (tracer only)
+   USE trdvor         ! trends: vertical averaged vorticity 
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_init   ! called by nemogcm.F90 module
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_init  ***
+      !! 
+      !! ** Purpose :   Initialization of trend diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios   ! local integer
+      !!
+      NAMELIST/namtrd/ ln_dyn_trd, ln_KE_trd, ln_vor_trd, ln_dyn_mxl,   &
+         &             ln_tra_trd, ln_PE_trd, ln_glo_trd, ln_tra_mxl, nn_trd 
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namtrd in reference namelist : trends diagnostic
+      READ  ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namtrd in configuration namelist : trends diagnostic
+      READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namtrd )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_init : Momentum/Tracers trends'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrd : set trends parameters'
+         WRITE(numout,*) '      global domain averaged dyn & tra trends   ln_glo_trd  = ', ln_glo_trd
+         WRITE(numout,*) '      U & V trends: 3D output                   ln_dyn_trd  = ', ln_dyn_trd
+         WRITE(numout,*) '      U & V trends: Mixed Layer averaged        ln_dyn_mxl  = ', ln_dyn_mxl
+         WRITE(numout,*) '      T & S trends: 3D output                   ln_tra_trd  = ', ln_tra_trd
+         WRITE(numout,*) '      T & S trends: Mixed Layer averaged        ln_tra_mxl  = ', ln_tra_mxl
+         WRITE(numout,*) '      Kinetic   Energy trends                   ln_KE_trd   = ', ln_KE_trd
+         WRITE(numout,*) '      Potential Energy trends                   ln_PE_trd   = ', ln_PE_trd
+         WRITE(numout,*) '      Barotropic vorticity trends               ln_vor_trd  = ', ln_vor_trd
+         !
+         WRITE(numout,*) '      frequency of trends diagnostics (glo)     nn_trd      = ', nn_trd
+      ENDIF
+      !
+      !                             ! trend extraction flags  
+      l_trdtra = .FALSE.                                                       ! tracers  
+      IF ( ln_tra_trd .OR. ln_PE_trd .OR. ln_tra_mxl .OR.   &
+         & ln_glo_trd                                       )   l_trdtra = .TRUE. 
+      !
+      l_trddyn = .FALSE.                                                       ! momentum
+      IF ( ln_dyn_trd .OR. ln_KE_trd .OR. ln_dyn_mxl .OR.   &
+         & ln_vor_trd .OR. ln_glo_trd                       )   l_trddyn = .TRUE.
+      !
+
+!!gm check the stop below      
+      IF( ln_dyn_mxl )   CALL ctl_stop( 'ML diag on momentum are not yet coded we stop' )
+      !
+
+!!gm end
+      IF( ln_tra_mxl .OR. ln_vor_trd )   CALL ctl_stop( 'ML tracer and Barotropic vorticity diags are still using old IOIPSL' )
+!!gm end
+      !
+!      IF( .NOT.ln_linssh .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' )
+      
+!!gm  : Potential BUG : 3D output only for vector invariant form!  add a ctl_stop or code the flux form case
+!!gm  : bug/pb for vertical advection of tracer in vvl case: add T.dt[eta] in the output... 
+
+      !                             ! diagnostic initialization  
+      IF( ln_glo_trd )   CALL trd_glo_init      ! global domain averaged trends
+      IF( ln_tra_mxl )   CALL trd_mxl_init      ! mixed-layer          trends  
+      IF( ln_vor_trd )   CALL trd_vor_init      ! barotropic vorticity trends
+      IF( ln_KE_trd  )   CALL trd_ken_init      ! 3D Kinetic    energy trends
+      IF( ln_PE_trd  )   CALL trd_pen_init      ! 3D Potential  energy trends
+      !
+   END SUBROUTINE trd_init
+
+   !!======================================================================
+END MODULE trdini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90	(revision 8732)
@@ -0,0 +1,267 @@
+MODULE trdken
+   !!======================================================================
+   !!                       ***  MODULE  trdken  ***
+   !! Ocean diagnostics:  compute and output 3D kinetic energy trends
+   !!=====================================================================
+   !! History :  3.5  !  2012-02  (G. Madec) original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_ken       : compute and output 3D Kinetic energy trends using IOM
+   !!   trd_ken_init  : initialisation
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE zdf_oce        ! ocean vertical physics variables
+   USE trd_oce        ! trends: ocean variables
+!!gm   USE dynhpg          ! hydrostatic pressure gradient   
+   USE zdfbfr         ! bottom friction
+   USE ldftra         ! ocean active tracers lateral physics
+   USE phycst         ! physical constants
+   USE trdvor         ! ocean vorticity trends 
+   USE trdglo         ! trends:global domain averaged
+   USE trdmxl         ! ocean active mixed layer tracers trends
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+   USE ldfslp         ! Isopycnal slopes
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_ken       ! called by trddyn module
+   PUBLIC   trd_ken_init  ! called by trdini module
+
+   INTEGER ::   nkstp       ! current time step 
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   bu, bv   ! volume of u- and v-boxes
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   r1_bt    ! inverse of t-box volume
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_ken_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION trd_ken_alloc  ***
+      !!---------------------------------------------------------------------
+      ALLOCATE( bu(jpi,jpj,jpk) , bv(jpi,jpj,jpk) , r1_bt(jpi,jpj,jpk) , STAT= trd_ken_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_ken_alloc )
+      IF( trd_ken_alloc /= 0 )   CALL ctl_warn('trd_ken_alloc: failed to allocate arrays')
+   END FUNCTION trd_ken_alloc
+
+
+   SUBROUTINE trd_ken( putrd, pvtrd, ktrd, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_ken  ***
+      !! 
+      !! ** Purpose :   output 3D Kinetic Energy trends using IOM
+      !!
+      !! ** Method  : - apply lbc to the input masked velocity trends 
+      !!              - compute the associated KE trend:
+      !!          zke = 0.5 * (  mi-1[ un * putrd * bu ] + mj-1[ vn * pvtrd * bv]  ) / bt
+      !!      where bu, bv, bt are the volume of u-, v- and t-boxes. 
+      !!              - vertical diffusion case (jpdyn_zdf): 
+      !!          diagnose separately the KE trend associated with wind stress
+      !!              - bottom friction case (jpdyn_bfr):
+      !!          explicit case (ln_bfrimp=F): bottom trend put in the 1st level 
+      !!                                       of putrd, pvtrd
+      !
+      !
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V masked trends
+      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
+      INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      !
+      INTEGER ::   ji, jj, jk       ! dummy loop indices
+      INTEGER ::   ikbu  , ikbv     ! local integers
+      INTEGER ::   ikbum1, ikbvm1   !   -       -
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy, zke2d   ! 2D workspace 
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zke                 ! 3D workspace 
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zke )
+      !
+      CALL lbc_lnk( putrd, 'U', -1. )   ;   CALL lbc_lnk( pvtrd, 'V', -1. )      ! lateral boundary conditions
+      !
+      nkstp = kt
+      DO jk = 1, jpkm1
+         bu   (:,:,jk) =    e1e2u(:,:) * e3u_n(:,:,jk)
+         bv   (:,:,jk) =    e1e2v(:,:) * e3v_n(:,:,jk)
+         r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk)
+      END DO
+      !
+      zke(:,:,jpk) = 0._wp
+      zke(1,:, : ) = 0._wp
+      zke(:,1, : ) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               zke(ji,jj,jk) = 0.5_wp * rau0 *( un(ji  ,jj,jk) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  &
+                  &                           + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  &
+                  &                           + vn(ji,jj  ,jk) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  &
+                  &                           + vn(ji,jj-1,jk) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk)  ) * r1_bt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      SELECT CASE( ktrd )
+         CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg"   , zke )    ! hydrostatic pressure gradient
+         CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg"   , zke )    ! surface pressure gradient
+         CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo"   , zke )    ! planetary vorticity
+         CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo"   , zke )    ! relative  vorticity     (or metric term)
+         CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg"   , zke )    ! Kinetic Energy gradient (or had)
+         CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad"   , zke )    ! vertical   advection
+         CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf"   , zke )    ! lateral diffusion
+         CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf"   , zke )    ! vertical diffusion 
+         !                   !                                          ! wind stress trends
+                                 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d )
+                           z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1)
+                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1)
+                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+                           DO jj = 2, jpj
+                              DO ji = 2, jpi
+                                 zke2d(ji,jj) = r1_rau0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+                                 &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1)
+                              END DO
+                           END DO
+                                 CALL iom_put( "ketrd_tau"   , zke2d )  ! 
+                                 CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d )
+         CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr"   , zke )    ! bottom friction (explicit case) 
+!!gm TO BE DONE properly
+!!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....
+!         IF(.NOT. ln_bfrimp) THEN
+!            DO jj = 1, jpj    !   
+!               DO ji = 1, jpi
+!                  ikbu = mbku(ji,jj)         ! deepest ocean u- & v-levels
+!                  ikbv = mbkv(ji,jj)   
+!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu)
+!                  z2dy(ji,jj) = vn(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv)
+!               END DO
+!            END DO
+!            zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+!            DO jj = 2, jpj
+!               DO ji = 2, jpi
+!                  zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+!                     &                      + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,  BEURK!!!
+!               END DO
+!            END DO
+!                                    CALL iom_put( "ketrd_bfr"  , zke2d )   ! bottom friction (explicit case)
+!         ENDIF
+!!gm end
+         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf"   , zke )    ! asselin filter trends 
+!! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!!
+!! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf....
+!
+!         IF( ln_bfrimp ) THEN                                          ! bottom friction (implicit case)
+!            DO jj = 1, jpj                                                  ! after velocity known (now filed at this stage)
+!               DO ji = 1, jpi
+!                  ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
+!                  ikbv = mbkv(ji,jj)
+!                  z2dx(ji,jj) = un(ji,jj,ikbu) * bfrua(ji,jj) * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu)
+!                  z2dy(ji,jj) = un(ji,jj,ikbu) * bfrva(ji,jj) * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv)
+!               END DO
+!            END DO
+!            zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp
+!            DO jj = 2, jpj
+!               DO ji = 2, jpi
+!                  zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   &
+!                     &                      + z2dy(ji,jj) + z2dy(ji,jj-1)   )
+!               END DO
+!            END DO
+!                              CALL iom_put( "ketrd_bfri", zke2d )
+!         ENDIF
+        CASE( jpdyn_ken )   ;   ! kinetic energy
+                    ! called in dynnxt.F90 before asselin time filter
+                    ! with putrd=ua and pvtrd=va
+                    zke(:,:,:) = 0.5_wp * zke(:,:,:)
+                    CALL iom_put( "KE", zke )
+                    !
+                    CALL ken_p2k( kt , zke )
+                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w
+         !
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zke )
+      !
+   END SUBROUTINE trd_ken
+
+
+   SUBROUTINE ken_p2k( kt , pconv )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE ken_p2k  ***
+      !!                    
+      !! ** Purpose :   compute rate of conversion from potential to kinetic energy
+      !!
+      !! ** Method  : - compute conv defined as -rau*g*w on T-grid points
+      !! 
+      !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps)
+      !!---------------------------------------------------------------------- 
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   pconv
+      !
+      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
+      INTEGER  ::   iku, ikv                         ! temporary integers
+      REAL(wp) ::   zcoef                            ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zconv  ! temporary conv on W-grid
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zconv )
+      !
+      ! Local constant initialization 
+      zcoef = - rau0 * grav * 0.5_wp      
+      
+      !  Surface value (also valid in partial step case)
+      zconv(:,:,1) = zcoef * ( 2._wp * rhd(:,:,1) ) * wn(:,:,1) * e3w_n(:,:,1)
+
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpk
+         zconv(:,:,jk) = zcoef * ( rhd(:,:,jk) + rhd(:,:,jk-1) ) * wn(:,:,jk) * e3w_n(:,:,jk)
+      END DO
+
+      ! conv value on T-point
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcoef = 0.5_wp / e3t_n(ji,jj,jk)
+               pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zconv )      
+      !
+   END SUBROUTINE ken_p2k
+
+
+   SUBROUTINE trd_ken_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_ken_init  ***
+      !! 
+      !! ** Purpose :   initialisation of 3D Kinetic Energy trend diagnostic
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_ken_init : 3D Kinetic Energy trends'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !                           ! allocate box volume arrays
+      IF( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays')
+      !
+   END SUBROUTINE trd_ken_init
+
+   !!======================================================================
+END MODULE trdken
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90	(revision 8732)
@@ -0,0 +1,887 @@
+MODULE trdmxl
+   !!======================================================================
+   !!                       ***  MODULE  trdmxl  ***
+   !! Ocean diagnostics:  mixed layer T-S trends 
+   !!======================================================================
+   !! History :  OPA  !  1995-04  (J. Vialard)    Original code
+   !!                 !  1997-02  (E. Guilyardi)  Adaptation global + base cmo
+   !!                 !  1999-09  (E. Guilyardi)  Re-writing + netCDF output
+   !!   NEMO     1.0  !  2002-06  (G. Madec)      F90: Free form and module
+   !!             -   !  2004-08  (C. Talandier)  New trends organization
+   !!            2.0  !  2005-05  (C. Deltel)     Diagnose trends of time averaged ML T & S
+   !!            3.5  !  2012-03  (G. Madec)      complete reorganisation + change in the time averaging
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_mxl          : T and S cumulated trends averaged over the mixed layer
+   !!   trd_mxl_zint     : T and S trends vertical integration
+   !!   trd_mxl_init     : initialization step
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trd_oce         ! trends: ocean variables
+   USE trdmxl_oce      ! ocean variables trends
+   USE ldftra          ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE zdf_oce         ! ocean vertical physics
+   USE phycst          ! Define parameters for the routines
+   USE dianam          ! build the name of file (routine)
+   USE ldfslp          ! iso-neutral slopes 
+   USE zdfmxl          ! mixed layer depth
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trdmxl_rst      ! restart for diagnosing the ML trends
+   !
+   USE in_out_manager  ! I/O manager
+   USE ioipsl          ! NetCDF library
+   USE prtctl          ! Print control
+   USE restart         ! for lrst_oce
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_mxl        ! routine called by step.F90
+   PUBLIC   trd_mxl_init   ! routine called by opa.F90
+   PUBLIC   trd_mxl_zint   ! routine called by tracers routines
+
+   INTEGER ::   nkstp       ! current time step 
+
+!!gm  to be moved from trdmxl_oce
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   hml                ! ML depth (sum of e3t over nmln-1 levels) [m] 
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   tml    , sml       ! now ML averaged T & S 
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   tmlb_nf, smlb_nf   ! not filtered before ML averaged T & S
+!
+!
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   hmlb, hmln         ! before, now, and after Mixed Layer depths [m]
+!   
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   tb_mlb, tb_mln     ! before (not filtered) tracer averaged over before and now ML 
+!
+!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   tn_mln             ! now tracer averaged over now ML
+!!gm end   
+   
+   CHARACTER (LEN=40) ::  clhstnam         ! name of the trends NetCDF file
+   INTEGER ::   nh_t, nmoymltrd
+   INTEGER ::   nidtrd
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1
+   INTEGER ::   ndimtrd1                        
+   INTEGER ::   ionce, icount                   
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_mxl_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( ndextrd1(jpi*jpj) , STAT=trd_mxl_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_mxl_alloc )
+      IF( trd_mxl_alloc /= 0 )   CALL ctl_warn('trd_mxl_alloc: failed to allocate array ndextrd1')
+   END FUNCTION trd_mxl_alloc
+
+
+   SUBROUTINE trd_tra_mxl( ptrdx, ptrdy, ktrd, kt, p2dt, kmxln )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_mng  ***
+      !! 
+      !! ** Purpose :   Dispatch all trends computation, e.g. 3D output, integral
+      !!                constraints, barotropic vorticity, kinetic enrgy, 
+      !!                potential energy, and/or mixed layer budget.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step index
+      REAL(wp)                  , INTENT(in   ) ::   p2dt    ! time step  [s]
+      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   kmxln   ! number of t-box for the vertical average 
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      !                         !==============================!
+      IF ( kt /= nkstp ) THEN   !=  1st call at kt time step  =!
+         !                      !==============================!
+         nkstp = kt
+         
+         
+         !                          !==  reset trend arrays to zero  ==!
+         tmltrd(:,:,:) = 0._wp    ;    smltrd(:,:,:) = 0._wp    
+         
+         
+         !
+         wkx(:,:,:) = 0._wp         !==  now ML weights for vertical averaging  ==!
+         DO jk = 1, jpktrd               ! initialize wkx with vertical scale factor in mixed-layer
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  IF( jk - kmxln(ji,jj) < 0 )   wkx(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         hmxl(:,:) = 0._wp               ! NOW mixed-layer depth
+         DO jk = 1, jpktrd
+            hmxl(:,:) = hmxl(:,:) + wkx(:,:,jk)
+         END DO
+         DO jk = 1, jpktrd               ! integration weights
+            wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1.e-20_wp, hmxl(:,:) ) * tmask(:,:,1)
+         END DO
+         
+         
+         !
+         !                          !==  Vertically averaged T and S  ==!
+         tml(:,:) = 0._wp   ;   sml(:,:) = 0._wp
+         DO jk = 1, jpktrd
+            tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem)
+            sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal)
+         END DO
+         !
+      ENDIF
+
+
+
+      ! mean now trends over the now ML 
+      tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + ptrdx(:,:,jk) * wkx(:,:,jk)   ! temperature
+      smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + ptrdy(:,:,jk) * wkx(:,:,jk)   ! salinity
+ 
+
+ 
+!!gm to be put juste before the output !
+!      ! Lateral boundary conditions
+!      CALL lbc_lnk( tmltrd(:,:,jl), 'T', 1. )
+!      CALL lbc_lnk( smltrd(:,:,jl), 'T', 1. )
+!!gm end
+
+
+
+         SELECT CASE( ktrd )
+         CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf
+!!gm : to be completed ! 
+!		   IF( ....
+!!gm end
+         CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion
+!                                   ! regroup iso-neutral diffusion in one term
+         tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) )
+         smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) )
+         !                                   ! put in zdf the dia-neutral diffusion
+         tmltrd(:,:,jpmxl_zdf) = tmltrd(:,:,jpmxl_zdfp)
+         smltrd(:,:,jpmxl_zdf) = smltrd(:,:,jpmxl_zdfp)
+         IF( ln_zdfnpc ) THEN
+            tmltrd(:,:,jpmxl_zdf) = tmltrd(:,:,jpmxl_zdf) + tmltrd(:,:,jpmxl_npc)
+            smltrd(:,:,jpmxl_zdf) = smltrd(:,:,jpmxl_zdf) + smltrd(:,:,jpmxl_npc)
+         ENDIF
+         !
+      CASE( jptra_atf  )               ! last trends of the current time step: perform the time averaging & output
+         !
+         ! after ML           :   zhmla                      NB will be swaped to provide hmln and hmlb
+         !
+         ! entrainement ent_1 :   tb_mln - tb_mlb        ==>> use previous timestep ztn_mla = tb_mln
+         !                                                    "     "         "     tn_mln = tb_mlb  (unfiltered tb!)
+         !                                                   NB: tn_mln itself comes from the 2 time step before (ta_mla)
+         !
+         ! atf trend          :   ztbf_mln - tb_mln      ==>> use previous timestep tn_mla = tb_mln
+         !                                                   need to compute tbf_mln, using the current tb
+         !                                                   which is the before fitered tracer
+         !
+         ! entrainement ent_2 :   zta_mla - zta_mln      ==>> need to compute zta_mla and zta_mln
+         !
+         ! time averaging     :   mean: CALL trd_mean( kt, ptrd, ptrdm )
+         !                              and out put the starting mean value and the total trends
+         !                              (i.e. difference between starting and ending values)
+         !                        hat : CALL trd_hat ( kt, ptrd, ptrdm )
+         !                              and output the starting hat value and the total hat trends
+         !
+         ! swaps              :   hmlb   <==   hmln   <== zhmla
+         !                        tb_mlb <==  tn_mln  <== zta_mla
+         !                        tb_mln <== ztn_mla     ==>> now T over after h, need to be computed here 
+         !                                                    to be used at next time step (unfiltered before)
+         !
+      END SELECT
+      !
+   END SUBROUTINE trd_tra_mxl
+
+
+   SUBROUTINE trd_mean( kt, ptrd, ptrdm )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mean  ***
+      !! 
+      !! ** Purpose :   
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrd    ! trend at kt
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdm   ! cumulative trends at kt
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step index
+      !!----------------------------------------------------------------------
+      !
+      IF ( kt == nn_it000 )   ptrdm(:,:,:) = 0._wp
+      !
+      ptrdm(:,:,:) = ptrdm(:,:,:) + ptrd(:,:,:)
+      !
+      IF ( MOD( kt - nn_it000 + 1, nn_trd ) == 0 ) THEN
+         !
+         ! call iom put????  avec en argument le tableau de nom des trends?
+         !
+      ENDIF
+      !
+   END SUBROUTINE trd_mean
+
+
+   SUBROUTINE trd_mxl_zint( pttrdmxl, pstrdmxl, ktrd, ctype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_zint  ***
+      !! 
+      !! ** Purpose :   Compute the vertical average of the 3D fields given as arguments 
+      !!                to the subroutine. This vertical average is performed from ocean
+      !!                surface down to a chosen control surface.
+      !!
+      !! ** Method/usage :
+      !!      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
+      !!      Note: in the remainder of the routine, the volume between the 
+      !!            surface and the control surface is called "mixed-layer"
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT( in ) ::   ktrd       ! ocean trend index
+      CHARACTER(len=2)                , INTENT( in ) ::   ctype      ! 2D surface/bottom or 3D interior physics
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pttrdmxl   ! temperature trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pstrdmxl   ! salinity trend 
+      !
+      INTEGER ::   ji, jj, jk, isum
+      REAL(wp), POINTER, DIMENSION(:,:)  :: zvlmsk 
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zvlmsk ) 
+
+      ! I. Definition of control surface and associated fields
+      ! ------------------------------------------------------
+      !            ==> only once per time step <== 
+
+      IF( icount == 1 ) THEN        
+         !
+         
+!!gm BUG?
+!!gm CAUTION:  double check the definition of nmln  it is the nb of w-level, not t-level I guess
+
+         
+         ! ... Set nmxl(ji,jj) = index of first T point below control surf. or outside mixed-layer
+         IF( nn_ctls == 0 ) THEN       ! * control surface = mixed-layer with density criterion 
+            nmxl(:,:) = nmln(:,:)    ! array nmln computed in zdfmxl.F90
+         ELSEIF( nn_ctls == 1 ) THEN   ! * control surface = read index from file 
+            nmxl(:,:) = nbol(:,:)
+         ELSEIF( nn_ctls >= 2 ) THEN   ! * control surface = model level
+            nn_ctls = MIN( nn_ctls, jpktrd - 1 )
+            nmxl(:,:) = nn_ctls + 1
+         ENDIF
+
+      END IF
+      !
+      CALL wrk_dealloc( jpi, jpj, zvlmsk ) 
+      !
+   END SUBROUTINE trd_mxl_zint
+    
+
+   SUBROUTINE trd_mxl( kt, p2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl  ***
+      !! 
+      !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis
+      !!               period, and write NetCDF outputs.
+      !!
+      !! ** Method/usage :
+      !!          The stored trends can be chosen twofold (according to the ln_trdmxl_instant 
+      !!          logical namelist variable) :
+      !!          1) to explain the difference between initial and final 
+      !!             mixed-layer T & S (where initial and final relate to the
+      !!             current analysis window, defined by nn_trd in the namelist)
+      !!          2) to explain the difference between the current and previous 
+      !!             TIME-AVERAGED mixed-layer T & S (where time-averaging is
+      !!             performed over each analysis window).
+      !!
+      !! ** Consistency check : 
+      !!        If the control surface is fixed ( nn_ctls > 1 ), the residual term (dh/dt
+      !!        entrainment) should be zero, at machine accuracy. Note that in the case
+      !!        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. nn_trd=5, rn_ucf=1., nn_ctls=8
+      !!             for checking residuals.
+      !!             On a NEC-SX5 computer, this typically leads to:
+      !!                   O(1.e-20) temp. residuals (tml_res) when ln_trdmxl_instant=.false.
+      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmxl_instant=.true.
+      !!
+      !! ** Action :
+      !!       At each time step, mixed-layer averaged trends are stored in the 
+      !!       tmltrd(:,:,jpmxl_xxx) array (see trdmxl_oce.F90 for definitions of jpmxl_xxx).
+      !!       This array is known when trd_mxl is called, at the end of the stp subroutine, 
+      !!       except for the purely vertical K_z diffusion term, which is embedded in the
+      !!       lateral diffusion trend.
+      !!
+      !!       In I), this K_z term is diagnosed and stored, thus its contribution is removed
+      !!       from the lateral diffusion trend.
+      !!       In II), the instantaneous mixed-layer T & S are computed, and misc. cumulative
+      !!       arrays are updated.
+      !!       In III), called only once per analysis window, we compute the total trends,
+      !!       along with the residuals and the Asselin correction terms.
+      !!       In IV), the appropriate trends are written in the trends NetCDF file.
+      !!
+      !! References :  Vialard et al.,2001, JPO.
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   ) ::   kt     ! ocean time-step index
+      REAL(wp), INTENT(in   ) ::   p2dt   ! time step  [s]
+      !
+      INTEGER :: ji, jj, jk, jl, ik, it, itmod
+      LOGICAL :: lldebug = .TRUE.
+      REAL(wp) :: zavt, zfn, zfn2
+      !                                              ! z(ts)mltot : dT/dt over the anlysis window (including Asselin)
+      !                                              ! z(ts)mlres : residual = dh/dt entrainment term
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2  
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics
+      !!----------------------------------------------------------------------
+  
+      CALL wrk_alloc( jpi, jpj,         ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf                        )
+      CALL wrk_alloc( jpi, jpj,         ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 )  
+      CALL wrk_alloc( jpi, jpj, jpltrd, ztmltrd2, zsmltrd2                                                               )
+
+      ! ======================================================================
+      ! II. Cumulate the trends over the analysis window
+      ! ======================================================================
+
+      ztmltrd2(:,:,:) = 0.e0   ;    zsmltrd2(:,:,:) = 0.e0  ! <<< reset arrays to zero
+      ztmltot2(:,:)   = 0.e0   ;    zsmltot2(:,:)   = 0.e0
+      ztmlres2(:,:)   = 0.e0   ;    zsmlres2(:,:)   = 0.e0
+      ztmlatf2(:,:)   = 0.e0   ;    zsmlatf2(:,:)   = 0.e0
+
+      ! II.1 Set before values of vertically average T and S 
+      ! ----------------------------------------------------
+      IF( kt > nit000 ) THEN
+         !   ... temperature ...                    ... salinity ...
+         tmlb   (:,:) = tml   (:,:)             ;   smlb   (:,:) = sml   (:,:)
+         tmlatfn(:,:) = tmltrd(:,:,jpmxl_atf)   ;   smlatfn(:,:) = smltrd(:,:,jpmxl_atf)
+      END IF
+
+
+      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window    
+      ! ------------------------------------------------------------------------
+      IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)
+         !
+         !   ... temperature ...                ... salinity ...
+         tmlbb  (:,:) = tmlb   (:,:)   ;   smlbb  (:,:) = smlb   (:,:)
+         tmlbn  (:,:) = tml    (:,:)   ;   smlbn  (:,:) = sml    (:,:)
+         tmlatfb(:,:) = tmlatfn(:,:)   ;   smlatfb(:,:) = smlatfn(:,:)
+         
+         tmltrd_csum_ub (:,:,:) = 0.e0  ;   smltrd_csum_ub (:,:,:) = 0.e0
+         tmltrd_atf_sumb(:,:)   = 0.e0  ;   smltrd_atf_sumb(:,:)   = 0.e0
+
+         hmxlbn(:,:) = hmxl(:,:)
+
+         IF( ln_ctl ) THEN
+            WRITE(numout,*) '             we reach kt == nit000 + 1 = ', nit000+1
+            CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=tmlbn   , clinfo1=' tmlbn   -   : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb -   : ', mask1=tmask, ovlap=1)
+         END IF
+         !
+      END IF
+
+      IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. ( ln_ctl ) ) THEN
+         IF( ln_trdmxl_instant ) THEN
+            WRITE(numout,*) '             restart from kt == nit000 = ', nit000
+            CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=tmlbn   , clinfo1=' tmlbn   -   : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb -   : ', mask1=tmask, ovlap=1)
+         ELSE
+            WRITE(numout,*) '             restart from kt == nit000 = ', nit000
+            CALL prt_ctl(tab2d_1=tmlbn          , clinfo1=' tmlbn           -  : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=hmxlbn         , clinfo1=' hmxlbn          -  : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=tml_sumb       , clinfo1=' tml_sumb        -  : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab2d_1=tmltrd_atf_sumb, clinfo1=' tmltrd_atf_sumb -  : ', mask1=tmask, ovlap=1)
+            CALL prt_ctl(tab3d_1=tmltrd_csum_ub , clinfo1=' tmltrd_csum_ub  -  : ', mask1=tmask, ovlap=1, kdim=1)
+         END IF
+      END IF
+
+      ! II.4 Cumulated trends over the analysis period
+      ! ----------------------------------------------
+      !
+      !         [  1rst analysis window ] [     2nd analysis window     ]                       
+      !
+      !     o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps
+      !                          nn_trd                           2*nn_trd       etc.
+      !     1      2     3     4    =5 e.g.                          =10
+      !
+      IF( ( kt >= 2 ).OR.( ln_rstart ) ) THEN
+         !
+         nmoymltrd = nmoymltrd + 1
+         
+         ! ... Cumulate over BOTH physical contributions AND over time steps
+         DO jl = 1, jpltrd
+            tmltrdm(:,:) = tmltrdm(:,:) + tmltrd(:,:,jl)
+            smltrdm(:,:) = smltrdm(:,:) + smltrd(:,:,jl)
+         END DO
+
+         ! ... Special handling of the Asselin trend 
+         tmlatfm(:,:) = tmlatfm(:,:) + tmlatfn(:,:)
+         smlatfm(:,:) = smlatfm(:,:) + smlatfn(:,:)
+
+         ! ... Trends associated with the time mean of the ML T/S
+         tmltrd_sum    (:,:,:) = tmltrd_sum    (:,:,:) + tmltrd    (:,:,:) ! tem
+         tmltrd_csum_ln(:,:,:) = tmltrd_csum_ln(:,:,:) + tmltrd_sum(:,:,:)
+         tml_sum       (:,:)   = tml_sum       (:,:)   + tml       (:,:)
+         smltrd_sum    (:,:,:) = smltrd_sum    (:,:,:) + smltrd    (:,:,:) ! sal
+         smltrd_csum_ln(:,:,:) = smltrd_csum_ln(:,:,:) + smltrd_sum(:,:,:)
+         sml_sum       (:,:)   = sml_sum       (:,:)   + sml       (:,:)
+         hmxl_sum      (:,:)   = hmxl_sum      (:,:)   + hmxl      (:,:)   ! rmxl
+         !
+      END IF
+
+      ! ======================================================================
+      ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD)
+      ! ======================================================================
+
+      ! Convert to appropriate physical units
+      ! N.B. It may be useful to check IOIPSL time averaging with :
+      !      tmltrd (:,:,:) = 1. ; smltrd (:,:,:) = 1.
+      tmltrd(:,:,:) = tmltrd(:,:,:) * rn_ucf   ! (actually needed for 1:jpltrd-1, but trdmxl(:,:,jpltrd)
+      smltrd(:,:,:) = smltrd(:,:,:) * rn_ucf   !  is no longer used, and is reset to 0. at next time step)
+      
+      ! define time axis
+      it = kt
+      itmod = kt - nit000 + 1
+
+      MODULO_NTRD : IF( MOD( itmod, nn_trd ) == 0 ) THEN        ! nitend MUST be multiple of nn_trd
+         !
+         ztmltot (:,:) = 0.e0   ;   zsmltot (:,:) = 0.e0   ! reset arrays to zero
+         ztmlres (:,:) = 0.e0   ;   zsmlres (:,:) = 0.e0
+         ztmltot2(:,:) = 0.e0   ;   zsmltot2(:,:) = 0.e0
+         ztmlres2(:,:) = 0.e0   ;   zsmlres2(:,:) = 0.e0
+      
+         zfn  = REAL( nmoymltrd, wp )   ;   zfn2 = zfn * zfn
+         
+         ! III.1 Prepare fields for output ("instantaneous" diagnostics) 
+         ! -------------------------------------------------------------
+         
+         !-- Compute total trends
+         ztmltot(:,:) = ( tml(:,:) - tmlbn(:,:) + tmlb(:,:) - tmlbb(:,:) ) / p2dt
+         zsmltot(:,:) = ( sml(:,:) - smlbn(:,:) + smlb(:,:) - smlbb(:,:) ) / p2dt
+         
+         !-- Compute residuals
+         ztmlres(:,:) = ztmltot(:,:) - ( tmltrdm(:,:) - tmlatfn(:,:) + tmlatfb(:,:) )
+         zsmlres(:,:) = zsmltot(:,:) - ( smltrdm(:,:) - smlatfn(:,:) + smlatfb(:,:) )
+      
+         !-- Diagnose Asselin trend over the analysis window 
+         ztmlatf(:,:) = tmlatfm(:,:) - tmlatfn(:,:) + tmlatfb(:,:)
+         zsmlatf(:,:) = smlatfm(:,:) - smlatfn(:,:) + smlatfb(:,:)
+         
+         !-- Lateral boundary conditions
+         !         ... temperature ...                    ... salinity ...
+         CALL lbc_lnk( ztmltot , 'T', 1. )  ;   CALL lbc_lnk( zsmltot , 'T', 1. )
+         CALL lbc_lnk( ztmlres , 'T', 1. )  ;   CALL lbc_lnk( zsmlres , 'T', 1. )
+         CALL lbc_lnk( ztmlatf , 'T', 1. )  ;   CALL lbc_lnk( zsmlatf , 'T', 1. )
+
+
+         ! III.2 Prepare fields for output ("mean" diagnostics) 
+         ! ----------------------------------------------------
+         
+         !-- Update the ML depth time sum (to build the Leap-Frog time mean)
+         hmxl_sum(:,:) = hmxlbn(:,:) + 2 * ( hmxl_sum(:,:) - hmxl(:,:) ) + hmxl(:,:)
+
+         !-- Compute temperature total trends
+         tml_sum (:,:) = tmlbn(:,:) + 2 * ( tml_sum(:,:) - tml(:,:) ) + tml(:,:)
+         ztmltot2(:,:) = ( tml_sum(:,:) - tml_sumb(:,:) ) / p2dt    ! now in degC/s
+         
+         !-- Compute salinity total trends
+         sml_sum (:,:) = smlbn(:,:) + 2 * ( sml_sum(:,:) - sml(:,:) ) + sml(:,:)
+         zsmltot2(:,:) = ( sml_sum(:,:) - sml_sumb(:,:) ) / p2dt    ! now in psu/s
+         
+         !-- Compute temperature residuals
+         DO jl = 1, jpltrd
+            ztmltrd2(:,:,jl) = tmltrd_csum_ub(:,:,jl) + tmltrd_csum_ln(:,:,jl)
+         END DO
+
+         ztmltrdm2(:,:) = 0.e0
+         DO jl = 1, jpltrd
+            ztmltrdm2(:,:) = ztmltrdm2(:,:) + ztmltrd2(:,:,jl)
+         END DO
+
+         ztmlres2(:,:) =  ztmltot2(:,:)  -       &
+              ( ztmltrdm2(:,:) - tmltrd_sum(:,:,jpmxl_atf) + tmltrd_atf_sumb(:,:) )
+         
+         !-- Compute salinity residuals
+         DO jl = 1, jpltrd
+            zsmltrd2(:,:,jl) = smltrd_csum_ub(:,:,jl) + smltrd_csum_ln(:,:,jl)
+         END DO
+
+         zsmltrdm2(:,:) = 0.
+         DO jl = 1, jpltrd
+            zsmltrdm2(:,:) = zsmltrdm2(:,:) + zsmltrd2(:,:,jl)
+         END DO
+
+         zsmlres2(:,:) =  zsmltot2(:,:)  -       &
+              ( zsmltrdm2(:,:) - smltrd_sum(:,:,jpmxl_atf) + smltrd_atf_sumb(:,:) )
+         
+         !-- Diagnose Asselin trend over the analysis window
+         ztmlatf2(:,:) = ztmltrd2(:,:,jpmxl_atf) - tmltrd_sum(:,:,jpmxl_atf) + tmltrd_atf_sumb(:,:)
+         zsmlatf2(:,:) = zsmltrd2(:,:,jpmxl_atf) - smltrd_sum(:,:,jpmxl_atf) + smltrd_atf_sumb(:,:)
+
+         !-- Lateral boundary conditions
+         !         ... temperature ...                    ... salinity ...
+         CALL lbc_lnk( ztmltot2, 'T', 1. )  ;   CALL lbc_lnk( zsmltot2, 'T', 1. )
+         CALL lbc_lnk( ztmlres2, 'T', 1. )  ;   CALL lbc_lnk( zsmlres2, 'T', 1. )
+         DO jl = 1, jpltrd
+            CALL lbc_lnk( ztmltrd2(:,:,jl), 'T', 1. ) ! \  these will be output
+            CALL lbc_lnk( zsmltrd2(:,:,jl), 'T', 1. ) ! /  in the NetCDF trends file
+         END DO
+         
+         ! III.3 Time evolution array swap
+         ! -------------------------------
+         
+         ! For T/S instantaneous diagnostics 
+         !   ... temperature ...               ... salinity ...
+         tmlbb  (:,:) = tmlb   (:,:)  ;   smlbb  (:,:) = smlb   (:,:)
+         tmlbn  (:,:) = tml    (:,:)  ;   smlbn  (:,:) = sml    (:,:)
+         tmlatfb(:,:) = tmlatfn(:,:)  ;   smlatfb(:,:) = smlatfn(:,:)
+
+         ! For T mean diagnostics 
+         tmltrd_csum_ub (:,:,:) = zfn * tmltrd_sum(:,:,:) - tmltrd_csum_ln(:,:,:)
+         tml_sumb       (:,:)   = tml_sum(:,:)
+         tmltrd_atf_sumb(:,:)   = tmltrd_sum(:,:,jpmxl_atf)
+         
+         ! For S mean diagnostics 
+         smltrd_csum_ub (:,:,:) = zfn * smltrd_sum(:,:,:) - smltrd_csum_ln(:,:,:)
+         sml_sumb       (:,:)   = sml_sum(:,:)
+         smltrd_atf_sumb(:,:)   = smltrd_sum(:,:,jpmxl_atf)
+         
+         ! ML depth
+         hmxlbn         (:,:)   = hmxl    (:,:)
+         
+         IF( ln_ctl ) THEN
+            IF( ln_trdmxl_instant ) THEN
+               CALL prt_ctl(tab2d_1=tmlbb   , clinfo1=' tmlbb   -   : ', mask1=tmask, ovlap=1)
+               CALL prt_ctl(tab2d_1=tmlbn   , clinfo1=' tmlbn   -   : ', mask1=tmask, ovlap=1)
+               CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb -   : ', mask1=tmask, ovlap=1)
+            ELSE
+               CALL prt_ctl(tab2d_1=tmlbn          , clinfo1=' tmlbn           -  : ', mask1=tmask, ovlap=1)
+               CALL prt_ctl(tab2d_1=hmxlbn         , clinfo1=' hmxlbn          -  : ', mask1=tmask, ovlap=1)
+               CALL prt_ctl(tab2d_1=tml_sumb       , clinfo1=' tml_sumb        -  : ', mask1=tmask, ovlap=1)
+               CALL prt_ctl(tab2d_1=tmltrd_atf_sumb, clinfo1=' tmltrd_atf_sumb -  : ', mask1=tmask, ovlap=1)
+               CALL prt_ctl(tab3d_1=tmltrd_csum_ub , clinfo1=' tmltrd_csum_ub  -  : ', mask1=tmask, ovlap=1, kdim=1)
+            END IF
+         END IF
+
+         ! III.4 Convert to appropriate physical units
+         ! -------------------------------------------
+
+         !    ... temperature ...                         ... salinity ...
+         ztmltot (:,:)   = ztmltot(:,:)   * rn_ucf/zfn  ; zsmltot (:,:)   = zsmltot(:,:)   * rn_ucf/zfn
+         ztmlres (:,:)   = ztmlres(:,:)   * rn_ucf/zfn  ; zsmlres (:,:)   = zsmlres(:,:)   * rn_ucf/zfn
+         ztmlatf (:,:)   = ztmlatf(:,:)   * rn_ucf/zfn  ; zsmlatf (:,:)   = zsmlatf(:,:)   * rn_ucf/zfn
+
+         tml_sum (:,:)   = tml_sum (:,:)  /  (2*zfn) ; sml_sum (:,:)   = sml_sum (:,:)  /  (2*zfn)
+         ztmltot2(:,:)   = ztmltot2(:,:)  * rn_ucf/zfn2 ; zsmltot2(:,:)   = zsmltot2(:,:)  * rn_ucf/zfn2
+         ztmltrd2(:,:,:) = ztmltrd2(:,:,:)* rn_ucf/zfn2 ; zsmltrd2(:,:,:) = zsmltrd2(:,:,:)* rn_ucf/zfn2
+         ztmlatf2(:,:)   = ztmlatf2(:,:)  * rn_ucf/zfn2 ; zsmlatf2(:,:)   = zsmlatf2(:,:)  * rn_ucf/zfn2
+         ztmlres2(:,:)   = ztmlres2(:,:)  * rn_ucf/zfn2 ; zsmlres2(:,:)   = zsmlres2(:,:)  * rn_ucf/zfn2
+
+         hmxl_sum(:,:)   = hmxl_sum(:,:)  /  (2*zfn)  ! similar to tml_sum and sml_sum
+
+         ! * Debugging information *
+         IF( lldebug ) THEN
+            !
+            WRITE(numout,*)
+            WRITE(numout,*) 'trd_mxl : write trends in the Mixed Layer for debugging process:'
+            WRITE(numout,*) '~~~~~~~  '
+            WRITE(numout,*) '          TRA kt = ', kt, 'nmoymltrd = ', nmoymltrd
+            WRITE(numout,*)
+            WRITE(numout,*) '          >>>>>>>>>>>>>>>>>>  TRA TEMPERATURE <<<<<<<<<<<<<<<<<<'
+            WRITE(numout,*) '          TRA ztmlres    : ', SUM(ztmlres(:,:))
+            WRITE(numout,*) '          TRA ztmltot    : ', SUM(ztmltot(:,:))
+            WRITE(numout,*) '          TRA tmltrdm    : ', SUM(tmltrdm(:,:))
+            WRITE(numout,*) '          TRA tmlatfb    : ', SUM(tmlatfb(:,:))
+            WRITE(numout,*) '          TRA tmlatfn    : ', SUM(tmlatfn(:,:))
+            DO jl = 1, jpltrd
+               WRITE(numout,*) '          * TRA TREND INDEX jpmxl_xxx = jl = ', jl, &
+                    & ' tmltrd : ', SUM(tmltrd(:,:,jl))
+            END DO
+            WRITE(numout,*) '          TRA ztmlres (jpi/2,jpj/2) : ', ztmlres (jpi/2,jpj/2)
+            WRITE(numout,*) '          TRA ztmlres2(jpi/2,jpj/2) : ', ztmlres2(jpi/2,jpj/2)
+            WRITE(numout,*)
+            WRITE(numout,*) '          >>>>>>>>>>>>>>>>>>  TRA SALINITY <<<<<<<<<<<<<<<<<<'
+            WRITE(numout,*) '          TRA zsmlres    : ', SUM(zsmlres(:,:))
+            WRITE(numout,*) '          TRA zsmltot    : ', SUM(zsmltot(:,:))
+            WRITE(numout,*) '          TRA smltrdm    : ', SUM(smltrdm(:,:))
+            WRITE(numout,*) '          TRA smlatfb    : ', SUM(smlatfb(:,:))
+            WRITE(numout,*) '          TRA smlatfn    : ', SUM(smlatfn(:,:))
+            DO jl = 1, jpltrd
+               WRITE(numout,*) '          * TRA TREND INDEX jpmxl_xxx = jl = ', jl, &
+                    & ' smltrd : ', SUM(smltrd(:,:,jl))
+            END DO
+            WRITE(numout,*) '          TRA zsmlres (jpi/2,jpj/2) : ', zsmlres (jpi/2,jpj/2)
+            WRITE(numout,*) '          TRA zsmlres2(jpi/2,jpj/2) : ', zsmlres2(jpi/2,jpj/2)
+            !
+         END IF
+         !
+      END IF MODULO_NTRD
+
+      ! ======================================================================
+      ! IV. Write trends in the NetCDF file
+      ! ======================================================================
+
+      !-- Write the trends for T/S instantaneous diagnostics 
+      
+      IF( ln_trdmxl_instant ) THEN           
+
+         CALL iom_put( "mxl_depth", hmxl(:,:) )
+         
+         !................................. ( ML temperature ) ...................................
+         
+         !-- Output the fields
+         CALL iom_put( "tml"     , tml    (:,:) ) 
+         CALL iom_put( "tml_tot" , ztmltot(:,:) ) 
+         CALL iom_put( "tml_res" , ztmlres(:,:) ) 
+         
+         DO jl = 1, jpltrd - 1
+            CALL iom_put( trim("tml"//ctrd(jl,2)), tmltrd (:,:,jl) )
+         END DO
+         
+         CALL iom_put( trim("tml"//ctrd(jpmxl_atf,2)), ztmlatf(:,:) )
+         
+         !.................................. ( ML salinity ) .....................................
+         
+         !-- Output the fields
+         CALL iom_put( "sml"    , sml    (:,:) )
+         CALL iom_put( "sml_tot", zsmltot(:,:) ) 
+         CALL iom_put( "sml_res", zsmlres(:,:) ) 
+         
+         DO jl = 1, jpltrd - 1
+            CALL iom_put( trim("sml"//ctrd(jl,2)), smltrd(:,:,jl) )
+         END DO
+         
+         CALL iom_put( trim("sml"//ctrd(jpmxl_atf,2)), zsmlatf(:,:) )
+
+
+         
+      ELSE      !-- Write the trends for T/S mean diagnostics 
+
+         CALL iom_put( "mxl_depth", hmxl_sum(:,:) )
+         
+         !................................. ( ML temperature ) ...................................
+         
+         !-- Output the fields
+         CALL iom_put( "tml"     , tml_sum (:,:) ) 
+         CALL iom_put( "tml_tot" , ztmltot2(:,:) ) 
+         CALL iom_put( "tml_res" , ztmlres2(:,:) ) 
+
+         DO jl = 1, jpltrd - 1
+            CALL iom_put( trim("tml"//ctrd(jl,2)), ztmltrd2(:,:,jl) )
+         END DO
+         
+         CALL iom_put( trim("tml"//ctrd(jpmxl_atf,2)), ztmlatf2(:,:) )
+         
+         !.................................. ( ML salinity ) .....................................
+                     
+         !-- Output the fields
+         CALL iom_put( "sml"    , sml_sum (:,:) )
+         CALL iom_put( "sml_tot", zsmltot2(:,:) ) 
+         CALL iom_put( "sml_res", zsmlres2(:,:) ) 
+
+         DO jl = 1, jpltrd - 1
+            CALL iom_put( trim("sml"//ctrd(jl,2)), zsmltrd2(:,:,jl) )
+         END DO
+         
+         CALL iom_put( trim("sml"//ctrd(jpmxl_atf,2)), zsmlatf2(:,:) )
+         !
+      END IF
+      !
+
+      IF( MOD( itmod, nn_trd ) == 0 ) THEN
+         !
+         ! III.5 Reset cumulative arrays to zero
+         ! -------------------------------------
+         nmoymltrd = 0
+         
+         !   ... temperature ...               ... salinity ...
+         tmltrdm        (:,:)   = 0.e0   ;   smltrdm        (:,:)   = 0.e0
+         tmlatfm        (:,:)   = 0.e0   ;   smlatfm        (:,:)   = 0.e0
+         tml_sum        (:,:)   = 0.e0   ;   sml_sum        (:,:)   = 0.e0
+         tmltrd_csum_ln (:,:,:) = 0.e0   ;   smltrd_csum_ln (:,:,:) = 0.e0
+         tmltrd_sum     (:,:,:) = 0.e0   ;   smltrd_sum     (:,:,:) = 0.e0
+
+         hmxl_sum       (:,:)   = 0.e0
+         !
+      END IF
+
+      ! ======================================================================
+      ! V. Write restart file
+      ! ======================================================================
+
+      IF( lrst_oce )   CALL trd_mxl_rst_write( kt ) 
+
+      CALL wrk_dealloc( jpi, jpj,         ztmltot , zsmltot , ztmlres , zsmlres , ztmlatf , zsmlatf                        )
+      CALL wrk_dealloc( jpi, jpj,         ztmltot2, zsmltot2, ztmlres2, zsmlres2, ztmlatf2, zsmlatf2, ztmltrdm2, zsmltrdm2 )  
+      CALL wrk_dealloc( jpi, jpj, jpltrd, ztmltrd2, zsmltrd2                                                               )
+      !
+   END SUBROUTINE trd_mxl
+
+
+   SUBROUTINE trd_mxl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_init  ***
+      !! 
+      !! ** Purpose :   computation of vertically integrated T and S budgets
+      !!      from ocean surface down to control surface (NetCDF output)
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jl     ! dummy loop indices
+      INTEGER  ::   inum   ! logical unit
+      INTEGER  ::   ios    ! local integer
+      REAL(wp) ::   zjulian, zsto, zout
+      CHARACTER (LEN=40) ::   clop
+      CHARACTER (LEN=12) ::   clmxl, cltu, clsu
+      !!
+      NAMELIST/namtrd_mxl/ nn_trd , cn_trdrst_in , ln_trdmxl_restart,       &
+         &                 nn_ctls, cn_trdrst_out, ln_trdmxl_instant, rn_ucf, rn_rho_c
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namtrd_mxl in reference namelist : mixed layer trends diagnostic
+      READ  ( numnam_ref, namtrd_mxl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namtrd_mxl in configuration namelist : mixed layer trends diagnostic
+      READ  ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, namtrd_mxl )
+      !
+      IF(lwp) THEN                      ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mxl_init : Mixed-layer trends'
+         WRITE(numout,*) ' ~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrd : set trends parameters'
+         WRITE(numout,*) '      frequency of trends diagnostics (glo)      nn_trd             = ', nn_trd
+         WRITE(numout,*) '      density criteria used to defined the MLD   rn_rho_c           = ', rn_rho_c
+         WRITE(numout,*) '      control surface type            (mld)      nn_ctls            = ', nn_ctls
+         WRITE(numout,*) '      restart for ML diagnostics                 ln_trdmxl_restart  = ', ln_trdmxl_restart
+         WRITE(numout,*) '      instantaneous or mean ML T/S               ln_trdmxl_instant  = ', ln_trdmxl_instant
+         WRITE(numout,*) '      unit conversion factor                     rn_ucf             = ', rn_ucf
+         WRITE(numout,*) '      criteria to compute the MLD                rn_rho_c           = ', rn_rho_c
+      ENDIF
+
+
+
+      ! I.1 Check consistency of user defined preferences
+      ! -------------------------------------------------
+      
+      IF ( rn_rho_c /= rho_c )   CALL ctl_warn( 'Unless you have good reason to do so, you should use the value ',    &
+         &                                      'defined in zdfmxl.F90 module to calculate the mixed layer depth' )
+
+      IF( MOD( nitend, nn_trd ) /= 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, nn_trd   = ', nn_trd
+         WRITE(numout,*) '                This will not allow you to restart from this simulation.  '
+         WRITE(numout,*) '                You should reconsider this choice.                        ' 
+         WRITE(numout,*) 
+         WRITE(numout,*) '                N.B. the nitend parameter is also constrained to be a     '
+         WRITE(numout,*) '                     multiple of the nn_fsbc parameter '
+         nstop = nstop + 1
+      END IF
+
+      !                                   ! allocate trdmxl arrays
+      IF( trd_mxl_alloc()    /= 0 )   CALL ctl_stop( 'STOP', 'trd_mxl_init : unable to allocate trdmxl     arrays' )
+      IF( trdmxl_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_mxl_init : unable to allocate trdmxl_oce arrays' )
+
+
+
+      nkstp     = nit000 - 1              ! current time step indicator initialization
+
+
+
+
+      ! I.2 Initialize arrays to zero or read a restart file
+      ! ----------------------------------------------------
+
+      nmoymltrd = 0
+
+      !     ... temperature ...                  ... salinity ...
+      tml            (:,:)   = 0.e0    ;    sml            (:,:)   = 0.e0     ! inst.
+      tmltrdm        (:,:)   = 0.e0    ;    smltrdm        (:,:)   = 0.e0
+      tmlatfm        (:,:)   = 0.e0    ;    smlatfm        (:,:)   = 0.e0
+      tml_sum        (:,:)   = 0.e0    ;    sml_sum        (:,:)   = 0.e0     ! mean
+      tmltrd_sum     (:,:,:) = 0.e0    ;    smltrd_sum     (:,:,:) = 0.e0
+      tmltrd_csum_ln (:,:,:) = 0.e0    ;    smltrd_csum_ln (:,:,:) = 0.e0
+
+      hmxl           (:,:)   = 0.e0            
+      hmxl_sum       (:,:)   = 0.e0
+
+      IF( ln_rstart .AND. ln_trdmxl_restart ) THEN
+         CALL trd_mxl_rst_read
+      ELSE
+         !     ... temperature ...                  ... salinity ...
+         tmlb           (:,:)   = 0.e0    ;    smlb           (:,:)   = 0.e0  ! inst.
+         tmlbb          (:,:)   = 0.e0    ;    smlbb          (:,:)   = 0.e0  
+         tmlbn          (:,:)   = 0.e0    ;    smlbn          (:,:)   = 0.e0  
+         tml_sumb       (:,:)   = 0.e0    ;    sml_sumb       (:,:)   = 0.e0  ! mean
+         tmltrd_csum_ub (:,:,:) = 0.e0    ;    smltrd_csum_ub (:,:,:) = 0.e0
+         tmltrd_atf_sumb(:,:)   = 0.e0    ;    smltrd_atf_sumb(:,:)   = 0.e0  
+      END IF
+
+      icount = 1   ;   ionce  = 1                            ! open specifier
+
+      ! I.3 Read control surface from file ctlsurf_idx
+      ! ----------------------------------------------
+ 
+      IF( nn_ctls == 1 ) THEN
+         CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+         READ ( inum, * ) nbol
+         CLOSE( inum )
+      END IF
+
+      ! ======================================================================
+      ! II. netCDF output initialization
+      ! ======================================================================
+
+      ! clmxl = legend root for netCDF output
+      IF( nn_ctls == 0 ) THEN      ! control surface = mixed-layer with density criterion
+         clmxl = 'Mixed Layer '  !                   (array nmln computed in zdfmxl.F90)
+      ELSE IF( nn_ctls == 1 ) THEN ! control surface = read index from file 
+         clmxl = '      Bowl '
+      ELSE IF( nn_ctls >= 2 ) THEN ! control surface = model level
+         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nn_ctls
+      END IF
+
+
+
+      ! II.3 Define the T grid trend file (nidtrd)
+      ! ------------------------------------------
+      !-- Define long and short names for the NetCDF output variables
+      !       ==> choose them according to trdmxl_oce.F90 <==
+
+      ctrd(jpmxl_xad,1) = " Zonal advection"                  ;   ctrd(jpmxl_xad,2) = "_xad"
+      ctrd(jpmxl_yad,1) = " Meridional advection"             ;   ctrd(jpmxl_yad,2) = "_yad"
+      ctrd(jpmxl_zad,1) = " Vertical advection"               ;   ctrd(jpmxl_zad,2) = "_zad"
+      ctrd(jpmxl_ldf,1) = " Lateral diffusion"                ;   ctrd(jpmxl_ldf,2) = "_ldf"
+      ctrd(jpmxl_for,1) = " Forcing"                          ;   ctrd(jpmxl_for,2) = "_for"
+      ctrd(jpmxl_zdf,1) = " Vertical diff. (Kz)"              ;   ctrd(jpmxl_zdf,2) = "_zdf"
+      ctrd(jpmxl_bbc,1) = " Geothermal flux"                  ;   ctrd(jpmxl_bbc,2) = "_bbc"
+      ctrd(jpmxl_bbl,1) = " Adv/diff. Bottom boundary layer"  ;   ctrd(jpmxl_bbl,2) = "_bbl"
+      ctrd(jpmxl_dmp,1) = " Tracer damping"                   ;   ctrd(jpmxl_dmp,2) = "_dmp"
+      ctrd(jpmxl_npc,1) = " Non penetrative convec. adjust."  ;   ctrd(jpmxl_npc,2) = "_npc"
+      ctrd(jpmxl_atf,1) = " Asselin time filter"              ;   ctrd(jpmxl_atf,2) = "_atf"
+                                                                  
+
+      !-- Define physical units
+      IF     ( rn_ucf == 1.       ) THEN   ;   cltu = "degC/s"     ;   clsu = "p.s.u./s"
+      ELSEIF ( rn_ucf == 3600.*24.) THEN   ;   cltu = "degC/day"   ;   clsu = "p.s.u./day"
+      ELSE                                 ;   cltu = "unknown?"   ;   clsu = "unknown?"
+      END IF
+      !
+   END SUBROUTINE trd_mxl_init
+
+   !!======================================================================
+END MODULE trdmxl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90	(revision 8732)
@@ -0,0 +1,135 @@
+MODULE trdmxl_oce
+   !!======================================================================
+   !!                   ***  MODULE trdmxl_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+   !! History :  1.0  ! 2004-08  (C. Talandier)  New trends organization
+   !!            3.5  ! 2012-02  (G. Madec) suppress the trend keys + new trdmxl formulation
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trdmxl_oce_alloc    ! Called in trdmxl.F90
+
+   !                                                !* mixed layer trend indices
+   INTEGER, PUBLIC, PARAMETER ::   jpltrd = 12      !: number of mixed-layer trends arrays
+   INTEGER, PUBLIC            ::   jpktrd           !: max level for mixed-layer trends diag.
+   !
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_xad =  1   !: i-componant of advection   
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_yad =  2   !: j-componant of advection
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_zad =  3   !: k-component of advection 
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_ldf =  4   !: lateral diffusion (geopot. or iso-neutral)
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_zdf =  5   !: vertical diffusion  
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_npc =  6   !: non penetrative convective adjustment
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_bbc =  7   !: geothermal flux
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_bbl =  8   !: bottom boundary layer (advective/diffusive)
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_for =  9   !: forcing 
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_dmp = 10   !: internal restoring trend
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_zdfp = 11  !: ! iso-neutral diffusion:"pure" vertical diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jpmxl_atf  = 12  !: asselin trend (**MUST BE THE LAST ONE**)
+   !                                                            !!* Namelist namtrd_mxl:  trend diagnostics in the mixed layer *
+   INTEGER           , PUBLIC ::   nn_ctls  = 0                  !: control surface type for trends vertical integration
+   REAL(wp)          , PUBLIC ::   rn_rho_c = 0.01               !: density criteria for MLD definition
+   REAL(wp)          , PUBLIC ::   rn_ucf   = 1.                 !: unit conversion factor (for netCDF trends outputs)
+                                                                 !  =1. (=86400.) for degC/s (degC/day) and psu/s (psu/day)
+   CHARACTER(len=32), PUBLIC ::   cn_trdrst_in  = "restart_mxl"  !: suffix of ocean restart name (input)
+   CHARACTER(len=32), PUBLIC ::   cn_trdrst_out = "restart_mxl"  !: suffix of ocean restart name (output)
+   LOGICAL          , PUBLIC ::   ln_trdmxl_instant = .FALSE.    !: flag to diagnose inst./mean ML T/S trends
+   LOGICAL          , PUBLIC ::   ln_trdmxl_restart = .FALSE.    !: flag to restart mixed-layer diagnostics
+
+
+   !! Arrays used for diagnosing mixed-layer trends 
+   !!---------------------------------------------------------------------
+   CHARACTER(LEN=80) , PUBLIC :: clname, ctrd(jpltrd+1,2)
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nmxl   !: mixed layer depth indexes 
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nbol   !: mixed-layer depth indexes when read from file
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wkx    !:
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  &
+      hmxl   ,                      & !: mixed layer depth (m) corresponding to nmld
+      tml    , sml  ,               & !: \ "now" mixed layer temperature/salinity
+      tmlb   , smlb ,               & !: /  and associated "before" fields
+      tmlbb  , smlbb,               & !: \  idem, but valid at the 1rst time step of the
+      tmlbn  , smlbn,               & !: /  current analysis window
+      tmltrdm, smltrdm,             & !: total cumulative trends over the analysis window
+      tml_sum,                      & !: mixed layer T, summed over the current analysis period
+      tml_sumb,                     & !: idem, but from the previous analysis period
+      tmltrd_atf_sumb,              & !: Asselin trends, summed over the previous analysis period
+      sml_sum,                      & !: 
+      sml_sumb,                     & !:    ( idem for salinity )
+      smltrd_atf_sumb,              & !: 
+      hmxl_sum, hmxlbn                !: needed to compute the leap-frog time mean of the ML depth
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  &
+      tmlatfb, tmlatfn ,            & !: "before" Asselin contribution at begining of the averaging
+      smlatfb, smlatfn,             & !: period (i.e. last contrib. from previous such period) and 
+                                      !: "now" Asselin contribution to the ML temp. & salinity trends
+      tmlatfm, smlatfm                !: accumulator for Asselin trends (needed for storage only)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::  &
+      tmltrd,                       & !: \ physical contributions to the total trend (for T/S),
+      smltrd,                       & !: / cumulated over the current analysis window
+      tmltrd_sum,                   & !: sum of these trends over the analysis period
+      tmltrd_csum_ln,               & !: now cumulated sum of the trends over the "lower triangle"
+      tmltrd_csum_ub,               & !: before (prev. analysis period) cumulated sum over the upper triangle
+      smltrd_sum,                   & !: 
+      smltrd_csum_ln,               & !:    ( idem for salinity )
+      smltrd_csum_ub                  !: 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  INTEGER FUNCTION trdmxl_oce_alloc()
+     !!----------------------------------------------------------------------
+     !!                 ***  FUNCTION trdmxl_oce_alloc   ***
+     !!----------------------------------------------------------------------
+     USE lib_mpp
+     INTEGER :: ierr(5)
+     !!----------------------------------------------------------------------
+
+     ! Initialise jpktrd here as can no longer do it in MODULE body since
+     ! jpk is now a variable.
+     jpktrd = jpk   !: max level for mixed-layer trends diag.
+
+     ierr(:) = 0
+
+     ALLOCATE( nmxl (jpi,jpj)    , nbol (jpi,jpj),    &
+        &      wkx  (jpi,jpj,jpk), hmxl (jpi,jpj),    & 
+        &      tml  (jpi,jpj)    , sml  (jpi,jpj),    & 
+        &      tmlb (jpi,jpj)    , smlb (jpi,jpj),    &
+        &      tmlbb(jpi,jpj)    , smlbb(jpi,jpj), STAT = ierr(1) )
+
+     ALLOCATE( tmlbn(jpi,jpj)  , smlbn(jpi,jpj),   &
+        &      tmltrdm(jpi,jpj), smltrdm(jpi,jpj), &
+        &      tml_sum(jpi,jpj), tml_sumb(jpi,jpj),&
+        &      tmltrd_atf_sumb(jpi,jpj)           , STAT=ierr(2) )
+
+     ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), &
+        &      smltrd_atf_sumb(jpi,jpj),            &
+        &      hmxl_sum(jpi,jpj), hmxlbn(jpi,jpj),  &
+        &      tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), STAT = ierr(3) )
+
+     ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), & 
+        &      tmlatfm(jpi,jpj), smlatfm(jpi,jpj), &
+        &      tmltrd(jpi,jpj,jpltrd),   smltrd(jpi,jpj,jpltrd), STAT=ierr(4))
+
+     ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd),      &
+        &      tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd),     &
+        &      smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), STAT=ierr(5) )
+      !
+      trdmxl_oce_alloc = MAXVAL( ierr )
+      IF( lk_mpp                )   CALL mpp_sum ( trdmxl_oce_alloc )
+      IF( trdmxl_oce_alloc /= 0 )   CALL ctl_warn('trdmxl_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trdmxl_oce_alloc
+
+   !!======================================================================
+END MODULE trdmxl_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90	(revision 8732)
@@ -0,0 +1,191 @@
+MODULE trdmxl_rst
+   !!=================================================================================
+   !!                       ***  MODULE  trdmxl_rst  ***
+   !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
+   !!=================================================================================
+   !! History :  1.0  ! 2005-05 (C. Deltel)  Original code
+   !!---------------------------------------------------------------------------------
+
+   !!---------------------------------------------------------------------------------
+   !!  trd_mxl_rst_write : write mixed layer trend restart
+   !!  trd_mxl_rst_read  : read  mixed layer trend restart
+   !!---------------------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE trd_oce         ! trends: ocean variables
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE restart         ! only for lrst_oce
+
+   IMPLICIT NONE
+   PRIVATE
+  
+   PUBLIC   trd_mxl_rst_read    ! routine called by trd_mxl_init
+   PUBLIC   trd_mxl_rst_write   ! routine called by step.F90
+  
+   INTEGER ::   nummxlw         ! logical unit for mxl restart
+
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE trd_mxl_rst_write( kt )
+      !!--------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE trd_mxl_rst_wri  ***
+      !!                
+      !! ** Purpose :   Write mixed-layer diagnostics restart fields.
+      !!--------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      CHARACTER (len=35) :: charout
+      INTEGER ::   jk                 ! loop indice
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(LEN=50)   ::   clname   ! output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
+      !!--------------------------------------------------------------------------------
+
+      ! to get better performances with NetCDF format:
+      ! we open and define the ocean restart_mxl file one time step before writing the data (-> at nitrst - 1)
+      ! except if we write ocean restart_mxl files every time step or if an ocean restart_mxl file was writen at nitend - 1
+      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. MOD( nitend - 1, nstock ) == 0 ) ) THEN
+         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+         IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+         ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+         ENDIF
+         ! create the file
+         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_out)
+         clpath = TRIM(cn_ocerst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) THEN
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart_mxl NetCDF file: '//clname
+            END SELECT
+            IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt,' date= ', ndastp
+            ELSE                          ;   WRITE(numout,*) '             kt = '             , kt,' date= ', ndastp
+            ENDIF
+         ENDIF
+
+         CALL iom_open( TRIM(clpath)//TRIM(clname), nummxlw, ldwrt = .TRUE., kiolib = jprstlib )
+      ENDIF
+
+      IF( kt == nitrst .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trdmxl_rst: output for ML diags. restart, with trd_mxl_rst_write routine kt =', kt
+         WRITE(numout,*) '~~~~~~~~~~'
+         WRITE(numout,*)
+      ENDIF
+
+      IF( ln_trdmxl_instant ) THEN 
+         !-- Temperature
+         CALL iom_rstput( kt, nitrst, nummxlw, 'tmlbb'           , tmlbb           )
+         CALL iom_rstput( kt, nitrst, nummxlw, 'tmlbn'           , tmlbn           )
+         CALL iom_rstput( kt, nitrst, nummxlw, 'tmlatfb'         , tmlatfb         )
+
+         !-- Salinity
+         CALL iom_rstput( kt, nitrst, nummxlw, 'smlbb'           , smlbb           )
+         CALL iom_rstput( kt, nitrst, nummxlw, 'smlbn'           , smlbn           )
+         CALL iom_rstput( kt, nitrst, nummxlw, 'smlatfb'         , smlatfb         )
+      ELSE
+         CALL iom_rstput( kt, nitrst, nummxlw, 'hmxlbn'          , hmxlbn          )
+
+         !-- Temperature
+         CALL iom_rstput( kt, nitrst, nummxlw, 'tmlbn'           , tmlbn           )
+         CALL iom_rstput( kt, nitrst, nummxlw, 'tml_sumb'        , tml_sumb        )
+         DO jk = 1, jpltrd
+            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I1)")   jk
+            ELSE                 ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I2)")   jk
+            ENDIF
+            CALL iom_rstput( kt, nitrst, nummxlw, charout,  tmltrd_csum_ub(:,:,jk) )
+         ENDDO
+         CALL iom_rstput( kt, nitrst, nummxlw, 'tmltrd_atf_sumb' , tmltrd_atf_sumb )
+
+         !-- Salinity
+         CALL iom_rstput( kt, nitrst, nummxlw, 'smlbn'           , smlbn           )
+         CALL iom_rstput( kt, nitrst, nummxlw, 'sml_sumb'        , sml_sumb        )
+         DO jk = 1, jpltrd
+            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('smltrd_csum_ub_', I1)")   jk
+            ELSE                 ;   WRITE(charout,FMT="('smltrd_csum_ub_', I2)")   jk
+            ENDIF
+            CALL iom_rstput( kt, nitrst, nummxlw, charout , smltrd_csum_ub(:,:,jk) )
+         ENDDO
+         CALL iom_rstput( kt, nitrst, nummxlw, 'smltrd_atf_sumb' , smltrd_atf_sumb )
+      ENDIF
+      !
+      IF( kt == nitrst ) THEN
+         CALL iom_close( nummxlw )     ! close the restart file (only at last time step)
+         lrst_oce = .FALSE.
+      ENDIF
+      ! 
+   END SUBROUTINE trd_mxl_rst_write
+
+
+   SUBROUTINE trd_mxl_rst_read
+      !!----------------------------------------------------------------------------
+      !!                   ***  SUBROUTINE trd_mxl_rst_lec  ***
+      !!                   
+      !! ** Purpose :   Read file for mixed-layer diagnostics restart.
+      !!----------------------------------------------------------------------------
+      INTEGER  ::  inum       ! temporary logical unit
+      !
+      CHARACTER (len=35) :: charout
+      INTEGER ::   jk         ! loop indice
+      INTEGER ::   jlibalt = jprstlib
+      LOGICAL ::   llok
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
+      !!-----------------------------------------------------------------------------
+
+      IF(lwp)  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mxl_rst_read : read the NetCDF mixed layer trend restart file'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
+      ENDIF
+
+      clpath = TRIM(cn_ocerst_indir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt ) 
+
+      IF( ln_trdmxl_instant ) THEN 
+         !-- Temperature
+         CALL iom_get( inum, jpdom_autoglo, 'tmlbb'           , tmlbb          )
+         CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          )
+         CALL iom_get( inum, jpdom_autoglo, 'tmlatfb'         , tmlatfb        )
+         !
+         !-- Salinity
+         CALL iom_get( inum, jpdom_autoglo, 'smlbb'           , smlbb          )
+         CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          )
+         CALL iom_get( inum, jpdom_autoglo, 'smlatfb'         , smlatfb        )
+      ELSE
+         CALL iom_get( inum, jpdom_autoglo, 'hmxlbn'          , hmxlbn         ) ! needed for hmxl_sum
+         !
+         !-- Temperature
+         CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) ! needed for tml_sum
+         CALL iom_get( inum, jpdom_autoglo, 'tml_sumb'        , tml_sumb       )
+         DO jk = 1, jpltrd
+            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I1)")   jk
+            ELSE                 ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I2)")   jk
+            ENDIF
+            CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub(:,:,jk) )
+         END DO
+         CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb' , tmltrd_atf_sumb)
+         !
+         !-- Salinity
+         CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) ! needed for sml_sum
+         CALL iom_get( inum, jpdom_autoglo, 'sml_sumb'        , sml_sumb       )
+         DO jk = 1, jpltrd
+            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('smltrd_csum_ub_', I1)")   jk
+            ELSE                 ;   WRITE(charout,FMT="('smltrd_csum_ub_', I2)")   jk
+            ENDIF
+            CALL iom_get( inum, jpdom_autoglo, charout, smltrd_csum_ub(:,:,jk) )
+         END DO
+         CALL iom_get( inum, jpdom_autoglo, 'smltrd_atf_sumb' , smltrd_atf_sumb)
+         !
+         CALL iom_close( inum )
+      ENDIF
+      !
+   END SUBROUTINE trd_mxl_rst_read
+  
+  !!=================================================================================
+END MODULE trdmxl_rst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90	(revision 8732)
@@ -0,0 +1,159 @@
+MODULE trdpen
+   !!======================================================================
+   !!                       ***  MODULE  trdpen  ***
+   !! Ocean diagnostics:  Potential Energy trends
+   !!=====================================================================
+   !! History :  3.5  !  2012-02  (G. Madec) original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_pen       : compute and output Potential Energy trends from T & S trends
+   !!   trd_pen_init  : initialisation of PE trends
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean domain 
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE zdf_oce        ! ocean vertical physics
+   USE trd_oce        ! trends: ocean variables
+   USE eosbn2         ! equation of state and related derivatives
+   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
+   USE zdfddm         ! vertical physics: double diffusion
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_pen        ! called by all trdtra module
+   PUBLIC   trd_pen_init   ! called by all nemogcm module
+
+   INTEGER ::   nkstp   ! current time step 
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_pe   ! partial derivatives of PE anomaly with respect to T and S
+
+   !! * Substitutions
+#  include "zdfddm_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
+
+   INTEGER FUNCTION trd_pen_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION trd_tra_alloc  ***
+      !!---------------------------------------------------------------------
+      ALLOCATE( rab_pe(jpi,jpj,jpk,jpts) , STAT= trd_pen_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_pen_alloc )
+      IF( trd_pen_alloc /= 0 )   CALL ctl_warn( 'trd_pen_alloc: failed to allocate arrays' )
+   END FUNCTION trd_pen_alloc
+
+
+   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_mng  ***
+      !! 
+      !! ** Purpose :   Dispatch all trends computation, e.g. 3D output, integral
+      !!                constraints, barotropic vorticity, kinetic enrgy, 
+      !!                potential energy, and/or mixed layer budget.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   ptrdx, ptrdy   ! Temperature & Salinity trends
+      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index
+      INTEGER                   , INTENT(in) ::   kt             ! time step index
+      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s]
+      !
+      INTEGER ::   jk                                            ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   z2d            ! 2D workspace 
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zpe            ! 3D workspace 
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zpe )
+      zpe(:,:,:) = 0._wp
+      !
+      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step
+         nkstp = kt
+         CALL eos_pen( tsn, rab_PE, zpe )
+         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
+         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
+         CALL iom_put( "PEanom" , zpe )
+      ENDIF
+      !
+      zpe(:,:,jpk) = 0._wp
+      DO jk = 1, jpkm1
+         zpe(:,:,jk) = ( - ( rab_n(:,:,jk,jp_tem) + rab_pe(:,:,jk,jp_tem) ) * ptrdx(:,:,jk)   &
+            &            + ( rab_n(:,:,jk,jp_sal) + rab_pe(:,:,jk,jp_sal) ) * ptrdy(:,:,jk)  )
+      END DO
+
+      SELECT CASE ( ktrd )
+      CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zpe )   ! zonal    advection
+      CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection
+      CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection
+                                IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
+                                   CALL wrk_alloc( jpi, jpj, z2d )
+                                   z2d(:,:) = wn(:,:,1) * ( &
+                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    &
+                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    &
+                                     & ) / e3t_n(:,:,1)
+                                   CALL iom_put( "petrd_sad" , z2d )
+                                   CALL wrk_dealloc( jpi, jpj, z2d )
+                                ENDIF
+      CASE ( jptra_ldf  )   ;   CALL iom_put( "petrd_ldf" , zpe )   ! lateral  diffusion
+      CASE ( jptra_zdf  )   ;   CALL iom_put( "petrd_zdf" , zpe )   ! lateral  diffusion (K_z)
+      CASE ( jptra_zdfp )   ;   CALL iom_put( "petrd_zdfp", zpe )   ! vertical diffusion (K_z)
+      CASE ( jptra_dmp  )   ;   CALL iom_put( "petrd_dmp" , zpe )   ! internal 3D restoring (tradmp)
+      CASE ( jptra_bbl  )   ;   CALL iom_put( "petrd_bbl" , zpe )   ! bottom boundary layer
+      CASE ( jptra_npc  )   ;   CALL iom_put( "petrd_npc" , zpe )   ! non penetr convect adjustment
+      CASE ( jptra_nsr  )   ;   CALL iom_put( "petrd_nsr" , zpe )   ! surface forcing + runoff (ln_rnf=T)
+      CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zpe )   ! air-sea : penetrative sol radiat
+      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux)
+      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend)
+                                !IF( ln_linssh ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation)
+                                !   CALL wrk_alloc( jpi, jpj, z2d )
+                                !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 &
+                                !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    &
+                                !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( e3t_n(:,:,1) * pdt )
+                                !   CALL iom_put( "petrd_sad" , z2d )
+                                !   CALL wrk_dealloc( jpi, jpj, z2d )
+                                !ENDIF
+         !
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zpe )
+      !
+   END SUBROUTINE trd_pen
+
+
+   SUBROUTINE trd_pen_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_pen_init  ***
+      !! 
+      !! ** Purpose :   initialisation of 3D Kinetic Energy trend diagnostic
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_pen_init : 3D Potential ENergy trends'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !                           ! allocate box volume arrays
+      IF ( trd_pen_alloc() /= 0 )   CALL ctl_stop('trd_pen_alloc: failed to allocate arrays')
+      !
+      rab_pe(:,:,:,:) = 0._wp
+      !
+      IF( .NOT.ln_linssh )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')
+      !
+      nkstp     = nit000 - 1
+      !
+   END SUBROUTINE trd_pen_init
+
+   !!======================================================================
+END MODULE trdpen
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 8732)
@@ -0,0 +1,357 @@
+MODULE trdtra
+   !!======================================================================
+   !!                       ***  MODULE  trdtra  ***
+   !! Ocean diagnostics:  ocean tracers trends pre-processing
+   !!=====================================================================
+   !! History :  3.3  !  2010-06  (C. Ethe) creation for the TRA/TRC merge
+   !!            3.5  !  2012-02  (G. Madec) update the comments 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_tra       : pre-process the tracer trends
+   !!   trd_tra_adv   : transform a div(U.T) trend into a U.grad(T) trend
+   !!   trd_tra_mng   : tracer trend manager: dispatch to the diagnostic modules
+   !!   trd_tra_iom   : output 3D tracer trends using IOM
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean domain 
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE zdf_oce        ! ocean vertical physics
+   USE trd_oce        ! trends: ocean variables
+   USE trdtrc         ! ocean passive mixed layer tracers trends 
+   USE trdglo         ! trends: global domain averaged
+   USE trdpen         ! trends: Potential ENergy
+   USE trdmxl         ! ocean active mixed layer tracers trends 
+   USE ldftra         ! ocean active tracers lateral physics
+   USE ldfslp
+   USE zdfddm         ! vertical physics: double diffusion
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_tra   ! called by all tra_... modules
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_evd  ! store avt_evd to calculate EVD trend
+
+   !! * Substitutions
+#  include "zdfddm_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
+
+   INTEGER FUNCTION trd_tra_alloc()
+      !!---------------------------------------------------------------------
+      !!                  ***  FUNCTION trd_tra_alloc  ***
+      !!---------------------------------------------------------------------
+      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc )
+      IF( trd_tra_alloc /= 0 )   CALL ctl_warn('trd_tra_alloc: failed to allocate arrays')
+   END FUNCTION trd_tra_alloc
+
+
+   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra  ***
+      !! 
+      !! ** Purpose : pre-process tracer trends
+      !!
+      !! ** Method  : - mask the trend
+      !!              - advection (ptra present) converte the incoming flux (U.T) 
+      !!              into trend (U.T => -U.grat(T)=div(U.T)-T.div(U)) through a 
+      !!              call to trd_tra_adv
+      !!              - 'TRA' case : regroup T & S trends
+      !!              - send the trends to trd_tra_mng (trdtrc) for further processing
+      !!----------------------------------------------------------------------
+      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     ! now velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable
+      !
+      INTEGER  ::   jk   ! loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:)  ::   zwt, zws, ztrdt, ztrds   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, ztrds )
+      !      
+      IF( .NOT. ALLOCATED( trdtx ) ) THEN      ! allocate trdtra arrays
+         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' )
+      ENDIF
+
+      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==!
+         !
+         SELECT CASE( ktrd )
+         !                            ! advection: transform the advective flux into a trend
+         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
+         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
+         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
+         CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng
+            &  jptra_qsr )   ;   trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
+                                 ztrds(:,:,:) = 0._wp
+                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )
+         CASE DEFAULT                 ! other trends: masked trends
+            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)              ! mask & store
+         END SELECT
+         !
+      ENDIF
+
+      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==!
+         !
+         SELECT CASE( ktrd )
+         !                            ! advection: transform the advective flux into a trend
+         !                            !            and send T & S trends to trd_tra_mng
+         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds ) 
+                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   )
+         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds ) 
+                                  CALL trd_tra_mng( trdty, ztrds, ktrd, kt   )
+         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds ) 
+                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt   )
+         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap)
+            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE"
+            CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt )
+            !
+            zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes
+            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp
+            DO jk = 2, jpk
+               zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+            END DO
+            !
+            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1
+               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk)
+               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 
+            END DO
+            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )  
+            !
+            !                         ! Also calculate EVD trend at this point. 
+            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes
+            DO jk = 2, jpk
+               zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+               zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)
+            END DO
+            !
+            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1
+               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t_n(:,:,jk)
+               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t_n(:,:,jk) 
+            END DO
+            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )  
+            !
+            CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt )
+            !
+         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng
+            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
+            CALL trd_tra_mng( trdt, ztrds, ktrd, kt )  
+         END SELECT
+      ENDIF
+
+      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==!
+         !
+         SELECT CASE( ktrd )
+         !                            ! advection: transform the advective flux into a masked trend
+         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds ) 
+         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 
+         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 
+         CASE DEFAULT                 ! other trends: just masked 
+                                 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)
+         END SELECT
+         !                            ! send trend to trd_trc
+         CALL trd_trc( ztrds, ktra, ktrd, kt ) 
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, ztrds )
+      !
+   END SUBROUTINE trd_tra
+
+
+   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_adv  ***
+      !! 
+      !! ** Purpose :   transformed a advective flux into a masked advective trends
+      !!
+      !! ** Method  :   use the following transformation: -div(U.T) = - U grad(T) + T.div(U)
+      !!       i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
+      !!       j-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] )
+      !!                where fi is the incoming advective flux.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pf      ! advective flux in one direction
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pun     ! now velocity   in one direction
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptn     ! now or before tracer 
+      CHARACTER(len=1)                , INTENT(in   ) ::   cdir    ! X/Y/Z direction
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   ptrd    ! advective trend in one direction
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ii, ij, ik   ! index shift as function of the direction
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE( cdir )      ! shift depending on the direction
+      CASE( 'X' )   ;   ii = 1   ;   ij = 0   ;   ik = 0      ! i-trend
+      CASE( 'Y' )   ;   ii = 0   ;   ij = 1   ;   ik = 0      ! j-trend
+      CASE( 'Z' )   ;   ii = 0   ;   ij = 0   ;   ik =-1      ! k-trend
+      END SELECT
+      !
+      !                        ! set to zero uncomputed values
+      ptrd(jpi,:,:) = 0._wp   ;   ptrd(1,:,:) = 0._wp
+      ptrd(:,jpj,:) = 0._wp   ;   ptrd(:,1,:) = 0._wp
+      ptrd(:,:,jpk) = 0._wp
+      !
+      DO jk = 1, jpkm1         ! advective trend
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        &
+                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   &
+                 &              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE trd_tra_adv
+
+
+   SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_mng  ***
+      !! 
+      !! ** Purpose :   Dispatch all tracer trends computation, e.g. 3D output,
+      !!                integral constraints, potential energy, and/or 
+      !!                mixed layer budget.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step
+      !!----------------------------------------------------------------------
+
+      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdt (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdt (leapfrog)
+      ENDIF
+
+      !                   ! 3D output of tracers trends using IOM interface
+      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )
+
+      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )
+
+      !                   ! Potential ENergy trends
+      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt )
+
+      !                   ! Mixed layer trends for active tracers
+      IF( ln_tra_mxl )   THEN   
+         !-----------------------------------------------------------------------------------------------
+         ! W.A.R.N.I.N.G :
+         ! jptra_ldf : called by traldf.F90
+         !                 at this stage we store:
+         !                  - the lateral geopotential diffusion (here, lateral = horizontal)
+         !                  - and the iso-neutral diffusion if activated 
+         ! jptra_zdf : called by trazdf.F90
+         !                 * in case of iso-neutral diffusion we store the vertical diffusion component in the 
+         !                   lateral trend including the K_z contrib, which will be removed later (see trd_mxl)
+         !-----------------------------------------------------------------------------------------------
+
+         SELECT CASE ( ktrd )
+         CASE ( jptra_xad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_xad, '3D' )   ! zonal    advection
+         CASE ( jptra_yad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_yad, '3D' )   ! merid.   advection
+         CASE ( jptra_zad )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zad, '3D' )   ! vertical advection
+         CASE ( jptra_ldf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion
+         CASE ( jptra_bbl )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbl, '3D' )   ! bottom boundary layer
+         CASE ( jptra_zdf )
+            IF( ln_traldf_iso ) THEN ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' )   ! lateral  diffusion (K_z)
+            ELSE                   ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zdf, '3D' )   ! vertical diffusion (K_z)
+            ENDIF
+         CASE ( jptra_dmp )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_dmp, '3D' )   ! internal 3D restoring (tradmp)
+         CASE ( jptra_qsr )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '3D' )   ! air-sea : penetrative sol radiat
+         CASE ( jptra_nsr )        ;   ptrdx(:,:,2:jpk) = 0._wp   ;   ptrdy(:,:,2:jpk) = 0._wp
+                                       CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '2D' )   ! air-sea : non penetr sol radiation
+         CASE ( jptra_bbc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbc, '3D' )   ! bottom bound cond (geoth flux)
+         CASE ( jptra_npc )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_npc, '3D' )   ! non penetr convect adjustment
+         CASE ( jptra_atf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' )   ! asselin time filter (last trend)
+                                   !
+                                       CALL trd_mxl( kt, r2dt )                             ! trends: Mixed-layer (output)
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE trd_tra_mng
+
+
+   SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_iom  ***
+      !! 
+      !! ** Purpose :   output 3D tracer trends using IOM
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step
+      !!
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikbu, ikbv   ! local integers
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace 
+      !!----------------------------------------------------------------------
+      !
+!!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added
+      !
+      SELECT CASE( ktrd )
+      CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection
+                               CALL iom_put( "strd_xad" , ptrdy )
+      CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection
+                               CALL iom_put( "strd_yad" , ptrdy )
+      CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection
+                               CALL iom_put( "strd_zad" , ptrdy )
+                               IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface
+                               	 CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
+                                  z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1)
+                                  z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1)
+                                  CALL iom_put( "ttrd_sad", z2dx )
+                                  CALL iom_put( "strd_sad", z2dy )
+                                  CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )
+                               ENDIF
+      CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )      ! total   advection
+                               CALL iom_put( "strd_totad" , ptrdy )
+      CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion
+                               CALL iom_put( "strd_ldf" , ptrdy )
+      CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution)
+                               CALL iom_put( "strd_zdf" , ptrdy )
+      CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution)
+                               CALL iom_put( "strd_zdfp", ptrdy )
+      CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection)
+                               CALL iom_put( "strd_evd", ptrdy )
+      CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping)
+                               CALL iom_put( "strd_dmp" , ptrdy )
+      CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer
+                               CALL iom_put( "strd_bbl" , ptrdy )
+      CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing
+                               CALL iom_put( "strd_npc" , ptrdy )
+      CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) )        ! surface forcing + runoff (ln_rnf=T)
+                               CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields
+      CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature)
+      CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature)
+      CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter
+                               CALL iom_put( "strd_atf" , ptrdy )
+      CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )        ! model total trend
+                               CALL iom_put( "strd_tot" , ptrdy )
+      END SELECT
+      !
+   END SUBROUTINE trd_tra_iom
+
+   !!======================================================================
+END MODULE trdtra
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90	(revision 8732)
@@ -0,0 +1,23 @@
+MODULE trdtrc
+   !!======================================================================
+   !!                       ***  MODULE trdtrc  ***
+   !!  Dummy module
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                             NO TOP use
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )
+      INTEGER ::   kt, kjn, ktrd   
+      REAL    ::   ptrtrd(:,:,:)  
+      WRITE(*,*) 'trd_trc : 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_trc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trdtrc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 8732)
@@ -0,0 +1,589 @@
+MODULE trdvor
+   !!======================================================================
+   !!                       ***  MODULE  trdvor  ***
+   !! Ocean diagnostics:  momentum trends
+   !!=====================================================================
+   !! History :  1.0  !  2006-01  (L. Brunier, A-M. Treguier) Original code 
+   !!            2.0  !  2008-04  (C. Talandier) New trends organization
+   !!            3.5  !  2012-02  (G. Madec) regroup beta.V computation with pvo trend
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_vor      : momentum trends averaged over the depth
+   !!   trd_vor_zint : vorticity vertical integration
+   !!   trd_vor_init : initialization step
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trd_oce         ! trends: ocean variables
+   USE zdf_oce         ! ocean vertical physics
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE phycst          ! Define parameters for the routines
+   USE ldfdyn          ! ocean active tracers: lateral physics
+   USE dianam          ! build the name of file (routine)
+   USE zdfmxl          ! mixed layer depth
+   !
+   USE in_out_manager  ! I/O manager
+   USE ioipsl          ! NetCDF library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE trd_vor_zint
+      MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
+   END INTERFACE
+
+   PUBLIC   trd_vor        ! routine called by trddyn.F90
+   PUBLIC   trd_vor_init   ! routine called by opa.F90
+   PUBLIC   trd_vor_alloc  ! routine called by nemogcm.F90
+
+   INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount   ! needs for IOIPSL output
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) ::   ndexvor1   ! needed for IOIPSL output
+   INTEGER ::   ndebug     ! (0/1) set it to 1 in case of problem to have more print
+
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avr      ! average
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrb     ! before vorticity (kt-1)
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbn    ! after vorticity at time step after the
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rotot        ! begining of the NWRITE-1 timesteps
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrtot   !
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrres   !
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd       ! curl of trends
+         
+   CHARACTER(len=12) ::   cvort
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_vor_alloc()
+      !!----------------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor_alloc  ***
+      !!----------------------------------------------------------------------------
+      ALLOCATE( vor_avr   (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) ,   &
+         &      vor_avrbn (jpi,jpj) , rotot   (jpi,jpj) , vor_avrtot(jpi,jpj) ,   &
+         &      vor_avrres(jpi,jpj) , vortrd  (jpi,jpj,jpltot_vor) ,              &
+         &      ndexvor1  (jpi*jpj)                                ,   STAT= trd_vor_alloc )
+         !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_vor_alloc )
+      IF( trd_vor_alloc /= 0 )   CALL ctl_warn('trd_vor_alloc: failed to allocate arrays')
+   END FUNCTION trd_vor_alloc
+
+
+   SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor  ***
+      !! 
+      !! ** Purpose :  computation of cumulated trends over analysis period
+      !!               and make outputs (NetCDF format)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends 
+      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
+      INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztswu, ztswv    ! 2D workspace 
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, ztswu, ztswv )
+
+      SELECT CASE( ktrd ) 
+      CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg )   ! Hydrostatique Pressure Gradient 
+      CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg )   ! KE Gradient 
+      CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo )   ! Relative Vorticity 
+      CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo )   ! Planetary Vorticity Term 
+      CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf )   ! Horizontal Diffusion 
+      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad )   ! Vertical Advection 
+      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg )   ! Surface Pressure Grad. 
+      CASE( jpdyn_zdf )                                                      ! Vertical Diffusion 
+         ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0
+         DO jj = 2, jpjm1                                                             ! wind stress trends
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 )
+               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 )
+            END DO
+         END DO
+         !
+         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf )                             ! zdf trend including surf./bot. stresses 
+         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                             ! surface wind stress 
+      CASE( jpdyn_bfr )
+         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr )                             ! Bottom stress
+         !
+      CASE( jpdyn_atf )       ! last trends: perform the output of 2D vorticity trends
+         CALL trd_vor_iom( kt )
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, ztswu, ztswv )
+      !
+   END SUBROUTINE trd_vor
+
+
+   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
+      !!----------------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor_zint  ***
+      !!
+      !! ** 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 :   trends :
+      !!                  vortrd (,, 1) = Pressure Gradient Trend
+      !!                  vortrd (,, 2) = KE Gradient Trend
+      !!                  vortrd (,, 3) = Relative Vorticity Trend
+      !!                  vortrd (,, 4) = Coriolis Term Trend
+      !!                  vortrd (,, 5) = Horizontal Diffusion Trend
+      !!                  vortrd (,, 6) = Vertical Advection Trend
+      !!                  vortrd (,, 7) = Vertical Diffusion Trend
+      !!                  vortrd (,, 8) = Surface Pressure Grad. Trend
+      !!                  vortrd (,, 9) = Beta V
+      !!                  vortrd (,,10) = forcing term
+      !!		              vortrd (,,11) = bottom friction term
+      !!                  rotot(,) : total cumulative trends over nwrite-1 time steps
+      !!                  vor_avrtot(,) : first membre of vrticity equation
+      !!                  vor_avrres(,) : residual = dh/dt entrainment
+      !!
+      !!      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 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
+      !
+      INTEGER ::   ji, jj       ! dummy loop indices
+      INTEGER ::   ikbu, ikbv   ! local integers
+      REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor  ! total cmulative trends
+      !!----------------------------------------------------------------------
+
+      !
+      CALL wrk_alloc( jpi, jpj, zudpvor, zvdpvor )                                     ! Memory allocation
+      !
+
+      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp                    ! Initialisation
+      CALL lbc_lnk( putrdvor, 'U', -1. )   ;   CALL lbc_lnk( pvtrdvor, 'V', -1. )      ! lateral boundary condition
+      
+
+      !  =====================================
+      !  I vertical integration of 2D trends
+      !  =====================================
+
+      SELECT CASE( ktrd ) 
+      !
+      CASE( jpvor_bfr )        ! bottom friction
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1 
+               ikbu = mbkv(ji,jj)
+               ikbv = mbkv(ji,jj)            
+               zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
+               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
+            END DO
+         END DO
+         !
+      CASE( jpvor_swf )        ! wind stress
+         zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1)
+         zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1)
+         !
+      END SELECT
+
+      ! Average except for Beta.V
+      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:)
+      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:)
+   
+      ! Curl
+      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) )
+         END DO
+      END DO
+      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)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zudpvor, zvdpvor )                                   
+      !
+   END SUBROUTINE trd_vor_zint_2d
+
+
+   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
+      !!----------------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor_zint  ***
+      !!
+      !! ** 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 :     trends :
+      !!                  vortrd (,,1) = Pressure Gradient Trend
+      !!                  vortrd (,,2) = KE Gradient Trend
+      !!                  vortrd (,,3) = Relative Vorticity Trend
+      !!                  vortrd (,,4) = Coriolis Term Trend
+      !!                  vortrd (,,5) = Horizontal Diffusion Trend
+      !!                  vortrd (,,6) = Vertical Advection Trend
+      !!                  vortrd (,,7) = Vertical Diffusion Trend
+      !!                  vortrd (,,8) = Surface Pressure Grad. Trend
+      !!                  vortrd (,,9) = Beta V
+      !!                  vortrd (,,10) = forcing term
+      !!		  vortrd (,,11) = bottom friction term
+      !!                  rotot(,) : total cumulative trends over nwrite-1 time steps
+      !!                  vor_avrtot(,) : first membre of vrticity equation
+      !!                  vor_avrres(,) : residual = dh/dt entrainment
+      !!
+      !!      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 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:) :: zubet  , zvbet    ! Beta.V   
+      REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor  ! total cmulative trends
+      !!----------------------------------------------------------------------
+     
+      CALL wrk_alloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )                                   
+
+      ! Initialization
+      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
+      !  =====================================
+      ! putrdvor and pvtrdvor terms
+      DO jk = 1,jpk
+        zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk)
+        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
+      END DO
+
+      ! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum
+      ! as Beta.V term need intergration, not average
+      IF( ktrd == jpvor_pvo ) THEN 
+         zubet(:,:) = zudpvor(:,:)
+         zvbet(:,:) = zvdpvor(:,:)
+         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) )
+            END DO
+         END DO
+         ! Average of the Curl and Surface mask
+         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1)
+      ENDIF
+      !
+      ! Average 
+      zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:)
+      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:)
+      !
+      ! Curl
+      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) )
+         END DO
+      END DO
+      ! Surface mask
+      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)
+   
+      IF( ndebug /= 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
+         CALL FLUSH(numout)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )                                   
+      !
+   END SUBROUTINE trd_vor_zint_3d
+
+
+   SUBROUTINE trd_vor_iom( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor  ***
+      !! 
+      !! ** Purpose :  computation of cumulated trends over analysis period
+      !!               and make outputs (NetCDF format)
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kt             ! time step
+      !
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   it, itmod        ! local integers
+      REAL(wp) ::   zmean            ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zun, zvn
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zun, zvn )                                   
+
+      !  =================
+      !  I. Initialization
+      !  =================
+     
+     
+      ! I.1 set before values of vertically average u and v
+      ! ---------------------------------------------------
+
+      IF( kt > nit000 )   vor_avrb(:,:) = vor_avr(:,:)
+
+      ! I.2 vertically integrated vorticity
+      !  ----------------------------------
+
+      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) * e3u_n(:,:,jk)
+         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk)
+      END DO
+ 
+      zun(:,:) = zun(:,:) * r1_hu_n(:,:)
+      zvn(:,:) = zvn(:,:) * r1_hv_n(:,:)
+
+      ! 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) ) * fmask(ji,jj,1)
+         END DO
+      END DO
+      
+      !  =================================
+      !   II. Cumulated trends
+      !  =================================
+
+      ! II.1 set `before' mixed layer values for kt = nit000+1
+      ! ------------------------------------------------------
+      IF( kt == nit000+1 ) THEN
+         vor_avrbb(:,:) = vor_avrb(:,:)
+         vor_avrbn(:,:) = vor_avr (:,:)
+      ENDIF
+
+      ! II.2 cumulated trends over analysis period (kt=2 to nwrite)
+      ! ----------------------
+      ! trends cumulated over nwrite-2 time steps
+
+      IF( kt >= nit000+2 ) THEN
+         nmoydpvor = nmoydpvor + 1
+         DO jl = 1, jpltot_vor
+            IF( jl /= 9 ) THEN
+               rotot(:,:) = rotot(:,:) + vortrd(:,:,jl)
+            ENDIF
+         END DO
+      ENDIF
+
+      !  =============================================
+      !   III. Output in netCDF + residual computation
+      !  =============================================
+
+      ! define time axis
+      it    = kt
+      itmod = kt - nit000 + 1
+
+      IF( MOD( it, nn_trd ) == 0 ) THEN
+
+         ! III.1 compute total trend
+         ! ------------------------
+         zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rdt  )
+         vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
+
+
+         ! III.2 compute residual
+         ! ---------------------
+         zmean = 1._wp / REAL( nmoydpvor, wp )
+         vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
+
+         ! Boundary conditions
+         CALL lbc_lnk( vor_avrtot, 'F', 1. )
+         CALL lbc_lnk( vor_avrres, 'F', 1. )
+
+
+         ! III.3 time evolution array swap
+         ! ------------------------------
+         vor_avrbb(:,:) = vor_avrb(:,:)
+         vor_avrbn(:,:) = vor_avr (:,:)
+         !
+         nmoydpvor = 0
+         !
+      ENDIF
+
+      ! III.4 write trends to output
+      ! ---------------------------
+
+      IF( kt >=  nit000+1 ) THEN
+
+         IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN
+            WRITE(numout,*) ''
+            WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt
+            WRITE(numout,*) '~~~~~~~  '
+         ENDIF
+ 
+         CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,jpvor_prg),ndimvor1,ndexvor1)  ! grad Ph
+         CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,jpvor_keg),ndimvor1,ndexvor1)  ! Energy
+         CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,jpvor_rvo),ndimvor1,ndexvor1)  ! rel vorticity
+         CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,jpvor_pvo),ndimvor1,ndexvor1)  ! coriolis
+         CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,jpvor_ldf),ndimvor1,ndexvor1)  ! lat diff
+         CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,jpvor_zad),ndimvor1,ndexvor1)  ! vert adv
+         CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,jpvor_zdf),ndimvor1,ndexvor1)  ! vert diff
+         CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,jpvor_spg),ndimvor1,ndexvor1)  ! grad Ps
+         CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1)  ! beta.V
+         CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress
+         CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction
+         CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot    ,ndimvor1,ndexvor1) ! First membre
+         CALL histwrite( nidvor,"sovorgap",it,vor_avrres    ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
+         !
+         IF( ndebug /= 0 ) THEN
+            WRITE(numout,*) ' debuging trd_vor: III.4 done'
+            CALL FLUSH(numout)
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0
+      !
+      IF( kt == nitend )   CALL histclo( nidvor )
+      !
+      CALL wrk_dealloc( jpi, jpj, zun, zvn )                                   
+      !
+   END SUBROUTINE trd_vor_iom
+
+
+   SUBROUTINE trd_vor_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor_init  ***
+      !! 
+      !! ** Purpose :   computation of vertically integrated T and S budgets
+      !!      from ocean surface down to control surface (NetCDF output)
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zjulian, zsto, zout
+      CHARACTER (len=40) ::   clhstnam
+      CHARACTER (len=40) ::   clop
+      !!----------------------------------------------------------------------
+
+      !  ===================
+      !   I. initialization
+      !  ===================
+
+      cvort='averaged-vor'
+
+      ! Open specifier
+      ndebug = 0      ! set it to 1 in case of problem to have more Print
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' trd_vor_init: vorticity trends'
+         WRITE(numout,*) ' ~~~~~~~~~~~~'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '               ##########################################################################'
+         WRITE(numout,*) '                CAUTION: The interpretation of the vorticity trends is'
+         WRITE(numout,*) '                not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr '
+         WRITE(numout,*) '               ##########################################################################'
+         WRITE(numout,*) ' '
+      ENDIF
+
+      IF( trd_vor_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' )
+
+
+      ! cumulated trends array init
+      nmoydpvor = 0
+      rotot(:,:)=0
+      vor_avrtot(:,:)=0
+      vor_avrres(:,:)=0
+
+      IF( ndebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_vor_init: I. done'
+         CALL FLUSH(numout)
+      ENDIF
+
+      !  =================================
+      !   II. netCDF output initialization
+      !  =================================
+
+      !-----------------------------------------
+      ! II.1 Define frequency of output and means
+      ! -----------------------------------------
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#if defined key_diainstant
+      zsto = nwrite*rdt
+      clop = "inst("//TRIM(clop)//")"
+#else
+      zsto = rdt
+      clop = "ave("//TRIM(clop)//")"
+#endif
+      zout = nn_trd*rdt
+
+      IF(lwp) WRITE(numout,*) '               netCDF initialization'
+
+      ! II.2 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
+      IF(lwp) WRITE(numout,*)' '  
+      IF(lwp) WRITE(numout,*)'               Date 0 used :',nit000,    &
+         &                   ' YEAR ', nyear,' MONTH '      , nmonth,   &
+         &                   ' DAY ' , nday, 'Julian day : ', zjulian
+
+      ! II.3 Define the T grid trend file (nidvor)
+      ! ---------------------------------
+      CALL dia_nam( clhstnam, nn_trd, 'vort' )                  ! filename
+      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, snc4chunks=snc4set )
+      CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 )    ! surface
+
+      ! Declare output fields as netCDF variables
+      CALL histdef( nidvor, "sovortPh", cvort//"grad Ph" , "s-2",        & ! grad Ph
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovortEk", cvort//"Energy", "s-2",          & ! Energy
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovozeta", cvort//"rel vorticity", "s-2",   & ! rel vorticity
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovortif", cvort//"coriolis", "s-2",        & ! coriolis
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovodifl", cvort//"lat diff ", "s-2",       & ! lat diff
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovoadvv", cvort//"vert adv", "s-2",        & ! vert adv
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovodifv", cvort//"vert diff" , "s-2",      & ! vert diff
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovortPs", cvort//"grad Ps", "s-2",         & ! grad Ps
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovortbv", cvort//"Beta V", "s-2",          & ! beta.V
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovowind", cvort//"wind stress", "s-2",     & ! wind stress
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "sovobfri", cvort//"bottom friction", "s-2", & ! bottom friction
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      CALL histdef( nidvor, "1st_mbre", cvort//"1st mbre", "s-2",        & ! First membre
+         &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
+      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, snc4set )
+
+      IF( ndebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_vor_init: II. done'
+         CALL FLUSH(numout)
+      ENDIF
+      !
+   END SUBROUTINE trd_vor_init
+
+   !!======================================================================
+END MODULE trdvor
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 8732)
@@ -0,0 +1,34 @@
+MODULE trdvor_oce
+   !!======================================================================
+   !!                   ***  MODULE trdvor_oce  ***
+   !! Ocean trends :   set vorticity trend variables
+   !!======================================================================
+   !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code 
+   !!----------------------------------------------------------------------
+   
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !                                               !!* vorticity trends index
+   INTEGER, PUBLIC, PARAMETER ::   jpltot_vor = 11  !: Number of vorticity trend terms
+   !
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_prg =  1   !: Pressure Gradient Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_keg =  2   !: KE Gradient Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_rvo =  3   !: Relative Vorticity Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_pvo =  4   !: Planetary Vorticity Term Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_ldf =  5   !: Horizontal Diffusion Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_zad =  6   !: Vertical Advection Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_zdf =  7   !: Vertical Diffusion Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_spg =  8   !: Surface Pressure Grad. Trend
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_bev =  9   !: Beta V
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_swf = 10   !: wind stress forcing term
+   INTEGER, PUBLIC, PARAMETER ::   jpvor_bfr = 11   !: bottom friction term
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trdvor_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90	(revision 8732)
@@ -0,0 +1,402 @@
+MODULE usrdef_closea
+   !!======================================================================
+   !!                   ***  MODULE  usrdef_closea  ***
+   !!
+   !!                      ===  ORCA configuration  ===
+   !!                         (2, 1 and 1/4 degrees)
+   !!
+   !! User define : specific treatments associated with closed seas
+   !!======================================================================
+   !! History :   8.2  !  2000-05  (O. Marti)  Original code
+   !!   NEMO      1.0  !  2002-06  (E. Durand, G. Madec)  F90
+   !!             3.0  !  2006-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat
+   !!             3.4  !  2014-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility
+   !!             4.0  !  2016-06  (G. Madec)  move to usrdef_closea, remove clo_ups
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_clo    : modification of the ocean domain for closed seas cases
+   !!   sbc_clo    : Special handling of closed seas
+   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
+   !!   clo_bat    : set to zero a field over closed sea (see domzrg)
+   !!----------------------------------------------------------------------
+   USE oce             ! dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! ocean surface boundary conditions
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran,    ONLY: glob_sum, DDPDD
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE lib_mpp         ! MPP library
+   USE timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dom_clo      ! called by domain module
+   PUBLIC sbc_clo      ! called by step module
+   PUBLIC clo_rnf      ! called by sbcrnf module
+   PUBLIC clo_bat      ! called in domzgr module
+
+   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j)
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j)
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours
+   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff
+
+   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_clo( cd_cfg, kcfg )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_clo  ***
+      !!        
+      !! ** Purpose :   Closed sea domain initialization
+      !!
+      !! ** Method  :   if a closed sea is located only in a model grid point
+      !!                just the thermodynamic processes are applied.
+      !!
+      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
+      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
+      !!                ncsir(), ncsjr() : Location of runoff
+      !!                ncsnr            : number of point where run-off pours
+      !!                ncstt            : Type of closed sea
+      !!                                   =0 spread over the world ocean
+      !!                                   =2 put at location runoff
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   ) ::   cd_cfg   ! configuration name
+      INTEGER         , INTENT(in   ) ::   kcfg     ! configuration identifier 
+      !
+      INTEGER ::   jc      ! dummy loop indices
+      INTEGER ::   isrow   ! local index
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
+      IF(lwp) WRITE(numout,*)'~~~~~~~'
+      !
+      ! initial values
+      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
+      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
+      !
+      ! set the closed seas (in data domain indices)
+      ! -------------------
+      !
+      IF( cd_cfg == "orca" ) THEN      !==  ORCA configuration  ==!
+         !
+         SELECT CASE ( kcfg )
+         !                                           ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configuration
+            !                                        ! =======================
+            IF(lwp) WRITE(numout,*)'   ORCA_R1 closed seas :  only the Caspian Sea'
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            !
+            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea  (spread over the globe)
+            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow
+            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow
+            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
+            !                                        
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            IF(lwp) WRITE(numout,*)'   ORCA_R2 closed seas and lakes : '
+            !                                            ! Caspian Sea
+            IF(lwp) WRITE(numout,*)'      Caspian Sea  '
+            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
+            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
+            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
+            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
+            !                                            ! Great North American Lakes
+            IF(lwp) WRITE(numout,*)'      Great North American Lakes  '
+            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
+            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
+            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
+            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111           
+            !                                            ! Black Sea (crossed by the cyclic boundary condition)
+            IF(lwp) WRITE(numout,*)'      Black Sea  '
+            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea)
+            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         !
+            ncsir(3:4,2) = 170;  ncsjr(3:4,2) = 106 
+            ncsir(3:4,3) = 171;  ncsjr(3:4,3) = 105 
+            ncsir(3:4,4) = 170;  ncsjr(3:4,4) = 105 
+            ncsi1(3)   = 174  ;  ncsj1(3)   = 107           ! 1 : west part of the Black Sea      
+            ncsi2(3)   = 181  ;  ncsj2(3)   = 112           !            (ie west of the cyclic b.c.)
+            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea 
+            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.)
+            !
+            !                                        ! =========================
+         CASE ( 025 )                                !  ORCA_R025 configuration
+            !                                        ! =========================
+            IF(lwp) WRITE(numout,*)'   ORCA_R025 closed seas : '
+            !                                            ! Caspian Sea
+            IF(lwp) WRITE(numout,*)'      Caspian Sea  '
+            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
+            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
+            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
+            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
+            !                                        
+            IF(lwp) WRITE(numout,*)'      Azov Sea  '
+            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea 
+            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
+            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
+            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
+            !
+         END SELECT
+         !
+      ELSE                             !==  No closed sea in the configuration  ==!
+         !
+         IF(lwp) WRITE(numout,*)'   No closed seas or lakes in the configuration '
+         !
+      ENDIF
+
+      ! convert the position in local domain indices
+      ! --------------------------------------------
+      DO jc = 1, jpncs
+         ncsi1(jc)   = mi0( ncsi1(jc) )
+         ncsj1(jc)   = mj0( ncsj1(jc) )
+         !
+         ncsi2(jc)   = mi1( ncsi2(jc) )   
+         ncsj2(jc)   = mj1( ncsj2(jc) )  
+      END DO
+      !
+   END SUBROUTINE dom_clo
+
+
+   SUBROUTINE sbc_clo( kt, cd_cfg, kcfg )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_clo  ***
+      !!                    
+      !! ** Purpose :   Special handling of closed seas
+      !!
+      !! ** Method  :   Water flux is forced to zero over closed sea
+      !!      Excess is shared between remaining ocean, or
+      !!      put as run-off in open ocean.
+      !!
+      !! ** Action  :   emp updated surface freshwater fluxes and associated heat content at kt
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kt       ! ocean model time step
+      CHARACTER(len=*), INTENT(in   ) ::   cd_cfg   ! configuration name
+      INTEGER         , INTENT(in   ) ::   kcfg     ! configuration identifier 
+      !
+      INTEGER             ::   ji, jj, jc, jn   ! dummy loop indices
+      REAL(wp), PARAMETER ::   rsmall = 1.e-20_wp    ! Closed sea correction epsilon
+      REAL(wp)            ::   zze2, ztmp, zcorr     ! 
+      REAL(wp)            ::   zcoef, zcoef1         ! 
+      COMPLEX(wp)         ::   ctmp 
+      REAL(wp), DIMENSION(jpncs) ::   zfwf   ! 1D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_clo')
+      !                                                   !------------------!
+      IF( kt == nit000 ) THEN                             !  Initialisation  !
+         !                                                !------------------!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas '
+         IF(lwp) WRITE(numout,*)'~~~~~~~'
+
+         surf(:) = 0._wp
+         !
+         surf(jpncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean
+         !
+         !                                        ! surface of closed seas 
+         DO jc = 1, jpncs
+            ctmp = CMPLX( 0.e0, 0.e0, wp )
+            DO jj = ncsj1(jc), ncsj2(jc)
+               DO ji = ncsi1(jc), ncsi2(jc)
+                  ztmp = e1e2t(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 )
+            surf(jc) = REAL(ctmp,wp)
+         END DO
+
+         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
+         DO jc = 1, jpncs
+            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
+         END DO
+
+         ! jpncs+1 : surface of sea, closed seas excluded
+         DO jc = 1, jpncs
+            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
+         END DO           
+         !
+      ENDIF
+      !                                                   !--------------------!
+      !                                                   !  update emp        !
+      zfwf = 0.e0_wp                                      !--------------------!
+      DO jc = 1, jpncs
+         ctmp = CMPLX( 0.e0, 0.e0, wp )
+         DO jj = ncsj1(jc), ncsj2(jc)
+            DO ji = ncsi1(jc), ncsi2(jc)
+               ztmp = e1e2t(ji,jj) * ( emp(ji,jj)-rnf(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 )
+         zfwf(jc) = REAL(ctmp,wp)
+      END DO
+
+      IF( cd_cfg == "orca" .AND. kcfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
+         zze2    = ( zfwf(3) + zfwf(4) ) * 0.5_wp
+         zfwf(3) = zze2
+         zfwf(4) = zze2
+      ENDIF
+
+      zcorr = 0._wp
+
+      DO jc = 1, jpncs
+         !
+         ! The following if avoids the redistribution of the round off
+         IF ( ABS(zfwf(jc) / surf(jpncs+1) ) > rsmall) THEN
+            !
+            IF( ncstt(jc) == 0 ) THEN           ! water/evap excess is shared by all open ocean
+               zcoef    = zfwf(jc) / surf(jpncs+1)
+               zcoef1   = rcp * zcoef
+               emp(:,:) = emp(:,:) + zcoef
+               qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
+               ! accumulate closed seas correction
+               zcorr    = zcorr    + zcoef
+               !
+            ELSEIF( ncstt(jc) == 1 ) THEN       ! Excess water in open sea, at outflow location, excess evap shared
+               IF ( zfwf(jc) <= 0.e0_wp ) THEN 
+                   DO jn = 1, ncsnr(jc)
+                     ji = mi0(ncsir(jc,jn))
+                     jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
+                     IF (      ji > 1 .AND. ji < jpi   &
+                         .AND. jj > 1 .AND. jj < jpj ) THEN 
+                         zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
+                         zcoef1     = rcp * zcoef
+                         emp(ji,jj) = emp(ji,jj) + zcoef
+                         qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
+                     ENDIF 
+                   END DO 
+               ELSE 
+                   zcoef    = zfwf(jc) / surf(jpncs+1)
+                   zcoef1   = rcp * zcoef
+                   emp(:,:) = emp(:,:) + zcoef
+                   qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)
+                   ! accumulate closed seas correction
+                   zcorr    = zcorr    + zcoef
+               ENDIF
+            ELSEIF( ncstt(jc) == 2 ) THEN       ! Excess e-p-r (either sign) goes to open ocean, at outflow location
+               DO jn = 1, ncsnr(jc)
+                  ji = mi0(ncsir(jc,jn))
+                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
+                  IF(      ji > 1 .AND. ji < jpi    &
+                     .AND. jj > 1 .AND. jj < jpj ) THEN 
+                     zcoef      = zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
+                     zcoef1     = rcp * zcoef
+                     emp(ji,jj) = emp(ji,jj) + zcoef
+                     qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj)
+                  ENDIF 
+               END DO 
+            ENDIF 
+            !
+            DO jj = ncsj1(jc), ncsj2(jc)
+               DO ji = ncsi1(jc), ncsi2(jc)
+                  zcoef      = zfwf(jc) / surf(jc)
+                  zcoef1     = rcp * zcoef
+                  emp(ji,jj) = emp(ji,jj) - zcoef
+                  qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj)
+               END DO  
+            END DO 
+            !
+         END IF
+      END DO 
+
+      IF ( ABS(zcorr) > rsmall ) THEN      ! remove the global correction from the closed seas
+         DO jc = 1, jpncs                  ! only if it is large enough
+            DO jj = ncsj1(jc), ncsj2(jc)
+               DO ji = ncsi1(jc), ncsi2(jc)
+                  emp(ji,jj) = emp(ji,jj) - zcorr
+                  qns(ji,jj) = qns(ji,jj) + rcp * zcorr * sst_m(ji,jj)
+               END DO  
+             END DO 
+          END DO
+      ENDIF
+      !
+      emp (:,:) = emp (:,:) * tmask(:,:,1)
+      !
+      CALL lbc_lnk( emp , 'T', 1._wp )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_clo')
+      !
+   END SUBROUTINE sbc_clo
+
+
+   SUBROUTINE clo_rnf( p_rnfmsk )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf  ***
+      !!                    
+      !! ** Purpose :   allow the treatment of closed sea outflow grid-points
+      !!                to be the same as river mouth grid-points
+      !!
+      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module)
+      !!                at the closed sea outflow grid-point.
+      !!
+      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array)
+      !
+      INTEGER  ::   jc, jn, ji, jj      ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jc = 1, jpncs
+         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows
+             DO jn = 1, 4
+                DO jj =    mj0( ncsjr(jc,jn) ), mj1( ncsjr(jc,jn) )
+                   DO ji = mi0( ncsir(jc,jn) ), mi1( ncsir(jc,jn) )
+                      p_rnfmsk(ji,jj) = MAX( p_rnfmsk(ji,jj), 1.0_wp )
+                   END DO
+                END DO
+            END DO 
+         ENDIF 
+      END DO 
+      !
+   END SUBROUTINE clo_rnf
+   
+      
+   SUBROUTINE clo_bat( k_top, k_bot )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE clo_bat  ***
+      !!                    
+      !! ** Purpose :   suppress closed sea from the domain
+      !!
+      !! ** Method  :   set first and last ocean level to 0 over the closed seas.
+      !!
+      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices
+      !
+      INTEGER  ::   jc, ji, jj      ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jc = 1, jpncs
+         DO jj = ncsj1(jc), ncsj2(jc)
+            DO ji = ncsi1(jc), ncsi2(jc)
+               k_top(ji,jj) = 0   
+               k_bot(ji,jj) = 0   
+            END DO 
+         END DO 
+       END DO 
+       !
+   END SUBROUTINE clo_bat
+
+   !!======================================================================
+END MODULE usrdef_closea
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_fmask.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_fmask.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_fmask.F90	(revision 8732)
@@ -0,0 +1,150 @@
+MODULE usrdef_fmask
+   !!======================================================================
+   !!                     ***  MODULE usrdef_fmask   ***
+   !!
+   !!                      ===  ORCA configuration  ===
+   !!                            (2 and 1 degrees)
+   !!
+   !! User defined : alteration of land/sea f-point mask in some straits
+   !!======================================================================
+   !! History :  4.0  ! 2016-06  (G. Madec, S. Flavoni)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_fmask  : alteration of f-point land/ocean mask in some straits
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! Massively Parallel Processing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_fmask    ! routine called by dommsk.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium  (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_fmask( cd_cfg, kcfg, pfmsk )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   User defined alteration of the lateral boundary 
+      !!              condition on velocity.
+      !!
+      !! ** Method  :   Local change of the value of fmask at lateral ocean/land 
+      !!              boundary in straits in order to increase the viscous 
+      !!              boundary layer and thus reduce the transport through the 
+      !!              corresponding straits.
+      !!                Here only alterations in ORCA R2 and R1 cases
+      !!
+      !! ** Action :   fmask : land/ocean mask at f-point with increased value 
+      !!                       in some user defined straits
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)          , INTENT(in   ) ::   cd_cfg   ! configuration name
+      INTEGER                   , INTENT(in   ) ::   kcfg     ! configuration identifier 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pfmsk    ! Ocean/Land f-point mask including lateral boundary cond.
+      !
+      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
+      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
+      INTEGER  ::   isrow                    ! index for ORCA1 starting row
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM( cd_cfg ) == "orca" ) THEN      !==  ORCA Configurations  ==!
+         !
+         SELECT CASE ( kcfg )
+         !
+         CASE( 2 )                           !  R2 case
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R2: increase lateral friction near the following straits:'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+            !
+            IF(lwp) WRITE(numout,*) '      Gibraltar '
+            ij0 = 101   ;   ij1 = 101           ! Gibraltar strait  : partial slip (pfmsk=0.5)
+            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+            ij0 = 102   ;   ij1 = 102
+            ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+            !
+            IF(lwp) WRITE(numout,*) '      Bab el Mandeb '
+            ij0 =  87   ;   ij1 =  88           ! Bab el Mandeb : partial slip (pfmsk=1)
+            ii0 = 160   ;   ii1 = 160   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 159   ;   ii1 = 159   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+            !
+            ! We keep this as an example but it is instable in this case 
+            !IF(lwp) WRITE(numout,*) '      Danish straits '
+            !         ij0 = 115   ;   ij1 = 115 ! Danish straits  : strong slip (pfmsk > 2)
+            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+            !         ij0 = 116   ;   ij1 = 116
+            !         ii0 = 145   ;   ii1 = 146   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+            !
+         CASE( 1 )                           ! R1 case
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R1: increase lateral friction near the following straits:'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
+!!gm    ! This dirty section will be suppressed by simplification process:
+!!gm    ! all this will come back in input files
+!!gm    ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332)
+            !
+            isrow = 332 - jpjglo
+            !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
+            IF(lwp) WRITE(numout,*) '      Gibraltar '
+            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
+            ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Bhosporus '
+            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait 
+            ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   pfmsk( 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 = 189 - isrow   ;   ij1 = 190 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Lombok '
+            ii0 =  44           ;   ii1 =  44        ! Lombok Strait 
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+            !
+            IF(lwp) WRITE(numout,*) '      Ombai '
+            ii0 =  53           ;   ii1 =  53        ! Ombai Strait 
+            ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( 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 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( 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 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( 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 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+            !
+         CASE DEFAULT
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R', kcfg,' : NO alteration of fmask in specific straits '
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'   
+         END SELECT
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'usr_def_fmask : NO alteration of fmask in specific straits '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !
+      CALL lbc_lnk( pfmsk, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+      !
+   END SUBROUTINE usr_def_fmask
+   
+   !!======================================================================
+END MODULE usrdef_fmask
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90	(revision 8732)
@@ -0,0 +1,165 @@
+MODULE usrdef_hgr
+   !!======================================================================
+   !!                     ***  MODULE usrdef_hgr   ***
+   !!
+   !!                     ===  GYRE configuration  ===
+   !!
+   !! User defined :   mesh and Coriolis parameter of a user configuration
+   !!======================================================================
+   !! History :  4.0 ! 2016-03  (S. Flavoni) 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE usrdef_nam     !
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_hgr   ! called in domhgr.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_hgr( plamt , plamu , plamv  , plamf  ,   &   ! geographic position (required)
+      &                    pphit , pphiu , pphiv  , pphif  ,   &   !
+      &                    kff   , pff_f , pff_t  ,            &   ! Coriolis parameter  (if domain not on the sphere)
+      &                    pe1t  , pe1u  , pe1v   , pe1f   ,   &   ! scale factors       (required)
+      &                    pe2t  , pe2u  , pe2v   , pe2f   ,   &   !
+      &                    ke1e2u_v      , pe1e2u , pe1e2v     )   ! u- & v-surfaces (if gridsize reduction is used in strait(s))
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE usr_def_hgr  ***
+      !!
+      !! ** Purpose :   user defined mesh and Coriolis parameter
+      !!
+      !! ** Method  :   set all intent(out) argument to a proper value
+      !!
+      !!                Here GYRE configuration :
+      !!          Rectangular mid-latitude domain 
+      !!          - with axes rotated by 45 degrees
+      !!          - a constant horizontal resolution of 106 km 
+      !!          - on a beta-plane
+      !!
+      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
+      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane)
+      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
+      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs                     [degrees]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs                      [degrees]
+      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter computed here, =0 otherwise
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point                [1/s]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors                             [m]
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors                             [m]
+      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces computed here, =0 otherwise 
+      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zlam1, zlam0, zcos_alpha, zim1 , zjm1 , ze1  , ze1deg, zf0 ! local scalars
+      REAL(wp) ::   zphi1, zphi0, zsin_alpha, zim05, zjm05, zbeta, znorme      !   -      -
+      !!-------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('usr_def_hgr')
+      !
+      !     !==  beta-plane with regular grid-spacing and rotated domain ==!  (GYRE configuration)
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_hgr : GYRE configuration (beta-plane with rotated regular grid-spacing)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      !                       !==  grid point position  ==!
+      !
+      zlam1 = -85._wp                           ! position of gridpoint (i,j) = (1,jpjglo)
+      zphi1 =  29._wp
+      !
+      ze1 = 106000._wp / REAL( nn_GYRE , wp )   ! gridspacing in meters
+      !
+      zsin_alpha = - SQRT( 2._wp ) * 0.5_wp     ! angle: 45 degrees
+      zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
+      ze1deg = ze1 / (ra * rad)
+      zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
+      zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+      !   
+      IF( ln_bench ) THEN     ! benchmark: forced the resolution to be 106 km 
+         ze1 = 106000._wp     ! but keep (lat,lon) at the right nn_GYRE resolution
+         CALL ctl_warn( ' GYRE used as Benchmark: e1=e2=106km, no need to adjust rdt, ahm,aht ' )
+      ENDIF
+      IF( nprint==1 .AND. lwp )   THEN
+         WRITE(numout,*) 'ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
+         WRITE(numout,*) 'ze1deg', ze1deg, 'zlam0', zlam0, 'zphi0', zphi0
+      ENDIF
+      !   
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
+            zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
+            !   
+            !glamt(i,j) longitude at T-point
+            !gphit(i,j) latitude at T-point  
+            plamt(ji,jj) = zlam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+            pphit(ji,jj) = zphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+            !   
+            !glamu(i,j) longitude at U-point
+            !gphiu(i,j) latitude at U-point
+            plamu(ji,jj) = zlam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+            pphiu(ji,jj) = zphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+            !   
+            !glamv(i,j) longitude at V-point
+            !gphiv(i,j) latitude at V-point
+            plamv(ji,jj) = zlam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+            pphiv(ji,jj) = zphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+            !
+            !glamf(i,j) longitude at F-point
+            !gphif(i,j) latitude at F-point 
+            plamf(ji,jj) = zlam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+            pphif(ji,jj) = zphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+         END DO
+      END DO
+      !
+      !                       !== Horizontal scale factors ==! (in meters)
+      !                     
+      !                                         ! constant grid spacing
+      pe1t(:,:) =  ze1     ;      pe2t(:,:) = ze1
+      pe1u(:,:) =  ze1     ;      pe2u(:,:) = ze1
+      pe1v(:,:) =  ze1     ;      pe2v(:,:) = ze1
+      pe1f(:,:) =  ze1     ;      pe2f(:,:) = ze1
+      !
+      !                                         ! NO reduction of grid size in some straits 
+      ke1e2u_v = 0                              !    ==>> u_ & v_surfaces will be computed in dom_ghr routine
+      pe1e2u(:,:) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that
+      pe1e2v(:,:) = 0._wp                       !             require an initialization of INTENT(out) arguments
+      !
+      !
+      !                       !==  Coriolis parameter  ==!
+      kff = 1                                            !  indicate not to compute ff afterward
+      !
+      zbeta = 2. * omega * COS( rad * zphi1 ) / ra       ! beta at latitude zphi1
+      !SF we overwrite zphi0 (south point in latitude) used just above to define pphif (value of zphi0=15.5190567531966)
+      !SF for computation of Coriolis we keep the parameter of Hazeleger, W., and S. S. Drijfhout, JPO 1998.
+      zphi0 = 15._wp                                     !  latitude of the most southern grid point  
+      zf0   = 2. * omega * SIN( rad * zphi0 )            !  compute f0 1st point south
+      !
+      pff_f(:,:) = ( zf0 + zbeta * ABS( pphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south)
+      pff_t(:,:) = ( zf0 + zbeta * ABS( pphit(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south)
+      !
+      IF(lwp) WRITE(numout,*) '                           beta-plane used. beta = ', zbeta, ' 1/(s.m)'
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('usr_def_hgr')
+      !
+   END SUBROUTINE usr_def_hgr
+
+   !!======================================================================
+END MODULE usrdef_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90	(revision 8732)
@@ -0,0 +1,85 @@
+MODULE usrdef_istate
+   !!======================================================================
+   !!                   ***  MODULE  usrdef_istate   ***
+   !!
+   !!                     ===  GYRE configuration  ===
+   !!
+   !! User defined : set the initial state of a user configuration
+   !!======================================================================
+   !! History :  4.0 ! 2016-03  (S. Flavoni) Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  usr_def_istate : initial state in Temperature and salinity
+   !!----------------------------------------------------------------------
+   USE par_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
+
+   PUBLIC   usr_def_istate   ! called in istate.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+  
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers
+      !!                Here GYRE configuration example : (double gyre with rotated domain)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity   field
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pdept   ! depth of t-point               [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask             [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pts     ! T & S fields      [Celsius ; g/kg]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+      !
+      INTEGER :: ji, jj, jk  ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate : analytical definition of initial state '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with an horizontally uniform T and S profiles'
+      !
+      pu  (:,:,:) = 0._wp        ! ocean at rest
+      pv  (:,:,:) = 0._wp
+      pssh(:,:)   = 0._wp
+      !
+      DO jk = 1, jpk             ! horizontally uniform T & S profiles
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   &
+                    &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             &
+                    &           + ( 15. * ( 1. - TANH( (pdept(ji,jj,jk)-50.) / 1500.) )            &
+                    &           - 1.4 * TANH((pdept(ji,jj,jk)-100.) / 100.)                        &
+                    &           + 7.  * (1500. - pdept(ji,jj,jk) ) / 1500.)                        &
+                    &           * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2.  ) * ptmask(ji,jj,jk)
+
+               pts(ji,jj,jk,jp_sal) =  (  (  36.25 - 1.13 * TANH( (pdept(ji,jj,jk) - 305) / 460 ) )  &
+                    &         * (-TANH((500. - pdept(ji,jj,jk)) / 150.) + 1.) / 2                  &
+                    &         + ( 35.55 + 1.25 * (5000. - pdept(ji,jj,jk)) / 5000.                 &
+                    &         - 1.62 * TANH( (pdept(ji,jj,jk) - 60.  ) / 650. )                    &
+                    &         + 0.2  * TANH( (pdept(ji,jj,jk) - 35.  ) / 100. )                    &
+                    &         + 0.2  * TANH( (pdept(ji,jj,jk) - 1000.) / 5000.) )                  &
+                    &         * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2  ) * ptmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !   
+   END SUBROUTINE usr_def_istate
+
+   !!======================================================================
+END MODULE usrdef_istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90	(revision 8732)
@@ -0,0 +1,98 @@
+MODULE usrdef_nam
+   !!======================================================================
+   !!                     ***  MODULE usrdef_nam   ***
+   !!
+   !!                     ===  GYRE configuration  ===
+   !!
+   !! User defined : set the domain characteristics of a user configuration
+   !!======================================================================
+   !! History :  4.0  ! 2016-03  (S. Flavoni, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_nam   : read user defined namelist and set global domain size
+   !!   usr_def_hgr   : initialize the horizontal mesh 
+   !!----------------------------------------------------------------------
+   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain
+   USE par_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_nam   ! called in nemogcm.F90 module
+
+   !                              !!* namusr_def namelist *!!
+   LOGICAL, PUBLIC ::   ln_bench   ! =T benchmark test with gyre: the gridsize is constant (no need to adjust timestep or viscosity)
+   INTEGER, PUBLIC ::   nn_GYRE    ! 1/nn_GYRE = the resolution chosen in degrees and thus defining the horizontal domain size
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read user defined namelist and define the domain size
+      !!
+      !! ** Method  :   read in namusr_def containing all the user specific namelist parameter
+      !!
+      !!                Here GYRE configuration
+      !!
+      !! ** input   : - namusr_def namelist found in namelist_cfg
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt, ldnam    ! stored print information
+      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
+      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
+      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
+      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      !
+      INTEGER ::   ios, ii   ! Local integer
+      !!
+      NAMELIST/namusr_def/ nn_GYRE, ln_bench, jpkglo
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      !
+      REWIND( numnam_cfg )          ! Namelist namusr_def (exist in namelist_cfg only)
+      READ  ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namusr_def in configuration namelist', .TRUE. )
+      !
+      WRITE( ldnam(:), namusr_def )
+      !
+      cd_cfg = 'GYRE'               ! name & resolution (not used)
+      kk_cfg = nn_GYRE
+      !
+      kpi = 30 * nn_GYRE + 2        ! Global Domain size
+      kpj = 20 * nn_GYRE + 2
+      kpk = jpkglo
+      !
+      !                             ! control print
+      WRITE(ldtxt(ii),*) '   '                                                                            ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'usr_def_nam  : read the user defined namelist (namusr_def) in namelist_cfg'     ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~~~~~~ '                                                                   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Namelist namusr_def : GYRE case'                                             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      GYRE used as Benchmark (=T)                      ln_bench  = ', ln_bench  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      inverse resolution & implied domain size         nn_GYRE   = ', nn_GYRE   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         jpiglo = 30*nn_GYRE+2                            jpiglo = ', kpi       ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '         jpjglo = 20*nn_GYRE+2                            jpjglo = ', kpj       ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      number of model levels                              jpkglo = ', kpk       ;   ii = ii + 1
+      !
+      !                             ! Set the lateral boundary condition of the global domain
+      kperio = 0                    ! GYRE configuration : closed domain
+      !
+      WRITE(ldtxt(ii),*) '   '                                                                        ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '   Lateral b.c. of the global domain set to closed     jperio = ', kperio   ;   ii = ii + 1
+      !
+   END SUBROUTINE usr_def_nam
+
+   !!======================================================================
+END MODULE usrdef_nam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90	(revision 8732)
@@ -0,0 +1,236 @@
+MODULE usrdef_sbc
+   !!======================================================================
+   !!                     ***  MODULE  usrdef_sbc  ***
+   !!
+   !!                     ===  GYRE configuration  ===
+   !!
+   !! User defined :   surface forcing of a user configuration
+   !!======================================================================
+   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usrdef_sbc    : user defined surface bounday conditions in GYRE case
+   !!----------------------------------------------------------------------
+   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 in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module
+   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
+   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE usrdef_sbc_oce( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE usrdef_sbc  ***
+      !!              
+      !! ** Purpose :   provide at each time-step the GYRE surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   analytical seasonal cycle for GYRE configuration.
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set the ocean surface boundary condition, i.e.   
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
+      !!
+      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ji, jj                 ! dummy loop indices
+      INTEGER  ::   zyear0                 ! initial year 
+      INTEGER  ::   zmonth0                ! initial month
+      INTEGER  ::   zday0                  ! initial day
+      INTEGER  ::   zday_year0             ! initial day since january 1st
+      REAL(wp) ::   ztau     , ztau_sais   ! wind intensity and of the seasonal cycle
+      REAL(wp) ::   ztime                  ! time in hour
+      REAL(wp) ::   ztimemax , ztimemin    ! 21th June, and 21th decem. if date0 = 1st january
+      REAL(wp) ::   ztimemax1, ztimemin1   ! 21th June, and 21th decem. if date0 = 1st january
+      REAL(wp) ::   ztimemax2, ztimemin2   ! 21th June, and 21th decem. if date0 = 1st january
+      REAL(wp) ::   ztaun                  ! intensity
+      REAL(wp) ::   zemp_s, zemp_n, zemp_sais, ztstar
+      REAL(wp) ::   zcos_sais1, zcos_sais2, ztrp, zconv, t_star
+      REAL(wp) ::   zsumemp, zsurf
+      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
+      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
+      REAL(wp) ::   zyydd                 ! number of days in one year
+      !!---------------------------------------------------------------------
+      zyydd = REAL(nyear_len(1),wp)
+
+      ! ---------------------------- !
+      !  heat and freshwater fluxes  !
+      ! ---------------------------- !
+      !same temperature, E-P as in HAZELEGER 2000
+
+      zyear0     =   ndate0 / 10000                             ! initial year
+      zmonth0    = ( ndate0 - zyear0 * 10000 ) / 100            ! initial month
+      zday0      =   ndate0 - zyear0 * 10000 - zmonth0 * 100    ! initial day betwen 1 and 30
+      zday_year0 = ( zmonth0 - 1 ) * 30.+zday0                  ! initial day betwen 1 and 360
+
+      ! current day (in hours) since january the 1st of the current year
+      ztime = REAL( kt ) * rdt / (rmmss * rhhmm)   &       !  total incrementation (in hours)
+         &      - (nyear  - 1) * rjjhh * zyydd             !  minus years since beginning of experiment (in hours)
+
+      ztimemax1 = ((5.*30.)+21.)* 24.                      ! 21th june     at 24h in hours
+      ztimemin1 = ztimemax1 + rjjhh * zyydd / 2            ! 21th december        in hours
+      ztimemax2 = ((6.*30.)+21.)* 24.                      ! 21th july     at 24h in hours
+      ztimemin2 = ztimemax2 - rjjhh * zyydd / 2            ! 21th january         in hours
+      !                                                    ! NB: rjjhh * zyydd / 4 = one seasonal cycle in hours
+
+      ! amplitudes
+      zemp_S    = 0.7       ! intensity of COS in the South
+      zemp_N    = 0.8       ! intensity of COS in the North
+      zemp_sais = 0.1
+      zTstar    = 28.3      ! intemsity from 28.3 a -5 deg
+
+      ! 1/2 period between 21th June and 21th December and between 21th July and 21th January
+      zcos_sais1 = COS( (ztime - ztimemax1) / (ztimemin1 - ztimemax1) * rpi ) 
+      zcos_sais2 = COS( (ztime - ztimemax2) / (ztimemax2 - ztimemin2) * rpi )
+
+      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K)
+      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3
+            ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
+            ! 64.5 in summer, 42.5 in winter
+            t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                &
+               &                    * COS( rpi * (gphit(ji,jj) - 5.)               &
+               &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) )
+            ! 23.5 deg : tropics
+            qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) )
+            qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj)
+            IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg
+               emp  (ji,jj) =   zemp_S * zconv   &
+                  &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  &
+                  &         * ( 1 - zemp_sais / zemp_S * zcos_sais1)
+            ELSE
+               emp (ji,jj) =  - zemp_N * zconv   &
+                  &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  &
+                  &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 )
+            ENDIF
+         END DO
+      END DO
+
+      zsumemp = GLOB_SUM( emp  (:,:)   ) 
+      zsurf   = GLOB_SUM( tmask(:,:,1) ) 
+      zsumemp = zsumemp / zsurf         ! Default GYRE configuration
+
+      ! freshwater (mass flux) and update of qns with heat content of emp
+      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average)
+      sfx (:,:) = 0.0_wp                                   ! no salt flux
+      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST
+
+
+      ! ---------------------------- !
+      !       momentum fluxes        !
+      ! ---------------------------- !
+      ! same wind as in Wico
+      !test date0 : ndate0 = 010203
+      zyear0  =   ndate0 / 10000
+      zmonth0 = ( ndate0 - zyear0 * 10000 ) / 100
+      zday0   =   ndate0 - zyear0 * 10000 - zmonth0 * 100
+      !Calculates nday_year, day since january 1st
+      zday_year0 = (zmonth0-1)*30.+zday0
+
+      !accumulates days of previous months of this year
+      ! day (in hours) since january the 1st
+      ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm)  &  ! incrementation in hour
+         &     - (nyear - 1) * rjjhh * zyydd          !  - nber of hours the precedent years
+      ztimemax = ((5.*30.)+21.)* 24.               ! 21th june     in hours
+      ztimemin = ztimemax + rjjhh * zyydd / 2      ! 21th december in hours
+      !                                            ! NB: rjjhh * zyydd / 4 = 1 seasonal cycle in hours
+
+      ! mean intensity at 0.105 ; srqt(2) because projected with 45deg angle
+      ztau = 0.105 / SQRT( 2. )
+      ! seasonal oscillation intensity
+      ztau_sais = 0.015
+      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           ! domain from 15deg to 50deg and 1/2 period along 14deg
+           ! so 5/4 of half period with seasonal cycle
+           utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) )
+           vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) )
+         END DO
+      END DO
+
+      ! module of wind stress and wind speed at T-point
+      zcoef = 1. / ( zrhoa * zcdrag ) 
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
+            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
+            zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
+            taum(ji,jj) = zmod
+            wndm(ji,jj) = SQRT( zmod * zcoef )
+         END DO
+      END DO
+      CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
+
+      ! ---------------------------------- !
+      !  control print at first time-step  !
+      ! ---------------------------------- !
+      IF( kt == nit000 .AND. lwp ) THEN 
+         WRITE(numout,*)
+         WRITE(numout,*)'usrdef_sbc_oce : analytical surface fluxes for GYRE configuration'               
+         WRITE(numout,*)'~~~~~~~~~~~ ' 
+         WRITE(numout,*)'           nyear      = ', nyear
+         WRITE(numout,*)'           nmonth     = ', nmonth
+         WRITE(numout,*)'           nday       = ', nday
+         WRITE(numout,*)'           nday_year  = ', nday_year
+         WRITE(numout,*)'           ztime      = ', ztime
+         WRITE(numout,*)'           ztimemax   = ', ztimemax
+         WRITE(numout,*)'           ztimemin   = ', ztimemin
+         WRITE(numout,*)'           ztimemax1  = ', ztimemax1
+         WRITE(numout,*)'           ztimemin1  = ', ztimemin1
+         WRITE(numout,*)'           ztimemax2  = ', ztimemax2
+         WRITE(numout,*)'           ztimemin2  = ', ztimemin2
+         WRITE(numout,*)'           zyear0     = ', zyear0
+         WRITE(numout,*)'           zmonth0    = ', zmonth0
+         WRITE(numout,*)'           zday0      = ', zday0
+         WRITE(numout,*)'           zday_year0 = ', zday_year0
+         WRITE(numout,*)'           zyydd      = ', zyydd
+         WRITE(numout,*)'           zemp_S     = ', zemp_S
+         WRITE(numout,*)'           zemp_N     = ', zemp_N
+         WRITE(numout,*)'           zemp_sais  = ', zemp_sais
+         WRITE(numout,*)'           zTstar     = ', zTstar
+         WRITE(numout,*)'           zsumemp    = ', zsumemp
+         WRITE(numout,*)'           zsurf      = ', zsurf
+         WRITE(numout,*)'           ztrp       = ', ztrp
+         WRITE(numout,*)'           zconv      = ', zconv
+         WRITE(numout,*)'           ndastp     = ', ndastp
+         WRITE(numout,*)'           adatrj     = ', adatrj
+      ENDIF
+      !
+   END SUBROUTINE usrdef_sbc_oce
+
+   SUBROUTINE usrdef_sbc_ice_tau( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_tau
+
+   SUBROUTINE usrdef_sbc_ice_flx( kt )
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+   END SUBROUTINE usrdef_sbc_ice_flx
+
+   !!======================================================================
+END MODULE usrdef_sbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90	(revision 8732)
@@ -0,0 +1,258 @@
+MODULE usrdef_zgr
+   !!======================================================================
+   !!                       ***  MODULE  usrdef_zgr  ***
+   !!
+   !!                       ===  GYRE configuration  ===
+   !!
+   !! User defined : vertical coordinate system of a user configuration
+   !!======================================================================
+   !! History :  4.0  ! 2016-06  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   usr_def_zgr   : user defined vertical coordinate system
+   !!      zgr_z      : reference 1D z-coordinate 
+   !!      zgr_top_bot: ocean top and bottom level indices
+   !!      zgr_zco    : 3D verticl coordinate in pure z-coordinate case
+   !!---------------------------------------------------------------------
+   USE oce            ! ocean variables
+   USE dom_oce        ! ocean domain
+   USE depth_e3       ! depth <=> e3
+   !
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! distributed memory computing library
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   usr_def_zgr        ! called by domzgr.F90
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS             
+
+   SUBROUTINE usr_def_zgr( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,    &   ! type of vertical coordinate
+      &                    pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,    &   ! 1D reference vertical coordinate
+      &                    pdept , pdepw ,                             &   ! 3D t & w-points depth
+      &                    pe3t  , pe3u  , pe3v   , pe3f ,             &   ! vertical scale factors
+      &                    pe3w  , pe3uw , pe3vw         ,             &   !     -      -      -
+      &                    k_top  , k_bot    )                             ! top & bottom ocean level
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE usr_def_zgr  ***
+      !!
+      !! ** Purpose :   User defined the vertical coordinates
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags
+      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
+      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level
+      !
+      INTEGER  ::   inum   ! local logical unit
+      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_zgr : GYRE configuration (z-coordinate closed flat box ocean without cavities)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      !
+      !
+      ! type of vertical coordinate
+      ! ---------------------------
+      ld_zco    = .TRUE.         ! GYRE case:  z-coordinate without ocean cavities
+      ld_zps    = .FALSE.
+      ld_sco    = .FALSE.
+      ld_isfcav = .FALSE.
+      !
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+      CALL zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system
+      !
+      CALL zgr_msk_top_bot( k_top , k_bot )                 ! masked top and bottom ocean t-level indices
+      !
+      !                                                     ! z-coordinate (3D arrays) from the 1D z-coord.
+      CALL zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in  : 1D reference vertical coordinate
+         &          pdept   , pdepw   ,                     &   ! out : 3D t & w-points depth
+         &          pe3t    , pe3u    , pe3v   , pe3f   ,   &   !       vertical scale factors
+         &          pe3w    , pe3uw   , pe3vw             )     !           -      -      -
+      !
+   END SUBROUTINE usr_def_zgr
+
+
+   SUBROUTINE zgr_z( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! 1D reference vertical coordinate
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!
+      !! ** Purpose :   set the 1D depth of model levels and the resulting 
+      !!              vertical scale factors.
+      !!
+      !! ** Method  :   1D z-coordinate system (use in all type of coordinate)
+      !!       The depth of model levels is set from dep(k), an analytical function:
+      !!                   w-level: depw_1d  = dep(k)
+      !!                   t-level: dept_1d  = dep(k+0.5)
+      !!       The scale factors are the discrete derivative of the depth:
+      !!                   e3w_1d(jk) = dk[ dept_1d ] 
+      !!                   e3t_1d(jk) = dk[ depw_1d ]
+      !!           with at top and bottom :
+      !!                   e3w_1d( 1 ) = 2 * ( dept_1d( 1 ) - depw_1d( 1 ) )
+      !!                   e3t_1d(jpk) = 2 * ( dept_1d(jpk) - depw_1d(jpk) )
+      !!       The depth are then re-computed from the sum of e3. This ensures 
+      !!    that depths are identical when reading domain configuration file. 
+      !!    Indeed, only e3. are saved in this file, depth are compute by a call
+      !!    to the e3_to_depth subroutine.
+      !!
+      !!       Here the Madec & Imbard (1996) function is used.
+      !!
+      !! ** Action  : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
+      !!              - pe3t_1d , pe3w_1d  : scale factors at T- and W-levels (m)
+      !!
+      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!             Madec and Imbard, 1996, Clim. Dyn.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d   ! 1D grid-point depth        [m]
+      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d    ! 1D vertical scale factors  [m]
+      !
+      INTEGER  ::   jk       ! dummy loop indices
+      REAL(wp) ::   zt, zw   ! local scalars
+      REAL(wp) ::   zsur, za0, za1, zkth, zacr   ! Values for the Madec & Imbard (1996) function  
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_z')
+      !
+      ! Set parameters of z(k) function
+      ! -------------------------------
+      zsur = -2033.194295283385_wp       
+      za0  =   155.8325369664153_wp 
+      za1  =   146.3615918601890_wp
+      zkth =    17.28520372419791_wp   
+      zacr =     5.0_wp       
+      !
+      IF(lwp) THEN            ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates '
+         WRITE(numout,*) '    ~~~~~~~'
+         WRITE(numout,*) '       GYRE case : MI96 function with the following coefficients :'
+         WRITE(numout,*) '                 zsur = ', zsur
+         WRITE(numout,*) '                 za0  = ', za0
+         WRITE(numout,*) '                 za1  = ', za1
+         WRITE(numout,*) '                 zkth = ', zkth
+         WRITE(numout,*) '                 zacr = ', zacr
+      ENDIF
+
+      !
+      ! 1D Reference z-coordinate    (using Madec & Imbard 1996 function)
+      ! -------------------------
+      !
+      DO jk = 1, jpk          ! depth at T and W-points
+         zw = REAL( jk , wp )
+         zt = REAL( jk , wp ) + 0.5_wp
+         pdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr *  LOG( COSH( (zw-zkth) / zacr ) )  )
+         pdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr *  LOG( COSH( (zt-zkth) / zacr ) )  )
+      END DO
+      !
+      !                       ! e3t and e3w from depth
+      CALL depth_to_e3( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d ) 
+      !
+      !                       ! recompute depths from SUM(e3)  <== needed
+      CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d ) 
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_z')
+      !
+   END SUBROUTINE zgr_z
+
+
+   SUBROUTINE zgr_msk_top_bot( k_top , k_bot )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_msk_top_bot  ***
+      !!
+      !! ** Purpose :   set the masked top and bottom ocean t-levels
+      !!
+      !! ** Method  :   GYRE case = closed flat box ocean without ocean cavities
+      !!                   k_top = 1     except along north, south, east and west boundaries
+      !!                   k_bot = jpk-1 except along north, south, east and west boundaries
+      !!
+      !! ** Action  : - k_top : first wet ocean level index
+      !!              - k_bot : last  wet ocean level index
+      !!----------------------------------------------------------------------
+      INTEGER , DIMENSION(:,:), INTENT(out) ::   k_top , k_bot   ! first & last wet ocean level
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_top_bot : defines the top and bottom wet ocean levels.'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities'
+      !
+      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom
+      !
+      CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
+      !
+      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere
+      !
+      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere
+      !
+   END SUBROUTINE zgr_msk_top_bot
+   
+
+   SUBROUTINE zgr_zco( pdept_1d, pdepw_1d, pe3t_1d, pe3w_1d,   &   ! in : 1D reference vertical coordinate
+      &                pdept   , pdepw   ,                     &   ! out: 3D t & w-points depth
+      &                pe3t    , pe3u    , pe3v   , pe3f   ,   &   !      vertical scale factors
+      &                pe3w    , pe3uw   , pe3vw             )     !          -      -      -
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the reference z-coordinate system
+      !!
+      !! ** Method  :   set 3D coord. arrays to reference 1D array 
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m]
+      REAL(wp), DIMENSION(:)    , INTENT(in   ) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth          [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      -
+      !
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zco')
+      !
+      DO jk = 1, jpk
+         pdept(:,:,jk) = pdept_1d(jk)
+         pdepw(:,:,jk) = pdepw_1d(jk)
+         pe3t (:,:,jk) = pe3t_1d (jk)
+         pe3u (:,:,jk) = pe3t_1d (jk)
+         pe3v (:,:,jk) = pe3t_1d (jk)
+         pe3f (:,:,jk) = pe3t_1d (jk)
+         pe3w (:,:,jk) = pe3w_1d (jk)
+         pe3uw(:,:,jk) = pe3w_1d (jk)
+         pe3vw(:,:,jk) = pe3w_1d (jk)
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zco')
+      !
+   END SUBROUTINE zgr_zco
+
+   !!======================================================================
+END MODULE usrdef_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 8732)
@@ -0,0 +1,76 @@
+MODULE zdf_oce
+   !!======================================================================
+   !!              ***  MODULE  zdf_oce  ***
+   !! Ocean physics : define vertical mixing variables
+   !!=====================================================================
+   !! history :  1.0  !  2002-06  (G. Madec) Original code
+   !!            3.2  !  2009-07  (G.Madec) addition of avm
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  zdf_oce_alloc    ! Called in nemogcm.F90
+
+#if defined key_zdfcst
+   LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .TRUE.         !: constant vertical mixing flag
+#else
+   LOGICAL, PARAMETER, PUBLIC ::   lk_zdfcst        = .FALSE.        !: constant vertical mixing flag
+#endif
+
+   !                                 !!* namelist namzdf: vertical diffusion *
+   REAL(wp), PUBLIC ::   rn_avm0     !: vertical eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_avt0     !: vertical eddy diffusivity (m2/s)
+   INTEGER , PUBLIC ::   nn_avb      !: constant or profile background on avt (=0/1)
+   INTEGER , PUBLIC ::   nn_havtb    !: horizontal shape or not for avtb (=0/1)
+   LOGICAL , PUBLIC ::   ln_zdfexp   !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_zdfexp   !: number of sub-time step (explicit time stepping)
+   LOGICAL , PUBLIC ::   ln_zdfevd   !: convection: enhanced vertical diffusion flag
+   INTEGER , PUBLIC ::   nn_evdm     !: =0/1 flag to apply enhanced avm or not
+   REAL(wp), PUBLIC ::   rn_avevd    !: vertical eddy coeff. for enhanced vert. diff. (m2/s)
+   LOGICAL , PUBLIC ::   ln_zdfnpc   !: convection: non-penetrative convection flag
+   INTEGER , PUBLIC ::   nn_npc      !: non penetrative convective scheme call  frequency
+   INTEGER , PUBLIC ::   nn_npcp     !: non penetrative convective scheme print frequency
+   LOGICAL , PUBLIC ::   ln_zdfqiao  !: Enhanced wave vertical mixing Qiao(2010) formulation flag
+
+
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::   avmb , avtb    !: background profile of avm and avt
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   avtb_2d        !: horizontal shape of background Kz profile
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   tfrua, tfrva   !: top friction coefficients set in zdfbfr
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s]
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en              !: now turbulent kinetic energy   [m2/s2]
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!            *** FUNCTION zdf_oce_alloc ***
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE(avmb(jpk) , bfrua(jpi,jpj) ,                         &
+         &     avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) ,      &
+         &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      &
+         &     avmu  (jpi,jpj,jpk), avm   (jpi,jpj,jpk)      ,      &
+         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk)      ,      &
+         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      & 
+         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      &
+         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc )
+         !
+      IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION zdf_oce_alloc
+
+   !!======================================================================
+END MODULE zdf_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 8732)
@@ -0,0 +1,486 @@
+MODULE zdfbfr
+   !!======================================================================
+   !!                       ***  MODULE  zdfbfr  ***
+   !! Ocean physics: Bottom friction
+   !!======================================================================
+   !! History :  OPA  ! 1997-06  (G. Madec, A.-M. Treguier)  Original code
+   !!   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
+   !!            3.4  ! 2011-11  (H. Liu) implementation of semi-implicit bottom friction option
+   !!                 ! 2012-06  (H. Liu) implementation of Log Layer bottom friction option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_bfr      : update bottom friction coefficient (non-linear bottom friction only)
+   !!   zdf_bfr_init : read in namelist and control the bottom friction parameters.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+   USE prtctl          ! Print control
+   USE timing          ! Timing
+   USE wrk_nemo        ! Memory Allocation
+   USE phycst, ONLY: vkarmn
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_bfr         ! called by step.F90
+   PUBLIC   zdf_bfr_init    ! called by nemogcm.F90
+
+   !                                 !!* Namelist nambfr: bottom friction namelist *
+   INTEGER , PUBLIC ::   nn_bfr       ! = 0/1/2/3 type of bottom friction  (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfri1     ! bottom drag coefficient (linear case)  (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfri2     ! bottom drag coefficient (non linear case) (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfri2_max ! Maximum bottom drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfeb2     ! background bottom turbulent kinetic energy  [m2/s2] (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfrien    ! local factor to enhance coefficient bfri (PUBLIC for TAM)
+   LOGICAL , PUBLIC ::   ln_bfr2d     ! logical switch for 2D enhancement (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_tfri1     ! top drag coefficient (linear case)  (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_tfri2     ! top drag coefficient (non linear case) (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_tfri2_max ! Maximum top drag coefficient (non linear case and ln_loglayer=T) (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_tfeb2     ! background top turbulent kinetic energy  [m2/s2] (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_tfrien    ! local factor to enhance coefficient tfri (PUBLIC for TAM)
+   LOGICAL , PUBLIC ::   ln_tfr2d     ! logical switch for 2D enhancement (PUBLIC for TAM)
+
+   LOGICAL , PUBLIC ::   ln_loglayer  ! switch for log layer bfr coeff. (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_bfrz0     ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
+   REAL(wp), PUBLIC ::   rn_tfrz0     ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM)
+   LOGICAL , PUBLIC ::   ln_bfrimp    ! logical switch for implicit bottom friction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d, tfrcoef2d   ! 2D bottom/top drag coefficient (PUBLIC for TAM)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_bfr_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_bfr_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_bfr_alloc )
+      IF( zdf_bfr_alloc /= 0 )   CALL ctl_warn('zdf_bfr_alloc: failed to allocate arrays.')
+   END FUNCTION zdf_bfr_alloc
+
+
+   SUBROUTINE zdf_bfr( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_bfr  ***
+      !!
+      !! ** Purpose :   compute the bottom friction coefficient.
+      !!
+      !! ** Method  :   Calculate and store part of the momentum trend due
+      !!              to bottom friction following the chosen friction type
+      !!              (free-slip, linear, or quadratic). The component
+      !!              calculated here is multiplied by the bottom velocity in
+      !!              dyn_bfr to provide the trend term.
+      !!                The coefficients are updated at each time step only
+      !!              in the quadratic case.
+      !!
+      !! ** Action  :   bfrua , bfrva   bottom friction coefficients
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj                       ! dummy loop indices
+      INTEGER  ::   ikbt, ikbu, ikbv             ! local integers
+      REAL(wp) ::   zvu, zuv, zecu, zecv, ztmp   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zbfrt, ztfrt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_bfr')
+      !
+      IF( nn_bfr == 2 ) THEN                 ! quadratic bottom friction only
+         !
+         CALL wrk_alloc( jpi, jpj, zbfrt, ztfrt )
+
+         IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient
+
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ikbt = mbkt(ji,jj)
+!! JC: possible WAD implementation should modify line below if layers vanish
+                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                  zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
+                  zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max)
+               END DO
+            END DO
+! (ISF)
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ikbt = mikt(ji,jj)
+! JC: possible WAD implementation should modify line below if layers vanish
+                     ztmp = (1.-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                     ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
+                     ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
+                  END DO
+               END DO
+            END IF
+            !   
+         ELSE
+            zbfrt(:,:) = bfrcoef2d(:,:)
+            ztfrt(:,:) = tfrcoef2d(:,:)
+         ENDIF
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               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  ,ikbu) + vn(ji+1,jj  ,ikbu)     &
+                  &           + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu)  )
+               zuv  = 0.25 * (  un(ji,jj  ,ikbv) + un(ji-1,jj  ,ikbv)     &
+                  &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  )
+               !
+               zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2  )
+               zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2  )
+               !
+               bfrua(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) ) * zecu
+               bfrva(ji,jj) = - 0.5_wp * ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) ) * zecv
+               !
+               ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
+               IF ( ln_isfcav ) THEN
+                  IF ( miku(ji,jj) + 1  >=  mbku(ji,jj) ) THEN
+                     bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) )   &
+                                  &            + ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) ) &
+                                  &          * zecu * (1._wp - umask(ji,jj,1))
+                  ENDIF
+                  IF( mikv(ji,jj) + 1  >=  mbkv(ji,jj) ) THEN
+                     bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) )   &
+                                  &            + ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) ) &
+                                  &          * zecv * (1._wp - vmask(ji,jj,1))
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition
+
+         IF( ln_isfcav ) THEN
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  ! (ISF) ========================================================================
+                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points 
+                  ikbv = mikv(ji,jj)         ! (1st wet ocean u- and v-points)
+                  !
+                  zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     &
+                     &           + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu)  )
+                  zuv  = 0.25 * (  un(ji,jj  ,ikbv) + un(ji-1,jj  ,ikbv)     &
+                     &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  )
+              !
+                  zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 )
+                  zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 )
+              !
+                  tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) * zecu * (1._wp - umask(ji,jj,1))
+                  tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
+              ! (ISF) END ====================================================================
+              ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
+                  IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
+                     tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) )   &
+                                  &            + ( zbfrt(ji,jj) + zbfrt(ji+1,jj  ) ) ) &
+                                  &          * zecu * (1._wp - umask(ji,jj,1))
+                  END IF
+                  IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
+                     tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji  ,jj+1) )   &
+                                  &            + ( zbfrt(ji,jj) + zbfrt(ji  ,jj+1) ) ) &
+                                  &          * zecv * (1._wp - vmask(ji,jj,1))
+                  END IF
+               END DO
+            END DO
+            CALL lbc_lnk( tfrua, 'U', 1. )   ;   CALL lbc_lnk( tfrva, 'V', 1. )      ! Lateral boundary condition
+         END IF
+         !
+         !
+         IF(ln_ctl)   CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  - u: ', mask1=umask,        &
+            &                       tab2d_2=bfrva, clinfo2=       ' v: ', mask2=vmask,ovlap=1 )
+         CALL wrk_dealloc( jpi,jpj,zbfrt, ztfrt )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_bfr')
+      !
+   END SUBROUTINE zdf_bfr
+
+
+   SUBROUTINE zdf_bfr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_bfr_init  ***
+      !!
+      !! ** Purpose :   Initialization of the bottom friction
+      !!
+      !! ** Method  :   Read the nambfr namelist and check their consistency
+      !!                called at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      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   ::   ikbt, ikbu, ikbv   ! temporary integers
+      INTEGER   ::   ictu, ictv         !    -          -
+      INTEGER   ::   ios
+      REAL(wp)  ::   zminbfr, zmaxbfr   ! temporary scalars
+      REAL(wp)  ::   zmintfr, zmaxtfr   ! temporary scalars
+      REAL(wp)  ::   ztmp, zfru, zfrv   !    -         -
+      !!
+      NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfri2_max, rn_bfeb2, rn_bfrz0, ln_bfr2d, &
+                    &          rn_tfri1, rn_tfri2, rn_tfri2_max, rn_tfeb2, rn_tfrz0, ln_tfr2d, &
+                    &  rn_bfrien, rn_tfrien, ln_bfrimp, ln_loglayer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_bfr_init')
+      !
+      !                              !* Allocate zdfbfr arrays
+      IF( zdf_bfr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' )
+      !
+      !                              !* Parameter control and print
+      !
+      REWIND( numnam_ref )              ! Namelist nambfr in reference namelist : Bottom momentum boundary condition
+      READ  ( numnam_ref, nambfr, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist nambfr in configuration namelist : Bottom momentum boundary condition
+      READ  ( numnam_cfg, nambfr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nambfr )
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '   Namelist nam_bfr : set bottom friction parameters'
+      !
+      SELECT CASE (nn_bfr)
+      !
+      CASE( 0 )
+         IF(lwp) WRITE(numout,*) '      free-slip '
+         bfrua(:,:) = 0._wp
+         bfrva(:,:) = 0._wp
+         tfrua(:,:) = 0._wp
+         tfrva(:,:) = 0._wp
+         !
+      CASE( 1 )
+         IF(lwp) WRITE(numout,*) '      linear botton friction'
+         IF(lwp) WRITE(numout,*) '      bottom friction coef.   rn_bfri1  = ', rn_bfri1
+         IF( ln_bfr2d ) THEN
+            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_bfr2d  = ', ln_bfr2d
+            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien
+         ENDIF
+         IF ( ln_isfcav ) THEN
+            IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_tfri1
+            IF( ln_tfr2d ) THEN
+               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d
+               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien
+            ENDIF
+         END IF
+         !
+         IF(ln_bfr2d) THEN
+            ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+            CALL iom_open('bfr_coef.nc',inum)
+            CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
+            CALL iom_close(inum)
+            bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
+         ELSE
+            bfrcoef2d(:,:) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable
+         ENDIF
+         !
+         bfrua(:,:) = - bfrcoef2d(:,:)
+         bfrva(:,:) = - bfrcoef2d(:,:)
+         !
+         IF ( ln_isfcav ) THEN
+            IF(ln_tfr2d) THEN
+               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+               CALL iom_open('tfr_coef.nc',inum)
+               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
+               CALL iom_close(inum)
+               tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
+            ELSE
+               tfrcoef2d(:,:) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable
+            ENDIF
+            !
+            tfrua(:,:) = - tfrcoef2d(:,:)
+            tfrva(:,:) = - tfrcoef2d(:,:)
+         END IF
+         !
+      CASE( 2 )
+         IF(lwp) WRITE(numout,*) '      quadratic bottom friction'
+         IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri2  = ', rn_bfri2
+         IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_bfri2_max  = ', rn_bfri2_max
+         IF(lwp) WRITE(numout,*) '      background tke   rn_bfeb2  = ', rn_bfeb2
+         IF(lwp) WRITE(numout,*) '      log formulation   ln_bfr2d = ', ln_loglayer
+         IF(lwp) WRITE(numout,*) '      bottom roughness  rn_bfrz0 [m] = ', rn_bfrz0
+         IF( rn_bfrz0 <= 0._wp ) THEN
+            WRITE(ctmp1,*) '      bottom roughness must be strictly positive'
+            CALL ctl_stop( ctmp1 )
+         ENDIF
+         IF( ln_bfr2d ) THEN
+            IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_bfr2d  = ', ln_bfr2d
+            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien
+         ENDIF
+         IF ( ln_isfcav ) THEN
+            IF(lwp) WRITE(numout,*) '      quadratic top    friction'
+            IF(lwp) WRITE(numout,*) '      friction coef.    rn_tfri2     = ', rn_tfri2
+            IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max
+            IF(lwp) WRITE(numout,*) '      background tke    rn_tfeb2     = ', rn_tfeb2
+            IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d     = ', ln_loglayer
+            IF(lwp) WRITE(numout,*) '      top roughness     rn_tfrz0 [m] = ', rn_tfrz0
+            IF( rn_tfrz0 <= 0._wp ) THEN
+               WRITE(ctmp1,*) '      top roughness must be strictly positive'
+               CALL ctl_stop( ctmp1 )
+            ENDIF
+            IF( ln_tfr2d ) THEN
+               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d
+               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien
+            ENDIF
+         END IF
+         !
+         IF(ln_bfr2d) THEN
+            ! bfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+            CALL iom_open('bfr_coef.nc',inum)
+            CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array
+            CALL iom_close(inum)
+            !
+            bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) )
+         ELSE
+            bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable
+         ENDIF
+         
+         IF ( ln_isfcav ) THEN
+            IF(ln_tfr2d) THEN
+               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+               CALL iom_open('tfr_coef.nc',inum)
+               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
+               CALL iom_close(inum)
+               !
+               tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
+            ELSE
+               tfrcoef2d(:,:) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable
+            ENDIF
+         END IF
+         !
+         IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ikbt = mbkt(ji,jj)
+                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+                  bfrcoef2d(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
+                  bfrcoef2d(ji,jj) = MIN(bfrcoef2d(ji,jj), rn_bfri2_max)
+               END DO
+            END DO
+            IF ( ln_isfcav ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ikbt = mikt(ji,jj)
+                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
+                     tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
+                     tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
+                  END DO
+               END DO
+            END IF
+         ENDIF
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(ctmp1,*) '         bad flag value for nn_bfr = ', nn_bfr
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+      IF(lwp) WRITE(numout,*) '      implicit bottom friction switch                ln_bfrimp  = ', ln_bfrimp
+      !
+      !                              ! Make sure ln_zdfexp=.false. when use implicit bfr
+      IF( ln_bfrimp .AND. ln_zdfexp ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.'
+            WRITE(numout,*) '         but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!'
+            WRITE(ctmp1,*)  '         set either ln_zdfexp = .false or ln_bfrimp = .false.'
+            CALL ctl_stop( ctmp1 )
+         END IF
+      END IF
+      !
+      ! Basic stability check on bottom friction coefficient
+      !
+      ictu = 0               ! counter for stability criterion breaches at U-pts
+      ictv = 0               ! counter for stability criterion breaches at V-pts
+      zminbfr =  1.e10_wp    ! initialise tracker for minimum of bottom friction coefficient
+      zmaxbfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient
+      zmintfr =  1.e10_wp    ! initialise tracker for minimum of bottom friction coefficient
+      zmaxtfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient
+      !
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points
+             ikbv = mbkv(ji,jj)
+             zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt
+             zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt
+             IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
+                IF( ln_ctl ) THEN
+                   WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
+                   WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
+                ENDIF
+                ictu = ictu + 1
+             ENDIF
+             IF( ABS( bfrcoef2d(ji,jj) ) > zfrv ) THEN
+                 IF( ln_ctl ) THEN
+                     WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbv
+                     WRITE(numout,*) 'BFR ', bfrcoef2d(ji,jj), zfrv
+                 ENDIF
+                 ictv = ictv + 1
+             ENDIF
+             zminbfr = MIN(  zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) )  )
+             zmaxbfr = MAX(  zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) )  )
+! (ISF)
+             IF ( ln_isfcav ) THEN
+                ikbu = miku(ji,jj)       ! 1st wet ocean level at u- and v-points
+                ikbv = mikv(ji,jj)
+                zfru = 0.5 * e3u_n(ji,jj,ikbu) / rdt
+                zfrv = 0.5 * e3v_n(ji,jj,ikbv) / rdt
+                IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
+                   IF( ln_ctl ) THEN
+                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu
+                      WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru
+                   ENDIF
+                   ictu = ictu + 1
+                ENDIF
+                IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN
+                   IF( ln_ctl ) THEN
+                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv
+                      WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv
+                   ENDIF
+                   ictv = ictv + 1
+                ENDIF
+                zmintfr = MIN(  zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) )  )
+                zmaxtfr = MAX(  zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) )  )
+             END IF
+! END ISF
+         END DO
+      END DO
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( ictu )
+         CALL mpp_sum( ictv )
+         CALL mpp_min( zminbfr )
+         CALL mpp_max( zmaxbfr )
+         IF ( ln_isfcav) CALL mpp_min( zmintfr )
+         IF ( ln_isfcav) CALL mpp_max( zmaxtfr )
+      ENDIF
+      IF( .NOT.ln_bfrimp) THEN
+      IF( lwp .AND. ictu + ictv > 0 ) THEN
+         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points '
+         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points '
+         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
+         IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
+         WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary'
+      ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_bfr_init')
+      !
+   END SUBROUTINE zdf_bfr_init
+
+   !!======================================================================
+END MODULE zdfbfr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 8732)
@@ -0,0 +1,277 @@
+MODULE zdfddm
+   !!======================================================================
+   !!                       ***  MODULE  zdfddm  ***
+   !! Ocean physics : double diffusion mixing parameterization
+   !!======================================================================
+   !! 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
+   !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta
+   !!----------------------------------------------------------------------
+#if defined key_zdfddm
+   !!----------------------------------------------------------------------
+   !!   'key_zdfddm' :                                     double diffusion
+   !!----------------------------------------------------------------------
+   !!   zdf_ddm       : compute the Ks for salinity
+   !!   zdf_ddm_init  : read namelist and control the parameters
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE eosbn2         ! equation of state
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_ddm       ! called by step.F90
+   PUBLIC   zdf_ddm_init  ! called by opa.F90
+   PUBLIC   zdf_ddm_alloc ! called by nemogcm.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag
+
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs   !: salinity vertical diffusivity coeff. at w-point
+
+   !                       !!* Namelist namzdf_ddm : double diffusive mixing *
+   REAL(wp) ::   rn_avts    ! maximum value of avs for salt fingering
+   REAL(wp) ::   rn_hsbfr   ! heat/salt buoyancy flux ratio
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_ddm_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_ddm_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc )
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc )
+      IF( zdf_ddm_alloc /= 0 )   CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays')
+   END FUNCTION zdf_ddm_alloc
+
+
+   SUBROUTINE zdf_ddm( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_ddm  ***
+      !!                    
+      !! ** Purpose :   Add to the vertical eddy diffusivity coefficient the 
+      !!              effect of salt fingering and diffusive convection. 
+      !!
+      !! ** Method  :   Diapycnal mixing is increased in case of double
+      !!      diffusive mixing (i.e. salt fingering and diffusive layering)
+      !!      following Merryfield et al. (1999). The rate of double diffusive 
+      !!      mixing depend on the buoyancy ratio (R=alpha/beta dk[T]/dk[S]):
+      !!         * salt fingering (Schmitt 1981):
+      !!      for R > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (R/rn_hsbfr)^6 )
+      !!      for R > 1 and rn2 > 0 : zavfs = O
+      !!      otherwise                : zavft = 0.7 zavs / R
+      !!         * diffusive layering (Federov 1988):
+      !!      for 0< R < 1 and N^2 > 0 : zavdt = 1.3635e-6 * exp( 4.6 exp(-0.54 (1/R-1) ) )
+      !!      otherwise                   : zavdt = 0 
+      !!      for .5 < R < 1 and N^2 > 0 : zavds = zavdt (1.885 R -0.85)
+      !!      for  0 < R <.5 and N^2 > 0 : zavds = zavdt 0.15 R      
+      !!      otherwise                     : zavds = 0 
+      !!         * update the eddy diffusivity:
+      !!      avt = avt + zavft + zavdt
+      !!      avs = avs + zavfs + zavds
+      !!      avmu, avmv are required to remain at least above avt and avs.
+      !!      
+      !! ** Action  :   avt, avs : updated vertical eddy diffusivity coef. for T & S
+      !!
+      !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step indexocean time step
+      !
+      INTEGER  ::   ji, jj , jk     ! dummy loop indices
+      REAL(wp) ::   zaw, zbw, zrw   ! local scalars
+      REAL(wp) ::   zdt, zds
+      REAL(wp) ::   zinr, zrr       !   -      -
+      REAL(wp) ::   zavft, zavfs    !   -      -
+      REAL(wp) ::   zavdt, zavds    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_ddm')
+      !
+      CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
+      !
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Define the mask 
+         ! ---------------
+         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s])
+            DO ji = 1, jpi
+               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
+               !
+               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  &
+                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  &
+                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+               !
+               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )
+               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 
+               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp
+               zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau
+            END DO
+         END DO
+
+         DO jj = 1, jpj                                     ! indicators:
+            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._wp
+               ELSE                                       ;   zmsks(ji,jj) = 1._wp
+               ENDIF
+               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere            
+               IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp
+               ELSE                                       ;   zmskf(ji,jj) = 1._wp
+               ENDIF
+               ! diffusive layering indicators: 
+               !     ! mskdl1=1 if 0< R <1; 0 elsewhere
+               IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp
+               ELSE                                       ;   zmskd1(ji,jj) = 1._wp
+               ENDIF
+               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere
+               IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp
+               ELSE                                       ;   zmskd2(ji,jj) = 1._wp
+               ENDIF
+               !   mskdl3=1 if 0.5< R <1; 0 elsewhere
+               IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp
+               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp
+               ENDIF
+            END DO
+         END DO
+         ! mask zmsk in order to have avt and avs masked
+         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk)
+
+
+         ! Update avt and avs
+         ! ------------------
+         ! Constant eddy coefficient: reset to the background value
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zinr = 1._wp / zrau(ji,jj)
+               ! salt fingering
+               zrr = zrau(ji,jj) / rn_hsbfr
+               zrr = zrr * zrr
+               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj)
+               zavft = 0.7 * zavfs * zinr
+               ! diffusive layering
+               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj)
+               zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   &
+                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  )
+               ! add to the eddy viscosity coef. previously computed
+# if defined key_zdftmx_new
+               ! key_zdftmx_new: New internal wave-driven param: use avs value computed by zdftmx
+               avs (ji,jj,jk) = avs(ji,jj,jk) + zavfs + zavds
+# else
+               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds
+# endif
+               avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt
+               avm (ji,jj,jk) = avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
+            END DO
+         END DO
+
+
+         ! Increase avmu, avmv if necessary
+         ! --------------------------------
+!!gm to be changed following the definition of avm.
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    &
+                  &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   &
+                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    &
+                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   &
+                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * wvmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                                ! ===============
+      END DO                                              !   End of slab
+      !                                                   ! ===============
+      !
+      CALL lbc_lnk( avt , 'W', 1._wp )     ! Lateral boundary conditions   (unchanged sign)
+      CALL lbc_lnk( avs , 'W', 1._wp )
+      CALL lbc_lnk( avm , 'W', 1._wp )
+      CALL lbc_lnk( avmu, 'U', 1._wp ) 
+      CALL lbc_lnk( avmv, 'V', 1._wp )
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm  - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl(tab3d_1=avmu, clinfo1=' ddm  - u: ', mask1=umask, &
+            &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm')
+      !
+   END SUBROUTINE zdf_ddm
+   
+   
+   SUBROUTINE zdf_ddm_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_ddm_init  ***
+      !!
+      !! ** Purpose :   Initialization of double diffusion mixing scheme
+      !!
+      !! ** Method  :   Read the namzdf_ddm namelist and check the parameter values
+      !!              called by zdf_ddm at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios   ! local integer
+      !!
+      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_ddm in reference namelist : Double diffusion mixing scheme
+      READ  ( numnam_ref, namzdf_ddm, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf_ddm in configuration namelist : Double diffusion mixing scheme
+      READ  ( numnam_cfg, namzdf_ddm, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_ddm )
+      !
+      IF(lwp) THEN                    ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_ddm : double diffusive mixing'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_ddm : set dd mixing parameter'
+         WRITE(numout,*) '      maximum avs for dd mixing      rn_avts   = ', rn_avts
+         WRITE(numout,*) '      heat/salt buoyancy flux ratio  rn_hsbfr  = ', rn_hsbfr
+      ENDIF
+      !
+      !                               ! allocate zdfddm arrays
+      IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' )
+      !                               ! initialization to masked Kz
+      avs(:,:,:) = rn_avt0 * wmask(:,:,:) 
+      !
+   END SUBROUTINE zdf_ddm_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :          Dummy module          No double diffusion
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .FALSE.   !: double diffusion flag
+CONTAINS
+   SUBROUTINE zdf_ddm( kt )           ! Dummy routine
+      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
+
+   !!======================================================================
+END MODULE zdfddm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 8732)
@@ -0,0 +1,18 @@
+   !!----------------------------------------------------------------------
+   !!                    *** zdfddm_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_zdfddm  && ! defined key_offline
+!   'key_zdfddm' :                      avs: 3D array defined in zdfddm module
+#   define   fsavs(i,j,k)       avs(i,j,k)
+#else
+!   Defautl option :                     avs = avt
+#   define   fsavs(i,j,k)       avt(i,j,k)
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 8732)
@@ -0,0 +1,124 @@
+MODULE zdfevd
+   !!======================================================================
+   !!                       ***  MODULE  zdfevd  ***
+   !! Ocean physics: parameterization of convection through an enhancement
+   !!                of vertical eddy mixing coefficient
+   !!======================================================================
+   !! History :  OPA  !  1997-06  (G. Madec, A. Lazar)  Original code
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2009-03  (M. Leclair, G. Madec, R. Benshila) test on both before & after
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_evd       : increase the momentum and tracer Kz at the location of
+   !!                   statically unstable portion of the water column (ln_zdfevd=T)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics variables
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! for iom_put
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_evd    ! called by step.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zdf_evd( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_evd  ***
+      !!                   
+      !! ** Purpose :   Local increased the vertical eddy viscosity and diffu-
+      !!      sivity coefficients when a static instability is encountered.
+      !!
+      !! ** Method  :   avt, avm, and the 4 neighbouring avmu, avmv coefficients
+      !!      are set to avevd (namelist parameter) if the water column is 
+      !!      statically unstable (i.e. if rn2 < -1.e-12 )
+      !!
+      !! ** Action  :   avt, avm, avmu, avmv updted in static instability cases
+      !!
+      !! References :   Lazar, A., these de l'universite Paris VI, France, 1997
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_evd')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd ) 
+      !
+      zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application
+      !
+      SELECT CASE ( nn_evdm )
+      !
+      CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12)
+         !
+         zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application
+         !
+         DO jk = 1, jpkm1 
+            DO jj = 2, jpj             ! no vector opt.
+               DO ji = 2, jpi
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
+                     avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
+                     avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
+                     avmu(ji  ,jj  ,jk) = rn_avevd * umask(ji  ,jj  ,jk)
+                     avmu(ji-1,jj  ,jk) = rn_avevd * umask(ji-1,jj  ,jk)
+                     avmv(ji  ,jj  ,jk) = rn_avevd * vmask(ji  ,jj  ,jk)
+                     avmv(ji  ,jj-1,jk) = rn_avevd * vmask(ji  ,jj-1,jk)
+                  ENDIF
+               END DO
+            END DO
+         END DO 
+         CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+         !
+         zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd
+         CALL iom_put( "avm_evd", zavm_evd )              ! output this change
+         !
+      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 
+         DO jk = 1, jpkm1
+!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL! 
+            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
+               DO ji = 1, jpi
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
+                     avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT 
+
+      zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd
+      CALL iom_put( "avt_evd", zavt_evd )              ! output this change
+      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zavt_evd, zavm_evd ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_evd')
+      !
+   END SUBROUTINE zdf_evd
+
+   !!======================================================================
+END MODULE zdfevd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 8732)
@@ -0,0 +1,1234 @@
+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
+   !!----------------------------------------------------------------------
+   !!   '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 zdfbfr         ! bottom friction (only for rn_bfrz0)
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE phycst         ! physical constants
+   USE zdfmxl         ! mixed layer
+   USE sbcwave ,  ONLY: hsw   ! significant wave height
+   !
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP manager
+   USE wrk_nemo       ! work arrays
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   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, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
+
+   !                              !! ** Namelist  namzdf_gls  **
+   LOGICAL  ::   ln_length_lim     ! use limit on the dissipation rate under stable stratification (Galperin et al. 1988)
+   LOGICAL  ::   ln_sigpsi         ! Activate Burchard (2003) modification for k-eps closure & wave breaking mixing
+   INTEGER  ::   nn_bc_surf        ! surface boundary condition (=0/1)
+   INTEGER  ::   nn_bc_bot         ! bottom boundary condition (=0/1)
+   INTEGER  ::   nn_z0_met         ! Method for surface roughness computation
+   INTEGER  ::   nn_stab_func      ! stability functions G88, KC or Canuto (=0/1/2)
+   INTEGER  ::   nn_clos           ! closure 0/1/2/3 MY82/k-eps/k-w/gen
+   REAL(wp) ::   rn_clim_galp      ! Holt 2008 value for k-eps: 0.267
+   REAL(wp) ::   rn_epsmin         ! minimum value of dissipation (m2/s3)
+   REAL(wp) ::   rn_emin           ! minimum value of TKE (m2/s2)
+   REAL(wp) ::   rn_charn          ! Charnock constant for surface breaking waves mixing : 1400. (standard) or 2.e5 (Stacey value)
+   REAL(wp) ::   rn_crban          ! Craig and Banner constant for surface breaking waves mixing
+   REAL(wp) ::   rn_hsro           ! Minimum surface roughness
+   REAL(wp) ::   rn_frac_hs        ! Fraction of wave height as surface roughness (if nn_z0_met > 1) 
+
+   REAL(wp) ::   rcm_sf        =  0.73_wp     ! Shear free turbulence parameters
+   REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1 
+   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) ::   rtrans        =  0.1_wp
+   REAL(wp) ::   rc02, rc02r, rc03, rc04                          ! coefficients deduced from above parameters
+   REAL(wp) ::   rsbc_tke1, rsbc_tke2, rfact_tke                  !     -           -           -        -
+   REAL(wp) ::   rsbc_psi1, rsbc_psi2, rfact_psi                  !     -           -           -        -
+   REAL(wp) ::   rsbc_zs1, rsbc_zs2                               !     -           -           -        -
+   REAL(wp) ::   rc0, rc2, rc3, rf6, rcff, rc_diff                !     -           -           -        -
+   REAL(wp) ::   rs0, rs1, rs2, rs4, rs5, rs6                     !     -           -           -        -
+   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 "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_gls_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_gls_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     &
+         &      ustars2(jpi,jpj) , ustarb2(jpi,jpj)   , STAT= zdf_gls_alloc )
+         !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc )
+      IF( zdf_gls_alloc /= 0 )   CALL ctl_warn('zdf_gls_alloc: failed to allocate arrays')
+   END FUNCTION zdf_gls_alloc
+
+
+   SUBROUTINE zdf_gls( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_gls  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!              coefficients using the GLS turbulent closure scheme.
+      !!----------------------------------------------------------------------
+      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), POINTER, DIMENSION(:,:  ) ::   zdep
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zkar
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zflxs       ! Turbulence fluxed induced by internal waves 
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhsro       ! Surface roughness (surface waves)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eb          ! tke at time before
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   mxlb        ! mixing length at time before
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   shear       ! vertical shear
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eps         ! dissipation rate
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   psi         ! psi at time now
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_a    ! element of the first  matrix diagonal
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_b    ! element of the second matrix diagonal
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_c    ! element of the third  matrix diagonal
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_gls')
+      !
+      CALL wrk_alloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_alloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi  )
+      
+      ! Preliminary computing
+
+      ustars2 = 0._wp   ;   ustarb2 = 0._wp   ;   psi  = 0._wp   ;   zwall_psi = 0._wp
+
+      IF( kt /= nit000 ) THEN   ! restore before value to compute tke
+         avt (:,:,:) = avt_k (:,:,:)
+         avm (:,:,:) = avm_k (:,:,:)
+         avmu(:,:,:) = avmu_k(:,:,:)
+         avmv(:,:,:) = avmv_k(:,:,:) 
+      ENDIF
+
+      ! Compute surface and bottom friction at T-points
+      DO jj = 2, jpjm1          
+         DO ji = fs_2, fs_jpim1   ! vector opt.         
+            !
+            ! surface friction
+            ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
+            !   
+            ! bottom friction (explicit before friction)        
+            ! Note that we chose here not to bound the friction as in dynbfr)   
+            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &         
+               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )      
+            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &         
+               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )      
+            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)         
+         END DO         
+      END DO    
+
+      ! Set surface roughness length
+      SELECT CASE ( nn_z0_met )
+      !
+      CASE ( 0 )             ! Constant roughness          
+         zhsro(:,:) = rn_hsro
+      CASE ( 1 )             ! Standard Charnock formula
+         zhsro(:,:) = MAX(rsbc_zs1 * ustars2(:,:), rn_hsro)
+      CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008)
+         zdep(:,:)  = 30.*TANH(2.*0.3/(28.*SQRT(MAX(ustars2(:,:),rsmall))))             ! Wave age (eq. 10)
+         zhsro(:,:) = MAX(rsbc_zs2 * ustars2(:,:) * zdep(:,:)**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11)
+      CASE ( 3 )             ! Roughness given by the wave model (coupled or read in file)
+         zhsro(:,:) = hsw(:,:)
+      END SELECT
+
+      ! 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) )   &
+                  &                            / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
+                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
+                  &                            / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
+               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk)
+            END DO
+         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) * gdepw_n(ji,jj,mbkt(ji,jj)+1)
+                  zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) )
+                  zcoef = ( zup / MAX( zdown, rsmall ) )
+                  zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
+               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) )   &
+                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+               !
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+               !
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + 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)
+      zwall_psi(:,:,1) = zwall_psi(:,:,2)
+      zwall_psi(:,:,jpk) = 1.
+      !
+      ! Surface boundary condition on tke
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_bc_surf )
+      !
+      CASE ( 0 )             ! Dirichlet case
+      ! First level
+      en(:,:,1) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+      en(:,:,1) = MAX(en(:,:,1), rn_emin) 
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      ! 
+      ! One level below
+      en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) &
+         &               / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
+      en(:,:,2) = MAX(en(:,:,2), rn_emin )
+      z_elem_a(:,:,2) = 0._wp 
+      z_elem_c(:,:,2) = 0._wp
+      z_elem_b(:,:,2) = 1._wp
+      !
+      !
+      CASE ( 1 )             ! Neumann boundary condition on d(e)/dz
+      !
+      ! Dirichlet conditions at k=1
+      en(:,:,1)       = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+      en(:,:,1)       = MAX(en(:,:,1), rn_emin)      
+      z_elem_a(:,:,1) = en(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! at k=2, set de/dz=Fw
+      !cbr
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0._wp
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) ))
+      zflxs(:,:)      = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) &
+          &                       * ((zhsro(:,:)+gdept_n(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf)
+
+      en(:,:,2) = en(:,:,2) + zflxs(:,:)/e3w_n(:,:,2)
+      !
+      !
+      END SELECT
+
+      ! Bottom boundary condition on tke
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_bc_bot )
+      !
+      CASE ( 0 )             ! Dirichlet 
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
+         !                      ! Balance between the production and the dissipation terms
+         DO jj = 2, jpjm1
+            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
+         !                      
+         DO jj = 2, jpjm1
+            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)  = eb(ji,jj,jk) * mxlb(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( eb(ji,jj,jk) ) / ( rc0 * mxlb(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 * eb(ji,jj,jk) * mxlb(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) )   &
+                  &                      / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) )
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + 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_bc_surf )
+      !
+      CASE ( 0 )             ! Dirichlet boundary conditions
+      !
+      ! Surface value
+      zdep(:,:)       = zhsro(:,:) * rl_sf ! Cosmetic
+      psi (:,:,1)     = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! One level below
+      zkar(:,:)       = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) )))
+      zdep(:,:)       = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:)
+      psi (:,:,2)     = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,2) = 0._wp
+      z_elem_c(:,:,2) = 0._wp
+      z_elem_b(:,:,2) = 1._wp
+      ! 
+      !
+      CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz
+      !
+      ! Surface value: Dirichlet
+      zdep(:,:)       = zhsro(:,:) * rl_sf
+      psi (:,:,1)     = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+      z_elem_a(:,:,1) = psi(:,:,1)
+      z_elem_c(:,:,1) = 0._wp
+      z_elem_b(:,:,1) = 1._wp
+      !
+      ! Neumann condition at k=2
+      z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+      z_elem_a(:,:,2) = 0._wp
+      !
+      ! Set psi vertical flux at the surface:
+      zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
+      zdep(:,:) = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+      zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
+      zdep(:,:) =  rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * &
+             & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.)
+      zflxs(:,:) = zdep(:,:) * zflxs(:,:)
+      psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2)
+
+      !   
+      !
+      END SELECT
+
+      ! Bottom boundary condition on psi
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_bc_bot )
+      !
+      !
+      CASE ( 0 )             ! Dirichlet 
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
+         !                      ! Balance between the production and the dissipation terms
+         DO jj = 2, jpjm1
+            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 * rn_bfrz0
+               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               z_elem_a(ji,jj,ibot) = 0._wp
+               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 * ( rn_bfrz0 + e3t_n(ji,jj,ibotm1) )
+               psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
+               z_elem_a(ji,jj,ibotm1) = 0._wp
+               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
+         !                      
+         DO jj = 2, jpjm1
+            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 * rn_bfrz0
+               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               !
+               z_elem_a(ji,jj,ibot) = 0._wp
+               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) = rn_bfrz0 + 0.5_wp*e3t_n(ji,jj,ibotm1)
+               zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) )   &
+                  &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
+               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(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) ) / MAX( psi(ji,jj,jk), rn_epsmin)
+               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 )
+               IF (ln_length_lim) mxln(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk) )
+            END DO
+         END DO
+      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
+
+      avmv(:,:,1) = avmv(:,:,2)
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            avmv(ji,jj,mbkt(ji,jj)+1) = avmv(ji,jj,mbkt(ji,jj))
+         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
+      !
+      avt_k (:,:,:) = avt (:,:,:)
+      avm_k (:,:,:) = avm (:,:,:)
+      avmu_k(:,:,:) = avmu(:,:,:)
+      avmv_k(:,:,:) = avmv(:,:,:)
+      !
+      CALL wrk_dealloc( jpi,jpj,       zdep, zkar, zflxs, zhsro )
+      CALL wrk_dealloc( jpi,jpj,jpk,   eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_gls')
+      !
+      !
+   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
+      INTEGER ::   ios   ! Local integer output status for namelist read
+      REAL(wp)::   zcr   ! local scalar
+      !!
+      NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &
+         &            rn_clim_galp, ln_sigpsi, rn_hsro,      &
+         &            rn_crban, rn_charn, rn_frac_hs,        &
+         &            nn_bc_surf, nn_bc_bot, nn_z0_met,      &
+         &            nn_stab_func, nn_clos
+      !!----------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_gls_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme
+      READ  ( numnam_ref, namzdf_gls, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_gls in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf_gls in configuration namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme
+      READ  ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, 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_bc_surf     = ', nn_bc_surf
+         WRITE(numout,*) '      TKE Bottom boundary condition                 nn_bc_bot      = ', nn_bc_bot
+         WRITE(numout,*) '      Modify psi Schmidt number (wb case)           ln_sigpsi      = ', ln_sigpsi
+         WRITE(numout,*) '      Craig and Banner coefficient                  rn_crban       = ', rn_crban
+         WRITE(numout,*) '      Charnock coefficient                          rn_charn       = ', rn_charn
+         WRITE(numout,*) '      Surface roughness formula                     nn_z0_met      = ', nn_z0_met
+         WRITE(numout,*) '      Wave height frac. (used if nn_z0_met=2)       rn_frac_hs     = ', rn_frac_hs
+         WRITE(numout,*) '      Stability functions                           nn_stab_func   = ', nn_stab_func
+         WRITE(numout,*) '      Type of closure                               nn_clos        = ', nn_clos
+         WRITE(numout,*) '      Surface roughness (m)                         rn_hsro        = ', rn_hsro
+         WRITE(numout,*) '      Bottom roughness (m) (nambfr namelist)        rn_bfrz0       = ', rn_bfrz0
+      ENDIF
+
+      !                                !* allocate gls arrays
+      IF( zdf_gls_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_gls_init : unable to allocate arrays' )
+
+      !                                !* Check of some namelist values
+      IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )
+      IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )
+      IF( nn_z0_met < 0 .OR. nn_z0_met > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_z0_met is 0, 1, 2 or 3' )
+      IF( nn_z0_met == 3 .AND. .NOT.ln_wave ) CALL ctl_stop( 'zdf_gls_init: nn_z0_met=3 requires ln_wave=T' )
+      IF( nn_stab_func  < 0 .OR. nn_stab_func  > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_stab_func is 0, 1, 2 and 3' )
+      IF( nn_clos       < 0 .OR. nn_clos       > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_clos is 0, 1, 2 or 3' )
+
+      SELECT CASE ( nn_clos )          !* set the parameters for the chosen closure
+      !
+      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.62_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.2_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
+
+      !
+      SELECT CASE ( nn_stab_func )     !* set the parameters of the stability functions
+      !
+      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 Eq. (13) of Carniel et al, OM, 30, 225-239, 2009
+      !                                     !  or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001
+      IF( ln_sigpsi ) THEN
+         ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf 
+         ! Verification: retrieve Burchard (2001) results by uncomenting the line below:
+         ! Note that the results depend on the value of rn_cm_sf which is constant (=rc0) in his work
+         ! ra_sf = -SQRT(2./3.*rc0**3./rn_cm_sf*rn_sc_tke)/vkarmn
+         rsc_psi0 = rsc_tke/(24.*rpsi2)*(-1.+(4.*rnn + ra_sf*(1.+4.*rmm))**2./(ra_sf**2.))
+      ELSE
+         rsc_psi0 = rsc_psi
+      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 ) )
+
+      IF ( rn_crban==0._wp ) THEN
+         rl_sf = vkarmn
+      ELSE
+         rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp)*rsc_tke          &
+                 &                                       + 12._wp * rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm) &
+                 &                                                *SQRT(rsc_tke*(rsc_tke                 &
+                 &                                                   + 24._wp*rsc_psi0*rpsi2)) )         &
+                 &                                         /(12._wp*rnn**2.)                             &
+                 &                                       )
+      ENDIF
+
+      !
+      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
+      rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf                      ! Dirichlet + Wave breaking
+      rsbc_tke2 = rdt * rn_crban / rl_sf                                 ! Neumann + Wave breaking 
+      zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp )
+      rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer 
+      rsbc_zs1  = rn_charn/grav                                          ! Charnock formula for surface roughness
+      rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness 
+      rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi
+      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking 
+
+      rfact_tke = -0.5_wp / rsc_tke * rdt                                ! Cst used for the Diffusion term of tke
+      rfact_psi = -0.5_wp / rsc_psi * rdt                                ! Cst used for the Diffusion term of tke
+
+      !                                !* Wall proximity function
+      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
+      !                              
+      CALL gls_rst( nit000, 'READ' )   !* read or initialize all required files
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_gls_init')
+      !
+   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
+      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 ) > 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.05        
+               avt_k (:,:,:) = avt (:,:,:)
+               avm_k (:,:,:) = avm (:,:,:)
+               avmu_k(:,:,:) = avmu(:,:,:)
+               avmv_k(:,:,:) = avmv(:,:,:)
+               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.05       
+         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_k  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 
+         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
+         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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 8732)
@@ -0,0 +1,180 @@
+MODULE zdfini
+   !!======================================================================
+   !!                      ***  MODULE  zdfini  ***
+   !! Ocean physics :   read vertical mixing namelist and check consistancy
+   !!======================================================================
+   !! History :  8.0  ! 1997-06  (G. Madec)  Original code from inimix
+   !!            1.0  ! 2002-08  (G. Madec)  F90 : free form
+   !!             -   ! 2005-06  (C. Ethe) KPP scheme
+   !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.7  ! 2014-12  (G. Madec) remove KPP scheme
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE par_oce         ! mesh and scale factors
+   USE zdf_oce         ! TKE vertical mixing          
+   USE sbc_oce         ! surface module (only for nn_isf in the option compatibility test)
+   USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
+   USE zdfric          ! Richardson vertical mixing   
+   USE zdfddm          ! double diffusion mixing      
+   USE zdfevd          ! enhanced vertical diffusion  
+   USE tranpc          ! convection: non penetrative adjustment
+   USE ldfslp          ! iso-neutral slopes
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+   USE lib_mpp         ! distribued memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_init   ! routine called by opa.F90
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zdf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the vertical ocean physics
+      !!
+      !! ** Method  :   Read namelist namzdf, control logicals 
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios       ! local integers
+      !!
+      NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,  &
+         &        ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp,       &
+         &        ln_zdfqiao
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
+      READ  ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf in reference namelist : Vertical mixing parameters
+      READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf )
+
+      IF(lwp) THEN               !* Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_init : vertical physics'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters'
+         WRITE(numout,*) '      vertical eddy viscosity             rn_avm0   = ', rn_avm0
+         WRITE(numout,*) '      vertical eddy diffusivity           rn_avt0   = ', rn_avt0
+         WRITE(numout,*) '      constant background or profile      nn_avb    = ', nn_avb
+         WRITE(numout,*) '      horizontal variation for avtb       nn_havtb  = ', nn_havtb
+         WRITE(numout,*) '      time splitting / backward scheme    ln_zdfexp = ', ln_zdfexp
+         WRITE(numout,*) '      number of time step                 nn_zdfexp = ', nn_zdfexp
+         WRITE(numout,*) '      enhanced vertical diffusion         ln_zdfevd = ', ln_zdfevd
+         WRITE(numout,*) '         applied on momentum (=1/0)       nn_evdm   = ', nn_evdm
+         WRITE(numout,*) '      vertical coefficient for evd        rn_avevd  = ', rn_avevd
+         WRITE(numout,*) '      non-penetrative convection (npc)    ln_zdfnpc = ', ln_zdfnpc
+         WRITE(numout,*) '      npc call  frequency                 nn_npc    = ', nn_npc
+         WRITE(numout,*) '      npc print frequency                 nn_npcp   = ', nn_npcp
+         WRITE(numout,*) '      Qiao formulation flag               ln_zdfqiao=', ln_zdfqiao
+      ENDIF
+
+      !                          !* Parameter & logical controls
+      !                          !  ----------------------------
+      !
+      !                               ! ... check of vertical mixing scheme on tracers
+      !                                              ==> will be done in trazdf module
+      !
+      !                               ! ... check of mixing coefficient
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   vertical mixing option :'
+      ioptio = 0
+      IF( lk_zdfcst ) THEN
+         IF(lwp) WRITE(numout,*) '      constant eddy diffusion coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfric ) THEN
+         IF(lwp) WRITE(numout,*) '      Richardson dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ioptio == 0 .OR. ioptio > 1 )   &
+         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
+      IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav )   &
+         &   CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
+      !
+      !                               ! ... Convection
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   convection :'
+      !
+#if defined key_top
+      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' )
+#endif
+      !
+      ioptio = 0
+      IF( ln_zdfnpc ) THEN
+         IF(lwp) WRITE(numout,*) '      use non penetrative convective scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ln_zdfevd ) THEN
+         IF(lwp) WRITE(numout,*) '      use enhanced vertical dif. scheme'
+         ioptio = ioptio+1
+      ENDIF
+      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 ( ioptio > 1 )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) )           &
+         CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is',   &
+         &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
+
+      !                               !* Background eddy viscosity and diffusivity profil
+      IF( nn_avb == 0 ) THEN                ! Define avmb, avtb from namelist parameter
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0                     
+      ELSE                                  ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990)
+         avmb(:) = rn_avm0
+         avtb(:) = rn_avt0 + ( 3.e-4_wp - 2._wp * rn_avt0 ) * 1.e-4_wp * gdepw_1d(:)   ! m2/s
+         IF(ln_sco .AND. lwp)   CALL ctl_warn( 'avtb profile not valid in sco' )
+      ENDIF
+      !
+      IF( ln_rstart ) THEN                  !  Read avmb, avtb in restart (if exist)
+         ! if ln_traadv_cen, avmb, avtb have been modified in traadv_cen2 module. 
+         ! To ensure the restartability, avmb & avtb are written in the restart 
+         ! file in traadv_cen2 end read here. 
+         IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numror, jpdom_unknown, 'avmb', avmb )
+            CALL iom_get( numror, jpdom_unknown, 'avtb', avtb )
+         ENDIF
+      ENDIF
+      !                                     ! 2D shape of the avtb
+      avtb_2d(:,:) = 1.e0                        ! uniform 
+      !
+      IF( nn_havtb == 1 ) THEN                   ! decrease avtb in the equatorial band
+           !  -15S -5S : linear decrease from avt0 to avt0/10.
+           !  -5S  +5N : cst value avt0/10.
+           !   5N  15N : linear increase from avt0/10, to avt0
+           WHERE(-15. <= gphit .AND. gphit < -5 )   avtb_2d = (1.  - 0.09 * (gphit + 15.))
+           WHERE( -5. <= gphit .AND. gphit <  5 )   avtb_2d =  0.1
+           WHERE(  5. <= gphit .AND. gphit < 15 )   avtb_2d = (0.1 + 0.09 * (gphit -  5.))
+      ENDIF
+      !
+   END SUBROUTINE zdf_init
+
+   !!======================================================================
+END MODULE zdfini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 8732)
@@ -0,0 +1,153 @@
+MODULE zdfmxl
+   !!======================================================================
+   !!                       ***  MODULE  zdfmxl  ***
+   !! Ocean physics: mixed layer depth 
+   !!======================================================================
+   !! History :  1.0  ! 2003-08  (G. Madec)  original code
+   !!            3.2  ! 2009-07  (S. Masson, G. Madec)  IOM + merge of DO-loop
+   !!            3.7  ! 2012-03  (G. Madec)  make public the density criteria for trdmxl 
+   !!             -   ! 2014-02  (F. Roquet)  mixed layer depth calculated using N2 instead of rhop 
+   !!----------------------------------------------------------------------
+   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trc_oce, ONLY: l_offline         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE phycst          ! physical constants
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_mxl       ! called by step.F90
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: depth of the last T-point inside the mixed layer [m]
+
+   REAL(wp), PUBLIC ::   rho_c = 0.01_wp    !: density criterion for mixed layer depth
+   REAL(wp)         ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_mxl_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION zdf_mxl_alloc  ***
+      !!----------------------------------------------------------------------
+      zdf_mxl_alloc = 0      ! set to zero if no array to be allocated
+      IF( .NOT. ALLOCATED( nmln ) ) THEN
+         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
+         !
+         IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc )
+         IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.')
+         !
+      ENDIF
+   END FUNCTION zdf_mxl_alloc
+
+
+   SUBROUTINE zdf_mxl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!              with density criteria.
+      !!
+      !! ** Method  :   The mixed layer depth is the shallowest W depth with 
+      !!      the density of the corresponding T point (just bellow) bellow a
+      !!      given value defined locally as rho(10m) + rho_c
+      !!               The turbocline depth is the depth at which the vertical
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default)
+      !!
+      !! ** Action  :   nmln, hmld, hmlp, hmlpt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      INTEGER  ::   iikn, iiki, ikt ! local integer
+      REAL(wp) ::   zN2_c           ! local scalar
+      INTEGER, POINTER, DIMENSION(:,:) ::   imld   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_mxl')
+      !
+      CALL wrk_alloc( jpi,jpj, imld )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         !                             ! allocate zdfmxl arrays
+         IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' )
+      ENDIF
+
+      ! w-level of the mixing and mixed layers
+      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point
+      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2
+      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria
+      DO jk = nlb10, jpkm1
+         DO jj = 1, jpj                ! Mixed layer level: w-level 
+            DO ji = 1, jpi
+               ikt = mbkt(ji,jj)
+               hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk)
+               IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level
+            END DO
+         END DO
+      END DO
+      !
+      ! w-level of the turbocline and mixing layer (iom_use)
+      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
+      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10 
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
+            END DO
+         END DO
+      END DO
+      ! depth of the mixing and mixed layers
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            iiki = imld(ji,jj)
+            iikn = nmln(ji,jj)
+            hmld (ji,jj) = gdepw_n(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth 
+            hmlp (ji,jj) = gdepw_n(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth
+            hmlpt(ji,jj) = gdept_n(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer
+         END DO
+      END DO
+      !
+      IF( .NOT.l_offline ) THEN
+         IF( iom_use("mldr10_1") ) THEN
+            IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness
+            ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth
+            END IF
+         END IF
+         IF( iom_use("mldkz5") ) THEN
+            IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness
+            ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth
+            END IF
+         ENDIF
+      ENDIF
+      
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 )
+      !
+      CALL wrk_dealloc( jpi,jpj, imld )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_mxl')
+      !
+   END SUBROUTINE zdf_mxl
+
+   !!======================================================================
+END MODULE zdfmxl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfqiao.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfqiao.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfqiao.F90	(revision 8732)
@@ -0,0 +1,128 @@
+MODULE zdfqiao
+   !!======================================================================
+   !!                       ***  MODULE  zdfqiao  ***
+   !! Qiao module      : vertical mixing enhancement due to surface waves 
+   !!======================================================================
+   !! History :  3.6  !  2014-10  (E. Clementi)  Original code
+   !!----------------------------------------------------------------------
+   !!   zdf_qiao        : compute Qiao parameters
+   !!----------------------------------------------------------------------
+
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE zdf_oce
+   USE sbcwave         ! wave module
+   USE dom_oce
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)  
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC zdf_qiao    ! routine called in step
+
+   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: qbv, qbvu, qbvv
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
+   !! $Id: $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_qiao( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE zdf_qiao ***
+      !!
+      !! ** Purpose :Compute the Qiao term (qbv) to be added to
+      !!             vertical viscosity and diffusivity coeffs.  
+      !!
+      !! ** Method  :qbv = alpha * A * Us(0) * exp (3 * k * z)
+      !!             
+      !! ** action  :Compute the Qiao wave dependent term 
+      !!             only if ln_wave=.true.
+      !!               
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::  kt   ! ocean time step
+      !
+      INTEGER :: jj, ji, jk   ! dummy loop indices
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
+         IF( .NOT. ( ln_wave .AND. ln_sdw ) )   &
+            &   CALL ctl_stop ( 'Ask for wave Qiao enhanced turbulence but ln_wave   &
+            &                    and ln_sdw have to be activated')
+         IF( zdf_qiao_alloc() /= 0 )   &
+            &   CALL ctl_stop( 'STOP', 'zdf_qiao : unable to allocate arrays' )
+      ENDIF
+
+      !
+      ! Compute the Qiao term Bv (qbv) to be added to
+      ! vertical viscosity and diffusivity
+      ! qbv = alpha * A * Us(0) * exp (3 * k * z)
+      ! alpha here is set to 1
+      !---------------------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1
+               qbv(ji,jj,jk) = 1.0 * 0.353553 * hsw(ji,jj) * tsd2d(ji,jj) *             &
+            &                  EXP(3.0 * wnum(ji,jj) *                                  &                     
+            &                  (-MIN( gdepw_n(ji  ,jj  ,jk), gdepw_n(ji+1,jj  ,jk),     &
+            &                         gdepw_n(ji  ,jj+1,jk), gdepw_n(ji+1,jj+1,jk))))   &
+            &                          * wmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CALL lbc_lnk( qbv, 'W', 1. )   ! Lateral boundary conditions
+         
+      !
+      ! Interpolate Qiao parameter qbv into the grid_U and grid_V
+      !----------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1
+               qbvu(ji,jj,jk) = 0.5 * wumask(ji,jj,jk)  *              &  
+            &                  ( qbv(ji,jj,jk) + qbv(ji+1,jj  ,jk) )
+               qbvv(ji,jj,jk) = 0.5 * wvmask(ji,jj,jk)  *              &
+            &                  ( qbv(ji,jj,jk) + qbv(ji  ,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      ! 
+      CALL lbc_lnk( qbvu, 'U', 1. ) ; CALL lbc_lnk( qbvv, 'V', 1. )   ! Lateral boundary conditions
+
+      ! Enhance vertical mixing coeff.         
+      !-------------------------------
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               avmu(ji,jj,jk) = ( avmu(ji,jj,jk) + qbvu(ji,jj,jk) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = ( avmv(ji,jj,jk) + qbvv(ji,jj,jk) ) * vmask(ji,jj,jk)
+               avt (ji,jj,jk) = ( avt (ji,jj,jk) + qbv (ji,jj,jk) ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE zdf_qiao
+
+   INTEGER FUNCTION zdf_qiao_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_qiao_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( qbv(jpi,jpj,jpk), qbvu(jpi,jpj,jpk), qbvv(jpi,jpj,jpk),   &
+         &      STAT = zdf_qiao_alloc )
+      !
+      IF( lk_mpp             )  CALL mpp_sum ( zdf_qiao_alloc )
+      IF( zdf_qiao_alloc > 0 )  CALL ctl_warn('zdf_qiao_alloc: allocation of arrays failed.')
+      !
+   END FUNCTION zdf_qiao_alloc
+      
+   !!======================================================================
+END MODULE zdfqiao
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 8732)
@@ -0,0 +1,319 @@
+MODULE zdfric
+   !!======================================================================
+   !!                       ***  MODULE  zdfric  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the local
+   !!                 Richardson number dependent formulation
+   !!======================================================================
+   !! History :  OPA  ! 1987-09  (P. Andrich)  Original code
+   !!            4.0  ! 1991-11  (G. Madec)
+   !!            7.0  ! 1996-01  (G. Madec)  complete rewriting of multitasking suppression of common work arrays
+   !!            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
+   !!            3.3.1! 2011-09  (P. Oddo) Mixed layer depth parameterization
+   !!----------------------------------------------------------------------
+#if defined key_zdfric
+   !!----------------------------------------------------------------------
+   !!   'key_zdfric'                                             Kz = f(Ri)
+   !!----------------------------------------------------------------------
+   !!   zdf_ric       : update momentum and tracer Kz from the Richardson
+   !!                  number computation
+   !!   zdf_ric_init  : initialization, namelist read, & parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   USE eosbn2, ONLY : neos
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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
+
+   !                           !!* Namelist namzdf_ric : Richardson number dependent Kz *
+   INTEGER  ::   nn_ric         ! coefficient of the parameterization
+   REAL(wp) ::   rn_avmri       ! maximum value of the vertical eddy viscosity
+   REAL(wp) ::   rn_alp         ! coefficient of the parameterization
+   REAL(wp) ::   rn_ekmfc       ! Ekman Factor Coeff
+   REAL(wp) ::   rn_mldmin      ! minimum mixed layer (ML) depth    
+   REAL(wp) ::   rn_mldmax      ! maximum mixed layer depth
+   REAL(wp) ::   rn_wtmix       ! Vertical eddy Diff. in the ML
+   REAL(wp) ::   rn_wvmix       ! Vertical eddy Visc. in the ML
+   LOGICAL  ::   ln_mldw        ! Use or not the MLD parameters
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric   !: coef. for the horizontal mean at t-point
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_ric_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION zdf_ric_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( tmric(jpi,jpj,jpk)   , STAT= zdf_ric_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_ric_alloc )
+      IF( zdf_ric_alloc /= 0 )   CALL ctl_warn('zdf_ric_alloc: failed to allocate arrays')
+   END FUNCTION zdf_ric_alloc
+
+
+   SUBROUTINE zdf_ric( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdfric  ***
+      !!                    
+      !! ** Purpose :   Compute the before eddy viscosity and diffusivity as
+      !!                a function of the local richardson number.
+      !!
+      !! ** Method  :   Local richardson number dependent formulation of the 
+      !!                vertical eddy viscosity and diffusivity coefficients. 
+      !!                The eddy coefficients are given by:
+      !!                    avm = avm0 + avmb
+      !!                    avt = avm0 / (1 + rn_alp*ri)
+      !!                with ri  = N^2 / dz(u)**2
+      !!                         = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ]
+      !!                    avm0= rn_avmri / (1 + rn_alp*ri)**nn_ric
+      !!      Where ri is the before local Richardson number,
+      !!            rn_avmri is the maximum value reaches by avm and avt 
+      !!            avmb and avtb are the background (or minimum) values
+      !!            and rn_alp, nn_ric are adjustable parameters.
+      !!      Typical values used are : avm0=1.e-2 m2/s, avmb=1.e-6 m2/s
+      !!      avtb=1.e-7 m2/s, rn_alp=5. and nn_ric=2.
+      !!      a numerical threshold is impose on the vertical shear (1.e-20)
+      !!      As second step compute Ekman depth from wind stress forcing
+      !!      and apply namelist provided vertical coeff within this depth.
+      !!      The Ekman depth is:
+      !!              Ustar = SQRT(Taum/rho0)
+      !!              ekd= rn_ekmfc * Ustar / f0
+      !!      Large et al. (1994, eq.29) suggest rn_ekmfc=0.7; however, the derivation
+      !!      of the above equation indicates the value is somewhat arbitrary; therefore
+      !!      we allow the freedom to increase or decrease this value, if the
+      !!      Ekman depth estimate appears too shallow or too deep, respectively.
+      !!      Ekd is then limited by rn_mldmin and rn_mldmax provided in the
+      !!      namelist
+      !!        N.B. the mask are required for implicit scheme, and surface
+      !!      and bottom value already set in zdfini.F90
+      !!
+      !! References : Pacanowski & Philander 1981, JPO, 1441-1451.
+      !!              PFJ Lermusiaux 2001.
+      !!----------------------------------------------------------------------
+      USE phycst,   ONLY:   rsmall,rau0
+      USE sbc_oce,  ONLY:   taum
+      !!
+      INTEGER, INTENT( in ) ::   kt                           ! ocean time-step
+      !!
+      INTEGER  ::   ji, jj, jk                                ! dummy loop indices
+      REAL(wp) ::   zcoef, zdku, zdkv, zri, z05alp, zflageos  ! temporary scalars
+      REAL(wp) ::   zrhos, zustar
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zwx, ekm_dep  
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_ric')
+      !
+      CALL wrk_alloc( jpi,jpj, zwx, ekm_dep )
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Richardson number (put in zwx(ji,jj))
+         ! -----------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zcoef = 0.5 / e3w_n(ji,jj,jk)
+               !                                            ! shear of horizontal velocity
+               zdku = zcoef * (  ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1)   &
+                  &             -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  )  )
+               !                                            ! richardson number (minimum value set to zero)
+               zri = rn2(ji,jj,jk) / ( zdku*zdku + zdkv*zdkv + 1.e-20 )
+               zwx(ji,jj) = MAX( zri, 0.e0 )
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'W', 1. )                       ! Boundary condition   (sign unchanged)
+
+         ! Vertical eddy viscosity and diffusivity coefficients
+         ! -------------------------------------------------------
+         z05alp = 0.5_wp * rn_alp
+         DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm)
+            DO ji = 1, fs_jpim1
+               avmu(ji,jj,jk) = umask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nn_ric
+               avmv(ji,jj,jk) = vmask(ji,jj,jk) * rn_avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nn_ric
+            END DO
+         END DO
+         DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt)
+            DO ji = fs_2, fs_jpim1
+               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1._wp + rn_alp * zwx(ji,jj) )           &
+                  &                            * (  avmu(ji,jj,jk) + avmu(ji-1,jj,jk)      &
+                  &                               + avmv(ji,jj,jk) + avmv(ji,jj-1,jk)  )   &
+                  &          + avtb(jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+         DO jj = 2, jpjm1                                   ! Add the background coefficient on eddy viscosity
+            DO ji = fs_2, fs_jpim1
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      !
+      IF( ln_mldw ) THEN
+
+      !  Compute Ekman depth from wind stress forcing.
+      ! -------------------------------------------------------
+      zflageos = ( 0.5 + SIGN( 0.5, neos - 1. ) ) * rau0
+      DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+            zrhos          = rhop(ji,jj,1) + zflageos * ( 1. - tmask(ji,jj,1) )
+            zustar         = SQRT( taum(ji,jj) / ( zrhos +  rsmall ) )
+            ekm_dep(ji,jj) = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )
+            ekm_dep(ji,jj) = MAX(ekm_dep(ji,jj),rn_mldmin) ! Minimun allowed
+            ekm_dep(ji,jj) = MIN(ekm_dep(ji,jj),rn_mldmax) ! Maximum allowed
+         END DO
+      END DO
+
+      ! In the first model level vertical diff/visc coeff.s 
+      ! are always equal to the namelist values rn_wtmix/rn_wvmix
+      ! -------------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            avmv(ji,jj,1) = MAX( avmv(ji,jj,1), rn_wvmix )
+            avmu(ji,jj,1) = MAX( avmu(ji,jj,1), rn_wvmix )
+            avt( ji,jj,1) = MAX(  avt(ji,jj,1), rn_wtmix )
+         END DO
+      END DO
+
+      !  Force the vertical mixing coef within the Ekman depth
+      ! -------------------------------------------------------
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               IF( gdept_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN
+                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix )
+                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix )
+                  avt( ji,jj,jk) = MAX(  avt(ji,jj,jk), rn_wtmix )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      DO jk = 1, jpkm1                
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * vmask(ji,jj,jk)
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) * umask(ji,jj,jk)
+               avt( ji,jj,jk) = avt( ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+     ENDIF
+
+      CALL lbc_lnk( avt , 'W', 1. )                         ! Boundary conditions   (unchanged sign)
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+      !
+      CALL wrk_dealloc( jpi,jpj, zwx, ekm_dep )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_ric')
+      !
+   END SUBROUTINE zdf_ric
+
+
+   SUBROUTINE zdf_ric_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdfbfr_init  ***
+      !!                    
+      !! ** Purpose :   Initialization of the vertical eddy diffusivity and
+      !!      viscosity coef. for the Richardson number dependent formulation.
+      !!
+      !! ** Method  :   Read the namzdf_ric namelist and check the parameter values
+      !!
+      !! ** input   :   Namelist namzdf_ric
+      !!
+      !! ** Action  :   increase by 1 the nstop flag is setting problem encounter
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ios        ! Local integer output status for namelist read
+      !!
+      NAMELIST/namzdf_ric/ rn_avmri, rn_alp   , nn_ric  , rn_ekmfc,  &
+         &                rn_mldmin, rn_mldmax, rn_wtmix, rn_wvmix, ln_mldw
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number
+      READ  ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number
+      READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_ric )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_ric : Ri depend vertical mixing scheme'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_ric : set Kz(Ri) parameters'
+         WRITE(numout,*) '      maximum vertical viscosity     rn_avmri  = ', rn_avmri
+         WRITE(numout,*) '      coefficient                    rn_alp    = ', rn_alp
+         WRITE(numout,*) '      coefficient                    nn_ric    = ', nn_ric
+         WRITE(numout,*) '      Ekman Factor Coeff             rn_ekmfc  = ', rn_ekmfc
+         WRITE(numout,*) '      minimum mixed layer depth      rn_mldmin = ', rn_mldmin
+         WRITE(numout,*) '      maximum mixed layer depth      rn_mldmax = ', rn_mldmax
+         WRITE(numout,*) '      Vertical eddy Diff. in the ML  rn_wtmix  = ', rn_wtmix
+         WRITE(numout,*) '      Vertical eddy Visc. in the ML  rn_wvmix  = ', rn_wvmix
+         WRITE(numout,*) '      Use the MLD parameterization   ln_mldw   = ', ln_mldw
+      ENDIF
+      !
+      !                              ! allocate zdfric arrays
+      IF( zdf_ric_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ric_init : unable to allocate arrays' )
+      !
+      DO jk = 1, jpk                 ! weighting mean array tmric for 4 T-points
+         DO jj = 2, jpj              ! which accounts for coastal boundary conditions            
+            DO ji = 2, jpi
+               tmric(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)  )
+            END DO
+         END DO
+      END DO
+      tmric(:,1,:) = 0._wp
+      !
+      DO jk = 1, jpk                 ! Initialization of vertical eddy coef. to the background value
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+      !
+   END SUBROUTINE zdf_ric_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :              NO Richardson dependent vertical mixing
+   !!----------------------------------------------------------------------
+   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
+   END SUBROUTINE zdf_ric
+#endif
+
+   !!======================================================================
+END MODULE zdfric
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 8732)
@@ -0,0 +1,911 @@
+MODULE zdftke
+   !!======================================================================
+   !!                       ***  MODULE  zdftke  ***
+   !! 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 tke_init routine
+   !!             -   !  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
+   !!             -   !  2008-12  (G. Reffray) stable discretization of the production term 
+   !!            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
+   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
+   !!----------------------------------------------------------------------
+#if defined key_zdftke
+   !!----------------------------------------------------------------------
+   !!   '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
+   !!   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 variables
+   USE phycst         ! physical constants
+   USE dom_oce        ! domain: ocean
+   USE domvvl         ! domain: variable volume layer
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE zdf_oce        ! vertical physics: ocean variables
+   USE zdfmxl         ! vertical physics: mixed layer
+   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 lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+#if defined key_agrif
+   USE agrif_opa_interp
+   USE agrif_opa_update
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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
+
+   !                      !!** Namelist  namzdf_tke  **
+   LOGICAL  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not
+   INTEGER  ::   nn_mxl    ! type of mixing length (=0/1/2/3)
+   REAL(wp) ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m]
+   INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1)
+   REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e)
+   REAL(wp) ::   rn_ediss  ! coefficient of the Kolmogoroff dissipation 
+   REAL(wp) ::   rn_ebb    ! coefficient of the surface input of tke
+   REAL(wp) ::   rn_emin   ! minimum value of tke           [m2/s2]
+   REAL(wp) ::   rn_emin0  ! surface minimum value of tke   [m2/s2]
+   REAL(wp) ::   rn_bshear ! background shear (>0) currently a numerical threshold (do not change it)
+   INTEGER  ::   nn_etau   ! type of depth penetration of surface tke (=0/1/2/3)
+   INTEGER  ::   nn_htau   ! type of tke profile of penetration (=0/1)
+   REAL(wp) ::   rn_efr    ! fraction of TKE surface value which penetrates in the ocean
+   LOGICAL  ::   ln_lc     ! Langmuir cells (LC) as a source term of TKE or not
+   REAL(wp) ::   rn_lc     ! 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)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apdlr          ! now mixing lenght of dissipation
+#if defined key_c1d
+   !                                                                        !!** 1D cfg only  **   ('key_c1d')
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
+#endif
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_tke_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_tke_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE(                                                                    &
+#if defined key_c1d
+         &      e_dis(jpi,jpj,jpk) , e_mix(jpi,jpj,jpk) ,                          &
+         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          &
+#endif
+         &      htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
+         &      apdlr(jpi,jpj,jpk) ,                                           STAT= zdf_tke_alloc      )
+         !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc )
+      IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays')
+      !
+   END FUNCTION zdf_tke_alloc
+
+
+   SUBROUTINE zdf_tke( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_tke  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!              coefficients using a turbulent closure scheme (TKE).
+      !!
+      !! ** Method  :   The time evolution of the turbulent kinetic energy (tke)
+      !!              is computed from a prognostic equation :
+      !!         d(en)/dt = avm (d(u)/dz)**2             ! shear production
+      !!                  + d( avm d(en)/dz )/dz         ! diffusion of tke
+      !!                  + avt N^2                      ! stratif. destruc.
+      !!                  - rn_ediss / emxl en**(2/3)    ! Kolmogoroff dissipation
+      !!      with the boundary conditions:
+      !!         surface: en = max( rn_emin0, rn_ebb * taum )
+      !!         bottom : en = rn_emin
+      !!      The associated critical Richardson number is: ri_cri = 2/(2+rn_ediss/rn_ediff) 
+      !!
+      !!        The now Turbulent kinetic energy is computed using the following 
+      !!      time stepping: implicit for vertical diffusion term, linearized semi
+      !!      implicit for kolmogoroff dissipation term, and explicit forward for 
+      !!      both buoyancy and shear production terms. Therefore a tridiagonal 
+      !!      linear system is solved. Note that buoyancy and shear terms are
+      !!      discretized in a energy conserving form (Bruchard 2002).
+      !!
+      !!        The dissipative and mixing length scale are computed from en and
+      !!      the stratification (see tke_avn)
+      !!
+      !!        The now vertical eddy vicosity and diffusivity coefficients are
+      !!      given by: 
+      !!              avm = max( avtb, rn_ediff * zmxlm * en^1/2 )
+      !!              avt = max( avmb, pdl * avm                 )  
+      !!              eav = max( avmb, avm )
+      !!      where pdl, the inverse of the Prandtl number is 1 if nn_pdl=0 and
+      !!      given by an empirical funtion of the localRichardson number if nn_pdl=1 
+      !!
+      !! ** 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
+      !!              Bruchard OM 2002
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!----------------------------------------------------------------------
+      !
+#if defined key_agrif 
+      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Tke
+#endif
+      !
+      IF( kt /= nit000 ) THEN   ! restore before value to compute tke
+         avt (:,:,:) = avt_k (:,:,:) 
+         avm (:,:,:) = avm_k (:,:,:) 
+         avmu(:,:,:) = avmu_k(:,:,:) 
+         avmv(:,:,:) = avmv_k(:,:,:) 
+      ENDIF 
+      !
+      CALL tke_tke      ! now tke (en)
+      !
+      CALL tke_avn      ! now avt, avm, avmu, avmv
+      !
+      avt_k (:,:,:) = avt (:,:,:) 
+      avm_k (:,:,:) = avm (:,:,:) 
+      avmu_k(:,:,:) = avmu(:,:,:) 
+      avmv_k(:,:,:) = avmv(:,:,:) 
+      !
+#if defined key_agrif
+      ! Update child grid f => parent grid 
+      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only
+#endif      
+     ! 
+  END SUBROUTINE zdf_tke
+
+
+   SUBROUTINE tke_tke
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tke_tke  ***
+      !!
+      !! ** Purpose :   Compute the now Turbulente Kinetic Energy (TKE)
+      !!
+      !! ** Method  : - TKE surface boundary condition
+      !!              - 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
+      !!                a tridiagonal linear system by a "methode de chasse"
+      !!              - increase TKE due to surface and internal wave breaking
+      !!
+      !! ** Action  : - en : now turbulent kinetic energy)
+      !!              - avmu, avmv : production of TKE by shear at u and v-points
+      !!                (= Kz dz[Ub] * dz[Un] )
+      !! ---------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
+!!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
+      REAL(wp) ::   zbbrau, zesh2                   ! temporary scalars
+      REAL(wp) ::   zfact1, zfact2, zfact3          !    -         -
+      REAL(wp) ::   ztx2  , zty2  , zcof            !    -         -
+      REAL(wp) ::   ztau  , zdif                    !    -         -
+      REAL(wp) ::   zus   , zwlc  , zind            !    -         -
+      REAL(wp) ::   zzd_up, zzd_lw                  !    -         -
+!!bfr      REAL(wp) ::   zebot                           !    -         -
+      INTEGER , POINTER, DIMENSION(:,:  ) ::   imlc
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhlc
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv
+      REAL(wp)                            ::   zri  !   local Richardson number
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tke_tke')
+      !
+      CALL wrk_alloc( jpi,jpj,       imlc )    ! integer
+      CALL wrk_alloc( jpi,jpj,       zhlc ) 
+      CALL wrk_alloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
+      !
+      zbbrau = rn_ebb / rau0       ! Local constant initialisation
+      zfact1 = -.5_wp * rdt 
+      zfact2 = 1.5_wp * rdt * rn_ediss
+      zfact3 = 0.5_wp       * rn_ediss
+      !
+      !
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Surface boundary condition on tke
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF ( ln_isfcav ) THEN
+         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1)
+            END DO
+         END DO
+      END IF
+      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0)
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+      
+!!bfr   - start commented area
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Bottom boundary condition on tke
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! Tests to date have found the bottom boundary condition on tke to have very little effect.
+      ! The condition is coded here for completion but commented out until there is proof that the
+      ! computational cost is justified
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     en(bot)   = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
+!!    DO jj = 2, jpjm1
+!!       DO ji = fs_2, fs_jpim1   ! vector opt.
+!!          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,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * tmask(ji,jj,1)
+!!       END DO
+!!    END DO
+!!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._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1)
+         DO jk = 2, jpk
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk)
+         END DO
+         !                        !* finite Langmuir Circulation depth
+         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )
+         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 
+               DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1)
+                  zus  = zcof * taum(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) = gdepw_n(ji,jj,imlc(ji,jj))
+            END DO
+         END DO
+         zcof = 0.016 / SQRT( zrhoa * zcdrag )
+         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift
+                  !                                           ! vertical velocity due to LC
+                  zind = 0.5 - SIGN( 0.5, gdepw_n(ji,jj,jk) - zhlc(ji,jj) )
+                  zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) )
+                  !                                           ! TKE Langmuir circulation source term
+                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   &
+                     &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  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 ).
+      !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
+      !
+      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji+1,jj,jk) )   &
+                  &                 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   &
+                  &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) &
+                  &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) )
+               z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk  ) + avm(ji,jj+1,jk) )   &
+                  &                 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   &
+                  &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) &
+                  &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: compute apdlr
+         ! Note that zesh2 is also computed in the next loop.
+         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                                          ! shear prod. at w-point weightened by mask
+                  zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                     &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  !                                          ! local Richardson number
+                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear )
+                  apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  )
+                  
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !         
+      DO jk = 2, jpkm1           !* Matrix and right hand side in en
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcof   = zfact1 * tmask(ji,jj,jk)
+# if defined key_zdftmx_new
+               ! key_zdftmx_new: New internal wave-driven param: set a minimum value for Kz on TKE (ensure numerical stability)
+               zzd_up = zcof * MAX( avm(ji,jj,jk+1) + avm(ji,jj,jk), 2.e-5_wp )   &  ! upper diagonal
+                  &          / (  e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  )  )
+               zzd_lw = zcof * MAX( avm(ji,jj,jk) + avm(ji,jj,jk-1), 2.e-5_wp )   &  ! lower diagonal
+                  &          / (  e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  )  )
+# else
+               zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
+                  &          / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk  ) )
+               zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
+                  &          / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk  ) )
+# endif
+               !                                   ! shear prod. at w-point weightened by mask
+               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+               !
+               zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
+               zd_lw(ji,jj,jk) = zzd_lw
+               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk)
+               !
+               !                                   ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  zesh2  -   avt(ji,jj,jk) * rn2(ji,jj,jk)    &
+                  &                                 + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk)  ) &
+                  &                                 * wmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !                          !* Matrix inversion from level 2 (tke prescribed at level 1)
+      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
+            END DO
+         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.
+            zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
+            END DO
+         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) = zd_lw(ji,jj,jpkm1) / zdiag(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) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(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 ) * wmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  TKE due to surface and internal wave breaking
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!gm BUG : in the exp  remove the depth of ssh !!!
+      
+      
+      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
+                     &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
+               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( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
+                  &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
+                  zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
+                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! 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( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   &
+                     &                        * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
+               END DO
+            END DO
+         END DO
+      ENDIF
+      CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
+      !
+      CALL wrk_dealloc( jpi,jpj,       imlc )    ! integer
+      CALL wrk_dealloc( jpi,jpj,       zhlc ) 
+      CALL wrk_dealloc( jpi,jpj,jpk,   zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
+      !
+   END SUBROUTINE tke_tke
+
+
+   SUBROUTINE tke_avn
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tke_avn  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!
+      !! ** Method  :   At this stage, en, the now TKE, is known (computed in 
+      !!              the tke_tke routine). First, the now mixing lenth is 
+      !!      computed from en and the strafification (N^2), then the mixings
+      !!      coefficients are computed.
+      !!              - Mixing length : a first evaluation of the mixing lengh
+      !!      scales is:
+      !!                      mxl = sqrt(2*en) / N  
+      !!      where N is the brunt-vaisala frequency, with a minimum value set
+      !!      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.
+      !!                        zmxld = zmxlm = mxl
+      !!         nn_mxl=1 : mxl bounded by the e3w and zmxld = zmxlm = mxl
+      !!         nn_mxl=2 : mxl bounded such that the vertical derivative of mxl is 
+      !!                    less than 1 (|d/dz(mxl)|<1) and zmxld = zmxlm = mxl
+      !!         nn_mxl=3 : mxl is bounded from the surface to the bottom usings
+      !!                    |d/dz(xml)|<1 to obtain lup, and from the bottom to 
+      !!                    the surface to obtain ldown. the resulting length 
+      !!                    scales are:
+      !!                        zmxld = sqrt( lup * ldown ) 
+      !!                        zmxlm = min ( lup , ldown )
+      !!              - Vertical eddy viscosity and diffusivity:
+      !!                      avm = max( avtb, rn_ediff * zmxlm * en^1/2 )
+      !!                      avt = max( avmb, pdlr * avm )  
+      !!      with pdlr=1 if nn_pdl=0, pdlr=1/pdl=F(Ri) otherwise.
+      !!
+      !! ** Action  : - avt : now vertical eddy diffusivity (w-point)
+      !!              - avmu, avmv : now vertical eddy viscosity at uw- and vw-points
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars
+      REAL(wp) ::   zdku, zri, zsqen            !   -      -
+      REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tke_avn')
+
+      CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 
+
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Mixing length
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !
+      !                     !* Buoyancy length scale: l=sqrt(2*e/n**2)
+      !
+      ! initialisation of interior minimum value (avoid a 2d loop with mikt)
+      zmxlm(:,:,:)  = rmxl_min    
+      zmxld(:,:,:)  = rmxl_min
+      !
+      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
+               zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) )
+            END DO
+         END DO
+      ELSE 
+         zmxlm(:,:,1) = rn_mxl0
+      ENDIF
+      !
+      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
+            END DO
+         END DO
+      END DO
+      !
+      !                     !* Physical limits for the mixing length
+      !
+      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value 
+      zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
+      !
+      SELECT CASE ( nn_mxl )
+      !
+ !!gm Not sure of that coding for ISF....
+      ! where wmask = 0 set zmxlm == e3w_n
+      CASE ( 0 )           ! bounded by the distance to surface and bottom
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( gdepw_n(ji,jj,jk) - gdepw_n(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   &
+                  &            gdepw_n(ji,jj,mbkt(ji,jj)+1) - gdepw_n(ji,jj,jk) )
+                  ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
+                  zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+                  zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),e3w_n(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+               END DO
+            END DO
+         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( e3w_n(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) + e3t_n(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) + e3t_n(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) + e3t_n(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) + e3t_n(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               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
+      e_dis(:,:,:) = zmxld(:,:,:)      ! c1d configuration : save mixing and dissipation turbulent length scales
+      e_mix(:,:,:) = zmxlm(:,:,:)
+# endif
+
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt)
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zsqen = SQRT( en(ji,jj,jk) )
+               zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
+               avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk)
+               avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
+               dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged)
+      !
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at wu- and wv-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) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions
+      !
+      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+# if defined key_c1d
+                  e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number
+!!gm bug NO zri here....
+!!gm remove the specific diag for c1d !
+                  e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk)                            ! c1d config. : save Ri
+# endif
+              END DO
+            END DO
+         END DO
+      ENDIF
+      CALL lbc_lnk( avt, 'W', 1. )                      ! Lateral boundary conditions on avt  (sign unchanged)
+
+      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
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tke_avn')
+      !
+   END SUBROUTINE tke_avn
+
+
+   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
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ios
+      !!
+      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   
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_tke in reference namelist : Turbulent Kinetic Energy
+      READ  ( numnam_ref, namzdf_tke, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy
+      READ  ( numnam_cfg, namzdf_tke, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_tke )
+      !
+      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number
+# if defined key_zdftmx_new
+      ! key_zdftmx_new: New internal wave-driven param: specified value of rn_emin & rmxl_min are used
+      rn_emin  = 1.e-10_wp
+      rmxl_min = 1.e-03_wp
+      IF(lwp) THEN                  ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tke_init :  New tidal mixing case: force rn_emin = 1.e-10 and rmxl_min = 1.e-3 '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+# else
+      rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity
+# endif
+      !
+      IF(lwp) THEN                    !* Control print
+         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
+         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,*) '      background shear (>0)                       rn_bshear = ', rn_bshear
+         WRITE(numout,*) '      mixing length type                          nn_mxl    = ', nn_mxl
+         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_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,*)
+         WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri
+      ENDIF
+      !
+      !                              ! allocate tke arrays
+      IF( zdf_tke_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' )
+      !
+      !                               !* 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 > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' )
+      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
+
+      IF( ln_mxl0 ) THEN
+         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 
+
+      !                               !* depth of penetration of surface tke
+      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._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
+      !                               !* set vertical eddy coef. to the background value
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+         avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
+      END DO
+      dissl(:,:,:) = 1.e-12_wp
+      !                              
+      CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files
+      !
+   END SUBROUTINE zdf_tke_init
+
+
+   SUBROUTINE tke_rst( kt, cdrw )
+     !!---------------------------------------------------------------------
+     !!                   ***  ROUTINE tke_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 
+     !!----------------------------------------------------------------------
+     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   ! local integers
+     !!----------------------------------------------------------------------
+     !
+     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, 'dissl', ldstop = .FALSE. )
+           !
+           IF( id1 > 0 ) THEN                       ! 'en' exists
+              CALL iom_get( numror, jpdom_autoglo, 'en', en )
+              IF( MIN( id2, id3, id4, id5, id6 ) > 0 ) THEN        ! all required arrays exist
+                 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, 'dissl', dissl )
+              ELSE                                                 ! one at least array is missing
+                 CALL tke_avn                                          ! compute avt, avm, avmu, avmv and dissl (approximation)
+              ENDIF
+           ELSE                                     ! No TKE array found: initialisation
+              IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop'
+              en (:,:,:) = rn_emin * tmask(:,:,:)
+              CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation)
+              !
+              avt_k (:,:,:) = avt (:,:,:)
+              avm_k (:,:,:) = avm (:,:,:)
+              avmu_k(:,:,:) = avmu(:,:,:)
+              avmv_k(:,:,:) = avmv(:,:,:)
+              !
+              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO
+           ENDIF
+        ELSE                                   !* Start from rest
+           en(:,:,:) = rn_emin * tmask(:,:,:)
+           DO jk = 1, jpk                           ! set the Kz to the background value
+              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+              avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+              avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+              avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
+           END DO
+        ENDIF
+        !
+     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+        !                                   ! -------------------
+        IF(lwp) WRITE(numout,*) '---- tke-rst ----'
+        CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     )
+        CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  )
+        CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  )
+        CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
+        CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
+        CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl  )
+        !
+     ENDIF
+     !
+   END SUBROUTINE tke_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        NO TKE scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag
+CONTAINS
+   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
+   SUBROUTINE tke_rst( kt, cdrw )
+     CHARACTER(len=*) ::   cdrw
+     WRITE(*,*) 'tke_rst: You should not have seen this print! error?', kt, cdwr
+   END SUBROUTINE tke_rst
+#endif
+
+   !!======================================================================
+END MODULE zdftke
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 8732)
@@ -0,0 +1,1045 @@
+MODULE zdftmx
+   !!========================================================================
+   !!                       ***  MODULE  zdftmx  ***
+   !! Ocean physics: vertical tidal mixing coefficient
+   !!========================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+   !!   'key_zdftmx'                                  Tidal vertical mixing
+   !!----------------------------------------------------------------------
+   !!   zdf_tmx       : global     momentum & tracer Kz with tidal induced Kz
+   !!   tmx_itf       : Indonesian momentum & tracer Kz with tidal induced Kz 
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics variables
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE eosbn2         ! ocean equation of state
+   USE phycst         ! physical constants
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O Manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_tmx         ! called in step module 
+   PUBLIC   zdf_tmx_init    ! called in opa module 
+   PUBLIC   zdf_tmx_alloc   ! called in nemogcm module
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: tidal mixing flag
+
+   !                       !!* Namelist  namzdf_tmx : tidal mixing *
+   REAL(wp) ::  rn_htmx     ! vertical decay scale for turbulence (meters)
+   REAL(wp) ::  rn_n2min    ! threshold of the Brunt-Vaisala frequency (s-1)
+   REAL(wp) ::  rn_tfe      ! tidal dissipation efficiency (St Laurent et al. 2002)
+   REAL(wp) ::  rn_me       ! mixing efficiency (Osborn 1980)
+   LOGICAL  ::  ln_tmx_itf  ! Indonesian Through Flow (ITF): Koch-Larrouy et al. (2007) parameterization
+   REAL(wp) ::  rn_tfe_itf  ! ITF tidal dissipation efficiency (St Laurent et al. 2002)
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   en_tmx     ! energy available for tidal mixing (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mask_itf   ! mask to use over Indonesian area
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_tmx_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_tmx_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE(en_tmx(jpi,jpj), mask_itf(jpi,jpj), az_tmx(jpi,jpj,jpk), STAT=zdf_tmx_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_tmx_alloc )
+      IF( zdf_tmx_alloc /= 0 )   CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays')
+   END FUNCTION zdf_tmx_alloc
+
+
+   SUBROUTINE zdf_tmx( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tmx  ***
+      !!                   
+      !! ** Purpose :   add to the vertical mixing coefficients the effect of
+      !!              tidal mixing (Simmons et al 2004).
+      !!
+      !! ** Method  : - tidal-induced vertical mixing is given by:
+      !!                  Kz_tides = az_tmx / max( rn_n2min, N^2 )
+      !!              where az_tmx is a coefficient that specified the 3D space 
+      !!              distribution of the faction of tidal energy taht is used
+      !!              for mixing. Its expression is set in zdf_tmx_init routine,
+      !!              following Simmons et al. 2004.
+      !!                NB: a specific bounding procedure is performed on av_tide
+      !!              so that the input tidal energy is actually almost used. The
+      !!              basic maximum value is 60 cm2/s, but values of 300 cm2/s 
+      !!              can be reached in area where bottom stratification is too 
+      !!              weak.
+      !!
+      !!              - update av_tide in the Indonesian Through Flow area
+      !!              following Koch-Larrouy et al. (2007) parameterisation
+      !!              (see tmx_itf routine).
+      !!
+      !!              - update the model vertical eddy viscosity and diffusivity: 
+      !!                     avt  = avt  +    av_tides
+      !!                     avm  = avm  +    av_tides
+      !!                     avmu = avmu + mi(av_tides)
+      !!                     avmv = avmv + mj(av_tides)
+      !!
+      !! ** Action  :   avt, avm, avmu, avmv   increased by tidal mixing
+      !!
+      !! References : Simmons et al. 2004, Ocean Modelling, 6, 3-4, 245-263.
+      !!              Koch-Larrouy et al. 2007, GRL.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   ztpc         ! scalar workspace
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zkz
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zav_tide
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx')
+      !
+      CALL wrk_alloc( jpi,jpj,       zkz )
+      CALL wrk_alloc( jpi,jpj,jpk,   zav_tide )
+      !
+      !                          ! ----------------------- !
+      !                          !  Standard tidal mixing  !  (compute zav_tide)
+      !                          ! ----------------------- !
+      !                             !* First estimation (with n2 bound by rn_n2min) bounded by 60 cm2/s
+      zav_tide(:,:,:) = MIN(  60.e-4, az_tmx(:,:,:) / MAX( rn_n2min, rn2(:,:,:) )  )
+
+      zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column
+      DO jk = 2, jpkm1
+         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
+      END DO
+
+      DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
+         DO ji = 1, jpi
+            IF( zkz(ji,jj) /= 0.e0 )   zkz(ji,jj) = en_tmx(ji,jj) / zkz(ji,jj)
+         END DO
+      END DO
+
+      DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
+         zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s
+      END DO
+
+      IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide
+         ztpc = 0._wp
+         DO jk= 1, jpk
+            DO jj= 1, jpj
+               DO ji= 1, jpi
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj)                  &
+                     &        * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) '          N Total power consumption by av_tide    : ztpc = ', ztpc * 1.e-12 ,'TW'
+      ENDIF
+       
+      !                          ! ----------------------- !
+      !                          !    ITF  tidal mixing    !  (update zav_tide)
+      !                          ! ----------------------- !
+      IF( ln_tmx_itf )   CALL tmx_itf( kt, zav_tide )
+
+      !                          ! ----------------------- !
+      !                          !   Update  mixing coefs  !                          
+      !                          ! ----------------------- !
+      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing
+         avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk)
+         avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj  ,jk) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! lateral boundary condition
+
+      !                             !* output tidal mixing coefficient
+      CALL iom_put( "av_tide", zav_tide )
+
+      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk)
+      !
+      CALL wrk_dealloc( jpi,jpj,       zkz )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zav_tide )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx')
+      !
+   END SUBROUTINE zdf_tmx
+
+
+   SUBROUTINE tmx_itf( kt, pav )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tmx_itf  ***
+      !!                   
+      !! ** Purpose :   modify the vertical eddy diffusivity coefficients 
+      !!              (pav) in the Indonesian Through Flow area (ITF).
+      !!
+      !! ** Method  : - Following Koch-Larrouy et al. (2007), in the ITF defined
+      !!                by msk_itf (read in a file, see tmx_init), the tidal
+      !!                mixing coefficient is computed with :
+      !!                  * q=1 (i.e. all the tidal energy remains trapped in
+      !!                         the area and thus is used for mixing)
+      !!                  * the vertical distribution of the tifal energy is a
+      !!                    proportional to N above the thermocline (d(N^2)/dz > 0)
+      !!                    and to N^2 below the thermocline (d(N^2)/dz < 0)
+      !!
+      !! ** Action  :   av_tide   updated in the ITF area (msk_itf)
+      !!
+      !! References :  Koch-Larrouy et al. 2007, GRL 
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                         ::   kt   ! ocean time-step
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pav  ! Tidal mixing coef.
+      !! 
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zcoef, ztpc   ! temporary scalar
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zkz                        ! 2D workspace
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zsum1 , zsum2 , zsum       !  -      -
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zempba_3d_1, zempba_3d_2   ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zempba_3d  , zdn2dz        !  -      -
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   zavt_itf                   !  -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tmx_itf')
+      !
+      CALL wrk_alloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum )
+      CALL wrk_alloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf )
+
+      !                             ! compute the form function using N2 at each time step
+      zempba_3d_1(:,:,jpk) = 0.e0
+      zempba_3d_2(:,:,jpk) = 0.e0
+      DO jk = 1, jpkm1             
+         zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz
+         zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N
+         zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2
+      END DO
+      !
+      zsum (:,:) = 0.e0
+      zsum1(:,:) = 0.e0
+      zsum2(:,:) = 0.e0
+      DO jk= 2, jpk
+         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)
+         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)               
+      END DO
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( zsum1(ji,jj) /= 0.e0 )   zsum1(ji,jj) = 1.e0 / zsum1(ji,jj)
+            IF( zsum2(ji,jj) /= 0.e0 )   zsum2(ji,jj) = 1.e0 / zsum2(ji,jj)                
+         END DO
+      END DO
+
+      DO jk= 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcoef = 0.5 - SIGN( 0.5, zdn2dz(ji,jj,jk) )       ! =0 if dN2/dz > 0, =1 otherwise 
+               ztpc  = zempba_3d_1(ji,jj,jk) * zsum1(ji,jj) *        zcoef     &
+                  &  + zempba_3d_2(ji,jj,jk) * zsum2(ji,jj) * ( 1. - zcoef )
+               !
+               zempba_3d(ji,jj,jk) =               ztpc 
+               zsum     (ji,jj)    = zsum(ji,jj) + ztpc * e3w_n(ji,jj,jk)
+            END DO
+         END DO
+       END DO
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             IF( zsum(ji,jj) > 0.e0 )   zsum(ji,jj) = 1.e0 / zsum(ji,jj)                
+          END DO
+       END DO
+
+      !                             ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min) 
+      zcoef = rn_tfe_itf / ( rn_tfe * rau0 )
+      DO jk = 1, jpk
+         zavt_itf(:,:,jk) = MIN(  10.e-4, zcoef * en_tmx(:,:) * zsum(:,:) * zempba_3d(:,:,jk)   &
+            &                                      / MAX( rn_n2min, rn2(:,:,jk) ) * tmask(:,:,jk)  )
+      END DO           
+
+      zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column
+      DO jk = 2, jpkm1
+         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk)
+      END DO
+
+      DO jj = 1, jpj                ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
+         DO ji = 1, jpi
+            IF( zkz(ji,jj) /= 0.e0 )   zkz(ji,jj) = en_tmx(ji,jj) * rn_tfe_itf / rn_tfe / zkz(ji,jj)
+         END DO
+      END DO
+
+      DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s
+         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s
+      END DO
+
+      IF( kt == nit000 ) THEN       ! diagnose the nergy consumed by zavt_itf
+         ztpc = 0.e0
+         DO jk= 1, jpk
+            DO jj= 1, jpj
+               DO ji= 1, jpi
+                  ztpc = ztpc + e1e2t(ji,jj) * e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   &
+                     &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
+         ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf )
+         IF(lwp) WRITE(numout,*) '          N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW'
+      ENDIF
+
+      !                             ! Update pav with the ITF mixing coefficient
+      DO jk = 2, jpkm1
+         pav(:,:,jk) = pav     (:,:,jk) * ( 1.e0 - mask_itf(:,:) )   &
+            &        + zavt_itf(:,:,jk) *          mask_itf(:,:) 
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum )
+      CALL wrk_dealloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tmx_itf')
+      !
+   END SUBROUTINE tmx_itf
+
+
+   SUBROUTINE zdf_tmx_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tmx_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the vertical tidal mixing, Reading
+      !!              of M2 and K1 tidal energy in nc files
+      !!
+      !! ** Method  : - Read the namtmx namelist and check the parameters
+      !!
+      !!              - Read the input data in NetCDF files :
+      !!              M2 and K1 tidal energy. The total tidal energy, en_tmx, 
+      !!              is the sum of M2, K1 and S2 energy where S2 is assumed 
+      !!              to be: S2=(1/2)^2 * M2
+      !!              mask_itf, a mask array that determine where substituing 
+      !!              the standard Simmons et al. (2005) formulation with the
+      !!              one of Koch_Larrouy et al. (2007).
+      !!
+      !!              - Compute az_tmx, a 3D coefficient that allows to compute
+      !!             the standard tidal-induced vertical mixing as follows:
+      !!                  Kz_tides = az_tmx / max( rn_n2min, N^2 )
+      !!             with az_tmx a bottom intensified coefficient is given by:
+      !!                 az_tmx(z) = en_tmx / ( rau0 * rn_htmx ) * EXP( -(H-z)/rn_htmx )
+      !!                                                  / ( 1. - EXP( - H   /rn_htmx ) ) 
+      !!             where rn_htmx the characteristic length scale of the bottom 
+      !!             intensification, en_tmx the tidal energy, and H the ocean depth
+      !!
+      !! ** input   :   - Namlist namtmx
+      !!                - NetCDF file : M2_ORCA2.nc, K1_ORCA2.nc, and mask_itf.nc
+      !!
+      !! ** Action  : - Increase by 1 the nstop flag is setting problem encounter
+      !!              - defined az_tmx used to compute tidal-induced mixing
+      !!
+      !! References : Simmons et al. 2004, Ocean Modelling, 6, 3-4, 245-263.
+      !!              Koch-Larrouy et al. 2007, GRL.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   inum         ! local integer
+      INTEGER  ::   ios
+      REAL(wp) ::   ztpc, ze_z   ! local scalars
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zem2, zek1     ! read M2 and K1 tidal energy
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zkz            ! total M2, K1 and S2 tidal energy
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact          ! used for vertical structure function
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep          ! Ocean depth 
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zpc, zav_tide  ! power consumption
+      !!
+      NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init')
+      !
+      CALL wrk_alloc( jpi,jpj,       zem2, zek1, zkz, zfact, zhdep )
+      CALL wrk_alloc( jpi,jpj,jpk,   zpc, zav_tide )
+      !
+      REWIND( numnam_ref )             ! Namelist namzdf_tmx in reference namelist : Tidal Mixing
+      READ  ( numnam_ref, namzdf_tmx, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )             ! Namelist namzdf_tmx in configuration namelist : Tidal Mixing
+      READ  ( numnam_cfg, namzdf_tmx, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_tmx )
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tmx_init : tidal mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_tmx : set tidal mixing parameters'
+         WRITE(numout,*) '      Vertical decay scale for turbulence   = ', rn_htmx 
+         WRITE(numout,*) '      Brunt-Vaisala frequency threshold     = ', rn_n2min
+         WRITE(numout,*) '      Tidal dissipation efficiency          = ', rn_tfe
+         WRITE(numout,*) '      Mixing efficiency                     = ', rn_me
+         WRITE(numout,*) '      ITF specific parameterisation         = ', ln_tmx_itf
+         WRITE(numout,*) '      ITF tidal dissipation efficiency      = ', rn_tfe_itf
+      ENDIF
+      !                                ! allocate tmx arrays
+      IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' )
+
+      IF( ln_tmx_itf ) THEN            ! read the Indonesian Through Flow mask
+         CALL iom_open('mask_itf',inum)
+         CALL iom_get (inum, jpdom_data, 'tmaskitf',mask_itf,1) ! 
+         CALL iom_close(inum)
+      ENDIF
+      !                                ! read M2 tidal energy flux : W/m2  ( zem2 < 0 )
+      CALL iom_open('M2rowdrg',inum)
+      CALL iom_get (inum, jpdom_data, 'field',zem2,1) ! 
+      CALL iom_close(inum)
+      !                                ! read K1 tidal energy flux : W/m2  ( zek1 < 0 )
+      CALL iom_open('K1rowdrg',inum)
+      CALL iom_get (inum, jpdom_data, 'field',zek1,1) ! 
+      CALL iom_close(inum)
+      !                                ! Total tidal energy ( M2, S2 and K1  with S2=(1/2)^2 * M2 )
+      !                                ! only the energy available for mixing is taken into account,
+      !                                ! (mixing efficiency tidal dissipation efficiency)
+      en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:)
+
+!============
+!TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep?
+!!gm : you are right, but tidal mixing acts in deep ocean (H>500m) where e3 is O(100m)
+!!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation.
+      !                                ! Vertical structure (az_tmx)
+      DO jj = 1, jpj                         ! part independent of the level
+         DO ji = 1, jpi
+            zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
+            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)
+         END DO
+      END DO
+      DO jk= 1, jpk                          ! complete with the level-dependent part
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               az_tmx(ji,jj,jk) = zfact(ji,jj) * EXP( -( zhdep(ji,jj)-gdepw_0(ji,jj,jk) ) / rn_htmx ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+!===========
+      !
+      IF( nprint == 1 .AND. lwp ) THEN
+         ! Control print
+         ! Total power consumption due to vertical mixing
+         ! zpc = rau0 * 1/rn_me * rn2 * zav_tide
+         zav_tide(:,:,:) = 0.e0
+         DO jk = 2, jpkm1
+            zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) )
+         END DO
+         !
+         ztpc = 0._wp
+         zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
+         DO jk= 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
+         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc
+         !
+         WRITE(numout,*) 
+         WRITE(numout,*) '          Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW'
+         !
+         ! control print 2
+         zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )   
+         zkz(:,:) = 0._wp
+         DO jk = 2, jpkm1
+               zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
+         END DO
+         ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zkz(ji,jj) /= 0.e0 )   THEN
+                   zkz(ji,jj) = en_tmx(ji,jj) / zkz(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         ztpc = 1.e50
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zkz(ji,jj) /= 0.e0 )   THEN
+                   ztpc = Min( zkz(ji,jj), ztpc)
+               ENDIF
+            END DO
+         END DO
+         WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) )
+         !
+         DO jk = 2, jpkm1
+            zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s
+         END DO
+         ztpc = 0._wp
+         zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)
+         DO jk= 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
+         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc
+         WRITE(numout,*) '          2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW'
+!!gm bug mpp  in these diagnostics
+         DO jk = 1, jpk
+            ze_z =                  SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask   (:,:,jk) * tmask_i(:,:) ) )
+            ztpc = 1.e50
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc = MIN( ztpc, zav_tide(ji,jj,jk) )
+               END DO
+            END DO
+            WRITE(numout,*) '            N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',ztpc*1.e4,   &
+               &       'max= ', MAXVAL(zav_tide(:,:,jk) )*1.e4, ' cm2/s'
+         END DO
+
+         WRITE(numout,*) '          e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'
+         WRITE(numout,*) 
+         WRITE(numout,*) '          Initial profile of tidal vertical mixing'
+         DO jk = 1, jpk
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  zkz(ji,jj) = az_tmx(ji,jj,jk) /MAX( rn_n2min, rn2(ji,jj,jk) )
+               END DO
+            END DO
+            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )
+            WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s'
+         END DO
+         DO jk = 1, jpk
+            zkz(:,:) = az_tmx(:,:,jk) /rn_n2min
+            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )
+            WRITE(numout,*) 
+            WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   &
+               &       'max= ', MAXVAL(zkz)*1.e4, ' cm2/s'
+         END DO
+!!gm  end bug mpp
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep )
+      CALL wrk_dealloc( jpi,jpj,jpk, zpc, zav_tide )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx_init')
+      !
+   END SUBROUTINE zdf_tmx_init
+
+#elif defined key_zdftmx_new
+   !!----------------------------------------------------------------------
+   !!   'key_zdftmx_new'               Internal wave-driven vertical mixing
+   !!----------------------------------------------------------------------
+   !!   zdf_tmx       : global     momentum & tracer Kz with wave induced Kz
+   !!   zdf_tmx_init  : global     momentum & tracer Kz with wave induced Kz
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE zdf_oce        ! ocean vertical physics variables
+   USE zdfddm         ! ocean vertical physics: double diffusive mixing
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE eosbn2         ! ocean equation of state
+   USE phycst         ! physical constants
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O Manager
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_tmx         ! called in step module 
+   PUBLIC   zdf_tmx_init    ! called in nemogcm module 
+   PUBLIC   zdf_tmx_alloc   ! called in nemogcm module
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: wave-driven mixing flag
+
+   !                       !!* Namelist  namzdf_tmx : internal wave-driven mixing *
+   INTEGER  ::  nn_zpyc     ! pycnocline-intensified mixing energy proportional to N (=1) or N^2 (=2)
+   LOGICAL  ::  ln_mevar    ! variable (=T) or constant (=F) mixing efficiency
+   LOGICAL  ::  ln_tsdiff   ! account for differential T/S wave-driven mixing (=T) or not (=F)
+
+   REAL(wp) ::  r1_6 = 1._wp / 6._wp
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ebot_tmx     ! power available from high-mode wave breaking (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   epyc_tmx     ! power available from low-mode, pycnocline-intensified wave breaking (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ecri_tmx     ! power available from low-mode, critical slope wave breaking (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hbot_tmx     ! WKB decay scale for high-mode energy dissipation (m)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hcri_tmx     ! decay scale for low-mode critical slope dissipation (m)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   emix_tmx     ! local energy density available for mixing (W/kg)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bflx_tmx     ! buoyancy flux Kz * N^2 (W/kg)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   pcmap_tmx    ! vertically integrated buoyancy flux (W/m2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zav_ratio    ! S/T diffusivity ratio (only for ln_tsdiff=T)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zav_wave     ! Internal wave-induced diffusivity
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_tmx_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_tmx_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE(     ebot_tmx(jpi,jpj),  epyc_tmx(jpi,jpj),  ecri_tmx(jpi,jpj)    ,   &
+      &             hbot_tmx(jpi,jpj),  hcri_tmx(jpi,jpj),  emix_tmx(jpi,jpj,jpk),   &
+      &         bflx_tmx(jpi,jpj,jpk), pcmap_tmx(jpi,jpj), zav_ratio(jpi,jpj,jpk),   & 
+      &         zav_wave(jpi,jpj,jpk), STAT=zdf_tmx_alloc     )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_tmx_alloc )
+      IF( zdf_tmx_alloc /= 0 )   CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays')
+   END FUNCTION zdf_tmx_alloc
+
+
+   SUBROUTINE zdf_tmx( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tmx  ***
+      !!                   
+      !! ** Purpose :   add to the vertical mixing coefficients the effect of
+      !!              breaking internal waves.
+      !!
+      !! ** Method  : - internal wave-driven vertical mixing is given by:
+      !!                  Kz_wave = min(  100 cm2/s, f(  Reb = emix_tmx /( Nu * N^2 )  )
+      !!              where emix_tmx is the 3D space distribution of the wave-breaking 
+      !!              energy and Nu the molecular kinematic viscosity.
+      !!              The function f(Reb) is linear (constant mixing efficiency)
+      !!              if the namelist parameter ln_mevar = F and nonlinear if ln_mevar = T.
+      !!
+      !!              - Compute emix_tmx, the 3D power density that allows to compute
+      !!              Reb and therefrom the wave-induced vertical diffusivity.
+      !!              This is divided into three components:
+      !!                 1. Bottom-intensified low-mode dissipation at critical slopes
+      !!                     emix_tmx(z) = ( ecri_tmx / rau0 ) * EXP( -(H-z)/hcri_tmx )
+      !!                                   / ( 1. - EXP( - H/hcri_tmx ) ) * hcri_tmx
+      !!              where hcri_tmx is the characteristic length scale of the bottom 
+      !!              intensification, ecri_tmx a map of available power, and H the ocean depth.
+      !!                 2. Pycnocline-intensified low-mode dissipation
+      !!                     emix_tmx(z) = ( epyc_tmx / rau0 ) * ( sqrt(rn2(z))^nn_zpyc )
+      !!                                   / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) )
+      !!              where epyc_tmx is a map of available power, and nn_zpyc
+      !!              is the chosen stratification-dependence of the internal wave
+      !!              energy dissipation.
+      !!                 3. WKB-height dependent high mode dissipation
+      !!                     emix_tmx(z) = ( ebot_tmx / rau0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_tmx)
+      !!                                   / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_tmx) * e3w(z) )
+      !!              where hbot_tmx is the characteristic length scale of the WKB bottom 
+      !!              intensification, ebot_tmx is a map of available power, and z_wkb is the
+      !!              WKB-stretched height above bottom defined as
+      !!                    z_wkb(z) = H * SUM( sqrt(rn2(z'>=z)) * e3w(z'>=z) )
+      !!                                 / SUM( sqrt(rn2(z'))    * e3w(z')    )
+      !!
+      !!              - update the model vertical eddy viscosity and diffusivity: 
+      !!                     avt  = avt  +    av_wave
+      !!                     avm  = avm  +    av_wave
+      !!                     avmu = avmu + mi(av_wave)
+      !!                     avmv = avmv + mj(av_wave)
+      !!
+      !!              - if namelist parameter ln_tsdiff = T, account for differential mixing:
+      !!                     avs  = avt  +    av_wave * diffusivity_ratio(Reb)
+      !!
+      !! ** Action  : - Define emix_tmx used to compute internal wave-induced mixing
+      !!              - avt, avs, avm, avmu, avmv increased by internal wave-driven mixing    
+      !!
+      !! References :  de Lavergne et al. 2015, JPO; 2016, in prep.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   ztpc         ! scalar workspace
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zfact     ! Used for vertical structure
+      REAL(wp), DIMENSION(:,:)  , POINTER ::  zhdep     ! Ocean depth
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zwkb      ! WKB-stretched height above bottom
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zweight   ! Weight for high mode vertical distribution
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  znu_t     ! Molecular kinematic viscosity (T grid)
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  znu_w     ! Molecular kinematic viscosity (W grid)
+      REAL(wp), DIMENSION(:,:,:), POINTER ::  zReb      ! Turbulence intensity parameter
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('zdf_tmx')
+      !
+      CALL wrk_alloc( jpi,jpj,       zfact, zhdep )
+      CALL wrk_alloc( jpi,jpj,jpk,   zwkb, zweight, znu_t, znu_w, zReb )
+
+      !                          ! ----------------------------- !
+      !                          !  Internal wave-driven mixing  !  (compute zav_wave)
+      !                          ! ----------------------------- !
+      !                             
+      !                        !* Critical slope mixing: distribute energy over the time-varying ocean depth,
+      !                                                 using an exponential decay from the seafloor.
+      DO jj = 1, jpj                ! part independent of the level
+         DO ji = 1, jpi
+            zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
+            zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_tmx(ji,jj) )  )
+            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ecri_tmx(ji,jj) / zfact(ji,jj)
+         END DO
+      END DO
+
+      DO jk = 2, jpkm1              ! complete with the level-dependent part
+         emix_tmx(:,:,jk) = zfact(:,:) * (  EXP( ( gde3w_n(:,:,jk  ) - zhdep(:,:) ) / hcri_tmx(:,:) )                      &
+            &                             - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) )  ) * wmask(:,:,jk)   &
+            &                          / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) )
+      END DO
+
+      !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying 
+      !                        !* ocean depth as proportional to sqrt(rn2)^nn_zpyc
+
+      SELECT CASE ( nn_zpyc )
+
+      CASE ( 1 )               ! Dissipation scales as N (recommended)
+
+         zfact(:,:) = 0._wp
+         DO jk = 2, jpkm1              ! part independent of the level
+            zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         END DO
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_tmx(ji,jj) / ( rau0 * zfact(ji,jj) )
+            END DO
+         END DO
+
+         DO jk = 2, jpkm1              ! complete with the level-dependent part
+            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         END DO
+
+      CASE ( 2 )               ! Dissipation scales as N^2
+
+         zfact(:,:) = 0._wp
+         DO jk = 2, jpkm1              ! part independent of the level
+            zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)
+         END DO
+
+         DO jj= 1, jpj
+            DO ji = 1, jpi
+               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_tmx(ji,jj) / ( rau0 * zfact(ji,jj) )
+            END DO
+         END DO
+
+         DO jk = 2, jpkm1              ! complete with the level-dependent part
+            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)
+         END DO
+
+      END SELECT
+
+      !                        !* WKB-height dependent mixing: distribute energy over the time-varying 
+      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot)
+      
+      zwkb(:,:,:) = 0._wp
+      zfact(:,:) = 0._wp
+      DO jk = 2, jpkm1
+         zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk)
+         zwkb(:,:,jk) = zfact(:,:)
+      END DO
+
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   &
+                                            &           * tmask(ji,jj,jk) / zfact(ji,jj)
+            END DO
+         END DO
+      END DO
+      zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1)
+
+      zweight(:,:,:) = 0._wp
+      DO jk = 2, jpkm1
+         zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_tmx(:,:) * wmask(:,:,jk)                    &
+            &   * (  EXP( -zwkb(:,:,jk) / hbot_tmx(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_tmx(:,:) )  )
+      END DO
+
+      zfact(:,:) = 0._wp
+      DO jk = 2, jpkm1              ! part independent of the level
+         zfact(:,:) = zfact(:,:) + zweight(:,:,jk)
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_tmx(ji,jj) / ( rau0 * zfact(ji,jj) )
+         END DO
+      END DO
+
+      DO jk = 2, jpkm1              ! complete with the level-dependent part
+         emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   &
+            &                                / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) )
+      END DO
+
+
+      ! Calculate molecular kinematic viscosity
+      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  &
+         &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0
+      DO jk = 2, jpkm1
+         znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk)
+      END DO
+
+      ! Calculate turbulence intensity parameter Reb
+      DO jk = 2, jpkm1
+         zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) )
+      END DO
+
+      ! Define internal wave-induced diffusivity
+      DO jk = 2, jpkm1
+         zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6
+      END DO
+
+      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the
+         DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( zReb(ji,jj,jk) > 480.00_wp ) THEN
+                     zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
+                  ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN
+                     zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      DO jk = 2, jpkm1                 ! Bound diffusivity by molecular value and 100 cm2/s
+         zav_wave(:,:,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp  ) * wmask(:,:,jk)
+      END DO
+
+      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave
+         ztpc = 0._wp
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj)   &
+                     &         * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztpc )
+         ztpc = rau0 * ztpc ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
+ 
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'zdf_tmx : Internal wave-driven mixing (tmx)'
+            WRITE(numout,*) '~~~~~~~ '
+            WRITE(numout,*)
+            WRITE(numout,*) '      Total power consumption by av_wave: ztpc =  ', ztpc * 1.e-12_wp, 'TW'
+         ENDIF
+      ENDIF
+
+      !                          ! ----------------------- !
+      !                          !   Update  mixing coefs  !                          
+      !                          ! ----------------------- !
+      !      
+      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature
+         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zav_ratio(ji,jj,jk) = ( 0.505_wp + 0.495_wp *                                                                  &
+                      &   TANH(    0.92_wp * (   LOG10(  MAX( 1.e-20_wp, zReb(ji,jj,jk) * 5._wp * r1_6 )  ) - 0.60_wp   )    )   &
+                      &                 ) * wmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL iom_put( "av_ratio", zav_ratio )
+         DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing
+            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk)
+            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)
+            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk)
+         END DO
+         !
+      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing
+         DO jk = 2, jpkm1
+            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)
+            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk)
+            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk)
+         END DO
+      ENDIF
+
+      DO jk = 2, jpkm1              !* update momentum diffusivity at wu and wv points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1  ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5_wp * ( zav_wave(ji,jj,jk) + zav_wave(ji+1,jj  ,jk) ) * wumask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5_wp * ( zav_wave(ji,jj,jk) + zav_wave(ji  ,jj+1,jk) ) * wvmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! lateral boundary condition
+
+      !                             !* output internal wave-driven mixing coefficient
+      CALL iom_put( "av_wave", zav_wave )
+                                    !* output useful diagnostics: N^2, Kz * N^2 (bflx_tmx), 
+                                    !  vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx)
+      IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN
+         bflx_tmx(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:)
+         pcmap_tmx(:,:) = 0._wp
+         DO jk = 2, jpkm1
+            pcmap_tmx(:,:) = pcmap_tmx(:,:) + e3w_n(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk)
+         END DO
+         pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:)
+         CALL iom_put( "bflx_tmx", bflx_tmx )
+         CALL iom_put( "pcmap_tmx", pcmap_tmx )
+      ENDIF
+      CALL iom_put( "bn2", rn2 )
+      CALL iom_put( "emix_tmx", emix_tmx )
+      
+      CALL wrk_dealloc( jpi,jpj,       zfact, zhdep )
+      CALL wrk_dealloc( jpi,jpj,jpk,   zwkb, zweight, znu_t, znu_w, zReb )
+
+      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' tmx - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('zdf_tmx')
+      !
+   END SUBROUTINE zdf_tmx
+
+
+   SUBROUTINE zdf_tmx_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tmx_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the wave-driven vertical mixing, reading
+      !!              of input power maps and decay length scales in netcdf files.
+      !!
+      !! ** Method  : - Read the namzdf_tmx namelist and check the parameters
+      !!
+      !!              - Read the input data in NetCDF files :
+      !!              power available from high-mode wave breaking (mixing_power_bot.nc)
+      !!              power available from pycnocline-intensified wave-breaking (mixing_power_pyc.nc)
+      !!              power available from critical slope wave-breaking (mixing_power_cri.nc)
+      !!              WKB decay scale for high-mode wave-breaking (decay_scale_bot.nc)
+      !!              decay scale for critical slope wave-breaking (decay_scale_cri.nc)
+      !!
+      !! ** input   : - Namlist namzdf_tmx
+      !!              - NetCDF files : mixing_power_bot.nc, mixing_power_pyc.nc, mixing_power_cri.nc,
+      !!              decay_scale_bot.nc decay_scale_cri.nc
+      !!
+      !! ** Action  : - Increase by 1 the nstop flag is setting problem encounter
+      !!              - Define ebot_tmx, epyc_tmx, ecri_tmx, hbot_tmx, hcri_tmx
+      !!
+      !! References : de Lavergne et al. 2015, JPO; 2016, in prep.
+      !!			  
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   inum         ! local integer
+      INTEGER  ::   ios
+      REAL(wp) ::   zbot, zpyc, zcri   ! local scalars
+      !!
+      NAMELIST/namzdf_tmx_new/ nn_zpyc, ln_mevar, ln_tsdiff
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx_init')
+      !
+      REWIND( numnam_ref )              ! Namelist namzdf_tmx in reference namelist : Wave-driven mixing
+      READ  ( numnam_ref, namzdf_tmx_new, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist namzdf_tmx in configuration namelist : Wave-driven mixing
+      READ  ( numnam_cfg, namzdf_tmx_new, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzdf_tmx_new )
+      !
+      IF(lwp) THEN                  ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tmx_init : internal wave-driven mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_tmx_new : set wave-driven mixing parameters'
+         WRITE(numout,*) '      Pycnocline-intensified diss. scales as N (=1) or N^2 (=2) = ', nn_zpyc
+         WRITE(numout,*) '      Variable (T) or constant (F) mixing efficiency            = ', ln_mevar
+         WRITE(numout,*) '      Differential internal wave-driven mixing (T) or not (F)   = ', ln_tsdiff
+      ENDIF
+      
+      ! The new wave-driven mixing parameterization elevates avt and avm in the interior, and
+      ! ensures that avt remains larger than its molecular value (=1.4e-7). Therefore, avtb should 
+      ! be set here to a very small value, and avmb to its (uniform) molecular value (=1.4e-6).
+      avmb(:) = 1.4e-6_wp        ! viscous molecular value
+      avtb(:) = 1.e-10_wp        ! very small diffusive minimum (background avt is specified in zdf_tmx)    
+      avtb_2d(:,:) = 1.e0_wp     ! uniform 
+      IF(lwp) THEN                  ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Force the background value applied to avm & avt in TKE to be everywhere ',   &
+            &               'the viscous molecular value & a very small diffusive value, resp.'
+      ENDIF
+      
+      IF( .NOT.lk_zdfddm )   CALL ctl_stop( 'STOP', 'zdf_tmx_init_new : key_zdftmx_new requires key_zdfddm' )
+      
+      !                             ! allocate tmx arrays
+      IF( zdf_tmx_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tmx_init : unable to allocate tmx arrays' )
+      !
+      !                             ! read necessary fields
+      CALL iom_open('mixing_power_bot',inum)       ! energy flux for high-mode wave breaking [W/m2]
+      CALL iom_get  (inum, jpdom_data, 'field', ebot_tmx, 1 ) 
+      CALL iom_close(inum)
+      !
+      CALL iom_open('mixing_power_pyc',inum)       ! energy flux for pynocline-intensified wave breaking [W/m2]
+      CALL iom_get  (inum, jpdom_data, 'field', epyc_tmx, 1 )
+      CALL iom_close(inum)
+      !
+      CALL iom_open('mixing_power_cri',inum)       ! energy flux for critical slope wave breaking [W/m2]
+      CALL iom_get  (inum, jpdom_data, 'field', ecri_tmx, 1 )
+      CALL iom_close(inum)
+      !
+      CALL iom_open('decay_scale_bot',inum)        ! spatially variable decay scale for high-mode wave breaking [m]
+      CALL iom_get  (inum, jpdom_data, 'field', hbot_tmx, 1 )
+      CALL iom_close(inum)
+      !
+      CALL iom_open('decay_scale_cri',inum)        ! spatially variable decay scale for critical slope wave breaking [m]
+      CALL iom_get  (inum, jpdom_data, 'field', hcri_tmx, 1 )
+      CALL iom_close(inum)
+
+      ebot_tmx(:,:) = ebot_tmx(:,:) * ssmask(:,:)
+      epyc_tmx(:,:) = epyc_tmx(:,:) * ssmask(:,:)
+      ecri_tmx(:,:) = ecri_tmx(:,:) * ssmask(:,:)
+
+      ! Set once for all to zero the first and last vertical levels of appropriate variables
+      emix_tmx (:,:, 1 ) = 0._wp
+      emix_tmx (:,:,jpk) = 0._wp
+      zav_ratio(:,:, 1 ) = 0._wp
+      zav_ratio(:,:,jpk) = 0._wp
+      zav_wave (:,:, 1 ) = 0._wp
+      zav_wave (:,:,jpk) = 0._wp
+
+      zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) )
+      zpyc = glob_sum( e1e2t(:,:) * epyc_tmx(:,:) )
+      zcri = glob_sum( e1e2t(:,:) * ecri_tmx(:,:) )
+      IF(lwp) THEN
+         WRITE(numout,*) '      High-mode wave-breaking energy:             ', zbot * 1.e-12_wp, 'TW'
+         WRITE(numout,*) '      Pycnocline-intensifed wave-breaking energy: ', zpyc * 1.e-12_wp, 'TW'
+         WRITE(numout,*) '      Critical slope wave-breaking energy:        ', zcri * 1.e-12_wp, 'TW'
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx_init')
+      !
+   END SUBROUTINE zdf_tmx_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module                NO Tidal MiXing
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .FALSE.   !: tidal mixing flag
+CONTAINS
+   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
+#endif
+
+   !!======================================================================
+END MODULE zdftmx
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90	(revision 8732)
@@ -0,0 +1,34 @@
+!  Cray subroutines or functions used by OPA model and possibly 
+!  not found on other platforms.
+!
+!  check their existence
+!  
+!  wheneq
+!!----------------------------------------------------------------------
+!!  OPA 9.0 , LOCEAN-IPSL (2005) 
+!! $Id$ 
+!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+!!----------------------------------------------------------------------
+SUBROUTINE lib_cray
+      WRITE(*,*) 'lib_cray: You should not have seen this print! error?'
+END SUBROUTINE lib_cray
+
+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
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 8732)
@@ -0,0 +1,629 @@
+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
+   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max 
+   !!                                           + 3d dim. of input is fexible (jpk, jpl...) 
+   !!            4.0  !  2016-06  (T. Lovato)  double precision global sum by default 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 dom_oce         ! ocean domain
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
+   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos)
+   PUBLIC   DDPDD         ! also used in closea module
+   PUBLIC   glob_min, glob_max
+#if defined key_nosignedzero
+   PUBLIC SIGN
+#endif
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, &
+         &             glob_sum_2d_a, glob_sum_3d_a
+   END INTERFACE
+   INTERFACE glob_sum_full
+      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
+   END INTERFACE
+   INTERFACE glob_min
+      MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a 
+   END INTERFACE
+   INTERFACE glob_max
+      MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_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
+
+   ! --- SUM ---
+   FUNCTION glob_sum_1d( ptab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_1d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in) :: kdim
+      REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab
+      REAL(wp)                              ::   glob_sum_1d   ! global sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO ji = 1, kdim
+         ztmp =  ptab(ji)
+         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_1d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_1d
+
+   FUNCTION glob_sum_2d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
+      REAL(wp)                             ::   glob_sum_2d   ! 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_2d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_2d
+
+
+   FUNCTION glob_sum_3d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
+      REAL(wp)                               ::   glob_sum_3d   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ijpk ! local variables: size of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, ijpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab(ji,jj,jk) * tmask_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_3d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d
+
+
+   FUNCTION glob_sum_2d_a( ptab1, ptab2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d_a ***
+      !!
+      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2
+      REAL(wp)                             ::   glob_sum_2d_a   ! 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_2d_a = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_2d_a
+
+
+   FUNCTION glob_sum_3d_a( ptab1, ptab2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3d_a ***
+      !!
+      !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2
+      REAL(wp)                               ::   glob_sum_3d_a   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ijpk ! local variables: size of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab1,3)
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, ijpk
+         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_3d_a = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d_a   
+
+   FUNCTION glob_sum_full_2d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
+      REAL(wp)                             ::   glob_sum_full_2d   ! global sum (nomask)
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jj = 1, jpj
+         DO ji =1, jpi
+         ztmp =  ptab(ji,jj) * tmask_h(ji,jj) 
+         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_full_2d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_full_2d
+
+   FUNCTION glob_sum_full_3d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
+      REAL(wp)                               ::   glob_sum_full_3d   ! global sum (nomask)
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ijpk ! local variables: size of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, ijpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab(ji,jj,jk) * tmask_h(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_full_3d = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_full_3d
+
+   ! --- MIN ---
+   FUNCTION glob_min_2d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_2D  ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of a 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
+      REAL(wp)                             ::   glob_min_2d   ! global masked min
+      !!-----------------------------------------------------------------------
+      !
+      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_min( glob_min_2d )
+      !
+   END FUNCTION glob_min_2d
+ 
+   FUNCTION glob_min_3d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_3D  ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of a 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
+      REAL(wp)                               ::   glob_min_3d   ! global masked min
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_min( glob_min_3d )
+      !
+   END FUNCTION glob_min_3d
+
+
+   FUNCTION glob_min_2d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_2D _a ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of two 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
+      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min
+      !!-----------------------------------------------------------------------
+      !             
+      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) )
+      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 )
+      !
+   END FUNCTION glob_min_2d_a
+ 
+ 
+   FUNCTION glob_min_3d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_3D_a ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of two 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
+      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab1,3)
+      !
+      glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) )
+      glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) )
+         glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 )
+      !
+   END FUNCTION glob_min_3d_a
+
+   ! --- MAX ---
+   FUNCTION glob_max_2d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_2D  ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of a 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
+      REAL(wp)                             ::   glob_max_2d   ! global masked max
+      !!-----------------------------------------------------------------------
+      !
+      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_max( glob_max_2d )
+      !
+   END FUNCTION glob_max_2d
+ 
+   FUNCTION glob_max_3d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_3D  ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of a 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
+      REAL(wp)                               ::   glob_max_3d   ! global masked max
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_max( glob_max_3d )
+      !
+   END FUNCTION glob_max_3d
+
+
+   FUNCTION glob_max_2d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_2D _a ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of two 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
+      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max
+      !!-----------------------------------------------------------------------
+      !             
+      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) )
+      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 )
+      !
+   END FUNCTION glob_max_2d_a
+ 
+ 
+   FUNCTION glob_max_3d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_3D_a ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of two 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
+      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab1,3)
+      !
+      glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) )
+      glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) )
+         glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 )
+      !
+   END FUNCTION glob_max_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
+
+#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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/module_example
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 8732)
@@ -0,0 +1,206 @@
+MODULE exampl
+   !!======================================================================
+   !!                       ***  MODULE  exampl  ***
+   !! Ocean physics:  brief description of the purpose of the module
+   !!                 (please no more than 2 lines)
+   !!======================================================================
+   !! History : 3.0  !  2008-06  (Author Names)  Original code
+   !!            -   !  2008-08  (Author names)  brief description of modifications
+   !!           3.3  !  2010-11  (Author names)        -              -
+   !!----------------------------------------------------------------------
+#if defined key_example
+   !!----------------------------------------------------------------------
+   !!   'key_example'  :                brief description of the key option
+   !!----------------------------------------------------------------------
+   !!   exa_mpl       : list 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
+   !!----------------------------------------------------------------------
+   USE module_name1   ! brief description of the used module
+   USE module_name2   ! ....
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   exa_mpl        ! routine called in xxx.F90 module
+   PUBLIC   exa_mpl_init   ! routine called in nemogcm.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, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe
+   !                                                          !  a PUBLIC variable: simplify its search : 
+   !                                                          !  grep var1 *90 | grep '!:'
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but 
+   !                                                          !  DO NOT use continuation lines in declaration
+
+   !                               !!* 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)
+   REAL(wp)                         ::   var     ! var         -                -
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                -
+
+   !! * Substitutions
+#  include "exampl_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION exa_mpl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION exa_mpl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                                
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( exa_mpl_alloc )
+      IF( exa_mpl_alloc /= 0 )   CALL ctl_warn('exa_mpl_alloc: failed to allocate arrays')
+      !
+   END FUNCTION exa_mpl_alloc
+   
+
+   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )
+      !!----------------------------------------------------------------------
+      !!                    ***  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 :   Author et al., Short_name_review, Year
+      !!                Give references if exist otherwise suppress these lines
+      !!----------------------------------------------------------------------
+      USE toto_module      ! description of the module
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   zztab => wrk_2d_5                     ! 2D workspace
+      USE wrk_nemo, ONLY:   zwx => wrk_3d_12 , zwy => wrk_3d_13   ! 3D workspace
+      !!
+      INTEGER , INTENT(in   )                     ::   kt      ! short description 
+      INTEGER , INTENT(inout)                     ::   pvar1   !   -         -
+      REAL(wp), INTENT(  out)                     ::   pvar2   !   -         -
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pvar2   !   -         -
+      !!
+      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp)
+      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i
+      REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z)
+      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration
+      !!--------------------------------------------------------------------
+
+      IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN
+         CALL ctl_stop('exa_mpl: requested workspace arrays unavailable')   ;   RETURN
+      ENDIF
+
+      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
+
+      zmlmin = 1.e-8                             ! Local constant initialization
+      zbbrau =  .5 * ebb / rau0
+      zfact1 = -.5 * rdt * efave
+      zfact2 = 1.5 * rdt * ediss
+
+      SELECT CASE ( npdl )                       ! short description of the action
+      !
+      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
+      !
+      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign)
+      !
+      IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN
+         CALL ctl_stop('exa_mpl: failed to release workspace arrays')   ;   RETURN
+      ENDIF
+      !
+   END SUBROUTINE exa_mpl
+
+
+   SUBROUTINE exa_mpl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE exa_mpl_init  ***
+      !!                   
+      !! ** Purpose :   initialization of ....
+      !!
+      !! ** Method  :   blah blah blah ...
+      !!
+      !! ** input   :   Namlist namexa
+      !!
+      !! ** Action  :   ...  
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
+      INTEGER  ::   ios              ! Local integer output status for namelist read
+      !!
+      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namexa in reference namelist : Example
+      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namexa in configuration namelist : Example
+      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist', lwp )
+   ! Output namelist for control
+      WRITE ( numond, 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_v2  = ', exa_v2
+         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
+      !
+      !                              ! allocate exa_mpl arrays      
+      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' )
+      !                              ! Parameter control
+      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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                         NO example
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine
+      REAL::   ptab(:,:)
+      WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1)
+   END SUBROUTINE exa_mpl
+#endif
+
+   !!======================================================================
+END MODULE exampl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemo.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemo.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemo.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 8732)
@@ -0,0 +1,869 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
+   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE step_oce       ! module used in the ocean time stepping module (step.F90)
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE domain         ! domain initialization   (dom_init & dom_cfg routines)
+   USE usrdef_nam     ! user defined configuration
+   USE tideini        ! tidal components initialization   (tide_ini routine)
+   USE bdy_oce,   ONLY: ln_bdy
+   USE bdyini         ! open boundary cond. setting       (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 trdini         ! dyn/tra trends initialization     (trd_init routine)
+   USE asminc         ! assimilation increments     
+   USE asmbkg         ! writing out state trajectory
+   USE diaptr         ! poleward transports           (dia_ptr_init routine)
+   USE diadct         ! sections transports           (dia_dct_init routine)
+   USE diaobs         ! Observation diagnostics       (dia_obs_init routine)
+   USE diacfl         ! CFL diagnostics               (dia_cfl_init routine)
+   USE step           ! NEMO time-stepping                 (stp     routine)
+   USE icbini         ! handle bergs, initialisation
+   USE icbstp         ! handle bergs, calving, themodynamics and transport
+   USE cpl_oasis3     ! OASIS3 coupling
+   USE c1d            ! 1D configuration
+   USE step_c1d       ! Time stepping loop for the 1D configuration
+   USE dyndmp         ! Momentum damping
+   USE stopar         ! Stochastic param.: ???
+   USE stopts         ! Stochastic param.: ???
+   USE diurnal_bulk   ! diurnal bulk SST 
+   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline)
+   USE crsini         ! initialise grid coarsening utility
+   USE diatmb         ! Top,middle,bottom output
+   USE dia25h         ! 25h mean output
+   USE sbc_oce , ONLY : lk_oasis
+   USE wet_dry        ! Wetting and drying setting   (wad_init routine)
+#if defined key_top
+   USE trcini         ! passive tracer initialisation
+#endif
+#if defined key_nemocice_decomp
+   USE ice_domain_size, only: nx_global, ny_global
+#endif
+   !
+   USE lib_mpp        ! distributed memory computing
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_iomput
+   USE xios           ! xIOserver
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+   PUBLIC   nemo_alloc  ! needed by TAM
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2016)
+   !! $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  ==!
+      !                            !-----------------------!
+#if defined key_agrif
+      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
+      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
+# if defined key_top
+      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
+# endif
+# if defined key_lim2
+      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM2
+# endif
+# if defined key_lim3
+      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3
+# endif
+#endif
+      ! 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_asmdin ) THEN                        ! Direct initialization
+                IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 )    ! Tracers
+                IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics
+                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH
+             ENDIF
+          ENDIF
+
+#if defined key_agrif
+          CALL Agrif_Regrid()
+#endif
+
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+#if defined key_agrif
+            CALL stp                         ! AGRIF: time stepping
+#else
+            IF ( .NOT. ln_diurnal_only ) THEN 
+               CALL stp( istp )                 ! standard time stepping 
+            ELSE 
+               CALL stp_diurnal( istp )        ! time step only the diurnal SST 
+            ENDIF 
+#endif
+            istp = istp + 1
+            IF( lk_mpp )   CALL mpp_max( nstop )
+         END DO
+#endif
+
+      IF( ln_diaobs   )   CALL dia_obs_wri
+      !
+      IF( ln_icebergs )   CALL icb_end( nitend )
+
+      !                            !------------------------!
+      !                            !==  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
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+                         CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( ln_diaobs ) CALL dia_obs_wri
+         IF( nn_timing == 1 )   CALL timing_finalize
+                                CALL Agrif_ChildGrid_To_ParentGrid()
+      ENDIF
+#endif
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
+      CALL nemo_closefile
+      !
+#if defined key_iomput
+      CALL xios_finalize                     ! end mpp communications with xios
+      IF( lk_oasis )   CALL cpl_finalize     ! end coupling and mpp communications with OASIS
+#else
+      IF( lk_oasis ) THEN 
+         CALL cpl_finalize                   ! end coupling and mpp communications with OASIS
+      ELSE
+         IF( lk_mpp )   CALL mppstop         ! end mpp communications
+      ENDIF
+#endif
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji                 ! dummy loop indices
+      INTEGER  ::   ios, ilocal_comm   ! local integer
+      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
+      !
+      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_timing, nn_diacfl
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
+      cltxt  = ''
+      cltxt2 = ''
+      clnam  = ''  
+      cxios_context = 'nemo'
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+      !
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+      !                             !--------------------------!
+      !                             !  Set global domain size  !   (control print return in cltxt2)
+      !                             !--------------------------!
+      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
+         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+         !
+      ELSE                                ! user-defined namelist
+         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+      ENDIF
+      !
+      jpk = jpkglo
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
+         jpiglo  = nbcellsx + 2 + 2*nbghostcells
+         jpjglo  = nbcellsy + 2 + 2*nbghostcells
+         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+         nperio  = 0
+         jperio  = 0
+         ln_use_jattr = .false.
+      ENDIF
+#endif
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis
+            CALL xios_initialize( "not used"       ,local_comm= ilocal_comm )    ! send nemo communicator to xios
+         ELSE
+            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+#else
+      IF( lk_oasis ) THEN
+         IF( Agrif_Root() ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis
+         ENDIF
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+      ELSE
+         ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
+      ENDIF
+#endif
+
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN               ! write merged namelists from earlier to output namelist 
+         !                       ! now that the file has been opened in call to mynode. 
+         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+         IF( .NOT.ln_read_cfg ) THEN
+            DO ji = 1, SIZE(clnam)
+               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
+            END DO
+         ENDIF
+      ENDIF
+
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+#if   defined key_mpp_mpi
+         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
+#else
+         jpni  = 1
+         jpnj  = 1
+         jpnij = jpni*jpnj
+#endif
+      ENDIF
+
+      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
+#if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
+#else
+         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+#endif
+      ENDIF
+
+!!gm ???    why here  it has already been done in line 301 !
+      jpk = jpkglo                                             ! third dim
+!!gm end
+
+#if defined key_agrif
+      ! simple trick to use same vertical grid as parent but different number of levels: 
+      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
+      ! Suppress once vertical online interpolation is ok
+      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
+#endif
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                NEMO version 3.7  (2016) '
+         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,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt2)
+            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size
+         END DO
+         !
+         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration
+                            CALL     wad_init   ! Wetting and drying options
+                            CALL     dom_init   ! Domain
+      IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization 
+      IF( ln_nnogather )    CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined)
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+      
+      CALL diurnal_sst_bulk_init            ! diurnal sst
+      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin   
+      
+      ! IF ln_diurnal_only, then we only want a subset of the initialisation routines
+      IF ( ln_diurnal_only ) THEN
+         CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+         CALL     sbc_init   ! Forcings : surface module
+         CALL tra_qsr_init   ! penetrative solar radiation qsr
+         IF( ln_diaobs     ) THEN                  ! Observation & model comparison
+            CALL dia_obs_init            ! Initialize observational data
+            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+         ENDIF     
+         !                                     ! Assimilation increments
+         IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+                 
+         IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+         RETURN
+      ENDIF
+      
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+
+      !                                      ! external forcing 
+!!gm to be added : creation and call of sbc_apr_init
+                            CALL    tide_init   ! tidal harmonics
+                            CALL     sbc_init   ! surface boundary conditions (including sea-ice)
+                            CALL     bdy_init   ! Open boundaries initialisation
+      !                                      ! Ocean physics
+      !                                         ! 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_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
+      IF( lk_zdfddm     )   CALL zdf_ddm_init      ! double diffusive mixing
+         
+      !                                         ! Lateral physics
+                            CALL ldf_tra_init      ! Lateral ocean tracer physics
+                            CALL ldf_eiv_init      ! eddy induced velocity param.
+                            CALL ldf_dyn_init      ! Lateral ocean momentum physics
+
+      !                                         ! Active tracers
+                            CALL tra_qsr_init      ! penetrative solar radiation qsr
+                            CALL tra_bbc_init      ! bottom heat flux
+      IF( lk_trabbl     )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme
+                            CALL tra_dmp_init      ! internal tracer damping
+                            CALL tra_adv_init      ! horizontal & vertical advection
+                            CALL tra_ldf_init      ! lateral mixing
+                            CALL tra_zdf_init      ! vertical mixing and after tracer fields
+
+      !                                         ! Dynamics
+      IF( lk_c1d        )   CALL dyn_dmp_init      ! internal momentum damping
+                            CALL dyn_adv_init      ! advection (vector or flux form)
+                            CALL dyn_vor_init      ! vorticity term including Coriolis
+                            CALL dyn_ldf_init      ! lateral mixing
+                            CALL dyn_hpg_init      ! horizontal gradient of Hydrostatic pressure
+                            CALL dyn_zdf_init      ! vertical diffusion
+                            CALL dyn_spg_init      ! surface pressure gradient
+
+#if defined key_top
+      !                                      ! Passive tracers
+                            CALL     trc_init
+#endif
+      IF( l_ldfslp      )   CALL ldf_slp_init   ! slope of lateral mixing
+
+      !                                      ! Icebergs
+                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+
+      !                                      ! Misc. options
+                            CALL sto_par_init   ! Stochastic parametrization
+      IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations
+     
+      !                                      ! Diagnostics
+      IF( lk_floats     )   CALL     flo_init   ! drifting Floats
+                            CALL dia_cfl_init   ! Initialise CFL diagnostics
+                            CALL dia_ptr_init   ! Poleward TRansports initialization
+      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports
+                            CALL dia_hsb_init   ! heat content, salt content and volume budgets
+                            CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends
+                            CALL dia_obs_init            ! Initialize observational data
+      IF( ln_diaobs     )   CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+
+      !                                         ! Assimilation increments
+      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+                            CALL dia_tmb_init  ! TMB outputs
+                            CALL dia_25h_init  ! 25h mean  outputs
+      !
+   END SUBROUTINE nemo_init
+
+
+   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'
+         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,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namcfg : configuration initialization through namelist read'
+         WRITE(numout,*) '~~~~~~ '
+         WRITE(numout,*) '   Namelist namcfg'
+         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
+         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
+      ENDIF
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
+      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
+      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
+      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
+      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE diawri    , ONLY: dia_wri_alloc
+      USE dom_oce   , ONLY: dom_oce_alloc
+      USE trc_oce   , ONLY: trc_oce_alloc
+#if defined key_diadct 
+      USE diadct    , ONLY: diadct_alloc 
+#endif 
+      USE bdy_oce   , ONLY: bdy_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        oce_alloc       ()          ! ocean 
+      ierr = ierr + dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      !
+      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
+      !
+#if defined key_diadct 
+      ierr = ierr + diadct_alloc    ()          ! 
+#endif 
+      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+      !
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
+      !
+      ! lfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
+      ! Clear the error flag and initialise output vars
+      kerr  = 0
+      kfax  = 1
+      knfax = 0
+      !
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+      !
+      inu   = kn
+      knfax = 0
+      !
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+      !
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+#if defined key_mpp_mpi
+
+   SUBROUTINE nemo_northcomms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto     = 0
+      !
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+  
+          DO jn = 1, jpni
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nfiimpp(jn, jpnj)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ENDIF
+          END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
+      ENDIF
+      l_north_nogather = .TRUE.
+   END SUBROUTINE nemo_northcomms
+
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
+
+   !!======================================================================
+END MODULE nemogcm
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 8732)
@@ -0,0 +1,132 @@
+MODULE oce
+   !!======================================================================
+   !!                      ***  MODULE  oce  ***
+   !! Ocean        :  dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! 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
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
+
+   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
+   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celsius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
+
+   !! free surface                                      !  before  ! now    ! after  !
+   !! ------------                                      !  fields  ! fields ! fields !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
+
+   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T)
+#if defined key_agrif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes 
+#endif
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
+
+   !! interpolated gradient (only used in zps case)
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
+
+   !! (ISF) interpolated gradient (only used for ice shelf case) 
+   !! --------------------- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtui, gtvi   !: horizontal gradient of T, S and rd at top u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   grui, grvi   !: horizontal gradient of T, S and rd at top v-point  
+   !! (ISF) ice load
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
+
+   !! arrays relating to embedding ice in the ocean. These arrays need to be declared 
+   !! even if no ice model is required. In the no ice model or traditional levitating 
+   !! ice cases they contain only zeros
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
+
+   !! Energy budget of the leads (open water embedded in sea ice)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-]
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(7)
+      !!----------------------------------------------------------------------
+      !
+      ierr(:) = 0 
+      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
+         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &          
+         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
+         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
+         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE(rke(jpi,jpj,jpk)  ,                                         &
+         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
+         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
+         &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)      ,                     &
+         &     gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts),                     &
+         &     grui(jpi,jpj)     , grvi(jpi,jpj)     ,                     &
+         &     riceload(jpi,jpj),                             STAT=ierr(2) )
+         !
+      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) )
+         !
+      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )
+         !
+      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
+         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
+         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
+         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) )
+         !
+      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) )
+#if defined key_agrif
+      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(7) )
+#endif
+         !
+      oce_alloc = MAXVAL( ierr )
+      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION oce_alloc
+
+   !!======================================================================
+END MODULE oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/par_kind.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/par_kind.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/par_kind.F90	(revision 8732)
@@ -0,0 +1,40 @@
+MODULE par_kind
+   !!======================================================================
+   !!                   ***  MODULE par_kind  ***
+   !! Ocean :  define the kind of real for the whole model
+   !!======================================================================
+   !! History :  1.0  ! 2002-06  (G. Madec)  Original code
+   !!            3.3  ! 2010-12  (G. Madec)  add a standard length of character strings
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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:
+   !             4 byte REAL       8 byte REAL
+   ! CRAY:           -            precision = 13
+   !                              exponent = 2465
+   ! IEEE:      precision = 6     precision = 15
+   !            exponent = 37     exponent = 307
+
+   !                                                                !!** 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 **
+   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 8732)
@@ -0,0 +1,88 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! 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
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   LOGICAL       ::   ln_read_cfg      !: (=T) read the domain configuration file or (=F) not
+   CHARACTER(lc) ::      cn_domcfg        !: filename the configuration file to be read
+   LOGICAL       ::   ln_write_cfg     !: (=T) create the domain configuration file
+   CHARACTER(lc) ::      cn_domcfg_out    !: filename the configuration file to be read
+   !
+   LOGICAL       ::   ln_use_jattr     !: input file read offset
+   !                                   !  Use file global attribute: open_ocean_jstart to determine start j-row 
+   !                                   !  when reading input from those netcdf files that have the 
+   !                                   !  attribute defined. This is designed to enable input files associated 
+   !                                   !  with the extended grids used in the under ice shelf configurations to 
+   !                                   !  be used without redundant rows when the ice shelves are not in use.
+   ! 
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size 
+   !!---------------------------------------------------------------------
+   ! configuration name & resolution   (required only in ORCA family case)
+   CHARACTER(lc) ::   cn_cfg           !: name of the configuration
+   INTEGER       ::   nn_cfg           !: resolution of the configuration 
+
+   ! global domain size               !!! * total computational domain *
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i-direction
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j-direction
+   INTEGER       ::   jpkglo           !: 3nd    -                  -    --> k levels
+
+#if defined key_agrif
+
+!!gm  BUG ?   I'm surprised by the calculation below of nbcellsx and nbcellsy before jpiglo,jpjglo 
+!!gm                           has been assigned to a value....
+!!gm
+
+   ! global domain size for AGRIF     !!! * total AGRIF computational domain *
+   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
+#endif
+
+   ! local domain size                !!! * local computational domain *
+   INTEGER, PUBLIC ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC ::   jpk   ! = jpkglo
+   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
+
+   !!---------------------------------------------------------------------
+   !! 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 decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   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 )
+   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 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 8732)
@@ -0,0 +1,355 @@
+MODULE step
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping   : manager of the ocean, tracer and ice time stepping
+   !!======================================================================
+   !! History :  OPA  !  1991-03  (G. Madec)  Original code
+   !!             -   !  1991-11  (G. Madec)
+   !!             -   !  1992-06  (M. Imbard)  add a first output record
+   !!             -   !  1996-04  (G. Madec)  introduction of dynspg
+   !!             -   !  1996-04  (M.A. Foujols)  introduction of passive tracer
+   !!            8.0  !  1997-06  (G. Madec)  new architecture of call
+   !!            8.2  !  1997-06  (G. Madec, M. Imbard, G. Roullet)  free surface
+   !!             -   !  1999-02  (G. Madec, N. Grima)  hpg implicit
+   !!             -   !  2000-07  (J-M Molines, M. Imbard)  Open Bondary Conditions
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  free form, suppress macro-tasking
+   !!             -   !  2004-08  (C. Talandier) New trends organization
+   !!             -   !  2005-01  (C. Ethe) Add the KPP closure scheme
+   !!             -   !  2005-11  (G. Madec)  Reorganisation of tra and dyn calls
+   !!             -   !  2006-01  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   !  2006-07  (S. Masson)  restart using iom
+   !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate
+   !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_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
+   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal
+   !!            3.6  !  2012-07  (J. Simeon, G. Madec. C. Ethe)  Online coarsening of outputs
+   !!            3.6  !  2014-04  (F. Roquet, G. Madec) New equations of state
+   !!            3.6  !  2014-10  (E. Clementi, P. Oddo) Add Qiao vertical mixing in case of waves
+   !!            3.7  !  2014-10  (G. Madec)  LDF simplication 
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
+   !!             -   !  2015-11  (J. Chanut) free surface simplification
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp             : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules
+   !
+   USE iom              ! xIOs server
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp   ! called by nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_agrif
+   RECURSIVE SUBROUTINE stp( )
+      INTEGER             ::   kstp   ! ocean time-step index
+#else
+   SUBROUTINE stp( kstp )
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+#endif
+      !!----------------------------------------------------------------------
+      !!                     ***  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, hdiv,w)
+      !!              -8- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji,jj,jk ! dummy loop indice
+      INTEGER ::   indic    ! error indicator if < 0
+      INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt)
+      !! ---------------------------------------------------------------------
+#if defined key_agrif
+      kstp = nit000 + Agrif_Nb_Step()
+      IF( lk_agrif_debug ) THEN
+         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---'
+         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint()
+      ENDIF
+      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE.
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
+# endif
+#endif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! update I/O and calendar 
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             indic = 0                ! reset to no error condition
+                             
+      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS)
+                             CALL iom_init(      cxios_context          )  ! for model grid (including passible AGRIF zoom)
+         IF( ln_crs      )   CALL iom_init( TRIM(cxios_context)//"_crs" )  ! for coarse grid
+      ENDIF
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell IOM we are at time step kstp
+      IF( ln_crs         )   CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell IOM we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_tide    )   CALL sbc_tide( kstp )                   ! update tide potential
+      IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                   ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
+      IF( ln_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+                         CALL sbc     ( kstp )                   ! Sea Boundary Condition (including sea-ice)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update stochastic parameters and random T/S fluctuations
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters
+      IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update                (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !  THERMODYNAMICS
+                         CALL eos_rab( tsb, rab_b )       ! before local thermal/haline expension ratio at T-points
+                         CALL eos_rab( tsn, rab_n )       ! now    local thermal/haline expension ratio at T-points
+                         CALL bn2    ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
+                         CALL bn2    ( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
+
+      !
+      !  VERTICAL PHYSICS
+                         CALL zdf_bfr( kstp )         ! bottom friction (if quadratic)
+      !                                               ! 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( ln_zdfqiao )   CALL zdf_qiao( kstp )             ! Qiao vertical mixing 
+      !
+      IF( lk_zdfcst  ) THEN                                ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * wmask (:,:,:)
+         avmu(:,:,:) = rn_avm0 * wumask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
+      ENDIF
+
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO
+      ENDIF
+      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
+
+      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
+
+      IF( lk_zdfddm  )   CALL zdf_ddm( kstp )         ! double diffusive mixing
+
+                         CALL zdf_mxl( kstp )         ! mixed layer depth
+
+                                                      ! 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( l_ldfslp ) THEN                             ! slope of lateral mixing
+                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density
+
+         IF( ln_zps .AND. .NOT. ln_isfcav)                               &
+            &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient
+            &                                          rhd, gru , grv    )  ! of t, s, rd at the last ocean level
+
+         IF( ln_zps .AND.       ln_isfcav)                               &
+            &            CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
+            &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
+         IF( ln_traldf_triad ) THEN 
+                         CALL ldf_slp_triad( kstp )                       ! before slope for triad operator
+         ELSE     
+                         CALL ldf_slp     ( kstp, rhd, rn2b )             ! before slope for standard operator
+         ENDIF
+      ENDIF
+      !                                                                   ! eddy diffusivity coeff.
+      IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kstp )       !       and/or eiv coeff.
+      IF( l_ldfdyn_time                    )   CALL ldf_dyn( kstp )       ! eddy viscosity coeff. 
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : hdiv, ssh, e3, u, v, w
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+                            CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor)
+      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
+                            CALL wzv           ( kstp )  ! now cross-level velocity 
+                            CALL eos    ( tsn, rhd, rhop, gdept_n(:,:,:) )  ! now in situ density for hpg computation
+                            
+!!jc: fs simplification
+!!jc: lines below are useless if ln_linssh=F. Keep them here (which maintains a bug if ln_linssh=T and ln_zps=T, cf ticket #1636) 
+!!                                         but ensures reproductible results
+!!                                         with previous versions using split-explicit free surface          
+            IF( ln_zps .AND. .NOT. ln_isfcav )                               &
+               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,   &  ! Partial steps: before horizontal gradient
+               &                                          rhd, gru , grv     )  ! of t, s, rd at the last ocean level
+            IF( ln_zps .AND.       ln_isfcav )                                          &
+               &            CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF)
+               &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level
+!!jc: fs simplification
+                            
+                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero
+                         va(:,:,:) = 0._wp
+
+      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   &
+               &         CALL dyn_asm_inc   ( kstp )  ! apply dynamics assimilation increment
+      IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp )  ! bdy damping trends
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())  & 
+               &         CALL Agrif_Sponge_dyn        ! momentum sponge
+#endif
+                         CALL dyn_adv       ( kstp )  ! advection (vector or flux form)
+                         CALL dyn_vor       ( kstp )  ! vorticity term including Coriolis
+                         CALL dyn_ldf       ( kstp )  ! lateral mixing
+                         CALL dyn_hpg       ( kstp )  ! horizontal gradient of Hydrostatic pressure
+                         CALL dyn_spg       ( kstp )  ! surface pressure gradient
+
+                                                      ! With split-explicit free surface, since now transports have been updated and ssha as well
+      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated
+                            CALL div_hor    ( kstp )              ! Horizontal divergence  (2nd call in time-split case)
+         IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component)
+                            CALL wzv        ( kstp )              ! now cross-level velocity 
+      ENDIF
+
+                         CALL dyn_bfr       ( kstp )  ! bottom friction
+                         CALL dyn_zdf       ( kstp )  ! vertical diffusion
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! cool skin
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+      IF ( ln_diurnal )  CALL stp_diurnal( kstp )
+      
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs             (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
+      IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics
+      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
+      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
+                         CALL dia_ar5( kstp )         ! ar5 diag
+      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
+                         CALL dia_wri( kstp )         ! ocean model: outputs
+      !
+      IF( ln_crs     )   CALL crs_fld       ( kstp )  ! ocean model: online field coarsening & output
+      
+#if defined key_top
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL trc_stp       ( kstp )  ! time-stepping
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         tsa(:,:,:,:) = 0._wp         ! set tracer trends to zero
+
+      IF(  lk_asminc .AND. ln_asmiau .AND. &
+         & ln_trainc )   CALL tra_asm_inc   ( kstp )  ! apply tracer assimilation increment
+                         CALL tra_sbc       ( kstp )  ! surface boundary condition
+      IF( ln_traqsr  )   CALL tra_qsr       ( kstp )  ! penetrative solar radiation qsr
+      IF( ln_trabbc  )   CALL tra_bbc       ( kstp )  ! bottom heat flux
+      IF( lk_trabbl  )   CALL tra_bbl       ( kstp )  ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_tradmp  )   CALL tra_dmp       ( kstp )  ! internal damping trends
+      IF( ln_bdy     )   CALL bdy_tra_dmp   ( kstp )  ! bdy damping trends
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())  & 
+               &         CALL Agrif_Sponge_tra        ! tracers sponge
+#endif
+                         CALL tra_adv       ( kstp )  ! horizontal & vertical advection
+                         CALL tra_ldf       ( kstp )  ! lateral mixing
+
+!!gm : why CALL to dia_ptr has been moved here??? (use trends info?)
+      IF( ln_diaptr  )   CALL dia_ptr                 ! Poleward adv/ldf TRansports diagnostics
+!!gm
+                         CALL tra_zdf       ( kstp )  ! vertical mixing and after tracer fields
+      IF( ln_zdfnpc  )   CALL tra_npc       ( kstp )  ! update after fields by non-penetrative convection
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Set boundary conditions and Swap
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 
+!!    (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields. 
+!!    If so: 
+!!    (i) no need to call agrif update at initialization time
+!!    (ii) no need to update "before" fields 
+!!
+!!    Apart from creating new tra_swp/dyn_swp routines, this however: 
+!!    (i) makes boundary conditions at initialization time computed from updated fields which is not the case between 
+!!    two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation", 
+!!    e.g. a shift of the feedback interface inside child domain. 
+!!    (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same
+!!    place.
+!! 
+!!jc2: dynnxt must be the latest call. e3t_b are indeed updated in that routine
+                         CALL tra_nxt       ( kstp )  ! finalize (bcs) tracer fields at next time step and swap
+                         CALL dyn_nxt       ( kstp )  ! finalize (bcs) velocities at next time step and swap
+                         CALL ssh_swp       ( kstp )  ! swap of sea surface height
+      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors
+      !
+      IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
+
+!!gm : This does not only concern the dynamics ==>>> add a new title
+!!gm2: why ouput restart before AGRIF update?
+!!
+!!jc: That would be better, but see comment above
+!!
+      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+      IF( ln_sto_eos       )   CALL sto_rst_write( kstp )   ! write restart file for stochastic parameters
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                         CALL Agrif_Integrate_ChildGrids( stp )  
+
+      IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update 
+!!jc in fact update is useless at last time step, but do it for global diagnostics
+                         CALL Agrif_Update_Tra()      ! Update active tracers
+                         CALL Agrif_Update_Dyn()      ! Update momentum
+      ENDIF
+#endif
+      IF( ln_diaobs  )   CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL stp_ctl       ( kstp, indic )
+      IF( indic < 0  ) THEN
+                         CALL ctl_stop( 'step: indic < 0' )
+                         CALL dia_wri_state( 'output.abort', kstp )
+      ENDIF
+      IF( kstp == nit000 ) THEN
+                 CALL iom_close( numror )     ! close input  ocean restart file
+         IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce
+         IF(lwm.AND.numoni /= -1 )   &
+            &    CALL FLUSH    ( numoni )     ! flush output namelist ice (if exist)
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Coupled mode
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!!gm why lk_oasis and not lk_cpl ????
+      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+      !
+#if defined key_iomput
+      IF( kstp == nitend .OR. indic < 0 ) THEN 
+                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF
+         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 
+      ENDIF
+#endif
+      !
+      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
+      !
+   END SUBROUTINE stp
+   
+END MODULE step
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 8732)
@@ -0,0 +1,124 @@
+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
+   !!             3.7  !  2014-01  (G. Madec) LDF simplication 
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables
+   USE zdf_oce          ! ocean vertical physics variables
+
+   USE daymod           ! calendar                         (day     routine)
+
+   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE sbcrnf           ! surface boundary condition: runoff variables
+   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
+   USE sbcapr           ! surface boundary condition: atmospheric pressure
+   USE sbctide          ! Tide initialisation
+   USE sbcwave          ! Wave intialisation
+
+   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 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 divhor           ! horizontal divergence            (div_hor 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           ! surface pressure gradient        (dyn_spg routine)
+
+   USE dynnxt           ! time-stepping                    (dyn_nxt routine)
+
+   USE stopar           ! Stochastic parametrization       (sto_par routine)
+   USE stopts 
+
+   USE bdy_oce    , ONLY: ln_bdy
+   USE bdydta           ! open boundary condition data     (bdy_dta routine)
+   USE bdytra           ! bdy cond. for tracers            (bdy_tra routine)
+   USE bdydyn3d         ! bdy cond. for baroclinic vel.  (bdy_dyn3d routine)
+
+   USE sshwzv           ! vertical velocity and ssh        (ssh_nxt routine)
+   !                                                       (ssh_swp routine)
+   !                                                       (wzv     routine)
+   USE domvvl           ! variable vertical scale factors  (dom_vvl_sf_nxt routine)
+   !                                                       (dom_vvl_sf_swp routine)
+
+   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
+   USE ldfdyn           ! lateral eddy viscosity coef.     (ldf_dyn routine)
+   USE ldftra           ! lateral eddy diffusive coef.     (ldf_tra routine)
+
+   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
+   USE zdfbfr           ! bottom friction                  (zdf_bfr routine)
+   USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
+   USE zdfgls           ! GLS vertical mixing              (zdf_gls 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 zdfqiao          !Qiao module wave induced mixing   (zdf_qiao routine)
+
+   USE step_diu        ! Time stepping for diurnal sst
+   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine) 
+   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)   
+   USE sbc_oce         ! surface fluxes  
+   
+   USE zpshde           ! partial step: hor. derivative     (zps_hde routine)
+
+   USE diawri           ! Standard run outputs             (dia_wri routine)
+   USE diaptr           ! poleward transports              (dia_ptr routine)
+   USE diadct           ! sections transports              (dia_dct routine)
+   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine)
+   USE diahth           ! thermocline depth                (dia_hth routine)
+   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
+   USE diaharm
+   USE diacfl
+   USE flo_oce          ! floats variables
+   USE floats           ! floats computation               (flo_stp routine)
+
+   USE crsfld           ! Standard output on coarse grid   (crs_fld routine)
+
+   USE asminc           ! assimilation increments      (tra_asm_inc routine)
+   !                                                   (dyn_asm_inc routine)
+   USE asmbkg
+   USE stpctl           ! time stepping control            (stp_ctl routine)
+   USE restart          ! ocean restart                    (rst_wri routine)
+   USE prtctl           ! Print control                    (prt_ctl routine)
+
+   USE diaobs           ! Observation operator
+
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
+   USE timing           ! Timing
+
+#if defined key_iomput
+   USE xios
+#endif
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+   USE agrif_opa_update ! Update (2-way nesting)
+#endif
+#if defined key_top
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE step_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 8732)
@@ -0,0 +1,189 @@
+MODULE stpctl
+   !!======================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  gross check of the ocean time stepping
+   !!======================================================================
+   !! History :  OPA  ! 1991-03  (G. Madec) Original code
+   !!            6.0  ! 1992-06  (M. Imbard)
+   !!            8.0  ! 1997-06  (A.M. Treguier)
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE c1d             ! 1D vertical configuration
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+   USE lib_fortran     ! Fortran routines library 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_ctl           ! 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 stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!              - Print it each 50 time steps
+      !!              - Stop the run IF problem ( indic < 0 )
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic   ! error indicator
+      !!
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ii, ij, ik             ! local integers
+      REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars
+      INTEGER, DIMENSION(3) ::   ilocu     ! 
+      INTEGER, DIMENSION(2) ::   ilocs     ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+      !
+      !                                              !* Test maximum of velocity (zonal only)
+      !                                              !  ------------------------
+      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
+      zumax = 0.e0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
+          END DO 
+        END DO 
+      END DO        
+      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      !
+      IF( zumax > 20.e0 ) THEN
+         IF( lk_mpp ) THEN
+            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
+         ELSE
+            ilocu = MAXLOC( ABS( un(:,:,:) ) )
+            ii = ilocu(1) + nimpp - 1
+            ij = ilocu(2) + njmpp - 1
+            ik = ilocu(3)
+         ENDIF
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' ====== '
+            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
+      !
+      !                                              !* Test minimum of salinity
+      !                                              !  ------------------------
+      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
+      zsmin = 100._wp
+      DO jj = 2, jpjm1
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
+      !
+      IF( zsmin < 0.) THEN 
+         IF (lk_mpp) THEN
+            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
+         ELSE
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9500) kt, zsmin, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
+      !
+      !
+      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
+
+      ! log file (ssh statistics)
+      ! --------                                   !* ssh statistics (and others...)
+      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
+         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      zsshmax = 0.e0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax
+      !
+      IF( zsshmax > 10.e0 ) THEN 
+         IF (lk_mpp) THEN
+            CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij)
+         ELSE
+            ilocs = MAXLOC( ABS(sshn(:,:)) )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9600) kt, zsshmax, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9600  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5)
+      !
+      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) )
+      !
+      IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics
+      !
+9700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16)
+      !
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/timing.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/timing.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/timing.F90	(revision 8732)
@@ -0,0 +1,797 @@
+MODULE timing
+   !!========================================================================
+   !!                     ***  MODULE  timing  ***
+   !!========================================================================
+   !! History : 4.0  ! 2001-05  (R. Benshila)   
+   !!------------------------------------------------------------------------
+
+   !!------------------------------------------------------------------------
+   !!   timming_init    : initialize timing process 
+   !!   timing_start    : start Timer
+   !!   timing_stop     : stop  Timer
+   !!   timing_reset    : end timing variable creation
+   !!   timing_finalize : compute stats and write output in calling w*_info 
+   !!   timing_ini_var  : create timing variables 
+   !!   timing_listing  : print instumented subroutines in ocean.output
+   !!   wcurrent_info   : compute and print detailed stats on the current CPU
+   !!   wave_info       : compute and print averaged statson all processors
+   !!   wmpi_info       : compute and write global stats  
+   !!   supress         : suppress an element of the timing linked list  
+   !!   insert          : insert an element of the timing linked list  
+   !!------------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager 
+   USE dom_oce         ! ocean domain
+   USE lib_mpp          
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
+   PUBLIC   timing_reset                   ! called in step module 
+   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
+   
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+
+   ! Variables for fine grain timing
+   TYPE timer
+      CHARACTER(LEN=20)  :: cname
+   	  REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
+      INTEGER :: ncount, ncount_max, ncount_rate  
+      INTEGER :: niter
+      LOGICAL :: l_tdone
+      TYPE(timer), POINTER :: next => NULL()
+      TYPE(timer), POINTER :: prev => NULL()
+      TYPE(timer), POINTER :: parent_section => NULL()
+   END TYPE timer
+    
+   TYPE alltimer
+      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
+   	  REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL()
+   	  REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
+   	  INTEGER, DIMENSION(:), POINTER :: niter => NULL()
+      TYPE(alltimer), POINTER :: next => NULL()
+      TYPE(alltimer), POINTER :: prev => NULL()
+   END TYPE alltimer 
+ 
+   TYPE(timer), POINTER :: s_timer_root => NULL()
+   TYPE(timer), POINTER :: s_timer      => NULL()
+   TYPE(timer), POINTER :: s_wrk        => NULL()
+   REAL(wp) :: t_overclock, t_overcpu
+   LOGICAL :: l_initdone = .FALSE.
+   INTEGER :: nsize
+   
+   ! Variables for coarse grain timing
+   REAL(wp) :: tot_etime, tot_ctime
+   REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
+   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
+   INTEGER, DIMENSION(8)           :: nvalues
+   CHARACTER(LEN=8), DIMENSION(2)  :: cdate
+   CHARACTER(LEN=10), DIMENSION(2) :: ctime
+   CHARACTER(LEN=5)                :: czone
+    
+   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl
+   LOGICAL :: ln_onefile = .TRUE. 
+   LOGICAL :: lwriter
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE timing_start(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_start  ***
+      !! ** Purpose :   collect execution time
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      !
+       
+      ! Create timing structure at first call
+      IF( .NOT. l_initdone ) THEN
+         CALL timing_ini_var(cdinfo)
+      ELSE
+         s_timer => s_timer_root
+         DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+            IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO
+      ENDIF         
+      s_timer%l_tdone = .FALSE.
+      s_timer%niter = s_timer%niter + 1
+      s_timer%t_cpu = 0.
+      s_timer%t_clock = 0.
+                  
+      ! CPU time collection
+      CALL CPU_TIME( s_timer%t_cpu  )
+      ! clock time collection
+#if defined key_mpp_mpi
+      s_timer%t_clock= MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=s_timer%ncount_rate, COUNT_MAX=s_timer%ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = s_timer%ncount)
+#endif
+      !
+   END SUBROUTINE timing_start
+
+
+   SUBROUTINE timing_stop(cdinfo, csection)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_stop  ***
+      !! ** Purpose :   finalize timing and output
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
+      !
+      INTEGER  :: ifinal_count, iperiods    
+      REAL(wp) :: zcpu_end, zmpitime
+      !
+      s_wrk => NULL()
+
+      ! clock time collection
+#if defined key_mpp_mpi
+      zmpitime = MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+#endif
+      ! CPU time collection
+      CALL CPU_TIME( zcpu_end )
+
+      s_timer => s_timer_root
+      DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+      END DO
+ 
+      ! CPU time correction
+      s_timer%t_cpu  = zcpu_end - s_timer%t_cpu - t_overcpu - s_timer%tsub_cpu
+  
+      ! clock time correction
+#if defined key_mpp_mpi
+      s_timer%t_clock = zmpitime - s_timer%t_clock - t_overclock - s_timer%tsub_clock
+#else
+      iperiods = ifinal_count - s_timer%ncount
+      IF( ifinal_count < s_timer%ncount )  &
+          iperiods = iperiods + s_timer%ncount_max 
+      s_timer%t_clock  = REAL(iperiods) / s_timer%ncount_rate - t_overclock - s_timer%tsub_clock
+#endif
+      
+      ! Correction of parent section
+      IF( .NOT. PRESENT(csection) ) THEN
+         s_wrk => s_timer
+         DO WHILE ( ASSOCIATED(s_wrk%parent_section ) )
+            s_wrk => s_wrk%parent_section
+            s_wrk%tsub_cpu   = s_wrk%tsub_cpu   + s_timer%t_cpu 
+            s_wrk%tsub_clock = s_wrk%tsub_clock + s_timer%t_clock              
+         END DO
+      ENDIF
+            
+      ! time diagnostics 
+      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
+      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu
+!RB to use to get min/max during a time integration
+!      IF( .NOT. l_initdone ) THEN
+!         s_timer%tmin_clock = s_timer%t_clock 
+!         s_timer%tmin_cpu   = s_timer%t_cpu 
+!      ELSE
+!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
+!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
+!      ENDIF   
+!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
+!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )  
+      !
+      s_timer%tsub_clock = 0.
+      s_timer%tsub_cpu = 0.
+      s_timer%l_tdone = .TRUE.
+      !
+   END SUBROUTINE timing_stop
+ 
+ 
+   SUBROUTINE timing_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_init  ***
+      !! ** Purpose :   open timing output file
+      !!----------------------------------------------------------------------
+      INTEGER :: iperiods, istart_count, ifinal_count
+      REAL(wp) :: zdum
+      LOGICAL :: ll_f
+             
+      IF( ln_onefile ) THEN
+         IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
+         lwriter = lwp
+      ELSE
+         CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
+         lwriter = .TRUE.
+      ENDIF
+      
+      IF( lwriter) THEN      
+         WRITE(numtime,*)
+         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
+         WRITE(numtime,*) '                             NEMO team'
+         WRITE(numtime,*) '                  Ocean General Circulation Model'
+         WRITE(numtime,*) '                        version 3.6  (2015) '
+         WRITE(numtime,*)
+         WRITE(numtime,*) '                        Timing Informations '
+         WRITE(numtime,*)
+         WRITE(numtime,*)
+      ENDIF   
+      
+      ! Compute clock function overhead
+#if defined key_mpp_mpi        
+      t_overclock = MPI_WTIME()
+      t_overclock = MPI_WTIME() - t_overclock
+#else        
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = istart_count)
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+      iperiods = ifinal_count - istart_count
+      IF( ifinal_count < istart_count )  &
+          iperiods = iperiods + ncount_max 
+      t_overclock = REAL(iperiods) / ncount_rate
+#endif
+
+      ! Compute cpu_time function overhead
+      CALL CPU_TIME(zdum)
+      CALL CPU_TIME(t_overcpu)
+      
+      ! End overhead omputation  
+      t_overcpu = t_overcpu - zdum        
+      t_overclock = t_overcpu + t_overclock        
+
+      ! Timing on date and time
+      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
+    
+      CALL CPU_TIME(t_cpu(1))      
+#if defined key_mpp_mpi        
+      ! Start elapsed and CPU time counters
+      t_elaps(1) = MPI_WTIME()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = ncount)
+#endif                 
+      !
+   END SUBROUTINE timing_init
+
+
+   SUBROUTINE timing_finalize
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_finalize ***
+      !! ** Purpose :  compute average time 
+      !!               write timing output file
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER :: s_temp
+      INTEGER :: idum, iperiods, icode
+      LOGICAL :: ll_ord, ll_averep
+      CHARACTER(len=120) :: clfmt            
+      
+      ll_averep = .TRUE.
+    
+      ! total CPU and elapse
+      CALL CPU_TIME(t_cpu(2))
+      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu
+#if defined key_mpp_mpi
+      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
+#else
+      CALL SYSTEM_CLOCK(COUNT = nfinal_count)
+      iperiods = nfinal_count - ncount
+      IF( nfinal_count < ncount )  &
+          iperiods = iperiods + ncount_max 
+      t_elaps(2) = REAL(iperiods) / ncount_rate - t_overclock
+#endif      
+
+      ! End of timings on date & time
+      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
+       
+      ! Compute the numer of routines
+      nsize = 0 
+      s_timer => s_timer_root
+      DO WHILE( ASSOCIATED(s_timer) )
+         nsize = nsize + 1
+         s_timer => s_timer%next
+      END DO
+      idum = nsize
+      IF(lk_mpp) CALL mpp_sum(idum)
+      IF( idum/jpnij /= nsize ) THEN
+         IF( lwriter ) WRITE(numtime,*) '        ===> W A R N I N G: '
+         IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
+         IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
+         IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
+         IF( lwriter ) WRITE(numtime,*)
+         ll_averep = .FALSE.
+      ENDIF   
+
+#if defined key_mpp_mpi      
+      ! in MPI gather some info
+      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
+      CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION,   &
+                         all_etime , 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OPA, icode)
+      CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION,   &
+                         all_ctime, 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OPA, icode)
+      tot_etime = SUM(all_etime(:))
+      tot_ctime = SUM(all_ctime(:))
+#else
+      tot_etime = t_elaps(2)
+      tot_ctime = t_cpu  (2)           
+#endif
+
+      ! write output file
+      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
+      IF( lwriter ) WRITE(numtime,*) '--------------------'
+      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')")
+      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime
+      IF( lwriter ) WRITE(numtime,*) 
+#if defined key_mpp_mpi
+      IF( ll_averep ) CALL waver_info
+      CALL wmpi_info
+#endif      
+      IF( lwriter ) CALL wcurrent_info
+      
+      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   &
+      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   &
+      &       czone(1:3),    czone(4:5)                     
+      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   &
+      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   &
+      &       czone(1:3),    czone(4:5)
+
+      IF( lwriter ) CLOSE(numtime) 
+      !
+   END SUBROUTINE timing_finalize
+   
+
+   SUBROUTINE wcurrent_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write timing output file
+      !!----------------------------------------------------------------------
+      LOGICAL :: ll_ord
+      CHARACTER(len=2048) :: clfmt            
+   
+      ! reorder the current list by elapse time      
+      s_wrk => NULL()
+      s_timer => s_timer_root
+      DO
+         ll_ord = .TRUE.
+         s_timer => s_timer_root
+         DO WHILE ( ASSOCIATED( s_timer%next ) )
+         IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
+            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
+               ALLOCATE(s_wrk)
+               s_wrk = s_timer%next
+               CALL insert  (s_timer, s_timer_root, s_wrk)
+               CALL suppress(s_timer%next)            
+               ll_ord = .FALSE.
+               CYCLE            
+            ENDIF           
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO         
+         IF( ll_ord ) EXIT
+      END DO
+            
+      ! write current info
+      WRITE(numtime,*) 'Detailed timing for proc :', narea-1
+      WRITE(numtime,*) '--------------------------'
+      WRITE(numtime,*) 'Section             ',            &
+      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   &
+      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
+      s_timer => s_timer_root  
+      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
+      DO WHILE ( ASSOCIATED(s_timer) )
+         WRITE(numtime,TRIM(clfmt))   s_timer%cname,   &
+         &   s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2),            &
+         &   s_timer%tsum_cpu  ,s_timer%tsum_cpu*100./t_cpu(2)    ,            &
+         &   s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
+         s_timer => s_timer%next
+      END DO
+      WRITE(numtime,*)
+      !                  
+   END SUBROUTINE wcurrent_info
+
+#if defined key_mpp_mpi     
+   SUBROUTINE waver_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write averaged timing informations
+      !!----------------------------------------------------------------------
+      TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
+      TYPE(alltimer), POINTER :: sl_timer_glob      => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave      => NULL()
+      INTEGER :: icode
+      INTEGER :: ierr
+      LOGICAL :: ll_ord           
+      CHARACTER(len=200) :: clfmt              
+                 
+      ! Initialised the global strucutre   
+      ALLOCATE(sl_timer_glob_root, Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+
+      ALLOCATE(sl_timer_glob_root%cname     (jpnij), &
+               sl_timer_glob_root%tsum_cpu  (jpnij), &
+               sl_timer_glob_root%tsum_clock(jpnij), &
+               sl_timer_glob_root%niter     (jpnij), Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+      sl_timer_glob_root%cname(:)       = ''
+      sl_timer_glob_root%tsum_cpu(:)   = 0._wp
+      sl_timer_glob_root%tsum_clock(:) = 0._wp
+      sl_timer_glob_root%niter(:)      = 0
+      sl_timer_glob_root%next => NULL()
+      sl_timer_glob_root%prev => NULL()
+      !ARPDBG - don't need to allocate a pointer that's immediately then
+      !         set to point to some other object.
+      !ALLOCATE(sl_timer_glob)
+      !ALLOCATE(sl_timer_glob%cname     (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_cpu  (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
+      !ALLOCATE(sl_timer_glob%niter     (jpnij))
+      sl_timer_glob => sl_timer_glob_root
+      !
+      IF( narea .EQ. 1 ) THEN
+         ALLOCATE(sl_timer_ave_root)
+         sl_timer_ave_root%cname       = ''
+         sl_timer_ave_root%t_cpu      = 0._wp
+         sl_timer_ave_root%t_clock    = 0._wp
+         sl_timer_ave_root%tsum_cpu   = 0._wp
+         sl_timer_ave_root%tsum_clock = 0._wp
+         sl_timer_ave_root%tmax_cpu   = 0._wp
+         sl_timer_ave_root%tmax_clock = 0._wp
+         sl_timer_ave_root%tmin_cpu   = 0._wp
+         sl_timer_ave_root%tmin_clock = 0._wp
+         sl_timer_ave_root%tsub_cpu   = 0._wp
+         sl_timer_ave_root%tsub_clock = 0._wp
+         sl_timer_ave_root%ncount      = 0
+         sl_timer_ave_root%ncount_rate = 0
+         sl_timer_ave_root%ncount_max  = 0
+         sl_timer_ave_root%niter       = 0
+         sl_timer_ave_root%l_tdone  = .FALSE.
+         sl_timer_ave_root%next => NULL()
+         sl_timer_ave_root%prev => NULL()
+         ALLOCATE(sl_timer_ave)
+         sl_timer_ave => sl_timer_ave_root            
+      ENDIF 
+
+      ! Gather info from all processors
+      s_timer => s_timer_root
+      DO WHILE ( ASSOCIATED(s_timer) )
+         CALL MPI_GATHER(s_timer%cname     , 20, MPI_CHARACTER,   &
+                         sl_timer_glob%cname, 20, MPI_CHARACTER,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%tsum_clock     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%tsum_cpu     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%niter     , 1, MPI_INTEGER,   &
+                         sl_timer_glob%niter, 1, MPI_INTEGER,   &
+                         0, MPI_COMM_OPA, icode)
+
+         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
+            ALLOCATE(sl_timer_glob%next)
+            ALLOCATE(sl_timer_glob%next%cname     (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_cpu  (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
+            ALLOCATE(sl_timer_glob%next%niter     (jpnij))
+            sl_timer_glob%next%prev => sl_timer_glob
+            sl_timer_glob%next%next => NULL()
+            sl_timer_glob           => sl_timer_glob%next
+         ENDIF              
+         s_timer => s_timer%next
+      END DO      
+
+         WRITE(*,*) 'ARPDBG: timing: done gathers'
+      
+      IF( narea == 1 ) THEN    
+         ! Compute some stats
+         sl_timer_glob => sl_timer_glob_root
+         DO WHILE( ASSOCIATED(sl_timer_glob) )
+            sl_timer_ave%cname  = sl_timer_glob%cname(1)
+            sl_timer_ave%tsum_cpu   = SUM   (sl_timer_glob%tsum_cpu  (:)) / jpnij
+            sl_timer_ave%tsum_clock = SUM   (sl_timer_glob%tsum_clock(:)) / jpnij
+            sl_timer_ave%tmax_cpu   = MAXVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%tmin_cpu   = MINVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%niter      = SUM   (sl_timer_glob%niter     (:))
+            !
+            IF( ASSOCIATED(sl_timer_glob%next) ) THEN
+               ALLOCATE(sl_timer_ave%next)          
+               sl_timer_ave%next%prev => sl_timer_ave
+               sl_timer_ave%next%next => NULL()           
+               sl_timer_ave           => sl_timer_ave%next
+            ENDIF
+            sl_timer_glob => sl_timer_glob%next                                
+         END DO
+
+         WRITE(*,*) 'ARPDBG: timing: done computing stats'
+      
+         ! reorder the averaged list by CPU time      
+         s_wrk => NULL()
+         sl_timer_ave => sl_timer_ave_root
+         DO
+            ll_ord = .TRUE.
+            sl_timer_ave => sl_timer_ave_root
+            DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
+
+               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
+
+               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
+                  ALLOCATE(s_wrk)
+                  ! Copy data into the new object pointed to by s_wrk
+                  s_wrk = sl_timer_ave%next
+                  ! Insert this new timer object before our current position
+                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk)
+                  ! Remove the old object from the list
+                  CALL suppress(sl_timer_ave%next)            
+                  ll_ord = .FALSE.
+                  CYCLE            
+               ENDIF           
+               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
+            END DO         
+            IF( ll_ord ) EXIT
+         END DO
+
+         ! write averaged info
+         WRITE(numtime,"('Averaged timing on all processors :')")
+         WRITE(numtime,"('-----------------------------------')")
+         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
+         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   &
+         &   'Max elap(%)',2x,'Min elap(%)',2x,            &           
+         &   'Freq')")
+         sl_timer_ave => sl_timer_ave_root  
+         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
+         DO WHILE ( ASSOCIATED(sl_timer_ave) )
+            WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                            &
+            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   &
+            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   &
+            &   sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock,                          &
+            &   sl_timer_ave%tmax_clock*100.*jpnij/tot_etime,                           &
+            &   sl_timer_ave%tmin_clock*100.*jpnij/tot_etime,                           &                                               
+            &   sl_timer_ave%niter/REAL(jpnij)
+            sl_timer_ave => sl_timer_ave%next
+         END DO
+         WRITE(numtime,*)
+         !
+         DEALLOCATE(sl_timer_ave_root)
+      ENDIF
+      !
+      DEALLOCATE(sl_timer_glob_root)
+      !                  
+   END SUBROUTINE waver_info
+  
+  
+   SUBROUTINE wmpi_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wmpi_time  ***
+      !! ** Purpose :   compute and write a summary of MPI infos 
+      !!----------------------------------------------------------------------   
+      !   
+      INTEGER                            :: idum, icode
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
+      REAL(wp) :: ztot_ratio
+      REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
+      REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
+      CHARACTER(LEN=128), dimension(8) :: cllignes
+      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date
+      CHARACTER(LEN=2048)              :: clfmt    
+   
+      ! Gather all times
+      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
+      IF( narea == 1 ) THEN
+         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
+   
+         ! Compute elapse user time
+         zavg_etime = tot_etime/REAL(jpnij,wp)
+         zmax_etime = MAXVAL(all_etime(:))
+         zmin_etime = MINVAL(all_etime(:))
+
+         ! Compute CPU user time
+         zavg_ctime = tot_ctime/REAL(jpnij,wp)
+         zmax_ctime = MAXVAL(all_ctime(:))
+         zmin_ctime = MINVAL(all_ctime(:))
+   
+         ! Compute cpu/elapsed ratio
+         zall_ratio(:) = all_ctime(:) / all_etime(:)
+         ztot_ratio    = SUM(zall_ratio(:))
+         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
+         zmax_ratio    = MAXVAL(zall_ratio(:))
+         zmin_ratio    = MINVAL(zall_ratio(:))   
+   
+         ! Output Format
+         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,'
+         cllignes(1)='(1x,"MPI summary report :",/,'
+         cllignes(2)='1x,"--------------------",//,'
+         cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
+         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
+         WRITE(cllignes(4)(1:4),'(I4)') jpnij
+         cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(7)='1x,"Maximum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(8)='1x,"Average      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3)'
+         clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))//          &
+           & TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))//  &
+           & TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))//  &
+           & TRIM(clhline)//TRIM(cllignes(8))
+         WRITE(numtime, TRIM(clfmt)) &
+             (iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
+             tot_etime,     tot_ctime,     ztot_ratio,   &
+             zmin_etime,    zmin_ctime,    zmin_ratio,   &
+             zmax_etime,    zmax_ctime,    zmax_ratio,   &
+             zavg_etime,    zavg_ctime,    zavg_ratio
+         WRITE(numtime,*)    
+      END IF
+      !
+      DEALLOCATE(zall_ratio, iall_rank)
+      !
+   END SUBROUTINE wmpi_info
+#endif   
+
+
+   SUBROUTINE timing_ini_var(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_ini_var  ***
+      !! ** Purpose :   create timing structure 
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      LOGICAL :: ll_section
+       
+      !
+      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
+         ALLOCATE(s_timer_root)
+         s_timer_root%cname       = cdinfo
+         s_timer_root%t_cpu      = 0._wp
+         s_timer_root%t_clock    = 0._wp
+         s_timer_root%tsum_cpu   = 0._wp
+         s_timer_root%tsum_clock = 0._wp
+         s_timer_root%tmax_cpu   = 0._wp
+         s_timer_root%tmax_clock = 0._wp
+         s_timer_root%tmin_cpu   = 0._wp
+         s_timer_root%tmin_clock = 0._wp
+         s_timer_root%tsub_cpu   = 0._wp
+         s_timer_root%tsub_clock = 0._wp
+         s_timer_root%ncount      = 0
+         s_timer_root%ncount_rate = 0
+         s_timer_root%ncount_max  = 0
+         s_timer_root%niter       = 0
+         s_timer_root%l_tdone  = .FALSE.
+         s_timer_root%next => NULL()
+         s_timer_root%prev => NULL()
+         s_timer => s_timer_root
+         !
+         ALLOCATE(s_wrk)
+         s_wrk => NULL()
+         
+      ELSE
+         s_timer => s_timer_root
+         ! case of already existing area (typically inside a loop)
+         DO WHILE( ASSOCIATED(s_timer) ) 
+            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) RETURN
+            s_timer => s_timer%next
+         END DO
+         
+         ! end of the chain
+         s_timer => s_timer_root
+         DO WHILE( ASSOCIATED(s_timer%next) )
+            s_timer => s_timer%next
+         END DO
+          
+         ALLOCATE(s_timer%next)      
+         s_timer%next%cname       = cdinfo
+         s_timer%next%t_cpu      = 0._wp
+         s_timer%next%t_clock    = 0._wp
+         s_timer%next%tsum_cpu   = 0._wp
+         s_timer%next%tsum_clock = 0._wp  
+         s_timer%next%tmax_cpu   = 0._wp
+         s_timer%next%tmax_clock = 0._wp
+         s_timer%next%tmin_cpu   = 0._wp
+         s_timer%next%tmin_clock = 0._wp
+         s_timer%next%tsub_cpu   = 0._wp
+         s_timer%next%tsub_clock = 0._wp
+         s_timer%next%ncount      = 0
+         s_timer%next%ncount_rate = 0
+         s_timer%next%ncount_max  = 0
+         s_timer%next%niter       = 0
+         s_timer%next%l_tdone  = .FALSE.
+         s_timer%next%parent_section => NULL()
+         s_timer%next%prev => s_timer
+         s_timer%next%next => NULL()
+         s_timer => s_timer%next
+
+         ! are we inside a section
+         s_wrk => s_timer%prev
+         ll_section = .FALSE.
+         DO WHILE( ASSOCIATED(s_wrk) .AND. .NOT. ll_section )
+            IF( .NOT. s_wrk%l_tdone ) THEN
+               ll_section = .TRUE.
+               s_timer%parent_section => s_wrk 
+            ENDIF
+            s_wrk => s_wrk%prev
+         END DO 
+      ENDIF         
+      !
+   END SUBROUTINE timing_ini_var
+
+
+   SUBROUTINE timing_reset
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_reset  ***
+      !! ** Purpose :   go to root of timing tree 
+      !!----------------------------------------------------------------------
+      l_initdone = .TRUE. 
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
+!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+!      CALL timing_list(s_timer_root)
+!      WRITE(numout,*)
+      !
+   END SUBROUTINE timing_reset
+
+
+   RECURSIVE SUBROUTINE timing_list(ptr)
+   
+      TYPE(timer), POINTER, INTENT(inout) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
+      IF(lwp) WRITE(numout,*)'   ', ptr%cname   
+      !
+   END SUBROUTINE timing_list
+
+
+   SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE insert  ***
+      !! ** Purpose :   insert an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
+      !
+     
+      IF( ASSOCIATED( sd_current, sd_root ) ) THEN
+         ! If our current element is the root element then
+         ! replace it with the one being inserted
+         sd_root => sd_ptr
+      ELSE
+         sd_current%prev%next => sd_ptr
+      END IF
+      sd_ptr%next     => sd_current
+      sd_ptr%prev     => sd_current%prev
+      sd_current%prev => sd_ptr
+      ! Nullify the pointer to the new element now that it is held
+      ! within the list. If we don't do this then a subsequent call
+      ! to ALLOCATE memory to this pointer will fail.
+      sd_ptr => NULL()
+      !    
+   END SUBROUTINE insert
+  
+  
+   SUBROUTINE suppress(sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE suppress  ***
+      !! ** Purpose :   supress an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
+      !
+      TYPE(timer), POINTER :: sl_temp
+    
+      sl_temp => sd_ptr
+      sd_ptr => sd_ptr%next    
+      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
+      DEALLOCATE(sl_temp)
+      sl_temp => NULL()
+      !
+    END SUBROUTINE suppress
+
+   !!=====================================================================
+END MODULE timing
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 8732)
@@ -0,0 +1,258 @@
+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        ! ocean parameters
+   USE dom_oce        ! ocean space and time domain
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   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
+   PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90
+
+   LOGICAL , PUBLIC                                      ::   l_co2cpl  = .false.   !: atmospheric pco2 recieved from oasis
+   LOGICAL , PUBLIC                                      ::   l_offline = .false.   !: offline passive tracers flag
+   INTEGER , PUBLIC                                      ::   nn_dttrc = 1     !: frequency of step on passive tracers
+   REAL(wp), PUBLIC                                      ::   r_si2         !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   oce_co2   !: ocean carbon flux
+
+#if defined key_top 
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                 bio-model          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .TRUE.   !: TOP model
+#else
+   !!----------------------------------------------------------------------
+   !! Default option                          No bio-model light absorption      
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .FALSE.   !: TOP model
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  trc_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), STAT=trc_oce_alloc )
+      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
+      !
+   END FUNCTION trc_oce_alloc
+
+
+   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,:)
+      !
+      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)
+         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
+         IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
+         IF( irgb /= jc ) THEN
+            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
+            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  ::   jc, jb ! dummy loop indice
+      INTEGER  ::   irgb   ! temporary integer
+      REAL(wp) ::   zchl   ! temporary scalar
+      INTEGER  ::   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,*) ' ~~~~~~~~~~~~~~~~'
+         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
+
+
+   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 below the following depth
+      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
+      !
+      ! Level of light extinction
+      pjl = jpkm1
+      DO jk = jpkm1, 1, -1
+         IF(SUM(tmask(:,:,jk)) > 0 ) THEN
+            zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) )
+            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
+         ELSE
+            pjl = jk                                            ! or regional sea-bed depth 
+         ENDIF
+      END DO
+      !
+   END FUNCTION trc_oce_ext_lev
+
+   !!======================================================================
+END MODULE trc_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 8732)
@@ -0,0 +1,18 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 8732)
@@ -0,0 +1,599 @@
+MODULE wrk_nemo
+   !!======================================================================
+   !!                       ***  MODULE  wrk_nemo  ***
+   !! NEMO work space:  define and allocate work-space arrays used in 
+   !! all components of NEMO
+   !!======================================================================
+   !! History :  4.0  !  2011-01  (A Porter)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   wrk_alloc         : get work space arrays
+   !!   wrk_dealloc       : release work space arrays
+   !!
+   !! 1d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, arr1, arr2, ... arr10, kistart = kistart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, arr1, arr2, ... arr10, kistart = kistart)
+   !!   with:
+   !!     - arr*: 1d arrays. real or (not and) integer
+   !!     - nx: size of the 1d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart: optional parameter to lower bound of the 1st dimension (default = 1)
+   !!
+   !! 2d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart )
+   !!   with:
+   !!     - arr* 2d arrays. real or (not and) integer
+   !!     - nx, ny: size of the 2d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart, kjstart: optional parameters to lower bound of the 1st/2nd dimension (default = 1)
+   !!
+   !! 3d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart )
+   !!   with:
+   !!     - arr* 3d arrays. real or (not and) integer
+   !!     - nx, ny, nz: size of the 3d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart, kjstart, kkstart: optional parameters to lower bound of the 1st/2nd/3rd dimension (default = 1)
+   !!
+   !! 4d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, ny, nz, nl, arr1, arr2, ... arr10, &
+   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, ny, nz, nl, arr1, arr2, ... arr10, &
+   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart )
+   !!   with:
+   !!     - arr* 3d arrays. real or (not and) integer
+   !!     - nx, ny, nz, nl: size of the 4d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart, kjstart, kkstart, klstart: optional parameters to lower bound of the 1st/2nd/3rd/4th dimension (default = 1)
+   !!   
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC wrk_alloc, wrk_dealloc, wrk_list
+
+   INTERFACE wrk_alloc
+      MODULE PROCEDURE wrk_alloc_1dr, wrk_alloc_2dr, wrk_alloc_3dr, wrk_alloc_4dr,   &
+         &             wrk_alloc_1di, wrk_alloc_2di, wrk_alloc_3di, wrk_alloc_4di
+   END INTERFACE
+
+   INTERFACE wrk_dealloc
+      MODULE PROCEDURE wrk_dealloc_1dr, wrk_dealloc_2dr, wrk_dealloc_3dr, wrk_dealloc_4dr,   &
+         &             wrk_dealloc_1di, wrk_dealloc_2di, wrk_dealloc_3di, wrk_dealloc_4di
+   END INTERFACE
+
+
+   INTEGER, PARAMETER :: jparray = 1000
+   INTEGER, PARAMETER :: jpmaxdim = 4
+
+   INTEGER, PARAMETER :: jpnotdefined = 0
+   INTEGER, PARAMETER :: jpinteger = 1
+   INTEGER, PARAMETER :: jpreal = 2
+  
+   TYPE leaf
+      LOGICAL :: in_use
+      INTEGER :: indic
+      INTEGER , DIMENSION(:)      , POINTER :: iwrk1d => NULL()    
+      INTEGER , DIMENSION(:,:)    , POINTER :: iwrk2d => NULL()    
+      INTEGER , DIMENSION(:,:,:)  , POINTER :: iwrk3d => NULL()    
+      INTEGER , DIMENSION(:,:,:,:), POINTER :: iwrk4d => NULL()    
+      REAL(wp), DIMENSION(:)      , POINTER :: zwrk1d => NULL()    
+      REAL(wp), DIMENSION(:,:)    , POINTER :: zwrk2d => NULL()    
+      REAL(wp), DIMENSION(:,:,:)  , POINTER :: zwrk3d => NULL()    
+      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zwrk4d => NULL()    
+      TYPE (leaf), POINTER :: next => NULL() 
+      TYPE (leaf), POINTER :: prev => NULL() 
+   END TYPE leaf
+   
+   TYPE branch
+      INTEGER :: itype
+      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart
+      TYPE(leaf), POINTER :: start => NULL()     
+      TYPE(leaf), POINTER :: current => NULL()      
+   END TYPE branch
+
+   TYPE(branch), SAVE, DIMENSION(jparray) :: tree
+
+   LOGICAL ::   linit = .FALSE.
+   LOGICAL ::   ldebug = .FALSE.
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE wrk_list
+      ! to list 3d arrays in use, to be duplicated for all cases 
+      WRITE(*,*) 'Arrays in use :'
+      !      CALL listage(tree_3d(1)%s_wrk_3d_start)
+      WRITE(*,*) ''
+      
+   END SUBROUTINE wrk_list
+   
+   
+   RECURSIVE SUBROUTINE listage(ptr)
+      
+      TYPE(leaf), POINTER, INTENT(in) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL listage(ptr%next)
+      WRITE(*,*) ptr%in_use, ptr%indic   
+      
+   END SUBROUTINE listage
+
+
+   SUBROUTINE wrk_alloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            &
+         &               p1d01 = p1d01, p1d02 = p1d02, p1d03 = p1d03, p1d04 = p1d04, p1d05 = p1d05,   &
+         &               p1d06 = p1d06, p1d07 = p1d07, p1d08 = p1d08, p1d09 = p1d09, p1d10 = p1d10    )
+      !
+   END SUBROUTINE wrk_alloc_1dr
+
+
+   SUBROUTINE wrk_alloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            &
+         &               k1d01 = k1d01, k1d02 = k1d02, k1d03 = k1d03, k1d04 = k1d04, k1d05 = k1d05,   &
+         &               k1d06 = k1d06, k1d07 = k1d07, k1d08 = k1d08, k1d09 = k1d09, k1d10 = k1d10    )
+      !
+   END SUBROUTINE wrk_alloc_1di
+
+
+   SUBROUTINE wrk_alloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart, kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  &
+         &               p2d01 = p2d01, p2d02 = p2d02, p2d03 = p2d03, p2d04 = p2d04, p2d05 = p2d05,   &
+         &               p2d06 = p2d06, p2d07 = p2d07, p2d08 = p2d08, p2d09 = p2d09, p2d10 = p2d10    )
+      !
+   END SUBROUTINE wrk_alloc_2dr
+
+
+   SUBROUTINE wrk_alloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart, kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  &
+         &               k2d01 = k2d01, k2d02 = k2d02, k2d03 = k2d03, k2d04 = k2d04, k2d05 = k2d05,   &
+         &               k2d06 = k2d06, k2d07 = k2d07, k2d08 = k2d08, k2d09 = k2d09, k2d10 = k2d10    )
+      !
+   END SUBROUTINE wrk_alloc_2di
+
+
+   SUBROUTINE wrk_alloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
+      &                      kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        &
+         &               p3d01 = p3d01, p3d02 = p3d02, p3d03 = p3d03, p3d04 = p3d04, p3d05 = p3d05,   &
+         &               p3d06 = p3d06, p3d07 = p3d07, p3d08 = p3d08, p3d09 = p3d09, p3d10 = p3d10    )
+      !
+   END SUBROUTINE wrk_alloc_3dr
+
+
+   SUBROUTINE wrk_alloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
+      &                      kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        &
+         &               k3d01 = k3d01, k3d02 = k3d02, k3d03 = k3d03, k3d04 = k3d04, k3d05 = k3d05,   &
+         &               k3d06 = k3d06, k3d07 = k3d07, k3d08 = k3d08, k3d09 = k3d09, k3d10 = k3d10    )
+      !
+   END SUBROUTINE wrk_alloc_3di
+
+
+   SUBROUTINE wrk_alloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   &
+      &                      kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              &
+         &               p4d01 = p4d01, p4d02 = p4d02, p4d03 = p4d03, p4d04 = p4d04, p4d05 = p4d05,   &
+         &               p4d06 = p4d06, p4d07 = p4d07, p4d08 = p4d08, p4d09 = p4d09, p4d10 = p4d10    )
+      !
+   END SUBROUTINE wrk_alloc_4dr
+
+
+   SUBROUTINE wrk_alloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
+      &                      kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              &
+         &               k4d01 = k4d01, k4d02 = k4d02, k4d03 = k4d03, k4d04 = k4d04, k4d05 = k4d05,   &
+         &               k4d06 = k4d06, k4d07 = k4d07, k4d08 = k4d08, k4d09 = k4d09, k4d10 = k4d10    )
+      !
+   END SUBROUTINE wrk_alloc_4di
+
+
+   SUBROUTINE wrk_dealloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p1d02),PRESENT(p1d03),PRESENT(p1d04),PRESENT(p1d05),   &
+         &                 PRESENT(p1d06),PRESENT(p1d07),PRESENT(p1d08),PRESENT(p1d09),PRESENT(p1d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, 0, 0, 0, kistart, 1, 1, 1)   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_1dr
+
+
+   SUBROUTINE wrk_dealloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k1d02),PRESENT(k1d03),PRESENT(k1d04),PRESENT(k1d05),   &
+         &                 PRESENT(k1d06),PRESENT(k1d07),PRESENT(k1d08),PRESENT(k1d09),PRESENT(k1d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, 0, 0, 0, kistart, 1, 1, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_1di
+
+
+   SUBROUTINE wrk_dealloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart,kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p2d02),PRESENT(p2d03),PRESENT(p2d04),PRESENT(p2d05),   &
+         &                 PRESENT(p2d06),PRESENT(p2d07),PRESENT(p2d08),PRESENT(p2d09),PRESENT(p2d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_2dr
+
+
+   SUBROUTINE wrk_dealloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart,kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k2d02),PRESENT(k2d03),PRESENT(k2d04),PRESENT(k2d05),   &
+         &                 PRESENT(k2d06),PRESENT(k2d07),PRESENT(k2d08),PRESENT(k2d09),PRESENT(k2d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_2di
+
+
+   SUBROUTINE wrk_dealloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
+      &                        kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p3d02),PRESENT(p3d03),PRESENT(p3d04),PRESENT(p3d05),   &
+         &                 PRESENT(p3d06),PRESENT(p3d07),PRESENT(p3d08),PRESENT(p3d09),PRESENT(p3d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_3dr
+
+
+   SUBROUTINE wrk_dealloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
+      &                        kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k3d02),PRESENT(k3d03),PRESENT(k3d04),PRESENT(k3d05),   &
+         &                 PRESENT(k3d06),PRESENT(k3d07),PRESENT(k3d08),PRESENT(k3d09),PRESENT(k3d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_3di
+
+
+   SUBROUTINE wrk_dealloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   &
+      &                        kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p4d02),PRESENT(p4d03),PRESENT(p4d04),PRESENT(p4d05),   &
+         &                 PRESENT(p4d06),PRESENT(p4d07),PRESENT(p4d08),PRESENT(p4d09),PRESENT(p4d10) /) )
+      DO jn = 1, icnt ; CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO
+      !
+   END SUBROUTINE wrk_dealloc_4dr
+
+
+   SUBROUTINE wrk_dealloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
+      &                        kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k4d02),PRESENT(k4d03),PRESENT(k4d04),PRESENT(k4d05),   &
+         &                 PRESENT(k4d06),PRESENT(k4d07),PRESENT(k4d08),PRESENT(k4d09),PRESENT(k4d10) /) )
+      DO jn = 1, icnt ; CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO
+      !
+   END SUBROUTINE wrk_dealloc_4di
+
+
+   SUBROUTINE wrk_alloc_xd( kidim, kjdim, kkdim, kldim,                                             &
+      &                     kisrt, kjsrt, kksrt, klsrt,                                             &
+      &                     k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10,   &
+      &                     k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10,   &
+      &                     k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
+      &                     k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
+      &                     p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10,   &
+      &                     p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10,   &
+      &                     p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
+      &                     p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10    )
+      INTEGER                              ,INTENT(in   )         ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      INTEGER                              ,INTENT(in   ),OPTIONAL::   kisrt, kjsrt, kksrt, klsrt
+      INTEGER , POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   k1d01,k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
+      INTEGER , POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   k2d01,k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
+      INTEGER , POINTER, DIMENSION(:,:,:  ),INTENT(inout),OPTIONAL::   k3d01,k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
+      INTEGER , POINTER, DIMENSION(:,:,:,:),INTENT(inout),OPTIONAL::   k4d01,k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
+      REAL(wp), POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   p1d01,p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
+      REAL(wp), POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   p2d01,p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
+      REAL(wp), POINTER, DIMENSION(:,:,:  ),INTENT(inout),OPTIONAL::   p3d01,p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
+      REAL(wp), POINTER, DIMENSION(:,:,:,:),INTENT(inout),OPTIONAL::   p4d01,p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
+      !
+      LOGICAL ::   llpres
+      INTEGER ::   jn, iisrt, ijsrt, iksrt, ilsrt
+      !
+      IF( .NOT. linit ) THEN
+         tree(:)%itype = jpnotdefined
+         DO jn = 1, jparray   ;   tree(jn)%ishape(:) = 0   ;   tree(jn)%istart(:) = 0   ;   END DO
+         linit = .TRUE.
+      ENDIF
+
+      IF( PRESENT(kisrt) ) THEN   ;   iisrt =  kisrt   ;   ELSE   ;   iisrt = 1   ;   ENDIF 
+      IF( PRESENT(kjsrt) ) THEN   ;   ijsrt =  kjsrt   ;   ELSE   ;   ijsrt = 1   ;   ENDIF 
+      IF( PRESENT(kksrt) ) THEN   ;   iksrt =  kksrt   ;   ELSE   ;   iksrt = 1   ;   ENDIF 
+      IF( PRESENT(klsrt) ) THEN   ;   ilsrt =  klsrt   ;   ELSE   ;   ilsrt = 1   ;   ENDIF 
+
+      llpres =  PRESENT(k1d01) .OR. PRESENT(k2d01) .OR. PRESENT(k3d01) .OR. PRESENT(k4d01)   &
+         & .OR. PRESENT(p1d01) .OR. PRESENT(p2d01) .OR. PRESENT(p3d01) .OR. PRESENT(p4d01)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d01, k2d01, k3d01, k4d01, p1d01, p2d01, p3d01, p4d01    )
+      llpres =  PRESENT(k1d02) .OR. PRESENT(k2d02) .OR. PRESENT(k3d02) .OR. PRESENT(k4d02)   &
+         & .OR. PRESENT(p1d02) .OR. PRESENT(p2d02) .OR. PRESENT(p3d02) .OR. PRESENT(p4d02)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d02, k2d02, k3d02, k4d02, p1d02, p2d02, p3d02, p4d02    )
+      llpres =  PRESENT(k1d03) .OR. PRESENT(k2d03) .OR. PRESENT(k3d03) .OR. PRESENT(k4d03)   &
+         & .OR. PRESENT(p1d03) .OR. PRESENT(p2d03) .OR. PRESENT(p3d03) .OR. PRESENT(p4d03)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d03, k2d03, k3d03, k4d03, p1d03, p2d03, p3d03, p4d03    )
+      llpres =  PRESENT(k1d04) .OR. PRESENT(k2d04) .OR. PRESENT(k3d04) .OR. PRESENT(k4d04)   &
+         & .OR. PRESENT(p1d04) .OR. PRESENT(p2d04) .OR. PRESENT(p3d04) .OR. PRESENT(p4d04)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d04, k2d04, k3d04, k4d04, p1d04, p2d04, p3d04, p4d04    )
+      llpres =  PRESENT(k1d05) .OR. PRESENT(k2d05) .OR. PRESENT(k3d05) .OR. PRESENT(k4d05)   &
+         & .OR. PRESENT(p1d05) .OR. PRESENT(p2d05) .OR. PRESENT(p3d05) .OR. PRESENT(p4d05)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d05, k2d05, k3d05, k4d05, p1d05, p2d05, p3d05, p4d05    )
+      llpres =  PRESENT(k1d06) .OR. PRESENT(k2d06) .OR. PRESENT(k3d06) .OR. PRESENT(k4d06)   &
+         & .OR. PRESENT(p1d06) .OR. PRESENT(p2d06) .OR. PRESENT(p3d06) .OR. PRESENT(p4d06)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d06, k2d06, k3d06, k4d06, p1d06, p2d06, p3d06, p4d06    )
+      llpres =  PRESENT(k1d07) .OR. PRESENT(k2d07) .OR. PRESENT(k3d07) .OR. PRESENT(k4d07)   &
+         & .OR. PRESENT(p1d07) .OR. PRESENT(p2d07) .OR. PRESENT(p3d07) .OR. PRESENT(p4d07)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d07, k2d07, k3d07, k4d07, p1d07, p2d07, p3d07, p4d07    )
+      llpres =  PRESENT(k1d08) .OR. PRESENT(k2d08) .OR. PRESENT(k3d08) .OR. PRESENT(k4d08)   &
+         & .OR. PRESENT(p1d08) .OR. PRESENT(p2d08) .OR. PRESENT(p3d08) .OR. PRESENT(p4d08)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d08, k2d08, k3d08, k4d08, p1d08, p2d08, p3d08, p4d08    )
+      llpres =  PRESENT(k1d09) .OR. PRESENT(k2d09) .OR. PRESENT(k3d09) .OR. PRESENT(k4d09)   &
+         & .OR. PRESENT(p1d09) .OR. PRESENT(p2d09) .OR. PRESENT(p3d09) .OR. PRESENT(p4d09)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d09, k2d09, k3d09, k4d09, p1d09, p2d09, p3d09, p4d09    )
+      llpres =  PRESENT(k1d10) .OR. PRESENT(k2d10) .OR. PRESENT(k3d10) .OR. PRESENT(k4d10)   &
+         & .OR. PRESENT(p1d10) .OR. PRESENT(p2d10) .OR. PRESENT(p3d10) .OR. PRESENT(p4d10)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d10, k2d10, k3d10, k4d10, p1d10, p2d10, p3d10, p4d10    )
+
+   END SUBROUTINE wrk_alloc_xd
+
+
+   SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt ,   &
+      &                      kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d    )
+      INTEGER                              , INTENT(in   )           :: kidim, kjdim, kkdim, kldim
+      INTEGER                              , INTENT(in   )           :: kisrt, kjsrt, kksrt, klsrt
+      INTEGER , POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: kwrk1d  
+      INTEGER , POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: kwrk2d  
+      INTEGER , POINTER, DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL :: kwrk3d  
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: kwrk4d  
+      REAL(wp), POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: pwrk1d  
+      REAL(wp), POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: pwrk2d  
+      REAL(wp), POINTER, DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL :: pwrk3d  
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: pwrk4d  
+      !
+      INTEGER, DIMENSION(jpmaxdim) :: ishape, isrt, iend
+      INTEGER :: itype
+      INTEGER :: ii
+
+      ! define the shape to be given to the work array
+      ishape(:) = (/ kidim, kjdim, kkdim, kldim /)
+      ! define the starting index of the dimension shape to be given to the work array
+      isrt  (:) = (/ kisrt, kjsrt, kksrt, klsrt /)
+      iend  (:) = ishape(:) + isrt(:) - 1
+
+      ! is it integer or real array?
+      IF( PRESENT(kwrk1d) .OR. PRESENT(kwrk2d) .OR. PRESENT(kwrk3d) .OR. PRESENT(kwrk4d) )   itype = jpinteger   
+      IF( PRESENT(pwrk1d) .OR. PRESENT(pwrk2d) .OR. PRESENT(pwrk3d) .OR. PRESENT(pwrk4d) )   itype = jpreal         
+
+      ! find the branch with the matching shape, staring index and type or get the first "free" branch 
+      ii = 1                          
+      DO WHILE(       ( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= isrt ) .OR. tree(ii)%itype /= itype )   &
+         &      .AND. SUM( tree(ii)%ishape ) /= 0 )
+         ii = ii + 1
+         IF (ii > jparray) STOP   ! increase the value of jparray (should not be needed as already very big!)
+      END DO
+      
+      IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch 
+         IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype
+         tree(ii)%itype = itype                                        ! define the type of this branch 
+         tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch 
+         tree(ii)%istart(:) = isrt(:)                                  ! define the lower bounds of this branch 
+         ALLOCATE( tree(ii)%start )                                    ! allocate its start
+         ALLOCATE( tree(ii)%current)                                   ! allocate the current leaf (the first leaf)
+
+         tree(ii)%start%in_use = .FALSE.                               ! Never use the start as work array
+         tree(ii)%start%indic = 0
+         tree(ii)%start%prev => NULL()                                 ! nothing before the start
+         tree(ii)%start%next => tree(ii)%current                       ! first leaf link to the start
+         
+         tree(ii)%current%in_use = .FALSE.                             ! first leaf is not yet used
+         tree(ii)%current%indic = 1                                    ! first leaf
+         tree(ii)%current%prev => tree(ii)%start                       ! previous leaf is the start
+         tree(ii)%current%next => NULL()                               ! next leaf is not yet defined
+         ! allocate the array of the first leaf
+         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+                  
+      ELSE IF( .NOT. ASSOCIATED(tree(ii)%current%next) ) THEN   ! all leafs used -> define a new one
+         ALLOCATE( tree(ii)%current%next )                             ! allocate the new leaf
+         tree(ii)%current%next%in_use = .FALSE.                        ! this leaf is not yet used
+         tree(ii)%current%next%indic = tree(ii)%current%indic + 1      ! number of this leaf
+         IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic
+         tree(ii)%current%next%prev => tree(ii)%current                ! previous leaf of the new leaf is the current leaf
+         tree(ii)%current%next%next => NULL()                          ! next leaf is not yet defined
+
+         tree(ii)%current => tree(ii)%current%next                     ! the current leaf becomes the new one 
+ 
+         ! allocate the array of the new leaf
+         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+         
+      ELSE 
+         tree(ii)%current => tree(ii)%current%next                     ! the current leaf becomes the next one 
+      ENDIF   
+      !       
+      ! use the array of the current leaf as a work array
+      IF( PRESENT(kwrk1d) ) kwrk1d => tree(ii)%current%iwrk1d   
+      IF( PRESENT(kwrk2d) ) kwrk2d => tree(ii)%current%iwrk2d   
+      IF( PRESENT(kwrk3d) ) kwrk3d => tree(ii)%current%iwrk3d   
+      IF( PRESENT(kwrk4d) ) kwrk4d => tree(ii)%current%iwrk4d   
+      IF( PRESENT(pwrk1d) ) pwrk1d => tree(ii)%current%zwrk1d   
+      IF( PRESENT(pwrk2d) ) pwrk2d => tree(ii)%current%zwrk2d   
+      IF( PRESENT(pwrk3d) ) pwrk3d => tree(ii)%current%zwrk3d   
+      IF( PRESENT(pwrk4d) ) pwrk4d => tree(ii)%current%zwrk4d   
+      tree(ii)%current%in_use = .TRUE.   ! this leaf is now used
+      !      
+   END SUBROUTINE wrk_allocbase
+
+
+   SUBROUTINE wrk_deallocbase( ktype, kidim, kjdim, kkdim, kldim, kisrt, kjsrt, kksrt, klsrt )
+      INTEGER, INTENT(in   )           :: ktype
+      INTEGER, INTENT(in   )           :: kidim, kjdim, kkdim, kldim
+      INTEGER, INTENT(in   ), OPTIONAL :: kisrt, kjsrt, kksrt, klsrt
+      !
+      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart
+      INTEGER :: ii
+
+      ishape(:) = (/ kidim, kjdim, kkdim, kldim /)
+      IF( PRESENT(kisrt) ) THEN   ;   istart(1) =  kisrt   ;   ELSE   ;   istart(1) = 1   ;   ENDIF 
+      IF( PRESENT(kjsrt) ) THEN   ;   istart(2) =  kjsrt   ;   ELSE   ;   istart(2) = 1   ;   ENDIF 
+      IF( PRESENT(kksrt) ) THEN   ;   istart(3) =  kksrt   ;   ELSE   ;   istart(3) = 1   ;   ENDIF 
+      IF( PRESENT(klsrt) ) THEN   ;   istart(4) =  klsrt   ;   ELSE   ;   istart(4) = 1   ;   ENDIF 
+
+      ! find the branch with the matcing shape and type or get the first "free" branch 
+      ii = 1                          
+      DO WHILE( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= istart ) .OR. tree(ii)%itype /= ktype )
+         ii = ii + 1
+      END DO
+      !
+      tree(ii)%current%in_use = .FALSE.           ! current leaf is no more used
+      tree(ii)%current => tree(ii)%current%prev   ! move back toward previous leaf   
+      ! 
+   END SUBROUTINE wrk_deallocbase
+
+
+   SUBROUTINE wrk_stop(cmsg)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wrk_stop  ***
+      !! ** Purpose :   to act as local alternative to ctl_stop. 
+      !!                Avoids dependency on in_out_manager module.
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) :: cmsg
+      !!----------------------------------------------------------------------
+      !
+!      WRITE(kumout, cform_err2)
+      WRITE(*,*) TRIM(cmsg)
+      ! ARPDBG - would like to CALL mppstop here to force a stop but that
+      ! introduces a dependency on lib_mpp. Could CALL mpi_abort() directly
+      ! but that's fairly brutal. Better to rely on CALLing routine to
+      ! deal with the error passed back from the wrk_X routine?
+      !CALL mppstop
+      !
+   END SUBROUTINE wrk_stop
+
+   !!=====================================================================
+END MODULE wrk_nemo
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90	(revision 8732)
@@ -0,0 +1,617 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  3.6  ! 2015-12  (A. Ryan) Original code   (from OPA_SRC/) 
+   !!            4.0  ! 2016-11  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE step_oce       ! module used in the ocean time stepping module (step.F90)
+   USE domain         ! domain initialization   (dom_init & dom_cfg routines)
+   USE istate         ! initial state setting          (istate_init routine)
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE step           ! NEMO time-stepping                 (stp     routine)
+   USE cpl_oasis3     ! OASIS3 coupling
+   USE diaobs         ! Observation diagnostics       (dia_obs_init routine)
+#if defined key_nemocice_decomp
+   USE ice_domain_size, only: nx_global, ny_global
+#endif
+   !           ! Stand Alone Observation operator modules
+   USE sao_data
+   USE sao_intp
+   !
+   USE lib_mpp        ! distributed memory computing
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_iomput
+   USE xios           ! xIOserver
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+   PUBLIC   nemo_alloc  ! needed by TAM
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE nemo_gcm
+         !!----------------------------------------------------------------------
+         !!                    ***  SUBROUTINE offline_obs_oper ***
+         !!
+         !! ** Purpose : To use NEMO components to interpolate model fields
+         !!              to observation space.
+         !!
+         !! ** Method : 1. Initialise NEMO
+         !!             2. Initialise offline obs_oper
+         !!             3. Cycle through match ups
+         !!             4. Write results to file
+         !!----------------------------------------------------------------------
+         !
+         CALL nemo_init       ! Initialise NEMO
+         !
+         CALL sao_data_init   ! Initialise Stand Alone Observation operator data
+         !
+         CALL dia_obs_init    ! Initialise obs_operator
+         !
+         CALL sao_interp      ! Interpolate to observation space
+         !
+         CALL dia_obs_wri     ! Pipe to output files
+         !
+         CALL dia_obs_dealloc ! Reset the obs_oper between
+         !
+         IF(lk_mpp)   CALL mppstop  ! Safely stop MPI (end mpp communications)
+         !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji                 ! dummy loop indices
+      INTEGER ::   ios, ilocal_comm   ! local integer
+      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
+      !
+      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_timing, nn_diacfl
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
+      cltxt  = ''
+      cltxt2 = ''
+      clnam  = ''  
+      cxios_context = 'nemo'
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+      !
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+      !                             !--------------------------!
+      !                             !  Set global domain size  !   (control print return in cltxt2)
+      !                             !--------------------------!
+      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
+         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+         !
+      ELSE                                ! user-defined namelist
+         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+      ENDIF
+      !
+      jpk = jpkglo
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
+         jpiglo  = nbcellsx + 2 + 2*nbghostcells
+         jpjglo  = nbcellsy + 2 + 2*nbghostcells
+         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+         nperio  = 0
+         jperio  = 0
+         ln_use_jattr = .false.
+      ENDIF
+#endif
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis
+            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
+         ELSE
+            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+#else
+      IF( lk_oasis ) THEN
+         IF( Agrif_Root() ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis
+         ENDIF
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+      ELSE
+         ilocal_comm = 0
+         ! Nodes selection (control print return in cltxt)
+         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
+      ENDIF
+#endif
+
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN
+         ! write merged namelists from earlier to output namelist now that the
+         ! file has been opened in call to mynode. nammpp has already been
+         ! written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+         IF( .NOT.ln_read_cfg ) THEN
+            DO ji = 1, SIZE(clnam)
+               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
+            END DO
+         ENDIF
+      ENDIF
+
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+#if   defined key_mpp_mpi
+         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
+#else
+         jpni  = 1
+         jpnj  = 1
+         jpnij = jpni*jpnj
+#endif
+      ENDIF
+
+      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
+#if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
+#else
+         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+#endif
+      ENDIF
+
+!!gm ???    why here  it has already been done in line 301 !
+      jpk = jpkglo                                             ! third dim
+!!gm end
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = jpk-1                                            !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Stand Alone Observation operator'
+         WRITE(numout,*) '                NEMO version 3.7  (2015) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt)
+            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt2)
+            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size
+         END DO
+         !
+         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+                            CALL     dom_init   ! Domain
+
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
+
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints'
+         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,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namcfg'
+         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg
+         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
+      ENDIF
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
+      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
+      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
+      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
+      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE diawri    , ONLY: dia_wri_alloc
+      USE dom_oce   , ONLY: dom_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        oce_alloc       ()          ! ocean
+      ierr = ierr + dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+      !
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
+      !
+      ! lfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
+      ! Clear the error flag and initialise output vars
+      kerr  = 0
+      kfax  = 1
+      knfax = 0
+      !
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+      !
+      inu   = kn
+      knfax = 0
+      !
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+      !
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+#if defined key_mpp_mpi
+
+   SUBROUTINE nemo_northcomms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto     = 0
+      !
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+  
+          DO jn = 1, jpni
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nfiimpp(jn, jpnj)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ENDIF
+          END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
+      ENDIF
+      l_north_nogather = .TRUE.
+   END SUBROUTINE nemo_northcomms
+
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
+
+   !!======================================================================
+END MODULE nemogcm
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/obs_fbm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/obs_fbm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/obs_fbm.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../OPA_SRC/OBS/obs_fbm.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao.nml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao.nml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao.nml	(revision 8732)
@@ -0,0 +1,10 @@
+!----------------------------------------------------------------------
+!       namsao Stand Alone Observation operator namelist
+!----------------------------------------------------------------------
+!   sao_files     specifies the files containing the model counterpart
+!   nn_sao_idx    specifies the index within the model file
+!   nn_sao_freq   specifies the number of timesteps between file reads
+&namsao
+   sao_files = 'fcst.0.nc'
+   nn_sao_idx = 1
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_data.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_data.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_data.F90	(revision 8732)
@@ -0,0 +1,80 @@
+MODULE sao_data
+   !!======================================================================
+   !!                       ***  MODULE sao_data  ***
+   !!======================================================================
+   !! History :  3.6  ! 2015-12  (A. Ryan)  Original code
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY: lc
+   USE lib_mpp         ! distributed memory computing
+   USE in_out_manager
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: MaxNumFiles = 1000
+
+   !! Stand Alone Observation operator settings
+   CHARACTER(len=lc) ::   sao_files(MaxNumFiles)   !: model files
+   INTEGER           ::   n_files                  !: number of files
+   INTEGER           :: nn_sao_idx(MaxNumFiles)    !: time_counter indices
+   INTEGER           :: nn_sao_freq                !: read frequency in time steps
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sao_data_init()
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE sao_data_init ***
+      !!
+      !! ** Purpose : To read namelists and initialise offline_oper run.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   jf                   ! file dummy loop index
+      LOGICAL ::   lmask(MaxNumFiles)   ! Logical mask used for counting
+      INTEGER ::   ios
+      !!
+      NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq
+      !!----------------------------------------------------------------------
+
+      ! Standard offline obs_oper initialisation
+      n_files = 0                   ! number of files to cycle through
+      sao_files(:) = ''             ! list of files to read in
+      nn_sao_idx(:) = 0             ! list of indices inside each file
+      nn_sao_freq = -1              ! input frequency in time steps
+
+      ! Standard offline obs_oper settings
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. )
+      !
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. )
+     
+      lmask(:) = .FALSE.               ! count input files
+      WHERE (sao_files(:) /= '') lmask(:) = .TRUE.
+      n_files = COUNT(lmask)
+      !
+      IF(nn_sao_freq == -1) THEN      ! Initialise sub obs window frequency
+         nn_sao_freq = nitend - nit000 + 1      ! Run length
+      ENDIF
+      !
+      IF(lwp) THEN                     ! Print summary of settings
+         WRITE(numout,*)
+         WRITE(numout,*) 'offline obs_oper : Initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters'
+         DO jf = 1, n_files
+            WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', TRIM(sao_files(jf))
+            WRITE(numout,*) '   Input forecast file index        forecastindex = ', nn_sao_idx(jf)
+         END DO
+      END IF
+      !
+   END SUBROUTINE sao_data_init
+
+   !!======================================================================
+END MODULE sao_data
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90	(revision 8732)
@@ -0,0 +1,58 @@
+MODULE sao_intp
+   !!======================================================================
+   !!                    ***  MODULE sao_intp ***
+   !! ** Purpose : Run NEMO observation operator in offline mode
+   !!======================================================================
+   !! History :  3.6  ! 2015-12  (A. Ryan)  Original code
+   !!----------------------------------------------------------------------
+   !        ! NEMO modules
+   USE in_out_manager
+   USE diaobs
+   !        ! Stand Alone Observation operator modules
+   USE sao_read
+   USE sao_data
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sao_interp
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sao_interp
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE sao_interp ***
+      !!
+      !! ** Purpose : To interpolate the model as if it were running online.
+      !!
+      !! ** Method : 1. Populate model counterparts
+      !!             2. Call dia_obs at appropriate time steps
+      !!----------------------------------------------------------------------
+      INTEGER ::   istp    ! time step index
+      INTEGER ::   ifile   ! file index
+      !!----------------------------------------------------------------------
+      istp = nit000 - 1
+      nstop = 0
+      ifile = 1
+      CALL sao_rea_dri(ifile)
+      !
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )
+         IF (ifile <= n_files + 1) THEN
+            IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN
+               CALL sao_rea_dri(ifile)
+               ifile = ifile + 1
+            ENDIF
+            CALL dia_obs(istp)
+         ENDIF
+         istp = istp + 1
+      END DO
+      !
+   END SUBROUTINE sao_interp
+
+   !!======================================================================
+END MODULE sao_intp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_read.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_read.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAO_SRC/sao_read.F90	(revision 8732)
@@ -0,0 +1,173 @@
+MODULE sao_read
+   !!======================================================================
+   !!                      ***  MODULE sao_read  ***
+   !! Read routines : I/O for Stand Alone Observation operator
+   !!======================================================================
+   USE mppini
+   USE lib_mpp
+   USE in_out_manager
+   USE par_kind, ONLY: lc
+   USE netcdf
+   USE oce,     ONLY: tsn, sshn
+   USE dom_oce, ONLY: nlci, nlcj, nimpp, njmpp, tmask
+   USE par_oce, ONLY: jpi, jpj, jpk
+   !
+   USE obs_fbm, ONLY: fbimdi, fbrmdi, fbsp, fbdp
+   USE sao_data
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sao_rea_dri
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sao_rea_dri( kfile )
+      !!------------------------------------------------------------------------
+      !!             *** sao_rea_dri ***
+      !!
+      !! Purpose : To choose appropriate read method
+      !! Method  :
+      !!
+      !! Author  : A. Ryan Oct 2013
+      !!
+      !!------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kfile         ! File number
+      !
+      CHARACTER(len=lc)   ::   cdfilename    ! File name
+      INTEGER ::   kindex        ! File index to read
+      !!------------------------------------------------------------------------
+      !
+      cdfilename = TRIM( sao_files(kfile) )
+      kindex = nn_sao_idx(kfile)
+      CALL sao_read_file( TRIM( cdfilename ), kindex )
+      !
+   END SUBROUTINE sao_rea_dri
+
+
+   SUBROUTINE sao_read_file( filename, ifcst )
+      !!------------------------------------------------------------------------
+      !!                         ***  sao_read_file  ***
+      !!
+      !! Purpose : To fill tn and sn with dailymean field from netcdf files
+      !! Method  : Use subdomain indices to create start and count matrices
+      !!           for netcdf read.
+      !!
+      !! Author  : A. Ryan Oct 2010
+      !!------------------------------------------------------------------------
+      INTEGER,          INTENT(in) ::   ifcst
+      CHARACTER(len=*), INTENT(in) ::   filename
+      INTEGER                      ::   ncid, varid, istat, ntimes
+      INTEGER                      ::   tdim, xdim, ydim, zdim
+      INTEGER                      ::   ii, ij, ik
+      INTEGER, DIMENSION(4)        ::   start_n, count_n
+      INTEGER, DIMENSION(3)        ::   start_s, count_s
+      REAL(fbdp)                   ::   fill_val
+      REAL(fbdp), DIMENSION(:,:,:), ALLOCATABLE ::   temp_tn, temp_sn
+      REAL(fbdp), DIMENSION(:,:)  , ALLOCATABLE ::   temp_sshn
+
+      ! DEBUG
+      INTEGER ::   istage
+      !!------------------------------------------------------------------------
+
+      IF (TRIM(filename) == 'nofile') THEN
+         tsn (:,:,:,:) = fbrmdi
+         sshn(:,:)     = fbrmdi
+      ELSE
+         WRITE(numout,*) "Opening :", TRIM(filename)
+         ! Open Netcdf file to find dimension id
+         istat = nf90_open(path=TRIM(filename), mode=nf90_nowrite, ncid=ncid)
+         IF ( istat /= nf90_noerr ) THEN
+             WRITE(numout,*) "WARNING: Could not open ", trim(filename)
+             WRITE(numout,*) "ERROR: ", nf90_strerror(istat)
+         ENDIF
+         istat = nf90_inq_dimid(ncid,'x',xdim)
+         istat = nf90_inq_dimid(ncid,'y',ydim)
+         istat = nf90_inq_dimid(ncid,'deptht',zdim)
+         istat = nf90_inq_dimid(ncid,'time_counter',tdim)
+         istat = nf90_inquire_dimension(ncid, tdim, len=ntimes)
+         IF (ifcst .LE. ntimes) THEN
+            ! Allocate temporary temperature array
+            ALLOCATE(temp_tn(nlci,nlcj,jpk))
+            ALLOCATE(temp_sn(nlci,nlcj,jpk))
+            ALLOCATE(temp_sshn(nlci,nlcj))
+
+            ! Set temp_tn, temp_sn to 0.
+            temp_tn(:,:,:) = fbrmdi
+            temp_sn(:,:,:) = fbrmdi
+            temp_sshn(:,:) = fbrmdi
+
+            ! Create start and count arrays
+            start_n = (/ nimpp, njmpp, 1,   ifcst /)
+            count_n = (/ nlci,  nlcj,  jpk, 1     /)
+            start_s = (/ nimpp, njmpp, ifcst /)
+            count_s = (/ nlci,  nlcj,  1     /)
+
+            ! Read information into temporary arrays
+            ! retrieve varid and read in temperature
+            istat = nf90_inq_varid(ncid,'votemper',varid)
+            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
+            istat = nf90_get_var(ncid, varid, temp_tn, start_n, count_n)
+            WHERE(temp_tn(:,:,:) == fill_val) temp_tn(:,:,:) = fbrmdi
+
+            ! retrieve varid and read in salinity
+            istat = nf90_inq_varid(ncid,'vosaline',varid)
+            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
+            istat = nf90_get_var(ncid, varid, temp_sn, start_n, count_n)
+            WHERE(temp_sn(:,:,:) == fill_val) temp_sn(:,:,:) = fbrmdi
+
+            ! retrieve varid and read in SSH
+            istat = nf90_inq_varid(ncid,'sossheig',varid)
+            IF (istat /= nf90_noerr) THEN
+               ! Altimeter bias
+               istat = nf90_inq_varid(ncid,'altbias',varid)
+            END IF
+
+            istat = nf90_get_att(ncid, varid, '_FillValue', fill_val)
+            istat = nf90_get_var(ncid, varid, temp_sshn, start_s, count_s)
+            WHERE(temp_sshn(:,:) == fill_val) temp_sshn(:,:) = fbrmdi
+
+            ! Initialise tsn, sshn to fbrmdi
+            tsn(:,:,:,:) = fbrmdi
+            sshn(:,:) = fbrmdi
+
+            ! Mask out missing data index
+            tsn(1:nlci,1:nlcj,1:jpk,1) = temp_tn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk)
+            tsn(1:nlci,1:nlcj,1:jpk,2) = temp_sn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk)
+            sshn(1:nlci,1:nlcj)        = temp_sshn(:,:) * tmask(1:nlci,1:nlcj,1)
+
+            ! Remove halo from tmask, tsn, sshn to prevent double obs counting
+            IF (jpi > nlci) THEN
+                tmask(nlci+1:,:,:) = 0
+                tsn(nlci+1:,:,:,1) = 0
+                tsn(nlci+1:,:,:,2) = 0
+                sshn(nlci+1:,:) = 0
+            END IF
+            IF (jpj > nlcj) THEN
+                tmask(:,nlcj+1:,:) = 0
+                tsn(:,nlcj+1:,:,1) = 0
+                tsn(:,nlcj+1:,:,2) = 0
+                sshn(:,nlcj+1:) = 0
+            END IF
+
+            ! Deallocate arrays
+            DEALLOCATE(temp_tn, temp_sn, temp_sshn)
+         ELSE
+            ! Mark all as missing data
+            tsn(:,:,:,:) = fbrmdi
+            sshn(:,:) = fbrmdi
+         ENDIF
+         ! Close netcdf file
+         WRITE(numout,*) "Closing :", TRIM(filename)
+         istat = nf90_close(ncid)
+      END IF
+      !
+   END SUBROUTINE sao_read_file
+   
+   !!------------------------------------------------------------------------
+END MODULE sao_read
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/daymod.F90	(revision 8732)
@@ -0,0 +1,379 @@
+MODULE daymod
+   !!======================================================================
+   !!                       ***  MODULE  daymod  ***
+   !! Ocean        :  calendar 
+   !!=====================================================================
+   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
+   !!                 ! 1997-03  (O. Marti)
+   !!                 ! 1997-05  (G. Madec) 
+   !!                 ! 1997-08  (M. Imbard)
+   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
+   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
+   !!                 ! 2006-08  (G. Madec)  surface module major update
+   !!----------------------------------------------------------------------      
+
+   !!----------------------------------------------------------------------
+   !!   day        : calendar
+   !!  
+   !!           -------------------------------
+   !!           ----------- WARNING -----------
+   !!
+   !!   we suppose that the time step is deviding the number of second of in a day
+   !!             ---> MOD( rday, rdt ) == 0
+   !!
+   !!           ----------- WARNING -----------
+   !!           -------------------------------
+   !!  
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+   USE ioipsl, ONLY :   ymds2ju   ! for calendar
+   USE prtctl          ! Print control
+   USE restart         ! 
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   day        ! called by step.F90
+   PUBLIC   day_init   ! called by istate.F90
+
+   INTEGER ::   nsecd, nsecd05, ndt, ndt05
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE day_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE day_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000 
+      !!                because day will be called at the beginning of step
+      !!
+      !! ** Action  : - nyear        : current year
+      !!              - nmonth       : current month of the year nyear
+      !!              - nday         : current day of the month nmonth
+      !!              - nday_year    : current day of the year nyear
+      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
+      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
+      !!              - nsec_day     : current time step counted in second since 00h of the current day
+      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
+      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inbday, idweek
+      REAL(wp) ::   zjul
+      !!----------------------------------------------------------------------
+      !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
+      ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0
+      IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+      IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
+      IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
+      nsecd   = NINT(rday       )
+      nsecd05 = NINT(0.5 * rday )
+      ndt     = NINT(      rdt  )
+      ndt05   = NINT(0.5 * rdt  )
+
+      ! ==> clem: here we read the ocean restart for the date (only if it exists)
+      !           It is not clean and another solution should be found
+      CALL day_rst( nit000, 'READ' )
+      ! ==>
+
+      ! set the calendar from ndastp (read in restart file and namelist)
+
+      nyear   =   ndastp / 10000
+      nmonth  = ( ndastp - (nyear * 10000) ) / 100
+      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
+
+      CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00
+      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
+      fjulday = fjulday + 1.                             ! move back to the day at nit000 (and not at nit000 - 1)
+
+      nsec1jan000 = 0
+      CALL day_mth
+      
+      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
+         nmonth = nmonth - 1  
+         nday = nmonth_len(nmonth)
+      ENDIF
+      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
+         nmonth = 12
+         nyear = nyear - 1
+         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
+         IF( nleapy == 1 )   CALL day_mth
+      ENDIF
+      
+      ! day since january 1st
+      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
+
+      !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,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
+
+      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
+      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
+      CALL day( nit000 )
+      !
+   END SUBROUTINE day_init
+
+
+   SUBROUTINE day_mth
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE day_init  ***
+      !! 
+      !! ** Purpose :   calendar values related to the months
+      !!
+      !! ** Action  : - nmonth_len    : length in days of the months of the current year
+      !!              - nyear_len     : length in days of the previous/current year
+      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
+      !!              - nmonth_end    : second since the beginning of the year and the end of the months
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jm               ! dummy loop indice
+      !!----------------------------------------------------------------------
+
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
+         nyear_len(:) = 365
+         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
+            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
+               nyear_len(0)  = 366
+            ENDIF
+            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
+               nmonth_len(2) = 29
+               nyear_len(1)  = 366
+            ENDIF
+            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
+               nyear_len(2)  = 366
+            ENDIF
+         ENDIF
+      ELSE
+         nmonth_len(:) = nleapy   ! all months with nleapy days per year
+         nyear_len(:) = 12 * nleapy
+      ENDIF
+
+      ! half month in second since the begining of the year:
+      ! time since Jan 1st   0     1     2    ...    11    12    13
+      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
+      !                 <---> <---> <--->  ...  <---> <---> <--->        
+      ! month number      0     1     2    ...    11    12    13
+      !
+      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
+      nmonth_half(0) = - nsecd05 * nmonth_len(0)
+      DO jm = 1, 13
+         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
+      END DO
+
+      nmonth_end(0) = 0
+      DO jm = 1, 13
+         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
+      END DO
+      !           
+   END SUBROUTINE 
+
+
+   SUBROUTINE day( kt )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE day  ***
+      !! 
+      !! ** Purpose :   Compute the date with a day iteration IF necessary.
+      !!
+      !! ** Method  : - ???
+      !!
+      !! ** Action  : - nyear     : current year
+      !!              - nmonth    : current month of the year nyear
+      !!              - nday      : current day of the month nmonth
+      !!              - nday_year : current day of the year nyear
+      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
+      !!              - adatrj    : date in days since the beginning of the run
+      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
+      !!----------------------------------------------------------------------      
+      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
+      !
+      CHARACTER (len=25) ::   charout
+      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('day')
+      !
+      zprec = 0.1 / rday
+      !                                                 ! New time-step
+      nsec_year  = nsec_year  + ndt 
+      nsec_month = nsec_month + ndt                 
+      nsec_week  = nsec_week  + ndt
+      nsec_day   = nsec_day   + ndt                
+      adatrj  = adatrj  + rdt / rday
+      fjulday = fjulday + rdt / rday
+      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
+      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
+      
+      IF( nsec_day > nsecd ) THEN                       ! New day
+         !
+         nday      = nday + 1
+         nday_year = nday_year + 1
+         nsec_day  = ndt05
+         !
+         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
+            nday   = 1
+            nmonth = nmonth + 1
+            nsec_month = ndt05
+            IF( nmonth == 13 ) THEN                     ! New year
+               nyear     = nyear + 1
+               nmonth    = 1
+               nday_year = 1
+               nsec_year = ndt05
+               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
+               IF( nleapy == 1 )   CALL day_mth
+            ENDIF
+         ENDIF
+         !
+         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, '   nsec_week = ', nsec_week
+      ENDIF
+
+      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
+      
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+         CALL prt_ctl_info(charout)
+      ENDIF
+
+      ! since we no longer call rst_opn, need to define nitrst here, used by ice restart routine
+      IF( kt == nit000 )  THEN
+         nitrst = nitend
+         lrst_oce = .FALSE.  ! init restart ocean (done in rst_opn when not SAS)
+      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
+
+      IF( nn_timing == 1 )  CALL timing_stop('day')
+      !
+   END SUBROUTINE day
+
+
+   SUBROUTINE day_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !!  ** Purpose : Read or write calendar in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
+      !!                   end of the current(previous) run (REAL -> keep fractions of day)
+      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
+      !!       nrstdt = 1  we verify that nit000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      REAL(wp) ::   zkt, zndastp
+      !!----------------------------------------------------------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+
+         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
+            ! Get Calendar informations
+            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nrstdt )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date
+            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
+                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
+                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
+            ! define ndastp and adatrj
+            IF ( nrstdt == 2 ) THEN
+               ! read the parameters correspondting to nit000 - 1 (last time step of previous run)
+               CALL iom_get( numror, 'ndastp', zndastp )
+               ndastp = NINT( zndastp )
+               CALL iom_get( numror, 'adatrj', adatrj  )
+            ELSE
+               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+         ELSE
+            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
+         ENDIF
+         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) ' *** Info used values : '
+            WRITE(numout,*) '   date ndastp                                      : ', ndastp
+            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+            WRITE(numout,*)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF( kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         ! calendar control
+         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
+         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+      ENDIF
+      !
+   END SUBROUTINE day_rst
+   !!======================================================================
+END MODULE daymod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/diawri.F90	(revision 8732)
@@ -0,0 +1,438 @@
+MODULE diawri
+   !!======================================================================
+   !!                     ***  MODULE  diawri  ***
+   !! Ocean diagnostics :  write ocean output files
+   !!=====================================================================
+   !! 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
+   USE zdf_oce         ! ocean vertical physics
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcssr          ! restoring term toward SST/SSS climatology
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer
+   USE dianam          ! build name of file (routine)
+   USE zdfddm          ! vertical  physics: double diffusion
+   USE diahth          ! thermocline diagnostics
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE iom
+   USE ioipsl
+#if defined key_lim2
+   USE limwri_2 
+#elif defined key_lim3
+   USE limwri
+#endif
+   USE lib_mpp         ! MPP library
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working array
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_wri                 ! routines called by step.F90
+   PUBLIC   dia_wri_state
+   PUBLIC   dia_wri_alloc           ! Called by nemogcm module
+
+   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 ::   ndex(1)                              ! ???
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dia_wri_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), STAT=dia_wri_alloc )
+      IF( lk_mpp )   CALL mpp_sum( dia_wri_alloc )
+      !
+  END FUNCTION dia_wri_alloc
+
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NetCDF output file
+   !!----------------------------------------------------------------------
+# if defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_iomput'                                        use IOM library
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dia_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!                   
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!      Standalone surface scheme 
+      !!
+      !! ** Method  :  use iom_put
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!----------------------------------------------------------------------
+      ! 
+      ! Output the initial state and forcings
+      IF( ninist == 1 ) THEN
+         CALL dia_wri_state( 'output.init', kt )
+         ninist = 0
+      ENDIF
+      !
+   END SUBROUTINE dia_wri
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                  use IOIPSL  library
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dia_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!                   
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!
+      !! ** Method  :   At the beginning of the first time step (nit000), 
+      !!      define all the NETCDF files and fields
+      !!      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
+      !!
+      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
+      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
+      INTEGER  ::   inum = 11                                ! temporary logical unit
+      INTEGER  ::   ji, jj, jk                               ! dummy loop indices
+      INTEGER  ::   ierr                                     ! error code return from allocation
+      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars
+      !!----------------------------------------------------------------------
+      ! 
+      IF( nn_timing == 1 )   CALL timing_start('dia_wri')
+      !
+      ! Output the initial state and forcings
+      IF( ninist == 1 ) THEN                       
+         CALL dia_wri_state( 'output.init', kt )
+         ninist = 0
+      ENDIF
+      !
+      ! 0. Initialisation
+      ! -----------------
+
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#if defined key_diainstant
+      zsto = nwrite * rdt
+      clop = "inst("//TRIM(clop)//")"
+#else
+      zsto=rdt
+      clop = "ave("//TRIM(clop)//")"
+#endif
+      zout = nwrite * rdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      it = kt
+      itmod = kt - nit000 + 1
+
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! Define the NETCDF files (one per grid)
+
+         ! 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
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
+            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
+         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
+                                 ' limit storage in depth = ', ipk
+
+         ! WRITE root name in date.file for use by postpro
+         IF(lwp) THEN
+            CALL dia_nam( clhstnam, nwrite,' ' )
+            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+            WRITE(inum,*) clhstnam
+            CLOSE(inum)
+         ENDIF
+
+         ! Define the T grid FILE ( nid_T )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_1d, nz_T, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
+
+         ! Define the U grid FILE ( nid_U )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_1d, nz_U, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
+
+         ! Define the V grid FILE ( nid_V )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
+            &          "m", ipk, gdept_1d, nz_V, "down" )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
+
+         ! No W grid FILE
+
+         ! Declare all the output fields as NETCDF variables
+
+         !                                                                                      !!! nid_T : 3D
+         CALL histdef( nid_T, "sst_m", "Sea Surface temperature"            , "C"      ,   &  ! sst
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sss_m", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         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, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! (sfx)
+             &         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
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soicecov", "Ice fraction"                       , "[0,1]"  ,   &  ! fr_i
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+         CALL histend( nid_T, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_U : 3D
+         CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s"   ,         &  ! ssu
+            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau
+            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+
+         CALL histend( nid_U, snc4chunks=snc4set )
+
+         !                                                                                      !!! nid_V : 3D
+         CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s",            &  ! ssv_m
+            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau
+            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+
+         CALL histend( nid_V, snc4chunks=snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
+         IF(ll_print) CALL FLUSH(numout )
+
+      ENDIF
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de 
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et ndex la liste des indices a sortir
+
+      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN 
+         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      ! Write fields on T grid
+      CALL histwrite( nid_T, "sst_m", it, sst_m, ndim_hT, ndex_hT )   ! sea surface temperature
+      CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT )   ! sea surface salinity
+      CALL histwrite( nid_T, "sowaflup", it, (emp - rnf )  , ndim_hT, ndex_hT )   ! upward water flux
+      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux 
+                                                                                  ! (includes virtual salt flux beneath ice 
+                                                                                  ! in linear free surface case)
+
+      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
+      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
+      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction   
+      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed   
+
+         ! Write fields on U grid
+      CALL histwrite( nid_U, "ssu_m"   , it, ssu_m         , ndim_hU, ndex_hU )   ! i-current speed
+      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
+
+         ! Write fields on V grid
+      CALL histwrite( nid_V, "ssv_m"   , it, ssv_m         , ndim_hV, ndex_hV )   ! j-current speed
+      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
+
+      ! 3. Close all files
+      ! ---------------------------------------
+      IF( kt == nitend ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
+      !
+   END SUBROUTINE dia_wri
+#endif
+
+   SUBROUTINE dia_wri_state( cdfile_name, kt )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_wri_state  ***
+      !!        
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!      the instantaneous ocean state and forcing fields.
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! ** Method  :   NetCDF files using ioipsl
+      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
+      !!      File 'output.abort.nc' is created in case of abnormal job end
+      !!----------------------------------------------------------------------
+      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
+      INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index
+      !! 
+      CHARACTER (len=32) :: clname
+      CHARACTER (len=40) :: clop
+      INTEGER  ::   id_i , nz_i, nh_i       
+      INTEGER, DIMENSION(1) ::   idex             ! local workspace
+      REAL(wp) ::   zsto, zout, zmax, zjulian
+      !!----------------------------------------------------------------------
+      ! 
+      IF( nn_timing == 1 )   CALL timing_start('dia_wri_state')
+
+      ! 0. Initialisation
+      ! -----------------
+
+      ! Define name, frequency of output and means
+      clname = cdfile_name
+      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      zsto = rdt
+      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
+      zout = rdt
+      zmax = ( nitend - nit000 + 1 ) * rdt
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
+      IF(lwp) WRITE(numout,*) '                and named :', clname, '.nc'
+
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      ! Compute julian date from starting date of the run
+      CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis 
+      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, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
+      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
+          "m", jpk, gdept_1d, nz_i, "down")
+
+      ! Declare all the output fields as NetCDF variables
+
+      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater 
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! fr_i
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+#if defined key_lim2
+      CALL lim_wri_state_2( kt, id_i, nh_i )
+#elif defined key_lim3
+      CALL lim_wri_state( kt, id_i, nh_i )
+#else
+      CALL histend( id_i, snc4chunks=snc4set )
+#endif
+
+      ! 2. Start writing data
+      ! ---------------------
+      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et idex la liste des indices a sortir
+      idex(1) = 1   ! init to avoid compil warning
+
+      ! Write all fields on T grid
+      CALL histwrite( id_i, "sowaflup", kt, emp              , 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
+      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction
+      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress
+      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress
+
+      ! 3. Close the file
+      ! -----------------
+      CALL histclo( id_i )
+#if ! defined key_iomput
+      IF( ninist /= 1  ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+      ENDIF
+#endif
+       
+      IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state')
+      ! 
+
+   END SUBROUTINE dia_wri_state
+   !!======================================================================
+END MODULE diawri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90	(revision 8732)
@@ -0,0 +1,713 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats
+   !!======================================================================
+   !! History :  3.6  ! 2011-11  (S. Alderson, G. Madec) original code
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
+   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE step_oce       ! module used in the ocean time stepping module
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE domain         ! domain initialization   (dom_init & dom_cfg routines)
+   USE usrdef_nam     ! user defined configuration
+   USE daymod         ! calendar
+   USE step           ! NEMO time-stepping                 (stp     routine)
+   USE cpl_oasis3     !
+   USE sbcssm         !
+   USE icbini         ! handle bergs, initialisation
+   USE icbstp         ! handle bergs, calving, themodynamics and transport
+   USE bdyini         ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3
+   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3
+   !
+   USE lib_mpp        ! distributed memory computing
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE lbcnfd   , ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_iomput
+   USE xios           ! xIOserver
+#endif
+
+   IMPLICIT NONE
+   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 4.0 , NEMO Consortium (2016)
+   !! $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  ==!
+      !                            !-----------------------!
+#if defined key_agrif
+      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
+      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
+# if defined key_top
+      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
+# endif
+# if defined key_lim2
+      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
+# endif
+# if defined key_lim3
+      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3
+# endif
+#endif
+      ! 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_agrif
+      CALL Agrif_Regrid()
+#endif
+
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )
+#if defined key_agrif
+         CALL stp                         ! AGRIF: time stepping
+#else
+         IF ( .NOT. ln_diurnal_only ) THEN
+            CALL stp( istp )                 ! standard time stepping
+         ELSE
+            CALL stp_diurnal( istp )        ! time step only the diurnal SST
+         ENDIF 
+#endif
+         istp = istp + 1
+         IF( lk_mpp )   CALL mpp_max( nstop )
+         END DO
+      !
+      IF( ln_icebergs )   CALL icb_end( nitend )
+
+      !                            !------------------------!
+      !                            !==  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
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         CALL Agrif_ParentGrid_To_ChildGrid()
+         IF( nn_timing == 1 )   CALL timing_finalize
+         CALL Agrif_ChildGrid_To_ParentGrid()
+      ENDIF
+#endif
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
+      CALL nemo_closefile
+      !
+#if defined key_iomput
+      CALL xios_finalize                     ! end mpp communications with xios
+      IF( lk_oasis )   CALL cpl_finalize     ! end coupling and mpp communications with OASIS
+#else
+      IF( lk_oasis ) THEN 
+         CALL cpl_finalize                   ! end coupling and mpp communications with OASIS
+      ELSE
+         IF( lk_mpp )   CALL mppstop         ! end mpp communications
+      ENDIF
+#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
+      INTEGER  ::   ios, inum     !   -      -
+      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam
+      CHARACTER(len=80)                 ::   clname
+      !
+      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_timing, nn_diacfl
+      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
+      cltxt  = ''
+      cltxt2 = ''
+      clnam  = ''  
+      cxios_context = 'nemo'
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      IF( lk_oasis ) THEN 
+         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         cxios_context = 'sas'
+         clname = 'output.namelist_sas.dyn'
+      ELSE
+         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         cxios_context = 'nemo'
+         clname = 'output.namelist.dyn'
+   ENDIF
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+      !
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+      !                             !--------------------------!
+      !                             !  Set global domain size  !   (control print return in cltxt2)
+      !                             !--------------------------!
+      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file
+         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+         !
+      ELSE                                ! user-defined namelist
+         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
+      ENDIF
+      !
+      jpk = jpkglo
+      !
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
+         jpiglo  = nbcellsx + 2 + 2*nbghostcells
+         jpjglo  = nbcellsy + 2 + 2*nbghostcells
+         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+         nperio  = 0
+         jperio  = 0
+         ln_use_jattr = .false.
+      ENDIF
+#endif
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
+            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
+         ELSE
+            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
+#else
+      IF( lk_oasis ) THEN
+         IF( Agrif_Root() ) THEN
+            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
+         ENDIF
+         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+      ELSE
+         ilocal_comm = 0
+         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
+      ENDIF
+#endif
+
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN               ! write merged namelists from earlier to output namelist 
+         !                       ! now that the file has been opened in call to mynode. 
+         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+         IF( .NOT.ln_read_cfg ) THEN
+            DO ji = 1, SIZE(clnam)
+               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print
+            END DO
+         ENDIF
+      ENDIF
+
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+#if   defined key_mpp_mpi
+         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
+#else
+         jpni  = 1
+         jpnj  = 1
+         jpnij = jpni*jpnj
+#endif
+      ENDIF
+
+      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj
+#if defined key_nemocice_decomp
+         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
+#else
+         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+#endif
+      ENDIF
+
+#if defined key_agrif
+      ! simple trick to use same vertical grid as parent but different number of levels: 
+      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
+      ! Suppress once vertical online interpolation is ok
+      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
+#endif
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         IF( lk_oasis ) THEN
+            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ELSE
+            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ENDIF
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.7  (2016) '
+         WRITE(numout,*) '             StandAlone Surface version (SAS) '
+         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,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt2)
+            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size
+         END DO
+         !
+         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
+      CALL nemo_alloc()
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+      !                                     ! General initialization
+                            CALL phy_cst    ! Physical constants
+                            CALL eos_init   ! Equation of state
+                            CALL dom_init   ! Domain
+
+     IF( ln_nnogather )     CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
+
+      IF( ln_ctl      )     CALL prt_ctl_init   ! Print control
+                            CALL day_init   ! model calendar (using both namelist and restart infos)
+
+                            CALL sbc_init   ! Forcings : surface module 
+
+      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from  
+      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 
+      !           This is not clean and should be changed in the future. 
+                            CALL bdy_init
+      ! ==>
+                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance
+      
+      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'
+         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,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namcfg'
+         WRITE(numout,*) '      read domain configuration files               ln_read_cfg      = ', ln_read_cfg
+         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg)
+         WRITE(numout,*) '      write  configuration definition files         ln_write_cfg     = ', ln_write_cfg
+         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out)
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr
+      ENDIF
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp      )   ! time-step file      
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice  )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout      )   ! standard model output file
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE diawri    , ONLY: dia_wri_alloc
+      USE dom_oce   , ONLY: dom_oce_alloc
+      USE bdy_oce   , ONLY: ln_bdy, bdy_oce_alloc
+      USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        dia_wri_alloc   ()
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or lim3 and bdy
+      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+      !
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
+      !
+      ! lfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
+      ! Clear the error flag and initialise output vars
+      kerr  = 0
+      kfax  = 1
+      knfax = 0
+      !
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+      !
+      inu   = kn
+      knfax = 0
+      !
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+      !
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+#if defined key_mpp_mpi
+
+   SUBROUTINE nemo_northcomms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto     = 0
+      !
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+  
+          DO jn = 1, jpni
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nfiimpp(jn, jpnj)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ENDIF
+          END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
+      ENDIF
+      l_north_nogather = .TRUE.
+   END SUBROUTINE nemo_northcomms
+
+#else
+   SUBROUTINE nemo_northcomms      ! Dummy routine
+      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
+   END SUBROUTINE nemo_northcomms
+#endif
+
+   !!======================================================================
+END MODULE nemogcm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90	(revision 8732)
@@ -0,0 +1,321 @@
+MODULE sbcssm
+   !!======================================================================
+   !!                       ***  MODULE  sbcssm  ***
+   !! Off-line : interpolation of the physical fields
+   !!======================================================================
+   !! History : 
+   !!   NEMO         3.4  ! 2012-03 First version by S. Alderson 
+   !!                     !         Heavily derived from Christian's dtadyn routine
+   !!                     !         in OFF_SRC
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_ssm_init : initialization, namelist read, and SAVEs control
+   !!   sbc_ssm      : Interpolation of the fields
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   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 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 iom             ! I/O library
+   USE lib_mpp         ! distributed memory computing library
+   USE prtctl          ! print control
+   USE fldread         ! read input fields 
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_ssm_init   ! called by sbc_init
+   PUBLIC   sbc_ssm        ! called by sbc
+
+   CHARACTER(len=100)   ::   cn_dir        !: Root directory for location of ssm files
+   LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D
+   LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not
+   LOGICAL              ::   l_sasread     !: Ice intilisation: read a file (.TRUE.) or anaytical initilaistion in namelist &namsbc_sas
+   LOGICAL              ::   l_initdone = .false.
+   INTEGER     ::   nfld_3d
+   INTEGER     ::   nfld_2d
+
+   INTEGER     ::   jf_tem         ! index of temperature
+   INTEGER     ::   jf_sal         ! index of salinity
+   INTEGER     ::   jf_usp         ! index of u velocity component
+   INTEGER     ::   jf_vsp         ! index of v velocity component
+   INTEGER     ::   jf_ssh         ! index of sea surface height
+   INTEGER     ::   jf_e3t         ! index of first T level thickness
+   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ssm( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ssm  ***
+      !!
+      !! ** Purpose :  Prepares dynamics and physics fields from a NEMO run
+      !!               for an off-line simulation using surface processes only
+      !!
+      !! ** Method : calculates the position of data 
+      !!             - interpolates data if needed
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
+      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'sbc_ssm')
+     
+      IF ( l_sasread ) THEN
+         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==!
+         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
+         ! 
+         IF( ln_3d_uve ) THEN
+            IF( .NOT. ln_linssh ) THEN
+               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
+            ELSE
+               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
+            ENDIF
+            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
+            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+         ELSE
+            IF( .NOT. ln_linssh ) THEN
+               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
+            ELSE
+               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
+            ENDIF
+            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
+            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
+         ENDIF
+         !
+         sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature
+         sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
+         ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
+         IF( ln_read_frq ) THEN
+            frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration
+         ELSE
+            frq_m(:,:) = 1._wp
+         ENDIF
+      ELSE
+         sst_m(:,:) = 0._wp
+         sss_m(:,:) = 0._wp
+         ssu_m(:,:) = 0._wp
+         ssv_m(:,:) = 0._wp
+         ssh_m(:,:) = 0._wp
+         IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D
+         frq_m(:,:) = 1._wp                              !              - -
+         sshn (:,:) = 0._wp                              !              - -
+      ENDIF
+      
+      IF ( nn_ice == 1 ) THEN
+         tsn(:,:,1,jp_tem) = sst_m(:,:)
+         tsn(:,:,1,jp_sal) = sss_m(:,:)
+         tsb(:,:,1,jp_tem) = sst_m(:,:)
+         tsb(:,:,1,jp_sal) = sss_m(:,:)
+      ENDIF
+      ub (:,:,1) = ssu_m(:,:)
+      vb (:,:,1) = ssv_m(:,:)
+ 
+      IF(ln_ctl) THEN                  ! print control
+         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask, ovlap=1   )
+         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask, ovlap=1   )
+         CALL prt_ctl(tab2d_1=ssu_m, clinfo1=' ssu_m   - : ', mask1=umask, ovlap=1   )
+         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   )
+         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   )
+         IF( .NOT.ln_linssh )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   )
+         IF( ln_read_frq    )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   )
+      ENDIF
+      !
+      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   !
+         CALL iom_put( 'ssu_m', ssu_m )
+         CALL iom_put( 'ssv_m', ssv_m )
+         CALL iom_put( 'sst_m', sst_m )
+         CALL iom_put( 'sss_m', sss_m )
+         CALL iom_put( 'ssh_m', ssh_m )
+         IF( .NOT.ln_linssh )   CALL iom_put( 'e3t_m', e3t_m )
+         IF( ln_read_frq    )   CALL iom_put( 'frq_m', frq_m )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'sbc_ssm')
+      !
+   END SUBROUTINE sbc_ssm
+
+
+   SUBROUTINE sbc_ssm_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_ssm_init  ***
+      !!
+      !! ** Purpose :   Initialisation of the dynamical data     
+      !! ** Method  : - read the data namsbc_ssm namelist
+      !!
+      !! ** Action  : - read parameters
+      !!----------------------------------------------------------------------
+      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
+      INTEGER  :: ifpr                               ! dummy loop indice
+      INTEGER  :: inum, idv, idimv, jpm              ! local integer
+      INTEGER  ::   ios                              ! Local integer output status for namelist read
+      !!
+      CHARACTER(len=100)                     ::  cn_dir       ! Root directory for location of core files
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_3d       ! array of namelist information on the fields to read
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read
+      TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read
+      TYPE(FLD_N) :: sn_usp, sn_vsp
+      TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq
+      !
+      NAMELIST/namsbc_sas/l_sasread, cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq
+      !!----------------------------------------------------------------------
+
+      IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN
+      
+      REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields
+      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_sas in configuration namelist : Input fields
+      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_sas )
+
+      !                                         ! store namelist information in an array
+      !                                         ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_sas : standalone surface scheme '
+         WRITE(numout,*) '~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namsbc_sas'
+         WRITE(numout,*) '      Initialisation using an input file  = ',l_sasread 
+         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve
+         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq
+         WRITE(numout,*)
+      ENDIF
+      !
+      !! switch off stuff that isn't sensible with a standalone module
+      !! note that we need sbc_ssm called first in sbc
+      !
+      IF( ln_apr_dyn ) THEN
+         IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme'
+         ln_apr_dyn = .FALSE.
+      ENDIF
+      IF( ln_rnf ) THEN
+         IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme'
+         ln_rnf = .FALSE.
+      ENDIF
+      IF( ln_ssr ) THEN
+         IF( lwp ) WRITE(numout,*) 'No surface relaxation needed with StandAlone Surface scheme'
+         ln_ssr = .FALSE.
+      ENDIF
+      IF( nn_fwb > 0 ) THEN
+         IF( lwp ) WRITE(numout,*) 'No freshwater budget adjustment needed with StandAlone Surface scheme'
+         nn_fwb = 0
+      ENDIF
+      IF( nn_closea > 0 ) THEN
+         IF( lwp ) WRITE(numout,*) 'No closed seas adjustment needed with StandAlone Surface scheme'
+         nn_closea = 0
+      ENDIF
+      IF (l_sasread) THEN
+      ! 
+      !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
+      !! when we have other 3d arrays that we need to read in
+      !! so if a new field is added i.e. jf_new, just give it the next integer in sequence
+      !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d,
+      !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
+      !! and the rest of the logic should still work
+      !
+      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4   ! default 2D fields index
+      !
+      IF( ln_3d_uve ) THEN
+         jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index
+         nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )        ! number of 3D fields to read
+         nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read
+      ELSE
+         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) )   ! update 2D fields index
+         nfld_3d  = 0                                                              ! no 3D fields to read
+         nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read
+      ENDIF
+
+      IF( nfld_3d > 0 ) THEN
+         ALLOCATE( slf_3d(nfld_3d), STAT=ierr )         ! set slf structure
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN
+         ENDIF
+         slf_3d(jf_usp) = sn_usp
+         slf_3d(jf_vsp) = sn_vsp
+         IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t
+      ENDIF
+
+      IF( nfld_2d > 0 ) THEN
+         ALLOCATE( slf_2d(nfld_2d), STAT=ierr )         ! set slf structure
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' )   ;   RETURN
+         ENDIF
+         slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh
+         IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq
+         IF( .NOT. ln_3d_uve ) THEN
+            slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
+            IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t
+         ENDIF
+      ENDIF
+      !
+      ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
+      IF( nfld_3d > 0 ) THEN
+         ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' )   ;   RETURN
+         ENDIF
+         DO ifpr = 1, nfld_3d
+                                       ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
+            IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 )
+            IF( ierr0 + ierr1 > 0 ) THEN
+               CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' )   ;   RETURN
+            ENDIF
+         END DO
+         !                                         ! fill sf with slf_i and control print
+         CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' )
+      ENDIF
+
+      IF( nfld_2d > 0 ) THEN
+         ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr )         ! set sf structure
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' )   ;   RETURN
+         ENDIF
+         DO ifpr = 1, nfld_2d
+                                       ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
+            IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 )
+            IF( ierr0 + ierr1 > 0 ) THEN
+               CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' )   ;   RETURN
+            ENDIF
+         END DO
+         !
+         CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' )
+      ENDIF
+      !
+      ! finally tidy up
+
+      IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr )
+      IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr )
+
+   ENDIF
+ 
+      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate
+      l_initdone = .TRUE.
+      !
+   END SUBROUTINE sbc_ssm_init
+
+   !!======================================================================
+END MODULE sbcssm
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/step.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/step.F90	(revision 8732)
@@ -0,0 +1,134 @@
+MODULE step
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping    : manager of the ocean, tracer and ice time stepping
+   !!                    version for standalone surface scheme
+   !!======================================================================
+   !! History :  OPA  !  1991-03  (G. Madec)  Original code
+   !!             .   !    .                                                     
+   !!             .   !    .                                                     
+   !!   NEMO     3.5  !  2012-03  (S. Alderson)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp             : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables 
+   USE daymod           ! calendar                         (day     routine)
+   USE sbc_oce          ! surface boundary condition: fields
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE sbcrnf           ! surface boundary condition: runoff variables
+   USE sbccpl           ! surface boundary condition: coupled interface
+   USE eosbn2           ! equation of state                (eos_bn2 routine)
+   USE diawri           ! Standard run outputs             (dia_wri routine)
+   USE bdy_oce   , ONLY: ln_bdy
+   USE bdydta           ! clem: mandatory for LIM3
+   USE stpctl           ! time stepping control            (stp_ctl routine)
+   !
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control                    (prt_ctl routine)
+   USE iom              !
+   USE lbclnk           !
+   USE timing           ! Timing            
+#if defined key_iomput
+   USE xios
+#endif
+
+#if defined key_agrif
+   USE agrif_oce, ONLY: lk_agrif_debug  !clem
+#endif
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp   ! called by nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_agrif
+   RECURSIVE SUBROUTINE stp( )
+      INTEGER             ::   kstp   ! ocean time-step index
+#else
+   SUBROUTINE stp( kstp )
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+#endif
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp  ***
+      !!                      
+      !! ** Purpose : - Time stepping of SBC (surface boundary)
+      !! 
+      !! ** Method  : -1- Update forcings and data  
+      !!              -2- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+#if defined key_agrif
+      kstp = nit000 + Agrif_Nb_Step()
+      IF ( lk_agrif_debug ) THEN
+         IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
+         IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint()
+      ENDIF
+
+      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE.
+
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context )
+# endif   
+#endif   
+                             indic = 0                    ! although indic is not changed in stp_ctl
+                                                          ! need to keep the same interface 
+      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp
+
+      ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from  
+      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
+      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.  
+      !           This is not clean and should be changed in the future. 
+      IF( ln_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries
+      ! ==>
+                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+
+                             CALL dia_wri( kstp )         ! ocean model: outputs
+
+#if defined key_agrif
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! AGRIF
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<      
+                             CALL Agrif_Integrate_ChildGrids( stp )  
+#endif
+                             
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             CALL stp_ctl( kstp, indic )
+      IF( indic < 0  )  THEN
+                             CALL ctl_stop( 'step: indic < 0' )
+                             CALL dia_wri_state( 'output.abort', kstp )
+      ENDIF
+      IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file (clem: not sure...)
+      
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Coupled mode
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice
+
+#if defined key_iomput
+      IF( kstp == nitend .OR. indic < 0 ) THEN 
+                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+      ENDIF
+#endif
+      !
+      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
+      !
+   END SUBROUTINE stp
+
+   !!======================================================================
+END MODULE step
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/stpctl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/stpctl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/stpctl.F90	(revision 8732)
@@ -0,0 +1,66 @@
+MODULE stpctl
+   !!======================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  gross check of the ocean time stepping
+   !!                      version for standalone surface scheme
+   !!======================================================================
+   !! 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
+   !!            3.5  ! 2012-03  (S. Alderson)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_ctl           ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!              - Print it each 50 time steps
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/par_age.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/par_age.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/par_age.F90	(revision 8732)
@@ -0,0 +1,17 @@
+MODULE par_age
+   !!======================================================================
+   !!                        ***  par_age  ***
+   !! TOP :   set the AGE parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   IMPLICIT NONE
+
+   INTEGER, PUBLIC  :: jp_age    !: number of passive tracers in PISCES
+
+   !!======================================================================
+END MODULE par_age
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcice_age.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcice_age.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcice_age.F90	(revision 8732)
@@ -0,0 +1,31 @@
+MODULE trcice_age
+   !!======================================================================
+   !!                         ***  MODULE trcice_age  ***
+   !!======================================================================
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_age       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_ageb.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_age
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_ageb  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_age
+
+   !!======================================================================
+END MODULE trcice_age
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcini_age.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcini_age.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcini_age.F90	(revision 8732)
@@ -0,0 +1,64 @@
+MODULE trcini_age
+   !!======================================================================
+   !!                         ***  MODULE trcini_age  ***
+   !! TOP :   initialisation of the AGE tracer
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (G. Nurser, G. Madec, C. Ethe ) Original code
+   !!----------------------------------------------------------------------
+   !! trc_ini_age   : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc
+   USE trc
+   USE trcnam_age
+   USE trcsms_age
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_age   ! called by trcini.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_age
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_age  ***  
+      !!
+      !! ** Purpose :   initialization for AGE model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER    ::  jn
+      CHARACTER(len = 20)  ::  cltra
+      !!----------------------------------------------------------------------
+      !
+      CALL trc_nam_age
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_age: passive tracer age'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      rryear  = 1._wp / ( nyear_len(1) * rday )    ! recip number of seconds in one year
+
+      !! BUG in s-coordinate this does not work!
+      nlb_age = MINLOC( gdepw_1d, mask = gdepw_1d > rn_age_depth, dim = 1 ) ! shallowest W level Below age_depth
+                                                                            !  = shallowest T level wholly below age_depth
+      nl_age  = nlb_age - 1                                                 ! deepest    W level Above age_depth
+                                                                            !  = T level surrounding age_depth
+
+      nla_age = nl_age - 1                                                   ! deepest    T level wholly above age_depth
+
+      frac_kill_age = ( rn_age_depth - gdepw_1d(nl_age) ) / e3t_1d(nl_age)      ! fraction of level nl_age above age_depth
+      frac_add_age  = 1._wp -  frac_kill_age                                    ! fraction of level nl_age below age_depth
+
+      
+      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_age) = 0.
+      !
+   END SUBROUTINE trc_ini_age
+
+   !!======================================================================
+END MODULE trcini_age
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcnam_age.F90	(revision 8732)
@@ -0,0 +1,72 @@
+MODULE trcnam_age
+   !!======================================================================
+   !!                         ***  MODULE trcnam_age  ***
+   !! TOP :   initialisation of some run parameters for Age tracer
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) 
+   !!----------------------------------------------------------------------
+   !! trc_nam_age      : AGE  tracer initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE trc             ! Ocean variables
+   USE trcsms_age      ! AGE specific variable
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_age   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_age
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_age  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for AGE model
+      !!
+      !! ** input   :   Namelist namage
+      !!----------------------------------------------------------------------
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namage/ rn_age_depth, rn_age_kill_rate 
+      !!----------------------------------------------------------------------
+      ! Variable setting
+      ctrcnm    (jp_age) = 'Age'
+      ctrcln    (jp_age) = 'Sea water age since surface contact'
+      ctrcun    (jp_age) = 'year'
+      ln_trc_ini(jp_age) = .false.
+      ln_trc_sbc(jp_age) = .false.
+      ln_trc_cbc(jp_age) = .false.
+      ln_trc_obc(jp_age) = .false.
+      !
+      REWIND( numnat_ref )              ! Namelist namagedate in reference namelist : AGE parameters
+      READ  ( numnat_ref, namage, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namagedate in configuration namelist : AGE parameters
+      READ  ( numnat_cfg, namage, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namage in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namage )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Sea Age Tracer'
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_nam_age: Read namage, namelist for Age passive tracer'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '  depth over which age tracer reset to zero                              rn_age_depth      = ', rn_age_depth 
+         WRITE(numout,*) '  recip of relax. timescale (s) for age tracer shallower than age_depth  rn_age_kill_rate  = ', rn_age_kill_rate 
+         WRITE(numout,*) ''
+      ENDIF
+
+      !
+   END SUBROUTINE trc_nam_age
+   
+   !!======================================================================
+END MODULE trcnam_age
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90	(revision 8732)
@@ -0,0 +1,77 @@
+MODULE trcsms_age
+   !!======================================================================
+   !!                         ***  MODULE trcsms_age  ***
+   !! TOP :   Main module of the AGE tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+   !! trc_sms_age       : AGE model main routine
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+   USE trd_oce
+   USE trdtrc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_age       ! called by trcsms.F90 module
+
+   INTEGER , PUBLIC :: nl_age             ! T level surrounding age_depth
+   INTEGER , PUBLIC :: nla_age            ! T level wholly above age_depth
+   INTEGER , PUBLIC :: nlb_age            ! T level wholly below age_depth
+
+   REAL(wp), PUBLIC :: rn_age_depth       ! = 10       depth over which age tracer reset to zero
+   REAL(wp), PUBLIC :: rn_age_kill_rate   ! = -1./7200  recip of relaxation timescale (s) for  age tracer shallower than age_depth
+   
+   REAL(wp), PUBLIC :: rryear          !: recip number of seconds in one year
+   REAL(wp), PUBLIC :: frac_kill_age   !: fraction of level nl_age above age_depth where it is relaxed towards zero
+   REAL(wp), PUBLIC :: frac_add_age    !: fraction of level nl_age below age_depth where it is incremented
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_age( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_sms_age  ***
+      !!
+      !! ** Purpose :   main routine of AGE model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER ::   jn, jk   ! dummy loop index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_age')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_sms_age:  AGE model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+
+      DO jk = 1, nla_age
+         tra(:,:,jk,jp_age) = rn_age_kill_rate * trb(:,:,jk,jp_age)
+      ENDDO
+      !
+      tra(:,:,nl_age,jp_age) = frac_kill_age * rn_age_kill_rate * trb(:,:,nl_age,jp_age)  &
+          &                   + frac_add_age  * rryear * tmask(:,:,nl_age)
+      !
+      DO jk = nlb_age, jpk
+         tra(:,:,jk,jp_age) = tmask(:,:,jk) * rryear
+      ENDDO
+      !
+      IF( l_trdtrc ) CALL trd_trc( tra(:,:,:,jp_age), jn, jptra_sms, kt )   ! save trends
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_age')
+      !
+   END SUBROUTINE trc_sms_age
+
+   !!======================================================================
+END MODULE trcsms_age
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcwri_age.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcwri_age.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/AGE/trcwri_age.F90	(revision 8732)
@@ -0,0 +1,56 @@
+MODULE trcwri_age
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    age :   Output of age tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top &&  defined key_iomput
+   !!----------------------------------------------------------------------
+   !! trc_wri_age   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE par_age     
+   USE trc         
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_age 
+
+CONTAINS
+
+   SUBROUTINE trc_wri_age
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+
+      ! write the tracer concentrations in the file
+
+      cltra = TRIM( ctrcnm(jp_age) )                  ! short title for tracer
+      CALL iom_put( cltra, trn(:,:,:,jp_age) )
+
+      !
+   END SUBROUTINE trc_wri_age
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_age
+CONTAINS
+   SUBROUTINE trc_wri_age                     ! Empty routine  
+   END SUBROUTINE trc_wri_age
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcwri_age.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_age
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/par_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/par_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/par_c14.F90	(revision 8732)
@@ -0,0 +1,13 @@
+MODULE par_c14
+   !!======================================================================
+   !!                        ***  par_c14 ***
+   !! TOP :   set the C14 parameters
+   !!======================================================================
+   !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture
+   !! History :        !  2015 (A.Mouchet) equilibrium + transient C14
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   INTEGER, PUBLIC ::  jp_c14    !: number of c14 tracer
+
+END MODULE par_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/sms_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/sms_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/sms_c14.F90	(revision 8732)
@@ -0,0 +1,75 @@
+MODULE sms_c14
+   !!======================================================================
+   !!                      ***  MODULE trcsms_c14  ***
+   !! TOP :  C14 main module
+   !!======================================================================
+   !! History     -   ! 1994-05 ( J. Orr ) original code
+   !!            1.0  ! 2006-02 ( J.M. Molines )  Free form + modularity
+   !!            2.0  ! 2008-12 ( C. Ethe ) reorganisation
+   !!            4.0  ! 2011-02 ( A.R. Porter, STFC Daresbury ) Dynamic memory
+   !!                 ! 2015    (A. Mouchet) general C14 + update formulas
+   !!----------------------------------------------------------------------
+   !!   sms_c14 :  compute and add C14 suface forcing to C14 trends
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+
+
+   IMPLICIT NONE
+   PUBLIC  
+
+
+   LOGICAL  :: ln_chemh                             ! Chemical enhancement (yes/no)
+   INTEGER  :: kc14typ                              ! C14 tracer type
+   REAL(wp) :: tyrc14_beg                           ! year start atmospheric scenario !! See below
+   REAL(wp) :: pco2at, rc14at                       ! atm co2, atm 14C ratio (global, reference)
+   REAL(wp) :: rc14init                             ! ocean 14C ratio for initialization
+   REAL(wp) :: xkwind, xdicsur                      ! wind coeff, ref DIC
+   REAL(wp) :: rlam14                               ! C14 decay  rate
+
+   !
+   CHARACTER (len=20)                           :: cfileco2, cfilec14  ! Name of atmospheric forcing files
+   !
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   c14sbc   ! atmospheric c14 ratio
+   REAL(wp)                                     ::   co2sbc   ! atmospheric co2 pressure
+  
+   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   exch_c14   ! exch. vel. for C14/C
+   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   exch_co2   ! CO2 invasion rate
+   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qtr_c14    ! flux at surface
+   REAL(wp),  ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qint_c14   ! cumulative flux
+
+   INTEGER , PARAMETER                          ::   nc14zon     = 3  ! number of zones for bomb c14
+   !
+   INTEGER                                       ::   nrecco2, nrecc14  ! nb record atm co2 & cc14
+   REAL(wp)                                      ::   tyrc14_now ! current yr for transient experiment relative to tyrc14_beg
+   INTEGER                                       ::   m1_co2, m1_c14  ! index of first co2 and c14 records to consider
+   INTEGER                                       ::   m2_co2, m2_c14  ! index of second co2 and c14 records to consider
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   bomb       ! C14 atm data (bomb - 3 zones)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   atmc14     ! C14 atm data (paleo - 1 zone)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   tyrc14     ! Time (yr) atmospheric C14 data
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fareaz     ! Spatial Interpolation Factors
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   spco2      ! Atmospheric CO2
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   tyrco2     ! Time (yr) atmospheric CO2 data
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $                                                                    $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   INTEGER FUNCTION sms_c14_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sms_c14_alloc  ***
+      !!----------------------------------------------------------------------
+      sms_c14_alloc = 0
+      ALLOCATE( exch_c14(jpi,jpj)        ,  exch_co2(jpi,jpj)        ,   &
+         &      qtr_c14(jpi,jpj)         ,  qint_c14(jpi,jpj)        ,   &
+         &      c14sbc(jpi,jpj)          ,  STAT = sms_c14_alloc )
+         !
+      !
+   END FUNCTION sms_c14_alloc
+
+  !!======================================================================
+END MODULE sms_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcatm_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcatm_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcatm_c14.F90	(revision 8732)
@@ -0,0 +1,304 @@
+MODULE trcatm_c14
+   !!======================================================================
+   !!                     ***  MODULE  trcatm_c14  ***
+   !! TOP :  read and manages atmospheric values for radiocarbon model  
+   !!=====================================================================
+   !! History: Based on trcini_c14b & trcsms_c14b : 
+   !!          Anne Mouchet
+   !!----------------------------------------------------------------------
+   !!   trc_atm_c14_ini  : initialize c14atm & pco2atm
+   !!   trc_atm_c14      : read and time interpolate  c14atm & pco2atm
+   !!----------------------------------------------------------------------
+   USE par_trc       !  passive tracers parameters
+   USE oce_trc       !  shared variables between ocean and passive tracers
+   USE trc           !  passive tracers common variables
+   USE sms_c14    ! c14 simulation type, atm default values...
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_atm_c14         ! called in trcsms_c14.F90
+   PUBLIC   trc_atm_c14_ini     ! called in trcini_c14.F90
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trcatm_c14.F90 .... $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_atm_c14_ini
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_c14_ini  ***
+      !!                    
+      !! ** Purpose :   initialisation of sbc for radiocarbon
+      !! 
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      !
+      CHARACTER (len=20)        :: clfile                        ! forcing file name
+      INTEGER                   :: ji,jj,jn                        ! dummy loop indice
+      INTEGER                   :: ierr1,ierr2,ierr3,izco2         ! temporary integers
+      INTEGER                   :: inum1,inum2,incom,iyear         ! temporary integers
+      REAL(wp) ::   ys40 = -40.     ! 40 degrees south
+      REAL(wp) ::   ys20 = -20.     ! 20 degrees south
+      REAL(wp) ::   yn20 =  20.     ! 20 degrees north
+      REAL(wp) ::   yn40 =  40.     ! 40 degrees north
+      REAL(wp), POINTER, DIMENSION(:)   :: zco2, zyrco2  ! temporary arrays for swap
+      !
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_atm_c14_ini')
+      !
+      
+      IF( lwp ) WRITE(numout,*) ' '
+      IF( lwp ) WRITE(numout,*) ' trc_atm_c14_ini : initialize atm CO2 & C14-ratio '
+      IF( lwp ) WRITE(numout,*) ' '
+      !
+      tyrc14_now = 0._wp   ! initialize
+      !
+      IF(kc14typ >= 1) THEN  ! Transient atmospheric forcing: CO2
+      !
+         clfile = TRIM( cfileco2 )
+         IF(lwp) WRITE(numout,*) 'Read CO2 atmospheric concentrations file ',clfile
+         CALL ctl_opn( inum1, clfile, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         REWIND(inum1)
+      
+         READ(inum1,*) nrecco2,incom
+         DO jn = 1, incom        ! Skip over descriptor lines
+            READ(inum1,'(1x)')
+         END DO
+         ALLOCATE( spco2(nrecco2), tyrco2(nrecco2)       , STAT=ierr1 )
+         IF( ierr1 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate co2 arrays' )
+      ! get  CO2 data
+         DO jn = 1, nrecco2
+            READ(inum1, *)  tyrco2(jn), spco2(jn)
+         END DO
+         CLOSE(inum1)
+      !
+         IF(kc14typ==2) THEN
+            CALL wrk_alloc( nrecco2,zco2)
+            CALL wrk_alloc( nrecco2,zyrco2)
+            zco2(:)=spco2(:)
+            zyrco2(:)=tyrco2(:)
+      ! Set CO2 times on AD time scale & swap records : In CO2 file : youngest first
+            DO jn = 1, nrecco2
+               izco2=nrecco2-jn+1
+               spco2(izco2)=zco2(jn)
+               tyrco2(izco2)=1950._wp-zyrco2(jn)         ! BP to AD dates
+            END DO
+            CALL wrk_dealloc(nrecco2,zco2)
+            CALL wrk_dealloc(nrecco2,zyrco2)
+         ENDIF
+      !
+      !        ! Transient atmospheric forcing: Bomb C14 & Paleo C14 : open file
+      !
+         clfile = TRIM( cfilec14 )
+         IF (lwp) WRITE(numout,*) 'Read C-14 atmospheric concentrations file ',clfile
+         CALL ctl_opn( inum2, clfile, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         REWIND(inum2)
+      !
+      ! Bomb C14: 3 zones for atm C14 !
+         IF(kc14typ == 1) THEN  ! Transient atmospheric forcing: Bomb C14
+      ! 
+            READ(inum2,*) nrecc14,incom
+            DO jn = 1, incom        ! Skip over descriptor lines
+               READ(inum2,'(1x)')
+            END DO
+            ALLOCATE( bomb(nrecc14,nc14zon), tyrc14(nrecc14)       , STAT=ierr2 )
+            IF( ierr2 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate c14 arrays' )
+      ! get bomb c14 data
+            DO jn = 1, nrecc14
+               READ(inum2,*) tyrc14(jn), bomb(jn,1), bomb(jn,2), bomb(jn,3)
+            END DO
+            CLOSE(inum2)
+
+       ! Linear  interpolation of the C-14 source fonction
+       ! in linear latitude bands  (20N,40N) and (20S,40S)
+       !------------------------------------------------------
+            ALLOCATE( fareaz  (jpi,jpj ,nc14zon) , STAT=ierr3 )
+            IF( ierr3 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' )
+      !
+            DO jj = 1 , jpj                       ! from C14b package
+              DO ji = 1 , jpi
+                 IF( gphit(ji,jj) >= yn40 ) THEN
+                    fareaz(ji,jj,1) = 0.
+                    fareaz(ji,jj,2) = 0.
+                    fareaz(ji,jj,3) = 1.
+                 ELSE IF( gphit(ji,jj ) <= ys40) THEN
+                    fareaz(ji,jj,1) = 1.
+                    fareaz(ji,jj,2) = 0.
+                    fareaz(ji,jj,3) = 0.
+                 ELSE IF( gphit(ji,jj) >= yn20 ) THEN
+                    fareaz(ji,jj,1) = 0.
+                    fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / yn40 )
+                    fareaz(ji,jj,3) = 2. * gphit(ji,jj) / yn40 - 1.
+                 ELSE IF( gphit(ji,jj) <= ys20 ) THEN
+                    fareaz(ji,jj,1) = 2. * gphit(ji,jj) / ys40 - 1.
+                    fareaz(ji,jj,2) = 2. * ( 1. - gphit(ji,jj) / ys40 )
+                    fareaz(ji,jj,3) = 0.
+                 ELSE
+                    fareaz(ji,jj,1) = 0.
+                    fareaz(ji,jj,2) = 1.
+                    fareaz(ji,jj,3) = 0.
+                 ENDIF
+              END DO
+           END DO
+      !
+         ENDIF
+      !
+      ! Paleo C14: 1 zone for atm C14 !
+         IF(kc14typ == 2) THEN  ! Transient atmospheric forcing: Paleo C14
+      ! 
+            READ(inum2,*) nrecc14,incom
+            DO jn = 1, incom        ! Skip over descriptor lines
+               READ(inum2,'(1x)')
+            END DO
+            ALLOCATE( atmc14(nrecc14), tyrc14(nrecc14)       , STAT=ierr2 )
+            IF( ierr2 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate c14 arrays' )
+      ! get past c14 data
+            DO jn = 1, nrecc14
+               READ(inum2,*) iyear,incom,incom,atmc14(jn)
+               tyrc14(jn)=1950._wp-REAL(iyear,wp)                ! BP to AD dates
+            END DO
+            CLOSE(inum2)
+      !
+         ENDIF
+      !
+      ! Note on dates: 
+      !   In files dates have dimension yr; either AD or BP; if BP date is changed into AD here
+      !   When dealing with dates previous to 0. AD one needs to set tyrc14_beg to the actual starting year
+      !   Do not forget to appropriately set nn_date0 and nn_rstctl in namelist
+      !                           AND        nn_rsttr in namelist_top  if offline run
+      !   All details are given in NEMO-C14.pdf report
+      !  
+         tyrc14_now=nyear                                ! actual initial yr - Bomb 
+         if(kc14typ == 2) tyrc14_now=nyear+tyrc14_beg-1  ! actual initial yr - Paleo
+      !                                     ! we suppose we start on tyrc14_now/01/01 @ 0h
+         m1_c14= 1
+         m1_co2= 1
+         DO jn = 1,nrecco2
+            IF ( tyrc14_now >= tyrco2(jn) ) m1_co2 = jn  ! index of first co2 record to consider
+         END DO
+         DO jn = 1,nrecc14
+            IF ( tyrc14_now >= tyrc14(jn) ) m1_c14 = jn  ! index of first c14 record to consider
+         END DO
+         IF (lwp) WRITE(numout,*) 'Initial yr for experiment', tyrc14_now
+         IF (lwp) WRITE(numout,*) '   CO2 & C14 start years:', tyrco2(m1_co2),tyrc14(m1_c14)
+      !
+         m2_c14= m1_c14
+         m2_co2= m1_co2
+      !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_atm_c14_ini')
+      !
+   END SUBROUTINE trc_atm_c14_ini
+
+
+   SUBROUTINE trc_atm_c14( kt, co2sbc, c14sbc )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_flx  ***
+      !!                    
+      !! ** Purpose :   provides sbc for co2 & c14 at kt
+      !! 
+      !! ** Method  :  read files
+      !!
+      !! ** Action  :   atmospheric values interpolated at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                 , INTENT(in   )   ::   kt       ! ocean time-step
+      REAL(wp), DIMENSION(:,:), INTENT(  out)   ::   c14sbc   ! atm c14 ratio
+      REAL(wp),                 INTENT(  out)   ::   co2sbc   ! atm co2 p
+      INTEGER                                   ::   jz       ! dummy loop indice
+      REAL(wp)                              ::   zdint,zint   ! work
+      REAL(wp), DIMENSION(nc14zon)              ::   zonbc14  ! work
+      !
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_atm_c14')
+      !
+      IF( kc14typ == 0) THEN
+         co2sbc=pco2at
+         c14sbc(:,:)=rc14at
+      ENDIF
+      !
+      IF(kc14typ >= 1) THEN  ! Transient C14 & CO2
+      !
+         tyrc14_now = tyrc14_now + ( rdt / ( rday * nyear_len(1)) )    !  current time step in yr relative to tyrc14_beg
+      !
+      ! CO2 --------------------------------------------------------
+      !
+      ! time interpolation of CO2 concentrations     ! if out of record keeps first/last value
+         IF( tyrc14_now > tyrco2(m2_co2) ) THEN     ! next interval
+           m1_co2 = m2_co2
+           m2_co2 = MIN ( m2_co2 + 1 , nrecco2 )
+         ENDIF
+      !
+         zdint  = tyrco2(m2_co2) - tyrco2(m1_co2)
+         co2sbc = spco2(m2_co2)                        ! if out of record keeps first/last value
+         zint = 0._wp
+         IF ( zdint > 0._wp ) THEN                     ! if within record interpolate:
+            zint = ( tyrco2(m2_co2) - tyrc14_now ) / zdint
+            co2sbc = spco2(m2_co2) + zint * ( spco2(m1_co2) - spco2(m2_co2) )
+         ENDIF
+      !
+         IF( lwp .AND.  kt == nitend )  THEN
+            WRITE(numout, '(3(A,F12.4))') 't1/tn/t2:',tyrco2(m1_co2),'/', tyrc14_now,'/',tyrco2(m2_co2)
+            WRITE(numout, *) 'CO2:',spco2(m1_co2),co2sbc ,spco2(m2_co2)
+         ENDIF
+      !
+      ! C14 --------------------------------------------------------
+      !
+      ! time interpolation of C14 concentrations 
+         IF ( tyrc14_now > tyrc14(m2_c14) ) THEN     ! next interval
+           m1_c14 = m2_c14
+           m2_c14 = MIN ( m2_c14 + 1 , nrecc14 )
+         ENDIF
+         zdint = tyrc14(m2_c14) - tyrc14(m1_c14)
+         zint=0._wp
+         IF ( zdint > 0._wp ) zint = ( tyrc14(m2_c14) - tyrc14_now ) / zdint ! if  within record
+         IF( lwp .AND.  kt == nitend )  &
+            &     WRITE(numout,'(3(A,F12.4))') 't1/tn/t2:',tyrc14(m1_c14),'/', tyrc14_now,'/',tyrc14(m2_c14)
+      !
+      ! ------- Bomb C14  ------------------------------------------
+      !
+         IF( kc14typ == 1) THEN
+      !                                          ! time interpolation
+          zonbc14(:) = bomb(m2_c14,:)                ! if out of record keeps first/last value
+      !                                          !    if within record interpolate:
+          IF ( zdint > 0._wp ) zonbc14(:) = bomb(m2_c14,:) + zint * ( bomb(m1_c14,:)  - bomb(m2_c14,:)  )
+      ! 
+            IF(lwp .AND.  kt == nitend )  &
+                 &      WRITE(numout, *)  'C14:',bomb(m1_c14,1),zonbc14(1),bomb(m2_c14,1)
+      !   Transform DeltaC14 --> C14 ratio
+            zonbc14(:) = 1._wp + zonbc14(:)/1.d03
+      !
+      !  For each (i,j)-box, with information from the fractional area
+      !  (zonmean), computes area-weighted mean to give the atmospheric C-14
+      !  ----------------------------------------------------------------
+            c14sbc(:,:) = zonbc14(1) * fareaz(:,:,1)   &
+               &          + zonbc14(2) * fareaz(:,:,2)   &
+               &          + zonbc14(3) * fareaz(:,:,3)
+         ENDIF
+      !
+      ! ------- Paleo C14  -----------------------------------------
+      !
+         IF( kc14typ == 2 ) THEN
+      !                                          ! time interpolation
+            zonbc14(1) = atmc14(m2_c14)          ! if out of record keeps first/last value
+         !                                       !    if within record interpolate:
+            IF ( zdint > 0._wp ) zonbc14(1) = atmc14(m2_c14) + zint * ( atmc14(m1_c14) - atmc14(m2_c14) )
+            IF(lwp .AND.  kt == nitend )  &
+                 &      WRITE(numout, *)  'C14: ',atmc14(m1_c14),zonbc14(1),atmc14(m2_c14)
+      !   Transform DeltaC14 --> C14 ratio
+            c14sbc(:,:) = 1._wp + zonbc14(1)/1.d03
+         ENDIF
+      !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_atm_c14')
+      !
+   END SUBROUTINE trc_atm_c14
+
+   !!======================================================================
+END MODULE trcatm_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcice_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcice_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcice_c14.F90	(revision 8732)
@@ -0,0 +1,31 @@
+MODULE trcice_c14
+   !!======================================================================
+   !!                         ***  MODULE trcice_c14  ***
+   !!======================================================================
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_c14       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_c14b.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_c14
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_c14b  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_c14
+
+   !!======================================================================
+END MODULE trcice_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcini_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcini_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcini_c14.F90	(revision 8732)
@@ -0,0 +1,97 @@
+MODULE trcini_c14
+   !!======================================================================
+   !!                         ***  MODULE trcini_c14  ***
+   !! TOP :   initialisation of the C14 tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !! History :   3.0  !  2015 (A. Mouchet) C14 Code
+   !!----------------------------------------------------------------------
+   !! trc_ini_c14   : C14 model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE sms_c14
+   USE trcatm_c14
+   USE trcnam_c14
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_c14   ! called by trcini.F90 module
+   
+   !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id:               $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_c14
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_c14  ***  
+      !!
+      !! ** Purpose :   initialization for C14 model
+      !!
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      !
+      REAL(wp) :: ztrai
+      INTEGER  :: jn
+      CHARACTER(len = 20)  ::  cltra
+      !!----------------------------------------------------------------------
+      !
+      CALL trc_nam_c14
+      !                       ! Allocate c14 arrays
+      IF( sms_c14_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14: unable to allocate C14 arrays' )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_c14: initialisation of C14 model'
+      !
+      IF( .NOT. ln_rsttr )  THEN
+         !
+         IF(lwp) WRITE(numout,*) '                      ==>    PRESCRIBED initial VALUES'
+         IF(lwp) WRITE(numout,*) '                      ==>    Ocean C14/C :', rc14init 
+         !
+         trn(:,:,:,jp_c14) = rc14init * tmask(:,:,:)
+         !
+         qtr_c14(:,:) = 0._wp           ! Init of air-sea BC
+         !
+      ELSE
+
+        IF(lwp) WRITE(numout,*)
+        IF(lwp) WRITE(numout,*) ' trc_rst_read_c14 : Read specific variables for c14 model '
+        IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+        ! 
+        CALL iom_get( numrtr, 'co2sbc', co2sbc ) 
+        CALL iom_get( numrtr, jpdom_autoglo, 'c14sbc', c14sbc ) 
+        CALL iom_get( numrtr, jpdom_autoglo, 'exch_co2', exch_co2 ) 
+        CALL iom_get( numrtr, jpdom_autoglo, 'exch_c14', exch_c14 ) 
+        CALL iom_get( numrtr, jpdom_autoglo, 'qtr_c14', qtr_c14 )
+        !
+      END IF
+      !
+      IF( ( nn_rsttr == 0 ) .OR. ( .NOT. ln_rsttr ) ) THEN
+      !
+      !                         !  qint set to zero <=== Initial of transient
+      !                         !                   <=== Restart=false
+         IF(lwp) WRITE(numout,*) '                    ==>    qint reset to ZERO '
+         qint_c14(:,:) = 0._wp
+      !
+      ELSE
+        !
+        CALL iom_get( numrtr, jpdom_autoglo, 'qint_c14', qint_c14 ) 
+        !
+      ENDIF
+      !
+      CALL trc_atm_c14_ini   ! Init atm values
+      !
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      !
+   END SUBROUTINE trc_ini_c14
+
+   !!======================================================================
+END MODULE trcini_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcnam_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcnam_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcnam_c14.F90	(revision 8732)
@@ -0,0 +1,120 @@
+MODULE trcnam_c14
+   !!======================================================================
+   !!                         ***  MODULE trcnam_c14  ***
+   !! TOP :   initialisation of some run parameters for C14 chemical model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
+   !! History :        !  2015 (A.Mouchet) equilibrium + transient C14
+   !!----------------------------------------------------------------------
+   !! trc_nam_c14      : C14 model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+   USE sms_c14
+
+   IMPLICIT NONE
+   PRIVATE
+   !!
+   PUBLIC   trc_nam_c14   ! called by trcnam.F90 module
+   !!
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnam_c14.F90                       $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_c14
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_c14  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for C14 model
+      !!
+      !! ** Method  :   Read the namc14 namelist and check the parameter 
+      !!       values called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist namelist_c14
+      !!----------------------------------------------------------------------
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !! 
+      NAMELIST/namc14_typ/ kc14typ,rc14at, pco2at, rc14init   ! type of C14 tracer, default values of C14/C, pco2, & ocean r14
+      NAMELIST/namc14_sbc/ ln_chemh, xkwind, xdicsur          ! chem enh, wind coeff, ref DIC 
+      NAMELIST/namc14_fcg/ cfileco2, cfilec14, tyrc14_beg  ! for transient exps; atm forcing
+      !!-------------------------------------------------------------------
+      ! Variable setting
+      ctrcnm    (jp_c14) = 'RC14'
+      ctrcln    (jp_c14) = 'Radiocarbon ratio'
+      ctrcun    (jp_c14) = '-'
+      ln_trc_ini(jp_c14) = .false.
+      ln_trc_sbc(jp_c14) = .false.
+      ln_trc_cbc(jp_c14) = .false.
+      ln_trc_obc(jp_c14) = .false.
+      !
+      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
+      READ  ( numtrc_ref, namc14_typ, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_typ in reference namelist', lwp )
+
+      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist 
+      READ  ( numtrc_cfg, namc14_typ, IOSTAT = ios, ERR = 902)
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_typ in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonr, namc14_typ )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Radiocarbon C14'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist namc14_typ'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Type of C14 tracer (0=equilibrium; 1=bomb transient; 2=past transient) kc14typ = ', kc14typ
+         WRITE(numout,*) ' Default value for atmospheric C14/C (used for equil run)               rc14at  = ', rc14at
+         WRITE(numout,*) ' Default value for atmospheric pcO2 [atm] (used for equil run)          pco2at  = ', pco2at
+         WRITE(numout,*) ' Default value for initial C14/C in the ocean (used for equil run)      rc14init= ', rc14init
+         WRITE(numout,*) '  '
+      ENDIF
+
+      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
+      READ  ( numtrc_ref, namc14_sbc, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_sbc in reference namelist', lwp )
+
+      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist 
+      READ  ( numtrc_cfg, namc14_sbc, IOSTAT = ios, ERR = 904)
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_sbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonr, namc14_sbc )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' Namelist namc14_sbc'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Chemical enhancement in piston velocity   ln_chemh = ', ln_chemh
+         WRITE(numout,*) ' Coefficient for gas exchange velocity     xkwind   = ', xkwind
+         WRITE(numout,*) ' Reference DIC concentration (mol/m3)      xdicsur  = ', xdicsur
+         WRITE(numout,*) '  '
+      ENDIF
+
+      REWIND( numtrc_ref )              ! Namelist namc14_typ in reference namelist :
+      READ  ( numtrc_ref, namc14_fcg, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_fcg in reference namelist', lwp )
+
+      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist 
+      READ  ( numtrc_cfg, namc14_fcg, IOSTAT = ios, ERR = 906)
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14_fcg in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonr, namc14_fcg )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' Namelist namc14_fcg'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Atmospheric co2 file ( bomb )  cfileco2   = ', TRIM( cfileco2 )
+         WRITE(numout,*) ' Atmospheric c14 file ( bomb )  cfilec14   = ', TRIM( cfilec14 )
+         WRITE(numout,*) ' Starting year of experiment    tyrc14_beg = ', tyrc14_beg
+         WRITE(numout,*) '  '
+      ENDIF
+
+      !
+      IF( kc14typ == 2)    tyrc14_beg = 1950._wp - tyrc14_beg  ! BP to AD dates
+      ! set units 
+      rlam14 = LOG(2._wp) / 5730._wp / rsiyea    ! C14 decay  rate: yr^-1 --> s^-1
+      !                                          ! radiocarbon half-life is 5730 yr
+   END SUBROUTINE trc_nam_c14
+   
+   !!======================================================================
+END MODULE trcnam_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcsms_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcsms_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcsms_c14.F90	(revision 8732)
@@ -0,0 +1,169 @@
+MODULE trcsms_c14
+   !!======================================================================
+   !!                      ***  MODULE trcsms_c14  ***
+   !! TOP : Bomb C14 main module
+   !!======================================================================
+   !! History     -   ! 1994-05 ( J. Orr ) original code
+   !!            1.0  ! 2006-02 ( J.M. Molines )  Free form + modularity
+   !!            2.0  ! 2008-12 ( C. Ethe ) reorganisation
+   !!            4.0  ! 2011-02 ( A.R. Porter, STFC Daresbury ) Dynamic memory
+   !!                 ! 2015    (A. Mouchet) general C14 + update formulas
+   !!----------------------------------------------------------------------
+   !!   trc_sms_c14 :  compute and add C14 suface forcing to C14 trends
+   !!----------------------------------------------------------------------
+   USE oce_trc       ! Ocean variables
+   USE par_trc       ! TOP parameters
+   USE trc           ! TOP variables
+   USE trd_oce    ! trends
+   USE trdtrc    ! trends
+   USE sms_c14    ! atmospheric forcing
+   USE trcatm_c14    ! atmospheric forcing
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_c14       ! called in trcsms.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $                                                                    $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_c14( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sms_c14  ***
+      !!
+      !! ** Purpose :   Compute the surface boundary contition on C14
+      !!      passive tracer associated with air-sea fluxes and add it to 
+      !!      the general trend of tracers equations.
+      !
+      !    Method: 
+      !          - transport the ratio C14/C as in Toggweiler et al. (JGR,1989)
+      !          - if on-line a passive tracer (jpcref; NO sms) allows compensating for
+      !            freshwater fluxes which should not impact the C14/C ratio
+      !
+      !        =>   Delta-C14= ( trn(...jp_c14) -1)*1000.
+      !!
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !
+      INTEGER  :: ji, jj, jk         ! dummy loop indices 
+      REAL(wp) :: zt, ztp, zsk      ! dummy variables
+      REAL(wp) :: zsol              ! solubility
+      REAL(wp) :: zsch              ! schmidt number
+      REAL(wp) :: zv2               ! wind speed ( square)
+      REAL(wp) :: zpv               ! piston velocity
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_c14')
+      !
+      IF( kt ==  nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_sms_c14:  C14 model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      ENDIF
+      !
+ 
+      ! Get co2sbc & c14sbc(ji,jj): at 1st iter for all, at each time step for transient
+      IF( kc14typ >= 1 .OR.  kt ==  nittrc000 )   CALL trc_atm_c14( kt, co2sbc, c14sbc ) 
+
+      ! -------------------------------------------------------------------
+      !  Gas exchange coefficient (Wanninkhof, 1992, JGR, 97,7373-7382)
+      !  Schmidt number of CO2 in seawater (Wanninkhof, 1992 & 2014)
+      !  CO2 solubility (Weiss, 1974; Wanninkhof, 2014) 
+      ! -------------------------------------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi  
+            IF( tmask(ji,jj,1) >  0.) THEN
+
+               zt   = MIN( 40., tsn(ji,jj,1,jp_tem))
+
+               !  Computation of solubility zsol in [mol/(L * atm)]
+               !   after Wanninkhof (2014) referencing Weiss (1974)
+               ztp  = ( zt + 273.16 ) * 0.01
+               zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)]
+               zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) )
+               ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)]
+               zsol = zsol * 1.e-03
+
+               ! Computes the Schmidt number of CO2 in seawater
+               !               Wanninkhof-2014
+               zsch = 2116.8 + zt * ( -136.25 + zt * (4.7353 + zt * (-0.092307 + 0.0007555 * zt ) ) )
+
+               ! Wanninkhof Piston velocity: zpv in units [m/s]
+               zv2 = xkwind * (wndm(ji,jj) * wndm(ji,jj))              ! wind speed module at T points
+               ! chemical enhancement (Wanninkhof & Knox, 1996)
+               IF( ln_chemh ) zv2 = zv2 + 2.5 * ( 0.5246 + zt * (0.016256 + 0.00049946  * zt ) )
+               zv2 = zv2/360000._wp                                    ! conversion cm/h -> m/s
+               !
+               zpv  = ( zv2 * SQRT( 660./ zsch ) ) * ( 1. - fr_i(ji,jj) ) * tmask(ji,jj,1)
+
+               ! CO2 piston velocity (m/s)
+               exch_co2(ji,jj)= zpv
+               ! CO2 invasion rate (mol/ppm/m2/s) = 1st part of 14C/C exchange velocity
+               exch_c14(ji,jj)= zpv * zsol
+            ELSE
+               exch_co2(ji,jj) = 0._wp
+               exch_c14(ji,jj) = 0._wp
+            ENDIF
+         END DO
+      END DO
+
+      ! Exchange velocity for 14C/C ratio (m/s)
+      zt = co2sbc / xdicsur
+      exch_c14(:,:) = zt * exch_c14(:,:)
+      !
+      ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s
+      !                               already masked
+      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - trb(:,:,1,jp_c14) )
+            
+      ! cumulation of air-to-sea flux at each time step
+      qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rdttrc
+      !
+      ! Add the surface flux to the trend of jp_c14
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            tra(ji,jj,1,jp_c14) = tra(ji,jj,1,jp_c14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1) 
+         END DO
+      END DO
+      !
+      ! Computation of decay effects on jp_c14
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               tra(ji,jj,jk,jp_c14) = tra(ji,jj,jk,jp_c14) - rlam14 * trb(ji,jj,jk,jp_c14) * tmask(ji,jj,jk) 
+               !
+            END DO
+         END DO
+      END DO
+
+      !
+      IF( lrst_trc ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_rst_wri_c14 : Write specific variables from c14 model '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      !
+         CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc )       ! These five need      &
+         CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc )     ! &    to be written   &
+         CALL iom_rstput( kt, nitrst, numrtw, 'exch_co2', exch_co2 ) ! &    for temporal    &
+         CALL iom_rstput( kt, nitrst, numrtw, 'exch_c14', exch_c14 ) ! &    averages        &
+         CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14 )   ! &    to be coherent.
+         CALL iom_rstput( kt, nitrst, numrtw, 'qint_c14', qint_c14 ) ! Cumulative
+      !
+      ENDIF
+
+      IF( l_trdtrc )  CALL trd_trc( tra(:,:,:,jp_c14), 1, jptra_sms, kt )   ! save trends
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_c14')
+      !
+   END SUBROUTINE trc_sms_c14
+
+
+  !!======================================================================
+END MODULE trcsms_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcwri_c14.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcwri_c14.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/C14/trcwri_c14.F90	(revision 8732)
@@ -0,0 +1,138 @@
+MODULE trcwri_c14
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    MY_SRC :   Additional outputs for C14 tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !! History :   2.0  !  2015 (A. Mouchet)  adapted code for C14
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput
+   !!----------------------------------------------------------------------
+   !! trc_wri_c14   :  outputs of ventilation fields
+   !!----------------------------------------------------------------------
+   USE oce_trc       ! Ocean variables
+   USE trc         ! passive tracers common variables 
+   USE iom         ! I/O manager 
+   USE sms_c14
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_c14
+   !
+   !   Standard ratio: 1.176E-12 ; Avogadro's nbr = 6.022E+23 at/mol ; bomb C14 traditionally reported as 1.E+26 atoms
+   REAL(wp), PARAMETER  :: atomc14 = 1.176 * 6.022E-15   ! conversion factor 
+
+
+CONTAINS
+
+   SUBROUTINE trc_wri_c14
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_c14  ***
+      !!
+      !! ** Purpose :   output additional C14 tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra         ! short title for tracer
+      INTEGER              :: ji,jj,jk,jn   ! dummy loop indexes
+      REAL(wp)             :: zage,zarea,ztemp   ! temporary
+      REAL(wp), POINTER, DIMENSION(:,:)   :: zres, z2d ! temporary storage 2D
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      cltra = TRIM( ctrcnm(jp_c14) )                  ! short title for tracer
+      CALL iom_put( cltra, trn(:,:,:,jp_c14) )
+
+      ! compute and write the tracer diagnostic in the file
+      ! ---------------------------------------
+      
+      IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge")   ) THEN
+         !
+         CALL wrk_alloc( jpi, jpj     , z2d, zres )
+         CALL wrk_alloc( jpi, jpj, jpk, z3d, zz3d )
+         !
+         zage = -1._wp / rlam14 / rsiyea  ! factor for radioages in year
+         z3d(:,:,:)  = 1._wp
+         zz3d(:,:,:) = 0._wp
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( tmask(ji,jj,jk) > 0._wp) THEN
+                     z3d (ji,jj,jk) = trn(ji,jj,jk,jp_c14)
+                     zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) )
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         zres(:,:) = z3d(:,:,1)
+
+         ! Reservoir age [yr]
+         z2d(:,:) =0._wp
+         jk = 1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztemp = zres(ji,jj) / c14sbc(ji,jj)
+               IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
+            ENDDO
+         ENDDO
+         !
+         z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp )
+         CALL iom_put( "DeltaC14" , z3d(:,:,:)  )  ! Delta C14 [permil]
+         CALL iom_put( "C14Age"   , zage * zz3d(:,:,:) )            !  Radiocarbon age [yr]
+
+         CALL iom_put( "qtr_c14", rsiyea * qtr_c14(:,:)  )            !  Radiocarbon surf flux [./m2/yr]
+         CALL iom_put( "qint_c14" , qint_c14  )                       ! cumulative flux [./m2]
+         CALL iom_put( "RAge" , zage * z2d(:,:) )                     ! Reservoir age [yr]
+         !
+         CALL wrk_dealloc( jpi, jpj     , z2d, zres )
+         CALL wrk_dealloc( jpi, jpj, jpk, z3d, zz3d )
+         !
+      ENDIF
+      !
+      !  0-D fields
+      !
+      CALL iom_put( "AtmCO2", co2sbc )  !     global atmospheric CO2 [ppm]
+    
+      IF( iom_use("AtmC14") ) THEN
+         zarea = glob_sum( e1e2t(:,:) )           ! global ocean surface
+         ztemp = glob_sum( c14sbc(:,:) * e1e2t(:,:) )
+         ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp
+         CALL iom_put( "AtmC14" , ztemp )   ! Global atmospheric DeltaC14 [permil]
+      ENDIF
+      IF( iom_use("K_C14") ) THEN
+         ztemp = glob_sum ( exch_c14(:,:) * e1e2t(:,:) )
+         ztemp = rsiyea * ztemp / zarea
+         CALL iom_put( "K_C14" , ztemp )   ! global mean exchange velocity for C14/C ratio [m/yr]
+      ENDIF
+      IF( iom_use("K_CO2") ) THEN
+         zarea = glob_sum( e1e2t(:,:) )           ! global ocean surface
+         ztemp = glob_sum ( exch_co2(:,:) * e1e2t(:,:) )
+         ztemp = 360000._wp * ztemp / zarea       ! cm/h units: directly comparable with literature
+         CALL iom_put( "K_CO2", ztemp )  !  global mean CO2 piston velocity [cm/hr]
+      ENDIF
+      IF( iom_use("C14Inv") ) THEN
+         ztemp = glob_sum( trn(:,:,:,jp_c14) * cvol(:,:,:) )
+         ztemp = atomc14 * xdicsur * ztemp
+         CALL iom_put( "C14Inv", ztemp )  !  Radiocarbon ocean inventory [10^26 atoms]
+      END IF
+      !
+   END SUBROUTINE trc_wri_c14
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No C14 tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_c14
+CONTAINS
+   SUBROUTINE trc_wri_c14                     ! Empty routine  
+   END SUBROUTINE trc_wri_c14
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcwri_c14 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_c14
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 8732)
@@ -0,0 +1,17 @@
+MODULE par_cfc
+   !!======================================================================
+   !!                        ***  par_cfc  ***
+   !! TOP :   set the CFC parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   INTEGER, PUBLIC  :: jp_cfc0, jp_cfc1  !:  First/last index of CFC tracers
+
+   !!======================================================================
+END MODULE par_cfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90	(revision 8732)
@@ -0,0 +1,39 @@
+MODULE trcice_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcice_cfc  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+   !! trc_ice_cfc       : MY_TRC model main routine
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_cfc       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcice_cfc.F90 4990 2014-12-15 16:42:49Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_cfc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_cfc  ***
+      !!
+      !! ** Purpose :   main routine of MY_TRC model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_cfc
+
+   !!======================================================================
+END MODULE trcice_cfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 8732)
@@ -0,0 +1,146 @@
+MODULE trcini_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcini_cfc  ***
+   !! TOP :   initialisation of the CFC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) 
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! trc_ini_cfc      : CFC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcnam_cfc      ! CFC SMS namelist
+   USE trcsms_cfc      ! CFC sms trends
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
+
+   INTEGER  ::   inum                   ! unit number
+   REAL(wp) ::   ylats = -10.           ! 10 degrees south
+   REAL(wp) ::   ylatn =  10.           ! 10 degrees north
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_cfc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_cfc  ***  
+      !!
+      !! ** Purpose :   initialization for cfc model
+      !!
+      !! ** Method  : - Read the namcfc namelist and check the parameter values
+      !!----------------------------------------------------------------------
+      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr
+      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines
+      REAL(wp) ::  zyy, zyd
+      CHARACTER(len = 20)  ::  cltra
+      !!----------------------------------------------------------------------
+      !
+      CALL trc_nam_cfc
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+      !
+      IF(lwp) WRITE(numout,*) 'Read annual atmospheric concentratioins from formatted file : ' // TRIM(clname)
+      
+      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      REWIND(inum)
+      
+      ! compute the number of year in the file
+      ! file starts in 1931 do jn represent the year in the century
+      jn = 31 
+      DO 
+        READ(inum,'(1x)',END=100) 
+        jn = jn + 1
+      END DO
+ 100  jpyear = jn - 1 - iskip
+      IF ( lwp) WRITE(numout,*) '   --->  ', jpyear ,' years read'
+      !                                ! Allocate CFC arrays
+
+      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr )
+      IF( ierr > 0 ) THEN
+         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN
+      ENDIF
+      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' )
+
+
+      ! Initialization of boundaries conditions
+      ! --------------------------------------- 
+      xphem (:,:)    = 0._wp
+      p_cfc(:,:,:)   = 0._wp
+      
+      ! Initialization of qint in case of  no restart 
+      !----------------------------------------------
+      qtr_cfc(:,:,:) = 0._wp
+      IF( .NOT. ln_rsttr ) THEN    
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'Initialisation of qint ; No restart : qint equal zero '
+         ENDIF
+         qint_cfc(:,:,:) = 0._wp
+         DO jl = 1, jp_cfc
+            jn = jp_cfc0 + jl - 1
+            trn(:,:,:,jn) = 0._wp
+         END DO
+      ENDIF
+
+      REWIND(inum)
+      
+      DO jm = 1, iskip        ! Skip over 1st six descriptor lines
+         READ(inum,'(1x)')
+      END DO
+      ! file starts in 1931 do jn represent the year in the century.jhh
+      ! Read file till the end
+      jn = 31
+      DO 
+        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3)
+        IF( io < 0 ) exit
+        jn = jn + 1
+      END DO
+
+      !p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
+      !p_cfc(33,1:2,1) = 8.e-4
+      !p_cfc(34,1:2,1) = 1.e-6
+      !p_cfc(35,1:2,1) = 2.e-3
+      !p_cfc(36,1:2,1) = 4.e-3
+      !p_cfc(37,1:2,1) = 6.e-3
+      !p_cfc(38,1:2,1) = 8.e-3
+      !p_cfc(39,1:2,1) = 1.e-2
+      IF(lwp) THEN        ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Year   c11NH     c11SH     c12NH     c12SH     SF6NH     SF6SH'
+         DO jn = 30, jpyear
+            WRITE(numout, '( 1I4, 6F10.4)') jn, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3)
+         END DO
+      ENDIF
+
+
+      ! Interpolation factor of atmospheric partial pressure
+      ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
+      !---------------------------------------------------------------------------------------
+      zyd = ylatn - ylats      
+      DO jj = 1 , jpj
+         DO ji = 1 , jpi
+            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
+            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
+            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
+            ENDIF
+         END DO
+      END DO
+      !
+      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
+      IF(lwp) WRITE(numout,*) ' '
+      !
+   END SUBROUTINE trc_ini_cfc
+
+   !!======================================================================
+END MODULE trcini_cfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 8732)
@@ -0,0 +1,107 @@
+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
+   !!----------------------------------------------------------------------
+   !! trc_nam_cfc      : CFC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+   USE trcsms_cfc      ! CFC specific variable
+
+   IMPLICIT NONE
+   PRIVATE
+
+   CHARACTER(len=34), PUBLIC ::   clname ! Input filename of CFCs atm. concentrations
+
+   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 (nittrc000)
+      !!
+      !! ** input   :   Namelist namcfc
+      !!----------------------------------------------------------------------
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      INTEGER :: jl, jn
+      !!
+      NAMELIST/namcfc/ ndate_beg, nyear_res, clname
+      !!----------------------------------------------------------------------
+      !
+      jn = jp_cfc0 - 1
+      ! Variables setting
+      IF( ln_cfc11 ) THEN
+         jn = jn + 1
+         ctrcnm    (jn) = 'CFC11'
+         ctrcln    (jn) = 'Chlorofluoro carbon 11 Concentration'
+         ctrcun    (jn) = 'umolC/L'
+         ln_trc_ini(jn) = .false.
+         ln_trc_sbc(jn) = .false.
+         ln_trc_cbc(jn) = .false.
+         ln_trc_obc(jn) = .false.
+      ENDIF
+      !
+      IF( ln_cfc12 ) THEN
+         jn = jn + 1
+         ctrcnm    (jn) = 'CFC12'
+         ctrcln    (jn) = 'Chlorofluoro carbon 12 Concentration'
+         ctrcun    (jn) = 'umolC/L'
+         ln_trc_ini(jn) = .false.
+         ln_trc_sbc(jn) = .false.
+         ln_trc_cbc(jn) = .false.
+         ln_trc_obc(jn) = .false.
+      ENDIF
+      !
+      IF( ln_sf6 ) THEN
+         jn = jn + 1
+         ctrcnm    (jn) = 'SF6'
+         ctrcln    (jn) = 'Sulfur hexafluoride Concentration'
+         ctrcun    (jn) = 'umol/L'
+         ln_trc_ini(jn) = .false.
+         ln_trc_sbc(jn) = .false.
+         ln_trc_cbc(jn) = .false.
+         ln_trc_obc(jn) = .false.
+      ENDIF
+      !
+      REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters
+      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp )
+
+      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters
+      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonr, namcfc )
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' CFCs'
+         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(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC
+
+   END SUBROUTINE trc_nam_cfc
+   
+   !!======================================================================
+END MODULE trcnam_cfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 8732)
@@ -0,0 +1,312 @@
+MODULE trcsms_cfc
+   !!======================================================================
+   !!                      ***  MODULE trcsms_cfc  ***
+   !! TOP : CFC main model
+   !!======================================================================
+   !! History :  OPA  !  1999-10  (JC. Dutay)  original code
+   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity
+   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
+   !!            4.0  !  2016-11  (T. Lovato) Add SF6, Update Schmidt number
+   !!----------------------------------------------------------------------
+   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends
+   !!   cfc_init     :  sets constants for CFC surface forcing computation
+   !!----------------------------------------------------------------------
+   USE oce_trc       ! Ocean variables
+   USE par_trc       ! TOP parameters
+   USE trc           ! TOP variables
+   USE trd_oce
+   USE trdtrc
+   USE iom           ! I/O library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_cfc         ! called in ???    
+   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90
+
+   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres
+   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in input data file (in trcini_cfc)
+   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC
+   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year)
+   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa) 
+   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for all CFC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   atm_cfc  ! partial hemispheric pressure for used CFC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function
+
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   soa      ! coefficient for solubility of CFC [mol/l/atm]
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sob      !    "               "
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sca      ! coefficients for schmidt number in degrees Celsius
+   !                          ! coefficients for conversion
+   REAL(wp) ::   xconv1 = 1.0          ! conversion from to 
+   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s: 
+   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm
+   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_cfc( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_cfc  ***
+      !!
+      !! ** Purpose :   Compute the surface boundary contition on CFC 11 
+      !!             passive tracer associated with air-mer fluxes and add it 
+      !!             to the general trend of tracers equations.
+      !!
+      !! ** Method  : - get the atmospheric partial pressure - given in pico -
+      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
+      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
+      !!              - the input function is given by : 
+      !!                speed * ( concentration at equilibrium - concentration at surface )
+      !!              - the input function is in pico-mol/m3/s and the
+      !!                CFC concentration in pico-mol/m3
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jn, jl, jm, js
+      INTEGER  ::   iyear_beg, iyear_end
+      INTEGER  ::   im1, im2, ierr
+      REAL(wp) ::   ztap, zdtap        
+      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2
+      REAL(wp) ::   zsol      ! solubility
+      REAL(wp) ::   zsch      ! schmidt number 
+      REAL(wp) ::   zpp_cfc   ! atmospheric partial pressure of CFC
+      REAL(wp) ::   zca_cfc   ! concentration at equilibrium
+      REAL(wp) ::   zak_cfc   ! transfert coefficients
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function
+      !!----------------------------------------------------------------------
+      !
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_cfc')
+      !
+      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr )
+      IF( ierr > 0 ) THEN
+         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN
+      ENDIF
+
+      IF( kt == nittrc000 )   CALL cfc_init
+
+      ! Temporal interpolation
+      ! ----------------------
+      iyear_beg = nyear - 1900
+      IF ( nmonth <= 6 ) THEN
+         iyear_beg = iyear_beg - 1
+         im1       =  6 - nmonth + 1
+         im2       =  6 + nmonth - 1
+      ELSE
+         im1       = 12 - nmonth + 7
+         im2       =      nmonth - 7
+      ENDIF
+      iyear_end = iyear_beg + 1
+
+      !                                                  !------------!
+      DO jl = 1, jp_cfc                                  !  CFC loop  !
+         !                                               !------------!
+         jn = jp_cfc0 + jl - 1
+         ! time interpolation at time kt
+         DO jm = 1, jphem
+            zpatm(jm,jl) = (  atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  &
+               &           +  atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12.
+         END DO
+         
+         !                                                         !------------!
+         DO jj = 1, jpj                                            !  i-j loop  !
+            DO ji = 1, jpi                                         !------------!
+ 
+               ! space interpolation
+               zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   &
+                  &     + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
+
+               ! Computation of concentration at equilibrium : in picomol/l
+               ! coefficient for solubility for CFC-11/12 in  mol/l/atm
+               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
+                  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 + tsn(ji,jj,1,jp_sal) * zdtap ) 
+               ELSE
+                  zsol  = 0.e0
+               ENDIF
+               ! conversion from mol/l/atm to mol/m3/atm and from mol/m3/atm to mol/m3/pptv    
+               zsol = xconv4 * xconv3 * zsol * tmask(ji,jj,1)  
+               ! concentration at equilibrium
+               zca_cfc = xconv1 * zpp_cfc * zsol * tmask(ji,jj,1)             
+  
+               ! Computation of speed transfert
+               !    Schmidt number revised in Wanninkhof (2014)
+               zt1  = tsn(ji,jj,1,jp_tem)
+               zt2  = zt1 * zt1 
+               zt3  = zt1 * zt2
+               zt4  = zt2 * zt2
+               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4
+
+               !    speed transfert : formulae revised in Wanninkhof (2014)
+               zv2     = wndm(ji,jj) * wndm(ji,jj)
+               zsch    = zsch / 660.
+               zak_cfc = ( 0.31 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
+
+               ! Input function  : speed *( conc. at equil - concen at surface )
+               ! trn in pico-mol/l idem qtr; ak in en m/a
+               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
+                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) )
+               ! Add the surface flux to the trend
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1) 
+
+               ! cumulation of surface flux at each time step
+               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt
+               !                                               !----------------!
+            END DO                                             !  end i-j loop  !
+         END DO                                                !----------------!
+         !                                                  !----------------!
+      END DO                                                !  end CFC loop  !
+      !
+      IF( lrst_trc ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         DO jn = jp_cfc0, jp_cfc1
+            CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
+         END DO
+      ENDIF                                            
+      !
+      IF( lk_iomput ) THEN
+         DO jn = jp_cfc0, jp_cfc1
+            CALL iom_put( 'qtr_'//ctrcnm(jn) , qtr_cfc (:,:,jn) )
+            CALL iom_put( 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
+         ENDDO
+      END IF
+      !
+      IF( l_trdtrc ) THEN
+          DO jn = jp_cfc0, jp_cfc1
+            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+          END DO
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
+      !
+   END SUBROUTINE trc_sms_cfc
+
+
+   SUBROUTINE cfc_init
+      !!---------------------------------------------------------------------
+      !!                     ***  cfc_init  ***  
+      !!
+      !! ** Purpose : sets constants for CFC model
+      !!---------------------------------------------------------------------
+      INTEGER :: jn
+      !!----------------------------------------------------------------------
+      !
+      jn = 0 
+      ! coefficient for CFC11 
+      !----------------------
+      if ( ln_cfc11 ) then
+         jn = jn + 1
+         ! Solubility
+         soa(1,jn) = -229.9261 
+         soa(2,jn) =  319.6552
+         soa(3,jn) =  119.4471
+         soa(4,jn) =  -1.39165
+
+         sob(1,jn) =  -0.142382
+         sob(2,jn) =   0.091459
+         sob(3,jn) =  -0.0157274
+
+         ! Schmidt number 
+         sca(1,jn) = 3579.2
+         sca(2,jn) = -222.63
+         sca(3,jn) = 7.5749
+         sca(4,jn) = -0.14595
+         sca(5,jn) = 0.0011874
+
+         ! atm. concentration
+         atm_cfc(:,:,jn) = p_cfc(:,:,1)
+      endif
+
+      ! coefficient for CFC12 
+      !----------------------
+      if ( ln_cfc12 ) then
+         jn = jn + 1
+         ! Solubility
+         soa(1,jn) = -218.0971
+         soa(2,jn) =  298.9702
+         soa(3,jn) =  113.8049
+         soa(4,jn) =  -1.39165
+
+         sob(1,jn) =  -0.143566
+         sob(2,jn) =   0.091015
+         sob(3,jn) =  -0.0153924
+
+         ! schmidt number 
+         sca(1,jn) = 3828.1
+         sca(2,jn) = -249.86
+         sca(3,jn) = 8.7603
+         sca(4,jn) = -0.1716
+         sca(5,jn) = 0.001408
+
+         ! atm. concentration
+         atm_cfc(:,:,jn) = p_cfc(:,:,2)
+      endif
+
+      ! coefficient for SF6
+      !----------------------
+      if ( ln_sf6 ) then
+         jn = jn + 1
+         ! Solubility
+         soa(1,jn) = -80.0343
+         soa(2,jn) = 117.232
+         soa(3,jn) =  29.5817
+         soa(4,jn) =   0.0
+
+         sob(1,jn) =  0.0335183 
+         sob(2,jn) = -0.0373942 
+         sob(3,jn) =  0.00774862
+
+         ! schmidt number
+         sca(1,jn) = 3177.5
+         sca(2,jn) = -200.57
+         sca(3,jn) = 6.8865
+         sca(4,jn) = -0.13335
+         sca(5,jn) = 0.0010877
+  
+         ! atm. concentration
+         atm_cfc(:,:,jn) = p_cfc(:,:,3)
+       endif
+
+      IF( ln_rsttr ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+         !
+         DO jn = jp_cfc0, jp_cfc1
+            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
+         END DO
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+      !
+   END SUBROUTINE cfc_init
+
+
+   INTEGER FUNCTION trc_sms_cfc_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( xphem   (jpi,jpj)        , atm_cfc(jpyear,jphem,jp_cfc)  ,    &
+         &      qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc)      ,    &
+         &      soa(4,jp_cfc)    ,  sob(3,jp_cfc)   ,  sca(5,jp_cfc)     ,    &
+         &      STAT=trc_sms_cfc_alloc )
+         !
+      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION trc_sms_cfc_alloc
+
+   !!======================================================================
+END MODULE trcsms_cfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90	(revision 8732)
@@ -0,0 +1,56 @@
+MODULE trcwri_cfc
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    cfc :   Output of cfc tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput
+   !!----------------------------------------------------------------------
+   !! trc_wri_cfc   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE trc         ! passive tracers common variables 
+   USE iom         ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_cfc 
+
+CONTAINS
+
+   SUBROUTINE trc_wri_cfc
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = jp_cfc0, jp_cfc1
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( cltra, trn(:,:,:,jn) )
+      END DO
+      !
+   END SUBROUTINE trc_wri_cfc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_cfc
+CONTAINS
+   SUBROUTINE trc_wri_cfc                     ! Empty routine  
+   END SUBROUTINE trc_wri_cfc
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcwri_cfc.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_cfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90	(revision 8732)
@@ -0,0 +1,19 @@
+MODULE par_my_trc
+   !!======================================================================
+   !!                        ***  par_my_trc  ***
+   !! TOP :   set the MY_TRC parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC ::   jp_myt0             !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC ::   jp_myt1             !: Last  index of MY_TRC passive tracers
+   !!======================================================================
+END MODULE par_my_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90	(revision 8732)
@@ -0,0 +1,35 @@
+MODULE trcice_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcice_my_trc  ***
+   !!----------------------------------------------------------------------
+   !! trc_ice_my_trc       : MY_TRC model seaice coupling routine
+   !!----------------------------------------------------------------------
+   !! History :        !  2016  (C. Ethe, T. Lovato) Revised architecture
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_my_trc       ! called by trcice.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ice_ini_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ice_my_trc  ***
+      !!
+      !!----------------------------------------------------------------------
+      !
+      !
+   END SUBROUTINE trc_ice_ini_my_trc
+
+   !!======================================================================
+END MODULE trcice_my_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 8732)
@@ -0,0 +1,57 @@
+MODULE trcini_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcini_my_trc  ***
+   !! TOP :   initialisation of the MY_TRC tracers
+   !!======================================================================
+   !! History :        !  2007  (C. Ethe, G. Madec) Original code
+   !!                  !  2016  (C. Ethe, T. Lovato) Revised architecture
+   !!----------------------------------------------------------------------
+   !! trc_ini_my_trc   : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE par_my_trc
+   USE trcnam_my_trc     ! MY_TRC SMS namelist
+   USE trcsms_my_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_my_trc   ! called by trcini.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_my_trc  ***  
+      !!
+      !! ** Purpose :   initialization for MY_TRC model
+      !!
+      !! ** Method  : - Read the namcfc namelist and check the parameter values
+      !!----------------------------------------------------------------------
+      !
+      CALL trc_nam_my_trc
+      !
+      !                       ! Allocate MY_TRC arrays
+      IF( trc_sms_my_trc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: passive tracer unit vector'
+      IF(lwp) WRITE(numout,*) ' To check conservation : '
+      IF(lwp) WRITE(numout,*) '   1 - No sea-ice model '
+      IF(lwp) WRITE(numout,*) '   2 - No runoff ' 
+      IF(lwp) WRITE(numout,*) '   3 - precipitation and evaporation equal to 1 : E=P=1 ' 
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      
+      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1.
+      !
+   END SUBROUTINE trc_ini_my_trc
+
+   !!======================================================================
+END MODULE trcini_my_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90	(revision 8732)
@@ -0,0 +1,43 @@
+MODULE trcnam_my_trc
+   !!======================================================================
+   !!                      ***  MODULE trcnam_my_trc  ***
+   !! TOP :   initialisation of some run parameters for MY_TRC bio-model
+   !!======================================================================
+   !! History :      !  2007  (C. Ethe, G. Madec) Original code
+   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture
+   !!----------------------------------------------------------------------
+   !! 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 4.0 , NEMO Consortium (2016)
+   !! $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
+   
+   !!======================================================================
+END MODULE trcnam_my_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 8732)
@@ -0,0 +1,87 @@
+MODULE trcsms_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcsms_my_trc  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :      !  2007  (C. Ethe, G. Madec)  Original code
+   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture
+   !!----------------------------------------------------------------------
+   !! trc_sms_my_trc       : MY_TRC model main routine
+   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc         ! Ocean variables
+   USE trc             ! TOP variables
+   USE trd_oce
+   USE trdtrc
+   USE trcbc, only : trc_bc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_my_trc       ! called by trcsms.F90 module
+   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module
+
+   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_my_trc( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_sms_my_trc  ***
+      !!
+      !! ** Purpose :   main routine of MY_TRC model
+      !!
+      !! ** Method  : -
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      INTEGER ::   jn   ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_my_trc')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_sms_my_trc:  MY_TRC model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt )
+
+      CALL trc_bc ( kt )       ! tracers: surface and lateral Boundary Conditions
+
+      ! add here the call to BGC model
+
+      ! Save the trends in the mixed layer
+      IF( l_trdtrc ) THEN
+          DO jn = jp_myt0, jp_myt1
+            ztrmyt(:,:,:) = tra(:,:,:,jn)
+            CALL trd_trc( ztrmyt, jn, jptra_sms, kt )   ! save trends
+          END DO
+          CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt )
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_my_trc')
+      !
+   END SUBROUTINE trc_sms_my_trc
+
+   INTEGER FUNCTION trc_sms_my_trc_alloc()
+      !!----------------------------------------------------------------------
+      !!              ***  ROUTINE trc_sms_my_trc_alloc  ***
+      !!----------------------------------------------------------------------
+      !
+      ! ALLOCATE here the arrays specific to MY_TRC
+      ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc )
+      trc_sms_my_trc_alloc = 0      ! set to zero if no array to be allocated
+      !
+      IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_warn('trc_sms_my_trc_alloc : failed to allocate arrays')
+      !
+   END FUNCTION trc_sms_my_trc_alloc
+
+   !!======================================================================
+END MODULE trcsms_my_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90	(revision 8732)
@@ -0,0 +1,56 @@
+MODULE trcwri_my_trc
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!     trc_wri_my_trc   :  outputs of concentration fields
+   !!======================================================================
+#if defined key_top && defined key_iomput
+   !!----------------------------------------------------------------------
+   !! History :      !  2007  (C. Ethe, G. Madec)  Original code
+   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture
+   !!----------------------------------------------------------------------
+   USE par_trc         ! passive tracers common variables
+   USE trc         ! passive tracers common variables 
+   USE iom         ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_my_trc 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_wri_my_trc
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = jp_myt0, jp_myt1
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( cltra, trn(:,:,:,jn) )
+      END DO
+      !
+   END SUBROUTINE trc_wri_my_trc
+
+#else
+
+CONTAINS
+
+   SUBROUTINE trc_wri_my_trc
+      !
+   END SUBROUTINE trc_wri_my_trc
+
+#endif
+
+END MODULE trcwri_my_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90	(revision 8732)
@@ -0,0 +1,505 @@
+MODULE p2zbio
+   !!======================================================================
+   !!                         ***  MODULE p2zbio  ***
+   !! TOP :   LOBSTER
+   !!======================================================================
+   !! History :    -   !  1999-07  (M. Levy) Original code
+   !!              -   !  2000-12  (E. Kestenare) assign a parameter to name individual tracers
+   !!              -   !  2001-03  (M. Levy)  LNO3 + dia2d 
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!----------------------------------------------------------------------
+   !!   p2z_bio        :  
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc             ! 
+   USE sms_pisces
+   USE p2zopt
+   USE lbclnk          ! 
+   USE prtctl_trc      ! Print control for debbuging
+   USE trd_oce
+   USE trdtrc
+   USE iom
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p2z_bio         ! called in ???
+   PUBLIC   p2z_bio_init    ! called in ???
+
+   REAL(wp) ::   tmumax     ! maximal phytoplankton growth rate            [s-1]
+   REAL(wp) ::   rgamma     ! phytoplankton exudation fraction             [%]
+   REAL(wp) ::   fphylab    ! NH4 fraction of phytoplankton exsudation
+   REAL(wp) ::   tmminp     ! minimal phytoplancton mortality rate         [0.05/86400 s-1=20 days]
+   REAL(wp) ::   aki        ! light photosynthesis half saturation constant[W/m2]
+   !
+   REAL(wp) ::   akno3      ! nitrate limitation half-saturation value     [mmol/m3]
+   REAL(wp) ::   aknh4      ! ammonium limitation half-saturation value    [mmol/m3]
+   REAL(wp) ::   taunn      ! nitrification rate                           [s-1]
+   REAL(wp) ::   psinut     ! inhibition of nitrate uptake by ammonium
+   !
+   REAL(wp) ::   taudn      ! detritus breakdown rate                        [0.1/86400 s-1=10 days]
+   REAL(wp) ::   fdetlab    ! NH4 fraction of detritus dissolution
+   !
+   REAL(wp) ::   taudomn    ! DOM breakdown rate                             [s-1]
+   !                        ! slow remineralization rate of semi-labile dom to nh4 (1 month)
+   !
+   REAL(wp) ::   rppz       ! ivlev coeff for zoo mortality
+   REAL(wp) ::   taus       ! specific zooplankton maximal grazing rate              [s-1]
+   !                                     ! 0.75/86400 s-1=8.680555E-6    1/86400 = 1.15e-5
+   REAL(wp) ::   aks        ! half-saturation constant for total zooplankton grazing [mmolN.m-3]
+   REAL(wp) ::   rpnaz      ! non-assimilated phytoplankton by zooplancton           [%]
+   REAL(wp) ::   rdnaz      ! non-assimilated detritus by zooplankton                [%]
+   REAL(wp) ::   tauzn      ! zooplancton specific excretion rate                    [0.1/86400 s-1=10 days]
+   REAL(wp) ::   tmminz     ! minimal zooplankton mortality rate                     [(mmolN/m3)-1 d-1]
+   REAL(wp) ::   fzoolab    ! NH4 fraction of zooplankton excretion
+   REAL(wp) ::   fdbod      ! zooplankton mortality fraction that goes to detritus
+
+   !! * Substitutions
+#  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 p2z_bio( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p2z_bio  ***
+      !!
+      !! ** Purpose :   compute the now trend due to biogeochemical processes
+      !!              and add it to the general trend of passive tracers equations
+      !!
+      !! ** Method  :   each now biological flux is calculated in function of now
+      !!              concentrations of tracers.
+      !!              depending on the tracer, these fluxes are sources or sinks.
+      !!              the total of the sources and sinks for each tracer
+      !!              is added to the general trend.
+      !!        
+      !!                      tra = tra + zf...tra - zftra...
+      !!                                     |         |
+      !!                                     |         |
+      !!                                  source      sink
+      !!        
+      !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      INTEGER  ::   ji, jj, jk, jl
+      REAL(wp) ::   zdet, zzoo, zphy, zno3, znh4, zdom      ! now concentrations
+      REAL(wp) ::   zlno3, zlnh4, zle, zlt                  ! limitation terms for phyto
+      REAL(wp) ::   zno3phy, znh4phy, zphynh4, zphydom
+      REAL(wp) ::   zphydet, zphyzoo, zdetzoo
+      REAL(wp) ::   zzoonh4, zzoodom, zzoodet, zdetnh4, zdetdom
+      REAL(wp) ::   znh4no3, zdomnh4, zppz, zpdz, zpppz, zppdz, zfood
+      REAL(wp) ::   zfilpz, zfildz, zphya, zzooa, zno3a
+      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju
+      REAL(wp) ::   ze3t
+      REAL(wp), POINTER,   DIMENSION(:,:,:) :: zw2d
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p2z_bio')
+      !
+      IF( lk_iomput ) THEN
+         CALL wrk_alloc( jpi, jpj,     17, zw2d )
+         CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d )
+      ENDIF
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' p2z_bio: LOBSTER bio-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      ENDIF
+
+      xksi(:,:) = 0.e0        ! zooplakton closure ( fbod)
+      IF( lk_iomput ) THEN
+         zw2d  (:,:,:) = 0.e0
+         zw3d(:,:,:,:) = 0.e0
+      ENDIF
+
+      !                                      ! -------------------------- !
+      DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  !
+         !                                   ! -------------------------- !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1 
+               ! 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) )
+
+               ! Limitations
+               zlt   = 1.
+               zle   = 1. - EXP( -etot(ji,jj,jk) / aki / zlt )
+               ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03
+               zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 )
+               zlnh4 = znh4 / (znh4+aknh4)  
+
+               ! sinks and sources
+               !    phytoplankton production and exsudation
+               zno3phy = tmumax * zle * zlt * zlno3 * zphy
+               znh4phy = tmumax * zle * zlt * zlnh4 * zphy
+
+               !    fphylab added by asklod AS Kremeur 2005-03
+               zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy)
+               zphynh4 = rgamma * fphylab * (zno3phy + znh4phy)
+               ! zooplankton production
+               !    preferences
+               zppz = rppz
+               zpdz = 1. - rppz
+               zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
+               zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
+               zfood = zpppz * zphy + zppdz * zdet
+               !    filtration 
+               zfilpz = taus * zpppz / (aks + zfood)
+               zfildz = taus * zppdz / (aks + zfood)
+               !    grazing
+               zphyzoo = zfilpz * zphy * zzoo
+               zdetzoo = zfildz * zdet * zzoo
+
+               ! fecal pellets production
+               zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo
+
+               ! zooplankton liquide excretion
+               zzoonh4 = tauzn * fzoolab * zzoo  
+               zzoodom = tauzn * (1 - fzoolab) * zzoo
+
+               ! mortality
+               !    phytoplankton mortality
+               zphydet = tmminp * zphy
+
+               !    zooplankton mortality
+               !    closure : flux grazing is redistributed below level jpkbio
+               zzoobod = tmminz * zzoo * zzoo
+               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk)
+               zboddet = fdbod * zzoobod
+
+               ! detritus and dom breakdown
+               zdetnh4 = taudn * fdetlab * zdet
+               zdetdom = taudn * (1 - fdetlab) * zdet
+
+               zdomnh4 = taudomn * zdom
+
+               ! flux added to express how the excess of nitrogen from 
+               ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment)
+               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
+
+               ! Nitrification 
+               znh4no3 = taunn * znh4
+
+               ! determination of trends
+               !    total trend for each biological tracer
+               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
+               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
+               zno3a = - zno3phy + znh4no3
+               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
+               zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet
+               zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
+
+               ! 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( lk_iomput ) THEN
+                  ! convert fluxes in per day
+                  ze3t = e3t_n(ji,jj,jk) * 86400._wp
+                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
+                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
+                  zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t
+                  zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t
+                  zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t
+                  zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t
+                  zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t
+                  zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t
+                  zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t
+                  zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t
+                  zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t
+                  zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t
+                  zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t
+                  zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t
+                  zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t
+                  zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t
+                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
+                  !   
+                  zw3d(ji,jj,jk,1) = zno3phy * 86400
+                  zw3d(ji,jj,jk,2) = znh4phy * 86400     
+                  zw3d(ji,jj,jk,3) = znh4no3 * 86400   
+                   ! 
+                ENDIF
+            END DO
+         END DO
+      END DO
+
+      !                                      ! -------------------------- !
+      DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  !
+         !                                   ! -------------------------- !
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1 
+               ! remineralisation of all quantities towards nitrate 
+
+               !    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) )
+
+               !    Limitations
+               zlt   = 0.e0
+               zle   = 0.e0
+               zlno3 = 0.e0
+               zlnh4 = 0.e0
+
+               !    sinks and sources
+               !       phytoplankton production and exsudation
+               zno3phy = 0.e0
+               znh4phy = 0.e0
+               zphydom = 0.e0
+               zphynh4 = 0.e0
+
+               !    zooplankton production
+               zphyzoo = 0.e0      ! grazing
+               zdetzoo = 0.e0
+
+               zzoodet = 0.e0      ! fecal pellets production
+
+               zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion
+               zzoodom = tauzn * (1 - fzoolab) * zzoo
+
+               !    mortality
+               zphydet = tmminp * zphy      ! phytoplankton mortality
+
+               zzoobod = 0.e0               ! zooplankton mortality
+               zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio
+
+               !    detritus and dom breakdown
+               zdetnh4 = taudn * fdetlab * zdet
+               zdetdom = taudn * (1 - fdetlab) * zdet
+
+               zdomnh4 = taudomn * zdom
+               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
+
+               !    Nitrification
+               znh4no3 = taunn * znh4
+
+
+               ! determination of trends
+               !     total trend for each biological tracer
+               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
+               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
+               zno3a = - zno3phy + znh4no3 
+               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
+               zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet
+               zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
+
+               ! 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( lk_iomput ) THEN
+                  ! convert fluxes in per day
+                  ze3t = e3t_n(ji,jj,jk) * 86400._wp
+                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t
+                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t
+                  zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t
+                  zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t
+                  zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t
+                  zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t
+                  zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t
+                  zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t
+                  zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t
+                  zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t
+                  zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t
+                  zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t
+                  zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t
+                  zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t
+                  zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t
+                  zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t
+                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
+                  !   
+                  zw3d(ji,jj,jk,1) = zno3phy * 86400._wp
+                  zw3d(ji,jj,jk,2) = znh4phy * 86400._wp
+                  zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp
+                   !
+                ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( lk_iomput ) THEN
+         DO jl = 1, 17 
+            CALL lbc_lnk( zw2d(:,:,jl),'T', 1. )
+         END DO
+         DO jl = 1, 3
+            CALL lbc_lnk( zw3d(:,:,:,jl),'T', 1. )
+         END DO
+      ENDIF
+      IF( lk_iomput ) THEN
+            ! Save diagnostics
+        CALL iom_put( "TNO3PHY", zw2d(:,:,1) )
+        CALL iom_put( "TNH4PHY", zw2d(:,:,2) )
+        CALL iom_put( "TPHYDOM", zw2d(:,:,3) )
+        CALL iom_put( "TPHYNH4", zw2d(:,:,4) )
+        CALL iom_put( "TPHYZOO", zw2d(:,:,5) )
+        CALL iom_put( "TPHYDET", zw2d(:,:,6) )
+        CALL iom_put( "TDETZOO", zw2d(:,:,7) )
+        CALL iom_put( "TZOODET", zw2d(:,:,8) )
+        CALL iom_put( "TZOOBOD", zw2d(:,:,9) )
+        CALL iom_put( "TZOONH4", zw2d(:,:,10) )
+        CALL iom_put( "TZOODOM", zw2d(:,:,11) )
+        CALL iom_put( "TNH4NO3", zw2d(:,:,12) )
+        CALL iom_put( "TDOMNH4", zw2d(:,:,13) )
+        CALL iom_put( "TDETNH4", zw2d(:,:,14) )
+        CALL iom_put( "TPHYTOT", zw2d(:,:,15) )
+        CALL iom_put( "TZOOTOT", zw2d(:,:,16) )
+         ! 
+        CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) )
+        CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) )
+        CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) )
+         !
+      ENDIF
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('bio')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( lk_iomput ) THEN
+         CALL wrk_dealloc( jpi, jpj,     17, zw2d )
+         CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p2z_bio')
+      !
+   END SUBROUTINE p2z_bio
+
+   SUBROUTINE p2z_bio_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p2z_bio_init  ***
+      !!
+      !! ** Purpose :  biological parameters 
+      !!
+      !! ** Method  :   Read namelist and check the parameters
+      !!
+      !!----------------------------------------------------------------------
+      NAMELIST/namlobphy/ tmumax, rgamma, fphylab, tmminp, aki
+      NAMELIST/namlobnut/ akno3, aknh4, taunn, psinut
+      NAMELIST/namlobzoo/ rppz, taus, aks, rpnaz, rdnaz, tauzn, fzoolab, fdbod, tmminz
+      NAMELIST/namlobdet/  taudn, fdetlab
+      NAMELIST/namlobdom/ taudomn
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp_ref )              ! Namelist namlobphy in reference namelist : Lobster biological parameters
+      READ  ( numnatp_ref, namlobphy, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobphy in configuration namelist : Lobster biological parameters
+      READ  ( numnatp_cfg, namlobphy, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobphy in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namlobphy )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobphy'
+          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,*) '    minimal phyto mortality rate                         tmminp    =', 86400 * tmminp
+          WRITE(numout,*) '    light hlaf saturation constant                       aki       =', aki
+          WRITE(numout,*) ' '
+      ENDIF
+
+      REWIND( numnatp_ref )              ! Namelist namlobnut in reference namelist : Lobster nutriments parameters
+      READ  ( numnatp_ref, namlobnut, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobnut in configuration namelist : Lobster nutriments parameters
+      READ  ( numnatp_cfg, namlobnut, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobnut in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namlobnut )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobnut'
+          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
+
+      REWIND( numnatp_ref )              ! Namelist namlobzoo in reference namelist : Lobster zooplankton parameters
+      READ  ( numnatp_ref, namlobzoo, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobzoo in configuration namelist : Lobster zooplankton parameters
+      READ  ( numnatp_cfg, namlobzoo, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobzoo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namlobzoo )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobzoo'
+          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,*) '    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
+
+      REWIND( numnatp_ref )              ! Namelist namlobdet in reference namelist : Lobster detritus parameters
+      READ  ( numnatp_ref, namlobdet, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobdet in configuration namelist : Lobster detritus parameters
+      READ  ( numnatp_cfg, namlobdet, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdet in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namlobdet )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobdet'
+          WRITE(numout,*) '    detrital breakdown rate                              taudn     =', 86400 * taudn , ' d'
+          WRITE(numout,*) '    NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab
+          WRITE(numout,*) ' '
+      ENDIF
+
+      REWIND( numnatp_ref )              ! Namelist namlobdom in reference namelist : Lobster DOM breakdown rate
+      READ  ( numnatp_ref, namlobdom, IOSTAT = ios, ERR = 909)
+909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobdom in configuration namelist : Lobster DOM breakdown rate
+      READ  ( numnatp_cfg, namlobdom, IOSTAT = ios, ERR = 910 )
+910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namlobdom )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobdom'
+          WRITE(numout,*) '    DOM breakdown rate                                 taudomn     =', 86400 * taudn , ' d'
+          WRITE(numout,*) ' '
+      ENDIF
+      !
+   END SUBROUTINE p2z_bio_init
+
+   !!======================================================================
+END MODULE p2zbio
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90	(revision 8732)
@@ -0,0 +1,264 @@
+MODULE p2zexp
+   !!======================================================================
+   !!                         ***  MODULE p2zsed  ***
+   !! TOP :   LOBSTER Compute loss of organic matter in the sediments
+   !!======================================================================
+   !! History :    -   !  1999    (O. Aumont, C. Le Quere)  original code
+   !!              -   !  2001-05 (O. Aumont, E. Kestenare) add sediment computations
+   !!             1.0  !  2005-06 (A.-S. Kremeur) new temporal integration for sedpoc
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!             3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER
+   !!----------------------------------------------------------------------
+   !!   p2z_exp        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_pisces
+   USE p2zsed
+   USE lbclnk
+   USE prtctl_trc      ! Print control for debbuging
+   USE trd_oce
+   USE trdtrc
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p2z_exp    
+   PUBLIC   p2z_exp_init 
+   PUBLIC   p2z_exp_alloc
+
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   cmask     !: Coastal mask area
+   REAL(wp)                                ::   areacot   !: surface coastal area
+
+   !! * Substitutions
+#  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 p2z_exp( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p2z_exp  ***
+      !!
+      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
+      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
+      !!
+      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
+      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
+      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 
+      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
+      !!              COLUMN BELOW THE SURFACE LAYER.
+      !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ikt
+      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zsedpoca
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p2z_exp')
+      !
+      IF( kt == nittrc000 )   CALL p2z_exp_init
+
+      CALL wrk_alloc( jpi, jpj, zsedpoca ) 
+      zsedpoca(:,:) = 0.
+
+
+      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
+      ! POC IN THE WATER COLUMN
+      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
+      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90
+      ! ----------------------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ze3t = 1. / e3t_n(ji,jj,jk)
+               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
+            END DO
+         END DO
+      END DO
+
+      ! Find the last level of the water column
+      ! Compute fluxes due to sinking particles (slow)
+   
+
+      zgeolpoc = 0.e0         !     Initialization
+      ! Release of nutrients from the "simple" sediment
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            ikt = mbkt(ji,jj) 
+            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 
+            ! Deposition of organic matter in the sediment
+            zwork = vsed * trn(ji,jj,ikt,jpdet)
+            zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
+               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt
+            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
+         END DO
+      END DO
+
+      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 / e3t_n(ji,jj,1)
+         END DO
+      END DO
+
+      CALL lbc_lnk( sedpocn, 'T', 1. )
+ 
+      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
+      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn )
+
+      
+      ! Time filter and swap of arrays
+      ! ------------------------------
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
+        !                                             ! (only swap)
+        sedpocn(:,:) = zsedpoca(:,:)
+        !                                              
+      ELSE
+        !
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              zsedpocd = zsedpoca(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) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
+           END DO
+        END DO
+        ! 
+      ENDIF
+      !
+      IF( lrst_trc ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'p2z_exp : POC in sediment fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
+         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zsedpoca)   ! temporary save of trends
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('exp')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p2z_exp')
+      !
+   END SUBROUTINE p2z_exp
+
+   SUBROUTINE p2z_exp_init
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE p4z_exp_init  ***
+      !! ** purpose :   specific initialisation for export
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zmaskt, zfluo, zfluu
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zrro
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdm0
+      !!---------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' p2z_exp: LOBSTER export'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '  compute remineralisation-damping arrays for tracers'
+      ENDIF
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zrro )
+      CALL wrk_alloc( jpi, jpj, jpk, zdm0 )
+
+
+      ! Calculate vertical distribution of newly formed biogenic poc
+      ! in the water column in the case of max. possible bottom depth
+      ! ------------------------------------------------------------
+      zdm0 = 0._wp
+      zrro = 1._wp
+      DO jk = jpkb, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr
+               zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr
+               IF( zfluo.GT.1. )   zfluo = 1._wp
+               zdm0(ji,jj,jk) = zfluo - zfluu
+               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
+               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      zdm0(:,:,jpk) = zrro(:,:)
+
+      ! Calculate vertical distribution of newly formed biogenic poc
+      ! in the water column with realistic topography (first "dry" layer
+      ! contains total fraction, which has passed to the upper layers)
+      ! ----------------------------------------------------------------------
+      dminl(:,:)   = 0._wp
+      dmin3(:,:,:) = zdm0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) == 0._wp ) THEN
+                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
+                  dmin3(ji,jj,jk) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
+         END DO
+      END DO
+
+      ! Coastal mask 
+      cmask(:,:) = 0._wp
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            IF( tmask(ji,jj,1) /= 0. ) THEN
+               zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
+               IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
+            END IF
+         END DO
+      END DO
+      CALL lbc_lnk( cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
+      areacot = glob_sum( e1e2t(:,:) * cmask(:,:) )
+      !
+      IF( ln_rsttr ) THEN
+         CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
+         CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
+      ELSE
+         sedpocb(:,:) = 0._wp
+         sedpocn(:,:) = 0._wp
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      zrro )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdm0 )
+      !
+   END SUBROUTINE p2z_exp_init
+
+   INTEGER FUNCTION p2z_exp_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p2z_exp_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), &
+         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj),   STAT=p2z_exp_alloc )
+      IF( p2z_exp_alloc /= 0 ) CALL ctl_warn('p2z_exp_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p2z_exp_alloc
+
+   !!======================================================================
+END MODULE  p2zexp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90	(revision 8732)
@@ -0,0 +1,205 @@
+MODULE p2zopt
+   !!======================================================================
+   !!                         ***  MODULE p2zopt  ***
+   !! TOP :   LOBSTER Compute the light availability in the water column
+   !!======================================================================
+   !! History :    -   !  1995-05  (M. Levy) Original code
+   !!              -   !  1999-09  (J.-M. Andre, M. Levy) 
+   !!              -   !  1999-11  (C. Menkes, M.-A. Foujols) itabe initial
+   !!              -   !  2000-02  (M.A. Foujols) change x**y par exp(y*log(x))
+   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90
+   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style
+   !!----------------------------------------------------------------------
+   !!   p2z_opt        :   Compute the light availability in the water column
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_pisces
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p2z_opt   !
+   PUBLIC   p2z_opt_init   !
+
+   REAL(wp), PUBLIC ::  xkr0      !: water coefficient absorption in red      
+   REAL(wp), PUBLIC ::  xkg0      !: water coefficient absorption in green    
+   REAL(wp), PUBLIC ::  xkrp      !: pigment coefficient absorption in red    
+   REAL(wp), PUBLIC ::  xkgp      !: pigment coefficient absorption in green  
+   REAL(wp), PUBLIC ::  xlr       !: exposant for pigment absorption in red  
+   REAL(wp), PUBLIC ::  xlg       !: exposant for pigment absorption in green 
+   REAL(wp), PUBLIC ::  rpig      !: chla/chla+phea ratio    
+   !                 
+   REAL(wp), PUBLIC ::  rcchl     ! Carbone/Chlorophyl ratio [mgC.mgChla-1]
+   REAL(wp), PUBLIC ::  redf      ! redfield ratio (C:N) for phyto
+   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p2z_opt( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p2z_opt  ***
+      !!
+      !! ** Purpose :   computes the light propagation in the water column
+      !!              and the euphotic layer depth
+      !!
+      !! ** Method  :   local par is computed in w layers using light propagation
+      !!              mean par in t layers are computed by integration
+      !!
+!!gm please remplace the '???' by true comments
+      !! ** Action  :   etot   ???
+      !!                neln   ???
+      !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      CHARACTER (len=25) ::   charout   ! temporary character
+      REAL(wp) ::   zpig                ! log of the total pigment
+      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green
+      REAL(wp) ::   zcoef               ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpar100, zpar0m
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zparr, zparg
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p2z_opt')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zpar100, zpar0m )
+      CALL wrk_alloc( jpi, jpj, jpk, zparr, zparg    )
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' p2z_opt : LOBSTER optic-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
+      ENDIF
+
+      !                                          ! surface irradiance
+      !                                          ! ------------------
+      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
+      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
+      ENDIF
+      zpar100(:,:)   = zpar0m(:,:) * 0.01
+      zparr  (:,:,1) = zpar0m(:,:) * 0.5
+      zparg  (:,:,1) = zpar0m(:,:) * 0.5
+
+      !                                          ! Photosynthetically Available Radiation (PAR)
+      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
+      DO jk = 2, jpk                                  ! local par at w-levels
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  )
+               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
+               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) )
+            END DO
+        END DO
+      END DO
+      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  )
+               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
+               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) )
+               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
+            END DO
+         END DO
+      END DO
+
+      !                                          ! Euphotic layer
+      !                                          ! --------------
+      neln(:,:) = 1                                   ! euphotic layer level
+      DO jk = 1, jpkm1                                  ! (i.e. 1rst T-level strictly below EL bottom)
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
+           END DO
+         END DO
+      END DO
+      !                                               ! Euphotic layer depth
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj))
+         END DO
+      END DO 
+
+
+      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('opt')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      zpar100, zpar0m )
+      CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg    )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p2z_opt')
+      !
+   END SUBROUTINE p2z_opt
+
+   SUBROUTINE p2z_opt_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p2z_opt_init  ***
+      !!
+      !! ** Purpose :  optical parameters 
+      !!
+      !! ** Method  :   Read the namlobopt namelist and check the parameters
+      !!
+      !!----------------------------------------------------------------------
+      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
+      NAMELIST/namlobrat/ rcchl, redf, reddom
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp_ref )              ! Namelist namlobopt in reference namelist : Lobster options
+      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobopt in configuration namelist : Lobster options
+      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, 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
+      !
+      REWIND( numnatp_ref )              ! Namelist namlobrat in reference namelist : Lobster ratios
+      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobrat in configuration namelist : Lobster ratios
+      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namlobrat )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobrat'
+         WRITE(numout,*) '     carbone/chlorophyl ratio                             rcchl = ', rcchl
+          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf
+          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom
+          WRITE(numout,*) ' '
+      ENDIF
+      !
+   END SUBROUTINE p2z_opt_init
+
+   !!======================================================================
+END MODULE  p2zopt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90	(revision 8732)
@@ -0,0 +1,158 @@
+MODULE p2zsed
+   !!======================================================================
+   !!                         ***  MODULE p2zsed  ***
+   !! TOP :   PISCES Compute loss of organic matter in the sediments
+   !!======================================================================
+   !! History :    -   !  1995-06 (M. Levy)  original code
+   !!              -   !  2000-12 (E. Kestenare)  clean up
+   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications
+   !!----------------------------------------------------------------------
+   !!   p2z_sed        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_pisces
+   USE lbclnk
+   USE trd_oce
+   USE trdtrc
+   USE iom
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p2z_sed         ! called in ???
+   PUBLIC   p2z_sed_init    ! called in ???
+
+   REAL(wp), PUBLIC ::   sedlam      !: time coefficient of POC remineralization in sediments
+   REAL(wp), PUBLIC ::   sedlostpoc  ! mass of POC lost in sediments 
+   REAL(wp), PUBLIC ::   vsed        ! detritus sedimentation speed [m/s] 
+   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p2z_sed( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p2z_sed  ***
+      !!
+      !! ** Purpose :   compute the now trend due to the vertical sedimentation of
+      !!              detritus and add it to the general trend of detritus equations
+      !!
+      !! ** Method  :   this ROUTINE compute not exactly the advection but the
+      !!              transport term, i.e.  dz(wt) and dz(ws)., dz(wtr)
+      !!              using an upstream scheme
+      !!              the now vertical advection of tracers is given by:
+      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
+      !!              add this trend now to the general trend of tracer (ta,sa,tra):
+      !!                             tra = tra + dz(trn wn)
+      !!        
+      !!              IF 'key_diabio' is defined, the now vertical advection
+      !!              trend of passive tracers is saved for futher diagnostics.
+      !!---------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ierr
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p2z_sed')
+      !
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' p2z_sed: LOBSTER sedimentation'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      ENDIF
+
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
+
+      ! sedimentation of detritus  : upstream scheme
+      ! --------------------------------------------
+
+      ! for detritus sedimentation only - jpdet
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
+
+      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
+      DO jk = 2, jpkm1
+         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
+      END DO
+
+      ! tracer flux divergence at t-point added to the general trend
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
+               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+
+      IF( lk_iomput )  THEN
+         IF( iom_use( "TDETSED" ) ) THEN
+            CALL wrk_alloc( jpi, jpj, zw2d )
+            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp
+            DO jk = 2, jpkm1
+               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp
+            END DO
+            CALL iom_put( "TDETSED", zw2d )
+            CALL wrk_dealloc( jpi, jpj, zw2d )
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
+      !
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sed')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p2z_sed')
+      !
+   END SUBROUTINE p2z_sed
+
+   SUBROUTINE p2z_sed_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p2z_sed_init  ***
+      !!
+      !! ** Purpose :   Parameters from aphotic layers to sediment
+      !!
+      !! ** Method  :   Read the namlobsed namelist and check the parameters
+      !!
+      !!----------------------------------------------------------------------
+      NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments
+      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments
+      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, 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,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
+          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
+          WRITE(numout,*) ' '
+      ENDIF
+      !
+   END SUBROUTINE p2z_sed_init
+
+   !!======================================================================
+END MODULE  p2zsed
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90	(revision 8732)
@@ -0,0 +1,70 @@
+MODULE p2zsms
+   !!======================================================================
+   !!                         ***  MODULE p2zsms  ***
+   !! TOP :   Time loop of LOBSTER model
+   !!======================================================================
+   !! History :   1.0  !            M. Levy
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !!   p2zsms        :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   USE oce_trc          !
+   USE trc
+   USE sms_pisces
+   USE p2zbio
+   USE p2zopt
+   USE p2zsed
+   USE p2zexp
+   USE trd_oce
+   USE trdtrc_oce
+   USE trdtrc
+   USE trdmxl_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p2z_sms    ! called in p2zsms.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p2z_sms( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p2z_sms  ***
+      !!
+      !! ** Purpose :  Managment of the call to Biological sources and sinks 
+      !!               routines of LOBSTER bio-model 
+      !!
+      !! ** Method  : - ???
+      !! --------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !
+      INTEGER :: jn
+      !! --------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p2z_sms')
+      !
+      CALL p2z_opt( kt )      ! optical model
+      CALL p2z_bio( kt )      ! biological model
+      CALL p2z_sed( kt )      ! sedimentation model
+      CALL p2z_exp( kt )      ! export
+
+      IF( l_trdtrc ) THEN
+         DO jn = jp_pcs0, jp_pcs1
+           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+         END DO
+      END IF
+
+      !
+      IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH    ( numonp )     ! flush output namelist PISCES
+      IF( nn_timing == 1 )  CALL timing_stop('p2z_sms')
+      !
+   END SUBROUTINE p2z_sms
+
+   !!======================================================================
+END MODULE p2zsms
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90	(revision 8732)
@@ -0,0 +1,185 @@
+MODULE p4zagg
+   !!======================================================================
+   !!                         ***  MODULE p4zagg  ***
+   !! TOP :  PISCES  aggregation of particles
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Change aggregation formula
+   !!             3.5  !  2012-07  (O. Aumont) Introduce potential time-splitting
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   p4z_agg       :  Compute aggregation of particles
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_agg         ! called in p4zbio.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zagg.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_agg ( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_agg  ***
+      !!
+      !! ** Purpose :   Compute aggregation of particles
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt, knt
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zagg, zagg1, zagg2, zagg3, zagg4
+      REAL(wp) ::   zaggpoc1, zaggpoc2, zaggpoc3, zaggpoc4
+      REAL(wp) ::   zaggpoc , zaggfe, zaggdoc, zaggdoc2, zaggdoc3
+      REAL(wp) ::   zaggpon , zaggdon, zaggdon2, zaggdon3
+      REAL(wp) ::   zaggpop, zaggdop, zaggdop2, zaggdop3
+      REAL(wp) ::   zaggtmp, zfact, zmax
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_agg')
+
+      !
+      !  Exchange between organic matter compartments due to coagulation/disaggregation
+      !  ---------------------------------------------------
+      IF( ln_p4z ) THEN
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zfact = xstep * xdiss(ji,jj,jk)
+                  !  Part I : Coagulation dependent on turbulence
+                  zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
+                  zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
+
+                  ! Part II : Differential settling
+
+                  !  Aggregation of small into large particles
+                  zagg3 =  47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
+                  zagg4 =  3.3  * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
+
+                  zagg   = zagg1 + zagg2 + zagg3 + zagg4
+                  zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
+
+                  ! Aggregation of DOC to POC : 
+                  ! 1st term is shear aggregation of DOC-DOC
+                  ! 2nd term is shear aggregation of DOC-POC
+                  ! 3rd term is differential settling of DOC-POC
+                  zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
+                  &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
+                  ! transfer of DOC to GOC : 
+                  ! 1st term is shear aggregation
+                  ! 2nd term is differential settling 
+                  zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
+                  ! tranfer of DOC to POC due to brownian motion
+                  zaggdoc3 =  114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc)
+
+                  !  Update the trends
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3
+                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2
+                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
+                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
+                  !
+                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3
+                  prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2
+                  !
+               END DO
+            END DO
+         END DO
+      ELSE    ! ln_p5z
+        !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zfact = xstep * xdiss(ji,jj,jk)
+                  !  Part I : Coagulation dependent on turbulence
+                  zaggtmp = 25.9  * zfact * trb(ji,jj,jk,jppoc)
+                  zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc)
+                  zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc)
+                  zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc)
+
+                  ! Part II : Differential settling
+   
+                  !  Aggregation of small into large particles
+                  zaggtmp =  47.1 * xstep * trb(ji,jj,jk,jpgoc)
+                  zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc)
+                  zaggtmp =  3.3  * xstep * trb(ji,jj,jk,jppoc)
+                  zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc)
+
+                  zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4
+                  zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)
+                  zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)
+                  zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc)  + rtrn )
+
+                  ! Aggregation of DOC to POC : 
+                  ! 1st term is shear aggregation of DOC-DOC
+                  ! 2nd term is shear aggregation of DOC-POC
+                  ! 3rd term is differential settling of DOC-POC
+                  zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
+                  &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) )
+                  zaggdoc  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
+                  zaggdon  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
+                  zaggdop  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
+
+                  ! transfer of DOC to GOC : 
+                  ! 1st term is shear aggregation
+                  ! 2nd term is differential settling 
+                  zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc)
+                  zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
+                  zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
+                  zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
+
+                  ! tranfer of DOC to POC due to brownian motion
+                  zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep
+                  zaggdoc3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
+                  zaggdon3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
+                  zaggdop3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
+
+                  !  Update the trends
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3
+                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3
+                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3
+                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2
+                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2
+                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2
+                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
+                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
+                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3
+                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3
+                  !
+                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3
+                  prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('agg')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_agg')
+      !
+   END SUBROUTINE p4z_agg
+
+   !!======================================================================
+END MODULE p4zagg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90	(revision 8732)
@@ -0,0 +1,119 @@
+MODULE p4zbio
+   !!======================================================================
+   !!                         ***  MODULE p4zbio  ***
+   !! TOP :   PISCES bio-model
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!----------------------------------------------------------------------
+   !!   p4z_bio        :   computes the interactions between the different
+   !!                      compartments of PISCES
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zsink         !  vertical flux of particulate matter due to sinking
+   USE p4zopt          !  optical model
+   USE p4zlim          !  Co-limitations of differents nutrients
+   USE p4zprod         !  Growth rate of the 2 phyto groups
+   USE p4zmort         !  Mortality terms for phytoplankton
+   USE p4zmicro        !  Sources and sinks of microzooplankton
+   USE p4zmeso         !  Sources and sinks of mesozooplankton
+   USE p5zlim          !  Co-limitations of differents nutrients
+   USE p5zprod         !  Growth rate of the 2 phyto groups
+   USE p5zmort         !  Mortality terms for phytoplankton
+   USE p5zmicro        !  Sources and sinks of microzooplankton
+   USE p5zmeso         !  Sources and sinks of mesozooplankton
+   USE p4zrem          !  Remineralisation of organic matter
+   USE p4zpoc          !  Remineralization of organic particles
+   USE p4zagg          !  Aggregation of particles
+   USE p4zfechem
+   USE p4zligand       !  Prognostic ligand model
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+  
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  p4z_bio    
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zbio.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_bio ( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_bio  ***
+      !!
+      !! ** Purpose :   Ecosystem model in the whole ocean: computes the
+      !!              different interactions between the different compartments
+      !!              of PISCES
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt, knt
+      INTEGER             :: ji, jj, jk, jn
+      CHARACTER (len=25) :: charout
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_bio')
+      !
+      !     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION
+      !     OF PHYTOPLANKTON AND DETRITUS
+
+      xdiss(:,:,:) = 1.
+!!gm the use of nmld should be better here?
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+!!gm  :  use nmln  and test on jk ...  less memory acces
+               IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01
+            END DO 
+         END DO
+      END DO
+
+      CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column
+      CALL p4z_sink    ( kt, knt )     ! vertical flux of particulate organic matter
+      CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging
+      !
+      IF( ln_p4z ) THEN
+         CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients
+         CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
+         !                             ! (for each element : C, Si, Fe, Chl )
+         CALL p4z_mort ( kt      )     ! phytoplankton mortality
+         !                             ! zooplankton sources/sinks routines 
+         CALL p4z_micro( kt, knt )           ! microzooplankton
+         CALL p4z_meso ( kt, knt )           ! mesozooplankton
+      ELSE
+         CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients
+         CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
+         !                             ! (for each element : C, Si, Fe, Chl )
+         CALL p5z_mort ( kt      )     ! phytoplankton mortality
+         !                             ! zooplankton sources/sinks routines 
+         CALL p5z_micro( kt, knt )           ! microzooplankton
+         CALL p5z_meso ( kt, knt )           ! mesozooplankton
+      ENDIF
+      !
+      CALL p4z_agg  ( kt, knt )     ! Aggregation of particles
+      CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe
+      CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles
+      IF( ln_ligand ) THEN
+        CALL p4z_ligand( kt, knt )
+      ENDIF
+      !                                                             !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('bio ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_bio')
+      !
+   END SUBROUTINE p4z_bio
+
+   !!======================================================================
+END MODULE p4zbio
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90	(revision 8732)
@@ -0,0 +1,837 @@
+MODULE p4zche
+   !!======================================================================
+   !!                         ***  MODULE p4zche  ***
+   !! TOP :   PISCES Sea water chemistry computed following OCMIP protocol
+   !!======================================================================
+   !! History :   OPA  !  1988     (E. Maier-Reimer)  Original code
+   !!              -   !  1998     (O. Aumont)  addition
+   !!              -   !  1999     (C. Le Quere)  modification
+   !!   NEMO      1.0  !  2004     (O. Aumont)  modification
+   !!              -   !  2006     (R. Gangsto)  modification
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants
+   !!             3.6  !  2016-03  (O. Aumont) Change chemistry to MOCSY standards
+   !!----------------------------------------------------------------------
+   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol
+   !!----------------------------------------------------------------------
+   USE oce_trc       !  shared variables between ocean and passive tracers
+   USE trc           !  passive tracers common variables
+   USE sms_pisces    !  PISCES Source Minus Sink variables
+   USE lib_mpp       !  MPP library
+   USE eosbn2, ONLY : neos
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_che          !
+   PUBLIC   p4z_che_alloc    !
+   PUBLIC   ahini_for_at     !
+   PUBLIC   solve_at_general !
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: sio3eq   ! chemistry of Si
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: fekeq    ! chemistry of Fe
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemc    ! Solubilities of O2 and CO2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemo2    ! Solubilities of O2 and CO2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: fesol    ! solubility of Fe
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   salinprac  ! Practical salinity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tempis   ! In situ temperature
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akf3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aks3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak1p3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak2p3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak3p3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksi3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fluorid    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sulfat     !: ???
+
+   !!* Variable for chemistry of the CO2 cycle
+
+   REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm
+
+   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )  
+
+   REAL(wp) ::   rgas   = 83.14472      ! universal gas constants
+   REAL(wp) ::   oxyco  = 1. / 22.4144  ! converts from liters of an ideal gas to moles
+   !                                    ! coeff. for seawater pressure correction : millero 95
+   !                                    ! AGRIF doesn't like the DATA instruction
+   REAL(wp) :: devk10  = -25.5
+   REAL(wp) :: devk11  = -15.82
+   REAL(wp) :: devk12  = -29.48
+   REAL(wp) :: devk13  = -20.02
+   REAL(wp) :: devk14  = -18.03
+   REAL(wp) :: devk15  = -9.78
+   REAL(wp) :: devk16  = -48.76
+   REAL(wp) :: devk17  = -14.51
+   REAL(wp) :: devk18  = -23.12
+   REAL(wp) :: devk19  = -26.57
+   REAL(wp) :: devk110  = -29.48
+   !
+   REAL(wp) :: devk20  = 0.1271
+   REAL(wp) :: devk21  = -0.0219
+   REAL(wp) :: devk22  = 0.1622
+   REAL(wp) :: devk23  = 0.1119
+   REAL(wp) :: devk24  = 0.0466
+   REAL(wp) :: devk25  = -0.0090
+   REAL(wp) :: devk26  = 0.5304
+   REAL(wp) :: devk27  = 0.1211
+   REAL(wp) :: devk28  = 0.1758
+   REAL(wp) :: devk29  = 0.2020
+   REAL(wp) :: devk210  = 0.1622
+   !
+   REAL(wp) :: devk30  = 0.
+   REAL(wp) :: devk31  = 0.
+   REAL(wp) :: devk32  = 2.608E-3
+   REAL(wp) :: devk33  = -1.409e-3
+   REAL(wp) :: devk34  = 0.316e-3
+   REAL(wp) :: devk35  = -0.942e-3
+   REAL(wp) :: devk36  = 0.
+   REAL(wp) :: devk37  = -0.321e-3
+   REAL(wp) :: devk38  = -2.647e-3
+   REAL(wp) :: devk39  = -3.042e-3
+   REAL(wp) :: devk310  = -2.6080e-3
+   !
+   REAL(wp) :: devk40  = -3.08E-3
+   REAL(wp) :: devk41  = 1.13E-3
+   REAL(wp) :: devk42  = -2.84E-3
+   REAL(wp) :: devk43  = -5.13E-3
+   REAL(wp) :: devk44  = -4.53e-3
+   REAL(wp) :: devk45  = -3.91e-3
+   REAL(wp) :: devk46  = -11.76e-3
+   REAL(wp) :: devk47  = -2.67e-3
+   REAL(wp) :: devk48  = -5.15e-3
+   REAL(wp) :: devk49  = -4.08e-3
+   REAL(wp) :: devk410  = -2.84e-3
+   !
+   REAL(wp) :: devk50  = 0.0877E-3
+   REAL(wp) :: devk51  = -0.1475E-3     
+   REAL(wp) :: devk52  = 0.
+   REAL(wp) :: devk53  = 0.0794E-3      
+   REAL(wp) :: devk54  = 0.09e-3
+   REAL(wp) :: devk55  = 0.054e-3
+   REAL(wp) :: devk56  = 0.3692E-3
+   REAL(wp) :: devk57  = 0.0427e-3
+   REAL(wp) :: devk58  = 0.09e-3
+   REAL(wp) :: devk59  = 0.0714e-3
+   REAL(wp) :: devk510  = 0.0
+   !
+   ! General parameters
+   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp
+   REAL(wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp
+
+   ! Maximum number of iterations for each method
+   INTEGER, PARAMETER :: jp_maxniter_atgen    = 20
+
+   ! Bookkeeping variables for each method
+   ! - SOLVE_AT_GENERAL
+   INTEGER :: niter_atgen    = jp_maxniter_atgen
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_che
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_che  ***
+      !!
+      !! ** Purpose :   Sea water chemistry computed following OCMIP protocol
+      !!
+      !! ** Method  : - ...
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2
+      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5
+      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2
+      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1, zc1, zplat
+      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1, za2
+      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw
+      REAL(wp) ::   zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi
+      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1
+      REAL(wp) ::   total2free, free2SWS, total2SWS, SWS2total
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_che')
+      !
+      ! Computation of chemical constants require practical salinity
+      ! Thus, when TEOS08 is used, absolute salinity is converted to 
+      ! practical salinity
+      ! -------------------------------------------------------------
+      IF (neos == -1) THEN
+         salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504
+      ELSE
+         salinprac(:,:,:) = tsn(:,:,:,jp_sal)
+      ENDIF
+
+      !
+      ! Computations of chemical constants require in situ temperature
+      ! Here a quite simple formulation is used to convert 
+      ! potential temperature to in situ temperature. The errors is less than 
+      ! 0.04°C relative to an exact computation
+      ! ---------------------------------------------------------------------
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zpres = gdept_n(ji,jj,jk) / 1000.
+               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )
+               za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 )
+               tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2
+            END DO
+         END DO
+      END DO
+      !
+      ! CHEMICAL CONSTANTS - SURFACE LAYER
+      ! ----------------------------------
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            !                             ! SET ABSOLUTE TEMPERATURE
+            ztkel = tempis(ji,jj,1) + 273.15
+            zt    = ztkel * 0.01
+            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
+            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980)
+            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS
+            zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    &
+            &       + 0.0047036e-4*ztkel**2)
+            chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm)
+            chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3
+            chemc(ji,jj,3) = 57.7 - 0.118*ztkel
+            !
+         END DO
+      END DO
+
+      ! OXYGEN SOLUBILITY - DEEP OCEAN
+      ! -------------------------------
+!CDIR NOVERRCHK
+      DO jk = 1, jpk
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+              ztkel = tempis(ji,jj,jk) + 273.15
+              zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35.
+              zsal2 = zsal * zsal
+              ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature
+              ztgg2 = ztgg  * ztgg
+              ztgg3 = ztgg2 * ztgg
+              ztgg4 = ztgg3 * ztgg
+              ztgg5 = ztgg4 * ztgg
+
+              zoxy  = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3    &
+              &       + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3   &
+              &       - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 )   &
+              &       - 3.11680e-7 * zsal2
+              chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm)
+            END DO
+          END DO
+        END DO
+
+
+
+      ! CHEMICAL CONSTANTS - DEEP OCEAN
+      ! -------------------------------
+!CDIR NOVERRCHK
+      DO jk = 1, jpk
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+
+               ! SET PRESSION ACCORDING TO SAUNDER (1980)
+               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) )
+               zc1 = 5.92E-3 + zplat**2 * 5.25E-3
+               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept_n(ji,jj,jk)))) / 4.42E-6
+               zpres = zpres / 10.0
+
+               ! SET ABSOLUTE TEMPERATURE
+               ztkel   = tempis(ji,jj,jk) + 273.15
+               zsal    = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35.
+               zsqrt  = SQRT( zsal )
+               zsal15  = zsqrt * zsal
+               zlogt  = LOG( ztkel )
+               ztr    = 1. / ztkel
+               zis    = 19.924 * zsal / ( 1000.- 1.005 * zsal )
+               zis2   = zis * zis
+               zisqrt = SQRT( zis )
+               ztc     = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20.
+
+               ! CHLORINITY (WOOSTER ET AL., 1969)
+               zcl     = zsal / 1.80655
+
+               ! TOTAL SULFATE CONCENTR. [MOLES/kg soln]
+               zst     = 0.14 * zcl /96.062
+
+               ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln]
+               zft     = 0.000067 * zcl /18.9984
+
+               ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990)
+               zcks    = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt         &
+               &         + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt &
+               &         + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis    &
+               &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         &
+               &         + LOG(1.0 - 0.001005 * zsal))
+
+               ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79)
+               zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   &
+               &         + LOG(1.0d0 - 0.001005d0*zsal)            &
+               &         + LOG(1.0d0 + zst/zcks))
+
+               ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE
+               zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        &
+               &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         &
+               &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   &
+               &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      & 
+               &      * zlogt + 0.053105*zsqrt*ztkel
+
+               ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 
+               ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale
+               zck1    = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt  &
+                  - 0.011555*zsal + 0.0001152*zsal*zsal)
+               zck2    = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt      &
+                  - 0.01781*zsal + 0.0001122*zsal*zsal)
+
+               ! PKW (H2O) (MILLERO, 1995) from composite data
+               zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    &
+                         - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal
+
+               ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995)
+              zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   &
+              &          + (-106.736*ztr + 0.69171) * zsqrt       &
+              &          + (-0.65643*ztr - 0.01844) * zsal
+
+              zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  &
+              &          + (-160.340*ztr + 1.3566)*zsqrt          &
+              &          + (0.37335*ztr - 0.05778)*zsal
+
+              zck3p    = -3070.75*ztr - 18.126                    &
+              &          + (17.27039*ztr + 2.81197) * zsqrt       &
+              &          + (-44.99486*ztr - 0.09984) * zsal 
+
+              ! CONSTANT FOR SILICATE, MILLERO (1995)
+              zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   &
+              &          + (-458.79*ztr + 3.5913) * zisqrt       &
+              &          + (188.74*ztr - 1.5998) * zis           &
+              &          + (-12.1652*ztr + 0.07871) * zis2       &
+              &          + LOG(1.0 - 0.001005*zsal)
+
+               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER
+               !       (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983)
+               zaksp0  = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel )   &
+                  &      + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt  &
+                  &      - 0.07711*zsal + 0.0041249*zsal15
+
+               ! CONVERT FROM DIFFERENT PH SCALES
+               total2free  = 1.0/(1.0 + zst/zcks)
+               free2SWS    = 1. + zst/zcks + zft/(zckf*total2free)
+               total2SWS   = total2free * free2SWS
+               SWS2total   = 1.0 / total2SWS
+
+               ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?)
+               zak1    = 10**(zck1) * total2SWS
+               zak2    = 10**(zck2) * total2SWS
+               zakb    = EXP( zckb ) * total2SWS
+               zakw    = EXP( zckw )
+               zaksp1  = 10**(zaksp0)
+               zak1p   = exp( zck1p )
+               zak2p   = exp( zck2p )
+               zak3p   = exp( zck3p )
+               zaksi   = exp( zcksi )
+               zckf    = zckf * total2SWS
+
+               ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970)
+               !        (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE
+               !        IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS
+               !        TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN
+               !        DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS
+               !        MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION
+               !        WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND
+               !        & GIESKES (1970), P. 1285-1286 (THE SMALL
+               !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE
+               !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285))
+               zcpexp  = zpres / (rgas*ztkel)
+               zcpexp2 = zpres * zcpexp
+
+               ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE
+               !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968)
+               !        (CF. BROECKER ET AL., 1982)
+
+               zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk40 + devk50 * ztc )
+               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk41 + devk51 * ztc )
+               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk42 + devk52 * ztc )
+               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk43 + devk53 * ztc )
+               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk44 + devk54 * ztc )
+               aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk45 + devk55 * ztc )
+               akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk47 + devk57 * ztc )
+               ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk48 + devk58 * ztc )
+               ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk19 + devk29 * ztc + devk39 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk49 + devk59 * ztc )
+               ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk410 + devk510 * ztc )
+               aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               ! CONVERT FROM DIFFERENT PH SCALES
+               total2free  = 1.0/(1.0 + zst/aks3(ji,jj,jk))
+               free2SWS    = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk)
+               total2SWS   = total2free * free2SWS
+               SWS2total   = 1.0 / total2SWS
+
+               ! Convert to total scale
+               ak13(ji,jj,jk)  = ak13(ji,jj,jk)  * SWS2total
+               ak23(ji,jj,jk)  = ak23(ji,jj,jk)  * SWS2total
+               akb3(ji,jj,jk)  = akb3(ji,jj,jk)  * SWS2total
+               akw3(ji,jj,jk)  = akw3(ji,jj,jk)  * SWS2total
+               ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total
+               ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total
+               ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total
+               aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total
+               akf3(ji,jj,jk)  = akf3(ji,jj,jk)  / total2free
+
+               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 
+               !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO
+               !        (P. 1285) AND BERNER (1976)
+               zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk46 + devk56 * ztc )
+               aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L]
+               borat(ji,jj,jk) = 0.0002414 * zcl / 10.811
+               sulfat(ji,jj,jk) = zst
+               fluorid(ji,jj,jk) = zft 
+
+               ! Iron and SIO3 saturation concentration from ...
+               sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6
+               fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel )
+
+               ! Liu and Millero (1999) only valid 5 - 50 degC
+               ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16
+               fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1)
+               fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 )
+               fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 )
+               fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 )
+               fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 )
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_che')
+      !
+   END SUBROUTINE p4z_che
+
+   SUBROUTINE ahini_for_at(p_hini)
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE ahini_for_at  ***
+      !!
+      !! Subroutine returns the root for the 2nd order approximation of the
+      !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic 
+      !! polynomial) around the local minimum, if it exists.
+      !! Returns * 1E-03_wp if p_alkcb <= 0
+      !!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot
+      !!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot
+      !!                    and the 2nd order approximation does not have 
+      !!                    a solution
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini
+      INTEGER  ::   ji, jj, jk
+      REAL(wp)  ::  zca1, zba1
+      REAL(wp)  ::  zd, zsqrtd, zhmin
+      REAL(wp)  ::  za2, za1, za0
+      REAL(wp)  ::  p_dictot, p_bortot, p_alkcb 
+
+      IF( nn_timing == 1 )  CALL timing_start('ahini_for_at')
+      !
+      DO jk = 1, jpk
+        DO jj = 1, jpj
+          DO ji = 1, jpi
+            p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)
+            p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn)
+            p_bortot = borat(ji,jj,jk)
+            IF (p_alkcb <= 0.) THEN
+                p_hini(ji,jj,jk) = 1.e-3
+            ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN
+                p_hini(ji,jj,jk) = 1.e-10_wp
+            ELSE
+                zca1 = p_dictot/( p_alkcb + rtrn )
+                zba1 = p_bortot/ (p_alkcb + rtrn )
+           ! Coefficients of the cubic polynomial
+                za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1)
+                za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    &
+                &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1))
+                za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1))
+                                        ! Taylor expansion around the minimum
+                zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation
+                                        ! for the minimum close to the root
+
+                IF(zd > 0.) THEN        ! If the discriminant is positive
+                  zsqrtd = SQRT(zd)
+                  IF(za2 < 0) THEN
+                    zhmin = (-za2 + zsqrtd)/3.
+                  ELSE
+                    zhmin = -za1/(za2 + zsqrtd)
+                  ENDIF
+                  p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd)
+                ELSE
+                  p_hini(ji,jj,jk) = 1.e-7
+                ENDIF
+             !
+             ENDIF
+          END DO
+        END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ahini_for_at')
+      !
+   END SUBROUTINE ahini_for_at
+
+   !===============================================================================
+   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup )
+
+   ! Subroutine returns the lower and upper bounds of "non-water-selfionization"
+   ! contributions to total alkalinity (the infimum and the supremum), i.e
+   ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+])
+
+   ! Argument variables
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup
+
+   p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  &
+   &              - fluorid(:,:,:)
+   p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    &
+   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 
+
+   END SUBROUTINE anw_infsup
+
+
+   SUBROUTINE solve_at_general( p_hini, zhi )
+
+   ! Universal pH solver that converges from any given initial value,
+   ! determines upper an lower bounds for the solution if required
+
+   ! Argument variables
+   !--------------------
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi
+
+   ! Local variables
+   !-----------------
+   INTEGER   ::  ji, jj, jk, jn
+   REAL(wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor
+   REAL(wp)  ::  zdelta, zh_delta
+   REAL(wp)  ::  zeqn, zdeqndh, zalka
+   REAL(wp)  ::  aphscale
+   REAL(wp)  ::  znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic
+   REAL(wp)  ::  znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor
+   REAL(wp)  ::  znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4
+   REAL(wp)  ::  znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil
+   REAL(wp)  ::  znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4
+   REAL(wp)  ::  znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu
+   REAL(wp)  ::  zalk_wat, zdalk_wat
+   REAL(wp)  ::  zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit
+   LOGICAL   ::  l_exitnow
+   REAL(wp), PARAMETER :: pz_exp_threshold = 1.0
+   REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin
+
+   IF( nn_timing == 1 )  CALL timing_start('solve_at_general')
+      !  Allocate temporary workspace
+   CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )
+   CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )
+
+   CALL anw_infsup( zalknw_inf, zalknw_sup )
+
+   rmask(:,:,:) = tmask(:,:,:)
+   zhi(:,:,:)   = 0.
+
+   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+   DO jk = 1, jpk
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF (rmask(ji,jj,jk) == 1.) THEN
+               p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)
+               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
+               zh_ini = p_hini(ji,jj,jk)
+
+               zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
+
+               IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN
+                 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) )
+               ELSE
+                 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2.
+               ENDIF
+
+               zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
+
+               IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN
+                 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2.
+               ELSE
+                 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) )
+               ENDIF
+
+               zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk))
+            ENDIF
+         END DO
+      END DO
+   END DO
+
+   zeqn_absmin(:,:,:) = HUGE(1._wp)
+
+   DO jn = 1, jp_maxniter_atgen 
+   DO jk = 1, jpk
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF (rmask(ji,jj,jk) == 1.) THEN
+               zfact = rhop(ji,jj,jk) / 1000. + rtrn
+               p_alktot = trb(ji,jj,jk,jptal) / zfact
+               zdic  = trb(ji,jj,jk,jpdic) / zfact
+               zbot  = borat(ji,jj,jk)
+               zpt = trb(ji,jj,jk,jppo4) / zfact * po4r
+               zsit = trb(ji,jj,jk,jpsil) / zfact
+               zst = sulfat (ji,jj,jk)
+               zft = fluorid(ji,jj,jk)
+               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
+               zh = zhi(ji,jj,jk)
+               zh_prev = zh
+
+               ! H2CO3 - HCO3 - CO3 : n=2, m=0
+               znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)
+               zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh)
+               zalk_dic   = zdic * (znumer_dic/zdenom_dic)
+               zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     &
+                             *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk))
+               zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2)
+
+
+               ! B(OH)3 - B(OH)4 : n=1, m=0
+               znumer_bor = akb3(ji,jj,jk)
+               zdenom_bor = akb3(ji,jj,jk) + zh
+               zalk_bor   = zbot * (znumer_bor/zdenom_bor)
+               zdnumer_bor = akb3(ji,jj,jk)
+               zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2)
+
+
+               ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1
+               znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
+               &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk))
+               zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     &
+               &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh))
+               zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1
+               zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
+               &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         &
+               &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         &
+               &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                &
+               &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) )
+               zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2)
+
+               ! H4SiO4 - H3SiO4 : n=1, m=0
+               znumer_sil = aksi3(ji,jj,jk)
+               zdenom_sil = aksi3(ji,jj,jk) + zh
+               zalk_sil   = zsit * (znumer_sil/zdenom_sil)
+               zdnumer_sil = aksi3(ji,jj,jk)
+               zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2)
+
+               ! HSO4 - SO4 : n=1, m=1
+               aphscale = 1.0 + zst/aks3(ji,jj,jk)
+               znumer_so4 = aks3(ji,jj,jk) * aphscale
+               zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh
+               zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.)
+               zdnumer_so4 = aks3(ji,jj,jk)
+               zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2)
+
+               ! HF - F : n=1, m=1
+               znumer_flu =  akf3(ji,jj,jk)
+               zdenom_flu =  akf3(ji,jj,jk) + zh
+               zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.)
+               zdnumer_flu = akf3(ji,jj,jk)
+               zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2)
+
+               ! H2O - OH
+               aphscale = 1.0 + zst/aks3(ji,jj,jk)
+               zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale
+               zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale
+
+               ! CALCULATE [ALK]([CO3--], [HCO3-])
+               zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   &
+               &      + zalk_so4 + zalk_flu                       &
+               &      + zalk_wat - p_alktot
+
+               zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   &
+               &       + zalk_so4 + zalk_flu + zalk_wat)
+
+               zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+               &         + zdalk_so4 + zdalk_flu + zdalk_wat
+
+               ! Adapt bracketing interval
+               IF(zeqn > 0._wp) THEN
+                 zh_min(ji,jj,jk) = zh_prev
+               ELSEIF(zeqn < 0._wp) THEN
+                 zh_max(ji,jj,jk) = zh_prev
+               ENDIF
+
+               IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN
+               ! if the function evaluation at the current point is
+               ! not decreasing faster than with a bisection step (at least linearly)
+               ! in absolute value take one bisection step on [ph_min, ph_max]
+               ! ph_new = (ph_min + ph_max)/2d0
+               !
+               ! In terms of [H]_new:
+               ! [H]_new = 10**(-ph_new)
+               !         = 10**(-(ph_min + ph_max)/2d0)
+               !         = SQRT(10**(-(ph_min + phmax)))
+               !         = SQRT(zh_max * zh_min)
+                  zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk))
+                  zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below
+               ELSE
+               ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH
+               !           = -zdeqndh * LOG(10) * [H]
+               ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10))
+               !
+               ! pH_new = pH_old + \deltapH
+               !
+               ! [H]_new = 10**(-pH_new)
+               !         = 10**(-pH_old - \Delta pH)
+               !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10)))
+               !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10)))
+               !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old))
+
+                  zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+
+                  IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+                     zh          = zh_prev*EXP(zh_lnfactor)
+                  ELSE
+                     zh_delta    = zh_lnfactor*zh_prev
+                     zh          = zh_prev + zh_delta
+                  ENDIF
+
+                  IF( zh < zh_min(ji,jj,jk) ) THEN
+                     ! if [H]_new < [H]_min
+                     ! i.e., if ph_new > ph_max then
+                     ! take one bisection step on [ph_prev, ph_max]
+                     ! ph_new = (ph_prev + ph_max)/2d0
+                     ! In terms of [H]_new:
+                     ! [H]_new = 10**(-ph_new)
+                     !         = 10**(-(ph_prev + ph_max)/2d0)
+                     !         = SQRT(10**(-(ph_prev + phmax)))
+                     !         = SQRT([H]_old*10**(-ph_max))
+                     !         = SQRT([H]_old * zh_min)
+                     zh                = SQRT(zh_prev * zh_min(ji,jj,jk))
+                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+                  ENDIF
+
+                  IF( zh > zh_max(ji,jj,jk) ) THEN
+                     ! if [H]_new > [H]_max
+                     ! i.e., if ph_new < ph_min, then
+                     ! take one bisection step on [ph_min, ph_prev]
+                     ! ph_new = (ph_prev + ph_min)/2d0
+                     ! In terms of [H]_new:
+                     ! [H]_new = 10**(-ph_new)
+                     !         = 10**(-(ph_prev + ph_min)/2d0)
+                     !         = SQRT(10**(-(ph_prev + ph_min)))
+                     !         = SQRT([H]_old*10**(-ph_min))
+                     !         = SQRT([H]_old * zhmax)
+                     zh                = SQRT(zh_prev * zh_max(ji,jj,jk))
+                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+                  ENDIF
+               ENDIF
+
+               zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk))
+
+               ! Stop iterations once |\delta{[H]}/[H]| < rdel
+               ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+               ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+               ! Alternatively:
+               ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+               !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+               !             < 1/LOG(10) * rdel
+
+               ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+               ! rdel <-- pp_rdel_ah_target
+               l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+               IF(l_exitnow) THEN 
+                  rmask(ji,jj,jk) = 0.
+               ENDIF
+
+               zhi(ji,jj,jk) =  zh
+
+               IF(jn >= jp_maxniter_atgen) THEN
+                  zhi(ji,jj,jk) = -1._wp
+               ENDIF
+
+            ENDIF
+         END DO
+      END DO
+   END DO
+   END DO
+   !
+   CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )
+   CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )
+
+
+   IF( nn_timing == 1 )  CALL timing_stop('solve_at_general')
+
+
+   END SUBROUTINE solve_at_general
+
+   INTEGER FUNCTION p4z_che_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_che_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr(3)        ! Local variables
+      !!----------------------------------------------------------------------
+
+      ierr(:) = 0
+
+      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) )
+
+      ALLOCATE( akb3(jpi,jpj,jpk)     , tempis(jpi, jpj, jpk),       &
+         &      akw3(jpi,jpj,jpk)     , borat (jpi,jpj,jpk)  ,       &
+         &      aks3(jpi,jpj,jpk)     , akf3(jpi,jpj,jpk)    ,       &
+         &      ak1p3(jpi,jpj,jpk)    , ak2p3(jpi,jpj,jpk)   ,       &
+         &      ak3p3(jpi,jpj,jpk)    , aksi3(jpi,jpj,jpk)   ,       &
+         &      fluorid(jpi,jpj,jpk)  , sulfat(jpi,jpj,jpk)  ,       &
+         &      salinprac(jpi,jpj,jpk),                 STAT=ierr(2) )
+
+      ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) )
+
+      !* Variable for chemistry of the CO2 cycle
+      p4z_che_alloc = MAXVAL( ierr )
+      !
+      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_che_alloc
+
+   !!======================================================================
+END MODULE  p4zche
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90	(revision 8732)
@@ -0,0 +1,437 @@
+MODULE p4zfechem
+   !!======================================================================
+   !!                         ***  MODULE p4zfechem  ***
+   !! TOP :   PISCES Compute iron chemistry and scavenging
+   !!======================================================================
+   !! History :   3.5  !  2012-07 (O. Aumont, A. Tagliabue, C. Ethe) Original code
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p4z_fechem       :  Compute remineralization/scavenging of iron
+   !!   p4z_fechem_init  :  Initialisation of parameters for remineralisation
+   !!   p4z_fechem_alloc :  Allocate remineralisation variables
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zche          !  chemical model
+   USE p4zsbc          !  Boundary conditions from sediments
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_fechem      ! called in p4zbio.F90
+   PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker
+   LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker
+   LOGICAL          ::  ln_fecolloid !: boolean for variable colloidal fraction
+   REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron 
+   REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust 
+   REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean 
+   REAL(wp), PUBLIC ::  kfep         !: rate constant for nanoparticle formation
+
+   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zrem.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_fechem( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_fechem  ***
+      !!
+      !! ** Purpose :   Compute remineralization/scavenging of iron
+      !!
+      !! ** Method  :   2 different chemistry models are available for iron
+      !!                (1) The simple chemistry model of Aumont and Bopp (2006)
+      !!                    based on one ligand and one inorganic form
+      !!                (2) The complex chemistry model of Tagliabue and 
+      !!                    Voelker (2009) based on 2 ligands, 2 inorganic forms
+      !!                    and one particulate form (ln_fechem)
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk, jic, jn
+      REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac
+      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll, fe3sol
+      REAL(wp) ::   zdenom1, zscave, zaggdfea, zaggdfeb, zcoag
+      REAL(wp) ::   ztrc, zdust
+      REAL(wp) ::   zdenom2
+      REAL(wp) ::   zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2
+      REAL(wp) ::   zrum, zcodel, zargu, zlight
+      REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand
+      REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2
+      REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2
+      REAL(wp) :: ztfe, zoxy, zhplus
+      REAL(wp) :: zaggliga, zaggligb
+      REAL(wp) :: dissol, zligco
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zstrn2
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_fechem')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )
+      zFe3 (:,:,:) = 0.
+      zFeL1(:,:,:) = 0.
+      zTL1 (:,:,:) = 0.
+      IF( ln_fechem ) THEN
+         CALL wrk_alloc( jpi, jpj,      zstrn, zstrn2 )
+         CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )
+         zFe2 (:,:,:) = 0.
+         zFeL2(:,:,:) = 0.
+         zTL2 (:,:,:) = 0.
+         zFeP (:,:,:) = 0.
+      ENDIF
+
+      ! Total ligand concentration : Ligands can be chosen to be constant or variable
+      ! Parameterization from Tagliabue and Voelker (2011)
+      ! -------------------------------------------------
+      IF( ln_ligvar ) THEN
+         ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9
+         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. )
+      ELSE
+        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9
+        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9
+        ENDIF
+      ENDIF
+
+      IF( ln_fechem ) THEN
+         ! compute the day length depending on latitude and the day
+         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
+         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
+
+         ! day length in hours
+         zstrn(:,:) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
+               zargu = MAX( -1., MIN(  1., zargu ) )
+               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+            END DO
+         END DO
+
+         ! Maximum light intensity
+         zstrn2(:,:) = zstrn(:,:) / 24.
+         WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
+         zstrn(:,:) = 24. / zstrn(:,:)
+
+         ! ------------------------------------------------------------
+         ! NEW FE CHEMISTRY ROUTINE from Tagliabue and Volker (2009)
+         ! This model is based on two ligands, Fe2+, Fe3+ and Fep
+         ! Chemistry is supposed to be fast enough to be at equilibrium
+         ! ------------------------------------------------------------
+         DO jn = 1, 2
+          DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlight = etot(ji,jj,jk) * zstrn(ji,jj) * REAL( 2-jn, wp )
+                  zzstrn2 = zstrn2(ji,jj) * REAL( 2-jn, wp ) + (1. - zstrn2(ji,jj) ) * REAL( jn-1, wp )
+                  ! Calculate ligand concentrations : assume 2/3rd of excess goes to
+                  ! strong ligands (L1) and 1/3rd to weak ligands (L2)
+                  ztligand       = ztotlig(ji,jj,jk) - ligand * 1E9
+                  zTL1(ji,jj,jk) =                0.000001 + 0.67 * ztligand
+                  zTL2(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand
+                  ! ionic strength from Millero et al. 1987
+                  zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) )
+                  zoxy   = trb(ji,jj,jk,jpoxy)
+                  ! Fe2+ oxydation rate from Santana-Casiano et al. (2005)
+                  zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tempis(ji,jj,jk) + 273.15 )  &
+                    &    - 0.04406 * SQRT( salinprac(ji,jj,jk) ) - 0.002847 * salinprac(ji,jj,jk)
+                  zkox   = ( 10.** zkox ) * spd
+                  zkox   = zkox * MAX( 1.e-6, zoxy) / ( chemo2(ji,jj,jk) + rtrn )
+                  ! PHOTOREDUCTION of complexed iron : Tagliabue and Arrigo (2006)
+                  zkph2 = MAX( 0., 15. * zlight / ( zlight + 2. ) ) * (1. - fr_i(ji,jj))
+                  zkph1 = zkph2 / 5.
+                  ! pass the dfe concentration from PISCES
+                  ztfe = trb(ji,jj,jk,jpfer) * 1e9
+                  ! ----------------------------------------------------------
+                  ! ANALYTICAL SOLUTION OF ROOTS OF THE FE3+ EQUATION
+                  ! As shown in Tagliabue and Voelker (2009), Fe3+ is the root of a 3rd order polynom. 
+                  ! ----------------------------------------------------------
+                  ! calculate some parameters
+                  za = 1 + ks / kpr
+                  zb = 1 + ( zkph1 + kth ) / ( zkox + rtrn )
+                  zc = 1 + zkph2 / ( zkox + rtrn )
+                  zkappa1 = ( kb1 + zkph1 + kth ) / kl1
+                  zkappa2 = ( kb2 + zkph2 ) / kl2
+                  za2 = zTL1(ji,jj,jk) * zb / za + zTL2(ji,jj,jk) * zc / za + zkappa1 + zkappa2 - ztfe / za
+                  za1 = zkappa2 * zTL1(ji,jj,jk) * zb / za + zkappa1 * zTL2(ji,jj,jk) * zc / za &
+                      & + zkappa1 * zkappa2 - ( zkappa1 + zkappa2 ) * ztfe / za
+                  za0 = -zkappa1 * zkappa2 * ztfe / za
+                  zp  = za1 - za2 * za2 / 3.
+                  zq  = za2 * za2 * za2 * 2. / 27. - za2 * za1 / 3. + za0
+                  zp3 = zp / 3.
+                  zq2 = zq / 2.
+                  zd  = zp3 * zp3 * zp3 + zq2 * zq2
+                  zr  = zq / ABS( zq ) * SQRT( ABS( zp ) / 3. )
+                  ! compute the roots
+                  IF( zp > 0.) THEN
+                     ! zphi = ASINH( zq / ( 2. * zr * zr * zr ) )
+                     zphi =  zq / ( 2. * zr * zr * zr ) 
+                     zphi = LOG( zphi + SQRT( zphi * zphi + 1 ) )  ! asinh(x) = log(x + sqrt(x^2+1))
+                     zxs  = -2. * zr * SINH( zphi / 3. ) - za1 / 3.
+                  ELSE
+                     IF( zd > 0. ) THEN
+                        zfff = MAX( 1., zq / ( 2. * zr * zr * zr ) )
+                        ! zphi = ACOSH( zfff )
+                        zphi = LOG( zfff + SQRT( zfff * zfff - 1 ) )  ! acosh(x) = log(x + sqrt(x^2-1))
+                        zxs = -2. * zr * COSH( zphi / 3. ) - za1 / 3.
+                     ELSE
+                        zfff = MIN( 1., zq / ( 2. * zr * zr * zr ) )
+                        zphi = ACOS( zfff )
+                        DO jic = 1, 3
+                           zfunc = -2 * zr * COS( zphi / 3. + 2. * REAL( jic - 1, wp ) * rpi / 3. ) - za2 / 3.
+                           IF( zfunc > 0. .AND. zfunc <= ztfe)  zxs = zfunc
+                        END DO
+                     ENDIF
+                  ENDIF
+                  ! solve for the other Fe species
+                  zzFe3 = MAX( 0., zxs )
+                  zzFep = MAX( 0., ( ks * zzFe3 / kpr ) )
+                  zkappa2 = ( kb2 + zkph2 ) / kl2
+                  zzFeL2 = MAX( 0., ( zzFe3 * zTL2(ji,jj,jk) ) / ( zkappa2 + zzFe3 ) )
+                  zzFeL1 = MAX( 0., ( ztfe / zb - za / zb * zzFe3 - zc / zb * zzFeL2 ) )
+                  zzFe2  = MAX( 0., ( ( zkph1 * zzFeL1 + zkph2 * zzFeL2 ) / zkox ) )
+                  zFe3(ji,jj,jk)  = zFe3(ji,jj,jk)  + zzFe3 * zzstrn2
+                  zFe2(ji,jj,jk)  = zFe2(ji,jj,jk)  + zzFe2 * zzstrn2
+                  zFeL2(ji,jj,jk) = zFeL2(ji,jj,jk) + zzFeL2 * zzstrn2
+                  zFeL1(ji,jj,jk) = zFeL1(ji,jj,jk) + zzFeL1 * zzstrn2
+                  zFeP(ji,jj,jk)  = zFeP(ji,jj,jk)  + zzFeP * zzstrn2
+               END DO
+            END DO
+         END DO
+         END DO
+      ELSE
+         ! ------------------------------------------------------------
+         ! OLD FE CHEMISTRY ROUTINE from Aumont and Bopp (2006)
+         ! This model is based on one ligand and Fe' 
+         ! Chemistry is supposed to be fast enough to be at equilibrium
+         ! ------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zTL1(ji,jj,jk) = ztotlig(ji,jj,jk)
+                  zkeq           = fekeq(ji,jj,jk)
+                  zfesatur       = zTL1(ji,jj,jk) * 1E-9
+                  ztfe           = trb(ji,jj,jk,jpfer) 
+                  ! Fe' is the root of a 2nd order polynom
+                  zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               &
+                     &             + SQRT( ( 1. + zfesatur * zkeq - zkeq * ztfe )**2       &
+                     &               + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
+                  zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
+                  zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
+              END DO
+            END DO
+         END DO
+         !
+      ENDIF
+
+      zdust = 0.         ! if no dust available
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 
+               ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
+               ! Scavenging onto dust is also included as evidenced from the DUNE experiments.
+               ! --------------------------------------------------------------------------------------
+               IF( ln_fechem ) THEN
+                  zfeequi = ( zFe3(ji,jj,jk) + zFe2(ji,jj,jk) + zFeP(ji,jj,jk) ) * 1E-9
+                  zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9
+               ELSE
+                  zfeequi = zFe3(ji,jj,jk) * 1E-9
+                  IF (ln_fecolloid) THEN
+                     zhplus   = max( rtrn, hi(ji,jj,jk) )
+                     fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
+                     &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
+                     &         + fesol(ji,jj,jk,5) / zhplus )
+                     zfecoll = max( ( 0.1 * zFeL1(ji,jj,jk) * 1E-9 ), ( zFeL1(ji,jj,jk) * 1E-9 -fe3sol ) )
+                  ELSE
+                     zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
+                     fe3sol  = 0.
+                  ENDIF
+               ENDIF
+               !
+               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
+               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s
+               zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc
+               zscave = zfeequi * zlam1b * xstep
+
+               ! Compute the different ratios for scavenging of iron
+               ! to later allocate scavenged iron to the different organic pools
+               ! ---------------------------------------------------------
+               zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b
+               zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b
+
+               !  Increased scavenging for very high iron concentrations found near the coasts 
+               !  due to increased lithogenic particles and let say it is unknown processes (precipitation, ...)
+               !  -----------------------------------------------------------
+               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
+               zlamfac = MIN( 1.  , zlamfac )
+               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) )
+               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
+               zcoag   = zfeequi * zlam1b * xstep + 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer)
+
+               !  Compute the coagulation of colloidal iron. This parameterization 
+               !  could be thought as an equivalent of colloidal pumping.
+               !  It requires certainly some more work as it is very poorly constrained.
+               !  ----------------------------------------------------------------
+               zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
+               zaggdfea = zlam1a * xstep * zfecoll
+               !
+               zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+               zaggdfeb = zlam1b * xstep * zfecoll
+               !
+               ! precipitation of Fe3+, creation of nanoparticles
+               precip(ji,jj,jk) = MAX( 0., ( zfeequi - fe3sol ) ) * kfep * xstep
+               !
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb &
+               &                     - zcoag - precip(ji,jj,jk)
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb
+               !
+            END DO
+         END DO
+      END DO
+      !
+      !  Define the bioavailable fraction of iron
+      !  ----------------------------------------
+      IF( ln_fechem ) THEN  ;  biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
+      ELSE                  ;  biron(:,:,:) = trb(:,:,:,jpfer) 
+      ENDIF
+      !
+      IF( ln_ligand ) THEN
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+                      &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
+                  !
+                  zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+                  zligco   = MAX( ( 0.1 * trb(ji,jj,jk,jplgw) ), ( trb(ji,jj,jk,jplgw) - fe3sol ) )
+                  zaggliga = zlam1a * xstep * zligco
+                  zaggligb = zlam1b * xstep * zligco
+                  tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + precip(ji,jj,jk)
+                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb
+               END DO
+            END DO
+         END DO
+         !
+         IF( .NOT.ln_fechem) THEN
+            plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) )
+            plig(:,:,:) =  MAX( 0. , plig(:,:,:) )
+         ENDIF
+         !
+      ENDIF
+      !  Output of some diagnostics variables
+      !     ---------------------------------
+      IF( lk_iomput ) THEN
+         IF( knt == nrdttrc ) THEN
+         IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+
+         IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1
+         IF( iom_use("TL1")    )  CALL iom_put("TL1"    , zTL1   (:,:,:)       * tmask(:,:,:) )   ! TL1
+         IF( iom_use("Totlig") )  CALL iom_put("Totlig" , ztotlig(:,:,:)       * tmask(:,:,:) )   ! TL
+         IF( iom_use("Biron")  )  CALL iom_put("Biron"  , biron  (:,:,:) * 1e9 * tmask(:,:,:) )   ! biron
+         IF( ln_fechem ) THEN
+            IF( iom_use("Fe2")  ) CALL iom_put("Fe2"    , zFe2   (:,:,:)       * tmask(:,:,:) )   ! Fe2+
+            IF( iom_use("FeL2") ) CALL iom_put("FeL2"   , zFeL2  (:,:,:)       * tmask(:,:,:) )   ! FeL2
+            IF( iom_use("FeP")  ) CALL iom_put("FeP"    , zFeP   (:,:,:)       * tmask(:,:,:) )   ! FeP
+            IF( iom_use("TL2")  ) CALL iom_put("TL2"    , zTL2   (:,:,:)       * tmask(:,:,:) )   ! TL2
+         ENDIF
+         ENDIF
+      ENDIF
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('fechem')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )
+      IF( ln_fechem )  THEN
+         CALL wrk_dealloc( jpi, jpj,      zstrn, zstrn2 )
+         CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_fechem')
+      !
+   END SUBROUTINE p4z_fechem
+
+
+   SUBROUTINE p4z_fechem_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_fechem_init  ***
+      !!
+      !! ** Purpose :   Initialization of iron chemistry parameters
+      !!
+      !! ** Method  :   Read the nampisfer namelist and check the parameters
+      !!      called at the first timestep
+      !!
+      !! ** input   :   Namelist nampisfer
+      !!
+      !!----------------------------------------------------------------------
+      NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep 
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampisfer in reference namelist : Pisces iron chemistry
+      READ  ( numnatp_ref, nampisfer, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisfer in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisfer in configuration namelist : Pisces iron chemistry
+      READ  ( numnatp_cfg, nampisfer, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisfer in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampisfer )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem    =', ln_fechem
+         WRITE(numout,*) '    variable concentration of ligand          ln_ligvar    =', ln_ligvar
+         WRITE(numout,*) '    Variable colloidal fraction of Fe3+       ln_fecolloid =', ln_fecolloid
+         WRITE(numout,*) '    scavenging rate of Iron                   xlam1        =', xlam1
+         WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust     =', xlamdust
+         WRITE(numout,*) '    ligand concentration in the ocean         ligand       =', ligand
+         WRITE(numout,*) '    rate constant for nanoparticle formation  kfep         =', kfep
+      ENDIF
+      !
+      IF( ln_fechem ) THEN
+         ! initialization of some constants used by the complexe chemistry scheme
+         ! ----------------------------------------------------------------------
+         spd = 3600. * 24.
+         con = 1.E9
+         ! LIGAND KINETICS (values from Witter et al. 2000)
+         ! Weak (L2) ligands
+         ! Phaeophytin
+         kl2 = 12.2E5  * spd / con
+         kb2 = 12.3E-6 * spd
+         ! Strong (L1) ligands
+         ! Saccharides
+         ! kl1 = 12.2E5  * spd / con
+         ! kb1 = 12.3E-6 * spd
+         ! DFOB-
+         kl1 = 19.6e5  * spd / con
+         kb1 = 1.5e-6  * spd
+         ! pcp and remin of Fe3p
+         ks  = 0.075
+         kpr = 0.05
+         ! thermal reduction of Fe3
+         kth = 0.0048 * 24.
+         !
+      ENDIF
+      !
+   END SUBROUTINE p4z_fechem_init
+   !!======================================================================
+END MODULE p4zfechem
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90	(revision 8732)
@@ -0,0 +1,393 @@
+MODULE p4zflx
+   !!======================================================================
+   !!                         ***  MODULE p4zflx  ***
+   !! TOP :   PISCES CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
+   !!======================================================================
+   !! History :    -   !  1988-07  (E. MAIER-REIMER) Original code
+   !!              -   !  1998     (O. Aumont) additions
+   !!              -   !  1999     (C. Le Quere) modifications
+   !!             1.0  !  2004     (O. Aumont) modifications
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction 
+   !!----------------------------------------------------------------------
+   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
+   !!   p4z_flx_init  :   Read the namelist
+   !!   p4z_patm      :   Read sfc atm pressure [atm] for each grid cell
+   !!----------------------------------------------------------------------
+   USE oce_trc                      !  shared variables between ocean and passive tracers 
+   USE trc                          !  passive tracers common variables
+   USE sms_pisces                   !  PISCES Source Minus Sink variables
+   USE p4zche                       !  Chemical model
+   USE prtctl_trc                   !  print control for debugging
+   USE iom                          !  I/O manager
+   USE fldread                      !  read input fields
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_flx  
+   PUBLIC   p4z_flx_init  
+   PUBLIC   p4z_flx_alloc  
+
+   !                               !!** Namelist  nampisext  **
+   REAL(wp)          ::  atcco2     !: pre-industrial atmospheric [co2] (ppm) 	
+   LOGICAL           ::  ln_co2int  !: flag to read in a file and interpolate atmospheric pco2 or not
+   CHARACTER(len=34) ::  clname     !: filename of pco2 values
+   INTEGER           ::  nn_offset  !: Offset model-data start year (default = 0) 
+
+   !!  Variables related to reading atmospheric CO2 time history    
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years
+   INTEGER  :: nmaxrec, numco2
+
+   !                               !!* nampisatm namelist (Atmospheric PRessure) *
+   LOGICAL, PUBLIC ::   ln_presatm     !: ref. pressure: global mean Patm (F) or a constant (F)
+   LOGICAL, PUBLIC ::   ln_presatmco2  !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F)
+
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::  patm      ! atmospheric pressure at kt                 [N/m2]
+   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_patm   ! structure of input fields (file informations, fields read)
+   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_atmco2 ! structure of input fields (file informations, fields read)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2 
+
+   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_flx ( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_flx  ***
+      !!
+      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
+      !!
+      !! ** Method  : 
+      !!              - Include total atm P correction via Esbensen & Kushnir (1981) 
+      !!              - Remove Wanninkhof chemical enhancement;
+      !!              - Add option for time-interpolation of atcco2.txt  
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt   !
+      !
+      INTEGER  ::   ji, jj, jm, iind, iindm1
+      REAL(wp) ::   ztc, ztc2, ztc3, ztc4, zws, zkgwan
+      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact
+      REAL(wp) ::   zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff
+      REAL(wp) ::   zph, zdic, zsch_o2, zsch_co2
+      REAL(wp) ::   zyr_dec, zdco2dt
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d, zpco2atm  
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_flx')
+      !
+      CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm )
+      !
+
+      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN
+      !     SURFACE LAYER); THE RESULT OF THIS CALCULATION
+      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
+
+      IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
+
+      IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN 
+         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values.
+         ! Caveats: First column of .txt must be in years, decimal  years preferably. 
+         ! For nn_offset, if your model year is iyy, nn_offset=(years(1)-iyy) 
+         ! then the first atmospheric CO2 record read is at years(1)
+         zyr_dec = REAL( nyear + nn_offset, wp ) + REAL( nday_year, wp ) / REAL( nyear_len(1), wp )
+         jm = 1
+         DO WHILE( jm <= nmaxrec .AND. years(jm) < zyr_dec ) ;  jm = jm + 1 ;  END DO
+         iind = jm  ;   iindm1 = jm - 1
+         zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn )
+         atcco2  = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1)
+         satmco2(:,:) = atcco2 
+      ENDIF
+
+      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
+            zfact = rhop(ji,jj,1) / 1000. + rtrn
+            zdic  = trb(ji,jj,1,jpdic)
+            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
+            ! CALCULATE [H2CO3]
+            zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2)
+         END DO
+      END DO
+
+      ! --------------
+      ! COMPUTE FLUXES
+      ! --------------
+
+      ! FIRST COMPUTE GAS EXCHANGE COEFFICIENTS
+      ! -------------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) )
+            ztc2 = ztc * ztc
+            ztc3 = ztc * ztc2 
+            ztc4 = ztc2 * ztc2 
+            ! Compute the schmidt Number both O2 and CO2
+            zsch_co2 = 2116.8 - 136.25 * ztc + 4.7353 * ztc2 - 0.092307 * ztc3 + 0.0007555 * ztc4
+            zsch_o2  = 1920.4 - 135.6  * ztc + 5.2122 * ztc2 - 0.109390 * ztc3 + 0.0009377 * ztc4
+            !  wind speed 
+            zws  = wndm(ji,jj) * wndm(ji,jj)
+            ! Compute the piston velocity for O2 and CO2
+            zkgwan = 0.251 * zws
+            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)
+            ! compute gas exchange for CO2 and O2
+            zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 )
+            zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 )
+         END DO
+      END DO
+
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztkel = tempis(ji,jj,1) + 273.15
+            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
+            zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal)
+            zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw )
+            zxc2      = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2
+            zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) )   &
+            &           / ( 82.05736 * ztkel ))
+            zfco2 = zpco2atm(ji,jj) * zfugcoeff
+
+            ! Compute CO2 flux for the sea and air
+            zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj)  ! (mol/L) * (m/s)
+            zflu = zh2co3(ji,jj) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
+            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
+            ! compute the trend
+            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) * tmask(ji,jj,1)
+
+            ! Compute O2 flux 
+            zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
+            zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj)
+            zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1)
+            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1)
+         END DO
+      END DO
+
+      t_oce_co2_flx     = glob_sum( oce_co2(:,:) )                    !  Total Flux of Carbon
+      t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx       !  Cumulative Total Flux of Carbon
+!      t_atm_co2_flx     = glob_sum( satmco2(:,:) * e1e2t(:,:) )       ! Total atmospheric pCO2
+      t_atm_co2_flx     =  atcco2      ! Total atmospheric pCO2
+ 
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('flx ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+         CALL wrk_alloc( jpi, jpj, zw2d )  
+         IF( iom_use( "Cflx"  ) )  THEN
+            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r
+            CALL iom_put( "Cflx"     , zw2d ) 
+         ENDIF
+         IF( iom_use( "Oflx"  ) )  THEN
+            zw2d(:,:) =  zoflx(:,:) * 1000 * tmask(:,:,1)
+            CALL iom_put( "Oflx" , zw2d )
+         ENDIF
+         IF( iom_use( "Kg"    ) )  THEN
+            zw2d(:,:) =  zkgco2(:,:) * tmask(:,:,1)
+            CALL iom_put( "Kg"   , zw2d )
+         ENDIF
+         IF( iom_use( "Dpco2" ) ) THEN
+           zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)
+           CALL iom_put( "Dpco2" ,  zw2d )
+         ENDIF
+         IF( iom_use( "Dpo2" ) )  THEN
+           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)
+           CALL iom_put( "Dpo2"  , zw2d )
+         ENDIF
+         IF( iom_use( "tcflx" ) )  CALL iom_put( "tcflx"    , t_oce_co2_flx * rfact2r )   ! molC/s
+         CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum )      ! molC
+         !
+         CALL wrk_dealloc( jpi, jpj, zw2d )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_flx')
+      !
+   END SUBROUTINE p4z_flx
+
+
+   SUBROUTINE p4z_flx_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_flx_init  ***
+      !!
+      !! ** Purpose :   Initialization of atmospheric conditions
+      !!
+      !! ** Method  :   Read the nampisext namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !! ** input   :   Namelist nampisext
+      !!----------------------------------------------------------------------
+      NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset
+      INTEGER :: jm
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+      !
+
+      REWIND( numnatp_ref )              ! Namelist nampisext in reference namelist : Pisces atm. conditions
+      READ  ( numnatp_ref, nampisext, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisext in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisext in configuration namelist : Pisces atm. conditions
+      READ  ( numnatp_cfg, nampisext, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisext in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampisext )
+      !
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int
+         WRITE(numout,*) ' '
+      ENDIF
+     IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN
+         IF(lwp) THEN                         ! control print
+            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2
+            WRITE(numout,*) ' '
+         ENDIF
+         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2
+      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN
+         IF(lwp)  THEN
+            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname )
+            WRITE(numout,*) '    Offset model-data start year      nn_offset   =', nn_offset
+            WRITE(numout,*) ' '
+         ENDIF
+         CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp )
+         jm = 0                      ! Count the number of record in co2 file
+         DO
+           READ(numco2,*,END=100) 
+           jm = jm + 1
+         END DO
+ 100     nmaxrec = jm - 1 
+         ALLOCATE( years  (nmaxrec) )     ;      years  (:) = 0._wp
+         ALLOCATE( atcco2h(nmaxrec) )     ;      atcco2h(:) = 0._wp
+
+         REWIND(numco2)
+         DO jm = 1, nmaxrec          ! get  xCO2 data
+            READ(numco2, *)  years(jm), atcco2h(jm)
+            IF(lwp) WRITE(numout, '(f6.0,f7.2)')  years(jm), atcco2h(jm)
+         END DO
+         CLOSE(numco2)
+      ELSEIF( .NOT.ln_co2int .AND. ln_presatmco2 ) THEN
+         IF(lwp)  THEN
+            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file'
+            WRITE(numout,*) ' '
+         ENDIF
+      ELSE
+         IF(lwp)  THEN
+            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file'
+            WRITE(numout,*) ' '
+         ENDIF
+      ENDIF
+
+      !
+      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon
+      t_oce_co2_flx = 0._wp
+      t_atm_co2_flx = 0._wp
+      !
+      CALL p4z_patm( nit000 )
+      !
+   END SUBROUTINE p4z_flx_init
+
+   SUBROUTINE p4z_patm( kt )
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_atm  ***
+      !!
+      !! ** Purpose :   Read and interpolate the external atmospheric sea-levl pressure
+      !! ** Method  :   Read the files and interpolate the appropriate variables
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      !
+      INTEGER            ::  ierr
+      INTEGER            ::  ios      ! Local integer output status for namelist read
+      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
+      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read
+      TYPE(FLD_N)        ::  sn_atmco2 ! informations about the fields to be read
+      !!
+      NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir
+
+      !                                         ! ----------------------- !
+      IF( kt == nit000 ) THEN                   ! First call kt=nittrc000 !
+
+         REWIND( numnatp_ref )              ! Namelist nampisatm in reference namelist : Pisces atm. sea level pressure file
+         READ  ( numnatp_ref, nampisatm, IOSTAT = ios, ERR = 901)
+901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in reference namelist', lwp )
+
+         REWIND( numnatp_cfg )              ! Namelist nampisatm in configuration namelist : Pisces atm. sea level pressure file 
+         READ  ( numnatp_cfg, nampisatm, IOSTAT = ios, ERR = 902 )
+902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisatm in configuration namelist', lwp )
+         IF(lwm) WRITE ( numonp, nampisatm )
+         !
+         !
+         IF(lwp) THEN                                 !* control print
+            WRITE(numout,*)
+            WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing'
+            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm
+            WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs  ln_presatmco2 = ', ln_presatmco2
+            WRITE(numout,*)
+         ENDIF
+         !
+         IF( ln_presatm ) THEN
+            ALLOCATE( sf_patm(1), STAT=ierr )           !* allocate and fill sf_patm (forcing structure) with sn_patm
+            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_patm structure' )
+            !
+            CALL fld_fill( sf_patm, (/ sn_patm /), cn_dir, 'p4z_flx', 'Atmospheric pressure ', 'nampisatm' )
+                                   ALLOCATE( sf_patm(1)%fnow(jpi,jpj,1)   )
+            IF( sn_patm%ln_tint )  ALLOCATE( sf_patm(1)%fdta(jpi,jpj,1,2) )
+         ENDIF
+         !                                         
+         IF( ln_presatmco2 ) THEN
+            ALLOCATE( sf_atmco2(1), STAT=ierr )           !* allocate and fill sf_atmco2 (forcing structure) with sn_atmco2
+            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_atmco2 structure' )
+            !
+            CALL fld_fill( sf_atmco2, (/ sn_atmco2 /), cn_dir, 'p4z_flx', 'Atmospheric co2 partial pressure ', 'nampisatm' )
+                                   ALLOCATE( sf_atmco2(1)%fnow(jpi,jpj,1)   )
+            IF( sn_atmco2%ln_tint )  ALLOCATE( sf_atmco2(1)%fdta(jpi,jpj,1,2) )
+         ENDIF
+         !
+         IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file
+         !
+      ENDIF
+      !
+      IF( ln_presatm ) THEN
+         CALL fld_read( kt, 1, sf_patm )               !* input Patm provided at kt + 1/2
+         patm(:,:) = sf_patm(1)%fnow(:,:,1)                        ! atmospheric pressure
+      ENDIF
+      !
+      IF( ln_presatmco2 ) THEN
+         CALL fld_read( kt, 1, sf_atmco2 )               !* input atmco2 provided at kt + 1/2
+         satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1)                        ! atmospheric pressure
+      ELSE
+         satmco2(:,:) = atcco2    ! Initialize atmco2 if no reading from a file
+      ENDIF
+      !
+   END SUBROUTINE p4z_patm
+
+
+   INTEGER FUNCTION p4z_flx_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_flx_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc )
+      !
+      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays')
+      !
+   END FUNCTION p4z_flx_alloc
+
+   !!======================================================================
+END MODULE p4zflx
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90	(revision 8732)
@@ -0,0 +1,68 @@
+MODULE p4zint
+   !!======================================================================
+   !!                         ***  MODULE p4zint  ***
+   !! TOP :   PISCES interpolation and computation of various accessory fields
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!----------------------------------------------------------------------
+   !!   p4z_int        :  interpolation and computation of various accessory fields
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_int  
+   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_int( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_int  ***
+      !!
+      !! ** Purpose :   interpolation and computation of various accessory fields
+      !!
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !
+      INTEGER  :: ji, jj                 ! dummy loop indices
+      REAL(wp) :: zvar                   ! local variable
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_int')
+      !
+      ! Computation of phyto and zoo metabolic rate
+      ! -------------------------------------------
+      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) )
+      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) )
+
+      ! Computation of the silicon dependant half saturation  constant for silica uptake
+      ! ---------------------------------------------------
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)
+            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
+         END DO
+      END DO
+      !
+      IF( nday_year == nyear_len(1) ) THEN
+         xksi   (:,:) = xksimax(:,:)
+         xksimax(:,:) = 0._wp
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_int')
+      !
+   END SUBROUTINE p4z_int
+
+   !!======================================================================
+END MODULE p4zint
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90	(revision 8732)
@@ -0,0 +1,142 @@
+MODULE p4zligand
+   !!======================================================================
+   !!                         ***  MODULE p4zligand  ***
+   !! TOP :   PISCES Compute remineralization/dissolution of organic ligands
+   !!=========================================================================
+   !! History :   3.6  !  2016-03  (O. Aumont, A. Tagliabue) Quota model and reorganization
+   !!----------------------------------------------------------------------
+   !!   p4z_ligand       :  Compute remineralization/dissolution of organic ligands
+   !!   p4z_ligand_init  :  Initialisation of parameters for remineralisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_ligand         ! called in p4zbio.F90
+   PUBLIC   p4z_ligand_init    ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  rlgw     !: lifetime (years) of weak ligands
+   REAL(wp), PUBLIC ::  rlgs     !: lifetime (years) of strong ligands
+   REAL(wp), PUBLIC ::  rlig     !: Remin ligand production
+   REAL(wp), PUBLIC ::  prlgw    !: Photochemical of weak ligand
+   REAL(wp), PUBLIC ::  rfep     !: Dissolution rate of FeP
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zligand.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_ligand( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_ligand  ***
+      !!
+      !! ** Purpose :   Compute remineralization/scavenging of organic ligands
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zlgwp, zlgwpr, zlgwr, zlablgw, zrfepa, zfepr
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_ligand')
+      !
+      ! ------------------------------------------------------------------
+      ! Remineralization of iron ligands
+      ! ------------------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! production from remineralisation of organic matter
+               zlgwp  = orem(ji,jj,jk) * rlig
+               ! decay of weak ligand
+               ! This is based on the idea that as LGW is lower
+               ! there is a larger fraction of refractory OM
+               zlgwr = max( rlgs , rlgw * exp( -2 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years
+               zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * trb(ji,jj,jk,jplgw)
+               ! photochem loss of weak ligand
+               zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj))
+               tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr
+            END DO
+         END DO
+      END DO
+
+      ! ----------------------------------------------------------
+      ! Dissolution of nanoparticle Fe
+      ! ----------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! dissolution rate is maximal in the presence of light and 
+               ! lower in the aphotici zone
+               ! ! 25 Wm-2 constant
+               zrfepa = rfep * ( 1. - EXP( -1. * etot(ji,jj,jk) / 25. ) ) * (1.- fr_i(ji,jj))
+               zrfepa = MAX( (zrfepa / 10.0), zrfepa ) ! min of 10 days lifetime
+               zfepr = rfep * xstep * trb(ji,jj,jk,jpfep)
+               tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) - zfepr
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zfepr
+            END DO
+         END DO
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ligand1')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_ligand')
+      !
+   END SUBROUTINE p4z_ligand
+
+
+   SUBROUTINE p4z_ligand_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_ligand_init  ***
+      !!
+      !! ** Purpose :   Initialization of remineralization parameters
+      !!
+      !! ** Method  :   Read the nampislig namelist and check the parameters
+      !!      called at the first timestep
+      !!
+      !! ** input   :   Namelist nampislig
+      !!
+      !!----------------------------------------------------------------------
+      NAMELIST/nampislig/ rlgw, prlgw, rlgs, rfep, rlig
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampislig in reference namelist : Pisces remineralization
+      READ  ( numnatp_ref, nampislig, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampislig in configuration namelist : Pisces remineralization
+      READ  ( numnatp_cfg, nampislig, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislig in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampislig )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for ligands, nampislig'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    Dissolution rate of FeP                        rfep =', rfep
+         WRITE(numout,*) '    Lifetime (years) of weak ligands               rlgw =', rlgw
+         WRITE(numout,*) '    Remin ligand production per unit C             rlig =', rlig
+         WRITE(numout,*) '    Photolysis of weak ligand                     prlgw =', prlgw
+         WRITE(numout,*) '    Lifetime (years) of strong ligands             rlgs =', rlgs
+      ENDIF
+      !
+   END SUBROUTINE p4z_ligand_init
+
+   !!======================================================================
+END MODULE p4zligand
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90	(revision 8732)
@@ -0,0 +1,305 @@
+MODULE p4zlim
+   !!======================================================================
+   !!                         ***  MODULE p4zlim  ***
+   !! TOP :   PISCES 
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota 
+   !!----------------------------------------------------------------------
+   !!   p4z_lim        :   Compute the nutrients limitation terms 
+   !!   p4z_lim_init   :   Read the namelist 
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Shared ocean-passive tracers variables
+   USE trc             ! Tracers defined
+   USE sms_pisces      ! PISCES variables
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC p4z_lim    
+   PUBLIC p4z_lim_init    
+   PUBLIC p4z_lim_alloc
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  concnno3    !:  NO3, PO4 half saturation   
+   REAL(wp), PUBLIC ::  concdno3    !:  Phosphate half saturation for diatoms  
+   REAL(wp), PUBLIC ::  concnnh4    !:  NH4 half saturation for phyto  
+   REAL(wp), PUBLIC ::  concdnh4    !:  NH4 half saturation for diatoms
+   REAL(wp), PUBLIC ::  concnfer    !:  Iron half saturation for nanophyto 
+   REAL(wp), PUBLIC ::  concdfer    !:  Iron half saturation for diatoms  
+   REAL(wp), PUBLIC ::  concbno3    !:  NO3 half saturation  for bacteria 
+   REAL(wp), PUBLIC ::  concbnh4    !:  NH4 half saturation for bacteria
+   REAL(wp), PUBLIC ::  xsizedia    !:  Minimum size criteria for diatoms
+   REAL(wp), PUBLIC ::  xsizephy    !:  Minimum size criteria for nanophyto
+   REAL(wp), PUBLIC ::  xsizern     !:  Size ratio for nanophytoplankton
+   REAL(wp), PUBLIC ::  xsizerd     !:  Size ratio for diatoms
+   REAL(wp), PUBLIC ::  xksi1       !:  half saturation constant for Si uptake 
+   REAL(wp), PUBLIC ::  xksi2       !:  half saturation constant for Si/C 
+   REAL(wp), PUBLIC ::  xkdoc       !:  2nd half-sat. of DOC remineralization  
+   REAL(wp), PUBLIC ::  concbfe     !:  Fe half saturation for bacteria 
+   REAL(wp), PUBLIC ::  oxymin      !:  half saturation constant for anoxia
+   REAL(wp), PUBLIC ::  qnfelim     !:  optimal Fe quota for nanophyto
+   REAL(wp), PUBLIC ::  qdfelim     !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  caco3r      !:  mean rainratio 
+
+   !!* Phytoplankton limitation terms
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbac    !: ??
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbacl   !: ??
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ???
+
+   ! Coefficient for iron limitation
+   REAL(wp) ::  xcoef1   = 0.0016  / 55.85  
+   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5
+   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zlim.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_lim( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_lim  ***
+      !!
+      !! ** Purpose :   Compute the co-limitations by the various nutrients
+      !!              for the various phytoplankton species
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in)  :: kt, knt
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim
+      REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2
+      REAL(wp) ::   z1_trbdia, z1_trbphy, ztem1, ztem2, zetot1, zetot2
+      REAL(wp) ::   zdenom, zratio, zironmin
+      REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4   
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_lim')
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               
+               ! Tuning of the iron concentration to a minimum level that is set to the detection limit
+               !-------------------------------------
+               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6
+               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
+               zferlim = MIN( zferlim, 7e-11 )
+               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
+
+               ! Computation of a variable Ks for iron on diatoms taking into account
+               ! that increasing biomass is made of generally bigger cells
+               !------------------------------------------------
+               zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+               zconcd2  = trb(ji,jj,jk,jpdia) - zconcd
+               zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy )
+               zconcn2  = trb(ji,jj,jk,jpphy) - zconcn
+               z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
+               z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia )
+               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia )
+               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia )
+
+               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy )
+               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy )
+               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy )
+
+               ! Michaelis-Menten Limitation term for nutrients Small bacteria
+               ! -------------------------------------------------------------
+               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom
+               !
+               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 )
+               zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )
+               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) )
+               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+               xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
+
+               ! Michaelis-Menten Limitation term for nutrients Small flagellates
+               ! -----------------------------------------------
+               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom
+               !
+               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 )
+               zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy 
+               zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
+               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim )
+               xnanopo4(ji,jj,jk) = zlim2
+               xlimnfe (ji,jj,jk) = MIN( 1., zlim3 )
+               xlimphy (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+               !
+               !   Michaelis-Menten Limitation term for nutrients Diatoms
+               !   ----------------------------------------------
+               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) )
+               xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
+               xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom
+               !
+               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  )
+               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
+               zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia
+               zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
+               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim )
+               xdiatpo4(ji,jj,jk) = zlim2
+               xlimdfe (ji,jj,jk) = MIN( 1., zlim4 )
+               xlimdia (ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 )
+               xlimsi  (ji,jj,jk) = MIN( zlim1, zlim2, zlim4 )
+           END DO
+         END DO
+      END DO
+
+      ! Compute the fraction of nanophytoplankton that is made of calcifiers
+      ! --------------------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    &
+                  &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 
+               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 )
+               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   )
+               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
+               ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
+               zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 
+               zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) 
+
+               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
+                  &                       * ztem1 / ( 0.1 + ztem1 )                     &
+                  &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
+                  &                       * zetot1 * zetot2               &
+                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
+                  &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) )
+               xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) )
+               xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! denitrification factor computed from O2 levels
+               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    &
+                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  )
+               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics
+        IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
+        IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        IF( iom_use( "LDnut"   ) ) CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        IF( iom_use( "LNFe"    ) ) CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        IF( iom_use( "LDFe"    ) ) CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_lim')
+      !
+   END SUBROUTINE p4z_lim
+
+   SUBROUTINE p4z_lim_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_lim_init  ***
+      !!
+      !! ** Purpose :   Initialization of nutrient limitation parameters
+      !!
+      !! ** Method  :   Read the nampislim namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampislim
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp4zlim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   &
+         &                concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd,          & 
+         &                xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
+      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
+      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zlim )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r
+         WRITE(numout,*) '    NO3 half saturation of nanophyto         concnno3  = ', concnno3
+         WRITE(numout,*) '    NO3 half saturation of diatoms           concdno3  = ', concdno3
+         WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4
+         WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4
+         WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1
+         WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2
+         WRITE(numout,*) '    half-sat. of DOC remineralization        xkdoc     = ', xkdoc
+         WRITE(numout,*) '    Iron half saturation for nanophyto       concnfer  = ', concnfer
+         WRITE(numout,*) '    Iron half saturation for diatoms         concdfer  = ', concdfer
+         WRITE(numout,*) '    size ratio for nanophytoplankton         xsizern   = ', xsizern
+         WRITE(numout,*) '    size ratio for diatoms                   xsizerd   = ', xsizerd
+         WRITE(numout,*) '    NO3 half saturation of bacteria          concbno3  = ', concbno3
+         WRITE(numout,*) '    NH4 half saturation for bacteria         concbnh4  = ', concbnh4
+         WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia
+         WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy
+         WRITE(numout,*) '    Fe half saturation for bacteria          concbfe   = ', concbfe
+         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin   =' , oxymin
+         WRITE(numout,*) '    optimal Fe quota for nano.               qnfelim   = ', qnfelim
+         WRITE(numout,*) '    Optimal Fe quota for diatoms             qdfelim   = ', qdfelim
+      ENDIF
+      !
+      nitrfac (:,:,:) = 0._wp
+      !
+   END SUBROUTINE p4z_lim_init
+
+   INTEGER FUNCTION p4z_lim_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_lim_alloc  ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp , ONLY: ctl_warn
+      !!----------------------------------------------------------------------
+
+      !*  Biological arrays for phytoplankton growth
+      ALLOCATE( xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       &
+         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       &
+         &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       &
+         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       &
+         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       &
+         &      xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk),       &
+         &      concnfe (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       &
+         &      xlimsi  (jpi,jpj,jpk), STAT=p4z_lim_alloc )
+      !
+      IF( p4z_lim_alloc /= 0 ) CALL ctl_warn('p4z_lim_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_lim_alloc
+
+   !!======================================================================
+END MODULE p4zlim
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90	(revision 8732)
@@ -0,0 +1,187 @@
+MODULE p4zlys
+   !!======================================================================
+   !!                         ***  MODULE p4zlys  ***
+   !! TOP :   PISCES 
+   !!======================================================================
+   !! History :    -   !  1988-07  (E. MAIER-REIMER) Original code
+   !!              -   !  1998     (O. Aumont) additions
+   !!              -   !  1999     (C. Le Quere) modifications
+   !!             1.0  !  2004     (O. Aumont) modifications
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p4z_lys        :   Compute the CaCO3 dissolution 
+   !!   p4z_lys_init   :   Read the namelist parameters
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zche          !  Chemical model
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_lys         ! called in trcsms_pisces.F90
+   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC :: kdca !: diss. rate constant calcite
+   REAL(wp), PUBLIC :: nca  !: order of reaction for calcite dissolution
+
+   !! * Module variables
+   REAL(wp) :: calcon = 1.03E-2           !: mean calcite concentration [Ca2+] in sea water [mole/kg solution]
+ 
+   INTEGER  :: rmtss                      !: number of seconds per month 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zlys.F90 3321 2012-03-05 17:10:55Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_lys( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_lys  ***
+      !!
+      !! ** Purpose :   CALCULATES DEGREE OF CACO3 SATURATION IN THE WATER
+      !!                COLUMN, DISSOLUTION/PRECIPITATION OF CACO3 AND LOSS
+      !!                OF CACO3 TO THE CACO3 SEDIMENT POOL.
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER  ::   ji, jj, jk, jn
+      REAL(wp) ::   zdispot, zfact, zcalcon
+      REAL(wp) ::   zomegaca, zexcess, zexcess0
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_lys')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )
+      !
+      zco3    (:,:,:) = 0.
+      zcaldiss(:,:,:) = 0.
+      zhinit(:,:,:)   = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn )
+      !     -------------------------------------------
+      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS
+      !     -------------------------------------------
+
+      CALL solve_at_general(zhinit, zhi)
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   &
+               &                + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
+               hi(ji,jj,jk)   = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.
+            END DO
+         END DO
+      END DO
+
+      !     ---------------------------------------------------------
+      !        CALCULATE DEGREE OF CACO3 SATURATION AND CORRESPONDING
+      !        DISSOLOUTION AND PRECIPITATION OF CACO3 (BE AWARE OF
+      !        MGCO3)
+      !     ---------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               ! DEVIATION OF [CO3--] FROM SATURATION VALUE
+               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units
+               zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp )
+               zfact    = rhop(ji,jj,jk) / 1000._wp
+               zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn )
+               zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn )
+
+               ! SET DEGREE OF UNDER-/SUPERSATURATION
+               excess(ji,jj,jk) = 1._wp - zomegaca
+               zexcess0 = MAX( 0., excess(ji,jj,jk) )
+               zexcess  = zexcess0**nca
+
+               ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION
+               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
+               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
+               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal)
+              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
+              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
+              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
+              !
+              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)
+              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk)
+              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+         IF( iom_use( "PH"     ) ) CALL iom_put( "PH"    , -1. * LOG10( hi(:,:,:) )          * tmask(:,:,:) )
+         IF( iom_use( "CO3"    ) ) CALL iom_put( "CO3"   , zco3(:,:,:)    * 1.e+3            * tmask(:,:,:) )
+         IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3            * tmask(:,:,:) )
+         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+        WRITE(charout, FMT="('lys ')")
+        CALL prt_ctl_trc_info(charout)
+        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_lys')
+      !
+   END SUBROUTINE p4z_lys
+
+   SUBROUTINE p4z_lys_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_lys_init  ***
+      !!
+      !! ** Purpose :   Initialization of CaCO3 dissolution parameters
+      !!
+      !! ** Method  :   Read the nampiscal namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampiscal
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::  ios                 ! Local integer output status for namelist read
+
+      NAMELIST/nampiscal/ kdca, nca
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp_ref )              ! Namelist nampiscal in reference namelist : Pisces CaCO3 dissolution
+      READ  ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiscal in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampiscal in configuration namelist : Pisces CaCO3 dissolution
+      READ  ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiscal in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampiscal )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for CaCO3 dissolution, nampiscal'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    diss. rate constant calcite (per month)   kdca      =', kdca
+         WRITE(numout,*) '    order of reaction for calcite dissolution nca       =', nca
+      ENDIF
+
+      ! Number of seconds per month 
+      rmtss =  nyear_len(1) * rday / raamo
+      !
+   END SUBROUTINE p4z_lys_init
+   !!======================================================================
+END MODULE p4zlys
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90	(revision 8732)
@@ -0,0 +1,301 @@
+MODULE p4zmeso
+   !!======================================================================
+   !!                         ***  MODULE p4zmeso  ***
+   !! TOP :   PISCES Compute the sources/sinks for mesozooplankton
+   !!======================================================================
+   !! History :   1.0  !  2002     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
+   !!----------------------------------------------------------------------
+   !!   p4z_meso       :   Compute the sources/sinks for mesozooplankton
+   !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zprod         !  production
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_meso              ! called in p4zbio.F90
+   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  part2        !: part of calcite not dissolved in mesozoo guts
+   REAL(wp), PUBLIC ::  xprefc       !: mesozoo preference for POC 
+   REAL(wp), PUBLIC ::  xprefp       !: mesozoo preference for nanophyto
+   REAL(wp), PUBLIC ::  xprefz       !: mesozoo preference for diatoms
+   REAL(wp), PUBLIC ::  xprefpoc     !: mesozoo preference for POC 
+   REAL(wp), PUBLIC ::  xthresh2zoo  !: zoo feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2dia  !: diatoms feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2phy  !: nanophyto feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2poc  !: poc feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2     !: feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  resrat2      !: exsudation rate of mesozooplankton
+   REAL(wp), PUBLIC ::  mzrat2       !: microzooplankton mortality rate 
+   REAL(wp), PUBLIC ::  grazrat2     !: maximal mesozoo grazing rate
+   REAL(wp), PUBLIC ::  xkgraz2      !: non assimilated fraction of P by mesozoo 
+   REAL(wp), PUBLIC ::  unass2       !: Efficicency of mesozoo growth 
+   REAL(wp), PUBLIC ::  sigma2       !: Fraction of mesozoo excretion as DOM 
+   REAL(wp), PUBLIC ::  epsher2      !: half sturation constant for grazing 2
+   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zmeso.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_meso( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_meso  ***
+      !!
+      !! ** Purpose :   Compute the sources/sinks for mesozooplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
+      REAL(wp) :: zgraze2 , zdenom, zdenom2
+      REAL(wp) :: zfact   , zfood, zfoodlim, zproport
+      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal
+      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf
+      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat, zgrasratn
+      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof
+      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf
+      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_meso')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
+      zgrazing(:,:,:) = 0._wp
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
+               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
+
+               !  Respiration rates of both zooplankton
+               !  -------------------------------------
+               zrespz2   = resrat2 * zfact * trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
+                  &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk)
+
+               !  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 * trb(ji,jj,jk,jpmes)
+               !
+               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
+               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
+               ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
+               ! it is to predation by mesozooplankton
+               ! -------------------------------------------------------------------------------
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
+                  &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
+
+               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc 
+               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
+               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
+               zdenom2   = zdenom / ( zfood + rtrn )
+               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 
+
+               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2 
+               zgrazz    = zgraze2  * xprefz   * zcompaz   * zdenom2 
+               zgrazn    = zgraze2  * xprefp   * zcompaph  * zdenom2 
+               zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2 
+
+               zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
+
+               !  Mesozooplankton flux feeding on GOC
+               !  ----------------------------------
+               !  ----------------------------------
+               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
+               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+              !
+              zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
+              ! Compute the proportion of filter feeders
+              zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztot)
+              ! Compute fractionation of aggregates. It is assumed that 
+              ! diatoms based aggregates are more prone to fractionation
+              ! since they are more porous (marine snow instead of fecal pellets)
+              zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
+              zratio2   = zratio * zratio
+              zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
+               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
+               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
+              zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
+
+              zgrazffep = zproport * zgrazffep
+              zgrazffeg = zproport * zgrazffeg
+              zgrazfffp = zproport * zgrazfffp
+              zgrazfffg = zproport * zgrazfffg
+              zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
+              zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   &
+              &   + zgrazpoc + zgrazffep + zgrazffeg
+              zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg
+
+              ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
+              zgrazing(ji,jj,jk) = zgraztot
+
+              !    Mesozooplankton efficiency
+              !    --------------------------
+               zgrasrat  =  ( zgraztotf +rtrn )/ ( zgraztot + rtrn )
+               zgrasratn =  ( zgraztotn +rtrn )/ ( zgraztot + rtrn )
+               zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3)
+               zepsherv  = zepshert * MIN( epsher2, (1. - unass2) * zgrasrat / ferat3, (1. - unass2) * zgrasratn )
+               zgrarem2  = zgraztot * ( 1. - zepsherv - unass2 ) &
+                &       + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz2
+               zgrafer2  = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    &
+                &       + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz2 )
+               zgrapoc2  = zgraztot * unass2
+
+               !   Update the arrays TRA which contain the biological sources and sinks
+               zgrarsig  = zgrarem2 * sigma2
+               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
+               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig
+               !
+               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz
+               !
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig              
+
+               zmortz2 = ztortz2 + zrespz2
+               zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz2 + zrespz2
+               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + zepsherv * zgraztot 
+               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 * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
+
+              tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac
+              prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac
+              conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
+              tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac
+              prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2
+              consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac
+              tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe
+              tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     &
+                 &                + zgraztotf * unass2 - zfracfe
+              zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn )
+              zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal
+              ! calcite production
+              zprcaca = xfracal(ji,jj,jk) * zgrazn
+              prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+              !
+              zprcaca = part2 * zprcaca
+              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca
+              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca )
+              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca
+            END DO
+         END DO
+      END DO
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+         CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+         IF( iom_use( "GRAZ2" ) ) THEN
+            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton
+            CALL iom_put( "GRAZ2", zw3d )
+         ENDIF
+         IF( iom_use( "PCAL" ) ) THEN
+            zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production
+            CALL iom_put( "PCAL", zw3d )  
+         ENDIF
+         CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+        WRITE(charout, FMT="('meso')")
+        CALL prt_ctl_trc_info(charout)
+        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_meso')
+      !
+   END SUBROUTINE p4z_meso
+
+   SUBROUTINE p4z_meso_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_meso_init  ***
+      !!
+      !! ** Purpose :   Initialization of mesozooplankton parameters
+      !!
+      !! ** Method  :   Read the nampismes namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampismes
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   &
+         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, &
+         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton
+      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton
+      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zmes )
+
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' ' 
+         WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2
+         WRITE(numout,*) '    mesozoo preference for phyto                   xprefc       =', xprefc
+         WRITE(numout,*) '    mesozoo preference for POC                     xprefp       =', xprefp
+         WRITE(numout,*) '    mesozoo preference for zoo                     xprefz       =', xprefz
+         WRITE(numout,*) '    mesozoo preference for poc                     xprefpoc     =', xprefpoc
+         WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo
+         WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia
+         WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy
+         WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc
+         WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2     =', xthresh2
+         WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2      =', resrat2
+         WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2       =', mzrat2
+         WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2     =', grazrat2
+         WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux     =', grazflux
+         WRITE(numout,*) '    non assimilated fraction of P by mesozoo       unass2       =', unass2
+         WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2      =', epsher2
+         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM           sigma2       =', sigma2
+         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2      =', xkgraz2
+      ENDIF
+
+
+   END SUBROUTINE p4z_meso_init
+
+   !!======================================================================
+END MODULE p4zmeso
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90	(revision 8732)
@@ -0,0 +1,255 @@
+MODULE p4zmicro
+   !!======================================================================
+   !!                         ***  MODULE p4zmicro  ***
+   !! TOP :   PISCES Compute the sources/sinks for microzooplankton
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
+   !!----------------------------------------------------------------------
+   !!   p4z_micro       :   Compute the sources/sinks for microzooplankton
+   !!   p4z_micro_init  :   Initialize and read the appropriate namelist
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zlim          !  Co-limitations
+   USE p4zprod         !  production
+   USE iom             !  I/O manager
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_micro         ! called in p4zbio.F90
+   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  part        !: part of calcite not dissolved in microzoo guts
+   REAL(wp), PUBLIC ::  xpref2c     !: microzoo preference for POC 
+   REAL(wp), PUBLIC ::  xpref2p     !: microzoo preference for nanophyto
+   REAL(wp), PUBLIC ::  xpref2d     !: microzoo preference for diatoms
+   REAL(wp), PUBLIC ::  xthreshdia  !: diatoms feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshphy  !: nanophyto threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshpoc  !: poc threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthresh     !: feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  resrat      !: exsudation rate of microzooplankton
+   REAL(wp), PUBLIC ::  mzrat       !: microzooplankton mortality rate 
+   REAL(wp), PUBLIC ::  grazrat     !: maximal microzoo grazing rate
+   REAL(wp), PUBLIC ::  xkgraz      !: non assimilated fraction of P by microzoo 
+   REAL(wp), PUBLIC ::  unass       !: Efficicency of microzoo growth 
+   REAL(wp), PUBLIC ::  sigma1      !: Fraction of microzoo excretion as DOM 
+   REAL(wp), PUBLIC ::  epsher      !: half sturation constant for grazing 1 
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zmicro.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_micro( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_micro  ***
+      !!
+      !! ** Purpose :   Compute the sources/sinks for microzooplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::  kt  ! ocean time step
+      INTEGER, INTENT(in) ::  knt 
+      !
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc
+      REAL(wp) :: zgraze  , zdenom, zdenom2
+      REAL(wp) :: zfact   , zfood, zfoodlim
+      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf
+      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz
+      REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn
+      REAL(wp) :: zgrazp, zgrazm, zgrazsd
+      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_micro')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
+               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
+
+               !  Respiration rates of both zooplankton
+               !  -------------------------------------
+               zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  &
+                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk)
+
+               !  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 * trb(ji,jj,jk,jpzoo)
+
+               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
+               
+               !     Microzooplankton grazing
+               !     ------------------------
+               zfood     = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi
+               zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
+               zdenom    = zfoodlim / ( xkgraz + zfoodlim )
+               zdenom2   = zdenom / ( zfood + rtrn )
+               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 
+
+               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2 
+               zgrazm    = zgraze  * xpref2c * zcompapoc * zdenom2 
+               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2 
+
+               zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
+               !
+               zgraztot  = zgrazp  + zgrazm  + zgrazsd 
+               zgraztotf = zgrazpf + zgrazsf + zgrazmf 
+               zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk)
+
+               ! Grazing by microzooplankton
+               zgrazing(ji,jj,jk) = zgraztot
+
+               !    Various remineralization and excretion terms
+               !    --------------------------------------------
+               zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztot + rtrn )
+               zgrasratn = ( zgraztotn + rtrn ) / ( zgraztot + rtrn )
+               zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3)
+               zepsherv  = zepshert * MIN( epsher, (1. - unass) * zgrasrat / ferat3, (1. - unass) * zgrasratn )
+               zgrafer   = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) 
+               zgrarem   = zgraztot * ( 1. - zepsherv - unass )
+               zgrapoc   = zgraztot * unass
+
+               !  Update of the TRA arrays
+               !  ------------------------
+               zgrarsig  = zgrarem * sigma1
+               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
+               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig
+               !
+               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz
+               !
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig
+               !   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 + zepsherv * zgraztot 
+               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  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz
+               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf
+               !
+               ! calcite production
+               zprcaca = xfracal(ji,jj,jk) * zgrazp
+               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+               !
+               zprcaca = part * zprcaca
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
+               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
+            END DO
+         END DO
+      END DO
+      !
+      IF( lk_iomput ) THEN
+         IF( knt == nrdttrc ) THEN
+           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+           IF( iom_use( "GRAZ1" ) ) THEN
+              zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton
+              CALL iom_put( "GRAZ1", zw3d )
+           ENDIF
+           CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+         ENDIF
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('micro')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_micro')
+      !
+   END SUBROUTINE p4z_micro
+
+
+   SUBROUTINE p4z_micro_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_micro_init  ***
+      !!
+      !! ** Purpose :   Initialization of microzooplankton parameters
+      !!
+      !! ** Method  :   Read the nampiszoo namelist and check the parameters
+      !!                called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampiszoo
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp4zzoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, &
+         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, &
+         &                xthresh, xkgraz, epsher, sigma1, unass
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton
+      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton
+      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zzoo )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part
+         WRITE(numout,*) '    microzoo preference for POC                     xpref2c     =', xpref2c
+         WRITE(numout,*) '    microzoo preference for nano                    xpref2p     =', xpref2p
+         WRITE(numout,*) '    microzoo preference for diatoms                 xpref2d     =', xpref2d
+         WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia
+         WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy
+         WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc
+         WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh
+         WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat
+         WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat
+         WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat
+         WRITE(numout,*) '    non assimilated fraction of P by microzoo       unass       =', unass
+         WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher
+         WRITE(numout,*) '    Fraction of microzoo excretion as DOM           sigma1      =', sigma1
+         WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz
+      ENDIF
+
+   END SUBROUTINE p4z_micro_init
+
+   !!======================================================================
+END MODULE p4zmicro
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90	(revision 8732)
@@ -0,0 +1,247 @@
+MODULE p4zmort
+   !!======================================================================
+   !!                         ***  MODULE p4zmort  ***
+   !! TOP :   PISCES Compute the mortality terms for phytoplankton
+   !!======================================================================
+   !! History :   1.0  !  2002     (O. Aumont)  Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!----------------------------------------------------------------------
+   !!   p4z_mort       :   Compute the mortality terms for phytoplankton
+   !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zprod         !  Primary productivity 
+   USE p4zlim          !  Phytoplankton limitation terms
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_mort    
+   PUBLIC   p4z_mort_init    
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC :: wchl    !:
+   REAL(wp), PUBLIC :: wchld   !:
+   REAL(wp), PUBLIC :: wchldm  !:
+   REAL(wp), PUBLIC :: mprat   !:
+   REAL(wp), PUBLIC :: mprat2  !:
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_mort( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_mort  ***
+      !!
+      !! ** Purpose :   Calls the different subroutine to initialize and compute
+      !!                the different phytoplankton mortality terms
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      !!---------------------------------------------------------------------
+
+      CALL p4z_nano            ! nanophytoplankton
+
+      CALL p4z_diat            ! diatoms
+
+   END SUBROUTINE p4z_mort
+
+
+   SUBROUTINE p4z_nano
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_nano  ***
+      !!
+      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zsizerat, zcompaph
+      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal
+      REAL(wp) :: ztortp , zrespp , zmortp 
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_nano')
+      !
+      prodcal(:,:,:) = 0.  !: calcite production variable set to zero
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
+               !     When highly limited by macronutrients, very small cells 
+               !     dominate the community. As a consequence, aggregation
+               !     due to turbulence is negligible. Mortality is also set
+               !     to 0
+               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy)
+               !     Squared mortality of Phyto similar to a sedimentation term during
+               !     blooms (Doney et al. 1996)
+               zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
+
+               !     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 * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat
+
+               zmortp = zrespp + ztortp
+
+               !   Update the arrays TRA which contains the biological sources and sinks
+
+               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
+               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
+               zprcaca = xfracal(ji,jj,jk) * zmortp
+               !
+               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+               !
+               zfracal = 0.5 * xfracal(ji,jj,jk)
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
+               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp
+               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe
+            END DO
+         END DO
+      END DO
+      !
+       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('nano')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_nano')
+      !
+   END SUBROUTINE p4z_nano
+
+   SUBROUTINE p4z_diat
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_diat  ***
+      !!
+      !! ** Purpose :   Compute the mortality terms for diatoms
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER  ::  ji, jj, jk
+      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi
+      REAL(wp) ::  zrespp2, ztortp2, zmortp2
+      REAL(wp) ::  zlim2, zlim1
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_diat')
+      !
+
+      !    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
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 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
+               !     ------------------------------------------------------------
+               !  Phytoplankton respiration 
+               !     ------------------------
+               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
+               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
+               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
+
+               !     Phytoplankton mortality. 
+               !     ------------------------
+               ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 
+
+               zmortp2 = zrespp2 + ztortp2
+
+               !   Update the arrays tra which contains the biological sources and sinks
+               !   ---------------------------------------------------------------------
+               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2
+               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
+            END DO
+         END DO
+      END DO
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('diat')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_diat')
+      !
+   END SUBROUTINE p4z_diat
+
+   SUBROUTINE p4z_mort_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_mort_init  ***
+      !!
+      !! ** Purpose :   Initialization of phytoplankton parameters
+      !!
+      !! ** Method  :   Read the nampismort namelist and check the parameters
+      !!      called at the first timestep
+      !!
+      !! ** input   :   Namelist nampismort
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
+      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
+      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zmort )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl
+         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld
+         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchldm    =', wchldm
+         WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat
+         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2
+      ENDIF
+
+   END SUBROUTINE p4z_mort_init
+
+   !!======================================================================
+END MODULE p4zmort
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90	(revision 8732)
@@ -0,0 +1,454 @@
+MODULE p4zopt
+   !!======================================================================
+   !!                         ***  MODULE p4zopt  ***
+   !! TOP - PISCES : Compute the light availability in the water column
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat
+   !!----------------------------------------------------------------------
+   !!   p4z_opt       : light availability in the water column
+   !!----------------------------------------------------------------------
+   USE trc            ! tracer variables
+   USE oce_trc        ! tracer-ocean share variables
+   USE sms_pisces     ! Source Minus Sink of PISCES
+   USE iom            ! I/O manager
+   USE fldread         !  time interpolation
+   USE prtctl_trc      !  print control for debugging
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_opt        ! called in p4zbio.F90 module
+   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module
+   PUBLIC   p4z_opt_alloc
+
+   !! * Shared module variables
+
+   LOGICAL  :: ln_varpar   !: boolean for variable PAR fraction
+   REAL(wp) :: parlux      !: Fraction of shortwave as PAR
+   REAL(wp) :: xparsw                 !: parlux/3
+   REAL(wp) :: xsi0r                 !:  1. /rn_si0
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par
+   INTEGER , PARAMETER :: nbtimes = 366  !: maximum number of times record in a file
+   INTEGER  :: ntimes_par                ! number of time steps in a file
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue)
+
+   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
+
+   REAL(wp), DIMENSION(3,61) ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zopt.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_opt( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_opt  ***
+      !!
+      !! ** Purpose :   Compute the light availability in the water column
+      !!              depending on the depth and the chlorophyll concentration
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk
+      INTEGER  ::   irgb
+      REAL(wp) ::   zchl
+      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zetmp5
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zqsr100, zqsr_corr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_opt')
+      !
+      ! Allocate temporary workspace
+                   CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+                   CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr )
+      IF( ln_p5z ) CALL wrk_alloc( jpi, jpj,      zetmp5 )
+                   CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3, zchl3d )
+
+      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
+
+      !     Initialisation of variables used to compute PAR
+      !     -----------------------------------------------
+      ze1(:,:,:) = 0._wp
+      ze2(:,:,:) = 0._wp
+      ze3(:,:,:) = 0._wp
+      !
+      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
+                                               !  --------------------------------------------------------
+                    zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch)
+      IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch)
+      !
+      DO jk = 1, jpkm1   
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6
+               zchl = MIN(  10. , MAX( 0.05, zchl )  )
+               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
+               !                                                         
+               ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk)
+               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk)
+               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !                                        !* Photosynthetically Available Radiation (PAR)
+      !                                        !  --------------------------------------
+      IF( l_trcdm2dc ) THEN                     !  diurnal cycle
+         !
+         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn )
+         !
+         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 
+         !
+         DO jk = 1, nksrp      
+            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
+            enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+         END DO
+         IF( ln_p5z ) THEN
+            DO jk = 1, nksrp      
+              epico  (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            END DO
+         ENDIF
+         !
+         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
+         !
+         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 
+         !
+         DO jk = 1, nksrp      
+            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
+         END DO
+         !
+      ELSE
+         !
+         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
+         !
+         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  ) 
+         !
+         DO jk = 1, nksrp      
+            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk)
+            enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+         END DO
+         IF( ln_p5z ) THEN
+            DO jk = 1, nksrp      
+              epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            END DO
+         ENDIF
+         etot_ndcy(:,:,:) =  etot(:,:,:) 
+      ENDIF
+
+
+      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
+         !                                     !  ------------------------
+         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
+         !
+         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1)
+         DO jk = 2, nksrp + 1
+            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
+         END DO
+         !                                     !  ------------------------
+      ENDIF
+      !                                        !* Euphotic depth and level
+      neln   (:,:) = 1                            !  ------------------------
+      heup   (:,:) = gdepw_n(:,:,2)
+      heup_01(:,:) = gdepw_n(:,:,2)
+
+      DO jk = 2, nksrp
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >=  zqsr100(ji,jj) )  THEN
+                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer
+                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
+                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth
+              ENDIF
+              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN
+                 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition)
+              ENDIF
+           END DO
+        END DO
+      END DO
+      !
+      heup   (:,:) = MIN( 300., heup   (:,:) )
+      heup_01(:,:) = MIN( 300., heup_01(:,:) )
+      !                                        !* mean light over the mixed layer
+      zdepmoy(:,:)   = 0.e0                    !  -------------------------------
+      zetmp1 (:,:)   = 0.e0
+      zetmp2 (:,:)   = 0.e0
+      zetmp3 (:,:)   = 0.e0
+      zetmp4 (:,:)   = 0.e0
+
+      DO jk = 1, nksrp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation
+                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk)
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      emoy(:,:,:) = etot(:,:,:)       ! remineralisation
+      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle 
+      !
+      DO jk = 1, nksrp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
+                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+                  enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
+                  ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      IF( ln_p5z ) THEN
+         zetmp5 (:,:) = 0.e0
+         DO jk = 1, nksrp
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
+                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                     epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+      IF( lk_iomput ) THEN
+        IF( knt == nrdttrc ) THEN
+           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
+           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+        ENDIF
+      ENDIF
+      !
+                   CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+                   CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr )
+      IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj,      zetmp5 )
+                   CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3, zchl3d )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
+      !
+   END SUBROUTINE p4z_opt
+
+   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_opt_par  ***
+      !!
+      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue)
+      !!                for a given shortwave radiation
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0  
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(out)  , OPTIONAL  ::  pqsr100  
+      !! * local variables
+      INTEGER    ::   ji, jj, jk     ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !   shortwave
+      !!----------------------------------------------------------------------
+
+      !  Real shortwave
+      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
+      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:)
+      ENDIF
+      
+      !  Light at the euphotic depth 
+      IF( PRESENT( pqsr100 ) )  pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)
+
+      IF( PRESENT( pe0 ) ) THEN     !  W-level
+         !
+         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q
+         pe1(:,:,1) = zqsr(:,:)         
+         pe2(:,:,1) = zqsr(:,:)
+         pe3(:,:,1) = zqsr(:,:)
+         !
+         DO jk = 2, nksrp + 1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r )
+                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) )
+                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) )
+                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) )
+               END DO
+              !
+            END DO
+            !
+         END DO
+        !
+      ELSE   ! T- level
+        !
+        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
+        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
+        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
+        !
+        DO jk = 2, nksrp      
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) )
+                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) )
+                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) )
+              END DO
+           END DO
+        END DO    
+        !
+      ENDIF
+      ! 
+   END SUBROUTINE p4z_opt_par
+
+
+   SUBROUTINE p4z_opt_sbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_opt_sbc  ***
+      !!
+      !! ** purpose :   read and interpolate the variable PAR fraction
+      !!                of shortwave radiation
+      !!
+      !! ** method  :   read the files and interpolate the appropriate variables
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER ,                INTENT(in) ::   kt     ! ocean time step
+
+      !! * local declarations
+      INTEGER  :: ji,jj
+      REAL(wp) :: zcoef
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_optsbc')
+      !
+      ! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file
+      IF( ln_varpar ) THEN
+         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN
+            CALL fld_read( kt, 1, sf_par )
+            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_optsbc')
+      !
+   END SUBROUTINE p4z_opt_sbc
+
+   SUBROUTINE p4z_opt_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_opt_init  ***
+      !!
+      !! ** Purpose :   Initialization of tabulated attenuation coef
+      !!                and of the percentage of PAR in Shortwave
+      !!
+      !! ** Input   :   external ascii and netcdf files
+      !!----------------------------------------------------------------------
+      !
+      INTEGER :: numpar
+      INTEGER :: ierr
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
+      !
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_par                ! informations about the fields to be read
+      !
+      NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux
+
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('p4z_opt_init')
+
+      REWIND( numnatp_ref )              ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR
+      READ  ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR
+      READ  ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampisopt )
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' namelist : nampisopt '
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
+         WRITE(numout,*) '    PAR as a variable fraction of SW     ln_varpar      = ', ln_varpar
+         WRITE(numout,*) '    Default value for the PAR fraction   parlux         = ', parlux
+      ENDIF
+      !
+      xparsw = parlux / 3.0
+      xsi0r  = 1.e0 / rn_si0
+      !
+      ! Variable PAR at the surface of the ocean
+      ! ----------------------------------------
+      IF( ln_varpar ) THEN
+         IF(lwp) WRITE(numout,*) '    initialize variable par fraction '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         !
+         ALLOCATE( par_varsw(jpi,jpj) )
+         !
+         ALLOCATE( sf_par(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_opt_init: unable to allocate sf_par structure' )
+         !
+         CALL fld_fill( sf_par, (/ sn_par /), cn_dir, 'p4z_opt_init', 'Variable PAR fraction ', 'nampisopt' )
+                                   ALLOCATE( sf_par(1)%fnow(jpi,jpj,1)   )
+         IF( sn_par%ln_tint )      ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) )
+
+         CALL iom_open (  TRIM( sn_par%clname ) , numpar )
+         CALL iom_gettime( numpar, zsteps, kntime=ntimes_par)  ! get number of record in file
+      ENDIF
+      !
+      CALL trc_oce_rgb( 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_1d(nksrp+1), ' m'
+      !
+                         ekr      (:,:,:) = 0._wp
+                         ekb      (:,:,:) = 0._wp
+                         ekg      (:,:,:) = 0._wp
+                         etot     (:,:,:) = 0._wp
+                         etot_ndcy(:,:,:) = 0._wp
+                         enano    (:,:,:) = 0._wp
+                         ediat    (:,:,:) = 0._wp
+      IF( ln_p5z     )   epico    (:,:,:) = 0._wp
+      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
+      ! 
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init')
+      !
+   END SUBROUTINE p4z_opt_init
+
+
+   INTEGER FUNCTION p4z_opt_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_opt_alloc  ***
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk),  &
+                ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc  ) 
+      !
+      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_opt_alloc
+
+   !!======================================================================
+END MODULE p4zopt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90	(revision 8732)
@@ -0,0 +1,948 @@
+MODULE p4zpoc
+   !!======================================================================
+   !!                         ***  MODULE p4zpoc  ***
+   !! TOP :   PISCES Compute remineralization of organic particles
+   !!=========================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
+   !!             3.6  !  2016-03  (O. Aumont) Quota model and diverse
+   !!----------------------------------------------------------------------
+   !!   p4z_poc       :  Compute remineralization/dissolution of organic compounds
+   !!   p4z_poc_init  :  Initialisation of parameters for remineralisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_poc         ! called in p4zbio.F90
+   PUBLIC   p4z_poc_init    ! called in trcsms_pisces.F90
+   PUBLIC   alngam
+   PUBLIC   gamain
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  xremip     !: remineralisation rate of DOC
+   REAL(wp), PUBLIC ::  xremipc    !: remineralisation rate of DOC
+   REAL(wp), PUBLIC ::  xremipn    !: remineralisation rate of DON
+   REAL(wp), PUBLIC ::  xremipp    !: remineralisation rate of DOP
+   INTEGER , PUBLIC ::  jcpoc      !: number of lability classes
+   REAL(wp), PUBLIC ::  rshape     !: shape factor of the gamma distribution
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   alphan, reminp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zrem.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_poc( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_poc  ***
+      !!
+      !! ** Purpose :   Compute remineralization of organic particles
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk, jn
+      REAL(wp) ::   zremip, zremig, zdep, zorem, zorem2, zofer
+      REAL(wp) ::   zopon, zopop, zopoc, zopoc2, zopon2, zopop2
+      REAL(wp) ::   zsizek, zsizek1, alphat, remint, solgoc, zpoc
+      REAL(wp) ::   zofer2, zofer3
+      REAL(wp) ::   zrfact2
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  )   :: totprod, totthick, totcons 
+      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zremipoc, zremigoc, zorem3, ztremint
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: alphag
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_poc')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      totprod,  totthick, totcons )
+      CALL wrk_alloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3, ztremint )
+      ALLOCATE( alphag(jpi,jpj,jpk,jcpoc) )
+
+      ! Initialization of local variables
+      ! ---------------------------------
+
+      ! Here we compute the GOC -> POC rate due to the shrinking
+      ! of the fecal pellets/aggregates as a result of bacterial
+      ! solubilization
+      ! This is based on a fractal dimension of 2.56 and a spectral
+      ! slope of -3.6 (identical to what is used in p4zsink to compute
+      ! aggregation
+      solgoc = 0.04/ 2.56 * 1./ ( 1.-50**(-0.04) )
+
+      ! Initialisation of temprary arrys
+      IF( ln_p4z ) THEN
+         zremipoc(:,:,:) = xremip
+         zremigoc(:,:,:) = xremip
+      ELSE    ! ln_p5z
+         zremipoc(:,:,:) = xremipc
+         zremigoc(:,:,:) = xremipc
+      ENDIF
+      zorem3(:,:,:)   = 0.
+      orem  (:,:,:)   = 0.
+      ztremint(:,:,:) = 0.
+
+      DO jn = 1, jcpoc
+        alphag(:,:,:,jn) = alphan(jn)
+        alphap(:,:,:,jn) = alphan(jn)
+      END DO
+
+     ! -----------------------------------------------------------------------
+     ! Lability parameterization. This is the big particles part (GOC)
+     ! This lability parameterization can be activated only with the standard
+     ! particle scheme. Does not work with Kriest parameterization.
+     ! -----------------------------------------------------------------------
+     DO jk = 2, jpkm1
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF (tmask(ji,jj,jk) == 1.) THEN
+                zdep = hmld(ji,jj)
+                !
+                ! In the case of GOC, lability is constant in the mixed layer 
+                ! It is computed only below the mixed layer depth
+                ! ------------------------------------------------------------
+                !
+                IF( gdept_n(ji,jj,jk) > zdep ) THEN
+                  alphat = 0.
+                  remint = 0.
+                  !
+                  zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1)
+                  zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)
+                  !
+                  IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN
+                    ! 
+                    ! The first level just below the mixed layer needs a 
+                    ! specific treatment because lability is supposed constant
+                    ! everywhere within the mixed layer. This means that 
+                    ! change in lability in the bottom part of the previous cell
+                    ! should not be computed
+                    ! ----------------------------------------------------------
+                    !
+                    ! POC concentration is computed using the lagrangian 
+                    ! framework. It is only used for the lability param
+                    zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk) * rday / rfact2               &
+                    &   * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn)
+                    zpoc = MAX(0., zpoc)
+                    !
+                    DO jn = 1, jcpoc
+                       !
+                       ! Lagrangian based algorithm. The fraction of each 
+                       ! lability class is computed starting from the previous
+                       ! level
+                       ! -----------------------------------------------------
+                       !
+                       ! the concentration of each lability class is calculated
+                       ! as the sum of the different sources and sinks
+                       ! Please note that production of new GOC experiences
+                       ! degradation 
+                       alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc &
+                       &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             &
+                       &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 
+                       alphat = alphat + alphag(ji,jj,jk,jn)
+                       remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)
+                    END DO
+                  ELSE
+                    !
+                    ! standard algorithm in the rest of the water column
+                    ! See the comments in the previous block.
+                    ! ---------------------------------------------------
+                    !
+                    zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk-1) * rday / rfact2               &
+                    &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   &
+                    &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn)
+                    zpoc = max(0., zpoc)
+                    !
+                    DO jn = 1, jcpoc
+                       alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              &
+                       &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           &
+                       &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) &
+                       &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) 
+                       alphat = alphat + alphag(ji,jj,jk,jn)
+                       remint = remint + alphag(ji,jj,jk,jn) * reminp(jn)
+                    END DO
+                  ENDIF
+                  !
+                  DO jn = 1, jcpoc
+                     ! The contribution of each lability class at the current
+                     ! level is computed
+                     alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn)
+                  END DO
+                  ! Computation of the mean remineralisation rate
+                  ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) )
+                  !
+                ENDIF
+              ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( ln_p4z ) THEN   ;  zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
+      ELSE                ;  zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )
+      ENDIF
+
+      IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! POC disaggregation by turbulence and bacterial activity. 
+                  ! --------------------------------------------------------
+                  zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+                  zorem2  = zremig * trb(ji,jj,jk,jpgoc)
+                  orem(ji,jj,jk)      = zorem2
+                  zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc)
+                  zofer2 = zremig * trb(ji,jj,jk,jpbfe)
+                  zofer3 = zremig * solgoc * trb(ji,jj,jk,jpbfe)
+
+                  ! -------------------------------------
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk)
+                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk)
+                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3
+                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                   ! POC disaggregation by turbulence and bacterial activity. 
+                  ! --------------------------------------------------------
+                  zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+                  zopoc2 = zremig  * trb(ji,jj,jk,jpgoc)
+                  orem(ji,jj,jk) = zopoc2
+                  zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc)
+                  zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon)
+                  zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop)
+                  zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe)
+
+                  ! -------------------------------------
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk)
+                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2 
+                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2
+                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2
+                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2
+                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2
+                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk)
+                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc)
+                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc)
+                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 * (1. + solgoc)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+        WRITE(charout, FMT="('poc1')")
+        CALL prt_ctl_trc_info(charout)
+        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+     ENDIF
+
+     ! ------------------------------------------------------------------
+     ! Lability parameterization for the small OM particles. This param 
+     ! is based on the same theoretical background as the big particles.
+     ! However, because of its low sinking speed, lability is not supposed
+     ! to be equal to its initial value (the value of the freshly produced
+     ! organic matter). It is however uniform in the mixed layer.
+     ! -------------------------------------------------------------------
+     !
+     totprod(:,:) = 0.
+     totthick(:,:) = 0.
+     totcons(:,:) = 0.
+     ! intregrated production and consumption of POC in the mixed layer
+     ! ----------------------------------------------------------------
+     ! 
+     DO jk = 1, jpkm1
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              zdep = hmld(ji,jj)
+              IF (tmask(ji,jj,jk) == 1. .AND. gdept_n(ji,jj,jk) <= zdep ) THEN
+                totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2
+                ! The temperature effect is included here
+                totthick(ji,jj) = totthick(ji,jj) + e3t_n(ji,jj,jk)* tgfunc(ji,jj,jk)
+                totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2    &
+                &                / ( trb(ji,jj,jk,jppoc) + rtrn )
+              ENDIF
+           END DO
+        END DO
+     END DO
+
+     ! Computation of the lability spectrum in the mixed layer. In the mixed 
+     ! layer, this spectrum is supposed to be uniform.
+     ! ---------------------------------------------------------------------
+     DO jk = 1, jpkm1
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF (tmask(ji,jj,jk) == 1.) THEN
+                zdep = hmld(ji,jj)
+                alphat = 0.0
+                remint = 0.0
+                IF( gdept_n(ji,jj,jk) <= zdep ) THEN
+                   DO jn = 1, jcpoc
+                      ! For each lability class, the system is supposed to be 
+                      ! at equilibrium: Prod - Sink - w alphap = 0.
+                      alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    &
+                      &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn )
+                      alphat = alphat + alphap(ji,jj,jk,jn)
+                   END DO
+                   DO jn = 1, jcpoc
+                      alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn)
+                      remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)
+                   END DO
+                   ! Mean remineralization rate in the mixed layer
+                   ztremint(ji,jj,jk) =  MAX( 0., remint )
+                ENDIF
+              ENDIF
+           END DO
+        END DO
+     END DO
+     !
+     IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
+     ELSE                ;  zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )
+     ENDIF
+
+     ! -----------------------------------------------------------------------
+     ! The lability parameterization is used here. The code is here 
+     ! almost identical to what is done for big particles. The only difference
+     ! is that an additional source from GOC to POC is included. This means 
+     ! that since we need the lability spectrum of GOC, GOC spectrum 
+     ! should be determined before.
+     ! -----------------------------------------------------------------------
+     !
+     DO jk = 2, jpkm1
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF (tmask(ji,jj,jk) == 1.) THEN
+                zdep = hmld(ji,jj)
+                IF( gdept_n(ji,jj,jk) > zdep ) THEN
+                  alphat = 0.
+                  remint = 0.
+                  !
+                  ! the scale factors are corrected with temperature
+                  zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1)
+                  zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)
+                  !
+                  ! Special treatment of the level just below the MXL
+                  ! See the comments in the GOC section
+                  ! ---------------------------------------------------
+                  !
+                  IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN
+                    !
+                    ! Computation of the POC concentration using the 
+                    ! lagrangian algorithm
+                    zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk) * rday / rfact2               &
+                    &   * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn)
+                    zpoc = max(0., zpoc)
+                    ! 
+                    DO jn = 1, jcpoc
+                       ! computation of the lability spectrum applying the 
+                       ! different sources and sinks
+                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  &
+                       &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) &
+                       &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     &
+                       &   * zsizek ) )
+                       alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) )
+                       alphat = alphat + alphap(ji,jj,jk,jn)
+                    END DO
+                  ELSE
+                    !
+                    ! Lability parameterization for the interior of the ocean
+                    ! This is very similar to what is done in the previous 
+                    ! block
+                    ! --------------------------------------------------------
+                    !
+                    zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk-1) * rday / rfact2               &
+                    &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   &
+                    &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn)
+                    zpoc = max(0., zpoc)
+                    !
+                    DO jn = 1, jcpoc
+                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       &
+                       &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             & 
+                       &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      &
+                       &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  &
+                       &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 &
+                       &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   &
+                       &   - exp( -reminp(jn) * zsizek ) )
+                       alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) )
+                       alphat = alphat + alphap(ji,jj,jk,jn)
+                    END DO
+                  ENDIF
+                  ! Normalization of the lability spectrum so that the 
+                  ! integral is equal to 1
+                  DO jn = 1, jcpoc
+                     alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn)
+                     remint = remint + alphap(ji,jj,jk,jn) * reminp(jn)
+                  END DO
+                  ! Mean remineralization rate in the water column
+                  ztremint(ji,jj,jk) =  MAX( 0., remint )
+                ENDIF
+              ENDIF
+            END DO
+         END DO
+      END DO
+
+     IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )
+     ELSE                ;  zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )
+     ENDIF
+
+     IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF (tmask(ji,jj,jk) == 1.) THEN
+                    ! POC disaggregation by turbulence and bacterial activity. 
+                    ! --------------------------------------------------------
+                    zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+                    zorem           = zremip * trb(ji,jj,jk,jppoc)
+                    zofer           = zremip * trb(ji,jj,jk,jpsfe)
+
+                    tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem
+                    orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem
+                    tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer
+                    tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem
+                    tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
+                  ENDIF
+               END DO
+            END DO
+         END DO
+     ELSE
+       DO jk = 1, jpkm1
+          DO jj = 1, jpj
+             DO ji = 1, jpi
+                ! POC disaggregation by turbulence and bacterial activity. 
+                ! --------------------------------------------------------
+                zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk)
+                zopoc  = zremip * trb(ji,jj,jk,jppoc)
+                orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc
+                zopon  = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon)
+                zopop  = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop)
+                zofer  = xremipn / xremipc * zremip * trb(ji,jj,jk,jpsfe)
+
+                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc
+                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon
+                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop
+                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
+                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc
+                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon 
+                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop 
+                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
+             END DO
+           END DO
+        END DO
+     ENDIF
+
+     IF( lk_iomput ) THEN
+        IF( knt == nrdttrc ) THEN
+          zrfact2 = 1.e3 * rfact2r
+          CALL iom_put( "REMINP" , zremipoc(:,:,:) * tmask(:,:,:) )  ! Remineralisation rate
+          CALL iom_put( "REMING" , zremigoc(:,:,:) * tmask(:,:,:) )  ! Remineralisation rate
+        ENDIF
+     ENDIF
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('poc2')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      totprod,  totthick, totcons )
+      CALL wrk_dealloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3, ztremint )
+      DEALLOCATE( alphag )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_poc')
+      !
+   END SUBROUTINE p4z_poc
+
+
+   SUBROUTINE p4z_poc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_poc_init  ***
+      !!
+      !! ** Purpose :   Initialization of remineralization parameters
+      !!
+      !! ** Method  :   Read the nampispoc namelist and check the parameters
+      !!      called at the first timestep
+      !!
+      !! ** input   :   Namelist nampispoc
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: jn
+      REAL(wp) :: remindelta, reminup, remindown
+      INTEGER  :: ifault
+
+      NAMELIST/nampispoc/ xremip, jcpoc, rshape,  &
+         &     xremipc, xremipn, xremipp
+
+
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization
+      READ  ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization
+      READ  ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampispoc )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for remineralization, nampispoc'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         IF( ln_p4z ) THEN
+            WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip
+         ELSE
+            WRITE(numout,*) '    remineralisation rate of POC              xremipc   =', xremipc
+            WRITE(numout,*) '    remineralisation rate of PON              xremipn   =', xremipn
+            WRITE(numout,*) '    remineralisation rate of POP              xremipp   =', xremipp
+         ENDIF
+         WRITE(numout,*) '    Number of lability classes for POC        jcpoc     =', jcpoc
+         WRITE(numout,*) '    Shape factor of the gamma distribution    rshape    =', rshape
+      ENDIF
+      !
+      ! Discretization along the lability space
+      ! ---------------------------------------
+      !
+      ALLOCATE( alphan(jcpoc), reminp(jcpoc) )
+      ALLOCATE( alphap(jpi,jpj,jpk,jcpoc) )
+      !
+      IF (jcpoc > 1) THEN
+         !
+         remindelta = LOG(4. * 1000. ) / REAL(jcpoc-1, wp)
+         reminup = 1./ 400. * EXP(remindelta)
+         !
+         ! Discretization based on incomplete gamma functions
+         ! As incomplete gamma functions are not available in standard 
+         ! fortran 95, they have been coded as functions in this module (gamain)
+         ! ---------------------------------------------------------------------
+         !
+         alphan(1) = gamain(reminup, rshape, ifault)
+         reminp(1) = gamain(reminup, rshape+1.0, ifault) * xremip / alphan(1)
+         DO jn = 2, jcpoc-1
+            reminup = 1./ 400. * EXP( REAL(jn, wp) * remindelta)
+            remindown = 1. / 400. * EXP( REAL(jn-1, wp) * remindelta)
+            alphan(jn) = gamain(reminup, rshape, ifault) - gamain(remindown, rshape, ifault)
+            reminp(jn) = gamain(reminup, rshape+1.0, ifault) - gamain(remindown, rshape+1.0, ifault)
+            reminp(jn) = reminp(jn) * xremip / alphan(jn)
+         END DO
+         remindown = 1. / 400. * EXP( REAL(jcpoc-1, wp) * remindelta)
+         alphan(jcpoc) = 1.0 - gamain(remindown, rshape, ifault)
+         reminp(jcpoc) = 1.0 - gamain(remindown, rshape+1.0, ifault)
+         reminp(jcpoc) = reminp(jcpoc) * xremip / alphan(jcpoc)
+
+      ELSE
+         alphan(jcpoc) = 1.
+         reminp(jcpoc) = xremip
+      ENDIF
+
+      DO jn = 1, jcpoc
+         alphap(:,:,:,jn) = alphan(jn)
+      END DO
+
+   END SUBROUTINE p4z_poc_init
+
+   REAL FUNCTION alngam( xvalue, ifault )
+
+!*****************************************************************************80
+!
+!! ALNGAM computes the logarithm of the gamma function.
+!
+!  Modified:
+!
+!    13 January 2008
+!
+!  Author:
+!
+!    Allan Macleod
+!    FORTRAN90 version by John Burkardt
+!
+!  Reference:
+!
+!    Allan Macleod,
+!    Algorithm AS 245,
+!    A Robust and Reliable Algorithm for the Logarithm of the Gamma Function,
+!    Applied Statistics,
+!    Volume 38, Number 2, 1989, pages 397-402.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function.
+!
+!    Output, integer ( kind = 4 ) IFAULT, error flag.
+!    0, no error occurred.
+!    1, XVALUE is less than or equal to 0.
+!    2, XVALUE is too big.
+!
+!    Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X.
+!
+  implicit none
+
+  real(wp), parameter :: alr2pi = 0.918938533204673E+00
+  integer:: ifault
+  real(wp), dimension ( 9 ) :: r1 = (/ &
+    -2.66685511495E+00, &
+    -24.4387534237E+00, &
+    -21.9698958928E+00, &
+     11.1667541262E+00, &
+     3.13060547623E+00, &
+     0.607771387771E+00, &
+     11.9400905721E+00, &
+     31.4690115749E+00, &
+     15.2346874070E+00 /)
+  real(wp), dimension ( 9 ) :: r2 = (/ &
+    -78.3359299449E+00, &
+    -142.046296688E+00, &
+     137.519416416E+00, &
+     78.6994924154E+00, &
+     4.16438922228E+00, &
+     47.0668766060E+00, &
+     313.399215894E+00, &
+     263.505074721E+00, &
+     43.3400022514E+00 /)
+  real(wp), dimension ( 9 ) :: r3 = (/ &
+    -2.12159572323E+05, &
+     2.30661510616E+05, &
+     2.74647644705E+04, &
+    -4.02621119975E+04, &
+    -2.29660729780E+03, &
+    -1.16328495004E+05, &
+    -1.46025937511E+05, &
+    -2.42357409629E+04, &
+    -5.70691009324E+02 /)
+  real(wp), dimension ( 5 ) :: r4 = (/ &
+     0.279195317918525E+00, &
+     0.4917317610505968E+00, &
+     0.0692910599291889E+00, &
+     3.350343815022304E+00, &
+     6.012459259764103E+00 /)
+  real (wp) :: x
+  real (wp) :: x1
+  real (wp) :: x2
+  real (wp), parameter :: xlge = 5.10E+05
+  real (wp), parameter :: xlgst = 1.0E+30
+  real (wp) :: xvalue
+  real (wp) :: y
+
+  x = xvalue
+  alngam = 0.0E+00
+!
+!  Check the input.
+!
+  if ( xlgst <= x ) then
+    ifault = 2
+    return
+  end if
+  if ( x <= 0.0E+00 ) then
+    ifault = 1
+    return
+  end if
+
+  ifault = 0
+!
+!  Calculation for 0 < X < 0.5 and 0.5 <= X < 1.5 combined.
+!
+  if ( x < 1.5E+00 ) then
+
+    if ( x < 0.5E+00 ) then
+      alngam = - log ( x )
+      y = x + 1.0E+00
+!
+!  Test whether X < machine epsilon.
+!
+      if ( y == 1.0E+00 ) then
+        return
+      end if
+
+    else
+
+      alngam = 0.0E+00
+      y = x
+      x = ( x - 0.5E+00 ) - 0.5E+00
+
+    end if
+
+    alngam = alngam + x * (((( &
+        r1(5)   * y &
+      + r1(4) ) * y &
+      + r1(3) ) * y &
+      + r1(2) ) * y &
+      + r1(1) ) / (((( &
+                  y &
+      + r1(9) ) * y &
+      + r1(8) ) * y &
+      + r1(7) ) * y &
+      + r1(6) )
+
+    return
+
+  end if
+!
+!  Calculation for 1.5 <= X < 4.0.
+!
+  if ( x < 4.0E+00 ) then
+
+    y = ( x - 1.0E+00 ) - 1.0E+00
+
+    alngam = y * (((( &
+        r2(5)   * x &
+      + r2(4) ) * x &
+      + r2(3) ) * x &
+      + r2(2) ) * x &
+      + r2(1) ) / (((( &
+                  x &
+      + r2(9) ) * x &
+      + r2(8) ) * x &
+      + r2(7) ) * x &
+      + r2(6) )
+!
+!  Calculation for 4.0 <= X < 12.0.
+!
+  else if ( x < 12.0E+00 ) then
+
+    alngam = (((( &
+        r3(5)   * x &
+      + r3(4) ) * x &
+      + r3(3) ) * x &
+      + r3(2) ) * x &
+      + r3(1) ) / (((( &
+                  x &
+      + r3(9) ) * x &
+      + r3(8) ) * x &
+      + r3(7) ) * x &
+      + r3(6) )
+!
+!  Calculation for 12.0 <= X.
+!
+  else
+
+    y = log ( x )
+    alngam = x * ( y - 1.0E+00 ) - 0.5E+00 * y + alr2pi
+
+    if ( x <= xlge ) then
+
+      x1 = 1.0E+00 / x
+      x2 = x1 * x1
+
+      alngam = alngam + x1 * ( ( &
+             r4(3)   * &
+        x2 + r4(2) ) * &
+        x2 + r4(1) ) / ( ( &
+        x2 + r4(5) ) * &
+        x2 + r4(4) )
+
+    end if
+
+   end if
+
+   END FUNCTION alngam
+
+   REAL FUNCTION gamain( x, p, ifault )
+
+!*****************************************************************************80
+!
+!! GAMAIN computes the incomplete gamma ratio.
+!
+!  Discussion:
+!
+!    A series expansion is used if P > X or X <= 1.  Otherwise, a
+!    continued fraction approximation is used.
+!
+!  Modified:
+!
+!    17 January 2008
+!
+!  Author:
+!
+!    G Bhattacharjee
+!    FORTRAN90 version by John Burkardt
+!
+!  Reference:
+!
+!    G Bhattacharjee,
+!    Algorithm AS 32:
+!    The Incomplete Gamma Integral,
+!    Applied Statistics,
+!    Volume 19, Number 3, 1970, pages 285-287.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) X, P, the parameters of the incomplete 
+!    gamma ratio.  0 <= X, and 0 < P.
+!
+!    Output, integer ( kind = 4 ) IFAULT, error flag.
+!    0, no errors.
+!    1, P <= 0.
+!    2, X < 0.
+!    3, underflow.
+!    4, error return from the Log Gamma routine.
+!
+!    Output, real ( kind = 8 ) GAMAIN, the value of the incomplete
+!    gamma ratio.
+!
+  implicit none
+
+  real (wp) a
+  real (wp), parameter :: acu = 1.0E-08
+  real (wp) an
+  real (wp) arg
+  real (wp) b
+  real (wp) dif
+  real (wp) factor
+  real (wp) g
+  real (wp) gin
+  integer i
+  integer ifault
+  real (wp), parameter :: oflo = 1.0E+37
+  real (wp) p
+  real (wp) pn(6)
+  real (wp) rn
+  real (wp) term
+  real (wp), parameter :: uflo = 1.0E-37
+  real (wp) x
+!
+!  Check the input.
+!
+  if ( p <= 0.0E+00 ) then
+    ifault = 1
+    gamain = 0.0E+00
+    return
+  end if
+
+  if ( x < 0.0E+00 ) then
+    ifault = 2
+    gamain = 0.0E+00
+    return
+  end if
+
+  if ( x == 0.0E+00 ) then
+    ifault = 0
+    gamain = 0.0E+00
+    return
+  end if
+
+  g = alngam ( p, ifault )
+
+  if ( ifault /= 0 ) then
+    ifault = 4
+    gamain = 0.0E+00
+    return
+  end if
+
+  arg = p * log ( x ) - x - g
+
+  if ( arg < log ( uflo ) ) then
+    ifault = 3
+    gamain = 0.0E+00
+    return
+  end if
+
+  ifault = 0
+  factor = exp ( arg )
+!
+!  Calculation by series expansion.
+!
+  if ( x <= 1.0E+00 .or. x < p ) then
+
+    gin = 1.0E+00
+    term = 1.0E+00
+    rn = p
+
+    do
+
+      rn = rn + 1.0E+00
+      term = term * x / rn
+      gin = gin + term
+
+      if ( term <= acu ) then
+        exit
+      end if
+
+    end do
+
+    gamain = gin * factor / p
+    return
+
+  end if
+!
+!  Calculation by continued fraction.
+!
+  a = 1.0E+00 - p
+  b = a + x + 1.0E+00
+  term = 0.0E+00
+
+  pn(1) = 1.0E+00
+  pn(2) = x
+  pn(3) = x + 1.0E+00
+  pn(4) = x * b
+
+  gin = pn(3) / pn(4)
+
+  do
+
+    a = a + 1.0E+00
+    b = b + 2.0E+00
+    term = term + 1.0E+00
+    an = a * term
+    do i = 1, 2
+      pn(i+4) = b * pn(i+2) - an * pn(i)
+    end do
+
+    if ( pn(6) /= 0.0E+00 ) then
+
+      rn = pn(5) / pn(6)
+      dif = abs ( gin - rn )
+!
+!  Absolute error tolerance satisfied?
+!
+      if ( dif <= acu ) then
+!
+!  Relative error tolerance satisfied?
+!
+        if ( dif <= acu * rn ) then
+          gamain = 1.0E+00 - factor * gin
+          exit
+        end if
+
+      end if
+
+      gin = rn
+
+    end if
+
+    do i = 1, 4
+      pn(i) = pn(i+2)
+    end do
+    if ( oflo <= abs ( pn(5) ) ) then
+
+      do i = 1, 4
+        pn(i) = pn(i) / oflo
+      end do
+
+    end if
+
+  end do
+
+  END FUNCTION gamain
+
+   !!======================================================================
+END MODULE p4zpoc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90	(revision 8732)
@@ -0,0 +1,558 @@
+MODULE p4zprod
+   !!======================================================================
+   !!                         ***  MODULE p4zprod  ***
+   !! TOP :  Growth Rate of the two phytoplanktons groups 
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation
+   !!----------------------------------------------------------------------
+   !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups
+   !!   p4z_prod_init  :   Initialization of the parameters for growth
+   !!   p4z_prod_alloc :   Allocate variables for growth
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zlim          !  Co-limitations of differents nutrients
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_prod         ! called in p4zbio.F90
+   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90
+   PUBLIC   p4z_prod_alloc
+
+   !! * Shared module variables
+   LOGICAL , PUBLIC ::  ln_newprod      !:
+   REAL(wp), PUBLIC ::  pislopen         !:
+   REAL(wp), PUBLIC ::  pisloped        !:
+   REAL(wp), PUBLIC ::  xadap           !:
+   REAL(wp), PUBLIC ::  excretn          !:
+   REAL(wp), PUBLIC ::  excretd         !:
+   REAL(wp), PUBLIC ::  bresp           !:
+   REAL(wp), PUBLIC ::  chlcnm          !:
+   REAL(wp), PUBLIC ::  chlcdm          !:
+   REAL(wp), PUBLIC ::  chlcmin         !:
+   REAL(wp), PUBLIC ::  fecnm           !:
+   REAL(wp), PUBLIC ::  fecdm           !:
+   REAL(wp), PUBLIC ::  grosip          !:
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax    !: optimal production = f(temperature)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotan   !: proxy of N quota in Nanophyto
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee
+   
+   REAL(wp) :: r1_rday                !: 1 / rday
+   REAL(wp) :: texcretn               !: 1 - excretn 
+   REAL(wp) :: texcretd               !: 1 - excretd        
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zprod.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_prod( kt , knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_prod  ***
+      !!
+      !! ** Purpose :   Compute the phytoplankton production depending on
+      !!              light, temperature and nutrient availability
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) :: kt, knt
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zsilfac, znanotot, zdiattot, zconctemp, zconctemp2
+      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn
+      REAL(wp) ::   zprod, zproreg, zproreg2, zprochln, zprochld
+      REAL(wp) ::   zmaxday, zdocprod, zpislopen, zpisloped
+      REAL(wp) ::   zmxltst, zmxlday
+      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n
+      REAL(wp) ::   zfact
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zw2d, zmixnano, zmixdiat
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d   
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch   
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_prod')
+      !
+      !  Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn )
+      CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )
+      CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )
+      !
+      zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
+      zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp
+      zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp
+      zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp 
+      zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 
+
+      ! Computation of the optimal production
+      prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 
+
+      ! compute the day length depending on latitude and the day
+      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
+      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
+
+      ! day length in hours
+      zstrn(:,:) = 0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
+            zargu = MAX( -1., MIN(  1., zargu ) )
+            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+         END DO
+      END DO
+
+      ! Impact of the day duration and light intermittency on phytoplankton growth
+      DO jk = 1, jpkm1
+         DO jj = 1 ,jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  zval = MAX( 1., zstrn(ji,jj) )
+                  IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN
+                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
+                  ENDIF
+                  zmxl_chl(ji,jj,jk) = zval / 24.
+                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:)
+      zprdia(:,:,:) = zprbio(:,:,:)
+
+      ! Maximum light intensity
+      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
+
+      ! Computation of the P-I slope for nanos and diatoms
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
+                  zadap       = xadap * ztn / ( 2.+ ztn )
+                  zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+                  zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
+                  !
+                  zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  &
+                  &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
+                  !
+                  zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   &
+                  &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( ln_newprod ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                      ! Computation of production function for Carbon
+                      !  ---------------------------------------------
+                      zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
+                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
+                      zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
+                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
+                      !  Computation of production function for Chlorophyll
+                      !--------------------------------------------------
+                      zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
+                      zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                      ! Computation of production function for Carbon
+                      !  ---------------------------------------------
+                      zpislopen = zpislopeadn(ji,jj,jk)  / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
+                      zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
+                      !  Computation of production function for Chlorophyll
+                      !--------------------------------------------------
+                      zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                      zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !  Computation of a proxy of the N/C ratio
+      !  ---------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   &
+                &      * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
+                quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
+                zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   &
+                &      * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
+                quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
+            END DO
+         END DO
+      END DO
+
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                   !    Si/C of diatoms
+                   !    ------------------------
+                   !    Si/C increases with iron stress and silicate availability
+                   !    Si/C is arbitrariliy increased for very high Si concentrations
+                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
+                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
+                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
+                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
+                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
+                  IF (gphit(ji,jj) < -30 ) THEN
+                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
+                  ELSE
+                    zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
+                  ENDIF
+                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
+              ENDIF
+            END DO
+         END DO
+      END DO
+
+      !  Mixed-layer effect on production 
+      !  Sea-ice effect on production
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+            END DO
+         END DO
+      END DO
+
+      ! Computation of the various production terms 
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  !  production terms for nanophyto. (C)
+                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
+                  zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
+                  !
+                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn )
+                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
+                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
+                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
+                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
+                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2
+                  !  production terms for diatoms (C)
+                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
+                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
+                  !
+                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn )
+                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
+                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
+                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
+                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
+                  &             * zmax * trb(ji,jj,jk,jpdia) * rfact2
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Computation of the chlorophyll production terms
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  !  production terms for nanophyto. ( chlorophyll )
+                  znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
+                  zprochln = chlcmin * 12. * zprorcan (ji,jj,jk)
+                  chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.))
+                  zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / &
+                                        & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn)
+                  !  production terms for diatoms ( chlorophyll )
+                  zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
+                  zprochld = chlcmin * 12. * zprorcad(ji,jj,jk)
+                  chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.))
+                  zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / &
+                                        & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn )
+                  !   Update the arrays TRA which contain the Chla sources and sinks
+                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn
+                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd
+               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
+              IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                 zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk)
+                 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
+                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
+                 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
+                 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)
+                 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2
+                 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn
+                 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn
+                 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd
+                 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd
+                 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
+                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod
+                 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
+                 &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) )
+                 !
+                 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
+                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup
+                 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
+                 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
+                 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
+                 &                                         - rno3 * ( zproreg + zproreg2 )
+              ENDIF
+           END DO
+        END DO
+     END DO
+     !
+     IF( ln_ligand ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+              DO ji =1 ,jpi
+                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                    zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
+                    zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
+                    tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
+                 ENDIF
+              END DO
+           END DO
+        END DO
+     ENDIF
+
+
+    ! Total primary production per year
+    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
+         & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
+
+    IF( lk_iomput ) THEN
+       IF( knt == nrdttrc ) THEN
+          CALL wrk_alloc( jpi, jpj,      zw2d )
+          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+          !
+          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN
+              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto
+              CALL iom_put( "PPPHYN"  , zw3d )
+              !
+              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes
+              CALL iom_put( "PPPHYD"  , zw3d )
+          ENDIF
+          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN
+              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto
+              CALL iom_put( "PPNEWN"  , zw3d )
+              !
+              zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes
+              CALL iom_put( "PPNEWD"  , zw3d )
+          ENDIF
+          IF( iom_use( "PBSi" ) )  THEN
+              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production
+              CALL iom_put( "PBSi"  , zw3d )
+          ENDIF
+          IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) )  THEN
+              zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto
+              CALL iom_put( "PFeN"  , zw3d )
+              !
+              zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes
+              CALL iom_put( "PFeD"  , zw3d )
+          ENDIF
+          IF( iom_use( "Mumax" ) )  THEN
+              zw3d(:,:,:) = prmax(:,:,:) * tmask(:,:,:)   ! Maximum growth rate
+              CALL iom_put( "Mumax"  , zw3d )
+          ENDIF
+          IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) )  THEN
+              zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto
+              CALL iom_put( "MuN"  , zw3d )
+              !
+              zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms
+              CALL iom_put( "MuD"  , zw3d )
+          ENDIF
+          IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) )  THEN
+              zw3d(:,:,:) = zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term
+              CALL iom_put( "LNlight"  , zw3d )
+              !
+              zw3d(:,:,:) =  zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term
+              CALL iom_put( "LDlight"  , zw3d )
+          ENDIF
+          IF( iom_use( "TPP" ) )  THEN
+              zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production
+              CALL iom_put( "TPP"  , zw3d )
+          ENDIF
+          IF( iom_use( "TPNEW" ) )  THEN
+              zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production
+              CALL iom_put( "TPNEW"  , zw3d )
+          ENDIF
+          IF( iom_use( "TPBFE" ) )  THEN
+              zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  ! total biogenic iron production
+              CALL iom_put( "TPBFE"  , zw3d )
+          ENDIF
+          IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN  
+             zw2d(:,:) = 0.
+             DO jk = 1, jpkm1
+               zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano
+             ENDDO
+             CALL iom_put( "INTPPPHYN" , zw2d )
+             !
+             zw2d(:,:) = 0.
+             DO jk = 1, jpkm1
+                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom
+             ENDDO
+             CALL iom_put( "INTPPPHYD" , zw2d )
+          ENDIF
+          IF( iom_use( "INTPP" ) ) THEN   
+             zw2d(:,:) = 0.
+             DO jk = 1, jpkm1
+                zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp
+             ENDDO
+             CALL iom_put( "INTPP" , zw2d )
+          ENDIF
+          IF( iom_use( "INTPNEW" ) ) THEN    
+             zw2d(:,:) = 0.
+             DO jk = 1, jpkm1
+                zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod
+             ENDDO
+             CALL iom_put( "INTPNEW" , zw2d )
+          ENDIF
+          IF( iom_use( "INTPBFE" ) ) THEN           !   total biogenic iron production  ( vertically integrated )
+             zw2d(:,:) = 0.
+             DO jk = 1, jpkm1
+                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod
+             ENDDO
+            CALL iom_put( "INTPBFE" , zw2d )
+          ENDIF
+          IF( iom_use( "INTPBSI" ) ) THEN           !   total biogenic silica production  ( vertically integrated )
+             zw2d(:,:) = 0.
+             DO jk = 1, jpkm1
+                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod
+             ENDDO
+             CALL iom_put( "INTPBSI" , zw2d )
+          ENDIF
+          IF( iom_use( "tintpp" ) )  CALL iom_put( "tintpp" , tpp * zfact )  !  global total integrated primary production molC/s
+          !
+          CALL wrk_dealloc( jpi, jpj,      zw2d )
+          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+       ENDIF
+     ENDIF
+
+     IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('prod')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+     ENDIF
+     !
+     CALL wrk_dealloc( jpi, jpj,  zmixnano, zmixdiat,    zstrn )
+     CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 
+     CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )
+     CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )
+     !
+     IF( nn_timing == 1 )  CALL timing_stop('p4z_prod')
+     !
+   END SUBROUTINE p4z_prod
+
+
+   SUBROUTINE p4z_prod_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_prod_init  ***
+      !!
+      !! ** Purpose :   Initialization of phytoplankton production parameters
+      !!
+      !! ** Method  :   Read the nampisprod namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampisprod
+      !!----------------------------------------------------------------------
+      !
+      NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd,  &
+         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production
+      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production
+      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zprod )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod    =', ln_newprod
+         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip
+         WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen
+         WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap
+         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn
+         WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd
+         IF( ln_newprod )  THEN
+            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp
+            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin
+         ENDIF
+         WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped
+         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm
+         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm
+         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm
+         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm        =', fecdm
+      ENDIF
+      !
+      r1_rday   = 1._wp / rday 
+      texcretn  = 1._wp - excretn
+      texcretd  = 1._wp - excretd
+      tpp       = 0._wp
+      !
+   END SUBROUTINE p4z_prod_init
+
+
+   INTEGER FUNCTION p4z_prod_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_prod_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc )
+      !
+      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_prod_alloc
+   !!======================================================================
+END MODULE p4zprod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90	(revision 8732)
@@ -0,0 +1,352 @@
+MODULE p4zrem
+   !!======================================================================
+   !!                         ***  MODULE p4zrem  ***
+   !! TOP :   PISCES Compute remineralization/dissolution of organic compounds
+   !!=========================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
+   !!----------------------------------------------------------------------
+   !!   p4z_rem       :  Compute remineralization/dissolution of organic compounds
+   !!   p4z_rem_init  :  Initialisation of parameters for remineralisation
+   !!   p4z_rem_alloc :  Allocate remineralisation variables
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zche          !  chemical model
+   USE p4zprod         !  Growth rate of the 2 phyto groups
+   USE p4zlim
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_rem         ! called in p4zbio.F90
+   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90
+   PUBLIC   p4z_rem_alloc
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  xremikc    !: remineralisation rate of DOC 
+   REAL(wp), PUBLIC ::  xremikn    !: remineralisation rate of DON 
+   REAL(wp), PUBLIC ::  xremikp    !: remineralisation rate of DOP 
+   REAL(wp), PUBLIC ::  xremik     !: remineralisation rate of POC 
+   REAL(wp), PUBLIC ::  nitrif     !: NH4 nitrification rate 
+   REAL(wp), PUBLIC ::  xsirem     !: remineralisation rate of POC 
+   REAL(wp), PUBLIC ::  xsiremlab  !: fast remineralisation rate of POC 
+   REAL(wp), PUBLIC ::  xsilab     !: fraction of labile biogenic silica 
+   REAL(wp), PUBLIC ::  feratb     !: Fe/C quota in bacteria
+   REAL(wp), PUBLIC ::  xkferb     !: Half-saturation constant for bacteria Fe/C
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zrem.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_rem( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_rem  ***
+      !!
+      !! ** Purpose :   Compute remineralization/scavenging of organic compounds
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zremik, zremikc, zremikn, zremikp, zsiremin, zfact 
+      REAL(wp) ::   zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep
+      REAL(wp) ::   zbactfer, zolimit, zonitr, zrfact2
+      REAL(wp) ::   zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_rem')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      ztempbac                  )
+      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )
+
+      ! Initialisation of temprary arrys
+      zdepprod(:,:,:) = 1._wp
+      ztempbac(:,:)   = 0._wp
+      zfacsib(:,:,:)  = xsilab / ( 1.0 - xsilab )
+      zfacsi(:,:,:)   = xsilab
+
+      ! Computation of the mean phytoplankton concentration as
+      ! a crude estimate of the bacterial biomass
+      ! this parameterization has been deduced from a model version
+      ! that was modeling explicitely bacteria
+      ! -------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdep = MAX( hmld(ji,jj), heup(ji,jj) )
+               IF( gdept_n(ji,jj,jk) < zdep ) THEN
+                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
+                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
+               ELSE
+                  zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) )
+                  zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
+                  zdepprod(ji,jj,jk) = zdepmin**0.273
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( ln_p4z ) THEN
+         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) * zdepbac(ji,jj,jk) 
+                  zremik = MAX( zremik, 2.74e-4 * xstep )
+                  ! Ammonification in oxic waters with oxygen consumption
+                  ! -----------------------------------------------------
+                  zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
+                  zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
+                  ! Ammonification in suboxic waters with denitrification
+                  ! -------------------------------------------------------
+                  denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
+                     &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  )
+                  !
+                  zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
+                  denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
+                  !
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk)    &
+                  &                     + ( rdenit + 1.) * denitr(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+      ELSE
+         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 = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 
+                  zremik = MAX( zremik, 2.74e-4 * xstep / xremikc )
+
+                  zremikc = xremikc * zremik
+                  zremikn = xremikn / xremikc
+                  zremikp = xremikp / xremikc
+
+                  ! Ammonification in oxic waters with oxygen consumption
+                  ! -----------------------------------------------------
+                  zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
+                  zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) ) 
+                  zolimi(ji,jj,jk) = zolimic
+                  zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
+                  zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
+
+                  ! Ammonification in suboxic waters with denitrification
+                  ! -------------------------------------------------------
+                  zolimit = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)
+                  denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, zolimit )
+                  denitr(ji,jj,jk) = MAX( 0.e0, denitr(ji,jj,jk) )
+                  zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
+                  zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )
+
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn
+                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + ( rdenit + 1.) * zdenitrn )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+
+
+      DO jk = 1, jpkm1
+         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 * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  &
+               &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 
+               zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)
+               ! Update of the tracers trends
+               ! ----------------------------
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4
+               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4
+            END DO
+         END DO
+      END DO
+
+       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rem1')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            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
+               ! ----------------------------------------------------------
+               zbactfer = feratb *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             &
+                  &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    &
+                  &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk)
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.16
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.12
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.04
+            END DO
+         END DO
+      END DO
+
+       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rem2')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+
+      ! Initialization of the array which contains the labile fraction
+      ! of bSi. Set to a constant in the upper ocean
+      ! ---------------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) )
+               zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) )
+               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
+               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25
+               ! Remineralization rate of BSi depedant on T and saturation
+               ! ---------------------------------------------------------
+               IF ( gdept_n(ji,jj,jk) > zdep ) THEN
+                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  &
+                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) )
+                  zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) )
+                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    &
+                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) )
+               ENDIF
+               zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil
+               zosil    = zsiremin * trb(ji,jj,jk,jpgsi)
+               !
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil
+               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil
+               !
+            END DO
+         END DO
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rem3')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+
+      IF( knt == nrdttrc ) THEN
+          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+          !
+          IF( iom_use( "REMIN" ) )  THEN
+              zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact !  Remineralisation rate
+              CALL iom_put( "REMIN"  , zw3d )
+          ENDIF
+          IF( iom_use( "DENIT" ) )  THEN
+              zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification
+              CALL iom_put( "DENIT"  , zw3d )
+          ENDIF
+          !
+          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+       ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      ztempbac                  )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_rem')
+      !
+   END SUBROUTINE p4z_rem
+
+
+   SUBROUTINE p4z_rem_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_rem_init  ***
+      !!
+      !! ** Purpose :   Initialization of remineralization parameters
+      !!
+      !! ** Method  :   Read the nampisrem namelist and check the parameters
+      !!      called at the first timestep
+      !!
+      !! ** input   :   Namelist nampisrem
+      !!
+      !!----------------------------------------------------------------------
+      NAMELIST/nampisrem/ xremik, nitrif, xsirem, xsiremlab, xsilab, feratb, xkferb, & 
+         &                xremikc, xremikn, xremikp
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization
+      READ  ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization
+      READ  ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampisrem )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         IF( ln_p4z ) THEN
+            WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik
+         ELSE
+            WRITE(numout,*) '    remineralization rate of DOC              xremikc   =', xremikc
+            WRITE(numout,*) '    remineralization rate of DON              xremikn   =', xremikn
+            WRITE(numout,*) '    remineralization rate of DOP              xremikp   =', xremikp
+         ENDIF
+         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem
+         WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab
+         WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab
+         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif
+         WRITE(numout,*) '    Bacterial Fe/C ratio                      feratb    =', feratb
+         WRITE(numout,*) '    Half-saturation constant for bact. Fe/C   xkferb    =', xkferb
+      ENDIF
+      !
+      denitr  (:,:,:) = 0._wp
+      !
+   END SUBROUTINE p4z_rem_init
+
+
+   INTEGER FUNCTION p4z_rem_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_rem_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc )
+      !
+      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays')
+      !
+   END FUNCTION p4z_rem_alloc
+
+   !!======================================================================
+END MODULE p4zrem
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90	(revision 8732)
@@ -0,0 +1,542 @@
+MODULE p4zsbc
+   !!======================================================================
+   !!                         ***  MODULE p4sbc  ***
+   !! TOP :   PISCES surface boundary conditions of external inputs of nutrients
+   !!======================================================================
+   !! History :   3.5  !  2012-07 (O. Aumont, C. Ethe) Original code
+   !!----------------------------------------------------------------------
+   !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes
+   !!   p4z_sbc_init   :  Initialization of p4z_sbc
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE iom             !  I/O manager
+   USE fldread         !  time interpolation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_sbc
+   PUBLIC   p4z_sbc_init   
+
+   LOGICAL , PUBLIC  :: ln_dust     !: boolean for dust input from the atmosphere
+   LOGICAL , PUBLIC  :: ln_solub    !: boolean for variable solubility of atmospheric iron
+   LOGICAL , PUBLIC  :: ln_river    !: boolean for river input of nutrients
+   LOGICAL , PUBLIC  :: ln_ndepo    !: boolean for atmospheric deposition of N
+   LOGICAL , PUBLIC  :: ln_ironsed  !: boolean for Fe input from sediments
+   LOGICAL , PUBLIC  :: ln_hydrofe  !: boolean for Fe input from hydrothermal vents
+   LOGICAL , PUBLIC  :: ln_ironice  !: boolean for Fe input from sea ice
+   REAL(wp), PUBLIC  :: sedfeinput  !: Coastal release of Iron
+   REAL(wp), PUBLIC  :: dustsolub   !: Solubility of the dust
+   REAL(wp), PUBLIC  :: mfrac       !: Mineral Content of the dust
+   REAL(wp), PUBLIC  :: icefeinput  !: Iron concentration in sea ice
+   REAL(wp), PUBLIC  :: wdust       !: Sinking speed of the dust 
+   REAL(wp), PUBLIC  :: nitrfix     !: Nitrogen fixation rate   
+   REAL(wp), PUBLIC  :: diazolight  !: Nitrogen fixation sensitivty to light 
+   REAL(wp), PUBLIC  :: concfediaz  !: Fe half-saturation Cste for diazotrophs 
+   REAL(wp)          :: hratio      !: Fe:3He ratio assumed for vent iron supply
+   REAL(wp), PUBLIC  :: fep_rats    !: Fep/Fer ratio from sed  sources
+   REAL(wp), PUBLIC  :: fep_rath    !: Fep/Fer ratio from hydro sources
+   REAL(wp), PUBLIC  :: lgw_rath    !: Weak ligand ratio from hydro sources
+
+
+   LOGICAL , PUBLIC  :: ll_sbc
+
+   LOGICAL  ::  ll_solub
+
+   INTEGER , PARAMETER  :: jpriv  = 7   !: Maximum number of river input fields
+   INTEGER , PARAMETER  :: jr_dic = 1   !: index of dissolved inorganic carbon
+   INTEGER , PARAMETER  :: jr_doc = 2   !: index of dissolved organic carbon
+   INTEGER , PARAMETER  :: jr_din = 3   !: index of dissolved inorganic nitrogen
+   INTEGER , PARAMETER  :: jr_don = 4   !: index of dissolved organic nitrogen
+   INTEGER , PARAMETER  :: jr_dip = 5   !: index of dissolved inorganic phosporus
+   INTEGER , PARAMETER  :: jr_dop = 6   !: index of dissolved organic phosphorus
+   INTEGER , PARAMETER  :: jr_dsi = 7   !: index of dissolved silicate
+
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_solub      ! structure of input dust
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_river  ! structure of input riverdic
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_hydrofe   ! structure of input iron from hydrothermal vents
+
+   INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file
+   INTEGER  :: ntimes_dust, ntimes_riv, ntimes_ndep       ! number of time steps in a file
+   INTEGER  :: ntimes_solub, ntimes_hydro                 ! number of time steps in a file
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust, solub       !: dust fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdic, rivalk    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdin, rivdip    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdon, rivdop    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdoc    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdsi    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed   !: Coastal supply of iron
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe   !: Hydrothermal vent supply of iron
+
+   REAL(wp), PUBLIC :: sumdepsi, rivalkinput, rivdicinput, nitdepinput
+   REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput
+
+   !! * Substitutions
+#  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 p4z_sbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_sbc  ***
+      !!
+      !! ** purpose :   read and interpolate the external sources of nutrients
+      !!
+      !! ** method  :   read the files and interpolate the appropriate variables
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * local declarations
+      INTEGER  :: ji,jj 
+      REAL(wp) :: zcoef, zyyss
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc')
+
+      !
+      ! Compute dust at nit000 or only if there is more than 1 time record in dust file
+      IF( ln_dust ) THEN
+         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
+            CALL fld_read( kt, 1, sf_dust )
+            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN
+               dust(:,:) = sf_dust(1)%fnow(:,:,1)
+            ELSE
+               dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      IF( ll_solub ) THEN
+         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN
+            CALL fld_read( kt, 1, sf_solub )
+            solub(:,:) = sf_solub(1)%fnow(:,:,1)
+         ENDIF
+      ENDIF
+
+      ! N/P and Si releases due to coastal rivers
+      ! Compute river at nit000 or only if there is more than 1 time record in river file
+      ! -----------------------------------------
+      IF( ln_river ) THEN
+         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN
+            CALL fld_read( kt, 1, sf_river )
+            IF( ln_p4z ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
+                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
+                        &              * 1.E3        / ( 12. * zcoef + rtrn )
+                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) &
+                        &              * 1.E3         / ( 12. * zcoef + rtrn )
+                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
+                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
+                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    &
+                        &              * 1.E3        / ( 28.1 * zcoef + rtrn )
+                  END DO
+               END DO
+            ELSE    !  ln_p5z
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
+                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
+                        &              * 1.E3        / ( 12. * zcoef + rtrn )
+                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdoc(ji,jj) = ( sf_river(jr_doc)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file
+      IF( ln_ndepo ) THEN
+         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN
+             zcoef = rno3 * 14E6 * ryyss
+             CALL fld_read( kt, 1, sf_ndepo )
+             nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 
+         ENDIF
+         IF( .NOT.ln_linssh ) THEN
+           zcoef = rno3 * 14E6 * ryyss
+           nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc')
+      !
+   END SUBROUTINE p4z_sbc
+
+   SUBROUTINE p4z_sbc_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_sbc_init  ***
+      !!
+      !! ** purpose :   initialization of the external sources of nutrients
+      !!
+      !! ** method  :   read the files and compute the budget
+      !!                called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   external netcdf files
+      !!
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  :: ji, jj, jk, jm, ifpr
+      INTEGER  :: ii0, ii1, ij0, ij1
+      INTEGER  :: numdust, numsolub, numriv, numiron, numdepo, numhydro
+      INTEGER  :: ierr, ierr1, ierr2, ierr3
+      INTEGER  :: ios                 ! Local integer output status for namelist read
+      INTEGER  :: ik50                !  last level where depth less than 50 m
+      INTEGER  :: isrow             ! index for ORCA1 starting row
+      REAL(wp) :: zexpide, zdenitide, zmaskt
+      REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 
+      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriver, zcmask
+      !
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION(jpriv) ::  slf_river    ! array of namelist informations on the fields to read
+      TYPE(FLD_N) ::   sn_dust, sn_solub, sn_ndepo, sn_ironsed, sn_hydrofe   ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_riverdoc, sn_riverdic, sn_riverdsi   ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop
+      !
+      NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon,     &
+        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, &
+        &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    &
+        &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, &
+        &                hratio, fep_rats, fep_rath, lgw_rath
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc_init')
+      !
+      !                            !* set file information
+      REWIND( numnatp_ref )              ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients
+      READ  ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients
+      READ  ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampissbc )
+
+      IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr
+            WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead '
+            WRITE(numout,*) ' ln_ironice is forced to .FALSE. '
+            ln_ironice = .FALSE.
+         ENDIF
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' namelist : nampissbc '
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
+         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust
+         WRITE(numout,*) '    Variable solubility of iron input        ln_solub    = ', ln_solub
+         WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river
+         WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo
+         WRITE(numout,*) '    Fe input from sediments                  ln_ironsed  = ', ln_ironsed
+         WRITE(numout,*) '    Fe input from seaice                     ln_ironice  = ', ln_ironice
+         WRITE(numout,*) '    fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe
+         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput
+         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub
+         WRITE(numout,*) '    Mineral Fe content of the dust           mfrac       = ', mfrac
+         WRITE(numout,*) '    Iron concentration in sea ice            icefeinput  = ', icefeinput
+         WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust
+         WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix
+         WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight
+         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz
+         WRITE(numout,*) '    Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
+         IF( ln_ligand ) THEN
+            WRITE(numout,*) '    Fep/Fer ratio from sed sources            fep_rats   = ', fep_rats
+            WRITE(numout,*) '    Fep/Fer ratio from sed hydro sources      fep_rath   = ', fep_rath
+            WRITE(numout,*) '    Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath
+         ENDIF
+      END IF
+
+      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN  ;  ll_sbc = .TRUE.
+      ELSE                                            ;  ll_sbc = .FALSE.
+      ENDIF
+
+      IF( ln_dust .AND. ln_solub ) THEN               ;  ll_solub = .TRUE.
+      ELSE                                            ;  ll_solub = .FALSE.
+      ENDIF
+
+      ! set the number of level over which river runoffs are applied 
+      ! online configuration : computed in sbcrnf
+      IF( l_offline ) THEN
+        nk_rnf(:,:) = 1
+        h_rnf (:,:) = gdept_n(:,:,1)
+      ENDIF
+
+      ! dust input from the atmosphere
+      ! ------------------------------
+      IF( ln_dust ) THEN 
+         !
+         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+         !
+         ALLOCATE( dust(jpi,jpj) )    ! allocation
+         !
+         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
+         !
+         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
+                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
+         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
+         !
+         IF( Agrif_Root() ) THEN   !  Only on the master grid
+            ! Get total input dust ; need to compute total atmospheric supply of Si in a year
+            CALL iom_open (  TRIM( sn_dust%clname ) , numdust )
+            CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file
+            ALLOCATE( zdust(jpi,jpj,ntimes_dust) )
+            DO jm = 1, ntimes_dust
+               CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm )
+            END DO
+            CALL iom_close( numdust )
+            ztimes_dust = 1._wp / REAL(ntimes_dust, wp) 
+            sumdepsi = 0.e0
+            DO jm = 1, ntimes_dust
+               sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust )
+            ENDDO
+            sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1 
+            DEALLOCATE( zdust)
+         ENDIF
+      ELSE
+         sumdepsi  = 0._wp
+      END IF
+
+      ! Solubility of dust deposition of iron
+      ! Only if ln_dust and ln_solubility set to true (ll_solub = .true.)
+      ! -----------------------------------------------------------------
+      IF( ll_solub ) THEN
+         !
+         IF(lwp) WRITE(numout,*) '    initialize variable solubility of Fe '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+         !
+         ALLOCATE( solub(jpi,jpj) )    ! allocation
+         !
+         ALLOCATE( sf_solub(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_solub structure' )
+         !
+         CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sed_init', 'Solubility of atm. iron ', 'nampissed' )
+                                   ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1)   )
+         IF( sn_solub%ln_tint )    ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) )
+         ! get number of record in file
+         CALL iom_open (  TRIM( sn_solub%clname ) , numsolub )
+         CALL iom_gettime( numsolub, zsteps, kntime=ntimes_solub)  ! get number of record in file
+         CALL iom_close( numsolub )
+      ENDIF
+
+      ! nutrient input from rivers
+      ! --------------------------
+      IF( ln_river ) THEN
+         !
+         slf_river(jr_dic) = sn_riverdic  ;  slf_river(jr_doc) = sn_riverdoc  ;  slf_river(jr_din) = sn_riverdin 
+         slf_river(jr_don) = sn_riverdon  ;  slf_river(jr_dip) = sn_riverdip  ;  slf_river(jr_dop) = sn_riverdop
+         slf_river(jr_dsi) = sn_riverdsi  
+         !
+         ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj) ) 
+         IF( ln_p5z )  ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj), rivdoc(jpi,jpj) )
+         !
+         ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )           !* allocate and fill sf_river (forcing structure) with sn_river_
+         rivinput(:) = 0.0
+
+         IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' )
+         !
+         CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sed_init', 'Input from river ', 'nampissed' )
+         DO ifpr = 1, jpriv
+                                          ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1  ) )
+            IF( slf_river(ifpr)%ln_tint ) ALLOCATE( sf_river(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
+         IF( Agrif_Root() ) THEN   !  Only on the master grid
+            ! Get total input rivers ; need to compute total river supply in a year
+            DO ifpr = 1, jpriv
+               CALL iom_open ( TRIM( slf_river(ifpr)%clname ), numriv )
+               CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv)
+               ALLOCATE( zriver(jpi,jpj,ntimes_riv) )
+               DO jm = 1, ntimes_riv
+                  CALL iom_get( numriv, jpdom_data, TRIM( slf_river(ifpr)%clvar ), zriver(:,:,jm), jm )
+               END DO
+               CALL iom_close( numriv )
+               ztimes_riv = 1._wp / REAL(ntimes_riv, wp) 
+               DO jm = 1, ntimes_riv
+                  rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) 
+               END DO
+               DEALLOCATE( zriver)
+            END DO
+            ! N/P and Si releases due to coastal rivers
+            ! -----------------------------------------
+            rivdicinput = (rivinput(jr_dic) + rivinput(jr_doc) ) * 1E3 / 12._wp
+            rivdininput = (rivinput(jr_din) + rivinput(jr_don) ) * 1E3 / rno3 / 14._wp
+            rivdipinput = (rivinput(jr_dip) + rivinput(jr_dop) ) * 1E3 / po4r / 31._wp
+            rivdsiinput = rivinput(jr_dsi) * 1E3 / 28.1_wp
+            rivalkinput = rivinput(jr_dic) * 1E3 / 12._wp
+            !
+         ENDIF
+      ELSE
+         rivdicinput = 0._wp
+         rivdininput = 0._wp
+         rivdipinput = 0._wp
+         rivdsiinput = 0._wp
+         rivalkinput = 0._wp
+      END IF 
+      ! nutrient input from dust
+      ! ------------------------
+      IF( ln_ndepo ) THEN
+         !
+         IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc'
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         !
+         ALLOCATE( nitdep(jpi,jpj) )    ! allocation
+         !
+         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_ndepo structure' )
+         !
+         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Nutrient atmospheric depositon ', 'nampissed' )
+                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   )
+         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) )
+         !
+         IF( Agrif_Root() ) THEN   !  Only on the master grid
+            ! Get total input dust ; need to compute total atmospheric supply of N in a year
+            CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo )
+            CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep)
+            ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) )
+            DO jm = 1, ntimes_ndep
+               CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm )
+            END DO
+            CALL iom_close( numdepo )
+            ztimes_ndep = 1._wp / REAL(ntimes_ndep, wp) 
+            nitdepinput = 0._wp
+            DO jm = 1, ntimes_ndep
+              nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_ndep )
+            ENDDO
+            nitdepinput = nitdepinput / rno3 / 14E6 
+            DEALLOCATE( zndepo)
+         ENDIF
+      ELSE
+         nitdepinput = 0._wp
+      ENDIF
+
+      ! coastal and island masks
+      ! ------------------------
+      IF( ln_ironsed ) THEN     
+         !
+         IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron'
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         !
+         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation
+         !
+         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
+         ALLOCATE( zcmask(jpi,jpj,jpk) )
+         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
+         CALL iom_close( numiron )
+         !
+         ik50 = 5        !  last level where depth less than 50 m
+         DO jk = jpkm1, 1, -1
+            IF( gdept_1d(jk) > 50. )  ik50 = jk - 1
+         END DO
+         IF (lwp) WRITE(numout,*)
+         IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
+         IF (lwp) WRITE(numout,*)
+         DO jk = 1, ik50
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  IF( tmask(ji,jj,jk) /= 0. ) THEN
+                     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. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) ) 
+                  END IF
+               END DO
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
+         !
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) )
+                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
+                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
+               END DO
+            END DO
+         END DO
+         ! Coastal supply of iron
+         ! -------------------------
+         ironsed(:,:,jpk) = 0._wp
+         DO jk = 1, jpkm1
+            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
+         END DO
+         DEALLOCATE( zcmask)
+      ENDIF
+      !
+      ! Iron from Hydrothermal vents
+      ! ------------------------
+      IF( ln_hydrofe ) THEN
+         !
+         IF(lwp) WRITE(numout,*) '    Input of iron from hydrothermal vents '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         !
+         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation
+         !
+         CALL iom_open ( TRIM( sn_hydrofe%clname ), numhydro )
+         CALL iom_get  ( numhydro, jpdom_data, TRIM( sn_hydrofe%clvar ), hydrofe(:,:,:), 1 )
+         CALL iom_close( numhydro )
+         !
+         DO jk = 1, jpk
+            hydrofe(:,:,jk) = ( hydrofe(:,:,jk) * hratio ) / ( e1e2t(:,:) * e3t_0(:,:,jk) * ryyss + rtrn ) / 1000._wp
+         ENDDO
+         !
+      ENDIF
+      ! 
+      IF( ll_sbc ) CALL p4z_sbc( nit000 ) 
+      !
+      IF(lwp) THEN 
+         WRITE(numout,*)
+         WRITE(numout,*) '    Total input of elements from river supply'
+         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    N Supply   : ', rivdininput*rno3*1E3/1E12*14.,' TgN/yr'
+         WRITE(numout,*) '    Si Supply  : ', rivdsiinput*1E3/1E12*28.1,' TgSi/yr'
+         WRITE(numout,*) '    P Supply   : ', rivdipinput*1E3*po4r/1E12*31.,' TgP/yr'
+         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr'
+         WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12,'TgC/yr'
+         WRITE(numout,*) 
+         WRITE(numout,*) '    Total input of elements from atmospheric supply'
+         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    N Supply   : ', nitdepinput*rno3*1E3/1E12*14.,' TgN/yr'
+         WRITE(numout,*) 
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc_init')
+      !
+   END SUBROUTINE p4z_sbc_init
+
+   !!======================================================================
+END MODULE p4zsbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90	(revision 8732)
@@ -0,0 +1,542 @@
+MODULE p4zsed
+   !!======================================================================
+   !!                         ***  MODULE p4sed  ***
+   !! TOP :   PISCES Compute loss of organic matter in the sediments
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (O. Aumont) Original code
+   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06 (C. Ethe) USE of fldread
+   !!             3.5  !  2012-07 (O. Aumont) improvment of river input of nutrients 
+   !!----------------------------------------------------------------------
+   !!   p4z_sed        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zlim          !  Co-limitations of differents nutrients
+   USE p4zsbc          !  External source of nutrients 
+   USE p4zint          !  interpolation and computation of various fields
+   USE iom             !  I/O manager
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_sed  
+   PUBLIC   p4z_sed_alloc
+ 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments
+   REAL(wp) :: r1_rday                  !: inverse of rday
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_sed( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sed  ***
+      !!
+      !! ** Purpose :   Compute loss of organic matter in the sediments. This
+      !!              is by no way a sediment model. The loss is simply 
+      !!              computed to balance the inout from rivers and dust
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER  ::   ji, jj, jk, ikt
+      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
+      REAL(wp) ::   zrivalk, zrivsil, zrivno3
+      REAL(wp) ::  zwflux, zfminus, zfplus
+      REAL(wp) ::  zlim, zfact, zfactcal
+      REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zdenitt, zolimit
+      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep
+      REAL(wp) ::  zwstpoc, zwstpon, zwstpop
+      REAL(wp) ::  ztrfer, ztrpo4s, ztrdp, zwdust, zmudia, ztemp
+      REAL(wp) ::  xdiano3, xdianh4
+      REAL(wp) ::  zwssfep
+      !
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsidep, zwork1, zwork2, zwork3
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsedcal, zsedsi, zsedc
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsfep
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sed')
+      !
+      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday
+      !
+      ! Allocate temporary workspace
+                      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
+                      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
+                      CALL wrk_alloc( jpi, jpj, zsedcal,  zsedsi, zsedc )
+                      CALL wrk_alloc( jpi, jpj, jpk, zlight, zsoufer )
+      IF( ln_p5z )    CALL wrk_alloc( jpi, jpj, jpk, ztrpo4, ztrdop )
+      IF( ln_ligand ) CALL wrk_alloc( jpi, jpj, zwsfep )
+
+
+      zdenit2d(:,:) = 0.e0
+      zbureff (:,:) = 0.e0
+      zwork1  (:,:) = 0.e0
+      zwork2  (:,:) = 0.e0
+      zwork3  (:,:) = 0.e0
+      zsedsi  (:,:) = 0.e0
+      zsedcal (:,:) = 0.e0
+      zsedc   (:,:) = 0.e0
+
+
+      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
+      ! ----------------------------------------------------
+      IF( ln_ironice ) THEN  
+         !                                              
+         CALL wrk_alloc( jpi, jpj, zironice )
+         !                                              
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdep    = rfact2 / e3t_n(ji,jj,1)
+               zwflux  = fmmflx(ji,jj) / 1000._wp
+               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
+               zfplus  = MAX( 0._wp, -zwflux ) * icefeinput * zdep
+               zironice(ji,jj) =  zfplus + zfminus
+            END DO
+         END DO
+         !
+         tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 
+         ! 
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   &
+            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
+         !
+         CALL wrk_dealloc( jpi, jpj, zironice )
+         !                                              
+      ENDIF
+
+      ! Add the external input of nutrients from dust deposition
+      ! ----------------------------------------------------------
+      IF( ln_dust ) THEN
+         !                                              
+         CALL wrk_alloc( jpi, jpj,      zsidep )
+         CALL wrk_alloc( jpi, jpj, jpk, zpdep, zirondep      )
+         !                                              ! Iron and Si deposition at the surface
+         IF( ln_solub ) THEN
+            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
+         ELSE
+            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
+         ENDIF
+         zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 
+         zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 
+         !                                              ! Iron solubilization of particles in the water column
+         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
+         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
+         DO jk = 2, jpkm1
+            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. )
+            zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023
+         END DO
+         !                                              ! Iron solubilization of particles in the water column
+         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:)
+         tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep   (:,:,:)
+         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 
+         ! 
+         IF( lk_iomput ) THEN
+            IF( knt == nrdttrc ) THEN
+                IF( iom_use( "Irondep" ) )   &
+                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
+                IF( iom_use( "pdust" ) )   &
+                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface
+            ENDIF
+         ENDIF
+         CALL wrk_dealloc( jpi, jpj,      zsidep )
+         CALL wrk_dealloc( jpi, jpj, jpk, zpdep, zirondep      )
+         !                                              
+      ENDIF
+     
+      ! Add the external input of nutrients from river
+      ! ----------------------------------------------------------
+      IF( ln_river ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, nk_rnf(ji,jj)
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2
+                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
+               ENDDO
+            ENDDO
+         ENDDO
+         IF( ln_p5z ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, nk_rnf(ji,jj)
+                     tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2
+                     tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2
+                     tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + rivdoc(ji,jj) * rfact2
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+      
+      ! Add the external input of nutrients from nitrogen deposition
+      ! ----------------------------------------------------------
+      IF( ln_ndepo ) THEN
+         tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
+         tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
+      ENDIF
+
+      ! Add the external input of iron from sediment mobilization
+      ! ------------------------------------------------------
+      IF( ln_ironsed ) THEN
+                         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
+         IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2
+         !
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
+            &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
+      ENDIF
+
+      ! Add the external input of iron from hydrothermal vents
+      ! ------------------------------------------------------
+      IF( ln_hydrofe ) THEN
+            tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
+         IF( ln_ligand ) THEN
+            tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2
+            tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2
+         ENDIF
+         !
+         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   &
+            &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
+      ENDIF
+
+      ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments
+      ! --------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt  = mbkt(ji,jj)
+            zdep = e3t_n(ji,jj,ikt) / xstep
+            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
+            zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) )
+            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
+         END DO
+      END DO
+      !
+      IF( ln_ligand ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = e3t_n(ji,jj,ikt) / xstep
+               zwsfep(ji,jj)  = MIN( 0.99 * zdep, wsfep(ji,jj,ikt)  )
+            END DO
+         ENDDO
+      ENDIF
+
+      IF( .NOT.lk_sed ) THEN
+         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
+         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
+         ! -------------------------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( tmask(ji,jj,1) == 1 ) THEN
+                 ikt = mbkt(ji,jj)
+                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
+                 zflx  = LOG10( MAX( 1E-3, zflx ) )
+                 zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
+                 zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
+                 zdep  = LOG10( gdepw_n(ji,jj,ikt+1) )
+                 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
+                   &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
+                 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
+                   !
+                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
+                 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
+                ENDIF
+              END DO
+           END DO 
+
+           ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 
+           ! First, the total loss is computed.
+           ! The factor for calcite comes from the alkalinity effect
+           ! -------------------------------------------------------------
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 IF( tmask(ji,jj,1) == 1 ) THEN
+                    ikt = mbkt(ji,jj) 
+                    zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
+                    zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
+                    ! For calcite, burial efficiency is made a function of saturation
+                    zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
+                    zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
+                    zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
+                ENDIF
+            END DO
+         END DO
+         zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday
+         zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday
+         zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday
+         !
+      ENDIF
+
+      ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean.
+      ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers)
+      ! ------------------------------------------------------
+      IF( .NOT.lk_sed )  zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / e3t_n(ji,jj,ikt) 
+            zwsc = zwscal (ji,jj) * zdep
+            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
+            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
+            !
+            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
+            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
+         END DO
+      END DO
+      !
+      IF( .NOT.lk_sed ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = xstep / e3t_n(ji,jj,ikt) 
+               zwsc = zwscal (ji,jj) * zdep
+               zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
+               zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
+               tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
+               !
+               zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
+               zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
+               zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
+               tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
+               tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+               zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss / zdep
+               zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss / zdep
+            END DO
+         END DO
+      ENDIF
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / e3t_n(ji,jj,ikt) 
+            zws4 = zwsbio4(ji,jj) * zdep
+            zws3 = zwsbio3(ji,jj) * zdep
+            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 
+            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
+            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+         END DO
+      END DO
+      !
+      IF( ln_ligand ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt     = mbkt(ji,jj)
+               zdep    = xstep / e3t_n(ji,jj,ikt) 
+               zwssfep = zwsfep(ji,jj) * zdep
+               tra(ji,jj,ikt,jpfep) = tra(ji,jj,ikt,jpfep) - trb(ji,jj,ikt,jpfep) * zwssfep
+            END DO
+         END DO
+      ENDIF
+      !
+      IF( ln_p5z ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = xstep / e3t_n(ji,jj,ikt) 
+               zws4 = zwsbio4(ji,jj) * zdep
+               zws3 = zwsbio3(ji,jj) * zdep
+               tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4
+               tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3
+               tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4
+               tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3
+            END DO
+         END DO
+      ENDIF
+
+      IF( .NOT.lk_sed ) THEN
+         ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
+         ! in the sediments and just above the sediments. Not very clever, but simpliest option.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = xstep / e3t_n(ji,jj,ikt) 
+               zws4 = zwsbio4(ji,jj) * zdep
+               zws3 = zwsbio3(ji,jj) * zdep
+               zrivno3 = 1. - zbureff(ji,jj)
+               zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
+               zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+               z1pdenit = zwstpoc * zrivno3 - zpdenit
+               zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+               zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
+               tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
+               tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
+               tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
+               tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
+               tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
+               tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
+               tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
+               sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt)
+               zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc / zdep
+               IF( ln_p5z ) THEN
+                  zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3
+                  zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3
+                  tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + (z1pdenit - zolimit - zdenitt) * zwstpon / (zwstpoc + rtrn)
+                  tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + (z1pdenit - zolimit - zdenitt) * zwstpop / (zwstpoc + rtrn)
+               ENDIF
+            END DO
+         END DO
+       ENDIF
+
+
+      ! Nitrogen fixation process
+      ! Small source iron from particulate inorganic iron
+      !-----------------------------------
+      DO jk = 1, jpkm1
+         zlight (:,:,jk) =  ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 
+         zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) )
+      ENDDO
+      IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !                      ! Potential nitrogen fixation dependant on temperature and iron
+                  zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
+                  IF( zlim <= 0.2 )   zlim = 0.01
+                  zfact = zlim * rfact2
+
+                  ztrfer  = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       )
+                  ztrpo4s = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) ) 
+                  nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
+                    &                *  zfact * MIN( ztrfer, ztrpo4s ) * zlight(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE       ! p5z
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !                      ! Potential nitrogen fixation dependant on temperature and iron
+                  ztemp = tsn(ji,jj,jk,jp_tem)
+                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
+                  !       Potential nitrogen fixation dependant on temperature and iron
+                  xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) )
+                  xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4)
+                  zlim = ( 1.- xdiano3 - xdianh4 )
+                  IF( zlim <= 0.1 )   zlim = 0.01
+                  zfact = zlim * rfact2
+                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
+                  ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) )
+                  ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk))
+                  ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk)
+                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Nitrogen change due to nitrogen fixation
+      ! ----------------------------------------
+      IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfact = nitrpot(ji,jj,jk) * nitrfix
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact 
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
+                  &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
+              END DO
+            END DO 
+         END DO
+      ELSE    ! p5z
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfact = nitrpot(ji,jj,jk) * nitrfix
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) &
+                  &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0
+                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  &
+                  &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   &
+                  &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0
+                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0
+                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0
+                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0
+                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0
+                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
+                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
+                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+              END DO
+            END DO 
+         END DO
+         !
+      ENDIF
+
+      IF( lk_iomput ) THEN
+         IF( knt == nrdttrc ) THEN
+            zfact = 1.e+3 * rfact2r * rno3  !  conversion from molC/l/kt  to molN/m3/s
+            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation 
+            IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated )
+               zwork1(:,:) = 0.
+               DO jk = 1, jpkm1
+                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk)
+               ENDDO
+               CALL iom_put( "INTNFIX" , zwork1 ) 
+            ENDIF
+            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * 1.e+3 )
+            IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * 1.e+3 )
+            IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * 1.e+3 )
+            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * 1.e+3 * rno3 )
+         ENDIF
+      ENDIF
+      !
+      IF(ln_ctl) THEN  ! print mean trends (USEd for debugging)
+         WRITE(charout, fmt="('sed ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+                      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
+                      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
+                      CALL wrk_dealloc( jpi, jpj, zsedcal,  zsedsi, zsedc )
+                      CALL wrk_dealloc( jpi, jpj, jpk, zlight, zsoufer )
+      IF( ln_p5z )    CALL wrk_dealloc( jpi, jpj, jpk, ztrpo4, ztrdop )
+      IF( ln_ligand ) CALL wrk_dealloc( jpi, jpj, zwsfep )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed')
+      !
+   END SUBROUTINE p4z_sed
+
+
+   INTEGER FUNCTION p4z_sed_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sed_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
+      !
+      IF( p4z_sed_alloc /= 0 )   CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
+      !
+   END FUNCTION p4z_sed_alloc
+
+
+   !!======================================================================
+END MODULE p4zsed
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90	(revision 8732)
@@ -0,0 +1,422 @@
+MODULE p4zsink
+   !!======================================================================
+   !!                         ***  MODULE p4zsink  ***
+   !! TOP :  PISCES  vertical flux of particulate matter due to gravitational sinking
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Change aggregation formula
+   !!             3.5  !  2012-07  (O. Aumont) Introduce potential time-splitting
+   !!----------------------------------------------------------------------
+   !!   p4z_sink       :  Compute vertical flux of particulate matter due to gravitational sinking
+   !!   p4z_sink_init  :  Unitialisation of sinking speed parameters
+   !!   p4z_sink_alloc :  Allocate sinking speed variables
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_sink         ! called in p4zbio.F90
+   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90
+   PUBLIC   p4z_sink_alloc
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinking, sinking2  !: POC sinking fluxes 
+   !                                                          !  (different meanings depending on the parameterization)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkingn, sinking2n  !: POC sinking fluxes 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkingp, sinking2p  !: POC sinking fluxes 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer            !: Small BFe sinking fluxes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfep      !: Fep sinking fluxes
+
+   INTEGER  :: ik100
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zsink.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!----------------------------------------------------------------------
+   !!   'standard sinking parameterisation'                  ???
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE p4z_sink ( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sink  ***
+      !!
+      !! ** Purpose :   Compute vertical flux of particulate matter due to 
+      !!                gravitational sinking
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt, knt
+      INTEGER  ::   ji, jj, jk, jit
+      INTEGER  ::   iiter1, iiter2
+      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4
+      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3
+      REAL(wp) ::   zfact, zwsmax, zmax
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sink')
+
+
+      ! Initialization of some global variables
+      ! ---------------------------------------
+      prodpoc(:,:,:) = 0.
+      conspoc(:,:,:) = 0.
+      prodgoc(:,:,:) = 0.
+      consgoc(:,:,:) = 0.
+
+      !
+      !    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
+               zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) )
+               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale
+               wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact
+            END DO
+         END DO
+      END DO
+
+      ! limit the values of the sinking speeds to avoid numerical instabilities  
+      wsbio3(:,:,:) = wsbio
+
+      !
+      ! OA This is (I hope) a temporary solution for the problem that may 
+      ! OA arise in specific situation where the CFL criterion is broken 
+      ! OA for vertical sedimentation of particles. To avoid this, a time
+      ! OA splitting algorithm has been coded. A specific maximum
+      ! OA iteration number is provided and may be specified in the namelist 
+      ! OA This is to avoid very large iteration number when explicit free
+      ! OA surface is used (for instance). When niter?max is set to 1, 
+      ! OA this computation is skipped. The crude old threshold method is 
+      ! OA then applied. This also happens when niter exceeds nitermax.
+      IF( MAX( niter1max, niter2max ) == 1 ) THEN
+        iiter1 = 1
+        iiter2 = 1
+      ELSE
+        iiter1 = 1
+        iiter2 = 1
+        DO jk = 1, jpkm1
+          DO jj = 1, jpj
+             DO ji = 1, jpi
+                IF( tmask(ji,jj,jk) == 1) THEN
+                   zwsmax =  0.5 * e3t_n(ji,jj,jk) / xstep
+                   iiter1 =  MAX( iiter1, INT( wsbio3(ji,jj,jk) / zwsmax ) )
+                   iiter2 =  MAX( iiter2, INT( wsbio4(ji,jj,jk) / zwsmax ) )
+                ENDIF
+             END DO
+          END DO
+        END DO
+        IF( lk_mpp ) THEN
+           CALL mpp_max( iiter1 )
+           CALL mpp_max( iiter2 )
+        ENDIF
+        iiter1 = MIN( iiter1, niter1max )
+        iiter2 = MIN( iiter2, niter2max )
+      ENDIF
+
+      DO jk = 1,jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) == 1 ) THEN
+                 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep
+                 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * REAL( iiter1, wp ) )
+                 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * REAL( iiter2, wp ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      wscal (:,:,:) = wsbio4(:,:,:)
+
+      !  Initializa to zero all the sinking arrays 
+      !   -----------------------------------------
+      sinking (:,:,:) = 0.e0
+      sinking2(:,:,:) = 0.e0
+      sinkcal (:,:,:) = 0.e0
+      sinkfer (:,:,:) = 0.e0
+      sinksil (:,:,:) = 0.e0
+      sinkfer2(:,:,:) = 0.e0
+
+      !   Compute the sedimentation term using p4zsink2 for all the sinking particles
+      !   -----------------------------------------------------
+      DO jit = 1, iiter1
+        CALL p4z_sink2( wsbio3, sinking , jppoc, iiter1 )
+        CALL p4z_sink2( wsbio3, sinkfer , jpsfe, iiter1 )
+      END DO
+
+      DO jit = 1, iiter2
+        CALL p4z_sink2( wsbio4, sinking2, jpgoc, iiter2 )
+        CALL p4z_sink2( wsbio4, sinkfer2, jpbfe, iiter2 )
+        CALL p4z_sink2( wsbio4, sinksil , jpgsi, iiter2 )
+        CALL p4z_sink2( wscal , sinkcal , jpcal, iiter2 )
+      END DO
+
+      IF( ln_p5z ) THEN
+         sinkingn (:,:,:) = 0.e0
+         sinking2n(:,:,:) = 0.e0
+         sinkingp (:,:,:) = 0.e0
+         sinking2p(:,:,:) = 0.e0
+
+         !   Compute the sedimentation term using p4zsink2 for all the sinking particles
+         !   -----------------------------------------------------
+         DO jit = 1, iiter1
+           CALL p4z_sink2( wsbio3, sinkingn , jppon, iiter1 )
+           CALL p4z_sink2( wsbio3, sinkingp , jppop, iiter1 )
+         END DO
+
+         DO jit = 1, iiter2
+           CALL p4z_sink2( wsbio4, sinking2n, jpgon, iiter2 )
+           CALL p4z_sink2( wsbio4, sinking2p, jpgop, iiter2 )
+         END DO
+      ENDIF
+
+      IF( ln_ligand ) THEN
+         wsfep (:,:,:) = wfep
+         DO jk = 1,jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( tmask(ji,jj,jk) == 1 ) THEN
+                    zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep
+                    wsfep(ji,jj,jk) = MIN( wsfep(ji,jj,jk), zwsmax * REAL( iiter1, wp ) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+         sinkfep(:,:,:) = 0.e0
+         DO jit = 1, iiter1
+           CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 )
+         END DO
+      ENDIF
+
+     ! Total carbon export per year
+     IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
+        &   t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
+     !
+     IF( lk_iomput ) THEN
+       IF( knt == nrdttrc ) THEN
+          CALL wrk_alloc( jpi, jpj,      zw2d )
+          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+          !
+          IF( iom_use( "EPC100" ) )  THEN
+              zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m
+              CALL iom_put( "EPC100"  , zw2d )
+          ENDIF
+          IF( iom_use( "EPFE100" ) )  THEN
+              zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m
+              CALL iom_put( "EPFE100"  , zw2d )
+          ENDIF
+          IF( iom_use( "EPCAL100" ) )  THEN
+              zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m
+              CALL iom_put( "EPCAL100"  , zw2d )
+          ENDIF
+          IF( iom_use( "EPSI100" ) )  THEN
+              zw2d(:,:) =  sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m
+              CALL iom_put( "EPSI100"  , zw2d )
+          ENDIF
+          IF( iom_use( "EXPC" ) )  THEN
+              zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column
+              CALL iom_put( "EXPC"  , zw3d )
+          ENDIF
+          IF( iom_use( "EXPFE" ) )  THEN
+              zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron 
+              CALL iom_put( "EXPFE"  , zw3d )
+          ENDIF
+          IF( iom_use( "EXPCAL" ) )  THEN
+              zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 
+              CALL iom_put( "EXPCAL"  , zw3d )
+          ENDIF
+          IF( iom_use( "EXPSI" ) )  THEN
+              zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica
+              CALL iom_put( "EXPSI"  , zw3d )
+          ENDIF
+          IF( iom_use( "tcexp" ) )  CALL iom_put( "tcexp" , t_oce_co2_exp * zfact )   ! molC/s
+          ! 
+          CALL wrk_dealloc( jpi, jpj,      zw2d )
+          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+        ENDIF
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sink')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink')
+      !
+   END SUBROUTINE p4z_sink
+
+   SUBROUTINE p4z_sink_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_sink_init  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: jk
+
+      ik100 = 10        !  last level where depth less than 100 m
+      DO jk = jpkm1, 1, -1
+         IF( gdept_1d(jk) > 100. )  ik100 = jk - 1
+      END DO
+      IF (lwp) WRITE(numout,*)
+      IF (lwp) WRITE(numout,*) ' Level corresponding to 100m depth ',  ik100 + 1
+      IF (lwp) WRITE(numout,*)
+      !
+      t_oce_co2_exp = 0._wp
+      !
+   END SUBROUTINE p4z_sink_init
+
+   SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra, kiter )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sink2  ***
+      !!
+      !! ** Purpose :   Compute the sedimentation terms for the various sinking
+      !!     particles. The scheme used to compute the trends is based
+      !!     on MUSCL.
+      !!
+      !! ** Method  : - this ROUTINE compute not exactly the advection but the
+      !!      transport term, i.e.  div(u*tra).
+      !!---------------------------------------------------------------------
+      !
+      INTEGER , INTENT(in   )                         ::   jp_tra    ! tracer index index      
+      INTEGER , INTENT(in   )                         ::   kiter     ! number of iterations for time-splitting 
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwsink    ! sinking speed
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   psinkflx  ! sinking fluxe
+      !!
+      INTEGER  ::   ji, jj, jk, jn
+      REAL(wp) ::   zigma,zew,zign, zflx, zstep
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2, ztrb 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sink2')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )
+
+      zstep = rfact2 / REAL( kiter, wp ) / 2.
+
+      ztraz(:,:,:) = 0.e0
+      zakz (:,:,:) = 0.e0
+      ztrb (:,:,:) = trb(:,:,:,jp_tra)
+
+      DO jk = 1, jpkm1
+         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 
+      END DO
+      zwsink2(:,:,1) = 0.e0
+
+
+      ! Vertical advective flux
+      DO jn = 1, 2
+         !  first guess of the slopes interior values
+         DO jk = 2, jpkm1
+            ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk)
+         END DO
+         ztraz(:,:,1  ) = 0.0
+         ztraz(:,:,jpk) = 0.0
+
+         ! slopes
+         DO jk = 2, jpkm1
+            DO jj = 1,jpj
+               DO ji = 1, jpi
+                  zign = 0.25 + SIGN( 0.25, ztraz(ji,jj,jk) * ztraz(ji,jj,jk+1) )
+                  zakz(ji,jj,jk) = ( ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign
+               END DO
+            END DO
+         END DO
+         
+         ! Slopes limitation
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zakz(ji,jj,jk) = SIGN( 1., zakz(ji,jj,jk) ) *        &
+                     &             MIN( ABS( zakz(ji,jj,jk) ), 2. * ABS(ztraz(ji,jj,jk+1)), 2. * ABS(ztraz(ji,jj,jk) ) )
+               END DO
+            END DO
+         END DO
+         
+         ! vertical advective flux
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj      
+               DO ji = 1, jpi    
+                  zigma = zwsink2(ji,jj,jk+1) * zstep / e3w_n(ji,jj,jk+1)
+                  zew   = zwsink2(ji,jj,jk+1)
+                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
+               END DO
+            END DO
+         END DO
+         !
+         ! Boundary conditions
+         psinkflx(:,:,1  ) = 0.e0
+         psinkflx(:,:,jpk) = 0.e0
+         
+         DO jk=1,jpkm1
+            DO jj = 1,jpj
+               DO ji = 1, jpi
+                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
+                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx
+               END DO
+            END DO
+         END DO
+
+      ENDDO
+
+      DO jk = 1,jpkm1
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
+               ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx
+            END DO
+         END DO
+      END DO
+
+      trb(:,:,:,jp_tra) = ztrb(:,:,:)
+      psinkflx(:,:,:)   = 2. * psinkflx(:,:,:)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink2')
+      !
+   END SUBROUTINE p4z_sink2
+
+
+   INTEGER FUNCTION p4z_sink_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sink_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(3)
+
+      ierr(:) = 0
+      !
+      ALLOCATE( sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                    ,     &                
+         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                    ,     &                
+         &      sinkfer2(jpi,jpj,jpk)                                           ,     &                
+         &      sinkfer(jpi,jpj,jpk)                                            , STAT=ierr(1) )                
+         !
+      IF( ln_ligand ) ALLOCATE( sinkfep(jpi,jpj,jpk)                            , STAT=ierr(2) )  
+         
+      IF( ln_p5z    ) ALLOCATE( sinkingn(jpi,jpj,jpk), sinking2n(jpi,jpj,jpk)   ,     &
+         &                      sinkingp(jpi,jpj,jpk), sinking2p(jpi,jpj,jpk)   , STAT=ierr(3) )
+      !
+      p4z_sink_alloc = MAXVAL( ierr )
+      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_sink_alloc
+   
+   !!======================================================================
+END MODULE p4zsink
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90	(revision 8732)
@@ -0,0 +1,558 @@
+MODULE p4zsms
+   !!======================================================================
+   !!                         ***  MODULE p4zsms  ***
+   !! TOP :   PISCES Source Minus Sink manager
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!----------------------------------------------------------------------
+   !!   p4zsms         :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE trcdta
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zbio          !  Biological model
+   USE p4zche          !  Chemical model
+   USE p4zlys          !  Calcite saturation
+   USE p4zflx          !  Gas exchange
+   USE p4zsbc          !  External source of nutrients
+   USE p4zsed          !  Sedimentation
+   USE p4zint          !  time interpolation
+   USE p4zrem          !  remineralisation
+   USE iom             !  I/O manager
+   USE trd_oce         !  Ocean trends variables
+   USE trdtrc          !  TOP trends variables
+   USE sedmodel        !  Sediment model
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_sms_init   ! called in p4zsms.F90
+   PUBLIC   p4z_sms        ! called in p4zsms.F90
+
+   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
+   REAL(wp) :: xfact1, xfact2, xfact3
+   INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget
+
+   !!* Array used to indicate negative tracer values
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ???
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zsms.F90 3320 2012-03-05 16:37:52Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_sms( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sms  ***
+      !!
+      !! ** Purpose :   Managment of the call to Biological sources and sinks 
+      !!              routines of PISCES bio-model
+      !!
+      !! ** Method  : - at each new day ...
+      !!              - several calls of bio and sed ???
+      !!              - ...
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      INTEGER ::   ji, jj, jk, jnt, jn, jl
+      REAL(wp) ::  ztra
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sms')
+      !
+      IF( kt == nittrc000 ) THEN
+        !
+        ALLOCATE( xnegtr(jpi,jpj,jpk) )
+        !
+        CALL p4z_che                              ! initialize the chemical constants
+        !
+        IF( .NOT. ln_rsttr ) THEN  ;   CALL ahini_for_at(hi)   !  set PH at kt=nit000 
+        ELSE                       ;   CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields 
+        ENDIF
+        !
+      ENDIF
+      !
+      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
+      !
+      rfact = r2dttrc
+      !
+      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
+         rfactr  = 1. / rfact
+         rfact2  = rfact / REAL( nrdttrc, wp )
+         rfact2r = 1. / rfact2
+         xstep = rfact2 / rday         ! Time step duration for biology
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt
+         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
+         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter
+            trb(:,:,:,jn) = trn(:,:,:,jn)
+         END DO
+      ENDIF
+      !
+      IF( ndayflxtr /= nday_year ) THEN      ! New days
+         !
+         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
+         CALL p4z_int( kt )        ! computation of various rates for biogeochemistry
+         !
+      ENDIF
+
+      IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients 
+
+      DO jnt = 1, nrdttrc          ! Potential time splitting if requested
+         !
+         CALL p4z_bio( kt, jnt )   ! Biology
+         CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation
+         CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions
+         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes
+         !
+         xnegtr(:,:,:) = 1.e0
+         DO jn = jp_pcs0, jp_pcs1
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
+                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
+                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
+                     ENDIF
+                 END DO
+               END DO
+            END DO
+         END DO
+         !                                ! where at least 1 tracer concentration becomes negative
+         !                                ! 
+         DO jn = jp_pcs0, jp_pcs1
+           trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
+         END DO
+        !
+         DO jn = jp_pcs0, jp_pcs1
+            tra(:,:,:,jn) = 0._wp
+         END DO
+         !
+         IF( ln_top_euler ) THEN
+            DO jn = jp_pcs0, jp_pcs1
+               trn(:,:,:,jn) = trb(:,:,:,jn)
+            END DO
+         ENDIF
+      END DO
+
+      !
+      IF( l_trdtrc ) THEN
+         DO jn = jp_pcs0, jp_pcs1
+           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
+         END DO
+      END IF
+      !
+      IF( lk_sed ) THEN 
+         !
+         CALL sed_model( kt )     !  Main program of Sediment model
+         !
+         DO jn = jp_pcs0, jp_pcs1
+           CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
+         END DO
+         !
+      ENDIF
+      !
+      IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file 
+      !
+
+      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt ) ! Mass conservation checking
+
+      IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH    ( numonp )     ! flush output namelist PISCES
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sms')
+      !
+      !
+   END SUBROUTINE p4z_sms
+
+   SUBROUTINE p4z_sms_init
+      !!----------------------------------------------------------------------
+      !!                     ***  p4z_sms_init  ***  
+      !!
+      !! ** Purpose :   read PISCES namelist
+      !!
+      !! ** input   :   file 'namelist.trc.s' containing the following
+      !!             namelist: natext, natbio, natsms
+      !!----------------------------------------------------------------------
+      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale,    &
+         &                   niter1max, niter2max, wfep, ldocp, ldocz, lthet,  &
+         &                   no3rat3, po4rat3
+
+      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
+      NAMELIST/nampismass/ ln_check_mass
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables
+      READ  ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables
+      READ  ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampisbio )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' Namelist : nampisbio'
+         WRITE(numout,*) '    frequence pour la biologie                nrdttrc    =', nrdttrc
+         WRITE(numout,*) '    POC sinking speed                         wsbio      =', wsbio
+         WRITE(numout,*) '    half saturation constant for mortality    xkmort     =', xkmort 
+         IF( ln_p5z ) THEN
+            WRITE(numout,*) '    N/C in zooplankton                        no3rat3    =', no3rat3
+            WRITE(numout,*) '    P/C in zooplankton                        po4rat3    =', po4rat3
+         ENDIF
+         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3     =', ferat3
+         WRITE(numout,*) '    Big particles sinking speed               wsbio2     =', wsbio2
+         WRITE(numout,*) '    Big particles maximum sinking speed       wsbio2max  =', wsbio2max
+         WRITE(numout,*) '    Big particles sinking speed length scale  wsbio2scale =', wsbio2scale
+         WRITE(numout,*) '    Maximum number of iterations for POC      niter1max =', niter1max
+         WRITE(numout,*) '    Maximum number of iterations for GOC      niter2max =', niter2max
+         IF( ln_ligand ) THEN
+            WRITE(numout,*) '    FeP sinking speed                             wfep   =', wfep
+            IF( ln_p4z ) THEN
+              WRITE(numout,*) '    Phyto ligand production per unit doc          ldocp  =', ldocp
+              WRITE(numout,*) '    Zoo ligand production per unit doc            ldocz  =', ldocz
+              WRITE(numout,*) '    Proportional loss of ligands due to Fe uptake lthet  =', lthet
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+      REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping
+      READ  ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisdmp in configuration namelist : Pisces damping
+      READ  ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, 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,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp
+         WRITE(numout,*) ' '
+      ENDIF
+
+      REWIND( numnatp_ref )              ! Namelist nampismass in reference namelist : Pisces mass conservation check
+      READ  ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampismass in configuration namelist : Pisces mass conservation check 
+      READ  ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampismass )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameter for mass conservation checking'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
+      ENDIF
+
+   END SUBROUTINE p4z_sms_init
+
+   SUBROUTINE p4z_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE p4z_rst  ***
+      !!
+      !!  ** Purpose : Read or write variables in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!---------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      !!---------------------------------------------------------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+         ! 
+         IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  )
+         ELSE
+            CALL ahini_for_at(hi)
+         ENDIF
+         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
+         IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  )
+         ELSE
+            xksimax(:,:) = xksi(:,:)
+         ENDIF
+         !
+         IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN  ! cumulative total flux of carbon
+            CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum  )
+         ELSE
+            t_oce_co2_flx_cum = 0._wp
+         ENDIF
+         !
+         IF( ln_p5z ) THEN
+            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sized(:,:,:)  )
+               CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sized(:,:,:)  )
+               CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  )
+            ELSE
+               sizep(:,:,:) = 1.
+               sizen(:,:,:) = 1.
+               sized(:,:,:) = 1.
+            ENDIF
+        ENDIF
+        !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         IF( kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file  kt =', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
+         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
+         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
+         CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
+         IF( ln_p5z ) THEN
+            CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sized(:,:,:) )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sized(:,:,:) )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) )
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE p4z_rst
+
+   SUBROUTINE p4z_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  p4z_dmp  ***
+      !!
+      !! ** purpose  : Relaxation of some tracers
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in )  ::     kt ! time step
+      !
+      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
+      REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates
+      REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate
+      REAL(wp) ::  silmean = 91.51     ! mean value of silicate
+      !
+      REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
+      REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
+      !!---------------------------------------------------------------------
+
+
+      IF(lwp)  WRITE(numout,*)
+      IF(lwp)  WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
+      IF(lwp)  WRITE(numout,*)
+
+      IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) !
+         !                                                ! --------------------------- !
+         ! set total alkalinity, phosphate, nitrate & silicate
+         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6              
+
+         zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+         zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
+         zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
+         zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+ 
+         IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn
+         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
+
+         IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn
+         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
+
+         IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn
+         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
+
+         IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn
+         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
+         !
+         !
+         IF( .NOT. ln_top_euler ) THEN
+            zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+            zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
+            zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
+            zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+ 
+            IF(lwp) WRITE(numout,*) ' '
+            IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb
+            trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
+
+            IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb
+            trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
+
+            IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb
+            trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
+
+            IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb
+            trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
+        ENDIF
+        !
+      ENDIF
+        !
+   END SUBROUTINE p4z_dmp
+
+
+   SUBROUTINE p4z_chk_mass( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_chk_mass  ***
+      !!
+      !! ** Purpose :  Mass conservation check 
+      !!
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
+      CHARACTER(LEN=100)   ::   cltxt
+      INTEGER :: jk
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork
+      !!----------------------------------------------------------------------
+
+      !
+      !!---------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN 
+         IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si, Fer
+            CALL ctl_opn( numco2, 'carbon.budget'  , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr
+            xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr
+            xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s
+            cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron'
+            IF( lwp ) WRITE(numnut,*)  TRIM(cltxt)
+            IF( lwp ) WRITE(numnut,*) 
+         ENDIF
+      ENDIF
+
+      CALL wrk_alloc( jpi, jpj, jpk, zwork )
+      !
+      IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         !   Compute the budget of NO3, ALK, Si, Fer
+         IF( ln_p4z ) THEN
+            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      &
+               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
+               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &        
+               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
+        ELSE
+            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   &
+               &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      & 
+               &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   &
+               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3 
+        ENDIF
+        !
+        no3budget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
+        no3budget = no3budget / areatot
+        CALL iom_put( "pno3tot", no3budget )
+      ENDIF
+      !
+      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         IF( ln_p4z ) THEN
+            zwork(:,:,:) =    trn(:,:,:,jppo4)                                         &
+               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
+               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &        
+               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
+        ELSE
+            zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      &
+               &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      & 
+               &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   &
+               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3 
+        ENDIF
+        !
+        po4budget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
+        po4budget = po4budget / areatot
+        CALL iom_put( "ppo4tot", po4budget )
+      ENDIF
+      !
+      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 
+         !
+         silbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
+         silbudget = silbudget / areatot
+         CALL iom_put( "psiltot", silbudget )
+      ENDIF
+      !
+      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.              
+         !
+         alkbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )         !
+         alkbudget = alkbudget / areatot
+         CALL iom_put( "palktot", alkbudget )
+      ENDIF
+      !
+      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   &
+            &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      &
+            &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3    
+         IF( ln_ligand)  zwork(:,:,:) = zwork(:,:,:) + trn(:,:,:,jpfep)                
+         !
+         ferbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
+         ferbudget = ferbudget / areatot
+         CALL iom_put( "pfertot", ferbudget )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwork )
+      !
+      ! Global budget of N SMS : denitrification in the water column and in the sediment
+      !                          nitrogen fixation by the diazotrophs
+      ! --------------------------------------------------------------------------------
+      IF( iom_use( "tnfix" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         znitrpottot  = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
+         CALL iom_put( "tnfix"  , znitrpottot * 1.e+3 * rno3 )  ! Global  nitrogen fixation molC/l  to molN/m3 
+      ENDIF
+      !
+      IF( iom_use( "tdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
+         CALL iom_put( "tdenit"  , zrdenittot * 1.e+3 * rno3 )  ! Total denitrification molC/l to molN/m3 
+      ENDIF
+      !
+      IF( iom_use( "Sdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
+         zsdenittot   = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
+         CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) )  ! Nitrate reduction in the sediments
+      ENDIF
+
+      IF( ln_check_mass .AND. kt == nitend ) THEN   ! Compute the budget of NO3, ALK, Si, Fer
+         t_atm_co2_flx  = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
+         t_oce_co2_flx  = t_oce_co2_flx         * xfact1 * (-1 )
+         tpp            = tpp           * 1000. * xfact1
+         t_oce_co2_exp  = t_oce_co2_exp * 1000. * xfact1
+         IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
+         IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget        * 1.e+06, &
+             &                                no3budget * rno3 * 1.e+06, &
+             &                                po4budget * po4r * 1.e+06, &
+             &                                silbudget        * 1.e+06, &
+             &                                ferbudget        * 1.e+09
+         !
+         IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2  , &
+         &                             zrdenittot  * xfact2  , &
+         &                             zsdenittot  * xfact2
+
+      ENDIF
+      !
+ 9000  FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
+ 9100  FORMAT(i8,5e18.10)
+ 9200  FORMAT(i8,3f10.5)
+
+       !
+   END SUBROUTINE p4z_chk_mass
+
+   !!======================================================================
+END MODULE p4zsms 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zlim.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zlim.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zlim.F90	(revision 8732)
@@ -0,0 +1,602 @@
+MODULE p5zlim
+   !!======================================================================
+   !!                         ***  MODULE p5zlim  ***
+   !! TOP :   PISCES with variable stoichiometry 
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota 
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p5z_lim        :   Compute the nutrients limitation terms 
+   !!   p5z_lim_init   :   Read the namelist 
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Shared ocean-passive tracers variables
+   USE trc             ! Tracers defined
+   USE sms_pisces      ! PISCES variables
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC p5z_lim    
+   PUBLIC p5z_lim_init    
+   PUBLIC p5z_lim_alloc
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  concnno3    !:  NO3, PO4 half saturation   
+   REAL(wp), PUBLIC ::  concpno3    !:  NO3, PO4 half saturation   
+   REAL(wp), PUBLIC ::  concdno3    !:  Phosphate half saturation for diatoms  
+   REAL(wp), PUBLIC ::  concnnh4    !:  NH4 half saturation for phyto  
+   REAL(wp), PUBLIC ::  concpnh4    !:  NH4 half saturation for phyto  
+   REAL(wp), PUBLIC ::  concdnh4    !:  NH4 half saturation for diatoms
+   REAL(wp), PUBLIC ::  concnpo4    !:  NH4 half saturation for diatoms
+   REAL(wp), PUBLIC ::  concppo4    !:  NH4 half saturation for diatoms
+   REAL(wp), PUBLIC ::  concdpo4    !:  NH4 half saturation for diatoms
+   REAL(wp), PUBLIC ::  concnfer    !:  Iron half saturation for nanophyto 
+   REAL(wp), PUBLIC ::  concpfer    !:  Iron half saturation for nanophyto 
+   REAL(wp), PUBLIC ::  concdfer    !:  Iron half saturation for diatoms  
+   REAL(wp), PUBLIC ::  concbno3    !:  NO3 half saturation  for bacteria 
+   REAL(wp), PUBLIC ::  concbnh4    !:  NH4 half saturation for bacteria
+   REAL(wp), PUBLIC ::  concbpo4    !:  PO4 half saturation for bacteria
+   REAL(wp), PUBLIC ::  xsizedia    !:  Minimum size criteria for diatoms
+   REAL(wp), PUBLIC ::  xsizepic    !:  Minimum size criteria for diatoms
+   REAL(wp), PUBLIC ::  xsizephy    !:  Minimum size criteria for nanophyto
+   REAL(wp), PUBLIC ::  xsizern     !:  Size ratio for nanophytoplankton
+   REAL(wp), PUBLIC ::  xsizerp     !:  Size ratio for nanophytoplankton
+   REAL(wp), PUBLIC ::  xsizerd     !:  Size ratio for diatoms
+   REAL(wp), PUBLIC ::  xksi1       !:  half saturation constant for Si uptake 
+   REAL(wp), PUBLIC ::  xksi2       !:  half saturation constant for Si/C 
+   REAL(wp), PUBLIC ::  xkdoc       !:  2nd half-sat. of DOC remineralization  
+   REAL(wp), PUBLIC ::  concbfe     !:  Fe half saturation for bacteria 
+   REAL(wp), PUBLIC ::  oxymin      !:  half saturation constant for anoxia
+   REAL(wp), PUBLIC ::  qfnopt      !:  optimal Fe quota for nanophyto
+   REAL(wp), PUBLIC ::  qfpopt      !:  optimal Fe quota for nanophyto
+   REAL(wp), PUBLIC ::  qfdopt      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  caco3r      !:  mean rainratio 
+   REAL(wp), PUBLIC ::  qnnmin      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qnnmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qpnmin      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qpnmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qnpmin      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qnpmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qppmin      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qppmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qndmin      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qndmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qpdmin      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qpdmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qfnmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qfpmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  qfdmax      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  zpsinh4
+   REAL(wp), PUBLIC ::  zpsino3
+   REAL(wp), PUBLIC ::  zpsiuptk
+
+   !!*  Allometric variations of the quotas
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqnnmin    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqnnmax    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqpnmin    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqpnmax    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqnpmin    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqnpmax    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqppmin    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqppmax    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqndmin    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqndmax    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqpdmin    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:,:)  ::   xqpdmax    !: ???
+
+   !!* Phytoplankton limitation terms
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbac    !: ??
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbacl   !: ??
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xpicono3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xpiconh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xpicopo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanodop   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xpicodop   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatdop   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanofer   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xpicofer   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatfer   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimpic    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimpfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   fvnuptk
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   fvpuptk
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   fvduptk
+
+   ! Coefficient for iron limitation
+   REAL(wp) ::  xcoef1   = 0.00167  / 55.85
+   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5
+   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zlim.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p5z_lim( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_lim  ***
+      !!
+      !! ** Purpose :   Compute the co-limitations by the various nutrients
+      !!              for the various phytoplankton species
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in)  :: kt, knt
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim
+      REAL(wp) ::   z1_trndia, z1_trnpic, z1_trnphy, ztem1, ztem2, zetot1
+      REAL(wp) ::   zratio, zration, zratiof, znutlim, zfalim
+      REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4, zconc0npo4, zconc0dpo4
+      REAL(wp) ::   zconc0p, zconc0pnh4, zconc0ppo4, zconcpfe, zconcnfe, zconcdfe
+      REAL(wp) ::   fanano, fananop, fananof, fadiat, fadiatp, fadiatf
+      REAL(wp) ::   fapico, fapicop, fapicof
+      REAL(wp) ::   zrpho, zrass, zcoef, zfuptk, zratchl
+      REAL(wp) ::   zfvn, zfvp, zfvf, zsizen, zsizep, zsized, znanochl, zpicochl, zdiatchl
+      REAL(wp) ::   zqfemn, zqfemp, zqfemd, zbactno3, zbactnh4
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_lim')
+      !
+      zratchl = 6.0
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! 
+               ! Tuning of the iron concentration to a minimum level that is set to the detection limit
+               !-------------------------------------
+               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6
+               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
+               zferlim = MIN( zferlim, 7e-11 )
+               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
+
+               ! Computation of the mean relative size of each community
+               ! -------------------------------------------------------
+               z1_trnphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
+               z1_trnpic   = 1. / ( trb(ji,jj,jk,jppic) + rtrn )
+               z1_trndia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
+               znanochl = trb(ji,jj,jk,jpnch) * z1_trnphy
+               zpicochl = trb(ji,jj,jk,jppch) * z1_trnpic
+               zdiatchl = trb(ji,jj,jk,jpdch) * z1_trndia
+
+               ! Computation of a variable Ks for iron on diatoms taking into account
+               ! that increasing biomass is made of generally bigger cells
+               !------------------------------------------------
+               zsized            = sized(ji,jj,jk)**0.81
+               zconcdfe          = concdfer * zsized
+               zconc1d           = concdno3 * zsized
+               zconc1dnh4        = concdnh4 * zsized
+               zconc0dpo4        = concdpo4 * zsized
+
+               zsizep            = 1.
+               zconcpfe          = concpfer * zsizep
+               zconc0p           = concpno3 * zsizep
+               zconc0pnh4        = concpnh4 * zsizep
+               zconc0ppo4        = concppo4 * zsizep
+
+               zsizen            = 1.
+               zconcnfe          = concnfer * zsizen
+               zconc0n           = concnno3 * zsizen
+               zconc0nnh4        = concnnh4 * zsizen
+               zconc0npo4        = concnpo4 * zsizen
+
+               ! Allometric variations of the minimum and maximum quotas
+               ! From Talmy et al. (2014) and Maranon et al. (2013)
+               ! -------------------------------------------------------
+               xqnnmin(ji,jj,jk) = qnnmin
+               xqnnmax(ji,jj,jk) = qnnmax
+               xqndmin(ji,jj,jk) = qndmin * sized(ji,jj,jk)**(-0.27) 
+               xqndmax(ji,jj,jk) = qndmax
+               xqnpmin(ji,jj,jk) = qnpmin
+               xqnpmax(ji,jj,jk) = qnpmax
+
+               ! Computation of the optimal allocation parameters
+               ! Based on the different papers by Pahlow et al., and Smith et al.
+               ! -----------------------------------------------------------------
+               znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0nnh4,    &
+                 &         trb(ji,jj,jk,jpno3) / zconc0n)
+               fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = trb(ji,jj,jk,jppo4) / zconc0npo4
+               fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = biron(ji,jj,jk) / zconcnfe
+               fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0pnh4,    &
+                 &         trb(ji,jj,jk,jpno3) / zconc0p)
+               fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = trb(ji,jj,jk,jppo4) / zconc0ppo4
+               fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = biron(ji,jj,jk) / zconcpfe
+               fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc1dnh4,    &
+                 &         trb(ji,jj,jk,jpno3) / zconc1d )
+               fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = trb(ji,jj,jk,jppo4) / zconc0dpo4
+               fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               znutlim = biron(ji,jj,jk) / zconcdfe
+               fadiatf = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) )
+               !
+               ! Michaelis-Menten Limitation term for nutrients Small bacteria
+               ! -------------------------------------------------------------
+               zbactnh4 = trb(ji,jj,jk,jpnh4) / ( concbnh4 + trb(ji,jj,jk,jpnh4) )
+               zbactno3 = trb(ji,jj,jk,jpno3) / ( concbno3 + trb(ji,jj,jk,jpno3) ) * (1. - zbactnh4)
+               !
+               zlim1    = zbactno3 + zbactnh4
+               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbpo4)
+               zlim3    = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) )
+               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) )
+               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+               xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4
+               !
+               ! Michaelis-Menten Limitation term for nutrients Small flagellates
+               ! -----------------------------------------------
+               zfalim = (1.-fanano) / fanano
+               xnanonh4(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0nnh4 + trb(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0n + trb(ji,jj,jk,jpno3) )  &
+               &                    * (1. - xnanonh4(ji,jj,jk))
+               !
+               zfalim = (1.-fananop) / fananop
+               xnanopo4(ji,jj,jk) = (1. - fananop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0npo4 )
+               xnanodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   &
+               &                    * ( 1.0 - xnanopo4(ji,jj,jk) )
+               xnanodop(ji,jj,jk) = 0.
+               !
+               zfalim = (1.-fananof) / fananof
+               xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe )
+               !
+               zratiof   = trb(ji,jj,jk,jpnfe) * z1_trnphy
+               zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk)
+               !
+               zration = trb(ji,jj,jk,jpnph) * z1_trnphy
+               zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration ))
+               fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn)  &
+               &                   * MAX(0., (1. - zratchl * znanochl / 12. ) )
+               !
+               zlim1    = max(0., (zration - 2. * xqnnmin(ji,jj,jk) )  &
+               &          / (xqnnmax(ji,jj,jk) - 2. * xqnnmin(ji,jj,jk) ) ) * xqnnmax(ji,jj,jk)  &
+               &          / (zration + rtrn)
+               zlim3    = MAX( 0.,( zratiof - zqfemn ) / qfnopt ) 
+               xlimnfe(ji,jj,jk) = MIN( 1., zlim3 )
+               xlimphy(ji,jj,jk) = MIN( 1., zlim1, zlim3 )
+               !
+               ! Michaelis-Menten Limitation term for nutrients picophytoplankton
+               ! ----------------------------------------------------------------
+               zfalim = (1.-fapico) / fapico 
+               xpiconh4(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0pnh4 + trb(ji,jj,jk,jpnh4) )
+               xpicono3(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0p + trb(ji,jj,jk,jpno3) )  &
+               &                    * (1. - xpiconh4(ji,jj,jk))
+               !
+               zfalim = (1.-fapicop) / fapicop 
+               xpicopo4(ji,jj,jk) = (1. - fapicop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0ppo4 )
+               xpicodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   &
+               &                    * ( 1.0 - xpicopo4(ji,jj,jk) )
+               xpicodop(ji,jj,jk) = 0.
+               !
+               zfalim = (1.-fapicof) / fapicof
+               xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe )
+               !
+               zratiof   = trb(ji,jj,jk,jppfe) * z1_trnpic
+               zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk)
+               !
+               zration   = trb(ji,jj,jk,jpnpi) * z1_trnpic
+               zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration ))
+               fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn)  &
+               &                   * MAX(0., (1. - zratchl * zpicochl / 12. ) ) 
+               !
+               zlim1    = max(0., (zration - 2. * xqnpmin(ji,jj,jk) )  &
+               &          / (xqnpmax(ji,jj,jk) - 2. * xqnpmin(ji,jj,jk) ) ) * xqnpmax(ji,jj,jk)  &
+               &          / (zration + rtrn)
+               zlim3    = MAX( 0.,( zratiof - zqfemp ) / qfpopt )
+               xlimpfe(ji,jj,jk) = MIN( 1., zlim3 )
+               xlimpic(ji,jj,jk) = MIN( 1., zlim1, zlim3 )
+               !
+               !   Michaelis-Menten Limitation term for nutrients Diatoms
+               !   ------------------------------------------------------
+               zfalim = (1.-fadiat) / fadiat 
+               xdiatnh4(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc1dnh4 + trb(ji,jj,jk,jpnh4) )
+               xdiatno3(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc1d + trb(ji,jj,jk,jpno3) )  &
+               &                    * (1. - xdiatnh4(ji,jj,jk))
+               !
+               zfalim = (1.-fadiatp) / fadiatp
+               xdiatpo4(ji,jj,jk) = (1. - fadiatp) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0dpo4 )
+               xdiatdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )  &
+               &                    * ( 1.0 - xdiatpo4(ji,jj,jk) )
+               xdiatdop(ji,jj,jk) = 0.
+               !
+               zfalim = (1.-fadiatf) / fadiatf
+               xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe )
+               !
+               zratiof   = trb(ji,jj,jk,jpdfe) * z1_trndia
+               zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk)
+               !
+               zration   = trb(ji,jj,jk,jpndi) * z1_trndia
+               zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration ))
+               fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn)   &
+               &                   * MAX(0., (1. - zratchl * zdiatchl / 12. ) ) 
+               !
+               zlim1    = max(0., (zration - 2. * xqndmin(ji,jj,jk) )    &
+               &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   &
+               &          * xqndmax(ji,jj,jk) / (zration + rtrn)
+               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
+               zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt )
+               xlimdfe(ji,jj,jk) = MIN( 1., zlim4 )
+               xlimdia(ji,jj,jk) = MIN( 1., zlim1, zlim3, zlim4 )
+               xlimsi(ji,jj,jk)  = MIN( zlim1, zlim4 )
+            END DO
+         END DO
+      END DO
+      !
+      ! Compute the phosphorus quota values. It is based on Litchmann et al., 2004 and Daines et al, 2013.
+      ! The relative contribution of three fonctional pools are computed: light harvesting apparatus, 
+      ! nutrient uptake pool and assembly machinery. DNA is assumed to represent 1% of the dry mass of 
+      ! phytoplankton (see Daines et al., 2013). 
+      ! --------------------------------------------------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Size estimation of nanophytoplankton
+               ! ------------------------------------
+               zfvn = 2. * fvnuptk(ji,jj,jk)
+               sizen(ji,jj,jk) = MAX(1., MIN(xsizern, 1.0 / ( MAX(rtrn, zfvn) ) ) )
+
+               ! N/P ratio of nanophytoplankton
+               ! ------------------------------
+               zfuptk = 0.23 * zfvn
+               zrpho = 2.24 * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpnph) * rno3 * 15. + rtrn )
+               zrass = 1. - 0.2 - zrpho - zfuptk
+               xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16.
+               xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) + 0.13
+               xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16.
+
+               ! Size estimation of picophytoplankton
+               ! ------------------------------------
+               zfvn = 2. * fvpuptk(ji,jj,jk)
+               sizep(ji,jj,jk) = MAX(1., MIN(xsizerp, 1.0 / ( MAX(rtrn, zfvn) ) ) )
+
+               ! N/P ratio of picophytoplankton
+               ! ------------------------------
+               zfuptk = 0.35 * zfvn
+               zrpho = 2.24 * trb(ji,jj,jk,jppch) / ( trb(ji,jj,jk,jpnpi) * rno3 * 15. + rtrn )
+               zrass = 1. - 0.4 - zrpho - zfuptk
+               xqppmax(ji,jj,jk) =  (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16.
+               xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) + 0.13
+               xqppmin(ji,jj,jk) = 0.13
+
+               ! Size estimation of diatoms
+               ! --------------------------
+               zfvn = 2. * fvduptk(ji,jj,jk)
+               sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) )
+               zcoef = trb(ji,jj,jk,jpdia) - MIN(xsizedia, trb(ji,jj,jk,jpdia) )
+               sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 )
+
+               ! N/P ratio of diatoms
+               ! --------------------
+               zfuptk = 0.2 * zfvn
+               zrpho = 2.24 * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpndi) * rno3 * 15. + rtrn )
+               zrass = 1. - 0.2 - zrpho - zfuptk
+               xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16.
+               xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) + 0.13
+               xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16.
+
+            END DO
+         END DO
+      END DO
+
+      ! Compute the fraction of nanophytoplankton that is made of calcifiers
+      ! --------------------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlim1 =  trb(ji,jj,jk,jpnh4) / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) + trb(ji,jj,jk,jpno3)    &
+               &        / ( trb(ji,jj,jk,jpno3) + concnno3 ) * ( 1.0 - trb(ji,jj,jk,jpnh4)   &
+               &        / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) )
+               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnpo4 )
+               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11 ) 
+               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
+               ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
+               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 
+
+!               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
+               xfracal(ji,jj,jk) = caco3r                 &
+               &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., trb(ji,jj,jk,jpphy)*1E6 )   &
+                  &                * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         &
+                  &                * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) )
+               xfracal(ji,jj,jk) = MAX( 0.02, MIN( 0.8 , xfracal(ji,jj,jk) ) )
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! denitrification factor computed from O2 levels
+               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    &
+                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  )
+               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics
+        IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht
+        IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        IF( iom_use( "LPnut"   ) ) CALL iom_put( "LPnut"  , xlimpic(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        IF( iom_use( "LDnut"   ) ) CALL iom_put( "LDnut"  , xlimdia(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+        IF( iom_use( "LNFe"    ) ) CALL iom_put( "LNFe"   , xlimnfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        IF( iom_use( "LPFe"    ) ) CALL iom_put( "LPFe"   , xlimpfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        IF( iom_use( "LDFe"    ) ) CALL iom_put( "LDFe"   , xlimdfe(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        IF( iom_use( "SIZEN"   ) ) CALL iom_put( "SIZEN"  , sizen(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        IF( iom_use( "SIZEP"   ) ) CALL iom_put( "SIZEP"  , sizep(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+        IF( iom_use( "SIZED"   ) ) CALL iom_put( "SIZED"  , sized(:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_lim')
+      !
+   END SUBROUTINE p5z_lim
+
+   SUBROUTINE p5z_lim_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p5z_lim_init  ***
+      !!
+      !! ** Purpose :   Initialization of nutrient limitation parameters
+      !!
+      !! ** Method  :   Read the nampislim and nampisquota namelists and check
+      !!      the parameters called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampislim
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp5zlim/ concnno3, concpno3, concdno3, concnnh4, concpnh4, concdnh4,  &
+         &                concnfer, concpfer, concdfer, concbfe, concnpo4, concppo4,   &
+         &                concdpo4, concbno3, concbnh4, concbpo4, xsizedia, xsizepic,  &
+         &                xsizephy, xsizern, xsizerp, xsizerd, xksi1, xksi2, xkdoc,    &
+         &                caco3r, oxymin
+
+      NAMELIST/namp5zquota/ qnnmin, qnnmax, qpnmin, qpnmax, qnpmin, qnpmax, qppmin,      &
+         &                  qppmax, qndmin, qndmax, qpdmin, qpdmax, qfnmax, qfpmax, qfdmax,  &
+         &                  qfnopt, qfpopt, qfdopt
+ 
+
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
+      READ  ( numnatp_ref, namp5zlim, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
+      READ  ( numnatp_cfg, namp5zlim, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp5zlim )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp5zlim'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r
+         WRITE(numout,*) '    NO3 half saturation of nanophyto         concnno3  = ', concnno3
+         WRITE(numout,*) '    NO3 half saturation of picophyto         concpno3  = ', concpno3
+         WRITE(numout,*) '    NO3 half saturation of diatoms           concdno3  = ', concdno3
+         WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4
+         WRITE(numout,*) '    NH4 half saturation for pico             concpnh4  = ', concpnh4
+         WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4
+         WRITE(numout,*) '    PO4 half saturation for phyto            concnpo4  = ', concnpo4
+         WRITE(numout,*) '    PO4 half saturation for pico             concppo4  = ', concppo4
+         WRITE(numout,*) '    PO4 half saturation for diatoms          concdpo4  = ', concdpo4
+         WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1
+         WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2
+         WRITE(numout,*) '    half-sat. of DOC remineralization        xkdoc     = ', xkdoc
+         WRITE(numout,*) '    Iron half saturation for nanophyto       concnfer  = ', concnfer
+         WRITE(numout,*) '    Iron half saturation for picophyto       concpfer  = ', concpfer
+         WRITE(numout,*) '    Iron half saturation for diatoms         concdfer  = ', concdfer
+         WRITE(numout,*) '    size ratio for nanophytoplankton         xsizern   = ', xsizern
+         WRITE(numout,*) '    size ratio for picophytoplankton         xsizerp   = ', xsizerp
+         WRITE(numout,*) '    size ratio for diatoms                   xsizerd   = ', xsizerd
+         WRITE(numout,*) '    NO3 half saturation of bacteria          concbno3  = ', concbno3
+         WRITE(numout,*) '    NH4 half saturation for bacteria         concbnh4  = ', concbnh4
+         WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia
+         WRITE(numout,*) '    Minimum size criteria for picophyto      xsizepic  = ', xsizepic
+         WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy
+         WRITE(numout,*) '    Fe half saturation for bacteria          concbfe   = ', concbfe
+         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin   =' , oxymin
+      ENDIF
+
+      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
+      READ  ( numnatp_ref, namp5zquota, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
+      READ  ( numnatp_cfg, namp5zquota, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisquota in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp5zquota )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp5zquota'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    optimal Fe quota for nano.               qfnopt    = ', qfnopt
+         WRITE(numout,*) '    optimal Fe quota for pico.               qfpopt    = ', qfpopt
+         WRITE(numout,*) '    Optimal Fe quota for diatoms             qfdopt    = ', qfdopt
+         WRITE(numout,*) '    Minimal N quota for nano                 qnnmin    = ', qnnmin
+         WRITE(numout,*) '    Maximal N quota for nano                 qnnmax    = ', qnnmax
+         WRITE(numout,*) '    Minimal P quota for nano                 qpnmin    = ', qpnmin
+         WRITE(numout,*) '    Maximal P quota for nano                 qpnmax    = ', qpnmax
+         WRITE(numout,*) '    Minimal N quota for pico                 qnpmin    = ', qnpmin
+         WRITE(numout,*) '    Maximal N quota for pico                 qnpmax    = ', qnpmax
+         WRITE(numout,*) '    Minimal P quota for pico                 qppmin    = ', qppmin
+         WRITE(numout,*) '    Maximal P quota for pico                 qppmax    = ', qppmax
+         WRITE(numout,*) '    Minimal N quota for diatoms              qndmin    = ', qndmin
+         WRITE(numout,*) '    Maximal N quota for diatoms              qndmax    = ', qndmax
+         WRITE(numout,*) '    Minimal P quota for diatoms              qpdmin    = ', qpdmin
+         WRITE(numout,*) '    Maximal P quota for diatoms              qpdmax    = ', qpdmax
+         WRITE(numout,*) '    Maximal Fe quota for nanophyto.          qfnmax    = ', qfnmax
+         WRITE(numout,*) '    Maximal Fe quota for picophyto.          qfpmax    = ', qfpmax
+         WRITE(numout,*) '    Maximal Fe quota for diatoms             qfdmax    = ', qfdmax
+      ENDIF
+
+      zpsino3 = 2.3 * rno3
+      zpsinh4 = 1.8 * rno3
+      zpsiuptk = 2.3 * rno3
+      !
+      nitrfac (:,:,:) = 0._wp
+      !
+   END SUBROUTINE p5z_lim_init
+
+   INTEGER FUNCTION p5z_lim_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_lim_alloc  ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp , ONLY: ctl_warn
+      INTEGER ::   ierr(2)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+
+      !*  Biological arrays for phytoplankton growth
+      ALLOCATE( xpicono3(jpi,jpj,jpk), xpiconh4(jpi,jpj,jpk),       &
+         &      xpicopo4(jpi,jpj,jpk), xpicodop(jpi,jpj,jpk),       &
+         &      xnanodop(jpi,jpj,jpk), xdiatdop(jpi,jpj,jpk),       &
+         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       &
+         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       &
+         &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       &
+         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       &
+         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       &
+         &      xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk),       &
+         &      xnanofer(jpi,jpj,jpk), xdiatfer(jpi,jpj,jpk),       &
+         &      xpicofer(jpi,jpj,jpk), xlimpfe (jpi,jpj,jpk),       &
+         &      fvnuptk (jpi,jpj,jpk), fvduptk (jpi,jpj,jpk),       &
+         &      fvpuptk (jpi,jpj,jpk), xlimpic (jpi,jpj,jpk),       &
+         &      xlimsi  (jpi,jpj,jpk), STAT=ierr(1) )
+
+      !*  Minimum/maximum quotas of phytoplankton
+      ALLOCATE( xqnnmin (jpi,jpj,jpk), xqnnmax(jpi,jpj,jpk),       &
+         &      xqpnmin (jpi,jpj,jpk), xqpnmax(jpi,jpj,jpk),       &
+         &      xqnpmin (jpi,jpj,jpk), xqnpmax(jpi,jpj,jpk),       &
+         &      xqppmin (jpi,jpj,jpk), xqppmax(jpi,jpj,jpk),       &
+         &      xqndmin (jpi,jpj,jpk), xqndmax(jpi,jpj,jpk),       &
+         &      xqpdmin (jpi,jpj,jpk), xqpdmax(jpi,jpj,jpk),     STAT=ierr(2) )
+      !
+      p5z_lim_alloc = MAXVAL( ierr )
+      !
+      IF( p5z_lim_alloc /= 0 ) CALL ctl_warn('p5z_lim_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p5z_lim_alloc
+   !!======================================================================
+END MODULE  p5zlim
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmeso.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmeso.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmeso.F90	(revision 8732)
@@ -0,0 +1,433 @@
+MODULE p5zmeso
+   !!======================================================================
+   !!                         ***  MODULE p5zmeso  ***
+   !! TOP :   PISCES Compute the sources/sinks for mesozooplankton
+   !!======================================================================
+   !! History :   1.0  !  2002     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p5z_meso       :   Compute the sources/sinks for mesozooplankton
+   !!   p5z_meso_init  :   Initialization of the parameters for mesozooplankton
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p5z_meso              ! called in p5zbio.F90
+   PUBLIC   p5z_meso_init         ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  part2        !: part of calcite not dissolved in mesozoo guts
+   REAL(wp), PUBLIC ::  xpref2c      !: mesozoo preference for POC 
+   REAL(wp), PUBLIC ::  xpref2p      !: mesozoo preference for nanophyto
+   REAL(wp), PUBLIC ::  xpref2z      !: mesozoo preference for zooplankton
+   REAL(wp), PUBLIC ::  xpref2d      !: mesozoo preference for Diatoms 
+   REAL(wp), PUBLIC ::  xpref2m      !: mesozoo preference for mesozoo
+   REAL(wp), PUBLIC ::  xthresh2zoo  !: zoo feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2dia  !: diatoms feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2phy  !: nanophyto feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2poc  !: poc feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2mes  !: mesozoo feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2     !: feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  resrat2      !: exsudation rate of mesozooplankton
+   REAL(wp), PUBLIC ::  mzrat2       !: microzooplankton mortality rate 
+   REAL(wp), PUBLIC ::  grazrat2     !: maximal mesozoo grazing rate
+   REAL(wp), PUBLIC ::  xkgraz2      !: non assimilated fraction of P by mesozoo
+   REAL(wp), PUBLIC ::  unass2c      !: Efficicency of mesozoo growth 
+   REAL(wp), PUBLIC ::  unass2n      !: Efficicency of mesozoo growth 
+   REAL(wp), PUBLIC ::  unass2p      !: Efficicency of mesozoo growth 
+   REAL(wp), PUBLIC ::  epsher2      !: half sturation constant for grazing 2
+   REAL(wp), PUBLIC ::  ssigma2      !: Fraction excreted as semi-labile DOM
+   REAL(wp), PUBLIC ::  srespir2     !: Active respiration
+   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate
+   LOGICAL,  PUBLIC ::  bmetexc2     !: Use of excess carbon for respiration
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zmeso.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p5z_meso( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_meso  ***
+      !!
+      !! ** Purpose :   Compute the sources/sinks for mesozooplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames
+      REAL(wp) :: zgraze2, zdenom, zfact, zfood, zfoodlim, zproport
+      REAL(wp) :: zmortzgoc, zfracc, zfracn, zfracp, zfracfe, zratio, zratio2
+      REAL(wp) :: zepsherf, zepshert, zepsherv, zrespirc, zrespirn, zrespirp, zbasresb, zbasresi
+      REAL(wp) :: zgraztotc, zgraztotn, zgraztotp, zgraztotf, zbasresn, zbasresp, zbasresf
+      REAL(wp) :: zgradoc, zgradon, zgradop, zgratmp, zgradoct, zgradont, zgrareft, zgradopt
+      REAL(wp) :: zgrapoc, zgrapon, zgrapop, zgrapof, zprcaca, zmortz
+      REAL(wp) :: zexcess, zgrarem, zgraren, zgrarep, zgraref
+      REAL(wp) :: zbeta, zrespz, ztortz, zgrasratp, zgrasratn, zgrasratf
+      REAL(wp) :: ztmp1, ztmp2, ztmp3, ztmp4, ztmp5, ztmptot
+      REAL(wp) :: zgrazdc, zgrazz, zgrazm, zgrazpof, zgrazcal, zfracal
+      REAL(wp) :: zgraznc, zgrazpoc, zgrazpon, zgrazpop, zgraznf, zgrazdf
+      REAL(wp) :: zgraznp, zgraznn, zgrazdn, zgrazdp
+      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg
+      REAL(wp) :: zgrazffnp, zgrazffng, zgrazffpp, zgrazffpg
+      CHARACTER (len=25) :: charout
+      REAL(wp) :: zrfact2, zmetexcess
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_meso')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
+      zgrazing(:,:,:) = 0._wp
+
+      zmetexcess = 0.0
+      IF ( bmetexc2 ) zmetexcess = 1.0
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
+               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
+
+               !   Michaelis-Menten mortality rates of mesozooplankton
+               !   ---------------------------------------------------
+               zrespz   = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
+               &          + 3. * nitrfac(ji,jj,jk) )
+
+               !   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   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)
+
+               !   Computation of the abundance of the preys
+               !   A threshold can be specified in the namelist
+               !   --------------------------------------------
+               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
+               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
+               zcompames = MAX( ( trb(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 )
+
+               !   Mesozooplankton grazing
+               !   ------------------------
+               zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2p * zcompaph + xpref2c * zcompapoc   &
+               &           + xpref2m * zcompames 
+               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
+               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
+               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 
+
+               !   An active switching parameterization is used here.
+               !   We don't use the KTW parameterization proposed by 
+               !   Vallina et al. because it tends to produce to steady biomass
+               !   composition and the variance of Chl is too low as it grazes
+               !   too strongly on winning organisms. Thus, instead of a square
+               !   a 1.5 power value is used which decreases the pressure on the
+               !   most abundant species
+               !   ------------------------------------------------------------  
+               ztmp1 = xpref2p * zcompaph**1.5
+               ztmp2 = xpref2m * zcompames**1.5
+               ztmp3 = xpref2c * zcompapoc**1.5
+               ztmp4 = xpref2d * zcompadi**1.5
+               ztmp5 = xpref2z * zcompaz**1.5
+               ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
+               ztmp1 = ztmp1 / ztmptot
+               ztmp2 = ztmp2 / ztmptot
+               ztmp3 = ztmp3 / ztmptot
+               ztmp4 = ztmp4 / ztmptot
+               ztmp5 = ztmp5 / ztmptot
+
+               !   Mesozooplankton regular grazing on the different preys
+               !   ------------------------------------------------------
+               zgrazdc   = zgraze2 * ztmp4 * zdenom
+               zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazz    = zgraze2 * ztmp5 * zdenom
+               zgrazm    = zgraze2 * ztmp2 * zdenom
+               zgraznc   = zgraze2 * ztmp1 * zdenom
+               zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn)
+               zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn)
+               zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazpoc  = zgraze2 * ztmp3 * zdenom
+               zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
+
+               !   Mesozooplankton flux feeding on GOC
+               !   ----------------------------------
+               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
+               zgrazffng = zgrazffeg * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn)
+               zgrazffpg = zgrazffeg * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn)
+               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
+               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)
+               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazffnp = zgrazffep * trb(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazffpp = zgrazffep * trb(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn)
+               !
+               zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg
+
+               !   Compute the proportion of filter feeders
+               !   ----------------------------------------  
+               zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc)
+
+               !   Compute fractionation of aggregates. It is assumed that 
+               !   diatoms based aggregates are more prone to fractionation
+               !   since they are more porous (marine snow instead of fecal pellets)
+               !   ----------------------------------------------------------------
+               zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
+               zratio2   = zratio * zratio
+               zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
+               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
+               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
+               zfracfe   = zfracc * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
+               zfracn    = zfracc * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn)
+               zfracp    = zfracc * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn)
+
+               zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg
+               zgrazfffp = zproport * zgrazfffp   ;   zgrazfffg = zproport * zgrazfffg
+               zgrazffnp = zproport * zgrazffnp   ;   zgrazffng = zproport * zgrazffng
+               zgrazffpp = zproport * zgrazffpp   ;   zgrazffpg = zproport * zgrazffpg
+
+               zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg
+               zgraztotf  = zgrazdf + zgraznf + ( zgrazz + zgrazm ) * ferat3 + zgrazpof &
+               &            + zgrazfffp + zgrazfffg
+               zgraztotn  = zgrazdn + (zgrazm + zgrazz) * no3rat3 + zgraznn + zgrazpon  &
+               &            + zgrazffnp + zgrazffng
+               zgraztotp  = zgrazdp + (zgrazz + zgrazm) * po4rat3 + zgraznp + zgrazpop  &
+               &            + zgrazffpp + zgrazffpg
+
+
+               ! Total grazing ( grazing by microzoo is already computed in p5zmicro )
+               zgrazing(ji,jj,jk) = zgraztotc
+
+               !   Stoichiometruc ratios of the food ingested by zooplanton 
+               !   --------------------------------------------------------
+               zgrasratf  =  (zgraztotf + rtrn) / ( zgraztotc + rtrn )
+               zgrasratn  =  (zgraztotn + rtrn) / ( zgraztotc + rtrn )
+               zgrasratp  =  (zgraztotp + rtrn) / ( zgraztotc + rtrn )
+
+               !   Growth efficiency is made a function of the quality 
+               !   and the quantity of the preys
+               !   ---------------------------------------------------
+               zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3)
+               zbeta = 1./ (epsher2 - 0.2)
+               zepsherf = 0.2 + 1./ (zbeta + 0.04 * 12. * zfood *1E6 )
+               zepsherv  = zepsherf * zepshert
+
+               !   Respiration of mesozooplankton
+               !   Excess carbon in the food is used preferentially
+               !   ----------------  ------------------------------
+               zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess 
+               zbasresb = MAX(0., zrespz - zexcess)
+               zbasresi = zexcess + MIN(0., zrespz - zexcess)
+               zrespirc = srespir2 * zepsherv * zgraztotc + zbasresb
+
+               !   When excess carbon is used, the other elements in excess
+               !   are also used proportionally to their abundance
+               !   --------------------------------------------------------
+               zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+               zbasresn = zbasresi * zexcess * zgrasratn
+               zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+               zbasresp = zbasresi * zexcess * zgrasratp
+               zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+               zbasresf = zbasresi * zexcess * zgrasratf
+
+               !   Voiding of the excessive elements as organic matter
+               !   --------------------------------------------------------
+               zgradoct = (1. - unass2c - zepsherv) * zgraztotc - zbasresi
+               zgradont = (1. - unass2n) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn
+               zgradopt = (1. - unass2p) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp
+               zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf
+               ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz
+               zgradoc = (zgradoct + ztmp1) * ssigma2
+               zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2
+               zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2
+               zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz
+
+               !  Since only semilabile DOM is represented in PISCES
+               !  part of DOM is in fact labile and is then released
+               !  as dissolved inorganic compounds (ssigma2)
+               !  --------------------------------------------------
+               zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2)
+               zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2)
+               zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2)
+               zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp )
+
+               !   Defecation as a result of non assimilated products
+               !   --------------------------------------------------
+               zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz
+               zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz
+               zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz
+               zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz
+
+               !  Addition of respiration to the release of inorganic nutrients
+               !  -------------------------------------------------------------
+               zgrarem = zgrarem + zbasresi + zrespirc
+               zgraren = zgraren + zbasresn + zrespirc * no3rat3
+               zgrarep = zgrarep + zbasresp + zrespirc * po4rat3
+               zgraref = zgraref + zbasresf + zrespirc * ferat3
+
+               !   Update the arrays TRA which contain the biological sources and
+               !   sinks
+               !   --------------------------------------------------------------
+               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren
+               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc
+               !
+               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz
+               !
+               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon
+               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren
+               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc   &
+               &                     - ztortz - zgrazm
+               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc
+               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn
+               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf
+               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
+               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc
+               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn
+               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc
+               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
+               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn
+               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc
+               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc
+               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc
+               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn
+               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe
+               zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn )
+               zgrazcal = zgrazffeg * (1. - part2) * zfracal
+
+               !  calcite production
+               !  ------------------
+               zprcaca = xfracal(ji,jj,jk) * zgraznc
+               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+               zprcaca = part2 * zprcaca
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca )
+               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca
+            END DO
+         END DO
+      END DO
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+         CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+         IF( iom_use( "GRAZ2" ) ) THEN
+            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton
+            CALL iom_put( "GRAZ2", zw3d )
+         ENDIF
+         IF( iom_use( "PCAL" ) ) THEN
+            zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production
+            CALL iom_put( "PCAL", zw3d )
+         ENDIF
+         CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+        WRITE(charout, FMT="('meso')")
+        CALL prt_ctl_trc_info(charout)
+        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_meso')
+      !
+   END SUBROUTINE p5z_meso
+
+   SUBROUTINE p5z_meso_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p5z_meso_init  ***
+      !!
+      !! ** Purpose :   Initialization of mesozooplankton parameters
+      !!
+      !! ** Method  :   Read the nampismes namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampismes
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp5zmes/part2, bmetexc2, grazrat2, resrat2, mzrat2, xpref2c, xpref2p, xpref2z, &
+         &                xpref2m, xpref2d, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, &
+         &                xthresh2mes, xthresh2, xkgraz2, epsher2, ssigma2, unass2c, &
+      &                   unass2n, unass2p, srespir2, grazflux
+
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton
+      READ  ( numnatp_ref, namp5zmes, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton
+      READ  ( numnatp_cfg, namp5zmes, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp5zmes )
+
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' ' 
+         WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp5zmes'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2       = ', part2
+         WRITE(numout,*) '    mesozoo preference for nano.                   xpref2p     = ', xpref2p
+         WRITE(numout,*) '    mesozoo preference for diatoms                 xpref2d     = ', xpref2d
+         WRITE(numout,*) '    mesozoo preference for zoo                     xpref2z     = ', xpref2z
+         WRITE(numout,*) '    mesozoo preference for mesozoo                 xpref2m     = ', xpref2m
+         WRITE(numout,*) '    mesozoo preference for poc                     xpref2c     = ', xpref2c
+         WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo = ', xthresh2zoo
+         WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia = ', xthresh2dia
+         WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy = ', xthresh2phy
+         WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc = ', xthresh2poc
+         WRITE(numout,*) '    mesozoo feeding threshold for mesozoo          xthresh2mes = ', xthresh2mes
+         WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2    = ', xthresh2
+         WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2     = ', resrat2
+         WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2      = ', mzrat2
+         WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2    = ', grazrat2
+         WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux    = ', grazflux
+         WRITE(numout,*) '    C egested fraction of food by mesozoo          unass2c     = ', unass2c
+         WRITE(numout,*) '    C egested fraction of food by mesozoo          unass2n     = ', unass2n
+         WRITE(numout,*) '    C egested fraction of food by mesozoo          unass2p     = ', unass2p
+         WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2     = ', epsher2
+         WRITE(numout,*) '    Fraction excreted as semi-labile DOM           ssigma2     = ', ssigma2
+         WRITE(numout,*) '    Active respiration                             srespir2    = ', srespir2
+         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2     = ', xkgraz2
+         WRITE(numout,*) '    Use excess carbon for respiration              bmetexc2    = ', bmetexc2
+      ENDIF
+
+
+   END SUBROUTINE p5z_meso_init
+
+   !!======================================================================
+END MODULE  p5zmeso
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmicro.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmicro.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmicro.F90	(revision 8732)
@@ -0,0 +1,375 @@
+MODULE p5zmicro
+   !!======================================================================
+   !!                         ***  MODULE p5zmicro  ***
+   !! TOP :   PISCES Compute the sources/sinks for microzooplankton
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p5z_micro       :   Compute the sources/sinks for microzooplankton
+   !!   p5z_micro_init  :   Initialize and read the appropriate namelist
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p5zlim          !  Phytoplankton limitation terms
+   USE iom             !  I/O manager
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p5z_micro         ! called in p5zbio.F90
+   PUBLIC   p5z_micro_init    ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  part        !: part of calcite not dissolved in microzoo guts
+   REAL(wp), PUBLIC ::  xprefc     !: microzoo preference for POC 
+   REAL(wp), PUBLIC ::  xprefn     !: microzoo preference for nanophyto
+   REAL(wp), PUBLIC ::  xprefp     !: microzoo preference for picophyto
+   REAL(wp), PUBLIC ::  xprefd     !: microzoo preference for diatoms
+   REAL(wp), PUBLIC ::  xprefz     !: microzoo preference for microzoo
+   REAL(wp), PUBLIC ::  xthreshdia  !: diatoms feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshpic  !: picophyto feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshphy  !: nanophyto threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshzoo  !: microzoo threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshpoc  !: poc threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthresh     !: feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  resrat      !: exsudation rate of microzooplankton
+   REAL(wp), PUBLIC ::  mzrat       !: microzooplankton mortality rate 
+   REAL(wp), PUBLIC ::  grazrat     !: maximal microzoo grazing rate
+   REAL(wp), PUBLIC ::  xkgraz      !: non assimilated fraction of P by microzoo
+   REAL(wp), PUBLIC ::  unassc      !: Efficicency of microzoo growth 
+   REAL(wp), PUBLIC ::  unassn      !: Efficicency of microzoo growth 
+   REAL(wp), PUBLIC ::  unassp      !: Efficicency of microzoo growth 
+   REAL(wp), PUBLIC ::  epsher      !: half sturation constant for grazing 1 
+   REAL(wp), PUBLIC ::  srespir     !: half sturation constant for grazing 1 
+   REAL(wp), PUBLIC ::  ssigma      !: Fraction excreted as semi-labile DOM
+   LOGICAL,  PUBLIC ::  bmetexc     !: Use of excess carbon for respiration
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zmicro.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p5z_micro( kt, knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_micro  ***
+      !!
+      !! ** Purpose :   Compute the sources/sinks for microzooplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::  kt  ! ocean time step
+      INTEGER, INTENT(in) ::  knt 
+      !
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc, zcompapon, zcompapop
+      REAL(wp) :: zcompapi, zgraze  , zdenom, zfact, zfood, zfoodlim
+      REAL(wp) :: ztmp1, ztmp2, ztmp3, ztmp4, ztmp5, ztmptot
+      REAL(wp) :: zepsherf, zepshert, zepsherv, zrespirc, zrespirn, zrespirp, zbasresb, zbasresi
+      REAL(wp) :: zgraztotc, zgraztotn, zgraztotp, zgraztotf, zbasresn, zbasresp, zbasresf
+      REAL(wp) :: zgradoc, zgradon, zgradop, zgraref, zgradoct, zgradont, zgradopt, zgrareft
+      REAL(wp) :: zexcess, zgraren, zgrarep, zgrarem
+      REAL(wp) :: zgrapoc, zgrapon, zgrapop, zgrapof, zprcaca, zmortz
+      REAL(wp) :: zrespz, ztortz, zgrasratf, zgrasratn, zgrasratp
+      REAL(wp) :: zgraznc, zgraznn, zgraznp, zgrazpoc, zgrazpon, zgrazpop, zgrazpof
+      REAL(wp) :: zgrazdc, zgrazdn, zgrazdp, zgrazdf, zgraznf, zgrazz
+      REAL(wp) :: zgrazpc, zgrazpn, zgrazpp, zgrazpf, zbeta, zrfact2, zmetexcess
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing, zw3d
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_micro')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
+      !
+      zmetexcess = 0.0
+      IF ( bmetexc ) zmetexcess = 1.0
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
+               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
+
+               !   Michaelis-Menten mortality rates of microzooplankton
+               !   -----------------------------------------------------
+               zrespz = resrat * zfact * ( trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  &
+               &        + 3. * nitrfac(ji,jj,jk) )
+
+               !   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 * trb(ji,jj,jk,jpzoo)
+
+               !   Computation of the abundance of the preys
+               !   A threshold can be specified in the namelist
+               !   --------------------------------------------
+               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
+               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
+               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 )
+               zcompapi  = MAX( ( trb(ji,jj,jk,jppic) - xthreshpic ), 0.e0 )
+               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
+               
+               !   Microzooplankton grazing
+               !   ------------------------
+               zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi   &
+               &           + xprefz * zcompaz + xprefp * zcompapi
+               zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
+               zdenom    = zfoodlim / ( xkgraz + zfoodlim )
+               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 
+
+               !   An active switching parameterization is used here.
+               !   We don't use the KTW parameterization proposed by 
+               !   Vallina et al. because it tends to produce to steady biomass
+               !   composition and the variance of Chl is too low as it grazes
+               !   too strongly on winning organisms. Thus, instead of a square
+               !   a 1.5 power value is used which decreases the pressure on the
+               !   most abundant species
+               !   ------------------------------------------------------------  
+               ztmp1 = xprefn * zcompaph**1.5
+               ztmp2 = xprefp * zcompapi**1.5
+               ztmp3 = xprefc * zcompapoc**1.5
+               ztmp4 = xprefd * zcompadi**1.5
+               ztmp5 = xprefz * zcompaz**1.5
+               ztmptot = ztmp1 + ztmp2 + ztmp3 + ztmp4 + ztmp5 + rtrn
+               ztmp1 = ztmp1 / ztmptot
+               ztmp2 = ztmp2 / ztmptot
+               ztmp3 = ztmp3 / ztmptot
+               ztmp4 = ztmp4 / ztmptot
+               ztmp5 = ztmp5 / ztmptot
+
+               !   Microzooplankton regular grazing on the different preys
+               !   -------------------------------------------------------
+               zgraznc   = zgraze  * ztmp1  * zdenom
+               zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn)
+               zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn)
+               zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
+               zgrazpc   = zgraze  * ztmp2  * zdenom
+               zgrazpn   = zgrazpc * trb(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn)
+               zgrazpp   = zgrazpc * trb(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn)
+               zgrazpf   = zgrazpc * trb(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn)
+               zgrazz    = zgraze  * ztmp5   * zdenom
+               zgrazpoc  = zgraze  * ztmp3   * zdenom
+               zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn )
+               zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn )
+               zgrazpof  = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+               zgrazdc   = zgraze  * ztmp4  * zdenom
+               zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn)
+               zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
+               !
+               zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc
+               zgraztotn = zgraznn + zgrazpn + zgrazpon + zgrazdn + zgrazz * no3rat3
+               zgraztotp = zgraznp + zgrazpp + zgrazpop + zgrazdp + zgrazz * po4rat3
+               zgraztotf = zgraznf + zgrazpf + zgrazpof + zgrazdf + zgrazz * ferat3
+               !
+               ! Grazing by microzooplankton
+               zgrazing(ji,jj,jk) = zgraztotc
+
+               !   Stoichiometruc ratios of the food ingested by zooplanton 
+               !   --------------------------------------------------------
+               zgrasratf =  (zgraztotf + rtrn) / ( zgraztotc + rtrn )
+               zgrasratn =  (zgraztotn + rtrn) / ( zgraztotc + rtrn )
+               zgrasratp =  (zgraztotp + rtrn) / ( zgraztotc + rtrn )
+
+               !   Growth efficiency is made a function of the quality 
+               !   and the quantity of the preys
+               !   ---------------------------------------------------
+               zepshert  = MIN( 1., zgrasratn/ no3rat3, zgrasratp/ po4rat3, zgrasratf / ferat3)
+               zbeta = 1./ (epsher - 0.2)
+               zepsherf = 0.2 + 1./ (zbeta + 0.04 * 12. * zfood * 1E6 )
+               zepsherv  = zepsherf * zepshert
+
+               !   Respiration of microzooplankton
+               !   Excess carbon in the food is used preferentially
+               !   ------------------------------------------------
+               zexcess  = zgraztotc * zepsherf * (1.0 - zepshert) * zmetexcess
+               zbasresb = MAX(0., zrespz - zexcess)
+               zbasresi = zexcess + MIN(0., zrespz - zexcess)  
+               zrespirc = srespir * zepsherv * zgraztotc + zbasresb
+               
+               !   When excess carbon is used, the other elements in excess
+               !   are also used proportionally to their abundance
+               !   --------------------------------------------------------
+               zexcess  = ( zgrasratn/ no3rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+               zbasresn = zbasresi * zexcess * zgrasratn 
+               zexcess  = ( zgrasratp/ po4rat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+               zbasresp = zbasresi * zexcess * zgrasratp
+               zexcess  = ( zgrasratf/ ferat3 - zepshert ) / ( 1.0 - zepshert + rtrn)
+               zbasresf = zbasresi * zexcess * zgrasratf
+
+               !   Voiding of the excessive elements as DOM
+               !   ----------------------------------------
+               zgradoct   = (1. - unassc - zepsherv) * zgraztotc - zbasresi  
+               zgradont   = (1. - unassn) * zgraztotn - zepsherv * no3rat3 * zgraztotc - zbasresn
+               zgradopt   = (1. - unassp) * zgraztotp - zepsherv * po4rat3 * zgraztotc - zbasresp
+               zgrareft   = (1. - unassc) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf
+
+               !  Since only semilabile DOM is represented in PISCES
+               !  part of DOM is in fact labile and is then released
+               !  as dissolved inorganic compounds (ssigma)
+               !  --------------------------------------------------
+               zgradoc =  zgradoct * ssigma
+               zgradon =  zgradont * ssigma
+               zgradop =  zgradopt * ssigma
+               zgrarem = (1.0 - ssigma) * zgradoct
+               zgraren = (1.0 - ssigma) * zgradont
+               zgrarep = (1.0 - ssigma) * zgradopt
+               zgraref = zgrareft
+
+               !   Defecation as a result of non assimilated products
+               !   --------------------------------------------------
+               zgrapoc   = zgraztotc * unassc
+               zgrapon   = zgraztotn * unassn
+               zgrapop   = zgraztotp * unassp
+               zgrapof   = zgraztotf * unassc
+
+               !  Addition of respiration to the release of inorganic nutrients
+               !  -------------------------------------------------------------
+               zgrarem = zgrarem + zbasresi + zrespirc
+               zgraren = zgraren + zbasresn + zrespirc * no3rat3
+               zgrarep = zgrarep + zbasresp + zrespirc * po4rat3
+               zgraref = zgraref + zbasresf + zrespirc * ferat3
+
+               !   Update of the TRA arrays
+               !   ------------------------
+               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren
+               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc
+               !
+               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz
+               !
+               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon
+               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref
+               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz
+               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc
+               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn
+               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp
+               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc
+               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn
+               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp
+               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc
+               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn
+               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn)
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
+               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc 
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc
+               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc
+               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon
+               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz  + zgrapof - zgrazpof
+               !
+               ! calcite production
+               zprcaca = xfracal(ji,jj,jk) * zgraznc
+               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+               !
+               zprcaca = part * zprcaca
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca     &
+               &                     + rno3 * zgraren
+               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
+            END DO
+         END DO
+      END DO
+      !
+      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+         CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+         IF( iom_use( "GRAZ1" ) ) THEN
+            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton
+            CALL iom_put( "GRAZ1", zw3d )
+         ENDIF
+         CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+      ENDIF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('micro')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_micro')
+      !
+   END SUBROUTINE p5z_micro
+
+
+   SUBROUTINE p5z_micro_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p5z_micro_init  ***
+      !!
+      !! ** Purpose :   Initialization of microzooplankton parameters
+      !!
+      !! ** Method  :   Read the nampiszoo namelist and check the parameters
+      !!                called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampiszoo
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp5zzoo/ part, grazrat, bmetexc, resrat, mzrat, xprefc, xprefn, &
+         &                xprefp, xprefd, xprefz, xthreshdia, xthreshphy, &
+         &                xthreshpic, xthreshpoc, xthreshzoo, xthresh, xkgraz, &
+         &                epsher, ssigma, srespir, unassc, unassn, unassp
+
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton
+      READ  ( numnatp_ref, namp5zzoo, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton
+      READ  ( numnatp_cfg, namp5zzoo, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zzoo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp5zzoo )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszooq'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part
+         WRITE(numout,*) '    microzoo preference for POC                     xprefc     =', xprefc
+         WRITE(numout,*) '    microzoo preference for nano                    xprefn     =', xprefn
+         WRITE(numout,*) '    microzoo preference for pico                    xprefp     =', xprefp
+         WRITE(numout,*) '    microzoo preference for diatoms                 xprefd     =', xprefd
+         WRITE(numout,*) '    microzoo preference for microzoo                xprefz     =', xprefz
+         WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia
+         WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy
+         WRITE(numout,*) '    picophyto feeding threshold for microzoo        xthreshpic  =', xthreshpic
+         WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc
+         WRITE(numout,*) '    microzoo feeding threshold for microzoo         xthreshzoo  =', xthreshzoo
+         WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh
+         WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat
+         WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat
+         WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat
+         WRITE(numout,*) '    C egested fraction of fodd by microzoo          unassc      =', unassc
+         WRITE(numout,*) '    N egested fraction of fodd by microzoo          unassn      =', unassn
+         WRITE(numout,*) '    P egested fraction of fodd by microzoo          unassp      =', unassp
+         WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher
+         WRITE(numout,*) '    Fraction excreted as semi-labile DOM            ssigma      =', ssigma
+         WRITE(numout,*) '    Active respiration                              srespir     =', srespir
+         WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz
+         WRITE(numout,*) '    Use of excess carbon for respiration            bmetexc     =', bmetexc
+      ENDIF
+
+   END SUBROUTINE p5z_micro_init
+
+   !!======================================================================
+END MODULE  p5zmicro
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmort.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmort.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmort.F90	(revision 8732)
@@ -0,0 +1,310 @@
+MODULE p5zmort
+   !!======================================================================
+   !!                         ***  MODULE p5zmort  ***
+   !! TOP :   PISCES Compute the mortality terms for phytoplankton
+   !!======================================================================
+   !! History :   1.0  !  2002     (O. Aumont)  Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p5z_mort       :   Compute the mortality terms for phytoplankton
+   !!   p5z_mort_init  :   Initialize the mortality params for phytoplankton
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p5zlim          !  Phytoplankton limitation terms
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p5z_mort    
+   PUBLIC   p5z_mort_init    
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC :: wchln    !:
+   REAL(wp), PUBLIC :: wchlp   !:
+   REAL(wp), PUBLIC :: wchld   !:
+   REAL(wp), PUBLIC :: wchldm  !:
+   REAL(wp), PUBLIC :: mpratn   !:
+   REAL(wp), PUBLIC :: mpratp  !:
+   REAL(wp), PUBLIC :: mpratd  !:
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p5z_mort( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_mort  ***
+      !!
+      !! ** Purpose :   Calls the different subroutine to initialize and compute
+      !!                the different phytoplankton mortality terms
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      !!---------------------------------------------------------------------
+
+      CALL p5z_nano            ! nanophytoplankton
+      CALL p5z_pico            ! picophytoplankton
+      CALL p5z_diat            ! diatoms
+
+   END SUBROUTINE p5z_mort
+
+
+   SUBROUTINE p5z_nano
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_nano  ***
+      !!
+      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompaph
+      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp, zprcaca
+      REAL(wp) :: ztortp , zrespp , zmortp
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_nano')
+      !
+      prodcal(:,:,:) = 0.  !: calcite production variable set to zero
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-9 ), 0.e0 )
+               !   Squared mortality of Phyto similar to a sedimentation term during
+               !   blooms (Doney et al. 1996)
+               !   -----------------------------------------------------------------
+               zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jpphy)
+
+               !   Phytoplankton linear mortality
+               !   ------------------------------
+               ztortp = mpratn * xstep  * zcompaph
+               zmortp = zrespp + ztortp
+
+               !   Update the arrays TRA which contains the biological sources and sinks
+
+               zfactn  = trb(ji,jj,jk,jpnph)/(trb(ji,jj,jk,jpphy)+rtrn)
+               zfactp  = trb(ji,jj,jk,jppph)/(trb(ji,jj,jk,jpphy)+rtrn)
+               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
+               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
+               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn
+               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp
+               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
+               zprcaca = xfracal(ji,jj,jk) * zmortp
+               !
+               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+               !
+               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
+               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
+               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
+               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
+            END DO
+         END DO
+      END DO
+      !
+       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('nano')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_nano')
+      !
+   END SUBROUTINE p5z_nano
+
+   SUBROUTINE p5z_pico
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_pico  ***
+      !!
+      !! ** Purpose :   Compute the mortality terms for picophytoplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompaph
+      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp
+      REAL(wp) :: ztortp , zrespp , zmortp 
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_pico')
+      !
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompaph = MAX( ( trb(ji,jj,jk,jppic) - 1e-9 ), 0.e0 )
+               !  Squared mortality of Phyto similar to a sedimentation term during
+               !  blooms (Doney et al. 1996)
+               !  -----------------------------------------------------------------
+               zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jppic)
+
+               !     Phytoplankton mortality 
+               ztortp = mpratp * xstep  * zcompaph
+               zmortp = zrespp + ztortp
+
+               !   Update the arrays TRA which contains the biological sources and sinks
+
+               zfactn = trb(ji,jj,jk,jpnpi)/(trb(ji,jj,jk,jppic)+rtrn)
+               zfactp = trb(ji,jj,jk,jpppi)/(trb(ji,jj,jk,jppic)+rtrn)
+               zfactfe = trb(ji,jj,jk,jppfe)/(trb(ji,jj,jk,jppic)+rtrn)
+               zfactch = trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn)
+               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp
+               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn
+               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp
+               tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch
+               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
+               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
+               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
+            END DO
+         END DO
+      END DO
+      !
+       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('pico')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_pico')
+      !
+   END SUBROUTINE p5z_pico
+
+
+   SUBROUTINE p5z_diat
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_diat  ***
+      !!
+      !! ** Purpose :   Compute the mortality terms for diatoms
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER  ::  ji, jj, jk
+      REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi
+      REAL(wp) ::  zrespp2, ztortp2, zmortp2
+      REAL(wp) ::  zlim2, zlim1
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_diat')
+      !
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1E-9), 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
+               !   -------------------------------------------------------------
+               !  Phytoplankton squared mortality
+               !  -------------------------------
+               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
+               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
+               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
+
+               !  Phytoplankton linear mortality 
+               !  ------------------------------
+               ztortp2 = mpratd * xstep  * zcompadi
+               zmortp2 = zrespp2 + ztortp2
+
+               !   Update the arrays tra which contains the biological sources and sinks
+               !   ---------------------------------------------------------------------
+               zfactn  = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactp  = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
+               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn
+               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 
+               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn
+               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2
+               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn
+               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe
+               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2
+               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2
+            END DO
+         END DO
+      END DO
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('diat')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_diat')
+      !
+   END SUBROUTINE p5z_diat
+
+   SUBROUTINE p5z_mort_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p5z_mort_init  ***
+      !!
+      !! ** Purpose :   Initialization of phytoplankton parameters
+      !!
+      !! ** Method  :   Read the nampismort namelist and check the parameters
+      !!      called at the first timestep
+      !!
+      !! ** input   :   Namelist nampismort
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/namp5zmort/ wchln, wchlp, wchld, wchldm, mpratn, mpratp, mpratd
+      INTEGER :: ios                 ! Local integer output status for namelist read
+
+      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
+      READ  ( numnatp_ref, namp5zmort, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
+      READ  ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp5zmort )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp5zmort'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchln     =', wchln
+         WRITE(numout,*) '    quadratic mortality of picophyto.         wchlp     =', wchlp
+         WRITE(numout,*) '    quadratic mortality of diatoms            wchld     =', wchld
+         WRITE(numout,*) '    Additional quadratic mortality of diatoms wchldm    =', wchldm
+         WRITE(numout,*) '    nanophyto. mortality rate                 mpratn    =', mpratn
+         WRITE(numout,*) '    picophyto. mortality rate                 mpratp    =', mpratp
+         WRITE(numout,*) '    Diatoms mortality rate                    mpratd    =', mpratd
+      ENDIF
+
+   END SUBROUTINE p5z_mort_init
+
+   !!======================================================================
+END MODULE  p5zmort
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zprod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zprod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zprod.F90	(revision 8732)
@@ -0,0 +1,644 @@
+MODULE p5zprod
+   !!======================================================================
+   !!                         ***  MODULE p5zprod  ***
+   !! TOP :  Growth Rate of the two phytoplanktons groups 
+   !!======================================================================
+   !! History :   1.0  !  2004     (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
+   !!----------------------------------------------------------------------
+   !!   p5z_prod       :   Compute the growth Rate of the two phytoplanktons groups
+   !!   p5z_prod_init  :   Initialization of the parameters for growth
+   !!   p5z_prod_alloc :   Allocate variables for growth
+   !!----------------------------------------------------------------------
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p5zlim          !  Co-limitations of differents nutrients
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p5z_prod         ! called in p5zbio.F90
+   PUBLIC   p5z_prod_init    ! called in trcsms_pisces.F90
+   PUBLIC   p5z_prod_alloc
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  pislopen        !:
+   REAL(wp), PUBLIC ::  pislopep        !:
+   REAL(wp), PUBLIC ::  pisloped        !:
+   REAL(wp), PUBLIC ::  xadap           !:
+   REAL(wp), PUBLIC ::  excretn         !:
+   REAL(wp), PUBLIC ::  excretp         !:
+   REAL(wp), PUBLIC ::  excretd         !:
+   REAL(wp), PUBLIC ::  bresp           !:
+   REAL(wp), PUBLIC ::  thetanpm        !:
+   REAL(wp), PUBLIC ::  thetannm        !:
+   REAL(wp), PUBLIC ::  thetandm        !:
+   REAL(wp), PUBLIC ::  chlcmin         !:
+   REAL(wp), PUBLIC ::  grosip          !:
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmaxn   !: optimal production = f(temperature)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmaxp   !: optimal production = f(temperature)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmaxd   !: optimal production = f(temperature)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   zdaylen
+   
+   REAL(wp) :: r1_rday                !: 1 / rday
+   REAL(wp) :: texcretn               !: 1 - excret 
+   REAL(wp) :: texcretp               !: 1 - excretp 
+   REAL(wp) :: texcretd               !: 1 - excret2        
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: p4zprod.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p5z_prod( kt , knt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_prod  ***
+      !!
+      !! ** Purpose :   Compute the phytoplankton production depending on
+      !!              light, temperature and nutrient availability
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) :: kt, knt
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zsilfac, znanotot, zpicotot, zdiattot, zconctemp, zconctemp2
+      REAL(wp) ::   zration, zratiop, zratiof, zmax, zmax2, zsilim, ztn, zadap
+      REAL(wp) ::   zpronmax, zpropmax, zprofmax, zrat
+      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot
+      REAL(wp) ::   zprnutmax, zdocprod, zprochln, zprochld, zprochlp
+      REAL(wp) ::   zpislopen, zpislopep, zpisloped, thetannm_n, thetandm_n, thetanpm_n
+      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup
+      REAL(wp) ::   zfact, zrfact2
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixpico, zmixdiat, zstrn
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadp, zpislopeadd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprbio, zprpic, zprdia, zysopt
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprchln, zprchlp, zprchld
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcap, zprorcad 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprofed, zprofep, zprofen
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewp, zpronewd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zproregn, zproregp, zproregd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpropo4n, zpropo4p, zpropo4d
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprodopn, zprodopp, zprodopd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zrespn, zrespp, zrespd, zprnut
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zcroissn, zcroissp, zcroissd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p5z_prod')
+      !
+      !  Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixpico, zmixdiat, zstrn )
+      CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )
+      CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad )
+      CALL wrk_alloc( jpi, jpj, jpk, zprofed, zprofep, zprofen )
+      CALL wrk_alloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd )
+      CALL wrk_alloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut )
+      CALL wrk_alloc( jpi, jpj, jpk, zprchln, zprchlp, zprchld, zprodopn, zprodopp, zprodopd )
+      CALL wrk_alloc( jpi, jpj, jpk, zcroissp, zcroissn, zcroissd )
+      !
+      zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp
+      zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp
+      zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp
+      zproregn(:,:,:) = 0._wp ; zproregp(:,:,:) = 0._wp ; zproregd(:,:,:) = 0._wp 
+      zpropo4n(:,:,:) = 0._wp ; zpropo4p(:,:,:) = 0._wp ; zpropo4d(:,:,:) = 0._wp
+      zprdia  (:,:,:) = 0._wp ; zprpic  (:,:,:) = 0._wp ; zprbio  (:,:,:) = 0._wp
+      zysopt  (:,:,:) = 0._wp
+      zrespn  (:,:,:) = 0._wp ; zrespp  (:,:,:) = 0._wp ; zrespd  (:,:,:) = 0._wp 
+
+      ! Computation of the optimal production
+      prmaxn(:,:,:) = ( 0.65_wp * (1. + zpsino3 * qnpmax ) ) * r1_rday * tgfunc(:,:,:)
+      prmaxp(:,:,:) = 0.5 / 0.65 * prmaxn(:,:,:) 
+      prmaxd(:,:,:) = prmaxn(:,:,:) 
+      zprnut(:,:,:) = 0.65_wp * r1_rday * tgfunc(:,:,:)
+
+      ! compute the day length depending on latitude and the day
+      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
+      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
+
+      ! day length in hours
+      zstrn(:,:) = 0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
+            zargu = MAX( -1., MIN(  1., zargu ) )
+            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+         END DO
+      END DO
+
+         ! Impact of the day duration on phytoplankton growth
+      DO jk = 1, jpkm1
+         DO jj = 1 ,jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  zval = MAX( 1., zstrn(ji,jj) )
+                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
+                  ENDIF
+                  zmxl_chl(ji,jj,jk) = zval / 24.
+                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      zprbio(:,:,:) = prmaxn(:,:,:) * zmxl_fac(:,:,:)
+      zprdia(:,:,:) = prmaxd(:,:,:) * zmxl_fac(:,:,:)
+      zprpic(:,:,:) = prmaxp(:,:,:) * zmxl_fac(:,:,:)
+
+
+      ! Maximum light intensity
+      zdaylen(:,:) = MAX(1., zstrn(:,:)) / 24.
+      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  ! Computation of the P-I slope for nanos and diatoms
+                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
+                  zadap       = xadap * ztn / ( 2.+ ztn )
+                  !
+                  zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch)    &
+                  &                       /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
+                  zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   &
+                  &                       * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn)
+                  zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch)    &
+                     &                    /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
+                  !
+                  zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
+                  zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn )
+                  zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
+
+                  ! Computation of production function for Carbon
+                  !  ---------------------------------------------
+                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
+                  zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  )
+                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
+
+                  ! Computation of production function for Chlorophyll
+                  !  -------------------------------------------------
+                  zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprchln(ji,jj,jk) = prmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
+                  zprchlp(ji,jj,jk) = prmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  )
+                  zprchld(ji,jj,jk) = prmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  !    Si/C of diatoms
+                  !    ------------------------
+                  !    Si/C increases with iron stress and silicate availability
+                  !    Si/C is arbitrariliy increased for very high Si concentrations
+                  !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
+                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
+                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
+                  zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
+                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
+                  IF (gphit(ji,jj) < -30 ) THEN
+                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
+                  ELSE
+                    zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
+                  ENDIF
+                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
+              ENDIF
+            END DO
+         END DO
+      END DO
+
+      !  Sea-ice effect on production                                                                               
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+               zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
+               zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
+               zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
+            END DO
+         END DO
+      END DO
+
+      ! Computation of the various production terms of nanophytoplankton 
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  !  production terms for nanophyto.
+                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
+                  !
+                  zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn )
+                  zratiop = trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn )
+                  zratiof = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )
+                  zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2
+                  ! Uptake of nitrogen
+                  zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   &
+                  &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) )
+                  zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk)
+                  zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk)
+                  ! Uptake of phosphorus
+                  zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk)
+                  zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk)
+                  zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk)
+                  ! Uptake of iron
+                  zrat = MIN( 1., zratiof / qfnmax )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zprofmax = zprnutmax * qfnmax * zmax
+                  zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    &
+                  &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  &
+                  &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Computation of the various production terms of picophytoplankton 
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  !  production terms for picophyto.
+                  zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2
+                  !
+                  zration = trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn )
+                  zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn )
+                  zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn )
+                  zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2
+                  ! Uptake of nitrogen
+                  zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   &
+                  &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) )
+                  zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 
+                  zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk)
+                  ! Uptake of phosphorus
+                  zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)
+                  zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk)
+                  zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk)
+                  ! Uptake of iron
+                  zrat = MIN( 1., zratiof / qfpmax )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zprofmax = zprnutmax * qfpmax * zmax
+                  zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   &
+                  &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   &
+                  &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Computation of the various production terms of diatoms
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  !  production terms for diatomees
+                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
+                  ! Computation of the respiration term according to pahlow 
+                  ! & oschlies (2013)
+                  !
+                  zration = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+                  zratiop = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+                  zratiof = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
+                  zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2
+                  ! Uptake of nitrogen
+                  zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
+                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   &
+                  &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) )
+                  zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk)
+                  zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk)
+                  ! Uptake of phosphorus
+                  zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
+                  zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk)
+                  zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk)
+                  zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk)
+                  ! Uptake of iron
+                  zrat = MIN( 1., zratiof / qfdmax )
+                  zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
+                  zprofmax = zprnutmax * qfdmax * zmax
+                  zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     &
+                  &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   &
+                  &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                     !  production terms for nanophyto. ( chlorophyll )
+                  znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
+                  thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   &
+                  &               * (1. - 1.14 / 43.4 * 20.))
+                  zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn )
+                  zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) )
+                     !  production terms for picophyto. ( chlorophyll )
+                  zpicotot = epico(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
+                  thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   &
+                  &               * (1. - 1.14 / 43.4 * 20.))
+                  zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn )
+                  zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) )
+                  !  production terms for diatomees ( chlorophyll )
+                  zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
+                  thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   &
+                  &               * (1. - 1.14 / 43.4 * 20.))
+                  zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn )
+                  zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) )
+                  !   Update the arrays TRA which contain the Chla sources and sinks
+                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn
+                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd
+                  tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp
+               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
+              zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
+              zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
+              zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
+              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
+              &          + excretp * zprorcap(ji,jj,jk)
+              tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  &
+              &                     - zpropo4p(ji,jj,jk)
+              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  &
+              &                     - zpronewp(ji,jj,jk)
+              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  &
+              &                     - zproregp(ji,jj,jk)
+              tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn    &
+                 &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   &
+                 &                  - zrespn(ji,jj,jk) 
+              zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn)
+              tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn
+              tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn   &
+              &                     + zprodopn(ji,jj,jk) * texcretn
+              tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn
+              tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp     &
+                 &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   &
+                 &                  - zrespp(ji,jj,jk) 
+              zcroissp(ji,jj,jk) = tra(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn)
+              tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp
+              tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp   &
+              &                     + zprodopp(ji,jj,jk) * texcretp
+              tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp
+              tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd   &
+                 &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   &
+                 &                  - zrespd(ji,jj,jk) 
+              zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn)
+              tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd
+              tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd   &
+              &                     + zprodopd(ji,jj,jk) * texcretd
+              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd
+              tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
+              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
+              &                     + excretp * zprorcap(ji,jj,jk)
+              tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot   &
+              &                     + excretp * zproptot
+              tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   &
+              &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     &
+              &    - texcretp * zprodopp(ji,jj,jk)
+              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   &
+                 &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           &
+                 &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   &
+                 &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) )
+              zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
+              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup
+              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
+              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  &
+              &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   &
+              &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   &
+              &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  &
+              &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 
+              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  &
+              &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     &
+              &                     + zproregp(ji,jj,jk) ) 
+          END DO
+        END DO
+     END DO
+     !
+     IF( ln_ligand ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+              DO ji =1 ,jpi
+                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
+                 zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
+                 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
+              END DO
+           END DO
+        END DO
+     ENDIF
+
+
+     ! Total primary production per year
+
+    ! Total primary production per year
+    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
+      & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )
+
+    IF( lk_iomput ) THEN
+       IF( knt == nrdttrc ) THEN
+          CALL wrk_alloc( jpi, jpj,      zw2d )
+          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+          !
+          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) .OR. iom_use( "PPPHYP" ) )  THEN
+              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto
+              CALL iom_put( "PPPHYN"  , zw3d )
+              !
+              zw3d(:,:,:) = zprorcap(:,:,:) * zfact * tmask(:,:,:)  ! primary production by picophyto
+              CALL iom_put( "PPPHYP"  , zw3d )
+              !
+              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes
+              CALL iom_put( "PPPHYD"  , zw3d )
+          ENDIF
+          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) .OR. iom_use( "PPNEWP" ) )  THEN
+              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto
+              CALL iom_put( "PPNEWN"  , zw3d )
+              !
+              zw3d(:,:,:) = zpronewp(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by picophyto
+              CALL iom_put( "PPNEWP"  , zw3d )
+              !
+              zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes
+              CALL iom_put( "PPNEWD"  , zw3d )
+          ENDIF
+          IF( iom_use( "PBSi" ) )  THEN
+              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production
+              CALL iom_put( "PBSi"  , zw3d )
+          ENDIF
+          IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) .OR. iom_use( "PFeP" ) )  THEN
+              zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto
+              CALL iom_put( "PFeN"  , zw3d )
+              !
+              zw3d(:,:,:) = zprofep(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by picophyto
+              CALL iom_put( "PFeP"  , zw3d )
+              !
+              zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes
+              CALL iom_put( "PFeD"  , zw3d )
+          ENDIF
+          IF( iom_use( "Mumax" ) )  THEN
+              zw3d(:,:,:) = prmaxn(:,:,:) * tmask(:,:,:)   ! Maximum growth rate
+              CALL iom_put( "Mumax"  , zw3d )
+          ENDIF
+          IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) .OR. iom_use( "MuP" ) )  THEN
+              zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto
+              CALL iom_put( "MuN"  , zw3d )
+              !
+              zw3d(:,:,:) = zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:)  ! Realized growth rate for picophyto
+              CALL iom_put( "MuP"  , zw3d )
+              !
+              zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms
+              CALL iom_put( "MuD"  , zw3d )
+          ENDIF
+          IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) .OR. iom_use( "LPlight" ) )  THEN
+              zw3d(:,:,:) = zprbio (:,:,:) / (prmaxn(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term
+              CALL iom_put( "LNlight"  , zw3d )
+              !
+              zw3d(:,:,:) = zprpic (:,:,:) / (prmaxp(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term
+              CALL iom_put( "LPlight"  , zw3d )
+              !
+              zw3d(:,:,:) =  zprdia (:,:,:) / (prmaxd(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term
+              CALL iom_put( "LDlight"  , zw3d )
+          ENDIF
+          IF( iom_use( "MunetN" ) .OR. iom_use( "MunetD" ) .OR. iom_use( "MunetP" ) )  THEN
+              zw3d(:,:,:) = zcroissn(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for nanophyto
+              CALL iom_put( "MunetN"  , zw3d )
+              !
+              zw3d(:,:,:) = zcroissp(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for picophyto
+              CALL iom_put( "MunetP"  , zw3d )
+              !
+              zw3d(:,:,:) = zcroissd(:,:,:) * tmask(:,:,:) ! ! Realized growth rate for diatomes
+              CALL iom_put( "MunetD"  , zw3d )
+              !
+          ENDIF
+
+          IF( iom_use( "tintpp" ) )  CALL iom_put( "tintpp" , tpp * zfact )  !  global total integrated primary production molC/s
+          !
+          CALL wrk_dealloc( jpi, jpj,      zw2d )
+          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+       ENDIF
+     ENDIF
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('prod')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixpico, zmixdiat, zstrn )
+      CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )
+      CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadp, zpislopeadd, zysopt )                           
+      CALL wrk_dealloc( jpi, jpj, jpk, zprdia, zprpic, zprbio, zprorcan, zprorcap, zprorcad )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprofed, zprofep, zprofen ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zpronewn, zpronewp, zpronewd, zproregn, zproregp, zproregd )
+      CALL wrk_dealloc( jpi, jpj, jpk, zpropo4n, zpropo4p, zpropo4d, zrespn, zrespp, zrespd, zprnut )
+      CALL wrk_dealloc( jpi, jpj, jpk, zprchln, zprchlp, zprchld, zprodopn, zprodopp, zprodopd )
+      CALL wrk_dealloc( jpi, jpj, jpk, zcroissp, zcroissn, zcroissd )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p5z_prod')
+      !
+   END SUBROUTINE p5z_prod
+
+
+   SUBROUTINE p5z_prod_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p5z_prod_init  ***
+      !!
+      !! ** Purpose :   Initialization of phytoplankton production parameters
+      !!
+      !! ** Method  :   Read the nampisprod namelist and check the parameters
+      !!      called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist nampisprod
+      !!----------------------------------------------------------------------
+      !
+      NAMELIST/namp5zprod/ pislopen, pislopep, pisloped, excretn, excretp, excretd,     &
+         &                 thetannm, thetanpm, thetandm, chlcmin, grosip, bresp, xadap
+
+      INTEGER :: ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production
+      READ  ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production
+      READ  ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp5zprod )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp5zprod'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip
+         WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen
+         WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped
+         WRITE(numout,*) '    P-I slope  for picophytoplankton          pislopep     =', pislopep
+         WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap
+         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn
+         WRITE(numout,*) '    excretion ratio of picophytoplankton      excretp      =', excretp
+         WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd
+         WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp
+         WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin
+         WRITE(numout,*) '    Minimum Chl/N in nanophytoplankton        thetannm     =', thetannm
+         WRITE(numout,*) '    Minimum Chl/N in picophytoplankton        thetanpm     =', thetanpm
+         WRITE(numout,*) '    Minimum Chl/N in diatoms                  thetandm     =', thetandm
+      ENDIF
+      !
+      r1_rday   = 1._wp / rday 
+      texcretn  = 1._wp - excretn
+      texcretp  = 1._wp - excretp
+      texcretd  = 1._wp - excretd
+      tpp       = 0._wp
+      !
+   END SUBROUTINE p5z_prod_init
+
+
+   INTEGER FUNCTION p5z_prod_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_prod_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( prmaxn(jpi,jpj,jpk), prmaxp(jpi,jpj,jpk), prmaxd(jpi,jpj,jpk),  &
+      &          zdaylen(jpi,jpj), STAT = p5z_prod_alloc )
+      !
+      IF( p5z_prod_alloc /= 0 ) CALL ctl_warn('p5z_prod_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p5z_prod_alloc
+   !!======================================================================
+END MODULE  p5zprod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90	(revision 8732)
@@ -0,0 +1,63 @@
+MODULE par_sed
+   !!======================================================================
+   !!                        ***  par_sed  ***
+   !! Sediment :   set sediment parameter
+   !!======================================================================
+   !! History :
+   !!        !  06-12  (C. Ethe)  Orignal
+   !!----------------------------------------------------------------------
+   !! $Id$
+#if defined key_sed
+   !! Domain characteristics
+   USE par_kind
+   USE par_oce , ONLY :       &
+      jpi      =>   jpi   ,  & !: first  dimension of grid --> i
+      jpj      =>   jpj   ,  & !: second dimension of grid --> j
+      jpim1    =>   jpim1 ,  & !: jpi - 1
+      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
+   USE par_pisces
+#endif
+
+   INTEGER, PARAMETER :: jpdta = 12
+
+
+   ! Vertical sediment geometry
+   INTEGER, PARAMETER :: &
+      jpksed   = 11         ,   & !: number of sediment layers
+      jpksedm1 = jpksed - 1 
+      
+   ! sediment tracer species
+   INTEGER, PARAMETER :: &
+      jpsol = 4,         &  !: number of solid component
+      jpwat = 7,         &   !: number of pore water component
+      jpwatp1 = jpwat + 1
+
+   
+   ! pore water components       
+   INTEGER, PARAMETER :: &
+      jwsil  = 1,        & !: silic acid
+      jwoxy  = 2,        & !: oxygen
+      jwdic  = 3,        & !: dissolved inorganic carbon
+      jwno3  = 4,        & !: nitrate
+      jwpo4  = 5,        & !: phosphate
+      jwalk  = 6,        & !: alkalinity
+      jwc13  = 7           !: dissolved inorganic carbon 13
+
+   ! solid components       
+   INTEGER, PARAMETER ::  &
+      jsopal  = 1,        & !: opal sediment
+      jsclay  = 2,        & !: clay
+      jspoc   = 3,        & !: organic carbon
+      jscal   = 4           !: calcite
+
+   INTEGER, PARAMETER ::  &
+      jptrased   = jpsol + jpwat , &
+      jpdia3dsed = 3          , &
+      jpdia2dsed = 7
+#endif
+END MODULE par_sed
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90	(revision 8732)
@@ -0,0 +1,190 @@
+MODULE sed
+   !!======================================================================
+   !!                        ***  sed  ***
+   !! Sediment :   set sediment global variables
+   !!======================================================================
+#if defined key_sed
+   !! History :
+   !!        !  06-12  (C. Ethe)  Orignal
+   !!----------------------------------------------------------------------
+   USE par_sed
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC sed_alloc   
+
+   USE dom_oce , ONLY :   nidom     =>   nidom          !:
+   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre)
+   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre)
+   USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m)
+   USE dom_oce , ONLY :   mbkt      =>   mbkt           !: vertical index of the bottom last T- ocean level
+   USE dom_oce , ONLY :   tmask     =>   tmask          !: land/ocean mask at t-points
+   USE dom_oce , ONLY :   rdt       =>   rdt            !: time step for the dynamics
+   USE dom_oce , ONLY :   nyear     =>   nyear          !: Current year
+   USE dom_oce , ONLY :   nmonth    =>   nmonth         !: Current month
+   USE dom_oce , ONLY :   nday      =>   nday           !: Current day
+   USE dom_oce , ONLY :   ndastp    =>   ndastp         !: time step date in year/month/day aammjj
+   USE dom_oce , ONLY :   nday_year =>   nday_year      !: curent day counted from jan 1st of the current year
+   USE dom_oce , ONLY :   adatrj    =>   adatrj         !: number of elapsed days since the begining of the run
+   !                                !: it is the accumulated duration of previous runs
+   !                                !: that may have been run with different time steps.
+
+#if ! defined key_sed_off
+
+   USE oce     , ONLY :  tsn        =>   tsn             !: pot. temperature (celsius) and salinity (psu)
+
+   USE trc     , ONLY :  trn        =>   trc             !: tracer 
+   USE trc     , ONLY :  nwritetrc  =>   nwritetrc       !: outputs frequency of tracer model
+
+   USE p4zsink , ONLY :  sinking    =>   sinking         !: sinking flux for POC
+   USE p4zsink , ONLY :  sinking2   =>   sinking2        !: sinking flux for GOC
+   USE p4zsink , ONLY :  sinkcal    =>   sinkcal         !: sinking flux for calcite
+   USE p4zsink , ONLY :  sinksil    =>   sinksil         !: sinking flux for opal ( dsi )
+
+   USE sms_pisces, ONLY : akb3      =>   akb3            !: Chemical constants  
+   USE sms_pisces, ONLY : ak13      =>   ak13            !: Chemical constants  
+   USE sms_pisces, ONLY : ak23      =>   ak23            !: Chemical constants  
+   USE sms_pisces, ONLY : akw3      =>   akw3            !: Chemical constants  
+   USE sms_pisces, ONLY : aksp      =>   aksp            !: Chemical constants  
+   USE sms_pisces, ONLY : borat     =>   borat           !: Chemical constants ( borat ) 
+
+#endif   
+
+
+   !! Namelist
+   REAL(wp), PUBLIC, DIMENSION(5) ::  reac                !: reactivity rc in  [l.mol-1.s-1]
+   REAL(wp), PUBLIC               ::  reac_sil            !: reactivity of silicate in  [l.mol-1.s-1]
+   REAL(wp), PUBLIC               ::  reac_clay           !: reactivity of clay in  [l.mol-1.s-1]
+   REAL(wp), PUBLIC               ::  reac_poc            !: reactivity of poc in  [l.mol-1.s-1]
+   REAL(wp), PUBLIC               ::  reac_no3            !: reactivity of no3 in  [l.mol-1.s-1]
+   REAL(wp), PUBLIC               ::  reac_cal            !: reactivity of cal in  [l.mol-1.s-1]
+   REAL(wp), PUBLIC               ::  sat_sil             !: saturation concentration for silicate in [mol.l-1]
+   REAL(wp), PUBLIC               ::  sat_clay            !: saturation concentration for clay in [mol.l-1]
+   REAL(wp), PUBLIC               ::  so2ut 
+   REAL(wp), PUBLIC               ::  srno3 
+   REAL(wp), PUBLIC               ::  spo4r 
+   REAL(wp), PUBLIC               ::  srDnit 
+   REAL(wp), PUBLIC               ::  sthro2              !: threshold O2 concen. in [mol.l-1]
+   REAL(wp), PUBLIC               ::  pdb = 0.0112372     !: 13C/12C in PD Belemnite
+   REAL(wp), PUBLIC               ::  rc13P  = 0.980      !: 13C/12C in POC = rc13P*PDB
+   REAL(wp), PUBLIC               ::  rc13Ca = 1.001      !: 13C/12C in CaCO3 = rc13Ca*PDB
+   REAL(wp), PUBLIC               ::  dtsed               !: sedimentation time step
+   REAL(wp), PUBLIC               ::  db                  !: bioturb coefficient in [cm2.s-1]
+
+   INTEGER , PUBLIC               ::  nitsed000
+   INTEGER , PUBLIC               ::  nitsedend
+   INTEGER , PUBLIC               ::  nwrised
+   INTEGER , PUBLIC               ::  nfreq
+   REAL(wp), PUBLIC               ::  dens                !: density of solid material
+   !
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  pwcp       !: pore water sediment data at given time-step
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  pwcp0      !: pore water sediment data at initial time
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  solcp      !: solid sediment data at given time-step
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  solcp0     !: solid sediment data at initial time
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  pwcp_dta   !: pore water data at given time-step
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  rainrm_dta !: rain data at at initial time
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  rainrm     !: rain data at given time-step
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  rainrg     !: rain of each solid component in [g/(cm**2.s)]
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  fromsed    !:
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  tosed      !:
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  rloss      !: 
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  tokbot        
+   !
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  temp       !: temperature
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  salt       !: salinity
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  press      !: pressure
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  raintg     !: total massic flux rained in each cell (sum of sol. comp.)
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  dzdep      !: total thickness of solid material rained [cm] in each cell
+   !
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  hipor      !: [h+] in mol/kg*densSW 
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  co3por     !: [co3--]solid sediment at initial time
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  dz3d       !:  ???
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  volw3d     !:  ???
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  vols3d     !:  ???
+
+
+   !! Chemistry
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  densSW 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  borats 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  calcon2
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  akbs  
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak1s 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak2s   
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  akws  
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak12s  
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak1ps 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak2ps  
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak3ps 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak12ps 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  ak123ps
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  aksis 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  aksps 
+
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  mol_wgt    !: molecular weight of solid sediment data
+ 
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  trc_data    !: tracer data to share with sediment model
+   !! Geometry
+   INTEGER , PUBLIC, SAVE                          ::  jpoce, indoce !: Ocean points ( number/indices )
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  iarroce       !: Computation of 1D array of sediments points
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  epkbot        !: ocean bottom layer thickness
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  dzkbot        !: ocean bottom layer thickness in meters
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  tmasksed      !: sediment mask
+   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  sbathy        !: bathymetry
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  dz            !: sediment layers thickness
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  por           !: porosity profile     
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  por1          !: 1-por 
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  profsed       !: depth of middle of each layer
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  volw          !: volume of pore water cell fraction
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  vols          !: volume of solid cell fraction
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  diff          !: diffusion ceofficient
+   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  rdtsed        !:  sediment model time-step
+   REAL(wp)  ::   dens               !: density of solid material
+   !! Inputs / Outputs
+   CHARACTER( len = 80 ), DIMENSION(jptrased  ) ::  sedtrcl
+   CHARACTER( len = 20 ), DIMENSION(jptrased  ) ::  sedtrcd , sedtrcu
+   CHARACTER( len = 80 ), DIMENSION(jpdia3dsed) ::  seddia3l 
+   CHARACTER( len = 20 ), DIMENSION(jpdia3dsed) ::  seddia3d, seddia3u
+   CHARACTER( len = 80 ), DIMENSION(jpdia2dsed) ::  seddia2l 
+   CHARACTER( len = 20 ), DIMENSION(jpdia2dsed) ::  seddia2d, seddia2u
+   !
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE ::  trcsedi
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE ::  flxsedi3d
+   REAL(wp), PUBLIC, DIMENSION(:,:,:  ), ALLOCATABLE ::  flxsedi2d
+
+   INTEGER, PUBLIC ::  numsed = 27    ! units
+
+   !! $Id$
+CONTAINS
+
+   INTEGER FUNCTION sed_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE sed_alloc ***
+      !!-------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE( trc_dta(jpi,jpj,jdta)                                     ,   &
+         &      epkbot(jpi,jpj), sbathy(jpi,jpj)                          ,   &
+         &      tmasksed(jpi,jpj,jpksed)                                  ,   &
+         &      dz(jpksed)  , por(jpksed) , por1(jpksed), profsed(jpksed) ,   &
+         &      volw(jpksed), vols(jpksed), diff(jpksed), rdtsed(jpksed)  ,   &
+         &      trcsedi  (jpi,jpj,jpksed,jptrased)                        ,   &
+         &      flxsedi3d(jpi,jpj,jpksed,jpdia3dsed)                      ,   &
+         &      flxsedi2d(jpi,jpj,jpksed,jpdia2dsed)                      ,   &
+         &      mol_wgt(jpsol),                                           STAT=sed_alloc )
+
+      IF( sed_alloc /= 0 )   CALL ctl_warn('sed_alloc: failed to allocate arrays')
+      !
+   END FUNCTION sed_alloc
+
+#else
+   !!======================================================================
+   !! No Sediment model
+   !!======================================================================
+#endif
+
+END MODULE sed
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90	(revision 8732)
@@ -0,0 +1,451 @@
+MODULE sedadv
+#if defined key_sed
+   !!======================================================================
+   !!              ***  MODULE  sedadv  ***
+   !!    Sediment : vertical advection and burial
+   !!=====================================================================
+   !! * Modules used
+   !!----------------------------------------------------------------------
+   !!   sed_adv :
+   !!----------------------------------------------------------------------
+   USE sed     ! sediment global variable
+
+   PUBLIC sed_adv
+
+   !! * Module variable
+   INTEGER, PARAMETER  ::  nztime = jpksed         ! number of time step between sunrise and sunset
+
+   REAL(wp), DIMENSION(jpksed), SAVE :: dvolsp, dvolsm
+   REAL(wp), DIMENSION(jpksed), SAVE :: c2por, ckpor
+
+   REAL(wp) :: cpor
+   REAL(wp) :: por1clay 
+   REAL(wp) :: eps = 1.e-13
+
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE sed_adv( kt )
+      !!-------------------------------------------------------------------------
+      !!                  ***  ROUTINE sed_adv  ***
+      !!
+      !! ** Purpose : vertical solid sediment advection and burial 
+      !!
+      !! ** Method  : At each grid point the 1-dimensional solid sediment column
+      !!              is shifted according the rain added to the top layer and
+      !!              the gaps produced through redissolution so that in the end
+      !!              the original sediment mixed layer geometry is reestablished.
+      !!
+      !!
+      !!   History :
+      !!        !  98-08 (E. Maier-Reimer, Christoph Heinze )  Original code
+      !!        !  04-10 (N. Emprin, M. Gehlen ) F90
+      !!        !  06-04 (C. Ethe)  Re-organization
+      !!-------------------------------------------------------------------------
+      !!* Arguments
+      INTEGER, INTENT(in) ::  &
+         kt                     ! time step
+      ! * local variables
+      INTEGER :: ji, jk, js 
+      INTEGER :: jn, ntimes, ikwneg
+      
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsolcpno
+      REAL(wp), DIMENSION(:  ), ALLOCATABLE :: zfilled, zfull, zfromup, zempty
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zgap, zwb
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zrainrf
+      REAL(wp), DIMENSION(nztime) ::  zraipush
+
+      REAL(wp) :: zkwnup, zkwnlo, zfrac,  zfromce, zrest
+
+      !------------------------------------------------------------------------
+
+
+      IF( kt == nitsed000 ) THEN
+         WRITE(numsed,*) ' '
+         WRITE(numsed,*) ' sed_adv : vertical sediment advection  '
+         WRITE(numsed,*) ' '
+         por1clay = dens * por1(jpksed) * dz(jpksed) / mol_wgt(jsclay)
+         cpor     = por1(jpksed) / por1(2)
+         DO jk = 2, jpksed
+            c2por(jk) = por1(2)      / por1(jk)
+            ckpor(jk) = por1(jpksed) / por1(jk)
+         ENDDO
+         DO jk = jpksedm1, 2, -1
+            dvolsp(jk) = vols(jk+1) / vols(jk)
+         ENDDO
+         DO jk = 3, jpksed
+           dvolsm(jk) = vols(jk-1) / vols(jk)
+        ENDDO
+      ENDIF
+
+      ALLOCATE( zsolcpno(jpksed,jpsol), zrainrf(jpoce,jpsol) )
+      ALLOCATE( zfilled(jpksed), zfull(jpksed), zfromup(jpksed), zempty(jpksed) )
+      ALLOCATE( zgap (jpoce,jpksed)   , zwb(jpoce,jpksed)  )  
+
+      ! Initialization of data for mass balance calculation
+      !---------------------------------------------------
+      fromsed(:,:) = 0.
+      tosed  (:,:) = 0. 
+      rloss  (:,:) = 0.
+
+
+      ! Initiate gap 
+      !--------------
+      zgap(:,:) = 0.
+      DO js = 1, jpsol
+         DO jk = 1, jpksed
+            DO ji = 1, jpoce
+               zgap(ji,jk) = zgap(ji,jk) + solcp(ji,jk,js)
+            END DO
+         ENDDO
+      ENDDO
+
+      zgap(1:jpoce,1:jpksed) = 1. - zgap(1:jpoce,1:jpksed)   
+
+
+      ! Initiate burial rates
+      !-----------------------
+      zwb(:,:) = 0.
+      DO jk = 2, jpksed
+         zfrac =  dtsed / ( dens * por1(jk) )     
+         DO ji = 1, jpoce
+            zwb(ji,jk) = zfrac * raintg(ji)
+         END DO
+      ENDDO
+
+
+      DO ji = 1, jpoce
+         zwb(ji,2) = zwb(ji,2) - zgap(ji,2) * dz(2)
+      ENDDO
+
+      DO jk = 3, jpksed
+         zfrac = por1(jk-1) / por1(jk)
+         DO ji = 1, jpoce
+            zwb(ji,jk) = zwb(ji,jk-1) * zfrac - zgap(ji,jk) * dz(jk)
+         END DO
+      ENDDO
+
+
+      zrainrf(:,:) = 0.
+      DO ji = 1, jpoce
+         IF( raintg(ji) /= 0. )  &
+            &   zrainrf(ji,:) = rainrg(ji,:) / raintg(ji)
+      ENDDO
+
+
+      ! Computation of full and empty solid fraction in each layer
+      ! for all 'burial' case
+      !----------------------------------------------------------
+
+
+      DO ji = 1, jpoce
+
+         ! computation of total weight fraction in sediment
+         !-------------------------------------------------
+         zfilled(:) = 0.
+         DO js = 1, jpsol
+            DO jk = 2, jpksed
+               zfilled(jk) = zfilled(jk) + solcp(ji,jk,js)
+            ENDDO
+         ENDDO
+         
+         DO js = 1, jpsol
+            DO jk = 2, jpksed
+               zsolcpno(jk,js) = solcp(ji,jk,js) / zfilled(jk)
+            ENDDO
+         ENDDO
+
+         ! burial  3 cases: 
+         ! zwb > 0 ==> rain > total rection loss 
+         ! zwb = 0 ==> rain = 0
+         ! zwb < 0 ==> rain > 0 and rain < total reaction loss
+         !----------------------------------------------------------------
+
+         IF( zwb(ji,jpksed) > 0. ) THEN
+
+            zfull (jpksed) = zfilled(jpksed)
+            zempty(jpksed) = 1. - zfull(jpksed)
+            DO jk = jpksedm1, 2, -1
+               zfull (jk) = zfilled(jk)
+               zfull (jk) = zfull(jk) - zempty(jk+1) * dvolsp(jk)
+               zempty(jk) = 1. - zfull(jk)
+            ENDDO
+
+            ! Computation of solid sediment species
+            !--------------------------------------
+            ! push entire sediment column downward to account rest of rain
+            DO js = 1, jpsol
+               DO jk = jpksed, 3, -1
+                  solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk-1,js)
+               ENDDO
+
+               solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js)
+
+               DO jk = 2, jpksed
+                  zsolcpno(jk,js) = solcp(ji,jk,js)
+               END DO
+            ENDDO
+
+            zrest = zwb(ji,jpksed) * cpor
+            ! what is remaining is less than dz(2)
+            IF( zrest <= dz(2) ) THEN           
+
+               zfromup(2) = zrest / dz(2)
+               DO jk = 3, jpksed
+                  zfromup(jk) = zwb(ji,jpksed) * ckpor(jk) / dz(jk)
+               ENDDO
+               DO js = 1, jpsol
+                  zfromce = 1. - zfromup(2)
+                  solcp(ji,2,js) = zfromce * zsolcpno(2,js) + zfromup(2) * zrainrf(ji,js)
+                  DO jk = 3, jpksed
+                     zfromce = 1. - zfromup(jk)
+                     solcp(ji,jk,js) = zfromce * zsolcpno(jk,js) + zfromup(jk) * zsolcpno(jk-1,js)
+                  ENDDO
+                  fromsed(ji,js) = 0.
+                  ! quantities to push in deeper sediment
+                  tosed  (ji,js) = zsolcpno(jpksed,js) &
+                     &           * zwb(ji,jpksed) * dens * por1(jpksed) / mol_wgt(js)
+               ENDDO
+               
+            ELSE ! what is remaining is great than dz(2)
+
+               ntimes = INT( zrest / dz(2) ) + 1
+               IF( ntimes > nztime ) THEN
+                  WRITE( numsed,* ) ' sedadv : rest too large at sediment point ji = ', ji
+                  STOP
+               ENDIF
+               zraipush(1) = dz(2)
+               zrest = zrest - zraipush(1)
+               DO jn = 2, ntimes
+                  IF( zrest >= dz(2) ) THEN
+                     zraipush(jn) = dz(2)
+                     zrest = zrest - zraipush(jn)
+                  ELSE
+                     zraipush(jn) = zrest
+                     zrest = 0.
+                  ENDIF
+               ENDDO
+
+               DO jn = 1, ntimes
+                  DO js = 1, jpsol
+                     DO jk = 2, jpksed
+                        zsolcpno(jk,js) = solcp(ji,jk,js)
+                     END DO
+                  ENDDO
+                  
+                  zfromup(2) = zraipush(jn) / dz(2)
+                  DO jk = 3, jpksed
+                     zfromup(jk) = ( zraipush(jn) / dz(jk) ) * c2por(jk)
+                  ENDDO
+
+                  DO js = 1, jpsol
+                     zfromce = 1. - zfromup(2)
+                     solcp(ji,2,js) = zfromce * zsolcpno(2,js) + zfromup(2) * zrainrf(ji,js)
+                     DO jk = 3, jpksed
+                        zfromce = 1. - zfromup(jk)
+                        solcp(ji,jk,js) = zfromce * zsolcpno(jk,js) + zfromup(jk) * zsolcpno(jk-1,js)
+                     ENDDO
+                     fromsed(ji,js) = 0.
+                     tosed  (ji,js) = tosed(ji,js) + zsolcpno(jpksed,js) * zraipush(jn) &
+                        &             * dens * por1(2) / mol_wgt(js)
+                  ENDDO
+               ENDDO
+ 
+            ENDIF
+
+         ELSE IF( raintg(ji) < eps ) THEN ! rain  = 0
+!! Nadia    rloss(:,:) = rainrm(:,:)   bug ??????           
+
+            rloss(ji,1:jpsol) = rainrm(ji,1:jpsol)
+
+            zfull (2) = zfilled(2)
+            zempty(2) = 1. - zfull(2)
+            DO jk = 3, jpksed
+               zfull (jk) = zfilled(jk)
+               zfull (jk) = zfull (jk) - zempty(jk-1) * dvolsm(jk)
+               zempty(jk) = 1. - zfull(jk)
+            ENDDO
+
+            ! fill boxes with weight fraction from underlying box
+            DO js = 1, jpsol
+               DO jk = 2, jpksedm1
+                  solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk+1,js)
+               END DO
+               solcp(ji,jpksed,js) = zsolcpno(jpksed,js) * zfull(jpksed)
+               tosed  (ji,js) = 0.
+               fromsed(ji,js) = 0.
+            ENDDO
+            ! for the last layer, one make go up clay 
+            solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1.
+            !! C. Heinze      fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay)
+            fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay
+
+         ELSE  ! rain > 0 and rain < total reaction loss
+
+
+            DO jk = 2, jpksed
+               zfull (jk) = zfilled(jk)
+               zempty(jk) = 1. - zfull(jk)
+            ENDDO
+
+            ! Determination of indice of layer - ikwneg - where advection is reversed
+            !------------------------------------------------------------------------
+ iflag:     DO jk = 2, jpksed
+               IF( zwb(ji,jk) < 0.  ) THEN
+                  ikwneg = jk
+                  EXIT iflag
+               ENDIF
+            ENDDO iflag
+
+            ! computation of zfull and zempty 
+            ! 3 cases : a/ ikwneg=2, b/ikwneg=3...jpksedm1, c/ikwneg=jpksed    
+            !-------------------------------------------------------------      
+            IF( ikwneg == 2 ) THEN ! advection is reversed in the first sediment layer
+
+               zkwnup = rdtsed(ikwneg) * raintg(ji) / dz(ikwneg)
+               zkwnlo = ABS( zwb(ji,ikwneg) ) / dz(ikwneg)
+               zfull (ikwneg+1) = zfilled(ikwneg+1) - zkwnlo * dvolsm(ikwneg+1)
+               zempty(ikwneg+1) = 1. - zfull(ikwneg+1)
+               DO jk = ikwneg+2, jpksed
+                  zfull (jk) = zfilled(jk) - zempty(jk-1) * dvolsm(jk)
+                  zempty(jk) = 1. - zfull(jk)
+               ENDDO
+               DO js = 1, jpsol
+                  solcp(ji,2,js) = zfull(2) * zsolcpno(2,js)+ zkwnlo * zsolcpno(3,js) &
+                     &                                      + zkwnup * zrainrf(ji,js)
+                  DO jk = 3, jpksedm1
+                     solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk+1,js)
+                  ENDDO
+                  solcp(ji,jpksed,js) = zfull(jpksed) * zsolcpno(jpksed,js)
+                  tosed(ji,js)   = 0.
+                  fromsed(ji,js) = 0.
+               ENDDO
+               solcp(ji,jpksed,jsclay) =  solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1.
+               !! C. Heinze  fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay)
+               fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay
+               
+            ELSE IF( ikwneg == jpksed ) THEN
+
+               zkwnup = ABS( zwb(ji,ikwneg-1) ) * dvolsm(ikwneg) / dz(ikwneg)
+               zkwnlo = ABS( zwb(ji,ikwneg) ) / dz(ikwneg)
+               zfull (ikwneg-1) = zfilled(ikwneg-1) - zkwnup * dvolsp(ikwneg-1)
+               zempty(ikwneg-1) = 1. - zfull(ikwneg-1)
+               DO jk = ikwneg-2, 2, -1
+                  zfull (jk) = zfilled(jk) - zempty(jk+1) * dvolsp(jk)
+                  zempty(jk) = 1. - zfull(jk) 
+               ENDDO
+               DO  js = 1, jpsol
+                  solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js)
+               ENDDO
+               DO  js = 1, jpsol              
+                  DO jk = jpksedm1, 3, -1
+                     solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk-1,js)
+                  ENDDO
+                  solcp(ji,jpksed,js) = zfull(jpksed) * zsolcpno(jpksed,js) &
+                     &                       + zkwnup * zsolcpno(jpksedm1,js)
+                  tosed(ji,js)   = 0.
+                  fromsed(ji,js) = 0.
+               ENDDO
+               solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zkwnlo * 1.
+               ! Heinze  fromsed(ji,jsclay) = zkwnlo * 1. * dens * por1(jpksed) / mol_wgt(jsclay)
+               fromsed(ji,jsclay) = zkwnlo * 1.* por1clay
+            ELSE   ! 2 < ikwneg(ji) <= jpksedm1
+
+               zkwnup = ABS( zwb(ji,ikwneg-1) ) * por1(ikwneg-1) / ( dz(ikwneg) * por1(ikwneg) )
+               zkwnlo = ABS( zwb(ji,ikwneg) ) / dz(ikwneg)
+
+               IF( ikwneg > 3 ) THEN
+
+                  zfull (ikwneg-1) = zfilled(ikwneg-1) - zkwnup * dvolsp(ikwneg-1)
+                  zempty(ikwneg-1) = 1. - zfull(ikwneg-1) 
+                  DO jk = ikwneg-2, 2, -1
+                     zfull (jk) = zfilled(jk) - zempty(jk+1) * dvolsp(jk)
+                     zempty(jk)    = 1. - zfull(jk) 
+                  ENDDO
+                  DO js = 1, jpsol
+                     solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js)
+                  ENDDO
+                  DO js = 1, jpsol
+                     DO jk = ikwneg-1, 3, -1
+                        solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk-1,js)
+                     ENDDO
+                  ENDDO
+               ELSE ! ikw = 3
+
+
+                  zfull (2) = zfilled(2) - zkwnup * dvolsm(3)
+                  zempty(2) = 1. - zfull(2)
+                  DO js = 1, jpsol
+                     solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js)
+                  ENDDO
+               ENDIF
+
+               IF( ikwneg < jpksedm1) THEN
+
+                  zfull (ikwneg+1) = zfilled(ikwneg+1) - zkwnlo * dvolsm(ikwneg+1)
+                  zempty(ikwneg+1) = 1. - zfull(ikwneg+1) 
+                  DO jk = ikwneg+2, jpksed
+                     zfull (jk) = zfilled(jk) - zempty(jk-1) * dvolsm(jk)
+                     zempty(jk) = 1. - zfull(jk)
+                  ENDDO
+                  DO js = 1, jpsol
+                     DO jk = ikwneg+1, jpksedm1
+                        solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk+1,js) 
+                     ENDDO
+                     solcp(ji,jpksed,js) = zfull(jpksed) * zsolcpno(jpksed,js)
+                  ENDDO
+                  solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1.
+               ELSE
+
+                  zfull (jpksed) = zfilled(jpksed) - zkwnlo * dvolsm(jpksed)
+                  zempty(jpksed) = 1. - zfull(jpksed)                
+                  DO js = 1, jpsol
+                     solcp(ji,jpksed,js) = zfull(jpksed) * zsolcpno(jpksed,js)
+                  ENDDO
+                  solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1.
+               ENDIF ! jpksedm1
+               
+               ! ikwneg = jpksedm1  ; ikwneg+1 = jpksed ; ikwneg-1 = jpksed - 2
+               DO js = 1, jpsol
+                  solcp(ji,ikwneg,js) =  zfull(ikwneg) * zsolcpno(ikwneg  ,js) &
+                     &                +  zkwnup        * zsolcpno(ikwneg-1,js) &
+                     &                +  zkwnlo        * zsolcpno(ikwneg+1,js)   
+                  tosed  (ji,js)   = 0.
+                  fromsed(ji,js)   = 0.
+               ENDDO
+               ! Heinze  fromsed(ji,jsclay) = zempty * 1. * dens * por1(jpksed) / mol_wgt(jsclay)
+               fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay
+            ENDIF ! ikwneg(ji) = 2
+         ENDIF  ! zwb > 0
+      ENDDO  ! ji = 1, jpoce
+
+      rainrm(:,:) = 0.
+      rainrg(:,:) = 0.
+      raintg(:)   = 0.
+
+      DEALLOCATE( zsolcpno )   
+      DEALLOCATE( zrainrf  )
+      DEALLOCATE( zfilled  )
+      DEALLOCATE( zfull    )
+      DEALLOCATE( zfromup  )
+      DEALLOCATE( zempty   )
+      DEALLOCATE( zgap     )  
+      DEALLOCATE( zwb      )
+
+
+   END SUBROUTINE sed_adv
+#else
+   !!======================================================================
+   !! MODULE sedbtb  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_adv( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_adv
+
+   !!======================================================================
+
+#endif
+END MODULE sedadv
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90	(revision 8732)
@@ -0,0 +1,129 @@
+MODULE sedarr
+   !!======================================================================
+   !!                       ***  MODULE sedarr   ***
+   !!              transform 1D (2D) array to a 2D (1D) table
+   !!======================================================================
+#if defined key_sed
+   !!----------------------------------------------------------------------
+   !!   arr_2d_1d  : 2-D to 1-D
+   !!   arr_1d_2d  : 1-D to 2-D
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_sed
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE pack_arr
+      MODULE PROCEDURE pack_arr_2d_1d , pack_arr_3d_2d 
+   END INTERFACE
+
+   INTERFACE unpack_arr
+      MODULE PROCEDURE unpack_arr_1d_2d , unpack_arr_2d_3d 
+   END INTERFACE
+
+   !! * Routine accessibility
+   PUBLIC pack_arr
+   PUBLIC unpack_arr
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE pack_arr_2d_1d ( ndim1d, tab1d, tab2d, tab_ind )
+
+      INTEGER, INTENT(in) ::  ndim1d
+      REAL(wp), DIMENSION (jpi, jpj), INTENT(in) :: tab2d
+      INTEGER, DIMENSION (ndim1d), INTENT (in) :: tab_ind
+      REAL(wp), DIMENSION(ndim1d), INTENT (out) ::  tab1d
+
+      INTEGER ::  jn, jid, jjd
+        
+      DO jn = 1, ndim1d
+         jid        = MOD( tab_ind(jn) - 1, jpi ) + 1
+         jjd        = ( tab_ind(jn) - 1 ) / jpi + 1
+         tab1d(jn)  = tab2d(jid, jjd)
+      END DO 
+
+   END SUBROUTINE pack_arr_2d_1d
+
+   SUBROUTINE unpack_arr_1d_2d ( ndim1d, tab2d, tab_ind, tab1d )
+
+      INTEGER, INTENT ( in) ::  ndim1d
+      INTEGER, DIMENSION (ndim1d) , INTENT (in) ::   tab_ind
+      REAL(wp), DIMENSION(ndim1d), INTENT (in) ::   tab1d  
+      REAL(wp), DIMENSION (jpi, jpj), INTENT ( out) ::  tab2d
+      INTEGER ::  jn, jid, jjd
+
+      DO jn = 1, ndim1d
+         jid             = MOD( tab_ind(jn) - 1, jpi) + 1
+         jjd             =    ( tab_ind(jn) - 1 ) / jpi  + 1
+         tab2d(jid, jjd) = tab1d(jn)
+      END DO
+
+   END SUBROUTINE unpack_arr_1d_2d
+
+   SUBROUTINE pack_arr_3d_2d ( ndim1d, tab2d, tab3d, tab_ind )
+
+      INTEGER, INTENT(in) :: ndim1d      
+      REAL(wp), DIMENSION(jpi,jpj,jpksed), INTENT(in) ::   tab3d      
+      INTEGER, DIMENSION(ndim1d), INTENT (in) ::   tab_ind      
+      REAL(wp), DIMENSION(ndim1d,jpksed), INTENT (out) ::    tab2d 
+      INTEGER, DIMENSION(ndim1d) ::  jid, jjd        
+      INTEGER ::    jk, jn , ji, jj
+      
+      DO jn = 1, ndim1d
+         jid(jn) = MOD( tab_ind(jn) - 1, jpi ) + 1
+         jjd(jn) = ( tab_ind(jn) - 1 ) / jpi + 1
+      END DO
+ 
+      DO jk = 1, jpksed
+         DO jn = 1, ndim1d
+            ji = jid(jn)
+            jj = jjd(jn)
+            tab2d(jn,jk)  = tab3d(ji,jj,jk) 
+         ENDDO
+      ENDDO
+      
+   END SUBROUTINE pack_arr_3d_2d
+
+
+   SUBROUTINE unpack_arr_2d_3d ( ndim1d, tab3d, tab_ind, tab2d )
+
+      INTEGER, INTENT(in) :: ndim1d      
+      REAL(wp), DIMENSION(ndim1d,jpksed), INTENT(in) ::   tab2d      
+      INTEGER, DIMENSION(ndim1d), INTENT (in) ::   tab_ind      
+      REAL(wp), DIMENSION(jpi,jpj,jpksed), INTENT (out) ::    tab3d 
+      INTEGER, DIMENSION(ndim1d) ::  jid, jjd        
+      INTEGER ::   jk, jn , ji, jj
+
+     DO jn = 1, ndim1d
+         jid(jn) = MOD( tab_ind(jn) - 1, jpi ) + 1
+         jjd(jn) = ( tab_ind(jn) - 1 ) / jpi + 1
+      END DO
+ 
+      DO jk = 1, jpksed
+         DO jn = 1, ndim1d
+            ji = jid(jn)
+            jj = jjd(jn)
+            tab3d(ji, jj, jk) = tab2d(jn,jk)
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE unpack_arr_2d_3d
+
+#else
+   !!======================================================================
+   !! MODULE sedarr  :   Dummy module
+   !!======================================================================
+CONTAINS
+   SUBROUTINE pack_arr         ! Empty routine
+   END SUBROUTINE  pack_arr
+   SUBROUTINE unpack_arr         ! Empty routine
+   END SUBROUTINE  unpack_arr
+   !!======================================================================
+#endif
+END MODULE sedarr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90	(revision 8732)
@@ -0,0 +1,90 @@
+MODULE sedbtb
+#if defined key_sed
+   !!======================================================================
+   !!              ***  MODULE  sedbtb  ***
+   !!    Sediment : bioturbation of the solid components
+   !!=====================================================================
+   !! * Modules used
+   USE sed     ! sediment global variable
+   USE sedmat  ! linear system of equations
+
+   PUBLIC sed_btb
+
+
+   !! $Id$
+CONTAINS
+   
+   SUBROUTINE sed_btb( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sed_btb  ***
+      !!
+      !! ** Purpose :  performs bioturbation of the solid sediment components
+      !!
+      !! ** Method  :  ``diffusion'' of solid sediment components. 
+      !!
+      !!   History :
+      !!        !  98-08 (E. Maier-Reimer, Christoph Heinze )  Original code
+      !!        !  04-10 (N. Emprin, M. Gehlen ) F90
+      !!        !  06-04 (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+      !!* Arguments
+      INTEGER, INTENT(in) ::  kt              ! time step
+
+      ! * local variables
+      INTEGER :: ji, jk, js
+      REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE ::  zsol  !   solution
+      !------------------------------------------------------------------------
+
+      IF( kt == nitsed000 ) THEN
+         WRITE(numsed,*) ' sed_btb : Bioturbation  '
+         WRITE(numsed,*) ' '
+      ENDIF
+
+      ! Initializations
+      !----------------
+      ALLOCATE( zsol(jpoce,jpksedm1,jpsol) )
+
+      zsol(:,:,:) = 0.
+
+
+      ! right hand side of coefficient matrix
+      !--------------------------------------
+      DO js = 1, jpsol
+         DO jk = 1, jpksedm1
+            DO ji = 1, jpoce
+               zsol(ji,jk,js) = solcp(ji,jk+1,js)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL sed_mat( jpsol, jpoce, jpksedm1, zsol )
+
+
+      ! store solution of the tridiagonal system
+      !------------------------
+      DO js = 1, jpsol
+         DO jk = 1, jpksedm1
+            DO ji = 1, jpoce
+               solcp(ji,jk+1,js) = zsol(ji,jk,js)
+            ENDDO
+         ENDDO
+      ENDDO
+     
+      DEALLOCATE( zsol )
+
+   END SUBROUTINE sed_btb
+#else
+   !!======================================================================
+   !! MODULE sedbtb  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_btb( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_btb: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_btb
+
+   !!======================================================================
+
+#endif
+END MODULE sedbtb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90	(revision 8732)
@@ -0,0 +1,573 @@
+MODULE sedchem
+
+#if defined key_sed 
+   !!======================================================================
+   !!                        ***  Module sedchem  ***
+   !! sediment :   Variable for chemistry of the CO2 cycle
+   !!======================================================================
+   !!   modules used
+   USE sed     ! sediment global variable
+   USE sedarr
+
+   !! * Accessibility
+   PUBLIC sed_chem   
+
+   !! * Module variables
+   REAL(wp) :: &
+      salchl = 1./1.80655 , & ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)
+      calcon = 1.03E-2        ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
+
+   REAL(wp) :: &              ! coeff. for 1. dissoc. of carbonic acid (Millero, 1995)   
+      c10 = 3670.7   , &
+      c11 = 62.008   , &
+      c12 = 9.7944   , &
+      c13 = 0.0118   , &
+      c14 = 0.000116
+
+   REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)   
+      c20 = 1394.7   , &
+      c21 = 4.777    , &
+      c22 = 0.       , &
+      c23 = 0.0184   , &
+      c24 = 0.000118
+
+   REAL(wp) :: &              ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994)
+      cb0  = -8966.90, &
+      cb1  = -2890.53, &
+      cb2  = -77.942 , &
+      cb3  = 1.728   , &
+      cb4  = -0.0996 , &
+      cb5  = 148.0248, &
+      cb6  = 137.1942, &
+      cb7  = 1.62142 , &
+      cb8  = -24.4344, &
+      cb9  = -25.085 , &
+      cb10 = -0.2474 , &
+      cb11 = 0.053105
+
+   REAL(wp) :: &             ! borat constants
+      bor1 = 0.000232, &
+      bor2 = 1./10.811
+
+   REAL(wp) :: &             ! constants for calculate concentrations 
+      st1  = 0.14     , &    ! for sulfate (Morris & Riley 1966)
+      st2  = 1./96.062, &
+      ks0  = 141.328  , &
+      ks1  = -4276.1  , &
+      ks2  = -23.093  , &
+      ks3  = -13856.  , &
+      ks4  = 324.57   , &
+      ks5  = -47.986  , &
+      ks6  = 35474.   , &
+      ks7  = -771.54  , &
+      ks8  = 114.723  , &
+      ks9  = -2698.   , &
+      ks10 = 1776.    , &
+      ks11 = 1.       , &
+      ks12 = -0.001005 
+
+   REAL(wp) :: &             ! constants for calculate concentrations 
+      ft1  = 0.000067   , &  ! fluorides (Dickson & Riley 1979 )
+      ft2  = 1./18.9984 , &
+      kf0  = -12.641    , &
+      kf1  = 1590.2     , &
+      kf2  = 1.525      , &
+      kf3  = 1.0        , &
+      kf4  =-0.001005
+
+   REAL(wp) :: &             ! coeff. for dissoc. of water (Dickson and Riley, 1979 )
+      cw0 = -13847.26  , &
+      cw1 = 148.9802   , &
+      cw2 = -23.6521   , &
+      cw3 = 118.67     , &
+      cw4 = -5.977     , &
+      cw5 = 1.0495     , &
+      cw6 = -0.01615
+ 
+   REAL(wp) :: &             ! coeff. for dissoc. of phosphate (Millero (1974)
+      cp10 = 115.54    , &
+      cp11 = -4576.752 , &
+      cp12 = -18.453   , &
+      cp13 = -106.736  , &
+      cp14 = 0.69171   , &
+      cp15 = -0.65643  , &
+      cp16 = -0.01844  , &
+      cp20 = 172.1033  , &
+      cp21 = -8814.715 , &
+      cp22 = -27.927   , &
+      cp23 = -160.340  , &
+      cp24 = 1.3566    , &
+      cp25 = 0.37335   , &
+      cp26 = -0.05778  , &
+      cp30 = -18.126   , &
+      cp31 = -3070.75  , &
+      cp32 = 17.27039  , &
+      cp33 = 2.81197   , &
+      cp34 = -44.99486 , &
+      cp35 = -0.09984
+
+   REAL(wp) :: &             ! coeff. for dissoc. of silicates (Millero (1974)  
+      cs10 = 117.40    , &  
+      cs11 = -8904.2   , & 
+      cs12 = -19.334   , & 
+      cs13 = -458.79   , & 
+      cs14 = 3.5913    , & 
+      cs15 = 188.74    , & 
+      cs16 = -1.5998   , & 
+      cs17 = -12.1652  , & 
+      cs18 = 0.07871   , & 
+      cs19 = 0.        , & 
+      cs20 = 1.        , & 
+      cs21 = -0.001005
+
+   REAL(wp) :: &            ! coeff. for apparent solubility equilibrium 
+      ! akcc1 = -34.452 , & ! of calcite (Ingle,1975,  1800, eq. 6)
+      ! akcc2 = -39.866 , &  
+      ! akcc3 = 110.21  , &  
+      ! akcc4 = -7.5752E-6  
+      akcc1 = -171.9065 , &    ! Millero et al. 1995 from Mucci 1983
+      akcc2 = -0.077993 , &  
+      akcc3 = 2839.319  , &  
+      akcc4 = 71.595    , &  
+      akcc5 = -0.77712  , &  
+      akcc6 = 0.0028426 , &  
+      akcc7 = 178.34    , &  
+      akcc8 = -0.07711  , &  
+      akcc9 = 0.0041249
+
+   REAL(wp) :: &                 ! universal gas constant
+      rgas = 83.145              ! bar.cm3/(mol.K) or R=8.31451 J/(g.mol.K)
+
+
+   ! coeff. for seawater pressure correction (millero 95)		
+   REAL(wp), DIMENSION(8)  :: & 
+      devk1, devk2, devk3, devk4, devk5
+
+   DATA devk1/ -25.5   , -15.82    , -29.48  , -25.60    , -48.76    , -14.51   , -23.12   , -26.57   /   
+   DATA devk2/ 0.1271  , -0.0219   , 0.1622  , 0.2324    , -0.5304   , 0.1211   ,  0.1758  , 0.2020   /   
+   DATA devk3/ 0.      , 0.        , 2.608E-3, -3.6246E-3, 0.        , -0.321E-3, -2.647E-3, -3.042E-3/   
+   DATA devk4/-3.08E-3 , 1.13E-3   , -2.84E-3, -5.13E-3  , -11.76E-3 , -2.67E-3 , -5.15E-3 , -4.08E-3 /   
+   DATA devk5/0.0877E-3, -0.1475E-3, 0.      , 0.0794E-3 , -0.3692E-3, 0.0427E-3,  0.09E-3 , 0.0714E-3/
+
+
+   ! coeff. for density of sea water (Millero & Poisson 1981) 
+   REAL(wp), DIMENSION(5)  :: Adsw                       
+   DATA Adsw/8.24493E-1, -4.0899E-3, 7.6438E-5 , -8.246E-7, 5.3875E-9 /
+
+   REAL(wp), DIMENSION(3)  :: Bdsw 
+   DATA Bdsw / -5.72466E-3, 1.0227E-4, -1.6546E-6 /
+
+   REAL(wp)  :: Cdsw = 4.8314E-4
+
+   REAL(wp), DIMENSION(6)  :: Ddsw                    
+   DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/
+
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE sed_chem( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_chem  ***
+      !!
+      !! ** Purpose :   set chemical constants
+      !!
+      !!   History :
+      !!        !  04-10  (N. Emprin, M. Gehlen )  Original code
+      !!        !  06-04  (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+      !!* Arguments
+      INTEGER, INTENT(in) :: kt                     ! time step
+
+#if ! defined key_sed_off
+      INTEGER  :: ji, jj, ikt
+      REAL(wp) :: ztkel, ztc, ztc2, zpres, ztr 
+      REAL(wp) :: zsal, zsal2, zsqrt, zsal15  
+      REAL(wp) :: zis, zis2, zisqrt          
+      REAL(wp) :: zdens0, zaw, zbw, zcw    
+      REAL(wp) :: zbuf1, zbuf2 
+      REAL(wp) :: zcpexp, zcpexp2
+      REAL(wp) :: zck1p, zck2p, zck3p, zcksi   
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zchem_data
+
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( MOD( kt - 1, nfreq ) /= 0 ) RETURN
+
+      WRITE(numsed,*) ' Getting Chemical constants from tracer model at time kt = ', kt
+      WRITE(numsed,*) ' '
+
+
+#if defined key_sed_off
+      CALL sed_chem_off
+#else
+      ! reading variables
+      ALLOCATE( zchem_data(jpi,jpj,6) )   ;   zchem_data(:,:,:) = 0.
+
+      DO jj = 1,jpj
+         DO ji = 1, jpi
+            ikt = mbkt(ji,jj) 
+            IF ( tmask(ji,jj,ikt) == 1 ) THEN
+               zchem_data(ji,jj,1) = ak13 (ji,jj,ikt)
+               zchem_data(ji,jj,2) = ak23 (ji,jj,ikt)
+               zchem_data(ji,jj,3) = akb3 (ji,jj,ikt)
+               zchem_data(ji,jj,4) = akw3 (ji,jj,ikt)
+               zchem_data(ji,jj,5) = aksp (ji,jj,ikt)
+               zchem_data(ji,jj,6) = borat(ji,jj,ikt)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      CALL pack_arr ( jpoce, ak1s  (1:jpoce), zchem_data(1:jpi,1:jpj,1), iarroce(1:jpoce) )
+      CALL pack_arr ( jpoce, ak2s  (1:jpoce), zchem_data(1:jpi,1:jpj,2), iarroce(1:jpoce) )
+      CALL pack_arr ( jpoce, akbs  (1:jpoce), zchem_data(1:jpi,1:jpj,3), iarroce(1:jpoce) )
+      CALL pack_arr ( jpoce, akws  (1:jpoce), zchem_data(1:jpi,1:jpj,4), iarroce(1:jpoce) )
+      CALL pack_arr ( jpoce, aksps (1:jpoce), zchem_data(1:jpi,1:jpj,5), iarroce(1:jpoce) )
+      CALL pack_arr ( jpoce, borats(1:jpoce), zchem_data(1:jpi,1:jpj,6), iarroce(1:jpoce) )
+
+      DEALLOCATE( zchem_data )
+
+      DO ji = 1, jpoce
+         ztkel   = temp(ji) + 273.16
+         ztc     = temp(ji)
+         ztc2    = ztc * ztc
+         zpres   = press(ji)
+         ! zqtt    = ztkel * 0.01
+         zsal    = salt(ji)
+         zsal2   = zsal * zsal 
+         zsqrt   = SQRT( zsal )
+         zsal15  = zsqrt * zsal
+         zlogt   = LOG( ztkel )
+         ztr     = 1./ ztkel
+         ! zis=ionic strength (ORNL/CDIAC-74, DOE 94,Dickson and Goyet)
+         zis     = 19.924 * zsal / ( 1000. - 1.005 * zsal )
+         zis2    = zis * zis
+         zisqrt  = SQRT( zis )
+
+         ! Density of Sea Water - F(temp,sal) [kg/m3]
+         zdens0 =  Ddsw(1) + Ddsw(2) * ztc + Ddsw(3) * ztc2 &
+                  + Ddsw(4) * ztc * ztc2 + Ddsw(5) * ztc2 * ztc2 &
+                  + Ddsw(6) * ztc * ztc2 * ztc2
+         zaw =  Adsw(1) + Adsw(2) * ztc + Adsw(3)* ztc2 + Adsw(4) * ztc * ztc2 &
+              + Adsw(5) * ztc2 * ztc2
+         zbw =  Bdsw(1) + Bdsw(2) * ztc + Bdsw(3) * ztc2
+         zcw =  Cdsw
+         densSW(ji) = zdens0 + zaw * zsal + zbw * zsal15 + zcw * zsal * zsal
+         densSW(ji) = densSW(ji) * 1E-3   ! to get dens in [kg/l]
+
+         ! FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970) 
+         ! (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE IN BROECKER ET AL. (1982) 
+         ! IS INCORRECT; HERE RGAS IS TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN
+         ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS MULTIPLIED BY LN(10.) 
+         ! TO ALLOW USE OF EXP-FUNCTION WITH BASIS E IN THE FORMULA FOR AKSPP 
+         ! (CF. EDMOND AND GIESKES (1970), P. 1285 AND P. 1286 (THE SMALL FORMULA ON P. 1286 
+         ! IS RIGHT AND CONSISTENT WITH THE SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)
+         !-----------------------------------------------------------------------------------------
+         zcpexp  = zpres / ( rgas*ztkel )
+         zcpexp2 = zpres * zcpexp
+
+         ! For Phodphates (phosphoric acid) (DOE 1994)
+         !----------------------------------------------
+         zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt &
+            &      + ( cp15*ztr + cp16 ) * zsal
+         zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt &
+            &      + ( cp25*ztr + cp26 ) * zsal
+         zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) *  zsqrt &
+            &      + ( cp34*ztr + cp35 ) * zsal
+
+         ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP)
+         !--------------------------------------------------------
+         zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt &
+            &      + ( cs15*ztr + cs16 ) * zis &
+            &      + ( cs17*ztr + cs18 ) * zis2 &
+            &      + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal )
+
+
+         !K1, K2 of carbonic acid, KB of boric acid, KW (H2O)
+         !---------------------------------------------------
+         zak1p  = EXP ( zck1p  )
+         zak2p  = EXP ( zck2p  )
+         zak3p  = EXP ( zck3p  )
+         zaksil = EXP ( zcksi  )
+
+         zbuf1       = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(3) + devk5(3)*ztc )
+         aksis(ji)     = zaksil * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = - ( devk1(6) + devk2(6)*ztc + devk3(6)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(6) + devk5(6)*ztc )
+         ak1ps(ji)   = zak1p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+ 
+         zbuf1       = - ( devk1(7) + devk2(7)*ztc + devk3(7)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(7) + devk5(7)*ztc )
+         ak2ps(ji)   = zak2p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = - ( devk1(8) + devk2(8)*ztc + devk3(8)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(8) + devk5(8)*ztc )
+         ak3ps(ji)   = zak3p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         ak12s  (ji) = ak1s (ji) * ak2s (ji)
+         ak12ps (ji) = ak1ps(ji) * ak2ps(ji)
+         ak123ps(ji) = ak1ps(ji) * ak2ps(ji) * ak3ps(ji)
+
+         calcon2(ji) = 0.01028 * ( salt(ji) / 35. ) * densSW(ji)
+      ENDDO
+
+       
+#endif
+
+   END SUBROUTINE sed_chem
+
+#if defined key_sed_off
+
+   SUBROUTINE sed_chem_off
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_chem_off  ***
+      !!                    
+      !! ** Purpose :   compute chemical constants
+      !!
+      !!   History :
+      !!        !  04-10  (N. Emprin, M. Gehlen )  Original code
+      !!        !  06-04  (C. Ethe)  Re-organization 
+      !!----------------------------------------------------------------------  
+      !! * Local declarations
+      INTEGER :: ji
+
+      REAL(wp) ::  ztkel, ztc, ztc2, zpres, ztr 
+      REAL(wp) ::  zsal, zsal2, zsqrt, zsal15   
+      REAL(wp) ::  zis, zis2, zisqrt            
+      REAL(wp) ::  zdens0, zaw, zbw, zcw        
+      REAL(wp) ::  zchl, zst, zft, zbuf1, zbuf2 
+      REAL(wp) ::  zcpexp, zcpexp2              
+      REAL(wp) ::  zckb, zck1, zck2, zckw       
+      REAL(wp) ::  zck1p, zck2p, zck3p, zcksi   
+      REAL(wp) ::  zak1, zak2, zakb, zakw              
+      REAL(wp) ::  zaksp0, zksp, zks, zkf 
+
+
+      ! CHEMICAL CONSTANTS - DEEP OCEAN
+      !-------------------------------------
+      ! [chem constants]=mol/kg solution (or (mol/kg sol)2 for akws and aksp)
+
+      DO ji = 1, jpoce
+         ztkel   = temp(ji) + 273.16
+         ztc     = temp(ji)
+         ztc2    = ztc * ztc
+         zpres   = press(ji)
+         ! zqtt    = ztkel * 0.01
+         zsal    = salt(ji)
+         zsal2   = zsal * zsal 
+         zsqrt   = SQRT( zsal )
+         zsal15  = zsqrt * zsal
+         zlogt   = LOG( ztkel )
+         ztr     = 1./ ztkel
+         ! zis=ionic strength (ORNL/CDIAC-74, DOE 94,Dickson and Goyet)
+         zis     = 19.924 * zsal / ( 1000. - 1.005 * zsal )
+         zis2    = zis * zis
+         zisqrt  = SQRT( zis )
+
+
+         ! Density of Sea Water - F(temp,sal) [kg/m3]
+         zdens0 =  Ddsw(1) + Ddsw(2) * ztc + Ddsw(3) * ztc2 &
+                  + Ddsw(4) * ztc * ztc2 + Ddsw(5) * ztc2 * ztc2 &
+                  + Ddsw(6) * ztc * ztc2 * ztc2
+         zaw =  Adsw(1) + Adsw(2) * ztc + Adsw(3)* ztc2 + Adsw(4) * ztc * ztc2 &
+              + Adsw(5) * ztc2 * ztc2
+         zbw =  Bdsw(1) + Bdsw(2) * ztc + Bdsw(3) * ztc2
+         zcw =  Cdsw
+         densSW(ji) = zdens0 + zaw * zsal + zbw * zsal15 + zcw * zsal * zsal
+         densSW(ji) = densSW(ji) * 1E-3   ! to get dens in [kg/l]
+
+
+         ! FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970) 
+         ! (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE IN BROECKER ET AL. (1982) 
+         ! IS INCORRECT; HERE RGAS IS TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN
+         ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS MULTIPLIED BY LN(10.) 
+         ! TO ALLOW USE OF EXP-FUNCTION WITH BASIS E IN THE FORMULA FOR AKSPP 
+         ! (CF. EDMOND AND GIESKES (1970), P. 1285 AND P. 1286 (THE SMALL FORMULA ON P. 1286 
+         ! IS RIGHT AND CONSISTENT WITH THE SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)
+         !-----------------------------------------------------------------------------------------
+         zcpexp  = zpres / ( rgas*ztkel )
+         zcpexp2 = zpres * zcpexp
+
+
+         ! chlorinity (WOOSTER ET AL., 1969)
+         !---------------------------------------
+         zchl = zsal * salchl
+
+         ! total sulfate concentration [mol/kg soln]
+         ! --------------------------------------
+         zst = st1 * zchl * st2
+
+         ! total fluoride concentration [mol/kg soln]
+         ! --------------------------------------
+         zft = ft1 * zchl * ft2
+
+         ! dissociation constant for carbonate (Mehrback 74 - Dickson & Millero 87)
+         !---------------------------------------------------------------------------
+         zck1 = c10*ztr - c11 + c12*zlogt - c13*zsal + c14*zsal2
+         zck2 = c20*ztr + c21 - c22*zlogt - c23*zsal + c24*zsal2
+
+         ! dissociation constant for sulfates (Dickson 1990)
+         !--------------------------------------------------
+         zks = EXP(  ks0 + ks1*ztr + ks2*zlogt &
+            &    + ( ks3*ztr + ks4 + ks5*zlogt ) * zisqrt &
+            &    + ( ks6*ztr + ks7 + ks8*zlogt ) * zis    &
+            &    +   ks9*ztr*zis*zisqrt + ks10*ztr*zis2   &
+            &    +   LOG( ks11 + ks12*zsal ) )
+
+         ! dissociation constant for fluorides (Dickson and Riley 79)
+         !--------------------------------------------------
+         zkf = EXP( kf0 + kf1*ztr + kf2*zisqrt + LOG( kf3 + kf4*zsal ) )
+
+         ! dissociation constant for borates (Doe 94)
+         !--------------------------------------------------
+         zckb = (  cb0 + cb1*zsqrt + cb2*zsal + cb3*zsal15 + cb4*zsal2) * ztr &
+            &  + ( cb5 + cb6*zsqrt + cb7*zsal) &
+            &  + ( cb8 + cb9*zsqrt + cb10*zsal) * zlogt &
+            &  +   cb11*zsqrt*ztkel + LOG( ( 1. + zst/zks + zft/zkf ) / ( 1. + zst/zks ) ) 
+
+         ! PKW (H2O) (DICKSON AND RILEY, 1979)
+         !--------------------------------------
+         zckw =   cw0*ztr + cw1 + cw2*zlogt &
+            & +( cw3*ztr + cw4 + cw5*zlogt )* zsqrt + cw6*zsal
+         
+         ! For Phodphates (phosphoric acid) (DOE 1994)
+         !----------------------------------------------
+         zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt &
+            &      + ( cp15*ztr + cp16 ) * zsal
+         zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt &
+            &      + ( cp25*ztr + cp26 ) * zsal
+         zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) *  zsqrt &
+            &      + ( cp34*ztr + cp35 ) * zsal
+
+         ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP)
+         !--------------------------------------------------------
+         zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt &
+            &      + ( cs15*ztr + cs16 ) * zis &
+            &      + ( cs17*ztr + cs18 ) * zis2 &
+            &      + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal )
+
+         ! apparent solublity product K'SP of calcite in seawater
+         ! (S=27-43, T=2-25 DEG C) AT pres =0 (INGLE, 1975, EQ. 6)
+         ! prob: olivier a log = ln et C. Heize a LOG10(sal)
+         ! aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log(sal)+akcc4*tkel*tkel)
+         ! aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log10(sal)+akcc4*tkel*tkel)
+         !--------------------------------------------------------------------
+         zaksp0 = akcc1 + akcc2*ztkel + akcc3*ztr + akcc4 * LOG10(ztkel) &
+            &  + ( akcc5 + akcc6*ztkel+ akcc7*ztr ) * zsqrt &
+            &  +  akcc8*zsal + akcc9*zsal15
+
+         !K1, K2 of carbonic acid, KB of boric acid, KW (H2O)
+         !---------------------------------------------------
+         zak1   = 10**( -zck1  )
+         zak2   = 10**( -zck2  )
+         zakb   = EXP ( zckb   ) 
+         zakw   = EXP ( zckw   )
+         zksp   = 10**( zaksp0 )
+
+
+
+         ! KB of boric acid, K1,K2 of carbonic acid pressure correction 
+         ! after Culberson and  AND Pytkowicz (1968) (CF. BROECKER ET AL., 1982) Millero 95
+         !--------------------------------------------------------------------------------
+         zbuf1       = - ( devk1(1) + devk2(1)*ztc + devk3(1)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(1) + devk5(1)*ztc )
+         ak1s(ji)    = zak1 * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = -( devk1(2) + devk2(2)*ztc + devk3(2)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(2) + devk5(2)*ztc )
+         ak2s(ji)    = zak2 * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(3) + devk5(3) * ztc )
+         akbs(ji)    = zakb * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = - ( devk1(4) + devk2(4)*ztc + devk3(4)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(4) + devk5(4)*ztc )
+         akws(ji)    = zakw * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+
+         ! APPARENT SOLUBILITY PRODUCT K''SP OF CALCITE (OR ARAGONITE)
+         ! AS FUNCTION OF PRESSURE FOLLWING EDMOND AND GIESKES (1970)
+         ! (P. 1285) AND BERNER (1976)
+         !-----------------------------------------------------------------
+         ! aksp(ji) = aksp0*exp(zcpexp*(devks-devkst*tc))
+         ! or following Mucci
+         zbuf1      = - ( devk1(5) + devk2(5)*ztc + devk3(5)*ztc2 )
+         zbuf2      = 0.5 *( devk4(5) + devk5(5)*ztc )
+         aksps(ji)   = zksp * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         ! For Phodphates (phosphoric acid) (DOE 1994)
+         !----------------------------------------------
+         zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt &
+            &      + ( cp15*ztr + cp16 ) * zsal
+         zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt &
+            &      + ( cp25*ztr + cp26 ) * zsal
+         zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) *  zsqrt &
+            &      + ( cp34*ztr + cp35 ) * zsal
+
+         ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP)
+         !--------------------------------------------------------
+         zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt &
+            &      + ( cs15*ztr + cs16 ) * zis &
+            &      + ( cs17*ztr + cs18 ) * zis2 &
+            &      + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal )
+
+
+         !K1, K2 of carbonic acid, KB of boric acid, KW (H2O)
+         !---------------------------------------------------
+         zak1p  = EXP ( zck1p  )
+         zak2p  = EXP ( zck2p  )
+         zak3p  = EXP ( zck3p  )
+         zaksil = EXP ( zcksi  )
+
+         zbuf1       = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(3) + devk5(3)*ztc )
+         aksis(ji)     = zaksil * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = - ( devk1(6) + devk2(6)*ztc + devk3(6)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(6) + devk5(6)*ztc )
+         ak1ps(ji)   = zak1p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+ 
+         zbuf1       = - ( devk1(7) + devk2(7)*ztc + devk3(7)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(7) + devk5(7)*ztc )
+         ak2ps(ji)   = zak2p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         zbuf1       = - ( devk1(8) + devk2(8)*ztc + devk3(8)*ztc2 )
+         zbuf2       = 0.5 * ( devk4(8) + devk5(8)*ztc )
+         ak3ps(ji)   = zak3p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 )
+
+         ! total borat concentration. [mol/l]
+         ! or from Millero 1995 [mol/l] : borat(l) = 0.000416_8*(sal/35._8)*densSW(l)
+         ! --------------------------------------------------------------------------
+         borats(ji) = bor1 * zchl * bor2 * densSW(ji)
+
+         ak12s  (ji) = ak1s (ji) * ak2s (ji)
+         ak12ps (ji) = ak1ps(ji) * ak2ps(ji)
+         ak123ps(ji) = ak1ps(ji) * ak2ps(ji) * ak3ps(ji)
+
+         calcon2(ji) = 0.01028 * ( zsal / 35. ) * densSW(ji)
+
+      ENDDO
+
+   END SUBROUTINE sed_chem_off
+
+#endif
+
+#else
+   !!======================================================================
+   !! MODULE sedchem  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_chem( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_chem
+
+   !!======================================================================
+
+#endif
+
+END MODULE sedchem
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90	(revision 8732)
@@ -0,0 +1,202 @@
+MODULE sedco3
+#if defined key_sed
+   !!======================================================================
+   !!              ***  MODULE  sedco3  ***
+   !!    Sediment : carbonate in sediment pore water
+   !!=====================================================================
+   !! * Modules used
+   USE sed     ! sediment global variable
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC sed_co3     
+
+
+   !! * Module variables
+   REAL(wp) :: epsmax   =  1.e-12      ! convergence limite value
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0   !   LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+
+   !! $Id$
+CONTAINS
+
+
+   SUBROUTINE sed_co3( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_co3  ***
+      !!
+      !! ** Purpose :  carbonate ion and proton concentration 
+      !!               in sediment pore water
+      !!
+      !! ** Methode :  - solving nonlinear equation for [H+] with given alkalinity
+      !!               and total co2 
+      !!               - one dimensional newton-raphson algorithm for [H+])
+      !!
+      !!   History :
+      !!        !  98-08 (E. Maier-Reimer, Christoph Heinze )  Original code
+      !!        !  04-10 (N. Emprin, M. Gehlen ) coupled with PISCES
+      !!        !  06-04 (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(in)  :: kt   ! time step
+
+      !
+      !---Local variables
+      INTEGER  :: jiter, ji, jk, ipt  ! dummy loop indices
+
+      INTEGER  :: itermax             ! maximum number of Newton-Raphson iterations
+      INTEGER  :: itime               ! number of time to perform Newton-Raphson algorithm
+      LOGICAL  :: lconv = .FALSE.     ! flag for convergence
+      REAL(wp) :: brems               !  relaxation. parameter
+      REAL(wp) :: zresm, zresm1, zhipor_min 
+      REAL(wp) :: zalk, zbor, zsil, zpo4, zdic
+      REAL(wp) :: zh_old, zh_old2, zh_old3, zh_old4
+      REAL(wp) :: zuu, zvv, zduu, zdvv 
+      REAL(wp) :: zup, zvp, zdup, zdvp
+      REAL(wp) :: zah_old, zah_olds
+      REAL(wp) :: zh_new, zh_new2, zco3
+
+     !!----------------------------------------------------------------------
+
+      IF( kt == nitsed000 ) THEN
+         WRITE(numsed,*) ' sed_co3 : carbonate ion and proton concentration calculation  '
+         WRITE(numsed,*) ' '
+      ENDIF
+
+      itermax     = 30
+      brems       = 1.
+      itime       = 0
+
+
+      DO jk = 1, jpksed
+10001    CONTINUE
+         IF( itime <= 2 ) THEN
+            lconv  = .FALSE.
+            IF( itime > 0 ) THEN  
+               ! increase max number of iterations and relaxation parameter
+               itermax = 200
+!!               brems   = 0.3
+               IF( itime == 2 ) hipor(1:jpoce,jk) = 3.e-9 ! re-initilazation of [H] values
+            ENDIF
+
+iflag:      DO jiter = 1, itermax
+
+                ! Store previous hi field.   
+               zresm = -1.e10
+               ipt = 1
+               DO ji = 1, jpoce
+                  ! dissociation constant are in mol/kg of solution
+                  ! convert pwcp concentration [mol/l] in mol/kg for solution
+                  zalk    = pwcp(ji,jk,jwalk) / densSW(ji)
+                  zh_old  = hipor(ji,jk) / densSW(ji)
+                  zh_old2 = zh_old  * zh_old
+                  zh_old3 = zh_old2 * zh_old
+                  zh_old4 = zh_old3 * zh_old
+                  zbor    = borats(ji) / densSW(ji)
+                  zsil    = pwcp(ji,jk,jwsil) / densSW(ji)
+                  zpo4    = pwcp(ji,jk,jwpo4) / densSW(ji)
+                  zdic    = pwcp(ji,jk,jwdic) / densSW(ji)               
+                  ! intermediate calculation 
+                  zuu     = zdic * ( ak1s(ji) / zh_old + 2.* ak12s(ji) / zh_old2 )
+                  zvv     = 1. + ak1s(ji) / zh_old + ak12s(ji) / zh_old2
+                  zduu    = zdic * ( -ak1s(ji) / zh_old2 - 4. * ak12s(ji) / zh_old3 )
+                  zdvv    = -ak1s(ji) / zh_old2 - 2. * ak12s(ji) / zh_old3
+                  zup     = zpo4 * ( ak12ps(ji) / zh_old2 + 2. * ak123ps(ji) / zh_old3 - 1.)
+                  zvp     = 1. + ak1ps(ji) / zh_old + ak12ps(ji) / zh_old2 + ak123ps(ji) / zh_old3
+                  zdup    = zpo4 * ( -2. * ak12ps(ji) / zh_old3 - 6. * ak123ps(ji) / zh_old4 )
+                  zdvp    = -ak1ps(ji) / zh_old2 - 2.* ak12ps(ji) / zh_old3 - 3. * ak123ps(ji) / zh_old4
+                  
+                  zah_old  = zuu / zvv + zbor / ( 1. + zh_old / akbs(ji) ) + &
+                     &      akws(ji) / zh_old - zh_old + zsil / ( 1. + zh_old / aksis(ji) ) + &
+                     &      zup / zvp
+                  
+                  zah_olds = ( ( zduu * zvv - zdvv * zuu ) / ( zvv * zvv ) )      - &
+                     &        zbor / akbs(ji) * ( 1. + zh_old / akbs(ji) )**(-2) - &
+                     &        akws(ji) / zh_old2 - 1. -                            &
+                     &        zsil / aksis(ji) * ( 1. + zh_old / aksis(ji) )**(-2) + &
+                     &       ( ( zdup * zvp - zdvp * zup ) / ( zvp * zvp ) )
+                  !
+                  zh_new = zh_old - brems * ( zah_old - zalk ) / zah_olds
+                  ! 
+                  zresm1 = ABS( zh_new - zh_old )
+                  IF( zresm1 > zresm ) THEN 
+                     zresm = zresm1  
+                  ENDIF
+                  !
+                  zh_new2  = zh_new * zh_new
+                  zco3   = ( ak12s(ji) * zdic ) / ( ak12s(ji) + ak1s(ji) * zh_new + zh_new2)
+                  ! again in mol/l
+                  hipor (ji,jk) = zh_new * densSW(ji)
+                  co3por(ji,jk) = zco3   * densSW(ji)
+                  
+               ENDDO  ! end loop ji
+               
+               ! convergence test
+               IF( zresm <= epsmax ) THEN
+                  lconv = .TRUE.
+                  !minimum value of hipor
+                  zhipor_min = MINVAL( hipor(1:jpoce,jk ) )
+                  EXIT iflag
+               ENDIF
+
+            ENDDO iflag
+
+            IF( lconv ) THEN
+!               WRITE(numsed,*) ' convergence after iter =', jiter, ' iterations ;  res =',zresm  
+               IF( zhipor_min < 0. ) THEN 
+                  IF ( itime == 0 ) THEN
+!                     WRITE(numsed,*) '    but hipor < 0 ; try one more time for jk = ', jk 
+!                     WRITE(numsed,*) '    with re-initialization of initial PH field '       
+                     itime = 2
+                     GOTO 10001
+                  ELSE
+!                     WRITE(numsed,*) ' convergence after iter =', jiter, ' iterations ;  res =',zresm 
+!                     WRITE(numsed,*) '    but hipor < 0, again for second time for jk = ', jk 
+!                     WRITE(numsed,*) ' We stop : STOP '
+                     STOP
+                  ENDIF
+               ELSE
+!                  WRITE(numsed,*) ' successfull convergence for level jk = ',jk,&
+!                     &               '  after iter =', jiter, ' iterations ;  res =',zresm  
+!                  WRITE(numsed,*) ' '
+                  itime = 0
+               ENDIF
+            ELSE
+               itime = itime + 1
+               WRITE(numsed,*) ' No convergence for jk = ', jk, ' after ', itime, '  try'            
+               IF ( itime == 1 ) THEN
+                  WRITE(numsed,*) ' try one more time with more iterations and higher relax. value'
+                  GOTO 10001
+               ELSE IF ( itime == 2 ) THEN
+                  WRITE(numsed,*) ' try one more time for with more iterations, higher relax. value'               
+                  WRITE(numsed,*) ' and with re-initialization of initial PH field ' 
+               ELSE       
+                  WRITE(numsed,*) ' No more... we stop '
+                  STOP
+               ENDIF
+            ENDIF
+         ENDIF
+     ENDDO
+
+   END SUBROUTINE sed_co3
+#else
+   !!======================================================================
+   !! MODULE sedco3  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_co3( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_co3: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_co3
+
+   !!======================================================================
+
+#endif
+
+END MODULE sedco3
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90	(revision 8732)
@@ -0,0 +1,541 @@
+MODULE seddsr
+#if defined key_sed
+   !!======================================================================
+   !!              ***  MODULE  seddsr  ***
+   !!    Sediment : dissolution and reaction in pore water
+   !!=====================================================================
+   !! * Modules used
+   USE sed     ! sediment global variable
+   USE sedmat  ! linear system of equations
+   USE sedco3  ! carbonate ion and proton concentration 
+
+   PUBLIC sed_dsr
+
+   !! * Module variables
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: cons_o2
+   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: cons_no3
+   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: sour_no3
+   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: sour_c13
+   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC ::  dens_mol_wgt  ! molecular density 
+
+   !! $Id$
+CONTAINS
+   
+   SUBROUTINE sed_dsr( kt ) 
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_dsr  ***
+      !! 
+      !!  ** Purpose :  computes pore water dissolution and reaction
+      !!
+      !!  ** Methode :  implicit simultaneous computation of undersaturation
+      !!               resulting from diffusive pore water transport and chemical
+      !!               pore water reactions. Solid material is consumed according
+      !!               to redissolution and remineralisation
+      !!
+      !!  ** Remarks :
+      !!              - undersaturation : deviation from saturation concentration
+      !!              - reaction rate   : sink of undersaturation from dissolution
+      !!                                 of solid material 
+      !!
+      !!   History :
+      !!        !  98-08 (E. Maier-Reimer, Christoph Heinze )  Original code
+      !!        !  04-10 (N. Emprin, M. Gehlen ) f90
+      !!        !  06-04 (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+      !! Arguments
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      ! --- local variables
+      INTEGER :: ji, jk, js, jw   ! dummy looop indices
+      INTEGER :: nv               ! number of variables in linear tridiagonal eq
+
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrearat    ! reaction rate in pore water
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zundsat    ! undersaturation ; indice jpwatp1 is for calcite   
+      REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zmo2_0, zmo2_1  ! temp. array for mass balance calculation
+      REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zmno3_0, zmno3_1, zmno3_2
+      REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zmc13_0, zmc13_1, zmc13_2, zmc13_3
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zvolc    ! temp. variables
+      REAL(wp)  ::  zsolid1, zsolid2, zsolid3, zvolw, zreasat
+
+      !!
+      !!----------------------------------------------------------------------
+
+      IF( kt == nitsed000 ) THEN
+         WRITE(numsed,*) ' sed_dsr : Dissolution reaction '
+         WRITE(numsed,*) ' '
+         ! 
+         ALLOCATE( dens_mol_wgt((jpoce) ) 
+         dens_mol_wgt(1:jpsol) = dens / mol_wgt(1:jpsol)
+         ! 
+         ALLOCATE( cons_o2 (jpoce) ) ;   ALLOCATE( cons_no3(jpoce) ) 
+         ALLOCATE( sour_no3(jpoce) ) ;   ALLOCATE( sour_c13(jpoce) )  
+      ENDIF
+
+      ! Initialization of data for mass balance calculation
+      !---------------------------------------------------
+
+      tokbot(:,:)  = 0.
+      cons_o2 (:)  = 0. 
+      cons_no3(:)  = 0.  
+      sour_no3(:)  = 0.  
+      sour_c13(:)  = 0.       
+   
+      ! Initializations
+      !----------------------
+      ALLOCATE( zmo2_0 (jpoce) ) ;  ALLOCATE( zmo2_1 (jpoce) ) 
+      ALLOCATE( zmno3_0(jpoce) ) ;  ALLOCATE( zmno3_1(jpoce) )  ;  ALLOCATE( zmno3_2(jpoce) ) 
+      ALLOCATE( zmc13_0(jpoce) ) ;  ALLOCATE( zmc13_1(jpoce) )  ;  ALLOCATE( zmc13_2(jpoce) ) ;  ALLOCATE( zmc13_3(jpoce) ) 
+
+      zmo2_0 (:) = 0.  ; zmo2_1 (:) = 0.
+      zmno3_0(:) = 0.  ; zmno3_1(:) = 0.  ;  zmno3_2(:) = 0.
+      zmc13_0(:) = 0.  ; zmc13_1(:) = 0.  ;  zmc13_2(:) = 0.  ; zmc13_3(:) = 0.
+      
+      ALLOCATE( zrearat(jpoce,jpksed,3) ) ;  ALLOCATE( zundsat(jpoce,jpksed,3) )      
+      zrearat(:,:,:)   = 0.    ;   zundsat(:,:,:) = 0. 
+
+
+      ALLOCATE( zvolc(jpoce,jpksed,jpsol) ) 
+      zvolc(:,:,:)   = 0.
+
+      !--------------------------------------------------------------------
+      ! Temporary accomodation to take account of  particule rain deposition
+      !---------------------------------------------------------------------
+      
+      
+      ! 1. Change of geometry
+      !    Increase of dz3d(2) thickness : dz3d(2) = dz3d(2)+dzdep
+      !    Warning : no change for dz(2)
+      !---------------------------------------------------------
+      dz3d(1:jpoce,2) = dz3d(1:jpoce,2) + dzdep(1:jpoce)
+
+      
+      ! New values for volw3d(:,2) and vols3d(:,2)
+      ! Warning : no change neither for volw(2) nor  vols(2)
+      !------------------------------------------------------
+      volw3d(1:jpoce,2) = dz3d(1:jpoce,2) * por(2)
+      vols3d(1:jpoce,2) = dz3d(1:jpoce,2) * por1(2)
+
+      ! Conversion of volume units
+      !----------------------------
+      DO js = 1, jpsol
+         DO jk = 1, jpksed
+            DO ji = 1, jpoce    
+               zvolc(ji,jk,js) = ( vols3d(ji,jk) * dens_mol_wgt(js) ) /  &
+                  &              ( volw3d(ji,jk) * 1.e-3 )     
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! 2. Change of previous solid fractions (due to volum changes) for k=2
+      !---------------------------------------------------------------------
+
+      DO js = 1, jpsol
+         DO ji = 1, jpoce
+            solcp(ji,2,js) = solcp(ji,2,js) * dz(2) / dz3d(ji,2)
+         ENDDO
+      END DO
+
+      ! 3. New solid fractions (including solid rain fractions) for k=2  
+      !------------------------------------------------------------------   
+      DO js = 1, jpsol
+         DO ji = 1, jpoce
+            solcp(ji,2,js) = solcp(ji,2,js) + &
+            &           ( rainrg(ji,js) / raintg(ji) ) * ( dzdep(ji) / dz3d(ji,2) )
+            ! rainrm are temporary cancel
+            rainrm(ji,js) = 0.
+         END DO
+      ENDDO
+
+      ! 4.  Adjustment of bottom water concen.(pwcp(1)): 
+      !     We impose that pwcp(2) is constant. Including dzdep in dz3d(:,2) we assume 
+      !     that dzdep has got a porosity of por(2). So pore water volum of jk=2 increase.
+      !     To keep pwcp(2) cste we must compensate this "increase" by a slight adjusment
+      !     of bottom water concentration.
+      !     This adjustment is compensate at the end of routine
+      !-------------------------------------------------------------
+      DO jw = 1, jpwat
+         DO ji = 1, jpoce
+            pwcp(ji,1,jw) = pwcp(ji,1,jw) - &
+               &            pwcp(ji,2,jw) * dzdep(ji) * por(2) / dzkbot(ji)
+         END DO
+      ENDDO
+
+ 
+      !----------------------------------------------------------
+      ! 5.  Beginning of  Pore Water diffusion and solid reaction
+      !---------------------------------------------------------
+      
+      !-----------------------------------------------------------------------------
+      ! For jk=2,jpksed, and for couple 
+      !  1 : jwsil/jsopal  ( SI/Opal )
+      !  2 : jsclay/jsclay ( clay/clay ) 
+      !  3 : jwoxy/jspoc   ( O2/POC )
+      !  reaction rate is a function of solid=concentration in solid reactif in [mol/l] 
+      !  and undersaturation in [mol/l].
+      !  Solid weight fractions should be in ie [mol/l])
+      !  second member and solution are in zundsat variable
+      !-------------------------------------------------------------------------
+
+      !number of variables
+      nv  = 3
+     
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            ! For Silicic Acid and clay
+            zundsat(ji,jk,1) = sat_sil   - pwcp(ji,jk,jwsil)
+            zundsat(ji,jk,2) = sat_clay
+            ! For O2
+            zundsat(ji,jk,3) = pwcp(ji,jk,jwoxy) / so2ut 
+         ENDDO
+      ENDDO
+      
+      
+      ! Definition of reaction rates [rearat]=sans dim 
+      ! For jk=1 no reaction (pure water without solid) for each solid compo
+      DO ji = 1, jpoce
+         zrearat(ji,1,:) = 0.
+      ENDDO
+
+
+      ! left hand side of coefficient matrix
+      DO jk = 2, jpksed
+         DO ji = 1, jpoce
+            zsolid1 = zvolc(ji,jk,jsopal) * solcp(ji,jk,jsopal)
+            zsolid2 = zvolc(ji,jk,jsclay) * solcp(ji,jk,jsclay)
+            zsolid3 = zvolc(ji,jk,jspoc)  * solcp(ji,jk,jspoc)
+
+            zrearat(ji,jk,1)  = ( reac_sil * dtsed * zsolid1 ) / &
+               &                ( 1. + reac_sil * dtsed * zundsat(ji,jk,1 ) )
+            zrearat(ji,jk,2)  = ( reac_clay * dtsed * zsolid2 ) / &
+               &                ( 1. + reac_clay * dtsed * zundsat(ji,jk,2 ) )
+            zrearat(ji,jk,3)  = ( reac_poc  * dtsed * zsolid3 ) / &
+               &                ( 1. + reac_poc  * dtsed * zundsat(ji,jk,3 ) )
+         ENDDO
+      ENDDO
+
+
+      CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat )
+
+
+      ! New solid concentration values (jk=2 to jksed) for each couple 
+      DO js = 1, nv
+         DO jk = 2, jpksed
+            DO ji = 1, jpoce
+               zreasat = zrearat(ji,jk,js) * zundsat(ji,jk,js) / zvolc(ji,jk,js)
+               solcp(ji,jk,js) = solcp(ji,jk,js) - zreasat
+            ENDDO
+         ENDDO
+      ENDDO
+      ! mass of O2/NO3 before POC remin. for mass balance check 
+      ! det. of o2 consomation/NO3 production Mc13
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zvolw = volw3d(ji,jk) * 1.e-3
+            zmo2_0 (ji)  = zmo2_0 (ji) + pwcp(ji,jk,jwoxy) * zvolw
+            zmno3_0(ji)  = zmno3_0(ji) + pwcp(ji,jk,jwno3) * zvolw
+            zmc13_0(ji)  = zmc13_0(ji) + pwcp(ji,jk,jwc13) * zvolw
+         ENDDO
+      ENDDO
+
+      ! New pore water concentrations    
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            ! Acid Silicic 
+            pwcp(ji,jk,jwsil)  = sat_sil - zundsat(ji,jk,1)            
+            ! For O2 (in mol/l)
+            pwcp(ji,jk,jwoxy)  = zundsat(ji,jk,3) * so2ut 
+            zreasat = zrearat(ji,jk,3) * zundsat(ji,jk,3)    ! oxygen         
+            ! For DIC
+            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat
+            ! For nitrates
+            pwcp(ji,jk,jwno3)  = pwcp(ji,jk,jwno3) + zreasat * srno3            
+            ! For Phosphate (in mol/l)
+            pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * spo4r            
+            ! For alkalinity
+            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) - zreasat * ( srno3 + 2.* spo4r )           
+            ! For DIC13
+            pwcp(ji,jk,jwc13)  = pwcp(ji,jk,jwc13) + zreasat * rc13P * pdb
+         ENDDO
+      ENDDO
+
+
+      ! Mass of O2 for mass balance check and det. of o2 consomation
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zvolw = volw3d(ji,jk) * 1.e-3
+            zmo2_1 (ji) = zmo2_1 (ji) + pwcp(ji,jk,jwoxy) * zvolw
+            zmno3_1(ji) = zmno3_1(ji) + pwcp(ji,jk,jwno3) * zvolw
+            zmc13_1(ji) = zmc13_1(ji) + pwcp(ji,jk,jwc13) * zvolw
+         ENDDO
+      ENDDO
+
+      DO ji = 1, jpoce
+         cons_o2 (ji) = zmo2_0 (ji) - zmo2_1 (ji)
+         sour_no3(ji) = zmno3_1(ji) - zmno3_0(ji)     
+         sour_c13(ji) = zmc13_1(ji) - zmc13_0(ji) 
+      ENDDO
+ 
+
+      !--------------------------------------------------------------------
+      ! Begining POC denitrification and NO3- diffusion
+      ! (indice n°5 for couple POC/NO3- ie solcp(:,:,jspoc)/pwcp(:,:,jwno3))
+      !--------------------------------------------------------------------
+
+      nv = 1
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zundsat(ji,jk,1) = pwcp(ji,jk,jwno3) / srDnit
+         ENDDO
+      ENDDO
+      DO jk = 2, jpksed
+         DO ji = 1, jpoce
+            IF( pwcp(ji,jk,jwoxy) < sthrO2 ) THEN
+               zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc)
+               zrearat(ji,jk,1) = ( reac_no3 * dtsed * zsolid1 ) / &
+                  &                    ( 1. + reac_no3 * dtsed * zundsat(ji,jk,1 ) )
+            ELSE
+               zrearat(ji,jk,1) = 0.
+            ENDIF
+         END DO
+      END DO
+
+
+      ! solves tridiagonal system
+      CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat )
+
+
+      ! New solid concentration values (jk=2 to jksed) for each couple 
+      DO jk = 2, jpksed
+         DO ji = 1, jpoce
+            zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) / zvolc(ji,jk,jspoc)
+            solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat
+         ENDDO
+      ENDDO
+
+      ! New dissolved concentrations
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1)    
+            ! For nitrates
+            pwcp(ji,jk,jwno3)  =  zundsat(ji,jk,1) * srDnit
+            ! For DIC
+            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat
+            ! For Phosphate (in mol/l)
+            pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * spo4r            
+            ! For alkalinity
+            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + zreasat * ( srDnit - 2.* spo4r )           
+            ! For DIC13
+            pwcp(ji,jk,jwc13)  = pwcp(ji,jk,jwc13) + zreasat * rc13P * pdb
+         ENDDO
+      ENDDO
+
+
+      ! Mass of O2 for mass balance check and det. of o2 consomation
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zvolw = volw3d(ji,jk) * 1.e-3
+            zmno3_2(ji) = zmno3_2(ji) + pwcp(ji,jk ,jwno3) * zvolw
+            zmc13_2(ji) = zmc13_2(ji) + pwcp(ji,jk ,jwc13) * zvolw   
+         ENDDO
+      ENDDO
+
+      DO ji = 1, jpoce
+         cons_no3(ji) = zmno3_1(ji) - zmno3_2(ji)  
+         sour_c13(ji) = sour_c13(ji) + zmc13_2(ji) - zmc13_1(ji)     
+      ENDDO
+
+
+      !---------------------------
+      ! Solves PO4 diffusion 
+      !----------------------------
+
+      nv = 1
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zundsat(ji,jk,1) = pwcp(ji,jk,jwpo4)
+            zrearat(ji,jk,1) = 0.
+         ENDDO
+      ENDDO
+
+
+      ! solves tridiagonal system
+      CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat )
+
+
+      ! New undsaturation values and dissolved concentrations
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            pwcp(ji,jk,jwpo4) = zundsat(ji,jk,1)
+         ENDDO
+      ENDDO
+
+
+      !---------------------------------------------------------------
+      ! Performs CaCO3 particle deposition and redissolution (indice 9)
+      !--------------------------------------------------------------
+
+      ! computes co3por from the updated pwcp concentrations (note [co3por] = mol/l)
+
+      CALL sed_co3( kt )
+
+
+      nv = 1
+      ! *densSW(l)**2 converts aksps [mol2/kg sol2] into [mol2/l2] to get [undsat] in [mol/l]
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zundsat(ji,jk,1) = aksps(ji) * densSW(ji) * densSW(ji) / calcon2(ji) &
+               &                     - co3por(ji,jk)
+            ! positive values of undersaturation
+            zundsat(ji,jk,1) = MAX( 0., zundsat(ji,jk,1) )            
+         ENDDO
+      ENDDO
+
+      DO jk = 2, jpksed
+         DO ji = 1, jpoce
+            zsolid1 = zvolc(ji,jk,jscal) * solcp(ji,jk,jscal)
+            zrearat(ji,jk,1) = ( reac_cal * dtsed * zsolid1 ) / &
+                  &               ( 1. + reac_cal * dtsed * zundsat(ji,jk,1) )
+         END DO
+      END DO
+
+
+      ! solves tridiagonal system
+      CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat )
+
+
+      ! New solid concentration values (jk=2 to jksed) for cacO3
+      DO jk = 2, jpksed
+         DO ji = 1, jpoce
+            zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) / zvolc(ji,jk,jscal)
+            solcp(ji,jk,jscal) = solcp(ji,jk,jscal) - zreasat
+         ENDDO
+      ENDDO
+
+      ! New dissolved concentrations
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1)    
+            ! For DIC
+            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat
+            ! For alkalinity
+            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + 2.* zreasat 
+            ! For DIC13
+            pwcp(ji,jk,jwc13)  = pwcp(ji,jk,jwc13) + zreasat * rc13Ca * pdb
+         ENDDO
+      ENDDO
+
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zmc13_3(ji) = zmc13_3(ji) + pwcp(ji,jk,jwc13) * volw3d(ji,jk) * 1.e-3                  
+         ENDDO
+      ENDDO
+
+      DO ji = 1, jpoce     
+         sour_c13(ji) = sour_c13(ji) + zmc13_3(ji) - zmc13_2(ji)   
+      ENDDO
+      
+      !-------------------------------------------------
+      ! Beginning DIC, Alkalinity and DIC13 diffusion
+      !-------------------------------------------------
+      
+      nv = 3
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce      
+            zundsat(ji,jk,1) = pwcp(ji,jk,jwdic)
+            zundsat(ji,jk,2) = pwcp(ji,jk,jwalk)
+            zundsat(ji,jk,3) = pwcp(ji,jk,jwc13)
+      
+            zrearat(ji,jk,1) = 0.
+            zrearat(ji,jk,2) = 0.
+            zrearat(ji,jk,3) = 0.
+      
+         ENDDO
+      ENDDO
+
+
+      ! solves tridiagonal system
+      CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat )
+
+
+      ! New dissolved concentrations      
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce                      
+            pwcp(ji,jk,jwdic) = zundsat(ji,jk,1)
+            pwcp(ji,jk,jwalk) = zundsat(ji,jk,2)
+            pwcp(ji,jk,jwc13) = zundsat(ji,jk,3)
+         ENDDO
+      ENDDO            
+      
+      !----------------------------------
+      !   Back to initial geometry
+      !-----------------------------
+      
+      !---------------------------------------------------------------------
+      !   1/ Compensation for ajustement of the bottom water concentrations
+      !      (see note n° 1 about *por(2))
+      !--------------------------------------------------------------------
+      DO jw = 1, jpwat
+         DO ji = 1, jpoce
+            pwcp(ji,1,jw) = pwcp(ji,1,jw) + &
+               &            pwcp(ji,2,jw) * dzdep(ji) * por(2) / dzkbot(ji)
+         END DO
+      ENDDO
+      
+      !-----------------------------------------------------------------------
+      !    2/ Det of new rainrg taking account of the new weight fraction obtained 
+      !      in dz3d(2) after diffusion/reaction (react/diffu are also in dzdep!)
+      !      This new rain (rgntg rm) will be used in advection/burial routine
+      !------------------------------------------------------------------------
+      DO js = 1, jpsol
+         DO ji = 1, jpoce
+            rainrg(ji,js) = raintg(ji) * solcp(ji,2,js)
+            rainrm(ji,js) = rainrg(ji,js) / mol_wgt(js)
+         END DO
+      ENDDO
+      
+      !  New raintg
+      raintg(:) = 0.
+      DO js = 1, jpsol
+         DO ji = 1, jpoce
+            raintg(ji) = raintg(ji) + rainrg(ji,js)
+         END DO
+      ENDDO
+      
+      !--------------------------------
+      !    3/ back to initial geometry
+      !--------------------------------
+      DO ji = 1, jpoce
+         dz3d  (ji,2) = dz(2)
+         volw3d(ji,2) = dz3d(ji,2) * por(2)
+         vols3d(ji,2) = dz3d(ji,2) * por1(2)
+      ENDDO
+      
+      !----------------------------------------------------------------------
+      !    4/ Saving new amount of material in dzkbot for mass balance check
+      !       tokbot in [mol] (implicit *1cm*1cm for spacial dim)
+      !----------------------------------------------------------------------
+      DO jw = 1, jpwat 
+         DO ji = 1, jpoce
+            tokbot(ji,jw) = pwcp(ji,1,jw) * 1.e-3 * dzkbot(ji)
+         END DO
+      ENDDO
+
+      DEALLOCATE( zmo2_0  ) ;  DEALLOCATE( zmno3_1 )  ;  DEALLOCATE( zmno3_2 ) 
+      DEALLOCATE( zmc13_0 ) ;  DEALLOCATE( zmc13_1 )  ;  DEALLOCATE( zmc13_2 ) ;  DEALLOCATE( zmc13_3 ) 
+      
+      DEALLOCATE( zrearat ) ;  DEALLOCATE( zundsat )  ;  DEALLOCATE( zvolc )   
+      
+   END SUBROUTINE sed_dsr
+#else
+   !!======================================================================
+   !! MODULE seddsr  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_dsr ( kt )
+     INTEGER, INTENT(in) :: kt
+     WRITE(*,*) 'sed_dsr: You should not have seen this print! error?', kt
+  END SUBROUTINE sed_dsr
+#endif
+   
+END MODULE seddsr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90	(revision 8732)
@@ -0,0 +1,239 @@
+MODULE seddta
+   !!======================================================================
+   !!                     ***  MODULE  seddta  ***
+   !! Sediment data  :  read sediment input data from a file
+   !!=====================================================================
+#if defined key_sed
+   !! * Modules used
+   USE sed
+   USE sedarr
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sed_dta   ! 
+
+   !! *  Module variables
+   REAL(wp), DIMENSION(:), ALLOCATABLE ::  smask       ! mask for sediments points
+   REAL(wp) ::  rsecday  ! number of second per a day
+   REAL(wp) ::  conv1    ! [m/day]--->[cm/s]  
+   REAL(wp) ::  conv2    ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days )
+
+   INTEGER ::  numbio
+
+#if defined key_sed_off
+   INTEGER ::  numoce
+#endif
+
+   !! $Id$
+CONTAINS
+
+   !!---------------------------------------------------------------------------
+   !!   sed_dta  : read the NetCDF data file in online version using module iom
+   !!---------------------------------------------------------------------------
+
+   SUBROUTINE sed_dta( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_dta  ***
+      !!                    
+      !! ** Purpose :   Reads data from a netcdf file and 
+      !!                initialization of rain and pore water (k=1) components
+      !! 
+      !!
+      !!   History :
+      !!        !  04-10  (N. Emprin, M. Gehlen )  Original code
+      !!        !  06-04  (C. Ethe)  Re-organization ; Use of iom
+      !!----------------------------------------------------------------------
+
+      !! Arguments
+      INTEGER, INTENT(in) ::  kt    ! time-step
+
+      !! * Local declarations
+      INTEGER  ::  ji, jj, js, jw, ikt
+
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdta
+      REAL(wp), DIMENSION(:)  , ALLOCATABLE :: zdtap, zdtag
+
+
+      !----------------------------------------------------------------------
+
+      ! Initialization of sediment variable 
+      ! Spatial dimension is merged, and unity converted if needed
+      !-------------------------------------------------------------
+
+      WRITE(numsed,*)
+      WRITE(numsed,*) ' sed_dta : Bottom layer fields'
+      WRITE(numsed,*) ' ~~~~~~'
+      WRITE(numsed,*) ' Data from SMS model'
+      WRITE(numsed,*)
+
+
+      ! open file
+      IF( kt == nitsed000 ) THEN
+         WRITE(numsed,*) ' sed_dta : Sediment fields'
+         CALL iom_open ( 'data_bio_bot'     , numbio )
+#if defined key_sed_off
+         CALL iom_open( 'data_oce_bot', numoce)
+#endif
+         rsecday = 60.* 60. * 24.
+         conv1   = 1.0e+2 / rsecday 
+         conv2   = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 
+
+         ! Compute sediment mask
+         ALLOCATE( zdta(jpi,jpj) ) 
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt = MAX( INT( sbathy(ji,jj) ) - 1, 1 )
+               zdta(ji,jj) = tmask(ji,jj,ikt) 
+            ENDDO
+         ENDDO
+         ALLOCATE( smask(jpoce) )
+         smask(:) = 0.
+         CALL pack_arr( jpoce, smask(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) )
+      ENDIF
+
+      ! Initialization of temporaries arrays  
+      ALLOCATE( zdtap(jpoce) )    ;   zdtap(:)    = 0. 
+      ALLOCATE( zdtag(jpoce) )    ;   zdtag(:)    = 0.  
+
+      IF( MOD( kt - 1, nfreq ) == 0 ) THEN
+         ! reading variables
+         WRITE(numsed,*)
+         WRITE(numsed,*) ' sed_dta : Bottom layer fields at time  kt = ', kt
+         ! reading variables
+         trc_data(:,:,:) = 0.
+#if ! defined key_sed_off
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ikt = mbkt(ji,jj)
+               IF ( tmask(ji,jj,ikt) == 1 ) THEN
+                  trc_data(ji,jj,1)  = trn  (ji,jj,ikt,jptal)
+                  trc_data(ji,jj,2)  = trn  (ji,jj,ikt,jpdic)
+                  trc_data(ji,jj,3)  = trn  (ji,jj,ikt,jpno3) / 7.6
+                  trc_data(ji,jj,4)  = trn  (ji,jj,ikt,jppo4) / 122.
+                  trc_data(ji,jj,5)  = trn  (ji,jj,ikt,jpoxy)
+                  trc_data(ji,jj,6)  = trn  (ji,jj,ikt,jpsil)
+                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
+                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
+                  trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt)
+                  trc_data(ji,jj,10) = sinkcal (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)
+               ENDIF
+            ENDDO
+         ENDDO
+
+#else
+         CALL iom_get( numbio, jpdom_data, 'ALKBOT'     , trc_data(:,:,1 ) )
+         CALL iom_get( numbio, jpdom_data, 'DICBOT'     , trc_data(:,:,2 ) )
+         CALL iom_get( numbio, jpdom_data, 'NO3BOT'     , trc_data(:,:,3 ) )
+         CALL iom_get( numbio, jpdom_data, 'PO4BOT'     , trc_data(:,:,4 ) )
+         CALL iom_get( numbio, jpdom_data, 'O2BOT'      , trc_data(:,:,5 ) )
+         CALL iom_get( numbio, jpdom_data, 'SIBOT'      , trc_data(:,:,6 ) )
+         CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 
+         CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) ) 
+         CALL iom_get( numbio, jpdom_data, 'GOCFLXBOT'  , trc_data(:,:,9 ) ) 
+         CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,10) ) 
+         CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,11) ) 
+         CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,12) ) 
+#endif
+
+         ! Pore water initial concentration [mol/l] in  k=1
+         !-------------------------------------------------
+
+          ! Alkalinity ( 1 umol = 10-6equivalent )
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwalk), trc_data(1:jpi,1:jpj,1), iarroce(1:jpoce) )
+         ! DIC 
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwdic), trc_data(1:jpi,1:jpj,2), iarroce(1:jpoce) )
+         ! Nitrates (1 umol/l = 10-6 mol/l)
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwno3), trc_data(1:jpi,1:jpj,3), iarroce(1:jpoce) )
+         ! Phosphates (1 umol/l = 10-6 mol/l)
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwpo4), trc_data(1:jpi,1:jpj,4), iarroce(1:jpoce) )
+         ! Oxygen (1 umol/l = 10-6 mol/l)
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwoxy), trc_data(1:jpi,1:jpj,5), iarroce(1:jpoce) )        
+         ! Silicic Acid [mol.l-1]
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwsil), trc_data(1:jpi,1:jpj,6), iarroce(1:jpoce) )                  
+         ! DIC13 (mol/l)obtained from dc13 and DIC (12) and PDB 
+         CALL iom_get ( numbio,jpdom_data,'DC13',zdta(:,:) )
+         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwc13), zdta(1:jpi,1:jpj), iarroce(1:jpoce) )
+         pwcp_dta(1:jpoce,jwc13) = pdb * ( pwcp_dta(1:jpoce,jwc13) * 1.0e-3 + 1.0 )  &
+            &                          *   pwcp_dta(1:jpoce,jwdic)         
+         
+         !  Solid components : 
+         !-----------------------
+         !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
+         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) 
+         rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4
+         !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
+         CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )      
+         CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,9) , iarroce(1:jpoce) )
+         rainrm_dta(1:jpoce,jspoc) =   ( zdtap(1:jpoce) +  zdtag(1:jpoce) ) * 1e-4
+         !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
+         CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) )
+         rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4
+         ! vector temperature [°C] and salinity 
+         CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )
+         CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) )
+        
+         ! Clay rain rate in [mol/(cm**2.s)] 
+         ! inputs data in [kg.m-2.mois-1] ---> 1e+3/(1e+4*60*24*60*60) [g.cm-2.s-1]   
+         ! divided after by molecular weight g.mol-1      
+         zdta(:,:)   = 0.
+         CALL iom_get( numbio, jpdom_data, 'CLAY', zdta(:,:) ) 
+         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsclay) , zdta(1:jpi,1:jpj), iarroce(1:jpoce) )      
+         rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay)
+
+      ENDIF
+
+      ! sediment pore water at 1st layer (k=1)
+      DO jw = 1, jpwat
+         pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) * smask(1:jpoce)
+      ENDDO
+
+      !  rain
+      DO js = 1, jpsol
+         rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) * smask(1:jpoce)
+      ENDDO
+
+      ! Calculation of raintg of each sol. comp.: rainrm in [g/(cm**2.s)]
+      DO js = 1, jpsol
+         rainrg(1:jpoce,js) = rainrm(1:jpoce,js) *  mol_wgt(js)
+      ENDDO
+
+      ! Calculation of raintg = total massic flux rained in each cell (sum of sol. comp.)
+      raintg(:) = 0.
+      DO js = 1, jpsol
+         raintg(1:jpoce) = raintg(1:jpoce) + rainrg(1:jpoce,js)
+      ENDDO
+
+      ! computation of dzdep = total thickness of solid material rained [cm] in each cell
+      dzdep(1:jpoce) = raintg(1:jpoce) * rdtsed(2) 
+
+
+      DEALLOCATE( zdta ) 
+      DEALLOCATE( zdtap    ) ;  DEALLOCATE( zdtag    ) 
+
+      IF( kt == nitsedend )   THEN
+         CALL iom_close ( numbio )
+#if defined key_sed_off
+         CALL iom_close ( numoce )
+#endif
+      ENDIF
+      
+   END SUBROUTINE sed_dta
+
+#else
+   !!======================================================================
+   !! MODULE seddta  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_dta ( kt )
+     INTEGER, INTENT(in) :: kt
+     WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt 
+  END SUBROUTINE sed_dta
+#endif
+
+END MODULE seddta
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90	(revision 8732)
@@ -0,0 +1,866 @@
+MODULE sedini
+   !!======================================================================
+   !!              ***  MODULE  sedini  ***
+   !! Sediment : define sediment variables
+   !!=====================================================================
+#if defined key_sed
+
+   !!----------------------------------------------------------------------
+   !!   sed_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE sed     ! sediment global variable
+   USE seddta
+   USE sedrst
+   USE sedco3
+   USE sedchem
+   USE sedarr
+   USE iom
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! Module variables
+   REAL(wp)    ::  &
+      sisat   =  800.  ,  &  !: saturation for si    [ mol.l-1]
+      claysat =    0.  ,  &  !: saturation for clay  [ mol.l-1]
+      rcopal  =   40.  ,  &  !: reactivity for si    [l.mol-1.an-1]
+      rcclay  =    0.  ,  &  !: reactivity for clay  [l.mol-1.an-1]
+      dcoef   =  8.e-6       !: diffusion coefficient (*por)   [cm**2/s]
+
+   REAL(wp)    ::  &
+      redO2   =  172.  ,  &  !: Redfield coef for Oxygene
+      redNo3  =   16.  ,  &  !: Redfield coef for Nitrates
+      redPo4  =    1.  ,  &  !: Redfield coef for Phosphates
+      redC    =  122.  ,  &  !: Redfield coef for Carbone
+      redDnit =  97.6  ,  &  !: Redfield coef for denitrification    
+      rcorg   =   50.  ,  &  !: reactivity for POC/O2 [l.mol-1.an-1]    
+      o2seuil =    1.  ,  &  !: threshold O2 concentration for [mol.l-1]     
+      rcorgN  =   50.       !: reactivity for POC/No3 [l.mol-1.an-1]
+
+   REAL(wp)    ::  &
+      rccal   = 1000.        !: reactivity for calcite         [l.mol-1.an-1]
+
+   REAL(wp)    ::  &
+      dbiot   = 15.          !: coefficient for bioturbation    [cm**2.(1000an-1)]
+
+   LOGICAL     :: &
+      ln_rst_sed = .TRUE.    !: initialisation from a restart file or not
+
+   REAL(wp)    ::  &
+      ryear = 365. * 24. * 3600. !:  1 year converted in second
+
+   !! *  Routine accessibility
+   PUBLIC sed_init          ! routine called by opa.F90
+
+   !! $Id$
+CONTAINS
+
+
+   SUBROUTINE sed_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_init  ***
+      !!
+      !! ** Purpose :  Initialization of sediment module
+      !!               - Reading namelist
+      !!               - Read the deepest water layer thickness
+      !!                 ( using as mask ) in Netcdf file
+      !!               - Convert unity if necessary
+      !!               - sets initial sediment composition
+      !!                 ( only clay or reading restart file )
+      !!               - sets sediment grid, porosity and others constants
+      !!
+      !!   History :
+      !!        !  04-10  (N. Emprin, M. Gehlen )  Original code
+      !!        !  06-07  (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, ikt
+#if defined key_sed_off
+      INTEGER  :: numblt         
+      INTEGER  :: nummsh   
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta
+#endif
+      !!----------------------------------------------------------------------
+
+
+      ! Reading namelist.sed variables
+      !---------------------------------------
+
+      CALL ctl_opn( numsed, 'sediment.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+      WRITE(numsed,*)
+      WRITE(numsed,*) '                 L S C E - C E A'
+      WRITE(numsed,*) '                 SEDIMENT model'
+      WRITE(numsed,*) '                version 2.0  (2007) '
+      WRITE(numsed,*)
+      WRITE(numsed,*)
+
+    
+      WRITE(numsed,*) ' sed_init : Initialization of sediment module  '
+      WRITE(numsed,*) ' '
+
+      !                                ! Allocate LOBSTER arrays
+      IF( sed_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sed_ini: unable to allocate sediment model arrays' )
+
+
+      ! Determination of sediments number of points and allocate global variables
+#if defined key_sed_off
+      ! Reading Netcdf Pisces file for deepest water layer thickness [m]
+      ! This data will be used as mask to merdge space in 1D vector
+      !----------------------------------------------------------------
+
+      CALL iom_open ( 'mesh_mask'  , nummsh )   
+      CALL iom_open ( 'e3tbot'     , numblt )
+
+      ! mask sediment points for outputs
+      CALL iom_get( nummsh, jpdom_data, 'tmask' , tmask )
+      CALL iom_get( nummsh, jpdom_data, 'mbathy', sbathy )
+      
+      ! longitude/latitude values
+      CALL iom_get ( nummsh, jpdom_data,'nav_lon', glamt(:,:) )
+      CALL iom_get ( nummsh, jpdom_data,'nav_lat', gphit(:,:) )
+    
+      ! bottom layer thickness
+      ALLOCATE( zdta(jpi,jpj) )
+      CALL iom_get  ( numblt, jpdom_data, 'E3TBOT', zdta(:,:) )
+      epkbot(:,:) = 0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt = MAX( INT( sbathy(ji,jj) ), 1 )
+            IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = zdta(ji,jj)
+         ENDDO
+      ENDDO
+
+      CALL iom_close( nummsh )  
+      CALL iom_close( numblt ) 
+
+      DEALLOCATE( zdta )
+#else
+
+      epkbot(:,:) = 0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt = mbkt(ji,jj) 
+            IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt)
+         ENDDO
+      ENDDO
+#endif     
+
+
+      ! computation of total number of ocean points
+      !--------------------------------------------
+      jpoce  = COUNT( epkbot(:,:) > 0. )
+
+
+      ! Allocate memory size of global variables
+      ALLOCATE( pwcp (jpoce,jpksed,jpwat) )  ;  ALLOCATE( pwcp0 (jpoce,jpksed,jpwat) ) ;  ALLOCATE( pwcp_dta  (jpoce,jpwat) )
+      ALLOCATE( solcp(jpoce,jpksed,jpsol) )  ;  ALLOCATE( solcp0(jpoce,jpksed,jpsol) ) ;  ALLOCATE( rainrm_dta(jpoce,jpsol) )
+      ALLOCATE( rainrm(jpoce,jpsol) )        ;  ALLOCATE( rainrg(jpoce,jpsol) )        ;  ALLOCATE( raintg(jpoce) ) 
+      ALLOCATE( dzdep(jpoce) )               ;  ALLOCATE( iarroce(jpoce) )             ;  ALLOCATE( dzkbot(jpoce) )
+      ALLOCATE( temp(jpoce) )                ;  ALLOCATE( salt(jpoce) )                
+      ALLOCATE( press(jpoce) )               ;  ALLOCATE( densSW(jpoce) ) 
+      ALLOCATE( hipor(jpoce,jpksed) )        ;  ALLOCATE( co3por(jpoce,jpksed) ) 
+      ALLOCATE( dz3d(jpoce,jpksed) )         ;  ALLOCATE( volw3d(jpoce,jpksed) )       ;  ALLOCATE( vols3d(jpoce,jpksed) )
+
+      ! Initialization of global variables
+      pwcp  (:,:,:) = 0.  ;  pwcp0 (:,:,:) = 0.  ; pwcp_dta  (:,:) = 0.  
+      solcp (:,:,:) = 0.  ;  solcp0(:,:,:) = 0.  ; rainrm_dta(:,:) = 0.
+      rainrm(:,:  ) = 0.  ;  rainrg(:,:  ) = 0.  ; raintg    (:  ) = 0. 
+      dzdep (:    ) = 0.  ;  iarroce(:   ) = 0   ; dzkbot    (:  ) = 0.
+      temp  (:    ) = 0.  ;  salt   (:   ) = 0.  
+      press (:    ) = 0.  ;  densSW (:   ) = 0. 
+      hipor (:,:  ) = 0.  ;  co3por (:,: ) = 0.  
+      dz3d  (:,:  ) = 0.  ;  volw3d (:,: ) = 0.  ;  vols3d   (:,:) = 0. 
+
+      ! Chemical variables      
+      ALLOCATE( akbs  (jpoce) )  ;  ALLOCATE( ak1s   (jpoce) )  ;  ALLOCATE( ak2s  (jpoce) ) ;  ALLOCATE( akws  (jpoce) )     
+      ALLOCATE( ak1ps (jpoce) )  ;  ALLOCATE( ak2ps  (jpoce) )  ;  ALLOCATE( ak3ps (jpoce) ) ;  ALLOCATE( aksis (jpoce) )    
+      ALLOCATE( aksps (jpoce) )  ;  ALLOCATE( ak12s  (jpoce) )  ;  ALLOCATE( ak12ps(jpoce) ) ;  ALLOCATE( ak123ps(jpoce) )    
+      ALLOCATE( borats(jpoce) )  ;  ALLOCATE( calcon2(jpoce) )    
+
+      akbs  (:) = 0. ;   ak1s   (:) = 0. ;  ak2s  (:) = 0. ;   akws   (:) = 0.
+      ak1ps (:) = 0. ;   ak2ps  (:) = 0. ;  ak3ps (:) = 0. ;   aksis  (:) = 0.
+      aksps (:) = 0. ;   ak12s  (:) = 0. ;  ak12ps(:) = 0. ;   ak123ps(:) = 0.
+      borats(:) = 0. ;   calcon2(:) = 0.
+
+      ! Mass balance calculation  
+      ALLOCATE( fromsed(jpoce, jpsol) ) ; ALLOCATE( tosed(jpoce, jpsol) ) ;  ALLOCATE( rloss(jpoce, jpsol) )
+      ALLOCATE( tokbot (jpoce, jpwat) ) 
+
+      fromsed(:,:) = 0.    ;   tosed(:,:) = 0. ;  rloss(:,:) = 0.  ;   tokbot(:,:) = 0. 
+
+      ! Read sediment Namelist
+      !-------------------------
+      CALL sed_init_nam
+    
+      ! Initialization of sediment geometry
+      !------------------------------------
+      CALL sed_init_geom
+
+
+      ! sets initial sediment composition
+      ! ( only clay or reading restart file )
+      !---------------------------------------
+      CALL sed_init_data
+
+
+      CALL sed_init_wri
+
+
+   END SUBROUTINE sed_init
+
+
+   SUBROUTINE sed_init_geom
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_init_geom  ***
+      !!
+      !! ** Purpose :  Initialization of sediment geometry
+      !!               - Read the deepest water layer thickness
+      !!                 ( using as mask ) in Netcdf file
+      !!               - sets sediment grid, porosity and molecular weight
+      !!                 and others constants
+      !!
+      !!   History :
+      !!        !  06-07  (C. Ethe)  Original
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * local declarations
+      INTEGER ::  &
+        ji, jj, jk
+ 
+#if defined key_sed_off
+      REAL(wp) , DIMENSION (jpi,jpj) :: zdta
+      INTEGER  ::  numpres
+#endif
+      !---------------------------------------------------------- 
+
+      WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry '
+      WRITE(numsed,*) ' '
+
+      ! Computation of 1D array of sediments points
+      indoce = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF (  epkbot(ji,jj) > 0. ) THEN
+               indoce          = indoce + 1
+               iarroce(indoce) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+
+      IF( indoce .NE. jpoce ) THEN
+         WRITE(numsed,*) ' '
+         WRITE(numsed,*) 'Warning : number of ocean points indoce = ', indoce, &
+            &     ' doesn''t match  number of point where epkbot>0  jpoce = ', jpoce
+         WRITE(numsed,*) ' '
+         WRITE(numsed,*) ' '
+         STOP
+      ELSE
+         WRITE(numsed,*) ' '
+         WRITE(numsed,*) ' total number of ocean points jpoce =  ',jpoce
+         WRITE(numsed,*) ' '
+      ENDIF
+
+#if defined key_sed_off
+
+      ! Reading Netcdf Pisces file for deepest water layer thickness [m]
+      ! This data will be used as mask to merdge space in 1D vector
+      !----------------------------------------------------------------
+      CALL iom_open ( 'pressbot'   , numpres )
+      
+      ! pressure  in  bars      
+      CALL iom_get ( numpres, jpdom_data,'BATH', zdta(:,:) )
+      CALL pack_arr ( jpoce, press(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) )
+      press(1:jpoce) = press(1:jpoce) * 1.025e-1 
+
+      CALL iom_close ( numpres )
+#endif
+
+
+      ! mask sediment points for outputs
+      DO jk = 1, jpksed
+         tmasksed(:,:,jk) = tmask(:,:,1)
+      ENDDO
+
+      ! initialization of dzkbot in [cm]
+      !------------------------------------------------    
+      CALL pack_arr ( jpoce, dzkbot(1:jpoce), epkbot(1:jpi,1:jpj), iarroce(1:jpoce) )
+      dzkbot(1:jpoce) = dzkbot(1:jpoce) * 1.e+2 
+
+      ! Geometry and  constants 
+      ! sediment layer thickness [cm]
+      ! (1st layer= diffusive layer = pur water) 
+      !------------------------------------------
+      dz(1)  = 0.1
+      dz(2)  = 0.3
+      dz(3)  = 0.3
+      dz(4)  = 0.5
+      dz(5)  = 0.5
+      dz(6)  = 0.5
+      dz(7)  = 1.
+      dz(8)  = 1.
+      dz(9)  = 1.
+      dz(10) = 2.45
+      dz(11) = 2.45
+
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            dz3d(ji,jk) = dz(jk)
+         END DO
+      ENDDO
+
+      ! Depth(jk)= depth of middle of each layer
+      !----------------------------------------
+      profsed(1) = -dz(1)/ 2.
+      DO jk = 2, jpksed
+         profsed(jk) = profsed(jk-1) + dz(jk-1) / 2. + dz(jk) / 2.
+      ENDDO
+
+      !  Porosity profile [0]
+      !---------------------
+      por(1)  = 1.
+      por(2)  = 0.95
+      por(3)  = 0.9
+      por(4)  = 0.85
+      por(5)  = 0.81
+      por(6)  = 0.75
+      por(7)  = 0.75      
+      por(8)  = 0.75      
+      por(9)  = 0.75      
+      por(10) = 0.75
+      por(11) = 0.75
+ 
+      ! inverse of  Porosity profile
+      !-----------------------------
+      por1(:) = 1. - por(:)
+
+      ! Volumes of pore water and solid fractions (vector and array)
+      !     WARNING : volw(1) and vols(1) are sublayer volums
+      volw(:) = dz(:) * por(:)
+      vols(:) = dz(:) * por1(:)
+
+      ! temporary new value for dz3d(:,1) 
+      dz3d(1:jpoce,1) = dzkbot(1:jpoce)
+
+      ! WARNING : volw3d(:,1) and vols3d(:,1) are deepest water column volums
+      DO jk = 1, jpksed
+         volw3d(1:jpoce,jk) = dz3d(1:jpoce,jk) * por (jk)
+         vols3d(1:jpoce,jk) = dz3d(1:jpoce,jk) * por1(jk)
+      ENDDO
+
+      ! Back to the old sublayer vlaue for dz3d(:,1)
+      dz3d(1:jpoce,1) = dz(1)
+
+
+      !---------------------------------------------
+      ! Molecular weight [g/mol] for solid species
+      !---------------------------------------------
+
+
+      ! opal=sio2*0.4(h20)=28+2*16+0.4*(2+16)
+      !---------------------------------------
+      mol_wgt(jsopal) = 28. + 2. * 16. + 0.4 * ( 2. + 16. )  
+
+      !  clay
+      !  some kind of Illit (according to Pape)
+      !  K0.58(Al 1.38 Fe(III)0.37Fe(II)0.04Mg0.34)[(OH)2|(Si3.41Al0.59)O10]
+      !--------------------------------------------------------------------
+      mol_wgt(jsclay) = 0.58 * 39. + 1.38 * 27. + ( 0.37 + 0.04 ) * 56.+ &
+         &              0.34 * 24. + 2. * ( 16. + 1. ) + 3.41 * 38. +    &
+         &              0.59 * 27. + 10. * 16.
+
+      ! for chemistry Poc : C(122)H(244)O(86)N(16)P(1)
+      ! But den sity of Poc is an Hydrated material (= POC + 30H2O)
+      ! So C(122)H(355)O(120)N(16)P(1)
+      !------------------------------------------------------------
+      mol_wgt(jspoc) = ( 122. * 12. + 355. + 120. * 16.+ &
+         &                16. * 14. + 31. ) / 122.
+
+      ! CaCO3
+      !---------
+      mol_wgt(jscal) = 40. + 12. + 3. * 16.
+
+      ! Density of solid material in sediment [g/cm**3]
+      !------------------------------------------------
+      dens = 2.6
+
+      ! Initialization of diffusion coefficient as function of porosity [cm**2/s]
+      !--------------------------------------------------------------------
+      diff(:) = dcoef * por(:)
+
+
+      ! Initialization of time step as function of porosity [cm**2/s]
+      !------------------------------------------------------------------
+      rdtsed(2:jpksed) = dtsed / ( dens * por1(2:jpksed) )
+     
+   END SUBROUTINE sed_init_geom
+
+   SUBROUTINE sed_init_nam
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_init_nam  ***
+      !!
+      !! ** Purpose :  Initialization of sediment geometry
+      !!               - Reading namelist and defines constants variables
+      !!
+      !!   History :
+      !!        !  06-07  (C. Ethe)  Original
+      !!----------------------------------------------------------------------
+
+      INTEGER :: &
+         numnamsed = 28
+
+      TYPE PSED
+         CHARACTER(len = 20)  :: snamesed   !: short name
+         CHARACTER(len = 80 ) :: lnamesed   !: long name
+         CHARACTER(len = 20 ) :: unitsed    !: unit
+      END TYPE PSED
+
+      TYPE(PSED) , DIMENSION(jpsol     ) :: sedsol
+      TYPE(PSED) , DIMENSION(jpwat     ) :: sedwat
+      TYPE(PSED) , DIMENSION(jpdia3dsed) :: seddiag3d
+      TYPE(PSED) , DIMENSION(jpdia2dsed) :: seddiag2d
+
+      NAMELIST/nam_time/nfreq
+      NAMELIST/nam_trased/sedsol, sedwat
+      NAMELIST/nam_diased/seddiag3d, seddiag2d
+      NAMELIST/nam_reac/sisat, claysat, rcopal, rcclay, dcoef 
+      NAMELIST/nam_poc/redO2, redNo3, redPo4, redC, redDnit, &
+         &           rcorg, o2seuil, rcorgN
+      NAMELIST/nam_cal/rccal
+      NAMELIST/nam_dc13/pdb, rc13P, rc13Ca
+      NAMELIST/nam_btb/dbiot
+      NAMELIST/nam_rst/ln_rst_sed
+
+      INTEGER :: jn, jn1
+      !-------------------------------------------------------
+
+      WRITE(numsed,*) ' sed_init_nam : Read namelists '
+      WRITE(numsed,*) ' '
+
+      ! ryear = 1 year converted in second
+      !------------------------------------
+      WRITE(numsed,*) ' '
+      WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear
+      WRITE(numsed,*) ' '     
+
+      ! Reading namelist.sed variables
+      !---------------------------------
+      CALL ctl_opn( numnamsed, 'namelist.sediment', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+      dtsed = rdt
+      nitsed000 = nittrc000
+      nitsedend = nitend
+#if ! defined key_sed_off
+      nwrised   = nwritetrc
+#else
+      nwrised   = nwrite
+#endif
+     ! Diffraction/reaction parameters
+      !----------------------------------
+      READ( numnamsed, nam_time )
+      WRITE(numsed,*) ' namelist nam_time'
+
+#if ! defined key_sed_off
+      nfreq     = 1
+#endif
+
+      WRITE(numsed,*) ' sedimentation time step              dtsed      = ', dtsed
+      WRITE(numsed,*) ' 1st time step for sediment.          nitsed000  = ', nitsed000
+      WRITE(numsed,*) ' last time step for sediment.         nitsedend  = ', nitsedend
+      WRITE(numsed,*) ' frequency of sediment outputs        nwrised    = ', nwrised
+      WRITE(numsed,*) ' frequency of restoring inputs data   nfreq      = ', nfreq
+      WRITE(numsed,*) ' '
+
+      REWIND( numnamsed )               ! read nattrc
+      READ  ( numnamsed, nam_trased )
+
+      DO jn = 1, jpsol
+         sedtrcd(jn) = sedsol(jn)%snamesed
+         sedtrcl(jn) = sedsol(jn)%lnamesed
+         sedtrcu(jn) = sedsol(jn)%unitsed
+      END DO
+
+      DO jn = 1, jpwat
+         jn1 = jn + jpsol
+         sedtrcd(jn1) = sedwat(jn)%snamesed
+         sedtrcl(jn1) = sedwat(jn)%lnamesed
+         sedtrcu(jn1) = sedwat(jn)%unitsed
+      END DO
+
+      WRITE(numsed,*) ' namelist nam_trased'
+      WRITE(numsed,*) ' '
+      DO jn = 1, jptrased
+         WRITE(numsed,*) 'name of 3d output sediment field number :',jn,' : ',TRIM(sedtrcd(jn))
+         WRITE(numsed,*) 'long name ', TRIM(sedtrcl(jn))
+         WRITE(numsed,*) ' in unit = ', TRIM(sedtrcu(jn))
+         WRITE(numsed,*) ' '
+      END DO
+      WRITE(numsed,*) ' '
+
+      
+      REWIND( numnamsed )
+      READ( numnamsed, nam_diased )
+
+      DO jn = 1, jpdia3dsed
+         seddia3d(jn) = seddiag3d(jn)%snamesed
+         seddia3l(jn) = seddiag3d(jn)%lnamesed
+         seddia3u(jn) = seddiag3d(jn)%unitsed
+      END DO
+
+      DO jn = 1, jpdia2dsed
+         seddia2d(jn) = seddiag2d(jn)%snamesed
+         seddia2l(jn) = seddiag2d(jn)%lnamesed
+         seddia2u(jn) = seddiag2d(jn)%unitsed
+      END DO
+
+      WRITE(numsed,*) ' namelist nam_diased'
+      WRITE(numsed,*) ' '
+      DO jn = 1, jpdia3dsed
+         WRITE(numsed,*) 'name of 3D output diag number :',jn, ' : ', TRIM(seddia3d(jn))
+         WRITE(numsed,*) 'long name ', TRIM(seddia3l(jn))
+         WRITE(numsed,*) ' in unit = ',TRIM(seddia3u(jn))
+         WRITE(numsed,*) ' '
+      END DO
+
+      DO jn = 1, jpdia2dsed
+         WRITE(numsed,*) 'name of 2D output diag number :',jn, ' : ', TRIM(seddia2d(jn))
+         WRITE(numsed,*) 'long name ', TRIM(seddia2l(jn))
+         WRITE(numsed,*) ' in unit = ',TRIM(seddia2u(jn))
+         WRITE(numsed,*) ' '
+      END DO
+
+      WRITE(numsed,*) ' '
+
+
+      ! Diffraction/reaction parameters
+      !----------------------------------
+      REWIND( numnamsed )
+      READ( numnamsed, nam_reac )
+      WRITE(numsed,*) ' namelist nam_reac'
+      WRITE(numsed,*) ' saturation for si    sisat   = ', sisat
+      WRITE(numsed,*) ' saturation for clay  claysat = ', claysat
+      WRITE(numsed,*) ' reactivity for Si    rcopal  = ', rcopal
+      WRITE(numsed,*) ' reactivity for clay  rcclay  = ', rcclay
+      WRITE(numsed,*) ' diff. coef for por.  dcoef   = ', dcoef
+      WRITE(numsed,*) ' '
+
+
+      ! Unity conversion to get saturation conc. psat in [mol.l-1]
+      ! and reactivity rc in  [l.mol-1.s-1]
+      !----------------------------------------------------------
+      sat_sil   = sisat   * 1.e-6   
+      sat_clay  = claysat * 1.e-6
+
+      reac_sil  = rcopal / ryear     
+      reac_clay  = rcclay / ryear
+
+
+      ! Additional parameter linked to POC/O2/No3/Po4
+      !----------------------------------------------
+      REWIND( numnamsed )
+      READ( numnamsed, nam_poc )
+      WRITE(numsed,*) ' namelist nam_poc'
+      WRITE(numsed,*) ' Redfield coef for oxy     redO2   = ', redO2
+      WRITE(numsed,*) ' Redfield coef for no3     redNo3  = ', redNo3
+      WRITE(numsed,*) ' Redfield coef for po4     redPo4  = ', redPo4
+      WRITE(numsed,*) ' Redfield coef for carbone redC    = ', redC
+      WRITE(numsed,*) ' Redfield coef for denitri redDnit = ', redDnit
+      WRITE(numsed,*) ' reactivity for POC/O2     rcorg   = ', rcorg
+      WRITE(numsed,*) ' threshold O2 concen.      o2seuil = ', o2seuil
+      WRITE(numsed,*) ' reactivity for POC/NO3    rcorgN  = ', rcorgN
+      WRITE(numsed,*) ' '
+
+
+      so2ut  = redO2   / redC
+      srno3  = redNo3  / redC
+      spo4r  = redPo4  / redC
+      srDnit = redDnit / redC
+      sthro2 = o2seuil * 1.e-6 ! threshold O2 concen. in [mol.l-1]
+      ! reactivity rc in  [l.mol-1.s-1]
+      reac_poc  = rcorg / ryear
+      reac_no3 = rcorgN  / ryear
+
+
+      ! Carbonate parameters
+      !---------------------
+      READ( numnamsed, nam_cal )
+      WRITE(numsed,*) ' namelist  nam_cal'
+      WRITE(numsed,*) ' reactivity for calcite rccal = ', rccal
+      WRITE(numsed,*) ' '
+
+      ! reactivity rc in  [l.mol-1.s-1]      
+      reac_cal = rccal / ryear
+
+
+      ! C13  parameters
+      !----------------
+      READ( numnamsed, nam_dc13 )
+      WRITE(numsed,*) ' namelist nam_dc13 ' 
+      WRITE(numsed,*) ' 13C/12C in PD Belemnite        PDB    = ', pdb
+      WRITE(numsed,*) ' 13C/12C in POC = rc13P*PDB     rc13P  = ', rc13P
+      WRITE(numsed,*) ' 13C/12C in CaCO3 = rc13Ca*PDB  rc13Ca = ', rc13Ca
+      WRITE(numsed,*) ' '
+
+      
+      ! Bioturbation parameter
+      !------------------------
+      READ( numnamsed, nam_btb )
+      WRITE(numsed,*) ' namelist nam_btb ' 
+      WRITE(numsed,*) ' coefficient for bioturbation   dbiot    = ', dbiot
+      WRITE(numsed,*) ' '
+
+      ! Unity convertion to get bioturb coefficient in [cm2.s-1]
+      db = dbiot / ( ryear * 1000. )
+
+      ! Initial value (t=0) for sediment pore water and solid components
+      !----------------------------------------------------------------
+      READ( numnamsed, nam_rst )
+      WRITE(numsed,*) ' namelist  nam_rst ' 
+      WRITE(numsed,*) '  boolean term for restart (T or F) ln_rst_sed = ', ln_rst_sed 
+      WRITE(numsed,*) ' '
+
+      CLOSE( numnamsed )
+
+   END SUBROUTINE sed_init_nam
+
+   SUBROUTINE sed_init_data
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_init_data  ***
+      !!
+      !! ** Purpose :  Initialization of sediment module
+      !!               - sets initial sediment composition
+      !!                 ( only clay or reading restart file )
+      !!
+      !!   History :
+      !!        !  06-07  (C. Ethe)  original
+      !!----------------------------------------------------------------------
+ 
+      ! local variables
+      INTEGER :: &
+         ji, jk, zhipor
+
+      !--------------------------------------------------------------------
+ 
+
+      IF( .NOT. ln_rst_sed ) THEN
+
+          WRITE(numsed,*) ' Initilization of default values of sediment components'
+
+         ! default values for initial pore water concentrations [mol/l]
+         pwcp(:,:,:) = 0.
+         ! default value for initial solid component (fraction of dry weight dim=[0])
+         ! clay
+         solcp(:,:,:) = 0.
+         solcp(:,2:jpksed,jsclay) = 1.
+
+         ! Initialization of [h+] and [co3--]
+
+         zhipor = 8.
+         ! Initialization of [h+] in mol/kg
+         DO jk = 1, jpksed
+            DO ji = 1, jpoce
+               hipor (ji,jk) = 10.**( -1. * zhipor )
+            ENDDO
+         ENDDO
+
+         co3por(:,:) = 0.
+
+      ELSE   
+  
+         WRITE(numsed,*) ' Initilization of Sediment components from restart'
+
+         CALL sed_rst_read
+
+      ENDIF
+
+
+      ! Load initial Pisces Data for bot. wat. Chem and fluxes
+      CALL sed_dta ( nitsed000 ) 
+
+      ! Initialization of chemical constants
+      CALL sed_chem ( nitsed000 )
+
+      ! Stores initial sediment data for mass balance calculation
+      pwcp0 (1:jpoce,1:jpksed,1:jpwat ) = pwcp (1:jpoce,1:jpksed,1:jpwat ) 
+      solcp0(1:jpoce,1:jpksed,1:jpsol ) = solcp(1:jpoce,1:jpksed,1:jpsol) 
+
+      ! Conversion of [h+] in mol/Kg to get it in mol/l ( multiplication by density)
+      DO jk = 1, jpksed
+         hipor(1:jpoce,jk) = hipor(1:jpoce,jk) * densSW(1:jpoce)
+      ENDDO
+
+
+      ! In default case - no restart - sedco3 is run to initiate [h+] and [co32-]
+      ! Otherwise initiate values of pH and co3 read in restart
+      IF( .NOT. ln_rst_sed ) THEN
+         ! sedco3 is run to initiate[h+] [co32-] in mol/l of solution
+         CALL sed_co3 ( nitsed000 )
+
+      ENDIF
+            
+   END SUBROUTINE sed_init_data
+
+   SUBROUTINE sed_init_wri
+
+      INTEGER :: jk
+
+      WRITE(numsed,*)' '
+      WRITE(numsed,*)'======== Write summary of initial state   ============'
+      WRITE(numsed,*)' '
+      WRITE(numsed,*)' '
+      WRITE(numsed,*)'-------------------------------------------------------------------'
+      WRITE(numsed,*)' Initial Conditions '
+      WRITE(numsed,*)'-------------------------------------------------------------------'
+      WRITE(numsed,*)'dzm = dzkbot minimum to calculate ', 0.
+      WRITE(numsed,*)'Local zone : jpi, jpj : ',jpi, jpj
+      WRITE(numsed,*)'jpoce = ',jpoce,' nbtot pts = ',jpij,' nb earth pts = ',jpij - jpoce
+      WRITE(numsed,*)'sublayer thickness dz(1) [cm] : ', dz(1)
+      WRITE(numsed,*)'Coeff diff for k=1 (cm2/s) : ',diff(1)
+      WRITE(numsed,*)' nb solid comp : ',jpsol
+      WRITE(numsed,*)'(1=opal,2=clay,3=POC,4=CaCO3)'
+      WRITE(numsed,*)'weight mol 1,2,3,4'
+      WRITE(numsed,'(4(F0.2,3X))')mol_wgt(jsopal),mol_wgt(jsclay),mol_wgt(jspoc),mol_wgt(jscal)
+      WRITE(numsed,*)'nb dissolved comp',jpwat
+      WRITE(numsed,*)'(1=silicic acid,2="dissolved" clay,3=O2,4=DIC,5=Nitrate,&
+         &6=Phosphates,7=Alk))'
+      WRITE(numsed,*)'Psat (umol/l) for silicic Acid and "dissolved" clay'
+      WRITE(numsed,'(2(F0.2,3X))') sat_sil * 1e+6,  sat_clay * 1e+6
+      WRITE(numsed,*)'reaction rate rc for Op/si,Clay,POC/O2,caco3, POC/No3 (an-1)'
+      WRITE(numsed,'(5(F0.2,3X))') reac_sil * ryear, reac_clay * ryear, reac_poc * ryear, &
+                                   reac_cal * ryear, reac_no3 * ryear
+      WRITE(numsed,*)'redfield coef C,O,N P Dit '
+      WRITE(numsed,'(5(F0.2,3X))')1./spo4r,so2ut/spo4r,srno3/spo4r,spo4r/spo4r,srDnit/spo4r
+      WRITE(numsed,*)'threshold for stating denitrification [mol/l]'
+      WRITE(numsed,'(1PE8.2)') sthrO2
+      WRITE(numsed,*)'-------------------------------------------------------------------'
+      WRITE(numsed,*)'Min-Max-Mean'
+      WRITE(numsed,*)'For each variable : min, max, moy value observed on selected local zone'
+      WRITE(numsed,*)'-------------------------------------------------------------------'
+      WRITE(numsed,*)'thickness of the last wet layer dzkbot [m]'
+      WRITE(numsed,'(3(F0.2,3X))') MINVAL(dzkbot(1:jpoce))/100.,MAXVAL(dzkbot(1:jpoce))/100.,&
+         &SUM(dzkbot(1:jpoce))/jpoce/100.
+      WRITE(numsed,*)'temp [°C]'
+      WRITE(numsed,'(3(F0.2,3X))') MINVAL(temp(1:jpoce)),MAXVAL(temp(1:jpoce)),&
+         &                         SUM(temp(1:jpoce))/jpoce
+      WRITE(numsed,*)'salt o/oo'
+      WRITE(numsed,'(3(F0.2,3X))')MINVAL(salt(1:jpoce)),MAXVAL(salt(1:jpoce)),&
+         &                        SUM(salt(1:jpoce))/jpoce
+#if defined key_sed_off
+      WRITE(numsed,*)'pressure [bar] (depth in m is about 10*pressure)'
+      WRITE(numsed,'(3(F0.2,3X))') MINVAL(press(1:jpoce)),MAXVAL(press(1:jpoce)),&
+         &                         SUM(press(1:jpoce))/jpoce
+#endif
+      WRITE(numsed,*)'density of Sea Water'
+      WRITE(numsed,'(3(F0.2,3X))') MINVAL(densSW(1:jpoce)), MAXVAL(densSW(1:jpoce)),&
+         &                         SUM(densSW(1:jpoce))/jpoce
+      WRITE(numsed,*)''
+      WRITE(numsed,*)'     Dissolved Components '
+      WRITE(numsed,*)'     ====================='
+      WRITE(numsed,*)'[Si(OH)4] dissolved (1)(k=1)(µmol/l)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwsil))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwsil))*1.e+6,&
+         &                         SUM(pwcp(1:jpoce,1,jwsil))*1.e+6/jpoce,&
+         &                         MINVAL(pwcp(1:jpoce,1,jwsil)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)'[O2]    dissolved (3) (k=1)(µmol/l)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwoxy))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwoxy))*1.e+6,&
+         &SUM(pwcp(1:jpoce,1,jwoxy))*1.e+6/jpoce,&
+         &MINVAL(pwcp(1:jpoce,1,jwoxy)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)'[DIC]    dissolved (4) (k=1)(µmol/l)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwdic))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwdic))*1.e+6,&
+         &SUM(pwcp(1:jpoce,1,jwdic))*1.e+6/jpoce,&
+         &MINVAL(pwcp(1:jpoce,1,jwdic)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)'[NO3]    dissolved (5) (k=1)(µmol/l)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwno3))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwno3))*1.e+6,&
+         &SUM(pwcp(1:jpoce,1,jwno3))*1.e+6/jpoce,&
+         &MINVAL(pwcp(1:jpoce,1,jwno3)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)'[PO4]    dissolved (6) (k=1)(µmol/l)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwpo4))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwpo4))*1.e+6,&
+         &SUM(pwcp(1:jpoce,1,jwpo4))*1.e+6/jpoce,&
+         &MINVAL(pwcp(1:jpoce,1,jwpo4)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)'[Alk]    dissolved (7) (k=1)(µequi)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwalk))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwalk))*1.e+6,&
+         &SUM(pwcp(1:jpoce,1,jwalk))*1.e+6/jpoce,&
+         &MINVAL(pwcp(1:jpoce,1,jwalk)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)'[DIC13]  dissolved (8) (k=1)(µmol/l)(and min value in mol/kg  of solution)'
+      WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwc13))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwc13))*1.e+6,&
+         &SUM(pwcp(1:jpoce,1,jwc13))*1.e+6/jpoce,&
+         &MINVAL(pwcp(1:jpoce,1,jwc13)*1.e+6/densSW(1:jpoce))
+      WRITE(numsed,*)''
+      WRITE(numsed,*)'     Solid Components '
+      WRITE(numsed,*)'     ====================='
+      WRITE(numsed,*)'nmole of Opale rained per dt'
+      WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jsopal))*dtsed,MAXVAL(rainrm(1:jpoce,jsopal))*dtsed,&
+         &SUM(rainrm(1:jpoce,1))*dtsed/jpoce
+      WRITE(numsed,*)'nmole of Clay rained per dt'
+      WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jsclay))*dtsed,MAXVAL(rainrm(1:jpoce,jsclay))*dtsed,&
+         &SUM(rainrm(1:jpoce,jsclay))*dtsed/jpoce
+      WRITE(numsed,*)'nmole of POC rained per dt'
+      WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jspoc))*dtsed,MAXVAL(rainrm(1:jpoce,jspoc))*dtsed,&
+         &SUM(rainrm(1:jpoce,jspoc))*dtsed/jpoce
+      WRITE(numsed,*)'nmole of CaCO3 rained per dt'
+      WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jscal))*dtsed,MAXVAL(rainrm(1:jpoce,jscal))*dtsed,&
+         &SUM(rainrm(1:jpoce,jscal))*dtsed/jpoce
+      WRITE(numsed,*)' '
+      WRITE(numsed,*)'Weight frac of opal rained (%) '
+      WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100.,&
+         &MAXVAL(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100.,&
+         & SUM(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100./jpoce
+      WRITE(numsed,*)'Weight frac of clay  rained (%) '
+      WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100.,&
+         &MAXVAL(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100.,&
+         &SUM(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100./jpoce
+      WRITE(numsed,*)'Weight frac of POC rained (%)'
+      WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100.,&
+         &MAXVAL(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100.,&
+         &SUM(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100./jpoce
+      WRITE(numsed,*)'Weight frac of CaCO3  rained (%)'
+      WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100.,&
+         &MAXVAL(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100.,&
+         &SUM(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100./jpoce
+      WRITE(numsed,*)''
+      WRITE(numsed,*)' Thickness of sediment layer added by particule rain, dzdep cm '
+      WRITE(numsed,*)' =============================================================='
+      WRITE(numsed,'(3(F0.5,2X))') MINVAL(dzdep(1:jpoce)),MAXVAL(dzdep(1:jpoce)),SUM(dzdep(1:jpoce))/jpoce
+      WRITE(numsed,*)''
+      WRITE(numsed,*)' chemical constants K1,pK1,K2,pK2,Kw,pKw and Kb pKb (min max) [mol/kgsol] or [mol/kgsol]2 '
+      WRITE(numsed,*)' ========================================================================================='
+      WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(ak1s(1:jpoce)),MAXVAL(ak1s(1:jpoce)),-LOG10(MINVAL(ak1s(1:jpoce))),&
+         &-LOG10(MAXVAL(ak1s(1:jpoce)))
+      WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(ak2s(1:jpoce)),MAXVAL(ak2s(1:jpoce)),-LOG10(MINVAL(ak2s(1:jpoce))),&
+         &-LOG10(MAXVAL(ak2s(1:jpoce)))
+      WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(akws(1:jpoce)),MAXVAL(akws(1:jpoce)),-LOG10(MINVAL(akws(1:jpoce))),&
+         &-LOG10(MAXVAL(akws(1:jpoce)))
+      WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(akbs(1:jpoce)),MAXVAL(akbs(1:jpoce)),-LOG10(MINVAL(akbs(1:jpoce))),&
+         &-LOG10(MAXVAL(akbs(1:jpoce)))
+      WRITE(numsed,*)'and boron'
+      WRITE(numsed,'(2(1PE10.3,2X))')MINVAL(borats(1:jpoce)),MAXVAL(borats(1:jpoce))
+      WRITE(numsed,*)''
+      WRITE(numsed,*)' Compo of initial sediment for point jpoce'
+      WRITE(numsed,*)' ========================================='
+      WRITE(numsed,*)'solcp(1),   solcp(2),   solcp(3),   solcp(4),   hipor,      pH,         co3por'
+      DO jk = 1,jpksed
+         WRITE(numsed,'(7(1PE10.3,2X))')solcp(jpoce,jk,jsopal),solcp(jpoce,jk,jsclay),solcp(jpoce,jk,jspoc),solcp(jpoce,jk,jscal),&
+            &       hipor(jpoce,jk),-LOG10(hipor(jpoce,jk)/densSW(jpoce)),co3por(jpoce,jk)
+      ENDDO
+      WRITE(numsed,'(A82)')'pwcp(1),    pwcp(2),    pwcp(3),    pwcp(4),    pwcp(5),    pwcp(6),    pwcp(7)'
+      DO jk = 1, jpksed
+         WRITE(numsed,'(7(1PE10.3,2X))')pwcp(jpoce,jk,jwsil),pwcp(jpoce,jk,jwoxy),pwcp(jpoce,jk,jwdic),&
+            & pwcp(jpoce,jk,jwno3),pwcp(jpoce,jk,jwpo4),pwcp(jpoce,jk,jwalk),pwcp(jpoce,jk,jwc13)
+      ENDDO
+      WRITE(numsed,*) ' '
+      WRITE(numsed,*) ' End Of Initialization '
+      WRITE(numsed,*) ' '
+!
+   END SUBROUTINE sed_init_wri
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO Sediment model
+   !!----------------------------------------------------------------------
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_ini              ! Empty routine
+   END SUBROUTINE sed_ini
+#endif
+
+
+END MODULE sedini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90	(revision 8732)
@@ -0,0 +1,267 @@
+MODULE sedmat
+#if defined key_sed
+   !!======================================================================
+   !!              ***  MODULE  sedmat  ***
+   !!    Sediment : linear system of equations
+   !!=====================================================================
+   !! * Modules used
+   !!----------------------------------------------------------------------
+
+   USE sed     ! sediment global variable
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sed_mat 
+
+   INTERFACE sed_mat
+      MODULE PROCEDURE sed_mat_dsr, sed_mat_btb
+   END INTERFACE
+
+   INTEGER, PARAMETER :: nmax = 30 
+
+
+   !! $Id$
+ CONTAINS
+
+    SUBROUTINE sed_mat_dsr( nvar, ndim, nlev, preac, psol )
+       !!---------------------------------------------------------------------
+       !!                  ***  ROUTINE sed_mat_dsr  ***
+       !!
+       !! ** Purpose :  solves tridiagonal system of linear equations 
+       !!
+       !! ** Method  : 
+       !!        1 - computes left hand side of linear system of equations
+       !!            for dissolution reaction
+       !!         For mass balance in kbot+sediment :
+       !!              dz3d  (:,1) = dz(1) = 0.5 cm
+       !!              volw3d(:,1) = dzkbot ( see sedini.F90 ) 
+       !!              dz(2)       = 0.3 cm 
+       !!              dz3d(:,2)   = 0.3 + dzdep   ( see seddsr.F90 )     
+       !!              volw3d(:,2) and vols3d(l,2) are thickened ( see seddsr.F90 ) 
+       !!
+       !!         2 - forward/backward substitution. 
+       !!
+       !!   History :
+       !!        !  04-10 (N. Emprin, M. Gehlen ) original
+       !!        !  06-04 (C. Ethe)  Module Re-organization
+       !!----------------------------------------------------------------------
+       !! * Arguments
+       INTEGER , INTENT(in) ::  nvar  ! number of variables
+       INTEGER , INTENT(in) ::  ndim  ! number of points
+       INTEGER , INTENT(in) ::  nlev  ! number of sediment levels
+
+       REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(in   ) :: preac  ! reaction rates
+       REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(inout) :: psol   ! solution ( undersaturation values )
+ 
+       !---Local declarations
+       INTEGER  ::  ji, jk, jn
+       REAL(wp), DIMENSION(ndim,nlev) :: za, zb, zc, zr
+       REAL(wp), DIMENSION(ndim)      :: zbet
+       REAL(wp), DIMENSION(ndim,nmax) :: zgamm
+
+       REAL(wp) ::  aplus,aminus  
+       REAL(wp) ::  rplus,rminus   
+       REAL(wp) ::  dxplus,dxminus
+
+       !----------------------------------------------------------------------
+
+
+       ! Computation left hand side of linear system of 
+       ! equations for dissolution reaction
+       !---------------------------------------------
+
+
+       ! first sediment level          
+       DO ji = 1, ndim
+          aplus  = ( ( volw3d(ji,1) / dz3d(ji,1) ) + &
+                     ( volw3d(ji,2) / dz3d(ji,2) ) ) / 2.
+          dxplus = ( dz3d(ji,1) + dz3d(ji,2) ) / 2.
+          rplus  = ( dtsed / volw3d(ji,1) ) * diff(1) * aplus / dxplus 
+
+          za(ji,1) = 0.
+          zb(ji,1) = 1. + rplus
+          zc(ji,1) = -rplus
+       ENDDO
+ 
+       DO jk = 2, nlev - 1
+          DO ji = 1, ndim
+             aminus  = ( ( volw3d(ji,jk-1) / dz3d(ji,jk-1) ) + &
+                &        ( volw3d(ji,jk  ) / dz3d(ji,jk  ) ) ) / 2.
+             dxminus = ( dz3d(ji,jk-1) + dz3d(ji,jk) ) / 2.
+
+             aplus   = ( ( volw3d(ji,jk  ) / dz3d(ji,jk  ) ) + &
+                &        ( volw3d(ji,jk+1) / dz3d(ji,jk+1) ) ) / 2.
+             dxplus  = ( dz3d(ji,jk) + dz3d(ji,jk+1) ) / 2
+             !
+             rminus  = ( dtsed / volw3d(ji,jk) ) * diff(jk-1) * aminus / dxminus
+             rplus   = ( dtsed / volw3d(ji,jk) ) * diff(jk)   * aplus / dxplus
+             !     
+             za(ji,jk) = -rminus
+             zb(ji,jk) = 1. + rminus + rplus 
+             zc(ji,jk) = -rplus
+          END DO
+       END DO
+
+       DO ji = 1, ndim
+          aminus  = ( ( volw3d(ji,nlev-1) / dz3d(ji,nlev-1) ) + &
+             &        ( volw3d(ji,nlev)  / dz3d(ji,nlev) ) ) / 2.
+          dxminus = ( dz3d(ji,nlev-1) + dz3d(ji,nlev) ) / 2.
+          rminus  = ( dtsed / volw3d(ji,nlev) ) * diff(nlev-1) * aminus / dxminus
+          !
+          za(ji,nlev) = -rminus
+          zb(ji,nlev) = 1. + rminus
+          zc(ji,nlev) = 0.
+       END DO
+
+
+       ! solves tridiagonal system of linear equations 
+       ! -----------------------------------------------
+
+       DO jn = 1, nvar
+
+          zr  (:,:)    = psol(:,:,jn)
+          zbet(:  )    = zb(:,1) + preac(:,1,jn)
+          psol(:,1,jn) = zr(:,1) / zbet(:)
+          ! 
+          DO jk = 2, nlev
+             DO ji = 1, ndim
+                zgamm(ji,jk)   =  zc(ji,jk-1) / zbet(ji)
+                zbet(ji)       = ( zb(ji,jk) + preac(ji,jk,jn) ) - za(ji,jk) * zgamm(ji,jk)
+                psol(ji,jk,jn) = ( zr(ji,jk) - za(ji,jk) * psol(ji,jk-1,jn) ) / zbet(ji)
+             END DO
+          ENDDO
+          ! 
+          DO jk = nlev - 1, 1, -1
+             DO ji = 1,ndim
+                psol(ji,jk,jn) = psol(ji,jk,jn) - zgamm(ji,jk+1) * psol(ji,jk+1,jn)
+             END DO
+          ENDDO
+
+       ENDDO
+
+
+    END SUBROUTINE sed_mat_dsr
+
+    
+    SUBROUTINE sed_mat_btb( nvar, ndim, nlev, psol )
+       !!---------------------------------------------------------------------
+       !!                  ***  ROUTINE sed_mat_btb  ***
+       !!
+       !! ** Purpose :  solves tridiagonal system of linear equations 
+       !!
+       !! ** Method  : 
+       !!        1 - computes left hand side of linear system of equations
+       !!            for dissolution reaction
+       !!
+       !!         2 - forward/backward substitution. 
+       !!
+       !!   History :
+       !!        !  04-10 (N. Emprin, M. Gehlen ) original
+       !!        !  06-04 (C. Ethe)  Module Re-organization
+       !!----------------------------------------------------------------------
+       !! * Arguments
+       INTEGER , INTENT(in) :: &
+          nvar , &  ! number of variables
+          ndim , &  ! number of points
+          nlev      ! number of sediment levels
+
+      REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(inout) :: &
+          psol      ! solution
+
+       !---Local declarations
+       INTEGER  ::  &
+          ji, jk, jn
+
+       REAL(wp) ::  &
+          aplus,aminus   ,  & 
+          rplus,rminus   ,  &
+          dxplus,dxminus 
+
+       REAL(wp), DIMENSION(nlev)      :: za, zb, zc
+       REAL(wp), DIMENSION(ndim,nlev) :: zr
+       REAL(wp), DIMENSION(nmax)      :: zgamm 
+       REAL(wp) ::  zbet
+
+ 
+       !----------------------------------------------------------------------
+
+       ! Computation left hand side of linear system of 
+       ! equations for dissolution reaction
+       !---------------------------------------------
+
+
+       ! first sediment level          
+       aplus  = ( ( vols(2) / dz(2) ) + ( vols(3) / dz(3) ) ) / 2.
+       dxplus = ( dz(2) + dz(3) ) / 2.
+       rplus  = ( dtsed / vols(2) ) * db * aplus / dxplus 
+
+       za(1) = 0.
+       zb(1) = 1. + rplus
+       zc(1) = -rplus
+
+             
+       DO jk = 2, nlev - 1
+          aminus  = ( ( vols(jk) / dz(jk) ) + ( vols(jk+1) / dz(jk+1) ) ) / 2.
+          dxminus = ( dz(jk) + dz(jk+1) ) / 2.
+          rminus  = ( dtsed / vols(jk+1) ) * db * aminus / dxminus
+          !
+          aplus   = ( ( vols(jk+1) / dz(jk+1  ) ) + ( vols(jk+2) / dz(jk+2) ) ) / 2.
+          dxplus  = ( dz(jk+1) + dz(jk+2) ) / 2.
+          rplus   = ( dtsed / vols(jk+1) ) * db * aplus / dxplus
+          !     
+          za(jk) = -rminus
+          zb(jk) = 1. + rminus + rplus 
+          zc(jk) = -rplus
+       ENDDO
+ 
+       aminus  = ( ( vols(nlev) / dz(nlev) ) + ( vols(nlev+1) / dz(nlev+1) ) ) / 2.
+       dxminus = ( dz(nlev) + dz(nlev+1) ) / 2.
+       rminus  = ( dtsed / vols(nlev+1) ) * db * aminus / dxminus
+       !
+ 
+       za(nlev) = -rminus
+       zb(nlev) = 1. + rminus
+       zc(nlev) = 0.
+
+
+       ! solves tridiagonal system of linear equations 
+       ! -----------------------------------------------    
+       DO jn = 1, nvar
+          
+          zr  (:,:)    = psol(:,:,jn)
+          zbet         = zb(1)
+          psol(:,1,jn) = zr(:,1) / zbet
+          ! 
+          DO jk = 2, nlev
+             zgamm(jk) =  zc(jk-1) / zbet
+             zbet      =  zb(jk) - za(jk) * zgamm(jk)
+             DO ji = 1, ndim
+                psol(ji,jk,jn) = ( zr(ji,jk) - za(jk) * psol(ji,jk-1,jn) ) / zbet
+             END DO
+          ENDDO
+          ! 
+          DO jk = nlev - 1, 1, -1
+             DO ji = 1,ndim
+                psol(ji,jk,jn) = psol(ji,jk,jn) - zgamm(jk+1) * psol(ji,jk+1,jn)
+             END DO
+          ENDDO
+
+       ENDDO
+
+       
+    END SUBROUTINE sed_mat_btb
+
+
+#else
+   !!======================================================================
+   !! MODULE sedmat  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_mat         ! Empty routine
+   END SUBROUTINE sed_mat
+   !!======================================================================
+#endif
+
+ END MODULE sedmat
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90	(revision 8732)
@@ -0,0 +1,321 @@
+MODULE sedmbc
+#if defined key_sed
+   !!======================================================================
+   !!              ***  MODULE  sedmbc  ***
+   !! Sediment : mass balance calculation
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sed_mbc    : 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE sed     ! sediment global variable
+   USE seddsr
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC sed_mbc
+
+   !! * Module variables
+   REAL(wp), DIMENSION(jpsol) :: rain_tot      ! total input rain
+   REAL(wp), DIMENSION(jpsol) :: fromsed_tot   ! tota input from sediment
+   REAL(wp), DIMENSION(jpsol) :: tosed_tot     ! total output from sediment
+   REAL(wp), DIMENSION(jpsol) :: rloss_tot     ! total rain loss
+
+   REAL(wp), DIMENSION(jpwat) :: diss_in_tot   ! total input in pore water
+   REAL(wp), DIMENSION(jpwat) :: diss_out_tot  ! total output from pore water
+
+   REAL(wp)  :: cons_tot_o2                   ! cumulative o2 consomation
+   REAL(wp)  :: sour_tot_no3                  ! cumulative no3 source
+   REAL(wp)  :: cons_tot_no3                  ! cumulative no3 consomation
+   REAL(wp)  :: sour_tot_c13                  ! cumulative o2 source
+
+   REAL(wp)  :: src13p  
+   REAL(wp)  :: src13ca  
+
+   !! $Id$
+CONTAINS
+
+
+   SUBROUTINE sed_mbc( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_mbc  ***
+      !!
+      !! ** Purpose :  computation of total tracer inventories for checking
+      !!               mass conservation.
+      !!
+      !!
+      !! ** Method   : tracer inventories of each reservoir are computed and added
+      !!               subsequently.
+      !!
+      !!   History :
+      !!        !  04-10  (N. Emprin, M. Gehlen )  Original code
+      !!        !  06-07  (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+
+      !! Arguments
+      INTEGER, INTENT(in) :: kt     ! time step
+
+      !! local declarations
+      INTEGER  :: ji,js, jw, jk
+      REAL(wp) :: zinit, zfinal 
+      REAL(wp) :: zinput, zoutput
+      REAL(wp) :: zdsw, zvol
+      REAL, DIMENSION(jpsol) :: zsolcp_inv_i, zsolcp_inv_f
+      REAL, DIMENSION(jpwat) :: zpwcp_inv_i, zpwcp_inv_f
+      REAL(wp) ::  zdelta_sil, zdelta_clay
+      REAL(wp) ::  zdelta_co2, zdelta_oxy
+      REAL(wp) ::  zdelta_po4, zdelta_no3
+      REAL(wp) ::  zdelta_c13, zdelta_c13b
+
+      !!----------------------------------------------------------------------
+      ! Initilization
+      !---------------
+      IF( kt == nitsed000 ) THEN
+         cons_tot_o2  = 0.
+         sour_tot_no3 = 0.
+         cons_tot_no3 = 0.
+         sour_tot_c13 = 0.
+
+         DO js = 1, jpsol
+            rain_tot   (js) = 0.
+            fromsed_tot(js) = 0.
+            tosed_tot  (js) = 0.
+            rloss_tot  (js) = 0.
+         ENDDO
+
+         DO jw = 1, jpwat
+            diss_in_tot (jw) = 0.
+            diss_out_tot(jw) = 0.
+         ENDDO
+
+         src13p  = rc13P  * pdb
+         src13ca = rc13Ca * pdb
+      ENDIF
+
+
+      ! Calculation of the cumulativ input and output
+      ! for mass balance check
+      !----------------------------------------------
+
+      ! cumulativ solid
+      DO js = 1, jpsol
+         DO ji = 1, jpoce
+            ! input [mol]
+            rain_tot   (js) = rain_tot   (js) + dtsed * rainrm_dta(ji,js)
+            fromsed_tot(js) = fromsed_tot(js) + fromsed(ji,js)
+            ! output [mol]
+            tosed_tot  (js) = tosed_tot (js) + tosed(ji,js)
+            rloss_tot  (js) = rloss_tot (js) + rloss(ji,js)
+         ENDDO
+      ENDDO
+
+      ! cumulativ dissolved
+      DO jw = 1, jpwat
+         DO ji = 1, jpoce
+            ! input [mol]
+            diss_in_tot (jw) = diss_in_tot (jw) + pwcp_dta(ji,jw) * 1.e-3 * dzkbot(ji)
+            ! output [mol]
+            diss_out_tot(jw) = diss_out_tot(jw) + tokbot(ji,jw)
+         ENDDO
+      ENDDO
+
+      ! cumulativ o2 and no3 consomation
+      DO ji = 1, jpoce
+         cons_tot_o2  = cons_tot_o2  + cons_o2 (ji)
+         sour_tot_no3 = sour_tot_no3 + sour_no3(ji)
+         cons_tot_no3 = cons_tot_no3 + cons_no3(ji)
+         sour_tot_c13 = sour_tot_c13 + sour_c13(ji)
+      ENDDO
+     
+
+      ! Mass balance check
+      !---------------------
+      IF( kt == nitsedend ) THEN
+         ! initial and final inventories for solid component (mole/dx.dy) in sediment
+         zsolcp_inv_i(:) = 0.
+         zsolcp_inv_f(:) = 0.
+         zpwcp_inv_i (:) = 0.       
+         zpwcp_inv_f (:) = 0.        
+         DO js = 1, jpsol
+            zdsw = dens / mol_wgt(js)
+            DO jk = 2, jpksed
+               DO ji = 1, jpoce
+                  zvol = vols3d(ji,jk) * zdsw
+                  zsolcp_inv_i(js) = zsolcp_inv_i(js) + solcp0(ji,jk,js) * zvol 
+                  zsolcp_inv_f(js) = zsolcp_inv_f(js) + solcp (ji,jk,js) * zvol
+               ENDDO
+            END DO
+         ENDDO
+
+         ! initial and final inventories for dissolved component (mole/dx.dy) in sediment
+         DO jw = 1, jpwat
+            DO jk = 2, jpksed
+               DO ji = 1, jpoce 
+                  zvol = volw3d(ji,jk) * 1.e-3
+                  zpwcp_inv_i(jw) = zpwcp_inv_i(jw) + pwcp0(ji,jk,jw) * zvol
+                  zpwcp_inv_f(jw) = zpwcp_inv_f(jw) + pwcp (ji,jk,jw) * zvol
+               ENDDO
+            END DO
+         ENDDO
+
+         ! mass balance for Silica/opal
+         zinit      = zsolcp_inv_i(jsopal) + zpwcp_inv_i(jwsil)
+         zfinal     = zsolcp_inv_f(jsopal) + zpwcp_inv_f(jwsil)
+         zinput     = rain_tot    (jsopal) + diss_in_tot (jwsil)
+         zoutput    = tosed_tot   (jsopal) + rloss_tot  (jsopal) + diss_out_tot(jwsil)
+         zdelta_sil = ( zfinal + zoutput ) - ( zinit + zinput )
+
+
+         ! mass balance for Clay
+         zinit      = zsolcp_inv_i(jsclay) 
+         zfinal     = zsolcp_inv_f(jsclay) 
+         zinput     = rain_tot   (jsclay) + fromsed_tot(jsclay) 
+         zoutput    = tosed_tot  (jsclay) + rloss_tot  (jsclay) 
+         zdelta_clay= ( zfinal + zoutput ) - ( zinit + zinput )
+
+         ! mass balance for carbon ( carbon in POC, CaCo3, DIC )
+         zinit      = zsolcp_inv_i(jspoc) + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic)
+         zfinal     = zsolcp_inv_f(jspoc) + zsolcp_inv_f(jscal) + zpwcp_inv_f(jwdic)
+         zinput     = rain_tot   (jspoc) + rain_tot   (jscal) + diss_in_tot(jwdic)
+         zoutput    = tosed_tot  (jspoc) + tosed_tot  (jscal) + diss_out_tot(jwdic) &
+            &       + rloss_tot  (jspoc) + rloss_tot  (jscal) 
+         zdelta_co2 = ( zfinal + zoutput ) - ( zinit + zinput )
+
+         ! mass balance for oxygen : O2 is in POC remineralization
+         zinit      = zpwcp_inv_i(jwoxy)
+         zfinal     = zpwcp_inv_f(jwoxy)
+         zinput     = diss_in_tot(jwoxy)
+         zoutput    = diss_out_tot(jwoxy) + cons_tot_o2
+         zdelta_oxy = ( zfinal + zoutput ) - ( zinit + zinput )
+
+         ! mass balance for phosphate ( PO4 in POC and dissolved phosphates )
+         zinit      = zsolcp_inv_i(jspoc) * spo4r + zpwcp_inv_i(jwpo4)
+         zfinal     = zsolcp_inv_f(jspoc) * spo4r + zpwcp_inv_f(jwpo4)
+         zinput     = rain_tot   (jspoc) * spo4r + diss_in_tot(jwpo4)
+         zoutput    = tosed_tot  (jspoc) * spo4r + diss_out_tot(jwpo4) &
+            &       + rloss_tot  (jspoc) * spo4r
+         zdelta_po4 = ( zfinal + zoutput ) - ( zinit + zinput )
+
+
+         ! mass balance for Nitrate
+         zinit      = zpwcp_inv_i  (jwno3)
+         zfinal     = zpwcp_inv_f  (jwno3)
+         zinput     = diss_in_tot (jwno3) + sour_tot_no3
+         zoutput    = diss_out_tot(jwno3) + cons_tot_no3
+         zdelta_no3 = ( zfinal + zoutput ) - ( zinit + zinput )
+
+         ! mass balance for DIC13
+         zinit      =  zpwcp_inv_i(jwc13)   &
+            &        + src13p * zsolcp_inv_i(jspoc) + src13Ca * zsolcp_inv_i(jscal) 
+         zfinal     =  zpwcp_inv_f(jwc13)   &
+            &        + src13p * zsolcp_inv_f(jspoc) + src13Ca * zsolcp_inv_f(jscal)
+         zinput     =  diss_in_tot (jwc13)  &
+            &        + src13p * rain_tot(jspoc) + src13Ca * rain_tot(jscal)
+         zoutput    =  diss_out_tot(jwc13)  &
+            &        + src13p * tosed_tot(jspoc) + src13Ca * tosed_tot(jscal) &   
+            &        + src13p * rloss_tot(jspoc) + src13Ca * rloss_tot(jscal)
+         zdelta_c13 = ( zfinal + zoutput ) - ( zinit + zinput )
+
+         ! other mass balance for DIC13
+         zinit      = zpwcp_inv_i  (jwc13)
+         zfinal     = zpwcp_inv_f  (jwc13)
+         zinput     = diss_in_tot (jwc13) + sour_tot_c13
+         zoutput    = diss_out_tot(jwc13)
+         zdelta_c13b= ( zfinal + zoutput ) - ( zinit + zinput )    
+
+      END IF
+
+      IF( kt == nitsedend) THEN 
+
+         WRITE(numsed,*)
+         WRITE(numsed,*)'==================    General mass balance   ==================  '
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)' Initial total solid Masses (mole/dx.dy) (k=2-11) '
+         WRITE(numsed,*)' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numsed,*)'    Opale,      Clay,       POC,        CaCO3,         C13'
+         WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_i(jsopal),zsolcp_inv_i(jsclay),zsolcp_inv_i(jspoc), &
+            & zsolcp_inv_i(jscal),( src13P * zsolcp_inv_i(jspoc) + src13Ca * zsolcp_inv_i(jscal) )
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)' Initial total dissolved Masses (mole/dx.dy) (k=2-11) '
+         WRITE(numsed,*)' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numsed,*)'    Si,         O2,         DIC,        Nit         Phos,       DIC13'
+         WRITE(numsed,'(4x,6(1PE10.3,2X))') zpwcp_inv_i(jwsil), zpwcp_inv_i(jwoxy), &
+            & zpwcp_inv_i(jwdic), zpwcp_inv_i(jwno3), zpwcp_inv_i(jwpo4), zpwcp_inv_i(jwc13)
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)'  Solid inputs :  Opale,      Clay,       POC,        CaCO3,         C13'
+         WRITE(numsed,'(A4,10X,5(1PE10.3,2X))')'Rain : ',rain_tot(jsopal),rain_tot(jsclay),rain_tot(jspoc),&
+            & rain_tot(jscal),( src13P * rain_tot(jspoc) + src13Ca * rain_tot(jscal) )
+         WRITE(numsed,'(A12,6x,4(1PE10.3,2X))')' From Sed : ',fromsed_tot(jsopal), fromsed_tot(jsclay), &
+            & fromsed_tot(jspoc), fromsed_tot(jscal)
+         WRITE(numsed,*)'Diss. inputs : Si,    O2,         DIC,         Nit,       Phos,       DIC13'
+         WRITE(numsed,'(A9,1x,6(1PE10.3,2X))')' From Pisc : ', diss_in_tot(jwsil), &
+            & diss_in_tot(jwoxy), diss_in_tot(jwdic), diss_in_tot(jwno3), diss_in_tot(jwpo4), &
+            & diss_in_tot(jwc13)
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)'Solid output : Opale,      Clay,       POC,        CaCO3,          C13'
+         WRITE(numsed,'(A6,8x,5(1PE10.3,2X))')'To sed', tosed_tot(jsopal),tosed_tot(jsclay),tosed_tot(jspoc),&
+            & tosed_tot(jscal),( src13P * tosed_tot(jspoc) + src13Ca * tosed_tot(jscal) )
+         WRITE(numsed,'(A5,9x,5(1PE10.3,2X))')'Perdu', rloss_tot(jsopal),rloss_tot(jsclay),rloss_tot(jspoc),&
+            & rloss_tot(jscal),( src13P * rloss_tot(jspoc) + src13Ca * rloss_tot(jscal) )
+         WRITE(numsed,*)'Diss. output : Si,     O2,        DIC,          Nit,       Phos,       DIC13 '  
+         WRITE(numsed,'(A7,2x,6(1PE10.3,2X))')'To kbot', diss_out_tot(jwsil), &
+            & diss_out_tot(jwoxy), diss_out_tot(jwdic), diss_out_tot(jwno3), diss_out_tot(jwpo4), &
+            & diss_out_tot(jwc13)
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)' Total consomation in POC remineralization [mol]:  O2,         NO3'
+         WRITE(numsed,'(51x,2(1PE10.3,2X))') cons_tot_o2,cons_tot_no3
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)'Final solid  Masses (mole/dx.dy) (k=2-11)'
+         WRITE(numsed,*)'    Opale,      Clay,       POC,        CaCO3,          C13'
+         WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_f(jsopal),zsolcp_inv_f(jsclay),zsolcp_inv_f(jspoc), &
+            & zsolcp_inv_f(jscal),( src13P * zsolcp_inv_f(jspoc) + src13Ca * zsolcp_inv_f(jscal) )
+         WRITE(numsed,*)' '
+         WRITE(numsed,*)'Final dissolved  Masses (mole/dx.dy) (k=2-11)'
+         WRITE(numsed,*)'    Si,        O2,         DIC,        Nit,        Phos,    DIC13'
+         WRITE(numsed,'(4x,6(1PE10.3,2X))') zpwcp_inv_f(jwsil), zpwcp_inv_f(jwoxy), &
+            & zpwcp_inv_f(jwdic), zpwcp_inv_f(jwno3), zpwcp_inv_f(jwpo4), zpwcp_inv_f(jwc13)
+         WRITE(numsed,*)' '     
+         WRITE(numsed,*)'Delta : Opale,      Clay,       C,          O,          N,          P,        C13'
+         WRITE(numsed,'(7x,7(1PE11.3,1X))') zdelta_sil, zdelta_clay, zdelta_co2, zdelta_oxy, zdelta_no3,&
+            &                          zdelta_po4, zdelta_c13
+         WRITE(numsed,*)' ' 
+         WRITE(numsed,*)'deltaC13bis : ',zdelta_c13b     
+
+         WRITE(numsed,*)'=========================================================================='
+         WRITE(numsed,*)' Composition of final sediment for point jpoce'
+         WRITE(numsed,*)' ========================================='
+         WRITE(numsed,*)'Opale,      Clay,       POC,        CaCo3,      hipor,      pH,         co3por'
+         DO jk = 1,jpksed
+            WRITE(numsed,'(4(F8.4,4X),3(1PE10.3,2X))') solcp(jpoce,jk,jsopal)*100.,solcp(jpoce,jk,jsclay)*100.,&
+               &       solcp(jpoce,jk,jspoc)*100.,solcp(jpoce,jk,jscal)*100.,&
+               &       hipor(jpoce,jk),-LOG10(hipor(jpoce,jk)/densSW(jpoce)),co3por(jpoce,jk)
+         ENDDO
+         WRITE(numsed,*)'Silicic A.,  Oxygen,     DIC,        Nitrats,    Phosphats,  Alkal.,     DIC13'
+         DO jk = 1, jpksed
+            WRITE(numsed,'(8(1PE10.3,2X))')pwcp(jpoce,jk,jwsil),pwcp(jpoce,jk,jwoxy),&
+               & pwcp(jpoce,jk,jwdic),pwcp(jpoce,jk,jwno3),pwcp(jpoce,jk,jwpo4),pwcp(jpoce,jk,jwalk),pwcp(jpoce,jk,jwc13)
+         ENDDO
+         WRITE(numsed,*)'densSW at the end : ',densSW(jpoce)
+         WRITE(numsed,*)'=========================================================================='
+
+      ENDIF
+  
+   END SUBROUTINE sed_mbc
+
+
+#else
+   !!======================================================================
+   !! MODULE sedmbc :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_mbc( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_mbc: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_mbc
+#endif
+END MODULE sedmbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90	(revision 8732)
@@ -0,0 +1,53 @@
+MODULE sedmodel
+#if defined key_sed
+   !!======================================================================
+   !!                       ***  MODULE sedmodel   ***
+   !!   Sediment model : Main routine of sediment model 
+   !!======================================================================
+   USE sed
+   USE sedini   ! sediment variables initialization
+   USE sedstp   ! time stepping
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sed_model  ! called by step.F90
+
+CONTAINS
+
+   SUBROUTINE sed_model ( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sed_model  ***
+      !!
+      !! ** Purpose :   main routine of sediment model
+      !!
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!
+      !!   History :
+      !!        !  07-02 (C. Ethe)  Original
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+
+
+      IF( kt == nittrc000 ) CALL sed_init       ! Initialization of sediment model
+
+                         CALL sed_stp( kt )  ! Time stepping of Sediment model
+
+
+   END SUBROUTINE sed_model
+
+#else
+   !!======================================================================
+   !! MODULE sedmodel  :   Dummy module 
+   !!======================================================================
+CONTAINS
+   SUBROUTINE sed_model( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_model
+#endif
+
+END MODULE sedmodel
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90	(revision 8732)
@@ -0,0 +1,276 @@
+MODULE sedrst
+#if defined key_sed
+   !!======================================================================
+   !!                       *** MODULE sedrst ***
+   !!   Read and write the restart files for sediment
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   !! ==============
+   USE sed
+   USE sedarr
+
+
+   !! * Accessibility
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC sed_rst_read
+   PUBLIC sed_rst_wri
+
+   !! * Module variables
+   INTEGER, PUBLIC ::   numrsr, numrsw   !: logical unit for sed restart (read and write)
+   
+   
+   !! $Id$
+CONTAINS
+
+
+   SUBROUTINE sed_rst_read 
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_rst_read  ***
+      !!
+      !! ** Purpose :  Initialization of sediment module
+      !!               - sets initial sediment composition
+      !!                 ( only clay or reading restart file )
+      !!
+      !!   History :
+      !!        !  06-07  (C. Ethe)  original
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * local declarations
+      INTEGER :: ji, jk, jn 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zdta
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zdta1 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zhipor
+      REAL(wp) :: zkt
+      CHARACTER(len = 20) ::   cltra
+      INTEGER             ::   jlibalt = jprstlib
+      LOGICAL             ::   llok
+      !--------------------------------------------------------------------
+ 
+
+      WRITE(numsed,*) ' '      
+      WRITE(numsed,*) ' Initilization of Sediment components from restart'
+      WRITE(numsed,*) ' '
+
+      ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 
+
+      CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )     
+      CALL iom_get( numrsr, 'kt'     , zkt      )   ! time-step
+ 
+      DO jn = 1, jptrased
+         cltra = sedtrcd(jn)
+         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), &
+            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
+      ENDDO
+        
+
+      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), &
+         &            zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) )
+
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) )
+
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) )
+
+      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), &
+         &             zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) )
+
+      DO jn = 1, 2
+         cltra = seddia3d(jn)
+         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), &
+            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
+      ENDDO
+
+      zhipor(:,:) = 0.
+      CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
+         &             zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
+
+      ! Initialization of [h+] in mol/kg
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) )
+         ENDDO
+      ENDDO
+      
+      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
+         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
+
+      ! Initialization of sediment composant only ie jk=2 to jk=jpksed 
+      ! ( nothing in jk=1)
+      solcp(1:jpoce,1,:) = 0.
+      pwcp (1:jpoce,1,:) = 0.
+
+      DEALLOCATE( zdta   )
+      DEALLOCATE( zdta1  )
+      DEALLOCATE( zhipor )
+     
+   END SUBROUTINE sed_rst_read
+
+   SUBROUTINE sed_rst_wri( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_rst_wri  ***
+      !!
+      !! ** Purpose :  save field which are necessary for sediment restart
+      !!
+      !!   History :
+      !!        !  06-07  (C. Ethe)  original
+      !!----------------------------------------------------------------------
+      !!* Modules used
+      USE ioipsl
+      !! *Arguments
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      !! * local declarations
+      INTEGER  :: ji, jk
+      INTEGER  :: ic, jc, jn, itime 
+      REAL(wp) :: zdate0
+      REAL(wp), DIMENSION(1) ::  zinfo
+      CHARACTER(len=50) :: clname,cln
+      CHARACTER(len=20) :: cltra 
+      REAL(wp), DIMENSION(:,:) , ALLOCATABLE  :: zdta   
+      !! -----------------------------------------------------------------------
+
+      ALLOCATE( zdta(jpoce,jpksed) )
+
+      IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN
+         
+         !! 0. initialisations
+         !! ------------------
+         
+         IF(lwp) WRITE(numsed,*) ' '
+         IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
+            'at it= ',kt
+         IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
+         
+         !! 1. WRITE in nutwrs
+         !! ------------------
+
+         ic = 1
+         DO jc = 1,16
+            IF( cexper(jc:jc) /= ' ') ic = jc
+         END DO
+         WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday
+         clname = cexper(1:ic)//cln
+         itime = 0
+         CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 )
+         zdate0 = zdate0 - adatrj   !   set calendar origin to the beginning of the experiment
+         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, &
+            &         clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom )
+         zinfo(1) = REAL( kt)
+         CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo  )
+
+
+
+         ! Back to 2D geometry
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
+            &                    solcp(1:jpoce,1:jpksed,jsopal ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
+            &                    solcp(1:jpoce,1:jpksed,jsclay ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), &
+            &                    solcp(1:jpoce,1:jpksed,jspoc  ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), &
+            &                    solcp(1:jpoce,1:jpksed,jscal  ) )   
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), &
+            &                    pwcp(1:jpoce,1:jpksed,jwsil  )  )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), &
+            &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), &
+            &                    pwcp(1:jpoce,1:jpksed,jwdic  ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), &
+            &                    pwcp(1:jpoce,1:jpksed,jwno3  ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), &
+            &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), &
+            &                    pwcp(1:jpoce,1:jpksed,jwalk  ) )
+         
+         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwc13  ) )
+         
+         ! porosity
+         zdta(:,:) = 0.
+         DO jk = 1, jpksed
+            DO ji = 1, jpoce
+               zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) )
+            ENDDO
+         ENDDO
+         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
+            &                   zdta(1:jpoce,1:jpksed)  )
+         
+         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
+            &                   co3por(1:jpoce,1:jpksed)  )
+      
+         ! prognostic variables
+         ! --------------------
+
+
+         DO jn = 1, jptrased
+            cltra = sedtrcd(jn)
+            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) )
+         ENDDO
+
+         DO jn = 1, 2
+            cltra = seddia3d(jn)
+            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) )
+         ENDDO
+
+
+         CALL restclo( numrsw )
+
+      ENDIF
+
+      DEALLOCATE( zdta )  
+         
+   END SUBROUTINE sed_rst_wri
+#else
+   !!======================================================================
+   !! MODULE sedrst :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_rst_read                      ! Empty routines
+   END SUBROUTINE sed_rst_read
+   SUBROUTINE sed_rst_wri( kt )
+      INTEGER, INTENT ( in ) :: kt
+      WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_rst_wri   
+#endif
+
+END MODULE sedrst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90	(revision 8732)
@@ -0,0 +1,78 @@
+MODULE sedsfc
+   !!======================================================================
+   !!              ***  MODULE  sedsfc  ***
+   !!    Sediment : Data at sediment surface
+   !!=====================================================================
+#if defined key_sed && ! defined key_sed_off
+   !! * Modules used
+   USE sed     ! sediment global variable
+   USE sedarr
+   USE seddta
+
+   PUBLIC sed_sfc
+
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE sed_sfc( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sed_sfc ***
+      !!
+      !! ** Purpose :  Give data from sediment model to tracer model
+      !!
+      !!
+      !!   History :
+      !!        !  06-04 (C. Ethe)  Orginal code
+      !!----------------------------------------------------------------------
+      !!* Arguments
+      INTEGER, INTENT(in) ::  kt              ! time step
+
+      ! * local variables
+      INTEGER :: ji, jj, ikt     ! dummy loop indices
+
+      !------------------------------------------------------------------------
+
+      IF( kt == nitsed000 ) THEN
+         WRITE(numsed,*) ' sed_sfc : Give data from sediment model to tracer model  '
+         WRITE(numsed,*) ' '
+      ENDIF
+
+      ! reading variables
+
+      CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,1), iarroce(1:jpoce), pwcp(1:jpoce,1,jwalk) )
+      CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,2), iarroce(1:jpoce), pwcp(1:jpoce,1,jwdic) )
+      CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,3), iarroce(1:jpoce), pwcp(1:jpoce,1,jwno3) )
+      CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,4), iarroce(1:jpoce), pwcp(1:jpoce,1,jwpo4) )
+      CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,5), iarroce(1:jpoce), pwcp(1:jpoce,1,jwoxy) )
+      CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,6), iarroce(1:jpoce), pwcp(1:jpoce,1,jwsil) )
+
+
+      DO jj = 1,jpj
+         DO ji = 1, jpi
+            ikt = mbkt(ji,jj)
+            IF ( tmask(ji,jj,ikt) == 1 ) THEN
+               trn(ji,jj,ikt,jptal) = trc_data(ji,jj,1)
+               trn(ji,jj,ikt,jpdic) = trc_data(ji,jj,2)
+               trn(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.6
+               trn(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122.
+               trn(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5)
+               trn(ji,jj,ikt,jpsil) = trc_data(ji,jj,6)
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE sed_sfc
+
+#else
+   !!======================================================================
+   !! MODULE sedsfc  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_sfc ( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_sfc: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_sfc
+#endif
+
+END MODULE sedsfc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90	(revision 8732)
@@ -0,0 +1,79 @@
+MODULE sedstp
+#if defined key_sed
+   !!======================================================================
+   !!                       ***  MODULE sedstp   ***
+   !!   Sediment model : Sediment model time-stepping
+   !!======================================================================
+   USE sed      ! sediment global variables
+   USE seddta   ! data read
+   USE sedchem  ! chemical constant
+   USE sedco3   ! carbonate in sediment pore water
+   USE seddsr   ! dissolution reaction
+   USE sedbtb   ! bioturbation
+   USE sedadv   ! vertical advection
+   USE sedmbc   ! mass balance calculation
+   USE sedsfc   ! sediment surface data
+   USE sedrst   ! restart
+   USE sedwri   ! outputs
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sed_stp  ! called by step.F90
+
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE sed_stp ( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sed_stp  ***
+      !!
+      !! ** Purpose :   Sediment time stepping
+      !!                Simulation of pore water chemistry
+      !!
+      !! ** Action  :
+      !!
+      !!
+      !!   History :
+      !!        !  98-08 (E. Maier-Reimer, Christoph Heinze )  Original code
+      !!        !  04-10 (N. Emprin, M. Gehlen ) coupled with PISCES
+      !!        !  06-04 (C. Ethe)  Re-organization
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+
+      !!----------------------------------------------------------------------
+
+      IF( kt /= nitsed000 )  THEN
+        CALL sed_dta( kt )       ! Load  Data for bot. wat. Chem and fluxes
+        CALL sed_chem( kt )      ! update of chemical constant to account for salinity, temperature changes
+      ENDIF
+      CALL sed_dsr( kt )         ! Dissolution reaction
+      CALL sed_adv( kt )         ! advection
+      CALL sed_btb( kt )         ! Bioturbation
+
+      IF ( ( MOD( kt, nwrised ) == 0 ) .OR. ( MOD( kt, nstock ) == 0 ) .OR. ( kt == nitsedend )  )   &
+      CALL sed_co3( kt )         ! pH actualization for saving
+      CALL sed_mbc( kt )         ! cumulation for mass balance calculation
+#if ! defined key_sed_off
+      CALL sed_sfc( kt )         ! Give back new bottom wat chem to tracer model
+#endif
+      CALL sed_rst_wri( kt )   ! restart file output
+      CALL sed_wri( kt )         ! outputs
+
+      IF( kt == nitsedend )  CLOSE( numsed )
+
+   END SUBROUTINE sed_stp
+
+#else
+   !!======================================================================
+   !! MODULE sedstp  :   Dummy module 
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_stp( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_stp
+#endif
+END MODULE sedstp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90	(revision 8732)
@@ -0,0 +1,277 @@
+MODULE sedwri
+#if defined key_sed
+   !!======================================================================
+   !!                     ***  MODULE  sedwri  ***
+   !!         Sediment diagnostics :  write sediment output files
+   !!======================================================================
+   USE sed
+   USE sedarr
+   USE ioipsl
+   USE dianam    ! build name of file (routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC sed_wri 
+
+   INTEGER  :: nised
+   INTEGER  :: nhorised
+   INTEGER  :: ndimt52
+   INTEGER  :: ndimt51
+   INTEGER  :: ndepsed
+   REAL(wp) :: zjulian
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext52  
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51
+
+   !! $Id$
+CONTAINS
+
+   !!----------------------------------------------------------------------
+   !!                                                   NetCDF output file
+   !!----------------------------------------------------------------------
+   SUBROUTINE sed_wri( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE sed_wri  ***
+      !!
+      !! ** Purpose :  output of sediment passive tracer
+      !!
+      !!   History :
+      !!        !  06-07  (C. Ethe)  original
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) :: kt
+
+      CHARACTER(len = 60)  ::  clhstnam, clop
+      INTEGER  :: ji, jk, js, jw, jn
+      REAL(wp) :: zsto,zout, zdt
+      INTEGER  :: iimi, iima, ijmi, ijma,ipk, it, itmod
+      CHARACTER(len = 20)  ::  cltra , cltrau
+      CHARACTER(len = 80)  ::  cltral
+      REAL(wp)  :: zrate
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx
+
+      !!-------------------------------------------------------------------
+
+
+      ! Initialisation
+      ! ----------------- 
+      IF( kt == nittrc000 )   ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) )
+
+      ! Define frequency of output and means
+      zdt = dtsed
+      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 = nwrised * zdt
+      clop = "inst("//TRIM(clop)//")"
+#else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+#endif
+      zout = nwrised * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpksed
+
+      ! define time axis
+      it = kt
+      itmod = kt - nitsed000 + 1
+
+
+      ! 1.  Initilisations
+      ! -----------------------------------------------------------------
+      WRITE(numsed,*) ' '
+      WRITE(numsed,*) 'sed_wri kt = ', kt
+      WRITE(numsed,*) ' '
+      
+      ALLOCATE( zdta(jpoce,jpksed) )    ;   ALLOCATE( zflx(jpoce,jpwatp1) )
+
+
+      ! 2.  Back to 2D geometry
+      ! -----------------------------------------------------------------
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
+         &                    solcp(1:jpoce,1:jpksed,jsopal ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
+         &                    solcp(1:jpoce,1:jpksed,jsclay ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), &
+         &                    solcp(1:jpoce,1:jpksed,jspoc  ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), &
+         &                    solcp(1:jpoce,1:jpksed,jscal  ) )   
+            
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwsil  )  )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwdic  ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwno3  ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwalk  ) )
+      
+      CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), &
+         &                    pwcp(1:jpoce,1:jpksed,jwc13  ) )
+      
+      ! porosity
+      zdta(:,:) = 0.
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) )
+         ENDDO
+      ENDDO
+      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
+         &                   zdta(1:jpoce,1:jpksed)  )
+      
+      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
+         &                   co3por(1:jpoce,1:jpksed)  )
+      
+      
+      ! computation of delta 13C
+      zdta(:,:) = 0.
+      DO jk = 1, jpksed
+         DO ji = 1, jpoce
+            zdta(ji,jk) = ( ( pwcp(ji,jk,jwc13) / pwcp(ji,jk,jwdic) / pdb ) - 1. ) &
+               &              * 1000.
+         ENDDO
+      ENDDO
+      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3)  , iarroce(1:jpoce), &
+         &                   zdta(1:jpoce,1:jpksed)  )
+      
+ 
+      zflx(:,:) = 0.    
+      ! Calculation of fluxes mol/cm2/s
+      DO jw = 1, jpwat
+         DO ji = 1, jpoce
+            zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) &
+               &         * 1.e-3 * dzkbot(ji) / dtsed
+         ENDDO
+      ENDDO
+      ! Calculation of accumulation rate per dt
+      DO js = 1, jpsol
+         zrate =  mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed
+         DO ji = 1, jpoce
+            zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate
+         ENDDO
+      ENDDO
+
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,1), iarroce(1:jpoce), zflx(1:jpoce,1)  )
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,2), iarroce(1:jpoce), zflx(1:jpoce,2)  )
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,3), iarroce(1:jpoce), zflx(1:jpoce,3)  )
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,4), iarroce(1:jpoce), zflx(1:jpoce,4)  )
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,5), iarroce(1:jpoce), zflx(1:jpoce,5)  )
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,6), iarroce(1:jpoce), zflx(1:jpoce,6)  )
+      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,7), iarroce(1:jpoce), zflx(1:jpoce,8)  )
+
+
+      ! 3. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF( kt == nitsed000 ) THEN
+
+         ! Define the NETCDF files        
+         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
+         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
+         CALL dia_nam ( clhstnam, nwrised, 'sed_T' )
+         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,     &
+            &             iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
+            &             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 )
+         CALL wheneq  ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 )
+
+         ! Declare all the output fields as NETCDF variables
+
+         DO jn = 1, jptrased
+            cltra  = sedtrcd(jn)   ! short title for sediment variable
+            cltral = sedtrcl(jn)   ! long title for  sediment variable
+            cltrau = sedtrcu(jn)   ! unit for  sediment variable
+
+            CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, &
+               &          ipk, 1, ipk, ndepsed, 32, clop, zsto, zout )
+         ENDDO
+
+         ! 3D diagnostic
+         DO jn = 1, jpdia3dsed
+            cltra  = seddia3d(jn)   ! short title for 3D diagnostic
+            cltral = seddia3l(jn)   ! long title for 3D diagnostic
+            cltrau = seddia3u(jn)   ! UNIT for 3D diagnostic
+
+            CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, &
+               &          ipk, 1, ipk, ndepsed, 32, clop, zsto, zout  )
+         ENDDO
+
+         ! Fluxes
+         DO jn = 1, jpdia2dsed
+            cltra  = seddia2d(jn)   ! short title for 2D diagnostic
+            cltral = seddia2l(jn)   ! long title for 2D diagnostic
+            cltrau = seddia2u(jn)   ! UNIT for 2D diagnostic
+            
+            CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, &
+               &          1, 1, 1, -99, 32, clop, zsto, zout )
+         ENDDO
+
+
+         CALL histend( nised, snc4set )
+
+         WRITE(numsed,*)
+         WRITE(numsed,*) 'End of NetCDF sediment output file Initialization'
+
+       ENDIF
+
+       ! Start writing data
+       ! ---------------------
+       DO jn = 1, jptrased
+          cltra = sedtrcd(jn) ! short title for 3D diagnostic
+          CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52 )
+       END DO
+
+       DO jn = 1, jpdia3dsed
+          cltra = seddia3d(jn) ! short title for 3D diagnostic
+          CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52 )
+       END DO
+
+       DO jn = 1, jpdia2dsed
+             cltra = seddia2d(jn) ! short title for 2D diagnostic
+             CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn  ), ndimt51, ndext51 )
+       END DO
+
+
+      ! 3. Closing all files
+      ! --------------------
+      IF( kt == nitsedend  ) THEN
+          CALL histclo( nised )
+      ENDIF
+
+      DEALLOCATE( zdta )    ;   DEALLOCATE( zflx )
+
+   END SUBROUTINE sed_wri
+
+#else
+   !!======================================================================
+   !! MODULE sedwri  :   Dummy module
+   !!======================================================================
+   !! $Id$
+CONTAINS
+   SUBROUTINE sed_wri( kt )         ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE sed_wri
+
+   !!======================================================================
+#endif
+
+END MODULE sedwri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 8732)
@@ -0,0 +1,71 @@
+MODULE par_pisces
+   !!======================================================================
+   !!                        ***  par_pisces  ***
+   !! TOP :   set the PISCES parameters
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+   ! productive layer depth
+   INTEGER, PUBLIC ::   jpkb       !: first vertical layers where biology is active
+   INTEGER, PUBLIC ::   jpkbm1     !: first vertical layers where biology is active
+
+   ! assign an index in trc arrays for each LOBSTER prognostic variables
+   INTEGER, PUBLIC ::   jpdet     !: detritus                   
+   INTEGER, PUBLIC ::   jpdom     !: dissolved organic matter 
+   INTEGER, PUBLIC ::   jpdic     !: dissolved inoganic carbon concentration 
+   INTEGER, PUBLIC ::   jptal     !: total alkalinity 
+   INTEGER, PUBLIC ::   jpoxy     !: oxygen carbon concentration 
+   INTEGER, PUBLIC ::   jpcal     !: calcite  concentration 
+   INTEGER, PUBLIC ::   jppo4     !: phosphate concentration 
+   INTEGER, PUBLIC ::   jppoc     !: small particulate organic phosphate concentration
+   INTEGER, PUBLIC ::   jpsil     !: silicate concentration
+   INTEGER, PUBLIC ::   jpphy     !: phytoplancton concentration 
+   INTEGER, PUBLIC ::   jpzoo     !: zooplancton concentration
+   INTEGER, PUBLIC ::   jpdoc     !: dissolved organic carbon concentration 
+   INTEGER, PUBLIC ::   jpdia     !: Diatoms Concentration
+   INTEGER, PUBLIC ::   jpmes     !: Mesozooplankton Concentration
+   INTEGER, PUBLIC ::   jpdsi     !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC ::   jpfer     !: Iron Concentration
+   INTEGER, PUBLIC ::   jpbfe     !: Big iron particles Concentration
+   INTEGER, PUBLIC ::   jpgoc     !: big particulate organic phosphate concentration
+   INTEGER, PUBLIC ::   jpsfe     !: Small iron particles Concentration
+   INTEGER, PUBLIC ::   jpdfe     !: Diatoms iron Concentration
+   INTEGER, PUBLIC ::   jpgsi     !: (big) Silicate Concentration
+   INTEGER, PUBLIC ::   jpnfe     !: Nano iron Concentration
+   INTEGER, PUBLIC ::   jpnch     !: Nano Chlorophyll Concentration
+   INTEGER, PUBLIC ::   jpdch     !: Diatoms Chlorophyll Concentration
+   INTEGER, PUBLIC ::   jpno3     !: Nitrates Concentration
+   INTEGER, PUBLIC ::   jpnh4     !: Ammonium Concentration
+   INTEGER, PUBLIC ::   jpdon     !: dissolved organic nitrogen concentration
+   INTEGER, PUBLIC ::   jpdop     !: dissolved organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppon     !: small particulate organic nitrogen concentration
+   INTEGER, PUBLIC ::   jppop     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpnph     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppph     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpndi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppdi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppic     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpnpi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpppi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppfe     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppch     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpgon     !: Big nitrogen particles Concentration
+   INTEGER, PUBLIC ::   jpgop     !: Big phosphorus particles Concentration
+   INTEGER, PUBLIC ::   jplgw     !: Weak Ligands
+   INTEGER, PUBLIC ::   jpfep     !: Fe nanoparticle
+
+   !!---------------------------------------------------------------------
+   !!   Default                                   No CFC geochemical model
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC  ::   jp_pcs0  !: First index of PISCES tracers
+   INTEGER, PUBLIC  ::   jp_pcs1  !: Last  index of PISCES tracers
+
+   !!======================================================================
+END MODULE par_pisces
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 8732)
@@ -0,0 +1,202 @@
+MODULE sms_pisces   
+   !!----------------------------------------------------------------------
+   !!                     ***  sms_pisces.F90  ***  
+   !! TOP :   PISCES Source Minus Sink variables
+   !!----------------------------------------------------------------------
+   !! History :   1.0  !  2000-02 (O. Aumont) original code
+   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+
+   IMPLICIT NONE
+   PUBLIC
+
+   INTEGER ::   numnatp_ref = -1           !! Logical units for namelist pisces
+   INTEGER ::   numnatp_cfg = -1           !! Logical units for namelist pisces
+   INTEGER ::   numonp      = -1           !! Logical unit for namelist pisces output
+
+   !                                                       !:  PISCES  : silicon dependant half saturation
+
+   !!* Model used
+   LOGICAL  ::  ln_p2z            !: Flag to use LOBSTER model
+   LOGICAL  ::  ln_p4z            !: Flag to use PISCES  model
+   LOGICAL  ::  ln_p5z            !: Flag to use PISCES  quota model
+   LOGICAL  ::  ln_ligand         !: Flag to enable organic ligands
+
+   !!*  Time variables
+   INTEGER  ::   nrdttrc           !: ???
+   INTEGER  ::   ndayflxtr         !: ???
+   REAL(wp) ::   rfact , rfactr    !: ???
+   REAL(wp) ::   rfact2, rfact2r   !: ???
+   REAL(wp) ::   xstep             !: Time step duration for biology
+   REAL(wp) ::   ryyss             !: number of seconds per year 
+   REAL(wp) ::   r1_ryyss          !: inverse number of seconds per year 
+
+
+   !!*  Biological parameters 
+   INTEGER  ::   niter1max, niter2max   !: Maximum number of iterations for sinking
+   REAL(wp) ::   rno3              !: ???
+   REAL(wp) ::   o2ut              !: ???
+   REAL(wp) ::   po4r              !: ???
+   REAL(wp) ::   rdenit            !: ???
+   REAL(wp) ::   rdenita           !: ???
+   REAL(wp) ::   o2nit             !: ???
+   REAL(wp) ::   wsbio, wsbio2     !: ???
+   REAL(wp) ::   wsbio2max         !: ???
+   REAL(wp) ::   wsbio2scale       !: ???
+   REAL(wp) ::   xkmort            !: ???
+   REAL(wp) ::   ferat3            !: ???
+   REAL(wp) ::   wfep              !: ???
+   REAL(wp) ::   ldocp             !: ???
+   REAL(wp) ::   ldocz             !: ???
+   REAL(wp) ::   lthet             !: ???
+   REAL(wp) ::   no3rat3           !: ???
+   REAL(wp) ::   po4rat3           !: ???
+
+
+   !!*  diagnostic parameters 
+   REAL(wp) ::  tpp                !: total primary production
+   REAL(wp) ::  t_oce_co2_exp      !: total carbon export
+   REAL(wp) ::  t_oce_co2_flx      !: Total ocean carbon flux
+   REAL(wp) ::  t_oce_co2_flx_cum  !: Cumulative Total ocean carbon flux
+   REAL(wp) ::  t_atm_co2_flx      !: global mean of atmospheric pco2
+
+   !!* restoring
+   LOGICAL  ::  ln_pisdmp          !: restoring or not of nutrients to a mean value
+   INTEGER  ::  nn_pisdmp          !: frequency of relaxation or not of nutrients to a mean value
+
+   !!* Mass conservation
+   LOGICAL  ::  ln_check_mass      !: Flag to check mass conservation
+
+   !!*  Biological fluxes for light : variables shared by pisces & lobster
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot_ndcy      !: PAR over 24h in case of diurnal cycle
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  epico          !: PAR for pico
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  emoy           !: averaged PAR in the mixed layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup_01 !: Absolute euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure
+
+   !!*  Biological fluxes for primary production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   xksimax    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   biron      !: bioavailable fraction of iron
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   plig       !: proportion of iron organically complexed
+
+   !!*  Sinking speed
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsfep
+
+
+
+   !!*  SMS for the organic matter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   orem       !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodpoc    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   conspoc    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodgoc    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   consgoc    !: Calcite production
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizen      !: size of diatoms 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizep      !: size of diatoms 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sized      !: size of diatoms 
+
+
+   !!* Variable for chemistry of the CO2 cycle
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aphscale   !: 
+
+
+   !!* Temperature dependancy of SMS terms
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates
+
+#if defined key_sed
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   INTEGER FUNCTION sms_pisces_alloc()
+      !!----------------------------------------------------------------------
+      !!        *** ROUTINE sms_pisces_alloc ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp , ONLY: ctl_warn
+      INTEGER ::   ierr(10)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !*  Biological fluxes for light : shared variables for pisces & lobster
+      ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj),    &
+        &       heup_01(jpi,jpj) , xksi(jpi,jpj)               ,  STAT=ierr(1) )
+      !
+  
+      IF( ln_p4z .OR. ln_p5z ) THEN
+         !*  Biological fluxes for light 
+         ALLOCATE(  enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk) ,   &
+           &        etot_ndcy(jpi,jpj,jpk), emoy(jpi,jpj,jpk)  ,  STAT=ierr(2) ) 
+
+         !*  Biological fluxes for primary production
+         ALLOCATE( xksimax(jpi,jpj)  , biron(jpi,jpj,jpk)      ,  STAT=ierr(3) )
+         !
+         !*  SMS for the organic matter
+         ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk) ,    &
+            &      orem    (jpi,jpj,jpk),                           &
+            &      prodcal(jpi,jpj,jpk),  xdiss   (jpi,jpj,jpk),    &
+            &      prodpoc(jpi,jpj,jpk) , conspoc(jpi,jpj,jpk) ,    &
+            &      prodgoc(jpi,jpj,jpk) , consgoc(jpi,jpj,jpk) ,  STAT=ierr(4) )
+
+         !* Variable for chemistry of the CO2 cycle
+         ALLOCATE( ak13  (jpi,jpj,jpk) ,                            &
+            &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,     &
+            &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     &
+            &      aphscale(jpi,jpj,jpk),                         STAT=ierr(5) )
+         !
+         !* Temperature dependancy of SMS terms
+         ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk),   STAT=ierr(6) )
+         !
+         !* Sinkong speed
+         ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk),     &
+            &      wscal(jpi,jpj,jpk)                         ,   STAT=ierr(7) )   
+         ! 
+         IF( ln_ligand ) THEN
+           ALLOCATE( plig(jpi,jpj,jpk)  , wsfep(jpi,jpj,jpk)  ,   STAT=ierr(8) )
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( ln_p5z ) THEN
+         !       
+         ALLOCATE( epico(jpi,jpj,jpk)                         ,   STAT=ierr(9) ) 
+
+         !*  Size of phytoplankton cells
+         ALLOCATE( sizen(jpi,jpj,jpk), sizep(jpi,jpj,jpk),         &
+           &       sized(jpi,jpj,jpk),                            STAT=ierr(10) )
+      ENDIF
+      !
+      sms_pisces_alloc = MAXVAL( ierr )
+      !
+      IF( sms_pisces_alloc /= 0 )   CALL ctl_warn('sms_pisces_alloc: failed to allocate arrays') 
+      !
+   END FUNCTION sms_pisces_alloc
+
+   !!======================================================================   
+END MODULE sms_pisces    
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90	(revision 8732)
@@ -0,0 +1,338 @@
+MODULE trcice_pisces
+   !!======================================================================
+   !!                         ***  MODULE trcice_pisces  ***
+   !! TOP :   initialisation of the PISCES biochemical model
+   !!======================================================================
+   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
+   !!----------------------------------------------------------------------
+   !! trc_ice_pisces   : PISCES fake sea ice model setting
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE par_pisces      ! PISCES parameters
+   USE oce_trc         ! Shared variables between ocean and passive tracers
+   USE trc             ! Passive tracers common variables 
+   USE sms_pisces      ! PISCES Source Minus Sink variables
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ice_ini_pisces ! called by trcini.F90 module
+
+CONTAINS
+
+
+   SUBROUTINE trc_ice_ini_pisces
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_ini_pisces ***
+      !!
+      !! ** Purpose :   Initialisation of the PISCES biochemical model
+      !!----------------------------------------------------------------------
+
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ice_ini   !  PISCES
+      ELSE                           ;   CALL p2z_ice_ini   !  LOBSTER
+      ENDIF
+
+   END SUBROUTINE trc_ice_ini_pisces
+
+
+   SUBROUTINE p4z_ice_ini
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE p4z_ice_ini ***
+      !!
+      !! ** Purpose :   PISCES fake sea ice model setting
+      !!    Method  :   Assign prescribe values to tracer concentrations in sea ice
+      !!
+      !! For levitating sea ice, constant ocean tracer concentrations also have to be defined. 
+      !! This is done specifically for Global, Arctic, Antarctic and Baltic regions
+      !! 
+      !! Sea ice concentrations are by default prescribed as follows
+      !!  trc_i = zratio * trc_o
+      !!
+      !! This formulation is modulated by the namelist parameter trc_ice_ratio
+      !!
+      !! trc_ice_ratio  * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+      !!                * -1 => the ice-ocean tracer concentration ratio follows the
+      !!                         ice-ocean salinity ratio
+      !!                * -2 => no ice-ocean tracer concentration is used
+      !!                        instead, the tracer concentration in sea ice 
+      !!                        is prescribed to trc_ice_prescr
+      !! 
+      !! cn_trc_o  specifies which disinctions are made for prescribed tracer concentration
+      !!                * 'GL' use global ocean values making distinction for Baltic Sea only
+      !!                * 'AA' use Arctic/Antarctic contrasted values, + Baltic
+      !!
+      !!----------------------------------------------------------------------
+
+                                        !--- Dummy variables
+      REAL(wp), DIMENSION(jpmaxtrc,2) :: zratio  ! effective ice-ocean tracer cc ratio
+      REAL(wp), DIMENSION(jpmaxtrc,4) :: zpisc   ! prescribes concentration 
+      !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic
+
+      REAL(wp), DIMENSION(2) :: zrs  ! ice-ocean salinity ratio, 1 - global, 2- Baltic
+      REAL(wp) :: zsice_bal          ! prescribed ice salinity in the Baltic
+      REAL(wp) :: zsoce_bal          ! prescribed ocean salinity in the Baltic
+      REAL(wp) :: zfeoce_glo         ! prescribed iron concentration in the global ocean
+      REAL(wp) :: zfeoce_bal         ! prescribed iron concentration in the global ocean
+      INTEGER  :: jn                 ! dummy loop index
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ice_ini_pisces: Prescribed sea ice biogeochemistry '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~'
+
+      !--------------------------------------------
+      ! Initialize ocean prescribed concentrations
+      !--------------------------------------------
+      ! values taken from a 500 yr equilibrium run
+      ! used only in the levitating sea ice case with virtual salt / tracer
+      ! fluxes
+
+      !--- Global values
+      zpisc(jpdic,1) =  1.99e-3_wp 
+      zpisc(jpdoc,1) =  2.04e-5_wp 
+      zpisc(jptal,1) =  2.31e-3_wp 
+      zpisc(jpoxy,1) =  2.47e-4_wp
+      zpisc(jpcal,1) =  1.04e-8_wp
+      zpisc(jppo4,1) =  5.77e-7_wp / po4r 
+      zpisc(jppoc,1) =  1.27e-6_wp  
+      zpisc(jpgoc,1) =  5.23e-8_wp  
+      zpisc(jpbfe,1) =  9.84e-13_wp 
+      zpisc(jpsil,1) =  7.36e-6_wp  
+      zpisc(jpdsi,1) =  1.07e-7_wp 
+      zpisc(jpgsi,1) =  1.53e-8_wp
+      zpisc(jpphy,1) =  9.57e-8_wp
+      zpisc(jpdia,1) =  4.24e-7_wp
+      zpisc(jpzoo,1) =  6.07e-7_wp
+      zpisc(jpmes,1) =  3.44e-7_wp
+      zpisc(jpfer,1) =  4.06e-10_wp
+      zpisc(jpsfe,1) =  2.51e-11_wp
+      zpisc(jpdfe,1) =  6.57e-12_wp
+      zpisc(jpnfe,1) =  1.76e-11_wp
+      zpisc(jpnch,1) =  1.67e-7_wp
+      zpisc(jpdch,1) =  1.02e-7_wp
+      zpisc(jpno3,1) =  5.79e-6_wp / rno3 
+      zpisc(jpnh4,1) =  3.22e-7_wp / rno3
+
+      ! ln_p5z
+      zpisc(jppic,1) =  9.57e-8_wp
+      zpisc(jpnpi,1) =  9.57e-8_wp
+      zpisc(jpppi,1) =  9.57e-8_wp
+      zpisc(jppfe,1) =  1.76e-11_wp
+      zpisc(jppch,1) =  1.67e-7_wp
+      zpisc(jpnph,1) =  9.57e-8_wp
+      zpisc(jppph,1) =  9.57e-8_wp
+      zpisc(jpndi,1) =  4.24e-7_wp
+      zpisc(jppdi,1) =  4.24e-7_wp
+      zpisc(jppon,1) =  9.57e-8_wp
+      zpisc(jppop,1) =  9.57e-8_wp
+      zpisc(jpdon,1) =  2.04e-5_wp
+      zpisc(jpdop,1) =  2.04e-5_wp
+      zpisc(jpgon,1) =  5.23e-8_wp
+      zpisc(jpgop,1) =  5.23e-8_wp
+
+      !--- Arctic specificities (dissolved inorganic & DOM)
+      zpisc(jpdic,2) =  1.98e-3_wp 
+      zpisc(jpdoc,2) =  6.00e-6_wp 
+      zpisc(jptal,2) =  2.13e-3_wp 
+      zpisc(jpoxy,2) =  3.65e-4_wp  
+      zpisc(jpcal,2) =  1.50e-9_wp  
+      zpisc(jppo4,2) =  4.09e-7_wp / po4r 
+      zpisc(jppoc,2) =  4.05e-7_wp  
+      zpisc(jpgoc,2) =  2.84e-8_wp  
+      zpisc(jpbfe,2) =  7.03e-13_wp 
+      zpisc(jpsil,2) =  6.87e-6_wp  
+      zpisc(jpdsi,2) =  1.73e-7_wp 
+      zpisc(jpgsi,2) =  7.93e-9_wp
+      zpisc(jpphy,2) =  5.25e-7_wp  
+      zpisc(jpdia,2) =  7.75e-7_wp 
+      zpisc(jpzoo,2) =  3.34e-7_wp
+      zpisc(jpmes,2) =  2.49e-7_wp  
+      zpisc(jpfer,2) =  1.43e-9_wp 
+      zpisc(jpsfe,2) =  2.21e-11_wp 
+      zpisc(jpdfe,2) =  2.04e-11_wp 
+      zpisc(jpnfe,2) =  1.75e-11_wp 
+      zpisc(jpnch,2) =  1.46e-07_wp 
+      zpisc(jpdch,2) =  2.36e-07_wp 
+      zpisc(jpno3,2) =  3.51e-06_wp / rno3 
+      zpisc(jpnh4,2) =  6.15e-08_wp / rno3 
+
+      ! ln_p5z
+      zpisc(jppic,2) =  5.25e-7_wp
+      zpisc(jpnpi,2) =  5.25e-7_wp
+      zpisc(jpppi,2) =  5.25e-7_wp
+      zpisc(jppfe,2) =  1.75e-11_wp
+      zpisc(jppch,2) =  1.46e-07_wp
+      zpisc(jpnph,2) =  5.25e-7_wp
+      zpisc(jppph,2) =  5.25e-7_wp
+      zpisc(jpndi,2) =  7.75e-7_wp
+      zpisc(jppdi,2) =  7.75e-7_wp
+      zpisc(jppon,2) =  4.05e-7_wp
+      zpisc(jppop,2) =  4.05e-7_wp
+      zpisc(jpdon,2) =  6.00e-6_wp
+      zpisc(jpdop,2) =  6.00e-6_wp
+      zpisc(jpgon,2) =  2.84e-8_wp
+      zpisc(jpgop,2) =  2.84e-8_wp
+
+      !--- Antarctic specificities (dissolved inorganic & DOM)
+      zpisc(jpdic,3) =  2.20e-3_wp  
+      zpisc(jpdoc,3) =  7.02e-6_wp  
+      zpisc(jptal,3) =  2.37e-3_wp  
+      zpisc(jpoxy,3) =  3.42e-4_wp  
+      zpisc(jpcal,3) =  3.17e-9_wp  
+      zpisc(jppo4,3) =  1.88e-6_wp / po4r  
+      zpisc(jppoc,3) =  1.13e-6_wp  
+      zpisc(jpgoc,3) =  2.89e-8_wp  
+      zpisc(jpbfe,3) =  5.63e-13_wp 
+      zpisc(jpsil,3) =  4.96e-5_wp  
+      zpisc(jpdsi,3) =  5.63e-7_wp 
+      zpisc(jpgsi,3) =  5.35e-8_wp
+      zpisc(jpphy,3) =  8.10e-7_wp  
+      zpisc(jpdia,3) =  5.77e-7_wp 
+      zpisc(jpzoo,3) =  6.68e-7_wp
+      zpisc(jpmes,3) =  3.55e-7_wp  
+      zpisc(jpfer,3) =  1.62e-10_wp
+      zpisc(jpsfe,3) =  2.29e-11_wp 
+      zpisc(jpdfe,3) =  8.75e-12_wp
+      zpisc(jpnfe,3) =  1.48e-11_wp 
+      zpisc(jpnch,3) =  2.02e-7_wp  
+      zpisc(jpdch,3) =  1.60e-7_wp  
+      zpisc(jpno3,3) =  2.64e-5_wp / rno3  
+      zpisc(jpnh4,3) =  3.39e-7_wp / rno3  
+
+      ! ln_p5z
+      zpisc(jppic,3) =  8.10e-7_wp
+      zpisc(jpnpi,3) =  8.10e-7_wp
+      zpisc(jpppi,3) =  8.10e-7_wp 
+      zpisc(jppfe,3) =  1.48e-11_wp
+      zpisc(jppch,3) =  2.02e-7_wp
+      zpisc(jpnph,3) =  9.57e-8_wp
+      zpisc(jppph,3) =  9.57e-8_wp
+      zpisc(jpndi,3) =  5.77e-7_wp
+      zpisc(jppdi,3) =  5.77e-7_wp
+      zpisc(jppon,3) =  1.13e-6_wp
+      zpisc(jppop,3) =  1.13e-6_wp
+      zpisc(jpdon,3) =  7.02e-6_wp
+      zpisc(jpdop,3) =  7.02e-6_wp
+      zpisc(jpgon,3) =  2.89e-8_wp
+      zpisc(jpgop,3) =  2.89e-8_wp
+
+
+      !--- Baltic Sea particular case for ORCA configurations
+      zpisc(jpdic,4) = 1.14e-3_wp
+      zpisc(jpdoc,4) = 1.06e-5_wp
+      zpisc(jptal,4) = 1.16e-3_wp
+      zpisc(jpoxy,4) = 3.71e-4_wp
+      zpisc(jpcal,4) = 1.51e-9_wp
+      zpisc(jppo4,4) = 2.85e-9_wp / po4r
+      zpisc(jppoc,4) = 4.84e-7_wp
+      zpisc(jpgoc,4) = 1.05e-8_wp
+      zpisc(jpbfe,4) = 4.97e-13_wp
+      zpisc(jpsil,4) = 4.91e-5_wp
+      zpisc(jpdsi,4) = 3.25e-7_wp
+      zpisc(jpgsi,4) = 1.93e-8_wp
+      zpisc(jpphy,4) = 6.64e-7_wp
+      zpisc(jpdia,4) = 3.41e-7_wp
+      zpisc(jpzoo,4) = 3.83e-7_wp
+      zpisc(jpmes,4) = 0.225e-6_wp
+      zpisc(jpfer,4) = 2.45e-9_wp
+      zpisc(jpsfe,4) = 3.89e-11_wp
+      zpisc(jpdfe,4) = 1.33e-11_wp
+      zpisc(jpnfe,4) = 2.62e-11_wp
+      zpisc(jpnch,4) = 1.17e-7_wp
+      zpisc(jpdch,4) = 9.69e-8_wp
+      zpisc(jpno3,4) = 5.36e-5_wp / rno3
+      zpisc(jpnh4,4) = 7.18e-7_wp / rno3
+
+      ! ln_p5z
+      zpisc(jppic,4) =  6.64e-7_wp
+      zpisc(jpnpi,4) =  6.64e-7_wp
+      zpisc(jpppi,4) =  6.64e-7_wp
+      zpisc(jppfe,4) =  3.89e-11_wp
+      zpisc(jppch,4) =  1.17e-7_wp
+      zpisc(jpnph,4) =  6.64e-7_wp
+      zpisc(jppph,4) =  6.64e-7_wp
+      zpisc(jpndi,4) =  3.41e-7_wp
+      zpisc(jppdi,4) =  3.41e-7_wp
+      zpisc(jppon,4) =  4.84e-7_wp
+      zpisc(jppop,4) =  4.84e-7_wp
+      zpisc(jpdon,4) =  1.06e-5_wp
+      zpisc(jpdop,4) =  1.06e-5_wp
+      zpisc(jpgon,4) =  1.05e-8_wp
+      zpisc(jpgop,4) =  1.05e-8_wp
+ 
+      DO jn = jp_pcs0, jp_pcs1
+         IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1)  ! Global case
+         IF( cn_trc_o(jn) == 'AA ' ) THEN 
+            WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic 
+            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic 
+         ENDIF
+         IF( cn_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations
+             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                    trc_o(:,:,jn) = zpisc(jn,4)
+            END WHERE
+         ENDIF 
+      ENDDO
+
+
+
+      !-----------------------------
+      ! Assign ice-ocean cc ratios 
+      !-----------------------------
+      ! 0 means zero concentration in sea ice
+      ! 1 means same concentration in the sea ice as in the ocean
+
+      ! Ice ocean salinity ratio
+      zsoce_bal   = 4. ; zsice_bal   = 2. !! Baltic ocean and sea ice salinities
+      zrs(1) = sice / soce                !! ice-ocean salinity ratio, global case
+      zrs(2) = zsice_bal / zsoce_bal      !! ice-ocean salinity ratio, Baltic case
+
+      DO jn = jp_pcs0, jp_pcs1
+         IF( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn)
+         IF( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:)
+         IF( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp
+      END DO
+
+      !-------------------------------
+      ! Sea ice tracer concentrations
+      !-------------------------------
+      DO jn = jp_pcs0, jp_pcs1
+         !-- Everywhere but in the Baltic
+         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+            trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn) 
+         ELSE                                    ! prescribed concentration
+            trc_i(:,:,jn) = trc_ice_prescr(jn)
+         ENDIF
+       
+         !-- Baltic
+         IF( cn_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs
+            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 
+               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                      54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                     trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn) 
+               END WHERE
+            ELSE                                 ! prescribed tracer concentration in ice
+               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    &
+                   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+                     trc_i(:,:,jn) = trc_ice_prescr(jn)
+               END WHERE
+            ENDIF ! trc_ice_ratio
+         ENDIF
+      !
+      END DO ! jn
+      !
+   END SUBROUTINE p4z_ice_ini
+
+   SUBROUTINE p2z_ice_ini
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE p2z_ice_ini ***
+      !!
+      !! ** Purpose :   Initialisation of the LOBSTER biochemical model
+      !!----------------------------------------------------------------------
+   END SUBROUTINE p2z_ice_ini
+
+
+   !!======================================================================
+END MODULE trcice_pisces
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 8732)
@@ -0,0 +1,354 @@
+MODULE trcini_pisces
+   !!======================================================================
+   !!                         ***  MODULE trcini_pisces  ***
+   !! TOP :   initialisation of the PISCES biochemical model
+   !!======================================================================
+   !! History :    -   !  1988-07  (E. Maier-Reiner) Original code
+   !!              -   !  1999-10  (O. Aumont, C. Le Quere)
+   !!              -   !  2002     (O. Aumont)  PISCES
+   !!             1.0  !  2005-03  (O. Aumont, A. El Moussaoui) F90
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.pisces.h90
+   !!             3.5  !  2012-05  (C. Ethe) Merge PISCES-LOBSTER
+   !!----------------------------------------------------------------------
+   !! trc_ini_pisces   : PISCES biochemical model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         !  TOP parameters
+   USE oce_trc         !  shared variables between ocean and passive tracers
+   USE trc             !  passive tracers common variables 
+   USE trcnam_pisces   !  PISCES namelist
+   USE sms_pisces      !  PISCES Source Minus Sink variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_pisces
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_ini_pisces ***
+      !!
+      !! ** Purpose :   Initialisation of the PISCES biochemical model
+      !!----------------------------------------------------------------------
+
+      !
+      CALL trc_nam_pisces
+      !
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini   !  PISCES
+      ELSE                           ;   CALL p2z_ini   !  LOBSTER
+      ENDIF
+
+   END SUBROUTINE trc_ini_pisces
+
+   SUBROUTINE p4z_ini
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE p4z_ini ***
+      !!
+      !! ** Purpose :   Initialisation of the PISCES biochemical model
+      !!----------------------------------------------------------------------
+      !
+      USE p4zsms          ! Main P4Z routine
+      USE p4zche          !  Chemical model
+      USE p4zsink         !  vertical flux of particulate matter due to sinking
+      USE p4zopt          !  optical model
+      USE p4zsbc          !  Boundary conditions
+      USE p4zfechem       !  Iron chemistry
+      USE p4zrem          !  Remineralisation of organic matter
+      USE p4zflx          !  Gas exchange
+      USE p4zlim          !  Co-limitations of differents nutrients
+      USE p4zprod         !  Growth rate of the 2 phyto groups
+      USE p4zmicro        !  Sources and sinks of microzooplankton
+      USE p4zmeso         !  Sources and sinks of mesozooplankton
+      USE p4zmort         !  Mortality terms for phytoplankton
+      USE p4zlys          !  Calcite saturation
+      USE p4zsed          !  Sedimentation & burial
+      USE p4zpoc          !  Remineralization of organic particles
+      USE p4zligand       !  Remineralization of organic ligands
+      USE p5zlim          !  Co-limitations of differents nutrients
+      USE p5zprod         !  Growth rate of the 2 phyto groups
+      USE p5zmicro        !  Sources and sinks of microzooplankton
+      USE p5zmeso         !  Sources and sinks of mesozooplankton
+      USE p5zmort         !  Mortality terms for phytoplankton
+
+      !
+      REAL(wp), SAVE :: sco2   =  2.312e-3_wp
+      REAL(wp), SAVE :: alka0  =  2.426e-3_wp
+      REAL(wp), SAVE :: oxyg0  =  177.6e-6_wp 
+      REAL(wp), SAVE :: po4    =  2.165e-6_wp 
+      REAL(wp), SAVE :: bioma0 =  1.000e-8_wp  
+      REAL(wp), SAVE :: silic1 =  91.51e-6_wp  
+      REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp
+      !
+      INTEGER  ::  ji, jj, jk, jn, ierr
+      REAL(wp) ::  zcaralk, zbicarb, zco3
+      REAL(wp) ::  ztmas, ztmas1
+      CHARACTER(len = 20)  ::  cltra
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( ln_p4z ) THEN 
+            WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation'
+         ELSE
+            WRITE(numout,*) ' p5z_ini :   PISCES biochemical model initialisation'
+            WRITE(numout,*) '             With variable stoichiometry'
+         ENDIF
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      ENDIF
+      !
+      ! Allocate PISCES arrays
+      ierr =         sms_pisces_alloc()          
+      ierr = ierr +  p4z_che_alloc()
+      ierr = ierr +  p4z_sink_alloc()
+      ierr = ierr +  p4z_opt_alloc()
+      ierr = ierr +  p4z_flx_alloc()
+      ierr = ierr +  p4z_sed_alloc()
+      ierr = ierr +  p4z_rem_alloc()
+      IF( ln_p4z ) THEN
+         ierr = ierr +  p4z_lim_alloc()
+         ierr = ierr +  p4z_prod_alloc()
+      ELSE
+         ierr = ierr +  p5z_lim_alloc()
+         ierr = ierr +  p5z_prod_alloc()
+      ENDIF
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' )
+      !
+      ryyss    = nyear_len(1) * rday    ! number of seconds per year
+      r1_ryyss = 1. / ryyss
+      !
+
+      ! assign an index in trc arrays for each prognostic variables
+      DO jn = 1, jptra
+        cltra = ctrcnm(jn) 
+        IF( cltra == 'DIC'      )   jpdic = jn      !: dissolved inoganic carbon concentration 
+        IF( cltra == 'Alkalini' )   jptal = jn      !: total alkalinity 
+        IF( cltra == 'O2'       )   jpoxy = jn      !: oxygen carbon concentration 
+        IF( cltra == 'CaCO3'    )   jpcal = jn      !: calcite  concentration 
+        IF( cltra == 'PO4'      )   jppo4 = jn      !: phosphate concentration 
+        IF( cltra == 'POC'      )   jppoc = jn      !: small particulate organic phosphate concentration
+        IF( cltra == 'Si'       )   jpsil = jn      !: silicate concentration
+        IF( cltra == 'PHY'      )   jpphy = jn      !: phytoplancton concentration 
+        IF( cltra == 'ZOO'      )   jpzoo = jn      !: zooplancton concentration
+        IF( cltra == 'DOC'      )   jpdoc = jn      !: dissolved organic carbon concentration 
+        IF( cltra == 'PHY2'     )   jpdia = jn      !: Diatoms Concentration
+        IF( cltra == 'ZOO2'     )   jpmes = jn      !: Mesozooplankton Concentration
+        IF( cltra == 'DSi'      )   jpdsi = jn      !: Diatoms Silicate Concentration
+        IF( cltra == 'Fer'      )   jpfer = jn      !: Iron Concentration
+        IF( cltra == 'BFe'      )   jpbfe = jn      !: Big iron particles Concentration
+        IF( cltra == 'GOC'      )   jpgoc = jn      !: Big particulate organic phosphate concentration
+        IF( cltra == 'SFe'      )   jpsfe = jn      !: Small iron particles Concentration
+        IF( cltra == 'DFe'      )   jpdfe = jn      !: Diatoms iron Concentration
+        IF( cltra == 'GSi'      )   jpgsi = jn      !: (big) Silicate Concentration
+        IF( cltra == 'NFe'      )   jpnfe = jn      !: Nano iron Concentration
+        IF( cltra == 'NCHL'     )   jpnch = jn      !: Nano Chlorophyll Concentration
+        IF( cltra == 'DCHL'     )   jpdch = jn      !: Diatoms Chlorophyll Concentration
+        IF( cltra == 'NO3'      )   jpno3 = jn      !: Nitrates Concentration
+        IF( cltra == 'NH4'      )   jpnh4 = jn      !: Ammonium Concentration
+        IF( cltra == 'DON'      )   jpdon = jn      !: Dissolved organic N Concentration
+        IF( cltra == 'DOP'      )   jpdop = jn      !: Dissolved organic P Concentration
+        IF( cltra == 'PON'      )   jppon = jn      !: Small Nitrogen particle Concentration
+        IF( cltra == 'POP'      )   jppop = jn      !: Small Phosphorus particle Concentration
+        IF( cltra == 'GON'      )   jpgon = jn      !: Big Nitrogen particles Concentration
+        IF( cltra == 'GOP'      )   jpgop = jn      !: Big Phosphorus Concentration
+        IF( cltra == 'PHYN'     )   jpnph = jn      !: Nanophytoplankton N biomass
+        IF( cltra == 'PHYP'     )   jppph = jn      !: Nanophytoplankton P biomass
+        IF( cltra == 'DIAN'     )   jpndi = jn      !: Diatoms N biomass
+        IF( cltra == 'DIAP'     )   jppdi = jn      !: Diatoms P biomass
+        IF( cltra == 'PIC'      )   jppic = jn      !: Picophytoplankton C biomass
+        IF( cltra == 'PICN'     )   jpnpi = jn      !: Picophytoplankton N biomass
+        IF( cltra == 'PICP'     )   jpppi = jn      !: Picophytoplankton P biomass
+        IF( cltra == 'PFe'      )   jppfe = jn      !: Picophytoplankton Fe biomass
+        IF( cltra == 'LGW'      )   jplgw = jn      !: Weak ligands
+        IF( cltra == 'LFe'      )   jpfep = jn      !: Fe nanoparticle
+      ENDDO
+
+      CALL p4z_sms_init       !  Maint routine
+      !                                            ! Time-step
+
+      ! Set biological ratios
+      ! ---------------------
+      rno3    =  16._wp / 122._wp
+      po4r    =   1._wp / 122._wp
+      o2nit   =  32._wp / 122._wp
+      o2ut    = 133._wp / 122._wp
+      rdenit  =  ( ( o2ut + o2nit ) * 0.80 - rno3 - rno3 * 0.60 ) / rno3
+      rdenita =   3._wp /  5._wp
+      IF( ln_p5z ) THEN
+         no3rat3 = no3rat3 / rno3
+         po4rat3 = po4rat3 / po4r
+      ENDIF
+
+      ! Initialization of tracer concentration in case of  no restart 
+      !--------------------------------------------------------------
+      IF( .NOT.ln_rsttr ) THEN  
+         trn(:,:,:,jpdic) = sco2
+         trn(:,:,:,jpdoc) = bioma0
+         trn(:,:,:,jptal) = alka0
+         trn(:,:,:,jpoxy) = oxyg0
+         trn(:,:,:,jpcal) = bioma0
+         trn(:,:,:,jppo4) = po4 / po4r
+         trn(:,:,:,jppoc) = bioma0
+         trn(:,:,:,jpgoc) = bioma0
+         trn(:,:,:,jpbfe) = bioma0 * 5.e-6
+         trn(:,:,:,jpsil) = silic1
+         trn(:,:,:,jpdsi) = bioma0 * 0.15
+         trn(:,:,:,jpgsi) = bioma0 * 5.e-6
+         trn(:,:,:,jpphy) = bioma0
+         trn(:,:,:,jpdia) = bioma0
+         trn(:,:,:,jpzoo) = bioma0
+         trn(:,:,:,jpmes) = bioma0
+         trn(:,:,:,jpfer) = 0.6E-9
+         trn(:,:,:,jpsfe) = bioma0 * 5.e-6
+         trn(:,:,:,jpdfe) = bioma0 * 5.e-6
+         trn(:,:,:,jpnfe) = bioma0 * 5.e-6
+         trn(:,:,:,jpnch) = bioma0 * 12. / 55.
+         trn(:,:,:,jpdch) = bioma0 * 12. / 55.
+         trn(:,:,:,jpno3) = no3
+         trn(:,:,:,jpnh4) = bioma0
+         IF( ln_ligand) THEN
+            trn(:,:,:,jplgw) = 0.6E-9
+            trn(:,:,:,jpfep) = 0. * 5.e-6
+         ENDIF
+         IF( ln_p5z ) THEN
+            trn(:,:,:,jpdon) = bioma0
+            trn(:,:,:,jpdop) = bioma0
+            trn(:,:,:,jppon) = bioma0
+            trn(:,:,:,jppop) = bioma0
+            trn(:,:,:,jpgon) = bioma0
+            trn(:,:,:,jpgop) = bioma0
+            trn(:,:,:,jpnph) = bioma0
+            trn(:,:,:,jppph) = bioma0
+            trn(:,:,:,jppic) = bioma0
+            trn(:,:,:,jpnpi) = bioma0
+            trn(:,:,:,jpppi) = bioma0
+            trn(:,:,:,jpndi) = bioma0
+            trn(:,:,:,jppdi) = bioma0
+            trn(:,:,:,jppfe) = bioma0 * 5.e-6
+            trn(:,:,:,jppch) = bioma0 * 12. / 55.
+         ENDIF
+         ! initialize the half saturation constant for silicate
+         ! ----------------------------------------------------
+         xksi(:,:)    = 2.e-6
+         xksimax(:,:) = xksi(:,:)
+      END IF
+
+
+      CALL p4z_sink_init         !  vertical flux of particulate organic matter
+      CALL p4z_opt_init          !  Optic: PAR in the water column
+      IF( ln_p4z ) THEN
+         CALL p4z_lim_init       !  co-limitations by the various nutrients
+         CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean.
+      ELSE
+         CALL p5z_lim_init       !  co-limitations by the various nutrients
+         CALL p5z_prod_init      !  phytoplankton growth rate over the global ocean.
+      ENDIF
+      CALL p4z_sbc_init          !  boundary conditions
+      CALL p4z_fechem_init       !  Iron chemistry
+      CALL p4z_rem_init          !  remineralisation
+      CALL p4z_poc_init          !  remineralisation of organic particles
+      IF( ln_ligand ) &
+         & CALL p4z_ligand_init  !  remineralisation of organic ligands
+
+      IF( ln_p4z ) THEN
+         CALL p4z_mort_init      !  phytoplankton mortality 
+         CALL p4z_micro_init     !  microzooplankton
+         CALL p4z_meso_init      !  mesozooplankton
+      ELSE
+         CALL p5z_mort_init      !  phytoplankton mortality 
+         CALL p5z_micro_init     !  microzooplankton
+         CALL p5z_meso_init      !  mesozooplankton
+      ENDIF
+      CALL p4z_lys_init          !  calcite saturation
+      IF( .NOT.l_co2cpl ) &
+        & CALL p4z_flx_init      !  gas exchange 
+
+      ndayflxtr = 0
+
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done'
+      IF(lwp) WRITE(numout,*) 
+      !
+   END SUBROUTINE p4z_ini
+
+   SUBROUTINE p2z_ini
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE p2z_ini ***
+      !!
+      !! ** Purpose :   Initialisation of the LOBSTER biochemical model
+      !!----------------------------------------------------------------------
+      !
+      USE p2zopt
+      USE p2zexp
+      USE p2zbio
+      USE p2zsed
+      !
+      INTEGER  ::  ji, jj, jk, jn, ierr
+      CHARACTER(len = 10)  ::  cltra
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' p2z_ini :   LOBSTER biochemical model initialisation'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      ierr =        sms_pisces_alloc()          
+      ierr = ierr + p2z_exp_alloc()
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'p2z_ini: unable to allocate LOBSTER arrays' )
+
+      DO jn = 1, jptra
+        cltra = ctrcnm(jn) 
+        IF( cltra == 'DET' )   jpdet = jn       !: detritus                    [mmoleN/m3]
+        IF( cltra == 'ZOO' )   jpzoo = jn       !: zooplancton concentration   [mmoleN/m3]
+        IF( cltra == 'PHY' )   jpphy = jn       !: phytoplancton concentration [mmoleN/m3]
+        IF( cltra == 'NO3' )   jpno3 = jn       !: nitrate concentration       [mmoleN/m3]
+        IF( cltra == 'NH4' )   jpnh4 = jn       !: ammonium concentration      [mmoleN/m3]
+        IF( cltra == 'DOM' )   jpdom = jn       !: dissolved organic matter    [mmoleN/m3]
+      ENDDO
+
+      jpkb = 10        !  last level where depth less than 200 m
+      DO jk = jpkm1, 1, -1
+         IF( gdept_1d(jk) > 200. ) jpkb = jk 
+      END DO
+      IF (lwp) WRITE(numout,*)
+      IF (lwp) WRITE(numout,*) ' first vertical layers where biology is active (200m depth ) ', jpkb
+      IF (lwp) WRITE(numout,*)
+      jpkbm1 = jpkb - 1
+      !
+
+
+      ! LOBSTER initialisation for GYRE : init NO3=f(density) by asklod AS Kremeur 2005-07
+      ! ----------------------
+      IF( .NOT. ln_rsttr ) THEN             ! in case of  no restart 
+         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(:,:,:)
+         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:)
+         ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:)
+         END WHERE                       
+      ENDIF
+      !                       !  Namelist read
+      CALL p2z_opt_init       !  Optics parameters
+      CALL p2z_sed_init       !  sedimentation
+      CALL p2z_bio_init       !  biology
+      CALL p2z_exp_init       !  export 
+      !
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done'
+      IF(lwp) WRITE(numout,*) 
+      !
+   END SUBROUTINE p2z_ini
+
+   !!======================================================================
+END MODULE trcini_pisces
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90	(revision 8732)
@@ -0,0 +1,99 @@
+MODULE trcnam_pisces
+   !!======================================================================
+   !!                      ***  MODULE trcnam_pisces  ***
+   !! 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
+   !!----------------------------------------------------------------------
+   !! 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 trdtrc_oce
+   USE iom             ! 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
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER :: jl, jn
+      INTEGER :: ios, ioptio                 ! Local integer output status for namelist read
+      CHARACTER(LEN=20)   ::   clname
+      !!
+      NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      clname = 'namelist_pisces'
+
+      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelist'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL ctl_opn( numnatp_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      !
+
+      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables
+      READ  ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp )
+
+      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables
+      READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampismod )
+
+     IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Flag to use LOBSTER model            ln_p2z    = ', ln_p2z
+         WRITE(numout,*) ' Flag to use PISCES standard  model   ln_p4z    = ', ln_p4z
+         WRITE(numout,*) ' Flag to use PISCES quota     model   ln_p5z    = ', ln_p5z
+         WRITE(numout,*) ' Flag to ligand                       ln_ligand = ', ln_ligand
+         WRITE(numout,*) ' '
+      ENDIF
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         IF( ln_p5z    )  WRITE(numout,*) '  PISCES QUOTA model is used'
+         IF( ln_p4z    )  WRITE(numout,*) '  PISCES STANDARD model is used'
+         IF( ln_p2z    )  WRITE(numout,*) '  LOBSTER model is used'
+         IF( ln_ligand )  WRITE(numout,*) '  Compute remineralization/dissolution of organic ligands'
+         WRITE(numout,*) ' '
+      ENDIF
+    
+      ioptio = 0
+      IF( ln_p2z )    ioptio = ioptio + 1
+      IF( ln_p4z )    ioptio = ioptio + 1
+      IF( ln_p5z )    ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE PISCES model namelist nampismod' )
+       !
+   END SUBROUTINE trc_nam_pisces
+
+   !!======================================================================
+END MODULE trcnam_pisces
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90	(revision 8732)
@@ -0,0 +1,55 @@
+MODULE trcsms_pisces
+   !!======================================================================
+   !!                         ***  MODULE trcsms_pisces  ***
+   !! TOP :   PISCES Source Minus Sink manager
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!----------------------------------------------------------------------
+   !!   trcsms_pisces        :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   USE par_pisces
+   USE sms_pisces
+   USE p4zsms
+   USE p2zsms
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_pisces    ! called in trcsms.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_ini_pisces ***
+      !!
+      !! ** Purpose :   Initialisation of the PISCES biochemical model
+      !!----------------------------------------------------------------------
+
+
+   SUBROUTINE trc_sms_pisces( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_pisces  ***
+      !!
+      !! ** Purpose :   Managment of the call to Biological sources and sinks 
+      !!                routines of PISCES or LOBSTER bio-model
+      !!
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!---------------------------------------------------------------------
+      !
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES
+      ELSE                           ;   CALL p2z_sms( kt )   !  LOBSTER
+      ENDIF
+
+      !
+   END SUBROUTINE trc_sms_pisces
+
+   !!======================================================================
+END MODULE trcsms_pisces 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 8732)
@@ -0,0 +1,103 @@
+MODULE trcwri_pisces
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    PISCES :   Output of PISCES tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput 
+   !!----------------------------------------------------------------------
+   !! trc_wri_pisces   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE trc         ! passive tracers common variables 
+   USE sms_pisces  ! PISCES variables
+   USE iom         ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_pisces 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcnam.F90 5836 2015-10-26 14:49:40Z cetlod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_wri_pisces
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)           :: cltra
+      REAL(wp)                     :: zfact
+      INTEGER                      :: ji, jj, jk, jn
+      REAL(wp), DIMENSION(jpi,jpj) :: zdic, zo2min, zdepo2min
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      IF( ln_p2z ) THEN
+         DO jn = jp_pcs0, jp_pcs1
+            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+            CALL iom_put( cltra, trn(:,:,:,jn) )
+         END DO
+      ELSE
+         DO jn = jp_pcs0, jp_pcs1
+            zfact = 1.0e+6 
+            IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6 
+            IF( jn == jppo4  )                 zfact = po4r * 1.0e+6
+            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+            IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact )
+         END DO
+
+         IF( iom_use( "INTDIC" ) ) THEN                     !   DIC content in kg/m2
+            zdic(:,:) = 0.
+            DO jk = 1, jpkm1
+               zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.
+            ENDDO
+            CALL iom_put( 'INTDIC', zdic )     
+         ENDIF
+         !
+         IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth 
+            zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1)
+            zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1)
+            DO jk = 2, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( tmask(ji,jj,jk) == 1 ) then
+                        IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then
+                           zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy)
+                           zdepo2min(ji,jj) = gdepw_n(ji,jj,jk)
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+            !
+            CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration
+            CALL iom_put('ZO2MIN', zdepo2min  )                              ! depth of oxygen minimum concentration
+             !
+         ENDIF
+     ENDIF
+      !
+   END SUBROUTINE trc_wri_pisces
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri_pisces
+CONTAINS
+   SUBROUTINE trc_wri_pisces                     ! Empty routine  
+   END SUBROUTINE trc_wri_pisces
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcwri_pisces.F90 3160 2011-11-20 14:27:18Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri_pisces
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 8732)
@@ -0,0 +1,269 @@
+MODULE trcadv
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv  ***
+   !! Ocean passive tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  2005-11  (G. Madec)  Original code
+   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers
+   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes 
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv       : compute ocean tracer advection trend
+   !!   trc_adv_ini   : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc        ! ocean dynamics and active tracers
+   USE trc            ! ocean passive tracers variables
+   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
+   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
+   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
+   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
+   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
+   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine)
+   USE ldftra         ! lateral diffusion coefficient on tracers
+   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
+   !
+   USE prtctl_trc     ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_adv       
+   PUBLIC   trc_adv_ini  
+
+   !                            !!* Namelist namtrc_adv *
+   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag
+   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
+   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag
+   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
+   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping
+   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag
+   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
+   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag
+   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
+   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag
+
+   !                                        ! choices of advection scheme:
+   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping
+   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme
+   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme
+
+   INTEGER ::              nadv             ! chosen advection scheme
+   !
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.7 , NEMO Consortium (2015)
+   !! $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   ! dummy loop index
+      CHARACTER (len=22) ::   charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_adv')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !                                               !==  effective transport  ==!
+      IF( l_offline ) THEN
+         zun(:,:,:) = un(:,:,:)     ! effective transport already in un/vn/wn
+         zvn(:,:,:) = vn(:,:,:)
+         zwn(:,:,:) = wn(:,:,:)
+      ELSE
+         !       
+         DO jk = 1, jpkm1
+            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport
+            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
+            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
+         END DO
+         !
+         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections
+            zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
+            zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
+         ENDIF
+         !
+         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
+            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport
+         !
+         IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport
+         !
+         zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom
+         zvn(:,:,jpk) = 0._wp
+         zwn(:,:,jpk) = 0._wp
+         !
+      ENDIF
+      !
+      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+      !
+      CASE ( np_CEN )                                    ! Centered : 2nd / 4th order
+         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v )
+      CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order
+         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
+      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
+         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts )
+      CASE ( np_MUS )                                    ! MUSCL
+         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
+      CASE ( np_UBS )                                    ! UBS
+         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   )
+      CASE ( np_QCK )                                    ! QUICKEST
+         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     )
+      !
+      END SELECT
+      !                  
+      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging)
+         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
+      !
+   END SUBROUTINE trc_adv
+
+
+   SUBROUTINE trc_adv_ini
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ini  ***
+      !!                
+      !! ** Purpose : Control the consistency between namelist options for 
+      !!              passive tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN
+         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT
+         &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL
+         &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS
+         &                 ln_trcadv_qck                                        ! QCK
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )              !  namtrc_adv in reference namelist 
+      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist
+      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
+         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct
+         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
+         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts
+         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus
+         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
+         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs
+         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
+         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck
+      ENDIF
+      !
+
+      ioptio = 0                       !==  Parameter control  ==!
+      IF( ln_trcadv_cen )   ioptio = ioptio + 1
+      IF( ln_trcadv_fct )   ioptio = ioptio + 1
+      IF( ln_trcadv_mus )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck )   ioptio = ioptio + 1
+
+      !
+      IF( ioptio == 0 ) THEN
+         nadv = np_NO_adv
+         CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' )
+      ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
+      !
+      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &
+                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &
+                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN
+         IF( nn_fct_h == 4 ) THEN
+            nn_fct_h = 2
+            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
+         ENDIF
+         IF( .NOT.ln_linssh ) THEN
+            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
+         ENDIF
+         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )
+      ENDIF
+      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN
+        CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' )
+      ENDIF
+      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
+         CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
+      ENDIF
+      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
+         IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF
+            & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
+      ENDIF
+      !
+      !                                !==  used advection scheme  ==!
+      !                                      ! set nadv
+      IF( ln_trcadv_cen                      )   nadv = np_CEN
+      IF( ln_trcadv_fct                      )   nadv = np_FCT
+      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts
+      IF( ln_trcadv_mus                      )   nadv = np_MUS
+      IF( ln_trcadv_ubs                      )   nadv = np_UBS
+      IF( ln_trcadv_qck                      )   nadv = np_QCK
+      !
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection'
+         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
+            &                                                                        ' Vertical   order: ', nn_cen_v
+         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
+            &                                                                       ' Vertical   order: ', nn_fct_v
+         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'
+         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used'
+         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used'
+         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ini
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 8732)
@@ -0,0 +1,111 @@
+MODULE trcbbl
+  !!======================================================================
+   !!                       ***  MODULE  trcbbl  ***
+   !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary 
+   !!                                  layer scheme
+   !!======================================================================
+   !!==============================================================================
+   !! 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_trabbl 
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl                      diffusive or/and adevective bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!    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 trabbl              ! 
+   USE prtctl_trc          ! Print control for debbuging
+   USE trd_oce
+   USE trdtra
+
+   PUBLIC   trc_bbl       !  routine called by step.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE trc_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.
+      !!
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_bbl')
+      !
+      IF( .NOT. l_offline .AND. nn_dttrc == 1 ) THEN
+         CALL bbl( kt, nittrc000, '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( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      !* 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
+
+      !* 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
+
+      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_bbl, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends
+      ENDIF
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('trc_bbl')
+      !
+   END SUBROUTINE trc_bbl
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_bbl( kt )              ! Empty routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl
+#endif
+
+   !!======================================================================
+END MODULE trcbbl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 8732)
@@ -0,0 +1,393 @@
+MODULE trcdmp
+   !!======================================================================
+   !!                       ***  MODULE  trcdmp  ***
+   !! Ocean physics: internal restoring trend on 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 
+   !!----------------------------------------------------------------------
+   !!   trc_dmp      : update the tracer trend with the internal damping
+   !!   trc_dmp_init : initialization, namlist read, parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE trcdta
+   USE tradmp
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdtra
+   USE trd_oce
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_dmp      
+   PUBLIC trc_dmp_clo   
+   PUBLIC trc_dmp_alloc  
+   PUBLIC trc_dmp_ini    
+
+   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer
+   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
+
+   INTEGER, PARAMETER           ::   npncts   = 8        ! number of closed sea
+   INTEGER, DIMENSION(npncts)   ::   nctsi1, nctsj1      ! south-west closed sea limits (i,j)
+   INTEGER, DIMENSION(npncts)   ::   nctsi2, nctsj2      ! north-east closed sea limits (i,j)
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_dmp_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dmp_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc )
+      !
+      IF( trc_dmp_alloc /= 0 )   CALL ctl_warn('trc_dmp_alloc: failed to allocate array')
+      !
+   END FUNCTION trc_dmp_alloc
+
+
+   SUBROUTINE trc_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dmp  ***
+      !!                  
+      !! ** Purpose :   Compute the passive tracer trend due to a newtonian damping
+      !!      of the tracer field towards given data field and add it to the
+      !!      general tracer trends.
+      !!
+      !! ** Method  :   Newtonian damping towards trdta computed 
+      !!      and add to the general tracer trends:
+      !!                     trn = tra + restotr * (trdta - trb)
+      !!         The trend is computed either throughout the water column
+      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or
+      !!      below the well mixed layer (nlmdmptr=2)
+      !!
+      !! ** Action  : - update the tracer trends tra with the newtonian 
+      !!                damping trends.
+      !!              - save the trends ('key_trdmxl_trc')
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices
+      CHARACTER (len=22) ::   charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dmp')
+      !
+      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends
+      !
+      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
+         !
+         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation
+         !                                                          ! ===========
+         DO jn = 1, jptra                                           ! tracer loop
+            !                                                       ! ===========
+            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends 
+            !
+            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
+               !
+               jl = n_trc_index(jn) 
+               CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
+               !
+               SELECT CASE ( nn_zdmp_tr )
+               !
+               CASE( 0 )                !==  newtonian damping throughout the water column  ==!
+                  DO jk = 1, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
+                        END DO
+                     END DO
+                  END DO
+                  !
+               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
+                  DO jk = 1, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN 
+                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
+                           ENDIF
+                        END DO
+                     END DO
+                  END DO
+                  !
+               CASE ( 2 )               !==  no damping in the mixed layer   ==! 
+                  DO jk = 1, jpkm1
+                     DO jj = 2, jpjm1
+                        DO ji = fs_2, fs_jpim1   ! vector opt.
+                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
+                           END IF
+                        END DO
+                     END DO
+                  END DO
+                  !  
+               END SELECT
+               ! 
+            ENDIF
+            !
+            IF( l_trdtrc ) THEN
+               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
+               CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd )
+            END IF
+            !                                                       ! ===========
+         END DO                                                     ! tracer loop
+         !                                                          ! ===========
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
+      ENDIF
+      !
+      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd )
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl ) THEN
+         WRITE(charout, FMT="('dmp ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp')
+      !
+   END SUBROUTINE trc_dmp
+
+
+   SUBROUTINE trc_dmp_ini
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_ini  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameters
+      !!              called by trc_dmp at the first timestep (nittrc000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ios, imask  ! local integers
+      !!
+      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_ini')
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping
+      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909)
+909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping
+      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910)
+910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_dmp )
+
+      IF(lwp) THEN                       ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
+         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
+         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr
+      ENDIF
+      !                          ! Allocate arrays
+      IF( trc_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' )
+      !
+      SELECT CASE ( nn_zdmp_tr )
+      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
+      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
+      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
+      CASE DEFAULT
+         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
+         CALL ctl_stop(ctmp1)
+      END SELECT
+
+      IF( .NOT.lk_c1d ) THEN
+         IF( .NOT. ln_tradmp )   &
+            &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' )
+         !
+         !                          ! Read damping coefficients from file
+         !Read in mask from file
+         CALL iom_open ( cn_resto_tr, imask)
+         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr)
+         CALL iom_close( imask )
+         !
+      ENDIF
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
+      !
+   END SUBROUTINE trc_dmp_ini
+
+
+   SUBROUTINE trc_dmp_clo( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_clo  ***
+      !!
+      !! ** Purpose :   Closed sea domain initialization
+      !!
+      !! ** Method  :   if a closed sea is located only in a model grid point
+      !!                we restore to initial data
+      !!
+      !! ** Action  :   nctsi1(), nctsj1() : south-west closed sea limits (i,j)
+      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !
+      INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa
+      INTEGER :: isrow                                      ! local index
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace
+
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         ! initial values
+         nctsi1(:) = 1  ;  nctsi2(:) = 1
+         nctsj1(:) = 1  ;  nctsj2(:) = 1
+
+         ! set the closed seas (in data domain indices)
+         ! -------------------
+
+         IF( cn_cfg == "orca" ) THEN
+            !
+            SELECT CASE ( nn_cfg )
+            !                                           ! =======================
+            CASE ( 1 )                                  ! eORCA_R1 configuration
+            !                                           ! =======================
+            isrow = 332 - jpjglo
+            !
+                                                        ! Caspian Sea
+            nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow
+            nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow
+            !                                           ! Lake Superior
+            nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow
+            nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow
+            !                                           ! Lake Michigan
+            nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow
+            nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow
+            !                                           ! Lake Huron
+            nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow
+            nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow
+            !                                           ! Lake Erie
+            nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow
+            nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow
+            !                                           ! Lake Ontario
+            nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow
+            nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow
+            !                                           ! Victoria Lake
+            nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow
+            nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow
+            !                                           ! Baltic Sea
+            nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow
+            nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow
+            !                                        
+            !                                           ! =======================
+            CASE ( 2 )                                  !  ORCA_R2 configuration
+               !                                        ! =======================
+               !                                            ! Caspian Sea
+               nctsi1(1)   =  11  ;  nctsj1(1)   = 103
+               nctsi2(1)   =  17  ;  nctsj2(1)   = 112
+               !                                            ! Great North American Lakes
+               nctsi1(2)   =  97  ;  nctsj1(2)   = 107
+               nctsi2(2)   = 103  ;  nctsj2(2)   = 111
+               !                                            ! Black Sea 1 : west part of the Black Sea
+               nctsi1(3)   = 174  ;  nctsj1(3)   = 107
+               nctsi2(3)   = 181  ;  nctsj2(3)   = 112
+              !                                            ! Black Sea 2 : est part of the Black Sea
+               nctsi1(4)   =   2  ;  nctsj1(4)   = 107
+               nctsi2(4)   =   6  ;  nctsj2(4)   = 112
+               !                                            ! Baltic Sea
+               nctsi1(5)   =  145 ;  nctsj1(5)   = 116
+               nctsi2(5)   =  150 ;  nctsj2(5)   = 126
+               !                                        ! =======================
+            CASE ( 4 )                                  !  ORCA_R4 configuration
+               !                                        ! =======================
+               !                                            ! Caspian Sea
+               nctsi1(1)   =  4  ;  nctsj1(1)   = 53
+               nctsi2(1)   =  4  ;  nctsj2(1)   = 56
+               !                                            ! Great North American Lakes
+               nctsi1(2)   = 49  ;  nctsj1(2)   = 55
+               nctsi2(2)   = 51  ;  nctsj2(2)   = 56
+               !                                            ! Black Sea
+               nctsi1(3)   = 88  ;  nctsj1(3)   = 55
+               nctsi2(3)   = 91  ;  nctsj2(3)   = 56
+               !                                            ! Baltic Sea
+               nctsi1(4)   = 75  ;  nctsj1(4)   = 59
+               nctsi2(4)   = 76  ;  nctsj2(4)   = 61
+               !                                        ! =======================
+            CASE ( 025 )                                ! ORCA_R025 configuration
+               !                                        ! =======================
+                                                     ! Caspian + Aral sea
+               nctsi1(1)   = 1330 ; nctsj1(1)   = 645
+               nctsi2(1)   = 1400 ; nctsj2(1)   = 795
+               !                                        ! Azov Sea
+               nctsi1(2)   = 1284 ; nctsj1(2)   = 722
+               nctsi2(2)   = 1304 ; nctsj2(2)   = 747
+               !
+            END SELECT
+            !
+         ENDIF
+         !
+
+         ! convert the position in local domain indices
+         ! --------------------------------------------
+         DO jc = 1, npncts
+            nctsi1(jc)   = mi0( nctsi1(jc) )
+            nctsj1(jc)   = mj0( nctsj1(jc) )
+
+            nctsi2(jc)   = mi1( nctsi2(jc) )
+            nctsj2(jc)   = mj1( nctsj2(jc) )
+         END DO
+         !
+      ENDIF
+
+      ! Restore close seas values to initial data
+      IF( ln_trcdta .AND. nb_trcdta > 0 )  THEN   ! Initialisation of tracer from a file that may also be used for damping
+         !
+         IF(lwp)  WRITE(numout,*)
+         IF(lwp)  WRITE(numout,*) ' trc_dmp_clo : Restoring of nutrients on close seas at time-step kt = ', kt
+         IF(lwp)  WRITE(numout,*)
+         !
+         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )   ! Memory allocation
+         !
+         DO jn = 1, jptra
+            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
+                jl = n_trc_index(jn)
+                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000
+                DO jc = 1, npncts
+                   DO jk = 1, jpkm1
+                      DO jj = nctsj1(jc), nctsj2(jc)
+                         DO ji = nctsi1(jc), nctsi2(jc)
+                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk)
+                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                         ENDDO
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ENDIF
+          ENDDO
+          CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
+      ENDIF
+      !
+   END SUBROUTINE trc_dmp_clo
+
+ 
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_dmp( kt )        ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_dmp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_dmp
+#endif
+
+   !!======================================================================
+END MODULE trcdmp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 8732)
@@ -0,0 +1,292 @@
+MODULE trcldf
+   !!======================================================================
+   !!                       ***  MODULE  trcldf  ***
+   !! Ocean Passive tracers : lateral diffusive trends
+   !!=====================================================================
+   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
+   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ldf       : update the tracer trend with the lateral diffusion
+   !!   trc_ldf_ini   : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE trc            ! ocean passive tracers variables
+   USE oce_trc        ! ocean dynamics and active tracers
+   USE ldfslp         ! lateral diffusion: iso-neutral slope
+   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine)
+   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine)
+   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine)
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers
+   !
+   USE prtctl_trc     ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ldf    
+   PUBLIC   trc_ldf_ini   
+   !
+   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_lev       !: iso-level   direction
+   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal  direction (rotation to geopotential)
+   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction (standard)
+   LOGICAL , PUBLIC ::   ln_trcldf_triad     !: iso-neutral direction (triad)
+   REAL(wp), PUBLIC ::   rn_ahtrc_0          !:   laplacian diffusivity coefficient for passive tracer [m2/s]
+   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s]
+   REAL(wp), PUBLIC ::   rn_fact_lap         !: Enhanced zonal diffusivity coefficent in the equatorial domain
+   !
+   !                      !!: ** lateral mixing namelist (nam_trcldf) **
+   REAL(wp) ::  rldf       ! ratio between active and passive tracers diffusive coefficient
+   
+   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.7 , NEMO Consortium (2014)
+   !! $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            :: ji, jj, jk, jn
+      REAL(wp)           :: zdep
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zahu, zahv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_ldf')
+      !
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi,jpj,jpk,jptra,   ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+      !                                  !* set the lateral diffusivity coef. for passive tracer      
+      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv )
+      zahu(:,:,:) = rldf * ahtu(:,:,:) 
+      zahv(:,:,:) = rldf * ahtv(:,:,:)
+      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain
+      DO jk= 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( gdept_n(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
+                  zdep = MAX( gdept_n(ji,jj,jk) - 1000., 0. ) / 1000.
+                  zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend
+      !
+      CASE ( np_lap   )                               ! iso-level laplacian
+         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   )
+         !
+      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   )
+         !
+      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   )
+         !
+      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral)
+         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf )
+         !
+      END SELECT
+      !
+      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
+      ENDIF
+      !                
+      IF( ln_ctl ) THEN                        ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('ldf ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zahu, zahv )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
+      !
+   END SUBROUTINE trc_ldf
+
+
+   SUBROUTINE trc_ldf_ini
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ctl  ***
+      !!
+      !! ** Purpose :   Define the operator for the lateral diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr   ! temporary integers
+      INTEGER ::   ios            ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  &
+         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  &
+         &                 rn_ahtrc_0   , rn_bhtrc_0, rn_fact_lap  
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )             !  namtrc_ldf in reference namelist 
+      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp )
+      !
+      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist 
+      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_ldf )
+      !
+      IF(lwp) THEN                     ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '      operator'
+         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap
+         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp
+         WRITE(numout,*) '      direction of action'
+         WRITE(numout,*) '         iso-level                   ln_trcldf_lev   = ', ln_trcldf_lev
+         WRITE(numout,*) '         horizontal (geopotential)   ln_trcldf_hor   = ', ln_trcldf_hor
+         WRITE(numout,*) '         iso-neutral (standard)      ln_trcldf_iso   = ', ln_trcldf_iso
+         WRITE(numout,*) '         iso-neutral (triad)         ln_trcldf_triad = ', ln_trcldf_triad
+         WRITE(numout,*) '      diffusivity coefficient'
+         WRITE(numout,*) '           laplacian                 rn_ahtrc_0      = ', rn_ahtrc_0
+         WRITE(numout,*) '         bilaplacian                 rn_bhtrc_0      = ', rn_bhtrc_0
+         WRITE(numout,*) '      enhanced zonal diffusivity     rn_fact_lap     = ', rn_fact_lap
+
+      ENDIF
+      !      
+      !                                ! control the namelist parameters
+      ioptio = 0
+      IF( ln_trcldf_lap )   ioptio = ioptio + 1
+      IF( ln_trcldf_blp )   ioptio = ioptio + 1
+      IF( ioptio >  1   )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0   )   nldf = np_no_ldf   ! No lateral diffusion
+      
+      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' )
+      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' )
+      !
+      ioptio = 0
+      IF( ln_trcldf_lev )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso )   ioptio = ioptio + 1
+      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' )
+      !
+      ! defined the type of lateral diffusion from ln_trcldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==!
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate with partial step
+            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker....
+            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         !                                ! diffusivity ratio: passive / active tracers 
+         IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN
+            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN
+               rldf = 1.0_wp
+            ELSE
+               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )
+            ENDIF
+         ELSE
+            rldf = rn_ahtrc_0 / rn_aht_0
+         ENDIF
+      ENDIF
+      !
+      IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==!
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate with partial step
+            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker....
+            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation)
+            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation)
+         ENDIF
+         !                                ! diffusivity ratio: passive / active tracers 
+         IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN
+            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN
+               rldf = 1.0_wp
+            ELSE
+               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' )
+            ENDIF
+         ELSE
+            rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  )
+         ENDIF
+      ENDIF
+      !
+      IF( ierr == 1 )   CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' )
+      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required 
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         SELECT CASE( nldf )
+         CASE( np_no_ldf )   ;   WRITE(numout,*) '          NO lateral diffusion'
+         CASE( np_lap    )   ;   WRITE(numout,*) '          laplacian iso-level operator'
+         CASE( np_lap_i  )   ;   WRITE(numout,*) '          Rotated laplacian operator (standard)'
+         CASE( np_lap_it )   ;   WRITE(numout,*) '          Rotated laplacian operator (triad)'
+         CASE( np_blp    )   ;   WRITE(numout,*) '          bilaplacian iso-level operator'
+         CASE( np_blp_i  )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (standard)'
+         CASE( np_blp_it )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (triad)'
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE trc_ldf_ini
+#else
+   !!----------------------------------------------------------------------
+   !!   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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 8732)
@@ -0,0 +1,241 @@
+MODULE trcnxt
+   !!======================================================================
+   !!                       ***  MODULE  trcnxt  ***
+   !! Ocean passive tracers:  time stepping on passives 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
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nxt     : time stepping on passive tracers
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and tracers variables
+   USE trc             ! ocean passive tracers variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl_trc      ! Print control for debbuging
+   USE trd_oce
+   USE trdtra
+   USE tranxt
+   USE bdy_oce   , ONLY: ln_bdy
+   USE trcbdy          ! BDY open boundaries
+# if defined key_agrif
+   USE agrif_top_interp
+# endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nxt          ! routine called by step.F90
+
+   REAL(wp) ::   rfact1, rfact2
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_nxt( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trcnxt  ***
+      !!
+      !! ** Purpose :   Compute the passive tracers fields at the 
+      !!      next time-step from their temporal trends and swap the fields.
+      !! 
+      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through 
+      !!      call to lbc_lnk routine
+      !!   default:
+      !!      arrays swap
+      !!         (trn) = (tra) ; (tra) = (0,0)
+      !!         (trb) = (trn) 
+      !!
+      !!   For Arakawa or TVD Scheme : 
+      !!      A Asselin time filter applied on now tracers (trn) to avoid
+      !!      the divergence of two consecutive time-steps and tr arrays
+      !!      to prepare the next time_step:
+      !!         (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]
+      !!         (trn) = (tra) ; (tra) = (0,0)
+      !!
+      !!
+      !! ** Action  : - update trb, trn
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+      !
+      INTEGER  ::   jk, jn   ! dummy loop indices
+      REAL(wp) ::   zfact            ! temporary scalar
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrdt 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_nxt')
+      !
+      IF( kt == nittrc000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
+      ENDIF
+      !
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
+      DO jn = 1, jptra                 ! Update after tracer on domain lateral boundaries
+         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
+      END DO
+
+      IF( ln_bdy )  CALL trc_bdy( kt )
+
+      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )
+         ztrdt(:,:,:,:)  = trn(:,:,:,:)
+      ENDIF
+      !                                ! Leap-Frog + Asselin filter time stepping
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN    ! Euler time-stepping at first time-step (only swap)
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               trn(:,:,jk,jn) = tra(:,:,jk,jn)
+            END DO
+         END DO
+      ELSE     
+         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping
+            IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh
+            ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
+              &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh
+            ENDIF
+         ELSE
+                                       CALL trc_nxt_off( kt )       ! offline 
+         ENDIF
+         !
+         DO jn = 1, jptra
+            CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp ) 
+            CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp )
+            CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp )
+         END DO
+      ENDIF
+      !
+      IF( l_trdtrc ) THEN              ! trends: send Asselin filter trends to trdtra manager for further diagnostics
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               zfact = 1._wp / r2dttrc  
+               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
+               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )
+            END DO
+         END DO
+         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt ) 
+      END IF
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('nxt')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_nxt')
+      !
+   END SUBROUTINE trc_nxt
+
+
+   SUBROUTINE trc_nxt_off( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_vvl  ***
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !!                and swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!              - save in (ta,sa) a thickness weighted average over the three 
+      !!             time levels which will be used to compute rdn and thus the semi-
+      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
+      !!              - swap tracer fields to prepare the next time_step.
+      !!                This can be summurized for tempearture as:
+      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
+      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
+      !!             ztm = 0                                                       otherwise
+      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
+      !!             tn  = ta 
+      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )   ::  kt       ! ocean time-step index
+      !!     
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nittrc000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_nxt_off : time stepping'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         IF( .NOT. ln_linssh ) THEN
+            rfact1 = atfp * rdttrc
+            rfact2 = rfact1 / rau0
+         ENDIF
+        !  
+      ENDIF
+      !
+      DO jn = 1, jptra      
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze3t_b = e3t_b(ji,jj,jk)
+                  ze3t_n = e3t_n(ji,jj,jk)
+                  ze3t_a = e3t_a(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = trb(ji,jj,jk,jn) * ze3t_b
+                  ztc_n  = trn(ji,jj,jk,jn) * ze3t_n
+                  ztc_a  = tra(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( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level 
+                     ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   ) 
+                     ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) )
+                  ENDIF
+
+                  ze3t_f = 1.e0 / ze3t_f
+                  trb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                  trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)     ! ptn <-- pta
+                  !
+               END DO
+            END DO
+         END DO
+         ! 
+      END DO
+      !
+   END SUBROUTINE trc_nxt_off
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nxt( kt )  
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_nxt: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_nxt
+#endif
+   !!======================================================================
+END MODULE trcnxt
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 8732)
@@ -0,0 +1,243 @@
+MODULE trcrad
+   !!======================================================================
+   !!                       ***  MODULE  trcrad  ***
+   !! Ocean passive tracers:  correction of negative concentrations
+   !!======================================================================
+   !! History :   -   !  01-01  (O. Aumont & E. Kestenare)  Original code
+   !!            1.0  !  04-03  (C. Ethe)  free form F90
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_rad    : correction of negative concentrations
+   !!----------------------------------------------------------------------
+   USE oce_trc             ! ocean dynamics and tracers variables
+   USE trc                 ! ocean passive tracers variables
+   USE trd_oce
+   USE trdtra
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_rad     
+   PUBLIC trc_rad_ini  
+
+   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE trc_rad( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_rad  ***
+      !!
+      !! ** Purpose :   "crappy" routine to correct artificial negative
+      !!              concentrations due to isopycnal scheme
+      !!
+      !! ** Method  : - PISCES or LOBSTER: Set negative concentrations to zero
+      !!                while computing the corresponding tracer content that
+      !!                is added to the tracers. Then, adjust the tracer 
+      !!                concentration using a multiplicative factor so that 
+      !!                the total tracer concentration is preserved.
+      !!              - CFC: simply set to zero the negative CFC concentration
+      !!                (the total CFC content is not strictly preserved)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index      
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_rad')
+      !
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations '
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      IF( ln_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age               )  !  AGE
+      IF( ll_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1               )  !  CFC model
+      IF( ln_c14     )   CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14               )  !  C14
+      IF( ln_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model
+      IF( ln_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1               )  !  MY_TRC model
+
+      !
+      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rad')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_rad')
+      !
+   END SUBROUTINE trc_rad
+
+   SUBROUTINE trc_rad_ini
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc _rad_ini ***
+      !!
+      !! ** Purpose : read  namelist options 
+      !!----------------------------------------------------------------------
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      NAMELIST/namtrc_rad/ ln_trcrad
+      !!----------------------------------------------------------------------
+
+      !
+      REWIND( numnat_ref )              ! namtrc_rad in reference namelist 
+      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907)
+907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist 
+      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 )
+908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_rad )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
+         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
+      ENDIF
+      !
+   END SUBROUTINE trc_rad_ini
+
+   SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv )
+      !!-----------------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_rad_sms  ***
+      !!
+      !! ** Purpose :   "crappy" routine to correct artificial negative
+      !!              concentrations due to isopycnal scheme
+      !!
+      !! ** Method  : 2 cases :
+      !!                - Set negative concentrations to zero while computing
+      !!                  the corresponding tracer content that is added to the
+      !!                  tracers. Then, adjust the tracer concentration using
+      !!                  a multiplicative factor so that the total tracer 
+      !!                  concentration is preserved.
+      !!                - simply set to zero the negative CFC concentration
+      !!                  (the total content of concentration is not strictly preserved)
+      !!--------------------------------------------------------------------------------
+      !! Arguments
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      INTEGER  , INTENT( in ) ::  &
+         jp_sms0, &       !: First index of the passive tracer model
+         jp_sms1          !: Last  index of  the passive tracer model
+
+      REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT( inout )  :: &
+         ptrb, ptrn       !: before and now traceur concentration
+
+      CHARACTER( len = 1) , INTENT(in), OPTIONAL  :: &
+         cpreserv          !: flag to preserve content or not
+      
+      ! Local declarations
+      INTEGER  :: ji, jj, jk, jn     ! dummy loop indices
+      REAL(wp) :: ztrcorb, ztrmasb   ! temporary scalars
+      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         "
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays
+      REAL(wp) :: zs2rdt
+      LOGICAL ::   lldebug = .FALSE.
+      !!----------------------------------------------------------------------
+
+ 
+      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn )
+      
+      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved 
+      
+         DO jn = jp_sms0, jp_sms1
+            !                                                        ! ===========
+            ztrcorb = 0.e0   ;   ztrmasb = 0.e0
+            ztrcorn = 0.e0   ;   ztrmasn = 0.e0
+
+            IF( l_trdtrc ) THEN
+               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation
+               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation
+            ENDIF
+            !                                                         ! sum over the global domain 
+            ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) )
+            ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) )
+
+            ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) )
+            ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) )
+
+            IF( ztrcorb /= 0 ) THEN
+               zcoef = 1. + ztrcorb / ztrmasb
+               DO jk = 1, jpkm1
+                  ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) )
+                  ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk)
+               END DO
+            ENDIF
+
+            IF( ztrcorn /= 0 ) THEN
+               zcoef = 1. + ztrcorn / ztrmasn
+               DO jk = 1, jpkm1
+                  ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) )
+                  ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk)
+               END DO
+            ENDIF
+            !
+            IF( l_trdtrc ) THEN
+               !
+               zs2rdt = 1. / ( 2. * rdt )
+               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
+               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
+               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling
+              !
+            ENDIF
+
+         END DO
+         !
+         !
+      ELSE  ! total CFC content is not strictly preserved
+
+         DO jn = jp_sms0, jp_sms1  
+
+           IF( l_trdtrc ) THEN
+              ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation
+              ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation
+           ENDIF
+
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) )
+                     ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) )
+                  END DO
+               END DO
+            END DO
+         
+            IF( l_trdtrc ) THEN
+               !
+               zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) )
+               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
+               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
+               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling
+              !
+            ENDIF
+            !
+         ENDDO
+
+      ENDIF
+
+      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn )
+
+   END SUBROUTINE trc_rad_sms
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                         NO TOP model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rad( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_rad: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_rad
+#endif
+   
+   !!======================================================================
+END MODULE trcrad
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 8732)
@@ -0,0 +1,211 @@
+MODULE trcsbc
+   !!==============================================================================
+   !!                       ***  MODULE  trcsbc  ***
+   !! Ocean passive tracers:  surface boundary condition
+   !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_sbc      : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean  passive tracers variables
+   USE prtctl_trc      ! Print control for debbuging
+   USE iom
+   USE trd_oce
+   USE trdtra
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sbc   ! routine called by step.F90
+
+   !! * Substitutions
+#  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_sbc ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sbc  ***
+      !!                   
+      !! ** Purpose :   Compute the tracer surface boundary condition trend of
+      !!      (concentration/dilution effect) and add it to the general 
+      !!       trend of tracer equations.
+      !!
+      !! ** Method :
+      !!      * concentration/dilution effect:
+      !!            The surface freshwater flux modify the ocean volume
+      !!         and thus the concentration of a tracer as :
+      !!            tra = tra + emp * trn / e3t   for k=1
+      !!         where emp, the surface freshwater budget (evaporation minus
+      !!         precipitation ) given in kg/m2/s is divided
+      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s.
+      !!
+      !! ** Action  : - Update the 1st level of tra with the trend associated
+      !!                with the tracer surface boundary condition 
+      !!
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices
+      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars
+      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sbc')
+      !
+      ! Allocate temporary workspace
+                      CALL wrk_alloc( jpi,jpj,       zsfx   )
+      IF( l_trdtrc )  CALL wrk_alloc( jpi,jpj,jpk,   ztrtrd )
+      !
+      zrtrn = 1.e-15_wp
+
+      SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option
+         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only
+         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                
+      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure
+      END SELECT
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+
+         IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.   &                     ! Restart: read in restart  file
+            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
+            zfact = 0.5_wp
+            DO jn = 1, jptra
+               CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc
+            END DO
+         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+           zfact = 1._wp
+           sbc_trc_b(:,:,:) = 0._wp
+         ENDIF
+      ELSE                                         ! Swap of forcing fields
+         IF( ln_top_euler ) THEN
+            zfact = 1._wp
+            sbc_trc_b(:,:,:) = 0._wp
+         ELSE
+            zfact = 0.5_wp
+            sbc_trc_b(:,:,:) = sbc_trc(:,:,:)
+         ENDIF
+         !
+      ENDIF
+
+      ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div 
+      ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice
+      ! Coupling offline : runoff are in emp which contains E-P-R
+      !
+      IF( .NOT.ln_linssh ) THEN  ! online coupling with vvl
+         zsfx(:,:) = 0._wp
+      ELSE                                      ! online coupling free surface or offline with free surface
+         zsfx(:,:) = emp(:,:)
+      ENDIF
+
+      ! 0. initialization
+      DO jn = 1, jptra
+         !
+         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
+
+         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice)
+
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn)
+               END DO
+            END DO
+
+         ELSE
+
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zse3t = 1. / e3t_n(ji,jj,1)
+                  ! tracer flux at the ice/ocean interface (tracer/m2/s)
+                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting,
+                                                               ! only used in the levitating sea ice case
+                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux
+                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange)
+   
+                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 
+                  IF ( zdtra < 0. ) THEN
+                     zratio = -zdtra * zse3t * r2dttrc / ( trn(ji,jj,1,jn) + zrtrn )
+                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise
+                  ENDIF
+                  sbc_trc(ji,jj,jn) =  zdtra 
+               END DO
+            END DO
+         ENDIF
+         !
+         CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. )
+         !                                       Concentration dilution effect on tracers due to evaporation & precipitation 
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zse3t = zfact / e3t_n(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
+            END DO
+         END DO
+         !
+         IF( l_trdtrc ) THEN
+            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
+            CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd )
+         END IF
+         !                                                       ! ===========
+      END DO                                                     ! tracer loop
+      !                                                          ! ===========
+
+      !                                           Write in the tracer restar  file
+      !                                          *******************************
+      IF( lrst_trc .AND. .NOT.ln_top_euler ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         DO jn = 1, jptra
+            CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) )
+         END DO
+      ENDIF
+      !
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+                      CALL wrk_dealloc( jpi,jpj,       zsfx   )
+      IF( l_trdtrc )  CALL wrk_dealloc( jpi,jpj,jpk,   ztrtrd )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc')
+      !
+   END SUBROUTINE trc_sbc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      NO passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sbc (kt)              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_sbc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sbc
+#endif
+   
+   !!======================================================================
+END MODULE trcsbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 8732)
@@ -0,0 +1,114 @@
+MODULE trctrp
+   !!======================================================================
+   !!                       ***  MODULE trctrp  ***
+   !! Ocean Physics    : manage the passive tracer transport
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (C. Ethe) Original code
+   !!             3.3  !  2010-07 (C. Ethe) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_trp        : passive tracer transport
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers variables
+   USE trc             ! ocean passive tracers variables 
+   USE trabbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trcdmp          ! internal damping                    (trc_dmp 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 trcsbc          ! surface boundary condition          (trc_sbc routine)
+   USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
+   USE bdy_oce   , ONLY: ln_bdy
+   USE trcbdy          ! BDY open boundaries
+
+#if defined key_agrif
+   USE agrif_top_sponge ! tracers sponges
+   USE agrif_top_update ! tracers updates
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_trp    ! called by trc_stp
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_trp( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_trp  ***
+      !!                      
+      !! ** Purpose :   Management of passive tracers transport
+      !! 
+      !! ** Method  : - Compute the passive tracers trends 
+      !!              - Update the passive tracers
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
+      !! ---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_trp')
+      !
+      IF( .NOT. lk_c1d ) THEN
+         !
+                                CALL trc_sbc    ( kt )      ! surface boundary condition
+         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends
+         IF( ln_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends
+                                CALL trc_adv    ( kt )      ! horizontal & vertical advection 
+         !                                                         ! Partial top/bottom cell: GRADh( trb )  
+         IF( ln_zps ) THEN
+           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom
+           ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom
+           ENDIF
+         ENDIF
+         !                                                      
+                                CALL trc_ldf    ( kt )      ! lateral mixing
+#if defined key_agrif
+         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge
+#endif
+                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields
+                                CALL trc_nxt    ( kt )      ! tracer fields at next time step     
+         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations
+         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only
+
+#if defined key_agrif
+         IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only
+#endif
+         !
+      ELSE                                               ! 1D vertical configuration
+                                CALL trc_sbc( kt )            ! surface boundary condition
+         IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends
+                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kt )            ! tracer fields at next time step     
+          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations
+         !
+      END IF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_trp')
+      !
+   END SUBROUTINE trc_trp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        No TOP models
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_trp( kt )              ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_trp
+#endif
+   
+   !!======================================================================
+END MODULE trctrp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 8732)
@@ -0,0 +1,162 @@
+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_zdf      : update the tracer trend with the lateral diffusion
+   !!   trc_zdf_ini  : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE trc           ! ocean passive tracers variables
+   USE oce_trc       ! ocean dynamics and active tracers
+   USE trd_oce       ! trends: ocean variables
+   USE trazdf_exp    ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp    ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trcldf        ! passive tracers: lateral diffusion
+   USE trdtra        ! trends manager: tracers 
+   USE prtctl_trc    ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_zdf         ! called by step.F90 
+   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90 
+   
+   !                                        !!** Vertical diffusion (nam_trczdf) **
+   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping)
+
+   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
+      !                                ! defined from ln_zdf...  namlist logicals)
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.7 , NEMO Consortium (2015)
+   !! $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), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_zdf')
+      !
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dttrc, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
+      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc,                trb, tra, jptra )    !   implicit scheme          
+      END SELECT
+
+      IF( l_trdtrc )   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) ) / r2dttrc ) - ztrtrd(:,:,jk,jn)
+            END DO
+            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )
+         END DO
+         CALL wrk_dealloc( jpi, jpj, jpk, jptra, 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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_zdf')
+      !
+   END SUBROUTINE trc_zdf
+
+
+   SUBROUTINE trc_zdf_ini
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE trc_zdf_ini  ***
+      !!
+      !! ** 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 vertical mixing scheme
+      !!----------------------------------------------------------------------
+      INTEGER ::  ios                 ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnat_ref )             ! namtrc_zdf in reference namelist 
+      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp )
+      !
+      REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist 
+      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_zdf )
+      !
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters'
+         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
+         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
+      ENDIF
+
+      !                                ! Define the vertical tracer physics scheme
+      IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme
+      ELSE                       ;   nzdf = 1     ! implicit scheme
+      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 
+                                         nzdf = 1      ! TKE or GLS physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )  & 
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE trc_zdf_ini
+   
+#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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90	(revision 8732)
@@ -0,0 +1,1012 @@
+MODULE trdmxl_trc
+   !!======================================================================
+   !!                       ***  MODULE  trdmxl_trc  ***
+   !! Ocean diagnostics:  mixed layer passive tracer trends 
+   !!======================================================================
+   !! History :  9.0  !  06-08  (C. Deltel)  Original code (from trdmxl.F90)
+   !!                 !  07-04  (C. Deltel)  Bug fix : add trcrad trends
+   !!                 !  07-06  (C. Deltel)  key_gyre : do not call lbc_lnk
+   !!----------------------------------------------------------------------
+#if   defined key_top   &&   defined key_trdmxl_trc
+   !!----------------------------------------------------------------------
+   !!   'key_trdmxl_trc'                      mixed layer trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_mxl_trc      : passive tracer cumulated trends averaged over ML
+   !!   trd_mxl_trc_zint : passive tracer trends vertical integration
+   !!   trd_mxl_trc_init : initialization step
+   !!----------------------------------------------------------------------
+   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE trc_oce, ONLY :   nn_dttrc  ! frequency of step on passive tracers
+   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 trdtrc_oce    ! definition of main arrays used for trends computations
+   USE in_out_manager    ! I/O manager
+   USE dianam            ! build the name of file (routine)
+   USE ldfslp            ! iso-neutral slopes 
+   USE ioipsl            ! NetCDF library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! MPP library
+   USE trdmxl_trc_rst    ! restart for diagnosing the ML trends
+   USE prtctl            ! print control
+   USE sms_pisces        ! PISCES bio-model
+   USE wrk_nemo          ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trd_mxl_trc
+   PUBLIC trd_mxl_trc_alloc
+   PUBLIC trd_mxl_trc_init
+   PUBLIC trd_mxl_trc_zint
+
+   CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file
+   INTEGER ::   nmoymltrd
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1, nidtrd, nh_t
+   INTEGER ::   ndimtrd1                        
+   INTEGER, SAVE ::  ionce, icount
+   LOGICAL :: llwarn  = .TRUE.                                    ! this should always be .TRUE.
+   LOGICAL :: lldebug = .TRUE.
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   !
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_mxl_trc_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_trc_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      &
+         &      ndextrd1(jpi*jpj), nidtrd(jptra), nh_t(jptra),  STAT=trd_mxl_trc_alloc)
+         !
+      IF( lk_mpp                )   CALL mpp_sum ( trd_mxl_trc_alloc )
+      IF( trd_mxl_trc_alloc /=0 )   CALL ctl_warn('trd_mxl_trc_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trd_mxl_trc_alloc
+
+
+   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_trc_zint  ***
+      !! 
+      !! ** Purpose :   Compute the vertical average of the 3D fields given as arguments 
+      !!                to the subroutine. This vertical average is performed from ocean
+      !!                surface down to a chosen control surface.
+      !!
+      !! ** Method/usage :
+      !!      The control surface can be either a mixed layer depth (time varying)
+      !!      or a fixed surface (jk level or bowl). 
+      !!      Choose control surface with nctls_trc in namelist NAMTRD :
+      !!        nctls_trc = -2  : use isopycnal surface
+      !!        nctls_trc = -1  : use euphotic layer with light criterion 
+      !!        nctls_trc =  0  : use mixed layer with density criterion 
+      !!        nctls_trc =  1  : read index from file 'ctlsurf_idx'
+      !!        nctls_trc >  1  : use fixed level surface jk = nctls_trc
+      !!      Note: in the remainder of the routine, the volume between the 
+      !!            surface and the control surface is called "mixed-layer"
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank
+      CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmxl ! passive tracer trend
+      !
+      INTEGER ::   ji, jj, jk, isum
+      REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zvlmsk )
+
+      ! I. Definition of control surface and integration weights
+      ! --------------------------------------------------------
+
+      ONCE_PER_TIME_STEP : IF( icount == 1 ) THEN
+         !
+         tmltrd_trc(:,:,:,:) = 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 ( nn_ctls_trc )                                ! choice of the control surface
+            CASE ( -2  )   ;   STOP 'trdmxl_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: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 )
+                               nmld_trc(:,:) = nn_ctls_trc + 1      !     -> model level
+         END SELECT
+
+         ! ... Compute ndextrd1 and ndimtrd1  ??? role de jpktrd_trc
+         IF( ionce == 1 ) THEN
+            !
+            isum  = 0   ;   zvlmsk(:,:) = 0.e0
+
+            IF( jpktrd_trc < jpk ) THEN                           ! description ???
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN
+                        zvlmsk(ji,jj) = tmask(ji,jj,1)
+                     ELSE
+                        isum = isum + 1
+                        zvlmsk(ji,jj) = 0.e0
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+
+            IF( isum > 0 ) THEN                                   ! index of ocean points (2D only)
+               WRITE(numout,*)' tmltrd_trc : Number of invalid points nmld_trc > jpktrd', isum 
+               CALL wheneq( jpi*jpj, zvlmsk(:,:) , 1, 1., ndextrd1, ndimtrd1 )
+            ELSE 
+               CALL wheneq( jpi*jpj, tmask(:,:,1), 1, 1., ndextrd1, ndimtrd1 )
+            ENDIF                                
+
+            ionce = 0                                             ! no more pass here
+            !
+         ENDIF   ! ionce == 1
+         
+         ! ... Weights for vertical averaging
+         wkx_trc(:,:,:) = 0.e0
+         DO jk = 1, jpktrd_trc                                    ! initialize wkx_trc with vertical scale factor in mixed-layer
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         
+         rmld_trc(:,:) = 0.e0
+         DO jk = 1, jpktrd_trc                                    ! compute mixed-layer depth : rmld_trc
+            rmld_trc(:,:) = rmld_trc(:,:) + wkx_trc(:,:,jk)
+         END DO
+         
+         DO jk = 1, jpktrd_trc                                    ! compute integration weights
+            wkx_trc(:,:,jk) = wkx_trc(:,:,jk) / MAX( 1., rmld_trc(:,:) )
+         END DO
+
+         icount = 0                                               ! <<< flag = off : control surface & integr. weights
+         !                                                        !     computed only once per time step
+      ENDIF ONCE_PER_TIME_STEP
+
+      ! II. Vertical integration of trends in the mixed-layer
+      ! -----------------------------------------------------
+
+      SELECT CASE ( ctype )
+         CASE ( '3D' )                                            ! mean passive tracer trends in the mixed-layer
+            DO jk = 1, jpktrd_trc
+               tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmxl(:,:,jk) * wkx_trc(:,:,jk)   
+            END DO
+         CASE ( '2D' )                                            ! forcing at upper boundary of the mixed-layer 
+            tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmxl(:,:,1) * wkx_trc(:,:,1)  ! non penetrative
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, zvlmsk )
+      !
+   END SUBROUTINE trd_mxl_trc_zint
+
+
+   SUBROUTINE trd_mxl_trc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_trc  ***
+      !! 
+      !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis
+      !!               period, and write NetCDF outputs.
+      !!
+      !! ** Method/usage :
+      !!          The stored trends can be chosen twofold (according to the ln_trdmxl_trc_instant 
+      !!          logical namelist variable) :
+      !!          1) to explain the difference between initial and final 
+      !!             mixed-layer T & S (where initial and final relate to the
+      !!             current analysis window, defined by ntrc_trc in the namelist)
+      !!          2) to explain the difference between the current and previous 
+      !!             TIME-AVERAGED mixed-layer T & S (where time-averaging is
+      !!             performed over each analysis window).
+      !!
+      !! ** Consistency check : 
+      !!        If the control surface is fixed ( nctls_trc > 1 ), the residual term (dh/dt
+      !!        entrainment) should be zero, at machine accuracy. Note that in the case
+      !!        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, rn_ucf_trc=1., nctls_trc=8
+      !!             for checking residuals.
+      !!             On a NEC-SX5 computer, this typically leads to:
+      !!                   O(1.e-20) temp. residuals (tml_res) when ln_trdmxl_trc_instant=.false.
+      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmxl_trc_instant=.true.
+      !!
+      !! ** Action :
+      !!       At each time step, mixed-layer averaged trends are stored in the 
+      !!       tmltrd(:,:,jpmxl_xxx) array (see trdmxl_oce.F90 for definitions of jpmxl_xxx).
+      !!       This array is known when trd_mld is called, at the end of the stp subroutine, 
+      !!       except for the purely vertical K_z diffusion term, which is embedded in the
+      !!       lateral diffusion trend.
+      !!
+      !!       In I), this K_z term is diagnosed and stored, thus its contribution is removed
+      !!       from the lateral diffusion trend.
+      !!       In II), the instantaneous mixed-layer T & S are computed, and misc. cumulative
+      !!       arrays are updated.
+      !!       In III), called only once per analysis window, we compute the total trends,
+      !!       along with the residuals and the Asselin correction terms.
+      !!       In IV), the appropriate trends are written in the trends NetCDF file.
+      !!
+      !! References :
+      !!       - Vialard & al.
+      !!       - See NEMO documentation (in preparation)
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn
+      REAL(wp) ::   zavt, zfn, zfn2
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot             ! d(trc)/dt over the anlysis window (incl. Asselin)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres             ! residual = dh/dt entrainment term
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf             ! for storage only
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad             ! for storage only (for trb<0 corr in trcrad)
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot2            ! -+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres2            !  | working arrays to diagnose the trends
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltrdm2           !  | associated with the time meaned ML
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf2            !  | passive tracers
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad2            !  | (-> for trb<0 corr in trcrad)
+      !
+      CHARACTER (LEN=10) ::   clvar
+      !!----------------------------------------------------------------------
+
+      ! Set-up pointers into sub-arrays of workspaces
+      CALL wrk_alloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad             )
+      CALL wrk_alloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 )
+
+      IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " )
+
+      ! ======================================================================
+      ! I. Diagnose the purely vertical (K_z) diffusion trend
+      ! ======================================================================
+
+      ! ... These terms can be estimated by flux computation at the lower boundary of the ML 
+      !     (we compute (-1/h) * K_z * d_z( tracer ))
+
+      IF( ln_trcldf_iso ) THEN
+         !
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ik = nmld_trc(ji,jj)
+               zavt = fsavs(ji,jj,ik)
+               DO jn = 1, jptra
+                  IF( ln_trdtrc(jn) )    &
+                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  &
+                       &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            &
+                       &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1)
+               END DO
+            END DO
+         END DO
+
+         DO jn = 1, jptra
+            ! ... Remove this K_z trend from the iso-neutral diffusion term (if any)
+            IF( ln_trdtrc(jn) ) &
+                 tmltrd_trc(:,:,jpmxl_trc_ldf,jn) = tmltrd_trc(:,:,jpmxl_trc_ldf,jn) - tmltrd_trc(:,:,jpmxl_trc_zdf,jn)
+   
+         END DO
+         !      
+      ENDIF
+
+!!gm Test removed, nothing specific to a configuration should survive out of usrdef modules
+!!gm      IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration
+!!gm      ! GYRE : for diagnostic fields, are needed if cyclic B.C. are present, but not for purely MPI comm. 
+!!gm      ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.)
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN
+               DO jl = 1, jpltrd_trc
+                  CALL lbc_lnk( tmltrd_trc(:,:,jl,jn), 'T', 1. )        ! lateral boundary conditions
+               END DO
+            ENDIF
+         END DO
+!!gm      ENDIF
+      
+      ! ======================================================================
+      ! II. Cumulate the trends over the analysis window
+      ! ======================================================================
+
+      ztmltrd2(:,:,:,:) = 0.e0   ;   ztmltot2(:,:,:)   = 0.e0     ! <<< reset arrays to zero
+      ztmlres2(:,:,:)   = 0.e0   ;   ztmlatf2(:,:,:)   = 0.e0
+      ztmlrad2(:,:,:)   = 0.e0
+
+      ! II.1 Set before values of vertically averages passive tracers
+      ! -------------------------------------------------------------
+      IF( kt > nittrc000 ) THEN
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN
+               tmlb_trc   (:,:,jn) = tml_trc   (:,:,jn)
+               tmlatfn_trc(:,:,jn) = tmltrd_trc(:,:,jpmxl_trc_atf,jn)
+               tmlradn_trc(:,:,jn) = tmltrd_trc(:,:,jpmxl_trc_radb,jn)
+            ENDIF
+         END DO
+      ENDIF
+
+      ! II.2 Vertically averaged passive tracers
+      ! ----------------------------------------
+      tml_trc(:,:,:) = 0.e0
+      DO jk = 1, jpktrd_trc ! - 1 ???
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) &
+               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn)
+         END DO
+      END DO
+
+      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window    
+      ! ------------------------------------------------------------------------
+      IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ???
+         !
+         DO jn = 1, jptra
+            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)
+               
+               tmltrd_csum_ub_trc (:,:,:,jn) = 0.e0   ;   tmltrd_atf_sumb_trc  (:,:,jn) = 0.e0
+               tmltrd_rad_sumb_trc  (:,:,jn) = 0.e0
+            ENDIF
+         END DO
+         
+         rmldbn_trc(:,:) = rmld_trc(:,:)
+         !
+      ENDIF
+
+      ! II.4 Cumulated trends over the analysis period
+      ! ----------------------------------------------
+      !
+      !         [  1rst analysis window ] [     2nd analysis window     ]                       
+      !
+      !     o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps
+      !                            ntrd                             2*ntrd       etc.
+      !     1      2     3     4    =5 e.g.                          =10
+      !
+      IF( ( kt >= 2 ).OR.( ln_rsttr ) ) THEN                        ! ???
+         !
+         nmoymltrd = nmoymltrd + 1
+
+
+         ! ... Cumulate over BOTH physical contributions AND over time steps
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN
+               DO jl = 1, jpltrd_trc
+                  tmltrdm_trc(:,:,jn) = tmltrdm_trc(:,:,jn) + tmltrd_trc(:,:,jl,jn)
+               END DO
+            ENDIF
+         END DO
+
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN
+               ! ... Special handling of the Asselin trend 
+               tmlatfm_trc(:,:,jn) = tmlatfm_trc(:,:,jn) + tmlatfn_trc(:,:,jn)
+               tmlradm_trc(:,:,jn) = tmlradm_trc(:,:,jn) + tmlradn_trc(:,:,jn)
+
+               ! ... Trends associated with the time mean of the ML passive tracers
+               tmltrd_sum_trc    (:,:,:,jn) = tmltrd_sum_trc    (:,:,:,jn) + tmltrd_trc    (:,:,:,jn)
+               tmltrd_csum_ln_trc(:,:,:,jn) = tmltrd_csum_ln_trc(:,:,:,jn) + tmltrd_sum_trc(:,:,:,jn)
+               tml_sum_trc       (:,:,jn)   = tml_sum_trc       (:,:,jn)   + tml_trc       (:,:,jn)
+            ENDIF
+         ENDDO
+
+         rmld_sum_trc      (:,:)     = rmld_sum_trc      (:,:)     + rmld_trc      (:,:)
+         !
+      ENDIF
+
+      ! ======================================================================
+      ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD)
+      ! ======================================================================
+
+      ! Convert to appropriate physical units
+      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc
+
+      itmod = kt - nittrc000 + 1
+      it    = kt
+
+      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
+         ztmlres (:,:,:) = 0.e0
+         ztmltot2(:,:,:) = 0.e0
+         ztmlres2(:,:,:) = 0.e0
+      
+         zfn  = FLOAT( nmoymltrd )    ;    zfn2 = zfn * zfn
+         
+         ! III.1 Prepare fields for output ("instantaneous" diagnostics) 
+         ! -------------------------------------------------------------
+
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN
+               !-- Compute total trends    (use rdttrc instead of rdt ???)
+               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
+                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rdt)
+               ENDIF
+               
+               !-- Compute residuals
+               ztmlres(:,:,jn) = ztmltot(:,:,jn) - ( tmltrdm_trc(:,:,jn) - tmlatfn_trc(:,:,jn) + tmlatfb_trc(:,:,jn) &
+                  &                                                 - tmlradn_trc(:,:,jn) + tmlradb_trc(:,:,jn)  )
+               
+               !-- Diagnose Asselin trend over the analysis window 
+               ztmlatf(:,:,jn) = tmlatfm_trc(:,:,jn) - tmlatfn_trc(:,:,jn) + tmlatfb_trc(:,:,jn)
+               ztmlrad(:,:,jn) = tmlradm_trc(:,:,jn) - tmlradn_trc(:,:,jn) + tmlradb_trc(:,:,jn)
+               
+         !-- Lateral boundary conditions
+               IF ( cn_cfg .NE. 'gyre' ) THEN
+                  CALL lbc_lnk( ztmltot(:,:,jn) , 'T', 1. )   ;   CALL lbc_lnk( ztmlres(:,:,jn) , 'T', 1. )
+                  CALL lbc_lnk( ztmlatf(:,:,jn) , 'T', 1. )   ;   CALL lbc_lnk( ztmlrad(:,:,jn) , 'T', 1. )
+               ENDIF
+
+
+#if defined key_diainstant
+               STOP 'tmltrd_trc : key_diainstant was never checked within trdmxl. Comment this to proceed.'
+#endif
+            ENDIF
+         END DO
+
+         ! III.2 Prepare fields for output ("mean" diagnostics) 
+         ! ----------------------------------------------------
+         
+         !-- Update the ML depth time sum (to build the Leap-Frog time mean)
+         rmld_sum_trc(:,:) = rmldbn_trc(:,:) + 2 * ( rmld_sum_trc(:,:) - rmld_trc(:,:) ) + rmld_trc(:,:)
+
+               !-- Compute passive tracer total trends
+         DO jn = 1, jptra
+            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
+            ENDIF
+         END DO
+
+         !-- Compute passive tracer residuals
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN
+               !
+               DO jl = 1, jpltrd_trc
+                  ztmltrd2(:,:,jl,jn) = tmltrd_csum_ub_trc(:,:,jl,jn) + tmltrd_csum_ln_trc(:,:,jl,jn)
+               END DO
+               
+               ztmltrdm2(:,:,jn) = 0.e0
+               DO jl = 1, jpltrd_trc
+                  ztmltrdm2(:,:,jn) = ztmltrdm2(:,:,jn) + ztmltrd2(:,:,jl,jn)
+               END DO
+               
+               ztmlres2(:,:,jn) =  ztmltot2(:,:,jn)  -       &
+                  & ( ztmltrdm2(:,:,jn) - tmltrd_sum_trc(:,:,jpmxl_trc_atf ,jn) + tmltrd_atf_sumb_trc(:,:,jn) &
+                  &                     - tmltrd_sum_trc(:,:,jpmxl_trc_radb,jn) + tmltrd_rad_sumb_trc(:,:,jn) )
+               !
+
+               !-- Diagnose Asselin trend over the analysis window
+               ztmlatf2(:,:,jn) = ztmltrd2(:,:,jpmxl_trc_atf ,jn) - tmltrd_sum_trc(:,:,jpmxl_trc_atf ,jn) &
+                  &                                               + tmltrd_atf_sumb_trc(:,:,jn)
+               ztmlrad2(:,:,jn) = ztmltrd2(:,:,jpmxl_trc_radb,jn) - tmltrd_sum_trc(:,:,jpmxl_trc_radb,jn) &
+                  &                                               + tmltrd_rad_sumb_trc(:,:,jn)
+
+         !-- Lateral boundary conditions 
+               IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration    
+                  CALL lbc_lnk( ztmltot2(:,:,jn), 'T', 1. )
+                  CALL lbc_lnk( ztmlres2(:,:,jn), 'T', 1. )
+                  DO jl = 1, jpltrd_trc
+                     CALL lbc_lnk( ztmltrd2(:,:,jl,jn), 'T', 1. )       ! will be output in the NetCDF trends file
+                  END DO
+               ENDIF
+
+            ENDIF
+         END DO
+
+         ! * Debugging information *
+         IF( lldebug ) THEN
+            !
+            WRITE(numout,*) 'trd_mxl_trc : write trends in the Mixed Layer for debugging process:'
+            WRITE(numout,*) '~~~~~~~~~~~  '
+            WRITE(numout,*)
+            WRITE(numout,*) 'TRC kt = ', kt, '    nmoymltrd = ', nmoymltrd
+
+            DO jn = 1, jptra
+
+               IF( ln_trdtrc(jn) ) THEN
+                  WRITE(numout, *)
+                  WRITE(numout, *) '>>>>>>>>>>>>>>>>>>  TRC TRACER jn =', jn, ' <<<<<<<<<<<<<<<<<<'
+                  
+                  WRITE(numout, *)
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM ztmlres     : ', SUM2D(ztmlres(:,:,jn))
+                  !CD??? PREVOIR: z2d = ztmlres(:,:,jn)   ;   CALL prt_ctl(tab2d_1=z2d, clinfo1=' ztmlres   -   : ')
+                  
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM ABS(ztmlres): ', SUM2D(ABS(ztmlres(:,:,jn)))
+                  WRITE(numout, '(3x,a)') ' -->>>------------------- ztmlres is computed from ------------- '
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +ztmltot    : ', SUM2D(+ztmltot    (:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tmltrdm_trc: ', SUM2D(+tmltrdm_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM -tmlatfn_trc: ', SUM2D(-tmlatfn_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tmlatfb_trc: ', SUM2D(+tmlatfb_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM -tmlradn_trc: ', SUM2D(-tmlradn_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tmlradb_trc: ', SUM2D(+tmlradb_trc(:,:,jn))
+                  WRITE(numout, '(3x,a)') ' --<<<----------------------------------------------------------- '
+                  
+                  WRITE(numout, *)
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM ztmlres2    : ', SUM2D(ztmlres2(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM ABS(ztmlres2):', SUM2D(ABS(ztmlres2(:,:,jn)))
+                  WRITE(numout, '(3x,a)') ' -->>>------------------- ztmlres2 is computed from ------------ '
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +ztmltot2            : ', SUM2D(+ztmltot2(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +ztmltrdm2           : ', SUM2D(+ztmltrdm2(:,:,jn)) 
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM -tmltrd_sum_trc      : ', SUM2D(-tmltrd_sum_trc(:,:,jpmxl_trc_atf,jn)) 
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tmltrd_atf_sumb_trc : ', SUM2D(+tmltrd_atf_sumb_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM -tmltrd_sum_trc      : ', SUM2D(-tmltrd_sum_trc(:,:,jpmxl_trc_radb,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tmltrd_rad_sumb_trc : ', SUM2D(+tmltrd_rad_sumb_trc(:,:,jn) )
+                  WRITE(numout, '(3x,a)') ' --<<<----------------------------------------------------------- '
+                  
+                  WRITE(numout, *)
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM ztmltot     : ', SUM2D(ztmltot    (:,:,jn))
+                  WRITE(numout, '(3x,a)') ' -->>>------------------- ztmltot is computed from ------------- '
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tml_trc    : ', SUM2D(tml_trc    (:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM -tmlbn_trc  : ', SUM2D(tmlbn_trc  (:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM +tmlb_trc   : ', SUM2D(tmlb_trc   (:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM -tmlbb_trc  : ', SUM2D(tmlbb_trc  (:,:,jn))
+                  WRITE(numout, '(3x,a)') ' --<<<----------------------------------------------------------- '
+                  
+                  WRITE(numout, *)
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM tmltrdm_trc : ', SUM2D(tmltrdm_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM tmlatfb_trc : ', SUM2D(tmlatfb_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM tmlatfn_trc : ', SUM2D(tmlatfn_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM tmlradb_trc : ', SUM2D(tmlradb_trc(:,:,jn))
+                  WRITE(numout,98) 'TRC jn =', jn, ' SUM tmlradn_trc : ', SUM2D(tmlradn_trc(:,:,jn))
+                  
+                  WRITE(numout, *)
+                  DO jl = 1, jpltrd_trc
+                     WRITE(numout,97) 'TRC jn =', jn, ' TREND INDEX jpmxl_trc_xxx = ', jl, &
+                        & ' SUM tmltrd_trc : ', SUM2D(tmltrd_trc(:,:,jl,jn))
+                  END DO
+               
+                  WRITE(numout,*) 
+                  WRITE(numout,*) ' *********************** ZTMLRES, ZTMLRES2 *********************** '
+                  WRITE(numout,*)
+                  WRITE(numout,*) 'TRC ztmlres (jpi/2,jpj/2,:) : ', ztmlres (jpi/2,jpj/2,jn)
+                  WRITE(numout,*)
+                  WRITE(numout,*) 'TRC ztmlres2(jpi/2,jpj/2,:) : ', ztmlres2(jpi/2,jpj/2,jn)
+                  
+                  WRITE(numout,*) 
+                  WRITE(numout,*) ' *********************** ZTMLRES *********************** '
+                  WRITE(numout,*)
+                  
+                  WRITE(numout,*) '...................................................'
+                  WRITE(numout,*) 'TRC jn =', jn, ' ztmlres (1:10,1:5,jn) : '
+                  DO jj = 5, 1, -1
+                     WRITE(numout,99) jj, ( ztmlres (ji,jj,jn), ji=1,10 )
+                  END DO
+                  
+                  WRITE(numout,*) 
+                  WRITE(numout,*) ' *********************** ZTMLRES2 *********************** '
+                  WRITE(numout,*)
+                  
+                  WRITE(numout,*) '...................................................'
+                  WRITE(numout,*) 'TRC jn =', jn, ' ztmlres2 (1:10,1:5,jn) : '
+                  DO jj = 5, 1, -1
+                     WRITE(numout,99) jj, ( ztmlres2 (ji,jj,jn), ji=1,10 )
+                  END DO
+                  !
+               ENDIF
+               !
+            END DO
+
+
+97            FORMAT(a10, i3, 2x, a30, i3, a20, 2x, g20.10)
+98            FORMAT(a10, i3, 2x, a30, 2x, g20.10)
+99            FORMAT('TRC jj =', i3,' : ', 10(g10.3,2x))
+              WRITE(numout,*)
+            !
+         ENDIF
+
+         ! III.3 Time evolution array swap
+         ! -------------------------------
+         ! ML depth
+         rmldbn_trc(:,:)   = rmld_trc(:,:)
+         rmld_sum_trc(:,:)     = rmld_sum_trc(:,:)     /      (2*zfn)  ! similar to tml_sum and sml_sum
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) THEN        
+               ! For passive tracer instantaneous diagnostics
+               tmlbb_trc  (:,:,jn) = tmlb_trc   (:,:,jn)   ;   tmlbn_trc  (:,:,jn) = tml_trc    (:,:,jn)
+               tmlatfb_trc(:,:,jn) = tmlatfn_trc(:,:,jn)   ;   tmlradb_trc(:,:,jn) = tmlradn_trc(:,:,jn)
+               
+               ! For passive tracer mean diagnostics
+               tmltrd_csum_ub_trc (:,:,:,jn) = zfn * tmltrd_sum_trc(:,:,:,jn) - tmltrd_csum_ln_trc(:,:,:,jn)
+               tml_sumb_trc       (:,:,jn)   = tml_sum_trc(:,:,jn)
+               tmltrd_atf_sumb_trc(:,:,jn)   = tmltrd_sum_trc(:,:,jpmxl_trc_atf ,jn)
+               tmltrd_rad_sumb_trc(:,:,jn)   = tmltrd_sum_trc(:,:,jpmxl_trc_radb,jn)
+               
+               
+               ! III.4 Convert to appropriate physical units
+               ! -------------------------------------------
+               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)   * 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
+         !
+      ENDIF MODULO_NTRD
+
+      ! ======================================================================
+      ! IV. Write trends in the NetCDF file
+      ! ======================================================================
+
+      ! IV.1 Code for IOIPSL/NetCDF output
+      ! ----------------------------------
+
+      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) 'trd_mxl_trc : write passive tracer trends in the NetCDF file :'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+         WRITE(numout,*) '          ', trim(clhstnam), ' at kt = ', kt
+         WRITE(numout,*) '          N.B. nmoymltrd = ', nmoymltrd
+         WRITE(numout,*) ' '
+      ENDIF
+         
+      NETCDF_OUTPUT : IF( ln_trdmxl_trc_instant ) THEN            ! <<< write the trends for passive tracer instant. diags
+         !
+
+         DO jn = 1, jptra
+            !
+            IF( ln_trdtrc(jn) ) THEN
+               CALL histwrite( nidtrd(jn), "mxl_depth", it, rmld_trc(:,:), ndimtrd1, ndextrd1 )
+               !-- Output the fields
+               clvar = trim(ctrcnm(jn))//"ml"                        ! e.g. detml, zooml, nh4ml, etc.
+               CALL histwrite( nidtrd(jn), trim(clvar)         , it, tml_trc(:,:,jn), ndimtrd1, ndextrd1 ) 
+               CALL histwrite( nidtrd(jn), trim(clvar)//"_tot" , it, ztmltot(:,:,jn), ndimtrd1, ndextrd1 ) 
+               CALL histwrite( nidtrd(jn), trim(clvar)//"_res" , it, ztmlres(:,:,jn), ndimtrd1, ndextrd1 ) 
+           
+               DO jl = 1, jpltrd_trc - 2
+                  CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)),             &
+                    &          it, tmltrd_trc(:,:,jl,jn), ndimtrd1, ndextrd1 )
+               END DO
+
+               CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)),    &  ! now trcrad    : jpltrd_trc - 1
+                    &          it, ztmlrad(:,:,jn), ndimtrd1, ndextrd1 )
+
+               CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_atf,2)),     &  ! now Asselin   : jpltrd_trc
+                    &          it, ztmlatf(:,:,jn), ndimtrd1, ndextrd1 )
+                     
+            ENDIF
+         END DO
+
+         IF( kt == nitend ) THEN 
+            DO jn = 1, jptra
+               IF( ln_trdtrc(jn) )  CALL histclo( nidtrd(jn) )
+            END DO
+         ENDIF
+
+      ELSE                                                        ! <<< write the trends for passive tracer mean diagnostics
+         
+         DO jn = 1, jptra
+            !
+            IF( ln_trdtrc(jn) ) THEN
+               CALL histwrite( nidtrd(jn), "mxl_depth", it, rmld_sum_trc(:,:), ndimtrd1, ndextrd1 ) 
+               !-- Output the fields
+               clvar = trim(ctrcnm(jn))//"ml"                        ! e.g. detml, zooml, nh4ml, etc.
+
+               CALL histwrite( nidtrd(jn), trim(clvar)         , it, tml_sum_trc(:,:,jn), ndimtrd1, ndextrd1 )
+               CALL histwrite( nidtrd(jn), trim(clvar)//"_tot" , it,    ztmltot2(:,:,jn), ndimtrd1, ndextrd1 ) 
+               CALL histwrite( nidtrd(jn), trim(clvar)//"_res" , it,    ztmlres2(:,:,jn), ndimtrd1, ndextrd1 ) 
+
+               DO jl = 1, jpltrd_trc - 2
+                  CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)),           &
+                    &          it, ztmltrd2(:,:,jl,jn), ndimtrd1, ndextrd1 )
+               END DO
+            
+               CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)),   &  ! now trcrad    : jpltrd_trc - 1
+                 &          it, ztmlrad2(:,:,jn), ndimtrd1, ndextrd1 )
+
+               CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_atf,2)),    &  ! now Asselin   : jpltrd_trc
+                 &          it, ztmlatf2(:,:,jn), ndimtrd1, ndextrd1 )
+
+            ENDIF 
+            !
+         END DO
+         IF( kt == nitend ) THEN 
+            DO jn = 1, jptra
+               IF( ln_trdtrc(jn) )  CALL histclo( nidtrd(jn) )
+            END DO
+         ENDIF
+
+         !
+      ENDIF NETCDF_OUTPUT
+         
+      ! Compute the control surface (for next time step) : flag = on
+      icount = 1
+
+      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN
+         !
+         ! Reset cumulative arrays to zero
+         ! -------------------------------         
+         nmoymltrd = 0
+         tmltrdm_trc        (:,:,:)   = 0.e0   ;   tmlatfm_trc        (:,:,:)   = 0.e0
+         tmlradm_trc        (:,:,:)   = 0.e0   ;   tml_sum_trc        (:,:,:)   = 0.e0
+         tmltrd_csum_ln_trc (:,:,:,:) = 0.e0   ;   tmltrd_sum_trc     (:,:,:,:) = 0.e0
+         rmld_sum_trc       (:,:)     = 0.e0
+         !
+      ENDIF
+
+      ! ======================================================================
+      ! V. Write restart file
+      ! ======================================================================
+
+      IF( lrst_trc )   CALL trd_mxl_trc_rst_write( kt )  ! this must be after the array swap above (III.3)
+
+      CALL wrk_dealloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad             )
+      CALL wrk_dealloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 )
+      !
+   END SUBROUTINE trd_mxl_trc
+
+   REAL FUNCTION sum2d( ztab )
+      !!----------------------------------------------------------------------
+      !! CD ??? prevoir d'utiliser plutot prtctl
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::  ztab      
+      !!----------------------------------------------------------------------
+      sum2d = SUM( ztab(2:jpi-1,2:jpj-1) )
+   END FUNCTION sum2d
+
+
+   SUBROUTINE trd_mxl_trc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mxl_init  ***
+      !! 
+      !! ** Purpose :   computation of vertically integrated T and S budgets
+      !!      from ocean surface down to control surface (NetCDF output)
+      !!
+      !! ** Method/usage :
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: inum   ! logical unit
+      INTEGER :: ilseq, jl, jn, iiter
+      REAL(wp) ::   zjulian, zsto, zout
+      CHARACTER (LEN=40) ::   clop
+      CHARACTER (LEN=15) ::   csuff
+      CHARACTER (LEN=12) ::   clmxl
+      CHARACTER (LEN=16) ::   cltrcu
+      CHARACTER (LEN=10) ::   clvar
+
+      !!----------------------------------------------------------------------
+
+      ! ======================================================================
+      ! I. initialization
+      ! ======================================================================
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mxl_trc_init : Mixed-layer trends for passive tracers                '
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
+         WRITE(numout,*)
+      ENDIF
+
+      
+      ! I.1 Check consistency of user defined preferences
+      ! -------------------------------------------------
+
+      IF( ( lk_trdmxl_trc ) .AND. ( MOD( nitend-nittrc000+1, 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, 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.                        ' 
+         WRITE(numout,*) 
+         WRITE(numout,*) '                N.B. the nitend parameter is also constrained to be a     '
+         WRITE(numout,*) '                multiple of the sea-ice frequency parameter (typically 5) '
+         nstop = nstop + 1
+      ENDIF
+
+      ! * Debugging information *
+      IF( lldebug ) THEN
+         WRITE(numout,*) '               ln_trcadv_muscl = '      , ln_trcadv_muscl
+         WRITE(numout,*) '               ln_trdmxl_trc_instant = ', ln_trdmxl_trc_instant
+      ENDIF
+
+      IF( ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) .AND. .NOT. ln_trdmxl_trc_instant ) THEN
+         WRITE(numout,cform_err)
+         WRITE(numout,*) '                Currently, you can NOT use simultaneously tracer MUSCL    '
+         WRITE(numout,*) '                advection and window averaged diagnostics of ML trends.   '
+         WRITE(numout,*) '                WHY? Everything in trdmxl_trc is coded for leap-frog, and '
+         WRITE(numout,*) '                MUSCL scheme is Euler forward for passive tracers (note   '
+         WRITE(numout,*) '                that MUSCL is leap-frog for active tracers T/S).          '
+         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
+
+      ! I.2 Initialize arrays to zero or read a restart file
+      ! ----------------------------------------------------
+      nmoymltrd   = 0
+
+      rmld_trc           (:,:)     = 0.e0   ;   tml_trc            (:,:,:)   = 0.e0       ! inst.
+      tmltrdm_trc        (:,:,:)   = 0.e0   ;   tmlatfm_trc        (:,:,:)   = 0.e0
+      tmlradm_trc        (:,:,:)   = 0.e0
+
+      tml_sum_trc        (:,:,:)   = 0.e0   ;   tmltrd_sum_trc     (:,:,:,:) = 0.e0       ! mean
+      tmltrd_csum_ln_trc (:,:,:,:) = 0.e0   ;   rmld_sum_trc       (:,:)     = 0.e0
+
+      IF( ln_rsttr .AND. ln_trdmxl_trc_restart ) THEN
+         CALL trd_mxl_trc_rst_read
+      ELSE
+         tmlb_trc           (:,:,:)   = 0.e0   ;   tmlbb_trc          (:,:,:)   = 0.e0     ! inst.
+         tmlbn_trc          (:,:,:)   = 0.e0
+
+         tml_sumb_trc       (:,:,:)   = 0.e0   ;   tmltrd_csum_ub_trc (:,:,:,:) = 0.e0     ! mean
+         tmltrd_atf_sumb_trc(:,:,:)   = 0.e0   ;   tmltrd_rad_sumb_trc(:,:,:)   = 0.e0 
+
+       ENDIF
+
+      icount = 1   ;   ionce  = 1  ! open specifier   
+
+
+      ! I.3 Read control surface from file ctlsurf_idx
+      ! ----------------------------------------------
+      IF( nn_ctls_trc == 1 ) THEN
+         CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+         READ ( inum ) nbol_trc
+         CLOSE( inum )
+      ENDIF
+
+      ! ======================================================================
+      ! II. netCDF output initialization
+      ! ======================================================================
+
+      ! clmxl = legend root for netCDF output
+      IF( nn_ctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion
+         clmxl = 'Mixed Layer '
+      ELSE IF( nn_ctls_trc == 1 ) THEN                              ! control surface = read index from file 
+         clmxl = '      Bowl '
+      ELSE IF( nn_ctls_trc >= 2 ) THEN                              ! control surface = model level
+         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nn_ctls_trc
+      ENDIF
+
+      ! II.1 Define frequency of output and means
+      ! -----------------------------------------
+      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 cp time)
+      ENDIF
+#  if defined key_diainstant
+      IF( .NOT. ln_trdmxl_trc_instant ) THEN
+         STOP 'trd_mxl_trc : this was never checked. Comment this line to proceed...'
+      ENDIF
+      zsto = nn_trd_trc * rdt
+      clop = "inst("//TRIM(clop)//")"
+#  else
+      IF( ln_trdmxl_trc_instant ) THEN
+         zsto = rdt                                               ! inst. diags : we use IOIPSL time averaging
+      ELSE
+         zsto = nn_trd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging
+      ENDIF
+      clop = "ave("//TRIM(clop)//")"
+#  endif
+      zout = nn_trd_trc * rdt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      IF(lwp) WRITE (numout,*) '                netCDF initialization'
+
+      ! II.2 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
+      IF(lwp) WRITE(numout,*)' '  
+      IF(lwp) WRITE(numout,*)' Date 0 used :', nittrc000               &
+           &   ,' YEAR ', nyear, ' MONTH ', nmonth,' DAY ', nday       &
+           &   ,'Julian day : ', zjulian
+
+      ! II.3 Define the T grid trend file (nidtrd)
+      ! ------------------------------------------
+
+      !-- Define long and short names for the NetCDF output variables
+      !       ==> choose them according to trdmxl_trc_oce.F90 <==
+
+      ctrd_trc(jpmxl_trc_xad    ,1) = " Zonal advection"                 ;   ctrd_trc(jpmxl_trc_xad    ,2) = "_xad"
+      ctrd_trc(jpmxl_trc_yad    ,1) = " Meridional advection"            ;   ctrd_trc(jpmxl_trc_yad    ,2) = "_yad"
+      ctrd_trc(jpmxl_trc_zad    ,1) = " Vertical advection"              ;   ctrd_trc(jpmxl_trc_zad    ,2) = "_zad"
+      ctrd_trc(jpmxl_trc_ldf    ,1) = " Lateral diffusion"               ;   ctrd_trc(jpmxl_trc_ldf    ,2) = "_ldf"
+      ctrd_trc(jpmxl_trc_zdf    ,1) = " Vertical diff. (Kz)"             ;   ctrd_trc(jpmxl_trc_zdf    ,2) = "_zdf"
+      ctrd_trc(jpmxl_trc_bbl    ,1) = " Adv/diff. Bottom boundary layer" ;   ctrd_trc(jpmxl_trc_bbl    ,2) = "_bbl"
+      ctrd_trc(jpmxl_trc_dmp    ,1) = " Tracer damping"                  ;   ctrd_trc(jpmxl_trc_dmp    ,2) = "_dmp"
+      ctrd_trc(jpmxl_trc_sbc    ,1) = " Surface boundary cond."          ;   ctrd_trc(jpmxl_trc_sbc    ,2) = "_sbc"
+      ctrd_trc(jpmxl_trc_sms,    1) = " Sources minus sinks"             ;   ctrd_trc(jpmxl_trc_sms    ,2) = "_sms"
+      ctrd_trc(jpmxl_trc_radb   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmxl_trc_radb   ,2) = "_radb"
+      ctrd_trc(jpmxl_trc_radn   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmxl_trc_radn   ,2) = "_radn"
+      ctrd_trc(jpmxl_trc_atf    ,1) = " Asselin time filter"             ;   ctrd_trc(jpmxl_trc_atf    ,2) = "_atf"
+
+      DO jn = 1, jptra      
+      !-- Create a NetCDF file and enter the define mode 
+         IF( ln_trdtrc(jn) ) THEN
+            csuff="ML_"//ctrcnm(jn)
+            CALL dia_nam( clhstnam, nn_trd_trc, csuff )
+            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
+               &        1, jpi, 1, jpj, iiter, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )
+      
+            !-- Define the ML depth variable
+            CALL histdef(nidtrd(jn), "mxl_depth", clmxl//" Mixed Layer Depth", "m",                        &
+               &        jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+         ENDIF
+      END DO
+
+      !-- Define physical units
+      IF( rn_ucf_trc == 1. ) THEN
+         cltrcu = "(mmole-N/m3)/sec"                              ! all passive tracers have the same unit 
+      ELSEIF ( rn_ucf_trc == 3600.*24.) THEN                         ! ??? trop long : seulement (mmole-N/m3)
+         cltrcu = "(mmole-N/m3)/day"                              ! ??? apparait dans les sorties netcdf 
+      ELSE
+         cltrcu = "unknown?"
+      ENDIF
+
+      !-- Define miscellaneous passive tracer mixed-layer variables 
+      IF( jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb ) THEN
+         STOP 'Error : jpltrd_trc /= jpmxl_trc_atf .OR.  jpltrd_trc - 1 /= jpmxl_trc_radb'  ! see below
+      ENDIF
+
+      DO jn = 1, jptra
+         !
+         IF( ln_trdtrc(jn) ) THEN
+            clvar = trim(ctrcnm(jn))//"ml"                           ! e.g. detml, zooml, no3ml, etc.
+            CALL histdef(nidtrd(jn), trim(clvar),           clmxl//" "//trim(ctrcnm(jn))//" Mixed Layer ",                         &
+              & "mmole-N/m3", jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout )           
+            CALL histdef(nidtrd(jn), trim(clvar)//"_tot"  , clmxl//" "//trim(ctrcnm(jn))//" Total trend ",                         & 
+              &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zout, zout ) 
+            CALL histdef(nidtrd(jn), trim(clvar)//"_res"  , clmxl//" "//trim(ctrcnm(jn))//" dh/dt Entrainment (Resid.)",           & 
+              &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zout, zout )                   
+         
+            DO jl = 1, jpltrd_trc - 2                                ! <== only true if jpltrd_trc == jpmxl_trc_atf
+               CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jl,2)), clmxl//" "//clvar//ctrd_trc(jl,1),                      & 
+                 &    cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean
+            END DO                                                                         ! if zsto=rdt above
+         
+            CALL histdef(nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmxl_trc_radb,2)), clmxl//" "//clvar//ctrd_trc(jpmxl_trc_radb,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)//trim(ctrd_trc(jpmxl_trc_atf,2)), clmxl//" "//clvar//ctrd_trc(jpmxl_trc_atf,1),   & 
+              &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean
+         !
+         ENDIF
+      END DO
+
+      !-- Leave IOIPSL/NetCDF define mode
+      DO jn = 1, jptra
+         IF( ln_trdtrc(jn) )  CALL histend( nidtrd(jn), snc4set )
+      END DO
+
+      IF(lwp) WRITE(numout,*)
+
+   END SUBROUTINE trd_mxl_trc_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trd_mxl_trc( kt )                                   ! Empty routine
+      INTEGER, INTENT( in) ::   kt
+      WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mxl_trc
+   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn )
+      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank
+      CHARACTER(len=2)      , INTENT( in ) ::  ctype                  ! surface/bottom (2D) or interior (3D) physics
+      REAL, DIMENSION(:,:,:), INTENT( in ) ::  ptrc_trdmxl            ! passive trc trend
+      WRITE(*,*) 'trd_mxl_trc_zint: You should not have seen this print! error?', ptrc_trdmxl(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ctype
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
+   END SUBROUTINE trd_mxl_trc_zint
+   SUBROUTINE trd_mxl_trc_init                                    ! Empty routine
+      WRITE(*,*) 'trd_mxl_trc_init: You should not have seen this print! error?'
+   END SUBROUTINE trd_mxl_trc_init
+#endif
+
+   !!======================================================================
+END MODULE trdmxl_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90	(revision 8732)
@@ -0,0 +1,206 @@
+MODULE trdmxl_trc_rst
+   !!======================================================================
+   !!                       ***  MODULE  trdmxl_rst  ***
+   !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
+   !!======================================================================
+   !! History :  9.0  ! 07-03 (C. Deltel) Original code
+   !!----------------------------------------------------------------------
+  
+#if defined key_top && defined key_trdmxl_trc
+   !!----------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE trc             ! for nn_dttrc ctrcnm
+   USE trdmxl_trc_oce  ! for lk_trdmxl_trc
+
+   IMPLICIT NONE
+   PRIVATE
+  
+   PUBLIC   trd_mxl_trc_rst_read    ! routine called by trd_mxl_init
+   PUBLIC   trd_mxl_trc_rst_write   ! routine called by step.F90
+  
+   INTEGER ::   nummldw_trc               ! logical unit for mld restart
+   
+   !!---------------------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+CONTAINS
+
+    SUBROUTINE trd_mxl_trc_rst_write( kt )
+      !!--------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE trd_mxl_rst_wri  ***
+      !!                
+      !! ** Purpose :   Write mixed-layer diagnostics restart fields.
+      !!--------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+      !
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(LEN=50)   ::   clname   ! output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
+      CHARACTER (len=35) :: charout
+      INTEGER :: jl,  jk, jn               ! loop indice
+      !!--------------------------------------------------------------------------------
+
+      IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc ) THEN ! idem trcrst.F90
+         IF( nitrst > 1.0e9 ) THEN
+            WRITE(clkt,*) nitrst
+         ELSE
+           WRITE(clkt,'(i8.8)') nitrst
+         ENDIF
+         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out)
+         clpath = TRIM(cn_trcrst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname)
+         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
+      ENDIF
+
+      IF( kt == nitend .AND. lk_trdmxl_trc ) THEN
+
+         IF( kt == nitend .AND. lwp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'trdmxl_trc_rst: output for ML diags. restart, with trd_mxl_trc_rst_write routine'
+            WRITE(numout,*) '~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         IF( ln_trdmxl_trc_instant ) THEN 
+            !
+            DO jn = 1, jptra
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) )
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) )
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )
+            END DO
+            !
+         ELSE
+            !
+            CALL iom_rstput( kt, nitrst, nummldw_trc, 'rmldbn_trc', rmldbn_trc )  ! 2D x 1
+            
+            !                                                          ! ===========
+            DO jn = 1, jptra                                           ! tracer loop
+               !                                                       ! ===========
+
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc (:,:,jn) ) ! 2D x jptra
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc   (:,:,jn) ) ! 2D x jptra
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc (:,:,jn) ) ! 2D x jptra
+
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! 2D x jptra
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) ! 2D x jptra
+               
+               DO jk = 1, jpltrd_trc
+                  IF( jk < 10 )   THEN
+                     WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I1)") ctrcnm(jn), jk
+                  ELSE
+                     WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk
+                  ENDIF
+                  CALL iom_rstput( kt, nitrst, nummldw_trc, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )
+               END DO
+               
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &
+                    &           tmltrd_atf_sumb_trc(:,:,jn) ) ! 2D x jptra
+
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &
+                    &           tmltrd_rad_sumb_trc(:,:,jn) ) ! 2D x jptra
+               !                                                       ! ===========
+            END DO                                                     ! tracer loop
+            !                                                          ! ===========
+         ENDIF
+         
+         CALL iom_close( nummldw_trc )
+         lrst_trc = .TRUE.
+
+      ENDIF
+
+    END SUBROUTINE trd_mxl_trc_rst_write
+
+
+    SUBROUTINE trd_mxl_trc_rst_read
+      !!----------------------------------------------------------------------------
+      !!                   ***  SUBROUTINE trd_mxl_rst_lec  ***
+      !!                   
+      !! ** Purpose :   Read file for mixed-layer diagnostics restart.
+      !!----------------------------------------------------------------------------
+      INTEGER  ::  inum       ! temporary logical unit
+      !
+      CHARACTER (len=35) :: charout
+      INTEGER ::  jk, jn, jl     ! loop indice
+      INTEGER ::  jlibalt = jprstlib
+      LOGICAL ::  llok
+      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file
+      !!-----------------------------------------------------------------------------
+      
+      IF(lwp)  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mxl_trc_rst_read : read the NetCDF MLD restart file'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~'
+      ENDIF
+      
+      clpath = TRIM(cn_trcrst_indir)
+      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 
+      
+      IF( ln_trdmxl_trc_instant ) THEN 
+         
+         DO jn = 1, jptra
+            CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) )
+            CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) )
+            CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )
+            CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )
+         END DO
+         
+      ELSE
+         CALL iom_get( inum, jpdom_autoglo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum
+         
+         !                                                          ! ===========
+         DO jn = 1, jptra                                           ! tracer loop
+            !                                                       ! ===========
+            CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) )
+            CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc  (:,:,jn) )
+            CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) )
+
+            CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! needed for tml_sum
+            CALL iom_get( inum, jpdom_autoglo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) )
+            
+            DO jk = 1, jpltrd_trc
+               IF( jk < 10 )   THEN
+                  WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I1)") ctrcnm(jn), jk
+               ELSE
+                  WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk
+               ENDIF
+               CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )
+            END DO
+            
+            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &
+                 &        tmltrd_atf_sumb_trc(:,:,jn) )
+
+            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &
+                 &        tmltrd_rad_sumb_trc(:,:,jn) )
+            !                                                       ! ===========
+         END DO                                                     ! tracer loop
+         !                                                          ! ===========
+
+         CALL iom_close( inum )
+      ENDIF
+      
+    END SUBROUTINE trd_mxl_trc_rst_read
+  
+#else
+  !!=================================================================================
+  !!                       ***  MODULE  trdmxl_rst  ***
+  !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
+  !!=================================================================================
+CONTAINS
+  SUBROUTINE trd_mxl_trc_rst_opn( kt )
+    WRITE(*,*) 'trd_mxl_trc_rst_opn: You should not have seen this print! error?', kt
+  END SUBROUTINE trd_mxl_trc_rst_opn
+  SUBROUTINE trd_mxl_trc_rst_write( kt )           !  No ML diags ==> empty routine
+    WRITE(*,*) 'trd_mxl_trc_rst_wri: You should not have seen this print! error?', kt
+  END SUBROUTINE trd_mxl_trc_rst_write
+  SUBROUTINE trd_mxl_trc_rst_read                  !  No ML Diags ==> empty routine
+  END SUBROUTINE trd_mxl_trc_rst_read
+#endif
+
+  !!=================================================================================
+END MODULE trdmxl_trc_rst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90	(revision 8732)
@@ -0,0 +1,125 @@
+MODULE trdtrc
+   !!======================================================================
+   !!                       ***  MODULE  trdtrc  ***
+   !! Ocean diagnostics:  mixed layer passive tracer trends 
+   !!======================================================================
+   !! History :  3.0  !  2010-07  (C. Ethe)  Original code (from trdtrc.F90)
+   !!----------------------------------------------------------------------
+#if   defined key_top && ( defined key_trdmxl_trc   ||   defined key_trdtrc )
+   !!----------------------------------------------------------------------
+   !!   'key_trdmxl_trc'                  mixed layer trend diagnostics
+   !!   'key_trdtrc'                      3D trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trdtrc      : passive tracer trends 
+   !!----------------------------------------------------------------------
+   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE trd_oce
+   USE trdtrc_oce       ! definition of main arrays used for trends computations
+   USE trdmxl_trc        ! Mixed layer trends diag.
+   USE iom               ! I/O library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trd_trc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_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 == nittrc000 ) THEN
+!         IF(lwp)WRITE(numout,*)
+!         IF(lwp)WRITE(numout,*) 'trd_trc:'
+!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Mixed layer trends for passive tracers
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+#if defined key_trdmxl_trc  
+      IF( lk_trdmxl_trc .AND. ln_trdtrc( kjn ) ) THEN
+         !
+         SELECT CASE ( ktrd )
+         CASE ( jptra_xad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_xad, '3D', kjn )
+         CASE ( jptra_yad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_yad, '3D', kjn )
+         CASE ( jptra_zad     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zad, '3D', kjn )
+         CASE ( jptra_ldf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
+         CASE ( jptra_bbl     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_bbl, '3D', kjn )
+         CASE ( jptra_zdf     )
+            IF( ln_trcldf_iso ) THEN
+               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_ldf, '3D', kjn )
+            ELSE
+               CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_zdf, '3D', kjn )
+            ENDIF
+         CASE ( jptra_dmp     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_dmp , '3D', kjn )
+         CASE ( jptra_nsr     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sbc , '2D', kjn )
+         CASE ( jptra_sms     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_sms , '3D', kjn )
+         CASE ( jptra_radb    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radb, '3D', kjn )
+         CASE ( jptra_radn    )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_radn, '3D', kjn )
+         CASE ( jptra_atf     )   ;   CALL trd_mxl_trc_zint( ptrtrd, jpmxl_trc_atf , '3D', kjn )
+         END SELECT
+         !
+      END IF
+#endif
+
+      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN
+         !
+         SELECT CASE( ktrd )
+         CASE( jptra_xad  )       ;    WRITE (cltra,'("XAD_",4a)')
+         CASE( jptra_yad  )       ;    WRITE (cltra,'("YAD_",4a)')
+         CASE( jptra_zad  )       ;    WRITE (cltra,'("ZAD_",4a)')
+         CASE( jptra_ldf  )       ;    WRITE (cltra,'("LDF_",4a)')
+         CASE( jptra_bbl  )       ;    WRITE (cltra,'("BBL_",4a)')
+         CASE( jptra_nsr  )       ;    WRITE (cltra,'("FOR_",4a)')
+         CASE( jptra_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)')
+         CASE( jptra_dmp  )       ;    WRITE (cltra,'("DMP_",4a)')
+         CASE( jptra_sms  )       ;    WRITE (cltra,'("SMS_",4a)')
+         CASE( jptra_atf  )       ;    WRITE (cltra,'("ATF_",4a)')
+         CASE( jptra_radb )       ;    WRITE (cltra,'("RDB_",4a)')
+         CASE( jptra_radn )       ;    WRITE (cltra,'("RDN_",4a)')
+         END SELECT
+                                          cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
+                                          CALL iom_put( cltra,  ptrtrd(:,:,:) )
+         !
+      END IF
+
+   END SUBROUTINE trd_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+
+   PUBLIC trd_trc
+
+CONTAINS
+
+   SUBROUTINE trd_trc( 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_trc : 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_trc
+
+#endif
+   !!======================================================================
+END MODULE trdtrc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90	(revision 8732)
@@ -0,0 +1,163 @@
+MODULE trdtrc_oce
+   !!======================================================================
+   !!                   ***  MODULE trdtrc_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+#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_trdmxl_trc_instant       !: flag to diagnose inst./mean ML trc trends
+   LOGICAL  ::    ln_trdmxl_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(:), ALLOCATABLE ::   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_trdmxl_trc
+   !!----------------------------------------------------------------------
+   !!   'key_trdmxl_trc'                     mixed layer trends diagnostics
+   !!----------------------------------------------------------------------
+
+   LOGICAL, PARAMETER ::   lk_trdmxl_trc = .TRUE.    !: ML trend flag
+
+   INTEGER, PARAMETER ::            & !: mixed layer trends indices
+        jpmxl_trc_xad     =  1,     & !:     zonal       advection     
+        jpmxl_trc_yad     =  2,     & !:     meridonal   =========
+        jpmxl_trc_zad     =  3,     & !:     vertical    =========
+        jpmxl_trc_ldf     =  4,     & !:     lateral diffusion (geopot. or iso-neutral)
+        jpmxl_trc_zdf     =  5,     & !:     vertical diffusion (TKE)
+        jpmxl_trc_bbl     =  6,     & !:     bottom boundary layer (advective/diffusive)
+        jpmxl_trc_dmp     =  7,     & !:     internal restoring trend
+        jpmxl_trc_sbc     =  8,     & !:     forcing 
+        jpmxl_trc_sms     =  9,     & !:     sources minus sinks trend
+  !     jpmxl_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **)
+        jpmxl_trc_radn    = 10,     & !:     corr. trn<0 in trcrad
+        jpmxl_trc_radb    = 11,     & !:     corr. trb<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **)
+        jpmxl_trc_atf     = 12        !:     asselin trend                    (** MUST BE    THE      LAST ONE**)
+
+   !! Trends diagnostics parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PARAMETER :: jpltrd_trc = 12    !: number of mixed-layer trends arrays
+      
+   INTEGER            :: jpktrd_trc         !: 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, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
+      nmld_trc       , &                            !: mixed layer depth indexes 
+      nbol_trc                                   !: mixed-layer depth indexes when read from file
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  wkx_trc  !:
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmld_trc     !: ML depth (m) corresponding to nmld_trc
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmldbn_trc   !: idem
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &
+      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), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &      
+      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), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  &
+      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), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &
+      tmltrdm_trc                                !: total cumulative trends over the analysis window
+
+# else
+   LOGICAL, PARAMETER ::   lk_trdmxl_trc = .FALSE.   !: ML trend flag
+# endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_trc_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!         *** ROUTINE trd_trc_oce_alloc ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      INTEGER :: ierr(2)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+# if defined key_trdmxl_trc
+      ALLOCATE(nmld_trc(jpi,jpj),          nbol_trc(jpi,jpj),           &
+               wkx_trc(jpi,jpj,jpk),       rmld_trc(jpi,jpj),           &
+               rmld_sum_trc(jpi,jpj),      rmldbn_trc(jpi,jpj),         &
+               tml_trc(jpi,jpj,jptra),     tmlb_trc(jpi,jpj,jptra),     &
+               tmlbb_trc(jpi,jpj,jptra),   tmlbn_trc(jpi,jpj,jptra),    &
+               tml_sum_trc(jpi,jpj,jptra), tml_sumb_trc(jpi,jpj,jptra), &
+               tmltrd_atf_sumb_trc(jpi,jpj,jptra),                      &
+               tmltrd_rad_sumb_trc(jpi,jpj,jptra),                      &
+               !
+               tmlatfb_trc(jpi,jpj,jptra), tmlatfn_trc(jpi,jpj,jptra),  &
+               tmlatfm_trc(jpi,jpj,jptra), tmlradb_trc(jpi,jpj,jptra),  &
+               tmlradn_trc(jpi,jpj,jptra), tmlradm_trc(jpi,jpj,jptra),  &
+               !
+               tmltrd_trc(jpi,jpj,jpltrd_trc,jptra)         , &
+               tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra)     , &
+               tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra) , &
+               tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra) , &
+               !
+               tmltrdm_trc(jpi,jpj,jptra)                   , STAT=ierr(1) )
+#endif
+      !
+      trd_trc_oce_alloc = MAXVAL(ierr)
+      !
+      IF( trd_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_trc_oce_alloc: failed to allocate arrays')
+      !
+# if defined key_trdmxl_trc
+      jpktrd_trc = jpk      ! Initialise what used to be a parameter - max level for mixed-layer trends diag.
+# endif
+      !
+   END FUNCTION trd_trc_oce_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE trdtrc_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 8732)
@@ -0,0 +1,114 @@
+MODULE oce_trc
+   !!======================================================================
+   !!                      ***  MODULE  oce_trc  ***
+   !! TOP :   variables shared between ocean and passive tracers
+   !!======================================================================
+   !! History :   1.0  !  2004-03  (C. Ethe)  original code
+   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting
+   !!----------------------------------------------------------------------
+   !                                            !* Domain size *
+   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i 
+   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j  
+   USE par_oce , ONLY :   jpk      =>   jpk        !: number of levels  
+   USE par_oce , ONLY :   jpim1    =>   jpim1      !: jpi - 1
+   USE par_oce , ONLY :   jpjm1    =>   jpjm1      !: jpj - 1 
+   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1  
+   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj
+   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature
+   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
+
+   USE in_out_manager                           !* IO manager *
+   USE wrk_nemo                                 !* Memory Allocation *
+   USE timing                                   !* Timing * 
+   USE lib_mpp                                  !* MPP library                         
+   USE lib_fortran                              !* Fortran utilities                         
+   USE lbclnk                                   !* Lateral boundary conditions                         
+   USE phycst                                   !* physical constants *
+   USE c1d                                      !* 1D configuration
+
+   USE dom_oce                                  !* model domain *
+
+   USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport
+   USE domvvl, ONLY : ln_vvl_ztilde         !: ztilde vertical coordinate
+   USE domvvl, ONLY : ln_vvl_layer          !: level  vertical coordinate
+
+   !* ocean fields: here now and after fields *
+   USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1) 
+   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1)
+   USE oce , ONLY :   wn      =>    wn      !: vertical velocity (m s-1)  
+   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)
+   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]   
+   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points
+
+   !* surface fluxes *
+   USE sbc_oce , ONLY :   utau       =>    utau       !: i-surface stress component
+   USE sbc_oce , ONLY :   vtau       =>    vtau       !: j-surface stress component
+   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        !: freshwater budget: volume flux               [Kg/m2/s]
+   USE sbc_oce , ONLY :   emp_b      =>    emp_b      !: freshwater budget: volume flux               [Kg/m2/s]
+   USE sbc_oce , ONLY :   fmmflx     =>    fmmflx     !: freshwater budget: volume flux               [Kg/m2/s]
+   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s]
+   USE sbc_oce , ONLY :   rnf_b      =>    rnf_b      !: river runoff at previus step   [Kg/m2/s]
+   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Diurnal Cycle 
+   USE sbc_oce , ONLY :   ln_cpl     =>    ln_cpl     !: ocean-atmosphere coupled formulation
+   USE sbc_oce , ONLY :   ncpl_qsr_freq   =>   ncpl_qsr_freq   !: qsr coupling frequency per days from atmospher
+   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths
+   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1)
+   USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean
+   USE sbc_oce , ONLY :   atm_co2    =>    atm_co2    !  atmospheric pCO2
+   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 :   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.)
+   USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s]
+   USE sbcrnf  , ONLY :   nk_rnf     =>    nk_rnf     !: depth of runoff in model level
+   USE sbcrnf  , ONLY :   rn_rfact   =>    rn_rfact   !: multiplicative factor for runoff
+
+   USE trc_oce
+
+!!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line)
+!!gm   so the following lines should be removed....   logical should be the one of TRC namelist
+!!gm   In case off coarsening....  the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all.
+   !* lateral diffusivity (tracers) *
+   USE ldftra , ONLY :  rn_aht_0     =>   rn_aht_0     !:   laplacian lateral eddy diffusivity [m2/s]
+   USE ldftra , ONLY :  rn_bht_0     =>   rn_bht_0     !: bilaplacian lateral eddy diffusivity [m4/s]
+   USE ldftra , ONLY :  ahtu         =>   ahtu         !: lateral diffusivity coef. at u-points 
+   USE ldftra , ONLY :  ahtv         =>   ahtv         !: lateral diffusivity coef. at v-points 
+   USE ldftra , ONLY :  rn_aeiv_0    =>   rn_aeiv_0    !: eddy induced velocity coefficient (m2/s) 
+   USE ldftra , ONLY :  aeiu         =>   aeiu         !: eddy induced velocity coef. at u-points (m2/s)   
+   USE ldftra , ONLY :  aeiv         =>   aeiv         !: eddy induced velocity coef. at v-points (m2/s) 
+   USE ldftra , ONLY :  ln_ldfeiv    =>   ln_ldfeiv    !: eddy induced velocity flag
+     
+!!gm this should be : ln_trcldf_triad (TRC namelist)
+   USE ldfslp , ONLY :  ln_traldf_triad => ln_traldf_triad   !: triad scheme (Griffies et al.)
+
+   !* direction of lateral diffusion *
+   USE ldfslp , ONLY :   l_ldfslp  =>  l_ldfslp       !: slopes flag
+   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-slope at u-point
+   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-slope at v-point
+   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-slope at w-point
+   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-slope at w-point
+!!gm end 
+
+   !* vertical diffusion *
+   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
+# endif
+
+   !* mixing & mixed layer depth *
+   USE zdfmxl , ONLY :   nmln        =>   nmln        !: number of level in the mixed layer
+   USE zdfmxl , ONLY :   hmld        =>   hmld        !: mixing layer depth (turbocline)
+   USE zdfmxl , ONLY :   hmlp        =>   hmlp        !: mixed layer depth  (rho=rho0+zdcrit) (m)
+   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m)
+
+END MODULE oce_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 8732)
@@ -0,0 +1,43 @@
+MODULE par_trc
+   !!======================================================================
+   !!                        ***  par_trc  ***
+   !! TOP :   set the passive tracers parameters
+   !!======================================================================
+   !! History :    -   !  1996-01  (M. Levy)  original code
+   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
+   !!             1.0  !  2004-03  (C. Ethe) Free form and module
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+   USE par_pisces        ! PISCES model  parameters
+   USE par_cfc           ! CFCs  tracers parameters
+   USE par_c14           ! C14 tracer    parameters
+   USE par_age           ! AGE tracer    parameters
+   USE par_my_trc        ! MY_TRC model  parameters
+   !
+
+   IMPLICIT NONE
+
+   INTEGER, PUBLIC,  PARAMETER :: jpmaxtrc = 100  ! Maximum number of tracers
+
+   INTEGER, PUBLIC             :: jptra           !: Total number of passive tracers
+   INTEGER, PUBLIC             :: jp_pisces       !: number of passive tracers in PISCES model
+   INTEGER, PUBLIC             :: jp_cfc          !: number of CFC passive tracers 
+   INTEGER, PUBLIC             :: jp_my_trc       !: number of passive tracers in MY_TRC model
+   INTEGER, PUBLIC             :: jp_bgc          !: number of passive tracers for the BGC model
+
+   INTEGER, PUBLIC             :: jp_dia3d        !: number of 3D diagnostic variables
+   INTEGER, PUBLIC             :: jp_dia2d        !: number of 2D diagnostic variables
+
+   LOGICAL, PUBLIC             :: ln_pisces       !: PISCES flag 
+   LOGICAL, PUBLIC             :: ln_age          !: AGE flag 
+   LOGICAL, PUBLIC             :: ln_cfc11        !: CFC11 flag 
+   LOGICAL, PUBLIC             :: ln_cfc12        !: CFC12 flag 
+   LOGICAL, PUBLIC             :: ln_sf6          !: SF6 flag 
+   LOGICAL, PUBLIC             :: ll_cfc          !: CFC flag 
+   LOGICAL, PUBLIC             :: ln_c14          !: C14 flag 
+   LOGICAL, PUBLIC             :: ln_my_trc       !: MY_TRC flag 
+
+   REAL(wp), PUBLIC            :: rtrn  = 0.5 * EPSILON( 1.e0 )    !: truncation value
+
+END MODULE par_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 8732)
@@ -0,0 +1,297 @@
+MODULE prtctl_trc
+   !!======================================================================
+   !!                         ***  MODULE prtctl_trc  ***
+   !! TOP :   print all SUM trends for each processor domain
+   !!======================================================================
+   !! History :    -   !  2005-07  (C. Talandier) original code for OPA
+   !!             1.0  !  2005-10  (C. Ethe     ) adapted to passive tracer
+   !!----------------------------------------------------------------------
+   !!   prt_ctl_trc      :   control print in mpp for passive tracers
+   !!   prt_ctl_trc_info :   ???
+   !!   prt_ctl_trc_init :   ???
+   !!----------------------------------------------------------------------
+   USE par_trc          ! TOP parameters
+   USE oce_trc          ! ocean space and time domain variables
+   USE prtctl           ! print control for OPA
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER , DIMENSION(:), ALLOCATABLE ::   numid_trc          !: logical unit 
+   INTEGER , DIMENSION(:), ALLOCATABLE ::   nlditl , nldjtl    !: first, last indoor index for each i-domain
+   INTEGER , DIMENSION(:), ALLOCATABLE ::   nleitl , nlejtl    !: first, last indoor index for each j-domain
+   INTEGER , DIMENSION(:), ALLOCATABLE ::   nimpptl, njmpptl   !: i-, j-indexes for each processor
+   INTEGER , DIMENSION(:), ALLOCATABLE ::   nlcitl , nlcjtl    !: dimensions of every subdomain
+   INTEGER , DIMENSION(:), ALLOCATABLE ::   ibonitl, ibonjtl
+
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl         !: previous trend values
+
+   PUBLIC prt_ctl_trc         ! called by all subroutines
+   PUBLIC prt_ctl_trc_info    !
+   PUBLIC prt_ctl_trc_init    ! called by opa.F90
+
+CONTAINS
+
+   SUBROUTINE prt_ctl_trc( tab4d, mask, clinfo, ovlap, kdim, clinfo2 )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE prt_ctl  ***
+      !!
+      !! ** Purpose : - print sum control 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 mask
+      !!                array tmask(:,:,:) must be passed through the prt_ctl subroutine, 
+      !!                it must looks like: CALL prt_ctl( mask=tmask ).
+      !!----------------------------------------------------------------------
+      REAL(wp)         , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d     ! 4D array
+      REAL(wp)         , DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask      ! 3D mask to apply to the tab4d array
+      CHARACTER (len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array
+      CHARACTER (len=*)                    , INTENT(in), OPTIONAL ::   clinfo2   ! ???
+      INTEGER                              , INTENT(in), OPTIONAL ::   ovlap     ! overlap value
+      INTEGER                              , INTENT(in), OPTIONAL ::   kdim      ! k- direction for 4D arrays
+      !!
+      INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id
+      REAL(wp) ::   zsum, zvctl
+      CHARACTER (len=20), ALLOCATABLE, DIMENSION(:) ::   cl
+      CHARACTER (len=10) ::   cl2
+      REAL(wp), POINTER, DIMENSION(:,:,:)  :: zmask, ztab3d 
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d )
+      ALLOCATE( cl(jptra) )
+      !                                      ! Arrays, scalars initialization 
+      overlap       = 0
+      kdir          = jpkm1
+      zsum          = 0.e0
+      zvctl         = 0.e0
+      cl(:)         = ''
+      cl2           = ''
+      ztab3d(:,:,:) = 0.e0
+      zmask (:,:,:) = 1.e0
+
+      !                                      ! Control of optional arguments
+      IF( PRESENT(ovlap)   )   overlap       = ovlap
+      IF( PRESENT(kdim)    )   kdir          = kdim
+      IF( PRESENT(clinfo ) )   cl(:)         = clinfo(:)
+      IF( PRESENT(clinfo2) )   cl2           = clinfo2
+      IF( PRESENT(mask)    )   zmask (:,:,:) = mask(:,:,:)
+
+      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 js = sind, eind
+         !
+         ! Set logical unit
+         j_id = numid_trc( js - narea + 1 )
+         ! Set indices for the SUM control
+         IF( .NOT. lsp_area ) THEN
+            IF (lk_mpp )   THEN
+               nictls = MAX( 1, nlditl(js) - overlap )
+               nictle = nleitl(js) + overlap * MIN( 1, nlcitl(js) - nleitl(js)) 
+               njctls = MAX( 1, nldjtl(js) - overlap )
+               njctle = nlejtl(js) + overlap * MIN( 1, nlcjtl(js) - nlejtl(js))
+               ! Do not take into account the bound of the domain
+               IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 )   nictls = MAX( 2, nictls )
+               IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 )   nictle = MIN( nictle, nleitl(js) - 1 )
+               IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 )   njctls = MAX( 2, njctls )
+               IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 )   njctle = MIN( njctle, nlejtl(js) - 1 )
+            ELSE
+               nictls = MAX( 1, nimpptl(js) + nlditl(js) - 1 - overlap )
+               nictle = nimpptl(js) + nleitl(js) - 1 + overlap * MIN( 1, nlcitl(js) - nleitl(js) ) 
+               njctls = MAX( 1, njmpptl(js) + nldjtl(js) - 1 - overlap )
+               njctle = njmpptl(js) + nlejtl(js) - 1 + overlap * MIN( 1, nlcjtl(js) - nlejtl(js) ) 
+               ! Do not take into account the bound of the domain
+               IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 )   nictls = MAX( 2, nictls )
+               IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 )   njctls = MAX( 2, njctls )
+               IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 )   nictle = MIN( nictle, nimpptl(js) + nleitl(js) - 2 )
+               IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 )   njctle = MIN( njctle, njmpptl(js) + nlejtl(js) - 2 )
+            ENDIF
+         ENDIF
+         !
+         IF( PRESENT(clinfo2) ) THEN
+            DO jn = 1, jptra
+               zvctl  = tra_ctl(jn,js)
+               ztab3d(:,:,:) = tab4d(:,:,:,jn)
+               zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir)   &
+                  &                * zmask(nictls:nictle,njctls:njctle,1:kdir) )
+               WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum-zvctl
+               tra_ctl(jn,js) = zsum
+            END DO
+         ELSE
+            DO jn = 1, jptra
+               ztab3d(:,:,:) = tab4d(:,:,:,jn)
+               zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir)   &
+                  &               *  zmask(nictls:nictle,njctls:njctle,1:kdir) )
+               WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zmask, ztab3d )
+      DEALLOCATE( cl )
+      !
+   END SUBROUTINE prt_ctl_trc
+
+
+   SUBROUTINE prt_ctl_trc_info( clinfo )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE prt_ctl_trc_info  ***
+      !!
+      !! ** Purpose : - print information without any computation
+      !!----------------------------------------------------------------------
+      CHARACTER (len=*), INTENT(in) ::   clinfo      ! information to print
+      !! 
+      INTEGER ::   js, sind, eind, j_id
+      !!----------------------------------------------------------------------
+
+      IF( lk_mpp ) THEN      ! processor number
+         sind = narea
+         eind = narea
+      ELSE                   ! total number of processors
+         sind = 1
+         eind = ijsplt
+      ENDIF
+
+      ! Loop over each sub-domain, i.e. number of processors ijsplt
+      DO js = sind, eind
+         j_id = numid_trc(js - narea + 1)
+         WRITE(j_id,*) clinfo
+      END DO
+      !
+   END SUBROUTINE prt_ctl_trc_info
+
+
+   SUBROUTINE prt_ctl_trc_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE prt_ctl_trc_init  ***
+      !!
+      !! ** Purpose :   open ASCII files & compute indices
+      !!----------------------------------------------------------------------
+      INTEGER            ::   js, sind, eind, j_id
+      CHARACTER (len=31) :: clfile_out
+      CHARACTER (len=27) :: 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( tra_ctl(jptra,ijsplt) )
+      ALLOCATE( ibonitl(ijsplt) )
+      ALLOCATE( ibonjtl(ijsplt) )
+
+      tra_ctl(:,:) = 0.e0           ! Initialization to zero
+
+      IF( lk_mpp ) THEN
+         sind = narea
+         eind = narea
+         clb_name = "('mpp.top.output_',I3.3)"
+         cl_run = 'MULTI processor run'
+         ! use indices for each area computed by mpp_init subroutine
+         nlditl(1:jpnij) = nldit(:) 
+         nleitl(1:jpnij) = nleit(:) 
+         nldjtl(1:jpnij) = nldjt(:) 
+         nlejtl(1:jpnij) = nlejt(:) 
+         !
+         nimpptl(1:jpnij) = nimppt(:)
+         njmpptl(1:jpnij) = njmppt(:)
+         !
+         nlcitl(1:jpnij) = nlcit(:)
+         nlcjtl(1:jpnij) = nlcjt(:)
+         !
+         ibonitl(1:jpnij) = ibonit(:)
+         ibonjtl(1:jpnij) = ibonjt(:)
+      ELSE
+         sind = 1
+         eind = ijsplt
+         clb_name = "('mono.top.output_',I3.3)"
+         cl_run   = 'MONO processor run '
+         ! compute indices for each area as done in mpp_init subroutine
+         CALL sub_dom
+      ENDIF
+
+      ALLOCATE( numid_trc(eind-sind+1) )
+
+      DO js = sind, eind
+         WRITE(clfile_out,FMT=clb_name) js-1
+         CALL ctl_opn( numid_trc(js -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         j_id = numid_trc(js -narea + 1)
+         WRITE(j_id,*)
+         WRITE(j_id,*) '                 L O D Y C - I P S L'
+         WRITE(j_id,*) '                       N E M 0 '
+         WRITE(j_id,*) '            Ocean General Circulation Model'
+         WRITE(j_id,*) '               version TOP 1.0  (2005) '
+         WRITE(j_id,*)
+         WRITE(j_id,*) '                   PROC number: ', js
+         WRITE(j_id,*)
+         WRITE(j_id,FMT="(19x,a20)") cl_run
+
+         ! Print the SUM control indices
+         IF( .NOT. lsp_area )   THEN
+            IF ( lk_mpp )   THEN
+               nictls = nlditl(js) 
+               nictle = nleitl(js)
+               njctls = nldjtl(js)
+               njctle = nlejtl(js)
+            ELSE
+               nictls = nimpptl(js) + nlditl(js) - 1
+               nictle = nimpptl(js) + nleitl(js) - 1
+               njctls = njmpptl(js) + nldjtl(js) - 1
+               njctle = njmpptl(js) + nlejtl(js) - 1
+            ENDIF
+         ENDIF
+         WRITE(j_id,*) 
+         WRITE(j_id,*) 'prt_tra_ctl :  Sum control indices'
+         WRITE(j_id,*) '~~~~~~~'
+         WRITE(j_id,*)
+         WRITE(j_id,9000)'                                nlej   = ', nlejtl(js), '              '
+         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(js),  '                           nlei   = ', nleitl(js)
+         WRITE(j_id,9001)'                  |                                       |'
+         WRITE(j_id,9001)'                  |                                       |'
+         WRITE(j_id,9001)'                  |                                       |'
+         WRITE(j_id,9004)'  njmpp  = ',njmpptl(js),'   ------------- njctls = ', njctls, ' -------------'
+         WRITE(j_id,9003)'           nimpp  = ', nimpptl(js), '        nldj   = ', nldjtl(js), '              '
+         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)
+      END DO
+      !
+   END SUBROUTINE prt_ctl_trc_init
+
+END MODULE prtctl_trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 8732)
@@ -0,0 +1,223 @@
+MODULE trc
+   !!======================================================================
+   !!                      ***  MODULE  trc  ***
+   !! Passive tracers   :  module for tracers defined
+   !!======================================================================
+   !! History :   OPA  !  1996-01  (M. Levy)  Original code
+   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
+   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+   USE bdy_oce, only: ln_bdy, nb_bdy, OBC_DATA
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   trc_alloc   ! called by nemogcm.F90
+
+   !! parameters for the control of passive tracers
+   !! ---------------------------------------------   
+   INTEGER, PUBLIC                                                 ::   numnat_ref = -1   !: logical unit for the reference passive tracer namelist_top_ref
+   INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg
+   INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top
+   INTEGER, PUBLIC                                                 ::   numtrc_ref = -1   !: logical unit for the reference passive tracer namelist_top_ref
+   INTEGER, PUBLIC                                                 ::   numtrc_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg
+   INTEGER, PUBLIC                                                 ::   numonr     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top
+   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics
+   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read )
+   INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write )
+
+   !! passive tracers fields (before,now,after)
+   !! --------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)               ::  trai           !: initial total tracer
+   REAL(wp), PUBLIC                                                ::  areatot        !: total volume 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC
+   INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers
+
+   !! interpolated gradient
+   !!--------------------------------------------------  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr
+   
+   !! passive tracers  (input and output)
+   !! ------------------------------------------  
+   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_writetrc    !: time step frequency for concentration outputs (namelist)
+   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 = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input)
+   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory
+   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
+   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory
+   REAL(wp)            , PUBLIC                                    ::  rdttrc         !: passive tracer time step
+   REAL(wp)            , PUBLIC                                    ::  r2dttrc        !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0
+   LOGICAL             , PUBLIC                                    ::  ln_top_euler   !: boolean term for euler integration 
+   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files
+   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag
+   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas
+   INTEGER             , PUBLIC                                    ::  nittrc000      !: first time step of passive tracers model
+   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP
+
+   !! Information for the ice module for tracers
+   !! ------------------------------------------
+   TYPE TRC_I_NML                    !--- Ice tracer namelist structure
+         REAL(wp)         :: trc_ratio  ! ice-ocean trc ratio
+         REAL(wp)         :: trc_prescr ! prescribed ice trc cc
+         CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc
+   END TYPE
+
+   REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: trc_ice_ratio      ! ice-ocean tracer ratio
+   REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: trc_ice_prescr     ! prescribed ice trc cc
+   CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: cn_trc_o ! choice of ocean tracer cc
+
+
+   !! information for outputs
+   !! --------------------------------------------------
+   TYPE, PUBLIC :: PTRACER                                                            !: Passive tracer type
+       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              :: llsbc   !: read in a file or not
+       LOGICAL              :: llcbc   !: read in a file or not
+       LOGICAL              :: llobc   !: read in a file or not
+   END TYPE PTRACER
+
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name 
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit
+
+   TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type
+      CHARACTER(len = 20)  :: sname    !: short name
+      CHARACTER(len = 80)  :: lname    !: long name
+      CHARACTER(len = 20)  :: units    !: unit
+   END TYPE DIAG
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trc3d          !: 3D diagnostics for tracers
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trc2d          !: 2D diagnostics for tracers
+
+   !! information for inputs
+   !! --------------------------------------------------
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_obc     !: Use open boundary condition data
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_sbc     !: Use surface boundary condition data
+   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_cbc     !: Use coastal boundary condition data
+   LOGICAL , PUBLIC                                     ::  ln_rnf_ctl     !: remove runoff dilution on tracers
+   REAL(wp), PUBLIC                                     ::  rn_bc_time     !: Time scaling factor for SBC and CBC data (seconds in a day)
+
+
+   !! variables to average over physics over passive tracer sub-steps.
+   !! ----------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_tm       !: i-horizontal velocity average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !: 
+# if defined key_zdfddm
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s]
+# endif
+#if defined key_trabbl
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm  !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm  !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm  !: j-direction slope at u-, w-points
+#endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm     !: average ssh for the now step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]  
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  rnf_tm     !: river runoff
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm   !: depth in metres to the bottom of the relevant grid box
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_tm    !: mixed layer depth average [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fmmflx_tm  !: freshwater budget: freezing/melting [Kg/m2/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  wndm_tm    !: 10m wind average [m]
+   !
+
+   ! Temporary physical arrays for sub_stepping
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp     !: hold current values of avt, un, vn, wn
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_temp, qsr_temp, fr_i_temp,wndm_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, fmmflx_temp, emp_b_temp
+   !
+#if defined key_trabbl
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values 
+#endif
+   !
+# if defined key_zdfddm
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s]
+# endif
+   !
+   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers
+   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers
+   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping
+   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp
+   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process)
+   !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE trc_alloc ***
+      !!-------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      !!-------------------------------------------------------------------
+      INTEGER :: ierr(4)
+      !!-------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &  
+         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       &
+         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       &
+         &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       &
+         &      trc_ice_ratio(jptra)  , trc_ice_prescr(jptra) , cn_trc_o(jptra)       ,       &
+         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &  
+         &      cvol(jpi,jpj,jpk)     , trai(jptra)           , qsr_mean(jpi,jpj)     ,       &
+         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &
+         &      ln_trc_ini(jptra)     ,                                                       &
+         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       &
+         &      STAT = ierr(1)  )
+      !
+      IF ( ln_bdy ) THEN
+         ALLOCATE( cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)     , nn_trcdmp_bdy(nb_bdy) ,       &
+         &      trcdta_bdy(jptra,nb_bdy)                                              ,       &
+         &      STAT = ierr(2)  )
+      ENDIF
+      !
+      IF (jp_dia3d > 0 ) ALLOCATE( trc3d(jpi,jpj,jpk,jp_dia3d), STAT = ierr(3) )
+      !
+      IF (jp_dia2d > 0 ) ALLOCATE( trc2d(jpi,jpj,jpk,jp_dia2d), STAT = ierr(4) )
+      ! 
+      trc_alloc = MAXVAL( ierr )
+      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trc_alloc
+
+   !!======================================================================
+END MODULE trc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcbc.F90	(revision 8732)
@@ -0,0 +1,470 @@
+MODULE trcbc
+   !!======================================================================
+   !!                     ***  MODULE  trcbc  ***
+   !! TOP :  module for passive tracer boundary conditions
+   !!=====================================================================
+   !! History :  3.5 !  2014 (M. Vichi, T. Lovato)  Original
+   !!            3.6 !  2015 (T . Lovato) Revision and BDY support
+   !!            4.0 !  2016 (T . Lovato) Include application of sbc and cbc
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP model 
+   !!----------------------------------------------------------------------
+   !!   trc_bc       :  Apply tracer Boundary Conditions
+   !!----------------------------------------------------------------------
+   USE par_trc       !  passive tracers parameters
+   USE oce_trc       !  shared variables between ocean and passive tracers
+   USE trc           !  passive tracers common variables
+   USE iom           !  I/O manager
+   USE lib_mpp       !  MPP library
+   USE fldread       !  read input fields
+   USE bdy_oce,  ONLY: ln_bdy, nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_bc         ! called in trcstp.F90 or within TOP modules
+   PUBLIC   trc_bc_ini     ! called in trcini.F90 
+
+   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC
+   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc    ! number of tracers with surface BC
+   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc    ! number of tracers with coastal BC
+   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data
+   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data
+   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac    ! multiplicative factor for SBC tracer values
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc    ! structure of data input SBC (file informations, fields read)
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac    ! multiplicative factor for CBC tracer values
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc    ! structure of data input CBC (file informations, fields read)
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac    ! multiplicative factor for OBCtracer values
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET  :: sf_trcobc    ! structure of data input OBC (file informations, fields read)
+   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2016)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_bc_ini( ntrc )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_bc_ini  ***
+      !!                    
+      !! ** Purpose :   initialisation of passive tracer BC data 
+      !! 
+      !! ** Method  : - Read namtsd namelist
+      !!              - allocates passive tracer BC data structure 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
+      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices
+      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers
+      INTEGER            :: ios                            ! Local integer output status for namelist read
+      INTEGER            :: nblen, igrd                    ! support arrays for BDY
+      CHARACTER(len=100) :: clndta, clntrc
+      !
+      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc
+
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read
+      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open
+      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc    ! surface
+      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc    ! coastal
+      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trofac    ! multiplicative factor for tracer values
+      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trsfac    ! multiplicative factor for tracer values
+      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values
+      !!
+      NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, & 
+                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time
+      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy
+
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 )  CALL timing_start('trc_bc_ini')
+      !
+      IF( lwp ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+      !  Initialisation and local array allocation
+      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  
+      ALLOCATE( slf_i(ntrc), STAT=ierr0 )
+      IF( ierr0 > 0 ) THEN
+         CALL ctl_stop( 'trc_bc_ini: unable to allocate local slf_i' )   ;   RETURN
+      ENDIF
+
+      ! Compute the number of tracers to be initialised with open, surface and boundary data
+      ALLOCATE( n_trc_indobc(ntrc), STAT=ierr0 )
+      IF( ierr0 > 0 ) THEN
+         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' )   ;   RETURN
+      ENDIF
+      nb_trcobc      = 0
+      n_trc_indobc(:) = 0
+      !
+      ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 )
+      IF( ierr0 > 0 ) THEN
+         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' )   ;   RETURN
+      ENDIF
+      nb_trcsbc      = 0
+      n_trc_indsbc(:) = 0
+      !
+      ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 )
+      IF( ierr0 > 0 ) THEN
+         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' )   ;   RETURN
+      ENDIF
+      nb_trccbc      = 0
+      n_trc_indcbc(:) = 0
+      !
+      ! Read Boundary Conditions Namelists
+      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure
+      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure
+      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_bc )
+
+      IF ( ln_bdy ) THEN
+         REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure
+         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903)
+903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp )
+
+         REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure
+         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 )
+904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp )
+         IF(lwm) WRITE ( numont, namtrc_bdy )
+      
+         ! setup up preliminary informations for BDY structure
+         DO jn = 1, ntrc
+            DO ib = 1, nb_bdy
+               ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml)
+               IF ( ln_trc_obc(jn) ) THEN
+                  trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) )
+               ELSE
+                  trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) )
+               ENDIF
+               ! set damping use in BDY data structure
+               trcdta_bdy(jn,ib)%dmp = .false.
+               IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true.
+               IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true.
+               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  &
+                   & CALL ctl_stop( 'Use FRS OR relaxation' )
+               IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            &
+                   & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )
+            ENDDO
+         ENDDO
+      ELSE
+         ! Force all tracers OBC to false if bdy not used
+         ln_trc_obc = .false.
+      ENDIF
+
+      ! compose BC data indexes
+      DO jn = 1, ntrc
+         IF( ln_trc_obc(jn) ) THEN
+             nb_trcobc       = nb_trcobc + 1  ; n_trc_indobc(jn) = nb_trcobc
+         ENDIF
+         IF( ln_trc_sbc(jn) ) THEN
+             nb_trcsbc       = nb_trcsbc + 1  ; n_trc_indsbc(jn) = nb_trcsbc
+         ENDIF
+         IF( ln_trc_cbc(jn) ) THEN
+             nb_trccbc       = nb_trccbc + 1  ; n_trc_indcbc(jn) = nb_trccbc
+         ENDIF
+      ENDDO
+
+      ! Print summmary of Boundary Conditions
+      IF( lwp ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc
+         IF ( nb_trcsbc > 0 ) THEN
+            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. '
+            DO jn = 1, ntrc
+               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn)
+            ENDDO
+         ENDIF
+         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc)
+
+         WRITE(numout,*) ' '
+         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc
+         IF( nb_trccbc > 0 ) THEN
+            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. '
+            DO jn = 1, ntrc
+               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn)
+            ENDDO
+         ENDIF
+         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc)
+         IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE.
+         IF( ln_rnf_ctl )  WRITE(numout,'(a)') ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)' 
+         WRITE(numout,*) ' '
+         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc
+
+         IF( ln_bdy .AND. nb_trcobc > 0 ) THEN
+            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings'
+            DO jn = 1, ntrc
+               IF( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
+               IF( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
+            ENDDO
+            WRITE(numout,*) ' '
+            DO ib = 1, nb_bdy
+                IF(nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers'
+                IF(nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided'
+                IF(nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers'
+                IF(nn_trcdmp_bdy(ib) .GT. 0) THEN
+                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : '
+                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days'
+                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days'
+                ENDIF
+            ENDDO
+         ENDIF
+
+         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc)
+      ENDIF
+9001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13)
+9002  FORMAT(2x,i5, 3x, a41, 3x, 10a13)
+9003  FORMAT(a, i5, a)
+
+      !
+      ! OPEN Lateral boundary conditions
+      IF( ln_bdy .AND. nb_trcobc > 0 ) THEN 
+         ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 )
+         IF( ierr1 > 0 ) THEN
+            CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' )   ;   RETURN
+         ENDIF
+
+         igrd = 1                       ! Everything is at T-points here
+
+         DO jn = 1, ntrc
+            DO ib = 1, nb_bdy
+
+               nblen = idx_bdy(ib)%nblen(igrd)
+
+               IF ( ln_trc_obc(jn) ) THEN
+               ! Initialise from external data
+                  jl = n_trc_indobc(jn)
+                  slf_i(jl)    = sn_trcobc(jn)
+                  rf_trofac(jl) = rn_trofac(jn)
+                                               ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 )
+                  IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 )
+                  IF( ierr2 + ierr3 > 0 ) THEN
+                    CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' )   ;   RETURN
+                  ENDIF
+                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:)
+                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl)
+                  ! create OBC mapping array
+                  nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd)
+                  nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd)
+               ELSE
+               ! Initialise obc arrays from initial conditions
+                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) )
+                  DO ibd = 1, nblen
+                     DO ik = 1, jpkm1
+                        ii = idx_bdy(ib)%nbi(ibd,igrd)
+                        ij = idx_bdy(ib)%nbj(ibd,igrd)
+                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik)
+                     END DO
+                  END DO
+                  trcdta_bdy(jn,ib)%rn_fac = 1._wp
+               ENDIF
+            ENDDO
+         ENDDO
+
+         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' )
+      ENDIF
+
+      ! SURFACE Boundary conditions
+      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
+         ALLOCATE( sf_trcsbc(nb_trcsbc), rf_trsfac(nb_trcsbc), STAT=ierr1 )
+         IF( ierr1 > 0 ) THEN
+            CALL ctl_stop( 'trc_bc_ini: unable to allocate  sf_trcsbc structure' )   ;   RETURN
+         ENDIF
+         !
+         DO jn = 1, ntrc
+            IF( ln_trc_sbc(jn) ) THEN      ! update passive tracers arrays with input data read from file
+               jl = n_trc_indsbc(jn)
+               slf_i(jl)    = sn_trcsbc(jn)
+               rf_trsfac(jl) = rn_trsfac(jn)
+                                            ALLOCATE( sf_trcsbc(jl)%fnow(jpi,jpj,1)   , STAT=ierr2 )
+               IF( sn_trcsbc(jn)%ln_tint )  ALLOCATE( sf_trcsbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 )
+               IF( ierr2 + ierr3 > 0 ) THEN
+                 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer SBC data arrays' )   ;   RETURN
+               ENDIF
+            ENDIF
+            !   
+         ENDDO
+         !                         ! fill sf_trcsbc with slf_i and control print
+         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' )
+         !
+      ENDIF
+      !
+      ! COSTAL Boundary conditions
+      IF( nb_trccbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
+         ALLOCATE( sf_trccbc(nb_trccbc), rf_trcfac(nb_trccbc), STAT=ierr1 )
+         IF( ierr1 > 0 ) THEN
+            CALL ctl_stop( 'trc_bc_ini: unable to allocate  sf_trccbc structure' )   ;   RETURN
+         ENDIF
+         !
+         DO jn = 1, ntrc
+            IF( ln_trc_cbc(jn) ) THEN      ! update passive tracers arrays with input data read from file
+               jl = n_trc_indcbc(jn)
+               slf_i(jl)    = sn_trccbc(jn)
+               rf_trcfac(jl) = rn_trcfac(jn)
+                                            ALLOCATE( sf_trccbc(jl)%fnow(jpi,jpj,1)   , STAT=ierr2 )
+               IF( sn_trccbc(jn)%ln_tint )  ALLOCATE( sf_trccbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 )
+               IF( ierr2 + ierr3 > 0 ) THEN
+                 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer CBC data arrays' )   ;   RETURN
+               ENDIF
+            ENDIF
+            !   
+         ENDDO
+         !                         ! fill sf_trccbc with slf_i and control print
+         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' )
+         !
+      ENDIF
+      !
+      DEALLOCATE( slf_i )          ! deallocate local field structure
+      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_ini')
+      !
+   END SUBROUTINE trc_bc_ini
+
+
+   SUBROUTINE trc_bc(kt, jit)
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_bc  ***
+      !!
+      !! ** Purpose :  Apply Boundary Conditions data to tracers
+      !!
+      !! ** Method  :  1) Read BC inputs and update data structures using fldread
+      !!               2) Apply Boundary Conditions to tracers
+      !!              
+      !!----------------------------------------------------------------------
+      USE fldread
+      
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index
+      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option)
+      !!
+      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index
+      REAL(wp) :: zfact, zrnf
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_bc')
+
+      IF( kt == nit000 .AND. lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      ! 1. Update Boundary conditions data
+      IF ( PRESENT(jit) ) THEN 
+
+         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step)
+         IF( nb_trcobc > 0 ) THEN
+           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1)
+         ENDIF
+
+         ! SURFACE boundary conditions
+         IF( nb_trcsbc > 0 ) THEN
+           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit)
+         ENDIF
+
+         ! COASTAL boundary conditions
+         IF( nb_trccbc > 0 ) THEN
+           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit)
+         ENDIF
+
+      ELSE
+
+         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step)
+         IF( nb_trcobc > 0 ) THEN
+           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1)
+         ENDIF
+
+         ! SURFACE boundary conditions
+         IF( nb_trcsbc > 0 ) THEN
+           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc)
+         ENDIF
+
+         ! COASTAL boundary conditions
+         IF( nb_trccbc > 0 ) THEN
+           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
+           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc)
+         ENDIF
+
+      ENDIF
+
+      ! 2. Apply Boundary conditions data
+      ! 
+      DO jn = 1 , jptra
+         !
+         ! Remove river dilution for tracers with absent river load
+         IF ( ln_rnf_ctl .AND. .NOT. ln_trc_cbc(jn) ) THEN
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1
+                  DO jk = 1, nk_rnf(ji,jj)
+                     zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj)
+                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
+          
+         ! OPEN boundary conditions: trcbdy is called in trcnxt !
+
+         ! SURFACE boundary conditions
+         IF (ln_trc_sbc(jn)) THEN
+            jl = n_trc_indsbc(jn)
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time )
+                  tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact
+               END DO
+            END DO
+         END IF
+
+         ! COASTAL boundary conditions
+         IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN
+            jl = n_trc_indcbc(jn)
+            DO jj = 2, jpj
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  DO jk = 1, nk_rnf(ji,jj)
+                     zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time ) 
+                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact
+                  ENDDO
+               END DO
+            END DO
+         END IF
+         !                                                       ! ===========
+      END DO                                                     ! tracer loop
+      !                                                          ! ===========
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_bc')
+      !
+   END SUBROUTINE trc_bc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                              NO 3D passive tracer data
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_bc_ini( ntrc )        ! Empty routine
+      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
+      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bc_ini
+
+   SUBROUTINE trc_bc( kt )        ! Empty routine
+      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bc
+#endif
+
+   !!======================================================================
+END MODULE trcbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90	(revision 8732)
@@ -0,0 +1,139 @@
+MODULE trcbdy
+   !!======================================================================
+   !!                       ***  MODULE  bdytrc  ***
+   !! Ocean tracers:   Apply boundary conditions for tracers in TOP component
+   !!======================================================================
+   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
+   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications
+   !!            3.6  !  2015     (T. Lovato) Adapt BDY for tracers in TOP component
+   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   trc_bdy       : Apply open boundary conditions & damping to tracers
+   !!----------------------------------------------------------------------
+   USE timing                       ! Timing
+   USE oce_trc                      ! ocean dynamics and tracers variables
+   USE par_trc
+   USE trc                          ! ocean space and time domain variables 
+   USE bdylib                       ! for orlanski library routines
+   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager               ! I/O manager
+   USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_bdy      ! routine called in trcnxt.F90 
+   PUBLIC trc_bdy_dmp  ! routine called in trcstp.F90 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_bdy( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE trc_bdy  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for TOP tracers
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt     ! Main time step counter
+      !!
+      INTEGER                           :: ib_bdy ,jn ,igrd ! Loop indeces
+      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc
+      REAL(wp), POINTER                 ::  zfac
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('trc_bdy')
+      !
+      igrd = 1 
+      !
+      DO ib_bdy=1, nb_bdy
+         DO jn = 1, jptra
+            !
+            ztrc => trcdta_bdy(jn,ib_bdy)%trc 
+            zfac => trcdta_bdy(jn,ib_bdy)%rn_fac
+            !
+            SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) )
+            CASE('none'        )   ;   CYCLE
+            CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
+            CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac )
+            CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )
+            CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. )
+            CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. )
+            CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' )
+            END SELECT
+            ! Boundary points should be updated
+            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy )
+            !
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy')
+
+   END SUBROUTINE trc_bdy
+
+   SUBROUTINE trc_bdy_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE trc_bdy_dmp  ***
+      !!                    
+      !! ** Purpose : Apply damping for tracers at open boundaries.
+      !!             It currently applies the damping to all tracers!!!
+      !! 
+      !!----------------------------------------------------------------------
+      INTEGER,         INTENT(in) ::   kt
+      !! 
+      INTEGER  ::   jn             ! Tracer index
+      REAL(wp) ::   zwgt           ! boundary weight
+      REAL(wp) ::   zta, zsa, ztime
+      INTEGER  ::   ib, ik, igrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! 2D addresses
+      INTEGER  ::   ib_bdy         ! Loop index
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('trc_bdy_dmp')
+      !
+      DO jn = 1, jptra
+         DO ib_bdy=1, nb_bdy
+            IF ( trcdta_bdy(jn, ib_bdy)%dmp ) THEN
+               igrd = 1                       ! Everything is at T-points here
+               DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd)
+                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
+                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
+                  zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
+                  DO ik = 1, jpkm1
+                     zta = zwgt * ( trcdta_bdy(jn, ib_bdy)%trc(ib,ik) - trb(ii,ij,ik,jn) ) * tmask(ii,ij,ik)
+                     tra(ii,ij,ik,jn) = tra(ii,ij,ik,jn) + zta
+                  END DO
+               END DO
+            ENDIF
+         ENDDO
+      ENDDO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy_dmp')
+      !
+   END SUBROUTINE trc_bdy_dmp
+ 
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Unstruct Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_bdy(kt)      ! Empty routine
+      WRITE(*,*) 'trc_bdy: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bdy
+
+   SUBROUTINE trc_bdy_dmp(kt)      ! Empty routine
+      WRITE(*,*) 'trc_bdy_dmp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bdy_dmp
+
+#endif
+
+   !!======================================================================
+END MODULE trcbdy
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 8732)
@@ -0,0 +1,263 @@
+MODULE trcdta
+   !!======================================================================
+   !!                     ***  MODULE  trcdta  ***
+   !! TOP :  reads passive tracer data 
+   !!=====================================================================
+   !! History :   1.0  !  2002-04  (O. Aumont)  original code
+   !!              -   !  2004-03  (C. Ethe)  module
+   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90
+   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation 
+   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models
+   !!            3.6   !  2015-03  (T. Lovato) revisit code I/O
+   !!----------------------------------------------------------------------
+#if defined key_top 
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP model 
+   !!----------------------------------------------------------------------
+   !!   trc_dta    : read and time interpolated passive tracer data
+   !!----------------------------------------------------------------------
+   USE par_trc       !  passive tracers parameters
+   USE oce_trc       !  shared variables between ocean and passive tracers
+   USE trc           !  passive tracers common variables
+   USE iom           !  I/O manager
+   USE lib_mpp       !  MPP library
+   USE fldread       !  read input fields
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
+   PUBLIC   trc_dta_ini     ! called in trcini.F90 
+
+   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data
+   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data
+   INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
+   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values
+!$AGRIF_DO_NOT_TREAT
+   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
+!$AGRIF_END_DO_NOT_TREAT
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_dta_ini(ntrc)
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dta_ini  ***
+      !!                    
+      !! ** Purpose :   initialisation of passive tracer input data 
+      !! 
+      !! ** Method  : - Read namtsd namelist
+      !!              - allocates passive tracer data structure 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER,INTENT(IN) :: ntrc                             ! number of tracers
+      INTEGER            :: jl, jn                           ! dummy loop indices
+      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers
+      INTEGER            :: ios                              ! Local integer output status for namelist read
+      CHARACTER(len=100) :: clndta, clntrc
+      REAL(wp)           :: zfact
+      !
+      CHARACTER(len=100)            :: cn_dir
+      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
+      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
+      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trfac    ! multiplicative factor for tracer values
+      !!
+      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dta_ini')
+      !
+      IF( lwp ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '  trc_dta_ini : Tracers Initial Conditions (IC)'
+         WRITE(numout,*) '  ~~~~~~~~~~~ '
+      ENDIF
+      !
+      !  Initialisation
+      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  
+      ! Compute the number of tracers to be initialised with data
+      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
+      IF( ierr0 > 0 ) THEN
+         CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' )   ;   RETURN
+      ENDIF
+      nb_trcdta      = 0
+      n_trc_index(:) = 0
+      DO jn = 1, ntrc
+         IF( ln_trc_ini(jn) ) THEN
+             nb_trcdta       = nb_trcdta + 1 
+             n_trc_index(jn) = nb_trcdta 
+         ENDIF
+      ENDDO
+      !
+      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
+         WRITE(numout,*) ' '
+      ENDIF
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
+      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
+      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_dta )
+
+      IF( lwp ) THEN
+         DO jn = 1, ntrc
+            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true
+               clndta = TRIM( sn_trcdta(jn)%clvar ) 
+               clntrc = TRIM( ctrcnm   (jn)       ) 
+               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
+               zfact  = rn_trfac(jn)
+               IF( clndta /=  clntrc ) THEN 
+                  CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation    ',   &
+                  &              'Input name of data file : '//TRIM(clndta)//   &
+                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
+               ENDIF
+               WRITE(numout,*) ' '
+               WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', &
+               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
+            ENDIF
+         END DO
+      ENDIF
+      !
+      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
+         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
+         IF( ierr1 > 0 ) THEN
+            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
+         ENDIF
+         !
+         DO jn = 1, ntrc
+            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
+               jl = n_trc_index(jn)
+               slf_i(jl)    = sn_trcdta(jn)
+               rf_trfac(jl) = rn_trfac(jn)
+                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
+               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+               IF( ierr2 + ierr3 > 0 ) THEN
+                 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' )   ;   RETURN
+               ENDIF
+            ENDIF
+            !   
+         ENDDO
+         !                         ! fill sf_trcdta with slf_i and control print
+         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' )
+         !
+      ENDIF
+      !
+      DEALLOCATE( slf_i )          ! deallocate local field structure
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_ini')
+      !
+   END SUBROUTINE trc_dta_ini
+
+
+   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dta  ***
+      !!                    
+      !! ** Purpose :   provides passive tracer data at kt
+      !! 
+      !! ** Method  : - call fldread routine
+      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
+      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
+      !!
+      !! ** Action  :   sf_trcdta   passive tracer data on meld mesh and interpolated at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step
+      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read
+      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor
+      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array
+      !
+      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
+      REAL(wp)::   zl, zi
+      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
+      CHARACTER(len=100) :: clndta
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
+      !
+      IF( nb_trcdta > 0 ) THEN
+         !
+         ! read data at kt time step
+         CALL fld_read( kt, 1, sf_trcdta )
+         ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)
+         ! 
+         IF( ln_sco ) THEN                !== s- or mixed s-zps-coordinate  ==!
+            !
+            IF( kt == nit000 .AND. lwp )THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
+            ENDIF
+            DO jj = 1, jpj                         ! vertical interpolation of T & S
+               DO ji = 1, jpi
+                  DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
+                     zl = gdept_n(ji,jj,jk)
+                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
+                        ztp(jk) = ptrcdta(ji,jj,1)
+                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
+                        ztp(jk) = ptrcdta(ji,jj,jpkm1)
+                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+                           IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                              zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                              ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
+                           ENDIF
+                        END DO
+                     ENDIF
+                  END DO
+                  DO jk = 1, jpkm1
+                     ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+                  END DO
+                  ptrcdta(ji,jj,jpk) = 0._wp
+                END DO
+            END DO
+            ! 
+         ELSE                                !==   z- or zps- coordinate   ==!
+            ! zps-coordinate (partial steps) interpolation at the last ocean level
+            IF( ln_zps ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ik = mbkt(ji,jj) 
+                     IF( ik > 1 ) THEN
+                        zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)
+                     ENDIF
+                     ik = mikt(ji,jj)
+                     IF( ik > 1 ) THEN
+                        zl = ( gdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
+                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)
+                     ENDIF
+                  END DO
+              END DO
+            ENDIF
+            !
+         ENDIF
+         !
+         ! Scale by multiplicative factor
+         ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
+      !
+   END SUBROUTINE trc_dta
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                              NO 3D passive tracer data
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! Empty routine
+      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_dta
+#endif
+
+   !!======================================================================
+END MODULE trcdta
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcice.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcice.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcice.F90	(revision 8732)
@@ -0,0 +1,131 @@
+MODULE trcice
+   !!======================================================================
+   !!                         ***  MODULE trcice  ***
+   !! TOP :   Manage the communication between TOP and sea ice
+   !!======================================================================
+   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ice   :  Call the appropriate sea ice tracer subroutine
+   !!----------------------------------------------------------------------
+
+   USE oce_trc         ! shared variables between ocean and passive tracers
+   USE trc             ! passive tracers common variables
+   USE trcice_cfc      ! CFC      initialisation
+   USE trcice_pisces   ! PISCES   initialisation
+   USE trcice_c14      ! C14 bomb initialisation
+   USE trcice_age      ! aGE initialisation
+   USE trcice_my_trc   ! MY_TRC   initialisation
+   
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   trc_ice_ini ! called by trc_nam
+
+CONTAINS
+   
+   SUBROUTINE trc_ice_ini
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ice_ini ***
+      !!
+      !! ** Purpose :   Initialization of the ice module for tracers
+      !!
+      !! ** Method  : - 
+      !!            
+      !!---------------------------------------------------------------------
+      ! --- Variable declarations --- !
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_ice_ini : Initialize sea ice tracer boundary condition'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_ice_ini')
+      !
+      CALL trc_nam_ice
+      !
+      trc_i(:,:,:) = 0.0d0 ! by default
+      trc_o(:,:,:) = 0.0d0 ! by default
+
+      IF ( nn_ice_tr == 1 ) THEN
+         IF( ln_pisces  )    CALL trc_ice_ini_pisces       ! PISCES  bio-model
+         IF( ll_cfc     )    CALL trc_ice_ini_cfc          ! CFC     tracers
+         IF( ln_c14     )    CALL trc_ice_ini_c14          ! C14     tracer
+         IF( ln_age     )    CALL trc_ice_ini_age          ! AGE     tracer
+         IF( ln_my_trc  )    CALL trc_ice_ini_my_trc       ! MY_TRC  tracers
+      ENDIF
+
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ice_ini')
+      !
+   END SUBROUTINE trc_ice_ini
+
+   SUBROUTINE trc_nam_ice
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam_ice ***
+      !!
+      !! ** Purpose :   Read the namelist for the ice effect on tracers
+      !!
+      !! ** Method  : -
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER :: jn      ! dummy loop indices
+      INTEGER :: ios, ierr     ! Local integer output status for namelist read
+      !
+      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer
+      !!
+      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice')
+
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
+      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
+ 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
+      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
+ 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
+
+      IF( lwp ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
+         WRITE(numout,*) ' '
+      ENDIF
+      !
+      ! Assign namelist stuff
+      DO jn = 1, jptra
+         trc_ice_ratio (jn) = sn_tri_tracer(jn)%trc_ratio
+         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
+         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
+      END DO
+
+      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice')
+      !
+   END SUBROUTINE trc_nam_ice
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ice_ini                   ! Dummy routine   
+   END SUBROUTINE trc_ice_ini
+
+   SUBROUTINE trc_nam_ice
+   END SUBROUTINE trc_nam_ice
+
+#endif
+
+   !!======================================================================
+END MODULE trcice
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 8732)
@@ -0,0 +1,300 @@
+MODULE trcini
+   !!======================================================================
+   !!                         ***  MODULE trcini  ***
+   !! TOP :   Manage the passive tracer initialization
+   !!======================================================================
+   !! History :   -   ! 1991-03 (O. Marti)  original code
+   !!            1.0  ! 2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture
+   !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_init  :   Initialization for passive tracer
+   !!   top_alloc :   allocate the TOP arrays
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! shared variables between ocean and passive tracers
+   USE trc             ! passive tracers common variables
+   USE trcnam          ! Namelist read
+   USE daymod          ! calendar manager
+   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
+   USE trcsub          ! variables to substep passive tracers
+   USE trcrst
+   USE lib_mpp         ! distribued memory computing library
+   USE trcice          ! tracers in sea ice
+   USE trcbc,   only : trc_bc_ini ! generalized Boundary Conditions
+ 
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   trc_init   ! called by opa
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE trc_init
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_init  ***
+      !!
+      !! ** Purpose :   Initialization of the passive tracer fields 
+      !!
+      !! ** Method  : - read namelist
+      !!              - control the consistancy 
+      !!              - compute specific initialisations
+      !!              - set initial tracer fields (either read restart 
+      !!                or read data or analytical formulation
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      !
+      CALL trc_ini_ctl   ! control 
+      CALL trc_nam       ! read passive tracers namelists
+      CALL top_alloc()   ! allocate TOP arrays
+      !
+      IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE.
+      !
+      IF(lwp) WRITE(numout,*)
+      IF( ln_rsttr .AND. .NOT. l_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
+      IF(lwp) WRITE(numout,*)
+      !
+      CALL trc_ini_sms   ! SMS
+      CALL trc_ini_inv   ! Inventories
+      CALL trc_ini_trp   ! passive tracers transport
+      CALL trc_ice_ini   ! Tracers in sea ice
+      !
+      IF(lwp) CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
+      !
+      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim
+      IF( nn_dttrc /= 1 ) &
+      CALL trc_sub_ini    ! Initialize variables for substepping passive tracers
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
+      !
+   END SUBROUTINE trc_init
+
+
+   SUBROUTINE trc_ini_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_ctl  ***
+      !! ** Purpose :        Control  + ocean volume
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk    ! dummy loop indices
+      !
+      ! Define logical parameter ton control dirunal cycle in TOP
+      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
+      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. l_offline
+      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   &
+         &                           'Computation of a daily mean shortwave for some biogeochemical models ' )
+      !
+   END SUBROUTINE trc_ini_ctl
+
+
+   SUBROUTINE trc_ini_inv
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_stat  ***
+      !! ** Purpose :      passive tracers inventories at initialsation phase
+      !!----------------------------------------------------------------------
+      INTEGER ::  jk, jn    ! dummy loop indices
+      CHARACTER (len=25) :: charout
+      !!----------------------------------------------------------------------
+      !                                                              ! masked grid volume
+      DO jk = 1, jpk
+         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
+      END DO
+      !                                                              ! total volume of the ocean 
+      areatot = glob_sum( cvol(:,:,:) )
+      !
+      trai(:) = 0._wp                                                   ! initial content of all tracers
+      DO jn = 1, jptra
+         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+      END DO
+
+      IF(lwp) THEN               ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '  *** Total number of passive tracer jptra = ', jptra
+         WRITE(numout,*) '  *** Total volume of ocean                = ', areatot
+         WRITE(numout,*) '  *** Total inital content of all tracers '
+         WRITE(numout,*)
+         DO jn = 1, jptra
+            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
+         ENDDO
+         WRITE(numout,*)
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
+         CALL prt_ctl_trc_init
+         WRITE(charout, FMT="('ini ')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+9000  FORMAT('  tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
+      !
+   END SUBROUTINE trc_ini_inv
+
+
+   SUBROUTINE trc_ini_sms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_sms  ***
+      !! ** Purpose :   SMS initialisation
+      !!----------------------------------------------------------------------
+      USE trcini_pisces  ! PISCES   initialisation
+      USE trcini_cfc     ! CFC      initialisation
+      USE trcini_c14     ! C14  initialisation
+      USE trcini_age     ! age initialisation
+      USE trcini_my_trc  ! MY_TRC   initialisation
+      !
+      INTEGER :: jn
+      !!----------------------------------------------------------------------
+      !
+      ! Pass sn_tracer fields to specialized arrays 
+      DO jn = 1, jp_bgc
+         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname )
+         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname )
+         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
+         ln_trc_ini(jn) =       sn_tracer(jn)%llinit
+         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc
+         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc
+         ln_trc_obc(jn) =       sn_tracer(jn)%llobc
+      END DO
+      !    
+      IF( ln_pisces  )   CALL trc_ini_pisces     !  PISCES model
+      IF( ln_my_trc  )   CALL trc_ini_my_trc     !  MY_TRC model
+      IF( ll_cfc     )   CALL trc_ini_cfc        !  CFC's
+      IF( ln_c14     )   CALL trc_ini_c14        !  C14 model
+      IF( ln_age     )   CALL trc_ini_age        !  AGE
+      !
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_init: Summary for selected passive tracers'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+         WRITE(numout,*) ' ID     NAME     INI  SBC  CBC  OBC'
+         DO jn = 1, jptra
+            WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn)
+         END DO
+      ENDIF
+9001  FORMAT(1x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2)
+      !
+   END SUBROUTINE trc_ini_sms
+
+   SUBROUTINE trc_ini_trp
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_trp  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!----------------------------------------------------------------------
+      USE trcdmp , ONLY:  trc_dmp_ini
+      USE trcadv , ONLY:  trc_adv_ini
+      USE trcldf , ONLY:  trc_ldf_ini
+      USE trczdf , ONLY:  trc_zdf_ini
+      USE trcrad , ONLY:  trc_rad_ini
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping
+                       CALL  trc_adv_ini          ! advection
+                       CALL  trc_ldf_ini          ! lateral diffusion
+                       CALL  trc_zdf_ini          ! vertical diffusion
+                       CALL  trc_rad_ini          ! positivity of passive tracers 
+      !
+   END SUBROUTINE trc_ini_trp
+
+
+   SUBROUTINE trc_ini_state
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ini_state ***
+      !! ** Purpose :          Initialisation of passive tracer concentration 
+      !!----------------------------------------------------------------------
+      USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
+      USE trcrst          ! passive tracers restart
+      USE trcdta          ! initialisation from files
+      !
+      INTEGER :: jn, jl   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      ! Initialisation of tracers Initial Conditions
+      IF( ln_trcdta )      CALL trc_dta_ini(jptra)
+
+      ! Initialisation of tracers Boundary Conditions
+      IF( ln_my_trc )     CALL trc_bc_ini(jptra)
+
+      IF( ln_rsttr ) THEN
+        !
+        CALL trc_rst_read              ! restart from a file
+        !
+      ELSE
+        ! Initialisation of tracer from a file that may also be used for damping
+        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN
+            ! update passive tracers arrays with input data read from file
+            DO jn = 1, jptra
+               IF( ln_trc_ini(jn) ) THEN
+                  jl = n_trc_index(jn) 
+                  CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) )
+                  !
+                  ! deallocate data structure if data are not used for damping
+                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN
+                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
+                                                  DEALLOCATE( sf_trcdta(jl)%fnow )
+                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta )
+                     !
+                  ENDIF
+               ENDIF
+            ENDDO
+            !
+        ENDIF
+        !
+        trb(:,:,:,:) = trn(:,:,:,:)
+        ! 
+      ENDIF
+ 
+      tra(:,:,:,:) = 0._wp
+      !                                                         ! Partial top/bottom cell: GRADh(trn)
+   END SUBROUTINE trc_ini_state
+
+   SUBROUTINE top_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE top_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!----------------------------------------------------------------------
+      USE trc           , ONLY:   trc_alloc
+      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
+#if defined key_trdmxl_trc 
+      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc
+#endif
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        trc_alloc()
+      ierr = ierr + trd_trc_oce_alloc()
+#if defined key_trdmxl_trc 
+      ierr = ierr + trd_mxl_trc_alloc()
+#endif
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE top_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_init                      ! Dummy routine   
+   END SUBROUTINE trc_init
+#endif
+
+   !!======================================================================
+END MODULE trcini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 8732)
@@ -0,0 +1,310 @@
+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           ! shared variables between ocean and passive tracers
+   USE trc               ! passive tracers common variables
+   USE trd_oce       
+   USE trdtrc_oce
+   USE iom               ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE 
+
+   PUBLIC trc_nam_run  ! called in trcini
+   PUBLIC trc_nam      ! called in trcini
+
+   TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC  :: sn_tracer  ! type of tracer for saving if not key_iomput
+
+   !!----------------------------------------------------------------------
+   !! 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
+      !!                ( (PISCES, CFC, MY_TRC )
+      !!---------------------------------------------------------------------
+      INTEGER  ::   jn                  ! dummy loop indice
+      !
+      IF( .NOT.l_offline )   CALL trc_nam_run     ! Parameters of the run                                  
+      !               
+      CALL trc_nam_trc     ! passive tracer informations
+      !                                        
+      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data
+      !
+      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data
+      !
+
+      IF(lwp) THEN                   ! control print
+         IF( ln_rsttr ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in )
+            WRITE(numout,*)
+         ENDIF
+         IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies '
+            WRITE(numout,*)
+         ENDIF
+         IF( .NOT.ln_trcdta ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '  All the passive tracers are initialised with constant values '
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !
+      rdttrc = rdt * FLOAT( nn_dttrc )          ! passive tracer time-step
+      ! 
+      IF(lwp) THEN                              ! control print
+        WRITE(numout,*) 
+        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc
+        WRITE(numout,*) 
+      ENDIF
+      !
+      IF( l_trdtrc )        CALL trc_nam_trd    ! Passive tracer trends
+      !
+   END SUBROUTINE trc_nam
+
+
+   SUBROUTINE trc_nam_run
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam  ***
+      !!
+      !! ** Purpose :   read options for the passive tracer run (namelist) 
+      !!
+      !!---------------------------------------------------------------------
+      NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, &
+        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
+      !
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL ctl_opn( numnat_ref, 'namelist_top_ref'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      CALL ctl_opn( numnat_cfg, 'namelist_top_cfg'   , 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      IF(lwm) CALL ctl_opn( numont, 'output.namelist.top', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., 1 )
+
+      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
+      READ  ( numnat_ref, namtrc_run, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
+      READ  ( numnat_cfg, namtrc_run, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_run )
+
+      !  computes the first time step of tracer model
+      nittrc000 = nit000 + nn_dttrc - 1
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc_run'
+         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc
+         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr
+         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr
+         WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000
+         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler
+         WRITE(numout,*) ' '
+      ENDIF
+      !
+    END SUBROUTINE trc_nam_run
+
+   SUBROUTINE trc_nam_trc
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam  ***
+      !!
+      !! ** Purpose :   read options for the passive tracer run (namelist) 
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER  ::   ios, ierr, icfc       ! Local integer output status for namelist read
+      !!
+      NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, &
+         &            sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d
+      !!---------------------------------------------------------------------
+      ! Dummy settings to fill tracers data structure
+      !                  !   name   !   title   !   unit   !   init  !   sbc   !   cbc   !   obc  !
+      sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false.)
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables
+      READ  ( numnat_ref, namtrc, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc in configuration namelist : Passive tracer variables
+      READ  ( numnat_cfg, namtrc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc )
+
+      ! Control settings
+      IF( ln_pisces .AND. ln_my_trc )   CALL ctl_stop( 'Choose only ONE BGC model - PISCES or MY_TRC' )
+      IF( .NOT. ln_pisces .AND. .NOT. ln_my_trc )   jp_bgc = 0
+      ll_cfc = ln_cfc11 .OR. ln_cfc12 .OR. ln_sf6
+      !
+      jptra       =  0
+      jp_pisces   =  0    ;   jp_pcs0  =  0    ;   jp_pcs1  = 0
+      jp_my_trc   =  0    ;   jp_myt0  =  0    ;   jp_myt1  = 0
+      jp_cfc      =  0    ;   jp_cfc0  =  0    ;   jp_cfc1  = 0
+      jp_age      =  0    ;   jp_c14   =  0
+      !
+      IF( ln_pisces )  THEN
+         jp_pisces = jp_bgc
+         jp_pcs0   = 1
+         jp_pcs1   = jp_pisces
+      ENDIF
+      IF( ln_my_trc )  THEN
+          jp_my_trc = jp_bgc
+          jp_myt0   = 1
+          jp_myt1   = jp_my_trc
+      ENDIF
+      !
+      jptra  = jp_bgc
+      !
+      IF( ln_age )    THEN
+         jptra     = jptra + 1
+         jp_age    = jptra
+      ENDIF
+      IF( ln_cfc11 )  jp_cfc = jp_cfc + 1
+      IF( ln_cfc12 )  jp_cfc = jp_cfc + 1
+      IF( ln_sf6   )  jp_cfc = jp_cfc + 1
+      IF( ll_cfc )    THEN
+          jptra     = jptra + jp_cfc
+          jp_cfc0   = jptra - jp_cfc + 1
+          jp_cfc1   = jptra
+      ENDIF
+      IF( ln_c14 )    THEN
+           jptra     = jptra + 1
+           jp_c14    = jptra
+      ENDIF
+      !
+      IF( jptra == 0 )   CALL ctl_stop( 'All TOP tracers disabled: change namtrc setting or check if key_top is active' )
+      !
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc'
+         WRITE(numout,*) '   Total number of passive tracers              jptra         = ', jptra
+         WRITE(numout,*) '   Total number of BGC tracers                  jp_bgc        = ', jp_bgc
+         WRITE(numout,*) '   Simulating PISCES model                      ln_pisces     = ', ln_pisces
+         WRITE(numout,*) '   Simulating MY_TRC  model                     ln_my_trc     = ', ln_my_trc
+         WRITE(numout,*) '   Simulating water mass age                    ln_age        = ', ln_age
+         WRITE(numout,*) '   Simulating CFC11 passive tracer              ln_cfc11      = ', ln_cfc11
+         WRITE(numout,*) '   Simulating CFC12 passive tracer              ln_cfc12      = ', ln_cfc12
+         WRITE(numout,*) '   Simulating SF6 passive tracer                ln_sf6        = ', ln_sf6
+         WRITE(numout,*) '   Total number of CFCs tracers                 jp_cfc        = ', jp_cfc
+         WRITE(numout,*) '   Simulating C14   passive tracer              ln_c14        = ', ln_c14
+         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta
+         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp
+         WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' '
+      ENDIF
+      !
+      IF( ll_cfc .OR. ln_c14 ) THEN
+        !                             ! Open namelist files
+        CALL ctl_opn( numtrc_ref, 'namelist_trc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+        CALL ctl_opn( numtrc_cfg, 'namelist_trc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+        IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+        !
+      ENDIF
+
+   END SUBROUTINE trc_nam_trc
+
+   SUBROUTINE trc_nam_trd
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam_dia  ***
+      !!
+      !! ** Purpose :   read options for the passive tracer diagnostics
+      !!
+      !! ** Method  : - read passive tracer namelist 
+      !!              - read namelist of each defined SMS model
+      !!                ( (PISCES, CFC, MY_TRC )
+      !!---------------------------------------------------------------------
+
+#if defined key_trdmxl_trc  || defined key_trdtrc
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      INTEGER ::  ierr
+      !!
+      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
+         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, &
+         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
+      !!---------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_nam_trd : read the passive tracer diagnostics options'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      !
+      ALLOCATE( ln_trdtrc(jptra) ) 
+      !
+      REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends
+      READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905)
+905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp )
+
+      REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends
+      READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 )
+906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numont, namtrc_trd )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mxl_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_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart
+         WRITE(numout,*) '   * flag to diagnose trends of                                 '
+         WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_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
+      !
+   END SUBROUTINE trc_nam_trd
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam                      ! Empty routine   
+   END SUBROUTINE trc_nam
+   SUBROUTINE trc_nam_run                      ! Empty routine   
+   END SUBROUTINE trc_nam_run
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcnam
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 8732)
@@ -0,0 +1,321 @@
+MODULE trcrst
+   !!======================================================================
+   !!                         ***  MODULE trcrst  ***
+   !! TOP :   Manage the passive tracer restart
+   !!======================================================================
+   !! History :    -   !  1991-03  ()  original code
+   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!              -   !  2005-10 (C. Ethe) print control
+   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_rst        : Restart for passive tracer
+   !!   trc_rst_opn    : open  restart file
+   !!   trc_rst_read   : read  restart file
+   !!   trc_rst_wri    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc
+   USE trc
+   USE iom
+   USE daymod
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_rst_opn       ! called by ???
+   PUBLIC   trc_rst_read      ! called by ???
+   PUBLIC   trc_rst_wri       ! called by ???
+   PUBLIC   trc_rst_cal
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.7 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE trc_rst_opn( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_opn  ***
+      !!
+      !! ** purpose  :   output of sea-trc variable in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! number of iteration
+      !
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
+      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
+      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
+      !!----------------------------------------------------------------------
+      !
+      IF( l_offline ) THEN
+         IF( kt == nittrc000 ) THEN
+            lrst_trc = .FALSE.
+            IF( ln_rst_list ) THEN
+               nrst_lst = 1
+               nitrst = nstocklist( nrst_lst )
+            ELSE
+               nitrst = nitend
+            ENDIF
+         ENDIF
+
+         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
+            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
+            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
+            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
+         ENDIF
+      ELSE
+         IF( kt == nittrc000 ) 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 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
+         ! beware of the format used to write kt (default is i8.8, that should be large enough)
+         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
+         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
+         ENDIF
+         ! create the file
+         IF(lwp) WRITE(numout,*)
+         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
+         clpath = TRIM(cn_trcrst_outdir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         IF(lwp) WRITE(numout,*) &
+             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
+         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
+         lrst_trc = .TRUE.
+      ENDIF
+      !
+   END SUBROUTINE trc_rst_opn
+
+   SUBROUTINE trc_rst_read
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_opn  ***
+      !!
+      !! ** purpose  :   read passive tracer fields in restart files
+      !!----------------------------------------------------------------------
+      INTEGER  ::  jn     
+
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ! READ prognostic variables and computes diagnostic variable
+      DO jn = 1, jptra
+         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
+      END DO
+
+      DO jn = 1, jptra
+         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
+      END DO
+      !
+   END SUBROUTINE trc_rst_read
+
+   SUBROUTINE trc_rst_wri( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_wri  ***
+      !!
+      !! ** purpose  :   write passive tracer fields in restart files
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
+      !!
+      INTEGER  :: jn
+      REAL(wp) :: zarak0
+      !!----------------------------------------------------------------------
+      !
+      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step
+      ! prognostic variables 
+      ! -------------------- 
+      DO jn = 1, jptra
+         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
+      END DO
+
+      DO jn = 1, jptra
+         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
+      END DO
+      !
+      IF( kt == nitrst ) THEN
+          CALL trc_rst_stat            ! statistics
+          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
+#if ! defined key_trdmxl_trc
+          lrst_trc = .FALSE.
+#endif
+          IF( l_offline .AND. ln_rst_list ) THEN
+             nrst_lst = nrst_lst + 1
+             nitrst = nstocklist( nrst_lst )
+          ENDIF
+      ENDIF
+      !
+   END SUBROUTINE trc_rst_wri 
+
+
+   SUBROUTINE trc_rst_cal( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_rst_cal  ***
+      !!
+      !!  ** Purpose : Read or write calendar in restart file:
+      !!
+      !!  WRITE(READ) mode:
+      !!       kt        : number of time step since the begining of the experiment at the
+      !!                   end of the current(previous) run
+      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
+      !!                   end of the current(previous) run (REAL -> keep fractions of day)
+      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
+      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      INTEGER  ::  jlibalt = jprstlib
+      LOGICAL  ::  llok
+      REAL(wp) ::  zkt, zrdttrc1
+      REAL(wp) ::  zndastp
+
+      ! Time domain : restart
+      ! ---------------------
+
+      IF( TRIM(cdrw) == 'READ' ) THEN
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+         IF( ln_rsttr ) THEN
+            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
+            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
+
+            IF(lwp) THEN
+               WRITE(numout,*) ' *** Info read in restart : '
+               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+               WRITE(numout,*) ' *** restart option'
+               SELECT CASE ( nn_rsttr )
+               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
+               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
+               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
+               END SELECT
+               WRITE(numout,*)
+            ENDIF
+            ! Control of date 
+            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
+               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
+               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
+         ENDIF
+         !
+         IF( l_offline ) THEN    
+            !                                          ! set the date in offline mode
+            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
+               CALL iom_get( numrtr, 'ndastp', zndastp ) 
+               ndastp = NINT( zndastp )
+               CALL iom_get( numrtr, 'adatrj', adatrj  )
+             ELSE
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
+               adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / 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
+            !
+            IF( ln_rsttr )  THEN   ;    neuler = 1
+            ELSE                   ;    neuler = 0
+            ENDIF
+            !
+            CALL day_init          ! compute calendar
+            !
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF(  kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
+         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+      ENDIF
+
+   END SUBROUTINE trc_rst_cal
+
+
+   SUBROUTINE trc_rst_stat
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_rst_stat  ***
+      !!
+      !! ** purpose  :   Compute tracers statistics
+      !!----------------------------------------------------------------------
+      INTEGER  :: jk, jn
+      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
+      !!----------------------------------------------------------------------
+
+      IF( lwp ) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '           ----TRACER STAT----             '
+         WRITE(numout,*) 
+      ENDIF
+      !
+      DO jk = 1, jpk
+         zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk)
+      END DO
+      !
+      DO jn = 1, jptra
+         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
+         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
+         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
+         IF( lk_mpp ) THEN
+            CALL mpp_min( zmin )      ! min over the global domain
+            CALL mpp_max( zmax )      ! max over the global domain
+         END IF
+         zmean  = ztraf / areatot
+         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
+         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
+      END DO
+      IF(lwp) WRITE(numout,*) 
+9000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
+      &      '    max :',e18.10,'    drift :',e18.10, ' %')
+      !
+   END SUBROUTINE trc_rst_stat
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read                      ! Empty routines
+   END SUBROUTINE trc_rst_read
+   SUBROUTINE trc_rst_wri( kt )
+      INTEGER, INTENT ( in ) :: kt
+      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_rst_wri   
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcrst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 8732)
@@ -0,0 +1,79 @@
+MODULE trcsms
+   !!======================================================================
+   !!                         ***  MODULE trcsms  ***
+   !! TOP :   Time loop of passive tracers sms
+   !!======================================================================
+   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_sms        :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   USE oce_trc            !
+   USE trc                !
+   USE trcsms_pisces      ! PISCES biogeo-model
+   USE trcsms_cfc         ! CFC 11 &/or 12
+   USE trcsms_c14         ! C14 
+   USE trcsms_age         ! AGE
+   USE trcsms_my_trc      ! MY_TRC  tracers
+   USE prtctl_trc         ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms    ! called in trcstp.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms  ***
+      !!
+      !! ** Purpose :   Managment of the time loop of passive tracers sms 
+      !!
+      !! ** Method  : -  call the main routine of of each defined tracer model
+      !! -------------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_sms')
+      !
+      IF( ln_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES 
+      IF( ll_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC
+      IF( ln_c14     )   CALL trc_sms_c14    ( kt )    ! surface fluxes of C14
+      IF( ln_age     )   CALL trc_sms_age    ( kt )    ! Age tracer
+      IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers
+
+      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('sms ')")
+         CALL prt_ctl_trc_info( charout )
+         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_sms')
+      !
+   END SUBROUTINE trc_sms
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                     No passive tracer
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sms( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms
+#endif 
+
+   !!======================================================================
+END MODULE trcsms
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 8732)
@@ -0,0 +1,239 @@
+MODULE trcstp
+   !!======================================================================
+   !!                       ***  MODULE trcstp  ***
+   !! 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
+   !!----------------------------------------------------------------------
+   USE oce_trc          ! ocean dynamics and active tracers variables
+   USE sbc_oce
+   USE trc
+   USE trctrp           ! passive tracers transport
+   USE trcsms           ! passive tracers sources and sinks
+   USE trcwri
+   USE trcrst
+   USE trdtrc_oce
+   USE trdmxl_trc
+   USE prtctl_trc       ! Print control for debbuging
+   USE iom
+   USE in_out_manager
+   USE trcsub
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_stp    ! called by step
+
+   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step
+   REAL(wp) :: rdt_sampl
+   INTEGER  :: nb_rec_per_day, ktdcy
+   REAL(wp) :: rsecfst, rseclast
+   LOGICAL  :: llnew
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_stp( kt )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_stp  ***
+      !!                      
+      !! ** Purpose : Time loop of opa for passive tracer
+      !! 
+      !! ** Method  : 
+      !!              Compute the passive tracers trends 
+      !!              Update the passive tracers
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
+      INTEGER               ::  jk, jn  ! dummy loop indices
+      REAL(wp)              ::  ztrai
+      CHARACTER (len=25)    ::  charout 
+
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_stp')
+      !
+      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
+         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
+         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
+      ENDIF
+      !
+      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
+      !
+      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution
+         DO jk = 1, jpk
+            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)
+         END DO
+         areatot         = glob_sum( cvol(:,:,:) )
+      ENDIF
+      !
+      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
+      !    
+      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping
+      !    
+      IF( MOD( kt , 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
+         !
+                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file 
+         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
+                                   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
+                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
+                                   CALL trc_trp      ( kt )       ! transport of passive tracers
+         IF( kt == nittrc000 ) THEN
+            CALL iom_close( numrtr )       ! close input tracer restart file
+            IF(lwm) CALL FLUSH( numont )   ! flush namelist output
+         ENDIF
+         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
+         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer
+         !
+         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping
+         !
+      ENDIF
+      !
+      ztrai = 0._wp                                                   !  content of all tracers
+      DO jn = 1, jptra
+         ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
+      END DO
+      IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot
+9300  FORMAT(i10,D23.16)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
+      !
+   END SUBROUTINE trc_stp
+
+   SUBROUTINE trc_mean_qsr( kt )
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE trc_mean_qsr  ***
+      !!
+      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
+      !!               of diurnal cycle
+      !!
+      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter 
+      !!              is greater than 1 hour ) and then, compute the  mean with 
+      !!              a moving average over 24 hours. 
+      !!              In coupled mode, the sampling is done at every coupling frequency 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      INTEGER  :: jn
+      REAL(wp) :: zkt, zrec
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 2 characters
+
+      IF( kt == nittrc000 ) THEN
+         IF( ln_cpl )  THEN  
+            rdt_sampl = rday / ncpl_qsr_freq
+            nb_rec_per_day = ncpl_qsr_freq
+         ELSE  
+            rdt_sampl = MAX( 3600., rdttrc )
+            nb_rec_per_day = INT( rday / rdt_sampl )
+         ENDIF
+         !
+         IF( lwp ) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
+            WRITE(numout,*) 
+         ENDIF
+         !
+         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
+         !
+         !                                            !* Restart: read in restart file
+         IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0  &
+           &                              .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0  &
+           &                              .AND. iom_varid( numrtr, 'ktdcy'    , ldstop = .FALSE. ) > 0  &
+           &                              .AND. iom_varid( numrtr, 'nrdcy'    , ldstop = .FALSE. ) > 0  ) THEN
+
+            CALL iom_get( numrtr, 'ktdcy', zkt )  
+            rsecfst = INT( zkt ) * rdttrc
+            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s '
+            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr
+            CALL iom_get( numrtr, 'nrdcy', zrec )   !  Number of record per days
+            IF( INT( zrec ) == nb_rec_per_day ) THEN
+               DO jn = 1, nb_rec_per_day 
+                  IF( jn <= 9 )  THEN
+                    WRITE(cl1,'(i1)') jn
+                    CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr
+                  ELSE
+                    WRITE(cl2,'(i2.2)') jn
+                    CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr
+                  ENDIF
+              ENDDO
+            ELSE
+               DO jn = 1, nb_rec_per_day
+                  qsr_arr(:,:,jn) = qsr_mean(:,:)
+               ENDDO
+            ENDIF
+         ELSE                                         !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
+            rsecfst  = kt * rdttrc
+            !
+            qsr_mean(:,:) = qsr(:,:)
+            DO jn = 1, nb_rec_per_day
+               qsr_arr(:,:,jn) = qsr_mean(:,:)
+            ENDDO
+         ENDIF
+         !
+      ENDIF
+      !
+      rseclast = kt * rdttrc
+      !
+      llnew   = ( rseclast - rsecfst ) .ge.  rdt_sampl    !   new shortwave to store
+      IF( llnew ) THEN
+          ktdcy = kt
+          IF( lwp .AND. kt < nittrc000 + 100 ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', ktdcy, &
+             &                      ' time = ', rseclast/3600.,'hours '
+          rsecfst = rseclast
+          DO jn = 1, nb_rec_per_day - 1
+             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
+          ENDDO
+          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
+          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
+      ENDIF
+      !
+      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         zkt  = REAL( ktdcy, wp )
+         zrec = REAL( nb_rec_per_day, wp )
+         CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt  )
+         CALL iom_rstput( kt, nitrst, numrtw, 'nrdcy', zrec )
+          DO jn = 1, nb_rec_per_day 
+             IF( jn <= 9 )  THEN
+               WRITE(cl1,'(i1)') jn
+               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
+             ELSE
+               WRITE(cl2,'(i2.2)') jn
+               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
+             ENDIF
+         ENDDO
+         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
+      ENDIF
+      !
+   END SUBROUTINE trc_mean_qsr
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO passive tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_stp( kt )        ! Empty routine
+      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_stp
+#endif
+
+   !!======================================================================
+END MODULE trcstp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 8732)
@@ -0,0 +1,594 @@
+MODULE trcsub
+   !!======================================================================
+   !!                       ***  MODULE trcsubstp  ***
+   !!TOP :   Averages physics variables for TOP substepping. 
+   !!======================================================================
+   !! History :  1.0  !  2011-10  (K. Edwards)  Original
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   trc_sub    : passive tracer system sub-stepping 
+   !!----------------------------------------------------------------------
+   USE oce_trc          ! ocean dynamics and active tracers variables
+   USE trc
+   USE prtctl_trc       ! Print control for debbuging
+   USE iom
+   USE in_out_manager
+   USE lbclnk
+   USE trabbl
+   USE zdf_oce
+   USE domvvl
+   USE divhor          ! horizontal divergence            (div_hor routine)
+   USE sbcrnf    , ONLY: h_rnf, nk_rnf    ! River runoff
+   USE bdy_oce   , ONLY: ln_bdy, bdytmask ! BDY
+#if defined key_agrif
+   USE agrif_opa_update
+   USE agrif_opa_interp
+#endif
+
+   IMPLICIT NONE
+
+   PUBLIC   trc_sub_stp      ! called by trc_stp
+   PUBLIC   trc_sub_ini      ! called by trc_ini to initialize substepping arrays.
+   PUBLIC   trc_sub_reset    ! called by trc_stp to reset physics variables
+   PUBLIC   trc_sub_ssh      ! called by trc_stp to reset physics variables
+
+   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc 
+   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1) 
+
+   !                                                       !* iso-neutral slopes (if l_ldfslp=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sub_stp( kt )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_stp  ***
+      !!                      
+      !! ** Purpose : Average variables needed for sub-stepping passive tracers
+      !! 
+      !! ** Method  : Called every timestep to increment _tm (time mean) variables
+      !!              on TOP steps, calculate averages.
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt        ! ocean time-step index
+      INTEGER               ::  ji,jj,jk  ! dummy loop indices
+      REAL(wp)              ::  z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_stp')
+      !
+      IF( kt == nit000 ) THEN
+           IF(lwp) WRITE(numout,*)
+           IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
+           IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+           !
+           sshb_hold  (:,:) = sshn  (:,:)
+           emp_b_hold (:,:) = emp_b (:,:)
+           !
+           r1_ndttrc        = 1._wp / REAL( nn_dttrc    , wp ) 
+           r1_ndttrcp1      = 1._wp / REAL( nn_dttrc + 1, wp )
+           !
+      ENDIF  
+
+       IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
+          !
+          un_tm   (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:) 
+          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:) 
+          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)  
+          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+         IF( l_ldfslp ) THEN
+            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:)
+            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:)
+            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:)
+            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:)
+         ENDIF
+# if defined key_trabbl
+          IF( nn_bbl_ldf == 1 ) THEN
+             ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:) 
+             ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:) 
+          ENDIF
+          IF( nn_bbl_adv == 1 ) THEN
+             utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:) 
+             vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:) 
+          ENDIF
+# endif
+          !
+          sshn_tm  (:,:)         = sshn_tm  (:,:)         + sshn  (:,:) 
+          rnf_tm   (:,:)         = rnf_tm   (:,:)         + rnf   (:,:) 
+          h_rnf_tm (:,:)         = h_rnf_tm (:,:)         + h_rnf (:,:) 
+          hmld_tm  (:,:)         = hmld_tm  (:,:)         + hmld  (:,:)
+          fr_i_tm  (:,:)         = fr_i_tm  (:,:)         + fr_i  (:,:)
+          emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:) 
+          fmmflx_tm(:,:)         = fmmflx_tm(:,:)         + fmmflx(:,:)
+          qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
+          wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:)
+
+      ELSE                           !  It is time to substep 
+         !   1. set temporary arrays to hold physics variables
+         un_temp    (:,:,:)      = un    (:,:,:)
+         vn_temp    (:,:,:)      = vn    (:,:,:)
+         wn_temp    (:,:,:)      = wn    (:,:,:)
+         tsn_temp   (:,:,:,:)    = tsn   (:,:,:,:)
+         rhop_temp  (:,:,:)      = rhop  (:,:,:)    
+         avt_temp   (:,:,:)      = avt   (:,:,:)
+# if defined key_zdfddm
+         avs_temp   (:,:,:)      = avs   (:,:,:)
+# endif
+         IF( l_ldfslp ) THEN
+            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:)
+            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:)
+         ENDIF
+# if defined key_trabbl
+          IF( nn_bbl_ldf == 1 ) THEN
+             ahu_bbl_temp(:,:)   = ahu_bbl(:,:)  
+             ahv_bbl_temp(:,:)   = ahv_bbl(:,:) 
+          ENDIF
+          IF( nn_bbl_adv == 1 ) THEN
+             utr_bbl_temp(:,:)   = utr_bbl(:,:) 
+             vtr_bbl_temp(:,:)   = vtr_bbl(:,:) 
+          ENDIF
+# endif
+         sshn_temp  (:,:)        = sshn  (:,:)
+         sshb_temp  (:,:)        = sshb  (:,:)
+         ssha_temp  (:,:)        = ssha  (:,:)
+         rnf_temp   (:,:)        = rnf   (:,:)
+         h_rnf_temp (:,:)        = h_rnf (:,:)
+         hmld_temp  (:,:)        = hmld  (:,:)
+         fr_i_temp  (:,:)        = fr_i  (:,:)
+         emp_temp   (:,:)        = emp   (:,:)
+         emp_b_temp (:,:)        = emp_b (:,:)
+         fmmflx_temp(:,:)        = fmmflx(:,:)
+         qsr_temp   (:,:)        = qsr   (:,:)
+         wndm_temp  (:,:)        = wndm  (:,:)
+         !                                    !  Variables reset in trc_sub_ssh
+         hdivn_temp (:,:,:)      = hdivn (:,:,:)
+         !
+         ! 2. Create averages and reassign variables
+         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_n(:,:,:) 
+         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_n(:,:,:) 
+         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_n(:,:,:)  
+         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+         IF( l_ldfslp ) THEN
+            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:) 
+            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:)
+            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
+            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
+         ENDIF
+# if defined key_trabbl
+          IF( nn_bbl_ldf == 1 ) THEN
+             ahu_bbl_tm(:,:)     = ahu_bbl_tm(:,:)        + ahu_bbl(:,:) 
+             ahv_bbl_tm(:,:)     = ahv_bbl_tm(:,:)        + ahv_bbl(:,:) 
+          ENDIF
+          IF( nn_bbl_adv == 1 ) THEN
+             utr_bbl_tm(:,:)     = utr_bbl_tm(:,:)        + utr_bbl(:,:) 
+             vtr_bbl_tm(:,:)     = vtr_bbl_tm(:,:)        + vtr_bbl(:,:) 
+          ENDIF
+# endif
+         sshn_tm  (:,:)          = sshn_tm    (:,:)       + sshn  (:,:) 
+         rnf_tm   (:,:)          = rnf_tm     (:,:)       + rnf   (:,:) 
+         h_rnf_tm (:,:)          = h_rnf_tm   (:,:)       + h_rnf (:,:) 
+         hmld_tm  (:,:)          = hmld_tm    (:,:)       + hmld  (:,:)
+         fr_i_tm  (:,:)          = fr_i_tm    (:,:)       + fr_i  (:,:)
+         emp_tm   (:,:)          = emp_tm     (:,:)       + emp   (:,:) 
+         fmmflx_tm(:,:)          = fmmflx_tm  (:,:)       + fmmflx(:,:)
+         qsr_tm   (:,:)          = qsr_tm     (:,:)       + qsr   (:,:)
+         wndm_tm  (:,:)          = wndm_tm    (:,:)       + wndm  (:,:)
+         !
+         sshn     (:,:)          = sshn_tm    (:,:) * r1_ndttrcp1 
+         sshb     (:,:)          = sshb_hold  (:,:)
+         rnf      (:,:)          = rnf_tm     (:,:) * r1_ndttrcp1 
+         h_rnf    (:,:)          = h_rnf_tm   (:,:) * r1_ndttrcp1 
+         hmld     (:,:)          = hmld_tm    (:,:) * r1_ndttrcp1 
+         !  variables that are initialized after averages
+         emp_b    (:,:) = emp_b_hold (:,:)
+         IF( kt == nittrc000 ) THEN
+            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrc 
+            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrc 
+            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrc 
+            fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrc 
+            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrc
+# if defined key_trabbl
+            IF( nn_bbl_ldf == 1 ) THEN
+               ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrc  
+               ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrc 
+            ENDIF
+            IF( nn_bbl_adv == 1 ) THEN
+               utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrc  
+               vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrc 
+            ENDIF
+# endif
+         ELSE
+            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrcp1 
+            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrcp1 
+            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrcp1 
+            fmmflx(:,:)          = fmmflx_tm  (:,:) * r1_ndttrcp1 
+            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrcp1 
+# if defined key_trabbl
+            IF( nn_bbl_ldf == 1 ) THEN
+               ahu_bbl(:,:)      = ahu_bbl_tm (:,:) * r1_ndttrcp1  
+               ahv_bbl(:,:)      = ahv_bbl_tm (:,:) * r1_ndttrcp1 
+            ENDIF
+            IF( nn_bbl_adv == 1 ) THEN
+               utr_bbl(:,:)      = utr_bbl_tm (:,:) * r1_ndttrcp1  
+               vtr_bbl(:,:)      = vtr_bbl_tm (:,:) * r1_ndttrcp1 
+            ENDIF
+# endif
+         ENDIF
+         !
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  z1_ne3t = r1_ndttrcp1  / e3t_n(ji,jj,jk)
+                  z1_ne3u = r1_ndttrcp1  / e3u_n(ji,jj,jk)
+                  z1_ne3v = r1_ndttrcp1  / e3v_n(ji,jj,jk)
+                  z1_ne3w = r1_ndttrcp1  / e3w_n(ji,jj,jk)
+                  !
+                  un   (ji,jj,jk)        = un_tm   (ji,jj,jk)        * z1_ne3u
+                  vn   (ji,jj,jk)        = vn_tm   (ji,jj,jk)        * z1_ne3v
+                  tsn  (ji,jj,jk,jp_tem) = tsn_tm  (ji,jj,jk,jp_tem) * z1_ne3t
+                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t
+                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
+                  avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w
+# if defined key_zdfddm
+                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w
+# endif
+               END DO
+            END DO
+         END DO
+         IF( l_ldfslp ) THEN
+            wslpi(:,:,:)        = wslpi_tm(:,:,:) 
+            wslpj(:,:,:)        = wslpj_tm(:,:,:)
+            uslp (:,:,:)        = uslp_tm (:,:,:)
+            vslp (:,:,:)        = vslp_tm (:,:,:)
+         ENDIF
+         !
+         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_stp')
+      !
+   END SUBROUTINE trc_sub_stp
+
+
+   SUBROUTINE trc_sub_ini
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sub_ini  ***
+      !!                      
+      !! ** Purpose : Initialize variables needed for sub-stepping passive tracers
+      !! 
+      !! ** Method  : 
+      !!              Compute the averages for sub-stepping
+      !!-------------------------------------------------------------------
+      INTEGER ::   ierr
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_ini')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      ierr =  trc_sub_alloc    ()
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
+
+      un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:) 
+      vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:) 
+      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+      rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)  
+!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w
+      avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+      avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+      IF( l_ldfslp ) THEN
+         wslpi_tm(:,:,:)     = wslpi(:,:,:)
+         wslpj_tm(:,:,:)     = wslpj(:,:,:)
+         uslp_tm (:,:,:)     = uslp (:,:,:)
+         vslp_tm (:,:,:)     = vslp (:,:,:)
+      ENDIF
+      sshn_tm  (:,:) = sshn  (:,:) 
+      rnf_tm   (:,:) = rnf   (:,:) 
+      h_rnf_tm (:,:) = h_rnf (:,:) 
+      hmld_tm  (:,:) = hmld  (:,:)
+
+      ! Physics variables that are set after initialization:
+      fr_i_tm(:,:) = 0._wp
+      emp_tm (:,:) = 0._wp
+      fmmflx_tm(:,:)  = 0._wp
+      qsr_tm (:,:) = 0._wp
+      wndm_tm(:,:) = 0._wp
+# if defined key_trabbl
+      IF( nn_bbl_ldf == 1 ) THEN
+         ahu_bbl_tm(:,:) = 0._wp
+         ahv_bbl_tm(:,:) = 0._wp
+      ENDIF
+      IF( nn_bbl_adv == 1 ) THEN
+         utr_bbl_tm(:,:) = 0._wp
+         vtr_bbl_tm(:,:) = 0._wp
+      ENDIF
+# endif
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ini')
+      !
+   END SUBROUTINE trc_sub_ini
+
+   SUBROUTINE trc_sub_reset( kt )
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sub_reset  ***
+      !!                      
+      !! ** Purpose : Reset physics variables averaged for substepping
+      !! 
+      !! ** Method  : 
+      !!              Compute the averages for sub-stepping
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
+      INTEGER :: jk                 ! dummy loop indices
+      !!-------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_reset')
+      !
+      !   restore physics variables
+      un    (:,:,:)   =  un_temp    (:,:,:)
+      vn    (:,:,:)   =  vn_temp    (:,:,:)
+      wn    (:,:,:)   =  wn_temp    (:,:,:)
+      tsn   (:,:,:,:) =  tsn_temp   (:,:,:,:)
+      rhop  (:,:,:)   =  rhop_temp  (:,:,:)
+      avt   (:,:,:)   =  avt_temp   (:,:,:)
+# if defined key_zdfddm
+      avs   (:,:,:)   =  avs_temp   (:,:,:)
+# endif
+      IF( l_ldfslp ) THEN
+         wslpi (:,:,:)=  wslpi_temp (:,:,:)
+         wslpj (:,:,:)=  wslpj_temp (:,:,:)
+         uslp  (:,:,:)=  uslp_temp  (:,:,:)
+         vslp  (:,:,:)=  vslp_temp  (:,:,:)
+      ENDIF
+      sshn  (:,:)     =  sshn_temp  (:,:)
+      sshb  (:,:)     =  sshb_temp  (:,:)
+      ssha  (:,:)     =  ssha_temp  (:,:)
+      rnf   (:,:)     =  rnf_temp   (:,:)
+      h_rnf (:,:)     =  h_rnf_temp (:,:)
+      !
+      hmld  (:,:)     =  hmld_temp  (:,:)
+      fr_i  (:,:)     =  fr_i_temp  (:,:)
+      emp   (:,:)     =  emp_temp   (:,:)
+      fmmflx(:,:)     =  fmmflx_temp(:,:)
+      emp_b (:,:)     =  emp_b_temp (:,:)
+      qsr   (:,:)     =  qsr_temp   (:,:)
+      wndm  (:,:)     =  wndm_temp  (:,:)
+# if defined key_trabbl
+      IF( nn_bbl_ldf == 1 ) THEN
+         ahu_bbl(:,:) = ahu_bbl_temp(:,:) 
+         ahv_bbl(:,:) = ahv_bbl_temp(:,:) 
+      ENDIF
+      IF( nn_bbl_adv == 1 ) THEN
+         utr_bbl(:,:) = utr_bbl_temp(:,:) 
+         vtr_bbl(:,:) = vtr_bbl_temp(:,:) 
+      ENDIF
+# endif
+      !
+      hdivn (:,:,:)   =  hdivn_temp (:,:,:)
+      !                                      
+      ! Start new averages
+         un_tm   (:,:,:)        = un   (:,:,:)        * e3u_n(:,:,:) 
+         vn_tm   (:,:,:)        = vn   (:,:,:)        * e3v_n(:,:,:) 
+         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * e3t_n(:,:,:)  
+         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * e3t_n(:,:,:)  
+         rhop_tm (:,:,:)        = rhop (:,:,:)        * e3t_n(:,:,:)  
+         avt_tm  (:,:,:)        = avt  (:,:,:)        * e3w_n(:,:,:)  
+# if defined key_zdfddm
+         avs_tm  (:,:,:)        = avs  (:,:,:)        * e3w_n(:,:,:)  
+# endif
+      IF( l_ldfslp ) THEN
+         uslp_tm (:,:,:)        = uslp (:,:,:)
+         vslp_tm (:,:,:)        = vslp (:,:,:)
+         wslpi_tm(:,:,:)        = wslpi(:,:,:) 
+         wslpj_tm(:,:,:)        = wslpj(:,:,:)
+      ENDIF
+      !
+      sshb_hold  (:,:) = sshn  (:,:)
+      emp_b_hold (:,:) = emp   (:,:)
+      sshn_tm    (:,:) = sshn  (:,:) 
+      rnf_tm     (:,:) = rnf   (:,:) 
+      h_rnf_tm   (:,:) = h_rnf (:,:) 
+      hmld_tm    (:,:) = hmld  (:,:)
+      fr_i_tm    (:,:) = fr_i  (:,:)
+      emp_tm     (:,:) = emp   (:,:)
+      fmmflx_tm  (:,:) = fmmflx(:,:)
+      qsr_tm     (:,:) = qsr   (:,:)
+      wndm_tm    (:,:) = wndm  (:,:)
+# if defined key_trabbl
+      IF( nn_bbl_ldf == 1 ) THEN
+         ahu_bbl_tm(:,:) = ahu_bbl(:,:) 
+         ahv_bbl_tm(:,:) = ahv_bbl(:,:) 
+      ENDIF
+      IF( nn_bbl_adv == 1 ) THEN
+         utr_bbl_tm(:,:) = utr_bbl(:,:) 
+         vtr_bbl_tm(:,:) = vtr_bbl(:,:) 
+      ENDIF
+# endif
+      !
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_reset')
+      !
+   END SUBROUTINE trc_sub_reset
+
+
+   SUBROUTINE trc_sub_ssh( kt ) 
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE trc_sub_ssh  ***
+      !!                   
+      !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity
+      !!              and update the now vertical coordinate (ln_linssh=F).
+      !!
+      !! ** 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.
+      !!        The boundary conditions are w=0 at the bottom (no flux) and.
+      !!
+      !! ** action  :   ssha    : after sea surface height
+      !!                wn      : now vertical velocity
+      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (ln_linssh=F)
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sub_ssh')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi,jpj,   zhdiv )
+
+      IF( kt == nittrc000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all)
+         !
+      ENDIF
+      !
+!!gm BUG here !   hdivn will include the runoff divergence at the wrong timestep !!!!
+      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity
+      !
+      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nittrc000 )   z2dt = rdt
+
+      !                                           !------------------------------!
+      !                                           !   After Sea Surface Height   !
+      !                                           !------------------------------!
+      zhdiv(:,:) = 0._wp
+      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
+        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk)
+      END DO
+      !                                                ! Sea surface elevation time stepping
+      ! 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( .NOT.ln_dynspg_ts ) THEN
+      ! These lines are not necessary with time splitting since
+      ! boundary condition on sea level is set during ts loop
+#if defined key_agrif
+      CALL agrif_ssh( kt )
+#endif
+         IF( ln_bdy ) THEN
+            ssha(:,:) = ssha(:,:) * bdytmask(:,:)
+            CALL lbc_lnk( ssha, 'T', 1. ) 
+         ENDIF
+      ENDIF
+      !
+      !                                           !------------------------------!
+      !                                           !     Now Vertical Velocity    !
+      !                                           !------------------------------!
+      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 e3t by its expression yields too long lines otherwise
+         wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)        &
+            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    &
+            &                         * tmask(:,:,jk) * z1_2dt
+         IF( ln_bdy ) wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,   zhdiv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sub_ssh')
+      !
+   END SUBROUTINE trc_sub_ssh
+
+
+   INTEGER FUNCTION trc_sub_alloc()
+      !!-------------------------------------------------------------------
+      !!                    *** ROUTINE trc_sub_alloc ***
+      !!-------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      INTEGER ::  ierr
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE( un_temp(jpi,jpj,jpk)        ,  vn_temp(jpi,jpj,jpk)  ,   &
+         &      wn_temp(jpi,jpj,jpk)        ,  avt_temp(jpi,jpj,jpk) ,   &
+         &      rhop_temp(jpi,jpj,jpk)      ,  rhop_tm(jpi,jpj,jpk) ,   &
+         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      &
+         &      ssha_temp(jpi,jpj)          ,                           &
+#if defined key_trabbl
+         &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    &
+         &      utr_bbl_temp(jpi,jpj)       ,  vtr_bbl_temp(jpi,jpj),    &
+#endif
+         &      rnf_temp(jpi,jpj)           ,  h_rnf_temp(jpi,jpj) ,     &
+         &      tsn_temp(jpi,jpj,jpk,2)     ,  emp_b_temp(jpi,jpj),      &
+         &      emp_temp(jpi,jpj)           ,  fmmflx_temp(jpi,jpj),     &
+         &      hmld_temp(jpi,jpj)          ,  qsr_temp(jpi,jpj) ,       &
+         &      fr_i_temp(jpi,jpj)          ,  fr_i_tm(jpi,jpj) ,        &
+         &      wndm_temp(jpi,jpj)          ,  wndm_tm(jpi,jpj) ,        &
+# if defined key_zdfddm
+         &      avs_tm(jpi,jpj,jpk)         ,  avs_temp(jpi,jpj,jpk) ,   &
+# endif
+         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  &
+         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
+         &      avt_tm(jpi,jpj,jpk)                                ,     &
+         &      sshn_tm(jpi,jpj)            ,  sshb_hold(jpi,jpj) ,      &
+         &      tsn_tm(jpi,jpj,jpk,2)       ,                            &
+         &      emp_tm(jpi,jpj)             ,  fmmflx_tm(jpi,jpj)  ,     &
+         &      emp_b_hold(jpi,jpj)         ,                            &
+         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
+#if defined key_trabbl
+         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      &
+         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      &
+#endif
+         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )  
+      !
+      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
+      !
+      IF( l_ldfslp ) THEN
+         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      &
+            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      &
+            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      &
+            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc )
+      ENDIF
+      !
+      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays')
+      !
+   END FUNCTION trc_sub_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO passive tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sub_stp( kt )        ! Empty routine
+      WRITE(*,*) 'trc_sub_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sub_stp
+   SUBROUTINE trc_sub_ini        ! Empty routine
+      WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sub_ini
+#endif
+
+   !!======================================================================
+END MODULE trcsub
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 8732)
@@ -0,0 +1,82 @@
+MODULE trcwri
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    TOP :   Output of passive tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top && defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                           TOP models
+   !!----------------------------------------------------------------------
+   !! trc_wri_trc   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE dom_oce     ! ocean space and time domain variables
+   USE oce_trc     ! shared variables between ocean and passive tracers
+   USE trc         ! passive tracers common variables 
+   USE iom         ! I/O manager
+   USE dianam      ! Output file name
+   USE trcwri_pisces
+   USE trcwri_cfc
+   USE trcwri_c14
+   USE trcwri_age
+   USE trcwri_my_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri      
+
+CONTAINS
+
+   SUBROUTINE trc_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri  ***
+      !! 
+      !! ** Purpose :   output passive tracers fields and dynamical trends
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in )     :: kt
+      !
+      INTEGER                   :: jn
+      CHARACTER (len=20)        :: cltra
+      CHARACTER (len=40)        :: clhstnam
+      INTEGER ::   inum = 11            ! temporary logical unit
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_wri')
+      !
+      IF( l_offline .AND. kt == nittrc000 .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
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      IF( ln_pisces  )   CALL trc_wri_pisces     ! PISCES 
+      IF( ll_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC
+      IF( ln_c14     )   CALL trc_wri_c14        ! surface fluxes of C14
+      IF( ln_age     )   CALL trc_wri_age        ! AGE tracer
+      IF( ln_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
+      !
+   END SUBROUTINE trc_wri
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+   PUBLIC trc_wri
+CONTAINS
+   SUBROUTINE trc_wri( kt )                     ! Empty routine   
+   INTEGER, INTENT(in) :: kt
+   END SUBROUTINE trc_wri
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trcwri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ALTIX_NAUTILUS_MPT
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ALTIX_NAUTILUS_MPT	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ALTIX_NAUTILUS_MPT	(revision 8732)
@@ -0,0 +1,92 @@
+#!/bin/bash 
+#!
+#PBS -N NEMO
+#PBS -l select=NODES:ncpus=8:mpiprocs=4
+#PBS -l place=scatter:excl
+#PBS -l walltime=00:59:00
+#PBS -q nemo
+#PBS -W group_list=nemo
+#PBS -j oe
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# set up mpp computing environment
+#
+#
+# Local settings. These settings are for a particular machine (the ALTIX ICE system at NOCS)
+# at a particular stage of that machine's evolution. This template file is provided for
+# illustration purposes only and will not work on any other machine. There should, however,
+# be sufficient similarity with other MPP platforms and batch systems for this example to provide
+# a useful guide for experienced users
+#
+  module load mpt/2.03
+  export MPT_HOME=/opt/sgi/mpt/mpt-2.03
+  export NC4_HOME=/noc/users/jeff/packages/netcdf4/netcdf-4.1.3/xSSE2/intel11.1
+  export HD5_HOME=/noc/users/jeff/packages/hdf5/hdf5-1.8.7/xSSE2/intel11.1
+  export IFT_HOME=/sw/Intel/fce/11.1.072
+  export SVN_HOME=/nerc/packages/subversion/v1.7.2
+#
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo PBS job ID is $PBS_JOBID
+  echo This jobs runs on the following machines:
+  echo `cat $PBS_NODEFILE | uniq`
+# 
+# Create a machine file for MPI
+  cat $PBS_NODEFILE | uniq > host.file.$PBS_JOBID
+#
+  echo export LD_LIBRARY_PATH=${MPT_HOME}/lib:${IFT_HOME}/lib:${NC4_HOME}/lib:${HD5_HOME}/lib:${SVN_HOME}/lib
+  export LD_LIBRARY_PATH=${MPT_HOME}/lib:${IFT_HOME}/lib:${NC4_HOME}/lib:${HD5_HOME}/lib:${SVN_HOME}/lib
+# 
+  echo export PATH=${MPT_HOME}/bin:${SVN_HOME}/bin:$PATH
+  export PATH=${MPT_HOME}/bin:${SVN_HOME}/bin:$PATH
+#
+  export PSM_SHAREDPORTS=1
+  echo export MPI_PPN=4
+  echo export MPI_PPN_CLIST="2-3-6-7-0-1-4-5"
+  echo export OMP_NUM_THREADS=1 
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# (half-populated on the NOCS ALTIX system) is also set by the fcm_job.sh on the PBS select
+# header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+  export EXE_DIR=DEF_EXE_DIR
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+# cd $PBS_O_WORKDIR
+  cd $EXE_DIR
+  echo Directory is `pwd`
+#
+#
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPT_HOME}/bin/mpiexec_mpt -np " $OCEANCORES " ./opa"
+#
+  time ${MPT_HOME}/bin/mpiexec_mpt -np $OCEANCORES ./opa
+#
+  post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV	(revision 8732)
@@ -0,0 +1,88 @@
+#!/bin/bash 
+#!
+#BSUB -q long
+#BSUB -n TOTAL_NPROCS
+#BSUB -J MPI_config
+#BSUB -o stdout.%J
+#BSUB -e stderr.%J
+
+ 
+
+###############################################################
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  XIOS_NUMPROCS=NXIOPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM (EKMAN at INGV)
+#
+
+ MPIPROGINF=detail
+ export MPIPROGINF
+ export LSF_PJL_TYPE="intelmpi"
+ export MP_PGMMODEL=mpmd
+ export MP_SHARED_MEMORY=yes
+ export MPIRUN="mpirun -n $OCEANCORES"
+ export MPIRUN_MPMD="mpirun -np $OCEANCORES ./opa : -np $XIOS_NUMPROCS /home/delrosso/XIOS_1.0/xios-1.0/bin/xios_server.exe"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+
+# Don't remove neither change the following line 
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+#
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} " $OCEANCORES " ./opa"
+#
+
+  if [ MPI_FLAG == "yes" ]; then
+     if [ $XIOS_NUMPROCS -eq 0 ]; then
+       time ${MPIRUN} ./opa
+     else
+       time ${MPIRUN_MPMD}
+     fi
+  else
+       time ./opa
+  fi
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line 
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_CALYPSO
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_CALYPSO	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_CALYPSO	(revision 8732)
@@ -0,0 +1,80 @@
+#!/bin/bash 
+#!
+#BSUB -q poe_short
+#BSUB -n NPROCS
+#BSUB -a poe
+#BSUB -J MPI_config
+#BSUB -o poe.stdout.%J
+#BSUB -e poe.stderr.%J
+
+ 
+
+###############################################################
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+
+# export MPIRUN="mpirun -n $OCEANCORES"
+
+export MPIRUN="mpirun.lsf"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+
+# Don't remove neither change the following line 
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+#
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} " $OCEANCORES " ./opa"
+#
+
+  if [ MPI_FLAG == "yes" ]; then
+     time ${MPIRUN} ./opa
+  else
+     time ./opa
+  fi
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line 
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_VARGAS
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_VARGAS	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_VARGAS	(revision 8732)
@@ -0,0 +1,79 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 1:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+export MPIRUN="mpiexec -n $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     time ${MPIRUN} ./opa
+  else
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_METO
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_METO	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_METO	(revision 8732)
@@ -0,0 +1,90 @@
+#!/bin/bash 
+#!
+# @ shell = /usr/bin/ksh
+# @ job_name = MPI_config
+# @ output = out.$(job_name).$(jobid)
+# @ error =  err.$(job_name).$(jobid)
+# @ job_type = parallel
+# @ total_tasks = NPROCS
+# @ wall_clock_limit = 0:30:00
+# @ resources = ConsumableMemory(1562mb)
+# @ class = parallel
+# @ node_usage = shared
+# @ notification = error
+# @ task_affinity = core
+# @ group = science
+# @ queue
+
+ulimit -c unlimited
+ulimit -s unlimited
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power7 (hpc2e at UK Met Office)
+#
+export MPIRUN="poe -pgmodel $MP_PGMMODEL -n $OCEANCORES -cmdfile"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+# Don't remove neither change the following comment line
+# BODY
+
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  if [ MPI_FLAG == "yes" ]; then
+     n=1
+     echo "./opa" > ./alltasks
+     while [ $n -lt $OCEANCORES ]
+     do
+       echo "./opa" >> ./alltasks
+       n=$(( $n + 1 ))
+     done
+     time ${MPIRUN} ./alltasks
+  else
+     time ./opa
+  fi
+
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous comment line
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_MONSOON
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_MONSOON	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_MONSOON	(revision 8732)
@@ -0,0 +1,89 @@
+#!/bin/bash 
+#!
+# @ shell = /usr/bin/ksh
+# @ job_name = MPI_config
+# @ output = out.$(job_name).$(jobid)
+# @ error =  err.$(job_name).$(jobid)
+# @ job_type = parallel
+# @ total_tasks = NPROCS
+# @ wall_clock_limit = 0:30:00
+# @ resources = ConsumableMemory(1562mb)
+# @ class = parallel
+# @ node_usage = shared
+# @ notification = error
+# @ task_affinity = core
+# @ queue
+
+ulimit -c unlimited
+ulimit -s unlimited
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power7 (hpc2e at UK Met Office)
+#
+export MPIRUN="poe -pgmodel $MP_PGMMODEL -n $OCEANCORES -cmdfile"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+# Don't remove neither change the following comment line
+# BODY
+
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  if [ MPI_FLAG == "yes" ]; then
+     n=1
+     echo "./opa" > ./alltasks
+     while [ $n -lt $OCEANCORES ]
+     do
+       echo "./opa" >> ./alltasks
+       n=$(( $n + 1 ))
+     done
+     time ${MPIRUN} ./alltasks
+  else
+     time ./opa
+  fi
+
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous comment line
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA	(revision 8732)
@@ -0,0 +1,81 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 1:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+export MPIRUN="poe"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     echo "Running time ${MPIRUN} ./opa -procs $OCEANCORES"
+     time ${MPIRUN} ./opa -procs $OCEANCORES
+  else
+     echo "Running time ./opa"
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA_DEBUG
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA_DEBUG	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA_DEBUG	(revision 8732)
@@ -0,0 +1,81 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 1:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+export MPIRUN="poe"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     echo "Running time ${MPIRUN} ./opa -procs $OCEANCORES"
+     time ${MPIRUN} ./opa -procs $OCEANCORES
+  else
+     echo "Running time ./opa"
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA_O0
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA_O0	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA_O0	(revision 8732)
@@ -0,0 +1,82 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 1:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+#export MPIRUN="poe -procs $OCEANCORES"
+export MPIRUN="poe"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     echo "Running time ${MPIRUN} ./opa -procs $OCEANCORES"
+     time ${MPIRUN} ./opa  -procs $OCEANCORES
+  else
+     echo "Running time ./opa"
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE	(revision 8732)
@@ -0,0 +1,81 @@
+#!/bin/bash
+#MSUB -T 3600                # elapsed time limit in seconds   (60 minutes)
+#MSUB -r SETTE_JOB           # Job name
+#MSUB -o sette.jobid_%I.txt  # standard output
+#MSUB -e sette.jobid_%I.txt  # standard error
+
+#======   Thin nodes (1 node = 2 * 8 procs) :   
+#MSUB -n NPROCS              # Total number of mpi task to use
+####  #MSUB -N 2                   # number of nodes to use
+#MSUB -ra2286             # project name
+#MSUB -q standard            # (queue name) only for thin nodes
+##########################################################################
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+#
+# set up mpp computing environment
+#
+# Local settings for machine BULL (TITANE at CCRT France)
+#
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# modules to load
+module unload netcdf
+module unload hdf5
+module load netcdf/4.3.3.1_hdf5_parallel
+module load hdf5/1.8.12_parallel
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     time ${MPIRUN} ./opa
+  else
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS	(revision 8732)
@@ -0,0 +1,94 @@
+#!/bin/bash
+#SBATCH -N NODES
+#SBATCH --time=00:59:00 
+
+module purge
+module load shared
+module load gcc
+module load intel/compiler/64/14.0/2013_sp1.2.144
+module load openmpi/intel/64/1.6.5
+module load slurm/2.5.7
+
+#
+  export OMP_NUM_THREADS=1
+  export OCORES=NPROCS
+  export XCORES=NXIOPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+  export XIO_HOME=/home/acc/XIOS_2.0
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# set up mpp computing environment
+#
+#
+# Local settings. These settings are for a particular machine (the MOBILIS ClusterVision 
+# system at NOCS) at a particular stage of that machine's evolution. This template file
+# is provided for illustration purposes only and will not work on any other machine. There
+# should, however, be sufficient similarity with other MPP platforms and batch systems
+# for this example to provide a useful guide for experienced users
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# is also set by the fcm_job.sh on the PBS select header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+  export EXE_DIR=DEF_EXE_DIR
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+  cd $EXE_DIR
+  echo Directory is `pwd`
+  if [ $XCORES -eq 0 ]; then
+#
+# Run SPMD case
+#
+       echo time `which mpirun` --report-bindings -x MALLOC_MMAP_MAX_=-1                 \
+                                -x MALLOC_TRIM_THRESHOLD_=33554432 -np $OCORES --bynode  \
+                                --mca mpi_paffinity_alone 1 ./opa 
+            time `which mpirun` --report-bindings -x MALLOC_MMAP_MAX_=-1                 \
+                                -x MALLOC_TRIM_THRESHOLD_=33554432 -np $OCORES --bynode  \
+                                --mca mpi_paffinity_alone 1 ./opa 
+  else
+       if [ ! -f ./xios_server.exe ] && [ -f ${XIO_HOME}/bin/xios_server.exe ]; then
+          cp ${XIO_HOME}/bin/xios_server.exe .
+       fi
+       if [ ! -f ./xios_server.exe ]; then
+          echo "./xios_server.exe not found"
+          echo "run aborted"
+          exit
+       fi
+#
+#  Run MPMD case
+#
+       echo time `which mpirun` --report-bindings -x MALLOC_MMAP_MAX_=-1 \
+                                -x MALLOC_TRIM_THRESHOLD_=33554432       \
+                                -np $XCORES ./xios_server.exe            \
+                              : -np $OCORES --bynode  --mca mpi_paffinity_alone 1 ./opa 
+#
+            time `which mpirun` --report-bindings -x MALLOC_MMAP_MAX_=-1 \
+                                -x MALLOC_TRIM_THRESHOLD_=33554432       \
+                                -np $XCORES ./xios_server.exe            \
+                              : -np $OCORES --bynode  --mca mpi_paffinity_alone 1 ./opa 
+#
+  fi
+#
+  post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_TITANE
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_TITANE	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_TITANE	(revision 8732)
@@ -0,0 +1,72 @@
+#!/bin/bash 
+#!
+#MSUB -T 3600                # Limite de temps elapsed du job ici 3600s
+#MSUB -r SETTE_JOB           # Nom du job                
+#MSUB -n NPROCS              # Reservation de NPROCS(number of processus)
+##########################################################################
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+#
+# set up mpp computing environment
+#
+# Local settings for machine BULL (TITANE at CCRT France)
+#
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# modules to load
+module load netcdf
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  if [ MPI_FLAG == "yes" ]; then
+  echo "Running time ${MPIRUN} ./opa"
+     time ${MPIRUN} ./opa
+  else
+  echo "Running time ./opa"
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO	(revision 8732)
@@ -0,0 +1,89 @@
+#/bin/bash 
+#!
+#PBS -N nemo_sette
+#PBS -l walltime=00:08:00
+#PBS -j oe
+#PBS -q normal
+#PBS -l SELECT
+
+  export PBS_O_WORKDIR=$(readlink -f $PBS_O_WORKDIR)
+  export OMP_NUM_THREADS=1
+  cd $PBS_O_WORKDIR
+  export XIO_HOME=/projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS
+#
+  echo " ";
+  export OMP_NUM_THREADS=1
+  O_PER_NODE=32
+  X_PER_NODE=4
+  OCORES=NPROCS
+  XCORES=NXIOPROCS
+  if [ $OCORES -le 32 ] ; then O_PER_NODE=$OCORES; fi
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# is also set by the fcm_job.sh on the PBS select header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+  export EXE_DIR=DEF_EXE_DIR
+  ulimit -c unlimited
+  ulimit -s unlimited
+  export FORT_FMT_RECL=132
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+  cd $EXE_DIR
+  echo Directory is `pwd`
+  
+  if [ $XCORES -gt 0 ]; then
+#
+#  Run MPMD case
+#
+     #XIOS will run on a separate node so will run in parallel queue
+     if [ ! -f ./xios_server.exe ] && [ -f ${XIO_HOME}/bin/xios_server.exe ]; then
+        cp ${XIO_HOME}/bin/xios_server.exe .
+     fi
+     if [ ! -f ./xios_server.exe ]; then
+        echo "./xios_server.exe not found"
+        echo "run aborted"
+        exit
+     fi
+       echo time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+            time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+#
+  else
+#
+# Run SPMD case
+#
+    echo time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+         time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+  fi
+#
+
+#
+  post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+  exit
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC_ARCHER_INTEL
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC_ARCHER_INTEL	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC_ARCHER_INTEL	(revision 8732)
@@ -0,0 +1,94 @@
+#!/bin/bash 
+#!
+#PBS -N nemo_sette
+#PBS -l walltime=00:59:00
+#PBS -l select=NODES
+#PBS -j oe
+#PBS -A n01-Global
+
+
+  export PBS_O_WORKDIR=$(readlink -f $PBS_O_WORKDIR)               
+  export OMP_NUM_THREADS=1
+  cd $PBS_O_WORKDIR
+#
+  echo " ";
+  export OMP_NUM_THREADS=1
+  O_PER_NODE=24
+  X_PER_NODE=4
+  OCORES=NPROCS
+  if [ $OCORES -le 23 ] ; then O_PER_NODE=$OCORES; fi
+  XCORES=NXIOPROCS
+  if [ $XCORES -le 3 ] ; then X_PER_NODE=$XCORES; fi
+  export SETTE_DIR=DEF_SETTE_DIR
+  export XIO_HOME=/home/acc/XIOS
+###############################################################
+#
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# set up mpp computing environment
+#
+#
+# Local settings. These settings are for a particular machine (the MOBILIS ClusterVision 
+# system at NOCS) at a particular stage of that machine's evolution. This template file
+# is provided for illustration purposes only and will not work on any other machine. There
+# should, however, be sufficient similarity with other MPP platforms and batch systems
+# for this example to provide a useful guide for experienced users
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# is also set by the fcm_job.sh on the PBS select header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+  export EXE_DIR=DEF_EXE_DIR
+  ulimit -c unlimited
+  ulimit -s unlimited
+  export FORT_FMT_RECL=132
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+  cd $EXE_DIR
+  echo Directory is `pwd`
+  if [ $XCORES -eq 0 ]; then
+#
+# Run SPMD case
+#
+       echo time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+            time aprun -b  -n $OCORES -N $O_PER_NODE ./opa
+  else
+       if [ ! -f ./xios_server.exe ] && [ -f ${XIO_HOME}/bin/xios_server.exe ]; then
+          cp ${XIO_HOME}/bin/xios_server.exe .
+       fi
+       if [ ! -f ./xios_server.exe ]; then
+          echo "./xios_server.exe not found"
+          echo "run aborted"
+          exit
+       fi
+#
+#  Run MPMD case
+#
+       echo time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+            time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+#
+  fi
+#
+  post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena	(revision 8732)
@@ -0,0 +1,80 @@
+#!/bin/bash 
+#!
+#BSUB -q poe_short
+#BSUB -n NPROCS
+#BSUB -a poe
+#BSUB -J NEMO_SETTE
+#BSUB -o poe.stdout.%J
+#BSUB -e poe.stderr.%J
+
+ 
+
+###############################################################
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+
+# export MPIRUN="mpirun -n $OCEANCORES"
+
+export MPIRUN="mpirun.lsf"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+
+# Don't remove neither change the following line 
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+#
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} " $OCEANCORES " ./opa"
+#
+
+  if [ MPI_FLAG == "yes" ]; then
+     time ${MPIRUN} ./opa
+  else
+     time ./opa
+  fi
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line 
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios	(revision 8732)
@@ -0,0 +1,106 @@
+#!/bin/bash 
+#!
+#BSUB -q poe_short
+#BSUB -n TOTAL_NPROCS
+#BSUB -a poe
+#BSUB -J NEMO_SETTE
+#BSUB -o poe.stdout.%J
+#BSUB -e poe.stderr.%J
+
+ 
+
+###############################################################
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  XIOS_NUMPROCS=NXIOPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+
+# export MPIRUN="mpirun -n $OCEANCORES"
+
+module load  INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel
+export MPIRUN="mpirun.lsf"
+
+export LD_LIBRARY_PATH=${XIOS}/lib:${LD_LIBRARY_PATH}
+
+XIOS_SERVER_PATHNAME="${XIOS}/bin/xios_server.exe"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+
+# Don't remove neither change the following line 
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+#
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+#  echo "Running time ${MPIRUN} " $OCEANCORES " ./opa"
+#
+
+  if [ MPI_FLAG == "yes" ]; then
+     if [ $XIOS_NUMPROCS -eq 0 ]; then
+       time ${MPIRUN} ./opa
+     else
+
+       export MP_PGMMODEL=mpmd
+       export MP_CMDFILE=xioscmdfile
+       rm xioscmdfile &> /dev/null
+       touch xioscmdfile
+       k=0
+       while (( k < $OCEANCORES )) ; do
+          echo ./opa >> xioscmdfile
+          k=`expr $k + 1`
+       done
+       k=0
+       while (( k < $XIOS_NUMPROCS )) ; do
+          echo $XIOS_SERVER_PATHNAME >> xioscmdfile
+          k=`expr $k + 1`
+       done
+
+       time ${MPIRUN}
+     fi
+  else
+     time ./opa
+  fi
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line 
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-macport_osx
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-macport_osx	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-macport_osx	(revision 8732)
@@ -0,0 +1,81 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 0:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine mac osx using macport
+#
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+# Don't remove neither change the following comment line
+# BODY
+
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  if [ MPI_FLAG == "yes" ]; then
+  echo "Running time ${MPIRUN} ./opa"
+     time ${MPIRUN} ./opa
+  else
+  echo "Running time./opa"
+     time ./opa
+  fi
+
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous comment line
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-macport_osx_debug
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-macport_osx_debug	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-macport_osx_debug	(revision 8732)
@@ -0,0 +1,81 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 0:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine mac osx using macport
+#
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+# Don't remove neither change the following comment line
+# BODY
+
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  if [ MPI_FLAG == "yes" ]; then
+  echo "Running time ${MPIRUN} ./opa"
+     time ${MPIRUN} ./opa
+  else
+  echo "Running time./opa"
+     time ./opa
+  fi
+
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous comment line
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-mpmd-ALTIX_NAUTILUS_MPT
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-mpmd-ALTIX_NAUTILUS_MPT	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-mpmd-ALTIX_NAUTILUS_MPT	(revision 8732)
@@ -0,0 +1,105 @@
+#!/bin/bash 
+#!
+#PBS -N NEMO
+#PBS -l select=NODES:ncpus=8:mpiprocs=4
+#PBS -l place=scatter:excl
+#PBS -l walltime=00:59:00
+#PBS -q nemo
+#PBS -W group_list=nemo
+#PBS -j oe
+#
+  OCEANCORES=NPROCS
+  XIOCORES=NXIOPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# set up mpp computing environment
+#
+#
+# Local settings. These settings are for a particular machine (the ALTIX ICE system at NOCS)
+# at a particular stage of that machine's evolution. This template file is provided for
+# illustration purposes only and will not work on any other machine. There should, however,
+# be sufficient similarity with other MPP platforms and batch systems for this example to provide
+# a useful guide for experienced users
+#
+  module load mpt/2.03
+  export MPT_HOME=/opt/sgi/mpt/mpt-2.03
+  export NC4_HOME=/fibre/omfman/NETCDF_PAR
+  export HD5_HOME=/fibre/omfman/NETCDF_PAR
+  export XIO_HOME=/fibre/omfman/XIOS
+  export SVN_HOME=/nerc/packages/subversion/v1.7.2
+  export FTN_LIB=/sw/Intel/fce/11.1.072/lib/intel64
+  export ICC_LIB=/sw/Intel/cce/11.1.072/lib/intel64
+#
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo PBS job ID is $PBS_JOBID
+  echo This jobs runs on the following machines:
+  echo `cat $PBS_NODEFILE | uniq`
+# 
+# Create a machine file for MPI
+  cat $PBS_NODEFILE | uniq > host.file.$PBS_JOBID
+#
+  echo export LD_LIBRARY_PATH=${MPT_HOME}/lib:${ICC_LIB}:${FTN_LIB}:${NC4_HOME}/lib:${HD5_HOME}/lib:${SVN_HOME}/lib:${LD_LIBRARY_PATH}
+  export LD_LIBRARY_PATH=${MPT_HOME}/lib:${ICC_LIB}:${FTN_LIB}:${NC4_HOME}/lib:${HD5_HOME}/lib:${SVN_HOME}/lib:${LD_LIBRARY_PATH}
+# 
+  echo export PATH=${MPT_HOME}/bin:${SVN_HOME}/bin:$PATH
+  export PATH=${MPT_HOME}/bin:${SVN_HOME}/bin:$PATH
+#
+  export PSM_SHAREDPORTS=1
+  echo export MPI_PPN=4
+  echo export MPI_PPN_CLIST="2-3-6-7-0-1-4-5"
+  echo export OMP_NUM_THREADS=1 
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# (half-populated on the NOCS ALTIX system) is also set by the fcm_job.sh on the PBS select
+# header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+  export EXE_DIR=DEF_EXE_DIR
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+# cd $PBS_O_WORKDIR
+  cd $EXE_DIR
+  echo Directory is `pwd`
+  if [ ! -f ./xios_server.exe ] && [ -f ${XIO_HOME}/bin/xios_server.exe ] 
+   then
+     cp ${XIO_HOME}/bin/xios_server.exe .
+  fi
+  if [ ! -f ./xios_server.exe ]
+   then
+     echo "./xios_server.exe not found"
+     echo "run aborted"
+     exit
+  fi
+#
+#
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPT_HOME}/bin/mpiexec_mpt -np " $XIOCORES " ./xios_server.exe : -np " $OCEANCORES " ./opa"
+#
+  time ${MPT_HOME}/bin/mpiexec_mpt -np $XIOCORES ./xios_server.exe :  -np $OCEANCORES ./opa
+#
+  post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-openmpi_NAVITI_MERCATOR	(revision 8732)
@@ -0,0 +1,74 @@
+#!/bin/bash 
+#!
+#PBS -N sette
+#PBS -e sette.$PBS_JOBID.err
+#PBS -o sette.$PBS_JOBID.out
+#PBS -l nodes=NODES:ppn=NPROC_NODE
+#PBS -q QUEUE
+#PBS -l walltime=03:00:00
+#PBS -l pmem=3gb
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+#cbr export MPIRUN="mpiexec -n $OCEANCORES"
+export MPIRUN="mpirun -np $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+#
+
+# Don't remove neither change the following line
+# BODY
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  echo "Running time ${MPIRUN} ./opa"
+#
+  if [ MPI_FLAG == "yes" ]; then
+     mpirun -np $OCEANCORES ./opa
+  else
+     time ./opa
+  fi
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous line
+
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/sette_batch_template
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/sette_batch_template	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/sette_batch_template	(revision 8732)
@@ -0,0 +1,81 @@
+#!/bin/bash 
+#!
+# @ job_name = MPI_config
+# standard output file  
+# @ output = $(job_name).$(jobid)
+# standard error file
+# @ error =  $(job_name).$(jobid)
+# job type
+# @ job_type = parallel
+# Number of procs 
+# @ total_tasks = NPROCS
+# time
+# @ wall_clock_limit = 0:30:00
+# @ queue
+
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). 
+#
+  OCEANCORES=NPROCS
+  export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power6 (VARGAS at IDRIS France)
+#
+export MPIRUN="mpiexec -n $OCEANCORES"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+  . ${SETTE_DIR}/all_functions.sh
+
+# Don't remove neither change the following comment line
+# BODY
+
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+  export EXE_DIR=DEF_EXE_DIR
+  export INPUT_DIR=DEF_INPUT_DIR
+  export CONFIG_DIR=DEF_CONFIG_DIR
+  export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+  export NEW_CONF=DEF_NEW_CONF
+  export CMP_NAM=DEF_CMP_NAM
+  export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory 
+#
+cd ${EXE_DIR}
+
+  echo Running on host `hostname`
+  echo Time is `date`
+  echo Directory is `pwd`
+# 
+#  Run the parallel MPI executable 
+#
+  if [ MPI_FLAG == "yes" ]; then
+  echo "Running time ${MPIRUN} ./opa"
+     time ${MPIRUN} ./opa
+  else
+  echo "Running time./opa"
+     time ./opa
+  fi
+
+
+#
+  post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous comment line
+
+  exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/README	(revision 8732)
@@ -0,0 +1,81 @@
+usage of SETTE package:
+
+principal script is sette.sh (usage: ./sette.sh) 
+
+VERY IMPORTANT : for a verbose debug do:
+./sette.sh 2>&1 | tee out.sette
+this create out.sette file in ${SETTE_DIR}
+
+USER MODIFICATIONS
+ in sette.sh script :
+               COMPILER    : compiler among those available in NEMOGCM/ARCH, needed for makenemo (see below)
+                             can also be pass as an argument, e.g. ./sette.sh ifort_osx
+	       BATCH_COMMAND_PAR : command for job submission in batch mode parallel (MMIÂ)
+	       BATCH_COMMAND_SEQ : command for job submission in batch mode sequential (NB_PROC = 1)
+	       INTERACT_FLAG : "yes" if you want to run in interactive mode 
+	       		       "no" if you want to run in batch mode
+	       MPIRUN_FLAG   : "yes" if you want to run in parallel (MPI)
+			       "no" if you want to run in sequential mode (NB_PROC = 1)
+
+               makenemo -m : machine (compilator); see ./makenemo -m help (in NEMOGCM/CONFIG directory)
+                        -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
+                        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\")
+			(  	 : to activate control print : namelist ln_ctl false )
+	       prepare_exe_dir.sh creates execution directory for each test
+	       			  : NOTE for EACH JOB EXECUTION it is needed to set TEST_NAME variable
+				    TEST_NAME variable gives name to execution directory (created in prepare_exe_dir.sh)
+				    IT is mandatory to have different TEST_NAME for each job run if not existing files are re-written (for example namelist)
+
+               prepare_job.sh generates the script to be executed 
+			input: INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPIRUN_FLAG JOB_FILE
+
+               fcm_job.sh needs input: TOTAL_NUMBER_OF_PROCS_used JOB_FILE_NAME INTERACT_FLAG MPIRUN_FLAG 
+			(for example if you run with 4 procs JOB_FILE batch parallel 
+			and only run short test ===> ./fcm_job 4 SHORT no    yes   )
+
+ in param.cfg :
+               FORCING_DIR 	   : directory in which will be found input.tar file (same name in input_CONFIG_NAME.cfg)
+               INPUT_DIR   	   : directory in which store input files (tar file)
+               TMPDIR      	   : temporary directory NEEDED ONLY FOR IBM machines (put EXP00 directory)
+	       NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, solver.stat, tracer.stat and ocean.output files in
+      			             tree NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE)
+ 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" if [ ${INTERACT_FLAG} == "yes" ] mpirun command line (some examples are already written)
+	       NOTE: if INTERACT_FLAG="no" it is needed a batch_file (see below to create a new one)
+
+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.
+
+NOTE 2: 
+if you want a completly verbose makenemo you can uncomment "set -x" in makenemo script
+and then launch ./sette.sh 2>&1 | tee out.sette
+
+TO ADD NEW CONFIGURATION:
+1. makenemo -n NEW_CONFIG (see makenemo -h for help) OR
+2. makenemo -n NEW_CONFIG -r REF_CONFIG (if it is based on another reference configuration)
+3. for fcm_job.sh creates a new input_NEW_CONFIG.cfg if you need tar file (if you use same tar file of GYRE, ORCA2_LIM or ORCA2_LIM_PISCES you can use it)
+
+TO ADD NEW MACHINE:
+1. add arch-compiler.fcm in NEMOGCM/ARCH directory
+2. makenemo -m new_compiler  (see makenemo -h for help)
+
+TO ADD NEW BATCH-FILE:
+1. see in SETTE/BATCH_TEMPLATE directory existing examples
+2. create you own batch file like: batch-${COMPILER}
+(note: sette.sh will copy it in job_batch_template if you run tests in INTERACT_FLAG="no")
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/all_functions.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/all_functions.sh	(revision 8732)
@@ -0,0 +1,422 @@
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# ----------------------------------------------------------------------
+# NEMO/SETTE , NEMO Consortium (2010)
+# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+# ----------------------------------------------------------------------
+#
+# 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 INPUT_NAMELIST VARIABLE VALUE 
+#  $ post_test_tidyup 
+#
+#
+# DESCRIPTION
+# ===========
+#
+# function superegrep
+#   input variable value
+#
+# function set_namelist
+#   input namelist_name variable value
+#   output namelist
+#
+# function post_test_tidyup
+#   creates nemo_validation tree, and save output & debug files
+#   this function creates tree of validation in NEMO_VALIDATION_DIR as follows : 
+#
+# NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/REVISION_NUMBER(or DATE)/TEST_NAME
+# 
+# NEMO_VALIDATION_DIR           : is choosen in param.cfg
+#
+# WCONFIG_NAME                  : set by makenemo at the moment of compilation
+#
+# WCOMPILER_NAME                : set by makenemo at the moment of compilation
+#
+# REVISION_NUMBER(or DATE)      : revision number by svn info, if problems with svn date is taken
+#
+# TEST_NAME                     : set in sette.sh for each configuration to be tested (directory TEST_NAME is created under ${NEW_CONF} directory )
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./set_namelist namelist          nn_itend        75
+#  $ ./set_namelist namelist_ice      cn_icerst_in  \"00101231_restart_ice\"
+#  $ post_test_tidyup 
+#
+#
+# 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 enough arguments for set_namelist"
+		echo "${usage}"
+		exit 1
+	fi
+	unset minargcount
+	if [  ! -f ${SETTE_DIR}/output.sette ] ; then
+                touch ${SETTE_DIR}/output.sette
+        fi
+
+        echo "executing script : set_namelist $@" >> ${SETTE_DIR}/output.sette
+        echo "################" >> ${SETTE_DIR}/output.sette
+      
+	VAR_NAME=$( supergrep $2 ${EXE_DIR}/$1 )
+	if [ ${#VAR_NAME} -eq 0 ] 
+	then
+		echo "doing \"set_namelist $@\". "  >> ${SETTE_DIR}/output.sette
+		echo "variable: \"$2\" not found in \"${EXE_DIR}/$1\" "  >> ${SETTE_DIR}/output.sette
+                NAMREF=$( basename $1 _cfg )_ref
+		echo "doing more : search in ${EXE_DIR}/$NAMREF " >> ${SETTE_DIR}/output.sette
+                VAR_NAME=$( supergrep $2 ${EXE_DIR}/$NAMREF )
+	        if [ ${#VAR_NAME} -eq 0 ] 
+	        then
+                    echo " variable $VAR_NAME not found in ${EXE_DIR}/$1 nor in ${EXE_DIR}/$NAMREF "
+                    echo " check your variable name "
+        		echo "exit"
+	        	echo "error in executing script : set_namelist $@" >> ${SETTE_DIR}/output.sette
+	        	echo "....." >> ${SETTE_DIR}/output.sette
+        		exit 1
+                fi
+                LINEVAR=$( grep -s -n "$VAR_NAME" ${EXE_DIR}/$NAMREF | awk -F: '{ { print $1} }' )
+                echo " $VAR_NAME found in ${EXE_DIR}/$NAMREF at line $LINEVAR " >> ${SETTE_DIR}/output.sette
+#   search for namelist group name
+                NAMGRP=$( head -n$LINEVAR ${EXE_DIR}/$NAMREF | grep --line-buffered "^&nam" | tail -1 | awk -F" " '{ { print $1} }' ) 
+                echo " variable $VAR_NAME will be added in $NAMGRP namelist-group of namelist file ${EXE_DIR}/$1 " >> ${SETTE_DIR}/output.sette
+# Add $VARNAME in namelist file ${EXE_DIR}/$1 in namelist group $NAMGRP
+# on mac osx, replace sed --posix by gsed (available with mac port)
+                sed --posix "/${NAMGRP} /a\ ${VAR_NAME} " ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp || gsed --posix "/${NAMGRP} /a\ ${VAR_NAME} " ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+# if file not empty replace ${EXE_DIR}/$1
+                if [ -s ${EXE_DIR}/$1.tmp ] ; then
+                   mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1 
+                else
+                echo "file ${EXE_DIR}/$1.tmp is empty. sed command went wrong "; exit 200
+                fi
+	fi
+
+        sed -e "s:${VAR_NAME}.*:${VAR_NAME}:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
+        sed -e "s:${VAR_NAME}:$2=$3:"  ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
+
+        echo "finished script : set_namelist $@" >> ${SETTE_DIR}/output.sette
+        echo "++++++++++++++++" >> ${SETTE_DIR}/output.sette
+        echo "                " >> ${SETTE_DIR}/output.sette
+}
+
+
+# function to tidy up after each test and populate the NEMO_VALIDATION store
+post_test_tidyup () {
+#
+# requires the following variables defined and exported from the calling script:
+#  SETTE_DIR
+#  INPUT_DIR
+#  EXE_DIR
+#  CONFIG_DIR
+#  NEMO_VALIDATION_DIR
+#  NEW_CONF
+#  CMP_NAM
+#  TEST_NAME
+echo "SETTE directory is : ${SETTE_DIR}"
+echo "INPUT directory is : ${INPUT_DIR}"
+echo "EXECUTION directory is : ${EXE_DIR}"
+echo "CONFIG directory is : ${CONFIG_DIR}"
+echo "VALIDATION directory is : ${NEMO_VALIDATION_DIR}"
+echo "NEW CONFIGURATION is : ${NEW_CONF}"
+echo "COMPILER is : ${CMP_NAM}"
+echo "TEST is : ${TEST_NAME}"
+################################################################
+# SMALL DEBUG
+    if [ ! -r ${EXE_DIR}/ocean.output ]
+        then
+        grep "E R R O R" ${EXE_DIR}/ocean.output && echo "Some ERRORS at execution time, see ${EXE_DIR}/ocean.output"
+        exit 2
+    fi
+
+    if [ ! -r ${EXE_DIR}/time.step ]
+        then
+        echo "file time.step does not exist"   >> ${SETTE_DIR}/output.sette
+        echo "some problems during execution of model"  >> ${SETTE_DIR}/output.sette 
+        exit 1
+    else
+        echo "file time.step exists"  >> ${SETTE_DIR}/output.sette
+        echo "execution of model time step loop started"   >> ${SETTE_DIR}/output.sette
+    fi
+
+################################################################
+
+################################################################
+# Creation of NEMO_VALIDATION tree
+    export LANG=en_US 
+    cd ${CONFIG_DIR}
+    cd ../
+    REVISION_NB=`svn info | grep -i "Last Changed Rev:" | sed -e "s/ //g" | cut -d ":" -f 2`
+    if [ ${#REVISION_NB} -eq 0 ]
+    then
+    	echo "some problems with svn info command"
+    	echo "some problems with svn info command" >> ${SETTE_DIR}/output.sette
+    	REVISION_NB=`date +%Y%m%d`
+    	echo "put in ${REVISION_NB} date"
+    	echo "put in ${REVISION_NB} date" >> ${SETTE_DIR}/output.sette
+    else
+    echo "value of revision number of NEMOGCM: ${REVISION_NB}"
+    fi
+    cd ${NEMO_VALIDATION_DIR}
+    `mkdir -p ${NEMO_VALIDATION_DIR}/W${NEW_CONF}/${CMP_NAM}/${REVISION_NB}/${TEST_NAME}`
+    NEMO_VALID=${NEMO_VALIDATION_DIR}/W${NEW_CONF}/${CMP_NAM}/${REVISION_NB}/${TEST_NAME}
+    if [ -d ${NEMO_VALID} ] ; then
+	echo "created ${NEMO_VALID} directory"   >> ${SETTE_DIR}/output.sette
+    else 
+	echo "problems in creating ${NEMO_VALID} directory"   >> ${SETTE_DIR}/output.sette
+	echo "EXIT,"
+	exit 1
+    fi
+    # Save output & debug files in NEMO_VALIDATION tree
+    echo "saving ocean & ice output, solver.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette
+    echo "            " >> ${SETTE_DIR}/output.sette
+    [ -f ${EXE_DIR}/ocean.output ] && cp ${EXE_DIR}/*ocean.output ${NEMO_VALID}/.
+    [ -f ${EXE_DIR}/solver.stat ] && cp ${EXE_DIR}/*solver.stat ${NEMO_VALID}/.
+    [ -f ${EXE_DIR}/output.namelist.dyn ] && cp ${EXE_DIR}/*output.nam* ${NEMO_VALID}/.
+    [ -f ${EXE_DIR}/tracer.stat ] && cp ${EXE_DIR}/*tracer.stat ${NEMO_VALID}/.
+
+    if [ -n "$(ls ${NEMO_VALID}/*solver*)" ] ; then
+	echo "moved solver.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "moved solver.stat in ${NEMO_VALID} directory"  
+    else
+	echo "problem in looking for solver.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "solver.stat IS NOT in ${NEMO_VALID} directory" 
+    fi
+    if [ -n "$(ls ${NEMO_VALID}/*ocean.output*)" ] ; then
+	echo "moved ocean.output in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "moved ocean.output in ${NEMO_VALID} directory" 
+    else
+	echo "problem in looking for ocean.output file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+	echo "ocean.output IS NOT in ${NEMO_VALID} directory" 
+    fi
+    if [ -n "$(ls ${NEMO_VALID}/*tracer.stat*)" ] ; then
+        echo "moved tracer.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+        echo "moved tracer.stat in ${NEMO_VALID} directory"
+    else
+        echo "problem in looking for tracer.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette
+        echo "tracer.stat IS NOT in ${NEMO_VALID} directory"
+    fi
+}
+
+#############################################################
+# extra functions to manipulate settings in the iodef.xml file
+#
+# Examples:
+#   set_xio_file_type    iodef.xml one_file
+#   set_xio_using_server iodef.xml true
+#   set_xio_buffer_size  iodef.xml 50000000
+#   set_xio_field_defs   iodef.xml
+#
+#############################################################
+
+usage2=" Usage : set_xio_file_type input_iodef.xml one_file||multiple_file"
+usage3=" Usage : set_xio_using_server input_iodef.xml true||false"
+usage4=" Usage : set_xio_buffer_size input_iodef.xml int_buffer_size"
+usage5=" Usage : set_xio_field_defs input_iodef.xml"
+
+set_xio_file_type () {
+        minargcount=2
+        if [ ${#} -lt ${minargcount} ]
+        then
+                echo "not enough arguments for set_xio_file_type"
+                echo "${usage2}"
+                exit 1
+        fi
+        if [ $2 != "one_file" ] && [ $2 != "multiple_file" ]
+        then
+                echo "unrecognised argument for set_xio_file_type"
+                echo "${usage2}"
+                echo $2
+                exit 1
+        fi
+        unset minargcount
+        if [  ! -f ${SETTE_DIR}/output.sette ] ; then
+                touch ${SETTE_DIR}/output.sette
+        fi
+
+        echo "executing script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
+        echo "################" >> ${SETTE_DIR}/output.sette
+
+        VAR_NAME=$( grep "^.*<.*file_definition.*type.*=" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
+        if [ ${#VAR_NAME} -eq 0 ]
+        then
+                echo "doing \"set_xio_file_type $@\". "
+                echo "xml_tag: file_definition with variable: type is empty"
+                echo "confirm that an appropriate file_definition is in \"${EXE_DIR}/$1\" "
+                echo "exit"
+                echo "error in executing script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
+                echo "....." >> ${SETTE_DIR}/output.sette
+                exit 1
+        fi
+        if [ $2 == "one_file" ] 
+        then
+           sed -e "s:multiple_file:one_file:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+        else
+           sed -e "s:one_file:multiple_file:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+        fi
+        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
+
+        echo "finished script : set_xio_file_type $@" >> ${SETTE_DIR}/output.sette
+        echo "++++++++++++++++" >> ${SETTE_DIR}/output.sette
+        echo "                " >> ${SETTE_DIR}/output.sette
+}
+
+set_xio_using_server () {
+        minargcount=2
+        if [ ${#} -lt ${minargcount} ]
+        then
+                echo "not enough arguments for set_xio_using_server"
+                echo "${usage2}"
+                exit 1
+        fi
+        if [ $2 != "true" ] && [ $2 != "false" ]
+        then
+                echo "unrecognised argument for set_xio_using_server"
+                echo "${usage2}"
+                echo $2
+                exit 1
+        fi
+        unset minargcount
+        if [  ! -f ${SETTE_DIR}/output.sette ] ; then
+                touch ${SETTE_DIR}/output.sette
+        fi
+
+        echo "executing script : set_xio_using_server $@" >> ${SETTE_DIR}/output.sette
+        echo "################" >> ${SETTE_DIR}/output.sette
+
+        VAR_NAME=$( grep "^.*<.*variable id.*=.*using_server.*=.*bool" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
+        if [ ${#VAR_NAME} -eq 0 ]
+        then
+                echo "doing \"set_xio_using_server $@\". "
+                echo "xml_tag: "variable id=using_server" with variable: bool is empty"
+                echo "confirm that an appropriate variable id is in \"${EXE_DIR}/$1\" "
+                echo "exit"
+                echo "error in executing script : set_xio_using_server $@" >> ${SETTE_DIR}/output.sette
+                echo "....." >> ${SETTE_DIR}/output.sette
+                exit 1
+        fi
+        if [ $2 == "false" ]
+        then
+           sed -e "/using_server/s:true:false:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+           export USING_MPMD=no
+        else
+           sed -e "/using_server/s:false:true:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+           export USING_MPMD=yes
+        fi
+        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
+
+        echo "finished script : set_xio_using_server $@" >> ${SETTE_DIR}/output.sette
+        echo "++++++++++++++++" >> ${SETTE_DIR}/output.sette
+        echo "                " >> ${SETTE_DIR}/output.sette
+}
+
+set_xio_buffer_size () {
+        minargcount=2
+        if [ ${#} -lt ${minargcount} ]
+        then
+                echo "not enough arguments for set_xio_buffer_size"
+                echo "${usage4}"
+                exit 1
+        fi
+        unset minargcount
+        if [  ! -f ${SETTE_DIR}/output.sette ] ; then
+                touch ${SETTE_DIR}/output.sette
+        fi
+
+        echo "executing script : set_xio_buffer_size $@" >> ${SETTE_DIR}/output.sette
+        echo "################" >> ${SETTE_DIR}/output.sette
+
+        VAR_NAME=$( grep "^.*<.*variable id.*=.*buffer_size.*=.*integer" ${EXE_DIR}/$1 | sed -e "s% *\!.*%%" )
+        if [ ${#VAR_NAME} -eq 0 ]
+        then
+                echo "doing \"set_xio_buffer_size $@\". "
+                echo "xml_tag: "variable id=buffer_size" with variable: integer is empty"
+                echo "confirm that an appropriate variable id is in \"${EXE_DIR}/$1\" "
+                echo "exit"
+                echo "error in executing script : set_xio_buffer_size $@" >> ${SETTE_DIR}/output.sette
+                echo "....." >> ${SETTE_DIR}/output.sette
+                exit 1
+        fi
+        sed -e "/buffer_size/s:>.*<:>$2<:" ${EXE_DIR}/$1 > ${EXE_DIR}/$1.tmp
+        mv ${EXE_DIR}/$1.tmp ${EXE_DIR}/$1
+
+        echo "finished script : set_xio_buffer_size $@" >> ${SETTE_DIR}/output.sette
+        echo "++++++++++++++++" >> ${SETTE_DIR}/output.sette
+        echo "                " >> ${SETTE_DIR}/output.sette
+}
+
+set_xio_field_defs () {
+        minargcount=1
+        if [ ${#} -lt ${minargcount} ]
+        then
+                echo "not enough arguments for set_xio_field_defs"
+                echo "${usage5}"
+                exit 1
+        fi
+        unset minargcount
+        if [  ! -f ${SETTE_DIR}/output.sette ] ; then
+                touch ${SETTE_DIR}/output.sette
+        fi
+
+        echo "executing script : set_xio_field_defs $@" >> ${SETTE_DIR}/output.sette
+        echo "################" >> ${SETTE_DIR}/output.sette
+
+
+        [ -f ${EXE_DIR}/field_def_nemo-opa.xml ] || sed -i '/field_def_nemo-opa/d' $1
+        [ -f ${EXE_DIR}/field_def_nemo-lim.xml ] || sed -i '/field_def_nemo-lim/d' $1
+        [ -f ${EXE_DIR}/field_def_nemo-pisces.xml ] || sed -i '/field_def_nemo-pisces/d' $1
+
+        echo "finished script : set_xio_field_defs $@" >> ${SETTE_DIR}/output.sette
+        echo "++++++++++++++++" >> ${SETTE_DIR}/output.sette
+        echo "                " >> ${SETTE_DIR}/output.sette
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/fcm_job.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/fcm_job.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/fcm_job.sh	(revision 8732)
@@ -0,0 +1,103 @@
+#####################################################
+# 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 -vx
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# fcm_job.sh
+# ================
+#
+# --------------------------
+# Simple job for NEMO tests 
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# :: lauches the script $JOB_FILE interactive or batch, one task or MPI
+#
+#  $ ./fcm_job.sh NUMBER_OF_PROCS JOB_FILE INTERACT_FLAG MPIRUN_FLAG
+#
+#
+# DESCRIPTION
+# ===========
+#
+# Simple job for SET TESTS for NEMO (SETTE)
+# 
+#  
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./fcm_job.sh NUMBER_OF_PROCS JOB_FILE INTERACT_FLAG MPIRUN_FLAG
+#
+#  run a job with 1 processor SHORT test ( 5 days ) 
+#  using an interactive run without mpirun 
+#
+#  ./fcm_job.sh        1           SHORT        yes          no 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: $
+#
+#
+#
+#   * creation
+#
+#-
+#
+
+usage=" Usage : ./fcm_job.sh  NUMBER_OF_PROCS JOB_FILE INTERACT_FLAG MPIRUN_FLAG"
+usage=" example : ./fcm_job.sh       8          SHORT      no/yes       no/yes"
+
+
+minargcount=4
+        if [ ${#} -lt ${minargcount} ]
+        then
+                echo "not enough arguments for fcm_job.sh script"
+                echo "control number of argument of fcm_job.sh in sette.sh"
+                echo "${usage}"
+        exit 1
+        fi
+        unset minargcount
+	if [ ! -f ${SETTE_DIR}/output.sette ] ; then
+	        touch ${SETTE_DIR}/output.sette
+	fi
+       
+
+export NB_PROCS=$1
+export JOB_FILE=$2
+export INTERACT_FLAG=$3
+export MPIRUN_FLAG=$4
+################################################################
+# RUN OPA
+cd ${EXE_DIR}
+if [ "${INTERACT_FLAG}" == "yes" ]; then
+	eval ${JOB_FILE}
+else if [ "${INTERACT_FLAG}" == "no" ]; then
+	# submit job to batch system 
+        if [ "${NB_PROC}" == "1" ]; then
+		eval ${BATCH_COMMAND_SEQ} ${JOB_FILE} ; echo  ${BATCH_COMMAND_SEQ} ${JOB_FILE}
+        else
+		eval ${BATCH_COMMAND_PAR} ${JOB_FILE} ; echo ${BATCH_COMMAND_PAR} ${JOB_FILE}
+        fi
+fi
+fi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_AMM12.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_AMM12.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_AMM12.cfg	(revision 8732)
@@ -0,0 +1,1 @@
+AMM12_v3.7.tar AMM12_v3.7
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_GYRE.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_GYRE.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_GYRE.cfg	(revision 8732)
@@ -0,0 +1,1 @@
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_AGRIF.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_AGRIF.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_AGRIF.cfg	(revision 8732)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_OBS.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_OBS.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_OBS.cfg	(revision 8732)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_PISCES.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_PISCES.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_LIM3_PISCES.cfg	(revision 8732)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.7.tar  ORCA2_LIM_PISCES_v3.7
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg	(revision 8732)
@@ -0,0 +1,1 @@
+ORCA2_OFF_v3.7.tar ORCA2_OFF_PISCES_3.7
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_SAS.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_SAS.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/input_SAS.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7
+INPUTS_SAS_v3.5.tar SAS 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/iodef_sette.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/iodef_sette.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/iodef_sette.xml	(revision 8732)
@@ -0,0 +1,324 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="DEF_SHARED/field_def_nemo-opa.xml"/>
+    <field_definition src="DEF_SHARED/field_def_nemo-lim.xml"/>
+    <field_definition src="DEF_SHARED/field_def_nemo-pisces.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->  
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>   
+
+ </context>
+  
+ <context id="1_nemo" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="DEF_SHARED/field_def_nemo-opa.xml"/>
+    <field_definition src="DEF_SHARED/field_def_nemo-lim.xml"/>
+    <field_definition src="DEF_SHARED/field_def_nemo-pisces.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files -->
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->  
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    <axis_definition>
+      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" />
+      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" />
+      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" />
+      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" />
+      <axis id="nfloat" long_name="Float number"      unit="-"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"               />
+      <axis id="ncatice" long_name="Ice category"       unit="1"               />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            />
+    </axis_definition>
+ 
+    <domain_definition src="./domain_def_nemo.xml"/>
+  
+    <grid_definition>    
+
+        <!--  -->
+       <grid id="grid_T_2D" >
+         <domain id="grid_T" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D_ncatice" >
+         <domain id="grid_T" />
+         <axis id="ncatice" />
+       </grid>
+        <!--  -->
+       <grid id="grid_T_3D" >
+         <domain id="grid_T" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_2D" >
+         <domain id="grid_U" />
+       </grid>
+        <!--  -->
+       <grid id="grid_U_3D" >
+         <domain id="grid_U" />
+         <axis id="depthu" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_2D" >
+         <domain id="grid_V" />
+       </grid>
+        <!--  -->
+       <grid id="grid_V_3D" >
+         <domain id="grid_V" />
+         <axis id="depthv" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_2D" >
+         <domain id="grid_W" />
+       </grid>
+        <!--  -->
+       <grid id="grid_W_3D" >
+         <domain id="grid_W" />
+         <axis id="depthw" />
+       </grid>
+        <!--  -->
+       <grid id="grid_1point" >
+         <domain domain_ref="1point"/>
+       </grid>
+        <!--  -->
+       <grid id="grid_T_nfloat" >
+         <domain id="grid_T" />
+         <axis id="nfloat" />
+       </grid>
+        <!--  -->
+       <grid id="grid_EqT" >
+         <domain domain_ref="EqT" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_2D">
+         <domain id="gznl" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_T_3D">
+         <domain id="gznl" />
+         <axis id="deptht" />
+       </grid>
+        <!--  -->
+       <grid id="grid_znl_W_3D">
+         <domain id="gznl" />
+         <axis id="depthw" />
+       </grid>
+
+      <grid id="grid_ptr_T_2D">
+       <domain id="ptr" />
+      </grid>
+
+      <grid id="grid_ptr_T_3D">
+       <domain id="ptr" />
+         <axis id="deptht" />
+       </grid>
+
+      <grid id="grid_ptr_W_3D">
+       <domain id="ptr" />
+         <axis id="depthw" />
+      </grid>
+
+    </grid_definition>  
+  </context>
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="info_level"                type="int">0</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/param.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/param.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/param.cfg	(revision 8732)
@@ -0,0 +1,8 @@
+#- forcing files storing
+FORCING_DIR=~/FORCING
+#- input files storing
+INPUT_DIR=${CONFIG_DIR}/${NEW_CONF}/EXP00
+#- only for IBM
+#TMPDIR=${CONFIG_DIR}/${NEW_CONF}/EXP00
+#- VALIDATION files storing
+NEMO_VALIDATION_DIR=~/NEMO_VALIDATION_DIR
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/prepare_exe_dir.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 8732)
@@ -0,0 +1,74 @@
+#!/bin/bash
+##########################################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# ----------------------------------------------------------------------
+# NEMO/SETTE , NEMO Consortium (2010)
+# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+# ----------------------------------------------------------------------
+#
+# Some scripts called by sette.sh
+# prepare_exe_dir.sh : script prepares execution directory for test
+##########################################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==================
+# prepare_exe_dir.sh
+# ==================
+#
+# ----------------------------------------------
+# Set of functions used by sette.sh (NEMO tests) 
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./prepare_exe_dir.sh
+#
+# DESCRIPTION
+# ===========
+#
+# prepare_exe_dir.sh creates execution directory takes name of TEST_NAME defined in every test in sette.sh
+# 
+# it is necessary to define in sette.sh TEST_NAME ( example : export TEST_NAME="LONG") to create execution directory in where run test.
+#
+# NOTE : each test has to run in its own directory ( of execution), if not existing files are re-written (for example namelist)
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./prepare_exe_dir.sh
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: $
+#
+#   * creation
+#-
+
+
+cd ${CONFIG_DIR}
+mkdir -p ${NEW_CONF}/${TEST_NAME}
+
+export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME}
+
+cp -RL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
+cat ${SETTE_DIR}/iodef_sette.xml | sed -e"s;DEF_SHARED;${CONFIG_DIR0}/SHARED;" > ${EXE_DIR}/iodef.xml
+cd ${EXE_DIR}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/prepare_job.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/prepare_job.sh	(revision 8732)
@@ -0,0 +1,344 @@
+#####################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# ----------------------------------------------------------------------
+# NEMO/SETTE , NEMO Consortium (2010)
+# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+# ----------------------------------------------------------------------
+#
+# Some scripts called by sette.sh
+# prepare_job.sh   : creates the job script for running job 
+######################################################
+#set -vx
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# prepare_job.sh
+# ================
+#
+# -------------------------------------------------
+# script that creates the job script for NEMO tests 
+# -------------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./prepare_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPI_FLAG JOB_FILE
+#
+#
+# DESCRIPTION
+# ===========
+#
+# Part of the SETTE package to run tests for NEMO
+# 
+# prepare the script $JOB_FILE to run the tests 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./prepare_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPI_FLAG $JOB_FILE
+#
+# prepare the $JOB_FILE for execution 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: prepare_job.sh 3050 2011-11-07 14:11:34Z acc $
+#
+#
+#
+#   * creation
+#
+#-
+#
+
+usage=" Usage : ./prepare_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC TEST_NAME MPI_FLAG JOB_FILE NUM_XIO_SERVERS"
+usage=" example : ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg 8 SHORT no/yes $JOB_FILE 0 2"
+
+
+minargcount=6
+        if [ ${#} -lt ${minargcount} ]
+        then
+                echo "not enough arguments for prepare_job.sh script"
+                echo "control number of argument of prepare_job.sh in sette.sh"
+                echo "${usage}"
+        exit 1
+        fi
+        unset minargcount
+	if [ ! -f ${SETTE_DIR}/output.sette ] ; then
+	        touch ${SETTE_DIR}/output.sette
+	fi
+       
+#
+# set and export TEST_NAME. It will be used within the post_test_tidyup function
+#
+INPUTARFILE=$1
+NB_PROC=$2
+TEST_NAME=$3
+MPI_FLAG=$4
+JOB_FILE=$5
+NXIO_PROC=$6
+
+# export EXE_DIR. This directory is used to execute model 
+#
+#
+#
+echo "date: `date`" >> ${SETTE_DIR}/output.sette
+echo "" >> ${SETTE_DIR}/output.sette
+echo "running config: ${NEW_CONF}" >> ${SETTE_DIR}/output.sette
+echo "" >> ${SETTE_DIR}/output.sette
+echo "list of cpp_keys: " >> ${SETTE_DIR}/output.sette
+echo "`more ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm`" >> ${SETTE_DIR}/output.sette 
+echo "" >> ${SETTE_DIR}/output.sette
+echo "compiling with: ${CMP_NAM}" >> ${SETTE_DIR}/output.sette
+echo "" >> ${SETTE_DIR}/output.sette
+echo "executing script : \"fcm_job $@\" " >> ${SETTE_DIR}/output.sette
+echo "            " >> ${SETTE_DIR}/output.sette
+
+################################################################
+# SET INPUT 
+# get the input tarfile if needed
+if [ "$(cat ${SETTE_DIR}/$INPUTARFILE | wc -w)" -ne 0 ] ; then
+   echo "looking for input files in ${SETTE_DIR}/$INPUTARFILE " >> ${SETTE_DIR}/output.sette
+# number of tarfiles: NBTAR
+   NBTAR=`cat ${SETTE_DIR}/$INPUTARFILE |wc -l` 
+   echo "NB of tarfiles ${NBTAR} " >> ${SETTE_DIR}/output.sette
+# loop on tarfiles
+# read file name and directory
+while read tar_file dir_conf_forc 
+do
+      echo looking for tarfile ${tar_file} and directory ${FORCING_DIR}/${dir_conf_forc} ; echo looking for tarfile ${tar_file} and directory ${FORCING_DIR}/${dir_conf_forc} >> ${SETTE_DIR}/output.sette
+      if [ -f ${FORCING_DIR}/${tar_file} ] && [ -d ${FORCING_DIR}/${dir_conf_forc} ] ; then
+# Tarfile and input dir ar there, only check the links
+         echo "Tarfile and input dir ar there, only check the links" >> ${SETTE_DIR}/output.sette
+# extract tarfile
+      else 
+
+if [ ! -f ${FORCING_DIR}/${tar_file} ] ; then  
+     echo "tarfile  ${FORCING_DIR}/${tar_file} cannot be found we stop " ; exit 2 ; fi 
+
+echo "mkdir ${FORCING_DIR}/${dir_conf_forc}" >> ${SETTE_DIR}/output.sette
+         mkdir ${FORCING_DIR}/${dir_conf_forc}  
+         cd    ${FORCING_DIR}/${dir_conf_forc}
+echo " extract from tarfile ${FORCING_DIR}/${tar_file} in  ${FORCING_DIR}/${dir_conf_forc}" >> ${SETTE_DIR}/output.sette
+         tar xvof ${FORCING_DIR}/${tar_file} ; gunzip -f `find . -name "*.gz"` 
+      fi
+# Tarfile and input dir ar there, only check the links
+      cd ${FORCING_DIR}/${dir_conf_forc}
+      for fida in *
+         do
+           [ -f ${EXE_DIR}/${fida} ] || ln -s ${FORCING_DIR}/${dir_conf_forc}/${fida} ${EXE_DIR}/${fida}
+         done
+    done < ${SETTE_DIR}/$INPUTARFILE
+
+else
+  echo "no input file to be searched "
+fi
+################################################################
+
+##########################################################################
+# COPY RESTART FILES (if needed; i.e. only for SHORT job in RESTART TESTS)
+# get the input tarfile if needed
+# SF : not ok for the moment because at this point is needed cn_exp variable,
+# SF : here it it not known.
+#\cd ${EXE_DIR}
+#if [ "$(echo ${TEST_NAME} | grep -c "SHORT" )" -ne 0 ] ; then
+#    for (( i=1; i<=${NB_PROC}; ${NB_PROC}++)) ; do
+#        L_NPROC=`printf "%04d\n" $i`
+#        ln -sf ../LONG/${NEW_CONF}_00000060_restart_${L_NPROC-1}.nc .
+#    done
+#fi
+## SF : other way
+##      for file in ../LONG/${NEW_CONF}_*restart_0*.nc ; do
+##              ncpu=`echo $file | awk -F '_' '{print $NF}' | cut -f 1 -d '.'`
+##              ln -sf ${file}  .
+##      done
+##fi
+##########################################################################
+
+################################################################
+# RUN OPA
+cd ${EXE_DIR}
+if [ ! -r ${EXE_DIR}/opa ]
+    then
+    echo "executable opa does not exist"
+    echo "executable opa does not exist, exit"  >> ${SETTE_DIR}/output.sette
+    exit 1
+fi
+
+# example for NOCS ClusterVision system using SLURM batch submission (requires ${SETTE_DIR}/sette_batch_template file)
+#
+  #  if [ ${MPI_FLAG} == "no" ] ; then
+		case ${COMPILER} in 
+			X64_MOBILIS)
+                                NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 16}')
+		        	if [ ${NB_REM} == 0 ] ; then
+					# number of processes required is an integer multiple of 16
+					#
+					NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1 + $2 ) / 16}')
+				else
+					#
+					# number of processes required is not an integer multiple of 16
+					# round up the number of nodes required.
+					#
+					NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1 + $2 ) / 16 + 1 )}')
+	       			fi
+				;;
+                        XC_ARCHER_INTEL)
+                                # ocean cores are packed 24 to a node
+                                NB_REM=$( echo $NB_PROC | awk '{print ( $1 % 24 ) }')
+                                if [ ${NB_REM} == 0 ] ; then
+                                        # number of processes required is an integer multiple of 24
+                                        #
+                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1) / 24}')
+                                else
+                                        #
+                                        # number of processes required is not an integer multiple of 24
+                                        # round up the number of nodes required.
+                                        #
+                                        NB_NODES=$( echo $NB_PROC | awk '{printf("%d",($1) / 24 + 1 )}')
+                                fi
+                                # xios cores are sparsely packed at 4 to a node
+                                # but can not share nodes with the ocean cores
+                                NB_REM=$( echo $NXIO_PROC | awk '{print ( $2 % 4 ) }')
+                                if [ ${NB_REM} == 0 ] ; then
+                                        # number of processes required is an integer multiple of 4                           
+                                        #
+                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ))}')                    
+                                else
+                                        #
+                                        # number of processes required is not an integer multiple of 4                             
+                                        # round up the number of nodes required.
+                                        #
+                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}') 
+                                fi
+                                ;;
+                        XC40_METO*) #Setup for Met Office XC40 with any compiler
+                                # ocean cores are packed 32 to a node
+                                # If we need more than one node then have to use parallel queue and XIOS must have a node to itself
+                                NB_REM=$( echo $NB_PROC | awk '{print ( $1 % 32 ) }')
+                                if [ ${NB_REM} == 0 ] ; then
+                                        # number of processes required is an integer multiple of 32
+                                        #
+                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1) / 32}')
+                                else
+                                        #
+                                        # number of processes required is not an integer multiple of 32
+                                        # round up the number of nodes required.
+                                        #
+                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1) / 32 + 1 )}')
+                                fi
+                                # xios cores are sparsely packed at 4 to a node
+                                if [ $NXIO_PROC == 0 ] ; then
+                                    NB_XNODES=0
+                                else
+                                    NB_REM=$( echo $NXIO_PROC | awk '{print ( $1 % 4 ) }')
+                                    if [ ${NB_REM} == 0 ] ; then
+                                            # number of processes required is an integer multiple of 4                           
+                                            #
+                                            NB_XNODES=$( echo $NXIO_PROC | awk '{print (( $1 / 4 ) + 1)}') 
+                                    else
+                                            #
+                                            # number of processes required is not an integer multiple of 4                             
+                                            # round up the number of nodes required.
+                                            #
+                                            NB_XNODES=$( echo $NXIO_PROC | awk '{printf("%d",($1) / 4 + 1) }')                    
+                                    fi
+                                fi
+                                if [ ${NB_XNODES} -ge 1 ] ; then
+                                   NB_NODES=$((NB_NODES+NB_XNODES))
+                                fi
+                                echo NB_XNODES=${NB_XNODES} 
+                                echo Total NB_NODES=${NB_NODES}
+                                QUEUE=normal
+                                SELECT="select=$NB_NODES"
+                                module unload cray-snplauncher #Make sure snplauncher module is not loaded
+                                ;;
+                        openmpi_NAVITI_MERCATOR)
+                                echo NB_PROCS ${NB_PROC}
+                                echo NB_NODES ${NB_NODES}
+                                echo  NB_PROC ${NB_PROC}
+                                if [ ${NB_PROC} -eq 1 ] ; then
+                                   NB_NODES=1
+                                   QUEUE=monoproc
+                                   NB_PROC_NODE=${NB_PROC}
+                                else
+                                   if [ ${NB_PROC} -le 16 ] ; then
+                                      NB_NODES=1
+                                      QUEUE=mono
+                                      NB_PROC_NODE=${NB_PROC}
+                                   else
+                                      NB_NODES=$( echo $NB_PROC | awk '{print $1 - $1 % 16}'  | awk '{print $1 / 16 }')
+                                      QUEUE=multi
+                                      NB_PROC_NODE=16
+                                  fi
+                                fi
+                                echo NB_PROCS     ${NB_PROC}
+                                echo NB_NODES     ${NB_NODES}
+                                echo NB_PROC_NODE ${NB_PROC_NODE}
+                                ;;
+			*)
+				NB_NODES=${NB_PROC}
+				;;
+
+		esac
+#
+# Pass settings into job file by using sed to edit predefined strings
+#
+        TOTAL_NPROCS=$(( $NB_PROC + $NXIO_PROC ))
+        cat ${SETTE_DIR}/job_batch_template | sed -e"s/NODES/${NB_NODES}/" \
+             -e"s/TOTAL_NPROCS/${TOTAL_NPROCS}/" \
+             -e"s/NPROCS/${NB_PROC}/" \
+             -e"s/NXIOPROCS/${NXIO_PROC}/" \
+             -e"s:DEF_SETTE_DIR:${SETTE_DIR}:" -e"s:DEF_INPUT_DIR:${INPUT_DIR}:" \
+             -e"s:DEF_EXE_DIR:${EXE_DIR}:" \
+             -e"s:DEF_CONFIG_DIR:${CONFIG_DIR}:" \
+             -e"s:MPI_FLAG:${MPI_FLAG}:" \
+             -e"s:DEF_NEMO_VALIDATION:${NEMO_VALIDATION_DIR}:" -e"s:DEF_NEW_CONF:${NEW_CONF}:" \
+             -e"s:DEF_CMP_NAM:${CMP_NAM}:" -e"s:DEF_TEST_NAME:${TEST_NAME}:" > run_sette_test.job
+
+        case ${COMPILER} in
+              openmpi_NAVITI_MERCATOR)
+                    cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" \
+                                                 -e"s:QUEUE:${QUEUE}:" > run_sette_test1.job
+                    mv run_sette_test1.job run_sette_test.job
+                    ;;
+              XC40_METO*)
+                    cat run_sette_test.job | sed -e"s/SELECT/${SELECT}/" > run_sette_test1.job
+                    mv run_sette_test1.job run_sette_test.job
+                    ;;
+	esac
+#
+# create the unique submission job script
+#
+	if [ ! -f $JOB_FILE ] ; then
+		mv run_sette_test.job $JOB_FILE
+	else
+	    e=`grep -n "# END_BODY" ${JOB_FILE} | cut -d : -f 1`
+            e=$(($e - 1))
+	    head -$e $JOB_FILE > ${JOB_FILE}_new 
+	    mv ${JOB_FILE}_new ${JOB_FILE}
+	    l=`wc -l run_sette_test.job | sed -e "s:run_sette_test.job::"`
+	    b=`grep -n "# BODY" run_sette_test.job | cut -d : -f 1`
+	    t=$(($l - $b))
+	    tail -$t run_sette_test.job >> $JOB_FILE
+	fi
+	
+	chmod a+x $JOB_FILE ; echo "$JOB_FILE is ready"
+
+#fi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette.sh	(revision 8732)
@@ -0,0 +1,1397 @@
+#!/bin/bash
+############################################################
+# Author : Simona Flavoni for NEMO
+# Contact: sflod@locean-ipsl.upmc.fr
+# 2013   : A.C. Coward added options for testing with XIOS in dettached mode
+#
+# sette.sh   : principal script of SET TEsts for NEMO (SETTE)
+# ----------------------------------------------------------------------
+# NEMO/SETTE , NEMO Consortium (2010)
+# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+# ----------------------------------------------------------------------
+#
+#############################################################
+#set -vx
+set -o posix
+#set -u
+#set -e
+# ===========
+# DESCRIPTION
+# ===========
+#
+# Variables to be checked by user:
+#
+# COMPILER          : name of compiler as defined in NEMOGCM/ARCH directory 
+# BATCH_COMMAND_PAR :  name of the command for submitting parallel batch jobs
+# BATCH_COMMAND_SEQ :  name of the command for submitting sequential batch jobs  
+# INTERACT_FLAG     : flag to run in interactive mode "yes"
+#                           to run in batch mode "no"
+# MPIRUN_FLAG       : flag to run in parallel (MPI) "yes"
+#                           to run in sequential mode (NB_PROC = 1) "no"
+# USING_XIOS        : flag to control the activation of key_iomput
+#                      "yes" to compile using key_iomput and link to the external XIOS library
+#                      "no"  to compile without key_iomput and link to the old IOIPSL library
+# USING_MPMD        : flag to control the use of stand-alone IO servers
+#                     requires USING_XIOS="yes"
+#                      "yes" to run in MPMD (detached) mode with stand-alone IO servers
+#                      "no"  to run in SPMD (attached) mode without separate IO servers 
+# NUM_XIOSERVERS    : number of stand-alone IO servers to employ
+#                     set to zero if USING_MPMD="no"
+#
+# Principal script is sette.sh, that calls 
+#
+#  makenemo  : to create successive exectuables in ${CONFIG_NAME}/BLD/bin/nemo.exe 
+#              and links to opa in ${CONFIG_NAME}/EXP00)
+#
+#  param.cfg : sets and loads following directories:
+#
+#   FORCING_DIR         : is the directory for forcing files (tarfile)
+#   INPUT_DIR           : is the directory for input files storing 
+#   TMPDIR              : is the temporary directory (if needed)
+#   NEMO_VALIDATION_DIR : is the validation directory
+#
+#   (NOTE: this file is the same for all configrations to be tested with sette)
+#
+#   all_functions.sh : loads functions used by sette (note: new functions can be added here)
+#   set_namelist     : function declared in all_functions that sets namelist parameters 
+#   post_test_tidyup : creates validation storage directory and copies required output files 
+#                      (solver.stat and ocean.output) in it after execution of test.
+#
+#  VALIDATION tree is:
+#
+#   NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE)
+#
+#  prepare_exe_dir.sh : defines and creates directory where the test is executed
+#                       execution directory takes name of TEST_NAME defined for every test 
+#                       in sette.sh. (each test in executed in its own directory)
+#
+#  prepare_job.sh     : to generate the script run_job.sh
+#
+#  fcm_job.sh         : run in batch (INTERACT_FLAG="no") or interactive (INTERACT_FLAG="yes")
+#                        see sette.sh and BATCH_TEMPLATE directory
+#
+#  NOTE: jobs requiring initial or forcing data need to have an input_CONFIG.cfg in which 
+#        can be found paths to the input tar file)
+#  NOTE: if job is not launched for any reason you have the executable ready in ${EXE_DIR} 
+#        directory
+#  NOTE: the changed namelists are left in ${EXE_DIR} directory whereas original namelists 
+#        remain in ${NEW_CONF}/EXP00
+# 
+#  NOTE: a log file, output.sette, is created in ${SETTE_DIR} with the echoes of 
+#        executed commands
+#
+#  NOTE: if sette.sh is stopped in output.sette there is written the last command 
+#        executed by sette.sh
+#
+# example use: ./sette.sh 
+#########################################################################################
+#
+# Compiler among those in NEMOGCM/ARCH
+COMPILER=X64_ADA
+
+export BATCH_COMMAND_PAR="llsubmit"
+export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR
+export INTERACT_FLAG="no"
+export MPIRUN_FLAG="yes"
+export USING_XIOS="yes"
+#
+export DEL_KEYS="key_iomput"
+if [ ${USING_XIOS} == "yes" ] 
+ then 
+   export DEL_KEYS=""
+fi
+#
+# Settings which control the use of stand alone servers (only relevant if using xios)
+#
+export USING_MPMD="no"
+export NUM_XIOSERVERS=4
+export JOB_PREFIX=batch-mpmd
+#
+if [ ${USING_MPMD} == "no" ] 
+ then
+   export NUM_XIOSERVERS=0
+   export JOB_PREFIX=batch
+fi
+#
+#
+if [ ${USING_MPMD} == "yes" ] && [ ${USING_XIOS} == "no"]
+ then
+   echo "Incompatible choices. MPMD mode requires the XIOS server"
+   exit
+fi
+
+# Directory to run the tests
+SETTE_DIR=$(cd $(dirname "$0"); pwd)
+MAIN_DIR=$(dirname $SETTE_DIR)
+CONFIG_DIR0=${MAIN_DIR}/CONFIG
+TOOLS_DIR=${MAIN_DIR}/TOOLS
+COMPIL_DIR=${TOOLS_DIR}/COMPILE
+
+CMP_NAM=${1:-$COMPILER}
+# Copy job_batch_COMPILER file for specific compiler into job_batch_template
+cd ${SETTE_DIR}
+cp BATCH_TEMPLATE/${JOB_PREFIX}-${COMPILER} job_batch_template || exit
+# Description of configuration tested:
+# GYRE_PISCES       :  1 &  2
+# ORCA2_LIM3_PISCES :  3 &  4
+# ORCA2_OFF_PISCES  :  5 &  6
+# AMM12             :  7 &  8 
+# SAS               :  9     fos SAS there is no solver so is useless to test REPRO
+# ISOMIP            : 10 & 11
+# ORCA2_LIM3_OBS    : 12
+# ORCA2_AGRIF_LIM3  : 13 & 14 
+#                     15 & 16 
+
+for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
+
+do
+
+# TESTS FOR GYRE_PISCES CONFIGURATION
+if [ ${config} -eq 1 ] ;  then
+    ## Restartability tests for GYRE_PISCES
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n GYREPIS_LONG -r GYRE_PISCES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}  
+    set_namelist namelist_cfg cn_exp \"GYREPIS_LONG\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 60
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYREPIS_SHORT\"
+    set_namelist namelist_cfg nn_it000 61
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 60
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_rsttr .true.
+    set_namelist namelist_top_cfg nn_rsttr 2
+    set_namelist namelist_cfg cn_ocerst_in \"GYREPIS_LONG_00000060_restart\"
+    set_namelist namelist_top_cfg cn_trcrst_in \"GYREPIS_LONG_00000060_restart_trc\"
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/GYREPIS_LONG_00000060_restart_${L_NPROC}.nc .
+        ln -sf ../LONG/GYREPIS_LONG_00000060_restart_trc_${L_NPROC}.nc .
+    done
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+if [ ${config} -eq 2 ] ;  then
+    ## Reproducibility tests for GYRE_PISCES
+    export TEST_NAME="REPRO_4_8"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n GYREPIS_32 -r GYRE_PISCES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYREPIS_48\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 60
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_8_4"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYREPIS_84\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 60
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg jpni 8
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+fi
+
+# TESTS FOR ORCA2_LIM3_PISCES CONFIGURATION
+if [ ${config} -eq 3 ] ;  then
+    ## Restartability tests for ORCA2_LIM3_PISCES
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2LIM3PIS_LONG -r ORCA2_LIM3_PISCES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"O2L3P_LONG\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 150
+    set_namelist namelist_cfg nn_stock 75
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"O2L3P_SHORT\"
+    set_namelist namelist_cfg nn_it000 76
+    set_namelist namelist_cfg nn_itend 150
+    set_namelist namelist_cfg nn_stock 75
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg ln_icebergs .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_rsttr .true.
+    set_namelist namelist_top_cfg nn_rsttr 2
+    set_namelist namelist_cfg cn_ocerst_in \"O2L3P_LONG_00000075_restart\"
+    set_namelist namelist_ice_cfg cn_icerst_in \"O2L3P_LONG_00000075_restart_ice\"
+    set_namelist namelist_top_cfg cn_trcrst_in \"O2L3P_LONG_00000075_restart_trc\"
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false.
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/O2L3P_LONG_00000075_restart_${L_NPROC}.nc .
+        ln -sf ../LONG/O2L3P_LONG_00000075_restart_trc_${L_NPROC}.nc .
+        ln -sf ../LONG/O2L3P_LONG_00000075_restart_ice_${L_NPROC}.nc .
+        ln -sf ../LONG/O2L3P_LONG_icebergs_00000075_restart_${L_NPROC}.nc O2L3P_LONG_00000075_restart_icebergs_${L_NPROC}.nc
+    done
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+if [ ${config} -eq 4 ] ;  then
+    ## Reproducibility tests for ORCA2_LIM3_PISCES
+    export TEST_NAME="REPRO_4_8"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2LIM3PIS_32 -r ORCA2_LIM3_PISCES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg ln_icebergs .true.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_8_4"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg ln_icebergs .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 8
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+# TESTS FOR ORCA2_OFF_PISCES CONFIGURATION
+if [ ${config} -eq 5 ] ;  then
+    ## Restartability tests for ORCA2_OFF_PISCES
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2OFFPIS_LONG -r ORCA2_OFF_PISCES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"OFFP_LONG\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 40
+    set_namelist namelist_cfg nn_stock 20
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"OFFP_SHORT\"
+    set_namelist namelist_cfg nn_it000 21
+    set_namelist namelist_cfg nn_itend 40
+    set_namelist namelist_cfg nn_stock 20
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_rsttr .true.
+    set_namelist namelist_top_cfg nn_rsttr 2
+    set_namelist namelist_top_cfg cn_trcrst_in \"OFFP_LONG_00000020_restart_trc\"
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/OFFP_LONG_00000020_restart_trc_${L_NPROC}.nc .
+    done
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME}  ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC  ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+if [ ${config} -eq 6 ] ;  then
+    ## Reproducibility tests for ORCA2_OFF_PISCES
+    export TEST_NAME="REPRO_4_8"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2OFFPIS_32 -r ORCA2_OFF_PISCES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 40
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_8_4"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 40
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg jpni 8
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    # put ln_pisdmp to false : no restoring to global mean value
+    set_namelist namelist_pisces_cfg ln_pisdmp .false. 
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC  ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+# TESTS FOR AMM12 CONFIGURATION
+if [ ${config} -eq 7 ] ;  then
+    ## Restartability tests for AMM12
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide" del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 576
+    set_namelist namelist_cfg nn_stock 288
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 289
+    set_namelist namelist_cfg nn_itend 576
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_cfg cn_ocerst_in \"AMM12_00000288_restart_oce_out\"
+    set_namelist namelist_cfg nn_date0 20120102
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/AMM12_00000288_restart_oce_out_${L_NPROC}.nc .
+    done
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+if [ ${config} -eq 8 ] ;  then
+## Reproducibility tests for AMM12
+    export TEST_NAME="REPRO_8_4"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n AMM12_32 -r AMM12 -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 576
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg jpni 8
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_4_8"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 576
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+
+# TESTS FOR ORCA2_SAS_LIM3 CONFIGURATION
+if [ ${config} -eq 9 ] ;  then
+    ## Restartability tests for SAS
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n SAS_LONG -r ORCA2_SAS_LIM3 -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"SAS\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 100
+    set_namelist namelist_cfg nn_stock 50
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"SAS\"
+    set_namelist namelist_cfg nn_it000 51
+    set_namelist namelist_cfg nn_itend 100
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_ice_cfg cn_icerst_in \"SAS_00000050_restart_ice\"
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/SAS_00000050_restart_ice_${L_NPROC}.nc .
+    done
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+# TESTS FOR ISOMIP CONFIGURATION
+if [ ${config} -eq 10 ] ;  then
+    ## Restartability tests for ISOMIP
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -r ISOMIP -a TEST_CASES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"ISOMIP_LONG\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 96
+    set_namelist namelist_cfg nn_stock 48
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"ISOMIP_SHORT\"
+    set_namelist namelist_cfg nn_it000 49
+    set_namelist namelist_cfg nn_itend 96
+    set_namelist namelist_cfg nn_stock 48
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_cfg cn_ocerst_in \"ISOMIP_LONG_00000048_restart\"
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/ISOMIP_LONG_00000048_restart_${L_NPROC}.nc .
+    done
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+if [ ${config} -eq 11 ] ;  then
+    ## Reproducibility tests for ISOMIP
+    export TEST_NAME="REPRO_4_8"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ISOMIP_32 -r ISOMIP -a TEST_CASES -j 8 del_key ${DEL_KEYS}
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"ISOMIP_14\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 48
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_8_4"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"ISOMIP_22\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 48
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .false.
+    set_namelist namelist_cfg jpni 8
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 32
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ISOMIP.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+fi
+
+## Test assimilation interface code, OBS and ASM for reproducibility
+## Restartability not tested (ASM code not restartable while increments are being applied)
+if [ ${config} -eq 12 ] ; then
+   ## Reproducibility tests for ORCA2_LIM3_OBS
+    export TEST_NAME="REPRO_4_8"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM3_OBS -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3"  -j 8 add_key "key_asminc" del_key "key_top"
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg ln_icebergs .false.
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_cfg ln_diaobs .true.
+    set_namelist namelist_cfg ln_t3d .true.
+    set_namelist namelist_cfg ln_s3d .true.
+    set_namelist namelist_cfg ln_sst .true.
+    set_namelist namelist_cfg ln_sla .true.
+    set_namelist namelist_cfg ln_sic .true.
+    set_namelist namelist_cfg ln_vel3d .true.
+    set_namelist namelist_cfg ln_bkgwri .true.
+    set_namelist namelist_cfg ln_trainc .true.
+    set_namelist namelist_cfg ln_dyninc .true.
+    set_namelist namelist_cfg ln_sshinc .true.
+    set_namelist namelist_cfg ln_asmiau .true.
+    #remove all useless options for pisces (due to ORCA2_LIM3_PISCES reference configuration)
+    set_namelist namelist_top_cfg ln_trcdta .false. 
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+   cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_8_4"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .false.
+    set_namelist namelist_cfg ln_icebergs .false.
+    set_namelist namelist_cfg jpni 8
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 32
+    set_namelist namelist_cfg ln_diaobs .true.
+    set_namelist namelist_cfg ln_t3d .true.
+    set_namelist namelist_cfg ln_s3d .true.
+    set_namelist namelist_cfg ln_sst .true.
+    set_namelist namelist_cfg ln_sla .true.
+    set_namelist namelist_cfg ln_sic .true.
+    set_namelist namelist_cfg ln_vel3d .true.
+    set_namelist namelist_cfg ln_bkgwri .true.
+    set_namelist namelist_cfg ln_trainc .true.
+    set_namelist namelist_cfg ln_dyninc .true.
+    set_namelist namelist_cfg ln_sshinc .true.
+    set_namelist namelist_cfg ln_asmiau .true.
+    #remove all useless options for pisces (due to ORCA2_LIM3_PISCES reference configuration)
+    set_namelist namelist_top_cfg ln_trcdta .false.
+    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false
+    # if not you need input files, and for tests is not necessary
+    set_namelist namelist_pisces_cfg ln_presatm .false.
+    set_namelist namelist_pisces_cfg ln_varpar .false.
+    set_namelist namelist_pisces_cfg ln_dust .false.
+    set_namelist namelist_pisces_cfg ln_solub .false.
+    set_namelist namelist_pisces_cfg ln_river .false.
+    set_namelist namelist_pisces_cfg ln_ndepo .false.
+    set_namelist namelist_pisces_cfg ln_ironsed .false.
+    set_namelist namelist_pisces_cfg ln_ironice .false.
+    set_namelist namelist_pisces_cfg ln_hydrofe .false.
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_OBS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+# TEST FOR ORCA2_LIM3_AGRIF : simple test of running AGRIF (no restartability neither reproducibility tests)
+if [ ${config} -eq 13 ] ;  then
+    ## ORCA2_LIM3 with Agulhas AGRIF zoom in MPI
+    export TEST_NAME="SHORT"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_1_2 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top"
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=2
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 1
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 2
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+    set_namelist 1_namelist_cfg ln_read_cfg .true.
+    set_namelist 1_namelist_cfg ln_linssh .true.
+    set_namelist 1_namelist_cfg ln_hpg_sco .false.
+    set_namelist 1_namelist_cfg ln_hpg_zps .true. 
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+# test code corruption with AGRIF
+# Compile and run with or without AGRIF ORCA2_LIM3
+if [ ${config} -eq 14 ] ;  then
+    # First run same as 15 but without zoom
+    export TEST_NAME="SHORT_NOZOOM"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_2_2 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top"
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+# 
+#   Set the number of fine grids to zero:    
+    sed -i "1s/.*/0/" ${EXE_DIR}/AGRIF_FixedGrids.in
+
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    export TEST_NAME="SHORT_NOAGRIF"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_2_2_NAG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 del_key "key_zdftmx key_top"
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+#
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+fi
+
+## Restartability tests for ORCA2_LIM3_AGRIF 
+if [ ${config} -eq 15 ] ;  then
+    export TEST_NAME="LONG"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top"
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"O2LP_LONG\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 150
+    set_namelist namelist_cfg nn_stock 75
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+    set_namelist 1_namelist_cfg cn_exp \"O2LP_LONG\"
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 300
+    set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+    set_namelist 1_namelist_cfg ln_read_cfg .true.
+    set_namelist 1_namelist_cfg ln_linssh .true.
+    set_namelist 1_namelist_cfg ln_hpg_sco .false.
+    set_namelist 1_namelist_cfg ln_hpg_zps .true. 
+#
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . ./prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"O2LP_SHORT\"
+    set_namelist namelist_cfg nn_it000 76
+    set_namelist namelist_cfg nn_itend 150
+    set_namelist namelist_cfg nn_stock 75
+    set_namelist namelist_cfg ln_rstart .true.
+    set_namelist namelist_cfg nn_rstctl 2
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 2
+    set_namelist namelist_cfg jpnij 4
+    set_namelist 1_namelist_cfg cn_exp \"O2LP_SHORT\"
+    set_namelist 1_namelist_cfg nn_it000 151
+    set_namelist 1_namelist_cfg nn_itend 300
+    set_namelist 1_namelist_cfg nn_stock 150
+    set_namelist 1_namelist_cfg ln_rstart .true.
+    set_namelist 1_namelist_cfg nn_rstctl 2
+    set_namelist 1_namelist_cfg ln_clobber .true.
+    set_namelist 1_namelist_cfg ln_read_cfg .true.
+    set_namelist 1_namelist_cfg ln_linssh .true.
+    set_namelist 1_namelist_cfg ln_hpg_sco .false.
+    set_namelist 1_namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg cn_ocerst_in \"O2LP_LONG_00000075_restart\"
+    set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\"
+    set_namelist 1_namelist_cfg cn_ocerst_in \"O2LP_LONG_00000150_restart\"
+
+    for (( i=1; i<=$NPROC; i++)) ; do
+        L_NPROC=$(( $i - 1 ))
+        L_NPROC=`printf "%04d\n" ${L_NPROC}`
+        ln -sf ../LONG/O2LP_LONG_00000075_restart_${L_NPROC}.nc .
+        ln -sf ../LONG/O2LP_LONG_00000075_restart_ice_${L_NPROC}.nc .
+        ln -sf ../LONG/1_O2LP_LONG_00000150_restart_${L_NPROC}.nc .
+    done
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+## Reproducibility tests for ORCA2_LIM3_AGRIF
+if [ ${config} -eq 16 ] ;  then
+    export TEST_NAME="REPRO_4_4"
+    cd ${CONFIG_DIR0}
+    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top"
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=16
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 4
+    set_namelist namelist_cfg jpnj 4
+    set_namelist namelist_cfg jpnij 16
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+    set_namelist 1_namelist_cfg ln_read_cfg .true.
+    set_namelist 1_namelist_cfg ln_linssh .true.
+    set_namelist 1_namelist_cfg ln_hpg_sco .false.
+    set_namelist 1_namelist_cfg ln_hpg_zps .true. 
+
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_2_8"
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=16
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 75
+    set_namelist namelist_cfg ln_ctl .false.
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg ln_read_cfg .true.
+    set_namelist namelist_cfg ln_linssh .true.
+    set_namelist namelist_cfg ln_hpg_sco .false.
+    set_namelist namelist_cfg ln_hpg_zps .true. 
+    set_namelist namelist_cfg nn_fwb 0
+    set_namelist namelist_cfg jpni 2
+    set_namelist namelist_cfg jpnj 8
+    set_namelist namelist_cfg jpnij 16
+    set_namelist 1_namelist_cfg nn_it000 1
+    set_namelist 1_namelist_cfg nn_itend 150
+    set_namelist 1_namelist_cfg ln_ctl .false.
+    set_namelist 1_namelist_cfg ln_clobber .true.
+    set_namelist 1_namelist_cfg ln_read_cfg .true.
+    set_namelist 1_namelist_cfg ln_linssh .true.
+    set_namelist 1_namelist_cfg ln_hpg_sco .false.
+    set_namelist 1_namelist_cfg ln_hpg_zps .true. 
+
+    if [ ${USING_MPMD} == "yes" ] ; then
+       set_xio_using_server iodef.xml true
+    else
+       set_xio_using_server iodef.xml false
+    fi
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_ORCA2_LIM3_AGRIF.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+fi
+
+done
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_beginner.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_beginner.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_beginner.sh	(revision 8732)
@@ -0,0 +1,168 @@
+#!/bin/bash
+#############################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# sette_beginner.sh   : example of script of SET TEsts for NEMO (SETTE)
+# ----------------------------------------------------------------------
+# NEMO/SETTE , NEMO Consortium (2010)
+# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+# ----------------------------------------------------------------------
+#
+#############################################################
+#set -vx
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ===================
+# sette_beginner.sh
+# ===================
+#
+# COMPILER          : name of compiler as defined in NEMOGCM/ARCH directory 
+# BATCH_COMMAND_PAR :  name of the command for submitting parallel batch jobs
+# BATCH_COMMAND_SEQ :  name of the command for submitting sequential batch jobs  
+# INTERACT_FLAG     : flag to run in interactive mode "yes"
+#                           to run in batch mode "no"
+# MPIRUN_FLAG       : flag to run in parallel (MPI) "yes"
+#                           to run in sequential mode (NB_PROC = 1) "no"
+# USING_XIOS        : flag to control the activation of key_iomput
+#                      "yes" to compile using key_iomput and link to the external XIOS library
+#                      "no"  to compile without key_iomput and link to the old IOIPSL library
+# USING_MPMD        : flag to control the use of stand-alone IO servers
+#                     requires USING_XIOS="yes"
+#                      "yes" to run in MPMD (detached) mode with stand-alone IO servers
+#                      "no"  to run in SPMD (attached) mode without separate IO servers 
+# NUM_XIOSERVERS    : number of stand-alone IO servers to employ
+#                     set to zero if USING_MPMD="no"
+#
+# Principal script is sette.sh, that calls 
+#
+#  makenemo  : to create successive exectuables in ${CONFIG_NAME}/BLD/bin/nemo.exe 
+#              and links to opa in ${CONFIG_NAME}/EXP00)
+#
+#  param.cfg : sets and loads following directories:
+#
+#   FORCING_DIR         : is the directory for forcing files (tarfile)
+#   INPUT_DIR           : is the directory for input files storing 
+#   TMPDIR              : is the temporary directory (if needed)
+#   NEMO_VALIDATION_DIR : is the validation directory
+#
+#   (NOTE: this file is the same for all configrations to be tested with sette)
+#
+#   all_functions.sh : loads functions used by sette (note: new functions can be added here)
+#   set_namelist     : function declared in all_functions that sets namelist parameters 
+#   post_test_tidyup : creates validation storage directory and copies required output files 
+#                      (solver.stat and ocean.output) in it after execution of test.
+#
+#  VALIDATION tree is:
+#
+#   NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE)
+#
+#  prepare_exe_dir.sh : defines and creates directory where the test is executed
+#                       execution directory takes name of TEST_NAME defined for every test 
+#                       in sette.sh. (each test in executed in its own directory)
+#
+#  prepare_job.sh     : to generate the script run_job.sh
+#
+#  fcm_job.sh         : run in batch (INTERACT_FLAG="no") or interactive (INTERACT_FLAG="yes")
+#                        see sette.sh and BATCH_TEMPLATE directory
+#
+#  NOTE: jobs requiring initial or forcing data need to have an input_CONFIG.cfg in which 
+#        can be found paths to the input tar file)
+#  NOTE: if job is not launched for any reason you have the executable ready in ${EXE_DIR} 
+#        directory
+#  NOTE: the changed namelists are left in ${EXE_DIR} directory whereas original namelists 
+#        remain in ${NEW_CONF}/EXP00
+# 
+#  NOTE: a log file, output.sette, is created in ${SETTE_DIR} with the echoes of 
+#        executed commands
+#
+#  NOTE: if sette.sh is stopped in output.sette there is written the last command 
+#        executed by sette.sh
+#
+# example use: ./sette_beginner.sh 
+#########################################################################################
+#
+# Compiler among those in NEMOGCM/ARCH
+COMPILER=x3750_ADA
+export BATCH_COMMAND_PAR="llsubmit"
+export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR
+export INTERACT_FLAG="yes"
+export MPIRUN_FLAG="yes"
+
+export DEL_KEYS="key_iomput"
+if [ ${USING_XIOS} == "yes" ]
+ then 
+   export DEL_KEYS=""
+fi
+
+#
+# Settings which control the use of stand alone servers (only relevant if using xios)
+#
+export USING_MPMD="no"
+export NUM_XIOSERVERS=4
+export JOB_PREFIX=batch-mpmd
+#
+if [ ${USING_MPMD} == "no" ] 
+ then
+   export NUM_XIOSERVERS=0
+   export JOB_PREFIX=batch
+fi
+#
+#
+if [ ${USING_MPMD} == "yes" ] && [ ${USING_XIOS} == "no"]
+ then
+   echo "Incompatible choices. MPMD mode requires the XIOS server"
+   exit
+fi
+#
+
+# Directory to run the tests
+SETTE_DIR=$(cd $(dirname "$0"); pwd)
+MAIN_DIR=${SETTE_DIR%/SETTE}
+CONFIG_DIR=${MAIN_DIR}/CONFIG
+TOOLS_DIR=${MAIN_DIR}/TOOLS
+COMPIL_DIR=${TOOLS_DIR}/COMPILE
+
+CMP_NAM=${1:-$COMPILER}
+# Copy job_batch_COMPILER file for specific compiler into job_batch_template
+cd ${SETTE_DIR}
+cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+
+# Run for GYRE CONFIG
+# small test to start
+# compile GYRE configuration with gfortran_osx compiler run with 4 proc : 
+export TEST_NAME="SHORT_TEST"
+cd ${CONFIG_DIR}
+. ./makenemo -m ${CMP_NAM} -n GYRE_SHORT -r GYRE -j 10 add_key "key_nosignedzero" del_key ${DEL_KEYS}
+cd ${SETTE_DIR}
+. ./param.cfg 
+. ./all_functions.sh
+. ./prepare_exe_dir.sh
+# creation of execution directory
+JOB_FILE=${EXE_DIR}/run_job.sh
+# setting number of procs used
+NPROC=4
+if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+cd ${EXE_DIR}
+# setting namelist parameters
+# experience name
+set_namelist namelist_cfg cn_exp \"GYRE_SHORT\"
+# first time step
+set_namelist namelist_cfg nn_it000 1
+# last time step
+set_namelist namelist_cfg nn_itend 120
+# frequency of creation of a restart file
+set_namelist namelist_cfg nn_stock 60
+if [ ${USING_MPMD} == "yes" ] ; then
+      set_xio_using_server iodef.xml true
+   else
+      set_xio_using_server iodef.xml false
+fi
+cd ${SETTE_DIR}
+. ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+# run job, with 4 processors, test named SHORT (= 60 time steps)
+cd ${SETTE_DIR}   
+. ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_rpt.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_rpt.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_rpt.sh	(revision 8732)
@@ -0,0 +1,229 @@
+#!/bin/bash -f
+#
+# simple SETTE report generator.
+#
+# This version should be run in the SETTE directory. 
+# The machine name will be picked up from the sette.sh script but the location of the
+# validation directory needs to be set here (currently assumed to reside in the ../CONFIG directory)
+#
+#########################################################################################
+######################### Start of function definitions #################################
+##
+function resttest() { 
+#
+# Restartability checks. Expects LONG and SHORT run directories
+# Compares end of LONG stat files with equivalent entries from the SHORT stat files.
+#
+  vdir=$1
+  nam=$2
+  pass=$3
+#
+  if [ -d $vdir/$nam ]; then
+    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
+    dorv=`echo $dorv | sed -e 's:.*/::'`
+    f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output
+    f1s=$vdir/$nam/$mach/$dorv/LONG/solver.stat
+    f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat
+    f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output
+    f2s=$vdir/$nam/$mach/$dorv/SHORT/solver.stat
+    f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat
+
+    if  [ ! -f $f1s ] &&  [ ! -f $f1t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+    if  [ ! -f $f2s ] &&  [ ! -f $f2t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+#
+    done_oce=0
+
+    if  [  -f $f1s ] && [  -f $f2s ]; then 
+      nl=(`wc -l $f2s`)
+      tail -${nl[0]} $f1s > f1.tmp$$
+      cmp -s f1.tmp$$ $f2s
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then 
+          printf "%-20s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view solver.stat differences"
+          read y
+          sdiff f1.tmp$$ $f2s
+          echo "<return> to view ocean.output differences"
+          read y
+          sdiff $f1o $f2o | grep "|"
+          done_oce=1
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+#
+# Check tracer.stat files (if they exist)
+#
+    if  [  -f $f1t ] && [  -f $f2t ]; then
+      nl=(`wc -l $f2t`)
+      tail -${nl[0]} $f1t > f1.tmp$$
+      cmp -s f1.tmp$$ $f2t
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then 
+          printf "%-20s %s %s\n" $nam  " tracer.stat restartability  passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " tracer.stat restartability  FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view tracer.stat differences"
+          read y
+          sdiff f1.tmp$$ $f2t
+#
+# Only offer ocean.output view if it has not been viewed previously
+#
+          if [ $done_oce == 0 ]; then
+            echo "<return> to view ocean.output differences"
+            read y
+            sdiff $f1o $f2o | grep "|"
+          fi
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+    rm f1.tmp$$
+  fi
+}
+
+function reprotest(){
+#
+# Reproducibility checks. Expects REPRO_N_M and REPRO_I_J run directories
+# Compares end of stat files from each
+#
+  vdir=$1
+  nam=$2
+  pass=$3
+#
+  if [ -d $vdir/$nam ]; then
+    dorv=`ls -1rt $vdir/$nam/$mach/ | tail -1l `
+    dorv=`echo $dorv | sed -e 's:.*/::'`
+    rep1=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -2l | head -1 `
+    rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l`
+    f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output
+    f1s=$vdir/$nam/$mach/$dorv/$rep1/solver.stat
+    f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat
+    f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output
+    f2s=$vdir/$nam/$mach/$dorv/$rep2/solver.stat
+    f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat
+
+    if  [ ! -f $f1s ] && [ ! -f $f1t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+    if  [ ! -f $f2s ] && [ ! -f $f2t ] ; then 
+      printf "%-20s %s\n" $nam " incomplete test";
+      return; 
+    fi
+#
+    done_oce=0
+
+    if  [ -f $f1s ] && [ -f $f2s ] ; then
+      cmp -s $f1s $f2s
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then 
+          printf "%-20s %s %s\n" $nam  " solver.stat reproducibility passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " solver.stat reproducibility FAILED : " $dorv 
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view solver.stat differences"
+          read y
+          sdiff f1.tmp$$ $f2s
+          echo "<return> to view ocean.output differences"
+          read y
+          sdiff $f1o $f2o | grep "|"
+          done_oce=1
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+#
+# Check tracer.stat files (if they exist)
+#
+    if  [ -f $f1t ] && [ -f $f2t ] ; then
+      cmp -s $f1t $f2t
+      if [ $? == 0 ]; then
+        if [ $pass == 0 ]; then           printf "%-20s %s %s\n" $nam  " tracer.stat reproducibility passed : " $dorv
+        fi
+      else
+        printf "%-20s %s %s\n" $nam  " tracer.stat reproducibility  FAILED : " $dorv
+#
+# Offer view of differences on the second pass
+#
+        if [ $pass == 1 ]; then
+          echo "<return> to view tracer.stat differences"
+          read y
+          sdiff $f1t $f2t
+#
+# Only offer ocean.output view if it has not been viewed previously
+#
+          if [ $done_oce == 0 ]; then
+            echo "<return> to view ocean.output differences"
+            read y
+            sdiff $f1o $f2o | grep "|"
+          fi
+          echo "<return> to continue"
+          read y
+        fi
+      fi
+    fi
+  fi
+}
+########################### END of function definitions #################################
+##                                                                                     ##
+##    Main script                                                                      ##
+##                                                                                     ##
+#########################################################################################
+#
+  mach=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'`
+  NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'`
+#
+  if [ ! -d $NEMO_VALID ]; then
+    echo "$NEMO_VALID validation directory not found"
+    exit
+  fi
+#
+# The script also needs the date or revision tag. Currently this is taken from the latest sub-directory found in each directory
+#  
+for pass in  0 1 
+do
+#
+ if [ $pass == 1 ]; then echo "---------------2nd pass------------------";fi
+#
+# Restartability test
+#
+ for restart_test in WGYREPIS_LONG WORCA2LIM3PIS_LONG WORCA2OFFPIS_LONG WAMM12_LONG WSAS_LONG WISOMIP_LONG WORCA2AGUL_LONG
+ do
+   resttest $NEMO_VALID $restart_test $pass
+ done
+#
+# Reproducibility tests
+#
+ for repro_test in WGYREPIS_32 WORCA2LIM3PIS_32 WORCA2OFFPIS_32 WAMM12_32 WISOMIP_32 WORCA2_LIM3_OBS WORCA2AGUL_1_2 WORCA2AGUL_16 WORCA2AGUL_2_2_NAG
+ do
+   reprotest $NEMO_VALID $repro_test $pass
+ done
+#
+done
+exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_xios.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_xios.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_xios.sh	(revision 8732)
@@ -0,0 +1,440 @@
+#!/bin/bash
+############################################################
+# Author : Italo Epicoco - CMCC
+# Contact: italo.epicoco@unisalento.it
+# 2014   : A.C. Coward added new namelist settings for GYRE configuration
+#
+# sette_xios.sh   : additional script of SET TEsts for XIOS within NEMO
+# ----------------------------------------------------------------------
+# NEMO/SETTE , NEMO Consortium (2014)
+# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+# ----------------------------------------------------------------------
+#
+#############################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+# ===========
+# DESCRIPTION
+# ===========
+#
+# Variables to be checked by user:
+#
+# COMPILER          : name of compiler as defined in NEMOGCM/ARCH directory 
+# BATCH_COMMAND_PAR :  name of the command for submitting parallel batch jobs
+# BATCH_COMMAND_SEQ :  name of the command for submitting sequential batch jobs  
+# INTERACT_FLAG     : flag to run in interactive mode "yes"
+#                           to run in batch mode "no"
+# MPIRUN_FLAG       : flag to run in parallel (MPI) "yes"
+#                           to run in sequential mode (NB_PROC = 1) "no"
+# USING_MPMD        : flag to control the use of stand-alone IO servers
+#                      "true" to run in MPMD (detached) mode with stand-alone IO servers
+#                      "false"  to run in SPMD (attached) mode without separate IO servers 
+# NUM_XIOSERVERS    : number of stand-alone IO servers to employ
+#                     set to zero if USING_MPMD="false"
+#
+# Principal script is sette_xios.sh, that calls 
+#
+#  makenemo  : to create successive exectuables in ${CONFIG_NAME}/BLD/bin/nemo.exe 
+#              and links to opa in ${CONFIG_NAME}/EXP00)
+#
+#  param.cfg : sets and loads following directories:
+#
+#   FORCING_DIR         : is the directory for forcing files (tarfile)
+#   INPUT_DIR           : is the directory for input files storing 
+#   TMPDIR              : is the temporary directory (if needed)
+#   NEMO_VALIDATION_DIR : is the validation directory
+#
+#   (NOTE: this file is the same for all configrations to be tested with sette)
+#
+#   all_functions.sh : loads functions used by sette (note: new functions can be added here)
+#   set_namelist     : function declared in all_functions that sets namelist parameters 
+#   post_test_tidyup : creates validation storage directory and copies required output files 
+#                      (solver.stat and ocean.output) in it after execution of test.
+#
+#  VALIDATION tree is:
+#
+#   NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE)
+#
+#  prepare_exe_dir.sh : defines and creates directory where the test is executed
+#                       execution directory takes name of TEST_NAME defined for every test 
+#                       in sette.sh. (each test in executed in its own directory)
+#
+#  prepare_job.sh     : to generate the script run_job.sh
+#
+#  fcm_job.sh         : run in batch (INTERACT_FLAG="no") or interactive (INTERACT_FLAG="yes")
+#                        see sette.sh and BATCH_TEMPLATE directory
+#
+#  NOTE: jobs requiring initial or forcing data need to have an input_CONFIG.cfg in which 
+#        can be found paths to the input tar file)
+#  NOTE: if job is not launched for any reason you have the executable ready in ${EXE_DIR} 
+#        directory
+#  NOTE: the changed namelists are left in ${EXE_DIR} directory whereas original namelists 
+#        remain in ${NEW_CONF}/EXP00
+# 
+#  NOTE: a log file, output.sette, is created in ${SETTE_DIR} with the echoes of 
+#        executed commands
+#
+#  NOTE: if sette_xios.sh is stopped in output.sette there is written the last command 
+#        executed by sette_xios.sh
+#
+# example use: ./sette_xios.sh 
+#########################################################################################
+#
+# Compiler among those in NEMOGCM/ARCH
+COMPILER=
+export BATCH_COMMAND_PAR="llsubmit"
+export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR
+export INTERACT_FLAG="no"
+export MPIRUN_FLAG="yes"
+#
+
+# Directory to run the tests
+SETTE_DIR=$(cd $(dirname "$0"); pwd)
+MAIN_DIR=${SETTE_DIR%/SETTE}
+CONFIG_DIR=${MAIN_DIR}/CONFIG
+TOOLS_DIR=${MAIN_DIR}/TOOLS
+COMPIL_DIR=${TOOLS_DIR}/COMPILE
+
+CMP_NAM=${1:-$COMPILER}
+#
+#=================================================================================
+# Copy job_batch_COMPILER file for specific compiler into job_batch_template
+# Note this batch template needs to be capable of launching both SPMD and MPMD
+# tasks with internal selection depending on the value of NUM_XIOSERVERS
+# (0=SPMD; >0 = MPMD)
+#=================================================================================
+#
+cd ${SETTE_DIR}
+cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+
+for config in 1 2  
+
+do
+
+#==========================================================
+# TESTS FOR XIOS USING GYRE CONFIGURATION AT LOW RESOLUTION
+#==========================================================
+
+if [ ${config} -eq 1 ] ;  then
+    ## Test of XIOS configured in attached mode with multiple output files (one for each process). 
+    ## $NPROC processes are used 
+
+    NPROC=4
+    jp_cfg=1
+    jpni=2
+    jpnj=2
+    export NUM_XIOSERVERS=0
+    export USING_MPMD="false"
+
+    export TEST_NAME="ATTACHED_MULTIPLE"
+
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_XIOS_LR -r GYRE_XIOS -j 8 
+    cd ${SETTE_DIR}
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}  
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_LR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml multiple_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+
+    ## Test of XIOS configured in attached mode with a single output file. 
+
+    export TEST_NAME="ATTACHED_ONE"
+    export NUM_XIOSERVERS=0
+    export USING_MPMD="false"
+    cd ${SETTE_DIR} 
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_LR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml one_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+
+    ## Test of XIOS configured in detached mode with a single output file. 
+    ## $NUM_XIOSERVERS IO server are used.
+    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 
+
+    export TEST_NAME="DETACHED_ONE"
+    export NUM_XIOSERVERS=2
+    export USING_MPMD="true"
+    cd ${SETTE_DIR}
+#
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_LR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml one_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    ## Test of XIOS configured in detached mode with multiple output files (one for each IO server). 
+    ## $NUM_XIOSERVERS IO server are used.
+    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 
+
+
+    export TEST_NAME="DETACHED_MULTIPLE"
+    export NUM_XIOSERVERS=2
+    export USING_MPMD="true"
+    cd ${SETTE_DIR}
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_LR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml multiple_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+fi
+
+#==========================================================
+# TESTS FOR XIOS USING GYRE CONFIGURATION AT HIGH RESOLUTION
+#==========================================================
+
+if [ ${config} -eq 2 ] ;  then
+    ## Test of XIOS configured in attached mode with multiple output files (one for each process). 
+    ## $NPROC processes are used 
+
+    NPROC=64
+    jp_cfg=30
+    jpni=8
+    jpnj=8
+    export NUM_XIOSERVERS=0
+    export USING_MPMD="false"
+
+    export TEST_NAME="ATTACHED_MULTIPLE"
+
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_XIOS_HR -r GYRE_XIOS -j 8
+    cd ${SETTE_DIR}
+#
+    . ./param.cfg
+    . ./all_functions.sh
+    . ./prepare_exe_dir.sh
+#
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_HR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg nn_bench 1
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml multiple_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+
+    ## Test of XIOS configured in attached mode with a single output file. 
+
+    export TEST_NAME="ATTACHED_ONE"
+    export NUM_XIOSERVERS=0
+    export USING_MPMD="false"
+    cd ${SETTE_DIR}
+#
+    . ./prepare_exe_dir.sh
+#
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_HR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg nn_bench 1
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml one_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+
+    ## Test of XIOS configured in detached mode with a single output file. 
+    ## $NUM_XIOSERVERS IO server are used.
+    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 
+
+    export TEST_NAME="DETACHED_ONE"
+    export NUM_XIOSERVERS=8
+    export USING_MPMD="true"
+    cd ${SETTE_DIR}
+#
+    . ./prepare_exe_dir.sh
+#
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_HR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg nn_bench 1
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml one_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+    ## Test of XIOS configured in detached mode with multiple output files (one for each IO server). 
+    ## $NUM_XIOSERVERS IO server are used.
+    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 
+
+    export TEST_NAME="DETACHED_MULTIPLE"
+    export NUM_XIOSERVERS=8
+    export USING_MPMD="true"
+    cd ${SETTE_DIR}
+    . ./prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
+    cd ${EXE_DIR}
+    set_namelist namelist_cfg cn_exp \"GYRE_XIOS_HR\"
+    set_namelist namelist_cfg nn_it000 1
+    set_namelist namelist_cfg nn_itend 120
+    set_namelist namelist_cfg nn_stock 120
+    set_namelist namelist_cfg nn_bench 1
+    set_namelist namelist_cfg ln_clobber .true.
+    set_namelist namelist_cfg jp_cfg $jp_cfg
+    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 ))
+    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 ))
+    set_namelist namelist_cfg jpni $jpni
+    set_namelist namelist_cfg jpnj $jpnj
+    set_namelist namelist_cfg jpnij $NPROC
+
+    set_xio_using_server iodef.xml $USING_MPMD
+    set_xio_file_type    iodef.xml multiple_file
+
+    cd ${SETTE_DIR}
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS}
+
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG}
+
+fi
+
+done
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder	(revision 8732)
@@ -0,0 +1,58 @@
+#!/bin/ksh
+
+# CALLS: bdy_reorder.exe
+
+#set -ax
+usage ()
+{
+   echo
+   echo "  bdy_reorder"
+   echo "  ************"
+   echo
+   echo "  usage: ${0##*/} [-c] file_in file_out"
+   echo
+   echo "  flags:    -c          target file is a coordinates.bdy.nc file"
+   echo "            -t          template file"
+   echo
+   exit 1
+}
+
+ln_coordinates=".false."
+file_template=""
+
+while getopts ct: opt
+do
+  case ${opt} in
+      c) 
+         ln_coordinates=".true." 
+      ;;
+      t) 
+         file_template=${OPTARG}
+      ;;
+      [?]) usage
+      ;;
+  esac
+done
+shift $(expr ${OPTIND} - 1)
+
+if [[ $# < 2 ]] ; then
+   usage
+fi
+
+script_dir=$(dirname $0)
+
+file_in=$1
+file_out=$2
+
+cat > nam_bdy_reorder << EOC
+&nam_bdy_reorder
+file_in='${file_in}'
+file_out='${file_out}'
+file_template='${file_template}'
+ln_coordinates=${ln_coordinates}
+EOC
+echo "/" >> nam_bdy_reorder
+
+${script_dir}/bdy_reorder.exe 
+
+exit 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90	(revision 8732)
@@ -0,0 +1,609 @@
+PROGRAM bdy_reorder
+
+!===============================================================================
+! A routine to reorder old BDY data files to make them compatible with NEMO 3.4.
+!
+! This routine has 2 modes:
+!   1. If no template file is given then it will re-order the data in the input
+!      file so that it is in order of increasing nbr. 
+!   2. If a template file is given it will re-order the data in the input file 
+!      be consistent with the order of the data in the template file. This is 
+!      useful for making old barotropic and baroclinic data files consistent. 
+!      For older versions of NEMO the barotropic boundary data did not have to
+!      be in the same order as the baroclinic boundary data. The rimwidth 
+!      value can be different in the input file and template file; in this case 
+!      the routine will just re-order the data that the two files have in common. 
+!
+! The routine is mainly for re-ordering BDY data files, but can also be used to
+! re-order BDY coordinate files if ln_coordinates is set to .true.
+!
+! Author: Dave Storkey  Aug 2011
+! Bug notifications etc to:  dave.storkey@metoffice.gov.uk
+!
+!===============================================================================
+  
+      USE netcdf
+
+      IMPLICIT NONE
+
+      INTEGER,PARAMETER         :: numnam=11
+      INTEGER,PARAMETER         :: sp=SELECTED_REAL_KIND(6,37)
+      INTEGER,PARAMETER         :: dp=SELECTED_REAL_KIND(12,307)
+      INTEGER                   :: chunksize = 32000000
+
+      INTEGER                   :: jpbgrd, iostat, ncid_in, ncid_out, ncid_template, nbrid(4), nbrid_template(4)
+      INTEGER                   :: dimids(10), unlimitedDimId
+      INTEGER                   :: xtype, dimid, varid, ndims, ndims_var, nvars, natts, nblen(4), nblen_template(4), dimlen(10)
+      INTEGER                   :: lenvar(10), igrid, ib, ib1, ir, idim, jgrid, jv, icount, attid, len1, idepth, itime
+      INTEGER                   :: idim_time, idim_xb, idim_yb, idim_depth
+      INTEGER                   :: nbr_min, nbr_max, nbr_min_template, nbr_max_template, strlen, nbr_match
+
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbr, imap
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbi, nbj
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbi_template
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbj_template
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbr_template
+
+      INTEGER, ALLOCATABLE, DIMENSION(:)     :: nbi_extract, nbj_extract
+
+      INTEGER,  ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_int, varout_int
+      REAL(sp), ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_float, varout_float
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_dble, varout_dble
+
+      LOGICAL                   :: ln_coordinates
+      LOGICAL                   :: ln_template
+
+      CHARACTER(LEN=nf90_max_name)        :: attname, dimname, varname, time, date, zone, timestamp
+      CHARACTER(LEN=nf90_max_name)        :: file_in, file_out, file_template, nbi_name, nbj_name, nbr_name
+      CHARACTER(LEN=1),DIMENSION(4)       :: cgrid
+      CHARACTER(LEN=1)                    :: end_letter
+
+      NAMELIST/nam_bdy_reorder/ file_in, file_out, file_template, ln_coordinates, nbr_match
+
+!=============================================================================
+
+!-----------------------------------------------------------------------------
+! 0. Read namelist and initialise parameters
+!----------------------------------------------------------------------------- 
+
+      file_in = ''
+      file_out = ''
+      file_template = ''
+      ln_coordinates = .false.
+      nbr_match = 0
+
+      OPEN( UNIT=numnam, FILE='nam_bdy_reorder', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, nam_bdy_reorder )
+      CLOSE( UNIT=numnam )
+
+      IF( ln_coordinates ) THEN
+         WRITE(*,*) 'Input file is a coordinates.bdy.nc file.'
+         jpbgrd = 4
+      ELSE
+          WRITE(*,*) 'Input file is a boundary data file.'
+         jpbgrd = 1
+      ENDIF
+ 
+      IF( LEN_TRIM(file_template) > 0 ) THEN 
+         WRITE(*,*) 'Reordering data to match template file.'
+         ln_template = .true.
+      ELSE 
+         WRITE(*,*) 'Reordering data in order of increasing nbr values.'
+         ln_template = .false.
+      ENDIF
+
+      cgrid= (/'t','u','v','f'/)
+
+!-----------------------------------------------------------------------------
+! 1. Read in nbr variables from file and create mapping. 
+!----------------------------------------------------------------------------- 
+
+! 1.1 Open input files
+
+      iostat = nf90_open( TRIM(file_in), nf90_nowrite, ncid_in )
+      IF (iostat /= nf90_noerr) THEN
+        WRITE(6,*) TRIM(nf90_strerror(iostat))
+        STOP
+      ENDIF
+      iostat = nf90_inquire( ncid_in, ndims, nvars, natts )
+
+      IF( ln_template ) THEN
+         iostat = nf90_open( TRIM(file_template), nf90_nowrite, ncid_template )
+         IF (iostat /= nf90_noerr) THEN
+           WRITE(6,*) TRIM(nf90_strerror(iostat))
+           STOP
+         ENDIF
+      ENDIF
+
+      DO igrid=1,jpbgrd
+
+! 1.2 Find dimensions of data in input files and allocate arrays
+
+         IF( ln_coordinates ) THEN
+            nbr_name = 'nbr'//cgrid(igrid)
+         ELSE
+            nbr_name = 'nbrdta'
+         ENDIF
+
+         iostat = nf90_inq_varid( ncid_in, nbr_name , nbrid(igrid) )
+         IF (iostat /= nf90_noerr) THEN
+            WRITE(6,*) TRIM(nf90_strerror(iostat))
+            STOP
+         ENDIF
+         iostat = nf90_inquire_variable( ncid_in, nbrid(igrid), ndims=ndims, dimids=dimids )
+         IF( ndims .ne. 2 ) THEN
+            WRITE(*,*) 'ERROR : ',TRIM(nbr_name),' does not have exactly 2 dimensions.'
+            WRITE(*,*) '        in file ',TRIM(file_in)
+            STOP
+         ENDIF
+         iostat = nf90_inquire_dimension( ncid_in, dimids(1), len=nblen(igrid))
+         iostat = nf90_inquire_dimension( ncid_in, dimids(2), len=len1)
+         WRITE(*,*) 'nblen(igrid), len1 : ',nblen(igrid), len1
+         IF( len1 .ne. 1 ) THEN 
+            WRITE(*,*) 'ERROR : second dimension of ',TRIM(nbr_name),' does not have length 1.'
+            WRITE(*,*) '        in file ',TRIM(file_in)
+            WRITE(*,*) '        len1 = ',len1
+            STOP
+         ENDIF
+
+         IF( ln_template ) THEN 
+
+            iostat = nf90_inq_varid( ncid_template, nbr_name , nbrid_template(igrid) )
+            IF (iostat /= nf90_noerr) THEN
+               WRITE(6,*) TRIM(nf90_strerror(iostat))
+               STOP
+            ENDIF
+            iostat = nf90_inquire_variable( ncid_template, nbrid_template(igrid), ndims=ndims, dimids=dimids )
+            IF( ndims .ne. 2 ) THEN
+               WRITE(*,*) 'ERROR : ',TRIM(nbr_name),' does not have exactly 2 dimensions.'
+               WRITE(*,*) '        in file ',TRIM(file_template)
+               STOP
+            ENDIF
+            iostat = nf90_inquire_dimension( ncid_template, dimids(1), len=nblen_template(igrid))
+            iostat = nf90_inquire_dimension( ncid_template, dimids(2), len=len1)
+            WRITE(*,*) 'nblen_template(igrid), len1 : ',nblen_template(igrid), len1
+            IF( len1 .ne. 1 ) THEN 
+               WRITE(*,*) 'ERROR : second dimension of ',TRIM(nbr_name),' does not have length 1.'
+               WRITE(*,*) '        in file ',TRIM(file_template)
+               WRITE(*,*) '        len1 = ',len1
+               STOP
+            ENDIF
+
+         ENDIF ! ln_template
+
+      ENDDO  ! jpbgrd
+
+      ALLOCATE( nbr(MAXVAL(nblen),1), imap(MAXVAL(nblen),jpbgrd) )
+      IF( ln_template ) THEN 
+         ALLOCATE( nbi(MAXVAL(nblen),1), nbj(MAXVAL(nblen),1) )
+         ALLOCATE( nbi_template(MAXVAL(nblen_template),1) )
+         ALLOCATE( nbj_template(MAXVAL(nblen_template),1) )
+         ALLOCATE( nbr_template(MAXVAL(nblen_template),1) )
+      ENDIF
+
+! 1.3 Read in nbr variables and generate mapping.
+
+      nbr(:,:) = -1
+      imap(:,:) = -1    
+      IF( ln_template ) THEN 
+         nbi(:,:) = -1
+         nbj(:,:) = -1
+         nbi_template(:,:) = -1
+         nbj_template(:,:) = -1
+         nbr_template(:,:) = -1
+      ENDIF
+
+      WRITE(*,*) '>>> Generating map.'
+      DO igrid=1,jpbgrd
+
+         iostat = nf90_get_var( ncid_in, nbrid(igrid), nbr(1:nblen(igrid),1:1) ) 
+         IF (iostat /= nf90_noerr) THEN
+           WRITE(6,*) TRIM(nf90_strerror(iostat))
+           STOP
+         ENDIF
+
+         nbr_min = MINVAL( nbr(1:nblen(igrid),1) )
+         nbr_max = MAXVAL( nbr(1:nblen(igrid),1) )
+         IF( nbr_min .ne. 1 ) THEN
+            WRITE(*,*) 'Something wrong with input file ',file_in
+            WRITE(*,*) 'MIN(nbr) /= 1'
+            STOP
+         ENDIF
+
+         IF( ln_template ) THEN 
+
+            IF( ln_coordinates ) THEN
+               nbi_name = 'nbi'//cgrid(igrid)
+               nbj_name = 'nbj'//cgrid(igrid)
+            ELSE
+               nbi_name = 'nbidta'            
+               nbj_name = 'nbjdta'            
+            ENDIF
+
+            ! read in nbi, nbj values from input file
+            iostat = nf90_inq_varid( ncid_in, nbi_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_in, varid, nbi(1:nblen(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_inq_varid( ncid_in, nbj_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_in, varid, nbj(1:nblen(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+
+            ! read in nbi, nbj, nbr values from template file
+            iostat = nf90_inq_varid( ncid_template, nbi_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_template, varid, nbi_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_inq_varid( ncid_template, nbj_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_template, varid, nbj_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_get_var( ncid_template, nbrid_template(igrid), nbr_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+
+            nbr_min_template = MINVAL( nbr_template(1:nblen_template(igrid),1) )
+            nbr_max_template = MAXVAL( nbr_template(1:nblen_template(igrid),1) )
+            IF( nbr_min_template .ne. 1 ) THEN
+               WRITE(*,*) 'Something wrong with template file ',file_template
+               WRITE(*,*) 'MIN(nbr) /= 1'
+               STOP
+            ENDIF
+
+            IF( nbr_match .lt. 1 ) nbr_match = MIN(nbr_max, nbr_max_template)
+
+            ! initialise imap to the identity mapping
+            DO ib = 1, nblen(igrid)
+               imap(ib, igrid) = ib
+            ENDDO
+
+            ! allocate "extract" arrays
+            icount = 0
+            DO ib = 1, nblen_template(igrid)
+               IF( nbr_template(ib,1) .eq. 1 ) THEN
+                  icount = icount+1
+               ENDIF
+            ENDDO
+            ALLOCATE( nbi_extract(icount), nbj_extract(icount) )
+
+            DO ir = 1, nbr_match
+
+               ! extract values from template array for this ir value
+               icount = 0
+               DO ib = 1, nblen_template(igrid)
+                  IF( nbr_template(ib,1) .eq. ir ) THEN
+                     icount = icount+1
+                     nbi_extract(icount) = nbi_template(ib,1)               
+                     nbj_extract(icount) = nbj_template(ib,1)               
+                  ENDIF
+               ENDDO
+
+               ! work out the mapping for this ir value
+               icount = 1
+               DO ib = 1, nblen(igrid)
+                  IF( nbr(ib,1) .eq. ir ) THEN                  
+                     DO ib1 = 1, nblen(igrid)
+                        IF( nbi(ib1,1) .eq. nbi_extract(icount) .and. &
+                       &    nbj(ib1,1) .eq. nbj_extract(icount)       ) THEN
+                           imap(ib,igrid) = ib1
+                           icount = icount + 1
+                           EXIT
+                        ENDIF                        
+                     ENDDO ! ib1
+                  ENDIF           
+               ENDDO ! ib
+
+            ENDDO ! ir
+            
+            DEALLOCATE( nbi_extract, nbj_extract )
+
+         ELSE 
+
+            icount = 0
+            DO ir = nbr_min, nbr_max
+               DO ib = 1, nblen(igrid)
+                  IF( nbr(ib,1) .eq. ir ) THEN
+                     icount = icount + 1
+                     imap(icount,igrid) = ib
+                  ENDIF           
+               ENDDO
+            ENDDO
+
+         ENDIF
+     
+      ENDDO  ! jpbgrd
+
+!-----------------------------------------------------------------------------
+! 2. Open output file and copy dimensions and attributes across
+!----------------------------------------------------------------------------- 
+
+      iostat = nf90_inquire( ncid_in, ndims, nvars, natts )
+
+! 2.1 Create the output file  
+
+      WRITE(*,*) '>>> Initialising output file.'
+      iostat = nf90_create( TRIM(file_out), nf90_64bit_offset, ncid_out, chunksize=chunksize)
+
+! 2.2 Copy the dimensions into the output file.
+
+      iostat = nf90_inquire( ncid_in, unlimitedDimId = unlimitedDimId )
+      dimlen(:) = 1
+      DO idim = 1, ndims
+         iostat = nf90_inquire_dimension(ncid_in, idim, dimname, dimlen(idim))
+         IF (idim == unlimitedDimId) THEN
+            iostat = nf90_def_dim( ncid_out, dimname, nf90_unlimited, dimid)    
+            idim_time = idim
+         ELSE
+            iostat = nf90_def_dim( ncid_out, dimname, dimlen(idim), dimid)
+            IF( INDEX(dimname,'x') .gt. 0 ) THEN
+               idim_xb = idim
+            ELSE IF( INDEX(dimname,'y') .gt. 0 ) THEN
+               idim_yb = idim
+            ELSE IF( INDEX(dimname,'depth') .gt. 0 .or. INDEX(dimname,'z') .gt. 0 ) THEN
+               idim_depth = idim
+            ELSE
+               WRITE(*,*) 'ERROR: Unrecognised dimension : ',dimname
+               STOP
+            ENDIF            
+         ENDIF
+      END DO
+      
+
+! 2.2 Copy the global attributes into the output file.
+!     Also need to change the file_name attribute and the TimeStamp attribute.
+
+      DO attid = 1, natts
+         iostat = nf90_inq_attname( ncid_in, nf90_global, attid, attname )
+         WRITE(6,*)'>>> Copying attribute '//TRIM(attname)//' into destination file...'
+         iostat = nf90_copy_att( ncid_in, nf90_global, attname, ncid_out, nf90_global )  
+      END DO
+      iostat = nf90_put_att( ncid_out, nf90_global, "file_name", TRIM(file_out))
+      CALL DATE_AND_TIME ( date=date, time=time, zone=zone )
+      timestamp = date(7:8) // "/" // date(5:6) // "/" // date(1:4) // " " // &
+                  time(1:2) // ":" // time(3:4) // ":" // time(5:6) // " " // &
+                  zone  
+      iostat = nf90_put_att( ncid_out, nf90_global, "TimeStamp", timestamp)
+  
+! 2.3 Copy the variable definitions and attributes into the output file.
+
+      DO jv = 1, nvars
+         iostat = nf90_inquire_variable( ncid_in, jv, varname, xtype, ndims_var, dimids, natts )
+         iostat = nf90_def_var( ncid_out, varname, xtype, dimids(1:ndims_var), varid )
+            IF (natts > 0) THEN
+            DO attid = 1, natts
+               iostat = nf90_inq_attname(ncid_in, varid, attid, attname)
+               iostat = nf90_copy_att( ncid_in, varid, attname, ncid_out, varid )   
+            END DO
+         ENDIF
+      END DO
+ 
+! 2.4 End definitions in output file
+
+      iostat = nf90_enddef( ncid_out )    
+
+!-----------------------------------------------------------------------------
+! 3. Read in variables from input file, re-order and write to output file
+!----------------------------------------------------------------------------- 
+
+     IF( ln_coordinates ) THEN
+        ALLOCATE( varin_int(MAXVAL(nblen),1,1,1), varout_int(MAXVAL(nblen),1,1,1) )
+        ALLOCATE( varin_float(MAXVAL(nblen),1,1,1), varout_float(MAXVAL(nblen),1,1,1) )
+        ALLOCATE( varin_dble(MAXVAL(nblen),1,1,1), varout_dble(MAXVAL(nblen),1,1,1) )
+     ELSE
+        SELECT CASE( ndims ) 
+           CASE( 2 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),1,1) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),1,1) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+           CASE ( 3 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+           CASE ( 4 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+           CASE DEFAULT
+              WRITE(*,*) 'ERROR : Can only cope with 2, 3 or 4 dimensions in the boundary data files.'
+              WRITE(*,*) '        This file appears to have ',ndims,' dimensions.'
+              STOP
+        END SELECT
+     ENDIF
+
+     DO jv = 1, nvars
+       iostat = nf90_inquire_variable( ncid_in, jv, varname, xtype, ndims_var, dimids )
+       DO idim = 1, ndims_var
+          lenvar(idim) = dimlen(dimids(idim))
+       ENDDO
+
+       IF( ndims_var .eq. 1 ) THEN
+          WRITE(*,*) '>>> Copying coordinate variable ',TRIM(varname)
+       ELSE
+          WRITE(*,*) '>>> Reordering variable ',TRIM(varname)
+       ENDIF
+       ! Error check here
+
+       IF( ln_coordinates ) THEN
+          strlen = len_trim(varname)
+          end_letter = varname(strlen:strlen)
+          jgrid = -1
+          DO igrid = 1,4
+             IF( end_letter .eq. cgrid(igrid) ) jgrid = igrid
+          END DO
+          IF( jgrid .lt. 0 ) THEN
+             WRITE(*,*) 'ERROR : Could not identify grid for variable ',TRIM(varname)
+             WRITE(*,*) ' varname : ',TRIM(varname),'!'
+             WRITE(*,*) ' strlen : ',strlen
+             WRITE(*,*) ' end_letter : ',end_letter
+             WRITE(*,*) ' cgrid(1) : ',cgrid(1)
+             WRITE(*,*) ' cgrid(2) : ',cgrid(2)
+             WRITE(*,*) ' cgrid(3) : ',cgrid(3)
+             WRITE(*,*) ' cgrid(4) : ',cgrid(4)
+             STOP
+          ENDIF
+       ELSE
+          jgrid=1
+       ENDIF
+           
+       SELECT CASE(xtype)
+
+          CASE( NF90_INT ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D integer.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D integer.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_int(ib,1,1,1) = varin_int(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D integer.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_int(ib,1,1,itime) = varin_int(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D integer.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_int(ib,1,idepth,itime) = varin_int(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+          CASE( NF90_FLOAT ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D float.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D float.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_float(ib,1,1,1) = varin_float(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D float.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_float(ib,1,1,itime) = varin_float(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D float.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_float(ib,1,idepth,itime) = varin_float(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+          CASE( NF90_DOUBLE ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D double.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D double.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_dble(ib,1,1,1) = varin_dble(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D double.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_dble(ib,1,1,itime) = varin_dble(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D double.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_dble(ib,1,idepth,itime) = varin_dble(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+             CASE DEFAULT
+                WRITE(*,*) 'ERROR : Unrecognised data type.'           
+                STOP
+
+       END SELECT
+
+       END DO ! jv
+
+!-----------------------------------------------------------------------------
+! 4. Close input and output files
+!----------------------------------------------------------------------------- 
+
+      iostat = nf90_close( ncid_out )
+      iostat = nf90_close( ncid_in )
+
+
+END PROGRAM bdy_reorder
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 8732)
@@ -0,0 +1,77 @@
+#!/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 of key when compiling a configuration.
+# The list of 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_rep"
+#
+#
+# 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 [ "$(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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 8732)
@@ -0,0 +1,211 @@
+#!/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 CPPFILE COMPILER
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+cpeval () 
+{
+    cat > $2 << EOF
+
+#==========================================================
+#    Automatically generated by Fcheck_archfile.sh from
+#    $1
+#==========================================================
+
+EOF
+    while read line  
+    do  
+	eval "echo \"$line\" >> $2"
+    done < $1
+}
+# cleaning related to the old version
+rm -f $( find ${COMPIL_DIR} -type l -name $1 -print )
+#
+if [ ${#3} -eq 0 ]; then # arch not specified
+    if [ ! -f ${COMPIL_DIR}/arch.history ]; then
+	echo "Warning !!!"
+	echo "NO compiler chosen"
+	echo "Try makenemo -h for help"
+	echo "EXITING..."
+	exit 1 
+    else # use the arch file defined in arch.history
+	myarch=$( cat ${COMPIL_DIR}/arch.history )	
+	if [ ! -f $myarch ]; then
+	    echo "Warning !!!"
+	    echo "previously used arch file no more found:"
+	    echo $myarch
+	    echo "EXITING..."
+	    exit 1 
+	else
+	    if [ -f ${COMPIL_DIR}/$1 ]; then
+		if [ "$2" != "nocpp" ] 
+		then
+		    # has the cpp keys file been changed since we copied the arch file in ${COMPIL_DIR}?
+		    mycpp=$( ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" )
+		    if [ "$mycpp" != "$( cat ${COMPIL_DIR}/cpp.history )" ]; then
+			echo $mycpp > ${COMPIL_DIR}/cpp.history
+			cpeval ${myarch} ${COMPIL_DIR}/$1
+		    fi
+		    # has the cpp keys file been updated since we copied the arch file in ${COMPIL_DIR}?
+		    mycpp=$( find -L ${COMPIL_DIR} -cnewer ${COMPIL_DIR}/$1 -name $2 -print )
+		    [ ${#mycpp} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1
+		fi
+		# has myarch file been updated since we copied it in ${COMPIL_DIR}?
+		myarchdir=$( dirname ${myarch} )
+		myarchname=$( basename ${myarch} )
+		myarch=$( find -L $myarchdir -cnewer ${COMPIL_DIR}/$1 -name $myarchname -print )
+		[ ${#myarch} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1
+	    else
+		cpeval ${myarch} ${COMPIL_DIR}/$1
+	    fi
+	fi
+    fi
+else 
+    nb=$( find ${MAIN_DIR}/ARCH -name arch-${3}.fcm -print | wc -l )
+    if [ $nb -eq 0 ]; then # no arch file found
+	echo "Warning !!!"
+	echo "Compiler not existing"
+	echo "Try makenemo -h for help"
+	echo "EXITING..."
+	exit 1       
+    fi
+    if [ $nb -gt 1 ]; then # more than 1 arch file found
+	echo "Warning !!!"
+	echo "more than 1 arch file for the same compiler have been found"
+	find ${MAIN_DIR}/ARCH -name arch-${3}.fcm -print
+	echo "keep only 1"
+	echo "EXITING..."
+	exit 1       
+    fi
+    myarch=$( find ${MAIN_DIR}/ARCH -name arch-${3}.fcm -print )
+    # we were already using this arch file ?
+    if [ "$myarch" == "$( cat ${COMPIL_DIR}/arch.history )" ]; then 
+	if [ -f ${COMPIL_DIR}/$1 ]; then
+	    if [ "$2" != "nocpp" ] 
+	    then
+		# has the cpp keys file been changed since we copied the arch file in ${COMPIL_DIR}?
+		mycpp=$( ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" )
+		if [ "$mycpp" != "$( cat ${COMPIL_DIR}/cpp.history )" ]; then
+		    echo $mycpp > ${COMPIL_DIR}/cpp.history
+		    cpeval ${myarch} ${COMPIL_DIR}/$1
+		fi
+		# has the cpp keys file been updated since we copied the arch file in ${COMPIL_DIR}?
+		mycpp=$( find -L ${COMPIL_DIR} -cnewer ${COMPIL_DIR}/$1 -name $2 -print )
+		[ ${#mycpp} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1
+	    fi
+	    # has myarch file been updated since we copied it in ${COMPIL_DIR}?
+	    myarch=$( find -L ${MAIN_DIR}/ARCH -cnewer ${COMPIL_DIR}/$1 -name arch-${3}.fcm -print )
+	    [ ${#myarch} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1
+	else
+	    cpeval ${myarch} ${COMPIL_DIR}/$1
+	fi
+    else
+	if [ "$2" != "nocpp" ] 
+	then
+	    ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" > ${COMPIL_DIR}/cpp.history
+	fi
+	echo ${myarch} > ${COMPIL_DIR}/arch.history
+	cpeval ${myarch} ${COMPIL_DIR}/$1
+    fi
+fi
+
+#- do we need xios library?
+#- 2 cases: 
+#- in CONFIG directory looking for key_iomput
+if [ "$1" == "arch_nemo.fcm" ]
+then
+    if [ "$2" != "nocpp" ] 
+    then
+        use_iom=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_iomput )
+    else
+        use_iom=0
+    fi
+    have_lxios=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-lxios" )
+    if [[ ( $use_iom -eq 0 ) && ( $have_lxios -ge 1 ) ]]
+    then 
+        sed -e "s/-lxios//g" ${COMPIL_DIR}/$1 > ${COMPIL_DIR}/tmp$$
+        mv -f ${COMPIL_DIR}/tmp$$ ${COMPIL_DIR}/$1
+    fi
+#- in TOOLS directory looking for USE xios
+else
+    use_iom=$( egrep --exclude-dir=.svn -r USE ${NEW_CONF}/src/* | grep -c xios )
+    have_lxios=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-lxios" )
+    if [[ ( $use_iom -eq 0 ) || ( $have_lxios != 1 ) ]]
+    then 
+        sed -e "s/-lxios//g" ${COMPIL_DIR}/$1 > ${COMPIL_DIR}/tmp$$
+        mv -f ${COMPIL_DIR}/tmp$$ ${COMPIL_DIR}/$1
+    fi
+fi
+
+#- do we need oasis libraries?
+if [ "$2" != "nocpp" ] 
+then
+    use_oasis=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_oasis3 )
+else
+    use_oasis=0
+fi
+for liboa in psmile.MPI1 mct mpeu scrip mpp_io
+do
+    have_liboa=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-l${liboa}" )
+    if [[ ( $use_oasis -eq 0 ) && ( $have_liboa -ge 1 ) ]]
+    then 
+	sed -e "s/-l${liboa}//g" ${COMPIL_DIR}/$1 > ${COMPIL_DIR}/tmp$$
+	mv -f ${COMPIL_DIR}/tmp$$ ${COMPIL_DIR}/$1
+    fi
+done
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 8732)
@@ -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/CONFIG_DIR/cfg.txt to check if the configuration exists.
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcheck_config.sh
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+declare -a ZTAB
+if [ ${#2} -eq 0 ]; then
+   tail -1  ${CONFIG_DIR}/$1	> ${CONFIG_DIR}/cfg.tmp
+   read -a ZTAB < ${CONFIG_DIR}/cfg.tmp
+   NEW_CONF=${ZTAB[0]} ; TAB=( ${ZTAB[@]:1} )
+   \rm ${CONFIG_DIR}/cfg.tmp
+   echo "Warning !!!"
+   echo "No configuration specified"
+   echo "Use makenemo -n MYCONFIG"
+   echo "or  makenemo -h for help"
+   echo "Using default configuration : ${NEW_CONF}"
+fi
+if [ "$1" == cfg.txt ]; then
+   cat ${CONFIG_DIR}/$1 | grep "${NEW_CONF} " > ${CONFIG_DIR}/cfg.tmp
+   read -a ZTAB < ${CONFIG_DIR}/cfg.tmp
+   NEW_CONF=${ZTAB[0]} ; TAB=( ${ZTAB[@]:1} )
+   \rm ${CONFIG_DIR}/cfg.tmp
+fi
+
+unset -v ZTAB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 8732)
@@ -0,0 +1,90 @@
+#!/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}
+ if [ ${#NEW_CONF} -eq 0 ] ; then
+ 	   echo " "
+	   echo "No configuration specified, please use makenemo -n CONFIG clean_config "
+ else
+    echo "Are you sure that you want to remove this directory $NEW_CONF? [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 ${CONFIG_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"  ${CONFIG_DIR}/cfg.txt >  ${CONFIG_DIR}/cfg.tmp
+		  mv  ${CONFIG_DIR}/cfg.tmp  ${CONFIG_DIR}/cfg.txt
+		  echo "${NEW_CONF} configuration REMOVED" 
+        fi
+    else
+	   echo " "
+	   echo "nothing to remove"
+    fi
+ fi 
+ unset -v answer
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh	(revision 8732)
@@ -0,0 +1,68 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# =============
+# Fclean_var.sh
+# =============
+#
+# ----------------------------
+# Clean environment variables
+# ----------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fclean_var.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Clean environment 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 8732)
@@ -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 reference 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 " ${CONFIG_DIR}/cfg.txt > ${CONFIG_DIR}/cfg.tmp
+read -a ZTAB < ${CONFIG_DIR}/cfg.tmp
+TAB=( ${ZTAB[@]:1} )
+\rm ${CONFIG_DIR}/cfg.tmp
+
+unset -v ZTAB
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcopy_extdir.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcopy_extdir.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fcopy_extdir.sh	(revision 8732)
@@ -0,0 +1,39 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+# ============
+# Fcopy_extdir.sh
+# ============
+# --------------------------
+# Copy a reference directory
+# --------------------------
+# SYNOPSIS
+# ========
+# ::
+#  $ Fcopy_extdir.sh
+# DESCRIPTION
+# ===========
+# When an unsupported configuration is requested, 
+# Prepare sources for the NEMO sub-directories needed (OPA_SRC, TOP_SRC ...)
+# EXAMPLES
+# ========
+# ::
+#  $ ./Fcopy_extdir.sh ORCA2_LIM
+# TODO
+# ====
+# option debug
+# EVOLUTIONS
+# ==========
+# $Id: Fcopy_extdir.sh 3294 2012-01-28 16:44:18Z rblod $
+#   * creation
+#-
+grep "$1 " ${CONFIG_DIR}/uspcfg.txt > ${CONFIG_DIR}/cfg.tmp
+#
+LOCAL_REF=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $2}')
+TAB=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $3}')
+REMOTE_CTL=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $4}')
+#
+\rm ${CONFIG_DIR}/cfg.tmp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh	(revision 8732)
@@ -0,0 +1,75 @@
+#!/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, containing 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}"
+ for i in ${list_del_key} ; do
+        if [ "$(echo ${i} | grep -c key_nproc )" -ne 0 ] ; then
+	        sed -e "s/key_nproc[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 " "
+        elif [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then
+        	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 "deleted key $i in ${NEW_CONF}"
+        fi
+ done
+
+ unset -v list_del_key
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Ffetch_extdir.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Ffetch_extdir.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Ffetch_extdir.sh	(revision 8732)
@@ -0,0 +1,53 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+# ===============
+# Ffetch_extdir.sh
+# ===============
+# ---------------
+# Make the config 
+# ---------------
+# SYNOPSIS
+# ========
+# ::
+#  $ Ffetch_extdir.sh
+# DESCRIPTION
+# ===========
+# - Make the config directory 
+# - Create repositories needed :
+#  
+#  - EXP00 for namelist
+#  - MY_SRC for user sources
+#  - BLD for compilation 
+# EXAMPLES
+# ========
+# ::
+#  $ ./Ffetch_extdir.sh CONFIG_NAME REMOTE_CTL 
+# TODO
+# ====
+# option debug
+# EVOLUTIONS
+# ==========
+# $Id: Ffetch_extdir.sh 3715 2012-11-28 16:06:02Z acc $
+#   * creation
+#-
+basedir=$(pwd)
+cd ${1}
+wget ${2} -O remote_file.list
+#
+if [ -f remote_file.list ] ; then
+ cat remote_file.list | grep -v '^#' |
+  while
+   read remfile locfile
+   do
+    if [ $remfile == 'create_directory' ] ;then
+      mkdir $locfile
+    else
+      wget $remfile -O $locfile
+    fi
+   done
+fi
+cd $basedir
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 8732)
@@ -0,0 +1,100 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==================
+# Flist_archfile.sh
+# ==================
+#
+# --------------------------
+# Check the compilation file
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Flist_archfile.sh Institute
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# List arch file available.
+# The first line of each file in NEMO/ARCH directory is echoed.  
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Flist_archfile.sh 
+#
+#  $ ./Flist_archfile.sh CNRS
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+if [ -n "$2" ]; then
+shift
+fi
+
+echo "Available compilers for -m option :"
+for file in  $(ls ${MAIN_DIR}/ARCH | grep "fcm$" )
+do
+zvar1=${file#arch-}
+zvar2=$(head -1 ${MAIN_DIR}/ARCH/$file)
+#echo "${zvar1%.fcm} : ${zvar2#\#}"
+printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
+done
+
+
+if [ "$1" == "all" ]; then
+   for dir  in  $(ls ${MAIN_DIR}/ARCH | grep -v "fcm$" )
+   do 
+      echo "Available compilers at ${dir} :"
+      for file in  $(ls ${MAIN_DIR}/ARCH/${dir} | grep "fcm$" )
+      do
+      zvar1=${file#arch-}
+      zvar2=$(head -1 ${MAIN_DIR}/ARCH/${dir}/$file)
+      #echo "${zvar1%.fcm} : ${zvar2#\#}"
+      printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
+      done
+   done
+elif [ -d ${MAIN_DIR}/ARCH/${1} ]; then
+      echo "Available compilers at $1 :"
+      for file in  $(ls ${MAIN_DIR}/ARCH/$1 | grep "fcm$" )
+      do
+      zvar1=${file#arch-}
+      zvar2=$(head -1 ${MAIN_DIR}/ARCH/${1}/$file)
+      #echo "${zvar1%.fcm} : ${zvar2#\#}"
+      printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
+      done
+else
+      echo "Available consortium member sub-directories :"
+      for dir  in  $(ls ${MAIN_DIR}/ARCH | grep -v "fcm$" )
+      do
+         echo ${dir}
+      done
+      echo "use \"makenemo -h all\" or \"makenemo -m help\" to see compilers available in member's sub-directories"
+fi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 8732)
@@ -0,0 +1,116 @@
+#!/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 line 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 ZSRC=$1 ; shift 
+declare ZCONF=$1 ; shift
+ZTAB=( $@ )
+declare i=0 ; declare NDIR=${#ZTAB[@]}
+
+echo "Creating ${ZCONF}/WORK = ${ZTAB[*]} for ${ZCONF}"
+
+[ ! -d ${ZCONF}/MY_SRC ] && \mkdir ${ZCONF}/MY_SRC
+[   -d ${ZCONF}/WORK   ] || \mkdir ${ZCONF}/WORK
+
+if [ "${ZSRC}" != "none" ] ; then 
+  if [ -d ${ZSRC} ] ; then 
+     ln -sf ${ZSRC}/*.[Ffh]90 ${ZCONF}/MY_SRC/. 
+     echo "MY_SRC content is linked to ${ZSRC}" 
+  else
+     echo "External directory for MY_SRC does not exist. Using default."
+  fi
+else 
+echo "MY_SRC directory is : ${ZCONF}/MY_SRC"
+fi
+
+\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 
+      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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 8732)
@@ -0,0 +1,66 @@
+#!/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/.
+\cp -R  ${2}/EXP00/*.xml ${1}/EXP00/.
+[ -f ${2}/EXP00/AGRIF_FixedGrids.in ] &&  \cp -R  ${2}/EXP00/AGRIF_FixedGrids.in ${1}/EXP00/.
+[ -d    ${2}/MY_SRC ] && \cp  ${2}/MY_SRC/* ${1}/MY_SRC/. 2> /dev/null
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_extconfig.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_extconfig.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fmake_extconfig.sh	(revision 8732)
@@ -0,0 +1,45 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+# ===============
+# Fmake_extconfig.sh
+# ===============
+# ---------------
+# Make the directories for an externally supported configuration
+# and base the initial versions on the nearest equivalent from the
+# reference set (as named in uspcfg.txt)
+# ---------------
+# SYNOPSIS
+# ========
+# ::
+#  $ Fmake_extconfig.sh
+# DESCRIPTION
+# ===========
+# - Make the config directory 
+# - Create repositories needed :
+#  - EXP00 for namelist
+#  - MY_SRC for user sources
+#  - BLD for compilation 
+# EXAMPLES
+# ========
+# ::
+#  $ ./Fmake_extconfig.sh CONFIG_NAME REF_CONFIG_NAME 
+# TODO
+# ====
+# option debug
+# EVOLUTIONS
+# ==========
+# $Id: Fmake_extconfig.sh 3715 2012-11-28 16:06:02Z acc $
+#   * 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/.
+\cp -R  ${2}/EXP00/*.xml ${1}/EXP00/.
+[ -f ${2}/EXP00/AGRIF_FixedGrids.in ] &&  \cp -R  ${2}/EXP00/AGRIF_FixedGrids.in ${1}/EXP00/.
+[ -d    ${2}/MY_SRC ]                 &&  \cp  ${2}/MY_SRC/* ${1}/MY_SRC/. 2> /dev/null
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 8732)
@@ -0,0 +1,79 @@
+#!/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
+#-MPI for AGRIF
+if [ ! -f ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h ];then
+   echo '#if defined key_mpp_mpi' > ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+   echo '#define AGRIF_MPI'      >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+   echo '#endif'                 >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+fi
+
+ #- CONV
+fcm build ${COMPIL_DIR}/conv.cfg || exit 1
+#C_COMPILER=${CC-cc}
+#gmake CC=${C_COMPILER} -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/
+cp -f -r $2/$1/AGRIFLIB/bin/conv  $2/$1/OPAFILES/
+
+fi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/README	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/agrifpp.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 8732)
@@ -0,0 +1,62 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==========
+# agrifpp.sh
+# ==========
+#
+# ----------------------------
+# Preform AGrif pre-processing
+# ----------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ agrifpp.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Preprocess file using the conv in OPAFILES directory
+# Standard preprocessed files are stored in OPAFILES/ppsrc/nemo
+# Source files are stored under OPAFILES/obj
+# Include filess  in OPAFILES/inc
+# Note that agrif2model.F90 should not be preprocess (standard one) 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./agrifpp.sh FILE_TO_PROCESS
+# 
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: agrifpp.sh 2143 2010-10-04 12:49:55Z rblod $
+#
+#
+#
+#   * creation
+#
+#-
+MYFILE=$(basename "$1")
+if [ "$MYFILE" == "agrif2model.f90" ];then
+   \cp ${NEMO_TDIR}/${NEW_CONF}/WORK/${MYFILE/.f90/.F90} ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/obj/$MYFILE
+else
+cd ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/ppsrc/nemo ; ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/conv ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/agrif_opa.in -rm -incdir ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/inc -comdirout ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/obj -convfile ${MYFILE} > /dev/null 
+fi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el	(revision 8732)
@@ -0,0 +1,81 @@
+; Bash syntax highlighting
+
+(defvar bash-builtins  ;; Unrecognized UNIX commands
+  '("awk" "basename" "cat" "cp" "cut" "date" "diff" "dirname" "env" "find"
+    "grep" "head" "ls" "make" "mkdir" "mv" "rm" "sed" "sort" "svn" "tail" "tee"
+    "touch" "uniq" "xargs"                                                     ))
+
+(defvar bash-keywords  ;; Bash keywords (consistency with 'return' command fontification)
+  '("declare" "let" "local" "readonly" "typeset" "set" "unset"                 ))
+
+(defvar bash-functions ;; Sourced or declared fonctions
+  '("fake_func"                                                                   ;; 
+    "em" "ev" "ge" "heil" "mkcd" "ok"                                             ;; Common
+    "nemch" "nemde" "nemid" "nemtr" "nemst"                                       ;; NEMO branchs
+    "cmpcf" "if90" "gf90"                                                         ;; NEMO cmp
+    "nemo_help" "nemo_cfg"                                                        ;; NEMO cfg
+    "append_output_file" "appech_output_file" "super_grep" "check_args_count"     ;; NEMO SETTE
+    "set_namelist" "set_xio" "post_test_tidyup"                                )) ;; Id
+
+(defvar bash-font-lock ;; Be careful with order
+  '(;; Variables
+    ;;; GLOBALS variables|arrays
+    ("\\(?:export +\\)?\\$?{?\\(#?[A-Z][A-Z_0-9]+\\)\\(?:\\[\\(?2:[@*]\\)\\]\\)?"
+     (1 font-lock-constant-face     ) (2 font-lock-constant-face      nil t))
+    ;;; Locals arrays
+    ("\\(?1:#?[a-z][a-z_0-9]+\\)\\[\\([@*]\\)?"
+     (1 font-lock-variable-name-face) (2 font-lock-variable-name-face nil t))
+    ;;; Shell specials variables
+    ("\\${?\\([#@?!_-]?[a-z]?[a-z_0-9]*\\)}?" 1 font-lock-variable-name-face)
+
+    ;; Tests  '[ ... ]' '[[ ... ]]' '(( ... ))'
+    ("\\((\\{2\\}\\) \\(?:.*\\) \\()\\{2\\}\\)"            
+     (1 font-lock-builtin-face) (2 font-lock-builtin-face))
+    ("\\(\\[\\{1,2\\}\\) \\(?:[^]]+\\) \\(\\]\\{1,2\\}\\)"
+     (1 font-lock-builtin-face) (2 font-lock-builtin-face))
+
+    ;; Operators  ' ! ' ' != ' ' ~= '  ' && ' ' || '
+    (" \\!=? \\| ~= " 0 font-lock-negation-char-face)
+    (" && \\| || "    0 font-lock-keyword-face      )
+
+    ;; Compound commands
+    ("\\\\$"                0 font-lock-warning-face) ; '\'
+    ("\\(?:[^;]\\)\\(;\\) " 1 font-lock-keyword-face) ; '; '
+     ;;; Function
+    ("^\\(?:function +\\)?\\(\\sw+\\)(?)? +\\({\\)"
+     (1 font-lock-function-name-face) (2 font-lock-warning-face      ))
+    ("^}$"                             0 font-lock-warning-face       )
+     ;;; Commands block ' { ...; }'
+    ("\\({\\) \\(?:[^}]*\\); +\\(}\\)?" (1 font-lock-warning-face) (2 font-lock-warning-face nil t))
+    ("\\(?:.*\\); +\\(}\\)$"          1 font-lock-warning-face                                  )
+     ;;; Sub-shell      '( ...  )'
+    ("\\((\\) \\(?:[^)]*\\) \\()\\)" (1 font-lock-warning-face) (2 font-lock-warning-face))
+
+    ;; 'case ... in ...) ...;; esac'
+    ("\\()\\)\\(?:[^)]*\\)\\(;;\\)" (1 font-lock-keyword-face) (2 font-lock-keyword-face))
+    ("^[^(]*\\()\\)$"                1 font-lock-keyword-face) ; Regular syntax
+    ("^\\s-+;;$"                     0 font-lock-keyword-face) ;    "      ""
+    )
+  )
+
+; Configuration loading
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-builtins  'words) 0 font-lock-builtin-face      )))
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-keywords  'words) 0 font-lock-keyword-face      )))
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-functions 'words) 0 font-lock-function-name-face)))
+(font-lock-add-keywords 'sh-mode bash-font-lock                                                         )
+
+; Highlighting example for font lock faces
+(font-lock-add-keywords 'sh-mode '(
+  ("font-lock-warning-face"           . font-lock-warning-face          )
+  ("font-lock-function-name-face"     . font-lock-function-name-face    )
+  ("font-lock-variable-name-face"     . font-lock-variable-name-face    )
+  ("font-lock-keyword-face"           . font-lock-keyword-face          )
+  ("font-lock-comment-face"           . font-lock-comment-face          )
+  ("font-lock-comment-delimiter-face" . font-lock-comment-delimiter-face)
+  ("font-lock-type-face"              . font-lock-type-face             )
+  ("font-lock-constant-face"          . font-lock-constant-face         )
+  ("font-lock-builtin-face"           . font-lock-builtin-face          )
+  ("font-lock-preprocessor-face"      . font-lock-preprocessor-face     )
+  ("font-lock-string-face"            . font-lock-string-face           )
+  ("font-lock-doc-face"               . font-lock-doc-face              )
+  ("font-lock-negation-char-face"     . font-lock-negation-char-face    )))
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 8732)
@@ -0,0 +1,68 @@
+# ----------------------- 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/OPAFILES/obj
+
+bld::target  nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::cpp       %CPP
+bld::tool::fpp       %CPP
+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::fppflags::nemo      %FPPFLAGS -I$CONFIG_DIR/$NEW_CONF/OPAFILES/inc
+bld::tool::fppflags::ioipsl    %FPPFLAGS
+bld::tool::fppflags::agrif     %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        use::xios
+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_oasis
+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
+bld::infile_ext::f90  FPP::FPP9X::SOURCE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg	(revision 8732)
@@ -0,0 +1,82 @@
+# ----------------------- 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::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+bld::target  lib_cray.f90 nemo.f90 agrif_user.f90 agrif2model.f90 
+
+dir::root            $NEMO_TDIR/$NEW_CONF/OPAFILES
+
+bld::tool::fc_output
+bld::tool::fc_compile
+bld::tool::fc_include
+bld::tool::fc        $COMPIL_DIR/agrifpp.sh 
+bld::tool::fflags    
+bld::tool::ld       
+bld::tool::ldflags   
+bld::tool::ar        
+bld::tool::arflags   
+bld::tool::make      %MK
+
+OUTFILE_EXT::obj   .f90
+
+# Pre-process code before analysing dependencies
+bld::pp::nemo     1
+bld::pp::nemo/agrif2model     0
+bld::tool::cpp       %CPP
+bld::tool::fpp       %CPP
+bld::tool::fppflags::nemo  %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_oasis
+bld::excl_dep        use::mkl_dfti
+bld::excl_dep	     use::nc4interface
+bld::excl_dep	     use::ioipsl
+bld::excl_dep	     use::xios
+bld::excl_dep        use::agrif_grids
+bld::excl_dep	     use::agrif_types
+bld::excl_dep	     use::agrif_util
+bld::excl_dep        inc::SetNumberofcells.h
+bld::excl_dep        inc::GetNumberofcells.h
+bld::excl_dep        inc::include_use_Alloc_agrif.h
+bld::excl_dep        inc::allocations_calls_agrif.h
+bld::excl_dep        inc::modtype_agrif.h
+bld::excl_dep        inc::probdim_agrif.h
+bld::excl_dep        inc::keys_agrif.h
+bld::excl_dep        h::SetNumberofcells.h
+bld::excl_dep        h::GetNumberofcells.h
+bld::excl_dep        h::include_use_Alloc_agrif.h
+bld::excl_dep        h::allocations_calls_agrif.h
+bld::excl_dep        h::modtype_agrif.h
+bld::excl_dep        h::probdim_agrif.h
+bld::excl_dep        h::keys_agrif.h
+bld::excl_dep        use::mod_attribut
+bld::excl_dep        use::mod_event_client
+bld::excl_dep        use::mod_ioclient
+#bld::excl_dep        OBJ
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" and ".f90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+bld::infile_ext::f90  FPP::FPP9X::SOURCE
+bld::src_type::nemo/agrif2model.F90 FORTRAN::FORTRAN9X::SOURCE
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg	(revision 8732)
@@ -0,0 +1,47 @@
+# ----------------------- 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::cpp       %CPP
+bld::tool::fpp       %CPP
+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        use::xios
+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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bldxag.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bldxag.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/bldxag.cfg	(revision 8732)
@@ -0,0 +1,64 @@
+# ----------------------- 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::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+bld::target nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::cpp       %CPP
+bld::tool::fpp       %CPP
+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
+
+# Pre-process code before analysing dependencies
+bld::pp::ioipsl   1
+bld::pp::nemo     1
+bld::tool::fppflags::nemo     %FPPFLAGS
+bld::tool::fppflags::ioipsl   %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        use::xios
+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_oasis
+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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 8732)
@@ -0,0 +1,35 @@
+# ----------------------- 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_nemo.fcm
+
+bld::tool::cc        %CC
+bld::tool::cflags    %CFLAGS
+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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/template.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/template.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/template.sh	(revision 8732)
@@ -0,0 +1,186 @@
+#!/bin/bash
+
+
+#§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+#
+# This template for Bash coding pair with Emacs Lisp package 'bash-font-lock.el'
+# to enhance default shell syntax fontification. This package is based on regexs
+# to match examples of concsyntax showed below.
+# All this is not mandatory and probably not optimized with other correct rules
+# Feel free to add your tips, modify it at your convenience or give your feedback
+# to improve it.
+#
+#§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+
+
+# To automatically use it with a bash script, copy it to your ~/.emacs.d and 
+# add '(load "~/.emacs.d/bash-font-lock.el")' in your .emacs configuration file
+#--------------------------------------------------------------------------------
+ # If a command  is not highlighted, add its name to 'bash-builtins'  list
+ # "  " function ""  "       "     ,  "   "   ""  "" 'bash-functions'  "" 
+
+# UNIX built-in commands sample
+#-------------------------------
+.; alias; bg; bind; builtin; caller; compgen; complete; declare; dirs; disown
+enable; fc; fg; help; history; jobs; kill; let; local; popd; printf; pushd
+shopt; source; suspend; typeset; unalias; eval; export; getopts; newgrp; pwd
+read; readonly; times; ulimit; command; hash; test; type; cd; echo; eval; set
+shift; umask; unset; wait
+
+# Common bash built-in commands already added to 'bash-builtins' list
+#---------------------------------------------------------------------
+awk basename cat cp cut date diff dirname env find grep head ls make mkdir mv rm
+sed sort svn tail tee touch uniq xargs
+
+# Variables
+#-----------
+ # Specials    parameters (see Bash manual for details, `man bash`)
+$0 $# $* $@ $? $! $_ $$ $-
+ # Positionnal parameters (ordered arguments given to run script "$0")
+$1 $2 $3 ...                
+$* ==  "$1${IFS}$2${IFS}$3..." #   Single word , recommended use for string
+$@ ==  "$1"    "$2"    "$3"...  # Separate words, recommended use for array
+ # Identify locals against GLOBALS or ENVIRONMENT variables with case sensitive
+TEMP=${temp_0123}; temp=${TEMP_0123}; export TEMP=${TEMP_0123}
+ # Possibles variable assignation syntax
+temp='temp'; temp=$1 # Simple
+length_temp=${#temp} # Length of string
+temp=$(( 1 + 1 ))    # Integer arithmetic evaluation
+temp=${........}     # String operations
+temp=$(test ....)    # Regular syntax
+temp=$( test ... )   # Highlight sub-shell '( ... )' & command or function call
+temp=`test .....`    # Backquotes not recommended to avoid complete highlighting
+
+# Arrays
+#--------
+ # Initialisation
+declare -a array                 # Explicit
+array=([0]='zero' [1]='one' ...) # Implicit with index assignement
+array[0]='zero'; array[9]='ten'  # Implicit or add element to array at an index
+ # Curly brackets are essential to work with arrays
+ # Last index of an array
+IDX=${#temp_0123[@]}; idx=${#TEMP_0123[@]}
+ # Get last element of an array (${#array[@]})
+LAST_ELMNT=array[${#array[@]}]; last_elmnt=ARRAY[${#ARRAY[@]}]
+ # Remove an element or entire array
+unset array[9]; unset array[@]
+
+# Strings
+#---------
+ # Single quotes are recommended to identified entire characters string instead
+ # of doubles quotes or initialize variable
+echo 'The name of the script is '$0' with following arguments '$*
+ # Doubles quotes should only be used when it's necessary to interpret escaping
+ # character or to perform parameter substitution
+printf "The value of PI is %8.6f.\n" $PI; sed "s/3.1415/$PI/" temp.txt
+
+# Function
+#----------
+ # 'function' word is not not mandatory at declaration if you have double
+ # brackets '()' right after name. A function has to be declared before its call
+ # so should be placed at the beginning of the main script. A clever solution is
+ # to gather similar functions in kind of a 'module' file which will be sourced
+ # from main script.
+ # 2 possibles syntax:
+function fake_func { local temp=''; ...; return ...; }
+fake_func() {
+    local temp='' # Declare variable as local, if not his attribute is global
+    ...
+    return ...   # Function can only return an integer (stderr by default)
+                  # export result by a global variable to bypass it 
+}
+ # Function call (with or without argument)
+temp=$( fake_func $1 $2 ); fake_func $1 $2; fake_func
+
+# Tests operators differs with type of test (arithmetic or string comparison
+# for number/characters, file attributs), see manual for test with `man test`
+#----------------------------------------------------------------------------
+ # Possible syntax : literal 'test' or compact syntax with brackets/parenthesis
+ # at the ends
+ # '[ ... ]' & '[[ ... ]]' are almost identical (simple and extended test)
+ # With ' != ' & ' == ' operators, right string is considered as          regex
+ #  ""             '~='     "    ,   "     ""   "      ""     "  extended   "
+[ $temp ~= "..." ] && [[ ! -e temp.txt ]] || (( $temp >= 0 ))
+
+# For compound commands, prefer the use of command block '{ ...; }' instead of
+# a sub-shell '( ... )', keep in mind that despite sub-shell inherit from its
+# run script all variables declared as locals are lost at the end of execution
+
+# To cut a long sequence, put the escape character '\' at the end of line and
+# continue on next line (possible on several lines)
+printf "This is a very very very long sentence that I have to cut in order to  \
+        be less than 80 characters for a line of code but I don't have to call \
+        the same command several times.\n                                       "
+# A pipe ' | ' cannot be put at the end of a line, even if you have a '\'
+cat temp.txt | cut -d' ' -f-5 | sort -kr3n | uniq -c | sort | head -n25 \
+| awk '$3 >= 1024 {print $4}'                                           \
+| xargs -t -i() mv () $HOST@$HOSTNAME:${REP_STORAGE}
+
+# 'if ...; then ...; fi'
+#------------------------
+ # Very short syntax with commands block '{ ...; }'
+[ ... ] && { ...; ...; }
+ #      Short syntax with commands block '{ ...; }'
+[ ... ] && { ...; \
+             ...;  }
+ #    Regular syntax
+if [ ... ]; then
+    ...  
+fi
+
+# 'if ...; then ...;  else ...; fi'
+#----------------------------------
+ #   Short syntax with commands block '{ ... }'
+{ [ ... ] && ...; } || { ...; ...; }
+ # Regular syntax
+if [ ... ]; then
+    ...
+else
+    ...
+fi
+
+# 'case ... in ...) ... ;; ... esac'
+#-----------------------------------
+case ... in
+ # Very short syntax
+    ...) ...;;     ...) ...;;    ...) ...;;
+ #      Short syntax
+    ...) ...; ...; ...;;
+ #    Regular syntax
+    ...)
+	...
+	;;
+esac
+
+# List font lock faces with effective highlighting (can be customized)
+#---------------------------------------------------------------------
+ font-lock-warning-face
+ # for a construct that is peculiar, or that greatly changes the meaning of
+  #other text
+ font-lock-function-name-face
+ # for the name of a function being defined or declared
+ font-lock-variable-name-face
+ # for the name of a variable being defined or declared
+ font-lock-keyword-face
+ # for a keyword with special syntactic significance, like ‘for’ and ‘if’ in C.
+ font-lock-comment-face
+ # for comments
+ font-lock-comment-delimiter-face
+ # for comments delimiters, like ‘/*’ and ‘*/’ in C. On most terminals, this
+  #inherits from font-lock-comment-face
+ font-lock-type-face
+ # for the names of user-defined data types
+ font-lock-constant-face
+ # for the names of constants, like ‘NULL’ in C
+ font-lock-builtin-face
+ # for the names of built-in functions
+ font-lock-preprocessor-face
+ # for preprocessor commands. This inherits, by default, from
+  #font-lock-builtin-face
+ font-lock-string-face
+ # for string constants
+ font-lock-doc-face
+ # for documentation strings in the code. This inherits, by default, from
+  #font-lock-string-face
+ font-lock-negation-char-face
+ # for easily-overlooked negation characters
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/tools.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 8732)
@@ -0,0 +1,1 @@
+DOMAINcfg 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/README	(revision 8732)
@@ -0,0 +1,5 @@
+DMP_TOOLS should be used to create a netcdf file called resto.nc containing restoration coefficients for use with the tra_dmp module in NEMO. Further instructions for it's use are available in the NEMO users guide.
+
+The tool can be compiled using the maketools script in the NEMOGCM/TOOLS directory as follows:
+./maketools -m $ARCH -n DMP_TOOLS
+where $ARCH indicates the arch file to be used from the directory NEMOGCM/ARCH. For example to use NEMOGCM/ARCH/arch-PW7_MONSOON.fcm, $ARCH would be PW7_MONSOON.
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/namelist
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/namelist	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/namelist	(revision 8732)
@@ -0,0 +1,24 @@
+&nam_dmp_create
+    cp_cfg = 'orca'            ! Name of model grid (orca and C1D have special options - otherwise ignored)
+    cp_cfz = 'antarctic'       ! Name of zoom configuration (arctic and antarctic have some special treatment if lzoom=.true.)
+    jp_cfg = 2                 ! Resolution of the model (used for med_red_seas damping)
+    lzoom = .false.            ! Zoom configuration or not
+    ln_full_field = .false.    ! Calculate coefficient over whole of domain 
+    ln_med_red_seas = .true.   ! Damping in Med/Red Seas (or local modifications here if ln_full_field=.true.)
+    ln_old_31_lev_code = .true.   ! Replicate behaviour of old online code for 31 level model (Med/Red seas damping based on level number instead of depth)
+    ln_coast = .true.          ! Reduce near to coastlines 
+    ln_zero_top_layer = .true. ! No damping in top layer
+    ln_custom = .false.        ! Call "custom" module to apply user modifications to the damping coefficient field
+    nn_hdmp = 10               ! Damp poleward of this latitude (smooth transition up to maximum damping)
+    pn_surf = 0.25             ! Surface Relaxation timescale (days) 
+    pn_bot = 0.25              ! Bottom relaxation timescale (days)
+    pn_dep = 1000              ! Transition depth from upper to deep ocean
+    jperio = 2                 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
+&nam_zoom_dmp
+    lzoom_n = .false.     ! Open boundary had northern edge?
+    lzoom_e = .false.     ! Open boundary at eastern edge?
+    lzoom_w = .false.     ! Open boundary at western edge?
+    lzoom_s = .false.     ! Open boundary at southern edge?
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90	(revision 8732)
@@ -0,0 +1,220 @@
+MODULE coastdist
+
+   USE utils
+   USE netcdf
+
+   IMPLICIT NONE
+   PUBLIC 
+
+   CONTAINS
+
+   SUBROUTINE coast_dist_weight( presto ) 
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE coast_dist_weight ***
+      !!
+      !! ** Purpose: Weight restoration coefficient by distance to coast
+      !!
+      !! ** Method: 1) Calculate distance to coast
+      !!            2) Reduce resto with 1000km of coast
+      !!
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: presto
+      REAL(wp), DIMENSION(jpi,jpj) :: zdct
+      REAL(wp) :: zinfl = 1000.e3_wp  ! Distance of influence of coast line (could be
+                                  ! a namelist setting)
+      INTEGER :: jj, ji           ! dummy loop indices
+      
+
+      CALL cofdis( zdct )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdct(ji,jj) = MIN( zinfl, zdct(ji,jj) )
+            presto(ji,jj) = presto(ji, jj) * 0.5_wp * (  1._wp - COS( rpi*zdct(ji,jj)/zinfl) )
+         END DO
+      END DO
+
+   END SUBROUTINE coast_dist_weight
+
+
+   SUBROUTINE cofdis( pdct )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cofdis  ***
+      !!
+      !! ** Purpose :   Compute the distance between ocean T-points and the
+      !!      ocean model coastlines.
+      !!
+      !! ** Method  :   For each model level, the distance-to-coast is 
+      !!      computed as follows : 
+      !!       - The coastline is defined as the serie of U-,V-,F-points
+      !!      that are at the ocean-land bound.
+      !!       - For each ocean T-point, the distance-to-coast is then 
+      !!      computed as the smallest distance (on the sphere) between the 
+      !!      T-point and all the coastline points.
+      !!       - For land T-points, the distance-to-coast is set to zero.
+      !!
+      !! ** Action  : - pdct, distance to the coastline (argument)
+      !!              - NetCDF file 'dist.coast.nc' 
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   pdct   ! distance to the coastline
+      !!
+      INTEGER ::   ji, jj, jl   ! dummy loop indices
+      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers
+      CHARACTER (len=32) ::   clname                     ! local name
+      REAL(wp) ::   zdate0                               ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask
+      REAL(wp), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace
+      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::  llcotu, llcotv, llcotf   ! 2D logical workspace
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zxt(jpi,jpj) , zyt(jpi,jpj) , zzt(jpi,jpj) , zmask(jpi,jpj)    )
+      ALLOCATE(zxc(3*jpi*jpj), zyc(3*jpi*jpj), zzc(3*jpi*jpj), zdis(3*jpi*jpj)     )
+      ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj)  )
+      ALLOCATE( gphiu(jpi,jpj), gphiv(jpi,jpj), gphif(jpi,jpj)  )
+      ALLOCATE( glamu(jpi,jpj), glamv(jpi,jpj), glamf(jpi,jpj), glamt(jpi,jpj)  )
+      ALLOCATE( umask(jpi,jpj), vmask(jpi,jpj), fmask(jpi,jpj)  )
+      !
+
+      CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphiu_id, gphiu, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphiv_id, gphiv, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphif_id, gphif, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamt_id, glamt, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamu_id, glamu, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamv_id, glamv, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamf_id, glamf, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, umask_id, umask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, vmask_id, vmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, fmask_id, fmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+      pdct(:,:) = 0._wp
+      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+      zzt(:,:) = SIN( rad * gphit(:,:) )
+
+
+         ! Define the coastline points (U, V and F)
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+               zmask(ji,jj) =  ( tmask(ji,jj+1) + tmask(ji+1,jj+1) &
+                   &           + tmask(ji,jj  ) + tmask(ji+1,jj  ) )
+               llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj  ) == 1._wp ) 
+               llcotv(ji,jj) = ( tmask(ji,jj  ) + tmask(ji  ,jj+1) == 1._wp ) 
+               llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
+            END DO
+         END DO
+
+         ! Lateral boundaries conditions
+         llcotu(:, 1 ) = umask(:,  2  ) == 1
+         llcotu(:,jpj) = umask(:,jpj-1) == 1
+         llcotv(:, 1 ) = vmask(:,  2  ) == 1
+         llcotv(:,jpj) = vmask(:,jpj-1) == 1
+         llcotf(:, 1 ) = fmask(:,  2  ) == 1
+         llcotf(:,jpj) = fmask(:,jpj-1) == 1
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            llcotu( 1 ,:) = llcotu(jpi-1,:)
+            llcotu(jpi,:) = llcotu(  2  ,:)
+            llcotv( 1 ,:) = llcotv(jpi-1,:)
+            llcotv(jpi,:) = llcotv(  2  ,:)
+            llcotf( 1 ,:) = llcotf(jpi-1,:)
+            llcotf(jpi,:) = llcotf(  2  ,:)
+         ELSE
+            llcotu( 1 ,:) = umask(  2  ,:) == 1
+            llcotu(jpi,:) = umask(jpi-1,:) == 1
+            llcotv( 1 ,:) = vmask(  2  ,:) == 1
+            llcotv(jpi,:) = vmask(jpi-1,:) == 1
+            llcotf( 1 ,:) = fmask(  2  ,:) == 1
+            llcotf(jpi,:) = fmask(jpi-1,:) == 1
+         ENDIF
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-2)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj-1) = llcotu(iju,jpj-1)
+            END DO
+            DO ji = 2, jpi
+               ijt = jpi - ji + 2
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-2)
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
+            END DO
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            DO ji = 1, jpi-1
+               iju = jpi - ji
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-1)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-1)
+            END DO
+            DO ji = 1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-1)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-1)
+            END DO
+         ENDIF
+
+         ! Compute cartesian coordinates of coastline points
+         ! and the number of coastline points
+         icoast = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( llcotf(ji,jj) ) THEN
+                  icoast = icoast + 1
+                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
+               ENDIF
+               IF( llcotu(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+               ENDIF
+               IF( llcotv(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         ! Distance for the T-points
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj) == 0._wp ) THEN
+                  pdct(ji,jj) = 0._wp
+               ELSE
+                  DO jl = 1, icoast
+                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
+                        &     + ( zyt(ji,jj) - zyc(jl) )**2   &
+                        &     + ( zzt(ji,jj) - zzc(jl) )**2
+                  END DO
+                  pdct(ji,jj) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+               ENDIF
+            END DO
+         END DO
+
+      DEALLOCATE( zxt , zyt , zzt , zmask    )
+      DEALLOCATE(zxc, zyc, zzc, zdis    )
+      DEALLOCATE( llcotu, llcotv, llcotf  )
+      DEALLOCATE( gphiu, gphiv, gphif  )
+      DEALLOCATE( glamu, glamv, glamf, glamt  )
+      DEALLOCATE( umask, vmask, fmask  )
+
+   END SUBROUTINE cofdis
+
+END MODULE coastdist
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90	(revision 8732)
@@ -0,0 +1,22 @@
+MODULE custom
+
+   USE utils
+
+   IMPLICIT NONE
+   PUBLIC
+
+   CONTAINS
+
+   SUBROUTINE custom_resto( presto )
+      !!---------------------------------
+      !!     **ROUTINE: custom_resto
+      !!
+      !!  ** Purpose: Module to be edited by users to create custom restoration
+      !!              coefficient files (e.g. regional damping).
+      !!
+      !!-------------------------------------
+      REAL(wp), DIMENSION(jpi,jpk), INTENT(inout) :: presto
+
+   END SUBROUTINE custom_resto
+
+END MODULE custom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90	(revision 8732)
@@ -0,0 +1,123 @@
+PROGRAM make_dmp_file
+  !================================================================================
+  !               *** PROGRAM make_dmp_file ****
+  !================================================================================
+  !
+  !  Purpose: Create a file containing a spacially varying
+  !           restoration coefficient to be used by TRADMP
+  !
+  !  Method:  1) Read in tmask from mesh_mask file to use as a template
+  !           2) Calculate restoration coefficients according to options
+  !           specified in the namelist. The user may modify custom.F90 to
+  !           specify specific damping options e.g. to mask certain regions only).
+  !           3) Write the array to output file
+  !
+  !  History: Original code: Tim Graham (Jul 2014) - some code moved from
+  !                            old tradmp.F90 module to this tool (as part of NEMO
+  !                            simplification process).
+  !-------------------------------------------------------------------------------
+
+  ! Declare variables
+  USE netcdf 
+  USE utils
+  USE coastdist
+  USE med_red_seas
+  USE zoom
+  USE custom
+
+  IMPLICIT NONE
+  INTEGER  :: ji, jj, jk                         ! dummpy loop variables
+  REAL(wp) :: zsdmp, zbdmp                     ! Surface and bottom damping coeff
+  CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc'   ! mesh file
+  CHARACTER(LEN=200) :: outfile = 'resto.nc'     ! output file
+  REAL(wp) :: zlat, zlat2, zlat0
+
+  ! Read namelist
+  OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+  READ( numnam, nam_dmp_create )
+  CLOSE( numnam )
+  
+  IF ( ln_full_field .AND. lzoom ) THEN
+    WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.'
+    STOP
+  ENDIF
+
+  CALL grid_info(meshfile)
+  WRITE(numout, *) 'jpi = ',jpi
+  WRITE(numout, *) 'jpj = ',jpj
+  WRITE(numout, *) 'jpk = ',jpk
+
+  ALLOCATE( resto(jpi, jpj) )
+
+  !Create output file
+  CALL make_outfile( outfile )
+  
+  CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+  !Calculate surface and bottom damping coefficients
+  zsdmp = 1._wp / ( pn_surf * rday )
+  zbdmp = 1._wp / ( pn_bot  * rday )
+
+  !Loop through levels and read in tmask for each level as starting point for
+  !coefficient array
+  DO jk = 1, jpk-1
+     resto(:,:) = 0._wp
+     
+     IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN 
+        !Read in tmask depth for this level
+        CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+        CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+     
+
+        IF ( ln_full_field ) THEN
+           !Set basic value of resto
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep))
+              END DO
+           END DO
+           IF ((nn_hdmp > 0)) THEN
+              zlat0 = 10. !width of latitude strip where resto decreases
+              zlat2 = nn_hdmp + zlat0
+              DO jj = 1, jpj
+                 DO ji = 1, jpi
+                    zlat = ABS(gphit(ji,jj))
+                    IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN
+                       resto(ji,jj) = resto(ji,jj) * 0.5_wp * (  1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) )
+                    ELSE IF ( zlat < nn_hdmp ) THEN
+                       resto(ji,jj) = 0._wp
+                    ENDIF
+                 END DO
+              END DO
+           ENDIF
+    
+           IF (ln_coast) THEN
+              ! Reduce damping in vicinity of coastlines
+              CALL coast_dist_weight(resto)
+           ENDIF
+        ENDIF
+
+        ! Damping in Med/Red Seas (or local modifications if full field is set)
+        IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN
+           CALL med_red_dmp(resto, jk, ln_old_31_lev_code)
+        ENDIF
+
+        IF ( lzoom ) THEN
+              CALL dtacof_zoom(resto, tmask)
+        ENDIF
+        
+        !Any user modifications can be added in the custom module
+        IF ( ln_custom ) THEN
+              CALL custom_resto( resto )
+        ENDIF
+     ENDIF
+
+     ! Write out resto for this level
+     CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+
+  END DO
+  
+  ! Close the output file
+  CALL check_nf90( nf90_close(ncout) )
+
+END PROGRAM make_dmp_file
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90	(revision 8732)
@@ -0,0 +1,135 @@
+MODULE med_red_seas
+
+   USE utils
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   CONTAINS  
+
+   SUBROUTINE med_red_dmp(presto, jk, ln_31_lev)
+      !!------------------------------------
+      !!    **ROUTINE: med_red_dmp
+      !! 
+      !! **Purpose: Apply specific modifications to damping coefficients on ORCA
+      !!            grids in Med and Red Seas
+      !!
+      !!-----------------------------------
+      INTEGER :: ij0,ij1,ii0,ii1,ji,jj     
+      INTEGER, INTENT(in) :: jk
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmrs
+      REAL(wp) :: zhfac, zsdmp, zbdmp
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto
+      LOGICAL, INTENT(in), OPTIONAL :: ln_31_lev
+      LOGICAL :: l_31_lev
+
+      WRITE(numout,*) 'ORCA Med and Red Seas Damping'
+      
+      IF ( PRESENT(ln_31_lev)) THEN
+         l_31_lev = ln_31_lev
+      ELSE
+         l_31_lev = .false.
+      ENDIF
+      
+      ALLOCATE( zmrs(jpi, jpj) )
+         !
+         zmrs(:,:) = 0._wp
+         !
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration 
+            !                                        ! =======================
+            ij0 =  50   ;   ij1 =  56                    ! Mediterranean Sea
+
+            ii0 =  81   ;   ii1 =  91   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+            ij0 =  50   ;   ij1 =  55
+            ii0 =  75   ;   ii1 =  80   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+            ij0 =  52   ;   ij1 =  53
+            ii0 =  70   ;   ii1 =  74   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+           !
+           !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration 
+            !                                        ! =======================
+            ij0 =  96   ;   ij1 = 110                    ! Mediterranean Sea
+            ii0 = 157   ;   ii1 = 181   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ij0 = 100   ;   ij1 = 110
+            ii0 = 144   ;   ii1 = 156   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ij0 = 100   ;   ij1 = 103
+            ii0 = 139   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 = 101   ;   ij1 = 102                    ! Decrease before Gibraltar Strait
+            ii0 = 139   ;   ii1 = 141   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+            ii0 = 142   ;   ii1 = 142   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ii0 = 143   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ii0 = 144   ;   ii1 = 144   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+            !
+            ij0 =  87   ;   ij1 =  96                    ! Red Sea
+            ii0 = 147   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 =  91   ;   ij1 =  91                    ! Decrease before Bab el Mandeb Strait
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp
+            ij0 =  90   ;   ij1 =  90
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ij0 =  89   ;   ij1 =  89
+            ii0 = 158   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 160   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+            !
+            !                                        ! =======================
+         CASE ( 05 )                                 !  ORCA_R05 configuration
+            !                                        ! =======================
+            ii0 = 568   ;   ii1 = 574                    ! Mediterranean Sea
+            ij0 = 324   ;   ij1 = 333   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ii0 = 575   ;   ii1 = 658
+            ij0 = 314   ;   ij1 = 366   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ii0 = 641   ;   ii1 = 651                    ! Black Sea (remaining part
+            ij0 = 367   ;   ij1 = 372   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 = 324   ;   ij1 = 333                    ! Decrease before Gibraltar Strait
+            ii0 = 565   ;   ii1 = 565   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ii0 = 566   ;   ii1 = 566   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ii0 = 567   ;   ii1 = 567   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+            !
+            ii0 = 641   ;   ii1 = 665                    ! Red Sea
+            ij0 = 270   ;   ij1 = 310   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait
+            ij0 = 270   ;   ij1 = 290   
+            DO ji = ii0, ii1
+               zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) )
+            END DO 
+            !                                       ! ========================
+         CASE ( 025 )                               !  ORCA_R025 configuration 
+            !                                       ! ========================
+            WRITE(numerr,*) ' Mediterranean and Red Sea damping option not implemented for ORCA_R025'
+            WRITE(numerr,*) ' Set ln_med_red = .false.'
+            STOP
+            !
+         END SELECT
+
+         zsdmp = 1._wp / ( pn_surf * rday )
+         zbdmp = 1._wp / ( pn_bot  * rday )
+
+         ! The l_31_lev option is used to reproduce the old behaviour of
+         ! defining the restoration coefficient based on the level number.
+         ! This is included to allow damping coefficients for reference
+         ! configurations to be kept the same.
+         IF (l_31_lev) THEN
+            IF (jk <= 17) THEN
+               zhfac = 0.5_wp * (  1. - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
+            ELSE
+               zhfac = 1._wp / rday
+            ENDIF
+         ELSE
+            zhfac = (  zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep )  )
+         ENDIF
+
+         presto(:,:) = zmrs(:,:) * zhfac + ( 1._wp - zmrs(:,:) ) * presto(:,:)
+
+         DEALLOCATE( zmrs )         
+
+   END SUBROUTINE med_red_dmp
+
+
+END MODULE med_red_seas
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90	(revision 8732)
@@ -0,0 +1,130 @@
+MODULE utils
+
+  USE netcdf
+
+  IMPLICIT NONE
+  PUBLIC
+  
+  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
+  INTEGER :: tmask_id, umask_id, vmask_id, fmask_id
+  INTEGER :: gdept_id
+  INTEGER :: gphit_id, gphiv_id, gphiu_id, gphif_id        ! Variable ids
+  INTEGER :: glamt_id, glamv_id, glamu_id, glamf_id        ! Variable ids
+  INTEGER :: resto_id                           ! Variable ID for output
+  INTEGER :: jpi, jpj, jpk                      ! Size of domain
+  INTEGER  :: ncin, ncout                              ! File handles for netCDF files
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit, glamt
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu, glamu
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiv, glamv
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphif, glamf
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask, umask, vmask, fmask
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gdept
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: resto
+
+  INTEGER,PARAMETER :: numout = 6
+  INTEGER,PARAMETER :: numerr = 0
+  INTEGER,PARAMETER :: numnam = 11
+  REAL(wp),PARAMETER :: rday = 86400           ! seconds in a day
+  REAL(wp),PARAMETER ::   rpi = 3.141592653589793
+  REAL(wp),PARAMETER ::   rad = 3.141592653589793/180.
+  REAL(wp),PARAMETER ::   ra =  6371229.
+
+  ! Namelist variables
+  CHARACTER(LEN=30) :: cp_cfg = 'ORCA'
+  CHARACTER(LEN=30) :: cp_cfz = 'No zoom'
+  INTEGER :: jp_cfg = 2
+  REAL(KIND=8) :: pn_surf = 1
+  REAL(KIND=8) :: pn_bot = 1
+  REAL(KIND=8) :: pn_dep = 1000         
+  INTEGER  :: nn_hdmp = 0                          ! damping option
+  INTEGER  :: jperio = 0                          ! damping option
+  LOGICAL :: lzoom = .false.
+  LOGICAL :: ln_coast = .false.
+  LOGICAL :: ln_full_field = .true.
+  LOGICAL :: ln_med_red_seas = .false.
+  LOGICAL :: ln_old_31_lev_code = .false.
+  LOGICAL :: ln_zero_top_layer = .false.
+  LOGICAL :: ln_custom = .false.
+
+  NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, &
+                          ln_med_red_seas, ln_old_31_lev_code, ln_coast, &
+                          ln_zero_top_layer, ln_custom, &
+                          pn_surf, pn_bot, pn_dep, nn_hdmp, jperio
+
+  CONTAINS 
+
+  SUBROUTINE grid_info(mesh)
+     CHARACTER(LEN=*),INTENT(in) :: mesh
+
+     ! Open meshfile
+     CALL check_nf90( nf90_open(mesh, NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
+  
+     ! Get size of grid from meshfile
+     CALL dimlen( ncin, 'x', jpi )
+     CALL dimlen( ncin, 'y', jpj )
+     CALL dimlen( ncin, 'z', jpk )
+
+     ALLOCATE( tmask(jpi, jpj), gdept(jpi, jpj), gphit(jpi,jpj) )
+
+     !Get ID of tmask in meshfile
+     CALL check_nf90( nf90_inq_varid( ncin, 'tmask', tmask_id ), 'Cannot get variable ID for tmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'umask', umask_id ), 'Cannot get variable ID for umask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'vmask', vmask_id ), 'Cannot get variable ID for vmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'fmask', fmask_id ), 'Cannot get variable ID for fmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gdept_0', gdept_id ), 'Cannot get variable ID for gdept_0')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', gphit_id ), 'Cannot get variable ID for gphit')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphiu', gphiu_id ), 'Cannot get variable ID for gphiu')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphiv', gphiv_id ), 'Cannot get variable ID for gphiv')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphif', gphif_id ), 'Cannot get variable ID for gphif')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamt', glamt_id ), 'Cannot get variable ID for glamt')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamu', glamu_id ), 'Cannot get variable ID for glamu')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamv', glamv_id ), 'Cannot get variable ID for glamv')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamf', glamf_id ), 'Cannot get variable ID for glamf')
+  
+  END SUBROUTINE grid_info
+
+  SUBROUTINE dimlen( ncid, dimname, len )
+     ! Determine the length of dimension dimname
+     INTEGER, INTENT(in)          :: ncid
+     CHARACTER(LEN=*), INTENT(in) :: dimname
+     INTEGER, INTENT(out)         :: len
+     ! Local variables
+     INTEGER :: id_var, istatus
+
+     id_var = 1
+     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+  END SUBROUTINE dimlen
+
+  SUBROUTINE make_outfile( filename )
+     ! Create the output file
+     ! Define dimensions and resto variable
+     CHARACTER(LEN=*), INTENT(in) :: filename
+     INTEGER :: id_x, id_y, id_z
+
+     CALL check_nf90( nf90_create(filename, NF90_CLOBBER, ncout), 'Could not create output file')
+     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+
+     CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) )
+     CALL check_nf90( nf90_enddef(ncout) )
+
+  END SUBROUTINE make_outfile
+
+
+  SUBROUTINE check_nf90( istat, message )
+     !Check for netcdf errors
+     INTEGER, INTENT(in) :: istat
+     CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+     
+     IF (istat /= nf90_noerr) THEN
+        WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+        IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
+        STOP
+     ENDIF
+
+  END SUBROUTINE check_nf90
+
+END MODULE utils
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90	(revision 8732)
@@ -0,0 +1,87 @@
+MODULE zoom
+   
+   USE utils
+
+   CONTAINS
+
+   SUBROUTINE dtacof_zoom( presto, mask)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof_zoom  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient for zoom domain
+      !!
+      !! ** Method  : - set along closed boundary due to zoom a damping over
+      !!                6 points with a max time scale of 5 days.
+      !!              - ORCA arctic/antarctic zoom: set the damping along
+      !!                south/north boundary over a latitude strip.
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  ::   mask   ! restoring coeff. (s-1)
+      !
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      REAL(wp) ::   zlat, zlat0, zlat1, zlat2, z1_5d   ! local scalar
+      REAL(wp), DIMENSION(6)  ::   zfact               ! 1Dworkspace
+
+      !Namelist variables
+      LOGICAL :: lzoom_w, lzoom_e, lzoom_n, lzoom_s 
+      NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s
+      !!----------------------------------------------------------------------
+
+      ! Read namelist
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, nam_dmp_create )
+      CLOSE( numnam )
+
+      zfact(1) =  1._wp
+      zfact(2) =  1._wp
+      zfact(3) = 11._wp / 12._wp
+      zfact(4) =  8._wp / 12._wp
+      zfact(5) =  4._wp / 12._wp
+      zfact(6) =  1._wp / 12._wp
+      zfact(:) = zfact(:) / ( 5._wp * rday )    ! 5 days max restoring time scale
+
+      presto(:,:) = 0._wp
+
+      ! damping along the forced closed boundary over 6 grid-points
+      DO jn = 1, 6
+         IF( lzoom_w )   presto( jn, : )                    = zfact(jn)   ! west  closed
+         IF( lzoom_s )   presto( : , jn )                    = zfact(jn)   ! south closed 
+         IF( lzoom_e )   presto( jpi+1-jn , : ) = zfact(jn)   ! east  closed 
+         IF( lzoom_n )   presto( : , jpj+1-jn ) = zfact(jn)   ! north closed
+      END DO
+
+      !                                           ! ====================================================
+      IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN   !  ORCA configuration : arctic or antarctic zoom
+         !                                        ! ====================================================
+         WRITE(numout,*)
+         IF(cp_cfz == "arctic" ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
+         IF(cp_cfz == "antarctic" ) WRITE(numout,*) '           dtacof_zoom : ORCA Antarctic zoom'
+         WRITE(numout,*)
+         !
+         !                          ! Initialization : 
+         presto(:,:) = 0._wp
+         zlat0 = 10._wp                     ! zlat0 : latitude strip where resto decreases
+         zlat1 = 30._wp                     ! zlat1 : resto = 1 before zlat1
+         zlat2 = zlat1 + zlat0              ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         z1_5d = 1._wp / ( 5._wp * rday )   ! z1_5d : 1 / 5days
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlat = ABS( gphit(ji,jj) )
+               IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                  presto(ji,jj) = 0.5_wp * z1_5d * (  1._wp - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
+               ELSEIF( zlat < zlat1 ) THEN
+                  presto(ji,jj) = z1_5d
+               ENDIF
+            END DO
+         END DO
+         !
+      ENDIF
+      !                             ! Mask resto array
+      presto(:,:) = presto(:,:) * mask(:,:)
+
+   END SUBROUTINE dtacof_zoom
+
+END MODULE zoom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/README	(revision 8732)
@@ -0,0 +1,73 @@
+================================
+= HOW TO COMPILE
+================================
+The DOMAINcfg tool can be compiled using the maketools script in the NEMOGCM/TOOLS directory as follows:
+:::::::::::::::::::::::::::::::::
+./maketools -m $ARCH -n DOMAINcfg
+:::::::::::::::::::::::::::::::::
+where $ARCH indicates the arch file to be used from the directory NEMOGCM/ARCH. 
+
+DOMAINcfg compiled will create "make_domain_cfg.exe" executable script (the main routine of this tool is make_domain_cfg.f90)
+
+================================
+= HOW TO RUN
+================================
+just run :
+:::::::::::::::::::::::::::::::::::::::::::::::::
+mpirun -np 1 ./make_domain_cfg.exe
+:::::::::::::::::::::::::::::::::::::::::::::::::
+NOTA: it can be run in multiproc mode, but in output there will be domain_cfg_00xx.nc files
+
+================================
+= HOW TO USE
+================================
+::: VERY IMPORTANT PRE-REQUIRED :::
+0) pre-required: this tool needs xios1
+
+  (download http://forge.ipsl.jussieu.fr/ioserver/svn/XIOS/branchs/xios-1.0
+   DOMAINcfg tool is working with revision 703 of xios)
+
+1) copy in DOMAINcfg  directory namelist_cfg all settings (that you had in 3.6_stable) of the configuration for which you want prepare domain_cfg.nc file
+IMPORTANT : keep the namelist_ref committed inchanged. 
+
+NEW OPTION ln_e3_dep in the namelist_ref:
+till nemo_v3.6_stable e3 were done like an analytical derivative of depth function
+now  e3=dk[depth] in discret sens
+
+If you want to create same e3[tuvw] like 3.6 you've to use "ln_e3_dep=.false."
+
+ ln_e3_dep   = .true.    ! =T : e3=dk[depth] in discret sens.
+   !                       !      ===>>> will become the only possibility in v4.0
+   !                       ! =F : e3 analytical derivative of depth function
+   !                       !      only there for backward compatibility test with v3.6
+   !
+
+2) copy in DOMAINcfg directory same input files (of related configuration) required in v3.6_stable.
+
+DOMAINcfg package is EXACTLY what does exist in NEMO version 3.6 to define a model domain (both domain related namelist and initialization).
+DOMAINcfg tool creates a netcdf file "domain_cfg.nc" containing all the ocean domain informations required to define an ocean configuration,
+these files are :
+          
+    domain size
+    domain characteristics (periodic)
+    horizontal mesh
+    Coriolis parameter
+    depth and vertical scale factors
+
+FOR EXAMPLE 
+- for AMM12 : 
+            coordinates.nc
+            bathy_meter.nc
+            bathy_level.nc
+            amm12_rivers.nc
+            coordinates.bdy.nc
+            amm12_restart_oce.nc
+         directories:   bdydta/
+                        fluxes/
+- for ORCA2 : 
+            coordinates.nc
+            bathy_meter.nc
+            bathy_level.nc
+            domain_def.xml
+            field_def.xml
+            iodef.xml
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/domain_def.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/domain_def.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/domain_def.xml	(revision 8732)
@@ -0,0 +1,187 @@
+
+   <domain_definition>
+      <domain_group id="grid_T">
+         <domain id="grid_T" long_name="grid T"/>
+	 <!--   My zoom: example of hand defined zoom   -->
+         <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" />
+         <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" />
+         <!--   Eq section   -->
+         <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" />
+         <!--   TAO   -->
+         <!--   137e   -->
+         <domain id="2n137eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n137eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n137eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   147e   -->
+         <domain id="0n147eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n147eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n147eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   156e   -->
+         <domain id="5s156eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s156eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n156eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n156eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n156eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n156eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   165e   -->
+         <domain id="8s165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n165eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   180w   -->
+         <domain id="8s180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n180wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   170w   -->
+         <domain id="8s170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n170wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   155w   -->
+         <domain id="8s155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n155wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   140w   -->
+         <domain id="8s140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n140wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   125w   -->
+         <domain id="8s125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n125wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   110w   -->
+         <domain id="8s110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n110wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   95w   -->
+         <domain id="8s95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2s95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="2n95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5n95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n95wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   RAMA   -->
+         <!--   55e   -->
+         <domain id="16s55eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12s55eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8s55eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4s55eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5s55eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n55eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5n55eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4n55eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+            <!--   65e   -->
+         <domain id="15n65eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+            <!--   67e   -->
+         <domain id="16s67eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12s67eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8s67eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4s67eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5s67eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n67eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5n67eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4n67eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n67eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   80.5e   -->
+         <domain id="16s80.5eT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12s80.5eT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8s80.5eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4s80.5eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5s80.5eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n80.5eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5n80.5eT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4n80.5eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   90e   -->
+         <domain id="1.5s90eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n90eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="1.5n90eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4n90eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n90eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12n90eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="15n90eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   95e   -->
+         <domain id="16s95eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12s95eT"    zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8s95eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="5s95eT"     zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   PIRATA   -->
+         <!--   38w-30w   -->
+         <domain id="19s34wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="14s32wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8s30wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n35wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4n38wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="8n38wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12n38wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="15n38wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="20n38wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   23w   -->
+         <domain id="0n23wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="4n23wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="12n23wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="21n23wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   10w   -->
+         <domain id="10s10wT" zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="6s10wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <domain id="0n10wT"  zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+         <!--   0e   -->
+         <domain id="0n0eT"   zoom_ibegin="0000" zoom_jbegin="0000" zoom_ni="1" zoom_nj="1" />
+      </domain_group>
+
+      <domain_group id="grid_U">
+         <domain id="grid_U" long_name="grid U"/>
+         <!--   Eq section   -->
+         <domain id="EqU" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" />
+      </domain_group>
+
+      <domain id="grid_V" long_name="grid V"/>
+      
+      <domain_group id="grid_W">
+         <domain id="grid_W" long_name="grid W"/>
+         <!--   Eq section   -->
+         <domain id="EqW" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" />
+      </domain_group>
+
+      <domain id="grid_F" long_name="grid F"/>
+
+      <domain_group id="scalarpoint"> 
+         <domain id="scalarpoint" long_name="scalar"/> 
+         <!-- 
+         <domain id="1point" zoom_ibegin="1" zoom_jbegin="1" zoom_ni="1" zoom_nj="1" /> 
+         --> 
+      </domain_group>
+
+      <domain_group id="gznl">
+         <domain id="ptr" long_name="zonal mean grid" zoom_ibegin="0000"  zoom_jbegin="1" zoom_ni="1" zoom_nj="0000" />
+      </domain_group>
+
+
+   </domain_definition>    
+ 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/field_def.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/field_def.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/field_def.xml	(revision 8732)
@@ -0,0 +1,1114 @@
+<!--
+<?xml version="1.0"?>
+       -->
+ 
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+   <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined -->
+
+    <!-- 
+============================================================================================================
+                                  Physical ocean and ice model variables
+============================================================================================================
+    -->
+
+      <!-- T grid -->
+      
+      <field_group id="grid_T" grid_ref="grid_T_2D" >
+         <field id="e3t"          long_name="T-cell thickness"   standard_name="cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+         <field id="e3t_0"        long_name="Initial T-cell thickness"   standard_name="ref_cell_thickness"   unit="m"   grid_ref="grid_T_3D"/>
+
+         <field id="toce"         long_name="temperature"         standard_name="sea_water_potential_temperature"   unit="degC"     grid_ref="grid_T_3D"/>
+         <field id="toce_e3t"     long_name="temperature (thickness weighted)"                                      unit="degC"     grid_ref="grid_T_3D" > toce * e3t </field >
+         <field id="soce"         long_name="salinity"            standard_name="sea_water_practical_salinity"      unit="1e-3"     grid_ref="grid_T_3D"/>
+         <field id="soce_e3t"     long_name="salinity    (thickness weighted)"                                      unit="1e-3"     grid_ref="grid_T_3D" > soce * e3t </field >
+
+	      <!-- t-eddy viscosity coefficients (ldfdyn) -->
+	      <field id="ahmt_2d"      long_name=" surface t-eddy viscosity coefficient"   unit="m2/s or m4/s" />
+	      <field id="ahmt_3d"      long_name=" 3D      t-eddy viscosity coefficient"   unit="m2/s or m4/s"                           grid_ref="grid_T_3D"/>
+
+         <field id="sst"          long_name="sea surface temperature"             standard_name="sea_surface_temperature"             unit="degC"     />
+         <field id="sst2"         long_name="square of sea surface temperature"   standard_name="square_of_sea_surface_temperature"   unit="degC2"     > sst * sst </field >
+         <field id="sstmax"       long_name="max of sea surface temperature"   field_ref="sst"   operation="maximum"                                  />
+         <field id="sstmin"       long_name="min of sea surface temperature"   field_ref="sst"   operation="minimum"                                  />
+         <field id="sstgrad"      long_name="module of sst gradient"                                                                  unit="degC/m"   />
+         <field id="sstgrad2"     long_name="square of module of sst gradient"                                                        unit="degC2/m2" />
+         <field id="sbt"          long_name="sea bottom temperature"                                                                  unit="degC"     />
+         <field id="sst_wl"       long_name="Delta SST of warm layer"                                                                 unit="degC"     />
+         <field id="sst_cs"       long_name="Delta SST of cool skin"                                                                  unit="degC"     />
+	 <field id="temp_3m"      long_name="temperature at 3m"                                                                       unit="degC"     />
+         
+         <field id="sss"          long_name="sea surface salinity"             standard_name="sea_surface_salinity"   unit="1e-3" />
+         <field id="sss2"         long_name="square of sea surface salinity"                                          unit="1e-6"  > sss * sss </field >
+         <field id="sssmax"       long_name="max of sea surface salinity"   field_ref="sss"   operation="maximum"                 />
+         <field id="sssmin"       long_name="min of sea surface salinity"   field_ref="sss"   operation="minimum"                 />
+         <field id="sbs"          long_name="sea bottom salinity"                                                     unit="1e-3" />
+
+         <field id="taubot"       long_name="bottom stress module"                                                    unit="N/m2" /> 
+
+         <field id="ssh"          long_name="sea surface height"             standard_name="sea_surface_height_above_geoid"             unit="m" />
+         <field id="ssh2"         long_name="square of sea surface height"   standard_name="square_of_sea_surface_height_above_geoid"   unit="m2" > ssh * ssh </field >
+         <field id="sshmax"       long_name="max of sea surface height"   field_ref="ssh"   operation="maximum"                                  />
+
+         <field id="mldkz5"       long_name="Turbocline depth (Kz = 5e-4)"                       standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity"                unit="m"          />
+         <field id="mldr10_1"     long_name="Mixed Layer Depth (dsigma = 0.01 wrt 10m)"          standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"          />
+         <field id="mldr10_1max"  long_name="Max of Mixed Layer Depth (dsigma = 0.01 wrt 10m)"   field_ref="mldr10_1"   operation="maximum"                                                                          />
+         <field id="mldr10_1min"  long_name="Min of Mixed Layer Depth (dsigma = 0.01 wrt 10m)"   field_ref="mldr10_1"   operation="minimum"                                                                          />
+         <field id="heatc"        long_name="Heat content vertically integrated"                 standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"       />
+         <field id="saltc"        long_name="Salt content vertically integrated"                                                                                                                   unit="1e-3*kg/m2" />
+
+         <!-- EOS -->
+         <field id="alpha"        long_name="thermal expansion"                                                         unit="degC-1" grid_ref="grid_T_3D" />
+         <field id="beta"         long_name="haline contraction"                                                        unit="1e3"    grid_ref="grid_T_3D" />
+         <field id="bn2"          long_name="squared Brunt-Vaisala frequency"                                           unit="s-1"    grid_ref="grid_T_3D" />
+         <field id="rhop"         long_name="potential density (sigma0)"        standard_name="sea_water_sigma_theta"   unit="kg/m3"  grid_ref="grid_T_3D" />
+
+         <!-- Energy - horizontal divergence -->
+         <field id="eken"         long_name="kinetic energy"          standard_name="specific_kinetic_energy_of_sea_water"   unit="m2/s2"  grid_ref="grid_T_3D" />
+         <field id="hdiv"         long_name="horizontal divergence"                                                          unit="s-1"    grid_ref="grid_T_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="Lf_NHpf"      long_name="MLE: Lf = N H / f"   unit="m" />
+
+         <!-- next variables available with key_diahth -->
+         <field id="mlddzt"       long_name="Thermocline Depth (depth of max dT/dz)"         standard_name="depth_at_maximum_upward_derivative_of_sea_water_potential_temperature"             unit="m"                         />
+         <field id="mldr10_3"     long_name="Mixed Layer Depth (dsigma = 0.03 wrt 10m)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="mldr0_1"      long_name="Mixed Layer Depth (dsigma = 0.01 wrt sfc)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="mldr0_3"      long_name="Mixed Layer Depth (dsigma = 0.03 wrt sfc)"      standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="mld_dt02"     long_name="Mixed Layer Depth (|dT| = 0.2 wrt 10m)"         standard_name="ocean_mixed_layer_thickness_defined_by_temperature"                                unit="m"                         />
+         <field id="topthdep"     long_name="Top of Thermocline Depth (dT = -0.2 wrt 10m)"   standard_name="ocean_mixed_layer_thickness_defined_by_temperature"                                unit="m"                         />
+         <field id="pycndep"      long_name="Pycnocline Depth (dsigma[dT=-0.2] wrt 10m)"     standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta"                                unit="m"                         />
+         <field id="BLT"          long_name="Barrier Layer Thickness"                                                                                                                          unit="m"                          > topthdep - pycndep </field>
+         <field id="tinv"         long_name="Max of vertical invertion of temperature"                                                                                                         unit="degC"                      />
+         <field id="depti"        long_name="Depth of max. vert. inv. of temperature"                                                                                                          unit="m"                         />
+         <field id="20d"          long_name="Depth of 20C isotherm"                          standard_name="depth_of_isosurface_of_sea_water_potential_temperature"                            unit="m"      axis_ref="iax_20C" />
+         <field id="28d"          long_name="Depth of 28C isotherm"                          standard_name="depth_of_isosurface_of_sea_water_potential_temperature"                            unit="m"      axis_ref="iax_28C" />
+         <field id="hc300"        long_name="Heat content 0-300m"                            standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content"   unit="J/m2"                      />
+
+         <!-- variables available with key_diaar5 -->
+         <field id="botpres"      long_name="Pressure at sea floor"   standard_name="sea_water_pressure_at_sea_floor"   unit="dbar" />
+
+         <!-- variables available with key_vvl -->
+         <field id="tpt_dep"      long_name="T-point depth"                  standard_name="depth_below_geoid"   unit="m"   grid_ref="grid_T_3D" />
+         <field id="e3tdef"       long_name="T-cell thickness deformation"                                       unit="%"   grid_ref="grid_T_3D" />
+      </field_group>
+
+      <!-- Tides -->
+
+      <field_group id="Tides_T" grid_ref="grid_T_2D" operation="once" >
+         <!-- tidal composante -->
+         <field id="M2x"          long_name="M2 Elevation harmonic real part "                             unit="m"        />
+         <field id="M2y"          long_name="M2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="S2x"          long_name="S2 Elevation harmonic real part "                             unit="m"        />
+         <field id="S2y"          long_name="S2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="N2x"          long_name="N2 Elevation harmonic real part "                             unit="m"        />
+         <field id="N2y"          long_name="N2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="K1x"          long_name="K1 Elevation harmonic real part "                             unit="m"        />
+         <field id="K1y"          long_name="K1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="O1x"          long_name="O1 Elevation harmonic real part "                             unit="m"        />
+         <field id="O1y"          long_name="O1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Q1x"          long_name="Q1 Elevation harmonic real part "                             unit="m"        />
+         <field id="Q1y"          long_name="Q1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="M4x"          long_name="M4 Elevation harmonic real part "                             unit="m"        />
+         <field id="M4y"          long_name="M4 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="K2x"          long_name="K2 Elevation harmonic real part "                             unit="m"        />
+         <field id="K2y"          long_name="K2 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="P1x"          long_name="P1 Elevation harmonic real part "                             unit="m"        />
+         <field id="P1y"          long_name="P1 Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Mfx"          long_name="Mf Elevation harmonic real part "                             unit="m"        />
+         <field id="Mfy"          long_name="Mf Elevation harmonic imaginary part"                         unit="m"        />
+         <field id="Mmx"          long_name="Mm Elevation harmonic real part "                             unit="m"        />
+         <field id="Mmy"          long_name="Mm Elevation harmonic imaginary part"                         unit="m"        />
+      </field_group>
+	 
+      <field_group id="Tides_U" grid_ref="grid_U_2D" operation="once" >
+         <field id="M2x_u"        long_name="M2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="M2y_u"        long_name="M2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="S2x_u"        long_name="S2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="S2y_u"        long_name="S2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="N2x_u"        long_name="N2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="N2y_u"        long_name="N2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K1x_u"        long_name="K1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="K1y_u"        long_name="K1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="O1x_u"        long_name="O1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="O1y_u"        long_name="O1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Q1x_u"        long_name="Q1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Q1y_u"        long_name="Q1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="M4x_u"        long_name="M4 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="M4y_u"        long_name="M4 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K2x_u"        long_name="K2 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="K2y_u"        long_name="K2 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="P1x_u"        long_name="P1 current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="P1y_u"        long_name="P1 current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mfx_u"        long_name="Mf current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Mfy_u"        long_name="Mf current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mmx_u"        long_name="Mm current barotrope along i-axis harmonic real part "        unit="m/s"      />
+         <field id="Mmy_u"        long_name="Mm current barotrope along i-axis harmonic imaginary part "   unit="m/s"      />
+      </field_group>
+	 
+      <field_group id="Tides_V" grid_ref="grid_V_2D" operation="once" >
+         <field id="M2x_v"        long_name="M2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="M2y_v"        long_name="M2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="S2x_v"        long_name="S2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="S2y_v"        long_name="S2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="N2x_v"        long_name="N2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="N2y_v"        long_name="N2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K1x_v"        long_name="K1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="K1y_v"        long_name="K1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="O1x_v"        long_name="O1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="O1y_v"        long_name="O1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Q1x_v"        long_name="Q1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Q1y_v"        long_name="Q1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="M4x_v"        long_name="M4 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="M4y_v"        long_name="M4 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="K2x_v"        long_name="K2 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="K2y_v"        long_name="K2 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="P1x_v"        long_name="P1 current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="P1y_v"        long_name="P1 current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mfx_v"        long_name="Mf current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Mfy_v"        long_name="Mf current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />
+         <field id="Mmx_v"        long_name="Mm current barotrope along j-axis harmonic real part "        unit="m/s"      />
+         <field id="Mmy_v"        long_name="Mm current barotrope along j-axis harmonic imaginary part "   unit="m/s"      />	 
+      </field_group>
+
+      <!-- SBC -->
+      
+      <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc -->
+         <field id="empmr"        long_name="Net Upward Water Flux"                standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   />
+         <field id="empbmr"       long_name="Net Upward Water Flux at pre. tstep"  standard_name="water_flux_out_of_sea_ice_and_sea_water"                              unit="kg/m2/s"   />
+         <field id="emp_oce"      long_name="Evap minus Precip over ocean"         standard_name="evap_minus_precip_over_sea_water"                                     unit="kg/m2/s"   />
+         <field id="emp_ice"      long_name="Evap minus Precip over ice"           standard_name="evap_minus_precip_over_sea_ice"                                       unit="kg/m2/s"   />
+         <field id="saltflx"      long_name="Downward salt flux"                                                                                                        unit="1e-3/m2/s" />
+         <field id="fmmflx"       long_name="Water flux due to freezing/melting"                                                                                        unit="kg/m2/s"   />
+         <field id="snowpre"      long_name="Snow precipitation"                   standard_name="snowfall_flux"                                                        unit="kg/m2/s"   />
+         <field id="runoffs"      long_name="River Runoffs"                        standard_name="water_flux_into_sea_water_from_rivers"                                unit="kg/m2/s"   />
+         <field id="precip"       long_name="Total precipitation"                  standard_name="precipitation_flux"                                                   unit="kg/m2/s"   />
+ 
+         <field id="qt"           long_name="Net Downward Heat Flux"                standard_name="surface_downward_heat_flux_in_sea_water"                              unit="W/m2"                           />
+         <field id="qns"          long_name="non solar Downward Heat Flux"                                                                                               unit="W/m2"                           />
+         <field id="qsr"          long_name="Shortwave Radiation"                   standard_name="net_downward_shortwave_flux_at_sea_water_surface"                     unit="W/m2"                           />
+         <field id="qsr3d"        long_name="Shortwave Radiation 3D distribution"   standard_name="downwelling_shortwave_flux_in_sea_water"                              unit="W/m2"      grid_ref="grid_T_3D" />
+         <field id="qrp"          long_name="Surface Heat Flux: Damping"            standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation"                 unit="W/m2"                           />
+         <field id="erp"          long_name="Surface Water Flux: Damping"           standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation"              unit="kg/m2/s"                        />
+         <field id="taum"         long_name="wind stress module"                    standard_name="magnitude_of_surface_downward_stress"                                 unit="N/m2"                           />
+         <field id="wspd"         long_name="wind speed module"                     standard_name="wind_speed"                                                           unit="m/s"                            />
+         
+         <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+         <field id="ssh_ib"       long_name="Inverse barometer sea surface height"  standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency"   unit="m"        />
+
+         <!-- * variable related to ice shelf forcing * -->
+         <field id="fwfisf"       long_name="Ice shelf melting"                                            unit="Kg/m2/s"  />
+         <field id="qisf"         long_name="Ice Shelf Heat Flux"                                          unit="W/m2"     />
+         <field id="isfgammat"    long_name="transfert coefficient for isf (temperature) "                 unit="m/s"      />
+         <field id="isfgammas"    long_name="transfert coefficient for isf (salinity)    "                 unit="m/s"      />
+ 	 <field id="stbl"         long_name="salinity in the Losh tbl                    "                 unit="PSU"      />
+	 <field id="ttbl"         long_name="temperature in the Losh tbl                 "                 unit="C"        />
+	 <field id="utbl"         long_name="zonal current in the Losh tbl at T point    "                 unit="m/s"      />
+	 <field id="vtbl"         long_name="merid current in the Losh tbl at T point    "                 unit="m/s"      />
+	 <field id="thermald"     long_name="thermal driving of ice shelf melting        "                 unit="C"        />
+	 <field id="tfrz"         long_name="top freezing point (used to compute melt)   "                 unit="C"        />
+	 <field id="tinsitu"      long_name="top insitu temperature (used to cmpt melt)  "                 unit="C"        />
+	 <field id="ustar"        long_name="ustar at T point used in ice shelf melting  "                 unit="m/s"      />
+
+         <!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"  standard_name="surface_net_downward_longwave_flux"   unit="W/m2"  />
+         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"  standard_name="surface_downward_sensible_heat_flux"  unit="W/m2"  />
+         <field id="qla_oce"      long_name="Latent Downward Heat Flux over open ocean"    standard_name="surface_downward_latent_heat_flux"    unit="W/m2"  />
+         <field id="qemp_oce"     long_name="Downward Heat Flux from E-P over open ocean"                                                       unit="W/m2"  />
+         <field id="taum_oce"     long_name="wind stress module over open ocean"           standard_name="magnitude_of_surface_downward_stress" unit="N/m2"  />
+
+         <!-- available key_oasis3 -->
+         <field id="snow_ao_cea"  long_name="Snow over ice-free ocean (cell average)"   standard_name="snowfall_flux"                             unit="kg/m2/s"  />
+         <field id="snow_ai_cea"  long_name="Snow over sea-ice (cell average)"          standard_name="snowfall_flux"                             unit="kg/m2/s"  />
+         <field id="subl_ai_cea"  long_name="Sublimation over sea-ice (cell average)"   standard_name="surface_snow_and_ice_sublimation_flux"     unit="kg/m2/s"  />
+         <field id="icealb_cea"   long_name="Ice albedo (cell average)"                 standard_name="sea_ice_albedo"                            unit="1"        />
+         <field id="calving_cea"  long_name="Calving"                                   standard_name="water_flux_into_sea_water_from_icebergs"   unit="kg/m2/s"  />
+
+         <!-- available if key_oasis3 + conservative method -->
+         <field id="rain"          long_name="Liquid precipitation"                                     standard_name="rainfall_flux"                                                                 unit="kg/m2/s"  />
+         <field id="evap_ao_cea"   long_name="Evaporation over ice-free ocean (cell average)"           standard_name="water_evaporation_flux"                                                        unit="kg/m2/s"  />
+         <field id="isnwmlt_cea"   long_name="Snow over Ice melting (cell average)"                     standard_name="surface_snow_melt_flux"                                                        unit="kg/m2/s"  />
+         <field id="fsal_virt_cea" long_name="Virtual salt flux due to ice formation (cell average)"    standard_name="virtual_salt_flux_into_sea_water_due_to_sea_ice_thermodynamics"                unit="kg/m2/s"  />
+         <field id="fsal_real_cea" long_name="Real salt flux due to ice formation (cell average)"       standard_name="downward_sea_ice_basal_salt_flux"                                              unit="kg/m2/s"  />
+         <field id="hflx_rain_cea" long_name="heat flux due to rainfall"                                standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"        unit="W/m2"     />
+         <field id="hflx_evap_cea" long_name="heat flux due to evaporation"                             standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water"   unit="W/m2"     />
+         <field id="hflx_snow_cea" long_name="heat flux due to snow falling over ice-free ocean"        standard_name="heat_flux_into_sea_water_due_to_snow_thermodynamics"                           unit="W/m2"     />
+         <field id="hflx_ice_cea"  long_name="heat flux due to ice thermodynamics"                      standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                        unit="W/m2"     />
+         <field id="hflx_rnf_cea"  long_name="heat flux due to runoffs"                                 standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"          unit="W/m2"     />
+         <field id="hflx_cal_cea"  long_name="heat flux due to calving"                                 standard_name="heat_flux_into_sea_water_due_to_iceberg_thermodynamics"                        unit="W/m2"     />
+         <field id="bicemel_cea"   long_name="Rate of Melt at Sea Ice Base (cell average)"              standard_name="tendency_of_sea_ice_amount_due_to_basal_melting"                               unit="kg/m2/s"  />
+         <field id="licepro_cea"   long_name="Lateral Sea Ice Growth Rate (cell average)"               standard_name="tendency_of_sea_ice_amount_due_to_lateral_growth_of_ice_floes"                 unit="kg/m2/s"  />
+         <field id="snowmel_cea"   long_name="Snow Melt Rate (cell average)"                            standard_name="surface_snow_melt_flux"                                                        unit="kg/m2/s"  />
+         <field id="sntoice_cea"   long_name="Snow-Ice Formation Rate (cell average)"                   standard_name="tendency_of_sea_ice_amount_due_to_snow_conversion"                             unit="kg/m2/s"  />
+         <field id="ticemel_cea"   long_name="Rate of Melt at Upper Surface of Sea Ice (cell average)"  standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"                             unit="kg/m2/s"  />
+
+         <!-- ice fields -->
+         <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            />
+
+         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
+         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
+         <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             standard_name="surface_downward_latent_heat_flux"                  unit="W/m2"         />
+         
+         <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
+         <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         />
+         
+         <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                standard_name="surface_snow_thickness"                             unit="m"            />
+         <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 standard_name="sea_ice_thickness"                                  unit="m"            />
+         <field id="iceprod_cea"  long_name="Ice production (cell average)"                                                                                                   unit="m/s"          />
+         <field id="iiceconc"     long_name="Ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="1"            />
+         
+         <field id="ice_pres"     long_name="Ice presence"                                                                                                                    unit=""             />
+         <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       standard_name="surface_temperature"                                unit="degC"         />
+         <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               standard_name="surface_temperature"                                unit="degC"         />      
+         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  standard_name="sea_ice_x_velocity"                                 unit="m/s"          />      
+         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  standard_name="sea_ice_y_velocity"                                 unit="m/s"          />      
+         
+         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             standard_name="surface_downward_x_stress"                          unit="N/m2"         />
+         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             standard_name="surface_downward_y_stress"                          unit="N/m2"         />
+         
+         <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          standard_name="sea_ice_x_transport"                                unit="kg/s"         />
+         <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          standard_name="sea_ice_y_transport"                                unit="kg/s"         />
+         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                                                                                              unit="kg*degC/m2/s" />
+         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*1e-3/m2/s" />        
+         <field id="rnf_x_sst"    long_name="Runoff term on SST"                                                                                                              unit="kg*degC/m2/s" />
+         <field id="rnf_x_sss"    long_name="Runoff term on SSS"                                                                                                              unit="kg*1e-3/m2/s" />
+       
+         <field id="iceconc"      long_name="ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="%"            />
+       	 <field id="isst"         long_name="sea surface temperature"                                      standard_name="sea_surface_temperature"                            unit="degC"         />
+         <field id="isss"         long_name="sea surface salinity"                                         standard_name="sea_surface_salinity"                               unit="1e-3"         /> 
+         <field id="qt_oce"       long_name="total flux at ocean surface"                                  standard_name="surface_downward_heat_flux_in_sea_water"            unit="W/m2"         />
+         <field id="qsr_oce"      long_name="solar heat flux at ocean surface"                             standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         />
+         <field id="qns_oce"      long_name="non-solar heat flux at ocean surface"                                                                                            unit="W/m2"         />
+         <field id="qt_ice"       long_name="total heat flux at ice surface: sum over categories"          standard_name="surface_downward_heat_flux_in_air"                  unit="W/m2"         />
+         <field id="qsr_ice"      long_name="solar heat flux at ice surface: sum over categories"          standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         />
+         <field id="qns_ice"      long_name="non-solar heat flux at ice surface: sum over categories"                                                                         unit="W/m2"         />
+         <field id="qtr_ice"      long_name="solar heat flux transmitted through ice: sum over categories"                                                                    unit="W/m2"         />
+         <field id="qemp_ice"     long_name="Downward Heat Flux from E-P over ice"                                                                                            unit="W/m2"         />
+         <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         />
+         <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        />
+         <field id="alb_ice"      long_name="Mean albedo over sea ice"                                                                                                        unit=""             />
+         <field id="albedo"       long_name="Mean albedo over sea ice and ocean"                                                                                              unit=""             />
+
+         <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   axis_ref="ncatice" />
+         <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      axis_ref="ncatice" />
+         <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      axis_ref="ncatice" />
+         <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      axis_ref="ncatice" />
+         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="g/kg"   axis_ref="ncatice" />
+         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      axis_ref="ncatice" />
+         <field id="icetemp_cat"  long_name="Ice temperature for categories"                               unit="degC"   axis_ref="ncatice" />
+         <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degC"   axis_ref="ncatice" />
+
+         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     />
+         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"    /> 
+         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    />
+         <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     />
+         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        />
+         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        />
+         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      />
+         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      />
+         <field id="idive"        long_name="divergence"                                                   unit="1e-8s-1"  />
+         <field id="ishear"       long_name="shear"                                                        unit="1e-8s-1"  />
+         <field id="icevolu"      long_name="ice volume"                                                   unit="m"        />
+         <field id="snowvol"      long_name="snow volume"                                                  unit="m"        />
+
+         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"          />
+         <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"          />
+         <field id="saltrp"       long_name="salt content transport"                                       unit="1e-3*kg/m2/day" />
+         <field id="deitrp"       long_name="advected ice enthalpy"                                        unit="W/m2"           />
+         <field id="destrp"       long_name="advected snw enthalpy"                                        unit="W/m2"           />
+
+         <field id="sfxbri"       long_name="brine salt flux"                                              unit="1e-3*kg/m2/day" />
+         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/day" />
+         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/day" />
+         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/day" />
+         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/day" />
+         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/day" />
+         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" />
+         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" />
+         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/day" />
+         <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" />
+
+         <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   />
+         <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   />
+         <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   />
+         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   />
+         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   />
+         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   />
+         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   />
+         <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   />
+         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   />
+         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   />
+         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   />
+         <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(<20cm) + open water"      unit="m/day"   />
+
+         <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   />
+         <field id="afxdyn"       long_name="area tendency (dynamics)"                                     unit="day-1"   />
+         <field id="afxthd"       long_name="area tendency (thermo)"                                       unit="day-1"   />
+
+         <field id="hfxsum"       long_name="heat fluxes causing surface ice melt"                         unit="W/m2"  />
+         <field id="hfxbom"       long_name="heat fluxes causing bottom ice melt"                          unit="W/m2"  />
+         <field id="hfxbog"       long_name="heat fluxes causing bottom ice growth"                        unit="W/m2"  />
+         <field id="hfxdif"       long_name="heat fluxes causing ice temperature change"                   unit="W/m2"  />
+         <field id="hfxopw"       long_name="heat fluxes causing open water ice formation"                 unit="W/m2"  />
+         <field id="hfxsnw"       long_name="heat fluxes causing snow melt"                                unit="W/m2"  />
+         <field id="hfxerr"       long_name="heat fluxes error after heat diffusion"                       unit="W/m2"  />
+         <field id="hfxerr_rem"   long_name="heat fluxes error after remapping"                            unit="W/m2"  />
+         <field id="hfxout"       long_name="total heat fluxes received by the ocean"                      unit="W/m2"  />
+         <field id="hfxin"        long_name="total heat fluxes at the ice/ocean surface"                   unit="W/m2"  />
+
+         <!-- heat flux associated with mass exchange -->
+         <field id="hfxthd"       long_name="heat fluxes from ice-ocean mass exchange during thermo"       unit="W/m2"  />
+         <field id="hfxdyn"       long_name="heat fluxes from ice-ocean mass exchange during dynamic"      unit="W/m2"  />
+         <field id="hfxres"       long_name="heat fluxes from ice-ocean mass exchange during resultant"    unit="W/m2"  />
+         <field id="hfxsub"       long_name="heat fluxes from ice-atm. mass exchange during sublimation"   unit="W/m2"  />
+         <field id="hfxspr"       long_name="heat fluxes from ice-atm. mass exchange during snow precip"   unit="W/m2"  />
+
+         <!-- diags -->
+         <field id="hfxdhc"       long_name="Heat content variation in snow and ice"                       unit="W/m2" />
+         <field id="hfxtur"       long_name="turbulent heat flux at the ice base"                          unit="W/m2" />
+	 <!-- sbcssm variables -->
+         <field id="sst_m"    unit="degC" />
+         <field id="sss_m"    unit="psu"  />
+         <field id="ssu_m"    unit="m/s"  />
+         <field id="ssv_m"    unit="m/s"  />
+         <field id="ssh_m"    unit="m"    />
+         <field id="e3t_m"    unit="m"    />
+         <field id="frq_m"    unit="-"    />
+
+      </field_group>
+
+      <!-- U grid -->
+      
+      <field_group id="grid_U"   grid_ref="grid_U_2D">
+         <field id="e3u"          long_name="U-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_U_3D" />
+         <field id="e3u_0"        long_name="Initial U-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_U_3D"/>
+         <field id="utau"         long_name="Wind Stress along i-axis"                               standard_name="surface_downward_x_stress"   unit="N/m2"                            />
+         <field id="uoce"         long_name="ocean current along i-axis"                             standard_name="sea_water_x_velocity"        unit="m/s"        grid_ref="grid_U_3D" />
+         <field id="uoce_e3u"     long_name="ocean current along i-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_U_3D"  > uoce * e3u </field>
+         <field id="ssu"          long_name="ocean surface current along i-axis"                                                                 unit="m/s"                             />
+         <field id="sbu"          long_name="ocean bottom current along i-axis"                                                                  unit="m/s"                             />
+         <field id="ubar"         long_name="ocean barotropic current along i-axis"                                                              unit="m/s"                             />
+         <field id="uocetr_eff"   long_name="Effective ocean transport along i-axis"                 standard_name="ocean_volume_x_transport"    unit="m3/s"       grid_ref="grid_U_3D" />
+         <field id="uocet"        long_name="ocean transport along i-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_U_3D" />
+         <field id="uoces"        long_name="ocean transport along i-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_U_3D" />
+
+	      <!-- u-eddy coefficients (ldftra) -->
+	      <field id="ahtu_2d"      long_name=" surface u-eddy diffusivity coefficient"   unit="m2/s or m4/s" />
+	      <field id="ahtu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s or m4/s"      grid_ref="grid_U_3D"/>
+	      <field id="aeiu_2d"      long_name=" surface u-EIV coefficient"                unit="m2/s" />
+	      <field id="aeiu_3d"      long_name=" 3D u-EIV coefficient"                     unit="m2/s"              grid_ref="grid_U_3D"/>
+
+         <!-- variables available with MLE -->
+         <field id="psiu_mle"     long_name="MLE streamfunction along i-axis"   unit="m3/s"   grid_ref="grid_U_3D" />
+
+         <!-- uoce_eiv: available EIV -->
+         <field id="uoce_eiv"     long_name="EIV ocean current along i-axis"   standard_name="bolus_sea_water_x_velocity"   unit="m/s"   grid_ref="grid_U_3D" />
+
+         <!-- uoce_eiv: available with key_trabbl -->
+         <field id="uoce_bbl"     long_name="BBL ocean current along i-axis"    unit="m/s"  />
+         <field id="ahu_bbl"      long_name="BBL diffusive flux along i-axis"   unit="m3/s" />
+
+         <!-- variable for ice shelves -->
+         <field id="utbl"         long_name="zonal current in the Losh tbl"     unit="m/s" />
+
+         <!-- variables available with key_diaar5 -->
+         <field id="u_masstr"     long_name="ocean eulerian mass transport along i-axis"    standard_name="ocean_mass_x_transport"                          unit="kg/s"        grid_ref="grid_U_3D" />
+         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"    standard_name="ocean_heat_x_transport"                          unit="W"                                />
+         <field id="u_salttr"     long_name="ocean eulerian salt transport along i-axis"    standard_name="ocean_salt_x_transport"                          unit="1e-3*kg/s"                        />
+         <field id="ueiv_heattr"  long_name="ocean bolus heat transport along i-axis"       standard_name="ocean_heat_x_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis"   standard_name="ocean_heat_x_transport_due_to_diffusion"         unit="W"                                />
+      </field_group>
+      
+      <!-- V grid -->
+      
+      <field_group id="grid_V"   grid_ref="grid_V_2D">
+         <field id="e3v"          long_name="V-cell thickness"                                       standard_name="cell_thickness"              unit="m"          grid_ref="grid_V_3D" />
+         <field id="e3v_0"        long_name="Initial V-cell thickness"                               standard_name="ref_cell_thickness"          unit="m"          grid_ref="grid_V_3D"/>
+         <field id="vtau"         long_name="Wind Stress along j-axis"                               standard_name="surface_downward_y_stress"   unit="N/m2"                            />
+         <field id="voce"         long_name="ocean current along j-axis"                             standard_name="sea_water_y_velocity"        unit="m/s"        grid_ref="grid_V_3D" />
+         <field id="voce_e3v"     long_name="ocean current along j-axis  (thickness weighted)"                                                   unit="m/s"        grid_ref="grid_V_3D"  > voce * e3v </field>
+         <field id="ssv"          long_name="ocean surface current along j-axis"                                                                 unit="m/s"                             />
+         <field id="sbv"          long_name="ocean bottom current along j-axis"                                                                  unit="m/s"                             />
+         <field id="vbar"         long_name="ocean barotropic current along j-axis"                                                              unit="m/s"                             />
+         <field id="vocetr_eff"   long_name="Effective ocean transport along j-axis"                 standard_name="ocean_volume_y_transport"    unit="m3/s"       grid_ref="grid_V_3D" />
+         <field id="vocet"        long_name="ocean transport along j-axis times temperature (CRS)"                                               unit="degC*m/s"   grid_ref="grid_V_3D" />
+         <field id="voces"        long_name="ocean transport along j-axis times salinity (CRS)"                                                  unit="1e-3*m/s"   grid_ref="grid_V_3D" />
+
+	      <!-- v-eddy coefficients (ldftra, ldfdyn) -->
+	      <field id="ahtv_2d"      long_name=" surface v-eddy diffusivity coefficient"     unit="m2/s or (m4/s)^1/2" />
+	      <field id="ahtv_3d"      long_name=" 3D v-eddy diffusivity coefficient"          unit="m2/s or (m4/s)^1/2"           grid_ref="grid_V_3D"/>
+	      <field id="aeiv_2d"      long_name=" surface v-EIV coefficient"                  unit="m2/s" />
+	      <field id="aeiv_3d"      long_name=" 3D v-EIV coefficient"                       unit="m2/s"                         grid_ref="grid_V_3D" />
+
+         <!-- variables available with MLE -->
+         <field id="psiv_mle"     long_name="MLE streamfunction along j-axis"   unit="m3/s"   grid_ref="grid_V_3D" />
+
+         <!-- voce_eiv: available with EIV -->
+         <field id="voce_eiv"     long_name="EIV ocean current along j-axis"   standard_name="bolus_sea_water_y_velocity"   unit="m/s"   grid_ref="grid_V_3D" />
+
+         <!-- voce_eiv: available with key_trabbl -->
+         <field id="voce_bbl"     long_name="BBL ocean current along j-axis"    unit="m/s"  />
+         <field id="ahv_bbl"      long_name="BBL diffusive flux along j-axis"   unit="m3/s" />
+
+         <!-- variable for ice shelves -->
+         <field id="vtbl"         long_name="meridional current in the Losh tbl"   unit="m/s" />
+
+         <!-- variables available with key_diaar5 -->
+         <field id="v_masstr"     long_name="ocean eulerian mass transport along j-axis"    standard_name="ocean_mass_y_transport"                          unit="kg/s"        grid_ref="grid_V_3D" />
+         <field id="v_heattr"     long_name="ocean eulerian heat transport along j-axis"    standard_name="ocean_heat_y_transport"                          unit="W"                                />
+         <field id="v_salttr"     long_name="ocean eulerian salt transport along i-axis"    standard_name="ocean_salt_y_transport"                          unit="1e-3*kg/s"                        />
+         <field id="veiv_heattr"  long_name="ocean bolus heat transport along j-axis"       standard_name="ocean_heat_y_transport_due_to_bolus_advection"   unit="W"                                />
+         <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis"   standard_name="ocean_heat_y_transport_due_to_diffusion"         unit="W"                                />
+      </field_group>
+      
+      <!-- W grid -->
+      
+      <field_group id="grid_W" grid_ref="grid_W_3D">
+        <field id="e3w"          long_name="W-cell thickness"                     standard_name="cell_thickness"              unit="m"    />
+        <field id="woce"         long_name="ocean vertical velocity"              standard_name="upward_sea_water_velocity"   unit="m/s"  />
+        <field id="wocetr_eff"   long_name="effective ocean vertical transport"                                               unit="m3/s" />
+
+        <!-- woce_eiv: available with EIV -->
+        <field id="woce_eiv"     long_name="EIV ocean vertical velocity"   standard_name="bolus_upward_sea_water_velocity"   unit="m/s" />
+
+
+        <field id="avt"          long_name="vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+        <field id="logavt"       long_name="logarithm of vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+        <field id="avm"          long_name="vertical eddy viscosity"     standard_name="ocean_vertical_momentum_diffusivity"   unit="m2/s" />
+
+        <!-- avs: available with key_zdfddm -->
+        <field id="avs"          long_name="salt vertical eddy diffusivity"   standard_name="ocean_vertical_salt_diffusivity"   unit="m2/s" />
+        <field id="logavs"       long_name="logarithm of salt vertical eddy diffusivity"   standard_name="ocean_vertical_heat_diffusivity"       unit="m2/s" />
+
+        <!-- avt_evd and avm_evd: available with ln_zdfevd -->
+        <field id="avt_evd"      long_name="convective enhancement of vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_convection"     unit="m2/s" />
+        <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"     standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" />
+
+        <!-- avt_tide: available with key_zdftmx -->
+        <field id="av_tide"      long_name="tidal vertical diffusivity"   standard_name="ocean_vertical_tracer_diffusivity_due_to_tides"   unit="m2/s" />
+
+        <!-- variables available with key_diaar5 -->   
+        <field id="w_masstr"     long_name="vertical mass transport"             standard_name="upward_ocean_mass_transport"             unit="kg/s"   />
+        <field id="w_masstr2"    long_name="square of vertical mass transport"   standard_name="square_of_upward_ocean_mass_transport"   unit="kg2/s2" />
+
+        <!-- aht2d and  aht2d_eiv -->
+        <field id="aht2d"        long_name="lateral eddy diffusivity"       standard_name="ocean_tracer_xy_laplacian_diffusivity"      unit="m2/s"   grid_ref="grid_W_2D" />
+        <field id="aht2d_eiv"    long_name="EIV lateral eddy diffusivity"   standard_name="ocean_tracer_bolus_laplacian_diffusivity"   unit="m2/s"   grid_ref="grid_W_2D" />
+      </field_group>
+        
+      <!-- F grid -->
+	      <!-- f-eddy viscosity coefficients (ldfdyn) -->
+	      <field id="ahmf_2d"      long_name=" surface f-eddy viscosity coefficient"   unit="m2/s or m4/s" />
+	      <field id="ahmf_3d"      long_name=" 3D      f-eddy viscosity coefficient"   unit="m2/s or m4/s"                           grid_ref="grid_T_3D"/>
+
+      <!-- scalar variables available with key_diaar5 -->
+
+      <field_group id="scalar"  domain_ref="1point" >
+         <field id="voltot"     long_name="global total volume"                          standard_name="sea_water_volume"                               unit="m3"   />
+         <field id="sshtot"     long_name="global mean ssh"                              standard_name="global_average_sea_level_change"                unit="m"    />
+         <field id="sshsteric"  long_name="global mean ssh steric"                       standard_name="global_average_steric_sea_level_change"         unit="m"    />
+         <field id="sshthster"  long_name="global mean ssh thermosteric"                 standard_name="global_average_thermosteric_sea_level_change"   unit="m"    />
+         <field id="masstot"    long_name="global total mass"                            standard_name="sea_water_mass"                                 unit="kg"   />
+         <field id="temptot"    long_name="global mean temperature"                      standard_name="sea_water_potential_temperature"                unit="degC" />
+         <field id="saltot"     long_name="global mean salinity"                         standard_name="sea_water_salinity"                             unit="1e-3" />
+         <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait"   standard_name="sea_ice_transport_across_line"                  unit="kg/s" />
+
+      	 <!-- available with ln_diahsb -->
+    	 <field id="bgtemper"     long_name="drift in global mean temperature wrt timestep 1"                 standard_name="change_over_time_in_sea_water_potential_temperature"   unit="degC"     />
+    	 <field id="bgsaline"     long_name="drift in global mean salinity wrt timestep 1"                    standard_name="change_over_time_in_sea_water_practical_salinity"      unit="1e-3"     />
+    	 <field id="bgheatco"     long_name="drift in global mean heat content wrt timestep 1"                                                                                      unit="10^9J"    />
+    	 <field id="bgsaltco"     long_name="drift in global mean salt content wrt timestep 1"                                                                                      unit="1e-3*m3"  />
+    	 <field id="bgvolssh"     long_name="drift in global mean ssh volume wrt timestep 1"                                                                                        unit="km3"      />
+         <field id="bgvole3t"     long_name="drift in global mean volume variation (e3t) wrt timestep 1"                                                                            unit="km3"      />
+    	 <field id="bgvoltot"     long_name="drift in global mean volume wrt timestep 1"                                                                                            unit="km3"      />
+         <!-- NOTE: No matching iom_put call -->
+    	 <field id="bgsshtot"     long_name="drift in global mean ssh wrt timestep 1"                         standard_name="global_average_sea_level_change"                       unit="m"        />
+    	 <field id="bgfrcvol"     long_name="drift in global mean volume from forcing wrt timestep 1"                                                                               unit="km3"      />
+    	 <field id="bgfrctem"     long_name="drift in global mean heat content from forcing wrt timestep 1"                                                                         unit="10^9J"    />
+    	 <field id="bgfrcsal"     long_name="drift in global mean salt content from forcing wrt timestep 1"                                                                         unit="1e-3*km3" />
+    	 <field id="bgmistem"     long_name="global mean temperature error due to free surface"                                                                                     unit="degC"     />
+    	 <field id="bgmissal"     long_name="global mean salinity error due to free surface"                                                                                        unit="1e-3"     />
+      </field_group>
+
+      <!-- LIM3 scalar variables -->
+
+      <field_group id="SBC_scalar"  domain_ref="1point" >
+         <!-- available with ln_limdiaout -->
+         <field id="ibgvoltot"    long_name="global mean ice volume"                                 unit="km3"        />
+         <field id="sbgvoltot"    long_name="global mean snow volume"                                unit="km3"        />
+         <field id="ibgarea"      long_name="global mean ice area"                                   unit="km2"        />
+         <field id="ibgsaline"    long_name="global mean ice salinity"                               unit="1e-3"       />
+         <field id="ibgtemper"    long_name="global mean ice temperature"                            unit="degC"       />
+         <field id="ibgheatco"    long_name="global mean ice heat content"                           unit="10^20J"     />
+         <field id="sbgheatco"    long_name="global mean snow heat content"                          unit="10^20J"     />
+         <field id="ibgsaltco"    long_name="global mean ice salt content"                           unit="1e-3*km3"   />
+
+         <field id="ibgvfx"       long_name="global mean volume flux (emp)"                          unit="m/day"      />
+         <field id="ibgvfxbog"    long_name="global mean volume flux (bottom growth)"                unit="m/day"      />
+         <field id="ibgvfxopw"    long_name="global mean volume flux (open water growth)"            unit="m/day"      />
+         <field id="ibgvfxsni"    long_name="global mean volume flux (snow-ice growth)"              unit="m/day"      />
+         <field id="ibgvfxdyn"    long_name="global mean volume flux (dynamic growth)"               unit="m/day"      />
+         <field id="ibgvfxbom"    long_name="global mean volume flux (bottom melt)"                  unit="m/day"      />
+         <field id="ibgvfxsum"    long_name="global mean volume flux (surface melt)"                 unit="m/day"      />
+         <field id="ibgvfxres"    long_name="global mean volume flux (resultant)"                    unit="m/day"      />
+         <field id="ibgvfxspr"    long_name="global mean volume flux (snow precip)"                  unit="m/day"      />
+         <field id="ibgvfxsnw"    long_name="global mean volume flux (snow melt)"                    unit="m/day"      />
+         <field id="ibgvfxsub"    long_name="global mean volume flux (snow sublimation)"             unit="m/day"      />
+
+         <field id="ibgsfx"       long_name="global mean salt flux (total)"                          unit="1e-3*m/day" />
+         <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"                        unit="1e-3*m/day" />
+         <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"                      unit="1e-3*m/day" />
+         <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+         <field id="ibgsfxsub"    long_name="global mean salt flux (thermo)"                         unit="1e-3*m/day" />
+
+         <field id="ibghfxdhc"    long_name="Heat content variation in snow and ice"                 unit="W"          />
+         <field id="ibghfxspr"    long_name="Heat content of snow precip"                            unit="W"          />
+
+         <field id="ibghfxthd"    long_name="heat fluxes from ice-ocean exchange during thermo"      unit="W"          />
+         <field id="ibghfxsum"    long_name="heat fluxes causing surface ice melt"                   unit="W"          />
+         <field id="ibghfxbom"    long_name="heat fluxes causing bottom ice melt"                    unit="W"          />
+         <field id="ibghfxbog"    long_name="heat fluxes causing bottom ice growth"                  unit="W"          />
+         <field id="ibghfxdif"    long_name="heat fluxes causing ice temperature change"             unit="W"          />
+         <field id="ibghfxopw"    long_name="heat fluxes causing open water ice formation"           unit="W"          />
+         <field id="ibghfxdyn"    long_name="heat fluxes from ice-ocean exchange during dynamic"     unit="W"          />
+         <field id="ibghfxres"    long_name="heat fluxes from ice-ocean exchange during resultant"   unit="W"          />
+         <field id="ibghfxsub"    long_name="heat fluxes from sublimation"                           unit="W"          />
+         <field id="ibghfxsnw"    long_name="heat fluxes from snow-ocean exchange"                   unit="W"          />
+         <field id="ibghfxout"    long_name="non solar heat fluxes received by the ocean"            unit="W"          />
+         <field id="ibghfxin"     long_name="total heat fluxes at the ice surface"                   unit="W"          />
+
+         <field id="ibgfrcvol"    long_name="global mean forcing volume (emp)"                       unit="km3"        />
+         <field id="ibgfrcsfx"    long_name="global mean forcing salt   (sfx)"                       unit="1e-3*km3"   />
+         <field id="ibgvolgrm"    long_name="global mean ice growth+melt volume"                     unit="km3"        />
+      </field_group>
+  
+      <!-- variables available with key_float -->
+
+      <field_group id="floatvar" domain_ref="1point" axis_ref="nfloat" operation="instant" >
+        <field id="traj_lon"      long_name="floats longitude"                                                           unit="degrees_east"  />
+        <field id="traj_lat"      long_name="floats latitude"                                                            unit="degrees_north" />
+        <field id="traj_dep"      long_name="floats depth"                                                               unit="m"             />
+        <field id="traj_temp"     long_name="floats temperature"       standard_name="sea_water_potential_temperature"   unit="degC"          />
+        <field id="traj_salt"     long_name="floats salinity"          standard_name="sea_water_practical_salinity"      unit="1e-3"          />
+        <field id="traj_dens"     long_name="floats in-situ density"   standard_name="sea_water_density"                 unit="kg/m3"         />
+        <field id="traj_group"    long_name="floats group"                                                               unit="1"             />
+      </field_group>
+
+      <!-- variables available with iceberg trajectories -->
+
+      <field_group id="icbvar" domain_ref="grid_T"  > 
+        <field id="berg_melt"          long_name="icb melt rate of icebergs"                       unit="kg/m2/s"                    />
+        <field id="berg_buoy_melt"     long_name="icb buoyancy component of iceberg melt rate"     unit="kg/m2/s"                    />
+        <field id="berg_eros_melt"     long_name="icb erosion component of iceberg melt rate"      unit="kg/m2/s"                    />
+        <field id="berg_conv_melt"     long_name="icb convective component of iceberg melt rate"   unit="kg/m2/s"                    />
+        <field id="berg_virtual_area"  long_name="icb virtual coverage by icebergs"                unit="m2"                         />
+        <field id="bits_src"           long_name="icb mass source of bergy bits"                   unit="kg/m2/s"                    />
+        <field id="bits_melt"          long_name="icb melt rate of bergy bits"                     unit="kg/m2/s"                    />
+        <field id="bits_mass"          long_name="icb bergy bit density field"                     unit="kg/m2"                      />
+        <field id="berg_mass"          long_name="icb iceberg density field"                       unit="kg/m2"                      />
+        <field id="calving"            long_name="icb calving mass input"                          unit="kg/s"                       />
+        <field id="berg_floating_melt" long_name="icb melt rate of icebergs + bits"                unit="kg/m2/s"                    />
+        <field id="berg_real_calving"  long_name="icb calving into iceberg class"                  unit="kg/s"     axis_ref="icbcla" />
+        <field id="berg_stored_ice"    long_name="icb accumulated ice mass by class"               unit="kg"       axis_ref="icbcla" />
+      </field_group>
+
+      <!-- Poleward transport : ptr -->     
+      <field_group id="diaptr" domain_ref="ptr" > 
+        <field id="zomsfglo"          long_name="Meridional Stream-Function: Global"           unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfatl"          long_name="Meridional Stream-Function: Atlantic"         unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfpac"          long_name="Meridional Stream-Function: Pacific"          unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfind"          long_name="Meridional Stream-Function: Indian"           unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zomsfipc"          long_name="Meridional Stream-Function: Pacific+Indian"   unit="Sv"       grid_ref="gznl_W_3D" />
+        <field id="zotemglo"          long_name="Zonal Mean Temperature : Global"              unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotematl"          long_name="Zonal Mean Temperature : Atlantic"            unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotempac"          long_name="Zonal Mean Temperature : Pacific"             unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotemind"          long_name="Zonal Mean Temperature : Indian"              unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zotemipc"          long_name="Zonal Mean Temperature : Pacific+Indian"      unit="degC"     grid_ref="gznl_T_3D" />
+        <field id="zosalglo"          long_name="Zonal Mean Salinity : Global"                 unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalatl"          long_name="Zonal Mean Salinity : Atlantic"               unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalpac"          long_name="Zonal Mean Salinity : Pacific"                unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalind"          long_name="Zonal Mean Salinity : Indian"                 unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosalipc"          long_name="Zonal Mean Salinity : Pacific+Indian"         unit="1e-3"     grid_ref="gznl_T_3D" />
+        <field id="zosrfglo"          long_name="Zonal Mean Surface"                           unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfatl"          long_name="Zonal Mean Surface : Atlantic"                unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfpac"          long_name="Zonal Mean Surface : Pacific"                 unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfind"          long_name="Zonal Mean Surface : Indian"                  unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="zosrfipc"          long_name="Zonal Mean Surface : Pacific+Indian"          unit="m2"       grid_ref="gznl_T_3D" />
+        <field id="sophtadv"          long_name="Advective Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sophtldf"          long_name="Diffusive Heat Transport"                     unit="PW"       grid_ref="gznl_T_2D" />
+        <field id="sopstadv"          long_name="Advective Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+        <field id="sopstldf"          long_name="Diffusive Salt Transport"                     unit="Giga g/s" grid_ref="gznl_T_2D" />
+      </field_group>
+
+    <!-- 
+============================================================================================================
+                  Physical ocean model trend diagnostics : temperature, KE, PE, momentum
+============================================================================================================
+    -->
+
+    <field_group id="trendT" grid_ref="grid_T_3D">
+      <!-- variables available with ln_tra_trd -->
+      <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                                                                                          unit="degC/s"                        />
+      <field id="strd_xad"      long_name="salinity   -trend: i-advection"                                                                                          unit="1e-3/s"                        />
+      <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                                                                                          unit="degC/s"                        />
+      <field id="strd_yad"      long_name="salinity   -trend: j-advection"                                                                                          unit="1e-3/s"                        />
+      <field id="ttrd_zad"      long_name="temperature-trend: k-advection"                                                                                          unit="degC/s"                        />
+      <field id="strd_zad"      long_name="salinity   -trend: k-advection"                                                                                          unit="1e-3/s"                        />
+      <field id="ttrd_ad"       long_name="temperature-trend: advection"               standard_name="tendency_of_sea_water_temperature_due_to_advection"           unit="degC/s"                         > sqrt( ttrd_xad^2 + ttrd_yad^2 + ttrd_zad^2 ) </field>
+      <field id="strd_ad"       long_name="salinity   -trend: advection"               standard_name="tendency_of_sea_water_salinity_due_to_advection"              unit="1e-3/s"                         > sqrt( strd_xad^2 + strd_yad^2 + strd_zad^2 ) </field>
+      <field id="ttrd_sad"      long_name="temperature-trend: surface adv. (no-vvl)"                                                                                unit="degC/s"   grid_ref="grid_T_2D" />
+      <field id="strd_sad"      long_name="salinity   -trend: surface adv. (no-vvl)"                                                                                unit="1e-3/s"   grid_ref="grid_T_2D" />
+      <field id="ttrd_ldf"      long_name="temperature-trend: lateral  diffusion"      standard_name="tendency_of_sea_water_temperature_due_to_horizontal_mixing"   unit="degC/s"                        />
+      <field id="strd_ldf"      long_name="salinity   -trend: lateral  diffusion"      standard_name="tendency_of_sea_water_salinity_due_to_horizontal_mixing"      unit="1e-3/s"                        />
+      <field id="ttrd_zdf"      long_name="temperature-trend: vertical diffusion"      standard_name="tendency_of_sea_water_temperature_due_to_vertical_mixing"     unit="degC/s"                        />
+      <field id="strd_zdf"      long_name="salinity   -trend: vertical diffusion"      standard_name="tendency_of_sea_water_salinity_due_to_vertical_mixing"        unit="1e-3/s"                        />
+
+      <!-- ln_traldf_iso=T only (iso-neutral diffusion) -->
+      <field id="ttrd_zdfp"     long_name="temperature-trend: pure vert. diffusion"   unit="degC/s" />
+      <field id="strd_zdfp"     long_name="salinity   -trend: pure vert. diffusion"   unit="1e-3/s" />
+
+      <!-- -->
+      <field id="ttrd_dmp"      long_name="temperature-trend: interior restoring"        unit="degC/s" />
+      <field id="strd_dmp"      long_name="salinity   -trend: interior restoring"        unit="1e-3/s" />
+      <field id="ttrd_bbl"      long_name="temperature-trend: bottom boundary layer"     unit="degC/s" />
+      <field id="strd_bbl"      long_name="salinity   -trend: bottom boundary layer"     unit="1e-3/s" />
+      <field id="ttrd_npc"      long_name="temperature-trend: non-penetrative conv."     unit="degC/s" />
+      <field id="strd_npc"      long_name="salinity   -trend: non-penetrative conv."     unit="1e-3/s" />
+      <field id="ttrd_qns"      long_name="temperature-trend: non-solar flux + runoff"   unit="degC/s" />
+      <field id="strd_cdt"      long_name="salinity   -trend: C/D term       + runoff"   unit="degC/s" />
+      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"     unit="degC/s" />
+      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"        unit="degC/s" />
+      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"       unit="degC/s" />
+      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"       unit="1e-3/s" />
+
+      <!-- variables available with ln_KE_trd -->
+      <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"          unit="W/s^3"                        />
+      <field id="ketrd_spg"     long_name="ke-trend: surface     pressure gradient"          unit="W/s^3"                        />
+      <field id="ketrd_spgexp"  long_name="ke-trend: surface pressure gradient (explicit)"   unit="W/s^3"                        />
+      <field id="ketrd_spgflt"  long_name="ke-trend: surface pressure gradient (filter)"     unit="W/s^3"                        />
+      <field id="ssh_flt"       long_name="filtered contribution to ssh (dynspg_flt)"        unit="m"       grid_ref="grid_T_2D" />
+      <field id="w0"            long_name="surface vertical velocity"                        unit="m/s"     grid_ref="grid_T_2D" />
+      <field id="pw0_exp"       long_name="surface pressure flux due to ssh"                 unit="W/s^2"   grid_ref="grid_T_2D" />
+      <field id="pw0_flt"       long_name="surface pressure flux due to filtered ssh"        unit="W/s^2"   grid_ref="grid_T_2D" />
+      <field id="ketrd_keg"     long_name="ke-trend: KE gradient         or hor. adv."       unit="W/s^3"                        />
+      <field id="ketrd_rvo"     long_name="ke-trend: relative  vorticity or metric term"     unit="W/s^3"                        />
+      <field id="ketrd_pvo"     long_name="ke-trend: planetary vorticity"                    unit="W/s^3"                        />
+      <field id="ketrd_zad"     long_name="ke-trend: vertical  advection"                    unit="W/s^3"                        />
+      <field id="ketrd_udx"     long_name="ke-trend: U.dx[U]"                                unit="W/s^3"                        />
+      <field id="ketrd_ldf"     long_name="ke-trend: lateral   diffusion"                    unit="W/s^3"                        />
+      <field id="ketrd_zdf"     long_name="ke-trend: vertical  diffusion"                    unit="W/s^3"                        />
+      <field id="ketrd_tau"     long_name="ke-trend: wind stress "                           unit="W/s^3"   grid_ref="grid_T_2D" />
+      <field id="ketrd_bfr"     long_name="ke-trend: bottom friction (explicit)"             unit="W/s^3"                        />   
+      <field id="ketrd_bfri"    long_name="ke-trend: bottom friction (implicit)"             unit="W/s^3"                        />   
+      <field id="ketrd_atf"     long_name="ke-trend: asselin time filter trend"              unit="W/s^3"                        />  
+      <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)"      unit="W/s^3"                        />
+      <field id="KE"            long_name="kinetic energy: u(n)*u(n+1)/2"                    unit="W/s^2"                        />   
+
+      <!-- variables available with ln_PE_trd -->
+      <field id="petrd_xad"     long_name="pe-trend: i-advection"                unit="W/m^3"                        />
+      <field id="petrd_yad"     long_name="pe-trend: j-advection"                unit="W/m^3"                        />
+      <field id="petrd_zad"     long_name="pe-trend: k-advection"                unit="W/m^3"                        />
+      <field id="petrd_sad"     long_name="pe-trend: surface adv. (no-vvl)"      unit="W/m^3"   grid_ref="grid_T_2D" />
+      <field id="petrd_ldf"     long_name="pe-trend: lateral  diffusion"         unit="W/m^3"                        />
+      <field id="petrd_zdf"     long_name="pe-trend: vertical diffusion"         unit="W/m^3"                        />
+      <field id="petrd_zdfp"    long_name="pe-trend: pure vert. diffusion"       unit="W/m^3"                        />
+      <field id="petrd_dmp"     long_name="pe-trend: interior restoring"         unit="W/m^3"                        />
+      <field id="petrd_bbl"     long_name="pe-trend: bottom boundary layer"      unit="W/m^3"                        />
+      <field id="petrd_npc"     long_name="pe-trend: non-penetrative conv."      unit="W/m^3"                        />
+      <field id="petrd_nsr"     long_name="pe-trend: surface forcing + runoff"   unit="W/m^3"                        />
+      <field id="petrd_qsr"     long_name="pe-trend: solar penetr. heating"      unit="W/m^3"                        />
+      <field id="petrd_bbc"     long_name="pe-trend: geothermal heating"         unit="W/m^3"                        />
+      <field id="petrd_atf"     long_name="pe-trend: asselin time filter"        unit="W/m^3"                        />
+      <field id="PEanom"        long_name="potential energy anomaly"             unit="1"                            />   
+      <field id="alphaPE"       long_name="partial deriv. of PEanom wrt T"       unit="degC-1"                       />   
+      <field id="betaPE"        long_name="partial deriv. of PEanom wrt S"       unit="1e3"                          />   
+    </field_group>
+
+    <field_group id="trendU" grid_ref="grid_U_3D">
+     <!-- variables available with ln_dyn_trd -->
+     <field id="utrd_hpg"       long_name="i-trend: hydrostatic pressure gradient"          unit="m/s^2"                        />
+     <field id="utrd_spg"       long_name="i-trend: surface     pressure gradient"          unit="m/s^2"                        />
+     <field id="utrd_spgexp"    long_name="i-trend: surface pressure gradient (explicit)"   unit="m/s^2"                        />
+     <field id="utrd_spgflt"    long_name="i-trend: surface pressure gradient (filtered)"   unit="m/s^2"                        />
+     <field id="utrd_keg"       long_name="i-trend: KE gradient         or hor. adv."       unit="m/s^2"                        />
+     <field id="utrd_rvo"       long_name="i-trend: relative  vorticity or metric term"     unit="m/s^2"                        />
+     <field id="utrd_pvo"       long_name="i-trend: planetary vorticity"                    unit="m/s^2"                        />
+     <field id="utrd_zad"       long_name="i-trend: vertical  advection"                    unit="m/s^2"                        />
+     <field id="utrd_udx"       long_name="i-trend: U.dx[U]"                                unit="m/s^2"                        />
+     <field id="utrd_ldf"       long_name="i-trend: lateral   diffusion"                    unit="m/s^2"                        />
+     <field id="utrd_zdf"       long_name="i-trend: vertical  diffusion"                    unit="m/s^2"                        />
+     <field id="utrd_tau"       long_name="i-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_U_2D" />
+     <field id="utrd_bfr"       long_name="i-trend: bottom friction (explicit)"             unit="m/s^2"                        />   
+     <field id="utrd_bfri"      long_name="i-trend: bottom friction (implicit)"             unit="m/s^2"                        />   
+     <field id="utrd_tot"       long_name="i-trend: total momentum trend before atf"        unit="m/s^2"                        />   
+     <field id="utrd_atf"       long_name="i-trend: asselin time filter trend"              unit="m/s^2"                        />   
+    </field_group>
+
+    <field_group id="trendV" grid_ref="grid_V_3D">
+     <!-- variables available with ln_dyn_trd -->
+     <field id="vtrd_hpg"       long_name="j-trend: hydrostatic pressure gradient"          unit="m/s^2"                        />
+     <field id="vtrd_spg"       long_name="j-trend: surface     pressure gradient"          unit="m/s^2"                        />
+     <field id="vtrd_spgexp"    long_name="j-trend: surface pressure gradient (explicit)"   unit="m/s^2"                        />
+     <field id="vtrd_spgflt"    long_name="j-trend: surface pressure gradient (filtered)"   unit="m/s^2"                        />
+     <field id="vtrd_keg"       long_name="j-trend: KE gradient         or hor. adv."       unit="m/s^2"                        />
+     <field id="vtrd_rvo"       long_name="j-trend: relative  vorticity or metric term"     unit="m/s^2"                        />
+     <field id="vtrd_pvo"       long_name="j-trend: planetary vorticity"                    unit="m/s^2"                        />
+     <field id="vtrd_zad"       long_name="j-trend: vertical  advection"                    unit="m/s^2"                        />
+     <field id="vtrd_vdy"       long_name="i-trend: V.dx[V]"                                unit="m/s^2"                        />
+     <field id="vtrd_ldf"       long_name="j-trend: lateral   diffusion"                    unit="m/s^2"                        />
+     <field id="vtrd_zdf"       long_name="j-trend: vertical  diffusion"                    unit="m/s^2"                        />
+     <field id="vtrd_tau"       long_name="j-trend: wind stress "                           unit="m/s^2"   grid_ref="grid_V_2D" />
+     <field id="vtrd_bfr"       long_name="j-trend: bottom friction (explicit)"             unit="m/s^2"                        />   
+     <field id="vtrd_bfri"      long_name="j-trend: bottom friction (implicit)"             unit="m/s^2"                        />   
+     <field id="vtrd_tot"       long_name="j-trend: total momentum trend before atf"        unit="m/s^2"                        />   
+     <field id="vtrd_atf"       long_name="j-trend: asselin time filter trend"              unit="m/s^2"                        />   
+    </field_group>
+
+    <!-- 
+============================================================================================================
+                                     Biogeochemistry model variables
+============================================================================================================
+    -->
+
+      <!-- ptrc on T grid -->
+
+     <field_group id="ptrc_T" grid_ref="grid_T_3D">
+       <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="DIC_E3T"      long_name="DIC * E3T"                                unit="mmol/m2" > DIC * e3t </field >
+       <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" />
+       <field id="Alkalini_E3T" long_name="Alkalini * E3T"                           unit="mmol/m2"  > Alkalini * e3t </field >
+       <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="O2_E3T"       long_name="O2 * E3T"                                 unit="mmol/m2"  > O2 * e3t </field >
+       <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="CaCO3_E3T"    long_name="CaCO3 * E3T"                              unit="mmol/m2"  > CaCO3 * e3t </field >
+       <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="PO4_E3T"      long_name="PO4 * E3T"                                unit="mmol/m2"  > PO4 * e3t </field >
+       <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="POC_E3T"      long_name="POC * E3T"                                unit="mmol/m2"  > POC * e3t </field >
+       <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="Si_E3T"       long_name="Si * E3T"                                 unit="mmol/m2"  > Si * e3t </field >
+       <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" />
+       <field id="PHY_E3T"      long_name="PHY * E3T"                                unit="mmol/m2"  > PHY * e3t </field >
+       <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" />
+       <field id="ZOO_E3T"      long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO * e3t </field >
+       <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="DOC_E3T"      long_name="DOC * E3T"                                unit="mmol/m2"  > DOC * e3t </field >
+       <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="PHY2_E3T"     long_name="PHY2 * E3T"                               unit="mmol/m2"  > PHY2 * e3t </field >
+       <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="ZOO2_E3T"     long_name="ZOO2 * E3T"                               unit="mmol/m2"  > ZOO2 * e3t </field >
+       <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="DSi_E3T"      long_name="Dsi * E3T"                                unit="mmol/m2"  > DSi * e3t </field >
+       <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="Fer_E3T"      long_name="Fer * E3T"                                unit="mmol/m2"  > Fer * e3t </field >
+       <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="BFe_E3T"      long_name="BFe * E3T"                                unit="mmol/m2"  > BFe * e3t </field >
+       <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="GOC_E3T"      long_name="GOC * E3T"                                unit="mmol/m2"  > GOC * e3t </field >
+       <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="SFe_E3T"      long_name="SFe * E3T"                                unit="mmol/m2"  > SFe * e3t </field >
+       <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="DFe_E3T"      long_name="DFe * E3T"                                unit="mmol/m2"  > DFe * e3t </field >
+       <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="GSi_E3T"      long_name="GSi * E3T"                                unit="mmol/m2"  > GSi * e3t </field >
+       <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NFe_E3T"      long_name="NFe * E3T"                                unit="mmol/m2"  > NFe * e3t </field >
+       <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="mg/m3"   />
+       <field id="NCHL_E3T"     long_name="NCHL * E3T"                               unit="mmol/m2"  > NCHL * e3t </field >
+       <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="mg/m3"   />
+       <field id="DCHL_E3T"     long_name="DCHL * E3T"                               unit="mmol/m2"  > DCHL * e3t </field >
+       <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" />
+       <field id="NO3_E3T"      long_name="NO3 * E3T"                                unit="mmol/m2"  > NO3 * e3t </field >
+       <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" />
+       <field id="NH4_E3T"      long_name="NH4 * E3T"                                unit="mmol/m2"  > NH4 * e3t </field >
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="Num"         long_name="Number of organic particles"              unit="1" />
+       <field id="Num_E3T"     long_name="Num * E3T"                                unit="m"  > Num * e3t </field >
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" />
+       <field id="DET_E3T"     long_name="DET * E3T"                                unit="mmol-N/m2"  > DET * e3t </field >
+       <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" />
+       <field id="DOM_E3T"     long_name="DOM * E3T"                                unit="mmol-N/m2"  > DOM * e3t </field >
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="CFC11"       long_name="CFC-11 Concentration"                     unit="umol/m3" />
+       <field id="CFC11_E3T"   long_name="CFC11 * E3T"                              unit="umol/m2"  > CFC11 * e3t </field >
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="C14B"     long_name="Bomb C14 Concentration"                      unit="1"         />
+       <field id="C14B_E3T"    long_name="C14B * E3T"                               unit="m"  > C14B * e3t </field >
+     </field_group>
+
+     <!-- PISCES additional diagnostics on T grid  -->
+
+     <field_group id="diad_T" grid_ref="grid_T_2D">
+       <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" />
+       <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" />
+       <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" />
+       <field id="PPPHY"       long_name="Primary production of nanophyto"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPPHY2"      long_name="Primary production of diatoms"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeN"        long_name="Primary production of nano iron"         unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" />
+       <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" />
+       <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" />
+       <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" />
+       <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" />
+       <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" />
+       <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" />
+       <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" />
+       <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" />
+       <field id="Fe2"         long_name="Iron II concentration"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeL2"        long_name="Complexed Iron concentration with L2"    unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="FeP"         long_name="Precipitated Iron III"                   unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="TL2"         long_name="Total L2 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            />
+       <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/m3"    grid_ref="grid_T_3D" />
+       <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="mol/m2/s"                        />
+       <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="mol/m2/s"                        />
+       <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        />
+       <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        />
+       <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        />
+       <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        />
+       <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        />
+       <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        />
+       <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   />
+       <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            />
+       <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            />
+       <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               />
+       <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        />
+       <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" />
+
+
+       <!-- PISCES with Kriest parametisation : variables available with key_kriest -->
+       <field id="EPN100"      long_name="Particulate number flux at 100 m"        unit="mol/m2/s"                        />
+       <field id="EXPN"        long_name="Particulate number flux"                 unit="mol/m2/s"   grid_ref="grid_T_3D" />
+       <field id="XNUM"        long_name="Number of particles in aggregats"        unit="1"          grid_ref="grid_T_3D" />
+       <field id="WSC"         long_name="sinking speed of mass flux"              unit="m2/s"       grid_ref="grid_T_3D" />
+       <field id="WSN"         long_name="sinking speed of number flux"            unit="m2/s"       grid_ref="grid_T_3D" />
+
+       <!-- dbio_T on T grid : variables available with key_diaar5 -->
+       <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" />
+       <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          />
+       <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          />
+       <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              />
+       <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"                       />
+       <field id="INTPPPHY"    long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"                       />
+       <field id="INTPPPHY2"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"                       />
+       <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"                       />
+       <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"                       />
+       <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"                       />
+       <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"                       />
+       <field id="INTPCAL"     long_name="Vertically integrated of calcite production"         unit="mol/m2/s"                       />
+
+       <!-- PISCES light : variables available with key_pisces_reduced -->
+       <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" /> 
+       <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  /> 
+       <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  /> 
+       <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  /> 
+       <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  /> 
+       <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  /> 
+       <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  /> 
+       <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  /> 
+       <field id="TZOODET"     long_name="TZOODET"                                 unit=""  /> 
+       <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  /> 
+       <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  /> 
+       <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  /> 
+       <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  /> 
+       <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  /> 
+       <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  /> 
+       <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  /> 
+       <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  /> 
+       <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  /> 
+       <field id="TDETSED"     long_name="TDETSED"                                 unit=""  /> 
+
+       <!-- CFC11 : variables available with key_cfc -->
+       <field id="qtrCFC11"    long_name="Air-sea flux of CFC-11"                  unit="mol/m2/s"   />
+       <field id="qintCFC11"   long_name="Cumulative air-sea flux of CFC-11"       unit="mol/m2"     />
+
+       <!-- Bomb C14 : variables available with key_c14b -->
+       <field id="qtrC14b"     long_name="Air-sea flux of Bomb C14"                unit="mol/m2/s"   />
+       <field id="qintC14b"    long_name="Cumulative air-sea flux of Bomb C14"     unit="mol/m2"     />
+       <field id="fdecay"      long_name="Radiactive decay of Bomb C14"            unit="mol/m3"  grid_ref="grid_T_3D"  />
+     </field_group>
+
+     <field_group id="PISCES_scalar"  domain_ref="1point" >
+       <field id="pno3tot"         long_name="global mean nitrate concentration"                  unit="mol/m3"   />
+       <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   />
+       <field id="psiltot"         long_name="global mean silicate concentration"                 unit="mol/m3"   />
+       <field id="palktot"         long_name="global mean alkalinity concentration"               unit="mol/m3"   />
+       <field id="pfertot"         long_name="global mean iron concentration"                     unit="mol/m3"   />
+       <field id="tcflx"           long_name="total Flux of Carbon out of the ocean"              unit="mol/s"   />
+       <field id="tcflxcum"        long_name="cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   />
+       <field id="tcexp"           long_name="total Carbon export at 100m"                        unit="mol/s"   />
+       <field id="tintpp"          long_name="global total integrated primary production"         unit="mol/s"   />
+       <field id="tnfix"           long_name="global total nitrogen fixation"                     unit="mol/s"   />
+       <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   />
+     </field_group>
+
+    <!-- 
+============================================================================================================
+                                        Definitions for iodef_demo.xml
+============================================================================================================
+    -->
+
+    <field_group id="mooring" >
+      <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"      />
+      <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                   />
+      <field field_ref="uoce"         name="uo"       long_name="sea_water_x_velocity"                 />
+      <field field_ref="voce"         name="vo"       long_name="sea_water_y_velocity"                 />
+      <field field_ref="woce"         name="wo"       long_name="sea_water_z_velocity"                 />
+      <field field_ref="avt"          name="difvho"   long_name="ocean_vertical_heat_diffusivity"      />
+      <field field_ref="avm"          name="difvmo"   long_name="ocean_vertical_momentum_diffusivity"  />
+   
+      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
+      <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
+      <field field_ref="sstgrad"      name="tosgrad"  long_name="module_of_sea_surface_temperature_gradient"    />
+      <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
+      <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+      <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
+      <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           />
+      <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          />
+      <field field_ref="taum"                                                                                   />
+      <field field_ref="20d"                                                                                    />
+      <field field_ref="mldkz5"                                                                                 />
+      <field field_ref="mldr10_1"                                                                               />
+      <field field_ref="mldr10_3"                                                                               />
+      <field field_ref="mldr0_1"                                                                                />
+      <field field_ref="mldr0_3"                                                                                />
+      <field field_ref="mld_dt02"                                                                               />
+      <field field_ref="topthdep"                                                                               />
+      <field field_ref="pycndep"                                                                                />
+      <field field_ref="tinv"                                                                                   />
+      <field field_ref="depti"                                                                                  />
+      <field field_ref="BLT"          name="blt"      long_name="barrier_layer_thickness"                       />
+      <field field_ref="utau"         name="tauuo"    long_name="surface_downward_x_stress"                     />
+      <field field_ref="vtau"         name="tauvo"    long_name="surface_downward_y_stress"                     />
+    </field_group>
+
+    <field_group id="groupT" >
+      <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               />
+      <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            />
+      <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       />
+      <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             />
+      <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          />
+      <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                />
+      <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     />
+      <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           />
+      <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          />
+      <field field_ref="taum"                                                                                   />
+      <field field_ref="20d"                                                                                    />
+      <field field_ref="mldkz5"                                                                                 />
+      <field field_ref="mldr10_1"                                                                               />
+      <field field_ref="mldr10_3"                                                                               />
+      <field field_ref="mld_dt02"                                                                               />
+      <field field_ref="topthdep"                                                                               />
+      <field field_ref="pycndep"                                                                                />
+      <field field_ref="tinv"                                                                                   />
+      <field field_ref="depti"                                                                                  />
+      <field field_ref="BLT"          name="blt"      long_name="Barrier Layer Thickness"                       />
+    </field_group>
+    
+    <field_group id="groupU" >
+      <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      />
+      <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    />
+      <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" />
+    </field_group>
+    
+    <field_group id="groupV" >
+      <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      />
+      <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    />
+      <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" />
+    </field_group>
+    
+    <field_group id="groupW" >
+      <field field_ref="woce"         name="wo"       long_name="ocean vertical velocity"  />
+    </field_group>
+
+       <!-- TMB diagnostic output -->
+    <field_group  id="1h_grid_T_tmb" grid_ref="grid_T_2D" operation="instant">
+     <field id="top_temp"           name="votemper_top"  unit="degC"  />
+     <field id="mid_temp"           name="votemper_mid"  unit="degC"  />
+     <field id="bot_temp"           name="votemper_bot"  unit="degC"  />
+     <field id="top_sal"            name="vosaline_top"  unit="psu"   />
+     <field id="mid_sal"            name="vosaline_mid"  unit="psu"   />
+     <field id="bot_sal"            name="vosaline_bot"  unit="psu"   />
+     <field id="sshnmasked"         name="sossheig"      unit="m"     /> 
+   </field_group>
+    <field_group  id="1h_grid_U_tmb" grid_ref="grid_U_2D" operation="instant">
+     <field id="top_u"           name="vozocrtx_top"  unit="m/s"  />
+     <field id="mid_u"           name="vozocrtx_mid"  unit="m/s"  />
+     <field id="bot_u"           name="vozocrtx_bot"  unit="m/s"  />
+     <field id="baro_u"          name="vobtcrtx"      unit="m/s"  />
+   </field_group>
+    <field_group  id="1h_grid_V_tmb" grid_ref="grid_V_2D" operation="instant">
+     <field id="top_v"           name="vomecrty_top"  unit="m/s"  />
+     <field id="mid_v"           name="vomecrty_mid"  unit="m/s"  />
+     <field id="bot_v"           name="vomecrty_bot"  unit="m/s"  />
+     <field id="baro_v"          name="vobtcrty"      unit="m/s"  />
+   </field_group>
+       <!-- 25h diagnostic output -->
+      <field_group id="25h_grid_T" grid_ref="grid_T_3D" operation="instant">
+   <field id="temper25h"         name="potential temperature 25h mean"    unit="degC" />
+   <field id="tempis25h"         name="insitu temperature 25h mean"    unit="degC" />
+   <field id="salin25h"          name="salinity 25h mean"                 unit="psu"  />
+   <field id="ssh25h"            name="sea surface height 25h mean"  grid_ref="grid_T_2D"      unit="m"    />
+      </field_group>
+
+      <field_group id="25h_grid_U" grid_ref="grid_U_3D" operation="instant" >
+   <field id="vozocrtx25h"         name="i current 25h mean"    unit="m/s"   />
+      </field_group>
+
+      <field_group id="25h_grid_V" grid_ref="grid_V_3D" operation="instant">
+   <field id="vomecrty25h"         name="j current 25h mean"    unit="m/s"    />
+      </field_group>
+
+      <field_group id="25h_grid_W" grid_ref="grid_W_3D" operation="instant">
+   <field id="vomecrtz25h"         name="k current 25h mean"                 unit="m/s"      />
+   <field id="avt25h"             name="vertical diffusivity25h mean"       unit="m2/s" />
+   <field id="avm25h"              name="vertical viscosity 25h mean"        unit="m2/s" />
+   <field id="tke25h"              name="turbulent kinetic energy 25h mean" />
+   <field id="mxln25h"             name="mixing length 25h mean"             unit="m" />
+      </field_group>
+
+
+
+   </field_definition>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/iodef.xml	(revision 8732)
@@ -0,0 +1,84 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1950-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE." />  <!-- 5d files -->  
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+   
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
+    </grid_definition>   
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">50000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_cfg	(revision 8732)
@@ -0,0 +1,267 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "domaincfg"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =      75   !  last  time step (std 5475)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   !
+   ln_e3_dep   = .true.    ! =T : e3=dk[depth] in discret sens. 
+   !                       !      ===>>> will become the only possibility in v4.0
+   !                       ! =F : e3 analytical derivative of depth function
+   !                       !      only there for backward compatibility test with v3.6
+   !                       !      
+   cp_cfg      =  "orca"   !  name of the configuration
+   jp_cfg      =       2   !  resolution of the configuration
+   jpidta      =     182   !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149   !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31   !  number of levels      ( >= jpk )
+   jpiglo      =     182   !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149   !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1   !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1   !  in data domain indices
+   jperio      =       4   !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .true.    !  z-coordinate - partial steps
+   ln_linssh   = .true.    !  linear free surface
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10    = .true.         !  = Use TEOS-10 equation of state
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_fct =  .true.    !  FCT scheme
+      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping
+      !                             !        (number of sub-timestep = nn_fct_zts)
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap   =  .true.   !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .true.   !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!----------------------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.
+!----------------------------------------------------------------------------------
+   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant
+   !                                !   = 10 F(k)      =ldf_c1d
+   !                                !   = 20 F(i,j)    =ldf_c2d
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme
+      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   Surface pressure gradient
+!-----------------------------------------------------------------------
+   ln_dynspg_ts = .true.   !  Split-explicit free surface
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .true.     !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .true.     !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref	(revision 8732)
@@ -0,0 +1,1285 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!!                            namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namcfg, namzgr, namzgr_sco, namdom, namtsd, namcrs, namc1d, namc1d_uvd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf,
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave)
+!!              4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namhsb, namsto)
+!!             10 - miscellaneous    (nammpp, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun       parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    5475   !  last  time step (std 5475)
+   nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_time0    =       0   !  initial time of day in hhmm
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      nn_euler    =    1            !  = 0 : start with forward time step if ln_rstart=T
+      nn_rstctl   =    0            !  restart control ==> activated only if ln_rstart=T
+      !                             !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
+      !                             !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
+      !                             !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
+      cn_ocerst_in    = "restart"   !  suffix of ocean restart name (input)
+      cn_ocerst_indir = "."         !  directory from which to read input ocean restarts
+      cn_ocerst_out   = "restart"   !  suffix of ocean restart name (output)
+      cn_ocerst_outdir= "."         !  directory in which to write output ocean restarts
+   ln_iscpl    = .false.   !  cavity evolution forcing or coupling to ice sheet model
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
+   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
+   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+!
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namcfg       parameters of the configuration
+!!   namzgr       vertical coordinate                                   (default: NO selection)
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namwad       Wetting and drying                                    (default F)
+!!   namtsd       data: temperature & salinity
+!!   namcrs       coarsened grid (for outputs and/or TOP)               ("key_crs")
+!!   namc1d       1D configuration options                              ("key_c1d")
+!!   namc1d_dyndmp 1D newtonian damping applied on currents             ("key_c1d")
+!!   namc1d_uvd   1D data (currents)                                    ("key_c1d")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   !
+   ln_e3_dep   = .true.    ! =T : e3=dk[depth] in discret sens. 
+   !                       !      ===>>> will become the only possibility in v4.0
+   !                       ! =F : e3 analytical derivative of depth function
+   !                       !      only there for backward compatibility test with v3.6
+   !
+   cp_cfg      = "default" !  name of the configuration
+   cp_cfz      = "no zoom" !  name of the zoom of configuration
+   jp_cfg      =      0    !  resolution of the configuration
+   jpidta      =     10    !  1st lateral dimension ( >= jpi )
+   jpjdta      =     12    !  2nd    "         "    ( >= jpj )
+   jpkdta      =     31    !  number of levels      ( >= jpk )
+   jpiglo      =     10    !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     12    !  2nd    -                  -    --> j =jpjdta
+   jpizoom     =      1    !  left bottom (i,j) indices of the zoom
+   jpjzoom     =      1    !  in data domain indices
+   jperio      =      0    !  lateral cond. type (between 0 and 6)
+                                 !  = 0 closed                 ;   = 1 cyclic East-West
+                                 !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+                                 !  = 4 cyclic East-West AND North fold T-point pivot
+                                 !  = 5 North fold F-point pivot
+                                 !  = 6 cyclic East-West AND North fold F-point pivot
+   ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present
+                           !  in netcdf input files, as the start j-row for reading
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate                                  (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps
+   ln_zps      = .false.   !  z-coordinate - partial steps
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate
+   ln_isfcav   = .false.   !  ice shelf cavity
+   ln_linssh   = .false.   !  linear free surface
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate                (default F)
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_hc       =  150.0    !  critical depth for transition to stretched coordinates
+                        !!!!!!!  Envelop bathymetry
+   rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1)
+                        !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma
+                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
+   rn_alpha    =    4.4    !  stretching with SF12 s-sigma
+   rn_efold    =    0.0    !  efold length scale for transition to stretched coord
+   rn_zs       =    1.0    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb
+   rn_zb_b     =   -0.2    !  offset for calculating Zb
+                        !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1)
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
+   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    1      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   ln_crs      = .false.      !  Logical switch for coarsening module
+   jphgr_msh   =       0               !  type of horizontal mesh
+                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+                                       !  = 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
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =     -35.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =       1.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =       0.5             !  meridional grid-spacing (degrees)
+   ppe1_m      =    5000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    5000.0             !  meridional grid-spacing (degrees)
+   ppsur       =    -4762.96143546300  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =      255.58049070440  ! (default coefficients)
+   ppa1        =      245.58132232490  !
+   ppkth       =       21.43336197938  !
+   ppacr       =        3.0            !
+   ppdzmin     =       10.             !  Minimum vertical spacing
+   pphmax      =     5000.             !  Maximum depth
+   ldbletanh   =    .TRUE.             !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =      100.760928500000 !  Double tanh function parameters
+   ppkth2      =       48.029893720000 !
+   ppacr2      =       13.000000000000 !
+/
+!-----------------------------------------------------------------------
+&namwad        !   Wetting and drying                                   (default F)
+!-----------------------------------------------------------------------
+   ln_wd       = .false.   !  T/F activation of wetting and drying
+   rn_wdmin1   =  0.1      !  Minimum wet depth on dried cells
+   rn_wdmin2   =  0.01     !  Tolerance of min wet depth on dried cells
+   rn_wdld     =  20.0     !  Land elevation below which wetting/drying is allowed
+   nn_wdit     =  10       !  Max iterations for W/D limiter
+/
+!-----------------------------------------------------------------------
+&namtsd        !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+!              !  file name                 ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                            !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_tem = 'data_1m_potential_temperature_nomask',     -1      ,'votemper',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_sal = 'data_1m_salinity_nomask'             ,     -1      ,'vosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_tsd_init = .true.    !  Initialisation of ocean T & S with T & S input data (T) or not (F)
+   ln_tsd_tradmp = .true.  !  damping of ocean T & S toward T & S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namcrs        !   coarsened grid (for outputs and/or TOP)              ("key_crs")
+!-----------------------------------------------------------------------
+   nn_factx    = 3         !  Reduction factor of x-direction
+   nn_facty    = 3         !  Reduction factor of y-direction
+   nn_binref   = 0         !  Bin centering preference: NORTH or EQUAT
+                           !  0, coarse grid is binned with preferential treatment of the north fold
+                           !  1, coarse grid is binned with centering at the equator
+                           !    Symmetry with nn_facty being odd-numbered. Asymmetry with even-numbered nn_facty.
+   nn_msh_crs  = 1         !  create (=1) a mesh file or not (=0)
+   nn_crs_kz   = 0         ! 0, MEAN of volume boxes
+                           ! 1, MAX of boxes
+                           ! 2, MIN of boxes
+   ln_crs_wn   = .true.    ! wn coarsened (T) or computed using horizontal divergence ( F )
+/
+!-----------------------------------------------------------------------
+&namc1d        !   1D configuration options                             ("key_c1d")
+!-----------------------------------------------------------------------
+   rn_lat1d    =      50   !  Column latitude (default at PAPA station)
+   rn_lon1d    =    -145   !  Column longitude (default at PAPA station)
+   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F)
+/
+!-----------------------------------------------------------------------
+&namc1d_dyndmp !   U & V newtonian damping                              ("key_c1d")
+!-----------------------------------------------------------------------
+   ln_dyndmp   =  .false.  !  add a damping term (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namc1d_uvd    !   data: U & V currents                                 ("key_c1d")
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_ucur     = 'ucurrent'  ,         -1        ,'u_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Ume'   , ''
+   sn_vcur     = 'vcurrent'  ,         -1        ,'v_current',   .false.    , .true. , 'monthly' ,  ''      ,  'Vme'   , ''
+!
+   cn_dir        = './'    !  root directory for the location of the files
+   ln_uvd_init   = .false. !  Initialisation of ocean U & V with U & V input data (T) or not (F)
+   ln_uvd_dyndmp = .false. !  damping of ocean U & V toward U & V input data (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation                     (ln_ana     =T)
+!!   namsbc_flx      flux               formulation                     (ln_flx     =T)
+!!   namsbc_clio     CLIO bulk formulae formulation                     (ln_blk_clio=T)
+!!   namsbc_core     CORE bulk formulae formulation                     (ln_blk_core=T)
+!!   namsbc_mfs      MFS  bulk formulae formulation                     (ln_blk_mfs =T)
+!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3" )
+!!   namsbc_sas      StAndalone Surface module
+!!   namtra_qsr      penetrative solar radiation                        (ln_traqsr  =T)
+!!   namsbc_rnf      river runoffs                                      (ln_rnf     =T)
+!!   namsbc_isf      ice shelf melting/freezing                         (nn_isf     >0)
+!!   namsbc_iscpl    coupling option between land ice model and ocean
+!!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T)
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)        (ln_ssr     =T)
+!!   namsbc_alb      albedo parameters
+!!   namsbc_wave     external fields from wave model                    (ln_wave    =T)
+!!   namberg         iceberg floats                                     (ln_icebergs=T)
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice & iceberg model call)
+                     ! Type of air-sea fluxes 
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio)
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+                     ! Type of coupling (Ocean/Ice/Atmosphere) :
+   ln_cpl      = .false.   !  atmosphere coupled   formulation          ( requires key_oasis3 )
+   ln_mixcpl   = .false.   !  forced-coupled mixed formulation          ( requires key_oasis3 )
+   nn_components = 0       !  configuration of the opa-sas OASIS coupling
+                           !  =0 no opa-sas OASIS coupling: default single executable configuration
+                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component
+                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component 
+   nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)
+                           !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled
+                           !  = 0  Average per-category fluxes (forced and coupled mode)
+                           !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled
+                           !  = 2  Redistribute a single flux over categories (coupled mode only)
+                     ! Sea-ice :
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice")
+   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect)
+                           !  =1 levitating ice with mass and salt exchange but no presure effect
+                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure)
+                     ! Misc. options of sbc : 
+   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr )
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 2         !  FreshWater Budget: =0 unchecked
+                           !     =1 global mean of e-p-r set to zero at each time step
+                           !     =2 annual global mean of e-p-r set to zero
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   ln_isf      = .false.   !  ice shelf                                 (T   => fill namsbc_isf)
+   ln_wave     = .false.   !  coupling with surface wave                (T => fill namsbc_wave)
+   nn_lsm      = 0         !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) ,
+                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field)
+/
+!-----------------------------------------------------------------------
+&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 ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   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 formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_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 formulae
+!-----------------------------------------------------------------------
+!              !  file name                   ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask !
+!              !                              !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      !
+   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'   , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+   sn_tdif     = 'taudif_core'                ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_zqt      = 10.       !  Air temperature and humidity reference height (m)
+   rn_zu       = 10.       !  Wind vector reference height (m)
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
+                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable ! time interp. !  clim  ! 'yearly'/ ! weights     ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name   !   (logical)  !  (T/F) ! 'monthly' ! filename    ! pairing  ! filename      !
+   sn_wndi     =   'ecmwf'   ,        6          , 'u10'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_wndj     =   'ecmwf'   ,        6          , 'v10'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_clc      =   'ecmwf'   ,        6          , 'clc'    ,    .true.    , .false., 'daily'   ,'bilinear.nc',   ''     ,   ''
+   sn_msl      =   'ecmwf'   ,        6          , 'msl'    ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_tair     =   'ecmwf'   ,        6          , 't2'     ,    .true.    , .false., 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+   sn_rhm      =   'ecmwf'   ,        6          , 'rh'     ,    .true.    , .false., 'daily'   ,'bilinear.nc',   ''     ,   ''
+   sn_prec     =   'ecmwf'   ,        6          , 'precip' ,    .true.    , .true. , 'daily'   ,'bicubic.nc' ,   ''     ,   ''
+
+   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+!                    !     description      !  multiple  !    vector   !      vector          ! vector !
+!                    !                      ! categories !  reference  !    orientation       ! grids  !
+! send
+   sn_snd_temp   =   'weighted oce and ice' ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_alb    =   'weighted ice'         ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_thick  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   ''
+   sn_snd_crt    =   'none'                 ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'
+   sn_snd_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   ''
+! receive
+   sn_rcv_w10m   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_taumod =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_tau    =   'oce only'             ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'
+   sn_rcv_dqnsdt =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_qsr    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_qns    =   'oce and ice'          ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_emp    =   'conservative'         ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_rnf    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''          ,   ''
+!
+   nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models
+   !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+/
+!-----------------------------------------------------------------------
+&namsbc_sas    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_usp      = 'sas_grid_U',     120           , 'vozocrtx',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_vsp      = 'sas_grid_V',     120           , 'vomecrty',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_tem      = 'sas_grid_T',     120           , 'sosstsst',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_sal      = 'sas_grid_T',     120           , 'sosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_ssh      = 'sas_grid_T',     120           , 'sossheig',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_e3t      = 'sas_grid_T',     120           , 'e3t_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+   sn_frq      = 'sas_grid_T',     120           , 'frq_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    ''
+
+   ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field
+   ln_read_frq = .false.   !  specify whether we must read frq or not
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr=T)
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   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_si1      =   23.0    !  2 bands: longest depth of extinction
+   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition          (ln_rnf=T)
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_rnf_mouth= .true.    !  specific treatment at rivers mouths
+      rn_hrnf     =  15.e0    !  depth over which enhanced vertical mixing is used    (ln_rnf_mouth=T)
+      rn_avt_rnf  =   1.e-3   !  value of the additional vertical mixing coef. [m2/s] (ln_rnf_mouth=T)
+   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
+   ln_rnf_depth_ini = .false. ! compute depth at initialisation from runoff file
+      rn_rnf_max  = 5.735e-4  !  max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )
+      rn_dep_max  = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+      nn_rnf_depth_file = 0   !  create (=1) a runoff depth file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_isf    !  Top boundary layer (ISF)                              (nn_isf >0)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+! nn_isf == 4
+   sn_fwfisf   = 'rnfisf'  ,         -12       ,'sowflisf',   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 3
+   sn_rnfisf   = 'rnfisf'  ,         -12       ,'sofwfisf',   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 2 and 3
+   sn_depmax_isf='rnfisf'  ,         -12       ,'sozisfmax',  .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+   sn_depmin_isf='rnfisf'  ,         -12       ,'sozisfmin',  .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+! nn_isf == 2
+   sn_Leff_isf = 'rnfisf'  ,         -12       ,'Leff'    ,   .false.   , .true. , 'yearly'  ,    ''    ,   ''     ,    ''
+!
+! for all case
+   nn_isf      = 1         !  ice shelf melting/freezing
+                           !  1 = presence of ISF    2 = bg03 parametrisation 
+                           !  3 = rnf file for isf   4 = ISF fwf specified
+                           !  option 1 and 4 need ln_isfcav = .true. (domzgr)
+! only for nn_isf = 1 or 2
+   rn_gammat0  = 1.e-4     ! gammat coefficient used in blk formula
+   rn_gammas0  = 1.e-4     ! gammas coefficient used in blk formula
+! only for nn_isf = 1 or 4
+   rn_hisf_tbl =  30.      ! thickness of the top boundary layer    (Losh et al. 2008)
+   !                       ! 0 => thickness of the tbl = thickness of the first wet cell
+! only for nn_isf = 1
+   nn_isfblk   = 1         ! 1 ISOMIP  like: 2 equations formulation (Hunter et al., 2006)
+   !                       ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
+   nn_gammablk = 1         ! 0 = cst Gammat (= gammat/s)
+   !                       ! 1 = velocity dependend Gamma (u* * gammat/s)  (Jenkins et al. 2010)
+   !                       ! 2 = velocity and stability dependent Gamma    (Holland et al. 1999)
+/
+!-----------------------------------------------------------------------
+&namsbc_iscpl  !   land ice / ocean coupling option                     
+!-----------------------------------------------------------------------
+   nn_drown    = 10        ! number of iteration of the extrapolation loop (fill the new wet cells)
+   ln_hsb      = .false.   ! activate conservation module (conservation exact after a time of rn_fiscpl)
+   nn_fiscpl   = 43800     ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,      ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   rn_pref     = 101000.   !  reference atmospheric pressure   [N/m2]/
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+   ln_apr_obc  = .false.   !  inverse barometer added to OBC ssh data
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr=T)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name   !   (logical) !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   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     =  -166.67  !  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
+!-----------------------------------------------------------------------
+   nn_ice_alb  =    0      !  parameterization of ice/snow albedo
+                           !     0: Shine & Henderson-Sellers (JGR 1985)
+                           !     1: "home made" based on Brandt et al. (J. Climate 2005)
+                           !                         and Grenfell & Perovich (JGR 2004)
+   rn_albice   =  0.53     !  albedo of bare puddled ice (values from 0.49 to 0.58)
+                           !     0.53 (default) => if nn_ice_alb=0
+                           !     0.50 (default) => if nn_ice_alb=1
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model                        (ln_wave=T)
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable    ! time interp.!  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !   name      !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_cdg      = 'cdg_wave',        1          , 'drag_coeff',   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+   sn_usd      = 'sdw_wave',        1          , 'u_sd2d'    ,   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+   sn_vsd      = 'sdw_wave',        1          , 'v_sd2d'    ,   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+   sn_wn       = 'sdw_wave',        1          , 'wave_num'  ,   .true.    , .false., 'daily'   ,    ''      , ''       , ''
+!
+   cn_dir_cdg  = './'      !  root directory for the location of drag coefficient files
+   ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model
+   ln_sdw      = .false.   !  Computation of 3D stokes drift               
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters                                   (default: No iceberg)
+!-----------------------------------------------------------------------
+      ln_icebergs              = .false.              ! iceberg floats or not
+      ln_bergdia               = .true.               ! Calculate budgets
+      nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0
+      nn_verbose_write         = 15                   ! Timesteps between verbose messages
+      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage
+                                                      ! Initial mass required for an iceberg of each class
+      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
+                                                      ! Proportion of calving mass to apportion to each class
+      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
+                                                      ! Ratio between effective and real iceberg mass (non-dim)
+                                                      ! i.e. number of icebergs represented at a point
+      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
+                                                      ! thickness of newly calved bergs (m)
+      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250.
+      rn_rho_bergs             = 850.                 ! Density of icebergs
+      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs
+      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics
+      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
+      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
+      ln_passive_mode          = .false.              ! iceberg - ocean decoupling
+      nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no)
+                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
+      rn_test_box              = 108.0,  116.0, -66.0, -58.0
+      rn_speed_limit           = 0.                   ! CFL speed limit for a berg
+
+!            ! file name ! frequency (hours) !   variable   ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!            !           !  (if <0  months)  !     name     !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+      sn_icb =  'calving',       -1          , 'calvingmask',   .true.    , .true.  , 'yearly'  ,    ''    ,    ''    ,     ''
+
+      cn_dir = './'
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif")
+!!   nam_tide      Tidal forcing 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   nambdy_dta    Unstructured open boundaries - external data         ("key_bdy")
+!!   nambdy_tide   tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
+!-----------------------------------------------------------------------
+&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 [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+   ln_chk_bathy  = .FALSE. !
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters                                      ("key_tide")
+!-----------------------------------------------------------------------
+   ln_tide_pot = .true.    !  use tidal potential forcing
+   ln_tide_ramp= .false.   !
+   rdttideramp =    0.     !
+   clname(1)   = 'DUMMY'   !  name of constituent - all tidal components must be set in namelist_cfg
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy         = 0                    !  number of open boundary sets
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file   = .false.              !  =T : read mask from file
+    cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.)
+    cn_dyn2d       = 'none'               !
+    nn_dyn2d_dta   =  0                   !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    cn_dyn3d      =  'none'               !
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_tra        =  'none'               !
+    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    cn_ice_lim      =  'none'             !
+    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice
+    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           --
+    rn_ice_age      = 30.                 !  lim3 only:      --   age                --
+
+    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers
+    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities
+    rn_time_dmp   =  1.                   ! Damping time scale in days
+    rn_time_dmp_out =  1.                 ! Outflow damping time scale
+    nn_rimwidth   = 10                    !  width of the relaxation zone
+    ln_vol        = .false.               !  total volume correction (see nn_volctl parameter)
+    nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta    !  open boundaries - external data                       ("key_bdy")
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh      = 'amm12_bdyT_u2d',         24        , 'sossheig',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_u2d      = 'amm12_bdyU_u2d',         24        , 'vobtcrtx',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_v2d      = 'amm12_bdyV_u2d',         24        , 'vobtcrty',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_u3d      = 'amm12_bdyU_u3d',         24        , 'vozocrtx',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_v3d      = 'amm12_bdyV_u3d',         24        , 'vomecrty',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+   bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+! for lim2
+!   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+! for lim3
+!   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_ht_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+!   bn_ht_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     ''
+
+   cn_dir      = 'bdydta/' !  root directory for the location of the bulk files
+   ln_full_vel = .false.   !  
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+   filtide          = 'bdydta/amm12_bdytide_'   !  file name root of tidal forcing files
+   ln_bdytide_2ddta = .false.                   !
+   ln_bdytide_conj  = .false.                   ! 
+/
+
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction                                      (default: linear)
+!-----------------------------------------------------------------------
+   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). Minimum coeft if ln_loglayer=T
+   rn_bfri2_max=    1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T
+   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)
+   rn_tfri1    =    4.e-4  !  top drag coefficient (linear case)
+   rn_tfri2    =    2.5e-3 !  top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+   rn_tfri2_max=    1.e-1  !  max. top drag coefficient (non linear case and ln_loglayer=T)
+   rn_tfeb2    =    0.0    !  top turbulent kinetic energy background  (m2/s2)
+   rn_tfrz0    =    3.e-3  !  top roughness [m] if ln_loglayer=T
+   ln_tfr2d    = .false.   !  horizontal variation of the top friction coef (read a 2D mask file )
+   rn_tfrien   =   50.     !  local multiplying factor of tfr (ln_tfr2d=T)
+
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+   ln_loglayer = .false.   !  logarithmic formulation (non linear case)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition                (default: NO)
+!-----------------------------------------------------------------------
+!              !  file name      ! frequency (hours) ! variable  ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                 !  (if <0  months)  !   name    !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_qgh      ='geothermal_heating.nc',  -12.       , 'heatflow',   .false.   , .true.  , 'yearly'  ,   ''     ,   ''     ,   ''
+   !
+   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]
+   cn_dir      = './'      !  root directory for the location of the runoff files 
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme                         ("key_trabbl")
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1        !  diffusive bbl (=1)   or not (=0)
+   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_adv_mle   mixed layer eddy param. (Fox-Kemper param.)
+!!   namtra_ldf       lateral diffusion scheme
+!!   namtra_ldfeiv    eddy induced velocity param.
+!!   namtra_dmp       T & S newtonian damping
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   ln_teos10   = .false.         !  = Use TEOS-10 equation of state
+   ln_eos80    = .false.         !  = Use EOS80 equation of state
+   ln_seos     = .false.         !  = Use simplified equation of state (S-EOS)
+                                 !
+   !                     ! S-EOS coefficients (ln_seos=T):
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer                          (default: NO advection)
+!-----------------------------------------------------------------------
+   ln_traadv_cen = .false. !  2nd order centered scheme
+      nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN
+      nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT
+   ln_traadv_fct = .false. !  FCT scheme
+      nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
+      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
+      nn_fct_zts =  0            !  >=1,  2nd order FCT scheme with vertical sub-timestepping
+      !                          !        (number of sub-timestep = nn_fct_zts)
+   ln_traadv_mus = .false. !  MUSCL scheme
+      ln_mus_ups = .false.       !  use upstream scheme near river mouths
+   ln_traadv_ubs = .false. !  UBS scheme
+      nn_ubs_v   =  2            !  =2  , vertical 2nd order FCT / COMPACT 4th order
+   ln_traadv_qck = .false. !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !   mixed layer eddy parametrisation (Fox-Kemper param) (default: NO)
+!-----------------------------------------------------------------------
+   ln_mle      = .false.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation
+   rn_ce       = 0.06      ! magnitude of the MLE (typical value: 0.06 to 0.08)
+   nn_mle      = 1         ! MLE type: =0 standard Fox-Kemper ; =1 new formulation
+   rn_lf       = 5.e+3     ! typical scale of mixed layer front (meters)                      (case rn_mle=0)
+   rn_time     = 172800.   ! time scale for mixing momentum across the mixed layer (seconds)  (case rn_mle=0)
+   rn_lat      = 20.       ! reference latitude (degrees) of MLE coef.                        (case rn_mle=1)
+   nn_mld_uv   = 0         ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)
+   nn_conv     = 0         ! =1 no MLE in case of convection ; =0 always MLE
+   rn_rho_c_mle= 0.01      ! delta rho criterion used to calculate MLD for FK
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO diffusion)
+!-----------------------------------------------------------------------
+   !                       !  Operator type:
+   !                           !  no diffusion: set ln_traldf_lap=..._blp=F 
+   ln_traldf_lap   =  .false.  !    laplacian operator
+   ln_traldf_blp   =  .false.  !  bilaplacian operator
+   !
+   !                       !  Direction of action:
+   ln_traldf_lev   =  .false.  !  iso-level
+   ln_traldf_hor   =  .false.  !  horizontal (geopotential)
+   ln_traldf_iso   =  .false.  !  iso-neutral (standard operator)
+   ln_traldf_triad =  .false.  !  iso-neutral (triad    operator)
+   !
+   !		       	         !  iso-neutral options:        
+   ln_traldf_msc   =  .false.  !  Method of Stabilizing Correction (both operators)
+   rn_slpmax       =   0.01    !  slope limit                      (both operators)
+   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only)
+   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only)
+   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only)
+   !
+   !                       !  Coefficients:
+   nn_aht_ijk_t    = 0         !  space/time variation of eddy coef
+   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d
+   !                                !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing)
+   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s]
+   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s]
+/
+!-----------------------------------------------------------------------
+&namtra_ldfeiv !   eddy induced velocity param.                         (default: NO)
+!-----------------------------------------------------------------------
+   ln_ldfeiv     =.false.  ! use eddy induced velocity parameterization
+   ln_ldfeiv_dia =.false.  ! diagnose eiv stream function and velocities
+   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s]
+   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient
+   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file
+   !                                !   =  0           constant 
+   !                                !   = 10 F(k)      =ldf_c1d 
+   !                                !   = 20 F(i,j)    =ldf_c2d 
+   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation
+   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO)
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   cn_resto    ='resto.nc' !  Name of file containing restoration coeff. field (use dmp_tools to create this)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection                (default: vector form)
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   ln_dynzad_zts = .false. !  Use (T) sub timestepping for vertical momentum advection
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options                             (default: zstar)
+!-----------------------------------------------------------------------
+   ln_vvl_zstar  = .true.           !  zstar vertical coordinate
+   ln_vvl_ztilde = .false.          !  ztilde vertical coordinate: only high frequency variations
+   ln_vvl_layer  = .false.          !  full layer vertical coordinate
+   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar
+   ln_vvl_zstar_at_eqtor  = .false. !  ztilde near the equator
+   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient
+   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days]
+   rn_lf_cutoff  = 5.0e0            !  cutoff frequency for low-pass filter  [days]
+   rn_zdef_max   = 0.9e0            !  maximum fractional e3t deformation
+   ln_vvl_dbg    = .true.           !  debug prints    (T/F)
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme
+   ln_dynvor_ens = .false. !  energy conserving scheme
+   ln_dynvor_mix = .false. !  mixed scheme
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+      nn_een_e3f = 1          ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)
+   ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes)  ! PLEASE DO NOT ACTIVATE
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option                 (default: zps)
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+/
+!-----------------------------------------------------------------------
+&namdyn_spg    !   surface pressure gradient                            (default: NO)
+!-----------------------------------------------------------------------
+   ln_dynspg_exp  = .false.   ! explicit free surface
+   ln_dynspg_ts   = .false.   ! split-explicit free surface
+      ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs.
+      ln_bt_av      = .true.     ! Time filtering of barotropic variables
+         nn_bt_flt     = 1          ! Time filter choice  = 0 None
+         !                          !                     = 1 Boxcar over   nn_baro sub-steps
+         !                          !                     = 2 Boxcar over 2*nn_baro  "    "
+      ln_bt_auto    = .true.     ! Number of sub-step defined from:
+         rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed
+         nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum                        (default: NO)
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F 
+   ln_dynldf_lap =  .false.    !    laplacian operator
+   ln_dynldf_blp =  .false.    !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_lev =  .false.    !  iso-level
+   ln_dynldf_hor =  .false.    !  horizontal (geopotential)
+   ln_dynldf_iso =  .false.    !  iso-neutral
+   !                       !  Coefficient
+   nn_ahm_ijk_t  = 0           !  space/time variation of eddy coef
+   !                                !  =-30  read in eddy_viscosity_3D.nc file
+   !                                !  =-20  read in eddy_viscosity_2D.nc file
+   !                                !  =  0  constant 
+   !                                !  = 10  F(k)=c1d
+   !                                !  = 20  F(i,j)=F(grid spacing)=c2d
+   !                                !  = 30  F(i,j,k)=c2d*c1d
+   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity)
+   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s]
+   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s]
+   !
+   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km)
+/
+
+!!======================================================================
+!!             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_gls    GLS vertical mixing                                 ("key_zdfgls")
+!!    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 Convective 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
+   rn_ekmfc    =    0.7    !  Factor in the Ekman depth Equation
+   rn_mldmin   =    1.0    !  minimum allowable mixed-layer depth estimate (m)
+   rn_mldmax   = 1000.0    !  maximum allowable mixed-layer depth estimate (m)
+   rn_wtmix    =   10.0    !  vertical eddy viscosity coeff [m2/s] in the mixed-layer
+   rn_wvmix    =   10.0    !  vertical eddy diffusion coeff [m2/s] in the mixed-layer
+   ln_mldw     =  .true.   !  Flag to use or not the mixed layer depth param.
+/
+!-----------------------------------------------------------------------
+&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]
+   rn_bshear   =   1.e-20  ! background shear (>0) currently a numerical threshold (do not change it)
+   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 near 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           (ln_cpl=T)
+   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_gls    !   GLS vertical diffusion                               ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-7   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.267   !  galperin limit
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   rn_hsro       =  0.02   !  Minimum surface roughness
+   rn_frac_hs    =   1.3   !  Fraction of wave height as roughness (if nn_z0_met=2)
+   nn_z0_met     =     2   !  Method for surface roughness computation (0/1/2)
+   nn_bc_surf    =     1   !  surface condition (0/1=Dir/Neum)
+   nn_bc_bot     =     1   !  bottom condition (0/1=Dir/Neum)
+   nn_stab_func  =     2   !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =     1   !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&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  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx_new !   internal wave-driven mixing parameterization        ("key_zdftmx_new" & "key_zdfddm")
+!-----------------------------------------------------------------------
+   nn_zpyc     = 1         !  pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
+   ln_mevar    = .true.    !  variable (T) or constant (F) mixing efficiency
+   ln_tsdiff   = .true.    !  account for differential T/S mixing (T) or not (F)
+/
+
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsto            Stochastic parametrization of EOS
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&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
+   ln_nnogather=  .false.  !  activate code to avoid mpi_allgather use at the northfold
+   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)
+   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)
+   jpnij       =   0       !  jpnij  number of local domains (set automatically if < 1)
+/
+!-----------------------------------------------------------------------
+&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_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+   nn_diacfl   =    0      !  Write out CFL diagnostics (=1) in cfl_diagnostics.ascii, or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsto        ! Stochastic parametrization of EOS                      (default: NO)
+!-----------------------------------------------------------------------
+   ln_sto_eos  = .false.   ! stochastic equation of state
+   nn_sto_eos  = 1         ! number of independent random walks
+   rn_eos_stdxy= 1.4       ! random walk horz. standard deviation (in grid points)
+   rn_eos_stdz = 0.7       ! random walk vert. standard deviation (in grid points)
+   rn_eos_tcor = 1440.     ! random walk time correlation (in timesteps)
+   nn_eos_ord  = 1         ! order of autoregressive processes
+   nn_eos_flt  = 0         ! passes of Laplacian filter
+   rn_eos_lim  = 2.0       ! limitation factor (default = 3.0)
+   ln_rststo   = .false.   ! start from mean parameter (F) or from restart file (T)
+   ln_rstseed  = .true.    ! read seed of RNG from restart file
+   cn_storst_in  = "restart_sto" !  suffix of stochastic parameter restart file (input)
+   cn_storst_out = "restart_sto" !  suffix of stochastic parameter restart file (output)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namtrd       dynamics and/or tracer trends                         (default F)
+!!   namptr       Poleward Transport Diagnostics                        (default F)
+!!   namhsb       Heat and salt budgets                                 (default F)
+!!   namdiu       Cool skin and warm layer models                       (default F)
+!!   namflo       float parameters                                      ("key_float")
+!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm")
+!!   namdct       transports through some sections                      ("key_diadct")
+!!   nam_diatmb   Top Middle Bottom Output                              (default F)
+!!   nam_dia25h   25h Mean Output                                       (default F)
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namtrd        !   trend diagnostics                                    (default F)
+!-----------------------------------------------------------------------
+   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
+   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
+   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
+   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet)
+   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
+   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
+   ln_tra_trd  = .false.   ! (T) 3D tracer trend output
+   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
+   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
+/
+!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+!!gm
+!-----------------------------------------------------------------------
+&namptr        !   Poleward Transport Diagnostic                         (default F)
+!-----------------------------------------------------------------------
+   ln_diaptr   = .false.   !  Poleward heat and salt transport (T) or not (F)
+   ln_subbas   = .false.   !  Atlantic/Pacific/Indian basins computation (T) or not
+/
+!-----------------------------------------------------------------------
+&namhsb        !  Heat and salt budgets                                  (default F)
+!-----------------------------------------------------------------------
+   ln_diahsb   = .false.   !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdiu        !   Cool skin and warm layer models                       (default F)
+!-----------------------------------------------------------------------
+   ln_diurnal      = .false.   ! 
+   ln_diurnal_only = .false.   !
+/
+!-----------------------------------------------------------------------
+&namflo        !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   jpnfl       = 1         !  total number of floats during the run
+   jpnnewflo   = 0         !  number of floats for the restart
+   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)
+   ln_ariane   = .true.    !  Input with Ariane tool convention(T)
+   ln_flo_ascii= .true.    !  Output with Ariane tool netcdf convention(F) or ascii file (T)
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents               ("key_diaharm")
+!-----------------------------------------------------------------------
+    nit000_han = 1         ! First time step used for harmonic analysis
+    nitend_han = 75        ! Last time step used for harmonic analysis
+    nstep_han  = 15        ! Time step frequency for harmonic analysis
+    tname(1)   = 'M2'      ! Name of tidal constituents
+    tname(2)   = 'K1'
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through some sections                        ("key_diadct")
+!-----------------------------------------------------------------------
+    nn_dct     = 15        !  time step frequency for transports computing
+    nn_dctwri  = 15        !  time step frequency for transports writing
+    nn_secdebug= 112       !      0 : no section to debug
+    !                      !     -1 : debug all section
+    !                      !  0 < n : debug section number n
+/
+!-----------------------------------------------------------------------
+&nam_diatmb    !  Top Middle Bottom Output                               (default F)
+!-----------------------------------------------------------------------
+   ln_diatmb   = .false.   !  Choose Top Middle and Bottom output or not
+/
+!-----------------------------------------------------------------------
+&nam_dia25h    !  25h Mean Output                                        (default F)
+!-----------------------------------------------------------------------
+   ln_dia25h   = .false.   ! Choose 25h mean output or not
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings             ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+   !                       !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+   !                       !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+   !                       !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+
+!!======================================================================
+!!               ***  Observation & Assimilation  ***
+!!======================================================================
+!!   namobs       observation and model comparison
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs        !  observation usage switch
+!-----------------------------------------------------------------------
+   ln_diaobs   = .false.             ! Logical switch for the observation operator
+   ln_t3d      = .false.             ! Logical switch for T profile observations
+   ln_s3d      = .false.             ! Logical switch for S profile observations
+   ln_sla      = .false.             ! Logical switch for SLA observations
+   ln_sst      = .false.             ! Logical switch for SST observations
+   ln_sic      = .false.             ! Logical switch for Sea Ice observations
+   ln_vel3d    = .false.             ! Logical switch for velocity observations
+   ln_altbias  = .false.             ! Logical switch for altimeter bias correction
+   ln_nea      = .false.             ! Logical switch for rejection of observations near land
+   ln_grid_global = .true.           ! Logical switch for global distribution of observations
+   ln_grid_search_lookup = .false.   ! Logical switch for obs grid search w/lookup table
+   ln_ignmis   = .true.              ! Logical switch for ignoring missing files
+   ln_s_at_t   = .false.             ! Logical switch for computing model S at T obs if not there
+   ln_sstnight = .false.             ! Logical switch for calculating night-time average for SST obs
+! All of the *files* variables below are arrays. Use namelist_cfg to add more files
+   cn_profbfiles = 'profiles_01.nc'  ! Profile feedback input observation file names
+   cn_slafbfiles = 'sla_01.nc'       ! SLA feedback input observation file names
+   cn_sstfbfiles = 'sst_01.nc'       ! SST feedback input observation file names
+   cn_sicfbfiles = 'sic_01.nc'       ! SIC feedback input observation file names
+   cn_velfbfiles = 'vel_01.nc'       ! Velocity feedback input observation file names
+   cn_altbiasfile = 'altbias.nc'     ! Altimeter bias input file name
+   cn_gridsearchfile='gridsearch.nc' ! Grid search file name
+   rn_gridsearchres = 0.5            ! Grid search resolution
+   rn_dobsini  = 00010101.000000     ! Initial date in window YYYYMMDD.HHMMSS
+   rn_dobsend  = 00010102.000000     ! Final date in window YYYYMMDD.HHMMSS
+   nn_1dint    = 0                   ! Type of vertical interpolation method
+   nn_2dint    = 0                   ! Type of horizontal interpolation method
+   nn_msshc    = 0                   ! MSSH correction scheme
+   rn_mdtcorr  = 1.61                ! MDT  correction
+   rn_mdtcutoff = 65.0               ! MDT cutoff for computed correction
+   nn_profdavtypes = -1              ! Profile daily average types - array
+   ln_sstbias  = .false.             !
+   cn_sstbias_files = 'sstbias.nc'   !
+/
+!-----------------------------------------------------------------------
+&nam_asminc    !   assimilation increments                              ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri  = .false.   !  Logical switch for writing out background state
+    ln_trainc  = .false.   !  Logical switch for applying tracer increments
+    ln_dyninc  = .false.   !  Logical switch for applying velocity increments
+    ln_sshinc  = .false.   !  Logical switch for applying SSH increments
+    ln_asmdin  = .false.   !  Logical switch for Direct Initialization (DI)
+    ln_asmiau  = .false.   !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg     = 0         !  Timestep of background in [0,nitend-nit000-1]
+    nitdin     = 0         !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr  = 1         !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin  = 15        !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn     = 0         !  Type of IAU weighting function
+    ln_salfix  = .false.   !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin  = -9999     !  Minimum salinity after applying the increments
+    nn_divdmp  = 0         !  Number of iterations of divergence damping operator
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/calendar.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/calendar.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/calendar.f90	(revision 8732)
@@ -0,0 +1,1044 @@
+MODULE calendar
+!-
+!$Id: calendar.f90 2459 2010-12-07 11:17:48Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/closea.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/closea.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/closea.f90	(revision 8732)
@@ -0,0 +1,223 @@
+MODULE closea
+   !!======================================================================
+   !!                       ***  MODULE  closea  ***
+   !! Closed Seas  : specific treatments associated with closed seas
+   !!======================================================================
+   !! History :   8.2  !  00-05  (O. Marti)  Original code
+   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90
+   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat
+   !!        NEMO 3.4  !  03-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_clo    : modification of the ocean domain for closed seas cases
+   !!   sbc_clo    : Special handling of closed seas
+   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf)
+   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2)
+   !!   clo_bat    : set to zero a field over closed sea (see domzrg)
+   !!----------------------------------------------------------------------
+   USE oce             ! dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran,    ONLY: glob_sum, DDPDD
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE lib_mpp         ! MPP library
+   USE timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dom_clo      ! routine called by domain module
+   PUBLIC clo_bat      ! routine called in domzgr module
+
+   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j)
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j)
+   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours
+   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff
+
+   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface
+
+   !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: closea.F90 5836 2015-10-26 14:49:40Z cetlod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_clo
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_clo  ***
+      !!        
+      !! ** Purpose :   Closed sea domain initialization
+      !!
+      !! ** Method  :   if a closed sea is located only in a model grid point
+      !!                just the thermodynamic processes are applied.
+      !!
+      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
+      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
+      !!                ncsir(), ncsjr() : Location of runoff
+      !!                ncsnr            : number of point where run-off pours
+      !!                ncstt            : Type of closed sea
+      !!                                   =0 spread over the world ocean
+      !!                                   =2 put at location runoff
+      !!----------------------------------------------------------------------
+      INTEGER ::   jc      ! dummy loop indices
+      INTEGER ::   isrow   ! local index
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
+      IF(lwp) WRITE(numout,*)'~~~~~~~'
+      !
+      ! initial values
+      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
+      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
+      !
+      ! set the closed seas (in data domain indices)
+      ! -------------------
+      !
+      IF( cp_cfg == "orca" ) THEN
+         !
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 1 )                                  ! ORCA_R1 configuration
+            !                                        ! =======================
+            ! This dirty section will be suppressed by simplification process:
+            ! all this will come back in input files
+            ! Currently these hard-wired indices relate to configuration with
+            ! extend grid (jpjglo=332)
+            isrow = 332 - jpjglo
+            !
+            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
+            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow
+            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow
+            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
+            !                                        
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            !                                            ! Caspian Sea
+            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
+            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
+            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
+            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
+            !                                            ! Great North American Lakes
+            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
+            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
+            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
+            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111           
+            !                                            ! Black Sea (crossed by the cyclic boundary condition)
+            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea)
+            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         !
+            ncsir(3:4,2) = 170;  ncsjr(3:4,2) = 106 
+            ncsir(3:4,3) = 171;  ncsjr(3:4,3) = 105 
+            ncsir(3:4,4) = 170;  ncsjr(3:4,4) = 105 
+            ncsi1(3)   = 174  ;  ncsj1(3)   = 107           ! 1 : west part of the Black Sea      
+            ncsi2(3)   = 181  ;  ncsj2(3)   = 112           !            (ie west of the cyclic b.c.)
+            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea 
+            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.)
+             
+          
+
+            !                                        ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            !                                            ! Caspian Sea
+            ncsnr(1)   =  1  ;  ncstt(1)   =  0  
+            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
+            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
+            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
+            !                                            ! Great North American Lakes
+            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
+            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
+            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
+            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
+            !                                            ! Black Sea
+            ncsnr(3)   =  4  ;  ncstt(3)   =  2  
+            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
+            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
+            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
+            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
+            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
+            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
+            !                                            ! Baltic Sea
+            ncsnr(4)   =  1  ;  ncstt(4)   =  2
+            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
+            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
+            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
+            !                                        ! =======================
+         CASE ( 025 )                                ! ORCA_R025 configuration
+            !                                        ! =======================
+            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea
+            ncsi1(1)   = 1330 ; ncsj1(1)   = 645
+            ncsi2(1)   = 1400 ; ncsj2(1)   = 795
+            ncsir(1,1) = 1    ; ncsjr(1,1) = 1
+            !                                        
+            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea 
+            ncsi1(2)   = 1284 ; ncsj1(2)   = 722
+            ncsi2(2)   = 1304 ; ncsj2(2)   = 747
+            ncsir(2,1) = 1    ; ncsjr(2,1) = 1
+            !
+         END SELECT
+         !
+      ENDIF
+
+      ! convert the position in local domain indices
+      ! --------------------------------------------
+      DO jc = 1, jpncs
+         ncsi1(jc)   = mi0( ncsi1(jc) )
+         ncsj1(jc)   = mj0( ncsj1(jc) )
+
+         ncsi2(jc)   = mi1( ncsi2(jc) )   
+         ncsj2(jc)   = mj1( ncsj2(jc) )  
+      END DO
+      !
+   END SUBROUTINE dom_clo
+
+
+   SUBROUTINE clo_bat( pbat, kbat )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE clo_bat  ***
+      !!                    
+      !! ** Purpose :   suppress closed sea from the domain
+      !!
+      !! ** Method  :   set to 0 the meter and level bathymetry (given in 
+      !!                arguments) over the closed seas.
+      !!
+      !! ** Action  :   set pbat=0 and kbat=0 over closed seas
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array)
+      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array)
+      !
+      INTEGER  ::   jc, ji, jj      ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jc = 1, jpncs
+         DO jj = ncsj1(jc), ncsj2(jc)
+            DO ji = ncsi1(jc), ncsi2(jc)
+               pbat(ji,jj) = 0._wp   
+               kbat(ji,jj) = 0   
+            END DO 
+         END DO 
+       END DO 
+       !
+   END SUBROUTINE clo_bat
+
+   !!======================================================================
+END MODULE closea
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/daymod.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/daymod.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/daymod.f90	(revision 8732)
@@ -0,0 +1,287 @@
+MODULE daymod
+   !!======================================================================
+   !!                       ***  MODULE  daymod  ***
+   !! Ocean        :  calendar
+   !!=====================================================================
+   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
+   !!                 ! 1997-03  (O. Marti)
+   !!                 ! 1997-05  (G. Madec)
+   !!                 ! 1997-08  (M. Imbard)
+   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
+   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
+   !!                 ! 2006-08  (G. Madec)  surface module major update
+   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   day        : calendar
+   !!
+   !!           -------------------------------
+   !!           ----------- WARNING -----------
+   !!
+   !!   we suppose that the time step is deviding the number of second of in a day
+   !!             ---> MOD( rday, rdt ) == 0
+   !!
+   !!           ----------- WARNING -----------
+   !!           -------------------------------
+   !!
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE in_out_manager ! I/O manager
+   USE iom            !
+   USE ioipsl  , ONLY :   ymds2ju   ! for calendar
+   USE prtctl         ! Print control
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   day        ! called by step.F90
+   PUBLIC   day_init   ! called by istate.F90
+   PUBLIC   day_mth    ! Needed by TAM
+
+   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: daymod.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE day_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE day_init  ***
+      !!
+      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
+      !!                because day will be called at the beginning of step
+      !!
+      !! ** Action  : - nyear        : current year
+      !!              - nmonth       : current month of the year nyear
+      !!              - nday         : current day of the month nmonth
+      !!              - nday_year    : current day of the year nyear
+      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
+      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
+      !!              - nsec_day     : current time step counted in second since 00h of the current day
+      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
+      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inbday, idweek
+      REAL(wp) ::   zjul
+      !!----------------------------------------------------------------------
+      !
+      ! max number of seconds between each restart
+      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
+         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
+            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
+      ENDIF
+      ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0
+      IF( MOD( rday     , rdt   ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+      IF( MOD( rday     , 2.    ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
+      IF( MOD( rdt      , 2.    ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
+      nsecd   = NINT(rday       )
+      nsecd05 = NINT(0.5 * rday )
+      ndt     = NINT(      rdt  )
+      ndt05   = NINT(0.5 * rdt  )
+
+
+      ! set the calandar from ndastp (read in restart file and namelist)
+
+      nyear   =   ndastp / 10000
+      nmonth  = ( ndastp - (nyear * 10000) ) / 100
+      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
+
+      nhour   =   nn_time0 / 100
+      nminute = ( nn_time0 - nhour * 100 )
+
+      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday )  
+      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
+      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
+
+      nsec1jan000 = 0
+      CALL day_mth
+
+      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
+         nmonth = nmonth - 1
+         nday = nmonth_len(nmonth)
+      ENDIF
+      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
+         nmonth = 12
+         nyear = nyear - 1
+         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
+         IF( nleapy == 1 )   CALL day_mth
+      ENDIF
+
+      ! day since january 1st
+      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
+
+      !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 = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
+      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
+      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
+
+      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
+      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
+         ! 1 timestep before current middle of first time step is still the same day
+         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
+         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05    
+      ELSE
+         ! 1 time step before the middle of the first time step is the previous day 
+         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
+         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
+      ENDIF
+      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
+      nsec_day   =             nhour*3600+nminute*60 - ndt05 
+      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
+      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
+
+      ! control print
+      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
+           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
+
+      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
+      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
+      CALL day( nit000 )
+      !
+   END SUBROUTINE day_init
+
+
+   SUBROUTINE day_mth
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE day_init  ***
+      !!
+      !! ** Purpose :   calendar values related to the months
+      !!
+      !! ** Action  : - nmonth_len    : length in days of the months of the current year
+      !!              - nyear_len     : length in days of the previous/current year
+      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
+      !!              - nmonth_end    : second since the beginning of the year and the end of the months
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jm               ! dummy loop indice
+      !!----------------------------------------------------------------------
+
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN
+         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
+         nyear_len(:) = 365
+         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
+            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
+               nyear_len(0)  = 366
+            ENDIF
+            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
+               nmonth_len(2) = 29
+               nyear_len(1)  = 366
+            ENDIF
+            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
+               nyear_len(2)  = 366
+            ENDIF
+         ENDIF
+      ELSE
+         nmonth_len(:) = nleapy   ! all months with nleapy days per year
+         nyear_len(:) = 12 * nleapy
+      ENDIF
+
+      ! half month in second since the begining of the year:
+      ! time since Jan 1st   0     1     2    ...    11    12    13
+      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
+      !                 <---> <---> <--->  ...  <---> <---> <--->
+      ! month number      0     1     2    ...    11    12    13
+      !
+      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
+      nmonth_half(0) = - nsecd05 * nmonth_len(0)
+      DO jm = 1, 13
+         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
+      END DO
+
+      nmonth_end(0) = 0
+      DO jm = 1, 13
+         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
+      END DO
+      !
+   END SUBROUTINE
+
+
+   SUBROUTINE day( kt )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE day  ***
+      !!
+      !! ** Purpose :   Compute the date with a day iteration IF necessary.
+      !!
+      !! ** Method  : - ???
+      !!
+      !! ** Action  : - nyear     : current year
+      !!              - nmonth    : current month of the year nyear
+      !!              - nday      : current day of the month nmonth
+      !!              - nday_year : current day of the year nyear
+      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
+      !!              - adatrj    : date in days since the beginning of the run
+      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
+      !
+      CHARACTER (len=25) ::   charout
+      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('day')
+      !
+      zprec = 0.1 / rday
+      !                                                 ! New time-step
+      nsec_year  = nsec_year  + ndt
+      nsec_month = nsec_month + ndt
+      nsec_week  = nsec_week  + ndt
+      nsec_day   = nsec_day   + ndt
+      adatrj  = adatrj  + rdt / rday
+      fjulday = fjulday + rdt / rday
+      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
+      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
+
+      IF( nsec_day > nsecd ) THEN                       ! New day
+         !
+         nday      = nday + 1
+         nday_year = nday_year + 1
+         nsec_day  = ndt05
+         !
+         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
+            nday   = 1
+            nmonth = nmonth + 1
+            nsec_month = ndt05
+            IF( nmonth == 13 ) THEN                     ! New year
+               nyear     = nyear + 1
+               nmonth    = 1
+               nday_year = 1
+               nsec_year = ndt05
+               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
+               IF( nleapy == 1 )   CALL day_mth
+            ENDIF
+         ENDIF
+         !
+         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, '   nsec_week = ', nsec_week
+      ENDIF
+
+      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
+
+      IF(ln_ctl) THEN
+         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+         CALL prt_ctl_info(charout)
+      ENDIF
+
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('day')
+      !
+   END SUBROUTINE day
+
+
+   !!======================================================================
+END MODULE daymod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/defprec.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/defprec.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/defprec.f90	(revision 8732)
@@ -0,0 +1,22 @@
+MODULE defprec 
+!-
+! $Id: defprec.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dom_oce.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dom_oce.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dom_oce.f90	(revision 8732)
@@ -0,0 +1,385 @@
+MODULE dom_oce
+   !!======================================================================
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!======================================================================
+   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
+   !!                             to the optimization of BDY communications
+   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
+   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Root    : dummy function used when lk_agrif=F
+   !!   Agrif_CFixed  : dummy function used when lk_agrif=F
+   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
+
+   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! time & space domain namelist
+   !! ----------------------------
+   !                                    !!* Namelist namdom : time & space domain *
+   INTEGER , PUBLIC ::   nn_bathy        !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1)
+   REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_isfhmin      !: threshold to discriminate grounded ice to floating ice
+   REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nn_msh          !: = 1 create a mesh-mask file
+   REAL(wp), PUBLIC ::   rn_atfp         !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rn_rdt          !: time step for the dynamics and tracer
+   INTEGER , PUBLIC ::   nn_closea       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+   INTEGER , PUBLIC ::   nn_euler        !: =0 start with forward time step or not (=1)
+   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
+   LOGICAL , PUBLIC ::   ln_crs          !: Apply grid coarsening to dynamical model output or online passive tracers
+
+   !! Free surface parameters
+   !! =======================
+   LOGICAL , PUBLIC :: ln_dynspg_exp     !: Explicit free surface flag
+   LOGICAL , PUBLIC :: ln_dynspg_ts      !: Split-Explicit free surface flag
+
+   !! Time splitting parameters
+   !! =========================
+   LOGICAL,  PUBLIC :: ln_bt_fw          !: Forward integration of barotropic sub-stepping
+   LOGICAL,  PUBLIC :: ln_bt_av          !: Time averaging of barotropic variables
+   LOGICAL,  PUBLIC :: ln_bt_auto        !: Set number of barotropic iterations automatically
+   INTEGER,  PUBLIC :: nn_bt_flt         !: Filter choice
+   INTEGER,  PUBLIC :: nn_baro           !: Number of barotropic iterations during one baroclinic step (rdt)
+   REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_auto=T)
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+   INTEGER       ::   jphgr_msh          !: type of horizontal mesh
+   !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                       !  = 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)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees)
+   REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients
+   REAL(wp)      ::   ppa0               !: (default coefficients)
+   REAL(wp)      ::   ppa1               !:
+   REAL(wp)      ::   ppkth              !:
+   REAL(wp)      ::   ppacr              !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing
+   REAL(wp)      ::   pphmax             !: Maximum depth
+   !
+   LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp)      ::   ppa2               !: Double tanh function parameters
+   REAL(wp)      ::   ppkth2             !:
+   REAL(wp)      ::   ppacr2             !:
+
+   !                                    !! old non-DOCTOR names still used in the model
+   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
+   REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics and tracer
+
+   !                                                  !!! associated variables
+   INTEGER , PUBLIC                 ::   neuler        !: restart euler forward option (0=Euler)
+   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp)
+   REAL(wp), PUBLIC                 ::   r2dt          !: = 2*rdt except at nit000 (=rdt) if neuler=0
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag
+   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag
+
+   !                                     !!! domain parameters linked to mpp
+   INTEGER, PUBLIC ::   nperio            !: type of lateral boundary condition
+   INTEGER, PUBLIC ::   nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom
+   INTEGER, PUBLIC ::   nreci, nrecj      !: overlap region in i and j
+   INTEGER, PUBLIC ::   nproc             !: number for local processor
+   INTEGER, PUBLIC ::   narea             !: number for local area
+   INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries  
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries  
+
+   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
+   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
+   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
+   INTEGER, PUBLIC ::   npne, npnw        !: index of north east and north west processor
+   INTEGER, PUBLIC ::   npse, npsw        !: index of south east and south west processor
+   INTEGER, PUBLIC ::   nbne, nbnw        !: logical of north east & north west processor
+   INTEGER, PUBLIC ::   nbse, nbsw        !: logical of south east & south west processor
+   INTEGER, PUBLIC ::   nidom             !: ???
+
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution?
+   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution?
+   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_f, ff_t                      !: coriolis factor                   [1/s]
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   !                                !!* Namelist namzgr : vertical coordinate *
+   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
+   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
+   LOGICAL, PUBLIC ::   ln_linssh    !: variable grid flag
+
+   !                                                        !  ref.   ! before  !   now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m]
+
+   !                                                        !  ref.   ! before  !   now   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m]
+   
+   !                                                      !  ref. ! before  !   now   !  after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0            ,    ht_n             !: t-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0  ,    hu_b ,    hu_n ,    hu_a   !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  ,    hv_b ,    hv_n ,    hv_a   !: u-depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m]
+
+
+   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
+   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
+
+   !! 1D reference  vertical coordinate
+   !! =-----------------====------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points
+
+!!gm  This should be removed from here....  ==>>> only used in domzgr at initialization phase
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsigt, gsigw       !: model level depth coefficient at t-, w-levels (analytic)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsi3w              !: model level depth coefficient at w-level (sum of gsigw)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   esigt, esigw       !: vertical scale factor coef. at t-, w-levels
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies 
+   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
+!!gm end
+
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: first wet T-, U-, V-, F- ocean level (ISF)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                       (ISF)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+   !!----------------------------------------------------------------------
+   !! calendar variables
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   nhour         !: current hour
+   INTEGER , PUBLIC ::   nminute       !: current minute
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   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: 2) ::   nyear_len     !: length in days of the previous/current/next year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
+   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+
+   !!----------------------------------------------------------------------
+   !! mpp reproducibility
+   !!----------------------------------------------------------------------
+
+
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag
+
+
+   !!----------------------------------------------------------------------
+   !! agrif domain
+   !!----------------------------------------------------------------------
+
+
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: dom_oce.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   !!----------------------------------------------------------------------
+   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom
+   !!----------------------------------------------------------------------
+   LOGICAL FUNCTION Agrif_Root()
+      Agrif_Root = .TRUE.
+   END FUNCTION Agrif_Root
+
+   CHARACTER(len=3) FUNCTION Agrif_CFixed()
+      Agrif_CFixed = '0' 
+   END FUNCTION Agrif_CFixed
+
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(13) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  &
+         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) )
+         !
+      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
+         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     &
+         &                                      nleit(jpnij) , nlejt(jpnij) ,     &
+         &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta),      &
+         &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) )
+         !
+      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
+         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
+         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
+         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
+         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
+         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
+         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
+         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
+         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
+         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
+         &       ff_f(jpi,jpj) ,     ff_t(jpi,jpj)                                     , STAT=ierr(3) )
+         !
+      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     &
+         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             &
+         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
+         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   & 
+         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   & 
+         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             &
+         !                                                          !
+         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         &
+         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &               
+         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                       
+         !
+      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           &
+         &                      hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) ,     &
+         &      ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) ,     &
+         &                      hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6)  )
+         !
+         !
+      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     &
+         &      e3t_1d  (jpk) , e3w_1d  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     &
+         &      gsigt   (jpk) , gsigw   (jpk) , gsi3w(jpk)    ,                     &
+         &      esigt   (jpk) , esigw   (jpk)                                 , STAT=ierr(7) )
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(8) )
+
+      ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       &
+         &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       & 
+         &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
+         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) )
+
+! (ISF) Allocation of basic array   
+      ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     &
+         &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           &
+         &     mikf(jpi,jpj), STAT=ierr(10) )
+
+      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     & 
+         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) )
+
+      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
+      !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+
+   !!======================================================================
+END MODULE dom_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domain.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domain.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domain.f90	(revision 8732)
@@ -0,0 +1,499 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean variables
+   USE dom_oce         ! domain: ocean
+   USE phycst          ! physical constants
+   USE closea          ! closed seas
+   USE domhgr          ! domain: set the horizontal mesh
+   USE domzgr          ! domain: set the vertical mesh
+   USE domstp          ! domain: set the time-step
+   USE dommsk          ! domain: set the mask system
+   USE domwri          ! domain: write the meshmask file
+   USE domvvl          ! variable volume
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+   USE wrk_nemo        ! Memory Allocation
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init   ! called by opa.F90
+
+   !!-------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: domain.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! 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_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - 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 indices
+      INTEGER ::   iconf = 0   ! local integers
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      !                       !==  Reference coordinate system  ==!
+      !
+                     CALL dom_nam               ! read namelist ( namrun, namdom )
+                     CALL dom_clo               ! Closed seas and lake
+                     CALL dom_hgr               ! Horizontal mesh
+                     CALL dom_zgr               ! Vertical mesh and bathymetry
+                     CALL dom_msk               ! Masks
+      !
+      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness
+      hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)
+      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpk
+         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
+         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
+         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !
+      !              !==  time varying part of coordinate system  ==!
+      !
+      IF( ln_linssh ) THEN          ! Fix in time : set to the reference one for all
+         !       before        !          now          !       after         !
+         ;  gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
+         ;  gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
+         ;                     ;   gde3w_n = gde3w_0   !        ---          !
+         !                                                                  
+         ;    e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
+         ;    e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
+         ;    e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
+         ;                     ;     e3f_n =   e3f_0   !        ---          !
+         ;    e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
+         ;   e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
+         ;   e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
+         !
+         CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
+         !
+         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
+         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
+         !
+         !        before       !          now          !       after         !
+         ;                     ;      ht_n =    ht_0   !                     ! water column thickness
+         ;     hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   ! 
+         ;     hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
+         ;  r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
+         ;  r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
+         !
+         CALL wrk_dealloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
+         !
+      ELSE                         ! time varying : initialize before/now/after variables
+         !
+         CALL dom_vvl_init 
+         !
+      ENDIF
+      !
+      CALL cfg_write         ! create the configuration file
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
+      !
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl
+      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin, &
+         &             rn_atfp , rn_rdt   , nn_closea   , ln_crs      , jphgr_msh ,                  &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
+         &             ppa2, ppkth2, ppacr2
+
+
+
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
+         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
+         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
+         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
+         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,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         IF( ln_rst_list ) THEN
+            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
+         ELSE
+            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         ENDIF
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
+      ENDIF
+
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+      neuler = nn_euler
+      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
+         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
+         CALL ctl_warn( ctmp1 )
+         neuler = 0
+      ENDIF
+
+      !                             ! 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
+
+
+
+
+      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
+
+
+
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+  
+      !
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      min number of ocean level (<0)       '
+         WRITE(numout,*) '      treshold to open the isf cavity   rn_isfhmin   = ', rn_isfhmin, ' (m)'
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         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,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea
+         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs
+         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
+         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
+         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
+         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
+         WRITE(numout,*) '                                        ppa0            = ', ppa0
+         WRITE(numout,*) '                                        ppa1            = ', ppa1
+         WRITE(numout,*) '                                        ppkth           = ', ppkth
+         WRITE(numout,*) '                                        ppacr           = ', ppacr
+         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
+         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
+         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
+         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
+         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
+         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
+      ENDIF
+      !
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc   ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE cfg_write
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE cfg_write  ***
+      !!                   
+      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which 
+      !!              contains all the ocean domain informations required to 
+      !!              define an ocean configuration.
+      !!
+      !! ** Method  :   Write in a file all the arrays required to set up an
+      !!              ocean configuration.
+      !!
+      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
+      !!                              Coriolis parameter, and vertical scale factors
+      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
+      !!                              and depths (ln_e3_dep=F) 
+      !!----------------------------------------------------------------------
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
+      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                       ! ============================= !
+      !                       !  create 'domain_cfg.nc' file  !
+      !                       ! ============================= !
+      !         
+      clnam = 'domain_cfg'  ! filename (configuration information)
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
+      
+      !
+      !                             !==  ORCA family specificities  ==!
+      IF( cp_cfg == "ORCA" ) THEN
+         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
+      ENDIF
+      !                             !==  global domain size  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
+      !
+      !                             !==  domain characteristics  ==!
+      !
+      !                                   ! lateral boundary of the global
+      !                                   domain
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !
+      !                                   ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !
+      !                                   ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+      !
+      !                             !==  horizontal mesh  !
+      !
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
+      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
+      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
+      !
+      !                             !==  vertical mesh  ==!
+      !                                                     
+      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
+      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
+      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
+      !
+      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
+         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with  
+         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
+         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
+         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
+      ENDIF
+      !                                         
+      !                             !==  ocean top and bottom level  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
+      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
+      !
+      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
+         CALL dom_stiff( z2d )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
+      ENDIF
+      !
+      !                                ! ============================
+      !                                !        close the files 
+      !                                ! ============================
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE cfg_write
+
+
+
+   !!======================================================================
+END MODULE domain
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domcfg.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domcfg.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domcfg.f90	(revision 8732)
@@ -0,0 +1,199 @@
+MODULE domcfg
+   !!==============================================================================
+   !!                       ***  MODULE domcfg   ***
+   !! Ocean initialization : domain configuration initialization
+   !!==============================================================================
+   !! History :  1.0  ! 2003-09  (G. Madec)  Original code
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_cfg        : initialize the domain configuration
+   !!----------------------------------------------------------------------
+   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 timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_cfg    ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id: domcfg.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_cfg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_cfg  ***
+      !!                    
+      !! ** Purpose :   set the domain configuration
+      !!
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_cfg')
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   ocean model configuration used :   cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
+         !
+         WRITE(numout,*) '   global domain lateral boundaries'
+         !
+         IF( jperio == 0 )   WRITE(numout,*) '      jperio= 0, closed'
+         IF( jperio == 1 )   WRITE(numout,*) '      jperio= 1, cyclic east-west'
+         IF( jperio == 2 )   WRITE(numout,*) '      jperio= 2, equatorial symmetric'
+         IF( jperio == 3 )   WRITE(numout,*) '      jperio= 3, north fold with T-point pivot'
+         IF( jperio == 4 )   WRITE(numout,*) '      jperio= 4, cyclic east-west and north fold with T-point pivot'
+         IF( jperio == 5 )   WRITE(numout,*) '      jperio= 5, north fold with F-point pivot'
+         IF( jperio == 6 )   WRITE(numout,*) '      jperio= 6, cyclic east-west and north fold with F-point pivot'
+      ENDIF
+      !
+      IF( jperio <  0 .OR. jperio > 6 )   CALL ctl_stop( 'jperio is out of range' )
+      !
+      CALL dom_glo                   ! global domain versus zoom and/or local domain
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_cfg')
+      !
+   END SUBROUTINE dom_cfg
+
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization for global domain, zoom and local domain
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig  , mjg : 
+      !!              - mi0  , mi1   :
+      !!              - mj0, , mj1   :
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop argument
+      !!----------------------------------------------------------------------
+      !                              ! recalculate jpizoom/jpjzoom given lat/lon
+      !
+      !                        ! ============== !
+      !                        !  Local domain  ! 
+      !                        ! ============== !
+      DO ji = 1, jpi                 ! local domain indices ==> data domain indices
+        mig(ji) = ji + jpizoom - 1 + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
+      END DO
+      !
+      !                              ! data domain indices ==> local domain indices
+      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
+      !                                   !local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
+      DO ji = 1, jpidta
+        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) )
+        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
+      END DO
+      DO jj = 1, jpjdta
+        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj+1 ) )
+        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
+      END DO
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: data / local '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
+            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
+         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
+            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
+         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
+            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
+            &                                           ' jpjzoom = ', jpjzoom
+         IF( nn_print >= 1 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> data i-index domain'
+            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion data   ==> local  i-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> data j-index domain'
+            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion data  ==> local j-index domain'
+            WRITE(numout,*) '             starting index'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
+            WRITE(numout,*) '             ending index'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
+         ENDIF
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+
+      !                        ! ============== !
+      !                        !  Zoom domain   !
+      !                        ! ============== !
+      !                              ! zoom control
+      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   &
+          jpjglo + jpjzoom - 1  >  jpjdta      ) &
+          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' )
+
+      !                              ! set zoom flag
+      IF( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
+
+      !                              ! set zoom type flags
+      IF( lzoom .AND. jpizoom /= 1 )   lzoom_w = .TRUE.                     ! 
+      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
+      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_e = .TRUE.
+      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          zoom flags : '
+         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
+         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
+         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
+         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
+         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
+      ENDIF
+      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   &
+           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' )
+      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   &
+           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' )
+
+      !                              ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
+      IF( cp_cfg == "orca" ) THEN
+         SELECT CASE ( jp_cfg )
+         CASE ( 2 )                               !  ORCA_R2 configuration
+            IF(  cp_cfz == "arctic"    .AND. jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
+               & jpizoom ==  21    .AND. jpjzoom ==  97         )   THEN
+              IF(lwp) WRITE(numout,*) '          ORCA configuration: arctic zoom '
+            ENDIF
+            IF(  cp_cfz == "antarctic" .AND. jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   THEN
+              IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic zoom '
+            ENDIF
+            !                             
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            IF(    cp_cfz == "arctic"    .AND. jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
+               & jpizoom ==  81    .AND. jpjzoom == 301         )   THEN
+              IF(lwp) WRITE(numout,*) '          ORCA configuration: arctic zoom '
+            ENDIF
+            IF(    cp_cfz == "antarctic" .AND. jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   THEN
+              IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic zoom '
+            ENDIF
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE dom_glo
+
+   !!======================================================================
+END MODULE domcfg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domhgr.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domhgr.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domhgr.f90	(revision 8732)
@@ -0,0 +1,498 @@
+MODULE domhgr
+   !!==============================================================================
+   !!                       ***  MODULE domhgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! 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 
+   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
+   !!                                       add optional read of e1e2u & e1e2v
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_hgr       : initialize the horizontal mesh 
+   !!   hgr_read      : read "coordinate" NetCDF file 
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
+
+   PUBLIC   dom_hgr   ! called by domain.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: domhgr.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_hgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_hgr  ***
+      !!
+      !! ** Purpose :   Compute the geographical position (in degre) of the 
+      !!      model grid-points,  the horizontal scale factors (in meters) and 
+      !!      the Coriolis factor (in s-1).
+      !!
+      !! ** Method  :   The geographical position of the model grid-points is
+      !!      defined from analytical functions, fslam and fsphi, the deriva-
+      !!      tives of which gives the horizontal scale factors e1,e2.
+      !!      Defining two function fslam and fsphi and their derivatives in 
+      !!      the two horizontal directions (fse1 and fse2), the model grid-
+      !!      point position and scale factors are given by:
+      !!         t-point:
+      !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
+      !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
+      !!         u-point:
+      !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
+      !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
+      !!         v-point:
+      !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
+      !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
+      !!            f-point:
+      !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
+      !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
+      !!      Where fse1 and fse2 are defined by:
+      !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
+      !!                                     +          di(fsphi) **2 )(i,j)
+      !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
+      !!                                     +          dj(fsphi) **2 )(i,j)
+      !!
+      !!        The coriolis factor is given at z-point by:
+      !!                     ff = 2.*omega*sin(gphif)      (in s-1)
+      !!
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model grid-point position and
+      !!      horizontal scale factors must be respected in order to insure
+      !!      second order accuracy schemes.
+      !!
+      !! N.B. If the domain is periodic, verify that scale factors are also
+      !!      periodic, and the coriolis term again.
+      !!
+      !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-, 
+      !!                u-, v- and f-points (in degre)
+      !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-,
+      !!               u-, v-  and f-points (in degre)
+      !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
+      !!      scale factors (in meters) at t-, u-, v-, and f-points.
+      !!        define ff: coriolis factor at f-point
+      !!
+      !! References :   Marti, Madec and Delecluse, 1992, JGR
+      !!                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   ! 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
+      INTEGER  ::   isrow                ! index for ORCA1 starting row
+      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_hgr')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
+         WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh
+         WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0
+         WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0
+         WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg
+         WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
+         WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m  
+         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
+      ENDIF
+      !
+      !
+      SELECT CASE( jphgr_msh )   !  type of horizontal mesh  
+      !
+      CASE ( 0 )                     !==  read in coordinate.nc file  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
+         !
+         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v
+         !
+         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file
+         !
+         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them
+            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction
+            e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+            e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+         ENDIF
+         !
+      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj
+               gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj
+               gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj
+               gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * ppe2_deg
+               e2u(ji,jj) = ra * rad * ppe2_deg
+               e2v(ji,jj) = ra * rad * ppe2_deg
+               e2f(ji,jj) = ra * rad * ppe2_deg
+            END DO
+         END DO
+         !
+      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
+         !
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         glam0 = 0._wp
+         gphi0 = - ppe2_m * 1.e-3
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 )
+               glamv(ji,jj) = glamt(ji,jj)
+               glamf(ji,jj) = glamu(ji,jj)
+               !
+               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       )
+               gphiu(ji,jj) = gphit(ji,jj)
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 )
+               gphif(ji,jj) = gphiv(ji,jj)
+            END DO
+         END DO
+         !
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m
+         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m
+         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
+         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
+         !
+      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
+         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
+         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
+         !
+         !  Find index corresponding to the equator, given the grid spacing e1_deg
+         !  and the (approximate) southern latitude ppgphi0.
+         !  This way we ensure that the equator is at a "T / U" point, when in the domain.
+         !  The formula should work even if the equator is outside the domain.
+         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
+         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
+         IF(  ppgphi0 > 0 )  ijeq = -ijeq
+         !
+         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+               gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zuj ) )
+               gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zvj ) )
+               gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zfj ) )
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+            END DO
+         END DO
+         !
+      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration)
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
+         !
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         !
+         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
+         zlam1 = -85._wp
+         zphi1 =  29._wp
+         ! resolution in meters
+         ze1 = 106000. / REAL( jp_cfg , wp )            
+         ! benchmark: forced the resolution to be about 100 km
+         IF( nbench /= 0 )   ze1 = 106000._wp     
+         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp
+         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
+         ze1deg = ze1 / (ra * rad)
+         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon
+         !                                                           ! at the right jp_cfg resolution
+         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         !
+         IF( nprint==1 .AND. lwp )   THEN
+            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
+            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
+         ENDIF
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5
+               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5
+               !
+               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+               !
+               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+            END DO
+         END DO
+         !
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1
+         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1
+         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
+         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
+         !
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      
+      ! associated horizontal metrics
+      ! -----------------------------
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them
+         e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+      ENDIF
+      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases
+      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+
+      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart)
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         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), e1f(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, 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), e2f  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+
+      ! ================= !
+      !  Coriolis factor  !
+      ! ================= !
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+      !
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+         !
+         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
+         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       - at t-point
+         !
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+         !
+         ff_f(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         ff_t(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         !
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff_f(1,1)
+         !
+      CASE ( 3 )                     ! beta-plane
+         !
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
+         !
+         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
+         !
+         ff_f(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         ff_t(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff_f(nldi,nldj)
+            WRITE(numout,*) '          Coriolis parameter varies from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
+         ENDIF
+         IF( lk_mpp ) THEN 
+            zminff=ff_f(nldi,nldj)
+            zmaxff=ff_f(nldi,nlej)
+            CALL mpp_min( zminff )   ! min over the global domain
+            CALL mpp_max( zmaxff )   ! max over the global domain
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
+         END IF
+         !
+      CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration)
+         !
+         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0 = 15._wp                                                     ! latitude of the first row F-points
+         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         !
+         ff_f(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         ff_t(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane and rotated domain : '
+            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
+         ENDIF
+         !
+         IF( lk_mpp ) THEN 
+            zminff=ff_f(nldi,nldj)
+            zmaxff=ff_f(nldi,nlej)
+            CALL mpp_min( zminff )   ! min over the global domain
+            CALL mpp_max( zmaxff )   ! max over the global domain
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
+         END IF
+         !
+      END SELECT
+
+
+      ! Control of domain for symetrical condition
+      ! ------------------------------------------
+      ! The equator line must be the latitude coordinate axe
+
+      IF( nperio == 2 ) THEN
+         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi )
+         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_hgr')
+      !
+   END SUBROUTINE dom_hgr
+
+
+   SUBROUTINE hgr_read( ke1e2u_v )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE hgr_read  ***
+      !!
+      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM
+      !!
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0)
+      !
+      INTEGER ::   inum   ! temporary logical unit
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'hgr_read : read the horizontal coordinates'
+         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
+      ENDIF
+      !
+      CALL iom_open( 'coordinates', inum )
+      !
+      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr )
+      !
+      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file'
+         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr )
+         ke1e2u_v = 1
+      ELSE
+         ke1e2u_v = 0
+      ENDIF
+      !
+      CALL iom_close( inum )
+      
+    END SUBROUTINE hgr_read
+    
+   !!======================================================================
+END MODULE domhgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dommsk.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dommsk.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dommsk.f90	(revision 8732)
@@ -0,0 +1,369 @@
+MODULE dommsk
+   !!======================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask 
+   !!======================================================================
+   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
+   !!            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
+   !!            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
+   !!            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
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk        : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         !
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+   !                            !!* Namelist namlbc : lateral boundary condition *
+   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
+   !                                            with analytical eqs.
+
+   !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id: dommsk.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) points.
+      !!
+      !! ** Method  :   The ocean/land mask is computed from the basin bathy-
+      !!      metry in level (mbathy) which is defined or read in dommba.
+      !!      mbathy equals 0 over continental T-point 
+      !!      and the number of ocean level over the ocean.
+      !!
+      !!      At a given position (ji,jj,jk) the ocean/land mask is given by:
+      !!      t-point : 0. IF mbathy( ji ,jj) =< 0
+      !!                1. IF mbathy( ji ,jj) >= jk
+      !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
+      !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
+      !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1)
+      !!                   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.
+      !!      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
+      !!      the coast and topography. This value is defined by rn_shlat, a
+      !!      namelist parameter:
+      !!         rn_shlat = 0, free slip  (no shear along the coast)
+      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays
+      !!      are defined with the proper value at lateral domain boundaries.
+      !!
+      !!      In case of open boundaries (lk_bdy=T):
+      !!        - tmask is set to 1 on the points to be computed bay the open
+      !!          boundaries routines.
+      !!
+      !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.)
+      !!               umask    : land/ocean mask at u-point (=0. or 1.)
+      !!               vmask    : land/ocean mask at v-point (=0. or 1.)
+      !!               fmask    : land/ocean mask at f-point (=0. or 1.)
+      !!                          =rn_shlat along lateral boundaries
+      !!               tmask_i  : interior ocean mask
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
+      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
+      INTEGER  ::   ios
+      INTEGER  ::   isrow                    ! index for ORCA1 starting row
+      INTEGER , POINTER, DIMENSION(:,:) ::  imsk
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zwf
+      !!
+      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_msk')
+      !
+      CALL wrk_alloc( jpi, jpj, imsk )
+      CALL wrk_alloc( jpi, jpj, zwf  )
+      !
+      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
+      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namlbc )
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dommsk : ocean mask '
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '   Namelist namlbc'
+         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
+         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
+      ENDIF
+
+      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 '
+      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  strong-slip '
+      ELSE
+         WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat
+         CALL ctl_stop( ctmp1 )
+      ENDIF
+
+      ! 1. Ocean/land mask at t-point (computed from mbathy)
+      ! -----------------------------
+      ! N.B. tmask has already the right boundary conditions since mbathy is ok
+      !
+      tmask(:,:,:) = 0._wp
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp
+            END DO  
+         END DO  
+      END DO  
+      
+      ! (ISF) define barotropic mask and mask the ice shelf point
+      ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked
+      
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp )   THEN
+                  tmask(ji,jj,jk) = 0._wp
+               END IF
+            END DO  
+         END DO  
+      END DO  
+
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+      tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf
+
+      tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere
+      iif = jpreci                         ! ???
+      iil = nlci - jpreci + 1
+      ijf = jprecj                         ! ???
+      ijl = nlcj - jprecj + 1
+
+      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+
+      ! north fold mask
+      ! ---------------
+      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._wp
+         fpol(     1    :jpiglo) = 0._wp
+         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row
+            DO ji = iif+1, iil-1
+               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF
+     
+      tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:)
+
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0._wp
+         fpol(jpiglo/2+1:jpiglo) = 0._wp
+      ENDIF
+
+      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
+      ! -------------------------------------------
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector loop
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+            END DO
+            DO ji = 1, jpim1      ! NO vector opt.
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1   ! vector loop
+            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
+            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
+         END DO
+         DO ji = 1, jpim1      ! NO vector opt.
+            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
+               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
+         END DO
+      END DO
+      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( vmask  , 'V', 1._wp )
+      CALL lbc_lnk( fmask  , 'F', 1._wp )
+      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( ssvmask, 'V', 1._wp )
+      CALL lbc_lnk( ssfmask, 'F', 1._wp )
+
+      ! 3. Ocean/land mask at wu-, wv- and w points 
+      !----------------------------------------------
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      wumask(:,:,1) = umask(:,:,1)
+      wvmask(:,:,1) = vmask(:,:,1)
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
+         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
+      END DO
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------     
+      DO jk = 1, jpk
+         zwf(:,:) = fmask(:,:,jk)         
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               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._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._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
+      END DO
+      !
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
+         !                                                 ! Increased lateral friction near of some straits
+         !                                ! Gibraltar strait  : partial slip (fmask=0.5)
+         ij0 = 101   ;   ij1 = 101
+         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+         ij0 = 102   ;   ij1 = 102
+         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
+         !
+         !                                ! Bab el Mandeb : partial slip (fmask=1)
+         ij0 =  87   ;   ij1 =  88
+         ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+         ij0 =  88   ;   ij1 =  88
+         ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
+         !
+         !                                ! Danish straits  : strong slip (fmask > 2)
+! We keep this as an example but it is instable in this case 
+!         ij0 = 115   ;   ij1 = 115
+!         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._wp
+         !
+      ENDIF
+      !
+      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration
+         !                                                 ! Increased lateral friction near of some straits
+         ! This dirty section will be suppressed by simplification process:
+         ! all this will come back in input files
+         ! Currently these hard-wired indices relate to configuration with
+         ! extend grid (jpjglo=332)
+         !
+         isrow = 332 - jpjglo
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
+         IF(lwp) WRITE(numout,*) '      Gibraltar '
+         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait 
+         ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Bhosporus '
+         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait 
+         ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Makassar (Top) '
+         ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top) 
+         ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+
+         IF(lwp) WRITE(numout,*) '      Lombok '
+         ii0 =  44           ;   ii1 =  44        ! Lombok Strait 
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Ombai '
+         ii0 =  53           ;   ii1 =  53        ! Ombai Strait 
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Timor Passage '
+         ii0 =  56           ;   ii1 =  56        ! Timor Passage 
+         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      West Halmahera '
+         ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait 
+         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+
+         IF(lwp) WRITE(numout,*) '      East Halmahera '
+         ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait 
+         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp  
+         !
+      ENDIF
+      !
+      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+      !
+      ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 )
+      !
+      CALL wrk_dealloc( jpi, jpj, imsk )
+      CALL wrk_dealloc( jpi, jpj, zwf  )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_msk')
+      !
+   END SUBROUTINE dom_msk
+   
+   !!======================================================================
+END MODULE dommsk
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domngb.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domngb.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domngb.f90	(revision 8732)
@@ -0,0 +1,92 @@
+MODULE domngb
+   !!======================================================================
+   !!                       ***  MODULE  domngb  ***
+   !! Grid search:  find the closest grid point from a given on/lat position
+   !!======================================================================
+   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_ngb       : find the closest grid point from a given lon/lat position
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+   USE wrk_nemo       ! Memory allocation
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_ngb   ! routine called in iom.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: domngb.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_ngb  ***
+      !!
+      !! ** Purpose :   find the closest grid point from a given lon/lat position
+      !!
+      !! ** Method  :   look for minimum distance in cylindrical projection 
+      !!                -> not good if located at too high latitude...
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
+      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
+      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
+      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
+      !
+      INTEGER :: ik         ! working level
+      INTEGER , DIMENSION(2) ::   iloc
+      REAL(wp)               ::   zlon, zmini
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
+      !
+      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
+      !
+      zmask(:,:) = 0._wp
+      ik = 1
+      IF ( PRESENT(kkk) ) ik=kkk
+      SELECT CASE( cdgrid )
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
+      END SELECT
+
+      IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN
+         zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
+         zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
+         IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
+         IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
+         zglam(:,:) = zglam(:,:) - zlon
+      ELSE
+         zglam(:,:) = zglam(:,:) - plon
+      END IF
+
+      zgphi(:,:) = zgphi(:,:) - plat
+      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
+      
+      IF( lk_mpp ) THEN  
+         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
+      ELSE
+         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
+         kii = iloc(1) + nimpp - 1
+         kjj = iloc(2) + njmpp - 1
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
+      !
+   END SUBROUTINE dom_ngb
+
+   !!======================================================================
+END MODULE domngb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domstp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domstp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domstp.f90	(revision 8732)
@@ -0,0 +1,71 @@
+MODULE domstp
+   !!==============================================================================
+   !!                       ***  MODULE domstp   ***
+   !! Ocean initialization : time domain
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_stp        : ocean time domain initialization
+   !!----------------------------------------------------------------------
+   !! History :  OPA  ! 1990-10  (O. Marti)  Original code
+   !!                 ! 1996-01  (G. Madec)  terrain following coordinates
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_stp   ! routine called by inidom.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: domstp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_stp
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_stp  ***
+      !!          
+      !! ** Purpose :   Intialize ocean time step for the run
+      !!
+      !! ** Method  : - Initialization of a coef. use in the Asselin time
+      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
+      !!      filter parameter read in namelist
+      !!              - Model time step:
+      !!                synchronous time intergration.
+      !!      There is one time step only, defined by: rdt for dynamics and
+      !!      tracer,wind stress, surface heat and salt fluxes
+      !!
+      !! ** Action  : [REMOVED - rdttra: vertical profile of tracer time step]
+      !!              - atfp1    : = 1 - 2*atfp
+      !!
+      !! References :   Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk              ! dummy loop indice
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stp : time stepping setting'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! 0. Asselin Time filter
+      ! ----------------------
+      
+      atfp1 = 1. - 2. * atfp
+
+      IF(lwp) WRITE(numout,*)'               synchronous time stepping'
+      IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
+
+
+   END SUBROUTINE dom_stp
+
+   !!======================================================================
+END MODULE domstp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domvvl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domvvl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domvvl.f90	(revision 8732)
@@ -0,0 +1,437 @@
+MODULE domvvl
+   !!======================================================================
+   !!                       ***  MODULE domvvl   ***
+   !! Ocean : 
+   !!======================================================================
+   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code
+   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate
+   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl:
+   !!                                          vvl option includes z_star and z_tilde coordinates
+   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness
+   !!   dom_vvl_sf_nxt   : Compute next vertical scale factors
+   !!   dom_vvl_sf_swp   : Swap vertical scale factors and update the vertical grid
+   !!   dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another
+   !!   dom_vvl_rst      : read/write restart file
+   !!   dom_vvl_ctl      : Check the vvl options
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE phycst          ! physical constant
+   USE dom_oce         ! ocean space and time domain
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  dom_vvl_init       ! called by domain.F90
+
+   !                                                      !!* Namelist nam_vvl
+   LOGICAL , PUBLIC :: ln_vvl_zstar           = .FALSE.    ! zstar  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde          = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_layer           = .FALSE.    ! level  vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor  = .FALSE.    ! ztilde vertical coordinate
+   LOGICAL , PUBLIC :: ln_vvl_kepe            = .FALSE.    ! kinetic/potential energy transfer
+   !                                                       ! conservation: not used yet
+   REAL(wp)         :: rn_ahe3                             ! thickness diffusion coefficient
+   REAL(wp)         :: rn_rst_e3t                          ! ztilde to zstar restoration timescale [days]
+   REAL(wp)         :: rn_lf_cutoff                        ! cutoff frequency for low-pass filter  [days]
+   REAL(wp)         :: rn_zdef_max                         ! maximum fractional e3t deformation
+   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence
+
+   !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 
+   !! $Id: domvvl.F90 6351 2016-02-24 18:50:11Z cetlod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dom_vvl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION dom_vvl_alloc  ***
+      !!----------------------------------------------------------------------
+      IF( ln_vvl_zstar )   dom_vvl_alloc = 0
+      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN
+         ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   &
+            &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   &
+            &      STAT = dom_vvl_alloc        )
+         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
+         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
+         un_td = 0._wp
+         vn_td = 0._wp
+      ENDIF
+      IF( ln_vvl_ztilde ) THEN
+         ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc )
+         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc )
+         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays')
+      ENDIF
+      !
+   END FUNCTION dom_vvl_alloc
+
+
+   SUBROUTINE dom_vvl_init
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_init  ***
+      !!                   
+      !! ** Purpose :  Initialization of all scale factors, depths
+      !!               and water column heights
+      !!
+      !! ** Method  :  - use restart file and/or initialize
+      !!               - interpolate scale factors
+      !!
+      !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b)
+      !!              - Regrid: e3(u/v)_n
+      !!                        e3(u/v)_b       
+      !!                        e3w_n           
+      !!                        e3(u/v)w_b      
+      !!                        e3(u/v)w_n      
+      !!                        gdept_n, gdepw_n and gde3w_n
+      !!              - h(t/u/v)_0
+      !!              - frq_rst_e3t and frq_rst_hdv
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2011, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk
+      INTEGER ::   ii0, ii1, ij0, ij1
+      REAL(wp)::   zcoef
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      !
+      CALL dom_vvl_ctl     ! choose vertical coordinate (z_star, z_tilde or layer)
+      !
+      !                    ! Allocate module arrays
+      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )
+      !
+      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf
+      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all
+      !
+      !                    !== Set of all other vertical scale factors  ==!  (now and before)
+      !                                ! Horizontal interpolation of e3t
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )    ! from T to U
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )    ! from T to V 
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )    ! from U to F
+      !                                ! Vertical interpolation of e3t,u,v 
+      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )  ! from T to W
+      CALL dom_vvl_interpol( e3t_b(:,:,:), e3w_b (:,:,:), 'W'  )
+      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )  ! from U to UW
+      CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
+      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )  ! from V to UW
+      CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
+      !
+      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep)
+      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration)
+      gdepw_n(:,:,1) = 0.0_wp
+      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg
+      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1)
+      gdepw_b(:,:,1) = 0.0_wp
+      DO jk = 2, jpk                               ! vertical sum
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+               !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+               !                             ! 0.5 where jk = mikt     
+!!gm ???????   BUG ?  gdept_n as well as gde3w_n  does not include the thickness of ISF ??
+               zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) )
+               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  &
+                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk)) 
+               gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj)
+               gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1)
+               gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  &
+                  &                + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(ji,jj,jk)) 
+            END DO
+         END DO
+      END DO
+      !
+      !                    !==  thickness of the water column  !!   (ocean portion only)
+      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) ....
+      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
+      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1)
+      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
+      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1)
+      DO jk = 2, jpkm1
+         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
+         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
+         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !
+      !                    !==  inverse of water column thickness   ==!   (u- and v- points)
+      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF
+      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) )
+      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
+      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )
+
+      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies)
+      IF( ln_vvl_ztilde ) THEN
+!!gm : idea: add here a READ in a file of custumized restoring frequency
+         !                                   ! Values in days provided via the namelist
+         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings
+         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp )
+         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp )
+         !
+         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile
+            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings
+            frq_rst_hdv(:,:) = 1._wp / rdt
+         ENDIF
+         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+!!gm  case |gphi| >= 6 degrees is useless   initialized just above by default
+                  IF( ABS(gphit(ji,jj)) >= 6.) THEN
+                     ! values outside the equatorial band and transition zone (ztilde)
+                     frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp )
+                     frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )
+                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star
+                     ! values inside the equatorial band (ztilde as zstar)
+                     frq_rst_e3t(ji,jj) =  0.0_wp
+                     frq_rst_hdv(ji,jj) =  1.0_wp / rdt
+                  ELSE                                      ! transition band (2.5 to 6 degrees N/S)
+                     !                                      ! (linearly transition from z-tilde to z-star)
+                     frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   &
+                        &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                        &                                          * 180._wp / 3.5_wp ) )
+                     frq_rst_hdv(ji,jj) = (1.0_wp / rdt)                                &
+                        &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp   &
+                        &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  &
+                        &                                          * 180._wp / 3.5_wp ) )
+                  ENDIF
+               END DO
+            END DO
+            IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
+               ii0 = 103   ;   ii1 = 111       
+               ij0 = 128   ;   ij1 = 135   ;   
+               frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp
+               frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init')
+      !
+   END SUBROUTINE dom_vvl_init
+
+
+   SUBROUTINE dom_vvl_interpol( pe3_in, pe3_out, pout )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_vvl__interpol  ***
+      !!
+      !! ** Purpose :   interpolate scale factors from one grid point to another
+      !!
+      !! ** Method  :   e3_out = e3_0 + interpolation(e3_in - e3_0)
+      !!                - horizontal interpolation: grid cell surface averaging
+      !!                - vertical interpolation: simple averaging
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3
+      CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors
+      !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW'
+      !
+      INTEGER ::   ji, jj, jk                                       ! dummy loop indices
+      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd = T/F
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol')
+      !
+      zlnwd = 0.0_wp
+      !
+      SELECT CASE ( pout )    !==  type of interpolation  ==!
+         !
+      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1   ! vector opt.
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   &
+                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     &
+                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
+         !
+      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1   ! vector opt.
+                  pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   &
+                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     &
+                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
+         !
+      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1   ! vector opt.
+                  pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &
+                     &                       *    r1_e1e2f(ji,jj)                                                  &
+                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     &
+                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )
+         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)
+         !
+      CASE( 'W' )                   !* from T- to W-point : vertical simple mean
+         !
+         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)
+         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing
+!!gm BUG? use here wmask in case of ISF ?  to be checked
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   &
+               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               &
+               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     &
+               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) )
+         END DO
+         !
+      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean
+         !
+         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)
+         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wumask in case of ISF ?  to be checked
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) )
+         END DO
+         !
+      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean
+         !
+         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)
+         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing
+!!gm BUG? use here wvmask in case of ISF ?  to be checked
+         DO jk = 2, jpk
+            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  &
+               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              &
+               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    &
+               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) )
+         END DO
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol')
+      !
+   END SUBROUTINE dom_vvl_interpol
+
+
+   SUBROUTINE dom_vvl_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_vvl_ctl  ***
+      !!                
+      !! ** Purpose :   Control the consistency between namelist options
+      !!                for vertical coordinate
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ios
+      !!
+      NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, &
+         &              ln_vvl_zstar_at_eqtor      , rn_ahe3     , rn_rst_e3t            , &
+         &              rn_lf_cutoff               , rn_zdef_max , ln_vvl_dbg                ! not yet implemented: ln_vvl_kepe
+      !!---------------------------------------------------------------------- 
+      !
+      REWIND( numnam_ref )              ! Namelist nam_vvl in reference namelist : 
+      READ  ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nam_vvl in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, nam_vvl )
+      !
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_vvl_ctl : choice/control of the variable vertical coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '           Namelist nam_vvl : chose a vertical coordinate'
+         WRITE(numout,*) '              zstar                      ln_vvl_zstar   = ', ln_vvl_zstar
+         WRITE(numout,*) '              ztilde                     ln_vvl_ztilde  = ', ln_vvl_ztilde
+         WRITE(numout,*) '              layer                      ln_vvl_layer   = ', ln_vvl_layer
+         WRITE(numout,*) '              ztilde as zstar   ln_vvl_ztilde_as_zstar  = ', ln_vvl_ztilde_as_zstar
+         WRITE(numout,*) '      ztilde near the equator    ln_vvl_zstar_at_eqtor  = ', ln_vvl_zstar_at_eqtor
+         ! WRITE(numout,*) '           Namelist nam_vvl : chose kinetic-to-potential energy conservation'
+         ! WRITE(numout,*) '                                         ln_vvl_kepe    = ', ln_vvl_kepe
+         WRITE(numout,*) '           Namelist nam_vvl : thickness diffusion coefficient'
+         WRITE(numout,*) '                                         rn_ahe3        = ', rn_ahe3
+         WRITE(numout,*) '           Namelist nam_vvl : maximum e3t deformation fractional change'
+         WRITE(numout,*) '                                         rn_zdef_max    = ', rn_zdef_max
+         IF( ln_vvl_ztilde_as_zstar ) THEN
+            WRITE(numout,*) '           ztilde running in zstar emulation mode; '
+            WRITE(numout,*) '           ignoring namelist timescale parameters and using:'
+            WRITE(numout,*) '                 hard-wired : z-tilde to zstar restoration timescale (days)'
+            WRITE(numout,*) '                                         rn_rst_e3t     =    0.0'
+            WRITE(numout,*) '                 hard-wired : z-tilde cutoff frequency of low-pass filter (days)'
+            WRITE(numout,*) '                                         rn_lf_cutoff   =    1.0/rdt'
+         ELSE
+            WRITE(numout,*) '           Namelist nam_vvl : z-tilde to zstar restoration timescale (days)'
+            WRITE(numout,*) '                                         rn_rst_e3t     = ', rn_rst_e3t
+            WRITE(numout,*) '           Namelist nam_vvl : z-tilde cutoff frequency of low-pass filter (days)'
+            WRITE(numout,*) '                                         rn_lf_cutoff   = ', rn_lf_cutoff
+         ENDIF
+         WRITE(numout,*) '           Namelist nam_vvl : debug prints'
+         WRITE(numout,*) '                                         ln_vvl_dbg     = ', ln_vvl_dbg
+      ENDIF
+      !
+      ioptio = 0                      ! Parameter control
+      IF( ln_vvl_ztilde_as_zstar )   ln_vvl_ztilde = .true.
+      IF( ln_vvl_zstar           )   ioptio = ioptio + 1
+      IF( ln_vvl_ztilde          )   ioptio = ioptio + 1
+      IF( ln_vvl_layer           )   ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' )
+      !
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( ln_vvl_zstar           ) WRITE(numout,*) '              zstar vertical coordinate is used'
+         IF( ln_vvl_ztilde          ) WRITE(numout,*) '              ztilde vertical coordinate is used'
+         IF( ln_vvl_layer           ) WRITE(numout,*) '              layer vertical coordinate is used'
+         IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) '              to emulate a zstar coordinate'
+         ! - ML - Option not developed yet
+         ! IF(       ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option used'
+         ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) '              kinetic to potential energy transfer : option not used'
+      ENDIF
+      !
+      !
+   END SUBROUTINE dom_vvl_ctl
+
+   !!======================================================================
+END MODULE domvvl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domwri.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domwri.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domwri.f90	(revision 8732)
@@ -0,0 +1,479 @@
+MODULE domwri
+   !!======================================================================
+   !!                       ***  MODULE domwri  ***
+   !! Ocean initialization : write the ocean domain mesh 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
+   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_wri        : create and write mesh and mask file(s)
+   !!   dom_uniq       : identify unique point of a grid (TUVF)
+   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lbclnk          ! lateral boundary conditions - mpp exchanges
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_wri              ! routine called by inidom.F90
+   PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90
+   PUBLIC   dom_stiff            ! routine called by inidom.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_wri_coordinate
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri_coordinate  ***
+      !!                   
+      !! ** Purpose :   Create the NetCDF file which contains all the
+      !!              standard coordinate information plus the surface,
+      !!              e1e2u and e1e2v. By doing so, those surface will
+      !!              not be changed by the reduction of e1u or e2v scale 
+      !!              factors in some straits. 
+      !!                 NB: call just after the read of standard coordinate
+      !!              and the reduction of scale factors in some straits
+      !!
+      !! ** output file :   coordinate_e1e2u_v.nc
+      !!----------------------------------------------------------------------
+      INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file
+      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
+      !                                   !  workspaces
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
+      
+      clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations)
+      
+      !  create 'coordinate_e1e2u_v.nc' file
+      ! ============================
+      !
+      CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+      !
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 )
+
+      CALL iom_close( inum0 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate')
+      !
+   END SUBROUTINE dom_wri_coordinate
+
+
+   SUBROUTINE dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri  ***
+      !!                   
+      !! ** Purpose :   Create 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  :   Write 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)
+      !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your 
+      !!      vertical coordinate.
+      !!
+      !!      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 t- and w-points
+      !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the
+      !!                        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
+      !                                   !  workspaces
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_wri')
+      !
+      CALL wrk_alloc( jpi, jpj, zprt, zprw )
+      CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam0 = 'mesh_mask'  ! filename (mesh and mask informations)
+      clnam1 = 'mesh'       ! filename (mesh informations)
+      clnam2 = 'mask'       ! filename (mask informations)
+      clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations)
+      clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations)
+      
+      SELECT CASE ( MOD(nmsh, 3) )
+         !                                  ! ============================
+      CASE ( 1 )                            !  create 'mesh_mask.nc' file
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         inum2 = inum0                                            ! put all the informations
+         inum3 = inum0                                            ! in unit inum0
+         inum4 = inum0
+         
+         !                                  ! ============================
+      CASE ( 2 )                            !  create 'mesh.nc' and 
+         !                                  !         'mask.nc' files
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         inum3 = inum1                                            ! put mesh informations 
+         inum4 = inum1                                            ! in unit inum1 
+         !                                  ! ============================
+      CASE ( 0 )                            !  create 'mesh_hgr.nc'
+         !                                  !         'mesh_zgr.nc' and
+         !                                  !         'mask.nc'     files
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
+         !
+      END SELECT
+      
+      !                                                         ! masks (inum2) 
+      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
+      CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 )
+      
+      CALL dom_uniq( zprw, 'T' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            jk=mikt(ji,jj) 
+            zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO                             !    ! unique point mask
+      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'U' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            jk=miku(ji,jj) 
+            zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'V' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            jk=mikv(ji,jj) 
+            zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'F' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            jk=mikf(ji,jj) 
+            zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )  
+
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'ff_f', ff_f, ktype = jp_r8 )           !    ! coriolis factor
+      CALL iom_rstput( 0, 0, inum3, 'ff_t', ff_t, ktype = jp_r8 )           !    ! coriolis factor
+      
+      ! note that mbkt is set to 1 over land ==> use surface tmask
+      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
+      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 )       !    ! nb of ocean T-points
+      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r8 )       !    ! nb of ocean T-points
+            
+      IF( ln_sco ) THEN                                         ! s-coordinate
+         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )
+         CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu )
+         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 )  
+         CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w )
+         CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
+         CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
+         !
+         CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         !    ! scale factors
+         CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
+         CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
+         CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
+         !
+         CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d )
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 )     
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 )
+         CALL dom_stiff( zprt )
+         CALL iom_rstput( 0, 0, inum4, 'stiffness', zprt )       !    ! Max. grid stiffness ratio
+      ENDIF
+      
+      IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
+         !
+         IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
+            CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         
+            CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 )
+            CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 )
+            CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 )
+         ELSE                                                   !    ! 2D masked bottom ocean scale factors
+            DO jj = 1,jpj   
+               DO ji = 1,jpi
+                  e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
+                  e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj)
+               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_0', gdept_0, ktype = jp_r8 )     
+            DO jk = 1,jpk   
+               DO jj = 1, jpjm1   
+                  DO ji = 1, jpim1   ! vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk) )
+                     zdepv(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(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_r8 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r8 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 )
+         ELSE                                                   !    ! 2D bottom depth
+            DO jj = 1,jpj   
+               DO ji = 1,jpi
+                  zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * ssmask(ji,jj)
+                  zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj)
+               END DO
+            END DO
+            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r8 )     
+            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r8 ) 
+         ENDIF
+         !
+         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! reference z-coord.
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )
+         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
+      ENDIF
+      
+      IF( ln_zco ) THEN
+         !                                                      ! z-coordinate - full steps
+         CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! depth
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )   !    ! scale factors
+         CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   )
+      ENDIF
+      !                                     ! ============================
+      !                                     !        close the files 
+      !                                     ! ============================
+      SELECT CASE ( MOD(nmsh, 3) )
+      CASE ( 1 )                
+         CALL iom_close( inum0 )
+      CASE ( 2 )
+         CALL iom_close( inum1 )
+         CALL iom_close( inum2 )
+      CASE ( 0 )
+         CALL iom_close( inum2 )
+         CALL iom_close( inum3 )
+         CALL iom_close( inum4 )
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, zprt, zprw )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_wri')
+      !
+   END SUBROUTINE dom_wri
+
+
+   SUBROUTINE dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** 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(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_uniq')
+      !
+      CALL wrk_alloc( jpi, jpj, ztstref )
+      !
+      ! 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 /) )
+      !
+      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 )
+      !
+      CALL wrk_dealloc( jpi, jpj, ztstref )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_uniq')
+      !
+   END SUBROUTINE dom_uniq
+
+
+   SUBROUTINE dom_stiff( px1 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_stiff  ***
+      !!                     
+      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
+      !!
+      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
+      !!                Save the maximum in the vertical direction
+      !!                (this number is only relevant in s-coordinates)
+      !!
+      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness
+      !
+      INTEGER  ::   ji, jj, jk 
+      REAL(wp) ::   zrxmax
+      REAL(wp), DIMENSION(4) ::   zr1
+      REAL(wp), DIMENSION(jpi,jpj) ::   zx1
+      !!----------------------------------------------------------------------
+      zx1(:,:) = 0._wp
+      zrxmax   = 0._wp
+      zr1(:)   = 0._wp
+      !
+      DO ji = 2, jpim1
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation....
+!!             especially since it is gde3w which is used to compute the pressure gradient
+!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator
+!!             so that the ratio is computed at the same point (i.e. uw and vw) ....
+               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
+                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
+                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
+               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
+                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
+                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
+               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
+                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
+                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
+               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
+                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
+                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
+               zrxmax = MAXVAL( zr1(1:4) )
+               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zx1, 'T', 1. )
+      !
+      IF( PRESENT( px1 ) )    px1 = zx1
+      !
+      zrxmax = MAXVAL( zx1 )
+      !
+      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
+         WRITE(numout,*) '~~~~~~~~~'
+      ENDIF
+      !
+   END SUBROUTINE dom_stiff
+
+   !!======================================================================
+END MODULE domwri
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domzgr.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domzgr.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/domzgr.f90	(revision 8732)
@@ -0,0 +1,2773 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean domain : definition of the vertical coordinate system
+   !!==============================================================================
+   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
+   !!                 ! 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
+   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
+   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
+   !!            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
+   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
+   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capabilitye  
+   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_zgr          : defined the ocean vertical coordinate system
+   !!       zgr_bat      : bathymetry fields (levels and meters)
+   !!       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 
+   !!       zgr_zps      : z-coordinate with partial steps
+   !!       zgr_sco      : s-coordinate
+   !!       fssig        : tanh stretch function
+   !!       fssig1       : Song and Haidvogel 1994 stretch function
+   !!       fgamma       : Siddorn and Furner 2012 stretching function
+   !!---------------------------------------------------------------------
+   USE oce               ! ocean variables
+   USE dom_oce           ! ocean domain
+   USE closea            ! closed seas
+   !
+   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
+   USE wrk_nemo          ! Memory allocation
+   USE timing            ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_zgr        ! called by dom_init.F90
+
+   !                              !!* Namelist namzgr_sco *
+   LOGICAL  ::   ln_s_sh94         ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T)
+   LOGICAL  ::   ln_s_sf12         ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T)
+   !
+   REAL(wp) ::   rn_sbot_min       ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max       ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_rmax           ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   REAL(wp) ::   rn_hc             ! Critical depth for transition from sigma to stretched coordinates
+   ! Song and Haidvogel 1994 stretching parameters
+   REAL(wp) ::   rn_theta          ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb          ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_bb             ! stretching parameter 
+   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   ! Siddorn and Furner stretching parameters
+   LOGICAL  ::   ln_sigcrit        ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch 
+   REAL(wp) ::   rn_alpha          ! control parameter ( > 1 stretch towards surface, < 1 towards seabed)
+   REAL(wp) ::   rn_efold          !  efold length scale for transition to stretched coord
+   REAL(wp) ::   rn_zs             !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   REAL(wp) ::   rn_zb_a           !  bathymetry scaling factor for calculating Zb
+   REAL(wp) ::   rn_zb_b           !  offset for calculating Zb
+
+  !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
+   !! $Id: domzgr.F90 6827 2016-08-01 13:37:15Z flavoni $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS       
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!              vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate   
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ibat   ! local integer
+      INTEGER ::   ios
+      !
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dom_zgr')
+      !
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
+         WRITE(numout,*) '      linear free surface            ln_linssh = ', ln_linssh
+      ENDIF
+
+      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      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' )
+      !
+      ioptio = 0
+      IF ( ln_zco .AND. ln_isfcav ) ioptio = ioptio + 1
+      IF ( ln_sco .AND. ln_isfcav ) ioptio = ioptio + 1
+      IF( ioptio > 0 )   CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' )
+      !
+      ! 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
+                          CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isolated ocean points
+                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points
+                          CALL zgr_top_level    ! shallowest ocean level for T-, U-, V- points
+      !
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL(  mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
+            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
+            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_zgr')
+      !
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE zgr_z
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   z-coordinate system (use in all type of coordinate)
+      !!        The depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the scale factors.
+      !!        both depth and scale factors only depend on k (1d arrays).
+      !!              w-level: gdepw_1d  = gdep(k)
+      !!                       e3w_1d(k) = dk(gdep)(k)     = e3(k)
+      !!              t-level: gdept_1d  = gdep(k+0.5)
+      !!                       e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)
+      !!
+      !! ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
+      !!              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m)
+      !!
+      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                     ! dummy loop indices
+      REAL(wp) ::   zt, zw                 ! temporary scalars
+      REAL(wp) ::   zsur, za0, za1, zkth   ! Values set from parameters in
+      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 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_z')
+      !
+      ! Set variables from parameters
+      ! ------------------------------
+       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.  &
+         &  ppsur == pp_to_be_computed           ) THEN
+         !
+         za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
+            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(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
+         za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur
+         za2 = ppa2                            ! optional (ldbletanh=T) double tanh parameter
+      ENDIF
+
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates'
+         WRITE(numout,*) '    ~~~~~~~'
+         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._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
+               WRITE(numout,*) '         zsur, za0, za1 computed from '
+               WRITE(numout,*) '                 zdzmin = ', zdzmin
+               WRITE(numout,*) '                 zhmax  = ', zhmax
+            ENDIF
+            WRITE(numout,*) '           Value of coefficients for vertical mesh:'
+            WRITE(numout,*) '                 zsur = ', zsur
+            WRITE(numout,*) '                 za0  = ', za0
+            WRITE(numout,*) '                 za1  = ', za1
+            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
+
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      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_wp
+            gdepw_1d(jk) = ( zw - 1 ) * za1
+            gdept_1d(jk) = ( zt - 1 ) * za1
+            e3w_1d  (jk) =  za1
+            e3t_1d  (jk) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         IF( .NOT. ldbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , wp )
+               zt = REAL( jk , wp ) + 0.5_wp
+               gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               e3t_1d  (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_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                  &                             + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                  &                             + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      &
+                  &                             + za2        * TANH(       (zw-zkth2) / zacr2 )
+               e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      &
+                  &                             + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         gdepw_1d(1) = 0._wp                    ! force first w-level to be exactly at zero
+      ENDIF
+
+      IF ( ln_isfcav .OR. ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+         !
+!==>>>   need to be like this to compute the pressure gradient with ISF. 
+!        If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+!        define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+!
+         DO jk = 1, jpkm1
+            e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk) 
+         END DO
+         e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO
+
+         DO jk = 2, jpk
+            e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1) 
+         END DO
+         e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1)) 
+      END IF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      DO jk = 1, jpk                      ! control positivity
+         IF( e3w_1d  (jk) <= 0._wp .OR. e3t_1d  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 '    )
+         IF( gdepw_1d(jk) <  0._wp .OR. gdept_1d(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' )
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_z')
+      !
+   END SUBROUTINE zgr_z
+
+
+   SUBROUTINE zgr_bat
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat  ***
+      !! 
+      !! ** Purpose :   set bathymetry both in levels and meters
+      !!
+      !! ** Method  :   read or define mbathy and bathy arrays
+      !!       * level bathymetry:
+      !!      The ocean basin geometry is given by a two-dimensional array,
+      !!      mbathy, which is defined as follow :
+      !!            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+      !!                              at t-point (ji,jj).
+      !!                            = 0  over the continental t-point.
+      !!      The array mbathy is checked to verified its consistency with
+      !!      model option. 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.
+      !!      ntopo=-1 :   rectangular channel or bassin with a bump 
+      !!      ntopo= 0 :   flat rectangular channel or basin 
+      !!      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
+      !!                   bathy  is read in 'bathy_meter.nc' NetCDF file
+      !!
+      !! ** Action  : - mbathy: level bathymetry (in level index)
+      !!              - bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk            ! dummy loop indices
+      INTEGER  ::   inum                      ! temporary logical unit
+      INTEGER  ::   ierror                    ! error flag
+      INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position
+      INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices
+      REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics 
+      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars
+      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   idta   ! global domain integer data
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdta   ! global domain scalar data
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bat')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~'
+      !                                               ! ================== ! 
+      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  !
+         !                                            ! ================== !
+         !                                            ! global domain level and meter bathymetry (idta,zdta)
+         !
+         ALLOCATE( idta(jpidta,jpjdta), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' )
+         ALLOCATE( zdta(jpidta,jpjdta), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' )
+         !
+         IF( ntopo == 0 ) THEN                        ! flat basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin'
+            IF( rn_bathy > 0.01 ) THEN 
+               IF(lwp) WRITE(numout,*) '         Depth = rn_bathy read in namelist'
+               zdta(:,:) = rn_bathy
+               IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+                  idta(:,:) = jpkm1
+               ELSE                                                ! z-coordinate (zco or zps): step-like topography
+                  idta(:,:) = jpkm1
+                  DO jk = 1, jpkm1
+                     WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk
+                  END DO
+               ENDIF
+            ELSE
+               IF(lwp) WRITE(numout,*) '         Depth = depthw(jpkm1)'
+               idta(:,:) = jpkm1                            ! before last level
+               zdta(:,:) = gdepw_1d(jpk)                     ! last w-point depth
+               h_oce     = gdepw_1d(jpk)
+            ENDIF
+         ELSE                                         ! bump centered in the basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump'
+            ii_bump = jpidta / 2                           ! i-index of the bump center
+            ij_bump = jpjdta / 2                           ! j-index of the bump center
+            r_bump  = 50000._wp                            ! bump radius (meters)       
+            h_bump  =  2700._wp                            ! bump height (meters)
+            h_oce   = gdepw_1d(jpk)                        ! background ocean depth (meters)
+            IF(lwp) WRITE(numout,*) '            bump characteristics: '
+            IF(lwp) WRITE(numout,*) '               bump center (i,j)   = ', ii_bump, ii_bump
+            IF(lwp) WRITE(numout,*) '               bump height         = ', h_bump , ' meters'
+            IF(lwp) WRITE(numout,*) '               bump radius         = ', r_bump , ' index'
+            IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters'
+            !                                        
+            DO jj = 1, jpjdta                              ! zdta :
+               DO ji = 1, jpidta
+                  zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump
+                  zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump
+                  zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) )
+               END DO
+            END DO
+            !                                              ! idta :
+            IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+               idta(:,:) = jpkm1
+            ELSE                                                ! z-coordinate (zco or zps): step-like topography
+               idta(:,:) = jpkm1
+               DO jk = 1, jpkm1
+                  WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk
+               END DO
+            ENDIF
+         ENDIF
+         !                                            ! set GLOBAL boundary conditions 
+         !                                            ! 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._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._wp
+            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp
+            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp
+         ELSE
+            ih = 0                                  ;      zh = 0._wp
+            IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce
+            idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh
+            idta( :    ,jpjdta) = ih                ;      zdta( :    ,jpjdta) =  zh
+            idta( 1    , :    ) = ih                ;      zdta( 1    , :    ) =  zh
+            idta(jpidta, :    ) = ih                ;      zdta(jpidta, :    ) =  zh
+         ENDIF
+
+         !                                            ! local domain level and meter bathymetries (mbathy,bathy)
+         mbathy(:,:) = 0                                   ! set to zero extra halo points
+         bathy (:,:) = 0._wp                               ! (require for mpp case)
+         DO jj = 1, nlcj                                   ! interior values
+            DO ji = 1, nlci
+               mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
+               bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
+            END DO
+         END DO
+         risfdep(:,:)=0.e0
+         misfdep(:,:)=1
+         !
+         ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code
+         IF( cp_cfg == "isomip" .AND. ln_isfcav ) THEN 
+            risfdep(:,:)=200.e0 
+            misfdep(:,:)=1 
+            ij0 = 1 ; ij1 = 40 
+            DO jj = mj0(ij0), mj1(ij1) 
+               risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
+            END DO 
+            WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
+         ! 
+         ELSEIF ( cp_cfg == "isomip2" .AND. ln_isfcav ) THEN
+         ! 
+            risfdep(:,:)=0.e0
+            misfdep(:,:)=1
+            ij0 = 1 ; ij1 = 40
+            DO jj = mj0(ij0), mj1(ij1)
+               risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
+            END DO
+            WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp
+         END IF
+         !
+         DEALLOCATE( idta, zdta )
+         !
+         !                                            ! ================ !
+      ELSEIF( ntopo == 1 ) THEN                       !   read in file   ! (over the local domain)
+         !                                            ! ================ !
+         !
+         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 )
+            mbathy(:,:) = INT( bathy(:,:) )
+            ! initialisation isf variables
+            risfdep(:,:)=0._wp ; misfdep(:,:)=1             
+            !                                                ! =====================
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !                                             ! =====================
+               !
+               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 15
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+               !
+               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 12
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+               !
+            ENDIF
+            !
+         ENDIF
+         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry
+            CALL iom_open ( 'bathy_meter.nc', inum ) 
+            IF ( ln_isfcav ) THEN
+               CALL iom_get  ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. )
+            ELSE
+               CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  )
+            END IF
+            CALL iom_close( inum )
+            !                                                
+            ! initialisation isf variables
+            risfdep(:,:)=0._wp ; misfdep(:,:)=1             
+            !
+            IF ( ln_isfcav ) THEN
+               CALL iom_open ( 'isf_draft_meter.nc', inum ) 
+               CALL iom_get  ( inum, jpdom_data, 'isf_draft', risfdep )
+               CALL iom_close( inum )
+               WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp
+
+               ! set grounded point to 0 
+               ! (a treshold could be set here if needed, or set it offline based on the grounded fraction)
+               WHERE ( bathy(:,:) <= risfdep(:,:) + rn_isfhmin )
+                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp
+                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp
+               END WHERE
+            END IF
+            !       
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+            !
+              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+              DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 284._wp
+                 END DO
+               END DO
+              IF(lwp) WRITE(numout,*)     
+              IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+              !
+              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 137._wp
+                 END DO
+              END DO
+              IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+              !
+           ENDIF
+            !
+        ENDIF
+         !                                            ! =============== !
+      ELSE                                            !      error      !
+         !                                            ! =============== !
+         WRITE(ctmp1,*) 'parameter , ntopo = ', ntopo
+         CALL ctl_stop( '    zgr_bat : '//trim(ctmp1) )
+      ENDIF
+      !
+      IF( nn_closea == 0 )   CALL clo_bat( bathy, mbathy )    !==  NO closed seas or lakes  ==!
+      !                       
+      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==!
+         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level
+         ELSE                          ;   ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )  ! from a depth
+         ENDIF
+         zhmin = gdepw_1d(ik+1)                                                         ! minimum depth = ik+1 w-levels 
+         WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands
+         ELSE WHERE                     ;   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans
+         END WHERE
+         IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_bat')
+      !
+   END SUBROUTINE zgr_bat
+
+
+   SUBROUTINE zgr_bat_zoom
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_zoom  ***
+      !!
+      !! ** Purpose : - Close zoom domain boundary if necessary
+      !!              - Suppress Med Sea from ORCA R2 and R05 arctic zoom
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integers
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_zoom : modify the level bathymetry for zoom domain'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~'
+      !
+      ! Zoom domain
+      ! ===========
+      !
+      ! Forced closed boundary if required
+      IF( lzoom_s )   mbathy(  : , mj0(jpjzoom):mj1(jpjzoom) )      = 0
+      IF( lzoom_w )   mbathy(      mi0(jpizoom):mi1(jpizoom) , :  ) = 0
+      IF( lzoom_e )   mbathy(      mi0(jpiglo+jpizoom-1):mi1(jpiglo+jpizoom-1) , :  ) = 0
+      IF( lzoom_n )   mbathy(  : , mj0(jpjglo+jpjzoom-1):mj1(jpjglo+jpjzoom-1) )      = 0
+      !
+      ! Configuration specific domain modifications
+      ! (here, ORCA arctic configuration: suppress Med Sea)
+      IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN
+         SELECT CASE ( jp_cfg )
+         !                                        ! =======================
+         CASE ( 2 )                               !  ORCA_R2 configuration
+            !                                     ! =======================
+            IF(lwp) WRITE(numout,*) '                   ORCA R2 arctic zoom: suppress the Med Sea'
+            ii0 = 141   ;   ii1 = 162      ! Sea box i,j indices
+            ij0 =  98   ;   ij1 = 110
+            !                                     ! =======================
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            !                                     ! =======================
+            IF(lwp) WRITE(numout,*) '                   ORCA R05 arctic zoom: suppress the Med Sea'
+            ii0 = 563   ;   ii1 = 642      ! zero over the Med Sea boxe
+            ij0 = 314   ;   ij1 = 370 
+         END SELECT
+         !
+         mbathy( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0   ! zero over the Med Sea boxe
+         !
+      ENDIF
+      !
+   END SUBROUTINE zgr_bat_zoom
+
+
+   SUBROUTINE zgr_bat_ctl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_ctl  ***
+      !!
+      !! ** 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.
+      !!      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  : - update mbathy: level bathymetry (in level index)
+      !!              - update bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jl                    ! dummy loop indices
+      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zbathy
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bat_ctl')
+      !
+      CALL wrk_alloc( jpi, jpj, zbathy )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_ctl : check the bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+      !                                          ! Suppress isolated ocean grid points
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points'
+      IF(lwp) WRITE(numout,*)'                   -----------------------------------'
+      icompt = 0
+      DO jl = 1, 2
+         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN
+            mbathy( 1 ,:) = mbathy(jpim1,:)           ! local domain is cyclic east-west
+            mbathy(jpi,:) = mbathy(  2  ,:)
+         ENDIF
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+                  &           mbathy(ji,jj-1), mbathy(ji,jj+1)  )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   &
+                     &   'grid-point (i,j) =  ',ji,jj,' is changed from ', mbathy(ji,jj),' to ', ibtest
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( icompt )
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+      IF( lk_mpp ) THEN
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+      ENDIF
+      !                                          ! East-west cyclic boundary conditions
+      IF( nperio == 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: nperio = ', nperio
+         IF( lk_mpp ) THEN
+            IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(1,:) = 0
+            ENDIF
+            IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(nlci,:) = 0
+            ENDIF
+         ELSE
+            IF( ln_zco .OR. ln_zps ) THEN
+               mbathy( 1 ,:) = 0
+               mbathy(jpi,:) = 0
+            ELSE
+               mbathy( 1 ,:) = jpkm1
+               mbathy(jpi,:) = jpkm1
+            ENDIF
+         ENDIF
+      ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio ==  6 ) THEN
+         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: nperio = ', nperio
+         mbathy( 1 ,:) = mbathy(jpim1,:)
+         mbathy(jpi,:) = mbathy(  2  ,:)
+      ELSEIF( nperio == 2 ) THEN
+         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: nperio = ', nperio
+      ELSE
+         IF(lwp) WRITE(numout,*) '    e r r o r'
+         IF(lwp) WRITE(numout,*) '    parameter , nperio = ', nperio
+         !         STOP 'dom_mba'
+      ENDIF
+      !  Boundary condition on mbathy
+      IF( .NOT.lk_mpp ) THEN 
+!!gm     !!bug ???  think about it !
+         !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+      ENDIF
+      ! Number of ocean level inferior or equal to jpkm1
+      ikmax = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikmax = MAX( ikmax, mbathy(ji,jj) )
+         END DO
+      END DO
+!!gm  !!! test to do:   ikmax = MAX( mbathy(:,:) )   ???
+      IF( ikmax > jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+         IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+      ELSE IF( ikmax < jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+         IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zbathy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_bat_ctl')
+      !
+   END SUBROUTINE zgr_bat_ctl
+
+
+   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), POINTER, DIMENSION(:,:) ::  zmbk
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bot_level')
+      !
+      CALL wrk_alloc( jpi, jpj, zmbk )
+      !
+      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 )
+      !
+      CALL wrk_dealloc( jpi, jpj, zmbk )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_bot_level')
+      !
+   END SUBROUTINE zgr_bot_level
+
+
+   SUBROUTINE zgr_top_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_top_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean top (mik. arrays)
+      !!
+      !! ** Method  :   computes from misfdep with a minimum value of 1
+      !!
+      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zmik
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_top_level')
+      !
+      CALL wrk_alloc( jpi, jpj, zmik )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_top_level : ocean top k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mikt(:,:) = MAX( misfdep(:,:) , 1 )    ! top k-index of T-level (=1)
+      !                                      ! top k-index of W-level (=mikt)
+      DO jj = 1, jpjm1                       ! top k-index of U- (U-) level
+         DO ji = 1, jpim1
+            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
+            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
+            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
+         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 
+      zmik(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk(zmik,'U',1.)   ;   miku  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      zmik(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk(zmik,'V',1.)   ;   mikv  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      zmik(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk(zmik,'F',1.)   ;   mikf  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      !
+      CALL wrk_dealloc( jpi, jpj, zmik )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_top_level')
+      !
+   END SUBROUTINE zgr_top_level
+
+
+   SUBROUTINE zgr_zco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the reference z-coordinate system
+      !!
+      !! ** Method  :   set 3D coord. arrays to reference 1D array 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zco')
+      !
+      DO jk = 1, jpk
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         gde3w_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3u_0  (:,:,jk) = e3t_1d  (jk)
+         e3v_0  (:,:,jk) = e3t_1d  (jk)
+         e3f_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+         e3uw_0 (:,:,jk) = e3w_1d  (jk)
+         e3vw_0 (:,:,jk) = e3w_1d  (jk)
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zco')
+      !
+   END SUBROUTINE zgr_zco
+
+
+   SUBROUTINE zgr_zps
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zps  ***
+      !!                     
+      !! ** Purpose :   the depth and vertical scale factor in partial step
+      !!              reference z-coordinate case
+      !!
+      !! ** Method  :   Partial steps : computes the 3D vertical scale factors
+      !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+      !!      a partial step representation of bottom topography.
+      !!
+      !!        The reference depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the reference vertical
+      !!      scale factors.
+      !!        From  depth and scale factors reference, we compute there new value
+      !!      with partial steps  on 3d arrays ( i, j, k ).
+      !!
+      !!              w-level: gdepw_0(i,j,k)  = gdep(k)
+      !!                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k)
+      !!              t-level: gdept_0(i,j,k)  = gdep(k+0.5)
+      !!                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
+      !!
+      !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+      !!      we find the mbathy index of the depth at each grid point.
+      !!      This leads us to three cases:
+      !!
+      !!              - bathy = 0 => mbathy = 0
+      !!              - 1 < mbathy < jpkm1    
+      !!              - bathy > gdepw_0(jpk) => mbathy = jpkm1  
+      !!
+      !!        Then, for each case, we find the new depth at t- and w- levels
+      !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+      !!      and f-points.
+      !! 
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!         c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives
+      !!         - - - - - - -   gdept_0, gdepw_0 and e3. are positives
+      !!      
+      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik, it, ikb, ikt ! temporary integers
+      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) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zmax             ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zps')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zprt )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
+      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+      ! e3t_1d is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+      END DO
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+      END DO
+      
+      ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf
+      IF ( ln_isfcav ) CALL zgr_isf
+
+      ! Scale factors and depth at T- and W-points
+      IF ( .NOT. ln_isfcav ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = mbathy(ji,jj)
+               IF( ik > 0 ) THEN               ! ocean point only
+                  ! max ocean level case
+                  IF( ik == jpkm1 ) THEN
+                     zdepwp = bathy(ji,jj)
+                     ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
+                     ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+                     e3t_0(ji,jj,ik  ) = ze3tp
+                     e3t_0(ji,jj,ik+1) = ze3tp
+                     e3w_0(ji,jj,ik  ) = ze3wp
+                     e3w_0(ji,jj,ik+1) = ze3tp
+                     gdepw_0(ji,jj,ik+1) = zdepwp
+                     gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                     !
+                  ELSE                         ! standard case
+                     IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+                     ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                     ENDIF
+   !gm Bug?  check the gdepw_1d
+                     !       ... on ik
+                     gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                        &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                        &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                     e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
+                        &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
+                     e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
+                        &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                     !       ... on ik+1
+                     e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                     e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                     gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         !
+         it = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = mbathy(ji,jj)
+               IF( ik > 0 ) THEN               ! ocean point only
+                  e3tp (ji,jj) = e3t_0(ji,jj,ik)
+                  e3wp (ji,jj) = e3w_0(ji,jj,ik)
+                  ! test
+                  zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
+                  IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                     it = it + 1
+                     WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                     WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                     WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                     WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      END IF
+      !
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u_0 (:,:,jk) = e3t_1d(jk)
+         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      IF ( ln_isfcav ) THEN
+      ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1   ! vector opt. 
+               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+            END DO
+         END DO
+      END IF
+
+      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp )
+      !
+
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+     
+      ! Compute gde3w_0 (vertical sum of e3w)
+      IF ( ln_isfcav ) THEN ! if cavity
+         WHERE( misfdep == 0 )   misfdep = 1
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
+               DO jk = 2, misfdep(ji,jj)
+                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+               END DO
+               IF( misfdep(ji,jj) >= 2 )   gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
+               DO jk = misfdep(ji,jj) + 1, jpk
+                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+               END DO
+            END DO
+         END DO
+      ELSE ! no cavity
+         gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
+         DO jk = 2, jpk
+            gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk)
+         END DO
+      END IF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zprt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
+      !
+   END SUBROUTINE zgr_zps
+
+
+   SUBROUTINE zgr_isf
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_isf  ***
+      !!   
+      !! ** Purpose :   check the bathymetry in levels
+      !!   
+      !! ** Method  :   THe water column have to contained at least 2 cells
+      !!                Bathymetry and isfdraft are modified (dig/close) to respect
+      !!                this criterion.
+      !!   
+      !! ** Action  : - test compatibility between isfdraft and bathy 
+      !!              - bathy and isfdraft are modified
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jk       ! dummy loop indices
+      INTEGER  ::   ik, it               ! temporary integers
+      INTEGER  ::   icompt, ibtest       ! (ISF)
+      INTEGER  ::   ibtestim1, ibtestip1 ! (ISF)
+      INTEGER  ::   ibtestjm1, ibtestjp1 ! (ISF)
+      REAL(wp) ::   zdepth           ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zmax             ! Maximum and minimum depth
+      REAL(wp) ::   zbathydiff       ! isf temporary scalar
+      REAL(wp) ::   zrisfdepdiff     ! isf temporary scalar
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp           ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH)
+      INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH)
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('zgr_isf')
+      !
+      CALL wrk_alloc( jpi,jpj,   zbathy, zmask, zrisfdep)
+      CALL wrk_alloc( jpi,jpj,   zmisfdep, zmbathy )
+
+      ! (ISF) compute misfdep
+      WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1  
+      ELSEWHERE                      ;                         misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level 
+      END WHERE  
+
+      ! Compute misfdep for ocean points (i.e. first wet level) 
+      ! find the first ocean level such that the first level thickness 
+      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
+      ! e3t_0 is the reference level thickness 
+      DO jk = 2, jpkm1 
+         zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
+         WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1 
+      END DO 
+      WHERE ( 0._wp < risfdep(:,:) .AND. risfdep(:,:) <= e3t_1d(1) )
+         risfdep(:,:) = 0. ; misfdep(:,:) = 1
+      END WHERE
+
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE (risfdep(:,:) <= 10._wp .AND. misfdep(:,:) > 1)
+         misfdep = 0; risfdep = 0.0_wp;
+         mbathy  = 0; bathy   = 0.0_wp;
+      END WHERE
+      WHERE (bathy(:,:) <= 30.0_wp .AND. gphit < -60._wp)
+         misfdep = 0; risfdep = 0.0_wp;
+         mbathy  = 0; bathy   = 0.0_wp;
+      END WHERE
+ 
+! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation
+      icompt = 0 
+! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together
+      DO jl = 1, 10     
+         ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments)
+         WHERE (bathy(:,:) <= risfdep(:,:) + rn_isfhmin)
+            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp
+            mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp
+         END WHERE
+         WHERE (mbathy(:,:) <= 0) 
+            misfdep(:,:) = 0; risfdep(:,:) = 0._wp 
+            mbathy (:,:) = 0; bathy  (:,:) = 0._wp
+         END WHERE
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
+            misfdep( 1 ,:) = misfdep(jpim1,:)            ! local domain is cyclic east-west 
+            misfdep(jpi,:) = misfdep(  2  ,:) 
+            mbathy( 1 ,:)  = mbathy(jpim1,:)             ! local domain is cyclic east-west
+            mbathy(jpi,:)  = mbathy(  2  ,:)
+         ENDIF
+
+         ! split last cell if possible (only where water column is 2 cell or less)
+         ! if coupled to ice sheet, we do not modify the bathymetry (can be discuss).
+         IF ( .NOT. ln_iscpl) THEN
+            DO jk = jpkm1, 1, -1
+               zmax = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+               WHERE( gdepw_1d(jk) < bathy(:,:) .AND. bathy(:,:) <= zmax .AND. misfdep + 1 >= mbathy)
+                  mbathy(:,:) = jk
+                  bathy(:,:)  = zmax
+               END WHERE
+            END DO
+         END IF
+ 
+         ! split top cell if possible (only where water column is 2 cell or less)
+         DO jk = 2, jpkm1
+            zmax = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+            WHERE( gdepw_1d(jk+1) > risfdep(:,:) .AND. risfdep(:,:) >= zmax .AND. misfdep + 1 >= mbathy)
+               misfdep(:,:) = jk
+               risfdep(:,:) = zmax
+            END WHERE
+         END DO
+
+ 
+ ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF (risfdep(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN
+                     zbathydiff  =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) &
+                         &            + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) &
+                         &            - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )))
+                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN
+                        IF (zbathydiff <= zrisfdepdiff) THEN
+                           bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat )
+                           mbathy(ji,jj)= mbathy(ji,jj) + 1
+                        ELSE
+                           risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )
+                           misfdep(ji,jj) = misfdep(ji,jj) - 1
+                        END IF
+                     ENDIF
+                  ELSE
+                     IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN
+                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )
+                        misfdep(ji,jj) = misfdep(ji,jj) - 1
+                     END IF
+                  END IF
+               END IF
+            END DO
+         END DO
+ 
+         ! At least 2 levels for water thickness at T, U, and V point.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(bathy(ji,jj)   - ( gdepw_1d(mbathy (ji,jj)+1) &
+                         &                             + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj) - ( gdepw_1d(misfdep(ji,jj)  ) & 
+                         &                             - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy(ji,jj) = mbathy(ji,jj) + 1
+                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj)= misfdep(ji,jj) - 1
+                        risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj)= misfdep(ji,jj) - 1
+                     risfdep(ji,jj)= gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+ 
+ ! point V mbathy(ji,jj) == misfdep(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(bathy(ji,jj    ) - ( gdepw_1d(mbathy (ji,jj)+1) &
+                          &                              + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj+1) - ( gdepw_1d(misfdep(ji,jj+1)) &
+                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy(ji,jj) = mbathy(ji,jj) + 1
+                        bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1
+                        risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1
+                     risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+ 
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+ ! point V misdep(ji,jj) == mbathy(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(  bathy(ji,jj+1) - ( gdepw_1d(mbathy (ji,jj+1)+1) &
+                           &                             + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji,jj  ) - ( gdepw_1d(misfdep(ji,jj  )  ) &
+                           &                             - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1
+                        bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj)   = misfdep(ji,jj) - 1
+                        risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj)   = misfdep(ji,jj) - 1
+                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+ 
+ 
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF 
+ 
+ ! point U mbathy(ji,jj) == misfdep(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                  zbathydiff  =ABS(  bathy(ji  ,jj) - ( gdepw_1d(mbathy (ji,jj)+1) &
+                       &                              + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat )))
+                  zrisfdepdiff=ABS(risfdep(ji+1,jj) - ( gdepw_1d(misfdep(ji+1,jj)) &
+                       &                              - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat )))
+                  IF (zbathydiff <= zrisfdepdiff) THEN
+                     mbathy(ji,jj) = mbathy(ji,jj) + 1
+                     bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat )
+                  ELSE
+                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1
+                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat )
+                  END IF
+                  ELSE
+                     misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1
+                     risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat )
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF 
+ 
+ ! point U misfdep(ji,jj) == bathy(ji,jj+1) 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) > 1) THEN
+                  IF ( .NOT. ln_iscpl ) THEN 
+                     zbathydiff  =ABS(  bathy(ji+1,jj) - ( gdepw_1d(mbathy (ji+1,jj)+1) &
+                          &                              + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat )))
+                     zrisfdepdiff=ABS(risfdep(ji  ,jj) - ( gdepw_1d(misfdep(ji  ,jj)  ) &
+                          &                              - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat )))
+                     IF (zbathydiff <= zrisfdepdiff) THEN
+                        mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1
+                        bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat )
+                     ELSE
+                        misfdep(ji,jj)   = misfdep(ji  ,jj) - 1
+                        risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat )
+                     END IF
+                  ELSE
+                     misfdep(ji,jj)   = misfdep(ji  ,jj) - 1
+                     risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat )
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+      END DO
+      ! end dig bathy/ice shelf to be compatible
+      ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness
+      DO jl = 1,20
+ 
+ ! remove single point "bay" on isf coast line in the ice shelf draft'
+         DO jk = 2, jpk
+            WHERE (misfdep==0) misfdep=jpk
+            zmask=0._wp
+            WHERE (misfdep <= jk) zmask=1
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF (misfdep(ji,jj) == jk) THEN
+                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1)
+                     IF (ibtest <= 1) THEN
+                        risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1
+                        IF (misfdep(ji,jj) > mbathy(ji,jj)) misfdep(ji,jj) = jpk
+                     END IF
+                  END IF
+               END DO
+            END DO
+         END DO
+         WHERE (misfdep==jpk)
+             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp
+         END WHERE
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+ 
+ ! remove single point "bay" on bathy coast line beneath an ice shelf'
+         DO jk = jpk,1,-1
+            zmask=0._wp
+            WHERE (mbathy >= jk ) zmask=1
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  IF (mbathy(ji,jj) == jk .AND. misfdep(ji,jj) >= 2) THEN
+                     ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1)
+                     IF (ibtest <= 1) THEN
+                        bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1
+                        IF (misfdep(ji,jj) > mbathy(ji,jj)) mbathy(ji,jj) = 0
+                     END IF
+                  END IF
+               END DO
+            END DO
+         END DO
+         WHERE (mbathy==0)
+             misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp
+         END WHERE
+         IF( lk_mpp ) THEN
+            zbathy(:,:)  = FLOAT( misfdep(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            misfdep(:,:) = INT( zbathy(:,:) )
+
+            CALL lbc_lnk( risfdep,'T', 1. )
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:)  = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:)  = INT( zbathy(:,:) )
+         ENDIF
+ 
+ ! fill hole in ice shelf
+         zmisfdep = misfdep
+         zrisfdep = risfdep
+         WHERE (zmisfdep <= 1._wp) zmisfdep=jpk
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  )
+               ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1)
+               IF( zmisfdep(ji,jj) >= mbathy(ji-1,jj  ) ) ibtestim1 = jpk
+               IF( zmisfdep(ji,jj) >= mbathy(ji+1,jj  ) ) ibtestip1 = jpk
+               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj-1) ) ibtestjm1 = jpk
+               IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj+1) ) ibtestjp1 = jpk
+               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == jpk .AND. misfdep(ji,jj) >= 2) THEN
+                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp
+               END IF
+               IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) >= 2) THEN
+                  misfdep(ji,jj) = ibtest
+                  risfdep(ji,jj) = gdepw_1d(ibtest)
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy,  'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep, 'T', 1. ) 
+            CALL lbc_lnk( bathy,   'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy,  'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ !
+ !! fill hole in bathymetry
+         zmbathy (:,:)=mbathy (:,:)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  )
+               ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1)
+               IF( zmbathy(ji,jj) <  misfdep(ji-1,jj  ) ) ibtestim1 = 0
+               IF( zmbathy(ji,jj) <  misfdep(ji+1,jj  ) ) ibtestip1 = 0
+               IF( zmbathy(ji,jj) <  misfdep(ji  ,jj-1) ) ibtestjm1 = 0
+               IF( zmbathy(ji,jj) <  misfdep(ji  ,jj+1) ) ibtestjp1 = 0
+               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == 0 .AND. misfdep(ji,jj) >= 2) THEN
+                  mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ;
+               END IF
+               IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) >= 2) THEN
+                  mbathy(ji,jj) = ibtest
+                  bathy(ji,jj)  = gdepw_1d(ibtest+1) 
+               ENDIF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy,  'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep, 'T', 1. ) 
+            CALL lbc_lnk( bathy,   'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy,  'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN
+                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy,  'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep, 'T', 1. ) 
+            CALL lbc_lnk( bathy,   'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy,  'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN
+                  mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy, 'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep,'T', 1. ) 
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN
+                  mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy, 'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep,'T', 1. ) 
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpjm1
+            DO ji = 1, jpi
+               IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN
+                  mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) = gdepw_1d(mbathy(ji,jj+1)+1) ;
+               END IF
+            END DO
+         END DO
+         IF( lk_mpp ) THEN 
+            zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
+            CALL lbc_lnk( zbathy, 'T', 1. ) 
+            misfdep(:,:) = INT( zbathy(:,:) ) 
+
+            CALL lbc_lnk( risfdep,'T', 1. ) 
+            CALL lbc_lnk( bathy,  'T', 1. )
+
+            zbathy(:,:) = FLOAT( mbathy(:,:) )
+            CALL lbc_lnk( zbathy, 'T', 1. )
+            mbathy(:,:) = INT( zbathy(:,:) )
+         ENDIF 
+ ! if not compatible after all check, mask T
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (mbathy(ji,jj) <= misfdep(ji,jj)) THEN
+                  misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0._wp ; mbathy(ji,jj)  = 0 ; bathy(ji,jj)   = 0._wp ;
+               END IF
+            END DO
+         END DO
+ 
+         WHERE (mbathy(:,:) == 1)
+            mbathy = 0; bathy = 0.0_wp ; misfdep = 0 ; risfdep = 0.0_wp
+         END WHERE
+      END DO 
+! end check compatibility ice shelf/bathy
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE (risfdep(:,:) <= 10._wp)
+         misfdep = 1; risfdep = 0.0_wp;
+      END WHERE
+
+      IF( icompt == 0 ) THEN 
+         IF(lwp) WRITE(numout,*)'     no points with ice shelf too close to bathymetry' 
+      ELSE 
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points with ice shelf thickness reduced to avoid bathymetry' 
+      ENDIF 
+
+      ! compute scale factor and depth at T- and W- points
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
+                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+                  e3t_0(ji,jj,ik  ) = ze3tp
+                  e3t_0(ji,jj,ik+1) = ze3tp
+                  e3w_0(ji,jj,ik  ) = ze3wp
+                  e3w_0(ji,jj,ik+1) = ze3tp
+                  gdepw_0(ji,jj,ik+1) = zdepwp
+                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                  ENDIF
+      !            gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+!gm Bug?  check the gdepw_1d
+                  !       ... on ik
+                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                  e3t_0  (ji,jj,ik  ) = gdepw_0(ji,jj,ik+1) - gdepw_1d(ik  )
+                  e3w_0  (ji,jj,ik  ) = gdept_0(ji,jj,ik  ) - gdept_1d(ik-1)
+                  !       ... on ik+1
+                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               e3tp (ji,jj) = e3t_0(ji,jj,ik)
+               e3wp (ji,jj) = e3w_0(ji,jj,ik)
+               ! test
+               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
+               IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      ! (ISF) Definition of e3t, u, v, w for ISF case
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = misfdep(ji,jj) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik) 
+               gdepw_0(ji,jj,ik) = risfdep(ji,jj) 
+!gm Bug?  check the gdepw_0 
+            !       ... on ik 
+               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   & 
+                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   & 
+                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      ) 
+               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) 
+               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
+
+               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
+                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik) 
+               ENDIF 
+            !       ... on ik / ik-1 
+               e3w_0  (ji,jj,ik  ) = e3t_0  (ji,jj,ik) !2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
+               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
+! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
+               gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
+            ENDIF 
+         END DO 
+      END DO 
+   
+      it = 0 
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = misfdep(ji,jj) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               e3tp (ji,jj) = e3t_0(ji,jj,ik  ) 
+               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 ) 
+            ! test 
+               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  ) 
+               IF( zdiff <= 0. .AND. lwp ) THEN  
+                  it = it + 1 
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
+                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj) 
+                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
+                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj) 
+               ENDIF 
+            ENDIF 
+         END DO 
+      END DO 
+
+      CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep )
+      CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('zgr_isf')
+      !      
+   END SUBROUTINE zgr_isf
+
+
+   SUBROUTINE zgr_sco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_sco  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            z_gsigt(k) = fssig (k    )
+      !!            z_gsigw(k) = fssig (k-0.5)
+      !!            z_esigt(k) = fsdsig(k    )
+      !!            z_esigw(k) = fsdsig(k-0.5)
+      !!      Three options for stretching are give, and they can be modified
+      !!      following the users requirements. Nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!      The three methods for stretching available are:
+      !! 
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !! 
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates        
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+      INTEGER  ::   ios                      ! Local integer output status for namelist read
+      REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+      REAL(wp) ::   zrfact
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+      !!
+      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+         &                rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+     !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_sco')
+      !
+      CALL wrk_alloc( jpi,jpj,   zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )
+      !
+      REWIND( numnam_ref )              ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters
+      READ  ( numnam_ref, namzgr_sco, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr_sco in configuration namelist : Sigma-stretching parameters
+      READ  ( numnam_cfg, namzgr_sco, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr_sco )
+
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr_sco : s-coordinate or hybrid z-s-coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr_sco'
+         WRITE(numout,*) '     stretching coeffs '
+         WRITE(numout,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+         WRITE(numout,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+         WRITE(numout,*) '        Critical depth                               rn_hc         = ',rn_hc
+         WRITE(numout,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+         WRITE(numout,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+         WRITE(numout,*) '        Song and Haidvogel 1994 stretching coefficients'
+         WRITE(numout,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+         WRITE(numout,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+         WRITE(numout,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+         WRITE(numout,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+         WRITE(numout,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+         WRITE(numout,*) '        Siddorn and Furner 2012 stretching coefficients'
+         WRITE(numout,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+         WRITE(numout,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+         WRITE(numout,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+         WRITE(numout,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+         WRITE(numout,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+         WRITE(numout,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+      ENDIF
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+            END DO
+         END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( bathy(ji,jj) == 0._wp ) THEN
+                  iip1 = MIN( ji+1, jpi )
+                  ijp1 = MIN( jj+1, jpj )
+                  iim1 = MAX( ji-1, 1 )
+                  ijm1 = MAX( jj-1, 1 )
+!!gm BUG fix see ticket #1617
+                  IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1)              &
+                     &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )              &
+                     &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) &
+                     &    zenv(ji,jj) = rn_sbot_min
+!!gm
+!!gm               IF( ( bathy(iip1,jj  ) + bathy(iim1,jj  ) + bathy(ji,ijp1  ) + bathy(ji,ijm1) +         &
+!!gm                  &  bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
+!!gm               zenv(ji,jj) = rn_sbot_min
+!!gm             ENDIF
+!!gm end
+              ENDIF
+            END DO
+         END DO
+
+      ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+      CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' )
+      ! 
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1._wp
+      !   
+      !     
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1._wp
+      zrj(:,:) = 1._wp
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0._wp
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0._wp
+         zrj(:,:) = 0._wp
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' )
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( 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._wp)**2._wp )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      IF(lwp) THEN
+         WRITE(numout,*)
+           WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      ENDIF
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1   ! NO vector opt.
+           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
+
+      ! 
+      ! 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._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               !No worries about the following line when ln_wd == .true.
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            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._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            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
+      END DO
+
+!!bug:  key_helsinki a verifer
+        hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+        hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+        hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+        hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      ENDIF
+!! helsinki
+
+      !                                            ! =======================
+      !                                            !   s-ccordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)                    
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN 
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE                 
+                           CALL s_tanh()
+      ENDIF 
+
+      CALL lbc_lnk( e3t_0 , 'T', 1._wp )
+      CALL lbc_lnk( e3u_0 , 'U', 1._wp )
+      CALL lbc_lnk( e3v_0 , 'V', 1._wp )
+      CALL lbc_lnk( e3f_0 , 'F', 1._wp )
+      CALL lbc_lnk( e3w_0 , 'W', 1._wp )
+      CALL lbc_lnk( e3uw_0, 'U', 1._wp )
+      CALL lbc_lnk( e3vw_0, 'V', 1._wp )
+      !
+        WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp
+        WHERE( e3u_0 (:,:,:) == 0._wp )   e3u_0 (:,:,:) = 1._wp
+        WHERE( e3v_0 (:,:,:) == 0._wp )   e3v_0 (:,:,:) = 1._wp
+        WHERE( e3f_0 (:,:,:) == 0._wp )   e3f_0 (:,:,:) = 1._wp
+        WHERE( e3w_0 (:,:,:) == 0._wp )   e3w_0 (:,:,:) = 1._wp
+        WHERE( e3uw_0(:,:,:) == 0._wp )   e3uw_0(:,:,:) = 1._wp
+        WHERE( e3vw_0(:,:,:) == 0._wp )   e3vw_0(:,:,:) = 1._wp
+
+
+!!gm   I don't like that HERE we are supposed to set the reference coordinate (i.e. _0 arrays)
+!!gm   and only that !!!!!
+!!gm   THIS should be removed from here !
+      gdept_n(:,:,:) = gdept_0(:,:,:)
+      gdepw_n(:,:,:) = gdepw_0(:,:,:)
+      gde3w_n(:,:,:) = gde3w_0(:,:,:)
+      e3t_n  (:,:,:) = e3t_0  (:,:,:)
+      e3u_n  (:,:,:) = e3u_0  (:,:,:)
+      e3v_n  (:,:,:) = e3v_0  (:,:,:)
+      e3f_n  (:,:,:) = e3f_0  (:,:,:)
+      e3w_n  (:,:,:) = e3w_0  (:,:,:)
+      e3uw_n (:,:,:) = e3uw_0 (:,:,:)
+      e3vw_n (:,:,:) = e3vw_0 (:,:,:)
+!!gm and obviously in the following, use the _0 arrays until the end of this subroutine
+!! gm end
+!!
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+            END DO
+         END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+
+      IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)    ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w '  , MINVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0 (:,:,:) ),   &
+            &                          ' w ', MINVAL( e3w_0  (:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w '  , MAXVAL( gde3w_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0 (:,:,:) ),   &
+            &                          ' w ', MAXVAL( e3w_0  (:,:,:) )
+      ENDIF
+      !  END DO
+      IF(lwp) THEN                                  ! selected vertical profiles
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1)
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(1,1,jk), gdepw_0(1,1,jk),     &
+            &                                 e3t_0 (1,1,jk) , e3w_0 (1,1,jk) , jk=1,jpk )
+         DO jj = mj0(20), mj1(20)
+            DO ji = mi0(20), mi1(20)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     &
+                  &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+            END DO
+         END DO
+         DO jj = mj0(74), mj1(74)
+            DO ji = mi0(100), mi1(100)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     &
+                  &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+            END DO
+         END DO
+      ENDIF
+      !
+      !================================================================================
+      ! check the coordinate makes sense
+      !================================================================================
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            !
+            IF( hbatt(ji,jj) > 0._wp) THEN
+               DO jk = 1, mbathy(ji,jj)
+                 ! check coordinate is monotonically increasing
+                 IF (e3w_n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'e3w',e3w_n(ji,jj,:)
+                    WRITE(numout,*) 'e3t',e3t_n(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it has never gone negative
+                 IF( gdepw_n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:)
+                    WRITE(numout,*) 'gdept',gdept_n(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it never exceeds the total depth
+                 IF( gdepw_n(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+               !
+               DO jk = 1, mbathy(ji,jj)-1
+                 ! and check it never exceeds the total depth
+                IF( gdept_n(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdept',gdept_n(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+            ENDIF
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco')
+      !
+   END SUBROUTINE zgr_sco
+
+
+   SUBROUTINE s_sh94()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994. 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp) ::   ztmpu,  ztmpv,  ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_alloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp 
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+      !
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            !
+            IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                  z_gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+               END DO
+            ELSE ! shallow water, uniform sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                  z_gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+            ENDIF
+            !
+            DO jk = 1, jpkm1
+               z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+               z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+            END DO
+            z_esigw3(ji,jj,1  ) = 2._wp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) )
+            z_esigt3(ji,jj,jpk) = 2._wp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) )
+            !
+            ! Coefficients for vertical depth as the sum of e3w scale factors
+            z_gsi3w3(ji,jj,1) = 0.5_wp * z_esigw3(ji,jj,1)
+            DO jk = 2, jpk
+               z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+            END DO
+            !
+            DO jk = 1, jpk
+               zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+               gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+               gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+               gde3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
+            END DO
+           !
+         END DO   ! for all jj's
+      END DO    ! for all ji's
+
+      DO ji = 1, jpim1
+         DO jj = 1, jpjm1
+            ! extended for Wetting/Drying case
+            ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+            ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+            ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+            ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+            ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+            ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                   & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+            DO jk = 1, jpk
+                 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+                 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+
+                 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+                 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+
+                 z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                        &            +   hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                        &            +   hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                        &            +   hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+
+               !
+               e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               !
+               e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+            END DO
+        END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
+   END SUBROUTINE s_sh94
+
+
+   SUBROUTINE s_sf12
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 *** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      REAL(wp) ::   ztmpu, ztmpv, ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp 
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+          IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              
+              zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+              zzb = 1.0_wp-(zzb/hbatt(ji,jj))
+            
+              zzs = rn_zs / hbatt(ji,jj) 
+              
+              IF (rn_efold /= 0.0_wp) THEN
+                zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+              ELSE
+                zsmth = 1.0_wp 
+              ENDIF
+               
+              DO jk = 1, jpk
+                z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)
+              ENDDO
+              z_gsigw3(ji,jj,:) = fgamma( z_gsigw3(ji,jj,:), zzb, zzs, zsmth  )
+              z_gsigt3(ji,jj,:) = fgamma( z_gsigt3(ji,jj,:), zzb, zzs, zsmth  )
+ 
+          ELSE IF (ln_sigcrit) THEN ! shallow water, uniform sigma
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+            END DO
+
+          ELSE  ! shallow water, z coordinates
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+            END DO
+
+          ENDIF
+
+          DO jk = 1, jpkm1
+             z_esigt3(ji,jj,jk) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+             z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+          END DO
+          z_esigw3(ji,jj,1  ) = 2.0_wp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ))
+          z_esigt3(ji,jj,jpk) = 2.0_wp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk))
+
+          ! Coefficients for vertical depth as the sum of e3w scale factors
+          z_gsi3w3(ji,jj,1) = 0.5 * z_esigw3(ji,jj,1)
+          DO jk = 2, jpk
+             z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+          END DO
+
+          DO jk = 1, jpk
+             gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)
+             gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)
+             gde3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk)
+          END DO
+
+        ENDDO   ! for all jj's
+      ENDDO    ! for all ji's
+
+      DO ji=1,jpi-1
+        DO jj=1,jpj-1
+
+           ! extend to suit for Wetting/Drying case
+           ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+           ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+           ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+           ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+           ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+           ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                  & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+           DO jk = 1, jpk
+                z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+                z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+
+                z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                       &              + hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                       &              + hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                       &              + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+
+             ! Code prior to wetting and drying option (for reference)
+             !z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                                 &
+             !                    &  +hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                                 &
+             !                       +hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                                 &
+             !                    &  +hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )                               &
+             !                     /( hbatt(ji  ,jj  )+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+
+             e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)
+             e3u_0(ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk)
+             e3v_0(ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk)
+             e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk)
+             !
+             e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)
+             e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk)
+             e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk)
+          END DO
+
+        ENDDO
+      ENDDO
+      !
+      CALL lbc_lnk(e3t_0 ,'T',1.) ; CALL lbc_lnk(e3u_0 ,'T',1.)
+      CALL lbc_lnk(e3v_0 ,'T',1.) ; CALL lbc_lnk(e3f_0 ,'T',1.)
+      CALL lbc_lnk(e3w_0 ,'T',1.)
+      CALL lbc_lnk(e3uw_0,'T',1.) ; CALL lbc_lnk(e3vw_0,'T',1.)
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      )
+      CALL wrk_dealloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
+   END SUBROUTINE s_sf12
+
+
+   SUBROUTINE s_tanh()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh*** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch 
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w
+      REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpk,   z_gsigw, z_gsigt, z_gsi3w )
+      CALL wrk_alloc( jpk,   z_esigt, z_esigw )
+
+      z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp   ;   z_gsi3w  = 0._wp
+      z_esigt  = 0._wp   ;   z_esigw  = 0._wp 
+
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpkm1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2._wp * ( z_gsigt(1  ) - z_gsigw(1  ) ) 
+      z_esigt(jpk) = 2._wp * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      z_gsi3w(1) = 0.5_wp * z_esigw(1)
+      DO jk = 2, jpk
+         z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk)
+      END DO
+!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
+      DO jk = 1, jpk
+         zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+         zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+         gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )
+         gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )
+         gde3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft )
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+              e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+              e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+              !
+              e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpk,   z_gsigw, z_gsigt, z_gsi3w )
+      CALL wrk_dealloc( jpk,   z_esigt, z_esigw          )
+      !
+   END SUBROUTINE s_tanh
+
+
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      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._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      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_wp ) / REAL( jpkm1 )
+      ELSE                        ! stretched sigma
+         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
+      !
+   END FUNCTION fssig1
+
+
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter
+      !
+      INTEGER  ::   jk             ! dummy loop index
+      REAL(wp) ::   za1,za2,za3    ! local scalar
+      REAL(wp) ::   zn1,zn2        !   -      - 
+      REAL(wp) ::   za,zb,zx       !   -      - 
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1._wp / REAL( jpkm1, wp )
+      zn2  =  1._wp -  zn1
+      !
+      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) 
+      za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp)
+      za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1)
+      !
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) )
+      zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1)
+      zx = 1.0_wp-za/2.0_wp-zb
+      !
+      DO jk = 1, jpk
+         p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  &
+            &          zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &
+            &               (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )
+        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth)
+      END DO
+      !
+   END FUNCTION fgamma
+
+   !!======================================================================
+END MODULE domzgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dtatsd.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dtatsd.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/dtatsd.f90	(revision 8732)
@@ -0,0 +1,265 @@
+MODULE dtatsd
+   !!======================================================================
+   !!                     ***  MODULE  dtatsd  ***
+   !! Ocean data  :  read ocean Temperature & Salinity Data from gridded 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
+   !!            3.4  ! 2010-11  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dta_tsd      : read and time interpolated ocean Temperature & Salinity Data
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE fldread         ! read input fields
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dta_tsd_init   ! called by opa.F90
+   PUBLIC   dta_tsd        ! called by istate.F90 and tradmp.90
+
+   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag
+   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dtatsd.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dta_tsd_init( ld_tradmp )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_tsd_init  ***
+      !!                    
+      !! ** Purpose :   initialisation of T & S input data 
+      !! 
+      !! ** Method  : - Read namtsd namelist
+      !!              - allocates T & S data structure 
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used
+      !
+      INTEGER ::   ierr0, ierr1, ierr2, ierr3   ! temporary integers
+      !
+      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read
+      TYPE(FLD_N)                   ::   sn_tem, sn_sal
+      !!
+      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal
+      INTEGER  ::   ios
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init')
+      !
+      !  Initialisation
+      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
+      !
+      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist : 
+      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namtsd )
+
+      IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
+         WRITE(numout,*) '~~~~~~~~~~~~ '
+         WRITE(numout,*) '   Namelist namtsd'
+         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init   = ', ln_tsd_init
+         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_tradmp = ', ln_tsd_tradmp
+         WRITE(numout,*)
+         IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_tradmp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '   T & S data not used'
+         ENDIF
+      ENDIF
+      !
+      IF( ln_rstart .AND. ln_tsd_init ) THEN
+         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
+            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
+         ln_tsd_init = .FALSE.
+      ENDIF
+      !
+      !                             ! allocate the arrays (if necessary)
+      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN
+         !
+         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
+         IF( ierr0 > 0 ) THEN
+            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
+         ENDIF
+         !
+                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
+         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
+         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+         !
+         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
+            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
+         ENDIF
+         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
+         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
+         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init')
+      !
+   END SUBROUTINE dta_tsd_init
+
+
+   SUBROUTINE dta_tsd( kt, ptsd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_tsd  ***
+      !!                    
+      !! ** Purpose :   provides T and S data at kt
+      !! 
+      !! ** Method  : - call fldread routine
+      !!              - ORCA_R2: add some hand made alteration to read data  
+      !!              - 'key_orca_lev10' interpolates on 10 times more levels
+      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
+      !!              - ln_tsd_tradmp=F: deallocates the T-S data structure
+      !!                as T-S data are no are used
+      !!
+      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
+      !
+      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
+      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
+      REAL(wp)::   zl, zi
+      REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dta_tsd')
+      !
+      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
+      !
+      !
+      !                                   !==   ORCA_R2 configuration and T & S damping   ==! 
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations
+         !
+         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
+         ii0 = 141   ;   ii1 = 155
+         DO jj = mj0(ij0), mj1(ij1)
+            DO ji = mi0(ii0), mi1(ii1)
+               sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
+               sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
+               sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
+               !
+               sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
+               sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
+               sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
+               sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
+            END DO
+         END DO
+         ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
+         ii0 = 148   ;   ii1 = 160
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
+         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
+      ENDIF
+      !
+      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
+      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
+      !
+      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
+         !
+         CALL wrk_alloc( jpk, ztp, zsp )
+         !
+         IF( kt == nit000 .AND. lwp )THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
+         ENDIF
+         !
+         DO jj = 1, jpj                         ! vertical interpolation of T & S
+            DO ji = 1, jpi
+               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
+                  zl = gdept_0(ji,jj,jk)
+                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
+                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
+                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
+                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
+                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
+                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
+                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
+                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
+                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
+                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
+                        ENDIF
+                     END DO
+                  ENDIF
+               END DO
+               DO jk = 1, jpkm1
+                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
+               END DO
+               ptsd(ji,jj,jpk,jp_tem) = 0._wp
+               ptsd(ji,jj,jpk,jp_sal) = 0._wp
+            END DO
+         END DO
+         ! 
+         CALL wrk_dealloc( jpk, ztp, zsp )
+         ! 
+      ELSE                                !==   z- or zps- coordinate   ==!
+         !                             
+         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
+         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
+         !
+         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ik = mbkt(ji,jj) 
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
+                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
+                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
+                  ENDIF
+                  ik = mikt(ji,jj)
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
+                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
+                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
+                  END IF
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==! 
+         !                                              (data used only for initialisation)
+         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
+                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
+         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
+                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
+         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
+                                        DEALLOCATE( sf_tsd              )     ! the structure itself
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd')
+      !
+   END SUBROUTINE dta_tsd
+
+   !!======================================================================
+END MODULE dtatsd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/eosbn2.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/eosbn2.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/eosbn2.f90	(revision 8732)
@@ -0,0 +1,1647 @@
+MODULE eosbn2
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
+   !!==============================================================================
+   !! History :  OPA  ! 1989-03  (O. Marti)  Original code
+   !!            6.0  ! 1994-07  (G. Madec, M. Imbard)  add bn2
+   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos
+   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3
+   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass
+   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+   !!            8.2  ! 2001-09  (M. Ben Jelloul)  bugfix on linear eos
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  add eos_init
+   !!             -   ! 2002-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
+   !!             -   ! 2003-08  (G. Madec)  F90, free form
+   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function (now eos_fzp function)
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add alpha/beta used in ldfslp
+   !!            3.7  ! 2012-03  (F. Roquet, G. Madec)  add primitive of alpha and beta used in PE computation
+   !!             -   ! 2012-05  (F. Roquet)  add Vallis and original JM95 equation of state
+   !!             -   ! 2013-04  (F. Roquet, G. Madec)  add eos_rab, change bn2 computation and reorganize the module
+   !!             -   ! 2014-09  (F. Roquet)  add TEOS-10, S-EOS, and modify EOS-80
+   !!             -   ! 2015-06  (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   eos           : generic interface of the equation of state
+   !!   eos_insitu    : Compute the in situ density
+   !!   eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
+   !!   eos_insitu_2d : Compute the in situ density for 2d fields
+   !!   bn2           : Compute the Brunt-Vaisala frequency
+   !!   eos_rab       : generic interface of in situ thermal/haline expansion ratio 
+   !!   eos_rab_3d    : compute in situ thermal/haline expansion ratio
+   !!   eos_rab_2d    : compute in situ thermal/haline expansion ratio for 2d fields
+   !!   eos_fzp_2d    : freezing temperature for 2d fields
+   !!   eos_fzp_0d    : freezing temperature for scalar
+   !!   eos_init      : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE timing         ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !                  !! * Interface
+   INTERFACE eos
+      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+   END INTERFACE
+   !
+   INTERFACE eos_rab
+      MODULE PROCEDURE rab_3d, rab_2d, rab_0d
+   END INTERFACE
+   !
+   INTERFACE eos_fzp 
+      MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d
+   END INTERFACE
+   !
+   PUBLIC   eos            ! called by step, istate, tranpc and zpsgrd modules
+   PUBLIC   bn2            ! called by step module
+   PUBLIC   eos_rab        ! called by ldfslp, zdfddm, trabbl
+   PUBLIC   eos_pt_from_ct ! called by sbcssm
+   PUBLIC   eos_fzp        ! called by traadv_cen2 and sbcice_... modules
+   PUBLIC   eos_pen        ! used for pe diagnostics in trdpen module
+   PUBLIC   eos_init       ! called by istate module
+
+   !                               !!** Namelist nameos **
+   LOGICAL , PUBLIC ::   ln_TEOS10   ! determine if eos_pt_from_ct is used to compute sst_m
+   LOGICAL , PUBLIC ::   ln_EOS80   ! determine if eos_pt_from_ct is used to compute sst_m
+   LOGICAL , PUBLIC ::   ln_SEOS   ! determine if eos_pt_from_ct is used to compute sst_m
+
+   ! Parameters
+   LOGICAL , PUBLIC    ::   l_useCT         ! =T in ln_TEOS10=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise
+   INTEGER , PUBLIC    ::   neos            ! Identifier for equation of state used
+
+   INTEGER , PARAMETER ::   np_teos10 = -1  ! parameter for using TEOS10
+   INTEGER , PARAMETER ::   np_eos80  =  0  ! parameter for using EOS80
+   INTEGER , PARAMETER ::   np_seos   = 1   ! parameter for using Simplified Equation of state
+
+   !                               !!!  simplified eos coefficients (default value: Vallis 2006)
+   REAL(wp) ::   rn_a0      = 1.6550e-1_wp     ! thermal expansion coeff. 
+   REAL(wp) ::   rn_b0      = 7.6554e-1_wp     ! saline  expansion coeff. 
+   REAL(wp) ::   rn_lambda1 = 5.9520e-2_wp     ! cabbeling coeff. in T^2        
+   REAL(wp) ::   rn_lambda2 = 5.4914e-4_wp     ! cabbeling coeff. in S^2        
+   REAL(wp) ::   rn_mu1     = 1.4970e-4_wp     ! thermobaric coeff. in T  
+   REAL(wp) ::   rn_mu2     = 1.1090e-5_wp     ! thermobaric coeff. in S  
+   REAL(wp) ::   rn_nu      = 2.4341e-3_wp     ! cabbeling coeff. in theta*salt  
+   
+   ! TEOS10/EOS80 parameters
+   REAL(wp) ::   r1_S0, r1_T0, r1_Z0, rdeltaS
+   
+   ! EOS parameters
+   REAL(wp) ::   EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600
+   REAL(wp) ::   EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510
+   REAL(wp) ::   EOS020 , EOS120 , EOS220 , EOS320 , EOS420
+   REAL(wp) ::   EOS030 , EOS130 , EOS230 , EOS330
+   REAL(wp) ::   EOS040 , EOS140 , EOS240
+   REAL(wp) ::   EOS050 , EOS150
+   REAL(wp) ::   EOS060
+   REAL(wp) ::   EOS001 , EOS101 , EOS201 , EOS301 , EOS401
+   REAL(wp) ::   EOS011 , EOS111 , EOS211 , EOS311
+   REAL(wp) ::   EOS021 , EOS121 , EOS221
+   REAL(wp) ::   EOS031 , EOS131
+   REAL(wp) ::   EOS041
+   REAL(wp) ::   EOS002 , EOS102 , EOS202
+   REAL(wp) ::   EOS012 , EOS112
+   REAL(wp) ::   EOS022
+   REAL(wp) ::   EOS003 , EOS103
+   REAL(wp) ::   EOS013 
+   
+   ! ALPHA parameters
+   REAL(wp) ::   ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500
+   REAL(wp) ::   ALP010 , ALP110 , ALP210 , ALP310 , ALP410
+   REAL(wp) ::   ALP020 , ALP120 , ALP220 , ALP320
+   REAL(wp) ::   ALP030 , ALP130 , ALP230
+   REAL(wp) ::   ALP040 , ALP140
+   REAL(wp) ::   ALP050
+   REAL(wp) ::   ALP001 , ALP101 , ALP201 , ALP301
+   REAL(wp) ::   ALP011 , ALP111 , ALP211
+   REAL(wp) ::   ALP021 , ALP121
+   REAL(wp) ::   ALP031
+   REAL(wp) ::   ALP002 , ALP102
+   REAL(wp) ::   ALP012
+   REAL(wp) ::   ALP003
+   
+   ! BETA parameters
+   REAL(wp) ::   BET000 , BET100 , BET200 , BET300 , BET400 , BET500
+   REAL(wp) ::   BET010 , BET110 , BET210 , BET310 , BET410
+   REAL(wp) ::   BET020 , BET120 , BET220 , BET320
+   REAL(wp) ::   BET030 , BET130 , BET230
+   REAL(wp) ::   BET040 , BET140
+   REAL(wp) ::   BET050
+   REAL(wp) ::   BET001 , BET101 , BET201 , BET301
+   REAL(wp) ::   BET011 , BET111 , BET211
+   REAL(wp) ::   BET021 , BET121
+   REAL(wp) ::   BET031
+   REAL(wp) ::   BET002 , BET102
+   REAL(wp) ::   BET012
+   REAL(wp) ::   BET003
+
+   ! PEN parameters
+   REAL(wp) ::   PEN000 , PEN100 , PEN200 , PEN300 , PEN400
+   REAL(wp) ::   PEN010 , PEN110 , PEN210 , PEN310
+   REAL(wp) ::   PEN020 , PEN120 , PEN220
+   REAL(wp) ::   PEN030 , PEN130
+   REAL(wp) ::   PEN040
+   REAL(wp) ::   PEN001 , PEN101 , PEN201
+   REAL(wp) ::   PEN011 , PEN111
+   REAL(wp) ::   PEN021
+   REAL(wp) ::   PEN002 , PEN102
+   REAL(wp) ::   PEN012
+   
+   ! ALPHA_PEN parameters
+   REAL(wp) ::   APE000 , APE100 , APE200 , APE300
+   REAL(wp) ::   APE010 , APE110 , APE210
+   REAL(wp) ::   APE020 , APE120
+   REAL(wp) ::   APE030
+   REAL(wp) ::   APE001 , APE101
+   REAL(wp) ::   APE011
+   REAL(wp) ::   APE002
+
+   ! BETA_PEN parameters
+   REAL(wp) ::   BPE000 , BPE100 , BPE200 , BPE300
+   REAL(wp) ::   BPE010 , BPE110 , BPE210
+   REAL(wp) ::   BPE020 , BPE120
+   REAL(wp) ::   BPE030
+   REAL(wp) ::   BPE001 , BPE101
+   REAL(wp) ::   BPE011
+   REAL(wp) ::   BPE002
+
+   !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: eosbn2.F90 6505 2016-05-01 16:11:06Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE eos_insitu( pts, prd, pdep )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!       potential temperature and salinity using an equation of state
+      !!       selected in the nameos namelist
+      !!
+      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0
+      !!         with   prd    in situ density anomaly      no units
+      !!                t      TEOS10: CT or EOS80: PT      Celsius
+      !!                s      TEOS10: SA or EOS80: SP      TEOS10: g/kg or EOS80: psu
+      !!                z      depth                        meters
+      !!                rho    in situ density              kg/m^3
+      !!                rau0   reference density            kg/m^3
+      !!
+      !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
+      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg
+      !!
+      !!     ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
+      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu
+      !!
+      !!     ln_seos : simplified equation of state
+      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0
+      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0
+      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
+      !!              Vallis like equation: use default values of coefficients
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :   Roquet et al, Ocean Modelling, in preparation (2014)
+      !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
+      !!                TEOS-10 Manual, 2010
+      !!----------------------------------------------------------------------
+      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(in   ) ::   pdep  ! depth                      [m]
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos-insitu')
+      !
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm = tmask(ji,jj,jk)                                         ! tmask
+                  !
+                  zn3 = EOS013*zt   &
+                     &   + EOS103*zs+EOS003
+                     !
+                  zn2 = (EOS022*zt   &
+                     &   + EOS112*zs+EOS012)*zt   &
+                     &   + (EOS202*zs+EOS102)*zs+EOS002
+                     !
+                  zn1 = (((EOS041*zt   &
+                     &   + EOS131*zs+EOS031)*zt   &
+                     &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                     &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                     &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                     !
+                  zn0 = (((((EOS060*zt   &
+                     &   + EOS150*zs+EOS050)*zt   &
+                     &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                     &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                     &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                     &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                     &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                     !
+                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  !
+                  prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked)
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
+                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
+                  zh  = pdep (ji,jj,jk)
+                  ztm = tmask(ji,jj,jk)
+                  !
+                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
+                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
+                     &  - rn_nu * zt * zs
+                     !                                 
+                  prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked)
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos-insitu')
+      !
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
+      !!----------------------------------------------------------------------
+      !!                  ***  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 selected in the
+      !!     namelist.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !!----------------------------------------------------------------------
+      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)
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m]
+      !
+      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
+      INTEGER  ::   jdof
+      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      -
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos-pot')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     !
+                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth
+                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                     ztm = tmask(ji,jj,jk)                                         ! tmask
+                     !
+                     zn3 = EOS013*zt   &
+                        &   + EOS103*zs+EOS003
+                        !
+                     zn2 = (EOS022*zt   &
+                        &   + EOS112*zs+EOS012)*zt   &
+                        &   + (EOS202*zs+EOS102)*zs+EOS002
+                        !
+                     zn1 = (((EOS041*zt   &
+                        &   + EOS131*zs+EOS031)*zt   &
+                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                        !
+                     zn0 = (((((EOS060*zt   &
+                        &   + EOS150*zs+EOS050)*zt   &
+                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                        !
+                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                     !
+                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface
+                     !
+                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked)
+                  END DO
+               END DO
+            END DO
+         
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts  (ji,jj,jk,jp_tem) - 10._wp
+                  zs  = pts  (ji,jj,jk,jp_sal) - 35._wp
+                  zh  = pdep (ji,jj,jk)
+                  ztm = tmask(ji,jj,jk)
+                  !                                                     ! potential density referenced at the surface
+                  zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   &
+                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   &
+                     &  - rn_nu * zt * zs
+                  prhop(ji,jj,jk) = ( rau0 + zn ) * ztm
+                  !                                                     ! density anomaly (masked)
+                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
+                  prd(ji,jj,jk) = zn * r1_rau0 * ztm
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos-pot')
+      !
+   END SUBROUTINE eos_insitu_pot
+
+
+   SUBROUTINE eos_insitu_2d( pts, 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
+      !!      selected in the nameos namelist. * 2D field case
+      !!
+      !! ** Action  : - prd , the in situ density (no units) (unmasked)
+      !!
+      !!----------------------------------------------------------------------
+      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, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos2d')
+      !
+      prd(:,:) = 0._wp
+      !
+      SELECT CASE( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               !
+               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
+               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+               !
+               zn3 = EOS013*zt   &
+                  &   + EOS103*zs+EOS003
+                  !
+               zn2 = (EOS022*zt   &
+                  &   + EOS112*zs+EOS012)*zt   &
+                  &   + (EOS202*zs+EOS102)*zs+EOS002
+                  !
+               zn1 = (((EOS041*zt   &
+                  &   + EOS131*zs+EOS031)*zt   &
+                  &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   &
+                  &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   &
+                  &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
+                  !
+               zn0 = (((((EOS060*zt   &
+                  &   + EOS150*zs+EOS050)*zt   &
+                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+                  !
+               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+               !
+               prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
+         !
+      CASE( np_seos )                !==  simplified EOS  ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               !
+               zt    = pts  (ji,jj,jp_tem)  - 10._wp
+               zs    = pts  (ji,jj,jp_sal)  - 35._wp
+               zh    = pdep (ji,jj)                         ! depth at the partial step level
+               !
+               zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   &
+                  &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   &
+                  &  - rn_nu * zt * zs
+                  !
+               prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( prd, 'T', 1. )                    ! Lateral boundary conditions
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos2d')
+      !
+   END SUBROUTINE eos_insitu_2d
+
+
+   SUBROUTINE rab_3d( pts, pab )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE rab_3d  ***
+      !!
+      !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points
+      !!
+      !! ** Method  :   calculates alpha / beta at T-points
+      !!
+      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('rab_3d')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
+                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm = tmask(ji,jj,jk)                                         ! tmask
+                  !
+                  ! alpha
+                  zn3 = ALP003
+                  !
+                  zn2 = ALP012*zt + ALP102*zs+ALP002
+                  !
+                  zn1 = ((ALP031*zt   &
+                     &   + ALP121*zs+ALP021)*zt   &
+                     &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+                     &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+                     !
+                  zn0 = ((((ALP050*zt   &
+                     &   + ALP140*zs+ALP040)*zt   &
+                     &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+                     &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+                     &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+                     &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+                     !
+                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  !
+                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm
+                  !
+                  ! beta
+                  zn3 = BET003
+                  !
+                  zn2 = BET012*zt + BET102*zs+BET002
+                  !
+                  zn1 = ((BET031*zt   &
+                     &   + BET121*zs+BET021)*zt   &
+                     &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+                     &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+                     !
+                  zn0 = ((((BET050*zt   &
+                     &   + BET140*zs+BET040)*zt   &
+                     &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+                     &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+                     &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+                     &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+                     !
+                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+                  !
+                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE( np_seos )                  !==  simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+                  zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+                  zh  = gdept_n(ji,jj,jk)                ! depth in meters at t-point
+                  ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask
+                  !
+                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+                  pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha
+                  !
+                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+                  pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
+         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('rab_3d')
+      !
+   END SUBROUTINE rab_3d
+
+
+   SUBROUTINE rab_2d( pts, pdep, pab )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE rab_2d  ***
+      !!
+      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked)
+      !!
+      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('rab_2d')
+      !
+      pab(:,:,:) = 0._wp
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               !
+               zh  = pdep(ji,jj) * r1_Z0                                  ! depth
+               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+               !
+               ! alpha
+               zn3 = ALP003
+               !
+               zn2 = ALP012*zt + ALP102*zs+ALP002
+               !
+               zn1 = ((ALP031*zt   &
+                  &   + ALP121*zs+ALP021)*zt   &
+                  &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+                  &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+                  !
+               zn0 = ((((ALP050*zt   &
+                  &   + ALP140*zs+ALP040)*zt   &
+                  &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+                  &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+                  &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+                  &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+                  !
+               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+               !
+               pab(ji,jj,jp_tem) = zn * r1_rau0
+               !
+               ! beta
+               zn3 = BET003
+               !
+               zn2 = BET012*zt + BET102*zs+BET002
+               !
+               zn1 = ((BET031*zt   &
+                  &   + BET121*zs+BET021)*zt   &
+                  &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+                  &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+                  !
+               zn0 = ((((BET050*zt   &
+                  &   + BET140*zs+BET040)*zt   &
+                  &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+                  &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+                  &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+                  &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+                  !
+               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+               !
+               pab(ji,jj,jp_sal) = zn / zs * r1_rau0
+               !
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions
+         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
+         !
+      CASE( np_seos )                  !==  simplified EOS  ==!
+         !
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               !
+               zt    = pts  (ji,jj,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+               zs    = pts  (ji,jj,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+               zh    = pdep (ji,jj)                   ! depth at the partial step level
+               !
+               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+               pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha
+               !
+               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+               pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta
+               !
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( pab(:,:,jp_tem), 'T', 1. )                    ! Lateral boundary conditions
+         CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. )                    
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
+         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('rab_2d')
+      !
+   END SUBROUTINE rab_2d
+
+
+   SUBROUTINE rab_0d( pts, pdep, pab )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE rab_0d  ***
+      !!
+      !! ** Purpose :   Calculates thermal/haline expansion ratio for a 2d field (unmasked)
+      !!
+      !! ** Action  : - pab     : thermal/haline expansion ratio at T-points
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity
+      REAL(wp),                      INTENT(in   ) ::   pdep   ! depth                  [m]
+      REAL(wp), DIMENSION(jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio
+      !
+      REAL(wp) ::   zt , zh , zs              ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('rab_2d')
+      !
+      pab(:) = 0._wp
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )      !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         !
+         zh  = pdep * r1_Z0                                  ! depth
+         zt  = pts (jp_tem) * r1_T0                           ! temperature
+         zs  = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+         !
+         ! alpha
+         zn3 = ALP003
+         !
+         zn2 = ALP012*zt + ALP102*zs+ALP002
+         !
+         zn1 = ((ALP031*zt   &
+            &   + ALP121*zs+ALP021)*zt   &
+            &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   &
+            &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
+            !
+         zn0 = ((((ALP050*zt   &
+            &   + ALP140*zs+ALP040)*zt   &
+            &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   &
+            &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   &
+            &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   &
+            &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
+            !
+         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+         !
+         pab(jp_tem) = zn * r1_rau0
+         !
+         ! beta
+         zn3 = BET003
+         !
+         zn2 = BET012*zt + BET102*zs+BET002
+         !
+         zn1 = ((BET031*zt   &
+            &   + BET121*zs+BET021)*zt   &
+            &   + (BET211*zs+BET111)*zs+BET011)*zt   &
+            &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
+            !
+         zn0 = ((((BET050*zt   &
+            &   + BET140*zs+BET040)*zt   &
+            &   + (BET230*zs+BET130)*zs+BET030)*zt   &
+            &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   &
+            &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   &
+            &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
+            !
+         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
+         !
+         pab(jp_sal) = zn / zs * r1_rau0
+         !
+         !
+         !
+      CASE( np_seos )                  !==  simplified EOS  ==!
+         !
+         zt    = pts(jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0)
+         zs    = pts(jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0)
+         zh    = pdep                   ! depth at the partial step level
+         !
+         zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
+         pab(jp_tem) = zn * r1_rau0   ! alpha
+         !
+         zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
+         pab(jp_sal) = zn * r1_rau0   ! beta
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('rab_2d')
+      !
+   END SUBROUTINE rab_0d
+
+
+   SUBROUTINE bn2( pts, pab, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the 
+      !!                time-step of the input arguments
+      !!
+      !! ** Method  :   pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w
+      !!      where alpha and beta are given in pab, and computed on T-points.
+      !!      N.B. N^2 is set one for all to zero at jk=1 in istate module.
+      !!
+      !! ** Action  :   pn2 : square of the brunt-vaisala frequency at w-point 
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2]
+      !
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   zaw, zbw, zrw   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bn2')
+      !
+      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 )
+         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90
+            DO ji = 1, jpi
+               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   &
+                  &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 
+                  !
+               zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 
+               zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
+               !
+               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     &
+                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  &
+                  &            / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('bn2')
+      !
+   END SUBROUTINE bn2
+
+
+   FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_pt_from_ct  ***
+      !!
+      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius]
+      !!
+      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm
+      !!       checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC
+      !!
+      !! Reference  :   TEOS-10, UNESCO
+      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu]
+      ! Leave result array automatic rather than making explicitly allocated
+      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius]
+      !
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      REAL(wp) ::   zt , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zd              ! local scalars
+      REAL(wp) ::   zdeltaS , z1_S0 , z1_T0
+      !!----------------------------------------------------------------------
+      !
+      IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct')
+      !
+      zdeltaS = 5._wp
+      z1_S0   = 0.875_wp/35.16504_wp
+      z1_T0   = 1._wp/40._wp
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            zt  = ctmp   (ji,jj) * z1_T0
+            zs  = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 )
+            ztm = tmask(ji,jj,1)
+            !
+            zn = ((((-2.1385727895e-01_wp*zt   &
+               &   - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt   &
+               &   + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt   &
+               &   + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt   &
+               &   + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs   &
+               &      +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt   &
+               &   + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs   &
+               &      -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
+               !
+            zd = (2.0035003456_wp*zt   &
+               &   -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt   &
+               &   + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
+               !
+            ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
+               !
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct')
+      !
+   END FUNCTION eos_pt_from_ct
+
+
+   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_fzp  ***
+      !!
+      !! ** Purpose :   Compute the freezing point temperature [Celcius]
+      !!
+      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by
+      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
+      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
+      !!
+      !! 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), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius]
+      !
+      INTEGER  ::   ji, jj          ! dummy loop indices
+      REAL(wp) ::   zt, zs, z1_S0   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( neos )
+      !
+      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
+         !
+         z1_S0 = 1._wp / 35.16504_wp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 )           ! square root salinity
+               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+            END DO
+         END DO
+         ptf(:,:) = ptf(:,:) * psal(:,:)
+         !
+         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+         !
+      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
+         !
+         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
+            !
+         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT      
+      !
+  END SUBROUTINE eos_fzp_2d
+
+
+  SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_fzp  ***
+      !!
+      !! ** Purpose :   Compute the freezing point temperature [Celcius]
+      !!
+      !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by
+      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
+      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
+      !!
+      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu]
+      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m]
+      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius]
+      !
+      REAL(wp) :: zs   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( neos )
+      !
+      CASE ( np_teos10, np_seos )      !==  CT,SA (TEOS-10 and S-EOS formulations) ==!
+         !
+         zs  = SQRT( ABS( psal ) / 35.16504_wp )           ! square root salinity
+         ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+         ptf = ptf * psal
+         !
+         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
+         !
+      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==!
+         !
+         ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal )   &
+            &                - 2.154996e-4_wp *       psal   ) * psal
+            !
+         IF( PRESENT( pdep ) )   ptf = ptf - 7.53e-4 * pdep
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_fzp_0d
+
+
+   SUBROUTINE eos_pen( pts, pab_pe, ppen )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_pen  ***
+      !!
+      !! ** Purpose :   Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points
+      !!
+      !! ** Method  :   PE is defined analytically as the vertical 
+      !!                   primitive of EOS times -g integrated between 0 and z>0.
+      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd
+      !!                                                      = 1/z * /int_0^z rd dz - rd 
+      !!                                where rd is the density anomaly (see eos_rhd function)
+      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S:
+      !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT
+      !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS
+      !!
+      !! ** Action  : - pen         : PE anomaly given at T-points
+      !!            : - pab_pe  : given at T-points
+      !!                    pab_pe(:,:,:,jp_tem) is alpha_pe
+      !!                    pab_pe(:,:,:,jp_sal) is beta_pe
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts     ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab_pe  ! alpha_pe and beta_pe
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   ppen     ! potential energy anomaly
+      !
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zt , zh , zs , ztm        ! local scalars
+      REAL(wp) ::   zn , zn0, zn1, zn2        !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('eos_pen')
+      !
+      SELECT CASE ( neos )
+      !
+      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !
+                  zh  = gdept_n(ji,jj,jk) * r1_Z0                                ! depth
+                  zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature
+                  zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+                  ztm = tmask(ji,jj,jk)                                         ! tmask
+                  !
+                  ! potential energy non-linear anomaly
+                  zn2 = (PEN012)*zt   &
+                     &   + PEN102*zs+PEN002
+                     !
+                  zn1 = ((PEN021)*zt   &
+                     &   + PEN111*zs+PEN011)*zt   &
+                     &   + (PEN201*zs+PEN101)*zs+PEN001
+                     !
+                  zn0 = ((((PEN040)*zt   &
+                     &   + PEN130*zs+PEN030)*zt   &
+                     &   + (PEN220*zs+PEN120)*zs+PEN020)*zt   &
+                     &   + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt   &
+                     &   + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
+                     !
+                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
+                  !
+                  ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm
+                  !
+                  ! alphaPE non-linear anomaly
+                  zn2 = APE002
+                  !
+                  zn1 = (APE011)*zt   &
+                     &   + APE101*zs+APE001
+                     !
+                  zn0 = (((APE030)*zt   &
+                     &   + APE120*zs+APE020)*zt   &
+                     &   + (APE210*zs+APE110)*zs+APE010)*zt   &
+                     &   + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
+                     !
+                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
+                  !                              
+                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm
+                  !
+                  ! betaPE non-linear anomaly
+                  zn2 = BPE002
+                  !
+                  zn1 = (BPE011)*zt   &
+                     &   + BPE101*zs+BPE001
+                     !
+                  zn0 = (((BPE030)*zt   &
+                     &   + BPE120*zs+BPE020)*zt   &
+                     &   + (BPE210*zs+BPE110)*zs+BPE010)*zt   &
+                     &   + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
+                     !
+                  zn  = ( zn2 * zh + zn1 ) * zh + zn0
+                  !                              
+                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==!
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt  = pts(ji,jj,jk,jp_tem) - 10._wp  ! temperature anomaly (t-T0)
+                  zs = pts (ji,jj,jk,jp_sal) - 35._wp  ! abs. salinity anomaly (s-S0)
+                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point
+                  ztm = tmask(ji,jj,jk)                ! tmask
+                  zn  = 0.5_wp * zh * r1_rau0 * ztm
+                  !                                    ! Potential Energy
+                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
+                  !                                    ! alphaPE
+                  pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
+                  pab_pe(ji,jj,jk,jp_sal) =   rn_b0 * rn_mu2 * zn
+                  !
+               END DO
+            END DO
+         END DO
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('eos_pen')
+      !
+   END SUBROUTINE eos_pen
+
+
+   SUBROUTINE eos_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos and control the parameters
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ios   ! local integer
+      INTEGER  ::   ioptio   ! local integer
+      !!
+      NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, rn_a0, rn_b0, rn_lambda1, rn_mu1,   &
+         &                                             rn_lambda2, rn_mu2, rn_nu
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist nameos in reference namelist : equation of state
+      READ  ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp )
+      !
+      REWIND( numnam_cfg )              ! Namelist nameos in configuration namelist : equation of state
+      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp )
+      IF(lwm) WRITE( numond, nameos )
+      !
+      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3]
+      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K]
+      !
+      IF(lwp) THEN                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist nameos : Chosen the Equation Of Seawater (EOS)'
+         WRITE(numout,*) '      TEOS-10 : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_TEOS10 = ', ln_TEOS10
+         WRITE(numout,*) '      EOS-80  : rho=F(Potential    Temperature, Practical Salinity, depth)   ln_EOS80  = ', ln_EOS80
+         WRITE(numout,*) '      S-EOS   : rho=F(Conservative Temperature, Absolute  Salinity, depth)   ln_SEOS   = ', ln_SEOS
+      ENDIF
+
+      ! Check options for equation of state & set neos based on logical flags
+      ioptio = 0
+      IF( ln_TEOS10 ) THEN   ;   ioptio = ioptio+1   ;   neos = np_teos10   ;   ENDIF
+      IF( ln_EOS80  ) THEN   ;   ioptio = ioptio+1   ;   neos = np_eos80    ;   ENDIF
+      IF( ln_SEOS   ) THEN   ;   ioptio = ioptio+1   ;   neos = np_seos     ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop("Exactly one equation of state option must be selected")
+      !
+      SELECT CASE( neos )         ! check option
+      !
+      CASE( np_teos10 )                       !==  polynomial TEOS-10  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of TEOS-10 equation of state (cons. temp. and abs. salinity)'
+         !
+         l_useCT = .TRUE.                          ! model temperature is Conservative temperature 
+         !
+         rdeltaS = 32._wp
+         r1_S0  = 0.875_wp/35.16504_wp
+         r1_T0  = 1._wp/40._wp
+         r1_Z0  = 1.e-4_wp
+         !
+         EOS000 = 8.0189615746e+02_wp
+         EOS100 = 8.6672408165e+02_wp
+         EOS200 = -1.7864682637e+03_wp
+         EOS300 = 2.0375295546e+03_wp
+         EOS400 = -1.2849161071e+03_wp
+         EOS500 = 4.3227585684e+02_wp
+         EOS600 = -6.0579916612e+01_wp
+         EOS010 = 2.6010145068e+01_wp
+         EOS110 = -6.5281885265e+01_wp
+         EOS210 = 8.1770425108e+01_wp
+         EOS310 = -5.6888046321e+01_wp
+         EOS410 = 1.7681814114e+01_wp
+         EOS510 = -1.9193502195_wp
+         EOS020 = -3.7074170417e+01_wp
+         EOS120 = 6.1548258127e+01_wp
+         EOS220 = -6.0362551501e+01_wp
+         EOS320 = 2.9130021253e+01_wp
+         EOS420 = -5.4723692739_wp
+         EOS030 = 2.1661789529e+01_wp
+         EOS130 = -3.3449108469e+01_wp
+         EOS230 = 1.9717078466e+01_wp
+         EOS330 = -3.1742946532_wp
+         EOS040 = -8.3627885467_wp
+         EOS140 = 1.1311538584e+01_wp
+         EOS240 = -5.3563304045_wp
+         EOS050 = 5.4048723791e-01_wp
+         EOS150 = 4.8169980163e-01_wp
+         EOS060 = -1.9083568888e-01_wp
+         EOS001 = 1.9681925209e+01_wp
+         EOS101 = -4.2549998214e+01_wp
+         EOS201 = 5.0774768218e+01_wp
+         EOS301 = -3.0938076334e+01_wp
+         EOS401 = 6.6051753097_wp
+         EOS011 = -1.3336301113e+01_wp
+         EOS111 = -4.4870114575_wp
+         EOS211 = 5.0042598061_wp
+         EOS311 = -6.5399043664e-01_wp
+         EOS021 = 6.7080479603_wp
+         EOS121 = 3.5063081279_wp
+         EOS221 = -1.8795372996_wp
+         EOS031 = -2.4649669534_wp
+         EOS131 = -5.5077101279e-01_wp
+         EOS041 = 5.5927935970e-01_wp
+         EOS002 = 2.0660924175_wp
+         EOS102 = -4.9527603989_wp
+         EOS202 = 2.5019633244_wp
+         EOS012 = 2.0564311499_wp
+         EOS112 = -2.1311365518e-01_wp
+         EOS022 = -1.2419983026_wp
+         EOS003 = -2.3342758797e-02_wp
+         EOS103 = -1.8507636718e-02_wp
+         EOS013 = 3.7969820455e-01_wp
+         !
+         ALP000 = -6.5025362670e-01_wp
+         ALP100 = 1.6320471316_wp
+         ALP200 = -2.0442606277_wp
+         ALP300 = 1.4222011580_wp
+         ALP400 = -4.4204535284e-01_wp
+         ALP500 = 4.7983755487e-02_wp
+         ALP010 = 1.8537085209_wp
+         ALP110 = -3.0774129064_wp
+         ALP210 = 3.0181275751_wp
+         ALP310 = -1.4565010626_wp
+         ALP410 = 2.7361846370e-01_wp
+         ALP020 = -1.6246342147_wp
+         ALP120 = 2.5086831352_wp
+         ALP220 = -1.4787808849_wp
+         ALP320 = 2.3807209899e-01_wp
+         ALP030 = 8.3627885467e-01_wp
+         ALP130 = -1.1311538584_wp
+         ALP230 = 5.3563304045e-01_wp
+         ALP040 = -6.7560904739e-02_wp
+         ALP140 = -6.0212475204e-02_wp
+         ALP050 = 2.8625353333e-02_wp
+         ALP001 = 3.3340752782e-01_wp
+         ALP101 = 1.1217528644e-01_wp
+         ALP201 = -1.2510649515e-01_wp
+         ALP301 = 1.6349760916e-02_wp
+         ALP011 = -3.3540239802e-01_wp
+         ALP111 = -1.7531540640e-01_wp
+         ALP211 = 9.3976864981e-02_wp
+         ALP021 = 1.8487252150e-01_wp
+         ALP121 = 4.1307825959e-02_wp
+         ALP031 = -5.5927935970e-02_wp
+         ALP002 = -5.1410778748e-02_wp
+         ALP102 = 5.3278413794e-03_wp
+         ALP012 = 6.2099915132e-02_wp
+         ALP003 = -9.4924551138e-03_wp
+         !
+         BET000 = 1.0783203594e+01_wp
+         BET100 = -4.4452095908e+01_wp
+         BET200 = 7.6048755820e+01_wp
+         BET300 = -6.3944280668e+01_wp
+         BET400 = 2.6890441098e+01_wp
+         BET500 = -4.5221697773_wp
+         BET010 = -8.1219372432e-01_wp
+         BET110 = 2.0346663041_wp
+         BET210 = -2.1232895170_wp
+         BET310 = 8.7994140485e-01_wp
+         BET410 = -1.1939638360e-01_wp
+         BET020 = 7.6574242289e-01_wp
+         BET120 = -1.5019813020_wp
+         BET220 = 1.0872489522_wp
+         BET320 = -2.7233429080e-01_wp
+         BET030 = -4.1615152308e-01_wp
+         BET130 = 4.9061350869e-01_wp
+         BET230 = -1.1847737788e-01_wp
+         BET040 = 1.4073062708e-01_wp
+         BET140 = -1.3327978879e-01_wp
+         BET050 = 5.9929880134e-03_wp
+         BET001 = -5.2937873009e-01_wp
+         BET101 = 1.2634116779_wp
+         BET201 = -1.1547328025_wp
+         BET301 = 3.2870876279e-01_wp
+         BET011 = -5.5824407214e-02_wp
+         BET111 = 1.2451933313e-01_wp
+         BET211 = -2.4409539932e-02_wp
+         BET021 = 4.3623149752e-02_wp
+         BET121 = -4.6767901790e-02_wp
+         BET031 = -6.8523260060e-03_wp
+         BET002 = -6.1618945251e-02_wp
+         BET102 = 6.2255521644e-02_wp
+         BET012 = -2.6514181169e-03_wp
+         BET003 = -2.3025968587e-04_wp
+         !
+         PEN000 = -9.8409626043_wp
+         PEN100 = 2.1274999107e+01_wp
+         PEN200 = -2.5387384109e+01_wp
+         PEN300 = 1.5469038167e+01_wp
+         PEN400 = -3.3025876549_wp
+         PEN010 = 6.6681505563_wp
+         PEN110 = 2.2435057288_wp
+         PEN210 = -2.5021299030_wp
+         PEN310 = 3.2699521832e-01_wp
+         PEN020 = -3.3540239802_wp
+         PEN120 = -1.7531540640_wp
+         PEN220 = 9.3976864981e-01_wp
+         PEN030 = 1.2324834767_wp
+         PEN130 = 2.7538550639e-01_wp
+         PEN040 = -2.7963967985e-01_wp
+         PEN001 = -1.3773949450_wp
+         PEN101 = 3.3018402659_wp
+         PEN201 = -1.6679755496_wp
+         PEN011 = -1.3709540999_wp
+         PEN111 = 1.4207577012e-01_wp
+         PEN021 = 8.2799886843e-01_wp
+         PEN002 = 1.7507069098e-02_wp
+         PEN102 = 1.3880727538e-02_wp
+         PEN012 = -2.8477365341e-01_wp
+         !
+         APE000 = -1.6670376391e-01_wp
+         APE100 = -5.6087643219e-02_wp
+         APE200 = 6.2553247576e-02_wp
+         APE300 = -8.1748804580e-03_wp
+         APE010 = 1.6770119901e-01_wp
+         APE110 = 8.7657703198e-02_wp
+         APE210 = -4.6988432490e-02_wp
+         APE020 = -9.2436260751e-02_wp
+         APE120 = -2.0653912979e-02_wp
+         APE030 = 2.7963967985e-02_wp
+         APE001 = 3.4273852498e-02_wp
+         APE101 = -3.5518942529e-03_wp
+         APE011 = -4.1399943421e-02_wp
+         APE002 = 7.1193413354e-03_wp
+         !
+         BPE000 = 2.6468936504e-01_wp
+         BPE100 = -6.3170583896e-01_wp
+         BPE200 = 5.7736640125e-01_wp
+         BPE300 = -1.6435438140e-01_wp
+         BPE010 = 2.7912203607e-02_wp
+         BPE110 = -6.2259666565e-02_wp
+         BPE210 = 1.2204769966e-02_wp
+         BPE020 = -2.1811574876e-02_wp
+         BPE120 = 2.3383950895e-02_wp
+         BPE030 = 3.4261630030e-03_wp
+         BPE001 = 4.1079296834e-02_wp
+         BPE101 = -4.1503681096e-02_wp
+         BPE011 = 1.7676120780e-03_wp
+         BPE002 = 1.7269476440e-04_wp
+         !
+      CASE( np_eos80 )                        !==  polynomial EOS-80 formulation  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of EOS-80 equation of state (pot. temp. and pract. salinity)'
+         !
+         l_useCT = .FALSE.                         ! model temperature is Potential temperature
+         rdeltaS = 20._wp
+         r1_S0  = 1._wp/40._wp
+         r1_T0  = 1._wp/40._wp
+         r1_Z0  = 1.e-4_wp
+         !
+         EOS000 = 9.5356891948e+02_wp
+         EOS100 = 1.7136499189e+02_wp
+         EOS200 = -3.7501039454e+02_wp
+         EOS300 = 5.1856810420e+02_wp
+         EOS400 = -3.7264470465e+02_wp
+         EOS500 = 1.4302533998e+02_wp
+         EOS600 = -2.2856621162e+01_wp
+         EOS010 = 1.0087518651e+01_wp
+         EOS110 = -1.3647741861e+01_wp
+         EOS210 = 8.8478359933_wp
+         EOS310 = -7.2329388377_wp
+         EOS410 = 1.4774410611_wp
+         EOS510 = 2.0036720553e-01_wp
+         EOS020 = -2.5579830599e+01_wp
+         EOS120 = 2.4043512327e+01_wp
+         EOS220 = -1.6807503990e+01_wp
+         EOS320 = 8.3811577084_wp
+         EOS420 = -1.9771060192_wp
+         EOS030 = 1.6846451198e+01_wp
+         EOS130 = -2.1482926901e+01_wp
+         EOS230 = 1.0108954054e+01_wp
+         EOS330 = -6.2675951440e-01_wp
+         EOS040 = -8.0812310102_wp
+         EOS140 = 1.0102374985e+01_wp
+         EOS240 = -4.8340368631_wp
+         EOS050 = 1.2079167803_wp
+         EOS150 = 1.1515380987e-01_wp
+         EOS060 = -2.4520288837e-01_wp
+         EOS001 = 1.0748601068e+01_wp
+         EOS101 = -1.7817043500e+01_wp
+         EOS201 = 2.2181366768e+01_wp
+         EOS301 = -1.6750916338e+01_wp
+         EOS401 = 4.1202230403_wp
+         EOS011 = -1.5852644587e+01_wp
+         EOS111 = -7.6639383522e-01_wp
+         EOS211 = 4.1144627302_wp
+         EOS311 = -6.6955877448e-01_wp
+         EOS021 = 9.9994861860_wp
+         EOS121 = -1.9467067787e-01_wp
+         EOS221 = -1.2177554330_wp
+         EOS031 = -3.4866102017_wp
+         EOS131 = 2.2229155620e-01_wp
+         EOS041 = 5.9503008642e-01_wp
+         EOS002 = 1.0375676547_wp
+         EOS102 = -3.4249470629_wp
+         EOS202 = 2.0542026429_wp
+         EOS012 = 2.1836324814_wp
+         EOS112 = -3.4453674320e-01_wp
+         EOS022 = -1.2548163097_wp
+         EOS003 = 1.8729078427e-02_wp
+         EOS103 = -5.7238495240e-02_wp
+         EOS013 = 3.8306136687e-01_wp
+         !
+         ALP000 = -2.5218796628e-01_wp
+         ALP100 = 3.4119354654e-01_wp
+         ALP200 = -2.2119589983e-01_wp
+         ALP300 = 1.8082347094e-01_wp
+         ALP400 = -3.6936026529e-02_wp
+         ALP500 = -5.0091801383e-03_wp
+         ALP010 = 1.2789915300_wp
+         ALP110 = -1.2021756164_wp
+         ALP210 = 8.4037519952e-01_wp
+         ALP310 = -4.1905788542e-01_wp
+         ALP410 = 9.8855300959e-02_wp
+         ALP020 = -1.2634838399_wp
+         ALP120 = 1.6112195176_wp
+         ALP220 = -7.5817155402e-01_wp
+         ALP320 = 4.7006963580e-02_wp
+         ALP030 = 8.0812310102e-01_wp
+         ALP130 = -1.0102374985_wp
+         ALP230 = 4.8340368631e-01_wp
+         ALP040 = -1.5098959754e-01_wp
+         ALP140 = -1.4394226233e-02_wp
+         ALP050 = 3.6780433255e-02_wp
+         ALP001 = 3.9631611467e-01_wp
+         ALP101 = 1.9159845880e-02_wp
+         ALP201 = -1.0286156825e-01_wp
+         ALP301 = 1.6738969362e-02_wp
+         ALP011 = -4.9997430930e-01_wp
+         ALP111 = 9.7335338937e-03_wp
+         ALP211 = 6.0887771651e-02_wp
+         ALP021 = 2.6149576513e-01_wp
+         ALP121 = -1.6671866715e-02_wp
+         ALP031 = -5.9503008642e-02_wp
+         ALP002 = -5.4590812035e-02_wp
+         ALP102 = 8.6134185799e-03_wp
+         ALP012 = 6.2740815484e-02_wp
+         ALP003 = -9.5765341718e-03_wp
+         !
+         BET000 = 2.1420623987_wp
+         BET100 = -9.3752598635_wp
+         BET200 = 1.9446303907e+01_wp
+         BET300 = -1.8632235232e+01_wp
+         BET400 = 8.9390837485_wp
+         BET500 = -1.7142465871_wp
+         BET010 = -1.7059677327e-01_wp
+         BET110 = 2.2119589983e-01_wp
+         BET210 = -2.7123520642e-01_wp
+         BET310 = 7.3872053057e-02_wp
+         BET410 = 1.2522950346e-02_wp
+         BET020 = 3.0054390409e-01_wp
+         BET120 = -4.2018759976e-01_wp
+         BET220 = 3.1429341406e-01_wp
+         BET320 = -9.8855300959e-02_wp
+         BET030 = -2.6853658626e-01_wp
+         BET130 = 2.5272385134e-01_wp
+         BET230 = -2.3503481790e-02_wp
+         BET040 = 1.2627968731e-01_wp
+         BET140 = -1.2085092158e-01_wp
+         BET050 = 1.4394226233e-03_wp
+         BET001 = -2.2271304375e-01_wp
+         BET101 = 5.5453416919e-01_wp
+         BET201 = -6.2815936268e-01_wp
+         BET301 = 2.0601115202e-01_wp
+         BET011 = -9.5799229402e-03_wp
+         BET111 = 1.0286156825e-01_wp
+         BET211 = -2.5108454043e-02_wp
+         BET021 = -2.4333834734e-03_wp
+         BET121 = -3.0443885826e-02_wp
+         BET031 = 2.7786444526e-03_wp
+         BET002 = -4.2811838287e-02_wp
+         BET102 = 5.1355066072e-02_wp
+         BET012 = -4.3067092900e-03_wp
+         BET003 = -7.1548119050e-04_wp
+         !
+         PEN000 = -5.3743005340_wp
+         PEN100 = 8.9085217499_wp
+         PEN200 = -1.1090683384e+01_wp
+         PEN300 = 8.3754581690_wp
+         PEN400 = -2.0601115202_wp
+         PEN010 = 7.9263222935_wp
+         PEN110 = 3.8319691761e-01_wp
+         PEN210 = -2.0572313651_wp
+         PEN310 = 3.3477938724e-01_wp
+         PEN020 = -4.9997430930_wp
+         PEN120 = 9.7335338937e-02_wp
+         PEN220 = 6.0887771651e-01_wp
+         PEN030 = 1.7433051009_wp
+         PEN130 = -1.1114577810e-01_wp
+         PEN040 = -2.9751504321e-01_wp
+         PEN001 = -6.9171176978e-01_wp
+         PEN101 = 2.2832980419_wp
+         PEN201 = -1.3694684286_wp
+         PEN011 = -1.4557549876_wp
+         PEN111 = 2.2969116213e-01_wp
+         PEN021 = 8.3654420645e-01_wp
+         PEN002 = -1.4046808820e-02_wp
+         PEN102 = 4.2928871430e-02_wp
+         PEN012 = -2.8729602515e-01_wp
+         !
+         APE000 = -1.9815805734e-01_wp
+         APE100 = -9.5799229402e-03_wp
+         APE200 = 5.1430784127e-02_wp
+         APE300 = -8.3694846809e-03_wp
+         APE010 = 2.4998715465e-01_wp
+         APE110 = -4.8667669469e-03_wp
+         APE210 = -3.0443885826e-02_wp
+         APE020 = -1.3074788257e-01_wp
+         APE120 = 8.3359333577e-03_wp
+         APE030 = 2.9751504321e-02_wp
+         APE001 = 3.6393874690e-02_wp
+         APE101 = -5.7422790533e-03_wp
+         APE011 = -4.1827210323e-02_wp
+         APE002 = 7.1824006288e-03_wp
+         !
+         BPE000 = 1.1135652187e-01_wp
+         BPE100 = -2.7726708459e-01_wp
+         BPE200 = 3.1407968134e-01_wp
+         BPE300 = -1.0300557601e-01_wp
+         BPE010 = 4.7899614701e-03_wp
+         BPE110 = -5.1430784127e-02_wp
+         BPE210 = 1.2554227021e-02_wp
+         BPE020 = 1.2166917367e-03_wp
+         BPE120 = 1.5221942913e-02_wp
+         BPE030 = -1.3893222263e-03_wp
+         BPE001 = 2.8541225524e-02_wp
+         BPE101 = -3.4236710714e-02_wp
+         BPE011 = 2.8711395266e-03_wp
+         BPE002 = 5.3661089288e-04_wp
+         !
+      CASE( np_seos )                        !==  Simplified EOS     ==!
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          use of simplified eos:    rhd(dT=T-10,dS=S-35,Z) = '
+            WRITE(numout,*) '             [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0'
+            WRITE(numout,*)
+            WRITE(numout,*) '             thermal exp. coef.    rn_a0      = ', rn_a0
+            WRITE(numout,*) '             saline  cont. coef.   rn_b0      = ', rn_b0
+            WRITE(numout,*) '             cabbeling coef.       rn_lambda1 = ', rn_lambda1
+            WRITE(numout,*) '             cabbeling coef.       rn_lambda2 = ', rn_lambda2
+            WRITE(numout,*) '             thermobar. coef.      rn_mu1     = ', rn_mu1
+            WRITE(numout,*) '             thermobar. coef.      rn_mu2     = ', rn_mu2
+            WRITE(numout,*) '             2nd cabbel. coef.     rn_nu      = ', rn_nu
+            WRITE(numout,*) '               Caution: rn_beta0=0 incompatible with ddm parameterization '
+         ENDIF
+         l_useCT = .TRUE.          ! Use conservative temperature
+         !
+      CASE DEFAULT                     !==  ERROR in neos  ==!
+         WRITE(ctmp1,*) '          bad flag value for neos = ', neos, '. You should never see this error'
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+      rau0_rcp    = rau0 * rcp 
+      r1_rau0     = 1._wp / rau0
+      r1_rcp      = 1._wp / rcp
+      r1_rau0_rcp = 1._wp / rau0_rcp 
+      !
+      IF(lwp) THEN
+         IF( l_useCT )   THEN
+            WRITE(numout,*) '             model uses Conservative Temperature'
+            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields'
+         ELSE
+            WRITE(numout,*) '             model does not use Conservative Temperature'
+         ENDIF
+      ENDIF
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
+      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
+      IF(lwp) WRITE(numout,*) '          rau0 * rcp                       rau0_rcp = ', rau0_rcp
+      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
+      !
+   END SUBROUTINE eos_init
+
+   !!======================================================================
+END MODULE eosbn2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/errioipsl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/errioipsl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/errioipsl.f90	(revision 8732)
@@ -0,0 +1,215 @@
+MODULE errioipsl
+!-
+!$Id: errioipsl.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/flincom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/flincom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/flincom.f90	(revision 8732)
@@ -0,0 +1,1939 @@
+MODULE flincom
+!-
+!$Id: flincom.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/fliocom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/fliocom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/fliocom.f90	(revision 8732)
@@ -0,0 +1,5173 @@
+MODULE fliocom
+!-
+!$Id: fliocom.f90 2512 2010-12-23 15:27:09Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/getincom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/getincom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/getincom.f90	(revision 8732)
@@ -0,0 +1,2008 @@
+MODULE getincom
+!-
+!$Id: getincom.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/histcom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/histcom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/histcom.f90	(revision 8732)
@@ -0,0 +1,2501 @@
+MODULE histcom
+!-
+!$Id: histcom.f90 2368 2010-11-09 15:38:45Z acc $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/in_out_manager.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/in_out_manager.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/in_out_manager.f90	(revision 8732)
@@ -0,0 +1,141 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! I/O manager utilities : Defines run parameters together with logical units
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+ 
+   !
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory
+   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output)
+   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
+   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
+   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
+   INTEGER       ::   nn_no            !: job number
+   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh   = 0  !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000         !: index of the first time step
+   INTEGER       ::   nn_itend         !: index of the last time step
+   INTEGER       ::   nn_date0         !: initial calendar date aammjj
+   INTEGER       ::   nn_time0         !: initial time of day in hhmm
+   INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate        !: initial state output flag (0/1)
+   INTEGER       ::   nn_write         !: model standard output frequency
+   INTEGER       ::   nn_stock         !: restart file frequency
+   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
+   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
+   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+!$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(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
+   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times
+
+   !!----------------------------------------------------------------------
+   !! 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
+   LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
+   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+   INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   nrst_lst              !: number of restart to output next
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_ctl       !: run control for debugging
+   INTEGER ::   nn_timing    !: run control for timing
+   INTEGER ::   nn_diacfl    !: flag whether to create CFL diagnostics
+   INTEGER ::   nn_print     !: level of print (0 no print)
+   INTEGER ::   nn_ictls     !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle     !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls     !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle     !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt     !: number of processors following i
+   INTEGER ::   nn_jsplt     !: number of processors following j
+   INTEGER ::   nn_bench     !: 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 ::   numtime         =   -1      !: logical unit for timing
+   INTEGER ::   numout          =    6      !: logical unit for output print; Set to stdout to ensure any early
+                                            !  output can be collected; do not change
+   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist
+   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist
+   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics
+   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
+   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numsol          =   -1      !: logical unit for solver statistics
+   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
+   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
+   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
+   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
+   INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
+   INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
+
+   !!----------------------------------------------------------------------
+   !!                          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(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       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always)
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+   CHARACTER(lc) ::   cxios_context         !: context name used in xios
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: in_out_manager.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!=====================================================================
+END MODULE in_out_manager
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/ioipsl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/ioipsl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/ioipsl.f90	(revision 8732)
@@ -0,0 +1,17 @@
+MODULE ioipsl
+!
+!$Id: ioipsl.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom.f90	(revision 8732)
@@ -0,0 +1,1670 @@
+MODULE iom
+   !!=====================================================================
+   !!                    ***  MODULE  iom ***
+   !! Input/Output manager :  Library to read input files
+   !!====================================================================
+   !! History :  2.0  ! 2005-12  (J. Belier) Original code
+   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
+   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
+   !!            3.6  ! 2014-15  DIMG format removed
+   !!--------------------------------------------------------------------
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis cdvar in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE iom_nf90        ! NetCDF format with native NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE domngb          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE xios
+   USE ioipsl, ONLY :  ju2ymds    ! for calendar
+
+   IMPLICIT NONE
+   PUBLIC   !   must be public to be able to access iom_def through iom
+   
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
+
+
+
+   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
+   PUBLIC iom_getatt, iom_use, iom_context_finalize
+
+   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
+   PRIVATE iom_p1d, iom_p2d, iom_p3d
+
+   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
+   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+
+
+   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
+      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   END INTERFACE
+  INTERFACE iom_put
+     MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+  END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom.F90 6519 2016-05-11 10:50:34Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_init( cdname ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)  :: cdname
+
+      TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
+      CHARACTER(len=19) :: cldate 
+      CHARACTER(len=10) :: clname
+      INTEGER           ::   ji
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( z_bnds(jpk,2) )
+
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
+      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
+      CALL iom_swap( cdname )
+
+      ! calendar parameters
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
+      CASE ( 0)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap")
+      CASE (30)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360")
+      END SELECT
+      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':00')") nyear,nmonth,nday,nhour,nminute
+      CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
+
+      ! horizontal grid definition
+      CALL set_scalar
+
+      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
+         CALL set_grid( "T", glamt, gphit ) 
+         CALL set_grid( "U", glamu, gphiu )
+         CALL set_grid( "V", glamv, gphiv )
+         CALL set_grid( "W", glamt, gphit )
+         CALL set_grid_znl( gphit )
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
+            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
+            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
+         ENDIF
+      ENDIF
+
+      ! vertical grid definition
+      CALL iom_set_axis_attr( "deptht", gdept_1d )
+      CALL iom_set_axis_attr( "depthu", gdept_1d )
+      CALL iom_set_axis_attr( "depthv", gdept_1d )
+      CALL iom_set_axis_attr( "depthw", gdepw_1d )
+
+      ! Add vertical grid bounds
+      z_bnds(:      ,1) = gdepw_1d(:)
+      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
+      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
+      CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
+      CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
+      CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
+      z_bnds(:    ,2) = gdept_1d(:)
+      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1)
+      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1)
+      CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
+
+      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
+      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
+      
+      ! automatic definitions of some of the xml attributs
+      CALL set_xmlatt
+
+      ! end file definition
+      dtime%second = rdt
+      CALL xios_set_timestep(dtime)
+      CALL xios_close_context_definition()
+      
+      CALL xios_update_calendar(0)
+
+      DEALLOCATE( z_bnds )
+
+
+      
+   END SUBROUTINE iom_init
+
+
+   SUBROUTINE iom_swap( cdname )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdname
+
+      TYPE(xios_context) :: nemo_hdl
+
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
+      ELSE
+        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
+      ENDIF
+      !
+      CALL xios_set_current_context(nemo_hdl)
+
+      !
+   END SUBROUTINE iom_swap
+
+
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
+      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90) 
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
+
+      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
+      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" 
+      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
+      CHARACTER(LEN=256)    ::   clinfo    ! info character
+      LOGICAL               ::   llok      ! check the existence 
+      LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
+      LOGICAL               ::   llstop    ! local definition of ldstop
+      LOGICAL               ::   lliof     ! local definition of ldiof
+      INTEGER               ::   iolib     ! library do we use to open the file
+      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
+      INTEGER               ::   iln, ils  ! lengths of character
+      INTEGER               ::   idom      ! type of domain
+      INTEGER               ::   istop     ! 
+      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters: 
+      ! local number of points for x,y dimensions
+      ! position of first local point for x,y dimensions
+      ! position of last local point for x,y dimensions
+      ! start halo size for x,y dimensions
+      ! end halo size for x,y dimensions
+      !---------------------------------------------------------------------
+      ! Initializations and control
+      ! =============
+      kiomid = -1
+      clinfo = '                    iom_open ~~~  '
+      istop = nstop
+      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
+      ! (could be done when defining iom_file in f95 but not in f90)
+      IF( Agrif_Root() ) THEN
+         IF( iom_open_init == 0 ) THEN
+            iom_file(:)%nfid = 0
+            iom_open_init = 1
+         ENDIF
+      ENDIF
+      ! do we read or write the file?
+      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
+      ELSE                        ;   llwrt = .FALSE.
+      ENDIF
+      ! do we call ctl_stop if we try to open a non-existing file in read mode?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      ! what library do we use to open the file?
+      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib
+      ELSE                         ;   iolib = jpnf90
+      ENDIF
+      ! are we using interpolation on the fly?
+      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
+      ELSE                        ;   lliof = .FALSE.
+      ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
+      ! =============
+      clname   = trim(cdname)
+      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
+      ! which suffix should we use?
+      SELECT CASE (iolib)
+      CASE (jpnf90   ) ;   clsuffix = '.nc'
+      CASE DEFAULT     ;   clsuffix = ''
+         CALL ctl_stop( TRIM(clinfo), 'accepted IO library is only jpnf90 (jpioipsl option has been removed) ' )
+      END SELECT
+      ! Add the suffix if needed
+      iln = LEN_TRIM(clname)
+      ils = LEN_TRIM(clsuffix)
+      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
+         &   clname = TRIM(clname)//TRIM(clsuffix)
+      cltmpn = clname   ! store this name
+      ! try to find if the file to be opened already exist
+      ! =============
+      INQUIRE( FILE = clname, EXIST = llok )
+      IF( .NOT.llok ) THEN
+         ! we try to add the cpu number to the name
+         WRITE(clcpu,*) narea-1
+
+         clcpu  = TRIM(ADJUSTL(clcpu))
+         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
+         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+         icnt = 0
+         INQUIRE( FILE = clname, EXIST = llok ) 
+         ! we try different formats for the cpu number by adding 0
+         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
+            clcpu  = "0"//trim(clcpu)
+            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+            INQUIRE( FILE = clname, EXIST = llok )
+            icnt = icnt + 1
+         END DO
+      ENDIF
+      IF( llwrt ) THEN
+         ! check the domain definition
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         idom = jpdom_local_noovlap   ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
+         ENDIF
+         IF( PRESENT(kdom) )   idom = kdom
+         ! create the domain informations
+         ! =============
+         SELECT CASE (idom)
+         CASE (jpdom_local_full)
+            idompar(:,1) = (/ jpi             , jpj              /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
+         CASE (jpdom_local_noextra)
+            idompar(:,1) = (/ nlci            , nlcj             /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
+         CASE (jpdom_local_noovlap)
+            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
+            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
+            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
+            idompar(:,4) = (/ 0               , 0                /)
+            idompar(:,5) = (/ 0               , 0                /)
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
+         END SELECT
+      ENDIF
+      ! Open the NetCDF file
+      ! =============
+      ! do we have some free file identifier?
+      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
+         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
+      ! if no file was found...
+      IF( .NOT. llok ) THEN
+         IF( .NOT. llwrt ) THEN   ! we are in read mode 
+            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
+            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
+            ENDIF
+         ELSE                     ! we are in write mode so we 
+            clname = cltmpn       ! get back the file name without the cpu number
+         ENDIF
+      ELSE
+         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
+            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
+            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
+         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
+            clname = cltmpn       ! overwrite so get back the file name without the cpu number
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN   ! no error within this routine
+         SELECT CASE (iolib)
+         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' )
+         END SELECT
+      ENDIF
+      !
+   END SUBROUTINE iom_open
+
+
+   SUBROUTINE iom_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_close  ***
+      !!
+      !! ** Purpose : close an input file, or all files opened by iom
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
+      !                                              ! return 0 when file is properly closed
+      !                                              ! No argument: all files opened by iom are closed
+
+      INTEGER ::   jf         ! dummy loop indices
+      INTEGER ::   i_s, i_e   ! temporary integer
+      CHARACTER(LEN=100)    ::   clinfo    ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_close ~~~  '
+      IF( PRESENT(kiomid) ) THEN
+         i_s = kiomid
+         i_e = kiomid
+      ELSE
+         i_s = 1
+         i_e = jpmax_files
+      ENDIF
+
+      IF( i_s > 0 ) THEN
+         DO jf = i_s, i_e
+            IF( iom_file(jf)%nfid > 0 ) THEN
+               SELECT CASE (iom_file(jf)%iolib)
+               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
+               CASE DEFAULT
+                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+               END SELECT
+               iom_file(jf)%nfid       = 0          ! free the id 
+               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
+            ELSEIF( PRESENT(kiomid) ) THEN
+               WRITE(ctmp1,*) '--->',  kiomid
+               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
+            ENDIF
+         END DO
+      ENDIF
+      !    
+   END SUBROUTINE iom_close
+
+
+   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
+      !
+      INTEGER                        ::   iom_varid, iiv, i_nvd
+      LOGICAL                        ::   ll_fnd
+      CHARACTER(LEN=100)             ::   clinfo                   ! info character
+      LOGICAL                        ::   llstop                   ! local definition of ldstop
+      !!-----------------------------------------------------------------------
+      iom_varid = 0                         ! default definition
+      ! do we call ctl_stop if we look for non-existing variable?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      !
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+         IF( iom_file(kiomid)%nfid == 0 ) THEN 
+            CALL ctl_stop( trim(clinfo), 'the file is not open' )
+         ELSE
+            ll_fnd  = .FALSE.
+            iiv = 0
+            !
+            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
+               iiv = iiv + 1
+               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
+            END DO
+            !
+            IF( .NOT.ll_fnd ) THEN
+               iiv = iiv + 1
+               IF( iiv <= jpmax_vars ) THEN
+                  SELECT CASE (iom_file(kiomid)%iolib)
+                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims )
+                  CASE DEFAULT
+                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+                  END SELECT
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
+                        &                         'increase the parameter jpmax_vars')
+               ENDIF
+               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
+            ELSE
+               iom_varid = iiv
+               IF( PRESENT(kdimsz) ) THEN 
+                  i_nvd = iom_file(kiomid)%ndims(iiv)
+                  IF( i_nvd == size(kdimsz) ) THEN
+                     kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
+                  ELSE
+                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
+                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
+                  ENDIF
+               ENDIF
+               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END FUNCTION iom_varid
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_get
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
+      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
+      !
+      INTEGER                                         ::   idvar     ! variable id
+      INTEGER                                         ::   idmspc    ! number of spatial dimensions
+      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
+      CHARACTER(LEN=100)                              ::   clinfo    ! info character
+      CHARACTER(LEN=100)                              ::   clname    ! file name
+      CHARACTER(LEN=1)                                ::   cldmspc   !
+      !
+      itime = 1
+      IF( PRESENT(ktime) ) itime = ktime
+      !
+      clname = iom_file(kiomid)%name
+      clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
+      !
+      IF( kiomid > 0 ) THEN
+         idvar = iom_varid( kiomid, cdvar )
+         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+            idmspc = iom_file ( kiomid )%ndims( idvar )
+            IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
+            WRITE(cldmspc , fmt='(i1)') idmspc
+            IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
+                                 &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
+                                 &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d
+
+   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+      ENDIF
+   END SUBROUTINE iom_g1d
+
+   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
+      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                               ! look for and use a file attribute
+                                                                               ! called open_ocean_jstart to set the start
+                                                                               ! value for the 2nd dimension (netcdf only)
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr )
+      ENDIF
+   END SUBROUTINE iom_g2d
+
+   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
+      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                                 ! look for and use a file attribute
+                                                                                 ! called open_ocean_jstart to set the start
+                                                                                 ! value for the 2nd dimension (netcdf only)
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr )
+      ENDIF
+   END SUBROUTINE iom_g3d
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
+         &                  pv_r1d, pv_r2d, pv_r3d,   &
+         &                  ktime , kstart, kcount,   &
+         &                  lrowattr                )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_get_123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
+                                                                           ! look for and use a file attribute
+                                                                           ! called open_ocean_jstart to set the start
+                                                                           ! value for the 2nd dimension (netcdf only)
+      !
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
+      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
+      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
+      INTEGER                        ::   jl          ! loop on number of dimension 
+      INTEGER                        ::   idom        ! type of domain
+      INTEGER                        ::   idvar       ! id of the variable
+      INTEGER                        ::   inbdim      ! number of dimensions of the variable
+      INTEGER                        ::   idmspc      ! number of spatial dimensions 
+      INTEGER                        ::   itime       ! record number
+      INTEGER                        ::   istop       ! temporary value of nstop
+      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER                        ::   ji, jj      ! loop counters
+      INTEGER                        ::   irankpv     ! 
+      INTEGER                        ::   ind1, ind2  ! substring index
+      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
+      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
+      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
+      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
+      INTEGER                        ::   itmp        ! temporary integer
+      CHARACTER(LEN=256)             ::   clinfo      ! info character
+      CHARACTER(LEN=256)             ::   clname      ! file name
+      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
+      !---------------------------------------------------------------------
+      !
+      clname = iom_file(kiomid)%name   !   esier to read
+      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
+      ! local definition of the domain ?
+      idom = kdom
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+      ! check kcount and kstart optionals parameters...
+      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
+      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
+      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) &
+     &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
+
+      luse_jattr = .false.
+      IF( PRESENT(lrowattr) ) THEN
+         IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
+         IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true.
+      ENDIF
+      IF( luse_jattr ) THEN
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpnf90   )   
+             ! Ok
+         CASE DEFAULT    
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+         END SELECT
+      ENDIF
+
+      ! Search for the variable in the data base (eventually actualize data)
+      istop = nstop
+      idvar = iom_varid( kiomid, cdvar )
+      !
+      IF( idvar > 0 ) THEN
+         ! to write iom_file(kiomid)%dimsz in a shorter way !
+         idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
+         inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
+         idmspc = inbdim                                   ! number of spatial dimensions in the file
+         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
+         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
+         !
+         ! update idom definition...
+         ! Identify the domain in case of jpdom_auto(glo/dta) definition
+         IF( idom == jpdom_autoglo_xy ) THEN
+            ll_depth_spec = .TRUE.
+            idom = jpdom_autoglo
+         ELSE
+            ll_depth_spec = .FALSE.
+         ENDIF
+         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
+            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
+            ELSE                               ;   idom = jpdom_data
+            ENDIF
+            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
+            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
+            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
+         ENDIF
+         ! Identify the domain in case of jpdom_local definition
+         IF( idom == jpdom_local ) THEN
+            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
+            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
+            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
+            ENDIF
+         ENDIF
+         !
+         ! check the consistency between input array and data rank in the file
+         !
+         ! initializations
+         itime = 1
+         IF( PRESENT(ktime) ) itime = ktime
+
+         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
+         WRITE(clrankpv, fmt='(i1)') irankpv
+         WRITE(cldmspc , fmt='(i1)') idmspc
+         !
+         IF(     idmspc <  irankpv ) THEN 
+            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+               &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+         ELSEIF( idmspc == irankpv ) THEN
+            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
+               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
+         ELSEIF( idmspc >  irankpv ) THEN
+               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
+                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
+                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
+                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
+                  idmspc = idmspc - 1
+               ELSE
+                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
+                     &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
+                     &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+               ENDIF
+         ENDIF
+
+         !
+         ! definition of istart and icnt
+         !
+         icnt  (:) = 1
+         istart(:) = 1
+         istart(idmspc+1) = itime
+
+         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
+         ELSE
+            IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc)
+            ELSE 
+               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
+                  IF(     idom == jpdom_data    ) THEN
+                     jstartrow = 1
+                     IF( luse_jattr ) THEN
+                        CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+                        jstartrow = MAX(1,jstartrow)
+                     ENDIF
+                     istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below
+                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below
+                  ENDIF
+                  ! we do not read the overlap                     -> we start to read at nldi, nldj
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                  ENDIF
+                  IF( PRESENT(pv_r3d) ) THEN
+                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta
+                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3)
+                     ELSE                                                           ; icnt(3) = jpk
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+
+         ! check that istart and icnt can be used with this file
+         !-
+         DO jl = 1, jpmax_dims
+            itmp = istart(jl)+icnt(jl)-1
+            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
+               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
+               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
+               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
+            ENDIF
+         END DO
+
+         ! check that icnt matches the input array
+         !-     
+         IF( idom == jpdom_unknown ) THEN
+            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
+            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
+            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
+            ctmp1 = 'd'
+         ELSE
+            IF( irankpv == 2 ) THEN
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
+               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+               ENDIF
+            ENDIF
+            IF( irankpv == 3 ) THEN 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
+               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+               ENDIF
+            ENDIF
+         ENDIF
+         
+         DO jl = 1, irankpv
+            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
+            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
+         END DO
+
+      ENDIF
+
+      ! read the data
+      !-     
+      IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
+         !
+         ! find the right index of the array to be read
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+!         ENDIF
+         IF( llnoov ) THEN
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+            ENDIF
+         ELSE
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+            ENDIF
+         ENDIF
+      
+         SELECT CASE (iom_file(kiomid)%iolib)
+         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+         END SELECT
+
+         IF( istop == nstop ) THEN   ! no additional errors until this point...
+            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+          
+            !--- overlap areas and extra hallows (mpp)
+            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
+               CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
+            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
+               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
+               IF( icnt(3) == jpk ) THEN
+                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
+               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
+                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
+                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
+               ENDIF
+            ENDIF
+            
+            !--- Apply scale_factor and offset
+            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
+            zofs = iom_file(kiomid)%ofs(idvar)      ! offset
+            IF(     PRESENT(pv_r1d) ) THEN
+               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
+               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
+            ELSEIF( PRESENT(pv_r2d) ) THEN
+               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
+               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
+            ELSEIF( PRESENT(pv_r3d) ) THEN
+               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
+               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE iom_get_123d
+
+
+   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier
+      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name
+      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file
+      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate
+      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of 
+      !
+      INTEGER, DIMENSION(1) :: kdimsz
+      INTEGER            ::   idvar    ! id of the variable
+      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate
+      CHARACTER(LEN=100) ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      IF ( PRESENT(cdvar) ) THEN
+         tname = cdvar
+      ELSE
+         tname = iom_file(kiomid)%uldname
+      ENDIF
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
+         IF ( PRESENT(kntime) ) THEN
+            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz )
+            kntime = kdimsz(1)
+         ELSE
+            idvar = iom_varid( kiomid, tname )
+         ENDIF
+         !
+         ptime(:) = 0. ! default definition
+         IF( idvar > 0 ) THEN
+            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
+               IF( iom_file(kiomid)%luld(idvar) ) THEN
+                  IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
+                     SELECT CASE (iom_file(kiomid)%iolib)
+                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
+                     CASE DEFAULT
+                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+                     END SELECT
+                  ELSE
+                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
+                     CALL ctl_stop( trim(clinfo), trim(ctmp1) )
+                  ENDIF
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
+               ENDIF
+            ELSE
+               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
+            ENDIF
+         ELSE
+            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
+         ENDIF
+      ENDIF
+      !
+   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 (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library is only jpnf90' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_intatt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_rstput
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp0d
+
+   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp1d
+
+   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp2d
+
+   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      INTEGER :: ivid   ! variable id
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            CASE DEFAULT
+               CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp3d
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_put
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d( cdname, pfield0d )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      REAL(wp)        , INTENT(in) ::   pfield0d
+      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+
+      zz(:,:)=pfield0d
+      CALL xios_send_field(cdname, zz)
+      !CALL xios_send_field(cdname, (/pfield0d/)) 
+
+
+
+   END SUBROUTINE iom_p0d
+
+   SUBROUTINE iom_p1d( cdname, pfield1d )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
+
+      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
+
+
+
+   END SUBROUTINE iom_p1d
+
+   SUBROUTINE iom_p2d( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+
+      CALL xios_send_field(cdname, pfield2d)
+
+
+
+   END SUBROUTINE iom_p2d
+
+   SUBROUTINE iom_p3d( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+
+      CALL xios_send_field(cdname, pfield3d)
+
+
+
+   END SUBROUTINE iom_p3d
+   !!----------------------------------------------------------------------
+
+
+
+   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   &
+      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
+      &                                    nvertex, bounds_lon, bounds_lat, area )
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
+      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
+      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask
+
+      IF ( xios_is_valid_domain     (cdid) ) THEN
+         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       &
+            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
+            &    bounds_lat=bounds_lat, area=area )
+      ENDIF
+
+      IF ( xios_is_valid_domaingroup(cdid) ) THEN
+         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       &
+            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
+            &    bounds_lat=bounds_lat, area=area )
+      ENDIF
+      CALL xios_solve_inheritance()
+
+   END SUBROUTINE iom_set_domain_attr
+
+
+   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
+      CHARACTER(LEN=*)      , INTENT(in) ::   cdid
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
+      IF ( PRESENT(paxis) ) THEN
+         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis )
+         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
+      ENDIF
+      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
+      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_axis_attr
+
+
+   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset
+      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
+    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
+    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_field_attr
+
+
+   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
+      IF ( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix )
+      IF ( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_file_attr
+
+
+   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
+      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq
+      LOGICAL                                 ::   llexist1,llexist2,llexist3
+      !---------------------------------------------------------------------
+      IF( PRESENT( name        ) )   name = ''          ! default values
+      IF( PRESENT( name_suffix ) )   name_suffix = ''
+      IF( PRESENT( output_freq ) )   output_freq = ''
+      IF ( xios_is_valid_file     (cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name )
+         IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq )
+      ENDIF
+      IF ( xios_is_valid_filegroup(cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name )
+         IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
+      ENDIF
+   END SUBROUTINE iom_get_file_attr
+
+
+   SUBROUTINE iom_set_grid_attr( cdid, mask )
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
+      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask )
+      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_grid_attr
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in) ::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !     
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_update_calendar(kt)
+      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+      !
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) :: cdname
+      !
+      IF( xios_is_valid_context(cdname) ) THEN
+         CALL iom_swap( cdname )   ! swap to cdname context
+         CALL xios_context_finalize() ! finalize the context
+         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+      ENDIF
+      !
+   END SUBROUTINE iom_context_finalize
+
+
+   SUBROUTINE set_grid( cdgrd, plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid  ***
+      !!
+      !! ** Purpose :   define horizontal grids
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
+      INTEGER  :: ni,nj
+      
+      ni=nlei-nldi+1 ; nj=nlej-nldj+1
+
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
+         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+
+      IF ( ln_mskland ) THEN
+         ! mask land points, keep values on coast line -> specific mask for U, V and W points
+         SELECT CASE ( cdgrd )
+         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:)
+         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( zmask, 'U', 1. )
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( zmask, 'V', 1. )
+         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
+         END SELECT
+         !
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj    /)) /= 0. )
+         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
+      ENDIF
+      
+   END SUBROUTINE set_grid
+
+
+   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE set_grid_bounds  ***
+      !!
+      !! ** Purpose :   define horizontal grid corners
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1) , INTENT(in) :: cdgrd
+      !
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j)
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells
+      !
+      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                          ! represents the bottom-left corner of cell (i,j)
+      INTEGER :: ji, jj, jn, ni, nj
+
+      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
+
+      ! Offset of coordinate representing bottom-left corner
+      SELECT CASE ( TRIM(cdgrd) )
+         CASE ('T', 'W')
+            icnr = -1 ; jcnr = -1
+         CASE ('U')
+            icnr =  0 ; jcnr = -1
+         CASE ('V')
+            icnr = -1 ; jcnr =  0
+      END SELECT
+
+      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior
+
+      z_fld(:,:) = 1._wp
+      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold
+
+      ! Cell vertices that can be defined
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+         END DO
+      END DO
+
+      ! Cell vertices on boundries
+      DO jn = 1, 4
+         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
+         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
+      END DO
+
+      ! Zero-size cells at closed boundaries if cell points provided,
+      ! otherwise they are closed cells with unrealistic bounds
+      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
+         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (West or jpni = 1), closed E-W
+               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:)
+            END DO
+         ENDIF
+         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (East or jpni = 1), closed E-W
+               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
+            END DO
+         ENDIF
+         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
+            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric)
+               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1)
+            END DO
+         ENDIF
+         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN
+            DO jn = 1, 4        ! (North or jpnj = 1), no north fold
+               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
+            END DO
+         ENDIF
+      ENDIF
+
+      ! Rotate cells at the north fold
+      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( z_fld(ji,jj) == -1. ) THEN
+                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
+                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
+                  z_bnds(:,ji,jj,:) = z_rot(:,:)
+               ENDIF
+            END DO
+         END DO
+
+      ! Invert cells at the symmetric equator
+      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
+         DO ji = 1, jpi
+            z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
+            z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
+            z_bnds(:,ji,1,:) = z_rot(:,:)
+         END DO
+      ENDIF
+
+      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           &
+                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
+
+      DEALLOCATE( z_bnds, z_fld, z_rot ) 
+
+   END SUBROUTINE set_grid_bounds
+
+
+   SUBROUTINE set_grid_znl( plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid_znl  ***
+      !!
+      !! ** Purpose :   define grids for zonal mean
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
+      INTEGER  :: ni,nj, ix, iy
+
+      
+      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk)
+      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0.
+
+      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
+         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      !
+      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
+      CALL iom_update_file_name('ptr')
+      !
+   END SUBROUTINE set_grid_znl
+
+   SUBROUTINE set_scalar
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_scalar  ***
+      !!
+      !! ** Purpose :   define fake grids for scalar point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1)   ::   zz = 1.
+      !!----------------------------------------------------------------------
+      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
+      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+      
+      zz=REAL(narea,wp)
+      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
+
+   END SUBROUTINE set_scalar
+
+
+   SUBROUTINE set_xmlatt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_xmlatt  ***
+      !!
+      !! ** Purpose :   automatic definitions of some of the xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
+      CHARACTER(len=256)             ::   clsuff                   ! suffix name
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 2 characters
+      CHARACTER(len=3)               ::   cl3                      ! 3 characters
+      INTEGER                        ::   ji, jg                   ! loop counters
+      INTEGER                        ::   ix, iy                   ! i-,j- index
+      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
+      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
+      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
+      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
+      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
+      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
+      !!----------------------------------------------------------------------
+      ! 
+      ! frequency of the call of iom_put (attribut: freq_op)
+      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts')
+       
+      ! output file names (attribut: name)
+      DO ji = 1, 9
+         WRITE(cl1,'(i1)') ji 
+         CALL iom_update_file_name('file'//cl1)
+      END DO
+      DO ji = 1, 99
+         WRITE(cl2,'(i2.2)') ji 
+         CALL iom_update_file_name('file'//cl2)
+      END DO
+      DO ji = 1, 999
+         WRITE(cl3,'(i3.3)') ji 
+         CALL iom_update_file_name('file'//cl3)
+      END DO
+
+      ! Zooms...
+      clgrd = (/ 'T', 'U', 'W' /) 
+      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
+         cl1 = clgrd(jg)
+         ! Equatorial section (attributs: jbegin, ni, name_suffix)
+         CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
+         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
+         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
+         CALL iom_update_file_name('Eq'//cl1)
+      END DO
+      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
+      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
+      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
+      CALL set_mooring( zlontao, zlattao )
+      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
+      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
+      CALL set_mooring( zlonrama, zlatrama )
+      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonpira = (/ -38.0, -23.0, -10.0 /)
+      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
+      CALL set_mooring( zlonpira, zlatpira )
+
+      
+   END SUBROUTINE set_xmlatt
+
+
+   SUBROUTINE set_mooring( plon, plat)
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_mooring  ***
+      !!
+      !! ** Purpose :   automatic definitions of moorings xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in) ::  plon, plat           ! longitudes/latitudes oft the mooring
+      !
+!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
+      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
+      CHARACTER(len=256)            ::   clname                   ! file name
+      CHARACTER(len=256)            ::   clsuff                   ! suffix name
+      CHARACTER(len=1)              ::   cl1                      ! 1 character
+      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
+      INTEGER                       ::   ji, jj, jg               ! loop counters
+      INTEGER                       ::   ix, iy                   ! i-,j- index
+      REAL(wp)                      ::   zlon, zlat
+      !!----------------------------------------------------------------------
+      DO jg = 1, SIZE(clgrd)
+         cl1 = clgrd(jg)
+         DO ji = 1, SIZE(plon)
+            DO jj = 1, SIZE(plat)
+               zlon = plon(ji)
+               zlat = plat(jj)
+               ! modifications for RAMA moorings
+               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
+               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
+               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
+               ! modifications for PIRATA moorings
+               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
+               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
+               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
+               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
+               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
+               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
+               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
+               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
+               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
+               IF( zlon >= 0. ) THEN  
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
+                  ENDIF
+               ELSE             
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
+                  ENDIF
+               ENDIF
+               IF( zlat >= 0. ) THEN  
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
+                  ENDIF
+               ELSE             
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
+                  ENDIF
+               ENDIF
+               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+               CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
+               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
+               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
+               CALL iom_update_file_name(TRIM(clname)//cl1)
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE set_mooring
+
+   
+   SUBROUTINE iom_update_file_name( cdid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_update_file_name  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      !
+      CHARACTER(LEN=256) ::   clname
+      CHARACTER(LEN=20)  ::   clfreq
+      CHARACTER(LEN=20)  ::   cldate
+      INTEGER            ::   idx
+      INTEGER            ::   jn
+      INTEGER            ::   itrlen
+      INTEGER            ::   iyear, imonth, iday, isec
+      REAL(wp)           ::   zsec
+      LOGICAL            ::   llexist
+      !!----------------------------------------------------------------------
+
+      DO jn = 1,2
+
+         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq )
+         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
+
+         IF ( TRIM(clname) /= '' ) THEN 
+
+            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            DO WHILE ( idx /= 0 ) 
+               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            END DO
+
+            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            DO WHILE ( idx /= 0 ) 
+               IF ( TRIM(clfreq) /= '' ) THEN
+                  itrlen = LEN_TRIM(clfreq)
+                  IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1)
+                  clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname))
+               ELSE
+                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
+                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
+               ENDIF
+               idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            END DO
+
+            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            END DO
+
+            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            END DO
+
+            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            END DO
+
+            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            END DO
+
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
+            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
+
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE iom_update_file_name
+
+
+   FUNCTION iom_sdate( pjday, ld24, ldfull )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_sdate  ***
+      !!
+      !! ** Purpose :   send back the date corresponding to the given julian day
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )           ::   pjday         ! julian day
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24          ! true to force 24:00 instead of 00:00
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull        ! true to get the compleate date: yyyymmdd_hh:mm:ss
+      !
+      CHARACTER(LEN=20) ::   iom_sdate
+      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date 
+      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec
+      REAL(wp)          ::   zsec
+      LOGICAL           ::   ll24, llfull
+      !
+      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24
+      ELSE                       ;   ll24 = .FALSE.
+      ENDIF
+
+      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull
+      ELSE                         ;   llfull = .FALSE.
+      ENDIF
+
+      CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
+      isec = NINT(zsec)
+
+      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
+         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
+         isec = 86400
+      ENDIF
+
+      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date 
+      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
+      ENDIF
+      
+!$AGRIF_DO_NOT_TREAT      
+! Should be fixed in the conv
+      IF( llfull ) THEN 
+         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
+         ihour   = isec / 3600
+         isec    = MOD(isec, 3600)
+         iminute = isec / 60
+         isec    = MOD(isec, 60)
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run
+      ELSE
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
+      ENDIF
+!$AGRIF_END_DO_NOT_TREAT      
+
+   END FUNCTION iom_sdate
+
+
+   LOGICAL FUNCTION iom_use( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      iom_use = xios_field_is_active( cdname )
+   END FUNCTION iom_use
+   
+   !!======================================================================
+END MODULE iom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom_def.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom_def.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom_def.f90	(revision 8732)
@@ -0,0 +1,71 @@
+MODULE iom_def
+   !!=====================================================================
+   !!                    ***  MODULE  iom_def ***
+   !! IOM variables definitions
+   !!====================================================================
+   !! History :  9.0  ! 06 09  (S. Masson) Original code
+   !!             "   ! 07 07  (D. Storkey) Add uldname
+   !!--------------------------------------------------------------------
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom_def.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta)
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo)
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !: 
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !: 
+
+   INTEGER, PARAMETER, PUBLIC ::   jpnf90      = 101      !: Use nf90 library
+
+   INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jpnf90     !: restarts io library
+
+   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
+   INTEGER, PARAMETER, PUBLIC ::   jp_r4    = 201      !: write REAL(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i4    = 202      !: write INTEGER(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i2    = 203      !: write INTEGER(2)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
+
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600  !: maximum number of variables in one file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name
+
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0
+
+   TYPE, PUBLIC ::   file_descriptor
+      CHARACTER(LEN=240)                        ::   name     !: name of the file
+      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
+      INTEGER                                   ::   iolib    !: library used to read the file (jpnf90 or new formats,
+                                                              !: jpioipsl option has been removed)
+      INTEGER                                   ::   nvars    !: number of identified varibles in the file
+      INTEGER                                   ::   iduld    !: id of the unlimited dimension
+      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file)
+      INTEGER                                   ::   irec     !: writing record position  
+      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension
+      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   nvid     !: id of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables
+      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     !: variable using the unlimited dimension
+      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions 
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables
+   END TYPE file_descriptor
+   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files
+!$AGRIF_END_DO_NOT_TREAT
+
+   !!=====================================================================
+END MODULE iom_def
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom_nf90.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom_nf90.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iom_nf90.f90	(revision 8732)
@@ -0,0 +1,582 @@
+MODULE iom_nf90
+   !!=====================================================================
+   !!                    ***  MODULE  iom_nf90 ***
+   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
+   !!====================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
+   !!--------------------------------------------------------------------
+   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
+
+   !!--------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_gettime    : read the time axis kvid in the file
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!--------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE netcdf          ! NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: iom_nf90.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+
+      CHARACTER(LEN=256) ::   clinfo           ! info character
+      CHARACTER(LEN=256) ::   cltmp            ! temporary character
+      INTEGER            ::   iln              ! lengths of character
+      INTEGER            ::   istop            ! temporary storage of nstop
+      INTEGER            ::   if90id           ! nf90 identifier of the opened file
+      INTEGER            ::   idmy             ! dummy variable
+      INTEGER            ::   jl               ! loop variable
+      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
+      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
+      !---------------------------------------------------------------------
+
+      clinfo = '                    iom_nf90_open ~~~  '
+      istop = nstop   ! store the actual value of nstop
+      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
+      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
+      ENDIF
+      !
+      llclobber = ldwrt .AND. ln_clobber
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
+         !                 ! =============
+         IF( ldwrt ) THEN  ! ... in write mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
+            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
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
+         ENDIF
+      ELSE                                       ! the file does not exist (or we overwrite it)
+         !                 ! =============
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
+
+            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
+            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
+            ENDIF
+            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
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo)
+            ! global attributes
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo)
+         ELSE              ! the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      ! start to fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%nfid   = if90id
+         iom_file(kiomid)%iolib  = jpnf90
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
+         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
+         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN
+           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     & 
+        &                                               name = iom_file(kiomid)%uldname,  &
+        &                                               len  = iom_file(kiomid)%lenuld ), clinfo )
+         ENDIF
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_open
+
+
+   SUBROUTINE iom_nf90_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_close  ***
+      !!
+      !! ** Purpose : close an input file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      CHARACTER(LEN=100)  ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
+      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
+      !    
+   END SUBROUTINE iom_nf90_close
+
+
+   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER              , INTENT(in   )           ::   kiv   ! 
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      !
+      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
+      INTEGER                        ::   if90id           ! nf90 file identifier
+      INTEGER                        ::   ji               ! dummy loop index
+      INTEGER                        ::   ivarid           ! NetCDF  variable Id
+      INTEGER                        ::   i_nvd            ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
+      LOGICAL                        ::   llok             ! ok  test
+      CHARACTER(LEN=100)             ::   clinfo           ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      iom_nf90_varid = 0                    ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
+      !
+      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
+      IF( llok ) THEN
+         iom_nf90_varid = kiv
+         iom_file(kiomid)%nvars       = kiv
+         iom_file(kiomid)%nvid(kiv)   = ivarid
+         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
+         iom_file(kiomid)%ndims(kiv)  = i_nvd
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
+         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used
+         DO ji = 1, i_nvd                       ! dimensions size
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
+            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
+         END DO
+         !---------- Deal with scale_factor and add_offset
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
+         IF( llok) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%scf(kiv) = 1.
+         END IF
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
+         IF( llok ) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%ofs(kiv) = 0.
+         END IF
+         ! return the simension size
+         IF( PRESENT(kdimsz) ) THEN 
+            IF( i_nvd == SIZE(kdimsz) ) THEN
+               kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
+            ELSE
+               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
+               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
+            ENDIF
+         ENDIF
+         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv)
+      ELSE  
+         iom_nf90_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_nf90_varid
+
+
+   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file
+      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id
+      REAL(wp),               INTENT(  out)            ::   pvar     ! read field
+      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis
+      !
+      CHARACTER(LEN=100)      ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo )
+      ! 
+   END SUBROUTINE iom_nf90_g0d
+
+
+   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                    pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with NF90
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
+      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
+      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
+      !
+      CHARACTER(LEN=100) ::   clinfo               ! info character
+      INTEGER            ::   if90id               ! nf90 identifier of the opened file
+      INTEGER            ::   ivid                 ! nf90 variable id
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
+      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
+      !
+      IF(     PRESENT(pv_r1d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_g123d
+
+
+   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 )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis kvid in the file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
+      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
+      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
+      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
+      !
+      CHARACTER(LEN=100) ::   clinfo     ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_gettime, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   &
+            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo)
+      IF ( PRESENT(cdunits) ) THEN 
+         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", &
+            &                           values=cdunits), clinfo)
+      ENDIF
+      IF ( PRESENT(cdcalendar) ) THEN 
+         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", &
+            &                           values=cdcalendar), clinfo)
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_gettime
+
+
+   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      INTEGER               :: idims                ! number of dimension
+      INTEGER               :: idvar                ! variable id
+      INTEGER               :: jd                   ! dimension loop counter   
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=256)    :: clinfo               ! info character
+      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character
+      INTEGER               :: if90id               ! nf90 file identifier
+      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)
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      if90id = iom_file(kiomid)%nfid
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! define the dimension variables if it is not already done
+         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
+         ! update informations structure related the dimension variable we just added...
+         iom_file(kiomid)%nvars       = 4
+         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
+         iom_file(kiomid)%cn_var(1:4) = cltmp
+         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)  
+         ! trick: defined to 0 to say that dimension variables are defined but not yet written
+         iom_file(kiomid)%dimsz(1, 1)  = 0   
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
+      ENDIF
+      ! define the data if it is not already done
+      ! ===============
+      IF( kvid <= 0 ) THEN
+         !
+         ! 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?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! variable definition
+         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
+         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
+         ENDIF
+         IF( PRESENT(ktype) ) THEN   ! variable external type
+            SELECT CASE (ktype)
+            CASE (jp_r8)  ;   itype = NF90_DOUBLE
+            CASE (jp_r4)  ;   itype = NF90_FLOAT
+            CASE (jp_i4)  ;   itype = NF90_INT
+            CASE (jp_i2)  ;   itype = NF90_SHORT
+            CASE (jp_i1)  ;   itype = NF90_BYTE
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = NF90_DOUBLE
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
+                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
+         ELSE
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
+                 &                            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
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%scf(idvar)    = 1.
+         iom_file(kiomid)%ofs(idvar)    = 0.
+         iom_file(kiomid)%ndims(idvar)  = idims
+         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
+         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         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
+         idvar = kvid
+      ENDIF
+
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! are we in write mode?
+         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
+         ENDIF
+         ! on what kind of domain must the data be written?
+         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
+            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
+            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
+               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
+               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSE 
+               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
+            ENDIF
+
+            ! write dimension variables if it is not already done
+            ! =============
+            ! trick: is defined to 0 => dimension variable are defined but not yet written
+            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo)
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo)
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d                ), clinfo)
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)
+               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)   
+               ! update the values of the variables dimensions size
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)
+               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
+               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)
+               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d                      ), clinfo)
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d(                  :) ), clinfo)
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2   ) ), clinfo)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)
+         ENDIF
+         ! add 1 to the size of the temporal dimension (not really useful...)
+         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
+               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !     
+   END SUBROUTINE iom_nf90_rp0123d
+
+
+   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_nf90_check  ***
+      !!
+      !! ** Purpose :   check nf90 errors
+      !!--------------------------------------------------------------------
+      INTEGER,          INTENT(in) :: kstatus
+      CHARACTER(LEN=*), INTENT(in) :: cdinfo
+      !---------------------------------------------------------------------
+      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
+   END SUBROUTINE iom_nf90_check
+
+   !!======================================================================
+END MODULE iom_nf90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplhsb.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplhsb.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplhsb.f90	(revision 8732)
@@ -0,0 +1,331 @@
+MODULE iscplhsb
+   !!======================================================================
+   !!                       ***  MODULE  iscplhsb***
+   !! Ocean forcing: ice sheet/ocean coupling (conservation)
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_alloc    : variable allocation
+   !!   iscpl_hsb      : compute and store the input of heat/salt/volume 
+   !!                    into the system due to the coupling process
+   !!   iscpl_div      : correction of divergence to keep volume conservation
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domwri          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface boundary condition variables
+   USE oce             ! global tra/dyn variable
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE lbclnk          !
+   USE domngb          !
+   USE iscplini
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_div   
+   PUBLIC   iscpl_cons       
+   !! * Substitutions  
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iscpl_cons(ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_cons  ***
+      !! 
+      !! ** Purpose :   compute input into the system during the coupling step
+      !!                compute the correction term
+      !!                compute where the correction have to be applied
+      !! 
+      !! ** Method  :   compute tsn*e3t-tsb*e3tb and e3t-e3t_b
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b      !! scale factor before
+      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) :: pts_flx     !! corrective flux to have tracer conservation
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation
+      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period 
+      !!
+      INTEGER :: ji, jj, jk                                    !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1
+      !!
+      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
+      REAL(wp):: r1_rdtiscpl
+      REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio
+      !!
+      REAL(wp):: zde3t, zdtem, zdsal
+      REAL(wp), DIMENSION(:,:), POINTER :: zdssh
+      !!
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
+      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
+      INTEGER :: jpts, npts
+
+      CALL wrk_alloc(jpi,jpj, zdssh )
+
+      ! get imbalance (volume heat and salt)
+      ! initialisation difference
+      zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp
+
+      ! initialisation correction term
+      pvol_flx(:,:,:  ) = 0.0_wp
+      pts_flx (:,:,:,:) = 0.0_wp
+      
+      r1_rdtiscpl = 1._wp / prdt_iscpl 
+
+      ! mask tsn and tsb 
+      tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:);
+      tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:);
+
+      !==============================================================================
+      ! diagnose the heat, salt and volume input and compute the correction variable
+      !==============================================================================
+
+      ! 
+      zdssh(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)
+      IF (.NOT. ln_linssh ) zdssh = 0.0_wp ! already included in the levels by definition
+      
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = 2,jpim1
+               IF (tmask_h(ji,jj) == 1._wp) THEN
+
+                  ! volume differences
+                  zde3t = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - pe3t_b(ji,jj,jk) * ptmask_b(ji,jj,jk)
+
+                  ! heat diff
+                  zdtem = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
+                        - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
+                  ! salt diff
+                  zdsal = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   &
+                        - tsb(ji,jj,jk,jp_sal) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk)
+               
+                  ! shh changes
+                  IF ( ptmask_b(ji,jj,jk) == 1._wp .OR. tmask(ji,jj,jk) == 1._wp ) THEN 
+                     zde3t = zde3t + zdssh(ji,jj) ! zdssh = 0 if vvl
+                     zdssh(ji,jj) = 0._wp
+                  END IF
+
+                  ! volume, heat and salt differences in each cell 
+                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl
+                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl 
+                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl
+
+                  ! case where we close a cell: check if the neighbour cells are wet 
+                  IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
+
+                     jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;
+
+                     zsum =   e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) + e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) &
+                       &    + e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk)
+
+                     IF ( zsum /= 0._wp ) THEN
+                        zjip1_ratio   = e1e2t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum
+                        zjim1_ratio   = e1e2t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum
+                        zjjp1_ratio   = e1e2t(ji  ,jjp1) * tmask(ji  ,jjp1,jk) / zsum
+                        zjjm1_ratio   = e1e2t(ji  ,jjm1) * tmask(ji  ,jjm1,jk) / zsum
+
+                        pvol_flx(ji  ,jjp1,jk       ) = pvol_flx(ji  ,jjp1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjp1_ratio
+                        pvol_flx(ji  ,jjm1,jk       ) = pvol_flx(ji  ,jjm1,jk       ) + pvol_flx(ji,jj,jk       ) * zjjm1_ratio
+                        pvol_flx(jip1,jj  ,jk       ) = pvol_flx(jip1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjip1_ratio
+                        pvol_flx(jim1,jj  ,jk       ) = pvol_flx(jim1,jj  ,jk       ) + pvol_flx(ji,jj,jk       ) * zjim1_ratio
+                        pts_flx (ji  ,jjp1,jk,jp_sal) = pts_flx (ji  ,jjp1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjp1_ratio
+                        pts_flx (ji  ,jjm1,jk,jp_sal) = pts_flx (ji  ,jjm1,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjjm1_ratio
+                        pts_flx (jip1,jj  ,jk,jp_sal) = pts_flx (jip1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjip1_ratio
+                        pts_flx (jim1,jj  ,jk,jp_sal) = pts_flx (jim1,jj  ,jk,jp_sal) + pts_flx (ji,jj,jk,jp_sal) * zjim1_ratio
+                        pts_flx (ji  ,jjp1,jk,jp_tem) = pts_flx (ji  ,jjp1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjp1_ratio
+                        pts_flx (ji  ,jjm1,jk,jp_tem) = pts_flx (ji  ,jjm1,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjjm1_ratio
+                        pts_flx (jip1,jj  ,jk,jp_tem) = pts_flx (jip1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjip1_ratio
+                        pts_flx (jim1,jj  ,jk,jp_tem) = pts_flx (jim1,jj  ,jk,jp_tem) + pts_flx (ji,jj,jk,jp_tem) * zjim1_ratio
+
+                        ! set to 0 the cell we distributed over neigbourg cells
+                        pvol_flx(ji,jj,jk       ) = 0._wp
+                        pts_flx (ji,jj,jk,jp_sal) = 0._wp
+                        pts_flx (ji,jj,jk,jp_tem) = 0._wp
+
+                     ELSE IF (zsum == 0._wp ) THEN
+                        ! case where we close a cell and no adjacent cell open
+                        ! check if the cell beneath is wet
+                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
+                           pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk)
+                           pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
+                           pts_flx (ji,jj,jk+1,jp_tem)=  pts_flx (ji,jj,jk+1,jp_tem) + pts_flx (ji,jj,jk,jp_tem)
+
+                           ! set to 0 the cell we distributed over neigbourg cells
+                           pvol_flx(ji,jj,jk       ) = 0._wp
+                           pts_flx (ji,jj,jk,jp_sal) = 0._wp
+                           pts_flx (ji,jj,jk,jp_tem) = 0._wp
+                        ELSE
+                        ! case no adjacent cell on the horizontal and on the vertical
+                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
+                                             ! open for narea== 1 (lwp=T)
+                           WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
+                           WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk
+                           WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea
+                           WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
+                           ENDIF
+                        ! We deal with these points later.
+                        END IF
+                     END IF
+                  END IF
+               END IF
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.)
+      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.)
+      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.)
+
+      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
+      ! allocation and initialisation of the list of problematic point
+      ALLOCATE(inpts(jpnij))
+      inpts(:)=0
+
+      ! fill narea location with the number of problematic point
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = 2,jpim1
+               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
+                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
+                  inpts(narea) = inpts(narea) + 1 
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! build array of total problematic point on each cpu (share to each cpu)
+      CALL mpp_max(inpts,jpnij) 
+
+      ! size of the new variable
+      npts  = SUM(inpts)    
+      
+      ! allocation of the coordinates, correction, index vector for the problematic points 
+      ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
+      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
+      zcorr_vol(:) = -1.0e20_wp
+      zcorr_sal(:) = -1.0e20_wp
+      zcorr_tem(:) = -1.0e20_wp
+
+      ! fill new variable
+      jpts = SUM(inpts(1:narea-1))
+      DO jk = 1,jpk-1
+         DO jj = 2,jpj-1
+            DO ji = 2,jpim1
+               IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
+                  .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
+                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea
+                  ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk
+                  zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
+                  zcorr_vol(jpts) = pvol_flx(ji,jj,jk)
+                  zcorr_sal(jpts) = pts_flx (ji,jj,jk,jp_sal)
+                  zcorr_tem(jpts) = pts_flx (ji,jj,jk,jp_tem)
+
+                  ! set flx to 0 (safer)
+                  pvol_flx(ji,jj,jk       ) = 0.0_wp
+                  pts_flx (ji,jj,jk,jp_sal) = 0.0_wp
+                  pts_flx (ji,jj,jk,jp_tem) = 0.0_wp
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! build array of total problematic point on each cpu (share to each cpu)
+      ! point coordinates
+      CALL mpp_max(zlat ,npts)
+      CALL mpp_max(zlon ,npts)
+      CALL mpp_max(izpts,npts)
+
+      ! correction values 
+      CALL mpp_max(zcorr_vol,npts)
+      CALL mpp_max(zcorr_sal,npts)
+      CALL mpp_max(zcorr_tem,npts)
+
+      ! put correction term in the closest cell          
+      DO jpts = 1,npts
+         CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts),'T', izpts(jpts))
+         DO jj = mj0(iypts(jpts)),mj1(iypts(jpts))
+            DO ji = mi0(ixpts(jpts)),mi1(ixpts(jpts))
+               jk = izpts(jpts)
+
+               IF (tmask_h(ji,jj) == 1._wp) THEN
+                  ! correct the vol_flx in the closest cell
+                  pvol_flx(ji,jj,jk)        =  pvol_flx(ji,jj,jk       ) + zcorr_vol(jpts)
+                  pts_flx (ji,jj,jk,jp_sal) =  pts_flx (ji,jj,jk,jp_sal) + zcorr_sal(jpts)
+                  pts_flx (ji,jj,jk,jp_tem) =  pts_flx (ji,jj,jk,jp_tem) + zcorr_tem(jpts)
+
+                  ! set correction to 0
+                  zcorr_vol(jpts) = 0.0_wp
+                  zcorr_sal(jpts) = 0.0_wp
+                  zcorr_tem(jpts) = 0.0_wp
+               END IF
+            END DO
+         END DO
+      END DO
+
+      ! deallocate variables 
+      DEALLOCATE(inpts)
+      DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
+    
+      ! add contribution store on the hallo (lbclnk remove one of the contribution)
+      pvol_flx(:,:,:       ) = pvol_flx(:,:,:       ) * tmask(:,:,:)
+      pts_flx (:,:,:,jp_sal) = pts_flx (:,:,:,jp_sal) * tmask(:,:,:)
+      pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:)
+
+      ! compute sum over the halo and set it to 0.
+      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp)
+      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp)
+      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp)
+
+      ! deallocate variables
+      CALL wrk_dealloc(jpi,jpj, zdssh ) 
+
+   END SUBROUTINE iscpl_cons
+
+   SUBROUTINE iscpl_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE iscpl_div  ***
+      !!
+      !! ** Purpose :   update the horizontal divergenc
+      !!
+      !! ** Method  :
+      !!                CAUTION : iscpl is positive (inflow) and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   increase by the iscpl correction term
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + hdiv_iscpl(ji,jj,jk) / e3t_n(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE iscpl_div
+
+END MODULE iscplhsb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplini.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplini.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplini.f90	(revision 8732)
@@ -0,0 +1,85 @@
+MODULE iscplini
+   !!======================================================================
+   !!                       ***  MODULE  sbciscpl***
+   !! Ocean forcing:  river runoff
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_init     : initialisation routine (namelist)
+   !!   iscpl_alloc    : allocation of correction variables
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE oce             ! global tra/dyn variable
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_init      
+   PUBLIC   iscpl_alloc 
+   !!                                                      !!* namsbc_iscpl namelist *
+   LOGICAL , PUBLIC                                        ::   ln_hsb
+   INTEGER , PUBLIC                                        ::   nn_fiscpl, nstp_iscpl
+   INTEGER , PUBLIC                                        ::   nn_drown
+   REAL(wp), PUBLIC                                        ::   rdt_iscpl
+   !!                                                      !!* namsbc_iscpl namelist *
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::   hdiv_iscpl
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   htsc_iscpl
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION iscpl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE sbc_iscpl_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc )
+         !
+      IF( lk_mpp          )   CALL mpp_sum ( iscpl_alloc )
+      IF( iscpl_alloc > 0 )   CALL ctl_warn('iscpl_alloc: allocation of arrays failed')
+   END FUNCTION iscpl_alloc
+
+   SUBROUTINE iscpl_init()
+      INTEGER ::   ios           ! Local integer output status for namelist read
+      NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown
+      !!----------------------------------------------------------------------
+      !                                   ! ============
+      !                                   !   Namelist
+      !                                   ! ============
+      !
+      nn_fiscpl = 0
+      ln_hsb    = .FALSE.
+      REWIND( numnam_ref )              ! Namelist namsbc_iscpl in reference namelist : Ice sheet coupling
+      READ  ( numnam_ref, namsbc_iscpl, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namsbc_iscpl in configuration namelist : Ice Sheet coupling
+      READ  ( numnam_cfg, namsbc_iscpl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iscpl in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namsbc_iscpl )
+      !
+      nstp_iscpl=MIN(nn_fiscpl, nitend-nit000+1) ! the coupling period have to be less or egal than the total number of time step
+      rdt_iscpl = nstp_iscpl * rn_rdt
+      !
+      IF (lwp) THEN
+         WRITE(numout,*) 'iscpl_rst:'
+         WRITE(numout,*) '~~~~~~~~~'
+         WRITE(numout,*) ' coupling     flag (ln_iscpl )            = ', ln_iscpl
+         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb
+         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl
+         IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified &
+            &                                           (larger than run length)'
+         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl
+         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
+      END IF
+
+   END SUBROUTINE iscpl_init
+
+END MODULE iscplini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplrst.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplrst.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/iscplrst.f90	(revision 8732)
@@ -0,0 +1,451 @@
+MODULE iscplrst
+   !!======================================================================
+   !!                       ***  MODULE  iscplrst***
+   !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling
+   !!=====================================================================
+   !! History :  NEMO  ! 2015-01 P. Mathiot: original 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iscpl_stp          : step management
+   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domwri          ! ocean space and time domain
+   USE domvvl, ONLY : dom_vvl_interpol
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface boundary condition variables
+   USE oce             ! global tra/dyn variable
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE lib_mpp         ! MPP library
+   USE lib_fortran     ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE lbclnk          ! communication
+   USE iscplini        ! ice sheet coupling: initialisation
+   USE iscplhsb        ! ice sheet coupling: conservation
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   iscpl_stp          ! step management 
+   !!
+   !! * Substitutions  
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: sbcrnf.F90 4666 2014-06-11 12:52:23Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iscpl_stp
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_stp  ***
+      !! 
+      !! ** Purpose : compute initialisation
+      !!              compute extrapolation of restart variable un, vn, tsn, sshn (wetting/drying)   
+      !!              compute correction term if needed
+      !! 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   inum0
+      REAL(wp), DIMENSION(:,:  ), POINTER :: zsmask_b
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b  , ze3u_b  , ze3v_b  
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b
+      CHARACTER(20) :: cfile
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before
+      CALL wrk_alloc(jpi,jpj,jpk, ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before
+      CALL wrk_alloc(jpi,jpj,jpk, zdepw_b )
+      CALL wrk_alloc(jpi,jpj,     zsmask_b                    )
+
+
+      !! get restart variable
+      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S
+      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b   ) ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:) )  ! need to compute temperature correction
+      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)
+
+      !! read namelist
+      CALL iscpl_init()
+
+      !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl)
+      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b )
+
+      !! compute correction if conservation needed
+      IF ( ln_hsb ) THEN
+         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' )
+         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl)
+      END IF
+         
+      !! print mesh/mask
+      IF( nmsh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file
+
+      IF ( ln_hsb ) THEN
+         cfile='correction'
+         cfile = TRIM( cfile )
+         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) )
+         CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) )
+         CALL iom_rstput( 0, 0, inum0, 'sal_cor', htsc_iscpl(:,:,:,jp_sal) )
+         CALL iom_close ( inum0 )
+      END IF
+
+      CALL wrk_dealloc(jpi,jpj,jpk, ztmask_b,zumask_b,zvmask_b )  
+      CALL wrk_dealloc(jpi,jpj,jpk, ze3t_b  ,ze3u_b  ,ze3v_b   )  
+      CALL wrk_dealloc(jpi,jpj,jpk, zdepw_b                    )
+      CALL wrk_dealloc(jpi,jpj,     zsmask_b                   )
+
+      !! next step is an euler time step
+      neuler = 0
+
+      !! set _b and _n variables equal
+      tsb (:,:,:,:) = tsn (:,:,:,:)
+      ub  (:,:,:  ) = un  (:,:,:  )
+      vb  (:,:,:  ) = vn  (:,:,:  )
+      sshb(:,:    ) = sshn(:,:)
+
+      !! set _b and _n vertical scale factor equal
+      e3t_b (:,:,:) = e3t_n (:,:,:)
+      e3u_b (:,:,:) = e3u_n (:,:,:)
+      e3v_b (:,:,:) = e3v_n (:,:,:)
+
+      e3uw_b(:,:,:)  = e3uw_n(:,:,:)
+      e3vw_b(:,:,:)  = e3vw_n(:,:,:)
+      gdept_b(:,:,:)  = gdept_n(:,:,:)
+      gdepw_b(:,:,:) = gdepw_n(:,:,:)
+      hu_b (:,:) = hu_n(:,:)
+      hv_b (:,:) = hv_n(:,:)
+      r1_hu_b(:,:) = r1_hu_n(:,:)
+      r1_hv_b(:,:) = r1_hv_n(:,:)
+      !
+   END SUBROUTINE iscpl_stp
+   
+   SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b)
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE iscpl_rst_interpol  ***
+      !! 
+      !! ** Purpose :   compute new tn, sn, un, vn and sshn in case of evolving geometry of ice shelves 
+      !!                compute 2d fields of heat, salt and volume correction
+      !! 
+      !! ** Method  :   tn, sn : extrapolation from neigbourg cells
+      !!                un, vn : fill with 0 velocity and keep barotropic transport by modifing surface velocity or adjacent velocity
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before
+      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before
+      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b                        !! mask before
+      !!
+      INTEGER :: ji, jj, jk, iz          !! loop index
+      INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
+      !!
+      REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb
+      REAL(wp):: zdz, zdzm1, zdzp1
+      !!
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1
+      REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1
+      REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp
+      REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d
+      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0
+      !!----------------------------------------------------------------------
+
+      !! allocate variables
+      CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   )
+      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        ) 
+      CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       ) 
+      CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       ) 
+      CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
+      CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         ) 
+      CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             ) 
+
+      !! mask value to be sure
+      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:)
+      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:)
+      
+      ! compute wmask
+      zwmaskn(:,:,1) = tmask   (:,:,1)
+      zwmaskb(:,:,1) = ptmask_b(:,:,1)
+      DO jk = 2,jpk
+         zwmaskn(:,:,jk) =  tmask  (:,:,jk) *  tmask  (:,:,jk-1)
+         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1)
+      END DO
+           
+      ! compute new ssh if we open a full water column (average of the closest neigbourgs)  
+      sshb (:,:)=sshn(:,:)
+      zssh0(:,:)=sshn(:,:)
+      zsmask0(:,:) = psmask_b(:,:)
+      zsmask1(:,:) = psmask_b(:,:)
+      DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+)
+         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
+         DO jj = 2,jpj-1
+            DO ji = 2, jpim1   ! vector opt.
+               jip1=ji+1; jim1=ji-1;
+               jjp1=jj+1; jjm1=jj-1;
+               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1))
+               IF (zdsmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
+                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     &
+                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     &
+                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     &
+                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk
+                  zsmask1(ji,jj)=1._wp
+               END IF
+            END DO
+         END DO
+         CALL lbc_lnk(sshn,'T',1._wp)
+         CALL lbc_lnk(zsmask1,'T',1._wp)
+         zssh0   = sshn
+         zsmask0 = zsmask1
+      END DO
+      sshn(:,:) = sshn(:,:) * ssmask(:,:)
+
+!=============================================================================
+!PM: Is this needed since introduction of VVL by default?
+      IF (.NOT.ln_linssh) THEN
+      ! Reconstruction of all vertical scale factors at now time steps
+      ! =============================================================================
+      ! Horizontal scale factor interpolations
+      ! --------------------------------------
+         DO jk = 1,jpk
+            DO jj=1,jpj
+               DO ji=1,jpi
+                  IF (tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp) THEN
+                     e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + sshn(ji,jj) / ( ht_0(ji,jj) + 1._wp - ssmask(ji,jj) ) * tmask(ji,jj,jk) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
+         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
+
+      ! Vertical scale factor interpolations
+      ! ------------------------------------
+         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
+         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
+         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
+
+      ! t- and w- points depth
+      ! ----------------------
+         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
+         gdepw_n(:,:,1) = 0.0_wp
+         gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               DO jk = 2,mikt(ji,jj)-1
+                  gdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
+                  gde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
+               END DO
+               IF (mikt(ji,jj) > 1) THEN
+                  jk = mikt(ji,jj)
+                  gdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * e3w_n(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
+                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj)
+               END IF
+               DO jk = mikt(ji,jj)+1, jpk
+                  gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)
+                  gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1)
+                  gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn (ji,jj)
+               END DO
+            END DO
+         END DO
+
+      ! t-, u- and v- water column thickness
+      ! ------------------------------------
+         ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp
+         DO jk = 1, jpkm1
+            hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+            hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+            ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk)
+         END DO
+         !                                        ! Inverse of the local depth
+         r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:)
+         r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:)
+
+      END IF
+
+!=============================================================================
+! compute velocity
+! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor).
+      ub(:,:,:)=un(:,:,:)
+      vb(:,:,:)=vn(:,:,:)
+      DO jk = 1,jpk
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/e3u_n(ji,jj,jk)*umask(ji,jj,jk);
+               vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/e3v_n(ji,jj,jk)*vmask(ji,jj,jk);
+            END DO
+         END DO
+      END DO
+
+! compute new velocity if we close a cell (check barotropic velocity and change velocity over the water column)
+! compute barotropic velocity now and after 
+      ztrp(:,:,:) = ub(:,:,:)*pe3u_b(:,:,:); 
+      zbub(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = vb(:,:,:)*pe3v_b(:,:,:); 
+      zbvb(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = un(:,:,:)*e3u_n(:,:,:); 
+      zbun(:,:)   = SUM(ztrp,DIM=3)
+      ztrp(:,:,:) = vn(:,:,:)*e3v_n(:,:,:); 
+      zbvn(:,:)   = SUM(ztrp,DIM=3)
+
+      ! new water column
+      zhu1=0.0_wp ;
+      zhv1=0.0_wp ;
+      DO jk  = 1,jpk
+        zhu1(:,:) = zhu1(:,:) + e3u_n(:,:,jk) * umask(:,:,jk)
+        zhv1(:,:) = zhv1(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk)
+      END DO
+      
+      ! compute correction      
+      zucorr = 0._wp
+      zvcorr = 0._wp
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            IF (zbun(ji,jj) /= zbub(ji,jj) .AND. zhu1(ji,jj) /= 0._wp ) THEN
+               zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/zhu1(ji,jj)
+            END IF
+            IF (zbvn(ji,jj) /= zbvb(ji,jj) .AND. zhv1(ji,jj) /= 0._wp ) THEN
+               zvcorr(ji,jj) = (zbvn(ji,jj) - zbvb(ji,jj))/zhv1(ji,jj)
+            END IF
+         END DO
+      END DO 
+      
+      ! update velocity
+      DO jk  = 1,jpk
+         un(:,:,jk)=(un(:,:,jk) - zucorr(:,:))*umask(:,:,jk)
+         vn(:,:,jk)=(vn(:,:,jk) - zvcorr(:,:))*vmask(:,:,jk)
+      END DO
+
+!=============================================================================
+      ! compute temp and salt
+      ! compute new tn and sn if we open a new cell
+      tsb (:,:,:,:) = tsn(:,:,:,:)
+      zts0(:,:,:,:) = tsn(:,:,:,:)
+      ztmask1(:,:,:) = ptmask_b(:,:,:)
+      ztmask0(:,:,:) = ptmask_b(:,:,:)
+      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
+          DO jk = 1,jpk-1
+              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
+              DO jj = 2,jpj-1
+                 DO ji = 2,jpim1
+                      jip1=ji+1; jim1=ji-1;
+                      jjp1=jj+1; jjm1=jj-1;
+                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk))
+                      IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp) THEN
+                      !! horizontal basic extrapolation
+                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) &
+                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) &
+                         &                +zts0(ji  ,jjp1,jk,1)*ztmask0(ji  ,jjp1,jk) &
+                         &                +zts0(ji  ,jjm1,jk,1)*ztmask0(ji  ,jjm1,jk) ) / summsk
+                         tsn(ji,jj,jk,2)=( zts0(jip1,jj  ,jk,2)*ztmask0(jip1,jj  ,jk) &
+                         &                +zts0(jim1,jj  ,jk,2)*ztmask0(jim1,jj  ,jk) &
+                         &                +zts0(ji  ,jjp1,jk,2)*ztmask0(ji  ,jjp1,jk) &
+                         &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk
+                         ztmask1(ji,jj,jk)=1
+                      ELSEIF (zdmask(ji,jj) == 1._wp .AND. summsk == 0._wp) THEN
+                      !! vertical extrapolation if horizontal extrapolation failed
+                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
+                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))
+                         IF (zdmask(ji,jj) == 1._wp .AND. summsk /= 0._wp ) THEN
+                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     &
+                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk
+                            tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     &
+                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk
+                            ztmask1(ji,jj,jk)=1._wp
+                         END IF
+                      END IF
+                  END DO
+              END DO
+          END DO
+          
+          CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp)
+          CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp)
+          CALL lbc_lnk(ztmask1,     'T',1._wp)
+
+          ! update
+          zts0(:,:,:,:) = tsn(:,:,:,:)
+          ztmask0 = ztmask1
+
+      END DO
+
+      ! mask new tsn field
+      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)
+      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)
+
+      ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
+      !PM: Is this IF needed since change to VVL by default
+      IF (.NOT.ln_linssh) THEN
+         DO jk = 2,jpk-1
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN
+                     !compute weight
+                     zdzp1 = MAX(0._wp,gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1))
+                     zdz   =           gdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  ) 
+                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - gdepw_n(ji,jj,jk  ))
+                     IF (zdz .LT. 0._wp) THEN 
+                        CALL ctl_stop( 'STOP', 'rst_iscpl : unable to compute the interpolation' )
+                     END IF
+                     tsn(ji,jj,jk,jp_tem) = ( zdzp1*tsb(ji,jj,jk+1,jp_tem)      &
+                        &                   + zdz  *tsb(ji,jj,jk  ,jp_tem)      &
+                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_tem)      )/e3t_n(ji,jj,jk)
+                     tsn(ji,jj,jk,jp_sal) = ( zdzp1*tsb(ji,jj,jk+1,jp_sal)      &
+                        &                   + zdz  *tsb(ji,jj,jk  ,jp_sal)      &
+                        &                   + zdzm1*tsb(ji,jj,jk-1,jp_sal)      )/e3t_n(ji,jj,jk)
+                  END IF
+               END DO
+            END DO
+         END DO               
+      END IF
+
+      ! closed pool
+      ! -----------------------------------------------------------------------------------------
+      ! case we open a cell but no neigbour cells available to get an estimate of T and S
+      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp) 
+         tsn(:,:,:,2) = -99._wp  ! Special value for closed pool (checking purpose in output.init)
+         tmask(:,:,:) = 0._wp    ! set mask to 0 to run
+         umask(:,:,:) = 0._wp
+         vmask(:,:,:) = 0._wp
+      END WHERE
+      
+      ! set mbkt and mikt to 1 in thiese location
+      WHERE (SUM(tmask,dim=3) == 0)
+         mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1
+         mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1
+      END WHERE
+      ! -------------------------------------------------------------------------------------------
+      ! compute new tn and sn if we close cell 
+      ! nothing to do
+      ! 
+      ! deallocation tmp arrays
+      CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   )
+      CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                ) 
+      CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              ) 
+      CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       ) 
+      CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t) 
+      CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        ) 
+      CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          ) 
+
+   END SUBROUTINE iscpl_rst_interpol
+
+END MODULE iscplrst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/istate.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/istate.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/istate.f90	(revision 8732)
@@ -0,0 +1,516 @@
+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
+   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 c1d             ! 1D vertical configuration
+   USE daymod          ! calendar
+   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
+   USE ldftra          ! lateral physics: ocean active tracers
+   USE zdf_oce         ! ocean vertical physics
+   USE phycst          ! physical constants
+   USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
+   USE dtauvd          ! data: U & V current             (dta_uvd routine)
+   USE domvvl          ! varying vertical mesh
+   USE iscplrst        ! ice sheet coupling
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE restart         ! restart
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: istate.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! 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.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('istate_init')
+      !
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+                     CALL dta_tsd_init        ! Initialisation of T & S input data
+      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
+
+      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
+      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
+      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
+      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
+
+      IF( ln_rstart ) THEN                    ! Restart from a file
+         !                                    ! -------------------
+         CALL rst_read                        ! Read the restart file
+         IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry
+         CALL day_init                        ! model calendar (using both namelist and restart infos)
+      ELSE
+         !                                    ! Start from rest
+         !                                    ! ---------------
+         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._wp   ;   sshn (:,:)   = 0._wp
+         ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp
+         vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp  
+                                    hdivn(:,:,:) = 0._wp
+         !
+         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                                    ! Initial T-S, U-V fields read in files
+            IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000
+               CALL dta_tsd( nit000, tsb )  
+               tsn(:,:,:,:) = tsb(:,:,:,:)
+               !
+            ELSE                                 ! Initial T-S fields defined analytically
+               CALL istate_t_s
+            ENDIF
+            IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000
+               CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd )
+               CALL dta_uvd( nit000, zuvd )
+               ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:)
+               vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:)
+               CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd )
+            ENDIF
+         ENDIF
+         !
+!!gm This is to be changed !!!!
+         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here
+         IF( .NOT.ln_linssh ) THEN
+            DO jk = 1, jpk
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+            END DO
+         ENDIF
+!!gm 
+         ! 
+      ENDIF
+      ! 
+      ! Initialize "now" and "before" barotropic velocities:
+      ! Do it whatever the free surface method, these arrays being eventually used
+      !
+      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
+      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
+      !
+!!gm  the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               un_b(ji,jj) = un_b(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
+               vn_b(ji,jj) = vn_b(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
+               !
+               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)
+               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
+      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
+      !
+      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
+      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('istate_init')
+      !
+   END SUBROUTINE istate_init
+
+
+   SUBROUTINE istate_t_s
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_t_s  ***
+      !!   
+      !! ** Purpose :   Intialization of the temperature field with an 
+      !!      analytical profile or a file (i.e. in EEL configuration)
+      !!
+      !! ** Method  : - temperature: use Philander analytic profile
+      !!              - salinity   : use to a constant value 35.5
+      !!
+      !! References :  Philander ???
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zsal = 35.50_wp
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_t_s : Philander s initial temperature profile'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)'
+      !
+      DO jk = 1, jpk
+         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((gdept_n(:,:,jk)-80.)/30.) )   &
+            &                + 10. * ( 5000. - gdept_n(:,:,jk) ) /5000.)  ) * tmask(:,:,jk)
+         tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
+      END DO
+      tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
+      tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
+      !
+   END SUBROUTINE istate_t_s
+
+
+   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 divhor     ! hor. divergence      (div_hor 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_1d(  1  )
+            zh2 = gdept_1d(jpkm1)
+            !
+            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
+            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
+            !
+            DO jk = 1, jpk
+               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - gdept_n(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
+               tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
+            END DO
+            !
+            ! 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,*) '~~~~~~~~~~'
+            !
+            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
+            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
+            !
+            ! set the dynamics: U,V, hdiv (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
+            !
+!!gm  Check  here call to div_hor should not be necessary
+!!gm         div_hor call runoffs  not sure they are defined at that level
+            CALL div_hor( nit000 )                  ! horizontal divergence and relative vorticity (curl)
+            ! N.B. the vertical velocity will be computed from the horizontal divergence field
+            ! in istate by a call to wzv routine
+
+
+            !                                     ! ==========================
+         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', tsb(:,:,:,jp_tem) ) ! read before temprature (tb)
+            CALL iom_close( inum )
+            !
+            tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb
+            !
+            ! 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,*) '~~~~~~~~~~'
+            !
+            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
+            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
+            !
+            !                                    ! ===========================
+         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
+                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (gdept_n(ji,jj,jk) - 400) / 700 )         )   &
+                       &           * (-TANH( (500-gdept_n(ji,jj,jk)) / 150 ) + 1) / 2               &
+                       &       + (      15. * ( 1. - TANH( (gdept_n(ji,jj,jk)-50.) / 1500.) )       &
+                       &                - 1.4 * TANH((gdept_n(ji,jj,jk)-100.) / 100.)               &    
+                       &                + 7.  * (1500. - gdept_n(ji,jj,jk)) / 1500.             )   & 
+                       &           * (-TANH( (gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2
+                  tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
+                  tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem)
+
+                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (gdept_n(ji,jj,jk) - 305) / 460 )  )  &
+                     &              * (-TANH((500 - gdept_n(ji,jj,jk)) / 150) + 1) / 2          &
+                     &          + (  35.55 + 1.25 * (5000. - gdept_n(ji,jj,jk)) / 5000.         &
+                     &                - 1.62 * TANH( (gdept_n(ji,jj,jk) - 60.  ) / 650. )       &
+                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 35.  ) / 100. )       &
+                     &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 1000.) / 5000.)    )  &
+                     &              * (-TANH((gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 
+                  tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
+                  tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal)
+               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', tsn(:,:,:,jp_tem) ) 
+         CALL iom_close( inum )
+
+         tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:) 
+         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
+
+         ! Read salinity field
+         ! -------------------
+         CALL iom_open ( 'data_sal', inum )
+         CALL iom_get ( inum, jpdom_data, 'vosaline', tsn(:,:,:,jp_sal) ) 
+         CALL iom_close( inum )
+
+         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 
+         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
+         !
+      END SELECT
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Initial temperature and salinity profiles:'
+         WRITE(numout, "(9x,' level   gdept_1d   temperature   salinity   ')" )
+         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), 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 divhor          ! hor. divergence                       (div_hor routine)
+      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+      !
+      INTEGER ::   ji, jj, jk        ! dummy loop indices
+      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk,   zprn)
+      !
+      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 * e3w_n(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
+
+      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
+         zprn(:,:,jk) = zprn(:,:,jk-1)   &
+            &         + zalfg * e3w_n(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
+      END DO  
+
+      ! Compute geostrophic balance
+      ! ---------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, 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(:,:,:)
+      
+      !
+!!gm  Check  here call to div_hor should not be necessary
+!!gm         div_hor call runoffs  not sure they are defined at that level
+      CALL div_hor( nit000 )            ! now horizontal divergence
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk,   zprn)
+      !
+   END SUBROUTINE istate_uvg
+
+   !!=====================================================================
+END MODULE istate
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lbclnk.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lbclnk.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lbclnk.f90	(revision 8732)
@@ -0,0 +1,63 @@
+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  
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
+   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   '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_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE lib_mpp        ! distributed memory computing library
+
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+   !
+   INTERFACE lbc_sum
+      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d
+   END INTERFACE
+   !
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE mpp_lnk_2d_icb
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions
+   PUBLIC   lbc_sum
+   PUBLIC   lbc_lnk_e     !
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lbclnk.F90 6493 2016-04-22 13:52:52Z mathiot $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   !!======================================================================
+END MODULE lbclnk
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lbcnfd.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lbcnfd.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lbcnfd.f90	(revision 8732)
@@ -0,0 +1,971 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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)
+   !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP
+   !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP
+   !!----------------------------------------------------------------------
+   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
+   !
+   INTERFACE mpp_lbc_nfd
+      MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   lbc_nfd       ! north fold conditions
+   PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case)
+
+   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
+   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
+   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lbcnfd.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! 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
+               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
+               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
+               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
+               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
+               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
+            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
+               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
+            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
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
+            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
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
+               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
+            pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2)
+            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
+            pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2)
+            pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2)
+            pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)   
+            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
+            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
+         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
+            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
+            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
+            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)      
+            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)      
+         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
+         CASE ( 'J' )                                     ! first 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
+         CASE ( 'K' )                                     ! second 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' )                               ! 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
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
+         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
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
+            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
+         CASE ( 'J' )                                  ! first 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)= pt2d(ji,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'K' )                                  ! second 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)= 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
+         CASE ( 'J' )                                   ! first ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'K' )                                   ! second 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
+
+
+   SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_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) ::   pt3dl     ! 3D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               IF (nimpp .ne. 1) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+
+               DO jk = 1, jpk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)
+                  ENDIF
+               END DO
+
+               IF(nimpp .ge. (jpiglo/2+1)) THEN
+                 startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+                 startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                 startloop = nlci + 1
+               ENDIF
+               IF(startloop .le. nlci) THEN
+                 DO jk = 1, jpk
+                    DO ji = startloop, nlci
+                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                       jia = ji + nimpp - 1
+                       ijta = jpiglo - jia + 2
+                       IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
+                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)
+                       ELSE
+                          pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
+                       ENDIF
+                    END DO
+                 END DO
+               ENDIF
+
+
+            CASE ( 'U' )                               ! U-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk)
+                  ENDIF
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)
+                  ENDIF
+               END DO
+
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF(nimpp .ge. (jpiglo/2)) THEN
+                  startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
+                  startloop = jpiglo/2 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF (startloop .le. endloop) THEN
+                 DO jk = 1, jpk
+                    DO ji = startloop, endloop
+                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                      jia = ji + nimpp - 1
+                      ijua = jpiglo - jia + 1
+                      IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
+                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)
+                      ELSE
+                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
+                      ENDIF
+                    END DO
+                 END DO
+               ENDIF
+
+            CASE ( 'V' )                               ! V-point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)
+                  ENDIF
+               END DO
+            CASE ( 'F' )                               ! F-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk)
+                  END DO
+                  IF(nimpp .eq. 1) THEN
+                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk)
+                  ENDIF
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)
+                  ENDIF
+               END DO
+            END SELECT
+            !
+
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'U' )                               ! U-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)
+                  END DO
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)
+                  ENDIF
+               END DO
+
+            CASE ( 'V' )                               ! V-point
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)
+                  END DO
+               END DO
+
+               IF(nimpp .ge. (jpiglo/2+1)) THEN
+                  startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = nlci + 1
+               ENDIF
+               IF(startloop .le. nlci) THEN
+                 DO jk = 1, jpk
+                    DO ji = startloop, nlci
+                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)
+                    END DO
+                 END DO
+               ENDIF
+
+            CASE ( 'F' )                               ! F-point
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jk = 1, jpk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)
+                  END DO
+                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)
+                  ENDIF
+               END DO
+
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF(nimpp .ge. (jpiglo/2+1)) THEN
+                  startloop = 1
+               ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+                  startloop = jpiglo/2+1 - nimpp + 1
+               ELSE
+                  startloop = endloop + 1
+               ENDIF
+               IF (startloop .le. endloop) THEN
+                  DO jk = 1, jpk
+                     DO ji = startloop, endloop
+                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)
+                     END DO
+                  END DO
+               ENDIF
+
+            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
+               pt3dl(:, 1  ,jk) = 0.e0
+               pt3dl(:,ijpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3dl(:,ijpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      !
+   END SUBROUTINE mpp_lbc_nfd_3d
+
+
+   SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_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) ::   pt2dl     ! 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
+      !!----------------------------------------------------------------------
+
+      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
+
+
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            IF (nimpp .ne. 1) THEN
+              startloop = 1
+            ELSE
+              startloop = 2
+            ENDIF
+            DO ji = startloop, nlci
+              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
+            END DO
+            IF (nimpp .eq. 1) THEN
+              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2)
+            ENDIF
+
+            IF(nimpp .ge. (jpiglo/2+1)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               startloop = jpiglo/2+1 - nimpp + 1
+            ELSE
+               startloop = nlci + 1
+            ENDIF
+            DO ji = startloop, nlci
+               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+               jia = ji + nimpp - 1
+               ijta = jpiglo - jia + 2
+               IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN
+                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)
+               ELSE
+                  pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
+               ENDIF
+            END DO
+
+         CASE ( 'U' )                                     ! U-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
+            END DO
+
+            IF (nimpp .eq. 1) THEN
+              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2)
+              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)
+            ENDIF
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2)
+            ENDIF
+
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            IF(nimpp .ge. (jpiglo/2)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN
+               startloop = jpiglo/2 - nimpp + 1
+            ELSE
+               startloop = endloop + 1
+            ENDIF
+            DO ji = startloop, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               jia = ji + nimpp - 1
+               ijua = jpiglo - jia + 1
+               IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN
+                  pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)
+               ELSE
+                  pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
+               ENDIF
+            END DO
+
+         CASE ( 'V' )                                     ! V-point
+            IF (nimpp .ne. 1) THEN
+              startloop = 1
+            ELSE
+              startloop = 2
+            ENDIF
+            DO ji = startloop, nlci
+              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)
+              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)
+            END DO
+            IF (nimpp .eq. 1) THEN
+              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3) 
+            ENDIF
+
+         CASE ( 'F' )                                     ! F-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)
+            END DO
+            IF (nimpp .eq. 1) THEN
+              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3)
+              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2)
+            ENDIF
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3)
+              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 
+            ENDIF
+
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'J' )                                     ! first ice U-V point
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'K' )                                     ! second ice U-V point
+            IF (nimpp .ne. 1) THEN
+               startloop = 1
+            ELSE
+               startloop = 3
+               pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)
+            ENDIF
+            DO ji = startloop, nlci
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            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, nlci
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)
+            END DO
+
+         CASE ( 'U' )                                     ! U-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)
+            ENDIF
+
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, nlci
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)
+            END DO
+            IF(nimpp .ge. (jpiglo/2+1)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               startloop = jpiglo/2+1 - nimpp + 1
+            ELSE
+               startloop = nlci + 1
+            ENDIF
+            DO ji = startloop, nlci
+               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)
+            END DO
+
+         CASE ( 'F' )                               ! F-point
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            DO ji = 1, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)
+            END DO
+            IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)
+            ENDIF
+
+            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+               endloop = nlci
+            ELSE
+               endloop = nlci - 1
+            ENDIF
+            IF(nimpp .ge. (jpiglo/2+1)) THEN
+               startloop = 1
+            ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN
+               startloop = jpiglo/2+1 - nimpp + 1
+            ELSE
+               startloop = endloop + 1
+            ENDIF
+
+            DO ji = startloop, endloop
+               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))
+               END DO
+
+         CASE ( 'J' )                                  ! first ice U-V point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop , endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1)
+               END DO
+
+         CASE ( 'K' )                                  ! second ice U-V point
+               IF (nimpp .ne. 1) THEN
+                  startloop = 1
+               ELSE
+                  startloop = 2
+               ENDIF
+               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO ji = startloop, endloop
+                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)
+               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
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'I' )                                   ! ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'J' )                                   ! first ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         CASE ( 'K' )                                   ! second ice U-V point
+            pt2dl(:, 1     ) = 0.e0
+            pt2dl(:,ijpj) = 0.e0
+         END SELECT
+         !
+      END SELECT
+      !
+   END SUBROUTINE mpp_lbc_nfd_2d
+
+   !!======================================================================
+END MODULE lbcnfd
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_cray.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_cray.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_cray.f90	(revision 8732)
@@ -0,0 +1,34 @@
+!  Cray subroutines or functions used by OPA model and possibly 
+!  not found on other platforms.
+!
+!  check their existence
+!  
+!  wheneq
+!!----------------------------------------------------------------------
+!!  OPA 9.0 , LOCEAN-IPSL (2005) 
+!! $Id: lib_cray.f90 3680 2012-11-27 14:42:24Z rblod $ 
+!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+!!----------------------------------------------------------------------
+SUBROUTINE lib_cray
+      WRITE(*,*) 'lib_cray: You should not have seen this print! error?'
+END SUBROUTINE lib_cray
+
+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
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_fortran.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_fortran.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_fortran.f90	(revision 8732)
@@ -0,0 +1,556 @@
+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
+   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max 
+   !!                                           + 3d dim. of input is fexible (jpk, jpl...) 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 dom_oce         ! ocean domain
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
+   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos)
+   PUBLIC   DDPDD         ! also used in closea module
+   PUBLIC   glob_min, glob_max
+
+   PUBLIC SIGN
+
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, &
+         &             glob_sum_2d_a, glob_sum_3d_a
+   END INTERFACE
+   INTERFACE glob_sum_full
+      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
+   END INTERFACE
+   INTERFACE glob_min
+      MODULE PROCEDURE glob_min_2d, glob_min_3d,glob_min_2d_a, glob_min_3d_a 
+   END INTERFACE
+   INTERFACE glob_max
+      MODULE PROCEDURE glob_max_2d, glob_max_3d,glob_max_2d_a, glob_max_3d_a 
+   END INTERFACE
+
+
+   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
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lib_fortran.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   ! --- SUM ---
+
+   FUNCTION glob_sum_1d( ptab, kdim )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_1D  ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of a 1D array
+      !!-----------------------------------------------------------------------
+      INTEGER :: kdim
+      REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab        ! input 1D array
+      REAL(wp)                              ::   glob_sum_1d ! global sum
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_1d = SUM( ptab(:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_1d )
+      !
+   END FUNCTION glob_sum_1d
+
+   FUNCTION glob_sum_2d( ptab )
+      !!-----------------------------------------------------------------------
+      !!                  ***  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_2d   ! global masked sum
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_2d = SUM( ptab(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_2d )
+      !
+   END FUNCTION glob_sum_2d
+
+
+   FUNCTION glob_sum_3d( ptab )
+      !!-----------------------------------------------------------------------
+      !!                  ***  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_3d   ! global masked sum
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_sum_3d = 0.e0
+      DO jk = 1, ijpk
+         glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_3d )
+      !
+   END FUNCTION glob_sum_3d
+
+
+   FUNCTION glob_sum_2d_a( ptab1, ptab2 )
+      !!-----------------------------------------------------------------------
+      !!                  ***  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_2d_a   ! global masked sum
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) )
+      glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_2d_a, 2 )
+      !
+   END FUNCTION glob_sum_2d_a
+
+
+   FUNCTION glob_sum_3d_a( ptab1, ptab2 )
+      !!-----------------------------------------------------------------------
+      !!                  ***  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_3d_a   ! global masked sum
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab1,3)
+      !
+      glob_sum_3d_a(:) = 0.e0
+      DO jk = 1, ijpk
+         glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) )
+         glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_3d_a, 2 )
+      !
+   END FUNCTION glob_sum_3d_a
+
+   FUNCTION glob_sum_full_2d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine (nomask)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
+      REAL(wp)                             ::   glob_sum_full_2d   ! global sum
+      !!
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_full_2d = SUM( ptab(:,:) * tmask_h(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_2d )
+      !
+   END FUNCTION glob_sum_full_2d
+
+   FUNCTION glob_sum_full_3d( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_full_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
+      REAL(wp)                               ::   glob_sum_full_3d   ! global sum
+      !!
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ijpk ! local variables: size of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_sum_full_3d = 0.e0
+      DO jk = 1, ijpk
+         glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_3d )
+      !
+   END FUNCTION glob_sum_full_3d
+
+
+
+   ! --- MIN ---
+   FUNCTION glob_min_2d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_2D  ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of a 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
+      REAL(wp)                             ::   glob_min_2d   ! global masked min
+      !!-----------------------------------------------------------------------
+      !
+      glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_min( glob_min_2d )
+      !
+   END FUNCTION glob_min_2d
+ 
+   FUNCTION glob_min_3d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_3D  ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of a 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
+      REAL(wp)                               ::   glob_min_3d   ! global masked min
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_min( glob_min_3d )
+      !
+   END FUNCTION glob_min_3d
+
+
+   FUNCTION glob_min_2d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_2D _a ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of two 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
+      REAL(wp)            , DIMENSION(2)   ::   glob_min_2d_a   ! global masked min
+      !!-----------------------------------------------------------------------
+      !             
+      glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) )
+      glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 )
+      !
+   END FUNCTION glob_min_2d_a
+ 
+ 
+   FUNCTION glob_min_3d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_min_3D_a ***
+      !!
+      !! ** Purpose : perform a masked min on the inner global domain of two 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
+      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab1,3)
+      !
+      glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) )
+      glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) )
+         glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 )
+      !
+   END FUNCTION glob_min_3d_a
+
+   ! --- MAX ---
+   FUNCTION glob_max_2d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_2D  ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of a 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array
+      REAL(wp)                             ::   glob_max_2d   ! global masked max
+      !!-----------------------------------------------------------------------
+      !
+      glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_max( glob_max_2d )
+      !
+   END FUNCTION glob_max_2d
+ 
+   FUNCTION glob_max_3d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_3D  ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of a 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array
+      REAL(wp)                               ::   glob_max_3d   ! global masked max
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab,3)
+      !
+      glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_max( glob_max_3d )
+      !
+   END FUNCTION glob_max_3d
+
+
+   FUNCTION glob_max_2d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_2D _a ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of two 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array
+      REAL(wp)            , DIMENSION(2)   ::   glob_max_2d_a   ! global masked max
+      !!-----------------------------------------------------------------------
+      !             
+      glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) )
+      glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 )
+      !
+   END FUNCTION glob_max_2d_a
+ 
+ 
+   FUNCTION glob_max_3d_a( ptab1, ptab2 ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_max_3D_a ***
+      !!
+      !! ** Purpose : perform a masked max on the inner global domain of two 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array
+      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max
+      !!
+      INTEGER :: jk
+      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab
+      !!-----------------------------------------------------------------------
+      !
+      ijpk = SIZE(ptab1,3)
+      !
+      glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) )
+      glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ijpk
+         glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) )
+         glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) )
+      END DO
+      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 )
+      !
+   END FUNCTION glob_max_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
+
+   !!----------------------------------------------------------------------
+   !!   '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
+
+   !!======================================================================
+END MODULE lib_fortran
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_mpp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_mpp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/lib_mpp.f90	(revision 8732)
@@ -0,0 +1,4166 @@
+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
+   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
+   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d', 
+   !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
+   !!                          the mppobc routine to optimize the BDY and OBC communications
+   !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
+   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
+   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn      : initialization, namelist read, and parameters control
+   !!   ctl_opn       : Open file and check if required file is available.
+   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   get_unit      : give the index of an unused logical unit
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lib_mpp_alloc : allocate mpp arrays
+   !!   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)
+   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
+   !!   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       :
+   !!   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
+   !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
+   USE wrk_nemo       ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
+   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_max_multiple
+   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple 
+   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d
+   PUBLIC   mppscatter, mppgather
+   PUBLIC   mpp_ini_ice, mpp_ini_znl
+   PUBLIC   mppsize
+   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
+   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
+   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
+   PUBLIC   mpprank
+
+   TYPE arrayptr
+      REAL , DIMENSION (:,:),  POINTER :: pt2d
+   END TYPE arrayptr
+   PUBLIC   arrayptr
+   
+   !! * 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,   &
+                       mppsum_realdd, mppsum_a_realdd
+   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
+
+   INTERFACE mpp_max_multiple
+      MODULE PROCEDURE mppmax_real_multiple
+   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
+
+   INTEGER :: MPI_SUMDD
+
+   ! variables used in case of sea-ice
+   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)
+   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology)
+   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, SAVE ::   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, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+
+   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
+   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send   ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
+   INTEGER, PUBLIC          ::   nn_buffer     ! size of the buffer in case of mpi_bsend
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
+
+   LOGICAL, PUBLIC                                  ::   ln_nnogather       ! namelist control of northfold comms
+   LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms
+   INTEGER, PUBLIC                                  ::   ityp
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: lib_mpp.F90 6490 2016-04-20 14:55:58Z mcastril $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!
+      !! ** Purpose :   Find processor unit
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
+      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
+      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
+      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
+      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
+      !
+      INTEGER ::   mynode, ierr, code, ji, ii, ios
+      LOGICAL ::   mpi_was_called
+      !
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
+      !
+
+      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
+      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
+
+      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
+      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
+
+      !                              ! 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 exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
+
+
+
+
+
+
+
+
+
+      IF(jpnij < 1)THEN
+         ! If jpnij is not specified in namelist then we calculate it - this
+         ! means there will be no land cutting out.
+         jpnij = jpni * jpnj
+      END IF
+
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1
+      ELSE
+         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1
+      END IF
+
+      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; 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
+            kstop = kstop + 1
+         END SELECT
+      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
+         kstop = kstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
+            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
+            kstop = kstop + 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( mynode == 0 ) THEN
+         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+         WRITE(kumond, nammpp)      
+      ENDIF
+      !
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+      !
+   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
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! 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
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_3d
+
+
+   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_multiple  ***
+      !!
+      !! ** Purpose :   Message passing management for multiple 2d arrays
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
+      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      REAL(wp) ::   zland
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
+         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+            !
+            ! WARNING pt2d is defined only between nld and nle
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
+               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
+               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
+               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
+               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
+            END DO
+            !
+         ELSE                              ! standard close or cyclic treatment
+            !
+            !                                   ! East-West boundaries
+            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
+               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
+            ELSE                                     ! closed
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
+            ENDIF
+            !                                   ! North-South boundaries (always closed)
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
+            !
+         ENDIF
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
+               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
+            END DO
+         END SELECT
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
+            END DO
+         END SELECT
+      END DO
+      
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
+               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
+            END DO
+         ENDIF
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+
+      DO ii = 1 , num_fields
+         !First Array
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
+               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
+            END DO
+         END SELECT
+      END DO
+      
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+         !First Array
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   
+             DO ii = 1 , num_fields  
+                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
+             END DO
+         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+        !
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_2d_multiple
+
+   
+   SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields )
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
+      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
+      REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER                            , INTENT (inout) :: num_fields 
+      !!---------------------------------------------------------------------
+      num_fields = num_fields + 1
+      pt2d_array(num_fields)%pt2d => pt2d
+      type_array(num_fields)      =  cd_type
+      psgn_array(num_fields)      =  psgn
+   END SUBROUTINE load_array
+   
+   
+   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER :: num_fields
+      !!---------------------------------------------------------------------
+      !
+      num_fields = 0
+      !
+      ! Load the first array
+      CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields )
+      !
+      ! Look if more arrays are added
+      IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+      IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+      !
+      CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval )
+      !
+   END SUBROUTINE mpp_lnk_2d_9
+
+
+   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
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! 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
+            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            zt2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_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
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
+         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
+      !
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                      ! 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
+            zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk *2
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
+         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,:,:) = zt4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = zt4we(:,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
+            zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk * 2
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
+         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,:) = zt4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab1(:,jl,:) = zt4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = zt4sn(:,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
+      !
+      DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we )
+      !
+   END SUBROUTINE mpp_lnk_3d_gather
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj )
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !!                    jpri   : number of rows for extra outer halo
+      !!                    jprj   : 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
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                             , INTENT(in   ) ::   jpri
+      INTEGER                                             , INTENT(in   ) ::   jprj
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), 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
+      !!
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jprj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      !* North-South boundaries (always colsed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north
+
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+         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-jpri
+         DO jl = 1, ipreci
+            r2dew(:,jl,1) = pt2d(jpreci+jl,:)
+            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jprj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         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,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,jl,2)
+            pt2d( iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,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-jprj
+         DO jl = 1, iprecj
+            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
+            r2dns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpri )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         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) = r2dns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+            pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE mpp_lnk_2d_e
+
+   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_sum_3d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement (sum the overlap region)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+      iihom = nlci-jpreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp
+            zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp 
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      iihom = nlci-nreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
+            ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
+         ijhom = nlcj-jprecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp
+            zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      ijhom = nlcj-nrecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)
+            ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
+      !
+   END SUBROUTINE mpp_lnk_sum_3d
+
+   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_sum_2d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci - jpreci
+         DO jl = 1, jpreci
+            zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp
+            zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      iihom = nlci-nreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
+            pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read lateral conditions
+         ijhom = nlcj - jprecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp
+            zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write lateral conditions
+      ijhom = nlcj-nrecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
+            pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_sum_2d
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  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, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  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, OPTIONAL, INTENT(in) :: ksource    ! source process number
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      INTEGER :: use_source
+      !!----------------------------------------------------------------------
+      !
+      ! If a specific process number has been passed to the receive call,
+      ! use that one. Default is to use mpi_any_source
+      use_source = mpi_any_source
+      IF( PRESENT(ksource) )   use_source = ksource
+      !
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_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 mppmax_real_multiple( ptab, NUM , kcom  )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_real  ***
+      !!
+      !! ** Purpose :   Maximum
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ???
+      INTEGER , INTENT(in   )           ::   NUM
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      !!
+      INTEGER  ::   ierror, localcomm
+      REAL(wp) , POINTER , DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc(NUM , zwork)
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab = zwork
+      CALL wrk_dealloc(NUM , zwork)
+      !
+   END SUBROUTINE mppmax_real_multiple
+
+
+   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 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
+      !
+      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    , OPTIONAL       , INTENT(in   ) ::   kcom
+      !
+      INTEGER:: ierror, localcomm    ! local integer
+      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror )
+      ytab(:) = zwork(:)
+      !
+   END SUBROUTINE mppsum_a_realdd
+
+
+   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 :: ierror
+      INTEGER , DIMENSION(2)   ::   ilocs
+      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 massively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      !
+      CALL mppsync
+      CALL mpi_finalize( info )
+      !
+   END SUBROUTINE mppstop
+
+
+   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, kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  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_iworld = 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, INTENT(in) ::   kumout   ! ocean.output logical unit
+      !!
+      INTEGER :: jjproc
+      INTEGER :: ii, ierr
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kice
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      ! Since this is just an init routine and these arrays are of length jpnij
+      ! then don't use wrk_nemo module - just allocate and deallocate.
+      ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)'
+         CALL mppstop
+      ENDIF
+
+      ! 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( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
+      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_iworld, ierr )
+
+      ! Create the ice group from the world group
+      CALL MPI_GROUP_INCL( ngrp_iworld, 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_iworld,n_ice_root,ierr)
+      !
+      CALL MPI_GROUP_FREE(ngrp_ice, ierr)
+      CALL MPI_GROUP_FREE(ngrp_iworld, ierr)
+
+      DEALLOCATE(kice, zwork)
+      !
+   END SUBROUTINE mpp_ini_ice
+
+
+   SUBROUTINE mpp_ini_znl( kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  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, INTENT(in) ::   kumout   ! ocean.output logical units
+      !
+      INTEGER :: jproc      ! dummy loop integer
+      INTEGER :: ierr, ii   ! local integer
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   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
+      !
+      ALLOCATE( kwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
+         CALL mppstop
+      ENDIF
+
+      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 (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+         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
+
+      DEALLOCATE(kwork)
+
+   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 (ALLOCATED (nrank_north)) DEALLOCATE(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 )
+      !
+   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, jk
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
+
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
+      ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) ) 
+
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      znorthloc(:,:,:) = 0
+      DO jk = 1, jpk
+         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
+            ij = jj - nlcj + ijpj
+            znorthloc(:,ij,jk) = pt3d(:,jj,jk)
+         END DO
+      END DO
+      !
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * jpk * ijpj
+
+      IF ( l_north_nogather ) THEN
+         !
+        ztabr(:,:,:) = 0
+        ztabl(:,:,:) = 0
+
+        DO jk = 1, jpk
+           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+              ij = jj - nlcj + ijpj
+              DO ji = nfsloop, nfeloop
+                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+
+         DO jr = 1,nsndto
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
+              DO jk = 1, jpk
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)
+                    END DO
+                 END DO
+              END DO
+           ELSE IF (iproc .eq. (narea-1)) THEN
+              DO jk = 1, jpk
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)
+                    END DO
+                 END DO
+              END DO
+           ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF    
+            END DO
+         ENDIF
+         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
+         DO jk = 1, jpk
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+               ij = jj - nlcj + ijpj
+               DO ji= 1, nlci
+                  pt3d(ji,jj,jk) = ztabl(ji,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+
+      ELSE
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:) = 0.e0
+         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 jk = 1, jpk
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                    ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
+                  END DO
+               END DO
+            END DO
+         END DO
+         CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+         !
+         DO jk = 1, jpk
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+               ij = jj - nlcj + ijpj
+               DO ji= 1, nlci
+                  pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      ! The ztab array has been either:
+      !  a. Fully populated by the mpi_allgather operation or
+      !  b. Had the active points for this domain and northern neighbours populated
+      !     by peer to peer exchanges
+      ! Either way the array may be folded by lbc_nfd and the result for the span of
+      ! this domain will be identical.
+      !
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
+      DEALLOCATE( ztabl, ztabr ) 
+      !
+   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      ! 2D array on which the b.c. is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d 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
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztabl, ztabr
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )
+      ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) ) 
+      !
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      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
+      IF ( l_north_nogather ) THEN
+         !
+         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
+         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
+         !
+         ztabr(:,:) = 0
+         ztabl(:,:) = 0
+
+         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+            ij = jj - nlcj + ijpj
+              DO ji = nfsloop, nfeloop
+               ztabl(ji,ij) = pt2d(ji,jj)
+            END DO
+         END DO
+
+         DO jr = 1,nsndto
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
+              DO jj = 1, ijpj
+                 DO ji = ildi, ilei
+                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj)
+                 END DO
+              END DO
+            ELSE IF (iproc .eq. (narea-1)) THEN
+              DO jj = 1, ijpj
+                 DO ji = ildi, ilei
+                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
+                 END DO
+              END DO
+            ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF
+            END DO
+         ENDIF
+         CALL mpp_lbc_nfd( ztabl, ztabr, 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) = ztabl(ji,ij)
+            END DO
+         END DO
+         !
+      ELSE
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:) = 0.e0
+         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
+               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
+         !
+      ENDIF
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
+      DEALLOCATE( ztabl, ztabr ) 
+      !
+   END SUBROUTINE mpp_lbc_north_2d
+
+   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
+      !!              in mpp configuration in case of jpn1 > 1
+      !!              (for multiple 2d arrays )
+      !!
+      !! ** 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.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points
+      !                                                          !   = T ,  U , V , F or W  gridpoints
+      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr, jk
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather
+      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions
+      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )
+      !
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      
+      DO jk = 1, num_fields
+         DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable)
+            ij = jj - nlcj + ijpj
+            znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj)
+         END DO
+      END DO
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * ijpj
+                                                                  
+      IF ( l_north_nogather ) THEN
+         !
+         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 
+         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange
+         !
+         ztabr(:,:,:) = 0
+         ztabl(:,:,:) = 0
+
+         DO jk = 1, num_fields
+            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+               ij = jj - nlcj + ijpj
+               DO ji = nfsloop, nfeloop
+                  ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj)
+               END DO
+            END DO
+         END DO
+
+         DO jr = 1,nsndto
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+               CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times
+            ENDIF
+         END DO
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times
+              DO jk = 1 , num_fields
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D
+                    END DO
+                 END DO
+              END DO
+            ELSE IF (iproc .eq. (narea-1)) THEN
+              DO jk = 1, num_fields
+                 DO jj = 1, ijpj
+                    DO ji = ildi, ilei
+                          ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D
+                    END DO
+                 END DO
+              END DO
+            ENDIF
+         END DO
+         IF (l_isend) THEN
+            DO jr = 1,nsndto
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF
+            END DO
+         ENDIF
+         !
+         DO ji = 1, num_fields     ! Loop to manage 3D variables
+            CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition
+         END DO
+         !
+         DO jk = 1, num_fields
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
+               ij = jj - nlcj + ijpj
+               DO ji = 1, nlci
+                  pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D
+               END DO
+            END DO
+         END DO
+         
+         !
+      ELSE
+         !
+         CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ztab(:,:,:) = 0.e0
+         DO jk = 1, num_fields
+            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
+                  DO ji = ildi, ilei
+                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
+                  END DO
+               END DO
+            END DO
+         END DO
+         
+         DO ji = 1, num_fields
+            CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition
+         END DO
+         !
+         DO jk = 1, num_fields
+            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
+               ij = jj - nlcj + ijpj
+               DO ji = 1, nlci
+                  pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk)
+               END DO
+            END DO
+         END DO
+         !
+         !
+      ENDIF
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
+      DEALLOCATE( ztabl, ztabr )
+      !
+   END SUBROUTINE mpp_lbc_north_2d_multiple
+
+   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(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
+
+      !
+      ijpj=4
+      ztab_e(:,:) = 0.e0
+
+      ij=0
+      ! put in znorthloc_e the last 4 jlines of pt2d
+      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
+         ij = ij + 1
+         DO ji = 1, jpi
+            znorthloc_e(ji,ij)=pt2d(ji,jj)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * jpr2dj )
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(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_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,:), 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_e(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
+      !
+   END SUBROUTINE mpp_lbc_north_e
+
+
+   SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_3d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : 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
+      INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland                      ! local scalar
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                   ! East-West boundaries
+      !                                        !* Cyclic east-west
+      IF( nbondi == 2) THEN
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE
+            IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
+            ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
+         ENDIF
+      ELSEIF(nbondi == -1) THEN
+         IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point
+      ELSEIF(nbondi == 1) THEN
+         ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north
+      ENDIF                                     !* closed
+
+      IF (nbondj == 2 .OR. nbondj == -1) THEN
+        IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point
+      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+        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_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+      CASE ( 0 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+      CASE ( 1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(      jl,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(      jl,:,:) = zt3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+      CASE ( 0 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+      CASE ( 1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
+      !
+   END SUBROUTINE mpp_lnk_bdy_3d
+
+
+   SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_2d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : 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), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                   ! East-West boundaries
+      !                                      !* Cyclic east-west
+      IF( nbondi == 2 ) THEN
+         IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+            ptab( 1 ,:) = ptab(jpim1,:)
+            ptab(jpi,:) = ptab(  2  ,:)
+         ELSE
+            IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point
+                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+      ELSEIF(nbondi == -1) THEN
+         IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point
+      ELSEIF(nbondi == 1) THEN
+                                      ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north
+      ENDIF
+      !                                      !* closed
+      IF( nbondj == 2 .OR. nbondj == -1 ) THEN
+         IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point
+      ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
+                                      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_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            zt2ew(:,jl,1) = ptab(jpreci+jl,:)
+            zt2we(:,jl,1) = ptab(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+      CASE ( 0 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+      CASE ( 1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
+      END SELECT
+      !
+      SELECT CASE ( nbondi_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:) = zt2we(:,jl,2)
+            ptab(iihom+jl,:) = zt2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:) = zt2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            zt2sn(:,jl,1) = ptab(:,ijhom +jl)
+            zt2ns(:,jl,1) = ptab(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+      CASE ( 0 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+      CASE ( 1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
+      END SELECT
+      !
+      SELECT CASE ( nbondj_bdy(ib_bdy) )
+      CASE ( -1 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         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 )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj_bdy_b(ib_bdy) )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            ptab(:,jl      ) = zt2sn(:,jl,2)
+            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl) = zt2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  )
+      !
+   END SUBROUTINE mpp_lnk_bdy_2d
+
+
+   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
+
+   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
+
+
+   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_icb  ***
+      !!
+      !! ** 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.
+      !!              This version accounts for an extra halo with icebergs.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), 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, OPTIONAL       , INTENT(in   ) ::   pr2dj
+      !
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ij, iproc, ipr2dj
+      !
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+      !!----------------------------------------------------------------------
+      !
+      ijpj=4
+      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
+         ipr2dj = pr2dj
+      ELSE
+         ipr2dj = 0
+      ENDIF
+      ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) )
+      !
+      ztab_e(:,:) = 0._wp
+      !
+      ij = 0
+      ! put in znorthloc_e the last 4 jlines of pt2d
+      DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj
+         ij = ij + 1
+         DO ji = 1, jpi
+            znorthloc_e(ji,ij)=pt2d(ji,jj)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * ipr2dj )
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(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*ipr2dj
+            DO ji = ildi, ilei
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )
+
+      ij = ipr2dj
+      !! Scatter back to pt2d
+      DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj
+      ij  = ij +1
+         DO ji= 1, nlci
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
+      !
+   END SUBROUTINE mpp_lbc_north_icb
+
+
+   SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_icb  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for 2d array (with extra halo and icebergs)
+      !!
+      !! ** 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
+      !!                    jpri   : number of rows for extra outer halo
+      !!                    jprj   : 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
+      !!----------------------------------------------------------------------
+      INTEGER                                             , INTENT(in   ) ::   jpri
+      INTEGER                                             , INTENT(in   ) ::   jprj
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), 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
+      !!
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns
+      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe
+      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jprj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  )
+         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-jpri
+         DO jl = 1, ipreci
+            r2dew(:,jl,1) = pt2d(jpreci+jl,:)
+            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jprj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe )
+         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,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,jl,2)
+            pt2d( iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpri,:) = r2dwe(:,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-jprj
+         DO jl = 1, iprecj
+            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
+            r2dns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpri )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso )
+         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) = r2dns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+            pt2d(:,ijhom+jl ) = r2dns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jprj) = r2dsn(:,jl,2)
+         END DO
+      END SELECT
+
+   END SUBROUTINE mpp_lnk_2d_icb
+   
+
+   !!----------------------------------------------------------------------
+   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_opa  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the error number (nstop) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nstop = nstop + 1
+      IF(lwp) THEN
+         WRITE(numout,cform_err)
+         IF( PRESENT(cd1 ) )   WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) )   WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) )   WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) )   WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) )   WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) )   WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) )   WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) )   WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) )   WRITE(numout,*) cd9
+         IF( PRESENT(cd10) )   WRITE(numout,*) cd10
+      ENDIF
+                               CALL FLUSH(numout    )
+      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
+      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
+      IF( cd1 == 'STOP' ) THEN
+         IF(lwp) WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
+         CALL mppstop()
+      ENDIF
+      !
+   END SUBROUTINE ctl_stop
+
+
+   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_warn  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the warning number (nwarn) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nwarn = nwarn + 1
+      IF(lwp) THEN
+         WRITE(numout,cform_war)
+         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
+         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
+      ENDIF
+      CALL FLUSH(numout)
+      !
+   END SUBROUTINE ctl_warn
+
+
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+      !!----------------------------------------------------------------------
+      !
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+      knum=get_unit()
+      !
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', clfile,' 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: ', clfile
+            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 'ctl_opn bad opening'
+      ENDIF
+      !
+   END SUBROUTINE ctl_opn
+
+
+   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_nam  ***
+      !!
+      !! ** Purpose :   Informations when error while reading a namelist
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      CHARACTER(len=4)                ::   clios   ! string to convert iostat in character for print
+      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      !!----------------------------------------------------------------------
+      !
+      WRITE (clios, '(I4.0)')   kios
+      IF( kios < 0 ) THEN         
+         CALL ctl_warn( 'end of record or file while reading namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      !
+      IF( kios > 0 ) THEN
+         CALL ctl_stop( 'misspelled variable in namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      kios = 0
+      RETURN
+      !
+   END SUBROUTINE ctl_nam
+
+
+   INTEGER FUNCTION get_unit()
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  get_unit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      LOGICAL :: llopn
+      !!----------------------------------------------------------------------
+      !
+      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (get_unit < 998) .AND. llopn )
+         get_unit = get_unit + 1
+         INQUIRE( unit = get_unit, opened = llopn )
+      END DO
+      IF( (get_unit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
+         get_unit = -1
+      ENDIF
+      !
+   END FUNCTION get_unit
+
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/make_domain_cfg.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/make_domain_cfg.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/make_domain_cfg.f90	(revision 8732)
@@ -0,0 +1,20 @@
+PROGRAM make_domain_cfg
+   !!======================================================================
+   !!                     ***  PROGRAM  make_domain_cfg  ***
+   !!
+   !! ** Purpose :  tool to create domain_cfg.nc file via nemogcm
+   !!======================================================================
+   !! 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: nemo.f90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !
+   CALL nemo_gcm           ! NEMO direct code
+   ! 
+   !!======================================================================
+END PROGRAM make_domain_cfg 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mathelp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mathelp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mathelp.f90	(revision 8732)
@@ -0,0 +1,3122 @@
+MODULE mathelp
+!-
+!$Id: mathelp.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mppini.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mppini.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mppini.f90	(revision 8732)
@@ -0,0 +1,1011 @@
+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
+   !!----------------------------------------------------------------------
+   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
+
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: mppini.F90 6412 2016-03-31 16:22:32Z lovato $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!----------------------------------------------------------------------
+   !!   '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
+      !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers
+      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      -
+      REAL(wp) ::   zidom, zjdom                       ! local scalars
+      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace
+      !!----------------------------------------------------------------------
+
+      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
+      
+      nfilcit(:,:) = ilcit(:,:)
+      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
+      
+
+      !  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
+      nfiimpp(:,:)=iimppt(:,:)
+
+      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
+         nfipproc(ii,ij) = jn - 1
+         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. Subdomain print
+      ! ------------------
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo
+
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo
+      IF(lwp) WRITE(numout,*)
+
+      IF(lwp) THEN
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200     FORMAT('     ***',20('*************',a3))
+ 9203     FORMAT('     *     ',20('         *   ',a3))
+ 9201     FORMAT('        ',20('   ',i3,'          '))
+ 9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9204     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+      ! 5. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 6. 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,*) ' nreci  = ', nreci  , ' npse   = ', npse
+         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
+         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
+         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
+         WRITE(numout,*)
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: 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_init : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+   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 ::  idir                        ! temporary integers
+      INTEGER ::  jstartrow                   ! temporary integers
+      INTEGER ::   ios                        ! Local integer output status for namelist read
+      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, zdtaisf                     ! temporary data workspace
+      REAL(wp) ::   zidom , zjdom          ! temporary scalars
+
+      ! read namelist for ln_zco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Id: mppini_2.h90 6412 2016-03-31 16:22:32Z lovato $
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp)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 and kcount forced 
+      jstartrow = 1
+      IF ( ln_zco ) THEN 
+         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
+          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+         jstartrow = MAX(1,jstartrow)
+         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
+      ELSE
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         IF ( ln_isfcav ) THEN
+             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+         ELSE
+             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+             jstartrow = MAX(1,jstartrow)
+             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
+                &                                                   , kcount=(/jpiglo,jpjglo/) )
+         ENDIF
+      ENDIF
+      CALL iom_close (inum)
+      
+      ! used to compute the land processor in case of not masked bathy file.
+      zdtaisf(:,:) = 0.0_wp
+      IF ( ln_isfcav ) THEN
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+      END IF
+      CALL iom_close (inum)
+
+      ! land/sea mask over the global/zoom domain
+
+      imask(:,:)=1
+      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) 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
+
+      nfilcit(:,:) = ilci(:,:)
+
+      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
+      nfiimpp(:,:) = iimppt(:,:)
+
+      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   ! MPI rank of northern neighbour
+         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    ! MPI rank of northern neighbour
+         ENDIF
+
+         ! Check wet points over the entire domain to preserve the MPI communication stencil
+         isurf = 0
+         DO jj = 1, ilj
+            DO  ji = 1, ili
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      nfipproc(:,:) = ipproc(:,:)
+
+      ! 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
+              ! Need to reverse the logical direction of communication 
+              ! for northern neighbours of northern row processors (north-fold)
+              ! i.e. need to check that the northern neighbour only communicates
+              ! to the SOUTH (or not at all) if this area is land-only (#1057)
+            idir = 1
+            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1    
+            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
+         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)
+
+      ! set default neighbours
+      noso = ioso(ii,ij)
+      nowe = iowe(ii,ij)
+      noea = ioea(ii,ij)
+      nono = iono(ii,ij) 
+      npse = iose(ii,ij)
+      npsw = iosw(ii,ij)
+      npne = ione(ii,ij)
+      npnw = ionw(ii,ij)
+
+      ! check neighbours location
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         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,'(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  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
+
+      ! 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
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
+         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
+         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
+         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
+         WRITE(numout,*)
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+
+   END SUBROUTINE mpp_init2
+
+   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
+      !!----------------------------------------------------------------------
+      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  
+
+
+   !!======================================================================
+END MODULE mppini
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mppini_2.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mppini_2.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/mppini_2.h90	(revision 8732)
@@ -0,0 +1,580 @@
+   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 ::  idir                        ! temporary integers
+      INTEGER ::  jstartrow                   ! temporary integers
+      INTEGER ::   ios                        ! Local integer output status for namelist read
+      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, zdtaisf                     ! temporary data workspace
+      REAL(wp) ::   zidom , zjdom          ! temporary scalars
+
+      ! read namelist for ln_zco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Id: mppini_2.h90 6412 2016-03-31 16:22:32Z lovato $
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp)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 and kcount forced 
+      jstartrow = 1
+      IF ( ln_zco ) THEN 
+         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
+          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+         jstartrow = MAX(1,jstartrow)
+         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
+      ELSE
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         IF ( ln_isfcav ) THEN
+             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+         ELSE
+             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+             jstartrow = MAX(1,jstartrow)
+             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
+                &                                                   , kcount=(/jpiglo,jpjglo/) )
+         ENDIF
+      ENDIF
+      CALL iom_close (inum)
+      
+      ! used to compute the land processor in case of not masked bathy file.
+      zdtaisf(:,:) = 0.0_wp
+      IF ( ln_isfcav ) THEN
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+      END IF
+      CALL iom_close (inum)
+
+      ! land/sea mask over the global/zoom domain
+
+      imask(:,:)=1
+      WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) 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
+
+      nfilcit(:,:) = ilci(:,:)
+
+      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
+      nfiimpp(:,:) = iimppt(:,:)
+
+      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   ! MPI rank of northern neighbour
+         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    ! MPI rank of northern neighbour
+         ENDIF
+
+         ! Check wet points over the entire domain to preserve the MPI communication stencil
+         isurf = 0
+         DO jj = 1, ilj
+            DO  ji = 1, ili
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      nfipproc(:,:) = ipproc(:,:)
+
+      ! 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
+              ! Need to reverse the logical direction of communication 
+              ! for northern neighbours of northern row processors (north-fold)
+              ! i.e. need to check that the northern neighbour only communicates
+              ! to the SOUTH (or not at all) if this area is land-only (#1057)
+            idir = 1
+            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1    
+            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
+         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)
+
+      ! set default neighbours
+      noso = ioso(ii,ij)
+      nowe = iowe(ii,ij)
+      noea = ioea(ii,ij)
+      nono = iono(ii,ij) 
+      npse = iose(ii,ij)
+      npsw = iosw(ii,ij)
+      npne = ione(ii,ij)
+      npnw = ionw(ii,ij)
+
+      ! check neighbours location
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         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,'(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  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
+
+      ! 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
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
+         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
+         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
+         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
+         WRITE(numout,*)
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+
+   END SUBROUTINE mpp_init2
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/nc4interface.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/nc4interface.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/nc4interface.f90	(revision 8732)
@@ -0,0 +1,55 @@
+MODULE nc4interface
+!-
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+
+      !!--------------------------------------------------------------------
+      !! 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
+
+!------------------
+END MODULE nc4interface
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/nemogcm.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/nemogcm.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/nemogcm.f90	(revision 8732)
@@ -0,0 +1,594 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE step_oce       ! module used in the ocean time stepping module (step.F90)
+   USE domcfg         ! domain configuration               (dom_cfg routine)
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE domain         ! domain initialization             (dom_init routine)
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_mpp        ! distributed memory computing
+
+   USE xios           ! xIOserver
+
+   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+   PUBLIC   nemo_alloc  ! needed by TAM
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: nemogcm.F90 6152 2015-12-21 22:33:57Z acc $
+   !! 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
+      !!----------------------------------------------------------------------
+      !
+      !                            !-----------------------!
+      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
+
+      !                            !-----------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      !
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found'
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
+      CALL nemo_closefile
+      !
+      CALL xios_finalize                  ! end mpp communications with xios
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER ::   ilocal_comm   ! local integer
+      INTEGER ::   ios
+      CHARACTER(len=80), DIMENSION(16) ::   cltxt
+      !
+      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_bench, nn_timing, nn_diacfl
+      NAMELIST/namcfg/ ln_e3_dep,                                &
+         &             cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
+         &             jpizoom, jpjzoom, jperio, ln_use_jattr
+      !!----------------------------------------------------------------------
+      !
+      cltxt = ''
+      cxios_context = 'nemo'
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+      IF( Agrif_Root() ) THEN
+            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios
+      ENDIF
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN
+         ! write merged namelists from earlier to output namelist now that the
+         ! file has been opened in call to mynode. nammpp has already been
+         ! written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+      ENDIF
+
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+         IF( Agrif_Root() )   CALL nemo_partition( mppsize )
+      ENDIF
+
+      ! Calculate domain dimensions given calculated jpni and jpnj
+      ! This used to be done in par_oce.F90 when they were parameters rather than variables
+      IF( Agrif_Root() ) THEN
+         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+      ENDIF         
+         jpk = jpkdta                                             ! third dim
+         jpim1 = jpi-1                                            ! inner domain indices
+         jpjm1 = jpj-1                                            !   "           "
+         jpkm1 = jpk-1                                            !   "           "
+         jpij  = jpi*jpj                                          !  jpi x j
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.7  (2015) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt)
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! Now we know the dimensions of the grid and numout has been set we can
+      ! allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_init
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+      !
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+      nbench    = nn_bench
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namcfg'
+         WRITE(numout,*) '      vertical scale factors =T: e3.=dk[depth]       ln_e3_dep = ', ln_e3_dep
+         WRITE(numout,*) '                             =F: old definition                 '
+         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg)
+         WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz)
+         WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg
+         WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta
+         WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta
+         WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta
+         WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo
+         WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo
+         WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
+         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
+         WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio  = ', jperio   
+         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
+         !
+         IF(.NOT.ln_e3_dep ) THEN
+            WRITE(numout,cform_war)
+            WRITE(numout,*)
+            WRITE(numout,*) '      ===>>>>    Obsolescent definition of e3 scale factors is used'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
+         &                                               'f2003 standard. '                              ,  &
+         &                                               'Compile with key_nosignedzero enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
+      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
+      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
+      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
+      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE dom_oce   , ONLY: dom_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        oce_alloc       ()          ! ocean
+      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+   SUBROUTINE nemo_partition( num_pes )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE nemo_partition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
+      !
+      INTEGER, PARAMETER :: nfactmax = 20
+      INTEGER :: nfact ! The no. of factors returned
+      INTEGER :: ierr  ! Error flag
+      INTEGER :: ji
+      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
+      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
+      !!----------------------------------------------------------------------
+      !
+      ierr = 0
+      !
+      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
+      !
+      IF( nfact <= 1 ) THEN
+         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
+         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
+         jpnj = 1
+         jpni = num_pes
+      ELSE
+         ! Search through factors for the pair that are closest in value
+         mindiff = 1000000
+         imin    = 1
+         DO ji = 1, nfact-1, 2
+            idiff = ABS( ifact(ji) - ifact(ji+1) )
+            IF( idiff < mindiff ) THEN
+               mindiff = idiff
+               imin = ji
+            ENDIF
+         END DO
+         jpnj = ifact(imin)
+         jpni = ifact(imin + 1)
+      ENDIF
+      !
+      jpnij = jpni*jpnj
+      !
+   END SUBROUTINE nemo_partition
+
+
+   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE factorise  ***
+      !!
+      !! ** Purpose :   return the prime factors of n.
+      !!                knfax factors are returned in array kfax which is of
+      !!                maximum dimension kmaxfax.
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
+      INTEGER                    , INTENT(  out) ::   kerr, knfax
+      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
+      !
+      INTEGER :: ifac, jl, inu
+      INTEGER, PARAMETER :: ntest = 14
+      INTEGER, DIMENSION(ntest) ::   ilfax
+      !!----------------------------------------------------------------------
+      !
+      ! lfax contains the set of allowed factors.
+      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
+      !
+      ! Clear the error flag and initialise output vars
+      kerr  = 0
+      kfax  = 1
+      knfax = 0
+      !
+      ! Find the factors of n.
+      IF( kn == 1 )   GOTO 20
+
+      ! nu holds the unfactorised part of the number.
+      ! knfax holds the number of factors found.
+      ! l points to the allowed factor list.
+      ! ifac holds the current factor.
+      !
+      inu   = kn
+      knfax = 0
+      !
+      DO jl = ntest, 1, -1
+         !
+         ifac = ilfax(jl)
+         IF( ifac > inu )   CYCLE
+
+         ! Test whether the factor will divide.
+
+         IF( MOD(inu,ifac) == 0 ) THEN
+            !
+            knfax = knfax + 1            ! Add the factor to the list
+            IF( knfax > kmaxfax ) THEN
+               kerr = 6
+               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
+               return
+            ENDIF
+            kfax(knfax) = ifac
+            ! Store the other factor that goes with this one
+            knfax = knfax + 1
+            kfax(knfax) = inu / ifac
+            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
+         ENDIF
+         !
+      END DO
+      !
+   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
+      !
+   END SUBROUTINE factorise
+
+
+   SUBROUTINE nemo_northcomms
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto     = 0
+      !
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+  
+          DO jn = 1, jpni
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nfiimpp(jn, jpnj)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                     isendto(nsndto) = jn
+                END IF
+          END DO
+          nfsloop = 1
+          nfeloop = nlci
+          DO jn = 2,jpni-1
+           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+                 nfsloop = nldi
+              ENDIF
+              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+                 nfeloop = nlei
+              ENDIF
+           ENDIF
+        END DO
+
+      ENDIF
+      l_north_nogather = .TRUE.
+   END SUBROUTINE nemo_northcomms
+
+
+   !!======================================================================
+END MODULE nemogcm
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/oce.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/oce.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/oce.f90	(revision 8732)
@@ -0,0 +1,132 @@
+MODULE oce
+   !!======================================================================
+   !!                      ***  MODULE  oce  ***
+   !! Ocean        :  dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! 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
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and before hdiv from in-core memory
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
+
+   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
+   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
+
+   !! free surface                                      !  before  ! now    ! after  !
+   !! ------------                                      !  fields  ! fields ! fields !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
+
+   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T)
+
+
+
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
+
+   !! interpolated gradient (only used in zps case)
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
+
+   !! (ISF) interpolated gradient (only used for ice shelf case) 
+   !! --------------------- 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtui, gtvi   !: horizontal gradient of T, S and rd at top u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   grui, grvi   !: horizontal gradient of T, S and rd at top v-point  
+   !! (ISF) ice load
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
+
+   !! arrays relating to embedding ice in the ocean. These arrays need to be declared 
+   !! even if no ice model is required. In the no ice model or traditional levitating 
+   !! ice cases they contain only zeros
+   !! ---------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
+
+   !! Energy budget of the leads (open water embedded in sea ice)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-]
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: oce.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(7)
+      !!----------------------------------------------------------------------
+      !
+      ierr(:) = 0 
+      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
+         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &          
+         &      wn   (jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
+         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)      ,                             &
+         &      rhd  (jpi,jpj,jpk)      , rhop (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE(rke(jpi,jpj,jpk)  ,                                         &
+         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
+         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
+         &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)      ,                     &
+         &     gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts),                     &
+         &     grui(jpi,jpj)     , grvi(jpi,jpj)     ,                     &
+         &     riceload(jpi,jpj),                             STAT=ierr(2) )
+         !
+      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) )
+         !
+      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )
+         !
+      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
+         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
+         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
+         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) )
+         !
+      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) )
+
+
+
+         !
+      oce_alloc = MAXVAL( ierr )
+      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION oce_alloc
+
+   !!======================================================================
+END MODULE oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/par_kind.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/par_kind.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/par_kind.f90	(revision 8732)
@@ -0,0 +1,40 @@
+MODULE par_kind
+   !!======================================================================
+   !!                   ***  MODULE par_kind  ***
+   !! Ocean :  define the kind of real for the whole model
+   !!======================================================================
+   !! History :  1.0  ! 2002-06  (G. Madec)  Original code
+   !!            3.3  ! 2010-12  (G. Madec)  add a standard length of character strings
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   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:
+   !             4 byte REAL       8 byte REAL
+   ! CRAY:           -            precision = 13
+   !                              exponent = 2465
+   ! IEEE:      precision = 6     precision = 15
+   !            exponent = 37     exponent = 307
+
+   !                                                                !!** 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 **
+   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: par_kind.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+END MODULE par_kind
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/par_oce.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/par_oce.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/par_oce.f90	(revision 8732)
@@ -0,0 +1,102 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! 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
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   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 )
+   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 
+
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   !
+   LOGICAL       ::   ln_e3_dep        ! e3. definition flag
+   !
+   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
+   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
+   INTEGER       ::   jp_cfg           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
+   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
+   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j
+
+   ! zoom starting position 
+   INTEGER       ::   jpizoom          !: left bottom (i,j) indices of the zoom
+   INTEGER       ::   jpjzoom          !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER       ::   jperio           !: lateral cond. type (between 0 and 6)
+   !                                       !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                       !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                       !  = 5 North fold F-point pivot
+   !                                       !  = 6 cyclic East-West AND North fold F-point pivot
+
+   ! Input file read offset
+   LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row 
+                                           ! when reading input from those netcdf files that have the 
+                                           ! attribute defined. This is designed to enable input files associated 
+                                           ! with the extended grids used in the under ice shelf configurations to 
+                                           ! be used without redundant rows when the ice shelves are not in use.
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+
+
+   !!---------------------------------------------------------------------
+   !! 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)
+   !!---------------------------------------------------------------------
+
+
+
+
+
+
+   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC  ::   jpk   ! = jpkdta
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_oce.F90 5836 2015-10-26 14:49:40Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/phycst.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/phycst.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/phycst.f90	(revision 8732)
@@ -0,0 +1,179 @@
+MODULE phycst
+   !!======================================================================
+   !!                    ***  MODULE  phycst  ***
+   !!     Definition of of both ocean and ice parameters used in the code
+   !!=====================================================================
+   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes
+   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants
+   !!              -   !  2006-08  (G. Madec)  style 
+   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
+   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   phy_cst  : define and print physical constant and domain parameters
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   phy_cst     ! routine called by inipar.F90
+
+   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi
+   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian
+   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value
+   
+   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
+   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
+   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s]
+   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year
+   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day
+   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour
+   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute
+   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1]
+   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m]
+   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2]
+   
+   REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin]
+   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
+
+
+
+
+   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin]
+
+   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
+   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
+   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
+   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
+   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
+
+   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3]
+   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice
+   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu]
+   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu]
+   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water)
+   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974)
+   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
+   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
+
+   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K]
+   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K]
+   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K]
+   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K]
+   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K]
+   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3]
+   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg]
+   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3]
+   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3]
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: phycst.F90 5147 2015-03-13 10:01:32Z cetlod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+   
+   SUBROUTINE phy_cst
+      !!----------------------------------------------------------------------
+      !!                       ***  ROUTINE phy_cst  ***
+      !!
+      !! ** Purpose :   Print model parameters and set and print the constants
+      !!----------------------------------------------------------------------
+      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )" 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+
+      ! Ocean Parameters
+      ! ----------------
+      IF(lwp) THEN
+         WRITE(numout,*) '       Domain info'
+         WRITE(numout,*) '          dimension of model'
+         WRITE(numout,*) '                 Local domain      Global domain       Data domain '
+         WRITE(numout,cform) '            ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta
+         WRITE(numout,cform) '            ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta
+         WRITE(numout,cform) '            ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta
+         WRITE(numout,*)      '           ','   jpij    : ', jpij
+         WRITE(numout,*) '          mpp local domain info (mpp)'
+         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci
+         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj
+         WRITE(numout,*) '             jpnij   : ', jpnij
+         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio
+      ENDIF
+
+      ! Define constants
+      ! ----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '       Constants'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
+
+      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
+      rsiday = rday / ( 1._wp + rday / rsiyea )
+      omega  = 2._wp * rpi / rsiday 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
+      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
+      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
+      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
+      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
+      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
+      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+
+      IF(lwp) WRITE(numout,*) '          reference density and heat capacity now defined in eosbn2.f90'
+              
+      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K]
+      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K'
+         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K'
+         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K'
+         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg'
+         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K' 
+         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K'
+         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m' 
+         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg' 
+         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3' 
+         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
+         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'
+         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic  
+         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu'
+         WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu'
+         WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3' 
+         WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma 
+         WRITE(numout,*) '          von Karman constant                       = ', vkarmn 
+         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad
+         WRITE(numout,*)
+         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall
+      ENDIF
+
+   END SUBROUTINE phy_cst
+
+   !!======================================================================
+END MODULE phycst
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/prtctl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/prtctl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/prtctl.f90	(revision 8732)
@@ -0,0 +1,561 @@
+MODULE prtctl
+   !!======================================================================
+   !!                       ***  MODULE prtctl   ***
+   !! Ocean system : print all SUM trends for each processor domain
+   !!======================================================================
+   !! History :  9.0  !  05-07  (C. Talandier) original code
+   !!            3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
+   !!----------------------------------------------------------------------
+   USE dom_oce          ! ocean space and time domain variables
+
+
+
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! distributed memory computing
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain
+   INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   !
+
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values
+
+   INTEGER ::   ktime   ! time step
+
+   PUBLIC prt_ctl         ! called by all subroutines
+   PUBLIC prt_ctl_info    ! called by all subroutines
+   PUBLIC prt_ctl_init    ! called by opa.F90
+   PUBLIC sub_dom         ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: prtctl.F90 5025 2015-01-12 15:53:50Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/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 
+      !!----------------------------------------------------------------------
+      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
+      !
+      CHARACTER (len=15) :: cl2
+      INTEGER ::   overlap, jn, sind, eind, kdir,j_id
+      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
+      REAL(wp), POINTER, DIMENSION(:,:)   :: ztab2d_1, ztab2d_2
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 )
+      CALL wrk_alloc( 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(:,:,1:kdir) = tab3d_1(:,:,1:kdir)
+      IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir)
+      IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:)
+      IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:)
+
+      IF( lk_mpp .AND. jpnij > 1 ) 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 .AND. jpnij > 1)   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( PRESENT(clinfo3)) THEN
+            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
+         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
+
+      CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 )
+      CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 )
+      !
+   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
+      !!----------------------------------------------------------------------
+      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
+      !
+      INTEGER :: jn, sind, eind, iltime, j_id
+      !!----------------------------------------------------------------------
+
+      IF( lk_mpp .AND. jpnij > 1 ) 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
+         !
+         j_id = numid(jn - narea + 1)         ! Set logical unit
+         !
+         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
+         !
+      END DO
+      !
+   END SUBROUTINE prt_ctl_info
+
+
+   SUBROUTINE prt_ctl_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE prt_ctl_init  ***
+      !!
+      !! ** Purpose :   open ASCII files & compute indices
+      !!----------------------------------------------------------------------
+      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) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   &
+         &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   &
+         &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     &
+         &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       )
+
+      ! Initialization 
+      t_ctll(:) = 0.e0
+      s_ctll(:) = 0.e0
+      u_ctll(:) = 0.e0
+      v_ctll(:) = 0.e0
+      ktime = 1
+
+      IF( lk_mpp .AND. jpnij > 1 ) 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(1:jpnij) = nldit(:) 
+         nleitl(1:jpnij) = nleit(:) 
+         nldjtl(1:jpnij) = nldjt(:) 
+         nlejtl(1:jpnij) = nlejt(:) 
+         !
+         nimpptl(1:jpnij) = nimppt(:)
+         njmpptl(1:jpnij) = njmppt(:)
+         !
+         nlcitl(1:jpnij) = nlcit(:)
+         nlcjtl(1:jpnij) = nlcjt(:)
+         !
+         ibonitl(1:jpnij) = ibonit(:)
+         ibonjtl(1:jpnij) = 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 ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+         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)
+      END DO
+      !
+   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
+      !!----------------------------------------------------------------------
+      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, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      !
+      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+      !  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
+
+
+
+      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
+      ! -------------------------------
+
+      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
+      !
+      !
+      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+      !
+   END SUBROUTINE sub_dom
+
+   !!======================================================================
+END MODULE prtctl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/restart.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/restart.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/restart.f90	(revision 8732)
@@ -0,0 +1,281 @@
+MODULE restart
+   !!======================================================================
+   !!                     ***  MODULE  restart  ***
+   !! Ocean restart :  write the ocean restart file
+   !!======================================================================
+   !! 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)
+   !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart
+   !!             -   !  2014-12  (G. Madec) remove KPP scheme
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   rst_opn    : open the ocean restart file
+   !!   rst_write  : write the ocean restart file
+   !!   rst_read   : read the ocean restart file
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_ice         ! only lk_lim3 
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE diurnal_bulk
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   rst_opn         ! routine called by step module
+   PUBLIC   rst_write       ! routine called by step module
+   PUBLIC   rst_read        ! routine called by istate module
+   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init
+
+   !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: restart.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE rst_opn( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rst_opn  ***
+      !!                     
+      !! ** Purpose : + initialization (should be read in the namelist) of nitrst 
+      !!              + open the restart when we are one time step before nitrst
+      !!                   - restart header is defined when kt = nitrst-1
+      !!                   - restart data  are written when kt = nitrst
+      !!              + define lrst_oce to .TRUE. when we need to define or write the restart
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !!
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name
+      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN   ! default definitions
+         lrst_oce = .FALSE.   
+         IF( ln_rst_list ) THEN
+            nrst_lst = 1
+            nitrst = nstocklist( nrst_lst )
+         ELSE
+            nitrst = nitend
+         ENDIF
+      ENDIF
+
+      ! frequency-based restart dumping (nn_stock)
+      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN   
+         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
+         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
+         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
+      ENDIF
+      ! to get better performances with NetCDF format:
+      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1)
+      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
+      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
+         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
+            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+            ENDIF
+            ! create the file
+            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
+            clpath = TRIM(cn_ocerst_outdir)
+            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+            IF(lwp) THEN
+               WRITE(numout,*)
+               SELECT CASE ( jprstlib )
+               CASE DEFAULT         ;   WRITE(numout,*)                            &
+                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname
+               END SELECT
+               IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
+               IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
+               ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
+               ENDIF
+            ENDIF
+            !
+            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
+            lrst_oce = .TRUE.
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE rst_opn
+
+
+   SUBROUTINE rst_write( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rstwrite  ***
+      !!                     
+      !! ** Purpose :   Write restart fields in the format corresponding to jprstlib
+      !!
+      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
+      !!              file, save fields which are necessary for restart
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step
+      !!----------------------------------------------------------------------
+
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics and tracer time step
+
+      IF ( .NOT. ln_diurnal_only ) THEN
+                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
+                     CALL iom_rstput( kt, nitrst, numrow, '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'     , tsn(:,:,:,jp_tem) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
+
+                  ! extra variable needed for the ice sheet coupling
+                  IF ( ln_iscpl ) THEN 
+                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask     ) ! need to extrapolate T/S
+                     CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask     ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask     ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask    ) ! need to correct barotropic velocity
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )   ! need to compute temperature correction
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) )   ! need to compute bt conservation
+                     CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) )   ! need to compute bt conservation
+                     CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) ) ! need to compute extrapolation if vvl
+                  END IF
+      ENDIF
+      
+      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst    )  
+
+      IF( kt == nitrst ) THEN
+         CALL iom_close( numrow )     ! close the restart file (only at last time step)
+!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
+!!gm  not sure what to do here   ===>>>  ask to Sebastian
+         lrst_oce = .FALSE.
+            IF( ln_rst_list ) THEN
+               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
+               nitrst = nstocklist( nrst_lst )
+            ENDIF
+            lrst_oce = .FALSE.
+      ENDIF
+      !
+   END SUBROUTINE rst_write
+
+
+   SUBROUTINE rst_read_open
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE rst_read_open  ***
+      !! 
+      !! ** Purpose :   Open read files for restart (format fixed by jprstlib )
+      !! 
+      !! ** Method  :   Use a non-zero, positive value of numror to assess whether or not
+      !!                the file has already been opened
+      !!----------------------------------------------------------------------
+      INTEGER        ::   jlibalt = jprstlib
+      LOGICAL        ::   llok
+      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file
+      !!----------------------------------------------------------------------
+      !
+      IF( numror <= 0 ) THEN
+         IF(lwp) THEN                                             ! Contol prints
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
+            END SELECT
+            IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
+            WRITE(numout,*) '~~~~~~~~'
+         ENDIF
+
+         clpath = TRIM(cn_ocerst_indir)
+         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
+      ENDIF
+   END SUBROUTINE rst_read_open
+
+
+   SUBROUTINE rst_read
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE rst_read  ***
+      !! 
+      !! ** Purpose :   Read files for restart (format fixed by jprstlib )
+      !! 
+      !! ** Method  :   Read in restart.nc file fields which are necessary for restart
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zrdt
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+
+      CALL rst_read_open           ! open restart for reading (if not already opened)
+
+      ! Check dynamics and tracer time-step consistency and force Euler restart if changed
+      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN
+         CALL iom_get( numror, 'rdt', zrdt )
+         IF( zrdt /= rdt )   neuler = 0
+      ENDIF
+
+      ! Diurnal DSST 
+      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  ) 
+      IF ( ln_diurnal_only ) THEN 
+         IF(lwp) WRITE( numout, * ) &
+         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0" 
+         rhop = rau0
+         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) ) 
+         RETURN 
+      ENDIF  
+      
+      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
+         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
+         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
+         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
+         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
+      ELSE
+         neuler = 0
+      ENDIF
+      !
+      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'     , tsn(:,:,:,jp_tem) )
+      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
+      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
+      ELSE
+         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )   
+      ENDIF
+      !
+      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
+         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
+         ub   (:,:,:)   = un   (:,:,:)
+         vb   (:,:,:)   = vn   (:,:,:)
+         sshb (:,:)     = sshn (:,:)
+         !
+         IF( .NOT.ln_linssh ) THEN
+            DO jk = 1, jpk
+               e3t_b(:,:,jk) = e3t_n(:,:,jk)
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE rst_read
+
+   !!=====================================================================
+END MODULE restart
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/restcom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/restcom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/restcom.f90	(revision 8732)
@@ -0,0 +1,2546 @@
+MODULE restcom
+!-
+!$Id: restcom.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/step_oce.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/step_oce.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/step_oce.f90	(revision 8732)
@@ -0,0 +1,31 @@
+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
+   !!             3.7  !  2014-01  (G. Madec) LDF simplication 
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables
+
+   USE daymod           ! calendar                         (day     routine)
+
+   USE eosbn2           ! equation of state                (eos_bn2 routine)
+
+   USE prtctl           ! Print control                    (prt_ctl routine)
+
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
+   USE timing           ! Timing
+
+
+   USE xios
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: step_oce.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE step_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/stpctl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/stpctl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/stpctl.f90	(revision 8732)
@@ -0,0 +1,159 @@
+MODULE stpctl
+   !!======================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  gross check of the ocean time stepping
+   !!======================================================================
+   !! History :  OPA  ! 1991-03  (G. Madec) Original code
+   !!            6.0  ! 1992-06  (M. Imbard)
+   !!            8.0  ! 1997-06  (A.M. Treguier)
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE c1d             ! 1D vertical configuration
+   !
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_ctl           ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: stpctl.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!              - Print it each 50 time steps
+      !!              - Stop the run IF problem ( indic < 0 )
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic   ! error indicator
+      !!
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ii, ij, ik             ! local integers
+      REAL(wp) ::   zumax, zsmin, zssh2    ! local scalars
+      INTEGER, DIMENSION(3) ::   ilocu     ! 
+      INTEGER, DIMENSION(2) ::   ilocs     ! 
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+      !
+      !                                              !* Test maximum of velocity (zonal only)
+      !                                              !  ------------------------
+      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
+      zumax = 0.e0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
+          END DO 
+        END DO 
+      END DO        
+      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      !
+      IF( zumax > 20.e0 ) THEN
+         IF( lk_mpp ) THEN
+            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
+         ELSE
+            ilocu = MAXLOC( ABS( un(:,:,:) ) )
+            ii = ilocu(1) + nimpp - 1
+            ij = ilocu(2) + njmpp - 1
+            ik = ilocu(3)
+         ENDIF
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' ====== '
+            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
+      !
+      !                                              !* Test minimum of salinity
+      !                                              !  ------------------------
+      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
+      zsmin = 100._wp
+      DO jj = 2, jpjm1
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
+      !
+      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
+      !
+      IF( zsmin < 0.) THEN 
+         IF (lk_mpp) THEN
+            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
+         ELSE
+            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
+            ii = ilocs(1) + nimpp - 1
+            ij = ilocs(2) + njmpp - 1
+         ENDIF
+         !
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9500) kt, zsmin, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic = -3
+      ENDIF
+9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
+      !
+      !
+      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
+
+      ! log file (ssh statistics)
+      ! --------                                   !* ssh statistics (and others...)
+      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
+         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
+      !
+      IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
+      !
+9200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
+9300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
+      !
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/stringop.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/stringop.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/stringop.f90	(revision 8732)
@@ -0,0 +1,185 @@
+MODULE stringop
+!-
+!$Id: stringop.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/timing.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/timing.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/timing.f90	(revision 8732)
@@ -0,0 +1,766 @@
+MODULE timing
+   !!========================================================================
+   !!                     ***  MODULE  timing  ***
+   !!========================================================================
+   !! History : 4.0  ! 2001-05  (R. Benshila)   
+   !!------------------------------------------------------------------------
+
+   !!------------------------------------------------------------------------
+   !!   timming_init    : initialize timing process 
+   !!   timing_start    : start Timer
+   !!   timing_stop     : stop  Timer
+   !!   timing_reset    : end timing variable creation
+   !!   timing_finalize : compute stats and write output in calling w*_info 
+   !!   timing_ini_var  : create timing variables 
+   !!   timing_listing  : print instumented subroutines in ocean.output
+   !!   wcurrent_info   : compute and print detailed stats on the current CPU
+   !!   wave_info       : compute and print averaged statson all processors
+   !!   wmpi_info       : compute and write global stats  
+   !!   supress         : suppress an element of the timing linked list  
+   !!   insert          : insert an element of the timing linked list  
+   !!------------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager 
+   USE dom_oce         ! ocean domain
+   USE lib_mpp          
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
+   PUBLIC   timing_reset                   ! called in step module 
+   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
+   
+
+   INCLUDE 'mpif.h'
+
+
+   ! Variables for fine grain timing
+   TYPE timer
+      CHARACTER(LEN=20)  :: cname
+   	  REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
+      INTEGER :: ncount, ncount_max, ncount_rate  
+      INTEGER :: niter
+      LOGICAL :: l_tdone
+      TYPE(timer), POINTER :: next => NULL()
+      TYPE(timer), POINTER :: prev => NULL()
+      TYPE(timer), POINTER :: parent_section => NULL()
+   END TYPE timer
+    
+   TYPE alltimer
+      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
+   	  REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL()
+   	  REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
+   	  INTEGER, DIMENSION(:), POINTER :: niter => NULL()
+      TYPE(alltimer), POINTER :: next => NULL()
+      TYPE(alltimer), POINTER :: prev => NULL()
+   END TYPE alltimer 
+ 
+   TYPE(timer), POINTER :: s_timer_root => NULL()
+   TYPE(timer), POINTER :: s_timer      => NULL()
+   TYPE(timer), POINTER :: s_wrk        => NULL()
+   REAL(wp) :: t_overclock, t_overcpu
+   LOGICAL :: l_initdone = .FALSE.
+   INTEGER :: nsize
+   
+   ! Variables for coarse grain timing
+   REAL(wp) :: tot_etime, tot_ctime
+   REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
+   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
+   INTEGER, DIMENSION(8)           :: nvalues
+   CHARACTER(LEN=8), DIMENSION(2)  :: cdate
+   CHARACTER(LEN=10), DIMENSION(2) :: ctime
+   CHARACTER(LEN=5)                :: czone
+    
+   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl
+   LOGICAL :: ln_onefile = .TRUE. 
+   LOGICAL :: lwriter
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: timing.F90 5120 2015-03-03 16:11:55Z acc $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE timing_start(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_start  ***
+      !! ** Purpose :   collect execution time
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      !
+       
+      ! Create timing structure at first call
+      IF( .NOT. l_initdone ) THEN
+         CALL timing_ini_var(cdinfo)
+      ELSE
+         s_timer => s_timer_root
+         DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+            IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO
+      ENDIF         
+      s_timer%l_tdone = .FALSE.
+      s_timer%niter = s_timer%niter + 1
+      s_timer%t_cpu = 0.
+      s_timer%t_clock = 0.
+                  
+      ! CPU time collection
+      CALL CPU_TIME( s_timer%t_cpu  )
+      ! clock time collection
+
+      s_timer%t_clock= MPI_Wtime()
+
+
+
+
+      !
+   END SUBROUTINE timing_start
+
+
+   SUBROUTINE timing_stop(cdinfo, csection)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_stop  ***
+      !! ** Purpose :   finalize timing and output
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
+      !
+      INTEGER  :: ifinal_count, iperiods    
+      REAL(wp) :: zcpu_end, zmpitime
+      !
+      s_wrk => NULL()
+
+      ! clock time collection
+
+      zmpitime = MPI_Wtime()
+
+
+
+      ! CPU time collection
+      CALL CPU_TIME( zcpu_end )
+
+      s_timer => s_timer_root
+      DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+      END DO
+ 
+      ! CPU time correction
+      s_timer%t_cpu  = zcpu_end - s_timer%t_cpu - t_overcpu - s_timer%tsub_cpu
+  
+      ! clock time correction
+
+      s_timer%t_clock = zmpitime - s_timer%t_clock - t_overclock - s_timer%tsub_clock
+
+
+
+
+
+
+      
+      ! Correction of parent section
+      IF( .NOT. PRESENT(csection) ) THEN
+         s_wrk => s_timer
+         DO WHILE ( ASSOCIATED(s_wrk%parent_section ) )
+            s_wrk => s_wrk%parent_section
+            s_wrk%tsub_cpu   = s_wrk%tsub_cpu   + s_timer%t_cpu 
+            s_wrk%tsub_clock = s_wrk%tsub_clock + s_timer%t_clock              
+         END DO
+      ENDIF
+            
+      ! time diagnostics 
+      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
+      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu
+!RB to use to get min/max during a time integration
+!      IF( .NOT. l_initdone ) THEN
+!         s_timer%tmin_clock = s_timer%t_clock 
+!         s_timer%tmin_cpu   = s_timer%t_cpu 
+!      ELSE
+!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
+!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
+!      ENDIF   
+!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
+!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )  
+      !
+      s_timer%tsub_clock = 0.
+      s_timer%tsub_cpu = 0.
+      s_timer%l_tdone = .TRUE.
+      !
+   END SUBROUTINE timing_stop
+ 
+ 
+   SUBROUTINE timing_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_init  ***
+      !! ** Purpose :   open timing output file
+      !!----------------------------------------------------------------------
+      INTEGER :: iperiods, istart_count, ifinal_count
+      REAL(wp) :: zdum
+      LOGICAL :: ll_f
+             
+      IF( ln_onefile ) THEN
+         IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
+         lwriter = lwp
+      ELSE
+         CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
+         lwriter = .TRUE.
+      ENDIF
+      
+      IF( lwriter) THEN      
+         WRITE(numtime,*)
+         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
+         WRITE(numtime,*) '                             NEMO team'
+         WRITE(numtime,*) '                  Ocean General Circulation Model'
+         WRITE(numtime,*) '                        version 3.6  (2015) '
+         WRITE(numtime,*)
+         WRITE(numtime,*) '                        Timing Informations '
+         WRITE(numtime,*)
+         WRITE(numtime,*)
+      ENDIF   
+      
+      ! Compute clock function overhead
+
+      t_overclock = MPI_WTIME()
+      t_overclock = MPI_WTIME() - t_overclock
+
+      ! Compute cpu_time function overhead
+      CALL CPU_TIME(zdum)
+      CALL CPU_TIME(t_overcpu)
+      
+      ! End overhead omputation  
+      t_overcpu = t_overcpu - zdum        
+      t_overclock = t_overcpu + t_overclock        
+
+      ! Timing on date and time
+      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
+    
+      CALL CPU_TIME(t_cpu(1))      
+      ! Start elapsed and CPU time counters
+      t_elaps(1) = MPI_WTIME()
+      !
+   END SUBROUTINE timing_init
+
+
+   SUBROUTINE timing_finalize
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_finalize ***
+      !! ** Purpose :  compute average time 
+      !!               write timing output file
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER :: s_temp
+      INTEGER :: idum, iperiods, icode
+      LOGICAL :: ll_ord, ll_averep
+      CHARACTER(len=120) :: clfmt            
+      
+      ll_averep = .TRUE.
+    
+      ! total CPU and elapse
+      CALL CPU_TIME(t_cpu(2))
+      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu
+      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
+
+      ! End of timings on date & time
+      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
+       
+      ! Compute the numer of routines
+      nsize = 0 
+      s_timer => s_timer_root
+      DO WHILE( ASSOCIATED(s_timer) )
+         nsize = nsize + 1
+         s_timer => s_timer%next
+      END DO
+      idum = nsize
+      IF(lk_mpp) CALL mpp_sum(idum)
+      IF( idum/jpnij /= nsize ) THEN
+         IF( lwriter ) WRITE(numtime,*) '        ===> W A R N I N G: '
+         IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
+         IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
+         IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
+         IF( lwriter ) WRITE(numtime,*)
+         ll_averep = .FALSE.
+      ENDIF   
+
+      ! in MPI gather some info
+      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
+      CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION,   &
+                         all_etime , 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OPA, icode)
+      CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION,   &
+                         all_ctime, 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OPA, icode)
+      tot_etime = SUM(all_etime(:))
+      tot_ctime = SUM(all_ctime(:))
+
+      ! write output file
+      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
+      IF( lwriter ) WRITE(numtime,*) '--------------------'
+      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')")
+      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime
+      IF( lwriter ) WRITE(numtime,*) 
+      IF( ll_averep ) CALL waver_info
+      CALL wmpi_info
+      IF( lwriter ) CALL wcurrent_info
+      
+      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   &
+      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   &
+      &       czone(1:3),    czone(4:5)                     
+      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   &
+      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   &
+      &       czone(1:3),    czone(4:5)
+
+      IF( lwriter ) CLOSE(numtime) 
+      !
+   END SUBROUTINE timing_finalize
+   
+
+   SUBROUTINE wcurrent_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write timing output file
+      !!----------------------------------------------------------------------
+      LOGICAL :: ll_ord
+      CHARACTER(len=2048) :: clfmt            
+   
+      ! reorder the current list by elapse time      
+      s_wrk => NULL()
+      s_timer => s_timer_root
+      DO
+         ll_ord = .TRUE.
+         s_timer => s_timer_root
+         DO WHILE ( ASSOCIATED( s_timer%next ) )
+         IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
+            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
+               ALLOCATE(s_wrk)
+               s_wrk = s_timer%next
+               CALL insert  (s_timer, s_timer_root, s_wrk)
+               CALL suppress(s_timer%next)            
+               ll_ord = .FALSE.
+               CYCLE            
+            ENDIF           
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO         
+         IF( ll_ord ) EXIT
+      END DO
+            
+      ! write current info
+      WRITE(numtime,*) 'Detailed timing for proc :', narea-1
+      WRITE(numtime,*) '--------------------------'
+      WRITE(numtime,*) 'Section             ',            &
+      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   &
+      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
+      s_timer => s_timer_root  
+      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
+      DO WHILE ( ASSOCIATED(s_timer) )
+         WRITE(numtime,TRIM(clfmt))   s_timer%cname,   &
+         &   s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2),            &
+         &   s_timer%tsum_cpu  ,s_timer%tsum_cpu*100./t_cpu(2)    ,            &
+         &   s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
+         s_timer => s_timer%next
+      END DO
+      WRITE(numtime,*)
+      !                  
+   END SUBROUTINE wcurrent_info
+
+   SUBROUTINE waver_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write averaged timing informations
+      !!----------------------------------------------------------------------
+      TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
+      TYPE(alltimer), POINTER :: sl_timer_glob      => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave      => NULL()
+      INTEGER :: icode
+      INTEGER :: ierr
+      LOGICAL :: ll_ord           
+      CHARACTER(len=200) :: clfmt              
+                 
+      ! Initialised the global strucutre   
+      ALLOCATE(sl_timer_glob_root, Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+
+      ALLOCATE(sl_timer_glob_root%cname     (jpnij), &
+               sl_timer_glob_root%tsum_cpu  (jpnij), &
+               sl_timer_glob_root%tsum_clock(jpnij), &
+               sl_timer_glob_root%niter     (jpnij), Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+      sl_timer_glob_root%cname(:)       = ''
+      sl_timer_glob_root%tsum_cpu(:)   = 0._wp
+      sl_timer_glob_root%tsum_clock(:) = 0._wp
+      sl_timer_glob_root%niter(:)      = 0
+      sl_timer_glob_root%next => NULL()
+      sl_timer_glob_root%prev => NULL()
+      !ARPDBG - don't need to allocate a pointer that's immediately then
+      !         set to point to some other object.
+      !ALLOCATE(sl_timer_glob)
+      !ALLOCATE(sl_timer_glob%cname     (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_cpu  (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
+      !ALLOCATE(sl_timer_glob%niter     (jpnij))
+      sl_timer_glob => sl_timer_glob_root
+      !
+      IF( narea .EQ. 1 ) THEN
+         ALLOCATE(sl_timer_ave_root)
+         sl_timer_ave_root%cname       = ''
+         sl_timer_ave_root%t_cpu      = 0._wp
+         sl_timer_ave_root%t_clock    = 0._wp
+         sl_timer_ave_root%tsum_cpu   = 0._wp
+         sl_timer_ave_root%tsum_clock = 0._wp
+         sl_timer_ave_root%tmax_cpu   = 0._wp
+         sl_timer_ave_root%tmax_clock = 0._wp
+         sl_timer_ave_root%tmin_cpu   = 0._wp
+         sl_timer_ave_root%tmin_clock = 0._wp
+         sl_timer_ave_root%tsub_cpu   = 0._wp
+         sl_timer_ave_root%tsub_clock = 0._wp
+         sl_timer_ave_root%ncount      = 0
+         sl_timer_ave_root%ncount_rate = 0
+         sl_timer_ave_root%ncount_max  = 0
+         sl_timer_ave_root%niter       = 0
+         sl_timer_ave_root%l_tdone  = .FALSE.
+         sl_timer_ave_root%next => NULL()
+         sl_timer_ave_root%prev => NULL()
+         ALLOCATE(sl_timer_ave)
+         sl_timer_ave => sl_timer_ave_root            
+      ENDIF 
+
+      ! Gather info from all processors
+      s_timer => s_timer_root
+      DO WHILE ( ASSOCIATED(s_timer) )
+         CALL MPI_GATHER(s_timer%cname     , 20, MPI_CHARACTER,   &
+                         sl_timer_glob%cname, 20, MPI_CHARACTER,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%tsum_clock     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%tsum_cpu     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OPA, icode)
+         CALL MPI_GATHER(s_timer%niter     , 1, MPI_INTEGER,   &
+                         sl_timer_glob%niter, 1, MPI_INTEGER,   &
+                         0, MPI_COMM_OPA, icode)
+
+         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
+            ALLOCATE(sl_timer_glob%next)
+            ALLOCATE(sl_timer_glob%next%cname     (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_cpu  (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
+            ALLOCATE(sl_timer_glob%next%niter     (jpnij))
+            sl_timer_glob%next%prev => sl_timer_glob
+            sl_timer_glob%next%next => NULL()
+            sl_timer_glob           => sl_timer_glob%next
+         ENDIF              
+         s_timer => s_timer%next
+      END DO      
+
+         WRITE(*,*) 'ARPDBG: timing: done gathers'
+      
+      IF( narea == 1 ) THEN    
+         ! Compute some stats
+         sl_timer_glob => sl_timer_glob_root
+         DO WHILE( ASSOCIATED(sl_timer_glob) )
+            sl_timer_ave%cname  = sl_timer_glob%cname(1)
+            sl_timer_ave%tsum_cpu   = SUM   (sl_timer_glob%tsum_cpu  (:)) / jpnij
+            sl_timer_ave%tsum_clock = SUM   (sl_timer_glob%tsum_clock(:)) / jpnij
+            sl_timer_ave%tmax_cpu   = MAXVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%tmin_cpu   = MINVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%niter      = SUM   (sl_timer_glob%niter     (:))
+            !
+            IF( ASSOCIATED(sl_timer_glob%next) ) THEN
+               ALLOCATE(sl_timer_ave%next)          
+               sl_timer_ave%next%prev => sl_timer_ave
+               sl_timer_ave%next%next => NULL()           
+               sl_timer_ave           => sl_timer_ave%next
+            ENDIF
+            sl_timer_glob => sl_timer_glob%next                                
+         END DO
+
+         WRITE(*,*) 'ARPDBG: timing: done computing stats'
+      
+         ! reorder the averaged list by CPU time      
+         s_wrk => NULL()
+         sl_timer_ave => sl_timer_ave_root
+         DO
+            ll_ord = .TRUE.
+            sl_timer_ave => sl_timer_ave_root
+            DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
+
+               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
+
+               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
+                  ALLOCATE(s_wrk)
+                  ! Copy data into the new object pointed to by s_wrk
+                  s_wrk = sl_timer_ave%next
+                  ! Insert this new timer object before our current position
+                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk)
+                  ! Remove the old object from the list
+                  CALL suppress(sl_timer_ave%next)            
+                  ll_ord = .FALSE.
+                  CYCLE            
+               ENDIF           
+               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
+            END DO         
+            IF( ll_ord ) EXIT
+         END DO
+
+         ! write averaged info
+         WRITE(numtime,"('Averaged timing on all processors :')")
+         WRITE(numtime,"('-----------------------------------')")
+         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
+         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   &
+         &   'Max elap(%)',2x,'Min elap(%)',2x,            &           
+         &   'Freq')")
+         sl_timer_ave => sl_timer_ave_root  
+         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
+         DO WHILE ( ASSOCIATED(sl_timer_ave) )
+            WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                            &
+            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   &
+            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   &
+            &   sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock,                          &
+            &   sl_timer_ave%tmax_clock*100.*jpnij/tot_etime,                           &
+            &   sl_timer_ave%tmin_clock*100.*jpnij/tot_etime,                           &                                               
+            &   sl_timer_ave%niter/REAL(jpnij)
+            sl_timer_ave => sl_timer_ave%next
+         END DO
+         WRITE(numtime,*)
+         !
+         DEALLOCATE(sl_timer_ave_root)
+      ENDIF
+      !
+      DEALLOCATE(sl_timer_glob_root)
+      !                  
+   END SUBROUTINE waver_info
+  
+  
+   SUBROUTINE wmpi_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wmpi_time  ***
+      !! ** Purpose :   compute and write a summary of MPI infos 
+      !!----------------------------------------------------------------------   
+      !   
+      INTEGER                            :: idum, icode
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
+      REAL(wp) :: ztot_ratio
+      REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
+      REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
+      CHARACTER(LEN=128), dimension(8) :: cllignes
+      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date
+      CHARACTER(LEN=2048)              :: clfmt    
+   
+      ! Gather all times
+      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
+      IF( narea == 1 ) THEN
+         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
+   
+         ! Compute elapse user time
+         zavg_etime = tot_etime/REAL(jpnij,wp)
+         zmax_etime = MAXVAL(all_etime(:))
+         zmin_etime = MINVAL(all_etime(:))
+
+         ! Compute CPU user time
+         zavg_ctime = tot_ctime/REAL(jpnij,wp)
+         zmax_ctime = MAXVAL(all_ctime(:))
+         zmin_ctime = MINVAL(all_ctime(:))
+   
+         ! Compute cpu/elapsed ratio
+         zall_ratio(:) = all_ctime(:) / all_etime(:)
+         ztot_ratio    = SUM(zall_ratio(:))
+         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
+         zmax_ratio    = MAXVAL(zall_ratio(:))
+         zmin_ratio    = MINVAL(zall_ratio(:))   
+   
+         ! Output Format
+         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,'
+         cllignes(1)='(1x,"MPI summary report :",/,'
+         cllignes(2)='1x,"--------------------",//,'
+         cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
+         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
+         WRITE(cllignes(4)(1:4),'(I4)') jpnij
+         cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(7)='1x,"Maximum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(8)='1x,"Average      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3)'
+         clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))//          &
+           & TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))//  &
+           & TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))//  &
+           & TRIM(clhline)//TRIM(cllignes(8))
+         WRITE(numtime, TRIM(clfmt)) &
+             (iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
+             tot_etime,     tot_ctime,     ztot_ratio,   &
+             zmin_etime,    zmin_ctime,    zmin_ratio,   &
+             zmax_etime,    zmax_ctime,    zmax_ratio,   &
+             zavg_etime,    zavg_ctime,    zavg_ratio
+         WRITE(numtime,*)    
+      END IF
+      !
+      DEALLOCATE(zall_ratio, iall_rank)
+      !
+   END SUBROUTINE wmpi_info
+
+
+   SUBROUTINE timing_ini_var(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_ini_var  ***
+      !! ** Purpose :   create timing structure 
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      LOGICAL :: ll_section
+       
+      !
+      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
+         ALLOCATE(s_timer_root)
+         s_timer_root%cname       = cdinfo
+         s_timer_root%t_cpu      = 0._wp
+         s_timer_root%t_clock    = 0._wp
+         s_timer_root%tsum_cpu   = 0._wp
+         s_timer_root%tsum_clock = 0._wp
+         s_timer_root%tmax_cpu   = 0._wp
+         s_timer_root%tmax_clock = 0._wp
+         s_timer_root%tmin_cpu   = 0._wp
+         s_timer_root%tmin_clock = 0._wp
+         s_timer_root%tsub_cpu   = 0._wp
+         s_timer_root%tsub_clock = 0._wp
+         s_timer_root%ncount      = 0
+         s_timer_root%ncount_rate = 0
+         s_timer_root%ncount_max  = 0
+         s_timer_root%niter       = 0
+         s_timer_root%l_tdone  = .FALSE.
+         s_timer_root%next => NULL()
+         s_timer_root%prev => NULL()
+         s_timer => s_timer_root
+         !
+         ALLOCATE(s_wrk)
+         s_wrk => NULL()
+         
+      ELSE
+         s_timer => s_timer_root
+         ! case of already existing area (typically inside a loop)
+         DO WHILE( ASSOCIATED(s_timer) ) 
+            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) RETURN
+            s_timer => s_timer%next
+         END DO
+         
+         ! end of the chain
+         s_timer => s_timer_root
+         DO WHILE( ASSOCIATED(s_timer%next) )
+            s_timer => s_timer%next
+         END DO
+          
+         ALLOCATE(s_timer%next)      
+         s_timer%next%cname       = cdinfo
+         s_timer%next%t_cpu      = 0._wp
+         s_timer%next%t_clock    = 0._wp
+         s_timer%next%tsum_cpu   = 0._wp
+         s_timer%next%tsum_clock = 0._wp  
+         s_timer%next%tmax_cpu   = 0._wp
+         s_timer%next%tmax_clock = 0._wp
+         s_timer%next%tmin_cpu   = 0._wp
+         s_timer%next%tmin_clock = 0._wp
+         s_timer%next%tsub_cpu   = 0._wp
+         s_timer%next%tsub_clock = 0._wp
+         s_timer%next%ncount      = 0
+         s_timer%next%ncount_rate = 0
+         s_timer%next%ncount_max  = 0
+         s_timer%next%niter       = 0
+         s_timer%next%l_tdone  = .FALSE.
+         s_timer%next%parent_section => NULL()
+         s_timer%next%prev => s_timer
+         s_timer%next%next => NULL()
+         s_timer => s_timer%next
+
+         ! are we inside a section
+         s_wrk => s_timer%prev
+         ll_section = .FALSE.
+         DO WHILE( ASSOCIATED(s_wrk) .AND. .NOT. ll_section )
+            IF( .NOT. s_wrk%l_tdone ) THEN
+               ll_section = .TRUE.
+               s_timer%parent_section => s_wrk 
+            ENDIF
+            s_wrk => s_wrk%prev
+         END DO 
+      ENDIF         
+      !
+   END SUBROUTINE timing_ini_var
+
+
+   SUBROUTINE timing_reset
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_reset  ***
+      !! ** Purpose :   go to root of timing tree 
+      !!----------------------------------------------------------------------
+      l_initdone = .TRUE. 
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
+!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+!      CALL timing_list(s_timer_root)
+!      WRITE(numout,*)
+      !
+   END SUBROUTINE timing_reset
+
+
+   RECURSIVE SUBROUTINE timing_list(ptr)
+   
+      TYPE(timer), POINTER, INTENT(inout) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
+      IF(lwp) WRITE(numout,*)'   ', ptr%cname   
+      !
+   END SUBROUTINE timing_list
+
+
+   SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE insert  ***
+      !! ** Purpose :   insert an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
+      !
+     
+      IF( ASSOCIATED( sd_current, sd_root ) ) THEN
+         ! If our current element is the root element then
+         ! replace it with the one being inserted
+         sd_root => sd_ptr
+      ELSE
+         sd_current%prev%next => sd_ptr
+      END IF
+      sd_ptr%next     => sd_current
+      sd_ptr%prev     => sd_current%prev
+      sd_current%prev => sd_ptr
+      ! Nullify the pointer to the new element now that it is held
+      ! within the list. If we don't do this then a subsequent call
+      ! to ALLOCATE memory to this pointer will fail.
+      sd_ptr => NULL()
+      !    
+   END SUBROUTINE insert
+  
+  
+   SUBROUTINE suppress(sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE suppress  ***
+      !! ** Purpose :   supress an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
+      !
+      TYPE(timer), POINTER :: sl_temp
+    
+      sl_temp => sd_ptr
+      sd_ptr => sd_ptr%next    
+      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
+      DEALLOCATE(sl_temp)
+      sl_temp => NULL()
+      !
+    END SUBROUTINE suppress
+
+   !!=====================================================================
+END MODULE timing
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/trc_oce.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/trc_oce.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/trc_oce.f90	(revision 8732)
@@ -0,0 +1,263 @@
+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        ! ocean parameters
+   USE dom_oce        ! ocean space and time domain
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   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
+   PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90
+
+   INTEGER , PUBLIC                                      ::   nn_dttrc      !: frequency of step on passive tracers
+   REAL(wp), PUBLIC                                      ::   r_si2         !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3         !: light absortion coefficient
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol        !: volume for degraded regions
+
+
+
+
+
+
+
+
+   !!----------------------------------------------------------------------
+   !! Default option                          No bio-model light absorption      
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .FALSE.   !: TOP model
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: trc_oce.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  trc_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr(2)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+                     ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) )
+      IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) )
+      trc_oce_alloc  = MAXVAL( ierr )
+      !
+      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
+   END FUNCTION trc_oce_alloc
+
+
+   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,:)
+      !
+      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)
+         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
+         IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
+         IF( irgb /= jc ) THEN
+            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
+            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  ::   jc, jb ! dummy loop indice
+      INTEGER  ::   irgb   ! temporary integer
+      REAL(wp) ::   zchl   ! temporary scalar
+      INTEGER  ::   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,*) ' ~~~~~~~~~~~~~~~~'
+         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
+
+
+   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 below the following depth
+      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
+      !
+      ! Level of light extinction
+      pjl = jpkm1
+      DO jk = jpkm1, 1, -1
+         IF(SUM(tmask(:,:,jk)) > 0 ) THEN
+            zem = MAXVAL( gdepw_0(:,:,jk+1) * tmask(:,:,jk) )
+            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
+         ELSE
+            pjl = jk                                            ! or regional sea-bed depth 
+         ENDIF
+      END DO
+      !
+   END FUNCTION trc_oce_ext_lev
+
+   !!======================================================================
+END MODULE trc_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/wrk_nemo.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/wrk_nemo.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/src/wrk_nemo.f90	(revision 8732)
@@ -0,0 +1,599 @@
+MODULE wrk_nemo
+   !!======================================================================
+   !!                       ***  MODULE  wrk_nemo  ***
+   !! NEMO work space:  define and allocate work-space arrays used in 
+   !! all components of NEMO
+   !!======================================================================
+   !! History :  4.0  !  2011-01  (A Porter)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   wrk_alloc         : get work space arrays
+   !!   wrk_dealloc       : release work space arrays
+   !!
+   !! 1d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, arr1, arr2, ... arr10, kistart = kistart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, arr1, arr2, ... arr10, kistart = kistart)
+   !!   with:
+   !!     - arr*: 1d arrays. real or (not and) integer
+   !!     - nx: size of the 1d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart: optional parameter to lower bound of the 1st dimension (default = 1)
+   !!
+   !! 2d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:,:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, ny, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart )
+   !!   with:
+   !!     - arr* 2d arrays. real or (not and) integer
+   !!     - nx, ny: size of the 2d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart, kjstart: optional parameters to lower bound of the 1st/2nd dimension (default = 1)
+   !!
+   !! 3d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:,:,:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, ny, nz, arr1, arr2, ... arr10, kistart = kistart, kjstart = kjstart, kkstart = kkstart )
+   !!   with:
+   !!     - arr* 3d arrays. real or (not and) integer
+   !!     - nx, ny, nz: size of the 3d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart, kjstart, kkstart: optional parameters to lower bound of the 1st/2nd/3rd dimension (default = 1)
+   !!
+   !! 4d arrays:
+   !!   REAL(wp), POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10
+   !!    or
+   !!   INTEGER, POINTER, DIMENSION(:,:,:,:) :: arr1, arr2, ... arr10
+   !!   ...
+   !!   CALL wrk_alloc( nx, ny, nz, nl, arr1, arr2, ... arr10, &
+   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart )
+   !!   ...
+   !!   CALL wrk_dealloc( nx, ny, nz, nl, arr1, arr2, ... arr10, &
+   !!      &            kistart = kistart, kjstart = kjstart, kkstart = kkstart, klstart = klstart )
+   !!   with:
+   !!     - arr* 3d arrays. real or (not and) integer
+   !!     - nx, ny, nz, nl: size of the 4d arr* arrays
+   !!     - arr2, ..., arr10: optional parameters
+   !!     - kistart, kjstart, kkstart, klstart: optional parameters to lower bound of the 1st/2nd/3rd/4th dimension (default = 1)
+   !!   
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC wrk_alloc, wrk_dealloc, wrk_list
+
+   INTERFACE wrk_alloc
+      MODULE PROCEDURE wrk_alloc_1dr, wrk_alloc_2dr, wrk_alloc_3dr, wrk_alloc_4dr,   &
+         &             wrk_alloc_1di, wrk_alloc_2di, wrk_alloc_3di, wrk_alloc_4di
+   END INTERFACE
+
+   INTERFACE wrk_dealloc
+      MODULE PROCEDURE wrk_dealloc_1dr, wrk_dealloc_2dr, wrk_dealloc_3dr, wrk_dealloc_4dr,   &
+         &             wrk_dealloc_1di, wrk_dealloc_2di, wrk_dealloc_3di, wrk_dealloc_4di
+   END INTERFACE
+
+
+   INTEGER, PARAMETER :: jparray = 1000
+   INTEGER, PARAMETER :: jpmaxdim = 4
+
+   INTEGER, PARAMETER :: jpnotdefined = 0
+   INTEGER, PARAMETER :: jpinteger = 1
+   INTEGER, PARAMETER :: jpreal = 2
+  
+   TYPE leaf
+      LOGICAL :: in_use
+      INTEGER :: indic
+      INTEGER , DIMENSION(:)      , POINTER :: iwrk1d => NULL()    
+      INTEGER , DIMENSION(:,:)    , POINTER :: iwrk2d => NULL()    
+      INTEGER , DIMENSION(:,:,:)  , POINTER :: iwrk3d => NULL()    
+      INTEGER , DIMENSION(:,:,:,:), POINTER :: iwrk4d => NULL()    
+      REAL(wp), DIMENSION(:)      , POINTER :: zwrk1d => NULL()    
+      REAL(wp), DIMENSION(:,:)    , POINTER :: zwrk2d => NULL()    
+      REAL(wp), DIMENSION(:,:,:)  , POINTER :: zwrk3d => NULL()    
+      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zwrk4d => NULL()    
+      TYPE (leaf), POINTER :: next => NULL() 
+      TYPE (leaf), POINTER :: prev => NULL() 
+   END TYPE leaf
+   
+   TYPE branch
+      INTEGER :: itype
+      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart
+      TYPE(leaf), POINTER :: start => NULL()     
+      TYPE(leaf), POINTER :: current => NULL()      
+   END TYPE branch
+
+   TYPE(branch), SAVE, DIMENSION(jparray) :: tree
+
+   LOGICAL ::   linit = .FALSE.
+   LOGICAL ::   ldebug = .FALSE.
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: wrk_nemo.F90 5514 2015-06-30 10:06:05Z smasson $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE wrk_list
+      ! to list 3d arrays in use, to be duplicated for all cases 
+      WRITE(*,*) 'Arrays in use :'
+      !      CALL listage(tree_3d(1)%s_wrk_3d_start)
+      WRITE(*,*) ''
+      
+   END SUBROUTINE wrk_list
+   
+   
+   RECURSIVE SUBROUTINE listage(ptr)
+      
+      TYPE(leaf), POINTER, INTENT(in) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL listage(ptr%next)
+      WRITE(*,*) ptr%in_use, ptr%indic   
+      
+   END SUBROUTINE listage
+
+
+   SUBROUTINE wrk_alloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            &
+         &               p1d01 = p1d01, p1d02 = p1d02, p1d03 = p1d03, p1d04 = p1d04, p1d05 = p1d05,   &
+         &               p1d06 = p1d06, p1d07 = p1d07, p1d08 = p1d08, p1d09 = p1d09, p1d10 = p1d10    )
+      !
+   END SUBROUTINE wrk_alloc_1dr
+
+
+   SUBROUTINE wrk_alloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      CALL wrk_alloc_xd( kidim, 0, 0, 0, kistart, 1, 1, 1,                                            &
+         &               k1d01 = k1d01, k1d02 = k1d02, k1d03 = k1d03, k1d04 = k1d04, k1d05 = k1d05,   &
+         &               k1d06 = k1d06, k1d07 = k1d07, k1d08 = k1d08, k1d09 = k1d09, k1d10 = k1d10    )
+      !
+   END SUBROUTINE wrk_alloc_1di
+
+
+   SUBROUTINE wrk_alloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart, kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  &
+         &               p2d01 = p2d01, p2d02 = p2d02, p2d03 = p2d03, p2d04 = p2d04, p2d05 = p2d05,   &
+         &               p2d06 = p2d06, p2d07 = p2d07, p2d08 = p2d08, p2d09 = p2d09, p2d10 = p2d10    )
+      !
+   END SUBROUTINE wrk_alloc_2dr
+
+
+   SUBROUTINE wrk_alloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart, kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, 0, 0, kistart, kjstart, 1, 1,                                  &
+         &               k2d01 = k2d01, k2d02 = k2d02, k2d03 = k2d03, k2d04 = k2d04, k2d05 = k2d05,   &
+         &               k2d06 = k2d06, k2d07 = k2d07, k2d08 = k2d08, k2d09 = k2d09, k2d10 = k2d10    )
+      !
+   END SUBROUTINE wrk_alloc_2di
+
+
+   SUBROUTINE wrk_alloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
+      &                      kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        &
+         &               p3d01 = p3d01, p3d02 = p3d02, p3d03 = p3d03, p3d04 = p3d04, p3d05 = p3d05,   &
+         &               p3d06 = p3d06, p3d07 = p3d07, p3d08 = p3d08, p3d09 = p3d09, p3d10 = p3d10    )
+      !
+   END SUBROUTINE wrk_alloc_3dr
+
+
+   SUBROUTINE wrk_alloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
+      &                      kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1,                        &
+         &               k3d01 = k3d01, k3d02 = k3d02, k3d03 = k3d03, k3d04 = k3d04, k3d05 = k3d05,   &
+         &               k3d06 = k3d06, k3d07 = k3d07, k3d08 = k3d08, k3d09 = k3d09, k3d10 = k3d10    )
+      !
+   END SUBROUTINE wrk_alloc_3di
+
+
+   SUBROUTINE wrk_alloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   &
+      &                      kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              &
+         &               p4d01 = p4d01, p4d02 = p4d02, p4d03 = p4d03, p4d04 = p4d04, p4d05 = p4d05,   &
+         &               p4d06 = p4d06, p4d07 = p4d07, p4d08 = p4d08, p4d09 = p4d09, p4d10 = p4d10    )
+      !
+   END SUBROUTINE wrk_alloc_4dr
+
+
+   SUBROUTINE wrk_alloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
+      &                      kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      CALL wrk_alloc_xd( kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart,              &
+         &               k4d01 = k4d01, k4d02 = k4d02, k4d03 = k4d03, k4d04 = k4d04, k4d05 = k4d05,   &
+         &               k4d06 = k4d06, k4d07 = k4d07, k4d08 = k4d08, k4d09 = k4d09, k4d10 = k4d10    )
+      !
+   END SUBROUTINE wrk_alloc_4di
+
+
+   SUBROUTINE wrk_dealloc_1dr( kidim, p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout)           ::   p1d01
+      REAL(wp), POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p1d02),PRESENT(p1d03),PRESENT(p1d04),PRESENT(p1d05),   &
+         &                 PRESENT(p1d06),PRESENT(p1d07),PRESENT(p1d08),PRESENT(p1d09),PRESENT(p1d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, 0, 0, 0, kistart, 1, 1, 1)   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_1dr
+
+
+   SUBROUTINE wrk_dealloc_1di( kidim, k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10, kistart )
+      INTEGER                        , INTENT(in   )           ::   kidim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout)           ::   k1d01
+      INTEGER , POINTER, DIMENSION(:), INTENT(inout), OPTIONAL ::   k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
+      INTEGER                        , INTENT(in   ), OPTIONAL ::   kistart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k1d02),PRESENT(k1d03),PRESENT(k1d04),PRESENT(k1d05),   &
+         &                 PRESENT(k1d06),PRESENT(k1d07),PRESENT(k1d08),PRESENT(k1d09),PRESENT(k1d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, 0, 0, 0, kistart, 1, 1, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_1di
+
+
+   SUBROUTINE wrk_dealloc_2dr( kidim, kjdim, p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10, kistart,kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout)           ::   p2d01
+      REAL(wp), POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p2d02),PRESENT(p2d03),PRESENT(p2d04),PRESENT(p2d05),   &
+         &                 PRESENT(p2d06),PRESENT(p2d07),PRESENT(p2d08),PRESENT(p2d09),PRESENT(p2d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_2dr
+
+
+   SUBROUTINE wrk_dealloc_2di( kidim, kjdim, k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10, kistart,kjstart )
+      INTEGER                          , INTENT(in   )           ::   kidim, kjdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout)           ::   k2d01
+      INTEGER , POINTER, DIMENSION(:,:), INTENT(inout), OPTIONAL ::   k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
+      INTEGER                          , INTENT(in   ), OPTIONAL ::   kistart, kjstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k2d02),PRESENT(k2d03),PRESENT(k2d04),PRESENT(k2d05),   &
+         &                 PRESENT(k2d06),PRESENT(k2d07),PRESENT(k2d08),PRESENT(k2d09),PRESENT(k2d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, 0, 0, kistart, kjstart, 1, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_2di
+
+
+   SUBROUTINE wrk_dealloc_3dr( kidim, kjdim, kkdim, p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
+      &                        kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   p3d01
+      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p3d02),PRESENT(p3d03),PRESENT(p3d04),PRESENT(p3d05),   &
+         &                 PRESENT(p3d06),PRESENT(p3d07),PRESENT(p3d08),PRESENT(p3d09),PRESENT(p3d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_3dr
+
+
+   SUBROUTINE wrk_dealloc_3di( kidim, kjdim, kkdim, k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
+      &                        kistart, kjstart, kkstart )
+      INTEGER                            , INTENT(in   )           ::   kidim, kjdim, kkdim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout)           ::   k3d01
+      INTEGER , POINTER, DIMENSION(:,:,:), INTENT(inout), OPTIONAL ::   k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
+      INTEGER                            , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k3d02),PRESENT(k3d03),PRESENT(k3d04),PRESENT(k3d05),   &
+         &                 PRESENT(k3d06),PRESENT(k3d07),PRESENT(k3d08),PRESENT(k3d09),PRESENT(k3d10) /) )
+      DO jn = 1, icnt   ;   CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, 0, kistart, kjstart, kkstart, 1 )   ;   END DO
+      !
+   END SUBROUTINE wrk_dealloc_3di
+
+
+   SUBROUTINE wrk_dealloc_4dr( kidim, kjdim, kkdim, kldim, p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10,   &
+      &                        kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   p4d01
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(p4d02),PRESENT(p4d03),PRESENT(p4d04),PRESENT(p4d05),   &
+         &                 PRESENT(p4d06),PRESENT(p4d07),PRESENT(p4d08),PRESENT(p4d09),PRESENT(p4d10) /) )
+      DO jn = 1, icnt ; CALL wrk_deallocbase( jpreal, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO
+      !
+   END SUBROUTINE wrk_dealloc_4dr
+
+
+   SUBROUTINE wrk_dealloc_4di( kidim, kjdim, kkdim, kldim, k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
+      &                        kistart, kjstart, kkstart, klstart )
+      INTEGER                              , INTENT(in   )           ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout)           ::   k4d01
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL ::   k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
+      INTEGER                              , INTENT(in   ), OPTIONAL ::   kistart, kjstart, kkstart, klstart
+      !
+      INTEGER :: icnt, jn
+      icnt = 1 + COUNT( (/                PRESENT(k4d02),PRESENT(k4d03),PRESENT(k4d04),PRESENT(k4d05),   &
+         &                 PRESENT(k4d06),PRESENT(k4d07),PRESENT(k4d08),PRESENT(k4d09),PRESENT(k4d10) /) )
+      DO jn = 1, icnt ; CALL wrk_deallocbase( jpinteger, kidim, kjdim, kkdim, kldim, kistart, kjstart, kkstart, klstart ) ; END DO
+      !
+   END SUBROUTINE wrk_dealloc_4di
+
+
+   SUBROUTINE wrk_alloc_xd( kidim, kjdim, kkdim, kldim,                                             &
+      &                     kisrt, kjsrt, kksrt, klsrt,                                             &
+      &                     k1d01, k1d02, k1d03, k1d04, k1d05, k1d06, k1d07, k1d08, k1d09, k1d10,   &
+      &                     k2d01, k2d02, k2d03, k2d04, k2d05, k2d06, k2d07, k2d08, k2d09, k2d10,   &
+      &                     k3d01, k3d02, k3d03, k3d04, k3d05, k3d06, k3d07, k3d08, k3d09, k3d10,   &
+      &                     k4d01, k4d02, k4d03, k4d04, k4d05, k4d06, k4d07, k4d08, k4d09, k4d10,   &
+      &                     p1d01, p1d02, p1d03, p1d04, p1d05, p1d06, p1d07, p1d08, p1d09, p1d10,   &
+      &                     p2d01, p2d02, p2d03, p2d04, p2d05, p2d06, p2d07, p2d08, p2d09, p2d10,   &
+      &                     p3d01, p3d02, p3d03, p3d04, p3d05, p3d06, p3d07, p3d08, p3d09, p3d10,   &
+      &                     p4d01, p4d02, p4d03, p4d04, p4d05, p4d06, p4d07, p4d08, p4d09, p4d10    )
+      INTEGER                              ,INTENT(in   )         ::   kidim, kjdim, kkdim, kldim   ! dimensions size
+      INTEGER                              ,INTENT(in   ),OPTIONAL::   kisrt, kjsrt, kksrt, klsrt
+      INTEGER , POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   k1d01,k1d02,k1d03,k1d04,k1d05,k1d06,k1d07,k1d08,k1d09,k1d10
+      INTEGER , POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   k2d01,k2d02,k2d03,k2d04,k2d05,k2d06,k2d07,k2d08,k2d09,k2d10
+      INTEGER , POINTER, DIMENSION(:,:,:  ),INTENT(inout),OPTIONAL::   k3d01,k3d02,k3d03,k3d04,k3d05,k3d06,k3d07,k3d08,k3d09,k3d10
+      INTEGER , POINTER, DIMENSION(:,:,:,:),INTENT(inout),OPTIONAL::   k4d01,k4d02,k4d03,k4d04,k4d05,k4d06,k4d07,k4d08,k4d09,k4d10
+      REAL(wp), POINTER, DIMENSION(:      ),INTENT(inout),OPTIONAL::   p1d01,p1d02,p1d03,p1d04,p1d05,p1d06,p1d07,p1d08,p1d09,p1d10
+      REAL(wp), POINTER, DIMENSION(:,:    ),INTENT(inout),OPTIONAL::   p2d01,p2d02,p2d03,p2d04,p2d05,p2d06,p2d07,p2d08,p2d09,p2d10
+      REAL(wp), POINTER, DIMENSION(:,:,:  ),INTENT(inout),OPTIONAL::   p3d01,p3d02,p3d03,p3d04,p3d05,p3d06,p3d07,p3d08,p3d09,p3d10
+      REAL(wp), POINTER, DIMENSION(:,:,:,:),INTENT(inout),OPTIONAL::   p4d01,p4d02,p4d03,p4d04,p4d05,p4d06,p4d07,p4d08,p4d09,p4d10
+      !
+      LOGICAL ::   llpres
+      INTEGER ::   jn, iisrt, ijsrt, iksrt, ilsrt
+      !
+      IF( .NOT. linit ) THEN
+         tree(:)%itype = jpnotdefined
+         DO jn = 1, jparray   ;   tree(jn)%ishape(:) = 0   ;   tree(jn)%istart(:) = 0   ;   END DO
+         linit = .TRUE.
+      ENDIF
+
+      IF( PRESENT(kisrt) ) THEN   ;   iisrt =  kisrt   ;   ELSE   ;   iisrt = 1   ;   ENDIF 
+      IF( PRESENT(kjsrt) ) THEN   ;   ijsrt =  kjsrt   ;   ELSE   ;   ijsrt = 1   ;   ENDIF 
+      IF( PRESENT(kksrt) ) THEN   ;   iksrt =  kksrt   ;   ELSE   ;   iksrt = 1   ;   ENDIF 
+      IF( PRESENT(klsrt) ) THEN   ;   ilsrt =  klsrt   ;   ELSE   ;   ilsrt = 1   ;   ENDIF 
+
+      llpres =  PRESENT(k1d01) .OR. PRESENT(k2d01) .OR. PRESENT(k3d01) .OR. PRESENT(k4d01)   &
+         & .OR. PRESENT(p1d01) .OR. PRESENT(p2d01) .OR. PRESENT(p3d01) .OR. PRESENT(p4d01)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d01, k2d01, k3d01, k4d01, p1d01, p2d01, p3d01, p4d01    )
+      llpres =  PRESENT(k1d02) .OR. PRESENT(k2d02) .OR. PRESENT(k3d02) .OR. PRESENT(k4d02)   &
+         & .OR. PRESENT(p1d02) .OR. PRESENT(p2d02) .OR. PRESENT(p3d02) .OR. PRESENT(p4d02)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d02, k2d02, k3d02, k4d02, p1d02, p2d02, p3d02, p4d02    )
+      llpres =  PRESENT(k1d03) .OR. PRESENT(k2d03) .OR. PRESENT(k3d03) .OR. PRESENT(k4d03)   &
+         & .OR. PRESENT(p1d03) .OR. PRESENT(p2d03) .OR. PRESENT(p3d03) .OR. PRESENT(p4d03)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d03, k2d03, k3d03, k4d03, p1d03, p2d03, p3d03, p4d03    )
+      llpres =  PRESENT(k1d04) .OR. PRESENT(k2d04) .OR. PRESENT(k3d04) .OR. PRESENT(k4d04)   &
+         & .OR. PRESENT(p1d04) .OR. PRESENT(p2d04) .OR. PRESENT(p3d04) .OR. PRESENT(p4d04)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d04, k2d04, k3d04, k4d04, p1d04, p2d04, p3d04, p4d04    )
+      llpres =  PRESENT(k1d05) .OR. PRESENT(k2d05) .OR. PRESENT(k3d05) .OR. PRESENT(k4d05)   &
+         & .OR. PRESENT(p1d05) .OR. PRESENT(p2d05) .OR. PRESENT(p3d05) .OR. PRESENT(p4d05)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d05, k2d05, k3d05, k4d05, p1d05, p2d05, p3d05, p4d05    )
+      llpres =  PRESENT(k1d06) .OR. PRESENT(k2d06) .OR. PRESENT(k3d06) .OR. PRESENT(k4d06)   &
+         & .OR. PRESENT(p1d06) .OR. PRESENT(p2d06) .OR. PRESENT(p3d06) .OR. PRESENT(p4d06)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d06, k2d06, k3d06, k4d06, p1d06, p2d06, p3d06, p4d06    )
+      llpres =  PRESENT(k1d07) .OR. PRESENT(k2d07) .OR. PRESENT(k3d07) .OR. PRESENT(k4d07)   &
+         & .OR. PRESENT(p1d07) .OR. PRESENT(p2d07) .OR. PRESENT(p3d07) .OR. PRESENT(p4d07)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d07, k2d07, k3d07, k4d07, p1d07, p2d07, p3d07, p4d07    )
+      llpres =  PRESENT(k1d08) .OR. PRESENT(k2d08) .OR. PRESENT(k3d08) .OR. PRESENT(k4d08)   &
+         & .OR. PRESENT(p1d08) .OR. PRESENT(p2d08) .OR. PRESENT(p3d08) .OR. PRESENT(p4d08)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d08, k2d08, k3d08, k4d08, p1d08, p2d08, p3d08, p4d08    )
+      llpres =  PRESENT(k1d09) .OR. PRESENT(k2d09) .OR. PRESENT(k3d09) .OR. PRESENT(k4d09)   &
+         & .OR. PRESENT(p1d09) .OR. PRESENT(p2d09) .OR. PRESENT(p3d09) .OR. PRESENT(p4d09)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d09, k2d09, k3d09, k4d09, p1d09, p2d09, p3d09, p4d09    )
+      llpres =  PRESENT(k1d10) .OR. PRESENT(k2d10) .OR. PRESENT(k3d10) .OR. PRESENT(k4d10)   &
+         & .OR. PRESENT(p1d10) .OR. PRESENT(p2d10) .OR. PRESENT(p3d10) .OR. PRESENT(p4d10)
+      IF( llpres ) CALL wrk_allocbase( kidim, kjdim, kkdim, kldim, iisrt, ijsrt, iksrt, ilsrt,   &
+         &                             k1d10, k2d10, k3d10, k4d10, p1d10, p2d10, p3d10, p4d10    )
+
+   END SUBROUTINE wrk_alloc_xd
+
+
+   SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt ,   &
+      &                      kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d    )
+      INTEGER                              , INTENT(in   )           :: kidim, kjdim, kkdim, kldim
+      INTEGER                              , INTENT(in   )           :: kisrt, kjsrt, kksrt, klsrt
+      INTEGER , POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: kwrk1d  
+      INTEGER , POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: kwrk2d  
+      INTEGER , POINTER, DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL :: kwrk3d  
+      INTEGER , POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: kwrk4d  
+      REAL(wp), POINTER, DIMENSION(:)      , INTENT(inout), OPTIONAL :: pwrk1d  
+      REAL(wp), POINTER, DIMENSION(:,:)    , INTENT(inout), OPTIONAL :: pwrk2d  
+      REAL(wp), POINTER, DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL :: pwrk3d  
+      REAL(wp), POINTER, DIMENSION(:,:,:,:), INTENT(inout), OPTIONAL :: pwrk4d  
+      !
+      INTEGER, DIMENSION(jpmaxdim) :: ishape, isrt, iend
+      INTEGER :: itype
+      INTEGER :: ii
+
+      ! define the shape to be given to the work array
+      ishape(:) = (/ kidim, kjdim, kkdim, kldim /)
+      ! define the starting index of the dimension shape to be given to the work array
+      isrt  (:) = (/ kisrt, kjsrt, kksrt, klsrt /)
+      iend  (:) = ishape(:) + isrt(:) - 1
+
+      ! is it integer or real array?
+      IF( PRESENT(kwrk1d) .OR. PRESENT(kwrk2d) .OR. PRESENT(kwrk3d) .OR. PRESENT(kwrk4d) )   itype = jpinteger   
+      IF( PRESENT(pwrk1d) .OR. PRESENT(pwrk2d) .OR. PRESENT(pwrk3d) .OR. PRESENT(pwrk4d) )   itype = jpreal         
+
+      ! find the branch with the matching shape, staring index and type or get the first "free" branch 
+      ii = 1                          
+      DO WHILE(       ( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= isrt ) .OR. tree(ii)%itype /= itype )   &
+         &      .AND. SUM( tree(ii)%ishape ) /= 0 )
+         ii = ii + 1
+         IF (ii > jparray) STOP   ! increase the value of jparray (should not be needed as already very big!)
+      END DO
+      
+      IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch 
+         IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype
+         tree(ii)%itype = itype                                        ! define the type of this branch 
+         tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch 
+         tree(ii)%istart(:) = isrt(:)                                  ! define the lower bounds of this branch 
+         ALLOCATE( tree(ii)%start )                                    ! allocate its start
+         ALLOCATE( tree(ii)%current)                                   ! allocate the current leaf (the first leaf)
+
+         tree(ii)%start%in_use = .FALSE.                               ! Never use the start as work array
+         tree(ii)%start%indic = 0
+         tree(ii)%start%prev => NULL()                                 ! nothing before the start
+         tree(ii)%start%next => tree(ii)%current                       ! first leaf link to the start
+         
+         tree(ii)%current%in_use = .FALSE.                             ! first leaf is not yet used
+         tree(ii)%current%indic = 1                                    ! first leaf
+         tree(ii)%current%prev => tree(ii)%start                       ! previous leaf is the start
+         tree(ii)%current%next => NULL()                               ! next leaf is not yet defined
+         ! allocate the array of the first leaf
+         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+                  
+      ELSE IF( .NOT. ASSOCIATED(tree(ii)%current%next) ) THEN   ! all leafs used -> define a new one
+         ALLOCATE( tree(ii)%current%next )                             ! allocate the new leaf
+         tree(ii)%current%next%in_use = .FALSE.                        ! this leaf is not yet used
+         tree(ii)%current%next%indic = tree(ii)%current%indic + 1      ! number of this leaf
+         IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic
+         tree(ii)%current%next%prev => tree(ii)%current                ! previous leaf of the new leaf is the current leaf
+         tree(ii)%current%next%next => NULL()                          ! next leaf is not yet defined
+
+         tree(ii)%current => tree(ii)%current%next                     ! the current leaf becomes the new one 
+ 
+         ! allocate the array of the new leaf
+         IF( PRESENT(kwrk1d) ) ALLOCATE( tree(ii)%current%iwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(kwrk2d) ) ALLOCATE( tree(ii)%current%iwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(kwrk3d) ) ALLOCATE( tree(ii)%current%iwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(kwrk4d) ) ALLOCATE( tree(ii)%current%iwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+         IF( PRESENT(pwrk1d) ) ALLOCATE( tree(ii)%current%zwrk1d(isrt(1):iend(1)                                                ) )
+         IF( PRESENT(pwrk2d) ) ALLOCATE( tree(ii)%current%zwrk2d(isrt(1):iend(1),isrt(2):iend(2)                                ) )
+         IF( PRESENT(pwrk3d) ) ALLOCATE( tree(ii)%current%zwrk3d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3)                ) )
+         IF( PRESENT(pwrk4d) ) ALLOCATE( tree(ii)%current%zwrk4d(isrt(1):iend(1),isrt(2):iend(2),isrt(3):iend(3),isrt(4):iend(4)) )
+         
+      ELSE 
+         tree(ii)%current => tree(ii)%current%next                     ! the current leaf becomes the next one 
+      ENDIF   
+      !       
+      ! use the array of the current leaf as a work array
+      IF( PRESENT(kwrk1d) ) kwrk1d => tree(ii)%current%iwrk1d   
+      IF( PRESENT(kwrk2d) ) kwrk2d => tree(ii)%current%iwrk2d   
+      IF( PRESENT(kwrk3d) ) kwrk3d => tree(ii)%current%iwrk3d   
+      IF( PRESENT(kwrk4d) ) kwrk4d => tree(ii)%current%iwrk4d   
+      IF( PRESENT(pwrk1d) ) pwrk1d => tree(ii)%current%zwrk1d   
+      IF( PRESENT(pwrk2d) ) pwrk2d => tree(ii)%current%zwrk2d   
+      IF( PRESENT(pwrk3d) ) pwrk3d => tree(ii)%current%zwrk3d   
+      IF( PRESENT(pwrk4d) ) pwrk4d => tree(ii)%current%zwrk4d   
+      tree(ii)%current%in_use = .TRUE.   ! this leaf is now used
+      !      
+   END SUBROUTINE wrk_allocbase
+
+
+   SUBROUTINE wrk_deallocbase( ktype, kidim, kjdim, kkdim, kldim, kisrt, kjsrt, kksrt, klsrt )
+      INTEGER, INTENT(in   )           :: ktype
+      INTEGER, INTENT(in   )           :: kidim, kjdim, kkdim, kldim
+      INTEGER, INTENT(in   ), OPTIONAL :: kisrt, kjsrt, kksrt, klsrt
+      !
+      INTEGER, DIMENSION(jpmaxdim) :: ishape, istart
+      INTEGER :: ii
+
+      ishape(:) = (/ kidim, kjdim, kkdim, kldim /)
+      IF( PRESENT(kisrt) ) THEN   ;   istart(1) =  kisrt   ;   ELSE   ;   istart(1) = 1   ;   ENDIF 
+      IF( PRESENT(kjsrt) ) THEN   ;   istart(2) =  kjsrt   ;   ELSE   ;   istart(2) = 1   ;   ENDIF 
+      IF( PRESENT(kksrt) ) THEN   ;   istart(3) =  kksrt   ;   ELSE   ;   istart(3) = 1   ;   ENDIF 
+      IF( PRESENT(klsrt) ) THEN   ;   istart(4) =  klsrt   ;   ELSE   ;   istart(4) = 1   ;   ENDIF 
+
+      ! find the branch with the matcing shape and type or get the first "free" branch 
+      ii = 1                          
+      DO WHILE( ANY( tree(ii)%ishape /= ishape ) .OR. ANY( tree(ii)%istart /= istart ) .OR. tree(ii)%itype /= ktype )
+         ii = ii + 1
+      END DO
+      !
+      tree(ii)%current%in_use = .FALSE.           ! current leaf is no more used
+      tree(ii)%current => tree(ii)%current%prev   ! move back toward previous leaf   
+      ! 
+   END SUBROUTINE wrk_deallocbase
+
+
+   SUBROUTINE wrk_stop(cmsg)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wrk_stop  ***
+      !! ** Purpose :   to act as local alternative to ctl_stop. 
+      !!                Avoids dependency on in_out_manager module.
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) :: cmsg
+      !!----------------------------------------------------------------------
+      !
+!      WRITE(kumout, cform_err2)
+      WRITE(*,*) TRIM(cmsg)
+      ! ARPDBG - would like to CALL mppstop here to force a stop but that
+      ! introduces a dependency on lib_mpp. Could CALL mpi_abort() directly
+      ! but that's fairly brutal. Better to rely on CALLing routine to
+      ! deal with the error passed back from the wrk_X routine?
+      !CALL mppstop
+      !
+   END SUBROUTINE wrk_stop
+
+   !!=====================================================================
+END MODULE wrk_nemo
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/namelist_R05
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/namelist_R05	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/namelist_R05	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/namelist_R2
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/namelist_R2	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/namelist_R2	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/types.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/types.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/GRIDGEN/src/types.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/README_uspcfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/README_uspcfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/README_uspcfg	(revision 8732)
@@ -0,0 +1,134 @@
+Instructions for using unsupported configurations on systems without wget access to
+the internet
+
+The unsupported configurations in NEMO are provided as a way for users to provide
+alternative configurations to the wider community without having to rely on system team
+sponsership and support. The idea is to provide minimal but sufficient information
+with the standard distribution to allow ancillary files to be fetched from remote
+servers at compile time. Thus a makenemo command such as:
+
+./makenemo -n MYISOMIP -u ISOMIP -m some_arch
+
+will create a new configuration called MYISOMIP with MY_SRC and EXP00 directories
+populated from a remote server. It does this by first using the wget command to fetch a
+list of remote files and then using wget repeatedly to fetch each of the files listed
+therein. The location of the remote list is contained in one line of information held
+in the uspcfg.txt file (in CONFIG).
+
+These instructions provide a work-around for systems without direct access to the
+internet or on which wget has been disabled/not installed. On these systems it is
+possible to create local copies of the remote files and replace the wget function
+with a local copy command. It will be the user's responsibility to ensure that the
+local copies reflect any changes made in the remote sources.
+
+The procedure requires the following steps:
+
+1. From the target NEMOGCM directory on your target system copy the following
+   files into a working directory on a system that does have internet access
+   and a working wget command:
+
+      a. TOOLS/MISCELLANEOUS/make_usp_tar.sh
+      b. CONFIG/uspcfg.txt
+
+2. On that alternative system and in the working directory containing the newly
+   copied files, run the make_usp_tar.sh script. The script takes three arguments:
+
+      a. The name of the uspcfg.txt file
+      b. The name of the unsupported configuration you wish to use
+      c. The name of a directory that will be created and filled with the remote
+         files in the current working directory. This directory will be tarred and
+         eventually transferred to the target system. There it will be unpacked and
+         will form the local archive for this configuration. A meaningful name is
+         therefore recommended.
+
+   For example:
+
+   ./make_usp_tar.sh uspcfg.txt ISOMIP ISOMIP_ARCHIVE
+
+3. Copy the resulting tarball (in this case: ISOMIP_ARCHIVE.tar) to the target 
+   system and unpack (tar xvf ISOMIP_ARCHIVE.tar) in a location that is visible to 
+   the node on which you intend to compile nemo. The unpacked directory will contain
+   the files retrieved from the remote server, modified versions of the file list and
+   uspcfg.txt files and two new scripts. For example:
+
+   ls -1R ISOMIP_ARCHIVE
+   cpp_ISOMIP.fcm             - downloaded from remote server
+   def_wget                   - newly constructed script
+   local_template.ctl         - file list modified for local copy
+   uspcfg_local_template.txt  - a copy of uspcfg.txt with modification for local copy
+   remote_file.list           - downloaded from remote server
+   set_local_uspcfg           - newly constructed script
+   EXP00                      - new subdirectory
+   MY_SRC                     - new subdirectory
+
+   ./EXP00:
+   iodef.xml                  - downloaded from remote server
+   namelist_cfg               - downloaded from remote server
+
+   ./MY_SRC:
+   domzgr.F90                 - downloaded from remote server
+   istate.F90                 - downloaded from remote server
+
+4. The final stage is to enter the directory and execute the set_local_uspcfg script.
+   This script will prompt for a full path to the target CONFIG directory and then:
+
+   a. Edit the templates and create local.ctl and uspcfg_local.txt files by inserting 
+      the full path to the archive directory (i.e. the current working directory)
+   b. move uspcfg_local.txt to the named CONFIG directory
+   c. rename any existing uspcfg.txt file in the CONFIG directory to uspcfg_remote.txt
+   d. insert symbolic link (uspcfg.txt) to uspcfg_local.txt in the CONFIG directory
+   e. redefine/define wget as an exported bash function to simply copy
+
+   This last action is needed so that subsequent use of makenemo with the -u argument
+   will not invoke wget. For this to be effective the set_local_usp script should be run
+   within the same bash shell as makenemo will be run in. I.e.:
+
+   . ./set_local_usp
+
+   If this is not possible or the makenemo command is run at a later date, then the
+   def_wget script should be run in the bash shell before any attempt to use the -u
+   option of makenemo. I.e.:
+
+   . ./def_wget
+
+   [ Tip: check that the definition/re-definition of wget has worked correctly by
+     issuing this command:
+
+     wget a b c
+
+     If you get messages such as:
+
+       wget a b c
+       --2016-10-27 10:14:52--  http://a/
+       Resolving a... failed: Name or service not known.
+       wget: unable to resolve host address `a'
+       .
+       .
+
+     then the re-definition of wget has not been retained by the current shell. Run
+     . ./def_wget and try again. You should get a response such as:
+
+     wget a b c
+     Expected wget usage: wget src -O dest
+     -O not found. No action taken
+
+     if the environment is set correctly
+   ]
+
+5. The setup is now complete and moving to the CONFIG directory and issuing a command
+   such as:
+
+    ./makenemo -n MYISOMIP -u ISOMIP -m target_arch
+
+   should correctly configure from local archives only.   
+
+   [ Tip: the -u argument ( and hence the need to switch wget to local copies on isolated
+     systems ) is only required when compiling for the first time. Subsequent compilations
+     following code changes in the MYISOMIP directories can be carried out in your
+     default nemo environment. I.e.:
+
+     ./makenemo -n MYISOMIP -m target_arch
+
+     will not require any of the preceeding steps in future sessions.
+   ]
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh	(revision 8732)
@@ -0,0 +1,31 @@
+#!/bin/bash
+#
+# check the propper syntax of C preprocessor directives.
+# for example:
+#if defined key_traldf_c3d && key_traldf_smag
+# is not good and should be
+#if defined key_traldf_c3d && defined key_traldf_smag
+#
+# use: go to TOOLS/MISCELLANEOUS/ and simply execute:
+#  ./chk_ifdef.sh 
+#
+set -u
+#
+grep -r "^ *#if" ../../NEMO | grep -v "~:" > tmp$$      # get each lines of the code starting with #if
+grep -r "^ *#elif" ../../NEMO | grep -v "~:" >> tmp$$   # get each lines of the code starting with #elif
+#
+for ll in $( seq 1 $( cat tmp$$ | wc -l  ) )            # for each of these lines
+do
+    lll=$( sed -n -e "${ll}p" tmp$$ )
+    nbdef=$( echo $lll | grep -o defined  | wc -l )         # number of occurences of "defined"
+    nband=$( echo $lll | grep -o   "&&"   | wc -l )         # number of occurences of "&&"
+    nbor=$(  echo $lll | grep -o   "||"   | wc -l )         # number of occurences of "||"
+    [ $nbdef -ne $(( $nband + $nbor + 1 )) ] && echo $lll   # print bad line
+done
+rm -f tmp$$ 
+
+#
+# add other basic tests
+#
+grep -ir  ":,:.*ji,jj" * | grep -v "~:"
+grep -ir  "ji,jj.*:,:" *  | grep -v "~:"
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh	(revision 8732)
@@ -0,0 +1,146 @@
+#!/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
+#
+#------------------------------------------------
+#
+external=$( grep -c "<field_definition  *\([^ ].* \)*src=" $xmlfile )
+if [ $external -eq 1 ]
+then
+    xmlfield_def=$( grep "<field_definition  *\([^ ].* \)*src=" $xmlfile | sed -e 's/.*src="\([^"]*\)".*/\1/' )
+    xmlfield_def=$( dirname $xmlfile )/$xmlfield_def   
+else
+    xmlfield_def=$xmlfile
+fi
+[ $inxml -eq 1 ] && grep "< *field  *\([^ ].* \)*id *=" $xmlfield_def
+[ $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"
+#
+badvarsrc=$( find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | grep -ic iom_put )
+if [ $badvarsrc -ne 0 ]
+then
+    echo "The following call to iom_put cannot be checked"
+    echo
+    find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | grep -i iom_put | sort -d 
+    echo
+fi
+varlistsrc=$( find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | grep -vi iom_put | sort -d )
+#
+# list of variables defined in the xml file
+#
+varlistxml=$( grep "< *field  *\([^ ].* \)*id *=" $xmlfield_def  | sed -e "s/^.*< *field .*id *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+# list of variables to be outputed in the xml file
+#
+varlistout=$( grep "< *field  *\([^ ].* \)*field_ref *=" $xmlfile  | sed -e "s/^.*< *field .*field_ref *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+echo "--------------------------------------------------"
+echo  check if all iom_put found in $srcdir
+echo  have a corresponding variable definition in $xmlfield_def
+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 $xmlfield_def, 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 8732)
@@ -0,0 +1,78 @@
+#!/bin/bash
+#
+# purpose:
+#   small script to check in all *90 files of the current directory and subdirectories 
+#   if all lines with wrk_alloc have their corresponding lines with wrk_dealloc
+#
+# use:
+#   call chk_wrk_alloc.sh from the directory you want to check
+#
+# example:
+#   cd ~/dev_NEMO_MERGE_2011/NEMOGCM/NEMO
+#   ../TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
+#
+set -u
+#
+echo "check for all *90 files contained in "$( pwd )" and its subdirectories"
+#
+for ff in $( grep -il "^ *use  *wrk_nemo" $( find . -name "*90" )  $( find . -name "*h90" ) )
+do
+    ierr=0
+    
+    # number of lines with wrk_alloc
+    n1=$( grep -ic "call *wrk_alloc *(" $ff )
+    # number of lines with wrk_dealloc
+    nn1=$( grep -ic "call *wrk_dealloc *(" $ff )  
+    
+    if [ $(( $n1 + $nn1 )) -ne 0 ]
+    then
+	# replace wrk_alloc with wrk_dealloc and count the lines
+	n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
+	# we should get n2 = 2 * n1...
+	if [ $(( 2 * $n1 )) -ne $n2 ]
+	then
+	    ierr=1
+	    echo "problem with wrk_alloc in $ff" 
+	fi
+	# same story but for wrk_dealloc
+	nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
+	if [ $(( 2 * $nn1 )) -ne $nn2 ]
+	then
+	    ierr=1
+	    echo "problem with wrk_dealloc in $ff" 
+	fi
+
+	if [ $ierr -eq 0 ] # check that wrk_alloc block is the same as wrk_dealloc block
+	then
+	    grep -i "call *wrk_alloc *("   $ff | sed -e "s/ //g" | sed -e "s/!.*//g" > txt1$$
+	    grep -i "call *wrk_dealloc *(" $ff | sed -e "s/wrk_dealloc/wrk_alloc/"  | sed -e "s/ //g" | sed -e "s/!.*//g" > txt2$$
+	    cmp txt1$$ txt2$$
+	    if [ $? -ne 0 ]
+	    then
+		echo "different syntax in wrk_alloc and wrk_dealloc in $ff"
+		echo
+		for ll in $( seq 1 $n1 )  # compare each line
+		do
+		    sed -n ${ll}p txt1$$ > ll1$$
+		    sed -n ${ll}p txt2$$ > ll2$$
+		    cmp ll1$$ ll2$$ > /dev/null
+		    if [ $? -ne 0 ]
+		    then
+			grep -i "call *wrk_alloc *("   $ff | sed -n ${ll}p
+			grep -i "call *wrk_dealloc *(" $ff | sed -n ${ll}p
+			echo
+		    fi
+		    rm -f ll1$$ ll2$$
+		done
+	    fi
+	    rm -f txt1$$ txt2$$
+	else
+	    grep -i "call *wrk_alloc *(" $ff
+	    echo
+	    grep -i "call *wrk_dealloc *(" $ff	
+	    echo
+	fi
+	
+    fi
+    
+done
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/icb_pp.py	(revision 8732)
@@ -0,0 +1,159 @@
+from netCDF4 import Dataset
+from argparse import ArgumentParser
+import numpy as np
+import sys
+
+#
+# Basic iceberg trajectory post-processing python script.
+# This script collates iceberg trajectories from the distributed datasets written
+# out by each processing region and rearranges the ragged arrays into contiguous
+# streams for each unique iceberg. The output arrays are 2D (ntraj, ntimes) arrays.
+# Note that some icebergs may only exist for a subset of the possible times. In these
+# cases the missing instances are filled with invalid (NaN) values.
+#
+
+parser = ArgumentParser(description='produce collated trajectory file from distributed output\
+                                     files, e.g. \n python ./icb_pp.py \
+                                     -t  trajectory_icebergs_004248_ -n 296 -o trajsout.nc' )
+
+parser.add_argument('-t',dest='froot',help='fileroot_of_distrbuted_data; root name of \
+                     distributed trajectory output (usually completed with XXXX.nc, where \
+                     XXXX is the 4 digit processor number)', 
+                     default='trajectory_icebergs_004248_')
+
+parser.add_argument('-n',dest='fnum',help='number of distributed files to process', 
+                     type=int, default=None)
+
+parser.add_argument('-o',dest='fout',help='collated_output_file; file name to receive the \
+                     collated trajectory data', default='trajsout.nc')
+
+args = parser.parse_args()
+
+default_used = 0
+if args.froot is None:
+    pathstart = 'trajectory_icebergs_004248_'
+    default_used = 1
+else:
+    pathstart = args.froot
+
+if args.fnum is None:
+    procnum = 0
+    default_used = 1
+else:
+    procnum = args.fnum
+
+if args.fout is None:
+    pathout = 'trajsout.nc'
+    default_used = 1
+else:
+    pathout = args.fout
+
+if default_used == 1:
+   print('At least one default value will be used; command executing is:')
+   print('icb_pp.py -t ',pathstart,' -n ',procnum,' -o ',pathout)
+
+if procnum < 1:
+   print('Need some files to collate! procnum = ',procnum)
+   sys.exit(11)
+
+icu = []
+times = []
+#
+# Loop through all distributed datasets to obtain the complete list
+# of iceberg identification numbers and timesteps
+#
+for n in range(procnum):
+ nn = '%4.4d' % n
+ fw = Dataset(pathstart+nn+'.nc')
+ if len(fw.dimensions['n']) > 0:
+   print pathstart+nn+'.nc'
+   ic = fw.variables['iceberg_number'][:,0]
+   ts = fw.variables['timestep'][:]
+   icv = np.unique(ic)
+   ts = np.unique(ts)
+   print('Min Max ts: ',ts.min(), ts.max())
+   print('Number unique icebergs= ',icv.shape[0])
+   icu.append(icv)
+   times.append(ts)
+ fw.close()
+#
+# Now flatten the lists and reduce to the unique spanning set
+#
+icu = np.concatenate(icu)
+icu = np.unique(icu)
+times = np.concatenate(times)
+times = np.unique(times)
+ntraj = icu.shape[0]
+print(ntraj, ' unique icebergs found across all datasets')
+print('Icebergs ids range from: ',icu.min(), 'to: ',icu.max())
+print('times range from:        ',times.min(), 'to: ', times.max())
+#
+# Declare 2-D arrays to receive the data from all files
+#
+nt = times.shape[0]
+lons = np.zeros((ntraj, nt))
+lats = np.zeros((ntraj, nt))
+tims = np.zeros((ntraj, nt))
+xis  = np.zeros((ntraj, nt))
+yjs  = np.zeros((ntraj, nt))
+#
+# initially fill with invalid data
+#
+lons.fill(np.nan)
+lats.fill(np.nan)
+xis.fill(np.nan)
+yjs.fill(np.nan)
+tims.fill(np.nan)
+#
+# loop through distributed datasets again, this time
+# checking indices against icu and times lists and
+# inserting data into the correct locations in the 
+# 2-D collated sets.
+#
+for n in range(procnum):
+ nn = '%4.4d' % n
+ fw = Dataset(pathstart+nn+'.nc')
+# Note many distributed datafiles will contain no iceberg data
+# so skip quickly over these
+ m  = len(fw.dimensions['n'])
+ if m > 0:
+   inx = np.zeros(m, dtype=int)
+   tsx = np.zeros(m, dtype=int)
+   print pathstart+nn+'.nc'
+   ic = fw.variables['iceberg_number'][:,0]
+   ts = fw.variables['timestep'][:]
+   lns = fw.variables['lon'][:]
+   lts = fw.variables['lat'][:]
+   xxs = fw.variables['xi'][:]
+   yys = fw.variables['yj'][:]
+   for k in range(m):
+     inxx   = np.where(icu == ic[k])
+     inx[k] = inxx[0]
+   for k in range(m):
+     inxx   = np.where(times == ts[k])
+     tsx[k] = inxx[0]
+   lons[inx[:],tsx[:]] = lns[:]
+   lats[inx[:],tsx[:]] = lts[:]
+   tims[inx[:],tsx[:]] = ts[:]
+   xis[inx[:],tsx[:]] = xxs[:]
+   yjs[inx[:],tsx[:]] = yys[:]
+ fw.close()
+
+# Finally create the output file and write out the collated sets
+#
+fo = Dataset(pathout, 'w', format='NETCDF4')
+ntrj = fo.createDimension('ntraj', ntraj)
+nti  = fo.createDimension('ntime', None)
+olon = fo.createVariable('lon', 'f4',('ntraj','ntime'))
+olat = fo.createVariable('lat', 'f4',('ntraj','ntime'))
+otim = fo.createVariable('ttim', 'f4',('ntraj','ntime'))
+oxis = fo.createVariable('xis', 'f4',('ntraj','ntime'))
+oyjs = fo.createVariable('yjs', 'f4',('ntraj','ntime'))
+icbn = fo.createVariable('icbn', 'f4',('ntraj'))
+olon[:,:] = lons
+olat[:,:] = lats
+otim[:,:] = tims
+oxis[:,:] = xis
+oyjs[:,:] = yjs
+icbn[:] = icu
+fo.close()
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/make_usp_tar.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/make_usp_tar.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/make_usp_tar.sh	(revision 8732)
@@ -0,0 +1,235 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+# ===============
+# make_usp_tar.sh
+# ===============
+# ---------------
+# Fetch and tar a unsupported configuration setup.
+# This script is only needed when target systems do
+# not have wget access to the internet. To configure
+# unsupported conigurations on these systems it will
+# first be necessary to run this script on a system that
+# does have access. Then copy access the resulting tar file,
+# unpack and run the enclosed set_local_uspcfg script in a 
+# bash shell to complete the process. That script redefines/
+# defines wget as a bash function to perform local copies 
+# from this unpacked tarball. If you wish to create a new 
+# configuration based on this local copy of an unsupported 
+# configuration in future sessions then you may need to 
+# redefine wget again before running makenemo with the 
+# appropriate -u setting. A simple script: def_wget is included
+# for such situations.
+# ---------------
+# SYNOPSIS
+# ========
+#  $ make_usp_tar.sh uspcfg.txt target_conf target_dir
+# Note target_dir.tar will be created
+#
+# DESCRIPTION
+# ===========
+# - Extract target configuration details from uspcfg.txt
+# - Create target directory
+# - Recursively use wget to retrieve remote configuration files
+#   into target directory
+# - Copy uspcfg.txt into target directory and alter remote paths
+#   to local (relative) versions
+# - tar target_directory and remove originals
+#----------------------------------------------------------------
+#
+#----------------------------------------------------------------
+# Check the correct number of arguments have been provided
+#----------------------------------------------------------------
+#
+   if [ "$#" != "3" ]; then
+    echo "Expected usage: make_usp_tar.sh uspcfg.txt target_conf target_dir"
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Check the named uspcfg.txt file exists
+#----------------------------------------------------------------
+#
+   if [ ! -f $1 ]; then
+    echo "named uspcfg.txt file does not exist ($1); attempt abandoned"
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Check the requested configuration is listed in the named uspcfg.txt file
+#----------------------------------------------------------------
+#
+   inthere=$( grep -c "$2" $1 )
+   if [ "$inthere" -lt 1 ]; then
+    echo "requested configuration is not in named uspcfg.txt file ($2); attempt abandoned"
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Create the target directory if it does not already exist
+# and cd into it
+#----------------------------------------------------------------
+#
+   if [ ! -d $3 ]; then
+    mkdir $3
+   else
+    echo "target directory already exists; attempt abandoned"
+    exit
+   fi
+   basedir=$(pwd)
+#
+   cd ${3}
+#
+#----------------------------------------------------------------
+# Copy named uspcfg.txt file into target directory
+#----------------------------------------------------------------
+#
+   cp $basedir/$1 .
+#
+#----------------------------------------------------------------
+# Extract information on target configuration and
+# retrieve full file list from remote server
+#----------------------------------------------------------------
+#
+   grep "$2 " $1 > ./cfg.tmp
+#
+   LOCAL_REF=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $2}')
+   TAB=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $3}')
+   REMOTE_CTL=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $4}')
+   wget ${REMOTE_CTL} -O remote_file.list
+#
+#----------------------------------------------------------------
+# Retrieve each remote file and create local directory structure
+# At the same time prepare a local version of the control file
+# by replacing http links with a string that will be replaced later
+# with a local directory path
+#----------------------------------------------------------------
+#
+   if [ -f remote_file.list ] ; then
+    cat remote_file.list | grep -v '^#' |
+     while
+      read remfile locfile
+      do
+       if [ $remfile == 'create_directory' ] ;then
+         mkdir $locfile
+         echo $remfile "                 " $locfile >> local_template.ctl
+       else
+         wget $remfile -O $locfile
+         remfile=$(echo $remfile | sed -e "s;.*$locfile;SET_LOCAL_DIRECTORY_HERE/$locfile;")
+         echo $remfile "  " $locfile >> local_template.ctl
+       fi
+      done
+   else
+    echo "Unable to find remote_file.list. Attempt abandoned"
+    echo "Files may be left in "$(pwd)
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Construct a modified version of the named uspcfg.txt file
+# First copy across all the other untouched configuration listed
+#----------------------------------------------------------------
+#
+   grep -v "$2 " $1 >  uspcfg_local_template.txt
+#
+#----------------------------------------------------------------
+# Now append the modified entry, replacing http links as before
+#----------------------------------------------------------------
+#
+   cat cfg.tmp | sed -e "s;http.*$;SET_LOCAL_DIRECTORY_HERE/local.ctl;" >> uspcfg_local_template.txt
+#
+#
+#----------------------------------------------------------------
+# Construct a script that can be used later to complete a local installation
+#----------------------------------------------------------------
+#
+cat > set_local_uspcfg << EOF
+#!/bin/bash
+   if [ "\$( echo $SHELL | grep -c bash )" -lt 1 ]; then
+    echo "WARNING: This is only going to be effective in a bash shell"
+    echo "since it redefines the wget command as a bash function."
+    echo "(ignore this comment if you are in a bash shell)"
+   fi
+   basedir=\$(pwd)
+#
+   echo "Enter full path to the CONFIG directory on your target system: "
+   read confdir
+#
+# Edit the local.ctl file to set the local directory path
+#
+   sed -e "s;SET_LOCAL_DIRECTORY_HERE;\$basedir;" local_template.ctl > local.ctl
+#
+# Edit the uspcfg_local.txt file to set the local directory path
+#
+   sed -e "s;SET_LOCAL_DIRECTORY_HERE;\$basedir;" uspcfg_local_template.txt > uspcfg_local.txt
+#
+# Install local versions in the named CONFIG directory
+#
+   if [ -f \$confdir/uspcfg.txt ] && [ ! -L \$confdir/uspcfg.txt ]; then
+    mv \$confdir/uspcfg.txt \$confdir/uspcfg_remote.txt
+    echo "\$confdir/uspcfg.txt moved to \$confdir/uspcfg_remote.txt"
+   fi
+   if [ -f \$confdir/uspcfg_local.txt ]; then
+    echo "Existing uspcfg_local.txt file found in \$confdir"
+    echo "This has been moved to: "\$confdir/uspcfg_local.txt\$\$
+    mv \$confdir/uspcfg_local.txt \$confdir/uspcfg_local.txt\$\$
+   fi
+   mv uspcfg_local.txt \$confdir/uspcfg_local.txt
+   ln -s \$confdir/uspcfg_local.txt \$confdir/uspcfg.txt
+#
+# define/redefine the wget command
+#
+function wget {
+   if [ "\$2" != "-O" ]; then
+    echo "Expected wget usage: wget src -O dest"
+    echo "-O not found. No action taken"
+   else
+    cp \$1 \$3
+   fi
+}
+export -f wget
+EOF
+#----------------------------------------------------------------
+# Construct a script that can be used later to just redefine wget 
+# in bash shell sessions
+#----------------------------------------------------------------
+#
+cat > def_wget << EOFC
+#!/bin/bash
+   if [ "\$( echo $SHELL | grep -c bash )" -lt 1 ]; then
+    echo "WARNING: This is only going to be effective in a bash shell"
+    echo "since it redefines the wget command as a bash function."
+    echo "(ignore this comment if you are in a bash shell)"
+   fi
+function wget {
+   if [ "\$2" != "-O" ]; then
+    echo "Expected wget usage: wget src -O dest"
+    echo "-O not found. No action taken"
+   else
+    cp \$1 \$3
+   fi
+}
+export -f wget
+EOFC
+#----------------------------------------------------------------
+# Make sure these scripts have execute permission
+#----------------------------------------------------------------
+   chmod 755 set_local_uspcfg
+   chmod 755 def_wget
+#
+#----------------------------------------------------------------
+# Tidy up and tar the contents of the downloaded configuration
+#----------------------------------------------------------------
+   rm cfg.tmp
+   cd $basedir
+   tar cvf ${3}.tar $3
+   echo ${3}.tar " file successfully created and prepared for local references. Move this"
+   echo "tar file to your target system, unpack and run the set_local_uspcfg script in a "
+   echo "bash shell to complete the process. This script redefines/defines wget as a bash"
+   echo "function to perform local copies from this unpacked tarball. If you wish to create"
+   echo "a new configuration based on this local copy of an unsupported configuration in "
+   echo "future sessions then you may need to rerun the def_wget script"
+exit
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 8732)
@@ -0,0 +1,207 @@
+#!/bin/bash
+#
+# rsync -av NEMO/ NEMO_no_wrkarrays/
+# cd NEMO_no_wrkarrays/
+# ../TOOLS/MISCELLANEOUS/rewrite_nemo.sh
+# cd ../CONFIG
+# ./makenemo -n ORCA2_LIM3 -s NEMO_no_wrkarrays
+#
+set -u
+#set -xv
+#
+# for on each file containing a call to work alloc
+for i in $( grep -iRl "^[^\!]*call *wrk_alloc *(" * | grep "90$" )
+do
+# create a temporary file that will be easier to process...
+    sed -e "s/dimension/DIMENSION/" -e "s/pointer/POINTER/" $i > tmp$$
+# replace "dimension(...), pointer" to "pointer, dimension(...)"
+    sed -e "s/, *DIMENSION *(\([^)]*\)) *, *POINTER/, POINTER, DIMENSION(\1)/" tmp$$ > tmp2$$
+    mv tmp2$$ tmp$$ 
+# remove all comments in $i
+    sed -e "s/\!.*//" tmp$$ > tmp2$$
+    mv tmp2$$ tmp$$
+# numbers of the lines defining the beginning and the end of each subroutine or functions
+    n1=$( egrep -ic "(^ *subroutine *[0-9a-zA-Z_]|function *[0-9a-zA-Z_][0-9a-zA-Z_]* *\(.*\))" tmp$$ )
+    n2=$( egrep -ic "(^ *end *subroutine|^ *end *function)" tmp$$ )
+    if [ $n1 -ne $n2 ]
+    then
+	echo "error with the definition of subroutine/function blocks in $i" 
+	exit
+    fi
+    linesbegin=$( egrep -in "(^ *subroutine *[0-9a-zA-Z_]|function *[0-9a-zA-Z_][0-9a-zA-Z_]* *\(.*\))" tmp$$ | sed -e "s/:.*//" )
+    linesend=$( egrep -in "(^ *end *subroutine|^ *end *function)" tmp$$ | sed -e "s/:.*//" | sort -rn )
+#
+# number of the lines containing wrk_alloc
+    cnt=$( grep -ci "^[^\!]*call *wrk_alloc *(" tmp$$ )
+# for each of these lines
+    ll=1
+    while [ $ll -le $cnt ]
+    do
+# get the line with its number
+	line=$( grep -in "^[^\!]*call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" )
+# get its number
+	lline=$( echo $line | sed -e "s/:.*//" )
+# keep only the arument of wrk_alloc between ()
+	line=$( echo $line | sed -e "s/^.*[cC][aA][lL][lL] *[wW][rR][kK]_[aA][lL][lL][oO][cC]//" | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )
+# find in which subroutine or function is located this call to wrk_alloc: l1 beginning l2: end
+	for lll in $linesbegin
+	do
+	    [ $lline -gt $lll ] && l1=$lll
+	done
+	for lll in $linesend
+	do
+	    [ $lline -lt $lll ] && l2=$lll
+	done
+	if [ $l2 -le $l1 ]
+	then
+	    echo "error in $i in the indentification subroutine/function block containing line $lline"
+	    exit
+	fi
+# get the last argument of the call to wrk_alloc (between the last "," and ")"
+	lw=$( echo $line | sed -e "s/.*,\(.*\)).*/\1/" | sed -e "s/ *//g" )
+# get the line containing the definition of this argument and from it get the number of dimension of the argument
+	tst=$( sed -n ${l1},${l2}p tmp$$  | grep -i "POINTER *, *DIMENSION *(.*) *::.*"${lw} | egrep -ic "[^0-9a-zA-Z_]("${lw}" *$|"${lw}" *,)" )
+	if [ $tst -ne 1 ]
+	then
+	    echo "error with ${lw} definition in $i" 
+	    exit
+	fi
+	dimsz=$( sed -n ${l1},${l2}p tmp$$  | grep -i "POINTER *, *DIMENSION *(.*) *::.*"${lw} | egrep -i "[^0-9a-zA-Z_]("${lw}" *$|"${lw}" *,)" | sed -e "s/.*POINTER *, *DIMENSION *(\(.*\)) *::.*/\1/" | sed -e "s/ //g" | wc -c )
+	dimsz=$(( $dimsz / 2 ))
+# get the number of variables concerned by the call to wrk_alloc (keep anly the , and count them)
+	nvar=$( echo $line | sed -e "s/[^,]//g" | wc -c )
+	nvar=$(( $nvar - $dimsz ))
+# get the définition of the size of the dimensions from the call to wrk_alloc 
+	case $dimsz in
+	    1) dim=$( echo $line | sed -e "s/( *\([^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 1st ,
+	    2) dim=$( echo $line | sed -e "s/( *\([^,]*,[^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 2nd ,
+	    3) dim=$( echo $line | sed -e "s/( *\([^,]*,[^,]*,[^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 3rd ,
+	    4) dim=$( echo $line | sed -e "s/( *\([^,]*,[^,]*,[^,]*,[^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 4th ,
+	    *) echo "error with the number of dimensions of $lw in $i"; exit ;;
+	esac
+# for each variable, change its definition...
+	nn=1 
+	var=$lw # start from the last argument
+	while [ $nn -le $nvar ]
+	do
+# get the line where this variable is defined.	
+	    tst=$( sed -n ${l1},${l2}p tmp$$  | grep -ni "POINTER *, *DIMENSION *(.*) *::.*"${var} | egrep -ic "[^0-9a-zA-Z_]("${var}" *$|"${var}" *,)" )
+	    if [ $tst -ne 1 ]
+	    then
+		echo "error with ${lw} definition in $i" 
+		exit
+	    fi
+# get the line number where the variable is defined
+	    lvar=$( sed -n ${l1},${l2}p tmp$$  | grep -ni "POINTER *, *DIMENSION *(.*) *::.*"${var} | egrep -i "[^0-9a-zA-Z_]("${var}" *$|"${var}" *,)" | sed -e "s/:.*//" )
+	    lvar=$(( $lvar + $l1 - 1 ))
+# get the dimension definition and compare it to ${dim}
+	    dim2=$( sed -n -e "${lvar}p" $i | sed -e "s/dimension/DIMENSION/" -e "s/\!.*//" | sed -e "s/.*, *DIMENSION *(\(.*\)).*/\1/" | sed -e "s/ //g" )
+	    if [ $( echo $dim2 | wc -c ) -ne $(( $dimsz * 2 )) ] 
+	    then 
+		if [ "$dim2" != "$dim" ] 
+		then 
+		    echo "problem in $i in the defininition of variable $var: its size is $dim but we have $dim2"
+		    sed -n -e "${lvar}p" $i
+		    exit
+		fi
+	    fi
+# remove pointer
+	    sed -e "${lvar}s/pointer/POINTER/" $i | sed -e "${lvar}s/, *POINTER *,/,/" | sed -e "${lvar}s/, *POINTER */ /" > tmp2$$
+	    mv tmp2$$ $i
+# redefine the dimensions 
+	    case $dimsz in
+		1) sed -e "${lvar}s/\(DIMENSION *(\) *: *)/\1${dim})/" $i > tmp2$$ ;;
+		2) sed -e "${lvar}s/\(DIMENSION *(\) *: *, *: *)/\1${dim})/" $i > tmp2$$ ;;
+		3) sed -e "${lvar}s/\(DIMENSION *(\) *: *, *: *, *: *)/\1${dim})/" $i > tmp2$$ ;;
+		4) sed -e "${lvar}s/\(DIMENSION *(\) *: *, *: *, *: *, *: *)/\1${dim})/" $i > tmp2$$ ;;
+	    esac
+	    mv tmp2$$ $i
+	    
+# define the next variable (previous argument)
+	    var=$( echo $line | sed -e "s/.*,\(.*\), *[^0-9a-zA-Z_]*${var}[^0-9a-zA-Z_]*[,)].*/\1/" | sed -e "s/ *//g" )
+	    nn=$(( $nn + 1 ))
+	done
+	
+	ll=$(( $ll + 1 ))
+    done
+#delete wrk_alloc line
+    sed -e "/call *wrk_alloc *(/d" -e "/CALL *wrk_alloc *(/d" \
+	-e "/call *wrk_dealloc *(/d" -e "/CALL *wrk_dealloc *(/d" \
+	-e "/USE wrk_nemo/d"  -e "/use wrk_nemo/d" $i > tmp$$
+    mv tmp$$ $i
+    
+    echo $i done
+done
+#
+# some specific changes...
+#
+# OPA_SRC/SBC/albedo.F90
+sed -e "s/DIMENSION(jpi,jpj,ijpl/DIMENSION(jpi,jpj,SIZE(pt_ice,3)/" OPA_SRC/SBC/albedo.F90 > tmp$$
+mv tmp$$ OPA_SRC/SBC/albedo.F90
+# see result of
+#    grep -i "wrk_alloc" $( find . -name "*90" ) | grep "="
+#
+# LIM_SRC_2/limrhg_2.F90
+#./LIM_SRC_2/limrhg_2.F90:      CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
+#./LIM_SRC_2/limrhg_2.F90:      CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
+sed -e "s/DIMENSION(jpi,jpj+2/DIMENSION(jpi,0:jpj+1/" LIM_SRC_2/limrhg_2.F90 > tmp$$
+mv tmp$$ LIM_SRC_2/limrhg_2.F90
+
+# LIM_SRC_3/limitd_me.F90
+#./LIM_SRC_3/limitd_me.F90:      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+sed -e "s/DIMENSION(jpi,jpj,jpl+2)/DIMENSION(jpi,jpj,-1:jpl)/" LIM_SRC_3/limitd_me.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limitd_me.F90
+
+# LIM_SRC_3/limitd_th.F90
+#./LIM_SRC_3/limitd_th.F90:      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
+sed -e "s/DIMENSION(jpi,jpj,jpl+1)/DIMENSION(jpi,jpj,0:jpl)/" LIM_SRC_3/limitd_th.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limitd_th.F90
+
+# LIM_SRC_3/limthd_dif.F90
+#./LIM_SRC_3/limthd_dif.F90:      CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+#./LIM_SRC_3/limthd_dif.F90:      CALL wrk_alloc( jpij,nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
+sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \
+    -e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limthd_dif.F90
+
+# LIM_SRC_3/limthd_ent.F90
+#./LIM_SRC_3/limthd_ent.F90:      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
+#./LIM_SRC_3/limthd_ent.F90:      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
+sed -e "s/DIMENSION(jpij,nlay_i+3)/DIMENSION(jpij,0:nlay_i+2)/" \
+    -e "s/DIMENSION(jpij,nlay_i+1)/DIMENSION(jpij,0:nlay_i)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limthd_ent.F90
+
+# OPA_SRC/DYN/divcur.F90
+#./OPA_SRC/DYN/divcur.F90:      CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 )
+sed -e "s/DIMENSION(jpi+4,jpj)/DIMENSION(-1:jpi+2,jpj)/" OPA_SRC/DYN/divcur.F90 > tmp$$
+mv tmp$$ OPA_SRC/DYN/divcur.F90
+
+# OPA_SRC/LDF/ldfslp.F90
+#./OPA_SRC/LDF/ldfslp.F90:      CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho,              klstart = 0  )
+#./OPA_SRC/LDF/ldfslp.F90:      CALL wrk_alloc( jpi,jpj,  2,2, zti_mlb, ztj_mlb,        kkstart = 0, klstart = 0  )
+sed -e "s/DIMENSION(jpi,jpj,jpk,2)/DIMENSION(jpi,jpj,jpk,0:1)/" \
+    -e "s/DIMENSION(jpi,jpj,2,2)/DIMENSION(jpi,jpj,0:1,0:1)/" OPA_SRC/LDF/ldfslp.F90 > tmp$$
+mv tmp$$ OPA_SRC/LDF/ldfslp.F90
+# OPA_SRC/ZDF/zdfkpp.F90
+#./OPA_SRC/ZDF/zdfkpp.F90:      CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 )
+sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) ::   zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$
+mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90
+
+# links 
+# see result of
+# find . -type l
+#
+# ./LIM_SRC_2/limrhg.F90
+cd LIM_SRC_2
+ln -sf ../LIM_SRC_3/limrhg.F90 .
+cd ..
+
+# ./OOO_SRC/dtadyn.F90
+cd OOO_SRC
+ln -sf ../OFF_SRC/dtadyn.F90 .
+cd ..
+
+# ./OOO_SRC/obs_fbm.F90
+cd OOO_SRC
+ln -sf ../OPA_SRC/OBS/obs_fbm.F90 .
+cd ..
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/namelist
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/namelist	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/namelist	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 8732)
@@ -0,0 +1,375 @@
+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
+
+              ! Check wet points over the entire domain to preserve the MPI communication stencil
+              isurf=0
+              DO jj=1,ippdj(jni2,jnj2)
+                 DO  ji=1,ippdi(jni2,jnj2)
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+              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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 8732)
@@ -0,0 +1,452 @@
+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
+
+              ! Check wet points over the entire domain to preserve the MPI communication stencil
+              isurf=0
+              DO jj=1,ippdj(jni2,jnj2)
+                 DO  ji=1,ippdi(jni2,jnj2)
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+                 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/agulhas	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/agulhas	(revision 8732)
@@ -0,0 +1,100 @@
+&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 
+    rn_hmin = -3 
+/   
+
+&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
+    ldbletanh   = .FALSE.
+    pa2         = 0.0
+    ppkth2      = 0.0
+    ppacr2      = 0.0
+/    
+    
+&partial_cells    	
+    partial_steps = true
+    parent_bathy_meter = 'bathy_meter.nc'
+    parent_batmet_name = 'Bathymetry'
+    e3zps_min = 20.
+    e3zps_rat = 0.1
+/
+
+&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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 8732)
@@ -0,0 +1,880 @@
+!************************************************************************
+! 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 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,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
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
+    !
+    gdepw(1) = 0.0
+    zmax = gdepw(N) + e3t(N)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
+         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 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,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
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+         END DO
+       ENDIF
+    ENDIF
+    !
+    gdepw(1) = 0.0  
+    !
+    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 rn_hmin  *
+  ! 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 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,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
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+          END DO
+       ENDIF
+    ENDIF
+    !
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !      
+    diff = 0
+    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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 8732)
@@ -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') 
+        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')
+                 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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 8732)
@@ -0,0 +1,855 @@
+!************************************************************************
+! 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 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
+    INTEGER, DIMENSION(1) :: k
+    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
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(N-1) 
+         DO i = 1, N
+            gdepw(i) = ( i - 1   ) * za1
+            gdept(i) = ( i - 0.5 ) * za1
+            e3w  (i) =  za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,N
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+               e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                  &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
+    gdepw(1) = 0.0  
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    ! Initialize bathy_level to the maximum ocean level available
+    !
+    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,za2,zsur,zacr,zacr2,zkth,zkth2,zmin,zmax,zdepth
+    INTEGER :: kbathy,jk,diff
+    INTEGER :: bornex,borney,bornex2,borney2
+    !
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  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
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(N-1) 
+         DO i = 1, N
+            gdepw(i) = ( i - 1   ) * za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,N
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
+    gdepw(1) = 0.0
+    !
+    diff = 0      
+    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)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    ! check that interpolated value stays at the same level         
+    ! 
+    !
+    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 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
+    INTEGER, DIMENSION(1) :: k
+    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
+       !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(jpk-1) 
+         DO i = 1, jpk
+            gdepw(i) = ( i - 1   ) * za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,jpk
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,jpk
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF         
+    !         
+    !                
+    DO i = 1,jpk
+       !       
+       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)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    DO jj = 1, jpj
+       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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 8732)
@@ -0,0 +1,231 @@
+!************************************************************************
+! 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 rn_hmin
+  REAL*8 ppkth2, ppacr2, ppkth,ppacr,ppdzmin,pphmax,smoothing_factor,e3zps_min,e3zps_rat
+  REAL*8 psur,pa0,pa1,pa2,adatrj
+  !       
+  LOGICAL ldbletanh
+  LOGICAL partial_steps,smoothing,bathy_update
+  LOGICAL new_topo,removeclosedseas,dimg,iom_activated
+  !       
+  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,rn_hmin      
+  !      
+  NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file      
+  !
+  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,pa2,ppkth2,ppacr2
+  ! 
+  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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/bin/ooo
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/bin/ooo	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/bin/ooo	(revision 8732)
@@ -0,0 +1,4 @@
+#!/usr/bin/env python2.7
+import ooo
+if __name__ == '__main__':
+    ooo.main()
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/Makefile
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/Makefile	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/Makefile	(revision 8732)
@@ -0,0 +1,153 @@
+# Makefile for Sphinx documentation
+#
+
+# You can set these variables from the command line.
+SPHINXOPTS    =
+SPHINXBUILD   = sphinx-build
+PAPER         =
+BUILDDIR      = build
+
+# Internal variables.
+PAPEROPT_a4     = -D latex_paper_size=a4
+PAPEROPT_letter = -D latex_paper_size=letter
+ALLSPHINXOPTS   = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
+# the i18n builder cannot share the environment and doctrees with the others
+I18NSPHINXOPTS  = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
+
+.PHONY: help clean html dirhtml singlehtml pickle json htmlhelp qthelp devhelp epub latex latexpdf text man changes linkcheck doctest gettext
+
+help:
+	@echo "Please use \`make <target>' where <target> is one of"
+	@echo "  html       to make standalone HTML files"
+	@echo "  dirhtml    to make HTML files named index.html in directories"
+	@echo "  singlehtml to make a single large HTML file"
+	@echo "  pickle     to make pickle files"
+	@echo "  json       to make JSON files"
+	@echo "  htmlhelp   to make HTML files and a HTML help project"
+	@echo "  qthelp     to make HTML files and a qthelp project"
+	@echo "  devhelp    to make HTML files and a Devhelp project"
+	@echo "  epub       to make an epub"
+	@echo "  latex      to make LaTeX files, you can set PAPER=a4 or PAPER=letter"
+	@echo "  latexpdf   to make LaTeX files and run them through pdflatex"
+	@echo "  text       to make text files"
+	@echo "  man        to make manual pages"
+	@echo "  texinfo    to make Texinfo files"
+	@echo "  info       to make Texinfo files and run them through makeinfo"
+	@echo "  gettext    to make PO message catalogs"
+	@echo "  changes    to make an overview of all changed/added/deprecated items"
+	@echo "  linkcheck  to check all external links for integrity"
+	@echo "  doctest    to run all doctests embedded in the documentation (if enabled)"
+
+clean:
+	-rm -rf $(BUILDDIR)/*
+
+html:
+	$(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html
+	@echo
+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/html."
+
+dirhtml:
+	$(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml
+	@echo
+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."
+
+singlehtml:
+	$(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml
+	@echo
+	@echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."
+
+pickle:
+	$(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle
+	@echo
+	@echo "Build finished; now you can process the pickle files."
+
+json:
+	$(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json
+	@echo
+	@echo "Build finished; now you can process the JSON files."
+
+htmlhelp:
+	$(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp
+	@echo
+	@echo "Build finished; now you can run HTML Help Workshop with the" \
+	      ".hhp project file in $(BUILDDIR)/htmlhelp."
+
+qthelp:
+	$(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp
+	@echo
+	@echo "Build finished; now you can run "qcollectiongenerator" with the" \
+	      ".qhcp project file in $(BUILDDIR)/qthelp, like this:"
+	@echo "# qcollectiongenerator $(BUILDDIR)/qthelp/Offlineobservationoperator.qhcp"
+	@echo "To view the help file:"
+	@echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Offlineobservationoperator.qhc"
+
+devhelp:
+	$(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp
+	@echo
+	@echo "Build finished."
+	@echo "To view the help file:"
+	@echo "# mkdir -p $$HOME/.local/share/devhelp/Offlineobservationoperator"
+	@echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/Offlineobservationoperator"
+	@echo "# devhelp"
+
+epub:
+	$(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub
+	@echo
+	@echo "Build finished. The epub file is in $(BUILDDIR)/epub."
+
+latex:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo
+	@echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."
+	@echo "Run \`make' in that directory to run these through (pdf)latex" \
+	      "(use \`make latexpdf' here to do that automatically)."
+
+latexpdf:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo "Running LaTeX files through pdflatex..."
+	$(MAKE) -C $(BUILDDIR)/latex all-pdf
+	@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
+
+text:
+	$(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text
+	@echo
+	@echo "Build finished. The text files are in $(BUILDDIR)/text."
+
+man:
+	$(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man
+	@echo
+	@echo "Build finished. The manual pages are in $(BUILDDIR)/man."
+
+texinfo:
+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
+	@echo
+	@echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."
+	@echo "Run \`make' in that directory to run these through makeinfo" \
+	      "(use \`make info' here to do that automatically)."
+
+info:
+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
+	@echo "Running Texinfo files through makeinfo..."
+	make -C $(BUILDDIR)/texinfo info
+	@echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."
+
+gettext:
+	$(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale
+	@echo
+	@echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."
+
+changes:
+	$(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes
+	@echo
+	@echo "The overview file is in $(BUILDDIR)/changes."
+
+linkcheck:
+	$(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck
+	@echo
+	@echo "Link check complete; look for any errors in the above output " \
+	      "or in $(BUILDDIR)/linkcheck/output.txt."
+
+doctest:
+	$(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest
+	@echo "Testing of doctests in the sources finished, look at the " \
+	      "results in $(BUILDDIR)/doctest/output.txt."
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/make.bat
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/make.bat	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/make.bat	(revision 8732)
@@ -0,0 +1,190 @@
+@ECHO OFF
+
+REM Command file for Sphinx documentation
+
+if "%SPHINXBUILD%" == "" (
+	set SPHINXBUILD=sphinx-build
+)
+set BUILDDIR=build
+set ALLSPHINXOPTS=-d %BUILDDIR%/doctrees %SPHINXOPTS% source
+set I18NSPHINXOPTS=%SPHINXOPTS% source
+if NOT "%PAPER%" == "" (
+	set ALLSPHINXOPTS=-D latex_paper_size=%PAPER% %ALLSPHINXOPTS%
+	set I18NSPHINXOPTS=-D latex_paper_size=%PAPER% %I18NSPHINXOPTS%
+)
+
+if "%1" == "" goto help
+
+if "%1" == "help" (
+	:help
+	echo.Please use `make ^<target^>` where ^<target^> is one of
+	echo.  html       to make standalone HTML files
+	echo.  dirhtml    to make HTML files named index.html in directories
+	echo.  singlehtml to make a single large HTML file
+	echo.  pickle     to make pickle files
+	echo.  json       to make JSON files
+	echo.  htmlhelp   to make HTML files and a HTML help project
+	echo.  qthelp     to make HTML files and a qthelp project
+	echo.  devhelp    to make HTML files and a Devhelp project
+	echo.  epub       to make an epub
+	echo.  latex      to make LaTeX files, you can set PAPER=a4 or PAPER=letter
+	echo.  text       to make text files
+	echo.  man        to make manual pages
+	echo.  texinfo    to make Texinfo files
+	echo.  gettext    to make PO message catalogs
+	echo.  changes    to make an overview over all changed/added/deprecated items
+	echo.  linkcheck  to check all external links for integrity
+	echo.  doctest    to run all doctests embedded in the documentation if enabled
+	goto end
+)
+
+if "%1" == "clean" (
+	for /d %%i in (%BUILDDIR%\*) do rmdir /q /s %%i
+	del /q /s %BUILDDIR%\*
+	goto end
+)
+
+if "%1" == "html" (
+	%SPHINXBUILD% -b html %ALLSPHINXOPTS% %BUILDDIR%/html
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The HTML pages are in %BUILDDIR%/html.
+	goto end
+)
+
+if "%1" == "dirhtml" (
+	%SPHINXBUILD% -b dirhtml %ALLSPHINXOPTS% %BUILDDIR%/dirhtml
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The HTML pages are in %BUILDDIR%/dirhtml.
+	goto end
+)
+
+if "%1" == "singlehtml" (
+	%SPHINXBUILD% -b singlehtml %ALLSPHINXOPTS% %BUILDDIR%/singlehtml
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The HTML pages are in %BUILDDIR%/singlehtml.
+	goto end
+)
+
+if "%1" == "pickle" (
+	%SPHINXBUILD% -b pickle %ALLSPHINXOPTS% %BUILDDIR%/pickle
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can process the pickle files.
+	goto end
+)
+
+if "%1" == "json" (
+	%SPHINXBUILD% -b json %ALLSPHINXOPTS% %BUILDDIR%/json
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can process the JSON files.
+	goto end
+)
+
+if "%1" == "htmlhelp" (
+	%SPHINXBUILD% -b htmlhelp %ALLSPHINXOPTS% %BUILDDIR%/htmlhelp
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can run HTML Help Workshop with the ^
+.hhp project file in %BUILDDIR%/htmlhelp.
+	goto end
+)
+
+if "%1" == "qthelp" (
+	%SPHINXBUILD% -b qthelp %ALLSPHINXOPTS% %BUILDDIR%/qthelp
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can run "qcollectiongenerator" with the ^
+.qhcp project file in %BUILDDIR%/qthelp, like this:
+	echo.^> qcollectiongenerator %BUILDDIR%\qthelp\Offlineobservationoperator.qhcp
+	echo.To view the help file:
+	echo.^> assistant -collectionFile %BUILDDIR%\qthelp\Offlineobservationoperator.ghc
+	goto end
+)
+
+if "%1" == "devhelp" (
+	%SPHINXBUILD% -b devhelp %ALLSPHINXOPTS% %BUILDDIR%/devhelp
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished.
+	goto end
+)
+
+if "%1" == "epub" (
+	%SPHINXBUILD% -b epub %ALLSPHINXOPTS% %BUILDDIR%/epub
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The epub file is in %BUILDDIR%/epub.
+	goto end
+)
+
+if "%1" == "latex" (
+	%SPHINXBUILD% -b latex %ALLSPHINXOPTS% %BUILDDIR%/latex
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; the LaTeX files are in %BUILDDIR%/latex.
+	goto end
+)
+
+if "%1" == "text" (
+	%SPHINXBUILD% -b text %ALLSPHINXOPTS% %BUILDDIR%/text
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The text files are in %BUILDDIR%/text.
+	goto end
+)
+
+if "%1" == "man" (
+	%SPHINXBUILD% -b man %ALLSPHINXOPTS% %BUILDDIR%/man
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The manual pages are in %BUILDDIR%/man.
+	goto end
+)
+
+if "%1" == "texinfo" (
+	%SPHINXBUILD% -b texinfo %ALLSPHINXOPTS% %BUILDDIR%/texinfo
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The Texinfo files are in %BUILDDIR%/texinfo.
+	goto end
+)
+
+if "%1" == "gettext" (
+	%SPHINXBUILD% -b gettext %I18NSPHINXOPTS% %BUILDDIR%/locale
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The message catalogs are in %BUILDDIR%/locale.
+	goto end
+)
+
+if "%1" == "changes" (
+	%SPHINXBUILD% -b changes %ALLSPHINXOPTS% %BUILDDIR%/changes
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.The overview file is in %BUILDDIR%/changes.
+	goto end
+)
+
+if "%1" == "linkcheck" (
+	%SPHINXBUILD% -b linkcheck %ALLSPHINXOPTS% %BUILDDIR%/linkcheck
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Link check complete; look for any errors in the above output ^
+or in %BUILDDIR%/linkcheck/output.txt.
+	goto end
+)
+
+if "%1" == "doctest" (
+	%SPHINXBUILD% -b doctest %ALLSPHINXOPTS% %BUILDDIR%/doctest
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Testing of doctests in the sources finished, look at the ^
+results in %BUILDDIR%/doctest/output.txt.
+	goto end
+)
+
+:end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/conf.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/conf.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/conf.py	(revision 8732)
@@ -0,0 +1,246 @@
+# -*- coding: utf-8 -*-
+#
+# Offline observation operator documentation build configuration file, created by
+# sphinx-quickstart on Mon Oct  7 17:21:35 2013.
+#
+# This file is execfile()d with the current directory set to its containing dir.
+#
+# Note that not all possible configuration values are present in this
+# autogenerated file.
+#
+# All configuration values have a default; values that are commented out
+# serve to show the default.
+
+import sys, os
+
+# If extensions (or modules to document with autodoc) are in another directory,
+# add these directories to sys.path here. If the directory is relative to the
+# documentation root, use os.path.abspath to make it absolute, like shown here.
+sys.path.insert(0, os.path.abspath('../..'))
+
+# -- General configuration -----------------------------------------------------
+
+# If your documentation needs a minimal Sphinx version, state it here.
+#needs_sphinx = '1.0'
+
+# Add any Sphinx extension module names here, as strings. They can be extensions
+# coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
+extensions = ['sphinx.ext.autodoc', 'sphinx.ext.intersphinx']
+
+# Add any paths that contain templates here, relative to this directory.
+templates_path = ['_templates']
+
+# The suffix of source filenames.
+source_suffix = '.rst'
+
+# The encoding of source files.
+#source_encoding = 'utf-8-sig'
+
+# The master toctree document.
+master_doc = 'index'
+
+# General information about the project.
+project = u'Offline observation operator'
+copyright = u'2013, Andrew Ryan'
+
+# The version info for the project you're documenting, acts as replacement for
+# |version| and |release|, also used in various other places throughout the
+# built documents.
+#
+# The short X.Y version.
+version = '0.1'
+# The full version, including alpha/beta/rc tags.
+release = '0.1.0'
+
+# The language for content autogenerated by Sphinx. Refer to documentation
+# for a list of supported languages.
+#language = None
+
+# There are two options for replacing |today|: either, you set today to some
+# non-false value, then it is used:
+#today = ''
+# Else, today_fmt is used as the format for a strftime call.
+#today_fmt = '%B %d, %Y'
+
+# List of patterns, relative to source directory, that match files and
+# directories to ignore when looking for source files.
+exclude_patterns = []
+
+# The reST default role (used for this markup: `text`) to use for all documents.
+#default_role = None
+
+# If true, '()' will be appended to :func: etc. cross-reference text.
+#add_function_parentheses = True
+
+# If true, the current module name will be prepended to all description
+# unit titles (such as .. function::).
+#add_module_names = True
+
+# If true, sectionauthor and moduleauthor directives will be shown in the
+# output. They are ignored by default.
+#show_authors = False
+
+# The name of the Pygments (syntax highlighting) style to use.
+pygments_style = 'sphinx'
+
+# A list of ignored prefixes for module index sorting.
+#modindex_common_prefix = []
+
+
+# -- Options for HTML output ---------------------------------------------------
+
+# The theme to use for HTML and HTML Help pages.  See the documentation for
+# a list of builtin themes.
+html_theme = 'default'
+
+# Theme options are theme-specific and customize the look and feel of a theme
+# further.  For a list of options available for each theme, see the
+# documentation.
+#html_theme_options = {}
+
+# Add any paths that contain custom themes here, relative to this directory.
+#html_theme_path = []
+
+# The name for this set of Sphinx documents.  If None, it defaults to
+# "<project> v<release> documentation".
+#html_title = None
+
+# A shorter title for the navigation bar.  Default is the same as html_title.
+#html_short_title = None
+
+# The name of an image file (relative to this directory) to place at the top
+# of the sidebar.
+#html_logo = None
+
+# The name of an image file (within the static path) to use as favicon of the
+# docs.  This file should be a Windows icon file (.ico) being 16x16 or 32x32
+# pixels large.
+#html_favicon = None
+
+# Add any paths that contain custom static files (such as style sheets) here,
+# relative to this directory. They are copied after the builtin static files,
+# so a file named "default.css" will overwrite the builtin "default.css".
+html_static_path = ['_static']
+
+# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,
+# using the given strftime format.
+#html_last_updated_fmt = '%b %d, %Y'
+
+# If true, SmartyPants will be used to convert quotes and dashes to
+# typographically correct entities.
+#html_use_smartypants = True
+
+# Custom sidebar templates, maps document names to template names.
+#html_sidebars = {}
+
+# Additional templates that should be rendered to pages, maps page names to
+# template names.
+#html_additional_pages = {}
+
+# If false, no module index is generated.
+#html_domain_indices = True
+
+# If false, no index is generated.
+#html_use_index = True
+
+# If true, the index is split into individual pages for each letter.
+#html_split_index = False
+
+# If true, links to the reST sources are added to the pages.
+#html_show_sourcelink = True
+
+# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.
+#html_show_sphinx = True
+
+# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.
+#html_show_copyright = True
+
+# If true, an OpenSearch description file will be output, and all pages will
+# contain a <link> tag referring to it.  The value of this option must be the
+# base URL from which the finished HTML is served.
+#html_use_opensearch = ''
+
+# This is the file name suffix for HTML files (e.g. ".xhtml").
+#html_file_suffix = None
+
+# Output file base name for HTML help builder.
+htmlhelp_basename = 'Offlineobservationoperatordoc'
+
+
+# -- Options for LaTeX output --------------------------------------------------
+
+latex_elements = {
+# The paper size ('letterpaper' or 'a4paper').
+#'papersize': 'letterpaper',
+
+# The font size ('10pt', '11pt' or '12pt').
+#'pointsize': '10pt',
+
+# Additional stuff for the LaTeX preamble.
+#'preamble': '',
+}
+
+# Grouping the document tree into LaTeX files. List of tuples
+# (source start file, target name, title, author, documentclass [howto/manual]).
+latex_documents = [
+  ('index', 'Offlineobservationoperator.tex', u'Offline observation operator Documentation',
+   u'Andrew Ryan', 'manual'),
+]
+
+# The name of an image file (relative to this directory) to place at the top of
+# the title page.
+#latex_logo = None
+
+# For "manual" documents, if this is true, then toplevel headings are parts,
+# not chapters.
+#latex_use_parts = False
+
+# If true, show page references after internal links.
+#latex_show_pagerefs = False
+
+# If true, show URL addresses after external links.
+#latex_show_urls = False
+
+# Documents to append as an appendix to all manuals.
+#latex_appendices = []
+
+# If false, no module index is generated.
+#latex_domain_indices = True
+
+
+# -- Options for manual page output --------------------------------------------
+
+# One entry per manual page. List of tuples
+# (source start file, name, description, authors, manual section).
+man_pages = [
+    ('index', 'offlineobservationoperator', u'Offline observation operator Documentation',
+     [u'Andrew Ryan'], 1)
+]
+
+# If true, show URL addresses after external links.
+#man_show_urls = False
+
+
+# -- Options for Texinfo output ------------------------------------------------
+
+# Grouping the document tree into Texinfo files. List of tuples
+# (source start file, target name, title, author,
+#  dir menu entry, description, category)
+texinfo_documents = [
+  ('index', 'Offlineobservationoperator', u'Offline observation operator Documentation',
+   u'Andrew Ryan', 'Offlineobservationoperator', 'One line description of project.',
+   'Miscellaneous'),
+]
+
+# Documents to append as an appendix to all manuals.
+#texinfo_appendices = []
+
+# If false, no module index is generated.
+#texinfo_domain_indices = True
+
+# How to display URL addresses: 'footnote', 'no', or 'inline'.
+#texinfo_show_urls = 'footnote'
+
+
+# Example configuration for intersphinx: refer to the Python standard library.
+intersphinx_mapping = {'http://docs.python.org/': None}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/index.rst
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/index.rst	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/index.rst	(revision 8732)
@@ -0,0 +1,23 @@
+.. Offline observation operator documentation master file, created by
+   sphinx-quickstart on Mon Oct  7 17:21:35 2013.
+   You can adapt this file completely to your liking, but it should at least
+   contain the root `toctree` directive.
+
+Welcome to Offline observation operator's documentation!
+========================================================
+
+Contents:
+
+.. toctree::
+   :maxdepth: 2
+
+   intro
+
+
+Indices and tables
+==================
+
+* :ref:`genindex`
+* :ref:`modindex`
+* :ref:`search`
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/intro.rst
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/intro.rst	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/doc/source/intro.rst	(revision 8732)
@@ -0,0 +1,57 @@
+
+Introduction
+------------
+
+The offline observation operator quick start script involves simple
+computation and manipulation of NEMO namelists.
+
+Quick start script
+------------------
+
+.. code-block:: none
+
+   ooo -h
+   usage: ooo [-h] [-w WORK_DIR] [-f FORECAST_TYPES] [-l LEAD_TIMES]
+              [-o OBS_TYPES] [--class4]
+              DATE NAMELIST
+   
+   positional arguments:
+     DATE                  Run date.
+     NAMELIST              NEMO namelist to edit.
+   
+   optional arguments:
+     -h, --help            show this help message and exit
+     -w WORK_DIR, --work-dir WORK_DIR
+     -f FORECAST_TYPES, --forecast-types FORECAST_TYPES
+                           Choice of forecast,persistence,climatology
+     -l LEAD_TIMES, --lead-times LEAD_TIMES
+                           Forecast lead times
+     -o OBS_TYPES, --obs-types OBS_TYPES
+                           Choice of namobs types.
+     --class4              Flag to choose class 4 file outputs
+     --dry-run             Flag to test namelist building without submitting.
+     --cmd COMMAND         Submit task to run.
+     -v, --verbose         Prints difference between before and after namelists.
+
+
+The above command line utility ``ooo`` can be used to edit **NEMO** namelists. 
+
+Run
+---
+
+.. automodule:: ooo.run
+   :members:
+
+
+Locators
+--------
+
+.. automodule:: ooo.locator
+   :members:
+
+Fortran
+-------
+
+.. automodule:: ooo.nml
+   :members:
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/__init__.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/__init__.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/__init__.py	(revision 8732)
@@ -0,0 +1,3 @@
+import nml
+import locator
+from ooo import main
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/locator.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/locator.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/locator.py	(revision 8732)
@@ -0,0 +1,151 @@
+"""Locates input files and calculates namelist attributes
+
+    Typically a user will have files distributed throughout the hard drive
+    and it makes little or no sense to try to capture all use cases.
+
+    >>> date = "20130101"
+    >>> namobs = observations(date, types=["profbfiles"])
+
+    >>> namooo, namcl4 = forecasts(date, types=["forecast", "persistence"], lead_times=[12, 36, 60])
+"""
+
+def observations(date, types=None):
+    """Responsible for locating observation files
+
+    Valid **namobs** observation types.
+
+    * profbfiles
+    * sstfbfiles
+    * slafbfiles
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :param types: A list of namobs observation types
+
+    :returns: namobs namelist dictionary
+    """
+    namobs = {"ln_t3d": False,
+              "ln_s3d": False,
+              "ln_ena": False,
+              "ln_profb": False,
+              "ln_sst": False,
+              "ln_sstfb": False,
+              "ln_reysst": False,
+              "ln_ghrsst": False,
+              "ln_sla": False,
+              "ln_slafb": False,
+              "ln_sladt": False}
+    if types is None: types = []
+    for obtype in types: 
+        if obtype == "profbfiles":
+            namobs[obtype] = profbfiles(date)
+            namobs["ln_t3d"] = True
+            namobs["ln_s3d"] = True
+            namobs["ln_profb"] = True
+        elif obtype == "sstfbfiles":
+            namobs[obtype] = sstfbfiles(date)
+            namobs["ln_sst"] = True
+            namobs["ln_sstfb"] = True
+        elif obtype == "slafbfiles":
+            namobs[obtype] = slafbfiles(date)
+            namobs["ln_sla"] = True
+            namobs["ln_slafb"] = True
+    return namobs
+
+def profbfiles(date):
+    """Observation file locator stub
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :returns: List of files
+    """
+    files = ['profb.nc']
+    return files
+
+def sstfbfiles(date):
+    """Observation file locator stub
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :returns: List of files
+    """
+    files = ['sstfb.nc']
+    return files
+
+def slafbfiles(date):
+    """Observation file locator stub
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :returns: List of files
+    """
+    files = ['slafb.nc']
+    return files
+
+def forecasts(date, types=None, lead_times=None):
+    """Responsible for locating forecast fields
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :param types: A list of forecast system types
+    :param lead_times: A list of lead_times to search for
+
+    :returns: tuple of namelist data, (namooo, namcl4)
+    """
+    namooo = {}
+    namcl4 = {}
+    if types is None: types = []
+    if lead_times is None: lead_times = []
+
+    # Initialise data
+    ooo_files = []
+    nn_ooo_idx = []
+    cl4_vars = []
+    cl4_fcst_idx = []
+
+    # Search for files
+    for type in types:
+        files = []
+        in_indices = []
+        out_indices = []
+        for ilt, lead_time in enumerate(lead_times):
+            file, index = field(date, type=type, lead_time=lead_time)
+            files.append(file)
+            in_indices.append(index)
+            out_indices.append(ilt + 1)
+        # Expand return lists
+        ooo_files += files
+        nn_ooo_idx += in_indices
+        cl4_fcst_idx += out_indices
+        cl4_vars += len(files) * [type]
+
+    # Namoo
+    namooo["ooo_files"] = ooo_files
+    namooo["nn_ooo_idx"] = nn_ooo_idx
+
+    # Namcl4
+    namcl4["cl4_vars"] = cl4_vars
+    namcl4["cl4_fcst_idx"] = cl4_fcst_idx
+
+    return namooo, namcl4
+
+def field(date, type=None, lead_time=None):
+    """Forecast field locator
+
+    Maps verification date and lead time off set to file name and
+    index along file *time_counter*
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :param type: Forecast type
+    :param lead_time: Forecast off set
+
+    :returns: (**path**, **index**)
+    """
+    # Worker function
+    file = 'nofile'
+    index = -1
+    return file, index
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/nml.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/nml.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/nml.py	(revision 8732)
@@ -0,0 +1,479 @@
+"""Collection of Fortran 90 namelist helper functions.
+
+    A common way to interface with a Fortran executable is via
+    an input file called a namelist. This module defines
+    functions which simplify the process of updating and
+    extending namelist data.
+
+    .. note:: This module is especially lightweight and follows the
+              batteries included philosophy. As such, only standard
+              library modules are required to use this code.
+
+    Walkthrough
+    ===========
+
+    New namelist
+    ------------
+
+    A typical usage is to create and update a Fortran namelist on the fly.
+
+    >>> import nml
+    >>> namid = "namfoo"
+    >>> text = nml.new(namid)
+    >>> data = {"x": nml.tostring([1, 2, 3])}
+    >>> text = nml.update(namid, text, data)
+    >>> print text
+    &namfoo
+       x = 1 2 3
+    /
+    <BLANKLINE>
+
+    In the above snippet :func:`tostring` has been used to sanitize the input
+    Python list. This function cleverly maps string data and numeric data to
+    the correct Fortran syntax.
+
+    However, the :func:`new` function takes care of many of the above steps automatically.
+    Where appropriate :func:`sanitize` has been embedded to reduce the need
+    to worry about data format problems. Take for example,
+
+    >>> print nml.new("namfoo", data={"x": range(3)})
+    &namfoo
+       x = 0 1 2
+    /
+    <BLANKLINE>
+
+    Parse existing namelist
+    -----------------------
+
+    In order to update a namelist it is necessary to convert the namelist text into
+    a dictionary of *key, value* pairs which can be manipulated in the usual Pythonic
+    fashion before being piped back out to disk.
+
+    In everyday usage text will be read from files, here however for illustration
+    purposes I have hand written a namelist.
+
+    >>> text = '''
+    ... &namfoo
+    ...     x = y  ! A description of the variables
+    ... /
+    ... &nambar
+    ...     ln_on = .TRUE. ! A description of the variables
+    ... /
+    ... '''
+
+    This can be parsed by invoking the :func:`variables` command.
+
+    >>> nml.variables(text)
+    {'x': 'y', 'ln_on': '.TRUE.'}
+
+    Or by using the :func:`namelists` function to split the file into sub-lists.
+
+    >>> nml.namelists(text)
+    {'namfoo': '&namfoo\\n    x = y  ! A description of the variables\\n/', 'nambar': '&nambar\\n    ln_on = .TRUE. ! A description of the variables\\n/'}
+    >>> sublists = nml.namelists(text)
+    >>> print sublists["nambar"]
+    &nambar
+        ln_on = .TRUE. ! A description of the variables
+    /
+
+    Which can be parsed into a dictionary as before.
+
+    >>> print nml.variables(sublists["nambar"])
+    {'ln_on': '.TRUE.'}
+
+
+    Update/replace data
+    -------------------
+
+    There are two ways of modifying values inside a Fortran namelist. 
+
+    Replace
+        The first is to simply replace a set of variables with new values. This behaviour is accomplished
+        via the :func:`replace` function. This approach simply overwrites existing variables. No knowledge
+        of sub-namelist structure is required to modify a string of text. 
+
+    .. note:: Additional variables will not be added to a namelist via this approach
+
+    Update
+        The second is to extend the set of variables contained within a namelist. This functionality is
+        controlled by the :func:`update` function. Here, variables which are not already specified are
+        added using a templated namelist line.
+
+    .. note:: It is essential to specify which sub-namelist is to be updated before modification takes place
+
+    Pipe to/from file
+    -----------------
+
+    As typical NEMO namelists are no larger than a few tens of kilobytes
+    it makes sense to process namelists as single strings instead of
+    line by line.
+
+    >>> path = "foo.nml"
+    >>> text = nml.new("namfoo")
+
+    To write to a file simply invoke the writer.
+
+    >>> # Write to file
+    >>> nml.writer(path, text)
+
+    To read from a file specify the path to be read.
+
+    >>> # Read from file
+    >>> text = nml.reader(path)
+
+    Join multiple namelists
+    -----------------------
+
+    Since the namelists are regular Python strings there is no need for a 
+    specific *join* function. Namelists can be combined in whatever manner
+    is most pleasing to the eye.
+
+    >>> namoff = nml.new("namoff")
+    >>> namcl4 = nml.new("namcl4")
+    >>> # new line join
+    >>> print "\\n".join([namoff, namcl4])
+    &namoff
+    /
+    <BLANKLINE>
+    &namcl4
+    /
+    <BLANKLINE>
+
+    >>> # Or addition
+    >>> print namoff + namcl4
+    &namoff
+    /
+    &namcl4
+    /
+    <BLANKLINE>
+
+    Module functions
+    ================
+
+"""
+__version__ = "0.1.0"
+import re
+from numbers import Number
+
+def reader(path):
+    """Reads a file into a string
+
+    Reads whole file into single string. Typically, 
+    namelists are small enough to be stored in memory
+    while updates and edits are being performed.
+
+    :param path: Path to input file
+    :returns: entire file as a single string
+
+    """
+    with open(path, "r") as handle:
+        text = handle.read()
+    return text
+
+def writer(path, text):
+    """Writes to a file from a string
+
+    Handy way of piping a processed namelist into
+    a file.
+
+    :param path: Path to output file
+    :param text: Input text to process
+
+    """
+    with open(path, "w") as handle:
+        handle.write(text)
+
+def update(namid, text, data, convert=True):
+    """Extends namelist definition.
+
+    Similar to replace this function alters the values
+    of variables defined within a namelist. In addition to
+    replacing values it also creates definitions if the
+    variable is not found in the namelist. As such, the
+    namelist id must be specified.
+
+    :param namid: Namelist id
+    :param text: Input text to process
+    :param data: Dictionary of variables
+    :keyword convert: Sanitizes input data before replacement takes place
+
+    :returns: Text
+
+    .. seealso:: :func:`replace` :func:`sanitize`
+    """
+    sublists = namelists(text)
+    assert namid in sublists, "Warning: invalid namid specified!"
+
+    # Sanitize inputs
+    if convert:
+        data = sanitize(data)
+
+    # Parse subsection
+    namtext = sublists[namid]
+    subdata = variables(namtext)
+    subvars = subdata.keys()
+
+    # Replace existing variables in namtext
+    tmptext = replace(namtext, data)
+    text = text.replace(namtext, tmptext)
+    namtext = tmptext
+
+    # Identify new variables
+    vars = data.keys()
+    newvars = list(set(vars) - set(subvars))
+    newvars.sort()
+
+    # Append new vars to namid
+    lines = namtext.split("\n")
+    for v in newvars:
+        newline = "   %s = %s" % (v, data[v])
+        lines.insert(-1, newline)
+    newtext = "\n".join(lines)
+
+    # Replace old namtext with new namtext
+    text = text.replace(namtext, newtext)
+    return text
+
+def replace(text, data, convert=True):
+    """Edits existing variables.
+
+    Pattern matches and substitutes variables inside
+    a string of text. This is independent of namid and
+    as such is useful for modifying existing variables.
+    To append new variables the :func:`update` function 
+    is required.
+
+    >>> text = '''
+    ... &namobs
+    ...    ln_sst = .TRUE. ! Logical switch for SST observations
+    ... /
+    ... '''
+    >>> data = {"ln_sst": ".FALSE."}
+    >>> print replace(text, data)
+    <BLANKLINE>
+    &namobs
+       ln_sst = .FALSE. ! Logical switch for SST observations
+    /
+    <BLANKLINE>
+
+    .. note :: This does not append new variables to a namelist
+
+    :param text: string to process
+    :param data: dictionary with which to modify **text**
+    :keyword convert: Sanitizes input data before replacement takes place
+
+    :returns: string with new data values
+
+    .. seealso:: :func:`update`, :func:`sanitize`
+    """
+    if convert:
+        data = sanitize(data)
+    for k, v in data.iteritems():
+        pat = r"(%s\s*=\s*).+?(\s*[!\n])" % (k,)
+        repl = r"\g<1>%s\g<2>" % (v,)
+        text = re.sub(pat, repl, text)
+    return text
+
+def variables(text):
+    """Retrieves dictionary of variables in text.
+
+    >>> text = '''
+    ... &namobs
+    ...    ln_sst = .TRUE. ! Logical switch for SST observations
+    ... /
+    ... '''
+    >>> variables(text)
+    {'ln_sst': '.TRUE.'}
+
+    :param text: Input text to process
+
+    :returns: A dictionary of variable, value pairs.
+
+    """
+    data = {}
+    pairs = re.findall(r"\n\s*(\w+)\s*=\s*(.+?)\s*(?=[!\n])", text)
+    for key, value in pairs:
+        data[key] = value
+    return data
+
+def namelists(text):
+    """Retrieves dictionary of namelists in text.
+
+    Useful for isolating sub-namelists.
+
+    >>> text = '''
+    ... &namobs
+    ...    ln_sst = .TRUE. ! Logical switch for SST observations
+    ... /
+    ... '''
+    >>> namelists(text)
+    {'namobs': '&namobs\\n   ln_sst = .TRUE. ! Logical switch for SST observations\\n/'}
+
+    :param text: Input text to process
+
+    :returns: A dictionary of id, text block key, value pairs
+
+    """
+    # Boundary case
+    if text.startswith("&"):
+        text = "\n" + text
+    # Regular expression
+    results = re.findall(r"\n(&(\w+).*?\n/)", text, re.DOTALL)
+    data = {}
+    for content, namid in results:
+        data[namid] = content
+    return data
+
+def tostring(data):
+    """Maps standard Python data to Fortran namelist format.
+
+    >>> tostring([1, 2, 3])
+    '1 2 3'
+    >>> tostring(["foo.nc", "bar.nc"])
+    "'foo.nc', 'bar.nc'"
+    >>> tostring(True)
+    '.TRUE.'
+
+    :param data: Input Python data
+
+    :returns: Namelist formatted string
+
+    .. seealso:: :func:`sanitize`
+    """
+    if isinstance(data, list):
+        if all_numeric(data):
+            delim = " "
+        else:
+            delim = ", "
+        text = delim.join([convert(item) for item in data])
+    else:
+        text = convert(data)
+    return text
+
+def all_numeric(inputs):
+    # Checks all list entries are numbers
+    flag = True
+    for input in inputs:
+        if not isinstance(input, Number):
+            flag = False
+            break
+    return flag
+
+def numeric(word):
+    # Tests input string is numeric data
+    parts = word.split(" ")
+    try:
+        map(float, parts)
+        flag = True
+    except ValueError:
+        flag = False
+    return flag
+
+def logical(word):
+    # Tests input string is numeric data
+    if word.upper() in [".FALSE.", ".TRUE."]:
+        flag = True
+    else:
+        flag = False
+    return flag
+
+def listed(word):
+    # Tests input string is not a list
+    if ("," in word) or (" " in word):
+        flag = True
+    else:
+        flag = False
+    return flag
+
+def quote(word):
+    word = str(word)
+    if not quoted(word):
+        word = "'%s'" % (word,)
+    return word
+
+def convert(word):
+    # Conversion function
+    if isinstance(word, str):
+        if (quoted(word) or numeric(word) 
+            or logical(word) or listed(word)):
+            result = "%s" % (word,)
+        else:
+            result = quote(word)
+    elif isinstance(word, bool):
+        if word:
+            result = ".TRUE."
+        else:
+            result = ".FALSE."
+    else:
+        result = str(word)
+    return result
+
+def quoted(word):
+    # Checks if string begins/ends with quotation marks
+    if (word.startswith("'") and word.endswith("'")):
+        flag = True
+    elif (word.startswith('"') and word.endswith('"')):
+        flag = True
+    else: 
+        flag = False
+    return flag
+
+def same_type(data):
+    # True if all entries are the same type
+    types = map(type, data)
+    if len(set(types)) == 1:
+        flag = True
+    else:
+        flag = False
+    return flag
+
+def sanitize(data):
+    """Converts dictionary values into Fortran namelist format.
+
+    This is a more typical way to prepare data for inclusion in
+    a Fortran namelist. Instead of manually applying :func:`tostring`
+    to every element of the input data, **sanitize** fixes the entire
+    data set.
+
+    >>> sanitize({"x": True})
+    {'x': '.TRUE.'}
+    >>> 
+
+    :param data: Dictionary to convert
+
+    :returns: Dictionary whose values are in Fortran namelist format
+
+    .. seealso:: :func:`tostring`
+    """
+    replacements = [(k, tostring(v)) for k, v in data.items()]
+    data.update(replacements)
+    return data
+
+def new(namid, data=None, convert=True):
+    """Creates a new Fortran namelist
+
+    >>> new("namobs")
+    '&namobs\\n/\\n'
+    >>> print new("namobs")
+    &namobs
+    /
+    <BLANKLINE>
+
+    :param namid: Name for the new namelist
+
+    :keyword data: Specifies an initial dictionary with which to
+                   populate the namelist
+    :type data: dict
+    :keyword convert: Sanitizes input data before replacement takes place
+
+    :returns: string representation of a Fortran namelist
+    """
+    text = "&{namid}\n/\n".format(namid=namid)
+    if data is not None:
+        text = update(namid, text, data, convert=convert)
+    return text
+
+if __name__ == '__main__':
+    import doctest
+    doctest.testmod()
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/ooo.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/ooo.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/ooo.py	(revision 8732)
@@ -0,0 +1,124 @@
+#!/usr/bin/env python2.7
+
+import os
+import shutil
+
+# Local imports
+import locator
+import nml
+import run
+
+def parse_args():
+    import argparse
+    parser = argparse.ArgumentParser()
+    parser.add_argument("date", metavar="DATE", 
+                        help="Run date.")
+    parser.add_argument("-w", "--work-dir", default=os.getcwd())
+    parser.add_argument("-f", "--forecast-types", default="forecast",
+                        help="Choice of forecast,persistence,climatology")
+    parser.add_argument("-l", "--lead-times", default="12",
+                        help="Forecast lead times")
+    parser.add_argument("-o", "--obs-types", default="profbfiles",
+                        help="Choice of namobs types.")
+    parser.add_argument("--class4", dest="ln_cl4", action="store_true",
+                        help="Flag to choose class 4 file outputs")
+    parser.add_argument("--dry-run", action="store_true",
+                        help="Flag to test namelist building without submitting.")
+    parser.add_argument("--cmd", dest="command", default="./opa",
+                        help="Submit task to run.")
+    parser.add_argument("-v", "--verbose", action="store_true",
+                        help="Prints difference between before and after namelists.")
+    parser.add_argument("namelist", metavar="NAMELIST", 
+                        help="NEMO namelist to edit.")
+    args = parser.parse_args()
+    args.forecast_types = args.forecast_types.split(',')
+    args.obs_types = args.obs_types.split(',')
+    args.lead_times = map(int, args.lead_times.split(','))
+    return args
+
+def printdiff(text1, text2):
+    # Provides nice text difference summary of namelists
+    import difflib
+    lines1 = text1.splitlines()
+    lines2 = text2.splitlines()
+    d = difflib.Differ()
+    result = list(d.compare(lines1, lines2))
+    text = '\n'.join(result)
+    print text
+
+def main():
+    args = parse_args()
+    date = args.date
+    print "Processing", args.namelist, " for", args.date
+    
+    # Move to working directory
+    if not os.path.exists(args.work_dir):
+        os.makedirs(args.work_dir)
+    os.chdir(args.work_dir)
+
+    # Collect forecast files
+    types = args.forecast_types
+    lead_times = args.lead_times
+    namooo, namcl4 = locator.forecasts(date=date,
+                                       types=types,
+                                       lead_times=lead_times)
+
+    # Process NEMO namelist
+    text = nml.reader(args.namelist)
+    sublists = nml.namelists(text)
+
+    # Verbose save original text
+    if args.verbose:
+        original_text = text
+
+    # namooo
+    if "namooo" not in sublists:
+        # Attach boilerplate
+        text += nml.new("namooo")
+    text = nml.update("namooo", text, data=namooo)
+
+    # namcl4
+    if "namcl4" not in sublists:
+        # Attach boilerplate
+        text += nml.new("namcl4")
+    namcl4["cl4_leadtime"] = lead_times
+    namcl4["cl4_date"] = nml.quote(date)
+    namcl4["cl4_match_len"] = len(namcl4["cl4_vars"])
+    namcl4["cl4_fcst_len"] = len(namcl4["cl4_leadtime"])
+    # Add naming convention
+    namcl4["cl4_sys"] = "FOAM"
+    namcl4["cl4_cfg"] = "orca025"
+    namcl4["cl4_vn"] = "'1.0'"
+    namcl4["cl4_prefix"] = "class4"
+    namcl4["cl4_contact"] = "example@example.com"
+    namcl4["cl4_inst"] = "institute"
+    text = nml.update("namcl4", text, data=namcl4)
+
+    # namrun
+    namrun = {"nn_date0": nml.quote(date)}
+    text = nml.update("namrun", text, data=namrun)
+
+    # namobs
+    namobs = locator.observations(date=date,
+                                  types=args.obs_types)
+    namobs["ln_cl4"] = args.ln_cl4
+    text = nml.update("namobs", text, data=namobs)
+
+    # Verbose print namelist differences
+    if args.verbose:
+        printdiff(original_text, text)
+
+    # pipe text to file
+    tmp = args.namelist+".tmp"
+    nml.writer(tmp, text)
+    shutil.move(tmp, args.namelist)
+
+    # Run job
+    if not args.dry_run:
+        run.submit(command=args.command)
+    
+
+
+if __name__ == '__main__':
+    main()
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/run.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/run.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/run.py	(revision 8732)
@@ -0,0 +1,27 @@
+"""
+
+The NEMO offline observation operator is built and runs similarly to the
+online NEMO model.
+ 
+"""
+import subprocess
+import shlex
+import os
+
+class SubmitError(Exception):
+    pass
+
+def submit(command="./opa"):
+    """Simple function that runs the code.
+
+    This can be customised based on the particular environment
+    used to submit MPI or serial tasks. For simplicity, this
+    function calls opa.
+
+    By default, this program runs ``./opa``.
+
+    :returns: retcode
+    """
+    retcode = subprocess.call(shlex.split(command))
+    return retcode
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/test_nml.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/test_nml.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/ooo/test_nml.py	(revision 8732)
@@ -0,0 +1,248 @@
+#!/usr/bin/env python2.7
+import unittest
+import nml
+
+def version(vn):
+    # Converts module version string to int tuple as PEP-440
+    return tuple(map(int, vn.split(".")))
+
+HEADER = """
+!! =====================================
+!! An example FORTRAN 90 namelist
+!! =====================================
+&namex
+"""
+NOHEADER = "&namex\n"
+LOGIC = " ln_test = .TRUE. ! Comment\n"
+NUMERIC = " nn_off_idx = 1 2 3\n"
+NOSPACE = " nn_off_idx=1 2 3\n"
+NEGATIVE = " nn_off_idx = -1 -2 -3\n"
+LIST = " off_files = 'a.nc' 'b.nc' 'c.nc' ! Comment\n"
+STRING = ' contact = "example@nowhere.com" ! Comment\n'
+COMMENT = ' ! x = y '
+FOOTER = "/\n"
+NOFOOTER = "/"
+
+class TestNamelist(unittest.TestCase):
+    def setUp(self):
+        self.logic_text = "\n".join([HEADER, LOGIC, FOOTER])
+        self.numeric_text = "\n".join([HEADER, NUMERIC, FOOTER])
+        self.nospace_text = "\n".join([HEADER, NOSPACE, FOOTER])
+        self.neg_numeric_text = "\n".join([HEADER, NEGATIVE, FOOTER])
+        self.list_text = "\n".join([HEADER, LIST, FOOTER])
+        self.mix_text = "\n".join([HEADER, LIST, NUMERIC, FOOTER])
+        self.string_text = "\n".join([HEADER, STRING, FOOTER])
+        self.comment_text = "\n".join([HEADER, COMMENT, FOOTER])
+        self.no_trail_text = "\n".join([HEADER, NUMERIC, LIST, NOFOOTER])
+
+    def test_should_handle_footer(self):
+        data = nml.variables(self.no_trail_text)
+        truth = {"nn_off_idx": "1 2 3",
+                 "off_files": "'a.nc' 'b.nc' 'c.nc'"}
+        self.assertDictEqual(data, truth)
+
+    def test_mix_data(self):
+        data = nml.variables(self.mix_text)
+        truth = {"nn_off_idx": "1 2 3",
+                 "off_files": "'a.nc' 'b.nc' 'c.nc'"}
+        self.assertDictEqual(data, truth)
+
+    def test_comment_data(self):
+        data = nml.variables(self.comment_text)
+        truth = {}
+        self.assertDictEqual(data, truth)
+
+    def test_logical_data(self):
+        data = nml.variables(self.logic_text)
+        truth = {"ln_test": ".TRUE."}
+        self.assertDictEqual(data, truth)
+
+    def test_numeric_data(self):
+        data = nml.variables(self.numeric_text)
+        truth = {"nn_off_idx": "1 2 3"}
+        self.assertDictEqual(data, truth)
+
+    def test_nospace_data(self):
+        data = nml.variables(self.nospace_text)
+        truth = {"nn_off_idx": "1 2 3"}
+        self.assertDictEqual(data, truth)
+
+    def test_negative_numeric_data(self):
+        data = nml.variables(self.neg_numeric_text)
+        truth = {"nn_off_idx": "-1 -2 -3"}
+        self.assertDictEqual(data, truth)
+
+    def test_string_data(self):
+        data = nml.variables(self.string_text)
+        truth = {"contact": '"example@nowhere.com"'}
+        self.assertDictEqual(data, truth)
+
+    def test_list_data(self):
+        data = nml.variables(self.list_text)
+        truth = {"off_files": "'a.nc' 'b.nc' 'c.nc'"}
+        self.assertDictEqual(data, truth)
+
+    def test_replace_variable_comment(self):
+        FIXTURE = " x = 'y' ! comment \n"
+        RESULT = " x = 'z' ! comment \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    def test_replace_variable_no_comment(self):
+        FIXTURE = " x = 'y' \n"
+        RESULT = " x = 'z' \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    def test_replace_variable_no_space(self):
+        FIXTURE = " x='y' \n"
+        RESULT = " x='z' \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    def test_replace_variable_no_space_comment(self):
+        FIXTURE = " x='y' ! comment \n"
+        RESULT = " x='z' ! comment \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    @unittest.skipIf(version(nml.__version__) < (1, 0),
+                     "Not implemented in this version")
+    def test_multiline_variable_replace(self):
+        # As a result of a code review
+        FIXTURE = " x = 1, \n     2"
+        RESULT =  " x = 3, \n     4"
+        text = nml.replace(FIXTURE, {"x": [3,4]})
+        self.assertEqual(text, RESULT)
+
+class TestCombinedNamelists(unittest.TestCase):
+    def setUp(self):
+        self.minimal = """&namone
+/"""
+        self.blanks = """
+&namone
+/
+&namtwo
+/
+"""
+        self.contents = """
+&namone
+Content 1
+/
+&namtwo
+Content 2
+/
+"""
+        self.contents_slash = """
+&namone
+Content 1 ! Y/N
+/
+&namtwo
+Content 2
+/
+"""
+    def test_should_select_name_from_minimal_namelist(self):
+        data = nml.namelists(self.minimal)
+        result = {"namone": "&namone\n/"}
+        self.assertDictEqual(data, result)
+
+    def test_should_select_names(self):
+        data = nml.namelists(self.blanks)
+        result = {"namone": "&namone\n/",
+                  "namtwo": "&namtwo\n/"}
+        self.assertDictEqual(data, result)
+
+    def test_should_select_contents(self):
+        data = nml.namelists(self.contents)
+        result = {"namone": "&namone\nContent 1\n/",
+                  "namtwo": "&namtwo\nContent 2\n/"}
+        self.assertDictEqual(data, result)
+
+    def test_should_select_contents_with_forward_slash(self):
+        data = nml.namelists(self.contents_slash)
+        result = {"namone": "&namone\nContent 1 ! Y/N\n/",
+                  "namtwo": "&namtwo\nContent 2\n/"}
+        self.assertDictEqual(data, result)
+
+
+class TestToString(unittest.TestCase):
+    def setUp(self):
+        self.char_list = ["a.nc", "b.nc", "c.nc"]
+        self.num_list = [1, 3, 7]
+        self.char = "foo@bar.com"
+        self.num = 10
+        self.mixed_list = ["foo.nc", -1, True]
+        self.mixed_str_list = map(nml.quote, ["foo.nc", "-1", ".TRUE."])
+
+    def test_should_format_mixed_list(self):
+        data = nml.tostring(self.mixed_list)
+        result = "'foo.nc', -1, .TRUE."
+        self.assertEqual(data, result)
+
+    def test_should_format_numeric_list(self):
+        data = nml.tostring(self.num_list)
+        result = "1 3 7"
+        self.assertEqual(data, result)
+
+    def test_should_format_character_list(self):
+        data = nml.tostring(self.char_list)
+        result = "'a.nc', 'b.nc', 'c.nc'"
+        self.assertEqual(data, result)
+
+    def test_should_format_strings(self):
+        data = nml.tostring(self.char)
+        result = "'%s'" % (self.char,)
+        self.assertEqual(data, result)
+
+    def test_should_format_numbers(self):
+        data = nml.tostring(self.num)
+        result = str(self.num)
+        self.assertEqual(data, result)
+
+    def test_should_not_format_numeric_string(self):
+        input = "3.14159"
+        self.assertEqual(nml.tostring(input), input)
+
+    def test_should_format_logicals(self):
+        data = nml.tostring(True)
+        result = ".TRUE."
+        self.assertEqual(data.upper(), result)
+
+    def test_should_not_format_string_of_list_data(self):
+        for input in ["1 2 3", "1, 2, 3", ".TRUE. .FALSE."]:
+            case = nml.tostring(input)
+            self.assertEqual(case, input)
+
+    def test_should_treat_mixed_numeric_character_data_as_character(self):
+        case = nml.tostring(self.mixed_str_list)
+        result = "'foo.nc', '-1', '.TRUE.'"
+        self.assertEqual(case, result)
+
+class TestUpdateNamelist(unittest.TestCase):
+    def setUp(self):
+        self.empty = """
+&namone
+/
+"""
+        self.single = """
+&namone
+   x = 'y'
+/
+"""
+        self.single_update = """
+&namone
+   x = 'z'
+/
+"""
+
+    def test_should_append_new_variable_to_namelist(self):
+        trial = nml.update("namone", self.empty, {"x": "'y'"})
+        self.assertEqual(trial, self.single)
+
+    def test_should_update_existing_variables(self):
+        trial = nml.update("namone", self.single, {"x": "'z'"})
+        self.assertEqual(trial, self.single_update)
+
+if __name__ == '__main__':
+    unittest.main()
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/setup.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/setup.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/OOO/setup.py	(revision 8732)
@@ -0,0 +1,9 @@
+from distutils.core import setup
+setup(name='Offline observation operator',
+      version='0.1',
+      description='NEMO Offline observation operator',
+      author='Andrew Ryan',
+      author_email='andrew.ryan@metoffice.gov.uk',
+      packages=['ooo',],
+      scripts=['bin/ooo'],
+      )
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README	(revision 8732)
@@ -0,0 +1,12 @@
+dataplot.pro - IDL widget based program to read in netcdf feedback and data
+files and plot observation and background values.
+
+example calls:
+
+dataplot,filenamearray
+dataplot,filenamearray,/batchplot,/gif
+dataplot,filenamearray,/batchplot,/ps
+
+use
+
+man,'dataplot' in idl for more information
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 8732)
@@ -0,0 +1,212 @@
+;+
+PRO colorbar_idl, datain, colors, lablevels, datalevels, data=data, $
+	textcolor=textcolor, mincolor=mincolor, position=position
+;--------------------------------------------------------------------
+; datain - gives the range of values which are represented by colors
+; colors - color values
+; lablevels - label levels
+;
+; Author:  D. J. Lea    Nov 2008
+;--------------------------------------------------------------------
+
+; keep current graphics keywords
+
+psave=!p
+xsave=!x
+ysize=!y
+
+	if (n_elements(mincolor) eq 3) then $
+	      TVLCT,mincolor(0),mincolor(1),mincolor(2),0 
+
+    mx=max(datain,min=mn)
+
+	normal=1
+	if (keyword_set(data)) then normal=0
+
+    
+    if (keyword_set(data)) then begin				; data coords
+    y1 = !y.crange(0)-0.1*(!y.crange(1)-!y.crange(0))     
+    y2 = !y.crange(0)-0.05*(!y.crange(1)-!y.crange(0))
+    x1 = !x.crange(0)+0.1*(!x.crange(1)-!x.crange(0))
+    x2 = !x.crange(0)+0.9*(!x.crange(1)-!x.crange(0))
+    endif else begin						; normal coords
+    y1 = !y.window(0)-0.11*(!y.window(1)-!y.window(0))     
+    y2 = !y.window(0)-0.05*(!y.window(1)-!y.window(0))
+;;    y1 = !y.window(0)+0.05*(!y.window(1)-!y.window(0))     
+;;    y2 = !y.window(0)+0.1*(!y.window(1)-!y.window(0))
+    x1 = !x.window(0)+0.076*(!x.window(1)-!x.window(0))
+    x2 = !x.window(0)+0.924*(!x.window(1)-!x.window(0))
+    endelse
+
+    if (n_elements(position) eq 4) then begin
+    	coords=position
+    endif else begin
+	coords=[x1,y1,x2,y2]
+    endelse
+
+    print,'coords: ',coords
+	print, 'normal: ',normal, ' data: ',keyword_set(data)
+
+;    nb = N_ELEMENTS(colors)               
+;    x=coords(0)+(coords(2)-coords(0))*findgen(nb+1)/nb
+;    
+;    FOR i=0,nb-1 DO BEGIN
+;;    print,colors(i)
+;    polyfill, transpose([[x(i),x(i+1),x(i+1),x(i),x(i)],$
+;      [coords(1),coords(1),coords(3),coords(3),coords(1)]]),$
+;      color=colors(i), data=data, normal=normal
+;    ENDFOR
+
+;Position is always in normal units will need to do a conversion if 
+; data units required...
+
+    fill=0
+    cell_fill=1
+
+    maxdat=mx
+    mindat=mn
+    if (n_elements(datalevels) gt 0) then begin
+	    maxdat=max(datalevels,min=mindat)
+;            mindat=mindat+(1./!d.table_size)*(maxdat-mindat)
+;            print,'datalevels ',datalevels
+    endif
+
+; fix to prevent zero contour range
+    if (maxdat eq mindat) then begin
+        if (maxdat eq 0) then begin
+    	maxdat = maxdat + 1e-20
+        mindat = mindat - 1e-20
+        endif else begin
+        maxdat = maxdat * 1.01
+        mindat = mindat * 0.99
+        if (maxdat lt mindat) then begin
+        	tmp = mindat
+                mindat = maxdat
+                maxdat = tmp
+        endif
+        endelse
+    endif
+    
+    array1d=(findgen(!d.table_size+1))/!d.table_size*(maxdat-mindat)+mindat
+;    array1d=(findgen(!d.table_size+10)-10)/!d.table_size*(maxdat-mindat)+mindat
+
+	print,'!d.table_size ',!d.table_size
+
+;	print,'array1d ',array1d
+        print,'min array1d ',min(array1d), max(array1d)
+        print,'datain ',datain
+        print,'mx ',mx,' mn ',mn
+
+    if (n_elements(datalevels) gt 0) then print, 'datalevels ', datalevels
+        
+    array2d=array1d#replicate(1,2)
+    if (n_elements(datalevels) lt 2) then datalevels=array1d
+    
+;    print, 'datalevels ', datalevels
+;	print,'cell_fill ',cell_fill
+
+    TVLCT, R, G, B, /get
+    TVLCT,R(1),G(1),B(1),0        ; bodge fix for wrong black contour   
+
+	if (n_elements(data) gt 0) then print,'data = ',data
+        if (n_elements(normal) gt 0) then print,'normal = ',normal
+        print,coords
+
+; draw a few times to remove gaps
+    nel=n_elements(datalevels)
+    print, 'datalevels ',datalevels(0), datalevels(nel-1), nel
+    print, 'array2d ',min(array2d), max(array2d)
+    if (datalevels(0) lt datalevels(nel-1)) then begin 
+    for i=0,2 do begin    
+    contour, array2d, levels=datalevels, fill=fill, cell_fill=cell_fill, $
+    POSITION=coords, /noerase, xstyle=5, ystyle=5, data=data, normal=normal
+    endfor
+    endif
+
+    TVLCT,R(0),G(0),B(0),0 
+
+    numlablevels=n_elements(lablevels)
+    sigfig=1
+	strlabs=strarr(numlablevels)
+
+	repeat begin
+        widstr=strtrim(string(sigfig+8),2)
+; output 2 significant figures except if 0.
+
+        for i = 0, numlablevels-1 do begin
+        format='(g'+widstr+'.'+strtrim(string(sigfig),2)+')'
+	strlabs(i)=strcompress(string(lablevels(i),format=format),/remove_all)
+
+;	print,i,'.',strlabs(i),'.',format
+
+        if (strmid(strlabs(i),0,1) eq '0' or strmid(strlabs(i),0,2) eq '-0') then begin
+        	format='(g'+widstr+'.'+strtrim(string(sigfig-1),2)+')'
+	        strlabs(i)=strcompress(string(lablevels(i),format=format),/remove_all) 
+;                print,i,'.',strlabs(i),'.',format               
+        endif
+
+;	print,i,'.',strlabs(i),'.',format 
+
+; trim out spaces
+	strlabs(i)=strtrim(strlabs(i),2)
+       
+        strtemp=strlabs(i)
+; strip off last two characters if there is 0 after the decimal place
+; with a number thereafter
+        ptpos=strpos(strtemp,'.0')
+        len=strlen(strtemp)
+;        if ptpos gt 0 then print,ptpos,len
+        if ptpos gt 0 and len-2 ge ptpos then begin
+		strlabs(i)=strmid(strtemp,0,len-1)		        
+        endif
+
+;if the remaining last character is a point (.) then get rid of it
+	ptpos=strpos(strlabs(i),'.')
+        len=strlen(strlabs(i))
+;	print,ptpos, len
+	if ptpos gt 0 and ptpos eq len-1 then begin
+        	strlabs(i)=strmid(strlabs(i),0,len-1)
+        endif
+        
+        endfor
+;        print,strlabs
+;        print,strlen(strlabs)
+        sigfig=sigfig+1
+        whe=where(strpos(strlabs,'e') gt 0, numexps)
+;        print,'whe ',whe, numexps
+; all labels should be unique
+; should be all exps or none 
+; give up if sigfigs 255       
+	endrep until (n_elements(unique(strlabs)) eq numlablevels $
+        	and (numexps eq 0 or numexps eq numlablevels) $
+        	or sigfig gt 255) 
+
+    pcharsize=!p.charsize
+    if (pcharsize lt 1) then pcharsize=1
+;    tolx=0.01*pcharsize*(!x.crange(1)-!x.crange(0))
+    tolx=0.01*(x2-x1)
+    
+    ypos = y1-0.02*pcharsize*(!y.crange(1)-!y.crange(0))
+    for i = 0, numlablevels-1 do begin
+;      xpos = x1 + float(i)/float(n_elements(lablevels)-1)*(x2-x1)
+	xpos = x1 + (lablevels(i)-mn)/(mx-mn)*(x2-x1)		; position labels correctly relative 
+
+	if (xpos ge x1-tolx and xpos le x2+tolx) then begin 	; don't print any labels off the edge 
+
+;      xyouts, xpos, ypos, strcompress(string(lablevels(i),format='(f7.2)'),/remove_all), $
+;              color=!d.table_size-1, data=data, normal=normal, align=0.5
+
+	if (n_elements(textcolor) eq 3) then $
+	      TVLCT,textcolor(0),textcolor(1),textcolor(2),0 
+;	print,'xyouts ',xpos, ypos, ' ',strlabs(i)
+        xyouts, xpos, ypos, strlabs(i), data=data, normal=normal, align=0.5 
+	endif
+
+    endfor
+
+; restore graphics keywords
+!p=psave
+!x=xsave
+!y=ysize
+                    
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro	(revision 8732)
@@ -0,0 +1,4517 @@
+;+----------------------------------------------------------------------------------------
+; dataplot.pro
+; IDL widget based plotting routine for plotting observation and background values
+;
+; Author: D. J. Lea     -  Feb 2008
+;
+;+----------------------------------------------------------------------------------------
+;example calls:
+;
+;dataplot,filenamearray
+;dataplot,filenamearray,/batch,/gif			; plots data directly to a gif
+;dataplot,filenamearray,/batch,/ps			; plots data directly to a ps
+;dataplot,filenamearray,/batch,area=area            ; area 4 element array or descriptive string
+;dataplot, longitude, latitude, deparr, dayarr, valarr, bkgarr
+;dataplot, [longitude, latitude, deparr, dayarr, valarr, bkgarr], rmdi=rmdi, filename=filename 
+;
+;optional keywords
+;area			descriptive string or array [minlon,minlat,maxlon,maxlat]
+;typeplot=1-5 		plot obs-bkg or obs bkg etc 
+;alldays=1 		plot all days otherwise just plot first day    
+;depths			[depmin,depmax] in metres
+;showmdt		plot mdt
+;obstypeselect		string array of selected obs types to plot 
+;printobstypes		keyword to print unique obs types to the terminal
+;
+;+-----------------------------------------------------------------------------------------
+; Note the upper two slider bars control the depth range
+; the lower two slider bars control the day range
+;------------------------------------------------------------------------------------------
+
+
+; Event-handling procedure. 
+PRO dataplot_event, ev 
+ 
+  ; Retrieve the anonymous structure contained in the user value of 
+  ; the top-level base widget.  
+ 
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+
+;  print,uval
+
+;  print,'event'
+;  print,stash.depmin
+
+;  position = [!X.Window[0], !Y.Window[0], !X.Window[1], !Y.Window[1]]
+;  print,position 
+;  xsize = (position(2) - position(0)) * !D.X_VSIZE
+;  ysize = (position(3) - position(1)) * !D.Y_VSIZE
+;  xstart = position(0) * !D.X_VSIZE
+;  ystart = position(1) * !D.Y_VSIZE
+;  print,xsize,ysize,xstart,ystart
+  
+  ; If the event is generated in the draw widget, update the 
+  ; label values with the current cursor position and the value 
+  ; of the data point under the cursor. Note that since we have 
+  ; passed a pointer to the image array rather than the array 
+  ; itself, we must dereference the pointer in the 'image' field 
+  ; of the stash structure before getting the subscripted value. 
+ 
+  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_DRAW') THEN BEGIN 
+	xdev= ev.X 
+	ydev= ev.Y
+        
+;        print, 'xdev ',xdev, ' ydev ',ydev
+        
+; convert the pointer position to a data position
+  	arr=CONVERT_COORD( xdev, ydev, /device, /to_data) 
+  	xdata=arr(0)
+	ydata=arr(1)
+
+;	print, xdata , ydata        
+        
+;        print, 'xdev: ',xdev,' ydev: ',ydev,' xdata: ',xdata, ' ydata: ',ydata
+;    WIDGET_CONTROL, stash.label1, $ 
+;      SET_VALUE='X position: ' + STRING(xdata) 
+;    WIDGET_CONTROL, stash.label2, $ 
+;      SET_VALUE='Y position: ' + STRING(ydata) 
+;;    WIDGET_CONTROL, stash.label3, $ 
+;;      SET_VALUE='Value: ' + $ 
+;;      STRING((*stash.imagePtr)[ev.X, ev.Y], FORMAT='(Z12)') 
+;    WIDGET_CONTROL, stash.label3, $ 
+
+
+   ; What kind of event is this?
+
+;eventTypes = ['DOWN', 'UP', 'MOTION']
+;0 1 2
+;thisEvent = ev.type
+
+;print, 'ev.type ',ev.type
+
+CASE ev.type OF
+   0: BEGIN
+; dragbox start
+   print, 'down ',xdev,ydev, xdata, ydata
+         ; Turn motion events on for the draw widget.
+
+      Widget_Control, stash.draw, Draw_Motion_Events=1
+
+	; dragbox
+         ; Create a pixmap. Store its ID. Copy window contents into it.
+
+      Window, /Free, /Pixmap, XSize=stash.im_size(1), YSize=stash.im_size(2)
+      stash.pixID = !D.Window
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.drawID]
+;      WSet, stash.drawID
+
+	print,stash.im_size(0), stash.im_size(1), stash.im_size(2), stash.pixID, stash.drawID
+      
+      stash.xcorn=xdev
+      stash.ycorn=ydev
+      
+      stash.xdatacorn=xdata
+      stash.ydatacorn=ydata
+   
+;   RETURN
+   ENDCASE
+   1: BEGIN
+; dragbox close
+   print, 'up ',xdev,ydev, xdata, ydata
+         ; Turn draw motion events off. Clear any events queued for widget.
+
+      Widget_Control, stash.draw, Draw_Motion_Events=0, Clear_Events=1
+
+       WSet, stash.drawID
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.pixID]
+      WDelete, stash.pixID
+           
+      ; zoom in
+
+; dragbox   
+; avoid zooming if no dragging has occurred
+	pixdiffx = min([abs(stash.xcorn-xdev),abs(stash.ycorn-ydev)])       
+        print, '** Pixdiffx ',pixdiffx, stash.xcorn-xdev, stash.ycorn-ydev
+        if (pixdiffx gt 1 and finite(xdata) and finite(ydata)) then begin
+
+   	minxdata = min([stash.xdatacorn, xdata], max=maxxdata)
+        minydata = min([stash.ydatacorn, ydata], max=maxydata)
+
+
+	if (minxdata ge -180 and maxxdata le 360 and minydata ge -90 and maxydata le 90) then begin
+
+                stash.xrange=[minxdata,maxxdata]
+        	stash.yrange=[minydata,maxydata]
+                
+	        plotpoints,stash
+        endif
+        endif	
+           
+;   RETURN
+   ENDCASE
+   2: BEGIN
+; drag box motion
+;   print, 'motion: ',ev.x, ev.y
+
+      WSet, stash.drawID
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.pixID]
+
+   
+   sx = stash.xcorn
+   sy = stash.ycorn
+
+      PlotS, [sx, sx, xdev, xdev, sx], [sy, ydev, ydev, sy, sy], /Device, $
+          Color=!p.color
+;         Color=255
+   
+   ENDCASE
+   
+;   RETURN
+   7: begin
+		print,'mouse wheel event ',ev.clicks
+		if (ev.clicks eq 1 or ev.clicks eq -1) then begin
+		print,'zoom in/out'
+
+		print,'stash.depmin ',stash.depmin
+
+		print,'xdata ',xdata
+                
+                if (finite(xdata) and finite(ydata)) then begin
+
+; make an adjustment if we're in the Pacific
+	xrange=stash.xrange
+        typeproj=stash.typeproj
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xdata lt 0) then xdata=xdata+360 
+       
+
+		oxrange=stash.xrange
+		oyrange=stash.yrange
+
+		dataplot_zoom, stash, xdata, ydata, ev.clicks
+
+; plot only if a change has been made
+		if (stash.xrange(0) ne oxrange(0) or stash.yrange(0) ne oyrange(0) $
+                    or stash.xrange(1) ne oxrange(1) or stash.yrange(1) ne oyrange(1)) then $
+			plotpoints, stash
+
+		endif
+                
+                endif
+
+   ENDCASE
+ENDCASE
+
+
+
+
+
+
+
+
+;      SET_VALUE='Value: ' + STRING(ev.release) 
+
+;	if(ev.release eq 1) then begin
+;		print,'left click - search for nearest point'
+	if(ev.release eq 1 or ev.release eq 4) then begin		; mouse click
+
+; might want a generalised point selection routine
+; for this routine and for plotpoints
+
+		print,'xdata ',xdata, ' ydata ',ydata
+                print,'xdev ',xdev, 'ydev ',ydev
+
+		if (finite(xdata) and finite(ydata)) then begin
+
+		print, 'finite'
+
+		xarr1=stash.xarr
+		yarr1=stash.yarr
+		dep1=stash.dep
+		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+                obstypes1=stash.obstypes
+ 		xrange=stash.xrange
+		yrange=stash.yrange
+		xs=xrange(1)-xrange(0)
+		ys=yrange(1)-yrange(0)
+		rmdi=stash.rmdi
+;                if (stash.salinity eq 0) then begin
+;		  obs1=stash.obs
+;		  bkg1=stash.bkg
+;                 qcarr1=stash.qcarr
+;                endif else begin
+;		  obs1=stash.obs2
+;		  bkg1=stash.bkg2
+;                 qcarr1=stash.qcarr2
+;		endelse                		
+                typeproj=stash.typeproj
+
+; make an adjustment if we're in the Pacific
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xdata lt 0) then xdata=xdata+360 
+
+; set reasonable dist criteria
+
+		distmax=(xs/100.)^2+(ys/100.)^2
+;		print,'distmax ',distmax
+
+
+		selpoints,stash,lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr 
+
+; get max min daysel
+		mindaysel=min(daysel, max=maxdaysel)
+
+;		print, 'selpoints ',obnumsel
+
+		if (n_elements(lonsel) gt 0) then begin
+		dist=((lonsel-xdata)^2+(latsel-ydata)^2)
+		res=min(dist,whd)		; whd is the minumum dist point index
+
+;		print,lonsel
+
+	xselstr=""
+	yselstr=""
+	valselstr=""
+	qcselstr=""
+	datestr=""
+        obnumselstr=""
+        mindatestr=""
+        maxdatestr=""
+
+;	print,'whd(0) ',whd(0)
+;        print,'res ',res, ' distmax ',distmax
+
+	obstypstr=""		
+	if (whd(0) gt -1 and res lt distmax) then begin		
+	xsel=lonsel(whd)
+	ysel=latsel(whd)
+ 
+ 	print,'xsel ',xsel,' ysel ',ysel       
+ ; make an adjustment if we're in the Pacific
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xsel gt 180) then xsel=xsel-360 
+               
+	valsel=innovsel(whd)
+	qcsel=qcsel(whd)
+	datesel=daysel(whd)
+	obstypsel=obstypsel(whd)
+	obnumsel=obnumsel(whd)
+
+	xselstr=string(xsel)
+	yselstr=string(ysel)
+	valselstr=string(valsel)	
+	qcselstr=string(qcsel)
+;	datestr=string(datesel)
+	obstypstr=string(obstypsel(0))
+        obnumselstr=string(obnumsel(0))
+        print,'datesel(0) ',datesel(0) 
+        print,'obnumsel(0) ',obnumsel(0)
+	jul_to_dtstr,datesel(0),datestr
+        jul_to_dtstr,mindaysel,mindatestr
+        jul_to_dtstr,maxdaysel,maxdatestr
+   
+	if (ev.release eq 4) then begin
+        
+        	print,'ev.release ',ev.release
+
+;		window
+		wh=where(xarr1 eq xsel and yarr1 eq ysel)
+                print,'xsel ',xsel
+;                print,'xarr1 ',xarr1
+		dep2=dep1(wh)
+
+		if (wh(0) gt -1) then begin
+		if (stash.density eq 0) then begin
+
+         if (stash.salinity eq 0) then begin
+;                  print,'salinity eq 0'
+            obs2=stash.obs(wh)
+		      bkg2=stash.bkg(wh)
+            qcarr2=stash.qcarr(wh)
+         endif else begin
+;                  print,'salinity eq 1'
+		      obs2=stash.obs2(wh)
+		      bkg2=stash.bkg2(wh)
+            qcarr2=stash.qcarr2(wh)
+		   endelse
+
+      endif else begin
+
+         if (stash.filetype eq 'CRT') then begin
+
+            bkgU=stash.bkg(wh)
+            bkgV=stash.bkg2(wh)
+            bkg2=sqrt(bkgU*bkgU + bkgV*bkgV)
+
+            obsU=stash.obs(wh)
+            obsV=stash.obs2(wh)
+            obs2=sqrt(obsU*obsU + obsV*obsV)
+
+            qcarr2=stash.qcarr(wh)
+
+         endif else begin
+
+;            print,'density eq 1'
+            bkgt=stash.bkg(wh)
+            bkgs=stash.bkg2(wh)
+            obst=stash.obs(wh)
+            obss=stash.obs2(wh)                  
+;		       obs2=obst+obss
+;            bkg2=bkgt+bkgs
+		      obs2=eos_nemo(obst,obss)
+            bkg2=eos_nemo(bkgt,bkgs)
+            wh2=where(bkgt eq rmdi or bkgs eq rmdi)
+            if (wh2(0) gt -1) then begin
+               obs2(wh2)=rmdi
+               bkg2(wh2)=rmdi
+            endif
+            qcarr2=max([[stash.qcarr(wh)],[stash.qcarr2(wh)]],dim=2)                                		
+
+         endelse
+
+		endelse
+
+;		val2=abs(obs1(wh)-bkg1(wh))
+		val2=abs(obs2-bkg2)
+;		obs2=obs1(wh)
+;		bkg2=bkg1(wh)
+		obstype2=obstypes1(wh)
+;                qcarr2=qcarr1(wh)
+                dayarr2=dayarr(wh)
+;		val2=sqrt(val1(wh)^2)
+		
+;		print,'val2 ',val2(wh2)
+;		print,'dep2 ',dep2(wh2)
+;		plot,val2(wh2),dep2(wh2),ystyle=1,xstyle=1
+
+		profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi, salinity=stash.salinity, $
+                	plot_bad_obs=stash.plot_bad_obs, white_on_black=stash.white_on_black, coltable=stash.coltable, $
+                        	depmax=stash.depmax, depmin=stash.depmin
+
+
+; set graphics back to main window
+;  		WSET, stash.drawID
+ 		print,'ev release'
+		plotpoints,stash
+                
+                endif     ; wh(0)>-1
+
+	endif			; ev.release 4 (right mouse)
+        endif         
+	endif			; left or right mouse click
+	
+    WIDGET_CONTROL, stash.label1, $ 
+      SET_VALUE=stash.labt1 + strtrim(xselstr,1) 
+    WIDGET_CONTROL, stash.label2, $ 
+      SET_VALUE=stash.labt2 + strtrim(yselstr,1) 
+     WIDGET_CONTROL, stash.label3, $ 
+      SET_VALUE=typestr+': ' + strtrim(valselstr,1) 
+     WIDGET_CONTROL, stash.label4, $ 
+      SET_VALUE=stash.labt4 + strtrim(qcselstr,1) 
+     WIDGET_CONTROL, stash.label5, $
+      SET_VALUE=stash.labt5 + strtrim(datestr,1)
+     WIDGET_CONTROL, stash.label6, $ 
+      SET_VALUE=stash.labt6 + strtrim(valselstr,1) 
+;     WIDGET_CONTROL, stash.label7, $ 
+;      SET_VALUE=stash.labt7 + strtrim(string(innovsd),1)
+     WIDGET_CONTROL, stash.label8, $
+      SET_VALUE=stash.labt8 + strtrim(obstypstr,1)
+     WIDGET_CONTROL, stash.label9, $
+      SET_VALUE=stash.labt9 + strtrim(obnumselstr,1)
+     WIDGET_CONTROL, stash.label10, $
+      SET_VALUE=stash.labt10 + string(mindatestr) + ' ' + string(maxdatestr)
+		
+	endif else begin			; not finite
+
+	print, 'not finite'
+        
+; check for colorbar click
+		if (ydev lt 80) then begin        
+ 	        toplevel=stash.base
+	        fmx=stash.fmx
+        	fmn=stash.fmn
+      	        mx=stash.mx
+        	mn=stash.mn
+   		inputmxmnwindow, fmx, fmn, mx, mn, stash.rmdi, toplevel, success
+		if (success eq 1) then begin
+        	stash.fmx=fmx
+        	stash.fmn=fmn
+        	plotpoints,stash
+        	endif
+                endif
+        
+        endelse			; finite
+
+	endif
+
+		
+      
+;      print,tag_names(ev)
+;      print,ev.id
+;      print,ev.top
+;      print,ev.handler
+;      print,ev.type
+;      print,ev.press
+;      print,ev.release
+;      print,ev.clicks
+;      print,ev.modifiers
+;      print,ev.ch
+;      print,ev.key
+       
+   ENDIF                   ; end of widget draw events
+ 
+  ; If the event is generated in a button, destroy the widget 
+  ; hierarchy. We know we can use this simple test because there 
+  ; is only one button in the application. 
+ 
+
+;  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_COMBOBOX') THEN BEGIN
+;   IF (uval eq 'LEVELLIST') THEN BEGIN
+
+   IF (uval eq 'LEVELCHOICE') THEN BEGIN
+
+	stash.depmin=ev.value
+
+		print,'levelchoice'
+	print, 'stash.depmin: ',stash.depmin
+	print, 'stash.depmax: ',stash.depmax
+
+	if (stash.depmin ge stash.depmax) then begin
+		stash.depmax=stash.depmin
+	if (stash.depmax gt stash.depmaxl) then stash.depmax=stash.depmaxl
+
+;set sliderb position
+	WIDGET_CONTROL, stash.sliderb, set_value=stash.depmax
+
+	endif
+	
+
+		plotpoints, stash
+
+		
+;		   print,ev.index,widget_info(ev.id,/combobox_gettext)
+  
+  ENDIF
+
+   IF (uval eq 'LEVELCHOICEB') THEN BEGIN
+
+	stash.depmax=ev.value
+
+		print,'levelchoiceb'
+	print, 'stash.depmin: ',stash.depmin
+	print, 'stash.depmax: ',stash.depmax
+
+	if (stash.depmax le stash.depmin) then begin
+		stash.depmin=stash.depmax
+	if (stash.depmin lt stash.depminl) then stash.depmin=stash.depminl
+
+;set sliderb position
+	WIDGET_CONTROL, stash.slider, set_value=stash.depmin
+
+	endif
+	
+
+		plotpoints, stash
+
+		
+;		   print,ev.index,widget_info(ev.id,/combobox_gettext)
+  
+  ENDIF
+
+
+  IF (uval eq 'DATERANGE1') THEN BEGIN
+
+	odaymin=stash.daymin
+        odaymax=stash.daymax
+  
+  	stash.daymin=ev.value
+;	print, 'ev.drag ',ev.drag
+
+; set slider label
+	jul_to_dtstr,stash.daymin,dayminstr, /notime
+        WIDGET_CONTROL, stash.slider1label, $ 
+        SET_VALUE='min date: '+dayminstr 
+
+	if (stash.daymin ge stash.daymax) then begin
+;		stash.daymax=stash.daymin+1
+		stash.daymax=stash.daymin
+	if (stash.daymax gt stash.daymaxl) then stash.daymax=stash.daymaxl
+
+;set slider2 position
+	WIDGET_CONTROL, stash.slider2, set_value=stash.daymax
+; set slider 2 label
+	jul_to_dtstr,stash.daymax,daymaxstr, /notime
+        WIDGET_CONTROL, stash.slider2label, $ 
+        SET_VALUE='max date: '+daymaxstr 
+	
+        
+	endif
+	
+	print,'daterange1'
+;	if (ev.drag eq 0) then
+        if (stash.daymin ne odaymin or stash.daymax ne odaymax) then plotpoints,stash
+	
+  ENDIF
+  IF (uval eq 'DATERANGE2') THEN BEGIN
+
+	odaymin=stash.daymin
+        odaymax=stash.daymax
+  
+  	stash.daymax=ev.value
+
+; set slider label
+	jul_to_dtstr,stash.daymax,daymaxstr, /notime
+        WIDGET_CONTROL, stash.slider2label, $ 
+        SET_VALUE='max date: '+daymaxstr 
+
+	if (stash.daymax le stash.daymin) then begin
+;		stash.daymin=stash.daymax-1
+		stash.daymin=stash.daymax
+	if (stash.daymin lt stash.dayminl) then stash.daymin=stash.dayminl
+
+;set slider1 position
+	WIDGET_CONTROL, stash.slider1, set_value=stash.daymin
+; set slider 2 label
+	jul_to_dtstr,stash.daymin,dayminstr, /notime
+        WIDGET_CONTROL, stash.slider1label, $ 
+        SET_VALUE='min date: '+dayminstr 
+
+	endif
+	
+	print,'daterange2'
+;	if (ev.drag eq 0) then 
+        if (stash.daymin ne odaymin or stash.daymax ne odaymax) then plotpoints,stash
+
+  ENDIF
+  
+	IF (uval eq "RADIO1") THEN BEGIN
+		print,'uval eq RADIO1'
+		stash.typeplot=1
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO2") THEN BEGIN
+		print,'uval eq RADIO2'	
+		stash.typeplot=2
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO3") THEN BEGIN
+		print,'uval eq RADIO3'
+		stash.typeplot=3
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO4") THEN BEGIN
+		print,'uval eq RADIO4'
+		stash.typeplot=4
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO5") THEN BEGIN
+		print,'uval eq RADIO5'
+		stash.ombtypeplot=1
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO6") THEN BEGIN
+		print,'uval eq RADIO6'
+		stash.ombtypeplot=2
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO7") THEN BEGIN
+		print,'uval eq RADIO7'
+		stash.ombtypeplot=3
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO01") THEN BEGIN
+		print,'uval eq RADIO01'
+		stash.typeproj=1
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO02") THEN BEGIN
+		print,'uval eq RADIO02'	
+		stash.typeproj=2
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO03") THEN BEGIN
+		print,'uval eq RADIO03'
+		stash.typeproj=3
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO001") THEN BEGIN
+		print,'uval eq RADIO001 ev.select: ',ev.select
+		stash.plot_bad_obs=ev.select
+;		stash.xrange=stash.xrangedef
+;		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+
+
+	IF (uval eq "RADIOSAL") THEN BEGIN
+	    print,'uval eq RADIOSAL ev.select: ',ev.select
+	    salinity=ev.select
+;            if (stash.filetype eq "Prof" or stash.filetype eq "feedback") then begin 
+	       stash.salinity=salinity
+  	       plotpoints,stash
+;	    endif
+	ENDIF
+
+
+	IF (uval eq "RADIODENSITY") THEN BEGIN
+            print,'uval eq RADIODENSITY ev.select: ',ev.select
+            density=ev.select
+            if (stash.filetype eq "CRT") then stash.salinity=0
+;            if (stash.filetype eq "Prof" or stash.filetype eq "CRT") then begin
+               stash.density=density  
+       	      plotpoints,stash
+;	         endif
+	ENDIF
+
+
+  IF (uval eq "PRINT") THEN BEGIN
+  	ps=1
+	eps=0
+	landscape=1
+  	pr2,file=stash.outfile+'.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  	plotpoints,stash
+	prend2,/view
+  ENDIF
+
+  IF (uval eq "SAVE") THEN BEGIN
+
+	thisDevice = !D.Name
+        psave=!p
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[800,512], decomposed=0
+        Device, Set_Resolution=stash.picsize, decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+
+;	if (stash.white_on_black eq 0) then begin
+;; flip background and foreground color
+;                        pcolor=!p.color
+;                        pbackground=!p.background
+;                        !p.color=pbackground
+;                        !p.background=pcolor
+;
+;        endif
+;        print,'!p.color,!p.background ',!p.color,!p.background
+
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+; plot data
+  	plotpoints,stash
+	snapshot = TVRD()
+        WRITE_GIF,stash.outfile+'.gif',snapshot, r, g, b
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+;        !p.charsize=0.0
+	!p=psave
+        
+        spawn,'xv '+stash.outfile+'.gif'
+
+  ENDIF
+
+;Area selection
+
+  xrange=stash.xrange
+  yrange=stash.yrange
+  areasel,uval,xrange,yrange,success, toplevel=stash.base
+  if (success eq 1) then begin
+  stash.xrange=xrange
+  stash.yrange=yrange
+  plotpoints,stash
+  endif
+
+      
+  IF (uval eq "Timeseries") THEN BEGIN
+  	stash.numtimeseries=0
+        timeserieswindow,stash
+; set graphics back to main window
+;  		WSET, stash.drawID
+;; 		print,'ev release'
+;;		plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "Num timeseries") THEN BEGIN
+	stash.numtimeseries=1  
+        timeserieswindow,stash
+; set graphics back to main window
+;  		WSET, stash.drawID
+ 		print,'ev release'
+		plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "TS diagram") THEN BEGIN
+        tsdiagramwindow,stash
+; set graphics back to main window
+;  	WSET, stash.drawID
+ 	print,'ev release'
+	plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "Worst points") THEN BEGIN
+        worstpointswindow,stash
+  ENDIF
+
+  IF (uval eq "Filter type") THEN BEGIN
+  	filterwindow, stash
+  ENDIF
+
+  IF (uval eq "Low res map") THEN BEGIN
+;        stash.map_file=""
+        stash.hires_map=0       
+        Widget_Control, stash.loresmap, Set_Button=1
+        Widget_Control, stash.hiresmap, Set_Button=0
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Hi res map") THEN BEGIN
+;        stash.map_file="/opt/ukmo/wave/ukmo/data/map_europe.xdr"
+	stash.hires_map=1
+        Widget_Control, stash.loresmap, Set_Button=0
+        Widget_Control, stash.hiresmap, Set_Button=1
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Plot only bad obs") THEN BEGIN
+  	stash.plot_only_bad_obs = 1-stash.plot_only_bad_obs
+        Widget_Control, stash.pltonbado, Set_Button=stash.plot_only_bad_obs
+        if (stash.plot_bad_obs eq 1) then plotpoints,stash
+  ENDIF
+
+  IF (uval eq "White on black") THEN BEGIN
+        print,uval,' !p.color,!p.background ',!p.color,!p.background
+  	stash.white_on_black = 1-stash.white_on_black
+        Widget_Control, stash.whtonblack, Set_Button=stash.white_on_black
+;        IF (!d.name eq 'X') then begin 
+;                	WSET, stash.drawID
+;; flip background and foreground color
+;                        pcolor=!p.color
+;                        pbackground=!p.background
+;                        !p.color=pbackground
+;                        !p.background=pcolor
+
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+			
+                        plotpoints,stash
+;	endif
+
+
+  ENDIF
+
+
+  IF (uval eq "Square psym") THEN BEGIN
+        stash.sym=1
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "Round psym") THEN BEGIN
+        stash.sym=2
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "incsym") THEN BEGIN
+  	stash.symscale=stash.symscale*1.41421
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "decsym") THEN BEGIN
+  	stash.symscale=stash.symscale/1.41421
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "resetsym") THEN BEGIN
+  	stash.symscale=1.0
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "vertgrad") THEN BEGIN
+  	stash.vertgrad=1-stash.vertgrad
+        Widget_Control, stash.vertgradmenu, Set_Button=stash.vertgrad
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Info") THEN BEGIN
+         infowindow
+  ENDIF
+
+  IF (uval eq "input max/min") THEN BEGIN
+        toplevel=stash.base
+        fmx=stash.fmx
+        fmn=stash.fmn
+        mx=stash.mx
+        mn=stash.mn
+   	inputmxmnwindow, fmx, fmn, mx, mn, stash.rmdi, toplevel, success
+	if (success eq 1) then begin
+        stash.fmx=fmx
+        stash.fmn=fmn
+        plotpoints,stash
+        endif
+        
+;        stash.mx=mx
+;        stash.mn=mn      
+;        info,stash.fmx
+;        info,stash.fmn
+;        info,stash.mx
+;        info,stash.mn
+
+  ENDIF
+
+	  
+; store values
+  WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash 
+
+;  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_BUTTON') THEN BEGIN 
+  IF (uval eq "DONE") THEN BEGIN
+;    WIDGET_CONTROL, ev.TOP, /DESTROY 
+    WIDGET_CONTROL, stash.base, /DESTROY 
+  ENDIF 
+
+
+
+;	WIDGET_CONTROL, stash.label3, SET_VALUE=TAG_NAMES(ev, /STRUCTURE_NAME)
+;	print,TAG_NAMES(ev, /STRUCTURE_NAME), uval
+ 
+END 
+
+;-----------------
+; proceedures
+;-----------------
+
+;setup area ranges
+
+PRO areasel, uval, xrange, yrange, success, toplevel=toplevel
+
+;info, xrange
+;info, yrange
+
+success=0
+  
+  IF (uval eq "Global") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[-90.,90.]
+        success=1
+  ENDIF
+  IF (uval eq "Arctic") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[70.,90.]
+        success=1
+  ENDIF
+  IF (uval eq "N Atl") THEN BEGIN
+    	xrange=[-100.,0.]
+        yrange=[25.,70.]
+        success=1
+  ENDIF
+  IF (uval eq "Trop Atl") THEN BEGIN
+    	xrange=[-80.,20.]
+        yrange=[-25.,25.]
+        success=1
+  ENDIF
+  IF (uval eq "S Atl") THEN BEGIN
+    	xrange=[-70.,20.]
+        yrange=[-50.,-25.]
+        success=1
+  ENDIF
+  IF (uval eq "N Pac") THEN BEGIN		
+        xrange=[120.,-100.+360.]
+        yrange=[25.,70.]
+        success=1
+  ENDIF
+  IF (uval eq "Trop Pac") THEN BEGIN
+    	xrange=[120.,-80.+360.]
+        yrange=[-25.,25.]
+        success=1
+  ENDIF
+  IF (uval eq "S Pac") THEN BEGIN
+    	xrange=[120.,-70.+360.]
+        yrange=[-50.,-25.]
+        success=1
+  ENDIF
+  IF (uval eq "Indian") THEN BEGIN
+    	xrange=[20.,120.]
+        yrange=[-50.,30.]
+        success=1
+  ENDIF
+  IF (uval eq "S Ocean") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[-90.,-50.]
+        success=1
+  ENDIF
+  IF (uval eq "Pacific") THEN BEGIN
+    	xrange=[120.,-80.+360.]
+        yrange=[-50.,70.]
+        success=1
+  ENDIF
+   IF (uval eq "Atlantic") THEN BEGIN
+    	xrange=[-100.,20.]
+        yrange=[-50.,70.]
+        success=1
+  ENDIF
+   IF (uval eq "Med") THEN BEGIN
+    	xrange=[-15.,38.]
+        yrange=[30.,46.]
+        success=1
+  ENDIF
+   IF (uval eq "NWS") THEN BEGIN
+    	xrange=[-20.,13.]
+        yrange=[40.,65.]
+        success=1
+  ENDIF
+   IF (uval eq "Input Area") THEN BEGIN
+   	IF (n_elements(toplevel) gt 0) THEN BEGIN
+        print,'success b4',success
+   	inputareawindow, xrange, yrange, toplevel, success
+        print,'success af',success
+        ENDIF
+   ENDIF
+
+END
+
+ 
+;select points to plot
+
+PRO selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+	daymin=daymin, daymax=daymax, salinity=salinity, rmsmean=rmsmean, innovsel2=innovsel2
+
+;		print, 'calling selpoints ',stash.netcdf, stash.txt
+      print, 'calling selpoints'
+
+		xarr1=stash.xarr
+		yarr1=stash.yarr
+		dep1=stash.dep
+                if (n_elements(salinity) eq 0) then salinity=stash.salinity
+		density=stash.density
+                mld=stash.mld
+      filetype=stash.filetype
+
+		obnum=stash.obnum
+;		obnum=lindgen(n_elements(xarr1))	; generate an array of observation numbers
+;                					; starting with zero
+
+;	        if (salinity eq 0) then begin                  
+;		  obs1=stash.obs
+;		  bkg1=stash.bkg
+;		  qcarr=stash.qcarr
+;                endif else begin
+;  		  obs1=stash.obs2
+;		  bkg1=stash.bkg2
+;		  qcarr=stash.qcarr2
+;                endelse              
+
+		if (salinity eq 0) then qcarr=stash.qcarr
+      if (salinity eq 1 or mld eq 1) then qcarr=stash.qcarr2
+      if (density  eq 1) then begin
+         if (filetype eq 'CRT') then qcarr=stash.qcarr $
+         else qcarr=max([[stash.qcarr],[stash.qcarr2]],dim=2)
+      endif
+
+		obstypes1=stash.obstypes
+		depmin=stash.depmin
+		depmax=stash.depmax
+		xrange=stash.xrange
+		yrange=stash.yrange
+		dayarr=stash.dayarr
+                fdayarr=long(dayarr+stash.dayshi)	; 0:00 hours should be plotted in prev day 
+		if (n_elements(daymin) eq 0) then daymin=stash.daymin
+		if (n_elements(daymax) eq 0) then daymax=stash.daymax
+		fdaymin=long(daymin)
+                fdaymax=long(daymax)
+		typeplot=stash.typeplot
+                ombtypeplot=stash.ombtypeplot
+		typeproj=stash.typeproj
+		xrange=stash.xrange
+		yrange=stash.yrange
+		rmdi=stash.rmdi
+
+		print,'dayarr ',max(dayarr)-2454710d, min(dayarr)-2454710d
+                print,'dayarr a',max(dayarr+stash.dayshi)-2454710d,min(dayarr+stash.dayshi)-2454710d
+		print,'stash.dayshi ',stash.dayshi
+
+		print,'fdayarr mx/mn ',max(fdayarr),min(fdayarr)
+                print,'fdaymin ',fdaymin,' fdaymax ',fdaymax
+
+		plot_bad_obs=stash.plot_bad_obs
+		
+		typestr=''
+
+		if (typeproj eq 2) then begin
+			xrange=[-999., 999.]
+			yrange=[0., 90.]
+		endif
+		if (typeproj eq 3) then begin
+			xrange=[-999., 999.]
+			yrange=[-90, 0.]
+		endif
+
+; add 360 if we're in the pacific
+
+		if (xrange(1) gt 180 and typeproj eq 1) then begin
+                print,'xrange(1) gt 180 ',xrange
+		    wh=where(xarr1 lt 0)
+                    xarr1(wh)=xarr1(wh)+360
+                endif
+
+		print,'dayarr(0): ',dayarr(0),fdayarr(0), daymin, daymax
+		
+;		if (plot_bad_obs eq 1) then begin
+		wh=where(dep1 ge depmin and dep1 le depmax and $
+			fdayarr ge fdaymin and fdayarr le fdaymax and $
+			xarr1 ge xrange(0) and xarr1 le xrange(1) and $
+			yarr1 ge yrange(0) and yarr1 le yrange(1))
+;		endif else begin
+;		wh=where(dep1 ge depmin and dep1 le depmax and $
+;			fdayarr ge fdaymin and fdayarr le fdaymax and $
+;			xarr1 ge xrange(0) and xarr1 le xrange(1) and $
+;			yarr1 ge yrange(0) and yarr1 le yrange(1) and qcarr eq 0)
+;		endelse		
+
+		nelwh=n_elements(wh)
+
+		print,'nelwh ',nelwh
+	
+		if (wh(0) gt -1) then begin
+;		   obssel=obs1(wh)
+;		   bkgsel=bkg1(wh)
+                                     
+		   qcsel=qcarr(wh)
+		   lonsel=xarr1(wh)
+		   latsel=yarr1(wh)
+		   daysel=dayarr(wh)
+		   depsel=dep1(wh)
+		   obstypsel=obstypes1(wh)
+         obnumsel=obnum(wh)
+         numsel=lonarr(nelwh)
+
+		   nel=n_elements(obssel)
+                   
+; select points here to avoid unnecessary density calculations                   
+
+         obssel1=stash.obs(wh)
+         bkgsel1=stash.bkg(wh)
+         obssel2=stash.obs2(wh)
+         bkgsel2=stash.bkg2(wh)
+
+         if (density eq 0 and mld eq 0) then begin   
+            if (salinity eq 0) then begin                  
+      		   obssel=obssel1
+		         bkgsel=bkgsel1
+            endif else begin
+  		         obssel=obssel2
+		         bkgsel=bkgsel2
+            endelse              
+         endif else begin
+            if (filetype eq 'CRT') then begin			 
+               bkgsel=sqrt(bkgsel1*bkgsel1 + bkgsel2*bkgsel2)
+               if (salinity eq 0) then begin
+                  obssel=sqrt(obssel1*obssel1 + obssel2*obssel2)
+               endif else begin
+                  obssel=stash.obs3(wh)                
+               endelse
+            endif else begin				; calculate density if mld flag set
+               obssel=eos_nemo(obssel1,obssel2)
+               bkgsel=eos_nemo(bkgsel1,bkgsel2)
+            endelse
+         endelse
+
+; create an array to store the sum of the square differences for calculating profile rms
+;		   omb2sel=(obssel - bkgsel)^2
+         nel=n_elements(obssel)
+      endif else begin			; if there are no obs then exit subroutine
+         nel=0
+			return
+                endelse  
+
+		if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+			innovseli=obssel^2
+                        innovseli2=bkgsel^2
+                        innovseli3=(obssel-bkgsel)^2
+                        innovseli4=obssel*bkgsel
+		endif else begin
+
+                             
+		if (ombtypeplot eq 1) then begin
+                	typestr='obs - bkg'
+                        innovseli=obssel-bkgsel
+                endif
+		if (ombtypeplot eq 2) then begin
+                	typestr='obs'
+                        innovseli=obssel
+                endif
+		if (ombtypeplot eq 3) then begin
+                	typestr='bkg'
+                        innovseli=bkgsel
+                endif
+
+		if (keyword_set(rmsmean)) then begin
+                	innovseli=innovseli
+                        innovseli2=innovseli^2
+                endif else begin
+
+		if (typeplot eq 1) then begin
+                	typestr='mean '+typestr
+                endif
+                if (typeplot eq 2) then begin
+                	typestr='rms '+typestr
+                        innovseli=innovseli^2
+                endif
+		if (typeplot eq 3) then begin
+                	typestr='sd '+typestr
+                        innovseli=innovseli^2		; ?
+                endif
+                if (typeplot eq 4) then begin
+                	typestr='mean sq '+typestr
+                        innovseli=innovseli^2
+                endif
+
+		endelse
+
+		endelse
+
+;      print,'bkgsel ',bkgsel
+;      print,'obssel ',obssel
+
+; tolerance check
+
+		if (wh(0) gt -1) then begin
+		   wh2=[-1]
+
+;	print,qcsel
+                   
+                   if (plot_bad_obs eq 0) then begin
+;		   if (typeplot eq 1 or typeplot eq 2 $
+;			or typeplot eq 3) then $
+		   if (ombtypeplot eq 1) then $
+;			wh2=where(bkgsel ne rmdi and obssel ne rmdi)
+			wh2=where(abs(bkgsel-rmdi) gt abs(rmdi)*0.01 and abs(obssel-rmdi) gt $
+	                        abs(rmdi)*0.01 and qcsel eq 0)	; tolerance rmdi check
+		   if (ombtypeplot eq 2) then $
+;                   if (typeplot eq 4) then $
+;		   	wh2=where(obssel ne rmdi)
+			wh2=where(abs(obssel-rmdi) gt abs(rmdi)*0.01 and qcsel eq 0)	;tol rmdi check
+		   if (ombtypeplot eq 3) then $
+;		   if (typeplot eq 5) then $	
+;			wh2=where(bkgsel ne rmdi)
+			wh2=where(abs(bkgsel-rmdi) gt abs(rmdi)*0.01 and qcsel eq 0)	;tol rmdi check
+
+; check for bad observations
+;		if (plot_bad_obs eq 1) then begin
+		endif else if (plot_bad_obs eq 1 and stash.plot_only_bad_obs eq 1) then begin
+;                	wh2=where(qcsel ne 0 or obssel eq rmdi or bkgsel eq rmdi, count)
+;                        wh2=where(qcsel ne 0 or abs(obssel-rmdi) lt abs(rmdi)*0.01,count) 
+			wh2=where(qcsel ne 0 and obssel ne rmdi)
+
+;                        wh2=where(qcsel ne 0 or abs(obssel-rmdi) lt abs(rmdi)*0.01 or abs(bkgsel-rmdi) lt abs(rmdi)*0.01,count) 
+;                        print,'bad obs: ',count
+;                        whtmp=where(qcsel eq 0, count)
+;                        print,'qcsel eq 0: ',count
+;                        whtmp=where(obssel eq 0, count)
+;                        print,'obssel eq 0: ',count
+;                        whtmp=where(bkgsel eq 0, count)
+;                        print,'bkgsel eq 0: ',count
+                endif else begin				; plot all observations
+;                	wh2=where(obssel)       
+                        wh2=where(obssel ne rmdi)
+                endelse
+
+		   if (wh2(0) gt -1) then begin
+		      obssel=obssel(wh2)
+		      bkgsel=bkgsel(wh2)
+                      innovseli=innovseli(wh2)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh2)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh2)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh2)
+;		      endif
+		      qcsel=qcsel(wh2)
+		      lonsel=lonsel(wh2)
+		      latsel=latsel(wh2)
+		      daysel=daysel(wh2)
+		      depsel=depsel(wh2)
+		      obstypsel=obstypsel(wh2)
+                      obnumsel=obnumsel(wh2)
+;                      numsel=numsel(wh2)
+		   endif
+
+		print,'nelwh2 ',n_elements(wh2), typeplot, ombtypeplot
+		       
+		if (wh2(0) gt -1) then begin
+                
+                ; calculate vertical gradients if required
+	if (stash.filetype eq "Prof" and stash.vertgrad eq 1) then $
+	calcvertgrad, lonsel, latsel, daysel, obssel, bkgsel, qcsel, depsel, rmdi
+
+; average profiles on the same latitude and longitude
+; goes through each point and puts the average in the first instance and flags 
+; the others for later removal
+; this routine can also be used to bin data
+		depmx=max(depsel,min=depmn)
+		print,'depmn/mx: ',depmn, depmx
+		if (depmx gt depmn or stash.duplicates gt 0 or stash.differences or stash.bindata) then begin
+
+; sort by lat and lon
+; presumably will average in time also...
+
+		if (stash.bindata) then begin		; if we are binning data (in 1 deg bins)
+                					; use +0.5 to get nearest round number 
+		  latbin=double(fix((latsel+stash.binsize(1)/2.)*(1/stash.binsize(1))))/(1/stash.binsize(1))
+		  lonbin=double(fix((lonsel+stash.binsize(0)/2.)*(1/stash.binsize(0))))/(1/stash.binsize(0))			
+		  latlon=long(latbin*10000000d)+double(lonbin+180d)/360d
+                endif else begin
+		  latlon=long(double(latsel)*10000000d)+double(lonsel+180d)/360d
+                endelse
+                
+		elsort=sort(latlon)
+
+		latsel=latsel(elsort)
+		lonsel=lonsel(elsort)
+		obssel=obssel(elsort)
+                bkgsel=bkgsel(elsort)
+                innovseli=innovseli(elsort)
+;                if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(elsort)
+                if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(elsort)
+                if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(elsort)
+;		endif
+		qcsel=qcsel(elsort)
+                daysel=daysel(elsort)
+                depsel=depsel(elsort)
+		obstypsel=obstypsel(elsort)
+                obnumsel=obnumsel(elsort)
+;                numsel=numsel(elsort)
+		latlon=latlon(elsort)
+		
+		nel=n_elements(obssel)
+                accum=0
+                isave=0
+                lon1=-99999.0
+                lat1=-99999.0
+                latlon1=-99999.0
+                day1=-99999
+                num=0
+ 
+; 		if (nel gt 100) then begin
+;                info,latsel
+; 		print,latsel(0:100)
+;                info,lonsel
+;                print,lonsel(0:100)
+;                info,latlon
+;		print,latlon(0:100)
+ 
+; 		latsel(0:100)=latsel(50)
+;                lonsel(0:100)=lonsel(50)
+; 		latlon=long(double(latsel)*10000000d)+double(lonsel+180d)/360d
+ 
+;                endif
+                
+
+		print,'DJL ',max(daysel),min(daysel)
+
+; loop through the data averaging profiles at the same location               
+ 
+                sign=1                                            
+                if (stash.duplicates eq 2) then sign=-1		; plot the difference rather than the average	
+  
+                numsel=lonarr(nel)
+		for i=0L,nel-1 do begin
+                
+                if i mod 100000 eq 0 then print,i,nel
+
+;		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+;                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+		
+; 		if (lonsel(i) ne lon1 or latsel(i) ne lat1) then begin
+
+; check for new profile or reaching the end of the data
+; check for the end of a day added
+
+		if ((latlon(i) ne latlon1) or (i eq nel-1) or (long(daysel(i)) ne long(day1))) then begin		
+
+;		print,i, latlon(i), latlon1, daysel(i), day1                
+;                if i gt 0 then stop
+		
+; average last profile
+		  if (isave ge 0 and num gt 0) then begin
+                
+                    if (num gt 1) then begin    
+                
+;                	print,num
+                        numsave=num
+                        if (stash.duplicates eq 2) then num=1
+
+			if (stash.bindata) then begin 
+ 			latsel(isave)=latsel(isave)/num
+                        lonsel(isave)=lonsel(isave)/num
+                        endif                          
+                	obssel(isave)=obssel(isave)/num
+                        bkgsel(isave)=bkgsel(isave)/num
+                        daysel(isave)=daysel(isave)/num
+                        depsel(isave)=depsel(isave)/num
+                        innovseli(isave)=innovseli(isave)/num
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=innovseli2(isave)/num
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=innovseli3(isave)/num
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=innovseli4(isave)/num
+;		        endif
+
+                        num=numsave
+
+; save the num	
+			numsel(isave)=num
+
+;                        if (fix(lonsel(isave)) eq -7297 and $
+;                            fix(latsel(isave)) eq -5935) then begin
+;                         print,'completed ',isave, num                        
+;			 print,'obssel ',obssel(isave)
+;                         print,'bkgsel ',bkgsel(isave)
+;                         endif
+                         
+                    endif else begin
+                    	numsel(isave)=num
+                    endelse
+                    if ((stash.duplicates gt 0 and num eq 1) or (stash.differences and num gt 1)) then begin
+                        obssel(isave)=rmdi
+                        bkgsel(isave)=rmdi
+                        lonsel(isave)=rmdi
+                        latsel(isave)=rmdi
+                        qcsel(isave)=rmdi
+                        innovseli(isave)=rmdi
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=rmdi
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=rmdi
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=rmdi
+;  		        endif
+                        
+                    endif
+                                           
+		  endif 
+
+		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+
+; start a new profile
+       		      lon1=lonsel(i)
+		      lat1=latsel(i)
+                      latlon1=latlon(i)
+                      day1=daysel(i)
+                      isave=i
+                      accum=1
+                      num=1
+
+		endif		; plot_bad_obs ...
+                      
+ ; accumulating                     
+                      
+		endif else begin
+                	
+		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+                        
+                	num=num+1
+
+			if (stash.bindata) then begin
+                        latsel(isave)=latsel(isave)+double(fix((1./stash.binsize(1))*(latsel(i)+stash.binsize(1)/2.)))/(1./stash.binsize(1))	;latsel(isave)+fix(latsel(i)+0.5)
+                        lonsel(isave)=lonsel(isave)+double(fix((1./stash.binsize(0))*(lonsel(i)+stash.binsize(0)/2.)))/(1./stash.binsize(0))	;lonsel(isave)+fix(lonsel(i)+0.5)
+                        endif
+
+                        obssel(isave)=obssel(isave)+obssel(i)*sign
+                        bkgsel(isave)=bkgsel(isave)+bkgsel(i)*sign
+                        innovseli(isave)=innovseli(isave)+innovseli(i)*sign
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=innovseli2(isave)+innovseli2(i)*sign
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=innovseli3(isave)+innovseli3(i)*sign
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=innovseli4(isave)+innovseli4(i)*sign
+; 		        endif
+
+                        qcsel(isave)=min([qcsel(isave),qcsel(i)])
+                        daysel(isave)=daysel(isave)+daysel(i)
+                        depsel(isave)=depsel(isave)+depsel(i)
+
+			if (stash.bindata) then begin
+                        latsel(i)=rmdi
+                        lonsel(i)=rmdi               
+                        endif         
+                        obssel(i)=rmdi
+                        bkgsel(i)=rmdi
+                        innovseli(i)=rmdi
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(i)=rmdi
+                        if (n_elements(innovseli3) gt 0) then innovseli3(i)=rmdi
+                        if (n_elements(innovseli4) gt 0) then innovseli4(i)=rmdi
+; 		        endif
+                        lonsel(i)=rmdi
+                        latsel(i)=rmdi
+                        qcsel(i)=rmdi
+
+;                        if (fix(lonsel(isave)*100) eq -7297 and $
+;                       	    fix(latsel(isave)*100) eq -5935) then begin
+;                         print,'isave ',isave, num                        
+;			  print,'obssel ',obssel(isave)
+;                         print,'bkgsel ',bkgsel(isave)
+;                        endif
+
+		endif		; plot_bad_obs ...
+                        
+                endelse 
+                      
+;                endif
+
+                endfor		; i  nobs
+
+		print,'DJL2x ',max(daysel),min(daysel)
+
+
+		wh5=where(lonsel ne rmdi)				; clears out but the averaged profiles
+                if (wh5(0) gt -1) then begin
+		      obssel=obssel(wh5)
+		      bkgsel=bkgsel(wh5)
+                      innovseli=innovseli(wh5)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh5)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh5)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh5)
+;		      endif
+		      qcsel=qcsel(wh5)
+		      lonsel=lonsel(wh5)
+		      latsel=latsel(wh5)
+		      daysel=daysel(wh5)
+		      obstypsel=obstypsel(wh5)
+                      obnumsel=obnumsel(wh5)
+                      numsel=numsel(wh5)
+                      nel=n_elements(obssel)
+                endif else begin			; if there are no obs then exit subroutine
+                	nel=0
+			return
+                endelse               
+		endif
+
+		print,'nel wh5 ',n_elements(wh5)
+		print,'DJL3 ',max(daysel),min(daysel)
+
+		typeselect=stash.obstypeselect
+;                print, 'typeselect ',typeselect
+		if (typeselect(0) ne "") then begin
+;                typeselecta=strsplit(typeselect,' ,',/extract)		; split string on commas or spaces
+		typeselecta=strsplit(typeselect,',',/extract)		; split string on commas only
+                nel=n_elements(typeselecta)
+                print,'n_elements(typeselecta) ',nel
+                for i=0L,nel-1 do begin
+                ; string matching (understands * ?)
+                st1=strtrim(string(obstypsel),2)		; strip tailing and leading spaces
+                st2=strtrim(typeselecta(i),2)
+                wh6t=where(strmatch(st1,st2,/FOLD_CASE) EQ 1)	
+;                print, 'wh6t ',typeselecta(i), wh6t
+		if i eq 0 then wh6=wh6t else wh6=[wh6,wh6t]
+                endfor 
+;                print,n_elements(wh6)
+;                print,wh6
+                wh=where(wh6 gt -1)
+;                print,wh
+                if (wh(0) gt -1) then begin
+                      wh6=wh6(wh)
+		      obssel=obssel(wh6)
+		      bkgsel=bkgsel(wh6)
+                      innovseli=innovseli(wh6)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh6)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh6)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh6)
+;		      endif
+		      qcsel=qcsel(wh6)
+		      lonsel=lonsel(wh6)
+		      latsel=latsel(wh6)
+		      daysel=daysel(wh6)
+		      obstypsel=obstypsel(wh6)
+                      obnumsel=obnumsel(wh6)
+                      numsel=numsel(wh6)
+                      nel=n_elements(obssel)
+;                      print, 'nel (in obstypeselect) ',nel
+                endif else begin			; if there are no obs then exit subroutine
+                	print,'no matching obs'
+			nel=0
+                endelse               
+		endif                	
+                
+                if (stash.printobstypes eq 1) then begin
+		s=sort(obstypsel)
+                sobstypsel=obstypsel(s)
+		u=uniq(sobstypsel)
+		print,"unique obs types: ",sobstypsel(u) 
+		endif
+
+		print,'nel ',nel
+		stash.symsize=1.0
+		if (nel gt 250) then stash.symsize=0.75
+		if (nel gt 1000) then stash.symsize=0.5
+		if (nel gt 2000) then stash.symsize=0.25
+		if (nel lt 20) then stash.symsize=2.0
+
+		if (!d.name eq 'Z') then stash.symsize=stash.symsize/2
+
+		print,'stash.symsize: ',stash.symsize
+
+; save data for mean and rms plots
+; for ombtypeplot=3 typeplot=2 innovsel = (obs - bkg)^2		mean value available from obssel(i) - bkgsel(i)
+
+; copy innovseli to innovsel (if we've got some valid data to plot / save)
+		if (nel gt 0) then innovsel=innovseli
+
+		if (stash.txt eq 1 and stash.bindata eq 1) then begin
+ 
+; The file contains:  longitude, latitude, num of points, obs mean, bkg mean
+;         mean sq obs,    mean sq bkg,        mean sq obs - bkg, 	mean obs * bkg 
+                
+                outfile=stash.outfile+'_selpoints.txt'
+                print, 'saving data to ',outfile
+                OPENW, unit, outfile, /get_lun
+;   	           printf,unit,'Output selpoints data: '
+                printf,unit, 3					; file version
+                printf,unit, typeplot
+                printf,unit, stash.bindata
+                printf,unit, xrange, yrange
+                printf,unit, min(daysel), max(daysel) 
+
+                for i=0L,nel-1 do begin
+                	   printf,unit, lonsel(i), latsel(i), numsel(i), obssel(i), bkgsel(i), $
+                        	   innovseli(i), innovseli2(i), innovseli3(i), innovseli4(i), $
+                        	   format='(2d10.3, i8, 6d18.8)'
+                endfor
+                FREE_LUN, unit
+               
+      endif
+
+		if (stash.netcdf eq 1 and stash.bindata eq 1) then begin
+
+                outfile=stash.outfile+'_selpoints.nc'
+                print, 'saving data to ',outfile
+
+                nid=NCDF_CREATE( outfile, /CLOBBER )
+                
+                NCDF_ATTPUT, nid, 'version', 3, /SHORT, /GLOBAL
+                NCDF_ATTPUT, nid, 'bindata', stash.bindata, /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'xrange0', xrange(0), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'xrange1', xrange(1), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'yrange0', yrange(0), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'yrange1', yrange(1), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'mindaysel', min(daysel), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'maxdaysel', max(daysel), /FLOAT, /GLOBAL
+                
+                print, 'nel ',nel
+                nelid = NCDF_DIMDEF( nid, 'n', nel )
+                
+                lonid = NCDF_VARDEF ( nid, 'longitudes', [nelid], /FLOAT )
+                latid = NCDF_VARDEF ( nid, 'latitudes', [nelid], /FLOAT ) 
+                numid = NCDF_VARDEF ( nid, 'num', [nelid], /LONG )
+                obsid = NCDF_VARDEF ( nid, 'obs_mean', [nelid], /FLOAT )
+                bkgid = NCDF_VARDEF ( nid, 'bkg_mean', [nelid], /FLOAT )
+                innovseli1id = NCDF_VARDEF ( nid, 'obs_mean_sq', [nelid], /FLOAT )
+                innovseli2id = NCDF_VARDEF ( nid, 'bkg_mean_sq', [nelid], /FLOAT )
+                innovseli3id = NCDF_VARDEF ( nid, 'omb_mean_sq', [nelid], /FLOAT )
+                innovseli4id = NCDF_VARDEF ( nid, 'otimesb_mean', [nelid], /FLOAT )
+                NCDF_CONTROL, nid, /ENDEF
+                
+                if (nel gt 0) then begin
+                NCDF_VARPUT, nid, lonid, lonsel
+                NCDF_VARPUT, nid, latid, latsel
+                NCDF_VARPUT, nid, numid, numsel
+                NCDF_VARPUT, nid, obsid, obssel
+                NCDF_VARPUT, nid, bkgid, bkgsel
+                NCDF_VARPUT, nid, innovseli1id, innovseli
+                NCDF_VARPUT, nid, innovseli2id, innovseli2
+                NCDF_VARPUT, nid, innovseli3id, innovseli3
+                NCDF_VARPUT, nid, innovseli4id, innovseli4
+                endif
+                
+                NCDF_CLOSE, nid
+                
+		endif
+
+      if (stash.filterout ne '') then begin
+
+         ; write out filtered feedback file in new feedback format
+         ; with some filthy fudges to emulate NEMOVAR format
+         if (nel gt 0) then begin
+
+            print, 'writing filtered feedback file ',stash.filterout
+
+            ; split type string in two to be used as STATION_IDENTIFIER and STATION_TYPE
+            typesel=strarr(nel)
+            instsel=strarr(nel)
+
+            for iob = 0, nel-1 do begin
+               tempsel=strsplit(obstypsel[iob],/extract)
+               typesel[iob]=tempsel[0]
+               ; catch for data without space and instrument id in types (e.g. altimeter)
+               instsel[iob]=''
+               if (n_elements(tempsel) gt 1 ) then $
+                  instsel[iob]=tempsel[1]
+            endfor
+
+            ; setup netcdf file
+            nid=NCDF_CREATE( stash.filterout, /CLOBBER )
+
+            ; global attribute to emulate NEMOVAR feedback files
+            NCDF_ATTPUT, nid, 'title', "NEMO observation operator output", /GLOBAL
+            if (stash.obstypeselect ne '' ) then $
+               NCDF_ATTPUT, nid, 'filter', stash.obstypeselect, /GLOBAL
+            NCDF_ATTPUT, nid, 'minday', min(daysel), /FLOAT, /GLOBAL
+            NCDF_ATTPUT, nid, 'maxday', max(daysel), /FLOAT, /GLOBAL
+
+            nobid = NCDF_DIMDEF( nid, 'N_OBS', nel )
+            ndepid = NCDF_DIMDEF( nid, 'N_LEVELS', 1 ) ; temporarily input 1d profile arrays
+
+            if (stash.filetype eq 'feedback') then begin
+
+               ncvars = stash.varname
+               nnvars = n_elements(ncvars)
+
+            endif else begin
+
+               nnvars = 1
+               ncvars = stash.filetype
+               if (stash.filetype eq 'Prof') then begin
+                  ncvars = 'POTM'
+                  if (salinity eq 1) then ncvars = 'PSAL'
+                  nextid = NCDF_DIMDEF( nid, 'N_EXTRA', 1 )
+               endif 
+
+            endelse
+
+            nvarid = NCDF_DIMDEF( nid, 'N_VARS', nnvars )
+
+            nentid = NCDF_DIMDEF( nid, 'N_ENTRIES', 1 )
+
+            nstrnamid = NCDF_DIMDEF( nid, 'STRINGNAM', 8 )
+            nstrwmoid = NCDF_DIMDEF( nid, 'STRINGWMO', 8 )
+            nstrtypid = NCDF_DIMDEF( nid, 'STRINGTYP', 4 )
+            nstrjulid = NCDF_DIMDEF( nid, 'STRINGJULD', 14 )
+
+            varid = NCDF_VARDEF ( nid, 'VARIABLES', [nstrnamid,nvarid], /CHAR )
+            entid = NCDF_VARDEF ( nid, 'ENTRIES', [nstrnamid,nentid], /CHAR )
+            signid = NCDF_VARDEF ( nid, 'STATION_IDENTIFIER', [nstrwmoid,nobid], /CHAR )
+            typeid = NCDF_VARDEF ( nid, 'STATION_TYPE', [nstrtypid,nobid], /CHAR )
+
+            lonid = NCDF_VARDEF ( nid, 'LONGITUDE', [nobid], /DOUBLE )
+            latid = NCDF_VARDEF ( nid, 'LATITUDE', [nobid], /DOUBLE )
+            depid = NCDF_VARDEF ( nid, 'DEPTH', [nobid], /DOUBLE )
+;            depid = NCDF_VARDEF ( nid, 'DEPTH', [ndepid,nobid], /DOUBLE )
+            julid = NCDF_VARDEF ( nid, 'JULD', [nobid], /DOUBLE )
+            jrefid = NCDF_VARDEF ( nid, 'JULD_REFERENCE', [nstrjulid], /CHAR )
+
+            obsqcid = NCDF_VARDEF ( nid, 'OBSERVATION_QC', [nobid], /LONG )
+
+            FillVal=9999
+            NCDF_ATTPUT, nid, depid, '_Fillvalue', FillVal, /DOUBLE
+            NCDF_ATTPUT, nid, obsqcid, '_Fillvalue', FillVal, /LONG
+
+            obsids=intarr(nnvars)
+            bkgids=intarr(nnvars)
+            qcids=intarr(nnvars)
+            lqcids=intarr(nnvars)
+
+            for ivar = 0, nnvars-1 do begin
+
+               obsids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_OBS', [nobid], /FLOAT )
+               NCDF_ATTPUT, nid, obsids[ivar], '_Fillvalue', FillVal, /FLOAT
+               bkgids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_Hx', [nobid], /FLOAT )
+               NCDF_ATTPUT, nid, bkgids[ivar], '_Fillvalue', FillVal, /FLOAT
+               qcids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_QC', [nobid], /LONG )
+               NCDF_ATTPUT, nid, qcids[ivar], '_Fillvalue', FillVal, /FLOAT
+               lqcids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_LEVEL_QC', [nobid], /LONG )
+               NCDF_ATTPUT, nid, lqcids[ivar], '_Fillvalue', FillVal, /FLOAT
+
+            endfor
+
+            NCDF_CONTROL, nid, /ENDEF
+
+            JulDRef = '19500101000000'
+            NCDF_VARPUT, nid, jrefid, JulDRef
+            RefDate = JULDAY(fix(strmid(JulDRef,4,2)), fix(strmid(JulDRef,6,2)), fix(strmid(JulDRef,0,4)), $
+                             fix(strmid(JulDRef,8,2)), fix(strmid(JulDRef,10,2)), fix(strmid(JulDRef,12,2)))
+            NCDF_VARPUT, nid, julid,daysel-RefDate 
+
+            NCDF_VARPUT, nid, varid, ncvars 
+            NCDF_VARPUT, nid, entid, 'Hx'
+
+            NCDF_VARPUT, nid, lonid, lonsel
+            NCDF_VARPUT, nid, latid, latsel
+
+            NCDF_VARPUT, nid, depid, fltarr(nel)
+            NCDF_VARPUT, nid, obsqcid, fltarr(nel)+1
+
+            for ivar = 0, nnvars-1 do begin
+
+               NCDF_VARPUT, nid, obsids[ivar], obssel
+               NCDF_VARPUT, nid, bkgids[ivar], bkgsel
+               NCDF_VARPUT, nid, qcids[ivar], qcsel+1
+               NCDF_VARPUT, nid, lqcids[ivar], fltarr(nel)+1
+
+            endfor
+
+            NCDF_VARPUT, nid, typeid, typesel
+            NCDF_VARPUT, nid, signid, instsel
+
+         endif
+
+         NCDF_CLOSE, nid
+
+      endif ; filterout
+
+		if (nel gt 0) then begin	
+
+		   if (typeplot eq 2) then begin
+                        innovsel=sqrt(innovsel)
+                   endif
+		   if (typeplot eq 3) then begin
+;  std dev = sqrt ( mean x2 - (mean x)^2)
+			x2=innovsel
+			print,'typeplot ',typeplot,' ombtypeplot ',ombtypeplot
+			if (ombtypeplot eq 1) then $
+                        	innovsel=sqrt(x2-(obssel-bkgsel)^2)
+                        if (ombtypeplot eq 2) then $
+                        	innovsel=sqrt(x2-(obssel)^2)                        
+                        if (ombtypeplot eq 3) then $
+                        	innovsel=sqrt(x2-(bkgsel)^2)                        
+                   endif
+
+		   if (keyword_set(rmsmean)) then begin
+                   	innovsel=innovseli						; mean 
+                        if (n_elements(innovseli2) gt 0) then innovsel2=innovseli2	; rms                  
+                   endif
+
+
+		   innovmean=total(innovsel)/nel
+		   innovmean2=total(innovsel^2)/nel
+		   innovsd=sqrt(innovmean2-innovmean^2)
+		   print,'mean innovsel ',innovmean
+		   print,'sd innovsel ',innovsd
+
+		endif
+
+		
+
+		endif
+
+		endif
+
+		wh=where(numsel eq 0)
+                if (wh(0) gt -1) then numsel(wh)=1
+
+END
+
+PRO setupct, r, g, b, coltable=coltable, white_on_black=white_on_black
+
+if (coltable eq 0 or coltable lt -2) then begin
+; get color table and modify
+                loadct, 13
+                stretch, -40, 256
+;                tvlct,r,g,b,/get                
+;                r(0)=0
+;                g(0)=0
+;                b(0)=0
+;                r(255)=255
+;                g(255)=255
+;                b(255)=255              
+;                tvlct,r,g,b
+endif else begin
+	if (coltable eq -1) then begin
+		restore_colors, 'spectrum.clr'
+	endif else if (coltable eq -2) then begin
+                restore_colors, '~frbe/spectrum_alt.xdr',/asis
+        endif else begin
+		loadct,coltable
+        endelse            
+endelse
+
+tvlct,r,g,b,/get
+i0=0
+i1=255
+if (n_elements(white_on_black) eq 1 and !d.name ne "PS") then begin
+	if (white_on_black eq 0) then begin
+     		i0=255
+                i1=0   
+        endif
+endif
+r(i0)=0
+g(i0)=0
+b(i0)=0
+r(i1)=255
+g(i1)=255
+b(i1)=255              
+tvlct,r,g,b
+
+END
+
+PRO plotpoints, stash
+
+		nplots=1
+                if (stash.pmulti eq 2) then nplots=stash.pmulti
+
+		for nplot=0,nplots-1 do begin
+
+		if (stash.busy eq 1) then return
+		stash.busy = 1
+
+		num_cols=254
+
+		print,"!d.name ",!d.name 
+		IF (stash.drawID gt -1) then begin
+  		IF (!d.name eq 'X' or !d.name eq 'Z') then begin 
+                        device, decomposed=0
+	        endif
+                IF (!d.name eq 'X') then WSET, stash.drawID
+		endif
+
+		IF (!d.name ne 'Z') then setupct, r, g, b, $
+                   coltable=stash.coltable,white_on_black=stash.white_on_black		; setup color table
+
+		noerase=0
+		if (stash.pmulti eq 2) then begin
+                	if (stash.pmultinum gt 0) then noerase=1
+                	!p.multi=[stash.pmultinum,2,1]
+                        stash.pmultinum=(stash.pmultinum+1) mod 2
+                endif else begin
+                	!p.multi=0
+                endelse
+                
+;		xarr1=stash.xarr
+;		yarr1=stash.yarr
+;		dep1=stash.dep
+;		obs1=stash.obs
+;		bkg1=stash.bkg
+;		depmin=stash.depmin
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+;		typeplot=stash.typeplot
+		typeproj=stash.typeproj
+;                print,"stash.map_file: ",stash.map_file
+;		if (strlen(stash.map_file) gt 0) then map_file=stash.map_file
+                                
+;		print,depmin,xrange,yrange
+
+  		dummy=[0,0]
+		
+		
+;		plot,dummy,/nodata,yrange=[-90,90],xrange=[-180,180]
+;		plot,dummy,/nodata,yrange=[-50,80],xrange=[-110,40],$
+;			xstyle=1,ystyle=1, xtitle='Longitude',ytitle='Latitude'
+
+		if (typeproj ne 1) then begin
+		    	origlon=0.
+			if (typeproj eq 2) then begin 
+                        	origlat=90.
+                                if (yrange(0) lt 0) then yrange(0)=45
+                                if (yrange(1) lt 0) then yrange(1)=90
+                        endif
+			if (typeproj eq 3) then begin 
+                        	origlat=-90.
+                                if (yrange(0) gt 0) then yrange(0)=-90
+                                if (yrange(1) gt 0) then yrange(1)=-45                               
+                        endif      
+			;scale=0.35
+                        smap = map_proj_init('Polar Stereographic')
+		endif
+
+		; select points to plot
+		typestr=""
+                
+spawn,'echo plotpoints 1 `date`'
+                
+		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr
+                
+spawn,'echo plotpoints 2 `date`'
+
+		if (stash.txt eq 0 and stash.netcdf eq 0) then begin
+		nelsel=n_elements(innovsel)
+
+                nptsstr=strtrim(string(nelsel),2)
+                print,nptsstr, nelsel
+
+;		if (nelsel gt 0) then begin
+
+
+
+		;convert lats and lons to projection positions
+;                if (nelsel gt 0) then begin
+;                print,'min/max lonsel: ',min(lonsel),max(lonsel)
+;		if (typeproj ne 1) then begin
+;                  coords = map_proj_forward(lonsel,latsel,MAP=smap)
+;		  lonsel=coords(0,*)
+;		  latsel=coords(1,*)
+;		endif
+;                endif
+
+
+
+		print,'nelsel: ',nelsel
+		nelinnov=n_elements(innovsel)
+		print,'nelinnov: ',nelinnov
+
+                jul_to_dtstr, daymin, dateminstr, /notime
+                jul_to_dtstr, daymax, datemaxstr, /notime		
+
+                strtsal=''
+;                print,'stash.filetype ',stash.filetype
+                if (stash.filetype eq "Prof" or stash.filetype eq "feedback") then begin
+                	   strtsal='T:  '
+                     if (stash.salinity eq 1) then strtsal='S:  '
+                     if (stash.density  eq 1) then strtsal='Density:  '
+                     if (stash.mld eq 1) then strtsal='MLD:  '
+                endif else begin
+                     if (stash.filetype eq "CRT") then begin
+                	      strtsal='U:  '
+                        if (stash.salinity eq 1) then strtsal='V:  '
+                        if (stash.density  eq 1) then strtsal='Speed:  '
+                        if (stash.salinity eq 1 and stash.density  eq 1) then strtsal='Total Speed:  '
+                     endif else begin
+                	      strtsal=stash.filetype+':  '
+                     endelse
+                endelse
+                if (stash.vertgrad eq 1) then strtsal='Grad '+strtsal
+		nptsstr2='Points: '+nptsstr+'  '
+		titlestr=strtsal+typestr+': '+dateminstr+' to '+datemaxstr
+		print,'titlestr ',titlestr
+
+; get max and min values
+		mx=0
+                mn=0
+                meaninnov=0
+                rmsinnov=0
+		if (nelinnov gt 0) then begin
+; NB these values are just the rms and mean of the points plotted...
+; and do not take account of the datapoints used in profiles plotted...
+		   mx=max(innovsel)
+                   mn=min(innovsel)
+		   meaninnov=avg(innovsel)
+                   rmsinnov=sqrt(avg(innovsel^2))
+;                   n=total(numsel)
+;                   wh=where(numsel gt 0)
+;                   print, 'innovsel: ',max(innovsel), min(innovsel)
+;                   print, 'numsel: ',max(numsel), min(numsel)
+;                   if (n gt 0) then begin
+;                      x=total(innovsel(wh)*numsel(wh))
+;                      x2=total(innovsel(wh)^2*numsel(wh))
+;                      meaninnov=x/n
+;                      rmsinnov=sqrt(x2/n)
+;                   endif
+                endif
+
+		subtitle=''
+		subtitle=nptsstr2+'depths: '+strtrim(string(long(stash.depmin)),2)+'-'+$
+                	strtrim(string(long(stash.depmax)),2)
+                if (stash.obstypeselect ne "") then subtitle=subtitle+'  filtered type: '+stash.obstypeselect        
+ 		subtitle=subtitle+'  extrema: '+$
+                	strtrim(string(mn,format='(G0.4)'),2)+', '+strtrim(string(mx,format='(G0.4)'),2)
+		subtitle=subtitle+'  mean: '+strtrim(string(meaninnov,format='(G0.4)'))+$
+                	' rms: '+strtrim(string(rmsinnov,format='(G0.4)'))
+		
+;                print,'noerase ',noerase
+                
+		if (typeproj ne 1) then begin                 
+                 map_set, /STEREOGRAPHIC, origlat, 0, /continents, title=titlestr+'!C'+subtitle, $
+                         ymargin=[10.,5.], /label, latlab=xrange(0), lonlab=yrange(0), $
+                         limit=[yrange(0),xrange(0),yrange(1),xrange(1)],/isotropic, hires=stash.hires_map, noerase=noerase
+                endif else begin        
+                  P0lon=0
+                  P0lat=0
+                  if (xrange(1) gt 180) then P0lon=180
+                  print,'ranges: ',yrange(0),xrange(0),yrange(1),xrange(1)
+                  map_set, P0lat, P0lon, /continents, title=titlestr+'!C'+subtitle, $
+                         ymargin=[10.,5.], /label, latlab=xrange(0), lonlab=yrange(0), $
+                         limit=[yrange(0),xrange(0),yrange(1),xrange(1)],/isotropic, hires=stash.hires_map, noerase=noerase  
+                endelse
+
+                                                                 
+		if (nelsel eq 0 or nelinnov eq 0) then begin 
+;			pp_contour,fld,title=titlestr,/nodata, /proportional, map_file=map_file
+		endif else begin
+;			pp_contour,fld,title=titlestr,/nodata, /proportional, map_file=map_file
+                          
+                if (stash.fmx ne stash.rmdi) then mx=stash.fmx
+                if (stash.fmn ne stash.rmdi) then mn=stash.fmn
+
+		print,'setting stash mx/mn'
+		stash.mx=mx
+                stash.mn=mn
+
+;		levs=contour_levels([mn,mx],nlevels=15)
+;		levs=findgen(10+1)/10.*(mx-mn)+mn
+
+		print, 'mn mx ',mn,mx
+
+
+
+;; De-select points outside window?
+;		
+;    xnd= [ -!X.s(0), 1. ]/!X.s(1)
+;    ynd= [ -!Y.s(0), 1. ]/!Y.s(1) 
+;    ov=0                ; overlap 
+;    clip_data= [ (!ppp.position(0)-ov)*xnd(1) + xnd(0) , $
+;                 (!ppp.position(1)-ov)*ynd(1) + ynd(0) , $
+;                 (!ppp.position(2)+ov)*xnd(1) + xnd(0) , $
+;                 (!ppp.position(3)+ov)*ynd(1) + ynd(0) ]
+;
+;	wh=where(lonsel ge clip_data(0) and lonsel le clip_data(2)  and $
+;               latsel ge clip_data(1) and latsel  le clip_data(3))
+;	       if (wh(0) gt -1) then begin
+;	       	latsel=latsel(wh)
+;		lonsel=lonsel(wh)
+;		innovsel=innovsel(wh)
+;	       endif
+
+
+		print,'daymin=',daymin
+		print,'daymax=',daymax
+;		print,dayarr(wh)
+
+	
+;		titlestr=typestr+': '+titlestr
+		
+
+
+		mx=max(innovsel)
+                mn=min(innovsel)
+                if (stash.fmx ne stash.rmdi) then mx=stash.fmx
+                if (stash.fmn ne stash.rmdi) then mn=stash.fmn
+                
+;                stash.mx=mx
+;                stash.mn=mn
+                
+;		levs=contour_levels([mn,mx],nlevels=30)
+		levs=findgen(15)/15.*(mx-mn)+mn
+                                
+                print, 'typeproj: ',typeproj
+		
+;		wh=sort(innovsel)
+;		print,'innovsel ',innovsel(wh)
+
+		clr=fix((innovsel-mn)/(mx-mn)*(num_cols-1))+1
+
+; prevent colours going out of range
+		wh=where(clr lt 1)
+                if (wh(0) gt -1) then clr(wh)=1
+                wh=where(clr gt num_cols)
+                if (wh(0) gt -1) then clr(wh)=num_cols
+
+;		print,'clr ',clr(wh)
+
+                case stash.sym of
+		1: USERSYM, [-1,-1,1,1,-1],[1,-1,-1,1,1], /FILL
+                2: usersym, cos(2.0*!pi*indgen(17)/16.0), sin(2.0*!pi*indgen(17)/16.0), thick=2.0, /fill
+                endcase
+                 
+                 spawn,'echo plotpoints 3 `date`'
+                 
+;;		rgb=transpose(reform(color24_to_rgb(clr),nelwh,3))
+
+		symsize=stash.symsize*stash.symscale  
+;		for i=0L,nelsel-1 do $
+;	        plots,lonsel(i),latsel(i),psym=8,color=clr,symsize=symsize
+
+		if (stash.bindata eq 0) then begin
+        	plots,lonsel,latsel,psym=8,color=clr,symsize=symsize,noclip=0
+;       	        plots,lonsel,latsel,psym=3,color=clr
+
+;		print, 'lonsel latsel'
+;		print,lonsel, format='(4g20.10)'
+;                print,latsel, format='(4g20.10)'
+		endif
+                
+                
+;                print, 'lonseld latseld'
+;		print,lonsel - lonsel(0), format='(4g20.10)'
+;                print,latsel - latsel(0), format='(4g20.10)'
+
+;		wh=where(lonsel eq lonsel(0) and latsel eq latsel(0))
+;                print,wh
+
+		endelse
+
+                 spawn,'echo plotpoints 4 `date`'
+		print,"stash.symsize ",stash.symsize
+
+		print,'limit=',[yrange(0),xrange(0),yrange(1),xrange(1)]
+
+;		endif       ; nel lonsel > 0 
+                
+		if (stash.bindata) then begin
+                     fillval=-32000
+                     mxlat=max(latsel)
+                     mnlat=min(latsel)
+                     mxlon=max(lonsel)
+                     mnlon=min(lonsel)
+                     dlon=stash.binsize(0)
+                     dlat=stash.binsize(1)
+                     nlats=(mxlat-mnlat)/dlat+1
+                     nlons=(mxlon-mnlon)/dlon+1
+                     print,'nlons ',nlons,' nlats ',nlats
+                     if (nlats ge 2 and nlons ge 2) then begin
+                     innovsel2=fltarr(nlons,nlats)
+;                     latsel2=fltarr(nlons,nlats)
+;                     lonsel2=fltarr(nlons,nlats)
+			latsel2=findgen(nlats)*dlat+mnlat
+                        lonsel2=findgen(nlons)*dlon+mnlon
+                     innovsel2(*)=fillval			; missing data
+;                     latsel2(*)=fillval
+;                     lonsel2(*)=fillval
+                     nelin=n_elements(innovsel)
+                     print,mnlat,mnlon
+                     iiarr=(lonsel-mnlon)/dlon
+                     ijarr=(latsel-mnlat)/dlat
+                     print,min(ijarr),max(ijarr),min(ijarr),max(ijarr)
+                     info,latsel2
+                     info,lonsel2
+                     for i=0L,nelin-1 do begin
+                     ii=iiarr(i)
+                     iip=ii+1
+                     if (iip ge nlons-1) then iip=ii
+                     iim=ii-1
+                     if (iim lt 0) then iim=0
+                     ij=ijarr(i)
+                     ijp=ij+1
+                     if (ijp ge nlats-1) then ijp=ij
+                     ijm=ij-1
+                     if (ijm lt 0) then ijm=0
+
+                     innovsel2(ii,ij)=innovsel(i)
+                     ; fill in gaps
+                     if (innovsel2(iip,ij) eq fillval) then innovsel2(iip,ij)=innovsel(i)
+                     if (innovsel2(ii,ijp) eq fillval) then innovsel2(ii,ijp)=innovsel(i)
+                     if (innovsel2(iim,ij) eq fillval) then innovsel2(iim,ij)=innovsel(i)
+                     if (innovsel2(ii,ijm) eq fillval) then innovsel2(ii,ijm)=innovsel(i)
+;                     latsel2(ii,ij)=latsel(i)
+;                     lonsel2(ii,ij)=lonsel(i)
+                     endfor 
+                     info,latsel2
+                     print,latsel2
+                     info,lonsel2
+                     print,lonsel2
+                     
+                     TVLCT, R, G, B, /get
+		     TVLCT,R(1),G(1),B(1),0        ; bodge fix for wrong black contour   
+
+			wh=where(innovsel2 gt mx-(mx-mn)*0.001 and innovsel2 ne fillval)
+                        if (wh(0) gt -1) then innovsel2(wh)=mx-(mx-mn)*0.001
+			wh=where(innovsel2 lt mn and innovsel2 ne fillval)
+                        if (wh(0) gt -1) then innovsel2(wh)=mn
+
+		     levs2=nice_contourlevels([mn,mx],nlevels=50)
+
+ 		     contour,innovsel2,lonsel2,latsel2,levels=levs2, /overplot, /cell_fill, min_value=-1000
+                     
+                     TVLCT,R(0),G(0),B(0),0		; restore original colour table
+                     endif
+                     
+		endif
+
+		if (daymin eq daymax and daymin eq 0) then begin
+                	print,'No data file'
+                        xyouts, 0.15, 0.5, 'No data files', /normal, charsize=8
+                endif
+
+; plot colorbar
+		levs=nice_contourlevels([mn,mx],nlevels=10)
+
+		print, levs
+                
+		barclr=findgen(num_cols)+1
+                colorbar_idl, [mn,mx], barclr, levs
+		endif				; stash.txt eq 0
+
+		stash.busy=0
+
+                if (stash.pmulti eq 2) then begin
+                	typeproj=stash.typeproj
+                        print, 'old stash.typeproj: ',stash.typeproj	
+                	if (typeproj eq 2) then stash.typeproj=3		;plot north and south poles 
+                	if (typeproj eq 3) then stash.typeproj=2
+                        print, 'new stash.typeproj: ',stash.typeproj
+                endif
+
+		endfor			; nplots
+
+
+end
+
+;------------------------------------------
+;Profile plotting window and event handling
+;------------------------------------------
+
+PRO profilewindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq "PRINTPW") then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file="~/plotprofile.ps",landscape=landscape,ps=ps,eps=eps,color=1
+		plotprofile,stash2
+		prend2,/view
+	endif
+        if (uval eq "SAVEPW") then begin
+  		thisDevice = !D.Name
+        	psave=!p
+
+        	Set_Plot, 'Z'			; do graphics in the background
+		Device, Set_Resolution=[640,480]    ; clear any existing stuff
+        	!p.charsize=0.75
+
+		if (stash2.white_on_black eq 0) then begin
+; flip background and foreground color
+                        pcolor=!p.color
+                        pbackground=!p.background
+                        !p.color=pbackground
+                        !p.background=pcolor
+
+        	endif
+        	print,'!p.color,!p.background ',!p.color,!p.background
+
+        	setupct, r, g, b, $
+                   coltable=stash2.coltable,white_on_black=stash2.white_on_black		; setup color table
+; plot data
+  		plotprofile,stash2
+		snapshot = TVRD()
+        	WRITE_GIF,"~/plotprofile.gif",snapshot, r, g, b
+        	Device, Z_Buffer=1		; reset graphics mode
+        	Set_Plot, thisDevice
+		!p=psave
+        
+        	spawn,'xv ~/plotprofile.gif'
+        
+        endif
+        if (uval eq "TXTPW") then begin
+        	plotprofile,stash2,/txt
+        endif
+end
+
+PRO plotprofile,stash2, txt=txt
+
+	if (n_elements(txt) eq 0) then txt=0
+
+;** need to deal with multiple times
+
+	dep2=stash2.dep2
+	val2=stash2.val2
+	obs2=stash2.obs2
+	bkg2=stash2.bkg2
+	obstype2=stash2.obstype2
+        qcarr2=stash2.qcarr2
+        dayarr2=stash2.dayarr2
+	datestr=stash2.datestr
+	xselstr=stash2.xselstr
+	yselstr=stash2.yselstr
+	rmdi=stash2.rmdi
+
+        multstr=""
+	mindayarr2=min(dayarr2,max=maxdayarr2)
+        
+        whs=sort(dayarr2)
+        u=uniq(dayarr2)
+
+        nu=n_elements(u)
+        dayarr2u=dayarr2(u)
+
+        print,'dayarr2u: ',dayarr2u
+        
+        if (maxdayarr2 ne mindayarr2) then multstr="mult times "+strtrim(string(nu),2)
+
+;	print,'obstype2 ',obstype2
+
+	print,'profile plot_bad_obs: ',stash2.plot_bad_obs
+	print, obs2
+        print, bkg2
+        print, qcarr2
+
+		if (stash2.plot_bad_obs eq 0) then begin
+		wh=where(obs2 ne rmdi and qcarr2 eq 0)
+                endif else begin
+;                wh=where(obs2 eq obs2)
+		wh=where(obs2 ne rmdi)
+                endelse
+                
+		if (wh(0) gt -1) then begin
+		depo1=dep2(wh)
+		valo1=val2(wh)
+		obso1=obs2(wh)
+		bkgo1=bkg2(wh)
+                qcarro1=qcarr2(wh)
+		endif
+                
+                
+		if (stash2.plot_bad_obs eq 0) then begin
+ 		wh=where(bkg2 ne rmdi and qcarr2 eq 0)
+		endif else begin
+;                wh=where(bkg2 eq bkg2)
+		wh=where(bkg2 ne rmdi)
+                endelse
+
+		if (wh(0) gt -1) then begin
+		depb1=dep2(wh)
+		valb1=val2(wh)
+		obsb1=obs2(wh)
+		bkgb1=bkg2(wh)
+                qcarrb1=qcarr2(wh)
+		endif
+                
+
+;loop thru times
+
+		if (n_elements(bkgb1) gt 0) then begin 
+                	xmx=max([obso1,bkgb1],min=xmn)
+                        ymx=max([depo1,depb1],min=ymn)
+                endif else begin
+                	xmx=max(obso1,min=xmn)
+                        ymx=max(depo1,min=ymn)
+                endelse
+
+; set max and min depth based on selection of depths from the main window
+		if (ymx gt stash2.depmax) then ymx=stash2.depmax
+                if (ymn lt stash2.depmin) then ymn=stash2.depmin
+
+; reset xrange based on new ymx and ymn
+		if (n_elements(bkgb1) gt 0) then begin 
+                        wh1=where(depo1 ge ymn and depo1 le ymx)
+                        wh2=where(depb1 ge ymn and depb1 le ymx)
+                	if (wh1(0) gt -1 and wh2(0) gt -1) then xmx=max([obso1(wh1),bkgb1(wh2)],min=xmn)
+                endif else begin
+                        wh1=where(depo1 ge ymn and depo1 le ymx)
+                	if (wh1(0) gt -1) then xmx=max(obso1(wh1),min=xmn)
+                endelse
+
+; add a little bit to xrange to make plots look better
+		if (xmn eq xmx) then begin 
+                	xmn=xmn-0.5
+                        xmx=xmx+0.5
+                endif
+		dxrange=(xmx-xmn)*0.02
+                xmx=xmx+dxrange
+                xmn=xmn-dxrange
+
+; add a little bit to yrange to make plots look better
+		if (ymn eq ymx) then begin 
+                	ymn=ymn-0.5
+                        ymx=ymx+0.5
+                endif
+		dyrange=(ymx-ymn)*0.01
+                ymx=ymx+dyrange
+                ymn=ymn-dyrange
+		print,'** yrange: ',ymn, ymx
+
+		if (txt eq 1) then begin
+		        outfile='dataplot_profile.txt'
+			print, 'saving data to ',outfile
+			OPENW, unit, outfile, /get_lun
+                endif
+	
+		for t=0,nu-1 do begin					; loop through times
+
+		wht=where(dayarr2 eq dayarr2u(t))
+		depo=depo1(wht)
+                valo=valo1(wht)
+                obso=obso1(wht)
+                bkgo=bkgo1(wht)
+                qcarro=qcarro1(wht)
+                dayarro=dayarr2(wht)
+		if (n_elements(depb1) gt 0) then depb=depb1(wht)
+                if (n_elements(valb1) gt 0) then valb=valb1(wht)
+                if (n_elements(obsb1) gt 0) then obsb=obsb1(wht)
+                if (n_elements(bkgb1) gt 0) then bkgb=bkgb1(wht)
+                if (n_elements(qcarrb1) gt 0) then qcarrb=qcarrb1(wht)
+                
+
+
+;print data
+
+;		if (txt eq 1) then begin
+;		print,'rmdi: ',rmdi
+;                print,'profile data'
+;		for i=0,n_elements(depo)-1 do begin
+;                	print,depo(i),obso(i),bkgo(i),qcarro(i)
+;                endfor
+;                print,'profile data'
+;		for i=0,n_elements(depb)-1 do begin
+;                	print,depb(i),obsb(i),bkgb(i),qcarrb(i)
+;                endfor
+;		endif
+
+		typestr="type: "+string(obstype2(0))
+	
+;get variable type
+		vartype=size(obstype2,/type)
+		if (vartype ne 7) then begin
+			if (obstype2(0) eq rmdi) then typestr=""
+		endif
+
+; line thickness
+		thick1=2
+                thick2=2
+
+;		color1='FFCC66'x
+		color1=102
+		color2=!p.color
+                color3=234
+                
+                linestyle1=0
+                linestyle2=0
+                
+		who=sort(depo)
+                whb=sort(depb)
+
+		obso_srto=obso(who)
+                depo_srto=depo(who)
+                qcarro_srto=qcarro(who)
+                whbad=where(qcarro ne 0)
+                
+                if (txt eq 0) then begin
+                
+                if (t eq 0) then $
+ 		plot,obso_srto,depo_srto,ystyle=1,xstyle=1,linestyle=linestyle1,$
+			xrange=[xmn,xmx],yrange=[ymx,ymn],thick=thick1, $
+			psym=-4,ytitle='Level',xtitle='Value', $
+			title=datestr+" "+multstr+" ("+xselstr+","+yselstr+")   "+typestr, /nodata
+               
+                oplot,obso_srto,depo_srto,linestyle=linestyle1,psym=-4, thick=thick1, color=color1
+                if (whbad(0) gt -1) then begin
+                	oplot,obso_srto(whbad),depo_srto(whbad),psym=4, thick=thick1, color=color3
+                        oplot,obso_srto(whbad),depo_srto(whbad),psym=1, thick=thick1, color=color3
+                endif
+		if (n_elements(bkgb) gt 0) then oplot,bkgb(whb),depb(whb),psym=-5,thick=thick2, color=color2,$
+                	linestyle=linestyle2
+		xcoord=0.8
+		ycoord=0.2
+;                if (stash2.salinity eq 1) then xcoord=0.15	; left corner legend for salinity
+		nel=n_elements(who)
+                if (obso(who(0)) lt obso(who(nel-1))) then xcoord=0.15 
+                if (t eq 0) then $
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], psym=-4, linestyle=linestyle1, /normal, $
+                  	thick=thick1, color=color1
+                  xyouts, xcoord+0.05, ycoord, 'obs', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], psym=-5, linestyle=linestyle2, /normal, $
+                  	thick=thick2, color=color2
+                  xyouts, xcoord+0.05, ycoord2, 'bkg',/normal                
+                
+                endif else begin	; txt
+                  
+                  printf, unit,'observations ',n_elements(who)              
+                  for i=0L,n_elements(who)-1 do begin              
+                  	printf, unit, depo(i), obso(i), dayarro(i), format='(3f18.5)'
+                  endfor
+                  printf, unit, 'background ',n_elements(who) 
+                  for i=0L,n_elements(whb)-1 do begin
+                  	printf, unit, depb(i), bkgb(i), dayarro(i), format='(3f18.5)'
+                  endfor              
+                                
+                endelse
+                                        
+                endfor  ; t
+                
+                if (txt eq 1) then FREE_LUN, unit
+                
+end
+
+PRO profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi,salinity=salinity, $
+		plot_bad_obs=plot_bad_obs, density=density, white_on_black=white_on_black, coltable=coltable, $
+                depmax=depmax, depmin=depmin
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+        buttonBase = Widget_Base(basepw, Row=1)
+	buttonpw = WIDGET_BUTTON(buttonBase, VALUE='Print',uvalue="PRINTPW") 
+	button2pw = WIDGET_BUTTON(buttonBase, VALUE='Save',uvalue="SAVEPW")
+        button3pw = WIDGET_BUTTON(buttonBase, VALUE='Text file',uvalue="TXTPW")
+	WIDGET_CONTROL, basepw, /REALIZE
+	
+        if (n_elements(salinity) eq 0) then salinity=0
+        if (n_elements(density) eq 0) then density=0
+	if (n_elements(plot_bad_obs) eq 0) then plot_bad_obs=0
+        if (n_elements(white_on_black) eq 0) then white_on_black=1
+
+		stash2 = { dep2:dep2,val2:val2,obs2:obs2, bkg2:bkg2, $
+			obstype2:obstype2, qcarr2:qcarr2, dayarr2:dayarr2, $
+			datestr:datestr,xselstr:xselstr, yselstr:yselstr, $
+			rmdi:rmdi, salinity:salinity, plot_bad_obs:plot_bad_obs,$
+                        density:density, white_on_black:white_on_black, $
+                        coltable:coltable, depmax:depmax, depmin:depmin }
+
+		plotprofile,stash2
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash2	
+
+	XMANAGER, 'profilewindow', basepw, /NO_BLOCK	
+end
+
+;---------------------------------------
+;Worst points, window and event handling
+;---------------------------------------
+
+PRO worstpoints,stash2
+
+;stash2 is a combination of main stash and worstpoints specific stuff
+
+        xrange=stash2.xrange
+        yrange=stash2.yrange
+        selpoints,stash2,lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, obnumsel, numsel, typestr 
+
+	str1='Worst points in '+$
+        '   lons ('+strtrim(string(xrange(0)),2)+','+strtrim(string(xrange(1)),2)+$
+                	')   lats ('+strtrim(string(yrange(0)),2)+','+strtrim(string(yrange(1)),2)+')'+$
+        '   depths '+strtrim(string(long(stash2.depmin)),2)+'-'+strtrim(string(long(stash2.depmax)),2)                
+        print,str1
+
+	WIDGET_CONTROL, stash2.wwlabel1, set_value=str1
+
+        count=n_elements(innovsel)
+        wh=sort(abs(innovsel))
+        wh0=reverse(wh)			; reverse order starting with the largest        
+        cmax=min([count,10])
+	stash2.lonselw(0:cmax-1)=lonsel(wh0(0:cmax-1))
+        stash2.latselw(0:cmax-1)=latsel(wh0(0:cmax-1))
+        stash2.dayselw(0:cmax-1)=daysel(wh0(0:cmax-1))
+        print,'lon      lat       '+typestr+'     qc         date    '
+        for j1=1,cmax do begin
+           j=j1-1
+	    jul_to_dtstr,daysel(wh0(j)),datestr
+;           datedt=jul_to_dt(daysel(wh0(j)))
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+	   
+           print,lonsel(wh0(j)),latsel(wh0(j)),innovsel(wh0(j)),$
+                qcsel(wh0(j)),' ',datestr
+
+        endfor
+        
+        if (n_elements(stash2) gt 0) then begin
+        i=0
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="Lon" & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="Lat" & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value=typestr & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="QC" & i=i+1
+        WIDGET_CONTROL, stash2.labels2(i,0), set_value="Date" & i=i+1
+        
+        for j1=1,cmax do begin
+           j=j1-1
+           jul_to_dtstr,daysel(wh0(j)),datestr
+;           datedt=jul_to_dt(daysel(wh0(j)))
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+
+        i=0
+	WIDGET_CONTROL, stash2.labels2(i,j1), $
+        	set_value=strtrim(string(lonsel(wh0(j)),format='(f9.3)'),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), $
+        	set_value=strtrim(string(latsel(wh0(j)),format='(f9.3)'),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(string(innovsel(wh0(j))),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(string(qcsel(wh0(j))),2) & i=i+1
+        WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(datestr,2) & i=i+1
+
+;           print,lonsel(wh0(j)),latsel(wh0(j)),innovsel(wh0(j)),$
+;                qcsel(wh0(j)),' ',datestr
+
+        endfor
+
+        
+        endif
+	        
+
+
+
+end
+
+pro worstpointswindow,stash
+	basepw=WIDGET_BASE(/column)
+;	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+
+	wwlabel1 = WIDGET_LABEL(basepw, XSIZE=480, VALUE="Worst points")
+                
+        nj=11
+        ni=5
+	labels=intarr(nj)
+        for j=0,nj-1 do begin        
+          labels(j)=Widget_Base(basepw,row=1)
+        endfor
+
+        labsiz=[50,50,50,50,125]
+	labels2=intarr(ni+2,nj)
+        for j=0,nj-1 do begin
+         for i=0,ni-1 do begin
+         labels2(i,j) = WIDGET_LABEL(labels(j), XSIZE=labsiz(i), $ 
+    VALUE="a") 
+ 	 endfor
+         if (j gt 0) then begin
+         labels2(i,j) = WIDGET_BUTTON(labels(j), VALUE='Zoom to', uvalue="Zoom to "+strtrim(string(j),2))
+         labels2(i+1,j) = WIDGET_BUTTON(labels(j), VALUE='Profile', uvalue="Profile "+strtrim(string(j),2))
+         endif
+        endfor
+
+        stashb={ wwlabel1:wwlabel1, labels2:labels2, ni:ni, nj:nj, lonselw:dblarr(10), latselw:dblarr(10), dayselw:dblarr(10)}
+	stash2=CREATE_STRUCT(stash,stashb)
+
+	buttonpw = WIDGET_BUTTON(basepw, VALUE='Print',uvalue="PRINTPW") 
+               
+	WIDGET_CONTROL, basepw, /REALIZE
+        worstpoints,stash2
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash2
+	XMANAGER, 'worstpointswindow', basepw, /NO_BLOCK
+end
+
+PRO worstpointswindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+
+		xarr1=stash2.xarr
+		yarr1=stash2.yarr
+		dep1=stash2.dep
+		dayarr=stash2.dayarr
+		daymin=stash2.daymin
+		daymax=stash2.daymax
+                obstypes1=stash2.obstypes
+                xrange=stash2.xrange
+		yrange=stash2.yrange
+		xs=xrange(1)-xrange(0)
+		ys=yrange(1)-yrange(0)
+		rmdi=stash2.rmdi
+                if (stash2.salinity eq 0) then begin
+		  obs1=stash2.obs
+		  bkg1=stash2.bkg
+                  qcarr1=stash2.qcarr
+                endif else begin
+		  obs1=stash2.obs2
+		  bkg1=stash2.bkg2
+                  qcarr1=stash2.qcarr2
+		endelse                	
+
+	if (uval eq "PRINTTSW") then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file="~/worstpoints.ps",landscape=landscape,ps=ps,eps=eps,color=1
+		worstpoints,stash2
+		prend2,/view
+	endif
+        print,strmid(uval,0,7)
+        if (strcmp(strmid(uval,0,7),"Zoom to")) then begin
+        	num=fix(strmid(uval,7,3))
+                xsel=stash2.lonselw(num-1)
+                ysel=stash2.latselw(num-1)
+                print,num,xsel,ysel  
+                dataplot_zoom,stash2, xsel, ysel, 1
+                plotpoints,stash2              
+                           
+        endif
+        if (strcmp(strmid(uval,0,7),"Profile")) then begin
+        	num=fix(strmid(uval,7,3))
+                xsel=stash2.lonselw(num-1)
+                ysel=stash2.latselw(num-1)
+                daysel=stash2.dayselw(num-1)
+;                print,num,xsel,ysel,daysel,daysel-long(daysel),float(daysel)
+;                info,dayarr
+;                info,daysel
+;		info,xarr1
+;                info,ysel
+;                info,yarr1
+;                info,xsel
+                
+                wh1=where(xarr1 eq xsel and yarr1 eq ysel)
+;                print,'dayarr(wh1) ',dayarr(wh1), float(dayarr(wh1))
+;                print,'dayarr(wh1)-long ',dayarr(wh1)-long(dayarr(wh1))
+;                print,'dep1(wh1) ',dep1(wh1)
+                wh2=where(xarr1 eq xsel and yarr1 eq ysel and float(dayarr) eq float(daysel))
+;                print,'wh2 ',wh2
+;                if (wh2(0) gt -1) then print,'daysel(wh2) ',daysel(wh2)
+       
+        	wh=where(xarr1 eq xsel and yarr1 eq ysel and long(dayarr) eq long(daysel))
+                if (wh(0) gt -1) then begin
+		dep2=dep1(wh)
+		val2=abs(obs1(wh)-bkg1(wh))
+		obs2=obs1(wh)
+		bkg2=bkg1(wh)
+		obstype2=obstypes1(wh)
+                qcarr2=qcarr1(wh)
+                dayarr2=dayarr(wh)
+		jul_to_dtstr,stash2.dayselw(num-1),datestr
+		xselstr=string(xsel)
+		yselstr=string(ysel)
+
+		profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi, salinity=stash2.salinity, $
+                	white_on_black=stash.white_on_black, coltable=stash.coltable, depmax=stash.depmax, depmin=stash.depmin
+                endif
+	endif
+
+; store values
+  WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2 
+
+end
+
+PRO filterwindow, stash
+
+	val=stash.obstypeselect
+
+	obstypes=stash.obstypes
+        uniquetypes=strjoin(obstypes(uniq(obstypes, sort(obstypes))),string(10b))
+        
+	base = WIDGET_BASE(GROUP_LEADER=stash.base ,/modal,/column) 
+        
+        
+	intextid = CW_FIELD(base, TITLE = "Filter type", /FRAME, value=val, uvalue='intext', /RETURN_EVENTS) 
+        outtextid = WIDGET_TEXT(base, value="Choose from:"+string(10b)+uniquetypes, $
+        	scr_xsize=200, scr_ysize=200, /scroll) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+	   acceptID = Widget_Button(buttonBase, Value='Accept', uvalue='accept')
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid:intextid }
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'filterwindow', base        
+
+        theText = (*ptr).text
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',theText, nocancel
+
+; if obstypeselect has changed then replot the points
+                
+        if (stash.obstypeselect ne theText and nocancel eq 1) then begin
+                stash.obstypeselect=theText
+        	plotpoints,stash
+        endif
+        
+        
+end
+
+PRO filterwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,uval
+        print,val
+
+	if (uval eq "accept" or uval eq "intext") then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid, Get_Value=theText
+	print,'the text ',theText
+
+        (*stash2.ptr).text=theText
+        (*stash2.ptr).nocancel=1
+        endif         
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+;--------------------------------------
+; Input area
+;--------------------------------------
+
+PRO inputareawindow, xrange, yrange, toplevel, success
+
+        val1=xrange(0)
+        val2=xrange(1)
+        val3=yrange(0)
+        val4=yrange(1)
+        
+	base = WIDGET_BASE(GROUP_LEADER=toplevel,/modal,/column) 
+                
+	intextid1 = CW_FIELD(base, TITLE = "lon1", /FRAME, value=val1, uvalue='intext1', /RETURN_EVENTS) 
+ 	intextid2 = CW_FIELD(base, TITLE = "lon2", /FRAME, value=val2, uvalue='intext2', /RETURN_EVENTS) 
+	intextid3 = CW_FIELD(base, TITLE = "lat1", /FRAME, value=val3, uvalue='intext3', /RETURN_EVENTS) 
+	intextid4 = CW_FIELD(base, TITLE = "lat2", /FRAME, value=val4, uvalue='intext4', /RETURN_EVENTS) 
+
+;       outtextid = WIDGET_TEXT(base, value="Choose from:"+string(10b)+uniquetypes, $
+;        	scr_xsize=200, scr_ysize=200, /scroll) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   acceptID = Widget_Button(buttonBase, Value='Accept', uvalue='accept')
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text1:"", text2:"", text3:"", text4:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid1:intextid1,  intextid2:intextid2, $
+         	intextid3:intextid3, intextid4:intextid4}
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'inputareawindow', base        
+
+        lon1 = (*ptr).text1
+        lon2 = (*ptr).text2
+        lat1 = (*ptr).text3
+        lat2 = (*ptr).text4
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',lon1, lon2, lat1, lat2, nocancel
+
+; if obstypeselect has changed then replot the points
+                
+        if (nocancel eq 1) then begin
+		xrange=[float(lon1),float(lon2)]
+                yrange=[float(lat1),float(lat2)]
+                xrange=xrange(sort(xrange))
+                yrange=yrange(sort(yrange))
+                wh=where(xrange gt 360)
+                if (wh(0) gt -1) then xrange(wh)=360
+                wh=where(xrange lt -180)
+                if (wh(0) gt -1) then xrange(wh)=-180
+                wh=where(yrange gt 90)
+                if (wh(0) gt -1) then yrange(wh)=90
+                wh=where(yrange lt -90)
+                if (wh(0) gt -1) then yrange(wh)=-90
+                
+                if (xrange(0) eq xrange(1)) then xrange(1)=xrange(1)+0.1 
+                if (yrange(0) eq yrange(1)) then yrange(1)=yrange(1)+0.1
+                
+                success=1
+        endif
+        
+        
+end
+
+PRO inputareawindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,uval
+        print,val
+
+	if (uval eq 'accept') then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid1, Get_Value=theText1
+	Widget_Control, stash2.intextid2, Get_Value=theText2
+        Widget_Control, stash2.intextid3, Get_Value=theText3
+        Widget_Control, stash2.intextid4, Get_Value=theText4
+	print,'the text ',theText1, theText2, theText3, theText4
+
+        (*stash2.ptr).text1=theText1
+        (*stash2.ptr).text2=theText2
+        (*stash2.ptr).text3=theText3
+        (*stash2.ptr).text4=theText4
+        (*stash2.ptr).nocancel=1
+        endif         
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+;--------------------------------------
+; Input max min
+;--------------------------------------
+
+PRO inputmxmnwindow, fmx, fmn, mx, mn, rmdi, toplevel, success
+
+	print,'fmx/mn ',fmx,fmn
+        print,'mx/mn ',mx,mn
+
+        val1=mx
+        val2=mn
+
+	base = WIDGET_BASE(GROUP_LEADER=toplevel,/modal,/column) 
+                
+	intextid1 = CW_FIELD(base, TITLE = "mx", /FRAME, value=val1, uvalue='intext1', /RETURN_EVENTS) 
+ 	intextid2 = CW_FIELD(base, TITLE = "mn", /FRAME, value=val2, uvalue='intext2', /RETURN_EVENTS) 
+
+	text="Max and min not locked"
+        if (fmx ne rmdi) then text="Max locked"
+        if (fmn ne rmdi) then text="Min Locked"
+        if (fmx ne rmdi and fmn ne rmdi) then text="Max and min locked"
+        outtextid = WIDGET_TEXT(base, value=text, $
+        	scr_xsize=200, scr_ysize=40) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   acceptID = Widget_Button(buttonBase, Value='Accept/lock', uvalue='accept')
+           resetID = Widget_Button(buttonBase, Value='Reset/free', uvalue='reset')
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+           
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text1:"", text2:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid1:intextid1,  intextid2:intextid2}
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'inputmxmnwindow', base        
+
+        fmx = float((*ptr).text1)
+        fmn = float((*ptr).text2)
+
+	info, fmx
+        info, fmn
+
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',fmx,fmn, mx, mn
+
+; if obstypeselect has changed then replot the points
+                
+        if (nocancel eq 1) then begin                
+                success=1
+        endif
+	if (nocancel eq 2) then begin
+        	fmx=rmdi
+                fmn=rmdi
+                success=1
+        endif
+ 
+end
+
+PRO inputmxmnwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,'uval ',uval,' val ',val
+
+	if (uval eq 'accept') then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid1, Get_Value=theText1
+	Widget_Control, stash2.intextid2, Get_Value=theText2
+	print,'the text ',theText1, theText2
+
+        (*stash2.ptr).text1=theText1
+        (*stash2.ptr).text2=theText2
+        (*stash2.ptr).nocancel=1
+        endif         
+
+	if (uval eq 'reset') then begin
+        (*stash2.ptr).nocancel=2
+        endif
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+
+
+pro infowindow
+	basepw=WIDGET_BASE(/column)
+	xsz=360
+
+        iwlabel0 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="Dataplot")
+        iwlabela = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="--------")
+        iwlabelb = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="")      
+	iwlabel1 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="To report bugs or for help")
+        iwlabel2 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="contact Dan Lea")
+        iwlabel3 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="daniel.lea@metoffice.gov.uk")
+ 	               
+	WIDGET_CONTROL, basepw, /REALIZE
+
+;	WIDGET_CONTROL, basepw, SET_UVALUE=stash2
+;	XMANAGER, 'worstpointswindow', basepw, /NO_BLOCK
+end
+
+PRO dataplot_zoom, stash, xdata, ydata, zoominout
+
+		xrange=stash.xrange
+		yrange=stash.yrange
+		xrangedef=stash.xrangedef
+		yrangedef=stash.yrangedef
+	
+
+		print,xrange,yrange
+
+;		zx=xrange(0)
+;		zy=yrange(0)
+		sx=xrange(1)-xrange(0)
+		sy=yrange(1)-yrange(0)
+		sxd=xrangedef(1)-xrangedef(0)
+		syd=yrangedef(1)-yrangedef(0)
+
+		print,sx,sy
+
+		if (zoominout eq 1) then begin
+		sx=sx/2.
+		sy=sy/2.
+; try to squarify for zoomed in version
+		sx2=(sx+sy)/2.
+;		sx=max(sx,sx2)
+;		sy=max(sy,sx2) 
+;		sx=(sx+sx2)/2.
+;		sy=(sy+sx2)/2.
+
+; try to tend to initial proportions for zooming in
+		sx=(sx+1.0*(sxd*0.5/(sxd+syd)))/2.
+                sy=(sy+1.0*(syd*0.5/(sxd+syd)))/2.
+
+		endif
+		if (zoominout eq -1) then begin
+		sx=sx*2.
+		sy=sy*2.
+ ; try to make similar to initial proportions for zooming out               
+                sx2=(sx+sy)*2.
+		sx=(sx+sx2*(sxd*0.5/(sxd+syd)))/2.
+		sy=(sy+sx2*(syd*0.5/(sxd+syd)))/2.
+                
+		endif
+		
+
+		print,'sx sy ',sx,sy, xdata, ydata
+
+                oxrange=xrange                
+		
+		xrange=[xdata-sx/2.,xdata+sx/2.]
+		yrange=[ydata-sy/2.,ydata+sy/2.]
+
+		if (oxrange(1) le 180) then begin		; 0 longitude centred
+		if (xrange(0) lt xrangedef(0)) then xrange(0)=xrangedef(0)
+		if (xrange(1) gt xrangedef(1)) then xrange(1)=xrangedef(1)
+		endif else begin				; 180 longitude centred
+ 		if (xrange(0) lt xrangedef(0)+180) then xrange(0)=xrangedef(0)+180
+		if (xrange(1) gt xrangedef(1)+180) then xrange(1)=xrangedef(1)+180
+		endelse               
+
+		if (yrange(0) lt yrangedef(0)) then yrange(0)=yrangedef(0)
+		if (yrange(1) gt yrangedef(1)) then yrange(1)=yrangedef(1)
+
+		print,'xrange ',xrange,' yrange ',yrange
+                
+                stash.xrange=xrange
+		stash.yrange=yrange
+
+end
+
+;---------------------------------------
+;Time series plotting and event handling
+;---------------------------------------
+
+PRO plottimeseries, stash
+ 
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+		dayminl=stash.dayminl
+      daymaxl=stash.daymaxl
+
+		numtimeseries=stash.numtimeseries		; if 1 then plot number of points
+
+;		print,depmin,xrange,yrange
+
+;		wh=where(dep1 eq ev.index)
+;		wh=where(dep1 eq depmin and $
+;			dayarr ge daymin and dayarr le daymax)
+
+;	
+
+;		nelwh=n_elements(wh)
+
+		; select points to plot
+		typestr=''
+
+		if (stash.plottssel eq 1) then begin
+         dayminl=daymin
+         daymaxl=daymax
+      endif
+
+		print,'djl ',dayminl,daymaxl, min(stash.dayarr), max(stash.dayarr)
+
+		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+                	daymin=dayminl, daymax=daymaxl, /rmsmean, innovsel2=innovsel2
+
+		print,'djl ',min(daysel), max(daysel)
+
+		if (stash.plottssel eq 1) then begin
+                	daymaxl=daymaxl+1
+                endif
+		   
+
+;		plot,daysel, ystyle=1
+
+		print,'n_elements(daysel) ',n_elements(daysel), min(daysel), max(daysel) 
+		print, dayminl, daymaxl
+
+; group in 1/4 day bins
+
+;		binspday=double(4.0)    ; every 6 hours
+;                binspday=double(8.0)    ; every 3 hours
+		binspday=double(stash.binspday)
+		nbins=(daymaxl-dayminl)*binspday+1
+
+		print, daymaxl, dayminl, binspday
+
+                x2arr=dblarr(nbins)
+                xarr=dblarr(nbins)
+                narr=dblarr(nbins)
+                tarr=dblarr(nbins)
+		meants=dblarr(nbins)
+                rmsts=dblarr(nbins)
+  
+		print, 'nbins: ',nbins
+
+		if n_elements(innovsel) gt 0 then begin
+
+		print,max(daysel),min(daysel)
+  
+                for ibin=0L,nbins-1 do begin
+                  timmn=double(dayminl)+ibin/binspday
+                  timmx=timmn+1/binspday
+;                  print, ibin, timmn, timmx, timmx-timmn
+                  wh=where(daysel ge timmn and daysel lt timmx, count)
+                  print, 'ibin ',ibin, timmn, timmx, count
+; redo based on the number of observations
+                  if (wh(0) ne -1) then begin
+                  innovsels=innovsel(wh)
+                  innovsel2s=innovsel2(wh)
+                  numsels=numsel(wh)
+                  
+		  x2arr(ibin)=total(innovsel2s*numsels)
+		  xarr(ibin)=total(innovsels*numsels)
+;		  narr(ibin)=n_elements(innovsels)
+		  narr(ibin)=total(numsels)
+;                  print,ibin, x2arr(ibin), xarr(ibin)
+                  endif
+                  tarr(ibin)=timmn
+                endfor
+
+		meants=xarr/narr
+                rmsts=sqrt(x2arr/narr)
+
+;		print,'meants: ',meants
+;		print,'rmsts: ',rmsts
+
+		endif	; n_elements(innovsel)
+
+		wh=where(finite(meants))		; find finite values
+		ymx=max([meants(wh),rmsts(wh)],min=ymn)
+
+;put a bit of white space around ymx,ymn
+		dymxmn=(ymx-ymn)*0.02
+                ymx=ymx+dymxmn
+                ymn=ymn-dymxmn
+
+		print,'ymx/mn ',ymx,ymn
+
+                strtsal=''
+;                print,'stash.filetype ',stash.filetype
+                if (stash.filetype eq 'Prof' or stash.filetype eq 'feedback') then begin
+                	strtsal='T:  '
+                        if (stash.salinity eq 1) then strtsal='S:  '
+                endif else begin
+                	strtsal=stash.filetype+':  '
+                endelse
+
+                title=strtsal+typestr+'   lons ('+string(xrange(0))+','+string(xrange(1))+$
+                	')   lats ('+string(yrange(0))+','+string(yrange(1))+')'  
+                print,title            
+
+;                dtarr=jul_to_dt(tarr)   
+		dtarr=tarr-0.5			; convert back to julian day
+
+		xmx=max(dtarr,min=xmn)
+;put a bit of white space around xmx,xmn
+		dxmxmn=(xmx-xmn)*0.02
+                xmx=xmx+dxmxmn
+                xmn=xmn-dxmxmn
+
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%I:%S', '%H', '%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+
+	if (stash.txt eq 0) then begin
+	if (numtimeseries ne 1) then begin                       
+		plot,dtarr, meants, xstyle=1, linestyle=1, yrange=[ymn,ymx], title=title, $
+                       ytitle=typestr, xrange=[xmn,xmx], $
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4] 
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+		plot, dtarr, rmsts, xstyle=1, yrange=[ymn,ymx], /noerase, $
+                       ytitle=typestr, xrange=[xmn,xmx], $
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.35
+                ycoord=0.2
+;		ukmo_legend,xcoord=xcoord,ycoord=ycoord,delta_y=0.05,$
+;			['RMS','mean'],linestyle=[0,1],/normal
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], linestyle=0, /normal
+                  xyouts, xcoord3, ycoord, 'RMS', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], linestyle=1, /normal
+                  xyouts, xcoord3, ycoord2, 'mean',/normal                
+
+	endif else begin
+		plot,dtarr, narr, xstyle=1, title=title, $
+                       ytitle='number of obs', $ 
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+      
+	endelse
+	endif else begin
+
+        outfile=stash.outfile+'_timeseries.txt'
+	print, 'saving data to ',outfile
+	OPENW, unit, outfile, /get_lun
+;   		printf,unit,'Output timeseries data: '
+		printf,unit, strtsal
+                printf,unit, typestr
+                printf,unit, xrange, yrange
+                printf,unit, binspday
+                nel=n_elements(dtarr)
+                for i=0L,nel-1 do begin
+                	printf,unit, dtarr(i), narr(i), meants(i), rmsts(i),format='(d18.8,d18.2,d18.8,d18.8)'
+                endfor
+        FREE_LUN, unit
+
+	endelse
+
+;		print,'min/max lonsel: ',min(lonsel),max(lonsel)
+
+end
+
+PRO timeserieswindow, stash
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+        buttons=Widget_Base(basepw,row=1)
+        
+        tlb = Widget_Base(buttons,Title='Push-Buttons', row=1, Scr_XSize=400,$
+       /Exclusive)
+; no_release only sends select events (not release ones)
+   	buttonp1 = Widget_Button(tlb, Value='1 bin per day',uvalue='RADIO1',/no_release)
+   	buttonp2 = Widget_Button(tlb, Value='2 bins',uvalue='RADIO2',/no_release)
+   	buttonp3=  Widget_Button(tlb, Value='4 bins',uvalue='RADIO3',/no_release)
+   	buttonp4 = Widget_Button(tlb, Value='8 bins',uvalue='RADIO4',/no_release)
+
+	if (stash.binspday eq 1) then Widget_Control, buttonp1, Set_Button=1
+	if (stash.binspday eq 2) then Widget_Control, buttonp2, Set_Button=1
+       	if (stash.binspday eq 4) then Widget_Control, buttonp3, Set_Button=1
+	if (stash.binspday eq 8) then Widget_Control, buttonp4, Set_Button=1
+ 
+        tlb2 = Widget_Base(buttons,Title='Push-Buttons', row=1, Scr_XSize=100,$
+       /NonExclusive)
+	buttonpa1= Widget_Button(tlb2, Value='plot selected period',uvalue='PLOTSEL')
+
+
+	Widget_Control, buttonpa1, Set_Button=stash.plottssel
+        
+	buttonpw = WIDGET_BUTTON(buttons, VALUE='Print',uvalue='PRINTTSW') 
+        buttonpw2 = WIDGET_BUTTON(buttons, VALUE='Output',uvalue='OUTPUTTSW')
+        
+	WIDGET_CONTROL, basepw, /REALIZE
+
+	xyouts,0.2,0.5,'working...',/normal,charsize=2.5
+	
+        plottimeseries,stash
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash	
+
+	XMANAGER, 'timeserieswindow', basepw, /NO_BLOCK	
+end
+
+PRO timeserieswindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq 'PRINTTSW') then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file='~/timeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1
+		plottimeseries,stash
+		prend2,/view
+	endif
+        if (uval eq 'OUTPUTTSW') then begin
+        	savetxt=stash.txt
+                stash.txt=1
+        	plottimeseries,stash
+                stash.txt=savetxt
+        endif
+        if (uval eq 'RADIO1') then begin
+        	stash.binspday=1
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO2') then begin
+        	stash.binspday=2
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO3') then begin
+        	stash.binspday=4
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO4') then begin
+        	stash.binspday=8
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'PLOTSEL') then begin
+        	stash.plottssel=1-stash.plottssel
+                print,'stash.plottssel ',stash.plottssel
+                WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash
+                plottimeseries,stash        
+        endif
+
+        
+end
+
+;----------------------------------------
+; T-S diagram plotting and event handling
+;----------------------------------------
+
+PRO plottsdiagram, stash
+ 
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+		dayminl=stash.dayminl
+                daymaxl=stash.daymaxl
+                xarr=stash.xarr
+                yarr=stash.yarr
+                rmdi=stash.rmdi
+
+		; select T and S points to plot
+		typestr=''
+      		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+                	daymin=dayminl, daymax=daymaxl, salinity=1
+                        
+                ; select points with salinity
+                
+                nel=n_elements(lonsel)
+                
+                if (nel gt 0) then begin
+
+		  bkg=stash.bkg
+                  bkg2=stash.bkg2
+                  obs=stash.obs
+                  obs2=stash.obs2
+                  dep=stash.dep
+                  strtarr=0
+ 		  depmin=stash.depmin
+		  depmax=stash.depmax
+                 
+		  for i=0L,nel-1 do begin
+			wh=where(lonsel(i) eq xarr and latsel(i) eq yarr and $
+                          dep ge depmin and dep le depmax )
+                        if (wh(0) gt -1) then begin
+                        if (strtarr eq 0) then begin
+                          strtarr=1
+                          bkgsel=bkg(wh)
+                          bkg2sel=bkg2(wh)
+                          obssel=obs(wh)
+                          obs2sel=obs2(wh)
+                        endif else begin
+		          bkgsel=[bkgsel,bkg(wh)]
+                          bkg2sel=[bkg2sel,bkg2(wh)]
+		          obssel=[obssel,obs(wh)]
+                          obs2sel=[obs2sel,obs2(wh)]
+                        endelse
+                        endif              
+                  endfor
+
+               ;filter out points with missing data
+               
+               wh=where(bkgsel ne rmdi and bkg2sel ne rmdi $
+                    and obssel ne rmdi and obs2sel ne rmdi)
+               
+                if (wh(0) gt -1) then begin
+                  obssel=obssel(wh)
+                  bkgsel=bkgsel(wh)
+                  obs2sel=obs2sel(wh)
+                  bkg2sel=bkg2sel(wh)              
+                  
+                  xmn=min([obssel,bkgsel],max=xmx)
+                  ymn=min([obs2sel,bkg2sel],max=ymx)
+               
+               title='T-S diagram: dep '+string(depmin)+'-'+string(depmax)
+               
+		plot,obssel,obs2sel,psym=4, color='FFFFFF'x, xtitle='Temperature',ytitle='Salinity',$
+                	xrange=[xmn,xmx], yrange=[ymn,ymx],xstyle=1,ystyle=1, title=title
+                oplot,bkgsel,bkg2sel,psym=5, color='FFCC66'x
+
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.2
+;		ukmo_legend,xcoord=xcoord,ycoord=ycoord,delta_y=0.05,$
+;			['obs','bkg'],psym=[4,5],color=['FFFFFF'x, 'FFCC66'x],/normal
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], psym=4, color='FFFFFF'x, /normal
+                  xyouts, xcoord+0.05, ycoord, 'obs', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], psym=5, color='FFCC66'x, /normal
+                  xyouts, xcoord+0.05, ycoord2, 'bkg',/normal                
+
+
+               endif
+               endif
+
+end
+
+PRO tsdiagramwindow, stash
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+	buttonpw = WIDGET_BUTTON(basepw, VALUE='Print',uvalue='PRINTTSW') 
+	WIDGET_CONTROL, basepw, /REALIZE
+	
+        plottsdiagram,stash
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash	
+
+	XMANAGER, 'tsdiagramwindow', basepw, /NO_BLOCK	
+end
+
+PRO tsdiagramwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq 'PRINTTSW') then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file='~/tsdiagram.ps',landscape=landscape,ps=ps,eps=eps,color=1
+		plottsdiagram,stash
+		prend2,/view
+	endif
+end
+
+PRO jul_to_dtstr, daysel, datestr, notime=notime
+
+;print,'called jul_to_dtstr ',daysel
+
+; IDL Julian days start at 12 noon
+
+	CALDAT, daysel(0)-0.5, Month, Day, Year, Hour, Minute, Second
+           datestr=strtrim(fix(year),2)+'/'+ $
+	     strtrim(string(fix(month),format='(i2.2)'),2)+'/'+ $
+	     strtrim(string(fix(day),format='(i2.2)'),2)
+             
+             if (n_elements(notime) eq 0) then $
+             	datestr=datestr+' '+$
+	     strtrim(string(fix(hour),format='(i2.2)'),2)+':'+ $
+	     strtrim(string(fix(minute),format='(i2.2)'),2)+':'+ $
+	     strtrim(string(fix(second),format='(i2.2)'),2)
+
+;           datedt=jul_to_dt(daysel)
+;           datedt=datedt(0)
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+
+;print,datestr
+
+END
+
+;-----------------------------------------------------------------------
+; MAIN routine
+; Widget creation routine. 
+;  dataplot, [longitude, latitude, deparr, dayarr, valarr, bkgarr]
+;+
+PRO dataplot, indata, rmdi=rmdi, filename=filename, salinity=salinity, batch=batch, $
+	ps=ps, gif=gif, area=area, typeplot=typeplot, ombtypeplot=ombtypeplot, $
+        alldays=alldays, depths=depths, $
+        mx=mx, mn=mn, showmdt=showmdt, obstypeselect=obstypeselect, printobstypes=printobstypes, $
+        daterange=daterange, timeseries=timeseries, binspday=binspday, plot_bad_obs=plot_bad_obs, $
+        plot_only_bad_obs=plot_only_bad_obs, $
+        numtimeseries=numtimeseries, txt=txt, netcdf=netcdf, vertgrad=vertgrad, healthcheck=healthcheck, $
+        duplicates=duplicates, differences=differences, outfile=outfile, white_on_black=white_on_black, $
+        bindata=bindata, symscale=symscale, hiresmap=hiresmap, coltable=coltable, $
+        picsize=picsize, pmulti=pmulti, typeproj=typeproj, dayrange=dayrange, $
+        notfussy=notfussy, mld=mld, binsize=binsize, filterout=filterout
+;-
+	
+; DJL switch off wave compatibility mode
+res=execute('waveoff')
+
+; string array obstypeselect
+
+if (n_elements(obstypeselect) eq 0) then obstypeselect=''
+if (n_elements(printobstypes) eq 0) then printobstypes=''
+if (n_elements(filterout) eq 0) then filterout=''
+
+if (n_elements(binspday) eq 0) then binspday=4		; plot timeseries every 6 hours
+plottssel=0	; plot selected period of timeseries
+if (n_elements(plot_bad_obs) eq 0) then plot_bad_obs=0	; don't plot bad obs
+
+if (n_elements(plot_only_bad_obs) eq 0) then plot_only_bad_obs=1	; plot only bad obs if selected
+if (n_elements(white_on_black) eq 0) then white_on_black=1
+
+if (n_elements(duplicates) eq 0) then duplicates=0	; plot only duplicates if selected
+if (n_elements(differences) eq 0) then differences=0	; plot only differences if selected
+
+if (n_elements(numtimeseries) eq 0) then numtimeseries=0	; plot time series of O-B
+
+if (n_elements(txt) eq 0) then txt=0
+
+if (n_elements(netcdf) eq 0) then netcdf=0			; if 1 the output netcdf data
+
+print,obstypeselect
+
+if (n_elements(salinity) eq 0) then salinity=0
+density=0
+if (n_elements(vertgrad) eq 0) then vertgrad=0
+
+if (n_elements(mld) eq 0) then mld=0
+
+if (n_elements(outfile) eq 0) then outfile="dataplot"
+
+if (n_elements(bindata) eq 0) then bindata=0
+
+if (n_elements(binsize) eq 0) then binsize=[1.0,1.0]
+
+if (n_elements(symscale) eq 0) then symscale=1.0
+
+if (n_elements(hiresmap) eq 0) then begin
+	hires_map=0
+endif else begin
+	hires_map=hiresmap
+endelse
+
+if (n_elements(rmdi) eq 0) then rmdi=0
+
+if (n_elements(coltable) eq 0) then begin
+	coltable=-1
+endif
+
+if (n_elements(picsize) ne 2) then picsize=[800,512]	; default gif resolution
+
+if (n_elements(pmulti) eq 0) then pmulti=0		; default pmulti
+
+sz=size(indata)
+nsz=n_elements(sz)
+type=sz(nsz-2)	; get type 2 integer, 4 float, 7 string
+if (type eq 7) then filename=indata
+
+if (type ne 7) then begin
+   nel=n_elements(indata)
+   nel8=nel/8
+   numobs=nel8
+
+   ; get input values
+   if (nel gt 0) then begin
+      indata=reform(indata,numobs,8)
+      xarr=indata(*,0)
+      yarr=indata(*,1)
+      dep=indata(*,2)
+      dayarrin=indata(*,3)
+      obs=indata(*,4)
+      bkg=indata(*,5)
+      obs2=rmdi
+      obs3=rmdi
+      bkg2=rmdi
+      qcarr=long(indata(*,6))
+      qcarr2=rmdi
+      obnum=rmdi
+      obstypes=long(indata(*,7))
+      filetype="generic"
+      
+      print, 'djl max/min dayarrin ',max(dayarrin), min(dayarrin)
+      print, 'djl max/min qcarr ',max(qcarr), min(qcarr)
+      
+   endif
+endif else begin
+   if (n_elements(filename) eq 0) then begin
+       print,'ERROR: No filename supplied'
+       print,'call: dataplot, filenamearr'
+       return
+   endif
+endelse
+
+;read in data
+if (n_elements(filename) gt 0) then begin
+	read_cdfobs, filename, numobs=numobs, Latitudes=yarr, Longitudes=xarr, $
+	      obs=obs, modelvals=bkg, qcs=qcarr, $
+         ob2=obs2, modelval2=bkg2, qc2=qcarr2, $
+         ob3=obs3, $
+         Dates=dayarrin, rmdi=rmdi, $
+	      depths=dep, nodates=0, types=obstypes, $
+         filetype=filetype, iobs=iobs, jobs=jobs, MDT=MDT, error=error, profilenum=obnum, $
+         notfussy=notfussy, VarName=varname
+
+	if (error eq 1) then begin
+           numobs=0
+           dayarrin=0
+           rmdi=-99999
+           xarr=rmdi
+           yarr=rmdi
+           obs=rmdi
+           bkg=rmdi
+           qcarr=1
+           dayarrin=rmdi
+           dayarr=rmdi
+           dep=rmdi
+           filetype=""
+           obstypes=rmdi
+           obnum=0
+	endif 
+
+	print,'error ',error, numobs
+
+	if (numobs gt 0) then begin
+        print, 'numobs ',numobs
+
+;setup obnum if it is not produced by read_cdfobs
+
+	if (n_elements(obnum) ne numobs and numobs gt 0) then begin
+		obnum=lindgen(n_elements(numobs))	; generate an array of observation numbers
+                					; starting with zero
+        endif
+
+
+
+;if gt 180 then make longitudes negative
+
+	  wh=where(xarr ge 180 and xarr le 360)
+	  if (wh(0) gt -1) then begin
+ 	    xarr(wh)=xarr(wh)-360
+	  endif
+
+
+;calculate vertical gradient
+;
+;	  if (filetype eq "Prof") then $
+;	  calcvertgrad, xarr, yarr, dayarrin, obs, bkg, qcarr, obs2,bkg2, qcarr2, dep, rmdi
+
+; adjust qc values for profile obs data (1 = good)
+	  wh=where(bkg ne rmdi)
+          if (n_elements(bkg2) gt 0) then begin
+            wh2=where(bkg2 ne rmdi)
+	    if (filetype eq "Prof" and wh(0) eq -1 and wh2(0) eq -1) then begin
+              qcarr=qcarr-1 
+              qcarr2=qcarr2-1
+	    endif
+	  endif
+ 
+          if (keyword_set(showmdt) eq 1) then begin
+	    bkg=MDT
+          endif
+
+
+	  print,'rmdi ',rmdi
+
+	  print,'file read in'
+
+spawn,'echo part 1 `date`'
+
+	  if (n_elements(rmdi) eq 0) then rmdi=-1.07374e+09
+
+	  qcarr=fix(qcarr)
+
+	endif		; numobs
+
+	print,'endif numobs'
+
+; select area
+
+        sz=size(area)
+        nsz=n_elements(sz)
+        type=sz(nsz-2)	; get type 2 integer, 4 float, 7 string
+        if (type eq 7) then areasel, area, xrange, yrange, success
+        if (type eq 4 or type eq 2) then begin
+	  if (nsz eq 4) then begin
+             xrange=[area(0),area(2)]
+             yrange=[area(1),area(3)]
+          endif
+	endif			
+
+; set missing obs types to missing data
+        if (n_elements(obs2) eq 0) then begin
+          obs2=rmdi
+          bkg2=rmdi
+          qcarr2=rmdi
+       endif
+        if (n_elements(obs3) eq 0) then begin
+          obs3=rmdi
+          bkg3=rmdi
+          qcarr3=rmdi
+       endif
+
+endif		; filename
+
+if (n_elements(varname) eq 0) then varname=''
+
+	  if (n_elements(dayarrin) ne numobs) then dayarrin=replicate(1,numobs)
+;	    dep=replicate(0,numobs)
+
+
+	  if (size(dayarrin,/type) eq 8) then begin 
+  	    dayarr=dayarrin.julian
+          endif else begin
+  	    dayarr=dayarrin
+            dayarr=dayarr+0.5			; dataplot prefers each day to be a different integer
+          endelse
+
+print,'xxx'
+
+;set contour range mn, mx
+if (n_elements(mx) eq 0) then fmx=rmdi else fmx=mx
+if (n_elements(mn) eq 0) then fmn=rmdi else fmn=mn
+mx=fmx
+mn=fmn
+
+
+
+  ; Define a monochrome image array for use in the application. 
+;  READ_PNG, FILEPATH('mineral.png', $ 
+;    SUBDIR=['examples', 'data']), image 
+ 
+  ; Place the image array in a pointer heap variable, so we can 
+  ; pass the pointer to the event routine rather than passing the 
+  ; entire image array. 
+;  imagePtr=PTR_NEW(image, /NO_COPY) 
+ 
+  ; Retrieve the size information from the image array. 
+;  im_size=SIZE(*imagePtr) 
+
+;---------------
+;Setup defaults
+;---------------
+
+  busy=0
+  wh=where(dep ge 0)
+  depminl=0.
+  depmaxl=1.
+  if( wh(0) gt -1) then depminl=min(dep(wh),max=depmaxl)
+  depscl=fix((depmaxl-depminl)/100.)
+  if (depscl lt 1) then depscl=1
+  depmin=depminl
+;  depmax=depmin+depscl  
+  depmax=depmaxl
+  pmultinum=0
+
+if (n_elements(depths) eq 2) then begin
+
+ depmin=max([depminl,depths(0)])
+ depmax=min([depmaxl,depths(1)])
+endif
+
+	print,'n_elements(typeplot) ',n_elements(typeplot)
+
+   if (n_elements(typeplot) eq 0) then typeplot=1
+;   if (n_elements(where(bkg ne bkg(0))) gt 1) then begin
+;   	typeplot=3
+;   endif else begin
+;   	typeplot=4
+;   endelse
+;   endif
+   if (typeplot gt 4) then typeplot=4
+   if (typeplot lt 1) then typeplot=1
+   
+   if (n_elements(ombtypeplot) eq 0) then begin
+    if (n_elements(where(bkg ne bkg(0))) gt 1) then begin
+   	ombtypeplot=1
+    endif else begin
+   	ombtypeplot=2
+    endelse
+   endif
+   if (ombtypeplot gt 3) then ombtypeplot=3
+   if (ombtypeplot lt 1) then ombtypeplot=1
+
+   	print,'typeplot ',typeplot, ' ombtypeplot ',ombtypeplot
+   
+    if (n_elements(typeproj) eq 0) then typeproj=1
+
+	xrangedef=[-110.,40.]
+	yrangedef=[-50.,80.]
+	wh=where(xarr lt xrangedef(0) or xarr gt xrangedef(1) or $
+		yarr lt yrangedef(0) or yarr gt yrangedef(1),count)
+	if (count gt 0) then begin
+		xrangedef=[-180.,180.]
+		yrangedef=[-90.,90.]
+	endif
+
+	if (n_elements(xrange) eq 0) then begin
+ 	xrange=xrangedef
+	yrange=yrangedef
+        endif
+	symsize=1.0
+
+;  map_file=""
+
+;  plot_bad_obs=0
+
+  dayshi=-10.d/86400.		; small shift to group 0:00 hours with the previous day
+;  dayshi=-0.1d
+
+  wh=where(dayarr gt 0 and dayarr lt 9000000)
+;  print,dayarr
+;  print,wh(0)
+  if (wh(0) gt -1) then begin
+    daymin=min(dayarr(wh)+dayshi,max=daymax)
+  endif else begin
+    daymax=0
+    daymin=0
+  endelse
+;  daymax=maxday
+;  daymin=minday
+  dayminl=daymin
+  daymaxl=daymax
+  
+
+  print,'** dayminl daymaxl ', dayminl, daymaxl
+
+; ** Health check file   
+	if (keyword_set(healthcheck)) then begin
+		OPENW, unit, outfile+'_health.txt', /get_lun
+   		printf,unit,' Health check data '
+                printf,unit,'-------------------'
+                printf,unit,' Number of files ',n_elements(filename)
+                printf,unit,' List of files '
+		printf,unit,filename
+                printf,unit,' Filetype ',filetype
+                printf,unit,' Number of observations ',numobs
+                printf,unit,' Date range in julian days ',dayminl, daymaxl,format='(a,2f20.8)'
+		jul_to_dtstr,dayminl,datestr1
+                jul_to_dtstr,daymaxl,datestr2
+		printf,unit,' Date range ',datestr1,' - ',datestr2
+                mxo=0 & mno=0 
+                mxb=0 & mnb=0 
+                mxob=0 & mnob=0
+                rmsomb=0 & meanomb=0
+;                info,obs
+;                print,obs
+;                info,bkg
+;                print,bkg 
+;                print,'rmdi: ',rmdi
+;                wh=where(obs ne rmdi and qcarr lt 1,counto)
+; check for missing data within a tolerance 
+		wh=where(abs((obs-rmdi)/rmdi) gt 0.01 and qcarr lt 1, counto)
+;                print,'min ',min(abs((bkg(wh)-rmdi)/rmdi))
+;                print,'min ',min(bkg(wh)), min(obs(wh))
+;                print,'min ',max(bkg(wh)), max(obs(wh))
+                if (counto gt 0) then mxo=max(obs(wh),min=mno)
+;               wh=where(bkg ne rmdi and qcarr lt 1,countb)
+		wh=where(abs((bkg-rmdi)/rmdi) gt 0.01 and qcarr lt 1, countb)
+                if (countb gt 0) then mxb=max(bkg(wh),min=mnb)
+;                wh=where(obs ne rmdi and bkg ne rmdi and qcarr lt 1,countob)
+		wh=where(abs((obs-rmdi)/rmdi) gt 0.01 and $
+                	abs((bkg-rmdi)/rmdi) gt 0.01 and qcarr lt 1, countob)
+                if (countob gt 0) then mxob=max(obs(wh)-bkg(wh),min=mnob)
+; calculate rms / mean
+		if (countob gt 0) then begin
+		   x=total(obs(wh)-bkg(wh))
+                   x2=total((obs(wh)-bkg(wh))^2)
+                   nel=n_elements(wh)
+                   meanomb=x/nel
+                   rmsomb=sqrt(x2/nel)
+                endif
+ 
+                printf,unit,' Max/min obs ',mxo,mno
+                printf,unit,' Max/min bkg ',mxb,mnb
+                printf,unit,' Max/min obs-bkg ',mxob,mnob
+                printf,unit,' RMS/mean obs-bkg ',rmsomb,meanomb
+                printf,unit,' Number of good observations ',counto
+                printf,unit,' Number of bad observations ', numobs-counto
+
+                mxo=0 & mno=0 
+                mxb=0 & mnb=0 
+                mxob=0 & mnob=0 
+                rmsomb=0 & meanomb=0 
+                wh=where(obs2 ne rmdi and qcarr2 lt 1,counto) 
+                if (counto gt 0) then mxo=max(obs2(wh),min=mno)
+                wh=where(bkg2 ne rmdi and qcarr2 lt 1,countb)
+                if (countb gt 0) then mxb=max(bkg2(wh),min=mnb)
+                wh=where(obs2 ne rmdi and bkg2 ne rmdi and qcarr2 lt 1,countob)
+                if (countob gt 0) then mxob=max(obs2(wh)-bkg2(wh),min=mnob)
+; calculate rms / mean
+		if (countob gt 0) then begin
+		   x=total(obs2(wh)-bkg2(wh))
+                   x2=total((obs2(wh)-bkg2(wh))^2)
+                   nel=n_elements(wh)
+                   meanomb=x/nel
+                   rmsomb=sqrt(x2/nel)
+                endif
+                
+                printf,unit,' Max/min obs2 ',mxo,mno
+                printf,unit,' Max/min bkg2 ',mxb,mnb
+                printf,unit,' Max/min obs2-bkg2 ',mxob,mnob
+                printf,unit,' RMS/mean obs2-bkg2 ',rmsomb,meanomb                
+                printf,unit,' Number of good observations2 ',counto
+                printf,unit,' Number of bad observations2 ', numobs-counto
+
+	        FREE_LUN,unit
+        endif
+
+        daymax=daymaxl			; default to show everything
+        if (keyword_set(alldays)) then daymax=daymaxl         ;print alldays
+        if (n_elements(daterange) eq 2) then begin
+        	daymin=daterange(0)
+                if (daterange(0) lt dayminl) then daymin=dayminl
+                if (daterange(0) gt daymaxl) then daymin=daymaxl
+                if (daterange(1) gt dayminl and daterange(1) le daymaxl) then begin
+                	daymax=daterange(1)
+                endif else begin
+                daymax=daymaxl                
+                endelse
+        endif
+        if (n_elements(daterange) eq 1) then begin		; select number of days before end or after beginning
+             	print,'daymin b4: ',daymin, daymax
+                daymax=daymaxl
+                daymin=dayminl
+                if (daterange(0) lt 0) then begin
+                	if (daterange(0) eq -9999) then begin
+                        	daymin=daymax
+                        endif else begin
+	                	daymin=daymax+daterange(0)
+                        endelse
+                endif
+                if (daterange(0) gt 0) then daymax=daymin+daterange(0)
+        endif                                 
+
+; select day from the start day
+	if (n_elements(dayrange) eq 1) then begin
+        	daymin=dayminl+dayrange
+                daymax=daymin
+        endif
+
+	if (n_elements(dayrange) eq 2) then begin
+        	daymin=dayminl+dayrange(0)
+                daymax=dayminl+dayrange(1)
+        endif
+
+
+; prevent error where only one day plotted  
+	daymaxsl=daymaxl
+        dayminsl=dayminl
+	if (daymaxsl le dayminsl+1) then daymaxsl=dayminsl+1
+; stop day going out of range
+	if (daymax gt daymaxl) then daymax=daymaxl
+        if (daymax lt dayminl) then daymax=dayminl
+        if (daymin lt dayminl) then daymin=dayminl
+        if (daymin gt daymaxl) then daymin=daymaxl
+
+	print,'daymin af: ',daymin, daymax
+
+  sym=1
+   
+;-------------
+;Setup window
+;-------------
+
+if (not keyword_set(batch)) then begin 
+  ; Create a base widget to hold the application. 
+;	base0=WIDGET_BASE()
+
+  base = WIDGET_BASE(/COLUMN,mbar=bar) 
+;   base = WIDGET_BASE(/row)
+
+ 
+  ; setup menu bar
+  
+  menu1 = WIDGET_BUTTON(bar, VALUE='Areas', /MENU) 
+button1 = WIDGET_BUTTON(menu1, VALUE='Global', uvalue='Global') 
+button2 = WIDGET_BUTTON(menu1, VALUE='Arctic', uvalue='Arctic')
+button2a = WIDGET_BUTTON(menu1, VALUE='Atlantic', uvalue='Atlantic') 
+button3 = WIDGET_BUTTON(menu1, VALUE='N Atl', uvalue='N Atl')
+button4 = WIDGET_BUTTON(menu1, VALUE='Trop Atl', uvalue='Trop Atl')
+button5 = WIDGET_BUTTON(menu1, VALUE='S Atl', uvalue='S Atl')
+button5a = WIDGET_BUTTON(menu1, VALUE='Pacific', uvalue='Pacific')
+button6 = WIDGET_BUTTON(menu1, VALUE='N Pac', uvalue='N Pac')
+button7 = WIDGET_BUTTON(menu1, VALUE='Trop Pac', uvalue='Trop Pac')
+button8 = WIDGET_BUTTON(menu1, VALUE='S Pac', uvalue='S Pac')
+button9 = WIDGET_BUTTON(menu1, VALUE='Indian', uvalue='Indian')
+button10 = WIDGET_BUTTON(menu1, VALUE='S Ocean', uvalue='S Ocean')
+button11 = WIDGET_BUTTON(menu1, VALUE='Med', uvalue='Med')
+button12 = WIDGET_BUTTON(menu1, VALUE='N West Shelf', uvalue='NWS')
+button13 = WIDGET_BUTTON(menu1, VALUE='Input Area', uvalue='Input Area')
+
+  menu2 = WIDGET_BUTTON(bar, VALUE='Plot', /MENU)
+button1 = WIDGET_BUTTON(menu2, VALUE='Timeseries', uvalue='Timeseries')
+button1a =  WIDGET_BUTTON(menu2, VALUE='Num timeseries', uvalue='Num timeseries')
+button2 = WIDGET_BUTTON(menu2, VALUE='T-S diagram', uvalue='TS diagram') 
+
+  menu1a = WIDGET_BUTTON(bar, VALUE='Find',/MENU)
+button1a= WIDGET_BUTTON(menu1a, VALUE='Worst points', uvalue='Worst points')
+button1a1 = WIDGET_BUTTON(menu1a, VALUE='Filter type', uvalue='Filter type')
+
+  menu3 = WIDGET_BUTTON(bar, VALUE='Config', /MENU)
+loresmap = WIDGET_BUTTON(menu3, VALUE='Low res map', uvalue='Low res map', /checked_menu)
+hiresmap = WIDGET_BUTTON(menu3, VALUE='Hi res map', uvalue='Hi res map', /checked_menu)
+
+button3 = WIDGET_BUTTON(menu3, VALUE='Square psym', uvalue='Square psym')
+button4 = WIDGET_BUTTON(menu3, VALUE='Round psym', uvalue='Round psym')
+
+pltonbado = WIDGET_BUTTON(menu3, VALUE='Plot only bad obs', uvalue='Plot only bad obs', /checked_menu)
+
+whtonblack = WIDGET_BUTTON(menu3, VALUE='White on black', uvalue='White on black', /checked_menu)
+
+incsym = WIDGET_BUTTON(menu3, VALUE='Psym size+ ', uvalue='incsym')
+decsym = WIDGET_BUTTON(menu3, VALUE='Psym size- ', uvalue='decsym')
+resetsym = WIDGET_BUTTON(menu3, VALUE='Psym size reset ', uvalue='resetsym')
+
+vertgradmenu = WIDGET_BUTTON(menu3, VALUE='Vert gradient', uvalue='vertgrad', /checked_menu)
+button12 = WIDGET_BUTTON(menu3, VALUE='Input max/min', uvalue='input max/min')
+
+
+  menu4 = WIDGET_BUTTON(bar, VALUE='Help', /MENU)
+help1 = WIDGET_BUTTON(menu4, VALUE='Info', uvalue='Info')
+
+if (n_elements(filename) gt 0) then begin
+  menu5 = WIDGET_BUTTON(bar, VALUE=filename[0])
+nel=n_elements(filename)
+nel2=nel
+nelmx=32
+if (nel2 gt nelmx) then nel2=nelmx
+for i=0L, nel2-1 do begin
+  id = WIDGET_BUTTON(menu5, VALUE=filename[i])
+endfor
+if (nel gt nelmx) then id=WIDGET_BUTTON(menu5, VALUE='... etc ...')
+endif
+
+Widget_Control, loresmap, Set_Button=1
+Widget_Control, vertgradmenu, Set_Button=vertgrad 
+
+Widget_Control, pltonbado, Set_Button=plot_only_bad_obs
+Widget_Control, whtonblack, Set_Button=white_on_black
+ 
+  ; Create a draw widget based on the size of the image, and 
+  ; set the MOTION_EVENTS keyword so that events are generated 
+  ; as the cursor moves across the image. Setting the BUTTON_EVENTS 
+  ; keyword rather than MOTION_EVENTS would require the user to 
+  ; click on the image before an event is generated. 
+
+;	im_size=[2,1024,800]
+;	im_size=[2,800,800]
+;	im_size=[2,800,720]
+;	im_size=[2,1024,720]
+        im_size=[2,1024,680]
+;	im_size=[2,800,640]
+
+  draw = WIDGET_DRAW(base, XSIZE=im_size[1], YSIZE=im_size[2], $ 
+    /BUTTON_EVENTS,/WHEEL_EVENTS, uvalue='MAPWINDOW') 
+
+;	base2=widget_base(GROUP_LEADER=base,/column)
+
+;  droplist = WIDGET_COMBOBOX(base2,value=string([indgen(101)]),$
+;  	uvalue='LEVELLIST', FRAME=2)
+
+;  button = WIDGET_BUTTON(base2, value='test',uvalue='test')
+
+
+;	print,'depminl/maxl ',depminl, depmaxl
+;        print,'value depmin ',depmin
+;        print,'value depmax ',depmax
+
+depmaxlsl=depmaxl
+depminlsl=depminl
+if (depmaxlsl eq depminlsl) then depmaxlsl=depmaxlsl+1
+print, 'depminlsl, depmaxlsl ',depminlsl, depmaxlsl
+  slider = WIDGET_SLIDER(base,maximum=depmaxlsl,minimum=depminlsl,scroll=depscl,$
+  	value=depmin,uvalue='LEVELCHOICE', ysize=32)
+
+  sliderb = WIDGET_SLIDER(base,maximum=depmaxlsl,minimum=depminlsl, scroll=depscl,$
+        value=depmax,uvalue='LEVELCHOICEB', ysize=32)
+
+
+  jul_to_dtstr,daymin,dayminstr,/notime
+  slider1label = WIDGET_LABEL(base, VALUE="min date: "+dayminstr, xsize=800,ysize=14)
+  slider1 = WIDGET_SLIDER(base,minimum=dayminsl,maximum=daymaxsl,scroll=1,$
+  	value=daymin,uvalue='DATERANGE1',/suppress_value,/drag)
+
+  jul_to_dtstr,daymax,daymaxstr,/notime
+  slider2label = WIDGET_LABEL(base, VALUE="max date: "+daymaxstr, xsize=800,ysize=14)
+  slider2 = WIDGET_SLIDER(base,minimum=dayminsl,maximum=daymaxsl,scroll=1,$
+  	value=daymax,uvalue='DATERANGE2',/suppress_value,/drag)
+
+
+
+;  slider1 = WIDGET_SLIDER(base,minimum=dayminl,maximum=daymaxl,scroll=1,$
+;  	value=daymin,uvalue='DATERANGE1',PRO_SET_VALUE="datesliderset",/drag)
+;
+;  slider2 = WIDGET_SLIDER(base,minimum=dayminl,maximum=daymaxl,scroll=1,$
+;  	value=daymax,uvalue='DATERANGE2',PRO_SET_VALUE="datesliderset",/drag)
+	 
+  ; Labels for stats
+   
+  labt1='Lon: '
+  labt2='Lat: '
+  labt3='Value: '
+  labt4='QC: '
+  labt5='Date: '
+  labt6='Value: '
+  labt7=' '
+  labt8='Type: ' 
+  labt9='obnum: '
+  labt10='visible date range: '
+  
+  ; Create label widgets to hold the cursor position and 
+  ; Hexadecimal value of the pixel under the cursor. 
+  labelb=Widget_Base(base,row=1)
+  
+  labsiz=105
+  labsizl1=150
+  labsizlg=150
+  labsizl2=135
+  label7=0
+  lb_ysize=14
+  label1 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt1, ysize=lb_ysize) 
+  label2 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt2, ysize=lb_ysize) 
+  label3 = WIDGET_LABEL(labelb, XSIZE=labsizl1, $ 
+    VALUE=labt3, ysize=lb_ysize) 
+  label4 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt4, ysize=lb_ysize)
+  label5 = WIDGET_LABEL(labelb, XSIZE=labsizlg, $ 
+    VALUE=labt5, ysize=lb_ysize) 
+  label6 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt6, ysize=lb_ysize)
+;  label7 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+;    VALUE=labt7, ysize=lb_ysize)
+  label8 = WIDGET_LABEL(labelb, XSIZE=labsizl2, $ 
+    VALUE=labt8, ysize=lb_ysize)
+  label9 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt9, ysize=lb_ysize)
+
+  labelb2 = Widget_Base(base,row=1)
+  label10 = WIDGET_LABEL(labelb2, XSIZE=1024, $
+    VALUE=labt10, ysize=lb_ysize)
+
+   tlba = Widget_Base(base,row=1)
+
+   t1b = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=200,$
+   /Exclusive)
+   button1 = Widget_Button(t1b, Value='mean',uvalue='RADIO1',/no_release)
+   button2 = Widget_Button(t1b, Value='rms',uvalue='RADIO2',/no_release)
+   button3 = Widget_Button(t1b, Value='sd',uvalue='RADIO3',/no_release)
+   button4 = Widget_Button(t1b, Value='ms',uvalue='RADIO4',/no_release)
+
+   if (typeplot eq 1) then Widget_Control, button1, Set_Button=typeplot
+   if (typeplot eq 2) then Widget_Control, button2, Set_Button=typeplot
+   if (typeplot eq 3) then Widget_Control, button3, Set_Button=typeplot
+   if (typeplot eq 4) then Widget_Control, button4, Set_Button=typeplot
+  
+   t1c = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=200,$
+   /Exclusive)
+   button5 = Widget_Button(t1c, Value='obs - bkg', uvalue='RADIO5',/no_release)
+   button6 = Widget_Button(t1c, Value='obs', uvalue='RADIO6',/no_release)
+   button7 = Widget_Button(t1c, Value='bkg', uvalue='RADIO7',/no_release)
+
+   if (ombtypeplot eq 1) then Widget_Control, button5, /Set_Button
+   if (ombtypeplot eq 2) then Widget_Control, button6, /Set_Button
+   if (ombtypeplot eq 3) then Widget_Control, button7, /Set_Button
+
+;   tlb = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=400,$
+;   /Exclusive)
+;; no_release only sends select events (not release ones)
+;   button1 = Widget_Button(tlb, Value='rms Obs - Bkg',uvalue='RADIO1',/no_release)
+;   button2 = Widget_Button(tlb, Value='sum(Obs - Bkg)^2',uvalue='RADIO2',/no_release)
+;   button3=  Widget_Button(tlb, Value='Obs - Bkg',uvalue='RADIO3',/no_release)
+;   button4 = Widget_Button(tlb, Value='Obs',uvalue='RADIO4',/no_release)
+;   button5 = Widget_Button(tlb, Value='Bkg',uvalue='RADIO5',/no_release)
+;
+;   if (typeplot eq 1) then Widget_Control, button1, Set_Button=typeplot
+;   if (typeplot eq 2) then Widget_Control, button2, Set_Button=typeplot
+;   if (typeplot eq 3) then Widget_Control, button3, Set_Button=typeplot
+;   if (typeplot eq 4) then Widget_Control, button4, Set_Button=typeplot
+;   if (typeplot eq 5) then Widget_Control, button5, Set_Button=typeplot
+  
+   tlb1 = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=220,$
+   /Exclusive)
+   button01 = Widget_Button(tlb1, Value='Lat/Lon',uvalue='RADIO01',/no_release)
+   button02 = Widget_Button(tlb1, Value='N Polar',uvalue='RADIO02',/no_release)
+   button03 = Widget_Button(tlb1, Value='S Polar',uvalue='RADIO03',/no_release)
+
+    Widget_Control, button01, Set_Button=typeproj
+
+
+   tlb1a = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=250,$
+   /NonExclusive)
+   button001 = Widget_Button(tlb1a, Value='Plot Bad Obs', uvalue='RADIO001')
+
+   Widget_Control, button001, Set_Button=plot_bad_obs
+
+
+   if filetype eq 'CRT' then begin
+
+      button002 = Widget_Button(tlb1a, Value='Meridional', uvalue='RADIOSAL')
+      Widget_Control, button002, Set_Button=salinity
+
+      button003 = Widget_Button(tlb1a, Value='Speed', uvalue='RADIODENSITY')
+      Widget_Control, button003, Set_Button=density
+
+   endif else begin
+;         tlb1b = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=90,$
+;         /NonExclusive)
+      button002 = Widget_Button(tlb1a, Value='Salinity', uvalue='RADIOSAL')
+      Widget_Control, button002, Set_Button=salinity
+;         tlb1c = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=90,$
+;          /NonExclusive)
+      button003 = Widget_Button(tlb1a, Value='Density', uvalue='RADIODENSITY')
+      Widget_Control, button003, Set_Button=density
+   endelse
+
+ 
+   tlb2= Widget_Base(tlba,row=1)
+  button = WIDGET_BUTTON(tlb2, VALUE='Print',uvalue="PRINT") 
+  button = WIDGET_BUTTON(tlb2, VALUE='Save',uvalue="SAVE")
+   
+  button = WIDGET_BUTTON(tlb2, VALUE='Done',uvalue="DONE") 
+
+
+
+  ; Realize the widget hierarchy. 
+  WIDGET_CONTROL, base, /REALIZE 
+;  WIDGET_CONTROL, base2, /REALIZE 
+;   WIDGET_CONTROL, tlb, /REALIZE 
+
+  ; Retrieve the widget ID of the draw widget. Note that the widget 
+  ; hierarchy must be realized before you can retrieve this value. 
+  WIDGET_CONTROL, draw, GET_VALUE=drawID 
+
+ 
+  ; Create an anonymous array to hold the image data and widget IDs 
+  ; of the label widgets. 
+;  stash = { imagePtr:imagePtr, label1:label1, label2:label2, $ 
+;            label3:label3, $
+;	    xarr:xarr, yarr:yarr, dep:dep, val:val } 
+
+
+spawn,'echo part 2 `date`'
+
+
+  stash = { label1:label1, label2:label2, $ 
+            label3:label3, label4:label4, $
+            label5:label5, label6:label6, $
+            label7:label7, label8:label8, $
+            label9:label9, label10:label10, $
+            labt1:labt1, labt2:labt2, $
+            labt3:labt3, labt4:labt4, $
+            labt5:labt5, labt6:labt6, $
+            labt7:labt7, labt8:labt8, $
+            labt9:labt9, labt10:labt10, $
+            slider1label:slider1label, $
+            slider2label:slider2label, $
+            drawID:drawID, draw:draw, base:base, $
+            im_size:im_size, pixID:0, $
+            xcorn:0, ycorn:0, xdatacorn:0.0, ydatacorn:0.0, $
+            slider1:slider1, slider2:slider2, $
+            slider:slider, sliderb:sliderb, $
+            hiresmap:hiresmap, loresmap:loresmap, vertgradmenu:vertgradmenu, $
+            pltonbado:pltonbado, plot_only_bad_obs:plot_only_bad_obs, $
+            whtonblack:whtonblack, white_on_black:white_on_black, $
+            duplicates:duplicates, differences:differences, $
+            bindata:bindata, binsize:binsize, $
+            filetype:filetype, $
+            xarr:xarr, yarr:yarr, dep:dep, dayarr:dayarr, $
+            obs:obs, bkg:bkg, qcarr:qcarr, obstypes: obstypes, $
+            obs2:obs2, obs3:obs3, bkg2:bkg2, qcarr2:qcarr2, $
+            obnum:obnum, $
+            depmin:depmin, typeplot:typeplot, ombtypeplot:ombtypeplot, $
+            typeproj:typeproj, $
+            hires_map:hires_map, $
+            plot_bad_obs:plot_bad_obs, salinity: salinity, $
+            density:density, vertgrad:vertgrad, mld:mld, $
+            daymin:daymin, daymax:daymax, dayminl:dayminl, daymaxl:daymaxl, $
+            dayshi:dayshi, $
+            depminl:depminl, depmaxl:depmaxl, depmax:depmax, depscl:depscl, $
+            xrange:xrange, yrange:yrange, $
+            fmx:fmx, fmn:fmn, mx:mx, mn:mn, $
+            symsize:symsize, sym:sym, picsize:picsize, $
+            pmulti:pmulti, pmultinum:pmultinum, $
+            outfile:outfile, $ 
+            xrangedef:xrangedef, yrangedef:yrangedef, rmdi:rmdi, $
+            obstypeselect:obstypeselect, printobstypes:printobstypes, $
+            plottssel:plottssel, $
+            binspday:binspday, numtimeseries:numtimeseries, txt:txt, netcdf:netcdf, $
+            busy:busy, symscale:symscale, coltable:coltable, $
+            filterout:filterout, varname:varname } 
+	     
+  ; Set the user value of the top-level base widget equal to the 
+  ; 'stash' array. 
+  WIDGET_CONTROL, base, SET_UVALUE=stash 
+ 
+  ; Make the draw widget the current IDL drawable area. 
+  WSET, drawID 
+
+spawn,'echo part 3 `date`' 
+
+  ; Draw the image into the draw widget. 
+  plotpoints, stash
+
+; plotpoints updates mx/mn values make sure these are included
+  WIDGET_CONTROL, base, SET_UVALUE=stash 
+
+spawn,'echo part 4 `date`' 
+
+  ; Call XMANAGER to manage the widgets. 
+  XMANAGER, 'dataplot', base, /NO_BLOCK
+;  XMANAGER, 'dataplot', base
+endif else begin
+
+;do batch
+
+print,"batch"
+
+drawID=-1
+
+print, 'filetype: ',filetype
+
+  stash = { drawID:drawID,$	    
+            filetype:filetype, $
+            xarr:xarr, yarr:yarr, dep:dep, dayarr:dayarr, $
+            obs:obs, bkg:bkg, qcarr:qcarr, obstypes: obstypes, $
+            obs2:obs2, bkg2:bkg2, qcarr2:qcarr2, $
+            obnum:obnum, $
+            depmin:depmin, typeplot:typeplot, ombtypeplot:ombtypeplot, $
+            typeproj:typeproj, $
+            hires_map:hires_map, $
+            plot_only_bad_obs:plot_only_bad_obs, $
+            white_on_black:white_on_black, $
+            duplicates:duplicates, differences:differences, $
+            bindata: bindata, binsize:binsize, $
+            plot_bad_obs:plot_bad_obs, salinity: salinity, $
+            density:density, vertgrad:vertgrad, mld:mld, $
+            daymin:daymin, daymax:daymax, dayminl:dayminl, daymaxl:daymaxl, $
+            dayshi:dayshi, $            
+            depminl:depminl, depmaxl:depmaxl, depmax:depmax, depscl:depscl, $
+            xrange:xrange, yrange:yrange, $
+            fmx:fmx, fmn:fmn, mx:mx, mn:mn, $
+            symsize:symsize, sym:sym, picsize:picsize, $
+            pmulti:pmulti, pmultinum:pmultinum, $ 
+            outfile:outfile, $ 
+            xrangedef:xrangedef, yrangedef:yrangedef, rmdi:rmdi, $
+            obstypeselect:obstypeselect, printobstypes:printobstypes, $
+            plottssel:plottssel, $
+            binspday:binspday, numtimeseries:numtimeseries, txt:txt, netcdf:netcdf, $
+            busy:busy, symscale:symscale, coltable:coltable, $
+            filterout:filterout, varname:varname } 
+
+if (keyword_set(ps)) then begin
+  	ps=1
+	eps=0
+	landscape=1
+  	pr2,file=stash.outfile+'.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+
+; plot data
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+	endelse
+
+	prend2,view=0
+
+endif 
+
+if (keyword_set(gif)) then begin
+	thisDevice = !D.Name
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[640,512], decomposed=0
+;	Device, Set_Resolution=[800,512], decomposed=0
+        Device, Set_Resolution=picsize, decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+
+; plot data
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+	endelse
+
+;	if (keyword_set(gif)) then begin
+;        IMAGE_GRAB, /gif, filename=stash.outfile+'.gif',/overwrite        
+	snapshot = TVRD()
+        WRITE_GIF,stash.outfile+'.gif',snapshot, r, g, b
+;        endif
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+        !p.charsize=0.0
+
+endif
+
+if (keyword_set(txt)) then begin
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+;		print,'no txt version of plotpoints!'
+	endelse
+endif	
+
+if (keyword_set(netcdf)) then begin
+	if keyword_set(timeseries) then begin
+        	print,'no netcdf version of timeseries!'
+        endif else begin
+  		plotpoints,stash        
+        endelse
+endif
+
+if (stash.filterout ne '') then begin
+
+   selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr
+
+endif
+
+endelse            ; batch
+ 
+END 
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 8732)
@@ -0,0 +1,452 @@
+pro plotts1, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+;+--------------------------------------------------------
+; plot mean and rms timeseries
+;
+; Author:  D. J. Lea      Feb 2008
+;+--------------------------------------------------------
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D', '%M, %Y']) 
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%M %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+; sort times (in case of a repeated day)
+
+timsrt=sort(arrsv(0,*))
+
+taxis=arrsv(0,timsrt)
+num=arrsv(1,timsrt)
+yaxis=arrsv(2,timsrt)
+yaxis2=arrsv(3,timsrt)
+
+; remove any zero times or non-finite values
+wh=where(taxis gt 0 and finite(yaxis) and finite(yaxis2))
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+num=num(wh)
+yaxis=yaxis(wh)
+yaxis2=yaxis2(wh)
+endif
+
+; remove any with num lt than a specific value
+if (n_elements(minperc) eq 1) then begin
+maxnum=max(num,min=minnum)
+wh=where(num gt maxnum*minperc)
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+num=num(wh)
+yaxis=yaxis(wh)
+yaxis2=yaxis2(wh)
+endif
+endif
+
+mxt=max(taxis,min=mnt)
+print, 'mnt mxt ',mnt, mxt
+
+ymx=max([yaxis,yaxis2],min=ymn)
+
+print, 'ymn ymx ',ymn,ymx
+
+;create a small amount of space around the max and min
+
+spc=(ymx-ymn)*0.05
+
+ymn=ymn-spc*3
+ymx=ymx+spc
+
+if (n_elements(emax) gt 0) then ymx=emax
+if (n_elements(emin) gt 0) then ymn=emin
+
+; setup time axis range
+
+skip=0
+xmx=max(taxis,min=xmn)
+if (n_elements(juldatemin) gt 0) then begin
+	if (xmn le juldatemin) then xmn=juldatemin
+        if (xmx le juldatemin) then skip=1
+endif
+if (n_elements(juldatemax) gt 0) then begin
+	if (xmx ge juldatemax) then xmx=juldatemax
+        if (xmn ge juldatemin) then skip=1
+endif
+
+if (skip eq 0) then begin
+;plot, arrsv(0,timsrt), arrsv(2,timsrt), xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;plot, arrsv(0,timsrt), arrsv(3,timsrt), xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;plot, arrsv(0,timsrt), arrsv(2,timsrt), xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE','LABEL_DATE'],$
+;   XTICKUNITS = ['Day','Month']
+
+;plot, arrsv(0,timsrt), arrsv(3,timsrt), xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE','LABEL_DATE'],$
+;   XTICKUNITS = ['Day','Month']
+
+;plot, taxis, yaxis, xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE']
+;   
+;plot, taxis, yaxis2, xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE']
+
+plot, taxis, yaxis, xstyle=1, ystyle=1, linestyle=1, $
+   yrange=[ymn,ymx], xrange=[xmn,xmx], $
+   ytitle=typestr, title=title, $
+   XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+
+plot, taxis, yaxis2, xstyle=4+1, ystyle=4+1, /noerase, $
+   yrange=[ymn,ymx], xrange=[xmn,xmx], $
+   XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+	
+
+
+; key
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.35
+                ycoord=0.2
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], linestyle=0, /normal
+                  xyouts, xcoord3, ycoord, 'RMS', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], linestyle=1, /normal
+                  xyouts, xcoord3, ycoord2, 'mean',/normal                
+
+endif
+
+end
+
+
+; plot number
+
+pro plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+   
+
+; number
+;
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%M %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+
+timsrt=sort(arrsv(0,*))
+
+taxis=arrsv(0,timsrt)
+yaxis=arrsv(1,timsrt)
+
+wh=where(taxis gt 0 and finite(yaxis))	 ; remove any zero times and non-finite vals
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+yaxis=yaxis(wh)
+endif
+mxt=max(taxis,min=mnt)
+print, 'mnt mxt ',mnt, mxt
+
+;plot, arrsv(0,timsrt), arrsv(1,timsrt), xstyle=1, $
+;   ytitle='Number of obs assim', title=title, $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;info, taxis
+;info, yaxis
+
+;print,taxis, yaxis
+
+;plot, taxis, yaxis, xstyle=1, $
+;   ytitle='Number of obs assim', title=title, $
+;   XTICKFORMAT = ['LABEL_DATE']
+
+ymx=max(yaxis)*1.05
+
+; setup time axis range
+
+skip=0
+xmx=max(taxis,min=xmn)
+if (n_elements(juldatemin) gt 0) then begin
+	if (xmn le juldatemin) then xmn=juldatemin
+        if (xmx le juldatemin) then skip=1
+endif
+if (n_elements(juldatemax) gt 0) then begin
+	if (xmx ge juldatemax) then xmx=juldatemax
+        if (xmn ge juldatemin) then skip=1
+endif
+
+if (skip eq 0) then $
+plot, taxis, yaxis, xstyle=1, ystyle=1, $
+   ytitle='Number of obs assim', title=title, yrange=[0,ymx], xrange=[xmn,xmx],$
+   XTICKUNITS = ['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+
+
+print,'min time ',min(arrsv(0,timsrt)),max(arrsv(0,timsrt)) 
+
+end
+
+PRO dataplot_txttimeseries, files, gif=gif, ps=ps, filtstr=filtstr, view=view, $
+	bin=bin, minperc=minperc, datemin=datemin, datemax=datemax, notitle=notitle, $
+        emax=emax, emin=emin
+
+; DJL switch off wave compatibility mode
+res=execute("waveoff")
+
+if (n_elements(filtstr) eq 0) then filtstr=""
+if (n_elements(view) eq 0) then view=0
+
+print, 'dataplot_txttimeseries '
+
+if (n_elements(datemin) gt 0) then begin
+	; month, day, year
+	juldatemin=julday(datemin(1),datemin(2), datemin(0))
+        print, 'juldatemin set:', juldatemin, datemin
+endif
+if (n_elements(datemax) gt 0) then begin
+	; month, day, year
+	juldatemax=julday(datemax(1),datemax(2), datemax(0))
+        print, 'juldatemax set:', juldatemax, datemax
+endif
+
+
+
+numfiles=n_elements(files)
+
+print,'numfiles ',numfiles
+
+imax=500
+	arrs=dblarr(4,imax)
+	arr=dblarr(4)
+	arrsv=dblarr(4,10000)
+
+j=0L		; position in full array
+for ii=0,numfiles-1 do begin
+	print,files(ii)
+        OPENR, unit, files(ii), /get_lun
+        obstypestr=""
+        readf,unit,obstypestr
+        typestr=""
+        readf,unit,typestr
+        xrange=fltarr(2)
+        readf,unit,xrange
+        yrange=fltarr(2)
+        readf,unit,yrange
+        binspday=0.0
+        readf,unit,binspday
+
+	i=0
+	while (~ eof(unit) and i lt imax) do begin        
+        readf,unit,arr
+	print,i,arr
+        if arr(1) eq 0 then arr(2:*)=0
+        print,arr
+        arrs(*,i)=arr
+        i=i+1
+        endwhile
+ 
+	numtimes=i
+	print, 'numtimes ',numtimes
+        
+        if (numtimes ge binspday) then begin
+        	print,arrs(*,numtimes-binspday:numtimes-1)
+
+; store daily values from each file in full time series array
+
+	arrsv(*,j:j+binspday-1)=arrs(*,numtimes-binspday:numtimes-1)
+        j=j+binspday
+
+	endif else begin 
+        if (numtimes gt 0) then begin
+        
+        print, '** numtimes ',numtimes
+        print, arrs(*,0:numtimes-1)  
+        arrsv(*,j:j+numtimes-1)=arrs(*,0:numtimes-1)        
+        j=j+numtimes
+                
+        endif
+        endelse
+                
+        FREE_LUN, unit
+        
+        print, obstypestr
+        print, typestr
+        print, xrange
+        print, yrange
+        print, binspday
+endfor	
+
+print, 'j ',j
+
+arrsv=arrsv(*,0:j-1)
+
+;stop
+
+; bin up the data
+
+;print,arrsv
+
+if (n_elements(bin) gt 0) then begin
+if (bin gt 1) then begin
+; time 0 num 1 mean 2 rms 3
+arrsv2=dblarr(4,j/bin)
+for i=0,j/bin-1 do begin
+
+	arrsvtemp=arrsv(*,i*bin:(i+1)*bin-1)
+        print,arrsvtemp
+	wh=where(arrsvtemp(1,*) gt 0)		; number of obs gt 0
+;        print,wh
+        if (wh(0) gt -1) then begin 
+
+; number of obs
+        arrsv2(1,i)=total(arrsvtemp(1,wh))
+; mean
+        arrsv2(2,i)=total(arrsvtemp(2,wh)*arrsvtemp(1,wh))/arrsv2(1,i)
+; rms
+        arrsv2(3,i)=sqrt(total(arrsvtemp(3,wh)^2*arrsvtemp(1,wh))/arrsv2(1,i))
+; date (average)
+;	print,arrsv(0,i*bin)
+	arrsv2(0,i)=total(arrsvtemp(0,*))/bin
+;	print,arrsv2(0,i)
+
+	endif
+
+endfor
+
+info, arrsv2
+
+arrsv=arrsv2
+	
+endif
+endif
+
+nel=n_elements(arrsv(0,*))
+
+; produce 1 month/3 month/all average values
+
+finaltime=arrsv(0,nel-1)
+onemon=finaltime-30
+threemon=finaltime-90
+
+print,arrsv
+
+wh1=where(arrsv(0,*) gt onemon and arrsv(1,*) gt 0)
+wh3=where(arrsv(0,*) gt threemon and arrsv(1,*) gt 0)
+wh0=where(arrsv(1,*) gt 0)
+
+num1=total(arrsv(1,wh1))
+mean1=total(arrsv(2,wh1)*arrsv(1,wh1))/num1
+rms1=sqrt(total(arrsv(3,wh1)^2*arrsv(1,wh1))/num1)
+print,num1
+
+num3=total(arrsv(1,wh3))
+mean3=total(arrsv(2,wh3)*arrsv(1,wh3))/num3
+rms3=sqrt(total(arrsv(3,wh3)^2*arrsv(1,wh3))/num3)
+print,num3
+
+num0=total(arrsv(1,wh0))
+mean0=total(arrsv(2,wh0)*arrsv(1,wh0))/num0
+rms0=sqrt(total(arrsv(3,wh0)^2*arrsv(1,wh0))/num0)
+print,num0
+
+if (keyword_set(notitle)) then begin
+title1=""
+title=""
+endif else begin 
+subtitle=          'rms (mean), 1 month: '+strtrim(string(rms1,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean1,format='(G0.3)'),2)+')'
+subtitle=subtitle+ ', 3 month: '+strtrim(string(rms3,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean3,format='(G0.3)'),2)+')'
+subtitle=subtitle+ ', all: '+strtrim(string(rms0,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean0,format='(G0.3)'),2)+')'
+
+
+fullfiltstr=''
+if (filtstr ne '') then fullfiltstr=' Type: '+filtstr
+
+title=obstypestr+typestr+'   lons ('+strtrim(string(xrange(0),format='(F0.2)'),2)+$
+	','+strtrim(string(xrange(1),format='(F0.2)'),2)+$
+        ')   lats ('+strtrim(string(yrange(0),format='(F0.2)'),2)+','+$
+        strtrim(string(yrange(1),format='(F0.2)'),2)+')'+fullfiltstr
+
+title1=title+'!C'+subtitle
+endelse
+
+if (keyword_set(gif)) then begin
+	thisDevice = !D.Name
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[640,512], decomposed=0
+	Device, Set_Resolution=[800,512], decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+;        setupct, r, g, b		; setup color table
+
+	plotts1, arrsv, title1, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+
+
+	snapshot = TVRD()
+        WRITE_GIF,'dataplot_timeseries.gif',snapshot, r, g, b
+
+	plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+
+        
+	snapshot = TVRD()
+        WRITE_GIF,'dataplot_numtimeseries.gif',snapshot, r, g, b
+
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+        !p.charsize=0.0
+
+endif
+
+if (keyword_set(ps)) then begin
+  ps=1
+  eps=0
+  landscape=1
+  pr2o,file='dataplot_timeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  plotts1, arrsv, title1, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+  prend2o,view=view
+  
+  pr2o,file='dataplot_numtimeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+  prend2o,view=view
+
+endif 
+
+end
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro	(revision 8732)
@@ -0,0 +1,79 @@
+function eos_nemo, t_in, psal
+;------------------------------------------------------------------------------
+;
+; Purpose:
+;       To calculate the density using the equation of state used in NEMO.
+;       This is based on the Jackett and McDougall (1994) equation of state
+;       for calculating the in situ density based on potential temperature
+;       and salinity.
+;
+; Inputs:
+;       temperature    =>  1d array potential temperature (deg C)
+;       salinity       =>  1d array salinity (PSU)
+;
+; Outputs:
+;       rhop            =>  1d array pot density (kg/m**3)
+;
+; could add use a difference reference pressure
+; observations are in-situ temperature?
+;
+; Author:
+;       D. J. Lea. Dec 2006.
+;------------------------------------------------------------------------------
+
+          zws = SQRT( ABS( psal ) )
+
+	sz=size(t_in)
+	ndim=sz(0)
+	NO_LEVS=sz(ndim)
+	
+	prhop=psal*0.
+
+;                 
+          for jk = 0L, NO_LEVS-1 do begin  
+
+                   zt = T_IN(jk)
+                   zs = psal(jk)
+; * depth
+;                   zh = O_DEP_LEVS(jk)		;used in calculating insitu density only
+                   zsr= zws(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(jk) = zrhop
+
+; * 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
+
+;                   ; in situ density anomaly
+;                   prd(jk) = zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )
+;
+          endfor  
+
+
+
+return, prhop
+
+END                  
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 8732)
@@ -0,0 +1,60 @@
+function nice_contourlevels, data, nlevels=nlevels
+;+----------------------------------------------------------------------------------------
+; nice_contourlevels.pro
+;
+; Select nice contour levels based on the data input and the number of levels
+;
+; Author:  D. J. Lea     -  Feb 2008
+;
+;+----------------------------------------------------------------------------------------
+
+if (n_elements(nlevels) eq 0) then nlevels=15
+
+mx=max(data)
+mn=min(data)
+
+; use this to select colors to plot and labels
+
+clevels=findgen(nlevels)/nlevels*(mx-mn)+mn
+
+ocint=1./nlevels*(mx-mn)
+print,'ocint ',ocint
+
+; contour interval at 2 sig figs
+;digits=2
+;p10 = floor(alog10(abs(ocint)))
+;expo = 10.0d^(digits -1 - p10)
+;cint = long(ocint*expo)/expo
+;print,'cint ',cint
+
+;does it end in 5 or 0?
+digits=1
+p10 = floor(alog10(abs(ocint)))
+expo = 10.0d^(digits -1 - p10)
+cint = long(ocint*expo)/expo
+print,'cint ',cint
+
+if (mx ne mn) then begin
+mxfix=fix(mx/cint)*cint
+mnfix=fix(mn/cint)*cint
+print, mx, mxfix
+print, mn, mnfix
+
+; nice contour values
+
+;calculate new nlevels
+nlevels=fix((mxfix-mnfix)/cint+1)
+
+;print,nlevels
+if (nlevels gt 0) then begin
+	clevels=findgen(nlevels)*cint+mnfix
+endif else begin
+	clevels=mnfix
+endelse
+endif else begin
+	clevels=mn
+endelse
+
+return, clevels
+
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro	(revision 8732)
@@ -0,0 +1,55 @@
+  PRO Pr2,device,$
+         bw=bw,$
+         color=o_color,$
+         pcl=pcl,$
+         ps=ps,$
+         cps=cps,$
+         eps=eps,$
+         cgm=cgm,$
+         screen=screen,$
+         transparency=o_transparency,$
+         encapsulated=encapsulated,$
+         bpp=bpp,$
+         portrait=portrait,$
+         landscape=landscape,$
+         table=table,$
+         reread=reread,$
+         noflip=noflip,$
+         verbose=verbose,$
+         xsize=xsize,$
+         ysize=ysize,$
+         xoffset=xoff,$
+         yoffset=yoff,$
+         scale=scale,$
+         file=file,$
+         destination=destination
+;+----------------------------------------------------------
+; NAME:pr2
+; like pr, but uses nice fonts
+;
+; Author:  D. J. Lea        Feb 2008
+;+----------------------------------------------------------
+
+COMMON pr2, view_landscape
+
+	set_plot,'ps'
+
+	if (n_elements(color) eq 0) then color=1
+        if (n_elements(landscape) eq 0) then landscape=1
+        if (keyword_set(portrait)) then landscape=0
+        encapsulated=1
+        if (keyword_set(eps)) then encapsulated=1
+        if (keyword_set(ps)) then encapsulated=0
+        
+        view_landscape=landscape
+        
+	DEVICE, filename=file, COLOR=color, landscape=landscape, $
+        	encapsulated=encapsulated, xsize=xsize, ysize=ysize
+
+
+!p.font=0
+device,/helv
+	 
+;return
+
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro	(revision 8732)
@@ -0,0 +1,38 @@
+PRO PREND2,in_printer,keep=keep,noprint=noprint,double=double,$
+    view=view,spin_landscape_ps=spin_landscape_ps,$
+    eps_preview=eps_preview,colour_preview=colour_preview,$
+    dpi_preview=dpi_preview, suppress_stderr=suppress_stderr
+;+
+; NAME:prend
+; 
+; Author:  D. J. Lea       Feb 2008
+
+COMMON pr2, view_landscape
+
+; get filename of postscript device  
+
+r = fstat(!D.UNIT)
+filename = r.name
+
+device,/close          
+set_plot,'x'
+
+if keyword_set(view) then begin
+
+   if (view_landscape) then begin
+      spawn,'gv -orientation=landscape -swap '+filename
+   endif else begin
+      spawn,'gv '+filename 
+   endelse
+
+endif
+
+!p.font=-1
+!p.charsize=0
+!p.charthick=0
+!p.thick=0
+!p.background=0
+
+;return
+
+end
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 8732)
@@ -0,0 +1,221 @@
+;+---------------------------------------------------------------------------
+PRO read_cdfobs, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, Depths=Depths, $
+               Obs=Observations, ModelVals=ModelVals, qcs=QCs, $
+               Ob2=Observations2, ModelVal2=ModelVals2, qc2=QCs2, $
+               Ob3=Observations3, $
+               Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, kobs=kobs, $
+	            Salinity=Salinity, nodates=nodates, types=types, $
+	            filetype=ObsType, quiet=quiet, MDT=MDT, $
+               ProfileNum=ProfileNum, error=error, $
+               notfussy=notfussy,VarName=VarName  
+;+--------------------------------------------------------------------------
+; Read in observation and feedback files
+; detects filetype and calls the appropriate reading routine
+;
+; Author:  D. J. Lea       Feb 2008
+;+--------------------------------------------------------------------------
+
+; Declare error label. 
+ON_IOERROR, IOERROR 
+	       
+error=0
+title=''
+
+; Set types to undefined
+types=-1 & tempvar=size(temporary(types))
+
+; Read in netcdf data file and observation operator
+;2. Work out which type of data is in the files by looking at the first one.
+ncid = ncdf_open(Files(0), /nowrite)
+if ncid lt 0 then message, 'Error opening file '+File
+result = NCDF_ATTINQ( ncid, 'title', /global)
+if result.datatype ne 'UNKNOWN' then ncdf_attget, ncid, 'title', Title, /global
+
+if string(Title) eq "NEMO observation operator output" then ObsType='feedback' $
+else $
+if string(Title) eq "Forecast class 4 file" then ObsType='ForecastClass4' $
+else $
+ObsType = 'none'
+
+if ObsType eq 'none' then begin
+  varid = ncdf_varid(ncid, 'POTM_CORRECTED')  
+  if varid ge 0 then ObsType = 'Prof' 
+  
+  varid = ncdf_varid(ncid, 'SLA')
+  if varid ge 0 then ObsType = 'SSH'
+  
+  varid = ncdf_varid(ncid, 'SST')
+  varid2 = ncdf_varid(ncid, 'sea_surface_temperature')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'SST'
+  
+  varid = ncdf_varid(ncid, 'SEAICE')
+  varid2 = ncdf_varid(ncid, 'sea_ice_concentration')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'SEAICE'    
+  
+  varid = ncdf_varid(ncid, 'LOGCHL')
+  varid2 = ncdf_varid(ncid, 'LogChl')
+  varid3 = ncdf_varid(ncid, 'CHL1_mean')
+  varid=max([varid,varid2,varid3])
+  if varid ge 0 then ObsType = 'LOGCHL'    
+  
+  varid = ncdf_varid(ncid, 'PCO2')
+  if varid ge 0 then ObsType = 'PCO2'
+
+  varid = ncdf_varid(ncid, 'UCRT')
+  varid2 = ncdf_varid(ncid, 'VCRT')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'CRT'    
+endif
+ 
+ncdf_close, ncid
+
+if not keyword_set(quiet) then print, 'Reading in data as type ',ObsType
+
+  if ObsType eq 'feedback' then begin
+  
+    if n_elements(DepRange) eq 0 then DepRange=[0,5000]  
+  
+    read_feedback, Files, DepRange=DepRange, VarName=VarName, NumData=numobs, $
+                OutLats=Latitudes, OutLons=Longitudes, $
+                OutInstruments=Instruments, OutPlatform=Platform, $
+                OutDeps=Depths,  $
+                OutObs1=Observations, OutObs2=Observations2, $
+                OutMod1=ModelVals, OutMod2=ModelVals2, $
+                OutQC1=QCs, OutQC2=QCs2, $
+                MDT=MDT, OutDates=Dates, $
+                rmdi=rmdi, quiet=quiet, $
+                OutProfileNum=ProfileNum
+                
+;                info, instruments
+;                info, platform
+                
+                types=Platform
+                if n_elements(instruments) gt 0 then types=Platform+' '+Instruments
+                
+  print, 'Varname: ',VarName
+  endif else if ObsType eq 'Prof' then begin
+  
+    if keyword_set(PlotModel) then begin
+      OutTMod = 1
+      OutSMod = 1
+    endif
+
+	if n_elements(DepRange) eq 0 then DepRange=[0,5000]
+    
+  read_enact, Files, DepRange=DepRange, NumData=NumData, $
+                OutLats=Latitudes, OutLons=Longitudes, $
+                Instruments=Instruments, Platform=Platform, $
+                OutDeps=Depths, OutSObs=OutSObs, OutSQC=OutSQC, $
+                OutTObs=OutTObs, OutTQC=OutTQC, OutDates=Dates, $
+                OutTMod=OutTMod, OutSMod=OutSMod, rmdi=rmdi, quiet=quiet, $
+                iobs=iobs, jobs=jobs, kobs=kobs, $
+                ProfileNum=ProfileNum
+
+	types=Instruments+' '+Platform
+
+; if salinity keyword is set then put salinity values first  
+    if keyword_set(Salinity) then begin		
+      Observations = OutSObs
+      ModelVals    = OutSMod    
+      QCs          = OutSQC
+      Observations2 = OutTObs
+      ModelVals2    = OutTMod
+      QCs2          = OutTQC
+    endif else begin
+      Observations = OutTObs
+      ModelVals    = OutTMod
+      QCs          = OutTQC
+      Observations2 = OutSObs
+      ModelVals2    = OutSMod
+      QCs2          = OutSQC
+    endelse 
+
+	numobs=numdata
+        numobs=n_elements(latitudes)
+	              
+  endif else if ObsType eq 'SSH' then begin
+    
+    read_sla, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              ObsSLA=Observations, ModSLA=ModelVals, SLAQC=QCs, $
+              MDT=MDT, Satellites=Satellites, types=types, Dates=Dates, rmdi=rmdi, $
+	      iobs=iobs, jobs=jobs, mstp=mstp, quiet=quiet
+    Depths = fltarr(NumObs)
+    
+  endif else if ObsType eq 'SST' then begin
+     
+    read_sst, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              ObsSST=Observations, ModSST=ModelVals, SSTQC=QCs, $
+              Dates=Dates, rmdi=rmdi, types=types, iobs=iobs, jobs=jobs, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+
+  endif else if ObsType eq 'SEAICE' then begin
+  
+    read_seaice, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+  
+  endif else if ObsType eq 'LOGCHL' then begin
+      
+    read_chl, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+             
+   endif else if ObsType eq 'PCO2' then begin
+      
+    read_pco2, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+
+   endif else if ObsType eq 'CRT' then begin
+
+    read_crt, Files, NumObs=NumObs, $
+              OutLats=Latitudes, OutLons=Longitudes, $
+              OutTypes=Types, OutDates=Dates, $
+              OutUObs=Observations, OutVObs=Observations2, $
+              OutUMod=ModelVals, OutVMod=ModelVals2, Quiet=Quiet, $
+              FloatNum=FloatNum, QC=QCs, OutSpeed=Observations3
+    rmdi=0.0
+    QCs2=QCs
+    Depths = fltarr(NumObs)
+
+   endif else if ObsType eq 'ForecastClass4' then begin
+   
+    print, 'reading forecast class 4 files'
+    read_forc_class4, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Depths=Depths, $
+              Types=types, Dates=Dates, $
+              Obsarr=Observations, Obs2arr=Observations2, $
+              Modarr=ModelVals, Mod2arr=ModelVals2, $
+              QCs1=QCs, QCs2=QCs2, rmdi=rmdi, $
+              notfussy=notfussy
+                  
+  endif else message, 'Error: ObsType is not set correctly'                 
+
+  if (n_elements(types) eq 0) then begin
+  	  types=replicate(rmdi,NumObs)
+  endif
+
+  goto, NOERROR
+  
+IOERROR: error=1
+	 print,'read_cdfobs: an error occurred trying read files: ',files
+
+NOERROR:
+	
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro	(revision 8732)
@@ -0,0 +1,313 @@
+PRO read_enact, Files, DepRange=DepRange, $
+                NumData=NumData, $
+                OutLats=OutLats, OutLons=OutLons, Instruments=OutInst, $
+		Platform=OutPlatform, $
+                OutDeps=OutDeps, OutSObs=OutSObs, OutSQC=OutSQC, $
+                OutTObs=OutTObs, OutTQC=OutTQC, OutDates=OutDates, $
+                OutTMod=OutTMod, OutSMod=OutSMod, rmdi=rmdi, quiet=quiet, $
+                iobs=outiobs, jobs=outjobs, kobs=outkobs, $
+                ProfileNum=OutProfileNum
+
+;------------------------------------------------------------------------------------------
+;Program to read in data from an ENACT format file containing profile data.
+;
+; Inputs:
+;        File        => File name to be read in
+;        DepRange    => (optional) Range of depths for which the data is to be extracted.
+;
+; Outputs:
+;        NumProfs    => Number of profiles  -Integer
+;        Latitudes   => Latitudes(NumProfs) -Real
+;        Longitudes  => Longitudes(NumProfs) -Real
+;        Dates       => Dates(NumProfs)  -Date/time structure.
+;        Instruments => Instrument type (NumProfs) -String
+;        Depths      => Depths of each ob (NumProfs)  -Real
+;        Salinity    => Salinity (psu) (NumProfs)  -Real
+;        SalQC       => QC flag for salinity (NumProfs) 1=> Good  -Int
+;        Temperature => Temperature (deg C) (NumProfs)  -Real
+;        TempQC      => QC flag for temperature (NumProfs) 1=> Good  -Int
+;        ModelT      => Model temperature (deg C) (NumProfs)  -Real
+;        ModelS      => Model salinity (psu) (NumProfs)  -Real
+;        rmdi        => Missing data indicator  -Real
+;
+;Author: Matt Martin. 5/10/07.
+;------------------------------------------------------------------------------------------
+rmdi = 99999.
+if NOT keyword_set(DepRange) then DepRange=[0.,1.e1]   ;Default to top 10 metres.
+NumFiles=n_elements(Files)
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+  File = Files(ifile)
+  
+;1. Open the netcdf file
+  ncid = ncdf_open(File, /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+File
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+File+' successfully'
+  
+  ;2. Get info about file
+  ncinfo = ncdf_inquire(ncid)
+;  if not keyword_set(quiet) then , ncinfo
+  ;3. Read in the relevant dimensions
+  for idim = 0, ncinfo.ndims-1 do begin
+    ncdf_diminq, ncid, idim, name, dimlen
+    if name eq 'N_PROF' then NumProfs = dimlen $
+    else if name eq 'N_LEVELS' then NumLevels = dimlen $
+    else if name eq 'STRING4' then str4 = dimlen
+  endfor
+ 
+  ;4. Set up arrays and read in the data
+
+  if (NumProfs gt 0) then begin  
+  JulDays = fltarr(NumProfs)
+  Latitudes = fltarr(NumProfs)
+  Longitudes = fltarr(NumProfs)
+  BytInsts = intarr(4, NumProfs)
+  Instruments = strarr(NumProfs)
+  Platforms = strarr(NumProfs)
+  Instrumentsa = strarr(NumLevels, NumProfs)
+  Platformsa = strarr(NumLevels, NumProfs)
+  Depths = fltarr(NumLevels, NumProfs)
+  Salinity = fltarr(NumLevels, NumProfs)
+  SalQC = intarr(NumLevels, NumProfs)
+  Temperature = fltarr(NumLevels, NumProfs)
+  TempQC = intarr(NumLevels, NumProfs)
+  ModelT = fltarr(NumLevels, NumProfs)
+  ModelS = fltarr(NumLevels, NumProfs)
+  ProfileNum = replicate(1,NumLevels)#indgen(NumProfs)
+    
+  varid = ncdf_varid(ncid, 'JULD')
+  ncdf_varget, ncid, varid, JulDays
+  
+;  print,JulDays
+  
+;  BaseDate = var_to_dt(1950,1,1)
+;  BaseDate=JULDAY(1,1,1950,0,0)
+  BaseDate=double(JULDAY(1,1,1950,0,0))		;should be at 0 UTC
+;  info,BaseDate
+  Dates = replicate(BaseDate, NumLevels,NumProfs)
+;  info,dates
+  for iprof = 0L, NumProfs-1 do begin
+    secs = JulDays(iprof)* 24. * 60. * 60.
+;    dt = dt_add(BaseDate, second=secs)
+    dt=BaseDate+JulDays(iprof)
+;    CALDAT, dt, mon, day, year, hour, minute, second
+;    print,dt-BaseDate, mon, day, year, hour, minute, second
+    Dates(0:NumLevels-1,iprof) = replicate(dt,NumLevels)
+  endfor
+
+  
+ 
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  ncdf_varget, ncid, varid, Longitudes
+
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  ncdf_varget, ncid, varid, Latitudes
+
+  varid = ncdf_varid(ncid, 'DEPH_CORRECTED')
+  ncdf_varget, ncid, varid, Depths
+  res = ncdf_attinq( ncid, varid , '_FillValue')
+  if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+  else begin
+    res = ncdf_attinq( ncid, varid , '_fillvalue')
+    ncdf_attget, ncid, varid, '_fillvalue', FillVal
+  endelse
+  pts = where(Depths eq FillVal, count)
+  if count gt 0 then Depths(pts) = rmdi
+
+;  if keyword_set(Salinity) then begin
+    varid = ncdf_varid(ncid, 'PSAL_CORRECTED')
+    if (varid ne -1) then  begin
+;    if not keyword_set(quiet) then print,'reading psal_corrected'
+    ncdf_varget, ncid, varid, Salinity
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(Salinity eq FillVal, count)
+    if count gt 0 then Salinity(pts) = rmdi
+   endif      
+    varid = ncdf_varid(ncid, 'PSAL_CORRECTED_QC')
+    ncdf_varget, ncid, varid, SalQC
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    SalQC = SalQC - 48
+;  endif
+
+;  if keyword_set(Temperature) then begin
+    varid = ncdf_varid(ncid, 'POTM_CORRECTED')
+    if (varid ne -1) then  begin
+;    if not keyword_set(quiet) then print,'reading potm_corrected'
+    ncdf_varget, ncid, varid, Temperature
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+;    if not keyword_set(quiet) then print,'Temp fill value ',fillval
+    pts = where(Temperature eq FillVal, count)
+    if count gt 0 then Temperature(pts) = rmdi
+   endif   
+    varid = ncdf_varid(ncid, 'POTM_CORRECTED_QC')
+    ncdf_varget, ncid, varid, TempQC
+    TempQC = TempQC - 48
+;   endif
+
+;  if keyword_set(OutTMod) then begin
+    varid = ncdf_varid(ncid, 'POTM_Hx')
+    if (varid ne -1) then begin
+    ncdf_varget, ncid, varid, ModelT
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(ModelT eq FillVal, count)
+    if count gt 0 then ModelT(pts) = rmdi
+    endif else begin
+	ModelT=rmdi
+    endelse
+;   endif
+
+;  if keyword_set(OutSMod) then begin
+    varid = ncdf_varid(ncid, 'PSAL_Hx')
+    if (varid ne -1) then begin
+    ncdf_varget, ncid, varid, ModelS
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(ModelS eq FillVal, count)
+    if count gt 0 then ModelS(pts) = rmdi
+    endif else begin
+	ModelS=rmdi
+    endelse
+;  endif
+
+  varid = ncdf_varid(ncid, 'WMO_INST_TYPE')
+  ncdf_varget, ncid, varid, BytInsts
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 56 and $
+              BytInsts(2,*) eq 50 and $
+              BytInsts(3,*) eq 48, count)
+  if count gt 0 then Instruments(pts) = 'BUOYS'  ; 820
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 52 and $
+              BytInsts(2,*) eq 48 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'XBT'    ; 401
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 55 and $
+              BytInsts(2,*) eq 52 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'TESAC'  ; 741
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 56 and $
+              BytInsts(2,*) eq 51 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'ARGO'   ; 831
+  
+  pts = where(Instruments eq '', count) 
+  if count gt 0 then Instruments(pts) = 'UNKNOWN'
+  
+  varid = ncdf_varid(ncid, 'PLATFORM_NUMBER')
+  ncdf_varget, ncid, varid, platforms
+  platforms=string(platforms)
+  
+  for i=0,numlevels-1 do begin
+    platformsa(i,*)=platforms
+    instrumentsa(i,*)=instruments
+  endfor
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsval
+
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsval
+
+  varid = ncdf_varid(ncid, 'KOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, kobsval
+    
+  ;Select those obs in the required depth range
+;  Lats = replv(Latitudes(*), [NumLevels,NumProfs],1)
+;  Lons = replv(Longitudes(*), [NumLevels,NumProfs],1)
+
+	Lons=fltarr(NumLevels,NumProfs)
+        Lats=fltarr(NumLevels,NumProfs)
+	iobs=fltarr(NumLevels,NumProfs)
+        jobs=fltarr(NumLevels,NumProfs)
+        
+	for i=0L,NumProfs-1 do begin
+          Lats(*,i)=Latitudes(i)
+          Lons(*,i)=Longitudes(i)
+          if (n_elements(iobsval) gt 0) then $
+	          iobs(*,i)=iobsval(i)
+          if (n_elements(jobsval) gt 0) then $
+          	  jobs(*,i)=jobsval(i)
+        endfor  
+  
+  pts = where(Depths ge DepRange(0) and Depths le DepRange(1), NumData)
+  
+  if ifile2 eq 0 then begin  
+    OutTObs = [Temperature(pts)]
+    OutSObs = [Salinity(pts)]
+    OutTMod = [ModelT(pts)]
+    OutSMod = [ModelS(pts)]
+    OutTQC  = [TempQC(pts)]
+    OutSQC  = [SalQC(pts)]
+    OutDeps = [Depths(pts)]
+    OutLats = [Lats(pts)]
+    OutLons = [Lons(pts)]
+    OutDates= [Dates(pts)]
+    OutInst= [Instrumentsa(pts)]    
+    OutPlatform= [Platformsa(pts)]
+    OutProfileNum = [ProfileNum(pts)]
+    if (n_elements(iobsval) gt 0) then outiobs = [iobs(pts)]
+    if (n_elements(jobsval) gt 0) then outjobs = [jobs(pts)]
+    if (n_elements(kobsval) gt 0) then outkobs = [kobsval(pts)]
+    
+  endif else begin
+    OutTObs = [OutTObs,Temperature(pts)]
+    OutSObs = [OutSObs,Salinity(pts)]
+    OutTMod = [OutTMod,ModelT(pts)]
+    OutSMod = [OutSMod,ModelS(pts)]
+    OutTQC  = [OutTQC,TempQC(pts)]
+    OutSQC  = [OutSQC,SalQC(pts)]
+    OutDeps = [OutDeps,Depths(pts)]
+    OutLats = [OutLats,Lats(pts)]
+    OutLons = [OutLons,Lons(pts)]
+    OutDates= [OutDates,Dates(pts)]
+    OutInst= [OutInst,Instrumentsa(pts)]
+    OutPlatform = [OutPlatform, Platformsa(pts)]
+    OutProfileNum = [OutProfileNum, ProfileNum(pts)]
+    if (n_elements(iobsval) gt 0) then outiobs = [outiobs, iobs(pts)]
+    if (n_elements(jobsval) gt 0) then outjobs = [outjobs, jobs(pts)]
+    if (n_elements(kobsval) gt 0) then outkobs = [outkobs, kobsval(pts)]
+
+  endelse
+
+	ifile2=ifile2+1
+   endif
+  ncdf_close, ncid
+
+
+	endif
+  
+endfor ;ifile
+
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro	(revision 8732)
@@ -0,0 +1,283 @@
+PRO read_feedback, Files, DepRange=DepRange, VarName=VarNames, NumData=NumData, $
+                OutLats=OutLats, OutLons=OutLons, $
+                OutInstruments=OutInst, OutPlatform=OutPlatform, $
+                OutDeps=OutDeps,  $
+                OutObs1=OutObs1, OutObs2=OutObs2, $
+                OutMod1=OutMod1, OutMod2=OutMod2, $
+                OutQC1=OutQC1, OutQC2=OutQC2, $
+                MDT=MDT, OutDates=OutDates, $
+                rmdi=rmdi, quiet=quiet, $
+                OutProfileNum=OutProfileNum
+
+;------------------------------------------------------------------------------------------
+;Program to read in data from a feedback format file
+;
+; Inputs:
+;        File        => File name to be read in
+;        DepRange    => (optional) Range of depths for which the data is to be extracted.
+;
+; Outputs:
+
+;
+;Author: Matt Martin. 29/09/09
+;------------------------------------------------------------------------------------------
+rmdi = 99999.
+if NOT keyword_set(DepRange) then DepRange=[0.,1.e1]   ;Default to top 10 metres.
+NumFiles=n_elements(Files)
+
+ifile2=0
+numdata=0
+for ifile = 0, NumFiles-1 do begin
+  File = Files(ifile)
+  
+;1. Open the netcdf file
+  ncid = ncdf_open(File, /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+File
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+File+' successfully'
+  
+  ;2. Get info about file
+  ncinfo = ncdf_inquire(ncid)
+
+  ;3. Read in the relevant dimensions
+  NumExtra = 0
+  for idim = 0, ncinfo.ndims-1 do begin
+    ncdf_diminq, ncid, idim, name, dimlen
+    if name eq 'N_OBS' then NumObs = dimlen $
+    else if name eq 'N_LEVELS' then NumLevels = dimlen $
+    else if name eq 'N_VARS' then NumVars = dimlen $
+    else if name eq 'N_QCF' then NumFlags = dimlen $
+    else if name eq 'N_ENTRIES' then NumEntries = dimlen $
+    else if name eq 'N_EXTRA' then NumExtra = dimlen $
+    else if name eq 'STRINGNAM' then strnam = dimlen $
+    else if name eq 'STRINGGRID' then strgrid = dimlen $
+    else if name eq 'STRINGWMO' then strwmo = dimlen $
+    else if name eq 'STRINGTYP' then strtyp = dimlen $
+    else if name eq 'STRINGJULD' then strjuld = dimlen
+  endfor
+ 
+  ;4. Set up arrays 
+
+  if (NumObs gt 0) then begin  
+    ByteNam = intarr(strnam, NumVars)
+    if (n_elements(NumEntries) eq 1) then ByteEntries = intarr(strnam, NumEntries)
+    ByteId = intarr(strwmo, NumObs)
+    ByteType = intarr(strtyp, NumObs)
+    ByteJulDRef = intarr(strjuld)
+    VarNames = strarr(NumVars)
+    if (n_elements(NumEntries) eq 1) then Entries = strarr(NumEntries)
+    Id = strarr(NumObs)
+    Type = strarr(NumObs)
+    if NumExtra gt 0 then begin
+      ByteExtra = intarr(strnam, NumExtra)    
+      Extra = strarr(NumExtra)    
+    endif 
+    Longitude = fltarr(NumObs)
+    Latitude  = fltarr(NumObs)
+    Depth     = fltarr(NumLevels, NumObs)
+    DepQC     = intarr(NumLevels, NumObs)
+    JulD      = dblarr(NumObs)
+    ObsQC     = intarr(NumObs)
+    PosQC     = intarr(NumObs)
+    JulDQC    = intarr(NumObs)
+    Obs       = fltarr(NumLevels, NumObs, NumVars)
+    Hx        = fltarr(NumLevels, NumObs, NumVars)
+    VarQC     = intarr(NumObs, NumVars)
+    LevelQC   = intarr(NumLevels, NumObs, NumVars)
+    
+  ;5. Read in the data  
+    varid = ncdf_varid(ncid, 'VARIABLES')
+    ncdf_varget, ncid, varid, ByteNam
+;    info, VarNames
+;    info, ByteNam
+    for ivar= 0, NumVars-1 do begin
+      VarNames(ivar) = string(ByteNam(*,ivar))
+    endfor
+    
+    if ifile2 eq 0 then VarName = VarNames(0)
+    if VarName ne VarNames(0) then message, 'Can only read in from files containing the same variables'
+    
+    varid = ncdf_varid(ncid, 'JULD_REFERENCE')
+    ncdf_varget, ncid, varid, ByteJulDRef
+    JulDRef = string(ByteJulDRef)
+    RefDate = JULDAY(fix(strmid(JulDRef,4,2)), fix(strmid(JulDRef,6,2)), fix(strmid(JulDRef,0,4)), $
+                     fix(strmid(JulDRef,8,2)), fix(strmid(JulDRef,10,2)), fix(strmid(JulDRef,12,2)))
+	print, 'RefDate: ',RefDate
+    varid = ncdf_varid(ncid, 'JULD')
+    ncdf_varget, ncid, varid, JulD
+;    print, JulD
+    Dates = dblarr(NumLevels, NumObs)
+    for iob = 0L, long(NumObs)-1L do begin
+      dt = RefDate + JulD(iob)
+;      print,dt, JulD(iob)
+      Dates(0:NumLevels-1, iob) = replicate(dt, NumLevels)
+    endfor
+    
+    varid = ncdf_varid(ncid, 'STATION_IDENTIFIER')
+    ncdf_varget, ncid, varid, ByteId
+    Identifier = string(ByteId)
+    
+    varid = ncdf_varid(ncid, 'STATION_TYPE')
+    ncdf_varget, ncid, varid, ByteType
+    Type = string(ByteType)
+   
+    varid = ncdf_varid(ncid, 'LONGITUDE')
+    ncdf_varget, ncid, varid, Longitude
+  
+    varid = ncdf_varid(ncid, 'LATITUDE')
+    ncdf_varget, ncid, varid, Latitude
+  
+    varid = ncdf_varid(ncid, 'DEPTH')
+    ncdf_varget, ncid, varid, Depth
+    ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+    pts = where(Depth eq FillVal, count)
+    if count gt 0 then Depth(pts) = rmdi
+    
+    varid = ncdf_varid(ncid, 'OBSERVATION_QC')
+    ncdf_varget, ncid, varid, ObsQC
+    ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+    pts = where(ObsQC eq FillVal, count)
+    if count gt 0 then ObsQC(pts) = rmdi      
+    
+    for ivar = 0, NumVars-1 do begin
+    
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_OBS')
+      ncdf_varget, ncid, varid, tmp
+      Obs(*,*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValObs
+  
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_Hx')
+      if (varid gt -1) then begin
+         ncdf_varget, ncid, varid, tmp
+         Hx(*,*,ivar) = tmp
+         ncdf_attget, ncid, varid, '_Fillvalue', FillValHx
+      endif else begin
+         FillValHx=0
+      endelse 
+      
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_QC')
+      ncdf_varget, ncid, varid, tmp
+      VarQC(*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValQC
+      
+      
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_LEVEL_QC')
+      ncdf_varget, ncid, varid, tmp
+      LevelQC(*,*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValLevQC
+          
+    endfor        
+ 
+; 	print,' DJL levelqc(*,218,0) ',levelqc(*,218,0)
+; 	print,' DJL levelqc(*,218,1) ',levelqc(*,218,1)
+    
+    pts = where(Obs eq FillValObs, count)
+    if count gt 0 then Obs(pts) = rmdi
+    pts = where(Hx eq FillValHx, count)
+    if count gt 0 then Hx(pts) = rmdi   
+    pts = where(VarQC eq FillValQC, count)
+    if count gt 0 then VarQC(pts) = rmdi  
+    pts = where(LevelQC eq FillValLevQC, count)
+    if count gt 0 then LevelQC(pts) = rmdi        
+
+    Obs1 = Obs(*,*,0)
+    Hx1  = Hx(*,*,0)
+    VarQC1=LevelQC(*,*,0)    
+    if NumVars gt 1 then begin
+      Obs2 = Obs(*,*,1)
+      Hx2  = Hx(*,*,1)
+      VarQC2=LevelQC(*,*,1)    
+    endif
+    
+    if strtrim(VarName,2) eq 'SLA' then begin
+      MDT = fltarr(NumLevels, NumObs)
+      print, NumLevels, NumObs
+      varid = ncdf_varid(ncid, 'MDT')
+      ncdf_varget, ncid, varid, MDT
+      ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+      pts = where(MDT eq FillVal, count)
+      if count gt 0 then MDT(pts) = rmdi   
+      Obs2 = MDT
+    endif
+          
+    ;6. Put the data into the correct form to be output from this routine
+    Platformsa = strarr(NumLevels, NumObs)
+    Instrumentsa = strarr(NumLevels, NumObs)
+    Lons = fltarr(NumLevels,NumObs)
+    Lats = fltarr(NumLevels,NumObs)
+    ProfileNum = lonarr(NumLevels,NumObs)
+        
+    for i=0,NumLevels-1 do begin
+      Platformsa(i,*)=Type
+      Instrumentsa(i,*)=Identifier
+    endfor
+      
+    for i=0L,long(NumObs)-1L do begin
+      Lats(*,i)=Latitude(i)
+      Lons(*,i)=Longitude(i)
+      ProfileNum(*,i) = i+1
+    endfor  
+;   
+   pts = where(Depth ge DepRange(0) and Depth le DepRange(1), NumDataInc)
+   NumData=NumData+NumDataInc
+;   
+   if ifile2 eq 0 then begin  
+     OutObs1 = [Obs1(pts)]
+     OutMod1 = [Hx1(pts)]
+     OutQC1  = [VarQC1(pts)]
+     OutDeps = [Depth(pts)]
+     OutLats = [Lats(pts)]
+     OutLons = [Lons(pts)]
+     OutDates= [Dates(pts)]
+     OutInst= [Instrumentsa(pts)]    
+     OutPlatform= [Platformsa(pts)]
+     OutProfileNum = [ProfileNum(pts)]
+     if NumVars eq 2 then begin
+       OutObs2 = [Obs2(pts)]     
+       OutMod2 = [Hx2(pts)]     
+       OutQC2  = [VarQC2(pts)]
+     endif
+   endif else begin
+     OutObs1 = [OutObs1, Obs1(pts)]
+     OutMod1 = [OutMod1, Hx1(pts)]
+     OutQC1  = [OutQC1, VarQC1(pts)]
+     OutDeps = [OutDeps, Depth(pts)]
+     OutLats = [OutLats, Lats(pts)]
+     OutLons = [OutLons, Lons(pts)]
+     OutDates= [OutDates, Dates(pts)]
+     OutInst= [OutInst, Instrumentsa(pts)]    
+     OutPlatform= [OutPlatform, Platformsa(pts)]
+     OutProfileNum = [OutProfileNum, ProfileNum(pts)]
+     if NumVars eq 2 then begin
+       OutObs2 = [OutObs2, Obs2(pts)]     
+       OutMod2 = [OutMod2, Hx2(pts)]     
+       OutQC2  = [OutQC2, VarQC2(pts)]
+     endif
+   endelse
+   
+   if NumVars eq 1 then begin
+     if VarName ne 'SLA' then OutObs2 = fltarr(n_elements(OutObs1)) + rmdi
+     OutMod2 = fltarr(n_elements(OutMod1)) + rmdi
+     OutQC2  = fltarr(n_elements(OutQC1)) + rmdi
+   endif
+; 
+   ifile2=ifile2+1
+   endif
+  ncdf_close, ncid
+  
+  endif
+  
+endfor ;ifile
+
+pts1 = where(OutQC1 eq 1, count1)
+pts2 = where(OutQC1 ne 1, count2)
+if count1 gt 0 then OutQc1(pts1) = 0
+if count2 gt 0 then OutQc1(pts2) = 1
+if NumVars gt 1 then begin
+  pts1 = where(OutQC2 eq 1, count1)
+  pts2 = where(OutQC2 ne 1, count2)
+  if count1 gt 0 then OutQc2(pts1) = 0
+  if count2 gt 0 then OutQc2(pts2) = 1
+endif
+
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro	(revision 8732)
@@ -0,0 +1,178 @@
+PRO  read_seaice, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               Obs=Obs, modarr=modarr, qc=qcarr, $
+               Dates=Dates, rmdi=rmdi, iobs=outiobs, jobs=outjobs, $
+               nodates=nodates, quiet=quiet
+;------------------------------------------------------------
+;IDL program to read in netcdf files of sea ice data.
+;
+;Author:   D. J. Lea       Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)		; should be at 0 UTC
+
+; could read in from file
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+  ncdf_diminq, ncid, 0, name, NData
+  if Ndata gt 0 then begin
+
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  bytQC  = bytarr(NData)  
+  QC     = fltarr(NData)
+  Dats   = dblarr(NData)
+  dts    = replicate(!dt_base, NData)
+  iobs = intarr(NData)
+  jobs = intarr(NData)
+
+; output attribute and variable info
+;  ncattinfo, id
+  
+  varid = ncdf_varid(ncid, 'lon')
+;  if not keyword_set(quiet) then print,varid
+  if (varid eq -1) then varid = ncdf_varid(ncid, 'LONGITUDE')
+  ncdf_varget, ncid, varid, lons
+  
+  varid = ncdf_varid(ncid, 'lat')
+;  if not keyword_set(quiet) then print,varid
+  if (varid eq -1) then varid = ncdf_varid(ncid, 'LATITUDE')
+  ncdf_varget, ncid, varid, lats
+
+  if (keyword_set(nodates) eq 0) then begin
+
+  varid = ncdf_varid(ncid, 'JULD')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, Dats
+    dts = Dats+RefDate
+  endif else begin
+    varid = ncdf_varid(ncid, 'time')
+    ncdf_varget, ncid, varid, secs_from_base
+    varid = ncdf_varid(ncid, 'SeaIce_dtime')
+    ncdf_varget, ncid, varid, dtime
+    ncdf_attget, ncid, varid, 'scale_factor', scale_factor    
+    if not keyword_set(quiet) then print,'dtime(0): ',dtime(0), scale_factor
+    dtime=dtime*scale_factor
+;    RefDate = '1981-01-01'
+    RefDate = JULDAY(1,1,1981,0,0)	; should be ref from 0 UTC
+    dtime = dtime + secs_from_base
+    dts = RefDate + dtime/86400.
+  endelse
+
+  endif
+
+  if not keyword_set(quiet) then print,'reading sea ice data'   
+  varid = ncdf_varid(ncid, 'sea_ice_concentration')
+    if not keyword_set(quiet) then print,varid
+    if (varid eq -1) then begin
+    	 varid2 = ncdf_varid(ncid, 'SEAICE')
+         if (varid2 ne -1) then ncdf_varget, ncid, varid2, obsval
+    endif
+    if (varid ne -1) then ncdf_varget, ncid, varid, obsval
+    if not keyword_set(quiet) then print,'scale_factor'
+  scale_factor=1.  
+  if (varid ne -1) then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+
+  if not keyword_set(quiet) then print,'_FillValue'
+  FillValue=99999
+      
+;  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  if not keyword_set(quiet) then print,FillValue  
+
+  pts = where(obsval eq FillValue, count)
+
+  if not keyword_set(quiet) then print,'scale_factor ',scale_factor  
+  obsval=obsval*scale_factor
+  
+  if count gt 0 then obsval(pts) = rmdi
+
+
+  if not keyword_set(quiet) then print,'reading sea ice model values'
+  varid = ncdf_varid(ncid, 'SEAICE_Hx')
+  if (varid ne -1) then ncdf_varget, ncid, varid, modval
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobs
+  
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobs
+  
+
+  scale_factor=1
+  pts = where(modval eq FillValue or modval eq -9999, count)
+  
+  modval=modval*scale_factor
+  
+  if count gt 0 then modval(pts) = rmdi
+
+  	if not keyword_set(quiet) then print,'sea ice qc'
+
+  varid = ncdf_varid(ncid, 'SEAICE_QC')	     
+  if (varid ne -1) then begin
+   if not keyword_set(quiet) then print,'bytQC' 
+   ncdf_varget, ncid, varid, bytQC
+   ncdf_attget, ncid, varid, '_FillValue', FillValue
+   QC(*) = 0.
+   pts = where(bytQC eq FillValue, count)
+   if count gt 0 then QC(pts) = rmdi
+   pts = where(bytQC ne 48, count)
+   if count gt 0 then QC(pts) = 1.  
+  endif else begin
+   varid = ncdf_varid(ncid, 'confidence_flag')
+   ncdf_varget, ncid, varid, QC
+  endelse
+  
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    Obs = [obsval]
+    Modarr = [modval]
+    QCarr = [QC]
+    Dates = [dts]
+    if (n_elements(iobs) gt 0) then outiobs = [iobs]
+    if (n_elements(jobs) gt 0) then outjobs = [jobs]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    Obs = [Obs, obsval]
+    Modarr = [Modarr, modval]    
+    QCarr = [QCarr, QC]
+    Dates = [Dates, dts]
+    if (n_elements(iobs) gt 0) then outiobs = [outiobs, iobs]
+    if (n_elements(jobs) gt 0) then outjobs = [outjobs, jobs]
+  endelse      
+
+ifile2=ifile2+1
+endif
+
+  if not keyword_set(quiet) then print,'closing file'
+
+  ncdf_close, ncid
+
+endif
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+if (n_elements(Modarr) ne NumObs) then Modarr=replicate(rmdi,NumObs)
+
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro	(revision 8732)
@@ -0,0 +1,312 @@
+;+
+PRO  read_sla, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               ObsSLA=ObsSLA, ModSLA=ModSLA, SLAQC=SLAQC, $
+               MDT=MDT, Satellites=Satellites, Types=Types, Dates=Dates, rmdi=rmdi, $
+	       iobs=iobs, jobs=jobs, mstp=mstp, quiet=quiet, track=track
+;+-----------------------------------------------------------
+;IDL program to read in netcdf files of altimeter data.
+;
+;Author:  D. J. Lea       - Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)		; should be at 0 UTC
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+;  var = ncdf_varinq( ncid, "SLA" )
+  if not keyword_set(quiet) then print,'ncinfo.ndims ',ncinfo.ndims
+  ncdf_diminq, ncid, 0, name, NData
+  NData2=0
+  cycles=1
+  if (ncinfo.ndims gt 2) then ncdf_diminq, ncid, 2, name, NData2
+  if (ncinfo.ndims gt 1) then ncdf_diminq, ncid, 1, name, cycles
+
+
+  if not keyword_set(quiet) then print,NData, NData2
+
+ NData=max([NData*cycles, NData2*cycles])
+
+; print,NData, NData2
+
+  if (NData gt 0) then begin
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  mdtval = fltarr(NData)  
+  bytQC  = bytarr(NData)
+  QC     = fltarr(NData)
+  Dats   = dblarr(NData)
+  trackval  = intarr(NData)
+  Sats   = intarr(NData)
+  strSats= strarr(NData)
+  StrVal = strarr(8)
+;  dts    = replicate(!dt_base, NData)
+  dts = dblarr(NData)
+  
+;  info,lons 
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  scale_factor=1.
+  if (varid eq -1) then begin 
+  	varid = ncdf_varid(ncid, 'Longitudes')
+        if (varid eq -1) then begin
+             varid = ncdf_varid(ncid, 'longitude')
+        endif
+        ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  endif
+  ncdf_varget, ncid, varid, lons 
+  lons=lons*scale_factor
+;  info, lons
+  if (cycles gt 1) then begin
+    lonsn=lons
+    for i=1,cycles-1 do begin
+       lonsn=[lonsn,lons]
+    endfor
+    lons=lonsn
+  endif
+
+;  info, lons
+
+;  info,lats     
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  scale_factor=1.
+  if (varid eq -1) then begin
+  	varid = ncdf_varid(ncid, 'Latitudes')
+        if (varid eq -1) then begin
+             varid = ncdf_varid(ncid, 'latitude')
+        endif
+        ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  endif
+  ncdf_varget, ncid, varid, lats
+  lats=lats*scale_factor
+;  info, lats
+  if (cycles gt 1) then begin
+    latsn=lats
+    for i=1,cycles-1 do begin
+       latsn=[latsn,lats]
+    endfor
+    lats=latsn
+  endif
+  
+;  info, lats
+    
+  varid = ncdf_varid(ncid, 'JULD')
+  if (varid eq -1) then begin
+        varid = ncdf_varid(ncid, 'time')
+  endif
+  if (varid ne -1) then begin 
+  	ncdf_varget, ncid, varid, Dats
+  endif else begin
+        varid = ncdf_varid(ncid, 'BeginDates')
+        ncdf_varget, ncid, varid, Bds
+;        print,bds
+;        info, bds
+        if (cycles gt 1) then begin
+           bds=transpose(bds)
+        endif
+        varid = ncdf_varid(ncid, 'NbPoints')
+        ncdf_varget, ncid, varid, nbpoints
+
+; Read in dataindexes and deltat in cls format file 
+; These are used to adjust dates 
+        varid = ncdf_varid(ncid, 'DeltaT')
+        if (varid ne -1) then begin 
+  	  ncdf_varget, ncid, varid, deltat
+          ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+          deltat=deltat*scale_factor
+          varid = ncdf_varid(ncid, 'DataIndexes')
+          ncdf_varget, ncid, varid, dataindexes
+          
+        endif
+
+	print, 'deltat ',deltat
+;        print, 'dataindexes ',dataindexes
+
+;        info, nbpoints
+;        print,nbpoints
+;        info, cycles
+        cumbds=[0]
+        nbpointst=nbpoints
+        dataindexest=dataindexes
+        for i=1,cycles-1 do begin
+	 	nbpointst=[nbpointst,nbpoints]
+                dataindexest=[dataindexest,dataindexes]
+        endfor
+        cumbds=[0,total(nbpointst,/cumulative)]
+;       if not keyword_set(quiet) then print,'cumbds ',cumbds
+        nel=n_elements(Bds)
+;        info,nel
+;       if not keyword_set(quiet) then print,n_elements(dats)
+        for i=0,nel-1 do begin
+;        print,'*',i, cumbds(i+1)-cumbds(i) 
+;           print,i,cumbds(i),cumbds(i+1)-1
+           dats(cumbds(i):cumbds(i+1)-1)=bds(i)
+           trackval(cumbds(i):cumbds(i+1)-1)=i
+           dataindexest(cumbds(i):cumbds(i+1)-1)=dataindexest(cumbds(i):cumbds(i+1)-1)-dataindexest(cumbds(i))
+        endfor
+        
+; adjust dats based on dataindex
+	dats=dats+dataindexest*deltat/86400.
+        
+        
+;        print, dats
+  endelse
+
+
+          
+  dts=RefDate + Dats 
+    
+  varid = ncdf_varid(ncid, 'MISSION')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, Sats
+  ncdf_attget, ncid, varid, 'Value_0', StrVal0           
+  ncdf_attget, ncid, varid, 'Value_1', StrVal1  
+  ncdf_attget, ncid, varid, 'Value_2', StrVal2  
+  ncdf_attget, ncid, varid, 'Value_3', StrVal3      
+  ncdf_attget, ncid, varid, 'Value_4', StrVal4  
+  ncdf_attget, ncid, varid, 'Value_5', StrVal5 
+  ncdf_attget, ncid, varid, 'Value_6', StrVal6    
+  ncdf_attget, ncid, varid, 'Value_7', StrVal7
+  StrVal=[StrVal0, StrVal1, StrVal2, StrVal3, StrVal4, $
+  	StrVal5, StrVal6, StrVal7]    
+  for ival = 0, 7 do begin
+    pts = where(Sats eq ival, count)
+    if count gt 0 then strSats(pts) = StrVal(ival)
+  endfor
+  endif
+
+  varid = ncdf_varid(ncid, 'SLA')
+  ncdf_varget, ncid, varid, obsval
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  scale_factor=1.
+  add_offset=0.
+  ;if (ncinfo.ndims gt 2) then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  ncviq=ncdf_varinq(ncid, varid)
+  for iatt=0,ncviq.natts-1 do begin
+    ncaiq=ncdf_attname(ncid, varid, iatt)
+    if ( ncaiq eq 'scale_factor') then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+    if ( ncaiq eq 'add_factor') then ncdf_attget, ncid, varid, 'add_factor', add_factor
+  endfor
+
+  if not keyword_set(quiet) then print,'SLA scale factor: ',scale_factor
+  if not keyword_set(quiet) then print,'SLA add offset: ',add_offset
+  if not keyword_set(quiet) then print,'SLA FillValue: ',FillValue
+  pts = where(obsval eq FillValue, count)
+;  if not keyword_set(quiet) then print,count
+  obsval=obsval*scale_factor+add_offset
+  if count gt 0 then obsval(pts) = rmdi
+  
+  varid = ncdf_varid(ncid, 'SLA_Hx')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, modval
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+;  if not keyword_set(quiet) then print,'SLA_Hx FillValue ',FillValue
+  pts = where(modval eq FillValue or modval eq -9999.0, count)
+;  if not keyword_set(quiet) then print,count
+  if count gt 0 then modval(pts) = rmdi
+  endif
+    
+  varid = ncdf_varid(ncid, 'SLA_QC')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, bytQC
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  QC(*) = 0.
+  pts = where(bytQC eq FillValue, count)
+  if count gt 0 then QC(pts) = rmdi
+  pts = where(bytQC ne 48, count)
+  if count gt 0 then QC(pts) = 1.
+  endif
+  
+  varid = ncdf_varid(ncid, 'MDT')
+  if (varid ne -1) then ncdf_varget, ncid, varid, mdtval
+
+  varid = ncdf_varid(ncid, 'data_source')
+  if varid ne -1 then begin
+     ncdf_varget, ncid, varid, obstyp
+  endif else begin
+     varid = ncdf_varid(ncid, 'MISSION')
+     if varid ne -1 then ncdf_varget, ncid, varid, obstyp
+  endelse
+
+; reads in multi cycle data the wrong way round!
+  if (cycles gt 1) then begin
+      obsval=reform(obsval,[cycles,ndata/cycles])
+      obsval=transpose(obsval)
+      modval=reform(modval,[cycles,ndata/cycles])
+      modval=transpose(modval)
+      QC=reform(QC,[cycles,ndata/cycles])
+      QC=transpose(QC)
+  endif
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsval
+
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsval
+
+  varid = ncdf_varid(ncid, 'MSTP')
+  if (varid ne -1) then ncdf_varget, ncid, varid, mstpval
+
+;  info, obssla
+;  info, obsval
+;  info, modsla
+;  info, modval
+ 
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    ObsSLA = [obsval(*)]
+    ModSLA = [modval(*)]
+    MDT = [mdtval]
+    SLAQC = [QC]
+    Dates = [dts]
+    Satellites = [strSats]
+    if (n_elements(obstyp) gt 0) then Types = [obstyp]
+    if (n_elements(iobsval) gt 0) then iobs = [iobsval]
+    if (n_elements(jobsval) gt 0) then jobs = [jobsval]
+   if (n_elements(mstpval) gt 0) then mstp = [mstpval]
+   if (n_elements(trackval) gt 0) then track = [trackval]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    ObsSLA = [ObsSLA, obsval(*)]
+    ModSLA = [ModSLA, modval(*)]
+    MDT = [MDT, mdtval]    
+    SLAQC = [SLAQC, QC]
+    Dates = [Dates, dts]    
+    Satellites = [Satellites, strSats]
+    if (n_elements(obstyp) gt 0) then Types = [Types, obstyp]
+    if (n_elements(iobsval) gt 0) then iobs = [iobs, iobsval]
+    if (n_elements(jobsval) gt 0) then jobs = [jobs, jobsval]
+    if (n_elements(mstpval) gt 0) then mstp = [mstp, mstpval]
+    if (n_elements(trackval) gt 0) then tracks = [track, trackval]
+  endelse      
+
+ifile2=ifile2+1
+endif
+  ncdf_close, ncid
+
+endif
+
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro	(revision 8732)
@@ -0,0 +1,193 @@
+PRO  read_sst, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               ObsSST=ObsSST, ModSST=ModSST, SSTQC=SSTQC, $
+               Dates=Dates, rmdi=rmdi, Types=Types, iobs=iobs, jobs=jobs, $
+               quiet=quiet
+;------------------------------------------------------------
+;IDL program to read in netcdf files of altimeter data.
+;
+;Author:  D. J. Lea        - Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;print,NumFiles
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)    ; should be at 0 UTC
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+
+  if ncinfo.Ndims eq 1 then begin
+    ncdf_diminq, ncid, 0, name, NData
+  endif else if ncinfo.Ndims eq 2 then begin
+    ncdf_diminq, ncid, 1, name, NData
+    if (name eq "string8") then  ncdf_diminq, ncid, 0, name, NData
+  endif else if ncinfo.Ndims eq 3 then begin
+    ncdf_diminq, ncid, 1, name, NLats
+    ncdf_diminq, ncid, 2, name, NLons
+    NData = NLats * NLons
+  endif
+    
+  if not keyword_set(quiet) then print, 'Number of SST data points ',NData
+  
+  if (NData gt 0) then begin
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  bytQC  = bytarr(NData)
+  QC     = fltarr(NData)
+  obstyp = intarr(NData)  
+  Dats   = dblarr(NData)
+  dts    = replicate(!dt_base, NData)
+  iobsa = intarr(NData)
+  jobsa = intarr(NData)
+  
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  if varid ne -1 then ncdf_varget, ncid, varid, lons $
+  else begin
+    varid = ncdf_varid(ncid, 'lon')
+    ncdf_varget, ncid, varid, lons
+  endelse
+  
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  if varid ne -1 then ncdf_varget, ncid, varid, lats $
+  else begin
+    varid = ncdf_varid(ncid, 'lat')
+    ncdf_varget, ncid, varid, lats
+  endelse
+  
+  varid = ncdf_varid(ncid, 'JULD')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, Dats
+    dts=RefDate + Dats
+    
+  endif else begin
+    varid = ncdf_varid(ncid, 'time')
+    ncdf_varget, ncid, varid, secs_from_base
+    varid = ncdf_varid(ncid, 'sst_dtime')
+    ncdf_varget, ncid, varid, dtime
+    ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+    dtime=dtime*scale_factor
+;    RefDate = '1981-01-01'
+    RefDate = JULDAY(1,1,1981,0,0)	; should be ref from 0 UTC
+    dtime = dtime + secs_from_base
+    dts = RefDate + dtime/86400.
+  endelse
+        
+  varid = ncdf_varid(ncid, 'SST')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, obsval
+    obsval=float(obsval)        ;ensure obsval is a floating point array
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    pts = where(obsval eq FillValue, count)
+    if count gt 0 then obsval(pts) = rmdi
+  endif else begin
+    varid = ncdf_varid(ncid, 'sea_surface_temperature')
+    ncdf_varget, ncid, varid, obsval
+    obsval=float(obsval)	;ensure obsval is a floating point array
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    ncdf_attget, ncid, varid, 'add_offset', Offset
+    ncdf_attget, ncid, varid, 'scale_factor', Scale
+    pts = where(obsval ne FillValue, count)
+    if count gt 0 then obsval(pts) = Offset + (obsval(pts) *Scale)
+    pts = where(obsval eq FillValue, count)
+    if count gt 0 then obsval(pts) = rmdi
+  endelse
+
+  varid = ncdf_varid(ncid, 'SST_Hx')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, modval
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    pts = where(modval eq FillValue, count)
+    if count gt 0 then modval(pts) = rmdi
+  endif
+      
+  varid = ncdf_varid(ncid, 'SST_QC')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, bytQC
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    QC(*) = 0.
+    pts = where(bytQC eq FillValue, count)
+    if count gt 0 then QC(pts) = rmdi
+    pts = where(bytQC ne 48, count)
+    if count gt 0 then QC(pts) = bytQC(pts)-48
+  endif else begin
+    varid = ncdf_varid(ncid, 'confidence_flag')
+    ncdf_varget, ncid, varid, bytQC
+    QC = float(bytQC)
+  endelse
+      
+  varid = ncdf_varid(ncid, 'SST_DATA_SOURCE')
+  if varid ne -1 then ncdf_varget, ncid, varid, obstyp $
+  else begin
+    varid = ncdf_varid(ncid, 'data_source')
+    if varid ne -1 then ncdf_varget, ncid, varid, obstyp
+  endelse
+
+  varid = ncdf_varid(ncid, 'callsign')
+  if varid ne -1 then begin 
+  	ncdf_varget, ncid, varid, callsign
+        tmp=strtrim(string(obstyp),2)+' '+strtrim(string(callsign),2)
+        obstyp=tmp
+  endif else begin
+   varid = ncdf_varid(ncid, 'SST_CALL_SIGN')
+   if varid ne -1 then begin 
+      ncdf_varget, ncid, varid, callsign
+        tmp=strtrim(string(obstyp),2)+' '+strtrim(string(callsign),2)
+        obstyp=tmp
+   endif
+  endelse
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsa
+  
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsa
+      
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    ObsSST = [obsval]
+    ModSST = [modval]
+    SSTQC = [QC]
+    Dates = [dts]
+    Types = [obstyp]
+    iobs = [iobsa]
+    jobs = [jobsa]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    ObsSST = [ObsSST, obsval]
+    ModSST = [ModSST, modval]
+    SSTQC = [SSTQC, QC]
+    Dates = [Dates, dts]    
+    Types = [Types, obstyp]
+    iobs = [iobs, iobsa]
+    jobs = [jobs, jobsa]       
+  endelse      
+
+  ifile2=ifile2+1
+  endif
+  ncdf_close, ncid
+
+  endif
+
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+END
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/python/increments_gen.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/python/increments_gen.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/python/increments_gen.py	(revision 8732)
@@ -0,0 +1,93 @@
+'''
+Generate a test increments file
+and the SlaReference file
+
+Requires coordinates and depth file
+
+D. J. Lea   Sep 2014
+'''
+
+import netCDF4
+import numpy as np
+
+# example files to get lon and lat
+exdir='/hpc/data/nwp/ofrd/frld/FORCING/ORCA2_LIM_nemo_v3.6'
+exfile1='coordinates.nc'
+
+infile1=exdir+'/'+exfile1
+fileid=netCDF4.Dataset(infile1, mode='r')
+nav_lon=fileid.variables['nav_lon'][:,:]
+nav_lat=fileid.variables['nav_lat'][:,:]
+fileid.close
+
+print np.shape(nav_lon)
+
+exfile2='data_1m_potential_temperature_nomask.nc'
+infile2=exdir+'/'+exfile2
+fileid=netCDF4.Dataset(infile2, mode='r')
+nav_lev=fileid.variables['depth'][:]
+fileid.close()
+
+nshp=np.shape(nav_lon)
+ny=nshp[0]
+nx=nshp[1]
+nz=np.size(nav_lev)
+nt=1
+
+#create a new file
+outdir='.'
+outfile='assim_background_increments_test.nc'
+
+print "creating: ",outfile
+ncfile=netCDF4.Dataset(outdir+'/'+outfile, mode='w', format='NETCDF3_CLASSIC')
+ncfile.createDimension('x',nx)
+ncfile.createDimension('y',ny)
+ncfile.createDimension('z',nz)
+ncfile.createDimension('t',size=0)
+ncnav_lat = ncfile.createVariable('nav_lat','f4',('y','x'))
+ncnav_lat[:,:]=nav_lat
+ncnav_lon = ncfile.createVariable('nav_lon','f4',('y','x'))
+ncnav_lon[:,:]=nav_lon
+ncnav_lev = ncfile.createVariable('nav_lev','f4',('z'))
+ncnav_lev[:]=nav_lev
+ncvar = ncfile.createVariable('bckineta','f8',('t','y','x'))
+ncvar[0,:,:]=0.1
+ncvar = ncfile.createVariable('bckins','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckint','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckinu','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckinv','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckinseaice','f8',('t','y','x'))
+ncvar[0,:,:]=0.1
+ncvar = ncfile.createVariable('bckinsshobias','f8',('t','y','x'))
+ncvar[0,:,:]=0.1
+ncvar = ncfile.createVariable('time_counter','f8',('t'))
+ncvar[0]=0
+ncvar = ncfile.createVariable('time','f8')
+ncvar[:]=10101
+ncvar = ncfile.createVariable('z_inc_dateb','f8')
+ncvar[:]=10101
+ncvar = ncfile.createVariable('z_inc_datef','f8')
+ncvar[:]=10102
+
+
+ncfile.close()
+
+#create sla reference file
+outfile='slaReferenceLevel_test.nc'
+
+print "creating: ",outfile
+ncfile=netCDF4.Dataset(outdir+'/'+outfile, mode='w', format='NETCDF3_CLASSIC')
+ncfile.createDimension('x',nx)
+ncfile.createDimension('y',ny)
+ncnav_lat = ncfile.createVariable('nav_lat','f4',('y','x'))
+ncnav_lat[:,:]=nav_lat
+ncnav_lon = ncfile.createVariable('nav_lon','f4',('y','x'))
+ncnav_lon[:,:]=nav_lon
+ncvar = ncfile.createVariable('sossheig','f4',('y','x'),fill_value=1e20)
+ncvar[:,:]=0.01
+
+ncfile.close()
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/c4comb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/c4comb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/c4comb.F90	(revision 8732)
@@ -0,0 +1,702 @@
+PROGRAM c4comb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM c4comb **
+   !!
+   !!  ** Purpose : Combine MPI decomposed class4 files into one file
+   !!
+   !!  ** Method  : Use of utilities from obs_utils, ooo_utils.
+   !!
+   !!  ** Action  : 
+   !!
+   !!   Usage:
+   !!     c4comb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!----------------------------------------------------------------------
+   USE netcdf
+   USE obs_const
+   USE obs_utils
+   USE ooo_utils, ONLY: date_format, obfilldbl
+   USE toolspar_kind
+   IMPLICIT NONE
+   !! Command line setup
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs,    & !: number of command line arguments
+            & ia,       & !: argument loop index
+            & ninfiles    !: number of input files
+   !! Routine arguments
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !! Routine variables
+   CHARACTER(len=80) :: cpname
+   INTEGER,PARAMETER :: nstr=8, n128=128
+   INTEGER           ::    ncid,   & !: netcdf file id
+                        &  dimid,  & !: netcdf dimension id
+                        &  dpdim,  & !: netcdf dimension ids
+                        &  fcdim,  &
+                        &  vrdim,  &
+                        &  obdim,  &
+                        &  stdim,  &
+                        &  sxdim,  &
+                        &  fdvid,  & !: netcdf variable ids
+                        &  lonid,  &
+                        &  latid,  &
+                        &  depid,  &
+                        &  varid,  &
+                        &  unitid, &
+                        &  obvid,  &
+                        &  fcvid,  &
+                        &  prvid,  &
+                        &  clvid,  &
+                        &  dm2id,  &
+                        &  dm1id,  &
+                        &  mdtid,  &
+                        &  altid,  &
+                        &  qcvid,  &
+                        &  jdvid,  &
+                        &  mjdid,  &
+                        &  typid,  &
+                        &  idvid,  &
+                        &  ndeps,  & !: number depths
+                        &  nfcst,  & !: number forecast
+                        &  nvars,  & !: number variables
+                        &  nobs,   & !: number obs
+                        &  sdeps,  &
+                        &  sobs,   &
+                        &  l_dex,  &
+                        &  u_dex
+
+   INTEGER                   :: iob, idep, istat
+   INTEGER, DIMENSION(2)     :: dim2a, dim2b, dim2c, dim2d
+   INTEGER, DIMENSION(3)     :: dim3a
+   INTEGER, DIMENSION(4)     :: dim4a
+   INTEGER,  ALLOCATABLE, DIMENSION(:)           :: fcday
+   REAL(wp), ALLOCATABLE, DIMENSION(:)           :: modjd
+   !: Global Attributes
+   CHARACTER(len=40)                             :: nam_str, &
+                                                 & version,  &
+                                                 & contact,  &
+                                                 & sys_str,  &
+                                                 & cfg_str,  &
+                                                 & ins_str,  &
+                                                 & val_str,  &
+                                                 & dat_str,  &
+                                                 & obs_str
+   !: Variable Attributes
+   CHARACTER(len=100)                            :: lon_units, &
+                                                 &  lat_units, &
+                                                 &  dep_units, &
+                                                 &  jul_units, &
+                                                 &  mjd_units, &
+                                                 &  fcd_units, &
+                                                 &  lead_comment, &
+                                                 &  fcst_comment, &
+                                                 &  per_comment,  &
+                                                 &  cli_comment,  &
+                                                 &  dm2_comment,  &
+                                                 &  dm1_comment
+   CHARACTER(len=128)                            :: qc_comment,   &
+                                                 &  qc_flag_meaning
+   INTEGER, DIMENSION(2)                         :: qc_flag_value
+
+   !: Global Arrays
+   REAL(wp), ALLOCATABLE, DIMENSION(:)           :: g_lam, &
+                                                 &  g_phi, & 
+                                                 &  gjuld 
+   CHARACTER(len=n128),ALLOCATABLE,DIMENSION(:)  :: gtype
+   CHARACTER(len=nstr),ALLOCATABLE,DIMENSION(:)  ::        &
+                                                 &  g_id,  & 
+                                                 &  gvnam, & 
+                                                 &  gunit
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)         :: g_dep
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)       :: g3dob, &
+                                                 &  g3dcl, &
+                                                 &  g3mdt, &
+                                                 &  g3alt, &
+                                                 &  g3dm2, &
+                                                 &  g3dm1
+   INTEGER(ik),  ALLOCATABLE, DIMENSION(:,:,:)   :: g3dqc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)     :: g3dmc, &
+                                                 &  g3dpr
+   !: Small Arrays  
+   REAL(wp), ALLOCATABLE, DIMENSION(:)       ::     s_lam, &
+                                                 &  s_phi, & 
+                                                 &  sjuld
+
+   CHARACTER(len=n128),ALLOCATABLE,DIMENSION(:) ::  stype
+   CHARACTER(len=nstr),ALLOCATABLE,DIMENSION(:) ::        &
+                                                 &  s_id 
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)        :: s_dep
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)      :: s3dob, &
+                                                &  s3dcl, &
+                                                &  s3mdt, &
+                                                &  s3alt, &
+                                                &  s3dm2, &
+                                                &  s3dm1
+   INTEGER(ik),  ALLOCATABLE, DIMENSION(:,:,:)  :: s3dqc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)    :: s3dmc, &
+                                                &  s3dpr
+
+   !: File creation logical
+   LOGICAL                                     :: ln_cre
+
+   !: Optional variable logicals
+   LOGICAL                                     :: ln_init, &
+                                                & ln_mdt,  &
+                                                & ln_altbias, &
+                                                & ln_best
+   !! Command name
+   cpname='c4comb.exe'
+
+   !! Process command line
+   nargs = IARGC()
+   IF (nargs /= 2) THEN
+      WRITE(*, *) "Usage: c4comb.exe outputfile inputfile1 inputfile2 ..."
+      CALL abort()
+   END IF
+   CALL GETARG(1, cdoutfile)
+
+   !! Process input files
+   !! Set output file creation to off
+   ln_cre = .false.
+
+   !! Turn optional variables off
+   ln_init = .false.
+   ln_best = .false.
+   ln_altbias = .false.
+   ln_mdt = .false.
+
+   !! Compute size of output file
+   nobs = 0
+   ndeps= 0
+   ALLOCATE( cdinfile( nargs - 1 ) )
+   ninfiles = nargs - 1
+   DO ia = 1, ninfiles
+      CALL GETARG(ia+1, cdinfile(ia))
+      WRITE(*,*) "Opening : ", TRIM(cdinfile(ia))
+      !! Open Netcdf file
+      istat = nf90_open(TRIM(cdinfile(ia)),nf90_nowrite,ncid)
+      IF (istat == nf90_noerr) THEN
+         !! Turn output file creation on
+         ln_cre = .true.
+         !! Get Dimensions
+         CALL chkerr( nf90_inq_dimid(ncid, 'numobs',  dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sobs  ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numdeps', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sdeps ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numfcsts',dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nfcst ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numvars', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nvars ),  cpname, __LINE__ )
+         !! Close Netcdf file
+         CALL chkerr( nf90_close(ncid), cpname, __LINE__ )
+         !! Report on file contents
+         WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia))
+         WRITE(*,'(A,I9,A)')'has', sobs, ' observations'
+         !! Increment size
+         nobs  = nobs + sobs       !: Accumulate number of profiles
+         ndeps = MAX(ndeps, sdeps) !: Define maximum number of levels needed
+      END IF ! istat
+   END DO
+
+   !! Allocate global arrays
+   ALLOCATE( g_phi(nobs),                      &
+          &  g_lam(nobs),                      &
+          &  g_dep(ndeps, nobs),               &
+          &  g3dob(ndeps,        nvars, nobs), &
+          &  g3dmc(ndeps, nfcst, nvars, nobs), &
+          &  g3dpr(ndeps, nfcst, nvars, nobs), &
+          &  g3dcl(ndeps,        nvars, nobs), &
+          &  g3dm2(ndeps,        nvars, nobs), &
+          &  g3dm1(ndeps,        nvars, nobs), &
+          &  g3mdt(ndeps,        nvars, nobs), &
+          &  g3alt(ndeps,        nvars, nobs), &
+          &  g3dqc(ndeps,        nvars, nobs), &
+          &  gjuld(nobs),                      &
+          &  gtype(nobs),                      &
+          &  g_id(nobs),                       &
+          &  gvnam(nvars),                     &
+          &  gunit(nvars) )
+   ALLOCATE(fcday(nfcst), modjd(nfcst))
+
+   !! Fill with missing data value
+   g_dep(:,:)     = 99999.
+   g3dmc(:,:,:,:) = 99999.
+   g3dpr(:,:,:,:) = 99999.
+   g3dob(:,:,:)   = 99999.
+   g3dcl(:,:,:)   = 99999.
+   g3dm2(:,:,:)   = 99999.
+   g3dm1(:,:,:)   = 99999.
+   g3mdt(:,:,:)   = 99999.
+   g3alt(:,:,:)   = 99999.
+   g3dqc(:,:,:)   = NF90_FILL_SHORT
+
+   !! Read in each file
+   !  initialise global matrix indices
+   l_dex = 0
+   u_dex = 0
+
+   !! initialise Global attribute strings
+   nam_str = ''
+   version = ''
+   contact = ''
+   sys_str = ''
+   cfg_str = ''
+   ins_str = ''
+   val_str = ''
+   dat_str = ''
+   obs_str = ''
+
+   !! initialise Variable attribute strings
+   fcd_units = ''
+   lon_units = ''
+   lat_units = ''
+   dep_units = ''
+   jul_units = ''
+   mjd_units = ''
+   lead_comment = ''
+   fcst_comment = ''
+   per_comment  = ''
+   cli_comment  = ''
+   dm2_comment  = ''
+   dm1_comment  = ''
+   qc_comment  = ''
+   qc_flag_meaning  = ''
+
+   DO ia = 1, ninfiles
+      WRITE(*,*) "Opening : ", TRIM(cdinfile(ia))
+      !! Open Netcdf file
+      istat = nf90_open(TRIM(cdinfile(ia)),nf90_nowrite,ncid)
+      IF (istat == nf90_noerr) THEN
+         !! Get Global Attributes
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'title',         nam_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'version',       version),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'contact',       contact),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'obs_type',      obs_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'system',        sys_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'configuration', cfg_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'institution',   ins_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'validity_time', val_str),cpname, __LINE__)
+         !! Get Dimensions of single file
+         CALL chkerr( nf90_inq_dimid(ncid, 'numdeps', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sdeps ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numfcsts',dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nfcst ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numvars', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nvars ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numobs',  dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sobs  ),  cpname, __LINE__ )
+         !! Check for Optional variables in first file
+         IF (ia == 1) THEN
+            !! Best estimate
+            istat = nf90_inq_varid(ncid,'best_estimate',dm2id)
+            IF (istat == nf90_noerr) THEN
+               ln_best = .TRUE.
+            ENDIF 
+            !! nrt_analysis
+            istat = nf90_inq_varid(ncid,'nrt_analysis',dm1id)
+            IF (istat == nf90_noerr) THEN
+               ln_init = .TRUE.
+            ENDIF 
+            !! Mean Dynamic Topography
+            istat = nf90_inq_varid(ncid,'mdt_reference',mdtid)
+            IF (istat == nf90_noerr) THEN
+               ln_mdt = .TRUE.
+            ENDIF 
+            !! Altimeter bias
+            istat = nf90_inq_varid(ncid,'altimeter_bias',altid)
+            IF (istat == nf90_noerr) THEN
+               ln_altbias = .TRUE.
+            ENDIF 
+         END IF
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", sobs, " observations"
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", sdeps, " depths"
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", nfcst, " forecasts"
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", nvars, " vars"
+         !! Read Variables
+         IF (sobs /= 0) THEN
+            !! Get Variable ids
+            CALL chkerr(nf90_inq_varid(ncid,'leadtime', fdvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'longitude',   lonid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'latitude',    latid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'depth',       depid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'varname',     varid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'unitname',   unitid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'observation', obvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'forecast',    fcvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'persistence', prvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'climatology', clvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'qc',          qcvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'juld',        jdvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'modeljuld',   mjdid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'type',        typid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'id',          idvid) ,cpname, __LINE__ )
+            !! Get variable attributes
+            CALL chkerr(nf90_get_att(ncid, fdvid, 'units', fcd_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, lonid, 'units', lon_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, latid, 'units', lat_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, depid, 'units', dep_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, jdvid, 'units', jul_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, mjdid, 'units', mjd_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, fcvid, 'comment', fcst_comment) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, prvid, 'comment', per_comment)  ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, clvid, 'comment', cli_comment)  ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, fdvid, 'comment', lead_comment) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, qcvid, 'comment', qc_comment) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, qcvid, 'flag_value', qc_flag_value) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, qcvid, 'flag_meaning', qc_flag_meaning) ,cpname, __LINE__ )
+            !! Optional variables
+            IF (ln_best) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'best_estimate',dm2id) ,cpname, __LINE__ )
+               CALL chkerr(nf90_get_att(ncid, dm2id, 'comment', dm2_comment)  ,cpname, __LINE__ )
+            ENDIF
+            IF (ln_init) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'nrt_analysis', dm1id) ,cpname, __LINE__ )
+               CALL chkerr(nf90_get_att(ncid, dm1id, 'comment', dm1_comment)  ,cpname, __LINE__ )
+            ENDIF
+            IF (ln_mdt) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'mdt_reference', mdtid) ,cpname, __LINE__ )
+            ENDIF
+            IF (ln_altbias) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'altimeter_bias', altid) ,cpname, __LINE__ )
+            ENDIF
+
+            !! Allocate small arrays
+            ALLOCATE( s_lam(sobs), s_phi(sobs),  s_dep(sdeps, sobs),               &
+                   &  s3dob(sdeps,        nvars, sobs), & !: observations 
+                   &  s3dmc(sdeps, nfcst, nvars, sobs), & !: model data
+                   &  s3dpr(sdeps, nfcst, nvars, sobs), & !: persistence
+                   &  s3dcl(sdeps,        nvars, sobs), & !: climatology
+                   &  s3dm2(sdeps,        nvars, sobs), & !: best estimate
+                   &  s3dm1(sdeps,        nvars, sobs), & !: nrt_analysis
+                   &  s3mdt(sdeps,        nvars, sobs), & !: mdt
+                   &  s3alt(sdeps,        nvars, sobs), & !: altbias
+                   &  s3dqc(sdeps,        nvars, sobs), & !: QC
+                   &  sjuld(sobs), stype( sobs),  &
+                   &  s_id(sobs) )
+            !! Fill with missing data value
+            s3dmc(:,:,:,:) = 99999.
+            s3dpr(:,:,:,:) = 99999.
+            s3dob(:,:,:)   = 99999.
+            s3dcl(:,:,:)   = 99999.
+            s3dm2(:,:,:)   = 99999.
+            s3dm1(:,:,:)   = 99999.
+            s3mdt(:,:,:)   = 99999.
+            s3alt(:,:,:)   = 99999.
+            s3dqc(:,:,:)   = NF90_FILL_SHORT
+
+            !! Read variables into small arrays
+            CALL chkerr( nf90_get_var(ncid, fdvid, fcday), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, lonid, s_lam), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, latid, s_phi), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, depid, s_dep), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, obvid, s3dob), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, fcvid, s3dmc), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, prvid, s3dpr), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, clvid, s3dcl), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, qcvid, s3dqc), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, jdvid, sjuld), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, mjdid, modjd), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, typid, stype), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, idvid, s_id),  cpname, __LINE__ )       
+            !! Read unitname and varname into global arrays
+            CALL chkerr( nf90_get_var(ncid, varid, gvnam), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, unitid,gunit), cpname, __LINE__ )       
+            !! Optional variables read
+            IF (ln_best) THEN
+               CALL chkerr( nf90_get_var(ncid, dm2id, s3dm2), cpname, __LINE__ )       
+            ENDIF
+            IF (ln_init) THEN
+               CALL chkerr( nf90_get_var(ncid, dm1id, s3dm1), cpname, __LINE__ )       
+            ENDIF
+            IF (ln_mdt) THEN
+               CALL chkerr( nf90_get_var(ncid, mdtid, s3mdt), cpname, __LINE__ )       
+            ENDIF
+            IF (ln_altbias) THEN
+               CALL chkerr( nf90_get_var(ncid, altid, s3alt), cpname, __LINE__ )       
+            ENDIF
+
+            !! Fill Global arrays
+            !  increment numobs indices
+            l_dex = u_dex + 1
+            u_dex = l_dex + sobs -1
+
+            g_lam(l_dex:u_dex)                          = s_lam(:)
+            g_phi(l_dex:u_dex)                          = s_phi(:)
+            g_dep(1:sdeps,  l_dex:u_dex)                = s_dep(1:sdeps,:)
+            g3dob(1:sdeps,1:nvars,l_dex:u_dex)          = s3dob(1:sdeps,1:nvars,:)
+            g3dmc(1:sdeps,1:nfcst,1:nvars,l_dex:u_dex)  = s3dmc(1:sdeps,1:nfcst,1:nvars,:)
+            g3dpr(1:sdeps,1:nfcst,1:nvars,l_dex:u_dex)  = s3dpr(1:sdeps,1:nfcst,1:nvars,:)
+            g3dcl(1:sdeps,1:nvars,l_dex:u_dex)          = s3dcl(1:sdeps,1:nvars,:)
+            g3dm2(1:sdeps,1:nvars,l_dex:u_dex)          = s3dm2(1:sdeps,1:nvars,:)
+            g3dm1(1:sdeps,1:nvars,l_dex:u_dex)          = s3dm1(1:sdeps,1:nvars,:)
+            g3mdt(1:sdeps,1:nvars,l_dex:u_dex)          = s3mdt(1:sdeps,1:nvars,:)
+            g3alt(1:sdeps,1:nvars,l_dex:u_dex)          = s3alt(1:sdeps,1:nvars,:)
+            g3dqc(1:sdeps,1:nvars,l_dex:u_dex)          = s3dqc(1:sdeps,1:nvars,:)
+            gjuld(l_dex:u_dex)                          = sjuld(:)
+            gtype(l_dex:u_dex)                          = stype(:)
+            g_id(l_dex:u_dex)                           = s_id(:)
+
+            !! Deallocate small array
+            DEALLOCATE( s_lam, s_phi, s_dep, s3dob, s3dmc, s3dpr, s3dcl, s3dqc, s3dm2, s3dm1, s3mdt, s3alt, sjuld, stype, s_id)
+         ENDIF ! sobs    
+         !! Close Netcdf file
+         CALL chkerr( nf90_close(ncid), cpname, __LINE__ )
+      END IF ! istat
+   END DO
+
+   !! Create Output file
+   IF (ln_cre) THEN
+      WRITE(*,*) 'Create the output file, ',trim(cdoutfile)
+      CALL chkerr( nf90_create(trim(cdoutfile),nf90_clobber,ncid),      cpname, __LINE__ )
+      !! Put Global Attributes
+      CALL date_format(dat_str) 
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'title',          trim(nam_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'version',        trim(version)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'creation_date',  trim(dat_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'contact',        trim(contact)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'obs_type',       trim(obs_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'system',         trim(sys_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'configuration',  trim(cfg_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'institution',    trim(ins_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'validity_time',  trim(val_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'best_estimate_description', &
+                              &       'analysis produced 2 days behind real time'),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'time_interp', 'daily average fields'),cpname, __LINE__)
+      WRITE(*,*) 'Succesfully put global attributes '
+
+      !! Define Dimensions
+      CALL chkerr( nf90_def_dim(ncid, 'numdeps',          ndeps, dpdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'numfcsts',         nfcst, fcdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'numvars',          nvars, vrdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'numobs',           nobs,  obdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'string_length8',   nstr,  stdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'string_length128', n128,  sxdim) ,cpname, __LINE__ )
+      WRITE(*,*) 'Succesfully defined dimensions'
+
+      !! Define possible dimension permutations
+      ! 2d
+      dim2a(:) = (/ dpdim, obdim /) !: (/ ndeps, nobs  /) 
+      dim2b(:) = (/ stdim, obdim /) !: (/ nstr,  nobs  /)
+      dim2c(:) = (/ stdim, vrdim /) !: (/ nstr,  nvars /)
+      dim2d(:) = (/ sxdim, obdim /) !: (/ nstr,  nobs  /)
+      ! 3d
+      dim3a(:) = (/ dpdim, vrdim, obdim/) !: (/ ndeps, nvars, nobs /)
+      ! 4d
+      dim4a(:) = (/ dpdim, fcdim, vrdim, obdim /) !: (/ ndeps, nfcst, nvars, nobs /)
+
+
+      !! Create the variables
+      !  Forecast day
+      CALL chkerr( nf90_def_var(ncid, 'leadtime',  nf90_double, fcdim, fdvid)          ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fdvid, 'long_name', 'Model forecast day offset') ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fdvid, 'units',     trim(fcd_units))             ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fdvid, 'comment',   trim(lead_comment))          ,cpname, __LINE__ )
+      WRITE(*,*) 'leadtime created'
+      !  longitude
+      CALL chkerr( nf90_def_var(ncid, 'longitude',    nf90_float, obdim, lonid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, lonid, 'long_name', 'Longitudes')                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, lonid, 'units',     trim(lon_units))             ,cpname, __LINE__ )
+      WRITE(*,*) 'lon created'
+      !  latitude
+      CALL chkerr( nf90_def_var(ncid, 'latitude',     nf90_float, obdim, latid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, latid, 'long_name', 'Latitudes')                 ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, latid, 'units',     trim(lat_units))             ,cpname, __LINE__ )
+      WRITE(*,*) 'lat created'
+      !  depth
+      CALL chkerr( nf90_def_var(ncid, 'depth',        nf90_float, dim2a, depid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, depid, 'long_name', 'Depths')                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, depid, 'units',     trim(dep_units))             ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, depid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      WRITE(*,*) 'dep created'
+      !  varname
+      CALL chkerr( nf90_def_var(ncid, 'varname',      nf90_char,  dim2c, varid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, varid, 'long_name', 'Variable name')             ,cpname, __LINE__ )
+      WRITE(*,*) 'varname created'
+      !  unitname
+      CALL chkerr( nf90_def_var(ncid, 'unitname',     nf90_char,  dim2c, unitid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid,  unitid, 'long_name', 'Unit name')              ,cpname, __LINE__ )
+      WRITE(*,*) 'unitname created'
+      !  obs
+      CALL chkerr( nf90_def_var(ncid, 'observation', nf90_float,  dim3a,  obvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, obvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid,  obvid, 'long_name', 'Observation value')         ,cpname, __LINE__ )
+      WRITE(*,*) 'obs created'
+      !  forecast
+      CALL chkerr( nf90_def_var(ncid, 'forecast',    nf90_float,  dim4a,  fcvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fcvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fcvid, 'long_name', 'Model forecast counterpart of obs. value')   ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fcvid, 'comment',   trim(fcst_comment))           ,cpname, __LINE__ )
+      WRITE(*,*) 'forecast created'
+      !  persistence
+      CALL chkerr( nf90_def_var(ncid, 'persistence', nf90_float,  dim4a,  prvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, prvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, prvid, 'long_name', 'Model persistence counterpart of obs. value'),cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, prvid, 'comment',   trim(per_comment))            ,cpname, __LINE__ )
+      WRITE(*,*) 'persistence created'
+      !  clim
+      CALL chkerr( nf90_def_var(ncid, 'climatology', nf90_float,  dim3a, clvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, clvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, clvid, 'long_name', 'Climatological value')       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, clvid, 'comment',   trim(cli_comment))            ,cpname, __LINE__ )
+      WRITE(*,*) 'clim created'
+      IF (ln_best) THEN
+         !  daym2
+         CALL chkerr( nf90_def_var(ncid, 'best_estimate', nf90_float,  dim3a, dm2id)    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm2id, '_FillValue',obfillflt)                 ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm2id, 'long_name', 'Best estimate')           ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm2id, 'comment',   trim(dm2_comment))         ,cpname, __LINE__ )
+         WRITE(*,*) 'daym2 created'
+      ENDIF
+      IF (ln_init) THEN
+         !  daym1
+         CALL chkerr( nf90_def_var(ncid, 'nrt_analysis', nf90_float,  dim3a, dm1id)        ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm1id, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm1id, 'long_name', 'Near real time analysis')    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm1id, 'comment',   trim(dm1_comment))            ,cpname, __LINE__ )
+         WRITE(*,*) 'daym1 created'
+      ENDIF
+      IF (ln_mdt) THEN
+         !  mdt
+         CALL chkerr( nf90_def_var(ncid, 'mdt_reference', nf90_float,  dim3a, mdtid)      ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, mdtid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, mdtid, 'long_name', 'Mean dynamic topography')    ,cpname, __LINE__ )
+         WRITE(*,*) 'mdt created'
+      ENDIF
+      IF (ln_altbias) THEN
+         !  altbias
+         CALL chkerr( nf90_def_var(ncid, 'altimeter_bias', nf90_float,  dim3a, altid)     ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, altid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, altid, 'long_name', 'Altimeter bias')             ,cpname, __LINE__ )
+         WRITE(*,*) 'altbias created'
+      ENDIF
+      !  qc
+      CALL chkerr( nf90_def_var(ncid, 'qc',          nf90_short,  dim3a, qcvid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, '_FillValue', NF90_FILL_SHORT)             ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'long_name', 'Quality flags')              ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'flag_value', qc_flag_value)               ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'flag_meaning', qc_flag_meaning)           ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'comment', qc_comment)                     ,cpname, __LINE__ )
+      WRITE(*,*) 'qc created'
+      !  juld
+      CALL chkerr( nf90_def_var(ncid, 'juld',       nf90_double,  obdim, jdvid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, jdvid, '_FillValue',99999.)                       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, jdvid, 'long_name', 'Observation time in Julian days'),cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, jdvid, 'units',     trim(jul_units))              ,cpname, __LINE__ )
+      WRITE(*,*) 'juld created'
+      !  modeljuld 
+      CALL chkerr( nf90_def_var(ncid, 'modeljuld',  nf90_double,  fcdim, mjdid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, mjdid, 'long_name', 'Model field date in Julian days'),cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, mjdid, 'units',     trim(mjd_units))              ,cpname, __LINE__ )
+      WRITE(*,*) 'modeljuld created'
+      !  type
+      CALL chkerr( nf90_def_var(ncid, 'type',     nf90_char,      dim2d, typid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, typid, 'long_name', 'Observation type')           ,cpname, __LINE__ )
+      WRITE(*,*) 'type created'
+      !  id
+      CALL chkerr( nf90_def_var(ncid, 'id',       nf90_char,      dim2b, idvid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, idvid, 'long_name', 'Observation id')             ,cpname, __LINE__ )
+      WRITE(*,*) 'id created'
+      ! Close Netcdf file 
+      CALL chkerr( nf90_close(ncid) ,cpname, __LINE__ )  
+      !! Fill in the variables
+      CALL chkerr( nf90_open(trim(cdoutfile),nf90_write,ncid),                   cpname, __LINE__ )
+      WRITE(*,*) 'Create the variables ',trim(cdoutfile)
+      !  Forecast day
+      CALL chkerr( nf90_inq_varid(ncid, 'leadtime', fdvid)                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, fdvid, fcday) ,cpname, __LINE__ )
+      WRITE(*,*) 'forecast day put'
+      !  longitude
+      CALL chkerr( nf90_inq_varid(ncid, 'longitude', lonid)                  ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, lonid, g_lam) ,cpname, __LINE__ )
+      WRITE(*,*) 'lon put'
+      !  latitude
+      CALL chkerr( nf90_inq_varid(ncid, 'latitude', latid)                   ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, latid, g_phi) ,cpname, __LINE__ )
+      WRITE(*,*) 'lat put'
+      !  depth
+      CALL chkerr( nf90_inq_varid(ncid, 'depth',depid)                       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, depid, g_dep) ,cpname, __LINE__ )
+      WRITE(*,*) 'dep put'
+      ! varname
+      CALL chkerr( nf90_inq_varid(ncid, 'varname', varid)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, varid, gvnam,(/1,1/), (/nstr,nvars/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'var put'
+      ! unitname
+      CALL chkerr( nf90_inq_varid(ncid, 'unitname',unitid)                   ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, unitid, gunit,(/1,1/),(/nstr,nvars/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'unitnam put'
+      ! obs
+      CALL chkerr( nf90_inq_varid(ncid, 'observation', obvid)                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, obvid,g3dob ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'obs put'
+      ! clim
+      CALL chkerr( nf90_inq_varid(ncid, 'climatology', clvid)                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, clvid,g3dcl ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'cli put'
+      IF (ln_best) THEN
+         ! daym2
+         CALL chkerr( nf90_inq_varid(ncid, 'best_estimate',dm2id)            ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, dm2id,g3dm2 ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'daym2 put'
+      ENDIF
+      IF (ln_init) THEN 
+         ! daym1
+         CALL chkerr( nf90_inq_varid(ncid, 'nrt_analysis',dm1id)              ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, dm1id,g3dm1 ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'daym1 put'
+      ENDIF
+      IF (ln_mdt) THEN 
+         ! mdt
+         CALL chkerr( nf90_inq_varid(ncid, 'mdt_reference', mdtid)              ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, mdtid, g3mdt ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'mdt put'
+      ENDIF
+      IF (ln_altbias) THEN 
+         ! altbias
+         CALL chkerr( nf90_inq_varid(ncid, 'altimeter_bias', altid)             ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, altid, g3alt ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'altbias put'
+      ENDIF
+      ! persistence
+      CALL chkerr( nf90_inq_varid(ncid, 'persistence',prvid)                                 ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, prvid, g3dpr, (/1,1,1,1/) ,(/ ndeps,nfcst,nvars,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'per put'
+      ! forecast
+      CALL chkerr( nf90_inq_varid(ncid, 'forecast',fcvid)                                      ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, fcvid, g3dmc, (/1,1,1,1/), (/ ndeps,nfcst,nvars,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'fcst put'
+      ! qc
+      CALL chkerr( nf90_inq_varid(ncid, 'qc', qcvid)                         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, qcvid,g3dqc ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'qc put'
+      ! juld
+      CALL chkerr( nf90_inq_varid(ncid, 'juld',jdvid)                        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, jdvid, gjuld) ,cpname, __LINE__ )   
+      WRITE(*,*) 'juld put'
+      ! modeljuld
+      CALL chkerr( nf90_inq_varid(ncid, 'modeljuld', mjdid)                  ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, mjdid, modjd,(/1/),(/nfcst/))          ,cpname, __LINE__ )   
+      WRITE(*,*) 'modjuld put'
+      ! type
+      CALL chkerr( nf90_inq_varid(ncid, 'type', typid)                       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, typid, gtype,(/1,1/) , (/n128,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'type put'
+      ! id
+      CALL chkerr( nf90_inq_varid(ncid, 'id', idvid)                         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, idvid, g_id,(/1,1/)  , (/nstr,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'id put'
+      ! Close netcdf file
+      CALL chkerr( nf90_close(ncid),                                          cpname, __LINE__ )
+   END IF ! ln_cre
+   !! Deallocate Global arrays
+   DEALLOCATE( g_lam, g_phi, g_dep, g3dob, g3dmc, g3dpr, g3dcl, g3dm2, g3dm1, g3mdt, g3alt, g3dqc, gjuld, gtype, g_id, gvnam, gunit)
+   DEALLOCATE( fcday, modjd )
+
+   !! Deallocate input argument list
+   DEALLOCATE(cdinfile)
+END PROGRAM c4comb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90	(revision 8732)
@@ -0,0 +1,131 @@
+MODULE convmerge
+
+   USE toolspar_kind
+   USE obs_fbm
+   USE obs_utils
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE conv_fbmerge( cdoutfile, nfiles, fbdata )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE conv_fbmerg **
+      !!
+      !!  ** Purpose : Merge all fbfiles into a single fbfile
+      !!
+      !!  ** Method  : Use of utilities from obs_fbm.
+      !!
+      !!  ** Action  :
+      !!
+      !!   Optional :
+      !!     namelist = namobs.in    to select the observation range 
+      !!
+      !!   History :
+      !!        ! 2010 (K. Mogensen) Initial version
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdoutfile                ! Input file.
+      INTEGER :: nfiles                            ! Number of files
+      TYPE(obfbdata), dimension(nfiles) :: fbdata  ! Structure to merge
+      !! * Local variables
+      type(obfbdata) :: fbmerge
+      INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+      INTEGER :: nmaxlev
+      INTEGER :: ia,ij,ii
+      REAL(fbdp), DIMENSION(nfiles) :: djulini, djulend
+      CHARACTER(len=8) :: cl_refdate
+      INTEGER :: irefdate,iyea,imon,iday,ihou,imin,isec
+      ! Namelist variables
+      CHARACTER(len=9) :: cdnamefile='namobs.in'
+      LOGICAL :: lexists 
+      REAL(fbdp) :: dobsini,dobsend
+      NAMELIST/namobs/dobsini,dobsend
+      
+      dobsini = 0.0
+      dobsend = 99991231.235959
+
+      INQUIRE(file=cdnamefile, exist=lexists)
+      IF (lexists) THEN
+         OPEN(10,file=cdnamefile)
+         READ(10,namobs)
+         WRITE(*,namobs)
+         CLOSE(10)
+      ENDIF
+      !
+      ! Count number of data points
+      !
+      nmaxlev = 1
+      ii = 0
+      DO ia = 1,nfiles
+         IF (lexists) THEN
+            cl_refdate=fbdata(ia)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate
+            CALL ddatetoymdhms( dobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(ia), &
+               &           krefdate = irefdate )
+            CALL ddatetoymdhms( dobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(ia), &
+            &           krefdate = irefdate )
+            DO ij = 1, fbdata(ia)%nobs
+               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
+                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
+                  ii = ii + 1
+                  nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
+               ENDIF
+            ENDDO
+         ELSE
+            nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
+            ii = ii + fbdata(ia)%nobs
+         ENDIF
+      ENDDO
+      !
+      ! Merge the input structures into the output structure
+      !
+      ALLOCATE( iset(ii), inum(ii), iindex(ii))
+      ii = 0
+      DO ia = 1,nfiles
+         DO ij = 1, fbdata(ia)%nobs
+            IF (lexists) THEN
+               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
+                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
+                  ii = ii + 1
+                  iset(ii)   = ia
+                  inum(ii)   = ij
+                  iindex(ii) = ii
+               ENDIF
+            ELSE
+               ii = ii + 1
+               iset(ii)   = ia
+               inum(ii)   = ij
+               iindex(ii) = ii
+            ENDIF
+         ENDDO
+      ENDDO
+      WRITE(*,*)'Output number of observations = ',ii
+      WRITE(*,*)'Output number of levels       = ',nmaxlev
+      !
+      ! Prepare fbmerge structure
+      !
+      CALL init_obfbdata( fbmerge )
+      CALL alloc_obfbdata( fbmerge, fbdata(1)%nvar, ii, nmaxlev, &
+         &                 fbdata(1)%nadd, fbdata(1)%next, fbdata(1)%lgrid )
+      CALL merge_obfbdata( nfiles, fbdata, fbmerge, iset, inum, iindex )
+      !
+      ! Write the file
+      !
+      CALL write_obfbdata( TRIM(cdoutfile), fbmerge )
+      !
+      ! Dellocate the data
+      !
+      CALL dealloc_obfbdata( fbmerge )
+
+   END SUBROUTINE conv_fbmerge
+
+#include "ctl_stop.h90"
+
+#include "greg2jul.h90"
+
+!#include "ddatetoymdhms.h90"
+
+END MODULE convmerge
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90	(revision 8732)
@@ -0,0 +1,1025 @@
+MODULE coords
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER     :: nsech = 167
+   CHARACTER(len=20), DIMENSION(nsech)  :: cl_sech = (/ &
+      & 'global              ',  &
+      & 'nstrpac             ',  &
+      & 'sstrpac             ',  &
+      & 'npac                ',  &
+      & 'spac                ',  &
+      & 'trpac               ',  &
+      & 'natl                ',  &
+      & 'satl                ',  &
+      & 'tratl               ',  &
+      & 'nstratl             ',  &
+      & 'sstratl             ',  &
+      & 'neatl               ',  &
+      & 'nwatl               ',  &
+      & 'equa                ',  &
+      & 'nino1               ',  &
+      & 'nino2               ',  &
+      & 'nino12              ',  &
+      & 'nino3               ',  &
+      & 'nino4               ',  &
+      & 'nino34              ',  &
+      & 'ind1                ',  &
+      & 'ind2                ',  &
+      & 'ind3                ',  &
+      & 'eq1                 ',  &
+      & 'eq2                 ',  &
+      & 'eq3                 ',  &
+      & 'eq4                 ',  &
+      & 'neq1                ',  &
+      & 'neq2                ',  &
+      & 'neq3                ',  &
+      & 'neq4                ',  &
+      & 'eqpac               ',  &
+      & 'eqind               ',  &
+      & 'atl1                ',  &
+      & 'atl2                ',  &
+      & 'atl3                ',  &
+      & 'eqatl               ',  &
+      & 'trop                ',  &
+      & 'nxtrp               ',  &
+      & 'sxtrp               ',  &
+      & 'trind               ',  &
+      & 'sind                ',  &
+      & 'nepac               ',  &
+      & 'nwpac               ',  &
+      & 'trepac              ',  &
+      & 'trwpac              ',  &
+      & 'p15n38w             ',  &
+      & 'p12n38w             ',  &
+      & 'p8n38w              ',  &
+      & 'p4n38w              ',  &
+      & 'p0n35w              ',  &
+      & 'p21n23w             ',  &
+      & 'p12n23w             ',  &
+      & 'p4n23w              ',  &
+      & 'p0n23w              ',  &
+      & 'p0n10w              ',  &
+      & 'p0n0w               ',  &
+      & 'p5s10w              ',  &
+      & 'p10s10w             ',  &
+      & 't0n156e             ',  &
+      & 't0n165e             ',  &
+      & 't0n180e             ',  &
+      & 't0n170w             ',  &
+      & 't0n155w             ',  &
+      & 't0n140w             ',  &
+      & 't0n125w             ',  &
+      & 't0n110w             ',  &
+      & 't0n95w              ',  &
+      & 't5n156e             ',  &
+      & 't5s156e             ',  &
+      & 't5n165e             ',  &
+      & 't5n180e             ',  &
+      & 't5n170w             ',  &
+      & 't5n155w             ',  &
+      & 't5n140w             ',  &
+      & 't5n125w             ',  &
+      & 't5n110w             ',  &
+      & 't5n95w              ',  &
+      & 't5s165e             ',  &
+      & 't5s180e             ',  &
+      & 't5s170w             ',  &
+      & 't5s155w             ',  &
+      & 't5s140w             ',  &
+      & 't5s125w             ',  &
+      & 't5s110w             ',  &
+      & 't5s95w              ',  &
+      & 'r8s55e              ',  &
+      & 'r12s55e             ',  &
+      & 'r4s67e              ',  &
+      & 'r8s67e              ',  &
+      & 'r12s67e             ',  &
+      & 'r0n80e              ',  &
+      & 'r4s80e              ',  &
+      & 'r12s80e             ',  &
+      & 'r12n90e             ',  &
+      & 'r8n90e              ',  &
+      & 'r4n90e              ',  &
+      & 'r0n90e              ',  &
+      & 'r5s95e              ',  &
+      & 'r8s95e              ',  &
+      & 'r8s100e             ',  &
+      & 'NE_subtrop_pac      ',  &
+      & 'NW_subtrop_pac      ',  &
+      & 'NE_extratrop_pac    ',  &
+      & 'NW_extratrop_pac    ',  &
+      & 'SE_subtrop_pac      ',  &
+      & 'SW_subtrop_pac      ',  &
+      & 'NE_subtrop_atl      ',  &
+      & 'NW_subtrop_atl      ',  &
+      & 'NE_extratrop_atl    ',  &
+      & 'NW_extratrop_atl    ',  &
+      & 'SE_subtrop_atl      ',  &
+      & 'SW_subtrop_atl      ',  &
+      & 'SE_subtrop_ind      ',  &
+      & 'SW_subtrop_ind      ',  &
+      & 'Southern_ocean_pac  ',  &
+      & 'Southern_ocean_atl  ',  &
+      & 'Southern_ocean_ind  ',  &
+      & 'GLOBAL05            ',  &
+      & 'GLOBAL10            ',  &
+      & 'GLOBAL15            ',  &
+      & 'GLOBAL20            ',  &
+      & 'GLOBAL25            ',  &
+      & 'GLOBAL30            ',  &
+      & 'GLOBAL40            ',  &
+      & 'GLOBAL50            ',  &
+      & 'GLOBAL60            ',  &
+      & 'ARCTIC              ',  &
+      & 'ATL60NA             ',  &
+      & 'ATL50NA             ',  &
+      & 'ATL40NA             ',  &
+      & 'ATL35NA             ',  &
+      & 'ATL30NA             ',  &
+      & 'ATL26NA             ',  &
+      & 'ATL10NA             ',  &
+      & 'ATLEQA              ',  &
+      & 'ATL10SA             ',  &
+      & 'ATL20SA             ',  &
+      & 'ATL30SA             ',  &
+      & 'PAC60NA             ',  &
+      & 'PAC50NA             ',  &
+      & 'PAC40NA             ',  &
+      & 'PAC35NA             ',  &
+      & 'PAC30NA             ',  &
+      & 'PAC20NA             ',  &
+      & 'PAC10NA             ',  &
+      & 'PACEQA              ',  &
+      & 'INP10SA             ',  &
+      & 'PAC20SA             ',  &
+      & 'PAC30SA             ',  &
+      & 'INDEQA              ',  &
+      & 'IND20SA             ',  &
+      & 'IND30SA             ',  &
+      & 'GLB60NA             ',  &
+      & 'GLB50NA             ',  &
+      & 'GLB40NA             ',  &
+      & 'GLB30NA             ',  &
+      & 'GLB20NA             ',  &
+      & 'GLB10NA             ',  &
+      & 'GLBEQA              ',  &
+      & 'GLB10SA             ',  &
+      & 'GLB20SA             ',  &
+      & 'GLB30SA             ',  &
+      & 'GLB40SA             ',  &
+      & 'GLB50SA             ',  &
+      & 'GLB60SA             ',  &
+      & 'npac25              '  &
+      & /)
+
+   ! User defined areas
+   INTEGER :: nboxuser
+   CHARACTER(len=20), DIMENSION(:), ALLOCATABLE  :: cl_boxes_user
+   REAL, DIMENSION(:,:), ALLOCATABLE :: areas
+
+   ! zonal sections
+   INTEGER, PARAMETER     :: nsecz = 50
+   CHARACTER(len=20), DIMENSION(nsecz)  :: cl_secz = (/ &
+      & 'LOMBOK              ',  &
+      & 'BANDA               ',  &
+      & 'MAKASSAR            ',  &
+      & 'SAVU                ',  &
+      & 'MALACCAS            ',  &
+      & 'PHILIPINES          ',  &
+      & 'YUCATAN             ',  &
+      & 'GIN                 ',  &
+      & 'LABRADOR            ',  &
+      & 'ATL60N              ',  &
+      & 'ATL50N              ',  &
+      & 'ATL40N              ',  &
+      & 'ATL35N              ',  &
+      & 'ATL30N              ',  &
+      & 'ATL27N              ',  &
+      & 'ATL26N              ',  &
+      & 'ATL10N              ',  &
+      & 'ATLEQ               ',  &
+      & 'ATL10S              ',  &
+      & 'ATL20S              ',  &
+      & 'ATL30S              ',  &
+      & 'PAC60N              ',  &
+      & 'PAC50N              ',  &
+      & 'PAC40N              ',  &
+      & 'PAC35N              ',  &
+      & 'PAC30N              ',  &
+      & 'PAC25N              ',  &
+      & 'PAC20N              ',  &
+      & 'PAC10N              ',  &
+      & 'PACEQ               ',  &
+      & 'INP10S              ',  &
+      & 'PAC20S              ',  &
+      & 'PAC30S              ',  &
+      & 'INDEQ               ',  &
+      & 'IND20S              ',  &
+      & 'IND30S              ',  &
+      & 'GLB60N              ',  &
+      & 'GLB50N              ',  &
+      & 'GLB40N              ',  &
+      & 'GLB30N              ',  &
+      & 'GLB20N              ',  &
+      & 'GLB10N              ',  &
+      & 'GLBEQ               ',  &
+      & 'GLB10S              ',  &
+      & 'GLB20S              ',  &
+      & 'GLB30S              ',  &
+      & 'GLB40S              ',  &
+      & 'GLB50S              ',  &
+      & 'GLB60S              ',  &
+      & 'SUM-DARWIN          '   &
+      & /)
+
+   ! meridional sections
+   INTEGER, PARAMETER     :: nsecm = 10
+   CHARACTER(len=20), DIMENSION(nsecm)  :: cl_secm = (/ &
+      & 'IT                  ',  &
+      & 'ITA                 ',  &
+      & 'TIMOR               ',  &
+!      & 'OMBAI               ',  &
+!      & 'SUMBA               ',  &
+!      & 'LUZON               ',  &
+      & 'DRAKE               ',  &
+      & 'TORRES              ',  &
+      & 'MED                 ',  &
+      & 'FLORIDA             ',  &
+      & 'ANTILLAS            ',  &
+      & 'GOODHOPE            ', &
+      & 'SOUTHAUS            '   &
+      & /)
+
+CONTAINS
+
+   SUBROUTINE coord_area( reg, area )
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE coord_area
+      !                     **********************
+      !
+      !  Purpose :
+      !  -------
+      !    Define coordinates of different regions 
+      !
+      !   Modifications :
+      !   -------------
+      !
+      !      SEE: /home/rd/ocx/postp/NEWGRIB/regions.txt 
+      !      and  /home/rd/nep/sms/verify/automat/include/regions.h
+      !
+      !      modification     : 04-09 (N. Daget)
+      !      modification     : 04-09 (N. Daget) add new regions
+      IMPLICIT NONE
+      !----------------------------------------------------------------------
+      ! local declarations
+      !----------------------------------------------------------------------
+      !
+      CHARACTER(len=20), INTENT(inout) :: reg
+      REAL, DIMENSION(4), INTENT(out) :: area
+      !
+      reg=TRIM(reg)
+      ! 
+      SELECT CASE (reg)
+      CASE ('global')
+         area = (/0.,360.,-90.,90./)
+      CASE ('nstrpac')
+         area = (/105.,270.,10.,30./)
+      CASE ('sstrpac')
+         area = (/105.,270.,-30.,-10./)
+      CASE ('npac')    
+         area = (/100.,260.,30.,70./)
+      CASE ('spac')
+         area = (/150.,290.,-70.,-30./)
+      CASE ('trpac')   
+         area = (/125.,280.,-30.,30./)
+      CASE ('natl')
+         area = (/290.,15.,30.,70./)
+      CASE ('satl')
+         area = (/290.,20.,-70.,-30./)
+      CASE ('tratl')
+         area = (/280.,20.,-20.,30./)
+      CASE ('nstratl')
+         area = (/280.,20.,5.,28./)
+      CASE ('sstratl')
+         area = (/300.,20.,-20.,5./)
+      CASE ('neatl')
+         area = (/320.,15.,30.,70./)
+      CASE ('nwatl')
+         area = (/260.,320.,30.,70./)
+      CASE ('equa')
+         area = (/0.,360.,-2.,2./)
+      CASE ('nino1')
+         area = (/270.,280.,-10.,-5./)
+      CASE ('nino2')
+         area = (/270.,280.,-5.,0./)
+      CASE ('nino12')
+         area = (/270.,280.,-10.,0./)
+      CASE ('nino3')
+         area = (/210.,270.,-5.,5./)
+      CASE ('nino4')
+         area = (/160.,210.,-5.,5./)
+      CASE ('nino34')
+         area = (/190.,240.,-5.,5./)
+      CASE ('ind1')
+         area = (/50.,70.,-10.,10./)
+      CASE ('ind2')
+         area = (/90.,110.,-10.,0./)
+      CASE ('ind3')
+         area = (/50.,90.,-10.,0./)
+      CASE ('eq1')
+         area = (/230.,270.,-5.,5./)
+      CASE ('eq2')
+         area = (/190.,230.,-5.,5./)
+      CASE ('eq3')
+         area = (/150.,190.,-5.,5./)
+      CASE ('eq4')
+         area = (/120.,150.,-5.,5./)
+      CASE ('neq1')
+         area = (/230.,270.,5.,15./)
+      CASE ('neq2')
+         area = (/190.,230.,5.,15./)
+      CASE ('neq3')
+         area = (/150.,190.,5.,15./)
+      CASE ('neq4')
+         area = (/120.,150.,5.,15./)
+      CASE ('eqpac')
+         area = (/130.,280.,-5.,5./)
+      CASE ('eqind')
+         area = (/40.,120.,-5.,5./)
+      CASE ('atl1')
+         area = (/315.,340.,0.,10./)
+      CASE ('atl2')
+         area = (/0.,10.,-3.,3./)
+      CASE ('atl3')
+         area = (/340.,360.,-3.,3./)
+      CASE ('eqatl')
+         area = (/290.,30.,-5.,5./)
+      CASE ('trop')
+         area = (/0.,360.,-30.,30./)      ! Tropics (second definition)
+      CASE ('nxtrp')
+         area = (/0.,360.,30.,70./)     ! Northern Extratropics
+      CASE ('sxtrp')
+         area = (/0.,360.,-70.,-30./)   ! Southern Extratropics
+      CASE ('trind')
+         area = (/40.,120.,-30.,30./)
+      CASE ('sind')
+         area = (/20.,150.,-70.,-30./)
+      CASE ('nepac')
+         area = (/210.,260.,30.,70./)
+      CASE ('nwpac')
+         area = (/100.,210.,30.,70./)
+      CASE ('trepac')
+         area = (/210.,270.,-30.,30./)
+      CASE ('trwpac')
+         area = (/100.,210.,-30.,30./)
+     ! PIRATA
+      CASE ('p20n38w') 
+         area = (/321.,323.,19.,21./)
+      CASE ('p15n38w') 
+         area = (/321.,323.,14.,16./)
+      CASE ('p12n38w') 
+         area = (/321.,323.,11.,13./)
+      CASE ('p8n38w') 
+         area = (/321.,323.,7.,9./)
+      CASE ('p4n38w') 
+         area = (/321.,323.,3.,5./)
+      CASE ('p0n35w') 
+         area = (/324.,326.,-0.5,0.5/)
+      CASE ('p21n23w') 
+         area = (/336.,338.,20.,22./)
+      CASE ('p12n23w') 
+         area = (/336.,338.,11.,13./)
+      CASE ('p4n23w') 
+         area = (/336.,338.,3.,5./)
+      CASE ('p0n23w') 
+         area = (/336.,338.,-0.5,0.5/)
+      CASE ('p0n10w') 
+         area = (/349.,351.,-0.5,0.5/)
+      CASE ('p0n0w') 
+         area = (/359.,1.,-0.5,0.5/)
+      CASE ('p5s10w') 
+         area = (/349.,351.,-6.,-4./)
+      CASE ('p10s10w') 
+         area = (/349.,351.,-11.,-9./)
+
+      ! TAO
+      CASE ('t0n156e') 
+         area = (/155.,157.,-0.5,0.5/)
+      CASE ('t0n165e') 
+         area = (/164.,166.,-0.5,0.5/)
+      CASE ('t0n180e') 
+         area = (/179.,181.,-0.5,0.5/)
+      CASE ('t0n170w') 
+         area = (/189.,191.,-0.5,0.5/)
+      CASE ('t0n155w') 
+         area = (/204.,206.,-0.5,0.5/)
+      CASE ('t0n140w')
+         area = (/219.,221.,-0.5,0.5/)
+      CASE ('t0n125w')
+         area = (/234.,236.,-0.5,0.5/)
+      CASE ('t0n110w')
+         area = (/249.,251.,-0.5,0.5/)
+      CASE ('t0n95w')
+         area = (/264.,266.,-0.5,0.5/)
+      CASE ('t5n156e')
+         area = (/155.,157.,4.5,5.5/)
+      CASE ('t5n165e')
+         area = (/164.,166.,4.5,5.5/)
+      CASE ('t5n180e')
+         area = (/179.,181.,4.5,5.5/)
+      CASE ('t5n170w')
+         area = (/189.,191.,4.5,5.5/)
+      CASE ('t5n155w') 
+         area = (/204.,206.,4.5,5.5/)
+      CASE ('t5n140w')
+         area = (/219.,221.,4.5,5.5/)
+      CASE ('t5n125w')
+         area = (/234.,236.,4.5,5.5/)
+      CASE ('t5n110w')
+         area = (/249.,251.,4.5,5.5/)
+      CASE ('t5n95w')
+         area = (/264.,266.,4.5,5.5/)
+      CASE ('t5s156e')
+         area = (/155.,157.,-5.5,-5.5/)
+      CASE ('t5s165e')
+         area = (/164.,166.,-5.5,4.5/)
+      CASE ('t5s180e')
+         area = (/179.,181.,-5.5,-4.5/)
+      CASE ('t5s170w')
+         area = (/189.,191.,-5.5,-4.5/)
+      CASE ('t5s155w') 
+         area = (/204.,206.,-5.5,-4.5/)
+      CASE ('t5s140w')
+         area = (/219.,221.,-5.5,-4.5/)
+      CASE ('t5s125w')
+         area = (/234.,236.,-5.5,-4.5/)
+      CASE ('t5s110w')
+         area = (/249.,251.,-5.5,-4.5/)
+      CASE ('t5s95w')
+         area = (/264.,266.,-5.5,-4.5/)
+      !RAMA
+      CASE ('r8s55e')
+         area = (/54.,56.,-8.,-7./)
+      CASE ('r12s55e')
+         area = (/54.,56.,-13.,-11./)
+      CASE ('r4s67e')
+         area = (/66.,68.,-4.5,-3.5/)
+      CASE ('r8s67e')
+         area = (/66.,68.,-9.,-7./)
+      CASE ('r12s67e')
+         area = (/66.,68.,-13.,-11./)
+      CASE ('r0n80e')
+         area = (/79.,81.,-0.5,0.5/)
+      CASE ('r4s80e')
+         area = (/79.,81.,-4.5,-3.5/)
+      CASE ('r8s80e')
+         area = (/79.,81.,-9.,-7./)
+      CASE ('r12s80e')
+         area = (/79.,81.,-13.,-11./)
+      CASE ('r12n90e')
+         area = (/89.,91.,11.,13./)
+      CASE ('r8n90e')
+         area = (/89.,91.,7.,9./)
+      CASE ('r4n90e')
+         area = (/89.,91.,3.5,4.5/)
+      CASE ('r0n90e')
+         area = (/89.,91.,-0.5,0.5/)
+      CASE ('r5s95e')
+         area = (/94.,96.,-5.5,-4.5/)
+      CASE ('r8s95e')
+         area = (/94.,96.,-9.,-7./)
+      CASE ('r8s100e')
+         area = (/99.,101.,-9.,-7./)
+
+
+      ! ENACT
+      CASE ('NE_subtrop_pac')
+         area = (/190.,260.,10.,30./)
+      CASE ('NW_subtrop_pac')
+         area = (/120.,190.,10.,30./)
+      CASE ('NE_extratrop_pac')
+         area = (/190.,250.,30.,60./)
+      CASE ('NW_extratrop_pac')
+         area = (/120.,190.,30.,60./)
+      CASE ('SE_subtrop_pac')
+         area = (/200.,300.,-30.,-10./)
+      CASE ('SW_subtrop_pac')
+         area = (/143.,200.,-30.,-10./)
+      CASE ('NE_subtrop_atl')
+         area = (/320.,355.,10.,30./)
+      CASE ('NW_subtrop_atl')
+         area = (/283.,320.,10.,30./)
+      CASE ('NE_extratrop_atl')
+         area = (/320.,360.,30.,60./)
+      CASE ('NW_extratrop_atl')
+         area = (/285.,320.,30.,60./)
+      CASE ('SE_subtrop_atl')
+         area = (/350.,20.,-30.,-10./)
+      CASE ('SW_subtrop_atl')
+         area = (/300.,350.,-30.,-10./)
+      CASE ('SE_subtrop_ind')
+         area = (/80.,120.,-30.,-10./)
+      CASE ('SW_subtrop_ind')
+         area = (/30.,80.,-30.,-10./)
+      CASE ('Southern_ocean_pac')
+         area = (/130.,290.,-80.,-30./)
+      CASE ('Southern_ocean_atl')
+         area = (/290.,20.,-80.,-30./)
+      CASE ('Southern_ocean_ind')
+         area = (/20.,130.,-80.,-30./)
+      ! Global areas different latitudes
+      CASE ('GLOBAL05')
+         area = (/0.,360.,-5.,5./)
+      CASE ('GLOBAL10')
+         area = (/0.,360.,-10.,10./)
+      CASE ('GLOBAL15')
+         area = (/0.,360.,-15.,15./)
+      CASE ('GLOBAL20')
+         area = (/0.,360.,-20.,20./)
+      CASE ('GLOBAL25')
+         area = (/0.,360.,-25.,25./)
+      CASE ('GLOBAL30')
+         area = (/0.,360.,-30.,30./)
+      CASE ('GLOBAL40')
+         area = (/0.,360.,-40.,40./)
+      CASE ('GLOBAL50')
+         area = (/0.,360.,-50.,50./)
+      CASE ('GLOBAL60')
+         area = (/0.,360.,-60.,60./)
+      CASE ('ARCTIC')
+         area = (/0.,360.,65.,90./)
+      CASE  ('ATL60NA')
+         area=(/260.,9.13,59.,61./) 
+      CASE  ('ATL50NA')
+         area=(/260.,5.,49.,51./) 
+      CASE  ('ATL40NA')
+         area=(/260.,358.,39.,41./) 
+      CASE  ('ATL35NA')
+         area=(/260.,360.,34.,36./) 
+      CASE  ('ATL30NA')
+         area=(/260.,360.,29.,31./) 
+      CASE  ('ATL26NA')
+         area=(/260.,360.,25.,27./) 
+      CASE  ('ATL20NA')
+         area=(/260.,360.,19.,21./) 
+      CASE  ('ATL10NA')
+         area=(/290.,360.,9.,11./) 
+      CASE  ('ATLEQA')
+         area=(/289.,11.,-1.,1./) 
+      CASE  ('ATL10SA')
+         area=(/320.,15.,-11.,-9./) 
+      CASE  ('ATL20SA')
+         area=(/318.,15.,-21.,-19./) 
+      CASE  ('ATL30SA')
+         area=(/310.,20.,-31.,-29./) 
+      CASE  ('PAC60NA')
+         area=(/140.,250.,59.,61./) 
+      CASE  ('PAC50NA')
+         area=(/130.,240.,49.,51./) 
+      CASE  ('PAC40NA')
+         area=(/125.,240.,39.,41./) 
+      CASE  ('PAC35NA')
+         area=(/115.,242.,34.,36./) 
+      CASE  ('PAC30NA')
+         area=(/115.,250.,29.,31./) 
+      CASE  ('PAC20NA')
+         area=(/100.,260.,19.,21./) 
+      CASE  ('PAC10NA')
+         area=(/105.,275.,9.,11./) 
+      CASE  ('PACEQA')
+         area=(/115.,282.,-1.,1./) 
+      CASE  ('INP10SA')
+         area=(/35.,290.,-11.,-9./) 
+      CASE  ('PAC20SA')
+         area=(/140.,292.,-21.,-19./) 
+      CASE  ('PAC30SA')
+         area=(/150.,292.,-31.,-29./) 
+      CASE  ('INDEQA')
+         area=(/40.,115.,-1.,1./) 
+      CASE  ('IND20SA')
+         area=(/30.,130.,-21.,-19./) 
+      CASE  ('IND30SA')
+         area=(/30.,120.,-31.,-29./) 
+      CASE  ('GLB60NA')
+         area=(/166.,9.13,59.,61./) 
+      CASE  ('GLB50NA')
+         area=(/0.,360.,49.,51./) 
+      CASE  ('GLB40NA')
+         area=(/0.,360.,39.,41./) 
+      CASE  ('GLB30NA')
+         area=(/0.,360.,29.,31./) 
+      CASE  ('GLB20NA')
+         area=(/0.,360.,19.,21./) 
+      CASE  ('GLB10NA')
+         area=(/0.,360.,9.,11./) 
+      CASE  ('GLBEQA')
+         area=(/0.,360.,-1.,1./) 
+      CASE  ('GLB10SA')
+         area=(/0.,360.,-11.,-9./) 
+      CASE  ('GLB20SA')
+         area=(/0.,360.,-21.,-19./) 
+      CASE  ('GLB30SA')
+         area=(/0.,360.,-31.,-29./) 
+      CASE  ('GLB40SA')
+         area=(/0.,360.,-41.,-39./) 
+      CASE  ('GLB50SA')
+         area=(/0.,360.,-51.,-49./) 
+      CASE  ('GLB60SA')
+         area=(/0.,360.,-61.,-59./) 
+      CASE ('npac25')    
+         area = (/100.,260.,25.,70./)
+      !Zonal sections
+      ! Measurements of Indonesian Throughflow at 
+      ! http://www.ocean.washington.edu/people/faculty/susanh/spga/spga.htm
+      ! INSTANT obserational program
+
+      CASE ('LOMBOK')
+!         area=(/114.,118.,-8.,-8./)  
+         area=(/114.,120.,-8.,-9./) ! first/last point rather than min,max
+      CASE ('MAKASSAR')
+!         area=(/114.,120.,-3.,-3./) 
+         area=(/114.,121.,-3.,-3./) 
+      CASE ('MALACCAS')
+!         area=(/99.,102.,3.,3./) 
+         area=(/103.,112.,-2.8,-2.8/) 
+      CASE ('BANDA')
+         area=(/122.,140.,-4.,-4./)
+      CASE  ('SAVU')
+!         area=(/122.,124.,-8.8,-8.8/) 
+         area=(/120.,125.,-8.8,-9.4/) 
+      CASE  ('PHILIPINES')
+         area=(/106.,120.,10.985,10.985/) 
+      CASE  ('YUCATAN')
+!         area=(/273.,285.,20.,20./) 
+         area=(/271.,283.,20.,21./) 
+      CASE  ('GIN')
+!         area=(/315.,7.,63.,63./) 
+         area=(/315.,9.8,63.,63./) 
+      CASE  ('LABRADOR')
+!         area=(/290.,315.,61.,61./) 
+         area=(/289.,310.,60.6,63.5/) 
+      CASE  ('ATL60N')
+!         area=(/260.,10.,57.,57./) 
+!         area=(/260.,10.87,57.,57./) 
+!         area=(/260.,11.2,57.,57./) 
+         area=(/260.,9.13,60.,59.925/) 
+      CASE  ('ATL50N')
+         area=(/260.,5.,50.,50./) 
+      CASE  ('ATL40N')
+         area=(/260.,358.,40.,40./) 
+      CASE  ('ATL35N')
+         area=(/260.,360.,35.,35./) 
+      CASE  ('ATL30N')
+         area=(/260.,360.,30.,30./) 
+      CASE  ('ATL27N')
+         area=(/260.,360.,27.,27./) 
+      CASE  ('ATL26N')
+         area=(/260.,360.,26.,26./) 
+      CASE  ('ATL20N')
+         area=(/260.,360.,20.,20./) 
+      CASE  ('ATL10N')
+!         area=(/300.,360.,10.,10./) 
+         area=(/290.,360.,10.,10./) 
+      CASE  ('ATLEQ')
+!         area=(/300.,10.,0.,0./) 
+         area=(/289.,11.,0.,0./) 
+      CASE  ('ATL10S')
+         area=(/320.,15.,-10.,-10./) 
+      CASE  ('ATL20S')
+         area=(/318.,15.,-30.,-30./) 
+      CASE  ('ATL30S')
+         area=(/310.,20.,-30.,-30./) 
+      CASE  ('PAC60N')
+         area=(/140.,250.,60.,60./) 
+      CASE  ('PAC50N')
+         area=(/130.,240.,50.,50./) 
+      CASE  ('PAC40N')
+         area=(/125.,240.,40.,40./) 
+      CASE  ('PAC35N')
+!         area=(/115.,240.,35.,35./) 
+         area=(/115.,242.,35.,35./) 
+      CASE  ('PAC30N')
+         area=(/115.,250.,30.,30./) 
+      CASE  ('PAC25N')
+         area=(/100.,260.,25.,25./) 
+      CASE  ('PAC20N')
+         area=(/100.,260.,20.,20./) 
+      CASE  ('PAC10N')
+!         area=(/98.,275.,10.,10./) 
+         area=(/105.,275.,10.,10./) 
+      CASE  ('PACEQ')
+         area=(/115.,282.,0.,0./) 
+      CASE  ('INP10S')
+         area=(/35.,290.,-10.,-10./) 
+      CASE  ('PAC20S')
+         area=(/140.,292.,-20.,-20./) 
+      CASE  ('PAC30S')
+         area=(/150.,292.,-30.,-30./) 
+      CASE  ('INDEQ')
+         area=(/40.,115.,-0.,-0./) 
+      CASE  ('IND20S')
+         area=(/30.,130.,-20.,-20./) 
+      CASE  ('IND30S')
+         area=(/30.,120.,-30.,-30./) 
+      CASE  ('GLB60N')
+!         area=(/0.,360.,60.,60./) 
+!         area=(/166.,10.,60.5,60./) 
+!         area=(/166.,6.6,60.5,59.7/) 
+         area=(/166.,9.13,60.5,59.925/) 
+      CASE  ('GLB50N')
+         area=(/0.,360.,50.,50./) 
+      CASE  ('GLB40N')
+         area=(/0.,360.,40.,40./) 
+      CASE  ('GLB30N')
+         area=(/0.,360.,30.,30./) 
+      CASE  ('GLB20N')
+         area=(/0.,360.,20.,20./) 
+      CASE  ('GLB10N')
+         area=(/0.,360.,10.,10./) 
+      CASE  ('GLBEQ')
+         area=(/0.,360.,0.,0./) 
+      CASE  ('GLB10S')
+         area=(/0.,360.,-10.,-10./) 
+      CASE  ('GLB20S')
+         area=(/0.,360.,-20.,-20./) 
+      CASE  ('GLB30S')
+         area=(/0.,360.,-30.,-30./) 
+      CASE  ('GLB40S')
+         area=(/0.,360.,-40.,-40./) 
+      CASE  ('GLB50S')
+         area=(/0.,360.,-50.,-50./) 
+      CASE  ('GLB60S')
+         area=(/0.,360.,-60.,-60./) 
+      CASE  ('SUM-DARWIN')
+         area=(/104.,131.,-4.9,-15.3/) 
+
+      !Meridonal sections (for zonal transports)
+      CASE ('IT'   )                    !From Flores to Australia
+!         area=(/114.,114.,-22.,-8.5/)
+         area=(/126.,126.,-8.8,-16./)
+      CASE ('ITA'   )                   !From Sumatra to Australia
+!         area=(/115.,114.,-22.,-3./)
+         area=(/104.,115.,-4.9,-24.7/)
+      CASE ('TIMOR')
+         area=(/124.,124.,-17.,-9./) 
+!      CASE  ('OMBAI')
+!         area=(/124.5,124.5,-9.2,-8.2/) 
+!      CASE  ('SUMBA') 
+!         area=(/120.,120.,-9.3,-8.3/) 
+!      CASE ('LUZON')
+!         area=(/120.5,120.5,17.,23./) 
+      CASE ('DRAKE')
+!         area=(/290.,290.,-75.,-52./) 
+!         area=(/-69.,-64.,-55.2,-65.9/) 
+         area=(/291.,296.,-54.6,-65.9/) 
+      CASE ('TORRES')
+         area=(/143.,143.,-15.,-8./) 
+      CASE ('MED')
+         area=(/356.,356.,32.,40./) 
+      CASE ('FLORIDA')
+!         area=(/279.5,279.5,22.,28./) 
+!         area=(/-81.,-79,26.5,21.9/) 
+         area=(/-82.,-79.,28.2,22./) 
+      CASE ('ANTILLAS')
+!         area=(/290.,290.,10.,18./) 
+         area=(/-72.,-72.,19.1,8.2/) 
+      CASE ('GOODHOPE')
+!         area=(/340.,340.,-80.,-30./) 
+         area=(/23.,44.,-31.7,-68.2/) 
+      CASE ('SOUTHAUS')
+!         area=(/140.,140.,-80.,-30./) 
+         area=(/133.,133.,-30.,-67.5/) 
+      CASE default
+         PRINT*,'area: ', reg, 'is not defined'
+         CALL abort
+      END SELECT
+
+   END SUBROUTINE coord_area
+
+   SUBROUTINE coord_user_init (sec)
+      CHARACTER(len=1), INTENT(IN) :: sec
+      CHARACTER(len=20), DIMENSION(:), ALLOCATABLE  :: cl_boxes
+      INTEGER                            :: nbox
+      CHARACTER(len=32) :: cdnamelist = 'coords.nml'
+      LOGICAL :: lexists, lnodefaults
+      CHARACTER(len=20) :: carea
+      REAL :: lat1,lat2,lon1,lon2,dlat,dlon
+      LOGICAL :: lreg, lstd
+      INTEGER :: nlat,nlon
+      INTEGER :: i,j,k
+      NAMELIST/area/lstd,lreg,carea,lat1,lat2,lon1,lon2,dlat,dlon
+
+      lnodefaults=.TRUE.
+      nboxuser=0
+      SELECT CASE (sec)
+      CASE ('u')
+         nbox=nsecm
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_secm(:)
+      CASE ('v')
+         nbox=nsecz
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_secz(:)
+      CASE default
+         nbox=nsech
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_sech(:)
+      END SELECT
+      INQUIRE(file=cdnamelist,exist=lexists) 
+      IF (lexists) THEN
+         nboxuser=0
+         OPEN(20,file=cdnamelist)
+         DO
+            carea='undefined'
+            lat1=-90
+            lat2=90
+            lon1=0
+            lon2=360
+            dlat=10
+            dlon=10
+            lreg=.FALSE.
+            lstd=.FALSE.
+            READ(20,area,end=100)
+            DO
+               IF (lon1<0) lon1=lon1+360
+               IF (lon1>360) lon1=lon1-360
+               IF ((lon1>=0).AND.(lon1<=360)) EXIT
+            ENDDO
+            DO
+               IF (lon2<0) lon2=lon2+360
+               IF (lon2>360) lon2=lon2-360
+               IF ((lon2>=0).AND.(lon2<=360)) EXIT
+            ENDDO
+            WRITE(*,area)
+            IF (lreg.AND.(TRIM(carea)/='undefined')) THEN
+               WRITE(*,*)'coord_init: please specify either lreg=true '//&
+                  &      'or carea/=undefined'
+               CALL abort
+            ENDIF
+            IF (TRIM(carea)/='undefined') THEN
+               nboxuser=nboxuser+1
+            ENDIF
+            IF (lreg) THEN
+               nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
+               nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
+               nboxuser=nboxuser+nlat*nlon
+            ENDIF
+            IF (lstd) THEN
+               IF (lnodefaults) THEN
+                  nboxuser=nboxuser+nbox
+                  lnodefaults=.FALSE.
+               ENDIF
+            ENDIF
+         END DO
+100      CONTINUE
+         WRITE(*,*)'Total areas = ',nboxuser
+         IF (nboxuser==0) THEN
+            CLOSE(20)
+            WRITE(*,*)'coord_init: no boxes defined!!'
+            CALL abort
+         ENDIF
+         ALLOCATE(cl_boxes_user(nboxuser))
+         ALLOCATE(areas(4,nboxuser))
+         nboxuser=0
+         IF (.NOT.lnodefaults) THEN
+            cl_boxes_user(1:nbox)=cl_boxes(1:nbox)
+            DO i=1,nbox
+               CALL coord_area( cl_boxes_user(i), areas(:,i) )
+            ENDDO
+            nboxuser=nboxuser+nbox
+         ENDIF
+         REWIND(20)
+         WRITE(*,*)'Reading areas'
+         DO
+            carea='undefined'
+            lat1=-90
+            lat2=90
+            lon1=0
+            lon2=360
+            dlat=10
+            dlon=10
+            lreg=.FALSE.
+            lstd=.FALSE.
+            READ(20,area,end=200)
+            DO
+               IF (lon1<0) lon1=lon1+360
+               IF (lon1>360) lon1=lon1-360
+               IF ((lon1>=0).AND.(lon1<=360)) EXIT
+            ENDDO
+            DO
+               IF (lon2<0) lon2=lon2+360
+               IF (lon2>360) lon2=lon2-360
+               IF ((lon2>=0).AND.(lon2<=360)) EXIT
+            ENDDO
+            IF (TRIM(carea)/='undefined') THEN
+               nboxuser=nboxuser+1
+               cl_boxes_user(nboxuser)=carea
+               areas(1,nboxuser)=MIN(lon1,lon2)
+               areas(2,nboxuser)=MAX(lon1,lon2)
+               areas(3,nboxuser)=MIN(lat1,lat2)
+               areas(4,nboxuser)=MAX(lat1,lat2)
+            ENDIF
+            IF (lreg) THEN
+               nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
+               nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
+               k=0
+               DO j=1,nlat
+                  DO i=1,nlon
+                     k=k+1
+                     areas(1,k+nboxuser)=MIN(lon1,lon2)+(i-1)*dlon
+                     areas(2,k+nboxuser)=MIN(lon1,lon2)+i*dlon
+                     areas(3,k+nboxuser)=MIN(lat1,lat2)+(j-1)*dlat
+                     areas(4,k+nboxuser)=MIN(lat1,lat2)+j*dlat
+                     WRITE(cl_boxes_user(k+nboxuser)(1:5),'(I4.4,A1)') &
+                        & NINT(areas(1,k+nboxuser)*10),'e'
+                     WRITE(cl_boxes_user(k+nboxuser)(6:10),'(I4.4,A1)') &
+                        & NINT(areas(2,k+nboxuser)*10),'e'
+                     IF (areas(3,k+nboxuser)<0) THEN
+                        WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
+                           & -NINT(areas(3,k+nboxuser)*10),'s'
+                     ELSE
+                        WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
+                           & NINT(areas(3,k+nboxuser)*10),'n'
+                     ENDIF
+                     IF (areas(4,k+nboxuser)<0) THEN
+                        WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
+                           & -NINT(areas(4,k+nboxuser)*10),'s'
+                     ELSE
+                        WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
+                           & NINT(areas(4,k+nboxuser)*10),'n'
+                     ENDIF
+                  ENDDO
+               ENDDO
+               nboxuser=nboxuser+nlat*nlon
+            ENDIF
+         END DO
+200      CONTINUE
+         CLOSE(20)
+      ELSE
+         nboxuser=nbox
+         ALLOCATE(cl_boxes_user(nboxuser))
+         ALLOCATE(areas(4,nboxuser))
+         cl_boxes_user(:)=cl_boxes(:)
+         DO i=1,nbox
+            CALL coord_area( cl_boxes_user(i), areas(:,i) )
+         ENDDO
+      ENDIF
+      DO i=1,nboxuser
+         WRITE(*,'(A,4F12.2)')cl_boxes_user(i),areas(:,i)
+         DO j=i+1,nboxuser
+            IF (TRIM(cl_boxes_user(i))==TRIM(cl_boxes_user(j))) THEN
+               WRITE(*,*)'coord_user_init: dublicate boxes'
+               CALL abort
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE coord_user_init
+
+   SUBROUTINE coord_area_user( reg, area, ldfail )
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE coord_area_user
+      !                     ****************************
+      !
+      !  Purpose :
+      !  -------
+      !    Get coordinate of different regions
+      !
+      !   Modifications :
+      !   -------------
+      IMPLICIT NONE
+      !----------------------------------------------------------------------
+      ! local declarations
+      !----------------------------------------------------------------------
+      !
+      CHARACTER(len=20), INTENT(inout) :: reg
+      REAL, DIMENSION(4), INTENT(out) :: area
+      LOGICAL, OPTIONAL, INTENT(out) :: ldfail
+      INTEGER :: i
+      LOGICAL :: lnotfound
+      !
+      reg=TRIM(reg)
+
+      lnotfound=.TRUE.
+      DO i=1,nboxuser
+         IF (reg==TRIM(cl_boxes_user(i))) THEN
+            area(:)=areas(:,i)
+            lnotfound=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+      IF (PRESENT(ldfail)) THEN
+         ldfail=lnotfound
+      ELSE
+         IF (lnotfound) THEN
+            WRITE(*,*)'coord_area_user: area not found'
+            CALL abort
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE coord_area_user
+
+END MODULE coords
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90	(revision 8732)
@@ -0,0 +1,90 @@
+PROGRAM corio2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM corio2fb **
+   !!
+   !!  ** Purpose : Convert Coriolis format profiles to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     corio2fb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_prof_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: coriof(:)
+   INTEGER :: ninfiles,ntotcorio,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'corio2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( coriof(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotcorio = 0
+   ninfiles  = nargs - 1
+   DO ia=1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_coriofile( TRIM(cdinfile(ia)), coriof(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',coriof(ia)%nobs,' profiles'
+      ntotcorio = ntotcorio + coriof(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, coriof(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( coriof(1) )
+      CALL alloc_obfbdata( coriof(1), 2, 0, 1, 0, 1, .FALSE. )
+      coriof(1)%cname(1) = 'POTM'
+      coriof(1)%cname(2) = 'PSAL'
+      coriof(1)%coblong(1) = 'Potential temperature'
+      coriof(1)%coblong(2) = 'Practical salinity'
+      coriof(1)%cobunit(1) = 'Degrees Celsius'
+      coriof(1)%cobunit(2) = 'PSU'
+      coriof(1)%cextname(1) = 'TEMP'
+      coriof(1)%cextlong(1) = 'Insitu temperature'
+      coriof(1)%cextunit(1) = 'Degrees Celsius'
+      coriof(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotcorio
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, coriof )
+   
+END PROGRAM corio2fb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90	(revision 8732)
@@ -0,0 +1,21 @@
+   SUBROUTINE ctl_stop( cerr )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE ctl_stop **
+      !!
+      !!  ** Purpose : Stop execution
+      !!
+      !!  ** Method  : 
+      !!
+      !!  ** Action  :
+      !!
+      !!   History :   (2008-12) K. Mogensen. NEMOVAR version
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) :: cerr
+
+      WRITE(*,*)'Error:'
+      WRITE(*,*)TRIM(cerr)
+      CALL abort
+
+   END SUBROUTINE ctl_stop
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90	(revision 8732)
@@ -0,0 +1,482 @@
+MODULE date_utils
+
+   USE toolspar_kind
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE add_date(initial_date,hours,final_date)
+
+      ! Add a number of hours to initial_date and return it in final_date
+
+      IMPLICIT NONE
+
+
+      !! Arguments
+      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDDHH)
+      INTEGER,INTENT(in) :: hours        ! Number of hours to add
+      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDDHH)
+
+      !! Local variables
+
+      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
+      REAL(dp):: juld
+
+      CALL split_date(initial_date,iyear,imon,iday,ihours)
+
+      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
+
+      juld=juld+REAL(hours)/24.0
+
+      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
+
+      final_date=iyear*1000000+imon*10000+iday*100+ihours
+
+   END SUBROUTINE add_date
+
+
+   SUBROUTINE add_days_to_date(initial_date,days,final_date)
+
+      ! Add a number of days to initial_date and return it in final_date
+
+      IMPLICIT NONE
+
+
+      !! Arguments
+      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDD)
+      INTEGER,INTENT(in) :: days         ! Number of days to add
+      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDD)
+
+      !! Local variables
+
+      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
+      REAL(dp):: juld
+
+		! Account for lack of hours in date format (initial_date*100)
+      CALL split_date(initial_date*100,iyear,imon,iday,ihours)
+
+      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
+
+      juld=juld+REAL(days)
+
+      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
+
+      final_date=(iyear*1000000+imon*10000+iday*100+ihours)/100
+
+   END SUBROUTINE add_days_to_date
+
+
+   SUBROUTINE split_date(iyyyymmddhh,iyyyy,imm,idd,ihh)
+
+      ! Splits a date in YYYYMMDDHH format into iyyyy, imm, idd, ihh
+
+      IMPLICIT NONE
+      INTEGER,INTENT(in) :: iyyyymmddhh
+      INTEGER,INTENT(out) :: iyyyy,imm,idd,ihh
+
+      iyyyy=iyyyymmddhh/1000000
+      imm=iyyyymmddhh/10000-iyyyy*100
+      idd=iyyyymmddhh/100-(iyyyy*10000+imm*100)
+      ihh=MOD(iyyyymmddhh,100)
+
+   END SUBROUTINE split_date
+
+   SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+      &                           prelday )
+
+      IMPLICIT NONE
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  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(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
+
+      ! Main computation
+      iref = jporef 
+
+      zday = prelday
+      ksec = NINT( 86400. * MOD( zday, 1.0_wp ) )
+
+      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
+
+   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian )
+
+      IMPLICIT NONE
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  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
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &  ! Gregorian calendar introduction date
+         & jpjref = 2433283                          ! Julian reference date: 19500101
+      INTEGER :: &
+         & ija,     &
+         & ijy,     &
+         & ijm,     &
+         & ijultmp, &
+         & ijyear
+
+      ! 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 - jpjref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
+
+   END SUBROUTINE greg2jul
+
+
+   SUBROUTINE addseconds(iyear,imon,iday,ihour,imin,isec,iaddsec)
+
+      ! Add iaddsecs to the date and return the new date (in place)
+
+      !! Arguments
+
+      INTEGER,intent(inout) :: iyear,imon,iday,ihour,imin,isec,iaddsec
+
+      !! Local variables
+
+      INTEGER :: itotsec,idays,isecs
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) 
+
+      itotsec=iaddsec+ihour*3600*imin*60+isec
+
+      IF (itotsec<0) THEN
+         WRITE(*,*)'Negative itotsec in addseconds'
+         WRITE(*,*)'This does not work'
+         RETURN
+      ENDIF
+
+      ihour=0
+      imin=0
+      isec=0
+
+      idays=itotsec/86400
+      isecs=itotsec-idays*86400
+      iday=iday+idays
+
+      ! Compute the date
+      DO
+         ! Leap year 
+         mday(2)=28
+         IF (MOD(iyear,4).EQ.0) mday(2)=29
+         IF (MOD(iyear,100).EQ.0) mday(2)=28
+         IF (MOD(iyear,400).EQ.0) mday(2)=29
+         IF (MOD(iyear,4000).EQ.0) mday(2)=28
+
+         IF (iday.GT.mday(imon))THEN
+            iday=iday-mday(imon)
+            imon=imon+1
+            IF(imon.GT.12)THEN
+               imon=1
+               iyear=iyear+1
+            ENDIF
+         ELSE
+            EXIT
+         ENDIF
+
+      ENDDO
+
+      ! Set the time
+      ihour=isecs/3600
+      imin=isecs/60-ihour*60
+      isec=isecs-ihour*3600-imin*60
+
+   END SUBROUTINE addseconds
+
+   INTEGER FUNCTION nextdate(idate)
+
+      ! Return next date.
+      ! Date format is assumed to be YYYYMMDD
+
+      IMPLICIT NONE
+
+      !! Arguments
+
+      INTEGER :: idate ! Initial date
+
+      !! Local variables
+
+      INTEGER :: year,day,mon
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+
+      day=MOD(idate,100)
+      mon=MOD((idate-day)/100,100)
+      year=idate/10000
+
+      mday(2)=28
+      IF (MOD(year,4).EQ.0) mday(2)=29
+      IF (MOD(year,100).EQ.0) mday(2)=28
+      IF (MOD(year,400).EQ.0) mday(2)= 29
+      IF (MOD(year,4000).EQ.0) mday(2) = 28
+
+      day=day+1
+      IF (day.GT.mday(mon))THEN
+         day=1
+         mon=mon+1
+         IF(mon.GT.12)THEN
+            mon=1
+            year=year+1
+         ENDIF
+      ENDIF
+      nextdate=year*10000+mon*100+day
+      RETURN
+
+   END FUNCTION nextdate
+
+   INTEGER FUNCTION prevdate(idate)
+
+      ! Return previous date.
+      ! Date format is assumed to be YYYYMMDD
+
+      IMPLICIT NONE
+
+      !! Arguments
+
+      INTEGER :: idate ! Initial date
+
+      !! Local variables
+
+      INTEGER :: year,day,mon
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+
+      day=MOD(idate,100)
+      mon=MOD((idate-day)/100,100)
+      year=idate/10000
+
+      mday(2)=28
+      IF (MOD(year,4).EQ.0) mday(2)=29
+      IF (MOD(year,100).EQ.0) mday(2)=28
+      IF (MOD(year,400).EQ.0) mday(2)= 29
+      IF (MOD(year,4000).EQ.0) mday(2) = 28
+
+      day=day-1
+      IF (day.LT.1)THEN
+         mon=mon-1
+         IF(mon.LT.1)THEN
+            mon=12
+            year=year-1
+         ENDIF
+         day=mday(mon)
+      ENDIF
+      prevdate=year*10000+mon*100+day
+      RETURN
+
+   END FUNCTION prevdate
+
+   INTEGER FUNCTION diffdate(idate1,idate2)
+
+      ! Compute difference in days between dates
+      ! Assumes YYYYMMDD format for dates
+
+      IMPLICIT NONE
+
+      !! Argument
+
+      INTEGER :: idate1,idate2    ! Dates to be diffed.
+
+      !! Local variables
+
+      INTEGER :: itdate1,itdate2
+      INTEGER :: it
+
+      itdate1=MIN(idate1,idate2)
+      itdate2=MAX(idate1,idate2)
+
+      IF (itdate1==itdate2) THEN
+         diffdate=0
+         RETURN
+      ENDIF
+      diffdate=0
+      it=itdate1
+      DO 
+         it=nextdate(it)
+         diffdate=diffdate+1
+         IF (it==itdate2) EXIT
+      ENDDO
+      RETURN
+
+   END FUNCTION diffdate
+
+   INTEGER FUNCTION difftime(itime1,itime2)
+
+      ! Compute difference in minutes between times
+      ! Assumes HHMM or HMM or MM or M format for dates
+		!
+		! ORDER MATTERS - itime1 is ealier time
+		! Result is an integer number of minutes
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) :: itime1,itime2    ! Times to be diffed.
+      INTEGER :: imin1, imin2, ihr1, ihr2
+
+		ihr1 = (itime1/100)
+		ihr2 = (itime2/100)
+		
+		imin1 = (itime1 - ihr1*100) + (60 * ihr1)
+		imin2 = (itime2 - ihr2*100) + (60 * ihr2)
+		
+		! Assume that itime2 is later, so wrap around midnight if necessary.
+		IF (imin2 < imin1) THEN
+			imin2 = imin2 + 24*60
+		END IF
+		
+		difftime = imin2 - imin1
+		
+   END FUNCTION difftime
+
+
+   INTEGER FUNCTION add_mins_to_time(itime1, imin_add)
+
+      ! Add number of minutes onto given time
+      ! Assumes time in HHMM or HMM or MM or M format
+		!
+		! Result is in HHMM format
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) :: itime1,imin_add
+      INTEGER :: imin1, ihr1, imin2, ihr2
+
+		ihr1 = (itime1/100)
+		
+		! itime1 in minutes from previous midnight
+		imin1 = (itime1 - ihr1*100) + (60 * ihr1)
+		
+		imin1 = imin1 + imin_add
+		
+		! Add 1day if time went nagative
+		IF (imin1 < 0) THEN
+			imin1 = imin1 + 24*60
+		END IF
+		
+		! Turn number of minutes back into HHMM
+		ihr2 = imin1/60
+		imin2 = imin1 - ihr2*60
+
+		DO
+			IF (ihr2<0) THEN
+				ihr2 = ihr2 + 24
+			ELSE IF (ihr2>=24) THEN
+				ihr2 = ihr2 - 24
+			END IF
+			IF ((ihr2>=0).OR.(ihr2<24)) EXIT
+		END DO
+
+		add_mins_to_time = ihr2*100 + imin2
+	
+   END FUNCTION add_mins_to_time
+
+
+END MODULE date_utils
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90	(revision 8732)
@@ -0,0 +1,33 @@
+   REAL FUNCTION distance( plon1, plat1, plon2, plat2 )
+      ! Arggumnts
+      REAL :: plon1,plat1,plat2,plon2
+      ! Local variables
+      REAL :: zplat1,zplon1,zplat2,zplon2
+      REAL :: za1,za2,zb1,zb2,zc1,zc2,zcos1,zcos2
+      REAL, PARAMETER :: zrad = 3.141592653589793/180.0
+      REAL, parameter :: rearth = 6371229
+
+      zplon1 = plon1
+      zplon2 = plon2
+      IF ( zplon1 <  -180 ) zplon1 = zplon1 + 360.0
+      IF ( zplon1 >=  180 ) zplon1 = zplon1 - 360.0
+      IF ( zplon2 <  -180 ) zplon2 = zplon2 + 360.0
+      IF ( zplon2 >=  180 ) zplon2 = zplon2 - 360.0
+
+      zplon1 = zplon1 * zrad
+      zplon2 = zplon2 * zrad
+      zplat1 = plat1  * zrad
+      zplat2 = plat2  * zrad
+      zcos1  = COS( zplat1 )
+      zcos2  = COS( zplat2 )
+      za1    = SIN( zplat1 )
+      za2    = SIN( zplat2 )
+      zb1    = zcos1 * COS( zplon1 )
+      zb2    = zcos2 * COS( zplon2 )
+      zc1    = zcos1 * SIN( zplon1 )
+      zc2    = zcos2 * SIN( zplon2 )
+
+      distance  =  rearth  *  &
+         &  ASIN( SQRT( ABS ( 1.0 - ( za1 * za2 + zb1 * zb2 + zc1 * zc2) ** 2) ) )
+      
+    END FUNCTION distance
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/DOM/dom_oce.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90	(revision 8732)
@@ -0,0 +1,90 @@
+PROGRAM enact2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM corio2fb **
+   !!
+   !!  ** Purpose : Convert ENACT format profiles to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     enact2fb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_prof_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: enactf(:)
+   INTEGER :: ninfiles,ntotenact,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'enact2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( enactf(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotenact = 0
+   ninfiles  = nargs - 1
+   DO ia = 1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_enactfile( TRIM(cdinfile(ia)), enactf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',enactf(ia)%nobs,' profiles'
+      ntotenact = ntotenact + enactf(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, enactf(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( enactf(1) )
+      CALL alloc_obfbdata( enactf(1), 2, 0, 1, 0, 1, .FALSE. )
+      enactf(1)%cname(1) = 'POTM'
+      enactf(1)%cname(2) = 'PSAL'
+      enactf(1)%coblong(1) = 'Potential temperature'
+      enactf(1)%coblong(2) = 'Practical salinity'
+      enactf(1)%cobunit(1) = 'Degrees Celsius'
+      enactf(1)%cobunit(2) = 'PSU'
+      enactf(1)%cextname(1) = 'TEMP'
+      enactf(1)%cextlong(1) = 'Insitu temperature'
+      enactf(1)%cextunit(1) = 'Degrees Celsius'
+      enactf(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotenact
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, enactf )
+
+END PROGRAM enact2fb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90	(revision 8732)
@@ -0,0 +1,16 @@
+MODULE fbaccdata
+   USE fbacctype
+   IMPLICIT NONE
+   INTEGER, DIMENSION(:,:,:,:,:), ALLOCATABLE :: inum,inumov,inumbv
+   INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: inuma
+   REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: zbias,zrms,zsdev,zomean,zmmean,&
+      & zoemea,zovmea,zbemea,zbvmea
+   REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: zoamean
+   INTEGER, PARAMETER :: maxvars = 10
+   REAL, DIMENSION(maxvars) :: zcheck
+   REAL, DIMENSION(maxvars) :: zhistmax, zhistmin, zhiststep
+   TYPE(histtype), DIMENSION(maxvars) :: hist
+   REAL, DIMENSION(maxvars) :: zxymax, zxymin, zxystep
+   TYPE(xytype), DIMENSION(maxvars) :: xy
+END MODULE fbaccdata
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90	(revision 8732)
@@ -0,0 +1,11 @@
+MODULE fbacctype
+   IMPLICIT NONE
+   TYPE histtype
+      INTEGER :: npoints
+      INTEGER, POINTER, DIMENSION(:,:,:,:,:) :: nhist
+   END TYPE histtype
+   TYPE xytype
+      INTEGER :: npoints
+      INTEGER, POINTER, DIMENSION(:,:,:,:,:,:) :: nxy
+   END TYPE xytype
+END MODULE fbacctype
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90	(revision 8732)
@@ -0,0 +1,182 @@
+PROGRAM fbcomb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbcomb **
+   !!
+   !!  ** Purpose : Combine MPI decomposed feedback files into one file
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  : 
+   !!
+   !!   Usage:
+   !!     fbcomb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind
+   USE obs_fbm
+   USE index_sort
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata),POINTER :: obsdata(:)
+   INTEGER :: ninfiles,ntotobs,nlev
+   !
+   ! Time sorting arrays
+   !
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   INTEGER :: iwmo
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: obsoutdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,iv,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs = IARGC()
+   IF ( nargs < 2 ) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbcomb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg( 1, cdoutfile )
+   !
+   ! Get input data
+   !
+   ALLOCATE( obsdata( nargs - 1 ) )
+   ALLOCATE( cdinfile( nargs - 1 ) )
+   ntotobs = 0
+   ninfiles = nargs - 1
+   DO ia=1, ninfiles
+      CALL getarg( ia+1, cdinfile(ia) )
+      CALL init_obfbdata( obsdata(ia) )
+      CALL read_obfbdata( TRIM(cdinfile(ia)), obsdata(ia) )
+      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has', obsdata(ia)%nobs, ' observations'
+      ntotobs = ntotobs + obsdata(ia)%nobs
+   ENDDO
+   WRITE(*,'(A,I8)') 'Total obsfiles : ',ntotobs
+   !
+   ! Check that the data is confirming
+   !
+   DO ia=2, ninfiles
+      IF ( obsdata(ia)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
+         WRITE(*,*)'Different julian date reference. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%nvar /= obsdata(1)%nvar ) THEN
+         WRITE(*,*)'Different number of variables. Aborting'
+         CALL abort
+      ENDIF
+      IF  (obsdata(ia)%nadd /= obsdata(1)%nadd ) THEN
+         WRITE(*,*)'Different number of additional entries. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%next /= obsdata(1)%next ) THEN
+         WRITE(*,*)'Different number of additional variables. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%lgrid .NEQV. obsdata(1)%lgrid ) THEN
+         WRITE(*,*)'Inconsistent grid search info. Aborting'
+         CALL abort
+      ENDIF
+      DO iv=1, obsdata(ia)%nvar
+         IF ( obsdata(ia)%cname(iv) /= obsdata(1)%cname(iv) ) THEN
+            WRITE(*,*)'Variable name ', TRIM(obsdata(ia)%cname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%cname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+         IF ( obsdata(1)%lgrid ) THEN
+            IF ( obsdata(ia)%cgrid(iv) /= obsdata(1)%cgrid(iv) ) THEN
+               IF (obsdata(1)%nobs==0) THEN
+                  obsdata(1)%cgrid(iv) = obsdata(ia)%cgrid(iv)
+               ELSE
+                  IF (obsdata(ia)%nobs>0) THEN
+                     WRITE(*,*)'Grid name ', TRIM(obsdata(ia)%cgrid(iv)), &
+                        &      ' is different from ', &
+                        &      TRIM(obsdata(1)%cgrid(iv)), '. Aborting'
+                     CALL abort
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+      DO iv=1,obsdata(ia)%nadd
+         IF ( obsdata(ia)%caddname(iv) /= obsdata(1)%caddname(iv) ) THEN
+            WRITE(*,*)'Additional name ', TRIM(obsdata(ia)%caddname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%caddname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+      ENDDO
+      DO iv=1,obsdata(ia)%next
+         IF ( obsdata(ia)%cextname(iv) /= obsdata(1)%cextname(iv) ) THEN
+            WRITE(*,*)'Extra name ', TRIM(obsdata(ia)%cextname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%cextname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+      ENDDO
+   ENDDO
+   !
+   ! Construct sorting arrays
+   !
+   ALLOCATE( zsort(5,ntotobs), iset(ntotobs), &
+      & inum(ntotobs), iindex(ntotobs))
+   ii = 0
+   DO ia = 1,ninfiles
+      DO ij = 1,obsdata(ia)%nobs
+         ii = ii+1
+         zsort(1,ii) = obsdata(ia)%ptim(ij)
+         zsort(2,ii) = obsdata(ia)%pphi(ij)
+         zsort(3,ii) = obsdata(ia)%plam(ij)
+         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(1:4), iwmo )
+         zsort(4,ii) = iwmo
+         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(5:8), iwmo )
+         zsort(5,ii) = iwmo
+         iset(ii) = ia
+         inum(ii) = ij
+      ENDDO
+   ENDDO
+   !
+   ! Get indexes for time sorting.
+   !
+   CALL index_sort_dp_n(zsort,5,iindex,ntotobs)
+   !
+   ! Allocate output data
+   !   
+   nlev = -1
+   DO ia = 1,ninfiles
+      IF ( obsdata(ia)%nlev > nlev ) nlev = obsdata(ia)%nlev
+   ENDDO
+   CALL init_obfbdata( obsoutdata )
+   CALL alloc_obfbdata( obsoutdata, obsdata(1)%nvar, ntotobs, nlev, &
+      &                 obsdata(1)%nadd, obsdata(1)%next, obsdata(1)%lgrid )
+   !
+   ! Copy input data into output data
+   !
+   CALL merge_obfbdata( ninfiles, obsdata, obsoutdata, iset, inum, iindex )
+   !
+   ! Save output data 
+   !
+   CALL write_obfbdata ( TRIM(cdoutfile), obsoutdata )
+   
+END PROGRAM fbcomb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate.F90	(revision 8732)
@@ -0,0 +1,327 @@
+PROGRAM fbgenerate
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbmatchup **
+   !!
+   !!  ** Purpose : Generate a feedback file of pseudo obs
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  : Read in data from a namelist file and generate a feedback
+   !!               file of pseudo observations
+   !! 
+   !!   Usage: 		For any parameter, if 3 values are given, these will be treated as
+   !!                   bounds (start, stop, step), EXCEPT when only 3 values are expected.
+   !!
+   !!                For spatial coord, date and time
+	!! 						3 values with nlat=3 will be treated as three separate values
+	!! 						3 values with nobs=3 will be treated as three separate values
+	!! 						3 values with nobs>3 will be treated as a start, end and step
+	!! 						Giving a FillValue in one of namelist entries may have unexpected consequences
+	!! 							e.g., discarding rest of list of values
+	!!
+	!! 					For time bounds, start(HHMM), end(HHMM), step(minutes)
+	!!						For date bounds, start(YYYYMMDD), end(YYYYMMDD), step(days)
+   !!
+   !!                To split obs evenly in time, date and time should be given two values 
+   !!                describing the start and end times. 
+   !!
+   !!                Can use logical flag to shuffle timestamps to remove position-time correlation.
+   !!
+   !!                Can use logical flag to add uniformly sampled perturbation (up to defined limit) to positions
+	!!
+	!! 					For obs values, can list either single value for all (x,y,z)
+	!! 					or can specify single profile for all (x,y)
+	!! 					or can specify all values 1 profile after another.
+	!!	 					
+	!! 					In namelist to set vals(nlev,nobs,nvar)
+	!! 						set all obs (for variable 1) at all levels to one value
+	!! 							vals(:,:,1)= 1.0
+	!! 						set all obs (for variable 2) at all levels to one value
+	!! 							vals(:,:,2)= 35.0
+	!! 						set one profile (for variable 1), apply to all	
+	!! 							vals(:,:,1)= 1.0, 2.0, 3.0, 4.0
+	!! 						set all profiles profile (for variable 1)	
+	!! 							vals(:,1,1)= 1.0, 2.0, 3.0, 4.0
+	!! 							vals(:,2,1)= 1.0, 2.0, 3.0, 4.0
+	!! 							vals(:,nobs,1)= 1.0, 2.0, 3.0, 4.0
+   !!     
+   !!
+   !!   Limitations: Uses an allocatable array in a namelist. This is not meant 
+	!!                 to be allowed in F95, but it works when compiled with xlf90_r
+	!!                 (and is allowed in Fortran2003).
+	!!
+	!!                Forces same depth levels on all profiles.
+	!!
+   !!   History :
+   !!        ! 2014    (J. Waters) Initial version
+   !!        ! 2014-02 (R. King)   Adapted for profiles and bounds on vars
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+	USE fbgenerate_coords
+	USE test_fbgenerate
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbobsdata
+   CHARACTER(len=256) :: filenameout
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nobs, nvar, nlev, ntyp, nadd, next, lgrid, ierr, nlats, nlons
+   INTEGER :: i, j
+   INTEGER :: FillValue_int
+	REAL(KIND=fbdp) :: FillValue_real
+   INTEGER, ALLOCATABLE :: dates(:), times(:)
+   REAL(KIND=fbdp), ALLOCATABLE :: julian_dates(:)
+	REAL(KIND=fbdp) :: phys_spacing, lat_step, current_lat, perturb_limit
+   REAL(KIND=fbdp), ALLOCATABLE :: lats(:), lons(:), deps(:), vals(:,:,:), model_vals(:,:,:) 
+   CHARACTER(LEN=ilenwmo) :: cdwmo, cdtyp
+   CHARACTER(LEN=ilenwmo), ALLOCATABLE :: variable(:)
+	CHARACTER(LEN=ilenlong), ALLOCATABLE :: variable_longname(:)
+	CHARACTER(LEN=ilenunit), ALLOCATABLE :: variable_units(:)
+	LOGICAL, PARAMETER :: test_prog = .FALSE.
+	LOGICAL :: ln_listobs, ln_physpace, ln_gridobs, ln_shuffletimes, ln_perturb_posn
+   REAL(KIND=fbdp), PARAMETER :: earth_radius = 6371.0_fbdp
+   REAL(KIND=fbdp), PARAMETER :: pi = 3.14159_fbdp
+	
+	!!!! set up default values and read in namelist namfbgen.in !!!!!!!!!!!!!!!!!!!!
+   NAMELIST/namfbgeneratesetup/ln_listobs,ln_physpace,ln_gridobs,ln_shuffletimes,ln_perturb_posn,perturb_limit,nobs,nlats,nlons,phys_spacing,nlev,nvar,nadd
+   NAMELIST/namfbgenerate/ntyp,lats,lons,deps,times,dates,vals,model_vals,variable,variable_longname,variable_units,cdwmo,cdtyp
+
+	IF (test_prog) THEN
+		WRITE(*,*) "In test mode:"
+		CALL tester
+	ELSE
+	
+   
+	IF (iargc()/=1) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbgenerate <output filename>'
+      CALL abort
+   ENDIF
+
+   CALL getarg(1,filenameout)
+	
+   ! set up default values for namfbgeneratesetup
+   ln_listobs=.FALSE.
+   ln_physpace=.FALSE.
+   ln_gridobs=.FALSE.
+   ln_shuffletimes=.FALSE.
+   ln_perturb_posn=.FALSE.
+   nobs=0
+   nlats=0
+   nlons=0
+   phys_spacing =100.0_fbdp
+   nlev=0
+	nvar=0
+
+   ! Read in number of obs and number of depths from namelist (before reading other variables)
+	FillValue_real = 99999.0_fbdp
+	FillValue_int = 99999
+   OPEN(10,file='namfbgen.in')
+   READ(10,namfbgeneratesetup) 
+   CLOSE(10)
+   
+   ! Calculate number of observations
+   IF ((ln_gridobs) .AND. (.NOT.ln_physpace) .AND. (.NOT.ln_listobs)) THEN
+      IF( ( nlats .LE. 0 ) .OR. (nlons .LE. 0) )THEN
+         WRITE(6,*)'ERROR: nlats and nlons must be greater than 0 if ln_gridobs set'
+      ELSE
+         nobs=nlats*nlons
+         WRITE(*,*) "Constructing a grid of lat-lons"
+      ENDIF
+
+   ELSE IF ((.NOT.ln_gridobs) .AND. (ln_physpace) .AND. (.NOT.ln_listobs)) THEN
+      IF ((phys_spacing .LE. 0) .OR.(phys_spacing .GE. earth_radius)) THEN
+         WRITE(6,*)'ERROR: phys_spacing must be greater than 0 and less than 6371km.'
+      ELSE
+        nlats = INT(pi * earth_radius / phys_spacing)
+        IF (MOD(nlats,2)==0) nlats=nlats-1   ! Ensure nlats is odd to have even number around equator.  
+        lat_step = 180.0_fbdp / (nlats-1)
+        nobs=0
+        current_lat=0.0_fbdp
+        ! Sum up number of lons at each latitude
+        DO i=1,(nlats-1)/2
+           current_lat = current_lat + lat_step * (pi/180.0_fbdp)
+           nobs = nobs + INT(2.0_fbdp * pi * earth_radius * cos(current_lat) / phys_spacing) 
+        END DO
+        nobs = nobs * 2 + INT(2.0_fbdp * pi * earth_radius / phys_spacing)
+        WRITE(*,*) "Using a physical seperation of ~", INT(phys_spacing),"km"
+      END IF
+
+   ELSE IF ((.NOT.ln_gridobs) .AND. (.NOT.ln_physpace) .AND. (ln_listobs)) THEN
+      IF( nobs .LE. 0 ) THEN
+         WRITE(6,*)'ERROR: nobs must be greater than 0'
+      ENDIF
+      WRITE(*,*) "Constructing a list of lat-lons"
+   ELSE
+      WRITE(*,*)'ERROR: one (and only one) of the logical flags must be true!'
+      CALL abort 
+   ENDIF
+
+
+   ALLOCATE(dates(nobs),       	&
+	    		times(nobs),       	&
+	    		julian_dates(nobs),  &
+	    		lats(nobs),	       	&
+	    		lons(nobs),	       	&
+	    		deps(nlev),        	&
+	    		variable(nvar),    	&
+	    		variable_longname(nvar),   &
+	    		variable_units(nvar),&
+	    		vals(nlev,nobs,nvar),&
+	    		model_vals(nlev,nobs,nvar),&
+				STAT=ierr          	&
+	    		)
+	IF (ierr /= 0) THEN
+		WRITE(*,*) "Could not allocate observation arrays:"
+		WRITE(*,*) "dates(", nobs, ")"
+		WRITE(*,*) "times(", nobs, ")"
+		WRITE(*,*) "lats(", nobs, ")"
+		WRITE(*,*) "lons(", nobs, ")"
+		WRITE(*,*) "deps(", nlev, ")"
+		WRITE(*,*) "variable(", nvar, ")"
+		WRITE(*,*) "variable_longname(", nvar, ")"
+		WRITE(*,*) "variable_units(", nvar, ")"
+		WRITE(*,*) "vals(", nlev, nobs, nvar, ")"
+		WRITE(*,*) "model_vals(", nlev, nobs, nvar, ")"
+
+		CALL abort
+	END IF			    
+	    
+		 
+   !!!! set up default values and read in namelist namfbgen.in !!!!!!!!!!!!!!!!!!!!
+   ntyp=-1
+   lats(:) = FillValue_real
+   lons(:) = FillValue_real
+   deps(:) = FillValue_real
+   times(:) = FillValue_int
+   dates(:) = FillValue_int
+   vals(:,:,:) = FillValue_real
+   model_vals(:,:,:) = FillValue_real
+   variable=REPEAT('X',ilenwmo)
+   variable_longname=REPEAT('X',ilenwmo)
+   variable_units=REPEAT('X',ilenwmo)
+   cdwmo=REPEAT('X',ilenwmo)  !station identifier
+   cdtyp="90"    !station type
+
+   WRITE(*,*) "Creating a fdbk file with", nobs, "observations"
+   WRITE(*,*) "with", nvar, "variables and",nlev, "depths."
+
+   OPEN(10,file='namfbgen.in')
+   READ(10,namfbgenerate)
+   CLOSE(10)
+	
+	! Use bounds to construct the full arrays of coords and values
+
+   IF (ln_physpace) THEN
+      CALL set_spatial_coords_physpace(lats,lons,nobs,FillValue_real,phys_spacing)
+   ELSE IF (ln_gridobs) THEN
+      CALL set_spatial_coords_grid(lats,lons,nobs,nlats,nlons,FillValue_real)
+   ELSE
+      CALL set_spatial_coords(lats,lons,nobs,FillValue_real)
+   END IF
+   
+   ! Add random perturbation to position if ln_perturb_posn=.TRUE.   
+   IF (ln_perturb_posn) CALL perturb_positions(lats,lons,perturb_limit)
+   
+   CALL set_datetime(dates,times,julian_dates,nobs,FillValue_int)
+   CALL set_depths(deps,nlev,FillValue_real)
+   CALL set_obs_values(vals,nvar,nobs,nlev,FillValue_real)
+   CALL set_obs_values(model_vals,nvar,nobs,nlev,FillValue_real)
+
+
+   !nadd=1	! Hx
+   next=0	! e.g. TEMP 
+	! Add TEMP as extra variable if POTM is defined.
+	DO i=1,nvar
+		IF (variable(i)(1:4) == "POTM") THEN
+		   next=1	! e.g. If set to zero, will not add extra TEMP variable			
+			EXIT
+		END IF
+	END DO
+
+   CALL init_obfbdata(fbobsdata)
+   
+   !!!! Allocate the obfb type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+   CALL alloc_obfbdata( fbobsdata, nvar, nobs, nlev, nadd, next, .FALSE.)
+   
+   !!!! Read data specified in the namelist into obfd type!!!!!!!!!!!!!!!
+	    
+   fbobsdata%cname = variable(:)
+	fbobsdata%coblong = variable_longname(:)
+	fbobsdata%cobunit = variable_units(:)
+   fbobsdata%cdjuldref = "19500101000000"
+   fbobsdata%cdwmo = cdwmo
+   fbobsdata%cdtyp = cdtyp
+	
+   ! Add model counterpart values if nadd=1
+	IF (nadd > 0) THEN
+		IF (nadd /= 1) THEN
+			CALL abort
+			WRITE(*,*) "Not set-up to add more than 1 additional variable."
+		ELSE
+			fbobsdata%caddname = "Hx"
+   		fbobsdata%caddlong(1,:) = "Model interpolated " // variable_longname(:)
+   		fbobsdata%caddunit(1,:) = variable_units(:)
+         fbobsdata%padd(:,:,1,:)=model_vals(:,:,:)
+		END IF
+	END IF
+	
+	! Add TEMP as extra variable if POTM is defined.
+	IF (next==1) THEN
+		fbobsdata%cextname = "TEMP"
+	END IF
+	
+   ! set up pos/time variables
+   fbobsdata%plam(:)=lons(:)
+   fbobsdata%pphi(:)=lats(:)
+	DO i=1,nobs 
+      fbobsdata%pdep(:,i)=deps(:)
+   END DO
+
+   
+   fbobsdata%ptim(:)= julian_dates(:)
+   
+   ! Shuffle the time array to spread the profiles across the time period
+   IF (ln_shuffletimes) CALL shuffle(fbobsdata%ptim)
+
+   ! read in variable data and flags
+   fbobsdata%ivqc(:,:)=1
+   fbobsdata%ivqcf(:,:,:)=1
+   fbobsdata%ivlqc(:,:,:)=1
+   fbobsdata%pob(:,:,:)=vals(:,:,:)
+
+   !set up all QC flags
+   fbobsdata%ioqc(:)=1
+   fbobsdata%ioqcf(:,:)=0
+   fbobsdata%ipqc(:)=1  
+   fbobsdata%ipqcf(:,:)=0 
+   fbobsdata%idqc(:,:)=1		!0
+   fbobsdata%idqcf(:,:,:)=0
+   fbobsdata%itqc(:)=1
+   fbobsdata%kindex(:)=0
+   
+   !!!! Write out the obfb type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+	
+   CALL write_obfbdata(TRIM(filenameout),fbobsdata)
+
+   DEALLOCATE(dates,       &
+              times,       &
+              julian_dates,&
+	    		  lats,	      &
+	    		  lons,	      &
+	    		  deps,        &
+	    		  variable,    &
+	    		  variable_longname,    &
+	    		  variable_units,       &
+	    		  vals,        &
+	    		  model_vals   &
+	    		  )
+
+	END IF !test prog
+
+
+END PROGRAM fbgenerate
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate_coords.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate_coords.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate_coords.F90	(revision 8732)
@@ -0,0 +1,509 @@
+MODULE fbgenerate_coords
+USE obs_fbm
+USE date_utils
+
+CONTAINS
+
+   REAL(KIND=fbdp) FUNCTION fb_dates(timein,datein) 
+      IMPLICIT NONE   
+      INTEGER, INTENT(IN) :: timein 	! Format: HHMM
+		INTEGER, INTENT(IN) :: datein 	! Format: YYYYMMDD
+      INTEGER :: iyea,imon,iday
+      INTEGER :: ihr,imin,isec
+  
+      iyea=datein/10000
+      imon=datein/100-iyea*100
+      iday=datein-iyea*10000-imon*100
+		
+		ihr = timein/100
+		imin = timein - ihr*100
+		isec = 0
+		
+      CALL greg2jul(isec,imin,ihr,iday,imon,iyea,fb_dates)
+   
+   END FUNCTION fb_dates
+
+
+
+	SUBROUTINE set_spatial_coords(lats,lons,n,FillVal)
+	IMPLICIT NONE	
+	INTEGER :: i, j, k, p, nlats, nlons, nlats_in_list, nlons_in_list
+	INTEGER, INTENT(IN) :: n
+	REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+	REAL(KIND=fbdp) :: FillVal 
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	
+	!Find number of lats and lons
+	! by finding number of non-FillVal entries in arrays
+	! and expanding bounds if necessary
+	
+	nlats_in_list = last_element(lats,FillVal)
+	nlons_in_list = last_element(lons,FillVal)
+
+   !Expand bounds only if 3 values given and number obs>3
+	IF (nlats_in_list == 1) THEN
+		lats(1:nlats) = lats(1)
+	ELSE IF ((nlats_in_list==3).AND.((n>3))) THEN ! Treat as list of three, not bounds
+		CALL expand_bounds(lats, FillVal)
+	END IF
+
+	IF (nlons_in_list == 1) THEN
+		lons(1:nlons) = lons(1)
+	ELSE IF ((nlons_in_list==3).AND.((n>3))) THEN ! Treat as list of three, not bounds
+		CALL expand_bounds(lons, FillVal)
+	END IF
+
+	nlats = last_element(lats,FillVal)
+	nlons = last_element(lons,FillVal)
+	
+	IF ((n /= nlats) .AND. (n /= nlons)) THEN
+		WRITE(*,*) "ERROR: Number of lat/lons not equal to nobs", nlats, nlons, n
+		CALL abort	
+	END IF
+	
+	END SUBROUTINE set_spatial_coords
+
+
+	SUBROUTINE set_spatial_coords_grid(lats,lons,n,nlats,nlons,FillVal)
+	IMPLICIT NONE	
+	INTEGER :: i, j, k, p, nlats_in_list, nlons_in_list
+	INTEGER, INTENT(IN) :: n, nlats, nlons
+	REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+	REAL(KIND=fbdp), ALLOCATABLE :: tmp_lats(:), tmp_lons(:)
+	REAL(KIND=fbdp) :: FillVal 
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	
+	!Find number of lats and lons in list
+	! by finding number of non-FillVal entries in arrays
+	! and then expand bounds if necessary
+	
+	nlats_in_list = last_element(lats,FillVal)
+	nlons_in_list = last_element(lons,FillVal)
+	
+   !Expand bounds only if 3 values given and number lats (or lons) not equal to 3
+	IF (nlats_in_list == 1) THEN
+		lats(1:nlats) = lats(1)
+	ELSE IF ((nlats_in_list==3).AND.((nlats>3))) THEN ! Treat as bounds
+		CALL expand_bounds(lats, FillVal)
+	END IF
+
+	IF (nlons_in_list == 1) THEN
+		lons(1:nlons) = lons(1)
+	ELSE IF ((nlons_in_list==3).AND.((nlons>3))) THEN ! Treat as bounds
+		CALL expand_bounds(lons, FillVal)
+	END IF
+
+	nlats_in_list = last_element(lats,FillVal)
+	nlons_in_list = last_element(lons,FillVal)
+
+
+	IF ((nlats_in_list * nlons_in_list) == n) THEN
+		ALLOCATE(tmp_lons(n))
+		ALLOCATE(tmp_lats(n))
+		k = 0
+		p = 0
+		DO i = 1, nlats
+		   p = p + 1
+			DO j = 1, nlons
+				k = k + 1
+				tmp_lons(k) = lons(j)   
+				tmp_lats(k) = lats(p)   
+			END DO
+		END DO
+		lats(:) = tmp_lats(:)
+		lons(:) = tmp_lons(:)
+		DEALLOCATE(tmp_lons)
+		DEALLOCATE(tmp_lats)
+	ELSE 
+		WRITE(*,*) 
+		WRITE(*,*) "ERROR: Number of lat * lon values not equal to nobs", nlats_in_list, nlons_in_list, n
+		CALL abort	
+	END IF
+	
+	END SUBROUTINE set_spatial_coords_grid
+
+
+	SUBROUTINE set_spatial_coords_physpace(lats,lons,n,FillVal,phys_spacing)
+	IMPLICIT NONE	
+	INTEGER :: i, j, k, nlats, nlons
+	INTEGER, INTENT(IN) :: n
+	REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+	REAL(KIND=fbdp), ALLOCATABLE :: tmp_lats(:)
+	REAL(KIND=fbdp) :: FillVal 
+   REAL(KIND=fbdp), PARAMETER :: earth_radius = 6371.0_fbdp ! km
+   REAL(KIND=fbdp), PARAMETER :: pi = 3.141592654_fbdp
+	REAL(KIND=fbdp), INTENT(IN) :: phys_spacing
+   REAL(KIND=fbdp) :: lat_step
+	
+	! Use physical spacing to set lats and lons
+
+   nlats = INT(pi * earth_radius / phys_spacing)
+   IF (MOD(nlats,2)==0) nlats=nlats-1   ! Ensure nlats is odd to have even number around equator.  
+      
+   ALLOCATE(tmp_lats(nlats))
+
+   lat_step = 180.0_fbdp / (nlats-1)
+
+   tmp_lats(1) = 0.0_fbdp
+   DO i=1,(nlats-1)/2
+      tmp_lats(i+1) = tmp_lats(i) + lat_step
+      tmp_lats(((nlats-1)/2)+i+1) = tmp_lats(i+1) * (-1.0_fbdp)
+   END DO
+
+   k = 0
+   DO i=1,nlats
+      nlons = INT(2.0_fbdp * pi * earth_radius * cos(tmp_lats(i)* (pi/180.0_fbdp)) / phys_spacing)
+      IF (nlons>0) THEN
+         DO j = 1, nlons
+            k = k + 1
+            lons(k) = REAL(j-1) * 360.0_fbdp / nlons
+            lats(k) = tmp_lats(i)
+         END DO
+      END IF
+   END DO
+   DEALLOCATE(tmp_lats)
+	
+	END SUBROUTINE set_spatial_coords_physpace
+
+
+	SUBROUTINE expand_bounds(array, fillval)
+	!
+	! Checks if there are three entries and expands bounds.
+	!
+	IMPLICIT NONE
+	INTEGER :: i, nentries
+	REAL(KIND=fbdp), INTENT(INOUT) :: array(:)
+	REAL(KIND=fbdp), INTENT(IN) :: fillval
+	REAL(KIND=fbdp) :: nsteps, start, step
+
+	! Find number of elements given in list
+	nentries = last_element(array, fillval)
+
+	IF (nentries==3) THEN 			! Bounds given	
+		nsteps = (array(2) - array(1)) /  array(3) 
+	   IF ((array(2) < array(1)) .AND. (array(3) >= 0.0)) THEN
+		   WRITE(*,*) "Error: if upper bound is less than lower bound, step must be negative.", array
+			CALL abort
+		ELSE IF ( NINT(nsteps)+1 > SIZE(array) ) THEN
+		   WRITE(*,*) "Error: bounds not compatible with length of array.", array
+		   WRITE(*,*) "Error: bounds not compatible with length of array.", nsteps
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,NINT(nsteps)+1
+			array(i) = start + (i-1)*step 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE expand_bounds
+
+
+
+	INTEGER FUNCTION last_element(array,fillval)
+	!
+	! Returns index of the last non-fill value element in a list
+	! Will return 1, even in first element is the FillValue
+	!
+	IMPLICIT NONE
+	REAL(KIND=fbdp), INTENT(IN) :: array(:), fillval
+	INTEGER :: i
+
+	last_element = 1
+	IF (SIZE(array) > 1) THEN
+		DO i=2, SIZE(array)
+			IF (array(i) /= fillval) THEN 
+				last_element = i
+			END IF
+		END DO
+	END IF
+		
+	END FUNCTION last_element
+
+
+
+	SUBROUTINE set_depths(array,n,FillVal)
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	REAL(KIND=fbdp), INTENT(INOUT) :: array(:)
+	REAL(KIND=fbdp) :: FillVal
+	REAL(KIND=fbdp) :: start, step, nstep
+	! Top bound not necessarily inclusive - will use start, step and number of obs
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	IF (n==1) THEN
+		array(:) = array(1)
+	ELSE IF ((n > 1) .AND. (array(2)==FillVal)) THEN
+		array(:) = array(1)
+	ELSE IF ((n==2) .AND. (array(2)/=FillVal)) THEN
+		array(:) = array(:)
+	ELSE IF (n==3) THEN ! Treat as list of three, not bounds
+		array(:) = array(:)
+	ELSE IF ((n>=4) .AND. (array(4)==FillVal)) THEN ! Assume start, stop, step
+		nstep = (array(2) - array(1)) /  array(3) 
+	   IF ((array(2) < array(1)) .AND. (array(3) >= 0.0)) THEN
+		   WRITE(*,*) "Error: if upper bound is less than lower bound, step must be negative.", array
+			CALL abort
+		ELSE IF ( ( nstep < (0.99 * real(n-1)) ) .OR. &
+		          ( nstep > (1.01 * real(n-1)) ) ) THEN
+		   WRITE(*,*) "Error: depth bounds not compatible.", array
+		   WRITE(*,*) "Error: depth bounds not compatible.", nstep
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,n
+			array(i) = start + (i-1)*step 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE set_depths
+
+
+
+
+
+	SUBROUTINE set_datetime(date,time,julian_date,n,FillVal)
+	!
+	! Transform input array from m values describing n dates to a list of n dates.
+	!
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	INTEGER, INTENT(INOUT) :: date(:), time(:)
+	INTEGER :: FillVal
+	REAL(KIND=fbdp), INTENT(INOUT) :: julian_date(:)
+	REAL(KIND=fbdp) :: start, step, finish
+
+   ! Check if user has supplied start and end times to be split amongst number of obs
+   ! (i.e. more than 2 obs, but only 2 dates and 2 times given.)
+   IF ((n>2) .AND. (date(2)/=FillVal) .AND. (date(3)==FillVal) &
+      &      .AND. (time(2)/=FillVal) .AND. (time(3)==FillVal)) THEN
+      
+      !work out JD of each
+      start = fb_dates(time(1),date(1)) 
+      finish = fb_dates(time(2),date(2)) 
+
+      ! use info to calc step
+      step = ( finish - start ) / n
+      ! calc all JDs and put output in dates
+      DO i=1,n 
+	      ! Could make this an elemental function if dateutils were pure funcs
+         julian_date(i)= start + (i-1)*step
+      END DO
+
+   ELSE
+      CALL set_date(date,n,FillVal)
+      CALL set_time(time,n,FillVal)
+      ! Replace dates with JD including time info
+      DO i=1,n 
+	      ! Could make this an elemental function if dateutils were pure funcs
+         julian_date(i)= fb_dates(time(i),date(i))
+      END DO
+   END IF
+
+
+	END SUBROUTINE set_datetime
+
+
+	SUBROUTINE set_date(array,n,FillVal)
+	!
+	! Transform input array from m values describing n dates to a list of n dates.
+	!
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	INTEGER, INTENT(INOUT) :: array(:)
+	INTEGER :: FillVal
+	INTEGER :: start, step, diff
+	! Top bound not necessarily inclusive - will use start, step and number of obs
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	IF (n==1) THEN
+		array(:) = array(1)
+	ELSE IF ((n > 1) .AND. (array(2)==FillVal)) THEN
+		array(:) = array(1)
+	ELSE IF ((n==2) .AND. (array(2)/=FillVal)) THEN
+		array(:) = array(:)
+	ELSE IF (n==3) THEN ! Treat as list of three, not bounds
+		array(:) = array(:)
+	ELSE IF ((n>=4) .AND. (array(4)==FillVal)) THEN ! Assume start, stop, step
+   	diff = diffdate(array(2),array(1))	! in number of days
+	   IF ((array(2) < array(1)) .AND. (array(3) >= 0)) THEN
+		   WRITE(*,*) "Error: if upper bound is less than lower bound, step must be negative.", array
+			CALL abort
+		ELSE IF ( ( diff / ABS(array(3)) ) /= (n-1) ) THEN
+		   WRITE(*,*) "Error: date bounds not compatible.", array
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,n
+			CALL add_days_to_date(start,(i-1)*step,array(i)) 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE set_date
+
+
+
+	SUBROUTINE set_time(array,n,FillVal)
+	!
+	! Transform input array from m (m<=n) values describing n times to a list of n times.
+	!
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	INTEGER, INTENT(INOUT) :: array(:)
+	INTEGER :: FillVal
+	INTEGER :: start, step, nstep
+	! Top bound not necessarily inclusive - will use start, step and number of obs
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	IF (n==1) THEN
+		array(:) = array(1)
+	ELSE IF ((n > 1) .AND. (array(2)==FillVal)) THEN
+		array(:) = array(1)
+	ELSE IF ((n==2) .AND. (array(2)/=FillVal)) THEN
+		array(:) = array(:)
+	ELSE IF (n==3) THEN ! Treat as list of three, not bounds
+		array(:) = array(:)
+	ELSE IF ((n>=4) .AND. (array(4)==FillVal)) THEN ! Assume start, stop, step
+		IF (array(3)<0) nstep = difftime(array(2),array(1)) / ABS(array(3)) 
+		IF (array(3)>=0) nstep = difftime(array(1),array(2)) / ABS(array(3)) 
+		IF ( nstep /= (n-1) ) THEN
+		   WRITE(*,*) "Error: time bounds not compatible.", array
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,n
+			array(i) = add_mins_to_time(start,(i-1)*step) 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE set_time
+	
+	
+
+	SUBROUTINE set_obs_values(array,p,n,m,FillVal)
+	!
+	! n profiles at m depths
+	!
+	IMPLICIT NONE	
+	INTEGER :: i, j, k
+	INTEGER, INTENT(IN) :: n, m, p
+	REAL(KIND=fbdp), INTENT(INOUT) :: array(:,:,:) 			! (nlevels, nprofiles, nvars) = (m,n,p)
+	REAL(KIND=fbdp) :: FillVal 
+	
+	
+	DO k=1,p
+	   IF ((k > 1) .AND. (array(1,1,k) == FillVal)) THEN  ! set to same values as first variable
+			array(:,:,k) = array(:,:,1)
+		ELSE
+			IF ((n==1).AND.(m==1)) THEN
+				array(:,:,k) = array(1,1,k)
+
+			! If mult depths, but not specified, set all to one value	
+			ELSE IF ((m > 1) .AND. (array(2,1,k) == FillVal)) THEN
+				array(:,:,k) = array(1,1,k)
+
+			! If mult profiles and mult depths and only one value set in first profile	
+			ELSE IF ((n > 1) .AND. (m > 1) .AND. (array(2,1,k) == FillVal)) THEN
+				array(:,:,k) = array(1,1,k)
+				
+			! If mult profiles and mult depths and only one first profile set	
+			ELSE IF ((n > 1) .AND. (m > 1) .AND. (array(1,2,k) == FillVal)) THEN
+				DO j=1,m
+					array(j,:,k) = array(j,1,k)
+				END DO
+				
+			ELSE 
+	   		array(:,:,k) = array(:,:,k)
+			END IF
+		END IF
+	END DO	
+	
+	END SUBROUTINE set_obs_values
+
+
+   ! Unbiased shuffle of array
+   SUBROUTINE shuffle(a)
+   REAL(KIND=fbdp), INTENT(INOUT) :: a(:)
+   INTEGER :: i, randpos
+   REAL(KIND=fbdp) :: r, temp
+
+   CALL random_seed()
+   DO i = SIZE(a), 2, -1
+      CALL random_number(r)
+      randpos = int(r * i) + 1
+      temp = a(randpos)
+      a(randpos) = a(i)
+      a(i) = temp
+   END DO
+   
+   END SUBROUTINE shuffle
+   
+   
+   ! Add a random perturbation to the lats and lons
+   ! Perturbation is sampled from a uniform distribution +/-perturb_limit
+   SUBROUTINE perturb_positions(lats,lons,perturb_limit)
+   INTEGER :: i
+   REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+   REAL(KIND=fbdp), INTENT(IN) :: perturb_limit
+   REAL(KIND=fbdp) :: randpos, lat_perturb, lon_perturb
+   REAL(KIND=fbdp), PARAMETER :: earth_radius = 6371.0_fbdp
+   REAL(KIND=fbdp), PARAMETER :: pi = 3.141592654_fbdp
+   
+ 	IF ( SIZE(lats) /= SIZE(lons) ) THEN
+		WRITE(*,*) "Error: different number of lat and lon elements", SIZE(lats), SIZE(lons)
+		CALL abort
+	END IF
+
+   CALL random_seed()
+   
+   ! Convert physical sep into a latidue sep in degrees
+   lat_perturb = 360.0_fbdp * perturb_limit / (2.0_fbdp * pi * earth_radius)
+   
+   DO i=1,SIZE(lats)
+   
+      ! Perturb lats first, as lon conversion uses lat
+      CALL random_number(randpos)
+      lats(i) = lats(i) + randpos*lat_perturb
+      IF (lats(i) > 90.0_fbdp) lats(i) = 180.0_fbdp - lats(i) 
+      IF (lats(i) < -90.0_fbdp) lats(i) = (lats(i) + 180.0_fbdp) * (-1.0_fbdp)
+      
+      ! Use lat to convert physical size to delta_longitude   
+      IF (ABS(lats(i)) == 90.0_fbdp) THEN 
+         lon_perturb = 0.0_fbdp
+      ELSE
+         lon_perturb = 360.0_fbdp * perturb_limit / (2.0_fbdp * pi * earth_radius * cos(lats(i)*(pi/180.0_fbdp)))
+      END IF
+      CALL random_number(randpos)
+      lons(i) = lons(i) + randpos*lon_perturb
+      IF (lons(i) >= 360.0_fbdp) lons(i) = lons(i) - 360.0_fbdp 
+      IF (lons(i) < 0.0_fbdp) lons(i) = lons(i) + 360.0_fbdp 
+   
+   END DO
+   
+   END SUBROUTINE perturb_positions
+    
+END MODULE fbgenerate_coords
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90	(revision 8732)
@@ -0,0 +1,477 @@
+PROGRAM fbmatchup
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbmatchup **
+   !!
+   !!  ** Purpose : Find matching obs in feedback files
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !! 
+   !!   Usage:
+   !!     fbmatchup.exe outputfile inputfile1 varname1 inputfile2 varname2 ...
+   !!
+   !!   Optional: 
+   !!     namelist = namfbmatchup.in       to set ldaily820
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind
+   USE obs_fbm
+   USE index_sort
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   CHARACTER(len=ilenname),ALLOCATABLE :: cdnames(:)
+   CHARACTER(len=2*ilenname) :: cdtmp
+   LOGICAL :: ldaily820
+   NAMELIST/namfbmatchup/ldaily820
+   !
+   ! Input data
+   !
+   TYPE(obfbdata)         :: obsdatatmp(1)
+   TYPE(obfbdata),POINTER :: obsdata(:)
+   INTEGER :: ninfiles,ntotobs,nlev,nadd,next
+   !
+   ! Time sorting arrays
+   !
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Comparison arrays and scalars
+   !
+   REAL(KIND=fbsp), ALLOCATABLE :: zrtim(:),zrphi(:),zrlam(:)
+   INTEGER(KIND=SELECTED_INT_KIND(12)), ALLOCATABLE :: irwmo(:)
+   REAL(KIND=fbsp) :: ztim,zphi,zlam
+   INTEGER(KIND=SELECTED_INT_KIND(12)) :: iwmo
+   LOGICAL, ALLOCATABLE :: ltaken(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: obsoutdata
+   !
+   ! Storage for extra to search for unique.
+   !
+   CHARACTER(len=ilenname), ALLOCATABLE :: cexttmp(:)
+   TYPE extout
+      LOGICAL, POINTER, DIMENSION(:) :: luse
+      INTEGER, POINTER, DIMENSION(:) :: ipos
+   END TYPE extout
+   TYPE(extout), POINTER, DIMENSION(:) :: pextinf
+   !
+   ! Loop variables
+   !
+   INTEGER :: ifi,ia,ip,i1,ii,ij,ik1,ik2,iv,ist,iadd,ie,iext
+   LOGICAL :: llfound
+   LOGICAL :: lexists,lnotobs
+   INTEGER :: ityp
+   !
+   ! Get number of command line arguments
+   !
+   nargs = IARGC()
+   IF ( ( MOD(nargs,2) /= 1 ) .OR. ( nargs == 0 )  ) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbmatchup outputfile inputfile1 varname1 inputfile2 varname2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg( 1, cdoutfile )
+   !
+   ! Read namelist if present
+   !
+   ldaily820=.FALSE.
+   INQUIRE(file='namfbmatchup.in',exist=lexists)
+   IF (lexists) THEN
+      OPEN(10,file='namfbmatchup.in')
+      READ(10,namfbmatchup)
+      CLOSE(10)
+      WRITE(*,namfbmatchup)
+   ENDIF
+   !
+   ! Get input data
+   !
+   ninfiles = ( nargs -1 ) / 2
+   ALLOCATE( obsdata( ninfiles ) )
+   ALLOCATE( cdinfile( ninfiles ) )
+   ALLOCATE( cdnames( ninfiles ) )
+   ip = 1
+   DO ifi = 1, ninfiles
+      !
+      ! Read the unsorted file
+      !
+      ip = ip + 1
+      CALL getarg( ip, cdinfile(ifi) )
+      ip = ip + 1
+      CALL getarg( ip, cdnames(ifi) )
+      CALL init_obfbdata( obsdatatmp(1) )
+      CALL read_obfbdata( TRIM(cdinfile(ifi)), obsdatatmp(1) )
+      !
+      ! Check if we have fewer levels than in the first file
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nlev > obsdata(1)%nlev ) THEN
+            WRITE(*,*)'Warning. More levels in file than the first file'
+            WRITE(*,*)'Number of levels in current file = ', obsdatatmp(1)%nlev
+            WRITE(*,*)'Number of levels in first file   = ', obsdata(1)%nlev
+            WRITE(*,*)'Only the number of levels in the first'//&
+               &' file will be used'
+         ENDIF
+      ENDIF
+      !
+      ! Check if we have fewer observations than in the first file
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nobs > obsdata(1)%nobs ) THEN
+            WRITE(*,*)'Warning. More obs in file than the first file'
+            WRITE(*,*)'Number of obs in current file = ', obsdatatmp(1)%nobs
+            WRITE(*,*)'Number of obs in first file   = ', obsdata(1)%nobs
+            WRITE(*,*)'Only the observations in the first'//&
+               &' file will be stored'
+         ENDIF
+      ENDIF
+      !
+      ! Check that we have the same number of variables
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nvar /= obsdata(1)%nvar ) THEN
+            WRITE(*,*)'Error. Different number of variables.'
+            WRITE(*,*)'Number of var in current file = ', obsdatatmp(1)%nvar
+            WRITE(*,*)'Number of var in first file   = ', obsdata(1)%nvar
+            CALL abort
+         ENDIF
+      ENDIF
+      !
+      ! Check reference datas
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
+            WRITE(*,*)'Different reference dates'
+            CALL abort
+         ENDIF
+      ENDIF
+      !
+      ! Special fix for daily average MRB data (820) for the first file
+      !
+      IF (ldaily820.AND.(ifi==1)) THEN
+         DO ij = 1,obsdatatmp(1)%nobs
+            READ(obsdatatmp(1)%cdtyp(ij),'(I5)')ityp
+            IF (ityp==820) THEN
+               obsdatatmp(1)%ptim(ij)=INT(obsdatatmp(1)%ptim(ij))+1.0
+            ENDIF
+         ENDDO
+      ENDIF
+      !
+      ! Construct sorting arrays
+      !
+      ALLOCATE( zsort(3,obsdatatmp(1)%nobs), iset(obsdatatmp(1)%nobs), &
+         & inum(obsdatatmp(1)%nobs), iindex(obsdatatmp(1)%nobs))
+      ii = 0
+      DO ij = 1,obsdatatmp(1)%nobs
+         ii = ii+1
+         zsort(1,ii) = obsdatatmp(1)%ptim(ij)
+         zsort(2,ii) = obsdatatmp(1)%pphi(ij)
+         zsort(3,ii) = obsdatatmp(1)%plam(ij)
+         iset(ii) = 1
+         inum(ii) = ij
+      ENDDO
+      !
+      ! Get indexes for time sorting.
+      !
+      CALL index_sort_dp_n(zsort,3,iindex,obsdatatmp(1)%nobs)
+      CALL init_obfbdata( obsdata(ifi) )
+      CALL alloc_obfbdata( obsdata(ifi), &
+         &                 obsdatatmp(1)%nvar, obsdatatmp(1)%nobs, &
+         &                 obsdatatmp(1)%nlev, obsdatatmp(1)%nadd, &
+         &                 obsdatatmp(1)%next, obsdatatmp(1)%lgrid )
+      !
+      ! Copy input data into output data
+      !
+      CALL merge_obfbdata( 1, obsdatatmp, obsdata(ifi), iset, inum, iindex )
+      CALL dealloc_obfbdata( obsdatatmp(1) )
+      
+      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ifi))
+      WRITE(*,'(A,I9,A)')'has', obsdata(ifi)%nobs, ' observations'
+
+      DEALLOCATE( zsort, iset, inum, iindex )
+
+   ENDDO
+   !
+   ! Prepare output data
+   ! 
+   CALL init_obfbdata( obsoutdata )
+   !
+   ! Count number of additional fields
+   !
+   nadd = 0
+   DO ifi = 1, ninfiles
+      nadd = nadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Count number of unique extra fields
+   !
+   ! First the maximum to construct list
+   next = 0
+   DO ifi = 1, ninfiles
+      next = next + obsdata(ifi)%next
+   ENDDO
+   ALLOCATE( &
+      & cexttmp(next) &
+      & )
+   ! Setup pextinf structure and search for unique extra fields
+   ALLOCATE( &
+      & pextinf(ninfiles) &
+      & )
+   next = 0
+   DO ifi = 1, ninfiles
+      ALLOCATE( &
+         & pextinf(ifi)%luse(obsdata(ifi)%next), &
+         & pextinf(ifi)%ipos(obsdata(ifi)%next)  &
+         & )
+      DO ie = 1, obsdata(ifi)%next
+         llfound = .FALSE.
+         DO ii = 1, next
+            IF ( cexttmp(ii) == obsdata(ifi)%cextname(ie) ) THEN
+               llfound = .TRUE.
+            ENDIF
+         ENDDO
+         IF (llfound) THEN
+            pextinf(ifi)%luse(ie) = .FALSE.
+            pextinf(ifi)%ipos(ie) = -1
+         ELSE
+            next = next + 1
+            pextinf(ifi)%luse(ie) = .TRUE.
+            pextinf(ifi)%ipos(ie) = next
+            cexttmp(next) = obsdata(ifi)%cextname(ie)
+         ENDIF
+      ENDDO
+   ENDDO
+   !
+   ! Copy the first input data to output data
+   !
+   CALL copy_obfbdata( obsdata(1), obsoutdata, &
+      &                kadd = nadd, kext = next )
+   ALLOCATE( ltaken(obsoutdata%nlev) )
+   iadd = 0
+   DO ifi = 1, ninfiles
+      DO ia = 1, obsdata(ifi)%nadd
+         cdtmp = TRIM(obsdata(ifi)%caddname(ia))//TRIM(cdnames(ifi))
+         obsoutdata%caddname(iadd+ia) = cdtmp(1:ilenname)
+         DO iv = 1, obsdata(ifi)%nvar
+            obsoutdata%caddlong(iadd+ia,iv) = obsdata(ifi)%caddlong(ia,iv)
+            obsoutdata%caddunit(iadd+ia,iv) = obsdata(ifi)%caddunit(ia,iv)
+         ENDDO
+      ENDDO
+      DO ie = 1, obsdata(ifi)%next
+         IF ( pextinf(ifi)%luse(ie) ) THEN
+            obsoutdata%cextname(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextname(ie)
+            obsoutdata%cextlong(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextlong(ie)
+            obsoutdata%cextunit(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextunit(ie)
+         ENDIF
+      ENDDO
+      iadd = iadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Allocate comparison arrays and file them
+   ! 
+   IF (ilenwmo>8) THEN
+      WRITE(*,*)'Fix fbmatchup to allow string length > 8'
+      CALL abort
+   ENDIF
+   ALLOCATE(zrtim(obsoutdata%nobs),zrphi(obsoutdata%nobs), &
+      &     zrlam(obsoutdata%nobs),irwmo(obsoutdata%nobs))
+   DO i1 = 1, obsoutdata%nobs
+      irwmo(i1) = TRANSFER( obsoutdata%cdwmo(i1), irwmo(i1) )
+      zrtim(i1) = REAL( obsoutdata%ptim(i1), fbsp )
+      zrphi(i1) = REAL( obsoutdata%pphi(i1), fbsp )
+      zrlam(i1) = REAL( obsoutdata%plam(i1), fbsp ) 
+   ENDDO
+   !
+   ! Merge extra data into output data
+   !
+   iadd = obsdata(1)%nadd
+   DO ifi = 2, ninfiles
+      ist = 1
+      DO ii = 1, obsdata(ifi)%nobs
+         IF (MOD(ii,10000)==1) THEN
+            WRITE(*,*)'Handling observation no ',ii,' for file no ',ifi
+         ENDIF
+         llfound = .FALSE.
+         iwmo = TRANSFER( obsdata(ifi)%cdwmo(ii), iwmo )
+         ztim = REAL( obsdata(ifi)%ptim(ii), fbsp )
+         zphi = REAL( obsdata(ifi)%pphi(ii), fbsp )
+         zlam = REAL( obsdata(ifi)%plam(ii), fbsp ) 
+         ! Check if the the same index is the right one.
+         IF ( iwmo == irwmo(ii) ) THEN
+            IF ( ztim == zrtim(ii) ) THEN
+               IF (  zphi == zrphi(ii) ) THEN
+                  IF ( zlam == zrlam(ii) ) THEN
+                     llfound = .TRUE.
+                     i1 = ii
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+         ! Search for position in from previous found position
+         ! if not the same index
+         IF (.NOT.llfound) THEN
+            DO i1 = ist, obsoutdata%nobs
+               IF ( iwmo == irwmo(i1) ) THEN
+                  IF ( ztim == zrtim(i1) ) THEN
+                     IF (  zphi == zrphi(i1) ) THEN
+                        IF ( zlam == zrlam(i1) ) THEN
+                           llfound = .TRUE.
+                           EXIT
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+         ! If not fount try agan from the beginnning
+         IF ( .NOT.llfound ) THEN
+            DO i1 = 1, obsoutdata%nobs
+               IF ( iwmo == irwmo(i1) ) THEN
+                  IF ( ztim == zrtim(i1) ) THEN
+                     IF (  zphi == zrphi(i1) ) THEN
+                        IF ( zlam == zrlam(i1) ) THEN
+                           llfound = .TRUE.
+                           EXIT
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+         ! If found put the data into the common structure
+         IF (llfound) THEN
+            obsoutdata%ioqc(i1) = & 
+               & MAX( obsoutdata%ioqc(i1), obsdata(ifi)%ioqc(ii) )
+            obsoutdata%ipqc(i1) = &
+               & MAX( obsoutdata%ipqc(i1), obsdata(ifi)%ipqc(ii) )
+            obsoutdata%itqc(i1) = &
+               & MAX( obsoutdata%itqc(i1), obsdata(ifi)%itqc(ii) )
+            obsoutdata%ivqc(i1,:) = &
+               & MAX( obsoutdata%ivqc(i1,:), obsdata(ifi)%ivqc(ii,:) )
+            obsoutdata%ioqcf(:,i1)   = IOR( obsdata(ifi)%ioqcf(:,ii), &
+               &                            obsoutdata%ioqcf(:,i1) )
+            obsoutdata%ipqcf(:,i1)   = IOR( obsdata(ifi)%ipqcf(:,ii), &
+               &                            obsoutdata%ipqcf(:,i1) )
+            obsoutdata%itqcf(:,i1)   = IOR( obsdata(ifi)%itqcf(:,ii), &
+               &                            obsoutdata%itqcf(:,i1) )
+            obsoutdata%ivqcf(:,i1,:) = IOR( obsdata(ifi)%ivqcf(:,ii,:), &
+               &                            obsoutdata%ivqcf(:,i1,:) )
+            llfound = .FALSE.
+            ! Search for levels 
+            ltaken(:) = .FALSE.
+            DO ik1 = 1, obsdata(ifi)%nlev
+               levloop : DO ik2 = 1, obsoutdata%nlev
+                  IF ( REAL( obsdata(ifi)%pdep(ik1,ii), fbsp ) ==  &
+                     & REAL( obsoutdata%pdep(ik2,i1),  fbsp ) ) THEN
+                     lnotobs=.TRUE.
+                     IF (ltaken(ik2)) CYCLE
+                     DO iv = 1, obsdata(ifi)%nvar
+                        IF ( REAL( obsdata(ifi)%pob(ik1,ii,iv), fbsp ) == &
+                           & REAL( obsoutdata%pob(ik2,i1,iv), fbsp ) ) THEN
+                           lnotobs=.FALSE.
+                        ENDIF
+                     ENDDO
+                     IF (lnotobs) CYCLE levloop
+                     ltaken(ik2)=.TRUE.
+                     DO ia = 1, obsdata(ifi)%nadd
+                        obsoutdata%padd(ik2,i1,iadd+ia,:) = &
+                           & obsdata(ifi)%padd(ik1,ii,ia,:)
+                     ENDDO
+                     DO ie = 1, obsdata(ifi)%next
+                        IF ( pextinf(ifi)%luse(ie) ) THEN
+                           obsoutdata%pext(ik2,i1,pextinf(ifi)%ipos(ie)) = &
+                              & obsdata(ifi)%pext(ik1,ii,ie)
+                        ENDIF
+                     ENDDO
+                     obsoutdata%idqc(ik2,i1) = &
+                        & MAX( obsoutdata%idqc(ik2,i1), obsdata(ifi)%idqc(ik1,ii) )
+                     obsoutdata%ivlqc(ik2,i1,:) = &
+                        & MAX( obsoutdata%ivlqc(ik2,i1,:), obsdata(ifi)%ivlqc(ik1,ii,:) )
+                     obsoutdata%idqcf(:,ik2,i1)    = &
+                        &                IOR( obsdata(ifi)%idqcf(:,ik1,ii), &
+                        &                     obsoutdata%idqcf(:,ik2,i1) )
+                     obsoutdata%ivlqcf(:,ik2,i1,:) = &
+                        &                IOR( obsdata(ifi)%ivlqcf(:,ik1,ii,:), &
+                        &                     obsoutdata%ivlqcf(:,ik2,i1,:) )
+                     llfound = .TRUE.
+                     EXIT
+                  ENDIF
+               ENDDO levloop
+               ! Write warning if level not found
+               IF (.NOT.llfound.AND.(obsdata(ifi)%pdep(ik1,ii)/=fbrmdi)) THEN
+                  WRITE(*,*)'Level not found in first file : ',&
+                     &      TRIM( cdinfile(1)  )
+                  WRITE(*,*)'Data file                     : ',&
+                     &      TRIM( cdinfile(ifi) )
+                  WRITE(*,*)'Identifier                    : ',&
+                     &      obsdata(ifi)%cdwmo(ii)
+                  WRITE(*,*)'Julifin date                   : ',&
+                     &      obsdata(ifi)%ptim(ii)
+                  WRITE(*,*)'Latitude                      : ',&
+                     &      obsdata(ifi)%pphi(ii)
+                  WRITE(*,*)'Longitude                     : ',&
+                     &      obsdata(ifi)%plam(ii)
+                  WRITE(*,*)'Depth                         : ',&
+                     &      obsdata(ifi)%pdep(ik1,ii)
+               ENDIF
+            ENDDO
+            ist = i1
+         ELSE
+            ! Write warning if observation not found
+            WRITE(*,*)'Observation not found in first data file : ',&
+               &      TRIM( cdinfile(1)  )
+            WRITE(*,*)'Data file                                : ',&
+               &      TRIM( cdinfile(ifi) )
+            WRITE(*,*)'Identifier                               : ',&
+               &      obsdata(ifi)%cdwmo(ii)
+            WRITE(*,*)'Julifin date                              : ',&
+               &      obsdata(ifi)%ptim(ii)
+            WRITE(*,*)'Latitude                                 : ',&
+               &      obsdata(ifi)%pphi(ii)
+            WRITE(*,*)'Longitude                                : ',&
+               &      obsdata(ifi)%plam(ii)
+            ist = 1
+         ENDIF
+      ENDDO
+      IF (obsdata(ifi)%nobs>0) THEN
+         WRITE(*,*)'Handled last obs. no    ',ii,' for file no ',ifi
+      ENDIF
+      iadd = iadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Write output file
+   !
+   CALL write_obfbdata( TRIM(cdoutfile), obsoutdata )
+   !
+   ! Deallocate temporary data
+   ! 
+   DEALLOCATE(zrtim,zrphi,zrlam,irwmo )
+   DEALLOCATE( &
+      & cexttmp &
+      & )
+   DO ifi = 1, ninfiles
+      DEALLOCATE( &
+         & pextinf(ifi)%luse, &
+         & pextinf(ifi)%ipos  &
+         & )
+   ENDDO
+   DEALLOCATE( &
+      & pextinf &
+      & )
+
+END PROGRAM fbmatchup
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90	(revision 8732)
@@ -0,0 +1,536 @@
+PROGRAM fbprint
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbprint **
+   !!
+   !!  ** Purpose : Print feedback file contents as text
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage :
+   !!     fbprint.exe [options] inputfile
+   !!   Options :
+   !!     -b            shorter output
+   !!     -q            QC flags (nqc=1) select observations based on QC flags
+   !!     -Q            QC flags (nqc=2) select observations based on QC flags
+   !!     -B            QC flags (nqc=3) select observations based on QC flags
+   !!     -u            unsorted
+   !!     -s ID         select station ID  
+   !!     -t TYPE       select observation type
+   !!     -v NUM1-NUM2  select variable range to print by number (default all)
+   !!     -a NUM1-NUM2  select additional variable range to print by number (default all)
+   !!     -e NUM1-NUM2  select extra variable range to print by number (default all)
+   !!     -d            output date range
+   !!     -D            print depths
+   !!     -z            use zipped files
+   !! 
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind 
+   USE obs_fbm
+   USE index_sort
+   USE date_utils
+   USE proftools
+
+   IMPLICIT NONE
+   !
+   ! Command line arguments input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdinfile, cdbrief
+   LOGICAL :: lbrief, lqcflags, lstat, ltyp, lsort, ldaterange, lzinp, ldepths
+   CHARACTER(len=ilenwmo) :: cdstat
+   CHARACTER(len=ilentyp) :: cdtyp
+   INTEGER :: nqc
+   INTEGER :: nvar1, nvar2, nadd1, nadd2, next1, next2
+   !
+   ! Input data
+   !
+   TYPE(obfbdata) :: obsdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ii, iarg, ip
+   !
+   ! Sorting
+   !
+   INTEGER :: iwmo
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iindex(:)
+   !
+   ! Get number of command line arguments
+   !
+   nargs  = IARGC()
+   lbrief = .FALSE.
+   lstat = .FALSE.
+   ltyp = .FALSE.
+   ldaterange = .FALSE.
+   ldepths = .FALSE.
+   cdstat = 'XXXXXXX'
+   cdtyp = 'XXXX'
+   lsort = .TRUE.
+   nqc = 0
+   nvar1 = -1
+   nvar2 = -1
+   nadd1 = -1
+   nadd2 = -1
+   next1 = -1
+   next2 = -1
+   lzinp = .FALSE.
+   IF ( nargs < 1 ) THEN
+      CALL usage()
+   ENDIF
+   iarg = 1
+   DO
+      IF ( iarg == nargs ) EXIT
+      CALL getarg( iarg, cdbrief )
+      IF ( cdbrief == '-b' ) THEN
+         lbrief = .TRUE.
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-q' ) THEN
+         lqcflags = .TRUE.
+         nqc=1
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-Q' ) THEN
+         lqcflags = .TRUE.
+         nqc=2
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-B' ) THEN
+         lqcflags = .TRUE.
+         nqc=3
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-u' ) THEN
+         lsort = .FALSE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-s' ) THEN
+         lstat = .TRUE.
+         CALL getarg( iarg + 1, cdstat )
+         iarg = iarg + 2 
+      ELSEIF ( cdbrief == '-t' ) THEN
+         ltyp = .TRUE.
+         CALL getarg( iarg + 1, cdtyp )
+         iarg = iarg + 2 
+      ELSEIF ( cdbrief == '-v' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') nvar1
+            IF (nvar1==0) THEN
+               nvar2=-1
+            ELSE
+               nvar2 = nvar1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            nvar1=1
+            READ(cdbrief(ip+1:),'(I10)') nvar2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') nvar1
+            READ(cdbrief(ip+1:),'(I10)') nvar2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-a' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') nadd1
+            IF (nadd1==0) THEN
+               nadd2=-1
+            ELSE
+               nadd2 = nadd1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            nadd1=1
+            READ(cdbrief(ip+1:),'(I10)') nadd2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') nadd1
+            READ(cdbrief(ip+1:),'(I10)') nadd2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-e' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') next1
+            IF (next1==0) THEN
+               next2=-1
+            ELSE
+               next2 = next1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            next1=1
+            READ(cdbrief(ip+1:),'(I10)') next2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') next1
+            READ(cdbrief(ip+1:),'(I10)') next2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-d' ) THEN
+         ldaterange=.TRUE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-D' ) THEN
+         ldepths=.TRUE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-z' ) THEN
+         lzinp=.TRUE.
+         iarg = iarg + 1
+      ELSE
+         CALL usage
+      ENDIF
+   ENDDO
+   CALL getarg( nargs, cdinfile )
+   !
+   ! Get input data
+   !
+   IF (lzinp) THEN
+#if defined NOSYSTEM
+      WRITE(*,*)'Compressed files need the system subroutine call'
+      CALL abort
+#else
+      CALL system( 'cp '//TRIM(cdinfile)//' fbprint_tmp.nc.gz' )
+      CALL system( 'gzip -df fbprint_tmp.nc.gz' )
+      CALL read_obfbdata( 'fbprint_tmp.nc', obsdata )
+      CALL system( 'rm -f fbprint_tmp.nc' )
+#endif
+   ELSE
+      CALL read_obfbdata( TRIM(cdinfile), obsdata )
+   ENDIF
+   CALL sealsfromargo( obsdata )
+   WRITE(*,'(2A,I9,A,I9,A)')TRIM(cdinfile), ' has ', obsdata%nobs ,&
+      & ' observations and a maximum of ', obsdata%nlev, ' levels'
+   IF (nvar1<0) THEN
+      nvar1 = 1
+      nvar2 = obsdata%nvar
+   ENDIF
+   IF (nadd1<0) THEN
+      nadd1 = 1
+      nadd2 = obsdata%nadd
+   ENDIF
+   IF (next1<0) THEN
+      next1 = 1
+      next2 = obsdata%next
+   ENDIF
+   !
+   ! Sort the data
+   !   
+   ALLOCATE(zsort(5,obsdata%nobs),iindex(obsdata%nobs))
+   IF (lsort) THEN
+      DO ii=1,obsdata%nobs
+         zsort(1,ii)=obsdata%ptim(ii)
+         zsort(2,ii)=obsdata%pphi(ii)
+         zsort(3,ii)=obsdata%plam(ii)
+         iwmo = TRANSFER( obsdata%cdwmo(ii)(1:4), iwmo )
+         zsort(4,ii) = iwmo
+         iwmo = TRANSFER( obsdata%cdwmo(ii)(5:8), iwmo )
+         zsort(5,ii) = iwmo
+      ENDDO
+      CALL index_sort_dp_n(zsort,5,iindex,obsdata%nobs)
+   ELSE
+      DO ii=1,obsdata%nobs
+         iindex(ii)=ii
+      ENDDO
+   ENDIF
+   IF (ldaterange) THEN
+      IF (obsdata%nobs>0) THEN
+         WRITE(*,'(A)')'First observation'
+         CALL print_time(obsdata%ptim(1))
+         WRITE(*,'(A)')'Last observation'
+         CALL print_time(obsdata%ptim(obsdata%nobs))
+      ENDIF
+   ELSE
+      !
+      ! Print the sorted list
+      !   
+      DO ii=1,obsdata%nobs
+         IF (lstat) THEN
+            IF (TRIM(ADJUSTL(cdstat)) /= &
+               &TRIM(ADJUSTL(obsdata%cdwmo(iindex(ii))))) CYCLE
+         ENDIF
+         IF (ltyp) THEN
+            IF (TRIM(ADJUSTL(cdtyp)) /= &
+               &TRIM(ADJUSTL(obsdata%cdtyp(iindex(ii))))) CYCLE
+         ENDIF
+         IF (ldepths) THEN
+            CALL print_depths(obsdata,iindex(ii))
+         ELSE
+            IF (lqcflags) THEN
+               CALL print_obs_qc(obsdata,iindex(ii),nqc,nvar1,nvar2)
+            ELSE
+               CALL print_obs(obsdata,iindex(ii),lbrief,&
+                  &           nvar1,nvar2,nadd1,nadd2,next1,next2)
+            ENDIF
+         ENDIF
+      ENDDO
+
+   ENDIF
+
+CONTAINS
+
+   SUBROUTINE usage
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbprint [options] inputfile'
+      CALL abort()
+   END SUBROUTINE usage
+   
+   SUBROUTINE print_depths(obsdata,iindex)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      INTEGER :: kj
+      REAL :: mindep,maxdep
+
+      mindep=10000
+      maxdep=0
+      DO kj=1,obsdata%nlev
+         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+            IF (obsdata%pdep(kj,iindex)>maxdep) maxdep=obsdata%pdep(kj,iindex)
+            IF (obsdata%pdep(kj,iindex)<mindep) mindep=obsdata%pdep(kj,iindex)
+         ENDIF
+      ENDDO
+      
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      WRITE(*,*)'Minimum obs. depth  = ',mindep
+      WRITE(*,*)'Maximum obs. depth  = ',maxdep
+      WRITE(*,*)
+
+   END SUBROUTINE print_depths
+
+   SUBROUTINE print_obs(obsdata,iindex,lshort,&
+      &                 kvar1,kvar2,kadd1,kadd2,kext1,kext2)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      LOGICAL :: lshort
+      INTEGER :: kvar1,kvar2,kadd1,kadd2,kext1,kext2
+      INTEGER :: jv,ja,je,jk
+      INTEGER :: kj
+      LOGICAL :: lskip
+      CHARACTER(len=1024) :: cdfmt1,cdfmt2
+      CHARACTER(len=16) :: cdtmp
+
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      IF (.NOT.lshort) THEN
+         DO jv = kvar1, kvar2
+            WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
+            WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
+            IF (obsdata%lgrid) THEN
+               WRITE(*,*)'Grid I              = ',obsdata%iobsi(iindex,jv)
+               WRITE(*,*)'Grid J              = ',obsdata%iobsj(iindex,jv)
+            ENDIF
+         ENDDO
+         cdfmt1='(1X,A8,1X,A8'
+         cdfmt2='(1X,F8.2,1X,I8'
+         DO jv = kvar1, kvar2
+            cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
+            cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
+            IF (kadd2-kadd1+1>0) THEN
+               WRITE(cdtmp,'(I10)')kadd2-kadd1+1
+               cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+               cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+            ENDIF
+            IF (obsdata%lgrid) THEN
+               cdfmt1 = TRIM(cdfmt1)//',1X,A10'
+               cdfmt2 = TRIM(cdfmt2)//',1X,I10'
+            ENDIF
+         ENDDO
+         IF (kext2-kext1+1>0) THEN
+            WRITE(cdtmp,'(I10)')kext2-kext1+1
+            cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+            cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+         ENDIF
+         cdfmt1=TRIM(cdfmt1)//')'
+         cdfmt2=TRIM(cdfmt2)//')'
+         IF (obsdata%lgrid) THEN
+            WRITE(*,FMT=cdfmt1)&
+               & 'DEPTH', 'DEP_QC', &
+               & (TRIM(obsdata%cname(jv))//'_OBS', &
+               & TRIM(obsdata%cname(jv))//'_QC' , &
+               & (TRIM(obsdata%cname(jv))//'_'//TRIM(obsdata%caddname(ja)),&
+               & ja = kadd1, kadd2 ), &
+               & TRIM(obsdata%cname(jv))//'_K' , &
+               & jv = kvar1, kvar2 ), &
+               & ( TRIM(obsdata%cextname(ja)),&
+               & ja = kext1, kext2 )
+            DO kj=1,obsdata%nlev
+               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+                  WRITE (*,FMT=cdfmt2) &
+                     & obsdata%pdep(kj,iindex),   &
+                     & obsdata%idqc(kj,iindex),   &
+                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
+                     & obsdata%iobsk(kj,iindex,jv), &
+                     & jv = kvar1, kvar2 ), &
+                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
+               ENDIF
+            ENDDO
+         ELSE
+            cdfmt1=TRIM(cdfmt1)//')'
+            cdfmt2=TRIM(cdfmt2)//')'
+            WRITE(*,FMT=cdfmt1)&
+               & 'DEPTH', 'DEP_QC', &
+               & (TRIM(obsdata%cname(jv))//'_OBS', &
+               & TRIM(obsdata%cname(jv))//'_QC' , &
+               & (TRIM(obsdata%cname(jv))//TRIM(obsdata%caddname(ja)),&
+               & ja = kadd1, kadd2 ), &
+               & jv = kvar1, kvar2 ), &
+               & ( TRIM(obsdata%cextname(ja)),&
+               & ja = kext1, kext2 )
+            DO kj=1,obsdata%nlev
+               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+                  WRITE (*,FMT=cdfmt2) &
+                     & obsdata%pdep(kj,iindex),   &
+                     & obsdata%idqc(kj,iindex),   &
+                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
+                     & jv = kvar1, kvar2 ), &
+                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDIF
+      WRITE(*,*)
+   END SUBROUTINE print_obs
+   
+   SUBROUTINE print_obs_qc(obsdata,iindex,kqc,kvar1,kvar2)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      LOGICAL :: lqc
+      INTEGER :: kqc
+      INTEGER :: kvar1,kvar2
+      INTEGER :: jv,ja,je,jk
+      INTEGER :: kj
+      LOGICAL :: lskip
+      CHARACTER(len=1024) :: cdfmt1,cdfmt2
+      CHARACTER(len=16) :: cdtmp
+      INTEGER :: iqcf
+      
+      IF (kqc==2) THEN
+         lskip=.TRUE.
+         IF (obsdata%ipqc(iindex)>1) lskip=.FALSE.
+         IF (obsdata%ioqc(iindex)>1) lskip=.FALSE.
+         DO jv = kvar1, kvar2
+            IF (obsdata%ivqc(iindex,jv)>1) lskip=.FALSE.
+         ENDDO
+         DO kj=1,obsdata%nlev
+            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+               IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
+               DO jv = kvar1, kvar2
+                  IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
+               ENDDO
+            ENDIF
+         ENDDO
+         IF (lskip) RETURN
+      ELSEIF (kqc==3) THEN
+         lskip=.TRUE.
+         DO kj=1,obsdata%nlev
+            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+               iqcf=0
+               DO jv = kvar1, kvar2
+                  IF (obsdata%ivlqc(kj,iindex,jv)>1) iqcf=iqcf+1
+                  IF (iqcf==obsdata%nvar) lskip=.FALSE.
+               ENDDO
+            ENDIF
+         ENDDO
+         IF (lskip) RETURN
+      ENDIF
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Position QC flags   = ',obsdata%ipqcf(:,iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      WRITE(*,*)'Observation QC flags= ',obsdata%ioqcf(:,iindex)
+      DO jv = kvar1, kvar2
+         WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
+         WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
+         WRITE(*,*)'Variable QC flags   = ',obsdata%ivqcf(:,iindex,jv)
+      ENDDO
+      cdfmt1='(1X,A8,1X,A8'
+      cdfmt2='(1X,F8.2,1X,I8'
+      WRITE(cdtmp,'(I10)')obsdata%nqcf
+      cdfmt1 = TRIM(cdfmt1)//',1X,A18'
+      cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
+      DO jv = kvar1, kvar2
+         cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
+         cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
+         WRITE(cdtmp,'(I10)')obsdata%nqcf
+         cdfmt1 = TRIM(cdfmt1)//',1X,A18'
+         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
+      ENDDO
+      IF (obsdata%next>0) THEN
+         WRITE(cdtmp,'(I10)')obsdata%next
+         cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+      ENDIF
+      cdfmt1=TRIM(cdfmt1)//')'
+      cdfmt2=TRIM(cdfmt2)//')'
+      WRITE(*,FMT=cdfmt1)&
+         & 'DEPTH', 'DEP_QC', 'DEP_QC_FLAGS', &
+         & (TRIM(obsdata%cname(jv))//'_OBS', &
+         & TRIM(obsdata%cname(jv))//'_QC' , &
+         & TRIM(obsdata%cname(jv))//'_QC_FLAGS',&
+         & jv = kvar1, kvar2 ), &
+         & ( TRIM(obsdata%cextname(ja)),&
+         & ja = 1, obsdata%next )
+      DO kj=1,obsdata%nlev
+         IF (kqc>=2)  THEN
+            lskip=.TRUE.
+            IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
+            DO jv = kvar1, kvar2
+               IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
+            ENDDO
+            IF (lskip) CYCLE
+         ENDIF
+         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+            WRITE (*,FMT=cdfmt2) &
+               & obsdata%pdep(kj,iindex),   &
+               & obsdata%idqc(kj,iindex),   &
+               & ( obsdata%idqcf(ja,kj,iindex), ja = 1, obsdata%nqcf ), &
+               & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+               & ( obsdata%ivlqcf(ja,kj,iindex,jv) , ja=1, obsdata%nqcf ), &
+               & jv = kvar1, kvar2 ), &
+               & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
+         ENDIF
+      ENDDO
+      WRITE(*,*)
+      
+   END SUBROUTINE print_obs_qc
+
+   SUBROUTINE print_time(ptim)
+      IMPLICIT NONE
+      REAL(fbdp) :: ptim
+      INTEGER:: iyr,imon,iday,ihou,imin,isec      
+      WRITE(*,*)'Julian date         = ',ptim
+      CALL jul2greg(isec,imin,ihou,iday,imon,iyr,ptim)
+      WRITE(*,'(1X,A,I4,2I2.2)') &
+         &      'Gregorian date      = ',iyr,imon,iday
+      WRITE(*,'(1X,A,I2.2,A1,I2.2,A1,I2.2)') &
+         &      'Time                = ',ihou,':',imin,':',isec
+   END  SUBROUTINE print_time
+
+END PROGRAM fbprint
+
+   
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90	(revision 8732)
@@ -0,0 +1,260 @@
+PROGRAM fbsel
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbsel **
+   !!
+   !!  ** Purpose : Select or subsample observations
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbsel.exe <input filename> <output filename>
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE date_utils
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbdatain,fbdataout
+   CHARACTER(len=256) :: filenamein,filenameout,filenametmp,cnameout
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER,PARAMETER :: maxtyp=1023
+   INTEGER,PARAMETER :: maxdates=20
+   INTEGER :: nqc,ntyp,ndates,ninidate(maxdates),nenddate(maxdates)
+   LOGICAL :: lsplitqc,lsplittyp,lsplitstat
+   INTEGER :: iqc,ityp,idate,istat
+   REAL :: maxlat,minlat,maxlon,minlon
+   CHARACTER(len=ilenwmo) :: cdwmo,cdwmobeg,cdwmoend
+   CHARACTER(len=ilenwmo), DIMENSION(:), POINTER :: clstatids
+   INTEGER :: nstat
+   NAMELIST/namsel/nqc,ntyp,ndates,ninidate,nenddate,lsplitqc,lsplittyp, &
+      &            lsplitstat,maxlat,minlat,maxlon,minlon,cdwmo,&
+      &            cdwmobeg,cdwmoend
+
+   IF (iargc()/=2) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbsel <input filename> <output filename>'
+      CALL abort
+   ENDIF
+
+   CALL getarg(1,filenamein)
+   CALL getarg(2,filenameout)
+   
+   nqc=-1
+   ntyp=-1
+   ndates=1
+   ninidate=19500101
+   nenddate=21000101
+
+   lsplitqc=.FALSE.
+   lsplittyp=.FALSE.
+   lsplitstat=.FALSE.
+   cdwmo=REPEAT('X',ilenwmo)
+   cdwmobeg=cdwmo
+   cdwmoend=cdwmo
+   maxlat=1e+38
+   minlat=-1e+38
+   maxlon=1e+38
+   minlon=-1e+38
+   OPEN(10,file='namsel.in')
+   READ(10,namsel)
+   CLOSE(10)
+   IF (cdwmobeg==REPEAT('X',ilenwmo)) cdwmobeg=cdwmo
+   IF (cdwmoend==REPEAT('X',ilenwmo)) cdwmoend=cdwmo
+   WRITE(*,namsel)
+
+   CALL init_obfbdata(fbdatain)
+   CALL init_obfbdata(fbdataout)
+
+   WRITE(*,*)'Reading file : ',TRIM(filenamein)
+   CALL read_obfbdata(TRIM(filenamein),fbdatain)
+   WRITE(*,*)'Number of observations before selection = ',fbdatain%nobs
+   DO idate=1,ndates
+      IF (ndates==1) THEN
+         cnameout=filenameout
+      ELSE
+         WRITE(cnameout,'(I2.2,2A)')idate,'_',TRIM(filenameout)
+      ENDIF
+      IF (lsplitqc) THEN
+         DO iqc=1,3
+            CALL fb_sel(fbdatain,fbdataout,iqc,ntyp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+            WRITE(filenametmp,'(A,I2.2,A,A)')'qc_',iqc,'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'QC selected = ',iqc
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSEIF (lsplittyp) THEN
+         DO ityp=0,maxtyp
+            CALL fb_sel(fbdatain,fbdataout,nqc,ityp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+            WRITE(filenametmp,'(A,I4.4,A,A)')'typ_',ityp,'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'Type = ',ityp
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSEIF (lsplitstat) THEN
+         CALL fb_sel_uniqueids(fbdatain,clstatids,nstat)
+         DO istat=1,nstat
+            CALL fb_sel(fbdatain,fbdataout,nqc,ntyp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,clstatids(istat),clstatids(istat))
+            WRITE(filenametmp,'(4A)')'statid_', &
+               & TRIM(clstatids(istat)),'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'Station = ',clstatids(istat)
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSE
+         CALL fb_sel(fbdatain,fbdataout,nqc,ntyp, & 
+            &        ninidate(idate),nenddate(idate), &
+            &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+         WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+         WRITE(*,*)'Writing file : ',TRIM(cnameout)
+         CALL write_obfbdata(TRIM(cnameout),fbdataout)
+         CALL dealloc_obfbdata(fbdataout)
+      ENDIF
+   ENDDO
+
+CONTAINS
+
+   SUBROUTINE fb_sel(fbdatain,fbdataout,nqc,ntyp,ninidate,nenddate,&
+      &              maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+      TYPE(obfbdata) :: fbdatain,fbdataout
+      INTEGER :: nqc,ntyp,ninidate,nenddate
+      REAL :: maxlat,minlat,maxlon,minlon
+      CHARACTER(len=ilenwmo) :: cdwmobeg,cdwmoend
+      INTEGER :: jobs
+      INTEGER :: iqc,ityp
+      LOGICAL :: llvalid(fbdatain%nobs)
+      INTEGER :: iyea,imon,iday
+      REAL(KIND=dp) :: zjini,zjend
+      LOGICAL :: lcheckwmo
+
+      lcheckwmo=(cdwmobeg/=REPEAT('X',ilenwmo)).OR.&
+         &      (cdwmoend/=REPEAT('X',ilenwmo))
+      iyea=ninidate/10000
+      imon=ninidate/100-iyea*100
+      iday=ninidate-iyea*10000-imon*100
+      CALL greg2jul(0,0,0,iday,imon,iyea,zjini)
+      iyea=nenddate/10000
+      imon=nenddate/100-iyea*100
+      iday=nenddate-iyea*10000-imon*100
+      CALL greg2jul(0,0,0,iday,imon,iyea,zjend)
+      DO jobs = 1, fbdatain%nobs
+         llvalid(jobs)=.TRUE.
+         IF (nqc/=-1) THEN
+            CALL check_prof(fbdatain,jobs,iqc)
+            llvalid(jobs)=(iqc==nqc).AND.llvalid(jobs)
+         ENDIF
+         IF (ntyp/=-1) THEN
+            READ(fbdatain%cdtyp(jobs),'(I4)')ityp
+            llvalid(jobs)=(ityp==ntyp).AND.llvalid(jobs)
+         ENDIF
+         IF (ninidate/=-1) THEN
+            llvalid(jobs)=(fbdatain%ptim(jobs)>zjini).AND.llvalid(jobs)
+         ENDIF
+         IF (nenddate/=-1) THEN
+            llvalid(jobs)=(fbdatain%ptim(jobs)<=zjend).AND.llvalid(jobs)
+         ENDIF
+         llvalid(jobs)=(fbdatain%pphi(jobs)<=maxlat).AND.       &
+            &          (fbdatain%pphi(jobs)>=minlat).AND.       &
+            &          (((fbdatain%plam(jobs)<=maxlon).AND.     &
+            &            (fbdatain%plam(jobs)>=minlon)).OR.     &
+            &           ((fbdatain%plam(jobs)+360<=maxlon).AND. &
+            &            (fbdatain%plam(jobs)+360>=minlon)).OR. &
+            &           ((fbdatain%plam(jobs)-360<=maxlon).AND. &
+            &            (fbdatain%plam(jobs)-360>=minlon))).AND.llvalid(jobs) 
+         IF (lcheckwmo) THEN
+            llvalid(jobs)=LGE(TRIM(fbdatain%cdwmo(jobs)),TRIM(cdwmobeg)) &
+               &    .AND. LLE(TRIM(fbdatain%cdwmo(jobs)),TRIM(cdwmoend)) &
+               &    .AND. llvalid(jobs)
+         ENDIF
+         ! Add more checks here...
+      ENDDO
+
+      CALL subsamp_obfbdata(fbdatain,fbdataout,llvalid)
+
+   END SUBROUTINE fb_sel
+
+   SUBROUTINE fb_sel_uniqueids(fbdatain,clstatids,nstat)
+      TYPE(obfbdata) :: fbdatain
+      CHARACTER(len=ilenwmo), DIMENSION(:), POINTER :: clstatids
+      INTEGER :: nstat
+      INTEGER :: jobs,kobs
+      LOGICAL, DIMENSION(fbdatain%nobs) :: lunique
+
+      lunique(:)=.TRUE.
+      DO jobs=1,fbdatain%nobs
+         IF (.NOT.lunique(jobs)) CYCLE
+         DO kobs=jobs+1,fbdatain%nobs
+            IF (.NOT.lunique(kobs)) CYCLE
+            IF (fbdatain%cdwmo(jobs)==fbdatain%cdwmo(kobs)) THEN
+               lunique(kobs)=.FALSE.
+            ENDIF
+         ENDDO
+      ENDDO
+      nstat=COUNT(lunique)
+      ALLOCATE(clstatids(nstat))
+      kobs=0
+      DO jobs=1,fbdatain%nobs
+         IF (lunique(jobs)) THEN
+            kobs=kobs+1
+            clstatids(kobs)=fbdatain%cdwmo(jobs)
+         ENDIF
+      ENDDO
+      WRITE(*,*)'Unique station ids'
+      DO jobs=1,nstat
+         WRITE(*,'(I5,1X,A)')jobs,clstatids(jobs)
+      ENDDO
+
+   END SUBROUTINE fb_sel_uniqueids
+   
+   SUBROUTINE check_prof(fbdata,iobs,iqc)
+      
+      TYPE(obfbdata) :: fbdata
+      INTEGER :: iobs,iqc
+      INTEGER :: i,ivar
+      
+      LOGICAL :: lpart,lfull
+
+      lpart=.false.
+      lfull=.true.
+      DO ivar=1,fbdata%nvar
+         DO i=1,fbdata%nlev
+            IF ((fbdata%ivlqc(i,iobs,ivar)>2).AND.&
+               &(fbdata%ivlqc(i,iobs,ivar)<9)) lpart = .TRUE.
+            IF (fbdata%ivlqc(i,iobs,ivar)<=2) lfull = .FALSE.
+         ENDDO
+      ENDDO
+
+      IF(lfull) THEN
+         iqc=3
+      ELSEIF (lpart) then
+         iqc=2
+      ELSE
+         iqc=1
+      ENDIF
+
+   END SUBROUTINE check_prof
+
+END PROGRAM fbsel
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90	(revision 8732)
@@ -0,0 +1,1335 @@
+PROGRAM fbstat
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbstat **
+   !!
+   !!  ** Purpose : Output feedback file summary info/statistics
+   !!         into a number of .dat files for different areas
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbstat.exe [-nmlev] <filenames>
+   !!   Optional:
+   !!     namelist = namfbstat.in
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE fbaccdata
+   USE coords
+   USE omonainfo
+   USE fbstatncio
+   USE proftools
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbdata
+   CHARACTER(len=256) :: filename,outfilename
+   INTEGER :: jfile,jbox,jlev,jfirst,jvar,jadd,ji,ja,jt,jboxl
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   REAL,DIMENSION(:),ALLOCATABLE :: zlev
+   INTEGER :: nmlev, nfiles
+   LOGICAL :: lexists,lomona,ltext,lnetcdf,lzinp
+   REAL, ALLOCATABLE, DIMENSION(:,:,:) :: zdat3d
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: zdat2d
+   INTEGER,DIMENSION(1) :: itime
+   INTEGER :: inidate,icurdate,loopno,ityp,iloopno
+   INTEGER :: nvar,nadd,noberr,nbgerr
+   CHARACTER(len=4) :: expver
+   CHARACTER(len=20) :: cltyp
+   CHARACTER(len=128) :: cdfmthead,cdfmtbody
+   LOGICAL :: lnear,linner,linnerp,linnerini,lpassive,lhistogram,lfound
+   LOGICAL :: lxyplot,lrmmean
+   INTEGER :: nqc,nqco
+   REAL :: rlspc,rlmax
+   CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: cname,caddname,&
+      & cobename,cbgename
+   INTEGER, PARAMETER :: nmaxareas = 20
+   CHARACTER(len=20), DIMENSION(nmaxareas) :: carea
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: lskipbox
+   INTEGER, parameter :: maxtyp = 10
+   CHARACTER(len=ilentyp), DIMENSION(maxtyp) :: ctyp
+   INTEGER :: ntyp,nboxuserl,ipdcst
+   REAL :: mindcst
+   NAMELIST/namfbstat/ltext,lomona,lnetcdf,nmlev,inidate,icurdate,loopno,&
+      &               expver,lnear,linner,lpassive,lhistogram,&
+      &               zhistmax,zhistmin,zhiststep,zcheck,carea,nmlev,&
+      &               nqc,nqco, &
+      &               rlspc,rlmax,ntyp,ctyp,&
+      &               lxyplot,zxymin,zxymax,zxystep,lzinp,lrmmean,mindcst
+
+   ltext=.TRUE.
+   lnetcdf=.TRUE.
+   lomona=.FALSE.
+   nmlev=31
+   inidate=19010101
+   icurdate=19010116
+   loopno=0
+   expver='test'
+   lnear=.TRUE.
+   linner=.FALSE.
+   lpassive=.FALSE.
+   lhistogram=.FALSE.
+   zhistmin(:)=-10.0
+   zhistmax(:)=10.0
+   zhiststep(:)=0.1
+   zcheck(:)=1000.0
+   nqc=2
+   nqco=2
+   carea(:)='all'
+   rlmax=5000.0
+   rlspc=-0.1
+   ntyp=1
+   ctyp(:)='all'
+   lxyplot=.FALSE.
+   zxymin(:)=-5.0
+   zxymax(:)=45.0
+   zxystep(:)=0.5
+   lzinp=.FALSE.
+   lrmmean=.FALSE.
+   mindcst=-1.0
+
+   INQUIRE(file='namfbstat.in',exist=lexists)
+   IF (lexists) THEN
+      OPEN(10,file='namfbstat.in')
+      READ(10,namfbstat)
+      CLOSE(10)
+      WRITE(*,namfbstat)
+   ENDIF
+   mindcst=mindcst*1000.0 !From km to m.
+   IF (iargc()==0) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbstat [-nmlev] <filenames>'
+      CALL abort
+   ENDIF
+   jfirst=1
+   DO ji=1,2
+      CALL getarg(jfirst,filename)
+      IF (filename=='-42') THEN
+         nmlev=42
+         jfirst=jfirst+1
+      ELSEIF(filename=='-31') THEN
+         nmlev=31
+         jfirst=jfirst+1
+      ELSEIF(filename=='-1') THEN
+         nmlev=1
+         lnear=.TRUE.
+         jfirst=jfirst+1
+      ELSEIF(filename=='-q') THEN
+         jfirst=jfirst+1
+         CALL getarg(jfirst,filename)
+         READ(filename,'(I4)')nqc
+         IF ((nqc<0).OR.(nqc>4)) THEN
+            WRITE(*,*)'Quality control option (-q) should be 1 to 4'
+            CALL abort
+         ENDIF
+         jfirst=jfirst+1
+      ENDIF
+   END DO
+   nfiles=iargc()
+
+   CALL coord_user_init('o')
+
+   ALLOCATE(lskipbox(nboxuser))
+   lskipbox(:)=.FALSE.
+
+   IF (carea(1)/='all') THEN
+      IF (lomona) THEN
+         WRITE(*,*)'For omona files carea(1) has to be all'
+         CALL abort
+      ENDIF
+      lskipbox(:)=.TRUE.
+      DO ji=1,nmaxareas
+         IF (carea(ji)/='all') THEN
+            lfound=.FALSE.
+            DO jbox=1,nboxuser
+               IF (TRIM(carea(ji))==TRIM(cl_boxes_user(jbox))) THEN
+                  lskipbox(jbox)=.FALSE.
+                  lfound=.TRUE.
+               ENDIF
+            ENDDO
+            IF (.NOT.lfound) THEN
+               WRITE(*,*)'Area ',TRIM(carea(ji)),' not found'
+               CALL abort
+            ENDIF
+         ENDIF
+      ENDDO
+      nboxuserl=0
+      DO ji=1,nboxuser
+         WRITE(*,*)'Area ',TRIM(cl_boxes_user(ji)),' is set to ',lskipbox(ji)
+         IF (.NOT.lskipbox(ji)) nboxuserl=nboxuserl+1
+      ENDDO
+      WRITE(*,*)'Total areas for statistics = ',nboxuserl
+      IF (lomona.AND.(nboxuserl/=nboxuser)) THEN
+         WRITE(*,*)'Omona files only possible if all areas'
+         CALL abort
+      ENDIF
+   ELSE
+      nboxuserl=nboxuser
+   ENDIF
+
+   IF (rlspc>0.0) THEN
+      lnear=.TRUE.
+      nmlev=rlmax/rlspc+1
+      ALLOCATE(zlev(nmlev))
+      DO ji=1,nmlev
+         zlev(ji)=(ji-1)*rlspc
+      ENDDO
+   ELSE
+      IF (.NOT.lnear) nmlev=nmlev-1
+      ALLOCATE(&
+         & zlev(nmlev) &
+         & )
+      IF(lnear) THEN
+         CALL getlevs(nmlev,zlev)
+      ELSE
+         CALL getlevsmean(nmlev,zlev)
+      ENDIF
+   ENDIF
+
+   DO jfile=jfirst, nfiles
+      CALL getarg(jfile,filename)
+      WRITE(*,*)'Handling file : ',TRIM(filename)
+      CALL flush(6)
+      IF (lzinp) THEN
+#if defined NOSYSTEM
+         WRITE(*,*)'Compressed files need the system subroutine call'
+         CALL abort
+#else
+         CALL system('cp '//TRIM(filename)//' fbstat_tmp.nc.gz')
+         CALL system('gzip -df fbstat_tmp.nc.gz')
+         CALL read_obfbdata('fbstat_tmp.nc',fbdata)
+         CALL system('rm -f fbstat_tmp.nc')
+#endif
+      ELSE
+         CALL read_obfbdata(TRIM(filename),fbdata)
+      ENDIF
+      CALL sealsfromargo( fbdata )
+      IF (jfile==jfirst) THEN
+         nvar=fbdata%nvar
+         nadd=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') nadd=nadd+1
+         ENDDO
+         noberr=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') noberr=noberr+1
+         ENDDO
+         nbgerr=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') nbgerr=nbgerr+1
+         ENDDO
+         IF (lhistogram) THEN
+            IF (nvar>maxvars) THEN
+               WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar
+               WRITE(*,*)'if you want histograms'
+               CALL abort
+            ENDIF
+            DO jvar = 1, nvar
+               hist(jvar)%npoints=(zhistmax(jvar)-zhistmin(jvar))&
+                  &              /zhiststep(jvar)+1
+               WRITE(*,*)'Number of points in histogram      = ',&
+                  &  hist(jvar)%npoints
+               WRITE(*,*)'Size of histogram array (elements) = ',&
+                  &  hist(jvar)%npoints*nmlev*nboxuserl*nadd
+               ALLOCATE(&
+                  & hist(jvar)%nhist(hist(jvar)%npoints,nmlev,nboxuserl,nadd,ntyp) &
+                  & )
+               hist(jvar)%nhist(:,:,:,:,:)=0
+            ENDDO
+         ENDIF
+         ipdcst=0
+         IF (mindcst>0) THEN
+            DO ja= 1, fbdata%next
+               IF (TRIM(fbdata%cextname(ja))=='DCST') THEN
+                  ipdcst=ja
+                  EXIT 
+               ENDIF
+            ENDDO
+            IF (ipdcst==0) THEN
+               WRITE(*,*)'Distance to coast not found in file, but mindcst>0'
+               WRITE(*,*)'Extra variables:'
+               DO ja= 1, fbdata%next
+                  WRITE(*,*)ja,TRIM(fbdata%cextname(ja))
+               ENDDO
+               CALL abort
+            ENDIF
+         ENDIF
+         IF (lxyplot) THEN
+            IF (nvar>maxvars) THEN
+               WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar
+               WRITE(*,*)'if you want xyplots'
+               CALL abort
+            ENDIF
+            DO jvar = 1, nvar
+               xy(jvar)%npoints=(zxymax(jvar)-zxymin(jvar))&
+                  &              /zxystep(jvar)+1
+               WRITE(*,*)'Number of points in x and y for xyplots = ',&
+                  &  xy(jvar)%npoints
+               WRITE(*,*)'Size of xyplot array (elements)         = ',&
+                  &  xy(jvar)%npoints*xy(jvar)%npoints*nmlev*nboxuserl*nadd
+               ALLOCATE(&
+                  & xy(jvar)%nxy(xy(jvar)%npoints,xy(jvar)%npoints,&
+                  &              nmlev,nboxuserl,nadd,ntyp) &
+                  & )
+               xy(jvar)%nxy(:,:,:,:,:,:)=0
+            ENDDO
+         ENDIF
+         ALLOCATE(&
+            & inum(nmlev,nboxuserl,nadd,nvar,ntyp),  &
+            & inumov(nmlev,nboxuserl,noberr,nvar,ntyp),  &
+            & inumbv(nmlev,nboxuserl,nbgerr,nvar,ntyp),  &
+            & inuma(nmlev,nboxuserl,nvar,ntyp),      &
+            & zbias(nmlev,nboxuserl,nadd,nvar,ntyp), &
+            & zrms(nmlev,nboxuserl,nadd,nvar,ntyp),  &
+            & zsdev(nmlev,nboxuserl,nadd,nvar,ntyp), &
+            & zomean(nmlev,nboxuserl,nadd,nvar,ntyp),&
+            & zmmean(nmlev,nboxuserl,nadd,nvar,ntyp),&
+            & zoemea(nmlev,nboxuserl,noberr,nvar,ntyp),&
+            & zovmea(nmlev,nboxuserl,noberr,nvar,ntyp),&
+            & zbemea(nmlev,nboxuserl,nbgerr,nvar,ntyp),&
+            & zbvmea(nmlev,nboxuserl,nbgerr,nvar,ntyp),&
+            & zoamean(nmlev,nboxuserl,nvar,ntyp),    &
+            & cname(nvar),                           &
+            & caddname(nadd),                        &
+            & cobename(noberr),                      &
+            & cbgename(nbgerr)                       &
+            & )
+         DO jvar = 1, nvar
+            cname(jvar) = fbdata%cname(jvar)
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') THEN
+               jadd=jadd+1
+               caddname(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') THEN
+               jadd=jadd+1
+               cobename(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') THEN
+               jadd=jadd+1
+               cbgename(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         IF (nadd>0) THEN
+            inum(:,:,:,:,:)=0
+            zbias(:,:,:,:,:)=0.0
+            zrms(:,:,:,:,:)=0.0
+            zsdev(:,:,:,:,:)=0.0
+            zomean(:,:,:,:,:)=0.0 
+            zmmean(:,:,:,:,:)=0.0
+         ENDIF
+         IF (noberr>0) THEN
+            inumov(:,:,:,:,:)=0
+            zoemea(:,:,:,:,:)=0
+            zovmea(:,:,:,:,:)=0
+         ENDIF
+         IF (nbgerr>0) THEN
+            inumbv(:,:,:,:,:)=0
+            zbemea(:,:,:,:,:)=0
+            zbvmea(:,:,:,:,:)=0
+         ENDIF
+         inuma(:,:,:,:)=0
+         zoamean(:,:,:,:)=0.0
+      ELSE
+         IF (fbdata%nvar/=nvar) THEN
+            WRITE(*,*)'Different number of nvar ',fbdata%nvar,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=nadd) THEN
+            WRITE(*,*)'Different number of nadd ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=noberr) THEN
+            WRITE(*,*)'Different number of noberr ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=nbgerr) THEN
+            WRITE(*,*)'Different number of nbgerr ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         IF (ipdcst>0) THEN
+            IF (ipdcst>fbdata%next) THEN
+               WRITE(*,*)'Distrance to coast in file not compatible with first file'
+               CALL abort
+            ENDIF
+            IF (TRIM(fbdata%cextname(ipdcst))/='DCST') THEN
+               WRITE(*,*)'Distrance to coast in file not compatible with first file'
+               CALL abort
+            ENDIF
+         ENDIF
+      ENDIF
+      IF (lrmmean) THEN
+         CALL fb_rmmean(fbdata)
+      ENDIF
+      CALL fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,nqc,nqco,&
+         &         lhistogram,lxyplot,ntyp,ctyp,ipdcst,mindcst)
+      CALL dealloc_obfbdata(fbdata)
+   ENDDO
+
+   DO jt=1,ntyp
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inum(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zbias(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbias(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                     zrms(jlev,jboxl,jadd,jvar,jt) = &
+                        & SQRT(zrms(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt))
+                     zsdev(jlev,jboxl,jadd,jvar,jt) = &
+                        & SQRT(MAX(zrms(jlev,jboxl,jadd,jvar,jt)**2-zbias(jlev,jboxl,jadd,jvar,jt)**2,0.0))
+                     zomean(jlev,jboxl,jadd,jvar,jt) = &
+                        & zomean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                     zmmean(jlev,jboxl,jadd,jvar,jt) = &
+                        & zmmean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zbias(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zrms(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zsdev(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zomean(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zmmean(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jadd=1,noberr
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inumov(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zoemea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zoemea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt)
+                     zovmea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zovmea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zoemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zovmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jadd=1,nbgerr
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inumbv(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zbemea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbemea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt)
+                     zbvmea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbvmea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zbemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zbvmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+   ENDDO
+   DO jt=1,ntyp
+      DO jvar=1,nvar
+         jboxl=0
+         DO jbox=1,nboxuser
+            IF (lskipbox(jbox)) CYCLE
+            jboxl=jboxl+1
+            DO jlev = 1, nmlev
+               IF ( inuma(jlev,jboxl,jvar,jt) > 0 ) THEN
+                  zoamean(jlev,jboxl,jvar,jt) = &
+                     & zoamean(jlev,jboxl,jvar,jt)/inuma(jlev,jboxl,jvar,jt)
+               ELSE
+                  zoamean(jlev,jboxl,jvar,jt) = fbrmdi
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+   ENDDO
+
+   IF (ltext) THEN
+
+      DO jt=1,ntyp
+         DO jvar=1,nvar
+            DO jadd=1,nadd
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(caddname(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inum(jlev,jboxl,jadd,jvar,jt), &
+                        & zbias(jlev,jboxl,jadd,jvar,jt), &
+                        & zrms(jlev,jboxl,jadd,jvar,jt), &
+                        & zsdev(jlev,jboxl,jadd,jvar,jt), &
+                        & zomean(jlev,jboxl,jadd,jvar,jt), &
+                        & zmmean(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+            DO jadd=1,noberr
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(cobename(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inumov(jlev,jboxl,jadd,jvar,jt), &
+                        & zoemea(jlev,jboxl,jadd,jvar,jt), &
+                        & zovmea(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+            DO jadd=1,nbgerr
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(cbgename(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inumbv(jlev,jboxl,jadd,jvar,jt), &
+                        & zbemea(jlev,jboxl,jadd,jvar,jt), &
+                        & zbvmea(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO jt=1,ntyp
+         DO jvar=1,nvar
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               WRITE(filename,'(7A)')TRIM(cname(jvar)),'_',&
+                  &                  TRIM(cl_boxes_user(jbox)),'_',&
+                  &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+               OPEN(10,file=TRIM(filename))
+               DO jlev = 1, nmlev
+                  WRITE(10,'(F16.7,2I12,F17.10)') zlev(jlev), &
+                     & jlev, inuma(jlev,jboxl,jvar,jt), &
+                     & zoamean(jlev,jboxl,jvar,jt)
+               ENDDO
+               CLOSE(10)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      IF (lhistogram) THEN
+         DO jt=1,ntyp
+            DO jvar=1,nvar
+               DO jadd=1,nadd
+                  jboxl=0
+                  DO jbox=1,nboxuser
+                     IF (lskipbox(jbox)) CYCLE
+                     jboxl=jboxl+1
+                     WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                        &                  TRIM(caddname(jadd)),'_',&
+                        &                  TRIM(cl_boxes_user(jbox)),'_',&
+                        &                  TRIM(ADJUSTL(ctyp(jt))),&
+                        &                  '_histogram.dat'
+                     OPEN(10,file=TRIM(filename))
+                     WRITE(10,'(A10,1000F10.2)')'#',(zlev(jlev),jlev=1,nmlev)
+                     DO ji=1,hist(jvar)%npoints
+                        WRITE(10,'(F10.2,1000I10)') &
+                           & zhistmin(jvar)+(ji-1)*zhiststep(jvar), &
+                           & (hist(jvar)%nhist(ji,jlev,jboxl,jadd,jt),jlev=1,nmlev)
+                     ENDDO
+                     CLOSE(10)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      
+   ENDIF
+
+   IF (lnetcdf) THEN
+
+      IF (nadd>0) THEN
+         DO jt=1,ntyp
+            WRITE(outfilename,'(3A)')'fbstat_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+            CALL fbstat_ncwrite(TRIM(outfilename),&
+               & nvar,cname,nadd,caddname,noberr,cobename,nbgerr,cbgename,&
+               & nboxuser,nboxuserl,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+               & inum(:,:,:,:,jt),zbias(:,:,:,:,jt),zrms(:,:,:,:,jt), &
+               & zsdev(:,:,:,:,jt),zomean(:,:,:,:,jt),zmmean(:,:,:,:,jt),&
+               & inuma(:,:,:,jt),zoamean(:,:,:,jt), &
+               & inumov(:,:,:,:,jt),zoemea(:,:,:,:,jt),zovmea(:,:,:,:,jt), &
+               & inumbv(:,:,:,:,jt),zbemea(:,:,:,:,jt),zbvmea(:,:,:,:,jt) )
+            IF (lhistogram) THEN
+               WRITE(outfilename,'(3A)')'fbstat_hist_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+               CALL fbstat_ncwrite_hist(TRIM(outfilename),&
+                  & nvar,cname,nadd,caddname,&
+                  & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+                  & hist,zhistmin,zhiststep,jt)
+            ENDIF
+            IF (lxyplot) THEN
+               WRITE(outfilename,'(3A)')'fbstat_xyplot_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+               CALL fbstat_ncwrite_xy(TRIM(outfilename),&
+                  & nvar,cname,nadd,caddname,&
+                  & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+                  & xy,zxymin,zxystep,jt)
+            ENDIF
+         ENDDO
+      ENDIF
+   ENDIF
+
+   IF (lomona) THEN
+
+      IF (ntyp>1) THEN
+         WRITE(*,*)'Omona file only supported for the first type which is : ',TRIM(ctyp(1))
+      ENDIF
+      IF (nmlev>1) THEN
+         ALLOCATE(zdat3d(nmlev,nboxuser,1))
+      ELSE
+         ALLOCATE(zdat2d(nboxuser,1))
+      ENDIF
+
+      cl_expnam=expver
+      WRITE(cl_date,'(I8.8)')inidate
+      i_dp = nmlev
+      itime=icurdate
+      linnerp=.TRUE.
+      iloopno = loopno
+      linnerini = linner
+      i_fill=0
+
+      DO jt=1,ntyp
+         DO jvar = 1, nvar
+            linner = linnerini
+            loopno = iloopno
+            SELECT CASE (TRIM(cname(jvar)))
+            CASE('POTM')
+               cl_var = 'votemper'
+            CASE('PSAL')
+               cl_var='vosaline'
+            CASE('SLA')
+               cl_var='sossheig'
+            CASE('SST')
+               cl_var='sosstsst'
+            CASE('UVEL')
+               cl_var='vozocrtx'
+            CASE('VVEL')
+               cl_var='vomecrty'
+            END SELECT
+            DO jadd = 1, nadd
+               linner = (caddname(jadd)(1:3)=='Hxa').OR.linner
+               IF (lpassive) THEN
+                  ityp=145
+               ELSE
+                  IF (linner) THEN
+                     linnerp=.TRUE.
+                     ityp=144
+                     IF (jadd>1) loopno=loopno+1
+                  ELSE
+                     ityp=142
+                     IF (.NOT.linnerp) THEN
+                        IF (jadd>1) loopno=loopno+1
+                     ENDIF
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbias(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbias(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=245
+               ELSE
+                  IF (linner) THEN
+                     ityp=244
+                  ELSE
+                     ityp=242
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zrms(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zrms(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=345
+               ELSE
+                  IF (linner) THEN
+                     ityp=344
+                  ELSE
+                     ityp=342
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zsdev(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zsdev(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=445
+               ELSE
+                  IF (linner) THEN
+                     ityp=444
+                  ELSE
+                     ityp=442
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = inum(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = inum(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=545
+               ELSE
+                  IF (linner) THEN
+                     ityp=544
+                  ELSE
+                     ityp=542
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zomean(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zomean(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=645
+               ELSE
+                  IF (linner) THEN
+                     ityp=644
+                  ELSE
+                     ityp=642
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zmmean(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zmmean(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               linner=.FALSE.
+            ENDDO
+            loopno = iloopno
+            DO jadd = 1, noberr
+               linner = .TRUE.
+               ityp = 139
+               IF (jadd>1) loopno=loopno+1
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zoemea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zoemea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               ityp = 239
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zovmea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zovmea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+            ENDDO
+            loopno = iloopno
+            DO jadd = 1, nbgerr
+               linner = .TRUE.
+               ityp = 141
+               IF (jadd>1) loopno=loopno+1
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbemea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbemea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               ityp = 241
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbvmea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbvmea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+            ENDDO
+            IF (lpassive) THEN
+               ityp=745
+            ELSE
+               ityp=742
+            ENDIF
+            WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+            CALL obs_variable_att(cltyp)
+            IF (nmlev>1) THEN
+               zdat3d(:,:,1) = inuma(:,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+            ELSE
+               zdat2d(:,1) = inuma(1,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+            ENDIF
+            IF (lpassive) THEN
+               ityp=845
+            ELSE
+               ityp=842
+            ENDIF
+            WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+            CALL obs_variable_att(cltyp)
+            IF (nmlev>1) THEN
+               zdat3d(:,:,1) = zoamean(:,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+            ELSE
+               zdat2d(:,1) = zoamean(1,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      IF (nmlev>1) THEN
+         DEALLOCATE(zdat3d)
+      ELSE
+         DEALLOCATE(zdat2d)
+      ENDIF
+      
+   ENDIF
+
+CONTAINS
+
+   SUBROUTINE fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,kqc,kqco,lhist,lxyplot,&
+      &               ntyp,ctyp,ipdcst,mindcst)
+      USE fbaccdata
+      USE coords
+      TYPE(obfbdata) :: fbdata
+      LOGICAL, DIMENSION(nboxuser) :: lskipbox
+      INTEGER :: nmlev
+      REAL :: zlev(nmlev)
+      LOGICAL :: lnear
+      INTEGER :: kqc,kqco
+      LOGICAL :: lhist,lxyplot
+      INTEGER :: ntyp
+      CHARACTER(len=ilentyp), DIMENSION(ntyp) :: ctyp
+      INTEGER :: ipdcst
+      REAL :: mindcst
+      INTEGER, DIMENSION(nboxuser) :: jlboxnum
+      INTEGER :: jlev, jobs, jvar, klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl
+      REAL :: zarea(4),zlat,zlon,zdiff,zdiff2,zvar
+      
+      jboxl=0
+      jlboxnum=-1
+      DO jbox = 1, nboxuser
+         IF (lskipbox(jbox)) CYCLE
+         jboxl=jboxl+1
+         jlboxnum(jbox)=jboxl
+      ENDDO
+
+      !$omp parallel do default(shared) private(jlev,jobs,jvar,klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl,zarea,zlat,zlon,zdiff,zdiff2)
+      DO jbox = 1, nboxuser
+         IF (lskipbox(jbox)) CYCLE
+         jboxl=jlboxnum(jbox)
+         CALL coord_area_user(cl_boxes_user(jbox),zarea)
+         DO jobs = 1, fbdata%nobs
+            ! Reject observations with observation, position or time flag rejections
+            IF (fbdata%ioqc(jobs)>kqco) CYCLE
+            IF (fbdata%ipqc(jobs)>kqco) CYCLE
+            IF (fbdata%itqc(jobs)>kqco) CYCLE
+            zlat = fbdata%pphi(jobs)
+            zlon = fbdata%plam(jobs)
+            IF (zlon<0) zlon=zlon+360
+            IF (zlon>360) zlon=zlon-360
+            IF ( ( zlat .GE. zarea(3) ) .AND. &
+               & ( zlat .LE. zarea(4) ) .AND. &
+               & ( ( ( zlon .GE. zarea(1) ) .AND. &
+               &     ( zlon .LE. zarea(2) ) ) .OR. &
+               &   ( ( zarea(2) .LE. zarea(1) ) .AND. &
+               &     ( zlon .GE. zarea(1) ) .AND. &
+               &     ( zlon .LE. 360        ) ) .OR. &
+               &   ( ( zarea(2)   .LE. zarea(1) ) .AND. &
+               &     ( zlon .GE. 0          ) .AND. &
+               &     ( zlon .LE. zarea(2) ) ) ) ) THEN
+            
+               DO jlev = 1, fbdata%nlev
+                  IF (ipdcst>0) THEN
+                     IF (fbdata%pext(jlev,jobs,ipdcst)==fbrmdi) CYCLE
+                     IF (fbdata%pext(jlev,jobs,ipdcst)<mindcst) CYCLE
+                  ENDIF
+                  DO jvar = 1, fbdata%nvar
+                     IF (nmlev==1) THEN
+                        klev=1
+                     ELSE
+                        IF (lnear) THEN
+                           zdiff=ABS(fbdata%pdep(jlev,jobs)-zlev(1))
+                           klev=1
+                           DO jlev2=2,nmlev
+                              zdiff2=ABS(fbdata%pdep(jlev,jobs)-zlev(jlev2))
+                              IF (zdiff2<zdiff) THEN
+                                 klev=jlev2
+                                 zdiff=zdiff2
+                              ENDIF
+                           ENDDO
+                        ELSE
+                           klev = fbdata%iobsk(jlev,jobs,jvar)-1
+                        ENDIF
+                        IF ( klev > nmlev ) THEN
+                           DO ja = 1, fbdata%nadd
+                              IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE
+                              IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar))<9000 ) THEN
+                                 WRITE(*,*)'Error in fb_stat'
+                                 WRITE(*,*)'Increase nmlev to at least ',klev
+                                 klev=nmlev
+                                 CALL abort
+                              ENDIF
+                           ENDDO
+                        ENDIF
+                     ENDIF
+                     IF (( klev > 0 ).AND. &
+                        &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN
+                        DO jt=1,ntyp
+                           IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                              IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                           ENDIF
+                           inuma(klev,jboxl,jvar,jt) = inuma(klev,jboxl,jvar,jt) + 1
+                           zoamean(klev,jboxl,jvar,jt) = zoamean(klev,jboxl,jvar,jt) + &
+                              & fbdata%pob(jlev,jobs,jvar)
+                        ENDDO
+                     ENDIF
+                     IF ( fbdata%ivlqc(jlev,jobs,jvar) < 0 ) CYCLE 
+                     IF ( fbdata%ivlqc(jlev,jobs,jvar) > kqc ) CYCLE 
+                     IF (( klev > 0 ).AND. &
+                        &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zdiff = ( fbdata%padd(jlev,jobs,ja,jvar) - &
+                                 &      fbdata%pob(jlev,jobs,jvar) )
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inum(klev,jboxl,jadd,jvar,jt) = inum(klev,jboxl,jadd,jvar,jt) + 1
+                                 zbias(klev,jboxl,jadd,jvar,jt) = zbias(klev,jboxl,jadd,jvar,jt) + &
+                                    & zdiff
+                                 zrms(klev,jboxl,jadd,jvar,jt) = zrms(klev,jboxl,jadd,jvar,jt) + &
+                                    & zdiff * zdiff
+                                 zomean(klev,jboxl,jadd,jvar,jt) = zomean(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%pob(jlev,jobs,jvar)
+                                 zmmean(klev,jboxl,jadd,jvar,jt) = zmmean(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)
+                              ENDDO
+                              IF (ABS(zdiff)>zcheck(jvar)) THEN
+                                 WRITE(*,*)'Departure outside check range ',&
+                                    & TRIM(fbdata%cname(jvar)),' entry ',&
+                                    & fbdata%caddname(jadd)
+                                 WRITE(*,*)'Depar = ',zdiff
+                                 WRITE(*,*)'Check = ',zcheck(jvar)
+                                 WRITE(*,*)'Id    = ',fbdata%cdwmo(jobs)
+                                 WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                 WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                 WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                 WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                 WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                 WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,ja,jvar)
+                                 WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                 WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                              ENDIF
+                              IF (lhist) THEN
+                                 ih=NINT((zdiff-zhistmin(jvar))/zhiststep(jvar))+1
+                                 IF ((ih>=1).AND.(ih<=hist(jvar)%npoints)) THEN
+                                    DO jt=1,ntyp
+                                       IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                          IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                       ENDIF
+                                       hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) = &
+                                          hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) +1
+                                    ENDDO
+                                 ELSE
+                                    WRITE(*,*)'Histogram value outside range for ',&
+                                       & TRIM(fbdata%cname(jvar)),' entry ',&
+                                       & fbdata%caddname(jadd)
+                                    WRITE(*,*)'Value = ',zdiff
+                                    WRITE(*,*)'Range = ',zhistmin(jvar),zhistmax(jvar)
+                                    WRITE(*,*)'Step  = ',zhiststep(jvar)
+                                    WRITE(*,*)'Index = ',ih
+                                    WRITE(*,*)'Id    = ',TRIM(fbdata%cdwmo(jobs))
+                                    WRITE(*,*)'Typ   = ',TRIM(fbdata%cdtyp(jobs))
+                                    WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                    WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                    WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                    WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,jadd,jvar)
+                                    WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                    WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                                 ENDIF
+                              ENDIF
+                              IF (lxyplot) THEN
+                                 ix=NINT((fbdata%pob(jlev,jobs,jvar)-zxymin(jvar))/&
+                                    &    zxystep(jvar))+1
+                                 iy=NINT((fbdata%padd(jlev,jobs,ja,jvar)-zxymin(jvar))/&
+                                    &    zxystep(jvar))+1
+                                 IF ((ix>=1).AND.(ix<=xy(jvar)%npoints).AND. &
+                                    &(iy>=1).AND.(iy<=xy(jvar)%npoints)) THEN
+                                    DO jt=1,ntyp
+                                       IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                          IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                       ENDIF
+                                       xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) = &
+                                          xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) +1
+                                    ENDDO
+                                 ELSE
+                                    WRITE(*,*)'xy plot values outside range for ',&
+                                       & TRIM(fbdata%cname(jvar)),' entry ',&
+                                       & fbdata%caddname(jadd)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Model = ',fbdata%padd(jlev,jobs,ja,jvar)
+                                    WRITE(*,*)'Range = ',zxymin(jvar),zxymax(jvar)
+                                    WRITE(*,*)'Step  = ',zxystep(jvar)
+                                    WRITE(*,*)'Index = ',ih
+                                    WRITE(*,*)'Id    = ',TRIM(fbdata%cdwmo(jobs))
+                                    WRITE(*,*)'Typ   = ',TRIM(fbdata%cdtyp(jobs))
+                                    WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                    WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                    WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                    WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,jadd,jvar)
+                                    WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                    WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                                 ENDIF
+                              ENDIF
+                           ENDIF
+                        ENDDO
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:3) /= 'OBE' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar)
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inumov(klev,jboxl,jadd,jvar,jt) = inumov(klev,jboxl,jadd,jvar,jt) + 1
+                                 zoemea(klev,jboxl,jadd,jvar,jt) = zoemea(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)                                 
+                                 zovmea(klev,jboxl,jadd,jvar,jt) = zovmea(klev,jboxl,jadd,jvar,jt) + zvar
+                              ENDDO
+                           ENDIF
+                        ENDDO
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:3) /= 'BGE' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar)
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inumbv(klev,jboxl,jadd,jvar,jt) = inumbv(klev,jboxl,jadd,jvar,jt) + 1
+                                 zbemea(klev,jboxl,jadd,jvar,jt) = zbemea(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)
+                                 zbvmea(klev,jboxl,jadd,jvar,jt) = zbvmea(klev,jboxl,jadd,jvar,jt) + zvar
+                              ENDDO
+                           ENDIF
+                        ENDDO
+                     ENDIF
+                  ENDDO
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDDO
+      !$omp end parallel do
+      
+   END SUBROUTINE fb_stat
+
+   SUBROUTINE fb_rmmean(fbdata)
+      TYPE(obfbdata) :: fbdata
+      INTEGER :: jadd,jmean
+
+      jmean=0
+      DO jadd=1,fbdata%nadd
+         IF (fbdata%caddname(jadd)(1:4)=='MEAN') THEN
+            jmean=jadd
+            EXIT
+         ENDIF
+      ENDDO
+      IF (jmean==0) THEN
+         WRITE(*,*)'Warning: MEAN additional variable not found'
+         RETURN
+      ENDIF
+      IF (fbdata%nobs>0) THEN
+         DO jadd=1,fbdata%nadd 
+            IF (fbdata%caddname(jadd)(1:2)=='Hx') THEN
+               fbdata%padd(:,:,jadd,:)=fbdata%padd(:,:,jadd,:)&
+                  &                   +fbdata%padd(:,:,jmean,:)
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE fb_rmmean
+
+   SUBROUTINE getlevsmean(nmlev,zlev)
+      IMPLICIT NONE
+      INTEGER :: nmlev
+      REAL,DIMENSION(nmlev) :: zlev
+      REAL,DIMENSION(nmlev+1) :: ztmp
+      INTEGER :: i
+
+      zlev(:)=9999.9
+      CALL getlevs(nmlev+1,ztmp)
+      DO i=1,nmlev
+         zlev(i)=0.5*(ztmp(i)+ztmp(i+1))
+      ENDDO
+
+   END SUBROUTINE getlevsmean
+
+   SUBROUTINE getlevs(nmlev,zlev)
+      IMPLICIT NONE
+      INTEGER :: nmlev
+      REAL,DIMENSION(nmlev) :: zlev
+      
+      zlev(:)=9999.9
+
+      IF (nmlev==42) THEN
+         zlev(1)=5.02159
+         zlev(2)=15.07854
+         zlev(3)=25.16046
+         zlev(4)=35.27829
+         zlev(5)=45.44776
+         zlev(6)=55.69149
+         zlev(7)=66.04198
+         zlev(8)=76.54591
+         zlev(9)=87.27029
+         zlev(10)=98.31118
+         zlev(11)=109.8062
+         zlev(12)=121.9519
+         zlev(13)=135.0285
+         zlev(14)=149.4337
+         zlev(15)=165.7285
+         zlev(16)=184.6975
+         zlev(17)=207.4254
+         zlev(18)=235.3862
+         zlev(19)=270.5341
+         zlev(20)=315.3741
+         zlev(21)=372.9655
+         zlev(22)=446.8009
+         zlev(23)=540.5022
+         zlev(24)=657.3229
+         zlev(25)=799.5496
+         zlev(26)=967.9958
+         zlev(27)=1161.806
+         zlev(28)=1378.661
+         zlev(29)=1615.291
+         zlev(30)=1868.071
+         zlev(31)=2133.517
+         zlev(32)=2408.583
+         zlev(33)=2690.780
+         zlev(34)=2978.166
+         zlev(35)=3269.278
+         zlev(36)=3563.041
+         zlev(37)=3858.676
+         zlev(38)=4155.628
+         zlev(39)=4453.502
+         zlev(40)=4752.021
+         zlev(41)=5050.990
+         zlev(42)=5350.272
+      ELSEIF (nmlev==31) THEN
+         zlev(1)=4.999938
+         zlev(2)=15.00029
+         zlev(3)=25.00176
+         zlev(4)=35.00541
+         zlev(5)=45.01332
+         zlev(6)=55.0295
+         zlev(7)=65.06181
+         zlev(8)=75.12551
+         zlev(9)=85.25037
+         zlev(10)=95.49429
+         zlev(11)=105.9699
+         zlev(12)=116.8962
+         zlev(13)=128.6979
+         zlev(14)=142.1953
+         zlev(15)=158.9606
+         zlev(16)=181.9628
+         zlev(17)=216.6479
+         zlev(18)=272.4767
+         zlev(19)=364.303
+         zlev(20)=511.5348
+         zlev(21)=732.2009
+         zlev(22)=1033.217
+         zlev(23)=1405.698
+         zlev(24)=1830.885
+         zlev(25)=2289.768
+         zlev(26)=2768.242
+         zlev(27)=3257.479
+         zlev(28)=3752.442
+         zlev(29)=4250.401
+         zlev(30)=4749.913
+         zlev(31)=5250.227
+      ELSEIF (nmlev==1) THEN
+         zlev(1)=0.0
+      ELSE
+         WRITE(*,*) 'Unknown number of levels'
+         CALL abort
+      ENDIF
+
+   END SUBROUTINE getlevs
+
+END PROGRAM fbstat
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90	(revision 8732)
@@ -0,0 +1,995 @@
+#define MYFILE 'fbstatncio.F90'
+MODULE fbstatncio
+
+   USE fbacctype
+   USE nctools
+   IMPLICIT NONE
+
+   REAL, PARAMETER :: fbstncmiss = 99999.
+
+   TYPE fbstatnctype
+      INTEGER :: nlev,nbox,nadd
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      CHARACTER(len=32), POINTER, DIMENSION(:) :: name
+      REAL, POINTER, DIMENSION(:) :: dep
+      REAL, POINTER, DIMENSION(:,:,:) :: val
+      INTEGER, POINTER, DIMENSION(:,:) :: cnt
+   END TYPE fbstatnctype
+
+   TYPE fbstathistnctype
+      INTEGER :: nlev,nbox,npoints
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      REAL, POINTER, DIMENSION(:) :: dep,val
+      INTEGER, POINTER, DIMENSION(:,:,:) :: nhist
+   END TYPE fbstathistnctype
+
+   TYPE fbstatxynctype
+      INTEGER :: nlev,nbox,npoints
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      REAL, POINTER, DIMENSION(:) :: dep,val
+      INTEGER, POINTER, DIMENSION(:,:,:,:) :: nxy
+   END TYPE fbstatxynctype
+
+CONTAINS
+
+   SUBROUTINE fbstat_ncwrite(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nobe,cdobe,nbge,cdbge,&
+      & nbox,nboxl,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & knum,pbias,prms,pstd,pomean,pmmean,knuma,poamean, &
+      & knumo,poerr,povar,knumb,pberr,pbvar)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of additional data
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nobe                               ! Number of obs errors
+      CHARACTER(len=*), DIMENSION(nadd) :: cdobe    ! Name of obs erors
+      INTEGER :: nbge                               ! Number of bg errors
+      CHARACTER(len=*), DIMENSION(nadd) :: cdbge    ! Name of bg erors
+      INTEGER :: nbox                               ! Total number of boxes
+      INTEGER :: nboxl                              ! Actual number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), DIMENSION(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      INTEGER, DIMENSION(nlev,nboxl,nadd,nvar) :: & ! Output data
+         & knum
+      REAL, DIMENSION(nlev,nboxl,nadd,nvar) :: &    ! Output data
+         & pbias, prms, pstd, pomean, pmmean
+      INTEGER, DIMENSION(nlev,nboxl,nvar) :: &      ! Output data
+         & knuma
+      REAL, DIMENSION(nlev,nboxl,nvar) :: &         ! Output data
+         & poamean
+      INTEGER, DIMENSION(nlev,nboxl,nobe,nvar) :: & ! Output data
+         & knumo
+      REAL, DIMENSION(nlev,nboxl,nobe,nvar) :: &    ! Output data
+         & poerr,povar
+      INTEGER, DIMENSION(nlev,nboxl,nbge,nvar) :: & ! Output data
+         & knumb
+      REAL, DIMENSION(nlev,nboxl,nbge,nvar) :: &    ! Output data
+         & pberr,pbvar
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,iv,jbox,ip
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimdep(1),idimbox(2),idimids(2)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      INTEGER :: inoboxes
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: ztmp
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox)
+      ALLOCATE(ztmp(nlev,inoboxes),itmp(nlev,inoboxes),clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Setup variables names
+
+      idimids(1)=idlev
+      idimids(2)=idbox
+      incvar=(nadd*6+nobe*3+nbge*3+2)*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdadd(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_bias'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_rms'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_std'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_omean'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_mmean'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nobe
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdobe(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nbge
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdbge(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         WRITE(cncvarbase,'(A)')TRIM(cdvar(jvar))
+         iv=iv+1
+         cncvar(iv)=TRIM(cncvarbase)//'_omean'
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+            &                       idimids,idvar(iv)),__LINE__,MYFILE)
+         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+            &          __LINE__,MYFILE)
+         iv=iv+1
+         cncvar(iv)=TRIM(cncvarbase)//'_count'
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+            &                       idimids,idvar(iv)),__LINE__,MYFILE)
+         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+            &          __LINE__,MYFILE)
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+      
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      ! Write the output data
+
+      iv=0
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pbias(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=prms(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pstd(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pomean(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pmmean(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knum(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nobe
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=poerr(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=povar(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knumo(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nbge
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pberr(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pbvar(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knumb(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         iv=iv+1
+         ip=0
+         DO jbox=1,nbox
+            IF (.NOT.lskipbox(jbox)) THEN
+               ip=ip+1
+               ztmp(:,ip)=poamean(:,ip,jvar)
+            ENDIF
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+            &          __LINE__,MYFILE)
+         iv=iv+1
+         ip=0
+         DO jbox=1,nbox
+            IF (.NOT.lskipbox(jbox)) THEN
+               ip=ip+1
+               itmp(:,ip)=knuma(:,ip,jvar)
+            ENDIF
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+      ENDDO
+      
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+      DEALLOCATE(cncvar,idvar,ztmp,itmp,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite
+
+   SUBROUTINE fbstat_ncwrite_hist(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & zhist,zhistmin,zhiststep,ntyp)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of addiables 
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nbox                               ! Number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), dimension(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      TYPE(histtype), DIMENSION(nvar) :: zhist      ! Histogram data
+      REAL, DIMENSION(nvar) :: &
+         & zhistmin,zhiststep                       ! Histogram info
+      integer :: ntyp                               ! Type to write
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimhist(nvar),&
+         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(3)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      CHARACTER(len=40) :: cdhdimname
+      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
+      INTEGER :: inoboxes
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox) 
+      ALLOCATE(clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+      
+      DO jvar=1,nvar
+         WRITE(cdhdimname,'(A,A)')'hist',TRIM(cdvar(jvar))
+         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
+            &                       zhist(jvar)%npoints,idimhist(jvar)),&
+            & __LINE__,MYFILE)
+      ENDDO
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Histogram values and depths
+
+      incvar=nvar+nadd*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
+         idimval(1)=idimhist(jvar)
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+            &                       nf90_float,idimval,idvar(iv)),&
+            &          __LINE__,MYFILE)
+         DO jadd=1,nadd
+            iv=iv+1
+            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
+               &                       TRIM(cdadd(jadd)),'_count'
+            idimcnt(1)=idimhist(jvar)
+            idimcnt(2)=idlev
+            idimcnt(3)=idbox
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+               &                       nf90_int,idimcnt,idvar(iv)),&
+               &          __LINE__,MYFILE)
+         ENDDO
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         ALLOCATE(zhval(zhist(jvar)%npoints))
+         DO ji=1,zhist(jvar)%npoints
+            zhval(ji)=(ji-1)*zhiststep(jvar)+zhistmin(jvar)
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
+            &          __LINE__,MYFILE)
+         DEALLOCATE(zhval)
+         DO jadd=1,nadd
+            iv=iv+1
+            ALLOCATE(itmp(zhist(jvar)%npoints,nlev,inoboxes))
+            ip=0
+            DO jbox=1,nbox
+               IF(.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,:,ip)=zhist(jvar)%nhist(:,:,ip,jadd,ntyp)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+            DEALLOCATE(itmp)
+         ENDDO
+      ENDDO
+
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+      
+      DEALLOCATE(cncvar,idvar,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite_hist
+
+   SUBROUTINE fbstat_ncwrite_xy(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & zxy,zxymin,zxystep,ntyp)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of addiables 
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nbox                               ! Number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), dimension(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      TYPE(xytype), DIMENSION(nvar) :: zxy          ! xyplot data
+      REAL, DIMENSION(nvar) :: &
+         & zxymin,zxystep                           ! xyplot info
+      integer :: ntyp                               ! Type to write
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimxy(nvar),&
+         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(4)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      CHARACTER(len=40) :: cdhdimname
+      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
+      INTEGER :: inoboxes
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox) 
+      ALLOCATE(clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+      
+      DO jvar=1,nvar
+         WRITE(cdhdimname,'(A,A)')'xy',TRIM(cdvar(jvar))
+         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
+            &                       zxy(jvar)%npoints,idimxy(jvar)),&
+            & __LINE__,MYFILE)
+      ENDDO
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Histogram values and depths
+
+      incvar=nvar+nadd*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
+         idimval(1)=idimxy(jvar)
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+            &                       nf90_float,idimval,idvar(iv)),&
+            &          __LINE__,MYFILE)
+         DO jadd=1,nadd
+            iv=iv+1
+            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
+               &                       TRIM(cdadd(jadd)),'_count'
+            idimcnt(1)=idimxy(jvar)
+            idimcnt(2)=idimxy(jvar)
+            idimcnt(3)=idlev
+            idimcnt(4)=idbox
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+               &                       nf90_int,idimcnt,idvar(iv)),&
+               &          __LINE__,MYFILE)
+         ENDDO
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         ALLOCATE(zhval(zxy(jvar)%npoints))
+         DO ji=1,zxy(jvar)%npoints
+            zhval(ji)=(ji-1)*zxystep(jvar)+zxymin(jvar)
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
+            &          __LINE__,MYFILE)
+         DEALLOCATE(zhval)
+         DO jadd=1,nadd
+            iv=iv+1
+            ALLOCATE(itmp(zxy(jvar)%npoints,zxy(jvar)%npoints,nlev,inoboxes))
+            ip=0
+            DO jbox=1,nbox
+               IF(.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,:,:,ip)=zxy(jvar)%nxy(:,:,:,ip,jadd,ntyp)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+            DEALLOCATE(itmp)
+         ENDDO
+      ENDDO
+
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+      
+      DEALLOCATE(cncvar,idvar,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite_xy
+
+   SUBROUTINE fbstat_ncread(cdfilename,cdvar,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      TYPE(fbstatnctype) :: sdata                 ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,nadd,nvar
+      INTEGER :: ncid,dimid,varid,i,icntpos
+      CHARACTER(len=128) :: cdname,tmpname
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire(ncid,nVariables=nvar),__LINE__,MYFILE)
+
+      ! Count the number of variables and find the "count" position
+
+      nadd=0
+      icntpos=0
+      DO i=1,nvar
+         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
+            &          __LINE__,MYFILE)
+         IF (TRIM(cdvar)//'_count'==TRIM(cdname)) THEN
+            icntpos=i
+         ELSE
+            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
+               tmpname=cdname(LEN_TRIM(cdvar)+2:)
+               IF (INDEX(tmpname,'_')==0) THEN
+                  nadd=nadd+1
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      nadd=0
+      DO i=1,nvar
+         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
+            &          __LINE__,MYFILE)
+         IF (i==icntpos) THEN
+            CALL nchdlerr(nf90_get_var(ncid,i,sdata%cnt),__LINE__,MYFILE)
+         ELSE
+            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
+               tmpname=cdname(LEN_TRIM(cdvar)+2:)
+               IF (INDEX(tmpname,'_')==0) THEN
+                  nadd=nadd+1
+                  sdata%name(nadd)=tmpname(1:MAX(LEN_TRIM(tmpname),32))
+                  CALL nchdlerr(nf90_get_var(ncid,i,sdata%val(:,:,nadd)),&
+                     &                       __LINE__,MYFILE)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread
+
+   SUBROUTINE fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
+      ! Arguments
+      TYPE(fbstatnctype) :: sdata    ! Data to be allocated
+      INTEGER :: nlev,nbox,nadd
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%nadd=nadd
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%name(nadd), &
+         & sdata%val(nlev,nbox,nadd), &
+         & sdata%cnt(nlev,nbox) &
+         )
+      
+   END SUBROUTINE fbstat_ncread_alloc
+
+   SUBROUTINE fbstat_ncread_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstatnctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%nadd=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%name, &
+         & sdata%val, &
+         & sdata%cnt &
+         )
+      
+   END SUBROUTINE fbstat_ncread_dealloc
+
+   SUBROUTINE fbstat_ncread_hist(cdfilename,cdvar,cdext,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      CHARACTER(len=*) :: cdext                     ! Name of extras
+      TYPE(fbstathistnctype) :: sdata               ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,npoints
+      INTEGER :: ncid,dimid,varid
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'hist'//TRIM(cdvar),dimid),&
+         &                                __LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=npoints),__LINE__,MYFILE)
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      ! Get values
+
+      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)
+
+      ! Get histograms
+
+      CALL nchdlerr(nf90_inq_varid(ncid,&
+         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nhist),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread_hist
+
+   SUBROUTINE fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
+      ! Arguments
+      TYPE(fbstathistnctype) :: sdata    ! Data to be allocated
+      INTEGER :: npoints,nlev,nbox
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%npoints=npoints
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%val(npoints), &
+         & sdata%nhist(npoints,nlev,nbox) &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_hist_alloc
+
+   SUBROUTINE fbstat_ncread_hist_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstathistnctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%npoints=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%val, &
+         & sdata%nhist &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_hist_dealloc
+
+   SUBROUTINE fbstat_ncread_xy(cdfilename,cdvar,cdext,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      CHARACTER(len=*) :: cdext                     ! Name of extras
+      TYPE(fbstatxynctype) :: sdata                 ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,npoints
+      INTEGER :: ncid,dimid,varid
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'xy'//TRIM(cdvar),dimid),&
+         &                                __LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=npoints),__LINE__,MYFILE)
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      ! Get values
+
+      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)
+
+      ! Get xyograms
+
+      CALL nchdlerr(nf90_inq_varid(ncid,&
+         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nxy),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread_xy
+
+   SUBROUTINE fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
+      ! Arguments
+      TYPE(fbstatxynctype) :: sdata    ! Data to be allocated
+      INTEGER :: npoints,nlev,nbox
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%npoints=npoints
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%val(npoints), &
+         & sdata%nxy(npoints,npoints,nlev,nbox) &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_xy_alloc
+
+   SUBROUTINE fbstat_ncread_xy_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstatxynctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%npoints=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%val, &
+         & sdata%nxy &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_xy_dealloc
+
+END MODULE fbstatncio
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90	(revision 8732)
@@ -0,0 +1,164 @@
+PROGRAM fbthin
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbthin **
+   !!
+   !!  ** Purpose : Thin the data to 1 degree resolution
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbthin.exe inputfile outputfile
+   !!
+   !!   Required:
+   !!     namelist = namthin.in
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256) :: cdinfile
+   CHARACTER(len=256) :: cdtmp
+   INTEGER :: nout,ninn,nadd,next,i,j,k
+   LOGICAL :: lgrid
+   !
+   ! Feedback data
+   !
+   TYPE(obfbdata) :: fbdatain
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF ((nargs /= 2)) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbthin inputfile outputfile'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdinfile)
+   CALL getarg(2,cdoutfile)
+   !
+   ! Initialize feedback data
+   !
+   CALL init_obfbdata( fbdatain )
+   !
+   ! Read the file
+   !
+   CALL read_obfbdata( TRIM(cdinfile), fbdatain )
+   !
+   ! Do the thining
+   !
+   CALL fb_thin( fbdatain )
+   !
+   ! Write the file
+   !
+   CALL write_obfbdata( TRIM(cdoutfile), fbdatain )
+
+CONTAINS
+   
+   SUBROUTINE fb_thin( fbdata )
+      !
+      ! Observation thinning 
+      !
+      IMPLICIT NONE
+      TYPE(obfbdata) :: fbdata
+      ! Namelist parameters
+      INTEGER, PARAMETER :: nmaxtypes = 10
+      CHARACTER(len=ilentyp), DIMENSION(nmaxtypes) :: thintypes
+      REAL, DIMENSION(nmaxtypes) :: thindists, thindtime
+      ! Local variables
+      NAMELIST/namthin/thintypes, thindists, thindtime
+      INTEGER :: it,ii,ij,iv,iobs,irej
+      REAL :: zdist
+
+      ! Get namelist
+      thintypes(:) = 'XXXX'
+      ! Distance in km
+      thindists(:) = 100.0
+      ! Time difference in days
+      thindtime(:) = 0.99999999
+      OPEN(10,file='namthin.in')
+      READ(10,namthin)
+      CLOSE(10)
+      WRITE(*,namthin)
+      
+      ! Convert to meters
+      thindists(:) = thindists(:) * 1000.0
+
+      DO it = 1, nmaxtypes
+
+         IF ( TRIM(thintypes(it)) == 'XXXX' ) CYCLE
+
+         iobs = 0 
+         irej = 0
+
+         master_loop: DO ii= 1, fbdata%nobs 
+            
+            IF ( TRIM(ADJUSTL(thintypes(it))) /= 'all' ) THEN
+               IF ( TRIM(ADJUSTL(fbdata%cdtyp(ii))) /= &
+                  & TRIM(ADJUSTL(thintypes(it))) ) CYCLE
+            ENDIF
+            
+            iobs = iobs + 1
+
+            ! Skip data with missing lon and lat and observation flag rejected.
+
+            IF (fbdata%plam(ii)==fbrmdi) CYCLE
+            IF (fbdata%pphi(ii)==fbrmdi) CYCLE
+            IF (fbdata%ioqc(ii)>2) CYCLE
+            
+            DO ij=ii+1, fbdata%nobs
+
+               ! Skip data with missing lon and lat and observation flag rejected.
+               
+               IF (fbdata%plam(ij)==fbrmdi) CYCLE
+               IF (fbdata%pphi(ij)==fbrmdi) CYCLE
+               IF (fbdata%ioqc(ij)>2) CYCLE
+               
+               ! Skip different type unless thintypes is 'all'
+
+               IF ( TRIM(ADJUSTL(thintypes(it))) /= 'all' ) THEN
+                  IF ( TRIM(ADJUSTL(fbdata%cdtyp(ij))) /= &
+                     & TRIM(ADJUSTL(thintypes(it))) ) CYCLE
+               ENDIF
+
+               IF ( ABS( fbdata%ptim(ij) - fbdata%ptim(ii) ) &
+                  & >= thindtime(it) ) CYCLE
+
+               zdist = distance( fbdata%plam(ii), fbdata%pphi(ii), &
+                  &              fbdata%plam(ij), fbdata%pphi(ij) )
+
+               IF ( zdist < thindists(it) ) THEN
+
+                  irej = irej + 1
+                  fbdata%ioqc(ij)    = 4
+                  fbdata%ioqcf(2,ij) = fbdata%ioqcf(2,ij) + 32
+
+               ENDIF
+            ENDDO
+            
+         ENDDO master_loop
+
+         WRITE(*,*)'For type                = ',TRIM(thintypes(it))
+         WRITE(*,*)'Observations considered = ',iobs
+         WRITE(*,*)'Observations rejected   = ',irej
+
+      ENDDO
+
+
+     
+   END SUBROUTINE fb_thin
+
+#include "distance.h90"
+
+END PROGRAM fbthin
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/greg2jul.h90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/grt_cir_dis.h90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 8732)
@@ -0,0 +1,131 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the tke 
+   !!                 turbulent closure parameterization
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+!   USE lib_print     ! formated print library
+!   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   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_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(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
+
+   !!----------------------------------------------------------------------
+   !!                    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)
+
+   !                                          
+   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
+
+   !!----------------------------------------------------------------------
+   !!                          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(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: in_out_manager.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!=====================================================================
+END MODULE in_out_manager
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90	(revision 8732)
@@ -0,0 +1,361 @@
+MODULE index_sort
+
+CONTAINS
+
+   LOGICAL FUNCTION lessn(a,b,n)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE lessn  ***
+      !!          
+      !! ** Purpose : Compare two array and return true if the first
+      !!              element of array "a" different from the corresponding 
+      !!              array "b" element is less than the this element
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      USE toolspar_kind
+      IMPLICIT NONE
+      INTEGER :: n
+      REAL(KIND=dp), DIMENSION(n) :: a,b
+      INTEGER :: i,j
+
+      DO i=1,n
+         IF (a(i)/=b(i)) THEN
+            IF (a(i)<b(i)) THEN
+               lessn=.TRUE.
+            ELSE
+               lessn=.FALSE.
+            ENDIF
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION lessn
+
+   SUBROUTINE  index_sort_dp_n(pval, n, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a
+      !!              double precision array 2D
+      !!
+      !! ** Method  : Heapsort with call to lessn for comparision
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code based on index_sort_dp
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & n                               ! Number of keys
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+      REAL(KIND=dp),DIMENSION(n,kvals),INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER,DIMENSION(kvals),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1) THEN
+
+         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 ( lessn(pval(:,kindx(jchild)),pval(:,kindx(jchild+1)),n) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( lessn(pval(:,jt),pval(:,kindx(jchild)),n) ) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+      ENDIF
+
+   END SUBROUTINE index_sort_dp_n
+
+   SUBROUTINE  index_sort_dp(pval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  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
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(KIND=dp),DIMENSION(*),INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1) THEN
+
+         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
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+   END SUBROUTINE index_sort_dp
+
+   SUBROUTINE  index_sort_int(kval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER,DIMENSION(*),INTENT(IN) :: &
+         & kval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         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 ( kval(kindx(jchild)) <  kval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( kval(jt) < kval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_int
+
+   SUBROUTINE  index_sort_string(cdval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*),DIMENSION(*),INTENT(IN) :: &
+         & cdval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         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 ( cdval(kindx(jchild)) <  cdval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( cdval(jt) < cdval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_string
+
+END MODULE index_sort
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90	(revision 8732)
@@ -0,0 +1,4315 @@
+#define __MYFILE__ 'ioncdf.F90'
+MODULE ioncdf
+   !!======================================================================
+   !!                       ***  MODULE  ioncdf  ***
+   !! Input/Output: manage netcdf inputs/outputs
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   ioncdf     : manage netcdf inputs/outputs
+   !!       put_map      : write a 2d/3d map 
+   !!       put_scalar   : write a scalar
+   !!       test_var     : test if variable exists
+   !!       get_nb_dim   : get dimension number of a variable
+   !!       get_dim_val  : get dimensions values of a variable
+   !!       get_var      : read a 1d/2d/3d/4d array 
+   !!       put_coord    : write coordinates
+   !!       create_map   : create map netcdf file
+   !!       put_att      : write CF attributes
+   !!       get_var_info : get CF attributes
+   !!  Original    : Nicolas Daget
+   !!  Modified      : MAB (nf90)
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE toolspar_kind
+   USE netcdf
+   USE nctools
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC :: put_coord, put_map, get_var, test_var, put_scalar, get_nb_dim, &
+             get_dim_val, get_scalar
+
+   !! * Substitutions
+
+   !! * Interface
+   INTERFACE put_coord
+     MODULE PROCEDURE put_coord_r, put_coord_d
+   END INTERFACE
+
+   INTERFACE put_map
+     MODULE PROCEDURE put_map_2d_r, put_map_3d_r, put_map_2d_d, put_map_3d_d
+   END INTERFACE
+
+   INTERFACE put_scalar
+     MODULE PROCEDURE put_scalar_i,  put_scalar_r,  put_scalar_d
+   END INTERFACE
+
+   INTERFACE get_var
+     MODULE PROCEDURE get_var_1d_r, get_var_2d_r, get_var_3d_r, get_var_4d_r, &
+                      get_var_1d_d, get_var_2d_d, get_var_3d_d, get_var_4d_d, &
+                      get_var_1d_i, get_var_2d_i, get_var_3d_i, get_var_4d_i
+   END INTERFACE
+
+   INTERFACE get_scalar
+     MODULE PROCEDURE get_scalar_i,  get_scalar_r,  get_scalar_d
+   END INTERFACE
+
+CONTAINS
+
+   SUBROUTINE test_var ( cd_filename, cd_var, k_test )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE test_var  ***
+      !!
+      !! ** Purpose :  test if cd_var exists
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                        :: &
+         k_test                                        ! test if variable exists
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id                           ! file and variable identifier
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ),&
+         & __LINE__,__MYFILE__)
+      k_test = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      CALL nchdlerr( nf90_close( i_file_id ),&
+         & __LINE__,__MYFILE__)
+
+      IF ( k_test .EQ. nf90_noerr  ) THEN
+         k_test = 1
+      ELSE
+         k_test = 0
+      ENDIF
+
+   END SUBROUTINE test_var
+   SUBROUTINE get_nb_dim ( cd_filename, cd_var, k_nb_dim )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_nb_dim  ***
+      !!
+      !! ** Purpose :  Get dimension number of variable
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get dimension number of variables
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-06  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                        :: &
+         k_nb_dim                                      ! c$dimension number of variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id                           ! file and variable identifier
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id, ndims=k_nb_dim ),&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_close( i_file_id ),&
+         & __LINE__,__MYFILE__) 
+   END SUBROUTINE get_nb_dim
+
+   SUBROUTINE get_dim_val ( cd_filename, cd_var, k_dim )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_dim_val  ***
+      !!
+      !! ** Purpose :  Get dimensions values of a variable
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get dimensions values of a variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-06  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:), INTENT(out)          :: &
+         k_dim                                         ! dimensions values of a variable
+
+      !! * local declarations
+      INTEGER, DIMENSION(1) :: i_nbdim                 ! dimensions of the variable
+      INTEGER               ::                       &
+         i_file_id, i_var_id,                        & ! file and variable identifier
+         ii                                     ! counter
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id, dimids=k_dim ) ,&
+         & __LINE__,__MYFILE__)
+      i_nbdim = SHAPE( k_dim )
+      DO ii =  1, i_nbdim(1)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, k_dim(ii), len=k_dim(ii) ),__LINE__,__MYFILE__ )
+      ENDDO
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE get_dim_val
+
+   !!======================================================================
+
+   SUBROUTINE get_scalar_i ( cd_filename, cd_var, k_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_i  ***
+      !!
+      !! ** Purpose :  read integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                     :: &
+         k_var                                         ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr(nf90_open( cd_filename, nf90_nowrite, i_file_id ),&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id,xtype=i_type,ndims=i_ndims),&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ),&
+         & __LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE get_scalar_i
+
+   SUBROUTINE get_scalar_r ( cd_filename, cd_var, p_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_r  ***
+      !!
+      !! ** Purpose :  read real scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), INTENT(out)                        :: &
+         p_var                                         ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type,ndims=i_ndims ),&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,__LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__  )
+
+   END SUBROUTINE get_scalar_r
+
+   SUBROUTINE get_scalar_d ( cd_filename, cd_var, dd_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_d  ***
+      !!
+      !! ** Purpose :  read double scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), INTENT(out)            :: &
+         dd_var                                        ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type,ndims=i_ndims),__LINE__,__MYFILE__ )
+      IF ( i_type .NE. 6 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ),__LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+
+   END SUBROUTINE get_scalar_d
+
+   !!======================================================================
+
+   SUBROUTINE put_scalar_i ( cd_filename, k_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_i  ***
+      !!
+      !! ** Purpose :  write an integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      INTEGER, INTENT(in)                      :: &
+        k_var                                          ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'scalar', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_int, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_i
+
+   SUBROUTINE put_scalar_r ( cd_filename, p_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_r  ***
+      !!
+      !! ** Purpose :  write an real scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      REAL(KIND=sp), INTENT(in)                         :: &
+        p_var                                          ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'scalar', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_r
+
+   SUBROUTINE put_scalar_d ( cd_filename, dd_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_d  ***
+      !!
+      !! ** Purpose :  write an integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      REAL(KIND=dp), INTENT(in)             :: &
+        dd_var                                         ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'double', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_d
+
+   !!======================================================================
+
+   SUBROUTINE put_map_2d_r ( cd_filename, p_var, p_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_2d_r  ***
+      !!
+      !! ** Purpose :  write 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=sp), OPTIONAL, INTENT(in)               :: &
+        p_missing,                                &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(in)         :: &
+        p_var                                          ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id, i_time_id,        &   ! dimension identifier
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(2) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(3) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL                  ::                     &
+         z_min, z_max, z_min_old, z_max_old            ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_count(3) = 1
+
+      IF ( PRESENT(p_missing) ) THEN
+         z_min = MINVAL(p_var, mask = p_var .NE. p_missing )
+         z_max = MAXVAL(p_var, mask = p_var .NE. p_missing )
+      ELSE
+         z_min = MINVAL(p_var )
+         z_max = MAXVAL(p_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(p_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', p_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(3), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_real, i_dim(3), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(3), i_leadtime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  &         'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(3)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(3) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_time) ) THEN
+            DO ii =  1, i_pos 
+               IF ( k_time .EQ. i_time(ii) ) THEN
+                  i_pos = ii - 1
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDIF
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(3) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+                                    start=(/1,i_tab_start(3)/), count=(/i_time_bnd(1),i_tab_count(3)/) ) ,&
+                                    & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_2d_r
+
+   SUBROUTINE put_map_2d_d ( cd_filename, dd_var, dd_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_2d_d  ***
+      !!
+      !! ** Purpose :  write 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=dp), OPTIONAL, INTENT(in)      :: &
+        dd_missing,                               &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(in)  :: &
+        dd_var                                         ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id, i_time_id,        &   ! dimension identifier
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(2) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(3) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL(KIND=dp)      ::                     &
+         dl_min, dl_max, dl_min_old, dl_max_old        ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_count(3) = 1
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dl_min = MINVAL( dd_var, mask = dd_var .NE. dd_missing )
+         dl_max = MAXVAL( dd_var, mask = dd_var .NE. dd_missing )
+      ELSE
+         dl_min = MINVAL( dd_var )
+         dl_max = MAXVAL( dd_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(dd_missing) )   &
+            & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dd_missing ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(3), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_double, i_dim(3), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(3), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(3)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(3) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', dl_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', dl_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         dl_min = MIN( dl_min, dl_min_old )
+         dl_max = MAX( dl_max, dl_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(3) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            & start=(/1,i_tab_start(3)/), count=(/i_time_bnd(1),i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_2d_d
+
+   SUBROUTINE put_map_3d_r ( cd_filename, p_var, p_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_3d_r  ***
+      !!
+      !! ** Purpose :  write 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=sp), OPTIONAL, INTENT(in)               :: &
+        p_missing,                                &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=sp), DIMENSION(:,:,:), INTENT(in)       :: &
+        p_var                                          ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id,                   &   ! dimension identifiers
+         i_dim_z_id, i_time_id,                    &   ! dimension identifiers
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(3) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(4) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL                  ::                     &
+         z_min, z_max, z_min_old, z_max_old            ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_start(3) = 1
+      i_tab_count(3) = i_dimxy(3)
+      i_tab_count(4) = 1
+
+      IF ( PRESENT(p_missing) ) THEN
+         z_min = MINVAL(p_var, mask = p_var .NE. p_missing )
+         z_max = MAXVAL(p_var, mask = p_var .NE. p_missing )
+      ELSE
+         z_min = MINVAL(p_var )
+         z_max = MAXVAL(p_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_dim_z_id
+      i_dim(4) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) .OR.  &
+           (i_len(3) .NE. i_dimxy(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(p_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', p_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(4), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_real, i_dim(4), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(4), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(4)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(4) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(4) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            start=(/1,i_tab_start(4)/), count=(/i_time_bnd(1),i_tab_count(4)/) ),__LINE__,__MYFILE__ )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_3d_r
+
+   SUBROUTINE put_map_3d_d ( cd_filename, dd_var, dd_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_3d_d  ***
+      !!
+      !! ** Purpose :  write 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=dp), OPTIONAL, INTENT(in)      :: &
+        dd_missing,                               &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=dp), DIMENSION(:,:,:), INTENT(in)  :: &
+        dd_var                                         ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id,                   &   ! dimension identifiers
+         i_dim_z_id, i_time_id,                    &   ! dimension identifiers
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(3) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(4) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL(KIND=dp)      ::                     &
+         dl_min, dl_max, dl_min_old, dl_max_old        ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_start(3) = 1
+      i_tab_count(3) = i_dimxy(3)
+      i_tab_count(4) = 1
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dl_min = MINVAL(dd_var, mask = dd_var .NE. dd_missing )
+         dl_max = MAXVAL(dd_var, mask = dd_var .NE. dd_missing )
+      ELSE
+         dl_min = MINVAL(dd_var )
+         dl_max = MAXVAL(dd_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_dim_z_id
+      i_dim(4) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) .OR.  &
+           (i_len(3) .NE. i_dimxy(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(dd_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dd_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(4), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_double, i_dim(4), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(4), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(4)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(4) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', dl_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', dl_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         dl_min = MIN( dl_min, dl_min_old )
+         dl_max = MAX( dl_max, dl_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(4) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            & start=(/1,i_tab_start(4)/), count=(/i_time_bnd(1),i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_3d_d
+
+   !!======================================================================
+
+   SUBROUTINE get_var_1d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_i  ***
+      !!
+      !! ** Purpose :  read 1d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:), INTENT(out)       :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)           :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER               :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_i
+
+   SUBROUTINE get_var_2d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_i  ***
+      !!
+      !! ** Purpose :  read 2d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:), INTENT(out)        :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_i
+
+   SUBROUTINE get_var_3d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_i  ***
+      !!
+      !! ** Purpose :  read 3d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:,:), INTENT(out)      :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_i
+
+   SUBROUTINE get_var_4d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_i  ***
+      !!
+      !! ** Purpose :  read 4d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:,:,:), INTENT(out)    :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_i
+
+   SUBROUTINE get_var_1d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_r  ***
+      !!
+      !! ** Purpose :  read 1d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:), INTENT(out)          :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_r
+
+   SUBROUTINE get_var_2d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_r  ***
+      !!
+      !! ** Purpose :  read 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(out)        :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_r
+
+   SUBROUTINE get_var_3d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_r  ***
+      !!
+      !! ** Purpose :  read 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:,:), INTENT(out)      :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_r
+
+   SUBROUTINE get_var_4d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_r  ***
+      !!
+      !! ** Purpose :  read 4d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:,:,:), INTENT(out)    :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_r
+
+   SUBROUTINE get_var_1d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_d  ***
+      !!
+      !! ** Purpose :  read 1d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_d
+
+   SUBROUTINE get_var_2d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_d  ***
+      !!
+      !! ** Purpose :  read 2d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_d
+
+   SUBROUTINE get_var_3d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_d  ***
+      !!
+      !! ** Purpose :  read 3d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_d
+
+   SUBROUTINE get_var_4d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_d  ***
+      !!
+      !! ** Purpose :  read 4d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:,:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_d
+
+   !!======================================================================
+
+   SUBROUTINE put_coord_r ( cd_filename, p_lon, p_lat, p_dep, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_coord_r  ***
+      !!
+      !! ** Purpose :  write coordinates as reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                    ! filename
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(in)         :: &
+         p_lon, p_lat                                   ! longitude and latitude
+      REAL(KIND=sp), DIMENSION(:), OPTIONAL, INTENT(in) :: &
+         p_dep                                          ! depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                  ! test
+      INTEGER               ::                    &
+         i_file_id, i_var_id,                     &     ! file and variable identifiers
+         i_dim_x_id, i_dim_y_id, i_dim_z_id,      &     ! dimension identifiers
+         i_var_exist                                    ! test
+      INTEGER, DIMENSION(2) :: i_dimxy                  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1) :: i_dimz                   ! dimension of depth
+      INTEGER, DIMENSION(3) :: i_dim                    ! dimensions for netcdf file
+      REAL                  ::                     &
+         z_minx, z_maxx, z_miny, z_maxy, z_minz, z_maxz ! minima and maxima
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_lon ) 
+      z_minx = MINVAL( p_lon )
+      z_maxx = MAXVAL( p_lon )
+      z_miny = MINVAL( p_lat )
+      z_maxy = MAXVAL( p_lat )
+
+      IF ( PRESENT( p_dep ) ) THEN
+         i_dimz = SHAPE(  p_dep )
+         z_minz = MINVAL( p_dep )
+         z_maxz = MAXVAL( p_dep )
+      ENDIF
+   
+      ! Open or create netcdf file
+      ! --------------------------
+      INQUIRE( FILE=TRIM(cd_filename), EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( p_dep ) ) THEN
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, i_dimz, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy, i_dimz )
+            ENDIF
+         ELSE
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Add longitude, latitude and depth
+      ! --------------------------------- 
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      IF ( PRESENT( p_dep ) ) THEN
+         i_var_exist = nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) 
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_redef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_def_dim( i_file_id, 'z', i_dimz(1), i_dim_z_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_dim(3) = i_dim_z_id
+      ENDIF
+
+      i_var_exist = nf90_inq_varid( i_file_id, "longitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "longitude", nf90_real, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_east' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Y' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'east' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_minx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_lon) ,&
+         & __LINE__,__MYFILE__)
+
+      i_var_exist = nf90_inq_varid( i_file_id, "latitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "latitude", nf90_real, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_north' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'X' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'north' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_miny ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxy ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_lat),__LINE__,__MYFILE__ )
+
+      IF ( PRESENT( p_dep ) ) THEN
+         i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_real, i_dim(3), i_var_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'depth' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface') ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', 'meter' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Z' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'down' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ),__LINE__,__MYFILE__ )
+         ENDIF
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_minz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_dep) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_coord_r
+ 
+   SUBROUTINE put_coord_d ( cd_filename, dd_lon, dd_lat, dd_dep, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_coord_d  ***
+      !!
+      !! ** Purpose :  write coordinates as real(kind=dp) in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)                        :: &
+         cd_filename                                            ! filename
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(in)         :: &
+         dd_lon, dd_lat                                         ! longitude and latitude
+      REAL(KIND=dp), DIMENSION(:), OPTIONAL, INTENT(in) :: &
+         dd_dep                                                 ! depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                  ! test
+      INTEGER               ::                    &
+         i_file_id, i_var_id,                     &     ! file and variable identifiers
+         i_dim_x_id, i_dim_y_id, i_dim_z_id,      &     ! dimension identifiers
+         i_var_exist                                    ! test
+      INTEGER, DIMENSION(2) :: i_dimxy                  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1) :: i_dimz                   ! dimension of depth
+      INTEGER, DIMENSION(3) :: i_dim                    ! dimensions for netcdf file
+      REAL(KIND=dp)      ::                     &
+         dl_minx, dl_maxx, dl_miny, dl_maxy,       &
+         dl_minz, dl_maxz,                         &    ! minima and maxima
+         dl_missing                                     ! missing value
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_lon ) 
+      dl_minx = MINVAL( dd_lon )
+      dl_maxx = MAXVAL( dd_lon )
+      dl_miny = MINVAL( dd_lat )
+      dl_maxy = MAXVAL( dd_lat )
+
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_dimz = SHAPE( dd_dep )
+         dl_minz = MINVAL(dd_dep)
+         dl_maxz = MAXVAL(dd_dep)
+      ENDIF
+
+      ! Open or create netcdf file
+      ! --------------------------
+      INQUIRE( FILE=TRIM(cd_filename), EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( dd_dep ) ) THEN
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, i_dimz, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy, i_dimz )
+            ENDIF
+         ELSE
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Add longitude, latitude and depth
+      ! --------------------------------- 
+      dl_missing = 9.e+19_8
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_var_exist = nf90_inq_dimid( i_file_id, 'z', i_dim_z_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_redef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_def_dim( i_file_id, 'z', i_dimz(1), i_dim_z_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         i_dim(3) = i_dim_z_id
+      ENDIF
+
+      i_var_exist = nf90_inq_varid( i_file_id, "longitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "longitude", nf90_double, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_east' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Y' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'east' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_minx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_lon) ,&
+         & __LINE__,__MYFILE__)
+
+      i_var_exist = nf90_inq_varid( i_file_id, "latitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "latitude", nf90_double, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_north' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'X' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'north' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_miny ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxy ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_lat),__LINE__,__MYFILE__ )
+
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_double, i_dim(3), i_var_id ),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'depth' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface'),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', 'meter' ),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Z' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'down' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_minz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_dep) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+!
+   END SUBROUTINE put_coord_d
+
+   !!======================================================================
+
+   SUBROUTINE create_map ( cd_filename, k_dimxy, k_dimz, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE create_map  ***
+      !!
+      !! ** Purpose :  create netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - define dimension of the netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)                 :: &
+         cd_filename                                            ! filename
+      INTEGER, DIMENSION(:), INTENT(in)             :: k_dimxy  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1), OPTIONAL, INTENT(in)   :: k_dimz   ! dimension of depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      INTEGER               ::                    &
+         i_file_id, i_dim_id                            ! file and dimension identifiers
+      INTEGER, DIMENSION(1) :: i_dim                    ! dimension of k_dimxy
+      !!----------------------------------------------------------------------
+
+      i_dim = SHAPE(k_dimxy)
+
+      ! Create file
+      ! -----------
+      CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Define dimensions
+      ! -----------------
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'x', k_dimxy(1), i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'y', k_dimxy(2), i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_dimz) ) THEN
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'z', k_dimz(1), i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( i_dim(1) .EQ. 3 ) THEN
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'z', k_dimxy(3), i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'time', nf90_unlimited, i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( PRESENT( cd_descr ) ) THEN
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "title", cd_descr(1) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "institution", cd_descr(2) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "source", cd_descr(3) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "history", cd_descr(4) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "references", cd_descr(5) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "comment", cd_descr(6) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE create_map
+
+   !!======================================================================
+
+   SUBROUTINE put_att( k_file_id, k_var_id, k_code )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_att  ***
+      !!
+      !! ** Purpose :  write CF attributes
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - write CF attributes
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      INTEGER, INTENT(in)      :: k_file_id, k_var_id,  &       ! file and variable identifiers
+                                  k_code                        ! CF identifier
+
+      !! * local declarations
+      CHARACTER(len=80)        ::                       &
+         cl_name, cl_longname,                          &       ! names of variable
+         cl_unit, cl_longunit                                   ! units of variable
+      !!----------------------------------------------------------------------
+
+      ! Get variable attributes and write them
+      ! --------------------------------------
+      CALL get_var_info( k_code, cl_name, cl_longname, cl_unit, cl_longunit )
+
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'standard_name', TRIM(cl_name) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'long_name', TRIM(cl_longname) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'units', TRIM(cl_unit) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'unit_long', TRIM(cl_longunit) ),__LINE__,__MYFILE__ )
+
+   END SUBROUTINE put_att
+
+   !!======================================================================
+
+   SUBROUTINE get_var_info( k_code, cd_name, cd_longname, cd_unit, cd_longunit )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_att  ***
+      !!
+      !! ** Purpose :  get CF attributes
+      !!
+      !! ** Method  : outofcore database
+      !!       
+      !! ** Action : - find iCF attributes
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(out)           :: cd_name       ! name of variable
+      CHARACTER(len=80), OPTIONAL, INTENT(out) ::       &
+         cd_longname, cd_unit, cd_longunit                      ! name and units of variable
+      INTEGER, INTENT(in)                      :: k_code        ! CF identifier
+
+      !! * local declarations
+      !!----------------------------------------------------------------------
+
+      ! Get CF attributes
+      ! -----------------
+      SELECT CASE ( k_code )
+         CASE (129)
+            cd_name="sea_water_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature ref to surface K"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_Celcius"
+         CASE (130)
+            cd_name="sea_water_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (131)
+            cd_name="sea_water_x_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="U zonal current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (132)
+            cd_name="sea_water_y_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="V meridional current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (133)
+            cd_name="upward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="W vertical current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (134)
+            cd_name="mst"
+            IF ( PRESENT(cd_longname) ) cd_longname="Modulus of strain rate tensor"
+            IF ( PRESENT(cd_unit) ) cd_unit="s-1"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="per_second"
+         CASE (135)
+            cd_name="vvs"
+            IF ( PRESENT(cd_longname) ) cd_longname="Vertical viscosity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_second"
+         CASE (136)
+            cd_name="vdf"
+            IF ( PRESENT(cd_longname) ) cd_longname="Vertical diffusivity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_second"
+         CASE (137)
+            cd_name="depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (138)
+            cd_name="sea_water_sigma_theta"
+            IF ( PRESENT(cd_longname) ) cd_longname="Sigma theta"
+            IF ( PRESENT(cd_unit) ) cd_unit="kgm3"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="kilogramme cubicmeter"
+         CASE (139)
+            cd_name="richardson_number"
+            IF ( PRESENT(cd_longname) ) cd_longname="Richardson number"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (140)
+            cd_name="UV"
+            IF ( PRESENT(cd_longname) ) cd_longname="UV product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (141)
+            cd_name="UT"
+            IF ( PRESENT(cd_longname) ) cd_longname="UT product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m s**-1 degC"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m s**-1 degC"
+         CASE (142)
+            cd_name="VT"
+            IF ( PRESENT(cd_longname) ) cd_longname="VT product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m s**-1 degC"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m s**-1 degC"
+         CASE (143)
+            cd_name="UU"
+            IF ( PRESENT(cd_longname) ) cd_longname="UU product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (144)
+            cd_name="VV"
+            IF ( PRESENT(cd_longname) ) cd_longname="VV product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (145)
+            cd_name="sea_surface_height_above_geoid"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea_surface_height_above_geoid"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (146)
+            cd_name="sea_floor_topography"
+            IF ( PRESENT(cd_longname) ) cd_longname="Sea floor topography"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (147)
+            cd_name="ocean_barotropic_streamfunction"
+            IF ( PRESENT(cd_longname) ) cd_longname="Barotropic Stream Function"
+            IF ( PRESENT(cd_unit) ) cd_unit="m3/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="cubic_meter_per_second"
+         CASE (148)
+            cd_name="ocean_mixed_layer_thickness"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the ocean mixed layer from the surface"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (149)
+            cd_name="sea_water_bottom_pressure"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea_water_bottom_pressure"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (153)
+            cd_name="surface_downward_eastward_stress"
+            IF ( PRESENT(cd_longname) ) cd_longname="U-Stress"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (154)
+            cd_name="surface_downward_northward_stress"
+            IF ( PRESENT(cd_longname) ) cd_longname="V-Stress"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (156)
+            cd_name="turbulent_kinetic_energy_input"
+            IF ( PRESENT(cd_longname) ) cd_longname="turbulent kinetic energy input"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (157)
+            cd_name="absorbed_solar_radiation"
+            IF ( PRESENT(cd_longname) ) cd_longname="Absorbed solar radiation"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (158)
+            cd_name="surface_downward_water_flux"
+            IF ( PRESENT(cd_longname) ) cd_longname="Precipitation minus Evaporation"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (159)
+            cd_name="sea_surface_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="specified sea surface temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_Celcius"
+         CASE (160)
+            cd_name="surface_downward_heat_flux_in_sea_water"
+            IF ( PRESENT(cd_longname) ) cd_longname="Specified Surface Heat flux"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (161)
+            cd_name="diagnosed_sst_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="diagnosed sea surface temperature error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (162)
+            cd_name="surface_downward_heat_flux_in_sea_water"
+            IF ( PRESENT(cd_longname) ) cd_longname="Heat flux Correction"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (163)
+            cd_name="d20_isotherm_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the D20 isotherm"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (164)
+            cd_name="ocean_integral_of_sea_water_temperature_wrt_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="averaged temperature over the fisrt 300m"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (167)
+            cd_name="barotropic_eastward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of U dz"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (168)
+            cd_name="barotropic_northward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of V dz"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (169)
+            cd_name="product_of_eastward_sea_water_velocity_and_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of Tudz"
+            IF ( PRESENT(cd_unit) ) cd_unit="Km/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Kelvin_meter_per_second"
+         CASE (170)
+            cd_name="product_of_northward_sea_water_velocity_and_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of Tvdz"
+            IF ( PRESENT(cd_unit) ) cd_unit="Km/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Kelvin_meter_per_second"
+         CASE (171)
+            cd_name="velocity_maximum"
+            IF ( PRESENT(cd_longname) ) cd_longname="velocity maximum"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (172)
+            cd_name="depth_of_maximum_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of maximum velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (173)
+            cd_name="salinity_maximum"
+            IF ( PRESENT(cd_longname) ) cd_longname="salinity maximum"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (174)
+            cd_name="depth_of_maximum_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of maximum salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (175)
+            cd_name="ocean_integral_of_sea_water_salinity_wrt_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="averaged salinity over the fisrt 300m"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (179)
+            cd_name="potential_temperature_analysis_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature analysis error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (180)
+            cd_name="background_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="background potential temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (181)
+            cd_name="analysed_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="Analysed potential temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (182)
+            cd_name="potential_temperature_background_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature background error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (183)
+            cd_name="analysed_salinity_from_soft"
+            IF ( PRESENT(cd_longname) ) cd_longname="analysed salinity from S(T) balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (184)
+            cd_name="sea_water_salinity_increment"
+            IF ( PRESENT(cd_longname) ) cd_longname="salinity increment"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (185)
+            cd_name="temperature_bias"
+            IF ( PRESENT(cd_longname) ) cd_longname="bias in temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (186)
+            cd_name="salinity_bias"
+            IF ( PRESENT(cd_longname) ) cd_longname="bias in salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (187)
+            cd_name="eastward_sea_water_velocity_increment_from_balance"
+            IF ( PRESENT(cd_longname) ) cd_longname="eastward sea water velocity increment from balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (188)
+            cd_name="northward_sea_water_velocity_increment_from_balance"
+            IF ( PRESENT(cd_longname) ) cd_longname="northward sea water velocity increment from balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (190)
+            cd_name="sea_water_salinity_increment_from_soft"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity increment from soft"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (191)
+            cd_name="sea_water_salinity_analysis_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity analysis error"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (192)
+            cd_name="sea_water_background_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water background salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (193)
+            cd_name="sea_water_analysed_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water analysed salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (194)
+            cd_name="sea_water_salinity_background_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity background error"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (500)
+            cd_name="bcksta_bal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (501)
+            cd_name="bcksta_unbal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (502)
+            cd_name="bcksta_bal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (503)
+            cd_name="bcksta_unbal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (504)
+            cd_name="bcksta_bal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of v"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (505)
+            cd_name="bcksta_unbal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of v"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (506)
+            cd_name="bcksta_bal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (507)
+            cd_name="bcksta_unbal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (510)
+            cd_name="increm_tot_T"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of T"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (511)
+            cd_name="increm_tot_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (512)
+            cd_name="increm_bal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (513)
+            cd_name="increm_unbal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (514)
+            cd_name="increm_tot_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (515)
+            cd_name="increm_bal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (516)
+            cd_name="increm_unbal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (517)
+            cd_name="increm_tot_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (518)
+            cd_name="increm_bal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (519)
+            cd_name="increm_unbal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (520)
+            cd_name="increm_tot_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (521)
+            cd_name="increm_bal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (522)
+            cd_name="increm_unbal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (530)
+            cd_name="pbudct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model u-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (531)
+            cd_name="pbvdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model v-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (532)
+            cd_name="pbtdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model t-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (533)
+            cd_name="pbfdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model f-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (540)
+            cd_name="bckenw_wetjc"
+            IF ( PRESENT(cd_longname) ) cd_longname="energy T weighting coefficient for Jc term"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s^2/C^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_square_second_per_square_degre_celcius"
+         CASE (541)
+            cd_name="bckenw_wesjc"
+            IF ( PRESENT(cd_longname) ) cd_longname="energy S weighting coefficient for Jc term"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s^2/PSU^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_square_second_per_square_practical_salinity_scale"
+         CASE (550)
+            cd_name="bckesd_ana_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for total part of T"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (551)
+            cd_name="bckesd_ana_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (552)
+            cd_name="bckesd_ana_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (553)
+            cd_name="bckesd_ana_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (554)
+            cd_name="bckesd_ana_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (560)
+            cd_name="bckesd_mod_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (561)
+            cd_name="bckesd_mod_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (562)
+            cd_name="bckesd_mod_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for u-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (563)
+            cd_name="bckesd_mod_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for v-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (564)
+            cd_name="bckesd_mod_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (565)
+            cd_name="bckesd_modf_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for temperature at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (566)
+            cd_name="bckesd_modf_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for salinity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (567)
+            cd_name="bckesd_modf_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for u-velocity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (568)
+            cd_name="bckesd_modf_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for v-velocity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (569)
+            cd_name="bckesd_modf_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for SSH at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (570)
+            cd_name="bcksal_dSdT"
+            IF ( PRESENT(cd_longname) ) cd_longname="dS/dT coefficient for the salinity balance"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU/C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale_per_degree_celcius"
+         CASE (571)
+            cd_name="bcksal_dTdz"
+            IF ( PRESENT(cd_longname) ) cd_longname="dT/dz for the background"
+            IF ( PRESENT(cd_unit) ) cd_unit="C/m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius_per_meter"
+         CASE (572)
+            cd_name="bcksal_dSdz"
+            IF ( PRESENT(cd_longname) ) cd_longname="dS/dz for the background"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU/m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale_per_meter"
+         CASE (575)
+            cd_name="bckssh_alpha"
+            IF ( PRESENT(cd_longname) ) cd_longname="Thermal expansion coefficient for the SSH balance"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (576)
+            cd_name="bckssh_beta"
+            IF ( PRESENT(cd_longname) ) cd_longname="Saline expansion coefficient for the SSH balance"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (580)
+            cd_name="filnot"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at T-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (581)
+            cd_name="filnou"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at u-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (582)
+            cd_name="filnov"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at v-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (583)
+            cd_name="filnoe"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at eta-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (590)
+            cd_name="bckint"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (591)
+            cd_name="bckins"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity"
+         CASE (592)
+            cd_name="bckinu"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background u-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (593)
+            cd_name="bckinv"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background v-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (594)
+            cd_name="bckineta"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (610)
+            cd_name="tangent_T"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent potential temperature field"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (611)
+            cd_name="tangent_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent salinity field"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (612)
+            cd_name="tangent_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent U zonal current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (613)
+            cd_name="tangent_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent V meridional current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (614)
+            cd_name="tangent_w"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent W vertical current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (615)
+            cd_name="tangent_SSH"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent sea surface height above geoid"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (616)
+            cd_name="tangent BSF"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent barotropic stream function"
+            IF ( PRESENT(cd_unit) ) cd_unit="m3/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="cubic_meter_per_second"
+         CASE (620)
+            cd_name="d28_isotherm_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the D28 isotherm"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (621)
+            cd_name="ocean_mixed_layer_thickness_bn2_criterion"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the ocean mixed layer from the surface with bn2 citerion"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (622)
+            cd_name="thermocline_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the strongest vertical temperature gradient"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (623)
+            cd_name="heat_content_of_first_300m"
+            IF ( PRESENT(cd_longname) ) cd_longname="heat content of first 300 m"
+            IF ( PRESENT(cd_unit) ) cd_unit="J"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules"
+         CASE (624)
+            cd_name="turbocline_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="turbocline depth"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (625)
+            cd_name="U-energy_transport"
+            IF ( PRESENT(cd_longname) ) cd_longname="U-energy transport"
+            IF ( PRESENT(cd_unit) ) cd_unit="J/s/m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules_per_second_per_square_meter"
+         CASE (626)
+            cd_name="V-energy_transport"
+            IF ( PRESENT(cd_longname) ) cd_longname="V-energy transport"
+            IF ( PRESENT(cd_unit) ) cd_unit="J/s/m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules_per_second_per_square_meter"
+         CASE default
+            cd_name="varname"
+            IF ( PRESENT(cd_longname) ) cd_longname="long_varname"
+            IF ( PRESENT(cd_unit) ) cd_unit="varunit"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="long_varunit"
+      END SELECT
+
+   END SUBROUTINE get_var_info
+
+END MODULE ioncdf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/LBC/lbcnfd.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/LBC/lib_mpp.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90	(revision 8732)
@@ -0,0 +1,40 @@
+#define __MYFILE__ 'nctools.F90'
+MODULE nctools
+
+   ! Utility subroutines for netCDF access
+   ! Modified    : MAB (nf90, handle_error, LINE&FILE)
+   ! Modifled    : KSM (new shorter name)
+
+   USE netcdf
+
+   PUBLIC ldebug_netcdf, nchdlerr
+   LOGICAL :: ldebug_netcdf = .FALSE.  ! Debug switch for netcdf
+
+CONTAINS
+
+   SUBROUTINE nchdlerr(status,lineno,filename)
+      
+      ! Error handler for netCDF access
+      IMPLICIT NONE
+
+
+      INTEGER :: status ! netCDF return status
+      INTEGER :: lineno ! Line number (usually obtained from 
+                        !  preprocessing __LINE__,__MYFILE__)
+      CHARACTER(len=*),OPTIONAL :: filename
+
+      IF (status/=nf90_noerr) THEN
+         WRITE(*,*)'Netcdf error, code ',status
+         IF (PRESENT(filename)) THEN
+            WRITE(*,*)'In file ',filename,' in line ',lineno
+         ELSE
+            WRITE(*,*)'In line ',lineno
+         END IF
+         WRITE(*,'(2A)')' Error message : ',nf90_strerror(status)
+         CALL abort
+      ENDIF
+
+   END SUBROUTINE nchdlerr
+
+!----------------------------------------------------------------------
+END MODULE nctools
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_const.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_const.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_const.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_const.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_conv.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_conv_functions.h90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_fbm.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 8732)
@@ -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: obs_prof_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsprof_io.h90"
+
+END MODULE obs_prof_io
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_seaice_io.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_seaice_io.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_seaice_io.F90	(revision 8732)
@@ -0,0 +1,30 @@
+MODULE obs_seaice_io
+   !!======================================================================
+   !!                       ***  MODULE obs_seaice_io  ***
+   !! Observation operators : I/O for GHRSEAICE files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_seaice_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsseaice_io.h90"
+
+END MODULE obs_seaice_io
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 8732)
@@ -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: obs_sla_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssla_io.h90"
+
+END MODULE obs_sla_io
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 8732)
@@ -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: obs_sla_types.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+#include "obssla_types.h90"
+
+END MODULE obs_sla_types
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sst_io.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sst_io.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sst_io.F90	(revision 8732)
@@ -0,0 +1,30 @@
+MODULE obs_sst_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sst_io  ***
+   !! Observation operators : I/O for GHRSST files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obs_sst_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssst_io.h90"
+
+END MODULE obs_sst_io
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_utils.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 8732)
@@ -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: obs_vel_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsvel_io.h90"
+
+END MODULE obs_vel_io
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 8732)
@@ -0,0 +1,834 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obsprof_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the profile ENACT observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                      ! Number of levels
+      INTEGER :: i_file_id
+      INTEGER :: i_obs_id
+      INTEGER :: i_lev_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_pl_num_id
+      INTEGER :: i_reference_date_time_id
+      INTEGER :: i_format_version_id
+      INTEGER :: i_juld_id
+      INTEGER :: i_data_type_id
+      INTEGER :: i_wmo_inst_type_id
+      INTEGER :: i_qc_var_id
+      INTEGER :: i_dc_ref_id
+      INTEGER :: i_qc_flag_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth 
+      CHARACTER(LEN=40) :: cl_fld_var_tp
+      CHARACTER(LEN=40) :: cl_fld_var_s
+      CHARACTER(LEN=40) :: cl_fld_var_ti
+      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
+      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
+      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
+      CHARACTER(LEN=40) :: cl_fld_var_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_qc_s
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
+      CHARACTER(LEN=40) :: cl_fld_reference_date_time
+      CHARACTER(LEN=40) :: cl_fld_juld
+      CHARACTER(LEN=40) :: cl_fld_data_type
+      CHARACTER(LEN=40) :: cl_fld_pl_num
+      CHARACTER(LEN=40) :: cl_fld_format_version
+      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
+
+      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
+      CHARACTER(LEN=16)            :: cl_data_type = ''
+      CHARACTER(LEN=4 )            :: cl_format_version = ''
+      INTEGER, DIMENSION(1) :: istart1, icount1
+      INTEGER, DIMENSION(2) :: istart2, icount2
+      CHARACTER(len=imaxlev) :: clqc
+      CHARACTER(len=1) :: cqc
+      INTEGER :: ji, jk
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      cl_fld_lam                 = 'LONGITUDE'
+      cl_fld_phi                 = 'LATITUDE'
+      cl_fld_depth               = 'DEPH_CORRECTED'
+      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
+      cl_fld_juld                = 'JULD'
+      cl_fld_data_type           = 'DATA_TYPE'
+      cl_fld_format_version      = 'FORMAT_VERSION'
+      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+      cl_fld_pl_num              = 'PLATFORM_NUMBER'
+
+      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
+      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
+      cl_fld_var_tp              = 'POTM_CORRECTED'
+      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
+      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+      cl_fld_var_s               = 'PSAL_CORRECTED'
+      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
+      cl_fld_var_juld_qc         = 'JULD_QC'
+      cl_fld_var_pos_qc          = 'POSITION_QC'
+      cl_fld_var_ti              = 'TEMP'
+      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
+      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
+
+      icount1(1) = 1 
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
+         &         i_data_type_id ),      cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
+         &         cl_data_type ),        cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
+         &         i_format_version_id ), cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
+         &         cl_format_version ),   cl_name, __LINE__ )
+      
+      CALL str_c_to_for( cl_data_type )
+      CALL str_c_to_for( cl_format_version )
+      
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
+         &                TRIM( ADJUSTL( cl_data_type ) )
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
+         &                TRIM( ADJUSTL( cl_format_version ) )
+      
+      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
+         &   .AND.                                              &
+         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
+         IF(ldwp)WRITE(kunit,*)'               Valid input file'
+      ELSE
+         CALL fatal_error( 'Invalid input file', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+
+      !---------------------------------------------------------------------
+      ! Read the QC atributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )        
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )
+      DO ji = 1, iobs
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      ! No depth QC in files
+      DO ji = 1, iobs
+         DO jk = 1, ilev
+            inpfile%idqc(jk,ji)  = 1
+            inpfile%idqcf(:,jk,ji) = 0
+         END DO
+      END DO
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
+!!         &         cl_name, __LINE__ ) 
+!!      !DO ji = 1,iobs
+!!         istart1(1) = ji
+!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+!!            &                         start = istart1, count = icount1),                              &
+!!            &         cl_name, __LINE__ )
+!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+!!         inpfile%itqcf(:,ji) = 0
+!!      END DO
+      ! Since the flags are not set in the ENACT files we reset them to 0
+      inpfile%itqc(:)    = 1      
+      inpfile%itqcf(:,:) = 0
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+         inpfile%ipqcf(:,ji) = 0
+      END DO
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc1(iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            inpfile%ioqcf(1,ji)   = iqc1(ji)
+            inpfile%ivqcf(1,ji,:) = iqc1(ji)
+            inpfile%ioqcf(2,ji)   = 0
+            inpfile%ivqcf(2,ji,:) = 0
+         END DO
+         DEALLOCATE( &
+            & iqc1 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
+         inpfile%ioqcf(:,:)   = 0
+         inpfile%ivqcf(:,:,:) = 0
+      ENDIF
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc2(ilev,iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            DO jk = 1,ilev
+               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
+               inpfile%ivlqcf(2,jk,ji,:) = 0
+            END DO
+         END DO
+         DEALLOCATE( &
+            & iqc2 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
+         inpfile%ivlqcf(:,:,:,:) = 0
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
+         &         cl_name, __LINE__ )
+ 
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+
+   END SUBROUTINE read_enactfile
+
+   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_coriofile **
+      !!
+      !! ** Purpose : Read from file the profile CORIO observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      INTEGER  :: &
+         & iobs, &
+         & ilev
+      !! * Local declarations
+      INTEGER :: &
+         & i_file_id,                &
+         & i_obs_id,                 &
+         & i_lev_id,                 &
+         & i_phi_id,                 & 
+         & i_lam_id,                 &
+         & i_depth_id,               &
+         & i_pres_id,                &
+         & i_var_id,                 &
+         & i_pl_num_id,              &
+         & i_format_version_id,      &
+         & i_juld_id,                &
+         & i_data_type_id,           &
+         & i_wmo_inst_type_id,       &
+         & i_qc_var_id,              &
+         & i_dc_ref_id
+      CHARACTER(LEN=40) :: & 
+         & cl_fld_lam,                 &
+         & cl_fld_phi,                 &
+         & cl_fld_depth,               & 
+         & cl_fld_depth_qc,            & 
+         & cl_fld_pres,                & 
+         & cl_fld_pres_qc,             & 
+         & cl_fld_var_t,               &
+         & cl_fld_var_s,               &
+         & cl_fld_var_ti,              &
+         & cl_fld_var_pos_qc,          &
+         & cl_fld_var_qc_t,            &
+         & cl_fld_var_qc_s,            &
+         & cl_fld_var_prof_qc_t,       &
+         & cl_fld_var_prof_qc_s,       &
+         & cl_fld_dc_ref,              &
+         & cl_fld_juld,                &
+         & cl_fld_pl_num,              &
+         & cl_fld_wmo_inst_type
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cl_name = 'read_coriofile'
+      CHARACTER(LEN=4 )            :: &
+         & cl_format_version = ''
+      INTEGER, DIMENSION(1) :: &
+         & istart1, icount1
+      INTEGER, DIMENSION(2) :: &
+         & istart2, icount2
+      CHARACTER(len=imaxlev) :: &
+         & clqc
+      CHARACTER(len=1) :: &
+         & cqc
+      CHARACTER(len=256) :: &
+         & cdjulref
+      INTEGER :: &
+         & ji, jk
+      INTEGER :: &
+         & iformat
+      LOGICAL :: & 
+         & lsal
+      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zpres
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & ipresqc
+      CHARACTER(len=256) :: &
+         & cerr
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      icount1(1) = 1 
+      lsal = .TRUE.
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Check format and set variables accordingly
+      !-----------------------------------------------------------------------
+
+      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 1
+      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 2
+      ELSE
+         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
+         CALL fatal_error( cerr, __LINE__ )
+      ENDIF
+      IF ( iformat == 1 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'DEPH_QC'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'PRES_QC'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+         cl_fld_dc_ref              = 'DC_REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'TEMP_QC'
+         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'PSAL_QC'
+         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'POSITION_QC'
+      ELSEIF ( iformat==2 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'QC_DEPH'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'QC_PRES'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'INST_TYPE'
+         cl_fld_dc_ref              = 'REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'QC_TEMP'
+         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'QC_PSAL'
+         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'Q_POSITION'
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+      ALLOCATE( &
+         & zpres(ilev,iobs),  &
+         & ipresqc(ilev,iobs) &
+         & )
+      !---------------------------------------------------------------------
+      ! Get julian data reference (iformat==2)
+      !---------------------------------------------------------------------
+
+      IF (iformat==2) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
+            &                        "Reference_date_time", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
+            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
+         &         cl_name, __LINE__ )
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%ivlqc(:,:,2) = 4
+         inpfile%pob(:,:,2) = fbrmdi
+         lsal = .FALSE.
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      IF (lsal) THEN
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1,iobs
+            istart1(1) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
+               &                         start = istart1, count = icount1),                           &
+               &         cl_name, __LINE__ )
+            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+         END DO
+      ELSE
+         inpfile%ivqc(:,2) = 4
+      ENDIF
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1, iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      IF (iformat==1) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
+            &                        "units", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
+            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
+            & cdjulref(29:30)
+      ENDIF
+      
+      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%pdep(:,:) = fbrmdi
+         inpfile%idqc(:,:) = 4
+      ENDIF
+
+      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         zpres(:,:) = fbrmdi
+         ipresqc(:,:) = 4
+      ENDIF
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      IF (lsal) THEN      
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
+            &         cl_name, __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+         
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Coriolis data conversion from insitu to potential temperature
+      !---------------------------------------------------------------------
+      !---------------------------------------------------------------------
+      !  Convert pressure to depth if depth not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
+                  IF ( zpres(jk,ji) < 9999.0 ) THEN
+                     inpfile%pdep(jk,ji) = &
+                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
+                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert depth to pressure if pressure not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( zpres(jk,ji) >= 9999.0 ) THEN
+                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
+                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
+                        &                            REAL(inpfile%pphi(ji),wp) )
+                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert insitu temperature to potential temperature if
+      !  salinity, insitu temperature and pressure are present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         DO jk = 1, inpfile%nlev
+            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
+               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
+               &( zpres(jk,ji) < 9999.0 ) ) THEN
+               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
+                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
+                  &                           REAL(zpres(jk,ji),wp),  &
+                  &                           0.0_wp )
+            ELSE
+               inpfile%pob(jk,ji,1) = fbrmdi
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      !  Initialize flags since they are not in the CORIOLIS input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+   END SUBROUTINE read_coriofile
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obsseaice_io.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obsseaice_io.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obsseaice_io.h90	(revision 8732)
@@ -0,0 +1,270 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obsseaice_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_seaice **
+      !!
+      !! ** Purpose : Read from file the SEAICE observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
+      INTEGER :: i_file_id    ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data       ! Number of data per parameter in current file
+      INTEGER :: i_time       ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of seaice measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_seaice         ! Seaice data     
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen          ! Length of netCDF attributes
+      INTEGER :: itype          ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca      ! Scale factor
+      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
+      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
+      CHARACTER (len=33) ::creftime     ! Reference time of file
+      INTEGER :: i_refyear       ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_seaice        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get seaice data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_seaice(:,:) /=  zfill)
+         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
+      ELSEWHERE
+         z_seaice(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get seaice obs type
+      
+      i_type(:,:)=1
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SEAICE'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+   END SUBROUTINE read_seaice
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 8732)
@@ -0,0 +1,378 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obssla_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_avisofile **
+      !!
+      !! ** Purpose : Read from file the AVISO SLA observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : http://www.aviso.oceanobs.com
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
+      INTEGER :: i_file_id     ! netcdf IDS
+      INTEGER :: i_tracks_id
+      INTEGER :: i_cycles_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen         ! Length of netCDF attributes
+      INTEGER :: itype         ! Typeof netCDF attributes
+      REAL(fbdp) :: zsca       ! Scale factor
+      REAL(fbdp) :: zfill      ! Fill value
+      CHARACTER(len=3) ::  cmission      ! Mission global attribute
+      INTEGER :: itracks       ! Maximum number of passes in file
+      INTEGER :: icycles       ! Maximum number of cycles for each pass
+      INTEGER :: idata         ! Number of data per parameter in current file
+      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
+      INTEGER, DIMENSION(:), POINTER :: & 
+         & iptracks,     &  ! List of passes contained in current file
+         & ipnbpoints,   &  ! Number of points per pass
+         & ipdataindexes    ! Index of data in theoretical profile
+      INTEGER, DIMENSION(:,:), POINTER :: & 
+         & ipcycles         ! List of cycles per pass
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zphi,   &        ! Latitudes
+         & zlam             ! Longitudes
+      REAL(fbdp), DIMENSION(:,:), POINTER :: &
+         & zbegindates      ! Date of point with index 0
+      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
+      REAL(fbsp), DIMENSION(:,:), POINTER :: &
+         & zsla             ! SLA data
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zjuld            ! Julian date
+      LOGICAL, DIMENSION(:), POINTER :: &
+         & llskip           ! Skip observation
+      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
+      INTEGER :: imission   ! Mission number converted from Mission global 
+                            ! netCDF atttribute.
+      CHARACTER(len=255) :: ctmp
+      INTEGER :: iobs
+      INTEGER :: jl
+      INTEGER :: jm
+      INTEGER :: jj
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: jcycle
+
+      ! Open the file
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
+         &         cpname, __LINE__ )
+
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
+         &                                 len = itracks ),  &
+         &         cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
+         &                                 len = icycles ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
+         &                                 len = idata ),  &
+         &         cpname, __LINE__ )
+
+      ! Allocate memory for input data
+
+      ALLOCATE( &
+         & iptracks     ( itracks          ), &  
+         & ipnbpoints   ( itracks          ), &  
+         & ipcycles     ( icycles, itracks ), &
+         & zphi         ( idata            ), &   
+         & zlam         ( idata            ), &  
+         & zbegindates  ( icycles, itracks ), &
+         & ipdataindexes( idata            ), & 
+         & zsla         ( icycles, idata   ), &
+         & zjuld        ( idata*icycles    ), &
+         & llskip       ( idata*icycles    )  &
+         & )
+
+      ! Get time gap getween two measurements in seconds
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
+         &         cpname, __LINE__ )
+      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zdeltat = zsca * zdeltat
+         
+      ! Get List of passes contained in current file      
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
+         &         cpname, __LINE__ )
+      
+      ! Get Number of points per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
+         &         cpname, __LINE__ )
+      
+      ! Get list of cycles per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
+         &         cpname, __LINE__ )
+
+      ! Get longitudes
+
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                         == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zlam(:) = zsca * zlam(:)
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zphi(:) = zsca * zphi(:)
+      
+      ! Get date of point with index 0
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
+         &        cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
+         &                                 'units', len = iilen,  &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
+         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
+         &                       ctmp ), cpname, __LINE__ )
+      jl=1
+      DO jm = 1, LEN(TRIM(ctmp))
+         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
+            cdjuldref(jl:jl) = ctmp(jm:jm)
+            jl=jl+1
+         ENDIF
+         IF (jl>14) EXIT
+      END DO
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF ( itype /= NF90_DOUBLE ) THEN
+         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
+         &                       zbeginmiss ), cpname, __LINE__ )
+
+      ! Get indices of data in theoretical profile
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
+         &       cpname, __LINE__ )
+      
+      ! Get SLA data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = idata
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                        == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       'scale_factor',zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     '_FillValue',zfill), cpname,  __LINE__ )
+      ENDIF
+      WHERE(zsla(:,:) /=  zfill)
+         zsla(:,:) = zsca * zsla(:,:)
+      ELSEWHERE
+         zsla(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get the global Mission netCDF attribute
+      
+      cmission='   '
+      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
+         &                                 'Mission', len = iilen,  &
+         &                                 xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
+         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
+         &                       cmission ), cpname, __LINE__ )
+      
+      ! Convert it to an integer
+      imission = 0
+      DO jm = 1, imaxmissions
+         IF (cmission==cmissions(jm)) THEN
+            imission = jm
+            EXIT
+         ENDIF
+      END DO
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Compute Julian dates for all observations
+      
+      jm = 0
+      jl = 0
+      DO jj = 1, itracks
+         DO ji = 1, ipnbpoints(jj)
+            jl = jl + 1
+            DO jk = 1, icycles
+               jm = jm + 1
+               IF (zbegindates(jk,jj)==zbeginmiss) THEN
+                  llskip(jm) = .TRUE.
+                  zjuld(jm)  = fbrmdi
+               ELSE
+                  llskip(jm) = .FALSE.
+                  zjuld(jm)  = zbegindates(jk,jj) + &
+                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Get rid of missing data
+
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
+         END DO
+      END DO
+      
+      ! Allocate obfbdata
+
+      iobs = COUNT( .NOT.llskip(:) )
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SLA'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = cdjuldref
+      iobs = 0
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (llskip(jm)) CYCLE
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
+            ! Real values
+            inpfile%plam(iobs)         = zlam(jobs)
+            inpfile%pphi(iobs)         = zphi(jobs)
+            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
+            inpfile%ptim(iobs)         = zjuld(jm)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            inpfile%ioqc(iobs)      = 1
+            inpfile%ivqc(iobs,1)    = 1
+            inpfile%ivlqc(1,iobs,1) = 1
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+
+      ! Deallocate memory for input data
+
+      DEALLOCATE( &
+         & iptracks,      &
+         & ipnbpoints,    &
+         & ipcycles,      &
+         & zphi,          &
+         & zlam,          &  
+         & zbegindates,   &
+         & ipdataindexes, &
+         & zsla,          &
+         & zjuld,         &
+         & llskip         &
+         & )
+
+   END SUBROUTINE read_avisofile
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 8732)
@@ -0,0 +1,9 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obssla_types.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   INTEGER, PARAMETER :: imaxmissions=8
+   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
+      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssst_io.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssst_io.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/obssst_io.h90	(revision 8732)
@@ -0,0 +1,286 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obssst_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_ghrsst **
+      !!
+      !! ** Purpose : Read from file the GHRSST observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
+      INTEGER :: i_file_id        ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data           ! Number of data per parameter in current file
+      INTEGER :: i_time           ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of SST measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_sst            ! SST data     
+      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
+      INTEGER :: iilen            ! Length of netCDF attributes
+      INTEGER :: itype            ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca           ! Scale factor
+      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
+      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
+      CHARACTER (len=33) :: creftime  ! Reference time of file
+      INTEGER :: i_refyear            ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_sst        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get SST data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_sst(:,:) /=  zfill)
+         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
+      ELSEWHERE
+         z_sst(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get SST obs type
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
+         &       cpname, __LINE__ )
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SST'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+      DEALLOCATE( &
+         & i_reftime, &
+         & i_dtime,   &
+         & i_qc,      &
+         & i_type,    &
+         & z_phi,     &
+         & z_lam,     &
+         & z_sst      &
+         & )
+
+   END SUBROUTINE read_ghrsst
+
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90	(revision 8732)
@@ -0,0 +1,1283 @@
+#define __MYFILE__ 'omonainfo.F90'
+MODULE omonainfo
+   
+   ! Specific utilities for omona files
+   ! 
+   ! History
+   ! Original: Magdalena A. Balmaseda
+   !           2010: Split as to remove "scale factor information", 
+   !           which is now in auxgrid
+   !
+   
+   
+   USE netcdf
+   USE nctools
+   USE ioncdf
+   USE coords
+!   USE orcagrid
+
+   CHARACTER(len=4)    :: cl_expnam  
+   CHARACTER(len=8)    :: cl_date
+   CHARACTER(len=80)   :: cl_filename_out
+   CHARACTER(len=80)   :: cl_filename2_out 
+   CHARACTER(len=3)    :: cl_code
+   CHARACTER(len=1)    :: cl_grid
+   CHARACTER(len=80)   :: cl_var,cl_var_out
+   CHARACTER(len=80)   :: cl_varname1, cl_varname2, cl_varunit1, cl_varunit2
+   CHARACTER(len=1)    :: sec !o =box average omona
+                              !x =zonal section. Integral along x
+                              !y =meridional section. Integral along y
+
+   CHARACTER(len=1)    :: grid0='?'
+   
+   INTEGER ::  i_nb_dims,i_dp
+   INTEGER ::  i_fill
+   REAL, DIMENSION(:,:),     ALLOCATABLE :: z_var_2d
+   REAL, DIMENSION(:,:,:),   ALLOCATABLE :: z_var_3d
+   REAL, DIMENSION(:),       ALLOCATABLE :: z_dep2
+
+   PUBLIC  :: variable_att, write_omona_netcdf, &
+      &       write_dep_netcdf, create_time_series_netcdf_file
+
+   
+   INTERFACE write_omona_netcdf
+      MODULE PROCEDURE write_omona_netcdf_2d_r, write_omona_netcdf_3d_r
+   END INTERFACE
+   
+CONTAINS
+
+   !
+   !----------------------------------------------------------------------
+   !
+   ! W R I T E _ O M O N A _ N E T C D F
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE write_omona_netcdf_2d_r (cl_filename, z_field,i_time, &
+      cl_boxes, z_missing,i_fill)
+      !
+      ! write a 2d array (time_serie) of reals
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER(len=80), INTENT(in)                :: cl_filename
+      INTEGER, DIMENSION(:), INTENT(in)            :: i_time
+      INTEGER, INTENT(inout)                       :: i_fill
+      REAL, DIMENSION(:,:), INTENT(in)             :: z_field
+      REAL, INTENT(in)                             :: z_missing
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+      
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_var_exist, i_pos
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_nb_files,i_z, i_b
+      INTEGER               :: i_tim_id,i_box_id
+      INTEGER               :: i_time_var
+      INTEGER               :: i_file
+      INTEGER, DIMENSION(2) :: i_dim, i_tab_start, i_tab_count
+      INTEGER               :: i_rest_start, i_rest_end
+      INTEGER               :: i_time0, i_time1
+      REAL                  :: z_min, z_max
+      REAL                  :: z_min_old, z_max_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_rest
+      INTEGER               :: i_t
+      REAL, DIMENSION(:,:), ALLOCATABLE :: z_old_2d
+      !
+      i_tab_start(1) = 1
+      i_z=1
+      i_b=SIZE(z_field,1)
+      i_nb_files = SIZE(z_field,2)
+      i_tab_count(1) = i_b
+      i_tab_count(2) = i_nb_files
+      i_rest_start = 0
+      i_rest_end   = 0
+      i_time0      = 0
+      i_time1      = 0
+      
+      WRITE(6,*)' Input time dimensions ',i_nb_files
+      WRITE(6,*)' file for output       ',cl_filename
+      !
+      z_min = MINVAL(z_field, mask = z_field .NE. z_missing )
+      z_max = MAXVAL(z_field, mask = z_field .NE. z_missing )
+      !
+      
+      INQUIRE( FILE=cl_filename_out, EXIST=clbon )
+      WRITE(*,*)' Inquiring clbon ',clbon
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes)
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+      !     
+      WRITE(*,*)' opening file ',cl_filename
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      
+      WRITE(*,*)' Inquiring var ',cl_var_out
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var_out, i_var_id ) 
+      WRITE(*,*)' i_var_exist ',i_var_exist, i_var_id
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+         i_dim(1) = i_box_id
+         i_dim(2) = i_tim_id
+         !         write(*,*)' i_dim ',i_dim
+         !
+         CALL nchdlerr( nf90_redef(i_file_id) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var(i_file_id, cl_var_out, nf90_real, i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', cl_varname1 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', cl_varname2 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units',cl_varunit1 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long',cl_varunit2 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'missing_value', z_missing ) ,__LINE__,__MYFILE__)
+         WRITE(*,*)'nf_put valid_min ',z_min
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         WRITE(*,*)'nf_put valid_max ',z_max
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+         i_pos = 1 
+         i_tab_start(2)=1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,__LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+ 
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_tim_id,len=i_pos ) ,__LINE__,__MYFILE__)
+         ALLOCATE(i_time_old(i_pos))
+         
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_var, i_time_old ) ,__LINE__,__MYFILE__)
+         i_tab_start(2)=i_pos+1
+         DO i_t=i_pos,1,-1
+            IF(i_time_old(i_t).GE.i_time(1)) THEN
+               i_tab_start(2)=i_t
+            ELSE
+               EXIT
+            ENDIF
+         ENDDO
+         WRITE(*,*)' i_tab_start(2)',i_tab_start(2)
+
+         IF (I_FILL == 1 ) THEN
+           DO i_t=1,i_tab_start(2),1
+             IF(i_time_old(i_t).LT.i_time(1)) THEN
+                i_time0=i_t+1
+             ELSE
+                EXIT
+             ENDIF
+          ENDDO
+          WRITE(*,*)' i_tab_start(2), i_time0',i_tab_start(2),i_time0
+          i_time0=min(i_time0,i_tab_start(2))
+          i_tab_start(2)=i_time0
+          i_time1=i_tab_start(2)+i_tab_count(2)-1
+          WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(2)-1),i_time(1)
+          i_rest_start=i_time1+1
+          i_rest_end = i_pos
+          IF ( i_rest_end .gt. i_rest_start ) THEN
+            ALLOCATE( z_old_2d(i_b, i_pos))
+            CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, z_old_2d ) ,__LINE__,__MYFILE__)
+            z_old_2d(:,i_time0:i_time1)=z_field
+            i_time_old(i_time0:i_time1)=i_time
+            i_tab_start(2)=1
+            i_tab_count(2)=i_pos
+            WRITE(*,*)' writing output I_FILL i_time0 ',i_time0
+            WRITE(*,*)' writing output I_FILL i_time1 ',i_time1
+            CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+            & z_old_2d, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time_old,start=(/i_tab_start(2)/), count=(/i_tab_count(2)/)),__LINE__,__MYFILE__)
+          ELSE
+            I_FILL = 0
+            DEALLOCATE(i_time_old)
+            DEALLOCATE(i_time_rest)
+            DEALLOCATE(z_old_2d)
+          ENDIF
+         ELSE
+         WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(2)-1),i_time(1)
+         DEALLOCATE(i_time_old)
+         ENDIF
+      ENDIF
+      !
+      IF ( I_FILL == 0 ) THEN
+         WRITE(*,*)' writing output start ',i_tab_start
+	 WRITE(*,*)' writing output count ',i_tab_count
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+         & z_field, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time,start=(/i_tab_start(2)/), count=(/i_tab_count(2)/)),__LINE__,__MYFILE__)
+      ENDIF
+
+      !
+      
+      CALL nchdlerr( nf90_close( i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      RETURN
+      !
+   END SUBROUTINE write_omona_netcdf_2d_r
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE write_omona_netcdf_3d_r (cl_filename, z_field,i_time, &
+                                       cl_boxes, z_missing, i_fill)
+!
+! write a 3d array (time_serie) of reals
+!
+      IMPLICIT NONE
+!
+      CHARACTER(len=80), INTENT(in)                :: cl_filename 
+      INTEGER, DIMENSION(:), INTENT(in)            :: i_time
+      INTEGER, INTENT(inout)                       :: i_fill
+      REAL, DIMENSION(:,:,:), INTENT(in)           :: z_field
+      REAL, INTENT(in)                             :: z_missing
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+
+!
+      LOGICAL               :: clbon
+      INTEGER               :: i_var_exist, i_pos
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_nb_files,i_z,i_b
+      INTEGER               :: i_tim_id,i_box_id,i_z_id
+      INTEGER               :: i_time_var
+      INTEGER               :: i_file
+      INTEGER, DIMENSION(3) :: i_dim, i_tab_start, i_tab_count
+      INTEGER               :: i_rest_start, i_rest_end
+      INTEGER               :: i_time0, i_time1
+      REAL                  :: z_min, z_max
+      REAL                  :: z_min_old, z_max_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_rest
+      INTEGER               :: i_t
+      REAL, DIMENSION(:,:,:), ALLOCATABLE :: z_old_3d
+!
+      i_tab_start(1) = 1
+      i_tab_start(2) = 1
+      i_tab_start(3) = 1
+      i_z=SIZE(z_field,1)   !depth
+      i_b=SIZE(z_field,2)   !nbox
+      i_nb_files = SIZE(z_field,3)
+      i_tab_count(1) = i_z
+      i_tab_count(2) = i_b
+      i_tab_count(3) = i_nb_files
+      i_time0        = 0
+      i_time1        = 0
+      i_rest_start   = 0
+      i_rest_end     = 0
+
+!      write(6,*)' in write_3d ,shape(z_field) ',shape(z_field)
+!      write(6,*)' i_z =',i_z
+!      write(6,*)' i_b =',i_b
+!      write(6,*)' i_nb_files =',i_nb_files
+
+
+!
+      z_min = MINVAL(z_field, mask = z_field .NE. z_missing )
+      z_max = MAXVAL(z_field, mask = z_field .NE. z_missing )
+!
+      INQUIRE( FILE=cl_filename, EXIST=clbon )
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes)
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+!     
+      WRITE(*,*)' opening file ',cl_filename
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+!
+      WRITE(*,*)'Inquiring var ',cl_var_out, i_var_id
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var_out, i_var_id)
+      WRITE(*,*)'i_var_exist ',i_var_exist
+
+      IF ( i_var_exist .NE. 0 ) THEN
+!       write(*,*)' Inquiring dimensions'
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'depth', i_z_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+
+       i_dim(1) = i_z_id
+       i_dim(2) = i_box_id
+       i_dim(3) = i_tim_id
+!       write(*,*)' In write_omona_ncdf_3d: Dimensions: i_dim ',i_dim
+
+
+       CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_def_var( i_file_id, cl_var_out,  nf90_real,i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', cl_varname1 ),__LINE__,__MYFILE__ )
+       CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', cl_varname2 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', cl_varunit1 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', cl_varunit2 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'missing_value', z_missing ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+!
+        CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+!       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+!        write(6,*)' inq_dimid ',i_tim_id
+        CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+        WRITE(*,*) 'inq_varid i_tim_id for var time ',i_time_var
+        i_pos = 1 
+        i_tab_start(3)=1
+      ELSE
+        !new addition
+!        CALL nchdlerr (nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dim ) ,__LINE__,__MYFILE__)
+!        write(6,*)' after inquire variable i_dim = ',i_dim
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(1), len(1) ',i_dim(1),i_pos
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(2), len(2) ',i_dim(2),i_pos
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(3), len(3) ',i_dim(3),i_pos
+        !!!!
+
+        CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,__LINE__,__MYFILE__)
+        z_min = MIN( z_min, z_min_old )
+        z_max = MAX( z_max, z_max_old )
+        CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+
+ 
+!        CALL nchdlerr( nf90_inq_varid( i_file_id, 'depth', i_z_id ) ,__LINE__,__MYFILE__)
+!        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_z_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!        write(*,*)' i_z_id, dim ',i_z_id,i_pos
+
+!        CALL nchdlerr( nf90_inq_varid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+!        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_box_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!        write(*,*)' i_box_id, dim ',i_box_id,i_pos
+
+
+ 
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+!        write(6,*)' inq_dimid ',i_tim_id
+        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_tim_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!       write(*,*) 'inq_var_id i_tim_id,dim ',i_tim_id,i_pos
+        ALLOCATE(i_time_old(i_pos))
+        CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+!        write(*,*) 'inq_var_id time',i_time_var
+        CALL nchdlerr( nf90_get_var( i_file_id, i_time_var, i_time_old ) ,__LINE__,__MYFILE__)
+        i_tab_start(3)=i_pos+1
+        DO i_t=i_pos,1,-1
+          IF(i_time_old(i_t).GE.i_time(1)) THEN
+            i_tab_start(3)=i_t
+          ELSE
+            EXIT
+         ENDIF
+        ENDDO
+
+         WRITE(*,*)'i_tab_start(3)',i_tab_start(3)
+         WRITE(*,*)'i_tab_count(3)',i_tab_count(3)
+
+         IF (I_FILL == 1 ) THEN
+           DO i_t=1,i_tab_start(3),1
+             IF(i_time_old(i_t).LT.i_time(1)) THEN
+                i_time0=i_t+1
+             ELSE
+                EXIT
+             ENDIF
+           ENDDO
+
+           i_time0=min(i_time0,i_tab_start(3))
+           i_tab_start(3)=i_time0
+           i_time1=i_time0+i_tab_count(3)-1
+           WRITE(*,*)'i_time0,i_tab_count(3),i_time1',i_Time0,i_tab_count(3),i_time1
+           WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(3)-1),i_time(1)
+           i_rest_start=i_time1+1
+           i_rest_end = i_pos
+          IF ( i_rest_end .gt. i_rest_start ) THEN
+            ALLOCATE( z_old_3d(i_z,i_b, i_pos))
+            CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, z_old_3d ) ,__LINE__,__MYFILE__)
+            z_old_3d(:,:,i_time0:i_time1)=z_field
+            i_time_old(i_time0:i_time1)=i_time
+            i_tab_start(3)=1
+            i_tab_count(3)=i_pos
+            WRITE(*,*)' writing output I_FILL i_time0 ',i_time0
+            WRITE(*,*)' writing output I_FILL i_time1 ',i_time1
+            CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+            & z_old_3d, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time_old,start=(/i_tab_start(3)/), count=(/i_tab_count(3)/)),__LINE__,__MYFILE__)
+          ELSE
+            I_FILL = 0
+            DEALLOCATE(i_time_old)
+            DEALLOCATE(i_time_rest)
+            DEALLOCATE(z_old_3d)
+          ENDIF
+         ELSE
+          WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(3)-1),i_time(1)
+          DEALLOCATE(i_time_old)
+         ENDIF
+      ENDIF
+      !
+      IF ( I_FILL == 0 ) THEN
+         WRITE(*,*)' writing output count ',i_tab_count
+         WRITE(*,*)' writing output start ',i_tab_start
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+           z_field, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+           i_time,start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ),__LINE__,__MYFILE__)
+      ENDIF
+!
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+!
+      RETURN
+      !
+   END SUBROUTINE write_omona_netcdf_3d_r
+   !!----------------------------------------------------------------------
+   !
+   SUBROUTINE write_dep_netcdf ( cl_filename, cl_boxes, z_dep )
+      !
+      ! write a 2d array (map) of reals
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER(len=80), INTENT(in)    :: cl_filename
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+      REAL, DIMENSION(:),   INTENT(in) :: z_dep
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_dim_z_id
+      INTEGER               :: i_dimz, i_var_exist
+      INTEGER, DIMENSION(1) :: i_dim
+      REAL                  :: z_min, z_max
+      !
+      i_dimz = i_dp
+      !
+      z_min = MINVAL(z_dep)
+      z_max = MAXVAL(z_dep)
+      !
+      INQUIRE( FILE=cl_filename, EXIST=clbon )
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes )
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+      !     
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'depth', i_dim_z_id ) ,__LINE__,__MYFILE__)
+      i_dim(1) = i_dim_z_id
+      !      write(6,*)' defining depth axis : i_dim(1)= ',i_dim(1)
+      !
+      i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id ) 
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_real,i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name','depth') ,__LINE__,__MYFILE__) 
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface') ,__LINE__,__MYFILE__) 
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long','meter' ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+      ENDIF
+      !
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, z_dep) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_close( i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      RETURN
+      !
+   END SUBROUTINE write_dep_netcdf
+   !
+   !
+   !----------------------------------------------------------------------
+   !
+   ! C R E A T E _ T I M E _ S E R I E S _ N E T C D F _ F I L E
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE create_time_series_netcdf_file ( cl_filename,cl_boxes)
+      !
+      ! create time_series netcdf file
+      !
+      IMPLICIT NONE
+      !
+
+      CHARACTER(len=80), INTENT(in)         :: cl_filename
+      CHARACTER(len=20), DIMENSION(:)       :: cl_boxes
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_file_id, i_dim_z_id, i_dim_box_id, &
+         i_dim_len_id, i_dim_t_id
+      INTEGER               :: i_box_id, i_tim_id
+      INTEGER               :: i_nbox
+      !
+      i_nbox = SIZE(cl_boxes,1)
+      !
+      
+      WRITE(*,*)' create_time_series',cl_filename
+      CALL nchdlerr( nf90_create( cl_filename, nf90_clobber, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'len', 20, i_dim_len_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'depth',i_dp, i_dim_z_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'box', i_nbox, i_dim_box_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'time', nf90_unlimited, i_dim_t_id ) ,__LINE__,__MYFILE__)
+
+
+      WRITE(*,*)' In create_time_series_ntcdf'
+      WRITE(*,*)' z,box,time:       ',i_dim_z_id,i_dim_box_id, i_dim_t_id
+
+      WRITE(*,*)' Definining box var '
+      CALL nchdlerr( nf90_def_var( i_file_id, 'box', nf90_char, &
+         (/i_dim_len_id,i_dim_box_id/), i_box_id ),__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_box_id, &
+         'long_name', 'Name of the box' ) ,__LINE__,__MYFILE__)
+
+      WRITE(*,*)' Definining time var'
+      CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, &
+         (/i_dim_t_id/),i_tim_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'standard_name','time') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'long_name','time') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'unit','days as %Y%m%d') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'unit_long','days as %Y%m%d') ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_put_var( i_file_id, i_box_id, cl_boxes &
+         ),__LINE__,__MYFILE__ )
+      !
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+      !
+      RETURN
+      !
+   END SUBROUTINE create_time_series_netcdf_file
+
+
+   !-----------------------------------------------------------------------
+   SUBROUTINE variable_att
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE variable_att
+      !                     **********************
+      !
+      !  Purpose :
+      !  -------
+      !    set attributes for a given variable name 
+      !
+      !  Original :  M. Balmaseda
+      IMPLICIT NONE
+      !-----------------------------------------------------------------------
+      !   Different variables
+      !-----------------------------------------------------------------------
+      !
+      INTEGER:: ji,jj,jk
+      REAL   :: dx0    !nominal longitudinal resolution in deg
+      REAL   :: alat, alon,aux
+      INTEGER,DIMENSION(:,:), ALLOCATABLE:: iaux
+
+      SELECT CASE ( TRIM(cl_var) )
+      CASE ('sosstsst')
+         i_nb_dims=2
+         cl_var_out='specified_sea_surface_temperature'
+         cl_varname1='Sea_Surface_Temperature'
+         cl_varname2='Sea Surface Temperature'
+         cl_varunit1='C'
+         cl_varunit2='degrees C'
+         cl_code='159'
+         cl_grid='t'
+      CASE ('somxl010')
+         i_nb_dims=2
+         cl_var_out='ocean_mixed_layer_thickness'
+         cl_varname1='ocean_mixed_layer_thickness'
+         cl_varname2='depth of the ocean mixed layer from the surface'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='148'
+         cl_grid='t'
+      CASE ('somixhgt')
+         i_nb_dims=2
+         cl_var_out='turbocline_depth'
+         cl_varname1='turbocline_depth'
+         cl_varname2='turbocline depth'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='248'
+         cl_grid='t'
+      CASE ('somxlt05')
+         i_nb_dims=2
+         cl_var_out='ocean_mixed_layer_depth'
+         cl_varname1='ocean_mixed_layer_depth'
+         cl_varname2='depth of the ocean mixed layer T 0.5 criteria'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='348'
+         cl_grid='t'
+      CASE ('sohtc300')
+         i_nb_dims=2
+         cl_var_out='hc300'
+         cl_varname1='300m_ocean_heat_content'
+         cl_varname2='ocean heat content over the first 300m'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='164'
+         cl_grid='t'
+      CASE ('sohtc700')
+         i_nb_dims=2
+         cl_var_out='hc700'
+         cl_varname1='700m_ocean_heat_content'
+         cl_varname2='ocean heat content over the first 700m'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='264'
+         cl_grid='t'
+      CASE ('sohtcbtm')
+         i_nb_dims=2
+         cl_var_out='hcbtm'
+         cl_varname1='Column_ocean_heat_content'
+         cl_varname2='ocean heat content over the whole column'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='364'
+         cl_grid='t'
+      CASE ('sosal300')
+         i_nb_dims=2
+         cl_var_out='sal300'
+         cl_varname1='300m_integrated salinity'
+         cl_varname2='salinity integrated over the first 300m'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='175'
+         cl_grid='t'
+      CASE ('sosal700')
+         i_nb_dims=2
+         cl_var_out='sal700'
+         cl_varname1='700m_integrated salinity'
+         cl_varname2='salinity integrated over the first 700m'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='275'
+         cl_grid='t'
+      CASE ('sosalbtm')
+         i_nb_dims=2
+         cl_var_out='salbtm'
+         cl_varname1='Column_integrate_salinity'
+         cl_varname2='Integrated Salinity over the whole column'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='375'
+         cl_grid='t'
+      CASE ('so20chgt')
+         i_nb_dims=2
+         cl_var_out='d20_isotherm_depth'
+         cl_varname1='depth'
+         cl_varname2='depth of the D20 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='163'
+         cl_grid='t'
+      CASE ('so28chgt')
+         i_nb_dims=2
+         cl_var_out='d28_isotherm_depth'
+         cl_varname1='28I_depth'
+         cl_varname2='depth of the D28 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='263'
+         cl_grid='t'
+      CASE ('so26chgt')
+         i_nb_dims=2
+         cl_var_out='d26_isotherm_depth'
+         cl_varname1='26I_depth'
+         cl_varname2='depth of the D26 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='463'
+         cl_grid='t'
+      CASE ('sothedep')
+         i_nb_dims=2
+         cl_var_out='thermocline_depth'
+         cl_varname1='thermocline_depth'
+         cl_varname2='thermocline depth'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='363'
+         cl_grid='t'
+      CASE ('sossheig')
+         i_nb_dims=2
+         cl_var_out='sea_surface_height_above_geoid'
+         cl_varname1='sea_surface_height_above_geoid'
+         cl_varname2='sea_surface_height_above_geoid'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='145'      
+         cl_grid='t'
+      CASE ('sostheig')
+         i_nb_dims=2
+         cl_var_out='steric_height'
+         cl_varname1='steric_height'
+         cl_varname2='steric_height'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='150'      
+         cl_grid='t'
+      CASE ('sobpheig')
+         i_nb_dims=2
+         cl_var_out='bottom_pressure_equivalent_height'
+         cl_varname1='Bottom Pressure'
+         cl_varname2='Bottom Pressure'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='149'      
+         cl_grid='t'
+      CASE ('sohefldo')
+         i_nb_dims=2
+         cl_var_out='specified_surface_heat_flux'
+         cl_varname1='Net Downward Heat Flux'
+         cl_varname2='Net Downward Heat Flux'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='160'      
+         cl_grid='t'
+      CASE ('sohefldp')
+         i_nb_dims=2
+         cl_var_out='heat_flux_correction'
+         cl_varname1='Surface_Heat_Flux_Damping'
+         cl_varname2='Surface Heat Flux: Damping'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='162'      
+         cl_grid='t'
+      CASE ('soshfldo')
+         i_nb_dims=2
+         cl_var_out='absorbed_solar_radiation'
+         cl_varname1='Shortwave_Radiation'
+         cl_varname2='Shortwave Radiation'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='157'      
+         cl_grid='t'
+      CASE ('sosalflx')
+         i_nb_dims=2
+         cl_var_out='Surface_Salt_Flux'
+         cl_varname1='Surface_Salt_Flux'
+         cl_varname2='Surface Salt Flux'
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='260'      
+         cl_grid='t'
+      CASE ('sosafldp')
+         i_nb_dims=2
+         cl_var_out='Surface_salt_flux_damping'
+         cl_varname1=cl_var_out
+         cl_varname2='Surface salt flux: damping'
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='261'      
+         cl_grid='t'
+      CASE ('sowaflup')
+         i_nb_dims=2
+         cl_var_out='Net_Upward_Water_Flux'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='258'      
+         cl_grid='t'
+      CASE ('sowafldp')
+         i_nb_dims=2
+         cl_var_out='Surface_Water_Flux_Damping'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='262'      
+         cl_grid='t'
+      CASE ('soicetem')
+         i_nb_dims=2
+         cl_var_out='Ice_Surface_Temperature'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='K'
+         cl_varunit2='Kelvin'
+         cl_code='429'      
+         cl_grid='t'
+      CASE ('soicealb')
+         i_nb_dims=2
+         cl_var_out='Ice_Albedo'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='dl'
+         cl_varunit2='dimensionless'
+         cl_code='430'      
+         cl_grid='t'
+      CASE ('soicecov')
+         i_nb_dims=2
+         cl_var_out='Ice_Fraction'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='dl'
+         cl_varunit2='dimensionless'
+         cl_code='431'      
+         cl_grid='t'
+      CASE ('votemper')
+         i_nb_dims=3
+         cl_var_out='sea_water_potential_temperature'
+         cl_varname1='sea_water_potential_temperature'
+         cl_varname2='Potential temperature ref to surface C'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celcius'
+         cl_code='129'
+         cl_grid='t'
+      CASE ('vosaline')
+         i_nb_dims=3
+         cl_var_out='sea_water_salinity'
+         cl_varname1='sea_water_salinity'
+         cl_varname2='sea water salinity'
+         cl_varunit1='PSU'
+         cl_varunit2='practical_salinity_scale'
+         cl_code='130'
+         cl_grid='t'
+      CASE ('vosigmat')
+         i_nb_dims=3
+         cl_var_out='sigmat'
+         cl_varname1='sigmat'
+         cl_varname2='sigmat'
+         cl_varunit1='C'
+         cl_varunit2='NA'
+         cl_code='138'
+         cl_grid='t'
+      CASE ('vottrdmp')
+         i_nb_dims=3
+         cl_var_out='Damping_T_3D'
+         cl_varname1='Damping_T_3D'
+         cl_varname2='Damping T 3D'
+         cl_varunit1='C/s'
+         cl_varunit2='degree_Celsius/second'
+         cl_code='201'
+         cl_grid='t'
+      CASE ('vostrdmp')
+         i_nb_dims=3
+         cl_var_out='Damping_S_3D'
+         cl_varname1='Damping_S_3D'
+         cl_varname2='Damping S_3D'
+         cl_varunit1='psu/s'
+         cl_varunit2='psu/second'
+         cl_code='202'
+         cl_grid='t'
+      CASE ('votbiasd')
+         i_nb_dims=3
+         cl_var_out='Bias_T_direct'
+         cl_varname1='Bias_T_direct'
+         cl_varname2='Bias_T_direct'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celsius'
+         cl_code='203'
+         cl_grid='t'
+      CASE ('vosbiasd')
+         i_nb_dims=3
+         cl_var_out='Bias_S_direct'
+         cl_varname1='Bias_S_direct'
+         cl_varname2='Bias_S_direct'
+         cl_varunit1='psu'
+         cl_varunit2='psu'
+         cl_code='204'
+         cl_grid='t'
+      CASE ('votbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_T_pressure'
+         cl_varname1='Bias_T_pressure'
+         cl_varname2='Bias_T_pressure'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celsius'
+         cl_code='205'
+         cl_grid='t'
+      CASE ('vosbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_S_pressure'
+         cl_varname1='Bias_S_pressure'
+         cl_varname2='Bias_S_pressure'
+         cl_varunit1='psu'
+         cl_varunit2='psu'
+         cl_code='206'
+         cl_grid='t'
+      CASE ('vorbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_rho_pressure'
+         cl_varname1='Bias_rho_pressure'
+         cl_varname2='Bias_rho_pressure'
+         cl_varunit1='kg/m3/s'
+         cl_varunit2='kg/m3/s'
+         cl_code='207'
+         cl_grid='t'
+      CASE ('sozotaux')
+         i_nb_dims=2
+         cl_var_out='surface_downward_eastward_stress'
+         cl_varname1='Wind_Stress_along_i-axis'
+         cl_varname2=cl_var_out
+         cl_varunit1='N/m2'
+         cl_varunit2='N/m2'
+         cl_code='153'      
+         cl_grid='u'
+         if (sec .eq. 'v') then
+            cl_varname2='taux*x*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+         if (sec .eq. 'u') then
+            cl_varname2='taux*y*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vozocrtx')
+         i_nb_dims=3
+         cl_var_out='sea_water_x_velocity'
+         cl_varname1='sea_water_x_velocity'
+         cl_varname2='U zonal current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='131'
+         cl_grid='u'
+         if (sec .eq. 'u') then
+            cl_var_out='zonal_transport'
+            cl_varname1='zonal_transport'
+            cl_varname2='zonal_transport'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vozout')
+         i_nb_dims=3
+         cl_var_out='UT'
+         cl_varname1='UT'
+         cl_varname2='UT'
+         cl_varunit1='K*m/s'
+         cl_varunit2='K*m/s'
+         cl_code='169'
+         cl_grid='t'
+         if (sec .eq. 'u') then
+          cl_var_out='zonal_H_transport'
+          cl_varname1='zonal_H_transport'
+          cl_varname2='zonal_H_transport'
+          cl_varunit1='PW'
+          cl_varunit2='PW'
+         endif
+      CASE ('vozous')
+         i_nb_dims=3
+         cl_var_out='US'
+         cl_varname1='US'
+         cl_varname2='US'
+         cl_varunit1='psu*m/s'
+         cl_varunit2='psu*m/s'
+         cl_code='171'
+         cl_grid='t'
+         if (sec .eq. 'u') then
+          cl_var_out='zonal_S_transport'
+          cl_varname1='zonal_S_transport'
+          cl_varname2='zonal_S_transport'
+          cl_varunit1='kT/s'
+          cl_varunit2='kT/s'
+         endif
+      CASE ('vomecrty')
+         i_nb_dims=3
+         cl_var_out='sea_water_y_velocity'
+         cl_varname1='sea_water_y_velocity'
+         cl_varname2='V meridional current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='132'
+         cl_grid='v'
+         if (sec .eq. 'v') then
+            cl_var_out='meridional_transport'
+            cl_varname1='meridional_transport'
+            cl_varname2='meridional_transport'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('sometauy')
+         i_nb_dims=2
+         cl_var_out='surface_downward_northward_stress'
+         cl_varname1='Wind_Stress_along_j-axis'
+         cl_varname2=cl_var_out
+         cl_varunit1='N/m2'
+         cl_varunit2='N/m2'
+         cl_code='154'      
+         cl_grid='v'
+         if (sec .eq. 'v') then
+            cl_varname2='tauy*x*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+         if (sec .eq. 'u') then
+            cl_varname2='tauy*y*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vomevt')
+         i_nb_dims=3
+         cl_var_out='VT'
+         cl_varname1='VT'
+         cl_varname2='VT'
+         cl_varunit1='K*m/s'
+         cl_varunit2='K*m/s'
+         cl_code='170'
+         cl_grid='t'
+         if (sec .eq. 'v') then
+          cl_var_out='meridional_H_transport'
+          cl_varname1='meridional_H_transport'
+          cl_varname2='meridional_H_transport'
+          cl_varunit1='PW'
+          cl_varunit2='PW'
+         endif
+      CASE ('vomevs')
+         i_nb_dims=3
+         cl_var_out='VS'
+         cl_varname1='VS'
+         cl_varname2='VS'
+         cl_varunit1='psu*m/s'
+         cl_varunit2='psu*m/s'
+         cl_code='172'
+         cl_grid='t'
+         if (sec .eq. 'v') then
+          cl_var_out='meridional_S_transport'
+          cl_varname1='meridional_S_transport'
+          cl_varname2='meridional_S_transport'
+          cl_varunit1='kT/s'
+          cl_varunit2='kT/s'
+         endif
+      CASE ('vovecrtz')
+         i_nb_dims=3
+         cl_var_out='upward_sea_water_velocity'
+         cl_varname1='upward_sea_water_velocity'
+         cl_varname2='W vertical current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='133'
+         cl_grid='f'
+      CASE ('votkeavm')
+         i_nb_dims=3
+         cl_var_out='vertical_eddy_viscosity'
+         cl_varname1='vertical_eddy_viscosity'
+         cl_varname2='vertical eddy viscosity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='135'
+         cl_grid='f'
+      CASE ('votkeavt')
+         i_nb_dims=3
+         cl_var_out='vertical_eddy_diffusivity'
+         cl_varname1='vertical_eddy_diffusivity'
+         cl_varname2='vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='136'
+         cl_grid='f'
+      CASE ('votkeevm')
+         i_nb_dims=3
+         cl_var_out='enhanced_vertical_eddy_viscosity'
+         cl_varname1='enhanced_vertical_eddy_viscosity'
+         cl_varname2='enhanced vertical eddy viscosity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='235'
+         cl_grid='f'
+      CASE ('votkeevd')
+         i_nb_dims=3
+         cl_var_out='enhanced_vertical_eddy_diffusivity'
+         cl_varname1='enhanced_vertical_eddy_diffusivity'
+         cl_varname2='enhanced vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='236'
+         cl_grid='f'
+      CASE ('voddmavs')
+         i_nb_dims=3
+         cl_var_out='salt_vertical_eddy_diffusivity'
+         cl_varname1='salt_vertical_eddy_diffusivity'
+         cl_varname2='salt vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='237'
+         cl_grid='f'
+      CASE ('bckint')
+         i_nb_dims=3
+         cl_var_out='assim_incr_temperature'
+         cl_varname1='assim_incr_temperature'
+         cl_varname2='assim_incr_temperature'
+         cl_varunit1='K/s'
+         cl_varunit2='Kelvin_per_second'
+         cl_code='178'
+         cl_grid='t'
+      CASE ('bckins')
+         i_nb_dims=3
+         cl_var_out='assim_incr_salinity'
+         cl_varname1='assim_incr_salinity'
+         cl_varname2='assim_incr_salinity'
+         cl_varunit1='psu/s'
+         cl_varunit2='psu_per_second'
+         cl_code='184'
+         cl_grid='t'
+      CASE ('bckinu')
+         i_nb_dims=3
+         cl_var_out='assim_incr_uvel'
+         cl_varname1='assim_incr_uvel'
+         cl_varname2='assim_incr_uvel'
+         cl_varunit1='m/s2'
+         cl_varunit2='meter_per_square_second'
+         cl_code='179'
+         cl_grid='u'
+      CASE ('bckinv')
+         i_nb_dims=3
+         cl_var_out='assim_incr_vvel'
+         cl_varname1='assim_incr_vvel'
+         cl_varname2='assim_incr_vvel'
+         cl_varunit1='m/s2'
+         cl_varunit2='meter_per_square_second'
+         cl_code='180'
+         cl_grid='v'
+      CASE ('bckineta')
+         i_nb_dims=2
+         cl_var_out='assim_incr_eta'
+         cl_varname1='assim_incr_eta'
+         cl_varname2='assim_incr_eta'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='181'
+         cl_grid='t'
+      CASE ('vozoeivu')
+         i_nb_dims=3
+         cl_var_out='vozoeivu'
+         cl_varname1='vozoeivu'
+         cl_varname2='eddy U velocity m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='231'
+      CASE ('vomeeivv')
+         i_nb_dims=3
+         cl_var_out='vomeeivv'
+         cl_varname1='vomeeivv'
+         cl_varname2='eddy V velocity m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='232'
+      CASE default
+         WRITE(*,*)'Variables not defined' 
+         CALL ABORT
+      END SELECT
+      cl_var_out  = TRIM(cl_var_out) 
+      cl_varname1 = TRIM(cl_varname1) 
+      cl_varname2 = TRIM(cl_varname2) 
+      cl_varunit1 = TRIM(cl_varunit1) 
+      cl_varunit2 = TRIM(cl_varunit2)
+      cl_code     = TRIM(cl_code)
+      cl_grid     = TRIM(cl_grid) 
+
+      cl_filename_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // TRIM(cl_code) //sec//'mona.nc'
+      cl_filename2_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // TRIM(cl_code) // 'xy' //sec//'mona.nc'
+!      IF ( i_nb_dims .EQ. 2 ) THEN
+!         i_dp=1
+!      ELSE
+!         i_dp=jpk
+!      ENDIF
+      WRITE(*,*)'Variable Attributes: '
+      WRITE(*,*)'   cl_var_out = ',cl_var_out
+!      WRITE(*,*)'   i_dp       = ',i_dp
+      WRITE(*,*)'   cl_grid    = ',cl_grid
+      WRITE(*,*)'   cl_code    = ',cl_code
+      WRITE(*,*)'   i_nb_dims  = ',i_nb_dims
+      WRITE(*,*)'------------------------------------ '
+
+      RETURN
+   END SUBROUTINE variable_att
+   !-----------------------------------------------------------------------
+   SUBROUTINE obs_variable_att(cl_type)
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE obs_variable_att
+      !                     ****************************
+      !
+      !  Purpose :
+      !  -------
+      !    set attributes for a given variable name (feedback version)
+      !
+      !  Original :  K. Mogensen
+      IMPLICIT NONE
+      !-----------------------------------------------------------------------
+      !   Different variables
+      !-----------------------------------------------------------------------
+      CHARACTER(len=*) :: cl_type
+      !
+      SELECT CASE ( TRIM(cl_var) )
+      CASE ('sossheig')
+         i_nb_dims=2
+         cl_var_out='sea_surface_height_above_geoid'
+         cl_varname1='sea_surface_height_above_geoid'
+         cl_varname2='sea_surface_height_above_geoid'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='145' 
+      CASE ('sosstsst')
+         i_nb_dims=2
+         cl_var_out='sea_surface_temperature'
+         cl_varname1='sea_surface_temperature'
+         cl_varname2='sea_surface_temperature'
+         cl_varunit1='K'
+         cl_varunit2='Kelvin'
+         cl_code='159'
+      CASE ('votemper')
+         i_nb_dims=3
+         cl_var_out='sea_water_potential_temperature'
+         cl_varname1='sea_water_potential_temperature'
+         cl_varname2='Potential temperature ref to surface C'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celcius'
+         cl_code='129'
+      CASE ('vosaline')
+         i_nb_dims=3
+         cl_var_out='sea_water_salinity'
+         cl_varname1='sea_water_salinity'
+         cl_varname2='sea water salinity'
+         cl_varunit1='PSU'
+         cl_varunit2='practical_salinity_scale'
+         cl_code='130'
+      CASE ('vozocrtx')
+         i_nb_dims=3
+         cl_var_out='sea_water_x_velocity'
+         cl_varname1='sea_water_x_velocity'
+         cl_varname2='U zonal current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='131'
+      CASE ('vomecrty')
+         i_nb_dims=3
+         cl_var_out='sea_water_y_velocity'
+         cl_varname1='sea_water_y_velocity'
+         cl_varname2='V meridional current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='132'
+      CASE default
+         WRITE(*,*)'Variables not defined' 
+         CALL ABORT
+      END SELECT
+      cl_var_out  = TRIM(cl_var_out) 
+      cl_varname1 = TRIM(cl_varname1) 
+      cl_varname2 = TRIM(cl_varname2) 
+      cl_varunit1 = TRIM(cl_varunit1) 
+      cl_varunit2 = TRIM(cl_varunit2)
+      cl_code     = TRIM(cl_code)
+      cl_filename_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // &
+         & TRIM(cl_code) // '_'//TRIM(cl_type)//'_'//'fbmona.nc'
+      cl_filename2_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // &
+         & TRIM(cl_code) // '_'//TRIM(cl_type)//'_'// 'xy' //'_'//'fbmona.nc'
+     
+      RETURN
+   END SUBROUTINE obs_variable_att
+
+
+END MODULE omonainfo
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_data.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_data.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_data.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OOO_SRC/ooo_data.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_utils.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_utils.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_utils.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OOO_SRC/ooo_utils.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_write.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_write.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/ooo_write.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OOO_SRC/ooo_write.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/par_kind.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 8732)
@@ -0,0 +1,99 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! 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
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   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 )
+   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 
+
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
+   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
+   INTEGER       ::   jp_cfg           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
+   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
+   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j
+
+   ! zoom starting position 
+   INTEGER       ::   jpizoom          !: left bottom (i,j) indices of the zoom
+   INTEGER       ::   jpjzoom          !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER       ::   jperio           !: lateral cond. type (between 0 and 6)
+   !                                       !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                       !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                       !  = 5 North fold F-point pivot
+   !                                       !  = 6 cyclic East-West AND North fold F-point pivot
+
+   ! Input file read offset
+   LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row 
+                                           ! when reading input from those netcdf files that have the 
+                                           ! attribute defined. This is designed to enable input files associated 
+                                           ! with the extended grids used in the under ice shelf configurations to 
+                                           ! be used without redundant rows when the ice shelves are not in use.
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+
+
+   !!---------------------------------------------------------------------
+   !! 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
+   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
+   !
+#endif
+   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC  ::   jpk   ! = jpkdta
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_oce.F90 5974 2015-12-02 10:52:05Z timgraham $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90	(revision 8732)
@@ -0,0 +1,34 @@
+MODULE proftools
+
+   ! Various tools to manipulate fb profiles data.
+
+   USE obs_fbm
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE sealsfromargo( fbdata )
+
+      ! Separate seals  from argo
+
+      ! Notes:
+      ! Argo is type 831
+      ! Seals have station ids from Q9900000 to Q9900328
+      ! according to
+      ! http://www.nodc.noaa.gov/GTSPP/document/codetbls/shipcode/name_1-C.html
+      ! on 2010-04-28 but we assume that all Q990???? are seals
+      
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(len=ilentyp) :: cdtyp
+      INTEGER :: i
+
+      DO i=1,fbdata%nobs
+         
+         cdtyp=ADJUSTL(fbdata%cdtyp(i))
+         IF ((cdtyp(1:3)=='831') .AND. &
+            &(fbdata%cdwmo(i)(1:4)=='Q990')) fbdata%cdtyp(i)='Seal'
+      ENDDO
+
+   END SUBROUTINE sealsfromargo
+
+END MODULE proftools
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90	(revision 8732)
@@ -0,0 +1,102 @@
+PROGRAM sla2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM sla2fb **
+   !!
+   !!  ** Purpose : Convert AVISO SLA format to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     sla2fb.exe [-s type] outputfile inputfile1 inputfile2 ...
+   !!   Option:
+   !!     -s            Select altimeter data_source
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_sla_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   CHARACTER(len=256) :: cdtmp
+   CHARACTER(len=5) :: cdsource
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: slaf(:)
+   INTEGER :: ninfiles,ntotobs
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ip,ia,ji,jk,noff
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'sla2fb [-s type] outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   cdsource=''
+   !
+   ! Get input data
+   !
+   noff=1
+   IF ( nargs > 1 ) THEN
+      CALL getarg(1,cdtmp)
+      IF (TRIM(cdtmp)=='-s') THEN
+         IF ( nargs < 3 ) THEN
+            WRITE(*,*)'Missing arguments to -s <datasource>'
+            CALL abort
+         ENDIF
+         CALL getarg(2,cdsource)
+         noff=3
+      ENDIF
+   ENDIF
+   CALL getarg(noff,cdoutfile)
+   ninfiles = nargs - noff
+   ALLOCATE( slaf(MAX(nargs-noff,1)) )
+   ALLOCATE( cdinfile(nargs-noff) )
+   ntotobs = 0
+   DO ia=1,ninfiles
+      CALL getarg( ia + noff, cdinfile(ia) )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      CALL read_avisofile( TRIM(cdinfile(ia)), slaf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(A,I9,A)')'has',slaf(ia)%nobs,' observations'
+      IF (LEN_TRIM(cdsource)>0) THEN
+         DO ji=1,slaf(ia)%nobs
+            slaf(ia)%cdwmo(ji)=TRIM(slaf(ia)%cdwmo(ji))//'_'//TRIM(cdsource)
+         ENDDO
+      ENDIF
+      ntotobs = ntotobs + slaf(ia)%nobs
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( slaf(1) )
+      CALL alloc_obfbdata( slaf(1), 1, 0, 1, 0, 0, .FALSE. )
+      slaf(1)%cname(1) = 'SLA'
+      slaf(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total observations : ',ntotobs
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, slaf )
+
+END PROGRAM sla2fb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/str_c_to_for.h90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/test_arrays_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/test_arrays_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/test_arrays_mod.F90	(revision 8732)
@@ -0,0 +1,94 @@
+MODULE test_arrays_mod
+USE obs_fbm
+
+INTERFACE test_arrays
+	MODULE PROCEDURE test_real_arrays
+	MODULE PROCEDURE test_real_arrays_2D
+	MODULE PROCEDURE test_real_arrays_3D
+	MODULE PROCEDURE test_integer_arrays
+END INTERFACE test_arrays
+
+CONTAINS
+
+   LOGICAL FUNCTION test_real_arrays(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i
+	REAL(KIND=fbdp) :: array_in(:), array_out(:)
+
+	test_real_arrays=.TRUE.
+	DO i=1,SIZE(array_in)
+		IF (array_in(i) /= array_out(i)) THEN
+			test_real_arrays=.FALSE.
+		END IF
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_real_arrays=.FALSE.
+	END IF
+
+	END FUNCTION test_real_arrays
+
+
+   LOGICAL FUNCTION test_real_arrays_2D(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i, j
+	REAL(KIND=fbdp) :: array_in(:,:), array_out(:,:)
+
+	test_real_arrays_2D=.TRUE.
+	DO j=1,SIZE(array_in,2)
+		DO i=1,SIZE(array_in,1)
+			IF (array_in(i,j) /= array_out(i,j)) THEN
+				test_real_arrays_2D=.FALSE.
+			END IF
+		END DO
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_real_arrays_2D=.FALSE.
+	END IF
+
+	END FUNCTION test_real_arrays_2D
+
+
+   LOGICAL FUNCTION test_real_arrays_3D(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i, j, k
+	REAL(KIND=fbdp) :: array_in(:,:,:), array_out(:,:,:)
+
+	test_real_arrays_3D=.TRUE.
+	DO k=1,SIZE(array_in,3)
+		DO j=1,SIZE(array_in,2)
+			DO i=1,SIZE(array_in,1)
+				IF (array_in(i,j,k) /= array_out(i,j,k)) THEN
+					test_real_arrays_3D=.FALSE.
+				END IF
+			END DO
+		END DO
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_real_arrays_3D=.FALSE.
+	END IF
+
+	END FUNCTION test_real_arrays_3D
+
+
+   LOGICAL FUNCTION test_integer_arrays(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i
+	INTEGER :: array_in(:), array_out(:)
+
+	test_integer_arrays=.TRUE.
+	DO i=1,SIZE(array_in)
+		IF (array_in(i) /= array_out(i)) THEN
+			test_integer_arrays=.FALSE.
+		END IF
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_integer_arrays=.FALSE.
+	END IF
+
+	END FUNCTION test_integer_arrays
+
+END MODULE test_arrays_mod
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/test_fbgenerate.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/test_fbgenerate.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/test_fbgenerate.F90	(revision 8732)
@@ -0,0 +1,787 @@
+MODULE test_fbgenerate	
+USE obs_fbm
+USE test_arrays_mod
+USE fbgenerate_coords
+
+CONTAINS
+
+   SUBROUTINE tester
+	IMPLICIT NONE
+	REAL(KIND=fbdp) :: array10_in(10), array1_in(1), array2_in(2), array3_in(3)
+	REAL(KIND=fbdp) :: array10_out(10), array1_out(1), array2_out(2), array3_out(3)
+	REAL(KIND=fbdp) :: array_4x3_in(3,4,1), array_4x3_out(3,4,1)
+	REAL(KIND=fbdp), ALLOCATABLE :: lat_array_in(:), lat_array_out(:)
+	REAL(KIND=fbdp), ALLOCATABLE :: lon_array_in(:), lon_array_out(:)
+	INTEGER :: iarray10_in(10), iarray1_in(1), iarray2_in(2), iarray3_in(3)
+	INTEGER :: iarray10_out(10), iarray1_out(1), iarray2_out(2), iarray3_out(3)
+	LOGICAL :: okay = .TRUE.
+	LOGICAL :: okay_too = .TRUE.
+	LOGICAL :: all_okay = .TRUE.
+	INTEGER, PARAMETER :: FV_int = 99999
+	REAL(KIND=fbdp), PARAMETER :: FV_real = 99999.0_fbdp
+	
+   ! A single non-FillVal value should be replicated n times
+	array1_in(:)=(/1.0_fbdp/)
+	array1_out(:)=(/1.0_fbdp/)
+	CALL set_depths(array1_in,1,FV_real)
+	okay = test_arrays(array1_in,array1_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 1 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	array2_in(:) = (/1.0_fbdp, FV_real/)
+	array2_out(:) = (/1.0_fbdp, 1.0_fbdp/)
+	CALL set_depths(array2_in,2,FV_real)
+	okay = test_arrays(array2_in,array2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 2 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	array10_in(:) = (/1.0_fbdp,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = 1.0_fbdp
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 3 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	array3_in(:) = (/1.0_fbdp,FV_real,FV_real/)
+	array3_out(:) = 1.0_fbdp
+	CALL set_depths(array3_in,3,FV_real)
+	okay = test_arrays(array3_in,array3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 4 failed"
+		all_okay = .FALSE.
+	END IF
+		
+	! A full list of n non-FillVals should be left unaltered.
+	array2_in(:) = (/1.0_fbdp, 2.0_fbdp/)
+	array2_out(:) = (/1.0_fbdp, 2.0_fbdp/)
+	CALL set_depths(array2_in,2,FV_real)
+	okay = test_arrays(array2_in,array2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 5 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	array3_in(:) = (/3.0_fbdp, 2.0_fbdp, 56.23_fbdp/)
+	array3_out(:) = (/3.0_fbdp, 2.0_fbdp, 56.23_fbdp/)
+	CALL set_depths(array3_in,3,FV_real)
+	okay = test_arrays(array3_in,array3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 6 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	array10_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, -5.0_fbdp, 5.0_fbdp, 67.0_fbdp, 7.0_fbdp, 8.0_fbdp, 9.0_fbdp, 10.0_fbdp/)
+	array10_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, -5.0_fbdp, 5.0_fbdp, 67.0_fbdp, 7.0_fbdp, 8.0_fbdp, 9.0_fbdp, 10.0_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 7 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	array10_in(:) = (/1.0_fbdp,10.0_fbdp,1.0_fbdp,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp, 6.0_fbdp, 7.0_fbdp, 8.0_fbdp, 9.0_fbdp, 10.0_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 8 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	array10_in(:) = (/1.0_fbdp, 3.25_fbdp, 0.25_fbdp, FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = (/1.0_fbdp, 1.25_fbdp, 1.5_fbdp, 1.75_fbdp, 2.0_fbdp, 2.25_fbdp, 2.5_fbdp, 2.75_fbdp, 3.0_fbdp, 3.25_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 9 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	array10_in(:) = (/3.25_fbdp, 1.0_fbdp, -0.25_fbdp, FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = (/3.25_fbdp, 3.0_fbdp, 2.75_fbdp, 2.5_fbdp, 2.25_fbdp, 2.0_fbdp, 1.75_fbdp, 1.5_fbdp, 1.25_fbdp, 1.0_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 11 failed"
+		all_okay = .FALSE.
+	END IF
+	
+   ! A single non-FillVal value should be replicated n times
+	iarray1_in(:)=(/19991231/)
+	iarray1_out(:)=(/19991231/)
+	CALL set_date(iarray1_in,1,FV_int)
+	okay = test_arrays(iarray1_in,iarray1_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 12 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	iarray2_in(:) = (/19991231, FV_int/)
+	iarray2_out(:) = (/19991231, 19991231/)
+	CALL set_date(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 13 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	iarray10_in(:) = (/20110101,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = 20110101
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 14 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	iarray3_in(:) = (/20110101,FV_int,FV_int/)
+	iarray3_out(:) = 20110101
+	CALL set_date(iarray3_in,3,FV_int)
+	okay = test_arrays(iarray3_in,iarray3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 15 failed"
+		all_okay = .FALSE.
+	END IF
+		
+	! A full list of n non-FillVals should be left unaltered.
+	iarray2_in(:) = (/19991231, 20000101/)
+	iarray2_out(:) = (/19991231, 20000101/)
+	CALL set_date(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 16 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray3_in(:) = (/19840101, 19001231, 20500612/)
+	iarray3_out(:) = (/19840101, 19001231, 20500612/)
+	CALL set_date(iarray3_in,3,FV_int)
+	okay = test_arrays(iarray3_in,iarray3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 17 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray10_in(:) = (/20091231, 20100101, 20100102, 20100103, 20091231, &
+	                    20100105, 20100106, 20091231, 20100108, 20100109/)
+	iarray10_out(:) = (/20091231, 20100101, 20100102, 20100103, 20091231, &
+	                    20100105, 20100106, 20091231, 20100108, 20100109/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 18 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/20091231,20100109,1,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/20091231, 20100101, 20100102, 20100103, 20100104, &
+	                    20100105, 20100106, 20100107, 20100108, 20100109/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 19 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/20100109,20091231,-1,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/20100109, 20100108, 20100107, 20100106, 20100105, &
+	                    20100104, 20100103, 20100102, 20100101, 20091231/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 20 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/20100101,20100401,10,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/20100101, 20100111, 20100121, 20100131, 20100210, &
+	                    20100220, 20100302, 20100312, 20100322, 20100401/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 21 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	iarray1_in(:)=(/0000/)
+	iarray1_out(:)=(/0/)
+	CALL set_time(iarray1_in,1,FV_int)
+	okay = test_arrays(iarray1_in,iarray1_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 22 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	iarray2_in(:) = (/0600, FV_int/)
+	iarray2_out(:) = (/600, 600/)
+	CALL set_time(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 23 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray2_in(:) = (/0600, 1200/)
+	iarray2_out(:) = (/0600, 1200/)
+	CALL set_time(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 24 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray10_in(:) = (/1, 2, 3, -5, 5, 67, 7, 8, 9, 10/)
+	iarray10_out(:) = (/1, 2, 3, -5, 5, 67, 7, 8, 9, 10/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 25 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/0000,0430,0030,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/0, 30, 100, 130, 200, &
+	                    230, 300, 330, 400, 430/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 26 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/2200,0230,0030,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/2200, 2230, 2300, 2330, 0, &
+	                    30, 100, 130, 200, 230/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 27 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/2200,1730,-0030,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/2200, 2130, 2100, 2030, 2000, &
+	                    1930, 1900, 1830, 1800, 1730/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 28 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/0100,2200,-0020,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/0100, 0040, 0020, 0000, 2340, &
+	                    2320, 2300, 2240, 2220, 2200/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 29 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/1700,0630,90,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/1700, 1830, 2000, 2130, 2300, &
+	                    0030, 0200, 0330, 0500, 0630/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 30 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! A single obs value should be replicated throught the array(obs,levels)
+	array_4x3_in(:,1,1) = (/1.0,FV_real,FV_real/)
+	array_4x3_in(:,2,1) = (/FV_real,FV_real,FV_real/)
+	array_4x3_in(:,3,1) = (/FV_real,FV_real,FV_real/)
+	array_4x3_in(:,4,1) = (/FV_real,FV_real,FV_real/)
+	array_4x3_out(:,1,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	array_4x3_out(:,2,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	array_4x3_out(:,3,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	array_4x3_out(:,4,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	CALL set_obs_values(array_4x3_in,1,4,3,FV_real)
+	okay = test_arrays(array_4x3_in,array_4x3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 31 failed"
+		WRITE(*,*) array_4x3_in
+		WRITE(*,*)
+		WRITE(*,*) array_4x3_out
+		all_okay = .FALSE.
+	END IF
+
+	! A full specification of the obs values should be unaltered
+	array_4x3_in(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_in(:,2,1) = (/4.0_fbdp, 5.0_fbdp, 6.0_fbdp/)
+	array_4x3_in(:,3,1) = (/7.0_fbdp, 8.0_fbdp, 9.0_fbdp/)
+	array_4x3_in(:,4,1) = (/10.0_fbdp, 11.0_fbdp, 12.0_fbdp/)
+	array_4x3_out(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,2,1) = (/4.0_fbdp, 5.0_fbdp, 6.0_fbdp/)
+	array_4x3_out(:,3,1) = (/7.0_fbdp, 8.0_fbdp, 9.0_fbdp/)
+	array_4x3_out(:,4,1) = (/10.0_fbdp, 11.0_fbdp, 12.0_fbdp/)
+	CALL set_obs_values(array_4x3_in,1,4,3,FV_real)
+	okay = test_arrays(array_4x3_in,array_4x3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 32 failed"
+		WRITE(*,*) array_4x3_in
+		WRITE(*,*)
+		WRITE(*,*) array_4x3_out
+		all_okay = .FALSE.
+	END IF
+
+	! A single profile should be replicated at all lat/lons
+	array_4x3_in(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_in(:,2,1) = (/FV_real, FV_real, FV_real/)
+	array_4x3_in(:,3,1) = (/FV_real, FV_real, FV_real/)
+	array_4x3_in(:,4,1) = (/FV_real, FV_real, FV_real/)
+	array_4x3_out(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,2,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,3,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,4,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	CALL set_obs_values(array_4x3_in,1,4,3,FV_real)
+	okay = test_arrays(array_4x3_in,array_4x3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 33 failed"
+		WRITE(*,*) array_4x3_in
+		WRITE(*,*)
+		WRITE(*,*) array_4x3_out
+		all_okay = .FALSE.
+	END IF
+
+	! A single profile position should only be given where nobs=1
+	ALLOCATE(lat_array_in(1),	&
+				lon_array_in(1),	&
+				lat_array_out(1), &
+				lon_array_out(1)	)
+	lat_array_in(:) = (/1.0_fbdp/)
+	lon_array_in(:) = (/1.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,1,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 34 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lat and list of lons should give nobs observations
+	ALLOCATE(lat_array_in(4),	&
+				lon_array_in(4),	&
+				lat_array_out(4), &
+				lon_array_out(4)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,4,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 35 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lat and bounded lons should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(3),	&
+				lon_array_in(3),	&
+				lat_array_out(3), &
+				lon_array_out(3)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 3.0_fbdp, 1.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,3,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 36 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lat and bounded lons should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 37 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lon and bounded lats should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 38 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A list of lats and lons with same number of elements as nobs should be unaltered
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 39 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A list of lats and lons with fewer elements as nobs should be gridded 
+	! to produce nobs observations - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(25),	&
+				lon_array_in(25),	&
+				lat_array_out(25), &
+				lon_array_out(25)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, & 
+								2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, &
+								3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, &
+								4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, &
+								5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 40 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A list of lats and lon bounds with fewer elements as nobs should be gridded 
+	! to produce nobs observations - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(25),	&
+				lon_array_in(25),	&
+				lat_array_out(25), &
+				lon_array_out(25)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, & 
+								2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, &
+								3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, &
+								4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, &
+								5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 41 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	! A list of lats and lon bounds with the same number of elements as nobs should be 
+	! unaltered expect for bounds expansion
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 42 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+	
+
+	! A list of lons and lat bounds with the same number of elements as nobs should be 
+	! unaltered expect for bounds expansion
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lat_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 43 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+	
+
+	! A list of lons and lat bounds with fewer elements as nobs should be gridded 
+	! to produce nobs observations - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(25),	&
+				lon_array_in(25),	&
+				lat_array_out(25), &
+				lon_array_out(25)	)
+	lat_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/10.0_fbdp, 10.0_fbdp, 10.0_fbdp, 10.0_fbdp, 10.0_fbdp, & 
+								20.0_fbdp, 20.0_fbdp, 20.0_fbdp, 20.0_fbdp, 20.0_fbdp, &
+								30.0_fbdp, 30.0_fbdp, 30.0_fbdp, 30.0_fbdp, 30.0_fbdp, &
+								40.0_fbdp, 40.0_fbdp, 40.0_fbdp, 40.0_fbdp, 40.0_fbdp, &
+								50.0_fbdp, 50.0_fbdp, 50.0_fbdp, 50.0_fbdp, 50.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 44 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	! A single lat and bounded lons should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 45 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	! Bounded lat and bounded lons - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(20),	&
+				lon_array_in(20),	&
+				lat_array_out(20), &
+				lon_array_out(20)	)
+	lat_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/10.0_fbdp, 40.0_fbdp, 10.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, & 
+								2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, &
+								3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, &
+								4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, &
+								5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,20,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 46 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	IF (all_okay) WRITE(*,*) "All tests passed"
+	
+	END SUBROUTINE tester
+
+END MODULE test_fbgenerate	
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90	(revision 8732)
@@ -0,0 +1,8 @@
+MODULE toolspar_kind
+  IMPLICIT NONE
+  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 = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+       ik = SELECTED_INT_KIND(6)            !: integer precision 
+END MODULE toolspar_kind
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90	(revision 8732)
@@ -0,0 +1,86 @@
+PROGRAM vel2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM vel2fb **
+   !!
+   !!  ** Purpose : Convert TAO/PIRATA/RAMA currents to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     vel2fb.exe outputfile inputfile1 inputfile2 ...
+   !! 
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_vel_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: velf(:)
+   INTEGER :: ninfiles,ntotvel,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'vel2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( velf(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotvel = 0
+   ninfiles  = nargs - 1
+   DO ia = 1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_taondbc( TRIM(cdinfile(ia)), velf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',velf(ia)%nobs,' profiles'
+      ntotvel = ntotvel + velf(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, velf(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( velf(1) )
+      CALL alloc_obfbdata( velf(1), 2, 0, 1, 0, 1, .FALSE. )
+      velf(1)%cname(1) = 'UVEL'
+      velf(1)%cname(2) = 'VVEL'
+      velf(1)%coblong(1) = 'Zonal current'
+      velf(1)%coblong(2) = 'Meridional current'
+      velf(1)%cobunit(1) = 'Meters per second'
+      velf(1)%cobunit(2) = 'Meters per second'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotvel
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, velf )
+
+END PROGRAM vel2fb
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/wrk_nemo.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/rebuild
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/rebuild	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/rebuild	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../EXTERNAL/IOIPSL/tools/rebuild
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/calendar.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/calendar.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/calendar.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/calendar.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/defprec.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/defprec.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/defprec.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/defprec.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/errioipsl.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/flincom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/flincom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/flincom.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/flincom.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/tools/flio_rbld.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/fliocom.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/getincom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/getincom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/getincom.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/getincom.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/histcom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/histcom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/histcom.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/histcom.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/ioipsl.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/mathelp.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/nc4interface.F90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/tools/ncunderflow.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/restcom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/restcom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/restcom.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/restcom.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/stringop.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/stringop.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD/src/stringop.f90	(revision 8732)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/stringop.f90
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py	(revision 8732)
@@ -0,0 +1,275 @@
+import os
+from netCDF4 import Dataset
+from argparse import ArgumentParser
+import numpy as np
+import sys
+
+#
+# Basic iceberg trajectory restart post-processing python script.
+# This script collects iceberg information from the distributed restarts written
+# out by each processing region and writes the information into a global restart file.
+# The global restart file must already exist and contain the collated 2D spatial fields
+# as prepared by utilities such as rebuild_nemo. This python script simply adds the
+# iceberg position and state data that is held using the unlimited dimension 'n' which
+# has been ignored by rebuild_nemo. Each processing region that contains icebergs will
+# (probably) have a different number of icebergs (indicated by differing values for the
+# current size of the unlimited dimension). This script collects all icebergs into a 
+# single unordered list.
+#
+
+parser = ArgumentParser(description='produce a global trajectory restart file from distributed output\
+                                     files, e.g. \n python ./icb_pp.py \
+                                     -f  icebergs_00692992_restart_ -n 480 -o icebergs_restart.nc [-O]')
+
+parser.add_argument('-f',dest='froot',help='fileroot_of_distrbuted_data; root name of \
+                     distributed trajectory restart file (usually completed with XXXX.nc, where \
+                     XXXX is the 4 digit processor number)', 
+                     default='icebergs_00692992_restart_')
+
+parser.add_argument('-n',dest='fnum',help='number of distributed files to process', 
+                     type=int, default=None)
+
+parser.add_argument('-o',dest='fout',help='global_iceberg_restart; file name to append the \
+                     global iceberg restart data to.', default='icebergs_restart.nc')
+
+parser.add_argument('-O',dest='fcre',help='Create the output file from scratch rather than \
+                     append to an existing file.', \
+                     action='store_true', default=False)
+
+args = parser.parse_args()
+
+default_used = 0
+if args.froot is None:
+    pathstart = 'icebergs_00692992_restart_'
+    default_used = 1
+else:
+    pathstart = args.froot
+
+if args.fnum is None:
+    procnum = 0
+    default_used = 1
+else:
+    procnum = args.fnum
+
+if args.fout is None:
+    pathout = 'icebergs_restart.nc'
+    default_used = 1
+else:
+    pathout = args.fout
+
+if default_used == 1:
+   print('At least one default value will be used; command executing is:')
+   print('icb_combrest.py -f ',pathstart,' -n ',procnum,' -o ',pathout)
+
+if procnum < 1:
+   print('Need some files to collate! procnum = ',procnum)
+   sys.exit(11)
+
+icu = []
+times = []
+ntraj = 0
+nk = 0
+#
+# Loop through all distributed datasets to obtain the total number 
+# of icebergs to transfer
+#
+for n in range(procnum):
+ nn = '%4.4d' % n
+ try:
+   fw = Dataset(pathstart+nn+'.nc')
+ except:
+   print 'Error: unable to open input file: ' + pathstart+nn+'.nc'
+   sys.exit(12)
+ for d in fw.dimensions :
+  if d == 'n' :
+   if len(fw.dimensions['n']) > 0:
+#    print 'icebergs found in: ' + pathstart+nn+'.nc' 
+     if len(fw.dimensions['k']) > nk :
+       nk = len(fw.dimensions['k'])
+     ntraj = ntraj + len(fw.dimensions['n'])
+ fw.close()
+#
+print(ntraj, ' icebergs found across all datasets')
+#
+# Declare 2-D arrays to receive the data from all files
+#
+lons = np.zeros(ntraj)
+lats = np.zeros(ntraj)
+xis  = np.zeros(ntraj)
+yjs  = np.zeros(ntraj)
+uvs  = np.zeros(ntraj)
+vvs  = np.zeros(ntraj)
+mas  = np.zeros(ntraj)
+ths  = np.zeros(ntraj)
+wis  = np.zeros(ntraj)
+les  = np.zeros(ntraj)
+dys  = np.zeros(ntraj)
+mss  = np.zeros(ntraj)
+msb  = np.zeros(ntraj)
+hds  = np.zeros(ntraj)
+yrs  = np.zeros(ntraj      , dtype=int)
+num  = np.zeros((ntraj, nk), dtype=int)
+#
+# loop through distributed datasets again, this time
+# collecting all trajectory data
+#
+nt = 0
+for n in range(procnum):
+ nn = '%4.4d' % n
+ fw = Dataset(pathstart+nn+'.nc')
+ for d in fw.dimensions :
+  if d == 'n' :
+# Note many distributed datafiles will contain no iceberg data
+# so skip quickly over these
+    m  = len(fw.dimensions['n'])
+    if m > 0:
+#     print pathstart+nn+'.nc'
+      lons[nt:nt+m]  = fw.variables['lon'][:]
+      lats[nt:nt+m]  = fw.variables['lat'][:]
+      xis[nt:nt+m]   = fw.variables['xi'][:]
+      yjs[nt:nt+m]   = fw.variables['yj'][:]
+      uvs[nt:nt+m]   = fw.variables['uvel'][:]
+      vvs[nt:nt+m]   = fw.variables['vvel'][:]
+      mas[nt:nt+m]   = fw.variables['mass'][:]
+      ths[nt:nt+m]   = fw.variables['thickness'][:]
+      wis[nt:nt+m]   = fw.variables['width'][:]
+      les[nt:nt+m]   = fw.variables['length'][:]
+      dys[nt:nt+m]   = fw.variables['day'][:]
+      mss[nt:nt+m]   = fw.variables['mass_scaling'][:]
+      msb[nt:nt+m]   = fw.variables['mass_of_bits'][:]
+      hds[nt:nt+m]   = fw.variables['heat_density'][:]
+      yrs[nt:nt+m]   = fw.variables['year'][:]
+      num[nt:nt+m,:] = fw.variables['number'][:,:]
+      nt = nt + m
+ fw.close()
+
+# Finally create the output file and write out the collated sets
+#
+if args.fcre :
+  try:
+    fo = Dataset(pathout, 'w', format='NETCDF4')
+  except:
+    print 'Error accessing output file: ' + pathout
+    print 'Check it is a writable location.'
+    sys.exit(13)
+else :
+  # Copy 2D variables across to output file from input file. This step avoids problems if rebuild_nemo 
+  # has created an "n" dimension in the prototype rebuilt file (ie. if there are icebergs on the zeroth 
+  # processor). 
+  try:
+    os.rename(pathout,pathout.replace('.nc','_WORK.nc'))
+  except OSError:
+    print 'Error: unable to move icebergs restart file: '+pathout
+    sys.exit(14)
+  #
+  try:
+    fi = Dataset(pathout.replace('.nc','_WORK.nc'), 'r')
+  except:
+    print 'Error: unable to open icebergs restart file: '+pathout.replace('.nc','_WORK.nc')
+    sys.exit(15)
+  fo = Dataset(pathout, 'w')
+  for dim in ['x','y','c','k']:
+    indim = fi.dimensions[dim]
+    fo.createDimension(dim, len(indim))
+  for var in ['kount','calving','calving_hflx','stored_ice','stored_heat']:
+    invar = fi.variables[var]
+    fo.createVariable(var, invar.datatype, invar.dimensions)
+    fo.variables[var][:] = invar[:]
+    if "long_name" in invar.ncattrs():
+        fo.variables[var].long_name = invar.long_name
+    if "units" in invar.ncattrs():
+        fo.variables[var].units = invar.units
+  os.remove(pathout.replace('.nc','_WORK.nc'))
+#
+add_k = 1
+for d in fo.dimensions :
+  if d == 'n' :
+    print 'Error: dimension n already exists in output file'
+    sys.exit(16)
+  if d == 'k' :
+    add_k = 0
+onn  = fo.createDimension('n', None)
+if add_k > 0 :
+ onk = fo.createDimension('k', nk)
+olon = fo.createVariable('lon', 'f8',('n'))
+olat = fo.createVariable('lat', 'f8',('n'))
+oxis = fo.createVariable('xi', 'f8',('n'))
+oyjs = fo.createVariable('yj', 'f8',('n'))
+ouvs = fo.createVariable('uvel', 'f8',('n'))
+ovvs = fo.createVariable('vvel', 'f8',('n'))
+omas = fo.createVariable('mass', 'f8',('n'))
+oths = fo.createVariable('thickness', 'f8',('n'))
+owis = fo.createVariable('width', 'f8',('n'))
+oles = fo.createVariable('length', 'f8',('n'))
+odys = fo.createVariable('day', 'f8',('n'))
+omss = fo.createVariable('mass_scaling', 'f8',('n'))
+omsb = fo.createVariable('mass_of_bits', 'f8',('n'))
+ohds = fo.createVariable('heat_density', 'f8',('n'))
+oyrs = fo.createVariable('year', 'i4',('n'))
+onum = fo.createVariable('number', 'i4',('n','k'))
+#
+olon[:] = lons
+olon.long_name = "longitude"
+olon.units = "degrees_E" 
+#
+olat[:] = lats
+olat.long_name = "latitude"
+olat.units = "degrees_N"
+#
+oxis[:] = xis
+oxis.long_name = "x grid box position"
+oxis.units = "fractional"
+#
+oyjs[:] = yjs
+oyjs.long_name = "y grid box position"
+oyjs.units = "fractional"
+#
+ouvs[:] = uvs
+ouvs.long_name = "zonal velocity"
+ouvs.units = "m/s"
+#
+ovvs[:] = vvs
+ovvs.long_name = "meridional velocity"
+ovvs.units = "m/s"
+#
+omas[:] = mas
+omas.long_name = "mass"
+omas.units = "kg"
+#
+oths[:] = ths
+oths.long_name = "thickness"
+oths.units = "m"
+#
+owis[:] = wis
+owis.long_name = "width"
+owis.units = "m"
+#
+oles[:] = les
+oles.long_name = "length"
+oles.units = "m"
+#
+odys[:] = dys
+odys.long_name = "year day of calving event"
+odys.units = "days"
+#
+omss[:] = mss
+omss.long_name = "scaling factor for mass of calving berg"
+omss.units = "none"
+#
+omsb[:] = msb
+omsb.long_name = "mass of bergy bits"
+omsb.units = "kg"
+#
+ohds[:] = hds
+ohds.long_name = "heat density"
+ohds.units = "J/kg"
+#
+oyrs[:] = yrs
+oyrs.long_name = "calendar year of calving event"
+oyrs.units = "years"
+#
+onum[:,:] = num
+onum.long_name = "iceberg number on this processor"
+onum.units = "count"
+#
+fo.close()
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo	(revision 8732)
@@ -0,0 +1,75 @@
+#!/bin/ksh
+#
+#  Script to run the NEMO rebuild tool to rebuild NEMO
+#  diagnostic or restart files.
+#
+#  The scripts creates the nam_rebuild namelist based upon
+#  the command line options you give it (see usage below)
+#
+#  Ed Blockley, September 2011
+#
+#
+
+#set -ax
+usage ()
+{
+   echo
+   echo "  NEMO Rebuild"
+   echo "  ************"
+   echo
+   echo "  usage: ${0##*/} [-t -c] filebase ndomain [rebuild dimensions]"
+   echo
+   echo "  flags:  -t num      use num threads"
+   echo "          -c num      split 4D vars into time chuncks of size num"
+   echo
+   exit 1
+}
+
+while getopts c:t: opt
+do
+  case ${opt} in
+      t)
+         OMP_NUM_THREADS=${OPTARG}
+      ;;
+      c)
+         NCHUNKSIZE=${OPTARG}
+      ;;
+  esac
+done
+shift $(expr ${OPTIND} - 1)
+
+if [[ $# < 2 ]] ; then
+   usage
+fi
+
+script_dir=$(dirname $0)
+
+file=$1
+ndomain=$2
+DIM1=$3
+DIM2=$4
+export OMP_NUM_THREADS=${OMP_NUM_THREADS:-16}
+
+if [[ -n ${DIM1} && -n ${DIM2} ]] ; then
+   dim_str=" dims '${DIM1}','${DIM2}'"
+   dims="dims='${DIM1}','${DIM2}'"
+   echo ${dim_str} >> nam_rebuild
+fi
+
+echo "file ${file},  num_domains ${ndomain}, num_threads ${OMP_NUM_THREADS}${dim_str}"
+
+cat > nam_rebuild << EOC
+&nam_rebuild
+filebase='${file}'
+ndomain=${ndomain}
+EOC
+if [[ -n ${dims} ]] ; then
+   echo ${dims} >> nam_rebuild
+fi
+if [[ -n ${NCHUNKSIZE} ]] ; then
+   echo " nchunksize=${NCHUNKSIZE}" >> nam_rebuild
+fi
+echo "/" >> nam_rebuild
+
+# run the rebuild code
+${script_dir}/rebuild_nemo.exe 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 8732)
@@ -0,0 +1,1200 @@
+PROGRAM rebuild_nemo
+
+   !!=========================================================================
+   !!                        ***  rebuild_nemo  ***
+   !!=========================================================================
+   !!
+   !!  A routine to rebuild NEMO files from multiple processors into one file.
+   !!  This routine is designed to be much quicker than the old IOIPSL rebuild
+   !!  but at the cost of an increased memory usage.
+   !!
+   !!  NEMO rebuild has the following features:
+   !!     * dynamically works out what variables require rebuilding
+   !!     * does not copy subdomain halo regions
+   !!     * works for 1,2,3 and 4d arrays or types for all valid NetCDF types
+   !!     * utilises OMP shared memory parallelisation where applicable
+   !!     * time 'chunking' for lower memory use 
+   !!       (only for 4D vars with unlimited dimension)
+   !!
+   !!  Ed Blockley - August 2011
+   !!  (based on original code by Matt Martin)
+   !!
+   !!-------------------------------------------------------------------------
+   !!
+   !!  The code reads the filestem and number of subdomains from the namelist file nam_rebuild.
+   !! 
+   !!  The 1st subdomain file is used to determine the dimensions and variables in all the input files. 
+   !!  It is also used to find which dimensions (and hence which variables) require rebuilding 
+   !!  as well as information about the global domain.
+   !!
+   !!  It then opens all the input files (unbuffered) and creates an array of netcdf identifiers
+   !!  before looping through all the variables and updating the rebuilt output file (either by direct 
+   !!  copying or looping over the number of domains and rebuilding as appropriate).
+   !!  
+   !!  The code looks more complicated than it is because it has lots of case statements to deal with all 
+   !!  the various NetCDF data types and with various data dimensions (up to 4d).
+   !!
+   !!  Diagnostic output is written to numout (default 6 - stdout)
+   !!  and errors are written to numerr (default 0 - stderr).
+   !!
+   !!  If time chunking is specified the code will use less memory but take a little longer.
+   !!  It does this by breaking down the 4D input variables over their 4th dimension 
+   !!  (generally time) by way of a while loop.
+   !!
+   !!-------------------------------------------------------------------------------
+  
+   USE netcdf
+
+!$ USE omp_lib           ! Note OpenMP sentinel
+
+   IMPLICIT NONE
+
+   ! kind specifications
+   INTEGER,PARAMETER :: i1=SELECTED_INT_KIND(2)          ! NF90_BYTE 
+   INTEGER,PARAMETER :: i2=SELECTED_INT_KIND(4)          ! NF90_SHORT
+   INTEGER,PARAMETER :: i4=SELECTED_INT_KIND(9)          ! NF90_INT
+   INTEGER,PARAMETER :: sp=SELECTED_REAL_KIND(6,37)      ! NF90_FLOAT
+   INTEGER,PARAMETER :: dp=SELECTED_REAL_KIND(12,307)    ! NF90_DOUBLE
+
+   INTEGER,PARAMETER :: numnam = 11
+   INTEGER,PARAMETER :: numout = 6
+   INTEGER,PARAMETER :: numerr = 0
+
+   LOGICAL, PARAMETER :: l_verbose = .true. 
+    
+   CHARACTER(LEN=nf90_max_name) :: filebase, suffix, attname, dimname, varname, time, date, zone, timestamp
+   CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: filenames(:), indimnames(:)
+   CHARACTER(LEN=nf90_max_name), DIMENSION(2) :: dims
+
+   INTEGER :: ndomain, ifile, ndomain_file, nchunksize
+   INTEGER :: ncid, outid, idim, istop
+   INTEGER :: natts, attid, xtype, varid, rbdims 
+   INTEGER :: jv, ndims, nvars, dimlen, dimids(4)
+   INTEGER :: dimid, unlimitedDimId, di, dj, dr
+   INTEGER :: nmax_unlimited, nt, ntchunk 
+   INTEGER :: chunksize = 32000000
+   INTEGER :: nthreads = 1
+   INTEGER, ALLOCATABLE  :: outdimids(:), outdimlens(:), indimlens(:), inncids(:)
+   INTEGER, ALLOCATABLE  :: global_sizes(:), rebuild_dims(:)
+   INTEGER, DIMENSION(2) :: halo_start, halo_end, local_sizes
+   INTEGER, DIMENSION(2) :: idomain, jdomain, rdomain, start_pos
+   INTEGER :: ji, jj, jk, jl, jr
+ 
+   REAL(sp) :: ValMin, ValMax, InMin, InMax
+
+   ! NF90_BYTE local data arrays
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i1
+
+   ! NF90_SHORT local data arrays
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i2
+
+   ! NF90_INT local data arrays
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i4
+
+   ! NF90_FLOAT local data arrays
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_sp
+
+   ! NF90_DOUBLE local data arrays
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_dp
+
+   ! NF90_BYTE global data arrays
+   INTEGER(i1) :: globaldata_0d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i1
+
+   ! NF90_SHORT global data arrays
+   INTEGER(i2) :: globaldata_0d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i2
+
+   ! NF90_INT global data arrays
+   INTEGER(i4) :: globaldata_0d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i4
+ 
+   ! NF90_FLOAT global data arrays
+   REAL(sp) :: globaldata_0d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_sp
+
+   ! NF90_DOUBLE global data arrays
+   REAL(dp) :: globaldata_0d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_dp
+
+   LOGICAL :: l_valid = .false.
+   LOGICAL :: l_noRebuild = .false.
+   LOGICAL :: l_findDims = .true.
+
+   NAMELIST/nam_rebuild/ filebase, ndomain, dims, nchunksize
+
+   !End of definitions 
+
+!--------------------------------------------------------------------------------
+!0. OMP setup
+
+!$OMP PARALLEL DEFAULT(NONE) SHARED(nthreads)
+!$OMP MASTER
+!$      nthreads = omp_get_num_threads()
+!$      WRITE(numout,*) 'Running OMP with ',nthreads,' thread(s).'
+!$OMP END MASTER
+!$OMP END PARALLEL
+ 
+!--------------------------------------------------------------------------------
+!1. Read in the namelist 
+
+   dims(:) = ""
+   nchunksize = 0
+   OPEN( UNIT=numnam, FILE='nam_rebuild', FORM='FORMATTED', STATUS='OLD' )
+   READ( numnam, nam_rebuild )
+   CLOSE( numnam )
+   IF( .NOT. ALL(dims(:) == "") ) l_findDims = .false.
+ 
+!1.1 Set up the filenames and fileids
+
+   ALLOCATE(filenames(ndomain))
+   IF (l_verbose) WRITE(numout,*) 'Rebuilding the following files:'
+   DO ifile = 1, ndomain
+      WRITE(suffix,'(i4.4)') ifile-1
+      filenames(ifile) = TRIM(filebase)//'_'//TRIM(suffix)//'.nc'
+      IF (l_verbose) WRITE(numout,*) TRIM(filenames(ifile))
+   END DO
+   ALLOCATE(inncids(ndomain))
+  
+!---------------------------------------------------------------------------
+!2. Read in the global dimensions from the first input file and set up the output file
+ 
+   CALL check_nf90( nf90_open( TRIM(filenames(1)), nf90_share, ncid ) )
+   CALL check_nf90( nf90_inquire( ncid, ndims, nvars, natts ) )
+    
+!2.0 Read in the total number of processors the file is expecting and check its correct  
+  
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_number_total', ndomain_file ) )
+   IF( ndomain /= ndomain_file ) THEN
+      WRITE(numerr,*) 'ERROR! : number of files to rebuild in file does not agree with namelist'
+      WRITE(numerr,*) 'Attribute DOMAIN_number_total is : ', ndomain_file
+      WRITE(numerr,*) 'Number of files specified in namelist is: ', ndomain
+      STOP 9
+   ENDIF
+  
+!2.1 Set up the output file
+
+   CALL check_nf90( nf90_create( TRIM(filebase)//'.nc', nf90_64bit_offset, outid, chunksize=chunksize ) )
+
+!2.2 Set up dimensions in output file
+
+!2.2.0 Find out  how many dimensions are required to be rebuilt and which ones they are
+   CALL check_nf90( nf90_inquire_attribute( ncid, nf90_global, 'DOMAIN_dimensions_ids', xtype, rbdims, attid ) )
+
+   ALLOCATE(rebuild_dims(rbdims))
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_dimensions_ids', rebuild_dims ) )
+
+   ALLOCATE(global_sizes(rbdims))
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_global', global_sizes ) )
+   IF (l_verbose) WRITE(numout,*) 'Size of global arrays: ', global_sizes
+
+
+!2.2.1 Copy the dimensions into the output file apart from rebuild_dims() which are dimensioned globally 
+   ALLOCATE(indimlens(ndims), indimnames(ndims), outdimlens(ndims))
+   CALL check_nf90( nf90_inquire( ncid, unlimitedDimId = unlimitedDimId ) )
+   istop = 0
+   DO idim = 1, ndims
+      CALL check_nf90( nf90_inquire_dimension( ncid, idim, dimname, dimlen ) )
+      CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_local', local_sizes ) )
+      indimlens(idim) = dimlen    
+      indimnames(idim) = dimname
+      IF (l_findDims) THEN
+         IF( idim == rebuild_dims(1) ) THEN
+            IF( dimlen == local_sizes(1) ) THEN 
+               dimlen = global_sizes(1)
+            ELSE
+               istop = 1
+            ENDIF
+         ENDIF
+         IF( rbdims > 1 .AND. idim == rebuild_dims(2) ) THEN
+            IF( dimlen == local_sizes(2) ) THEN
+               dimlen = global_sizes(2)
+            ELSE
+               istop = 1
+            ENDIF
+         ENDIF
+      ELSE ! l_findDims = false
+         IF( TRIM(dimname) == TRIM(dims(1))) THEN
+            dimlen = global_sizes(1)
+            rebuild_dims(1) = idim
+         ENDIF
+         IF( rbdims > 1 .AND. TRIM(dimname) == TRIM(dims(2))) THEN
+            dimlen = global_sizes(2)
+            rebuild_dims(2) = idim
+         ENDIF
+      ENDIF
+
+      IF( idim == unlimitedDimId ) THEN
+         CALL check_nf90( nf90_def_dim( outid, dimname, nf90_unlimited, dimid) )
+         nmax_unlimited = dimlen
+      ELSE
+         CALL check_nf90( nf90_def_dim( outid, dimname, dimlen, dimid) )
+      ENDIF
+      outdimlens(idim) = dimlen
+   END DO
+
+   IF( istop == 1 ) THEN
+      WRITE(numerr,*) 'ERROR! : DOMAIN_local_sizes attribute does not match rebuild dimension lengths in the first file'
+      WRITE(numerr,*) 'Attribute DOMAIN_local_sizes is : ', local_sizes
+      WRITE(numerr,*) 'Dimensions to be rebuilt are of size : ', outdimlens(rebuild_dims(1)), outdimlens(rebuild_dims(2)) 
+      STOP 9
+   ENDIF
+
+   IF (l_findDims) THEN
+      IF (l_verbose) WRITE(numout,*) 'Finding rebuild dimensions from the first file...'
+   ELSE
+      IF (l_verbose) WRITE(numout,*) 'Using rebuild dimensions given in namelist...'
+   ENDIF
+
+   IF( rbdims > 1 ) THEN
+      IF (l_verbose) WRITE(numout,*) 'Rebuilding across dimensions '//TRIM(indimnames(rebuild_dims(1)))//  &
+         &                      ' and '//TRIM(indimnames(rebuild_dims(2)))
+   ELSE
+      IF (l_verbose) WRITE(numout,*) 'Rebuilding across dimension '//TRIM(indimnames(rebuild_dims(1)))
+   ENDIF
+      
+!2.2.2 Copy the global attributes into the output file, apart from those beginning with DOMAIN_  
+!      Also need to change the file_name attribute and the TimeStamp attribute.
+   DO attid = 1, natts
+      CALL check_nf90( nf90_inq_attname( ncid, nf90_global, attid, attname ) )
+      IF( INDEX( attname, "DOMAIN_" ) == 1 ) CYCLE
+      IF( INDEX( attname, "file_name") == 1 ) CYCLE
+      IF( INDEX( attname, "associate_file") == 1 ) CYCLE
+      IF (l_verbose) WRITE(numout,*) 'Copying attribute '//TRIM(attname)//' into destination file...'
+      CALL check_nf90( nf90_copy_att( ncid, nf90_global, attname, outid, nf90_global ) )
+   END DO
+   CALL check_nf90( nf90_put_att( outid, nf90_global, "file_name", TRIM(filebase)//'.nc') )
+   IF (l_verbose) WRITE(numout,*) 'Writing new file_name attribute'  
+   CALL DATE_AND_TIME ( date=date, time=time, zone=zone )
+   timestamp = date(7:8) // "/" // date(5:6) // "/" // date(1:4) // " " // &
+               time(1:2) // ":" // time(3:4) // ":" // time(5:6) // " " // &
+               zone  
+   CALL check_nf90( nf90_put_att( outid, nf90_global, "TimeStamp", timestamp ) )
+   IF (l_verbose) WRITE(numout,*) 'Writing new TimeStamp attribute'
+  
+!2.2.3 Copy the variable definitions and attributes into the output file.
+   DO jv = 1, nvars
+      CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ) )
+      ALLOCATE(outdimids(ndims))
+      DO idim = 1, ndims
+         outdimids(idim) = dimids(idim)
+      END DO
+      CALL check_nf90( nf90_def_var( outid, varname, xtype, outdimids, varid ) )
+      DEALLOCATE(outdimids)
+      IF (l_verbose) WRITE(numout,*) 'Defining variable '//TRIM(varname)//'...' 
+      IF( natts > 0 ) THEN
+         DO attid = 1, natts
+            CALL check_nf90( nf90_inq_attname( ncid, varid, attid, attname ) )
+            CALL check_nf90( nf90_copy_att( ncid, varid, attname, outid, varid ) )
+         END DO
+      ENDIF
+   END DO
+ 
+!2.3 End definitions in output file and copy 1st file ncid to the inncids array
+
+   CALL check_nf90( nf90_enddef( outid ) )
+   inncids(1) = ncid
+   IF (l_verbose) WRITE(numout,*) 'Finished defining output file.'
+  
+!---------------------------------------------------------------------------
+!3. Read in data from each file for each variable 
+
+!3.1 Open each file and store the ncid in inncids array
+
+   IF (l_verbose) WRITE(numout,*) 'Opening input files...'
+   DO ifile = 2, ndomain
+      CALL check_nf90( nf90_open( TRIM(filenames(ifile)), nf90_share, ncid, chunksize=chunksize ) )
+      inncids(ifile) = ncid
+   END DO
+   IF (l_verbose) WRITE(numout,*) 'All input files open.'
+
+   DO jv = 1, nvars
+
+      ValMin = 1.e10
+      ValMax = -1.e10
+      l_valid = .false.
+      istop = nf90_noerr
+      nt = 1
+      ntchunk = nmax_unlimited
+      IF( nchunksize == 0 ) nchunksize = nmax_unlimited
+
+!3.2 Inquire variable to find out name and how many dimensions it has
+!    and importantly whether it contains the dimensions in rebuild_dims()
+
+      ncid = inncids(1)
+      CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ) )
+
+      l_noRebuild = .true.
+      IF( ANY( dimids(1:ndims) == rebuild_dims(1) )) l_noRebuild = .false.
+      IF( rbdims > 1 ) THEN
+         IF( ANY( dimids(1:ndims) == rebuild_dims(2) )) l_noRebuild = .false.
+      ENDIF
+
+!3.2.0 start while loop for time chunking
+
+      DO WHILE( nt <= nmax_unlimited )
+
+         IF( ndims > 3 ) THEN
+            ntchunk = MIN( nchunksize, nmax_unlimited + 1 - nt )
+         ENDIF
+
+      IF (l_noRebuild) THEN
+
+         IF( nchunksize == nmax_unlimited .OR. ndims <= 3 ) THEN
+            IF (l_verbose) WRITE(numout,*) 'Copying data from variable '//TRIM(varname)//'...'
+         ELSE
+            IF (l_verbose) WRITE(numout,'(A,I3,A,I3,A)') ' Copying data from variable '  &
+            &                 //TRIM(varname)//' for chunks ',nt,' to ',nt+ntchunk-1,' ...'
+         ENDIF
+
+!3.2.1 If rebuilding not required then just need to read in variable
+!      for copying direct into output file after the OMP (files) loop.
+         IF( ndims == 0 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  globaldata_0d_i1 = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) )
+               CASE( NF90_SHORT )
+                  globaldata_0d_i2 = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) )
+               CASE( NF90_INT )
+                  globaldata_0d_i4 = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) )
+               CASE( NF90_FLOAT )
+                  globaldata_0d_sp = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) )
+               CASE( NF90_DOUBLE )
+                  globaldata_0d_dp = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(indimlens(dimids(1))))
+                  globaldata_1d_i1(:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(indimlens(dimids(1))))
+                  globaldata_1d_i2(:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(indimlens(dimids(1))))
+                  globaldata_1d_i4(:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(indimlens(dimids(1))))
+                  globaldata_1d_sp(:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(indimlens(dimids(1))))
+                  globaldata_1d_dp(:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_i1(:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_i2(:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_i4(:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_sp(:,:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  globaldata_2d_dp(:,:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 3 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_3d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  globaldata_3d_i1(:,:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  globaldata_3d_i2(:,:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  globaldata_3d_i4(:,:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  globaldata_3d_sp(:,:,:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  globaldata_3d_dp(:,:,:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 4 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_4d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i1(:,:,:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i2(:,:,:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i4(:,:,:,:) = 0
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_sp(:,:,:,:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  globaldata_4d_dp(:,:,:,:) = 0.
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ENDIF
+
+      ELSE  ! l_noRebuild = .false.
+
+!3.2.2 For variables that require rebuilding we need to read in from all ndomain files
+!      Here we allocate global variables ahead of looping over files
+         IF( nchunksize == nmax_unlimited .OR. ndims <= 3 ) THEN
+            IF (l_verbose) WRITE(numout,*) 'Rebuilding data from variable '//TRIM(varname)//'...'
+         ELSE
+            IF (l_verbose) WRITE(numout,'(A,I3,A,I3,A)') ' Rebuilding data from variable '  &
+            &                 //TRIM(varname)//' for chunks ',nt,' to ',nt+ntchunk-1,' ...'
+         ENDIF
+         IF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(outdimlens(dimids(1))))
+                  globaldata_1d_i1(:) = 0
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1))))
+                  globaldata_1d_i2(:) = 0
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1))))
+                  globaldata_1d_i4(:) = 0
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1))))
+                  globaldata_1d_sp(:) = 0.
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1))))
+                  globaldata_1d_dp(:) = 0.
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_i1(:,:) = 0
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_i2(:,:) = 0
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_i4(:,:) = 0
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_sp(:,:) = 0.
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  globaldata_2d_dp(:,:) = 0.
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 3 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_3d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  globaldata_3d_i1(:,:,:) = 0
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  globaldata_3d_i2(:,:,:) = 0
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  globaldata_3d_i4(:,:,:) = 0
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  globaldata_3d_sp(:,:,:) = 0.
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  globaldata_3d_dp(:,:,:) = 0.
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+
+         ELSEIF( ndims == 4 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_4d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+                   globaldata_4d_i1(:,:,:,:) = 0
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i2(:,:,:,:) = 0
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_i4(:,:,:,:) = 0
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_sp(:,:,:,:) = 0.
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+                  globaldata_4d_dp(:,:,:,:) = 0.
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 9
+            END SELECT
+         ELSE
+            WRITE(numerr,*) 'ERROR! : A netcdf variable has more than 4 dimensions which is not taken into account'
+            STOP 9
+         ENDIF
+
+!$OMP  PARALLEL DO DEFAULT(NONE)                                                          &
+!$OMP& PRIVATE(ifile,ncid,xtype,start_pos,local_sizes,InMin,InMax,natts,                  &
+!$OMP&         ndims,attid,attname,dimids,idim,dimname,dimlen,unlimitedDimId,             &
+!$OMP&         halo_start,halo_end,idomain,jdomain,rdomain,di,dj,dr,                      &
+!$OMP&         localdata_1d_i2,localdata_1d_i4,localdata_1d_sp,localdata_1d_dp,           &
+!$OMP&         localdata_2d_i2,localdata_2d_i4,localdata_2d_sp,localdata_2d_dp,           &
+!$OMP&         localdata_3d_i2,localdata_3d_i4,localdata_3d_sp,localdata_3d_dp,           &
+!$OMP&         localdata_4d_i2,localdata_4d_i4,localdata_4d_sp,localdata_4d_dp,           &
+!$OMP&         localdata_1d_i1,localdata_2d_i1,localdata_3d_i1,localdata_4d_i1)           &
+!$OMP& SHARED(jv,nvars,varname,filenames,ValMin,ValMax,indimlens,outdimlens,rbdims,       &
+!$OMP&        ndomain,outid,chunksize,istop,l_valid,nthreads,inncids,rebuild_dims,        &
+!$OMP&        globaldata_1d_i2,globaldata_1d_i4,globaldata_1d_sp,globaldata_1d_dp,        &
+!$OMP&        globaldata_2d_i2,globaldata_2d_i4,globaldata_2d_sp,globaldata_2d_dp,        &
+!$OMP&        globaldata_3d_i2,globaldata_3d_i4,globaldata_3d_sp,globaldata_3d_dp,        &
+!$OMP&        globaldata_4d_i2,globaldata_4d_i4,globaldata_4d_sp,globaldata_4d_dp,        &
+!$OMP&        globaldata_1d_i1,globaldata_2d_i1,globaldata_3d_i1,globaldata_4d_i1,        &
+!$OMP&        ntchunk,nt,nmax_unlimited)
+
+         DO ifile = 1, ndomain
+
+            ncid = inncids(ifile)
+!$OMP CRITICAL
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_local', local_sizes ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_position_first', start_pos ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_halo_size_start', halo_start ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_halo_size_end', halo_end ), istop )
+            CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ), istop )
+            CALL check_nf90( nf90_inquire( ncid, unlimitedDimId = unlimitedDimId ), istop )
+!$OMP END CRITICAL
+
+            ! set defaults for rebuilding so that i is 1st, j 2nd
+            di=1
+            dj=2
+
+            IF( rbdims == 1 ) THEN
+               ! override defaults above and set other variables
+               start_pos(2) = 1
+               local_sizes(2) = outdimlens(3-dimids(2))
+               halo_end(2) = 0
+               halo_start(2) = 0
+               di=rebuild_dims(1)
+               dj=3-di
+            ENDIF
+
+!3.3.1 Generate local domain interior sizes from local_sizes and halo sizes
+!      idomain defines the 1st and last interior points in the i direction and
+!      jdomain defines the 1st and last interior points in the j direction
+
+            idomain(1) = 1 + halo_start(di)
+            idomain(2) = local_sizes(di) - halo_end(di)
+            jdomain(1) = 1 + halo_start(dj)
+            jdomain(2) = local_sizes(dj) - halo_end(dj)
+
+!3.3.2 For rbdims or more dimensions put the data array from this input file into the correct
+!      part of the output data array. Assume the first dimensions are those to be rebuilt.
+
+            IF( ndims == 1 ) THEN
+
+               IF( rebuild_dims(1) == 1 ) THEN
+                  dr = di
+                  rdomain = idomain
+               ELSE
+                  dr = dj
+                  rdomain = jdomain
+               ENDIF
+
+              SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_1d_i1(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i1 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i1(start_pos(dr) + jr - 1) = localdata_1d_i1(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_1d_i2(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i2 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i2(start_pos(dr) + jr - 1) = localdata_1d_i2(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_1d_i4(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i4 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i4(start_pos(dr) + jr - 1) = localdata_1d_i4(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_1d_sp(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_sp ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_sp(start_pos(dr) + jr - 1) = localdata_1d_sp(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_1d_dp(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_dp ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_dp(start_pos(dr) + jr - 1) = localdata_1d_dp(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ELSEIF( ndims == 2 ) THEN
+        
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_2d_i1(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i1 ), istop )
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_2d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i1(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_2d_i2(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i2 ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i2(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_2d_i4(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i4 ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i4(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_2d_sp(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_sp ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_sp(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_2d_dp(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_dp ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_dp(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_dp) 
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ELSEIF( ndims == 3 ) THEN
+
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_3d_i1(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i1 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i1,localdata_3d_i1,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i1(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_3d_i2(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i2 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i2,localdata_3d_i2,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i2(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_3d_i4(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i4 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i4,localdata_3d_i4,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i4(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_3d_sp(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_sp ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_sp,localdata_3d_sp,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_sp(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_3d_dp(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_dp ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_dp,localdata_3d_dp,di,dj)
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_dp(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+      
+            ELSEIF (ndims == 4) THEN
+        
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_4d_i1(local_sizes(di),local_sizes(dj),               &
+                         &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i1, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i1,localdata_4d_i1,di,dj,nt,ntchunk)
+                     DO jl = 1, ntchunk
+!$OMP DO 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2)
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i1(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_4d_i2(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i2, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i2,localdata_4d_i2,di,dj,nt,ntchunk)
+                     DO jl = 1, ntchunk
+!$OMP DO 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i2(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_4d_i4(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i4, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i4,localdata_4d_i4,di,dj,nt,ntchunk)
+                     DO jl = 1, ntchunk
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i4(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_4d_sp(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_sp, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_sp,localdata_4d_sp,di,dj,nt,ntchunk) 
+                     DO jl = 1, ntchunk
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_sp(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_4d_dp(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_dp, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_dp,localdata_4d_dp,di,dj,nt,ntchunk) 
+                     DO jl = 1, ntchunk
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_dp(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ENDIF ! l_noRebuild false
+
+!3.4 Work out if the valid_min and valid_max attributes exist for this variable.
+!    If they do then calculate the extrema over all input files.
+
+            DO attid = 1, natts
+               CALL check_nf90( nf90_inq_attname( ncid, jv, attid, attname ), istop )
+               IF( INDEX( attname, "valid_min" ) == 1 ) THEN
+                  CALL check_nf90( nf90_get_att( ncid, jv, attname, InMin), istop )
+                  l_valid = .true.
+               ENDIF
+               IF( INDEX( attname, "valid_max" ) == 1 ) THEN
+                  CALL check_nf90( nf90_get_att( ncid, jv, attname, InMax ), istop )
+                  l_valid = .true.
+               ENDIF
+            END DO
+
+            IF (l_valid) THEN
+!$OMP CRITICAL
+               IF( InMin < ValMin ) ValMin = InMin
+               IF( InMax > ValMax ) ValMax = InMax
+!$OMP END CRITICAL
+            ENDIF
+
+!3.5 Abort if failure and only 1 thread 
+
+            IF( nthreads == 1 .AND. istop /= nf90_noerr )  THEN
+               WRITE(numerr,*) '*** NEMO rebuild failed! ***'
+               STOP 9
+            ENDIF
+        
+         END DO  ! loop over files
+!$OMP END PARALLEL DO
+
+!3.6 Abort if any of the OMP threads failed
+         IF( istop /= nf90_noerr )  THEN
+            WRITE(numerr,*) '*** NEMO rebuild failed! ***'
+            STOP 9
+         ENDIF
+
+      ENDIF ! ndims > 2
+
+!---------------------------------------------------------------------------
+!4. Write data to output file
+
+      IF (l_verbose) WRITE(numout,*) 'Writing variable '//TRIM(varname)//'...'
+
+!4.1 If the valid min and max attributes exist then update them in the file
+
+      IF( l_valid ) THEN
+         CALL check_nf90( nf90_put_att( outid, jv, "valid_min", ValMin ) )
+         CALL check_nf90( nf90_put_att( outid, jv, "valid_max", ValMax ) )
+      ENDIF
+
+!4.2 Write the data to the output file depending on how many dimensions it has
+
+      IF( ndims == 0 ) THEN
+
+         SELECT CASE( xtype )
+            CASE( NF90_BYTE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i1 ) )
+            CASE( NF90_SHORT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i2 ) )
+            CASE( NF90_INT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i4 ) )
+            CASE( NF90_FLOAT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_sp ) )
+            CASE( NF90_DOUBLE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_dp ) )
+         END SELECT
+
+      ELSEIF( ndims == 1 ) THEN
+
+         SELECT CASE( xtype )
+            CASE( NF90_BYTE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i1 ) )
+               DEALLOCATE(globaldata_1d_i1)
+            CASE( NF90_SHORT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i2 ) )
+               DEALLOCATE(globaldata_1d_i2)
+            CASE( NF90_INT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i4 ) )
+               DEALLOCATE(globaldata_1d_i4)
+            CASE( NF90_FLOAT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_sp ) )
+               DEALLOCATE(globaldata_1d_sp)
+            CASE( NF90_DOUBLE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_dp ) )
+               DEALLOCATE(globaldata_1d_dp)
+         END SELECT
+
+      ELSEIF( ndims == 2 ) THEN  
+     
+         SELECT CASE( xtype )   
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i1 ) )
+               DEALLOCATE(globaldata_2d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i2 ) )
+               DEALLOCATE(globaldata_2d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i4 ) )
+               DEALLOCATE(globaldata_2d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_sp ) )
+               DEALLOCATE(globaldata_2d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_dp ) )
+               DEALLOCATE(globaldata_2d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+               STOP 9
+         END SELECT     
+                      
+      ELSEIF( ndims == 3 ) THEN
+      
+         SELECT CASE( xtype ) 
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i1 ) )
+               DEALLOCATE(globaldata_3d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i2 ) )
+               DEALLOCATE(globaldata_3d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i4 ) )
+               DEALLOCATE(globaldata_3d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_sp ) )
+               DEALLOCATE(globaldata_3d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_dp ) )
+               DEALLOCATE(globaldata_3d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+               STOP 9
+         END SELECT     
+    
+      ELSEIF( ndims == 4 ) THEN
+
+         SELECT CASE( xtype )   
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+               STOP 9
+         END SELECT     
+    
+      ENDIF
+
+         nt = nt + ntchunk
+
+      END DO ! WHILE loop
+    
+   END DO  ! loop over variables
+
+!---------------------------------------------------------------------------
+!5. Close files
+
+!5.1 Close input files
+
+   IF (l_verbose) WRITE(numout,*) 'Closing input files...'
+   DO ifile = 1, ndomain
+      ncid = inncids(ifile)
+      CALL check_nf90( nf90_close( ncid ) )
+   END DO
+
+!5.2 Close output file
+
+   IF (l_verbose) WRITE(numout,*) 'Closing output file...'
+   CALL check_nf90( nf90_close( outid ) )
+
+   IF (l_verbose) WRITE(numout,*) 'NEMO rebuild completed successfully'
+   IF (l_verbose) WRITE(numout,*)
+
+CONTAINS
+
+
+   SUBROUTINE check_nf90(status, errorFlag)
+   !---------------------------------------------------------------------
+   !  Checks return code from nf90 library calls and warns if needed
+   !  If errorFlag is present then it just increments this flag (OMP use)
+   !
+   !---------------------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: status
+      INTEGER, INTENT(INOUT), OPTIONAL :: errorFlag
+   !---------------------------------------------------------------------
+
+      IF( status /= nf90_noerr ) THEN
+         WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(status))
+         IF( PRESENT( errorFlag ) ) THEN
+            errorFlag = errorFlag + status
+         ELSE
+            WRITE(numerr,*) "*** NEMO rebuild failed ***"
+            WRITE(numerr,*)
+            STOP 9
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE check_nf90
+
+
+END PROGRAM rebuild_nemo
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/namelist
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/namelist	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/namelist	(revision 8732)
@@ -0,0 +1,28 @@
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .true.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .true.    !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_jpk      =  51       ! Number of S levels
+   ln_eq_taper = .false.   !  Tapering of S coords near equator
+   cn_coord_hgr = 'coordinates.nc'  ! File containing gphit (latitude) coordinate for use if ln_eq_taper=.true.
+   rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_hc       =   50.0    !  critical depth for transition to stretched coordinates
+                        !!!!!!!  Envelop bathymetry
+   rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1)
+                        !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma   
+                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
+   rn_alpha    =    4.4    !  stretching with SF12 s-sigma
+   rn_efold    =    0.0    !  efold length scale for transition to stretched coord
+   rn_zs       =    1.0    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb
+   rn_zb_b     =   -0.2    !  offset for calculating Zb
+                        !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1) 
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90	(revision 8732)
@@ -0,0 +1,664 @@
+PROGRAM SCOORD_GEN
+      !!----------------------------------------------------------------------
+      !!                  ***  PROGRAM scoord_gen  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            z_gsigt(k) = fssig (k    )
+      !!            z_gsigw(k) = fssig (k-0.5)
+      !!            z_esigt(k) = fsdsig(k    )
+      !!            z_esigw(k) = fsdsig(k-0.5)
+      !!      Three options for stretching are give, and they can be modified
+      !!      following the users requirements. Nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!      The three methods for stretching available are:
+      !! 
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !! 
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates        
+      !!
+      !! ** History: 2015: Tim Graham - Code created based on online zdf_sco routine
+      !!
+      !!
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      IMPLICIT NONE
+
+
+     !!----------------------------------------------------------------------
+      !
+      !
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, namzgr_sco )
+      CLOSE( numnam )
+      jpk = INT(rn_jpk)
+
+      WRITE(*,*)
+      WRITE(*,*) 'scoord_gen : s-coordinate or hybrid z-s-coordinate'
+      WRITE(*,*) '~~~~~~~~~~~'
+      WRITE(*,*) '   Namelist namzgr_sco'
+      WRITE(*,*) '     stretching coeffs '
+      WRITE(*,*) '        Number of levels                             rn_jpk        = ',rn_jpk
+      WRITE(*,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+      WRITE(*,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+      WRITE(*,*) '        Critical depth                               rn_hc         = ',rn_hc
+      WRITE(*,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+      WRITE(*,*) '        Tapering in vicinity of equator              ln_eq_taper   = ',ln_eq_taper
+      WRITE(*,*) '        Horizontal Coordinate File                   cn_coord_hgr  = ',cn_coord_hgr
+      WRITE(*,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+      WRITE(*,*) '        Song and Haidvogel 1994 stretching coefficients'
+      WRITE(*,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+      WRITE(*,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+      WRITE(*,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+      WRITE(*,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+      WRITE(*,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+      WRITE(*,*) '        Siddorn and Furner 2012 stretching coefficients'
+      WRITE(*,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+      WRITE(*,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+      WRITE(*,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+      WRITE(*,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+      WRITE(*,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+      WRITE(*,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+
+      
+      ! Read in bathy, jpi and jpj from bathy.nc
+      CALL read_bathy()
+
+      !Allocate all other allocatable variables
+      ios = dom_oce_alloc()
+      IF( ios .NE. 0) THEN
+         WRITE(0,*) 'Unable to allocate all arrays'
+         STOP 1
+      ENDIF
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) > 0. )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+         END DO
+      END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) == 0. ) THEN
+             iip1 = MIN( ji+1, jpi )
+             ijp1 = MIN( jj+1, jpj )
+             iim1 = MAX( ji-1, 1 )
+             ijm1 = MAX( jj-1, 1 )
+             IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) +              &
+        &         bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0. ) THEN
+               zenv(ji,jj) = rn_sbot_min
+             ENDIF
+           ENDIF
+         END DO
+      END DO
+      ! 
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0.             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1.
+      !   
+      !     
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1. - rn_rmax ) / ( 1. + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1.
+      zrj(:,:) = 1.
+
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8 ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0.
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0.
+         zrj(:,:) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               iip1 = MIN(ji+1,jpi) 
+               ijp1 = MIN(jj+1,jpj)     
+               IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0.) .AND. (zenv(ji,ijp1) > 0.)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         !
+         WRITE(*,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( ln_eq_taper) THEN
+        CALL READ_GPHIT()
+        IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0. ) THEN
+          WRITE(*,*) 's-coordinates are tapered in vicinity of the Equator' 
+          DO jj = 1, jpj
+             DO ji = 1, jpi
+                ztaper = EXP( -(gphit(ji,jj)/8.)**2. )
+                hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1. - ztaper )
+             END DO
+          END DO
+        ENDIF
+      ENDIF
+      !
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      WRITE(*,*)
+      WRITE(*,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpj-1
+        DO ji = 1, jpi-1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50 * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+      ! 
+      zhbat(:,:) = hbatu(:,:)   
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)  
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+!!bug:  key_helsinki a verifer
+      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+         WRITE(*,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(*,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(*,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(*,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      
+      ! Create the output file
+      CALL make_coord_file()
+
+      !                                            ! =======================
+      !                                            !   s-coordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)                    
+! To reduce memory loop over jpk and write each level to file
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN 
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE                 
+                           CALL s_tanh()
+      ENDIF
+
+!Write all 2D variables to output file
+      CALL write_netcdf_2d_vars()
+      CALL check_nf90( nf90_close(ncout) )
+
+ 
+      !
+END PROGRAM SCOORD_GEN
+
+!!======================================================================
+   SUBROUTINE s_sh94()
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994. 
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigt3, z_esigw3, z_esigtu3 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+
+      ALLOCATE( z_gsigw3(jpi,jpj), z_gsigt3(jpi,jpj), z_gsi3w3(jpi,jpj) )
+      ALLOCATE( z_esigt3(jpi,jpj), z_esigw3(jpi,jpj), z_esigtu3(jpi,jpj)) 
+      ALLOCATE( z_esigtv3(jpi,jpj), z_esigtf3(jpi,jpj), z_esigwu3(jpi,jpj)) 
+      ALLOCATE( z_esigwv3(jpi,jpj), z_gsigw3p1(jpi,jpj), z_gsigt3m1(jpi,jpj) )
+      ALLOCATE( z_gsi3w3m1(jpi,jpj) )
+ 
+      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0.
+      z_esigt3  = 0.   ;   z_esigw3  = 0. 
+      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0.
+      z_esigwu3 = 0.   ;   z_esigwv3 = 0.
+
+      DO jk = 1,jpk
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                     z_gsigw3(ji,jj) = -fssig1( REAL(jk,wp)-0.5, rn_bb )
+                     z_gsigw3p1(ji,jj) = -fssig1( REAL(jk+1,wp)-0.5, rn_bb )
+                     z_gsigt3(ji,jj) = -fssig1( REAL(jk,wp)    , rn_bb )
+               ELSE ! shallow water, uniform sigma
+                     z_gsigw3(ji,jj) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     z_gsigw3p1(ji,jj) =   REAL(jk,wp)            / REAL(jpk-1,wp)
+                     z_gsigt3(ji,jj) = ( REAL(jk-1,wp) + 0.5 ) / REAL(jpk-1,wp)
+               ENDIF
+               !
+             !gsi3w3m1 & gsigt3m1 only used if jk /= 1 and is set at the end of the loop over jk
+               IF( jk .EQ. 1) THEN
+                  z_esigw3(ji,jj ) = 2. * ( z_gsigt3(ji,jj ) - z_gsigw3(ji,jj ) )
+                  z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj)
+               ELSE
+                  z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj)
+                  z_gsi3w3(ji,jj) = z_gsi3w3m1(ji,jj) + z_esigw3(ji,jj)
+               ENDIF
+               IF( jk .EQ. jpk) THEN
+                  z_esigt3(ji,jj) = 2. * ( z_gsigt3(ji,jj) - z_gsigw3(ji,jj) )
+               ELSE
+                  z_esigt3(ji,jj ) = z_gsigw3p1(ji,jj) - z_gsigw3(ji,jj)
+               ENDIF
+               !
+
+               zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpk-1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpk-1,wp)
+               gdept_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj)+rn_hc*zcoeft )
+               gdepw_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj)+rn_hc*zcoefw )
+               gdep3w_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj)+rn_hc*zcoeft )
+              !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+
+         DO ji = 1, jpi-1
+            DO jj = 1, jpj-1
+               z_esigtu3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj)     &
+                  &                + hbatt(ji,jj+1)*z_esigt3(ji,jj+1)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               !
+               e3t_0(ji,jj) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3u_0(ji,jj) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3v_0(ji,jj) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3f_0(ji,jj) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               !
+               e3w_0 (ji,jj) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3uw_0(ji,jj) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3vw_0(ji,jj) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+            END DO
+         END DO
+
+         z_gsigt3m1 = z_gsigt3
+         z_gsi3w3m1 = z_gsi3w3
+ 
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+        
+         CALL write_netcdf_3d_vars(jk)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+      END DO !End of loop over jk
+
+      DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3, z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1)
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+   END SUBROUTINE s_sh94
+
+   SUBROUTINE s_sf12
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 *** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigt3, z_esigw3, z_esigtu3 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+
+      ALLOCATE( z_gsigw3(jpi,jpj), z_gsigt3(jpi,jpj), z_gsi3w3(jpi,jpj) )
+      ALLOCATE( z_esigt3(jpi,jpj), z_esigw3(jpi,jpj), z_esigtu3(jpi,jpj)) 
+      ALLOCATE( z_esigtv3(jpi,jpj), z_esigtf3(jpi,jpj), z_esigwu3(jpi,jpj)) 
+      ALLOCATE( z_esigwv3(jpi,jpj), z_gsigw3p1(jpi,jpj), z_gsigt3m1(jpi,jpj) )
+      ALLOCATE( z_gsi3w3m1(jpi,jpj) )
+
+      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0.
+      z_esigt3  = 0.   ;   z_esigw3  = 0. 
+      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0.
+      z_esigwu3 = 0.   ;   z_esigwv3 = 0.
+      
+
+      DO jk = 1,jpk
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+             IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              
+                zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+                zzb = 1.0-(zzb/hbatt(ji,jj))
+            
+                zzs = rn_zs / hbatt(ji,jj) 
+              
+                IF (rn_efold /= 0.0) THEN
+                   zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+                ELSE
+                   zsmth = 1.0 
+                ENDIF
+                  
+                z_gsigw3(ji,jj) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigw3p1(ji,jj) =  REAL(jk,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+                z_gsigw3(ji,jj) = fgamma( z_gsigw3(ji,jj), zzb, zzs, zsmth  )
+                z_gsigw3p1(ji,jj) = fgamma( z_gsigw3p1(ji,jj), zzb, zzs, zsmth  )
+                z_gsigt3(ji,jj) = fgamma( z_gsigt3(ji,jj), zzb, zzs, zsmth  )
+ 
+             ELSE IF(ln_sigcrit) THEN ! shallow water, uniform sigma
+
+                z_gsigw3(ji,jj) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+                z_gsigw3p1(ji,jj) =  REAL(jk,wp)     /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+
+             ELSE  ! shallow water, z coordinates
+
+               z_gsigw3(ji,jj) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+               z_gsigw3p1(ji,jj) =  REAL(jk,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+               z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+
+             ENDIF
+
+             !gsi3w3m1 & z_gsigt3m1 only used if jk /= 1 and is set at the end of the loop over jk
+             IF( jk .EQ. 1) THEN
+                z_esigw3(ji,jj  ) = 2.0 * (z_gsigt3(ji,jj ) - z_gsigw3(ji,jj ))
+                z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj) 
+             ELSE
+                z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj)
+                z_gsi3w3(ji,jj) = z_gsi3w3m1(ji,jj) + z_esigw3(ji,jj)
+             ENDIF
+             IF( jk .EQ. jpk) THEN
+                z_esigt3(ji,jj) = 2.0 * (z_gsigt3(ji,jj) - z_gsigw3(ji,jj))
+             ELSE
+                z_esigt3(ji,jj) = z_gsigw3p1(ji,jj) - z_gsigw3(ji,jj)
+             ENDIF
+
+             gdept_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj)
+             gdepw_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj)
+             gdep3w_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj)
+
+            ENDDO   ! for all jj's
+         ENDDO    ! for all ji's
+
+         DO ji=1,jpi-1
+            DO jj=1,jpj-1
+
+               z_esigtu3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) +  &
+                                       hbatt(ji,jj+1)*z_esigt3(ji,jj+1)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+
+               e3t_0(ji,jj)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj)
+               e3u_0(ji,jj)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj)
+               e3v_0(ji,jj)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj)
+               e3f_0(ji,jj)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj)
+               !
+               e3w_0(ji,jj)=hbatt(ji,jj)*z_esigw3(ji,jj)
+               e3uw_0(ji,jj)=hbatu(ji,jj)*z_esigwu3(ji,jj)
+               e3vw_0(ji,jj)=hbatv(ji,jj)*z_esigwv3(ji,jj)
+            ENDDO
+         ENDDO
+         ! Keep some arrays for next level
+         z_gsigt3m1 = z_gsigt3
+         z_gsi3w3m1 = z_gsi3w3
+ 
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+         
+         CALL write_netcdf_3d_vars(jk)
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+
+      ENDDO ! End of loop over jk
+
+      DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3, z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1)
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+   END SUBROUTINE s_sf12
+
+   SUBROUTINE s_tanh()
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh*** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch 
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+
+      USE utils
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw
+
+      ALLOCATE( z_gsigw(jpk), z_gsigt(jpk), z_gsi3w(jpk) )
+      ALLOCATE( z_esigt(jpk), z_esigw(jpk) )
+
+      z_gsigw  = 0.   ;   z_gsigt  = 0.   ;   z_gsi3w  = 0.
+      z_esigt  = 0.   ;   z_esigw  = 0. 
+
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5 )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      WRITE(*,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpk-1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2. * ( z_gsigt(1  ) - z_gsigw(1  ) ) 
+      z_esigt(jpk) = 2. * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      z_gsi3w(1) = 0.5 * z_esigw(1)
+      DO jk = 2, jpk
+         z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk)
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpk-1,wp)
+              zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpk-1,wp)
+              gdept_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsigt(jk) + hift(ji,jj)*zcoeft )
+              gdepw_0(:,:) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsigw(jk) + hift(ji,jj)*zcoefw )
+              gdep3w_0(:,:) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsi3w(jk) + hift(ji,jj)*zcoeft )
+              e3t_0(ji,jj) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpk-1,wp) )
+              e3u_0(ji,jj) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpk-1,wp) )
+              e3v_0(ji,jj) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpk-1,wp) )
+              e3f_0(ji,jj) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpk-1,wp) )
+              !
+              e3w_0(ji,jj) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpk-1,wp) )
+              e3uw_0(ji,jj) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpk-1,wp) )
+              e3vw_0(ji,jj) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpk-1,wp) )
+              IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+              IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+ 
+         CALL write_netcdf_3d_vars(jk)
+      ENDDO ! End of loop over jk
+
+
+      DEALLOCATE( z_gsigw, z_gsigt, z_gsi3w )
+      DEALLOCATE( z_esigt, z_esigw )
+
+   END SUBROUTINE s_tanh
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SCOORD_GEN/src/utils.F90	(revision 8732)
@@ -0,0 +1,330 @@
+MODULE utils
+
+   USE netcdf
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used
+   !                  ! exception to coding rules... to be suppressed ???
+
+!   PUBLIC dom_oce_alloc
+
+   INTEGER, PARAMETER   :: dp=8 , sp=4, wp=dp
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit              !: latitude at t points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m)
+
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies 
+   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio
+
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters - read from file)
+
+   !! Other variables needed by scoord_gen
+   INTEGER  ::   jpi, jpj, jpk            ! Size of the domain - read from bathy or namelist?
+   INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+   INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+   INTEGER  ::   ios                      ! Local integer output status for namelist read and allocation
+   INTEGER,PARAMETER  ::   numnam=8       ! File handle for namelist 
+   REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+   REAL(wp) ::   zrfact
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+
+   !Namelist variables
+   REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta
+   REAL(wp) :: rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+   LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper
+   CHARACTER(len=50) :: cn_coord_hgr
+
+   NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper, & 
+                  &      cn_coord_hgr, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+                  &      rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+
+  ! IDs for output netcdf file
+  INTEGER :: id_x, id_y, id_z
+  INTEGER :: ncout
+  INTEGER, DIMENSION(20) :: var_ids  !Array to contain all variable IDs
+
+   CONTAINS
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(4) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), &
+         &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) ,                         &
+         &      gdept_0(jpi,jpj) , e3t_0(jpi,jpj) , e3u_0 (jpi,jpj) ,                         &
+         &      gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) ,                         &
+         &      gphit(jpi,jpj)   , e3uw_0(jpi,jpj) , STAT=ierr(2) )
+         !
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(3) )
+
+      ALLOCATE( mbathy(jpi,jpj) , STAT=ierr(4) )
+     !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+ 
+
+   SUBROUTINE read_bathy()
+     !! Read bathymetry from input netcdf file
+     INTEGER :: var_id, ncin
+
+     CALL check_nf90( nf90_open('bathy_meter.nc', NF90_NOWRITE, ncin), 'Error opening bathy_meter.nc file' )
+
+     ! Find the size of the input bathymetry
+     CALL dimlen(ncin, 'lon', jpi)    
+     CALL dimlen(ncin, 'lat', jpj)    
+     
+     ALLOCATE( bathy(jpi, jpj) )
+     
+     ! Read the bathymetry variable from file
+     CALL check_nf90( nf90_inq_varid( ncin, 'Bathymetry', var_id ), 'Cannot get variable ID for bathymetry')
+     CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+     CALL check_nf90( nf90_close(ncin), 'Error closing bathy.nc file' )
+
+   END SUBROUTINE read_bathy
+
+   SUBROUTINE read_gphit()
+   !! Read gphit from horizontal coordinate file if required
+     INTEGER :: var_id, ncin
+
+     CALL check_nf90( nf90_open(cn_coord_hgr, NF90_NOWRITE, ncin), 'Error opening horizontal coordinate file' )
+
+     ! Read gphit variable from file
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', var_id ), 'Cannot get variable ID for bathymetry')
+     CALL check_nf90( nf90_get_var( ncin, var_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+     CALL check_nf90( nf90_close(ncin), 'Error closing horizontal coordinate file' )
+
+   END SUBROUTINE read_gphit
+
+   SUBROUTINE dimlen( ncid, dimname, len )
+     ! Determine the length of dimension dimname
+     INTEGER, INTENT(in)          :: ncid
+     CHARACTER(LEN=*), INTENT(in) :: dimname
+     INTEGER, INTENT(out)         :: len
+     ! Local variables
+     INTEGER :: id_var
+
+     id_var = 1
+     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+   END SUBROUTINE dimlen
+  
+ 
+   SUBROUTINE make_coord_file()
+     ! Create new coordinates file and define dimensions and variables ready for
+     ! writing
+     
+
+     !Create the file
+     CALL check_nf90( nf90_create('coord_zgr.nc', NF90_NETCDF4, ncout), 'Could not create output file')
+     !
+     !Define dimensions
+     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+     !
+     !Define variables - include all varibles that would be put into the mesh
+     !mask file
+     CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_z/), var_ids(1)) )
+     CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(2)) )
+     CALL check_nf90( nf90_def_var(ncout, 'gdep3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(3)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3f_0', nf90_double, (/id_x, id_y,id_z/), var_ids(4)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3t_0', nf90_double, (/id_x, id_y,id_z/), var_ids(5)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3u_0', nf90_double, (/id_x, id_y,id_z/), var_ids(6)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3v_0', nf90_double, (/id_x, id_y,id_z/), var_ids(7)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(8)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(9)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) )
+     ! 2D fields
+     CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y/), var_ids(11)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatt', nf90_double, (/id_x, id_y/), var_ids(12)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatu', nf90_double, (/id_x, id_y/), var_ids(13)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatv', nf90_double, (/id_x, id_y/), var_ids(14)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatf', nf90_double, (/id_x, id_y/), var_ids(15)) )
+     CALL check_nf90( nf90_def_var(ncout, 'rx1', nf90_double, (/id_x, id_y/), var_ids(16)) )
+
+     
+     ! End define mode
+     CALL check_nf90( nf90_enddef(ncout) )
+     
+     WRITE(*,*) 'Opened coord_zgr.nc file and defined variables'
+
+   END SUBROUTINE make_coord_file
+
+   SUBROUTINE write_netcdf_2d_vars()
+
+     CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(12), hbatt, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(13), hbatu, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(14), hbatv, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(15), hbatf, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(16), rx1, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+   END SUBROUTINE write_netcdf_2d_vars
+
+   SUBROUTINE write_netcdf_3d_vars(kk)
+   ! Write  variables to the netcdf file at level kk
+     INTEGER, INTENT(in) :: kk
+
+     CALL check_nf90( nf90_put_var(ncout, var_ids(1), gdept_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(2), gdepw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(3), gdep3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(4), e3f_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(5), e3t_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(6), e3u_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(7), e3v_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(8), e3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+
+   END SUBROUTINE write_netcdf_3d_vars
+
+   SUBROUTINE check_nf90( istat, message )
+      !Check for netcdf errors
+      INTEGER, INTENT(in) :: istat
+      CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+
+      IF (istat /= nf90_noerr) THEN
+         WRITE(*,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+         IF ( PRESENT(message) ) THEN ; WRITE(*,*) message ; ENDIF
+         STOP
+      ENDIF
+
+   END SUBROUTINE check_nf90
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : wp,rn_theta,rn_thetb,jpk
+      IMPLICIT NONE
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpk-1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2. * rn_thetb - 1. ) )  )              &
+         & / ( 2. * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : wp, jpk, rn_theta
+      IMPLICIT NONE
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5 ) / REAL( jpk-1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1. - pbb ) * ( SINH( rn_theta*(-(pk1-0.5)/REAL(jpk-1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5)/REAL(jpk-1)) + 0.5) ) - TANH( 0.5 * rn_theta )  )  &
+            &        / ( 2. * TANH( 0.5 * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : jpk,wp,rn_alpha
+      IMPLICIT NONE
+      REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma       ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth         ! Smoothing parameter
+      REAL(wp)                ::   za1,za2,za3   ! local variables
+      REAL(wp)                ::   zn1,zn2       ! local variables
+      REAL(wp)                ::   za,zb,zx      ! local variables
+      !!----------------------------------------------------------------------
+      !
+
+      zn1  =  1./(jpk-1.)
+      zn2  =  1. -  zn1
+
+      za1 = (rn_alpha+2.0)*zn1**(rn_alpha+1.0)-(rn_alpha+1.0)*zn1**(rn_alpha+2.0) 
+      za2 = (rn_alpha+2.0)*zn2**(rn_alpha+1.0)-(rn_alpha+1.0)*zn2**(rn_alpha+2.0)
+      za3 = (zn2**3.0 - za2)/( zn1**3.0 - za1)
+     
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5*(za2+zn2**2.0) - za3*(zn1-0.5*(za1+zn1**2.0) ) )
+      zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1)
+      zx = 1.0-za/2.0-zb
+
+      p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  &
+                  & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- &
+                  &      (rn_alpha+1.0)*pk1**(rn_alpha+2.0) )
+      p_gamma = p_gamma*psmth+pk1*(1.0-psmth)
+
+      !
+   END FUNCTION fgamma
+
+
+END MODULE utils
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh	(revision 8732)
@@ -0,0 +1,46 @@
+#!/bin/ksh
+set -x
+#####################################################
+#     CONFIGURATION CHOICE                          #
+#####################################################
+#CONFIG=ORCA2_LIM GYRE
+CONFIG=ORCA2_LIM
+
+#####################################################
+#     CONFIGURATION DESCRIPTION                     #
+#####################################################
+# each configuration is defined by:
+#   - INSPACE: directory the coordinate netcdf file is
+#   - COOR_FIL: configuration's coordinate netcdf file
+#   - LIST:     configuration's list of sections
+#
+#####################################################
+case $CONFIG in
+#
+ORCA2_LIM)
+INSPACE=/dataref/rd/INITIALISATION/ORCA2
+COOR_FIL=coordinates.nc
+LIST=list_sections.ascii_global
+;;
+#
+GYRE)
+INSPACE=/perm/ms/fr/ar5
+COOR_FIL=mesh_mask.nc
+LIST=list_sections.ascii_GYRE
+;;
+#
+esac
+
+#####################################################
+#     RUN                                           #
+#####################################################
+BIN=diadct_sections.exe
+
+export CTLDIR=`pwd`
+cd ${CTLDIR}
+rm -f coordinates.nc ${BIN} list_sections.ascii
+cp ../${BIN} .
+ln -sf ${LIST} list_sections.ascii
+ln -s $INSPACE/$COOR_FIL ./coordinates.nc
+./${BIN}
+mv section_ijglobal.diadct section_ijglobal.diadct_$CONFIG 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 8732)
@@ -0,0 +1,3 @@
+ -80.     14.    -80.     30.   00 okstrpond noice  SEC1
+ -70.     14.    -70.     30.   00 okstrpond noice  SEC2
+ -90.     20.    -60.     20.   00 okstrpond noice  SEC3
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 8732)
@@ -0,0 +1,27 @@
+(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)
+
+long1   lat1    long2   lat2    nbclasse S/T transp? ice transp? section name
+
+-xxx.xx_-xxx.xx_-xxx.xx_-xxx.xx_ii_aaaaaaaaa_aaaaa_aaaaa....
+ 100.    -23.9   115.    -23.9  00 nostrpond noice IND_W1
+ 100.    -33.8   117.    -33.8  00 nostrpond noice IND_W2
+ 100.    -33.8   100.      2.   00 nostrpond noice IND_W3
+ 122.    -45.    122.    -30.   00 nostrpond noice IND_S1
+ 139.5   -45.    139.5   -32.   00 nostrpond noice IND_S2
+ 122.    -45.    139.5   -45.   00 nostrpond noice IND_S3
+ 150.    -28.5   165.    -28.5  00 nostrpond noice IND_E1
+ 148.    -34.    165.    -34.   00 nostrpond noice IND_E2
+ 146.    -41.7   165.    -41.7  00 nostrpond noice IND_E3
+ 165.    -41.7   165.    -28.5  00 nostrpond noice IND_E4
+ 149.    -10.    165.    -10.   00 nostrpond noice IND_E6
+ 165.    -41.7   173.    -41.7  00 nostrpond noice IND_E7
+ 115.     24.    122.     17.   00 nostrpond noice IND_N1
+ 125.      8.    134.     -2.   00 nostrpond noice IND_N2
+ 114.1    -8.45  118.9    -8.45 00 nostrpond noice IND_N3
+ 121.8    -8.7   124.1    -9.7  00 nostrpond noice IND_N4
+ 124.1    -9.7   127.    -15.   00 nostrpond noice IND_N5
+ 115.    -25.    104.     -4.   00 nostrpond noice IND_N6
+ 116.      2.3   134.     -2.   00 nostrpond noice IND_N8
+  33.   -22.2     45.    -22.2  00 nostrpond noice IND_AG1
+  25.   -33.65    44.    -33.65 00 nostrpond noice IND_AG2
+  44.   -22.2     44.    -33.65 00 nostrpond noice IND_AG3
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 8732)
@@ -0,0 +1,357 @@
+ -68.    -54.5   -60.    -64.7  00 okstrpond noice ACC_Drake_Passage
+  27.    -73.     27.    -30.   00 nostrpond noice ACC_LeCap
+ 116.    -70.    116.    -33.8  00 nostrpond noice ACC_WAUS
+ 147.3   -70.    147.3   -41.   00 okstrpond noice ACC_TAS
+ 167.4   -73.    167.4   -45.5  00 nostrpond noice ACC_NZ
+ -82.     73.4   -82.     74.9  00 nostrpond   ice ARC_Lancaster_sound
+ -81.     75.1   -81.     76.6  00 nostrpond   ice ARC_Jones_Strait
+ -76.     78.4   -72.     78.3  00 nostrpond   ice ARC_Robeson_Channel
+ -64.6    60.3   -65.     61.5  00 nostrpond   ice ARC_Hudson_Strait
+  20.9    71.5    16.     77.   03 nostrpond   ice ARC_Bear_Island
+zsal
+ 0.00
+34.9
+50.0
+  33.5    68.     33.5    74.   03 nostrpond   ice ARC_Kola_Section
+zsal
+ 0.00
+34.9
+50.0
+  25.     80.     48.2    80.2  00 nostrpond   ice ARC_Spitzberg_FJLand
+  57.     80.3    65.9    76.4  03 nostrpond   ice ARC_FJLand_NovZemlija
+zsigi
+ 0.
+27.8
+30.0
+  57.     70.7    59.     70.2  00 nostrpond   ice ARC_Kara_Gate
+  25.     70.     22.6    77.8  05 nostrpond   ice ARC_Barents_Sea
+zsigi
+ 0.0
+25.0
+27.8
+29.0
+30.0
+ -21.5    79.5    15.     79.   05 nostrpond   ice ARC_Fram_Strait
+zsigi
+0.0
+25.0
+27.8
+29.0
+30.0
+ -81.     27.1   -73.     27.   04 nostrpond noice ATL_West_Atlantic_27N
+zlay
+    0.
+ 1000.
+ 6000.
+20000.
+ -35.     15.1   -35.     -8.   00 nostrpond noice ATL_Tropical_Atlantic_35W
+ -63.      9.    -55.     20.   03 nostrpond noice ATL_South_West_Atlantic
+ztem
+-2.0
+ 4.5
+40.0
+ -35.     54.    -30.5    52.   03 nostrpond noice ATL_Gibbs
+zlay
+    0.
+ 3000.
+20000.
+ -40.     -4.    -40.     10.   03 nostrpond noice ATL_North_Brazil_Current_40W
+zsigi
+ 0.0
+27.45
+30.0
+ -55.     -1.    -50.     10.   05 nostrpond noice ATL_North_Brazil_Current_10N
+zsigi
+ 0.0
+24.5
+27.125
+27.45
+30.0 
+ -53.    -30.1   -40.    -30.   00 nostrpond noice ATL_Brazil_Current_30S
+ -63     -40.1   -53.    -40.   00 nostrpond noice ATL_Falklands_Current_40S
+ -23.    -15.    -23.     15.   05 nostrpond noice ATL_Atlantic_Equatorial
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+   5.    -15.1    13.    -15.   00 nostrpond noice ATL_Benguela_Current_15S
+  10.    -40.     22.    -31.   00 nostrpond noice ATL_Agulhas_zone_30S
+  19.    -30.1   -54.0   -30.0  00 nostrpond noice ATL_Trans_Atlantic_30S
+  -7.     62.2    -4.5    58.   05 nostrpond noice ATL_England_Faroe
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -15.     65.     -7.     62.2  05 nostrpond noice ATL_Iceland_Faroe
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -37.     66.1   -22.5    66.   05 nostrpond   ice ATL_Denmark_Strait
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -44.     63.    -35.     61.   05 nostrpond   ice ATL_East_Greenland
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -45.     60.9   -45.     57.   05 nostrpond   ice ATL_South_Greenland
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -50.1    55.1   -61.     55.   05 nostrpond   ice ATL_Labrador_55N 
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+   8.     58.5    -2.5    57.   00 nostrpond noice ATL_England_Norway 
+  -5.7    35.5    -5.7    36.5  00 nostrpond noice ATL_Gibraltar 
+  -8.5    32.     -8.5    38.2  00 nostrpond noice ATL_Gulf_Cadiz
+ -44.     60.     -27.    56.   00 nostrpond noice ATL_Ovide1
+ -27.     56.     -16.    40.   00 nostrpond noice ATL_Ovide2
+ -16.     40.1     -8.1   40.   00 nostrpond noice ATL_Portugal
+  -4.     48.2     -8.1   43.1  05 nostrpond noice ATL_Biscay
+zsal
+ 0.0
+35.6
+36.0
+36.0
+50.0
+ -14.     26.1    -22.    26.   00 nostrpond noice ATL_South_Canaries
+ -24.     32.     -24.    37.9  03 nostrpond noice ATL_Acores_24W
+zlay
+   0.
+  800.
+20000.
+ -66.4    18.1    -63.    10.   05 nostrpond noice ATL_Antilles
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -60.1    18.1    -66.5   18.2  05 nostrpond noice ATL_Porto_Rico
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -66.5    18.1    -68.9   18.5  05 nostrpond noice ATL_Hispagnola_Porto_Rico
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -75.     20.2    -72.6   19.7  05 nostrpond noice ATL_Windward_Passage
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -77.5    18.2    -84.    14.   05 nostrpond noice ATL_Jamaica_Ridge
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -77.5    18.     -76.5   20.3  05 nostrpond noice ATL_Cuba_Jamaica
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -87.3    21.     -84.    22.2  05 nostrpond noice ATL_Yucatan_Strait_KANEC
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -80.5    22.5    -80.5   25.5  05 nostrpond noice ATL_Cuba_Florida
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -78.5    26.7    -80.5   27.   05 okstrpond noice ATL_Florida_Bahamas
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -70.     30.1    -82.    30.   05 nostrpond noice ATL_West_Atlantic_30N
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -70.     45.     -70.    30.1  05 nostrpond noice ATL_Gulf_Stream
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -55.     30.     -55.    47.9  05 nostrpond noice ATL_Gulf_Stream_2
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -55.     48.1     -3.9   48.   00 okstrpond noice ATL_Atlantic_48N
+ -85.     24.1    -10.8   24.   00 okstrpond noice ATL_Atlantic_24N
+ -75.6    24.     -10.8   24.   00 okstrpond noice ATL_Atlantic_24N1
+ -85.     26.1    -10.8   26.   04 okstrpond noice ATL_Atlantic_26N
+zlay
+    0.
+ 1000.
+ 6000.
+20000.
+ 100.    -23.9   115.    -23.9  00 nostrpond noice IND_W1
+ 100.    -33.8   117.    -33.8  00 nostrpond noice IND_W2
+ 100.    -33.8   100.      2.   00 nostrpond noice IND_W3
+ 122.    -45.    122.    -30.   00 nostrpond noice IND_S1
+ 139.5   -45.    139.5   -32.   00 nostrpond noice IND_S2
+ 122.    -45.    139.5   -45.   00 nostrpond noice IND_S3
+ 150.    -28.5   165.    -28.5  00 nostrpond noice IND_E1
+ 148.    -34.    165.    -34.   00 nostrpond noice IND_E2
+ 146.    -41.7   165.    -41.7  00 nostrpond noice IND_E3
+ 165.    -41.7   165.    -28.5  00 nostrpond noice IND_E4
+ 165.    -10.    165.    -28.5  00 nostrpond noice IND_E5
+ 149.    -10.    165.    -10.   00 nostrpond noice IND_E6
+ 165.    -41.7   173.    -41.7  00 nostrpond noice IND_E7
+ 115.     24.    122.     17.   00 nostrpond noice IND_N1
+ 125.      8.    134.     -2.   00 nostrpond noice IND_N2
+ 114.1    -8.45  118.9    -8.45 00 nostrpond noice IND_N3
+ 121.8    -8.7   124.1    -9.7  00 nostrpond noice IND_N4
+ 124.1    -9.7   127.    -15.   00 nostrpond noice IND_N5
+ 115.    -25.    104.     -4.   00 nostrpond noice IND_N6
+ 116.      2.3   134.     -2.   00 nostrpond noice IND_N8
+  33.   -22.2     45.    -22.2  00 nostrpond noice IND_AG1
+  25.   -33.65    44.    -33.65 00 nostrpond noice IND_AG2
+  44.   -22.2     44.    -33.65 00 nostrpond noice IND_AG3
+ 114.    -8.5    120.    -21.   05 nostrpond noice IND_Australia_Bali
+zlay
+    0.
+  200.
+  500.
+ 2000.
+20000.
+  45.     6.1     53.      6.   00 nostrpond noice IND_Somali_Current
+  39.   -16.      45.    -18.   00 nostrpond noice IND_Mozambique_Current
+  27.   -32.1     40.    -32.   06 nostrpond noice IND_Agulhas_Current_32S
+zsigi
+ 0.
+26.5
+26.75
+27.
+27.4
+50.0 
+  43.25   12.65   43.75   12.9  00 nostrpond noice IND_Bab_El_Manded
+  41.      0.1    50.      0.   00 nostrpond noice IND_Indian_Equatorial
+  81.    -20.     81.      8.   00 nostrpond noice IND_Indian_80E
+ 115.    -30.1   109.    -30.   00 nostrpond noice IND_West_Australia
+  52.    -24.     47.    -22.   00 nostrpond noice IND_Madagascar
+  25.    -30.1   120.    -30.   00 nostrpond noice IND_Indian_30S
+-171.5    66.2  -166.0    65.7  00 okstrpond   ice ARC_Bering_Strait
+-120.     47.1   142.5    47.   00 nostrpond noice PAC_Subarctic_Gyre_47N
+-130.     43.   -122.     47.   00 nostrpond noice PAC_OffCalif1
+-122.     40.   -130.     36.   00 nostrpond noice PAC_OffCalif2
+-118.     35.   -126.     31.   00 nostrpond noice PAC_OffCalif3
+ 121.     24.   -110.6    24.   03 okstrpond noice PAC_North_Pacific_24N
+zsigi
+20.
+27.
+30.
+-137.      7.   -137.     25.   00 nostrpond noice PAC_North_Pacific_137W_NEC
+-137.     25.   -137.     37.   00 nostrpond noice PAC_North_Pacific_137W_Kuroshio
+ 132.8    33.    137.     26.   00 nostrpond noice PAC_Kuroshio
+ 175.    -20.    175.     10.   00 nostrpond noice PAC_Pacific_Equatorial_175E
+-125.    -10.   -125.     10.   00 nostrpond noice PAC_Pacific_Equatorial_125W
+ -70.    -17.1   -76.    -17.   00 nostrpond noice PAC_Peru_Current
+ 152.    -30.1   175.    -30.   00 nostrpond noice PAC_East_Australia
+ 142.5    -8.    142.5   -13.   00 nostrpond noice PAC_Torres_Strait
+ 147.     10.    147.     50.   06 nostrpond noice PAC_Pacific_147E_10N_50N
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+ 165.      0.    165.     50.   06 nostrpond noice PAC_Pacific_165E
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+ 179.9     0.    179.9    50.   06 nostrpond noice PAC_Pacific_180E
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+-140.      0.   -140.     30.   06 nostrpond noice PAC_Pacific_140W
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+-150.     40.   -150.     60.5  00 nostrpond noice PAC_Alaskan_Gyre
+ 161.     55.   -162.     55.5  00 nostrpond noice PAC_Bering_Sea
+ 137.      0.    137.     36.   00 nostrpond noice PAC_JMA_137E_0N_35N
+ 150.    -30.    -70.    -30.   00 nostrpond noice PAC_Pacific_30S
+   0.     38.75    0.     35.36 00 nostrpond noice MED_0E
+   0.     38.75    1.37   39.   00 nostrpond noice MED_Ibiza_Channel
+   9.     36.8     9.     39.37 00 nostrpond noice MED_Sardinia_Channel
+   9.3    42.5    11.68   42.5  00 nostrpond noice MED_Corsica_Channel
+  10.5    36.6    12.9    37.85 00 nostrpond noice MED_Sicily_Strait
+  18.3    40.1    20.07   40.   00 nostrpond noice MED_Otranto_Strait
+  25.     31.5    25.     35.05 00 nostrpond noice MED_Cretan_Passage
+  28.     30.8    28.     37.32 00 nostrpond noice MED_Rhodes_Gyre
+  25.5    35.1    28.6    37.07 00 nostrpond noice MED_Kassos_Strait
+  33.4    35.     33.4    36.36 00 nostrpond noice MED_Cilician_Channel
+  22.9    36.8    23.85   35.42 00 nostrpond noice MED_Kytheron_Strait
+  10.08   60.     10.08,  56.   00 nostrpond noice BAL_WesternBaltic
+  10.     57.     13.     57.   00 nostrpond noice BAL_Kattegat
+  14.     57.     14.     53.   00 nostrpond noice BAL_Skagerrak
+ -53.5    47.     -43.    47.   00 nostrpond noice ATL_FlemishCap
+ -40.    -11.     20.    -11.1  03 okstrpond noice ATL_11S
+zsigi
+0.0
+28.12
+60.0
+  25.    -32.    120.    -32.   00 okstrpond noice IND_Indian_32S
+ 150.    -32.    -70.    -32.   00 okstrpond noice PAC_Pacific_32S
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist	(revision 8732)
@@ -0,0 +1,8 @@
+&namdct
+!----------------------------------------!
+!nsecdebug =-1 (debug all section        !
+!          = 0 (no section to debug)     !
+!          = n (debug section # n        !
+!----------------------------------------!
+nsecdebug= 1
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90	(revision 8732)
@@ -0,0 +1,692 @@
+MODULE compute_sections
+   !!=====================================================================
+   !!                       ***  MODULE  diadct  ***
+   !! Ocean diagnostics: Compute the transport through a section
+   !!
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !!
+   !!===============================================================
+   !! * Modules used
+   USE declarations 
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC compsec
+   
+   !! * Module variables
+ 
+CONTAINS
+
+  SUBROUTINE compsec(jsec,sec,lkdebug)         
+     !!---------------------------------------------------------------------
+     !!                     ***  ROUTINE compsec  ***
+     !!
+     !!  ** Purpose : Compute the series of mesh points that represent the section
+     !!               defined by its extremities.
+     !!
+     !!  ** Method  : 
+     !!          I.   Find which cells of the mesh the section is crossing
+     !!          II.  Classification of the intersections mesh/section
+     !!                  -first  classification west to east          
+     !!                  -second classification south to north 
+     !!          III. Find extremities of section in the mesh
+     !!          IV.  Find the series of mesh points that form the section
+     !!  ** Input: sec : the section to compute
+     !!
+     !!  ** Output:
+     !!---------------------------------------------------------------------
+     !! * Arguments
+     INTEGER,INTENT(IN)           :: jsec    ! number of the section
+     TYPE(SECTION), INTENT(INOUT) :: sec     ! information about the section
+     LOGICAL ,INTENT(IN)          :: lkdebug ! debug or not debug this section
+
+     !! * Local variables
+     INTEGER :: &
+        ji,jj            ,     & ! dummy loop argument
+        jseg             ,     & ! loop on segments that form the section    
+        nb_inmesh        ,     & ! number of intersections between the section and the mesh
+        nmesh                    ! number of cells in processor domain
+     INTEGER :: itest , jtest    ! dummy integer
+     REAL(wp)      :: &
+        zdistEst   , zdistNorth , zdistWest , zdistSouth ,  &! temporary scalars
+        zdistEst2  , zdistNorth2, zdistWest2, zdistSouth2,  &! temporary scalars
+        zdistEst3  , zdistNorth3, zdistWest3, zdistSouth3,  &! temporary scalars
+        zdistFirst , zdistLast  , zdistref  ,               &! temporary scalars
+        zdistante  , zdistante2 , zdistnew  , zdistnew2  ,  &! temporary scalars
+        zdeltai    , zdeltaj                                 ! temporary scalars
+     LOGICAL :: & 
+        ll_overlap_sec_left = .FALSE. , ll_overlap_sec_right = .FALSE. ,&! temporary logical
+        ll_date_domain_left = .FALSE. , ll_date_domain_right = .FALSE. ,&! temporary logical
+        ll_overlap_sec      = .FALSE. , ll_date_domain       = .FALSE. ,&! temporary logical
+        ll_test             = .FALSE.                                    ! temporary logical
+     LOGICAL :: lest, lwest, lnorth, lsouth
+     LOGICAL :: l_oldmethod
+     CHARACTER(len=120) :: cltmp
+     TYPE(COORD_SECTION) :: &
+        coord_a   , coord_b  , coord_d ,  coord_t ,               &!temporary point (long/lat)
+        coordFirst, coordLast, coordTemp                           !        "
+     TYPE(COORD_SECTION), DIMENSION(nb_point_max) :: coordSec      !intersections mesh/section    
+     TYPE(POINT_SECTION) :: &
+        endingPoint, prevPoint , nextPoint,           &!temporary point (I/J)
+        SouthPoint , NorthPoint, EstPoint , WestPoint  !        "
+     !!---------------------------------------------------------------------
+     IF( jsec==1 )THEN
+          PRINT*,'                '
+          PRINT*,'COMPUTE SECTIONS'
+          PRINT*,'----------------'
+     ENDIF
+
+     !debug
+     CALL write_debug(jsec,'compute section:')
+     CALL write_debug(jsec,'================')
+
+
+     !==================!
+     !0. Initializations!
+     !==================! 
+     
+     nmesh       = jpi*jpj          ! number of cells in processor domain
+     nb_inmesh   = 0                ! initialize number of intersections between section and the mesh
+     zdistEst  =0. ; zdistNorth=0. ; zdistWest=0. ; zdistSouth=0.   ! temporary scalars
+     zdistFirst=0. ; zdistLast =0.                                  ! temporary scalars
+     zdistante =0. ; zdistante2=0. ; zdistnew=0.  ; zdistnew2=0.    ! temporary scalars
+     zdeltai=0.    ; zdeltaj=0. 
+     coord_a     = COORD_SECTION( 0., 0. ) ; coord_b    = COORD_SECTION( 0., 0. )
+     coord_d     = COORD_SECTION( 0., 0. ) ; coord_t    = COORD_SECTION( 0., 0. ) 
+     coordFirst  = COORD_SECTION( 0., 0. ) ; coordLast  = COORD_SECTION( 0., 0. )
+     coordTemp   = COORD_SECTION( 0., 0. ) ; coordSec   = COORD_SECTION( 0., 0. )
+     endingPoint = POINT_SECTION( -1, -1 ) 
+     prevPoint   = POINT_SECTION( -1, -1 ) ; nextPoint   = POINT_SECTION( -1, -1 )
+     SouthPoint  = POINT_SECTION( -1, -1 ) ; NorthPoint  = POINT_SECTION( -1, -1 )
+     EstPoint    = POINT_SECTION( -1, -1 ) ; WestPoint   = POINT_SECTION( -1, -1 )
+
+     !===========================================================!    
+     !I. Find which cells of the mesh the section is  crossing  !
+     !===========================================================!
+
+     !loop on the mesh 
+     DO jj=2,jpj
+        DO ji=2,jpi
+           !-----------------------------------------------------------
+           !For each cell of the mesh, we find the intersection between 
+           !the section and the cell as described below:
+           !The cell is defined by 4 points A B C D 
+           !and the section by S1 and S2 
+           !
+           !Section\    ________
+           !        \ B|        |
+           !         \ |        |
+           !          \|one cell|
+           !      .....\        |
+           !           |\       |
+           !           | \      | 
+           !          A|__\_____|D
+           !       ........\
+           !----------------\-------------------------------------------
+
+           !definition of points A,B,D (we don't need C) 
+           coord_a = COORD_SECTION( glamf(ji-1,jj-1) ,gphif(ji-1,jj-1) )
+           coord_b = COORD_SECTION( glamf(ji-1,jj)   ,gphif(ji-1,jj)   )
+           coord_d = COORD_SECTION( glamf(ji,jj-1)   ,gphif(ji,jj-1)   )
+ 
+           !size of the cell 
+           zdeltai= glamf(ji-1,jj) - glamf(ji-1,jj-1) !zdeltai=[AB]
+           zdeltaj= gphif(ji,jj-1) - gphif(ji-1,jj-1) !zdeltaj=[AD]
+           
+           !intersection section/[AB]=?
+           coordTemp     = intersec(sec,coord_a,coord_b)     !compute intersection 
+ 
+           IF( coordTemp%lon .NE. -9999 )THEN
+              IF( nb_inmesh+1 .GT. nb_point_max )THEN
+                 PRINT*,"WARNING diadct: nb_point_max needs to be greater than ", nb_inmesh
+              ELSE    
+                 nb_inmesh=nb_inmesh+1              
+                 coordSec(nb_inmesh) = coordTemp    !store the intersection's coordinates
+
+                 !We need to know if the section crosses the overlapping band.
+
+                 !Fist we look if there is an intersection mesh/section 
+                 !just on the left of the overlapping band: 
+                 IF( coordTemp%lon .GT. glamf(1,1)-5  .AND. coordTemp%lon .LT. glamf(1,1) ) & 
+                    & ll_overlap_sec_left  = .TRUE.
+                 !And we look if there is an intersection mesh/section 
+                 !just on the right of the overlapping band:
+                 IF( coordTemp%lon .GT. glamf(jpi,1) .AND. coordTemp%lon .LT. glamf(1,1)+5 ) &
+                    & ll_overlap_sec_right = .TRUE.
+              ENDIF
+           ENDIF
+              
+           !intersection section/[AD]=?
+           coordTemp=intersec(sec,coord_a,coord_d)       !compute intersection
+           coordTemp%lon = coordTemp%lon !* zmask(ji,jj)-9999.*(1-zmask(ji,jj))
+           coordTemp%lat = coordTemp%lat !* zmask(ji,jj)-9999.*(1-zmask(ji,jj))
+
+           IF( coordTemp%lon .NE. -9999 )THEN
+              IF( nb_inmesh+1 .GT. nb_point_max )THEN
+                 PRINT*, "WARNING diadct: nb_point_max needs to be greater than ", nb_inmesh
+              ELSE  
+                 nb_inmesh=nb_inmesh+1
+                 coordSec(nb_inmesh)=coordTemp
+                   
+                 !We need to know if the section crosses the overlapping band:
+                 !same test as above 
+                 IF( coordTemp%lon .GE. glamf(1,1)-3  .AND. coordTemp%lon .LE. glamf(1,1) ) &
+                      & ll_overlap_sec_left  = .TRUE.
+                 IF( coordTemp%lon .GE. glamf(jpi,1) .AND. coordTemp%lon .LE. glamf(jpi,1)+3) & 
+                      & ll_overlap_sec_right = .TRUE. 
+              ENDIF
+           ENDIF
+         
+           !We need to know if the domain crosses the date line:
+           !Fist, we search a mesh point that is just one the left of date line:
+           IF( glamf(ji-1,jj-1) .GT.  175 .AND. glamf(ji-1,jj-1) .LT.  180 ) &
+              & ll_date_domain_left = .TRUE.
+           !And we search a mesh point that is just one the right of date line:
+           IF( glamf(ji-1,jj-1) .GT. -180 .AND. glamf(ji-1,jj-1) .LT. -175 ) &  
+              & ll_date_domain_right = .TRUE.
+ 
+        ENDDO
+     ENDDO !End of the loop on the mesh
+
+ 
+     !Crossing section/overlapping band (we need to know it for later):
+     !----------------------------------------------------------------- 
+     !If there is one intersection mesh/section just on the left of
+     !the overlapping band (ll_overlap_sec_left  = .TRUE.)
+     !AND there is one just the right of the overlapping band 
+     !(ll_overlap_sec_right  = .TRUE.),
+     !so the section crosses the overlapping band.
+     ll_overlap_sec = ll_overlap_sec_left .AND. ll_overlap_sec_right 
+
+     !Crossing of the domain and the date line (we need to know it for later): 
+     !------------------------------------------------------------------------
+     !If there is one point of the domain that is just on the left of the date line
+     !(ll_date_domain_left = .TRUE.) AND one point that is just on the right of the
+     !date line (ll_date_domain_right = .TRUE. ) 
+     !So the domain crosses the date line:
+     ll_date_domain = ll_date_domain_left .AND. ll_date_domain_right
+
+     !=====================================================!
+     ! II. Classification of the intersections mesh/section!
+     !=====================================================!
+
+     !   -first classification  west to east          
+     !   -second classification south to north        
+     !CAUTION: routine qcksrt doesn't work in the same way if the section
+     !and the domain crosse the date line (sec%ll_date_line=T and ll_date_domain=T)
+
+     IF( sec%ll_date_line .AND. ll_date_domain )THEN
+
+        !we add 360° to negative longitudes to have a good classification
+        DO jseg=1,nb_inmesh
+           IF( coordSec(jseg)%lon .LT. 0 ) coordSec(jseg)%lon=coordSec(jseg)%lon+360.
+        ENDDO
+        IF( sec%coordSec(1)%lon .NE. sec%coordSec(2)%lon ) THEN
+           CALL qcksrt(coordSec(:)%lon,coordSec(:)%lat,nb_inmesh)
+        ELSE
+           CALL qcksrt(coordSec(:)%lat,coordSec(:)%lon,nb_inmesh)
+        ENDIF
+        DO jseg=1,nb_inmesh
+           IF( coordSec(jseg)%lon .GT. 180 ) coordSec(jseg)%lon=coordSec(jseg)%lon-360.
+        ENDDO
+
+     ELSE     
+
+        IF( sec%coordSec(1)%lon .NE. sec%coordSec(2)%lon )THEN
+           CALL qcksrt(coordSec(:)%lon,coordSec(:)%lat,nb_inmesh)
+        ELSE
+           CALL qcksrt(coordSec(:)%lat,coordSec(:)%lon,nb_inmesh)
+        ENDIF
+
+     ENDIF
+
+     !debug
+     WRITE(cltmp,'(A20,i3.3)')'number intersections = ',nb_inmesh ; CALL write_debug(jsec,cltmp)
+     CALL write_debug(jsec,'List of intersections between grid and section: ')
+     DO jseg=1,nb_inmesh
+        WRITE(cltmp,'(i4.4,1X,2(f8.3,1X) )')jseg,coordSec(jseg) ;  CALL write_debug(jsec,cltmp)
+     ENDDO
+ 
+     !=====================================================!
+     ! III. Find extremities of section in the mesh        !
+     !=====================================================!
+     !we can find section's extremities in the mesh only if
+     !there is intersection between section and mesh (nb_inmesh .ne. 0)
+
+     IF( nb_inmesh .ne. 0 )THEN
+        coordFirst       = coordSec(1)
+        coordLast        = coordSec(nb_inmesh) 
+        sec%nb_point     = nb_inmesh
+        sec%listPoint(1) = POINT_SECTION(-1,-1)
+        zdistante        = 1000.
+        zdistante2       = 1000.
+
+        !First, we find the point of the mesh that is the closest 
+        !to the first intersection section/mesh (=coordFirst=coordSec(1)):
+        !this point will be called sec%listPoint(1).
+        !Then, we find the point of the mesh that is the closest
+        !to the last intersection section/mesh (coordLast=coordSec(nb_inmesh))
+        !this point will be called endingPoint.
+
+        DO jj=1,jpj
+           DO ji=1,jpi  
+              coord_t=COORD_SECTION(glamf(ji,jj),gphif(ji,jj))
+              zdistFirst = distance2(coord_t,coordFirst)
+              zdistLast = distance2(coord_t,coordLast)
+              IF( zdistFirst .LT. zdistante )THEN
+                 sec%listPoint(1) = POINT_SECTION(ji,jj)
+                 zdistante=zdistFirst
+              ENDIF
+              IF( zdistLast .LT. zdistante2 )THEN
+                 endingPoint = POINT_SECTION(ji,jj)
+                 zdistante2=zdistLast
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( sec%listPoint(1)%I == endingPoint%I .AND. sec%listPoint(1)%J == endingPoint%J )THEN
+           sec%listPoint(1) = POINT_SECTION(-1,-1)
+           endingPoint      = POINT_SECTION(-1,-1)
+           coordFirst       = coordSec(1)
+           coordLast        = coordSec(2)
+           sec%nb_point     = 0
+        ENDIF
+
+     ELSE
+        !If there is no intersection section/mesh
+        sec%listPoint(1) = POINT_SECTION(-1,-1)
+        endingPoint      = POINT_SECTION(-1,-1)
+        coordFirst       = coordSec(1)
+        coordLast        = coordSec(2)
+        sec%nb_point     = 0
+     ENDIF 
+
+     !debug
+     CALL write_debug(jsec,"extremities of section in the grid : ")
+     ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J
+     IF( sec%nb_point .ne. 0 )THEN
+        ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J
+        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'First point: ',sec%listPoint(1),glamf(ji,jj),gphif(ji,jj) 
+        CALL write_debug(jsec,cltmp)
+        ji=endingPoint%I ; jj=endingPoint%J
+        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'Last  point: ',endingPoint,glamf(ji,jj),gphif(ji,jj)
+        CALL write_debug(jsec,cltmp)
+        !
+        coord_a=pointToCoordF(sec%listPoint(1)) ; coord_b=pointToCoordF(endingPoint)
+        ll_test = .FALSE.
+        IF ( ll_date_domain .AND. ABS( coord_a%lon - coord_b%lon ).GT. 180) ll_test= .TRUE.
+        zdistante=distance2(coord_a,coord_b ,ll_test )
+        WRITE(cltmp,'(A20,f10.3)' )'distance between IJ-extremities : ',zdistante
+        CALL write_debug(jsec,cltmp)
+        !
+        CALL write_debug(jsec,"Initial extremities : ") 
+        WRITE(cltmp,'( 2(f9.3),A3,2(f9.3) )')coordFirst,'---',coordLast
+        CALL write_debug(jsec,cltmp)
+        ll_test = .FALSE.
+        IF( ll_date_domain .AND. ABS(coordFirst%lon - coordLast%lon).GT. 180)ll_test= .TRUE.
+        zdistante=distance2(coordFirst,coordLast,ll_test)
+        WRITE(cltmp,'(A30,f10.3)')' distance between initial extremities : ',zdistante
+        CALL write_debug(jsec,cltmp)
+        CALL write_debug(jsec,"                  ")
+     ELSE
+        WRITE(cltmp,'(A50)' )"no intersection between section and mesh"
+     ENDIF
+
+     !==========================================================!
+     ! IV. Find the series of mesh points that form the section !
+     !==========================================================!
+     CALL write_debug(jsec,"Find the serie of mesh's points that form the section")
+
+     IF( sec%nb_point .ne. 0 )THEN
+
+        !The series of mesh points that form the section will 'link' 
+        !sec%listPoint(1) to endingPoint: it will be stored in 
+        !sec%listPoint(jseg)
+        !
+        !We take place on the first point (sec%listPoint(1)) 
+        ! a.  We find the 4 adjacent points (North, South, East, West)
+        ! b.  Compute distance between current point and endingPoint
+        ! c.  Compute distance between the 4 adjacent points and endingPoint
+        ! d.  Select the points which are closer to end-point than current point
+        ! e.1 If at least one point is selected, select the point which is closest to original section among selected points 
+        ! e.2 If no point is selected, select the point which is the closest to end-point 
+        ! f. save next point and direction of velocity.
+        ! g. Save nextPoint and go to nextPoint
+        !
+        !We get out of this loop if:
+        !    - we are on endingPoint
+        !    - the number of points (jseg) that link sec%listPoint(1) to endingPoint is 
+        !      twice greater than number of section/mesh intersection (nb_inmesh):
+        !      it could be possible if thr algorithm can't link endingPoint (bug).
+
+        !initialize distnew value (with distance between section's extremities) 
+        zdistnew  = distance2(coordFirst,coordLast,sec%ll_date_line) 
+        prevPoint  = POINT_SECTION(0,0)
+        jseg       = 1
+
+        DO WHILE ( (  sec%listPoint(jseg)%I .NE.  endingPoint%I    &
+                 .OR. sec%listPoint(jseg)%J .NE. endingPoint%J   ) &
+                 .AND. jseg .LT. nb_inmesh + 10 .AND. sec%listPoint(jseg)%I .GT. 0  )         
+   
+           ! a. find the 4 adjacent points (North, South, East, West)
+           !---------------------------------------------------------
+           SouthPoint = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J-1)
+           NorthPoint = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
+           WestPoint  = POINT_SECTION(sec%listPoint(jseg)%I-1,sec%listPoint(jseg)%J)
+           EstPoint   = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
+
+           !debug
+           CALL write_debug(jsec,"---------------")
+           WRITE(cltmp,100)'Current points: ',sec%listPoint(jseg), & 
+                         glamf(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J), &
+                         gphif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)
+           CALL write_debug(jsec,cltmp)
+           CALL write_debug(jsec,"E/W/N/S points")
+           WRITE(cltmp,102)EstPoint,WestPoint,NorthPoint,SouthPoint
+           CALL write_debug(jsec,cltmp)
+           itest=MIN(MAX(EstPoint%I,0),jpi+1) ; jtest=MIN(MAX(EstPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'Est',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"Est point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(WestPoint%I,0),jpi+1) ; jtest=MIN(MAX(WestPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'West',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"West point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(NorthPoint%I,0),jpi+1) ; jtest=MIN(MAX(NorthPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'North',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"North point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(SouthPoint%I,0),jpi+1) ; jtest=MIN(MAX(SouthPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'South',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"South point out of domain")
+           ENDIF
+           !
+           !
+100 FORMAT ( A15,2(i4.4," "),2(f8.3," ") )
+101 FORMAT ( A6,2(f7.3," "))
+102 FORMAT ( "E ",i4.4,' ',i4.4,"//W ",i4.4,' ',i4.4,"//N ",i4.4,' ',i4.4,"//S ",i4.4,' ',i4.4 )
+
+               
+           !Either we are at an end-point
+           !--------------------
+           IF(      SouthPoint%I==endingPoint%I .AND. SouthPoint%J==endingPoint%J )THEN 
+               sec%direction(jseg)=2 ; jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint
+           ELSE IF( NorthPoint%I==endingPoint%I .AND. NorthPoint%J==endingPoint%J )THEN
+               sec%direction(jseg)=3 ; jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint
+           ELSE IF(  WestPoint%I==endingPoint%I .AND.  WestPoint%J==endingPoint%J )THEN
+               sec%direction(jseg)=0 ; jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint
+           ELSE IF(   EstPoint%I==endingPoint%I .AND.   EstPoint%J==endingPoint%J )THEN
+               sec%direction(jseg)=1 ; jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint
+
+           ELSE
+           !Else we are NOT on end-point
+           !------------------------
+
+              ! b. distance between current point and endingPoint
+              !--------------------------------------------------
+              zdistante = zdistnew
+
+              ! c. compute distance between the 4 adjacent points and endingPoint
+              !------------------------------------------------------------------
+              ! BE CAREFUL! When the domain crosses the date line (ll_date_domain):
+              !
+              ! When we will compute distances between W/E/S/N points and endingPoint,
+              ! we have to check if theses 4 lines crosses the date line
+              ! (test: ABS(coordTemp%lon - coordLast%lon).GT. 180)
+              !
+              ! If one of these lines crosses the date line, we have to add 360° 
+              ! to the longitudes of the extremities to compute the distance through
+              ! the date line and not around the Earth.
+       
+              ! c.1 compute distWest: distance between west point and endingPoint
+              !----------------------
+              zdistWest2 = 99999999.9 ;  zdistWest3 = 99999999.9 
+              IF( sec%listPoint(jseg)%I .NE. 1 )THEN
+                 !When we are on the west side of the mesh (i=1),we can't go to the west.
+                 coordTemp = pointToCoordF(WestPoint) 
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test = .TRUE.
+                 zdistWest2  = distance2(pointToCoordF(WestPoint) ,coordLast ,ll_test)
+              ENDIF
+
+              ! c.2 compute distEst: distance between east point and endingPoint
+              !---------------------
+              zdistEst2 = 99999999.9 ;  zdistEst3 = 99999999.9
+              IF( sec%listPoint(jseg)%I .EQ. jpi )THEN
+                 !We test if the current point is on the east side of the mesh
+                 ! The method is done such that we go toward east to link
+                 ! sec%listPoint(1) to endingPoint.
+                 ! So, if the section crosses the overlapping band (ll_overlap_sec=T),
+                 ! we won't have to stop if the current point is on the EAST side of the mesh:
+                 ! we have to follow the construction of the section on the
+                 ! WEST side of the mesh
+                 IF( ll_overlap_sec  )THEN
+                    !section crosses the overlapping band 
+                    !So EastPoint is on the west side of the mesh
+                    EstPoint = POINT_SECTION(3,sec%listPoint(jseg)%J)
+                    zdistEst2= distance2(pointToCoordF(EstPoint)  ,coordLast ,.FALSE.)
+                 ENDIF 
+              ELSE
+                 coordTemp = pointToCoordF(EstPoint) 
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                 zdistEst2 = distance2(pointToCoordF(EstPoint)  ,coordLast ,ll_test )
+              ENDIF
+
+              ! c.3 compute distSouth: distance between south point and endingPoint
+              !-----------------------
+              zdistSouth2 = 99999999.9 ; zdistSouth3 = 99999999.9
+              IF( sec%listPoint(jseg)%J .NE. 1 )THEN
+                 !When we are on the south side of the mesh (j=1),we can't go to the south. 
+                 coordTemp=pointToCoordF(SouthPoint)
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                    zdistSouth2 = distance2(pointToCoordF(SouthPoint),coordlast ,ll_test )
+              ENDIF
+
+              ! c.4 compute distNorth: distance between north and endingPoint
+              !-----------------------
+              zdistNorth2 = 99999999.9 ; zdistNorth3 = 99999999.9 
+              IF( sec%listPoint(jseg)%J .NE. jpj )THEN
+                 !When we are on the north side of the mesh (j=jpj),we can't go to the south. 
+                 coordTemp=pointToCoordF(NorthPoint)
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                 zdistNorth2 = distance2(pointToCoordF(NorthPoint),coordlast ,ll_test )
+              ENDIF
+
+              ! d. select the points which are closer to end-point than current point
+              !----------------------------------------------------------------------
+              zdistref=distance2(pointToCoordF(sec%listPoint(jseg)),coordlast ,ll_test )
+              WRITE(cltmp,'( A56,f10.3 )' )'distance between actual point and last point: zdistref = ',zdistref
+              CALL write_debug(jsec,cltmp)
+              lest   = .FALSE. ; IF( zdistEst2   .LE. zdistref ) lest  = .TRUE.
+              lwest  = .FALSE. ; IF( zdistwest2  .LE. zdistref ) lwest = .TRUE.
+              lnorth = .FALSE. ; IF( zdistnorth2 .LE. zdistref ) lnorth= .TRUE.
+              lsouth = .FALSE. ; IF( zdistsouth2 .LE. zdistref ) lsouth= .TRUE.
+
+              !debug
+              IF( .NOT. lest   )CALL write_debug(jsec,'Est   point eliminated')
+              IF( .NOT. lwest  )CALL write_debug(jsec,'West  point eliminated')
+              IF( .NOT. lnorth )CALL write_debug(jsec,'North point eliminated')
+              IF( .NOT. lsouth )CALL write_debug(jsec,'South point eliminated')
+
+              l_oldmethod = .FALSE.
+
+              IF( ( COUNT((/lest/))+COUNT((/lwest/))+COUNT((/lnorth/))+COUNT((/lsouth/)) ) .NE. 0 )THEN
+
+                 ! e.1 If at least one point is selected, select the point 
+                 !     which is the closest to original section among selected points 
+                 !-------------------------------------------------------------------
+
+                 zdistWest3  = 9999999.9
+                 IF( lwest )zdistWest3  = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(WestPoint) ,pointToCoordF(endingPoint) ,lkdebug )
+                 zdistEst3   = 9999999.9
+                 IF( lest )zdistEst3   =  &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(EstPoint)  ,pointToCoordF(endingPoint) ,lkdebug )
+                 zdistSouth3 = 9999999.9
+                 IF( lsouth )zdistSouth3 = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(SouthPoint),pointToCoordF(endingPoint) ,lkdebug )
+                 zdistNorth3 = 9999999.9
+                 IF( lnorth )zdistNorth3 = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(NorthPoint),pointToCoordF(endingPoint) ,lkdebug )
+
+                 zdistEst3   = zdistEst3   + (1-COUNT((/lest/))  )*9999999.9
+                 zdistWest3  = zdistWest3  + (1-COUNT((/lwest/)) )*9999999.9
+                 zdistNorth3 = zdistNorth3 + (1-COUNT((/lnorth/)))*9999999.9
+                 zdistSouth3 = zdistSouth3 + (1-COUNT((/lsouth/)))*9999999.9
+
+                 zdistnew = MIN(zdistEst3,zdistWest3,zdistnorth3,zdistSouth3)
+
+              ELSE 
+
+                 ! e.2 If no point is selected, select the point which is the closest to end-point 
+                 !--------------------------------------------------------------------------------
+                 l_oldmethod = .TRUE.
+
+                 !debug
+                 WRITE(cltmp,'(A30,i3.3)' )'SEARCH NEW POINT WITH OLD METHOD: ',jsec
+                 CALL write_debug(jsec,cltmp)
+                   
+                 !be careful! we can't go backward.
+                 zdistNorth = zdistNorth2    ; zdistSouth = zdistSouth2
+                 zdistEst   = zdistEst2      ; zdistWest  = zdistWest2 
+
+                 IF(     prevPoint%I .EQ. NorthPoint%I .AND. prevPoint%J .EQ. NorthPoint%J) THEN
+                     zdistnew = MIN(zdistEst,zdistWest,zdistSouth)
+                 ELSE IF(prevPoint%I .EQ. SouthPoint%I .AND. prevPoint%J .EQ. SouthPoint%J) THEN
+                    zdistnew = MIN(zdistEst,zdistWest,zdistNorth)
+                 ELSE IF(prevPoint%I .EQ. WestPoint%I  .AND. prevPoint%J .EQ. WestPoint%J ) THEN
+                    zdistnew = MIN(zdistEst,zdistNorth,zdistSouth)
+                 ELSE IF(prevPoint%I .EQ. EstPoint%I   .AND. prevPoint%J .EQ. EstPoint%J  ) THEN
+                    zdistnew = MIN(zdistWest,zdistNorth,zdistSouth)
+                 ELSE 
+                    zdistnew = MIN(zdistEst,zdistWest,zdistNorth,zdistSouth)
+                 ENDIF              
+
+              ENDIF
+
+              !debug
+              WRITE(cltmp,'(A11, f8.3)')'zdistref = ',zdistref
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp, 103         )'distance2 :',zdistEst2,zdistWest2,zdistNorth2,zdistSouth2 
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp, 103         )'distance3 :',zdistEst3,zdistWest3,zdistNorth3,zdistSouth3
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp,'(A11, f8.3)')"zdistnew = ",zdistnew
+              CALL write_debug(jsec,cltmp)
+
+103 FORMAT (A12,"E",f12.3," W",f12.3," N",f12.3," S",f12.3)
+
+              !f. save next point and direction of velocity.
+              !--------------------------------------------- 
+              !nextPoint will be the one which is the closest to endingPoint.
+              !sec%direction will be direction between current point and nextPoint:
+              !It will be used to compute velocity through the segment [CurrentPoint,nextPoint}:
+              !                 
+              !A:Current Point    NorthPoint(I,J+1)   Nextpoint=NorthPoint(I,J+1) => sec%direction=3
+              !                   |                   Nextpoint=SouthPoint(I,J-1) => sec%direction=2   
+              !                   |                   Nextpoint=WestPoint(I-1,J)  => sec%direction=0   
+              !                   |==>V(I,J+1)        Nextpoint=EastPoint(I+1,J)  => sec%direction=1
+              !            U(I,J) |       U(I+1,J)
+              !            ^      |       ^
+              !   West_____|______A_______|_____EstPoint 
+              !   Point           |(I,J)        (I+1,J)  
+              !   (I-1,J)         |               
+              !                   |==>V(I,J)
+              !                   |
+              !              SoutPoint(I,J-1)
+              IF( l_oldmethod )THEN
+                 IF( zdistnew == zdistWest )      THEN
+                      sec%direction(jseg)=0 ; nextPoint = WestPoint
+                 ELSE IF( zdistnew == zdistEst )  THEN
+                      sec%direction(jseg)=1 ; nextPoint = EstPoint
+                 ELSE IF( zdistnew == zdistSouth )THEN
+                      sec%direction(jseg)=2 ; nextPoint = SouthPoint
+                 ELSE IF( zdistnew == zdistNorth )THEN
+                      sec%direction(jseg)=3 ; nextPoint= NorthPoint
+                 ENDIF
+              ELSE 
+                 IF( zdistnew == zdistWest3 )      THEN
+                      sec%direction(jseg)=0 ; nextPoint = WestPoint
+                 ELSE IF( zdistnew == zdistEst3 )  THEN
+                      sec%direction(jseg)=1 ; nextPoint = EstPoint
+                 ELSE IF( zdistnew == zdistSouth3 )THEN
+                      sec%direction(jseg)=2 ; nextPoint = SouthPoint
+                 ELSE IF( zdistnew == zdistNorth3 )THEN
+                      sec%direction(jseg)=3 ; nextPoint= NorthPoint
+                 ENDIF 
+              ENDIF
+
+              WRITE(cltmp,'(A11, 2(i4.4,1X) )')'nextPoint = ', nextPoint
+              CALL write_debug(jsec,cltmp)
+        
+              !f. Save nextPoint and go to nextPoint
+              !-------------------------------------
+              prevPoint = sec%listPoint(jseg)
+              jseg = jseg+1                   !increment of number of segments that form the section
+              sec%listPoint(jseg) = nextPoint !Save next point
+   
+           ENDIF ! southP/northP/WestP/EstP == endingpoint ?
+
+        ENDDO                  !End of loop on jseg
+        sec%nb_point = jseg    !Save the number of segments that form the section
+
+
+     ELSE ! isec%nb_point == 0
+        DO jseg=1,nb_point_max 
+           sec%listPoint(:)=POINT_SECTION(0,0)
+        ENDDO
+        sec%direction(:)=0.
+        sec%nb_point = 0
+     ENDIF
+
+     !debug     
+     IF( sec%nb_point .ne. 0 )THEN
+        CALL write_debug(jsec,"-------------------------------------")
+        CALL write_debug(jsec,"list of points in the grid : ")
+        DO jseg=1,sec%nb_point 
+           ji=sec%listPoint(jseg)%I ; jj=sec%listPoint(jseg)%J
+           WRITE(cltmp, '(i4.4,X,i4.4,X,i4.4,X,f8.3,X,f8.3)' )jseg,ji,jj,glamf(ji,jj),gphif(ji,jj)
+           CALL write_debug(jsec,cltmp)
+        ENDDO
+    
+        !test if we are an end-point
+        IF( sec%listPoint(sec%nb_point)%I .NE. endingPoint%J .AND. sec%listPoint(sec%nb_point)%J .NE. endingPoint%J )THEN   
+           PRINT*,TRIM(sec%name)," NOT ARRIVED TO endingPoint FOR jsec =  ",jsec
+        ENDIF
+     ENDIF
+
+     !now compute new slopeSection with ij-coordinates of first and last point 
+     sec%slopeSection = 0  ! default value
+     IF( sec%nb_point .ne. 0 )THEN
+        IF (  sec%listPoint(sec%nb_point)%I .NE.  sec%listPoint(1)%I ) THEN
+           sec%slopeSection = REAL( ( sec%listPoint(sec%nb_point)%J - sec%listPoint(1)%J ) , wp )/  &
+                              REAL( ( sec%listPoint(sec%nb_point)%I - sec%listPoint(1)%I ) , wp )     
+        ELSE
+           sec%slopeSection = 10000._wp
+        ENDIF
+     ENDIF
+ 
+  END SUBROUTINE compsec
+
+END MODULE compute_sections 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90	(revision 8732)
@@ -0,0 +1,61 @@
+MODULE declarations 
+  !!----------------------------------------------------------------------------
+  !!             *** declarations global varibles 
+  !!
+  !! History: 2011: Clement Bricaud, Mercator-Ocean
+  !!
+  !!----------------------------------------------------------------------------
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! * Shared module variables 
+  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
+  INTEGER, PUBLIC, PARAMETER   :: nb_class_max  = 10            ! Max number of classes
+  INTEGER, PUBLIC, PARAMETER   :: nb_sec_max    = 150           ! Max number of sections
+  INTEGER, PUBLIC, PARAMETER   :: nb_point_max  = 2000          ! Max number of segments per section
+  INTEGER, PUBLIC, PARAMETER   :: nb_type_class = 10            ! Max number of types of classes
+  INTEGER, PUBLIC, PARAMETER   :: numnam=3                      ! Unit for namelist
+  INTEGER, PUBLIC, PARAMETER   :: numdctin=1                    ! Unit for input file
+  INTEGER, PUBLIC, PARAMETER   :: numdctout=2                   ! Unit for output file
+
+  INTEGER, PUBLIC              :: jpi,jpj                       ! domain dimensions
+  INTEGER, PUBLIC              :: nb_sec                        ! Number of sections read from input file
+  INTEGER, PUBLIC              :: nsecdebug = 0                 ! Number of the section to debug
+
+  REAL(wp), PUBLIC ,DIMENSION(:,:)  , ALLOCATABLE :: glamf,gphif,glamt,gphit,e1t
+  INTEGER,  PUBLIC ,DIMENSION(nb_sec_max)         :: num_sec_debug
+
+  TYPE POINT_SECTION
+     INTEGER :: I,J
+  END TYPE POINT_SECTION
+
+  TYPE COORD_SECTION
+     REAL(wp) :: lon,lat
+  END TYPE COORD_SECTION
+
+  TYPE SECTION
+     CHARACTER(len=60)                              :: name                ! name of the sec
+     LOGICAL                                        :: llstrpond           ! true if you want the computation of salt 
+                                                                           ! and heat transport
+     LOGICAL                                        :: ll_ice_section      ! ice surface and icevolume transport computation
+     LOGICAL                                        :: ll_date_line        ! = T if the section crosses the date-line
+     TYPE(COORD_SECTION), DIMENSION(2)              :: coordSec            ! longitude and latitude of the extremities of the section
+     INTEGER                                        :: nb_class            ! number of boundaries for density classes
+     INTEGER, DIMENSION(nb_point_max)               :: direction           ! vector direction of the point in the section
+     CHARACTER(len=40),DIMENSION(nb_class_max)      :: classname           ! characteristics of the class
+     REAL(wp), DIMENSION(nb_class_max)              :: zsigi             ,&! insitu density classes    (99 if you don't want)
+                                                       zsigp             ,&! potential density classes    (99 if you don't want)
+                                                       zsal              ,&! salinity classes   (99 if you don't want)
+                                                       ztem              ,&! temperature classes(99 if you don't want)
+                                                       zlay                ! depth level classes      (99 if you don't want)
+     REAL(wp)                                       :: slopeSection        ! slope of the section 
+     INTEGER                                        :: nb_point            ! number of points in the section
+     TYPE(POINT_SECTION),DIMENSION(nb_point_max)    :: listPoint           ! list of points in the section
+  END TYPE SECTION
+
+  TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
+
+
+
+END MODULE declarations
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 8732)
@@ -0,0 +1,114 @@
+PROGRAM generate_sections
+     !!==============================================================================
+     !!                       ***  PROGRAM generate_sections    ***
+     !!
+     !! create a binary file containig the IJ positions of sections in global 
+     !! coordinates for the diagnostic routine diadct.F90 of NEMO
+     !!
+     !!
+     !! History: 09/2011: Clement Bricaud ( Mercator-Ocean )
+     !!
+     !!==============================================================================
+     !! * Modules used
+     USE declarations
+     USE sections_tools
+     USE readcoordmesh 
+     USE readsections
+     USE compute_sections
+     USE writesections    
+
+     IMPLICIT NONE
+ 
+     !! * Module Variables used
+     INTEGER            :: iargc, narg
+     CHARACTER(LEN=80)  :: cdum
+     INTEGER            :: jsec ,&! loop on sections
+                           jseg   ! loop on segments (parts of the section)
+     CHARACTER(len=40)  :: clname
+     LOGICAL            :: llok
+
+     NAMELIST/namdct/nsecdebug
+     !!==============================================================================     
+ 
+     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+     PRINT*,'CREATION OF SECTIONS FOR NEMO diadct.F90 ROUTINE'
+     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+ 
+     !-------------------!
+     !1. Read namelist   !
+     !-------------------!
+     PRINT*,'              '
+     PRINT*,'READ NAMELIST'
+     PRINT*,'--------------'
+
+     !!open, read and close namelist
+     nsecdebug=0
+     clname='namelist'
+     CALL file_open(numnam,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
+     IF ( llok ) THEN
+          REWIND( numnam )
+          READ  ( numnam, namdct )
+          PRINT*,'  '
+          PRINT*,'read namelist'
+          IF( nsecdebug==-1      )THEN ; PRINT*,' Debug all sections'
+          ELSE IF ( nsecdebug==0 )THEN ; PRINT*,' No section to debug'
+          ELSE IF ( nsecdebug .GE. 1 .AND. nsecdebug .LE. nb_sec_max )THEN
+              PRINT*,' Debug section number ',nsecdebug
+          ELSE
+              PRINT*,'Wrong number for nsecdebug = ',nsecdebug
+          ENDIF
+     ENDIF
+     CLOSE(numnam)
+     PRINT*,'read namelist ok'
+
+     !-------------------------------------!
+     !2. Read coordinates and meshmask     !
+     !-------------------------------------!
+     CALL read_coord_mesh
+ 
+     PRINT*,'domain sizes: '
+     PRINT*,'jpi    jpj    = ',jpi   ,jpj 
+     PRINT*,'domain boundaries: '
+     PRINT*,' 1   1   ',glamt(1,1),gphit(1,1)
+     PRINT*,' 1   jpj ',glamt(1,jpj),gphit(1,jpj)
+     PRINT*,' jpi 1   ',glamt(jpi,1),gphit(jpi,1)
+     PRINT*,'jpi jpj  ',glamt(jpi,jpj),gphit(jpi,jpj)
+
+
+
+     !----------------------!
+     !3. Read list_sections !
+     !----------------------!
+     num_sec_debug(:)=0     ! Unit numbers for debug files
+     CALL read_list_sections
+
+     !----------------------!
+     !4.Compute sections    !
+     !----------------------!
+     DO jsec=1,nb_sec
+          !we use compsec to generate the series of grid points making the section
+          IF(jsec == nsecdebug .OR. nsecdebug ==-1)THEN
+             CALL compsec(jsec,secs(jsec),.true.)
+          ELSE
+             CALL compsec(jsec,secs(jsec),.false.)
+          ENDIF
+          IF (jsec == nb_sec)PRINT*,'compute section ok '
+     ENDDO
+
+     !--------------------------------!
+     !5.Write section_ijglobal.diadct !
+     !--------------------------------!
+     CALL write_sections
+
+     !----------------------! 
+     !END                   !
+     !----------------------!
+    
+     !close debug files
+     DO jsec=1,nb_sec
+        IF( num_sec_debug(jsec) .NE. 0 )CLOSE(num_sec_debug(jsec))
+     ENDDO
+
+     PRINT*,'END END END END END END END END END END END END'
+
+END PROGRAM generate_sections
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 8732)
@@ -0,0 +1,199 @@
+MODULE readcoordmesh
+  !!=====================================================================
+  !!                       ***  MODULE  readcoordmesh  ***
+  !! 
+  !! History: 2011: Clement Bricaud, Mercator-Ocean
+  !! 
+  !!=====================================================================
+  !! * Modules used
+  USE netcdf
+  USE declarations
+
+  IMPLICIT NONE
+  PRIVATE
+  
+  PUBLIC  read_coord_mesh
+
+CONTAINS
+
+  SUBROUTINE read_coord_mesh
+  !!---------------------------------------------------------------------
+  !!              ***  ROUTINE coord_mesh_read  ***
+  !!
+  !! ** Purpose :   Read a coordinate file and a meshmask file in NetCDF format 
+  !!
+  !!---------------------------------------------------------------------      
+  PRINT*,'              '
+  PRINT*,'READ COORDINATES AND MESHMASK'
+  PRINT*,'-----------------------------'
+
+  ! Get coordinates dimensions
+  CALL getdim(cdfile="coordinates.nc")
+
+  !Allocate coordinates array with domain size
+  ALLOCATE(glamt(jpi,jpj)) ; ALLOCATE(gphit(jpi,jpj))
+  ALLOCATE(glamf(jpi,jpj)) ; ALLOCATE(gphif(jpi,jpj))
+  ALLOCATE(e1t(jpi,jpj)  )   
+
+  !Read glamt
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamt",ksize=(/jpi,jpj,1,1/),ptab=glamt)
+
+  !Read gphit
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphit",ksize=(/jpi,jpj,1,1/),ptab=gphit)
+
+  !Read glamf
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamf",ksize=(/jpi,jpj,1,1/),ptab=glamf)
+
+  !Read gphif
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphif",ksize=(/jpi,jpj,1,1/),ptab=gphif)
+
+  !Read e1t
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="e1t",ksize=(/jpi,jpj,1,1/),ptab=e1t)
+
+  END SUBROUTINE read_coord_mesh
+
+  SUBROUTINE getdim(cdfile)
+  !!----------------------------------------------------------------------
+  !!              ***  ROUTINE getdim  ***
+  !!
+  !! ** Purpose :   get dimensions of a netcdf file
+  !!
+  !!----------------------------------------------------------------------
+  !! * Arguments
+  CHARACTER(*),INTENT(IN):: cdfile
+
+  !! * Local declarations
+  INTEGER           :: ncid                 ! file unit
+  INTEGER           :: idims                ! number of dimensions
+  INTEGER           :: istatus, id_var      ! dummy variable
+  CHARACTER(len=30) :: clname               ! dimension name   
+  INTEGER, ALLOCATABLE,DIMENSION(:) :: ndim ! dimension value
+  !!----------------------------------------------------------------------
+
+  !Open file
+  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
+
+  IF( istatus/= NF90_NOERR )THEN
+     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
+  ELSE
+ 
+     ! read number of dimensions   
+     istatus=NF90_INQUIRE(ncid,ndimensions=idims)
+
+     ALLOCATE( ndim(idims) )
+
+     ! read each dimension
+     PRINT*,'     File dimensions: '
+     DO id_var=1,idims
+        istatus=NF90_Inquire_Dimension(ncid,id_var,clname,ndim(id_var))
+        PRINT*,'       ',id_var,clname,ndim(id_var)
+     ENDDO
+
+     !close
+     istatus=NF90_CLOSE( ncid )              
+     IF( istatus/=NF90_NOERR )THEN 
+        PRINT*,'Problem for closing ',TRIM(cdfile);STOP
+     ELSE
+        PRINT*,'     close ',TRIM(cdfile),' OK'
+     ENDIF
+
+  ENDIF
+
+  !domain dimensions
+  jpi = ndim(1)
+  jpj = ndim(2)
+
+  DEALLOCATE( ndim )
+  END SUBROUTINE getdim
+
+  SUBROUTINE read_ncdf(cdfile,cdvar,ksize,ptab,kstart,kcount)
+  !!----------------------------------------------------------------------
+  !!              ***  ROUTINE coord_mesh_read  ***
+  !!
+  !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format
+  !!
+  !!----------------------------------------------------------------------
+  !! * Arguments
+  CHARACTER(*),        INTENT(IN)                                    :: cdfile
+  CHARACTER(*),        INTENT(IN)                                    :: cdvar
+  INTEGER,DIMENSION(4),INTENT(IN)                                    :: ksize
+  INTEGER,DIMENSION(4),INTENT(IN),OPTIONAL                           :: kstart,kcount
+  REAL(wp),DIMENSION(ksize(1),ksize(2),ksize(3),ksize(4)),INTENT(OUT):: ptab
+
+  !! * Local declarations
+  INTEGER                                 ::istatus,ncid,id_var,len
+  CHARACTER(len=30) :: clname , cdvar2
+
+  INTEGER :: idims
+  INTEGER,DIMENSION(3)::idimids 
+  !!----------------------------------------------------------------------
+  ptab=0.
+  PRINT*,'read ',TRIM(cdvar),' in ',TRIM(cdfile)
+  
+  !OPEN
+  !----
+  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
+  IF( istatus/= NF90_NOERR )THEN
+     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
+  ENDIF
+
+  !READ
+  !----
+  !search variable
+  istatus=NF90_INQ_VARID (ncid,TRIM(cdvar),id_var)
+  IF( istatus/=NF90_NOERR )THEN
+      PRINT*,TRIM(cdvar),' not found in ',TRIM(cdfile),'.stop';STOP
+  ENDIF
+
+  !get variable
+  !------------
+  istatus=nf90_inquire_variable(ncid,id_var, cdvar2, ndims=idims, dimids=idimids)
+  IF ( PRESENT(kstart) .AND. PRESENT(kcount) )THEN  
+      istatus=NF90_GET_VAR(ncid,id_var,ptab,start=kstart,count=kcount)
+  ELSE
+      istatus=NF90_GET_VAR(ncid,id_var,ptab)
+  ENDIF
+
+  CALL ERR_HDL(istatus)
+
+  IF( istatus/=NF90_NOERR )THEN
+           PRINT*,'Problem for reading ',TRIM(cdvar),' in ',TRIM(cdfile); STOP
+  ELSE
+      PRINT*,'     read ',TRIM(cdvar),' OK'
+  ENDIF
+
+  !CLOSE
+  !-----
+  istatus=NF90_CLOSE( ncid )
+  IF( istatus/=NF90_NOERR )THEN
+      PRINT*,'Problem for closing ',TRIM(cdfile);stop
+  ELSE
+      PRINT*,'     close ',TRIM(cdfile),' OK'
+  ENDIF
+
+
+  END SUBROUTINE read_ncdf
+
+  SUBROUTINE ERR_HDL(kstatus)
+  !! ----------------------------------------------------------
+  !!   ***  SUBROUTINE err_hdl
+  !!
+  !!   ** Purpose :  Error handle for NetCDF routine.
+  !!          Stop if kstatus indicates error conditions.
+  !!
+  !! History :
+  !!     Original: J.M. Molines (01/99)
+  !!
+  !! -----------------------------------------------------------
+  INTEGER, INTENT(in) ::  kstatus
+
+  !! -----------------------------------------------------------
+  IF( kstatus /=  NF90_NOERR ) THEN
+     PRINT *, 'ERROR in NETCDF routine, status=',kstatus
+     PRINT *,NF90_STRERROR(kstatus)
+     STOP
+  END IF
+
+  END SUBROUTINE ERR_HDL
+
+END MODULE readcoordmesh
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90	(revision 8732)
@@ -0,0 +1,200 @@
+MODULE readsections 
+   !!=====================================================================
+   !!                       ***  MODULE  readsections  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations   
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC read_list_sections 
+ 
+CONTAINS
+
+  SUBROUTINE read_list_sections
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE read_list_sections ***
+     !!
+     !! ** Purpose: read ascii file 'list_sections.ascii' that contains
+     !!             section descriptions
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+
+     !! * Local declarations
+     INTEGER             :: jsec !loop on section number
+     INTEGER             :: iost,ji
+     INTEGER             :: iclass , jclass
+     LOGICAL             :: llok,llstrpond,llice,lldate
+     REAL(wp)            :: plon1,plat1,plon2,plat2
+     REAL(wp)            :: zslope
+     CHARACTER(len=5)    :: clclass
+     CHARACTER(len=5)    :: cdice
+     CHARACTER(len=9)    :: cdstrpond
+     CHARACTER(len=110)  :: clname,cdsecname,cltmp
+     REAL,DIMENSION(nb_type_class)     :: zclass_value
+     TYPE(COORD_SECTION)               :: coord_point1,coord_point2,coordTemp
+     TYPE(COORD_SECTION), DIMENSION(2) :: coord_sec
+     !!---------------------------------------------------------------------
+     PRINT*,'              '
+     PRINT*,'READ list_sections'
+     PRINT*,'------------------'
+     PRINT*,'               '
+
+     nb_sec=0 !initialize number of sections read in list_sections.ascii
+
+     !open and read input file
+     clname='list_sections.ascii'
+     PRINT*,'               '
+     CALL file_open(numdctin,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
+
+     IF ( llok ) THEN
+          PRINT*,'list_sections.ascii open '
+           PRINT*,'nb_sec_max = ',nb_sec_max
+          PRINT*,'                         '
+     
+          DO jsec=1,nb_sec_max
+
+                 !read a line corresponding to one section
+                 READ(numdctin,'(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)',iostat=iost) & 
+                 &    plon1,plat1,plon2,plat2,iclass,cdstrpond,cdice,cdsecname
+                 IF (iost /= 0) EXIT  ! end of file
+
+                 ! cdsecname: change space to underscore for cdsecname
+                 cdsecname=ADJUSTL(cdsecname)
+                 ji = SCAN(TRIM(cdsecname)," ")
+                 DO WHILE(ji .NE. 0)
+                    cdsecname(ji:ji) = "_"
+                    ji = SCAN(TRIM(cdsecname)," ")
+                 ENDDO
+
+                 !computation of heat and salt transport ?
+                 llstrpond=.FALSE. ; IF( cdstrpond .EQ. 'okstrpond' ) llstrpond=.TRUE.
+
+                 !computation of ice tranpsort ?
+                 llice=.FALSE. ; IF( cdice .EQ. 'okice' ) llice=.TRUE.
+
+                 !store coordinates of the extremities
+                 coord_point1=COORD_SECTION(plon1,plat1)
+                 coord_point2=COORD_SECTION(plon2,plat2)
+                 coord_sec=(/coord_point1,coord_point2/)
+
+                 !Extremities of the section are classed
+                 lldate=.FALSE.
+                 IF(  coord_sec(2)%lon .LT. coord_sec(1)%lon  .OR.   &
+                    ((coord_sec(2)%lon .EQ. coord_sec(1)%lon) .AND.  &
+                     (coord_sec(2)%lat .LT. coord_sec(1)%lat)) ) THEN
+                      coordTemp   =coord_sec(1)
+                      coord_sec(1)=coord_sec(2)
+                      coord_sec(2)=coordTemp
+                 ENDIF
+                 IF((coord_sec(2)%lon - coord_sec(1)%lon) .GT. 180) THEN
+                      coordTemp   =coord_sec(1)
+                      coord_sec(1)=coord_sec(2)
+                      coord_sec(2)=coordTemp
+                      lldate=.TRUE.
+                 ENDIF
+
+                 !slope of the section (equidistant cylindric projection)
+                 zslope=slope_coeff(coord_sec(1),coord_sec(2),lldate)
+
+                 !!initialise global array secs
+                 secs(jsec)%llstrpond=.FALSE.  
+                 secs(jsec)%ll_date_line=.FALSE. ; secs(jsec)%nb_class=0
+                 secs(jsec)%zsigi=99.            ; secs(jsec)%zsigp=99.
+                 secs(jsec)%zsal=99.             ; secs(jsec)%ztem=99.
+                 secs(jsec)%zlay=99.
+                 secs(jsec)%nb_point=0
+
+                 !store all information in global array secs
+                 secs(jsec)%name           = cdsecname
+                 secs(jsec)%llstrpond      = llstrpond
+                 secs(jsec)%ll_ice_section = llice
+                 secs(jsec)%coordSec       = (/ coord_sec(1) , coord_sec(2) /)
+                 secs(jsec)%slopeSection   = zslope
+                 secs(jsec)%ll_date_line   = lldate
+
+                 !debug information
+                 CALL write_debug(jsec,'Informations read in ascii file:')
+                 CALL write_debug(jsec,'--------------------------------')
+                 CALL write_debug(jsec,'section name: '//secs(jsec)%name )
+                 IF( secs(jsec)%llstrpond )THEN ; CALL write_debug(jsec,'salt/heat transport computing' )
+                 ELSE                           ; CALL write_debug(jsec,'no salt/heat transport computing' )
+                 ENDIF
+                 IF( secs(jsec)%ll_ice_section )THEN ; CALL write_debug(jsec,'Ice transport computing' )
+                 ELSE                                ; CALL write_debug(jsec,'no Ice transport computing' )
+                 ENDIF
+                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 1 :',secs(jsec)%coordSec(1)
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 2 :',secs(jsec)%coordSec(2)
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,f8.3)')'Slope coefficient :',secs(jsec)%slopeSection
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,i3.3)')'number of classes : ',iclass
+                 CALL write_debug(jsec,cltmp)
+                 IF( secs(jsec)%ll_date_line ) THEN ;  CALL write_debug(jsec,'section crosses date line')
+                 ELSE                                ; CALL write_debug(jsec,'section don t crosse date line')
+                 ENDIF
+                 CALL write_debug(jsec,'                        ')
+
+                 !verify number of sections and store it
+                 IF ( iclass .GT. nb_class_max) THEN
+                     PRINT*,"WARNING:  nb_class_max needs to be greater than ", iclass ; STOP
+                 ENDIF
+                 secs(jsec)%nb_class=iclass
+
+                 !read classes
+                 IF ( iclass .NE. 0 )THEN
+
+                      !classname=zsigi/zsigp/zsal/ztem/zlay
+                      READ(numdctin,'(A5)')clclass
+                      DO jclass = 1,iclass
+                         READ(numdctin,'(F9.3)',iostat=iost) zclass_value(jclass) 
+                      ENDDO 
+                      IF      ( TRIM(clclass) .EQ. 'zsigi' )THEN
+                           secs(jsec)%zsigi(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'zsigp' )THEN
+                           secs(jsec)%zsigp(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'zsal'  )THEN
+                           secs(jsec)%zsal(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'ztem'  )THEN
+                           secs(jsec)%ztem(1:iclass)=zclass_value(1:iclass)
+                      ELSE IF ( TRIM(clclass) .EQ. 'zlay'  )THEN
+                           secs(jsec)%zlay(1:iclass)=zclass_value(1:iclass)
+                      ELSE
+                          PRINT*,'Wrong name of class for section/clclass: ', cdsecname,TRIM(clclass)
+                      ENDIF
+
+                      IF ( jsec==nsecdebug .OR. nsecdebug==-1)THEN
+                           PRINT*,'class type = ',clclass
+                           PRINT*,'class values = ',zclass_value(1:iclass)
+                      ENDIF
+
+                 ENDIF
+
+          ENDDO !end of loop on sections
+         
+          CLOSE(numdctin) !Close file
+          IF( jsec .EQ. nb_sec_max)THEN
+              PRINT*,'   '
+              PRINT*,' nb_sec_max is less than the number of sections written in list_sections.ascii'
+              STOP
+          ELSE 
+             nb_sec=jsec-1 !number of read sections
+             PRINT*,'   '
+             PRINT*,'Number of sections read in list_sections.ascii: ',nb_sec 
+             PRINT*,'Reading of list_sections.ascii ok'
+             PRINT*,'   '
+          ENDIF
+
+     ENDIF
+
+  END SUBROUTINE  read_list_sections
+
+END MODULE readsections 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90	(revision 8732)
@@ -0,0 +1,563 @@
+MODULE sections_tools
+   !!=====================================================================
+   !!                       ***  MODULE  sections_tools  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC pointToCoordF         ! define a point with geographical coordinates
+   PUBLIC distance2             ! compute distance between 2 points
+   PUBLIC distance3             ! compute distance between a point and a line
+   PUBLIC intersec              ! intersection between 2 lines
+   PUBLIC slope_coeff           ! slope coefficient of a line
+   PUBLIC qcksrt                ! organize a list of point
+   PUBLIC write_debug           ! write debug messages
+   PUBLIC file_open             ! open a file ( ascii, bin)
+ 
+CONTAINS
+
+  TYPE(COORD_SECTION) FUNCTION pointToCoordF(p)
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION pointToCoordF  ***
+     !!           
+     !! ** Purpose: define a point with geographical coordinates
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(POINT_SECTION), INTENT(IN) ::  p
+
+     !!---------------------------------------------------------------------
+
+     pointToCoordF = COORD_SECTION(glamf(p%I,p%J),gphif(p%I,p%J))
+
+     RETURN
+
+  END FUNCTION pointToCoordF
+
+  REAL(wp) FUNCTION distance2(coordA,coordB,ld_date_line)
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION distance  ***
+     !!
+     !! ** Purpose:compute distance between coordA and coordB
+     !!            We add 360 to coordB%long if the line (coordA,coordB)
+     !!            crosses the date-line.
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA,coordB
+     LOGICAL,INTENT(IN),OPTIONAL     :: ld_date_line
+
+     !! * Local declarations 
+     REAL(wp) :: zrad, zrayon
+     REAL(wp) :: zpi = 3.141592653589793
+     REAL(wp) :: zlam1, zlam2, zphi1, zphi2
+
+     !-----------------------------------------------
+     zrayon = 6367000.0
+     zrad   = zpi/180.
+     zlam1  = coordA%lon*zrad
+     zlam2  = coordB%lon*zrad
+     zphi1  = coordA%lat*zrad
+     zphi2  = coordB%lat*zrad
+     !
+     !function output
+     distance2=0.001*2.*zrayon *ASIN(SQRT(SIN((zphi2-zphi1)/2.0)**2.0+COS(zphi1)*COS(zphi2)*SIN((zlam2-zlam1)/2.0)**2.0) )
+     !
+     RETURN
+  END FUNCTION distance2
+
+  REAL(wp) FUNCTION distance3(coordA,coordB,coordC,ll_debug) 
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION cosinus  ***
+     !!
+     !! ** Purpose: compute distance between a point B and a line (AC)
+     !!
+     !! ** Methode: use Al-Kashi theorem
+     !!
+     !!              B                   A first point of the section
+     !!             / \                  B intermediate point on the section
+     !!            / | \                 C last point of the section
+     !!           /  |  \               
+     !!          /   |   \               angle=ACB
+     !!         /    |    \              
+     !!        /     |     \             distance3=Bd
+     !!       /      |      \
+     !!    C  -------d------- A  
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA,coordB,coordC
+     LOGICAL                         :: ll_debug
+
+     !! * Local declarations
+     REAL(wp)                        :: ztmp
+     REAL(wp)                        :: za, zb, zc, zangle
+
+     !-----------------------------------------------
+     za = SQRT( (coordB%lon-coordC%lon)**2 + (coordB%lat-coordC%lat)**2 )
+     zb = SQRT( (coordA%lon-coordC%lon)**2 + (coordA%lat-coordC%lat)**2 )
+     zc = SQRT( (coordA%lon-coordB%lon)**2 + (coordA%lat-coordB%lat)**2 )
+     !
+     IF( za /= 0. .AND. zb /= 0. )THEN
+        ztmp = ( za**2 + zb**2  - zc**2 ) / ( 2.0*za*zb )
+        ztmp = MIN(ztmp,1.00_wp)
+        IF( ztmp==1.00_wp )THEN ; zangle = 0.0 
+        ELSE                    ; zangle = ABS(acos(ztmp)) 
+        ENDIF
+     ELSE
+        PRINT*,'You should not have this situation: za zb =',za,zb ; STOP
+     ENDIF
+     !
+     distance3 = za*ABS(sin(zangle)) 
+     !
+     !function output
+     RETURN
+  END FUNCTION distance3
+
+  REAL(wp) FUNCTION slope_coeff(coordA,coordB,ld_dateline)
+     !!---------------------------------------------------------------------
+     !!         ***  Function slope_coeff  ***
+     !!
+     !! ** Purpose: Compute slope coefficient of the line (coordA,coordB)
+     !!
+     !! ** Method:
+     !!           Usual method :
+     !!                   slope_coeff = (latB-latA)/(lonB-lonA)
+     !!           Special case: the segment [A,B] crosses the date-line (lddate=T)
+     !!                   slope_coeff = (latB-latA)/(360+lonB-lonA)
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA, coordB
+     LOGICAL,INTENT(IN),OPTIONAL     :: ld_dateline
+
+     !! * Local declarations
+     REAL(wp)                        :: zcoeff
+     INTEGER                         :: idateline
+
+     !!---------------------------------------------------------
+     !initialization
+     zcoeff = 1.e20
+     idateline=0
+     IF( PRESENT( ld_dateline))THEN
+       IF( ld_dateline )idateline=1
+     ENDIF
+
+     !compute slope coefficient
+     IF ( coordB%lon-coordA%lon .NE. 0.) &
+         zcoeff=(coordB%lat-coordA%lat)/(360*idateline+coordB%lon-coordA%lon)
+
+     !output
+     slope_coeff = zcoeff
+     RETURN
+
+  END FUNCTION slope_coeff 
+
+  TYPE(COORD_SECTION) FUNCTION intersec(sec,coord_a,coord_b)
+     !!---------------------------------------------------------------------
+     !!         ***  Function intersec  ***
+     !!
+     !! ** Purpose:Return the coordinates of the intersection point, 
+     !!            between segment [a,b] and the section.
+     !!            If no intersection the point = -9999.
+     !!
+     !! ** Method:(coord_a,coord_b) => y=za2*x+zb2  (2)
+     !!            sec              => y=za1*x+zb1  (1)
+     !!    Intersection = (X,Y) solves (1) and (2)
+     !!    Vefify that (X,Y) is in [coord_a,coord_b] AND in the section
+     !!         
+     !! ** Action: 1. compute za1, za1 
+     !!            2. compute zb1, zb2
+     !!            3. compute X and Y
+     !!            4.Verify that (zX,zY) is in [coord_a,coord_b] 
+     !!              and in [sec%coordSec(1),sec%coordSec(2)]    
+     !!
+     !! History: Author: 10/05 Matthieu Laborie
+     !!          Additions:
+     !!           05-2007: (C Bricaud) add special cases
+     !!                                (crossing date line)
+     !----------------------------------------------------------------------------- 
+     !! * arguments
+     TYPE(SECTION), INTENT(IN)        :: sec
+     TYPE(COORD_SECTION)  , INTENT(IN):: coord_a, coord_b
+
+     !! * Local declarations
+     TYPE(COORD_SECTION) :: coordInter
+     REAL(wp)            :: za1,za2, &! slope coefficient
+                            zb1,zb2, &! 
+                            zX,zY     ! coordinates of intersection
+     LOGICAL             :: ll_date_line=.FALSE. !segment [a,b] crosses the date-line ?
+
+     !----------------------------------------------------------------------------
+
+     !=================!
+     !0. INITALIZATION !
+     !=================!
+     coordInter=COORD_SECTION(-9999.,-9999.) 
+     ll_date_line=.FALSE.    
+     !we need to know if [coord_a,coord_b] crosses the date-line 
+     if(coord_a%lon-coord_b%lon .GT. 180)ll_date_line=.TRUE.
+
+     !=======================!
+     !1. compute za1 and za2 !
+     !=======================!
+     za1=sec%slopeSection
+     za2=slope_coeff(coord_a,coord_b,ll_date_line)
+ 
+     !=======================!
+     !2. compute zb1 and zb2 !
+     !=======================!
+
+     ! Compute coefficient b for a straight line y=a*x+b
+     !        Usual method:  knowing value of a, we compute b with coordinates of 1 point:
+     !                       b=latA-a.lonA or b=latB-a.lonB
+     !        Particular case: the straight line crosses the date line; so it is in 2 parts:
+     !                         one on the left of the date-line and one the right
+     !                         then,b can could have 2 values:
+     ! As the date-line can be crossed by the section and the segment of the mesh [a,b],
+     ! we have to check if the segment [a,b] crosses the date-line (we know it already for the
+     ! section(sec%ll_date_line): ll_date_line
+     ! Then, there are 4 cases for computing b1 and b2 ( sec%ll_date_line=T/F AND ll_date_line=T/F )
+     !=========================================================================================!
+     ! CASE A :                               !CASE C:
+     ! sec%ll_date_line=T AND ll_date_line =T !sec%ll_date_line=F AND ll_date_line =T
+     !                                        !     |  -180 !+180   |
+     ! this case doesn't exist                !     |       !       |
+     !========================================! a___|_______!_______|__b
+     !CASE B:                                 !     |       !       |
+     !sec%ll_date_line=T AND ll_date_line=F   !     |       !       |
+     !     \     |                            ! section  date-line  section
+     !   a__\__b |                            ! b1: usual method
+     !       \   |                            ! b2: depend of longitude of
+     !        \  |                            !     sec%coordSec(1) et de  sec%coordSec(2)
+     !         \ |                            !=================================================!
+     !          \|                            !CASE D:
+     !     +180  \  -180                      !sec%ll_date_line=F AND ll_date_line =F
+     !           |\                           !      |       !       |
+     !           | \                          !      | +180  ! -180  |
+     !           |  \                         !  a___|___b   !   a___|___b
+     !           |a__\__b                     !      |       !       |
+     !           |    \                       !      |       !       |
+     !    date-line   section                 !   section date-line section
+     !b2: usual method                        !b1: usual method
+     !b1: depend of longitude of a and b.     !b2: usual method
+     !==========================================================================================!
+
+     IF( sec%ll_date_line )THEN
+          IF( ll_date_line )THEN
+              !CASE A: this case doesn't exist
+              !-------
+              zb1=1.e20
+              zb2=1.e20
+          ELSE 
+              !CASE B:
+              !-------
+              !compute zb2: 
+              !zb2 = coord_b%lat - za2 * coord_b%lon = coord_a%lat - za2 * coord_a%lon 
+              zb2=coord_b%lat - za2 * coord_b%lon  
+
+              !compute zb1:
+              IF( coord_a%lon .GT. 0 .AND. coord_b%lon .GT. 0  )THEN
+                  zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+              ELSE  
+                  zb1 = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon
+              ENDIF 
+          ENDIF
+     ELSE
+          IF( ll_date_line )THEN
+              !CASE C:
+              !-------
+              !Compute zb1: 
+              !zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon 
+              !    = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon 
+              zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+
+              !Compute zb2:
+              IF( sec%coordSec(1)%lon .GT. 0 .AND. sec%coordSec(2)%lon .GT. 0 )THEN
+                  zb2 = coord_a%lat - za2 * coord_a%lon
+              ELSE  
+                  zb2 = coord_b%lat - za2 * coord_b%lon
+              ENDIF
+          ELSE
+              !CASE D:
+              !-------
+              !compute zb1:
+              !zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon  
+              !    = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon
+              zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+
+              !compute zb2:
+              !zb2 = coord_b%lat - za2 * coord_b%lon = coord_a%lat - za2 * coord_a%lon
+              zb2 = coord_b%lat - za2 * coord_b%lon  
+          ENDIF
+     ENDIF 
+
+     IF( (za1 - za2) .NE. 0) THEN
+          !================================!
+          !3. Compute intersection (zX,zY) !
+          !================================!
+          IF( za1 == 1.e20 ) THEN ! Case X=constant
+              zX = sec%coordSec(1)%lon
+              zY = za2 * zX + zb2
+          ELSE IF ( za2 == 1.e20) THEN ! Case X=constant
+              zX = coord_b%lon
+              zY = za1 * zX + zb1
+          ELSE ! Case zY=A*zX+B
+              zX = (zb2 - zb1) / (za1 - za2)
+              zY = (za1 * zX ) + zb1
+          ENDIF
+           
+          !==============================================!
+          !4.Verify that (zX,zY) is in [coord_a,coord_b] !
+          !  and in [sec%coordSec(1),sec%coordSec(2)]    !
+          !==============================================!
+          !Be careful! The test is not the same for all configurations
+          IF( sec%ll_date_line )THEN
+
+              IF( ll_date_line )THEN
+                  !CASE A: this case doesn't exist
+                  !-------
+                  coordInter=COORD_SECTION(-9999.,-9999.)
+              ELSE
+                  !CASE B:
+                  !-------   
+                  IF( zX .GE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                      zX .LE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                      zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                      zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                    ((zX .LE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .GE. -180) .OR.  &
+                     (zX .GE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .LE. 180)) .AND. &
+                      zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                      zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN
+                     coordInter = COORD_SECTION(zX, zY)
+                  ENDIF
+              ENDIF
+          ELSE
+
+              IF( ll_date_line )THEN
+                  !CASE C:
+                  !-------
+                  IF( ((zX .LE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                        zX .GE. -180 )  .OR. &
+                       (zX .GE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                        zX .LE. 180 )) .AND. & 
+                        zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                        zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                        zX .GE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                        zX .LE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                        zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                        zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN 
+                        coordInter = COORD_SECTION(zX, zY)   
+                  ENDIF 
+              ELSE
+                  !CASE D:
+                  !-------
+                  IF( zX .GE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                      zX .LE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                      zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                      zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                      zX .GE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .LE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                      zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN
+                      coordInter = COORD_SECTION(zX, zY)
+                  ENDIF             
+              ENDIF
+          ENDIF   
+            
+     ENDIF
+      
+     !output
+     intersec = coordInter
+     RETURN
+   
+  END FUNCTION intersec
+
+  SUBROUTINE qcksrt(arr1,arr2,n)
+     !!---------------------------------------------------------------------
+     !!         ***  SUBROUTINE qcksrt  ***
+     !!
+     !! ** Purpose : organize a list point by latitude , and after by longitude
+     !!              using "numerical recipies " routine.
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER,INTENT(IN)                 :: n           ! number of points
+     REAL(wp),DIMENSION(n),INTENT(INOUT):: arr1,arr2   ! longitude and latitude
+
+     !! * Local declarations
+     INTEGER , PARAMETER                :: m = 7, nstack = 500
+     REAL(wp), PARAMETER                :: fm=7875.,fa=211.,fc=1663.,fmi=1./fm
+     INTEGER                            :: il, ir, i, iq, ist    !local integers
+     INTEGER                            :: jj                    !loop indices
+     REAL(wp)                           :: zfx, za, zb           !local real
+     INTEGER,DIMENSION(nstack)          :: istack(nstack)        !temp array
+     !---------------------------------------------------
+     ist=0
+     il=1
+     ir=n
+     zfx=0.
+     !
+ 10  IF( ir-il .LT. m )THEN
+
+        DO jj = il+1,ir
+           za = arr1(jj)
+           zb = arr2(jj)
+           DO i = jj-1,1,-1
+              IF( arr1(i) .LE. za )GOTO 12
+              arr1(i+1) = arr1(i)
+              arr2(i+1) = arr2(i)
+           ENDDO
+           i=0
+ 12        arr1(i+1) = za
+           arr2(i+1) = zb
+        ENDDO
+        IF( ist .EQ. 0 )RETURN
+        ir  = istack(ist)
+        il  = istack(ist-1)
+        ist = ist-2
+     ELSE
+        i  = il
+        jj = ir
+        zfx = MOD(zfx*fa+fc,fm)
+        iq = il+(ir-il+1)*(zfx*fmi)
+        za  = arr1(iq)
+        arr1(iq) = arr1(il)
+        zb = arr2(iq)
+        arr2(iq) = arr2(il)
+ 20     CONTINUE
+ 21     IF( jj .GT. 0 )THEN
+           IF( za .LT. arr1(jj) )THEN
+              jj = jj-1
+              GOTO 21
+           ENDIF
+        ENDIF
+        IF( jj .LE. i )THEN
+           arr1(i) = za
+           arr2(i) = zb
+           GOTO 30
+        ENDIF
+        arr1(i) = arr1(jj)
+        arr2(i) = arr2(jj)
+        i=i+1
+ 22     IF( i .LE. n )THEN
+           IF( za .GT. arr1(i) )THEN
+              i = i+1
+              GOTO 22
+           ENDIF
+        ENDIF 
+        IF( jj .LE.i )THEN
+           arr1(jj) = za
+           arr2(jj) = zb
+           i        = jj
+           GOTO 30
+        ENDIF
+        arr1(jj) = arr1(i)
+        arr2(jj) = arr2(i)
+        jj = jj - 1
+        GOTO 20
+ 30     ist = ist + 2
+        IF( ist .GT. nstack )PAUSE 'nstack too small'
+        IF( ir-i .GE. i-1 )THEN
+           istack(ist  ) = ir
+           istack(ist-1) = i + 1
+           ir = i-1
+        ELSE
+           istack(ist  ) = i-1
+           istack(ist-1) = il
+           il = i+1
+        ENDIF
+     ENDIF
+     GOTO 10
+  END SUBROUTINE qcksrt
+
+  SUBROUTINE write_debug(ksec,cd_write)
+     !!---------------------------------------------------------------------
+     !!         ***  SUBROUTINE write_debug  ***
+     !!
+     !! ** Purpose: write debug messages
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER           :: ksec       !number of section
+     CHARACTER(len=*)  :: cd_write   !message to write
+
+     !! * Local declarations
+     INTEGER           :: iunit
+     LOGICAL           :: llok
+     CHARACTER(len=80) :: clfilename
+   
+     !!---------------------------------------------------------------------
+     IF( ksec == nsecdebug .OR. nsecdebug == -1 )THEN
+
+
+        !open / verify is debug output file is open
+
+        clfilename=TRIM(secs(ksec)%name)//"_debug"
+        iunit = num_sec_debug(ksec)
+
+        IF( iunit .EQ. 0 )THEN
+           PRINT*,"Open debug file: "//TRIM(clfilename)
+           iunit = 100 + ksec
+           num_sec_debug(ksec) = iunit 
+ 
+           CALL file_open(iunit,clfilename,llok,cdform="FORMATTED",cdstatus="REPLACE",cdaction="WRITE")
+        
+           IF( .NOT. llok )THEN 
+               PRINT*,"Can not open TRIM(clfilename)." ; STOP
+           ENDIF   
+        ENDIF
+      
+       WRITE(iunit,*)TRIM(cd_write)
+
+     ENDIF
+
+  END SUBROUTINE write_debug
+
+  SUBROUTINE file_open(knum,cdfile,ldok,cdform,cdstatus,cdaction)
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE file_open ***
+     !!
+     !! ** Purpose: open a file
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER          ,INTENT(IN)  :: knum       ! file unit number
+     CHARACTER(len=*),INTENT(IN)   :: cdfile     ! file name to open
+     LOGICAL          ,INTENT(OUT) :: ldok       ! =.TRUE. if file exists and is corectly opened
+     CHARACTER(len=*),INTENT(IN)   :: cdform,   &! FORM arguments for OPEN function
+                                      cdstatus, &! STATUS arguments for OPEN function
+                                      cdaction   ! ACTION arguments for OPEN function
+                                      
+     !! * Local declarations
+     INTEGER :: iost
+     LOGICAL :: llbon=.FALSE. !check existence of file
+     !!---------------------------------------------------------------------
+     ldok = .FALSE.                        ! initialization; file not found and not opened
+
+     !check presence of file
+     IF( cdstatus .EQ. "OLD" ) THEN
+        INQUIRE( FILE=cdfile, EXIST=llbon ) ! check presence of namelist
+        IF( llbon )THEN ;  PRINT*,TRIM(cdfile)//' EXISTS'
+        ELSE            ;  PRINT*,TRIM(cdfile)//' NOT EXISTS' ; STOP
+        ENDIF
+     ENDIF
+
+     !open file
+     OPEN(UNIT=knum,FILE=TRIM(cdfile),FORM=cdform,status=cdstatus,action=cdaction,iostat=iost)
+     IF ( iost == 0 )THEN
+          ldok=.TRUE.
+     ELSE
+          PRINT*,TRIM(cdfile)//' bad opening. STOP.'; STOP
+     ENDIF
+
+  END SUBROUTINE file_open
+
+END MODULE sections_tools 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90	(revision 8732)
@@ -0,0 +1,91 @@
+MODULE writesections 
+   !!=====================================================================
+   !!                       ***  MODULE  writesections  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations   
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC  write_sections 
+   PRIVATE file_open 
+ 
+CONTAINS
+
+  SUBROUTINE write_sections
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE read_list_sections ***
+     !!
+     !! ** Purpose
+     !!
+     !! ** Method
+     !!
+     !! ** Input
+     !!
+     !! ** Action
+     !!
+     !! History
+     !!---------------------------------------------------------------------
+     !! * arguments
+
+     !! * Local declarations
+     INTEGER             :: jsec ,&!loop on sections 
+                            jseg   !loop on segments
+     INTEGER             :: i1, i2 !temporary integers
+     LOGICAL             :: llok   !
+     CHARACTER(len=40)   :: clname !
+     TYPE(POINT_SECTION) :: point  !coordinates of a point
+
+     !!---------------------------------------------------------------------
+
+     PRINT*,'              '
+     PRINT*,'WRITE SECTIONS'
+     PRINT*,'--------------'
+
+     !open output file
+     llok=.FALSE.
+     clname='section_ijglobal.diadct'
+     CALL file_open(numdctout,clname,llok,cdform="UNFORMATTED",cdstatus="REPLACE",cdaction="WRITE")
+
+     !print informations
+     IF ( llok ) THEN
+          PRINT*,TRIM(clname),' open. '
+
+          DO jsec=1,nb_sec
+  
+             WRITE(numdctout)jsec
+             WRITE(numdctout)secs(jsec)%name
+             WRITE(numdctout)secs(jsec)%llstrpond
+             WRITE(numdctout)secs(jsec)%ll_ice_section
+             WRITE(numdctout)secs(jsec)%ll_date_line
+             WRITE(numdctout)secs(jsec)%coordSec
+             WRITE(numdctout)secs(jsec)%nb_class
+             WRITE(numdctout)secs(jsec)%zsigi
+             WRITE(numdctout)secs(jsec)%zsigp
+             WRITE(numdctout)secs(jsec)%zsal
+             WRITE(numdctout)secs(jsec)%ztem
+             WRITE(numdctout)secs(jsec)%zlay
+             WRITE(numdctout)secs(jsec)%slopeSection
+             WRITE(numdctout)secs(jsec)%nb_point
+             IF( secs(jsec)%nb_point .NE. 0 )THEN
+                DO jseg=1,secs(jsec)%nb_point
+                   i1 = secs(jsec)%listPoint(jseg)%I  ; i2 = secs(jsec)%listPoint(jseg)%J
+                   WRITE(numdctout)i1,i2
+                ENDDO
+                WRITE(numdctout)secs(jsec)%direction(1:secs(jsec)%nb_point)
+             ENDIF
+
+          ENDDO !end of loop on sections
+         
+          CLOSE(numdctout) !Close file
+     ENDIF
+
+  END SUBROUTINE  write_sections
+
+END MODULE writesections 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/Doxyfile
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/Doxyfile	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/Doxyfile	(revision 8732)
@@ -0,0 +1,2331 @@
+# Doxyfile 1.8.8
+
+# This file describes the settings to be used by the documentation system
+# doxygen (www.doxygen.org) for a project.
+#
+# All text after a double hash (##) is considered a comment and is placed in
+# front of the TAG it is preceding.
+#
+# All text after a single hash (#) is considered a comment and will be ignored.
+# The format is:
+# TAG = value [value, ...]
+# For lists, items can also be appended using:
+# TAG += value [value, ...]
+# Values that contain spaces should be placed between quotes (\" \").
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+
+# This tag specifies the encoding used for all characters in the config file
+# that follow. The default is UTF-8 which is also the encoding used for all text
+# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv
+# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv
+# for the list of possible encodings.
+# The default value is: UTF-8.
+
+DOXYFILE_ENCODING      = UTF-8
+
+# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by
+# double-quotes, unless you are using Doxywizard) that should identify the
+# project for which the documentation is generated. This name is used in the
+# title of most generated pages and in a few other places.
+# The default value is: My Project.
+
+PROJECT_NAME           = "SIREN"
+
+# The PROJECT_NUMBER tag can be used to enter a project or revision number. This
+# could be handy for archiving the generated documentation or if some version
+# control system is used.
+
+PROJECT_NUMBER         = "NEMO 3.6"
+
+# Using the PROJECT_BRIEF tag one can provide an optional one line description
+# for a project that appears at the top of each page and should give viewer a
+# quick idea about the purpose of the project. Keep the description short.
+
+PROJECT_BRIEF          = "System and Interface for oceanic RElocatable Nesting"
+
+# With the PROJECT_LOGO tag one can specify an logo or icon that is included in
+# the documentation. The maximum height of the logo should not exceed 55 pixels
+# and the maximum width should not exceed 200 pixels. Doxygen will copy the logo
+# to the output directory.
+
+PROJECT_LOGO           = ./src/docsrc/Image/logoSirenNemo.png
+
+# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path
+# into which the generated documentation will be written. If a relative path is
+# entered, it will be relative to the location where doxygen was started. If
+# left blank the current directory will be used.
+
+OUTPUT_DIRECTORY       = ./doc
+
+# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create 4096 sub-
+# directories (in 2 levels) under the output directory of each output format and
+# will distribute the generated files over these directories. Enabling this
+# option can be useful when feeding doxygen a huge amount of source files, where
+# putting all generated files in the same directory would otherwise causes
+# performance problems for the file system.
+# The default value is: NO.
+
+CREATE_SUBDIRS         = NO
+
+# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII
+# characters to appear in the names of generated files. If set to NO, non-ASCII
+# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode
+# U+3044.
+# The default value is: NO.
+
+ALLOW_UNICODE_NAMES    = NO
+
+# The OUTPUT_LANGUAGE tag is used to specify the language in which all
+# documentation generated by doxygen is written. Doxygen will use this
+# information to generate all constant output in the proper language.
+# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese,
+# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States),
+# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian,
+# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages),
+# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian,
+# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian,
+# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish,
+# Ukrainian and Vietnamese.
+# The default value is: English.
+
+OUTPUT_LANGUAGE        = English
+
+# If the BRIEF_MEMBER_DESC tag is set to YES doxygen will include brief member
+# descriptions after the members that are listed in the file and class
+# documentation (similar to Javadoc). Set to NO to disable this.
+# The default value is: YES.
+
+BRIEF_MEMBER_DESC      = YES
+
+# If the REPEAT_BRIEF tag is set to YES doxygen will prepend the brief
+# description of a member or function before the detailed description
+#
+# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the
+# brief descriptions will be completely suppressed.
+# The default value is: YES.
+
+REPEAT_BRIEF           = YES
+
+# This tag implements a quasi-intelligent brief description abbreviator that is
+# used to form the text in various listings. Each string in this list, if found
+# as the leading text of the brief description, will be stripped from the text
+# and the result, after processing the whole list, is used as the annotated
+# text. Otherwise, the brief description is used as-is. If left blank, the
+# following values are used ($name is automatically replaced with the name of
+# the entity):The $name class, The $name widget, The $name file, is, provides,
+# specifies, contains, represents, a, an and the.
+
+ABBREVIATE_BRIEF       =
+
+# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then
+# doxygen will generate a detailed section even if there is only a brief
+# description.
+# The default value is: NO.
+
+ALWAYS_DETAILED_SEC    = NO
+
+# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all
+# inherited members of a class in the documentation of that class as if those
+# members were ordinary class members. Constructors, destructors and assignment
+# operators of the base classes will not be shown.
+# The default value is: NO.
+
+INLINE_INHERITED_MEMB  = NO
+
+# If the FULL_PATH_NAMES tag is set to YES doxygen will prepend the full path
+# before files name in the file list and in the header files. If set to NO the
+# shortest path that makes the file name unique will be used
+# The default value is: YES.
+
+FULL_PATH_NAMES        = YES
+
+# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path.
+# Stripping is only done if one of the specified strings matches the left-hand
+# part of the path. The tag can be used to show relative paths in the file list.
+# If left blank the directory from which doxygen is run is used as the path to
+# strip.
+#
+# Note that you can specify absolute paths here, but also relative paths, which
+# will be relative from the directory where doxygen is started.
+# This tag requires that the tag FULL_PATH_NAMES is set to YES.
+
+STRIP_FROM_PATH        =
+
+# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the
+# path mentioned in the documentation of a class, which tells the reader which
+# header file to include in order to use a class. If left blank only the name of
+# the header file containing the class definition is used. Otherwise one should
+# specify the list of include paths that are normally passed to the compiler
+# using the -I flag.
+
+STRIP_FROM_INC_PATH    =
+
+# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but
+# less readable) file names. This can be useful is your file systems doesn't
+# support long names like on DOS, Mac, or CD-ROM.
+# The default value is: NO.
+
+SHORT_NAMES            = NO
+
+# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the
+# first line (until the first dot) of a Javadoc-style comment as the brief
+# description. If set to NO, the Javadoc-style will behave just like regular Qt-
+# style comments (thus requiring an explicit @brief command for a brief
+# description.)
+# The default value is: NO.
+
+JAVADOC_AUTOBRIEF      = NO
+
+# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first
+# line (until the first dot) of a Qt-style comment as the brief description. If
+# set to NO, the Qt-style will behave just like regular Qt-style comments (thus
+# requiring an explicit \brief command for a brief description.)
+# The default value is: NO.
+
+QT_AUTOBRIEF           = NO
+
+# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a
+# multi-line C++ special comment block (i.e. a block of //! or /// comments) as
+# a brief description. This used to be the default behavior. The new default is
+# to treat a multi-line C++ comment block as a detailed description. Set this
+# tag to YES if you prefer the old behavior instead.
+#
+# Note that setting this tag to YES also means that rational rose comments are
+# not recognized any more.
+# The default value is: NO.
+
+MULTILINE_CPP_IS_BRIEF = NO
+
+# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the
+# documentation from any documented member that it re-implements.
+# The default value is: YES.
+
+INHERIT_DOCS           = YES
+
+# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce a
+# new page for each member. If set to NO, the documentation of a member will be
+# part of the file/class/namespace that contains it.
+# The default value is: NO.
+
+SEPARATE_MEMBER_PAGES  = NO
+
+# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen
+# uses this value to replace tabs by spaces in code fragments.
+# Minimum value: 1, maximum value: 16, default value: 4.
+
+TAB_SIZE               = 3
+
+# This tag can be used to specify a number of aliases that act as commands in
+# the documentation. An alias has the form:
+# name=value
+# For example adding
+# "sideeffect=@par Side Effects:\n"
+# will allow you to put the command \sideeffect (or @sideeffect) in the
+# documentation, which will result in a user-defined paragraph with heading
+# "Side Effects:". You can put \n's in the value part of an alias to insert
+# newlines.
+
+ALIASES                =
+
+# This tag can be used to specify a number of word-keyword mappings (TCL only).
+# A mapping has the form "name=value". For example adding "class=itcl::class"
+# will allow you to use the command class in the itcl::class meaning.
+
+TCL_SUBST              =
+
+# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources
+# only. Doxygen will then generate output that is more tailored for C. For
+# instance, some of the names that are used will be different. The list of all
+# members will be omitted, etc.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_FOR_C  = NO
+
+# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or
+# Python sources only. Doxygen will then generate output that is more tailored
+# for that language. For instance, namespaces will be presented as packages,
+# qualified scopes will look different, etc.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_JAVA   = NO
+
+# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran
+# sources. Doxygen will then generate output that is tailored for Fortran.
+# The default value is: NO.
+
+OPTIMIZE_FOR_FORTRAN   = NO
+
+# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL
+# sources. Doxygen will then generate output that is tailored for VHDL.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_VHDL   = NO
+
+# Doxygen selects the parser to use depending on the extension of the files it
+# parses. With this tag you can assign which parser to use for a given
+# extension. Doxygen has a built-in mapping, but you can override or extend it
+# using this tag. The format is ext=language, where ext is a file extension, and
+# language is one of the parsers supported by doxygen: IDL, Java, Javascript,
+# C#, C, C++, D, PHP, Objective-C, Python, Fortran (fixed format Fortran:
+# FortranFixed, free formatted Fortran: FortranFree, unknown formatted Fortran:
+# Fortran. In the later case the parser tries to guess whether the code is fixed
+# or free formatted code, this is the default for Fortran type files), VHDL. For
+# instance to make doxygen treat .inc files as Fortran files (default is PHP),
+# and .f files as C (default is Fortran), use: inc=Fortran f=C.
+#
+# Note For files without extension you can use no_extension as a placeholder.
+#
+# Note that for custom extensions you also need to set FILE_PATTERNS otherwise
+# the files are not read by doxygen.
+
+EXTENSION_MAPPING      = 
+
+# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments
+# according to the Markdown format, which allows for more readable
+# documentation. See http://daringfireball.net/projects/markdown/ for details.
+# The output of markdown processing is further processed by doxygen, so you can
+# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in
+# case of backward compatibilities issues.
+# The default value is: YES.
+
+MARKDOWN_SUPPORT       = YES
+
+# When enabled doxygen tries to link words that correspond to documented
+# classes, or namespaces to their corresponding documentation. Such a link can
+# be prevented in individual cases by by putting a % sign in front of the word
+# or globally by setting AUTOLINK_SUPPORT to NO.
+# The default value is: YES.
+
+AUTOLINK_SUPPORT       = YES
+
+# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want
+# to include (a tag file for) the STL sources as input, then you should set this
+# tag to YES in order to let doxygen match functions declarations and
+# definitions whose arguments contain STL classes (e.g. func(std::string);
+# versus func(std::string) {}). This also make the inheritance and collaboration
+# diagrams that involve STL classes more complete and accurate.
+# The default value is: NO.
+
+BUILTIN_STL_SUPPORT    = NO
+
+# If you use Microsoft's C++/CLI language, you should set this option to YES to
+# enable parsing support.
+# The default value is: NO.
+
+CPP_CLI_SUPPORT        = NO
+
+# Set the SIP_SUPPORT tag to YES if your project consists of sip (see:
+# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen
+# will parse them like normal C++ but will assume all classes use public instead
+# of private inheritance when no explicit protection keyword is present.
+# The default value is: NO.
+
+SIP_SUPPORT            = NO
+
+# For Microsoft's IDL there are propget and propput attributes to indicate
+# getter and setter methods for a property. Setting this option to YES will make
+# doxygen to replace the get and set methods by a property in the documentation.
+# This will only work if the methods are indeed getting or setting a simple
+# type. If this is not the case, or you want to show the methods anyway, you
+# should set this option to NO.
+# The default value is: YES.
+
+IDL_PROPERTY_SUPPORT   = YES
+
+# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC
+# tag is set to YES, then doxygen will reuse the documentation of the first
+# member in the group (if any) for the other members of the group. By default
+# all members of a group must be documented explicitly.
+# The default value is: NO.
+
+DISTRIBUTE_GROUP_DOC   = NO
+
+# Set the SUBGROUPING tag to YES to allow class member groups of the same type
+# (for instance a group of public functions) to be put as a subgroup of that
+# type (e.g. under the Public Functions section). Set it to NO to prevent
+# subgrouping. Alternatively, this can be done per class using the
+# \nosubgrouping command.
+# The default value is: YES.
+
+SUBGROUPING            = YES
+
+# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions
+# are shown inside the group in which they are included (e.g. using \ingroup)
+# instead of on a separate page (for HTML and Man pages) or section (for LaTeX
+# and RTF).
+#
+# Note that this feature does not work in combination with
+# SEPARATE_MEMBER_PAGES.
+# The default value is: NO.
+
+INLINE_GROUPED_CLASSES = NO
+
+# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions
+# with only public data fields or simple typedef fields will be shown inline in
+# the documentation of the scope in which they are defined (i.e. file,
+# namespace, or group documentation), provided this scope is documented. If set
+# to NO, structs, classes, and unions are shown on a separate page (for HTML and
+# Man pages) or section (for LaTeX and RTF).
+# The default value is: NO.
+
+INLINE_SIMPLE_STRUCTS  = NO
+
+# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or
+# enum is documented as struct, union, or enum with the name of the typedef. So
+# typedef struct TypeS {} TypeT, will appear in the documentation as a struct
+# with name TypeT. When disabled the typedef will appear as a member of a file,
+# namespace, or class. And the struct will be named TypeS. This can typically be
+# useful for C code in case the coding convention dictates that all compound
+# types are typedef'ed and only the typedef is referenced, never the tag name.
+# The default value is: NO.
+
+TYPEDEF_HIDES_STRUCT   = NO
+
+# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This
+# cache is used to resolve symbols given their name and scope. Since this can be
+# an expensive process and often the same symbol appears multiple times in the
+# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small
+# doxygen will become slower. If the cache is too large, memory is wasted. The
+# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range
+# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536
+# symbols. At the end of a run doxygen will report the cache usage and suggest
+# the optimal cache size from a speed point of view.
+# Minimum value: 0, maximum value: 9, default value: 0.
+
+LOOKUP_CACHE_SIZE      = 0
+
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+
+# If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in
+# documentation are documented, even if no documentation was available. Private
+# class members and static file members will be hidden unless the
+# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES.
+# Note: This will also disable the warnings about undocumented members that are
+# normally produced when WARNINGS is set to YES.
+# The default value is: NO.
+
+EXTRACT_ALL            = NO
+
+# If the EXTRACT_PRIVATE tag is set to YES all private members of a class will
+# be included in the documentation.
+# The default value is: NO.
+
+EXTRACT_PRIVATE        = NO
+
+# If the EXTRACT_PACKAGE tag is set to YES all members with package or internal
+# scope will be included in the documentation.
+# The default value is: NO.
+
+EXTRACT_PACKAGE        = NO
+
+# If the EXTRACT_STATIC tag is set to YES all static members of a file will be
+# included in the documentation.
+# The default value is: NO.
+
+EXTRACT_STATIC         = NO
+
+# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs) defined
+# locally in source files will be included in the documentation. If set to NO
+# only classes defined in header files are included. Does not have any effect
+# for Java sources.
+# The default value is: YES.
+
+EXTRACT_LOCAL_CLASSES  = YES
+
+# This flag is only useful for Objective-C code. When set to YES local methods,
+# which are defined in the implementation section but not in the interface are
+# included in the documentation. If set to NO only methods in the interface are
+# included.
+# The default value is: NO.
+
+EXTRACT_LOCAL_METHODS  = NO
+
+# If this flag is set to YES, the members of anonymous namespaces will be
+# extracted and appear in the documentation as a namespace called
+# 'anonymous_namespace{file}', where file will be replaced with the base name of
+# the file that contains the anonymous namespace. By default anonymous namespace
+# are hidden.
+# The default value is: NO.
+
+EXTRACT_ANON_NSPACES   = NO
+
+# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all
+# undocumented members inside documented classes or files. If set to NO these
+# members will be included in the various overviews, but no documentation
+# section is generated. This option has no effect if EXTRACT_ALL is enabled.
+# The default value is: NO.
+
+HIDE_UNDOC_MEMBERS     = NO
+
+# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all
+# undocumented classes that are normally visible in the class hierarchy. If set
+# to NO these classes will be included in the various overviews. This option has
+# no effect if EXTRACT_ALL is enabled.
+# The default value is: NO.
+
+HIDE_UNDOC_CLASSES     = NO
+
+# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend
+# (class|struct|union) declarations. If set to NO these declarations will be
+# included in the documentation.
+# The default value is: NO.
+
+HIDE_FRIEND_COMPOUNDS  = NO
+
+# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any
+# documentation blocks found inside the body of a function. If set to NO these
+# blocks will be appended to the function's detailed documentation block.
+# The default value is: NO.
+
+HIDE_IN_BODY_DOCS      = NO
+
+# The INTERNAL_DOCS tag determines if documentation that is typed after a
+# \internal command is included. If the tag is set to NO then the documentation
+# will be excluded. Set it to YES to include the internal documentation.
+# The default value is: NO.
+
+INTERNAL_DOCS          = NO
+
+# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file
+# names in lower-case letters. If set to YES upper-case letters are also
+# allowed. This is useful if you have classes or files whose names only differ
+# in case and if your file system supports case sensitive file names. Windows
+# and Mac users are advised to set this option to NO.
+# The default value is: system dependent.
+
+CASE_SENSE_NAMES       = YES
+
+# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with
+# their full class and namespace scopes in the documentation. If set to YES the
+# scope will be hidden.
+# The default value is: NO.
+
+HIDE_SCOPE_NAMES       = NO
+
+# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of
+# the files that are included by a file in the documentation of that file.
+# The default value is: YES.
+
+SHOW_INCLUDE_FILES     = YES
+
+# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each
+# grouped member an include statement to the documentation, telling the reader
+# which file to include in order to use the member.
+# The default value is: NO.
+
+SHOW_GROUPED_MEMB_INC  = NO
+
+# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include
+# files with double quotes in the documentation rather than with sharp brackets.
+# The default value is: NO.
+
+FORCE_LOCAL_INCLUDES   = NO
+
+# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the
+# documentation for inline members.
+# The default value is: YES.
+
+INLINE_INFO            = YES
+
+# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the
+# (detailed) documentation of file and class members alphabetically by member
+# name. If set to NO the members will appear in declaration order.
+# The default value is: YES.
+
+SORT_MEMBER_DOCS       = YES
+
+# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief
+# descriptions of file, namespace and class members alphabetically by member
+# name. If set to NO the members will appear in declaration order. Note that
+# this will also influence the order of the classes in the class list.
+# The default value is: NO.
+
+SORT_BRIEF_DOCS        = NO
+
+# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the
+# (brief and detailed) documentation of class members so that constructors and
+# destructors are listed first. If set to NO the constructors will appear in the
+# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS.
+# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief
+# member documentation.
+# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting
+# detailed member documentation.
+# The default value is: NO.
+
+SORT_MEMBERS_CTORS_1ST = NO
+
+# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy
+# of group names into alphabetical order. If set to NO the group names will
+# appear in their defined order.
+# The default value is: NO.
+
+SORT_GROUP_NAMES       = NO
+
+# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by
+# fully-qualified names, including namespaces. If set to NO, the class list will
+# be sorted only by class name, not including the namespace part.
+# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES.
+# Note: This option applies only to the class list, not to the alphabetical
+# list.
+# The default value is: NO.
+
+SORT_BY_SCOPE_NAME     = NO
+
+# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper
+# type resolution of all parameters of a function it will reject a match between
+# the prototype and the implementation of a member function even if there is
+# only one candidate or it is obvious which candidate to choose by doing a
+# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still
+# accept a match between prototype and implementation in such cases.
+# The default value is: NO.
+
+STRICT_PROTO_MATCHING  = NO
+
+# The GENERATE_TODOLIST tag can be used to enable ( YES) or disable ( NO) the
+# todo list. This list is created by putting \todo commands in the
+# documentation.
+# The default value is: YES.
+
+GENERATE_TODOLIST      = YES
+
+# The GENERATE_TESTLIST tag can be used to enable ( YES) or disable ( NO) the
+# test list. This list is created by putting \test commands in the
+# documentation.
+# The default value is: YES.
+
+GENERATE_TESTLIST      = YES
+
+# The GENERATE_BUGLIST tag can be used to enable ( YES) or disable ( NO) the bug
+# list. This list is created by putting \bug commands in the documentation.
+# The default value is: YES.
+
+GENERATE_BUGLIST       = YES
+
+# The GENERATE_DEPRECATEDLIST tag can be used to enable ( YES) or disable ( NO)
+# the deprecated list. This list is created by putting \deprecated commands in
+# the documentation.
+# The default value is: YES.
+
+GENERATE_DEPRECATEDLIST= YES
+
+# The ENABLED_SECTIONS tag can be used to enable conditional documentation
+# sections, marked by \if <section_label> ... \endif and \cond <section_label>
+# ... \endcond blocks.
+
+ENABLED_SECTIONS       =
+
+# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the
+# initial value of a variable or macro / define can have for it to appear in the
+# documentation. If the initializer consists of more lines than specified here
+# it will be hidden. Use a value of 0 to hide initializers completely. The
+# appearance of the value of individual variables and macros / defines can be
+# controlled using \showinitializer or \hideinitializer command in the
+# documentation regardless of this setting.
+# Minimum value: 0, maximum value: 10000, default value: 30.
+
+MAX_INITIALIZER_LINES  = 30
+
+# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at
+# the bottom of the documentation of classes and structs. If set to YES the list
+# will mention the files that were used to generate the documentation.
+# The default value is: YES.
+
+SHOW_USED_FILES        = YES
+
+# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This
+# will remove the Files entry from the Quick Index and from the Folder Tree View
+# (if specified).
+# The default value is: YES.
+
+SHOW_FILES             = YES
+
+# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces
+# page. This will remove the Namespaces entry from the Quick Index and from the
+# Folder Tree View (if specified).
+# The default value is: YES.
+
+SHOW_NAMESPACES        = YES
+
+# The FILE_VERSION_FILTER tag can be used to specify a program or script that
+# doxygen should invoke to get the current version for each file (typically from
+# the version control system). Doxygen will invoke the program by executing (via
+# popen()) the command command input-file, where command is the value of the
+# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided
+# by doxygen. Whatever the program writes to standard output is used as the file
+# version. For an example see the documentation.
+
+FILE_VERSION_FILTER    =
+
+# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed
+# by doxygen. The layout file controls the global structure of the generated
+# output files in an output format independent way. To create the layout file
+# that represents doxygen's defaults, run doxygen with the -l option. You can
+# optionally specify a file name after the option, if omitted DoxygenLayout.xml
+# will be used as the name of the layout file.
+#
+# Note that if you run doxygen from a directory containing a file called
+# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE
+# tag is left empty.
+
+LAYOUT_FILE            =
+
+# The CITE_BIB_FILES tag can be used to specify one or more bib files containing
+# the reference definitions. This must be a list of .bib files. The .bib
+# extension is automatically appended if omitted. This requires the bibtex tool
+# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info.
+# For LaTeX the style of the bibliography can be controlled using
+# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the
+# search path. See also \cite for info how to create references.
+
+CITE_BIB_FILES         =
+
+#---------------------------------------------------------------------------
+# Configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+
+# The QUIET tag can be used to turn on/off the messages that are generated to
+# standard output by doxygen. If QUIET is set to YES this implies that the
+# messages are off.
+# The default value is: NO.
+
+QUIET                  = NO
+
+# The WARNINGS tag can be used to turn on/off the warning messages that are
+# generated to standard error ( stderr) by doxygen. If WARNINGS is set to YES
+# this implies that the warnings are on.
+#
+# Tip: Turn warnings on while writing the documentation.
+# The default value is: YES.
+
+WARNINGS               = YES
+
+# If the WARN_IF_UNDOCUMENTED tag is set to YES, then doxygen will generate
+# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag
+# will automatically be disabled.
+# The default value is: YES.
+
+WARN_IF_UNDOCUMENTED   = YES
+
+# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for
+# potential errors in the documentation, such as not documenting some parameters
+# in a documented function, or documenting parameters that don't exist or using
+# markup commands wrongly.
+# The default value is: YES.
+
+WARN_IF_DOC_ERROR      = YES
+
+# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that
+# are documented, but have no documentation for their parameters or return
+# value. If set to NO doxygen will only warn about wrong or incomplete parameter
+# documentation, but not about the absence of documentation.
+# The default value is: NO.
+
+WARN_NO_PARAMDOC       = NO
+
+# The WARN_FORMAT tag determines the format of the warning messages that doxygen
+# can produce. The string should contain the $file, $line, and $text tags, which
+# will be replaced by the file and line number from which the warning originated
+# and the warning text. Optionally the format may contain $version, which will
+# be replaced by the version of the file (if it could be obtained via
+# FILE_VERSION_FILTER)
+# The default value is: $file:$line: $text.
+
+WARN_FORMAT            = "$file:$line: $text"
+
+# The WARN_LOGFILE tag can be used to specify a file to which warning and error
+# messages should be written. If left blank the output is written to standard
+# error (stderr).
+
+WARN_LOGFILE           =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the input files
+#---------------------------------------------------------------------------
+
+# The INPUT tag is used to specify the files and/or directories that contain
+# documented source files. You may enter file names like myfile.cpp or
+# directories like /usr/src/myproject. Separate the files or directories with
+# spaces.
+# Note: If this tag is empty the current directory is searched.
+
+INPUT                  = ./src ./src/docsrc
+
+# This tag can be used to specify the character encoding of the source files
+# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
+# libiconv (or the iconv built into libc) for the transcoding. See the libiconv
+# documentation (see: http://www.gnu.org/software/libiconv) for the list of
+# possible encodings.
+# The default value is: UTF-8.
+
+INPUT_ENCODING         = UTF-8
+
+# If the value of the INPUT tag contains directories, you can use the
+# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and
+# *.h) to filter out the source-files in the directories. If left blank the
+# following patterns are tested:*.c, *.cc, *.cxx, *.cpp, *.c++, *.java, *.ii,
+# *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, *.hh, *.hxx, *.hpp,
+# *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, *.m, *.markdown,
+# *.md, *.mm, *.dox, *.py, *.f90, *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf,
+# *.qsf, *.as and *.js.
+
+FILE_PATTERNS          = 
+
+# The RECURSIVE tag can be used to specify whether or not subdirectories should
+# be searched for input files as well.
+# The default value is: NO.
+
+RECURSIVE              = NO
+
+# The EXCLUDE tag can be used to specify files and/or directories that should be
+# excluded from the INPUT source files. This way you can easily exclude a
+# subdirectory from a directory tree whose root is specified with the INPUT tag.
+#
+# Note that relative paths are relative to the directory from which doxygen is
+# run.
+
+EXCLUDE                =
+
+# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or
+# directories that are symbolic links (a Unix file system feature) are excluded
+# from the input.
+# The default value is: NO.
+
+EXCLUDE_SYMLINKS       = NO
+
+# If the value of the INPUT tag contains directories, you can use the
+# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude
+# certain files from those directories.
+#
+# Note that the wildcards are matched against the file with absolute path, so to
+# exclude all test directories for example use the pattern */test/*
+
+EXCLUDE_PATTERNS       =
+
+# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names
+# (namespaces, classes, functions, etc.) that should be excluded from the
+# output. The symbol name can be a fully qualified name, a word, or if the
+# wildcard * is used, a substring. Examples: ANamespace, AClass,
+# AClass::ANamespace, ANamespace::*Test
+#
+# Note that the wildcards are matched against the file with absolute path, so to
+# exclude all test directories use the pattern */test/*
+
+EXCLUDE_SYMBOLS        =
+
+# The EXAMPLE_PATH tag can be used to specify one or more files or directories
+# that contain example code fragments that are included (see the \include
+# command).
+
+EXAMPLE_PATH           =
+
+# If the value of the EXAMPLE_PATH tag contains directories, you can use the
+# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and
+# *.h) to filter out the source-files in the directories. If left blank all
+# files are included.
+
+EXAMPLE_PATTERNS       =
+
+# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be
+# searched for input files to be used with the \include or \dontinclude commands
+# irrespective of the value of the RECURSIVE tag.
+# The default value is: NO.
+
+EXAMPLE_RECURSIVE      = NO
+
+# The IMAGE_PATH tag can be used to specify one or more files or directories
+# that contain images that are to be included in the documentation (see the
+# \image command).
+
+IMAGE_PATH             = ./src/docsrc/Image
+
+# The INPUT_FILTER tag can be used to specify a program that doxygen should
+# invoke to filter for each input file. Doxygen will invoke the filter program
+# by executing (via popen()) the command:
+#
+# <filter> <input-file>
+#
+# where <filter> is the value of the INPUT_FILTER tag, and <input-file> is the
+# name of an input file. Doxygen will then use the output that the filter
+# program writes to standard output. If FILTER_PATTERNS is specified, this tag
+# will be ignored.
+#
+# Note that the filter must not add or remove lines; it is applied before the
+# code is scanned, but not when the output code is generated. If lines are added
+# or removed, the anchors will not be placed correctly.
+
+INPUT_FILTER           =
+
+# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern
+# basis. Doxygen will compare the file name with each pattern and apply the
+# filter if there is a match. The filters are a list of the form: pattern=filter
+# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how
+# filters are used. If the FILTER_PATTERNS tag is empty or if none of the
+# patterns match the file name, INPUT_FILTER is applied.
+
+FILTER_PATTERNS        =
+
+# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using
+# INPUT_FILTER ) will also be used to filter the input files that are used for
+# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES).
+# The default value is: NO.
+
+FILTER_SOURCE_FILES    = NO
+
+# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file
+# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and
+# it is also possible to disable source filtering for a specific pattern using
+# *.ext= (so without naming a filter).
+# This tag requires that the tag FILTER_SOURCE_FILES is set to YES.
+
+FILTER_SOURCE_PATTERNS =
+
+# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that
+# is part of the input, its contents will be placed on the main page
+# (index.html). This can be useful if you have a project on for instance GitHub
+# and want to reuse the introduction page also for the doxygen output.
+
+USE_MDFILE_AS_MAINPAGE =
+
+#---------------------------------------------------------------------------
+# Configuration options related to source browsing
+#---------------------------------------------------------------------------
+
+# If the SOURCE_BROWSER tag is set to YES then a list of source files will be
+# generated. Documented entities will be cross-referenced with these sources.
+#
+# Note: To get rid of all source code in the generated output, make sure that
+# also VERBATIM_HEADERS is set to NO.
+# The default value is: NO.
+
+SOURCE_BROWSER         = NO
+
+# Setting the INLINE_SOURCES tag to YES will include the body of functions,
+# classes and enums directly into the documentation.
+# The default value is: NO.
+
+INLINE_SOURCES         = NO
+
+# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any
+# special comment blocks from generated source code fragments. Normal C, C++ and
+# Fortran comments will always remain visible.
+# The default value is: YES.
+
+STRIP_CODE_COMMENTS    = YES
+
+# If the REFERENCED_BY_RELATION tag is set to YES then for each documented
+# function all documented functions referencing it will be listed.
+# The default value is: NO.
+
+REFERENCED_BY_RELATION = NO
+
+# If the REFERENCES_RELATION tag is set to YES then for each documented function
+# all documented entities called/used by that function will be listed.
+# The default value is: NO.
+
+REFERENCES_RELATION    = NO
+
+# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set
+# to YES, then the hyperlinks from functions in REFERENCES_RELATION and
+# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will
+# link to the documentation.
+# The default value is: YES.
+
+REFERENCES_LINK_SOURCE = YES
+
+# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the
+# source code will show a tooltip with additional information such as prototype,
+# brief description and links to the definition and documentation. Since this
+# will make the HTML file larger and loading of large files a bit slower, you
+# can opt to disable this feature.
+# The default value is: YES.
+# This tag requires that the tag SOURCE_BROWSER is set to YES.
+
+SOURCE_TOOLTIPS        = YES
+
+# If the USE_HTAGS tag is set to YES then the references to source code will
+# point to the HTML generated by the htags(1) tool instead of doxygen built-in
+# source browser. The htags tool is part of GNU's global source tagging system
+# (see http://www.gnu.org/software/global/global.html). You will need version
+# 4.8.6 or higher.
+#
+# To use it do the following:
+# - Install the latest version of global
+# - Enable SOURCE_BROWSER and USE_HTAGS in the config file
+# - Make sure the INPUT points to the root of the source tree
+# - Run doxygen as normal
+#
+# Doxygen will invoke htags (and that will in turn invoke gtags), so these
+# tools must be available from the command line (i.e. in the search path).
+#
+# The result: instead of the source browser generated by doxygen, the links to
+# source code will now point to the output of htags.
+# The default value is: NO.
+# This tag requires that the tag SOURCE_BROWSER is set to YES.
+
+USE_HTAGS              = NO
+
+# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a
+# verbatim copy of the header file for each class for which an include is
+# specified. Set to NO to disable this.
+# See also: Section \class.
+# The default value is: YES.
+
+VERBATIM_HEADERS       = YES
+
+#---------------------------------------------------------------------------
+# Configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+
+# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all
+# compounds will be generated. Enable this if the project contains a lot of
+# classes, structs, unions or interfaces.
+# The default value is: YES.
+
+ALPHABETICAL_INDEX     = NO
+
+# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in
+# which the alphabetical index list will be split.
+# Minimum value: 1, maximum value: 20, default value: 5.
+# This tag requires that the tag ALPHABETICAL_INDEX is set to YES.
+
+COLS_IN_ALPHA_INDEX    = 5
+
+# In case all classes in a project start with a common prefix, all classes will
+# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag
+# can be used to specify a prefix (or a list of prefixes) that should be ignored
+# while generating the index headers.
+# This tag requires that the tag ALPHABETICAL_INDEX is set to YES.
+
+IGNORE_PREFIX          =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the HTML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_HTML tag is set to YES doxygen will generate HTML output
+# The default value is: YES.
+
+GENERATE_HTML          = YES
+
+# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: html.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_OUTPUT            = html
+
+# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each
+# generated HTML page (for example: .htm, .php, .asp).
+# The default value is: .html.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_FILE_EXTENSION    = .html
+
+# The HTML_HEADER tag can be used to specify a user-defined HTML header file for
+# each generated HTML page. If the tag is left blank doxygen will generate a
+# standard header.
+#
+# To get valid HTML the header file that includes any scripts and style sheets
+# that doxygen needs, which is dependent on the configuration options used (e.g.
+# the setting GENERATE_TREEVIEW). It is highly recommended to start with a
+# default header using
+# doxygen -w html new_header.html new_footer.html new_stylesheet.css
+# YourConfigFile
+# and then modify the file new_header.html. See also section "Doxygen usage"
+# for information on how to generate the default header that doxygen normally
+# uses.
+# Note: The header is subject to change so you typically have to regenerate the
+# default header when upgrading to a newer version of doxygen. For a description
+# of the possible markers and block names see the documentation.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_HEADER            =
+
+# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each
+# generated HTML page. If the tag is left blank doxygen will generate a standard
+# footer. See HTML_HEADER for more information on how to generate a default
+# footer and what special commands can be used inside the footer. See also
+# section "Doxygen usage" for information on how to generate the default footer
+# that doxygen normally uses.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_FOOTER            =
+
+# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style
+# sheet that is used by each HTML page. It can be used to fine-tune the look of
+# the HTML output. If left blank doxygen will generate a default style sheet.
+# See also section "Doxygen usage" for information on how to generate the style
+# sheet that doxygen normally uses.
+# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as
+# it is more robust and this tag (HTML_STYLESHEET) will in the future become
+# obsolete.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_STYLESHEET        =
+
+# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined
+# cascading style sheets that are included after the standard style sheets
+# created by doxygen. Using this option one can overrule certain style aspects.
+# This is preferred over using HTML_STYLESHEET since it does not replace the
+# standard style sheet and is therefor more robust against future updates.
+# Doxygen will copy the style sheet files to the output directory.
+# Note: The order of the extra stylesheet files is of importance (e.g. the last
+# stylesheet in the list overrules the setting of the previous ones in the
+# list). For an example see the documentation.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_EXTRA_STYLESHEET  =
+
+# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or
+# other source files which should be copied to the HTML output directory. Note
+# that these files will be copied to the base HTML output directory. Use the
+# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these
+# files. In the HTML_STYLESHEET file, use the file name only. Also note that the
+# files will be copied as-is; there are no commands or markers available.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_EXTRA_FILES       =
+
+# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen
+# will adjust the colors in the stylesheet and background images according to
+# this color. Hue is specified as an angle on a colorwheel, see
+# http://en.wikipedia.org/wiki/Hue for more information. For instance the value
+# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300
+# purple, and 360 is red again.
+# Minimum value: 0, maximum value: 359, default value: 220.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_HUE    = 220
+
+# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors
+# in the HTML output. For a value of 0 the output will use grayscales only. A
+# value of 255 will produce the most vivid colors.
+# Minimum value: 0, maximum value: 255, default value: 100.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_SAT    = 100
+
+# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the
+# luminance component of the colors in the HTML output. Values below 100
+# gradually make the output lighter, whereas values above 100 make the output
+# darker. The value divided by 100 is the actual gamma applied, so 80 represents
+# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not
+# change the gamma.
+# Minimum value: 40, maximum value: 240, default value: 80.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_GAMMA  = 80
+
+# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML
+# page will contain the date and time when the page was generated. Setting this
+# to NO can help when comparing the output of multiple runs.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_TIMESTAMP         = YES
+
+# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML
+# documentation will contain sections that can be hidden and shown after the
+# page has loaded.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_DYNAMIC_SECTIONS  = NO
+
+# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries
+# shown in the various tree structured indices initially; the user can expand
+# and collapse entries dynamically later on. Doxygen will expand the tree to
+# such a level that at most the specified number of entries are visible (unless
+# a fully collapsed tree already exceeds this amount). So setting the number of
+# entries 1 will produce a full collapsed tree by default. 0 is a special value
+# representing an infinite number of entries and will result in a full expanded
+# tree by default.
+# Minimum value: 0, maximum value: 9999, default value: 100.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_INDEX_NUM_ENTRIES = 100
+
+# If the GENERATE_DOCSET tag is set to YES, additional index files will be
+# generated that can be used as input for Apple's Xcode 3 integrated development
+# environment (see: http://developer.apple.com/tools/xcode/), introduced with
+# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a
+# Makefile in the HTML output directory. Running make will produce the docset in
+# that directory and running make install will install the docset in
+# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at
+# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html
+# for more information.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_DOCSET        = NO
+
+# This tag determines the name of the docset feed. A documentation feed provides
+# an umbrella under which multiple documentation sets from a single provider
+# (such as a company or product suite) can be grouped.
+# The default value is: Doxygen generated docs.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_FEEDNAME        = "Doxygen generated docs"
+
+# This tag specifies a string that should uniquely identify the documentation
+# set bundle. This should be a reverse domain-name style string, e.g.
+# com.mycompany.MyDocSet. Doxygen will append .docset to the name.
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_BUNDLE_ID       = org.doxygen.Project
+
+# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify
+# the documentation publisher. This should be a reverse domain-name style
+# string, e.g. com.mycompany.MyDocSet.documentation.
+# The default value is: org.doxygen.Publisher.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_PUBLISHER_ID    = org.doxygen.Publisher
+
+# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher.
+# The default value is: Publisher.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_PUBLISHER_NAME  = Publisher
+
+# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three
+# additional HTML index files: index.hhp, index.hhc, and index.hhk. The
+# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop
+# (see: http://www.microsoft.com/en-us/download/details.aspx?id=21138) on
+# Windows.
+#
+# The HTML Help Workshop contains a compiler that can convert all HTML output
+# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML
+# files are now used as the Windows 98 help format, and will replace the old
+# Windows help format (.hlp) on all Windows platforms in the future. Compressed
+# HTML files also contain an index, a table of contents, and you can search for
+# words in the documentation. The HTML workshop also contains a viewer for
+# compressed HTML files.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_HTMLHELP      = NO
+
+# The CHM_FILE tag can be used to specify the file name of the resulting .chm
+# file. You can add a path in front of the file if the result should not be
+# written to the html output directory.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+CHM_FILE               =
+
+# The HHC_LOCATION tag can be used to specify the location (absolute path
+# including file name) of the HTML help compiler ( hhc.exe). If non-empty
+# doxygen will try to run the HTML help compiler on the generated index.hhp.
+# The file has to be specified with full path.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+HHC_LOCATION           =
+
+# The GENERATE_CHI flag controls if a separate .chi index file is generated (
+# YES) or that it should be included in the master .chm file ( NO).
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+GENERATE_CHI           = NO
+
+# The CHM_INDEX_ENCODING is used to encode HtmlHelp index ( hhk), content ( hhc)
+# and project file content.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+CHM_INDEX_ENCODING     =
+
+# The BINARY_TOC flag controls whether a binary table of contents is generated (
+# YES) or a normal table of contents ( NO) in the .chm file. Furthermore it
+# enables the Previous and Next buttons.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+BINARY_TOC             = NO
+
+# The TOC_EXPAND flag can be set to YES to add extra items for group members to
+# the table of contents of the HTML help documentation and to the tree view.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+TOC_EXPAND             = NO
+
+# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and
+# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that
+# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help
+# (.qch) of the generated HTML documentation.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_QHP           = NO
+
+# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify
+# the file name of the resulting .qch file. The path specified is relative to
+# the HTML output folder.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QCH_FILE               =
+
+# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help
+# Project output. For more information please see Qt Help Project / Namespace
+# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace).
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_NAMESPACE          = org.doxygen.Project
+
+# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt
+# Help Project output. For more information please see Qt Help Project / Virtual
+# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual-
+# folders).
+# The default value is: doc.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_VIRTUAL_FOLDER     = doc
+
+# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom
+# filter to add. For more information please see Qt Help Project / Custom
+# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom-
+# filters).
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_CUST_FILTER_NAME   =
+
+# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the
+# custom filter to add. For more information please see Qt Help Project / Custom
+# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom-
+# filters).
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_CUST_FILTER_ATTRS  =
+
+# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this
+# project's filter section matches. Qt Help Project / Filter Attributes (see:
+# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes).
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_SECT_FILTER_ATTRS  =
+
+# The QHG_LOCATION tag can be used to specify the location of Qt's
+# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the
+# generated .qhp file.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHG_LOCATION           =
+
+# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be
+# generated, together with the HTML files, they form an Eclipse help plugin. To
+# install this plugin and make it available under the help contents menu in
+# Eclipse, the contents of the directory containing the HTML and XML files needs
+# to be copied into the plugins directory of eclipse. The name of the directory
+# within the plugins directory should be the same as the ECLIPSE_DOC_ID value.
+# After copying Eclipse needs to be restarted before the help appears.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_ECLIPSEHELP   = NO
+
+# A unique identifier for the Eclipse help plugin. When installing the plugin
+# the directory name containing the HTML and XML files should also have this
+# name. Each documentation set should have its own identifier.
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES.
+
+ECLIPSE_DOC_ID         = org.doxygen.Project
+
+# If you want full control over the layout of the generated HTML pages it might
+# be necessary to disable the index and replace it with your own. The
+# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top
+# of each HTML page. A value of NO enables the index and the value YES disables
+# it. Since the tabs in the index contain the same information as the navigation
+# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+DISABLE_INDEX          = NO
+
+# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index
+# structure should be generated to display hierarchical information. If the tag
+# value is set to YES, a side panel will be generated containing a tree-like
+# index structure (just like the one that is generated for HTML Help). For this
+# to work a browser that supports JavaScript, DHTML, CSS and frames is required
+# (i.e. any modern browser). Windows users are probably better off using the
+# HTML help feature. Via custom stylesheets (see HTML_EXTRA_STYLESHEET) one can
+# further fine-tune the look of the index. As an example, the default style
+# sheet generated by doxygen has an example that shows how to put an image at
+# the root of the tree instead of the PROJECT_NAME. Since the tree basically has
+# the same information as the tab index, you could consider setting
+# DISABLE_INDEX to YES when enabling this option.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_TREEVIEW      = NO
+
+# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that
+# doxygen will group on one line in the generated HTML documentation.
+#
+# Note that a value of 0 will completely suppress the enum values from appearing
+# in the overview section.
+# Minimum value: 0, maximum value: 20, default value: 4.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+ENUM_VALUES_PER_LINE   = 4
+
+# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used
+# to set the initial width (in pixels) of the frame in which the tree is shown.
+# Minimum value: 0, maximum value: 1500, default value: 250.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+TREEVIEW_WIDTH         = 250
+
+# When the EXT_LINKS_IN_WINDOW option is set to YES doxygen will open links to
+# external symbols imported via tag files in a separate window.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+EXT_LINKS_IN_WINDOW    = NO
+
+# Use this tag to change the font size of LaTeX formulas included as images in
+# the HTML documentation. When you change the font size after a successful
+# doxygen run you need to manually remove any form_*.png images from the HTML
+# output directory to force them to be regenerated.
+# Minimum value: 8, maximum value: 50, default value: 10.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+FORMULA_FONTSIZE       = 10
+
+# Use the FORMULA_TRANPARENT tag to determine whether or not the images
+# generated for formulas are transparent PNGs. Transparent PNGs are not
+# supported properly for IE 6.0, but are supported on all modern browsers.
+#
+# Note that when changing this option you need to delete any form_*.png files in
+# the HTML output directory before the changes have effect.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+FORMULA_TRANSPARENT    = YES
+
+# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see
+# http://www.mathjax.org) which uses client side Javascript for the rendering
+# instead of using prerendered bitmaps. Use this if you do not have LaTeX
+# installed or if you want to formulas look prettier in the HTML output. When
+# enabled you may also need to install MathJax separately and configure the path
+# to it using the MATHJAX_RELPATH option.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+USE_MATHJAX            = NO
+
+# When MathJax is enabled you can set the default output format to be used for
+# the MathJax output. See the MathJax site (see:
+# http://docs.mathjax.org/en/latest/output.html) for more details.
+# Possible values are: HTML-CSS (which is slower, but has the best
+# compatibility), NativeMML (i.e. MathML) and SVG.
+# The default value is: HTML-CSS.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_FORMAT         = HTML-CSS
+
+# When MathJax is enabled you need to specify the location relative to the HTML
+# output directory using the MATHJAX_RELPATH option. The destination directory
+# should contain the MathJax.js script. For instance, if the mathjax directory
+# is located at the same level as the HTML output directory, then
+# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax
+# Content Delivery Network so you can quickly see the result without installing
+# MathJax. However, it is strongly recommended to install a local copy of
+# MathJax from http://www.mathjax.org before deployment.
+# The default value is: http://cdn.mathjax.org/mathjax/latest.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_RELPATH        = http://cdn.mathjax.org/mathjax/latest
+
+# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax
+# extension names that should be enabled during MathJax rendering. For example
+# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_EXTENSIONS     =
+
+# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces
+# of code that will be used on startup of the MathJax code. See the MathJax site
+# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an
+# example see the documentation.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_CODEFILE       =
+
+# When the SEARCHENGINE tag is enabled doxygen will generate a search box for
+# the HTML output. The underlying search engine uses javascript and DHTML and
+# should work on any modern browser. Note that when using HTML help
+# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET)
+# there is already a search function so this one should typically be disabled.
+# For large projects the javascript based search engine can be slow, then
+# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to
+# search using the keyboard; to jump to the search box use <access key> + S
+# (what the <access key> is depends on the OS and browser, but it is typically
+# <CTRL>, <ALT>/<option>, or both). Inside the search box use the <cursor down
+# key> to jump into the search results window, the results can be navigated
+# using the <cursor keys>. Press <Enter> to select an item or <escape> to cancel
+# the search. The filter options can be selected when the cursor is inside the
+# search box by pressing <Shift>+<cursor down>. Also here use the <cursor keys>
+# to select a filter and <Enter> or <escape> to activate or cancel the filter
+# option.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+SEARCHENGINE           = YES
+
+# When the SERVER_BASED_SEARCH tag is enabled the search engine will be
+# implemented using a web server instead of a web client using Javascript. There
+# are two flavors of web server based searching depending on the EXTERNAL_SEARCH
+# setting. When disabled, doxygen will generate a PHP script for searching and
+# an index file used by the script. When EXTERNAL_SEARCH is enabled the indexing
+# and searching needs to be provided by external tools. See the section
+# "External Indexing and Searching" for details.
+# The default value is: NO.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+SERVER_BASED_SEARCH    = NO
+
+# When EXTERNAL_SEARCH tag is enabled doxygen will no longer generate the PHP
+# script for searching. Instead the search results are written to an XML file
+# which needs to be processed by an external indexer. Doxygen will invoke an
+# external search engine pointed to by the SEARCHENGINE_URL option to obtain the
+# search results.
+#
+# Doxygen ships with an example indexer ( doxyindexer) and search engine
+# (doxysearch.cgi) which are based on the open source search engine library
+# Xapian (see: http://xapian.org/).
+#
+# See the section "External Indexing and Searching" for details.
+# The default value is: NO.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+EXTERNAL_SEARCH        = NO
+
+# The SEARCHENGINE_URL should point to a search engine hosted by a web server
+# which will return the search results when EXTERNAL_SEARCH is enabled.
+#
+# Doxygen ships with an example indexer ( doxyindexer) and search engine
+# (doxysearch.cgi) which are based on the open source search engine library
+# Xapian (see: http://xapian.org/). See the section "External Indexing and
+# Searching" for details.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+SEARCHENGINE_URL       =
+
+# When SERVER_BASED_SEARCH and EXTERNAL_SEARCH are both enabled the unindexed
+# search data is written to a file for indexing by an external tool. With the
+# SEARCHDATA_FILE tag the name of this file can be specified.
+# The default file is: searchdata.xml.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+SEARCHDATA_FILE        = searchdata.xml
+
+# When SERVER_BASED_SEARCH and EXTERNAL_SEARCH are both enabled the
+# EXTERNAL_SEARCH_ID tag can be used as an identifier for the project. This is
+# useful in combination with EXTRA_SEARCH_MAPPINGS to search through multiple
+# projects and redirect the results back to the right project.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+EXTERNAL_SEARCH_ID     =
+
+# The EXTRA_SEARCH_MAPPINGS tag can be used to enable searching through doxygen
+# projects other than the one defined by this configuration file, but that are
+# all added to the same external search index. Each project needs to have a
+# unique id set via EXTERNAL_SEARCH_ID. The search mapping then maps the id of
+# to a relative location where the documentation can be found. The format is:
+# EXTRA_SEARCH_MAPPINGS = tagname1=loc1 tagname2=loc2 ...
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+EXTRA_SEARCH_MAPPINGS  =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_LATEX tag is set to YES doxygen will generate LaTeX output.
+# The default value is: YES.
+
+GENERATE_LATEX         = YES
+
+# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: latex.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_OUTPUT           = latex
+
+# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be
+# invoked.
+#
+# Note that when enabling USE_PDFLATEX this option is only used for generating
+# bitmaps for formulas in the HTML output, but not in the Makefile that is
+# written to the output directory.
+# The default file is: latex.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_CMD_NAME         = latex
+
+# The MAKEINDEX_CMD_NAME tag can be used to specify the command name to generate
+# index for LaTeX.
+# The default file is: makeindex.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+MAKEINDEX_CMD_NAME     = makeindex
+
+# If the COMPACT_LATEX tag is set to YES doxygen generates more compact LaTeX
+# documents. This may be useful for small projects and may help to save some
+# trees in general.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+COMPACT_LATEX          = NO
+
+# The PAPER_TYPE tag can be used to set the paper type that is used by the
+# printer.
+# Possible values are: a4 (210 x 297 mm), letter (8.5 x 11 inches), legal (8.5 x
+# 14 inches) and executive (7.25 x 10.5 inches).
+# The default value is: a4.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+PAPER_TYPE             = a4
+
+# The EXTRA_PACKAGES tag can be used to specify one or more LaTeX package names
+# that should be included in the LaTeX output. To get the times font for
+# instance you can specify
+# EXTRA_PACKAGES=times
+# If left blank no extra packages will be included.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+EXTRA_PACKAGES         =
+
+# The LATEX_HEADER tag can be used to specify a personal LaTeX header for the
+# generated LaTeX document. The header should contain everything until the first
+# chapter. If it is left blank doxygen will generate a standard header. See
+# section "Doxygen usage" for information on how to let doxygen write the
+# default header to a separate file.
+#
+# Note: Only use a user-defined header if you know what you are doing! The
+# following commands have a special meaning inside the header: $title,
+# $datetime, $date, $doxygenversion, $projectname, $projectnumber,
+# $projectbrief, $projectlogo. Doxygen will replace $title with the empy string,
+# for the replacement values of the other commands the user is refered to
+# HTML_HEADER.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_HEADER           =
+
+# The LATEX_FOOTER tag can be used to specify a personal LaTeX footer for the
+# generated LaTeX document. The footer should contain everything after the last
+# chapter. If it is left blank doxygen will generate a standard footer. See
+# LATEX_HEADER for more information on how to generate a default footer and what
+# special commands can be used inside the footer.
+#
+# Note: Only use a user-defined footer if you know what you are doing!
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_FOOTER           =
+
+# The LATEX_EXTRA_FILES tag can be used to specify one or more extra images or
+# other source files which should be copied to the LATEX_OUTPUT output
+# directory. Note that the files will be copied as-is; there are no commands or
+# markers available.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_EXTRA_FILES      =
+
+# If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated is
+# prepared for conversion to PDF (using ps2pdf or pdflatex). The PDF file will
+# contain links (just like the HTML output) instead of page references. This
+# makes the output suitable for online browsing using a PDF viewer.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+PDF_HYPERLINKS         = YES
+
+# If the USE_PDFLATEX tag is set to YES, doxygen will use pdflatex to generate
+# the PDF file directly from the LaTeX files. Set this option to YES to get a
+# higher quality PDF documentation.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+USE_PDFLATEX           = YES
+
+# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \batchmode
+# command to the generated LaTeX files. This will instruct LaTeX to keep running
+# if errors occur, instead of asking the user for help. This option is also used
+# when generating formulas in HTML.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_BATCHMODE        = NO
+
+# If the LATEX_HIDE_INDICES tag is set to YES then doxygen will not include the
+# index chapters (such as File Index, Compound Index, etc.) in the output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_HIDE_INDICES     = NO
+
+# If the LATEX_SOURCE_CODE tag is set to YES then doxygen will include source
+# code with syntax highlighting in the LaTeX output.
+#
+# Note that which sources are shown also depends on other settings such as
+# SOURCE_BROWSER.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_SOURCE_CODE      = NO
+
+# The LATEX_BIB_STYLE tag can be used to specify the style to use for the
+# bibliography, e.g. plainnat, or ieeetr. See
+# http://en.wikipedia.org/wiki/BibTeX and \cite for more info.
+# The default value is: plain.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_BIB_STYLE        = plain
+
+#---------------------------------------------------------------------------
+# Configuration options related to the RTF output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_RTF tag is set to YES doxygen will generate RTF output. The
+# RTF output is optimized for Word 97 and may not look too pretty with other RTF
+# readers/editors.
+# The default value is: NO.
+
+GENERATE_RTF           = NO
+
+# The RTF_OUTPUT tag is used to specify where the RTF docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: rtf.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_OUTPUT             = rtf
+
+# If the COMPACT_RTF tag is set to YES doxygen generates more compact RTF
+# documents. This may be useful for small projects and may help to save some
+# trees in general.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+COMPACT_RTF            = NO
+
+# If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated will
+# contain hyperlink fields. The RTF file will contain links (just like the HTML
+# output) instead of page references. This makes the output suitable for online
+# browsing using Word or some other Word compatible readers that support those
+# fields.
+#
+# Note: WordPad (write) and others do not support links.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_HYPERLINKS         = NO
+
+# Load stylesheet definitions from file. Syntax is similar to doxygen's config
+# file, i.e. a series of assignments. You only have to provide replacements,
+# missing definitions are set to their default value.
+#
+# See also section "Doxygen usage" for information on how to generate the
+# default style sheet that doxygen normally uses.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_STYLESHEET_FILE    =
+
+# Set optional variables used in the generation of an RTF document. Syntax is
+# similar to doxygen's config file. A template extensions file can be generated
+# using doxygen -e rtf extensionFile.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_EXTENSIONS_FILE    =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the man page output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_MAN tag is set to YES doxygen will generate man pages for
+# classes and files.
+# The default value is: NO.
+
+GENERATE_MAN           = NO
+
+# The MAN_OUTPUT tag is used to specify where the man pages will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it. A directory man3 will be created inside the directory specified by
+# MAN_OUTPUT.
+# The default directory is: man.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_OUTPUT             = man
+
+# The MAN_EXTENSION tag determines the extension that is added to the generated
+# man pages. In case the manual section does not start with a number, the number
+# 3 is prepended. The dot (.) at the beginning of the MAN_EXTENSION tag is
+# optional.
+# The default value is: .3.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_EXTENSION          = .3
+
+# The MAN_SUBDIR tag determines the name of the directory created within
+# MAN_OUTPUT in which the man pages are placed. If defaults to man followed by
+# MAN_EXTENSION with the initial . removed.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_SUBDIR             =
+
+# If the MAN_LINKS tag is set to YES and doxygen generates man output, then it
+# will generate one additional man file for each entity documented in the real
+# man page(s). These additional files only source the real man page, but without
+# them the man command would be unable to find the correct page.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_LINKS              = NO
+
+#---------------------------------------------------------------------------
+# Configuration options related to the XML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_XML tag is set to YES doxygen will generate an XML file that
+# captures the structure of the code including all documentation.
+# The default value is: NO.
+
+GENERATE_XML           = NO
+
+# The XML_OUTPUT tag is used to specify where the XML pages will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: xml.
+# This tag requires that the tag GENERATE_XML is set to YES.
+
+XML_OUTPUT             = xml
+
+# If the XML_PROGRAMLISTING tag is set to YES doxygen will dump the program
+# listings (including syntax highlighting and cross-referencing information) to
+# the XML output. Note that enabling this will significantly increase the size
+# of the XML output.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_XML is set to YES.
+
+XML_PROGRAMLISTING     = YES
+
+#---------------------------------------------------------------------------
+# Configuration options related to the DOCBOOK output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_DOCBOOK tag is set to YES doxygen will generate Docbook files
+# that can be used to generate PDF.
+# The default value is: NO.
+
+GENERATE_DOCBOOK       = NO
+
+# The DOCBOOK_OUTPUT tag is used to specify where the Docbook pages will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be put in
+# front of it.
+# The default directory is: docbook.
+# This tag requires that the tag GENERATE_DOCBOOK is set to YES.
+
+DOCBOOK_OUTPUT         = docbook
+
+# If the DOCBOOK_PROGRAMLISTING tag is set to YES doxygen will include the
+# program listings (including syntax highlighting and cross-referencing
+# information) to the DOCBOOK output. Note that enabling this will significantly
+# increase the size of the DOCBOOK output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_DOCBOOK is set to YES.
+
+DOCBOOK_PROGRAMLISTING = NO
+
+#---------------------------------------------------------------------------
+# Configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_AUTOGEN_DEF tag is set to YES doxygen will generate an AutoGen
+# Definitions (see http://autogen.sf.net) file that captures the structure of
+# the code including all documentation. Note that this feature is still
+# experimental and incomplete at the moment.
+# The default value is: NO.
+
+GENERATE_AUTOGEN_DEF   = NO
+
+#---------------------------------------------------------------------------
+# Configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_PERLMOD tag is set to YES doxygen will generate a Perl module
+# file that captures the structure of the code including all documentation.
+#
+# Note that this feature is still experimental and incomplete at the moment.
+# The default value is: NO.
+
+GENERATE_PERLMOD       = NO
+
+# If the PERLMOD_LATEX tag is set to YES doxygen will generate the necessary
+# Makefile rules, Perl scripts and LaTeX code to be able to generate PDF and DVI
+# output from the Perl module output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_PERLMOD is set to YES.
+
+PERLMOD_LATEX          = NO
+
+# If the PERLMOD_PRETTY tag is set to YES the Perl module output will be nicely
+# formatted so it can be parsed by a human reader. This is useful if you want to
+# understand what is going on. On the other hand, if this tag is set to NO the
+# size of the Perl module output will be much smaller and Perl will parse it
+# just the same.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_PERLMOD is set to YES.
+
+PERLMOD_PRETTY         = YES
+
+# The names of the make variables in the generated doxyrules.make file are
+# prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX. This is useful
+# so different doxyrules.make files included by the same Makefile don't
+# overwrite each other's variables.
+# This tag requires that the tag GENERATE_PERLMOD is set to YES.
+
+PERLMOD_MAKEVAR_PREFIX =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor
+#---------------------------------------------------------------------------
+
+# If the ENABLE_PREPROCESSING tag is set to YES doxygen will evaluate all
+# C-preprocessor directives found in the sources and include files.
+# The default value is: YES.
+
+ENABLE_PREPROCESSING   = YES
+
+# If the MACRO_EXPANSION tag is set to YES doxygen will expand all macro names
+# in the source code. If set to NO only conditional compilation will be
+# performed. Macro expansion can be done in a controlled way by setting
+# EXPAND_ONLY_PREDEF to YES.
+# The default value is: NO.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+MACRO_EXPANSION        = NO
+
+# If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES then
+# the macro expansion is limited to the macros specified with the PREDEFINED and
+# EXPAND_AS_DEFINED tags.
+# The default value is: NO.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+EXPAND_ONLY_PREDEF     = NO
+
+# If the SEARCH_INCLUDES tag is set to YES the includes files in the
+# INCLUDE_PATH will be searched if a #include is found.
+# The default value is: YES.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+SEARCH_INCLUDES        = YES
+
+# The INCLUDE_PATH tag can be used to specify one or more directories that
+# contain include files that are not input files but should be processed by the
+# preprocessor.
+# This tag requires that the tag SEARCH_INCLUDES is set to YES.
+
+INCLUDE_PATH           =
+
+# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard
+# patterns (like *.h and *.hpp) to filter out the header-files in the
+# directories. If left blank, the patterns specified with FILE_PATTERNS will be
+# used.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+INCLUDE_FILE_PATTERNS  =
+
+# The PREDEFINED tag can be used to specify one or more macro names that are
+# defined before the preprocessor is started (similar to the -D option of e.g.
+# gcc). The argument of the tag is a list of macros of the form: name or
+# name=definition (no spaces). If the definition and the "=" are omitted, "=1"
+# is assumed. To prevent a macro definition from being undefined via #undef or
+# recursively expanded use the := operator instead of the = operator.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+PREDEFINED             =
+
+# If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then this
+# tag can be used to specify a list of macro names that should be expanded. The
+# macro definition that is found in the sources will be used. Use the PREDEFINED
+# tag if you want to use a different macro definition that overrules the
+# definition found in the source code.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+EXPAND_AS_DEFINED      =
+
+# If the SKIP_FUNCTION_MACROS tag is set to YES then doxygen's preprocessor will
+# remove all references to function-like macros that are alone on a line, have
+# an all uppercase name, and do not end with a semicolon. Such function macros
+# are typically used for boiler-plate code, and will confuse the parser if not
+# removed.
+# The default value is: YES.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+SKIP_FUNCTION_MACROS   = YES
+
+#---------------------------------------------------------------------------
+# Configuration options related to external references
+#---------------------------------------------------------------------------
+
+# The TAGFILES tag can be used to specify one or more tag files. For each tag
+# file the location of the external documentation should be added. The format of
+# a tag file without this location is as follows:
+# TAGFILES = file1 file2 ...
+# Adding location for the tag files is done as follows:
+# TAGFILES = file1=loc1 "file2 = loc2" ...
+# where loc1 and loc2 can be relative or absolute paths or URLs. See the
+# section "Linking to external documentation" for more information about the use
+# of tag files.
+# Note: Each tag file must have a unique name (where the name does NOT include
+# the path). If a tag file is not located in the directory in which doxygen is
+# run, you must also specify the path to the tagfile here.
+
+TAGFILES               =
+
+# When a file name is specified after GENERATE_TAGFILE, doxygen will create a
+# tag file that is based on the input files it reads. See section "Linking to
+# external documentation" for more information about the usage of tag files.
+
+GENERATE_TAGFILE       =
+
+# If the ALLEXTERNALS tag is set to YES all external class will be listed in the
+# class index. If set to NO only the inherited external classes will be listed.
+# The default value is: NO.
+
+ALLEXTERNALS           = NO
+
+# If the EXTERNAL_GROUPS tag is set to YES all external groups will be listed in
+# the modules index. If set to NO, only the current project's groups will be
+# listed.
+# The default value is: YES.
+
+EXTERNAL_GROUPS        = YES
+
+# If the EXTERNAL_PAGES tag is set to YES all external pages will be listed in
+# the related pages index. If set to NO, only the current project's pages will
+# be listed.
+# The default value is: YES.
+
+EXTERNAL_PAGES         = YES
+
+# The PERL_PATH should be the absolute path and name of the perl script
+# interpreter (i.e. the result of 'which perl').
+# The default file (with absolute path) is: /usr/bin/perl.
+
+PERL_PATH              = /usr/bin/perl
+
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool
+#---------------------------------------------------------------------------
+
+# If the CLASS_DIAGRAMS tag is set to YES doxygen will generate a class diagram
+# (in HTML and LaTeX) for classes with base or super classes. Setting the tag to
+# NO turns the diagrams off. Note that this option also works with HAVE_DOT
+# disabled, but it is recommended to install and use dot, since it yields more
+# powerful graphs.
+# The default value is: YES.
+
+CLASS_DIAGRAMS         = YES
+
+# You can define message sequence charts within doxygen comments using the \msc
+# command. Doxygen will then run the mscgen tool (see:
+# http://www.mcternan.me.uk/mscgen/)) to produce the chart and insert it in the
+# documentation. The MSCGEN_PATH tag allows you to specify the directory where
+# the mscgen tool resides. If left empty the tool is assumed to be found in the
+# default search path.
+
+MSCGEN_PATH            =
+
+# You can include diagrams made with dia in doxygen documentation. Doxygen will
+# then run dia to produce the diagram and insert it in the documentation. The
+# DIA_PATH tag allows you to specify the directory where the dia binary resides.
+# If left empty dia is assumed to be found in the default search path.
+
+DIA_PATH               =
+
+# If set to YES, the inheritance and collaboration graphs will hide inheritance
+# and usage relations if the target is undocumented or is not a class.
+# The default value is: YES.
+
+HIDE_UNDOC_RELATIONS   = YES
+
+# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is
+# available from the path. This tool is part of Graphviz (see:
+# http://www.graphviz.org/), a graph visualization toolkit from AT&T and Lucent
+# Bell Labs. The other options in this section have no effect if this option is
+# set to NO
+# The default value is: NO.
+
+HAVE_DOT               = NO
+
+# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is allowed
+# to run in parallel. When set to 0 doxygen will base this on the number of
+# processors available in the system. You can set it explicitly to a value
+# larger than 0 to get control over the balance between CPU load and processing
+# speed.
+# Minimum value: 0, maximum value: 32, default value: 0.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_NUM_THREADS        = 0
+
+# When you want a differently looking font in the dot files that doxygen
+# generates you can specify the font name using DOT_FONTNAME. You need to make
+# sure dot is able to find the font, which can be done by putting it in a
+# standard location or by setting the DOTFONTPATH environment variable or by
+# setting DOT_FONTPATH to the directory containing the font.
+# The default value is: Helvetica.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_FONTNAME           = Helvetica
+
+# The DOT_FONTSIZE tag can be used to set the size (in points) of the font of
+# dot graphs.
+# Minimum value: 4, maximum value: 24, default value: 10.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_FONTSIZE           = 10
+
+# By default doxygen will tell dot to use the default font as specified with
+# DOT_FONTNAME. If you specify a different font using DOT_FONTNAME you can set
+# the path where dot can find it using this tag.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_FONTPATH           =
+
+# If the CLASS_GRAPH tag is set to YES then doxygen will generate a graph for
+# each documented class showing the direct and indirect inheritance relations.
+# Setting this tag to YES will force the CLASS_DIAGRAMS tag to NO.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+CLASS_GRAPH            = YES
+
+# If the COLLABORATION_GRAPH tag is set to YES then doxygen will generate a
+# graph for each documented class showing the direct and indirect implementation
+# dependencies (inheritance, containment, and class references variables) of the
+# class with other documented classes.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+COLLABORATION_GRAPH    = YES
+
+# If the GROUP_GRAPHS tag is set to YES then doxygen will generate a graph for
+# groups, showing the direct groups dependencies.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+GROUP_GRAPHS           = YES
+
+# If the UML_LOOK tag is set to YES doxygen will generate inheritance and
+# collaboration diagrams in a style similar to the OMG's Unified Modeling
+# Language.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+UML_LOOK               = YES
+
+# If the UML_LOOK tag is enabled, the fields and methods are shown inside the
+# class node. If there are many fields or methods and many nodes the graph may
+# become too big to be useful. The UML_LIMIT_NUM_FIELDS threshold limits the
+# number of items for each type to make the size more manageable. Set this to 0
+# for no limit. Note that the threshold may be exceeded by 50% before the limit
+# is enforced. So when you set the threshold to 10, up to 15 fields may appear,
+# but if the number exceeds 15, the total amount of fields shown is limited to
+# 10.
+# Minimum value: 0, maximum value: 100, default value: 10.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+UML_LIMIT_NUM_FIELDS   = 10
+
+# If the TEMPLATE_RELATIONS tag is set to YES then the inheritance and
+# collaboration graphs will show the relations between templates and their
+# instances.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+TEMPLATE_RELATIONS     = NO
+
+# If the INCLUDE_GRAPH, ENABLE_PREPROCESSING and SEARCH_INCLUDES tags are set to
+# YES then doxygen will generate a graph for each documented file showing the
+# direct and indirect include dependencies of the file with other documented
+# files.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+INCLUDE_GRAPH          = YES
+
+# If the INCLUDED_BY_GRAPH, ENABLE_PREPROCESSING and SEARCH_INCLUDES tags are
+# set to YES then doxygen will generate a graph for each documented file showing
+# the direct and indirect include dependencies of the file with other documented
+# files.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+INCLUDED_BY_GRAPH      = YES
+
+# If the CALL_GRAPH tag is set to YES then doxygen will generate a call
+# dependency graph for every global function or class method.
+#
+# Note that enabling this option will significantly increase the time of a run.
+# So in most cases it will be better to enable call graphs for selected
+# functions only using the \callgraph command.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+CALL_GRAPH             = NO
+
+# If the CALLER_GRAPH tag is set to YES then doxygen will generate a caller
+# dependency graph for every global function or class method.
+#
+# Note that enabling this option will significantly increase the time of a run.
+# So in most cases it will be better to enable caller graphs for selected
+# functions only using the \callergraph command.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+CALLER_GRAPH           = NO
+
+# If the GRAPHICAL_HIERARCHY tag is set to YES then doxygen will graphical
+# hierarchy of all classes instead of a textual one.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+GRAPHICAL_HIERARCHY    = YES
+
+# If the DIRECTORY_GRAPH tag is set to YES then doxygen will show the
+# dependencies a directory has on other directories in a graphical way. The
+# dependency relations are determined by the #include relations between the
+# files in the directories.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DIRECTORY_GRAPH        = YES
+
+# The DOT_IMAGE_FORMAT tag can be used to set the image format of the images
+# generated by dot.
+# Note: If you choose svg you need to set HTML_FILE_EXTENSION to xhtml in order
+# to make the SVG files visible in IE 9+ (other browsers do not have this
+# requirement).
+# Possible values are: png, jpg, gif and svg.
+# The default value is: png.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_IMAGE_FORMAT       = png
+
+# If DOT_IMAGE_FORMAT is set to svg, then this option can be set to YES to
+# enable generation of interactive SVG images that allow zooming and panning.
+#
+# Note that this requires a modern browser other than Internet Explorer. Tested
+# and working are Firefox, Chrome, Safari, and Opera.
+# Note: For IE 9+ you need to set HTML_FILE_EXTENSION to xhtml in order to make
+# the SVG files visible. Older versions of IE do not have SVG support.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+INTERACTIVE_SVG        = NO
+
+# The DOT_PATH tag can be used to specify the path where the dot tool can be
+# found. If left blank, it is assumed the dot tool can be found in the path.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_PATH               =
+
+# The DOTFILE_DIRS tag can be used to specify one or more directories that
+# contain dot files that are included in the documentation (see the \dotfile
+# command).
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOTFILE_DIRS           =
+
+# The MSCFILE_DIRS tag can be used to specify one or more directories that
+# contain msc files that are included in the documentation (see the \mscfile
+# command).
+
+MSCFILE_DIRS           =
+
+# The DIAFILE_DIRS tag can be used to specify one or more directories that
+# contain dia files that are included in the documentation (see the \diafile
+# command).
+
+DIAFILE_DIRS           =
+
+# When using plantuml, the PLANTUML_JAR_PATH tag should be used to specify the
+# path where java can find the plantuml.jar file. If left blank, it is assumed
+# PlantUML is not used or called during a preprocessing step. Doxygen will
+# generate a warning when it encounters a \startuml command in this case and
+# will not generate output for the diagram.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+PLANTUML_JAR_PATH      =
+
+# The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of nodes
+# that will be shown in the graph. If the number of nodes in a graph becomes
+# larger than this value, doxygen will truncate the graph, which is visualized
+# by representing a node as a red box. Note that doxygen if the number of direct
+# children of the root node in a graph is already larger than
+# DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note that
+# the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH.
+# Minimum value: 0, maximum value: 10000, default value: 50.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_GRAPH_MAX_NODES    = 50
+
+# The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the graphs
+# generated by dot. A depth value of 3 means that only nodes reachable from the
+# root by following a path via at most 3 edges will be shown. Nodes that lay
+# further from the root node will be omitted. Note that setting this option to 1
+# or 2 may greatly reduce the computation time needed for large code bases. Also
+# note that the size of a graph can be further restricted by
+# DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction.
+# Minimum value: 0, maximum value: 1000, default value: 0.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+MAX_DOT_GRAPH_DEPTH    = 0
+
+# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent
+# background. This is disabled by default, because dot on Windows does not seem
+# to support this out of the box.
+#
+# Warning: Depending on the platform used, enabling this option may lead to
+# badly anti-aliased labels on the edges of a graph (i.e. they become hard to
+# read).
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_TRANSPARENT        = NO
+
+# Set the DOT_MULTI_TARGETS tag to YES allow dot to generate multiple output
+# files in one run (i.e. multiple -o and -T options on the command line). This
+# makes dot run faster, but since only newer versions of dot (>1.8.10) support
+# this, this feature is disabled by default.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_MULTI_TARGETS      = NO
+
+# If the GENERATE_LEGEND tag is set to YES doxygen will generate a legend page
+# explaining the meaning of the various boxes and arrows in the dot generated
+# graphs.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+GENERATE_LEGEND        = YES
+
+# If the DOT_CLEANUP tag is set to YES doxygen will remove the intermediate dot
+# files that are used to generate the various graphs.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_CLEANUP            = YES
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/README	(revision 8732)
@@ -0,0 +1,7 @@
+
+To create SIREN documentation, run doxygen in TOOLS/SIREN directory 
+(http://www.stack.nl/~dimitri/doxygen/index.html version 1.8.3.1 or upper)
+then
+   open ./TOOLS/SIREN/doc/html/index.html in your web browser
+or 
+   run gmake in ./TOOLS/SIREN/doc/latex directory and open ./TOOLS/SIREN/doc/latex/refman.pdf 
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg	(revision 8732)
@@ -0,0 +1,6 @@
+&namdim
+   cn_dimX="x","xaxis"
+   cn_dimY="y","yaxis"
+   cn_dimZ="z","deptht","depthu","depthv","depthw","ncatice"
+   cn_dimT="t","time","time_counter"
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg	(revision 8732)
@@ -0,0 +1,5 @@
+&namdum
+   cn_dumvar="orca_lon", "orca_lat", "time_instant", "time_centered"
+   cn_dumdim=""
+   cn_dumatt="history"
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg	(revision 8732)
@@ -0,0 +1,165 @@
+# name       | units          | axis | pt| interpolation   | long name                             | standard name                                  
+X            | unitless       | X    |   |                 |                                       | projection_x_coordinate               
+Y            | unitless       | Y    |   |                 |                                       | projection_y_coordinate               
+Z            | unitless       | Z    |   |                 |                                       | projection_z_coordinate               
+T            | unitless       | T    |   |                 |                                       | projection_t_coordinate               
+nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                   
+nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                         
+nav_lev      | model_levels   | Z    | T | cubic           | Model levels                          |                                  
+deptht       | m              | Z    | T |                 | Vertical T levels                     | depth                            
+ncatice      | 1              | Z    | T |                 | Ice category                          | num_icecat_coordinate
+time_counter |                | T    |   |                 | Time axis                             | time                             
+Bathymetry   | m              | XY   | T | cubic           | Bathymetry                            | bathymetry                       
+votemper     | degree_Celsius | XYZT | T | cubic           | Temperature                           | sea_water_potential_temperature  
+vozocrtx     | m s-1          | XYZT | U | cubic           | Zonal velocity                        |                                  
+vomecrty     | m s-1          | XYZT | V | cubic           | Meridional velocity                   |                                  
+vosaline     | PSU            | XYZT | T | cubic           | Salinity                              | sea_water_salinity               
+sossheig     | m              | XYT  | T | cubic           | Sea Surface Height                    | sea_surface_height               
+sotemper     | m              | XYT  | T | cubic           |                                       |                                  
+sossheig     | m              | XYT  | T | cubic           |                                       |                                  
+glamt        | degrees_east   | XY   | T | cubic           | Longitude_T                           |                                  
+glamu        | degrees_east   | XY   | U | cubic           | Longitude_U                           |                                   
+glamv        | degrees_east   | XY   | V | cubic           | Longitude_V                           |                                  
+glamf        | degrees_east   | XY   | F | cubic           | Longitude_F                           |                                  
+gphit        | degrees_north  | XY   | T | cubic           | Latitude_T                            |                                  
+gphiu        | degrees_north  | XY   | U | cubic           | Latitude_U                            |                                  
+gphiv        | degrees_north  | XY   | V | cubic           | Latitude_V                            |                                  
+gphif        | degrees_north  | XY   | F | cubic           | Latitude_F                            |                                  
+e1t          | m              | XY   | T | cubic/rhoi      |                                       |                                  
+e1u          | m              | XY   | U | cubic/rhoi      |                                       |                                  
+e1v          | m              | XY   | V | cubic/rhoi      |                                       |                                  
+e1f          | m              | XY   | F | cubic/rhoi      |                                       |                                  
+e2t          | m              | XY   | T | cubic/rhoj      |                                       |                                  
+e2u          | m              | XY   | U | cubic/rhoj      |                                       |                                  
+e2v          | m              | XY   | V | cubic/rhoj      |                                       |                                  
+e2f          | m              | XY   | F | cubic/rhoj      |                                       |                                  
+tmask        |                | XYZ  | T | nearest         |                                       |                                  
+umask        |                | XYZ  | U | nearest         |                                       |                                  
+vmask        |                | XYZ  | V | nearest         |                                       |                                  
+fmask        |                | XYZ  | F | nearest         |                                       |                                  
+weight       |                | XY   | T |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+ndastp       |                |      |   |                 |                                       |                                  
+adatrj       |                |      |   |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+rdt          |                |      |   |                 |                                       |                                  
+rdttra1      |                |      |   |                 |                                       |                                  
+utau_b       |                | XY   | U |                 |                                       |surface_downward_eastward_stress  
+vtau_b       |                | XY   | V |                 |                                       |surface_downward_northward_stress 
+qns_b        |                | XY   | T |                 |                                       |                                  
+emp_b        |                | XY   | T |                 |                                       |                                  
+sfx_b        |                | XY   | T |                 |                                       |                                  
+en           |                | XYZ  | T |                 |                                       |                                  
+avt          |                | XYZ  | T |                 | vertical eddy diffusivity             |                                  
+avm          |                | XYZ  | T |                 | vertical eddy viscosity               |                                  
+avmu         |                | XYZ  | T |                 |                                       |                                  
+avmv         |                | XYZ  | T |                 |                                       |                                  
+dissl        |                | XYZ  | T |                 |                                       |                                  
+sbc_hc_b     |                | XY   | T |                 |                                       |                                  
+sbc_sc_b     |                | XY   | T |                 |                                       |                                  
+gcx          |                | XY   | T |                 |                                       |                                  
+gcxb         |                | XY   | T |                 |                                       |                                  
+ub           |                | XYZ  | U |                 |                                       |                                  
+vb           |                | XYZ  | V |                 |                                       |                                  
+tb           |                | XYZ  | T |                 |                                       |                                  
+sb           |                | XYZ  | T |                 |                                       |                                  
+rotb         |                | XYZ  | T |                 |                                       |                                  
+hdivb        |                | XYZ  | T |                 |                                       |                                  
+sshb         |                | XY   | T |                 |                                       |                                  
+un           |                | XYZ  | U |                 |                                       |                                  
+vn           |                | XYZ  | V |                 |                                       |                                  
+tn           |                | XYZ  | T |                 |                                       |                                  
+sn           |                | XYZ  | T |                 |                                       |                                  
+rotn         |                | XYZ  | T |                 |                                       |                                  
+hdivn        |                | XYZ  | T |                 |                                       |                                  
+sshn         |                | XYT  | T |                 |                                       |                                  
+rhop         |                | XYZ  | T |                 |                                       |                                  
+dic          |                | XYZT | T |                 | Dissolved Inorganic Carbon            | mole_concentration_of_dissolved_inorganic_caron_in_sea_water
+alkalini     |                | XYZT | T |                 | Total Alkalinity                      | sea_water_alkalinity_expressed_as_mole_equivalent
+o2           |                | XYZT | T |                 | Dissolved Oxygen                      | mole_concentration_of_dissolved_molecular_oxygen_in_sea_water
+caco3        |                | XYZT | T |                 | Calcite                               |                                  
+po4          |                | XYZT | T |                 | Phosphate                             | mole_concentration_of_phosphate_in_sea_water
+poc          |                | XYZT | T |                 | Small Particulate Organic Carbon      |                                  
+si           |                | XYZT | T |                 | Dissolved Silicate                    | mole_concentration_of_silicate_in_sea_water
+phy          |                | XYZT | T |                 | Nanophytoplankton                     |                                  
+zoo          |                | XYZT | T |                 | Microzooplankton                      | mole_concentration_of_microzooplankton_expressed_as_carbon_in_sea_water
+doc          |                | XYZT | T |                 | Dissolved Organic Carbon              |                                  
+phy2         |                | XYZT | T |                 | Diatoms                               |                                  
+zoo2         |                | XYZT | T |                 | Mesozooplankton                       | mole_concentration_of_mesozooplankton_expressed_as_carbon_in_sea_water
+gsi          |                | XYZT | T |                 | Sinking biogenic Silica               |                                  
+fer          |                | XYZT | T |                 | Dissolved Iron                        | mole_concentration_of_dissolved_iron_in_sea_water
+bfe          |                | XYZT | T |                 | Iron in the big particles             |                                  
+goc          |                | XYZT | T |                 | Big Particulate Organic Carbon        |                                  
+sfe          |                | XYZT | T |                 | Iron in the small particles           |                                  
+dfe          |                | XYZT | T |                 | Iron content of the Diatoms           |                                  
+dsi          |                | XYZT | T |                 | Silicon content of the Diatoms        |                                  
+nfe          |                | XYZT | T |                 | Iron content of the Nanophytoplankton |                                  
+nchl         |                | XYZT | T |                 | Chlorophyll of the Nanophytoplankton  |                                  
+dchl         |                | XYZT | T |                 | Chlorophyll of the Diatoms            |                                  
+no3          |                | XYZT | T |                 | Nitrate                               | mole_concentration_of_nitrate_in_sea_water
+nh4          |                | XYZT | T |                 | Ammonium                              | mole_concentration_of_ammonium_in_sea_water
+ppd          |                | XYZT | T |                 |                                       |                                  
+ppn          |                | XYZT | T |                 |                                       |                                  
+ph           |                | XYZT | T |                 |                                       |                                  
+cflx         |                | XYZT | T |                 |                                       |                                  
+oflx         |                | XYZT | T |                 |                                       |                                  
+kg           |                | XYZT | T |                 |                                       |                                  
+dpco2        |                | XYZT | T |                 |                                       |                                  
+heup         |                | XYZT | T |                 |                                       |                                  
+kz           |                | XYZT | T |                 |                                       |                                  
+irondep      |                | XYZT | T |                 |                                       |                                  
+sivelu       | m/s            | XYT  | T |                 | Ice velocity along i-axis at I-point  | sea_ice_x_velocity
+sivelv       | m/s            | XYT  | T |                 | Ice velocity along j-axis at I-point  | sea_ice_y_velocity
+siconcat     | %              | XYZT | T |                 | Ice concentration for categories      | sea_ice_cat_concentration
+sithicat     | m              | XYZT | T |                 | Ice thickness for categories          | sea_ice_cat_icethickness
+snthicat     | m              | XYZT | T |                 | Snow thickness for categories         | sea_ice_cat_snowthickness
+kt_ice       |                |      |   |                 |                                       |                                  
+hicif        |                |      |   |                 |                                       |                                  
+hsnif        |                |      |   |                 |                                       |                                  
+frld         |                |      |   |                 |                                       |                                  
+sist         |                |      |   |                 |                                       |                                  
+tbif1        |                |      |   |                 |                                       |                                  
+tbif2        |                |      |   |                 |                                       |                                  
+tbif3        |                |      |   |                 |                                       |                                  
+ui_ice       |                |      |   |                 |                                       |                                  
+vi_ice       |                |      |   |                 |                                       |                                  
+qstoif       |                |      |   |                 |                                       |                                  
+fsbbq        |                |      |   |                 |                                       |                                  
+stress1_i    |                |      |   |                 |                                       |                                  
+stress2_i    |                |      |   |                 |                                       |                                  
+stress12_i   |                |      |   |                 |                                       |                                  
+sxice        |                |      |   |                 |                                       |                                  
+syice        |                |      |   |                 |                                       |                                  
+sxxice       |                |      |   |                 |                                       |                                  
+syyice       |                |      |   |                 |                                       |                                  
+sxyice       |                |      |   |                 |                                       |                                  
+sxsn         |                |      |   |                 |                                       |                                  
+sysn         |                |      |   |                 |                                       |                                  
+sxxsn        |                |      |   |                 |                                       |                                  
+syysn        |                |      |   |                 |                                       |                                  
+sxysn        |                |      |   |                 |                                       |                                  
+sxa          |                |      |   |                 |                                       |                                  
+sya          |                |      |   |                 |                                       |                                  
+sxxa         |                |      |   |                 |                                       |                                  
+syya         |                |      |   |                 |                                       |                                  
+sxya         |                |      |   |                 |                                       |                                  
+sxc0         |                |      |   |                 |                                       |                                  
+syc0         |                |      |   |                 |                                       |                                  
+sxxc0        |                |      |   |                 |                                       |                                  
+syyc0        |                |      |   |                 |                                       |                                  
+sxyc0        |                |      |   |                 |                                       |                                  
+sxc1         |                |      |   |                 |                                       |                                  
+syc1         |                |      |   |                 |                                       |                                  
+sxxc1        |                |      |   |                 |                                       |                                  
+syyc1        |                |      |   |                 |                                       |                                  
+sxyc1        |                |      |   |                 |                                       |                                  
+sxc2         |                |      |   |                 |                                       |                                  
+syc2         |                |      |   |                 |                                       |                                  
+sxxc2        |                |      |   |                 |                                       |                                  
+syyc2        |                |      |   |                 |                                       |                                  
+sxyc2        |                |      |   |                 |                                       |                                  
+sxst         |                |      |   |                 |                                       |                                  
+syst         |                |      |   |                 |                                       |                                  
+sxxst        |                |      |   |                 |                                       |                                  
+syyst        |                |      |   |                 |                                       |                                  
+sxyst        |                |      |   |                 |                                       |                                  
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/attribute.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/attribute.f90	(revision 8732)
@@ -0,0 +1,1356 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: att
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage attribute of variable or file.
+!>
+!> @details
+!>    define type TATT:<br/>
+!> @code
+!>    TYPE(TATT) :: tl_att
+!> @endcode
+!>
+!>    the attribute value inside attribute structure will be
+!>    character or real(8) 1D array.<br/>
+!>    However the attribute value could be initialized with:<br/>
+!>    - character
+!>    - scalar (real(4), real(8), integer(4) or integer(8))
+!>    - array 1D (real(4), real(8), integer(4) or integer(8))
+!>
+!>    to initialize an attribute structure :<br/>
+!> @code
+!>    tl_att=att_init('attname',value)
+!> @endcode
+!>    - value is a character, scalar value or table of value
+!>
+!>    to print attribute information of one or array of attribute structure:<br/>
+!> @code
+!>    CALL att_print(td_att) 
+!> @endcode
+!>
+!>    to clean attribute structure:<br/>
+!> @code
+!>    CALL att_clean(td_att) 
+!> @endcode
+!>
+!>    to copy attribute structure in another one (using different memory cell):<br/>
+!> @code
+!>    tl_att2=att_copy(tl_att1) 
+!> @endcode
+!>    @note as we use pointer for the value array of the attribute structure,
+!>    the use of the assignment operator (=) to copy attribute structure 
+!>    create a pointer on the same array. 
+!>    This is not the case with this copy function.
+!>
+!>    to get attribute index, in an array of attribute structure:<br/>
+!> @code
+!>   il_index=att_get_index( td_att, cd_name )
+!> @endcode
+!>    - td_att array of attribute structure
+!>    - cd_name attribute name
+!> 
+!>    to get attribute id, read from a file:<br/>
+!>@code
+!>  il_id=att_get_id( td_att, cd_name )
+!>@endcode
+!>    - td_att array of attribute structure
+!>    - cd_name attribute name
+!>
+!>    to get attribute name
+!>    - tl_att\%c_name
+!> 
+!>    to get character length or the number of value store in attribute
+!>    - tl_att\%i_len
+!>
+!>    to get attribute value:<br/>
+!>    - tl_att\%c_value    (for character attribute)
+!>    - tl_att\%d_value(i) (otherwise)
+!>    
+!>    to get the type number (based on NETCDF type constants) of the 
+!>    attribute:<br/>
+!>    - tl_att\%i_type
+!>
+!>    to get attribute id (read from file):<br/>
+!>    - tl_att\%i_id
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date September, 2015
+!> - manage useless (dummy) attributes
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE att
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TATT       !< attribute structure
+
+   PRIVATE :: cm_dumatt !< dummy attribute array
+
+   ! function and subroutine
+   PUBLIC :: att_init       !< initialize attribute structure
+   PUBLIC :: att_print      !< print attribute structure
+   PUBLIC :: att_clean      !< clean attribute strcuture
+   PUBLIC :: att_copy       !< copy attribute structure
+   PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure
+   PUBLIC :: att_get_id     !< get attribute id, read from file
+   PUBLIC :: att_get_dummy  !< fill dummy attribute array
+   PUBLIC :: att_is_dummy   !< check if attribute is defined as dummy attribute
+
+   PRIVATE :: att__clean_unit ! clean attribute strcuture
+   PRIVATE :: att__clean_arr  ! clean array of attribute strcuture
+   PRIVATE :: att__print_unit ! print information on one attribute
+   PRIVATE :: att__print_arr  ! print information on a array of attribute
+   PRIVATE :: att__init_c     ! initialize an attribute structure with character value
+   PRIVATE :: att__init_dp    ! initialize an attribute structure with array of real(8) value
+   PRIVATE :: att__init_dp_0d ! initialize an attribute structure with real(8) value
+   PRIVATE :: att__init_sp    ! initialize an attribute structure with array of real(4) value
+   PRIVATE :: att__init_sp_0d ! initialize an attribute structure with real(4) value
+   PRIVATE :: att__init_i1    ! initialize an attribute structure with array of integer(1) value
+   PRIVATE :: att__init_i1_0d ! initialize an attribute structure with integer(1) value
+   PRIVATE :: att__init_i2    ! initialize an attribute structure with array of integer(2) value
+   PRIVATE :: att__init_i2_0d ! initialize an attribute structure with integer(2) value
+   PRIVATE :: att__init_i4    ! initialize an attribute structure with array of integer(4) value
+   PRIVATE :: att__init_i4_0d ! initialize an attribute structure with integer(4) value
+   PRIVATE :: att__init_i8    ! initialize an attribute structure with array of integer(8) value
+   PRIVATE :: att__init_i8_0d ! initialize an attribute structure with integer(8) value
+   PRIVATE :: att__copy_unit  ! copy attribute structure
+   PRIVATE :: att__copy_arr   ! copy array of attribute structure
+
+   TYPE TATT !< attribute structure
+      CHARACTER(LEN=lc) :: c_name = ''       !< attribute name
+      INTEGER(i4)       :: i_id   = 0        !< attribute id
+      INTEGER(i4)       :: i_type = 0        !< attribute type
+      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
+      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
+      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
+   END TYPE TATT
+
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumatt !< dummy attribute
+
+   INTERFACE att_init
+      MODULE PROCEDURE att__init_c    
+      MODULE PROCEDURE att__init_dp
+      MODULE PROCEDURE att__init_dp_0d
+      MODULE PROCEDURE att__init_sp
+      MODULE PROCEDURE att__init_sp_0d
+      MODULE PROCEDURE att__init_i1
+      MODULE PROCEDURE att__init_i1_0d
+      MODULE PROCEDURE att__init_i2
+      MODULE PROCEDURE att__init_i2_0d
+      MODULE PROCEDURE att__init_i4
+      MODULE PROCEDURE att__init_i4_0d
+      MODULE PROCEDURE att__init_i8
+      MODULE PROCEDURE att__init_i8_0d
+   END INTERFACE att_init
+
+   INTERFACE att_print
+      MODULE PROCEDURE att__print_unit ! print information on one attribute
+      MODULE PROCEDURE att__print_arr  ! print information on a array of attribute
+   END INTERFACE att_print
+
+   INTERFACE att_clean
+      MODULE PROCEDURE att__clean_unit  
+      MODULE PROCEDURE att__clean_arr   
+   END INTERFACE
+
+   INTERFACE att_copy
+      MODULE PROCEDURE att__copy_unit  ! copy attribute structure
+      MODULE PROCEDURE att__copy_arr   ! copy array of attribute structure
+   END INTERFACE
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of attribute structure in another one
+   !> @details 
+   !> see att__copy_unit
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak) 
+   !
+   !> @param[in] td_att   array of attribute structure
+   !> @return copy of input array of attribute structure
+   !-------------------------------------------------------------------
+   FUNCTION att__copy_arr( td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
+      ! function
+      TYPE(TATT), DIMENSION(SIZE(td_att(:))) :: att__copy_arr
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_att(:))
+         att__copy_arr(ji)=att_copy(td_att(ji))
+      ENDDO
+
+   END FUNCTION att__copy_arr
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an attribute structure in another one.
+   !> @details 
+   !> attribute value are copied in a temporary array, so input and output
+   !> attribute structure value do not point on the same "memory cell", and so
+   !> on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator (to avoid memory leak) 
+   !>
+   !> @param[in] td_att   attribute structure
+   !> @return copy of input attribute structure
+   !-------------------------------------------------------------------
+   FUNCTION att__copy_unit( td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TATT), INTENT(IN)  :: td_att
+      ! function
+      TYPE(TATT) :: att__copy_unit
+
+      ! local variable
+      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      ! copy attribute variable
+      att__copy_unit%c_name  = TRIM(td_att%c_name)
+      att__copy_unit%i_id    = td_att%i_id
+      att__copy_unit%i_type  = td_att%i_type
+      att__copy_unit%i_len   = td_att%i_len
+      att__copy_unit%c_value = TRIM(td_att%c_value)
+
+      ! copy attribute pointer in an independant variable
+      IF( ASSOCIATED(att__copy_unit%d_value) ) DEALLOCATE(att__copy_unit%d_value)
+      IF( ASSOCIATED(td_att%d_value) )THEN
+         ALLOCATE( dl_value(td_att%i_len) )
+         dl_value(:) = td_att%d_value(:)
+
+         ALLOCATE( att__copy_unit%d_value(att__copy_unit%i_len) )
+         att__copy_unit%d_value(:) = dl_value(:)
+
+         DEALLOCATE( dl_value )
+      ENDIF
+
+   END FUNCTION att__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief This function return attribute index, in a array of attribute structure,
+   !> given attribute name.<br/>
+   !> @details
+   !> if attribute name do not exist, return 0.
+   !>
+   !> @author J.Paul
+   !> @date Septempber, 2014 - Initial Version
+   !
+   !> @param[in] td_att    array of attribute structure
+   !> @param[in] cd_name   attribute name
+   !> @return attribute index
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION att_get_index( td_att, cd_name )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      att_get_index=0
+
+      il_size=SIZE(td_att(:))
+      DO ji=1,il_size
+         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
+            att_get_index=ji
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_get_index
+   !-------------------------------------------------------------------
+   !> @brief This function return attribute id, read from a file.<br/>
+   !> @details
+   !> if attribute name do not exist, return 0.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - bug fix with use of id read from attribute structure
+   !>
+   !> @param[in] td_att    array of attribute structure
+   !> @param[in] cd_name   attribute name
+   !> @return attribute id
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION att_get_id( td_att, cd_name )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      att_get_id=0
+
+      il_size=SIZE(td_att(:))
+      DO ji=1,il_size
+         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
+            att_get_id=td_att(ji)%i_id
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_get_id
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with character
+   !> value. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] cd_value  attribute value
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_c( cd_name, cd_value )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN) :: cd_value
+      !----------------------------------------------------------------
+ 
+      ! clean attribute
+      CALL att_clean(att__init_c)
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cd_value)) )
+
+      att__init_c%c_name=TRIM(ADJUSTL(cd_name))
+      att__init_c%i_type=NF90_CHAR
+
+      att__init_c%c_value=TRIM(ADJUSTL(cd_value))
+      att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
+
+   END FUNCTION att__init_c
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of real(8) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] dd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value, id_type )
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      REAL(dp),         DIMENSION(:), INTENT(IN) :: dd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_dp)
+
+      ! array size
+      il_len=size(dd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
+
+      att__init_dp%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_dp%i_type=id_type
+      ELSE
+         att__init_dp%i_type=NF90_DOUBLE
+      ENDIF
+
+      IF( ASSOCIATED(att__init_dp%d_value) )THEN
+         DEALLOCATE(att__init_dp%d_value)
+      ENDIF
+      ALLOCATE(att__init_dp%d_value(il_len))
+
+      att__init_dp%d_value(:)=dd_value(:)
+      att__init_dp%i_len=il_len
+
+   END FUNCTION att__init_dp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> real(8) value 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] dd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(dp),         INTENT(IN) :: dd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_dp_0d)
+      
+      cl_value="(/"//TRIM(fct_str(dd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
+
+      att__init_dp_0d%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_dp_0d%i_type=id_type
+      ELSE
+         att__init_dp_0d%i_type=NF90_DOUBLE
+      ENDIF
+
+      IF( ASSOCIATED(att__init_dp_0d%d_value) )THEN
+         DEALLOCATE(att__init_dp_0d%d_value)
+      ENDIF
+      ALLOCATE(att__init_dp_0d%d_value(1))
+
+      att__init_dp_0d%d_value(1)=dd_value
+      att__init_dp_0d%i_len=1
+
+   END FUNCTION att__init_dp_0d
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of real(4) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] rd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      REAL(sp),         DIMENSION(:), INTENT(IN) :: rd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_sp)
+      
+      ! array size
+      il_len=size(rd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_sp%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_sp%i_type=id_type
+      ELSE
+         att__init_sp%i_type=NF90_FLOAT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_sp%d_value) )THEN
+         DEALLOCATE(att__init_sp%d_value)
+      ENDIF
+      ALLOCATE(att__init_sp%d_value(il_len))
+
+      att__init_sp%d_value(:)=REAL(rd_value(:),dp)
+      att__init_sp%i_len=il_len
+
+   END FUNCTION att__init_sp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> real(4) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] rd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(sp),         INTENT(IN) :: rd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_sp_0d)
+      
+      cl_value="(/"//TRIM(fct_str(rd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_sp_0d%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_sp_0d%i_type=id_type
+      ELSE
+         att__init_sp_0d%i_type=NF90_FLOAT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_sp_0d%d_value) )THEN
+         DEALLOCATE(att__init_sp_0d%d_value)
+      ENDIF
+      ALLOCATE(att__init_sp_0d%d_value(1))
+
+      att__init_sp_0d%d_value(1)=REAL(rd_value,dp)
+      att__init_sp_0d%i_len=1
+
+   END FUNCTION att__init_sp_0d
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(1) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] bd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i1),      DIMENSION(:), INTENT(IN) :: bd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i1)
+      
+      ! array size
+      il_len=size(bd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i1%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i1%i_type=id_type
+      ELSE
+         att__init_i1%i_type=NF90_BYTE
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i1%d_value) )THEN
+         DEALLOCATE(att__init_i1%d_value)
+      ENDIF
+      ALLOCATE(att__init_i1%d_value(il_len))
+
+      att__init_i1%d_value(:)=REAL(bd_value(:),dp)
+      att__init_i1%i_len=il_len
+
+   END FUNCTION att__init_i1
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(1) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] bd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i1),      INTENT(IN) :: bd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      !local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i1_0d)
+      
+      cl_value="(/"//TRIM(fct_str(bd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i1_0d%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i1_0d%i_type=id_type
+      ELSE
+         att__init_i1_0d%i_type=NF90_BYTE
+      ENDIF      
+
+      IF( ASSOCIATED(att__init_i1_0d%d_value) )THEN
+         DEALLOCATE(att__init_i1_0d%d_value)
+      ENDIF
+      ALLOCATE(att__init_i1_0d%d_value(1))
+
+      att__init_i1_0d%d_value(1)=REAL(bd_value,dp)
+      att__init_i1_0d%i_len=1
+
+   END FUNCTION att__init_i1_0d
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(2) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] sd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i2),      DIMENSION(:), INTENT(IN) :: sd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i2)
+      
+      ! array size
+      il_len=size(sd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i2%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i2%i_type=id_type
+      ELSE
+         att__init_i2%i_type=NF90_SHORT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i2%d_value) )THEN
+         DEALLOCATE(att__init_i2%d_value)
+      ENDIF
+      ALLOCATE(att__init_i2%d_value(il_len))
+
+      att__init_i2%d_value(:)=REAL(sd_value(:),dp)
+      att__init_i2%i_len=il_len
+
+   END FUNCTION att__init_i2
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(2) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] sd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i2),      INTENT(IN) :: sd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      !local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i2_0d)
+      
+      cl_value="(/"//TRIM(fct_str(sd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i2_0d%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i2_0d%i_type=id_type
+      ELSE
+         att__init_i2_0d%i_type=NF90_SHORT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i2_0d%d_value) )THEN
+         DEALLOCATE(att__init_i2_0d%d_value)
+      ENDIF
+      ALLOCATE(att__init_i2_0d%d_value(1))
+
+      att__init_i2_0d%d_value(1)=REAL(sd_value,dp)
+      att__init_i2_0d%i_len=1
+
+   END FUNCTION att__init_i2_0d
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(4) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] id_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i4),      DIMENSION(:), INTENT(IN) :: id_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i4)
+      
+      ! array size
+      il_len=size(id_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i4%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i4%i_type=id_type
+      ELSE
+         att__init_i4%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i4%d_value) )THEN
+         DEALLOCATE(att__init_i4%d_value)
+      ENDIF
+      ALLOCATE(att__init_i4%d_value(il_len))
+
+      att__init_i4%d_value(:)=REAL(id_value(:),dp)
+      att__init_i4%i_len=il_len
+
+   END FUNCTION att__init_i4
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(4) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_name   attribute name
+   !> @param[in] id_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i4),      INTENT(IN) :: id_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      !local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i4_0d)
+      
+      cl_value="(/"//TRIM(fct_str(id_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i4_0d%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i4_0d%i_type=id_type
+      ELSE
+         att__init_i4_0d%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i4_0d%d_value) )THEN
+         DEALLOCATE(att__init_i4_0d%d_value)
+      ENDIF
+      ALLOCATE(att__init_i4_0d%d_value(1))
+
+      att__init_i4_0d%d_value(1)=REAL(id_value,dp)
+      att__init_i4_0d%i_len=1
+
+   END FUNCTION att__init_i4_0d
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(8) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] kd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i8),      DIMENSION(:), INTENT(IN) :: kd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i8)
+      
+      ! array size
+      il_len=size(kd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len
+         cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i8%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i8%i_type=id_type
+      ELSE
+         att__init_i8%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i8%d_value) )THEN
+         DEALLOCATE(att__init_i8%d_value)
+      ENDIF
+      ALLOCATE(att__init_i8%d_value(il_len))
+
+      att__init_i8%d_value(:)=REAL(kd_value(:),dp)
+      att__init_i8%i_len=il_len
+
+   END FUNCTION att__init_i8
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(8) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] kd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value, id_type )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i8),      INTENT(IN) :: kd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(att__init_i8_0d)
+      
+      cl_value="(/"//TRIM(fct_str(kd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      att__init_i8_0d%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         att__init_i8_0d%i_type=id_type
+      ELSE
+         att__init_i8_0d%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(att__init_i8_0d%d_value) )THEN
+         DEALLOCATE(att__init_i8_0d%d_value)
+      ENDIF
+      ALLOCATE(att__init_i8_0d%d_value(1))
+
+      att__init_i8_0d%d_value(1)=REAL(kd_value,dp)
+      att__init_i8_0d%i_len=1
+
+   END FUNCTION att__init_i8_0d
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print informations of an array of attribute. 
+   !>
+   !> @author J.Paul
+   !> @date June, 2014 - Initial Version
+   !>
+   !> @param[in] td_att array of attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE att__print_arr(td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_att(:))
+         CALL att_print(td_att(ji))
+      ENDDO
+
+   END SUBROUTINE att__print_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print attribute information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account type of attribute.
+   !
+   !> @param[in] td_att attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE att__print_unit(td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), INTENT(IN) :: td_att
+
+      ! local vairbale
+      CHARACTER(LEN=lc) :: cl_type
+      CHARACTER(LEN=lc) :: cl_value
+
+      INTEGER(i8)       :: kl_tmp
+      INTEGER(i2)       :: sl_tmp
+      INTEGER(i1)       :: bl_tmp
+      REAL(sp)          :: rl_tmp
+      REAL(dp)          :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+         SELECT CASE( td_att%i_type )
+
+            CASE(NF90_CHAR)
+               cl_type='CHAR'
+            CASE(NF90_BYTE)
+               cl_type='BYTE'
+            CASE(NF90_SHORT)
+               cl_type='SHORT'
+            CASE(NF90_INT)
+               cl_type='INT'
+            CASE(NF90_FLOAT)
+               cl_type='FLOAT'
+            CASE(NF90_DOUBLE)
+               cl_type='DOUBLE'
+            CASE DEFAULT
+               cl_type=''
+
+         END SELECT
+
+         SELECT CASE( td_att%i_type )
+
+            CASE(NF90_CHAR)
+
+               cl_value=td_att%c_value
+
+            CASE(NF90_BYTE)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     bl_tmp=INT(td_att%d_value(ji),i1)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//','
+                  ENDDO
+                  bl_tmp=INT(td_att%d_value(td_att%i_len),i1)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_SHORT)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     sl_tmp=INT(td_att%d_value(ji),i2)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//','
+                  ENDDO
+                  sl_tmp=INT(td_att%d_value(td_att%i_len),i2)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_INT)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     kl_tmp=INT(td_att%d_value(ji),i8)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//','
+                  ENDDO
+                  kl_tmp=INT(td_att%d_value(td_att%i_len),i8)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_FLOAT)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     rl_tmp=REAL(td_att%d_value(ji),sp)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//','
+                  ENDDO
+                  rl_tmp=REAL(td_att%d_value(td_att%i_len),sp)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_DOUBLE)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     dl_tmp=REAL(td_att%d_value(ji),dp)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//','
+                  ENDDO
+                  dl_tmp=REAL(td_att%d_value(td_att%i_len),dp)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE DEFAULT
+               cl_value="none"
+
+         END SELECT
+
+         WRITE(*,'((3x,a,a),(/6x,a,i2.2),(a,a),(a,a))')&
+         &        " attribute : ",TRIM(ADJUSTL(td_att%c_name)),      &
+         &        " id : ",td_att%i_id,                         &
+         &        " type : ",TRIM(ADJUSTL(cl_type)),            &
+         &        " value : ",TRIM(ADJUSTL(cl_value))
+
+   END SUBROUTINE att__print_unit
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean attribute strcuture.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_att attribute strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE att__clean_unit( td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TATT),  INTENT(INOUT) :: td_att
+
+      ! local variable
+      TYPE(TATT) :: tl_att ! empty attribute structure
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " CLEAN: reset attribute "//TRIM(td_att%c_name) )
+
+      IF( ASSOCIATED(td_att%d_value) )THEN
+         ! clean value
+         DEALLOCATE(td_att%d_value)
+      ENDIF
+
+      ! replace by empty structure
+      td_att=att_copy(tl_att)
+
+   END SUBROUTINE att__clean_unit
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean array of attribute strcuture.
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_att attribute strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE att__clean_arr( td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TATT), DIMENSION(:), INTENT(INOUT) :: td_att
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_att(:)),1,-1
+         CALL att_clean(td_att(ji) )
+      ENDDO
+
+   END SUBROUTINE att__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy attribute array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date Marsh, 2016
+   !> - close file (bugfix)
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE att_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumatt(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         cm_dumatt(:)=cn_dumatt(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+   
+   END SUBROUTINE att_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if attribute is defined as dummy attribute
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_att attribute structure
+   !> @return true if attribute is dummy attribute
+   !-------------------------------------------------------------------
+   FUNCTION att_is_dummy(td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), INTENT(IN) :: td_att
+      
+      ! function
+      LOGICAL :: att_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      att_is_dummy=.FALSE.
+      DO ji=1,ip_maxdumcfg
+         IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN
+            att_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_is_dummy
+END MODULE att
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/boundary.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/boundary.f90	(revision 8732)
@@ -0,0 +1,1868 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: boundary
+!
+! DESCRIPTION:
+!> @brief
+!> This module manage boundary.
+!>
+!> @details
+!>    define type TBDY:<br/>
+!> @code
+!>    TYPE(TBDY) :: tl_bdy<br/>
+!> @endcode
+!>
+!>    to initialise boundary structure:<br/>
+!> @code
+!>    tl_bdy=boundary_init(td_var, [ld_north,] [ld_south,] [ld_east,] [ld_west,]
+!>    [cd_north,] [cd_south,] [cd_east,] [cd_west,] [ld_oneseg])
+!> @endcode
+!>       - td_var is variable structure
+!>       - ld_north is logical to force used of north boundary [optional]
+!>       - ld_south is logical to force used of north boundary [optional]
+!>       - ld_east  is logical to force used of north boundary [optional]
+!>       - ld_west  is logical to force used of north boundary [optional]
+!>       - cd_north is string character description of north boundary [optional]
+!>       - cd_south is string character description of south boundary [optional]
+!>       - cd_east  is string character description of east  boundary [optional]
+!>       - cd_west  is string character description of west  boundary [optional]
+!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
+!>
+!>    to get boundary cardinal:<br/>
+!>    - tl_bdy\%c_card
+!>
+!>    to know if boundary is use:<br/>
+!>    - tl_bdy\%l_use
+!>
+!>    to know if boundary come from namelist (cn_north,..):<br/>
+!>    - tl_bdy\%l_nam
+!>
+!>    to get the number of segment in boundary:<br/>
+!>    - tl_bdy\%i_nseg
+!>
+!>    to get array of segment in boundary:<br/>
+!>    - tl_bdy\%t_seg(:)
+!>
+!>    to get orthogonal segment index of north boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_north)%\i_index
+!>
+!>    to get segment width of south boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_south)%\i_width
+!>
+!>    to get segment first indice of east boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_east)%\i_first
+!>
+!>    to get segment last indice of west boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_west)%\i_last
+!>
+!>    to print information about boundary:<br/>
+!> @code
+!>    CALL boundary_print(td_bdy)
+!> @endcode
+!>       - td_bdy is boundary structure or a array of boundary structure
+!>
+!>    to clean boundary structure:<br/>
+!> @code
+!>    CALL boundary_clean(td_bdy)
+!> @endcode
+!>
+!>    to get indices of each semgent for each boundary:<br/>
+!> @code
+!>    CALL boundary_get_indices( td_bdy, td_var, ld_oneseg)
+!> @endcode
+!>       - td_bdy is boundary structure
+!>       - td_var is variable structure
+!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
+!>
+!>    to check boundary indices and corner:<br/>
+!> @code
+!>    CALL boundary_check(td_bdy, td_var)
+!> @endcode
+!>       - td_bdy is boundary structure
+!>       - td_var is variable structure
+!>
+!>    to check boundary corner:<br/>
+!> @code
+!>    CALL boundary_check_corner(td_bdy, td_var)
+!> @endcode
+!>       - td_bdy is boundary structure
+!>       - td_var is variable structure
+!>
+!>    to create filename with cardinal name inside:<br/>
+!> @code
+!>    cl_filename=boundary_set_filename(cd_file, cd_card)
+!> @endcode
+!>       - cd_file = original file name
+!>       - cd_card = cardinal name
+!>
+!>    to swap array for east and north boundary:<br/>
+!> @code
+!>    CALL boundary_swap( td_var, td_bdy )
+!> @endcode
+!>       - td_var is variable strucutre
+!>       - td_bdy is boundary strucutre
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014 
+!> - add boundary description
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date February, 2015 
+!> - Do not change indices read from namelist
+!> - Change string character format of boundary read from namelist, 
+!>  see boundary__get_info
+!> 
+!> @todo add schematic to boundary structure description
+!> 
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE boundary
+   USE netcdf                          ! nf90 library                           
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE var                             ! variable manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TBDY     !< boundary structure
+   PUBLIC :: TSEG     !< segment structure
+
+   PRIVATE :: im_width !< boundary width
+
+   ! function and subroutine
+   PUBLIC :: boundary_copy         !< copy boundary structure
+   PUBLIC :: boundary_init         !< initialise boundary structure
+   PUBLIC :: boundary_print        !< print information about boundary
+   PUBLIC :: boundary_clean        !< clean boundary structure 
+   PUBLIC :: boundary_get_indices  !< get indices of each semgent for each boundary.
+   PUBLIC :: boundary_check        !< check boundary indices and corner.
+   PUBLIC :: boundary_check_corner !< check boundary corner
+   PUBLIC :: boundary_set_filename !< set boundary filename
+   PUBLIC :: boundary_swap         !< swap array for north and east boundary
+
+   PRIVATE :: boundary__clean_unit      ! clean boundary structure 
+   PRIVATE :: boundary__clean_arr       ! clean array of boundary structure 
+   PRIVATE :: boundary__init_wrapper    ! initialise a boundary structure
+   PRIVATE :: boundary__init            ! initialise basically a boundary structure
+   PRIVATE :: boundary__copy_unit       ! copy boundary structure in another
+   PRIVATE :: boundary__copy_arr        ! copy boundary structure in another
+   PRIVATE :: boundary__add_seg         ! add one segment structure to a boundary 
+   PRIVATE :: boundary__del_seg         ! remove all segments of a boundary
+   PRIVATE :: boundary__get_info        ! get boundary information from boundary description string character.
+   PRIVATE :: boundary__get_seg_number  ! compute the number of sea segment for one boundary
+   PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary 
+   PRIVATE :: boundary__print_unit      ! print information about one boundary
+   PRIVATE :: boundary__print_arr       ! print information about a array of boundary
+   
+   PRIVATE :: seg__init       ! initialise segment structure
+   PRIVATE :: seg__clean      ! clean segment structure
+   PRIVATE :: seg__clean_unit ! clean one segment structure
+   PRIVATE :: seg__clean_arr  ! clean array of segment structure
+   PRIVATE :: seg__copy       ! copy segment structure in another
+   PRIVATE :: seg__copy_unit  ! copy segment structure in another
+   PRIVATE :: seg__copy_arr   ! copy array of segment structure in another
+
+   TYPE TSEG   !< segment structure
+      INTEGER(i4) :: i_index = 0 !< segment index
+      INTEGER(i4) :: i_width = 0 !< segment width
+      INTEGER(i4) :: i_first = 0 !< segment first indice 
+      INTEGER(i4) :: i_last  = 0 !< segment last indices
+   END TYPE TSEG
+
+   TYPE TBDY !< boundary structure
+      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal
+      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not 
+      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist
+      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary
+      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure
+   END TYPE TBDY
+
+   ! module variable
+   INTEGER(i4), PARAMETER :: im_width=10
+
+   INTERFACE boundary_init
+      MODULE PROCEDURE boundary__init_wrapper 
+   END INTERFACE boundary_init
+
+   INTERFACE boundary_print
+      MODULE PROCEDURE boundary__print_unit 
+      MODULE PROCEDURE boundary__print_arr 
+   END INTERFACE boundary_print
+
+   INTERFACE boundary_clean
+      MODULE PROCEDURE boundary__clean_unit   
+      MODULE PROCEDURE boundary__clean_arr    
+   END INTERFACE
+
+   INTERFACE seg__clean
+      MODULE PROCEDURE seg__clean_unit   
+      MODULE PROCEDURE seg__clean_arr    
+   END INTERFACE
+
+   INTERFACE boundary_copy
+      MODULE PROCEDURE boundary__copy_unit 
+      MODULE PROCEDURE boundary__copy_arr 
+   END INTERFACE   
+
+   INTERFACE seg__copy
+      MODULE PROCEDURE seg__copy_unit   ! copy segment structure
+      MODULE PROCEDURE seg__copy_arr    ! copy array of segment structure
+   END INTERFACE   
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of boundary structure in another one
+   !> @details 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_bdy   array of boundary structure
+   !> @return copy of input array of boundary structure 
+   !-------------------------------------------------------------------
+   FUNCTION boundary__copy_arr( td_bdy )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TBDY), DIMENSION(:), INTENT(IN)  :: td_bdy
+      ! function
+      TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      DO jk=1,SIZE(td_bdy(:))
+         boundary__copy_arr(jk)=boundary_copy(td_bdy(jk))
+      ENDDO
+
+   END FUNCTION boundary__copy_arr
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy boundary structure in another one
+   !> @details 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_bdy   boundary structure
+   !> @return copy of input boundary structure
+   !-------------------------------------------------------------------
+   FUNCTION boundary__copy_unit( td_bdy )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TBDY), INTENT(IN)  :: td_bdy
+      ! function
+      TYPE(TBDY) :: boundary__copy_unit
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! copy variable name, id, ..
+      boundary__copy_unit%c_card     = TRIM(td_bdy%c_card)
+      boundary__copy_unit%i_nseg     = td_bdy%i_nseg
+      boundary__copy_unit%l_use      = td_bdy%l_use
+
+      ! copy segment
+      IF( ASSOCIATED(boundary__copy_unit%t_seg) )THEN
+         CALL seg__clean(boundary__copy_unit%t_seg(:))
+         DEALLOCATE(boundary__copy_unit%t_seg)
+      ENDIF
+      IF( ASSOCIATED(td_bdy%t_seg) .AND. boundary__copy_unit%i_nseg > 0 )THEN
+         ALLOCATE( boundary__copy_unit%t_seg(boundary__copy_unit%i_nseg) )
+         DO ji=1,boundary__copy_unit%i_nseg
+            boundary__copy_unit%t_seg(ji)=td_bdy%t_seg(ji)
+         ENDDO
+      ENDIF
+
+   END FUNCTION boundary__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean boundary structure
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_bdy boundary strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE boundary__clean_unit( td_bdy )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TBDY), INTENT(INOUT) :: td_bdy
+
+      ! local variable
+      TYPE(TBDY) :: tl_bdy ! empty boundary strucutre
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info( &
+      &  " CLEAN: reset boundary "//TRIM(td_bdy%c_card) )
+
+      ! del segment
+      IF( ASSOCIATED(td_bdy%t_seg) )THEN
+         ! clean each segment
+         CALL seg__clean(td_bdy%t_seg(:) )
+         DEALLOCATE( td_bdy%t_seg )
+      ENDIF
+
+      ! replace by empty structure
+      td_bdy=boundary_copy(tl_bdy)
+
+   END SUBROUTINE boundary__clean_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean array of boundary structure
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_bdy boundary strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE boundary__clean_arr( td_bdy )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TBDY), DIMENSION(:), INTENT(INOUT) :: td_bdy
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_bdy(:)),1,-1
+         CALL boundary_clean( td_bdy(ji) )
+      ENDDO
+
+   END SUBROUTINE boundary__clean_arr
+   !------------------------------------------------------------------- 
+   !> @brief This function put cardinal name and date inside file name.
+   ! 
+   !> @details 
+   !>    Examples :
+   !>       cd_file="boundary.nc"
+   !>       cd_card="west" 
+   !>       id_seg =2
+   !>       cd_date=y2015m07d16
+   !> 
+   !>       function return "boundary_west_2_y2015m07d16.nc"
+   !> 
+   !>       cd_file="boundary.nc"
+   !>       cd_card="west" 
+   !> 
+   !>       function return "boundary_west.nc"
+   !> 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] cd_file   file name 
+   !> @param[in] cd_card   cardinal name 
+   !> @param[in] id_seg    segment number 
+   !> @param[in] cd_date   file date (format: y????m??d??) 
+   !> @return file name with cardinal name inside
+   !------------------------------------------------------------------- 
+   FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) 
+      IMPLICIT NONE 
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_card
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_seg
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date
+
+      ! function 
+      CHARACTER(LEN=lc) :: boundary_set_filename
+
+      ! local variable 
+      CHARACTER(LEN=lc) :: cl_dirname
+      CHARACTER(LEN=lc) :: cl_basename
+      CHARACTER(LEN=lc) :: cl_base
+      CHARACTER(LEN=lc) :: cl_suffix
+      CHARACTER(LEN=lc) :: cl_segnum
+      CHARACTER(LEN=lc) :: cl_date
+      CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_indend
+
+      ! loop indices 
+      !---------------------------------------------------------------- 
+      ! init
+      boundary_set_filename=''
+
+      IF( TRIM(cd_file) /= '' .AND. TRIM(cd_card) /= '' )THEN
+
+         cl_dirname = fct_dirname( TRIM(cd_file))
+         IF( TRIM(cl_dirname) == '' ) cl_dirname='.'
+
+         cl_basename= fct_basename(TRIM(cd_file))
+
+         cl_base  =fct_split(TRIM(cl_basename),1,'.')
+         cl_suffix=fct_split(TRIM(cl_basename),2,'.')
+         
+         ! add segment number
+         IF( PRESENT(id_seg) )THEN
+            cl_segnum="_"//TRIM(fct_str(id_seg))
+         ELSE
+            cl_segnum=""
+         ENDIF
+
+         ! add date
+         IF( PRESENT(cd_date) )THEN
+            cl_date="_"//TRIM(ADJUSTL(cd_date))
+         ELSE
+            cl_date=""
+         ENDIF
+
+         ! special case for obcdta
+         il_ind=INDEX(cl_base,'_obcdta_')
+         IF( il_ind/=0 )THEN
+            il_ind=il_ind-1+8
+            il_indend=LEN_TRIM(cl_base)
+
+            cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//&
+               &     TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//&
+               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ELSE
+            cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
+               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ENDIF
+
+         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name)
+      ELSE
+         CALL logger_error("BOUNDARY SET FILENAME: file or cardinal name "//&
+         &  " are empty")
+      ENDIF
+ 
+   END FUNCTION boundary_set_filename 
+   !------------------------------------------------------------------- 
+   !> @brief This function initialise a boundary structure.
+   ! 
+   !> @details 
+   !>  Boundaries for each cardinal will be compute with variable structure.
+   !>  It means that orthogonal index, first and last indices of each 
+   !>  sea segment will be compute automatically.
+   !>  However you could specify which boundary to use or not with
+   !>  arguments ln_north, ln_south, ln_east, ln_west.
+   !>  And boundary description could be specify with argument
+   !>  cn_north, cn_south, cn_east, cn_west.
+   !>  For each cardinal you could specify orthogonal index, 
+   !>  first and last indices (in this order) and boundary width (between
+   !>  parentheses).
+   !> ex : cn_north='index,first,last(width)'
+   !> You could specify more than one segment for each boundary. 
+   !> However each segment will have the same width. So you do not need to
+   !> specify it for each segment.
+   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
+   !>
+   !> @warn Boundaries are compute on T point, but expressed on U,V point.
+   !> change will be done to get data on other point when need be. 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !> @date September, 2014
+   !> - add boolean to use only one segment for each boundary
+   !> - check boundary width
+   ! 
+   !> @param[in] td_var    variable structure 
+   !> @param[in] ld_north  use north boundary or not 
+   !> @param[in] ld_south  use south boundary or not 
+   !> @param[in] ld_east   use east  boundary or not 
+   !> @param[in] ld_west   use west  boundary or not 
+   !> @param[in] cd_north  north boundary description 
+   !> @param[in] cd_south  south boundary description 
+   !> @param[in] cd_east   east  boundary description 
+   !> @param[in] cd_west   west  boundary description 
+   !> @param[in] ld_oneseg force to use only one segment for each boundary 
+   !> @return boundary structure
+   !------------------------------------------------------------------- 
+   FUNCTION boundary__init_wrapper(td_var, &
+   &                               ld_north, ld_south, ld_east, ld_west, &
+   &                               cd_north, cd_south, cd_east, cd_west, &
+   &                               ld_oneseg ) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TVAR)       , INTENT(IN) :: td_var
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_north
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_south
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_east 
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_west 
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_north
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_south
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_east 
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_west
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_oneseg 
+
+      ! function 
+      TYPE(TBDY), DIMENSION(ip_ncard) :: boundary__init_wrapper
+
+      ! local variable 
+      INTEGER(i4)                            :: il_width
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max_width
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_index
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_min
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
+
+      CHARACTER(LEN=lc), DIMENSION(ip_ncard) :: cl_card
+
+      TYPE(TBDY)       , DIMENSION(ip_ncard) :: tl_bdy
+      TYPE(TBDY)                             :: tl_tmp
+
+      TYPE(TSEG)                             :: tl_seg
+
+      LOGICAL                                :: ll_oneseg
+
+      ! loop indices 
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !---------------------------------------------------------------- 
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("BOUNDARY INIT: no value associated to variable "//&
+         &              TRIM(td_var%c_name) )
+      ELSEIF( TRIM(td_var%c_point) /= 'T' )THEN
+         CALL logger_error("BOUNDARY INIT: can not compute boundary with "//&
+         &                 "variable "//TRIM(td_var%c_name)//&
+         &                 ". need a variable on T point." )
+      ELSE
+         ll_oneseg=.TRUE.
+         IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
+
+         ! init
+         tl_bdy(jp_north)=boundary__init('north',ld_north)
+         tl_bdy(jp_south)=boundary__init('south',ld_south)
+         tl_bdy(jp_east )=boundary__init('east ',ld_east )
+         tl_bdy(jp_west )=boundary__init('west ',ld_west )
+
+         ! if EW cyclic no east west boundary and force to use one segment
+         IF( td_var%i_ew >= 0 )THEN
+            CALL logger_info("BOUNDARY INIT: cyclic domain, "//&
+            &  "no East West boundary")
+            tl_bdy(jp_east )%l_use=.FALSE.
+            tl_bdy(jp_west )%l_use=.FALSE.
+
+            CALL logger_info("BOUNDARY INIT: force to use one segment due"//&
+            &  " to EW cyclic domain")
+            ll_oneseg=.TRUE.
+         ENDIF
+
+         il_index(jp_north)=td_var%t_dim(2)%i_len-ip_ghost
+         il_index(jp_south)=1+ip_ghost
+         il_index(jp_east )=td_var%t_dim(1)%i_len-ip_ghost
+         il_index(jp_west )=1+ip_ghost
+
+         il_min(jp_north)=1
+         il_min(jp_south)=1
+         il_min(jp_east )=1
+         il_min(jp_west )=1
+
+         il_max(jp_north)=td_var%t_dim(1)%i_len
+         il_max(jp_south)=td_var%t_dim(1)%i_len
+         il_max(jp_east )=td_var%t_dim(2)%i_len
+         il_max(jp_west )=td_var%t_dim(2)%i_len
+ 
+         cl_card=(/'','','',''/)
+         IF( PRESENT(cd_north) ) cl_card(jp_north)=TRIM(cd_north)
+         IF( PRESENT(cd_south) ) cl_card(jp_south)=TRIM(cd_south)
+         IF( PRESENT(cd_east ) ) cl_card(jp_east )=TRIM(cd_east )
+         IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west )
+
+         il_max_width(jp_north)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost))
+         il_max_width(jp_south)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost))
+         il_max_width(jp_east )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost))
+         il_max_width(jp_west )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost))
+
+         DO jk=1,ip_ncard
+
+            ! check boundary width
+            IF( il_max_width(jk) <= im_width )THEN
+               IF( il_max_width(jk) <= 0 )THEN
+                  CALL logger_fatal("BOUNDARY INIT: domain too small to define"//&
+                  &                " boundaries.")
+               ELSE
+                  CALL logger_warn("BOUNDARY INIT: default boundary width too "//&
+                  &                "large for boundaries. force to use boundary"//&
+                  &                " on one point")
+                  il_width=1
+               ENDIF
+            ELSE
+               il_width=im_width
+            ENDIF
+
+            ! define default segment
+            tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk))
+
+            IF( tl_bdy(jk)%l_use )THEN
+
+               ! get namelist information
+               tl_tmp=boundary__get_info(cl_card(jk),jk)
+
+               ! get segments indices
+               DO ji=1,tl_tmp%i_nseg
+                  CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji))
+               ENDDO
+               ! indices from namelist or not
+               tl_bdy(jk)%l_nam=tl_tmp%l_nam
+
+               CALL boundary_clean(tl_tmp)
+
+               IF( tl_bdy(jk)%i_nseg == 0 )THEN
+                  ! add default segment
+                  CALL boundary__add_seg(tl_bdy(jk),tl_seg)
+               ELSE
+                  ! fill undefined value
+                  WHERE( tl_bdy(jk)%t_seg(:)%i_index == 0 ) 
+                     tl_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index
+                  END WHERE               
+                  WHERE( tl_bdy(jk)%t_seg(:)%i_width == 0 ) 
+                     tl_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width
+                  END WHERE
+                  WHERE( tl_bdy(jk)%t_seg(:)%i_first == 0 ) 
+                     tl_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first
+                  END WHERE
+                  WHERE( tl_bdy(jk)%t_seg(:)%i_last == 0 ) 
+                     tl_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last
+                  END WHERE
+               ENDIF
+
+            ENDIF
+            ! clean
+            CALL seg__clean(tl_seg)
+
+         ENDDO
+
+         CALL boundary_get_indices(tl_bdy(:), td_var, ll_oneseg)
+
+         CALL boundary_check(tl_bdy, td_var)
+
+         boundary__init_wrapper(:)=boundary_copy(tl_bdy(:))
+
+         ! clean
+         DO jk=1,ip_ncard
+            CALL boundary_clean(tl_bdy(jk))
+         ENDDO
+
+      ENDIF
+ 
+   END FUNCTION boundary__init_wrapper 
+   !------------------------------------------------------------------- 
+   !> @brief This function initialise basically a boundary structure with
+   !> cardinal name.
+   ! 
+   !> @details 
+   !> optionnaly you could specify if this boundary is used or not, 
+   !> and add one segment structure.
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in]  cd_card  cardinal name
+   !> @param[in]  ld_use   boundary use or not
+   !> @param[in]  td_seg   segment structure
+   !> @return boundary structure
+   !------------------------------------------------------------------- 
+   FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg ) 
+      IMPLICIT NONE 
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_card
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use 
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam 
+      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg
+
+      ! function 
+      TYPE(TBDY) :: boundary__init
+
+      ! local variable 
+      
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      SELECT CASE(TRIM(cd_card))
+         CASE ('north','south','east','west')
+         
+            boundary__init%c_card=TRIM(cd_card)
+
+            boundary__init%l_use=.TRUE.
+            IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use
+
+            boundary__init%l_nam=.FALSE.
+            IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam
+
+            IF( PRESENT(td_seg) )THEN
+               CALL boundary__add_seg(boundary__init, td_seg)
+            ENDIF
+
+         CASE DEFAULT
+            CALL logger_error("BOUNDARY INIT: invalid cardinal name")
+      END SELECT
+
+   END FUNCTION boundary__init
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine add one segment structure to a boundary structure 
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure  
+   !> @param[in] td_seg    segment structure  
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary__add_seg(td_bdy, td_seg) 
+      IMPLICIT NONE 
+      ! Argument 
+      TYPE(TBDY), INTENT(INOUT) :: td_bdy
+      TYPE(TSEG), INTENT(IN   ) :: td_seg
+
+      ! local variable 
+      INTEGER(i4)                            :: il_status
+      TYPE(TSEG) , DIMENSION(:), ALLOCATABLE :: tl_seg
+
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      IF( td_bdy%i_nseg > 0 )THEN
+         ! already other segment in boundary structure
+         ALLOCATE( tl_seg(td_bdy%i_nseg), stat=il_status )
+         IF(il_status /= 0 )THEN
+            CALL logger_error( &
+            &  " BOUNDARY ADD SEG: not enough space to put segments ")
+         ELSE
+            ! save temporary segment
+            tl_seg(:)=seg__copy(td_bdy%t_seg(:))
+
+            CALL seg__clean(td_bdy%t_seg(:))
+            DEALLOCATE( td_bdy%t_seg )
+            ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+               CALL logger_error( &
+               &  " BOUNDARY ADD SEG: not enough space to put segments ")
+            ENDIF
+
+            ! copy segment in boundary before
+            td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:))
+
+            ! clean
+            CALL seg__clean(tl_seg(:))
+            DEALLOCATE(tl_seg)            
+            
+         ENDIF
+      ELSE
+         ! no segment in boundary structure
+         IF( ASSOCIATED(td_bdy%t_seg) )THEN
+            CALL seg__clean(td_bdy%t_seg(:))
+            DEALLOCATE(td_bdy%t_seg)
+         ENDIF
+         ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
+         IF(il_status /= 0 )THEN
+            CALL logger_error( &
+            &  " BOUNDARY ADD SEG: not enough space to put segments ")
+         ENDIF         
+      ENDIF
+ 
+      ! update number of segment
+      td_bdy%i_nseg=td_bdy%i_nseg+1
+
+      ! add new segment
+      td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg)
+
+   END SUBROUTINE boundary__add_seg 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine remove all segments of a boundary structure 
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout]  td_bdy   boundary structure
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary__del_seg(td_bdy) 
+      IMPLICIT NONE 
+      ! Argument 
+      TYPE(TBDY), INTENT(INOUT) :: td_bdy
+
+      ! local variable 
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      IF( ASSOCIATED(td_bdy%t_seg) )THEN
+         CALL seg__clean(td_bdy%t_seg(:))
+         DEALLOCATE(td_bdy%t_seg)
+      ENDIF
+      !update number of segment
+      td_bdy%i_nseg=0
+
+   END SUBROUTINE boundary__del_seg 
+   !------------------------------------------------------------------- 
+   !> @brief This function get information about boundary from string character. 
+   ! 
+   !> @details
+   !> This string character that will be passed through namelist could contains
+   !> orthogonal index, first and last indices, of each segment. 
+   !> And also the width of all segments of this boundary.
+   !>   cn_north='index1,first1:last1(width)|index2,first2:last2'
+   !> 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !> @date february, 2015 
+   !> - do not change indices read from namelist
+   !> - change format cn_north
+   ! 
+   !> @param[in] cd_card   boundary description
+   !> @param[in] id_jcard  boundary index
+   !> @return boundary structure
+   !------------------------------------------------------------------- 
+   FUNCTION boundary__get_info(cd_card, id_jcard) 
+      IMPLICIT NONE 
+      ! Argument 
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_card
+      INTEGER(i4)      , INTENT(IN) :: id_jcard
+
+      ! function 
+      TYPE(TBDY) :: boundary__get_info
+
+      ! local variable 
+      INTEGER(i4)       :: il_width
+      INTEGER(i4)       :: il_ind1
+      INTEGER(i4)       :: il_ind2
+
+      CHARACTER(LEN=lc) :: cl_seg
+      CHARACTER(LEN=lc) :: cl_index
+      CHARACTER(LEN=lc) :: cl_width
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_first
+      CHARACTER(LEN=lc) :: cl_last 
+
+      TYPE(TSEG)        :: tl_seg
+
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+ 
+      ji=1
+      cl_seg=fct_split(cd_card,ji)
+
+      il_width=0
+      ! look for segment width 
+      ! width should be the same for all segment of one boundary
+      IF( TRIM(cl_seg)   /= '' )THEN
+
+         ! initialise boundary
+         ! temporaty boundary, so it doesn't matter which caridnal is used
+         boundary__get_info=boundary__init('north',ld_nam=.TRUE.)
+
+         il_ind1=SCAN(fct_lower(cl_seg),'(')
+         IF( il_ind1 /=0 )THEN
+            cl_width=TRIM(cl_seg(il_ind1+1:))
+
+            il_ind2=SCAN(fct_lower(cl_width),')')
+            IF( il_ind2 /=0 )THEN
+               cl_width=TRIM(cl_width(1:il_ind2-1))
+               READ(cl_width,*) il_width
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF
+
+      ENDIF 
+
+      DO WHILE( TRIM(cl_seg) /= '' )
+
+         cl_index=fct_split(cl_seg,1,',')
+         ! remove potential width information
+         il_ind1=SCAN(fct_lower(cl_index),'(')
+         IF( il_ind1 /=0 )THEN
+            il_ind2=SCAN(fct_lower(cl_index),')')
+            IF( il_ind2 /=0 )THEN
+               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:))
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF
+      
+         
+         cl_tmp=fct_split(cl_seg,2,',')
+
+
+         cl_first=fct_split(cl_tmp,1,':')
+         ! remove potential width information
+         il_ind1=SCAN(fct_lower(cl_first),'(')
+         IF( il_ind1 /=0 )THEN
+            il_ind2=SCAN(fct_lower(cl_first),')')
+            IF( il_ind2 /=0 )THEN
+               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:))
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF         
+         
+         cl_last =fct_split(cl_tmp,2,':')
+         ! remove potential width information
+         il_ind1=SCAN(fct_lower(cl_last),'(')
+         IF( il_ind1 /=0 )THEN
+            il_ind2=SCAN(fct_lower(cl_last),')')
+            IF( il_ind2 /=0 )THEN
+               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:))
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF
+
+         IF( il_width /= 0 ) tl_seg%i_width=il_width
+
+         IF( TRIM(cl_index) /= '' ) READ(cl_index,*) tl_seg%i_index
+         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first
+         IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last
+
+         ! index expressed on U,V point, move on T point.
+         SELECT CASE(id_jcard)
+            CASE(jp_north, jp_east)
+               tl_seg%i_index=tl_seg%i_index+1
+         END SELECT
+
+         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. &
+         &   (tl_seg%i_first /= 0 .AND.  tl_seg%i_last /= 0) )THEN
+            CALL boundary__add_seg(boundary__get_info, tl_seg)
+         ELSE
+            CALL logger_error("BOUNDARY INIT: first or last segment indices "//&
+            &              "are missing . check namelist.")
+         ENDIF
+
+         ji=ji+1
+         cl_seg=fct_split(cd_card,ji)
+
+         ! clean
+         CALL seg__clean(tl_seg)
+      ENDDO 
+
+   END FUNCTION boundary__get_info 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine get indices of each semgent for each boundary.
+   ! 
+   !> @details 
+   !> indices are compute from variable value, actually variable fill value,
+   !> which is assume to be land mask. 
+   !> Boundary structure should have been initialized before running 
+   !> this subroutine. Segment indices will be search between first and last
+   !> indies, at this orthogonal index.
+   !> 
+   !> Optionnally you could forced to use only one segment for each boundary.
+   !> 
+   !> @warning number of segment (i_nseg) will be change, before the number 
+   !> of segment structure
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure  
+   !> @param[in] td_var    variable structure 
+   !> @param[in] ld_onseg  use only one sgment for each boundary 
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
+      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
+      LOGICAL                         , INTENT(IN   ), OPTIONAL :: ld_oneseg
+
+      ! local variable 
+      INTEGER(i4) :: il_index
+      INTEGER(i4) :: il_width
+      INTEGER(i4) :: il_first
+      INTEGER(i4) :: il_last 
+
+      LOGICAL     :: ll_oneseg
+
+      TYPE(TSEG)  :: tl_seg
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !---------------------------------------------------------------- 
+ 
+      ll_oneseg=.TRUE.
+      IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
+
+      DO jk=1,ip_ncard
+         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN
+            ! nothing to be done
+         ELSE
+
+            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
+               CALL logger_error("BOUNDARY GET INDICES: no segment "//&
+               &  " associated to "//TRIM(td_bdy(jk)%c_card)//&
+               &  " boundary. you should have run boundary_init before"//&
+               &  " running boundary_get_indices" )
+            ELSE
+               il_index=td_bdy(jk)%t_seg(1)%i_index
+               il_width=td_bdy(jk)%t_seg(1)%i_width
+               il_first=td_bdy(jk)%t_seg(1)%i_first
+               il_last =td_bdy(jk)%t_seg(1)%i_last
+ 
+               CALL boundary__get_seg_number( td_bdy(jk), td_var)
+
+               CALL boundary__get_seg_indices( td_bdy(jk), td_var, &
+               &                               il_index, il_width, &
+               &                               il_first, il_last )
+
+               IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN
+                  tl_seg=seg__copy(td_bdy(jk)%t_seg(1))
+                  ! use last indice of last segment
+                  tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last
+
+                  ! remove all segment from boundary
+                  CALL boundary__del_seg(td_bdy(jk))
+
+                  ! add one segment
+                  CALL boundary__add_seg(td_bdy(jk),tl_seg)
+
+                  ! clean
+                  CALL seg__clean(tl_seg)
+               ENDIF
+
+            ENDIF
+
+         ENDIF
+
+      ENDDO
+
+   END SUBROUTINE boundary_get_indices 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine compute the number of sea segment. 
+   ! 
+   !> @details 
+   !> It use variable value, actually variable fill value
+   !> (which is assume to be land mask), to compute the number of segment between
+   !> first and last indices at boundary orthogonal index.
+   !> @warning number of segment (i_nseg) will be change, before the number 
+   !> of segment structure
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure 
+   !> @param[in] td_var    variable structure 
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary__get_seg_number( td_bdy, td_var) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+
+      ! local variable 
+      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
+      LOGICAL                                        :: ll_sea
+      INTEGER(i4)                                    :: il_index
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+ 
+      IF( td_bdy%l_use .AND. td_bdy%i_nseg == 1 )THEN
+
+         il_index=td_bdy%t_seg(1)%i_index
+
+         SELECT CASE(TRIM(td_bdy%c_card))
+            CASE('north','south')
+
+               ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
+               dl_value(:)=td_var%d_value(:,il_index,1,1)
+
+               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
+                  
+                  td_bdy%l_use=.TRUE.
+                  td_bdy%i_nseg=0
+
+                  ll_sea=.FALSE.
+                  DO ji=1,td_var%t_dim(1)%i_len
+                     IF( dl_value(ji)/= td_var%d_fill )THEN
+                        IF( .NOT. ll_sea )THEN
+                           td_bdy%i_nseg=td_bdy%i_nseg+1
+                        ENDIF
+                        ll_sea=.TRUE.
+                     ELSE
+                        ll_sea=.FALSE.
+                     ENDIF
+                  ENDDO
+
+               ELSE
+                  td_bdy%l_use=.FALSE.
+                  td_bdy%i_nseg=0
+               ENDIF
+
+               DEALLOCATE( dl_value )
+
+            CASE('east','west')
+
+               ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
+               dl_value(:)=td_var%d_value(il_index,:,1,1)
+
+               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
+                  
+                  td_bdy%l_use=.TRUE.
+                  td_bdy%i_nseg=0
+
+                  ll_sea=.FALSE.
+                  DO ji=1,td_var%t_dim(2)%i_len
+                     IF( dl_value(ji)/= td_var%d_fill )THEN
+                        IF( .NOT. ll_sea )THEN
+                           td_bdy%i_nseg=td_bdy%i_nseg+1
+                        ENDIF
+                        ll_sea=.TRUE.
+                     ELSE
+                        ll_sea=.FALSE.
+                     ENDIF
+                  ENDDO
+
+               ELSE
+                  td_bdy%l_use=.FALSE.
+                  td_bdy%i_nseg=0
+               ENDIF
+
+               DEALLOCATE( dl_value )
+
+         END SELECT
+      ENDIF
+ 
+   END SUBROUTINE boundary__get_seg_number 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine get segment indices for one boundary.
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure  
+   !> @param[in] td_var    variable structure  
+   !> @param[in] id_index  boundary orthogonal index  
+   !> @param[in] id_width  bounary width 
+   !> @param[in] id_first  boundary first indice
+   !> @param[in] id_last   boundary last  indice
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, &
+   &                                     id_index, id_width, id_first, id_last) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+      INTEGER(i4), INTENT(IN   ) :: id_index
+      INTEGER(i4), INTENT(IN   ) :: id_width
+      INTEGER(i4), INTENT(IN   ) :: id_first
+      INTEGER(i4), INTENT(IN   ) :: id_last
+
+      ! local variable 
+      INTEGER(i4)                                    :: il_nseg
+      INTEGER(i4), DIMENSION(ip_ncard)               :: il_max
+      INTEGER(i4), DIMENSION(ip_ncard)               :: il_min
+
+      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
+
+      LOGICAL                                        :: ll_sea
+      LOGICAL                                        :: ll_first
+      LOGICAL                                        :: ll_last
+
+      TYPE(TSEG)                                     :: tl_seg
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !---------------------------------------------------------------- 
+ 
+      SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+            jk=jp_north
+            
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
+            dl_value(:)=td_var%d_value(:,id_index,1,1)
+
+         CASE('south')
+            jk=jp_south
+
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
+            dl_value(:)=td_var%d_value(:,id_index,1,1)
+
+         CASE('east ')
+            jk=jp_east 
+
+            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
+            dl_value(:)=td_var%d_value(id_index,:,1,1)
+
+         CASE('west ')
+            jk=jp_west 
+
+            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
+            dl_value(:)=td_var%d_value(id_index,:,1,1)
+
+      END SELECT
+
+      il_max(jp_north)=td_var%t_dim(1)%i_len-ip_ghost
+      il_max(jp_south)=td_var%t_dim(1)%i_len-ip_ghost
+      il_max(jp_east )=td_var%t_dim(2)%i_len-ip_ghost
+      il_max(jp_west )=td_var%t_dim(2)%i_len-ip_ghost
+
+      il_min(jp_north)=1+ip_ghost
+      il_min(jp_south)=1+ip_ghost
+      il_min(jp_east )=1+ip_ghost
+      il_min(jp_west )=1+ip_ghost
+         
+      ! special case for EW cyclic 
+      IF( td_var%i_ew >= 0 )THEN
+         il_min(jp_north)=1
+         il_min(jp_south)=1
+
+         il_max(jp_north)=td_var%t_dim(1)%i_len
+         il_max(jp_south)=td_var%t_dim(1)%i_len
+      ENDIF
+      
+      il_nseg=td_bdy%i_nseg
+      ! remove all segment from boundary
+      CALL boundary__del_seg(td_bdy)
+
+      ll_first=.FALSE.
+      ll_last =.FALSE.
+      DO jl=1,il_nseg
+
+         ! init
+         tl_seg=seg__init(id_index,id_width,id_first,id_last)
+
+         IF( .NOT. (ll_first .AND. ll_last) )THEN
+            ! first loop
+            tl_seg%i_first=MAX(id_first,il_min(jk))
+            tl_seg%i_last =MIN(id_last ,il_max(jk))
+         ELSE
+            ! load new min and max
+            tl_seg%i_first=MAX(td_bdy%t_seg(jl-1)%i_last,il_min(jk))
+            tl_seg%i_last =MIN(id_last                  ,il_max(jk))
+         ENDIF
+
+         ll_first=.FALSE.
+         ll_last =.FALSE.
+         ll_sea  =.FALSE.
+
+         DO ji=tl_seg%i_first,tl_seg%i_last
+
+            IF( ll_first .AND. ll_last )THEN
+               ! first and last point already loaded
+               ! look for next segment
+               EXIT
+            ENDIF
+
+            IF( dl_value(ji)/= td_var%d_fill )THEN
+               IF( .NOT. ll_sea )THEN
+                  tl_seg%i_first=MAX(tl_seg%i_first,ji-1)
+                  ll_first=.true.
+               ENDIF
+               ll_sea=.TRUE.
+            ELSE
+               IF( ll_sea )THEN
+                  tl_seg%i_last=ji
+                  ll_last=.TRUE.
+               ENDIF
+               ll_sea=.FALSE.
+            ENDIF
+            
+         ENDDO
+
+         CALL boundary__add_seg(td_bdy,tl_seg)
+
+         ! clean
+         CALL seg__clean(tl_seg)
+         
+      ENDDO
+
+      DEALLOCATE(dl_value)
+      
+   END SUBROUTINE boundary__get_seg_indices 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine check if there is boundary at corner, and 
+   !> adjust boundary indices if necessary. 
+   ! 
+   !> @details 
+   !> If there is a north west corner, first indices of north boundary
+   !> should be the same as the west boundary indices. 
+   !> And the last indices of the west boundary should be the same as
+   !> the north indices.
+   !> More over the width of west and north boundary should be the same.
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure
+   !> @param[in] td_var    variable structure
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary_check_corner( td_bdy, td_var )
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
+      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
+
+      ! local variable 
+      TYPE(TSEG)  :: tl_north
+      TYPE(TSEG)  :: tl_south
+      TYPE(TSEG)  :: tl_east 
+      TYPE(TSEG)  :: tl_west
+
+      INTEGER(i4) :: il_width
+
+      ! loop indices
+      !---------------------------------------------------------------- 
+ 
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("BOUNDARY CHEKC CORNER: no value associated "//&
+         &              "to variable "//TRIM(td_var%c_name))
+      ENDIF
+
+      ! check north west corner
+      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_west)%l_use )THEN
+         tl_west =seg__copy(td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg))
+         tl_north=seg__copy(td_bdy(jp_north)%t_seg(1))
+
+         IF( tl_west%i_last  >= tl_north%i_index .AND. &
+         &   tl_west%i_index >= tl_north%i_first ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &                 "a north west corner")
+
+            tl_west%i_last   = tl_north%i_index
+            tl_north%i_first = tl_west%i_index
+
+            IF( tl_west%i_width /= tl_north%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between north and west boundary ")
+
+               il_width=MIN(tl_west%i_width,tl_north%i_width)
+               
+               tl_west%i_width =il_width
+               tl_north%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)=seg__copy(tl_west)
+            td_bdy(jp_north)%t_seg(1)                     =seg__copy(tl_north)
+
+         ELSE
+
+            IF( td_var%d_value(tl_north%i_first,tl_north%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "north boundary first indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_west%i_index,tl_west%i_last,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "west boundary last indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! check north east corner
+      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_east)%l_use )THEN
+         tl_east =seg__copy(td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg))
+         tl_north=seg__copy(td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg))
+
+         IF( tl_east%i_last  >= tl_north%i_index .AND. &
+         &   tl_east%i_index <= tl_north%i_last ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &              "a north east corner")
+
+            tl_east%i_last  = tl_north%i_index
+            tl_north%i_last = tl_east%i_index
+
+            IF( tl_east%i_width /= tl_north%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between north and east boundary ")
+
+               il_width=MIN(tl_east%i_width,tl_north%i_width)
+               
+               tl_east%i_width =il_width
+               tl_north%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)=seg__copy(tl_east)
+            td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)=seg__copy(tl_north)
+         ELSE
+
+            IF( td_var%d_value(tl_north%i_last,tl_north%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "north boundary last indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_east%i_index,tl_east%i_last,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "east boundary last indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! check south east corner
+      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_east)%l_use )THEN
+         tl_east =seg__copy(td_bdy(jp_east )%t_seg(1))
+         tl_south=seg__copy(td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg))
+
+         IF( tl_east%i_first <= tl_south%i_index .AND. &
+         &   tl_east%i_index <= tl_south%i_last ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &              "a south east corner")
+
+            tl_east%i_first = tl_south%i_index
+            tl_south%i_last = tl_east%i_index
+
+            IF( tl_east%i_width /= tl_south%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between south and east boundary ")
+
+               il_width=MIN(tl_east%i_width,tl_south%i_width)
+               
+               tl_east%i_width =il_width
+               tl_south%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_east )%t_seg(1)                      =seg__copy(tl_east)
+            td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)=seg__copy(tl_south)
+         ELSE
+
+            IF( td_var%d_value(tl_south%i_last,tl_south%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "south boundary last indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_east%i_index,tl_east%i_first,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "east boundary first indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! check south west corner
+      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_west)%l_use )THEN
+         tl_west =seg__copy(td_bdy(jp_west )%t_seg(1))
+         tl_south=seg__copy(td_bdy(jp_south)%t_seg(1))
+
+         IF( tl_west%i_first <= tl_south%i_index .AND. &
+         &   tl_west%i_index >= tl_south%i_first ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &              "a south west corner")
+
+            tl_west%i_first = tl_south%i_index
+            tl_south%i_first= tl_west%i_index
+
+            IF( tl_west%i_width /= tl_south%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between south and west boundary ")
+
+               il_width=MIN(tl_west%i_width,tl_south%i_width)
+               
+               tl_west%i_width =il_width
+               tl_south%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west)
+            td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south)
+         ELSE
+
+            IF( td_var%d_value(tl_south%i_first,tl_south%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "south boundary first indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_west%i_index,tl_west%i_first,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "west boundary first indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! clean
+      CALL seg__clean(tl_north)
+      CALL seg__clean(tl_south)
+      CALL seg__clean(tl_east )
+      CALL seg__clean(tl_west )
+
+   END SUBROUTINE boundary_check_corner 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine check boundary.
+   ! 
+   !> @details 
+   !> It checks that first and last indices as well as orthogonal index are
+   !> inside domain, and check corner (see boundary_check_corner).
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !> @date June, 2016
+   !> - Bug fix: take into account that boundaries are compute on T point,
+   !>   but expressed on U,V point
+   !>
+   !> @param[inout] td_bdy boundary structure 
+   !> @param[in] td_var    variable structure 
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary_check(td_bdy, td_var) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
+      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
+
+      ! local variable 
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_maxindex
+
+      ! loop indices 
+      INTEGER(i4) :: jk
+      !---------------------------------------------------------------- 
+ 
+      il_max(jp_north)=td_var%t_dim(1)%i_len
+      il_max(jp_south)=td_var%t_dim(1)%i_len
+      il_max(jp_east )=td_var%t_dim(2)%i_len
+      il_max(jp_west )=td_var%t_dim(2)%i_len
+ 
+      ! index expressed on U,V point, move on T point.
+      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost+1
+      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost
+      il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost+1
+      il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ip_ghost
+
+      DO jk=1,ip_ncard
+         IF( td_bdy(jk)%l_use )THEN
+            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
+               CALL logger_error("BOUNDARY CHECK: no segment associted "//&
+               &                 "to "//TRIM(td_bdy(jk)%c_card)//" boundary")
+            ELSE
+               ! check indices
+               IF( ANY(td_bdy(jk)%t_seg(:)%i_first < 1         ) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_first > il_max(jk)) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_last  < 1         ) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_last  > il_max(jk)) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_first > td_bdy(jk)%t_seg(:)%i_last)&
+               & )THEN
+                  CALL logger_error("BOUNDARY CHECK: invalid segment "//&
+                  &              "first and/or last indice for "//&
+                  &              TRIM(td_bdy(jk)%c_card)//&
+                  &              " boundary. check namelist")
+               ENDIF
+
+               IF( ANY(td_bdy(jk)%t_seg(:)%i_index < 1         ) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_index > il_maxindex(jk)) &
+               & )THEN
+                  CALL logger_error("BOUNDARY CHECK: invalid index "//&
+                  &              "for "//TRIM(td_bdy(jk)%c_card)//&
+                  &              " boundary. check namelist")
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+ 
+      CALL boundary_check_corner(td_bdy, td_var)
+
+   END SUBROUTINE boundary_check
+   !-------------------------------------------------------------------
+   !> @brief This subroutine swap array for east and north boundary.
+   !
+   !> @detail
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable strucutre
+   !> @param[in   ] td_bdy boundary strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE boundary_swap( td_var, td_bdy )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TBDY), INTENT(IN   ) :: td_bdy
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("BOUNDARY SWAP: no array of value "//&
+         &  "associted to variable "//TRIM(td_var%c_name) )
+      ELSE      
+
+         SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
+            &                  td_var%t_dim(2)%i_len, &
+            &                  td_var%t_dim(3)%i_len, &
+            &                  td_var%t_dim(4)%i_len) )
+
+            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+            DO jj=1, td_var%t_dim(2)%i_len
+               td_var%d_value(:,jj,:,:) = &
+               &  dl_value(:,td_var%t_dim(2)%i_len-jj+1,:,:)
+            ENDDO
+
+            DEALLOCATE( dl_value )         
+         CASE('east')
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
+            &                  td_var%t_dim(2)%i_len, &
+            &                  td_var%t_dim(3)%i_len, &
+            &                  td_var%t_dim(4)%i_len) )
+
+            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+            DO ji=1, td_var%t_dim(1)%i_len
+               td_var%d_value(ji,:,:,:) = &
+               &  dl_value(td_var%t_dim(1)%i_len-ji+1,:,:,:)
+            ENDDO
+
+            DEALLOCATE( dl_value )
+         CASE DEFAULT
+         ! nothing to be done
+         END SELECT
+
+      ENDIF
+   END SUBROUTINE boundary_swap
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine print information about one boundary. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] td_bdy boundary structure 
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary__print_unit( td_bdy ) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY), INTENT(IN) :: td_bdy
+      ! local variable 
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+
+      WRITE(*,'(a,/1x,a,/1x,a)') "Boundary "//TRIM(td_bdy%c_card), &
+      &  " use  "//TRIM(fct_str(td_bdy%l_use)), &
+      &  " nseg "//TRIM(fct_str(td_bdy%i_nseg))
+      DO ji=1,td_bdy%i_nseg
+         WRITE(*,'(4(/1x,a))') &
+         &  " index "//TRIM(fct_str(td_bdy%t_seg(ji)%i_index)), &
+         &  " width "//TRIM(fct_str(td_bdy%t_seg(ji)%i_width)), &
+         &  " first "//TRIM(fct_str(td_bdy%t_seg(ji)%i_first)), &
+         &  " last  "//TRIM(fct_str(td_bdy%t_seg(ji)%i_last))
+      ENDDO
+ 
+   END SUBROUTINE boundary__print_unit
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine print information about a array of boundary 
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] td_bdy boundary structure 
+   !------------------------------------------------------------------- 
+   SUBROUTINE boundary__print_arr( td_bdy ) 
+      IMPLICIT NONE 
+      ! Argument
+      TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy
+      ! local variable 
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+
+      DO ji=1,SIZE(td_bdy(:))
+         CALL boundary_print(td_bdy(ji))
+      ENDDO
+ 
+   END SUBROUTINE boundary__print_arr
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy segment structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_seg   segment structure
+   !> @return copy of input segment structure
+   !-------------------------------------------------------------------
+   FUNCTION seg__copy_unit( td_seg )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TSEG), INTENT(IN)  :: td_seg
+      ! function
+      TYPE(TSEG) :: seg__copy_unit
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy segment index, width, ..
+      seg__copy_unit%i_index    = td_seg%i_index
+      seg__copy_unit%i_width    = td_seg%i_width
+      seg__copy_unit%i_first    = td_seg%i_first
+      seg__copy_unit%i_last     = td_seg%i_last 
+
+   END FUNCTION seg__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy segment structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.   
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_seg   segment structure
+   !> @return copy of input array of segment structure
+   !-------------------------------------------------------------------
+   FUNCTION seg__copy_arr( td_seg )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TSEG), DIMENSION(:), INTENT(IN)  :: td_seg
+      ! function
+      TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: seg__copy_arr
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_seg(:))
+         seg__copy_arr(ji)=seg__copy(td_seg(ji))
+      ENDDO
+
+   END FUNCTION seg__copy_arr
+   !------------------------------------------------------------------- 
+   !> @brief This function  initialise segment structure.
+   ! 
+   !> @details 
+   !> It simply add orthogonal index, and optionnaly width, first
+   !> and last indices of the segment. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] id_index  orthogonal index
+   !> @param[in] id_width  width of the segment 
+   !> @param[in] id_first  first indices 
+   !> @param[in] id_last   last  indices
+   !> @return segment structure
+   !------------------------------------------------------------------- 
+   FUNCTION seg__init( id_index, id_width, id_first, id_last ) 
+      IMPLICIT NONE 
+      ! Argument
+      INTEGER(i4), INTENT(IN) :: id_index
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_width
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_first
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_last 
+
+      ! function 
+      TYPE(TSEG) :: seg__init
+
+      ! local variable 
+      
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      seg__init%i_index=id_index
+
+      IF( PRESENT(id_width) ) seg__init%i_width=id_width
+      IF( PRESENT(id_first) ) seg__init%i_first=id_first
+      IF( PRESENT(id_last ) ) seg__init%i_last =id_last
+
+   END FUNCTION seg__init 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine clean segment structure. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_seg segment structure
+   !------------------------------------------------------------------- 
+   SUBROUTINE seg__clean_unit(td_seg) 
+      IMPLICIT NONE 
+      ! Argument       
+      TYPE(TSEG), INTENT(INOUT) :: td_seg
+      ! local variable 
+      TYPE(TSEG) :: tl_seg
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      td_seg=seg__copy(tl_seg)
+ 
+   END SUBROUTINE seg__clean_unit
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine clean segment structure. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_seg array of segment structure
+   !------------------------------------------------------------------- 
+   SUBROUTINE seg__clean_arr(td_seg) 
+      IMPLICIT NONE 
+      ! Argument       
+      TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg
+      ! local variable 
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+
+      DO ji=SIZE(td_seg(:)),1,-1
+         CALL seg__clean(td_seg(ji))
+      ENDDO
+ 
+   END SUBROUTINE seg__clean_arr 
+END MODULE boundary
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90	(revision 8732)
@@ -0,0 +1,1222 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! PROGRAM: create_bathy
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates fine grid bathymetry file.
+!>
+!> @details
+!> @section sec1 method
+!> Bathymetry could be extracted from fine grid Bathymetry file, interpolated
+!> from coarse grid Bathymetry file, or manually written.
+!>
+!> @section sec2 how to
+!>    to create fine grid bathymetry file:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/create_bathy create_bathy.nam
+!> @endcode
+!> <br/>    
+!> \image html  bathy_40.png 
+!> <center>\image latex bathy_30.png
+!> </center>
+!>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_bathy.nam contains 7 namelists:<br/>
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - coarse grid namelist (namcrs)
+!>       - fine grid namelist (namfin)
+!>       - variable namelist (namvar)
+!>       - nesting namelist (namnst)
+!>       - output namelist (namout)
+!>    
+!>    * _logger namelist (namlog)_:<br/>
+!>       - cn_logfile   : log filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!> 'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:<br/>
+!>       - cn_varcfg : variable configuration file 
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dimcfg : dimension configuration file. defines dimension allowed
+!> (see ./SIREN/cfg/dimension.cfg).
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _coarse grid namelist (namcrs)_:<br/>
+!>       - cn_coord0 : coordinate file
+!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
+!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
+!>
+!>    * _fine grid namelist (namfin)_:<br/>
+!>       - cn_coord1 : coordinate file
+!>       - in_perio1 : periodicity index
+!>       - ln_fillclosed : fill closed sea or not (default is .TRUE.)
+!>
+!>    * _variable namelist (namvar)_:<br/>
+!>       - cn_varfile : list of variable, and corresponding file.<br/> 
+!>          *cn_varfile* is the path and filename of the file where find
+!>          variable.
+!>          @note 
+!>             *cn_varfile* could be a matrix of value, if you want to filled
+!>             manually variable value.<br/>
+!>             the variable array of value is split into equal subdomain.<br/>
+!>             Each subdomain is filled with the corresponding value 
+!>             of the matrix.<br/>          
+!>             separators used to defined matrix are:
+!>                - ',' for line
+!>                - '/' for row
+!>                Example:<br/>
+!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                         3 & 2 & 3 \\
+!>                                         1 & 4 & 5 \end{array} \right) @f$
+!>
+!>          Examples: 
+!>             - 'Bathymetry:gridT.nc'
+!>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000'
+!>
+!>       - cn_varinfo : list of variable and extra information about request(s) 
+!>       to be used.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
+!>          it is composed of the variable name follow by ':', 
+!>          then request(s) to be used on this variable.<br/> 
+!>          request could be:
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
+!>
+!>                requests must be separated by ';'.<br/>
+!>                order of requests does not matter.<br/>
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter modules.<br/>
+!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0'
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is apply.
+!>          @warning 
+!>             variable name must be __Bathymetry__ here.
+!>
+!>    * _nesting namelist (namnst)_:<br/>
+!>       - in_rhoi  : refinement factor in i-direction
+!>       - in_rhoj  : refinement factor in j-direction
+!>       @note 
+!>          coarse grid indices will be deduced from fine grid
+!>          coordinate file.
+!>
+!>    * _output namelist (namout)_:<br/>
+!>       - cn_fileout : output bathymetry file
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date Sepember, 2014 
+!> - add header for user
+!> - Bug fix, compute offset depending of grid point
+!> @date June, 2015
+!> - extrapolate all land points.
+!> - allow to change unit.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date January,2016
+!> - add create_bathy_check_depth as in create_boundary
+!> - add create_bathy_check_time  as in create_boundary
+!> @date February, 2016
+!> - do not closed sea for east-west cyclic domain
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!
+!> @todo
+!> - check tl_multi is not empty
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_bathy
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_data
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_attid
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+   INTEGER(i4)      , DIMENSION(:,:)    , ALLOCATABLE :: il_mask
+
+   LOGICAL                                            :: ll_exist
+   LOGICAL                                            :: ll_fillclosed
+
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_mpp
+   TYPE(TFILE)                                        :: tl_fileout
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   TYPE(TVAR)                                         :: tl_depth
+   TYPE(TVAR)                                         :: tl_time
+
+   TYPE(TVAR)                                         :: tl_tmp
+   TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE       :: tl_var
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   REAL(dp)                                           :: dl_minbat
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_bathy.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg' 
+
+   ! namcrs
+   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namfin
+   CHARACTER(LEN=lc)                       :: cn_coord1 = ''
+   INTEGER(i4)                             :: in_perio1 = -1
+   LOGICAL                                 :: ln_fillclosed = .TRUE.
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi  = 1
+   INTEGER(i4)                             :: in_rhoj  = 1
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_fine.nc' 
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &   !< logger namelist
+   &  cn_logfile,    &   !< log file
+   &  cn_verbosity,  &   !< log verbosity
+   &  in_maxerror        !< logger maximum error
+
+   NAMELIST /namcfg/ &   !< configuration namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namcrs/ &   !< coarse grid namelist
+   &  cn_coord0,  &      !< coordinate file
+   &  in_perio0          !< periodicity index
+   
+   NAMELIST /namfin/ &   !< fine grid namelist
+   &  cn_coord1,   &     !< coordinate file
+   &  in_perio1,   &     !< periodicity index
+   &  ln_fillclosed      !< fill closed sea
+ 
+   NAMELIST /namvar/ &   !< variable namelist
+   &  cn_varfile, &      !< list of variable file
+   &  cn_varinfo         !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
+   
+   NAMELIST /namnst/ &   !< nesting namelist
+   &  in_rhoi,    &      !< refinement factor in i-direction
+   &  in_rhoj            !< refinement factor in j-direction
+
+   NAMELIST /namout/ &   !< output namlist
+   &  cn_fileout         !< fine grid bathymetry file
+   !-------------------------------------------------------------------
+
+   ! namelist
+   ! get namelist
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+   IF( il_narg/=1 )THEN
+      PRINT *,"ERROR in create_bathy: need a namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+ 
+   ! read namelist
+   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+ 
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"ERROR in create_bathy: error opening "//TRIM(cl_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namcrs )
+      READ( il_fileid, NML = namfin )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra( cn_varinfo )
+      ! match variable with file
+      tl_multi=multi_init(cn_varfile)
+ 
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE BATHY: closing "//TRIM(cl_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"ERROR in create_bathy: can't find "//TRIM(cl_namelist)
+      STOP
+
+   ENDIF
+
+   CALL multi_print(tl_multi)
+
+   ! open files
+   IF( cn_coord0 /= '' )THEN
+      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE BATHY: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)),id_perio=in_perio1)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE BATHY: no fine grid coordinate found. "//&
+      &     "check namelist")
+   ENDIF
+
+   ! do not closed sea for east-west cyclic domain
+   ll_fillclosed=ln_fillclosed
+   IF( tl_coord1%i_perio == 1 ) ll_fillclosed=.FALSE.
+
+   ! check
+   ! check output file do not already exist
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE BATHY: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check namelist
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE BATHY: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   ! check domain indices
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, &
+   &                                  id_rho=il_rho(:) )
+
+   il_imin0=il_ind(jp_I,1) ; il_imax0=il_ind(jp_I,2)
+   il_jmin0=il_ind(jp_J,1) ; il_jmax0=il_ind(jp_J,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coincidence between coarse and fine grid
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )
+
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE BATHY: no mpp file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+
+      ALLOCATE( tl_var( tl_multi%i_nvar ) )
+      jk=0
+      DO ji=1,tl_multi%i_nmpp
+      
+         WRITE(cl_data,'(a,i2.2)') 'data-',jk+1
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_fatal("CREATE BATHY: no variable to work on for "//&
+            &                 "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+
+            !- use input matrix to initialise variable
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+               jk=jk+1
+               tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+            
+               tl_var(jk)=create_bathy_matrix(tl_tmp, tl_coord1)
+            ENDDO
+            ! clean
+            CALL var_clean(tl_tmp)
+
+         ELSE
+
+            tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%c_name)) )
+            CALL grid_get_info(tl_mpp)
+
+            ! open mpp file
+            CALL iom_mpp_open(tl_mpp)
+
+            ! get or check depth value
+            CALL create_bathy_check_depth( tl_mpp, tl_depth )
+
+            ! get or check time value
+            CALL create_bathy_check_time( tl_mpp, tl_time )
+
+            ! close mpp file
+            CALL iom_mpp_close(tl_mpp)
+
+            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len).OR.&
+            &   ALL(il_rho(:)==1) )THEN
+               !- extract bathymetry from fine grid bathymetry 
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+                  jk=jk+1
+                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+               
+                  tl_var(jk)=create_bathy_extract( tl_tmp, tl_mpp, &
+                  &                                tl_coord1 )
+               ENDDO
+               ! clean
+               CALL var_clean(tl_tmp)
+            ELSE
+               !- get bathymetry from coarse grid bathymetry 
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+                  jk=jk+1
+                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+                  il_offset(:,:)= grid_get_fine_offset(tl_coord0,    &
+                  &                                    il_imin0, il_jmin0, &
+                  &                                    il_imax0, il_jmax0, &
+                  &                                    tl_coord1,          &
+                  &                                    il_rho(:),          &
+                  &                                    TRIM(tl_tmp%c_point) )
+
+                  tl_var(jk)=create_bathy_get_var( tl_tmp, tl_mpp,     &
+                  &                                il_imin0, il_jmin0, &
+                  &                                il_imax0, il_jmax0, &
+                  &                                il_offset(:,:),  &
+                  &                                il_rho(:) )
+               ENDDO
+               ! clean
+               CALL var_clean(tl_tmp)
+            ENDIF
+
+            ! clean structure
+            CALL mpp_clean(tl_mpp)
+
+         ENDIF
+      ENDDO
+   ENDIF
+
+   ! use additional request
+   DO jk=1,tl_multi%i_nvar
+
+         ! change unit and apply factor
+         CALL var_chg_unit(tl_var(jk))
+
+         ! forced min and max value
+         CALL var_limit_value(tl_var(jk))
+
+         ! fill closed sea
+         IF( ll_fillclosed )THEN
+            ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, &
+            &                 tl_var(jk)%t_dim(2)%i_len) )
+
+            ! split domain in N sea subdomain
+            il_mask(:,:)=grid_split_domain(tl_var(jk))
+
+            !  fill smallest domain
+            CALL grid_fill_small_dom( tl_var(jk), il_mask(:,:) )
+
+            DEALLOCATE( il_mask )
+         ENDIF
+
+         ! filter
+         CALL filter_fill_value(tl_var(jk))
+
+         ! check bathymetry
+         dl_minbat=MINVAL(tl_var(jk)%d_value(:,:,:,:))
+         IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. &
+         &   dl_minbat <= 0._dp  )THEN
+            CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat)))
+            CALL logger_fatal("CREATE BATHY: Bathymetry has value <= 0")
+         ENDIF
+
+   ENDDO
+
+   ! create file
+   tl_fileout=file_init(TRIM(cn_fileout))
+
+   ! add dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,ip_maxdim
+      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord1)
+
+      ! add longitude
+      tl_lon=iom_mpp_read_var(tl_coord1,'longitude')
+      CALL file_add_var(tl_fileout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      tl_lat=iom_mpp_read_var(tl_coord1,'latitude')
+      CALL file_add_var(tl_fileout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord1)
+
+   ENDIF
+
+   IF( tl_dim(3)%l_use )THEN
+      ! add depth
+      CALL file_add_var(tl_fileout, tl_depth)
+      CALL var_clean(tl_depth)
+   ENDIF
+
+   IF( tl_dim(4)%l_use )THEN
+      ! add time
+      CALL file_add_var(tl_fileout, tl_time)
+      CALL var_clean(tl_time)
+   ENDIF
+
+   ! add other variables
+   DO jk=tl_multi%i_nvar,1,-1
+      CALL file_add_var(tl_fileout, tl_var(jk))
+      CALL var_clean(tl_var(jk))
+   ENDDO
+   DEALLOCATE(tl_var)
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN create_bathy")
+   CALL file_add_att(tl_fileout, tl_att)
+
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_coord1%i_perio)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+   ! add attribute east west overlap
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_coord1%i_ew)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+   
+   ! create file
+   CALL iom_create(tl_fileout)
+
+   ! write file
+   CALL iom_write_file(tl_fileout)
+
+   ! close file
+   CALL iom_close(tl_fileout)
+
+   ! clean
+   CALL att_clean(tl_att)
+
+   CALL file_clean(tl_fileout)
+   CALL mpp_clean(tl_coord1)
+   CALL mpp_clean(tl_coord0)
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file.<br/> 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is filled with the corresponding value of the matrix.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_coord  coordinate file structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION create_bathy_matrix(td_var, td_coord)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+      TYPE(TMPP), INTENT(IN) :: td_coord
+
+      ! function
+      TYPE(TVAR) :: create_bathy_matrix
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
+      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(3)                    :: il_size
+      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
+
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TVAR)                                         :: tl_lon
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      TYPE(TMPP)                                         :: tl_coord
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! copy structure
+      tl_coord=mpp_copy(td_coord)
+
+      ! use only edge processor
+      CALL mpp_get_contour(tl_coord)
+
+      ! open useful processor
+      CALL iom_mpp_open(tl_coord)
+
+      ! read output grid
+      tl_lon=iom_mpp_read_var(tl_coord,'longitude')
+
+      ! look for ghost cell
+      il_xghost(:,:)=grid_get_ghost( tl_coord )
+
+      ! close processor
+      CALL iom_mpp_close(tl_coord)
+      ! clean
+      CALL mpp_clean(tl_coord)
+
+      ! remove ghost cell
+      CALL grid_del_ghost(tl_lon, il_xghost(:,:))
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:3)%i_len
+      ! output dimension
+      tl_dim(:)=dim_copy(tl_lon%t_dim(:))
+      ! clean
+      CALL var_clean(tl_lon)
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ALLOCATE( il_kshape(il_dim(3)+1) )
+      il_kshape(:)=0
+      DO jk=2,il_dim(3)+1
+         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
+      ENDDO
+      ! add rest to last cell
+      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+
+      DO jk=2,il_dim(3)+1
+         DO jj=2,il_dim(2)+1
+            DO ji=2,il_dim(1)+1
+               
+               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+               &         1+il_jshape(jj-1):il_jshape(jj), &
+               &         1+il_kshape(jk-1):il_kshape(jk), &
+               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! initialise variable with value
+      create_bathy_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+
+      ! add ghost cell
+      CALL grid_add_ghost(create_bathy_matrix, il_xghost(:,:))
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END FUNCTION create_bathy_matrix
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function extract variable from file over coordinate domain and
+   !> return variable structure
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_mpp    mpp file structure
+   !> @param[in] td_coord  coordinate file structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION create_bathy_extract(td_var, td_mpp, &
+   &                             td_coord)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var  
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+      TYPE(TMPP), INTENT(IN) :: td_coord
+
+      ! function
+      TYPE(TVAR) :: create_bathy_extract
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2,2) :: il_ind
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmax
+
+      TYPE(TMPP)  :: tl_mpp
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TVAR)  :: tl_var
+      
+      TYPE(TDOM)  :: tl_dom
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+         CALL logger_error("CREATE BATHY EXTRACT: no processor associated "//&
+         &  "to mpp "//TRIM(td_mpp%c_name))
+      ELSE
+
+         !init
+         tl_mpp=mpp_copy(td_mpp)
+
+         ! compute file grid indices around coord grid
+         il_ind(:,:)=grid_get_coarse_index(tl_mpp, td_coord )
+
+         il_imin=il_ind(1,1) ; il_imax=il_ind(1,2)
+         il_jmin=il_ind(2,1) ; il_jmax=il_ind(2,2)
+
+         ! check grid coincidence
+         CALL grid_check_coincidence( tl_mpp, td_coord, &
+         &                            il_imin, il_imax, &
+         &                            il_jmin, il_jmax, &
+         &                            (/1, 1, 1/) )
+
+         ! compute domain
+         tl_dom=dom_init(tl_mpp,           &
+         &               il_imin, il_imax, &
+         &               il_jmin, il_jmax)
+
+         ! open mpp files over domain
+         CALL iom_dom_open(tl_mpp, tl_dom)
+
+         ! read variable on domain
+         tl_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom)
+
+         ! close mpp file
+         CALL iom_dom_close(tl_mpp)
+
+         ! add ghost cell
+         CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:))
+
+         ! check result
+         IF( ANY( tl_var%t_dim(:)%l_use .AND. &
+         &        tl_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN
+            CALL logger_debug("CREATE BATHY EXTRACT: "//&
+            &        "dimensoin of variable "//TRIM(td_var%c_name)//" "//&
+            &        TRIM(fct_str(tl_var%t_dim(1)%i_len))//","//&
+            &        TRIM(fct_str(tl_var%t_dim(2)%i_len))//","//&
+            &        TRIM(fct_str(tl_var%t_dim(3)%i_len))//","//&
+            &        TRIM(fct_str(tl_var%t_dim(4)%i_len)) )
+            CALL logger_debug("CREATE BATHY EXTRACT: "//&
+            &        "dimensoin of coordinate file "//&
+            &        TRIM(fct_str(td_coord%t_dim(1)%i_len))//","//&
+            &        TRIM(fct_str(td_coord%t_dim(2)%i_len))//","//&
+            &        TRIM(fct_str(td_coord%t_dim(3)%i_len))//","//&
+            &        TRIM(fct_str(td_coord%t_dim(4)%i_len)) )
+            CALL logger_fatal("CREATE BATHY EXTRACT: "//&
+            &  "dimensoin of extracted "//&
+            &  "variable and coordinate file dimension differ")
+         ENDIF
+
+         ! add attribute to variable
+         tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+         CALL var_move_att(tl_var, tl_att)         
+
+         tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/))
+         CALL var_move_att(tl_var, tl_att)
+
+         tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))
+         CALL var_move_att(tl_var, tl_att)
+
+         ! save result
+         create_bathy_extract=var_copy(tl_var)
+
+         ! clean structure
+         CALL att_clean(tl_att)
+         CALL var_clean(tl_var)
+         CALL mpp_clean(tl_mpp)
+      ENDIF
+
+   END FUNCTION create_bathy_extract
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function get coarse grid variable, interpolate variable, and return
+   !> variable structure over fine grid
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure
+   !> @param[in] td_mpp    mpp file structure
+   !> @param[in] id_imin   i-direction lower left  corner indice 
+   !> @param[in] id_imax   i-direction upper right corner indice 
+   !> @param[in] id_jmin   j-direction lower left  corner indice
+   !> @param[in] id_jmax   j-direction upper right corner indice 
+   !> @param[in] id_offset offset between fine grid and coarse grid
+   !> @param[in] id_rho    array of refinement factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION create_bathy_get_var(td_var, td_mpp,   &
+            &                    id_imin, id_jmin, &
+            &                    id_imax, id_jmax, &
+            &                    id_offset,        &
+            &                    id_rho )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)                 , INTENT(IN) :: td_var  
+      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
+      INTEGER(i4)                , INTENT(IN) :: id_imin
+      INTEGER(i4)                , INTENT(IN) :: id_imax
+      INTEGER(i4)                , INTENT(IN) :: id_jmin
+      INTEGER(i4)                , INTENT(IN) :: id_jmax
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho
+
+      ! function
+      TYPE(TVAR) :: create_bathy_get_var
+
+      ! local variable
+      TYPE(TMPP)  :: tl_mpp
+      TYPE(TATT)  :: tl_att
+      TYPE(TVAR)  :: tl_var
+      TYPE(TDOM)  :: tl_dom
+
+      INTEGER(i4) :: il_size
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
+         CALL logger_error("CREATE BATHY GET VAR: invalid dimension of "//&
+         &                 "offset array")
+      ENDIF
+
+      ! copy structure
+      tl_mpp=mpp_copy(td_mpp)
+
+      !- compute domain
+      tl_dom=dom_init(tl_mpp,           &
+      &               id_imin, id_imax, &
+      &               id_jmin, id_jmax)
+
+      !- add extra band (if possible) to compute interpolation
+      CALL dom_add_extra(tl_dom)
+
+      !- open mpp files over domain
+      CALL iom_dom_open(tl_mpp, tl_dom)
+
+      !- read variable value on domain
+      tl_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom)
+
+      !- close mpp files
+      CALL iom_dom_close(tl_mpp)
+
+      il_size=SIZE(id_rho(:))
+      ALLOCATE( il_rho(il_size) )
+      il_rho(:)=id_rho(:)
+      
+      !- interpolate variable
+      CALL create_bathy_interp(tl_var, il_rho(:), id_offset(:,:))
+
+      !- remove extraband added to domain
+      CALL dom_del_extra( tl_var, tl_dom, il_rho(:) )
+
+      CALL dom_clean_extra( tl_dom )
+
+      !- add ghost cell
+      CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:))
+ 
+      !- add attribute to variable
+      tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+      CALL var_move_att(tl_var, tl_att)
+
+      tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/))
+      CALL var_move_att(tl_var, tl_att)
+
+      tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))
+      CALL var_move_att(tl_var, tl_att)
+
+      IF( .NOT. ALL(id_rho(:)==1) )THEN
+         tl_att=att_init("refinment_factor",(/id_rho(jp_I),id_rho(jp_J)/))
+         CALL var_move_att(tl_var, tl_att)
+      ENDIF
+
+      DEALLOCATE( il_rho )
+
+      !- save result
+      create_bathy_get_var=var_copy(tl_var)
+
+      !- clean structure
+      CALL att_clean(tl_att)
+      CALL var_clean(tl_var)
+      CALL mpp_clean(tl_mpp)
+ 
+   END FUNCTION create_bathy_get_var
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE create_bathy_interp( td_var,         &
+   &                               id_rho,          &
+   &                               id_offset,       &
+   &                               id_iext, id_jext)
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      TYPE(TVAR)  :: tl_mask
+
+      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: two extrabands are required for cubic interpolation
+      il_iext=3
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=3
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on mask
+      ! create mask
+      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+      &                td_var%t_dim(2)%i_len, &
+      &                td_var%t_dim(3)%i_len, &
+      &                td_var%t_dim(4)%i_len) )
+
+      bl_mask(:,:,:,:)=1
+      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+      SELECT CASE(TRIM(td_var%c_point))
+      CASE DEFAULT ! 'T'
+         tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=td_var%t_dim(:), &
+         &                id_ew=td_var%i_ew )
+      CASE('U','V','F')
+         CALL logger_fatal("CREATE BATHY INTERP: can not computed "//&
+         &                 "interpolation on "//TRIM(td_var%c_point)//&
+         &                 " grid point (variable "//TRIM(td_var%c_name)//&
+         &                 "). check namelist.")
+      END SELECT
+
+      DEALLOCATE(bl_mask)
+
+      ! interpolate mask
+      CALL interp_fill_value( tl_mask, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate Bathymetry
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+      ! keep original mask 
+      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+      END WHERE
+
+      ! clean variable structure
+      CALL var_clean(tl_mask)
+
+   END SUBROUTINE create_bathy_interp
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] td_mpp       mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_bathy_check_depth( td_mpp, td_depth )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
+      TYPE(TVAR) , INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_depthid
+         IF( ASSOCIATED(td_depth%d_value) )THEN
+
+            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+
+            IF( ANY( td_depth%d_value(:,:,:,:) /= &
+            &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+               CALL logger_warn("CREATE BATHY: depth value from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_depth)
+
+         ELSE
+            td_depth=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_bathy_check_depth
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_bathy_check_time( td_mpp, td_time )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_timeid
+         IF( ASSOCIATED(td_time%d_value) )THEN
+
+            tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+            tl_date1=var_to_date(td_time)
+            tl_date2=var_to_date(tl_time)
+            IF( tl_date1 - tl_date2 /= 0 )THEN
+
+               CALL logger_warn("CREATE BATHY: date from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_time)
+
+         ELSE
+            td_time=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_bathy_check_time
+END PROGRAM create_bathy
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90	(revision 8732)
@@ -0,0 +1,1777 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+!
+! PROGRAM: create_boundary
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates boundary files.
+!>
+!> @details
+!> @section sec1 method
+!> Variables are read from coarse grid standard output, 
+!> extracted or interpolated on fine grid. 
+!> Variables could also be manually written.<br/>
+!> @note 
+!>    method could be different for each variable.
+!>
+!> @section sec2 how to 
+!>    to create boundaries files:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/create_boundary create_boundary.nam
+!> @endcode
+!>  <br/> 
+!> \image html  boundary_NEATL36_70.png 
+!> <center>\image latex boundary_NEATL36_70.png
+!> </center>
+!>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_boundary.nam contains 9 namelists:<br/>
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - coarse grid namelist (namcrs)
+!>       - fine grid namelist (namfin)
+!>       - variable namelist (namvar)
+!>       - nesting namelist (namnst)
+!>       - boundary namelist (nambdy)
+!>       - vertical grid namelist (namzgr)
+!>       - output namelist (namout)
+!>    
+!>    * _logger namelist (namlog)_:<br/>
+!>       - cn_logfile   : log filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!> 'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:<br/>
+!>       - cn_varcfg : variable configuration file
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dimcfg : dimension configuration file. define dimensions allowed
+!> (see ./SIREN/cfg/dimension.cfg).
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _coarse grid namelist (namcrs)_:<br/>
+!>       - cn_coord0 : coordinate file
+!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
+!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
+!>
+!>    * _fine grid namelist (namfin)_:<br/>
+!>       - cn_coord1 : coordinate file
+!>       - cn_bathy1 : bathymetry file
+!>       - in_perio1 : periodicity index
+!>
+!>    * _vertical grid namelist (namzgr)_:<br/>
+!>       - dn_ppsur              :
+!>       - dn_ppa0               :
+!>       - dn_ppa1               :
+!>       - dn_ppa2               : 
+!>       - dn_ppkth              :
+!>       - dn_ppkth2             :
+!>       - dn_ppacr              :
+!>       - dn_ppacr2             :
+!>       - dn_ppdzmin            :
+!>       - dn_pphmax             :
+!>       - in_nlevel             : number of vertical level
+!>
+!>    * _partial step namelist (namzps)_:<br/>
+!>       - dn_e3zps_min          :
+!>       - dn_e3zps_rat          : 
+!>
+!>    * _variable namelist (namvar)_:<br/>
+!>       - cn_varfile : list of variable, and associated file<br/> 
+!>          *cn_varfile* is the path and filename of the file where find
+!>          variable.<br/> 
+!>          @note 
+!>             *cn_varfile* could be a matrix of value, if you want to filled
+!>             manually variable value.<br/>
+!>             the variable array of value is split into equal subdomain.<br/>
+!>             Each subdomain is filled with the corresponding value 
+!>             of the matrix.<br/>          
+!>             separators used to defined matrix are:
+!>                - ',' for line
+!>                - '/' for row
+!>                - '\' for level<br/>
+!>                Example:<br/>
+!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                         3 & 2 & 3 \\\\
+!>                                         1 & 4 & 5 \end{array} \right) @f$
+!>          @warning 
+!>             the same matrix is used for all boundaries.
+!>
+!>       Examples: 
+!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
+!>          - 'votemper:10\25', 'vozocrtx:gridU.nc'
+!>
+!>       - cn_varinfo : list of variable and extra information about request(s)
+!>          to be used (separated by ',').<br/>
+!>          each elements of *cn_varinfo* is a string character.<br/>
+!>          it is composed of the variable name follow by ':', 
+!>          then request(s) to be used on this variable.<br/> 
+!>          request could be:
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
+!>
+!>                requests must be separated by ';'.<br/>
+!>                order of requests does not matter.
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter.<br/>
+!>
+!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 
+!>                   'vosaline:int=cubic'
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is apply.
+!>
+!>    * _nesting namelist (namnst)_:<br/>
+!>       - in_rhoi  : refinement factor in i-direction
+!>       - in_rhoj  : refinement factor in j-direction
+!>
+!>    * _boundary namelist (nambdy)_:<br/>
+!>       - ln_north  : use north boundary
+!>       - ln_south  : use south boundary
+!>       - ln_east   : use east  boundary
+!>       - ln_west   : use west  boundary
+!>       - cn_north  : north boundary indices on fine grid
+!>          *cn_north* is a string character defining boundary
+!>          segmentation.<br/>
+!>          segments are separated by '|'.<br/>
+!>          each segments of the boundary is composed of:
+!>             - indice of velocity (orthogonal to boundary .ie. 
+!>                for north boundary, J-indice). 
+!>             - indice of segment start (I-indice for north boundary) 
+!>             - indice of segment end   (I-indice for north boundary)<br/>
+!>                indices must be separated by ':' .<br/>
+!>             - optionally, boundary size could be added between '(' and ')' 
+!>             in the definition of the first segment.
+!>                @note 
+!>                   boundary width is the same for all segments of one boundary.
+!>
+!>          Examples:
+!>             - cn_north='index1,first1:last1(width)'
+!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
+!>             \image html  boundary_50.png 
+!>             <center>\image latex boundary_50.png
+!>             </center>
+!>       - cn_south  : south boundary indices on fine grid
+!>       - cn_east   : east  boundary indices on fine grid
+!>       - cn_west   : west  boundary indices on fine grid
+!>       - ln_oneseg : force to use only one segment for each boundary or not
+!>
+!>    * _output namelist (namout)_:<br/>
+!>       - cn_fileout : fine grid boundary basename
+!>         (cardinal point and segment number will be automatically added)
+!>       - dn_dayofs  : date offset in day (change only ouput file name)
+!>       - ln_extrap  : extrapolate land point or not
+!>
+!>          Examples: 
+!>             - cn_fileout='boundary.nc'<br/>
+!>                if time_counter (16/07/2015 00h) is read on input file (see varfile), 
+!>                west boundary will be named boundary_west_y2015m07d16
+!>             - dn_dayofs=-2.<br/>
+!>                if you use day offset you get boundary_west_y2015m07d14
+!>       
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - take into account grid point to compue boundaries
+!> - reorder output dimension for north and south boundaries
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
+!> @date July, 2015
+!> - add namelist parameter to shift date of output file name.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> - allow to run on multi processors with key_mpp_mpi
+!> @date January, 2016
+!> - same process use for variable extracted or interpolated from input file.
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!>
+!> @todo
+!> - rewitre using meshmask instead of bathymetry and coordinates files.
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_boundary
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE boundary                        ! boundary manager
+   USE iom                             ! I/O manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE vgrid                           ! vertical grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   INTEGER(i4)                                        :: il_narg
+
+#if defined key_mpp_mpi
+   ! mpp variable
+   CHARACTER(LEN=lc), DIMENSION(:)      , ALLOCATABLE :: cl_namelist
+   INTEGER(i4)                                        :: ierror
+   INTEGER(i4)                                        :: iproc
+   INTEGER(i4)                                        :: nproc
+   INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_nprog
+
+   ! loop indices
+   INTEGER(i4) :: jm
+#else
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+#endif
+   !-------------------------------------------------------------------
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+   !-------------------------------------------------------------------
+
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+#if ! defined key_mpp_mpi
+
+   IF( il_narg/=1 )THEN
+      PRINT *,"CREATE BOUNDARY: ERROR. need one namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+
+   CALL create__boundary(cl_namelist)
+
+#else
+
+   ! Initialize MPI
+   CALL mpi_init(ierror)
+   CALL mpi_comm_rank(mpi_comm_world,iproc,ierror)
+   CALL mpi_comm_size(mpi_comm_world,nproc,ierror)
+
+   IF( il_narg==0 )THEN
+      PRINT *,"CREATE BOUNDARY: ERROR. need at least one namelist"
+      STOP
+   ELSE
+      ALLOCATE(cl_namelist(il_narg))
+      DO jm=1,il_narg
+         CALL GET_COMMAND_ARGUMENT(jm,cl_namelist(jm))
+      ENDDO
+   ENDIF
+
+   ALLOCATE(il_nprog(il_narg))
+   DO jm=1, il_narg
+      il_nprog(jm)= MOD(jm,nproc)
+   ENDDO
+
+   DO jm=1, il_narg
+      IF ( il_nprog(jm) .eq. iproc ) THEN
+         CALL create__boundary(cl_namelist(jm))
+      ENDIF
+   ENDDO
+
+   CALL mpi_finalize(ierror)
+
+   DEALLOCATE(cl_namelist)
+   DEALLOCATE(il_nprog)
+#endif
+
+CONTAINS
+SUBROUTINE create__boundary(cd_namelist)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine create boundary files.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] cd_namelist namelist file 
+   !-------------------------------------------------------------------
+
+   USE logger                          ! log file manager
+
+   IMPLICIT NONE
+   ! Argument
+   CHARACTER(LEN=lc), INTENT(IN) :: cd_namelist 
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_name
+   CHARACTER(LEN=lc)                                  :: cl_bdyout
+   CHARACTER(LEN=lc)                                  :: cl_data
+   CHARACTER(LEN=lc)                                  :: cl_dimorder
+   CHARACTER(LEN=lc)                                  :: cl_fmt
+
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_shift
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_depth   
+   TYPE(TVAR)                                         :: tl_time
+   TYPE(TVAR)                                         :: tl_var1
+   TYPE(TVAR)                                         :: tl_var0
+   TYPE(TVAR)                                         :: tl_lon1
+   TYPE(TVAR)                                         :: tl_lat1
+   TYPE(TVAR)                                         :: tl_lvl1  
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
+   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_seglvl1
+   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segvar1
+
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TDATE)                                        :: tl_date
+   
+   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
+   
+   TYPE(TDOM)                                         :: tl_dom0
+   TYPE(TDOM)                                         :: tl_dom1
+   TYPE(TDOM)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segdom1
+
+   TYPE(TFILE)                                        :: tl_fileout
+   
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_bathy1
+   TYPE(TMPP)                                         :: tl_mpp
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   ! loop indices
+   INTEGER(i4) :: jvar
+   INTEGER(i4) :: jpoint
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+   INTEGER(i4) :: jl
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namcrs
+   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namfin
+   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
+   INTEGER(i4)                             :: in_perio1 = -1
+
+   !namzgr
+   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
+   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
+   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
+   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
+   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
+   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
+   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp
+   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp
+   REAL(dp)                                :: dn_ppdzmin = 6._dp
+   REAL(dp)                                :: dn_pphmax  = 5750._dp
+   INTEGER(i4)                             :: in_nlevel  = 75
+
+   !namzps
+   REAL(dp)                                :: dn_e3zps_min = 25._dp
+   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi  = 0
+   INTEGER(i4)                             :: in_rhoj  = 0
+
+   ! nambdy
+   LOGICAL                                 :: ln_north   = .TRUE.
+   LOGICAL                                 :: ln_south   = .TRUE.
+   LOGICAL                                 :: ln_east    = .TRUE.
+   LOGICAL                                 :: ln_west    = .TRUE.
+   LOGICAL                                 :: ln_oneseg  = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_north   = ''
+   CHARACTER(LEN=lc)                       :: cn_south   = ''
+   CHARACTER(LEN=lc)                       :: cn_east    = ''
+   CHARACTER(LEN=lc)                       :: cn_west    = ''
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
+   REAL(dp)                                :: dn_dayofs  = 0._dp
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror
+
+   NAMELIST /namcfg/ &  !< config namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namcrs/ &  !< coarse grid namelist
+   &  cn_coord0,     &  !< coordinate file
+   &  in_perio0         !< periodicity index
+ 
+   NAMELIST /namfin/ &  !< fine grid namelist
+   &  cn_coord1,     &  !< coordinate file
+   &  cn_bathy1,     &  !< bathymetry file
+   &  in_perio1         !< periodicity index
+ 
+   NAMELIST /namzgr/ &
+   &  dn_ppsur,     &
+   &  dn_ppa0,      &
+   &  dn_ppa1,      &
+   &  dn_ppa2,      &
+   &  dn_ppkth,     &
+   &  dn_ppkth2,    &
+   &  dn_ppacr,     &
+   &  dn_ppacr2,    &
+   &  dn_ppdzmin,   &
+   &  dn_pphmax,    &
+   &  in_nlevel         !< number of vertical level
+
+   NAMELIST /namzps/ &
+   &  dn_e3zps_min, &
+   &  dn_e3zps_rat
+
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varfile, &     !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 
+   &  cn_varinfo        !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
+ 
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,       &  !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /nambdy/ &  !< boundary namelist
+   &  ln_north,      &  !< use north boundary
+   &  ln_south,      &  !< use south boundary
+   &  ln_east ,      &  !< use east  boundary
+   &  ln_west ,      &  !< use west  boundary
+   &  cn_north,      &  !< north boundary indices on fine grid
+   &  cn_south,      &  !< south boundary indices on fine grid
+   &  cn_east ,      &  !< east  boundary indices on fine grid
+   &  cn_west ,      &  !< west  boundary indices on fine grid
+   &  ln_oneseg         !< use only one segment for each boundary or not
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout,    &  !< fine grid boundary file basename   
+   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
+   &  ln_extrap         !< extrapolate or not
+   !-------------------------------------------------------------------
+
+   ! read namelist
+   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cd_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namcrs )
+      READ( il_fileid, NML = namfin )
+      READ( il_fileid, NML = namzgr )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra(cn_varinfo)
+      ! match variable with file
+      tl_multi=multi_init(cn_varfile)
+
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = nambdy )
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cd_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cd_namelist)
+      STOP
+
+   ENDIF
+
+   CALL multi_print(tl_multi)
+   IF( tl_multi%i_nvar <= 0 )THEN
+      CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//&
+      &  " check namelist.")
+   ENDIF
+
+   ! open files
+   IF( TRIM(cn_coord0) /= '' )THEN
+      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//&
+      &  "coordinate file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//&
+      &  "file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   ! WARNING: do not work when use time to create output file name
+   DO jk=1,ip_ncard
+      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+      &                                TRIM(cp_card(jk)), 1 )
+      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
+         &  " already exist.")
+      ENDIF
+
+      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+      &                                TRIM(cp_card(jk)) )
+      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
+         &  " already exist.")
+      ENDIF
+   ENDDO
+
+   ! check namelist
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cd_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   !
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
+   &                                 id_rho=il_rho(:))
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coordinate file
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )      
+
+   ! read or compute boundary
+   CALL mpp_get_contour(tl_bathy1)
+
+   CALL iom_mpp_open(tl_bathy1)
+ 
+   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry')
+ 
+   CALL iom_mpp_close(tl_bathy1)
+
+   ! get boundaries indices
+   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, &
+   &                                cn_north, cn_south, cn_east, cn_west, &
+   &                                ln_oneseg ) 
+
+
+   CALL var_clean(tl_var1)
+
+   ! compute level
+   ALLOCATE(tl_level(ip_npoint))
+   tl_level(:)=vgrid_get_level(tl_bathy1, cd_namelist )
+
+   ! get coordinate for each segment of each boundary
+   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) )
+   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) )
+ 
+   DO jl=1,ip_ncard
+      IF( tl_bdy(jl)%l_use )THEN
+         DO jk=1,tl_bdy(jl)%i_nseg
+
+            ! get fine grid segment domain
+            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, &
+            &                                            tl_bdy(jl), jk )
+
+            IF( .NOT. ln_extrap )THEN
+               ! get fine grid level
+               tl_seglvl1(:,jk,jl)= &
+                  & create_boundary_get_level( tl_level(:), &
+                  &                            tl_segdom1(:,jk,jl))
+            ENDIF
+
+            ! add extra band to fine grid domain (if possible)
+            ! to avoid dimension of one and so be able to compute offset
+            DO jj=1,ip_npoint
+               CALL dom_add_extra(tl_segdom1(jj,jk,jl), &
+               &                  il_rho(jp_I), il_rho(jp_J))
+            ENDDO
+
+         ENDDO
+      ENDIF
+   ENDDO
+
+   ! clean
+   CALL var_clean(tl_level(:))
+   DEALLOCATE(tl_level)
+
+   ! clean bathy
+   CALL mpp_clean(tl_bathy1)
+
+   ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) )
+   ! compute boundary for variable to be used (see namelist)
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE BOUNDARY: no file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+
+      jvar=0
+      ! for each file
+      DO ji=1,tl_multi%i_nmpp
+
+         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
+
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_error("CREATE BOUNDARY: no variable to work on for "//&
+            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+         !- use input matrix to fill variable
+
+            WRITE(*,'(a)') "work on data"
+            ! for each variable initialise from matrix
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+               jvar=jvar+1
+               WRITE(*,'(2x,a,a)') "work on variable "//&
+               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+               tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+               SELECT CASE(TRIM(tl_var1%c_point))
+               CASE DEFAULT !'T'
+                  jpoint=jp_T
+               CASE('U')
+                  jpoint=jp_U
+               CASE('V')
+                  jpoint=jp_V
+               CASE('F')
+                  jpoint=jp_F
+               END SELECT
+
+               WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name)
+               DO jl=1,ip_ncard
+                  IF( tl_bdy(jl)%l_use )THEN
+
+                     DO jk=1,tl_bdy(jl)%i_nseg
+
+                        ! fill value with matrix data
+                        tl_segvar1(jvar,jk,jl)=create_boundary_matrix( &
+                        &                          tl_var1, &
+                        &                          tl_segdom1(jpoint,jk,jl), &
+                        &                          in_nlevel )
+
+                        !del extra
+                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), &
+                        &                   tl_segdom1(jpoint,jk,jl) )
+
+                     ENDDO
+
+                  ENDIF
+               ENDDO
+               
+               ! clean
+               CALL var_clean(tl_var1)
+
+            ENDDO
+
+         !- end of use input matrix to fill variable
+         ELSE
+         !- use mpp file to fill variable
+
+            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
+            ! 
+            tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)))
+            CALL grid_get_info(tl_mpp)
+
+            DO jl=1,ip_ncard
+               IF( tl_bdy(jl)%l_use )THEN
+
+                  WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
+                     &  ' boundary'
+                  DO jk=1,tl_bdy(jl)%i_nseg
+
+                     ! for each variable of this file
+                     DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+ 
+                        WRITE(*,'(4x,a,a)') "work on variable "//&
+                        &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                        tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+                        ! open mpp file
+                        CALL iom_mpp_open(tl_mpp)
+
+                        ! get or check depth value
+                        CALL create_boundary_check_depth( tl_var0, tl_mpp, &
+                        &                                 in_nlevel, tl_depth )
+
+                        ! get or check time value
+                        CALL create_boundary_check_time( tl_var0, tl_mpp, &
+                        &                                tl_time )
+
+                        ! close mpp file
+                        CALL iom_mpp_close(tl_mpp)
+
+                        ! open mpp file on domain
+                        SELECT CASE(TRIM(tl_var0%c_point))
+                           CASE DEFAULT !'T'
+                              jpoint=jp_T
+                           CASE('U')
+                              jpoint=jp_U
+                           CASE('V')
+                              jpoint=jp_V
+                           CASE('F')
+                              jpoint=jp_F
+                        END SELECT
+
+                        tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
+
+                        CALL create_boundary_get_coord( tl_coord1, tl_dom1, &
+                        &                               tl_var0%c_point,    &
+                        &                               tl_lon1, tl_lat1 )
+
+                        ! get coarse grid indices of this segment
+                        il_ind(:,:)=grid_get_coarse_index(tl_coord0, &
+                        &                                 tl_lon1, tl_lat1, &
+                        &                                 id_rho=il_rho(:) )
+
+                        IF( ANY(il_ind(:,:)==0) )THEN
+                           CALL logger_error("CREATE BOUNDARY: error "//&
+                           &  "computing coarse grid indices")
+                        ELSE
+                           il_imin0=il_ind(1,1)
+                           il_imax0=il_ind(1,2)
+
+                           il_jmin0=il_ind(2,1)
+                           il_jmax0=il_ind(2,2)
+                        ENDIF
+
+                        il_offset(:,:)= grid_get_fine_offset( &
+                        &                    tl_coord0, &
+                        &                    il_imin0, il_jmin0,&
+                        &                    il_imax0, il_jmax0,&
+                        &                    tl_lon1%d_value(:,:,1,1),&
+                        &                    tl_lat1%d_value(:,:,1,1),&
+                        &                    il_rho(:),&
+                        &                    TRIM(tl_var0%c_point) )
+
+                        ! compute coarse grid segment domain
+                        tl_dom0=dom_init( tl_coord0,         &
+                        &                 il_imin0, il_imax0,&
+                        &                 il_jmin0, il_jmax0 )
+
+                        ! add extra band (if possible) to compute interpolation
+                        CALL dom_add_extra(tl_dom0)
+
+                        ! open mpp files
+                        CALL iom_dom_open(tl_mpp, tl_dom0)
+
+                        cl_name=tl_var0%c_name
+                        ! read variable value on domain
+                        tl_segvar1(jvar+jj,jk,jl)= &
+                        &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
+
+                        IF( ANY(il_rho(:)/=1) )THEN
+                           WRITE(*,'(4x,a,a)') "interp variable "//TRIM(cl_name)
+                           ! work on variable
+                           CALL create_boundary_interp( &
+                           &                 tl_segvar1(jvar+jj,jk,jl),&
+                           &                 il_rho(:), il_offset(:,:) )
+                        ENDIF
+
+                        ! remove extraband added to domain
+                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
+                        &                   tl_dom0, il_rho(:) )
+
+                        ! del extra point on fine grid
+                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
+                        &                   tl_dom1 )
+                        ! clean extra point information on coarse grid domain
+                        CALL dom_clean_extra( tl_dom0 )
+
+                        ! add attribute to variable
+                        tl_att=att_init('src_file',&
+                        &  TRIM(fct_basename(tl_mpp%c_name)))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        ! 
+                        tl_att=att_init('src_i_indices',&
+                        &  (/tl_dom0%i_imin, tl_dom0%i_imax/))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        tl_att=att_init('src_j_indices', &
+                        &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        IF( ANY(il_rho(:)/=1) )THEN
+                           tl_att=att_init("refinment_factor", &
+                           &               (/il_rho(jp_I),il_rho(jp_J)/))
+                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                           &                 tl_att)
+                        ENDIF
+
+                        ! clean structure
+                        CALL att_clean(tl_att)
+
+                        ! clean
+                        CALL dom_clean(tl_dom0)
+                        CALL dom_clean(tl_dom1)
+
+                        ! close mpp files
+                        CALL iom_dom_close(tl_mpp)
+
+                        ! clean structure
+                        CALL var_clean(tl_lon1)
+                        CALL var_clean(tl_lat1)
+                        CALL var_clean(tl_lvl1)
+
+                     ENDDO ! jj
+
+                     ! clean
+                     CALL var_clean(tl_var0)
+
+                  ENDDO ! jk
+            
+               ENDIF
+            ENDDO ! jl
+
+            jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+            ! clean
+            CALL mpp_clean(tl_mpp)
+
+         !- end of use file to fill variable
+         ENDIF
+      ENDDO ! ji
+   ENDIF
+
+   IF( jvar /= tl_multi%i_nvar )THEN
+      CALL logger_error("CREATE BOUNDARY: it seems some variable "//&
+         &  "can not be read")
+   ENDIF
+
+   ! write file for each segment of each boundary
+   DO jl=1,ip_ncard
+      IF( tl_bdy(jl)%l_use )THEN
+
+         DO jk=1,tl_bdy(jl)%i_nseg
+            !- 
+            CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),&
+            &                               'T', tl_lon1, tl_lat1 )
+
+            ! force to use nav_lon, nav_lat as variable name
+            tl_lon1%c_name='nav_lon'
+            tl_lat1%c_name='nav_lat'
+
+            ! del extra point on fine grid
+            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) )
+            CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) )
+
+            ! clean
+            DO jpoint=1,ip_npoint
+               CALL dom_clean(tl_segdom1(jpoint,jk,jl))
+            ENDDO
+
+            ! swap array
+            CALL boundary_swap(tl_lon1, tl_bdy(jl))
+            CALL boundary_swap(tl_lat1, tl_bdy(jl))
+            DO jvar=1,tl_multi%i_nvar
+
+               ! use additional request
+               ! change unit and apply factor
+               CALL var_chg_unit(tl_segvar1(jvar,jk,jl))
+
+               ! forced min and max value
+               CALL var_limit_value(tl_segvar1(jvar,jk,jl))
+
+               ! filter
+               CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
+
+               IF( .NOT. ln_extrap )THEN
+                  ! use mask
+                  SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point))
+                  CASE DEFAULT !'T'
+                     jpoint=jp_T
+                  CASE('U')
+                     jpoint=jp_U
+                  CASE('V')
+                     jpoint=jp_V
+                  CASE('F')
+                     jpoint=jp_F
+                  END SELECT
+
+                  CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), &
+                  &                             tl_seglvl1(jpoint,jk,jl))
+               ENDIF
+
+               ! swap dimension order
+               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
+
+            ENDDO
+
+            ! create file
+            ! create file structure
+            ! set file namearray of level variable structure
+            IF( tl_bdy(jl)%i_nseg > 1 )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt ) 
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk,&
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk )
+               ENDIF
+            ELSE
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt )
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), &
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card) )
+               ENDIF
+            ENDIF
+            ! 
+            tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1)
+
+            ! add dimension
+            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl))
+
+            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
+               CASE DEFAULT ! 'north','south'
+                  cl_dimorder='xyzt'
+               CASE('east','west')
+                  cl_dimorder='yxzt'
+            END SELECT
+
+            DO ji=1,ip_maxdim
+               IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+            ENDDO
+
+            ! add variables
+            IF( ALL( tl_dim(1:2)%l_use ) )THEN
+               ! add longitude
+               CALL file_add_var(tl_fileout, tl_lon1)
+               CALL var_clean(tl_lon1)
+
+               ! add latitude
+               CALL file_add_var(tl_fileout, tl_lat1)
+               CALL var_clean(tl_lat1)
+            ENDIF
+            
+
+
+            IF( tl_dim(3)%l_use )THEN
+               IF( ASSOCIATED(tl_depth%d_value) )THEN
+                  ! add depth
+                  CALL file_add_var(tl_fileout, tl_depth)
+               ENDIF
+            ENDIF
+
+            IF( tl_dim(4)%l_use )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  ! add time
+                  CALL file_add_var(tl_fileout, tl_time)
+               ENDIF
+            ENDIF
+
+            ! add other variable
+            DO jvar=tl_multi%i_nvar,1,-1
+               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
+               CALL var_clean(tl_segvar1(jvar,jk,jl))
+            ENDDO
+
+            ! add some attribute
+            tl_att=att_init("Created_by","SIREN create_boundary")
+            CALL file_add_att(tl_fileout, tl_att)
+
+            cl_date=date_print(date_now())
+            tl_att=att_init("Creation_date",cl_date)
+            CALL file_add_att(tl_fileout, tl_att)
+
+            ! add shift on north and east boundary
+            ! boundary compute on T point but express on U or V point
+            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
+            CASE DEFAULT ! 'south','west'
+               il_shift=0
+            CASE('north','east')
+               il_shift=1
+            END SELECT
+
+            ! add indice of velocity row or column
+            tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift)
+            CALL file_move_att(tl_fileout, tl_att)
+
+            ! add width of the relaxation zone
+            tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width)
+            CALL file_move_att(tl_fileout, tl_att)
+            
+            ! add indice of segment start 
+            tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first)
+            CALL file_move_att(tl_fileout, tl_att)
+            
+            ! add indice of segment end 
+            tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last)
+            CALL file_move_att(tl_fileout, tl_att)
+                           
+            ! clean
+            CALL att_clean(tl_att)
+
+            ! create file
+            CALL iom_create(tl_fileout)
+
+            ! write file
+            CALL iom_write_file(tl_fileout, cl_dimorder)
+
+            ! close file
+            CALL iom_close(tl_fileout)
+            CALL file_clean(tl_fileout)
+
+         ENDDO ! jk
+
+      ENDIF
+      ! clean
+      CALL boundary_clean(tl_bdy(jl))
+   ENDDO !jl
+
+   ! clean
+   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
+   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
+   DEALLOCATE( tl_segdom1 )
+   DEALLOCATE( tl_segvar1 )
+   CALL var_clean(tl_seglvl1(:,:,:))
+   DEALLOCATE( tl_seglvl1 )
+
+
+   CALL mpp_clean(tl_coord1)
+   CALL mpp_clean(tl_coord0)
+   CALL var_clean_extra()
+
+   CALL multi_clean(tl_multi)
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+   CALL logger_clean()
+
+END SUBROUTINE create__boundary
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute boundary domain for each grid point (T,U,V,F) 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - take into account grid point to compute boundary indices
+   !>
+   !> @param[in] td_bathy1 file structure 
+   !> @param[in] td_bdy    boundary structure
+   !> @param[in] id_seg    segment indice 
+   !> @return array of domain structure 
+   !-------------------------------------------------------------------
+   FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN   ) :: td_bathy1
+      TYPE(TBDY) , INTENT(IN   ) :: td_bdy
+      INTEGER(i4), INTENT(IN   ) :: id_seg
+
+      ! function
+      TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom
+
+      ! local variable
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift
+      INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      ! init
+      jk=id_seg
+
+      il_ishift(:)=0
+      il_jshift(:)=0
+
+      ! get boundary definition
+      SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+
+            il_imin1=td_bdy%t_seg(jk)%i_first
+            il_imax1=td_bdy%t_seg(jk)%i_last 
+            il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
+            il_jmax1=td_bdy%t_seg(jk)%i_index
+
+            il_jshift(jp_V)=-1
+            il_jshift(jp_F)=-1
+
+         CASE('south')
+
+            il_imin1=td_bdy%t_seg(jk)%i_first
+            il_imax1=td_bdy%t_seg(jk)%i_last 
+            il_jmin1=td_bdy%t_seg(jk)%i_index
+            il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
+
+         CASE('east')
+
+            il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
+            il_imax1=td_bdy%t_seg(jk)%i_index
+            il_jmin1=td_bdy%t_seg(jk)%i_first
+            il_jmax1=td_bdy%t_seg(jk)%i_last 
+
+            il_ishift(jp_U)=-1
+            il_ishift(jp_F)=-1
+
+         CASE('west')
+
+            il_imin1=td_bdy%t_seg(jk)%i_index
+            il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
+            il_jmin1=td_bdy%t_seg(jk)%i_first
+            il_jmax1=td_bdy%t_seg(jk)%i_last 
+
+      END SELECT         
+
+      !-read fine grid domain
+      DO ji=1,ip_npoint
+
+         ! shift domain
+         il_imin=il_imin1+il_ishift(ji)
+         il_imax=il_imax1+il_ishift(ji)
+
+         il_jmin=il_jmin1+il_jshift(ji)
+         il_jmax=il_jmax1+il_jshift(ji)
+
+         ! compute domain
+         create_boundary_get_dom(ji)=dom_init( td_bathy1,       &
+         &                                     il_imin, il_imax,&
+         &                                     il_jmin, il_jmax,&
+         &                                     TRIM(td_bdy%c_card) )
+
+      ENDDO
+
+   END FUNCTION create_boundary_get_dom
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get coordinates over boundary domain
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account grid point
+   !>
+   !> @param[in] td_coord1 coordinates file structure
+   !> @param[in] td_dom1   boundary domain structure
+   !> @param[in] cd_point  grid point
+   !> @param[out] td_lon1  longitude variable structure
+   !> @param[out] td_lat1  latitude variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, &
+   &                                     td_lon1, td_lat1 )
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1
+      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_point
+      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1
+      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1 
+
+      ! local variable
+      TYPE(TMPP)        :: tl_coord1
+      
+      CHARACTER(LEN=lc) :: cl_name
+      ! loop indices
+      !----------------------------------------------------------------
+      !read variables on domain (ugly way to do it, have to work on it)
+      ! init mpp structure
+      tl_coord1=mpp_copy(td_coord1)
+      
+      ! open mpp files
+      CALL iom_dom_open(tl_coord1, td_dom1)
+
+      ! read variable value on domain
+      WRITE(cl_name,*) 'longitude_'//TRIM(cd_point)
+      td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
+      WRITE(cl_name,*) 'latitude_'//TRIM(cd_point)
+      td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
+
+      ! close mpp files
+      CALL iom_dom_close(tl_coord1)
+
+      ! clean structure
+      CALL mpp_clean(tl_coord1)
+
+   END SUBROUTINE create_boundary_get_coord
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable on boundary
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_interp( td_var,           &
+   &                                  id_rho,           &
+   &                                  id_offset,        &
+   &                                  id_iext, id_jext )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: at least two extrabands are required for cubic interpolation
+      il_iext=2
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=2
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate Bathymetry
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), &
+         &                               il_jext*id_rho(jp_J))
+
+   END SUBROUTINE create_boundary_interp
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file. 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is fill with the associated value of the matrix.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_dom    domain structure 
+   !> @param[in] id_nlevel number of levels 
+   !> @return variable structure 
+   !-------------------------------------------------------------------
+   FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      TYPE(TDOM) , INTENT(IN) :: td_dom
+      INTEGER(i4), INTENT(IN) :: id_nlevel
+
+      ! function
+      TYPE(TVAR) :: create_boundary_matrix
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(3)                    :: il_size
+      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
+
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:3)%i_len
+
+      tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J))
+      tl_dim(jp_K)%i_len=id_nlevel
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+      
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ALLOCATE( il_kshape(il_dim(3)+1) )
+      il_kshape(:)=0
+      DO jk=2,il_dim(3)+1
+         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
+      ENDDO
+      ! add rest to last cell
+      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+
+      DO jk=2,il_dim(3)+1
+         DO jj=2,il_dim(2)+1
+            DO ji=2,il_dim(1)+1
+               
+               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+               &         1+il_jshape(jj-1):il_jshape(jj), &
+               &         1+il_kshape(jk-1):il_kshape(jk), &
+               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! initialise variable with value
+      create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+
+   END FUNCTION create_boundary_matrix
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine use mask to filled land point with _FillValue
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] td_mask   mask variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_use_mask( td_var, td_mask )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TVAR), INTENT(IN   ) :: td_mask
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( ANY(td_var%t_dim(1:2)%i_len /= &
+      &       td_mask%t_dim(1:2)%i_len) )THEN
+         CALL logger_debug("     mask dimension ( "//&
+         &              TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//&
+         &              TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" )
+         CALL logger_debug(" variable dimension ( "//&
+         &              TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
+         &              TRIM(fct_str(td_var%t_dim(2)%i_len))//")" )
+         CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//&
+         &                 "variable dimension differ."   )
+      ENDIF
+
+      ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+      &                 td_var%t_dim(2)%i_len) )
+
+      il_mask(:,:)=INT(td_mask%d_value(:,:,1,1))
+
+      DO jl=1,td_var%t_dim(4)%i_len
+         DO jk=1,td_var%t_dim(3)%i_len
+            WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=td_var%d_fill
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_mask )
+
+   END SUBROUTINE create_boundary_use_mask
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function extract level over domain on each grid point, and return
+   !> array of variable structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_level  array of level variable structure
+   !> @param[in] td_dom    array of domain structure
+   !> @return array of variable structure
+   !-------------------------------------------------------------------
+   FUNCTION create_boundary_get_level(td_level, td_dom)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
+      TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom
+
+      ! function
+      TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level
+
+      ! local variable
+      TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_level(:)) /= ip_npoint .OR. &
+      &   SIZE(td_dom(:)) /= ip_npoint )THEN
+         CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//&
+         &  "check input array of level and domain.")
+      ELSE
+
+         DO ji=1,ip_npoint
+
+            tl_var(ji)=var_copy(td_level(ji))
+
+            IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value)
+
+            tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len
+            tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len
+            ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, &
+            &                           tl_var(ji)%t_dim(2)%i_len, &
+            &                           tl_var(ji)%t_dim(3)%i_len, &
+            &                           tl_var(ji)%t_dim(4)%i_len) )
+
+            tl_var(ji)%d_value(:,:,:,:) = &
+            &  td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, &
+            &                        td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : )
+
+         ENDDO
+         ! save result
+         create_boundary_get_level(:)=var_copy(tl_var(:))
+
+         ! clean
+         CALL var_clean(tl_var(:))
+
+      ENDIF
+
+   END FUNCTION create_boundary_get_level
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable need depth dimension, 
+   !> get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2016
+   !> - check if variable need/use depth dimension
+   !>
+   !> @param[in] td_var       variable structure
+   !> @param[in] td_mpp       mpp structure
+   !> @param[in] id_nlevel    mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_check_depth( td_var, td_mpp, id_nlevel, td_depth )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
+      INTEGER(i4), INTENT(IN   ) :: id_nlevel
+      TYPE(TVAR) , INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( td_var%t_dim(jp_K)%l_use .AND. &
+      &   ( TRIM(td_var%c_axis) == '' .OR. &
+      &     INDEX(TRIM(td_var%c_axis),'Z') /= 0 )&
+      & )THEN
+
+         ! check vertical dimension
+         IF( td_mpp%t_dim(jp_K)%l_use )THEN
+            IF( td_mpp%t_dim(jp_K)%i_len /= id_nlevel .AND. &
+              & td_mpp%t_dim(jp_K)%i_len /= 1 )THEN
+               CALL logger_error("CREATE BOUNDARY: dimension in file "//&
+               &  TRIM(td_mpp%c_name)//" not agree with namelist in_nlevel ")
+            ENDIF
+         ENDIF
+
+         ! get or check depth value
+         IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+            il_varid=td_mpp%t_proc(1)%i_depthid
+            IF( ASSOCIATED(td_depth%d_value) )THEN
+
+               tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+
+               IF( ANY( td_depth%d_value(:,:,:,:) /= &
+               &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+                  CALL logger_error("CREATE BOUNDARY: depth value "//&
+                  &  "for variable "//TRIM(td_var%c_name)//&
+                  &  "from "//TRIM(td_mpp%c_name)//" not conform "//&
+                  &  " to those from former file(s).")
+
+               ENDIF
+               CALL var_clean(tl_depth)
+
+            ELSE
+               td_depth=iom_mpp_read_var(td_mpp,il_varid)
+            ENDIF
+
+         ENDIF
+      ELSE
+         CALL logger_debug("CREATE BOUNDARY: no depth dimension use"//&
+         &                 " for variable "//TRIM(td_var%c_name))
+      ENDIF
+      
+   END SUBROUTINE create_boundary_check_depth
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable need time dimension, 
+   !> get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2016
+   !> - check if variable need/use time dimension
+   !>
+   !> @param[in] td_var       variable structure
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_boundary_check_time( td_var, td_mpp, td_time )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN   ) :: td_var
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( td_var%t_dim(jp_L)%l_use .AND. &
+      &   ( TRIM(td_var%c_axis) == '' .OR. &
+      &     INDEX(TRIM(td_var%c_axis),'T') /= 0 )&
+      & )THEN
+
+         ! get or check depth value
+         IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+            il_varid=td_mpp%t_proc(1)%i_timeid
+            IF( ASSOCIATED(td_time%d_value) )THEN
+
+               tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+               tl_date1=var_to_date(td_time)
+               tl_date2=var_to_date(tl_time)
+               IF( tl_date1 - tl_date2 /= 0 )THEN
+
+                  CALL logger_warn("CREATE BOUNDARY: date from "//&
+                  &  TRIM(td_mpp%c_name)//" not conform "//&
+                  &  " to those from former file(s).")
+
+               ENDIF
+               CALL var_clean(tl_time)
+
+            ELSE
+               td_time=iom_mpp_read_var(td_mpp,il_varid)
+            ENDIF
+
+         ENDIF
+
+      ELSE
+         CALL logger_debug("CREATE BOUNDARY: no time dimension use"//&
+         &                 " for variable "//TRIM(td_var%c_name))
+      ENDIF
+
+   END SUBROUTINE create_boundary_check_time
+END PROGRAM create_boundary
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_coord.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_coord.f90	(revision 8732)
@@ -0,0 +1,693 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+!
+! PROGRAM: create_coord
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates fine grid coordinate file.
+!>
+!> @details
+!> @section sec1 method
+!>    All variables from the input coordinates coarse grid file, are extracted
+!>    and interpolated to create fine grid coordinates files.<br/>
+!>    @note 
+!>       interpolation method could be different for each variable.
+!>
+!> @section sec2 how to
+!>    to create fine grid coordinates files:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/create_coord create_coord.nam
+!> @endcode
+!>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_coord.nam contains 6 namelists:<br/>
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - coarse grid namelist (namcrs)
+!>       - variable namelist (namvar)
+!>       - nesting namelist (namnst)
+!>       - output namelist (namout)
+!>    
+!>    * _logger namelist (namlog)_:<br/>
+!>       - cn_logfile   : log filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!> 'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:<br/>
+!>       - cn_varcfg : variable configuration file 
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dimcfg : dimension configuration file. define dimensions allowed 
+!> (see ./SIREN/cfg/dimension.cfg).
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _coarse grid namelist (namcrs)_:<br/>
+!>       - cn_coord0 : coordinate file
+!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
+!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
+!>
+!>    * _variable namelist (namvar)_:<br/>
+!>       - cn_varinfo : list of variable and extra information about request(s)
+!> to be used.<br/>
+!>          each elements of *cn_varinfo* is a string character 
+!>          (separated by ',').<br/>
+!>          it is composed of the variable name follow by ':', 
+!>          then request(s) to be used on this variable.<br/> 
+!>          request could be:
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!> 
+!>                requests must be separated by ';' .<br/>
+!>                order of requests does not matter.<br/>
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter modules.<br/>
+!>
+!>          Example: 'glamt: int=linear; ext=dist_weight', 
+!>          'e1t: int=cubic/rhoi'<br/>
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is applied.
+!>
+!>    * _nesting namelist (namnst)_:<br/>
+!>       you could define sub domain with coarse grid indices or with coordinates.
+!>       - in_imin0 : i-direction lower left  point indice 
+!> of coarse grid subdomain to be used
+!>       - in_imax0 : i-direction upper right point indice
+!> of coarse grid subdomain to be used
+!>       - in_jmin0 : j-direction lower left  point indice
+!> of coarse grid subdomain to be used
+!>       - in_jmax0 : j-direction upper right point indice
+!> of coarse grid subdomain to be used
+!>       - rn_lonmin0 : lower left  longitude of coarse grid subdomain to be used
+!>       - rn_lonmax0 : upper right longitude of coarse grid subdomain to be used
+!>       - rn_latmin0 : lower left  latitude  of coarse grid subdomain to be used
+!>       - rn_latmax0 : upper right latitude  of coarse grid subdomain to be used
+!>       - in_rhoi  : refinement factor in i-direction
+!>       - in_rhoj  : refinement factor in j-direction<br/>
+!>
+!>       \image html  grid_zoom_40.png 
+!>       <center> \image latex grid_zoom_40.png 
+!>       </center>
+!>
+!>    * _output namelist (namout)_:
+!>       - cn_fileout : output coordinate file name
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - compute offset considering grid point
+!> - add global attributes in output file
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date September, 2016
+!> - allow to use coordinate to define subdomain
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_coord
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   CHARACTER(LEN=lc)                                    :: cl_namelist
+   CHARACTER(LEN=lc)                                    :: cl_date
+
+   INTEGER(i4)                                          :: il_narg
+   INTEGER(i4)                                          :: il_status
+   INTEGER(i4)                                          :: il_fileid
+   INTEGER(i4)                                          :: il_attid
+   INTEGER(i4)                                          :: il_ind
+   INTEGER(i4)                                          :: il_nvar
+   INTEGER(i4)                                          :: il_ew
+   INTEGER(i4)                                          :: il_imin0
+   INTEGER(i4)                                          :: il_imax0
+   INTEGER(i4)                                          :: il_jmin0
+   INTEGER(i4)                                          :: il_jmax0
+
+   INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_rho
+   INTEGER(i4)      , DIMENSION(2)                      :: il_index
+   INTEGER(i4)      , DIMENSION(2,2,ip_npoint)          :: il_offset
+
+   LOGICAL                                              :: ll_exist
+
+   TYPE(TATT)                                           :: tl_att
+
+   TYPE(TDOM)                                           :: tl_dom
+
+   TYPE(TVAR)       , DIMENSION(:)        , ALLOCATABLE :: tl_var
+
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)              :: tl_dim
+
+   TYPE(TMPP)                                           :: tl_coord0
+   TYPE(TFILE)                                          :: tl_fileout
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log' 
+   CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 
+   INTEGER(i4)       :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg' 
+   CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namcrs
+   CHARACTER(LEN=lc) :: cn_coord0 = '' 
+   INTEGER(i4)       :: in_perio0 = -1
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   !namnst
+   REAL(sp)          :: rn_lonmin0 = -360.
+   REAL(sp)          :: rn_lonmax0 = -360.
+   REAL(sp)          :: rn_latmin0 = -360.
+   REAL(sp)          :: rn_latmax0 = -360.
+   INTEGER(i4)       :: in_imin0 = 0
+   INTEGER(i4)       :: in_imax0 = 0
+   INTEGER(i4)       :: in_jmin0 = 0
+   INTEGER(i4)       :: in_jmax0 = 0
+   INTEGER(i4)       :: in_rhoi  = 1
+   INTEGER(i4)       :: in_rhoj  = 1
+
+   !namout
+   CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc'
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !  logger namelist
+   &  cn_logfile,    &  !< logger file name
+   &  cn_verbosity,  &  !< logger verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !  config namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namcrs/ &  !  coarse grid namelist
+   &  cn_coord0 , &     !< coordinate file
+   &  in_perio0         !< periodicity index
+
+   NAMELIST /namvar/ &  !  variable namelist
+   &  cn_varinfo        !< list of variable and extra information about 
+                        !< interpolation, extrapolation or filter method to be used. 
+                        !< (ex: 'votemper:linear,hann,dist_weight','vosaline:cubic' ) 
+   
+   NAMELIST /namnst/ &  !  nesting namelist
+   &  rn_lonmin0, &     !< lower left  coarse grid longitude
+   &  rn_lonmax0, &     !< upper right coarse grid longitude
+   &  rn_latmin0, &     !< lower left  coarse grid latitude
+   &  rn_latmax0, &     !< upper right coarse grid latitude
+   &  in_imin0,   &     !< i-direction lower left  point indice 
+   &  in_imax0,   &     !< i-direction upper right point indice
+   &  in_jmin0,   &     !< j-direction lower left  point indice
+   &  in_jmax0,   &     !< j-direction upper right point indice
+   &  in_rhoi,    &     !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /namout/ &  !  output namelist
+   &  cn_fileout        !< fine grid coordinate file   
+   !-------------------------------------------------------------------
+
+   ! namelist
+   ! get namelist
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+   IF( il_narg/=1 )THEN
+      PRINT *,"ERROR in create_coord: need a namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+   
+   ! read namelist
+   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+ 
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cl_namelist),   &
+      &                FORM='FORMATTED',         &
+      &                ACCESS='SEQUENTIAL',      &
+      &                STATUS='OLD',             &
+      &                ACTION='READ',            &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"ERROR in create_coord: error opening "//TRIM(cl_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define logger file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information on configuration file
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namcrs )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra( cn_varinfo )
+
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE COORD: closing "//TRIM(cl_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"ERROR in create_coord: can't find "//TRIM(cl_namelist)
+      STOP
+
+   ENDIF
+
+   ! open files
+   IF( cn_coord0 /= '' )THEN
+      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE COORD: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE COORD: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check nesting parameters
+   il_index(:)=0
+   IF( rn_lonmin0 >= -180. .AND. rn_lonmin0 <= 360 .AND. &
+     & rn_latmin0 >= -90.  .AND. rn_latmin0 <= 90. )THEN
+
+      il_index(:)=grid_get_closest(tl_coord0, &
+         &                         REAL(rn_lonmin0,dp), REAL(rn_latmin0,dp), &
+         &                         cd_pos='ll') 
+      il_imin0=il_index(1)
+      il_jmin0=il_index(2)
+   ELSE
+      il_imin0=in_imin0
+      il_jmin0=in_jmin0
+   ENDIF
+
+   il_index(:)=0
+   IF( rn_lonmax0 >= -180. .AND. rn_lonmax0 <= 360 .AND. &
+     & rn_latmax0 >= -90.  .AND. rn_latmax0 <= 90. )THEN
+
+      il_index(:)=grid_get_closest(tl_coord0, &
+         &                         REAL(rn_lonmax0,dp), REAL(rn_latmax0,dp), &
+         &                         cd_pos='ur') 
+      il_imax0=il_index(1)
+      il_jmax0=il_index(2)
+   ELSE
+      il_imax0=in_imax0
+      il_jmax0=in_jmax0
+   ENDIF
+
+   ! forced indices for east west cyclic domain
+   IF( rn_lonmin0 == rn_lonmax0 .AND. &
+     & rn_lonmin0 /= -360. )THEN
+      il_imin0=0
+      il_imax0=0
+   ENDIF
+
+   IF( il_imin0 < 0 .OR. il_imax0 < 0 .OR. il_jmin0 < 0 .OR. il_jmax0 < 0)THEN
+      CALL logger_fatal("CREATE COORD: invalid points indices."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ENDIF
+
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE COORD: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj      
+
+      il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
+   ENDIF
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0 )
+
+   ! compute domain
+   tl_dom=dom_init( tl_coord0,         &
+   &                il_imin0, il_imax0,&
+   &                il_jmin0, il_jmax0 )
+
+   ! add extra band (if need be) to compute interpolation
+   CALL dom_add_extra(tl_dom)
+
+   ! open mpp files
+   CALL iom_dom_open(tl_coord0, tl_dom)
+
+   il_nvar=tl_coord0%t_proc(1)%i_nvar
+   ALLOCATE( tl_var(il_nvar) )
+   DO ji=1,il_nvar
+
+      tl_var(ji)=iom_dom_read_var(tl_coord0, &
+      &                          TRIM(tl_coord0%t_proc(1)%t_var(ji)%c_name),&
+      &                          tl_dom)
+
+      SELECT CASE(TRIM(tl_var(ji)%c_point))
+         CASE('T')
+            jj=jp_T
+         CASE('U')
+            jj=jp_U
+         CASE('V')
+            jj=jp_V
+         CASE('F')
+            jj=jp_F
+      END SELECT
+
+      ! interpolate variables
+      CALL create_coord_interp( tl_var(ji), il_rho(:), &
+      &                         il_offset(:,:,jj) )
+
+      ! remove extraband added to domain
+      CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. )
+
+      ! filter
+      CALL filter_fill_value(tl_var(ji))      
+
+   ENDDO
+
+   ! clean
+   CALL dom_clean_extra( tl_dom )
+
+   ! close mpp files
+   CALL iom_dom_close(tl_coord0)
+
+   ! clean
+   CALL mpp_clean(tl_coord0)
+
+   ! create file
+   tl_fileout=file_init(TRIM(cn_fileout))
+
+   ! add dimension
+   ! save biggest dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,ip_maxdim
+      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+   ENDDO
+
+   ! add variables
+   DO ji=il_nvar,1,-1
+      CALL file_add_var(tl_fileout, tl_var(ji))
+      CALL var_clean(tl_var(ji))
+   ENDDO
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN create_coord")
+   CALL file_add_att(tl_fileout, tl_att)
+
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   tl_att=att_init("src_file",TRIM(fct_basename(cn_coord0)))
+   CALL file_add_att(tl_fileout, tl_att)   
+
+   tl_att=att_init("src_i_indices",(/tl_dom%i_imin,tl_dom%i_imax/))
+   CALL file_add_att(tl_fileout, tl_att)   
+   tl_att=att_init("src_j_indices",(/tl_dom%i_jmin,tl_dom%i_jmax/))
+   CALL file_add_att(tl_fileout, tl_att)
+   IF( .NOT. ALL(il_rho(:)==1) )THEN
+      tl_att=att_init("refinment_factor",(/il_rho(jp_I),il_rho(jp_J)/))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_dom%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_dom%i_perio)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+   ! add attribute east west overlap
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
+   ENDIF
+   IF( il_attid == 0 )THEN
+      il_ind=var_get_index(tl_fileout%t_var(:),'longitude')
+      IF( il_ind == 0 )THEN
+         il_ind=var_get_index(tl_fileout%t_var(:),'longitude_T')
+      ENDIF
+      il_ew=grid_get_ew_overlap(tl_fileout%t_var(il_ind))
+      IF( il_ew >= 0 )THEN
+         tl_att=att_init('ew_overlap',il_ew)
+         CALL file_add_att(tl_fileout,tl_att)
+      ENDIF
+   ENDIF
+
+   ! create file
+   CALL iom_create(tl_fileout)
+
+   ! write file
+   CALL iom_write_file(tl_fileout)
+
+   ! close file
+   CALL iom_close(tl_fileout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL var_clean(tl_var(:))
+   DEALLOCATE( tl_var) 
+
+   CALL file_clean(tl_fileout)
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close() 
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute offset over Arakawa grid points, 
+   !> given refinement factor.
+   !> 
+   !> @author J.Paul
+   !> @date August, 2014 - Initial Version
+   !>
+   !> @param[in] id_rho array of refinement factor
+   !> @return array of offset
+   !-------------------------------------------------------------------
+   FUNCTION create_coord_get_offset( id_rho )
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2,ip_npoint) :: create_coord_get_offset
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! case 'T'
+      create_coord_get_offset(jp_I,:,jp_T)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
+      create_coord_get_offset(jp_J,:,jp_T)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
+      ! case 'U'
+      create_coord_get_offset(jp_I,1,jp_U)=0
+      create_coord_get_offset(jp_I,2,jp_U)=id_rho(jp_I)-1
+      create_coord_get_offset(jp_J,:,jp_U)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
+      ! case 'V'
+      create_coord_get_offset(jp_I,:,jp_V)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
+      create_coord_get_offset(jp_J,1,jp_V)=0
+      create_coord_get_offset(jp_J,2,jp_V)=id_rho(jp_J)-1
+      ! case 'F'
+      create_coord_get_offset(jp_I,1,jp_F)=0
+      create_coord_get_offset(jp_I,2,jp_F)=id_rho(jp_I)-1
+      create_coord_get_offset(jp_J,1,jp_F)=0
+      create_coord_get_offset(jp_J,2,jp_F)=id_rho(jp_J)-1
+
+
+   END FUNCTION create_coord_get_offset
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable, given refinment factor.
+   !> 
+   !> @details 
+   !>  Optionaly, you could specify number of points 
+   !>    to be extrapolated in i- and j-direction.<br/>
+   !>  variable mask is first computed (using _FillValue) and interpolated.<br/>
+   !>  variable is then extrapolated, and interpolated.<br/> 
+   !>  Finally interpolated mask is applied on refined variable.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable strcuture 
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] id_offset offset between fine grid and coarse grid
+   !> @param[in] id_iext   number of points to be extrapolated in i-direction
+   !> @param[in] id_jext   number of points to be extrapolated in j-direction
+   !>
+   !> @todo check if mask is really needed
+   !-------------------------------------------------------------------
+   SUBROUTINE create_coord_interp( td_var,          &
+   &                               id_rho,          &
+   &                               id_offset,       &
+   &                               id_iext, id_jext)
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      TYPE(TVAR)  :: tl_mask
+
+      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
+         CALL logger_error("CREATE COORD INTERP: invalid dimension of "//&
+         &                 "offset array")
+      ENDIF
+
+      !WARNING: two extrabands are required for cubic interpolation
+      il_iext=2
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=2
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+      
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      IF( ANY(id_rho(:)>1) )THEN
+         ! work on mask
+         ! create mask
+         ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+         &                td_var%t_dim(2)%i_len, &
+         &                td_var%t_dim(3)%i_len, &
+         &                td_var%t_dim(4)%i_len) )
+
+         bl_mask(:,:,:,:)=1
+         WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+         SELECT CASE(TRIM(td_var%c_point))
+         CASE DEFAULT ! 'T'
+            tl_mask=var_init('tmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         CASE('U')
+            tl_mask=var_init('umask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         CASE('V')
+            tl_mask=var_init('vmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         CASE('F')
+            tl_mask=var_init('fmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         END SELECT         
+
+         DEALLOCATE(bl_mask)
+
+         ! interpolate mask
+         CALL interp_fill_value( tl_mask, id_rho(:), &
+         &                       id_offset=id_offset(:,:) )
+
+         ! work on variable
+         ! add extraband
+         CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+         ! extrapolate variable
+         CALL extrap_fill_value( td_var )
+
+         ! interpolate variable
+         CALL interp_fill_value( td_var, id_rho(:), &
+         &                       id_offset=id_offset(:,:))
+
+         ! remove extraband
+         CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+         ! keep original mask 
+         WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+            td_var%d_value(:,:,:,:)=td_var%d_fill
+         END WHERE
+      ENDIF
+
+      ! clean variable structure
+      CALL var_clean(tl_mask)
+
+   END SUBROUTINE create_coord_interp
+END PROGRAM create_coord
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_meshmask.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_meshmask.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_meshmask.f90	(revision 8732)
@@ -0,0 +1,1747 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! PROGRAM: create_meshmask
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!>  This program creates the NetCDF file(s) which contain(s) all the
+!>  ocean domain informations.
+!>  It allows to create the domain_cfg.nc file needed to run NEMO, or 
+!>  the mesh_mask file(s).
+!>
+!> @details
+!> @section sec1 method
+!>  Bathymetry (and optionally ice shelf draft) is read on input file.<br/>
+!>  Horizontal grid-point position and scale factors, and the coriolis factor 
+!>  are read in coordinates file or computed.<br/> 
+!>  Vertical coordinate is defined, and the bathymetry recomputed to fit the
+!>  vertical grid.<br/>
+!>  Finally the masks from the bathymetry are computed.
+!>
+!>  All the arrays generated, are writen in one to three file(s) depending on
+!>  output option.
+!>  @note the file contain depends on
+!>  the vertical coordinate used (z-coord, partial steps, s-coord)
+!>
+!> @section sec2 how to
+!>    to create domain_cfg or meshmask file:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/create_meshmask create_meshmask.nam
+!> @endcode
+!>
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_meshmask.nam contains 13 namelists:<br/>
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - input files namelist (namin)
+!>       - horizontal grid namelist (namhgr)
+!>       - vertical grid namelist (namzgr)
+!>       - minimum depth namelist (namdmin)
+!>       - vertical coordinate namelist (namzco)
+!>       - partial step namelist (namzps)
+!>       - sigma or hybrid namelist (namsco)
+!>       - lateral boundary condition namelist (namlbc)
+!>       - wetting and dryong namelist (namwd)
+!>       - grid namelist (namgrd)
+!>       - output namelist (namout)
+!>
+!>    * _logger namelist (namlog)_:<br/>
+!>       - cn_logfile   : log filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!> 'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:<br/>
+!>       - cn_varcfg : variable configuration file
+!> (see ./SIREN/cfg/variable.cfg).
+!>       - cn_dimcfg : dimension configuration file. define dimensions allowed
+!> (see ./SIREN/cfg/dimension.cfg).
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _input files namelist (namin)_:<br/>
+!>       - cn_bathy     : Bathymetry file
+!>       - cn_varbathy  : Bathymetry variable name
+!>       - cn_coord     : coordinate file (in_mshhgr=0)
+!>       - cn_isfdep    : Iceshelf draft  (ln_isfcav=true)
+!>       - cn_varisfdep : Iceshelf draft variable name (ln_isfcav=true)
+!>       - in_perio     : NEMO periodicity
+!>       - ln_closea    :
+!>
+!>    * _horizontal grid namelist (namhgr)_:<br/>
+!>       - in_mshhgr   : 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
+!>         - 5: beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+!>       - dn_ppglam0  : longitude of first raw and column T-point (in_mshhgr = 1 or 4)
+!>       - dn_ppgphi0  : latitude  of first raw and column T-point (in_mshhgr = 1 or 4)
+!>       - dn_ppe1_deg : zonal      grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+!>       - dn_ppe2_deg : meridional grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+!>
+!>    * _vertical grid namelist (namzgr)_:<br/>
+!>       - ln_zco    : z-coordinate - full steps
+!>       - ln_zps    : z-coordinate - partial steps
+!>       - ln_sco    : s- or hybrid z-s-coordinate
+!>       - ln_isfcav : ice shelf cavities
+!>       - ln_iscpl  : coupling with ice sheet
+!>       - ln_wd     : Wetting/drying activation
+!>       - in_nlevel : number of vertical level
+!>
+!>    * _depth namelist (namdmin)_:<br/>
+!>       - dn_hmin      : minimum ocean depth (>0) or minimum number of ocean levels (<0)
+!>       - dn_isfhmin   : threshold to discriminate grounded ice to floating ice
+!>
+!>    * _vertical coordinate namelist (namzco)_:<br/>
+!>       - dn_ppsur              : coefficient to compute vertical grid
+!>       - dn_ppa0               : coefficient to compute vertical grid
+!>       - dn_ppa1               : coefficient to compute vertical grid
+!>       - dn_ppkth              : coefficient to compute vertical grid
+!>       - dn_ppacr              : coefficient to compute vertical grid
+!>       - ln_dbletanh           : use double tanh function for vertical coordinates
+!>       - dn_ppa2               : double tanh function parameter
+!>       - dn_ppkth2             : double tanh function parameter
+!>       - dn_ppacr2             : double tanh function parameter
+!>       - dn_ppdzmin            : minimum vertical spacing
+!>       - dn_pphmax             : maximum depth
+!>
+!>     @note If *ppa1* and *ppa0* and *ppsur* are undefined
+!>           NEMO will compute them from *ppdzmin* , *pphmax*, *ppkth*, *ppacr*
+!>
+!>       this namelist is also needed to define partial steps, sigma or hybrid coordinate.
+!>
+!>    * _partial step namelist (namzps)_:<br/>
+!>       - dn_e3zps_min          : minimum thickness of partial step level (meters)
+!>       - dn_e3zps_rat          : minimum thickness ratio of partial step level
+!>
+!>    * _sigma or hybrid namelist (namsco)_:<br/>
+!>       - ln_s_sh94    : use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1
+!>       - ln_s_sf12    : use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma
+!>       - dn_sbot_min  : minimum depth of s-bottom surface (>0) (m)
+!>       - dn_sbot_max  : maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+!>       - dn_hc        : Critical depth for transition from sigma to stretched coordinates
+!>       Song and Haidvogel 1994 stretching additional parameters
+!>          - dn_rmax      : maximum cut-off r-value allowed (0<dn_rmax<1)
+!>          - dn_theta     : surface control parameter (0<=dn_theta<=20)
+!>          - dn_thetb     : bottom control parameter  (0<=dn_thetb<= 1)
+!>          - dn_bb        : stretching parameter ( dn_bb=0; top only, dn_bb =1; top and bottom)
+!>       Siddorn and Furner stretching additional parameters
+!>          - ln_sigcrit   : switching to sigma (T) or Z (F) at H<Hc
+!>          - dn_alpha     : stretchin parameter ( >1 surface; <1 bottom)
+!>          - dn_efold     : e-fold length scale for transition region
+!>          - dn_zs        : Surface cell depth (Zs) (m)
+!>          Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+!>          - dn_zb_a      : Bathymetry multiplier for Zb
+!>          - dn_zb_b      : Offset for Zb
+!>
+!>    * _lateral boundary condition namelist (namlbc)_:<br/>
+!>       - rn_shlat : lateral boundary conditions at the coast (modify fmask)
+!>          -     shlat = 0 : free slip
+!>          - 0 < shlat < 2 : partial slip 
+!>          -     shlat = 2 : no slip
+!>          -     shlat > 2 : strong slip
+!>    for more information see Boundary Condition at the Coast 
+!>    in [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 
+!>
+!>    * _wetting and drying namelist (namwd)_:<br/>
+!>       - dn_wdmin1    : minimum water depth on dried cells
+!>       - dn_wdmin2    : tolerrance of minimum water depth on dried cells
+!>       - dn_wdld      : land elevation below which wetting/drying
+!>    
+!>    * _grid namelist (namgrd)_:<br/>
+!>       - in_cfg    : inverse resolution of the configuration (1/4° => 4)
+!>       - ln_bench  : GYRE (in_mshhgr = 5 ) used as Benchmark.<br/>
+!>                     => forced the resolution to be about 100 km
+!>       - ln_c1d    : use configuration 1D
+!>       - ln_e3_dep : vertical scale factors =T: e3.=dk[depth] =F: old definition
+!>    * _output namelist (namout)_:<br/>
+!>       - cn_domcfg    : output file name
+!>       - in_msh       : number of output file and contain (0-9)
+!>       - in_nproc     : number of processor to be used
+!>       - in_niproc    : i-direction number of processor
+!>       - in_njproc    : j-direction numebr of processor
+!>
+!>    @note
+!>        - if         in_msh = 0  : write '**domain_cfg.nc**' file.
+!>        - if MOD(in_msh, 3) = 1  : write '<b>mesh_mask.nc</b>' file.
+!>        - if MOD(in_msh, 3) = 2  : write '<b>mesh.nc</b>' and '<b>mask.nc</b>' files.
+!>        - if MOD(in_msh, 3) = 0  : write '<b>mesh_hgr.nc</b>', '<b>mesh_zgr.nc</b>' and '<b>mask.nc</b>' files.<br/>
+!>        For huge size domain, use option 2 or 3 depending on your vertical coordinate.
+!>        - if     in_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
+!>        - if 3 < in_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 
+!>                            corresponding to the depth of the bottom t- and w-points
+!>        - if 6 < in_msh <= 9: write 2D arrays corresponding to the depth and the
+!>                            thickness (e3[tw]_ps) of the bottom points
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date September, 2015 - Initial Version (based on domhgr.F90, domzgr.F90, domwri.F90)
+!> @date October, 2016
+!> - update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!> - do not use anymore special case for ORCA grid
+!> - allow to write domain_cfg file
+!> @date November, 2016
+!> - choose vertical scale factors (e3.=dk[depth] or old definition)
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_meshmask
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE date                            ! date manager
+   USE fct                             ! basic useful function
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   USE lbc                             ! lateral boundary conditions
+   USE grid
+   USE grid_hgr
+   USE grid_zgr
+
+   IMPLICIT NONE
+
+   ! local variable
+   CHARACTER(LEN=lc)                              :: cl_namelist
+   CHARACTER(LEN=lc)                              :: cl_date
+
+   INTEGER(i1), DIMENSION(:)        , ALLOCATABLE :: bl_tmp
+
+   INTEGER(i4)                                    :: il_narg
+   INTEGER(i4)                                    :: il_status
+   INTEGER(i4)                                    :: il_fileid
+   INTEGER(i4)                                    :: il_attid
+   INTEGER(i4)                                    :: il_ew
+   INTEGER(i4)                                    :: jpi
+   INTEGER(i4)                                    :: jpj
+   INTEGER(i4)                                    :: jpk
+   INTEGER(i4), DIMENSION(:)        , ALLOCATABLE :: il_tmp
+   INTEGER(i4), DIMENSION(:,:)      , ALLOCATABLE :: il_mask
+
+   LOGICAL                                        :: ll_exist
+   LOGICAL                                        :: ll_domcfg
+
+   REAL(dp)   , DIMENSION(:,:)      , ALLOCATABLE :: dl_tmp2D
+   REAL(dp)   , DIMENSION(:,:,:)    , ALLOCATABLE :: dl_tmp3D
+
+   TYPE(TATT)                                     :: tl_att
+   TYPE(TATT) , DIMENSION(:)        , ALLOCATABLE :: tl_gatt
+
+   TYPE(TDIM)                                     :: tl_dim
+   
+   TYPE(TVAR)                                     :: tl_bathy
+   TYPE(TVAR)                                     :: tl_risfdep
+   TYPE(TVAR)                                     :: tl_misf
+   TYPE(TVAR)                                     :: tl_gdepu
+   TYPE(TVAR)                                     :: tl_gdepv
+   TYPE(TVAR)                                     :: tl_hdept
+   TYPE(TVAR)                                     :: tl_hdepw
+   TYPE(TVAR)                                     :: tl_scalar
+
+   TYPE(TNAMH)                                    :: tl_namh
+   TYPE(TNAMZ)                                    :: tl_namz
+
+   TYPE(TMPP)                                     :: tl_mpp
+   TYPE(TMPP) , TARGET                            :: tl_mppout0
+   TYPE(TMPP) , TARGET                            :: tl_mppout1
+   TYPE(TMPP) , TARGET                            :: tl_mppout2
+   TYPE(TMPP) , POINTER                           :: tl_mppmsk
+   TYPE(TMPP) , POINTER                           :: tl_mpphgr
+   TYPE(TMPP) , POINTER                           :: tl_mppzgr
+
+   ! parameter
+   INTEGER(i4) , PARAMETER :: ip_maxatt = 40
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+
+   INTEGER(i4) :: ik
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc) :: cn_logfile  = 'create_meshmask.log' 
+   CHARACTER(LEN=lc) :: cn_verbosity= 'warning' 
+   INTEGER(i4)       :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc) :: cn_varcfg   = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc) :: cn_dimcfg   = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc) :: cn_dumcfg   = './cfg/dummy.cfg'
+
+   ! namin
+   CHARACTER(LEN=lc) :: cn_bathy    = ''
+   CHARACTER(LEN=lc) :: cn_varbathy = ''
+   CHARACTER(LEN=lc) :: cn_coord    = ''
+   CHARACTER(LEN=lc) :: cn_isfdep   = ''
+   CHARACTER(LEN=lc) :: cn_varisfdep= 'isfdraft'
+   INTEGER(i4)       :: in_perio    = -1
+   LOGICAL           :: ln_closea   = .TRUE.
+
+   ! namzgr
+   LOGICAL           :: ln_zco      = .FALSE.
+   LOGICAL           :: ln_zps      = .FALSE.
+   LOGICAL           :: ln_sco      = .FALSE.
+   LOGICAL           :: ln_isfcav   = .FALSE.
+   LOGICAL           :: ln_iscpl    = .FALSE.
+   LOGICAL           :: ln_wd       = .FALSE.
+   INTEGER(i4)       :: in_nlevel   = 75
+
+   ! namlbc
+   REAL(sp)          :: rn_shlat    = 2.
+
+   ! namout
+   CHARACTER(LEN=lc) :: cn_domcfg   = 'domain_cfg.nc'
+   INTEGER(i4)       :: in_msh      = 0 
+   CHARACTER(LEN=lc) :: cn_type     = 'cdf'
+   INTEGER(i4)       :: in_nproc    = 0
+   INTEGER(i4)       :: in_niproc   = 0
+   INTEGER(i4)       :: in_njproc   = 0
+   !-------------------------------------------------------------------
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namin/  &  !< input namelist
+   &  cn_bathy,      &  !< Bathymetry file
+   &  cn_varbathy,   &  !< Bathymetry variable name
+   &  cn_coord,      &  !< Coordinate file (in_mshhgr=0)
+   &  cn_isfdep,     &  !< Iceshelf draft  (ln_isfcav=true)
+   &  cn_varisfdep,  &  !< Iceshelf draft variable name (ln_isfcav=true)
+   &  in_perio,      &  !< NEMO periodicity
+   &  ln_closea
+
+   NAMELIST /namzgr/ &
+   &  ln_zco,        &  !< z-coordinate
+   &  ln_zps,        &  !< z-coordinate with partial steps
+   &  ln_sco,        &  !< s-coordinate
+   &  ln_isfcav,     &  !< presence of ISF
+   &  ln_iscpl,      &  !< coupling with ice sheet
+   &  ln_wd,         &  !< Wetting/drying activation
+   &  in_nlevel
+
+   NAMELIST /namlbc/  &
+   &  rn_shlat          !< lateral momentum boundary condition
+
+   NAMELIST /namout/ &  !< output namlist
+   &  cn_domcfg,     &  !< output file name
+   &  in_msh,        &  !< number of output file (1,2,3)
+   &  in_nproc,      &  !< number of processor to be used
+   &  in_niproc,     &  !< i-direction number of processor
+   &  in_njproc         !< j-direction numebr of processor
+   !-------------------------------------------------------------------   
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !1- namelist
+   !1-1 get namelist
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+   IF( il_narg/=1 )THEN
+      PRINT *,"ERROR in create_mask: need a namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+   !1-2 read namelist
+   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"ERROR in create_mask: error opening "//TRIM(cl_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      !1-2-1 define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      !1-2-2 get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namin   )
+      READ( il_fileid, NML = namzgr  )
+      READ( il_fileid, NML = namlbc  )
+
+      READ( il_fileid, NML = namout  )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE MASK: closing "//TRIM(cl_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"ERROR in create_mask: can't find "//TRIM(cl_namelist)
+
+   ENDIF
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ll_domcfg=.FALSE.
+   IF( in_msh == 0 )THEN
+      ll_domcfg=.TRUE.
+   ENDIF
+
+   ! open file
+   IF( cn_bathy /= '' )THEN
+      tl_mpp=mpp_init( file_init(TRIM(cn_bathy)), id_perio=in_perio)
+      CALL grid_get_info(tl_mpp)
+   ELSE
+      CALL logger_fatal("CREATE MESH MASK: no input bathymetry file found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   ! read bathymetry
+   WRITE(*,*) 'FILE TO BE USED:',TRIM(cn_bathy)
+   CALL iom_mpp_open(tl_mpp)
+
+   ! get dimension
+   jpi=tl_mpp%t_dim(jp_I)%i_len
+   jpj=tl_mpp%t_dim(jp_J)%i_len
+   jpk=in_nlevel
+
+   WRITE(*,*) 'DIMENSION TO BE USED :',jpi,jpj,jpk
+
+   ! read variable
+   IF( TRIM(cn_varbathy) == '' )THEN
+      IF( ln_zco )THEN
+         cn_varbathy='Bathy_level'
+      ELSEIF( ln_zps .OR. ln_sco )THEN
+         IF( ln_isfcav )THEN
+            cn_varbathy='Bathymetry_isf'
+         ELSE
+            cn_varbathy='Bathymetry'
+         ENDIF
+      ENDIF
+   ENDIF
+   WRITE(*,*) 'VARIABLE READ : '//TRIM(cn_varbathy)
+   tl_bathy=iom_mpp_read_var(tl_mpp, TRIM(cn_varbathy))
+   CALL iom_mpp_close(tl_mpp)
+
+   WHERE( tl_bathy%d_value(:,:,1,1) == tl_bathy%d_fill .OR. &
+        & tl_bathy%d_value(:,:,1,1) < 0._dp )
+      tl_bathy%d_value(:,:,1,1) = 0._dp
+   END WHERE
+ 
+   IF ( ln_isfcav ) THEN
+      WRITE(*,*) 'ICESHELF DRAFT FILE TO BE USED:',TRIM(cn_isfdep)
+      WRITE(*,*) 'ICESHELF VARIABLE READ : '//TRIM(cn_varisfdep)
+      ! open Iceshelf draft
+      IF( cn_isfdep /= '' )THEN
+         tl_mpp=mpp_init( file_init(TRIM(cn_isfdep)), id_perio=in_perio)
+         CALL grid_get_info(tl_mpp)
+      ELSE
+         CALL logger_fatal("CREATE MESH MASK: no input Iceshelf draft '//&
+            &  'file found. check namelist")      
+      ENDIF
+
+      ! read Iceshelf draft
+      CALL iom_mpp_open(tl_mpp)
+      IF( ln_zps .OR. ln_sco )   THEN
+         tl_risfdep=iom_mpp_read_var(tl_mpp, cn_varisfdep)
+      ENDIF
+      CALL iom_mpp_close(tl_mpp)
+   ELSE
+      ALLOCATE(dl_tmp2D(jpi,jpj))
+      dl_tmp2D(:,:)=0._dp
+
+      tl_risfdep=var_init(cn_varisfdep, dl_tmp2D(:,:), id_type=NF90_DOUBLE)
+
+      DEALLOCATE(dl_tmp2D)
+   ENDIF
+
+   ! fill closed sea
+   IF( ln_closea )THEN
+      WRITE(*,*) "CLOSED SEA"
+      ALLOCATE( il_mask(tl_bathy%t_dim(1)%i_len, &
+      &                 tl_bathy%t_dim(2)%i_len) )
+
+      ! split domain in N sea subdomain
+      il_mask(:,:)=grid_split_domain(tl_bathy)
+
+      !  fill smallest domain
+      CALL grid_fill_small_dom( tl_bathy, il_mask(:,:) )
+
+      DEALLOCATE( il_mask )
+   ENDIF
+
+   in_perio = tl_mpp%i_perio
+   il_ew    = tl_mpp%i_ew
+
+   ! clean
+   CALL mpp_clean(tl_mpp)
+
+   ! Horizontal mesh (dom_hgr) -------------------------------------------------
+   tl_namh=grid_hgr_nam( cn_coord, in_perio, cl_namelist )
+
+   ! init Horizontal grid global variable
+   CALL grid_hgr_init(jpi,jpj,jpk,ll_domcfg)
+
+   ! compute horizontal mesh
+   WRITE(*,*) "COMPUTE HORIZONTAL MESH"
+   CALL grid_hgr_fill(tl_namh,jpi,jpj,ll_domcfg)      
+
+   ! Vertyical  mesh (dom_zgr) -------------------------------------------------
+   tl_namz=grid_zgr_nam( cn_coord, in_perio, cl_namelist )
+
+   ! init Vertical grid global variable
+   CALL grid_zgr_init(jpi,jpj,jpk,ln_sco)
+   IF( ln_zps    ) CALL grid_zgr_zps_init(jpi,jpj)
+   IF( ln_sco    ) CALL grid_zgr_sco_init(jpi,jpj) 
+
+   ! compute vertical  mesh
+   WRITE(*,*) "COMPUTE VERTICAL MESH"
+   CALL grid_zgr_fill( tl_namz,jpi,jpj,jpk, tl_bathy, tl_risfdep )
+
+   ! compute masks
+   WRITE(*,*) "COMPUTE MASK"
+   CALL create__mask(tl_namh,jpi,jpj,jpk,ll_domcfg)
+
+   ! Maximum stiffness ratio/hydrostatic consistency
+   IF( ln_sco    ) CALL grid_zgr_sco_stiff(tl_namz,jpi,jpj,jpk)
+ 
+   ! clean
+   CALL var_clean(tl_bathy)
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! create ouptut structure 
+   IF( in_niproc == 0 .AND. &
+   &   in_njproc == 0 .AND. &
+   &   in_nproc  == 0 )THEN
+      in_niproc = 1
+      in_njproc = 1
+      in_nproc = 1
+   ENDIF
+
+   WRITE(*,*) "WRITE FILE(S)"
+   IF( ll_domcfg )THEN
+         !                                  ! ============================
+         !                                  ! create 'domain_cfg.nc' file
+         !                                  ! ============================
+         tl_mppout0=mpp_init( cn_domcfg, tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout0
+         tl_mppzgr=>tl_mppout0
+
+   ELSE
+      SELECT CASE ( MOD(in_msh, 3) )
+         !                                  ! ============================
+      CASE ( 1 )                            !  create 'mesh_mask.nc' file
+         !                                  ! ============================
+         tl_mppout0=mpp_init( 'mesh_mask', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout0
+         tl_mppzgr=>tl_mppout0
+         
+         !                                  ! ============================
+      CASE ( 2 )                            !  create 'mesh.nc' and 
+         !                                  !         'mask.nc' files
+         !                                  ! ============================
+         tl_mppout0=mpp_init( 'mask', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         tl_mppout1=mpp_init( 'mesh', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout1
+         tl_mppzgr=>tl_mppout1
+
+         !                                  ! ============================
+      CASE ( 0 )                            !  create 'mesh_hgr.nc'
+         !                                  !         'mesh_zgr.nc' and
+         !                                  !         'mask.nc'     files
+         !                                  ! ============================
+         tl_mppout0=mpp_init( 'mask', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         tl_mppout1=mpp_init( 'mesh_hgr', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         tl_mppout2=mpp_init( 'mesh_zgr', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         !
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout1
+         tl_mppzgr=>tl_mppout2
+
+      END SELECT
+   ENDIF
+
+   ! add variables
+   IF( ll_domcfg )THEN
+      ALLOCATE(il_tmp(1))
+      tl_dim%l_use=.FALSE.
+
+      il_tmp(:)=jpi
+      tl_scalar=var_init('jpiglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      il_tmp(:)=jpj
+      tl_scalar=var_init('jpjglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      il_tmp(:)=jpk
+      tl_scalar=var_init('jpkglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+      
+      il_tmp(:)=tl_mppout0%i_perio
+      tl_scalar=var_init('jperio', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      DEALLOCATE(il_tmp)
+      ALLOCATE(bl_tmp(1))
+
+      bl_tmp(:)=0
+      IF( ln_zco ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_zco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      bl_tmp(:)=0
+      IF( ln_zps ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_zps',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      bl_tmp(:)=0
+      IF( ln_sco ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_sco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      bl_tmp(:)=0
+      IF( ln_isfcav ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_isfcav',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      DEALLOCATE(bl_tmp)
+      CALL var_clean(tl_scalar)
+   ENDIF
+
+   !!! mask (msk)
+   !!!----------------------
+   IF( .NOT. ll_domcfg )THEN
+      ! tmask
+      CALL mpp_add_var(tl_mppmsk, tg_tmask)
+      CALL var_clean(tg_tmask)
+      ! umask
+      CALL mpp_add_var(tl_mppmsk, tg_umask)
+      CALL var_clean(tg_umask)
+      ! vmask
+      CALL mpp_add_var(tl_mppmsk, tg_vmask)
+      CALL var_clean(tg_vmask)
+      ! fmask
+      CALL mpp_add_var(tl_mppmsk, tg_fmask)
+      CALL var_clean(tg_fmask)
+   ENDIF
+
+   !!! horizontal mesh (hgr)
+   !!!----------------------
+
+   ! latitude
+   ! glamt
+   CALL mpp_add_var(tl_mpphgr, tg_glamt)
+   CALL var_clean(tg_glamt)
+   ! glamu
+   CALL mpp_add_var(tl_mpphgr, tg_glamu)
+   CALL var_clean(tg_glamu)
+   ! glamV
+   CALL mpp_add_var(tl_mpphgr, tg_glamv)
+   CALL var_clean(tg_glamv)
+   ! glamf
+   CALL mpp_add_var(tl_mpphgr, tg_glamf)
+   CALL var_clean(tg_glamf)
+
+   ! longitude
+   ! gphit
+   CALL mpp_add_var(tl_mpphgr, tg_gphit)
+   CALL var_clean(tg_gphit)
+   ! gphiu
+   CALL mpp_add_var(tl_mpphgr, tg_gphiu)
+   CALL var_clean(tg_gphiu)
+   ! gphiv
+   CALL mpp_add_var(tl_mpphgr, tg_gphiv)
+   CALL var_clean(tg_gphiv)
+   ! gphif
+   CALL mpp_add_var(tl_mpphgr, tg_gphif)
+   CALL var_clean(tg_gphif)
+
+   ! e1 scale factors
+   ! e1t
+   CALL mpp_add_var(tl_mpphgr, tg_e1t)
+   CALL var_clean(tg_e1t)
+   ! e1u
+   CALL mpp_add_var(tl_mpphgr, tg_e1u)
+   CALL var_clean(tg_e1u)
+   ! e1v
+   CALL mpp_add_var(tl_mpphgr, tg_e1v)
+   CALL var_clean(tg_e1v)
+   ! e1f
+   CALL mpp_add_var(tl_mpphgr, tg_e1f)
+   CALL var_clean(tg_e1f)
+
+   ! e2 scale factors
+   ! e2t
+   CALL mpp_add_var(tl_mpphgr, tg_e2t)
+   CALL var_clean(tg_e2t)
+   ! e2u
+   CALL mpp_add_var(tl_mpphgr, tg_e2u)
+   CALL var_clean(tg_e2u)
+   ! e2v
+   CALL mpp_add_var(tl_mpphgr, tg_e2v)
+   CALL var_clean(tg_e2v)
+   ! e2f
+   CALL mpp_add_var(tl_mpphgr, tg_e2f)
+   CALL var_clean(tg_e2f)
+
+   ! coriolis factor
+   ! ff_t
+   CALL mpp_add_var(tl_mpphgr, tg_ff_t)
+   CALL var_clean(tg_ff_t)
+   ! ff_f
+   CALL mpp_add_var(tl_mpphgr, tg_ff_f)
+   CALL var_clean(tg_ff_f)
+
+   ! angles
+   IF( .NOT. ll_domcfg )THEN
+      ! cost
+      CALL mpp_add_var(tl_mpphgr, tg_gcost)
+      CALL var_clean(tg_gcost)
+      ! cosu
+      CALL mpp_add_var(tl_mpphgr, tg_gcosu)
+      CALL var_clean(tg_gcosu)
+      ! cosv
+      CALL mpp_add_var(tl_mpphgr, tg_gcosv)
+      CALL var_clean(tg_gcosv)
+      ! cosf
+      CALL mpp_add_var(tl_mpphgr, tg_gcosf)
+      CALL var_clean(tg_gcosf)
+      
+      ! sint
+      CALL mpp_add_var(tl_mpphgr, tg_gsint)
+      CALL var_clean(tg_gsint)
+      ! sinu
+      CALL mpp_add_var(tl_mpphgr, tg_gsinu)
+      CALL var_clean(tg_gsinu)
+      ! sinv
+      CALL mpp_add_var(tl_mpphgr, tg_gsinv)
+      CALL var_clean(tg_gsinv)
+      ! sinf
+      CALL mpp_add_var(tl_mpphgr, tg_gsinf)
+      CALL var_clean(tg_gsinf)
+   ENDIF
+   
+   !!! vertical mesh (zgr)
+   !!!----------------------
+   ! note that mbkt is set to 1 over land ==> use surface tmask
+   ! 
+   ! mbathy
+   tg_mbathy%d_value(:,:,:,:) = tg_ssmask%d_value(:,:,:,:) * &
+   &                            tg_mbkt%d_value(:,:,:,:)
+   !
+   IF( ll_domcfg )THEN
+      tg_mbathy%c_name='bottom_level'
+   ENDIF
+   CALL mpp_add_var(tl_mppzgr, tg_mbathy)
+   CALL var_clean(tg_mbathy)
+
+   ! misf
+   ALLOCATE(dl_tmp2D(jpi,jpj))
+   dl_tmp2D(:,:)=dp_fill
+
+   tl_misf =var_init('misf     ',dl_tmp2D(:,:), id_type=NF90_INT)
+
+   DEALLOCATE(dl_tmp2D)
+   tl_misf%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1) * &
+   &                          tg_mikt%d_value(:,:,1,1)
+   !
+   IF( ll_domcfg ) tl_misf%c_name='top_level'
+   CALL mpp_add_var(tl_mppzgr, tl_misf)
+   CALL var_clean(tl_misf)
+
+   IF( .NOT. ll_domcfg )THEN
+      ! isfdraft
+      tl_risfdep%d_value(:,:,:,:) = tl_risfdep%d_value(:,:,:,:) * &
+      &                             tg_mikt%d_value(:,:,:,:)
+ 
+      CALL mpp_add_var(tl_mppzgr, tl_risfdep)
+      CALL var_clean(tl_risfdep)
+   ENDIF
+
+   IF( ln_sco ) THEN ! s-coordinate
+
+      IF( .NOT. ll_domcfg )THEN
+         ! hbatt
+         CALL mpp_add_var(tl_mppzgr, tg_hbatt)
+         CALL var_clean(tg_hbatt)
+         ! hbatu
+         CALL mpp_add_var(tl_mppzgr, tg_hbatu)
+         CALL var_clean(tg_hbatu)
+         ! hbatv
+         CALL mpp_add_var(tl_mppzgr, tg_hbatv)
+         CALL var_clean(tg_hbatv)
+         ! hbatf
+         CALL mpp_add_var(tl_mppzgr, tg_hbatf)
+         CALL var_clean(tg_hbatf)
+
+         ! scaling coef.
+         IF( .NOT. (tl_namz%l_s_sh94 .OR. tl_namz%l_s_sf12) )THEN
+            ! gsigt
+            CALL mpp_add_var(tl_mppzgr, tg_gsigt)
+            CALL var_clean(tg_gsigt)
+            ! gsigw
+            CALL mpp_add_var(tl_mppzgr, tg_gsigw)
+            CALL var_clean(tg_gsigw)
+            ! gsi3w
+            CALL mpp_add_var(tl_mppzgr, tg_gsi3w)
+            CALL var_clean(tg_gsi3w)
+            ! esigt
+            CALL mpp_add_var(tl_mppzgr, tg_esigt)
+            CALL var_clean(tg_esigt)
+            ! esigw
+            CALL mpp_add_var(tl_mppzgr, tg_esigw)
+            CALL var_clean(tg_esigw)
+         ENDIF
+      ENDIF
+
+      ! scale factors
+      ! e3t_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3t_0)
+      CALL var_clean(tg_e3t_0)
+      ! e3u_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3u_0)
+      CALL var_clean(tg_e3u_0)
+      ! e3v_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3v_0)
+      CALL var_clean(tg_e3v_0)
+      ! e3f_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3f_0)
+      CALL var_clean(tg_e3f_0)
+      ! e3w_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3w_0)
+      CALL var_clean(tg_e3w_0)
+      ! e3uw_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3uw_0)
+      CALL var_clean(tg_e3uw_0)
+      ! e3vw_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3vw_0)
+      CALL var_clean(tg_e3vw_0)
+
+      ! Max. grid stiffness ratio
+      ! rx1
+      IF( ll_domcfg ) tg_rx1%c_name='stiffness'
+      CALL mpp_add_var(tl_mppzgr, tg_rx1)
+      CALL var_clean(tg_rx1)
+
+      ! stretched system
+      IF( .NOT. tl_namz%l_e3_dep )THEN
+         ! gdept_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdept_1d)
+         CALL var_clean(tg_gdept_1d)
+         ! gdepw_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d)
+         CALL var_clean(tg_gdepw_1d)
+         
+         ! gdept_0
+         CALL mpp_add_var(tl_mppzgr, tg_gdept_0)      
+         CALL var_clean(tg_gdept_0)
+         ! gdepw_0
+         CALL mpp_add_var(tl_mppzgr, tg_gdepw_0)      
+         CALL var_clean(tg_gdepw_0)
+      ENDIF
+
+   ENDIF
+
+   IF( ln_zps ) THEN ! z-coordinate - partial steps
+
+      IF( ll_domcfg .OR. in_msh <= 6 ) THEN ! 3D vertical scale factors
+
+         ! e3t_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3t_0)
+         CALL var_clean(tg_e3t_0)
+         ! e3u_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3u_0)
+         CALL var_clean(tg_e3u_0)
+         ! e3v_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3v_0)
+         CALL var_clean(tg_e3v_0)
+         ! e3w_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3w_0)
+         CALL var_clean(tg_e3w_0)
+
+      ELSE
+
+         DO jj = 1,jpj   
+            DO ji = 1,jpi
+               ik=tg_mbkt%d_value(ji,jj,1,1)
+               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1) * &
+                  &                         tg_ssmask%d_value(ji,jj,1,1)
+               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1) * &
+                  &                         tg_ssmask%d_value(ji,jj,1,1)
+            END DO
+         END DO         
+         ! e3t_ps
+         CALL mpp_add_var(tl_mppzgr, tg_e3tp)
+         CALL var_clean(tg_e3tp)
+         ! e3w_ps
+         CALL mpp_add_var(tl_mppzgr, tg_e3wp)
+         CALL var_clean(tg_e3wp)
+
+      ENDIF ! 3D vertical scale factors
+
+      IF( ll_domcfg .OR. in_msh <= 3 ) THEN ! 3D depth
+         
+         IF( .NOT. tl_namz%l_e3_dep )THEN
+      
+            ! gdepu, gdepv
+            IF( .NOT. ll_domcfg )THEN
+               ALLOCATE(dl_tmp3D(jpi,jpj,jpk))
+               dl_tmp3D(:,:,:)=dp_fill
+
+               tl_gdepu=var_init('gdepu',dl_tmp3D(:,:,:), id_type=NF90_FLOAT)
+               tl_gdepv=var_init('gdepv',dl_tmp3D(:,:,:), id_type=NF90_FLOAT)
+
+               DEALLOCATE(dl_tmp3D)
+               DO jk = 1,jpk   
+                  DO jj = 1, jpj-1   
+                     DO ji = 1, jpi-1   ! vector opt.
+                        tl_gdepu%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji  ,jj  ,jk,1) , &
+                           &                                tg_gdept_0%d_value(ji+1,jj  ,jk,1) )
+
+                        tl_gdepv%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji  ,jj  ,jk,1) , &
+                           &                                tg_gdept_0%d_value(ji  ,jj+1,jk,1) )
+                     END DO   
+                  END DO   
+               END DO         
+               CALL lbc_lnk( tl_gdepu%d_value(:,:,:,1), 'U', in_perio, 1._dp )
+               CALL lbc_lnk( tl_gdepv%d_value(:,:,:,1), 'V', in_perio, 1._dp )
+
+               ! gdepu
+               CALL mpp_add_var(tl_mppzgr, tl_gdepu)
+               CALL var_clean(tl_gdepu)
+               ! gdepv
+               CALL mpp_add_var(tl_mppzgr, tl_gdepv)
+               CALL var_clean(tl_gdepv)
+            ENDIF
+
+            ! gdept_0
+            CALL mpp_add_var(tl_mppzgr, tg_gdept_0)
+            CALL var_clean(tg_gdept_0)
+
+            ! gdepw_0
+            CALL mpp_add_var(tl_mppzgr, tg_gdepw_0)
+            CALL var_clean(tg_gdepw_0)
+         ENDIF
+
+      ELSE ! 2D bottom depth
+         ALLOCATE(dl_tmp2D(jpi,jpj))
+         dl_tmp2D(:,:)=dp_fill
+
+         tl_hdept=var_init('hdept',dl_tmp2D(:,:), id_type=NF90_INT)
+         tl_hdepw=var_init('hdepw',dl_tmp2D(:,:), id_type=NF90_INT)
+
+         DEALLOCATE(dl_tmp2D)
+         DO jj = 1,jpj   
+            DO ji = 1,jpi
+               ik=tg_mbkt%d_value(ji,jj,1,1)
+               tl_hdept%d_value(ji,jj,1,1) = tg_gdept_0%d_value(ji,jj,ik  ,1) * tg_ssmask%d_value(ji,jj,1,1)
+               tl_hdepw%d_value(ji,jj,1,1) = tg_gdepw_0%d_value(ji,jj,ik+1,1) * tg_ssmask%d_value(ji,jj,1,1)
+            END DO
+         END DO
+         ! hdept
+         CALL mpp_add_var(tl_mppzgr, tl_hdept)
+         CALL var_clean(tl_hdept)
+         ! hdepw
+         CALL mpp_add_var(tl_mppzgr, tl_hdepw)
+         CALL var_clean(tl_hdepw)
+
+         ! clean
+         CALL var_clean(tg_gdept_0)
+
+      ENDIF ! 3D depth
+
+   ENDIF
+
+   ! scale factors
+   IF( ll_domcfg )THEN
+      ! e3t_1d
+      CALL mpp_add_var(tl_mppzgr, tg_e3t_1d)
+      CALL var_clean(tg_e3t_1d)
+      ! e3w_1d
+      CALL mpp_add_var(tl_mppzgr, tg_e3w_1d)
+      CALL var_clean(tg_e3w_1d)
+   ENDIF
+
+   IF( ln_zps .OR. ln_zco )THEN ! z-coordinate 
+      IF( .NOT. tl_namz%l_e3_dep )THEN
+         ! depth
+         ! gdept_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdept_1d)
+         CALL var_clean(tg_gdept_1d)
+         ! gdepw_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d)
+         CALL var_clean(tg_gdepw_1d)
+      ENDIF
+   ENDIF
+
+   ! define global attributes
+   ALLOCATE(tl_gatt(ip_maxatt))
+
+   tl_gatt(:) = create__gloatt(cn_bathy,cn_coord,cn_isfdep,tl_namh,tl_namz)
+
+
+   IF( in_msh == 0 ) in_msh=1
+   SELECT CASE ( MOD(in_msh, 3) )
+      CASE ( 1 )
+         ! add some attribute
+         tl_att=att_init("Created_by","SIREN create_meshmask")
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         
+         cl_date=date_print(date_now())
+         tl_att=att_init("Creation_date",TRIM(cl_date))
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         
+         ! add attribute periodicity
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
+         ENDIF
+         IF( in_perio >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('periodicity',in_perio)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+         ENDIF
+         
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
+         ENDIF
+         IF( il_ew >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('ew_overlap',il_ew)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+         ENDIF
+         
+         ji=1
+         DO WHILE( tl_gatt(ji)%c_name /= '' )
+            CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
+            ji=ji+1
+         ENDDO
+         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ! create file
+         CALL iom_mpp_create(tl_mppmsk)
+         
+         ! write file
+         CALL iom_mpp_write_file(tl_mppmsk)
+         ! close file
+         CALL iom_mpp_close(tl_mppmsk)
+         
+         ! clean
+         CALL mpp_clean(tl_mppmsk)
+
+      CASE ( 2 )
+         ! add some attribute
+         tl_att=att_init("Created_by","SIREN create_meshmask")
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         
+         cl_date=date_print(date_now())
+         tl_att=att_init("Creation_date",TRIM(cl_date))
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         
+         ! add attribute periodicity
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
+         ENDIF
+         IF( in_perio >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('periodicity',in_perio)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+         ENDIF
+         
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
+         ENDIF
+         IF( il_ew >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('ew_overlap',il_ew)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+         ENDIF
+
+         ji=1
+         DO WHILE( tl_gatt(ji)%c_name /= '' )
+            CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
+            CALL mpp_add_att(tl_mpphgr,tl_gatt(ji))
+            ji=ji+1
+         ENDDO
+         
+         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ! create mask file
+         !-----------------
+         CALL iom_mpp_create(tl_mppmsk)
+         
+         ! write file
+         CALL iom_mpp_write_file(tl_mppmsk)
+         ! close file
+         CALL iom_mpp_close(tl_mppmsk)
+         
+         ! clean
+         CALL mpp_clean(tl_mppmsk)
+
+         ! create mesh file
+         !-----------------
+         CALL iom_mpp_create(tl_mpphgr)
+         
+         ! write file
+         CALL iom_mpp_write_file(tl_mpphgr)
+         ! close file
+         CALL iom_mpp_close(tl_mpphgr)
+         
+         ! clean
+         CALL mpp_clean(tl_mpphgr)
+
+      CASE(0)
+         ! add some attribute
+         tl_att=att_init("Created_by","SIREN create_meshmask")
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         CALL mpp_add_att(tl_mppzgr, tl_att)
+         
+         cl_date=date_print(date_now())
+         tl_att=att_init("Creation_date",TRIM(cl_date))
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         CALL mpp_add_att(tl_mppzgr, tl_att)
+         
+         ! add attribute periodicity
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
+         ENDIF
+         IF( in_perio >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('periodicity',in_perio)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+            CALL mpp_add_att(tl_mppzgr,tl_att)
+         ENDIF
+ 
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
+         ENDIF
+         IF( il_ew >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('ew_overlap',il_ew)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+            CALL mpp_add_att(tl_mppzgr,tl_att)
+         ENDIF
+
+         ji=1
+         DO WHILE( tl_gatt(ji)%c_name /= '' )
+            CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
+            CALL mpp_add_att(tl_mpphgr,tl_gatt(ji))
+            CALL mpp_add_att(tl_mppzgr,tl_gatt(ji))
+            ji=ji+1
+         ENDDO
+
+         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ! create mask file
+         !-----------------
+         CALL iom_mpp_create(tl_mppmsk)
+ 
+         ! write file
+         CALL iom_mpp_write_file(tl_mppmsk)
+         ! close file
+         CALL iom_mpp_close(tl_mppmsk)
+ 
+         ! clean
+         WRITE(*,*) "CLEAN MSK"
+         CALL mpp_clean(tl_mppmsk)
+
+         ! create mesh_hgr file
+         !-----------------
+         CALL iom_mpp_create(tl_mpphgr)
+ 
+         ! write file
+         CALL iom_mpp_write_file(tl_mpphgr)
+         ! close file
+         CALL iom_mpp_close(tl_mpphgr)
+ 
+         ! clean
+         WRITE(*,*) "CLEAN HGR"
+         CALL mpp_clean(tl_mpphgr)
+
+         ! create mesh_zgr file
+         !-----------------
+         WRITE(*,*) "CREATE ZGR"
+         CALL iom_mpp_create(tl_mppzgr)
+ 
+         ! write file
+         WRITE(*,*) "WRITE ZGR"
+         CALL iom_mpp_write_file(tl_mppzgr)
+         ! close file
+         WRITE(*,*) "CLOSE ZGR"
+         CALL iom_mpp_close(tl_mppzgr)
+ 
+         ! clean
+         WRITE(*,*) "CLEAN ZGR"
+         CALL mpp_clean(tl_mppzgr)
+
+      CASE DEFAULT
+         CALL logger_fatal("CREATE MESHMASK : something wrong with in_msh("//&
+            &  TRIM(fct_str(in_msh))//"), check your namelist.")
+    END SELECT
+
+   ! clean
+   WRITE(*,*) "CLEAN"
+   CALL att_clean(tl_att)
+   CALL att_clean(tl_gatt)
+
+   DEALLOCATE(tl_gatt)
+
+   CALL grid_hgr_clean(ll_domcfg)
+   CALL grid_zgr_clean(ln_sco)
+   IF( ln_zps    ) CALL grid_zgr_zps_clean()
+   IF( ln_sco    ) CALL grid_zgr_sco_clean()
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute land/ocean mask arrays at tracer points, 
+   !>      horizontal velocity points (u & v), vorticity points (f) and 
+   !>      barotropic stream function  points (b). 
+   !>
+   !> @details
+   !>
+   !> ** Method  :   The ocean/land mask is computed from the basin bathymetry in level (mbathy) which is defined or read in dommba.
+   !>      mbathy equals 0 over continental T-point and the number of ocean level over the ocean.
+   !>
+   !>      At a given position (ji,jj,jk) the ocean/land mask is given by:
+   !>      - t-point : 
+   !>             - 0. IF mbathy( ji ,jj) =< 0
+   !>             - 1. IF mbathy( ji ,jj) >= jk
+   !>      - u-point : 
+   !>             - 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
+   !>             - 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
+   !>      - v-point : 
+   !>             - 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
+   !>             - 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
+   !>      - f-point : 
+   !>             - 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) 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.
+   !>      - 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.
+   !>
+   !> @warning do not set the lateral friction through the value of fmask along
+   !>      the coast and topography. 
+   !>
+   !> @note If nperio not equal to 0, the land/ocean mask arrays
+   !>      are defined with the proper value at lateral domain boundaries,
+   !>      but bmask. indeed, bmask defined the domain over which the
+   !>      barotropic stream function is computed. this domain cannot
+   !>      contain identical columns because the matrix associated with
+   !>      the barotropic stream function equation is then no more inverti-
+   !>      ble. therefore bmask is set to 0 along lateral domain boundaries
+   !>      even IF nperio is not zero.
+   !>
+   !>      In case of open boundaries (lk_bdy=T):
+   !>        - tmask is set to 1 on the points to be computed bay the open
+   !>          boundaries routines.
+   !>        - bmask is  set to 0 on the open boundaries.
+   !>
+   !> ** Action :   
+   !>       - tmask    : land/ocean mask at t-point (=0. or 1.)
+   !>       - umask    : land/ocean mask at u-point (=0. or 1.)
+   !>       - vmask    : land/ocean mask at v-point (=0. or 1.)
+   !>       - fmask    : land/ocean mask at f-point (=0. or 1.)
+   !>       - bmask    : land/ocean mask at barotropic stream
+   !>                  function point (=0. or 1.) and set to 0 along lateral boundaries
+   !>       - tmask_i  : interior ocean mask
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from dom_msk
+   !> @date October, 2016
+   !> - do not use anymore special case for ORCA grid
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+   SUBROUTINE create__mask(td_nam,jpi,jpj,jpk,ld_domcfg) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      INTEGER(i4), INTENT(IN) :: jpk
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      ! local variable
+!      INTEGER(i4)  ::   ii0, ii1  ! local integers
+!      INTEGER(i4)  ::   ij0, ij1
+!      INTEGER(i4)  ::   isrow
+
+!      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE ::  imsk
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE ::  zwf
+
+!      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_tpol
+!      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_fpol
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+!      ALLOCATE( imsk(jpi,jpj) )
+
+!      ALLOCATE( dl_tpol(jpi) )
+!      ALLOCATE( dl_fpol(jpi) )
+
+      CALL logger_info('dommsk : ocean mask ')
+      CALL logger_info('~~~~~~')
+      IF    (      rn_shlat == 0.               )THEN ; CALL logger_info('   ocean lateral  free-slip ')
+      ELSEIF(      rn_shlat == 2.               )THEN ; CALL logger_info('   ocean lateral  no-slip ')
+      ELSEIF( 0. < rn_shlat .AND. rn_shlat < 2. )THEN ; CALL logger_info('   ocean lateral  partial-slip ')
+      ELSEIF( 2. < rn_shlat                     )THEN ; CALL logger_info('   ocean lateral  strong-slip ')
+      ELSE ; CALL logger_info(' rn_shlat is negative = '//TRIM(fct_str(rn_shlat)))
+      ENDIF
+
+      ! 1. Ocean/land mask at t-point (computed from mbathy)
+      ! -----------------------------
+      ! N.B. tmask has already the right boundary conditions since mbathy is ok
+      !
+      tg_tmask%d_value(:,:,:,1) = 0._dp
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tg_mbathy%d_value(ji,jj,1,1) - REAL(jk,dp) + 0.1_dp >= 0._dp )THEN
+                  tg_tmask%d_value(ji,jj,jk,1) = 1._dp
+               ENDIF
+            ENDDO  
+         ENDDO  
+      ENDDO  
+      
+      ! (ISF) define barotropic mask and mask the ice shelf point
+      tg_ssmask%d_value(:,:,1,1)=tg_tmask%d_value(:,:,1,1) ! at this stage ice shelf is not masked
+      
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tg_misfdep%d_value(ji,jj,1,1) - REAL(jk,dp) - 0.1_dp >= 0._dp )   THEN
+                  tg_tmask%d_value(ji,jj,jk,1) = 0._dp
+               END IF
+            ENDDO  
+         ENDDO  
+      ENDDO
+
+!      ! Interior domain mask (used for global sum)
+!      ! --------------------
+!      tg_tmask_i%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1)  ! (ISH) tmask_i = 1 even on the ice shelf
+!
+!      tg_tmask_h%d_value(:,:,1,1) = 1._dp          ! 0 on the halo and 1 elsewhere
+!
+!      tg_tmask_h%d_value( 1 , : ,1,1) = 0._dp      ! first columns
+!      tg_tmask_h%d_value(jpi, : ,1,1) = 0._dp      ! last  columns
+!      tg_tmask_h%d_value( : , 1 ,1,1) = 0._dp      ! first rows
+!      tg_tmask_h%d_value( : ,jpj,1,1) = 0._dp      ! last  rows
+!
+!      ! north fold mask
+!      ! ---------------
+!      dl_tpol(1:jpi) = 1._dp 
+!      dl_fpol(1:jpi) = 1._dp
+!      IF( td_nam%i_perio == 3 .OR. td_nam%i_perio == 4 )THEN      ! T-point pivot
+!         dl_tpol(jpi/2+1:jpi) = 0._dp
+!         dl_fpol(   1   :jpi) = 0._dp
+!         IF( mjg(nlej) == jpj ) THEN                  ! only half of the nlcj-1 row
+!            DO ji = iif+1, iil-1
+!               tg_tmask_h%d_value(ji,nlej-1,1,1) = tg_tmask_h%d_value(ji,nlej-1,1,1) * dl_tpol(mig(ji))
+!            END DO
+!         ENDIF
+!      ENDIF
+!
+!      tg_tmask_i%d_value(:,:,1,1) = tg_tmask_i%d_value(:,:,1,1) * tg_tmask_h%d_value(:,:,1,1)
+!
+!      IF( td_nam%i_perio == 5 .OR. td_nam%i_perio == 6 )THEN      ! F-point pivot
+!         dl_tpol(   1   :jpi) = 0._dp
+!         dl_fpol(jpi/2+1:jpi) = 0._dp
+!      ENDIF
+
+      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
+      ! -------------------------------------------
+      DO jk = 1, jpk
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1  ! vector loop
+               tg_umask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji  ,jj  ,jk,1) * &
+                                            & tg_tmask%d_value(ji+1,jj  ,jk,1)
+
+               tg_vmask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji  ,jj  ,jk,1) * &
+                                            & tg_tmask%d_value(ji  ,jj+1,jk,1)
+            !END DO
+            !DO ji = 1, jpi-1  ! NO vector opt.
+               IF( .NOT. ld_domcfg )THEN
+                  tg_fmask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji  ,jj  ,jk,1) * &
+                                               & tg_tmask%d_value(ji+1,jj  ,jk,1) * &
+                                               & tg_tmask%d_value(ji  ,jj+1,jk,1) * &
+                                               & tg_tmask%d_value(ji+1,jj+1,jk,1)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO      
+
+!      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point
+!      DO jj = 1, jpjm1
+!         DO ji = 1, fs_jpim1   ! vector loop
+!            tg_ssumask%d_value(ji,jj,1,1)  = tg_ssmask%d_value(ji  ,jj  ,1,1) * &
+!                                           & tg_ssmask%d_value(ji+1,jj  ,1,1) * &
+!                                           & MIN( 1._wp, SUM(tg_umask%d_value(ji,jj,:,1)) )
+!            tg_ssvmask%d_value(ji,jj,1,1)  = tg_ssmask%d_value(ji  ,jj  ,1,1) * &
+!                                           & tg_ssmask%d_value(ji  ,jj+1,1,1) * &
+!                                           & MIN( 1._wp, SUM(tg_vmask%d_value(ji,jj,:,1)) )
+!         END DO
+!         DO ji = 1, jpim1      ! NO vector opt.
+!            tg_ssfmask%d_value(ji,jj,1,1) =  tg_ssmask%d_value(ji  ,jj  ,1,1) * &
+!                                          &  tg_ssmask%d_value(ji+1,jj  ,1,1) * &
+!                                          &  tg_ssmask%d_value(ji  ,jj+1,1,1) * &
+!                                          &  tg_ssmask%d_value(ji+1,jj+1,1,1) * &
+!                                          &  MIN( 1._wp, SUM(tg_fmask%d_value(ji,jj,:,1)) )
+!         END DO
+!      END DO
+      CALL lbc_lnk( tg_umask%d_value  (:,:,:,1), 'U', td_nam%i_perio, 1._dp )      ! Lateral boundary conditions
+      CALL lbc_lnk( tg_vmask%d_value  (:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+      IF( .NOT. ld_domcfg )THEN
+         CALL lbc_lnk( tg_fmask%d_value  (:,:,:,1), 'F', td_nam%i_perio, 1._dp )
+      ENDIF
+!      CALL lbc_lnk( tg_ssumask%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )      ! Lateral boundary conditions
+!      CALL lbc_lnk( tg_ssvmask%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+!      CALL lbc_lnk( tg_ssfmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )
+
+      ! 3. Ocean/land mask at wu-, wv- and w points 
+      !----------------------------------------------
+!      tg_wmask%d_value (:,:,1,1) = tg_tmask%d_value(:,:,1,1) ! surface
+!      tg_wumask%d_value(:,:,1,1) = tg_umask%d_value(:,:,1,1)
+!      tg_wvmask%d_value(:,:,1,1) = tg_vmask%d_value(:,:,1,1)
+!
+!      DO jk=2,jpk                                            ! interior values
+!         tg_wmask%d_value (:,:,jk,1) = tg_tmask%d_value(:,:,jk  ,1) * &
+!                                     & tg_tmask%d_value(:,:,jk-1,1)
+!         tg_wumask%d_value(:,:,jk,1) = tg_umask%d_value(:,:,jk  ,1) * &
+!                                     & tg_umask%d_value(:,:,jk-1,1)   
+!         tg_wvmask%d_value(:,:,jk,1) = tg_vmask%d_value(:,:,jk  ,1) * &
+!                                     & tg_vmask%d_value(:,:,jk-1,1)
+!      ENDDO
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------     
+      IF( .NOT. ld_domcfg )THEN
+         ALLOCATE( zwf(jpi,jpj) )
+         DO jk = 1, jpk
+            zwf(:,:) = tg_fmask%d_value(:,:,jk,1)         
+            DO jj = 2, jpj-1
+               DO ji = 2, jpi-1   ! vector opt.
+                  IF( tg_fmask%d_value(ji,jj,jk,1) == 0._dp )THEN
+                     tg_fmask%d_value(ji,jj,jk,1) = rn_shlat * &
+                                                  & MIN(1._dp , 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, jpj-1
+               IF( tg_fmask%d_value(1,jj,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(1  ,jj,jk,1) = rn_shlat * &
+                                                & MIN(1._dp, MAX(zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1)))
+               ENDIF
+               IF( tg_fmask%d_value(jpi,jj,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(jpi,jj,jk,1) = rn_shlat * &
+                                                & MIN(1._wp, MAX(zwf(jpi,jj+1), zwf(jpi-1,jj), zwf(jpi,jj-1)))
+               ENDIF
+            END DO         
+            DO ji = 2, jpi-1
+               IF( tg_fmask%d_value(ji,1,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(ji, 1 ,jk,1) = rn_shlat * &
+                                                & MIN(1._dp, MAX(zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1)))
+               ENDIF
+               IF( tg_fmask%d_value(ji,jpj,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(ji,jpj,jk,1) = rn_shlat * &
+                                                & MIN(1._dp, MAX(zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpj-1)))
+               ENDIF
+            END DO
+         END DO
+         DEALLOCATE( zwf )
+
+!      IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 2 )THEN   ! ORCA_R2 configuration
+!         !                                                 ! Increased lateral friction near of some straits
+!         IF( td_nam%i_cla == 0 ) THEN
+!            ! Gibraltar strait  : partial slip (fmask=0.5)
+!            ij0 = 101   ;   ij1 = 101
+!            ii0 = 139   ;   ii1 = 140   
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  0.5_dp
+!
+!            ij0 = 102   ;   ij1 = 102
+!            ii0 = 139   ;   ii1 = 140
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  0.5_dp
+!            !
+!            !Bab el Mandeb : partial slip (fmask=1)
+!            ij0 =  87   ;   ij1 =  88
+!            ii0 = 160   ;   ii1 = 160
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  1._dp
+!
+!            ij0 =  88   ;   ij1 =  88
+!            ii0 = 159   ;   ii1 = 159
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  1._dp
+!            !
+!         ENDIF
+!      ENDIF
+!      !
+!      IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 1 )THEN   ! ORCA R1 configuration
+!         ! Increased lateral friction near of some straits
+!         ! This dirty section will be suppressed by simplification process:
+!         ! all this will come back in input files
+!         ! Currently these hard-wired indices relate to configuration with
+!         ! extend grid (jpjglo=332)
+!         !
+!         isrow = 332 - jpj
+!         ! Gibraltar Strait
+!         ii0 = 282           ;   ii1 = 283 
+!         ij0 = 201 + isrow   ;   ij1 = 241 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp  
+!
+!         ! Bhosporus Strait
+!         ii0 = 314           ;   ii1 = 315
+!         ij0 = 208 + isrow   ;   ij1 = 248 - isrow 
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! Makassar Strait (Top) 
+!         ii0 =  48           ;   ii1 =  48
+!         ij0 = 149 + isrow   ;   ij1 = 190 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp  
+!
+!         ! Lombok Strait
+!         ii0 =  44           ;   ii1 =  44
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! Ombai Strait
+!         ii0 =  53           ;   ii1 =  53
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! Timor Passage
+!         ii0 =  56           ;   ii1 =  56
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! West Halmahera Strait
+!         ii0 =  58           ;   ii1 =  58
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp  
+!
+!         ! East Halmahera Strait
+!         ii0 =  55           ;   ii1 =  55
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp  
+!         !
+!      ENDIF
+      !
+         CALL lbc_lnk( tg_fmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )      ! Lateral boundary conditions on fmask
+      ENDIF
+
+!      DEALLOCATE( imsk )
+
+!      DEALLOCATE( dl_tpol )
+!      DEALLOCATE( dl_fpol )
+      
+   END SUBROUTINE create__mask
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> this function create array of global attributes.
+   !>
+   !> @author J.Paul
+   !> @date October, 2016 - initial release
+   !>
+   !> @param[in] cd_bathy
+   !> @param[in] cd_coord
+   !> @param[in] cd_isfdep
+   !> @param[in] td_namh
+   !> @param[in] td_namz
+   !-------------------------------------------------------------------
+   FUNCTION create__gloatt(cd_bathy,cd_coord,cd_isfdep,td_namh,td_namz) RESULT(td_att)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_bathy 
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_coord 
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_isfdep 
+      TYPE(TNAMH)     , INTENT(IN   ) :: td_namh 
+      TYPE(TNAMZ)     , INTENT(IN   ) :: td_namz 
+
+      ! function
+      TYPE(TATT), DIMENSION(ip_maxatt) :: td_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ji=1    ; td_att(ji)=att_init("src_bathy",TRIM(cd_bathy))
+      ! horizontal grid
+      ji=ji+1 ; td_att(ji)=att_init("in_mshhgr",td_namh%i_mshhgr)
+      SELECT CASE(td_namh%i_mshhgr)
+         CASE(0)
+            ji=ji+1 ; td_att(ji)=att_init("src_coord",TRIM(cd_coord))
+         CASE(1,4)
+            ji=ji+1 ; td_att(ji)=att_init("ppglam0",td_namh%d_ppglam0)
+            ji=ji+1 ; td_att(ji)=att_init("ppgphi0",td_namh%d_ppgphi0)
+         CASE(2,3)
+            ji=ji+1 ; td_att(ji)=att_init("ppglam0",td_namh%d_ppglam0)
+            ji=ji+1 ; td_att(ji)=att_init("ppgphi0",td_namh%d_ppgphi0)
+            ji=ji+1 ; td_att(ji)=att_init("ppe1_deg",td_namh%d_ppe1_deg)
+            ji=ji+1 ; td_att(ji)=att_init("ppe2_deg",td_namh%d_ppe2_deg)
+      END SELECT
+
+      IF( td_namz%l_isfcav )THEN
+         ji=ji+1 ; td_att(ji)=att_init("ice_shelf_cavities","activated")
+         ji=ji+1 ; td_att(ji)=att_init("src_isfdep",TRIM(cd_isfdep))
+      ENDIF
+      IF( td_namz%l_iscpl )THEN
+         ji=ji+1 ; td_att(ji)=att_init("ice_sheet_coupling","activated")
+      ENDIF
+
+      ! vertical grid
+      IF( td_namz%l_zco )THEN
+         ji=ji+1 ; td_att(ji)=att_init("z_coord","full steps")
+      ENDIF
+      IF( td_namz%l_zps )THEN
+         ji=ji+1 ; td_att(ji)=att_init("z_coord","partial steps")
+      ENDIF
+      IF( td_namz%l_sco )THEN
+         IF( td_namz%l_s_sh94 )THEN
+            ji=ji+1 ; td_att(ji)=att_init("z_coord","hybrid Song and Haidvogel 1994")
+         ELSEIF( td_namz%l_s_sf12 )THEN
+            ji=ji+1 ; td_att(ji)=att_init("z_coord","hybrid Siddorn and Furner 2012")
+         ELSE
+            ji=ji+1 ; td_att(ji)=att_init("z_coord","sigma")
+         ENDIF
+      ENDIF
+      ji=ji+1 ; td_att(ji)=att_init("hmin",td_namz%d_hmin)
+      IF( td_namz%l_isfcav ) ji=ji+1 ; td_att(ji)=att_init("isfhmin",td_namz%d_isfhmin)
+
+      ! zco
+      IF( td_namz%d_ppsur /= NF90_FILL_DOUBLE )THEN
+         ji=ji+1 ; td_att(ji)=att_init("ppsur",td_namz%d_ppsur)
+      ELSE
+         ji=ji+1 ; td_att(ji)=att_init("ppsur","to_be_computed")
+      ENDIF
+      IF( td_namz%d_ppa0 /= NF90_FILL_DOUBLE )THEN
+         ji=ji+1 ; td_att(ji)=att_init("ppa0",td_namz%d_ppa0)
+      ELSE
+         ji=ji+1 ; td_att(ji)=att_init("ppa0","to_be_computed")
+      ENDIF
+      IF( td_namz%d_ppa1 /= NF90_FILL_DOUBLE )THEN
+         ji=ji+1 ; td_att(ji)=att_init("ppa1",td_namz%d_ppa1)
+      ELSE
+         ji=ji+1 ; td_att(ji)=att_init("ppa1","to_be_computed")
+      ENDIF
+
+      ji=ji+1 ; td_att(ji)=att_init("ppkth",td_namz%d_ppkth)
+      ji=ji+1 ; td_att(ji)=att_init("ppacr",td_namz%d_ppacr)
+      ji=ji+1 ; td_att(ji)=att_init("ppdzmin",td_namz%d_ppdzmin)
+      ji=ji+1 ; td_att(ji)=att_init("pphmax",td_namz%d_pphmax)
+
+      IF( td_namz%l_dbletanh )THEN
+         ji=ji+1 ; td_att(ji)=att_init("ppa2",td_namz%d_ppa2)
+         ji=ji+1 ; td_att(ji)=att_init("ppkth2",td_namz%d_ppkth2)
+         ji=ji+1 ; td_att(ji)=att_init("ppacr2",td_namz%d_ppacr2)
+      ENDIF
+
+      IF( td_namz%l_zps )THEN
+         ji=ji+1 ; td_att(ji)=att_init("e3zps_min",td_namz%d_e3zps_min)
+         ji=ji+1 ; td_att(ji)=att_init("e3zps_rat",td_namz%d_e3zps_rat)
+      ENDIF
+
+      IF( td_namz%l_sco )THEN
+         ji=ji+1 ; td_att(ji)=att_init("sbot_min",td_namz%d_sbot_min)
+         ji=ji+1 ; td_att(ji)=att_init("sbot_max",td_namz%d_sbot_max)
+         ji=ji+1 ; td_att(ji)=att_init("hc",td_namz%d_hc)
+         IF( td_namz%l_s_sh94 )THEN
+            ji=ji+1 ; td_att(ji)=att_init("rmax",td_namz%d_rmax)
+            ji=ji+1 ; td_att(ji)=att_init("theta",td_namz%d_theta)
+            ji=ji+1 ; td_att(ji)=att_init("thetb",td_namz%d_thetb)
+            ji=ji+1 ; td_att(ji)=att_init("bb",td_namz%d_bb)
+         ELSEIF( td_namz%l_s_sf12 )THEN
+            IF( td_namz%l_sigcrit ) ji=ji+1 ; td_att(ji)=att_init("sigma_below_critical_depth","activated")
+            ji=ji+1 ; td_att(ji)=att_init("alpha",td_namz%d_alpha)
+            ji=ji+1 ; td_att(ji)=att_init("efold",td_namz%d_efold)
+            ji=ji+1 ; td_att(ji)=att_init("zs",td_namz%d_zs)
+            ji=ji+1 ; td_att(ji)=att_init("zb_a",td_namz%d_zb_a)
+            ji=ji+1 ; td_att(ji)=att_init("zb_b",td_namz%d_zb_b)
+         ENDIF
+      ENDIF
+
+      IF( td_namz%l_wd )THEN
+         ji=ji+1 ; td_att(ji)=att_init("wetting_drying","activated")
+      ENDIF
+
+      IF( td_namz%l_wd )THEN
+         ji=ji+1 ; td_att(ji)=att_init("wdmin1",td_namz%d_wdmin1)
+         ji=ji+1 ; td_att(ji)=att_init("wdmin2",td_namz%d_wdmin2)
+         ji=ji+1 ; td_att(ji)=att_init("wdld",td_namz%d_wdld)
+      ENDIF
+      
+   END FUNCTION create__gloatt
+
+END PROGRAM
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/create_restart.f90	(revision 8732)
@@ -0,0 +1,1287 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+!
+! PROGRAM: create_restart
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates restart file.
+!>
+!> @details
+!> @section sec1 method
+!> Variables could be extracted from fine grid file, interpolated from coarse
+!> grid file or restart file. Variables could also be manually written.<br/> 
+!> Then they are split over new layout. 
+!> @note 
+!>    method could be different for each variable.
+!>
+!> @section sec2 how to
+!>    to create restart file:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/create_restart create_restart.nam
+!> @endcode
+!>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_restart.nam contains 9 namelists:<br/>
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - coarse grid namelist (namcrs)
+!>       - fine grid namelist (namfin)
+!>       - vertical grid namelist (namzgr)
+!>       - partial step namelist (namzps)
+!>       - variable namelist (namvar)
+!>       - nesting namelist (namnst)
+!>       - output namelist (namout)
+!>    
+!>    * _logger namelist (namlog)_:<br/>
+!>       - cn_logfile   : log filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!> 'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:<br/>
+!>       - cn_varcfg : variable configuration file
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dimcfg : dimension configuration file. define dimensions allowed
+!> (see ./SIREN/cfg/dimension.cfg).
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _coarse grid namelist (namcrs):<br/>
+!>       - cn_coord0 : coordinate file
+!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
+!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
+!>
+!>    * _fine grid namelist (namfin)_:<br/>
+!>       - cn_coord1 : coordinate file
+!>       - cn_bathy1 : bathymetry file
+!>       - in_perio1 : NEMO periodicity index
+!>
+!>    * _vertical grid namelist (namzgr)_:<br/>
+!>       - dn_ppsur              : coefficient to compute vertical grid
+!>       - dn_ppa0               : coefficient to compute vertical grid
+!>       - dn_ppa1               : coefficient to compute vertical grid
+!>       - dn_ppa2               : double tanh function parameter
+!>       - dn_ppkth              : coefficient to compute vertical grid
+!>       - dn_ppkth2             : double tanh function parameter
+!>       - dn_ppacr              : coefficient to compute vertical grid
+!>       - dn_ppacr2             : double tanh function parameter
+!>       - dn_ppdzmin            : minimum vertical spacing
+!>       - dn_pphmax             : maximum depth
+!>       - in_nlevel             : number of vertical level
+!>
+!>     @note If ppa1 and ppa0 and ppsur are undefined
+!>           NEMO will compute them from ppdzmin , pphmax, ppkth, ppacr
+!>
+!>    * _partial step namelist (namzps)_:<br/>
+!>       - dn_e3zps_min          : minimum thickness of partial step level (meters)
+!>       - dn_e3zps_rat          : minimum thickness ratio of partial step level
+!>
+!>    * _variable namelist (namvar)_:<br/>
+!>       - cn_varfile : list of variable, and associated file<br/> 
+!>          *cn_varfile* is the path and filename of the file where find
+!>          variable.<br/>
+!>          @note 
+!>             *cn_varfile* could be a matrix of value, if you want to filled
+!>             manually variable value.<br/>
+!>             the variable array of value is split into equal subdomain.<br/>
+!>             Each subdomain is filled with the corresponding value 
+!>             of the matrix.<br/>          
+!>             separators used to defined matrix are:
+!>                - ',' for line
+!>                - '/' for row
+!>                - '\' for level<br/>
+!>                Example:<br/>
+!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                         3 & 2 & 3 \\
+!>                                         1 & 4 & 5 \end{array} \right) @f$
+!>
+!>          Examples: 
+!>             - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
+!>             - 'votemper:10\25', 'vozocrtx:gridU.nc'
+!>
+!>             to get all variable from one file:
+!>             - 'all:restart.dimg'
+!>
+!>       - cn_varinfo : list of variable and extra information about request(s) 
+!>       to be used.<br/>
+!>          each elements of *cn_varinfo* is a string character
+!>          (separated by ',').<br/>
+!>          it is composed of the variable name follow by ':', 
+!>          then request(s) to be used on this variable.<br/> 
+!>          request could be:
+!>             - int = interpolation method
+!>             - ext = extrapolation method
+!>             - flt = filter method
+!>             - min = minimum value
+!>             - max = maximum value
+!>             - unt = new units
+!>             - unf = unit scale factor (linked to new units)
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>          informations about available method could be find in @ref interp,
+!>          @ref extrap and @ref filter.<br/>
+!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight',
+!>                   'vosaline: int=cubic'
+!>          @note 
+!>             If you do not specify a method which is required, 
+!>             default one is apply.
+!>
+!>    * _nesting namelist (namnst)_:<br/>
+!>       - in_rhoi  : refinement factor in i-direction
+!>       - in_rhoj  : refinement factor in j-direction
+!>       @note 
+!>          coarse grid indices will be computed from fine grid
+!>          coordinate file.
+!>
+!>    * _output namelist (namout)_:<br/>
+!>       - cn_fileout : output file
+!>       - ln_extrap : extrapolate land point or not
+!>       - in_niproc : number of processor in i-direction
+!>       - in_njproc : number of processor in j-direction
+!>       - in_nproc  : total number of processor to be used
+!>       - cn_type   : output format ('dimg', 'cdf')
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - offset computed considering grid point
+!> - add attributes in output variable
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!>
+!> @todo
+!> - rewrite using meshmask instead of bathymetry and coordinates files
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_restart
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE vgrid                           ! vertical grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_name
+   CHARACTER(LEN=lc)                                  :: cl_data
+   CHARACTER(LEN=lc)                                  :: cl_fileout 
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_attid
+   INTEGER(i4)                                        :: il_nvar
+   INTEGER(i4)                                        :: il_imin1
+   INTEGER(i4)                                        :: il_imax1
+   INTEGER(i4)                                        :: il_jmin1
+   INTEGER(i4)                                        :: il_jmax1
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_index
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+   LOGICAL                                            :: ll_sameGrid
+
+   TYPE(TDOM)                                         :: tl_dom1
+   TYPE(TDOM)                                         :: tl_dom0
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_depth
+   TYPE(TVAR)                                         :: tl_time
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_var
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_bathy1
+   TYPE(TMPP)                                         :: tl_mpp
+   TYPE(TMPP)                                         :: tl_mppout
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jvar
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_restart.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namcrs
+   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namfin
+   CHARACTER(LEN=lc)                       :: cn_coord1 = ''
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = ''
+   INTEGER(i4)                             :: in_perio1 = -1
+
+   !namzgr
+   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
+   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
+   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
+   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
+   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
+   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
+   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp
+   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp
+   REAL(dp)                                :: dn_ppdzmin = 6._dp
+   REAL(dp)                                :: dn_pphmax  = 5750._dp
+   INTEGER(i4)                             :: in_nlevel  = 75
+
+   !namzps
+   REAL(dp)                                :: dn_e3zps_min = 25._dp
+   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi = 0
+   INTEGER(i4)                             :: in_rhoj = 0
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'restart.nc' 
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   INTEGER(i4)                             :: in_nproc   = 0
+   INTEGER(i4)                             :: in_niproc  = 0
+   INTEGER(i4)                             :: in_njproc  = 0
+   CHARACTER(LEN=lc)                       :: cn_type    = ''
+
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg, &      !< variable configuration file
+   &  cn_dimcfg, &      !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namcrs/ &  !< coarse grid namelist
+   &  cn_coord0,  &     !< coordinate file
+   &  in_perio0         !< periodicity index
+
+   NAMELIST /namfin/ &  !< fine grid namelist
+   &  cn_coord1,   &    !< coordinate file
+   &  cn_bathy1,   &    !< bathymetry file
+   &  in_perio1         !< periodicity index
+ 
+   NAMELIST /namzgr/ &
+   &  dn_ppsur,     &
+   &  dn_ppa0,      &
+   &  dn_ppa1,      &
+   &  dn_ppa2,      &
+   &  dn_ppkth,     &
+   &  dn_ppkth2,    &
+   &  dn_ppacr,     &
+   &  dn_ppacr2,    &
+   &  dn_ppdzmin,   &
+   &  dn_pphmax,    &
+   &  in_nlevel         !< number of vertical level
+
+   NAMELIST /namzps/ &
+   &  dn_e3zps_min, &
+   &  dn_e3zps_rat
+
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varfile, &     !< list of variable file
+   &  cn_varinfo        !< list of variable and interpolation method to be used.
+
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,    &     !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /namout/ &  !< output namlist
+   &  cn_fileout, &     !< fine grid bathymetry file
+   &  ln_extrap,  &     !< extrapolate or not
+   &  in_niproc,  &     !< i-direction number of processor
+   &  in_njproc,  &     !< j-direction numebr of processor
+   &  in_nproc,   &     !< number of processor to be used
+   &  cn_type           !< output type format (dimg, cdf)
+   !-------------------------------------------------------------------
+
+   ! namelist
+   ! get namelist
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+   IF( il_narg/=1 )THEN
+      PRINT *,"ERROR in create_restart: need a namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+
+   ! read namelist
+   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"ERROR in create_restart: error opening "//TRIM(cl_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namcrs )
+      READ( il_fileid, NML = namfin )
+      READ( il_fileid, NML = namzgr )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra(cn_varinfo)
+      ! match variable with file
+      tl_multi=multi_init(cn_varfile)
+ 
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE RESTART: closing "//TRIM(cl_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"ERROR in create_restart: can't find "//TRIM(cl_namelist)
+      STOP
+
+   ENDIF
+
+   ! 
+   CALL multi_print(tl_multi)
+   IF( tl_multi%i_nvar <= 0 )THEN
+      CALL logger_fatal("CREATE RESTART: no variable to be used."//&
+      &  " check namelist.")
+   ENDIF
+
+   ! open files
+   IF( cn_coord0 /= '' )THEN
+      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE RESTART: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE RESTART: no fine grid coordinate found. "//&
+      &     "check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("CREATE RESTART: no fine grid bathymetry found. "//&
+      &     "check namelist")
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   IF( in_nproc > 0 )THEN
+      cl_fileout=file_rename(cn_fileout,1)
+   ELSE
+      cl_fileout=file_rename(cn_fileout)
+   ENDIF
+   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE RESTART: output file "//TRIM(cl_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE RESTART: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   ! check domain indices
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
+   &                                 id_rho=il_rho(:))
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   !3-2-4 check coincidence between coarse and fine grid
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )
+
+   ! fine grid ghost cell
+   il_xghost(:,:)=grid_get_ghost(tl_bathy1)
+
+   ! work on variables
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE RESTART: no file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+      ALLOCATE( tl_var( tl_multi%i_nvar ) )
+
+      jvar=0
+      ! for each file
+      DO ji=1,tl_multi%i_nmpp
+         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
+
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_error("CREATE RESTART: no variable to work on for "//&
+            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+         !- use input matrix to fill variable
+
+            WRITE(*,'(a)') "work on data"
+            ! for each variable initialise from matrix
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+               jvar=jvar+1
+
+               WRITE(*,'(2x,a,a)') "work on variable "//&
+               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+               ! fill value with matrix data
+               tl_var(jvar) = create_restart_matrix( &
+               &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, &
+               &  in_nlevel, il_xghost(:,:) )
+
+               ! add ghost cell
+               CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
+
+            ENDDO
+         !- end of use input matrix to fill variable
+         ELSE
+         !- use mpp file to fill variable
+
+            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
+            !
+            tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) )
+            CALL grid_get_info(tl_mpp)
+
+            ! check vertical dimension
+            IF( tl_mpp%t_dim(jp_K)%l_use .AND. &
+            &   tl_mpp%t_dim(jp_K)%i_len /= in_nlevel  )THEN
+               CALL logger_error("CREATE RESTART: dimension in file "//&
+               &  TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ")
+            ENDIF
+
+            ! open mpp file
+            CALL iom_mpp_open(tl_mpp)
+
+            ! get or check depth value
+            CALL create_restart_check_depth( tl_mpp, tl_depth )
+
+            ! get or check time value
+            CALL create_restart_check_time( tl_mpp, tl_time )
+
+            ! close mpp file
+            CALL iom_mpp_close(tl_mpp)
+
+            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.&
+            &   ALL(il_rho(:)==1) )THEN
+            !!! extract value from fine grid 
+
+               IF( ANY( tl_mpp%t_dim(1:2)%i_len < &
+               &        tl_coord1%t_dim(1:2)%i_len) )THEN
+                  CALL logger_fatal("CREATE RESTART: dimensions in file "//&
+                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//&
+                  &  " grid coordinates.")
+               ENDIF
+
+               ! use coord0 instead of mpp for restart file case 
+               !  (without lon,lat)
+               ll_sameGrid=.FALSE.
+               IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) &
+               &   )THEN
+                  ll_sameGrid=.TRUE. 
+               ENDIF
+
+               ! compute domain on fine grid
+               IF( ll_sameGrid )THEN
+                  il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 )
+               ELSE
+                  il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 )
+               ENDIF
+
+               il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2)
+               il_jmin1=il_ind(2,1) ; il_jmax1=il_ind(2,2)
+
+               !- check grid coincidence
+               IF( ll_sameGrid )THEN
+                  il_rho(:)=1
+                  CALL grid_check_coincidence( tl_mpp, tl_coord1, &
+                  &                            il_imin1, il_imax1, &
+                  &                            il_jmin1, il_jmax1, &
+                  &                            il_rho(:) )
+               ELSE
+                  CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+                  &                            il_imin1, il_imax1, &
+                  &                            il_jmin1, il_jmax1, &
+                  &                            il_rho(:) )
+               ENDIF
+
+               ! compute domain
+               tl_dom1=dom_init(tl_mpp,         &
+               &                il_imin1, il_imax1, &
+               &                il_jmin1, il_jmax1)
+               
+               ! open mpp files
+               CALL iom_dom_open(tl_mpp, tl_dom1)
+
+               ! for each variable of this file
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//&
+                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                  jvar=jvar+1
+                  cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
+                  ! read variable over domain
+                  tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom1)
+
+                  ! add attribute to variable
+                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_i_indices',(/il_imin0, il_imax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_j_indices',(/il_jmin0, il_jmax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  ! clean structure
+                  CALL att_clean(tl_att)
+
+                  ! add ghost cell
+                  CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:))
+
+               ENDDO
+
+               ! close mpp file
+               CALL iom_dom_close(tl_mpp)
+
+               ! clean structure
+               CALL mpp_clean(tl_mpp)
+               CALL dom_clean(tl_dom1)
+
+            ELSE
+            !!! get value from coarse grid 
+
+               ! compute domain on coarse grid
+               tl_dom0=dom_init(tl_mpp,             &
+               &                il_imin0, il_imax0, &
+               &                il_jmin0, il_jmax0 )
+
+               ! add extra band (if possible) to compute interpolation
+               CALL dom_add_extra(tl_dom0)
+
+               ! open mpp files
+               CALL iom_dom_open(tl_mpp, tl_dom0)
+               ! for each variable of this file
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//&
+                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                  jvar=jvar+1
+                  cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
+
+                  ! read variable over domain
+                  tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
+
+                  il_offset(:,:)=grid_get_fine_offset(tl_coord0, &
+                  &                                   il_imin0, il_jmin0, &
+                  &                                   il_imax0, il_jmax0, &
+                  &                                   tl_coord1, &
+                  &                                   id_rho=il_rho(:), &
+                  &                                   cd_point=TRIM(tl_var(jvar)%c_point))
+
+                  ! interpolate variable
+                  CALL create_restart_interp(tl_var(jvar), & 
+                  &                          il_rho(:), &
+                  &                          id_offset=il_offset(:,:))
+
+                  ! remove extraband added to domain
+                  CALL dom_del_extra( tl_var(jvar), tl_dom0, il_rho(:) )
+
+                  ! add attribute to variable
+                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_i-indices',(/il_imin0, il_imax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_j-indices',(/il_jmin0, il_jmax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  IF( ANY(il_rho(:)/=1) )THEN
+                     tl_att=att_init("refinment_factor", &
+                     &               (/il_rho(jp_I),il_rho(jp_J)/))
+                     CALL var_move_att(tl_var(jvar), tl_att)
+                  ENDIF
+
+                  ! clean structure
+                  CALL att_clean(tl_att)
+
+                  ! add ghost cell
+                  CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
+               ENDDO
+
+               ! close mpp file
+               CALL iom_dom_close(tl_mpp)
+
+               ! clean structure
+               CALL mpp_clean(tl_mpp)
+               CALL dom_clean(tl_dom0)
+
+            ENDIF
+
+            ! clean structure
+            CALL mpp_clean(tl_mpp)
+         ENDIF
+      ENDDO
+   ENDIF
+
+   il_nvar=tl_multi%i_nvar
+
+   ! clean
+   CALL multi_clean(tl_multi)
+   CALL mpp_clean(tl_coord0)
+
+   IF( .NOT. ln_extrap )THEN
+      ! compute level
+      ALLOCATE(tl_level(ip_npoint))
+      tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
+   ENDIF
+
+   ! clean
+   CALL mpp_clean(tl_bathy1)
+
+   ! use additional request
+   DO jvar=1,il_nvar
+
+      ! change unit and apply factor
+      CALL var_chg_unit(tl_var(jvar))
+
+      ! forced min and max value
+      CALL var_limit_value(tl_var(jvar))
+
+      ! filter
+      CALL filter_fill_value(tl_var(jvar))
+
+      IF( .NOT. ln_extrap )THEN
+         ! use mask
+         CALL create_restart_mask(tl_var(jvar), tl_level(:))
+      ENDIF
+
+   ENDDO
+
+   ! create file
+   IF( in_niproc == 0 .AND. &
+   &   in_njproc == 0 .AND. &
+   &   in_nproc == 0 )THEN
+      in_niproc = 1
+      in_njproc = 1
+      in_nproc = 1
+   ENDIF
+
+   ! add dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,il_nvar
+
+      IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN
+         tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), &
+         &                   in_niproc, in_njproc, in_nproc, &
+         &                   cd_type=cn_type)
+         EXIT
+      ENDIF
+
+   ENDDO
+
+   DO ji=1,ip_maxdim
+
+      IF( tl_dim(ji)%l_use )THEN
+         CALL mpp_move_dim(tl_mppout, tl_dim(ji))
+         SELECT CASE(TRIM(tl_dim(ji)%c_sname))
+         CASE('z','t')
+            DO jj=1,tl_mppout%i_nproc
+               CALL file_add_dim(tl_mppout%t_proc(jj), tl_dim(ji))
+            ENDDO
+         END SELECT 
+      ENDIF
+
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord1)
+
+      ! add longitude
+      tl_lon=iom_mpp_read_var(tl_coord1,'longitude')
+      CALL mpp_add_var(tl_mppout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      tl_lat=iom_mpp_read_var(tl_coord1,'latitude')
+      CALL mpp_add_var(tl_mppout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord1)
+
+   ENDIF
+
+   IF( tl_dim(3)%l_use )THEN
+      IF( ASSOCIATED(tl_depth%d_value) )THEN
+         ! add depth
+         CALL mpp_add_var(tl_mppout, tl_depth)
+      ELSE
+         CALL logger_warn("CREATE RESTART: no value for depth variable.")
+      ENDIF
+   ENDIF
+   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
+
+   IF( tl_dim(4)%l_use )THEN
+      IF( ASSOCIATED(tl_time%d_value) )THEN
+         ! add time
+         CALL mpp_add_var(tl_mppout, tl_time)
+      ELSE
+         CALL logger_warn("CREATE RESTART: no value for time variable.")
+      ENDIF
+   ENDIF
+   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
+
+   ! add other variable
+   DO jvar=il_nvar,1,-1
+      ! check if variable already add
+      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
+      IF( il_index == 0 )THEN
+         CALL mpp_add_var(tl_mppout, tl_var(jvar))
+         CALL var_clean(tl_var(jvar))
+      ENDIF
+   ENDDO
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN create_restart")
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",TRIM(cl_date))
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
+      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_coord1%i_perio)
+      CALL mpp_add_att(tl_mppout,tl_att)
+   ENDIF
+
+   il_attid=0
+   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
+      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_coord1%i_ew)
+      CALL mpp_add_att(tl_mppout,tl_att)
+   ENDIF
+
+   ! print
+   CALL mpp_print(tl_mppout)
+
+   ! create file
+   CALL iom_mpp_create(tl_mppout)
+
+   ! write file
+   CALL iom_mpp_write_file(tl_mppout)
+   ! close file
+   CALL iom_mpp_close(tl_mppout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL var_clean(tl_var(:))
+   DEALLOCATE(tl_var)
+   IF( .NOT. ln_extrap )THEN
+      CALL var_clean(tl_level(:))
+      DEALLOCATE(tl_level)
+   ENDIF
+
+   CALL mpp_clean(tl_mppout)
+   CALL mpp_clean(tl_coord1)
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file.<br/> 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is filled with the associated value of the matrix.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore 
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_coord  coordinate file structure 
+   !> @param[in] id_nlevel number of vertical level  
+   !> @param[in] id_xghost ghost cell array
+   !> @return variable structure 
+   !-------------------------------------------------------------------
+   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)                 , INTENT(IN) :: td_var
+      TYPE(TMPP)                 , INTENT(IN) :: td_coord
+      INTEGER(i4)                , INTENT(IN) :: id_nlevel
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost
+
+      ! function
+      TYPE(TVAR) :: create_restart_matrix
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(3)                    :: il_size
+      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
+
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:3)%i_len
+
+      ! output dimension
+      tl_dim(jp_I:jp_J)=dim_copy(td_coord%t_dim(jp_I:jp_J))
+      IF( id_nlevel >= 1 )THEN
+         tl_dim(jp_K)=dim_init('Z',id_nlevel)
+      ENDIF
+
+      ! remove ghost cell
+      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost
+      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ALLOCATE( il_kshape(il_dim(3)+1) )
+      il_kshape(:)=0
+      DO jk=2,il_dim(3)+1
+         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
+      ENDDO
+      ! add rest to last cell
+      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+
+      DO jk=2,il_dim(3)+1
+         DO jj=2,il_dim(2)+1
+            DO ji=2,il_dim(1)+1
+               
+               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+               &         1+il_jshape(jj-1):il_jshape(jj), &
+               &         1+il_kshape(jk-1):il_kshape(jk), &
+               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! keep attribute and type
+      create_restart_matrix=var_copy(td_var)
+      DEALLOCATE( create_restart_matrix%d_value )
+      ! save new dimension
+      create_restart_matrix%t_dim(:)=dim_copy(tl_dim(:))
+      ! add variable value
+      CALL var_add_value( create_restart_matrix, dl_value(:,:,:,:), &
+      &                   id_type=td_var%i_type)
+
+      DEALLOCATE(dl_value)
+
+      ! clean 
+      DEALLOCATE(il_ishape)
+      DEALLOCATE(il_jshape)
+      DEALLOCATE(il_kshape)
+
+   END FUNCTION create_restart_matrix
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine use mask to filled land point with _FillValue
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_mask   mask variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE create_restart_mask( td_var, td_mask )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)              , INTENT(INOUT) :: td_var
+      TYPE(TVAR), DIMENSION(:), INTENT(IN   ) :: td_mask
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+         IF( ANY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN
+            CALL logger_error("CREATE RESTART MASK: dimension differ between"//&
+            &                 " variable "//TRIM(td_var%c_name)//" ("//&
+            &                 TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
+            &                 TRIM(fct_str(td_var%t_dim(2)%i_len))//&
+            &                 ") and level ("//&
+            &                 TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//&
+            &                 TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")")
+         ELSE
+            ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+            &                 td_var%t_dim(2)%i_len) )
+
+            SELECT CASE(TRIM(td_var%c_point))
+            CASE('T')
+               il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1))
+            CASE('U')
+               il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1))
+            CASE('V')
+               il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1))
+            CASE('F')
+               il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1))
+            END SELECT
+
+            DO jl=1,td_var%t_dim(4)%i_len
+               DO jk=1,td_var%t_dim(3)%i_len
+                  WHERE( il_mask(:,:) < jk )
+                     td_var%d_value(:,:,jk,jl)=td_var%d_fill
+                  END WHERE
+               ENDDO
+            ENDDO
+
+            DEALLOCATE( il_mask )
+         ENDIF
+      ENDIF
+   END SUBROUTINE create_restart_mask
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore (for extrapolation)
+   !>
+   !> @param[inout] td_var    variable structure 
+   !> @param[in] id_rho       array of refinment factor
+   !> @param[in] id_offset    array of offset between fine and coarse grid
+   !> @param[in] id_iext      i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE create_restart_interp( td_var, & 
+   &                                 id_rho,          &
+   &                                 id_offset,       &
+   &                                 id_iext, id_jext)
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      il_iext=3
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=3
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE RESTART INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE RESTART INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate variable
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+   END SUBROUTINE create_restart_interp
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp       mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_restart_check_depth( td_mpp, td_depth )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_depthid
+         IF( ASSOCIATED(td_depth%d_value) )THEN
+
+            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+            IF( ANY( td_depth%d_value(:,:,:,:) /= &
+            &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+               CALL logger_warn("CREATE RESTART: depth value from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_depth)
+
+         ELSE
+            td_depth=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_restart_check_depth
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE create_restart_check_time( td_mpp, td_time )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+
+      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_timeid
+         IF( ASSOCIATED(td_time%d_value) )THEN
+
+            tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+            tl_date1=var_to_date(td_time)
+            tl_date2=var_to_date(tl_time)
+            IF( tl_date1 - tl_date2 /= 0 )THEN
+
+               CALL logger_warn("CREATE BOUNDARY: date from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_time)
+
+         ELSE
+            td_time=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_restart_check_time
+END PROGRAM create_restart
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/date.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/date.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/date.f90	(revision 8732)
@@ -0,0 +1,975 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: date
+!
+! DESCRIPTION:
+!> @brief This module provide the calculation of Julian dates, and
+!> do many manipulations with dates.
+!>
+!> @details
+!> Actually we use Modified Julian Dates, with  
+!> 17 Nov 1858 at 00:00:00 as origin.<br/>
+!>
+!>   define type TDATE:<br/>
+!> @code
+!>   TYPE(TDATE) :: tl_date1
+!> @endcode
+!>   default date is 17 Nov 1858 at 00:00:00<br/>
+!>
+!>   to intialise date : <br/>
+!>   - from date of the day at 12:00:00 : 
+!> @code
+!> tl_date1=date_today()
+!> @endcode
+!>   - from date and time of the day    : 
+!> @code
+!> tl_date1=date_now()
+!> @endcode
+!>   - from julian day                  : 
+!> @code
+!> tl_date1=date_init(dd_jd)
+!> @endcode
+!>      - dd_jd julian day (double precision) 
+!>   - from number of second since julian day origin   : 
+!> @code
+!> tl_date1=date_init(kd_nsec)
+!> @endcode
+!>      - kd_nsec number of second (integer 8) 
+!>   - from year month day              : 
+!> @code
+!> tl_date1=date_init(2012,12,10)
+!> @endcode
+!>   - from string character formatted date  : 
+!> @code
+!> tl_date1=date_init(cd_fmtdate)
+!> @endcode
+!>      - cd_fmtdate date in format YYYY-MM-DD hh:mm:ss
+!>
+!>   to print date in format YYYY-MM-DD hh:mm:ss<br/>
+!>   CHARACTER(LEN=lc) :: cl_date<br/>
+!> @code
+!>   cl_date=date_print(tl_date1)
+!>   PRINT *, TRIM(cl_date)
+!> @endcode
+!>    
+!>   to print date in another format (only year, month, day):
+!> @code
+!>   cl_date=date_print(tl_date1, cd_fmt)
+!>   PRINT *, TRIM(cl_date)
+!> @endcode
+!>       - cd_fmt ouput format (ex: cd_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" ) 
+!>
+!>   to print day of the week:<br/>
+!> @code
+!>   PRINT *,"dow ", tl_date1\%i_dow
+!> @endcode
+!>   to print last day of the month:<br/>
+!> @code
+!>   PRINT *,"last day ", tl_date1\%i_lday
+!> @endcode
+!>
+!>   to know if year is a leap year:<br/>
+!> @code
+!>   ll_isleap=date_leapyear(tl_date1)
+!> @endcode
+!>    - ll_isleap is logical
+!>
+!>   to compute number of days between two dates:<br/>
+!> @code
+!>   tl_date2=date_init(2010,12,10)
+!>   dl_diff=tl_date1-tl_date2
+!> @endcode
+!>    - dl_diff is the number of days between date1 and date2 (double precision)
+!>
+!>   to add or substract nday to a date:<br/>
+!> @code
+!>   tl_date2=tl_date1+2.
+!>   tl_date2=tl_date1-2.6
+!> @endcode
+!>    - number of day (double precision)
+!>
+!>   to print julian day:<br/>
+!> @code
+!>   PRINT *," julian day",tl_date1\%r_jd
+!> @endcode
+!>
+!>   to print CNES julian day (origin 1950-01-01 00:00:00)<br/>
+!> @code
+!>   PRINT *," CNES julian day",tl_date1\%r_jc
+!> @endcode
+!>
+!>   to create pseudo julian day with origin date_now:<br/>
+!> @code
+!>   tl_date1=date_init(2012,12,10,td_dateo=date_now())
+!> @endcode
+!>   @note you erase CNES julian day when doing so<br/> 
+!>
+!>   to print julian day in seconds:<br/>
+!> @code
+!>   PRINT *, tl_date1\%k_jdsec
+!> @endcode
+!>   to print CNES or new julian day in seconds:<br/>
+!> @code
+!>   PRINT *, tl_date1\%k_jcsec
+!> @endcode
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!
+!> @note This module is based on Perderabo's date calculator (ksh)
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!>
+!> @todo
+!> - see calendar.f90 and select Gregorian, NoLeap, or D360 calendar
+!----------------------------------------------------------------------
+MODULE date
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TDATE              !< date structure
+
+   PRIVATE :: cm_fmtdate        !< date and time format
+   PRIVATE :: im_secbyday       !< number of second by day
+
+   ! function and subroutine
+   PUBLIC :: date_today         !< return the date of the day at 12:00:00
+   PUBLIC :: date_now           !< return the date and time
+   PUBLIC :: date_init          !< initialized date structure form julian day or year month day
+   PUBLIC :: date_print         !< print the date with format YYYY-MM-DD hh:mm:ss
+   PUBLIC :: date_leapyear      !< check if year is a leap year
+   PUBLIC :: OPERATOR(-)        !< substract two dates or n days to a date
+   PUBLIC :: OPERATOR(+)        !< add n days to a date
+
+   PRIVATE :: date__init_fmtdate ! initialized date structure from character YYYY-MM-DD hh:mm:ss
+   PRIVATE :: date__init_jd      ! initialized date structure from julian day
+   PRIVATE :: date__init_nsec    ! initialized date structure from number of second since origin of julian day
+   PRIVATE :: date__init_ymd     ! initialized date structure from year month day
+   PRIVATE :: date__addnday      ! add nday to a date
+   PRIVATE :: date__subnday      ! substract nday to a date
+   PRIVATE :: date__diffdate     ! compute number of days between two dates 
+   PRIVATE :: date__lastday      ! compute last day of the month
+   PRIVATE :: date__ymd2jd       ! compute julian day from year month day
+   PRIVATE :: date__jd2ymd       ! compute year month day from julian day 
+   PRIVATE :: date__jc2jd        ! compute julian day from pseudo julian day
+   PRIVATE :: date__jd2jc        ! compute pseudo julian day with new date origin
+   PRIVATE :: date__jd2dow       ! compute the day of week from julian day
+   PRIVATE :: date__hms2jd       ! compute fraction of a day from hour, minute, second
+   PRIVATE :: date__jd2hms       ! compute hour, minute, second from julian fraction
+   PRIVATE :: date__check        ! check date in date structure
+   PRIVATE :: date__adjust       ! adjust date
+   PRIVATE :: date__jd2sec       ! convert julian day in seconds since julian day origin 
+   PRIVATE :: date__sec2jd       ! convert seconds since julian day origin in julian day
+
+   TYPE TDATE !< date structure
+      INTEGER(i4) :: i_year  = 1858   !< year
+      INTEGER(i4) :: i_month = 11     !< month
+      INTEGER(i4) :: i_day   = 17     !< day
+      INTEGER(i4) :: i_hour  = 0      !< hour
+      INTEGER(i4) :: i_min   = 0      !< min
+      INTEGER(i4) :: i_sec   = 0      !< sec
+      INTEGER(i4) :: i_dow   = 0      !< day of week
+      INTEGER(i4) :: i_lday  = 0      !< last day of the month
+      REAL(dp)    :: d_jd = 0         !< julian day (origin : 1858/11/17 00:00:00)
+      REAL(dp)    :: d_jc = 0         !< CNES julian day or pseudo julian day with new date origin    
+      INTEGER(i8) :: k_jdsec  = 0     !< number of seconds since julian day origin
+      INTEGER(i8) :: k_jcsec  = 0     !< number of seconds since CNES or pseudo julian day origin
+   END TYPE TDATE   
+
+   !  module variable   
+   CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = &  !< date and time format
+   &  "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2)"
+
+   INTEGER(i4), PARAMETER :: im_secbyday = 86400    !< number of second by day   
+
+   INTERFACE date_init
+      MODULE PROCEDURE date__init_jd    ! initialized date structure from julian day
+      MODULE PROCEDURE date__init_nsec  ! initialized date structure from number of second since origin of julian day
+      MODULE PROCEDURE date__init_ymd   ! initialized date structure from year month day
+      MODULE PROCEDURE date__init_fmtdate   ! initialized date structure from character YYYY-MM-DD hh:mm:ss
+   END INTERFACE date_init
+
+   INTERFACE OPERATOR(+)
+      MODULE PROCEDURE date__addnday   ! add nday to a date
+   END INTERFACE
+
+   INTERFACE OPERATOR(-)
+      MODULE PROCEDURE date__subnday   ! substract nday to a date
+      MODULE PROCEDURE date__diffdate  ! compute number of day between two dates
+   END INTERFACE
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This function print the date and time with 
+   !> format YYYY/MM/DD hh:mm:ss.
+   !> @details
+   !> Optionally, you could specify output format. However it will be only apply
+   !> to year, month, day.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @param[in] cd_fmt    ouput format (only for year,month,day)
+   !> @return date in format YYYY-MM-DD hh:mm:ss
+   !-------------------------------------------------------------------
+   CHARACTER(LEN=lc) FUNCTION date_print(td_date, cd_fmt)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE)     , INTENT(IN) :: td_date
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_fmt
+      !----------------------------------------------------------------
+
+      IF( PRESENT(cd_fmt) )THEN
+         WRITE(date_print,TRIM(cd_fmt)) &
+         &    td_date%i_year,td_date%i_month,td_date%i_day
+      ELSE
+         WRITE(date_print,cm_fmtdate) &
+         &    td_date%i_year,td_date%i_month,td_date%i_day, &
+         &    td_date%i_hour,td_date%i_min,td_date%i_sec
+      ENDIF
+
+   END FUNCTION date_print
+   !-------------------------------------------------------------------
+   !> @brief This function check if year is a leap year.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @return true if year is leap year
+   !-------------------------------------------------------------------
+   LOGICAL FUNCTION date_leapyear(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+      !----------------------------------------------------------------
+
+      date_leapyear=.false.
+      IF( (MOD(td_date%i_year,100_i4)==0) )THEN
+         IF( (MOD(td_date%i_year,400_i4)==0) )THEN
+            date_leapyear=.true.
+         ENDIF
+      ELSE
+         IF( (MOD(td_date%i_year,4_i4)==0) )THEN
+            date_leapyear=.true.
+         ENDIF
+      ENDIF      
+
+   END FUNCTION date_leapyear
+   !-------------------------------------------------------------------
+   !> @brief This function return the current date and time.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @return current date and time in a date structure
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date_now()
+      IMPLICIT NONE
+      ! local variable
+      INTEGER(sp), DIMENSION(8) :: il_values
+      !----------------------------------------------------------------
+
+      CALL DATE_AND_TIME( values= il_values)
+
+      date_now=date_init( il_values(1), il_values(2), il_values(3), &
+      &                   il_values(5), il_values(6), il_values(7) )
+
+   END FUNCTION date_now
+   !-------------------------------------------------------------------
+   !> @brief This function return the date of the day at 12:00:00.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @return date of the day at 12:00:00 in a date structure
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date_today()
+      IMPLICIT NONE
+      ! local variable
+      INTEGER(sp), DIMENSION(8) :: il_values
+      !----------------------------------------------------------------
+
+      CALL DATE_AND_TIME( values= il_values)
+
+      date_today=date_init( il_values(1), il_values(2), il_values(3), 12_i4 )
+
+   END FUNCTION date_today
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure from a character 
+   !> date with format YYYY-MM-DD hh:mm:ss.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.<br/>
+   !> julian day origin is 17 Nov 1858 at 00:00:00
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_date   date in format YYYY-MM-DD hh:mm:ss
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !> @return date structure
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date__init_fmtdate(cd_datetime, td_dateo)
+      IMPLICIT NONE
+      ! Argument   
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_datetime
+      TYPE(TDATE),      INTENT(IN), OPTIONAL :: td_dateo
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_datetime
+      CHARACTER(LEN=lc) :: cl_date
+      CHARACTER(LEN=lc) :: cl_time
+      CHARACTER(LEN=lc) :: cl_year
+      CHARACTER(LEN=lc) :: cl_month
+      CHARACTER(LEN=lc) :: cl_day
+      CHARACTER(LEN=lc) :: cl_hour
+      CHARACTER(LEN=lc) :: cl_min
+      CHARACTER(LEN=lc) :: cl_sec
+
+      INTEGER(i4) :: il_year
+      INTEGER(i4) :: il_month
+      INTEGER(i4) :: il_day
+      INTEGER(i4) :: il_hour
+      INTEGER(i4) :: il_min
+      INTEGER(i4) :: il_sec
+      !----------------------------------------------------------------
+
+      cl_datetime=TRIM(ADJUSTL(cd_datetime))
+
+      cl_date=fct_split(cl_datetime,1,' ')
+      cl_time=fct_split(cl_datetime,2,' ')
+
+      cl_year = fct_split(cl_date,1,'-')
+      READ(cl_year,*) il_year
+      cl_month= fct_split(cl_date,2,'-')
+      READ(cl_month, *) il_month
+      cl_day  = fct_split(cl_date,3,'-')
+      READ(cl_day, *) il_day
+      cl_hour = fct_split(cl_time,1,':')
+      READ(cl_hour, *) il_hour
+      cl_min  = fct_split(cl_time,2,':')
+      READ(cl_min, *) il_min
+      cl_sec  = fct_split(cl_time,3,':')
+      READ(cl_sec, *) il_sec
+
+      date__init_fmtdate = date_init( il_year, il_month, il_day, il_hour, &
+      &                               il_min, il_sec, td_dateo=td_dateo )
+
+   END FUNCTION date__init_fmtdate
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure from julian day.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.<br/>
+   !> julian day origin is 17 Nov 1858 at 00:00:00
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_jd     julian day
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !
+   !> @return date structure of julian day
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date__init_jd(dd_jd, td_dateo)
+      IMPLICIT NONE
+      !Argument
+      REAL(dp),    INTENT(IN)  :: dd_jd
+      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
+      !----------------------------------------------------------------
+      IF( PRESENT(td_dateo) )THEN
+         CALL date__check(td_dateo)
+
+         ! pseudo julian day with origin dateo
+         date__init_jd%d_jc=dd_jd
+         date__init_jd%k_jcsec=date__jd2sec(dd_jd)
+
+         ! convert to truly julian day
+         CALL date__jc2jd(date__init_jd, td_dateo)
+      ELSE
+         date__init_jd%d_jd=dd_jd
+         date__init_jd%k_jdsec=date__jd2sec(dd_jd)
+
+         ! compute CNES julian day
+         CALL date__jd2jc(date__init_jd)
+      ENDIF
+
+      ! check input data
+      CALL date__check(date__init_jd)
+
+      ! compute year month day hour min sec 
+      CALL date__jd2ymd(date__init_jd)
+
+      ! compute day of the wekk
+      CALL date__jd2dow(date__init_jd)
+
+      !compute last day of the month
+      date__init_jd%i_lday=date__lastday(date__init_jd)
+
+   END FUNCTION date__init_jd
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure from number of 
+   !> second since julian day origin.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] kd_nsec   number of second since julian day origin
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !
+   !> @return date structure of julian day
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date__init_nsec(kd_nsec, td_dateo)
+      IMPLICIT NONE
+      !Argument
+      INTEGER(i8), INTENT(IN)  :: kd_nsec
+      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
+      !----------------------------------------------------------------
+      IF( PRESENT(td_dateo) )THEN
+         date__init_nsec=date_init( date__sec2jd(kd_nsec), td_dateo )
+      ELSE
+         date__init_nsec=date_init( date__sec2jd(kd_nsec) )
+      ENDIF
+
+   END FUNCTION date__init_nsec
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure form year month day
+   !> and optionnaly hour min sec.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] id_year
+   !> @param[in] id_month
+   !> @param[in] id_day
+   !> @param[in] id_hour
+   !> @param[in] id_min
+   !> @param[in] id_sec
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !
+   !> @return date structure of year month day
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date__init_ymd(id_year, id_month, id_day,  &
+   &                                   id_hour, id_min, id_sec, &
+   &                                   td_dateo)
+      IMPLICIT NONE
+      !Argument
+      INTEGER(i4), INTENT(IN) :: id_year
+      INTEGER(i4), INTENT(IN) :: id_month
+      INTEGER(i4), INTENT(IN) :: id_day
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_hour
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_min
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_sec
+      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
+      !----------------------------------------------------------------
+      date__init_ymd%i_year=id_year
+      date__init_ymd%i_month=id_month
+      date__init_ymd%i_day=id_day
+      IF( PRESENT(id_hour) )THEN
+         date__init_ymd%i_hour=id_hour
+      ENDIF
+      IF( PRESENT(id_min) )THEN
+         date__init_ymd%i_min=id_min
+      ENDIF   
+      IF( PRESENT(id_sec) )THEN   
+         date__init_ymd%i_sec=id_sec
+      ENDIF   
+      ! check input data
+      CALL date__check(date__init_ymd)
+
+      ! compute julian day
+      CALL date__ymd2jd(date__init_ymd)
+
+      IF( PRESENT(td_dateo) )THEN
+         CALL date__check(td_dateo)
+         ! compute julian day with origin dateo
+         CALL date__jd2jc(date__init_ymd, td_dateo)         
+      ELSE
+         ! compute CNES julian day
+         CALL date__jd2jc(date__init_ymd)
+      ENDIF      
+
+      ! compute day of the week
+      CALL date__jd2dow(date__init_ymd)
+
+      !compute last day of the month
+      date__init_ymd%i_lday=date__lastday(date__init_ymd)
+
+   END FUNCTION date__init_ymd
+   !-------------------------------------------------------------------
+   !> @brief This function compute number of day between two dates: 
+   !> nday= date1 - date2
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date1  first date strutcutre
+   !> @param[in] td_date2  second date strutcutre
+   !> @return nday
+   !-------------------------------------------------------------------
+   REAL(dp) FUNCTION date__diffdate(td_date1, td_date2)
+      IMPLICIT NONE
+       
+      !Argument
+      TYPE(TDATE), INTENT(IN) :: td_date1
+      TYPE(TDATE), INTENT(IN) :: td_date2
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date1)   
+      CALL date__check(td_date2)   
+
+      date__diffdate = td_date1%d_jd - td_date2%d_jd
+
+   END FUNCTION date__diffdate
+   !-------------------------------------------------------------------
+   !> @brief This function substract nday to a date:
+   !> date2 = date1 - nday
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @param[in] dd_nday   number of day
+   !> @return date strutcutre of date - nday
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date__subnday(td_date, dd_nday)
+      IMPLICIT NONE
+      !Argument
+      TYPE(TDATE), INTENT(IN) :: td_date
+      REAL(dp),    INTENT(IN) :: dd_nday
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date)   
+
+      date__subnday=date__init_jd(td_date%d_jd-dd_nday)
+
+   END FUNCTION date__subnday
+   !-------------------------------------------------------------------
+   !> @brief This function add nday to a date:
+   !> date2 = date1 + nday
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @param[in] dd_nday   number of day
+   !> @return date strutcutre of date + nday
+   !-------------------------------------------------------------------
+   TYPE(TDATE) FUNCTION date__addnday(td_date, dd_nday)
+      IMPLICIT NONE
+      !Argument
+      TYPE(TDATE), INTENT(IN) :: td_date
+      REAL(dp),    INTENT(IN) :: dd_nday
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date)   
+
+      date__addnday=date__init_jd(td_date%d_jd+dd_nday)
+
+   END FUNCTION date__addnday
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute last day of the month
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @return last day of the month
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION date__lastday(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+
+      ! local variable
+      INTEGER, DIMENSION(12), PARAMETER :: il_lastdaytab = &
+      &        (/31,28,31,30,31,30,31,31,30,31,30,31/)
+      !----------------------------------------------------------------
+
+      ! general case
+      IF( td_date%i_month /= 2 )THEN
+         date__lastday=il_lastdaytab(td_date%i_month)
+      ELSE
+         IF( date_leapyear(td_date) )THEN
+            date__lastday=29
+         ELSE
+            date__lastday=il_lastdaytab(td_date%i_month)
+         ENDIF
+      ENDIF
+
+   END FUNCTION date__lastday
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute julian day from year month day , and fill
+   !> input date strutcutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+   SUBROUTINE date__ymd2jd(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+
+      ! local variable
+      REAL(dp) :: dl_standard_jd
+      REAL(dp) :: dl_frac
+      !----------------------------------------------------------------
+
+      dl_standard_jd= td_date%i_day - 32075                               & 
+          & + 1461 * (td_date%i_year + 4800 - (14 - td_date%i_month)/12)/4  &
+          & + 367 * (td_date%i_month - 2 + (14 - td_date%i_month)/12*12)/12 &
+          & - 3 * ((td_date%i_year + 4900 - (14 - td_date%i_month)/12)/100)/4
+      
+      td_date%d_jd = dl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00
+
+      ! compute fraction of day
+      dl_frac=date__hms2jd(td_date)
+
+      td_date%d_jd = td_date%d_jd + dl_frac
+
+      td_date%k_jdsec = date__jd2sec( td_date%d_jd ) 
+
+   END SUBROUTINE date__ymd2jd
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute year month day from julian day, and fill
+   !> input date strutcutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+   SUBROUTINE date__jd2ymd(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+
+      ! local variable
+      INTEGER(i4) :: il_standard_jd
+      INTEGER(i4) :: il_temp1
+      INTEGER(i4) :: il_temp2
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date)   
+
+      il_standard_jd=INT( td_date%d_jd+2400001, i4 )
+
+      il_temp1=il_standard_jd + 68569
+      il_temp2=4*il_temp1/146097
+      il_temp1=il_temp1 - (146097 * il_temp2 + 3) / 4
+      td_date%i_year  = 4000 * (il_temp1 + 1) / 1461001
+      il_temp1 = il_temp1 - 1461 * td_date%i_year/4 + 31
+      td_date%i_month = 80 * il_temp1 / 2447
+      td_date%i_day   = il_temp1 - 2447 * td_date%i_month / 80
+      il_temp1 = td_date%i_month / 11
+      td_date%i_month = td_date%i_month + 2 - 12 * il_temp1
+      td_date%i_year  = 100 * (il_temp2 - 49) + td_date%i_year + il_temp1
+
+      ! compute hour, minute, second from julian fraction
+      CALL date__jd2hms(td_date)
+
+      ! adjust date
+      CALL date__adjust(td_date)
+
+   END SUBROUTINE date__jd2ymd
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute julian day from pseudo julian day 
+   !> with new date origin, and fill input date strutcutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date
+   !> @param[in]    td_dateo  new date origin for pseudo julian day
+   !-------------------------------------------------------------------
+   SUBROUTINE date__jc2jd(td_date, td_dateo)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      TYPE(TDATE), INTENT(IN) :: td_dateo
+
+      ! local variable
+      TYPE(TDATE) :: tl_date
+      REAL(dp)    :: dl_nday
+      !----------------------------------------------------------------
+      ! origin julian day
+      tl_date=date_init(1858,11,17)
+
+      dl_nday=td_dateo-tl_date
+
+      ! compute julian day
+      td_date%d_jd = td_date%d_jc + dl_nday
+      ! compute number of second since julian day origin
+      td_date%k_jdsec = date__jd2sec(td_date%d_jd)
+
+   END SUBROUTINE date__jc2jd
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute pseudo julian day with new date origin, and
+   !> fill input date structure.<br/>
+   !>  default new origin is CNES julian day origin: 1950-01-01 00:00:00
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date
+   !> @param[in] td_dateo     new origin date
+   !-------------------------------------------------------------------
+   SUBROUTINE date__jd2jc(td_date, td_dateo)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      TYPE(TDATE), INTENT(IN),   OPTIONAL :: td_dateo
+
+      ! local variable
+      TYPE(TDATE) :: tl_dateo
+      !----------------------------------------------------------------
+      IF( PRESENT(td_dateo) )THEN
+         td_date%d_jc=td_date%d_jd-td_dateo%d_jd
+      ELSE
+         ! CNES julian day origin
+         tl_dateo%i_year = 1950
+         tl_dateo%i_month = 1
+         tl_dateo%i_day = 1
+
+         CALL date__ymd2jd(tl_dateo)
+
+         td_date%d_jc = td_date%d_jd-tl_dateo%d_jd
+      ENDIF
+
+      td_date%k_jcsec = date__jd2sec(td_date%d_jc)
+
+   END SUBROUTINE date__jd2jc
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute the day of week from julian day, and fill
+   !> input date structure.<br/>
+   !>  days   : Sunday Monday Tuesday Wednesday Thursday Friday Saturday<br/>
+   !>  numday : 0      1      2       3         4        5      6<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+   SUBROUTINE date__jd2dow(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      !----------------------------------------------------------------
+
+      td_date%i_dow=MOD((INT(AINT(td_date%d_jd))+3),7)
+
+   END SUBROUTINE date__jd2dow
+   !-------------------------------------------------------------------
+   !> @brief This function compute fraction of a day from 
+   !> hour, minute, second. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @return fraction of the day
+   !-------------------------------------------------------------------
+   REAL(dp) FUNCTION date__hms2jd(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+      !----------------------------------------------------------------
+
+      !  compute real seconds
+      date__hms2jd = REAL( td_date%i_sec, dp )   
+      !  compute real minutes
+      date__hms2jd = REAL( td_date%i_min, dp ) + date__hms2jd/60.0
+      !  compute real hours
+      date__hms2jd = REAL( td_date%i_hour, dp ) + date__hms2jd/60.0
+      !  julian fraction of a day
+      date__hms2jd = date__hms2jd/24.0
+
+   END FUNCTION date__hms2jd
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute hour, minute, second from julian 
+   !> fraction, and fill date structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+   SUBROUTINE date__jd2hms(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+
+      !local variable
+      REAL(dp) :: dl_fract
+      !----------------------------------------------------------------
+
+      dl_fract=(td_date%d_jd)-AINT(td_date%d_jd)
+      !  compute hour
+      td_date%i_hour = INT( dl_fract * 24.0, i4 )
+      dl_fract = ( dl_fract - REAL( td_date%i_hour, dp ) / 24.0) * 24.0
+      !  compute minute
+      td_date%i_min = INT( dl_fract * 60.0, i4 )
+      dl_fract = ( dl_fract - REAL( td_date%i_min, dp ) / 60.0) * 60.0
+      !  compute second
+      td_date%i_sec = NINT( dl_fract * 60.0, i4 )
+
+   END SUBROUTINE date__jd2hms
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check date express in date structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !-------------------------------------------------------------------
+   SUBROUTINE date__check(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+
+      ! local variable
+      INTEGER(i4)       :: il_lastday
+      INTEGER(i4)       :: il_status
+      CHARACTER(LEN=lc) :: cl_msg
+      !----------------------------------------------------------------
+
+      ! init
+      il_status=0
+
+      ! check year
+      IF( td_date%i_year < 1858_i4 .OR. td_date%i_year > 39999_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "year ",td_date%i_year," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check month
+      IF( td_date%i_month < 1_i4 .OR. td_date%i_month > 12_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "month ",td_date%i_month," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check day
+      il_lastday=date__lastday(td_date)
+      IF( td_date%i_day < 1_i4 .OR. td_date%i_day > il_lastday )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "day ",td_date%i_day," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check hour
+      IF( td_date%i_hour < 0_i4 .OR. td_date%i_hour > 23_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "hour ",td_date%i_hour," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check minutes
+      IF( td_date%i_min < 0_i4 .OR. td_date%i_min > 59_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "minutes ",td_date%i_min," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF   
+      ! check seconds
+      IF( td_date%i_sec < 0_i4 .OR. td_date%i_sec > 59_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "seconds ",td_date%i_sec," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+
+      ! check julian day
+      IF( td_date%d_jd < 0_sp .OR. td_date%d_jd > 782028_sp )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "julian day ",td_date%d_jd," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+
+      IF( il_status/= 0 )THEN
+         WRITE(cl_msg,*) " date error"
+         CALL logger_fatal(cl_msg)
+      ENDIF
+
+   END SUBROUTINE date__check
+   !-------------------------------------------------------------------
+   !> @brief This subroutine adjust date (correct hour, minutes, and seconds
+   !> value if need be)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+   SUBROUTINE date__adjust(td_date)
+      IMPLICIT NONE
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      !----------------------------------------------------------------
+
+      IF( td_date%i_sec == 60 )THEN
+         td_date%i_sec=0
+         td_date%i_min=td_date%i_min+1
+      ENDIF
+      
+      IF( td_date%i_min == 60 )THEN
+         td_date%i_min=0
+         td_date%i_hour=td_date%i_hour+1
+      ENDIF
+
+      IF( td_date%i_hour == 24 )THEN
+         td_date%i_hour=0
+         td_date=date__addnday(td_date,1._dp)
+      ENDIF
+
+   END SUBROUTINE date__adjust
+   !-------------------------------------------------------------------
+   !> @brief This function convert julian day in seconds
+   !> since julian day origin.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_date   date strutcutre
+   !> @return number of seconds since julian day origin
+   !-------------------------------------------------------------------
+   INTEGER(i8) FUNCTION date__jd2sec(dd_jul)
+      IMPLICIT NONE
+      ! Argument   
+      REAL(dp), INTENT(IN) :: dd_jul
+      !----------------------------------------------------------------
+
+      date__jd2sec = NINT( dd_jul * im_secbyday, i8 )
+
+   END FUNCTION date__jd2sec
+   !-------------------------------------------------------------------
+   !> @brief This function convert seconds since julian day origin in 
+   !> julian day.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] kd_nsec   number of second since julian day origin
+   !> @return julian day
+   !-------------------------------------------------------------------
+   REAL(dp) FUNCTION date__sec2jd(kd_nsec)
+      IMPLICIT NONE
+      ! Argument   
+      INTEGER(i8), INTENT(IN) :: kd_nsec
+      !----------------------------------------------------------------
+
+      date__sec2jd = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp )
+
+   END FUNCTION date__sec2jd
+END MODULE date
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/dimension.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/dimension.f90	(revision 8732)
@@ -0,0 +1,1630 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: dim
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage dimension and how to change order of those dimension.
+!>
+!> @details
+!>    define type TDIM:<br/>
+!> @code
+!>    TYPE(TDIM) :: tl_dim
+!> @endcode
+!>
+!>    to initialize a dimension structure:<br/>
+!> @code
+!>    tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname])
+!> @endcode
+!>       - cd_name is the dimension name
+!>       - id_len is the dimension size [optional]
+!>       - ld_uld is true if this dimension is the unlimited one [optional]
+!>       - cd_sname is the dimension short name ('x','y','z','t') [optional]
+!>
+!>    to clean dimension structure:<br/>
+!> @code
+!>    CALL dim_clean(tl_dim)
+!> @endcode
+!>       - tl_dim : dimension strucutre or array of dimension structure
+!>
+!>    to print information about dimension structure:<br/>
+!> @code
+!>    CALL dim_print(tl_dim)
+!> @endcode
+!>
+!>    to copy dimension structure in another one (using different memory cell):<br/>
+!> @code
+!>    tl_dim2=dim_copy(tl_dim1) 
+!> @endcode
+!>
+!>    to get dimension name:<br/>
+!>    - tl_dim\%c_name
+!>
+!>    to get dimension short name:<br/>
+!>    - tl_dim\%c_sname
+!>
+!>    to get dimension length:<br/>
+!>    - tl_dim\%i_len
+!>
+!>    to know if dimension is the unlimited one:<br/>
+!>    - tl_dim\%l_uld
+!>
+!>    to get dimension id (for variable or file dimension):<br/>
+!>    - tl_dim\%i_id 
+!>
+!>    to know if dimension is used (for variable or file dimension):<br/>
+!>    - tl_dim\%l_use
+!>
+!>    Former function or information concern only one dimension. However
+!>    variables as well as files use usually 4 dimensions.<br/>
+!>    To easily work with variable we want they will be all 4D and ordered as
+!>    following: ('x','y','z','t').<br/>
+!>    Functions and subroutines below, allow to reorder dimension of 
+!>    variable.<br/>
+!>    
+!>    Suppose we defined the array of dimension structure below:<br/>
+!> @code
+!>    TYPE(TDIM), DIMENSION(4) :: tl_dim 
+!>    tl_dim(1)=dim_init( 'X', id_len=10)
+!>    tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
+!> @endcode
+!>
+!>    to reorder dimension (default order: ('x','y','z','t')):<br/>
+!> @code
+!>    CALL dim_reorder(tl_dim(:))
+!> @endcode
+!>
+!>    This subroutine filled dimension structure with unused dimension, 
+!>    then switch from "disordered" dimension to "ordered" dimension.<br/>
+!>    The dimension structure return will be:<br/>
+!>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/>
+!>    tl_dim(2) => 'Y', i_len=1,  l_use=F, l_uld=F<br/> 
+!>    tl_dim(3) => 'Z', i_len=1,  l_use=F, l_uld=F<br/>
+!>    tl_dim(4) => 'T', i_len=3,  l_use=T, l_uld=T<br/>
+!>
+!>    After using subroutine dim_reorder you could use functions and subroutine
+!>    below.<br/>
+!>
+!>    to use another dimension order.<br/>
+!> @code
+!>    CALL dim_reorder(tl(dim(:), cl_neworder)
+!> @endcode
+!>    - cl_neworder : character(len=4) (example: 'yxzt')
+!>
+!>    to switch dimension array from ordered dimension to disordered
+!> dimension:<br/>
+!> @code
+!>    CALL dim_disorder(tl_dim(:))
+!> @endcode
+!>
+!>    to fill unused dimension of an array of dimension structure.<br/>
+!> @code
+!>    tl_dimout(:)=dim_fill_unused(tl_dimin(:))
+!> @endcode
+!>    - tl_dimout(:) : 1D array (4elts) of dimension strcuture
+!>    - tl_dimin(:)  : 1D array (<=4elts) of dimension structure
+!>
+!>    to reshape array of value in "ordered" dimension:<br/>
+!> @code
+!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
+!> @endcode
+!>       - value must be a 4D array of real(8) value "disordered"
+!>
+!>    to reshape array of value in "disordered" dimension:<br/>
+!> @code
+!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
+!> @endcode
+!>       - value must be a 4D array of real(8) value "ordered"
+!>
+!>    to reorder a 1D array of 4 elements in "ordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
+!> @endcode
+!>       - tab must be a 1D array with 4 elements "disordered".
+!>       It could be composed of character, integer(4), or logical
+!> 
+!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
+!> @endcode
+!>       - tab must be a 1D array with 4 elements "ordered".
+!>       It could be composed of character, integer(4), or logical
+!>
+!>    to get dimension index from a array of dimension structure, 
+!>    given dimension name or short name :<br/>
+!> @code
+!>    index=dim_get_index( tl_dim(:), [cl_name, cl_sname] )
+!> @endcode
+!>       - tl_dim(:) : array of dimension structure
+!>       - cl_name : dimension name [optional]
+!>       - cl_sname: dimension short name [optional]
+!>
+!>    to get dimension id used in an array of dimension structure, 
+!>    given dimension name or short name :<br/>
+!> @code
+!>    id=dim_get_id( tl_dim(:), [cl_name, cl_sname] )
+!> @endcode
+!>       - tl_dim(:) : array of dimension structure
+!>       - cl_name : dimension name [optional]
+!>       - cl_sname: dimension short name [optional]
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date Spetember, 2015
+!> - manage useless (dummy) dimension
+!> @date October, 2016
+!> - dimension allowed read in configuration file
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE dim
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TDIM              !< dimension structure
+
+   PRIVATE :: cm_dumdim        !< dummy dimension array
+   PRIVATE :: cm_dimX          !< x dimension array
+   PRIVATE :: cm_dimY          !< y dimension array
+   PRIVATE :: cm_dimZ          !< z dimension array
+   PRIVATE :: cm_dimT          !< t dimension array
+
+   ! function and subroutine
+   PUBLIC :: dim_init          !< initialize dimension structure
+   PUBLIC :: dim_clean         !< clean dimension structuree
+   PUBLIC :: dim_print         !< print dimension information
+   PUBLIC :: dim_copy          !< copy dimension structure
+   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension
+   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension
+   PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension 
+   PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t')
+   PUBLIC :: dim_reshape_xyzt2 !< reshape array dimension from ('x','y','z','t')
+   PUBLIC :: dim_reorder_2xyzt !< reorder 1D array to ('x','y','z','t')
+   PUBLIC :: dim_reorder_xyzt2 !< reorder 1D array from ('x','y','z','t')
+   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure
+   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure
+   PUBLIC :: dim_get_dummy     !< fill dummy dimension array
+   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension
+   PUBLIC :: dim_def_extra     !< read dimension configuration file, and save dimension allowed.
+
+   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t')
+   PRIVATE :: dim__reshape_xyzt2_dp ! reshape real(8) 4D array from ('x','y','z','t')
+   PRIVATE :: dim__reorder_2xyzt_i4 ! reorder integer(4) 1D array to ('x','y','z','t')
+   PRIVATE :: dim__reorder_xyzt2_i4 ! reorder integer(4) 1D array from ('x','y','z','t')
+   PRIVATE :: dim__reorder_2xyzt_l  ! reorder logical 1D array to ('x','y','z','t')
+   PRIVATE :: dim__reorder_xyzt2_l  ! reorder logical 1D array from ('x','y','z','t')
+   PRIVATE :: dim__reorder_2xyzt_c  ! reorder string 1D array to ('x','y','z','t')
+   PRIVATE :: dim__reorder_xyzt2_c  ! reorder string 1D array from ('x','y','z','t')
+   PRIVATE :: dim__clean_unit       ! clean one dimension structure
+   PRIVATE :: dim__clean_arr        ! clean a array of dimension structure
+   PRIVATE :: dim__print_unit       ! print information on one dimension structure
+   PRIVATE :: dim__print_arr        ! print information on a array of dimension structure
+   PRIVATE :: dim__copy_unit        ! copy dimension structure
+   PRIVATE :: dim__copy_arr         ! copy array of dimension structure
+   PRIVATE :: dim__is_allowed
+
+   TYPE TDIM !< dimension structure
+      CHARACTER(LEN=lc) :: c_name = ''       !< dimension name
+      CHARACTER(LEN=lc) :: c_sname = 'u'     !< dimension short name
+      INTEGER(i4)       :: i_id  = 0         !< dimension id
+      INTEGER(i4)       :: i_len = 1         !< dimension length
+      LOGICAL           :: l_uld = .FALSE.   !< dimension unlimited or not
+      LOGICAL           :: l_use = .FALSE.   !< dimension used or not
+      INTEGER(i4)       :: i_2xyzt = 0       !< indices to reshape array to ('x','y','z','t')
+      INTEGER(i4)       :: i_xyzt2 = 0       !< indices to reshape array from ('x','y','z','t')
+   END TYPE
+
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim !< dummy dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX   !< x dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY   !< y dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ   !< z dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT   !< t dimension
+
+   INTERFACE dim_print
+      MODULE PROCEDURE dim__print_unit ! print information on one dimension
+      MODULE PROCEDURE dim__print_arr  ! print information on a array of dimension
+   END INTERFACE dim_print
+
+   INTERFACE dim_clean
+      MODULE PROCEDURE dim__clean_unit ! clean one dimension
+      MODULE PROCEDURE dim__clean_arr  ! clean a array of dimension
+   END INTERFACE dim_clean
+
+   INTERFACE dim_copy
+      MODULE PROCEDURE dim__copy_unit  ! copy dimension structure
+      MODULE PROCEDURE dim__copy_arr   ! copy array of dimension structure
+   END INTERFACE
+
+   INTERFACE dim_reshape_2xyzt
+      MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D array to ('x','y','z','t')
+   END INTERFACE dim_reshape_2xyzt
+
+   INTERFACE dim_reshape_xyzt2
+      MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D array from ('x','y','z','t')
+   END INTERFACE dim_reshape_xyzt2
+
+   INTERFACE dim_reorder_2xyzt
+      MODULE PROCEDURE dim__reorder_2xyzt_i4   ! reorder integer(4) 1D array to ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_2xyzt_c    ! reorder string 1D array to ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_2xyzt_l    ! reorder logical 1D array to ('x','y','z','t')
+   END INTERFACE dim_reorder_2xyzt
+
+   INTERFACE dim_reorder_xyzt2
+      MODULE PROCEDURE dim__reorder_xyzt2_i4   ! reorder integer(4) 1D array from ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_xyzt2_c    ! reorder string 1D array from ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_xyzt2_l    ! reorder logical 1D array from ('x','y','z','t')  
+   END INTERFACE dim_reorder_xyzt2
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of dimension structure in another one
+   !> @details 
+   !> see dim__copy_unit
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !
+   !> @param[in] td_dim   array of dimension structure
+   !> @return copy of input array of dimension structure
+   !-------------------------------------------------------------------
+   FUNCTION dim__copy_arr( td_dim )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
+      ! function
+      TYPE(TDIM), DIMENSION(SIZE(td_dim(:))) :: dim__copy_arr
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_dim(:))
+         dim__copy_arr(ji)=dim_copy(td_dim(ji))
+      ENDDO
+
+   END FUNCTION dim__copy_arr
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an dimension structure in another one
+   !> @details 
+   !> dummy function to get the same use for all structure
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_dim   dimension structure
+   !> @return copy of input dimension structure
+   !-------------------------------------------------------------------
+   FUNCTION dim__copy_unit( td_dim )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM), INTENT(IN)  :: td_dim
+      ! function
+      TYPE(TDIM) :: dim__copy_unit
+
+      ! local variable
+      !----------------------------------------------------------------
+
+      dim__copy_unit=td_dim
+
+   END FUNCTION dim__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief This function returns dimension index,
+   !> given dimension name or short name.
+   !>
+   !> @details
+   !> the function check dimension name, in the array of dimension structure.
+   !> dimension could be used or not.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - do not check if dimension used
+   !>
+   !> @param[in] td_dim    array of dimension structure
+   !> @param[in] cd_name   dimension name
+   !> @param[in] cd_sname  dimension short name
+   !> @return dimension index
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION dim_get_index( td_dim, cd_name, cd_sname )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM)      , DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_dim_name
+      CHARACTER(LEN=lc) :: cl_sname
+      CHARACTER(LEN=lc) :: cl_dim_sname
+
+      INTEGER(i4) :: il_ndim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      dim_get_index=0
+
+      il_ndim=SIZE(td_dim(:))
+
+      ! look for dimension name
+      cl_name=fct_lower(cd_name)
+      ! check if dimension is in array of dimension structure
+      jj=0
+      DO ji=1,il_ndim
+         cl_dim_name=fct_lower(td_dim(ji)%c_name)
+         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN
+             dim_get_index=ji
+             EXIT
+         ENDIF
+      ENDDO
+
+      ! look for dimension short name
+      IF(  dim_get_index == 0 )THEN
+
+         cl_sname=fct_lower(cd_name)
+         ! check if dimension is in array of dimension structure
+         jj=0
+         DO ji=1,il_ndim
+            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
+               CALL logger_debug("DIM GET INDEX: variable short name "//&
+               &  TRIM(ADJUSTL(cd_name))//" already in file")
+               dim_get_index=ji
+               EXIT
+            ENDIF
+         ENDDO
+
+      ENDIF
+
+      ! look for dimension short name
+      IF( PRESENT(cd_sname) )THEN
+         IF(  dim_get_index == 0 )THEN
+
+            cl_sname=fct_lower(cd_sname)
+            ! check if dimension is in array of dimension structure
+            jj=0
+            DO ji=1,il_ndim
+               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
+                  CALL logger_debug("DIM GET INDEX: variable short name "//&
+                  &  TRIM(ADJUSTL(cd_sname))//" already in file")
+                  dim_get_index=ji
+                  EXIT
+               ENDIF
+            ENDDO
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION dim_get_index
+   !-------------------------------------------------------------------
+   !> @brief This function returns dimension id, in a array of dimension structure,
+   !> given dimension name, or short name. 
+   !> @note only dimension used are checked.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim    dimension structure
+   !> @param[in] cd_name   dimension name or short name
+   !> @param[in] cd_sname  dimension short name
+   !> @return dimension id
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_dim_name
+      CHARACTER(LEN=lc) :: cl_sname
+      CHARACTER(LEN=lc) :: cl_dim_sname
+
+      INTEGER(i4) :: il_ndim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      dim_get_id=0
+
+      il_ndim=SIZE(td_dim(:))
+
+      ! look for dimension name
+      cl_name=fct_lower(cd_name)
+      ! check if dimension is in array of dimension structure and used
+      jj=0
+      DO ji=1,il_ndim
+         cl_dim_name=fct_lower(td_dim(ji)%c_name)
+         IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. &
+         &   td_dim(ji)%l_use )THEN
+            IF( td_dim(ji)%i_id /= 0 )THEN
+               dim_get_id=td_dim(ji)%i_id
+               EXIT
+            ENDIF
+         ENDIF
+      ENDDO
+
+      ! look for dimension short name
+      IF(  dim_get_id == 0 )THEN
+
+         cl_sname=fct_lower(cd_name)
+         ! check if dimension is in array of dimension structure and used
+         jj=0
+         DO ji=1,il_ndim
+            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
+            &   td_dim(ji)%l_use )THEN
+               IF( td_dim(ji)%i_id /= 0 )THEN
+                  dim_get_id=td_dim(ji)%i_id
+                  EXIT
+               ENDIF
+            ENDIF
+         ENDDO
+
+      ENDIF
+
+      ! look for dimension short name
+      IF( PRESENT(cd_sname) )THEN
+         IF(  dim_get_id == 0 )THEN
+
+            cl_sname=fct_lower(cd_sname)
+            ! check if dimension is in array of dimension structure and used
+            jj=0
+            DO ji=1,il_ndim
+               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
+               &   td_dim(ji)%l_use )THEN
+                  IF( td_dim(ji)%i_id /= 0 )THEN
+                     dim_get_id=td_dim(ji)%i_id
+                     EXIT
+                  ENDIF
+               ENDIF
+            ENDDO
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION dim_get_id
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a dimension structure with given
+   !> name.<br/>
+   !> @details
+   !> Optionally length could be inform, as well as short name and if dimension
+   !> is unlimited or not.<br/>
+   !> By default, define dimension is supposed to be used.
+   !> Optionally you could force a defined dimension to be unused. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - add optional argument to define dimension unused
+   !> @date July, 2015
+   !> - Bug fix: inform order to disorder table instead of disorder to order
+   !> table
+   !
+   !> @param[in] cd_name   dimension name
+   !> @param[in] id_len    dimension length
+   !> @param[in] ld_uld    dimension unlimited
+   !> @param[in] cd_sname  dimension short name
+   !> @param[in] ld_use    dimension use or not
+   !> @return dimension structure
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use )
+      IMPLICIT NONE
+
+      ! Argument 
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_name
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_len
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_sname
+      !----------------------------------------------------------------
+
+      ! clean dimension
+      CALL dim_clean(dim_init)
+
+      cl_name=fct_upper(cd_name)
+
+      CALL logger_debug( &
+      &  " DIM INIT: dimension name: "//TRIM(cl_name) )
+      dim_init%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_len) )THEN
+         CALL logger_debug( &
+         &  " DIM INIT: dimension length: "//fct_str(id_len) )
+         dim_init%i_len=id_len
+      ENDIF
+
+      ! define dimension is supposed to be used
+      IF( PRESENT(ld_use) )THEN
+         dim_init%l_use=ld_use
+      ELSE
+         dim_init%l_use=.TRUE.
+      ENDIF
+
+      IF( PRESENT(cd_sname) )THEN
+
+         cl_sname=fct_lower(cd_sname)
+
+         IF( TRIM(cl_sname) == 'x' .OR. &
+         &   TRIM(cl_sname) == 'y' .OR. & 
+         &   TRIM(cl_sname) == 'z' .OR. & 
+         &   TRIM(cl_sname) == 't' )THEN
+            CALL logger_debug( &
+            &  " DIM INIT: dimension short name: "//TRIM(cd_sname) )
+            dim_init%c_sname=TRIM(cd_sname)
+         ELSE
+            CALL logger_warn("DIM INIT: invalid short name."//&
+            " choose between ('x','y','z','t')")
+         ENDIF
+      ENDIF
+
+      IF( TRIM(fct_lower(dim_init%c_sname)) == 'u' )THEN
+
+         cl_name=fct_lower(cd_name)
+
+         IF(     dim__is_allowed(TRIM(cl_name), cm_dimX(:)) )THEN
+            dim_init%c_sname='x'
+         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:)) )THEN
+            dim_init%c_sname='y'
+         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:)) )THEN
+            dim_init%c_sname='z'
+         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:)) )THEN
+            dim_init%c_sname='t'
+         ELSE
+            CALL logger_warn("DIM INIT: "//TRIM(cd_name)//&
+            " not allowed.")
+         ENDIF
+
+      ENDIF
+
+      IF( PRESENT(ld_uld) )THEN
+         CALL logger_debug( &
+         &  " DIM INIT: unlimited dimension: "//fct_str(ld_uld) )
+         dim_init%l_uld=ld_uld
+      ELSE
+         IF( TRIM(fct_lower(dim_init%c_sname)) =='t'  )THEN
+            dim_init%l_uld=.TRUE.
+         ENDIF
+      ENDIF
+      
+      ! get dimension order indices
+      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
+
+   END FUNCTION dim_init
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print informations of an array of dimension. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE dim__print_arr(td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_dim(:))
+         CALL dim_print(td_dim(ji))
+      ENDDO
+
+   END SUBROUTINE dim__print_arr
+   !-------------------------------------------------------------------
+   !> @brief This subrtoutine print dimension information. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE dim__print_unit(td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), INTENT(IN) :: td_dim
+      !----------------------------------------------------------------
+
+      WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i4),2(a,a),2(a,i1))')   &
+      &        " dimension : ",TRIM(td_dim%c_name),               &
+      &        " short name : ",TRIM(td_dim%c_sname),        &
+      &        " id : ",td_dim%i_id,                         &
+      &        " len : ",td_dim%i_len,                       &
+      &        " use : ",TRIM(fct_str(td_dim%l_use)),        &
+      &        " uld : ",TRIM(fct_str(td_dim%l_uld)),        &
+      &        " xyzt2 : ",td_dim%i_xyzt2,                   &
+      &        " 2xyzt : ",td_dim%i_2xyzt
+
+   END SUBROUTINE dim__print_unit
+   !-------------------------------------------------------------------
+   !> @brief This function fill unused dimension of an array of dimension
+   !> and return a 4 elts array of dimension structure. 
+   !> @details
+   !> output dimensions 'x','y','z' and 't' are all informed.
+   !>
+   !> @note without input array of dimension, return 
+   !> a 4 elts array of dimension structure all unused
+   !> (case variable 0d)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !>
+   !> @param[in] td_dim array of dimension structure
+   !> @return  4elts array of dimension structure
+   !-------------------------------------------------------------------
+   FUNCTION dim_fill_unused(td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
+
+      ! function
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: dim_fill_unused
+
+      ! local variable
+      CHARACTER(LEN=lc)                       :: cl_dimin
+      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index
+      
+      TYPE(TDIM),        DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( PRESENT(td_dim) )THEN
+         tl_dim(1:SIZE(td_dim(:)))=td_dim(:)
+      ENDIF
+      ! concatenate short nem dimension in a character string
+      cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
+      DO ji = 1, ip_maxdim
+
+         ! search missing dimension
+         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
+            ! search first empty dimension (see dim_init)
+            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
+
+            ! put missing dimension instead of empty one
+            tl_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji))
+            ! update output structure
+            tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
+            tl_dim(il_ind(1))%i_xyzt2=ji
+            tl_dim(il_ind(1))%i_len=1
+            tl_dim(il_ind(1))%l_use=.FALSE.
+         ENDIF
+
+      ENDDO
+         
+      ! save result
+      dim_fill_unused(:)=tl_dim(:)
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END FUNCTION dim_fill_unused
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine switch element of an array (4 elts) of dimension 
+   !> structure 
+   !> from disordered dimension to ordered dimension <br/>
+   !>
+   !> @details
+   !> Optionally you could specify dimension order to output
+   !> (default 'xyzt')
+   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
+   !>
+   !> @warning this subroutine change dimension order 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - allow to choose ordered dimension to be output
+   !>
+   !> @param[inout] td_dim    array of dimension structure
+   !> @param[in] cd_dimorder  dimension order to be output 
+   !-------------------------------------------------------------------
+   SUBROUTINE dim_reorder(td_dim, cd_dimorder)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim
+      CHARACTER(LEN=ip_maxdim)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      INTEGER(i4)                             :: il_ind
+
+      CHARACTER(LEN=lc)                       :: cl_dimin
+      CHARACTER(LEN=lc)                       :: cl_dimorder
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER: invalid dimension of array dimension.")
+      ELSE
+
+         cl_dimorder=TRIM(cp_dimorder)
+         IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
+
+         ! add id if dimension used and no id
+         DO ji=1, ip_maxdim
+
+            IF( td_dim(ji)%l_use )THEN
+               IF( td_dim(ji)%i_id == 0 )THEN
+                  td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1
+               ENDIF
+            ELSE
+               td_dim(ji)%i_id=0
+               td_dim(ji)%i_xyzt2=0
+               td_dim(ji)%i_2xyzt=0
+               td_dim(ji)%c_sname='u'
+               td_dim(ji)%c_name=''
+               td_dim(ji)%l_uld=.FALSE.
+            ENDIF
+
+         ENDDO
+
+         ! fill unused dimension
+         tl_dim(:)=dim_fill_unused(td_dim(:))
+         cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
+
+         ! compute input id from output id (xyzt) 
+         DO ji = 1, ip_maxdim
+             
+            il_ind=SCAN(TRIM(cl_dimorder),TRIM(cl_dimin(ji:ji)))
+            IF( il_ind /= 0 )THEN
+               tl_dim(ji)%i_xyzt2=il_ind
+            ENDIF
+            
+         ENDDO
+
+         ! compute output id (xyzt) from input id 
+         DO ji = 1, ip_maxdim
+             
+            il_ind=SCAN(TRIM(cl_dimin),TRIM(cl_dimorder(ji:ji)))
+            IF( il_ind /= 0 )THEN
+               tl_dim(ji)%i_2xyzt=il_ind
+            ENDIF
+            
+         ENDDO
+
+         ! change dimension order to ('x','y','z','t')
+         td_dim(:)%c_name  = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_name)
+         td_dim(:)%c_sname = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_sname)
+         td_dim(:)%i_id    = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_id  )
+         td_dim(:)%i_len   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_len )
+         td_dim(:)%l_uld   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_uld )
+         td_dim(:)%l_use   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_use )
+         td_dim(:)%i_2xyzt = tl_dim(:)%i_2xyzt
+         td_dim(:)%i_xyzt2 = tl_dim(:)%i_xyzt2
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+      ENDIF
+
+   END SUBROUTINE dim_reorder
+   !-------------------------------------------------------------------
+   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
+   !> to disordered dimension. <br/>
+   !> @details
+   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
+   !  This is useful to add dimension in a variable or file.
+   !> @warning this subroutine change dimension order 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_dim array of dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE dim_disorder(td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
+      ELSE      
+         ! add dummy xyzt2 id to unused dimension
+         jj=1
+         DO ji = 1, ip_maxdim
+            IF( .NOT. td_dim(ji)%l_use .AND. td_dim(ji)%i_xyzt2 == 0 )THEN
+               DO WHILE( ANY( td_dim(:)%i_xyzt2 == jj ))
+                  jj=jj+1
+               ENDDO
+               td_dim(ji)%i_xyzt2=jj
+            ENDIF
+         ENDDO
+
+         ! change dimension order from ('x','y','z','t')
+         td_dim(:)%c_name  = dim_reorder_xyzt2(td_dim,td_dim(:)%c_name)
+         td_dim(:)%c_sname = dim_reorder_xyzt2(td_dim,td_dim(:)%c_sname)
+         td_dim(:)%i_id    = dim_reorder_xyzt2(td_dim,td_dim(:)%i_id  )
+         td_dim(:)%i_len   = dim_reorder_xyzt2(td_dim,td_dim(:)%i_len )
+         td_dim(:)%l_uld   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_uld )
+         td_dim(:)%l_use   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_use )
+
+         ! remove dummy xyzt2 id from unused dimension
+         DO ji = 1, ip_maxdim
+            IF( .NOT. td_dim(ji)%l_use )THEN
+               td_dim(ji)%i_id=0
+               td_dim(ji)%i_xyzt2=0
+               td_dim(ji)%c_sname='u'
+               td_dim(ji)%c_name=''
+               td_dim(ji)%l_uld=.FALSE.
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE dim_disorder
+   !-------------------------------------------------------------------
+   !> @brief This function reshape real(8) 4D array   
+   !> to an ordered array, as defined by dim_reorder.<br/>
+   !> @details
+   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
+   !
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @warning output array dimension differ from input array dimension
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim    array of dimension structure
+   !> @param[in] dd_value  array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
+      REAL(dp)  , DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+      
+      ! function
+      REAL(dp), DIMENSION(td_dim(1)%i_len, &
+      &                   td_dim(2)%i_len, &
+      &                   td_dim(3)%i_len, &
+      &                   td_dim(4)%i_len) :: dim__reshape_2xyzt_dp
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(ip_maxdim) :: il_shape
+      CHARACTER(LEN=lc)                       :: cl_dim
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
+            &  "array dimension.")
+      ELSE      
+
+         IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
+
+            CALL logger_fatal( &
+            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
+            &  "   before running RESHAPE" )
+
+         ENDIF
+
+         il_shape=SHAPE(dd_value)
+         ! check input dimension
+         IF( ANY(il_shape(:) /= (/ td_dim(td_dim(1)%i_xyzt2)%i_len, &
+                               &   td_dim(td_dim(2)%i_xyzt2)%i_len, &
+                               &   td_dim(td_dim(3)%i_xyzt2)%i_len, &
+                               &   td_dim(td_dim(4)%i_xyzt2)%i_len /)) )THEN
+
+            DO ji=1,ip_maxdim
+               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//&
+               &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//&
+               &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//&
+               &     TRIM(fct_str(il_shape(ji))) )
+            ENDDO
+            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " )
+
+         ELSE
+
+            ! write some informations
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//&
+            &  TRIM(cl_dim) )
+
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ji)%i_len))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ip_maxdim)%i_len))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//&
+            &  TRIM(cl_dim) )
+
+               ! reorder dimension to x,y,z,t
+               dim__reshape_2xyzt_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),&
+               &                 SHAPE = (/ td_dim(1)%i_len,   &
+               &                            td_dim(2)%i_len,   &
+               &                            td_dim(3)%i_len,   &
+               &                            td_dim(4)%i_len /),&
+               &                 ORDER = (/ td_dim(1)%i_2xyzt,          &
+               &                            td_dim(2)%i_2xyzt,          &
+               &                            td_dim(3)%i_2xyzt,          &
+               &                            td_dim(4)%i_2xyzt        /))      
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION dim__reshape_2xyzt_dp
+   !-------------------------------------------------------------------
+   !> @brief This function reshape ordered real(8) 4D array with dimension 
+   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
+   !> @details
+   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
+   !
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @warning output array dimension differ from input array dimension
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim    array of dimension structure
+   !> @param[in] dd_value  array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value)
+      IMPLICIT NONE
+      
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
+      REAL(dp),   DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+      
+      ! function
+      REAL(dp), DIMENSION(td_dim(td_dim(1)%i_xyzt2)%i_len, &
+      &                   td_dim(td_dim(2)%i_xyzt2)%i_len, &
+      &                   td_dim(td_dim(3)%i_xyzt2)%i_len, &
+      &                   td_dim(td_dim(4)%i_xyzt2)%i_len) :: dim__reshape_xyzt2_dp
+
+      ! local variable
+      INTEGER(i4),      DIMENSION(ip_maxdim) :: il_shape
+      CHARACTER(LEN=lc)                      :: cl_dim
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
+            &  "array dimension.")
+      ELSE
+
+         IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_fatal( &
+            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
+            &  "   before running RESHAPE" )
+
+         ENDIF        
+
+         ! check input dimension
+         il_shape=SHAPE(dd_value)
+         IF( ANY(il_shape(:)/=td_dim(:)%i_len))THEN
+
+            DO ji=1,ip_maxdim
+               CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//&
+               &              TRIM(td_dim(ji)%c_name)//" "//&
+               &              TRIM(fct_str(td_dim(ji)%i_len))//" vs "//&
+               &              TRIM(fct_str(il_shape(ji))) )
+            ENDDO
+            CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ")
+
+         ELSE      
+
+            ! write some informations
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//&
+            &  TRIM(cl_dim) )
+
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//&
+               &      TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//&
+            &      TRIM(fct_str(td_dim(td_dim(ip_maxdim)%i_xyzt2)%i_len))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//&
+            &  TRIM(cl_dim) )
+
+            ! reshape array
+            dim__reshape_xyzt2_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value,  &
+            &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   &
+            &                      td_dim(td_dim(2)%i_xyzt2)%i_len,   &
+            &                      td_dim(td_dim(3)%i_xyzt2)%i_len,   &
+            &                      td_dim(td_dim(4)%i_xyzt2)%i_len /),&
+            &           ORDER = (/        td_dim(1)%i_xyzt2,          &
+            &                             td_dim(2)%i_xyzt2,          &
+            &                             td_dim(3)%i_xyzt2,          &
+            &                             td_dim(4)%i_xyzt2        /))
+
+         ENDIF      
+      ENDIF      
+
+   END FUNCTION dim__reshape_xyzt2_dp
+   !-------------------------------------------------------------------
+   !> @brief  This function reordered integer(4) 1D array to be suitable 
+   !> with dimension ordered as defined in dim_reorder.
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] id_arr array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
+      
+      ! function
+      INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_i4
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            dim__reorder_2xyzt_i4(ji)=id_arr(td_dim(ji)%i_2xyzt)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_2xyzt_i4
+   !-------------------------------------------------------------------
+   !> @brief This function disordered integer(4) 1D array to be suitable with
+   !> initial dimension order (ex: dimension read in file).
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] id_arr array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
+      
+      ! function
+      INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_i4
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
+            &  "array dimension or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            dim__reorder_xyzt2_i4(ji)=id_arr(td_dim(ji)%i_xyzt2)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_xyzt2_i4
+   !-------------------------------------------------------------------
+   !> @brief  This function reordered logical 1D array to be suitable 
+   !> with dimension ordered as defined in dim_reorder.
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] ld_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
+      
+      ! function
+      LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_l
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            dim__reorder_2xyzt_l(ji)=ld_arr(td_dim(ji)%i_2xyzt)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_2xyzt_l
+   !-------------------------------------------------------------------
+   !> @brief This function disordered logical 1D array to be suitable with
+   !> initial dimension order (ex: dimension read in file).
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] ld_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
+      
+      ! function
+      LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_l
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE
+         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
+            &  "  before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            dim__reorder_xyzt2_l(ji)=ld_arr(td_dim(ji)%i_xyzt2)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_xyzt2_l
+   !-------------------------------------------------------------------
+   !> @brief  This function reordered string 1D array to be suitable 
+   !> with dimension ordered as defined in dim_reorder.
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] cd_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
+      
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_c
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
+            &  " before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            dim__reorder_2xyzt_c(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt))
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_2xyzt_c
+   !-------------------------------------------------------------------
+   !> @brief This function disordered string 1D array to be suitable with
+   !> initial dimension order (ex: dimension read in file).
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] cd_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
+      
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_c
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE
+         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
+            CALL logger_error( &
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            dim__reorder_xyzt2_c(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2))
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_xyzt2_c
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean dimension structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim dimension strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE dim__clean_unit( td_dim )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM), INTENT(INOUT) :: td_dim
+
+      ! local variable
+      TYPE(TDIM) :: tl_dim ! empty dimension strucutre
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) )
+
+      ! replace by empty structure
+      td_dim=tl_dim
+
+   END SUBROUTINE dim__clean_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean array of dimension structure
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE dim__clean_arr( td_dim )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_dim(:))
+         CALL dim_clean(td_dim(ji))
+      ENDDO
+
+   END SUBROUTINE dim__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy dimension array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE dim_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumdim(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+
+         il_fileid=fct_getunit()
+
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+
+         READ( il_fileid, NML = namdum )
+         cm_dumdim(:)=cn_dumdim(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+
+   END SUBROUTINE dim_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if dimension is defined as dummy dimension
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_dim dimension structure
+   !> @return true if dimension is dummy dimension 
+   !-------------------------------------------------------------------
+   FUNCTION dim_is_dummy(td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), INTENT(IN) :: td_dim
+      
+      ! function
+      LOGICAL :: dim_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      dim_is_dummy=.FALSE.
+      DO ji=1,ip_maxdumcfg
+         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN
+            dim_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION dim_is_dummy
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read dimension configuration file, 
+   !> and fill array of dimension allowed.
+   !>
+   !> @author J.Paul
+   !> @date Ocotber, 2016 - Initial Version
+   !
+   !> @param[in] cd_file input file (dimension configuration file)
+   !-------------------------------------------------------------------
+   SUBROUTINE dim_def_extra( cd_file )
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+      
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimX = '' 
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimY = ''
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimZ = ''
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimT = ''
+
+      !----------------------------------------------------------------
+      NAMELIST /namdim/ &   !< dimension namelist
+      &  cn_dimX, &       !< x dimension name allowed
+      &  cn_dimY, &       !< y dimension name allowed
+      &  cn_dimZ, &       !< z dimension name allowed
+      &  cn_dimT          !< t dimension name allowed
+
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dimX(:)=''
+      cm_dimY(:)=''
+      cm_dimZ(:)=''
+      cm_dimT(:)=''
+
+      ! read config variable file
+      INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist)
+      IF( ll_exist )THEN
+
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_file), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_file))
+         ENDIF
+   
+         READ( il_fileid, NML = namdim )
+         cm_dimX(:)=cn_dimX(:)
+         cm_dimY(:)=cn_dimY(:)
+         cm_dimZ(:)=cn_dimZ(:)
+         cm_dimT(:)=cn_dimT(:)
+
+         CLOSE( il_fileid )
+
+      ELSE
+
+         CALL logger_fatal("DIM DEF EXTRA: can't find configuration"//&
+            &              " file "//TRIM(cd_file))
+
+      ENDIF         
+
+   END SUBROUTINE dim_def_extra
+   !-------------------------------------------------------------------
+   !> @brief This function check if dimension is allowed, i.e defined 
+   !> in dimension configuraton file
+   !>
+   !> @author J.Paul
+   !> @date OCTOber, 2016 - Initial Version
+   !
+   !> @param[in] cd_name dimension name
+   !> @param[in] cd_dim  array dimension name allowed
+   !> @return true if dimension is allowed 
+   !-------------------------------------------------------------------
+   FUNCTION dim__is_allowed(cd_name, cd_dim)
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_dim
+      
+      ! function
+      LOGICAL :: dim__is_allowed
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      dim__is_allowed=.FALSE.
+      ji=1
+      DO WHILE( TRIM(cd_dim(ji)) /= '' )
+         IF( TRIM(fct_lower(cd_name)) == TRIM(fct_lower(cd_dim(ji))) )THEN
+            dim__is_allowed=.TRUE.
+            EXIT
+         ENDIF
+         ji=ji+1
+      ENDDO
+
+   END FUNCTION dim__is_allowed
+
+END MODULE dim
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md	(revision 8732)
@@ -0,0 +1,27 @@
+# Download
+
+# Download NEMO #
+to install SIREN, you should first download NEMO.
+see [NEMO quick start guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide)
+
+# Compile SIREN #
+when NEMO is installed, you just have to compile SIREN codes:
+   1. go to ./NEMOGCM/TOOLS
+   2. run maketools (ex: ./maketools -n SIREN -m ifort_mpi_beaufix)
+
+      @note to get help on maketools: ./maketools -h
+
+# Fortran Compiler #
+SIREN codes were succesfully tested with :
+  - ifort (version 15.0.1)
+  - gfortran (version 4.8.2 20140120) 
+
+<HR>
+  <b>
+  - @ref index
+  - @ref md_src_docsrc_2_quickstart
+  - @ref md_src_docsrc_3_support_bug
+  - @ref md_src_docsrc_4_codingRules
+  - @ref md_src_docsrc_5_changeLog
+  - @ref todo
+  </b>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md	(revision 8732)
@@ -0,0 +1,734 @@
+# How To Use (Quick Start)
+
+@tableofcontents
+
+SIREN is a software to set up regional configuration with
+ [NEMO](http://www.nemo-ocean.eu).<br/> 
+Actually SIREN creates all the input files you need to run a NEMO regional configuration.<br/>
+ 
+SIREN is composed of a set of 6 Fortran programs :
+<ul>
+ <li>create_coord.f90 to create regional grid coordinates.</li>
+ <li>create_bathy.f90 to create regional grid bathymetry.</li>
+ <li>merge_bathy.f90 to merge regional grid bathymetry with wider grid bathymetry
+ at boundaries. 
+ @note the goal of this step is to avoid break in Bathymetry.
+ This break may cause inconsistency between forcing fields  at boundary and regional fields.
+ </li>
+ <li>create_meshmask.f90 to create meshmask or domain_cfg file(s) which contain(s) all the ocean domain informations.</li>
+ <li>create_restart.f90 to create initial state file from coarse grid restart
+ or standard outputs.
+ @note this program could also be used to refined other input fields from a wider
+ configuations (as runoff, chlorophyll etc...)
+ </li>
+ <li>create_boundary.F90 to create boundaries conditions from wider configurations
+ output fields.
+ </li>
+</ul>
+
+@warning SIREN can not:
+<ul>
+<li>create global configuration.</li>
+<li>create configuarion around or close to North pole.</li>
+<li>change number of vertical level.</li>
+</ul>
+
+Here after we briefly describe how to use each programs,
+and so how to create your own regional configuration.
+@note As demonstrator for a first start a set of GLORYS files (global reanalysis on *ORCA025* grid), as well as examples of namelists are available [here](https://cloud.mercator-ocean.fr/public.php?service=files&t=acf44730538cdda0da548ffc5f99fb55).
+
+<!-- ######################################################################  -->
+# Create coordinates file # {#coord}
+
+To create your own configuration, you first have to create a coordinates file on your domain of study.<br/>
+SIREN allows you to create this coordinates file from a wider coordinates file.<br/>
+The coordinates file created could simply be an extraction, or a refinment of
+the wide grid.<br/>
+
+To create this new cooridnates file, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_coord.exe create_coord.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_coord.exe*.<br/>
+In this example, you create a coordinates file named *coord_fine.nc*.<br/>
+This new coordinates file is refined from an extraction of *coordinates_ORCA025.nc*. 
+~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namvar
+/
+
+&namnst
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+
+   in_rhoi = 2
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/coord_fine.nc"
+/
+~~~~~~~~~~~
+
+Let's get describe this namelist.<br/>
+First we have the **namlog** sub-namelist. This sub-namelist set parameters of the log
+file.<br/>
+All the parameters of this sub-namelist have default value, so you could let it
+empty, as done here.<br/> This will create a log file named *create_coord.log*
+
+The **namcfg** sub-namelist defines where found SIREN configuration files.<br/>
+- The variable configuration file defines standard name, default interpolation method,
+axis,... to be used for some known variables.<br/>
+Obviously, you could add other variables to those already list, in this file.
+- The dimension configuration file defines dimensions allowed.
+
+@note You could find the generic version of those configuration files in the directory *NEMOGCM/TOOLS/SIREN/cfg*.
+
+The **namcrs** sub-namelist set parameters of the wide
+coordinates file, as path to find it, and NEMO periodicity of the wide grid.<br/>
+
+@note the NEMO periodicity could be choose between 0 to 6:
+<dl>
+<dt>in_perio=0</dt>
+<dd>standard regional model</dd>
+<dt>in_perio=1</dt>
+<dd>east-west cyclic model</dd>
+<dt>in_perio=2</dt>
+<dd>model with symmetric boundary condition across the equator</dd>
+<dt>in_perio=3</dt>
+<dd>regional model with North fold boundary and T-point pivot</dd>
+<dt>in_perio=4</dt>
+<dd>global model with a T-point pivot.<br/>
+example: ORCA2, ORCA025, ORCA12</dd>
+<dt>in_perio=5</dt>
+<dd>regional model with North fold boundary and F-point pivot</dd>
+<dt>in_perio=6</dt>
+<dd>global model with a F-point pivot<br/>
+example: ORCA05</dd>
+</dl>
+@sa For more information see @ref md_src_docsrc_6_perio
+</dd>
+</dl>
+
+The **namvar** sub-namelist lists variables to be used.<br/>
+By default all the variables of the wider coordinates file are used to create
+the new coordinates file.<br/> 
+The interpolation methods to be used are defined in the configuration variables file (see
+below). So you do not need to fill this sub-namelist too.
+
+The **namnst** sub-namelist defines the subdomain to be used as well as refinment factor.<br/>
+@note Subdomain is defined by indices of the coarse/wide grid.<br/>
+
+<ul>
+<li>you can select area quite every where (excepted too close from the North
+pole), and use the refinment factor you want.</li>
+
+~~~~~~~~~~~
+&namvar
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+
+   in_rhoi = 2
+   in_rhoj = 3
+/
+~~~~~~~~~~~
+@image html grid_zoom_60.png
+<center>@image latex grid_zoom_40.png
+</center>
+<!-- @note ghost cells all around the grid are not shown here. -->
+
+<li>you can select area crossing the east-west overlap of the global ORCA grid.</li>
+
+~~~~~~~~~~~
+&namvar          
+   in_imin0 = 1402 
+   in_imax0 = 62
+   in_jmin0 = 490 
+   in_jmax0 = 570 
+
+   in_rhoi = 5
+   in_rhoj = 5 
+/                
+~~~~~~~~~~~
+@image html grid_glob_over_30.png
+<center>@image latex grid_glob_over_20.png
+</center>
+<!-- @note in blue, the east-west overlap band of ORCA grid. -->
+
+<li>you can select east-west cyclic area.</li>
+
+~~~~~~~~~~~
+&namvar
+   in_imin0 = 0
+   in_imax0 = 0
+   in_jmin0 = 390
+   in_jmax0 = 450
+
+   in_rhoi = 1
+   in_rhoj = 1
+/
+~~~~~~~~~~~
+@image html grid_glob_band_30.png
+<center>@image latex grid_glob_band_20.png
+</center>
+
+</ul>
+
+Finally the **namout** sub-namelist defines the output file.<br/>
+
+@note All the output files created by SIREN include information about NEMO
+periodicity, as well as source file, indices and refinment used.
+
+@sa For more information about how to create coordinates, see create_coord.f90
+
+<!-- ######################################################################  -->
+# Create bathymetry file # {#bathy}
+
+Then you need a Bathymetry file.<br/>
+SIREN allows you to create a Bathymetry extracted or refined from a wider
+Bathymetry grid.<br/>
+
+To create this new bathymetry, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_bathy.exe create_bathy.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_bathy.exe*.<br/>
+In this example, you create a bathymetry file named *bathy_fine.nc*.<br/>
+This new bathymetry file is refined from an extraction of *bathy_meter_ORCA025.nc*.<br/>
+Moreover a minimum value of 5m is imposed to the output Bathymetry.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_coord1 = "PATH/coord_fine.nc"
+/
+
+&namvar
+   cn_varfile = "Bathymetry:PATH/bathy_meter_ORCA025.nc"
+   cn_varinfo = "Bathymetry: min=5"
+/
+
+&namnst
+   in_rhoi = 2
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/bathy_fine.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+Let's get describe this namelist.<br/>
+
+First as previously, we have the **namlog** and **namcfg** sub-namelist (see above for more
+explanation).<br/>
+
+Then the **namcrs** sub-namelist set parameters of the wide
+coordinates file.<br/>
+@note in all SIREN namelist: <br/>
+**0** referred to the coarse/wide grid.<br/>
+**1** referred to the fine grid.
+
+In the same way, the **namfin** sub-namelist  set parameters of the fine
+coordinates file.<br/>
+@note in this namelist example, there is no need to set the variable *in_perio1* to define the NEMO
+periodicity of the fine grid. Indeed, if this variable is not inform, SIREN tries to read it 
+in the global attributes of the file. So if you created the fine coordinates with SIREN, you do not have to
+fill it. In other case, you should add it to the namelist.
+
+The **namvar** sub-namelist lists variables to be used:
+<dl>
+   <dt>cn_varfile</dt>
+      <dd> defines the variable name ("Bathymetry" here) and the input file associated with.
+            @warning The domain of the input Bathymetry have to be larger than the output domain.
+         @note 
+         <ul>
+            <li>if the input file is at coarse grid resolution (same than *cn_coord0*), the ouptut Bathymetry will be refined on fine grid.</li>
+            <li>if the input file is a wider bathymetry (already at fine grid resolution), the output Bathymetry will be extracted from this one.</li>
+         </ul>
+      </dd>
+   <dt>cn_varinfo</dt>
+      <dd> defines user's requests for a variable.
+         @note Default interpolation method for the Bathymetry, is *cubic* interpolation.<br/>
+         So you may want to specify a minimum value to avoid negative value, or to change interpolation method.<br/>
+         example: <ul><li>cn_varinfo="Bathymetry: min=1"'</li>
+                      <li>cn_varinfo="Bathymetry: int=linear"</li></ul>
+      </dd>
+</dl>
+
+The **namnst** sub-namelist defines the subdomain refinment factor.<br/>
+Of course those refinment factors have to be convenient with refinment
+from coarse grid *cn_coord0* to fine grid *cn_coord1*.
+@note subdomain indices are automatically deduced from fine and coarse grid
+coordinates.
+
+Finally, this **namout** sub-namelist defines the output file.<br/>
+
+@note All the output files create by SIREN include information about 
+source file, indices, refinment and interpolation method used.
+
+@sa For more information about how to create bathymetry, see
+create_bathy.f90
+
+<!-- ######################################################################  -->
+# Merge bathymetry file # {#merge}
+
+The Bathymetry you build, may differ from the wider one.<br/>
+To avoid issue with boundaries forcing fields, you should merge fine and coarse Bathymetry on boundaries.<br/>
+SIREN allows you to do this.<br/>
+
+To create this merged bathymetry, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/merge_bathy.exe merge_bathy.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *merge_bathy.exe*.<br/>
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namcrs
+   cn_bathy0 = "PATH/bathy_meter_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_bathy1 = "PATH/bathy_fine.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&nambdy
+/
+
+&namout
+   cn_fileout = "PATH/bathy_merged.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+In this namelist, you find again the **namlog**, **namcfg** describe above.
+
+Then the **namcrs** sub-namelist sets parameters of the wider grid.
+However this time, this is the coarse/wide grid Bathymetry wich have to be informed.
+
+The **namfin** sub-namelist defines parameters of the fine grid Bathymetry.
+@note here again you could add the *in_perio1* parameter if need be i.e. if your
+fine grid Bathymetry was not created by SIREN.
+
+The **namnst** sub-namelist defines the subdomain refinment factor.
+
+
+The **nambdy** sub-namelist defines the subdomain boundaries.<br/>
+By default SIREN tries to create boundaries for each side. Boundary exist if there is at least one sea point on the second row of each side. So you could let this namelist empty.
+@sa For more information about boundaries, see @ref boundary
+
+Finally, this **namout** sub-namelist defines the output file.<br/>
+
+@sa For more information about how to merge bathymetry, see
+merge_bathy.f90
+
+<!-- ######################################################################  -->
+# Create meshmask (ocean domain informations) # {#meshmask}
+
+
+Depending on the vertical grid you choose to use, NEMO may not see the bathymetry exactly as you defined it just before. To get the ocean domain informations as seen by NEMO, SIREN allows you to create the meshmask file(s) which contain(s) all those informations.<br/>
+Morevoer SIREN allows you to create the *domain_cfg* file which is the new input file for NEMO (release 3.7 and upper).<br/>
+
+To create the meshmask file(s), you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_meshmask.exe create_meshmask.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_meshmask.exe*.<br/>
+In this example, you create one meshmask file named *mesh_mask.nc*.<br/>
+It uses coordinates file *coord_fine.nc* to define horizontal grid.
+and defines z-coordinate with partial steps.
+The minimum depth of the final Bathymetry is 10m. 
+~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namin
+   cn_bathy = "PATH/bathy_merged.nc"
+   cn_coord = "PATH/coord_fine.nc"
+   in_perio = 4
+/
+
+&namhgr
+   in_mshhgr = 0
+/
+
+&namzgr
+   ln_zps   = .TRUE.
+   in_nlevel= 75
+/
+
+&namdmin
+   dn_hmin=10.
+/
+
+&namzco
+   dn_ppsur   = -3958.951371276829
+   dn_ppa0    =   103.953009600000
+   dn_ppa1    =     2.415951269000
+   dn_ppkth   =    15.351013700000
+   dn_ppacr   =     7.000000000000
+   dn_ppdzmin = 6.
+   dn_pphmax  = 5750.
+   ln_dbletanh= .TRUE.
+   dn_ppa2    =   100.760928500000
+   dn_ppkth2  =    48.029893720000
+   dn_ppacr2  =    13.000000000000
+/
+
+&namzps
+   dn_e3zps_min = 25.
+   dn_e3zps_rat = 0.2
+/
+
+&namsco
+/
+
+&namlbc
+/
+
+&namwd
+/
+
+&namgrd
+/
+
+&namout
+   in_msh = 1
+/
+~~~~~~~~~~~
+
+Let's get describe this namelist more accurately.<br/>
+
+As previously, we have the **namlog** and **namcfg** describe above.<br/>
+
+The **namin** sub-namelist defines the Bathymetry to be used.
+Mainly SIREN need Bathymetry to create meshmask.
+Here we also read coordinates directly on a file. 
+@note 
+ 1. here again you could add the *in_perio* parameter if need be i.e. if your
+Bathymetry was not created by SIREN.
+ 2. by default SIREN suppress closed sea/lake from the ORCA domain.
+
+
+The **namhgr** sub-namelist defines the horizontal grid.
+the type of horizontal mesh is choose between :<ul>
+<li> in_mshhgr=0 : curvilinear coordinate on the sphere read in coordinate.nc</li>
+<li> in_mshhgr=1 : geographical mesh on the sphere with regular grid-spacing</li>
+<li> in_mshhgr=2 : f-plane with regular grid-spacing</li>
+<li> in_mshhgr=3 : beta-plane with regular grid-spacing</li>
+<li> in_mshhgr=4 : Mercator grid with T/U point at the equator</li>
+<li> in_mshhgr=5 : beta-plane with regular grid-spacing and rotated domain (GYRE configuration)</li>
+</ul>
+
+The **namzgr** sub-namelist allows to choose the type of vertical grid (z-coordinate full steps, partial steps, sigma or hybrid coordinates) and the number of level.
+
+The **namdmin** sub-namelist defines the minimum ocean depth. It could be defines in meter (>0) or in number of level (<0).
+
+The **namzco** sub-namelist defines parameters to compute z-coordinate vertical grid (**needed for all type of vertical grid**)
+<!-- By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/> -->
+
+The **namzps** sub-namelist defines extra parameters needed to define z-coordinates partial steps.
+
+The **namsco** sub-namelist defines extra parameters needed to define sigma or hybrid coordinates (not needed here).
+
+<!--The **namcla** sub-namelist defines cross land advection for exchanges through some straits only used for ORCA2 (see namgrd).-->
+
+The **namlbc** sub-namelist defines lateral boundary conditions at the coast. It is needed to modify the fmask.
+
+The **namwd** sub-namelist defines the wetting and drying parameters if activated (see namzgr sub-namelist)
+
+The **namgrd** sub-namelist allows to use configuration 1D or to choose vertical scale factors (e3.=dk or old definition).
+
+Finally, this **namout** sub-namelist defines the number output file(s).<br/>
+@note To create the domain_cfg file, you should put **in_msh=0**.
+
+@sa For more information about how to create meshmask, see create_meshmask.f90
+
+<!-- ######################################################################  -->
+# Create initial state # {#restart}
+
+To run your configuration you need an inital state of the ocean.<br/>
+You could start from a restart file (with all NEMO variables fields at one
+time step). Or you could start from "partial" information about ocean state (Temperature and Salinity for example).
+
+SIREN allows you to create both of those initial state.<br/>
+To create the initial state, you have to run:<br/>
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_restart.exe create_restart.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_restart.exe*.<br/>
+In this example, you create an initial state split on 81 "processors", and named restart_out.nc.<br/>
+The initial state is composed of temperature and salinity refined from an extraction of GLORYS fields.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_coord1 = "PATH/coord_fine.nc"
+   cn_bathy1 = "PATH/bathy_merged.nc"
+/
+
+&namzgr
+/
+
+&namzps
+/
+
+&namvar
+   cn_varfile = "votemper:GLORYS_gridT.nc",
+                "vosaline:GLORYS_gridS.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/restart_out.nc"      
+   in_nproc = 81
+/
+~~~~~~~~~~~~~~~~~~
+Let's get describe this namelist more accurately.<br/>
+
+As previously, we have the **namlog** and **namcfg** sub-namelists, as well as 
+the **namcrs** sub-namelist to set parameters of the wide coordinates file (see above for more
+explanation).<br/>
+
+Then the **namfin** sub-namelist set parameters of the fine
+grid coordinates and bathymetry.<br/>
+
+The **namzgr** and **namzps** sub-namelists define respectively parameters for vertical grid
+and partial step.<br>
+By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/>
+So you could let it empty.
+@note If you use forcing fields other than GLORYS, you have to be sure it uses the same vertical grid. In other case, you need to get information about the parametrisation use, and to put it in those sub-namelist (see create_restart.f90).
+
+the **namvar** sub-namelist lists variables to be used.<br/>
+Here we use *votemper* (temperature) get from *GLORYS_gridT.nc* file, and *vosaline*
+(salinity) get from *GLORYS_gridS.nc* file.
+@note To get all variables of a restart file. You have to use:
+~~~~~~~~~~~~~~~~~~
+cn_varfile = "all:PATH/restart.dimg"
+~~~~~~~~~~~~~~~~~~
+
+The **namnst** sub-namelist defines the subdomain refinment factor, as seen previously.<br/>
+
+Finally, this **namout** sub-namelist defines the output files.<br/>
+Here we ask for output on 81 processors, with *restart_out.nc* as file "basename".<br/>
+So SIREN computes the optimal layout for 81 processors
+available,<br/>
+and split restart on output files named *restart_out_num.nc*, where *num* is the proc number.
+
+@note SIREN could also create the other fields you may need for
+your configuration.<br/>
+To do so, you just have to run *create_restart.exe* with other variable(s) from other input file(s).<br/>
+For example, to get runoff fields, you could use:
+~~~~~~~~~~~~~~~~~~
+cn_varfile = "sorunoff:PATH/runoff_GLORYS.nc"
+...
+cn_fileout = "PATH/runoff_out.nc"
+~~~~~~~~~~~~~~~~~~
+
+@sa For more information about how to create initial state or other fields, see
+create_restart.f90
+
+<!-- ######################################################################  -->
+# Create boundaries conditions # {#boundary}
+
+Finally to force your configuration, you may need boundaries conditions.<br/>
+NEMO read physical boundaries conditions from temperature, salinity, currents, and sea
+surface height.
+
+To create the boundaries condition with SIREN, you have to run:<br/>
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_boundary.exe create_boundary.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_boundary.exe*.<br/>
+In this example, you create boundaries conditions named *boundary_out.nc* on
+each side of the domain.<br/>
+The boundaries contain information about temperature, salinity, currents and sea surface height refined from an extraction of GLORYS fields.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namcrs
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namfin
+   cn_coord1 = "PATH/coord_fine.nc"
+   cn_bathy1 = "PATH/bathy_fine.nc"
+/
+
+&namzgr
+/
+
+&namzps
+/
+
+&namvar
+   cn_varfile="votemper:GLORYS_gridT.nc",
+              "vosaline:GLORYS_gridS.nc",
+              "vozocrtx:GLORYS_gridU.nc",
+              "vomecrty:GLORYS_gridV.nc",
+              "sossheig:GLORYS_grid2D.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&nambdy
+/
+
+&namout
+   cn_fileout = "PATH/boundary_out.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+Let's get describe this namelist more accurately.<br/>
+
+As previously, we have the **namlog** and **namcfg** sub-namelists, as well as 
+the **namcrs** sub-namelist to set parameters of the wide coordinates file (see above for more
+explanation).<br/>
+
+Then the **namfin** sub-namelist set parameters of the fine
+grid coordinates and bathymetry.<br/>
+
+The **namzgr** and **namzps** sub-namelists define respectively parameters for vertical grid
+and partial step.<br>
+By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/>
+So you could let it empty.
+@note If you use forcing fields other than GLORYS, you have to be sure it uses the same vertical grid. In other case, you need to get information about the parametrisation use, and to put it in those sub-namelist (see create_boundary.F90).
+
+the **namvar** sub-namelist lists variables to be used.<br/>
+Here we get *votemper* (temperature) from *GLORYS_gridT.nc* file, *vosaline*
+(salinity) from *GLORYS_gridS.nc* file, *vozocrtx* (zonal velocity) from
+*GLORYS_gridU.nc*, *vomecrty* (meridional velocity) from *GLORYS_gridV.nc*, and sossheig (sea surface
+height) from *GLORYS_grid2D.nc*.
+
+The **namnst** sub-namelist defines the subdomain refinment factor.<br/>
+
+The **nambdy** sub-namelist defines the subdomain boundaries.<br/>
+By default SIREN tries to create boundaries for each side (Boundary is created if sea point exist on the second row of each side).<br/>
+So you could let this namelist empty.
+
+@note SIREN allows you to place boundaries away from the side of the domain.
+To do so you have to define your boundary.<br/>
+That means you have to give on fine
+grid the index of the boundary (how far from the border your boundary is),
+the width of your boundary, and finally first and last point of your boundary (the length of your boundary).<br/>
+So to define a north boundary, you have to add in the sub-namelist *nambdy*, the parameter:
+~~~~~~~~~~~~~~~~~~
+cn_north="index,first:last(width)"
+~~~~~~~~~~~~~~~~~~
+
+Finally, this **namout** sub-namelist defines the output files.<br/>
+Here we ask for output with *boundary_out.nc* as file "basename".<br/>
+So SIREN creates output files named *boundary_out_west.nc*,
+*boundary_out_east.nc*, *boundary_out_north.nc*, and *boundary_out_south.nc*
+depending if boundary exist or not.
+
+@sa For more information about how to create boundaries condition, see
+create_boundary.F90
+
+# Create and run NEMO configuration # {#NEMOconf}
+
+So now you created all the input files you need for your physical configuration, you have to create the "NEMO configuration".<br/>
+To do so, go to the directory *NEMOGCM/CONFIG/*, and run:
+~~~~~~~~~~~~~~~~~~
+./makenemo -n MY_CONFIG -d "OPA_SRC"
+~~~~~~~~~~~~~~~~~~
+This creates your configuration "MY_CONFIG" in the directory *NEMOGCM/CONFIG*.<br/>
+you could check the cpp_keys used in file *cpp_MY_CONFIG.fcm*, and re-run *makenemo*
+if need be.
+
+Once *makenemo* has run successfully, the *opa* executable is available in
+directory *NEMOGCM/CONFIG/MY_CONFIG/EXP00*.<br/>
+Then you just have to put all your input files in this directory, fill the namelist *namelist_cfg*, and run:
+~~~~~~~~~~~~~~~~~~
+mpirun ./opa
+~~~~~~~~~~~~~~~~~~
+
+@note no surface forcing here.
+weighted function needed to do interpolation on the fly, could be created by WEIGHT tools already inside NEMO.
+
+@sa For more information about how to create NEMO configuration see [NEMO Quick Start Guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide).
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/3_support_bug.md
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/3_support_bug.md	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/3_support_bug.md	(revision 8732)
@@ -0,0 +1,28 @@
+# Support
+
+# How to get support
+  If you have questions regarding the use of SIREN, please have a look at the [NEMO configuration manager forum](https://forge.ipsl.jussieu.fr/nemo/discussion/forum/2).<br/>
+  If you don't find an answer in the archives, feel free to register and post your question.
+
+# How to Help
+   The development of SIREN highly depends on your input!<br/>
+   If you are trying SIREN let me know what you think of it (do you miss certain features?). Even if you decide not to use it, please let me know why.
+
+# How to report a bug
+   If you believe you have found a new bug, please report it.<br/>
+   Before submitting a new bug, first search through the database if the same bug has already been submitted by others
+
+   If you send only a (vague) description of a bug, you are usually not very
+   helpful and it will cost much more time to figure out what you mean. In
+   the worst-case your bug report may even be completely ignored.
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md	(revision 8732)
@@ -0,0 +1,100 @@
+# Coding Rules
+
+The conventions used in SIREN coding are based on the NEMO coding rules
+(see [NEMO coding
+conventions](http://www.nemo-ocean.eu/content/download/15483/73221/file/NEMO_coding.conv_v3.pdf)).<br/>
+However some modifications were added to improve readibility of the code.<br/>
+Some of the NEMO coding rules are reminded here, and extensions are described.
+
+@tableofcontents
+
+# Fortran Standard {#std}
+
+SIREN software adhere to strict __FORTRAN 95__ standard.<br/>
+There is only one exception. The use of functions _COMMAND_ARGUMENT_COUNT_ and
+_GET_COMMAND_ARGUMENT_.<br/>
+There exist no equivalent for those Fortran 03 intrinsec functions in Fortran
+95.<br/> At least none convenient for compilers tested (see @ref md_src_docsrc_1_install). 
+
+#  Free Form Source {#free}
+Free Form Source will be used, however a self imposed limit of 80 should
+enhance readibility.
+
+#  Indentation {#indent}
+Code as well as comments lines will be indented 3 characters for readibility.<br/>
+__Indentation should be write without hard tabs__.
+
+Example for vi  :
+~~~~~~~~~~~~~~~~~~~~~
+:set expandtab tabstop=3 shiftwidth=3
+~~~~~~~~~~~~~~~~~~~~~
+
+#  Naming conventions : variable {#namvar}
+All variables should be named as explicitly as possible.<br/>
+The naming conventions concerns prefix letters of these name, in order to
+identify the variable type and status.<br/> It must be composed of two
+letters defining type and status follow by an underscore.<br/>
+table below list the starting letters to be used for variable naming,
+depending on their type and status.
+
+ | Type / Status     | byte (integer(1)) <br/> __b__ | short (integer(2)) <br/> __s__ | integer(4) <br/> __i__  | integer(8) <br/> __k__ | real(4) <br/> __r__ | real(8) <br/> __d__ | logical <br/> __l__ | character <br/> __c__ | complex <br/> __y__ | structure <br/> __t__  |
+ | :----:            | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: |
+ |global <br/> __g__           | bg_  | sg_  | ig_  | kg_  | rg_  | dg_  | lg_  | cg_  | yg_  | tg_  |
+ |global parameter <br/> __p__ | bp_  | sp_  | ip_  | kp_  | rp_  | dp_  | lp_  | cp_  | yp_  | tp_  |
+ |module <br/> __m__           | bm_  | sm_  | im_  | km_  | rm_  | dm_  | lm_  | cm_  | ym_  | tm_  |
+ |namelist <br/> __n__         | bn_  | sn_  | in_  | kn_  | rn_  | dn_  | ln_  | cn_  | yn_  | tn_  |
+ |dummy argument <br/> __d__   | bd_  | sd_  | id_  | kd_  | rd_  | dd_  | ld_  | cd_  | yd_  | td_  |
+ |local <br/> __l__            | bl_  | sl_  | il_  | kl_  | rl_  | dl_  | ll_  | cl_  | yl_  | tl_  |
+ |loop control       |      |      | j?   |      |      |      |      |      |      |      |
+
+# Naming conventions : structure {#namstr}
+The structure name should be written in capital letter, and start with
+__T__<br/> Example: TTRACER <br/>
+Variables inside the structure should be named as explicitly as possible.<br/>
+For those variables, the prefix naming conventions only concern the type of variable.<br/>
+It must be composed of one letter defining type follows by an
+underscore.<br/>
+see table of variable conventions.<br/>
+
+Example: __tl\_type\%i\_year__<br/> _year_ is an integer(4) variable in a local strucure
+named _type_. <br/>
+
+# Naming conventions : function-subroutine {#namsub}
+Functions or Subroutines are defined in a module.<br/>
+Their name should start with the module name then with their "functional" name. So it will be
+easy to find it.<br/>
+Example:<br/> a function to realise addition written in a module
+__math__ should be called __math\_add__.<br/>
+
+__PUBLIC__  function or subroutine should used one undescrore: _math_add_<br/>
+__PRIVATE__ function or subroutine should used two undescrores: _math__add_<br/>
+
+# Precision {#precision}
+__All variables should make use of kinds__.<br/>
+Numerical constant need to have a suffix of __kindvalue__
+
+# Declaration for global variable and constants {#global}
+All global data must be accompanied with a comment field on the same
+line.<br/>
+_Note that using doxygen (see [header](#header)), we will use symbol !< instead of !: as separator_
+
+# Implicit none {#implicit}
+All subroutines and functions will include an IMPLICIT NONE statement.
+
+# Header {#header}
+
+SIREN use __doxigen auto documentation__ tool.<br/>
+Information could be find on
+[doxygen](http://www.stack.nl/~dimitri/doxygen/index.html) web page.<br/>
+Some basic tag are described
+[here](http://www.msg.chem.iastate.edu/gamess/DoxygenRules.oct10.pdf).
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md	(revision 8732)
@@ -0,0 +1,39 @@
+# Change log
+
+@tableofcontents
+
+# Release $Date:: 2016-11-16 #$ ($Revision: 7235 $)
+
+## New Features
+- create_meshmask.f90 program to create meshmask from coordinates and bathymetry files.
+- create_meshmask.f90 allows to write domain_cfg file.
+- merge_bathy.f90: allow to choose the number of boundary point with coarse grid value.
+- dimension.f90: dimension allowed read in configuration file.
+- variable.f90: allow to add scalar value.
+- create_meshmask.f90: choose vertical scale factors (e3.=dk[depth] or old definition).
+## Changes
+- create_coord.f90: allow to define sub domain with coarse grid indices or coordinates.
+- grid.f90:grid__get_closest_str: add function to get closest grid point using coarse grid coordinates strucutre.
+- iom_cdf.f90:iom_cdf__get_info: define cdf4 as cdf.
+- variable.f90: add subroutine to clean global array of extra information, and define logical for variable to be used.
+- create_coord.f90: dimension to be used select from configuration file.
+- create_bathy.f90: dimension to be used select from configuration file.
+- merge_bathy.f90: dimension to be used select from configuration file.
+- create_boundary.f90: dimension to be used select from configuration file.
+- create_restart.f90: dimension to be used select from configuration file.
+## Bug fixes
+- boundary.f90:boundary_check: take into account that boundaries are compute on T point, but expressed on U,V point.
+- grid.f90:grid__get_closest_str: use max of zero and east-west overlap instead of east-west overlap.
+- mpp.f90: compare index to td_lay number of proc instead of td_mpp (bug fix) .
+
+# Initial Release 2016-03-17
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref todo
+   </b>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/6_perio.md
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/6_perio.md	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/6_perio.md	(revision 8732)
@@ -0,0 +1,41 @@
+# NEMO periodicity
+
+NEMO periodicity is defined as follow :<br/> 
+<dl>
+<dt>closed boundary (in_perio=0)</dt>
+<dd>ghost cells (solid walls) are imposed at all model boundaries.</dd> 
+@image html perio0_20.png 
+<center>@image latex perio0_20.png 
+</center>
+<dt>cyclic east-west boundary (in_perio=1)</dt>
+<dd>first and last rows are closed, whilst the first column is set to the value of the last-but-one column and the last column to the value of the second one.</dd>  
+@image html perio1_20.png 
+<center>@image latex perio1_20.png 
+</center>
+<dt>symmetric boundary condition across the equator. (in_perio=2)</dt>
+<dd>last row, and first and last columns are closed. </dd> 
+@image html perio2_20.png 
+<center>@image latex perio2_20.png 
+</center>
+<dt>North fold boundary with a T -point pivot (in_perio=3)</dt>
+<dd>first row, and first and last columns are closed. </dd> 
+@image html perio3_20.png 
+<center>@image latex perio3_20.png 
+</center>
+<dt>North fold boundary with a T -point pivot and cyclic east-west boundary (in_perio=4)</dt>
+<dd>first row is closed. The first column is set to the value of the last-but-one column and the last column to the value of the second one. </dd> 
+@image html perio4_20.png 
+<center>@image latex perio4_20.png 
+</center>
+<dt>North fold boundary with a F -point pivot (in_perio=5)</dt>
+<dd>first row, and first and last columns are closed. </dd> 
+@image html perio5_20.png 
+<center>@image latex perio5_20.png 
+</center>
+<dt>North fold boundary with a F -point pivot and cyclic east-west boundary (in_perio=6)</dt>
+<dd>first row is closed. The first column is set to the value of the last-but-one column and the last column to the value of the second one.</dd> 
+@image html perio6_20.png 
+<center>@image latex perio6_20.png 
+</center>
+</dl>
+@sa For more information about NEMO periodicity, see _Model Boundary Condition_ chapter in [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox	(revision 8732)
@@ -0,0 +1,29 @@
+/*!
+ @mainpage About 
+
+ SIREN is a software to set up regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/> 
+ Actually SIREN creates the input files you need to run a NEMO regional configuration.<br/>
+ 
+ SIREN allows you to create your own regional configuration embedded in a wider one.<br/>
+
+ To know how to install SIREN see @ref md_src_docsrc_1_install.
+
+ You could find a tutorial for a quick start with SIREN in @ref md_src_docsrc_2_quickstart.<br/>
+ For more information about how to use each component of SIREN
+ - see create_coord.f90 to create fine grid coordinate file
+ - see create_bathy.f90 to create fine grid bathymetry
+ - see merge_bathy.f90 to merge fine grid bathymetry
+ - see create_meshmask.f90 to create mesh mask or domain_cfg file.
+ - see create_restart.f90 to create initial state file, or other fields.
+ - see create_boundary.F90 to create boundary condition
+
+<HR>
+   <b>
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
+*/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/domain.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/domain.f90	(revision 8732)
@@ -0,0 +1,1750 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: dom
+!
+! DESCRIPTION:
+!> @brief
+!> This module manage domain computation.
+!>
+!> @details
+!>    define type TDOM:<br/>
+!> @code
+!>    TYPE(TDOM) :: tl_dom
+!> @endcode
+!>
+!>    to initialize domain structure:<br/>
+!> @code
+!>    tl_dom=dom_init(td_mpp, [id_imin,] [id_imax,] [id_jmin,] [id_jmax],[cd_card])
+!> @endcode
+!>       - td_mpp  is mpp structure of an opened file.
+!>       - id_imin is i-direction sub-domain lower left  point indice
+!>       - id_imax is i-direction sub-domain upper right point indice 
+!>       - id_jmin is j-direction sub-domain lower left  point indice
+!>       - id_jmax is j-direction sub-domain upper right point indice
+!>       - cd_card is the cardinal name (for boundary case) 
+!> 
+!>    to get global domain dimension:<br/>
+!>    - tl_dom\%t_dim0
+!>
+!>    to get NEMO periodicity index of global domain:<br/>
+!>    - tl_dom\%i_perio0
+!>
+!>    to get NEMO pivot point index F(0),T(1):<br/>
+!>    - tl_dom\%i_pivot
+!>
+!>    to get East-West overlap of global domain:<br/>
+!>    - tl_dom\%i_ew0
+!>
+!>    to get selected sub domain dimension:<br/>
+!>    - tl_dom\%t_dim
+!>
+!>    to get NEMO periodicity index of sub domain:<br/>
+!>    - tl_dom\%i_perio
+!>
+!>    to get East-West overlap of sub domain:<br/>
+!>    - tl_dom\%i_ew
+!>
+!>    to get i-direction sub-domain lower left  point indice:<br/>
+!>    - tl_dom\%i_imin
+!>
+!>    to get i-direction sub-domain upper right point indice:<br/>
+!>    - tl_dom\%i_imax
+!>
+!>    to get j-direction sub-domain lower left  point indice:<br/>
+!>    - tl_dom\%i_jmin
+!>
+!>    to get j-direction sub-domain upper right point indice:<br/>
+!>    - tl_dom\%i_jmax
+!>
+!>    to get size of i-direction extra band:<br/>
+!>    - tl_dom\%i_iextra
+!>
+!>    to get size of j-direction extra band:<br/>
+!>    - tl_dom\%i_jextra
+!>
+!>    to get i-direction ghost cell number:<br/>
+!>    - tl_dom\%i_ighost
+!>
+!>    to get j-direction ghost cell number:<br/>
+!>    - tl_dom\%i_jghost
+!>
+!>    to get boundary index:<br/>
+!>    - tl_dom\%i_bdy
+!>       - 0 = no boundary
+!>       - 1 = north
+!>       - 2 = south 
+!>       - 3 = east 
+!>       - 4 = west
+!>
+!>    to clean domain structure:<br/>
+!> @code
+!>    CALL dom_clean(td_dom)
+!> @endcode
+!>       - td_dom is domain structure
+!>
+!>    to print information about domain structure:<br/>
+!> @code
+!>    CALL dom_print(td_dom)
+!> @endcode
+!>
+!>    to get East-West overlap (if any):<br/>
+!> @code
+!>    il_ew=dom_get_ew_overlap(td_lon)
+!> @endcode
+!>       - td_lon : longitude variable structure
+!>
+!>    to add extra bands to coarse grid domain (for interpolation):<br/>
+!> @code
+!>    CALL dom_add_extra( td_dom, id_iext, id_jext ) 
+!> @endcode
+!>       - td_dom is domain structure
+!>       - id_iext is i-direction size of extra bands
+!>       - id_jext is j-direction size of extra bands
+!> 
+!>    to remove extra bands from fine grid (after interpolation):<br/>
+!> @code
+!>    CALL dom_del_extra( td_var, td_dom, id_rho )
+!> @endcode
+!>       - td_var is variable structure to be changed
+!>       - td_dom is domain structure
+!>       - id_rho is a array of refinement factor following i- and j-direction
+!>    
+!>    to reset coarse grid domain witouht extra bands:<br/>
+!> @code
+!>    CALL dom_clean_extra( td_dom )
+!> @endcode
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> - use zero indice to defined cyclic or global domain
+!> @date October, 2014
+!> - use mpp file structure instead of file
+!> 
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE dom
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE mpp                             ! mpp file manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TDOM     !< domain structure
+
+   PRIVATE :: im_minext !< default minumum number of extraband
+
+   ! function and subroutine
+   PUBLIC :: dom_copy            !< copy domain structure
+   PUBLIc :: dom_clean           !< clean domain structure
+   PUBLIC :: dom_init            !< initialise domain structure
+   PUBLIC :: dom_print           !< print information about domain
+   PUBLIC :: dom_add_extra       !< add useful extra bands to coarse grid for interpolation
+   PUBLIC :: dom_clean_extra     !< reset domain without extra bands
+   PUBLIC :: dom_del_extra       !< remove extra point from fine grid after interpolation
+    
+   PRIVATE :: dom__init_mpp                 ! initialise domain structure, given mpp file structure
+   PRIVATE :: dom__define                   ! define sub domain indices
+                                            ! define sub domain indices for input domain with
+   PRIVATE :: dom__define_cyclic_north_fold ! - cyclic east-west boundary and north fold boundary condition.
+   PRIVATE :: dom__define_north_fold        ! - north fold boundary condition.
+   PRIVATE :: dom__define_symmetric         ! - symmetric boundary condition across the equator.
+   PRIVATE :: dom__define_cyclic            ! - cyclic east-west boundary.
+   PRIVATE :: dom__define_closed            ! - cyclic east-west boundary.
+                                            ! compute size of sub domain
+   PRIVATE :: dom__size_no_pole             ! - without north fold condition
+   PRIVATE :: dom__size_no_pole_overlap     ! - without north fold condition, and which overlap east-west boundary
+   PRIVATE :: dom__size_no_pole_no_overlap  ! - without north fold condition, and which do not overlap east-west boundary
+   PRIVATE :: dom__size_pole                ! - with north fold condition
+   PRIVATE :: dom__size_pole_overlap        ! - with north fold condition, and which overlap east-west boundary
+   PRIVATE :: dom__size_pole_no_overlap     ! - with north fold condition, and which do not overlap east-west boundary
+                                            ! compute size of
+   PRIVATE :: dom__size_global              ! - global domain
+   PRIVATE :: dom__size_semi_global         ! - semi global domain 
+   PRIVATE :: dom__copy_unit                ! copy attribute structure
+
+   TYPE TDOM !< domain structure
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim0  !< global domain dimension
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim   !< sub domain dimension
+      INTEGER(i4) :: i_perio0                      !< NEMO periodicity index of global domain
+      INTEGER(i4) :: i_ew0                         !< East-West overlap of global domain
+      INTEGER(i4) :: i_perio                       !< NEMO periodicity index of sub domain
+      INTEGER(i4) :: i_pivot                       !< NEMO pivot point index F(0),T(1)
+      INTEGER(i4) :: i_imin = 0                    !< i-direction sub-domain lower left  point indice
+      INTEGER(i4) :: i_imax = 0                    !< i-direction sub-domain upper right point indice
+      INTEGER(i4) :: i_jmin = 0                    !< j-direction sub-domain lower left  point indice
+      INTEGER(i4) :: i_jmax = 0                    !< j-direction sub-domain upper right point indice
+
+      INTEGER(i4) :: i_bdy = 0                     !< boundary index : 0 = no boundary
+                                                   !<                  1 = north
+                                                   !<                  2 = south 
+                                                   !<                  3 = east 
+                                                   !<                  4 = west 
+      INTEGER(i4), DIMENSION(2,2) :: i_ghost0 = 0   !< array of ghost cell factor of global domain
+      INTEGER(i4), DIMENSION(2,2) :: i_ghost  = 0   !< array of ghost cell factor of sub domain
+
+      INTEGER(i4), DIMENSION(2) :: i_iextra = 0    !< i-direction extra point
+      INTEGER(i4), DIMENSION(2) :: i_jextra = 0    !< j-direction extra point
+
+   END TYPE TDOM
+
+   INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of extraband
+
+   INTERFACE dom_init
+      MODULE PROCEDURE dom__init_file
+      MODULE PROCEDURE dom__init_mpp
+   END INTERFACE dom_init
+
+   INTERFACE dom_copy
+      MODULE PROCEDURE dom__copy_unit  ! copy attribute structure
+   END INTERFACE
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an domain structure in another one
+   !> @details 
+   !> dummy function to get the same use for all structure
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_dom=dom_copy(dom_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_dom   domain structure
+   !> @return copy of input domain structure
+   !-------------------------------------------------------------------
+   FUNCTION dom__copy_unit( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(IN)  :: td_dom
+      ! function
+      TYPE(TDOM) :: dom__copy_unit
+
+      ! local variable
+      !----------------------------------------------------------------
+
+      dom__copy_unit=td_dom
+      
+      END FUNCTION dom__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about domain strucutre.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_dom dom structure
+   !-------------------------------------------------------------------
+   SUBROUTINE dom_print(td_dom)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDOM), INTENT(IN) :: td_dom
+
+      ! local argument
+      CHARACTER(LEN=lc) :: cl_pivot
+      !----------------------------------------------------------------
+      SELECT CASE(td_dom%i_pivot)
+         CASE(0)
+            cl_pivot='F-point'
+         CASE(1)
+            cl_pivot='T-point'
+         CASE DEFAULT
+            cl_pivot='unknown'
+      END SELECT
+
+      WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),2(/a,2(i0,1x)),(/a,4(i0,1x)),(/a,i2/),&
+      &          4(/a,i0),4(/a,2(i0,1x)))') &
+      &  " global domain size ",td_dom%t_dim0(:)%i_len, &
+      &  " domain periodicity ",td_dom%i_perio0,", pivot: ",TRIM(cl_pivot),   &
+      &  " i-direction ghost cell factor of global domain  ",td_dom%i_ghost0(jp_I,:), &
+      &  " j-direction ghost cell factor of global domain  ",td_dom%i_ghost0(jp_J,:), &
+      &  " sub-domain size : ",td_dom%t_dim(:)%i_len,                         &
+      &  " sub domain periodicity ",td_dom%i_perio,                           &
+      &  " i-direction sub-domain lower left  point indice ",td_dom%i_imin,   &
+      &  " i-direction sub-domain upper right point indice ",td_dom%i_imax,   &
+      &  " j-direction sub-domain lower left  point indice ",td_dom%i_jmin,   &
+      &  " j-direction sub-domain upper right point indice ",td_dom%i_jmax,   &
+      &  " i-direction ghost cell factor                   ",td_dom%i_ghost(jp_I,:), &
+      &  " j-direction ghost cell factor                   ",td_dom%i_ghost(jp_J,:), &
+      &  " i-direction extra point for interpolation       ",td_dom%i_iextra(:), &
+      &  " j-direction extra point for interpolation       ",td_dom%i_jextra(:)
+
+      END SUBROUTINE dom_print
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function intialise domain structure, given open file structure,
+   !> and sub domain indices. 
+   !> @details
+   !> sub domain indices are computed, taking into account coarse grid
+   !> periodicity, pivot point, and East-West overlap.
+   !
+   !> @author J.Paul
+   !> @date June, 2013 - Initial Version
+   !> @date September, 2014
+   !> - add boundary index
+   !> - add ghost cell factor
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] id_perio  grid periodicity
+   !> @param[in] id_imin   i-direction sub-domain lower left  point indice
+   !> @param[in] id_imax   i-direction sub-domain upper right point indice
+   !> @param[in] id_jmin   j-direction sub-domain lower left  point indice
+   !> @param[in] id_jmax   j-direction sub-domain upper right point indice
+   !> @param[in] cd_card   name of cardinal (for boundary)
+   !> @return domain structure
+   !-------------------------------------------------------------------
+   TYPE(TDOM) FUNCTION dom__init_mpp( td_mpp, &
+   &                                  id_imin, id_imax, id_jmin, id_jmax, &
+   &                                  cd_card )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN) :: td_mpp 
+
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_jmax
+
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
+      !local variable
+      !----------------------------------------------------------------
+
+      ! clean domain structure
+      CALL dom_clean(dom__init_mpp)
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( &
+         &  " DOM INIT: no processor file associated to mpp "//&
+         &  TRIM(td_mpp%c_name))
+
+      ELSE
+         ! global domain define by file
+
+         ! look for boundary index
+         IF( PRESENT(cd_card) )THEN
+            SELECT CASE(TRIM(cd_card))
+               CASE('north')
+                  dom__init_mpp%i_bdy=jp_north
+               CASE('south')
+                  dom__init_mpp%i_bdy=jp_south
+               CASE('east')
+                  dom__init_mpp%i_bdy=jp_east
+               CASE('west')
+                  dom__init_mpp%i_bdy=jp_west
+               CASE DEFAULT
+                  ! no boundary
+                  dom__init_mpp%i_bdy=0
+            END SELECT
+         ELSE
+            ! no boundary
+            dom__init_mpp%i_bdy=0
+         ENDIF
+
+         ! use global dimension define by mpp file
+         dom__init_mpp%t_dim0(:) = dim_copy(td_mpp%t_dim(:))
+
+         IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_mpp%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
+         ELSE
+            dom__init_mpp%i_perio0=td_mpp%i_perio
+         ENDIF
+
+         ! global domain pivot point
+         SELECT CASE(dom__init_mpp%i_perio0)
+            CASE(3,4)
+               dom__init_mpp%i_pivot = 0
+            CASE(5,6)
+               dom__init_mpp%i_pivot = 1
+            CASE DEFAULT
+               dom__init_mpp%i_pivot = 0
+         END SELECT
+
+         ! add ghost cell factor of global domain
+         dom__init_mpp%i_ghost0(:,:)=0
+         SELECT CASE(dom__init_mpp%i_perio0)
+            CASE(0)
+               dom__init_mpp%i_ghost0(:,:)=1
+            CASE(1)
+               dom__init_mpp%i_ghost0(jp_J,:)=1
+            CASE(2)
+               dom__init_mpp%i_ghost0(jp_I,:)=1
+               dom__init_mpp%i_ghost0(jp_J,2)=1
+            CASE(3,5)
+               dom__init_mpp%i_ghost0(jp_I,:)=1
+               dom__init_mpp%i_ghost0(jp_J,1)=1
+            CASE(4,6)
+               dom__init_mpp%i_ghost0(jp_J,1)=1
+         END SELECT
+
+         ! look for EW overlap
+         dom__init_mpp%i_ew0=td_mpp%i_ew
+
+         ! initialise domain as global
+         dom__init_mpp%i_imin = 1 
+         dom__init_mpp%i_imax = dom__init_mpp%t_dim0(1)%i_len
+
+         dom__init_mpp%i_jmin = 1 
+         dom__init_mpp%i_jmax = dom__init_mpp%t_dim0(2)%i_len
+
+         ! sub domain dimension
+         dom__init_mpp%t_dim(:) = dim_copy(td_mpp%t_dim(:))
+
+         ! define sub domain indices 
+         CALL dom__define( dom__init_mpp, &
+         &                 id_imin, id_imax, id_jmin, id_jmax )
+
+      ENDIF
+
+   END FUNCTION dom__init_mpp
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function intialise domain structure, given open file structure,
+   !> and sub domain indices. 
+   !> @details
+   !> sub domain indices are computed, taking into account coarse grid
+   !> periodicity, pivot point, and East-West overlap.
+   !
+   !> @author J.Paul
+   !> @date June, 2013 - Initial Version
+   !> @date September, 2014
+   !> - add boundary index
+   !> - add ghost cell factor
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_perio  grid periodicity
+   !> @param[in] id_imin   i-direction sub-domain lower left  point indice
+   !> @param[in] id_imax   i-direction sub-domain upper right point indice
+   !> @param[in] id_jmin   j-direction sub-domain lower left  point indice
+   !> @param[in] id_jmax   j-direction sub-domain upper right point indice
+   !> @param[in] cd_card   name of cardinal (for boundary)
+   !> @return domain structure
+   !-------------------------------------------------------------------
+   TYPE(TDOM) FUNCTION dom__init_file( td_file, &
+   &                                   id_imin, id_imax, id_jmin, id_jmax, &
+   &                                   cd_card )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE)      , INTENT(IN) :: td_file 
+
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_jmax
+
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
+      !local variable
+      !----------------------------------------------------------------
+
+      ! clean domain structure
+      CALL dom_clean(dom__init_file)
+
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " DOM INIT: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         ! global domain define by file
+
+         ! look for boundary index
+         IF( PRESENT(cd_card) )THEN
+            SELECT CASE(TRIM(cd_card))
+               CASE('north')
+                  dom__init_file%i_bdy=jp_north
+               CASE('south')
+                  dom__init_file%i_bdy=jp_south
+               CASE('east')
+                  dom__init_file%i_bdy=jp_east
+               CASE('west')
+                  dom__init_file%i_bdy=jp_west
+               CASE DEFAULT
+                  ! no boundary
+                  dom__init_file%i_bdy=0
+            END SELECT
+         ELSE
+            ! no boundary
+            dom__init_file%i_bdy=0
+         ENDIF
+
+         ! use global dimension define by file
+         dom__init_file%t_dim0(:) = dim_copy(td_file%t_dim(:))
+
+         IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_file%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
+         ELSE
+            dom__init_file%i_perio0=td_file%i_perio
+         ENDIF
+
+         ! global domain pivot point
+         SELECT CASE(dom__init_file%i_perio0)
+            CASE(3,4)
+               dom__init_file%i_pivot = 0
+            CASE(5,6)
+               dom__init_file%i_pivot = 1
+            CASE DEFAULT
+               dom__init_file%i_pivot = 0
+         END SELECT
+
+         ! add ghost cell factor of global domain
+         dom__init_file%i_ghost0(:,:)=0
+         SELECT CASE(dom__init_file%i_perio0)
+            CASE(0)
+               dom__init_file%i_ghost0(:,:)=1
+            CASE(1)
+               dom__init_file%i_ghost0(jp_J,:)=1
+            CASE(2)
+               dom__init_file%i_ghost0(jp_I,:)=1
+               dom__init_file%i_ghost0(jp_J,2)=1
+            CASE(3,5)
+               dom__init_file%i_ghost0(jp_I,:)=1
+               dom__init_file%i_ghost0(jp_J,1)=1
+            CASE(4,6)
+               dom__init_file%i_ghost0(jp_J,1)=1
+         END SELECT
+
+         ! look for EW overlap
+         dom__init_file%i_ew0=td_file%i_ew
+
+         ! initialise domain as global
+         dom__init_file%i_imin = 1 
+         dom__init_file%i_imax = dom__init_file%t_dim0(1)%i_len
+
+         dom__init_file%i_jmin = 1 
+         dom__init_file%i_jmax = dom__init_file%t_dim0(2)%i_len
+
+         ! sub domain dimension
+         dom__init_file%t_dim(:) = dim_copy(td_file%t_dim(:))
+
+         ! define sub domain indices 
+         CALL dom__define( dom__init_file, &
+         &                 id_imin, id_imax, id_jmin, id_jmax )
+
+      ENDIF
+
+   END FUNCTION dom__init_file
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices, and compute the size 
+   !> of the sub domain.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain structure
+   !> @param[in] id_imin   i-direction sub-domain lower left  point indice
+   !> @param[in] id_imax   i-direction sub-domain upper right point indice
+   !> @param[in] id_jmin   j-direction sub-domain lower left  point indice
+   !> @param[in] id_jmax   j-direction sub-domain upper right point indice
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__define(td_dom, &
+   &                      id_imin, id_imax, id_jmin, id_jmax )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TDOM),  INTENT(INOUT) :: td_dom
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_imin) ) td_dom%i_imin = id_imin
+      IF( PRESENT(id_imax) ) td_dom%i_imax = id_imax
+
+      IF( PRESENT(id_jmin) ) td_dom%i_jmin = id_jmin
+      IF( PRESENT(id_jmax) ) td_dom%i_jmax = id_jmax
+
+      ! check indices
+      IF(( td_dom%i_imin < -1 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. &
+      &  ( td_dom%i_imax < -1 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. &
+      &  ( td_dom%i_jmin < -1 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. &
+      &  ( td_dom%i_jmax < -1 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN
+         CALL logger_debug("0 <= imin ("//TRIM(fct_str(id_imin))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
+         CALL logger_debug("0 <= imax ("//TRIM(fct_str(id_imax))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
+         CALL logger_debug("0 <= jmin ("//TRIM(fct_str(id_jmin))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
+         CALL logger_debug("0 <= jmax ("//TRIM(fct_str(id_jmax))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
+         CALL logger_fatal( "DOM INIT DEFINE: invalid grid definition."// &
+         &               " check min and max indices")
+      ELSE
+
+         ! force to select north fold
+         IF( td_dom%i_perio0 > 2 .AND. &
+         &   ( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 .OR. &
+         &     td_dom%i_jmax < td_dom%i_jmin .OR. &
+         &     td_dom%i_jmin == 0 ) )THEN
+            td_dom%i_jmax=0
+         ENDIF
+
+         ! force to use cyclic boundary
+         IF( ( td_dom%i_perio0 == 1 .OR. &
+         &     td_dom%i_perio0 == 4 .OR. &
+         &     td_dom%i_perio0 == 6 ) .AND. &
+         &   ( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
+         &     ABS(td_dom%i_imax-td_dom%i_imin)+1 == td_dom%t_dim0(1)%i_len ) &
+         &  )THEN
+            td_dom%i_imin = 0
+            td_dom%i_imax = 0
+         ENDIF
+
+         SELECT CASE(td_dom%i_perio0)
+            CASE(0) ! closed boundary
+               CALL logger_trace("DOM INIT DEFINE: closed boundary")
+               CALL dom__define_closed( td_dom )
+            CASE(1) ! cyclic east-west boundary
+               CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary")
+               CALL dom__define_cyclic( td_dom )
+            CASE(2) ! symmetric boundary condition across the equator
+               CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//&
+               &                 " across the equator")
+               CALL dom__define_symmetric( td_dom )
+            CASE(3) ! North fold boundary (with a F-point pivot)  
+               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
+               &                 "(with a F-point pivot)")
+               CALL dom__define_north_fold( td_dom )
+            CASE(5) ! North fold boundary (with a T-point pivot)
+               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
+               &                 "(with a T-point pivot)")
+               CALL dom__define_north_fold( td_dom )
+            CASE(4) ! North fold boundary (with a F-point pivot) 
+                    ! and cyclic east-west boundary
+               CALL logger_trace("DOM INIT DEFINE:  North fold boundary "//&
+               &                 "(with a F-point pivot) and cyclic "//&
+               &                 "east-west boundary")
+               CALL dom__define_cyclic_north_fold( td_dom )
+            CASE(6) ! North fold boundary (with a T-point pivot) 
+                    ! and cyclic east-west boundary
+               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
+               &                 "(with a T-point pivot) and cyclic "//&
+               &                 "east-west boundary")
+               CALL dom__define_cyclic_north_fold( td_dom )
+            CASE DEFAULT
+               CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index")
+         END SELECT
+
+      ENDIF
+
+   END SUBROUTINE dom__define
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain with
+   !> cyclic east-west boundary and north fold boundary condition.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - use zero indice to defined cyclic or global domain
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__define_cyclic_north_fold( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      !CALL dom__check_EW_index( td_dom )
+
+      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
+      &   td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract is global" )
+         ! coarse domain is global domain
+
+         CALL dom__size_global( td_dom )
+
+      ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
+      &       td_dom%i_jmax == 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract is semi-global" )
+
+         CALL dom__size_semi_global( td_dom )
+
+      ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
+      &       td_dom%i_jmax /= 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract is band of latidue" )
+
+         CALL dom__size_no_pole( td_dom )
+
+      ELSEIF( td_dom%i_jmax == 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract use north fold" )
+
+         CALL dom__size_pole( td_dom )
+
+      ELSEIF( td_dom%i_jmax /= 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract do not use north fold" )
+         ! no North Pole
+         
+         CALL dom__size_no_pole( td_dom )
+
+      ELSE
+
+         CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "should have been an impossible case" )
+
+      ENDIF
+      
+   END SUBROUTINE dom__define_cyclic_north_fold
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain 
+   !> with north fold boundary condition.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial verison
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__define_north_fold( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax /= 0 )THEN
+
+         CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
+         &  "domain to extract has no north boundary" )
+         ! no North Pole
+         
+         CALL dom__size_no_pole_no_overlap( td_dom )
+
+      ELSE
+
+         CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
+         &  "sub domain has north boundary" )
+
+         CALL dom__size_pole_no_overlap( td_dom )
+
+      ENDIF      
+
+   END SUBROUTINE dom__define_north_fold
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain 
+   !> with symmetric boundary condition across the equator.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__define_symmetric( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      CALL dom__size_no_pole_no_overlap( td_dom )
+
+   END SUBROUTINE dom__define_symmetric
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain
+   !> with cyclic east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__define_cyclic( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+      
+      IF( td_dom%i_imin >= td_dom%i_imax )THEN
+         CALL logger_trace("DOM DEFINE CYCLIC: "//&
+         &  "domain to extract overlap east-west boundary")
+
+         CALL dom__size_no_pole_overlap( td_dom )
+
+      ELSE
+         ! id_imin < id_imax
+         CALL logger_trace("DOM DEFINE CYCLIC: "//&
+         &  "domain to extract do not overlap east-west boundary")
+
+         CALL dom__size_no_pole_no_overlap( td_dom )
+
+      ENDIF
+
+   END SUBROUTINE dom__define_cyclic
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain
+   !> with closed boundaries.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__define_closed( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      CALL dom__size_no_pole_no_overlap( td_dom )
+
+   END SUBROUTINE dom__define_closed
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of global domain 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_global( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      td_dom%i_imin = 1                     
+      td_dom%i_imax = td_dom%t_dim0(1)%i_len
+
+      td_dom%i_jmin = 1 
+      td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+      ! domain size
+      td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
+      td_dom%t_dim(2)%i_len = td_dom%t_dim0(2)%i_len
+
+      ! no ghost cell to add
+      td_dom%i_ghost(:,:)=0
+
+      ! periodicity
+      IF( td_dom%i_pivot == 0 )THEN ! 0-F
+         td_dom%i_perio=4
+         td_dom%i_pivot=0
+      ELSE ! 1-T
+         td_dom%i_perio=6
+         td_dom%i_pivot=1
+      ENDIF
+
+   END SUBROUTINE dom__size_global
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of a semi global domain 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_semi_global( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+
+      ! local variable
+      INTEGER(i4) :: il_imid   ! canadian bipole index (middle of global domain) 
+      !----------------------------------------------------------------
+
+      il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
+
+      td_dom%i_imin = 2
+      td_dom%i_imax = il_imid !td_dom%t_dim0(1)%i_len
+
+      IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1
+      td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+      ! domain size
+      td_dom%t_dim(1)%i_len = td_dom%i_imax - &
+      &                       td_dom%i_imin + 1
+
+      td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+      &                         td_dom%i_jmin + 1 ) +      &
+      &                         ( td_dom%t_dim0(2)%i_len - &
+      &                           td_dom%i_jmin + 1 ) - 2    ! remove north fold condition ?
+
+      ! ghost cell to add
+      td_dom%i_ghost(:,:)=1
+
+      ! periodicity
+      IF( td_dom%i_pivot == 0 )THEN !0-F
+         td_dom%i_perio=3
+         td_dom%i_pivot=0
+      ELSE !1-T
+         td_dom%i_perio=5
+         td_dom%i_pivot=1
+      ENDIF
+
+   END SUBROUTINE dom__size_semi_global
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain without north fold
+   !> condition
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_no_pole( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//&
+         &  "can not get north pole from this coarse grid. "//&
+         &  "check namelist and coarse grid periodicity." )
+      ENDIF
+
+      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .OR. &
+      &   td_dom%i_imin > td_dom%i_imax )THEN
+         CALL logger_trace("DOM SIZE NO POLE: "// &
+         &  "domain to extract overlap east-west boundary")
+
+         CALL dom__size_no_pole_overlap( td_dom )
+
+      ELSE
+         ! id_imin < id_imax
+         CALL logger_trace("DOM SIZE NO POLE: "// &
+         &  "domain to extract do not overlap east-west boundary")
+
+         CALL dom__size_no_pole_no_overlap( td_dom )
+
+      ENDIF
+
+   END SUBROUTINE dom__size_no_pole
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain with north fold
+   !> condition.
+   !>
+   !> @author J.Paul
+   !> @date April, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_pole( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_imin >= td_dom%i_imax )THEN
+         CALL logger_trace("DOM SIZE POLE: "//&
+         &  "domain to extract overlap east-west boundary")
+         CALL dom__size_pole_overlap( td_dom )
+      ELSEIF( td_dom%i_imin < td_dom%i_imax )THEN
+         CALL logger_trace("DOM SIZE POLE: "//&
+         &  "domain to extract do not overlap east-west boundary")
+         CALL dom__size_pole_no_overlap( td_dom )
+      ENDIF
+
+   END SUBROUTINE dom__size_pole
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain without north fold
+   !> condition, and which overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_no_pole_overlap( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//&
+         &  "can not get north pole from this coarse grid. "//&
+         &  "check namelist and coarse grid periodicity." )
+      ENDIF
+
+      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN
+         ! domain to extract with east west cyclic boundary
+         CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//&
+         &  "domain to extract has cyclic east-west boundary")
+
+         td_dom%i_imin = 1
+         td_dom%i_imax = td_dom%t_dim0(1)%i_len
+
+         td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
+
+         ! no ghost cell
+         td_dom%i_ghost(jp_I,:)=0
+
+         ! periodicity
+         td_dom%i_perio=1
+
+      ELSE
+
+         ! id_imin > id_imax
+         ! extract domain overlap east-west boundary
+
+         td_dom%t_dim(1)%i_len = td_dom%i_imax + &
+         &                       td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - & 
+         &                       td_dom%i_ew0     ! remove cyclic boundary
+
+         ! add ghost cell
+         td_dom%i_ghost(jp_I,:)=1
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ENDIF
+
+      td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
+      &                       td_dom%i_jmin + 1
+
+      ! add ghost cell
+      td_dom%i_ghost(jp_J,:)=1
+
+   END SUBROUTINE dom__size_no_pole_overlap
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain without north fold
+   !> condition, and which do not overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_no_pole_no_overlap( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
+         &  "can not get north pole from this coarse grid. "//&
+         &  "check domain indices and grid periodicity." )
+      ENDIF
+
+      IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
+         &  "can not overlap East-West boundary with this coarse grid. "//&
+         &  "check domain indices and grid periodicity." )
+      ENDIF
+
+      td_dom%t_dim(1)%i_len = td_dom%i_imax - & 
+      &                       td_dom%i_imin + 1 
+
+      td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
+      &                       td_dom%i_jmin + 1
+      
+      ! add ghost cell
+      td_dom%i_ghost(:,:)=1
+
+      ! periodicity
+      td_dom%i_perio=0
+
+   END SUBROUTINE dom__size_no_pole_no_overlap
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain with north fold
+   !> condition, and which overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_pole_overlap( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+
+      ! local variable
+      INTEGER(i4) :: il_idom1  ! extract domain size, east part
+      INTEGER(i4) :: il_idom2  ! extract domain size, west part
+      INTEGER(i4) :: il_imid   ! cananadian bipole index (middle of global domain) 
+      !----------------------------------------------------------------
+
+      CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
+      &  "asian bipole inside domain to extract")
+
+      il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
+
+      il_idom1 = td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1
+      il_idom2 = td_dom%i_imax
+      
+      IF( il_idom1 > il_imid .OR. il_idom2 > il_imid )THEN
+
+         CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
+         &  "canadian bipole inside domain to extract")
+         td_dom%i_imin = 0
+         td_dom%i_imax = 0
+
+         IF( td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
+            CALL dom__size_global( td_dom )
+         ELSE
+            CALL dom__size_semi_global( td_dom )
+         ENDIF
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ELSEIF( il_idom1 > il_idom2 )THEN
+
+         ! east part bigger than west part
+         CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ")
+         ! to respect symmetry around asian bipole
+         td_dom%i_imax = il_idom1
+
+         IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1 
+         ! north pole
+         td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+         ! compute size
+         td_dom%t_dim(1)%i_len = il_idom1  !! no ghost cell ??
+         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) + &   
+         &                         ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) - 2   ! remove north fold condition ?
+
+         ! add ghost cell
+         td_dom%i_ghost(:,:)=1
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ELSE ! il_idom2 >= il_idom1
+
+         ! west part bigger than east part
+         CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ")
+
+         ! to respect symmetry around asian bipole
+         td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1
+
+         IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1 
+         ! north pole
+         td_dom%i_jmax=td_dom%t_dim0(2)%i_len
+
+         ! compute size
+         td_dom%t_dim(1)%i_len = il_idom2
+         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) + &
+         &                         ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) - 2
+
+         ! add ghost cell
+         td_dom%i_ghost(:,:)=1
+         
+         ! periodicity
+         td_dom%i_perio=0
+
+      ENDIF
+
+   END SUBROUTINE dom__size_pole_overlap
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain with north fold
+   !> condition, and which do not overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+   SUBROUTINE dom__size_pole_no_overlap( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+
+      ! local variable
+      INTEGER(i4) :: il_idom1  ! extract domain size, east part
+      INTEGER(i4) :: il_idom2  ! extract domain size, west part
+      INTEGER(i4) :: il_mid    ! canadian biple index ?
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
+      &   td_dom%i_imin > td_dom%i_imax )THEN
+         CALL logger_fatal("DOM SIZE POLE NO OVERLAP: invalid domain. "//&
+         &  "can not overlap East-West boundary with this coarse grid. "//&
+         &  "check namelist and coarse grid periodicity." )
+      ENDIF
+
+      CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
+      &  "no asian bipole inside domain to extract")
+
+      IF( td_dom%i_jmin==0 ) td_dom%i_jmin = 1
+      IF( td_dom%i_jmax==0 ) td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+      ! 
+      il_mid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
+
+      IF( (td_dom%i_imin < il_mid .AND. td_dom%i_imax < il_mid) .OR. &
+      &   (td_dom%i_imin > il_mid .AND. td_dom%i_imax > il_mid) )THEN
+         CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
+         &  "no canadian bipole inside domain to extract")
+
+         td_dom%t_dim(1)%i_len = td_dom%i_imax - &
+         &                       td_dom%i_imin + 1
+
+         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+         &                       td_dom%i_jmin + 1 ) + &
+         &                       ( td_dom%t_dim0(2)%i_len - &
+         &                       td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
+
+         ! add ghost cell
+         td_dom%i_ghost(:,:)=1
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ELSE ! id_imin < il_mid .AND. id_imax > il_mid
+         CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
+         &  "canadian bipole inside domain to extract")
+
+         il_idom1 = td_dom%i_imax - (il_mid - 1)
+         il_idom2 = il_mid  - td_dom%i_imin
+         IF( il_idom1 > il_idom2 )THEN
+            ! east part bigger than west part
+            CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ")
+            ! to respect symmetry around canadian bipole
+            td_dom%i_imin = il_mid - il_idom1
+
+            td_dom%t_dim(1)%i_len = il_idom1 + 1
+            td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+            &                         td_dom%i_jmin + 1 ) + & 
+            &                         ( td_dom%t_dim0(2)%i_len - &
+            &                         td_dom%i_jmin + 1 ) &   
+            &                         - 2 - 2 * td_dom%i_pivot    ! remove north fold condition ?
+
+            ! add ghost cell
+            td_dom%i_ghost(:,:)=1
+
+            ! periodicity
+            td_dom%i_perio=0
+
+         ELSE ! il_idom2 >= il_idom1
+            ! west part bigger than east part
+            CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ")
+            ! to respect symmetry around canadian bipole
+
+            td_dom%i_imax = il_mid + il_idom2
+
+            td_dom%t_dim(1)%i_len = il_idom2 + 1
+            td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len -  &
+            &                         td_dom%i_jmin + 1 ) +     & 
+            &                         ( td_dom%t_dim0(2)%i_len -  &
+            &                         td_dom%i_jmax + 1 )       & 
+            &                         - 2 - 2 * td_dom%i_pivot  !  remove north fold condition ?
+
+            ! add ghost cell
+            td_dom%i_ghost(:,:)=1
+
+            ! periodicity
+            td_dom%i_perio=0            
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE dom__size_pole_no_overlap
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine add extra bands to coarse domain to get enough point for
+   !>  interpolation...
+   !>
+   !> @details
+   !>  - domain periodicity is take into account.<br/>
+   !>  - domain indices are changed, and size of extra bands are saved.<br/>
+   !>  - optionaly, i- and j- direction size of extra bands could be specify 
+   !> (default=im_minext)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - take into account number of ghost cell
+   !> @date February, 2016
+   !> - number of extra point is the MAX (not the MIN) of zero and asess value. 
+   !
+   !> @param[inout] td_dom domain strcuture
+   !> @param [in] id_iext  i-direction size of extra bands (default=im_minext)
+   !> @param [in] id_jext  j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE dom_add_extra( td_dom, id_iext, id_jext )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM) ,  INTENT(INOUT) :: td_dom
+      INTEGER(i4),  INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),  INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      il_iext=im_minext
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=im_minext
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      td_dom%i_iextra(:)=0
+      td_dom%i_jextra(:)=0
+
+      IF( td_dom%i_imin == 1                       .AND. &
+      &   td_dom%i_imax == td_dom%t_dim0(1)%i_len  .AND. &
+      &   td_dom%i_jmin == 1                       .AND. &
+      &   td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
+         ! global
+         ! nothing to be done
+      ELSE
+
+         IF( td_dom%i_imin == 1                       .AND. &
+         &   td_dom%i_imax == td_dom%t_dim0(1)%i_len )THEN
+            ! EW cyclic
+            ! nothing to be done
+         ELSE
+            IF( td_dom%i_ew0 < 0 )THEN
+               ! EW not cyclic
+               IF( td_dom%i_imin - il_iext > td_dom%i_ghost0(jp_I,1)*ip_ghost )THEN
+                  td_dom%i_iextra(1) = il_iext
+                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
+               ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost
+                  td_dom%i_iextra(1) = MAX(0, &
+                  &                         td_dom%i_imin - &
+                  &                         td_dom%i_ghost0(jp_I,1)*ip_ghost -1)
+                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
+               ENDIF
+
+               IF( td_dom%i_imax + il_iext < &
+               &   td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost )THEN
+                  td_dom%i_iextra(2) = il_iext
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2)
+               ELSE ! td_dom%i_imax + il_iext >= &
+                    !  td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost
+                  td_dom%i_iextra(2) = MAX( 0, &
+                  &                         td_dom%t_dim0(1)%i_len - &
+                  &                         td_dom%i_ghost0(jp_I,2)*ip_ghost - &
+                  &                         td_dom%i_imax )
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2)
+               ENDIF
+
+            ELSE ! td_dom%i_ew0 >= 0
+
+               ! EW cyclic
+               IF( td_dom%i_imin - il_iext > 0 )THEN
+                  td_dom%i_iextra(1) = il_iext
+                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
+               ELSE ! td_dom%i_imin - il_iext <= 0
+                  td_dom%i_iextra(1) = il_iext
+                  td_dom%i_imin      = td_dom%t_dim0(1)%i_len + &
+                  &                     td_dom%i_imin - td_dom%i_iextra(1) -&
+                  &                     td_dom%i_ew0
+               ENDIF
+
+               IF( td_dom%i_imax + il_iext <= td_dom%t_dim0(1)%i_len )THEN
+                  td_dom%i_iextra(2) = il_iext
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2)
+               ELSE ! td_dom%i_imax + il_iext > td_dom%t_dim0(1)%i_len
+                  td_dom%i_iextra(2) = il_iext
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2) - &
+                  &                     (td_dom%t_dim0(1)%i_len-td_dom%i_ew0) 
+               ENDIF               
+            ENDIF
+
+         ENDIF
+
+         IF( td_dom%i_jmin == 1                       .AND. &
+         &   td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
+            ! nothing to be done
+         ELSE
+
+            IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN
+               td_dom%i_jextra(1) = il_jext
+               td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1)
+            ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost
+               td_dom%i_jextra(1) = MAX( 0, &
+               &                         td_dom%i_jmin - &
+               &                         td_dom%i_ghost0(jp_J,1)*ip_ghost - 1)
+               td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1)
+            ENDIF
+
+            IF( td_dom%i_jmax + il_jext < &
+            &   td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost )THEN
+               td_dom%i_jextra(2) = il_jext
+               td_dom%i_jmax      = td_dom%i_jmax + td_dom%i_jextra(2)
+            ELSE ! td_dom%i_jmax + il_jext >= &
+                 !  td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost
+               td_dom%i_jextra(2) = MAX( 0, &
+               &                         td_dom%t_dim0(2)%i_len - &
+               &                         td_dom%i_ghost0(jp_J,2)*ip_ghost - &
+               &                         td_dom%i_jmax )
+               td_dom%i_jmax      = td_dom%i_jmax + td_dom%i_jextra(2)
+            ENDIF
+         ENDIF         
+
+      ENDIF
+
+      IF( td_dom%i_imin <= td_dom%i_imax )THEN
+         td_dom%t_dim(1)%i_len = td_dom%i_imax - td_dom%i_imin +1 
+      ELSE ! td_dom%i_imin > td_dom%i_imax
+         td_dom%t_dim(1)%i_len = td_dom%i_imax + &
+         &                       td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - &
+         &                       td_dom%i_ew0 ! remove overlap
+      ENDIF
+
+      td_dom%t_dim(2)%i_len = td_dom%i_jmax-td_dom%i_jmin+1
+
+
+   END SUBROUTINE dom_add_extra
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean coarse grid domain structure. 
+   !> it remove extra point added. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom_clean_extra( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM) , INTENT(INOUT) :: td_dom
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! change domain
+      td_dom%i_imin         = td_dom%i_imin + td_dom%i_iextra(1)
+      td_dom%i_jmin         = td_dom%i_jmin + td_dom%i_jextra(1)
+
+      td_dom%i_imax         = td_dom%i_imax - td_dom%i_iextra(2)
+      td_dom%i_jmax         = td_dom%i_jmax - td_dom%i_jextra(2)
+
+      td_dom%t_dim(1)%i_len = td_dom%t_dim(1)%i_len - &
+      &                          td_dom%i_iextra(1) - &
+      &                          td_dom%i_iextra(2)
+      td_dom%t_dim(2)%i_len = td_dom%t_dim(2)%i_len - &
+      &                          td_dom%i_jextra(1) - &
+      &                          td_dom%i_jextra(2)
+
+      td_dom%i_iextra(:)=0
+      td_dom%i_jextra(:)=0
+
+   END SUBROUTINE dom_clean_extra
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine delete extra band, from fine grid variable value, 
+   !> and dimension, taking into account refinement factor.
+   !>
+   !> @details
+   !> @note This subroutine should be used before clean domain structure.
+   !>
+   !> @warning if work on coordinates grid, do not remove all extra point.
+   !> save value on ghost cell. 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - take into account boundary for one point size domain
+   !> @date December, 2014
+   !> - add special case for coordinates file.
+   !
+   !> @param[inout] td_var variable strcuture
+   !> @param[in] td_dom    domain strcuture
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] ld_coord  work on coordinates file or not
+   !-------------------------------------------------------------------
+   SUBROUTINE dom_del_extra( td_var, td_dom, id_rho, ld_coord )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)               , INTENT(INOUT) :: td_var
+      TYPE(TDOM)               , INTENT(IN   ) :: td_dom
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_rho
+      LOGICAL                  , INTENT(IN   ), OPTIONAL :: ld_coord
+
+      ! local variable
+      INTEGER(i4) :: il_iextra
+      INTEGER(i4) :: il_jextra
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+      
+      INTEGER(i4), DIMENSION(2)   :: il_rho
+      INTEGER(i4), DIMENSION(2,2) :: il_ghost
+
+      REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL     :: ll_coord
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_rho) )THEN
+         ! work on coarse grid
+         il_rho(:)=id_rho(jp_I:jp_J)
+      ELSE
+         ! work on fine grid
+         il_rho(:)=1
+      ENDIF
+
+      ll_coord=.false.
+      IF( PRESENT(ld_coord) ) ll_coord=ld_coord
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("DOM DEL EXTRA: no value associated to "//&
+         &     "variable "//TRIM(td_var%c_name) )
+      ELSE
+         ! get variable right domain
+         IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+            ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+            &                 td_var%t_dim(2)%i_len, &
+            &                 td_var%t_dim(3)%i_len, &
+            &                 td_var%t_dim(4)%i_len) )
+            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+            il_iextra=SUM(td_dom%i_iextra(:))*il_rho(jp_I)
+            il_jextra=SUM(td_dom%i_jextra(:))*il_rho(jp_J)
+
+            il_ghost(:,:)=0
+            IF( ll_coord )THEN
+               il_ghost(:,:)=td_dom%i_ghost(:,:)
+            ENDIF
+
+            IF( il_iextra >= td_var%t_dim(1)%i_len )THEN
+               ! case one point size dimension
+               SELECT CASE(td_dom%i_bdy) 
+
+                  CASE(jp_north,jp_east)
+
+                     CALL logger_info("DOM DEL EXTRA: special case for north"//&
+                     &                " or east boundary.")
+                     IF( td_dom%i_iextra(1) <= 0 )THEN
+                        il_imin= 1
+                        il_ghost(jp_I,1) = 0
+                     ELSE
+                        il_imin= 1 + (td_dom%i_iextra(1)-1)*il_rho(jp_I) + 1 &
+                        &        - il_ghost(jp_I,1)
+                     ENDIF
+                     IF( td_dom%i_iextra(2) <= 0 )THEN;
+                        il_imax= td_var%t_dim(1)%i_len
+                        il_ghost(jp_I,2) = 0
+                     ELSE
+                        il_imax= td_var%t_dim(1)%i_len - &
+                        &          td_dom%i_iextra(2)*il_rho(jp_I) &
+                        &        + il_ghost(jp_I,2)
+                     ENDIF
+
+                  CASE(jp_south,jp_west)
+
+                     CALL logger_info("DOM DEL EXTRA: special case for south"//&
+                     &                " or west boundary.")
+                     IF( td_dom%i_iextra(1) <= 0 )THEN
+                        il_imin= 1
+                        il_ghost(jp_I,1) = 0
+                     ELSE
+                        il_imin= 1 + td_dom%i_iextra(1)*il_rho(jp_I) &
+                        &        - il_ghost(jp_I,1)
+                     ENDIF
+                     IF( td_dom%i_iextra(2) <= 0 )THEN
+                        il_imax= td_var%t_dim(1)%i_len
+                        il_ghost(jp_I,2) = 0
+                     ELSE
+                        il_imax= td_var%t_dim(1)%i_len - &
+                        &          (td_dom%i_iextra(2)-1)*il_rho(jp_I) - 1 &
+                        &        + il_ghost(jp_I,2)
+                     ENDIF
+
+                  CASE DEFAULT
+
+                     IF( MOD(il_iextra-td_var%t_dim(1)%i_len,2)==0 )THEN
+                        ! case one point size dimension with even refinment
+                        CALL logger_fatal("DOM DEL EXTRA: should have been"//&
+                        &                 "an impossible case: domain of "//&
+                        &                 " one point size and even refinment.")
+                     ELSE
+                        il_imin= 1 + &
+                        &        (td_dom%i_iextra(1)-1)*il_rho(jp_I) + &
+                        &        (il_rho(jp_I)-1)/2 + 1                &
+                        &        - il_ghost(jp_I,1)
+                        il_imax= td_var%t_dim(1)%i_len - &
+                        &        (td_dom%i_iextra(2)-1)*il_rho(jp_I) - &
+                        &        (il_rho(jp_I)-1)/2 - 1                &
+                        &        + il_ghost(jp_I,2)
+                     ENDIF
+
+               END SELECT
+
+               td_var%t_dim(1)%i_len = 1 + SUM(il_ghost(jp_I,:))
+
+            ELSE
+               ! general case
+               il_imin=1                     + td_dom%i_iextra(1)*il_rho(jp_I) &
+               &                             - il_ghost(jp_I,1)
+               il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*il_rho(jp_I) &
+               &                             + il_ghost(jp_I,2)
+
+               td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len - il_iextra &
+               &                                         + SUM(il_ghost(jp_I,:))
+            ENDIF
+
+            IF( il_jextra >= td_var%t_dim(2)%i_len )THEN
+               ! case one point size dimension
+               SELECT CASE(td_dom%i_bdy) 
+
+                  CASE(jp_north,jp_east)
+
+                     IF( td_dom%i_jextra(1) <= 0 )THEN
+                        il_jmin= 1
+                        il_ghost(jp_J,1) = 0
+                     ELSE
+                        il_jmin= 1 + (td_dom%i_jextra(1)-1)*il_rho(jp_J) + 1 &
+                        &        - il_ghost(jp_J,1)
+                     ENDIF
+                     IF( td_dom%i_jextra(2) <= 0 )THEN
+                        il_jmax= td_var%t_dim(2)%i_len
+                        il_ghost(jp_J,2) = 0
+                     ELSE
+                        il_jmax= td_var%t_dim(2)%i_len - &
+                        &          td_dom%i_jextra(2)*il_rho(jp_J) &
+                        &        + il_ghost(jp_J,2)
+                     ENDIF
+
+                  CASE(jp_south,jp_west)
+
+                     IF( td_dom%i_iextra(2) <= 0 )THEN
+                        il_jmin= 1
+                        il_ghost(jp_J,1) = 0
+                     ELSE
+                        il_jmin= 1 + td_dom%i_jextra(1)*il_rho(jp_J) &
+                        &        - il_ghost(jp_J,1)
+                     ENDIF
+                     IF( td_dom%i_jextra(2) <= 0 )THEN
+                        il_jmax= td_var%t_dim(2)%i_len
+                        il_ghost(jp_J,2) = 0
+                     ELSE
+                        il_jmax= td_var%t_dim(2)%i_len - &
+                        &          (td_dom%i_jextra(2)-1)*il_rho(jp_J) - 1 &
+                        &        + il_ghost(jp_J,2)
+                     ENDIF
+
+                  CASE DEFAULT
+
+                     IF( MOD(il_jextra-td_var%t_dim(2)%i_len,2)==0 )THEN
+                        ! case one point size dimension with even refinment
+                        CALL logger_fatal("DOM DEL EXTRA: should have been"//&
+                        &                 "an impossible case: domain of "//&
+                        &                 " one point size and even refinment.")
+                     ELSE
+                        il_jmin= 1 + &
+                        &        (td_dom%i_jextra(1)-1)*il_rho(jp_J) + &
+                        &        (il_rho(jp_J)-1)/2 + 1 &
+                        &        - il_ghost(jp_J,1)
+                        il_jmax= td_var%t_dim(2)%i_len - &
+                        &        (td_dom%i_jextra(2)-1)*il_rho(jp_J) - &
+                        &        (il_rho(jp_J)-1)/2 - 1 &
+                        &        + il_ghost(jp_J,2)
+                     ENDIF
+
+               END SELECT
+
+               td_var%t_dim(2)%i_len = 1 + SUM(il_ghost(jp_J,:))
+
+            ELSE
+               ! general case
+               il_jmin=1                     + td_dom%i_jextra(1)*il_rho(jp_J) &
+               &                             - il_ghost(jp_J,1)
+               il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*il_rho(jp_J) &
+               &                             + il_ghost(jp_J,2)
+
+                td_var%t_dim(2)%i_len= td_var%t_dim(2)%i_len - il_jextra &
+                &                                        + SUM(il_ghost(jp_J,:))
+            ENDIF
+
+            DEALLOCATE(td_var%d_value)
+            ALLOCATE(td_var%d_value(td_var%t_dim(1)%i_len, &
+            &                       td_var%t_dim(2)%i_len, &
+            &                       td_var%t_dim(3)%i_len, &
+            &                       td_var%t_dim(4)%i_len) )
+
+            td_var%d_value(:,:,:,:)=dl_value(il_imin:il_imax, &
+            &                                il_jmin:il_jmax, &
+            &                                :, :)
+            DEALLOCATE(dl_value)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE dom_del_extra
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean domain structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE dom_clean( td_dom )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDOM),  INTENT(INOUT) :: td_dom
+
+      ! local variable
+      TYPE(TDOM) :: tl_dom ! empty dom structure
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_info( "DOM CLEAN: reset domain " )
+
+      ! del dimension
+      DO ji=ip_maxdim,1,-1
+         CALL dim_clean( td_dom%t_dim0(ji) )
+      ENDDO
+
+      ! replace by empty structure
+      td_dom=tl_dom
+
+   END SUBROUTINE dom_clean
+END MODULE dom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/extrap.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/extrap.f90	(revision 8732)
@@ -0,0 +1,1349 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: extrap
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage extrapolation.
+!>
+!> @details
+!>    Extrapolation method to be used is specify inside variable 
+!>    strcuture, as array of string character.<br/> 
+!>    - td_var\%c_extrap(1) string character is the interpolation name choose between:
+!>       - 'dist_weight'
+!>       - 'min_error'
+!>
+!>    @note Extrapolation method could be specify for each variable in namelist _namvar_,
+!>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/>
+!>    Example:
+!>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error'
+!>
+!>    to detect point to be extrapolated:<br/>
+!> @code
+!>    il_detect(:,:,:)=extrap_detect(td_var)
+!> @endcode
+!>       - il_detect(:,:,:) is 3D array of point to be extrapolated
+!>       - td_var  is coarse grid variable to be extrapolated
+!>
+!>    to extrapolate variable:<br/>
+!> @code
+!>    CALL extrap_fill_value( td_var, [id_radius])
+!> @endcode
+!>       - td_var  is coarse grid variable to be extrapolated
+!>       - id_radius is radius of the halo used to compute extrapolation [optional]
+!>
+!>    to add extraband to the variable (to be extrapolated):<br/>
+!> @code
+!>    CALL extrap_add_extrabands(td_var, [id_isize,] [id_jsize] )
+!> @endcode
+!>       - td_var is variable structure
+!>       - id_isize : i-direction size of extra bands [optional]
+!>       - id_jsize : j-direction size of extra bands [optional]
+!>
+!>    to delete extraband of a variable:<br/>
+!> @code
+!>    CALL extrap_del_extrabands(td_var, [id_isize,] [id_jsize] )
+!> @endcode
+!>       - td_var is variable structure
+!>       - id_isize : i-direction size of extra bands [optional]
+!>       - id_jsize : j-direction size of extra bands [optional]
+!>
+!> @warning _FillValue must not be zero (use var_chg_FillValue())
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> @date June, 2015
+!> - extrapolate all land points (_FillValue)
+!> - move deriv function to math module
+!> @date July, 2015
+!> - compute extrapolation from north west to south east, 
+!> and from south east to north west
+!>
+!> @todo
+!> - create module for each extrapolation method
+!> - smooth extrapolated points
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE extrap
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE phycst                          ! physical constant
+   USE global                          ! global variable
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE logger                          ! log file manager
+   USE math                            ! mathematical function
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PRIVATE :: im_minext    !< default minumum number of point to extrapolate
+   PRIVATE :: im_mincubic  !< default minumum number of point to extrapolate for cubic interpolation
+
+   ! function and subroutine
+   PUBLIC :: extrap_detect         !< detected point to be extrapolated
+   PUBLIC :: extrap_fill_value     !< extrapolate value over detected point 
+   PUBLIC :: extrap_add_extrabands !< add extraband to the variable (to be extrapolated) 
+   PUBLIC :: extrap_del_extrabands !< delete extraband of the variable 
+
+   PRIVATE :: extrap__detect_wrapper      ! detected point to be extrapolated wrapper
+   PRIVATE :: extrap__detect              ! detected point to be extrapolated
+   PRIVATE :: extrap__fill_value_wrapper  ! extrapolate value over detected point wrapper 
+   PRIVATE :: extrap__fill_value          ! extrapolate value over detected point 
+   PRIVATE :: extrap__3D                  !
+   PRIVATE :: extrap__3D_min_error_coef   !
+   PRIVATE :: extrap__3D_min_error_fill   !
+   PRIVATE :: extrap__3D_dist_weight_coef !
+   PRIVATE :: extrap__3D_dist_weight_fill ! 
+
+   INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of point to extrapolate
+   INTEGER(i4), PARAMETER :: im_mincubic= 4  !< default minumum number of point to extrapolate for cubic interpolation
+
+   INTERFACE extrap_detect
+      MODULE PROCEDURE extrap__detect_wrapper     !< detected point to be extrapolated
+   END INTERFACE extrap_detect
+
+   INTERFACE extrap_fill_value
+      MODULE PROCEDURE extrap__fill_value_wrapper !< detected point to be interpolated
+   END INTERFACE extrap_fill_value
+   
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function detected point to be extrapolated, given variable structure.
+   !> 
+   !> @details 
+   !> optionaly, you could sepcify fine grid level, refinment factor (default 1), 
+   !> offset between fine and coarse grid (default compute from refinment factor
+   !> as offset=(rho-1)/2), number of point to be extrapolated in each direction
+   !> (default im_minext).<br/>
+   !>
+   !> First coarsening fine grid level, if need be, then select point near 
+   !> grid point already inform.
+   !>
+   !> @note point to be extrapolated are selected using FillValue, 
+   !> so to avoid mistake FillValue should not be zero (use var_chg_FillValue)
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level to select points to be extrapolated
+   !
+   !> @param[in] td_var0   coarse grid variable to extrapolate
+   !> @return array of point to be extrapolated
+   !-------------------------------------------------------------------
+   FUNCTION extrap__detect( td_var0 ) 
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(IN   ) :: td_var0
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var0%t_dim(1)%i_len,&
+      &                      td_var0%t_dim(2)%i_len,&
+      &                      td_var0%t_dim(3)%i_len ) :: extrap__detect
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji0
+      INTEGER(i4) :: jj0
+      INTEGER(i4) :: jk0
+      !----------------------------------------------------------------
+
+      ! force to extrapolated all points
+      extrap__detect(:,:,:)=1
+
+      ! do not compute grid point already inform
+      DO jk0=1,td_var0%t_dim(3)%i_len
+         DO jj0=1,td_var0%t_dim(2)%i_len
+            DO ji0=1,td_var0%t_dim(1)%i_len
+               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN
+                  extrap__detect(ji0,jj0,jk0)=0
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END FUNCTION extrap__detect
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function sort variable to be extrapolated, depending on number of
+   !> dimentsion, then detected point to be extrapolated.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
+   !>
+   !> @param[in] td_var    coarse grid variable to extrapolate
+   !> @return 3D array of point to be extrapolated
+   !-------------------------------------------------------------------
+   FUNCTION extrap__detect_wrapper( td_var )
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(IN   ) :: td_var
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len,&
+      &                      td_var%t_dim(2)%i_len,&
+      &                      td_var%t_dim(3)%i_len ) :: extrap__detect_wrapper
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      extrap__detect_wrapper(:,:,:)=0
+
+      IF( .NOT. ANY(td_var%t_dim(1:3)%l_use) )THEN
+         ! no dimension I-J-K used
+         CALL logger_debug(" EXTRAP DETECT: nothing done for variable"//&
+         &              TRIM(td_var%c_name) )
+      ELSE IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
+         
+         ! detect point to be extrapolated on I-J-K
+         CALL logger_debug(" EXTRAP DETECT: detect point "//&
+         &              " for variable "//TRIM(td_var%c_name) )
+         
+         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var )
+
+      ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+         ! detect point to be extrapolated on I-J
+         CALL logger_debug(" EXTRAP DETECT: detect horizontal point "//&
+         &              " for variable "//TRIM(td_var%c_name) )
+         
+         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var )
+
+      ELSE IF( td_var%t_dim(3)%l_use )THEN
+         
+         ! detect point to be extrapolated on K
+         CALL logger_debug(" EXTRAP DETECT: detect vertical point "//&
+         &              " for variable "//TRIM(td_var%c_name) )
+         
+         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var )
+
+      ENDIF              
+
+      CALL logger_debug(" EXTRAP DETECT: "//&
+      &  TRIM(fct_str(SUM(extrap__detect_wrapper(:,:,:))))//&
+      &  " points to be extrapolated" )
+      
+   END FUNCTION extrap__detect_wrapper
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine select method to be used for extrapolation.
+   !> If need be, increase number of points to be extrapolated.
+   !> Finally launch extrap__fill_value.
+   !> 
+   !> @details
+   !> optionaly, you could specify :<br/>
+   !>  - refinment factor (default 1)
+   !>  - offset between fine and coarse grid (default compute from refinment factor
+   !> as offset=(rho-1)/2) 
+   !>  - number of point to be extrapolated in each direction (default im_minext)
+   !>  - radius of the halo used to compute extrapolation
+   !>  - maximum number of iteration
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
+   !
+   !> @param[inout] td_var    variable structure
+   !> @param[in] id_radius    radius of the halo used to compute extrapolation 
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap__fill_value_wrapper( td_var, & 
+   &                                      id_radius )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,                  INTENT(INOUT) :: td_var
+      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_radius
+
+      ! local variable
+      INTEGER(i4) :: il_radius
+
+      CHARACTER(LEN=lc) :: cl_method
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("EXTRAP FILL VALUE: no value "//&
+         &  "associted to variable "//TRIM(td_var%c_name) )
+      ELSE
+
+         SELECT CASE(TRIM(td_var%c_extrap(1)))
+            CASE('min_error')
+               cl_method='min_error'
+            CASE DEFAULT
+               cl_method='dist_weight'
+
+               !update variable structure
+               td_var%c_extrap(1)='dist_weight'
+         END SELECT
+
+         ! number of point use to compute box
+         il_radius=1
+         IF( PRESENT(id_radius) ) il_radius=id_radius
+         IF( il_radius < 0 )THEN
+            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+            &  " radius of the box used to compute extrapolation "//&
+            &  "("//TRIM(fct_str(il_radius))//")")
+         ENDIF
+
+         CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//&
+         &  " using "//TRIM(cl_method)//" method." )
+
+         CALL extrap__fill_value( td_var, cl_method, &
+         &                        il_radius )
+ 
+      ENDIF
+
+   END SUBROUTINE extrap__fill_value_wrapper
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute point to be extrapolated, then extrapolate point.
+   !> 
+   !> @details 
+   !> optionaly, you could specify :<br/>
+   !>  - refinment factor (default 1)
+   !>  - offset between fine and coarse grid (default compute from refinment factor
+   !> as offset=(rho-1)/2) 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
+   !
+   !> @param[inout] td_var    variable structure
+   !> @param[in] cd_method    extrapolation method
+   !> @param[in] id_radius    radius of the halo used to compute extrapolation
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap__fill_value( td_var, cd_method, &
+   &                              id_radius )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)      ,                 INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_method
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_extrap
+
+      INTEGER(i4), DIMENSION(:,:,:)  , ALLOCATABLE :: il_detect
+
+      TYPE(TATT)                                   :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !1- detect point to be extrapolated
+      ALLOCATE( il_detect( td_var%t_dim(1)%i_len, &
+      &                    td_var%t_dim(2)%i_len, &
+      &                    td_var%t_dim(3)%i_len) )
+
+      il_detect(:,:,:) = extrap_detect( td_var )
+
+      !2- add attribute to variable
+      cl_extrap=fct_concat(td_var%c_extrap(:))
+      tl_att=att_init('extrapolation',cl_extrap)
+      CALL var_move_att(td_var, tl_att)
+
+      CALL att_clean(tl_att)
+
+      IF( ALL(il_detect(:,:,:)==1) )THEN
+         CALL logger_warn(" EXTRAP FILL: "//&
+            &  " can not extrapolate "//TRIM(td_var%c_name)//&
+            &  ". no value inform." )
+      ELSE
+         CALL logger_info(" EXTRAP FILL: "//&
+            &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+            &              " point(s) to extrapolate " )
+
+         CALL logger_info(" EXTRAP FILL: method "//&
+            &  TRIM(cd_method) )
+
+         !3- extrapolate
+         CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill, &
+         &               il_detect(:,:,:),                       &
+         &               cd_method, id_radius )
+      ENDIF
+
+      DEALLOCATE(il_detect)
+
+   END SUBROUTINE extrap__fill_value
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute point to be extrapolated in 3D array.
+   !> 
+   !> @details 
+   !> in case of 'min_error' method:<br/>
+   !>    - compute derivative in i-, j- and k- direction
+   !>    - compute minimum error coefficient (distance to center of halo)
+   !>    - compute extrapolatd values by calculated minimum error using taylor expansion 
+   !> in case of 'dist_weight' method:<br/>
+   !>    - compute distance weight coefficient (inverse of distance to center of halo) 
+   !>    - compute extrapolatd values using Inverse Distance Weighting
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - compute coef indices to be used
+   !> - bug fix: force coef indice to 1, for dimension lenth equal to 1
+   !
+   !> @param[inout] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect array of point to extrapolate
+   !> @param[in] cd_method    extrapolation method
+   !> @param[in] id_radius    radius of the halo used to compute extrapolation
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap__3D( dd_value, dd_fill, id_detect,&
+   &                      cd_method, id_radius )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)   ,                     INTENT(IN   ) :: dd_fill
+      INTEGER(i4), DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      CHARACTER(LEN=*),                INTENT(IN   ) :: cd_method
+      INTEGER(i4),                     INTENT(IN   ) :: id_radius
+
+      ! local variable
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4)                                :: il_iter
+      INTEGER(i4)                                :: il_radius
+      INTEGER(i4)                                :: il_i1
+      INTEGER(i4)                                :: il_i2
+      INTEGER(i4)                                :: il_j1
+      INTEGER(i4)                                :: il_j2
+      INTEGER(i4)                                :: il_k1
+      INTEGER(i4)                                :: il_k2
+
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+      INTEGER(i4), DIMENSION(3)                  :: il_dim
+
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdx
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdy
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
+
+      LOGICAL                                    :: ll_iter
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ALLOCATE( il_detect( il_shape(1), il_shape(2), il_shape(3)) )
+
+      SELECT CASE(TRIM(cd_method))
+      CASE('min_error')
+         DO jl=1,il_shape(4)
+
+            ! intitialise table of poitn to be extrapolated
+            il_detect(:,:,:)=id_detect(:,:,:)
+
+            il_iter=1
+            DO WHILE( ANY(il_detect(:,:,:)==1) )
+               ! change extend value to minimize number of iteration
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
+
+               ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) ) 
+               ALLOCATE( dl_dfdy(il_shape(1), il_shape(2), il_shape(3)) ) 
+               ALLOCATE( dl_dfdz(il_shape(1), il_shape(2), il_shape(3)) ) 
+
+               ! compute derivative in i-direction
+               dl_dfdx(:,:,:)=dd_fill
+               IF( il_shape(1) > 1 )THEN
+                  dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'I' )
+               ENDIF
+
+               ! compute derivative in j-direction
+               dl_dfdy(:,:,:)=dd_fill
+               IF( il_shape(2) > 1 )THEN
+                  dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'J' )
+               ENDIF
+ 
+               ! compute derivative in k-direction
+               dl_dfdz(:,:,:)=dd_fill
+               IF( il_shape(3) > 1 )THEN
+                  dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'K' )
+               ENDIF
+ 
+               il_dim(1)=2*il_radius+1
+               IF( il_shape(1) < 2*il_radius+1 ) il_dim(1)=1
+               il_dim(2)=2*il_radius+1
+               IF( il_shape(2) < 2*il_radius+1 ) il_dim(2)=1
+               il_dim(3)=2*il_radius+1
+               IF( il_shape(3) < 2*il_radius+1 ) il_dim(3)=1
+
+               ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) ) 
+
+               dl_coef(:,:,:)=extrap__3D_min_error_coef(dd_value( 1:il_dim(1), &
+               &                                                  1:il_dim(2), &
+               &                                                  1:il_dim(3), &
+               &                                                  jl ))
+
+               DO jk=1,il_shape(3)
+                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=1,il_shape(2)
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=1,il_shape(1)
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                          
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, &
+                           &  dl_dfdx(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdy(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdz(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=il_shape(2),1,-1
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=il_shape(1),1,-1
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                          
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, &
+                           &  dl_dfdx(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdy(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdz(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+               ENDDO
+
+               DEALLOCATE( dl_dfdx )
+               DEALLOCATE( dl_dfdy )
+               DEALLOCATE( dl_dfdz )
+               DEALLOCATE( dl_coef )
+
+               IF( ll_iter ) il_iter=il_iter+1
+            ENDDO
+         ENDDO
+
+      CASE DEFAULT ! 'dist_weight'
+         DO jl=1,il_shape(4)
+
+            ! intitialise table of poitn to be extrapolated
+            il_detect(:,:,:)=id_detect(:,:,:)
+
+            il_iter=1
+            DO WHILE( ANY(il_detect(:,:,:)==1) )
+               ! change extend value to minimize number of iteration
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
+
+               il_dim(1)=2*il_radius+1
+               IF( il_shape(1) < 2*il_radius+1 ) il_dim(1)=1
+               il_dim(2)=2*il_radius+1
+               IF( il_shape(2) < 2*il_radius+1 ) il_dim(2)=1
+               il_dim(3)=2*il_radius+1
+               IF( il_shape(3) < 2*il_radius+1 ) il_dim(3)=1
+               
+               ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) )
+
+               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1),&
+               &                                                   1:il_dim(2),&
+               &                                                   1:il_dim(3),&
+               &                                                   jl ) )
+               
+               DO jk=1,il_shape(3)
+                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=1,il_shape(2)
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=1,il_shape(1)
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                           
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax, &
+                           &            jl), dd_fill, il_radius, &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=il_shape(2),1,-1
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=il_shape(1),1,-1
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                           
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax, &
+                           &            jl), dd_fill, il_radius, &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+               ENDDO
+               CALL logger_info(" EXTRAP 3D: "//&
+               &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+               &              " point(s) to extrapolate " )
+            
+               DEALLOCATE( dl_coef )
+               IF( ll_iter ) il_iter=il_iter+1
+            ENDDO
+         ENDDO            
+      END SELECT
+
+      DEALLOCATE( il_detect )
+
+   END SUBROUTINE extrap__3D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute coefficient for min_error extrapolation.
+   !> 
+   !> @details 
+   !> coefficients are  "grid distance" to the center of the box 
+   !> choosed to compute extrapolation.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
+   !
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @return 3D array of coefficient for minimum error extrapolation
+   !-------------------------------------------------------------------
+   PURE FUNCTION extrap__3D_min_error_coef( dd_value )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value(:,:,:),DIM=1), &
+      &                   SIZE(dd_value(:,:,:),DIM=2), &
+      &                   SIZE(dd_value(:,:,:),DIM=3) ) :: extrap__3D_min_error_coef
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+
+      INTEGER(i4) :: il_imid
+      INTEGER(i4) :: il_jmid
+      INTEGER(i4) :: il_kmid
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dist
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! init
+      extrap__3D_min_error_coef(:,:,:)=0
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+      il_imid=INT(REAL(il_shape(1),sp)*0.5+1)
+      il_jmid=INT(REAL(il_shape(2),sp)*0.5+1)
+      il_kmid=INT(REAL(il_shape(3),sp)*0.5+1)
+
+      ALLOCATE( dl_dist(il_shape(1),il_shape(2),il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               ! compute distance
+               ! "vertical weight" is lower than horizontal 
+               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
+               &                   (jj-il_jmid)**2 + &
+               &                 3*(jk-il_kmid)**2
+
+               IF( dl_dist(ji,jj,jk) /= 0 )THEN
+                  dl_dist(ji,jj,jk)=SQRT( dl_dist(ji,jj,jk) )
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      WHERE( dl_dist(:,:,:) /= 0 )
+         extrap__3D_min_error_coef(:,:,:)=dl_dist(:,:,:)
+      END WHERE
+
+      DEALLOCATE( dl_dist )
+
+   END FUNCTION extrap__3D_min_error_coef
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute extrapolatd value by calculated minimum error using
+   !> taylor expansion
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill   FillValue of variable
+   !> @param[in] id_radius radius of the halo used to compute extrapolation
+   !> @param[in] dd_dfdx   derivative of function in i-direction
+   !> @param[in] dd_dfdy   derivative of function in j-direction
+   !> @param[in] dd_dfdz   derivative of function in k-direction
+   !> @param[in] dd_coef   array of coefficient for min_error extrapolation 
+   !> @return extrapolatd value
+   !-------------------------------------------------------------------
+   PURE FUNCTION extrap__3D_min_error_fill( dd_value, dd_fill, id_radius, &
+   &                                        dd_dfdx, dd_dfdy, dd_dfdz, &
+   &                                        dd_coef )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)   ,                   INTENT(IN) :: dd_fill
+      INTEGER(i4),                   INTENT(IN) :: id_radius
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_dfdx
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_dfdy
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_dfdz
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_coef
+
+      ! function
+      REAL(dp) :: extrap__3d_min_error_fill
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+      INTEGER(i4), DIMENSION(3) :: il_ind
+
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_mask
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_error
+
+      INTEGER(i4) :: il_min
+      ! loop indices
+
+      !----------------------------------------------------------------
+
+      ! init
+      extrap__3D_min_error_fill=dd_fill
+
+      il_min=MAX(1,(SIZE(dd_value(:,:,:)))/(1+id_radius*2))
+
+      IF( COUNT(dd_value(:,:,:) /= dd_fill) >= il_min )THEN
+
+         il_shape(:)=SHAPE(dd_value(:,:,:))
+         ALLOCATE( il_mask( il_shape(1),il_shape(2),il_shape(3)) )
+         ALLOCATE( dl_error(il_shape(1),il_shape(2),il_shape(3)) )
+
+         ! compute error
+         dl_error(:,:,:)=0.
+         il_mask(:,:,:)=0
+         WHERE( dd_dfdx(:,:,:) /= dd_fill )
+            dl_error(:,:,:)=dd_coef(:,:,:)*dd_dfdx(:,:,:)
+            il_mask(:,:,:)=1
+         END WHERE
+         WHERE( dd_dfdy(:,:,:) /= dd_fill  )
+            dl_error(:,:,:)=(dl_error(:,:,:)+dd_coef(:,:,:)*dd_dfdy(:,:,:))
+            il_mask(:,:,:)=1
+         END WHERE
+         WHERE( dd_dfdz(:,:,:) /= dd_fill  )
+            dl_error(:,:,:)=(dl_error(:,:,:)+dd_coef(:,:,:)*dd_dfdz(:,:,:))
+            il_mask(:,:,:)=1
+         END WHERE
+
+         ! get minimum error indices
+         il_ind(:)=MINLOC(dl_error(:,:,:),il_mask(:,:,:)==1)
+
+         ! return value
+         IF( ALL(il_ind(:)/=0) )THEN
+            extrap__3D_min_error_fill=dd_value(il_ind(1),il_ind(2),il_ind(3))
+         ENDIF
+
+         DEALLOCATE( il_mask )
+         DEALLOCATE( dl_error )
+
+      ENDIF
+
+   END FUNCTION extrap__3D_min_error_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute coefficient for inverse distance weighted method 
+   !> 
+   !> @details 
+   !> coefficients are inverse "grid distance" to the center of the box choosed to compute
+   !> extrapolation.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
+   !
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @return 3D array of coefficient for inverse distance weighted extrapolation
+   !-------------------------------------------------------------------
+   PURE FUNCTION extrap__3D_dist_weight_coef( dd_value )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value(:,:,:),DIM=1), &
+      &                   SIZE(dd_value(:,:,:),DIM=2), &
+      &                   SIZE(dd_value(:,:,:),DIM=3) ) :: extrap__3D_dist_weight_coef
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+
+      INTEGER(i4) :: il_imid
+      INTEGER(i4) :: il_jmid
+      INTEGER(i4) :: il_kmid
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dist
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! init
+      extrap__3D_dist_weight_coef(:,:,:)=0
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+      il_imid=INT(REAL(il_shape(1),sp)*0.5+1,i4)
+      il_jmid=INT(REAL(il_shape(2),sp)*0.5+1,i4)
+      il_kmid=INT(REAL(il_shape(3),sp)*0.5+1,i4)
+
+      ALLOCATE( dl_dist(il_shape(1),il_shape(2),il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               ! compute distance
+               ! "vertical weight" is lower than horizontal 
+               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
+               &                   (jj-il_jmid)**2 + &
+               &                 3*(jk-il_kmid)**2
+
+               IF( dl_dist(ji,jj,jk) /= 0 )THEN
+                  dl_dist(ji,jj,jk)=SQRT( dl_dist(ji,jj,jk) )
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      WHERE( dl_dist(:,:,:) /= 0 ) 
+         extrap__3D_dist_weight_coef(:,:,:)=1./dl_dist(:,:,:)
+      END WHERE
+
+      DEALLOCATE( dl_dist )
+
+   END FUNCTION extrap__3D_dist_weight_coef
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute extrapolatd value using inverse distance weighted
+   !> method
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill   FillValue of variable
+   !> @param[in] id_radius radius of the halo used to compute extrapolation
+   !> @param[in] dd_coef   3D array of coefficient for inverse distance weighted extrapolation 
+   !> @return extrapolatd value
+   !-------------------------------------------------------------------
+   FUNCTION extrap__3D_dist_weight_fill( dd_value, dd_fill, id_radius, &
+   &                                     dd_coef )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)   ,                   INTENT(IN) :: dd_fill
+      INTEGER(i4),                   INTENT(IN) :: id_radius
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_coef
+
+      ! function
+      REAL(dp) :: extrap__3D_dist_weight_fill
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
+
+      INTEGER(i4) :: il_min
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! init
+      extrap__3D_dist_weight_fill=dd_fill
+
+      il_min=MAX(1,(SIZE(dd_value(:,:,:)))/(1+id_radius*2))
+
+      IF( COUNT(dd_value(:,:,:)/= dd_fill) >= il_min )THEN
+
+         il_shape(:)=SHAPE(dd_value(:,:,:))
+         ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3)) )
+         ALLOCATE( dl_coef( il_shape(1),il_shape(2),il_shape(3)) )
+
+         dl_value(:,:,:)=0
+         dl_coef(:,:,:)=0
+
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+
+                  IF( dd_value(ji,jj,jk) /= dd_fill )THEN
+                     ! compute factor
+                     dl_value(ji,jj,jk)=dd_coef(ji,jj,jk)*dd_value(ji,jj,jk)
+                     dl_coef(ji,jj,jk)=dd_coef(ji,jj,jk)
+                  ENDIF
+
+               ENDDO
+            ENDDO
+         ENDDO
+
+
+         ! return value
+         IF( SUM( dl_coef(:,:,:) ) /= 0 )THEN
+            extrap__3D_dist_weight_fill = &
+            &  SUM( dl_value(:,:,:) )/SUM( dl_coef(:,:,:) )
+         ENDIF
+
+         DEALLOCATE( dl_value )
+         DEALLOCATE( dl_coef )
+
+      ENDIF
+
+   END FUNCTION extrap__3D_dist_weight_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add to the variable (to be extrapolated) an 
+   !> extraband of N points at north,south,east and west boundaries.
+   !> 
+   !> @details
+   !> optionaly you could specify size of extra bands in i- and j-direction
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_var variable 
+   !> @param[in] id_isize  i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jsize  j-direction size of extra bands (default=im_minext)
+   !> @todo
+   !> - invalid special case for grid with north fold
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap_add_extrabands(td_var, id_isize, id_jsize )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(INOUT)  :: td_var
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_isize
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_jsize
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+      INTEGER(i4) :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ij
+      !----------------------------------------------------------------
+      il_isize=im_minext
+      IF(PRESENT(id_isize)) il_isize=id_isize
+      IF( il_isize < im_minext .AND. &
+      &   TRIM(td_var%c_interp(1)) == 'cubic' )THEN
+         CALL logger_warn("EXTRAP ADD EXTRABANDS: size of extrabands "//&
+         &  "should be at least "//TRIM(fct_str(im_minext))//" for "//&
+         &  " cubic interpolation ")
+      ENDIF
+
+      il_jsize=im_minext
+      IF(PRESENT(id_jsize)) il_jsize=id_jsize
+      IF( il_jsize < im_minext .AND. &
+      &   TRIM(td_var%c_interp(1)) == 'cubic' )THEN
+         CALL logger_warn("EXTRAP ADD EXTRABANDS: size of extrabands "//&
+         &  "should be at least "//TRIM(fct_str(im_minext))//" for "//&
+         &  " cubic interpolation ")
+      ENDIF
+
+      IF( .NOT. td_var%t_dim(1)%l_use ) il_isize=0
+      IF( .NOT. td_var%t_dim(2)%l_use ) il_jsize=0
+
+      CALL logger_trace( "EXTRAP ADD EXTRABANDS: dimension change "//&
+      &              "in variable "//TRIM(td_var%c_name) )
+
+      ! add extrabands in variable
+      ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
+      &                  td_var%t_dim(2)%i_len, &
+      &                  td_var%t_dim(3)%i_len, &
+      &                  td_var%t_dim(4)%i_len ))
+
+      dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+
+      td_var%t_dim(1)%i_len = td_var%t_dim(1)%i_len + 2*il_isize
+      td_var%t_dim(2)%i_len = td_var%t_dim(2)%i_len + 2*il_jsize
+
+      DEALLOCATE(td_var%d_value)
+      ALLOCATE( td_var%d_value(td_var%t_dim(1)%i_len, &
+      &                        td_var%t_dim(2)%i_len, &
+      &                        td_var%t_dim(3)%i_len, &
+      &                        td_var%t_dim(4)%i_len ) )
+
+      ! intialise
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      ! fill center
+      td_var%d_value( 1+il_isize:td_var%t_dim(1)%i_len-il_isize, &
+      &               1+il_jsize:td_var%t_dim(2)%i_len-il_jsize, &
+      &                :,:) = dl_value(:,:,:,:)
+
+      ! special case for overlap
+      IF( td_var%i_ew >= 0 .AND. il_isize /= 0 )THEN
+         DO ji=1,il_isize
+            ! from east to west
+            il_tmp=td_var%t_dim(1)%i_len-td_var%i_ew+ji-2*il_isize
+            td_var%d_value(ji,:,:,:) = td_var%d_value(il_tmp,:,:,:)
+
+            ! from west to east
+            ij=td_var%t_dim(1)%i_len-ji+1
+            il_tmp=td_var%i_ew-ji+2*il_isize+1
+            td_var%d_value(ij,:,:,:) = td_var%d_value(il_tmp,:,:,:)
+         ENDDO
+      ENDIF
+
+      DEALLOCATE( dl_value )
+
+   END SUBROUTINE extrap_add_extrabands
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine remove of the variable an extraband 
+   !> of N points at north,south,east and west boundaries.
+   !> 
+   !> @details
+   !> optionaly you could specify size of extra bands in i- and j-direction
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_var variable 
+   !> @param[in] id_isize  i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jsize  j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE extrap_del_extrabands(td_var, id_isize, id_jsize )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(INOUT) :: td_var
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_isize
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_jsize
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+ 
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      ! loop indices
+      !----------------------------------------------------------------
+      il_isize=im_minext
+      IF(PRESENT(id_isize)) il_isize=id_isize
+
+      il_jsize=im_minext
+      IF(PRESENT(id_jsize)) il_jsize=id_jsize
+
+      IF( .NOT. td_var%t_dim(1)%l_use ) il_isize=0
+      IF( .NOT. td_var%t_dim(2)%l_use ) il_jsize=0
+
+      CALL logger_trace( "EXTRAP DEL EXTRABANDS: dimension change "//&
+      &              "in variable "//TRIM(td_var%c_name) )
+
+      ! add extrabands in variable
+      ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
+      &                  td_var%t_dim(2)%i_len, &
+      &                  td_var%t_dim(3)%i_len, &
+      &                  td_var%t_dim(4)%i_len ))
+
+      dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+      ! fill center
+      il_imin=1+il_isize
+      il_imax=td_var%t_dim(1)%i_len-il_isize
+
+      il_jmin=1+il_jsize
+      il_jmax=td_var%t_dim(2)%i_len-il_jsize
+      
+      td_var%t_dim(1)%i_len = td_var%t_dim(1)%i_len - 2*il_isize
+      td_var%t_dim(2)%i_len = td_var%t_dim(2)%i_len - 2*il_jsize
+
+      DEALLOCATE(td_var%d_value)
+      ALLOCATE( td_var%d_value(td_var%t_dim(1)%i_len, &
+      &                        td_var%t_dim(2)%i_len, &
+      &                        td_var%t_dim(3)%i_len, &
+      &                        td_var%t_dim(4)%i_len ) )
+
+      ! intialise
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      td_var%d_value(:,:,:,:)=dl_value(il_imin:il_imax,&
+      &                                il_jmin:il_jmax,&
+      &                                :,:)
+
+      DEALLOCATE( dl_value )
+
+   END SUBROUTINE extrap_del_extrabands
+END MODULE extrap
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/file.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/file.f90	(revision 8732)
@@ -0,0 +1,2115 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: file
+!
+!> @brief 
+!> This module manage file structure.
+!>
+!> @details
+!>    define type TFILE:<br/>
+!> @code
+!>    TYPE(TFILE) :: tl_file
+!> @endcode
+!>
+!>    to initialize a file structure:<br/>
+!> @code
+!>    tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,cd_grid])
+!%    tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,id_ew] [,id_perio] [,id_pivot] [,cd_grid])
+!> @endcode
+!>       - cd_file is the file name
+!>       - cd_type is the type of the file ('cdf', 'dimg') [optional]
+!>       - ld_wrt  file in write mode or not [optional]
+!%       - id_ew is the number of point for east-west overlap [optional]
+!%       - id_perio is the NEMO periodicity index [optional]
+!%       - id_pivot is the NEMO pivot point index F(0),T(1) [optional]
+!>       - cd_grid is the grid type (default 'ARAKAWA-C')
+!>
+!>    to get file name:<br/>
+!>    - tl_file\%c_name
+!>
+!>    to get file id (units):<br/>
+!>    - tl_file\%i_id
+!>    
+!>    to get the type of the file (cdf, cdf4, dimg):<br/>
+!>    - tl_file\%c_type
+!> 
+!>    to know if file was open in write mode:<br/>
+!>    - tl_file\%l_wrt
+!>
+!>    to get the record length of the file:<br/>
+!>    - tl_file\%i_recl
+!>
+!>    Files variables<br/>
+!>    to get the number of variable in the file:<br/>
+!>    - tl_file\%i_nvar
+!>
+!>    to get the array of variable structure associated to the file:<br/>
+!>    - tl_file\%t_var(:)
+!>
+!>    Files attributes<br/>
+!>    to get the nmber of global attributes of the file:<br/>
+!>    - tl_file\%i_natt
+!>
+!>    to get the array of attributes structure associated to the file:<br/>
+!>    - tl_file\%t_att(:)
+!>
+!>    Files dimensions<br/>
+!>    to get the number of dimension used in the file:<br/>
+!>    - tl_file\%i_ndim
+!>
+!>    to get the array of dimension structure (4 elts) associated to the
+!>    file:<br/>
+!>    - tl_file\%t_dim(:)
+!>
+!>    to print information about file structure:<br/>
+!> @code
+!>    CALL file_print(td_file)
+!> @endcode
+!>
+!>    to clean file structure:<br/>
+!> @code
+!>    CALL file_clean(td_file)
+!> @endcode
+!>
+!>    to add a global attribute structure in file structure:<br/>
+!> @code
+!>    CALL file_add_att(td_file, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to add a dimension structure in file structure:<br/>
+!> @code
+!>    CALL file_add_dim(td_file, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to add a variable structure in file structure:<br/>
+!> @code
+!>    CALL file_add_var(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to delete a global attribute structure in file structure:<br/>
+!> @code
+!>    CALL file_del_att(td_file, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to delete a dimension structure in file structure:<br/>
+!> @code
+!>    CALL file_del_dim(td_file, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to delete a variable structure in file structure:<br/>
+!> @code
+!>    CALL file_del_var(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to overwrite one attribute structure in file structure:<br/>
+!> @code
+!>    CALL file_move_att(td_file, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to  overwrite one dimension strucutre in file structure:<br/>
+!> @code
+!>    CALL file_move_dim(td_file, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to overwrite one variable  structure in file structure:<br/>
+!> @code
+!>    CALL file_move_var(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!> 
+!>    to check if file and variable structure share same dimension:<br/>
+!> @code
+!>    ll_check_dim = file_check_var_dim(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE file
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global variable
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TFILE   !< file structure
+
+   ! function and subroutine
+   PUBLIC :: file_copy           !< copy file structure
+   PUBLIC :: file_print          !< print information about file structure
+   PUBLIC :: file_clean          !< clean file structure
+   PUBLIC :: file_init           !< initialize file structure
+   PUBLIC :: file_add_att        !< add one attribute structure in file structure
+   PUBLIC :: file_add_var        !< add one variable  structure in file structure
+   PUBLIC :: file_add_dim        !< add one dimension strucutre in file structure
+   PUBLIC :: file_del_att        !< delete one attribute structure of file structure
+   PUBLIC :: file_del_var        !< delete one variable  structure of file structure
+   PUBLIC :: file_del_dim        !< delete one dimension strucutre of file structure
+   PUBLIC :: file_move_att       !< overwrite one attribute structure in file structure
+   PUBLIC :: file_move_var       !< overwrite one variable  structure in file structure
+   PUBLIC :: file_move_dim       !< overwrite one dimension strucutre in file structure
+   PUBLIC :: file_check_var_dim  !< check if file and variable structure use same dimension.
+   PUBLIC :: file_get_type       !< get type of file
+   PUBLIC :: file_get_id         !< get file id
+   PUBLIC :: file_rename         !< rename file name
+   PUBLIC :: file_add_suffix     !< add suffix to file name
+ 
+   PRIVATE :: file__clean_unit    ! clean file structure
+   PRIVATE :: file__clean_arr     ! clean array of file structure
+   PRIVATE :: file__del_var_name ! delete a variable structure in file structure, given variable name or standard name
+   PRIVATE :: file__del_var_str  ! delete a variable structure in file structure, given variable structure
+   PRIVATE :: file__del_att_name ! delete a attribute structure in file structure, given attribute name
+   PRIVATE :: file__del_att_str  ! delete a attribute structure in file structure, given attribute structure
+   PRIVATE :: file__get_number   ! get number in file name without suffix
+   PRIVATE :: file__get_suffix   ! get suffix of file name
+   PRIVATE :: file__copy_unit    ! copy file structure
+   PRIVATE :: file__copy_arr     ! copy array of file structure
+   PRIVATE :: file__rename_char  ! rename file name, given processor number.
+   PRIVATE :: file__rename_str   ! rename file name, given file structure.
+
+   TYPE TFILE !< file structure
+
+      ! general 
+      CHARACTER(LEN=lc)                 :: c_name = ""       !< file name
+      CHARACTER(LEN=lc)                 :: c_type = ""       !< type of the file (cdf, cdf4, dimg)
+      INTEGER(i4)                       :: i_id   = 0        !< file id
+      LOGICAL                           :: l_wrt  = .FALSE.  !< read or write mode
+      INTEGER(i4)                       :: i_nvar = 0        !< number of variable
+      TYPE(TVAR), DIMENSION(:), POINTER :: t_var  => NULL()  !< file variables
+
+      CHARACTER(LEN=lc)                 :: c_grid = 'ARAKAWA-C' !< grid type
+
+      INTEGER(i4)                       :: i_ew    =-1       !< east-west overlap
+      INTEGER(i4)                       :: i_perio =-1       !< NEMO periodicity index
+      INTEGER(i4)                       :: i_pivot =-1       !< NEMO pivot point index F(0),T(1)
+
+      INTEGER(i4)                       :: i_depthid = 0     !< variable id of depth
+      INTEGER(i4)                       :: i_timeid  = 0     !< variable id of time
+
+      ! netcdf file
+      INTEGER(i4)                       :: i_ndim  = 0       !< number of dimensions used in the file
+      INTEGER(i4)                       :: i_natt  = 0       !< number of global attributes in the file
+      INTEGER(i4)                       :: i_uldid = 0       !< id of the unlimited dimension in the file
+      LOGICAL                           :: l_def   = .FALSE. !< define mode or not
+      TYPE(TATT), DIMENSION(:), POINTER :: t_att   => NULL() !< global attributes
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim             !< dimension structure
+      
+      ! dimg file
+      INTEGER(i4)                       :: i_recl = 0        !< record length (binary file)
+      INTEGER(i4)                       :: i_n0d  = 0        !< number of scalar variable
+      INTEGER(i4)                       :: i_n1d  = 0        !< number of 1D variable
+      INTEGER(i4)                       :: i_n2d  = 0        !< number of 2D variable
+      INTEGER(i4)                       :: i_n3d  = 0        !< number of 3D variable
+      INTEGER(i4)                       :: i_rhd  = 0        !< record of the header infos (last record)
+
+      ! mpp
+      ! only use for massively parallel processing
+      INTEGER(i4)                       :: i_pid  = -1       !< processor id (start to 1)
+      INTEGER(i4)                       :: i_impp = 0        !< i-indexes for mpp-subdomain left bottom
+      INTEGER(i4)                       :: i_jmpp = 0        !< j-indexes for mpp-subdomain left bottom
+      INTEGER(i4)                       :: i_lci  = 0        !< i-dimensions of subdomain
+      INTEGER(i4)                       :: i_lcj  = 0        !< j-dimensions of subdomain
+      INTEGER(i4)                       :: i_ldi  = 0        !< first indoor i-indices
+      INTEGER(i4)                       :: i_ldj  = 0        !< first indoor j-indices
+      INTEGER(i4)                       :: i_lei  = 0        !< last  indoor i-indices
+      INTEGER(i4)                       :: i_lej  = 0        !< last  indoor j-indices
+
+      LOGICAL                           :: l_ctr  = .FALSE.  !< domain is on border
+      LOGICAL                           :: l_use  = .FALSE.  !< domain is used
+
+      ! only use to draw domain decomposition when initialize with mpp_init
+      INTEGER(i4)                       :: i_iind = 0        !< i-direction indices
+      INTEGER(i4)                       :: i_jind = 0        !< j-direction indices
+
+   END TYPE TFILE
+
+   INTERFACE file_clean
+      MODULE PROCEDURE file__clean_unit
+      MODULE PROCEDURE file__clean_arr
+   END INTERFACE file_clean
+
+   INTERFACE file_del_var
+      MODULE PROCEDURE file__del_var_name
+      MODULE PROCEDURE file__del_var_str
+   END INTERFACE file_del_var
+
+   INTERFACE file_del_att
+      MODULE PROCEDURE file__del_att_name
+      MODULE PROCEDURE file__del_att_str
+   END INTERFACE file_del_att
+   
+   INTERFACE file_rename
+      MODULE PROCEDURE file__rename_char
+      MODULE PROCEDURE file__rename_str
+   END INTERFACE file_rename
+
+    INTERFACE file_copy
+      MODULE PROCEDURE file__copy_unit   
+      MODULE PROCEDURE file__copy_arr    
+   END INTERFACE
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy file structure in another one
+   !> @details 
+   !> file variable and attribute value are copied in a temporary array, 
+   !> so input and output file structure value do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @note new file is assume to be closed.
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>   
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_file  file structure
+   !> @return copy of input file structure
+   !-------------------------------------------------------------------
+   FUNCTION file__copy_unit( td_file )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+      ! function
+      TYPE(TFILE) :: file__copy_unit
+
+      ! local variable
+      TYPE(TVAR) :: tl_var
+      TYPE(TATT) :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_trace("FILE COPY: file "//TRIM(td_file%c_name) )
+
+      ! copy file variable
+      file__copy_unit%c_name = TRIM(td_file%c_name)
+      file__copy_unit%c_type = TRIM(td_file%c_type)
+      ! file1 should be closed even if file2 is opened right now
+      file__copy_unit%i_id   = 0
+      file__copy_unit%l_wrt  = td_file%l_wrt
+      file__copy_unit%i_nvar = td_file%i_nvar
+
+      file__copy_unit%c_grid = td_file%c_grid
+
+      file__copy_unit%i_ew   = td_file%i_ew
+      file__copy_unit%i_perio= td_file%i_perio
+      file__copy_unit%i_pivot= td_file%i_pivot
+
+      file__copy_unit%i_depthid = td_file%i_depthid
+      file__copy_unit%i_timeid  = td_file%i_timeid
+
+      ! copy variable structure
+      IF( ASSOCIATED(file__copy_unit%t_var) )THEN
+         CALL var_clean(file__copy_unit%t_var(:))
+         DEALLOCATE(file__copy_unit%t_var)
+      ENDIF
+      IF( ASSOCIATED(td_file%t_var) .AND. file__copy_unit%i_nvar > 0 )THEN
+         ALLOCATE( file__copy_unit%t_var(file__copy_unit%i_nvar) )
+         DO ji=1,file__copy_unit%i_nvar
+            tl_var = var_copy(td_file%t_var(ji))
+            file__copy_unit%t_var(ji) = var_copy(tl_var)
+         ENDDO
+      ENDIF
+      
+      ! copy netcdf variable
+      file__copy_unit%i_ndim   = td_file%i_ndim
+      file__copy_unit%i_natt   = td_file%i_natt
+      file__copy_unit%i_uldid  = td_file%i_uldid
+      file__copy_unit%l_def    = td_file%l_def
+
+      ! copy dimension
+      file__copy_unit%t_dim(:) = dim_copy(td_file%t_dim(:))
+      
+      ! copy attribute structure
+      IF( ASSOCIATED(file__copy_unit%t_att) )THEN
+         CALL att_clean(file__copy_unit%t_att(:))
+         DEALLOCATE(file__copy_unit%t_att)
+      ENDIF
+      IF( ASSOCIATED(td_file%t_att) .AND. file__copy_unit%i_natt > 0 )THEN
+         ALLOCATE( file__copy_unit%t_att(file__copy_unit%i_natt) )
+         DO ji=1,file__copy_unit%i_natt
+            tl_att = att_copy(td_file%t_att(ji))
+            file__copy_unit%t_att(ji) = att_copy(tl_att)
+         ENDDO
+      ENDIF
+
+      ! clean
+      CALL att_clean(tl_att)
+
+      ! copy dimg variable
+      file__copy_unit%i_recl = td_file%i_recl
+      file__copy_unit%i_n0d  = td_file%i_n0d
+      file__copy_unit%i_n1d  = td_file%i_n1d
+      file__copy_unit%i_n2d  = td_file%i_n2d
+      file__copy_unit%i_n3d  = td_file%i_n3d 
+      file__copy_unit%i_rhd  = td_file%i_rhd
+      
+      ! copy mpp variable
+      file__copy_unit%i_pid  = td_file%i_pid
+      file__copy_unit%i_impp = td_file%i_impp
+      file__copy_unit%i_jmpp = td_file%i_jmpp
+      file__copy_unit%i_lci  = td_file%i_lci
+      file__copy_unit%i_lcj  = td_file%i_lcj
+      file__copy_unit%i_ldi  = td_file%i_ldi
+      file__copy_unit%i_ldj  = td_file%i_ldj
+      file__copy_unit%i_lei  = td_file%i_lei
+      file__copy_unit%i_lej  = td_file%i_lej
+      file__copy_unit%l_ctr  = td_file%l_ctr
+      file__copy_unit%l_use  = td_file%l_use
+      file__copy_unit%i_iind = td_file%i_iind
+      file__copy_unit%i_jind = td_file%i_jind
+
+   END FUNCTION file__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of file structure in another one
+   !> @details 
+   !> file variable and attribute value are copied in a temporary array, 
+   !> so input and output file structure value do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @note new file is assume to be closed.
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>   
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_file  file structure
+   !> @return copy of input array of file structure
+   !-------------------------------------------------------------------
+   FUNCTION file__copy_arr( td_file )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE), DIMENSION(:)                , INTENT(IN   ) :: td_file
+      ! function
+      TYPE(TFILE), DIMENSION(SIZE(td_file(:))) :: file__copy_arr
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_file(:))
+         file__copy_arr(ji)=file_copy(td_file(ji))
+      ENDDO
+
+   END FUNCTION file__copy_arr
+   !-------------------------------------------------------------------
+   !> @brief This function initialize file structure.<br/> 
+   !> @details
+   !> If cd_type is not specify, check if file name include '.nc' or
+   !> '.dimg'<br/>
+   !> Optionally, you could specify:<br/>
+   !> - write mode (default .FALSE., ld_wrt)
+   !% - East-West overlap (id_ew)
+   !% - NEMO periodicity index (id_perio)
+   !% - NEMO pivot point index F(0),T(1) (id_pivot)
+   !> - grid type (default: 'ARAKAWA-C')
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_file   file name
+   !> @param[in] cd_type   file type ('cdf', 'dimg')
+   !> @param[in] ld_wrt    write mode (default .FALSE.)
+   !> @param[in] id_ew     east-west overlap
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @param[in] cd_grid   grid type (default 'ARAKAWA-C')
+   !> @return file structure
+   !-------------------------------------------------------------------
+   TYPE(TFILE) FUNCTION file_init( cd_file, cd_type, ld_wrt, &
+   &                               id_ew, id_perio, id_pivot,&
+   &                               cd_grid)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_wrt
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_pivot
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_grid
+
+      ! local variable
+      TYPE(TATT)  :: tl_att
+      !----------------------------------------------------------------
+
+      ! clean file
+      CALL file_clean(file_init)
+
+      file_init%c_name=TRIM(ADJUSTL(cd_file))
+      CALL logger_trace("FILE INIT: initialize file "//TRIM(file_init%c_name))
+
+      ! check type
+      IF( PRESENT(cd_type) )THEN
+         SELECT CASE(TRIM(cd_type))
+            CASE('cdf')
+               file_init%c_type='cdf'
+            CASE('dimg')
+               file_init%c_type='dimg'
+            CASE DEFAULT
+               CALL logger_error( " FILE INIT: can't initialize file "//&
+               &               TRIM(file_init%c_name)//" : type unknown " )
+         END SELECT
+      ELSE
+         file_init%c_type=TRIM(file_get_type(cd_file))
+      ENDIF
+
+      ! create some global attribute
+      IF( TRIM(file_init%c_type) == 'cdf' )THEN
+         tl_att=att_init("Conventions","CF-1.5")
+         CALL file_add_att(file_init,tl_att)
+      ENDIF
+     
+      tl_att=att_init("Grid",TRIM(file_init%c_grid))
+      CALL file_add_att(file_init,tl_att)
+
+      IF( PRESENT(ld_wrt) )THEN
+         file_init%l_wrt=ld_wrt
+      ENDIF
+
+      IF( PRESENT(id_ew) )THEN
+         file_init%i_ew=id_ew
+         IF( id_ew >= 0 )THEN
+            tl_att=att_init('ew_overlap',id_ew)
+            CALL file_move_att(file_init, tl_att)
+         ENDIF
+      ENDIF
+
+      IF( PRESENT(id_perio) )THEN
+         file_init%i_perio=id_perio
+         IF( id_perio >= 0 )THEN
+            tl_att=att_init('periodicity',id_perio)
+            CALL file_move_att(file_init, tl_att)
+         ENDIF
+      ENDIF
+
+      IF( PRESENT(id_pivot) )THEN
+         file_init%i_pivot=id_pivot
+         IF( id_pivot > 0 )THEN
+            tl_att=att_init('pivot_point',id_pivot)
+            CALL file_move_att(file_init, tl_att)
+         ENDIF
+      ENDIF
+
+      IF( PRESENT(cd_grid) )THEN
+         file_init%c_grid=cd_grid
+      ENDIF
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END FUNCTION file_init
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function get type of file, given file name.
+   !> @details
+   !> Actually it get suffix of the file name, and compare it to 'nc', 'cdf' or
+   !> 'dimg'<br/>
+   !> If no suffix or suffix not identify, we assume file is dimg
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_file   file name
+   !> @return type of file
+   !-------------------------------------------------------------------
+   CHARACTER(LEN=lc) FUNCTION file_get_type(cd_file)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      !local variable
+      CHARACTER(LEN=lc) :: cl_suffix
+      !----------------------------------------------------------------
+
+      cl_suffix=file__get_suffix(cd_file)
+      SELECT CASE( TRIM(fct_lower(cl_suffix)) )
+         CASE('.nc','.cdf')
+            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is cdf")
+            file_get_type='cdf'
+         CASE('.dimg')
+            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is dimg" )
+            file_get_type='dimg'
+         CASE DEFAULT
+            CALL logger_warn(" FILE GET TYPE: type unknown, we assume file: "//&
+            &              TRIM(cd_file)//" is dimg ")
+            file_get_type='dimg'
+      END SELECT
+
+   END FUNCTION file_get_type
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable dimension to be used 
+   !> have the same length that in file structure.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] td_var    variable structure
+   !> @return true if dimension of variable and file structure agree
+   !-------------------------------------------------------------------
+   LOGICAL FUNCTION file_check_var_dim(td_file, td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      TYPE(TVAR),  INTENT(IN) :: td_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_dim
+      LOGICAL           :: ll_error
+      LOGICAL           :: ll_warn 
+
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      file_check_var_dim=.TRUE.
+
+      ! check used dimension 
+      ll_error=.FALSE.
+      ll_warn=.FALSE.
+      DO ji=1,ip_maxdim
+         il_ind=dim_get_index( td_file%t_dim(:), &
+         &                     TRIM(td_var%t_dim(ji)%c_name), &
+         &                     TRIM(td_var%t_dim(ji)%c_sname))
+         IF( il_ind /= 0 )THEN
+            IF( td_var%t_dim(ji)%l_use  .AND. &
+            &   td_file%t_dim(il_ind)%l_use .AND. &
+            &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN
+               IF( INDEX( TRIM(td_var%c_axis), &
+               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
+                  ll_warn=.TRUE.
+               ELSE
+                  ll_error=.TRUE.
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      IF( ll_error )THEN
+
+         cl_dim='(/'
+         DO ji = 1, td_file%i_ndim
+            IF( td_file%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_file%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_file%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " file dimension: "//TRIM(cl_dim) )
+
+         cl_dim='(/'
+         DO ji = 1, td_var%i_ndim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
+
+         file_check_var_dim=.FALSE.
+
+         CALL logger_error( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name))
+
+      ELSEIF( ll_warn )THEN
+         CALL logger_warn( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name)//". you should use"//&
+         &  " var_check_dim to remove useless dimension.")
+      ELSE
+
+         IF( td_var%i_ndim >  td_file%i_ndim )THEN
+            CALL logger_info("FILE CHECK VAR DIM: variable "//&
+            &  TRIM(td_var%c_name)//" use more dimension than file "//&
+            &  TRIM(td_file%c_name)//" do until now.")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION file_check_var_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a variable structure in a file structure.<br/>
+   !> Do not overwrite, if variable already in file structure.
+   !
+   !> @note variable value is suppose to be ordered ('x','y','z','t')
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - add dimension in file if need be
+   !> - do not reorder dimension from variable, before put in file
+   !> @date September, 2015
+   !> - check variable dimension expected
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_add_var(td_file, td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR) , INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !INTEGER(i4) :: il_rec
+      INTEGER(i4) :: il_ind
+
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//&
+         & "running file_add_var" )
+         CALL logger_error( " FILE ADD VAR: structure file unknown" )
+
+      ELSE
+         ! check if variable exist
+         IF( TRIM(td_var%c_name) == '' .AND. &
+         &   TRIM(td_var%c_stdname) == '' )THEN
+            CALL logger_error(" FILE ADD VAR: variable without name ")
+         ELSE
+            ! check if variable already in file structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               il_ind=var_get_index( td_file%t_var(:), td_var%c_name,   &
+               &                                       td_var%c_stdname )
+            ENDIF
+            CALL logger_debug( &
+            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) )
+            IF( il_ind /= 0 )THEN
+
+               CALL logger_error( &
+               &  " FILE ADD VAR: variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", already in file "//TRIM(td_file%c_name) )
+
+               DO ji=1,td_file%i_nvar
+                  CALL logger_debug( " ADD VAR: in file : &
+                  &  variable "//TRIM(td_file%t_var(ji)%c_name)//&
+                  &  ", standard name "//TRIM(td_file%t_var(ji)%c_stdname) )
+               ENDDO
+
+            ELSE
+
+               CALL logger_debug( &
+               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", in file "//TRIM(td_file%c_name) )
+
+               ! check used dimension 
+               IF( file_check_var_dim(td_file, td_var) )THEN
+
+                  ! check variable dimension expected
+                  CALL var_check_dim(td_var)
+
+                  ! update dimension if need be
+                  DO ji=1,ip_maxdim
+                     IF( td_var%t_dim(ji)%l_use .AND. &
+                     &   .NOT. td_file%t_dim(ji)%l_use )THEN
+                        CALL file_add_dim(td_file,td_var%t_dim(ji))
+                     ENDIF
+                  ENDDO
+
+                  ! get index of new variable
+                  SELECT CASE(td_var%i_ndim)
+                     CASE(0)
+                        il_ind=td_file%i_n0d+1
+                        !il_rec=0
+                     CASE(1)
+                        il_ind=td_file%i_n0d+td_file%i_n1d+1
+                        !il_rec=1
+                     CASE(2)
+                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+1
+                        !il_rec=1
+                     CASE(3,4)
+                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+td_file%i_n3d+1
+                        !il_rec=td_file%t_dim(3)%i_len
+                  END SELECT
+
+                  IF( td_file%i_nvar > 0 )THEN
+                  ! already other variable in file structure
+                     ALLOCATE( tl_var(td_file%i_nvar), stat=il_status )
+                     IF(il_status /= 0 )THEN
+
+                        CALL logger_error( &
+                        &  " FILE ADD VAR: not enough space to put variables "//&
+                        &  "from "//TRIM(td_file%c_name)//&
+                        &  " in variable structure")
+
+                     ELSE
+
+                        ! save temporary variable of file structure
+                        tl_var(:)=var_copy(td_file%t_var(:))
+
+                        CALL var_clean( td_file%t_var(:) )
+                        DEALLOCATE(td_file%t_var)
+                        ALLOCATE( td_file%t_var(td_file%i_nvar+1), &
+                        &         stat=il_status)
+                        IF(il_status /= 0 )THEN
+
+                           CALL logger_error( &
+                           &  " FILE ADD VAR: not enough space to put variable "//&
+                           &  "in file structure "//TRIM(td_file%c_name) )
+
+                        ENDIF
+
+                        ! copy variable in file before
+                        ! variable with less than or equal dimension that new variable
+                        IF( il_ind > 1 )THEN
+                           td_file%t_var( 1:il_ind-1 ) = var_copy(tl_var(1:il_ind-1))
+                        ENDIF
+
+                        IF( il_ind < td_file%i_nvar+1 )THEN
+                           ! variable with more dimension than new variable
+                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
+                           &        var_copy( tl_var(il_ind : td_file%i_nvar) )
+                        ENDIF
+
+                        ! clean
+                        CALL var_clean(tl_var(:))
+                        DEALLOCATE(tl_var)
+                     ENDIF
+
+                  ELSE
+                  ! no variable in file structure
+                     IF( ASSOCIATED(td_file%t_var) )THEN
+                        CALL var_clean(td_file%t_var(:))
+                        DEALLOCATE(td_file%t_var)
+                     ENDIF
+                     ALLOCATE( td_file%t_var(td_file%i_nvar+1), stat=il_status )
+                     IF(il_status /= 0 )THEN
+
+                        CALL logger_error( &
+                        &  " FILE ADD VAR: not enough space to put variable "//&
+                        &  "in file structure "//TRIM(td_file%c_name) )
+
+                     ENDIF
+
+                  ENDIF
+
+                  ! add new variable in array of variable
+                  ALLOCATE( tl_var(1), stat=il_status )
+                  IF(il_status /= 0 )THEN
+
+                     CALL logger_error( &
+                     &  " FILE ADD VAR: not enough space to put variables from "//&
+                     &  TRIM(td_var%c_name)//" in variable structure")
+
+                  ELSE
+                     tl_var(1)=var_copy(td_var)
+
+                     ! update dimension name in new variable
+                     tl_var(1)%t_dim(:)%c_name = td_file%t_dim(:)%c_name
+                  
+                     ! add new variable
+                     td_file%t_var(il_ind)=var_copy(tl_var(1))
+
+                     ! update number of variable
+                     td_file%i_nvar=td_file%i_nvar+1
+                     SELECT CASE(tl_var(1)%i_ndim)
+                        CASE(0)
+                           td_file%i_n0d=td_file%i_n0d+1
+                        CASE(1)
+                           td_file%i_n1d=td_file%i_n1d+1
+                        CASE(2)
+                           td_file%i_n2d=td_file%i_n2d+1
+                        CASE(3,4)
+                           td_file%i_n3d=td_file%i_n3d+1
+                     END SELECT
+
+                     ! update variable id
+                     td_file%t_var(il_ind)%i_id=var_get_unit(td_file%t_var(:))
+
+                     ! update dimension used
+                     td_file%t_dim(:)%l_use=.FALSE.
+                     DO ji=1,ip_maxdim
+                        IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
+                           td_file%t_dim(ji)%l_use=.TRUE.
+                        ENDIF
+                     ENDDO
+
+                     ! update number of dimension
+                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
+
+                     ! clean
+                     CALL var_clean( tl_var(:) )
+                     DEALLOCATE(tl_var)
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file_add_var
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a variable structure 
+   !> in file structure, given variable name or standard name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      variable name or standard name
+   !-------------------------------------------------------------------
+   SUBROUTINE file__del_var_name(td_file, cd_name )
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      TYPE(TVAR)        :: tl_var
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL VAR NAME: file structure unknown ")
+         CALL logger_debug( " FILE DEL VAR NAME: you should have used file_init before "//&
+         & "running file_del_var" )
+
+      ELSE
+
+         IF( td_file%i_nvar /= 0 )THEN
+
+            ! get the variable index, in file variable structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               il_ind=var_get_index(td_file%t_var(:), cd_name )
+            ENDIF
+
+            IF( il_ind /= 0 )THEN
+   
+               tl_var=var_copy(td_file%t_var(il_ind))
+               CALL file_del_var(td_file, tl_var)
+
+            ELSE
+
+               CALL logger_debug( &
+               &  " FILE DEL VAR NAME: there is no variable with name or "//&
+               &  "standard name "//TRIM(cd_name)//" in file "//&
+               &  TRIM(td_file%c_name))
+
+            ENDIF
+
+         ELSE
+            CALL logger_debug( " FILE DEL VAR NAME: "//&
+            &        "no variable associated to file "//&
+            &        TRIM(td_file%c_name) )
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE file__del_var_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a variable structure 
+   !> in file structure, given variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file__del_var_str(td_file, td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR),  INTENT(IN)    :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_rec
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL VAR: file structure unknown ")
+         CALL logger_debug( " FILE DEL VAR: you should have used "//&
+         &  "file_init before running file_del_var" )      
+
+      ELSE
+
+         ! check if variable is member of a file
+         IF( td_var%l_file )THEN
+            CALL logger_warn( &
+            &  " FILE DEL VAR: variable "//TRIM(td_var%c_name)//&
+            &  ", belong to file "//TRIM(td_file%c_name)//&
+            &  " and can not be removed.")
+         ELSE
+            ! check if variable already in file structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               il_ind=var_get_index( td_file%t_var(:), td_var%c_name, &
+               &                                       td_var%c_stdname )
+            ENDIF
+
+            IF( il_ind == 0 )THEN
+
+               CALL logger_warn( "FILE DEL VAR: no variable "//&
+               &     TRIM(td_var%c_name)//", in file "//TRIM(td_file%c_name) )
+
+               DO ji=1,td_file%i_nvar
+                  CALL logger_debug( "FILE DEL VAR: in file "//&
+                  &  TRIM(td_file%t_var(ji)%c_name)//", standard name "//&
+                  &  TRIM(td_file%t_var(ji)%c_stdname) )
+               ENDDO
+
+            ELSE
+               
+               CALL logger_trace( "FILE DEL VAR: delete variable "//&
+               &  TRIM(td_var%c_name)//", from file "//TRIM(td_file%c_name) )
+
+               ALLOCATE( tl_var(td_file%i_nvar-1), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE DEL VAR: not enough space to put variables from "//&
+                  &  TRIM(td_file%c_name)//" in temporary variable structure")
+
+               ELSE
+
+                  ! save temporary variable's file structure
+                  IF( il_ind > 1 )THEN
+                     tl_var(1:il_ind-1)=var_copy(td_file%t_var(1:il_ind-1))
+                  ENDIF
+
+                  IF( il_ind < td_file%i_nvar )THEN
+                     tl_var(il_ind:)=var_copy(td_file%t_var(il_ind+1:))
+                  ENDIF
+
+                  ! new number of variable in file
+                  td_file%i_nvar=td_file%i_nvar-1
+                  SELECT CASE(td_var%i_ndim)
+                     CASE(0)
+                        td_file%i_n0d=td_file%i_n0d-1
+                        il_rec=0
+                     CASE(1)
+                        td_file%i_n1d=td_file%i_n1d-1
+                        il_rec=1
+                     CASE(2)
+                        td_file%i_n2d=td_file%i_n2d-1
+                        il_rec=1
+                     CASE(3,4)
+                        td_file%i_n3d=td_file%i_n3d-1
+                        il_rec=td_file%t_dim(3)%i_len
+                  END SELECT
+
+                  CALL var_clean( td_file%t_var(:) )
+                  DEALLOCATE(td_file%t_var)
+
+                  IF( td_file%i_nvar > 0 )THEN
+                     ALLOCATE( td_file%t_var(td_file%i_nvar), stat=il_status )
+                     IF(il_status /= 0 )THEN
+
+                        CALL logger_error( " FILE DEL VAR: not enough space"//&
+                        &  "to put variables in file structure "//&
+                        &  TRIM(td_file%c_name) )
+
+                     ENDIF
+
+                     ! copy attribute in file before
+                     td_file%t_var(:)=var_copy(tl_var(:))
+
+                     ! update dimension used
+                     td_file%t_dim(:)%l_use=.FALSE.
+                     DO ji=1,ip_maxdim
+                        IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
+                           td_file%t_dim(ji)%l_use=.TRUE.
+                        ENDIF
+                     ENDDO
+
+                     ! update number of dimension
+                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
+
+                  ENDIF
+
+                  ! clean
+                  CALL var_clean(tl_var(:))
+                  DEALLOCATE(tl_var)
+                  
+               ENDIF 
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file__del_var_str
+   !-------------------------------------------------------------------
+   !> @brief This subroutine overwrite variable structure 
+   !> in file structure.
+   !
+   !> @warning change variable id in file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_move_var(td_file, td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR),  INTENT(IN)    :: td_var
+
+      ! local variable
+      TYPE(TVAR) :: tl_var
+      !----------------------------------------------------------------
+
+      ! copy variable
+      tl_var=var_copy(td_var)
+
+      ! remove variable with same name or standard name
+      CALL file_del_var(td_file, tl_var)
+
+      ! add new variable
+      CALL file_add_var(td_file, tl_var)
+
+      ! clean
+      CALL var_clean(tl_var)
+
+   END SUBROUTINE file_move_var
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a global attribute 
+   !> in a file structure.<br/>
+   !> Do not overwrite, if attribute already in file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_add_att(td_file, td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE ADD ATT: file structure unknown ")
+         CALL logger_debug( " FILE ADD ATT: you should have used file_init before "//&
+         & "running file_add_att" )      
+
+      ELSE
+
+         ! check if attribute already in file structure
+         il_ind=0
+         IF( ASSOCIATED(td_file%t_att) )THEN
+            il_ind=att_get_index( td_file%t_att(:), td_att%c_name )
+         ENDIF
+
+         IF( il_ind /= 0 )THEN
+         
+            CALL logger_error( &
+            &  " FILE ADD ATT: attribute "//TRIM(td_att%c_name)//&
+            &  ", already in file "//TRIM(td_file%c_name) )
+
+            DO ji=1,td_file%i_natt
+               CALL logger_debug( &
+               &  " FILE ADD ATT: in file "//TRIM(td_file%t_att(ji)%c_name) )
+            ENDDO
+
+         ELSE
+            
+            CALL logger_trace( &
+            &  " FILE ADD ATT: add attribute "//TRIM(td_att%c_name)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+            IF( td_file%i_natt > 0 )THEN
+            ! already other attribute in file structure
+               ALLOCATE( tl_att(td_file%i_natt), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE ADD ATT: not enough space to put attributes from "//&
+                  &  TRIM(td_file%c_name)//" in temporary attribute structure")
+
+               ELSE
+
+                  ! save temporary global attribute's file structure
+                  tl_att(:)=att_copy(td_file%t_att(:))
+
+                  CALL att_clean( td_file%t_att(:) )
+                  DEALLOCATE(td_file%t_att)
+                  ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
+                  IF(il_status /= 0 )THEN
+
+                     CALL logger_error( &
+                     &  " FILE ADD ATT: not enough space to put attributes "//&
+                     &  "in file structure "//TRIM(td_file%c_name) )
+
+                  ENDIF
+
+                  ! copy attribute in file before
+                  td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:))
+
+                   ! clean
+                  CALL att_clean(tl_att(:))
+                  DEALLOCATE(tl_att)
+
+               ENDIF
+            ELSE
+            ! no attribute in file structure
+               IF( ASSOCIATED(td_file%t_att) )THEN
+                  CALL att_clean(td_file%t_att(:))
+                  DEALLOCATE(td_file%t_att)
+               ENDIF
+
+               ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE ADD ATT: not enough space to put attributes "//&
+                  &  "in file structure "//TRIM(td_file%c_name) )
+
+               ENDIF
+            ENDIF
+            ! add new attribute
+            td_file%t_att(td_file%i_natt+1)=att_copy(td_att)
+
+            ! update number of attribute
+            td_file%i_natt=td_file%i_natt+1
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file_add_att
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a global attribute structure 
+   !> in file structure, given attribute name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake
+   !> with pointer
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      attribute name
+   !-------------------------------------------------------------------
+   SUBROUTINE file__del_att_name(td_file, cd_name )
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      TYPE(TATT)        :: tl_att
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL ATT NAME: file structure unknown ")
+         CALL logger_debug( " FILE DEL ATT NAME: you should have "//&
+         &  "used file_init before running file_del_att" )
+
+      ELSE
+
+         IF( td_file%i_natt /= 0 )THEN
+
+            ! get the variable id, in file variable structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_att) )THEN
+               il_ind=att_get_index(td_file%t_att(:), cd_name )
+            ENDIF
+
+            IF( il_ind /= 0 )THEN
+   
+               tl_att=att_copy(td_file%t_att(il_ind))
+               CALL file_del_att(td_file, tl_att)
+
+            ELSE
+
+               CALL logger_debug( &
+               &  " FILE DEL ATT NAME: there is no attribute with name "//&
+               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
+
+            ENDIF
+
+         ELSE
+            CALL logger_debug( " FILE DEL ATT NAME: no attribute "//&
+            &  "associated to file "//TRIM(td_file%c_name) )
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE file__del_att_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a global attribute structure 
+   !> from file structure, given attribute structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file__del_att_str(td_file, td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL ATT: file structure unknown ")
+         CALL logger_debug( " FILE DEL ATT: you should have used "//&
+         &  "file_init before running file_del_att" )      
+
+      ELSE
+
+         ! check if attribute already in file structure
+         il_ind=0
+         IF( ASSOCIATED(td_file%t_att) )THEN
+            il_ind=att_get_index( td_file%t_att(:), td_att%c_name )
+         ENDIF
+
+         IF( il_ind == 0 )THEN
+
+            CALL logger_error( &
+            &  " FILE DEL ATT: no attribute "//TRIM(td_att%c_name)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+         ELSE
+            
+            CALL logger_trace( &
+            &  " FILE DEL ATT: del attribute "//TRIM(td_att%c_name)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+            ALLOCATE( tl_att(td_file%i_natt-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " FILE ADD ATT: not enough space to put attributes from "//&
+               &  TRIM(td_file%c_name)//" in temporary attribute structure")
+
+            ELSE
+
+               ! save temporary global attribute's file structure
+               IF( il_ind > 1 )THEN
+                  tl_att(1:il_ind-1)=att_copy(td_file%t_att(1:il_ind-1))
+               ENDIF
+
+               IF( il_ind < td_file%i_natt )THEN
+                  tl_att(il_ind:)=att_copy(td_file%t_att(il_ind+1:))
+               ENDIF
+
+               CALL att_clean( td_file%t_att(:) )
+               DEALLOCATE(td_file%t_att)
+
+               ! new number of attribute in file
+               td_file%i_natt=td_file%i_natt-1
+
+               ALLOCATE( td_file%t_att(td_file%i_natt), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE ADD ATT: not enough space to put attributes "//&
+                  &  "in file structure "//TRIM(td_file%c_name) )
+
+               ENDIF
+
+               ! copy attribute in file before
+               td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:))
+
+               ! clean 
+               CALL att_clean(tl_att(:))
+               DEALLOCATE(tl_att)
+
+            ENDIF 
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file__del_att_str
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a global attribute structure 
+   !> from file structure.
+   !> @warning change attribute id in file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_move_att(td_file, td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      TYPE(TATT)  :: tl_att
+      INTEGER(i4) :: il_ind
+      !----------------------------------------------------------------
+
+      ! copy attribute
+      tl_att=att_copy(td_att)
+
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_ind=att_get_index(td_file%t_att(:),TRIM(tl_att%c_name))
+         IF( il_ind /= 0 )THEN
+            ! remove attribute with same name
+            CALL file_del_att(td_file, tl_att)
+         ENDIF
+      ENDIF
+
+      ! add new attribute
+      CALL file_add_att(td_file, tl_att)
+
+       ! clean
+       CALL att_clean(tl_att)
+
+   END SUBROUTINE file_move_att
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a dimension structure in file 
+   !> structure.
+   !> Do not overwrite, if dimension already in file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - do not reorder dimension, before put in file
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_dim       dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_add_dim(td_file, td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE ADD DIM: file structure unknown ")
+         CALL logger_debug( " FILE ADD DIM: you should have used "//&
+         &  "file_init before running file_add_dim" )      
+
+      ELSE
+
+         IF( td_file%i_ndim <= ip_maxdim )THEN
+
+            ! check if dimension already in file structure
+            il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname)
+            IF( il_ind /= 0 )THEN
+               IF( td_file%t_dim(il_ind)%l_use )THEN
+                  CALL logger_error( &
+                  &  "FILE ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+                  &  ", short name "//TRIM(td_dim%c_sname)//&
+                  &  ", already used in file "//TRIM(td_file%c_name) )
+               ELSE
+                  ! replace dimension
+                  td_file%t_dim(il_ind)=dim_copy(td_dim)
+                  td_file%t_dim(il_ind)%i_id=il_ind
+                  td_file%t_dim(il_ind)%l_use=.TRUE.
+               ENDIF
+            ELSE
+               IF( td_file%i_ndim == ip_maxdim )THEN
+                  CALL logger_error( &
+                  &  "FILE ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//&
+                  &  ", short name "//TRIM(td_dim%c_sname)//&
+                  &  ", in file "//TRIM(td_file%c_name)//". Already "//&
+                  &  TRIM(fct_str(ip_maxdim))//" dimensions." )
+               ELSE
+                  ! search empty dimension
+                  DO ji=1,ip_maxdim
+                     IF( td_file%t_dim(ji)%i_id == 0 )THEN
+                        il_ind=ji 
+                        EXIT
+                     ENDIF
+                  ENDDO
+ 
+                  ! add new dimension    
+                  td_file%t_dim(il_ind)=dim_copy(td_dim)
+                  ! update number of attribute
+                  td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
+
+                  td_file%t_dim(il_ind)%i_id=td_file%i_ndim
+                  td_file%t_dim(il_ind)%l_use=.TRUE.
+               ENDIF               
+            ENDIF
+
+         ELSE
+            CALL logger_error( &
+            &  " FILE ADD DIM: too much dimension in file "//&
+            &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE file_add_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a dimension structure in file 
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_dim       dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_del_dim(td_file, td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+
+      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL DIM: file structure unknown ")
+         CALL logger_debug( " FILE DEL DIM: you should have used "//&
+         &  "file_init before running file_del_dim" )      
+
+      ELSE
+
+         ! check if dimension already in file structure
+         il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname)
+         IF( il_ind == 0 )THEN
+
+            CALL logger_error( &
+            &  "FILE DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+         ELSE
+            ALLOCATE( tl_dim(td_file%i_ndim-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  "FILE DEL DIM: not enough space to put dimensions from "//&
+               &  TRIM(td_file%c_name)//" in temporary dimension structure")
+
+            ELSE            
+               ! save temporary dimension's mpp structure
+               tl_dim( 1 : il_ind-1 ) = dim_copy(td_file%t_dim(1 : il_ind-1))
+               tl_dim( il_ind : td_file%i_ndim-1 ) = &
+               &      dim_copy(td_file%t_dim(il_ind+1 : td_file%i_ndim))
+
+               ! remove dimension from file
+               CALL dim_clean(td_file%t_dim(:))
+               ! copy dimension in file, except one
+               td_file%t_dim(1:td_file%i_ndim)=dim_copy(tl_dim(:))
+
+               ! update number of dimension
+               td_file%i_ndim=td_file%i_ndim-1
+
+               ! update dimension id
+               DO ji=1,td_file%i_ndim
+                  td_file%t_dim(ji)%i_id=ji
+               ENDDO
+
+               ! clean
+               CALL dim_clean(tl_dim(:))
+               DEALLOCATE(tl_dim)
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file_del_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a dimension structure 
+   !> in file structure.
+   !> @warning change dimension order in file structure. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_dim       dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_move_dim(td_file, td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+      IF( td_file%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            il_dimid=td_file%t_dim(il_ind)%i_id
+            ! replace dimension
+            td_file%t_dim(il_ind)=dim_copy(td_dim)
+            td_file%t_dim(il_ind)%i_id=il_dimid
+            td_file%t_dim(il_ind)%l_use=.TRUE.
+
+         ELSE
+            CALL file_add_dim(td_file, td_dim)
+         ENDIF
+
+      ELSE
+         CALL logger_error( &
+         &  "FILE MOVE DIM: too much dimension in mpp "//&
+         &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE file_move_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about file strucutre.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE file_print(td_file)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_mode
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      cl_mode='READ'
+      IF( td_file%l_wrt ) cl_mode='WRITE'
+
+      WRITE(*,'((a,a),2(/3x,a,a),4(/3x,a,i0))')&
+      &  "File : ",TRIM(td_file%c_name), &
+      &  " type : ",TRIM(td_file%c_type), &
+      &  " mode : ",TRIM(cl_mode), &
+      &  " id   : ",td_file%i_id, &
+      &  " ndim : ",td_file%i_ndim, &
+      &  " natt : ",td_file%i_natt, &
+      &  " nvar : ",td_file%i_nvar
+
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            WRITE(*,'((/3x,a,a),(/3x,a,i3))')&
+            &  "define mode : ",TRIM(fct_str(td_file%l_def)),&
+            &  "unlimited id : ",td_file%i_uldid
+         CASE('dimg')
+            WRITE(*,'(5(/3x,a,i0))')&
+            &  " record length : ",td_file%i_recl, &
+            &  " n0d : ",td_file%i_n0d, &
+            &  " n1d : ",td_file%i_n1d, &
+            &  " n2d : ",td_file%i_n2d, &
+            &  " n3d : ",td_file%i_n3d
+      END SELECT
+
+      ! print dimension
+      IF(  td_file%i_ndim /= 0 )THEN
+         WRITE(*,'(/a)') " File dimension"
+         DO ji=1,ip_maxdim
+            IF( td_file%t_dim(ji)%l_use )THEN
+               CALL dim_print(td_file%t_dim(ji))
+            ENDIF
+         ENDDO
+      ENDIF
+
+      ! print global attribute
+      IF( td_file%i_natt /= 0 )THEN
+         WRITE(*,'(/a)') " File attribute"
+         DO ji=1,td_file%i_natt
+            CALL att_print(td_file%t_att(ji))
+         ENDDO
+      ENDIF
+
+      ! print variable
+      IF( td_file%i_nvar /= 0 )THEN
+         WRITE(*,'(/a)') " File variable"
+         DO ji=1,td_file%i_nvar
+            CALL var_print(td_file%t_var(ji),.FALSE.)
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE file_print
+   !-------------------------------------------------------------------
+   !> @brief This function get suffix of file name.
+   !> @details
+   !> we assume suffix is define as alphanumeric character following the
+   !> last '.' in file name.<br/>
+   !> If no suffix is found, return empty character.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_file   file structure
+   !> @return suffix
+   !-------------------------------------------------------------------
+   CHARACTER(LEN=lc) FUNCTION file__get_suffix(cd_file)
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      !----------------------------------------------------------------
+
+      CALL logger_trace( "FILE GET SUFFIX: look for suffix in file name "//&
+      &               TRIM(cd_file) )
+
+      il_ind=INDEX(TRIM(cd_file),'.',BACK=.TRUE.)
+      IF( il_ind /= 0 )THEN
+         ! read number in basename
+         READ( cd_file(il_ind:),'(a)' ) file__get_suffix
+
+         IF( fct_is_num(file__get_suffix(2:)) )THEN
+            file__get_suffix=''
+         ENDIF
+
+      ELSE
+         file__get_suffix=''
+      ENDIF
+
+   END FUNCTION file__get_suffix
+   !-------------------------------------------------------------------
+   !> @brief This function get number in file name without suffix.
+   !> @details
+   !> Actually it get the number following the last separator.
+   !> separator could be '.' or '_'.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - add case to not return date (yyyymmdd) at the end of filename
+   !> @date February, 2015 
+   !> - add case to not return release number
+   !> we assume release number only on one digit (ex : file_v3.5.nc)
+   !
+   !> @param[in] cd_file   file name (without suffix)
+   !> @return character file number.
+   !-------------------------------------------------------------------
+   CHARACTER(LEN=lc) FUNCTION file__get_number(cd_file)
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_file
+
+      ! local variable
+      INTEGER(i4) :: il_indmax
+      INTEGER(i4) :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! get number position in file name
+      il_indmax=0
+      DO ji=1,ip_nsep
+         il_ind=INDEX(TRIM(cd_file),TRIM(cp_sep(ji)),BACK=.TRUE.)
+         IF( il_ind > il_indmax )THEN
+            il_indmax=il_ind
+         ENDIF
+      ENDDO
+
+      IF( il_indmax /= 0 )THEN
+         ! read number in basename
+         READ( cd_file(il_indmax:),'(a)' ) file__get_number
+
+         IF( .NOT. fct_is_num(file__get_number(2:)) )THEN
+            file__get_number=''
+         ELSEIF( LEN(TRIM(file__get_number))-1 == 8 )THEN
+            ! date case yyyymmdd
+            file__get_number=''
+         ELSEIF( LEN(TRIM(file__get_number))-1 == 1 )THEN
+            ! release number case 
+            file__get_number=''
+         ENDIF
+      ELSE
+         file__get_number=''
+      ENDIF
+
+   END FUNCTION file__get_number
+   !-------------------------------------------------------------------
+   !> @brief This function rename file name, given processor number.
+   !> @details
+   !> If no processor number is given, return file name without number
+   !> If processor number is given, return file name with new number
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_num    processor number (start to 1)
+   !> @return file name
+   !-------------------------------------------------------------------
+   CHARACTER(LEN=lc) FUNCTION file__rename_char(cd_file, id_num)
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_num
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_suffix
+      CHARACTER(LEN=lc) :: cl_file
+      CHARACTER(LEN=lc) :: cl_number
+      CHARACTER(LEN=lc) :: cl_base
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_format
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_numlen
+      !----------------------------------------------------------------
+
+      ! get suffix
+      cl_suffix=file__get_suffix(cd_file)
+      IF( TRIM(cl_suffix) /= '' )THEN
+         il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
+         cl_file=TRIM(cd_file(:il_ind-1))
+      ELSE
+         cl_file=TRIM(cd_file)
+      ENDIF
+
+      cl_number=file__get_number(cl_file)
+      IF( TRIM(cl_number) /= '' )THEN
+         il_ind=INDEX(TRIM(cl_file),TRIM(cl_number(1:1)),BACK=.TRUE.)
+         cl_base=TRIM(cl_file(:il_ind-1))
+
+         cl_sep=TRIM(cl_number(1:1))
+         il_numlen=LEN(TRIM(cl_number))-1
+      ELSE
+         cl_base=TRIM(cl_file)
+         il_numlen=4
+         cl_sep='_'
+      ENDIF
+
+      IF( PRESENT(id_num) )THEN
+         ! format
+         WRITE(cl_format,'(a,i1.1,a,i1.1,a)') '(a,a,i',il_numlen,'.',il_numlen,',a)'
+         WRITE(file__rename_char,cl_format) TRIM(cl_base),TRIM(cl_sep),id_num,TRIM(cl_suffix)
+      ELSE
+         WRITE(file__rename_char,'(a,a)') TRIM(cl_base),TRIM(cl_suffix)
+      ENDIF
+      CALL logger_trace(" FILE RENAME : "//TRIM(file__rename_char))
+
+   END FUNCTION file__rename_char
+   !-------------------------------------------------------------------
+   !> @brief This function rename file name, given file structure.
+   !> @details
+   !> If no processor number is given, return file name without number
+   !> I processor number is given, return file name with new number
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_num    processor number (start to 1)
+   !> @return file structure
+   !-------------------------------------------------------------------
+   TYPE(TFILE) FUNCTION file__rename_str(td_file, id_num)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_num
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      !----------------------------------------------------------------
+
+      ! change name
+      cl_name=TRIM( file_rename(td_file%c_name, id_num) )
+
+      file__rename_str=file_init(TRIM(cl_name), TRIM(td_file%c_type))
+
+   END FUNCTION file__rename_str
+   !-------------------------------------------------------------------
+   !> @brief This function add suffix to file name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @return file name
+   !-------------------------------------------------------------------
+   CHARACTER(LEN=lc) FUNCTION file_add_suffix(cd_file, cd_type)
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_type
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      CHARACTER(LEN=lc) :: cl_file
+      CHARACTER(LEN=lc) :: cl_suffix
+      !----------------------------------------------------------------
+      ! get suffix 
+      cl_suffix=file__get_suffix(cd_file)
+      IF( TRIM(cl_suffix) /= '' )THEN
+         il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
+         cl_file=TRIM(cd_file(:il_ind-1))
+      ELSE
+         cl_file=TRIM(cd_file)
+      ENDIF
+
+      SELECT CASE(TRIM(cd_type))
+         CASE('cdf')
+            file_add_suffix=TRIM(cl_file)//'.nc'
+         CASE('dimg')
+            IF( TRIM(cl_suffix) /= '' )THEN
+               file_add_suffix=TRIM(cl_file)//'.dimg'
+            ELSE
+               file_add_suffix=TRIM(cl_file)
+            ENDIF
+         CASE DEFAULT
+            CALL logger_error(" FILE ADD SUFFIX: type unknown "//TRIM(cd_type))
+      END SELECT
+
+   END FUNCTION file_add_suffix
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean file strcuture.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Inital version
+   !
+   !> @param[inout] td_file   file strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE file__clean_unit( td_file )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE),  INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TFILE) :: tl_file ! empty file structure
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " FILE CLEAN: reset file "//TRIM(td_file%c_name) )
+
+      ! del attribute
+      IF( ASSOCIATED( td_file%t_att ) )THEN
+         CALL att_clean( td_file%t_att(:) )
+         DEALLOCATE(td_file%t_att)
+      ENDIF
+
+      ! del dimension
+      IF( td_file%i_ndim /= 0 )THEN
+         CALL dim_clean( td_file%t_dim(:) )
+      ENDIF
+
+      ! del variable
+      IF( ASSOCIATED( td_file%t_var ) )THEN
+         CALL var_clean( td_file%t_var(:) )
+         DEALLOCATE(td_file%t_var)
+      ENDIF
+
+      ! replace by empty structure
+      td_file=file_copy(tl_file)
+
+   END SUBROUTINE file__clean_unit
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean file array of file strcuture.
+   !
+   !> @author J.Paul
+   !> @date Marsh, 2014 - Inital version
+   !
+   !> @param[inout] td_file   array file strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE file__clean_arr( td_file )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE), DIMENSION(:), INTENT(INOUT) :: td_file
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_file(:)),1,-1
+         CALL file_clean(td_file(ji))
+      ENDDO
+
+   END SUBROUTINE file__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This function return the file id, in a array of file
+   !> structure,  given file name. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   array of file structure
+   !> @param[in] cd_name   file name
+   !> @return file id in array of file structure (0 if not found)
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION file_get_id(td_file, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)     , DIMENSION(:), INTENT(IN) :: td_file
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      file_get_id=0
+      il_size=SIZE(td_file(:))
+
+      ! check if file is in array of file structure
+      DO ji=1,il_size
+         ! look for file name
+         IF( fct_lower(td_file(ji)%c_name) == fct_lower(cd_name) )THEN
+         
+            file_get_id=td_file(ji)%i_id
+            EXIT
+
+         ENDIF
+      ENDDO
+
+   END FUNCTION file_get_id
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function get the next unused unit in array of file structure.
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[in] td_file   array of file 
+   !-------------------------------------------------------------------
+   FUNCTION file_get_unit(td_file)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_file
+
+      ! function
+      INTEGER(i4) :: file_get_unit
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      file_get_unit=MAXVAL(td_file(:)%i_id)+1
+
+   END FUNCTION file_get_unit
+END MODULE file
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/filter.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/filter.f90	(revision 8732)
@@ -0,0 +1,1256 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: filter
+!
+! DESCRIPTION:
+!> @brief This module is filter manager.
+!>
+!> @details Filtering method to be used is specify inside variable strcuture,
+!>    as array of string character.<br/>
+!>    td_var\%c_filter(1) string character is the filter name choose between:<br/>
+!>       - 'hann'
+!>          - rad < cutoff : @f$ filter=0.5+0.5*COS(\pi*\frac{rad}{cutoff}) @f$
+!>          - rad > cutoff : @f$ filter=0 @f$
+!>       - 'hamming'
+!>          - rad < cutoff : @f$ filter=0.54+0.46*COS(\pi*\frac{rad}{cutoff}) @f$
+!>          - rad > cutoff : @f$ filter=0 @f$               
+!>       - 'blackman'
+!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 
+!>                                      0.08*COS(2\pi*\frac{rad}{cutoff}) @f$
+!>          - rad > cutoff : @f$ filter=0 @f$
+!>       - 'gauss'
+!>          - @f$filter=exp(-(\alpha * rad^2) / (2*cutoff^2))@f$
+!>       - 'butterworth'
+!>          - @f$ filer=1 / (1+(rad^2 / cutoff^2)^{\alpha}) @f$
+!>             .
+!>
+!>       with @f$ rad= \sqrt{(dist-radius)^2} @f$
+!>
+!>    td_var\%c_filter(2) string character is the number of turn to be done<br/>
+!>    td_var\%c_filter(3) string character is the cut-off frequency 
+! >                       (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(4) string character is the halo radius 
+!>                        (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(5) string character is the alpha parameter 
+!>                        (for gauss and butterworth method)<br/>
+!>    
+!>    @note Filter method could be specify for each variable in namelist _namvar_,
+!>    defining string character _cn\_varinfo_. None by default.<br/>
+!>    Filter method parameters are informed inside bracket.
+!>       - @f$\alpha@f$ parameter is added for _gauss_ and _butterworth_ methods
+!> 
+!>    The number of turn is specify using '*' separator.<br/>
+!>    Example:
+!>       - cn_varinfo='varname1:flt=2*hamming(@f$cutoff@f$,@f$radius@f$)', 
+!>                    'varname2:flt=gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
+!>
+!>    to filter variable value:<br/>
+!> @code
+!>    CALL filter_fill_value( td_var )
+!> @endcode
+!>       - td_var is variable structure
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE filter
+   USE kind                            ! F90 kind parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE fct                             ! basic usefull function
+   use att                             ! attribute manager
+   USE var                             ! variable manager
+   USE extrap                          ! extrapolation manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+
+   ! function and subroutine
+   PUBLIC :: filter_fill_value   !< filter variable value
+
+   PRIVATE :: filter__fill_value_wrapper !
+   PRIVATE :: filter__fill_value         !
+   PRIVATE :: filter__3D_fill_value      ! 
+   PRIVATE :: filter__2D_fill_value      !
+   PRIVATE :: filter__2D                 !
+   PRIVATE :: filter__2D_coef            !
+   PRIVATE :: filter__2D_hann            !
+   PRIVATE :: filter__2D_hamming         !
+   PRIVATE :: filter__2D_blackman        !
+   PRIVATE :: filter__2D_gauss           !
+   PRIVATE :: filter__2D_butterworth     !
+   PRIVATE :: filter__1D_fill_value      !
+   PRIVATE :: filter__1D                 !
+   PRIVATE :: filter__1D_coef            !
+   PRIVATE :: filter__1D_hann            !
+   PRIVATE :: filter__1D_hamming         !
+   PRIVATE :: filter__1D_blackman        !
+   PRIVATE :: filter__1D_gauss           !
+   PRIVATE :: filter__1D_butterworth     !
+
+   INTERFACE filter_fill_value
+      MODULE PROCEDURE filter__fill_value_wrapper
+   END INTERFACE filter_fill_value
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine filter variable value.
+   !>
+   !> @details
+   !> it checks if filtering method is available,
+   !>  gets parameter value, and launch filter__fill_value 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__fill_value_wrapper( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_filter
+      CHARACTER(LEN=lc) :: cl_method
+      INTEGER(I4)       :: il_radius
+      INTEGER(I4)       :: il_nturn
+      REAL(dp)          :: dl_cutoff 
+      REAL(dp)          :: dl_alpha
+
+      TYPE(TATT)        :: tl_att
+
+      ! loop indices
+      INTEGER(I4) :: jl
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("FILTER FILL VALUE: no array of value "//&
+         &  "associted to variable "//TRIM(td_var%c_name) )
+      ELSE
+
+         SELECT CASE(TRIM(td_var%c_filter(1)))
+
+         CASE DEFAULT
+         
+            CALL logger_trace("FILTER FILL VALUE: no filter selected "//&
+            &  "for variable "//TRIM(td_var%c_name))
+
+         CASE('hann','hamming','blackman','gauss','butterworth')
+
+            cl_method=TRIM(td_var%c_filter(1))
+
+            ! look for number of turn to be done
+            READ(td_var%c_filter(2),*) il_nturn
+            IF( il_nturn < 0 )THEN
+               CALL logger_error("FILTER FILL VALUE: invalid "//&
+               &  "number of turn ("//TRIM(td_var%c_filter(2))//")")
+            ENDIF
+
+            ! look for cut-off frequency
+            dl_cutoff=2
+            IF( TRIM(td_var%c_filter(3)) /= '' )THEN
+               READ(td_var%c_filter(3),*) dl_cutoff
+            ENDIF
+            IF( dl_cutoff < 0 )THEN
+               CALL logger_error("FILTER FILL VALUE: invalid cut-off "//&
+               &  "frequency ("//TRIM(td_var%c_filter(3))//")")
+            ENDIF
+
+            ! look for halo size
+            il_radius=1
+            IF( TRIM(td_var%c_filter(4)) /= '' )THEN
+               READ(td_var%c_filter(4),*) il_radius
+            ENDIF
+            IF( il_radius < 0 )THEN
+               CALL logger_error("FILTER FILL VALUE: invalid halo radius "//&
+               &  " ("//TRIM(td_var%c_filter(4))//")")
+            ENDIF
+
+            IF( REAL(2*il_radius+1,dp) < dl_cutoff )THEN
+               CALL logger_error("FILTER FILL VALUE: radius of halo and "//&
+               &  "spatial cut-off frequency are not suitable.")
+            ENDIF
+
+            ! look for alpha parameter
+            dl_alpha=2
+            IF( TRIM(td_var%c_filter(5)) /= '' )THEN
+               READ(td_var%c_filter(5),*) dl_alpha
+            ENDIF
+
+            SELECT CASE(TRIM(cl_method))
+            CASE('gauss','butterworth')
+               CALL logger_info("FILTER FILL VALUE: filtering "//&
+               &   " variable "//TRIM(td_var%c_name)//&
+               &   " using "//TRIM(fct_str(il_nturn))//" turn"//&
+               &   " of "//TRIM(cl_method)//" method,"//&
+               &   " with cut-off frequency of "//&
+               &        TRIM(fct_str(REAL(dl_cutoff,sp)))//&
+               &   ", halo's radius of "//&
+               &        TRIM(fct_str(il_radius))//&
+               &   ", and alpha parameter of "//&
+               &        TRIM(fct_str(REAL(dl_alpha,sp))) )
+            CASE DEFAULT
+               CALL logger_info("FILTER FILL VALUE: filtering "//&
+               &   " variable "//TRIM(td_var%c_name)//&
+               &   " using "//TRIM(fct_str(il_nturn))//" turn"//&
+               &   " of "//TRIM(cl_method)//" method,"//&
+               &   " with cut-off frequency of "//&
+               &        TRIM(fct_str(REAL(dl_cutoff,sp)))//&
+               &   " and halo's radius of "//&
+               &        TRIM(fct_str(il_radius)) )
+            END SELECT
+      
+            IF( .NOT. ANY(td_var%t_dim(1:3)%l_use) )THEN
+               ! no dimension I-J-K used
+               CALL logger_debug("FILTER FILL VALUE: no filtering can "//&
+               &  "be done for variable "//TRIM(td_var%c_name))
+            ELSE 
+
+               ! add attribute to variable
+               SELECT CASE(TRIM(cl_method))
+               CASE('gauss','butterworth')
+                  cl_filter=TRIM(fct_str(il_nturn))//'*'//TRIM(cl_method)//&
+                  &                    '('//TRIM(fct_str(REAL(dl_cutoff,sp)))//","//&
+                  &                         TRIM(fct_str(il_radius))//","//&
+                  &                         TRIM(fct_str(REAL(dl_alpha,sp)))//')'
+               CASE DEFAULT
+                  cl_filter=TRIM(fct_str(il_nturn))//'*'//TRIM(cl_method)//&
+                  &                    '('//TRIM(fct_str(REAL(dl_cutoff,sp)))//","//&
+                  &                         TRIM(fct_str(il_radius))//')'
+               END SELECT
+               tl_att=att_init('filter',cl_filter)
+               CALL var_move_att(td_var,tl_att)
+               ! clean
+               CALL att_clean(tl_att)
+
+               DO jl=1,il_nturn
+                  CALL filter__fill_value( td_var, TRIM(cl_method),  & 
+                  &                        dl_cutoff, il_radius, dl_alpha )
+               ENDDO
+            ENDIF               
+
+         END SELECT
+
+      ENDIF
+   END SUBROUTINE filter__fill_value_wrapper
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine filtering variable value, given cut-off frequency
+   !> halo radius and alpha parameter.
+   !> 
+   !> @details 
+   !>    First extrabands are added to array of variable value.
+   !>    Then values are extrapolated, before apply filter.
+   !>    Finally extrabands are removed.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable 
+   !> @param[in] cd_name   filter name
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__fill_value( td_var, cd_name, &
+   &                              dd_cutoff, id_radius, dd_alpha )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      REAL(dp)        , INTENT(IN   ) :: dd_cutoff 
+      INTEGER(I4)     , INTENT(IN   ) :: id_radius
+      REAL(dp)        , INTENT(IN   ) :: dd_alpha
+
+      ! local variable
+      TYPE(TVAR)                                         :: tl_mask
+
+      INTEGER(i1)      , DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_debug("FILTER: "//TRIM(fct_str(td_var%d_fill)) )
+
+      !1-add extraband
+      CALL extrap_add_extrabands(td_var, id_radius, id_radius)
+
+      !2-compute mask
+      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+      &                td_var%t_dim(2)%i_len, &
+      &                td_var%t_dim(3)%i_len, &
+      &                td_var%t_dim(4)%i_len) )
+
+      bl_mask(:,:,:,:)=1
+      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+      tl_mask=var_init('tmask', bl_mask(:,:,:,:))
+
+      DEALLOCATE(bl_mask)
+
+      !3-extrapolate
+      CALL extrap_fill_value( td_var ) !, id_iext=id_radius, id_jext=id_radius )
+
+      !4-filtering
+      DO jl=1,td_var%t_dim(4)%i_len
+         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
+            ! dimension I-J-K used
+            CALL filter__3D_fill_value( td_var%d_value(:,:,:,jl),       &
+            &                           td_var%d_fill, TRIM(cd_name), &
+            &                           dd_cutoff, id_radius, dd_alpha)
+         ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
+            ! dimension I-J used
+            CALL filter__2D_fill_value( td_var%d_value(:,:,1,jl),       &
+            &                           td_var%d_fill, TRIM(cd_name), &
+            &                           dd_cutoff, id_radius, dd_alpha)         
+         ELSE IF( td_var%t_dim(3)%l_use )THEN 
+            ! dimension K used
+            CALL filter__1D_fill_value( td_var%d_value(1,1,:,jl),       &
+            &                           td_var%d_fill, TRIM(cd_name), &
+            &                           dd_cutoff, id_radius, dd_alpha)         
+         ENDIF
+      ENDDO
+
+      !5-keep original mask
+      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+      END WHERE
+
+      ! clean
+      CALL var_clean(tl_mask)
+
+      !6-remove extraband
+      CALL extrap_del_extrabands(td_var, id_radius, id_radius)
+
+   END SUBROUTINE filter__fill_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute filtered value of 3D array. 
+   !>
+   !> @details
+   !>    First compute filter coefficient.
+   !>    Then apply it on each level of variable value.
+   !>
+   !> @warning array of value should have been already extrapolated before
+   !> running this subroutine.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] cd_name      filter name
+   !> @param[in] dd_cutoff    cut-off frequency
+   !> @param[in] id_radius    filter halo radius
+   !> @param[in] dd_alpha     filter parameter
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__3D_fill_value( dd_value, dd_fill, cd_name, &
+   &                                 dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , DIMENSION(:,:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,                   INTENT(IN   ) :: dd_fill
+      CHARACTER(LEN=*),                   INTENT(IN   ) :: cd_name
+      REAL(dp)        ,                   INTENT(IN   ) :: dd_cutoff
+      INTEGER(i4)     ,                   INTENT(IN   ) :: id_radius
+      REAL(dp)        ,                   INTENT(IN   ) :: dd_alpha      
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3)                :: il_shape
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coef
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+      ALLOCATE( dl_coef(2*id_radius+1,2*id_radius+1) )
+
+      dl_coef(:,:)=filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+
+      DO jk=1,il_shape(3)
+         CALL filter__2D(dd_value(:,:,jk), dd_fill,dl_coef(:,:),id_radius)
+      ENDDO
+
+      DEALLOCATE( dl_coef )
+
+   END SUBROUTINE filter__3D_fill_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute filtered value of 2D array.
+   !
+   !> @details
+   !>    First compute filter coefficient.
+   !>    Then apply it on variable value.
+   !>
+   !> @warning array of value should have been already extrapolated before
+   !> running this subroutine.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] cd_name      filter name
+   !> @param[in] dd_cutoff    cut-off frequency
+   !> @param[in] id_radius    filter halo radius
+   !> @param[in] dd_alpha     filter parameter
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__2D_fill_value( dd_value, dd_fill, cd_name, &
+   &                                 dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_fill
+      CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_name
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_cutoff
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_alpha      
+
+      ! local variable
+
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_coef
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ALLOCATE( dl_coef(2*id_radius+1,2*id_radius+1) )
+
+      dl_coef(:,:)=filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+
+      CALL filter__2D(dd_value(:,:), dd_fill, dl_coef(:,:), id_radius)
+
+      DEALLOCATE( dl_coef )
+
+   END SUBROUTINE filter__2D_fill_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute filtered value of 1D array.
+   !
+   !> @details
+   !>    First compute filter coefficient.
+   !>    Then apply it on variable value.
+   !>
+   !> @warning array of value should have been already extrapolated before
+   !> running this subroutine.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] cd_name      filter name
+   !> @param[in] dd_cutoff    cut-off frequency
+   !> @param[in] id_radius    filter halo radius
+   !> @param[in] dd_alpha     filter parameter
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__1D_fill_value( dd_value, dd_fill, cd_name, &
+   &                                 dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,               INTENT(IN   ) :: dd_fill
+      CHARACTER(LEN=*),               INTENT(IN   ) :: cd_name
+      REAL(dp)        ,               INTENT(IN   ) :: dd_cutoff
+      INTEGER(i4)     ,               INTENT(IN   ) :: id_radius
+      REAL(dp)        ,               INTENT(IN   ) :: dd_alpha      
+
+      ! local variable
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_coef
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ALLOCATE( dl_coef(2*id_radius+1) )
+
+      dl_coef(:)=filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+
+      CALL filter__1D(dd_value(:), dd_fill, dl_coef(:),id_radius)
+
+      DEALLOCATE( dl_coef )
+
+   END SUBROUTINE filter__1D_fill_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine filtered 2D array of value 
+   !>
+   !> @details
+   !>    loop on first and second dimension, 
+   !>    and apply coefficient 2D array on each point
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] dd_coef      filter coefficent array
+   !> @param[in] id_radius    filter halo radius
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__2D(dd_value, dd_fill, dd_coef, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_fill 
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_coef 
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_halo
+
+      ! loop indices
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      ALLOCATE(dl_value(il_shape(1),il_shape(2)))
+      dl_value(:,:)=dd_value(:,:)
+
+      ALLOCATE(dl_halo(2*id_radius+1,2*id_radius+1))
+
+      DO jj=1+id_radius,il_shape(2)-id_radius
+         DO ji=1+id_radius,il_shape(1)-id_radius
+
+            dl_halo(:,:)=dd_fill
+            dl_halo(:,:)=dl_value(ji-id_radius:ji+id_radius, &
+            &                     jj-id_radius:jj+id_radius)
+
+            dd_value(ji,jj)=SUM(dl_halo(:,:)*dd_coef(:,:))
+
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(dl_halo)
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE filter__2D
+   !-------------------------------------------------------------------
+   !> @brief This subroutine filtered 1D array of value  
+   !
+   !> @details
+   !>    loop on first dimension, 
+   !>    and apply coefficient 1D array on each point
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] dd_coef      filter coefficent array
+   !> @param[in] id_radius    filter halo radius
+   !-------------------------------------------------------------------
+   SUBROUTINE filter__1D(dd_value, dd_fill, dd_coef, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,               INTENT(IN   ) :: dd_fill 
+      REAL(dp)        , DIMENSION(:), INTENT(IN   ) :: dd_coef 
+      INTEGER(i4)     ,               INTENT(IN   ) :: id_radius
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_shape(:)=SHAPE(dd_value(:))
+
+      ALLOCATE(dl_value(2*id_radius+1))
+
+      DO ji=1+id_radius,il_shape(1)-id_radius
+
+         dl_value(:)=dd_fill
+         dl_value(:)=dd_value(ji-id_radius:ji+id_radius)
+
+         dd_value(ji)=SUM(dl_value(:)*dd_coef(:))
+
+      ENDDO
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE filter__1D
+   !-------------------------------------------------------------------
+   !> @brief This function compute filter coefficient. 
+   !
+   !> @details
+   !> 
+   !> filter could be choose between :
+   !> - hann
+   !> - hamming
+   !> - blackman
+   !> - gauss
+   !> - butterworth
+   !> Cut-off frequency could be specify.
+   !> As well as a filter parameter for gauss and butterworth filter
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   filter name
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter 
+   !> @return array of filter coefficient
+   !-------------------------------------------------------------------
+   FUNCTION filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(dp)        , INTENT(IN) :: dd_cutoff
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_coef
+
+      ! local variable
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( REAL(id_radius,dp) < dd_cutoff )THEN
+         CALL logger_warn("FILTER COEF: radius of the filter halo "//&
+         &  "is lower than cut-off frequency")
+      ENDIF
+
+      SELECT CASE(TRIM(fct_lower(cd_name)))
+      CASE('hann')
+         filter__2D_coef(:,:)=filter__2D_hann(dd_cutoff, id_radius)
+      CASE('hamming')
+         filter__2D_coef(:,:)=filter__2D_hamming(dd_cutoff, id_radius)
+      CASE('blackman')
+         filter__2D_coef(:,:)=filter__2D_blackman(dd_cutoff, id_radius)
+      CASE('gauss')
+         filter__2D_coef(:,:)=filter__2D_gauss(dd_cutoff, id_radius, dd_alpha)
+      CASE('butterworth')
+         filter__2D_coef(:,:)=filter__2D_butterworth(dd_cutoff, id_radius, dd_alpha)
+      CASE DEFAULT
+         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name))
+      END SELECT
+
+   END FUNCTION filter__2D_coef
+   !-------------------------------------------------------------------
+   !> @brief This function compute filter coefficient. 
+   !
+   !> @details
+   !> 
+   !> filter could be choose between :
+   !> - hann
+   !> - hamming
+   !> - blackman
+   !> - gauss
+   !> - butterworth
+   !> Cut-off frequency could be specify.
+   !> As well as a filter parameter for gauss an butterworth filter
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   filter name
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter 
+   !> @return array of filter coefficient
+   !-------------------------------------------------------------------
+   FUNCTION filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(dp)        , INTENT(IN) :: dd_cutoff
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_coef
+
+      ! local variable
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      SELECT CASE(TRIM(fct_lower(cd_name)))
+      CASE('hann')
+         filter__1D_coef(:)=filter__1D_hann(dd_cutoff, id_radius)
+      CASE('hamming')
+         filter__1D_coef(:)=filter__1D_hamming(dd_cutoff, id_radius)
+      CASE('blackman')
+         filter__1D_coef(:)=filter__1D_blackman(dd_cutoff, id_radius)
+      CASE('gauss')
+         filter__1D_coef(:)=filter__1D_gauss(dd_cutoff, id_radius, dd_alpha)
+      CASE('butterworth')
+         filter__1D_coef(:)=filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha)
+      CASE DEFAULT
+         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name))
+      END SELECT
+
+   END FUNCTION filter__1D_coef
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HANN filter.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hann filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__1D_hann(dd_cutoff, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_hann
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__1D_hann(:)=0.
+         filter__1D_hann(id_radius+1)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad=SQRT(REAL(ji-id_radius+1,dp)**2 )
+            
+            IF( dl_rad < dd_cutoff )THEN
+               filter__1D_hann(ji)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff)
+            ELSE
+               filter__1D_hann(ji)=0
+            ENDIF
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__1D_hann(:))
+
+         filter__1D_hann(:)=filter__1D_hann(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_hann
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HANN filter.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hann filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__2D_hann(dd_cutoff, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)   , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4), INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_hann
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1.0_dp )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__2D_hann(:,:)=0.
+         filter__2D_hann(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               ! radius
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+               
+               IF( dl_rad < dd_cutoff )THEN
+                  filter__2D_hann(ji,jj)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff)
+               ELSE
+                  filter__2D_hann(ji,jj)=0
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__2D_hann(:,:))
+
+         filter__2D_hann(:,:)=filter__2D_hann(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_hann
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HAMMING filter.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hamming filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__1D_hamming(dd_cutoff, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_hamming
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__1D_hamming(:)=0.
+         filter__1D_hamming(id_radius+11)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+         
+            IF( dl_rad < dd_cutoff )THEN
+               filter__1D_hamming(ji)= 0.54 &
+               &                     + 0.46*COS(dp_pi*dl_rad/dd_cutoff)
+            ELSE
+               filter__1D_hamming(ji)=0
+            ENDIF
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__1D_hamming(:))
+
+         filter__1D_hamming(:)=filter__1D_hamming(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_hamming
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HAMMING filter.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hamming filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__2D_hamming(dd_cutoff, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_hamming
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__2D_hamming(:,:)=0.
+         filter__2D_hamming(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+            
+               IF( dl_rad < dd_cutoff )THEN
+                  filter__2D_hamming(ji,jj)= 0.54 &
+                  &                        + 0.46*COS(dp_pi*dl_rad/dd_cutoff)
+               ELSE
+                  filter__2D_hamming(ji,jj)=0
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__2D_hamming(:,:))
+
+         filter__2D_hamming(:,:)=filter__2D_hamming(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_hamming
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BLACKMAN filter.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of blackman filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__1D_blackman(dd_cutoff, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_blackman
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__1D_blackman(:)=0.
+         filter__1D_blackman(id_radius+1)=1.
+      ELSE      
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+            
+            IF( dl_rad < dd_cutoff )THEN
+               filter__1D_blackman(ji)= 0.42 &
+               &                      + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) &
+               &                      + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff)
+            ELSE
+               filter__1D_blackman(ji)=0
+            ENDIF                                
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__1D_blackman(:))
+
+         filter__1D_blackman(:)=filter__1D_blackman(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_blackman
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BLACKMAN filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of blackman filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__2D_blackman(dd_cutoff, id_radius)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_blackman
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__2D_blackman(:,:)=0.
+         filter__2D_blackman(id_radius+1,id_radius+1)=1.
+      ELSE      
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+               
+               IF( dl_rad < dd_cutoff )THEN
+                  filter__2D_blackman(ji,jj)= 0.42 &
+                  &                         + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) &
+                  &                         + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff)
+               ELSE
+                  filter__2D_blackman(ji,jj)=0
+               ENDIF                                
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__2D_blackman(:,:))
+
+         filter__2D_blackman(:,:)=filter__2D_blackman(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_blackman
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for GAUSS filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of gauss filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__1D_gauss(dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_gauss
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__1D_gauss(:)=0.
+         filter__1D_gauss(id_radius+1)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+            
+            filter__1D_gauss(ji)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2))
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__1D_gauss(:))
+
+         filter__1D_gauss(:)=filter__1D_gauss(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_gauss
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for GAUSS filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of gauss filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__2D_gauss(dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_gauss
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         filter__2D_gauss(:,:)=0.
+         filter__2D_gauss(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+               
+               filter__2D_gauss(ji,jj)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2))
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__2D_gauss(:,:))
+
+         filter__2D_gauss(:,:)=filter__2D_gauss(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_gauss
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BUTTERWORTH filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of butterworth filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: filter__1D_butterworth
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff <= 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than 1. No filter will be apply ")
+         filter__1D_butterworth(:)=0.
+         filter__1D_butterworth(id_radius+1)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+            
+            filter__1D_butterworth(ji)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha)
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__1D_butterworth(:))
+
+         filter__1D_butterworth(:)=filter__1D_butterworth(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_butterworth
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BUTTERWORTH filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of butterworth filter coefficient 
+   !-------------------------------------------------------------------
+   FUNCTION filter__2D_butterworth(dd_cutoff,  id_radius, dd_alpha)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: filter__2D_butterworth
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff <= 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than 1. No filter will be apply ")
+         filter__2D_butterworth(:,:)=0.
+         filter__2D_butterworth(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+               
+               filter__2D_butterworth(ji,jj)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha)
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(filter__2D_butterworth(:,:))
+
+         filter__2D_butterworth(:,:)=filter__2D_butterworth(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_butterworth
+END MODULE filter
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/function.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/function.f90	(revision 8732)
@@ -0,0 +1,1024 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: fct
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups some basic useful function.
+!>
+!> @details
+!>  to get free I/O unit number:<br/>
+!> @code
+!>  il_id=fct_getunit()
+!> @endcode
+!>
+!>  to convert "numeric" to string character:<br/>
+!> @code
+!>  cl_string=fct_str(numeric)
+!> @endcode
+!>  - "numeric" could be integer, real, or logical
+!>
+!>  to concatenate "numeric" to a string character:<br/>
+!> @code
+!>  cl_str=cd_char//num
+!> @endcode
+!>  - cd_char is the string character
+!>  - num is the numeric value (integer, real or logical)  
+!>
+!>  to concatenate all the element of a character array:<br/> 
+!> @code
+!>  cl_string=fct_concat(cd_arr [,cd_sep])
+!> @endcode
+!>  - cd_arr is a 1D array of character
+!>  - cd_sep is a separator character to add between each element of cd_arr 
+!> [optional]
+!>
+!>  to convert character from lower to upper case:<br/>
+!> @code
+!>  cl_upper=fct_upper(cd_var)
+!> @endcode
+!>
+!>  to convert character from upper to lower case:<br/>
+!> @code
+!>  cl_lower=fct_lower(cd_var)
+!> @endcode
+!>
+!>  to check if character is numeric
+!> @code
+!>  ll_is_num=fct_is_num(cd_var)
+!> @endcode
+!>
+!>  to check if character is real
+!> @code
+!>  ll_is_real=fct_is_real(cd_var)
+!> @endcode
+!>
+!>  to split string into substring and return one of the element:<br/>  
+!> @code
+!>  cl_str=fct_split(cd_string ,id_ind [,cd_sep])
+!> @endcode
+!>  - cd_string is a string of character
+!>  - id_ind is the indice of the lement to extract
+!>  - cd_sep is the separator use to split cd_string (default '|')
+!>
+!>  to get basename (name without path):<br/>
+!> @code
+!>  cl_str=fct_basename(cd_string [,cd_sep])
+!> @endcode
+!>  - cd_string is the string filename
+!>  - cd_sep is the separator ti be used (default '/')
+!>
+!>  to get dirname (path of the filename):<br/>
+!> @code
+!>  cl_str=fct_dirname(cd_string [,cd_sep])
+!> @endcode
+!>  - cd_string is the string filename
+!>  - cd_sep is the separator ti be used (default '/')
+!>  
+!> to create a pause statement:<br/>
+!> @code
+!> CALL fct_pause(cd_msg)
+!> @endcode
+!>    - cd_msg : message to be added [optional]
+!>
+!> to handle frotran error:<br/>
+!> @code
+!> CALL fct_err(id_status)
+!> @endcode
+!> 
+!> 
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014 
+!> - add header
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE fct
+   USE kind                            ! F90 kind parameter
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: fct_getunit  !< returns free unit number
+   PUBLIC :: fct_str      !< convert numeric to string character
+   PUBLIC :: OPERATOR(//) !< concatenate operator
+   PUBLIC :: fct_concat   !< concatenate all the element of a character array
+   PUBLIC :: fct_upper    !< convert character from lower to upper case
+   PUBLIC :: fct_lower    !< convert character from upper to lower case
+   PUBLIC :: fct_is_num   !< check if character is numeric
+   PUBLIC :: fct_is_real  !< check if character is real
+   PUBLIC :: fct_split    !< split string into substring
+   PUBLIC :: fct_basename !< return basename (name without path)
+   PUBLIC :: fct_dirname  !< return dirname (path without filename)
+   PUBLIC :: fct_pause    !< pause statement
+   PUBLIC :: fct_err      !< handle fortran error status
+
+   PRIVATE :: fct__i1_str ! convert integer(1) to string character
+   PRIVATE :: fct__i2_str ! convert integer(2) to string character
+   PRIVATE :: fct__i4_str ! convert integer(4) to string character
+   PRIVATE :: fct__i8_str ! convert integer(8) to string character
+   PRIVATE :: fct__r4_str ! convert real(4) to string character
+   PRIVATE :: fct__r8_str ! convert real(8) to string character
+   PRIVATE :: fct__l_str  ! convert logical to string character
+   PRIVATE :: fct__i1_cat ! concatenate integer(1) to string character
+   PRIVATE :: fct__i2_cat ! concatenate integer(2) to string character
+   PRIVATE :: fct__i4_cat ! concatenate integer(4) to string character
+   PRIVATE :: fct__i8_cat ! concatenate integer(8) to string character
+   PRIVATE :: fct__r4_cat ! concatenate real(4) to string character
+   PRIVATE :: fct__r8_cat ! concatenate real(8) to string character
+   PRIVATE :: fct__l_cat  ! concatenate logical to string character
+   PRIVATE :: fct__split_space ! split string into substring using space as separator
+
+   INTERFACE fct_str
+      MODULE PROCEDURE fct__i1_str ! convert integer(1) to string character
+      MODULE PROCEDURE fct__i2_str ! convert integer(2) to string character
+      MODULE PROCEDURE fct__i4_str ! convert integer(4) to string character
+      MODULE PROCEDURE fct__i8_str ! convert integer(8) to string character
+      MODULE PROCEDURE fct__r4_str ! convert real(4) to string character
+      MODULE PROCEDURE fct__r8_str ! convert real(8) to string character
+      MODULE PROCEDURE fct__l_str  ! convert logical to string character
+   END INTERFACE fct_str
+
+   INTERFACE OPERATOR(//)
+      MODULE PROCEDURE fct__i1_cat ! concatenate integer(1) to string character
+      MODULE PROCEDURE fct__i2_cat ! concatenate integer(2) to string character
+      MODULE PROCEDURE fct__i4_cat ! concatenate integer(4) to string character
+      MODULE PROCEDURE fct__i8_cat ! concatenate integer(8) to string character
+      MODULE PROCEDURE fct__r4_cat ! concatenate real(4) to string character
+      MODULE PROCEDURE fct__r8_cat ! concatenate real(8) to string character
+      MODULE PROCEDURE fct__l_cat  ! concatenate logical to string character
+   END INTERFACE
+
+CONTAINS
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(1) (as character). 
+   ! 
+   !> @author J.Paul 
+   !> @date September, 2014 - Initial Version 
+   ! 
+   !> @param[in] cd_char   string character
+   !> @param[in] bd_val    integer(1) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i1_cat(cd_char, bd_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i1),       INTENT(IN) :: bd_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(bd_val)
+      fct__i1_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i1_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(2) (as character). 
+   ! 
+   !> @author J.Paul 
+   !> @date September, 2014 - Initial Version 
+   ! 
+   !> @param[in] cd_char   string character
+   !> @param[in] sd_val    integer(2) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i2_cat(cd_char, sd_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i2),       INTENT(IN) :: sd_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(sd_val)
+      fct__i2_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i2_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(4) (as character). 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] cd_char   string character
+   !> @param[in] id_val    integer(4) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i4_cat(cd_char, id_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i4),       INTENT(IN) :: id_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(id_val)
+      fct__i4_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i4_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(8) (as character). 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] cd_char   string character
+   !> @param[in] kd_val    integer(8) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i8_cat(cd_char, kd_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i8),       INTENT(IN) :: kd_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(kd_val)
+      fct__i8_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i8_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and real(4) (as character). 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] cd_char   string character
+   !> @param[in] rd_val    real(4) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__r4_cat(cd_char, rd_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      REAL(sp),          INTENT(IN) :: rd_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(rd_val)
+      fct__r4_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__r4_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and real(8) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] dd_val    real(8) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__r8_cat(cd_char, dd_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      REAL(dp),          INTENT(IN) :: dd_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(dd_val)
+      fct__r8_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__r8_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and logical (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] ld_val    logical variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+   PURE CHARACTER(LEN=lc) FUNCTION fct__l_cat(cd_char, ld_val) 
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      LOGICAL,           INTENT(IN) :: ld_val
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(ld_val)
+      fct__l_cat=TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__l_cat 
+   !------------------------------------------------------------------- 
+   !> @brief This function returns the next available I/O unit number. 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @return file id 
+   !------------------------------------------------------------------- 
+   INTEGER(i4) FUNCTION fct_getunit() 
+ 
+      ! local variable 
+      LOGICAL ::  ll_opened 
+      !---------------------------------------------------------------- 
+      ! initialise 
+      fct_getunit = 10 
+ 
+      INQUIRE(UNIT=fct_getunit, OPENED=ll_opened) 
+      DO WHILE( ll_opened ) 
+         fct_getunit = fct_getunit + 1 
+         INQUIRE(UNIT=fct_getunit, OPENED=ll_opened)  
+      ENDDO 
+ 
+   END FUNCTION fct_getunit 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine handle Fortran status.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] id_status
+   !-------------------------------------------------------------------
+   SUBROUTINE fct_err(id_status)
+
+      ! Argument
+      INTEGER(i4),       INTENT(IN) :: id_status
+      !----------------------------------------------------------------
+
+      IF( id_status /= 0 )THEN
+         !CALL ERRSNS() ! not F95 standard
+         PRINT *, "FORTRAN ERROR ",id_status
+         !STOP
+      ENDIF
+
+   END SUBROUTINE fct_err
+   !-------------------------------------------------------------------
+   !> @brief This subroutine  create a pause statement
+   !
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] cd_msg optional message to be added
+   !-------------------------------------------------------------------
+   SUBROUTINE fct_pause(cd_msg)
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: cd_msg
+      !----------------------------------------------------------------
+
+      IF( PRESENT(cd_msg) )THEN
+         WRITE( *, * ) 'Press Enter to continue '//TRIM(cd_msg)
+      ELSE
+         WRITE( *, * ) 'Press Enter to continue'
+      ENDIF
+      READ( *, * )
+
+   END SUBROUTINE fct_pause
+   !-------------------------------------------------------------------
+   !> @brief This function convert logical to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] ld_var logical variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__l_str(ld_var)
+      IMPLICIT NONE
+      ! Argument      
+      LOGICAL, INTENT(IN) :: ld_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) ld_var
+      fct__l_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__l_str
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(1) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] bd_var integer(1) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i1_str(bd_var)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i1), INTENT(IN) :: bd_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) bd_var
+      fct__i1_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i1_str
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(2) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] sd_var integer(2) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i2_str(sd_var)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i2), INTENT(IN) :: sd_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) sd_var
+      fct__i2_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i2_str
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(4) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] id_var integer(4) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i4_str(id_var)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: id_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) id_var
+      fct__i4_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i4_str
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(8) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] kd_var integer(8) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__i8_str(kd_var)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i8), INTENT(IN) :: kd_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) kd_var
+      fct__i8_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i8_str
+   !-------------------------------------------------------------------
+   !> @brief This function convert real(4) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] rd_var real(4) variable
+   !> @return character of this real variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__r4_str(rd_var)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(sp), INTENT(IN) :: rd_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) rd_var
+      fct__r4_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__r4_str
+   !-------------------------------------------------------------------
+   !> @brief This function convert real(8) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_var real(8) variable
+   !> @return character of this real variable
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct__r8_str(dd_var)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), INTENT(IN) :: dd_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      write(cl_tmp,*) dd_var
+      fct__r8_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__r8_str
+   !-------------------------------------------------------------------
+   !> @brief This function concatenate all the element of a character array 
+   !> in a character string.
+   !> @details
+   !> optionnally a separator could be added between each element.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_arr array of character
+   !> @param[in] cd_sep separator character
+   !> @return character
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct_concat(cd_arr,cd_sep)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr
+      CHARACTER(*),               INTENT(IN), OPTIONAL :: cd_sep
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_sep
+      INTEGER(i4)       :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      cl_sep=''
+      IF(PRESENT(cd_sep)) cl_sep=cd_sep
+
+      il_size=SIZE(cd_arr)
+      fct_concat=''
+      cl_tmp=''
+      DO ji=1,il_size
+
+         WRITE(cl_tmp,*) TRIM(fct_concat)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep)
+         fct_concat=TRIM(ADJUSTL(cl_tmp))
+      
+      ENDDO
+
+   END FUNCTION fct_concat
+   !-------------------------------------------------------------------
+   !> @brief This function convert string character upper case to lower case.
+   !
+   !> @details
+   !> The function IACHAR returns the ASCII value of the character passed 
+   !> as argument. The ASCII code has the uppercase alphabet starting at 
+   !> code 65, and the lower case one at code 101, therefore 
+   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase
+   !> and the lowercase codes.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_var character
+   !> @return lower case character
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct_lower(cd_var)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(*), INTENT(IN) :: cd_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_nletter ! number of letters in variable
+      CHARACTER(LEN=lc)                            :: cl_var
+      CHARACTER(LEN=lc), DIMENSION(:), ALLOCATABLE :: cl_tmp
+
+      INTEGER(i4) :: il_icode    ! ASCII value
+      INTEGER(i4) :: il_lacode   ! ASCII value of the lower case 'a'
+      INTEGER(i4) :: il_uacode   ! ASCII value of the upper case 'A'
+      INTEGER(i4) :: il_uzcode   ! ASCII value of the upper case 'z'
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_lacode=IACHAR('a')
+      il_uacode=IACHAR('A')
+      il_uzcode=IACHAR('Z')
+
+      cl_var=TRIM(ADJUSTL(cd_var))
+      il_nletter=LEN(TRIM(cl_var))
+      ALLOCATE(cl_tmp(il_nletter))
+      DO ji=1,il_nletter
+         il_icode=IACHAR(cl_var(ji:ji))
+         IF( il_icode >= il_uacode .AND. il_icode <= il_uzcode )THEN
+            ! upper case
+            cl_tmp(ji)=TRIM(CHAR(il_icode + (il_lacode - il_uacode) ))
+         ELSE
+            ! lower case and other character
+            cl_tmp(ji)=TRIM(CHAR(il_icode))
+         ENDIF
+      ENDDO
+
+      fct_lower=TRIM(ADJUSTL(fct_concat(cl_tmp(:))))
+      DEALLOCATE(cl_tmp)
+
+   END FUNCTION fct_lower
+   !-------------------------------------------------------------------
+   !> @brief This function convert string character lower case to upper case.
+   !
+   !> @details
+   !> The function IACHAR returns the ASCII value of the character passed 
+   !> as argument. The ASCII code has the uppercase alphabet starting at 
+   !> code 65, and the lower case one at code 101, therefore 
+   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase
+   !> and the lowercase codes.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_var character
+   !> @return upper case character
+   !-------------------------------------------------------------------
+   PURE CHARACTER(LEN=lc) FUNCTION fct_upper(cd_var)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(*), INTENT(IN) :: cd_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_nletter ! number of letters in cd_var
+      CHARACTER(LEN=lc)                            :: cl_var
+      CHARACTER(LEN=lc), DIMENSION(:), ALLOCATABLE :: cl_tmp
+
+      INTEGER(i4) :: il_icode    ! ASCII value
+      INTEGER(i4) :: il_lacode   ! ASCII value of the lower case 'a'
+      INTEGER(i4) :: il_uacode   ! ASCII value of the upper case 'A'
+      INTEGER(i4) :: il_lzcode   ! ASCII value of the lower case 'z'
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_lacode=ICHAR('a')
+      il_uacode=ICHAR('A')
+      il_lzcode=IACHAR('z')
+
+      cl_var=TRIM(ADJUSTL(cd_var))
+      il_nletter=LEN(TRIM(cl_var))
+      ALLOCATE(cl_tmp(il_nletter))
+      DO ji=1,il_nletter
+         il_icode=IACHAR(cl_var(ji:ji))
+         IF( il_icode >= il_lacode .AND. il_icode <= il_lzcode )THEN
+            ! lower case
+            cl_tmp(ji)=CHAR(il_icode - (il_lacode - il_uacode) )
+         ELSE
+            ! upper case and other character
+            cl_tmp(ji)=CHAR(il_icode)
+         ENDIF
+      ENDDO
+
+      fct_upper=TRIM(ADJUSTL(fct_concat(cl_tmp(:))))
+      DEALLOCATE(cl_tmp)
+
+   END FUNCTION fct_upper
+   !-------------------------------------------------------------------
+   !> @brief This function check if character is numeric.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_var character
+   !> @return character is numeric
+   !-------------------------------------------------------------------
+   PURE LOGICAL FUNCTION fct_is_num(cd_var)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,LEN(TRIM(cd_var))
+         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
+         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
+            fct_is_num=.TRUE.
+         ELSE
+            fct_is_num=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION fct_is_num
+   !-------------------------------------------------------------------
+   !> @brief This function check if character is real number.
+   !
+   !> @details
+   !> it allows exponantial and decimal number
+   !> exemple :  1e6, 2.3
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !
+   !> @param[in] cd_var character
+   !> @return character is real number
+   !-------------------------------------------------------------------
+   PURE LOGICAL FUNCTION fct_is_real(cd_var)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+   
+      ! local variables
+      LOGICAL :: ll_exp
+      LOGICAL :: ll_dec
+   
+      ! loop indices
+      INTEGER :: ji
+      !----------------------------------------------------------------
+   
+      ll_exp=.TRUE.
+      ll_dec=.FALSE.
+      DO ji=1,LEN(TRIM(cd_var))
+         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
+         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
+   
+            fct_is_real=.TRUE.
+            ll_exp=.FALSE.
+      
+         ELSEIF( TRIM(cd_var(ji:ji))=='e' )THEN
+         
+            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN
+               fct_is_real=.FALSE.
+               EXIT
+            ELSE 
+               ll_exp=.TRUE.
+            ENDIF
+   
+         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN
+   
+            IF( ll_dec )THEN
+               fct_is_real=.FALSE.
+               EXIT
+            ELSE
+               fct_is_real=.TRUE.
+               ll_dec=.TRUE.
+            ENDIF
+   
+         ELSE
+   
+            fct_is_real=.FALSE.
+            EXIT
+   
+         ENDIF
+      ENDDO
+   
+   END FUNCTION fct_is_real
+   !-------------------------------------------------------------------
+   !> @brief This function split string of character 
+   !> using separator character, by default '|',
+   !> and return the element on index ind.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_string string of character
+   !> @param[in] id_ind    indice
+   !> @param[in] cd_sep    separator character
+   !> @return return the element on index id_ind
+   !-------------------------------------------------------------------
+   PURE FUNCTION fct_split(cd_string, id_ind, cd_sep)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      INTEGER(i4)     , INTENT(IN) :: id_ind
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc) :: fct_split
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_string
+
+      INTEGER(i4) :: il_sep
+      INTEGER(i4) :: il_lsep
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialize
+      fct_split=''
+      cl_string=ADJUSTL(cd_string)
+
+      ! get separator
+      cl_sep='|'
+      IF( PRESENT(cd_sep) )THEN
+         IF( cd_sep==' ')THEN
+            cl_sep=' '
+         ELSE
+            cl_sep=TRIM(ADJUSTL(cd_sep))
+         ENDIF
+      ENDIF
+      
+      IF( cl_sep /= ' ' )THEN
+         ! get separator index
+         il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) )
+         il_lsep=LEN(TRIM(cl_sep)) 
+
+         IF( il_sep /= 0 )THEN
+            fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+         ELSE
+            fct_split=TRIM(ADJUSTL(cl_string))
+         ENDIF
+
+         ji=1
+         DO WHILE( il_sep /= 0 .AND. ji /= id_ind )
+            
+            ji=ji+1
+            
+            cl_string=TRIM(cl_string(il_sep+il_lsep:))
+            il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) )
+
+            IF( il_sep /= 0 )THEN
+               fct_split=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+            ELSE
+               fct_split=TRIM(ADJUSTL(cl_string))
+            ENDIF
+
+         ENDDO
+
+         IF( ji /= id_ind ) fct_split=''
+      ELSE
+         fct_split=fct__split_space(TRIM(cl_string), id_ind)
+      ENDIF
+
+   END FUNCTION fct_split
+   !-------------------------------------------------------------------
+   !> @brief This function split string of character 
+   !> using space as separator, 
+   !> and return the element on index ind.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_string string of character
+   !> @param[in] id_ind    indice
+   !> @return return the element on index id_ind
+   !-------------------------------------------------------------------
+   PURE FUNCTION fct__split_space(cd_string, id_ind)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      INTEGER(i4)     , INTENT(IN) :: id_ind
+
+      ! function
+      CHARACTER(LEN=lc) :: fct__split_space
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_string
+
+      INTEGER(i4) :: il_sep
+      INTEGER(i4) :: il_lsep
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialize
+      fct__split_space=''
+      cl_string=ADJUSTL(cd_string)
+
+      ! get separator index
+      il_sep=INDEX( TRIM(cl_string), ' ' )
+      il_lsep=LEN(' ') 
+
+      IF( il_sep /= 0 )THEN
+         fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+      ELSE
+         fct__split_space=TRIM(ADJUSTL(cl_string))
+      ENDIF
+
+      ji=1
+      DO WHILE( il_sep /= 0 .AND. ji /= id_ind )
+         
+         ji=ji+1
+         
+         cl_string=TRIM(cl_string(il_sep+il_lsep:))
+         il_sep=INDEX( TRIM(cl_string), ' ' )
+
+         IF( il_sep /= 0 )THEN
+            fct__split_space=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+         ELSE
+            fct__split_space=TRIM(ADJUSTL(cl_string))
+         ENDIF
+
+      ENDDO
+
+      IF( ji /= id_ind ) fct__split_space=''
+
+   END FUNCTION fct__split_space
+   !-------------------------------------------------------------------
+   !> @brief This function return basename of a filename.
+   !
+   !> @details
+   !> Actually it splits filename using sperarator '/'
+   !> and return last string character.<br/>
+   !> Optionally you could specify another separator.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_string filename
+   !> @param[in] cd_sep    separator character
+   !> @return basename (filename without path)
+   !-------------------------------------------------------------------
+   PURE FUNCTION fct_basename(cd_string, cd_sep)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc) :: fct_basename
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_string
+      INTEGER(i4)       :: il_sep
+      
+      ! loop indices
+      !----------------------------------------------------------------
+      ! initialize
+      cl_string=TRIM(ADJUSTL(cd_string))
+
+      ! get separator
+      cl_sep='/'
+      IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep))
+
+      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.)
+      fct_basename=TRIM(cl_string(il_sep+1:))
+
+   END FUNCTION fct_basename
+   !-------------------------------------------------------------------
+   !> @brief This function return dirname of a filename.
+   !
+   !> @details
+   !> Actually it splits filename using sperarator '/'
+   !> and return all except last string character.<br/>
+   !> Optionally you could specify another separator.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_string filename
+   !> @param[in] cd_sep    separator character
+   !> @return dirname (path of the filename)
+   !-------------------------------------------------------------------
+   PURE FUNCTION fct_dirname(cd_string, cd_sep)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc) :: fct_dirname
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_string
+      INTEGER(i4)       :: il_sep
+      
+      ! loop indices
+      !----------------------------------------------------------------
+      ! initialize
+      cl_string=TRIM(ADJUSTL(cd_string))
+
+      ! get separator
+      cl_sep='/'
+      IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep))
+
+      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.)
+      IF( il_sep == 0 )THEN
+         fct_dirname=''
+      ELSE
+         fct_dirname=TRIM(cl_string(1:il_sep))
+      ENDIF
+
+   END FUNCTION fct_dirname
+END MODULE fct
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/global.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/global.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/global.f90	(revision 8732)
@@ -0,0 +1,138 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: global
+!
+! DESCRIPTION:
+!> @brief This module defines global variables and parameters.
+!
+!> @author
+!> J.paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - define fill value for each variable type
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE global
+   USE kind                         ! F90 kind parameter
+   USE netcdf
+
+   IMPLICIT NONE
+
+   PUBLIC :: dp_fill         !< default fill value
+   PUBLIC :: ip_nsep         !< number of separator listed
+   PUBLIC :: ip_ncom         !< number of comment character listed
+   PUBLIC :: cp_sep          !< list of separator
+   PUBLIC :: cp_com          !< list of comment character
+
+   PUBLIC :: ip_npoint       !< number of point on ARAKAWA C-grid 
+   PUBLIC :: jp_T            !< indice for T-point on ARAKAWA C-grid
+   PUBLIC :: jp_U            !< indice for U-point on ARAKAWA C-grid
+   PUBLIC :: jp_V            !< indice for V-point on ARAKAWA C-grid
+   PUBLIC :: jp_F            !< indice for F-point on ARAKAWA C-grid
+   PUBLIC :: cp_grid_point   !< list of grid_point character
+
+   PUBLIC :: ip_maxdim       !< maximum number of dimension to be used
+   PUBLIC :: jp_I            !< indice for I-direction
+   PUBLIC :: jp_J            !< indice for J-direction
+   PUBLIC :: jp_K            !< indice for K-direction
+   PUBLIC :: jp_L            !< indice for L-direction
+   PUBLIC :: cp_dimorder     !< dimension order
+
+   PUBLIC :: ip_maxvar       !< maximum number of variable
+   PUBLIC :: ip_maxmtx       !< matrix variable maximum dimension
+   PUBLIC :: ip_maxseg       !< maximum number of segment
+   PUBLIC :: ip_ghost        !< number of ghost cell
+
+   PUBLIC :: ip_ninterp      !< number of available interpolation method
+   PUBLIC :: cp_interp_list  !< list of interpolation name
+   
+   PUBLIC :: ip_nextrap      !< number of available extrapolation method
+   PUBLIC :: cp_extrap_list  !< list of extrapolation name
+   
+   PUBLIC :: ip_nfilter      !< number of available filter
+   PUBLIC :: cp_filter_list  !< list of filter name
+
+   PUBLIC :: ip_ncard        !< number of cardinal point
+   PUBLIC :: cp_card         !< array of cardinal point
+   PUBLIC :: jp_north        !< indice for north boundary
+   PUBLIC :: jp_south        !< indice for south boundary
+   PUBLIC :: jp_east         !< indice for east  boundary
+   PUBLIC :: jp_west         !< indice for west  boundary
+
+   ! NOTE_avoid_public_variables_if_possible
+
+   INTEGER(i4)                             , PARAMETER :: ip_maxvar =200   !< maximum number of variable
+   INTEGER(i4)                             , PARAMETER :: ip_maxmtx =50    !< matrix variable maximum dimension (cf create_bathy)
+   INTEGER(i4)                             , PARAMETER :: ip_maxseg =10    !< maximum number of segment for each boundary
+
+   INTEGER(i4)                             , PARAMETER :: ip_nsep=2        !< number of separator listed
+   CHARACTER(1)     , DIMENSION(ip_nsep)   , PARAMETER :: cp_sep = (/'.','_'/) !< list of separator 
+
+   INTEGER(i4)                             , PARAMETER :: ip_ncom=2        !< number of comment character listed
+   CHARACTER(1)     , DIMENSION(ip_ncom)   , PARAMETER :: cp_com = (/'#','!'/) !< list of comment character 
+    
+   INTEGER(i4)                             , PARAMETER :: ip_ghost=1       !< number of ghost cell
+
+   INTEGER(i4)                             , PARAMETER :: ip_ninterp=3
+   CHARACTER(LEN=lc), DIMENSION(ip_ninterp), PARAMETER :: cp_interp_list = &
+   &  (/ 'nearest', &
+   &     'cubic  ', &
+   &     'linear '  /)
+
+   INTEGER(i4)                             , PARAMETER :: ip_nextrap=2
+   CHARACTER(LEN=lc), DIMENSION(ip_nextrap), PARAMETER :: cp_extrap_list = &
+   &  (/ 'dist_weight', &
+   &     'min_error  ' /)
+
+   INTEGER(i4)                             , PARAMETER :: ip_nfilter=5
+   CHARACTER(LEN=lc), DIMENSION(ip_nfilter), PARAMETER :: cp_filter_list = &
+   &  (/ 'butterworth', &
+   &     'blackman   ', &
+   &     'hamming    ', &
+   &     'hann       ', &
+   &     'gauss      '/)
+
+   REAL(dp)                                , PARAMETER :: dp_fill_i1=NF90_FILL_BYTE   !< byte fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i2=NF90_FILL_SHORT  !< short fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i4=NF90_FILL_INT    !< INT fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_sp=NF90_FILL_FLOAT  !< real fill value
+   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE    !< double fill value
+
+   INTEGER(i4)                             , PARAMETER :: ip_npoint=4
+   INTEGER(i4)                             , PARAMETER :: jp_T=1
+   INTEGER(i4)                             , PARAMETER :: jp_U=2
+   INTEGER(i4)                             , PARAMETER :: jp_V=3
+   INTEGER(i4)                             , PARAMETER :: jp_F=4
+   CHARACTER(LEN=1), DIMENSION(ip_npoint)  , PARAMETER :: cp_grid_point = &
+   &  (/ 'T', 'U', 'V', 'F' /)
+
+
+   INTEGER(i4)                             , PARAMETER :: ip_maxdimcfg=10 !< maximum allowed dimension in configuration file
+   INTEGER(i4)                             , PARAMETER :: ip_maxdim=4
+   INTEGER(i4)                             , PARAMETER :: jp_I=1
+   INTEGER(i4)                             , PARAMETER :: jp_J=2
+   INTEGER(i4)                             , PARAMETER :: jp_K=3
+   INTEGER(i4)                             , PARAMETER :: jp_L=4
+   CHARACTER(LEN=ip_maxdim)                , PARAMETER :: cp_dimorder = 'xyzt' !< dimension order to output
+
+   INTEGER(i4), PARAMETER :: ip_ncard=4
+   CHARACTER(LEN=lc), DIMENSION(ip_ncard), PARAMETER :: cp_card = &
+   &  (/ 'north', &
+   &     'south', &
+   &     'east ', &
+   &     'west ' /)
+
+   INTEGER(i4), PARAMETER :: jp_north=1
+   INTEGER(i4), PARAMETER :: jp_south=2
+   INTEGER(i4), PARAMETER :: jp_east =3
+   INTEGER(i4), PARAMETER :: jp_west =4
+
+   INTEGER(i4)                             , PARAMETER :: ip_maxdumcfg = 10 !< maximum dummy variable, dimension, or attribute 
+                                                                            !< in configuration file
+
+END MODULE global
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid.f90	(revision 8732)
@@ -0,0 +1,6010 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: grid
+!
+! DESCRIPTION:
+!> @brief This module is grid manager.
+!>
+!> @details
+!>    to get NEMO pivot point index:<br/>
+!> @code
+!>    il_pivot=grid_get_pivot(td_file)
+!> @endcode
+!>       - il_pivot is NEMO pivot point index F(0), T(1)
+!>       - td_file is mpp structure 
+!>
+!>    to get NEMO periodicity index:<br/>
+!> @code
+!>    il_perio=grid_get_perio(td_file)
+!> @endcode
+!>       - il_perio is NEMO periodicity index (0,1,2,3,4,5,6)
+!>       - td_file is mpp structure
+!>
+!>    to check domain validity:<br/>
+!> @code
+!>    CALL grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax)
+!> @endcode
+!>       - td_coord is coordinates mpp structure
+!>       - id_imin is i-direction lower left  point indice
+!>       - id_imax is i-direction upper right point indice
+!>       - id_jmin is j-direction lower left  point indice
+!>       - id_jmax is j-direction upper right point indice
+!>
+!>    to get closest coarse grid indices of fine grid domain:<br/>
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_coord0, td_coord1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>    or 
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_coord1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_coord0, td_lon1, td_lat1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_lon1, td_lat1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>       - il_index(:,:) is  coarse grid indices (/ (/ imin0, imax0 /), 
+!> (/ jmin0, jmax0 /) /)
+!>       - td_coord0 is coarse grid coordinate mpp structure 
+!>       - td_coord1 is fine grid coordinate mpp structure
+!>       - td_lon0 is coarse grid longitude variable structure 
+!>       - td_lat0 is coarse grid latitude  variable structure 
+!>       - td_lon1 is fine   grid longitude variable structure 
+!>       - td_lat1 is fine   grid latitude  variable structure 
+!>       - id_rho is array of refinment factor (default 1)
+!>       - cd_point is Arakawa grid point (default 'T')
+!>
+!>    to know if grid is global:<br/>
+!> @code
+!>    ll_global=grid_is_global(td_lon, td_lat)
+!> @endcode
+!>       - td_lon is longitude variable structure
+!>       - td_lat is latitude variable structure
+!>   
+!>    to know if grid contains north fold:<br/>
+!> @code
+!>    ll_north=grid_is_north_fold(td_lat)
+!> @endcode
+!>       - td_lat is latitude variable structure    
+!>
+!>    to get coarse grid indices of the closest point from one fine grid 
+!> point:<br/>
+!> @code
+!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1
+!>                                 [,dd_fill] [,cd_pos])
+!> @endcode
+!>       - il_index(:) is  coarse grid indices (/ i0, j0 /)
+!>       - dd_lon0 is coarse grid array of longitude value (real(8))
+!>       - dd_lat0 is coarse grid array of latitude  value (real(8))
+!>       - dd_lon1 is fine grid longitude value (real(8))
+!>       - dd_lat1 is fine grid latitude  value (real(8))
+!>       - dd_fill
+!>       - cd_pos
+!>
+!>    to compute distance between a point A and grid points:<br/>
+!> @code
+!>    il_dist(:,:)=grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA)
+!> @endcode
+!>       - il_dist(:,:) is array of distance between point A and grid points
+!>       - dd_lon is array of longitude value (real(8))
+!>       - dd_lat is array of longitude value (real(8))
+!>       - dd_lonA is longitude of point A (real(8))
+!>       - dd_latA is latitude  of point A (real(8))
+!>
+!>    to get offset between fine grid and coarse grid:<br/> 
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(td_coord0, 
+!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
+!>                                        td_coord1
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0, 
+!>                                        id_imin0, id_jmin0,id_imax0, id_jmax0,
+!>                                        td_coord1 
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(td_coord0, 
+!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
+!>                                        dd_lon1, dd_lat1 
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0,
+!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
+!>                                        dd_lon1, dd_lat1
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>       - il_offset(:,:) is offset array 
+!>    (/ (/ i_offset_left, i_offset_right /), (/ j_offset_lower, j_offset_upper /) /)
+!>       - td_coord0 is coarse grid coordinate mpp structure 
+!>       - dd_lon0  is coarse grid longitude array (real(8))
+!>       - dd_lat0  is coarse grid latitude  array (real(8))
+!>       - id_imin0 is coarse grid lower left  corner i-indice of fine grid 
+!> domain
+!>       - id_jmin0 is coarse grid lower left  corner j-indice of fine grid 
+!> domain
+!>       - id_imax0 is coarse grid upper right corner i-indice of fine grid 
+!> domain
+!>       - id_jmax0 is coarse grid upper right corner j-indice of fine grid 
+!> domain
+!>       - td_coord1 is fine grid coordinate mpp structure
+!>       - dd_lon1  is fine   grid longitude array (real(8))
+!>       - dd_lat1  is fine   grid latitude  array (real(8))
+!>       - id_rho is array of refinment factor (default 1)
+!>       - cd_point is Arakawa grid point (default 'T')
+!>
+!>    to check fine and coarse grid coincidence:<br/>
+!> @code
+!>    CALL grid_check_coincidence(td_coord0, td_coord1, 
+!>                                id_imin0, id_imax0, id_jmin0, id_jmax0
+!>                                ,id_rho)
+!> @endcode
+!>       - td_coord0 is coarse grid coordinate mpp structure
+!>       - td_coord1 is fine   grid coordinate mpp structure
+!>       - id_imin0  is coarse grid lower left  corner i-indice of fine grid 
+!> domain
+!>       - id_imax0  is coarse grid upper right corner i-indice of fine grid 
+!> domain
+!>       - id_jmin0  is coarse grid lower left  corner j-indice of fine grid 
+!> domain
+!>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid 
+!> domain 
+!>       - id_rho    is array of refinement factor 
+!>
+!>    to add ghost cell at boundaries:<br/>
+!> @code
+!>    CALL grid_add_ghost(td_var, id_ghost)
+!> @endcode
+!>       - td_var is array of variable structure
+!>       - id_ghost is 2D array of ghost cell factor
+!>
+!>    to delete ghost cell at boundaries:<br/>
+!> @code
+!>    CALL grid_del_ghost(td_var, id_ghost)
+!> @endcode
+!>       - td_var is array of variable structure
+!>       - id_ghost is 2D array of ghost cell factor
+!>
+!>    to get ghost cell factor (use or not):<br/>
+!> @code
+!>    il_factor(:)= grid_get_ghost( td_var )
+!> @endcode
+!>    or
+!> @code
+!>    il_factor(:)= grid_get_ghost( td_mpp )
+!> @endcode
+!>       - il_factor(:) is  array of ghost cell factor (0 or 1)
+!>       - td_var  is variable structure
+!>       - td_mpp is mpp sturcture
+!>
+!>    to compute closed sea domain:<br/>
+!> @code
+!>    il_mask(:,:)=grid_split_domain(td_var, [id_level])
+!> @endcode
+!>       - il_mask(:,:) is domain mask
+!>       - td_var is variable strucutre
+!>       - id_level is level to be used [optional] 
+!>
+!>    to fill small closed sea with _FillValue:<br/>
+!> @code
+!>    CALL grid_fill_small_dom(td_var, id_mask, [id_minsize])
+!> @endcode
+!>       - td_var  is variable structure
+!>       - id_mask is domain mask (from grid_split_domain)
+!>       - id_minsize is minimum size of sea to be kept [optional]
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> @date October, 2014
+!> - use mpp file structure instead of file
+!> @date February, 2015
+!> - add function grid_fill_small_msk to fill small domain inside bigger one
+!> @date February, 2016
+!> - improve way to check coincidence (bug fix)
+!> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix)
+!> @date April, 2016
+!> - add function to get closest grid point using coarse grid coordinates strucutre 
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE grid
+   USE netcdf
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: grid_get_info             !< get information about mpp global domain (pivot, perio, ew)
+   PUBLIC :: grid_get_pivot            !< get NEMO pivot point index
+   PUBLIC :: grid_get_perio            !< get NEMO periodicity index
+   PUBLIC :: grid_get_ew_overlap       !< get East West overlap
+   PUBLIC :: grid_check_dom            !< check domain validity 
+   PUBLIC :: grid_get_coarse_index     !< get closest coarse grid indices of fine grid domain.
+   PUBLIC :: grid_is_global            !< check if grid is global or not
+   PUBLIC :: grid_is_north_fold
+   PUBLIC :: grid_get_closest          !< return closest coarse grid point from another point
+   PUBLIC :: grid_distance             !< compute grid distance to a point
+   PUBLIC :: grid_get_fine_offset      !< get fine grid offset
+   PUBLIC :: grid_check_coincidence    !< check fine and coarse grid coincidence
+   PUBLIC :: grid_add_ghost            !< add ghost cell at boundaries.
+   PUBLIC :: grid_del_ghost            !< delete ghost cell at boundaries.
+   PUBLIC :: grid_get_ghost            !< return ghost cell factor
+   PUBLIC :: grid_split_domain         !< compute closed sea domain 
+   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value 
+   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one 
+
+                                     ! get closest coarse grid indices of fine grid domain
+   PRIVATE :: grid__get_coarse_index_ff ! - using coarse and fine grid coordinates files
+   PRIVATE :: grid__get_coarse_index_cf ! - using coarse grid array of lon,lat and fine grid coordinates files
+   PRIVATE :: grid__get_coarse_index_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat
+   PRIVATE :: grid__get_coarse_index_cc ! - using coarse and fine grid array of lon,lat
+
+                                     ! return closest coarse grid point from another point
+   PRIVATE :: grid__get_closest_str    ! - using coarse grid coordinates strucutre
+   PRIVATE :: grid__get_closest_arr    ! - using coarse grid array of lon,lat
+
+                                     ! get offset between fine and coarse grid
+   PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files
+   PRIVATE :: grid__get_fine_offset_cf ! - using coarse grid array of lon,lat and fine grid coordinates files
+   PRIVATE :: grid__get_fine_offset_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat
+   PRIVATE :: grid__get_fine_offset_cc ! - using coarse and fine grid array of lon,lat
+
+                                     ! get information about global domain (pivot, perio, ew)
+   PRIVATE :: grid__get_info_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_info_file     ! - using files structure
+
+                                     ! get NEMO pivot point index
+   PRIVATE :: grid__get_pivot_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_pivot_file     ! - using files structure
+   PRIVATE :: grid__get_pivot_var      ! - using variable structure
+   PRIVATE :: grid__get_pivot_varT   ! compute NEMO pivot point index for variable on grid T 
+   PRIVATE :: grid__get_pivot_varU   ! compute NEMO pivot point index for variable on grid U
+   PRIVATE :: grid__get_pivot_varV   ! compute NEMO pivot point index for variable on grid V
+   PRIVATE :: grid__get_pivot_varF   ! compute NEMO pivot point index for variable on grid F
+
+                                     ! get NEMO periodicity index
+   PRIVATE :: grid__get_perio_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_perio_file     ! - using files structure
+   PRIVATE :: grid__get_perio_var      ! - using variable structure
+
+                                     ! get East West overlap
+   PRIVATE :: grid__get_ew_overlap_mpp  ! - using mpp files structure
+   PRIVATE :: grid__get_ew_overlap_file ! - using files structure
+   PRIVATE :: grid__get_ew_overlap_var  ! - using longitude variable structure
+
+                                    ! return ghost cell factor
+   PRIVATE :: grid__get_ghost_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_ghost_var      ! - using array of lon,lat
+   PRIVATE :: grid__check_corner    ! check that fine grid is inside coarse grid
+   PRIVATE :: grid__check_lat       ! check that fine grid latitude are inside coarse grid latitude
+   
+   INTERFACE  grid_get_info
+      MODULE PROCEDURE grid__get_info_mpp
+      MODULE PROCEDURE grid__get_info_file
+   END INTERFACE grid_get_info
+
+   INTERFACE  grid_get_pivot
+      MODULE PROCEDURE grid__get_pivot_mpp
+      MODULE PROCEDURE grid__get_pivot_file
+      MODULE PROCEDURE grid__get_pivot_var
+   END INTERFACE grid_get_pivot
+
+   INTERFACE  grid_get_perio
+      MODULE PROCEDURE grid__get_perio_mpp
+      MODULE PROCEDURE grid__get_perio_file
+      MODULE PROCEDURE grid__get_perio_var
+   END INTERFACE grid_get_perio
+
+   INTERFACE  grid_get_ew_overlap
+      MODULE PROCEDURE grid__get_ew_overlap_mpp
+      MODULE PROCEDURE grid__get_ew_overlap_file
+      MODULE PROCEDURE grid__get_ew_overlap_var
+   END INTERFACE grid_get_ew_overlap
+
+   INTERFACE  grid_get_ghost
+      MODULE PROCEDURE grid__get_ghost_var
+      MODULE PROCEDURE grid__get_ghost_mpp
+   END INTERFACE  grid_get_ghost
+
+   INTERFACE  grid_get_closest
+      MODULE PROCEDURE grid__get_closest_str
+      MODULE PROCEDURE grid__get_closest_arr
+   END INTERFACE  grid_get_closest
+
+   INTERFACE  grid_get_coarse_index
+      MODULE PROCEDURE grid__get_coarse_index_ff
+      MODULE PROCEDURE grid__get_coarse_index_cf
+      MODULE PROCEDURE grid__get_coarse_index_fc
+      MODULE PROCEDURE grid__get_coarse_index_cc
+   END INTERFACE grid_get_coarse_index
+
+   INTERFACE  grid_get_fine_offset
+      MODULE PROCEDURE grid__get_fine_offset_ff
+      MODULE PROCEDURE grid__get_fine_offset_fc
+      MODULE PROCEDURE grid__get_fine_offset_cf
+      MODULE PROCEDURE grid__get_fine_offset_cc
+   END INTERFACE grid_get_fine_offset   
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get information about global domain, given file
+   !> strucutre.
+   !>
+   !> @details
+   !> open edge files then:
+   !> - compute NEMO pivot point 
+   !> - compute NEMO periodicity
+   !> - compute East West overlap
+   !>
+   !> @note need all processor files to be there
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[inout] td_file file structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid__get_info_file(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_ew
+      INTEGER(i4) :: il_pivot
+      INTEGER(i4) :: il_perio
+      INTEGER(i4) :: il_attid
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TFILE) :: tl_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intialise
+      il_pivot=-1
+      il_perio=-1
+      il_ew   =-1 
+
+      ! copy structure
+      tl_file=file_copy(td_file)
+
+      ! open file to be used
+      CALL iom_open(tl_file)
+
+      IF( td_file%i_perio >= 0 .AND. td_file%i_perio <= 6 )THEN
+         il_perio=td_file%i_perio
+      ELSE
+         ! look for attribute in file
+         il_attid=att_get_index(tl_file%t_att(:),'periodicity')
+         IF( il_attid /= 0 )THEN
+            il_perio=INT(tl_file%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+
+      IF( td_file%i_ew >= 0 )THEN
+         il_ew=td_file%i_ew
+      ELSE
+         ! look for attribute in file
+         il_attid=att_get_index(tl_file%t_att(:),'ew_overlap')
+         IF( il_attid /= 0 )THEN
+            il_ew=INT(tl_file%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+
+      SELECT CASE(il_perio)
+      CASE(3,4)
+         il_pivot=0
+      CASE(5,6)
+         il_pivot=1
+      CASE(0,1,2)
+         il_pivot=1
+      END SELECT
+      
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         ! get pivot
+         il_pivot=grid_get_pivot(tl_file)
+      ENDIF
+
+      IF( il_perio < 0 .OR. il_perio > 6 )THEN
+         ! get periodicity
+         il_perio=grid_get_perio(tl_file, il_pivot)
+      ENDIF
+
+      IF( il_ew < 0 )THEN
+         ! get periodicity
+         il_ew=grid_get_ew_overlap(tl_file)
+      ENDIF
+
+      ! close
+      CALL iom_close(tl_file)
+
+      !save in file structure
+      td_file%i_ew=il_ew
+      td_file%i_pivot=il_pivot
+      td_file%i_perio=il_perio
+
+      ! save in variable of file structure
+      tl_att=att_init("ew_overlap",il_ew)
+      DO ji=1,td_file%i_nvar
+         IF( td_file%t_var(ji)%t_dim(jp_I)%l_use )THEN
+            CALL var_move_att(td_file%t_var(ji),tl_att)
+         ENDIF
+      ENDDO
+
+      ! clean 
+      CALL file_clean(tl_file)
+      CALL att_clean(tl_att)
+
+      IF( td_file%i_perio == -1 )THEN
+         CALL logger_fatal("GRID GET INFO: can not read or compute "//&
+         &  "domain periodicity from file "//TRIM(td_file%c_name)//"."//&
+         &  " you have to inform periodicity in namelist.")
+      ENDIF
+
+   END SUBROUTINE grid__get_info_file
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get information about global domain, given mpp
+   !> structure.
+   !>
+   !> @details
+   !> open edge files then:
+   !> - compute NEMO pivot point 
+   !> - compute NEMO periodicity
+   !> - compute East West overlap
+   !>
+   !> @note need all processor files
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp mpp structure 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid__get_info_mpp(td_mpp)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_ew
+      INTEGER(i4) :: il_pivot
+      INTEGER(i4) :: il_perio
+      INTEGER(i4) :: il_attid
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TMPP)  :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! intialise
+      il_pivot=-1
+      il_perio=-1
+      il_ew   =-1
+
+      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name))
+      ! copy structure
+      tl_mpp=mpp_copy(td_mpp)
+      ! select edge files
+      CALL mpp_get_contour(tl_mpp)
+      ! open mpp file to be used
+      CALL iom_mpp_open(tl_mpp)
+
+      IF( td_mpp%i_perio >= 0 .AND. td_mpp%i_perio <= 6 )THEN
+         il_perio=td_mpp%i_perio
+      ELSE
+         ! look for attribute in mpp files
+         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'periodicity')
+         IF( il_attid /= 0 )THEN
+            il_perio=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+      
+      IF( td_mpp%i_ew >= 0 )THEN
+         il_ew=td_mpp%i_ew
+      ELSE
+         ! look for attribute in mpp files
+         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'ew_overlap')
+         IF( il_attid /= 0 )THEN
+            il_ew=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+
+      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio)))
+
+      SELECT CASE(il_perio)
+         CASE(3,4)
+            il_pivot=1
+         CASE(5,6)
+            il_pivot=0
+         CASE(0,1,2)
+            il_pivot=1
+      END SELECT
+
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         ! get pivot
+         CALL logger_info("GRID GET INFO: look for pivot ")
+         il_pivot=grid_get_pivot(tl_mpp)
+      ENDIF
+
+      IF( il_perio < 0 .OR. il_perio > 6 )THEN
+         ! get periodicity
+         CALL logger_info("GRID GET INFO: look for perio ")
+         il_perio=grid_get_perio(tl_mpp, il_pivot)
+      ENDIF
+
+      IF( il_ew < 0 )THEN
+         ! get periodicity
+         CALL logger_info("GRID GET INFO: look for overlap ")
+         il_ew=grid_get_ew_overlap(tl_mpp)
+      ENDIF
+
+      ! close
+      CALL iom_mpp_close(tl_mpp)
+
+      !save in mpp structure
+      td_mpp%i_ew=il_ew
+      td_mpp%i_pivot=il_pivot
+      td_mpp%i_perio=il_perio
+
+      ! save in variable of mpp structure
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         tl_att=att_init("ew_overlap",il_ew)
+         DO jj=1,td_mpp%i_nproc
+            DO ji=1,td_mpp%t_proc(jj)%i_nvar
+               IF( td_mpp%t_proc(jj)%t_var(ji)%t_dim(jp_I)%l_use )THEN
+                  CALL var_move_att(td_mpp%t_proc(jj)%t_var(ji),tl_att)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_mpp)
+      CALL att_clean(tl_att)
+
+      IF( td_mpp%i_perio == -1 )THEN
+         CALL logger_fatal("GRID GET INFO: can not read or compute "//&
+         &  "domain periodicity from mpp "//TRIM(td_mpp%c_name)//"."//&
+         &  " you have to inform periodicity in namelist.")
+      ENDIF
+
+   END SUBROUTINE grid__get_info_mpp
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index of the input variable.
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @details
+   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
+   !> (T,F,U,V) variable is defined
+   !> 
+   !> @note variable must be at least 2D variable, and should not be coordinate
+   !> variable (i.e lon, lat)
+   !> 
+   !> @warning 
+   !> - do not work with ORCA2 grid (T-point)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - add dummy loop in case variable not over right point.
+   !> @date October, 2014
+   !> - work on variable structure instead of file structure
+   !
+   !> @param[in] td_lat  latitude variable structure
+   !> @param[in] td_var  variable structure
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_var(td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_dim
+
+      REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_var=-1
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. &
+      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
+         CALL logger_error("GRID GET PIVOT: can not compute pivot point"//&
+         &  " with variable "//TRIM(td_var%c_name)//"."//&
+         &  " no value associated or missing dimension.")
+      ELSE
+         il_dim(:)=td_var%t_dim(:)%i_len
+
+         ALLOCATE(dl_value(il_dim(1),4,1,1))
+         ! extract value
+         dl_value(:,:,:,:)=td_var%d_value( 1:il_dim(1),          &
+         &                                 il_dim(2)-3:il_dim(2),&
+         &                                 1:1,                  &
+         &                                 1:1 )
+
+         SELECT CASE(TRIM(td_var%c_point))
+         CASE('T')
+            grid__get_pivot_var=grid__get_pivot_varT(dl_value)
+         CASE('U')
+            grid__get_pivot_var=grid__get_pivot_varU(dl_value)
+         CASE('V')
+            grid__get_pivot_var=grid__get_pivot_varV(dl_value)
+         CASE('F')
+            grid__get_pivot_var=grid__get_pivot_varF(dl_value)
+         END SELECT
+
+         ! dummy loop in case variable not over right point 
+         ! (ex: nav_lon over U-point)
+         IF( grid__get_pivot_var == -1 )THEN
+            
+            ! no pivot point found
+            CALL logger_warn("GRID GET PIVOT: something wrong "//&
+            &  "when computing pivot point with variable "//&
+            &  TRIM(td_var%c_name))
+
+            DO jj=1,ip_npoint
+               SELECT CASE(TRIM(cp_grid_point(jj)))
+               CASE('T')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point T")
+                  grid__get_pivot_var=grid__get_pivot_varT(dl_value)
+               CASE('U')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point U")
+                  grid__get_pivot_var=grid__get_pivot_varU(dl_value)
+               CASE('V')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point V")
+                  grid__get_pivot_var=grid__get_pivot_varV(dl_value)
+               CASE('F')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point F")
+                  grid__get_pivot_var=grid__get_pivot_varF(dl_value)
+               END SELECT
+
+               IF( grid__get_pivot_var /= -1 )THEN
+                  CALL logger_info("GRID GET PIVOT: variable "//&
+                  &  TRIM(td_var%c_name)//" seems to be on grid point "//&
+                  &  TRIM(cp_grid_point(jj)) )
+                  EXIT
+               ENDIF
+
+            ENDDO
+         ENDIF
+
+         IF( grid__get_pivot_var == -1 )THEN
+            CALL logger_warn("GRID GET PIVOT: not able to found pivot point. "//&
+            &  "Force to use pivot point T.")
+            grid__get_pivot_var = 1
+         ENDIF
+
+         ! clean
+         DEALLOCATE(dl_value)
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_var
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid T.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_varT(dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_varT
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_varT=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4  ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=2,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         grid__get_pivot_varT=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            grid__get_pivot_varT=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varT
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid U.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_varU(dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_varU
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_varU=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4 ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=1,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         grid__get_pivot_varU=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            grid__get_pivot_varU=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varU
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid V.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_varV(dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_varV
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_varV=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4 ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=2,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2-1,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         grid__get_pivot_varV=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2-1,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            grid__get_pivot_varV=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varV
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid F.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_varF(dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_varF
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_varF=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4 ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=1,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2-1,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         grid__get_pivot_varF=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2-1,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            grid__get_pivot_varF=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varF
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index from input file variable.
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @details
+   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
+   !> (T,F,U,V) variable is defined
+   !> 
+   !> @warning 
+   !> - do not work with ORCA2 grid (T-point)
+   !>
+   !> @author J.Paul
+   !> @date Ocotber, 2014 - Initial version
+   !
+   !> @param[in] td_file file structure
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_file(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_file
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_north
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_lat
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_file=-1
+
+      ! look for north fold
+      il_varid=var_get_index(td_file%t_var(:), 'latitude')
+      IF( il_varid == 0 )THEN
+         CALL logger_error("GRID GET PIVOT: no variable with name "//&
+         &  "or standard name latitude in file structure "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+      IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN
+         tl_lat=var_copy(td_file%t_var(il_varid))
+      ELSE
+         tl_lat=iom_read_var(td_file, 'latitude')
+      ENDIF
+
+      ll_north=grid_is_north_fold(tl_lat)
+      ! clean
+      CALL var_clean(tl_lat)
+
+      IF( ll_north )THEN      
+         ! look for suitable variable
+         DO ji=1,td_file%i_nvar
+            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+
+            IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
+               tl_var=var_copy(td_file%t_var(ji))
+            ELSE
+               il_dim(:)=td_file%t_var(ji)%t_dim(:)%i_len
+               tl_var=iom_read_var(td_file, &
+               &                   td_file%t_var(ji)%c_name, &
+               &                   id_start=(/1,il_dim(2)-3,1,1/), &
+               &                   id_count=(/il_dim(1),4,1,1/) )
+            ENDIF
+         ENDDO
+
+         IF( ASSOCIATED(tl_var%d_value) )THEN
+
+            grid__get_pivot_file=grid_get_pivot(tl_var)
+
+         ENDIF
+
+         ! clean
+         CALL var_clean(tl_var)
+      ELSE
+         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT")
+         grid__get_pivot_file=1
+      ENDIF
+
+   END FUNCTION grid__get_pivot_file
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index from input mpp variable.
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @details
+   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
+   !> (T,F,U,V) variable is defined
+   !> 
+   !> @warning 
+   !> - do not work with ORCA2 grid (T-point)
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !
+   !> @param[in] td_mpp   mpp file structure
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_pivot_mpp(td_mpp)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+
+      ! function
+      INTEGER(i4) :: grid__get_pivot_mpp
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_north
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_lat
+ 
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_pivot_mpp=-1
+
+      ! look for north fold
+      il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:), 'latitude')
+      IF( il_varid == 0 )THEN
+         CALL logger_error("GRID GET PIVOT: no variable with name "//&
+         &  "or standard name latitude in mpp structure "//&
+         &  TRIM(td_mpp%c_name)//". Assume there is north fold and "//&
+         &  "try to get pivot point")
+
+         ll_north=.TRUE.
+      ELSE
+         IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(il_varid)%d_value) )THEN
+            ! 
+            tl_lat=mpp_recombine_var(td_mpp, 'latitude')
+         ELSE
+            tl_lat=iom_mpp_read_var(td_mpp, 'latitude')
+         ENDIF      
+
+         ll_north=grid_is_north_fold(tl_lat)
+      ENDIF
+
+      IF( ll_north )THEN
+
+         IF( ASSOCIATED(tl_lat%d_value) )THEN
+            grid__get_pivot_mpp=grid_get_pivot(tl_lat)
+         ELSE
+            ! look for suitable variable
+            DO ji=1,td_mpp%t_proc(1)%i_nvar
+               IF(.NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use)) CYCLE
+
+               IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(ji)%d_value) )THEN
+                  CALL logger_debug("GRID GET PIVOT: mpp_recombine_var"//&
+                  &         TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
+                  tl_var=mpp_recombine_var(td_mpp, &
+                  &              TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
+               ELSE
+                  CALL logger_debug("GRID GET PIVOT: iom_mpp_read_var "//&
+                  &        TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
+                  il_dim(:)=td_mpp%t_dim(:)%i_len
+
+                  ! read variable
+                  tl_var=iom_mpp_read_var(td_mpp, &
+                  &                       td_mpp%t_proc(1)%t_var(ji)%c_name, &
+                  &                       id_start=(/1,il_dim(2)-3,1,1/), &
+                  &                       id_count=(/il_dim(1),4,1,1/) )
+               ENDIF
+               EXIT
+            ENDDO
+
+            IF( ASSOCIATED(tl_var%d_value) )THEN
+
+               grid__get_pivot_mpp=grid_get_pivot(tl_var)
+
+           ELSE
+               CALL logger_warn("GRID GET PIVOT: force to use T-PIVOT")
+               grid__get_pivot_mpp=1
+            ENDIF
+
+            ! clean
+            CALL var_clean(tl_var)
+         ENDIF
+      ELSE
+         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT")
+         grid__get_pivot_mpp=1
+      ENDIF
+
+      CALL var_clean(tl_lat)
+   END FUNCTION grid__get_pivot_mpp
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine search NEMO periodicity index given variable structure and
+   !> pivot point index.
+   !> @details
+   !> The variable must be on T point.
+   !>
+   !> 0: closed boundaries
+   !> 1: cyclic east-west boundary
+   !> 2: symmetric boundary condition across the equator
+   !> 3: North fold boundary (with a T-point pivot)
+   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a F-point pivot)
+   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !>
+   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date October, 2014
+   !> - work on variable structure instead of file structure
+   !
+   !> @param[in] td_var   variable structure
+   !> @param[in] id_pivot pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_perio_var(td_var, id_pivot)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      INTEGER(i4), INTENT(IN) :: id_pivot
+
+      ! function
+      INTEGER(i4) :: grid__get_perio_var
+
+      ! local variable
+      INTEGER(i4)                       :: il_perio
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! intitalise
+      grid__get_perio_var=-1
+
+      IF( id_pivot < 0 .OR. id_pivot > 1 )THEN
+         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
+         &  "you should use grid_get_pivot to compute it")
+      ENDIF
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. &
+      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
+         CALL logger_error("GRID GET PERIO: can not compute periodicity"//&
+         &  " with variable "//TRIM(td_var%c_name)//"."//&
+         &  " no value associated or missing dimension.")
+      ELSE
+
+         il_dim(:)=td_var%t_dim(:)%i_len
+
+         CALL logger_debug("GRID GET PERIO: use varibale "//TRIM(td_var%c_name))
+         CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill)))
+         CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1))))
+
+         IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
+         &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.&
+         &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.&
+         &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
+         ! no boundary closed
+            CALL logger_error("GRID GET PERIO: can't determined periodicity. "//&
+            &             "there is no boundary closed for variable "//&
+            &              TRIM(td_var%c_name) )
+            ! check pivot
+            SELECT CASE(id_pivot)
+               CASE(0)
+                  ! F pivot
+                  CALL logger_warn("GRID GET PERIO: assume domain is global")
+                  grid__get_perio_var=6
+               CASE(1)
+                  ! T pivot
+                  CALL logger_warn("GRID GET PERIO: assume domain is global")
+                  grid__get_perio_var=4
+            END SELECT
+         ELSE
+            il_perio=-1
+            ! check periodicity
+            IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
+            &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN
+            ! East-West cyclic (1,4,6)
+
+               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+               ! South boundary not closed 
+
+                  CALL logger_debug("GRID GET PERIO: East_West cyclic")
+                  CALL logger_debug("GRID GET PERIO: South boundary not closed")
+                  CALL logger_error("GRID GET PERIO: should have been an "//&
+                  &              "impossible case")
+
+               ELSE
+               ! South boundary closed (1,4,6)
+                  CALL logger_info("GRID GET PERIO: South boundary closed")
+
+                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN
+                  ! North boundary not closed (4,6)
+                     CALL logger_info("GRID GET PERIO: North boundary not closed")
+                     ! check pivot
+                     SELECT CASE(id_pivot)
+                        CASE(0)
+                           ! F pivot
+                           il_perio=6
+                        CASE(1)
+                           ! T pivot
+                           il_perio=4
+                        CASE DEFAULT
+                           CALL logger_error("GRID GET PERIO: invalid pivot ")
+                     END SELECT
+                  ELSE
+                  ! North boundary closed
+                     CALL logger_info("GRID GET PERIO: North boundary closed")
+                     il_perio=1 ! North and South boundaries closed
+                  ENDIF
+
+               ENDIF
+
+            ELSE
+            ! East-West boundaries closed (0,2,3,5)
+               CALL logger_info("GRID GET PERIO: East West boundaries closed")
+
+               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+               ! South boundary not closed (2)
+                  CALL logger_info("GRID GET PERIO: South boundary not closed")
+
+                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                  ! North boundary not closed
+                     CALL logger_debug("GRID GET PERIO: East West boundaries "//&
+                     &              "closed")
+                     CALL logger_debug("GRID GET PERIO: South boundary not closed")
+                     CALL logger_debug("GRID GET PERIO: North boundary not closed")
+                     CALL logger_error("GRID GET PERIO: should have been "//&
+                     &              "an impossible case")
+                  ELSE
+                  ! North boundary closed
+                     il_perio=2   ! East-West and North boundaries closed 
+                  ENDIF
+
+               ELSE
+               ! South boundary closed (0,3,5)
+                  CALL logger_info("GRID GET PERIO: South boundary closed")
+
+                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                  ! North boundary not closed (3,5)
+                     CALL logger_info("GRID GET PERIO: North boundary not closed")
+                     ! check pivot
+                     SELECT CASE(id_pivot)
+                        CASE(0)
+                           ! F pivot
+                           il_perio=5
+                        CASE(1)
+                           ! T pivot
+                           il_perio=3
+                        CASE DEFAULT
+                           CALL logger_error("GRID GET PERIO: invalid pivot")
+                     END SELECT
+                  ELSE
+                  ! North boundary closed   
+                     CALL logger_info("GRID GET PERIO: North boundary closed")
+                     il_perio=0   ! all boundary closed
+                  ENDIF
+
+               ENDIF
+
+            ENDIF
+
+            grid__get_perio_var=il_perio
+
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_perio_var
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine search NEMO periodicity index given file structure, and
+   !> optionaly pivot point index.
+   !> @details
+   !> The variable used must be on T point.
+   !>
+   !> 0: closed boundaries
+   !> 1: cyclic east-west boundary
+   !> 2: symmetric boundary condition across the equator
+   !> 3: North fold boundary (with a F-point pivot)
+   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a T-point pivot)
+   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !>
+   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_pivot  pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_perio_file(td_file, id_pivot)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
+
+      ! function
+      INTEGER(i4) :: grid__get_perio_file
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4)                       :: il_pivot
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      TYPE(TVAR)                        :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      !initialise
+      grid__get_perio_file=-1
+
+      IF(PRESENT(id_pivot) )THEN
+         il_pivot=id_pivot
+      ELSE
+         il_pivot=grid_get_pivot(td_file)
+      ENDIF
+
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
+         &  "you should use grid_get_pivot to compute it")
+      ENDIF
+
+      ! look for suitable variable
+      il_varid=0
+      DO ji=1,td_file%i_nvar
+         IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+         SELECT CASE(TRIM(fct_lower(td_file%t_var(ji)%c_stdname)) )
+            CASE('longitude','latitude')
+            CASE DEFAULT
+               il_varid=ji
+               EXIT
+         END SELECT
+      ENDDO
+
+      IF( il_varid==0 )THEN
+      
+         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//&
+         &              " periodicity in file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         il_dim(:)= td_file%t_var(il_varid)%t_dim(:)%i_len
+
+         ! read variable
+         tl_var=iom_read_var(td_file, &
+         &                   td_file%t_var(il_varid)%c_name, &
+         &                   id_start=(/1,1,1,1/), &
+         &                   id_count=(/il_dim(1),il_dim(2),1,1/) )
+
+
+         grid__get_perio_file=grid_get_perio(tl_var,il_pivot)
+ 
+         ! clean 
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END FUNCTION grid__get_perio_file
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine search NEMO periodicity given mpp structure and optionaly
+   !> pivot point index.
+   !> @details
+   !> The variable used must be on T point.
+   !>
+   !> 0: closed boundaries
+   !> 1: cyclic east-west boundary
+   !> 2: symmetric boundary condition across the equator
+   !> 3: North fold boundary (with a T-point pivot)
+   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a F-point pivot)
+   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !>
+   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !
+   !> @param[in] td_mpp   mpp file structure
+   !> @param[in] id_pivot pivot point index
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_perio_mpp(td_mpp, id_pivot)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
+
+      ! function
+      INTEGER(i4) :: grid__get_perio_mpp
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4)                       :: il_pivot
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      TYPE(TVAR)                        :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialise
+      grid__get_perio_mpp=-1
+
+      IF(PRESENT(id_pivot) )THEN
+         il_pivot=id_pivot
+      ELSE
+         il_pivot=grid_get_pivot(td_mpp)
+      ENDIF
+
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
+         &  "you should use grid_get_pivot to compute it")
+      ENDIF
+
+      ! look for suitable variable
+      il_varid=0
+      DO ji=1,td_mpp%t_proc(1)%i_nvar
+         IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+         SELECT CASE(TRIM(fct_lower(td_mpp%t_proc(1)%t_var(ji)%c_stdname)) )
+            CASE('longitude','latitude')
+            CASE DEFAULT
+               il_varid=ji
+               EXIT
+         END SELECT
+      ENDDO
+
+      IF( il_varid==0 )THEN
+      
+         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//&
+         &              " periodicity in file "//TRIM(td_mpp%c_name))
+      ELSE
+ 
+         DO ji=1,ip_maxdim
+            IF( td_mpp%t_proc(1)%t_var(il_varid)%t_dim(ji)%l_use )THEN
+               il_dim(ji)=td_mpp%t_dim(ji)%i_len
+            ELSE
+               il_dim(ji)=1
+            ENDIF
+         ENDDO
+
+         ! read variable
+         tl_var=iom_mpp_read_var(td_mpp, &
+         &                       td_mpp%t_proc(1)%t_var(il_varid)%c_name, &
+         &                       id_start=(/1,1,1,1/), &
+         &                       id_count=(/il_dim(1),il_dim(2),1,1/) )
+
+         grid__get_perio_mpp=grid_get_perio(tl_var, il_pivot)
+
+         ! clean 
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION grid__get_perio_mpp
+   !-------------------------------------------------------------------
+   !> @brief This function get East-West overlap.
+   !
+   !> @details
+   !> If no East-West wrap return -1, 
+   !> else return the size of the ovarlap band.
+   !> East-West overlap is computed comparing longitude value of the  
+   !> South part of the domain, to avoid  north fold boundary.
+   !>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date October, 2016
+   !> - check longitude as longname
+   !>
+   !> @param[in] td_lon longitude variable structure 
+   !> @return East West overlap
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_ew_overlap_var(td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      ! function
+      INTEGER(i4) :: grid__get_ew_overlap_var
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_value
+      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_vare
+      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_varw
+
+      REAL(dp)    :: dl_delta
+      REAL(dp)    :: dl_varmax
+      REAL(dp)    :: dl_varmin
+
+      INTEGER(i4) :: il_east
+      INTEGER(i4) :: il_west
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      INTEGER(i4), PARAMETER :: il_max_overlap = 5
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialise
+      grid__get_ew_overlap_var=-1
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         IF( td_var%t_dim(1)%i_len > 1 )THEN
+            il_west=1
+            il_east=td_var%t_dim(1)%i_len
+
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
+            &                  td_var%t_dim(2)%i_len) )
+
+            dl_value(:,:)=td_var%d_value(:,:,1,1)
+
+            ! we do not use jmax as dimension length due to north fold boundary
+            il_jmin=1+ip_ghost
+            il_jmax=(td_var%t_dim(2)%i_len-ip_ghost)/2
+
+            ALLOCATE( dl_vare(il_jmax-il_jmin+1) )
+            ALLOCATE( dl_varw(il_jmax-il_jmin+1) )
+
+            dl_vare(:)=dl_value(il_east,il_jmin:il_jmax)
+            dl_varw(:)=dl_value(il_west,il_jmin:il_jmax)
+
+            IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. &
+            &          ALL(dl_varw(:)==td_var%d_fill) ) )THEN
+
+               IF( TRIM(td_var%c_stdname) == 'longitude' .OR. &
+                 & SCAN( TRIM(td_var%c_longname), 'longitude') == 0 )THEN
+                  WHERE( dl_value(:,:) > 180._dp .AND. &
+                  &      dl_value(:,:) /= td_var%d_fill ) 
+                     dl_value(:,:)=360.-dl_value(:,:)
+                  END WHERE
+
+                  dl_varmax=MAXVAL(dl_value(:,il_jmin:il_jmax))
+                  dl_varmin=MINVAL(dl_value(:,il_jmin:il_jmax))
+
+                  dl_delta=(dl_varmax-dl_varmin)/td_var%t_dim(1)%i_len
+
+                  IF( ALL(ABS(dl_vare(:)) - ABS(dl_varw(:)) == dl_delta) )THEN
+                     grid__get_ew_overlap_var=0
+                  ENDIF
+               ENDIF
+
+               IF( grid__get_ew_overlap_var == -1 )THEN
+                  DO ji=0,il_max_overlap
+
+                     IF( il_east-ji == il_west )THEN
+                        ! case of small domain
+                        EXIT
+                     ELSE
+                        dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax)
+
+                        IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN
+                           grid__get_ew_overlap_var=ji+1
+                           EXIT
+                        ENDIF
+                     ENDIF
+
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDIF
+      ELSE
+         CALL logger_error("GRID GET EW OVERLAP: input variable standard name"//&
+         &  TRIM(td_var%c_stdname)//" can not be used to compute East West "//&
+         &  "overalp. no value associated. ")
+      ENDIF
+
+   END FUNCTION grid__get_ew_overlap_var
+   !-------------------------------------------------------------------
+   !> @brief This function get East-West overlap.
+   !
+   !> @details
+   !> If no East-West wrap return -1, 
+   !> else return the size of the ovarlap band.
+   !> East-West overlap is computed comparing longitude value of the  
+   !> South part of the domain, to avoid  north fold boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !> @date October, 2016
+   !> - check varid for longitude_T
+   !>
+   !> @param[in] td_file file structure 
+   !> @return East West overlap
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_ew_overlap_file(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      ! function
+      INTEGER(i4) :: grid__get_ew_overlap_file
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+
+      TYPE(TVAR)  :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_varid=var_get_id(td_file%t_var(:), 'longitude', 'longitude_T')
+      IF( il_varid /= 0 )THEN
+         ! read longitude on boundary
+         tl_var=iom_read_var(td_file, il_varid)
+      ELSE
+         DO ji=1,td_file%i_nvar
+            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+
+            tl_var=iom_read_var(td_file, td_file%t_var(ji)%c_name)
+            EXIT
+         ENDDO
+      ENDIF
+
+      grid__get_ew_overlap_file=grid_get_ew_overlap(tl_var)
+
+      ! clean
+      CALL var_clean(tl_var)
+
+   END FUNCTION grid__get_ew_overlap_file
+   !-------------------------------------------------------------------
+   !> @brief This function get East-West overlap.
+   !
+   !> @details
+   !> If no East-West wrap return -1, 
+   !> else return the size of the ovarlap band.
+   !> East-West overlap is computed comparing longitude value of the  
+   !> South part of the domain, to avoid  north fold boundary.
+   !>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date October, 2016
+   !> - check varid for longitude_T
+   !>
+   !> @param[in] td_mpp mpp structure 
+   !> @return East West overlap
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_ew_overlap_mpp(td_mpp)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      ! function
+      INTEGER(i4) :: grid__get_ew_overlap_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_ew
+      INTEGER(i4) :: il_varid
+
+      TYPE(TVAR)  :: tl_var
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! initialise
+      grid__get_ew_overlap_mpp=td_mpp%i_ew
+
+      ! read longitude on boundary
+      il_varid=var_get_id(td_mpp%t_proc(1)%t_var(:),'longitude', 'longitude_T')
+      IF( il_varid /= 0 )THEN
+         tl_var=iom_mpp_read_var(td_mpp, il_varid)
+      ELSE
+         DO ji=1,td_mpp%t_proc(1)%i_nvar
+            IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+
+            tl_var=iom_mpp_read_var(td_mpp, td_mpp%t_proc(1)%t_var(ji)%c_name)
+            EXIT
+         ENDDO         
+      ENDIF
+
+      il_ew=grid_get_ew_overlap(tl_var)
+      IF( il_ew >= 0 )THEN
+         grid__get_ew_overlap_mpp=il_ew
+      ENDIF
+
+      ! clean
+      CALL var_clean(tl_var)
+
+   END FUNCTION grid__get_ew_overlap_mpp
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check if there is north fold.
+   !>
+   !> @details
+   !> check if maximum latitude greater than 88°N 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_lat latitude variable structure 
+   !-------------------------------------------------------------------
+   LOGICAL FUNCTION grid_is_north_fold(td_lat)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_lat
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+   
+      ! init
+      grid_is_north_fold=.FALSE.
+
+      IF( .NOT. ASSOCIATED(td_lat%d_value) )THEN
+         CALL logger_error("GRID IS NORTH FOLD: "//&
+         &                 " no value associated to latitude")
+      ELSE      
+         IF( MAXVAL(td_lat%d_value(:,:,:,:), &
+         &          td_lat%d_value(:,:,:,:)/= td_lat%d_fill) >= 88.0 )THEN
+
+            grid_is_north_fold=.TRUE.
+            
+         ENDIF
+      ENDIF
+
+   END FUNCTION grid_is_north_fold
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check domain validity.
+   !
+   !> @details
+   !> If maximum latitude greater than 88°N, program will stop. 
+   !> @note Not able to manage north fold for now.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !
+   !> @param[in] cd_coord  coordinate file 
+   !> @param[in] id_imin   i-direction lower left  point indice  
+   !> @param[in] id_imax   i-direction upper right point indice 
+   !> @param[in] id_jmin   j-direction lower left  point indice 
+   !> @param[in] id_jmax   j-direction upper right point indice 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP) , INTENT(IN) :: td_coord
+      INTEGER(i4), INTENT(IN) :: id_imin
+      INTEGER(i4), INTENT(IN) :: id_imax
+      INTEGER(i4), INTENT(IN) :: id_jmin
+      INTEGER(i4), INTENT(IN) :: id_jmax
+
+      ! local variable
+      TYPE(TVAR) :: tl_var
+
+      TYPE(TMPP) :: tl_coord
+
+      TYPE(TDOM) :: tl_dom
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( id_jmin > id_jmax .OR. id_jmax == 0 )THEN
+
+         CALL logger_fatal("GRID CHECK DOM: invalid domain. "//&
+         &  "can not create configuration with north pole.")
+
+      ELSE
+
+            IF( id_imin == id_imax .AND. td_coord%i_ew < 0 )THEN
+               CALL logger_fatal("GRID CHECK DOM: invalid domain."//&
+               &  " can not create east-west cyclic fine grid"//&
+               &  " inside closed coarse grid")
+            ENDIF
+
+            ! copy structure
+            tl_coord=mpp_copy(td_coord)
+
+            ! compute domain
+            tl_dom=dom_init( tl_coord,        &
+            &                id_imin, id_imax,&
+            &                id_jmin, id_jmax )
+            
+            ! open mpp files to be used
+            CALL iom_dom_open(tl_coord, tl_dom)
+
+            ! read variable value on domain
+            tl_var=iom_dom_read_var(tl_coord,'latitude',tl_dom)
+
+            ! close mpp files
+            CALL iom_dom_close(tl_coord)
+
+            ! clean structure
+            CALL mpp_clean(tl_coord)
+
+            IF( MAXVAL(tl_var%d_value(:,:,:,:), &
+            &          tl_var%d_value(:,:,:,:)/= tl_var%d_fill) >= 88.0 )THEN
+               
+               CALL logger_debug("GRID CHECK DOM: max latitude "//&
+               &  TRIM(fct_str(MAXVAL(tl_var%d_value(:,:,:,:)))) )
+               CALL logger_fatal("GRID CHECK DOM: invalid domain. "//&
+               &  "can not create configuration too close from north pole.")
+
+            ENDIF
+
+            ! clean
+            CALL dom_clean(tl_dom)
+            CALL var_clean(tl_var)
+
+      ENDIF
+
+   END SUBROUTINE grid_check_dom
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !
+   !> @details
+   !> it use coarse and fine grid coordinates files.
+   !> optionally, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use grid point to read coordinates variable. 
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] td_coord1 fine grid coordinate mpp structure
+   !> @param[in] id_rho    array of refinment factor (default 1.)
+   !> @param[in] cd_point  Arakawa grid point (default 'T').
+   !> @return coarse grid indices(/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !>                                     
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_coarse_index_ff( td_coord0, td_coord1, &
+   &                                   id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord0
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_ff
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+
+      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)                               :: tl_coord1
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      grid__get_coarse_index_ff(:,:)=0
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+      tl_coord1=mpp_copy(td_coord1)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. &
+      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: can not get coarse "//&
+         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//&
+         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." )
+      ELSE
+         ! Coarse grid
+         ! get ghost cell factor on coarse grid
+         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+         
+         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         ! Fine grid
+
+         ! get ghost cell factor on fine grid
+         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+ 
+         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         ! compute
+         grid__get_coarse_index_ff(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,&
+         &                                                    tl_lon1,tl_lat1,&
+         &                                                    il_rho(:) )
+
+         ! add ghost cell to indices
+         il_imin0=grid__get_coarse_index_ff(1,1)+il_xghost0(jp_I,1)*ip_ghost
+         il_imax0=grid__get_coarse_index_ff(1,2)+il_xghost0(jp_I,1)*ip_ghost
+
+         il_jmin0=grid__get_coarse_index_ff(2,1)+il_xghost0(jp_J,1)*ip_ghost
+         il_jmax0=grid__get_coarse_index_ff(2,2)+il_xghost0(jp_J,1)*ip_ghost
+
+         grid__get_coarse_index_ff(jp_I,1)=il_imin0
+         grid__get_coarse_index_ff(jp_I,2)=il_imax0
+         grid__get_coarse_index_ff(jp_J,1)=il_jmin0
+         grid__get_coarse_index_ff(jp_J,2)=il_jmax0
+
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)         
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)         
+
+      ENDIF
+
+      ! clean
+      CALL mpp_clean(tl_coord0)
+      CALL mpp_clean(tl_coord1)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_coarse_index_ff
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !
+   !> @details
+   !> it use coarse array of longitude and latitude and fine grid coordinates file.
+   !> optionaly, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use grid point to read coordinates variable.
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
+   !>
+   !> @param[in] td_longitude0   coarse grid longitude
+   !> @param[in] td_latitude0    coarse grid latitude
+   !> @param[in] td_coord1       fine grid coordinate mpp structure
+   !> @param[in] id_rho          array of refinment factor
+   !> @param[in] cd_point        Arakawa grid point (default 'T')
+   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_coarse_index_cf( td_lon0, td_lat0, td_coord1, &
+   &                                   id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR )                   , INTENT(IN) :: td_lon0
+      TYPE(TVAR )                   , INTENT(IN) :: td_lat0
+      TYPE(TMPP )                   , INTENT(IN) :: td_coord1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cf
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
+
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord1
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      grid__get_coarse_index_cf(:,:)=0
+
+      ALLOCATE(il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ! copy structure
+      tl_coord1=mpp_copy(td_coord1)
+      
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord1%c_name)//" not defined." )
+
+      ELSE IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. &
+      &        .NOT. ASSOCIATED(td_lat0%d_value) )THEN
+
+         CALL logger_error("GRID GET COARSE INDEX: some coarse grid"//&
+         &                 " coordinate value are not associated.")         
+
+      ELSE
+         
+         IF( TRIM(td_lon0%c_point)/='' )THEN
+            cl_point=TRIM(td_lon0%c_point)
+         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN
+            cl_point=TRIM(td_lat0%c_point)
+         ENDIF
+
+         ! Fine grid
+         ! get ghost cell factor on fine grid
+         il_xghost(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+         
+         CALL grid_del_ghost(tl_lon1, il_xghost(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         ! compute
+         grid__get_coarse_index_cf(:,:)=grid_get_coarse_index(td_lon0,td_lat0,&
+         &                                                    tl_lon1,tl_lat1,&
+         &                                                    il_rho(:), cl_point )
+
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)         
+
+      ENDIF
+
+      DEALLOCATE(il_rho)
+      CALL mpp_clean(tl_coord1)
+
+   END FUNCTION grid__get_coarse_index_cf
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !
+   !> @details
+   !> it use coarse grid coordinates file and fine grid array of longitude and latitude.
+   !> optionaly, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use grid point to read coordinates variable.
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
+   !> 
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] td_lon1   fine grid longitude
+   !> @param[in] td_lat1   fine grid latitude
+   !> @param[in] id_rho    array of refinment factor (default 1.)
+   !> @param[in] cd_point  Arakawa grid point (default 'T')
+   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_coarse_index_fc( td_coord0, td_lon1, td_lat1, &
+   &                                  id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP )                   , INTENT(IN) :: td_coord0
+      TYPE(TVAR )                   , INTENT(IN) :: td_lon1
+      TYPE(TVAR )                   , INTENT(IN) :: td_lat1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_fc
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name      
+
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+
+      TYPE(TMPP)                               :: tl_coord0
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      grid__get_coarse_index_fc(:,:)=0
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
+
+      ELSE IF( .NOT. ASSOCIATED(td_lon1%d_value) .OR. &
+      &        .NOT. ASSOCIATED(td_lat1%d_value) )THEN
+
+         CALL logger_error("GRID GET COARSE INDEX: some fine grid"//&
+         &                 " coordinate value are not associated.")
+
+      ELSE
+
+         IF( TRIM(td_lon1%c_point)/='' )THEN
+            cl_point=TRIM(td_lon1%c_point)
+         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN
+            cl_point=TRIM(td_lat1%c_point)
+         ENDIF
+
+         ! get ghost cell factor on coarse grid
+         il_xghost(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+         
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         CALL grid_del_ghost(tl_lon0, il_xghost(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         grid__get_coarse_index_fc(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,&
+         &                                                    td_lon1,td_lat1,&
+         &                                                    il_rho(:), cl_point )
+
+         ! remove ghost cell
+         il_imin0=grid__get_coarse_index_fc(1,1)+il_xghost(jp_I,1)*ip_ghost
+         il_imax0=grid__get_coarse_index_fc(1,2)+il_xghost(jp_I,1)*ip_ghost
+
+         il_jmin0=grid__get_coarse_index_fc(2,1)+il_xghost(jp_J,1)*ip_ghost
+         il_jmax0=grid__get_coarse_index_fc(2,2)+il_xghost(jp_J,1)*ip_ghost
+
+         grid__get_coarse_index_fc(1,1)=il_imin0
+         grid__get_coarse_index_fc(1,2)=il_imax0
+         grid__get_coarse_index_fc(2,1)=il_jmin0
+         grid__get_coarse_index_fc(2,2)=il_jmax0
+
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+
+      ENDIF
+
+      CALL mpp_clean(tl_coord0)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_coarse_index_fc
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !
+   !> @details
+   !> it use coarse and fine grid array of longitude and latitude.
+   !> optionaly, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @note do not use ghost cell
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - check grid point
+   !> - take into account EW overlap
+   !> @date February, 2016
+   !> - use delta (lon or lat)
+   !> - manage cases for T,U,V or F point, with even or odd refinment
+   !>
+   !> @param[in] td_lon0   coarse grid longitude
+   !> @param[in] td_lat0   coarse grid latitude
+   !> @param[in] td_lon1   fine grid longitude
+   !> @param[in] td_lat1   fine grid latitude
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] cd_point  Arakawa grid point ('T','U','V','F')
+   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !>
+   !> @todo
+   !> -check case boundary domain on overlap band
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_coarse_index_cc( td_lon0, td_lat0, td_lon1, td_lat1, &
+   &                                   id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)                    , INTENT(IN) :: td_lon0
+      TYPE(TVAR)                    , INTENT(IN) :: td_lat0
+      TYPE(TVAR)                    , INTENT(IN) :: td_lon1
+      TYPE(TVAR)                    , INTENT(IN) :: td_lat1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cc
+
+      ! local variable
+      CHARACTER(LEN= 1)                      :: cl_point0
+      CHARACTER(LEN= 1)                      :: cl_point1
+
+      LOGICAL    , DIMENSION(2)              :: ll_even
+
+      REAL(dp)                               :: dl_lon1
+      REAL(dp)                               :: dl_dlon
+      REAL(dp)                               :: dl_lat1
+      REAL(dp)                               :: dl_dlat
+
+      INTEGER(i4)                            :: il_ew0 
+      INTEGER(i4)                            :: il_imin0
+      INTEGER(i4)                            :: il_imax0
+      INTEGER(i4)                            :: il_jmin0
+      INTEGER(i4)                            :: il_jmax0
+
+      INTEGER(i4)                            :: il_ew1 
+      INTEGER(i4)                            :: il_imin1
+      INTEGER(i4)                            :: il_imax1
+      INTEGER(i4)                            :: il_jmin1
+      INTEGER(i4)                            :: il_jmax1
+
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4)                            :: il_jmin
+      INTEGER(i4)                            :: il_jmax      
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2)              :: il_ill
+      INTEGER(i4), DIMENSION(2)              :: il_ilr
+      INTEGER(i4), DIMENSION(2)              :: il_iul
+      INTEGER(i4), DIMENSION(2)              :: il_iur
+
+      INTEGER(i4), DIMENSION(2,2)            :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)            :: il_yghost0
+      INTEGER(i4), DIMENSION(2,2)            :: il_xghost1
+      INTEGER(i4), DIMENSION(2,2)            :: il_yghost1
+
+      TYPE(TVAR)                             :: tl_lon0
+      TYPE(TVAR)                             :: tl_lat0
+      TYPE(TVAR)                             :: tl_lon1
+      TYPE(TVAR)                             :: tl_lat1
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      grid__get_coarse_index_cc(:,:)=0
+
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
+
+      cl_point0='T'
+      cl_point1='T'
+      IF( PRESENT(cd_point) )THEN
+         cl_point0=TRIM(fct_upper(cd_point))
+         cl_point1=TRIM(fct_upper(cd_point))
+      ENDIF
+      
+      IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lat0%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lon1%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lat1%d_value) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: some fine or coarse grid"//&
+         &                 " coordinate value not associated.")
+      ELSE
+
+         IF( TRIM(td_lon0%c_point)/='' )THEN
+            cl_point0=TRIM(td_lon0%c_point)
+         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN
+            cl_point0=TRIM(td_lat0%c_point)
+         ENDIF
+         IF( TRIM(td_lon1%c_point)/='' )THEN
+            cl_point1=TRIM(td_lon1%c_point)
+         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN
+            cl_point1=TRIM(td_lat1%c_point)
+         ENDIF
+         IF( cl_point0 /= cl_point1 )THEN
+            CALL logger_error("GRID GET COARSE INDEX: fine and coarse grid"//&
+         &                 " coordinate not on same grid point.")
+         ENDIF
+
+         IF( grid_is_global(td_lon1, td_lat1) )THEN
+
+            IF( grid_is_global(td_lon0, td_lat0) )THEN
+               CALL logger_trace("GRID GET COARSE INDEX: fine grid is global ")
+               grid__get_coarse_index_cc(:,:) = 1
+               grid__get_coarse_index_cc(:,:) = 0
+            ELSE
+               CALL logger_error("GRID GET COARSE INDEX: fine grid is "//&
+               &                 "global, coarse grid not.")
+            ENDIF
+
+         ELSE
+
+            il_xghost0(:,:)=grid_get_ghost( td_lon0 )
+            il_yghost0(:,:)=grid_get_ghost( td_lat0 )
+            IF( ANY(il_xghost0(:,:) /= il_yghost0(:,:)) )THEN
+               CALL logger_error("GRID GET COARSE INDEX: coarse grid "//&
+               &        "coordinate do not share same ghost cell")
+            ENDIF
+
+            tl_lon0=var_copy(td_lon0)
+            tl_lat0=var_copy(td_lat0)
+            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+ 
+            ! "global" coarse grid indice
+            il_imin0=1
+            il_jmin0=1
+
+            il_imax0=tl_lon0%t_dim(1)%i_len
+            il_jmax0=tl_lon0%t_dim(2)%i_len
+
+            ! get east west overlap for coarse grid
+            il_ew0=tl_lon0%i_ew
+            IF( il_ew0 >= 0 )THEN
+               ! last point before overlap
+               il_imax0=il_imax0-il_ew0
+            ENDIF
+
+            il_xghost1(:,:)=grid_get_ghost( td_lon1 )
+            il_yghost1(:,:)=grid_get_ghost( td_lat1 )
+            IF( ANY(il_xghost1(:,:) /= il_yghost1(:,:)) )THEN
+               CALL logger_error("GRID GET COARSE INDEX: fine grid "//&
+               &        "coordinate do not share same ghost cell")
+            ENDIF
+
+            tl_lon1=var_copy(td_lon1)
+            tl_lat1=var_copy(td_lat1)
+            CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+            CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+            
+            ! "global" fine grid indice
+            il_imin1=1
+            il_jmin1=1
+
+            il_imax1=tl_lon1%t_dim(1)%i_len
+            il_jmax1=tl_lon1%t_dim(2)%i_len
+
+            ! get east west overlap for fine grid
+            il_ew1=tl_lon1%i_ew
+            IF( il_ew1 >= 0 )THEN
+               ! last point before overlap
+               il_imax1=il_imax1-il_ew1
+            ENDIF
+
+            ! get indices for each corner
+            !1- search lower left corner indices
+            dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//&
+               &                 "point is FillValue. remove ghost cell "//&
+               &                 "before running grid_get_coarse_index.")
+            ENDIF
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
+                        &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
+                  &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
+                        &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
+                  &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 + dl_dlon
+            dl_lat1 = dl_lat1 + dl_dlat
+
+            ! look for closest point on coarse grid
+            il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           tl_lat0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           dl_lon1, dl_lat1, 'll'   )
+
+
+            !2- search upper left corner indices
+            dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: upper left corner "//&
+               &                 "point is FillValue. remove ghost cell "//&
+               &                 "running grid_get_coarse_index.")
+            ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
+                        &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
+                  &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
+                        &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
+                  &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 + dl_dlon
+            dl_lat1 = dl_lat1 - dl_dlat
+
+            ! look for closest point on coarse grid
+            il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           tl_lat0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           dl_lon1, dl_lat1, 'ul' )
+
+            !3- search lower right corner indices
+            dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: lower right corner "//&
+               &                 "point is FillValue. remove ghost cell "//&
+               &                 "running grid_get_coarse_index.")
+            ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
+                        &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
+                  &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
+                        &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
+                  &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 - dl_dlon
+            dl_lat1 = dl_lat1 + dl_dlat
+
+            ! look for closest point on coarse grid
+            il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           tl_lat0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           dl_lon1, dl_lat1, 'lr' )
+
+            !4- search upper right corner indices
+            dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: upper right corner "//&
+               &                 "point is FillValue. remove ghost cell "//&
+               &                 "before running grid_get_coarse_index.")
+            ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
+                        &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
+                  &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
+                        &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
+                  &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 - dl_dlon
+            dl_lat1 = dl_lat1 - dl_dlat
+
+            ! look for closest point on coarse grid
+            il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           tl_lat0%d_value(il_imin0:il_imax0, &
+            &                                           il_jmin0:il_jmax0, &
+            &                                           1,1), &
+            &                           dl_lon1, dl_lat1, 'ur' )
+
+            ! coarse grid indices
+            il_imin = il_imin0-1+MIN(il_ill(1), il_iul(1))
+            il_imax = il_imin0-1+MAX(il_ilr(1), il_iur(1))
+
+            IF( il_imax <= il_ew0 )THEN
+               !il_imin = 1
+               il_imax = tl_lon0%t_dim(1)%i_len - il_ew0 + il_imax 
+            ENDIF
+
+            il_jmin = il_jmin0-1+MIN(il_ill(2), il_ilr(2))
+            il_jmax = il_jmin0-1+MAX(il_iul(2), il_iur(2))
+
+            ! special case if east west overlap
+            IF( il_ew1 >= 0 )THEN
+               CALL logger_debug("GRID GET COARSE INDEX: East-West overlap "//&
+               &                 "found for fine grid " )
+
+               il_imin = 1
+               il_imax = tl_lon0%t_dim(1)%i_len
+
+            ENDIF
+         ENDIF
+
+         grid__get_coarse_index_cc(1,1) = il_imin
+         grid__get_coarse_index_cc(1,2) = il_imax
+
+         grid__get_coarse_index_cc(2,1) = il_jmin
+         grid__get_coarse_index_cc(2,2) = il_jmax
+ 
+         ! clean 
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+      ENDIF
+
+      DEALLOCATE( il_rho )
+
+   END FUNCTION grid__get_coarse_index_cc
+   !-------------------------------------------------------------------
+   !> @brief This function check if grid is global or not
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_lon longitude structure 
+   !> @param[in] td_lat latitude structure 
+   !-------------------------------------------------------------------
+   FUNCTION grid_is_global(td_lon, td_lat)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_lon
+      TYPE(TVAR), INTENT(IN) :: td_lat
+
+      ! function
+      LOGICAL :: grid_is_global
+      
+      ! local variable
+      INTEGER(i4)               :: il_ew
+      INTEGER(i4)               :: il_south
+      INTEGER(i4)               :: il_north
+
+      REAL(dp)                  :: dl_lat_min
+      REAL(dp)                  :: dl_lat_max
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      grid_is_global=.FALSE.
+
+      IF( ANY( td_lon%t_dim(:)%i_len /= td_lat%t_dim(:)%i_len )  )THEN
+         CALL logger_fatal("GRID IS GLOBAL: dimension of longitude and "//&
+         &              " latitude differ")
+      ENDIF
+
+      IF( .NOT. ASSOCIATED(td_lon%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lat%d_value) )THEN
+         CALL logger_error("GRID IS GLOBAL: no value associated to "//&
+         &              " longitude or latitude strucutre")      
+      ELSE
+
+         il_south=1
+         il_north=td_lon%t_dim(2)%i_len
+
+         dl_lat_min=MINVAL(td_lat%d_value(:,il_south,1,1))
+         dl_lat_max=MAXVAL(td_lat%d_value(:,il_north,1,1))
+
+         IF( dl_lat_min < -77.0 .AND. dl_lat_max > 89.0 )THEN
+
+            il_ew=td_lon%i_ew
+            IF( il_ew >= 0 )THEN
+
+               grid_is_global=.TRUE.
+
+            ENDIF
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION grid_is_global
+   !-------------------------------------------------------------------
+   !> @brief This function return grid indices of the closest point
+   !> from point (lon1,lat1) 
+   !> 
+   !> @details
+   !>
+   !> @note overlap band should have been already removed from coarse grid array 
+   !> of longitude and latitude, before running this function
+   !>
+   !> if you add cd_pos argument, you could choice to return closest point at
+   !> - lower left  (ll) of the point
+   !> - lower right (lr) of the point
+   !> - upper left  (ul) of the point
+   !> - upper right (ur) of the point
+   !> - lower       (lo) of the point
+   !> - upper       (up) of the point
+   !> -       left  (le) of the point
+   !> -       right (ri) of the point
+   !>
+   !> @author J.Paul
+   !> @date April, 2016 - Initial Version
+   !> @date October, 2016
+   !> - use max of zero and east-west overlap instead of east-west overlap
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] dd_lon1   fine   grid longitude
+   !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] cd_pos    relative position of grid point from point 
+   !> @param[in] dd_fill   fill value
+   !> @return coarse grid indices of closest point of fine grid point
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_closest_str( td_coord0, dd_lon1, dd_lat1, cd_pos, dd_fill ) &
+   &  RESULT(id_res)
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP )     , INTENT(IN) :: td_coord0
+      REAL(dp),         INTENT(IN) :: dd_lon1
+      REAL(dp),         INTENT(IN) :: dd_lat1
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_pos
+      REAL(dp),         INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      INTEGER(i4), DIMENSION(2) :: id_res
+
+      ! local variable
+      CHARACTER(LEN=lc)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_ind
+      INTEGER(i4)                              :: il_ew
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TMPP)                               :: tl_coord0
+      !----------------------------------------------------------------
+
+      id_res(:)=-1
+      cl_point='T'
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+
+         CALL logger_error("GRID GET CLOSEST: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
+
+      ELSE
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+ 
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET CLOSEST: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+ 
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET CLOSEST: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         il_ew=MAX(0,tl_coord0%i_ew)
+         ALLOCATE(dl_lon0(tl_coord0%t_dim(jp_I)%i_len-il_ew, &
+            &             tl_coord0%t_dim(jp_J)%i_len) )             
+         ALLOCATE(dl_lat0(tl_coord0%t_dim(jp_I)%i_len-il_ew, &
+            &             tl_coord0%t_dim(jp_J)%i_len) )
+
+         dl_lon0(:,:)=tl_lon0%d_value(il_ew+1:,:,1,1)
+         dl_lat0(:,:)=tl_lat0%d_value(il_ew+1:,:,1,1)
+
+         id_res(:)=grid_get_closest( dl_lon0, dl_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
+
+         DEALLOCATE(dl_lon0, dl_lat0)
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+         CALL mpp_clean(tl_coord0)
+
+      ENDIF
+
+   END FUNCTION  grid__get_closest_str
+   !-------------------------------------------------------------------
+   !> @brief This function return grid indices of the closest point
+   !> from point (lon1,lat1) 
+   !> 
+   !> @details
+   !>
+   !> @note overlap band should have been already removed from coarse grid array 
+   !> of longitude and latitude, before running this function
+   !>
+   !> if you add cd_pos argument, you could choice to return closest point at
+   !> - lower left  (ll) of the point
+   !> - lower right (lr) of the point
+   !> - upper left  (ul) of the point
+   !> - upper right (ur) of the point
+   !> - lower       (lo) of the point
+   !> - upper       (up) of the point
+   !> -       left  (le) of the point
+   !> -       right (ri) of the point
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015
+   !> - change dichotomy method to manage ORCA grid
+   !> @date February, 2016
+   !> - add optional use of relative position
+   !
+   !> @param[in] dd_lon0   coarse grid array of longitude
+   !> @param[in] dd_lat0   coarse grid array of latitude
+   !> @param[in] dd_lon1   fine   grid longitude
+   !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] cd_pos    relative position of grid point from point 
+   !> @param[in] dd_fill   fill value
+   !> @return coarse grid indices of closest point of fine grid point
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_closest_arr( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp),                 INTENT(IN) :: dd_lon1
+      REAL(dp),                 INTENT(IN) :: dd_lat1
+      CHARACTER(LEN=*),         INTENT(IN), OPTIONAL :: cd_pos
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      INTEGER(i4), DIMENSION(2) :: grid__get_closest_arr
+
+      ! local variable
+      INTEGER(i4)                              :: il_iinf
+      INTEGER(i4)                              :: il_imid
+      INTEGER(i4)                              :: il_isup
+      INTEGER(i4)                              :: il_jinf
+      INTEGER(i4)                              :: il_jmid
+      INTEGER(i4)                              :: il_jsup
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(1)                :: il_ind
+    
+      LOGICAL                                  :: ll_north
+      LOGICAL                                  :: ll_continue
+
+      REAL(dp)                                 :: dl_lon1
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dist
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ANY( SHAPE(dd_lon0(:,:)) /= SHAPE(dd_lat0(:,:)) ) )THEN
+         CALL logger_fatal("GRID GET CLOSEST: dimension of longitude and "//&
+         &              " latitude differ")
+      ENDIF
+
+      il_shape(:)=SHAPE(dd_lon0(:,:))
+      
+      ALLOCATE( dl_lon0(il_shape(1),il_shape(2)) ) 
+      
+      dl_lon0(:,:) = dd_lon0(:,:)
+      WHERE(dd_lon0(:,:) < 0 ) dl_lon0(:,:) = dd_lon0(:,:) + 360.
+
+      dl_lon1 = dd_lon1
+      IF( dd_lon1 < 0 ) dl_lon1 = dd_lon1 + 360.
+
+      ! first, use dichotomy to reduce domain
+      il_iinf = 1              ; il_jinf = 1
+      il_isup = il_shape(1)    ; il_jsup = il_shape(2)
+
+      il_shape(1)= il_isup - il_iinf + 1
+      il_shape(2)= il_jsup - il_jinf + 1
+
+      ll_north=.FALSE.
+      ll_continue=.FALSE.
+
+      ! avoid to use fillvalue for reduce domain on first time
+      IF( PRESENT(dd_fill) )THEN
+         DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) )
+            il_isup=il_isup-1
+         ENDDO
+         DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) )
+            il_iinf=il_iinf+1
+         ENDDO
+         DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) )
+            il_jsup=il_jsup-1
+         ENDDO
+         DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) )
+            il_jinf=il_jinf+1
+         ENDDO
+
+         il_shape(1)= il_isup - il_iinf + 1
+         il_shape(2)= il_jsup - il_jinf + 1
+
+      ENDIF
+
+      ! special case for north ORCA grid
+      IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN
+         ll_north=.TRUE.
+      ENDIF
+
+      IF( .NOT. ll_north )THEN
+         ! look for meridian 0°/360°
+         il_jmid = il_jinf + INT(il_shape(2)/2)
+         il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), &
+         &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp )
+
+         il_imid=il_ind(1)
+
+         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
+         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
+
+            il_iinf = il_imid ;  il_isup = il_imid
+            il_jinf = il_jmid ;  il_jsup = il_jmid
+
+         ELSE
+            IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. &
+            &   il_imid /= il_isup )THEN
+               ! 0 < lon1 < lon0(isup)
+               ! point east
+               il_iinf = il_imid+1
+               ll_continue=.TRUE.
+         
+            ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. &
+            &        il_imid /= il_iinf )THEN
+               ! lon0(iinf) < lon1 < 360
+               ! point west
+               il_isup = il_imid
+               ll_continue=.TRUE.
+
+            ENDIF
+
+            il_shape(1)= il_isup - il_iinf + 1
+            il_shape(2)= il_jsup - il_jinf + 1
+
+            il_imid = il_iinf + INT(il_shape(1)/2) 
+            il_jmid = il_jinf + INT(il_shape(2)/2)
+
+            ! exit when close enough of point
+            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         ENDIF
+      ENDIF
+
+      !
+      DO WHILE( ll_continue .AND. .NOT. ll_north )
+
+         ll_continue=.FALSE.
+         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
+         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
+
+            il_iinf = il_imid ;  il_isup = il_imid
+            il_jinf = il_jmid ;  il_jsup = il_jmid
+
+         ELSE
+            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN    
+
+               ! point east
+               il_iinf = il_imid
+               ll_continue=.TRUE.
+        
+            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN    
+
+               ! point west
+               il_isup = il_imid
+               ll_continue=.TRUE.
+
+            ENDIF
+
+            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN    
+               
+               ! point north
+               il_jinf = il_jmid
+               ll_continue=.TRUE.
+
+            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN    
+
+               ! point south
+               il_jsup = il_jmid
+               ll_continue=.TRUE.
+            
+            ENDIF
+
+            il_shape(1)= il_isup - il_iinf + 1
+            il_shape(2)= il_jsup - il_jinf + 1
+
+            il_imid = il_iinf + INT(il_shape(1)/2) 
+            il_jmid = il_jinf + INT(il_shape(2)/2)
+
+            ! exit when close enough of point
+            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         ENDIF
+         
+      ENDDO
+
+      ! then find closest point by computing distances
+      il_shape(1)= il_isup - il_iinf + 1
+      il_shape(2)= il_jsup - il_jinf + 1
+
+      ALLOCATE( dl_dist(il_shape(1), il_shape(2)) )
+
+      dl_dist(:,:)=grid_distance(dl_lon0(il_iinf:il_isup,il_jinf:il_jsup), &
+      &                          dd_lat0(il_iinf:il_isup,il_jinf:il_jsup), &
+      &                          dl_lon1, dd_lat1 )
+
+      IF( PRESENT(cd_pos) )THEN
+         ! 
+         SELECT CASE(TRIM(cd_pos))
+            CASE('le')
+               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('ri')
+               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('up')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('lo')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('ll')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('lr')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE               
+            CASE('ul')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE               
+            CASE('ur')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+         END SELECT
+      ENDIF
+      grid__get_closest_arr(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)
+
+      grid__get_closest_arr(1)=grid__get_closest_arr(1)+il_iinf-1
+      grid__get_closest_arr(2)=grid__get_closest_arr(2)+il_jinf-1
+
+      DEALLOCATE( dl_dist )
+      DEALLOCATE( dl_lon0 )
+
+   END FUNCTION grid__get_closest_arr
+   !-------------------------------------------------------------------
+   !> @brief This function compute the distance between a point A and grid points.  
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_lon    grid longitude array
+   !> @param[in] dd_lat    grid latitude  array
+   !> @param[in] dd_lonA   longitude of point A
+   !> @param[in] dd_latA   latitude  of point A
+   !> @param[in] dd_fill
+   !> @return array of distance between point A and grid points.
+   !-------------------------------------------------------------------
+   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA )
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat
+      REAL(dp),                 INTENT(IN) :: dd_lonA
+      REAL(dp),                 INTENT(IN) :: dd_latA
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_lon(:,:),DIM=1),&
+      &                   SIZE(dd_lon(:,:),DIM=2)) :: grid_distance
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2) :: il_shape
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat
+      REAL(dp)                                 :: dl_lonA
+      REAL(dp)                                 :: dl_latA
+
+      REAL(dp)                                 :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( ANY( SHAPE(dd_lon(:,:)) /= SHAPE(dd_lat(:,:)) ) )THEN
+         CALL logger_fatal("GRID DISTANCE: dimension of longitude and "//&
+         &              " latitude differ")
+      ENDIF
+      il_shape(:)=SHAPE(dd_lon(:,:))
+      
+      ALLOCATE(dl_lon(il_shape(1),il_shape(2)))
+      ALLOCATE(dl_lat(il_shape(1),il_shape(2)))
+
+      dl_lon(:,:) = dd_lon(:,:)
+      dl_lonA     = dd_lonA
+
+      WHERE(dd_lon(:,:) < 0 ) dl_lon(:,:) = dd_lon(:,:) + 360.
+      IF(   dd_lonA     < 0 ) dl_lonA     = dd_lonA     + 360.
+      
+      dl_lonA = dd_lonA * dp_deg2rad
+      dl_latA = dd_latA * dp_deg2rad
+
+      dl_lon(:,:) = dl_lon(:,:) * dp_deg2rad
+      dl_lat(:,:) = dd_lat(:,:) * dp_deg2rad
+
+      grid_distance(:,:)=NF90_FILL_DOUBLE
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            IF( dl_lon(ji,jj) == dl_lonA .AND. &
+            &   dl_lat(ji,jj) == dl_latA )THEN
+               grid_distance(ji,jj)=0.0
+            ELSE
+               dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + &
+               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * &
+               &       COS(dl_lon(ji,jj)-dl_lonA)
+               ! check to avoid mistake with ACOS
+               IF( dl_tmp < -1.0 ) dl_tmp = -1.0
+               IF( dl_tmp >  1.0 ) dl_tmp =  1.0
+               grid_distance(ji,jj)=ACOS(dl_tmp)*dp_rearth
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(dl_lon)
+      DEALLOCATE(dl_lat)
+
+   END FUNCTION grid_distance
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !
+   !> @details
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !> offset value could be 0,1,..,rho-1
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !
+   !> @param[in] td_coord0 coarse grid coordinate 
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] td_coord1 fine   grid coordinate 
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_fine_offset_ff( td_coord0, &
+   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
+   &                                  td_coord1, id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord0
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord1
+
+      INTEGER(i4)                   , INTENT(IN) :: id_imin0
+      INTEGER(i4)                   , INTENT(IN) :: id_jmin0
+      INTEGER(i4)                   , INTENT(IN) :: id_imax0
+      INTEGER(i4)                   , INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_ff
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+      
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)                               :: tl_coord1
+      
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      grid__get_fine_offset_ff(:,:)=-1
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+      tl_coord1=mpp_copy(td_coord1)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. &
+      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET FINE OFFSET: can not get coarse "//&
+         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//&
+         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." )
+      ELSE      
+         !1- Coarse grid
+         ! get ghost cell factor on coarse grid
+         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
+         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
+         &                tl_lon0%t_dim(jp_J)%i_len ))
+
+         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, &
+         &                tl_lat0%t_dim(jp_J)%i_len ))
+
+         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+
+         ! adjust coarse grid indices
+         il_imin0=id_imin0-il_xghost0(jp_I,1)
+         il_imax0=id_imax0-il_xghost0(jp_I,1)
+
+         il_jmin0=id_jmin0-il_xghost0(jp_J,1)
+         il_jmax0=id_jmax0-il_xghost0(jp_J,1)
+
+         !2- Fine grid
+         ! get ghost cell factor on fine grid
+         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+ 
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+
+         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, &
+         &                tl_lon1%t_dim(jp_J)%i_len ))
+
+         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, &
+         &                tl_lat1%t_dim(jp_J)%i_len ))
+
+         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)
+ 
+         !3- compute
+         grid__get_fine_offset_ff(:,:)=grid_get_fine_offset( &
+         &                                         dl_lon0(:,:), dl_lat0(:,:),&
+         &                                         il_imin0, il_jmin0, &
+         &                                         il_imax0, il_jmax0, &
+         &                                         dl_lon1(:,:), dl_lat1(:,:),&
+         &                                         id_rho(:), cl_point )
+ 
+         DEALLOCATE(dl_lon0, dl_lat0)
+         DEALLOCATE(dl_lon1, dl_lat1)
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_coord0)
+      CALL mpp_clean(tl_coord1)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_fine_offset_ff
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !
+   !> @details
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !> offset value could be 0,1,..,rho-1
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !
+   !> @param[in] dd_lon0   coarse grid longitude array 
+   !> @param[in] dd_lat0   coarse grid latitude  array
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] td_coord1 fine   grid coordinate 
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_fine_offset_cf( dd_lon0, dd_lat0, &
+   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
+   &                                  td_coord1, id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      TYPE(TMPP)                     , INTENT(IN) :: td_coord1
+
+      INTEGER(i4)                    , INTENT(IN) :: id_imin0
+      INTEGER(i4)                    , INTENT(IN) :: id_jmin0
+      INTEGER(i4)                    , INTENT(IN) :: id_imax0
+      INTEGER(i4)                    , INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)               , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cf
+
+      ! local variable
+      INTEGER(i4)                              :: il_ind
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
+
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord1
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      grid__get_fine_offset_cf(:,:)=-1
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord1=mpp_copy(td_coord1)
+
+      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord1%c_name)//" not defined." )
+      ELSE      
+
+         ! Fine grid
+         ! get ghost cell factor on fine grid
+         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+ 
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+
+         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, &
+         &                tl_lon1%t_dim(jp_J)%i_len ))
+
+         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, &
+         &                tl_lat1%t_dim(jp_J)%i_len ))
+
+         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)
+      
+         ! compute
+         grid__get_fine_offset_cf(:,:)=grid_get_fine_offset( &
+         &                                         dd_lon0(:,:), dd_lat0(:,:),&
+         &                                         id_imin0, id_jmin0, &
+         &                                         id_imax0, id_jmax0, &
+         &                                         dl_lon1(:,:), dl_lat1(:,:),&
+         &                                         id_rho(:), cl_point )
+         
+         DEALLOCATE(dl_lon1, dl_lat1)
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_coord1)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_fine_offset_cf
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !
+   !> @details
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !> offset value could be 0,1,..,rho-1
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !
+   !> @param[in] td_coord0 coarse grid coordinate 
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] dd_lon1   fine   grid longitude array 
+   !> @param[in] dd_lat1   fine   grid latitude  array
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_fine_offset_fc( td_coord0, &
+   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
+   &                                  dd_lon1, dd_lat1, &
+   &                                  id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)                      , INTENT(IN) :: td_coord0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      INTEGER(i4)                     , INTENT(IN) :: id_imin0
+      INTEGER(i4)                     , INTENT(IN) :: id_jmin0
+      INTEGER(i4)                     , INTENT(IN) :: id_imax0
+      INTEGER(i4)                     , INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_fc
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+      
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+
+      TYPE(TMPP)                               :: tl_coord0
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      grid__get_fine_offset_fc(:,:)=-1
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
+      ELSE      
+         !1- Coarse grid
+         ! get ghost cell factor on coarse grid
+         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitude and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+ 
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
+
+         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
+         &                tl_lon0%t_dim(jp_J)%i_len ))
+
+         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, &
+         &                tl_lat0%t_dim(jp_J)%i_len ))
+
+         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+
+         ! adjust coarse grid indices
+         il_imin0=id_imin0-il_xghost0(jp_I,1)
+         il_imax0=id_imax0-il_xghost0(jp_I,1)
+
+         il_jmin0=id_jmin0-il_xghost0(jp_J,1)
+         il_jmax0=id_jmax0-il_xghost0(jp_J,1)
+
+         !3- compute
+         grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(&
+         &                                         dl_lon0(:,:), dl_lat0(:,:),&
+         &                                         il_imin0, il_jmin0, &
+         &                                         il_imax0, il_jmax0, &
+         &                                         dd_lon1(:,:), dd_lat1(:,:),&
+         &                                         id_rho(:), cl_point )
+         
+         DEALLOCATE(dl_lon0, dl_lat0)
+      ENDIF
+
+      ! clean
+      CALL mpp_clean(tl_coord0)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_fine_offset_fc
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !
+   !> @details
+   !> offset value could be 0,1,..,rho-1
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - rename from grid_get_fine_offset
+   !> @date May, 2015 
+   !> - improve way to find offset
+   !> @date July, 2015
+   !> - manage case close to greenwich meridian
+   !> @date February, 2016
+   !> - use grid_get_closest to assess offset
+   !> - use delta (lon or lat)
+   !> - manage cases for T,U,V or F point, with even or odd refinment
+   !> - check lower left(upper right) fine grid point inside lower left(upper
+   !> right) coarse grid cell.
+   !> 
+   !> @todo check case close from North fold.
+   !>
+   !> @param[in] dd_lon0   coarse grid longitude array 
+   !> @param[in] dd_lat0   coarse grid latitude  array
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] dd_lon1   fine   grid longitude array 
+   !> @param[in] dd_lat1   fine   grid latitude  array
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, &
+   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, &
+   &                                  dd_lon1, dd_lat1, id_rho, cd_point )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      INTEGER(i4)     ,                 INTENT(IN) :: id_imin0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_jmin0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_imax0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN) :: id_rho
+      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cc
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+
+      INTEGER(i4)                              :: i1
+      INTEGER(i4)                              :: i2
+      INTEGER(i4)                              :: j1
+      INTEGER(i4)                              :: j2
+
+      INTEGER(i4), DIMENSION(2)                :: il_shape0
+      INTEGER(i4), DIMENSION(2)                :: il_shape1
+
+      INTEGER(i4), DIMENSION(2)                :: il_ind
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+
+      REAL(dp)                                 :: dl_lonmax0
+      REAL(dp)                                 :: dl_latmax0
+      REAL(dp)                                 :: dl_lonmin0
+      REAL(dp)                                 :: dl_latmin0
+
+      REAL(dp)                                 :: dl_lon0F
+      REAL(dp)                                 :: dl_lat0F
+      REAL(dp)                                 :: dl_dlon
+      REAL(dp)                                 :: dl_dlat
+
+      LOGICAL    , DIMENSION(2)                :: ll_even
+      LOGICAL                                  :: ll_greenwich
+      
+      ! loop indices
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+      !----------------------------------------------------------------
+      IF( ANY( SHAPE(dd_lon0(:,:)) /= SHAPE(dd_lat0(:,:)) ) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: dimension of coarse "//&
+         &              "longitude and latitude differ")
+      ENDIF
+
+      IF( ANY( SHAPE(dd_lon1(:,:)) /= SHAPE(dd_lat1(:,:)) ) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//&
+         &              "longitude and latitude differ")
+      ENDIF
+
+      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      il_shape0(:)=SHAPE(dd_lon0(:,:))
+      ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) )
+
+      il_shape1(:)=SHAPE(dd_lon1(:,:))
+      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) )
+
+      dl_lon0(:,:)=dd_lon0(:,:)
+      WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360.
+
+      dl_lon1(:,:)=dd_lon1(:,:)
+      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.
+
+      ! init
+      grid__get_fine_offset_cc(:,:)=-1
+      ll_greenwich=.FALSE.
+
+      IF( il_shape1(jp_J) == 1 )THEN
+ 
+         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2)
+
+         !!! work on i-direction
+         !!! look for i-direction left offset
+         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
+         j1=1 ; j2=1
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. &
+           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! max lognitude of the left cell
+         dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0)
+         IF( dl_lon1(1,1) < dl_lonmax0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
+                        &       dl_lon0(id_imin0  ,id_jmin0) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
+                  &       dl_lon0(id_imin0  ,id_jmin0) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon
+            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0)
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'le' )
+      
+            ii=il_ind(1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid left corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+         !!!!!! look for i-direction right offset !!!!!!
+         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
+         j1=1                                         ; j2=1
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. &
+           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! min lognitude of the right cell
+         dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0)
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
+                        &       dl_lon0(id_imax0-1,id_jmin0) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
+                  &       dl_lon0(id_imax0-1,id_jmin0) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon
+            dl_lat0F= dd_lat0(id_imax0-1,id_jmin0)
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'ri' )
+
+            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid right corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+      ELSEIF( il_shape1(jp_I) == 1 )THEN
+         
+         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2)
+         
+         !!! work on j-direction
+         !!! look for j-direction lower offset 
+         i1=1 ; i2=1
+         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
+
+
+         ! max latitude of the lower cell
+         dl_latmax0=dd_lat0(id_imin0,id_jmin0+1)
+         IF( dd_lat1(1,1) < dl_latmax0 )THEN
+
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
+                        &       dd_lat0(id_imin0,id_jmin0  ) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
+                  &       dd_lat0(id_imin0,id_jmin0  ) ) / &
+                  &     ( 2.*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0,id_jmin0+1)
+            dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat 
+            
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'lo' )
+
+            ij=il_ind(2)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid lower corner.")
+         ENDIF
+
+         !!! look for j-direction upper offset 
+         i1=1                                         ; i2=1
+         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
+
+         ! min latitude of the upper cell
+         dl_latmin0=dd_lat0(id_imin0,id_jmax0-1)
+         IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
+
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
+                        &       dd_lat0(id_imin0,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
+                  &       dd_lat0(id_imin0,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0,id_jmax0-1) 
+            dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat
+            
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'up' )
+
+            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid upper corner.")
+         ENDIF
+
+      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1 
+
+         !!!!!! look for lower left offset !!!!!!
+         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
+         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. &
+           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! max longitude of the lower left cell
+         dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1))
+         ! max latitude of the lower left cell
+         dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1))
+         IF( dl_lon1(1,1) < dl_lonmax0 .AND. &
+           & dd_lat1(1,1) < dl_latmax0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
+                        &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
+                  &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
+                        &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
+                  &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
+                  &     ( 2.*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon
+            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'll' )
+
+            ii=il_ind(1)
+            ij=il_ind(2)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     grid__get_fine_offset_cc(jp_J,1)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
+            &                 " not match fine grid lower left corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360 
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+         !!!!!! look for upper right offset !!!!!!
+         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
+         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. &
+           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! min latitude of the upper right cell
+         dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0))
+         ! min latitude of the upper right cell
+         dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1))
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. &
+           & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
+                        &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT               
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
+                  &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_I) )
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
+                        &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
+                  &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon
+            dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'ur' )
+
+            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
+            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
+            &                 " not match fine grid upper right corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+      ENDIF
+
+      DEALLOCATE( dl_lon0 )
+      DEALLOCATE( dl_lon1 )
+
+      IF( ANY(grid__get_fine_offset_cc(:,:)==-1) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: can not found "//&
+         &                 " offset between coarse and fine grid.")
+      ENDIF
+
+   END FUNCTION grid__get_fine_offset_cc
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check fine and coarse grid coincidence.
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013- Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2016
+   !> - use F-point to check coincidence for even refinment
+   !> - use F-point estimation, if can not read it.
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate file structure 
+   !> @param[in] td_coord1 fine   grid coordinate file structure 
+   !> @param[in] id_imin0  coarse grid lower left  corner i-indice of fine grid domain 
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain 
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain  
+   !> @param[in] id_rho    array of refinement factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, &
+   &                                  id_imin0, id_imax0, &
+   &                                  id_jmin0, id_jmax0, &
+   &                                  id_rho )
+      IMPLICIT NONE
+      
+      ! Argument      
+      TYPE(TMPP)               , INTENT(IN) :: td_coord0
+      TYPE(TMPP)               , INTENT(IN) :: td_coord1
+      INTEGER(i4)              , INTENT(IN) :: id_imin0
+      INTEGER(i4)              , INTENT(IN) :: id_imax0
+      INTEGER(i4)              , INTENT(IN) :: id_jmin0
+      INTEGER(i4)              , INTENT(IN) :: id_jmax0
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
+
+      ! local variable
+      INTEGER(i4)               :: il_imid1
+      INTEGER(i4)               :: il_jmid1
+      
+      INTEGER(i4)               :: il_ew0
+      INTEGER(i4)               :: il_ew1
+
+      INTEGER(i4)               :: il_ind
+
+      INTEGER(i4)               :: il_imin1
+      INTEGER(i4)               :: il_imax1
+      INTEGER(i4)               :: il_jmin1
+      INTEGER(i4)               :: il_jmax1
+
+      INTEGER(i4), DIMENSION(2) :: il_ind0
+      INTEGER(i4), DIMENSION(2) :: il_ind1
+
+      INTEGER(i4), DIMENSION(2) :: il_ill1
+      INTEGER(i4), DIMENSION(2) :: il_ilr1
+      INTEGER(i4), DIMENSION(2) :: il_iul1
+      INTEGER(i4), DIMENSION(2) :: il_iur1
+
+      REAL(dp)                  :: dl_lon0F
+      REAL(dp)                  :: dl_lat0F
+      REAL(dp)                  :: dl_lon0
+      REAL(dp)                  :: dl_lat0
+      REAL(dp)                  :: dl_lon1F
+      REAL(dp)                  :: dl_lat1F
+      REAL(dp)                  :: dl_lon1
+      REAL(dp)                  :: dl_lat1
+
+      REAL(dp)                  :: dl_delta
+
+      LOGICAL                   :: ll_coincidence
+      LOGICAL                   :: ll_even
+      LOGICAL                   :: ll_grid0F
+      LOGICAL                   :: ll_grid1F
+
+      TYPE(TVAR)                :: tl_lon0
+      TYPE(TVAR)                :: tl_lat0
+      TYPE(TVAR)                :: tl_lon0F
+      TYPE(TVAR)                :: tl_lat0F
+      TYPE(TVAR)                :: tl_lon1
+      TYPE(TVAR)                :: tl_lat1
+      TYPE(TVAR)                :: tl_lon1F
+      TYPE(TVAR)                :: tl_lat1F
+
+      TYPE(TMPP)                :: tl_coord0
+      TYPE(TMPP)                :: tl_coord1
+
+      TYPE(TDOM)                :: tl_dom0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ll_coincidence=.TRUE.
+
+      ll_even=.FALSE.
+      IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN
+         ll_even=.TRUE.
+      ENDIF
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      ! compute domain
+      tl_dom0=dom_init( tl_coord0,         &
+      &                 id_imin0, id_imax0,&
+      &                 id_jmin0, id_jmax0 )
+
+      ! open mpp files
+      CALL iom_dom_open(tl_coord0, tl_dom0)
+
+      ! read variable value on domain
+      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T')
+      IF( il_ind /= 0 )THEN
+         tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0)
+      ELSE
+         tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0)
+      ENDIF
+
+      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T')
+      IF( il_ind /= 0 )THEN
+         tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0)
+      ELSE
+         tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0)
+      ENDIF
+
+      IF( ll_even )THEN
+
+         ! look for variable value on domain for F point
+         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0)
+         ENDIF
+
+         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0)
+         ENDIF
+
+         ll_grid0F=.FALSE.
+         IF( ASSOCIATED(tl_lon0F%d_value) .AND. &
+         &   ASSOCIATED(tl_lat0F%d_value) )THEN
+            ll_grid0F=.TRUE.
+         ENDIF
+
+      ENDIF
+
+      ! close mpp files
+      CALL iom_dom_close(tl_coord0)
+
+      ! clean structure
+      CALL mpp_clean(tl_coord0)
+      CALL dom_clean(tl_dom0)
+
+      ! copy structure
+      tl_coord1=mpp_copy(td_coord1)
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord1)
+
+      ! read fine longitue and latitude
+      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname))
+      IF( il_ind /= 0 )THEN
+         tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname))
+      ELSE
+         tl_lon1=iom_mpp_read_var(tl_coord1,'longitude')
+      ENDIF
+      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname))
+      IF( il_ind /= 0 )THEN
+         tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname))
+      ELSE
+         tl_lat1=iom_mpp_read_var(tl_coord1,'latitude')
+      ENDIF
+      
+      IF( ll_even )THEN
+
+         ! look for variable value on domain for F point
+         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F')
+         ENDIF
+
+         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F')
+         ENDIF
+
+         ll_grid1F=.FALSE.
+         IF( ASSOCIATED(tl_lon1F%d_value) .AND. &
+         &   ASSOCIATED(tl_lat1F%d_value) )THEN
+            ll_grid1F=.TRUE.
+         ENDIF
+
+      ENDIF
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord1)
+      ! clean structure
+      CALL mpp_clean(tl_coord1)
+
+      CALL logger_debug("GRID CHECK COINCIDENCE:"//&
+      &        " fine   grid "//TRIM(td_coord1%c_name) )
+      CALL logger_debug("GRID CHECK COINCIDENCE:"//&
+      &        " coarse grid "//TRIM(td_coord0%c_name) )
+
+      ! check domain
+      ! check global grid
+      IF( .NOT. grid_is_global(tl_lon0, tl_lat0) )THEN
+         IF( grid_is_global(tl_lon1, tl_lat1) )THEN
+
+            ll_coincidence=.FALSE.
+            CALL logger_fatal("GRID CHECK COINCIDENCE:"//&
+            &        " fine   grid is global,"//&
+            &        " coarse grid is not ")
+
+         ELSE
+            il_ew1=tl_lon1%i_ew
+            IF( il_ew1 >= 0 )THEN
+               ! ew overlap
+
+               il_ew0=tl_lon0%i_ew
+               IF( il_ew0 < 0 )THEN
+                  CALL logger_fatal("GRID CHECK COINCIDENCE: "//&
+                  &        "fine grid has east west overlap,"//&
+                  &        " coarse grid not ")
+               ENDIF
+
+               il_jmin1=1+ip_ghost
+               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost
+
+               ll_coincidence=grid__check_lat(&
+               &                     tl_lat0%d_value(1,:,1,1),&
+               &                     tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1))
+
+            ELSE
+               ! other case
+               il_imin1=1+ip_ghost
+               il_jmin1=1+ip_ghost
+
+               il_imax1=tl_lon1%t_dim(1)%i_len-ip_ghost
+               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost
+
+               ll_coincidence=grid__check_corner(&
+               &                      tl_lon0%d_value(:,:,1,1),&
+               &                      tl_lat0%d_value(:,:,1,1),&
+               &                      tl_lon1%d_value(il_imin1:il_imax1, &
+               &                                      il_jmin1:il_jmax1, &
+               &                                      1,1),&
+               &                      tl_lat1%d_value(il_imin1:il_imax1, &
+               &                                      il_jmin1:il_jmax1, &
+               &                                      1,1) )
+
+            ENDIF
+ 
+         ENDIF
+
+         IF( .NOT. ll_coincidence )THEN
+            CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
+            &              "between fine grid and coarse grid: invalid domain." )
+         ENDIF
+
+      ENDIF
+ 
+      ! check refinement factor
+      ! select point in middle of fine grid
+      il_imid1=INT(tl_lon1%t_dim(1)%i_len*0.5)
+      il_jmid1=INT(tl_lon1%t_dim(2)%i_len*0.5)
+ 
+      dl_lon1=tl_lon1%d_value(il_imid1, il_jmid1,1,1)
+      dl_lat1=tl_lat1%d_value(il_imid1, il_jmid1,1,1)
+
+      ! select closest point on coarse grid
+      il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),&
+      &                           tl_lat0%d_value(:,:,1,1),&
+      &                           dl_lon1, dl_lat1   )
+
+      IF( ANY(il_ind0(:)==0) )THEN
+         CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//&
+         &              "coarse grid indices: invalid domain." )
+      ENDIF
+
+      IF( .NOT. ll_even )THEN
+         ! case odd refinment in both direction
+         ! work on T-point
+
+         dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1)
+         dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1)
+
+         il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+         &                           tl_lat1%d_value(:,:,1,1),&
+         &                           dl_lon0, dl_lat0 )
+
+         ! check i-direction refinement factor
+         DO ji=0,MIN(3,il_imid1)
+
+            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check i-direction refinement factor ")
+               EXIT
+            ELSE
+               dl_lon0=tl_lon0%d_value(il_ind0(1)+ji             ,il_ind0(2),1,1)
+               dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1)
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+         ! check j-direction refinement factor
+         DO jj=0,MIN(3,il_jmid1)
+
+            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check j-direction refinement factor ")
+               EXIT
+            ELSE      
+               dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj             ,1,1)
+               dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1)
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "j-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_J)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+      ELSE
+         ! case even refinment at least in one direction
+         ! work on F-point
+
+         dl_delta=dp_delta
+         ! look for lower left fine point in coarse cell.
+         IF( ll_grid0F )THEN
+      
+            ! lower left corner of coarse cell
+            dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
+            dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
+
+         ELSE
+
+            ! approximate lower left corner of coarse cell (with T point)
+            dl_lon0F=( tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
+            &          tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
+            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
+            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
+
+            dl_lat0F=( tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
+            &          tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
+            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
+            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
+
+            ! as we use approximation of F-point we relax condition
+            dl_delta=100*dp_delta
+
+         ENDIF
+
+         IF( ll_grid1F )THEN
+      
+            il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),&
+            &                           tl_lat1F%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F )
+
+         ELSE
+
+            il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'll' )
+
+            il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'lr' )
+
+            il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'ul' )
+
+            il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                           tl_lat1%d_value(:,:,1,1),&
+            &                           dl_lon0F, dl_lat0F, 'ur' )
+
+            ! as we use approximation of F-point we relax condition
+            dl_delta=100*dp_delta
+
+         ENDIF
+
+         ! check i-direction refinement factor
+         DO ji=0,MIN(3,il_imid1)
+
+            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check i-direction refinement factor ")
+               EXIT
+            ELSE
+               IF( ll_grid0F )THEN
+                  dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1)
+               ELSE
+                  dl_lon0F= 0.25 * &
+                  & ( tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)  ,1,1) + &
+                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)  ,1,1) + &
+                  &   tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)-1,1,1) + &
+                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) )
+               ENDIF
+
+               IF( ll_grid1F )THEN
+                  dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), &
+                                            & il_ind1(2),1,1)
+               ELSE
+                  dl_lon1F= 0.25 * &
+                  & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), &
+                                     & il_ill1(2),1,1) + &
+                  &   tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), &
+                                     & il_ilr1(2),1,1) + &
+                  &   tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), &
+                                     & il_iul1(2),1,1) + &
+                  &   tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), &
+                                     & il_iur1(2),1,1) )
+                  
+               ENDIF
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+         ! check j-direction refinement factor
+         DO jj=0,MIN(3,il_jmid1)
+
+            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check j-direction refinement factor ")
+               EXIT
+            ELSE      
+               IF( ll_grid0F )THEN
+                  dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1)
+               ELSE
+                  dl_lat0F= 0.25 * &
+                  & ( tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj  ,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj  ,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj-1,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) )
+               ENDIF
+
+               IF( ll_grid1F )THEN
+                  dl_lat1F= tl_lat1F%d_value( il_ind1(1), &
+                                            & il_ind1(2)+jj*id_rho(jp_J),1,1)
+               ELSE
+                  dl_lat1F= 0.25 * &
+                  & ( tl_lat1%d_value( il_ill1(1), &
+                                     & il_ill1(2)+jj*id_rho(jp_J),1,1) + &
+                  &   tl_lat1%d_value( il_ilr1(1), &
+                                     & il_ilr1(2)+jj*id_rho(jp_J),1,1) + &
+                  &   tl_lat1%d_value( il_iul1(1), &
+                                     & il_iul1(2)+jj*id_rho(jp_J),1,1) + &
+                  &   tl_lat1%d_value( il_iur1(1), &
+                                     & il_iur1(2)+jj*id_rho(jp_J),1,1) )
+                  
+               ENDIF
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDIF
+
+      ! clean 
+      CALL var_clean(tl_lon1)
+      CALL var_clean(tl_lat1)
+      CALL var_clean(tl_lon0)
+      CALL var_clean(tl_lat0)
+
+      IF( .NOT. ll_coincidence )THEN
+         CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
+         &              "between fine and coarse grid: "//&
+         &              "invalid refinement factor" )
+      ENDIF
+
+   END SUBROUTINE grid_check_coincidence
+   !-------------------------------------------------------------------
+   !> @brief This function check that fine grid is 
+   !> inside coarse grid 
+   !
+   !> @details
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_lon0   array of coarse grid longitude
+   !> @param[in] dd_lat0   array of coarse grid latitude
+   !> @param[in] dd_lon1   array of fine   grid longitude 
+   !> @param[in] dd_lat1   array of fine   grid latitude
+   !> @return logical, fine grid is inside coarse grid
+   !-------------------------------------------------------------------
+   FUNCTION grid__check_corner(dd_lon0, dd_lat0, &
+   &                           dd_lon1, dd_lat1 )
+   IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      ! function
+      LOGICAL :: grid__check_corner
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2) :: il_shape0
+      INTEGER(i4), DIMENSION(2) :: il_shape1
+
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmax1
+
+      REAL(dp)    :: dl_lon0
+      REAL(dp)    :: dl_lat0
+
+      REAL(dp)    :: dl_lon1
+      REAL(dp)    :: dl_lat1
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      grid__check_corner=.TRUE.
+
+      il_shape0=SHAPE(dd_lon0(:,:))
+      il_shape1=SHAPE(dd_lon1(:,:))
+
+      !1- check if fine grid inside coarse grid domain
+      il_imin0=1 ; il_imax0=il_shape0(1)
+      il_jmin0=1 ; il_jmax0=il_shape0(2)
+
+      il_imin1=1 ; il_imax1=il_shape1(1)
+      il_jmin1=1 ; il_jmax1=il_shape1(2)
+
+      ! check lower left corner
+      dl_lon0 = dd_lon0(il_imin0, il_jmin0)
+      dl_lat0 = dd_lat0(il_imin0, il_jmin0)
+
+      dl_lon1 = dd_lon1(il_imin1, il_jmin1)
+      dl_lat1 = dd_lat1(il_imin1, il_jmin1)
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & 
+      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0 ) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower left "//&
+         &     "corner  not north east of coarse grid (imin,jmin) ")
+         CALL logger_debug(" fine   grid lower left ( "//&
+         &              TRIM(fct_str(dl_lon1))//","//&
+         &              TRIM(fct_str(dl_lat1))//")" )
+         CALL logger_debug(" coarse grid lower left ( "//&
+         &              TRIM(fct_str(dl_lon0))//","//&
+         &              TRIM(fct_str(dl_lat0))//")" )
+         grid__check_corner=.FALSE.
+
+      ENDIF
+
+      ! check upper left corner
+      dl_lon0 = dd_lon0(il_imin0, il_jmax0)
+      dl_lat0 = dd_lat0(il_imin0, il_jmax0)
+
+      dl_lon1 = dd_lon1(il_imin1, il_jmax1)
+      dl_lat1 = dd_lat1(il_imin1, il_jmax1)
+
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0) .OR. &
+      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper left "//&
+         &     "corner not south east of coarse grid (imin,jmax) ")
+         CALL logger_debug(" fine   grid upper left ("//&
+         &              TRIM(fct_str(dl_lon1))//","//&
+         &              TRIM(fct_str(dl_lat1))//")")
+         CALL logger_debug(" coasre grid upper left ("//&
+         &              TRIM(fct_str(dl_lon0))//","//&
+         &              TRIM(fct_str(dl_lat0))//")")
+         grid__check_corner=.FALSE.
+
+      ENDIF
+
+      ! check lower right corner
+      dl_lon0 = dd_lon0(il_imax0, il_jmin0)
+      dl_lat0 = dd_lat0(il_imax0, il_jmin0)
+
+      dl_lon1 = dd_lon1(il_imax1, il_jmin1)
+      dl_lat1 = dd_lat1(il_imax1, il_jmin1)
+
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. &
+      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower right "//&
+         &     "corner not north west of coarse grid (imax,jmin) ")
+         CALL logger_debug(" fine   grid lower right ( "//&
+         &              TRIM(fct_str(dl_lon1))//","//&
+         &              TRIM(fct_str(dl_lat1))//")" )
+         CALL logger_debug(" coarse grid lower right ( "//&
+         &              TRIM(fct_str(dl_lon0))//","//&
+         &              TRIM(fct_str(dl_lat0))//")" )   
+         grid__check_corner=.FALSE.
+
+      ENDIF
+
+      ! check upper right corner
+      dl_lon0 = dd_lon0(il_imax0, il_jmax0)
+      dl_lat0 = dd_lat0(il_imax0, il_jmax0)
+
+      dl_lon1 = dd_lon1(il_imax1, il_jmax1)
+      dl_lat1 = dd_lat1(il_imax1, il_jmax1)
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. &
+      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper right "//&
+         &     "corner not south west of coarse grid (imax,jmax) ")
+         CALL logger_debug(" fine   grid upper right ( "//&
+         &              TRIM(fct_str(dl_lon1))//","//&
+         &              TRIM(fct_str(dl_lat1))//")" )
+         CALL logger_debug(" fine   imax1 jmax1 ( "//&
+         &              TRIM(fct_str(il_imax1))//","//&
+         &              TRIM(fct_str(il_jmax1))//")" )
+         CALL logger_debug(" coarse grid upper right ( "//&
+         &              TRIM(fct_str(dl_lon0))//","//&
+         &              TRIM(fct_str(dl_lat0))//")" )    
+         CALL logger_debug(" fine   imax0 jmax0 ( "//&
+         &              TRIM(fct_str(il_imax0))//","//&
+         &              TRIM(fct_str(il_jmax0))//")" )
+         grid__check_corner=.FALSE.
+
+      ENDIF      
+
+   END FUNCTION grid__check_corner
+   !-------------------------------------------------------------------
+   !> @brief This function check that fine grid latitude are 
+   !> inside coarse grid latitude
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_lat0   array of coarse grid latitude 
+   !> @param[in] dd_lat1   array of fine grid latitude 
+   !-------------------------------------------------------------------
+   FUNCTION grid__check_lat(dd_lat0, dd_lat1)
+      IMPLICIT NONE
+      ! Argument 
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat0
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat1
+
+      ! function
+      LOGICAL :: grid__check_lat
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_shape0
+      INTEGER(i4), DIMENSION(1) :: il_shape1
+
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      grid__check_lat=.TRUE.
+
+      il_shape0(:)=SHAPE(dd_lat0(:))
+      il_shape1(:)=SHAPE(dd_lat1(:))
+
+      !1- check if fine grid inside coarse grid domain
+      il_jmin0=1 ; il_jmax0=il_shape0(1)
+      il_jmin1=1 ; il_jmax1=il_shape1(1)
+
+      ! check lower left fine grid
+      IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > dp_delta .AND. &
+      &   dd_lat1(il_jmin1) < dd_lat0(il_jmin0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower point"//&
+         &     " not north of coarse grid (jmin) ")
+         CALL logger_debug(" fine grid lower point ( "//&
+         &              TRIM(fct_str(dd_lat1(il_jmin1)))//")" )
+         CALL logger_debug(" coarse grid lower point ( "//&
+         &              TRIM(fct_str(dd_lat0(il_jmin0)))//")" )
+         grid__check_lat=.FALSE.
+
+      ENDIF
+
+      ! check upper left fine grid
+      IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > dp_delta .AND. &
+      &   dd_lat1(il_jmax1) > dd_lat0(il_jmax0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper point"//&
+         &     " not south of coarse grid (jmax) ")
+         CALL logger_debug(" fine grid upper point ("//&
+         &              TRIM(fct_str(dd_lat1(il_jmax1)))//")")
+         CALL logger_debug(" coasre grid upper point ("//&
+         &              TRIM(fct_str(dd_lat0(il_jmax0)))//")")
+         grid__check_lat=.FALSE.
+
+      ENDIF
+      
+   END FUNCTION grid__check_lat
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add ghost cell at boundaries.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_var array of variable structure 
+   !> @param[in] id_ghost  array of ghost cell factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_add_ghost(td_var, id_ghost)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost
+
+      ! local variable
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmax
+
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+      
+      TYPE(TVAR) :: tl_var
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+         CALL logger_warn( "ADD GHOST: dimension change in variable "//&
+         &              TRIM(td_var%c_name) )
+
+         ! copy variable
+         tl_var=var_copy(td_var)
+
+         CALL var_del_value(td_var)
+
+         ! compute indice to fill center
+         il_imin=1+id_ghost(jp_I,1)*ip_ghost
+         il_jmin=1+id_ghost(jp_J,1)*ip_ghost
+
+         il_imax=tl_var%t_dim(1)%i_len+id_ghost(jp_I,1)*ip_ghost
+         il_jmax=tl_var%t_dim(2)%i_len+id_ghost(jp_J,1)*ip_ghost
+
+         ! compute new dimension
+         td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + &
+         &                             SUM(id_ghost(jp_I,:))*ip_ghost
+         td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + &
+         &                             SUM(id_ghost(jp_J,:))*ip_ghost
+
+         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+         &                 td_var%t_dim(2)%i_len, &
+         &                 td_var%t_dim(3)%i_len, &
+         &                 td_var%t_dim(4)%i_len) )
+
+         dl_value(:,:,:,:)=tl_var%d_fill
+
+         dl_value(il_imin:il_imax, &
+         &        il_jmin:il_jmax, &
+         &              :,:)  =  tl_var%d_value(:,:,:,:)
+
+         ! add variable value
+         CALL var_add_value(td_var,dl_value(:,:,:,:))
+
+         ! save variable type
+         td_var%i_type=tl_var%i_type
+         
+         DEALLOCATE( dl_value )
+
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END SUBROUTINE grid_add_ghost
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine delete ghost cell at boundaries.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_var array of variable structure 
+   !> @param[in] id_ghost  array of ghost cell factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_del_ghost(td_var, id_ghost)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost
+
+      ! local variable
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmax
+
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+      
+      TYPE(TVAR) :: tl_var
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+         IF( ANY(id_ghost(:,:)/=0) )THEN
+            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
+            &              TRIM(td_var%c_name) )
+         ENDIF
+
+         ! copy variable
+         tl_var=var_copy(td_var)
+
+         CALL var_del_value(td_var)
+
+         ! compute indice to get center
+         il_imin=1+id_ghost(jp_I,1)*ip_ghost
+         il_jmin=1+id_ghost(jp_J,1)*ip_ghost
+
+         il_imax=tl_var%t_dim(1)%i_len-id_ghost(jp_I,2)*ip_ghost
+         il_jmax=tl_var%t_dim(2)%i_len-id_ghost(jp_J,2)*ip_ghost
+
+         ! compute new dimension
+         td_var%t_dim(1)%i_len = il_imax - il_imin +1 
+         td_var%t_dim(2)%i_len = il_jmax - il_jmin +1 
+
+         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+         &                 td_var%t_dim(2)%i_len, &
+         &                 td_var%t_dim(3)%i_len, &
+         &                 td_var%t_dim(4)%i_len) )
+
+         dl_value(:,:,:,:)=tl_var%d_fill
+
+         dl_value(:,:,:,:)  =  tl_var%d_value(il_imin:il_imax, &
+         &                                    il_jmin:il_jmax, &
+         &                                    :,:)
+
+         ! add variable value
+         CALL var_add_value(td_var,dl_value(:,:,:,:))
+
+         ! save variable type
+         td_var%i_type=tl_var%i_type
+         
+         DEALLOCATE( dl_value )
+
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END SUBROUTINE grid_del_ghost
+   !-------------------------------------------------------------------
+   !> @brief This function check if ghost cell are used or not, and return ghost
+   !> cell factor (0,1) in horizontal plan.
+   !
+   !> @details
+   !> check if domain is global, and if there is an East-West overlap.
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[in] td_var variable sturcture 
+   !> @return array of ghost cell factor
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_ghost_var( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      grid__get_ghost_var(:,:)=0
+
+      IF( .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
+         CALL logger_error("GRID GET GHOST: "//TRIM(td_var%c_name)//" is not a suitable"//&
+         &                 " variable to look for ghost cell (not 2D).")
+      ELSE
+         IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+            CALL logger_error("GRID GET GHOST: no value associated to "//TRIM(td_var%c_name)//&
+            &                 ". can't look for ghost cell.")
+         ELSE
+            il_dim(:)=td_var%t_dim(:)%i_len
+
+            IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
+            &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.&
+            &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.&
+            &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
+            ! no boundary closed
+               CALL logger_warn("GRID GET GHOST: can't determined ghost cell. "//&
+               &             "there is no boundary closed for variable "//&
+               &              TRIM(td_var%c_name))
+
+            ELSE
+               ! check periodicity
+               IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
+               &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN
+               ! East-West cyclic (1,4,6)
+                  CALL logger_info("GRID GET GHOST: East West cyclic")
+                  grid__get_ghost_var(jp_I,:)=0
+
+                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+                  ! South boundary not closed 
+
+                     CALL logger_debug("GRID GET GHOST: East_West cyclic")
+                     CALL logger_debug("GRID GET GHOST: South boundary not closed")
+                     CALL logger_error("GRID GET GHOST: should have been an "//&
+                     &              "impossible case")
+
+                  ELSE
+                  ! South boundary closed (1,4,6)
+                     CALL logger_info("GRID GET GHOST: South boundary closed")
+                     grid__get_ghost_var(jp_J,1)=1
+
+                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN
+                     ! North boundary not closed (4,6)
+                        CALL logger_info("GRID GET GHOST: North boundary not closed")
+                        grid__get_ghost_var(jp_J,2)=0
+                     ELSE
+                     ! North boundary closed
+                        CALL logger_info("GRID GET GHOST: North boundary closed")
+                        grid__get_ghost_var(jp_J,2)=1
+                     ENDIF
+
+                  ENDIF
+
+               ELSE
+               ! East-West boundaries closed (0,2,3,5)
+                  CALL logger_info("GRID GET GHOST: East West boundaries closed")
+                  grid__get_ghost_var(jp_I,:)=1
+
+                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+                  ! South boundary not closed (2)
+                     CALL logger_info("GRID GET GHOST: South boundary not closed")
+                     grid__get_ghost_var(jp_J,1)=0
+
+                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                     ! North boundary not closed
+                        CALL logger_debug("GRID GET GHOST: East West boundaries "//&
+                        &              "closed")
+                        CALL logger_debug("GRID GET GHOST: South boundary not closed")
+                        CALL logger_debug("GRID GET GHOST: North boundary not closed")
+                        CALL logger_error("GRID GET GHOST: should have been "//&
+                        &              "an impossible case")
+                     ELSE
+                     ! North boundary closed
+                        grid__get_ghost_var(jp_J,2)=1
+                     ENDIF
+
+                  ELSE
+                  ! South boundary closed (0,3,5)
+                     CALL logger_info("GRID GET GHOST: South boundary closed")
+                     grid__get_ghost_var(jp_J,1)=1
+
+                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                     ! North boundary not closed (3,5)
+                        CALL logger_info("GRID GET GHOST: North boundary not closed")
+                        grid__get_ghost_var(jp_J,2)=0
+                     ELSE
+                     ! North boundary closed   
+                        CALL logger_info("GRID GET GHOST: North boundary closed")
+                        grid__get_ghost_var(jp_J,2)=1
+                     ENDIF
+
+                  ENDIF
+
+               ENDIF
+
+            ENDIF
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION grid__get_ghost_var
+   !-------------------------------------------------------------------
+   !> @brief This function check if ghost cell are used or not, and return ghost
+   !> cell factor (0,1) in i- and j-direction.
+   !
+   !> @details
+   !> get longitude an latitude array, then
+   !> check if domain is global, and if there is an East-West overlap
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !
+   !> @param[in] td_file   file sturcture
+   !> @return array of ghost cell factor
+   !-------------------------------------------------------------------
+   FUNCTION grid__get_ghost_mpp( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_mpp
+
+      ! local variable
+      !TYPE(TVAR)  :: tl_lon
+      !TYPE(TVAR)  :: tl_lat
+
+      TYPE(TMPP) :: tl_mpp
+
+      !INTEGER(i4) :: il_lonid
+      !INTEGER(i4) :: il_latid
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      grid__get_ghost_mpp(:,:)=0
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+         CALL logger_error("GRID GET GHOST: decomposition of mpp file "//&
+         &                 TRIM(td_mpp%c_name)//" not defined." )
+
+      ELSE
+
+         ! copy structure
+         tl_mpp=mpp_copy(td_mpp)
+
+         CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio)))
+         IF( tl_mpp%i_perio < 0 )THEN
+            ! compute NEMO periodicity index
+            CALL grid_get_info(tl_mpp)
+         ENDIF
+
+         SELECT CASE(tl_mpp%i_perio)
+            CASE(0)
+               grid__get_ghost_mpp(:,:)=1
+            CASE(1)
+               grid__get_ghost_mpp(jp_J,:)=1
+            CASE(2)
+               grid__get_ghost_mpp(jp_I,:)=1
+               grid__get_ghost_mpp(jp_J,2)=1
+            CASE(3,5)
+               grid__get_ghost_mpp(jp_I,:)=1
+               grid__get_ghost_mpp(jp_J,1)=1
+            CASE(4,6)
+               grid__get_ghost_mpp(jp_J,1)=1
+            CASE DEFAULT
+         END SELECT
+
+         ! clean 
+         CALL mpp_clean(tl_mpp)
+
+      ENDIF
+
+   END FUNCTION grid__get_ghost_mpp
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute closed sea domain.
+   !
+   !> @details
+   !> to each domain is associated a negative value id (from -1 to ...)<br/>
+   !> optionaly you could specify which level use (default 1)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var    variable strucutre 
+   !> @param[in] id_level  level
+   !> @return domain mask  
+   !-------------------------------------------------------------------
+   FUNCTION grid_split_domain(td_var, id_level)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_level
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
+      &                      td_var%t_dim(2)%i_len ) :: grid_split_domain
+
+      ! local variable
+      INTEGER(i4)                              :: il_domid
+      INTEGER(i4)                              :: il_level
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(2)                :: il_ind
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      LOGICAL                                  :: ll_full
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jim
+      INTEGER(i4) :: jip
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jjm
+      INTEGER(i4) :: jjp
+      !----------------------------------------------------------------
+      il_level=1
+      IF( PRESENT(id_level) ) il_level=id_level
+
+      ! init
+      il_domid=-1
+
+      il_shape(:)=td_var%t_dim(1:2)%i_len
+      ALLOCATE( il_mask(il_shape(1),il_shape(2)) )
+      il_mask(:,:)=0
+      WHERE( td_var%d_value(:,:,il_level,1)/=td_var%d_fill ) il_mask(:,:)=1
+
+      il_ind(:)=MAXLOC( il_mask(:,:) )
+      DO WHILE( il_mask(il_ind(1), il_ind(2)) == 1 )
+
+         il_mask(il_ind(1),il_ind(2))=il_domid
+         ll_full=.FALSE.
+
+         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+
+         DO WHILE( .NOT. ll_full )
+            il_tmp(:,:)=0
+
+            ll_full=.TRUE.
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  IF( il_mask(ji,jj)==il_domid )THEN
+                     jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
+                     jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
+                     
+                     WHERE( il_mask(jim:jip,jjm:jjp)==1 )
+                        il_mask(jim:jip,jjm:jjp)=il_domid
+                        il_tmp(jim:jip,jjm:jjp)=1
+                     END WHERE
+
+                  ENDIF
+               ENDDO
+            ENDDO
+            IF( SUM(il_tmp(:,:))/=0 ) ll_full=.FALSE.
+
+         ENDDO
+         DEALLOCATE( il_tmp )
+
+         il_ind(:)=MAXLOC( il_mask(:,:) )
+         il_domid=il_domid-1
+
+      ENDDO
+
+      ! save result
+      grid_split_domain(:,:)=il_mask(:,:)
+
+      DEALLOCATE( il_mask )
+
+      CALL logger_info("GRID SPLIT DOMAIN: "//TRIM( fct_str(ABS(il_domid+1)) )//&
+      &             " domain found" ) 
+
+   END FUNCTION grid_split_domain
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill small closed sea with fill value. 
+   !>
+   !> @details
+   !> the minimum size (number of point) of closed sea to be kept could be
+   !> sepcify with id_minsize.
+   !> By default only the biggest sea is preserve.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var    variable structure
+   !> @param[in] id_mask      domain mask (from grid_split_domain)
+   !> @param[in] id_minsize   minimum size of sea to be kept
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_mask
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_minsize
+
+      ! local variable
+      INTEGER(i4)                              :: il_ndom
+      INTEGER(i4)                              :: il_minsize
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(id_mask(:,:))
+      IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN
+         CALL logger_error("GRID FILL SMALL DOM: variable and mask "//&
+         &              "dimension differ")
+      ELSE
+
+         il_ndom=MINVAL(id_mask(:,:))
+
+         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+         il_tmp(:,:)=0
+         DO ji=-1,il_ndom,-1
+            WHERE( id_mask(:,:)==ji ) 
+               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+            END WHERE
+         ENDDO
+
+         il_minsize=MAXVAL(il_tmp(:,:))
+         IF( PRESENT(id_minsize) ) il_minsize=id_minsize
+
+         DO jl=1,td_var%t_dim(4)%i_len
+            DO jk=1,td_var%t_dim(3)%i_len
+               WHERE( il_tmp(:,:) < il_minsize ) 
+                  td_var%d_value(:,:,jk,jl)=td_var%d_fill
+               END WHERE
+            ENDDO
+         ENDDO
+
+         DEALLOCATE( il_tmp )
+
+      ENDIF
+
+   END SUBROUTINE grid_fill_small_dom
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill small domain inside bigger one. 
+   !>
+   !> @details
+   !> the minimum size (number of point) of domain sea to be kept could be
+   !> is sepcified with id_minsize.
+   !> smaller domain are included in the one they are embedded.
+   !>
+   !> @author J.Paul
+   !> @date Ferbruay, 2015 - Initial Version
+   !>
+   !> @param[inout] id_mask      domain mask (from grid_split_domain)
+   !> @param[in] id_minsize   minimum size of sea to be kept
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_fill_small_msk(id_mask, id_minsize)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask
+      INTEGER(i4),                 INTENT(IN   ) :: id_minsize
+
+      ! local variable
+      INTEGER(i4)                              :: il_ndom
+      INTEGER(i4)                              :: il_minsize
+      INTEGER(i4)                              :: il_msk
+      
+      INTEGER(i4)                              :: jim
+      INTEGER(i4)                              :: jjm
+      INTEGER(i4)                              :: jip
+      INTEGER(i4)                              :: jjp
+
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(id_mask(:,:))
+      il_ndom=MINVAL(id_mask(:,:))
+
+      ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+      il_tmp(:,:)=0
+      DO ji=-1,il_ndom,-1
+         WHERE( id_mask(:,:)==ji ) 
+            il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+         END WHERE
+      ENDDO
+
+      DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) )
+
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               IF( il_tmp(ji,jj) < il_minsize )THEN
+                  jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
+                  jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
+                  
+                  il_msk=0
+                  DO ij=jjm,jjp
+                     DO ii=jim,jip
+                        IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN
+                           IF( il_msk == 0 )THEN
+                              il_msk=id_mask(ii,ij)
+                           ELSEIF( il_msk /= id_mask(ii,ij) )THEN
+                              CALL logger_error("GRID FILL SMALL MSK: "//&
+                              &  "small domain not embedded in bigger one"//&
+                              &  ". point should be between two different"//&
+                              &  " domain.")
+                           ENDIF
+                        ENDIF
+                     ENDDO
+                  ENDDO
+                  IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+
+         il_tmp(:,:)=0
+         DO ji=-1,il_ndom,-1
+            WHERE( id_mask(:,:)==ji ) 
+               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+            END WHERE
+         ENDDO            
+
+      ENDDO
+
+      DEALLOCATE( il_tmp )
+
+
+   END SUBROUTINE grid_fill_small_msk
+END MODULE grid
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid_hgr.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid_hgr.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid_hgr.f90	(revision 8732)
@@ -0,0 +1,1410 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: grid_hgr
+!
+! DESCRIPTION:
+!> @brief This module manage Horizontal grid.
+!>
+!> @details
+!> ** Purpose :   Compute the geographical position (in degre) of the 
+!>      model grid-points,  the horizontal scale factors (in meters) and 
+!>      the Coriolis factor (in s-1).
+!>
+!> ** Method  :   The geographical position of the model grid-points is
+!>    defined from analytical functions, fslam and fsphi, the derivatives of which gives the horizontal scale factors e1,e2.
+!>    Defining two function fslam and fsphi and their derivatives in the two horizontal directions (fse1 and fse2), 
+!>    the model grid-point position and scale factors are given by:
+!>    - t-point:
+!>       - glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
+!>       - gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
+!>    - u-point:
+!>       - glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
+!>       - gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
+!>    - v-point:
+!>       - glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
+!>       - gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
+!>    - f-point:
+!>       - glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
+!>       - gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
+!>
+!>    Where fse1 and fse2 are defined by:
+!>       - fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
+!>                                     +          di(fsphi) **2 )(i,j)
+!>       - fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
+!>                                     +          dj(fsphi) **2 )(i,j)
+!>
+!>    The coriolis factor is given at z-point by:
+!>        - ff = 2.*omega*sin(gphif)      (in s-1)<br/>
+!>
+!>        This routine is given as an example, it must be modified
+!>      following the user s desiderata. nevertheless, the output as
+!>      well as the way to compute the model grid-point position and
+!>      horizontal scale factors must be respected in order to insure
+!>      second order accuracy schemes.
+!>
+!> @note If the domain is periodic, verify that scale factors are also
+!>      periodic, and the coriolis term again.
+!>
+!> ** Action  : 
+!>    - define  glamt, glamu, glamv, glamf: longitude of t-, u-, v- and f-points (in degre)
+!>    - define  gphit, gphiu, gphiv, gphit: latitude  of t-, u-, v-  and f-points (in degre)
+!>    - define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
+!>    - scale factors (in meters) at t-, u-, v-, and f-points.
+!>    - define ff: coriolis factor at f-point
+!>
+!> References :   Marti, Madec and Delecluse, 1992, JGR
+!>                Madec, Imbard, 1996, Clim. Dyn.
+!>
+!> @author
+!> G, Madec
+! REVISION HISTORY:
+!> @date March, 1988 - Original code
+!> @date January, 1996 
+!> - terrain following coordinates
+!> @date February, 1997 
+!> - print mesh informations
+!> @date November, 1999
+!> - M. Imbard : NetCDF format with IO-IPSL
+!> @date Augustr, 2000
+!> - D. Ludicone : Reduced section at Bab el Mandeb
+!> @date September, 2001
+!> - M. Levy : eel config: grid in km, beta-plane
+!> @date August, 2002
+!> - G. Madec :  F90: Free form and module, namelist
+!> @date January, 2004
+!> - A.M. Treguier, J.M. Molines : Case 4 (Mercator mesh)
+!> use of parameters in par_CONFIG-Rxx.h90, not in namelist
+!> @date May, 2004
+!> - A. Koch-Larrouy : Add Gyre configuration 
+!> @date February, 2011
+!> - G. Madec : add cell surface (e1e2t)
+!> @date September, 2015 
+!> - J, Paul : rewrite to SIREN format from $Id: domhgr.F90 5506 2015-06-29 15:19:38Z clevy $
+!> @date October, 2016
+!> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
+!> - J, Paul : compute coriolis factor at f-point and at t-point 
+!> - J, Paul : do not use anymore special case for ORCA grid
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE grid_hgr
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   USE lbc                             ! lateral boundary conditions
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TNAMH
+
+   PUBLIC :: tg_tmask
+   PUBLIC :: tg_umask
+   PUBLIC :: tg_vmask
+   PUBLIC :: tg_fmask
+
+!   PUBLIC :: tg_wmask
+!   PUBLIC :: tg_wumask
+!   PUBLIC :: tg_wvmask
+
+   PUBLIC :: tg_ssmask
+!   PUBLIC :: tg_ssumask
+!   PUBLIC :: tg_ssvmask
+!   PUBLIC :: tg_ssfmask
+
+   PUBLIC :: tg_glamt
+   PUBLIC :: tg_glamu
+   PUBLIC :: tg_glamv
+   PUBLIC :: tg_glamf
+
+   PUBLIC :: tg_gphit
+   PUBLIC :: tg_gphiu
+   PUBLIC :: tg_gphiv
+   PUBLIC :: tg_gphif
+   
+   PUBLIC :: tg_e1t
+   PUBLIC :: tg_e1u
+   PUBLIC :: tg_e1v
+   PUBLIC :: tg_e1f
+   
+   PUBLIC :: tg_e2t
+   PUBLIC :: tg_e2u
+   PUBLIC :: tg_e2v
+   PUBLIC :: tg_e2f
+   
+   PUBLIC :: tg_ff_t
+   PUBLIC :: tg_ff_f
+
+   PUBLIC :: tg_gcost
+   PUBLIC :: tg_gcosu
+   PUBLIC :: tg_gcosv
+   PUBLIC :: tg_gcosf
+
+   PUBLIC :: tg_gsint
+   PUBLIC :: tg_gsinu
+   PUBLIC :: tg_gsinv
+   PUBLIC :: tg_gsinf
+
+   ! function and subroutine
+   PUBLIC :: grid_hgr_init 
+   PUBLIC :: grid_hgr_fill
+   PUBLIC :: grid_hgr_clean
+   PUBLIC :: grid_hgr_nam 
+
+   PRIVATE :: grid_hgr__fill_curv
+   PRIVATE :: grid_hgr__fill_reg
+   PRIVATE :: grid_hgr__fill_plan
+   PRIVATE :: grid_hgr__fill_merc
+   PRIVATE :: grid_hgr__fill_gyre
+   PRIVATE :: grid_hgr__fill_coriolis
+   PRIVATE :: grid_hgr__angle
+
+   TYPE TNAMH
+
+      CHARACTER(LEN=lc) :: c_coord   
+      INTEGER(i4)       :: i_perio   
+                
+      INTEGER(i4)       :: i_mshhgr  
+      REAL(dp)          :: d_ppglam0 
+      REAL(dp)          :: d_ppgphi0 
+                
+      REAL(dp)          :: d_ppe1_deg
+      REAL(dp)          :: d_ppe2_deg
+!      REAL(dp)          :: d_ppe1_m  
+!      REAL(dp)          :: d_ppe2_m     
+
+!      INTEGER(i4)       :: i_cla     
+                
+!      CHARACTER(LEN=lc) :: c_cfg     
+      INTEGER(i4)       :: i_cfg     
+      LOGICAL           :: l_bench   
+                
+   END TYPE
+
+   TYPE(TVAR), SAVE :: tg_tmask   
+   TYPE(TVAR), SAVE :: tg_umask
+   TYPE(TVAR), SAVE :: tg_vmask
+   TYPE(TVAR), SAVE :: tg_fmask
+!   TYPE(TVAR), SAVE :: tg_wmask
+!   TYPE(TVAR), SAVE :: tg_wumask
+!   TYPE(TVAR), SAVE :: tg_wvmask
+
+   TYPE(TVAR), SAVE :: tg_ssmask 
+!   TYPE(TVAR), SAVE :: tg_ssumask
+!   TYPE(TVAR), SAVE :: tg_ssvmask
+!   TYPE(TVAR), SAVE :: tg_ssfmask
+
+   TYPE(TVAR), SAVE :: tg_glamt
+   TYPE(TVAR), SAVE :: tg_glamu
+   TYPE(TVAR), SAVE :: tg_glamv
+   TYPE(TVAR), SAVE :: tg_glamf
+
+   TYPE(TVAR), SAVE :: tg_gphit
+   TYPE(TVAR), SAVE :: tg_gphiu
+   TYPE(TVAR), SAVE :: tg_gphiv
+   TYPE(TVAR), SAVE :: tg_gphif
+
+   TYPE(TVAR), SAVE :: tg_e1t
+   TYPE(TVAR), SAVE :: tg_e1u
+   TYPE(TVAR), SAVE :: tg_e1v
+   TYPE(TVAR), SAVE :: tg_e1f
+
+   TYPE(TVAR), SAVE :: tg_e2t
+   TYPE(TVAR), SAVE :: tg_e2u
+   TYPE(TVAR), SAVE :: tg_e2v
+   TYPE(TVAR), SAVE :: tg_e2f
+
+   TYPE(TVAR), SAVE :: tg_ff_t
+   TYPE(TVAR), SAVE :: tg_ff_f
+
+   TYPE(TVAR), SAVE :: tg_gcost
+   TYPE(TVAR), SAVE :: tg_gcosu
+   TYPE(TVAR), SAVE :: tg_gcosv
+   TYPE(TVAR), SAVE :: tg_gcosf
+
+   TYPE(TVAR), SAVE :: tg_gsint
+   TYPE(TVAR), SAVE :: tg_gsinu
+   TYPE(TVAR), SAVE :: tg_gsinv
+   TYPE(TVAR), SAVE :: tg_gsinf
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This function initialise hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr_init(jpi,jpj,jpk,ld_domcfg) 
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      INTEGER(i4), INTENT(IN) :: jpk
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      REAL(dp), DIMENSION(jpi,jpj)     :: dl_tmp2D
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: dl_tmp3D
+      ! loop indices
+      !----------------------------------------------------------------
+      ! variable 2D
+      dl_tmp2D(:,:)  =dp_fill_i1
+
+      tg_ssmask   = var_init('ssmask' ,dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_ssumask  = var_init('ssumask',dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_ssvmask  = var_init('ssvmask',dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_ssfmask  = var_init('ssfmask',dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+
+      dl_tmp2D(:,:)=dp_fill
+
+      tg_glamt    = var_init('glamt',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_glamu    = var_init('glamu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_glamv    = var_init('glamv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_glamf    = var_init('glamf',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_gphit    = var_init('gphit',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gphiu    = var_init('gphiu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gphiv    = var_init('gphiv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gphif    = var_init('gphif',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_e1t      = var_init('e1t'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e1u      = var_init('e1u'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e1v      = var_init('e1v'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e1f      = var_init('e1f'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_e2t      = var_init('e2t'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e2u      = var_init('e2u'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e2v      = var_init('e2v'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e2f      = var_init('e2f'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_ff_t     = var_init('ff_t' ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_ff_f     = var_init('ff_f' ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      IF( .NOT. ld_domcfg )THEN
+         tg_gcost     =var_init('gcost',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gcosu     =var_init('gcosu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gcosv     =var_init('gcosv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gcosf     =var_init('gcosf',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+         tg_gsint     =var_init('gsint',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsinu     =var_init('gsinu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsinv     =var_init('gsinv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsinf     =var_init('gsinf',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      ENDIF
+
+      ! variable 3D
+      dl_tmp3D(:,:,:)=dp_fill_i1
+
+      tg_tmask   = var_init('tmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      tg_umask   = var_init('umask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      tg_vmask   = var_init('vmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      IF( .NOT. ld_domcfg )THEN
+         tg_fmask   = var_init('fmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      ENDIF
+      
+!      tg_wmask   = var_init('wmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_wumask  = var_init('wumask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_wvmask  = var_init('wvmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+
+   END SUBROUTINE grid_hgr_init
+   !-------------------------------------------------------------------
+   !> @brief This function clean hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr_clean(ld_domcfg) 
+      IMPLICIT NONE
+      ! Argument      
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+      CALL var_clean(tg_ssmask  )
+
+      CALL var_clean(tg_glamt)
+      CALL var_clean(tg_glamu)
+      CALL var_clean(tg_glamv)
+      CALL var_clean(tg_glamf)
+
+      CALL var_clean(tg_gphit)
+      CALL var_clean(tg_gphiu)
+      CALL var_clean(tg_gphiv)
+      CALL var_clean(tg_gphif)
+
+      CALL var_clean(tg_e1t  )
+      CALL var_clean(tg_e1u  )
+      CALL var_clean(tg_e1v  )
+      CALL var_clean(tg_e1f  )
+
+      CALL var_clean(tg_e2t  )
+      CALL var_clean(tg_e2u  )
+      CALL var_clean(tg_e2v  )
+      CALL var_clean(tg_e2f  )
+
+      CALL var_clean(tg_ff_t )
+      CALL var_clean(tg_ff_f )
+
+      IF( .NOT. ld_domcfg )THEN
+         CALL var_clean(tg_gcost )
+         CALL var_clean(tg_gcosu )
+         CALL var_clean(tg_gcosv )
+         CALL var_clean(tg_gcosf )
+
+         CALL var_clean(tg_gsint )
+         CALL var_clean(tg_gsinu )
+         CALL var_clean(tg_gsinv )
+         CALL var_clean(tg_gsinf )
+      ENDIF
+
+      CALL var_clean(tg_tmask   )
+      CALL var_clean(tg_umask   )
+      CALL var_clean(tg_vmask   )
+      IF( .NOT. ld_domcfg )THEN
+         CALL var_clean(tg_fmask   )
+      ENDIF
+   END SUBROUTINE grid_hgr_clean
+   !-------------------------------------------------------------------
+   !> @brief This function initialise hgr namelist structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] cd_coord   
+   !> @param[in] id_perio  
+   !> @param[in] cd_namelist
+   !> @return hgr namelist structure
+   !-------------------------------------------------------------------
+   FUNCTION grid_hgr_nam( cd_coord,id_perio,cd_namelist )
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_coord
+      INTEGER(i4)     , INTENT(IN) :: id_perio   
+      CHARACTER(LEN=*), INTENT(IN) :: cd_namelist
+      
+      ! function
+      TYPE(TNAMH) :: grid_hgr_nam
+
+      ! local variable
+      INTEGER(i4)        :: il_status
+      INTEGER(i4)        :: il_fileid
+
+      LOGICAL            :: ll_exist
+
+      ! loop indices
+      ! namelist
+
+      ! namhgr
+      INTEGER(i4)       :: in_mshhgr   = 0 
+      REAL(dp)          :: dn_ppglam0  = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppgphi0  = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppe1_deg = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppe2_deg = NF90_FILL_DOUBLE
+!      REAL(dp)          :: dn_ppe1_m   = NF90_FILL_DOUBLE
+!      REAL(dp)          :: dn_ppe2_m   = NF90_FILL_DOUBLE
+
+!      ! namcla
+!      INTEGER(i4)       :: in_cla      = 0
+
+      ! namgrd
+!      CHARACTER(LEN=lc) :: cn_cfg      = ''
+      INTEGER(i4)       :: in_cfg      = 0
+      LOGICAL           :: ln_bench    = .FALSE.
+
+      !----------------------------------------------------------------
+      NAMELIST /namhgr/ &  
+      &  in_mshhgr,     &  !< 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
+                           !< 5: beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+      &  dn_ppglam0,    &  !< longitude of first raw and column T-point (in_mshhgr = 1 or 4)
+      &  dn_ppgphi0,    &  !< latitude  of first raw and column T-point (in_mshhgr = 1 or 4)
+      &  dn_ppe1_deg,   &  !< zonal      grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+      &  dn_ppe2_deg       !< meridional grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+!      &  dn_ppe1_m,     &  !< zonal      grid-spacing (degrees)
+!      &  dn_ppe2_m         !< meridional grid-spacing (degrees)
+
+!      NAMELIST /namcla/ &
+!      &  in_cla            !< =1 cross land advection for exchanges through some straits (ORCA2)
+
+      NAMELIST/namgrd/  &  !< orca grid namelist
+!      &  cn_cfg,        &  !< name of the configuration (orca)
+      &  in_cfg,        &  !< resolution of the configuration (2,1,025..)
+      &  ln_bench          !< benchmark parameter (in_mshhgr = 5 ). 
+
+      !----------------------------------------------------------------
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         
+         il_fileid=fct_getunit()
+
+         OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("GRID HGR NAM: error opening "//&
+               &  TRIM(cd_namelist))
+         ENDIF
+
+         READ( il_fileid, NML = namhgr  )
+!         READ( il_fileid, NML = namcla  )
+!         READ( il_fileid, NML = namgrd  )
+
+         CLOSE( il_fileid, IOSTAT=il_status )
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_error("GRID HGR NAM: closing "//TRIM(cd_namelist))
+         ENDIF
+        
+         grid_hgr_nam%c_coord   = TRIM(cd_coord)
+         grid_hgr_nam%i_perio   = id_perio
+
+         grid_hgr_nam%i_mshhgr  = in_mshhgr
+         grid_hgr_nam%d_ppglam0 = dn_ppglam0
+         grid_hgr_nam%d_ppgphi0 = dn_ppgphi0
+
+         grid_hgr_nam%d_ppe1_deg= dn_ppe1_deg
+         grid_hgr_nam%d_ppe2_deg= dn_ppe2_deg
+!         grid_hgr_nam%d_ppe1_m  = dn_ppe1_m
+!         grid_hgr_nam%d_ppe2_m  = dn_ppe2_m
+
+!         grid_hgr_nam%i_cla     = in_cla
+
+!         grid_hgr_nam%c_cfg     = TRIM(cn_cfg)
+         grid_hgr_nam%i_cfg     = in_cfg
+         grid_hgr_nam%l_bench   = ln_bench
+
+      ELSE
+
+         CALL logger_fatal(" GRID HGR NAM: can't find "//TRIM(cd_namelist))
+
+      ENDIF
+
+   END FUNCTION grid_hgr_nam
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr_fill(td_nam,jpi,jpj,ld_domcfg) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      ! local variable
+      REAL(dp)    :: znorme
+      ! loop indices
+      !----------------------------------------------------------------
+      CALL logger_info('GRID HGR FILL : define the horizontal mesh from the'//&
+      &  ' type of horizontal mesh mshhgr = '//TRIM(fct_str(td_nam%i_mshhgr)))
+      IF( td_nam%i_mshhgr == 1 )THEN
+         CALL logger_info('   position of the first row and     ppglam0  = '//&
+            &  TRIM(fct_str(td_nam%d_ppglam0  )) )
+         CALL logger_info('   column grid-point (degrees)       ppgphi0  = '//&
+            &  TRIM(fct_str(td_nam%d_ppgphi0  )) )
+      ELSEIF( td_nam%i_mshhgr == 2 .OR. td_nam%i_mshhgr == 3  )THEN
+         CALL logger_info('   zonal      grid-spacing (degrees) ppe1_deg = '//&
+            &  TRIM(fct_str(td_nam%d_ppe1_deg )) )
+         CALL logger_info('   meridional grid-spacing (degrees) ppe2_deg = '//&
+            &  TRIM(fct_str(td_nam%d_ppe2_deg )) )
+!         CALL logger_info('   zonal      grid-spacing (meters)  ppe1_m   = '//&
+!            &  TRIM(fct_str(td_nam%d_ppe1_m   )) ) 
+!         CALL logger_info('   meridional grid-spacing (meters)  ppe2_m   = '//&
+!            &  TRIM(fct_str(td_nam%d_ppe2_m   )) ) 
+      ENDIF
+
+      SELECT CASE( td_nam%i_mshhgr ) ! type of horizontal mesh
+
+         CASE(0)   !  curvilinear coordinate on the sphere read in coordinate.nc file
+
+            CALL grid_hgr__fill_curv(td_nam)!,jpi,jpj)
+
+         CASE(1)   ! geographical mesh on the sphere with regular grid-spacing
+
+            CALL grid_hgr__fill_reg(td_nam,jpi,jpj)
+
+         CASE(2:3) ! f- or beta-plane with regular grid-spacing
+
+            CALL grid_hgr__fill_plan(td_nam,jpi,jpj)
+
+         CASE(4)   ! geographical mesh on the sphere, isotropic MERCATOR type
+
+            CALL grid_hgr__fill_merc(td_nam,jpi,jpj)
+
+         CASE(5)   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+
+            CALL grid_hgr__fill_gyre(td_nam,jpi,jpj)
+
+         CASE DEFAULT
+
+            CALL logger_fatal('GRID HGR FILL : bad flag value for mshhgr = '//&
+               &  TRIM(fct_str(td_nam%i_mshhgr)))
+
+      END SELECT
+
+      ! No Useful associated horizontal metrics
+      ! ---------------------------------------
+
+      ! create coriolis factor
+      CALL grid_hgr__fill_coriolis(td_nam,jpi)!,jpj)
+     
+      ! Control of domain for symetrical condition
+      ! ------------------------------------------
+      ! The equator line must be the latitude coordinate axe
+
+      IF( td_nam%i_perio == 2 ) THEN
+         znorme = SQRT( SUM(tg_gphiu%d_value(:,2,1,1)*tg_gphiu%d_value(:,2,1,1)) ) / FLOAT( jpi )
+         IF( znorme > 1.e-13 )THEN
+            CALL logger_fatal( ' ===>>>> : symmetrical condition: rerun with good equator line' )
+         ENDIF
+      ENDIF
+
+      ! compute angles between model grid lines and the North direction
+      ! ---------------------------------------------------------------
+      IF( .NOT. ld_domcfg )THEN
+         CALL grid_hgr__angle(td_nam,jpi,jpj) 
+      ENDIF
+
+   END SUBROUTINE grid_hgr_fill
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of curvilinear coordinate on the sphere read in coordinate.nc file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !> @date October, 2016
+   !> - do not use anymore special case for ORCA grid
+   !>
+   !> @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj   
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr__fill_curv( td_nam )!,jpi,jpj ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+!      INTEGER(i4), INTENT(IN) :: jpi
+!      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+!      INTEGER(i4) :: ii0, ii1, ij0, ij1   ! temporary integers
+!      INTEGER(i4) :: isrow                ! index for ORCA1 starting row
+
+      TYPE(TMPP)  :: tl_coord
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! read coordinates
+      ! open file
+      IF( td_nam%c_coord /= '' )THEN
+         tl_coord=mpp_init( file_init(TRIM(td_nam%c_coord)), id_perio=td_nam%i_perio)
+         CALL grid_get_info(tl_coord)
+      ELSE
+         CALL logger_fatal("GRID HGR FILL: no input coordinates file found. "//&
+         &     "check namelist")      
+      ENDIF
+
+      CALL iom_mpp_open( tl_coord )
+
+      ! read variable in coordinates
+      tg_glamt=iom_mpp_read_var(tl_coord, 'glamt')
+      tg_glamu=iom_mpp_read_var(tl_coord, 'glamu')
+      tg_glamv=iom_mpp_read_var(tl_coord, 'glamv')
+      tg_glamf=iom_mpp_read_var(tl_coord, 'glamf')
+
+      tg_gphit=iom_mpp_read_var(tl_coord, 'gphit')
+      tg_gphiu=iom_mpp_read_var(tl_coord, 'gphiu')
+      tg_gphiv=iom_mpp_read_var(tl_coord, 'gphiv')
+      tg_gphif=iom_mpp_read_var(tl_coord, 'gphif')
+
+      ! force output type
+      tg_glamt%i_type=NF90_DOUBLE
+      tg_glamu%i_type=NF90_DOUBLE
+      tg_glamv%i_type=NF90_DOUBLE
+      tg_glamf%i_type=NF90_DOUBLE
+
+      tg_gphit%i_type=NF90_DOUBLE
+      tg_gphiu%i_type=NF90_DOUBLE
+      tg_gphiv%i_type=NF90_DOUBLE
+      tg_gphif%i_type=NF90_DOUBLE
+
+      tg_e1t  =iom_mpp_read_var(tl_coord, 'e1t')
+      tg_e1u  =iom_mpp_read_var(tl_coord, 'e1u')
+      tg_e1v  =iom_mpp_read_var(tl_coord, 'e1v')
+      tg_e1f  =iom_mpp_read_var(tl_coord, 'e1f')
+
+      tg_e2t  =iom_mpp_read_var(tl_coord, 'e2t')
+      tg_e2u  =iom_mpp_read_var(tl_coord, 'e2u')
+      tg_e2v  =iom_mpp_read_var(tl_coord, 'e2v')
+      tg_e2f  =iom_mpp_read_var(tl_coord, 'e2f')
+
+      CALL iom_mpp_close( tl_coord )
+      ! clean
+      CALL mpp_clean(tl_coord)
+
+      !! WARNING extended grid have to be correctly fill
+
+!      !! special case for ORCA grid
+!      ! ORCA R2 configuration
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN
+!            IF( td_nam%i_cla == 0 ) THEN
+!               !
+!               ! Gibraltar Strait (e2u = 20 km)
+!               ii0 = 139   ;   ii1 = 140
+!               ij0 = 102   ;   ij1 = 102   
+!               ! e2u = 20 km
+!               tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  20.e3
+!               CALL logger_info('orca_r2: Gibraltar    : e2u reduced to 20 km')
+!               !
+!               ! Bab el Mandeb (e2u = 18 km)
+!               ii0 = 160   ;   ii1 = 160 
+!               ij0 =  88   ;   ij1 =  88   
+!               ! e1v = 18 km
+!               tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  18.e3
+!               ! e2u = 30 km
+!               tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  30.e3
+!
+!               CALL logger_info('orca_r2: Bab el Mandeb: e2u reduced to 30 km')
+!               CALL logger_info('e1v reduced to 18 km')
+!            ENDIF
+!            ! Danish Straits
+!            ii0 = 145   ;   ii1 = 146
+!            ij0 = 116   ;   ij1 = 116   
+!            ! e2u = 10 km
+!            tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!            CALL logger_info('orca_r2: Danish Straits : e2u reduced to 10 km')
+!      ENDIF
+!
+!      ! ORCA R1 configuration
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 1 ) THEN
+!         ! This dirty section will be suppressed by simplification process: all this will come back in input files
+!         ! Currently these hard-wired indices relate to configuration with
+!         ! extend grid (jpjglo=332)
+!         ! which had a grid-size of 362x292.
+!
+!         isrow = 332 - jpj
+!
+!         ! Gibraltar Strait (e2u = 20 km)
+!         ii0 = 282           ;   ii1 = 283
+!         ij0 = 201 + isrow   ;   ij1 = 241 - isrow 
+!         ! e2u = 20 km
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  20.e3
+!         CALL logger_info('orca_r1: Gibraltar : e2u reduced to 20 km')
+!
+!         ! Bhosporus Strait (e2u = 10 km)
+!         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
+!         ij0 = 208 + isrow   ;   ij1 = 248 - isrow
+!         ! Bhosporus Strait (e2u = 10 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r1: Bhosporus : e2u reduced to 10 km')
+!
+!         ! Lombok Strait (e1v = 13 km)
+!         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         ! Lombok Strait (e1v = 13 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  13.e3
+!         CALL logger_info('orca_r1: Lombok : e1v reduced to 10 km')
+!
+!         ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+!         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  8.e3
+!         CALL logger_info('orca_r1: Sumba : e1v reduced to 8 km')
+!
+!         ! Ombai Strait (e1v = 13 km)
+!         ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         ! Ombai Strait (e1v = 13 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3
+!         CALL logger_info('orca_r1: Ombai : e1v reduced to 13 km')
+!
+!         ! Timor Passage (e1v = 20 km)
+!         ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
+!         ij0 = 124 + isrow   ;   ij1 = 145 - isrow
+!         ! Timor Passage (e1v = 20 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3
+!         CALL logger_info('orca_r1: Timor Passage : e1v reduced to 20 km')
+!
+!          ! West Halmahera Strait (e1v = 30 km)
+!         ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         ! West Halmahera Strait (e1v = 30 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3
+!         CALL logger_info('orca_r1: W Halmahera : e1v reduced to 30 km')
+!
+!         ! East Halmahera Strait (e1v = 50 km)
+!         ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         ! East Halmahera Strait (e1v = 50 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 50.e3
+!         CALL logger_info('orca_r1: E Halmahera : e1v reduced to 50 km')
+!
+!      ENDIF
+!
+!      ! ORCA R05 configuration
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 05 ) THEN
+!
+!         ! Gibraltar Strait (e2u = 20 km)
+!         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
+!         ij0 = 327   ;   ij1 = 327
+!         ! Gibraltar Strait (e2u = 20 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  20.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Gibraltar Strait')
+!         !
+!         ! Bosphore Strait (e2u = 10 km)
+!         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u = 10 km)
+!         ij0 = 343   ;   ij1 = 343
+!         ! Bosphore Strait (e2u = 10 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Bosphore Strait')
+!         !
+!         ! Sumba Strait (e2u = 40 km)
+!         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u = 40 km)
+!         ij0 = 232   ;   ij1 = 232
+!         ! Sumba Strait (e2u = 40 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  40.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Sumba Strait')
+!         !
+!         ! Ombai Strait (e2u = 15 km)
+!         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u = 15 km)
+!         ij0 = 232   ;   ij1 = 232
+!         ! Ombai Strait (e2u = 15 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  15.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Ombai Strait')
+!         !
+!         ! Palk Strait (e2u = 10 km)
+!         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u = 10 km)
+!         ij0 = 270   ;   ij1 = 270
+!         ! Palk Strait (e2u = 10 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Palk Strait')
+!         !
+!         ! Lombok Strait (e1v = 10 km)
+!         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v = 10 km)
+!         ij0 = 232   ;   ij1 = 233
+!         ! Lombok Strait (e1v = 10 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r05: Reduced e1v at the Lombok Strait')
+!         !
+!         !
+!         ! Bab el Mandeb (e1v = 25 km)
+!         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v = 25 km)
+!         ij0 = 276   ;   ij1 = 276
+!         ! Bab el Mandeb (e1v = 25 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  25.e3
+!         CALL logger_info('orca_r05: Reduced e1v at the Bab el Mandeb')
+!
+!      ENDIF
+
+   END SUBROUTINE grid_hgr__fill_curv
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of geographical mesh on the sphere with regular grid-spacing
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj   
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr__fill_reg(td_nam,jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp)   ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(dp)   ::   ztj, zuj, zvj, zfj   !
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : geographical mesh on the sphere with'//&
+         &  ' regular grid-spacing given by ppe1_deg and ppe2_deg')
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zti = FLOAT( ji - 1 )         ;   ztj = FLOAT( jj - 1 )
+            zui = FLOAT( ji - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 )
+            zvi = FLOAT( ji - 1 )         ;   zvj = FLOAT( jj - 1 ) + 0.5
+            zfi = FLOAT( ji - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 ) + 0.5
+      ! Longitude
+            tg_glamt%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zti
+            tg_glamu%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zui
+            tg_glamv%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zvi
+            tg_glamf%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zfi
+      ! Latitude
+            tg_gphit%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * ztj
+            tg_gphiu%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * zuj
+            tg_gphiv%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * zvj
+            tg_gphif%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * zfj
+      ! e1
+            tg_e1t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphit%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiu%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiv%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphif%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+      ! e2
+            tg_e2t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+            tg_e2u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+            tg_e2v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+            tg_e2f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+         END DO
+      END DO
+
+   END SUBROUTINE grid_hgr__fill_reg
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of f- or beta-plane with regular grid-spacing
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj   
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr__fill_plan(td_nam,jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp)    :: dl_glam0
+      REAL(dp)    :: dl_gphi0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : f- or beta-plane with regular'//&
+         &  ' grid-spacing given by ppe1_deg and ppe2_deg')
+!         &  ' grid-spacing given by ppe1_m and ppe2_m')
+
+      ! Position coordinates (in kilometers)
+      !                          ==========
+      dl_glam0 = 0.e0
+      dl_gphi0 = - td_nam%d_ppe2_deg * 1.e-3
+!      dl_gphi0 = - td_nam%d_ppe2_m * 1.e-3
+
+         !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+!            tg_glamt%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_m * 1.e-3 * ( FLOAT( ji - 1 )       )
+!            tg_glamu%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_m * 1.e-3 * ( FLOAT( ji - 1 ) + 0.5 )
+            tg_glamt%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_deg * 1.e-3 * ( FLOAT( ji - 1 )       )
+            tg_glamu%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_deg * 1.e-3 * ( FLOAT( ji - 1 ) + 0.5 )
+            tg_glamv%d_value(ji,jj,1,1) = tg_glamt%d_value(ji,jj,1,1)
+            tg_glamf%d_value(ji,jj,1,1) = tg_glamu%d_value(ji,jj,1,1)
+   
+            !tg_gphit%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_m * 1.e-3 * ( FLOAT( jj - 1 )       )
+            tg_gphit%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_deg * 1.e-3 * ( FLOAT( jj - 1 )       )
+            tg_gphiu%d_value(ji,jj,1,1) = tg_gphit%d_value(ji,jj,1,1)
+            !tg_gphiv%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_m * 1.e-3 * ( FLOAT( jj - 1 ) + 0.5 )
+            tg_gphiv%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_deg * 1.e-3 * ( FLOAT( jj - 1 ) + 0.5 )
+            tg_gphif%d_value(ji,jj,1,1) = tg_gphiv%d_value(ji,jj,1,1)
+         END DO
+      END DO
+
+      ! Horizontal scale factors (in meters)
+      !                              ======
+!      tg_e1t%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+!      tg_e1u%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+!      tg_e1v%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+!      tg_e1f%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+      tg_e1t%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+      tg_e1u%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+      tg_e1v%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+      tg_e1f%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+
+!      tg_e2t%d_value(:,:,1,1) = td_nam%d_ppe2_m
+!      tg_e2u%d_value(:,:,1,1) = td_nam%d_ppe2_m
+!      tg_e2v%d_value(:,:,1,1) = td_nam%d_ppe2_m
+!      tg_e2f%d_value(:,:,1,1) = td_nam%d_ppe2_m
+      tg_e2t%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+      tg_e2u%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+      tg_e2v%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+      tg_e2f%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+
+   END SUBROUTINE grid_hgr__fill_plan
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of geographical mesh on the sphere, isotropic MERCATOR type
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj   
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr__fill_merc(td_nam,jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4)
+
+      REAL(dp) ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(dp) ::   ztj, zuj, zvj, zfj   !
+      REAL(dp) ::   zarg
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : geographical mesh on the sphere, '//&
+        &  'MERCATOR type longitudinal/latitudinal spacing given by ppe1_deg')
+
+      IF( td_nam%d_ppgphi0 == -90 )THEN
+         CALL logger_fatal(' Mercator grid cannot start at south pole !!!! ' )
+      ENDIF
+
+      !  Find index corresponding to the equator, given the grid spacing e1_deg
+      !  and the (approximate) southern latitude ppgphi0.
+      !  This way we ensure that the equator is at a "T / U" point, when in the domain.
+      !  The formula should work even if the equator is outside the domain.
+      zarg = dp_pi / 4. - dp_pi / 180. * td_nam%d_ppgphi0 / 2.
+      ijeq = ABS( 180./dp_pi * LOG( COS( zarg ) / SIN( zarg ) ) / td_nam%d_ppe1_deg )
+      IF( td_nam%d_ppgphi0 > 0 )  ijeq = -ijeq
+
+      CALL logger_info('Index of the equator on the MERCATOR grid: '//TRIM(fct_str(ijeq)))
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zti = FLOAT( ji - 1 )         ;   ztj = FLOAT( jj - ijeq )
+            zui = FLOAT( ji - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq )
+            zvi = FLOAT( ji - 1 )         ;   zvj = FLOAT( jj - ijeq ) + 0.5
+            zfi = FLOAT( ji - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq ) + 0.5
+         ! Longitude
+            tg_glamt%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zti
+            tg_glamu%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zui
+            tg_glamv%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zvi
+            tg_glamf%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zfi
+         ! Latitude
+            tg_gphit%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* ztj ) )
+            tg_gphiu%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* zuj ) )
+            tg_gphiv%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* zvj ) )
+            tg_gphif%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* zfj ) )
+         ! e1
+            tg_e1t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphit%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiu%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiv%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphif%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+         ! e2
+            tg_e2t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphit%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e2u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiu%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e2v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiv%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e2f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphif%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+         END DO
+      END DO
+
+   END SUBROUTINE grid_hgr__fill_merc
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr__fill_gyre(td_nam,jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
+      REAL(dp) ::   zphi1, zsin_alpha, zim05, zjm05
+
+      REAL(dp) ::   dl_glam0
+      REAL(dp) ::   dl_gphi0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : beta-plane with regular grid-spacing '//&
+         &  'and rotated domain (GYRE configuration)')
+
+      ! Position coordinates (in kilometers)
+      !
+      ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
+      zlam1 = -85
+      zphi1 = 29
+      ! resolution in meters
+      ze1 = 106000. / FLOAT(td_nam%i_cfg)            
+      ! benchmark: forced the resolution to be about 100 km
+      IF( td_nam%l_bench )   ze1 = 106000.e0     
+      zsin_alpha = - SQRT( 2. ) / 2.
+      zcos_alpha =   SQRT( 2. ) / 2.
+      ze1deg = ze1 / (dp_rearth * dp_deg2rad)
+      dl_glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpj-2 )
+      dl_gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpj-2 )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zim1 = FLOAT( ji - 1 )   ;   zim05 = FLOAT( ji ) - 1.5
+            zjm1 = FLOAT( jj - 1 )   ;   zjm05 = FLOAT( jj ) - 1.5
+
+            tg_glamf%d_value(ji,jj,1,1) = dl_glam0 &
+                                        &  + zim1  * ze1deg * zcos_alpha &
+                                        &  + zjm1  * ze1deg * zsin_alpha
+            tg_gphif%d_value(ji,jj,1,1) = dl_gphi0 &
+                                        & - zim1  * ze1deg * zsin_alpha &
+                                        & + zjm1  * ze1deg * zcos_alpha
+
+            tg_glamt%d_value(ji,jj,1,1) = dl_glam0 &
+                                        & + zim05 * ze1deg * zcos_alpha &
+                                        & + zjm05 * ze1deg * zsin_alpha
+            tg_gphit%d_value(ji,jj,1,1) = dl_gphi0 &
+                                        & - zim05 * ze1deg * zsin_alpha &
+                                        & + zjm05 * ze1deg * zcos_alpha
+
+            tg_glamu%d_value(ji,jj,1,1) = dl_glam0 &
+                                        & + zim1  * ze1deg * zcos_alpha &
+                                        & + zjm05 * ze1deg * zsin_alpha
+            tg_gphiu%d_value(ji,jj,1,1) = dl_gphi0 & 
+                                        & - zim1  * ze1deg * zsin_alpha &
+                                        & + zjm05 * ze1deg * zcos_alpha
+
+            tg_glamv%d_value(ji,jj,1,1) = dl_glam0 &
+                                        & + zim05 * ze1deg * zcos_alpha &
+                                        & + zjm1  * ze1deg * zsin_alpha
+            tg_gphiv%d_value(ji,jj,1,1) = dl_gphi0 &
+                                        & - zim05 * ze1deg * zsin_alpha &
+                                        & + zjm1  * ze1deg * zcos_alpha
+
+         END DO
+      END DO
+
+      ! Horizontal scale factors (in meters)
+      !                              ======
+      tg_e1t%d_value(:,:,1,1) = ze1      
+      tg_e1u%d_value(:,:,1,1) = ze1      
+      tg_e1v%d_value(:,:,1,1) = ze1      
+      tg_e1f%d_value(:,:,1,1) = ze1      
+
+      tg_e2t%d_value(:,:,1,1) = ze1
+      tg_e2u%d_value(:,:,1,1) = ze1
+      tg_e2v%d_value(:,:,1,1) = ze1
+      tg_e2f%d_value(:,:,1,1) = ze1
+
+   END SUBROUTINE grid_hgr__fill_gyre
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill coriolis factor
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !> @date October, 2016
+   !> - compute coriolis factor at f-point and at t-point
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   ! @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_hgr__fill_coriolis(td_nam,jpi)!,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+!      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp) :: zbeta
+      REAL(dp) :: zphi0  
+      REAL(dp) :: zf0
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !  Coriolis factor
+      SELECT CASE( td_nam%i_mshhgr )   ! type of horizontal mesh
+
+         CASE ( 0, 1, 4 ) ! mesh on the sphere
+
+            tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphif%d_value(:,:,1,1))
+            tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphit%d_value(:,:,1,1)) ! at t-point
+
+         CASE ( 2 )  ! f-plane at ppgphi0 
+
+            tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 )
+            tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 )
+            CALL logger_info('f-plane: Coriolis parameter = constant = '//&
+               &  TRIM(fct_str(tg_ff_f%d_value(1,1,1,1))) )
+
+         CASE ( 3 )  ! beta-plane
+
+            ! beta at latitude ppgphi0
+            zbeta = 2. * dp_omega * COS( dp_deg2rad * td_nam%d_ppgphi0 ) / dp_rearth
+            ! latitude of the first row F-points
+!            zphi0 = td_nam%d_ppgphi0 - FLOAT( jpi/2 ) * td_nam%d_ppe2_m / ( dp_rearth * dp_deg2rad )
+            zphi0 = td_nam%d_ppgphi0 - FLOAT( jpi/2 ) * td_nam%d_ppe2_deg / ( dp_rearth * dp_deg2rad )
+
+            ! compute f0 1st point south
+            zf0 = 2. * dp_omega * SIN( dp_deg2rad * zphi0 )
+            ! f = f0 +beta* y ( y=0 at south)
+            tg_ff_f%d_value(:,:,1,1) = zf0 + zbeta * tg_gphif%d_value(:,:,1,1) * 1.e3
+            tg_ff_t%d_value(:,:,1,1) = zf0 + zbeta * tg_gphit%d_value(:,:,1,1) * 1.e3
+
+         CASE ( 5 )  ! beta-plane and rotated domain (gyre configuration)
+
+            ! beta at latitude ppgphi0
+            zbeta = 2. * dp_omega * COS( dp_deg2rad * td_nam%d_ppgphi0 ) / dp_rearth
+            ! latitude of the first row F-points
+            zphi0 = 15.e0
+            ! compute f0 1st point south
+            zf0   = 2. * dp_omega * SIN( dp_deg2rad * zphi0 )
+
+            ! f = f0 +beta* y ( y=0 at south)
+            tg_ff_f%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphif%d_value(:,:,1,1) - zphi0 ) &
+                                     & * dp_deg2rad * dp_rearth )
+            tg_ff_t%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphit%d_value(:,:,1,1) - zphi0 ) &
+                                     & * dp_deg2rad * dp_rearth )
+
+      END SELECT
+
+   END SUBROUTINE grid_hgr__fill_coriolis
+   !!----------------------------------------------------------------------
+   !! @brief This subroutine compute angles between model grid lines and the North direction
+   !>
+   !> @details
+   !> ** Method  :
+   !>
+   !> ** Action  :   Compute (gsint, gcost, gsinu, gcosu, gsinv, gcosv, gsinf, gcosf) arrays:
+   !>      sinus and cosinus of the angle between the north-south axe and the 
+   !>      j-direction at t, u, v and f-points
+   !>
+   !> History :
+   !>   7.0  !  96-07  (O. Marti )  Original code
+   !>   8.0  !  98-06  (G. Madec )
+   !>   8.5  !  98-06  (G. Madec )  Free form, F90 + opt.
+   !>   9.2  !  07-04  (S. Masson)  Add T, F points and bugfix in cos lateral boundary
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from geo2ocean
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !!----------------------------------------------------------------------
+   SUBROUTINE grid_hgr__angle(td_nam, jpi,jpj)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp) :: zlam, zphi          
+      REAL(dp) :: zlan, zphh          
+      REAL(dp) :: zxnpt, zynpt, znnpt ! x,y components and norm of the vector: T point to North Pole
+      REAL(dp) :: zxnpu, zynpu, znnpu ! x,y components and norm of the vector: U point to North Pole
+      REAL(dp) :: zxnpv, zynpv, znnpv ! x,y components and norm of the vector: V point to North Pole
+      REAL(dp) :: zxnpf, zynpf, znnpf ! x,y components and norm of the vector: F point to North Pole
+      REAL(dp) :: zxvvt, zyvvt, znvvt ! x,y components and norm of the vector: between V points below and above a T point
+      REAL(dp) :: zxffu, zyffu, znffu ! x,y components and norm of the vector: between F points below and above a U point
+      REAL(dp) :: zxffv, zyffv, znffv ! x,y components and norm of the vector: between F points left  and right a V point
+      REAL(dp) :: zxuuf, zyuuf, znuuf ! x,y components and norm of the vector: between U points below and above a F point
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !!----------------------------------------------------------------------
+
+      ! ============================= !
+      ! Compute the cosinus and sinus !
+      ! ============================= !
+      ! (computation done on the north stereographic polar plane)
+
+      DO jj = 2, jpj-1
+!CDIR NOVERRCHK
+         DO ji = 2, jpi   ! vector opt.
+
+            ! north pole direction & modulous (at t-point)
+            zlam = tg_glamt%d_value(ji,jj,1,1)
+            zphi = tg_gphit%d_value(ji,jj,1,1)
+            zxnpt = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpt = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpt = zxnpt*zxnpt + zynpt*zynpt
+
+            ! north pole direction & modulous (at u-point)
+            zlam = tg_glamu%d_value(ji,jj,1,1)
+            zphi = tg_gphiu%d_value(ji,jj,1,1)
+            zxnpu = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpu = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpu = zxnpu*zxnpu + zynpu*zynpu
+
+            ! north pole direction & modulous (at v-point)
+            zlam = tg_glamv%d_value(ji,jj,1,1)
+            zphi = tg_gphiv%d_value(ji,jj,1,1)
+            zxnpv = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpv = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpv = zxnpv*zxnpv + zynpv*zynpv
+
+            ! north pole direction & modulous (at f-point)
+            zlam = tg_glamf%d_value(ji,jj,1,1)
+            zphi = tg_gphif%d_value(ji,jj,1,1)
+            zxnpf = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpf = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpf = zxnpf*zxnpf + zynpf*zynpf
+
+            ! j-direction: v-point segment direction (around t-point)
+            zlam = tg_glamv%d_value(ji,jj  ,1,1)
+            zphi = tg_gphiv%d_value(ji,jj  ,1,1)
+            zlan = tg_glamv%d_value(ji,jj-1,1,1)
+            zphh = tg_gphiv%d_value(ji,jj-1,1,1)
+            zxvvt =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyvvt =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
+            znvvt = MAX( znvvt, dp_eps )
+
+            ! j-direction: f-point segment direction (around u-point)
+            zlam = tg_glamf%d_value(ji,jj  ,1,1)
+            zphi = tg_gphif%d_value(ji,jj  ,1,1)
+            zlan = tg_glamf%d_value(ji,jj-1,1,1)
+            zphh = tg_gphif%d_value(ji,jj-1,1,1)
+            zxffu =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyffu =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
+            znffu = MAX( znffu, dp_eps )
+
+            ! i-direction: f-point segment direction (around v-point)
+            zlam = tg_glamf%d_value(ji  ,jj,1,1)
+            zphi = tg_gphif%d_value(ji  ,jj,1,1)
+            zlan = tg_glamf%d_value(ji-1,jj,1,1)
+            zphh = tg_gphif%d_value(ji-1,jj,1,1)
+            zxffv =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyffv =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
+            znffv = MAX( znffv, dp_eps )
+
+            ! j-direction: u-point segment direction (around f-point)
+            zlam = tg_glamu%d_value(ji,jj+1,1,1)
+            zphi = tg_gphiu%d_value(ji,jj+1,1,1)
+            zlan = tg_glamu%d_value(ji,jj  ,1,1)
+            zphh = tg_gphiu%d_value(ji,jj  ,1,1)
+            zxuuf =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyuuf =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
+            znuuf = MAX( znuuf, dp_eps )
+
+            ! cosinus and sinus using scalar and vectorial products
+            tg_gsint%d_value(ji,jj,1,1) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
+            tg_gcost%d_value(ji,jj,1,1) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
+
+            tg_gsinu%d_value(ji,jj,1,1) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
+            tg_gcosu%d_value(ji,jj,1,1) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
+
+            tg_gsinf%d_value(ji,jj,1,1) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
+            tg_gcosf%d_value(ji,jj,1,1) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
+
+            ! (caution, rotation of 90 degres)
+            tg_gsinv%d_value(ji,jj,1,1) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
+            tg_gcosv%d_value(ji,jj,1,1) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv
+
+         END DO
+      END DO
+
+      ! =============== !
+      ! Geographic mesh !
+      ! =============== !
+
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi   ! vector opt.
+            IF( MOD( ABS( tg_glamv%d_value(ji,jj,1,1) - tg_glamv%d_value(ji,jj-1,1,1) ), 360._dp ) < 1.e-8 ) THEN
+               tg_gsint%d_value(ji,jj,1,1) = 0._dp
+               tg_gcost%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+            IF( MOD( ABS( tg_glamf%d_value(ji,jj,1,1) - tg_glamf%d_value(ji,jj-1,1,1) ), 360._dp ) < 1.e-8 ) THEN
+               tg_gsinu%d_value(ji,jj,1,1) = 0._dp
+               tg_gcosu%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+            IF(      ABS( tg_gphif%d_value(ji,jj,1,1) - tg_gphif%d_value(ji-1,jj,1,1) )            < 1.e-8 ) THEN
+               tg_gsinv%d_value(ji,jj,1,1) = 0._dp
+               tg_gcosv%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+            IF( MOD( ABS( tg_glamu%d_value(ji,jj,1,1) - tg_glamu%d_value(ji,jj+1,1,1) ), 360._dp ) < 1.e-8 ) THEN
+               tg_gsinf%d_value(ji,jj,1,1) = 0._dp
+               tg_gcosf%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+         END DO
+      END DO
+
+      ! =========================== !
+      ! Lateral boundary conditions !
+      ! =========================== !
+
+      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn
+      CALL lbc_lnk( tg_gcost%d_value(:,:,1,1), 'T', td_nam%i_perio, -1._dp )   
+      CALL lbc_lnk( tg_gcosu%d_value(:,:,1,1), 'U', td_nam%i_perio, -1._dp )   
+      CALL lbc_lnk( tg_gcosv%d_value(:,:,1,1), 'V', td_nam%i_perio, -1._dp )   
+      CALL lbc_lnk( tg_gcosf%d_value(:,:,1,1), 'F', td_nam%i_perio, -1._dp )   
+
+      CALL lbc_lnk( tg_gsint%d_value(:,:,1,1), 'T', td_nam%i_perio, -1._dp )
+      CALL lbc_lnk( tg_gsinu%d_value(:,:,1,1), 'U', td_nam%i_perio, -1._dp )
+      CALL lbc_lnk( tg_gsinv%d_value(:,:,1,1), 'V', td_nam%i_perio, -1._dp )
+      CALL lbc_lnk( tg_gsinf%d_value(:,:,1,1), 'F', td_nam%i_perio, -1._dp )
+
+   END SUBROUTINE grid_hgr__angle
+END MODULE grid_hgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid_zgr.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid_zgr.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/grid_zgr.f90	(revision 8732)
@@ -0,0 +1,4373 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: grid_zgr
+!
+! DESCRIPTION:
+!> @brief This module manage Vertical grid.
+!>
+!> @details
+!> ** Purpose :   set the depth of model levels and the resulting 
+!>              vertical scale factors.
+!>
+!> ** Method  : 
+!>    - reference 1D vertical coordinate (gdep._1d, e3._1d)
+!>    - read/set ocean depth and ocean levels (bathy, mbathy)
+!>    - vertical coordinate (gdep., e3.) depending on the coordinate chosen :
+!>       - ln_zco=T   z-coordinate   
+!>       - ln_zps=T   z-coordinate with partial steps
+!>       - ln_zco=T   s-coordinate 
+!>
+!> ** Action  :   define gdep., e3., mbathy and bathy
+!>
+!> @author
+!> G, Madec
+! REVISION HISTORY:
+!> @date December, 1995 - Original code : s vertical coordinate
+!> @date July, 1997
+!> - lbc_lnk call
+!> @date September, 2002
+!> - A. Bozec, G. Madec : F90: Free form and module
+!> @date September, 2002
+!> - A. de Miranda : rigid-lid + islands
+!> @date August, 2003
+!> - G. Madec : Free form and module
+!> @date October, 2005
+!> - A. Beckmann : modifications for hybrid s-ccordinates & new stretching function
+!> @date April, 2006
+!> - R. Benshila, G. Madec : add zgr_zco
+!> @date June, 2008
+!> - G. Madec : insertion of domzgr_zps.h90 & conding style
+!> @date July, 2009
+!> - R. Benshila : Suppression of rigid-lid option
+!> @date November, 2011
+!> - G. Madec : add mbk. arrays associated to the deepest ocean level
+!> @date August, 2012
+!> - J. Siddorn : added Siddorn and Furner stretching function
+!> @date December, 2012
+!> - R. Bourdalle-Badie and G. Reffray : modify C1D case
+!> @date November, 2014
+!> - P. Mathiot and C. Harris : add ice shelf capabilitye
+!> @date November, 2015
+!> - H. Liu : Modifications for Wetting/Drying
+!> @date October, 2016
+!> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
+!> - J, Paul : do not use anymore special case for ORCA grid.
+!> @date November, 2016
+!> - J, Paul : vertical scale factors e3. = dk[gdep] or old definition
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE grid_zgr
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   USE lbc                             ! lateral boundary conditions
+   USE grid_hgr                        ! Horizontal mesh
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+   ! type and variable
+   PUBLIC :: TNAMZ
+
+   PUBLIC :: tg_gdepw_1d
+   PUBLIC :: tg_gdept_1d
+   PUBLIC :: tg_e3w_1d
+   PUBLIC :: tg_e3t_1d
+   PUBLIC :: tg_e3tp 
+   PUBLIC :: tg_e3wp 
+
+   PUBLIC :: tg_rx1 
+   
+   PUBLIC :: tg_mbathy
+   PUBLIC :: tg_misfdep
+
+   PUBLIC :: tg_gdept_0 
+   PUBLIC :: tg_gdepw_0
+!   PUBLIC :: tg_gdep3w_0  !useless to create meshmask
+   PUBLIC :: tg_e3t_0
+   PUBLIC :: tg_e3u_0
+   PUBLIC :: tg_e3v_0
+   PUBLIC :: tg_e3w_0
+   PUBLIC :: tg_e3f_0     !useless to create meshmask
+   PUBLIC :: tg_e3uw_0    !useless to create meshmask
+   PUBLIC :: tg_e3vw_0    !useless to create meshmask
+   
+   PUBLIC :: tg_mbkt
+!   PUBLIC :: tg_mbku      !useless to create meshmask
+!   PUBLIC :: tg_mbkv      !useless to create meshmask
+   PUBLIC :: tg_mikt
+!   PUBLIC :: tg_miku      !useless to create meshmask
+!   PUBLIC :: tg_mikv      !useless to create meshmask
+!   PUBLIC :: tg_mikf      !useless to create meshmask
+
+   PUBLIC :: tg_hbatt     !            sco
+   PUBLIC :: tg_hbatu     !            sco
+   PUBLIC :: tg_hbatv     !            sco
+   PUBLIC :: tg_hbatf     !            sco
+
+   PUBLIC :: tg_gsigt     !            sco(tanh)
+   PUBLIC :: tg_gsigw     !            sco(tanh)
+   PUBLIC :: tg_gsi3w     !            sco(tanh)
+   PUBLIC :: tg_esigt     !            sco(tanh)
+   PUBLIC :: tg_esigw     !            sco(tanh)
+
+   ! function and subroutine
+   PUBLIC :: grid_zgr_init 
+   PUBLIC :: grid_zgr_nam
+   PUBLIC :: grid_zgr_fill
+   PUBLIC :: grid_zgr_clean
+
+   PUBLIC :: grid_zgr_zps_init 
+   PUBLIC :: grid_zgr_zps_clean
+   PUBLIC :: grid_zgr_sco_init
+   PUBLIC :: grid_zgr_sco_clean
+   PUBLIC :: grid_zgr_sco_stiff 
+
+   PRIVATE :: grid_zgr__z
+   PRIVATE :: grid_zgr__bat 
+   PRIVATE :: grid_zgr__zco 
+!   PRIVATE :: grid_zgr__bat_zoom
+   PRIVATE :: grid_zgr__bat_ctl
+   PRIVATE :: grid_zgr__bot_level
+   PRIVATE :: grid_zgr__top_level
+   PRIVATE :: grid_zgr__zps_fill
+   PRIVATE :: grid_zgr__isf_fill
+!   PRIVATE :: grid_zgr__isf_fill_e3x
+   PRIVATE :: grid_zgr__isf_fill_e3uw
+!   PRIVATE :: grid_zgr__isf_fill_gdep3w_0
+   PRIVATE :: grid_zgr__sco_fill
+   PRIVATE :: grid_zgr__sco_s_sh94 
+   PRIVATE :: grid_zgr__sco_s_sf12
+   PRIVATE :: grid_zgr__sco_s_tanh
+   PRIVATE :: grid_zgr__sco_fssig      !: tanh stretch function
+   PRIVATE :: grid_zgr__sco_fssig1     !: Song and Haidvogel 1994 stretch function
+   PRIVATE :: grid_zgr__sco_fgamma     !: Siddorn and Furner 2012 stretching function 
+
+   TYPE TNAMZ
+
+      CHARACTER(LEN=lc) :: c_coord   
+      INTEGER(i4)       :: i_perio   
+                
+      LOGICAL           :: l_zco               
+      LOGICAL           :: l_zps      
+      LOGICAL           :: l_sco      
+      LOGICAL           :: l_isfcav   
+      LOGICAL           :: l_iscpl   
+      LOGICAL           :: l_wd   
+      INTEGER(i4)       :: i_nlevel   
+                  
+      REAL(dp)          :: d_ppsur    
+      REAL(dp)          :: d_ppa0     
+      REAL(dp)          :: d_ppa1     
+      REAL(dp)          :: d_ppkth    
+      REAL(dp)          :: d_ppacr    
+      REAL(dp)          :: d_ppdzmin  
+      REAL(dp)          :: d_pphmax   
+      LOGICAL           :: l_dbletanh 
+      REAL(dp)          :: d_ppa2     
+      REAL(dp)          :: d_ppkth2   
+      REAL(dp)          :: d_ppacr2   
+                  
+      REAL(dp)          :: d_hmin     
+      REAL(dp)          :: d_isfhmin
+
+      REAL(dp)          :: d_e3zps_min
+      REAL(dp)          :: d_e3zps_rat
+!      INTEGER(i4)       :: i_msh      
+                  
+      LOGICAL           :: l_s_sh94   
+      LOGICAL           :: l_s_sf12   
+      REAL(dp)          :: d_sbot_min 
+      REAL(dp)          :: d_sbot_max 
+      ! Song and Haidvogel 1994 stretching additional parameters
+      REAL(dp)          :: d_rmax     
+      REAL(dp)          :: d_hc       
+      REAL(dp)          :: d_theta    
+      REAL(dp)          :: d_thetb    
+      REAL(dp)          :: d_bb       
+      ! Siddorn and Furner stretching additional parameters 
+      LOGICAL           :: l_sigcrit  
+      REAL(dp)          :: d_alpha    
+      REAL(dp)          :: d_efold    
+      REAL(dp)          :: d_zs       
+      REAL(dp)          :: d_zb_a     
+      REAL(dp)          :: d_zb_b     
+                  
+      INTEGER(i4)       :: i_cla     
+
+      REAL(dp)          :: d_wdmin1 
+      REAL(dp)          :: d_wdmin2 
+      REAL(dp)          :: d_wdld 
+
+!      CHARACTER(LEN=lc) :: c_cfg     
+!      INTEGER(i4)       :: i_cfg     
+!      INTEGER(i4)       :: i_bench   
+!      LOGICAL           :: l_zoom
+      LOGICAL           :: l_c1d
+      LOGICAL           :: l_e3_dep
+                
+!      CHARACTER(LEN=lc) :: c_cfz      
+!      INTEGER(i4)       :: i_izoom    
+!      INTEGER(i4)       :: i_jzoom    
+!      LOGICAL           :: l_zoom_s   
+!      LOGICAL           :: l_zoom_e   
+!      LOGICAL           :: l_zoom_w   
+!      LOGICAL           :: l_zoom_n
+
+   END TYPE
+
+   TYPE(TVAR), SAVE :: tg_gdepw_1d  !zco & zps & sco
+   TYPE(TVAR), SAVE :: tg_gdept_1d  !zco & zps & sco
+   TYPE(TVAR), SAVE :: tg_e3w_1d    !zco & zps
+   TYPE(TVAR), SAVE :: tg_e3t_1d    !zco & zps
+   TYPE(TVAR), SAVE :: tg_e3tp      !      zps
+   TYPE(TVAR), SAVE :: tg_e3wp      !      zps
+   
+   TYPE(TVAR), SAVE :: tg_rx1       !            sco
+   
+   TYPE(TVAR), SAVE :: tg_mbathy    !zco & zps & sco
+   TYPE(TVAR), SAVE :: tg_misfdep
+
+   TYPE(TVAR), SAVE :: tg_gdept_0   !      zps & sco
+   TYPE(TVAR), SAVE :: tg_gdepw_0   !      zps & sco
+   !TYPE(TVAR), SAVE :: tg_gdep3w_0
+   TYPE(TVAR), SAVE :: tg_e3t_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3u_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3v_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3w_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3f_0
+   TYPE(TVAR), SAVE :: tg_e3uw_0
+   TYPE(TVAR), SAVE :: tg_e3vw_0
+   
+   TYPE(TVAR), SAVE :: tg_mbkt      !zco & zps & sco
+   !TYPE(TVAR), SAVE :: tg_mbku
+   !TYPE(TVAR), SAVE :: tg_mbkv
+   TYPE(TVAR), SAVE :: tg_mikt      !zco & zps & sco
+   !TYPE(TVAR), SAVE :: tg_miku
+   !TYPE(TVAR), SAVE :: tg_mikv
+   !TYPE(TVAR), SAVE :: tg_mikf
+
+   TYPE(TVAR), SAVE :: tg_hbatt     !            sco
+   TYPE(TVAR), SAVE :: tg_hbatu     !            sco
+   TYPE(TVAR), SAVE :: tg_hbatv     !            sco
+   TYPE(TVAR), SAVE :: tg_hbatf     !            sco
+
+   TYPE(TVAR), SAVE :: tg_gsigt     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_gsigw     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_gsi3w     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_esigt     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_esigw     !            sco(tanh)
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This function initialise global variable needed to compute vertical
+   !>        mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] ld_sco
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_init( jpi,jpj,jpk, ld_sco ) 
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      INTEGER(i4), INTENT(IN) :: jpk
+      LOGICAL    , INTENT(IN) :: ld_sco
+
+      ! local variable
+      REAL(dp), DIMENSION(jpk)         :: dl_tmp1D
+      REAL(dp), DIMENSION(jpi,jpj)     :: dl_tmp2D
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: dl_tmp3D
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! variable 1D
+      dl_tmp1D(:)    =dp_fill
+
+      tg_gdepw_1d=var_init('gdepw_1d',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gdept_1d=var_init('gdept_1d',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3w_1d  =var_init('e3w_1d  ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3t_1d  =var_init('e3t_1d  ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      !only sco
+      IF( ld_sco )THEN
+         tg_gsigt   =var_init('gsigt   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsigw   =var_init('gsigw   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsi3w   =var_init('gsi3w   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_esigt   =var_init('esigt   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_esigw   =var_init('esigw   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      ENDIF
+
+      ! variable 2D
+      dl_tmp2D(:,:)  =dp_fill_i2
+
+      tg_mbkt    =var_init('mbkt    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mbku    =var_init('mbku    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mbkv    =var_init('mbkv    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      tg_mikt    =var_init('mikt    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_miku    =var_init('miku    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mikv    =var_init('mikv    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mikf    =var_init('mikf    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+
+      dl_tmp2D(:,:)  =dp_fill_i4
+
+      tg_mbathy  =var_init('mbathy  ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i4, id_type=NF90_INT)
+      tg_misfdep =var_init('misfdep ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i4, id_type=NF90_INT)
+
+      dl_tmp2D(:,:)  =dp_fill
+
+      ! only sco
+      IF( ld_sco )THEN
+         tg_hbatt   =var_init('hbatt   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_hbatu   =var_init('hbatu   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_hbatv   =var_init('hbatv   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_hbatf   =var_init('hbatf   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      ENDIF
+
+      ! variable 3D
+      dl_tmp3D(:,:,:)=dp_fill
+
+      tg_gdept_0 =var_init('gdept_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gdepw_0 =var_init('gdepw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      !tg_gdep3w_0=var_init('gdep3w_0',dl_tmp3D(:,:,:), dd_fill=dp_fill_sp, id_type=NF90_FLOAT)
+
+      tg_e3t_0   =var_init('e3t_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3u_0   =var_init('e3u_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3v_0   =var_init('e3v_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3w_0   =var_init('e3w_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3f_0   =var_init('e3f_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3uw_0  =var_init('e3uw_0  ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3vw_0  =var_init('e3vw_0  ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+   END SUBROUTINE grid_zgr_init
+   !-------------------------------------------------------------------
+   !> @brief This function clean hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] ld_sco
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_clean(ld_sco) 
+      IMPLICIT NONE
+      ! Argument      
+      LOGICAL    , INTENT(IN) :: ld_sco
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_gdepw_1d)
+      CALL var_clean(tg_gdept_1d)
+      CALL var_clean(tg_e3w_1d  )
+      CALL var_clean(tg_e3t_1d  )
+
+      IF( ld_sco )THEN
+         CALL var_clean(tg_gsigt   )
+         CALL var_clean(tg_gsigw   )
+         CALL var_clean(tg_gsi3w   )
+         CALL var_clean(tg_esigt   )
+         CALL var_clean(tg_esigw   )
+      ENDIF
+      
+      CALL var_clean(tg_mbathy  )
+      CALL var_clean(tg_misfdep )
+
+      CALL var_clean(tg_mbkt    )
+      !CALL var_clean(tg_mbku    )
+      !CALL var_clean(tg_mbkv    )
+      CALL var_clean(tg_mikt    )
+      !CALL var_clean(tg_miku    )
+      !CALL var_clean(tg_mikv    )
+      !CALL var_clean(tg_mikf    )
+
+      IF( ld_sco )THEN
+         CALL var_clean(tg_hbatt   )
+         CALL var_clean(tg_hbatu   )
+         CALL var_clean(tg_hbatv   )
+         CALL var_clean(tg_hbatf   )
+      ENDIF
+
+      CALL var_clean(tg_gdept_0 )
+      CALL var_clean(tg_gdepw_0 )
+      !CALL var_clean(tg_gdep3w_0)
+
+      CALL var_clean(tg_e3t_0   )
+      CALL var_clean(tg_e3u_0   )
+      CALL var_clean(tg_e3v_0   )
+      CALL var_clean(tg_e3f_0   )
+      CALL var_clean(tg_e3uw_0  )
+      CALL var_clean(tg_e3vw_0  )
+      
+   END SUBROUTINE grid_zgr_clean
+   !-------------------------------------------------------------------
+   !> @brief This function initialise zgr namelist structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] cd_coord   
+   !> @param[in] id_perio  
+   !> @param[in] cd_namelist
+   !> @return hgr namelist structure
+   !-------------------------------------------------------------------
+   FUNCTION grid_zgr_nam( cd_coord,id_perio,cd_namelist )
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_coord
+      INTEGER(i4)     , INTENT(IN) :: id_perio   
+
+      CHARACTER(LEN=*), INTENT(IN) :: cd_namelist
+      
+      ! function
+      TYPE(TNAMZ) :: grid_zgr_nam
+
+      ! local variable
+      INTEGER(i4)        :: il_status
+      INTEGER(i4)        :: il_fileid
+
+      LOGICAL            :: ll_exist
+
+      ! namelist
+      ! namzgr
+      LOGICAL           :: ln_zco      = .FALSE.
+      LOGICAL           :: ln_zps      = .FALSE.
+      LOGICAL           :: ln_sco      = .FALSE.
+      LOGICAL           :: ln_isfcav   = .FALSE.
+      LOGICAL           :: ln_iscpl    = .FALSE.
+      LOGICAL           :: ln_wd       = .FALSE.
+      INTEGER(i4)       :: in_nlevel   = 75
+
+      ! namdmin
+      REAL(dp)          :: dn_hmin     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_isfhmin  = NF90_FILL_DOUBLE
+
+      ! namzco
+      REAL(dp)          :: dn_ppsur    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppa0     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppa1     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppkth    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppacr    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppdzmin  = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_pphmax   = NF90_FILL_DOUBLE
+      LOGICAL           :: ln_dbletanh = .FALSE.
+      REAL(dp)          :: dn_ppa2     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppkth2   = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppacr2   = NF90_FILL_DOUBLE
+
+      ! namzps
+      REAL(dp)          :: dn_e3zps_min= NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_e3zps_rat= NF90_FILL_DOUBLE
+!      INTEGER(i4)       :: in_msh      = NF90_FILL_INT
+
+      ! namsco
+      LOGICAL           :: ln_s_sh94   = .FALSE.
+      LOGICAL           :: ln_s_sf12   = .FALSE.
+      REAL(dp)          :: dn_sbot_min = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_sbot_max = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_rmax     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_hc       = NF90_FILL_DOUBLE
+      !
+      REAL(dp)          :: dn_theta    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_thetb    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_bb       = NF90_FILL_DOUBLE
+      !                               
+      LOGICAL           :: ln_sigcrit  = .FALSE.
+      REAL(dp)          :: dn_alpha    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_efold    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_zs       = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_zb_a     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_zb_b     = NF90_FILL_DOUBLE
+
+!      ! namcla
+!      INTEGER(i4)       :: in_cla      = 0
+
+      ! namwd
+      REAL(dp)          :: dn_wdmin1   = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_wdmin2   = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_wdld     = NF90_FILL_DOUBLE
+
+      ! namgrd
+!      CHARACTER(LEN=lc) :: cn_cfg      = ''
+!      INTEGER(i4)       :: in_cfg      = 0
+!      INTEGER(i4)       :: in_bench    = 0
+!      LOGICAL           :: ln_zoom     = .FALSE.
+      LOGICAL           :: ln_c1d      = .FALSE.
+      LOGICAL           :: ln_e3_dep   = .FALSE.
+
+!      ! namzoom
+!      CHARACTER(LEN=lc) :: cn_cfz      =''
+!      INTEGER(i4)       :: in_izoom    = NF90_FILL_INT
+!      INTEGER(i4)       :: in_jzoom    = NF90_FILL_INT
+!      LOGICAL           :: ln_zoom_s   = .FALSE.
+!      LOGICAL           :: ln_zoom_e   = .FALSE.
+!      LOGICAL           :: ln_zoom_w   = .FALSE.
+!      LOGICAL           :: ln_zoom_n   = .FALSE.
+      !----------------------------------------------------------------
+      NAMELIST /namzgr/ &
+      &  ln_zco,        &  !< z-coordinate
+      &  ln_zps,        &  !< z-coordinate with partial steps
+      &  ln_sco,        &  !< s-coordinate
+      &  ln_isfcav,     &  !< presence of ISF 
+      &  ln_iscpl,      &  !< coupling with ice sheet
+      &  ln_wd,         &  !< Wetting/drying activation      
+      &  in_nlevel         !< number of vertical level
+
+      NAMELIST /namdmin/ &
+      &  dn_hmin,       &  !< minimum ocean depth (>0) or minimum number of ocean levels (<0)
+      &  dn_isfhmin        !< threshold to discriminate grounded ice to floating ice
+
+      NAMELIST /namzco/ &
+      &  dn_ppsur,      &
+      &  dn_ppa0,       &
+      &  dn_ppa1,       &
+      &  dn_ppkth,      &
+      &  dn_ppacr,      &
+      &  dn_ppdzmin,    &
+      &  dn_pphmax,     &
+      &  ln_dbletanh,   &
+      &  dn_ppa2,       &
+      &  dn_ppkth2,     &
+      &  dn_ppacr2
+
+      NAMELIST /namzps/ &
+      &  dn_e3zps_min,  &
+      &  dn_e3zps_rat!,  &
+!      &  in_msh          
+
+      NAMELIST /namsco/ &
+      &   ln_s_sh94,    & !< use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1
+      &   ln_s_sf12,    & !< use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma
+      &   dn_sbot_min,  & !< minimum depth of s-bottom surface (>0) (m)
+      &   dn_sbot_max,  & !< maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+      &   dn_hc,        & !< Critical depth for transition from sigma to stretched coordinates
+      ! Song and Haidvogel 1994 stretching parameters
+      &   dn_rmax,      & !< maximum cut-off r-value allowed (0<dn_rmax<1)
+      &   dn_theta,     & !< surface control parameter (0<=dn_theta<=20)
+      &   dn_thetb,     & !< bottom control parameter  (0<=dn_thetb<= 1)
+      &   dn_bb,        & !< stretching parameter ( dn_bb=0; top only, dn_bb =1; top and bottom)
+      ! Siddorn and Furner stretching parameters
+      &   ln_sigcrit,   & !< use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+      &   dn_alpha,     & !< control parameter ( > 1 stretch towards surface, < 1 towards seabed)
+      &   dn_efold,     & !<  efold length scale for transition to stretched coord
+      &   dn_zs,        & !<  depth of surface grid box
+                          !<  bottom cell depth (Zb) is a linear function of water depth Zb = H*rn_zb_a + rn_zb_b'
+      &   dn_zb_a,      & !<  bathymetry scaling factor for calculating Zb
+      &   dn_zb_b         !<  offset for calculating Zb
+
+!      NAMELIST /namcla/ &
+!      &  in_cla            !< =1 cross land advection for exchanges through some straits (ORCA2)
+
+      NAMELIST /namwd/ &  !< wetting and drying
+      &  dn_wdmin1, &     !< minimum water depth on dried cells
+      &  dn_wdmin2, &     !< tolerrance of minimum water depth on dried cells
+      &  dn_wdld          !< land elevation below which wetting/drying
+
+      NAMELIST/namgrd/  &  !< orca grid namelist
+!      &  cn_cfg,        &  !< name of the configuration (orca)
+!      &  in_cfg,        &  !< resolution of the configuration (2,1,025..)
+!      &  in_bench,      &  !< benchmark parameter (in_mshhgr = 5 )
+!      &  ln_zoom,       &  !< use zoom
+      &  ln_c1d,         &  !< use configuration 1D
+      &  ln_e3_dep          !< new vertical scale factors [T, F:old definition]
+
+!      NAMELIST /namzoom/&
+!      &  cn_cfz,        &  !< name of the zoom of configuration
+!      &  in_izoom,      &  !< left bottom i-indices of the zoom in data domain indices
+!      &  in_jzoom,      &  !< left bottom j-indices of the zoom in data domain indices
+!      &  ln_zoom_s,     &  !< South zoom type flag
+!      &  ln_zoom_e,     &  !< East  zoom type flag
+!      &  ln_zoom_w,     &  !< West  zoom type flag
+!      &  ln_zoom_n         !< North zoom type flag
+      !----------------------------------------------------------------
+   !1-2 read namelist
+   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_fatal("GRID ZGR NAM: error opening "//&
+            &  TRIM(cd_namelist))
+      ENDIF
+
+      READ( il_fileid, NML = namzgr  )
+      READ( il_fileid, NML = namdmin )
+      READ( il_fileid, NML = namzco  )
+
+      IF( ln_zps    ) READ( il_fileid, NML = namzps  )
+      IF( ln_sco    ) READ( il_fileid, NML = namsco  )
+!      READ( il_fileid, NML = namcla  )
+      READ( il_fileid, NML = namwd   )
+      READ( il_fileid, NML = namgrd  )
+!      IF( ln_zoom   ) READ( il_fileid, NML = namzoom )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("GRID ZGR NAM: closing "//TRIM(cd_namelist))
+      ENDIF
+     
+      grid_zgr_nam%c_coord    = TRIM(cd_coord)
+      grid_zgr_nam%i_perio    = id_perio
+
+      grid_zgr_nam%l_zco      = ln_zco    
+      grid_zgr_nam%l_zps      = ln_zps    
+      grid_zgr_nam%l_sco      = ln_sco    
+      grid_zgr_nam%l_isfcav   = ln_isfcav 
+      grid_zgr_nam%l_iscpl    = ln_iscpl 
+      grid_zgr_nam%l_wd       = ln_wd 
+      grid_zgr_nam%i_nlevel   = in_nlevel
+
+      grid_zgr_nam%d_hmin     = dn_hmin  
+      grid_zgr_nam%d_isfhmin  = dn_isfhmin  
+
+      grid_zgr_nam%d_ppsur    = dn_ppsur  
+      grid_zgr_nam%d_ppa0     = dn_ppa0   
+      grid_zgr_nam%d_ppa1     = dn_ppa1   
+      grid_zgr_nam%d_ppkth    = dn_ppkth  
+      grid_zgr_nam%d_ppacr    = dn_ppacr  
+      grid_zgr_nam%d_ppdzmin  = dn_ppdzmin
+      grid_zgr_nam%d_pphmax   = dn_pphmax 
+                             
+      grid_zgr_nam%l_dbletanh = ln_dbletanh
+      grid_zgr_nam%d_ppa2     = dn_ppa2    
+      grid_zgr_nam%d_ppkth2   = dn_ppkth2  
+      grid_zgr_nam%d_ppacr2   = dn_ppacr2  
+
+      grid_zgr_nam%d_e3zps_min= dn_e3zps_min
+      grid_zgr_nam%d_e3zps_rat= dn_e3zps_rat
+!      grid_zgr_nam%i_msh      = in_msh      
+
+      grid_zgr_nam%l_s_sh94   = ln_s_sh94  
+      grid_zgr_nam%l_s_sf12   = ln_s_sf12  
+      grid_zgr_nam%d_sbot_min = dn_sbot_min
+      grid_zgr_nam%d_sbot_max = dn_sbot_max
+      grid_zgr_nam%d_rmax     = dn_rmax    
+      grid_zgr_nam%d_hc       = dn_hc      
+      !
+      grid_zgr_nam%d_theta    = dn_theta   
+      grid_zgr_nam%d_thetb    = dn_thetb   
+      grid_zgr_nam%d_bb       = dn_bb      
+      !
+      grid_zgr_nam%l_sigcrit  = ln_sigcrit
+      grid_zgr_nam%d_alpha    = dn_alpha  
+      grid_zgr_nam%d_efold    = dn_efold  
+      grid_zgr_nam%d_zs       = dn_zs     
+      grid_zgr_nam%d_zb_a     = dn_zb_a
+      grid_zgr_nam%d_zb_b     = dn_zb_b
+
+!      grid_zgr_nam%i_cla      = in_cla
+
+      grid_zgr_nam%d_wdmin1   = dn_wdmin1  
+      grid_zgr_nam%d_wdmin2   = dn_wdmin2  
+      grid_zgr_nam%d_wdld     = dn_wdld  
+
+!      grid_zgr_nam%c_cfg      = TRIM(cn_cfg)
+!      grid_zgr_nam%i_cfg      = in_cfg
+!      grid_zgr_nam%i_bench    = in_bench
+!      grid_zgr_nam%l_zoom     = ln_zoom
+      grid_zgr_nam%l_c1d      = ln_c1d
+      grid_zgr_nam%l_e3_dep   = ln_e3_dep
+
+!      grid_zgr_nam%c_cfz      = cn_cfz   
+!      grid_zgr_nam%i_izoom    = in_izoom 
+!      grid_zgr_nam%i_jzoom    = in_jzoom 
+!      grid_zgr_nam%l_zoom_s   = ln_zoom_s
+!      grid_zgr_nam%l_zoom_e   = ln_zoom_e
+!      grid_zgr_nam%l_zoom_w   = ln_zoom_w
+!      grid_zgr_nam%l_zoom_n   = ln_zoom_n
+
+   ELSE
+
+      CALL logger_fatal(" GRID ZGR NAM: can't find "//TRIM(cd_namelist))
+
+   ENDIF
+
+   END FUNCTION grid_zgr_nam
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill vertical mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !> @date October, 2016
+   !> - ice shelf cavity
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] td_bathy
+   !> @param[in] td_risfdep
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_fill( td_nam,jpi,jpj,jpk,td_bathy,td_risfdep ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+      INTEGER(i4) :: il_count
+
+      REAL(dp)    :: dl_bat
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR : vertical coordinate')
+      CALL logger_info('~~~~~~~')
+      CALL logger_info(' Namelist namzgr : set vertical coordinate')
+      CALL logger_info(' z-coordinate - full steps      ln_zco    = '//TRIM(fct_str(td_nam%l_zco)))
+      CALL logger_info(' z-coordinate - partial steps   ln_zps    = '//TRIM(fct_str(td_nam%l_zps)))
+      CALL logger_info(' s- or hybrid z-s-coordinate    ln_sco    = '//TRIM(fct_str(td_nam%l_sco)))
+      CALL logger_info(' ice shelf cavities             ln_isfcav = '//TRIM(fct_str(td_nam%l_isfcav)))
+      CALL logger_info(' vertical scale factors         ln_e3_dep = '//TRIM(fct_str(td_nam%l_e3_dep)))
+
+      il_count=0
+      IF( td_nam%l_zco      )   il_count = il_count + 1
+      IF( td_nam%l_zps      )   il_count = il_count + 1
+      IF( td_nam%l_sco      )   il_count = il_count + 1
+      IF( il_count /= 1 )THEN
+         CALL logger_fatal(' GRID ZGR : none or several vertical coordinate options used' )
+      ENDIF
+      !
+      il_count=0
+      IF ( td_nam%l_zco .AND. td_nam%l_isfcav ) il_count = il_count + 1
+      IF ( td_nam%l_sco .AND. td_nam%l_isfcav ) il_count = il_count + 1
+      IF( il_count > 0 )THEN
+         CALL logger_fatal(' GRID ZGR : Cavity not tested/compatible with full step (zco) and sigma (ln_sco)' )
+      ENDIF
+
+      IF(.NOT. td_nam%l_e3_dep )THEN
+         CALL logger_info("Obsolescent definition of e3 scale factors is used")
+      ENDIF
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+
+      ! Reference z-coordinate system (always called)
+      CALL grid_zgr__z( td_nam,jpk )
+
+      ! Bathymetry fields (levels and meters)
+      CALL grid_zgr__bat( td_nam,td_bathy,td_risfdep ) !jpi,jpj,td_bathy,td_risfdep )
+
+      ! 1D config.: same bathy value over the 3x3 domain
+      IF( td_nam%l_c1d ) CALL lbc_lnk( td_bathy%d_value(:,:,1,1),'T',td_nam%i_perio,1._dp )
+
+      ! z-coordinate
+      IF( td_nam%l_zco ) CALL grid_zgr__zco(jpk)
+
+      ! Partial step z-coordinate
+      IF( td_nam%l_zps ) CALL grid_zgr__zps_fill( td_nam,jpi,jpj,jpk,td_bathy,td_risfdep )
+
+      ! s-coordinate or hybrid z-s coordinate
+      IF( td_nam%l_sco ) CALL grid_zgr__sco_fill( td_nam,jpi,jpj,jpk,td_bathy )
+
+      ! final adjustment of mbathy & check 
+      ! ----------------------------------
+
+!      ! correct mbathy in case of zoom subdomain
+!      IF( td_nam%l_zoom )   CALL grid_zgr__bat_zoom( td_nam,jpi,jpj )
+
+      ! check bathymetry (mbathy) and suppress isolated ocean points
+      IF( .NOT. td_nam%l_c1d )   CALL grid_zgr__bat_ctl( td_nam,jpi,jpj,jpk )
+
+      ! deepest ocean level for t-, u- and v-points
+      CALL grid_zgr__bot_level( ) !td_nam,jpi,jpj )
+
+      ! shallowest ocean level for T-, U-, V- points
+      CALL grid_zgr__top_level( ) !td_nam,jpi,jpj )
+
+      ! 1D config.: same mbathy value over the 3x3 domain
+      IF( td_nam%l_c1d ) THEN
+         dl_bat = tg_mbathy%d_value(2,2,1,1)
+         tg_mbathy%d_value(:,:,1,1) = dl_bat
+      END IF      
+
+      CALL logger_info(' MIN val mbathy '//TRIM(fct_str(MINVAL( tg_mbathy%d_value(:,:,1,1) )))//&
+         &   ' MAX '//TRIM(fct_str(MAXVAL( tg_mbathy%d_value(:,:,1,1) ))) )
+      CALL logger_info(' MIN val depth  t '//TRIM(fct_str(MINVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &   ' w '//TRIM(fct_str(MINVAL( tg_gdepw_0%d_value(:,:,:,1) )))//&
+         !&   ' 3w '//TRIM(fct_str(MINVAL( tg_gdep3w_0%d_value(:,:,:,1) )))//&
+         &   '  t '//TRIM(fct_str(MINVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &   '  f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &   '  u '//TRIM(fct_str(MINVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &   '  v '//TRIM(fct_str(MINVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &   ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &   ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &   '  w '//TRIM(fct_str(MINVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+      CALL logger_info(' MAX val depth t '//TRIM(fct_str(MAXVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &   ' w '//TRIM(fct_str(MAXVAL( tg_gdepw_0%d_value(:,:,:,1) ))) )!//&
+         !&   ' 3w '//TRIM(fct_str(MAXVAL( tg_gdep3w_0%d_value(:,:,:,1) ))) )
+      CALL logger_info(' MAX val e3    t '//TRIM(fct_str(MAXVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &   ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &   ' u '//TRIM(fct_str(MAXVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &   ' v '//TRIM(fct_str(MAXVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &   ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &   ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &   ' w '//TRIM(fct_str(MAXVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+
+   END SUBROUTINE grid_zgr_fill
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set the depth of model levels and the resulting 
+   !>        vertical scale factors.
+   !>
+   !> @details
+   !>
+   !> ** Method  :   z-coordinate system (use in all type of coordinate)
+   !>        The depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the scale factors.
+   !>        both depth and scale factors only depend on k (1d arrays).<br/>
+   !>              w-level: 
+   !>                       - gdepw_1d  = gdep(k)<br/>
+   !>                       - e3w_1d(k) = dk(gdep)(k)     = e3(k)<br/>
+   !>              t-level: 
+   !>                       - gdept_1d  = gdep(k+0.5)<br/>
+   !>                       - e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)<br/>
+   !>
+   !>
+   !> ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
+   !>              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m)
+   !>
+   !> !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_z
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__z(td_nam,jpk) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      CHARACTER(LEN=lc)          :: cl_tmp
+
+      REAL(dp)                   :: zsur, za0, za1, zkth   ! Values set from parameters in
+      REAL(dp)                   :: zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
+!      REAL(dp)                   :: zrefdep                ! depth of the reference level (~10m)
+      REAL(dp)                   :: za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters
+      REAL(dp)                   :: zt, zw                 ! temporary scalars
+      REAL(dp), PARAMETER        :: dp_pp_to_be_computed = NF90_FILL_DOUBLE
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! Set variables from parameters
+      ! ------------------------------
+      zkth   = td_nam%d_ppkth       
+      zacr   = td_nam%d_ppacr
+      zdzmin = td_nam%d_ppdzmin   
+      zhmax  = td_nam%d_pphmax
+      zkth2  = td_nam%d_ppkth2     
+      zacr2  = td_nam%d_ppacr2
+
+      ! If ppa1 and ppa0 and ppsur are set to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      IF(   td_nam%d_ppa1  == dp_pp_to_be_computed  .AND.  &
+         &  td_nam%d_ppa0  == dp_pp_to_be_computed  .AND.  &
+         &  td_nam%d_ppsur == dp_pp_to_be_computed           ) THEN
+         !
+         za1  = (  zdzmin - zhmax / REAL(jpk-1,dp)  )                                               &
+            & / ( TANH((1-zkth)/zacr) - zacr/REAL(jpk-1,dp) * ( LOG( COSH( (jpk - zkth) / zacr) )   &
+            &                                               - LOG( COSH( ( 1  - zkth) / zacr) ) ) )
+         za0  = zdzmin  - za1 *             TANH( (1-zkth) / zacr )
+         zsur =   - za0 - za1 * zacr * LOG( COSH( (1-zkth) / zacr )  )
+         ! za2 ???
+      ELSE
+         za1  = td_nam%d_ppa1 
+         za0  = td_nam%d_ppa0
+         zsur = td_nam%d_ppsur
+         za2  = td_nam%d_ppa2                            ! optional (ldbletanh=T) double tanh parameter
+      ENDIF      
+
+      CALL logger_info(' GRID ZGR Z : Reference vertical z-coordinates')
+      CALL logger_info('~~~~~~~~~~~')
+      IF( zkth == 0._dp ) THEN 
+         CALL logger_info('Uniform grid with '//TRIM(fct_str(jpk-1))//' layers')
+         CALL logger_info('Total depth    :'//TRIM(fct_str(zhmax)))
+         CALL logger_info('Layer thickness:'//TRIM(fct_str(zhmax/(jpk-1))))         
+      ELSE
+         IF( za1 == 0._dp .AND. za0 == 0._dp .AND. zsur == 0._dp ) THEN
+            CALL logger_info('zsur, za0, za1 computed from ')
+            CALL logger_info('        zdzmin = '//TRIM(fct_str(zdzmin)))
+            CALL logger_info('        zhmax  = '//TRIM(fct_str(zhmax)))            
+         ENDIF
+            CALL logger_info('Value of coefficients for vertical mesh:')
+            CALL logger_info('      zsur = '//TRIM(fct_str(zsur)))
+            CALL logger_info('      za0  = '//TRIM(fct_str(za0)))
+            CALL logger_info('      za1  = '//TRIM(fct_str(za1)))
+            CALL logger_info('      zkth = '//TRIM(fct_str(zkth)))
+            CALL logger_info('      zacr = '//TRIM(fct_str(zacr)))
+         IF( td_nam%l_dbletanh ) THEN
+            CALL logger_info(' (Double tanh    za2  = '//TRIM(fct_str(za2)))
+            CALL logger_info('  parameters)    zkth2= '//TRIM(fct_str(zkth2)))
+            CALL logger_info('                 zacr2= '//TRIM(fct_str(zacr2)))
+         ENDIF
+      ENDIF
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      ! init
+      IF( zkth == 0._dp ) THEN            !  uniform vertical grid       
+         za1 = zhmax / REAL(jpk-1,dp) 
+         DO jk = 1, jpk
+            zw = REAL( jk, dp )
+            zt = REAL( jk, dp ) + 0.5_dp
+            tg_gdepw_1d%d_value(1,1,jk,1) = ( zw - 1 ) * za1
+            tg_gdept_1d%d_value(1,1,jk,1) = ( zt - 1 ) * za1
+            tg_e3w_1d%d_value  (1,1,jk,1) =  za1
+            tg_e3t_1d%d_value  (1,1,jk,1) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         IF( .NOT. td_nam%l_dbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , dp )
+               zt = REAL( jk , dp ) + 0.5_dp
+               tg_gdepw_1d%d_value(1,1,jk,1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               tg_gdept_1d%d_value(1,1,jk,1) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               tg_e3w_1d%d_value  (1,1,jk,1) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               tg_e3t_1d%d_value  (1,1,jk,1) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = REAL( jk, dp )
+               zt = REAL( jk, dp ) + 0.5_dp
+               ! Double tanh function
+               tg_gdepw_1d%d_value(1,1,jk,1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                           &                                     + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               tg_gdept_1d%d_value(1,1,jk,1) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                           &                                     + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               tg_e3w_1d  %d_value(1,1,jk,1) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      &
+                           &                                     + za2        * TANH(       (zw-zkth2) / zacr2 )
+               tg_e3t_1d  %d_value(1,1,jk,1) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      &
+                  &                                              + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         tg_gdepw_1d%d_value(1,1,1,1) = 0._dp                    ! force first w-level to be exactly at zero
+      ENDIF      
+
+      IF ( td_nam%l_isfcav .OR. td_nam%l_e3_dep ) THEN
+         ! need to be like this to compute the pressure gradient with ISF. 
+         ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+         ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+         DO jk = 1, jpk-1
+            tg_e3t_1d%d_value(1,1,jk,1) = tg_gdepw_1d%d_value(1,1,jk+1,1)-tg_gdepw_1d%d_value(1,1,jk,1) 
+         END DO
+         ! we don't care because this level is masked in NEMO
+         tg_e3t_1d%d_value(1,1,jpk,1) = tg_e3t_1d%d_value(1,1,jpk-1,1)
+
+         DO jk = 2, jpk
+            tg_e3w_1d%d_value(1,1,jk,1) = tg_gdept_1d%d_value(1,1,jk,1) - tg_gdept_1d%d_value(1,1,jk-1,1) 
+         END DO
+         tg_e3w_1d%d_value(1,1,1,1) = 2._dp * (tg_gdept_1d%d_value(1,1,1,1) - tg_gdepw_1d%d_value(1,1,1,1)) 
+      END IF 
+
+! unused ?
+!!!!gm BUG in s-coordinate this does not work!
+!      ! deepest/shallowest W level Above/Below ~10m
+!      
+!      ! ref. depth with tolerance (10% of minimum layer thickness)
+!      zrefdep = 10._dp - 0.1_dp * MINVAL( tg_e3w_1d%d_value(1,1,:,1) )
+!      
+!      ! shallowest W level Below ~10m
+!      nlb10 = MINLOC( tg_gdepw_1d%d_value(1,1,:,1), mask = tg_gdepw_1d%d_value(1,1,:,1) > zrefdep, dim = 1 )
+!      
+!      ! deepest    W level Above ~10m
+!      nla10 = nlb10 - 1
+!!!!gm end bug
+
+      ! control print
+      CALL logger_info(' GRID ZGR Z : Reference z-coordinate depth and scale factors:')
+      CALL logger_info('~~~~~~~~~~~')
+      WRITE(cl_tmp, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+      CALL logger_info(cl_tmp)
+      DO jk=1,jpk
+         WRITE(cl_tmp, "(10x, i4, 4f9.2)" ) jk, tg_gdept_1d%d_value(1,1,jk,1), tg_gdepw_1d%d_value(1,1,jk,1), &
+            &                                   tg_e3t_1d%d_value  (1,1,jk,1), tg_e3w_1d%d_value  (1,1,jk,1)
+         CALL logger_info(cl_tmp)
+      ENDDO
+
+      ! control positivity
+      DO jk = 1, jpk                      
+         IF( tg_e3w_1d%d_value  (1,1,jk,1) <= 0._dp .OR. tg_e3t_1d%d_value  (1,1,jk,1) <= 0._dp )THEN
+            CALL logger_fatal( 'GRID ZGR Z: e3w_1d or e3t_1d =< 0 '    )
+         ENDIF
+         IF( tg_gdepw_1d%d_value(1,1,jk,1) <  0._dp .OR. tg_gdept_1d%d_value(1,1,jk,1) <  0._dp )THEN
+            CALL logger_fatal( 'GRID ZGR Z: gdepw_1d or gdept_1d < 0 ' )
+         ENDIF
+      END DO
+
+   END SUBROUTINE grid_zgr__z
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set bathymetry both in levels and meters
+   !>
+   !> @details
+   !>
+   !> ** Method  :   read or define mbathy and bathy arrays
+   !>       * level bathymetry:
+   !>      The ocean basin geometry is given by a two-dimensional array,
+   !>      mbathy, which is defined as follow :
+   !>            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+   !>                              at t-point (ji,jj).
+   !>                          = 0  over the continental t-point.
+   !>      The array mbathy is checked to verified its consistency with
+   !>      model option. 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.
+   !>      ntopo=-1 :   rectangular channel or bassin with a bump 
+   !>      ntopo= 0 :   flat rectangular channel or basin 
+   !>      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
+   !>                   bathy  is read in 'bathy_meter.nc' NetCDF file
+   !>
+   !> ** Action  : - mbathy: level bathymetry (in level index)
+   !>              - bathy : meter bathymetry (in meters)   
+   !>
+   !> @warning do not manage case ntopo=-1 or 0
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_bat
+   !> @date October, 2016
+   !> - do not use anymore special case for ORCA grid.
+   !>
+   !> @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj
+   !> @param[in] td_bathy
+   !> @param[in] td_risfdep
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__bat( td_nam,td_bathy,td_risfdep ) !jpi,jpj,td_bathy,td_risfdep ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+!      INTEGER(i4) :: ii0, ii1
+!      INTEGER(i4) :: ij0, ij1
+
+      REAL(dp)                                  :: zhmin
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      CALL logger_info(' GRID ZGR BAT : defines level and meter bathymetry')
+      CALL logger_info(' ~~~~~~~~~~~~~')
+      CALL logger_info(' GRID ZGR BAT : bathymetry read in file')
+
+      IF( td_nam%l_zco )THEN
+         ! zco : read level bathymetry
+
+         ! read variable in bathymetry file
+         tg_mbathy%d_value(:,:,1,1) = INT(td_bathy%d_value(:,:,1,1),i4)
+         tg_misfdep%d_value(:,:,1,1)=1
+         !                                                ! =====================
+!         IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN    ! ORCA R2 configuration
+!            !                                             ! =====================
+!            IF( td_nam%i_cla == 0 ) THEN
+!               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+!               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+!               tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 15
+!               CALL logger_info('orca_r2: Gibraltar strait open at i='//&
+!                  &  TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!               !
+!               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+!               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+!               tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 12
+!               CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//&
+!                  &  TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!            ENDIF
+!            !
+!         ENDIF
+
+      ENDIF
+
+      IF( td_nam%l_zps .OR. td_nam%l_sco )THEN
+         ! zps or sco : read meter bathymetry
+
+         tg_misfdep%d_value(:,:,:,:)=1
+
+         IF ( td_nam%l_isfcav ) THEN
+            WHERE( td_bathy%d_value(:,:,1,1) <= 0._dp )
+               td_risfdep%d_value(:,:,1,1) = 0._dp
+            END WHERE
+
+            ! set grounded point to 0
+            ! (a treshold could be set here if needed, or set it offline based on the grounded fraction)
+            WHERE ( td_bathy%d_value(:,:,1,1) <= td_risfdep%d_value(:,:,1,1) + td_nam%d_isfhmin )
+               tg_misfdep%d_value(:,:,1,1) = 0
+               td_risfdep%d_value(:,:,1,1) = 0._dp
+               tg_mbathy%d_value (:,:,1,1) = 0
+               td_bathy%d_value  (:,:,1,1) = 0._dp
+            END WHERE
+         END IF
+         !       
+!         IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN    ! ORCA R2 configuration
+!            !
+!           IF( td_nam%i_cla == 0 ) THEN
+!              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+!              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+!              td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 284._dp 
+!              CALL logger_info('orca_r2: Gibraltar strait open at i='//&
+!                 &   TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!              !
+!              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+!              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+!              td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 137._dp
+!              CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//&
+!                 &   TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!           ENDIF
+!           !
+!        ENDIF
+         !
+      ENDIF      
+
+      !==  NO closed seas or lakes  ==!
+      ! already done
+
+      IF ( .NOT. td_nam%l_sco ) THEN
+         !==  set a minimum depth  ==!
+         
+         IF( td_nam%d_hmin < 0._dp ) THEN
+            ! from a nb of level
+            jk = - INT(td_nam%d_hmin, i4)
+         ELSE
+            ! from a depth
+            jk = MINLOC( tg_gdepw_1d%d_value(1,1,:,1), &
+               &  MASK = tg_gdepw_1d%d_value(1,1,:,1) > td_nam%d_hmin, &
+               &  DIM  = 1)
+         ENDIF
+
+         ! minimum depth = ik+1 w-levels
+         zhmin = tg_gdepw_1d%d_value(1,1,jk+1,1)
+         WHERE( td_bathy%d_value(:,:,1,1) <= 0._dp )
+            ! min=0     over the lands
+            td_bathy%d_value(:,:,1,1) = 0._dp
+         ELSE WHERE
+            ! min=zhmin over the oceans
+            td_bathy%d_value(:,:,1,1) = MAX(zhmin, td_bathy%d_value(:,:,1,1))
+         END WHERE
+         CALL logger_info('GRID ZGR BAT: Minimum ocean depth: '//&
+            &   TRIM(fct_str(zhmin))//' minimum number of ocean'//&
+            &   ' levels : '//TRIM(fct_str(jk)))
+      ENDIF
+
+   END SUBROUTINE grid_zgr__bat
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define the z-coordinate system
+   !>
+   !> @details
+   !> set 3D coord. arrays to reference 1D array
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_zco
+   !>
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__zco(jpk) 
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      DO jk = 1, jpk
+         tg_gdept_0%d_value (:,:,jk,1) = tg_gdept_1d%d_value(1,1,jk,1)
+         tg_gdepw_0%d_value (:,:,jk,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+         !tg_gdep3w_0%d_value(:,:,jk,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+         tg_e3t_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3u_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3v_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3f_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3w_0%d_value   (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+         tg_e3uw_0%d_value  (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+         tg_e3vw_0%d_value  (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+      END DO
+
+   END SUBROUTINE grid_zgr__zco
+!   !-------------------------------------------------------------------
+!   !> @brief This subroutine : 
+!   !> - close zoom domain boundary if necessary
+!   !> - suppress Med Sea from ORCA R2 and R05 arctic zoom
+!   !> 
+!   !> @author J.Paul
+!   !> @date September, 2015 - Initial version
+!   !>
+!   !> @param[in] td_nam
+!   !> @param[in] jpi
+!   !> @param[in] jpj
+!   !-------------------------------------------------------------------
+!   SUBROUTINE grid_zgr__bat_zoom(td_nam,jpi,jpj) 
+!      IMPLICIT NONE
+!      ! Argument      
+!      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+!
+!      ! local variable
+!      INTEGER(i4) :: jpizoom
+!      INTEGER(i4) :: jpjzoom
+!
+!      INTEGER(i4) :: ii0, ii1
+!      INTEGER(i4) :: ij0, ij1
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!      CALL logger_info('GRID ZGR BAT ZOOM : modify the level bathymetry for zoom domain')
+!      CALL logger_info('~~~~~~~~~~~~')
+!
+!      jpizoom=td_nam%i_izoom
+!      jpjzoom=td_nam%i_jzoom
+!
+!      ! Forced closed boundary if required
+!      IF( td_nam%l_zoom_s ) tg_mbathy%d_value(    :         ,    jpjzoom  ,1,1) = 0
+!      IF( td_nam%l_zoom_w ) tg_mbathy%d_value(     jpizoom  ,   :         ,1,1) = 0
+!      IF( td_nam%l_zoom_e ) tg_mbathy%d_value( jpi+jpizoom-1,   :         ,1,1) = 0
+!      IF( td_nam%l_zoom_n ) tg_mbathy%d_value(    :         ,jpj+jpjzoom-1,1,1) = 0
+!
+!      ! Configuration specific domain modifications
+!      ! (here, ORCA arctic configuration: suppress Med Sea)
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. &
+!        & TRIM(td_nam%c_cfz) == "arctic" ) THEN
+!         SELECT CASE ( td_nam%i_cfg )
+!         !                                        ! =======================
+!         CASE ( 2 )                               !  ORCA_R2 configuration
+!            !                                     ! =======================
+!            CALL logger_info('ORCA R2 arctic zoom: suppress the Med Sea')
+!            ii0 = 141   ;   ii1 = 162      ! Sea box i,j indices
+!            ij0 =  98   ;   ij1 = 110
+!            !                                     ! =======================
+!         CASE ( 05 )                              !  ORCA_R05 configuration
+!            !                                     ! =======================
+!            CALL logger_info('ORCA R05 arctic zoom: suppress the Med Sea')
+!            ii0 = 563   ;   ii1 = 642      ! zero over the Med Sea boxe
+!            ij0 = 314   ;   ij1 = 370 
+!         END SELECT
+!         !
+!         tg_mbathy%d_value( ii0:ii1, ij0:ij1, 1, 1) = 0   ! zero over the Med Sea boxe
+!         !
+!      ENDIF
+!
+!   END SUBROUTINE grid_zgr__bat_zoom
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check the bathymetry in levels
+   !>
+   !> @details
+   !>
+   !> 
+   !> ** 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.
+   !>      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  : - update mbathy: level bathymetry (in level index)
+   !>              - update bathy : meter bathymetry (in meters)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__bat_ctl(td_nam,jpi,jpj,jpk) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      INTEGER(i4) :: icompt, ibtest, ikmax         ! temporary integers
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR BAT CTL: check the bathymetry')
+      CALL logger_info('~~~~~~~~~~~~~~~')
+      CALL logger_info('                   suppress isolated ocean grid points')
+      CALL logger_info('                   -----------------------------------')
+
+      icompt = 0
+      DO jl = 1, 2
+         IF( td_nam%i_perio == 1 .OR. &
+           & td_nam%i_perio == 4 .OR. &
+           & td_nam%i_perio == 6 ) THEN
+            tg_mbathy%d_value( 1 ,:,1,1) = tg_mbathy%d_value(jpi-1,:,1,1)           ! local domain is cyclic east-west
+            tg_mbathy%d_value(jpi,:,1,1) = tg_mbathy%d_value(  2  ,:,1,1)
+         ENDIF
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+               ibtest = MAX(  tg_mbathy%d_value(ji-1,jj  ,1,1), &
+                  &           tg_mbathy%d_value(ji+1,jj  ,1,1), &
+                  &           tg_mbathy%d_value(ji  ,jj-1,1,1), &
+                  &           tg_mbathy%d_value(ji  ,jj+1,1,1)  )
+               IF( ibtest < tg_mbathy%d_value(ji,jj,1,1) ) THEN
+                  CALL logger_info(' the number of ocean level at '//&
+                     &             'grid-point (i,j) =  ('//TRIM(fct_str(ji))//&
+                     &             ','//TRIM(fct_str(jj))//') is changed from '//&
+                     &             TRIM(fct_str(tg_mbathy%d_value(ji,jj,1,1)))//' to '//&
+                     &             TRIM(fct_str(ibtest)) )
+                  tg_mbathy%d_value(ji,jj,1,1) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      !! lk_mpp not used
+
+      IF( icompt == 0 ) THEN
+         CALL logger_info('     no isolated ocean grid points')
+      ELSE
+         CALL logger_info(TRIM(fct_str(icompt))//' ocean grid points suppressed')
+      ENDIF
+
+      !! lk_mpp not used
+
+      !                                          ! East-west cyclic boundary conditions
+      IF( td_nam%i_perio == 0 ) THEN
+         CALL logger_info(' mbathy set to 0 along east and west boundary:'//&
+            &  ' nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+         !! lk_mpp not used
+         IF( td_nam%l_zco .OR. td_nam%l_zps ) THEN
+            tg_mbathy%d_value( 1 ,:,1,1) = 0
+            tg_mbathy%d_value(jpi,:,1,1) = 0
+         ELSE
+            tg_mbathy%d_value( 1 ,:,1,1) = jpk-1
+            tg_mbathy%d_value(jpi,:,1,1) = jpk-1
+         ENDIF
+      ELSEIF( td_nam%i_perio == 1 .OR. &
+            & td_nam%i_perio == 4 .OR. &
+            & td_nam%i_perio == 6 ) THEN
+         CALL logger_info(' east-west cyclic boundary conditions on mbathy:'//&
+            &  ' nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+         tg_mbathy%d_value( 1 ,:,1,1) = tg_mbathy%d_value(jpi-1,:,1,1)
+         tg_mbathy%d_value(jpi,:,1,1) = tg_mbathy%d_value(  2  ,:,1,1)
+      ELSEIF( td_nam%i_perio == 2 ) THEN
+         CALL logger_info('   equatorial boundary conditions on mbathy:'//&
+            ' nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+      ELSE
+         CALL logger_info('    e r r o r')
+         CALL logger_info('    parameter , nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+         !         STOP 'dom_mba'
+      ENDIF
+
+      !  Boundary condition on mbathy
+!!gm  !!bug ???  think about it !
+      !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+      CALL lbc_lnk( tg_mbathy%d_value(:,:,1,1), 'T', td_nam%i_perio, 1._dp )
+
+
+      ! Number of ocean level inferior or equal to jpkm1
+      ikmax = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikmax = MAX( ikmax, INT(tg_mbathy%d_value(ji,jj,1,1),i4) )
+         END DO
+      END DO      
+!!gm  !!! test to do:   ikmax = MAX( mbathy(:,:) )   ???
+      IF( ikmax > jpk-1 ) THEN
+         CALL logger_info(' maximum number of ocean level = '//TRIM(fct_str(ikmax))//' >  jpk-1')
+         CALL logger_info(' change jpk to '//TRIM(fct_str(ikmax+1))//' to use the exact ead bathymetry')
+      ELSE IF( ikmax < jpk-1 ) THEN
+         CALL logger_info(' maximum number of ocean level = '//TRIM(fct_str(ikmax))//' < jpk-1')
+         CALL logger_info(' you can decrease jpk to '//TRIM(fct_str(ikmax+1)))
+      ENDIF      
+
+   END SUBROUTINE grid_zgr__bat_ctl
+   !-------------------------------------------------------------------
+   !> @brief This subroutine defines the vertical index of ocean bottom (mbk. arrays)
+   !>
+   !> @details
+   !>
+   !> ** 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)
+   !> 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_bot_level
+   !>
+   ! @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__bot_level( )!td_nam,jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+!      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+
+      ! local variable
+
+      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR BOT LEVEL: ocean bottom k-index of T-, U-, V- and W-levels ')
+      CALL logger_info('    ~~~~~~~~~~~~~')
+
+      ! bottom k-index of T-level (=1 over land)
+      tg_mbkt%d_value(:,:,1,1) = MAX( tg_mbathy%d_value(:,:,1,1) , 1._dp )
+
+!      ! bottom k-index of W-level = mbkt+1
+!      ! bottom k-index of u- (v-) level
+!      DO jj = 1, jpj-1                      ! bottom k-index of u- (v-) level
+!         DO ji = 1, jpi-1
+!            tg_mbku%d_value(ji,jj,1,1) = MIN(  tg_mbkt%d_value(ji+1,jj  ,1,1) , &
+!               &                               tg_mbkt%d_value(ji  ,jj  ,1,1)  )
+!
+!            tg_mbkv%d_value(ji,jj,1,1) = MIN(  tg_mbkt%d_value(ji  ,jj+1,1,1) , &
+!               &                               tg_mbkt%d_value(ji  ,jj  ,1,1)  )
+!         END DO
+!      END DO
+!
+!      CALL lbc_lnk(tg_mbku%d_value(:,:,1,1),'U', td_nam%i_perio, 1._dp)
+!      CALL lbc_lnk(tg_mbkv%d_value(:,:,1,1),'U', td_nam%i_perio, 1._dp)
+
+   END SUBROUTINE grid_zgr__bot_level
+   !-------------------------------------------------------------------
+   !> @brief This subroutine defines the vertical index of ocean top (mik. arrays)
+   !>
+   !> @details
+   !>
+   !> ** Method  :   computes from misfdep with a minimum value of 1
+   !>
+   !> ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
+   !>                                     ocean level at t-, u- & v-points
+   !>                                     (min value = 1)
+   !> 
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_top_level
+   !>
+   ! @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__top_level( )!td_nam,jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+!      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+      ! local variable
+
+      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('    GRID ZGR TOP LEVEL : ocean top k-index of T-, U-, V- and W-levels ')
+      CALL logger_info('    ~~~~~~~~~~~~~')
+
+      ! top k-index of T-level (=1)
+      tg_mikt%d_value(:,:,1,1) = MAX( tg_misfdep%d_value(:,:,1,1) , 1._dp )
+
+!      ! top k-index of W-level (=mikt)
+!      ! top k-index of U- (U-) level
+!      DO jj = 1, jpj-1                       ! top k-index of U- (U-) level
+!         DO ji = 1, jpi-1
+!            tg_miku%d_value(ji,jj,1,1) = MAX(  tg_mikt%d_value(ji+1,jj  ,1,1), &
+!               &                               tg_mikt%d_value(ji  ,jj  ,1,1)  )
+!
+!            tg_mikv%d_value(ji,jj,1,1) = MAX(  tg_mikt%d_value(ji  ,jj+1,1,1), &
+!               &                               tg_mikt%d_value(ji  ,jj  ,1,1)  )
+!
+!            tg_mikf%d_value(ji,jj,1,1) = MAX(  tg_mikt%d_value(ji  ,jj+1,1,1), &
+!               &                               tg_mikt%d_value(ji  ,jj  ,1,1), &
+!               &                               tg_mikt%d_value(ji+1,jj  ,1,1), &
+!               &                               tg_mikt%d_value(ji+1,jj+1,1,1)  )
+!         END DO
+!      END DO
+!
+!      CALL lbc_lnk(tg_miku%d_value(:,:,1,1),'U',td_nam%i_perio,1._dp)
+!      CALL lbc_lnk(tg_mikv%d_value(:,:,1,1),'V',td_nam%i_perio,1._dp)
+!      CALL lbc_lnk(tg_mikf%d_value(:,:,1,1),'F',td_nam%i_perio,1._dp)
+
+   END SUBROUTINE grid_zgr__top_level
+   !-------------------------------------------------------------------
+   !> @brief This function initialise global variable needed to compute vertical
+   !>        mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_zps_init(jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp), DIMENSION(jpi,jpj) :: dl_tmp
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      dl_tmp(:,:)=dp_fill
+
+      tg_e3tp    =var_init('e3t_ps   ',dl_tmp(:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3wp    =var_init('e3w_ps   ',dl_tmp(:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+   END SUBROUTINE grid_zgr_zps_init
+   !-------------------------------------------------------------------
+   !> @brief This function clean hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_zps_clean() 
+      IMPLICIT NONE
+      ! Argument      
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_e3tp     )
+      CALL var_clean(tg_e3wp     )
+      
+   END SUBROUTINE grid_zgr_zps_clean
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define the depth and vertical scale factor in partial step
+   !>      z-coordinate case
+   !>
+   !> @details
+   !> ** Method  :   Partial steps : computes the 3D vertical scale factors
+   !>      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+   !>      a partial step representation of bottom topography.
+   !>
+   !>        The reference depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the reference vertical
+   !>      scale factors.
+   !>        From  depth and scale factors reference, we compute there new value
+   !>      with partial steps  on 3d arrays ( i, j, k ).
+   !>
+   !>              w-level: gdepw_0(i,j,k)  = gdep(k)
+   !>                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k)
+   !>              t-level: gdept_0(i,j,k)  = gdep(k+0.5)
+   !>                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
+   !>
+   !>        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+   !>      we find the mbathy index of the depth at each grid point.
+   !>      This leads us to three cases:
+   !>
+   !>              - bathy = 0 => mbathy = 0
+   !>              - 1 < mbathy < jpkm1    
+   !>              - bathy > gdepw_0(jpk) => mbathy = jpkm1  
+   !>
+   !>        Then, for each case, we find the new depth at t- and w- levels
+   !>      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+   !>      and f-points.
+   !> 
+   !>        This routine is given as an example, it must be modified
+   !>      following the user s desiderata. nevertheless, the output as
+   !>      well as the way to compute the model levels and scale factors
+   !>      must be respected in order to insure second order accuracy
+   !>      schemes.
+   !>
+   !>  @warrning gdept_1d, gdepw_1d and e3._1d are positives
+   !>            gdept_0, gdepw_0 and e3. are positives
+   !>      
+   !>  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+   !> set 3D coord. arrays to reference 1D array
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_zps
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[inout] td_bathy
+   !> @param[inout] td_risfdep
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__zps_fill( td_nam, jpi,jpj,jpk,td_bathy, td_risfdep ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+      REAL(dp)    :: zmax             ! Maximum depth
+      REAL(dp)    :: zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(dp)    :: ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(dp)    :: zdiff            ! temporary scalar
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+
+      INTEGER(i4) :: ik
+      INTEGER(i4) :: it
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR ZPS : z-coordinate with partial steps')
+      CALL logger_info('mbathy is recomputed : bathy_level file is NOT used')
+
+      ! bathymetry in level (from bathy_meter)
+
+      ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+      zmax = tg_gdepw_1d%d_value(1,1,jpk,1) + tg_e3t_1d%d_value(1,1,jpk,1)
+
+      ! bounded value of bathy (min already set at the end of zgr_bat)
+      td_bathy%d_value(:,:,1,1) = MIN(zmax, td_bathy%d_value(:,:,1,1))
+
+      WHERE( td_bathy%d_value(:,:,1,1) == 0._dp )
+         ! land  : set mbathy to 0
+         tg_mbathy%d_value(:,:,1,1) = 0
+      ELSE WHERE
+         ! ocean : initialize mbathy to the max ocean level
+         tg_mbathy%d_value(:,:,1,1) = jpk-1
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+      ! e3t_1d is the reference level thickness
+      DO jk = jpk-1, 1, -1
+         zdepth = tg_gdepw_1d%d_value(1,1,jk,1) +  MIN( td_nam%d_e3zps_min, &
+            &                                           td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1))
+
+         WHERE( 0._dp < td_bathy%d_value(:,:,1,1) .AND. &
+            &           td_bathy%d_value(:,:,1,1) <= zdepth )
+            tg_mbathy%d_value(:,:,1,1) = jk-1
+         END WHERE
+      END DO
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        
+         ! intitialization to the reference z-coordinate
+         tg_gdept_0%d_value(:,:,jk,1) = tg_gdept_1d%d_value(1,1,jk,1)
+         tg_gdepw_0%d_value(:,:,jk,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+         tg_e3t_0%d_value  (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3w_0%d_value  (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+      END DO
+
+      IF ( td_nam%l_isfcav )THEN
+         ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf
+         CALL grid_zgr__isf_fill( td_nam, jpi,jpj,jpk, td_bathy, td_risfdep )
+
+      ELSE ! .NOT. td_nam%l_isfcav
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = tg_mbathy%d_value(ji,jj,1,1)
+               IF( ik > 0 ) THEN               
+                  ! ocean point only
+                  IF( ik == jpk-1 ) THEN
+                     ! max ocean level case
+                     zdepwp = td_bathy%d_value(ji,jj,1,1)
+                     ze3tp  = td_bathy%d_value(ji,jj,1,1) - tg_gdepw_1d%d_value(1,1,ik,1)
+                     ze3wp  = 0.5_dp * tg_e3w_1d%d_value(1,1,ik,1) &
+                        &            * ( 1._dp + ( ze3tp/tg_e3t_1d%d_value(1,1,ik,1) ) )
+                     tg_e3t_0%d_value  (ji,jj,ik  ,1) = ze3tp
+                     tg_e3t_0%d_value  (ji,jj,ik+1,1) = ze3tp
+                     tg_e3w_0%d_value  (ji,jj,ik  ,1) = ze3wp
+                     tg_e3w_0%d_value  (ji,jj,ik+1,1) = ze3tp
+
+                     tg_gdepw_0%d_value(ji,jj,ik+1,1) = zdepwp
+                     tg_gdept_0%d_value(ji,jj,ik  ,1) = tg_gdept_1d%d_value( 1, 1,ik-1,1) + ze3wp
+                     tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value (ji,jj,ik  ,1) + ze3tp
+                     !
+                  ELSE
+                     ! standard case
+                     IF( td_bathy%d_value(ji,jj,1,1) <= tg_gdepw_1d%d_value(1,1,ik+1,1) ) THEN
+                        tg_gdepw_0%d_value(ji,jj,ik+1,1) = td_bathy%d_value(ji,jj,1,1)
+                     ELSE
+                        tg_gdepw_0%d_value(ji,jj,ik+1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+                     ENDIF
+                     !gm Bug?  check the gdepw_1d
+                     !       ... on ik
+                     tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value( 1, 1,ik  ,1) + &
+                     &        ( tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) )  &
+                     &    * ( (tg_gdept_1d%d_value( 1, 1,ik  ,1) - tg_gdepw_1d%d_value(1,1,ik,1) )  &
+                     &      / (tg_gdepw_1d%d_value( 1, 1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) )
+
+                     tg_e3t_0%d_value  (ji,jj,ik,1) = tg_e3t_1d%d_value  ( 1, 1,ik  ,1)            &
+                     &     * ( tg_gdepw_0%d_value (ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &
+                     &     / ( tg_gdepw_1d%d_value( 1, 1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) 
+
+                     tg_e3w_0%d_value  (ji,jj,ik,1) = 0.5_dp   &
+                     &                               * ( tg_gdepw_0%d_value(ji,jj,ik+1,1) &
+                     &                                 + tg_gdepw_1d%d_value(1,1 ,ik+1,1) &
+                     &                                 - tg_gdepw_1d%d_value(1,1 ,ik  ,1) * 2._dp ) &
+                     &                               * ( tg_e3w_1d%d_value (1 ,1 ,ik  ,1) &
+                     &                                 / (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1)) )
+
+                     !       ... on ik+1
+                     tg_e3w_0%d_value  (ji,jj,ik+1,1) = tg_e3t_0%d_value  (ji,jj,ik,1)
+                     tg_e3t_0%d_value  (ji,jj,ik+1,1) = tg_e3t_0%d_value  (ji,jj,ik,1)
+                     tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik,1) + tg_e3t_0%d_value(ji,jj,ik,1)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         !
+         it = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = tg_mbathy%d_value(ji,jj,1,1)
+               IF( ik > 0 ) THEN               ! ocean point only
+                  tg_e3tp%d_value (ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+                  tg_e3wp%d_value (ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1)
+                  ! test
+                  zdiff= tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1)
+                  IF( zdiff <= 0._dp ) THEN 
+                     it = it + 1
+                     CALL logger_info(' it      = '//TRIM(fct_str(it))//&
+                        &             ' ik      = '//TRIM(fct_str(ik))//&
+                        &             ' (i,j)   = ('//TRIM(fct_str(ji))//','//TRIM(fct_str(jj))//')')
+                     CALL logger_info(' bathy = '//TRIM(fct_str(td_bathy%d_value(ji,jj,1,1))))
+                     CALL logger_info(' gdept_0 = '//TRIM(fct_str( tg_gdept_0%d_value(ji,jj,ik  ,1) ))//&
+                        &             ' gdepw_0 = '//TRIM(fct_str( tg_gdepw_0%d_value(ji,jj,ik+1,1) ))//&
+                        &             ' zdiff = '//TRIM(fct_str(zdiff)) )
+                     CALL logger_info(' e3tp    = '//TRIM(fct_str(tg_e3t_0%d_value(ji,jj,ik,1)))//&
+                        &             ' e3wp    = '//TRIM(fct_str(tg_e3w_0%d_value(ji,jj,ik,1)))  )
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+      !
+!      IF ( td_nam%l_isfcav ) THEN
+!      ! (ISF) Definition of e3t, u, v, w for ISF case
+!         CALL grid_zgr__isf_fill_e3x( jpi,jpj, &
+!            &                        td_risfdep )
+!      END IF
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk
+         ! initialisation to z-scale factors
+         tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+         tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+      END DO
+
+      ! Computed as the minimum of neighbooring scale factors
+      DO jk = 1,jpk
+         DO jj = 1, jpj - 1
+            DO ji = 1, jpi - 1 
+               tg_e3u_0%d_value (ji,jj,jk,1) = MIN( tg_e3t_0%d_value(ji,jj,jk,1), tg_e3t_0%d_value(ji+1,jj  ,jk,1) )
+               tg_e3v_0%d_value (ji,jj,jk,1) = MIN( tg_e3t_0%d_value(ji,jj,jk,1), tg_e3t_0%d_value(ji  ,jj+1,jk,1) )
+               tg_e3uw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji+1,jj  ,jk,1) )
+               tg_e3vw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji  ,jj+1,jk,1) )
+            END DO
+         END DO
+      END DO
+
+      IF ( td_nam%l_isfcav ) THEN
+         ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         CALL grid_zgr__isf_fill_e3uw(jpi,jpj)
+      END IF
+
+      ! lateral boundary conditions
+      CALL lbc_lnk( tg_e3u_0%d_value (:,:,:,1), 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3v_0%d_value (:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+
+      ! set to z-scale factor if zero (i.e. along closed boundaries)
+      DO jk = 1, jpk
+         WHERE( tg_e3u_0%d_value (:,:,jk,1) == 0._dp )   tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         WHERE( tg_e3v_0%d_value (:,:,jk,1) == 0._dp )   tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         WHERE( tg_e3uw_0%d_value(:,:,jk,1) == 0._dp )   tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+         WHERE( tg_e3vw_0%d_value(:,:,jk,1) == 0._dp )   tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+      END DO
+
+      !! Scale factor at F-point
+      !DO jk = 1, jpk                        
+      !   ! initialisation to z-scale factors
+      !   tg_e3f_0%d_value(:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+      !END DO
+      !
+      !! Computed as the minimum of neighbooring V-scale factors
+      !DO jk = 1, jpk
+      !   DO jj = 1, jpj - 1
+      !      DO ji = 1, jpi - 1
+      !         tg_e3f_0%d_value(ji,jj,jk,1) = MIN( tg_e3v_0%d_value(ji,jj,jk,1), tg_e3v_0%d_value(ji+1,jj,jk,1) )
+      !      END DO
+      !   END DO
+      !END DO
+      !! Lateral boundary conditions
+      !CALL lbc_lnk( tg_e3f_0%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )
+      !
+      !! set to z-scale factor if zero (i.e. along closed boundaries)
+      !DO jk = 1, jpk
+      !   WHERE( tg_e3f_0%d_value(:,:,jk,1) == 0._dp )   tg_e3f_0%d_value(:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+      !END DO
+
+!!gm  bug ? :  must be a do loop with mj0,mj1
+
+      ! we duplicate factor scales for jj = 1 and jj = 2
+      tg_e3t_0%d_value(:,1,:,1) = tg_e3t_0%d_value(:,2,:,1)
+      tg_e3w_0%d_value(:,1,:,1) = tg_e3w_0%d_value(:,2,:,1) 
+      tg_e3u_0%d_value(:,1,:,1) = tg_e3u_0%d_value(:,2,:,1) 
+      tg_e3v_0%d_value(:,1,:,1) = tg_e3v_0%d_value(:,2,:,1) 
+      !tg_e3f_0%d_value(:,1,:,1) = tg_e3f_0%d_value(:,2,:,1)
+
+      ! Control of the sign
+      IF( MINVAL( tg_e3t_0%d_value  (:,:,:,:) ) <= 0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( tg_e3w_0%d_value  (:,:,:,:) ) <= 0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( tg_gdept_0%d_value(:,:,:,:) ) <  0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( tg_gdepw_0%d_value(:,:,:,:) ) <  0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   gdepw_0 <  0' )
+
+      !! Compute gdep3w_0 (vertical sum of e3w)
+      !IF ( td_nam%l_isfcav ) THEN 
+      !   ! if cavity
+      !   CALL grid_zgr__isf_fill_gdep3w_0(jpi, jpj, jpk, td_risfdep)
+      !ELSE 
+      !   ! no cavity
+      !   tg_gdep3w_0%d_value(:,:,1,1) = 0.5_dp * tg_e3w_0%d_value(:,:,1,1)
+      !   DO jk = 2, jpk
+      !      tg_gdep3w_0%d_value(:,:,jk,1) = tg_gdep3w_0%d_value(:,:,jk-1,1) + tg_e3w_0%d_value(:,:,jk,1)
+      !   END DO
+      !END IF
+
+   END SUBROUTINE grid_zgr__zps_fill
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check the bathymetry in levels
+   !>
+   !> @details
+   !> ** Method  :   THe water column have to contained at least 2 cells
+   !>                Bathymetry and isfdraft are modified (dig/close) to respect
+   !>                this criterion.
+   !>                 
+   !>   
+   !> ** Action  : - test compatibility between isfdraft and bathy 
+   !>              - bathy and isfdraft are modified   
+   !> 
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_isf
+   !> @date October, 2016
+   !> - add ice sheet coupling case
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] td_bathy
+   !> @param[in] td_risfdep
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__isf_fill( td_nam, jpi,jpj,jpk, td_bathy, td_risfdep) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+      INTEGER(i4) :: ik, it
+      INTEGER(i4) :: ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF)
+
+      INTEGER(i4), ALLOCATABLE, DIMENSION(:,:) :: zmbathy, zmisfdep     ! 2D workspace (ISH)
+
+      REAL(dp)    :: zdepth           ! Ajusted ocean depth to avoid too small e3t
+      REAL(dp)    :: zmax             ! Maximum and minimum depth
+      REAL(dp)    :: zbathydiff, zrisfdepdiff  ! isf temporary scalar
+      REAL(dp)    :: zdepwp           ! Ajusted ocean depth to avoid too small e3t
+      REAL(dp)    :: ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(dp)    :: zdiff            ! temporary scalar
+
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: zrisfdep, zmask   ! 2D workspace (ISH)
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      
+      !----------------------------------------------------------------
+
+      ! (ISF) compute misfdep
+      WHERE( td_risfdep%d_value(:,:,1,1) == 0._dp .AND. &
+           & td_bathy%d_value  (:,:,1,1) /= 0 )
+        ! open water : set misfdep to 1
+        tg_misfdep%d_value(:,:,1,1) = 1
+      ELSEWHERE
+         ! iceshelf : initialize misfdep to second level
+         tg_misfdep%d_value(:,:,1,1) = 2
+      END WHERE
+
+      ALLOCATE(zmask   (jpi,jpj))
+      ALLOCATE(zrisfdep(jpi,jpj))
+      ALLOCATE(zmisfdep(jpi,jpj))
+
+      ! Compute misfdep for ocean points (i.e. first wet level) 
+      ! find the first ocean level such that the first level thickness 
+      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
+      ! e3t_0 is the reference level thickness
+      DO jk = 2, jpk-1 
+         zdepth = tg_gdepw_1d%d_value(1,1,jk+1,1) - MIN( td_nam%d_e3zps_min, &
+            &                                            td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1) ) 
+         WHERE( 0._dp < td_risfdep%d_value(:,:,1,1) .AND. &
+         &              td_risfdep%d_value(:,:,1,1) >= zdepth )
+            tg_misfdep%d_value(:,:,1,1) = jk+1 
+         END WHERE
+      END DO 
+
+      WHERE( 0._dp < td_risfdep%d_value(:,:,1,1) .AND. &
+           &         td_risfdep%d_value(:,:,1,1) <= tg_e3t_1d%d_value(1,1,1,1) )
+         td_risfdep%d_value(:,:,1,1) = 0.
+         tg_misfdep%d_value(:,:,1,1) = 1
+      END WHERE
+
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE( td_risfdep%d_value(:,:,1,1) <= 10._dp .AND. &
+           & tg_misfdep%d_value(:,:,1,1) > 1 )
+         tg_misfdep%d_value(:,:,1,1) = 0
+         td_risfdep%d_value(:,:,1,1) = 0.0_dp
+         tg_mbathy%d_value (:,:,1,1) = 0
+         td_bathy%d_value  (:,:,1,1) = 0.0_dp
+      END WHERE
+      WHERE( td_bathy%d_value(:,:,1,1) <= 30.0_dp .AND. &
+           & tg_gphit%d_value(:,:,1,1) < -60._dp )
+         tg_misfdep%d_value(:,:,1,1) = 0
+         td_risfdep%d_value(:,:,1,1) = 0.0_dp
+         tg_mbathy%d_value (:,:,1,1) = 0
+         td_bathy%d_value  (:,:,1,1) = 0.0_dp
+      END WHERE
+
+      ! basic check for the compatibility of bathy and risfdep. 
+      ! I think it should be offline because it is not perfect and cannot solved all the situation
+      ! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together
+      DO jl = 1, 10
+
+         WHERE( td_bathy%d_value(:,:,1,1) <= td_risfdep%d_value(:,:,1,1) + td_nam%d_isfhmin )
+            tg_misfdep%d_value(:,:,1,1) = 0
+            td_risfdep%d_value(:,:,1,1) = 0._dp
+            tg_mbathy%d_value (:,:,1,1) = 0
+            td_bathy%d_value  (:,:,1,1) = 0._dp
+         END WHERE
+
+         WHERE( tg_mbathy%d_value(:,:,1,1) <= 0 )
+            tg_misfdep%d_value(:,:,1,1) = 0 
+            td_risfdep%d_value(:,:,1,1) = 0._dp
+            tg_mbathy%d_value (:,:,1,1) = 0
+            td_bathy%d_value  (:,:,1,1) = 0._dp
+         ENDWHERE
+
+         !! lk_mpp not added
+
+         IF( td_nam%i_perio == 1 .OR. &
+           & td_nam%i_perio == 4 .OR. &
+           & td_nam%i_perio == 6 )THEN 
+            ! local domain is cyclic east-west
+            tg_misfdep%d_value( 1 ,:,1,1) = tg_misfdep%d_value(jpi-1,:,1,1)
+            tg_misfdep%d_value(jpi,:,1,1) = tg_misfdep%d_value(  2  ,:,1,1) 
+
+            tg_mbathy%d_value( 1 ,:,1,1) = tg_mbathy%d_value(jpi-1,:,1,1)
+            tg_mbathy%d_value(jpi,:,1,1) = tg_mbathy%d_value(  2  ,:,1,1)
+         ENDIF
+
+         ! split last cell if possible (only where water column is 2 cell or less)
+         ! if coupled to ice sheet, we do not modify the bathymetry (can be discuss).
+         IF( .NOT. td_nam%l_iscpl )THEN
+            DO jk = jpk-1, 1, -1
+               zmax = tg_gdepw_1d%d_value(1,1,jk,1) + &
+                  &   MIN( td_nam%d_e3zps_min, &
+                  &        td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1) )
+
+               WHERE( td_bathy%d_value(:,:,1,1)       >  tg_gdepw_1d%d_value(1,1,jk,1).AND. &
+                   &  td_bathy%d_value(:,:,1,1)       <= zmax                         .AND. &
+                   &  tg_misfdep%d_value(:,:,1,1) + 1 >= tg_mbathy%d_value(:,:,1,1) )
+
+                  tg_mbathy%d_value(:,:,1,1) = jk
+                  td_bathy%d_value (:,:,1,1) = zmax
+
+               END WHERE
+            END DO
+         ENDIF
+
+         ! split top cell if possible (only where water column is 2 cell or less)
+         DO jk = 2, jpk-1
+            zmax = tg_gdepw_1d%d_value(1,1,jk+1,1) - &
+               &   MIN( td_nam%d_e3zps_min, &
+               &        td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1) )
+
+            WHERE( td_risfdep%d_value(:,:,1,1)     <  tg_gdepw_1d%d_value(1,1,jk+1,1) .AND. &
+                &  td_risfdep%d_value(:,:,1,1)     >= zmax                            .AND. &
+                &  tg_misfdep%d_value(:,:,1,1) + 1 >= tg_mbathy%d_value(:,:,1,1) )
+
+               tg_misfdep%d_value(:,:,1,1) = jk
+               td_risfdep%d_value(:,:,1,1) = zmax
+
+            END WHERE
+         END DO
+
+         ! Case where bathy and risfdep compatible but not the level 
+         ! variable mbathy/misfdep because of partial cell condition
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF( td_risfdep%d_value(ji,jj,1,1) > 1 )THEN
+                  IF( .NOT. td_nam%l_iscpl )THEN
+
+                     ik=tg_mbathy%d_value(ji,jj,1,1)
+                     zbathydiff = ABS( td_bathy%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN(td_nam%d_e3zps_min,                                       &
+                        &                    td_nam%d_e3zps_rat * tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                      &
+                        &                       td_nam%d_e3zps_rat * tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+ 
+                     IF( td_bathy%d_value (ji,jj,1,1) > td_risfdep%d_value (ji,jj,1,1) .AND. &
+                      &  tg_mbathy%d_value(ji,jj,1,1) < tg_misfdep%d_value(ji,jj,1,1) )THEN
+
+                        IF( zbathydiff <= zrisfdepdiff )THEN
+
+                           tg_mbathy%d_value(ji,jj,1,1) = tg_mbathy%d_value(ji,jj,1,1) + 1
+
+                           ik=tg_mbathy%d_value(ji,jj,1,1)
+                           td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                              &                           MIN( td_nam%d_e3zps_min, &
+                              &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                        ELSE
+
+                           tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+
+                           ik=tg_misfdep%d_value(ji,jj,1,1)
+                           td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) - &
+                              &                            MIN( td_nam%d_e3zps_min, &
+                              &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1) )
+                        ENDIF
+
+                     ENDIF
+
+                  ELSE
+
+                     IF( td_bathy%d_value (ji,jj,1,1) > td_risfdep%d_value (ji,jj,1,1) .AND. &
+                       & tg_mbathy%d_value(ji,jj,1,1) < tg_misfdep%d_value(ji,jj,1,1) )THEN
+
+                        tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+                    
+                        ik=tg_misfdep%d_value(ji,jj,1,1)
+                        td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) - &
+                           &                            MIN( td_nam%d_e3zps_min, &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1) )
+                     ENDIF
+
+                  ENDIF
+
+               ENDIF
+            ENDDO
+         ENDDO
+
+          ! At least 2 levels for water thickness at T, U, and V point.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF( tg_misfdep%d_value(ji,jj,1,1) == tg_mbathy%d_value(ji,jj,1,1) .AND. &
+                 & tg_mbathy%d_value (ji,jj,1,1) > 1) THEN
+
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji,jj,1,1)
+                     zbathydiff  = ABS( td_bathy%d_value(ji,jj,1,1)  - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &               + MIN( td_nam%d_e3zps_min, &
+                        &                      td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min, &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value(ji,jj,1,1) = tg_mbathy%d_value(ji,jj,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji,jj,1,1)
+                        td_bathy%d_value(ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+
+                        tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji,jj,1,1)
+                        td_risfdep%d_value(ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                            MIN( td_nam%d_e3zps_min, &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     ENDIF
+
+                  ELSE
+
+                     tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji,jj,1,1)
+                     td_risfdep%d_value(ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                            MIN( td_nam%d_e3zps_min, &
+                        &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+
+                  ENDIF
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         ! point V mbathy(ji,jj  ) == misfdep(ji,jj+1) 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji,jj  ,1,1) == tg_misfdep%d_value(ji,jj+1,1,1) .AND. &
+                &  tg_mbathy%d_value(ji,jj  ,1,1) >  1 )THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji,jj  ,1,1)
+                     zbathydiff = ABS( td_bathy%d_value(ji,jj  ,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                        &
+                        &                     td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj+1,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj+1,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                        &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value(ji,jj  ,1,1) = tg_mbathy%d_value(ji,jj  ,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji,jj  ,1,1)
+                        td_bathy%d_value (ji,jj  ,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+
+                        tg_misfdep%d_value(ji,jj+1,1,1) = tg_misfdep%d_value(ji,jj+1,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji,jj+1,1,1)
+                        td_risfdep%d_value(ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                             MIN( td_nam%d_e3zps_min, &
+                           &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     ENDIF
+
+                  ELSE
+                     tg_misfdep%d_value(ji,jj+1,1,1) = tg_misfdep%d_value(ji,jj+1,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji,jj+1,1,1)
+                     td_risfdep%d_value(ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                             MIN( td_nam%d_e3zps_min, &
+                        &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                  ENDIF
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! point V mbathy(ji,jj+1) == misfdep(ji,jj  ) 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji,jj+1,1,1) == tg_misfdep%d_value(ji,jj  ,1,1) .AND. &
+                &  tg_mbathy%d_value(ji,jj  ,1,1) > 1) THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji,jj+1,1,1)
+                     zbathydiff = ABS( td_bathy%d_value(ji,jj+1,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                        &
+                        &                     td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj  ,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                      &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value (ji,jj+1,1,1) = tg_mbathy%d_value(ji,jj+1,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji,jj+1,1,1)
+                        td_bathy%d_value  (ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                            MIN( td_nam%d_e3zps_min,          &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+
+                        tg_misfdep%d_value(ji,jj  ,1,1) = tg_misfdep%d_value(ji,jj  ,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji,jj  ,1,1)
+                        td_risfdep%d_value(ji,jj  ,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                           MIN( td_nam%d_e3zps_min,              &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     END IF
+
+                  ELSE
+
+                     tg_misfdep%d_value(ji,jj  ,1,1) = tg_misfdep%d_value(ji,jj  ,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji,jj  ,1,1)
+                     td_risfdep%d_value(ji,jj  ,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                           MIN( td_nam%d_e3zps_min,           &
+                        &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+
+                  ENDIF
+               
+               ENDIF
+
+            ENDDO
+         ENDDO         
+
+         !! lk_mpp not added
+
+         ! point U mbathy(ji  ,jj) EQ misfdep(ji+1,jj)
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji  ,jj,1,1) == tg_misfdep%d_value(ji+1,jj,1,1) .AND. &
+                &  tg_mbathy%d_value(ji  ,jj,1,1) > 1 )THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji  ,jj,1,1)
+                     zbathydiff = ABS(     td_bathy%d_value(ji  ,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                     &
+                        &                     td_nam%d_e3zps_rat* tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji+1,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji+1,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                       &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value (ji  ,jj,1,1) = tg_mbathy%d_value(ji  ,jj,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji  ,jj,1,1)
+                        td_bathy%d_value  (ji  ,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+                        tg_misfdep%d_value(ji+1,jj,1,1) = tg_misfdep%d_value(ji+1,jj,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji+1,jj,1,1)
+                        td_risfdep%d_value(ji+1,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                             MIN( td_nam%d_e3zps_min, &
+                           &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     END IF
+
+                  ELSE
+                     tg_misfdep%d_value(ji+1,jj,1,1)= tg_misfdep%d_value(ji+1,jj,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji+1,jj,1,1)
+                     td_risfdep%d_value(ji+1,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                             MIN( td_nam%d_e3zps_min, &
+                        &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                  ENDIF
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! point U mbathy(ji+1,jj) == misfdep(ji  ,jj) 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji+1,jj,1,1) == tg_misfdep%d_value(ji  ,jj,1,1) .AND. &
+                &  tg_mbathy%d_value(ji  ,jj,1,1) > 1 )THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji+1,jj,1,1)
+                     zbathydiff = ABS(     td_bathy%d_value(ji+1,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                        &
+                        &                     td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji ,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji  ,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                      &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value (ji+1,jj,1,1) = tg_mbathy%d_value(ji+1,jj,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji+1,jj,1,1)
+                        td_bathy%d_value  (ji+1,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                            MIN( td_nam%d_e3zps_min, &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+                        tg_misfdep%d_value(ji  ,jj,1,1) = tg_misfdep%d_value(ji  ,jj,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji  ,jj,1,1)
+                        td_risfdep%d_value(ji  ,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     END IF
+
+                  ELSE
+
+                     tg_misfdep%d_value(ji ,jj,1,1) = tg_misfdep%d_value(ji ,jj,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji  ,jj,1,1)
+                     td_risfdep%d_value(ji  ,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                           MIN( td_nam%d_e3zps_min, &
+                        &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+
+                  ENDIF
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+      END DO ! jl 
+      ! end dig bathy/ice shelf to be compatible
+
+      ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness
+      DO jl = 1,20
+
+         ! remove single point "bay" on isf coast line in the ice shelf draft'
+         DO jk = 2, jpk
+            WHERE( tg_misfdep%d_value(:,:,1,1) == 0 )
+               tg_misfdep%d_value(:,:,1,1)=jpk
+            END WHERE
+
+            zmask(:,:)=0
+            WHERE( tg_misfdep%d_value(:,:,1,1) <= jk ) zmask(:,:)=1
+            
+            DO jj = 2, jpj-1
+               DO ji = 2, jpi-1
+                  IF( tg_misfdep%d_value(ji,jj,1,1) == jk )THEN
+
+                     ibtest =   zmask(ji-1,jj  ) &
+                        &     + zmask(ji+1,jj  ) &
+                        &     + zmask(ji  ,jj-1) &
+                        &     + zmask(ji  ,jj+1)
+                     IF( ibtest <= 1 )THEN
+                        td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,jk+1,1)
+                        tg_misfdep%d_value(ji,jj,1,1) = jk+1
+                        IF( tg_misfdep%d_value(ji,jj,1,1) > tg_mbathy%d_value(ji,jj,1,1) )THEN
+                           tg_misfdep%d_value(ji,jj,1,1) = jpk
+                        ENDIF
+                     ENDIF
+
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+
+         WHERE( tg_misfdep%d_value(:,:,1,1) == jpk )
+             tg_misfdep%d_value(:,:,1,1)=0
+             td_risfdep%d_value(:,:,1,1)=0.
+             tg_mbathy%d_value (:,:,1,1)=0
+             td_bathy%d_value  (:,:,1,1)=0.
+         END WHERE
+
+         !! lk_mpp not added
+
+         ! remove single point "bay" on bathy coast line beneath an ice shelf'
+         DO jk = jpk,1,-1
+
+            zmask(:,:)=0
+            WHERE( tg_mbathy%d_value(:,:,1,1) >= jk ) zmask(:,:)=1
+
+            DO jj = 2, jpj-1
+               DO ji = 2, jpi-1
+                  IF( tg_mbathy%d_value (ji,jj,1,1) == jk .AND. &
+                    & tg_misfdep%d_value(ji,jj,1,1) >= 2 )THEN
+
+                     ibtest =   zmask(ji-1,jj  ) &
+                        &     + zmask(ji+1,jj  ) &
+                        &     + zmask(ji  ,jj-1) &
+                        &     + zmask(ji  ,jj+1)
+                     IF( ibtest <= 1 )THEN
+                        td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+                        tg_mbathy%d_value(ji,jj,1,1) = jk-1
+                        IF( tg_misfdep%d_value(ji,jj,1,1) > tg_mbathy%d_value(ji,jj,1,1) )THEN
+                           tg_mbathy%d_value(ji,jj,1,1) = 0
+                        ENDIF
+                     ENDIF
+
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+
+         WHERE( tg_mbathy%d_value(:,:,1,1) == 0 )
+             tg_misfdep%d_value(:,:,1,1)=0
+             td_risfdep%d_value(:,:,1,1)=0.
+             tg_mbathy%d_value (:,:,1,1)=0
+             td_bathy%d_value  (:,:,1,1)=0.
+         END WHERE
+
+         !! lk_mpp not added
+
+         ! fill hole in ice shelf
+         zmisfdep(:,:) = tg_misfdep%d_value(:,:,1,1)
+         zrisfdep(:,:) = td_risfdep%d_value(:,:,1,1)
+         WHERE( zmisfdep(:,:) <= 1 ) zmisfdep(:,:)=jpk
+
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+
+               ibtestim1 = zmisfdep(ji-1,jj  )
+               ibtestip1 = zmisfdep(ji+1,jj  )
+               
+               ibtestjm1 = zmisfdep(ji  ,jj-1)
+               ibtestjp1 = zmisfdep(ji  ,jj+1)
+
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji-1,jj  ,1,1) ) ibtestim1 = jpk
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji+1,jj  ,1,1) ) ibtestip1 = jpk
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji  ,jj-1,1,1) ) ibtestjm1 = jpk
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji  ,jj+1,1,1) ) ibtestjp1 = jpk
+
+               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == jpk .AND. &
+                 & tg_misfdep%d_value(ji,jj,1,1) >= 2 )THEN
+                  tg_mbathy%d_value (ji,jj,1,1) = 0
+                  td_bathy%d_value  (ji,jj,1,1) = 0.0_dp
+                  tg_misfdep%d_value(ji,jj,1,1) = 0
+                  td_risfdep%d_value(ji,jj,1,1) = 0.0_dp
+               END IF
+
+               IF( zmisfdep(ji,jj) < ibtest .AND. &
+                 & tg_misfdep%d_value(ji,jj,1,1) >= 2 )THEN
+                  tg_misfdep%d_value(ji,jj,1,1) = ibtest
+                  td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ibtest,1)
+               ENDIF
+
+            ENDDO
+         ENDDO         
+
+         !! lk_mpp not added
+
+         !! fill hole in bathymetry
+         zmbathy(:,:) = tg_mbathy%d_value(:,:,1,1)
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+
+               ibtestim1 = zmbathy(ji-1,jj  )
+               ibtestip1 = zmbathy(ji+1,jj  )
+
+               ibtestjm1 = zmbathy(ji  ,jj-1)
+               ibtestjp1 = zmbathy(ji  ,jj+1)
+
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji-1,jj  ,1,1) ) ibtestim1 = 0
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji+1,jj  ,1,1) ) ibtestip1 = 0
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji  ,jj-1,1,1) ) ibtestjm1 = 0
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji  ,jj+1,1,1) ) ibtestjp1 = 0
+
+               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == 0 .AND. tg_misfdep%d_value(ji,jj,1,1) >= 2) THEN
+                  tg_mbathy%d_value (ji,jj,1,1) = 0
+                  td_bathy%d_value  (ji,jj,1,1) = 0.0_dp
+                  tg_misfdep%d_value(ji,jj,1,1) = 0
+                  td_risfdep%d_value(ji,jj,1,1) = 0.0_dp
+               END IF
+
+               IF( ibtest < zmbathy(ji,jj) .AND. &
+               &   tg_misfdep%d_value(ji,jj,1,1) >= 2) THEN
+                  tg_mbathy%d_value(ji,jj,1,1) = ibtest
+                  td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ibtest+1,1) 
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+               IF( tg_mbathy%d_value(ji  ,jj,1,1) == tg_misfdep%d_value(ji+1,jj,1,1) .AND. &
+                 & tg_mbathy%d_value(ji  ,jj,1,1) >= 1   .AND. &
+                 & tg_mbathy%d_value(ji+1,jj,1,1) >= 1   )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1)  = tg_mbathy%d_value(ji,jj,1,1) - 1 
+
+                  ik=tg_mbathy%d_value(ji,jj,1,1)
+                  td_bathy%d_value (ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik+1,1)
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+               IF( tg_misfdep%d_value(ji  ,jj,1,1) == tg_mbathy%d_value(ji+1,jj,1,1) .AND. &
+                 & tg_mbathy%d_value (ji  ,jj,1,1) >= 1 .AND.&
+                 & tg_mbathy%d_value (ji+1,jj,1,1) >= 1 )THEN
+
+                  tg_mbathy%d_value(ji+1,jj,1,1)  = tg_mbathy%d_value(ji+1,jj,1,1) - 1
+
+                  ik=tg_mbathy%d_value(ji+1,jj,1,1)
+                  td_bathy%d_value(ji+1,jj,1,1)   = tg_gdepw_1d%d_value(1,1,ik+1,1)
+               ENDIF
+            ENDDO
+         ENDDO         
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi
+               IF( tg_mbathy%d_value(ji,jj  ,1,1) == tg_misfdep%d_value(ji,jj+1,1,1) .AND. &
+                 & tg_mbathy%d_value(ji,jj  ,1,1) >= 1 .AND. &
+                 & tg_mbathy%d_value(ji,jj+1,1,1) >= 1 )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1) = tg_mbathy%d_value(ji,jj,1,1) - 1
+
+                  ik=tg_mbathy%d_value(ji,jj,1,1)
+                  td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi
+               IF( tg_misfdep%d_value(ji,jj  ,1,1) == tg_mbathy%d_value(ji,jj+1,1,1) .AND.&
+                 & tg_mbathy%d_value (ji,jj  ,1,1) >= 1 .AND.&
+                 & tg_mbathy%d_value (ji,jj+1,1,1) >= 1 )THEN
+
+                  tg_mbathy%d_value(ji,jj+1,1,1) = tg_mbathy%d_value(ji,jj+1,1,1) - 1
+
+                  ik=tg_mbathy%d_value(ji,jj+1,1,1)
+                  td_bathy%d_value (ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check, mask T
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tg_mbathy%d_value(ji,jj,1,1) <= tg_misfdep%d_value(ji,jj,1,1) )THEN
+                  tg_misfdep%d_value(ji,jj,1,1) = 0
+                  td_risfdep%d_value(ji,jj,1,1) = 0._dp
+                  tg_mbathy%d_value (ji,jj,1,1) = 0
+                  td_bathy%d_value  (ji,jj,1,1) = 0._dp
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         WHERE( tg_mbathy%d_value(:,:,1,1) == 1 )
+            tg_mbathy%d_value (:,:,1,1) = 0
+            td_bathy%d_value  (:,:,1,1) = 0.0_dp
+            tg_misfdep%d_value(:,:,1,1) = 0
+            td_risfdep%d_value(:,:,1,1) = 0.0_dp
+         END WHERE
+      ENDDO
+      ! end check compatibility ice shelf/bathy
+
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE( td_risfdep%d_value(:,:,1,1) <= 10._dp )
+         tg_misfdep%d_value(:,:,1,1) = 1
+         td_risfdep%d_value(:,:,1,1) = 0.0_dp;
+      END WHERE
+
+      DEALLOCATE(zmask   )
+      DEALLOCATE(zrisfdep)
+      DEALLOCATE(zmisfdep)
+
+      ! compute scale factor and depth at T- and W- points
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = tg_mbathy%d_value(ji,jj,1,1)
+            IF( ik > 0 ) THEN               ! ocean point only      
+               ! max ocean level case
+               IF( ik == jpk-1 ) THEN
+
+                  zdepwp = td_bathy%d_value(ji,jj,1,1)
+                  ze3tp  = td_bathy%d_value(ji,jj,1,1) - tg_gdepw_1d%d_value(1,1,ik,1)
+                  ze3wp  = 0.5_dp * tg_e3w_1d%d_value(1,1,ik,1) &
+                     &            * ( 1._dp + ( ze3tp/tg_e3t_1d%d_value(1,1,ik,1) ) )
+                  tg_e3t_0%d_value  (ji,jj,ik  ,1) = ze3tp
+                  tg_e3t_0%d_value  (ji,jj,ik+1,1) = ze3tp
+                  tg_e3w_0%d_value  (ji,jj,ik  ,1) = ze3wp
+                  tg_e3w_0%d_value  (ji,jj,ik+1,1) = ze3wp
+
+                  tg_gdepw_0%d_value(ji,jj,ik+1,1) = zdepwp
+                  tg_gdept_0%d_value(ji,jj,ik  ,1) = tg_gdept_1d%d_value(1 ,1 ,ik-1,1) + ze3wp
+                  tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value (ji,jj,ik  ,1) + ze3tp
+                  !
+               ELSE    ! standard case
+
+                  IF( td_bathy%d_value(ji,jj,1,1) <= tg_gdepw_1d%d_value(1,1,ik+1,1) ) THEN
+                     tg_gdepw_0%d_value(ji,jj,ik+1,1) = td_bathy%d_value(ji,jj,1,1)
+                  ELSE
+                     tg_gdepw_0%d_value(ji,jj,ik+1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+                  ENDIF      
+                  !
+                  !gm Bug?  check the gdepw_1d
+                  ! ... on ik
+                  tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                     &     ( tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &
+                     & * ( ( tg_gdept_1d%d_value(1,1, ik  ,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &
+                     &   / ( tg_gdepw_1d%d_value(1,1, ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) )
+
+                  tg_e3t_0%d_value(ji,jj,ik  ,1) = tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik  ,1)
+                  tg_e3w_0%d_value(ji,jj,ik  ,1) = tg_gdept_0%d_value(ji,jj,ik  ,1) - tg_gdept_1d%d_value(1,1,ik-1,1)
+                  ! ... on ik+1
+                  tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+                  tg_e3t_0%d_value(ji,jj,ik+1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+                  !
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = tg_mbathy%d_value(ji,jj,1,1)
+            IF( ik > 0 ) THEN               ! ocean point only
+               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1)
+               ! test
+               zdiff= tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1)
+               IF( zdiff <= 0._dp ) THEN 
+                  it = it + 1
+                  CALL logger_info(' it    = '//TRIM(fct_str(it))//&
+                     &             ' ik    = '//TRIM(fct_str(ik))//&
+                     &             ' (i,j) = '//trim(fct_str(ji))//' '//TRIM(fct_str(jj)))
+                  CALL logger_info(' bathy = '//TRIM(fct_str(td_bathy%d_value(ji,jj,1,1))))
+                  CALL logger_info(' gdept_0 = '//TRIM(fct_str(tg_gdept_0%d_value(ji,jj,ik,1)))//&
+                     &             ' gdepw_0 = '//TRIM(fct_str(tg_gdepw_0%d_value(ji,jj,ik+1,1)))//&
+                     &             ' zdiff   = '//TRIM(fct_str(zdiff)))
+                  CALL logger_info(' e3tp    = '//TRIM(fct_str(tg_e3t_0%d_value(ji,jj,ik,1)))//&
+                     &             ' e3wp    = '//TRIM(fct_str(tg_e3w_0%d_value(ji,jj,ik,1))))
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      ! (ISF) Definition of e3t, u, v, w for ISF case
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = tg_misfdep%d_value(ji,jj,1,1) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+
+               IF( td_risfdep%d_value(ji,jj,1,1) < tg_gdepw_1d%d_value(1,1,ik,1) )THEN
+                   td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) 
+               ENDIF
+               tg_gdepw_0%d_value(ji,jj,ik,1) = td_risfdep%d_value(ji,jj,1,1) 
+!gm Bug?  check the gdepw_0 
+            !       ... on ik 
+               tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                  &        - ( tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_0%d_value(ji,jj,ik,1) )   & 
+                  &        * ( tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdept_1d%d_value(1,1, ik,1) )   & 
+                  &        / ( tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_1d%d_value(1,1, ik,1) ) 
+
+               tg_e3t_0%d_value(ji,jj,ik  ,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_0%d_value(ji,jj,ik,1) 
+               tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_gdept_1d%d_value(1,1,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1)
+
+               IF( ik + 1 == tg_mbathy%d_value(ji,jj,1,1) )THEN    ! ice shelf point only (2 cell water column) 
+                  tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1) 
+               ENDIF 
+            !       ... on ik / ik-1 
+               tg_e3w_0%d_value  (ji,jj,ik  ,1) = tg_e3t_0%d_value  (ji,jj,ik,1) 
+               tg_e3t_0%d_value  (ji,jj,ik-1,1) = tg_gdepw_0%d_value(ji,jj,ik,1) - tg_gdepw_1d%d_value(1,1,ik-1,1)
+! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
+               tg_gdept_0%d_value(ji,jj,ik-1,1) = tg_gdept_1d%d_value(1,1,ik-1,1)
+
+            ENDIF 
+         END DO 
+      END DO
+
+      it = 0 
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = tg_misfdep%d_value(ji,jj,1,1) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik  ,1) 
+               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik+1,1) 
+            ! test 
+               zdiff= tg_gdept_0%d_value(ji,jj,ik,1) - tg_gdepw_0%d_value(ji,jj,ik,1) 
+               IF( zdiff <= 0. ) THEN  
+                  it = it + 1 
+                  CALL logger_info(' it    = '//TRIM(fct_str(it))//&
+                  &                ' ik    = '//TRIM(fct_str(ik))//&
+                  &                ' (i,j) = '//trim(fct_str(ji))//' '//TRIM(fct_str(jj)))
+
+                  CALL logger_info(' risfdep = '//TRIM(fct_str(td_risfdep%d_value(ji,jj,1,1)))) 
+                  CALL logger_info(' gdept = '//TRIM(fct_str(tg_gdept_0%d_value(ji,jj,ik,1)))//&
+                  &                ' gdepw = '//TRIM(fct_str(tg_gdepw_0%d_value(ji,jj,ik+1,1)))//&
+                  &                ' zdiff = '//TRIM(fct_str(zdiff)))
+                  CALL logger_info(' e3tp  = '//TRIM(fct_str(tg_e3t_0%d_value(ji,jj,ik  ,1)))//&
+                  &                ' e3wp  = '//TRIM(fct_str(tg_e3w_0%d_value(ji,jj,ik+1,1))))
+               ENDIF 
+            ENDIF 
+         END DO 
+      END DO
+
+   END SUBROUTINE grid_zgr__isf_fill
+!   !-------------------------------------------------------------------
+!   !> @brief This subroutine define e3t, u, v, w for ISF case 
+!   !>
+!   !> @details
+!   !>
+!   !> @author J.Paul
+!   !> @date September, 2015 - rewrite from zgr_zps
+!   !>
+!   !> @param[in] jpi
+!   !> @param[in] jpj
+!   !> @param[in] td_risfdep
+!   !-------------------------------------------------------------------
+!   SUBROUTINE grid_zgr__isf_fill_e3x( jpi,jpj, &
+!         &                            td_risfdep) 
+!      IMPLICIT NONE
+!      ! Argument      
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+!      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+!
+!      ! local variable
+!      REAL(dp)    :: zdiff            ! temporary scalar
+!
+!      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+!      INTEGER(i4) :: it
+!      INTEGER(i4) :: ik
+!      !----------------------------------------------------------------
+!
+!      ! (ISF) Definition of e3t, u, v, w for ISF case
+!      DO jj = 1, jpj 
+!         DO ji = 1, jpi 
+!            ik = tg_misfdep%d_value(ji,jj,1,1) 
+!
+!            IF( ik > 1 ) THEN
+!               ! ice shelf point only
+!               IF( td_risfdep%d_value(ji,jj,1,1) < tg_gdepw_1d%d_value(1,1,ik,1) )THEN
+!                   td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) 
+!               ENDIF
+!               tg_gdepw_0%d_value(ji,jj,ik,1) = td_risfdep%d_value(ji,jj,1,1) 
+!            !gm Bug?  check the gdepw_0 
+!            !       ... on ik 
+!               tg_gdept_0%d_value(ji,jj,ik  ,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - & 
+!                  &                               (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_0%d_value (ji,jj,ik,1)) * &
+!                  &                               (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdept_1d%d_value( 1, 1,ik,1)) / & 
+!                  &                               (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_1d%d_value( 1, 1,ik,1)) 
+!
+!               tg_e3t_0%d_value  (ji,jj,ik  ,1) = tg_gdepw_1d%d_value( 1, 1,ik+1,1) - &
+!                  &                               tg_gdepw_0%d_value (ji,jj,ik  ,1) 
+!
+!               tg_e3w_0%d_value  (ji,jj,ik+1,1) = tg_gdept_1d%d_value( 1, 1,ik+1,1) - &
+!                  &                               tg_gdept_0%d_value (ji,jj,ik  ,1)
+!
+!               IF( ik + 1 == tg_mbathy%d_value(ji,jj,1,1) ) THEN
+!
+!                  ! ice shelf point only (2 cell water column)
+!                  tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik+1,1) - &
+!                     &                             tg_gdept_0%d_value(ji,jj,ik  ,1) 
+!
+!               ENDIF 
+!            !       ... on ik / ik-1 
+!               tg_e3w_0%d_value  (ji,jj,ik  ,1) = 2._dp * (tg_gdept_0%d_value(ji,jj,ik,1) - &
+!                  &                                        tg_gdepw_0%d_value(ji,jj,ik,1)) 
+!
+!               tg_e3t_0%d_value  (ji,jj,ik-1,1) = tg_gdepw_0%d_value (ji,jj,ik  ,1) - &
+!                  &                               tg_gdepw_1d%d_value( 1, 1,ik-1,1)
+!
+!               ! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
+!               tg_gdept_0%d_value(ji,jj,ik-1,1) = tg_gdept_1d%d_value(1,1,ik-1,1)
+!            ENDIF 
+!
+!         END DO 
+!      END DO 
+!      
+!      it = 0 
+!      DO jj = 1, jpj 
+!         DO ji = 1, jpi 
+!            ik = tg_misfdep%d_value(ji,jj,1,1) 
+!            IF( ik > 1 ) THEN               ! ice shelf point only 
+!               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik  ,1) 
+!               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik+1,1) 
+!            ! test 
+!               zdiff= tg_gdept_0%d_value(ji,jj,ik,1) - &
+!                  &   tg_gdepw_0%d_value(ji,jj,ik,1) 
+!
+!               IF( zdiff <= 0. ) THEN  
+!                  it = it + 1 
+!                  CALL logger_info(' it      = '//TRIM(fct_str(it))//&
+!                     &             ' ik      = '//TRIM(fct_str(ik))//&
+!                     &             ' (i,j)   =('//TRIM(fct_str(ji))//','//TRIM(fct_str(jj))//')')  
+!                  CALL logger_info(' risfdep = '//TRIM(fct_str(td_risfdep%d_value(ji,jj,1,1))) )
+!                  CALL logger_info(' gdept = '//TRIM(fct_str(tg_gdept_0%d_value(ji,jj,ik  ,1)))//&
+!                     &             ' gdepw = '//TRIM(fct_str(tg_gdepw_0%d_value(ji,jj,ik+1,1)))//&
+!                     &             ' zdiff = '//TRIM(fct_str(zdiff)) ) 
+!                  CALL logger_info(' e3tp  = '//TRIM(fct_str( tg_e3tp%d_value(ji,jj,1,1)))//&
+!                     &             ' e3wp  = '//TRIM(fct_str( tg_e3wp%d_value(ji,jj,1,1))) ) 
+!               ENDIF 
+!            ENDIF 
+!         END DO 
+!      END DO 
+!      ! END (ISF)
+!
+!   END SUBROUTINE grid_zgr__isf_fill_e3x
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define e3uw 
+   !>    (adapted for 2 cells in the water column) for ISF case 
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_zps
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__isf_fill_e3uw(jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4)   , INTENT(IN   ) :: jpi
+      INTEGER(i4)   , INTENT(IN   ) :: jpj
+
+      ! local variable
+      INTEGER(i4) :: ikb, ikt
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      DO jj = 2, jpj - 1 
+         DO ji = 2, jpi - 1 
+
+            ikb = MAX(tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji+1,jj,1,1))
+            ikt = MAX(tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji+1,jj,1,1))
+            IF( ikb == ikt+1 )THEN
+               tg_e3uw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb  ,1), tg_gdept_0%d_value(ji+1,jj  ,ikb  ,1) ) - &
+               &                                MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji+1,jj  ,ikb-1,1) )
+            ENDIF
+            
+            ikb = MAX( tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji,jj+1,1,1))
+            ikt = MAX( tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji,jj+1,1,1))
+            IF( ikb == ikt+1 )THEN
+               tg_e3vw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb  ,1), tg_gdept_0%d_value(ji  ,jj+1,ikb  ,1) ) - &
+               &                                MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji  ,jj+1,ikb-1,1) )
+            ENDIF
+         END DO
+      END DO
+
+   END SUBROUTINE grid_zgr__isf_fill_e3uw
+!   !-------------------------------------------------------------------
+!   !> @brief This subroutine compute gdep3w_0 (vertical sum of e3w) 
+!   !>
+!   !> @details
+!   !>
+!   !> @author J.Paul
+!   !> @date September, 2015 - rewrite from zgr_zps
+!   !>
+!   !> @param[in] jpi
+!   !> @param[in] jpj
+!   !> @param[in] jpk
+!   !> @param[in] td_risfdep
+!   !-------------------------------------------------------------------
+!   SUBROUTINE grid_zgr__isf_fill_gdep3w_0( jpi,jpj,jpk,td_risfdep )
+!      IMPLICIT NONE
+!      ! Argument      
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+!      INTEGER(i4), INTENT(IN   ) :: jpk
+!      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+!
+!      ! local variable
+!      INTEGER(i4) :: ik
+!
+!      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+!      INTEGER(i4) :: jk
+!      !----------------------------------------------------------------
+!
+!      WHERE( tg_misfdep%d_value(:,:,:,:) == 0 ) tg_misfdep%d_value(:,:,:,:) = 1
+!      
+!      DO jj = 1,jpj
+!         DO ji = 1,jpi
+!
+!            tg_gdep3w_0%d_value(ji,jj,1,1) = 0.5_dp * tg_e3w_0%d_value(ji,jj,1,1)
+!            DO jk = 2, INT(tg_misfdep%d_value(ji,jj,1,1),i4)
+!               tg_gdep3w_0%d_value(ji,jj,jk,1) = tg_gdep3w_0%d_value(ji,jj,jk-1,1) + &
+!                  &                              tg_e3w_0%d_value   (ji,jj,jk  ,1) 
+!            END DO
+!
+!            ik=tg_misfdep%d_value(ji,jj,1,1)
+!            IF( ik >= 2 )THEN
+!               tg_gdep3w_0%d_value(ji,jj,ik,1) = td_risfdep%d_value(ji,jj, 1,1) + &
+!                  &                       0.5_dp * tg_e3w_0%d_value(ji,jj,ik,1)
+!            ENDIF
+!
+!            DO jk = ik + 1, jpk
+!               tg_gdep3w_0%d_value(ji,jj,jk,1) = tg_gdep3w_0%d_value(ji,jj,jk-1,1) + &
+!                  &                              tg_e3w_0%d_value   (ji,jj,jk  ,1) 
+!            END DO
+!
+!         END DO
+!      END DO
+!
+!   END SUBROUTINE grid_zgr__isf_fill_gdep3w_0
+   !-------------------------------------------------------------------
+   !> @brief This function initialise global variable needed to compute vertical
+   !>        mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_sco_init(jpi,jpj) 
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp), DIMENSION(jpi,jpj) :: dl_tmp
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      dl_tmp(:,:)=dp_fill
+
+      tg_rx1     =var_init('rx1      ',dl_tmp(:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+   END SUBROUTINE grid_zgr_sco_init
+   !-------------------------------------------------------------------
+   !> @brief This function clean structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_sco_clean() 
+      IMPLICIT NONE
+      ! Argument      
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_rx1      )
+      
+   END SUBROUTINE grid_zgr_sco_clean
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define the s-coordinate system
+   !>
+   !> @details
+   !>
+   !> ** Method  :   s-coordinate
+   !>         The depth of model levels is defined as the product of an
+   !>      analytical function by the local bathymetry, while the vertical
+   !>      scale factors are defined as the product of the first derivative
+   !>      of the analytical function by the bathymetry.
+   !>      (this solution save memory as depth and scale factors are not
+   !>      3d fields)
+   !>          - Read bathymetry (in meters) at t-point and compute the
+   !>         bathymetry at u-, v-, and f-points.
+   !>            - hbatu = mi( hbatt )
+   !>            - hbatv = mj( hbatt )
+   !>            - hbatf = mi( mj( hbatt ) )
+   !>          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+   !>         function and its derivative given as function.
+   !>            - z_gsigt(k) = fssig (k    )
+   !>            - z_gsigw(k) = fssig (k-0.5)
+   !>            - z_esigt(k) = fsdsig(k    )
+   !>            - z_esigw(k) = fsdsig(k-0.5)
+   !>      Three options for stretching are give, and they can be modified
+   !>      following the users requirements. Nevertheless, the output as
+   !>      well as the way to compute the model levels and scale factors
+   !>      must be respected in order to insure second order accuracy
+   !>      schemes.
+   !>
+   !>      The three methods for stretching available are:
+   !> 
+   !>           s_sh94 (Song and Haidvogel 1994)
+   !>                a sinh/tanh function that allows sigma and stretched sigma
+   !>
+   !>           s_sf12 (Siddorn and Furner 2012?)
+   !>                allows the maintenance of fixed surface and or
+   !>                bottom cell resolutions (cf. geopotential coordinates) 
+   !>                within an analytically derived stretched S-coordinate framework.
+   !> 
+   !>          s_tanh  (Madec et al 1996)
+   !>                a cosh/tanh function that gives stretched coordinates
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_sco
+   !> @date October, 2016
+   !> - add wetting and drying boolean
+   !>
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__sco_fill( td_nam,jpi,jpj,jpk,td_bathy ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+
+      ! local variable
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+
+      REAL(dp) :: zrmax, zrfact
+      REAL(dp) :: ztaper
+
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hifv  !< interface depth between stretching at v--f
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hiff
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hift  !< and quasi-uniform spacing t--u points (m)
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hifu
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_scosrf !< ocean surface topography
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_scobot !< ocean bottom topography
+
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatt
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatu
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatv
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatf
+
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zenv
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zri
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zrj
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zhbat
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpi1
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpi2
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpj1
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpj2
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR SCO: s-coordinate or hybrid z-s-coordinate')
+      CALL logger_info('~~~~~~~~~~~')
+      CALL logger_info('   Namelist namzgr_sco')
+      CALL logger_info('     stretching coeffs ')
+      CALL logger_info('        maximum depth of s-bottom surface (>0)       dn_sbot_max   = '//TRIM(fct_str(td_nam%d_sbot_max)))
+      CALL logger_info('        minimum depth of s-bottom surface (>0)       dn_sbot_min   = '//TRIM(fct_str(td_nam%d_sbot_min)))
+      CALL logger_info('        Critical depth                               dn_hc         = '//TRIM(fct_str(td_nam%d_hc)))
+      CALL logger_info('        maximum cut-off r-value allowed              dn_rmax       = '//TRIM(fct_str(td_nam%d_rmax)))
+      CALL logger_info('     Song and Haidvogel 1994 stretching              ln_s_sh94     = '//TRIM(fct_str(td_nam%l_s_sh94)))
+      CALL logger_info('        Song and Haidvogel 1994 stretching coefficients')
+      CALL logger_info('        surface control parameter (0<=rn_theta<=20)  dn_theta      = '//TRIM(fct_str(td_nam%d_theta)))
+      CALL logger_info('        bottom  control parameter (0<=rn_thetb<= 1)  dn_thetb      = '//TRIM(fct_str(td_nam%d_thetb)))
+      CALL logger_info('        stretching parameter (song and haidvogel)    dn_bb         = '//TRIM(fct_str(td_nam%d_bb)))
+      CALL logger_info('     Siddorn and Furner 2012 stretching              ln_s_sf12     = '//TRIM(fct_str(td_nam%l_s_sf12)))
+      CALL logger_info('        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = '//TRIM(fct_str(td_nam%l_sigcrit)))
+      CALL logger_info('        Siddorn and Furner 2012 stretching coefficients')
+      CALL logger_info('        stretchin parameter ( >1 surface; <1 bottom) dn_alpha      = '//TRIM(fct_str(td_nam%d_alpha)))
+      CALL logger_info('        e-fold length scale for transition region    dn_efold      = '//TRIM(fct_str(td_nam%d_efold)))
+      CALL logger_info('        Surface cell depth (Zs) (m)                  dn_zs         = '//TRIM(fct_str(td_nam%d_zs)))
+      CALL logger_info('        Bathymetry multiplier for Zb                 dn_zb_a       = '//TRIM(fct_str(td_nam%d_zb_a)))
+      CALL logger_info('        Offset for Zb                                dn_zb_b       = '//TRIM(fct_str(td_nam%d_zb_b)))
+      CALL logger_info('        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b')
+
+      ALLOCATE(dl_hifv(jpi,jpj))
+      ALLOCATE(dl_hiff(jpi,jpj))
+      ALLOCATE(dl_hift(jpi,jpj))
+      ALLOCATE(dl_hifu(jpi,jpj))
+
+      ! set the minimum depth for the s-coordinate
+      dl_hift(:,:) = td_nam%d_sbot_min
+      dl_hifu(:,:) = td_nam%d_sbot_min
+      dl_hifv(:,:) = td_nam%d_sbot_min
+      dl_hiff(:,:) = td_nam%d_sbot_min
+
+      ! set maximum ocean depth
+      td_bathy%d_value(:,:,1,1) = MIN( td_nam%d_sbot_max, td_bathy%d_value(:,:,1,1) )
+      IF( .NOT. td_nam%l_wd )THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( td_bathy%d_value(ji,jj,1,1) > 0._dp )THEN
+                 td_bathy%d_value(ji,jj,1,1) = MAX(td_nam%d_sbot_min, td_bathy%d_value(ji,jj,1,1))
+              ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! =============================
+      ! Define the envelop bathymetry   (hbatt)
+      ! =============================
+      ! use r-value to create hybrid coordinates
+      ALLOCATE(zenv(jpi,jpj))
+      zenv(:,:) = td_bathy%d_value(:,:,1,1)
+
+      IF( .NOT. td_nam%l_wd )THEN
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( td_bathy%d_value(ji,jj,1,1) == 0._dp )THEN
+                iip1 = MIN( ji+1, jpi )
+                ijp1 = MIN( jj+1, jpj )
+                iim1 = MAX( ji-1,  1  )
+                ijm1 = MAX( jj-1,  1  )
+                IF( ( td_bathy%d_value(iim1,ijm1,1,1) + &
+                   &  td_bathy%d_value(ji  ,ijp1,1,1) + &
+                   &  td_bathy%d_value(iip1,ijp1,1,1) + &
+                   &  td_bathy%d_value(iim1,jj  ,1,1) + &
+                   &  td_bathy%d_value(iip1,jj  ,1,1) + &
+                   &  td_bathy%d_value(iim1,ijm1,1,1) + &
+                   &  td_bathy%d_value(ji  ,ijm1,1,1) + &
+                   &  td_bathy%d_value(iip1,ijp1,1,1) ) > 0._dp )THEN
+                  zenv(ji,jj) = td_nam%d_sbot_min
+                ENDIF
+              ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+      ! this is only in mpp case, so here just do nothing
+      !! CALL lbc_lnk( zenv(:,:), 'T', td_nam%i_perio, 1._dp, 'no0' ) 
+
+      ! smooth the bathymetry (if required)
+      ALLOCATE(dl_scosrf(jpi,jpj))
+      ALLOCATE(dl_scobot(jpi,jpj))
+      dl_scosrf(:,:) = 0._dp                      ! ocean surface depth (here zero: no under ice-shelf sea)
+      dl_scobot(:,:) = td_bathy%d_value(:,:,1,1)  ! ocean bottom  depth
+
+      jl    = 0
+      zrmax = 1._dp
+
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1._dp - td_nam%d_rmax ) / ( 1._dp + td_nam%d_rmax )      
+
+      ! initialise temporary envelope depth arrays
+      ALLOCATE(ztmpi1(jpi,jpj))
+      ALLOCATE(ztmpi2(jpi,jpj))
+      ALLOCATE(ztmpj1(jpi,jpj))
+      ALLOCATE(ztmpj2(jpi,jpj))
+
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+
+      ! initialise temporary r-value arrays
+      ALLOCATE(zri(jpi,jpj))
+      ALLOCATE(zrj(jpi,jpj))
+      zri(:,:) = 1._dp
+      zrj(:,:) = 1._dp
+
+      !  Iterative loop  !
+      ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - td_nam%d_rmax ) > 1.e-8_dp )
+
+         jl = jl + 1
+         zrmax = 0._dp
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0._dp
+         zrj(:,:) = 0._dp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               iip1 = MIN( ji+1, jpi )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, jpj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               IF( (zenv(ji  ,jj) > 0._dp) .AND. &
+                 & (zenv(iip1,jj) > 0._dp) )THEN
+                  zri(ji,jj) = ( zenv(iip1,  jj) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj  ) > 0._dp) .AND. &
+                 & (zenv(ji,ijp1) > 0._dp) )THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  td_nam%d_rmax ) ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -td_nam%d_rmax ) ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  td_nam%d_rmax ) ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -td_nam%d_rmax ) ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         !! 
+         !
+         CALL logger_info('zgr_sco :   iter= '//TRIM(fct_str(jl))//&
+            &             ' rmax= '//TRIM(fct_str(zrmax)) )
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zenv(ji,jj) = MAX( zenv  (ji,jj), &
+                                & ztmpi1(ji,jj), &
+                                & ztmpi2(ji,jj), &
+                                & ztmpj1(ji,jj), &
+                                & ztmpj2(ji,jj) )
+            END DO
+         END DO
+         ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         ! this is only in mpp case, so here just do nothing
+         !!CALL lbc_lnk( zenv, 'T', td_nam%i_perio, 1._dp, 'no0' )
+      ENDDO
+      !     End loop     !
+      ! ================ !
+
+      DEALLOCATE(zri)
+      DEALLOCATE(zrj)
+
+      DEALLOCATE(ztmpi1)
+      DEALLOCATE(ztmpi2)
+      DEALLOCATE(ztmpj1)
+      DEALLOCATE(ztmpj2)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! set all points to avoid undefined scale value warnings
+            zenv(ji,jj) = MAX( zenv(ji,jj), td_nam%d_sbot_min )
+         ENDDO
+      ENDDO
+      !
+      ! Envelope bathymetry saved in hbatt
+      !
+!      ALLOCATE(dl_hbatt(jpi,jpj))
+!      ALLOCATE(dl_hbatu(jpi,jpj))
+!      ALLOCATE(dl_hbatv(jpi,jpj))
+!      ALLOCATE(dl_hbatf(jpi,jpj))
+
+      tg_hbatt%d_value(:,:,1,1) = zenv(:,:) 
+      IF( MINVAL( tg_gphit%d_value(:,:,1,1) ) * &
+        & MAXVAL( tg_gphit%d_value(:,:,1,1) ) <= 0._dp ) THEN
+         CALL logger_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(tg_gphit%d_value(ji,jj,1,1)/8._dp)**2._dp )
+               tg_hbatt%d_value(ji,jj,1,1) =   td_nam%d_sbot_max           * ztaper           &
+               &                             + tg_hbatt%d_value(ji,jj,1,1) * (1._dp - ztaper)
+            END DO
+         END DO
+      ENDIF
+
+      DEALLOCATE(zenv)
+
+      CALL logger_info(' bathy  MAX '//TRIM(fct_str(MAXVAL( td_bathy%d_value(:,:,1,1) )))//&
+         &                    ' MIN '//TRIM(fct_str(MINVAL( td_bathy%d_value(:,:,1,1) ))) )
+      CALL logger_info(' hbatt  MAX '//TRIM(fct_str(MAXVAL( tg_hbatt%d_value(:,:,1,1) )))//&
+         &                    ' MIN '//TRIM(fct_str(MINVAL( tg_hbatt%d_value(:,:,1,1) ))) )
+      !
+      !   hbatu, hbatv, hbatf fields
+      !
+      tg_hbatu%d_value(:,:,1,1) = td_nam%d_sbot_min
+      tg_hbatv%d_value(:,:,1,1) = td_nam%d_sbot_min
+      tg_hbatf%d_value(:,:,1,1) = td_nam%d_sbot_min
+
+      DO jj = 1, jpj-1
+        DO ji = 1, jpi-1   ! NO vector opt.
+           tg_hbatu%d_value(ji,jj,1,1) = 0.50_dp * ( tg_hbatt%d_value(ji  ,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji+1,jj  ,1,1) )
+           tg_hbatv%d_value(ji,jj,1,1) = 0.50_dp * ( tg_hbatt%d_value(ji  ,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji  ,jj+1,1,1) )
+           tg_hbatf%d_value(ji,jj,1,1) = 0.25_dp * ( tg_hbatt%d_value(ji  ,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji  ,jj+1,1,1) + &
+              &                                      tg_hbatt%d_value(ji+1,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji+1,jj+1,1,1) )
+        ENDDO
+      ENDDO
+
+      IF( td_nam%l_wd ) THEN               !avoid the zero depth on T- (U-,V-,F-) points
+        DO jj = 1, jpj
+          DO ji = 1, jpi
+            IF( ABS(tg_hbatt%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatt%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatt%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+            IF( ABS(tg_hbatu%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatu%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatu%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+            IF( ABS(tg_hbatv%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatv%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatv%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+            IF( ABS(tg_hbatf%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatf%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatf%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+          END DO
+        END DO
+      ENDIF
+
+      ! Apply lateral boundary condition
+      ALLOCATE(zhbat(jpi,jpj))
+
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = tg_hbatu%d_value(:,:,1,1)
+      CALL lbc_lnk( tg_hbatu%d_value(:,:,1,1), 'U', td_nam%i_perio, 1._dp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tg_hbatu%d_value(ji,jj,1,1) == 0._dp )THEN
+               !No worries about the following line when l_wd == .true.
+               IF( zhbat(ji,jj) == 0._dp ) tg_hbatu%d_value(ji,jj,1,1) = td_nam%d_sbot_min
+               IF( zhbat(ji,jj) /= 0._dp ) tg_hbatu%d_value(ji,jj,1,1) = zhbat(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      zhbat(:,:) = tg_hbatv%d_value(:,:,1,1)
+      CALL lbc_lnk( tg_hbatv%d_value(:,:,1,1), 'V', td_nam%i_perio, 1._dp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tg_hbatv%d_value(ji,jj,1,1) == 0._dp ) THEN
+               IF( zhbat(ji,jj) == 0._dp ) tg_hbatv%d_value(ji,jj,1,1) = td_nam%d_sbot_min
+               IF( zhbat(ji,jj) /= 0._dp ) tg_hbatv%d_value(ji,jj,1,1) = zhbat(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      zhbat(:,:) = tg_hbatf%d_value(:,:,1,1)
+      CALL lbc_lnk( tg_hbatf%d_value(:,:,1,1), 'F', td_nam%i_perio, 1._dp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tg_hbatf%d_value(ji,jj,1,1) == 0._dp ) THEN
+               IF( zhbat(ji,jj) == 0._dp ) tg_hbatf%d_value(ji,jj,1,1) = td_nam%d_sbot_min
+               IF( zhbat(ji,jj) /= 0._dp ) tg_hbatf%d_value(ji,jj,1,1) = zhbat(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(zhbat)
+
+!!bug:  key_helsinki a verifer
+      IF( .NOT.td_nam%l_wd )THEN
+         dl_hift(:,:) = MIN( dl_hift(:,:), tg_hbatt%d_value(:,:,1,1) )
+         dl_hifu(:,:) = MIN( dl_hifu(:,:), tg_hbatu%d_value(:,:,1,1) )
+         dl_hifv(:,:) = MIN( dl_hifv(:,:), tg_hbatv%d_value(:,:,1,1) )
+         dl_hiff(:,:) = MIN( dl_hiff(:,:), tg_hbatf%d_value(:,:,1,1) )
+      ENDIF
+
+      CALL logger_info(' MAX val hif   t '//TRIM(fct_str(MAXVAL( dl_hift(:,:) )))//&
+         &                           ' f '//TRIM(fct_str(MAXVAL( dl_hiff(:,:) )))//&
+         &                           ' u '//TRIM(fct_str(MAXVAL( dl_hifu(:,:) )))//&
+         &                           ' v '//TRIM(fct_str(MAXVAL( dl_hifv(:,:) ))) )
+      CALL logger_info(' MIN val hif   t '//TRIM(fct_str(MINVAL( dl_hift(:,:) )))//&
+         &                           ' f '//TRIM(fct_str(MINVAL( dl_hiff(:,:) )))//&
+         &                           ' u '//TRIM(fct_str(MINVAL( dl_hifu(:,:) )))//&
+         &                           ' v '//TRIM(fct_str(MINVAL( dl_hifv(:,:) ))) )
+      CALL logger_info(' MAX val hbat  t '//TRIM(fct_str(MAXVAL( tg_hbatt%d_value(:,:,1,1) )))//&
+         &                           ' f '//TRIM(fct_str(MAXVAL( tg_hbatf%d_value(:,:,1,1) )))//&
+         &                           ' u '//TRIM(fct_str(MAXVAL( tg_hbatu%d_value(:,:,1,1) )))//&
+         &                           ' v '//TRIM(fct_str(MAXVAL( tg_hbatv%d_value(:,:,1,1) ))) )
+      CALL logger_info(' MIN val hbat  t '//TRIM(fct_str(MINVAL( tg_hbatt%d_value(:,:,1,1) )))//&
+         &                           ' f '//TRIM(fct_str(MINVAL( tg_hbatf%d_value(:,:,1,1) )))//&
+         &                           ' u '//TRIM(fct_str(MINVAL( tg_hbatu%d_value(:,:,1,1) )))//&
+         &                           ' v '//TRIM(fct_str(MINVAL( tg_hbatv%d_value(:,:,1,1) ))) )
+!! helsinki
+
+      ! =======================
+      !   s-ccordinate fields     (gdep., e3.)
+      ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner  2012 (ln_sf12=T)
+! or  tanh function        (both false)                    
+!========================================================================
+      IF( td_nam%l_s_sh94 ) THEN 
+         CALL grid_zgr__sco_s_sh94( td_nam,jpi,jpj,jpk, &
+         &                          dl_scosrf )
+      ELSEIF( td_nam%l_s_sf12 ) THEN
+         CALL grid_zgr__sco_s_sf12( td_nam,jpi,jpj,jpk, &
+         &                          dl_scosrf )
+      ELSE                 
+         CALL grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, &
+         &                          dl_scosrf, &
+         &                          dl_hift, dl_hifu, dl_hifv, dl_hiff )
+      ENDIF
+
+      DEALLOCATE(dl_scosrf)
+
+      DEALLOCATE(dl_hifv)
+      DEALLOCATE(dl_hiff)
+      DEALLOCATE(dl_hift)
+      DEALLOCATE(dl_hifu)
+
+      CALL lbc_lnk( tg_e3t_0%d_value(:,:,:,1) , 'T', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3u_0%d_value(:,:,:,1) , 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3v_0%d_value(:,:,:,1) , 'V', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3f_0%d_value(:,:,:,1) , 'F', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3w_0%d_value(:,:,:,1) , 'W', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+
+      IF( .NOT. td_nam%l_wd ) THEN
+         WHERE( tg_e3t_0%d_value(:,:,:,1) == 0_dp )  tg_e3t_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3u_0%d_value(:,:,:,1) == 0_dp )  tg_e3u_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3v_0%d_value(:,:,:,1) == 0_dp )  tg_e3v_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3f_0%d_value(:,:,:,1) == 0_dp )  tg_e3f_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3w_0%d_value(:,:,:,1) == 0_dp )  tg_e3w_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3uw_0%d_value(:,:,:,1)== 0_dp )  tg_e3uw_0%d_value(:,:,:,1)= 1._dp
+         WHERE( tg_e3vw_0%d_value(:,:,:,1)== 0_dp )  tg_e3vw_0%d_value(:,:,:,1)= 1._dp
+      ENDIF
+
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk-1
+               IF( dl_scobot(ji,jj) >= tg_gdept_0%d_value(ji,jj,jk,1) )THEN
+                  tg_mbathy%d_value(ji,jj,1,1) = REAL(MAX( 2, jk ),dp)
+               ENDIF
+            END DO
+
+            IF( td_nam%l_wd ) THEN
+               IF( dl_scobot(ji,jj) <= -(td_nam%d_wdld - td_nam%d_wdmin2) )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1) = 0._dp
+
+               ELSEIF( dl_scobot(ji,jj) <= td_nam%d_wdmin1 )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1) = 2._dp
+
+               ENDIF
+            ELSE
+               IF( dl_scobot(ji,jj) == 0._dp )THEN
+                  tg_mbathy%d_value(ji,jj,1,1) = 0._dp
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(dl_scobot)
+
+      CALL logger_info(' MIN val mbathy MIN '//TRIM(fct_str(MINVAL( tg_mbathy%d_value(:,:,1,1) )))//&
+         &             ' MAX '//TRIM(fct_str(MAXVAL( tg_mbathy%d_value(:,:,1,1) ))) )
+      CALL logger_info(' MIN val depth t '//TRIM(fct_str(MINVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MINVAL( tg_gdepw_0%d_value(:,:,:,1) ))) )!//&
+         !&                           '3w '//TRIM(fct_str(MINVAL( tg_gdep3w_0%d_value(:,:,:,1)))) )
+
+      CALL logger_info(' MIN val e3    t '//TRIM(fct_str(MINVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &                           ' f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &                           ' u '//TRIM(fct_str(MINVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &                           ' v '//TRIM(fct_str(MINVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &                          ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &                          ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MINVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+
+      CALL logger_info(' MAX val depth t '//TRIM(fct_str(MAXVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MAXVAL( tg_gdepw_0%d_value(:,:,:,1) ))) )!//&
+         !&                           '3w '//TRIM(fct_str(MAXVAL( tg_gdep3w_0%d_value(:,:,:,1) ))) )
+
+      CALL logger_info(' MAX val e3    t '//TRIM(fct_str(MAXVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &                           ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &                           ' u '//TRIM(fct_str(MAXVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &                           ' v '//TRIM(fct_str(MAXVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &                          ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &                          ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MAXVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+
+!================================================================================
+! check the coordinate makes sense
+!================================================================================
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+            IF( tg_hbatt%d_value(ji,jj,1,1) > 0._dp )THEN
+               DO jk = 1, INT(tg_mbathy%d_value(ji,jj,1,1),i4)
+                  ! check coordinate is monotonically increasing
+                  IF( tg_e3w_0%d_value(ji,jj,jk,1) <= 0._dp .OR. &
+                    & tg_e3t_0%d_value(ji,jj,jk,1) <= 0._dp )THEN
+                     CALL logger_fatal(' GRID ZGR SCO:   e3w   or e3t   =< 0  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'e3w',fse3w(ji,jj,:)
+                    !WRITE(numout,*) 'e3t',fse3t(ji,jj,:)
+                  ENDIF
+                  ! and check it has never gone negative
+                  IF( tg_gdepw_0%d_value(ji,jj,jk,1) < 0._dp .OR. &
+                    & tg_gdept_0%d_value(ji,jj,jk,1) < 0._dp ) THEN
+                     CALL logger_fatal('GRId ZGR SCO :   gdepw or gdept =< 0  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                    !WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                  ENDIF
+                  ! and check it never exceeds the total depth
+                  IF( tg_gdepw_0%d_value(ji,jj,jk,1) > tg_hbatt%d_value(ji,jj,1,1) ) THEN
+                     CALL logger_fatal('GRID ZGR SCO:   gdepw > hbatt  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                  ENDIF
+               ENDDO
+
+               DO jk = 1, INT(tg_mbathy%d_value(ji,jj,1,1),i4)-1
+                  ! and check it never exceeds the total depth
+                  IF( tg_gdept_0%d_value(ji,jj,jk,1) > tg_hbatt%d_value(ji,jj,1,1) ) THEN
+                    CALL logger_fatal('GRID ZGR SCO:   gdept > hbatt  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                  ENDIF
+               ENDDO
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE grid_zgr__sco_fill
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !> @details
+   !> ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+   !>                mixed S/sigma coordinate
+   !>
+   !> Reference : Song and Haidvogel 1994.   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr 
+   !> @date October, 2016
+   !> - add wetting and drying option
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] dd_scosrf
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__sco_s_sh94( td_nam,jpi,jpj,jpk, &
+         &                          dd_scosrf ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ),                 INTENT(IN   ) :: td_nam
+      INTEGER(i4),                 INTENT(IN   ) :: jpi
+      INTEGER(i4),                 INTENT(IN   ) :: jpj
+      INTEGER(i4),                 INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_scosrf
+
+      ! local variable
+      REAL(dp) :: zcoeft
+      REAL(dp) :: zcoefw
+
+      REAL(dp) ::   ztmpu
+      REAL(dp) ::   ztmpv
+      REAL(dp) ::   ztmpf
+      REAL(dp) ::   ztmpu1
+      REAL(dp) ::   ztmpv1
+      REAL(dp) ::   ztmpf1
+
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsi3w3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtv3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtf3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwv3
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ALLOCATE( z_gsigw3(jpi,jpj,jpk))
+      ALLOCATE( z_gsigt3(jpi,jpj,jpk))
+      ALLOCATE( z_gsi3w3(jpi,jpj,jpk))
+      ALLOCATE( z_esigt3(jpi,jpj,jpk))
+      ALLOCATE( z_esigw3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtv3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwv3(jpi,jpj,jpk))
+
+      z_gsigw3(:,:,:) =0._dp
+      z_gsigt3(:,:,:) =0._dp  
+      z_gsi3w3(:,:,:) =0._dp  
+      z_esigt3(:,:,:) =0._dp  
+      z_esigw3(:,:,:) =0._dp  
+
+      z_esigtu3(:,:,:)=0._dp 
+      z_esigtv3(:,:,:)=0._dp
+      z_esigtf3(:,:,:)=0._dp
+      z_esigwu3(:,:,:)=0._dp
+      z_esigwv3(:,:,:)=0._dp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+   
+            IF( tg_hbatt%d_value(ji,jj,1,1) > td_nam%d_hc ) THEN    !deep water, stretched sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) = -grid_zgr__sco_fssig1( td_nam, jpk, REAL(jk,dp)-0.5_dp, td_nam%d_bb )
+                  z_gsigt3(ji,jj,jk) = -grid_zgr__sco_fssig1( td_nam, jpk, REAL(jk,dp)       , td_nam%d_bb )
+               END DO
+            ELSE ! shallow water, uniform sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) =   REAL(jk-1,dp)            / REAL(jpk-1,dp)
+                  z_gsigt3(ji,jj,jk) = ( REAL(jk-1,dp) + 0.5_dp ) / REAL(jpk-1,dp)
+               END DO
+            ENDIF         
+
+            DO jk = 1, jpk-1
+               z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+               z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+            END DO            
+            z_esigw3(ji,jj,1  ) = 2._dp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) )
+            z_esigt3(ji,jj,jpk) = 2._dp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) )
+
+            ! Coefficients for vertical depth as the sum of e3w scale factors
+            z_gsi3w3(ji,jj,1) = 0.5_dp * z_esigw3(ji,jj,1)
+            DO jk = 2, jpk
+               z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+            END DO
+            !
+            DO jk = 1, jpk
+               zcoeft = ( REAL(jk,dp) - 0.5_dp ) / REAL(jpk-1,dp)
+               zcoefw = ( REAL(jk,dp) - 1.0_dp ) / REAL(jpk-1,dp)
+               tg_gdept_0%d_value(ji,jj,jk,1)  = (  dd_scosrf(ji,jj) &
+                  &                              + (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc)*z_gsigt3(ji,jj,jk) &
+                  &                              +  td_nam%d_hc*zcoeft )
+               tg_gdepw_0%d_value(ji,jj,jk,1)  = (  dd_scosrf(ji,jj) &
+                  &                              + (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc)*z_gsigw3(ji,jj,jk) &
+                  &                              +  td_nam%d_hc*zcoefw )
+               !tg_gdep3w_0%d_value(ji,jj,jk,1) = (  dd_scosrf(ji,jj) &
+               !   &                              + (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc)*z_gsi3w3(ji,jj,jk) &
+               !   &                              +  td_nam%d_hc*zcoeft )
+            END DO
+
+         END DO   ! for all jj's
+      END DO    ! for all ji's
+
+      DO ji = 1, jpi-1
+         DO jj = 1, jpj-1
+            ! extended for Wetting/Drying case
+            ztmpu  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1)
+            ztmpv  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji  ,jj+1,1,1)
+            ztmpf  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1) + &
+                   & tg_hbatt%d_value(ji  ,jj+1,1,1) + tg_hbatt%d_value(ji+1,jj+1,1,1)
+
+            ztmpu1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji+1,jj  ,1,1)
+            ztmpv1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji  ,jj+1,1,1)
+            ztmpf1 =    MIN(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                   &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1)) &
+                   & *  MAX(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                   &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1))
+
+            DO jk = 1, jpk
+
+               IF( td_nam%l_wd .AND. &
+                 & ( ztmpu1 < 0._dp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN
+                  z_esigtu3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )
+                  z_esigwu3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )
+               ELSE
+                  z_esigtu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigt3(ji  ,jj,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigt3(ji+1,jj,jk) ) / ztmpu
+                  z_esigwu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigw3(ji  ,jj,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigw3(ji+1,jj,jk)) / ztmpu
+               ENDIF
+
+               IF( td_nam%l_wd .AND. &
+                 & ( ztmpv1 < 0._dp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN
+                  z_esigtv3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )
+                  z_esigwv3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )
+               ELSE
+                  z_esigtv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigt3(ji,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigt3(ji,jj+1,jk)) / ztmpv
+                  z_esigwv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigw3(ji,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigw3(ji,jj+1,jk)) / ztmpv
+               ENDIF
+
+               IF( td_nam%l_wd .AND. &
+                 & ( ztmpf1 < 0._dp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN
+                  z_esigtf3(ji,jj,jk) = 0.25_dp * ( z_esigt3(ji  ,jj  ,jk) &
+                                      &           + z_esigt3(ji+1,jj  ,jk) &
+                                      &           + z_esigt3(ji  ,jj+1,jk) &
+                                      &           + z_esigt3(ji+1,jj+1,jk) )
+               ELSE
+                  z_esigtf3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj  ,1,1)*z_esigt3(ji  ,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj  ,1,1)*z_esigt3(ji+1,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji  ,jj+1,1,1)*z_esigt3(ji  ,jj+1,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj+1,1,1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+               ENDIF
+               !
+               tg_e3t_0%d_value(ji,jj,jk,1) = ( ( tg_hbatt%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigt3 (ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3u_0%d_value(ji,jj,jk,1) = ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigtu3(ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3v_0%d_value(ji,jj,jk,1) = ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigtv3(ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3f_0%d_value(ji,jj,jk,1) = ( ( tg_hbatf%d_value(ji,jj,1,1) - td_nam%d_hc ) *z_esigtf3(ji,jj,jk) &
+                  &                            + td_nam%d_hc/REAL(jpk-1,dp) )
+               
+               tg_e3w_0%d_value (ji,jj,jk,1)= ( ( tg_hbatt%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigw3 (ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3uw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwu3(ji,jj,jk) &
+                 &                             + td_nam%d_hc/REAL(jpk-1,dp) )
+               tg_e3vw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwv3(ji,jj,jk) &
+                 &                             + td_nam%d_hc/REAL(jpk-1,dp) )
+            END DO
+        END DO
+      END DO
+
+      DEALLOCATE( z_gsigw3  )
+      DEALLOCATE( z_gsigt3  )
+      DEALLOCATE( z_gsi3w3  )
+      DEALLOCATE( z_esigt3  )
+      DEALLOCATE( z_esigw3  )
+      DEALLOCATE( z_esigtu3 )
+      DEALLOCATE( z_esigtv3 )
+      DEALLOCATE( z_esigtf3 )
+      DEALLOCATE( z_esigwu3 )
+      DEALLOCATE( z_esigwv3 )
+
+   END SUBROUTINE grid_zgr__sco_s_sh94
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !> ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+   !>                mixed S/sigma/Z coordinate
+   !>
+   !>                This method allows the maintenance of fixed surface and or
+   !>                bottom cell resolutions (cf. geopotential coordinates) 
+   !>                within an analytically derived stretched S-coordinate framework.
+   !>
+   !>
+   !> Reference : Siddorn and Furner 2012 (submitted Ocean modelling).   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr 
+   !> @date October, 2016
+   !> - add wetting and drying option
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] dd_scosrf
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__sco_s_sf12( td_nam,jpi,jpj,jpk, &
+         &                          dd_scosrf ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ),                 INTENT(IN   ) :: td_nam
+      INTEGER(i4),                 INTENT(IN   ) :: jpi
+      INTEGER(i4),                 INTENT(IN   ) :: jpj
+      INTEGER(i4),                 INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_scosrf
+
+      ! local variable
+      REAL(dp) ::   zsmth     ! smoothing around critical depth
+      REAL(dp) ::   zzs, zzb  ! Surface and bottom cell thickness in sigma space
+
+      REAL(dp) ::   ztmpu
+      REAL(dp) ::   ztmpv
+      REAL(dp) ::   ztmpf
+      REAL(dp) ::   ztmpu1
+      REAL(dp) ::   ztmpv1
+      REAL(dp) ::   ztmpf1
+
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsi3w3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtv3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtf3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwv3
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      ALLOCATE( z_gsigw3(jpi,jpj,jpk))
+      ALLOCATE( z_gsigt3(jpi,jpj,jpk))
+      ALLOCATE( z_gsi3w3(jpi,jpj,jpk))
+      ALLOCATE( z_esigt3(jpi,jpj,jpk))
+      ALLOCATE( z_esigw3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtv3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwv3(jpi,jpj,jpk))
+
+      z_gsigw3(:,:,:) =0._dp
+      z_gsigt3(:,:,:) =0._dp  
+      z_gsi3w3(:,:,:) =0._dp  
+      z_esigt3(:,:,:) =0._dp  
+      z_esigw3(:,:,:) =0._dp  
+      z_esigtu3(:,:,:)=0._dp 
+      z_esigtv3(:,:,:)=0._dp
+      z_esigtf3(:,:,:)=0._dp
+      z_esigwu3(:,:,:)=0._dp
+      z_esigwv3(:,:,:)=0._dp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+          IF( tg_hbatt%d_value(ji,jj,1,1) > td_nam%d_hc )THEN !deep water, stretched sigma
+              
+             ! this forces a linear bottom cell depth relationship with H,.
+             ! could be changed by users but care must be taken to do so carefully
+              zzb = tg_hbatt%d_value(ji,jj,1,1)*td_nam%d_zb_a + td_nam%d_zb_b
+
+              zzb = 1.0_dp-(zzb/tg_hbatt%d_value(ji,jj,1,1))
+            
+              zzs = td_nam%d_zs / tg_hbatt%d_value(ji,jj,1,1) 
+              
+              IF( td_nam%d_efold /= 0.0_dp )THEN
+                zsmth = TANH( (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc ) / td_nam%d_efold )
+              ELSE
+                zsmth = 1.0_dp 
+              ENDIF
+               
+              DO jk = 1, jpk
+                z_gsigw3(ji,jj,jk) =  REAL(jk-1,dp)        /REAL(jpk-1,dp)
+                z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5_dp)/REAL(jpk-1,dp)
+              ENDDO
+              z_gsigw3(ji,jj,:) = grid_zgr__sco_fgamma( td_nam, jpk, z_gsigw3(ji,jj,:), zzb, zzs, zsmth  )
+              z_gsigt3(ji,jj,:) = grid_zgr__sco_fgamma( td_nam, jpk, z_gsigt3(ji,jj,:), zzb, zzs, zsmth  )
+ 
+          ELSE IF( td_nam%l_sigcrit )THEN ! shallow water, uniform sigma
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,dp)     /REAL(jpk-1,dp)
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5)/REAL(jpk-1,dp)
+            END DO
+
+          ELSE  ! shallow water, z coordinates
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,dp)        /REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1))
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5_dp)/REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1))
+            END DO
+
+          ENDIF
+
+          DO jk = 1, jpk-1
+             z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+             z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+          END DO
+          z_esigw3(ji,jj,1  ) = 2.0_dp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ))
+          z_esigt3(ji,jj,jpk) = 2.0_dp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk))
+
+          ! Coefficients for vertical depth as the sum of e3w scale factors
+          z_gsi3w3(ji,jj,1) = 0.5_dp * z_esigw3(ji,jj,1)
+          DO jk = 2, jpk
+             z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+          END DO
+
+          DO jk = 1, jpk
+             tg_gdept_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsigt3(ji,jj,jk)
+             tg_gdepw_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsigw3(ji,jj,jk)
+             !tg_gdep3w_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsi3w3(ji,jj,jk)
+          END DO
+
+        ENDDO   ! for all jj's
+      ENDDO    ! for all ji's
+
+      DO ji=1,jpi-1
+        DO jj=1,jpj-1
+
+           ! extend to suit for Wetting/Drying case
+           ztmpu  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1)
+           ztmpv  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji  ,jj+1,1,1)
+           ztmpf  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1) + &
+                  & tg_hbatt%d_value(ji  ,jj+1,1,1) + tg_hbatt%d_value(ji+1,jj+1,1,1)
+
+           ztmpu1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji+1,jj  ,1,1)
+           ztmpv1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji  ,jj+1,1,1)
+           ztmpf1 =    MIN(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                  &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1)) & 
+                  &  * MAX(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                  &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1))
+
+          DO jk = 1, jpk
+
+            IF( td_nam%l_wd .AND. &
+              & ( ztmpu1 < 0._dp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN
+               z_esigtu3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )
+               z_esigwu3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )
+            ELSE
+               z_esigtu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigt3(ji  ,jj,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigt3(ji+1,jj,jk) ) / ztmpu
+               z_esigwu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigw3(ji  ,jj,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigw3(ji+1,jj,jk) ) / ztmpu
+            ENDIF
+
+            IF( td_nam%l_wd .AND. &
+              & ( ztmpv1 < 0._dp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN
+               z_esigtv3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )
+               z_esigwv3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )
+            ELSE
+               z_esigtv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigt3(ji,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigt3(ji,jj+1,jk)) / ztmpv
+               z_esigwv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigw3(ji,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigw3(ji,jj+1,jk)) / ztmpv
+            ENDIF
+
+            IF( td_nam%l_wd .AND. &
+              & ( ztmpf1 < 0._dp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN
+               z_esigtf3(ji,jj,jk) = 0.25_dp * ( z_esigt3(ji  ,jj  ,jk) &
+                                   &           + z_esigt3(ji+1,jj  ,jk) &
+                                   &           + z_esigt3(ji  ,jj+1,jk) &
+                                   &           + z_esigt3(ji+1,jj+1,jk) )
+            ELSE
+               z_esigtf3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj  ,1,1)*z_esigt3(ji  ,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj  ,1,1)*z_esigt3(ji+1,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji  ,jj+1,1,1)*z_esigt3(ji  ,jj+1,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj+1,1,1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+            ENDIF
+
+             tg_e3t_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_esigt3 (ji,jj,jk)
+             tg_e3u_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatu%d_value(ji,jj,1,1))*z_esigtu3(ji,jj,jk)
+             tg_e3v_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatv%d_value(ji,jj,1,1))*z_esigtv3(ji,jj,jk)
+             tg_e3f_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatf%d_value(ji,jj,1,1))*z_esigtf3(ji,jj,jk)
+             !
+             tg_e3w_0%d_value(ji,jj,jk,1)  = tg_hbatt%d_value(ji,jj,1,1)*z_esigw3 (ji,jj,jk)
+             tg_e3uw_0%d_value(ji,jj,jk,1) = tg_hbatu%d_value(ji,jj,1,1)*z_esigwu3(ji,jj,jk)
+             tg_e3vw_0%d_value(ji,jj,jk,1) = tg_hbatv%d_value(ji,jj,1,1)*z_esigwv3(ji,jj,jk)
+          END DO
+
+        ENDDO
+      ENDDO
+
+      CALL lbc_lnk(tg_e3t_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 
+      CALL lbc_lnk(tg_e3u_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+      CALL lbc_lnk(tg_e3v_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 
+      CALL lbc_lnk(tg_e3f_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+      CALL lbc_lnk(tg_e3w_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+      CALL lbc_lnk(tg_e3uw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 
+      CALL lbc_lnk(tg_e3vw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+
+      DEALLOCATE( z_gsigw3  )
+      DEALLOCATE( z_gsigt3  )
+      DEALLOCATE( z_gsi3w3  )
+      DEALLOCATE( z_esigt3  )
+      DEALLOCATE( z_esigw3  )
+      DEALLOCATE( z_esigtu3 )
+      DEALLOCATE( z_esigtv3 )
+      DEALLOCATE( z_esigtf3 )
+      DEALLOCATE( z_esigwu3 )
+      DEALLOCATE( z_esigwv3 )
+
+   END SUBROUTINE grid_zgr__sco_s_sf12
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !>
+   !> ** Method  :   s-coordinate stretch 
+   !>
+   !> Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] dd_scosrf
+   !> @param[in] dd_hift 
+   !> @param[in] dd_hifu 
+   !> @param[in] dd_hifv 
+   ! @param[in] dd_hiff 
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, &
+         &                          dd_scosrf, &
+         &                          dd_hift, dd_hifu, dd_hifv, dd_hiff ) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ),                 INTENT(IN   ) :: td_nam
+      INTEGER(i4),                 INTENT(IN   ) :: jpi
+      INTEGER(i4),                 INTENT(IN   ) :: jpj
+      INTEGER(i4),                 INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_scosrf
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hift
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hifu
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hifv
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hiff
+
+      ! local variable
+      REAL(dp) :: zcoeft
+      REAL(dp) :: zcoefw
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      tg_gsigt%d_value(1,1,:,1) =0._dp  
+      tg_gsigw%d_value(1,1,:,1) =0._dp
+      tg_gsi3w%d_value(1,1,:,1) =0._dp  
+      tg_esigt%d_value(1,1,:,1) =0._dp  
+      tg_esigw%d_value(1,1,:,1) =0._dp
+
+      DO jk = 1, jpk
+        tg_gsigw%d_value(1,1,jk,1) = -grid_zgr__sco_fssig( td_nam, jpk, REAL(jk,dp)-0.5_dp )
+        tg_gsigt%d_value(1,1,jk,1) = -grid_zgr__sco_fssig( td_nam, jpk, REAL(jk,dp)        )
+      END DO
+      CALL logger_info('z_gsigw 1 jpk '//TRIM(fct_str(tg_gsigw%d_value(1,1,1,1)))//&
+         &             TRIM(fct_str(tg_gsigw%d_value(1,1,jpk,1))) )
+
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpk-1
+         tg_esigt%d_value(1,1,jk  ,1) = tg_gsigw%d_value(1,1,jk+1,1) - tg_gsigw%d_value(1,1,jk,1)
+         tg_esigw%d_value(1,1,jk+1,1) = tg_gsigt%d_value(1,1,jk+1,1) - tg_gsigt%d_value(1,1,jk,1)
+      END DO
+      tg_esigw%d_value(1,1, 1 ,1) = 2._dp * ( tg_gsigt%d_value(1,1,1  ,1) - tg_gsigw%d_value(1,1,1  ,1) ) 
+      tg_esigt%d_value(1,1,jpk,1) = 2._dp * ( tg_gsigt%d_value(1,1,jpk,1) - tg_gsigw%d_value(1,1,jpk,1) )
+
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      tg_gsi3w%d_value(1,1,1,1) = 0.5_dp * tg_esigw%d_value(1,1,1,1)
+      DO jk = 2, jpk
+         tg_gsi3w%d_value(1,1,jk,1) = tg_gsi3w%d_value(1,1,jk-1,1) + tg_esigw%d_value(1,1,jk,1)
+      END DO
+!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
+      DO jk = 1, jpk
+         zcoeft = ( REAL(jk,dp) - 0.5_dp ) / REAL(jpk-1,dp)
+         zcoefw = ( REAL(jk,dp) - 1.0_dp ) / REAL(jpk-1,dp)
+         tg_gdept_0%d_value (:,:,jk,1) = dd_scosrf(:,:) + ( tg_hbatt%d_value(:,:,1 ,1) - dd_hift(:,:) ) &
+            &                                             * tg_gsigt%d_value(1,1,jk,1) + dd_hift(:,:)*zcoeft
+         tg_gdepw_0%d_value (:,:,jk,1) = dd_scosrf(:,:) + ( tg_hbatt%d_value(:,:,1 ,1) - dd_hift(:,:) ) &
+            &                                             * tg_gsigw%d_value(1,1,jk,1) + dd_hift(:,:)*zcoefw
+         !tg_gdep3w_0%d_value(:,:,jk,1) = dd_scosrf(:,:) + ( tg_hbatt%d_value(:,:,1 ,1) - dd_hift(:,:)) &
+         !                                                 * tg_gsi3w%d_value(1,1,jk,1) + dd_hift(:,:)*zcoeft
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+              tg_e3t_0%d_value(ji,jj,jk,1) = ( (tg_hbatt%d_value(ji,jj,1 ,1) - dd_hift(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hift(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3u_0%d_value(ji,jj,jk,1) = ( (tg_hbatu%d_value(ji,jj,1 ,1) - dd_hifu(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hifu(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3v_0%d_value(ji,jj,jk,1) = ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3f_0%d_value(ji,jj,jk,1) = ( (tg_hbatf%d_value(ji,jj,1 ,1) - dd_hiff(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1, jk,1) + dd_hiff(ji,jj)/REAL(jpk-1,dp) )
+               
+              tg_e3w_0%d_value (ji,jj,jk,1)= ( (tg_hbatt%d_value(ji,jj,1 ,1) - dd_hift(ji,jj)) &
+                 &                            * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hift(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3uw_0%d_value(ji,jj,jk,1)= ( (tg_hbatu%d_value(ji,jj,1 ,1) - dd_hifu(ji,jj)) &
+                 &                            * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifu(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3vw_0%d_value(ji,jj,jk,1)= ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) &
+                 &                            * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) )
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE grid_zgr__sco_s_tanh
+   !!----------------------------------------------------------------------
+   !> @brief This function provide the analytical function in s-coordinate
+   !>        
+   !> @details
+   !> ** Method  :   the function provide the non-dimensional position of
+   !>                T and W (i.e. between 0 and 1)
+   !>                T-points at integer values (between 1 and jpk)
+   !>                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr
+   !>
+   !> @param[in] td_nam 
+   !> @param[in] jpk
+   !> @param[in] pk
+   !!----------------------------------------------------------------------
+   FUNCTION grid_zgr__sco_fssig( td_nam, jpk, pk ) RESULT( pf )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      REAL(dp)   , INTENT(IN   ) :: pk   ! continuous "k" coordinate
+      REAL(dp)                   :: pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( td_nam%d_theta * ( -(pk-0.5_dp) / REAL(jpk-1,dp) + td_nam%d_thetb )  ) &
+         &     - TANH( td_nam%d_thetb * td_nam%d_theta                                   )  ) &
+         & * (   COSH( td_nam%d_theta                                      )                  &
+         &     + COSH( td_nam%d_theta * ( 2._dp * td_nam%d_thetb - 1._dp ) )  )               &
+         & / ( 2._dp * SINH( td_nam%d_theta ) )
+      !
+   END FUNCTION grid_zgr__sco_fssig
+   !!----------------------------------------------------------------------
+   !> @brief This function provide the Song and Haidvogel version of the analytical function in s-coordinate
+   !>
+   !> @details
+   !> ** Method  :   the function provides the non-dimensional position of
+   !>                T and W (i.e. between 0 and 1)
+   !>                T-points at integer values (between 1 and jpk)
+   !>                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] pk1 
+   !> @param[in] pbb
+   !!----------------------------------------------------------------------
+   FUNCTION grid_zgr__sco_fssig1( td_nam, jpk, pk1, pbb ) RESULT( pf1 )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      REAL(dp)   , INTENT(IN   ) :: pk1   ! continuous "k" coordinate
+      REAL(dp)   , INTENT(IN   ) :: pbb   ! Stretching coefficient
+      REAL(dp)                   :: pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( td_nam%d_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_dp ) / REAL(jpk-1,dp)
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._dp - pbb ) * ( SINH( td_nam%d_theta*(-(pk1-0.5_dp)/REAL(jpk-1,dp)) ) ) / SINH( td_nam%d_theta )              &
+            &  + pbb * (  (TANH( td_nam%d_theta*( (-(pk1-0.5_dp)/REAL(jpk-1,dp)) + 0.5_dp) ) - TANH( 0.5_dp * td_nam%d_theta )  )  &
+            &        / ( 2._dp * TANH( 0.5_dp * td_nam%d_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION grid_zgr__sco_fssig1
+   !!----------------------------------------------------------------------
+   !> @brief This function provide analytical function for the s-coordinate
+   !>
+   !> @details
+   !> ** Method  :   the function provides the non-dimensional position of
+   !>                T and W (i.e. between 0 and 1)
+   !>                T-points at integer values (between 1 and jpk)
+   !>                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+   !>
+   !>                This method allows the maintenance of fixed surface and or
+   !>                bottom cell resolutions (cf. geopotential coordinates) 
+   !>                within an analytically derived stretched S-coordinate framework.
+   !>
+   !> Reference  :   Siddorn and Furner, in prep
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr 
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpk
+   !> @param[in] pk1 
+   !> @param[in] pzb
+   !> @param[in] pzs
+   !> @param[in] pzsmth
+   !!----------------------------------------------------------------------
+   FUNCTION grid_zgr__sco_fgamma( td_nam, jpk, pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:) , INTENT(IN   ) :: pk1       ! continuous "k" coordinate
+      ! function
+      REAL(dp)   , DIMENSION(jpk) :: p_gamma   ! stretched coordinate
+      ! local variable
+      REAL(dp)   , INTENT(IN   ) :: pzb           ! Bottom box depth
+      REAL(dp)   , INTENT(IN   ) :: pzs           ! surface box depth
+      REAL(dp)   , INTENT(IN   ) :: psmth       ! Smoothing parameter
+      REAL(dp)                   :: za1,za2,za3    ! local variables
+      REAL(dp)                   :: zn1,zn2        ! local variables
+      REAL(dp)                   :: za,zb,zx       ! local variables
+
+      ! loop indices
+      INTEGER(i4)             ::   jk
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1._dp / REAL(jpk-1,dp)
+      zn2  =  1._dp -  zn1
+
+      za1 = (td_nam%d_alpha+2.0_dp)*zn1**(td_nam%d_alpha+1.0_dp)-(td_nam%d_alpha+1.0_dp)*zn1**(td_nam%d_alpha+2.0_dp) 
+      za2 = (td_nam%d_alpha+2.0_dp)*zn2**(td_nam%d_alpha+1.0_dp)-(td_nam%d_alpha+1.0_dp)*zn2**(td_nam%d_alpha+2.0_dp)
+      za3 = (zn2**3.0_dp - za2)/( zn1**3.0_dp - za1)
+     
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5_dp*(za2+zn2**2.0_dp) - za3*(zn1-0.5_dp*(za1+zn1**2.0_dp) ) )
+      zb = (pzs - za1 - za*( zn1-0.5_dp*(za1+zn1**2.0_dp ) ) ) / (zn1**3.0_dp - za1)
+      zx = 1.0_dp-za/2.0_dp-zb
+ 
+      DO jk = 1, jpk
+        p_gamma(jk) = za*(pk1(jk)*(1.0_dp-pk1(jk)/2.0_dp))+zb*pk1(jk)**3.0_dp +  &
+                    & zx*( (td_nam%d_alpha+2.0_dp)*pk1(jk)**(td_nam%d_alpha+1.0_dp)- &
+                    &      (td_nam%d_alpha+1.0_dp)*pk1(jk)**(td_nam%d_alpha+2.0_dp) )
+        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_dp-psmth)
+      ENDDO 
+
+      !
+   END FUNCTION grid_zgr__sco_fgamma
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !>
+   !> ** Method  :   s-coordinate stretch 
+   !>
+   !> Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domain (dom_stiff) 
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+   SUBROUTINE grid_zgr_sco_stiff(td_nam, jpi,jpj,jpk)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      REAL(dp) ::   zrxmax
+      REAL(dp), DIMENSION(4) :: zr1
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      tg_rx1%d_value(:,:,1,1) = 0._dp
+
+      zrxmax   = 0._dp
+      zr1(:)   = 0._dp
+
+      DO ji = 2, jpi-1
+         DO jj = 2, jpj-1
+            DO jk = 1, jpk-1
+               zr1(1) = tg_umask%d_value(ji-1,jj  ,jk,1) &
+                  &            * ABS( ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1) &
+                  &                   - tg_gdepw_0%d_value(ji-1,jj  ,jk  ,1) & 
+                  &                   + tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) &
+                  &                   - tg_gdepw_0%d_value(ji-1,jj  ,jk+1,1) ) &
+                  &                 / ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1) &
+                  &                   + tg_gdepw_0%d_value(ji-1,jj  ,jk  ,1) &
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) &
+                  &                   - tg_gdepw_0%d_value(ji-1,jj  ,jk+1,1) &
+                  &                   + dp_eps) )
+               zr1(2) = tg_umask%d_value(ji  ,jj  ,jk,1) &
+                  &            * ABS( ( tg_gdepw_0%d_value(ji+1,jj  ,jk  ,1) &
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1) &
+                  &                   + tg_gdepw_0%d_value(ji+1,jj  ,jk+1,1) &
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) ) &
+                  &                 / ( tg_gdepw_0%d_value(ji+1,jj  ,jk  ,1)&
+                  &                   + tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                   - tg_gdepw_0%d_value(ji+1,jj  ,jk+1,1)&
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                   + dp_eps) )
+               zr1(3) = tg_vmask%d_value(ji  ,jj  ,jk,1) &
+                  &              * ABS( ( tg_gdepw_0%d_value(ji  ,jj+1,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj+1,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) ) &
+                  &                   / ( tg_gdepw_0%d_value(ji  ,jj+1,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj+1,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                     + dp_eps) )
+               zr1(4) = tg_vmask%d_value(ji  ,jj-1,jk,1) &
+                  &              * ABS( ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj-1,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj-1,jk+1,1) ) &
+                  &                   / ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj-1,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj-1,jk+1,1)&
+                  &                     + dp_eps) )
+               zrxmax = MAXVAL(zr1(1:4))
+               tg_rx1%d_value(ji,jj,1,1) = MAX(tg_rx1%d_value(ji,jj,1,1), zrxmax)
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_lnk( tg_rx1%d_value(:,:,1,1), 'T', td_nam%i_perio, 1._dp )
+
+      zrxmax = MAXVAL(tg_rx1%d_value(:,:,1,1))
+      CALL logger_info(' GRID ZGR SCO STIFF: maximum grid stiffness ratio: '//&
+         &  TRIM(fct_str(zrxmax)) )
+
+   END SUBROUTINE grid_zgr_sco_stiff
+END MODULE grid_zgr
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp.f90	(revision 8732)
@@ -0,0 +1,959 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: interp
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage interpolation on regular grid.
+!>
+!> @details Interpolation method to be used is specify inside variable 
+!>    strcuture, as array of string character.<br/> 
+!>    - td_var\%c_interp(1) string character is the interpolation name choose between:
+!>       - 'nearest'
+!>       - 'cubic  '
+!>       - 'linear '
+!>    - td_var\%c_interp(2) string character is an operation to be used 
+!>    on interpolated value.<br/>
+!>          operation have to be mulitplication '*' or division '/'.<br/>
+!>          coefficient have to be refinement factor following i-direction 'rhoi', 
+!>          j-direction 'rhoj', or k-direction 'rhok'.<br/>
+!>
+!>          Examples: '*rhoi', '/rhoj'.
+!> 
+!>    @note Those informations are read from namelist or variable configuration file (default).<br/>
+!>    Interplation method could be specify for each variable in namelist _namvar_,
+!>    defining string character _cn\_varinfo_.<br/>
+!>    Example:
+!>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear' 
+!>
+!>    to create mixed grid (with coarse grid point needed to compute
+!> interpolation):<br/>
+!> @code
+!>    CALL interp_create_mixed_grid( td_var, td_mix [,id_rho] )
+!> @endcode
+!>       - td_var is coarse grid variable (should be extrapolated)
+!>       - td_mix is mixed grid variable structure [output]
+!>       - id_rho is array of refinment factor [optional]
+!>
+!>    to detected point to be interpolated:<br/>
+!> @code
+!>    il_detect(:,:,:)=interp_detect( td_mix [,id_rho] )
+!> @endcode
+!>       - il_detect(:,:,:) is 3D array of detected point to be interpolated
+!>       - td_mix is mixed grid variable
+!>       - id_rho is array of refinement factor [optional]
+!>
+!>    to interpolate variable value:<br/>
+!> @code
+!>    CALL  interp_fill_value( td_var [,id_rho] [,id_offset] )
+!> @endcode
+!>       - td_var is variable structure
+!>       - id_rho is array of refinement factor [optional]
+!>       - id_offset is array of offset between fine and coarse grid [optional]
+!>
+!>    to clean mixed grid (remove points added on mixed grid to compute interpolation):<br/>
+!> @code
+!>    CALL interp_clean_mixed_grid( td_mix, td_var, id_rho )
+!> @endcode
+!>       - td_mix is mixed grid variable structure
+!>       - td_var is variable structure [output]
+!>       - id_rho is array of refinement factor [optional]
+!>       - id_offset is array of offset between fine and coarse grid [optional]
+!>
+!> @note It use to work on ORCA grid, as we work only with grid indices.
+!>
+!> @warning due to the use of second derivative when using cubic interpolation
+!> you should add at least 2 extrabands.
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> - use interpolation method modules
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp_cubic                    !   cubic interpolation manager
+   USE interp_linear                   !  linear interpolation manager
+   USE interp_nearest                  ! nearest interpolation manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_detect             !< detected point to be interpolated
+   PUBLIC :: interp_fill_value         !< interpolate value
+   PUBLIC :: interp_create_mixed_grid  !< create mixed grid
+   PUBLIC :: interp_clean_mixed_grid   !< clean mixed grid
+
+   PRIVATE :: interp__detect              ! detected point to be interpolated
+   PRIVATE :: interp__detect_wrapper      ! detected point to be interpolated
+   PRIVATE :: interp__fill_value_wrapper  ! interpolate value over detectected point
+   PRIVATE :: interp__fill_value          ! interpolate value over detectected point
+   PRIVATE :: interp__clean_even_grid     ! clean even mixed grid
+   PRIVATE :: interp__check_method        ! check if interpolation method available
+   
+   TYPE TINTERP
+      CHARACTER(LEN=lc) :: c_name   = '' !< interpolation method name
+      CHARACTER(LEN=lc) :: c_factor = '' !< interpolation factor
+      CHARACTER(LEN=lc) :: c_divisor= '' !< interpolation divisor
+   END TYPE TINTERP
+
+   INTERFACE interp_detect
+      MODULE PROCEDURE interp__detect_wrapper 
+   END INTERFACE interp_detect
+
+   INTERFACE interp_fill_value
+      MODULE PROCEDURE interp__fill_value_wrapper 
+   END INTERFACE interp_fill_value
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if interpolation method is available.
+   !> 
+   !> @details 
+   !> check if name of interpolation method is present in global list of string
+   !> character cp_interp_list (see global.f90).
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_method interpolation method
+   !> @return 
+   !-------------------------------------------------------------------
+   FUNCTION interp__check_method( cd_method )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=lc) :: cd_method
+
+      ! function
+      LOGICAL :: interp__check_method
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_interp
+      CHARACTER(LEN=lc) :: cl_method
+
+      ! loop indices
+      INTEGER(I4) :: ji
+      !----------------------------------------------------------------
+
+      cl_method=fct_lower(cd_method)
+
+      interp__check_method=.FALSE.
+      DO ji=1,ip_ninterp
+         cl_interp=fct_lower(cp_interp_list(ji))
+         IF( TRIM(cl_interp) == TRIM(cl_method) )THEN
+            interp__check_method=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION interp__check_method
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function detected point to be interpolated.
+   !> 
+   !> @details 
+   !> Actually it checks, the number of dimension used for this variable
+   !> and launch interp__detect which detected point to be interpolated.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_mix mixed grid variable (to interpolate)
+   !> @param[in] id_rho array of refinement factor
+   !> @return 3D array of detected point to be interpolated 
+   !-------------------------------------------------------------------
+   FUNCTION interp__detect_wrapper( td_mix, id_rho )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_mix
+      INTEGER(I4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+
+      ! function
+      INTEGER(i4), DIMENSION(td_mix%t_dim(1)%i_len,&
+      &                      td_mix%t_dim(2)%i_len,&
+      &                      td_mix%t_dim(3)%i_len ) :: interp__detect_wrapper
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( .NOT. ANY(td_mix%t_dim(1:3)%l_use) )THEN
+         ! no dimension I-J-K used
+         CALL logger_debug(" INTERP DETECT: nothing done for variable"//&
+         &              TRIM(td_mix%c_name) )
+         
+         interp__detect_wrapper(:,:,:)=0
+
+      ELSE IF( ALL(td_mix%t_dim(1:3)%l_use) )THEN
+         
+         ! detect point to be interpolated on I-J-K
+         CALL logger_debug(" INTERP DETECT: detect point "//&
+         &              TRIM(td_mix%c_point)//" for variable "//&
+         &              TRIM(td_mix%c_name) )
+         
+         interp__detect_wrapper(:,:,:)=interp__detect( td_mix, id_rho(:) )
+
+      ELSE IF( ALL(td_mix%t_dim(1:2)%l_use) )THEN
+
+         ! detect point to be interpolated on I-J
+         CALL logger_debug(" INTERP DETECT: detect point "//&
+         &              TRIM(td_mix%c_point)//" for variable "//&
+         &              TRIM(td_mix%c_name) )
+         
+         interp__detect_wrapper(:,:,1:1)=interp__detect( td_mix, id_rho(:))
+
+      ELSE IF( td_mix%t_dim(3)%l_use )THEN
+         
+         ! detect point to be interpolated on K
+         CALL logger_debug(" INTERP DETECT: detect vertical point "//&
+         &              " for variable "//TRIM(td_mix%c_name) )
+         
+         interp__detect_wrapper(1:1,1:1,:)=interp__detect( td_mix, id_rho(:) )
+
+      ENDIF              
+
+   END FUNCTION interp__detect_wrapper
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function detected point to be interpolated.
+   !> 
+   !> @details 
+   !> A special case is done for even refinement on ARAKAWA-C grid.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_mix mixed grid variable (to interpolate)
+   !> @param[in] id_rho array of refinement factor
+   !> @return 3D array of detected point to be interpolated 
+   !-------------------------------------------------------------------
+   FUNCTION interp__detect( td_mix, id_rho )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_mix
+      INTEGER(I4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+
+      ! function
+      INTEGER(i4), DIMENSION(td_mix%t_dim(1)%i_len,&
+      &                      td_mix%t_dim(2)%i_len,&
+      &                      td_mix%t_dim(3)%i_len ) :: interp__detect
+
+      ! local variable
+      INTEGER(I4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(I4) :: il_xextra
+      INTEGER(I4) :: il_yextra
+      INTEGER(I4) :: il_zextra
+
+      INTEGER(i4), DIMENSION(3) :: il_dim
+
+      LOGICAL    , DIMENSION(3) :: ll_even
+
+      ! loop indices
+      INTEGER(I4) :: ji
+      INTEGER(I4) :: jj
+      INTEGER(I4) :: jk
+      !----------------------------------------------------------------
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(il_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(il_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(il_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(td_mix%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      IF( ll_even(1) ) il_rho(jp_I)=il_rho(jp_I)+1
+      IF( ll_even(2) ) il_rho(jp_J)=il_rho(jp_J)+1
+      IF( ll_even(3) ) il_rho(jp_K)=il_rho(jp_K)+1
+
+      ! special case for cubic interpolation
+      il_xextra=0
+      il_yextra=0
+      il_zextra=0
+      SELECT CASE(TRIM(td_mix%c_interp(1)))
+      CASE('cubic')
+         ! those points can not be compute cause cubic interpolation
+         ! need second derivative.
+         IF( il_rho(jp_I) /= 1 ) il_xextra=3*il_rho(jp_I)
+         IF( il_rho(jp_J) /= 1 ) il_yextra=3*il_rho(jp_J)
+         IF( il_rho(jp_K) /= 1 ) il_zextra=3*il_rho(jp_K)
+      END SELECT
+
+      il_dim(:)=td_mix%t_dim(1:3)%i_len
+
+      ! init
+      interp__detect(:,:,:)=1
+
+      ! do not compute coarse grid point
+      interp__detect(1:td_mix%t_dim(1)%i_len:il_rho(jp_I), &
+      &              1:td_mix%t_dim(2)%i_len:il_rho(jp_J), &
+      &              1:td_mix%t_dim(3)%i_len:il_rho(jp_K)  ) = 0
+
+      ! do not compute point near fill value
+      DO jk=1,il_dim(3),il_rho(jp_K)
+         DO jj=1,il_dim(2),il_rho(jp_J)
+            DO ji=1,il_dim(1),il_rho(jp_I)
+
+               IF( td_mix%d_value(ji,jj,jk,1) == td_mix%d_fill )THEN
+
+                  ! i-direction
+                  interp__detect(MAX(1,ji-il_xextra):MIN(ji+il_xextra,il_dim(1)),&
+                  &              MAX(1,jj-(il_rho(jp_J)-1)):MIN(jj+(il_rho(jp_J)-1),il_dim(2)),&
+                  &              MAX(1,jk-(il_rho(jp_K)-1)):MIN(jk+(il_rho(jp_K)-1),il_dim(3)) )=0 
+                  ! j-direction
+                  interp__detect(MAX(1,ji-(il_rho(jp_I)-1)):MIN(ji+(il_rho(jp_I)-1),il_dim(1)),&
+                  &              MAX(1,jj-il_yextra):MIN(jj+il_yextra,il_dim(2)),&
+                  &              MAX(1,jk-(il_rho(jp_K)-1)):MIN(jk+(il_rho(jp_K)-1),il_dim(3)) )=0
+                  ! k-direction
+                  interp__detect(MAX(1,ji-(il_rho(jp_I)-1)):MIN(ji+(il_rho(jp_I)-1),il_dim(1)),&
+                  &              MAX(1,jj-(il_rho(jp_J)-1)):MIN(jj+(il_rho(jp_J)-1),il_dim(2)),&
+                  &              MAX(1,jk-il_zextra):MIN(jk+il_zextra,il_dim(3)) )=0         
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_rho )
+
+   END FUNCTION interp__detect
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine create mixed grid.
+   !> 
+   !> @details 
+   !> Created grid is fine resolution grid.
+   !> First and last point are coasre grid point. 
+   !>
+   !> A special case is done for even refinement on ARAKAWA-C grid.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    coarse grid variable (should be extrapolated)
+   !> @param[out] td_mix   mixed grid variable
+   !> @param[in] id_rho    array of refinment factor (default 1) 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_create_mixed_grid( td_var, td_mix, id_rho )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,               INTENT(IN   ) :: td_var 
+      TYPE(TVAR) ,               INTENT(  OUT) :: td_mix 
+      INTEGER(I4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_rho
+
+      ! local variable
+      INTEGER(I4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4) :: il_xextra
+      INTEGER(i4) :: il_yextra
+      INTEGER(i4) :: il_zextra
+
+      LOGICAL, DIMENSION(3) :: ll_even
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(il_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(il_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(il_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(td_var%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      IF( ll_even(1) ) il_rho(jp_I)=il_rho(jp_I)+1
+      IF( ll_even(2) ) il_rho(jp_J)=il_rho(jp_J)+1
+      IF( ll_even(3) ) il_rho(jp_K)=il_rho(jp_K)+1
+
+      ! copy variable
+      td_mix=var_copy(td_var)
+
+      ! compute new dimension length
+      il_xextra=il_rho(jp_I)-1
+      td_mix%t_dim(1)%i_len=td_mix%t_dim(1)%i_len*il_rho(jp_I)-il_xextra
+
+      il_yextra=il_rho(jp_J)-1
+      td_mix%t_dim(2)%i_len=td_mix%t_dim(2)%i_len*il_rho(jp_J)-il_yextra
+
+      il_zextra=il_rho(jp_K)-1
+      td_mix%t_dim(3)%i_len=td_mix%t_dim(3)%i_len*il_rho(jp_K)-il_zextra
+
+      IF( ASSOCIATED(td_mix%d_value) ) DEALLOCATE( td_mix%d_value )
+      ALLOCATE( td_mix%d_value( td_mix%t_dim(1)%i_len, &
+      &                         td_mix%t_dim(2)%i_len, &
+      &                         td_mix%t_dim(3)%i_len, &
+      &                         td_mix%t_dim(4)%i_len) )
+
+      ! initialise to FillValue
+      td_mix%d_value(:,:,:,:)=td_mix%d_fill
+
+      ! quid qd coord ou bathy fourni par user ?? (offset ??)
+      td_mix%d_value(1:td_mix%t_dim(1)%i_len:il_rho(jp_I), &
+      &              1:td_mix%t_dim(2)%i_len:il_rho(jp_J), &
+      &              1:td_mix%t_dim(3)%i_len:il_rho(jp_K), :) = &
+      &     td_var%d_value(:,:,:,:)
+
+      DEALLOCATE(il_rho)
+
+   END SUBROUTINE interp_create_mixed_grid
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine remove points added to mixed grid to compute
+   !> interpolation in the special case of even refinement on ARAKAWA-C grid.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_mix mixed grid variable
+   !> @param[in] id_rho    array of refinment factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp__clean_even_grid( td_mix, id_rho )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,               INTENT(INOUT) :: td_mix 
+      INTEGER(I4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_rho
+
+      ! local variable
+      INTEGER(I4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4) :: il_xextra
+      INTEGER(i4) :: il_yextra
+      INTEGER(i4) :: il_zextra
+
+      LOGICAL, DIMENSION(3) :: ll_even
+
+      LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ll_mask
+
+      REAL(dp), DIMENSION(:)     , ALLOCATABLE :: dl_vect
+
+      TYPE(TVAR) :: tl_mix
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(il_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(il_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(il_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(td_mix%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      ! remove some point only if refinement in some direction is even
+      IF( ANY(ll_even(:)) )THEN
+
+         ! copy variable
+         tl_mix=var_copy(td_mix)
+
+         ALLOCATE( ll_mask( tl_mix%t_dim(1)%i_len, &
+         &                  tl_mix%t_dim(2)%i_len, &
+         &                  tl_mix%t_dim(3)%i_len, &
+         &                  tl_mix%t_dim(4)%i_len) )
+
+         ll_mask(:,:,:,:)=.TRUE.
+
+         IF( tl_mix%t_dim(1)%l_use .AND. ll_even(1) )THEN
+
+            il_rho(jp_I)=il_rho(jp_I)+1
+
+            ! locate wrong point on mixed grid
+            ll_mask(1:td_mix%t_dim(1)%i_len:il_rho(jp_I),:,:,:)=.FALSE.
+
+            ! compute coasre grid dimension length
+            il_xextra=il_rho(jp_I)-1
+            td_mix%t_dim(1)%i_len=(tl_mix%t_dim(1)%i_len+il_xextra)/il_rho(jp_I)
+
+            il_rho(jp_I)=il_rho(jp_I)-1
+            ! compute right fine grid dimension length
+            td_mix%t_dim(1)%i_len=td_mix%t_dim(1)%i_len*il_rho(jp_I)-il_xextra
+
+         ENDIF
+
+         IF( tl_mix%t_dim(2)%l_use .AND. ll_even(2) )THEN
+
+            il_rho(jp_J)=il_rho(jp_J)+1
+
+            ! locate wrong point on mixed grid
+            ll_mask(:,1:tl_mix%t_dim(2)%i_len:il_rho(jp_J),:,:)=.FALSE.
+
+            ! compute coasre grid dimension length
+            il_yextra=il_rho(jp_J)-1
+            td_mix%t_dim(2)%i_len=(tl_mix%t_dim(2)%i_len+il_yextra)/il_rho(jp_J)
+
+            il_rho(jp_J)=il_rho(jp_J)-1
+            ! compute right fine grid dimension length
+            td_mix%t_dim(2)%i_len=td_mix%t_dim(2)%i_len*il_rho(jp_J)-il_yextra
+            
+         ENDIF
+
+         IF( tl_mix%t_dim(3)%l_use .AND. ll_even(3) )THEN
+
+            il_rho(jp_K)=il_rho(jp_K)+1
+
+            ! locate wrong point on mixed grid
+            ll_mask(:,:,1:tl_mix%t_dim(3)%i_len:il_rho(jp_K),:)=.FALSE.
+
+            ! compute coasre grid dimension length
+            il_zextra=il_rho(jp_K)-1
+            td_mix%t_dim(3)%i_len=(tl_mix%t_dim(3)%i_len+il_zextra)/il_rho(jp_K)
+
+            il_rho(jp_K)=il_rho(jp_K)-1
+            ! compute right fine grid dimension length
+            td_mix%t_dim(3)%i_len=td_mix%t_dim(3)%i_len*il_rho(jp_K)-il_zextra
+
+         ENDIF      
+
+         IF( ASSOCIATED(td_mix%d_value) ) DEALLOCATE( td_mix%d_value )
+         ALLOCATE( td_mix%d_value( td_mix%t_dim(1)%i_len, &
+         &                         td_mix%t_dim(2)%i_len, &
+         &                         td_mix%t_dim(3)%i_len, &
+         &                         td_mix%t_dim(4)%i_len) )
+
+         ! initialise to FillValue
+         td_mix%d_value(:,:,:,:)=td_mix%d_fill
+
+         IF( COUNT(ll_mask(:,:,:,:)) /= SIZE(td_mix%d_value(:,:,:,:)) )THEN
+
+            CALL logger_error("INTERP CLEAN EVEN GRID: output value size "//&
+            &  " and mask count differ ")
+
+         ELSE
+
+            ALLOCATE( dl_vect(COUNT(ll_mask(:,:,:,:))) )
+
+            dl_vect(:)= PACK( tl_mix%d_value(:,:,:,:), &
+            &                 MASK=ll_mask(:,:,:,:)     )
+
+            td_mix%d_value(:,:,:,:)=RESHAPE( dl_vect(:), &
+            &                                SHAPE=(/td_mix%t_dim(1)%i_len, &
+            &                                        td_mix%t_dim(2)%i_len, &
+            &                                        td_mix%t_dim(3)%i_len, &
+            &                                        td_mix%t_dim(4)%i_len/) )
+
+            DEALLOCATE( dl_vect )
+
+         ENDIF
+
+         DEALLOCATE( ll_mask )
+
+         ! clean
+         CALL var_clean(tl_mix)
+
+      ENDIF
+
+      ! clean
+      DEALLOCATE(il_rho)
+
+   END SUBROUTINE interp__clean_even_grid
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine remove points added on mixed grid 
+   !> to compute interpolation. And save interpolated value over domain. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use offset to save useful domain
+   !>
+   !> @param[in] td_mix    mixed grid variable structure
+   !> @param[out] td_var   variable structure
+   !> @param[in] id_rho    array of refinement factor (default 1)
+   !> @param[in] id_offset 2D array of offset between fine and coarse grid
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_clean_mixed_grid( td_mix, td_var, &
+   &                                   id_rho, id_offset )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)                 , INTENT(IN   ) :: td_mix
+      TYPE(TVAR)                 , INTENT(  OUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(I4), DIMENSION(2,2), INTENT(IN   ) :: id_offset
+
+      ! local variable
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmax1
+
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+
+      TYPE(TVAR) :: tl_mix
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! copy mixed variable in temporary structure
+      tl_mix=var_copy(td_mix)
+
+      ! remove unusefull points over mixed grid for even refinement
+      CALL interp__clean_even_grid(tl_mix, id_rho(:))
+
+      ! copy cleaned mixed variable
+      td_var=var_copy(tl_mix)
+
+      ! delete array of value
+      CALL var_del_value(td_var)
+
+      ! compute domain indices in i-direction
+      il_imin0=1  ; il_imax0=td_var%t_dim(1)%i_len
+ 
+      IF( td_var%t_dim(1)%l_use )THEN
+         il_imin1=il_imin0+id_offset(Jp_I,1)
+         il_imax1=il_imax0-id_offset(Jp_I,2)
+      ELSE
+
+         il_imin1=il_imin0
+         il_imax1=il_imax0
+
+      ENDIF
+
+      ! compute domain indices in j-direction
+      il_jmin0=1  ; il_jmax0=td_var%t_dim(2)%i_len
+ 
+      IF( td_var%t_dim(2)%l_use )THEN
+         il_jmin1=il_jmin0+id_offset(Jp_J,1)
+         il_jmax1=il_jmax0-id_offset(Jp_J,2)
+      ELSE
+
+         il_jmin1=il_jmin0
+         il_jmax1=il_jmax0
+ 
+      ENDIF
+
+      ! compute new dimension
+      td_var%t_dim(1)%i_len=il_imax1-il_imin1+1
+      td_var%t_dim(2)%i_len=il_jmax1-il_jmin1+1
+ 
+      ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+      &                 td_var%t_dim(2)%i_len, &
+      &                 td_var%t_dim(3)%i_len, &
+      &                 td_var%t_dim(4)%i_len) )
+
+      dl_value( 1:td_var%t_dim(1)%i_len, &
+      &         1:td_var%t_dim(2)%i_len, &
+      &         :,:) = tl_mix%d_value( il_imin1:il_imax1, &
+      &                                il_jmin1:il_jmax1, &
+      &                                     :, : )
+
+      ! add variable value
+      CALL var_add_value(td_var,dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+ 
+      ! clean
+      CALL var_clean(tl_mix)
+
+   END SUBROUTINE interp_clean_mixed_grid
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable value.
+   !> 
+   !> @details 
+   !> Actually it checks, the number of dimension used for this variable
+   !> and launch interp__fill_value.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] id_offset 2D array of offset between fine and coarse grid
+   !-------------------------------------------------------------------
+   SUBROUTINE interp__fill_value_wrapper( td_var, & 
+   &                                      id_rho, &
+   &                                      id_offset )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
+      INTEGER(I4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_method
+      INTEGER(i4)      , DIMENSION(:), ALLOCATABLE :: il_rho
+      INTEGER(i4)      , DIMENSION(2,2)            :: il_offset
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+      IF( ANY(il_rho(:) < 0) )THEN
+         CALL logger_error("INTERP FILL VALUE: invalid "//&
+         &  " refinement factor ")
+      ENDIF
+
+      il_offset(:,:)=0
+      IF( PRESENT(id_offset) )THEN
+         IF( ANY(SHAPE(id_offset(:,:)) /= (/2,2/)) )THEN
+            CALL logger_error("INTERP FILL VALUE: invalid array of offset")
+         ELSE
+            il_offset(:,:)=id_offset(:,:)
+         ENDIF
+      ENDIF
+
+      IF( (il_rho(jp_I) /= 1 .AND. td_var%t_dim(1)%l_use) .OR. &
+      &   (il_rho(jp_J) /= 1 .AND. td_var%t_dim(2)%l_use) .OR. &
+      &   (il_rho(jp_K) /= 1 .AND. td_var%t_dim(3)%l_use) )THEN
+
+         SELECT CASE(TRIM(td_var%c_interp(1)))
+            CASE('cubic','linear','nearest')
+               cl_method=TRIM(td_var%c_interp(1))
+            CASE DEFAULT
+               CALL logger_warn("INTERP FILL VALUE: interpolation method unknown."//&
+               &  " use linear interpolation")
+               cl_method='linear'
+               ! update variable structure value
+               td_var%c_interp(1)='linear'
+         END SELECT
+
+         CALL logger_info("INTERP FILL: interpolate "//TRIM(td_var%c_name)//&
+         &             " using "//TRIM(cl_method)//" method." )
+         CALL logger_info("INTERP FILL: refinement factor "//&
+         &                        TRIM(fct_str(il_rho(jp_I)))//&
+         &                   " "//TRIM(fct_str(il_rho(jp_J)))//&
+         &                   " "//TRIM(fct_str(il_rho(jp_K))) )
+ 
+         CALL interp__fill_value( td_var, cl_method, & 
+         &                        il_rho(:), il_offset(:,:) )
+
+         SELECT CASE(TRIM(td_var%c_interp(2)))
+         CASE('/rhoi')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) / REAL(il_rho(jp_I),dp)
+            END WHERE
+         CASE('/rhoj')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) / REAL(il_rho(jp_J),dp)
+            END WHERE
+         CASE('/rhok')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) / REAL(il_rho(jp_K),dp)
+            END WHERE
+         CASE('*rhoi')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) * REAL(il_rho(jp_I),dp)
+            END WHERE
+         CASE('*rhoj')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) * REAL(il_rho(jp_J),dp)
+            END WHERE
+         CASE('*rhok')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) * REAL(il_rho(jp_K),dp)
+            END WHERE
+         CASE DEFAULT
+            td_var%c_interp(2)=''
+         END SELECT
+
+      ELSE
+         td_var%c_interp(:)=''
+      ENDIF
+
+      DEALLOCATE(il_rho)
+
+   END SUBROUTINE interp__fill_value_wrapper
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate value over mixed grid.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use interpolation method modules
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] cd_method interpolation method 
+   !> @param[in] id_rho    array of refinment factor 
+   !> @param[in] id_offset 2D array of offset between fine and coarse grid
+   !-------------------------------------------------------------------
+   SUBROUTINE interp__fill_value( td_var, cd_method, &
+   &                              id_rho, id_offset )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)                      , INTENT(INOUT) :: td_var 
+      CHARACTER(LEN=*)                , INTENT(IN   ) :: cd_method
+      INTEGER(I4)     , DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(I4)     , DIMENSION(2,2), INTENT(IN   ) :: id_offset
+
+      ! local variable
+      CHARACTER(LEN=lc)                                :: cl_interp
+
+      INTEGER(I4)    , DIMENSION(:)      , ALLOCATABLE :: il_rho
+      INTEGER(i4)    , DIMENSION(:,:,:)  , ALLOCATABLE :: il_detect
+ 
+      REAL(dp)                                         :: dl_min
+      REAL(dp)                                         :: dl_max
+
+      LOGICAL        , DIMENSION(3)                    :: ll_even
+      LOGICAL                                          :: ll_discont
+ 
+      TYPE(TVAR)                                       :: tl_mix
+
+      TYPE(TATT)                                       :: tl_att
+ 
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !1- create mixed grid
+      CALL interp_create_mixed_grid( td_var, tl_mix, id_rho(:) )
+
+      ! clean variable structure
+      CALL var_clean(td_var)
+
+      !2- detect point to be interpolated
+      ALLOCATE( il_detect( tl_mix%t_dim(1)%i_len, &
+      &                    tl_mix%t_dim(2)%i_len, &
+      &                    tl_mix%t_dim(3)%i_len) )
+
+      il_detect(:,:,:)=0
+
+      il_detect(:,:,:)=interp_detect(tl_mix, id_rho(:) )
+
+      ! add attribute to variable
+      cl_interp=fct_concat(tl_mix%c_interp(:))
+      tl_att=att_init('interpolation',cl_interp)
+      CALL var_move_att(tl_mix, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(id_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(id_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(id_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(tl_mix%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=id_rho(:)
+
+      IF( ll_even(1) ) il_rho(jp_I)=id_rho(jp_I)+1
+      IF( ll_even(2) ) il_rho(jp_J)=id_rho(jp_J)+1
+      IF( ll_even(3) ) il_rho(jp_K)=id_rho(jp_K)+1
+
+      ! special case for longitude
+      ll_discont=.FALSE.
+      IF( TRIM(tl_mix%c_units) == 'degrees_east' )THEN
+         dl_min=MINVAL( tl_mix%d_value(:,:,:,:), &
+         &              tl_mix%d_value(:,:,:,:)/=tl_mix%d_fill)
+         dl_max=MAXVAL( tl_mix%d_value(:,:,:,:), &
+         &              tl_mix%d_value(:,:,:,:)/=tl_mix%d_fill)         
+         IF( dl_min < -170_dp .AND. dl_max > 170_dp .OR. &
+         &   dl_min <   10_dp .AND. dl_max > 350_dp )THEN
+            ll_discont=.TRUE.
+         ENDIF
+      ENDIF
+
+      !3- interpolate
+      CALL logger_debug("INTERP 2D: interpolation method "//TRIM(cd_method)//&
+      &  " discont "//TRIM(fct_str(ll_discont)) )
+      SELECT CASE(TRIM(cd_method))
+      CASE('cubic')
+         CALL interp_cubic_fill(tl_mix%d_value(:,:,:,:), tl_mix%d_fill, &
+           &                    il_detect(:,:,:),                        &
+           &                    il_rho(:), ll_even(:), ll_discont )
+      CASE('nearest')
+         CALL interp_nearest_fill(tl_mix%d_value(:,:,:,:), &
+              &                   il_detect(:,:,:),         &
+              &                   il_rho(:) )
+      CASE DEFAULT ! linear
+         CALL interp_linear_fill(tl_mix%d_value(:,:,:,:), tl_mix%d_fill, &
+              &                  il_detect(:,:,:),                        &
+              &                  il_rho(:), ll_even(:), ll_discont )
+      END SELECT         
+
+      IF( ANY(il_detect(:,:,:)==1) )THEN
+         CALL logger_warn("INTERP FILL: some points can not be interpolated "//&
+         &             "for variable "//TRIM(tl_mix%c_name) )
+      ENDIF
+
+      DEALLOCATE(il_detect)
+
+      !4- save useful domain (remove offset)
+      CALL interp_clean_mixed_grid( tl_mix, td_var, &
+      &                             id_rho(:), id_offset(:,:)  )  
+
+      ! clean variable structure
+      DEALLOCATE(il_rho)
+      CALL var_clean(tl_mix)
+
+   END SUBROUTINE interp__fill_value
+END MODULE interp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90	(revision 8732)
@@ -0,0 +1,795 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: interp
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage cubic interpolation on regular grid.
+!>
+!>
+!> @details
+!> to compute cubic interpolation:<br/>
+!> @code
+!> CALL interp_cubic_fill(dd_value, dd_fill, id_detect, id_rho, ld_even [,ld_discont] )
+!> @endcode
+!>    - dd_value is 2D array of variable value 
+!>    - dd_fill is the FillValue of variable
+!>    - id_detect is 2D array of point to be interpolated (see interp module) 
+!>    - id_rho  is array of refinment factor
+!>    - ld_even indicates even refinment or not 
+!>    - ld_discont indicates longitudinal discontinuity (-180°/180°, 0°/360°) or not
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date September, 2014 -Initial version
+!> @date June, 2015
+!> - use math module
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp_cubic
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE math                            ! mathematical function
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_cubic_fill  !< compute interpolation using cubic method
+
+   PRIVATE :: interp_cubic__2D           !< compute bicubic interpolation on 2D gid
+   PRIVATE :: interp_cubic__1D           !< compute   cubic interpolation on 1D gid
+   PRIVATE :: interp_cubic__2D_coef      !< compute coefficient for bicubic interpolation
+   PRIVATE :: interp_cubic__2D_fill      !< fill value using bicubic interpolation
+   PRIVATE :: interp_cubic__1D_coef      !< compute coefficient for   cubic interpolation
+   PRIVATE :: interp_cubic__1D_fill      !< fill value using   cubic interpolation
+   PRIVATE :: interp_cubic__get_weight2D !< compute interpoaltion weight for 2D array 
+   PRIVATE :: interp_cubic__get_weight1D !< compute interpoaltion weight for 1D array
+
+CONTAINS   
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute horizontal cubic interpolation on 4D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 
+   !> - reinitialise detect array for each level
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rho       array of refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic_fill(dd_value, dd_fill, id_detect, &
+   &                            id_rho, ld_even, ld_discont )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                            , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      INTEGER(I4)     , DIMENSION(:)      , INTENT(IN   ) :: id_rho
+      LOGICAL         , DIMENSION(:)      , INTENT(IN   ) :: ld_even
+      LOGICAL                             , INTENT(IN   ), OPTIONAL :: ld_discont
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      LOGICAL                                    :: ll_discont
+
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ! compute vect2D
+      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      CALL interp_cubic__get_weight2D(dl_weight_IJ(:,:), &
+      &                               id_rho(:), ld_even(:))
+
+      ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) )
+      CALL interp_cubic__get_weight1D(dl_weight_I(:,:), &
+      &                               id_rho(jp_I), ld_even(jp_I))
+      CALL interp_cubic__get_weight1D(dl_weight_J(:,:), &
+      &                               id_rho(jp_J), ld_even(jp_J))
+
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+
+      DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
+         ! loop on vertical level
+         DO jk=1,il_shape(3)
+
+            ! I-J plan
+            CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, &
+            &                     il_detect(:,:,jk),            &
+            &                     dl_weight_IJ(:,:),            &
+            &                     id_rho(jp_I), id_rho(jp_J),   &
+            &                     ll_discont)            
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
+               ! I direction
+               DO jj=1,il_shape(2)
+                  CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, &
+                  &                      il_detect(:,jj,jk),            &
+                  &                      dl_weight_I(:,:),              &
+                  &                      id_rho(jp_I), ll_discont )
+               ENDDO
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
+                  CYCLE
+               ELSE
+                  ! J direction
+                  DO ji=1,il_shape(1)
+                     CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, &
+                     &                      il_detect(ji,:,jk),            &
+                     &                      dl_weight_J(:,:),              &
+                     &                      id_rho(jp_J), ll_discont )
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
+      DEALLOCATE(dl_weight_IJ)
+      DEALLOCATE(dl_weight_I)
+      DEALLOCATE(dl_weight_J)
+
+   END SUBROUTINE interp_cubic_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation on 2D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor in i-direction
+   !> @param[in] id_rhoj      refinment factor in j-direction
+   !> @param[in] id_rhok      refinment factor in k-direction
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic__2D( dd_value,  dd_fill,   &
+      &                         id_detect,            &
+      &                         dd_weight,            &
+      &                         id_rhoi, id_rhoj,     &
+      &                         ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                              :: il_xextra
+      INTEGER(I4)                              :: il_yextra
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(2)                :: il_dim
+
+      REAL(dp)                                 :: dl_min 
+      REAL(dp)                                 :: dl_max 
+      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_tmp
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dfdx
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dfdy
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_d2fdxy
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:,:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         il_yextra=id_rhoj-1
+         il_dim(2)=(il_shape(2)+il_yextra)/id_rhoj
+
+         ALLOCATE( dl_coarse(il_dim(1),il_dim(2)) )
+
+         ! value on coarse grid
+         dl_coarse(:,:)=dd_value( 1:il_shape(1):id_rhoi, &
+         &                        1:il_shape(2):id_rhoj )
+
+         ALLOCATE( dl_dfdx(  il_dim(1),il_dim(2)), &
+         &         dl_dfdy(  il_dim(1),il_dim(2)), &
+         &         dl_d2fdxy(il_dim(1),il_dim(2)) )
+
+         ! compute derivative on coarse grid
+         dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
+         dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
+
+         ! compute cross derivative on coarse grid
+         dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
+
+         ALLOCATE( dl_tmp(2,2) )
+         ALLOCATE( dl_coef(16) )
+
+         DO jj=1,il_shape(2)-1,id_rhoj
+            ij=((jj-1)/id_rhoj)+1
+            DO ji=1,il_shape(1)-1,id_rhoi
+               ii=((ji-1)/id_rhoi)+1
+         
+               ! check if point to be interpolated
+               IF( ALL(id_detect(ji:ji+id_rhoi,   &
+               &                 jj:jj+id_rhoj)==0) ) CYCLE
+               ! check data needed to interpolate
+               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) .OR. &
+               &   ANY(  dl_dfdx(ii:ii+1,ij:ij+1)==dd_fill) .OR. &
+               &   ANY(  dl_dfdy(ii:ii+1,ij:ij+1)==dd_fill) .OR. &
+               &   ANY(dl_d2fdxy(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
+
+               dl_tmp(:,:)=dl_coarse(ii:ii+1,ij:ij+1)
+               ! check longitude discontinuity
+               IF( ld_discont )THEN
+
+                  dl_min=MINVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  dl_max=MAXVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                     WHERE( dl_tmp(:,:) < 0_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)+360._dp
+                     END WHERE
+                  ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                     WHERE( dl_tmp(:,:) > 180_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)-180._dp
+                     END WHERE
+                  ENDIF
+
+               ENDIF
+
+               ! compute bicubic coefficient
+               dl_coef(:)=interp_cubic__2D_coef(dl_tmp(:,:),&
+               &                                dl_dfdx(  ii:ii+1,ij:ij+1),&
+               &                                dl_dfdy(  ii:ii+1,ij:ij+1),&
+               &                                dl_d2fdxy(ii:ii+1,ij:ij+1),&
+               &                                dd_fill )
+
+               ! compute value on detetected point
+               CALL interp_cubic__2D_fill(dd_value( ji:ji+id_rhoi,   &
+               &                                    jj:jj+id_rhoj ), &
+               &                          id_detect(ji:ji+id_rhoi,   &
+               &                                    jj:jj+id_rhoj ), &
+               &                          dd_weight(:,:), dl_coef(:),&
+               &                          dd_fill, id_rhoi, id_rhoj )
+
+               IF( ld_discont )THEN
+                  WHERE( dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) >= 180._dp .AND. &
+                     &   dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) /= dd_fill )
+                     dd_value( ji:ji+id_rhoi, &
+                     &         jj:jj+id_rhoj ) = &
+                     &           dd_value( ji:ji+id_rhoi, &
+                     &                     jj:jj+id_rhoj ) - 360._dp
+                  END WHERE
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE(dl_dfdx, &
+         &          dl_dfdy, &
+         &          dl_d2fdxy )
+
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_cubic__2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation on 1D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 1D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic__1D( dd_value,  dd_fill,   &
+      &                         id_detect,            &
+      &                         dd_weight,            &
+      &                         id_rhoi,              &
+      &                         ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                            :: il_xextra
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+      INTEGER(i4), DIMENSION(1)              :: il_dim
+
+      REAL(dp)                               :: dl_min 
+      REAL(dp)                               :: dl_max 
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_tmp
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_dfdx
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         ALLOCATE( dl_coarse(il_dim(1)) )
+
+         ! value on coarse grid
+         dl_coarse(:)=dd_value( 1:il_shape(1):id_rhoi )
+
+         ALLOCATE( dl_dfdx(il_dim(1)) )
+
+         ! compute derivative on coarse grid
+         dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
+
+         ALLOCATE( dl_tmp(2) )
+         ALLOCATE( dl_coef(4) )
+
+         DO ji=1,il_shape(1)-1,id_rhoi
+            ii=((ji-1)/id_rhoi)+1
+         
+            ! check if point to be interpolated
+            IF( ALL(id_detect(ji:ji+id_rhoi)==0) ) CYCLE
+            ! check data needed to interpolate
+            IF( ANY(dl_coarse(ii:ii+1)==dd_fill) .OR. &
+            &   ANY(  dl_dfdx(ii:ii+1)==dd_fill) ) CYCLE
+            ! check longitude discontinuity
+            dl_tmp(:)=dl_coarse(ii:ii+1)
+            IF( ld_discont )THEN
+
+               dl_min=MINVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               dl_max=MAXVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_tmp(:) < 0_dp ) 
+                     dl_tmp(:) = dl_tmp(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_tmp(:) > 180_dp ) 
+                     dl_tmp(:) = dl_tmp(:)-180._dp
+                  END WHERE
+               ENDIF
+
+            ENDIF
+
+            ! compute bicubic coefficient
+            dl_coef(:)=interp_cubic__1D_coef(dl_tmp(:),       &
+            &                                dl_dfdx(ii:ii+1),&
+            &                                dd_fill )
+
+            ! compute value on detetected point
+            CALL interp_cubic__1D_fill( dd_value( ji:ji+id_rhoi ), &
+            &                           id_detect(ji:ji+id_rhoi ), &
+            &                           dd_weight(:,:), dl_coef(:),  &
+            &                           dd_fill, id_rhoi )
+
+            IF( ld_discont )THEN
+               WHERE( dd_value( ji:ji+id_rhoi ) >= 180._dp .AND. &
+                  &   dd_value( ji:ji+id_rhoi ) /= dd_fill )
+                  dd_value(ji:ji+id_rhoi) = dd_value(ji:ji+id_rhoi) - 360._dp
+               END WHERE
+            ENDIF
+
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE(dl_dfdx )
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_cubic__1D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 2D array of coefficient for cubic interpolation.
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  2D array of value
+   !> @param[in] dd_dfdx   2D array of first derivative in i-direction 
+   !> @param[in] dd_dfdy   2D array of first derivative in j-direction
+   !> @param[in] dd_d2fdxy 2D array of cross derivative in i-j-direction
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+   FUNCTION interp_cubic__2D_coef( dd_value, &
+      &                            dd_dfdx,  &
+      &                            dd_dfdy,  &
+      &                            dd_d2fdxy,&
+      &                            dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_value 
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_dfdx  
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_dfdy  
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_d2fdxy
+      REAL(dp)                , INTENT(IN) :: dd_fill
+
+      ! function
+      REAL(dp), DIMENSION(16) :: interp_cubic__2D_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(16,16), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/ 1 , 0 ,-3 , 2 , 0 , 0 , 0 , 0 ,-3 , 0 , 9 ,-6 , 2 , 0 ,-6 , 4 ,& 
+           0 , 0 , 3 ,-2 , 0 , 0 , 0 , 0 , 0 , 0 ,-9 , 6 , 0 , 0 , 6 ,-4 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 0 ,-9 , 6 ,-2 , 0 , 6 ,-4 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 9 ,-6 , 0 , 0 ,-6 , 4 ,& 
+           0 , 1 ,-2 , 1 , 0 , 0 , 0 , 0 , 0 ,-3 , 6 ,-3 , 0 , 2 ,-4 , 2 ,& 
+           0 , 0 ,-1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 3 ,-3 , 0 , 0 ,-2 , 2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 ,-6 , 3 , 0 ,-2 , 4 ,-2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-3 , 3 , 0 , 0 , 2 ,-2 ,& 
+           0 , 0 , 0 , 0 , 1 , 0 ,-3 , 2 ,-2 , 0 , 6 ,-4 , 1 , 0 ,-3 , 2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 3 ,-2 , 0 , 0 ,-6 , 4 , 0 , 0 , 3 ,-2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-1 , 0 , 3 ,-2 , 1 , 0 ,-3 , 2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-3 , 2 , 0 , 0 , 3 ,-2 ,& 
+           0 , 0 , 0 , 0 , 0 , 1 ,-2 , 1 , 0 ,-2 , 4 ,-2 , 0 , 1 ,-2 , 1 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 ,-1 , 1 , 0 , 0 , 2 ,-2 , 0 , 0 ,-1 , 1 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-1 , 2 ,-1 , 0 , 1 ,-2 , 1 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1 ,-1 , 0 , 0 ,-1 , 1 /), &
+      & (/ 16, 16 /) )
+
+      REAL(dp), DIMENSION(16) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      interp_cubic__2D_coef(:)=dd_fill
+
+      dl_vect( 1: 4)=PACK(dd_value(:,:),.TRUE. )
+      dl_vect( 5: 8)=PACK(dd_dfdx(:,:),.TRUE. )
+      dl_vect( 9:12)=PACK(dd_dfdy(:,:),.TRUE. )
+      dl_vect(13:16)=PACK(dd_d2fdxy(:,:),.TRUE. )
+
+      interp_cubic__2D_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_cubic__2D_coef
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation of a 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of mixed grid value
+   !> @param[inout] id_detect 2D array of point to be interpolated
+   !> @param[in] dd_coef      2D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rhoi      refinement factor in i-direction 
+   !> @param[in] id_rhoj      refinement factor in j-direction
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic__2D_fill( dd_value, id_detect, &
+   &                                 dd_weight, dd_coef,  &
+   &                                 dd_fill, id_rhoi, id_rhoj )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoj
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ii
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP CUBIC FILL: fill value detected in coef . "//&
+         &              "can not compute interpolation.")
+      ELSE
+
+         ii=0
+         DO jj=1,id_rhoj+1
+            DO ji=1,id_rhoi+1
+              
+               ii=ii+1
+               IF(id_detect(ji,jj)==1)THEN
+                  
+                  dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
+                  id_detect(ji,jj)=0
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_cubic__2D_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 1D array of coefficient for cubic interpolation. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  1D array of value
+   !> @param[in] dd_dfdx   1D array of first derivative 
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+   FUNCTION interp_cubic__1D_coef( dd_value, &
+      &                            dd_dfdx,  &
+      &                            dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_value 
+      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_dfdx  
+      REAL(dp)                , INTENT(IN) :: dd_fill  
+
+      ! function
+      REAL(dp), DIMENSION(4) :: interp_cubic__1D_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(4,4), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/  1 ,-1 ,-3 , 2 ,& 
+            0 , 1 , 3 ,-2 ,& 
+            0 , 0 ,-2 , 1 ,& 
+            0 , 0 ,-1 , 1  /), &
+      & (/ 4, 4 /) )      
+
+      REAL(dp), DIMENSION(4) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      interp_cubic__1D_coef(:)=dd_fill
+
+      dl_vect( 1: 2)=PACK(dd_value(:),.TRUE. )
+      dl_vect( 3: 4)=PACK(dd_dfdx(:),.TRUE. )
+
+      interp_cubic__1D_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_cubic__1D_coef
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation of a 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of mixed grid value
+   !> @param[inout] id_detect 1D array of point to be interpolated
+   !> @param[in] dd_coef      1D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rho       refinement factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic__1D_fill( dd_value, id_detect, &
+   &                                 dd_weight, dd_coef,  &
+   &                                 dd_fill, id_rhoi )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
+      REAL(dp)        , DIMENSION(4)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP CUBIC FILL: fill value detected. "//&
+         &              "can not compute interpolation")
+      ELSE
+
+         DO ji=1,id_rhoi+1
+            
+            IF(id_detect(ji)==1)THEN
+
+               dd_value(ji)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ji))
+               id_detect(ji)=0
+
+            ENDIF
+
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_cubic__1D_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 2D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 2D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic__get_weight2D(dd_weight, &
+   &                                     id_rho, ld_even)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      LOGICAL    , DIMENSION(:)  , INTENT(IN   ) :: ld_even
+
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+      REAL(dp)                  :: dl_x2
+      REAL(dp)                  :: dl_x3
+      REAL(dp)                  :: dl_dy
+      REAL(dp)                  :: dl_y      
+      REAL(dp)                  :: dl_y2
+      REAL(dp)                  :: dl_y3
+      
+      ! loop indices
+      INTEGER(i4) :: ii 
+
+      INTEGER(i4) :: ji 
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      
+      IF( ld_even(jp_I) )THEN
+         dl_dx=1./REAL(id_rho(jp_I)-1)
+      ELSE ! odd refinement
+         dl_dx=1./REAL(id_rho(jp_I))
+      ENDIF
+
+      IF( ld_even(jp_J) )THEN
+         dl_dy=1./REAL(id_rho(jp_J)-1)
+      ELSE ! odd refinement
+         dl_dy=1./REAL(id_rho(jp_J))
+      ENDIF
+
+      ii=0
+      DO jj=1,id_rho(jp_J)+1
+
+         IF( ld_even(jp_J) )THEN
+            dl_y=(jj-1)*dl_dy - dl_dy*0.5 
+         ELSE ! odd refinement
+            dl_y=(jj-1)*dl_dy 
+         ENDIF
+         dl_y2=dl_y*dl_y
+         dl_y3=dl_y2*dl_y
+
+         DO ji=1,id_rho(jp_I)+1
+
+            ! iter
+            ii=ii+1
+
+            IF( ld_even(jp_I) )THEN
+               dl_x=(ji-1)*dl_dx - dl_dx*0.5 
+            ELSE ! odd refinement
+               dl_x=(ji-1)*dl_dx 
+            ENDIF
+            dl_x2=dl_x*dl_x
+            dl_x3=dl_x2*dl_x
+
+            dd_weight(:,ii)=(/1._dp, dl_x      , dl_x2      , dl_x3      , &
+            &                 dl_y , dl_x*dl_y , dl_x2*dl_y , dl_x3*dl_y , &
+            &                 dl_y2, dl_x*dl_y2, dl_x2*dl_y2, dl_x3*dl_y2, &
+            &                 dl_y3, dl_x*dl_y3, dl_x2*dl_y3, dl_x3*dl_y3 /)
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE interp_cubic__get_weight2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 1D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 1D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_cubic__get_weight1D(dd_weight, &
+   &                                     id_rho, ld_even)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4)                , INTENT(IN   ) :: id_rho
+      LOGICAL                    , INTENT(IN   ) :: ld_even
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+      REAL(dp)                  :: dl_x2
+      REAL(dp)                  :: dl_x3
+      ! loop indices
+      INTEGER(i4) :: ji   
+      !----------------------------------------------------------------
+      
+      IF( ld_even )THEN
+         dl_dx=1./REAL(id_rho-1)
+      ELSE ! odd refinement
+         dl_dx=1./REAL(id_rho)
+      ENDIF
+
+      DO ji=1,id_rho+1
+         IF( ld_even )THEN
+            dl_x=(ji-1)*dl_dx - dl_dx*0.5 
+         ELSE ! odd refinement
+            dl_x=(ji-1)*dl_dx 
+         ENDIF
+         dl_x2=dl_x*dl_x
+         dl_x3=dl_x2*dl_x
+
+         dd_weight(:,ji)=(/1._dp, dl_x, dl_x2, dl_x3 /)
+      ENDDO
+
+   END SUBROUTINE interp_cubic__get_weight1D
+END MODULE interp_cubic
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90	(revision 8732)
@@ -0,0 +1,710 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: interp
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage linear interpolation on regular grid.
+!>
+!> @details
+!> to compute linear interpolation:<br/>
+!> @code
+!> CALL interp_linear_fill(dd_value, dd_fill, id_detect, id_rho, ld_even [,ld_discont] )
+!> @endcode
+!>    - dd_value is 2D array of variable value 
+!>    - dd_fill is the FillValue of variable
+!>    - id_detect is 2D array of point to be interpolated (see interp module) 
+!>    - id_rho  is array of refinment factor
+!>    - ld_even indicates even refinment or not 
+!>    - ld_discont indicates longitudinal discontinuity (-180°/180°, 0°/360°) or not
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date September, 2014 - Initial version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+
+MODULE interp_linear
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE extrap                          ! extrapolation manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_linear_fill  !< compute interpolation using linear method
+
+   PRIVATE :: interp_linear__2D           !< compute bilinear interpolation on 2D gid
+   PRIVATE :: interp_linear__1D           !< compute   linear interpolation on 1D gid
+   PRIVATE :: interp_linear__2D_coef      !< compute coefficient for bilinear interpolation
+   PRIVATE :: interp_linear__2D_fill      !< fill value using bilinear interpolation
+   PRIVATE :: interp_linear__1D_coef      !< compute coefficient for   linear interpolation
+   PRIVATE :: interp_linear__1D_fill      !< fill value using   linear interpolation
+   PRIVATE :: interp_linear__get_weight2D !< compute interpoaltion weight for 2D array.
+   PRIVATE :: interp_linear__get_weight1D !< compute interpoaltion weight for 1D array.
+
+CONTAINS   
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute horizontal linear interpolation on 4D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 - reinitialise detect array for each level
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rho       array of refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear_fill(dd_value, dd_fill, id_detect, &
+   &                             id_rho, ld_even, ld_discont )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                            , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      INTEGER(I4)     , DIMENSION(:)      , INTENT(IN   ) :: id_rho
+      LOGICAL         , DIMENSION(:)      , INTENT(IN   ) :: ld_even
+      LOGICAL                             , INTENT(IN   ), OPTIONAL :: ld_discont
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      LOGICAL                                    :: ll_discont
+ 
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ! compute vect2D
+      ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), &
+      &                               id_rho(:), ld_even(:))
+
+      ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) )
+      CALL interp_linear__get_weight1D(dl_weight_I(:,:), &
+      &                               id_rho(jp_I), ld_even(jp_I))
+      CALL interp_linear__get_weight1D(dl_weight_J(:,:), &
+      &                               id_rho(jp_J), ld_even(jp_J))
+
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+
+      DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
+         ! loop on vertical level
+         DO jk=1,il_shape(3)
+
+            ! I-J plan
+            CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,&
+            &                     il_detect(:,:,jk),            &
+            &                     dl_weight_IJ(:,:),            &
+            &                     id_rho(jp_I), id_rho(jp_J),   &
+            &                     ll_discont)            
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
+               ! I direction
+               DO jj=1,il_shape(2)
+                  CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,&
+                  &                       il_detect(:,jj,jk),           &
+                  &                       dl_weight_I(:,:),             &
+                  &                       id_rho(jp_I), ll_discont )
+               ENDDO
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
+                  CYCLE
+               ELSE
+                  ! J direction
+                  DO ji=1,il_shape(1)
+                     CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,&
+                     &                       il_detect(ji,:,jk),           &
+                     &                       dl_weight_J(:,:),             &
+                     &                       id_rho(jp_J), ll_discont )
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
+      DEALLOCATE(dl_weight_IJ)
+      DEALLOCATE(dl_weight_I)
+      DEALLOCATE(dl_weight_J)
+ 
+   END SUBROUTINE interp_linear_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation on 2D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor in i-direction
+   !> @param[in] id_rhoj      refinment factor in j-direction
+   !> @param[in] id_rhok      refinment factor in k-direction
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear__2D( dd_value,  dd_fill,   &
+      &                          id_detect,            &
+      &                          dd_weight,            &
+      &                          id_rhoi, id_rhoj,     &
+      &                          ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                              :: il_xextra
+      INTEGER(I4)                              :: il_yextra
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(2)                :: il_dim
+
+      REAL(dp)                                 :: dl_min 
+      REAL(dp)                                 :: dl_max 
+      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:,:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         il_yextra=id_rhoj-1
+         il_dim(2)=(il_shape(2)+il_yextra)/id_rhoj
+
+         ALLOCATE( dl_coarse(il_dim(1),il_dim(2)) )
+
+         ! value on coarse grid
+         dl_coarse(:,:)=dd_value( 1:il_shape(1):id_rhoi, &
+         &                        1:il_shape(2):id_rhoj )
+
+         ALLOCATE( dl_tmp(2,2) )
+         ALLOCATE( dl_coef(4) )
+
+         DO jj=1,il_shape(2)-1,id_rhoj
+            ij=((jj-1)/id_rhoj)+1
+            DO ji=1,il_shape(1)-1,id_rhoi
+               ii=((ji-1)/id_rhoi)+1
+         
+               ! check if point to be interpolated
+               IF( ALL(id_detect(ji:ji+id_rhoi,   &
+               &                 jj:jj+id_rhoj)==0) ) CYCLE
+               ! check data needed to interpolate
+               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
+               ! check longitude discontinuity
+               dl_tmp(:,:)=dl_coarse(ii:ii+1,ij:ij+1)
+               IF( ld_discont )THEN
+
+                  dl_min=MINVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  dl_max=MAXVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                     WHERE( dl_tmp(:,:) < 0_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)+360._dp
+                     END WHERE
+                  ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                     WHERE( dl_tmp(:,:) > 180_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)-180._dp
+                     END WHERE
+                  ENDIF
+
+               ENDIF
+
+               ! compute bilinear coefficient
+               dl_coef(:)=interp_linear__2D_coef(dl_tmp(:,:),&
+               &                                 dd_fill )
+
+               ! compute value on detetected point
+               CALL interp_linear__2D_fill(dd_value( ji:ji+id_rhoi,   &
+               &                                     jj:jj+id_rhoj ), &
+               &                           id_detect(ji:ji+id_rhoi,   &
+               &                                     jj:jj+id_rhoj ), &
+               &                           dd_weight(:,:), dl_coef(:),&
+               &                           dd_fill, id_rhoi, id_rhoj )
+
+               IF( ld_discont )THEN
+                  WHERE( dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) >= 180._dp .AND. &
+                     &   dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) /= dd_fill )
+                     dd_value( ji:ji+id_rhoi, &
+                     &         jj:jj+id_rhoj ) = &
+                     &           dd_value( ji:ji+id_rhoi, &
+                     &                     jj:jj+id_rhoj ) - 360._dp
+                  END WHERE
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_linear__2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation on 1D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 1D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear__1D( dd_value,  dd_fill,   &
+      &                          id_detect,            &
+      &                          dd_weight,            &
+      &                          id_rhoi,              &
+      &                          ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                            :: il_xextra
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+      INTEGER(i4), DIMENSION(1)              :: il_dim
+
+      REAL(dp)                               :: dl_min 
+      REAL(dp)                               :: dl_max 
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         ALLOCATE( dl_coarse(il_dim(1)) )
+
+         ! value on coarse grid
+         dl_coarse(:)=dd_value( 1:il_shape(1):id_rhoi )
+
+         ALLOCATE( dl_tmp(2) )
+         ALLOCATE( dl_coef(4) )
+
+         DO ji=1,il_shape(1)-1,id_rhoi
+            ii=((ji-1)/id_rhoi)+1
+         
+            ! check if point to be interpolated
+            IF( ALL(id_detect(ji:ji+id_rhoi)==0) ) CYCLE
+            ! check data needed to interpolate
+            IF( ANY(dl_coarse(ii:ii+1)==dd_fill) ) CYCLE
+            ! check longitude discontinuity
+            dl_tmp(:)=dl_coarse(ii:ii+1)
+            IF( ld_discont )THEN
+
+               dl_min=MINVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               dl_max=MAXVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_tmp(:) < 0_dp ) 
+                     dl_tmp(:) = dl_tmp(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_tmp(:) > 180_dp ) 
+                     dl_tmp(:) = dl_tmp(:)-180._dp
+                  END WHERE
+               ENDIF
+
+            ENDIF
+
+            ! compute bilinear coefficient
+            dl_coef(:)=interp_linear__1D_coef(dl_tmp(:),       &
+            &                                 dd_fill )
+
+            ! compute value on detetected point
+            CALL interp_linear__1D_fill( dd_value( ji:ji+id_rhoi ), &
+            &                            id_detect(ji:ji+id_rhoi ), &
+            &                            dd_weight(:,:), dl_coef(:),&
+            &                            dd_fill, id_rhoi )
+
+            IF( ld_discont )THEN
+               WHERE( dd_value( ji:ji+id_rhoi ) >= 180._dp .AND. &
+                  &   dd_value( ji:ji+id_rhoi ) /= dd_fill )
+                  dd_value(ji:ji+id_rhoi) = dd_value(ji:ji+id_rhoi) - 360._dp
+               END WHERE
+            ENDIF
+
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_linear__1D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 2D array of coefficient for linear interpolation. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  2D array of value
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+   FUNCTION interp_linear__2D_coef( dd_value, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:)  , INTENT(IN) :: dd_value 
+      REAL(dp)                  , INTENT(IN) :: dd_fill 
+
+      ! function
+      REAL(dp), DIMENSION(4) :: interp_linear__2D_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(4,4), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/  1 ,-1 ,-1 , 1 ,& 
+            0 , 1 , 0 ,-1 ,& 
+            0 , 0 , 1 ,-1 ,& 
+            0 , 0 , 0 , 1 /), &
+      & (/ 4, 4 /) )
+
+      REAL(dp), DIMENSION(4) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      interp_linear__2D_coef(:)=dd_fill
+
+      dl_vect( 1: 4)=PACK(dd_value(:,:),.TRUE. )
+      interp_linear__2D_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_linear__2D_coef
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation of a 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of mixed grid value
+   !> @param[inout] id_detect 2D array of point to be interpolated
+   !> @param[in] dd_coef      2D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rhoi      refinement factor in i-direction 
+   !> @param[in] id_rhoj      refinement factor in j-direction
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear__2D_fill( dd_value, id_detect, &
+   &                                  dd_weight, dd_coef,  &
+   &                                  dd_fill, id_rhoi, id_rhoj )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoj
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ii
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//&
+         &              "can not compute interpolation.")
+      ELSE
+
+         ii=0
+         DO jj=1,id_rhoj+1
+            DO ji=1,id_rhoi+1
+
+               ii=ii+1
+               IF(id_detect(ji,jj)==1)THEN
+
+                  dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
+                  id_detect(ji,jj)=0
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_linear__2D_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 1D array of coefficient for linear interpolation. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  1D array of value
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+   FUNCTION interp_linear__1D_coef( dd_value, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_value 
+      REAL(dp)                , INTENT(IN) :: dd_fill  
+
+      ! function
+      REAL(dp), DIMENSION(2) :: interp_linear__1D_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(2,2), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/  1 ,-1 ,& 
+            0 , 1  /), &
+      &  (/ 2, 2 /) )
+
+      REAL(dp), DIMENSION(2) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      interp_linear__1D_coef(:)=dd_fill
+
+      dl_vect( 1: 2)=PACK(dd_value(:),.TRUE. )
+      interp_linear__1D_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_linear__1D_coef
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation of a 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> 
+   !> @param[inout] dd_value  1D array of mixed grid value
+   !> @param[inout] id_detect 1D array of point to be interpolated
+   !> @param[in] dd_coef      1D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rho       refinement factor
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear__1D_fill( dd_value, id_detect, &
+   &                                  dd_weight, dd_coef,  &
+   &                                  dd_fill, id_rho )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rho      
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP LINEAR FILL: fill value detected. "//&
+         &              "can not compute interpolation")
+      ELSE
+
+         DO ji=1,id_rho+1
+            
+            IF(id_detect(ji)==1)THEN
+
+               dd_value(ji)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ji))
+               id_detect(ji)=0
+
+            ENDIF
+
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_linear__1D_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 2D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 2D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear__get_weight2D(dd_weight, &
+   &                                     id_rho, ld_even)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      LOGICAL    , DIMENSION(:)  , INTENT(IN   ) :: ld_even
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+      REAL(dp)                  :: dl_dy
+      REAL(dp)                  :: dl_y      
+      
+      ! loop indices
+      INTEGER(i4) :: ii 
+
+      INTEGER(i4) :: ji 
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      
+      IF( ld_even(jp_I) )THEN
+         dl_dx=1._dp/REAL(id_rho(jp_I)-1,dp)
+      ELSE ! odd refinement
+         dl_dx=1._dp/REAL(id_rho(jp_I),dp)
+      ENDIF
+
+      IF( ld_even(jp_J) )THEN
+         dl_dy=1._dp/REAL(id_rho(jp_J)-1,dp)
+      ELSE ! odd refinement
+         dl_dy=1._dp/REAL(id_rho(jp_J),dp)
+      ENDIF
+
+      ii=0
+      DO jj=1,id_rho(jp_J)+1
+
+         IF( ld_even(jp_J) )THEN
+            dl_y=REAL(jj-1,dp)*dl_dy - dl_dy*0.5_dp
+         ELSE ! odd refinement
+            dl_y=REAL(jj-1,dp)*dl_dy 
+         ENDIF
+
+         DO ji=1,id_rho(jp_I)+1
+
+            ! iter
+            ii=ii+1
+
+            IF( ld_even(jp_I) )THEN
+               dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp 
+            ELSE ! odd refinement
+               dl_x=REAL(ji-1,dp)*dl_dx 
+            ENDIF
+
+            dd_weight(:,ii)=(/1._dp, dl_x, dl_y, dl_x*dl_y /)
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE interp_linear__get_weight2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 1D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 1D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_linear__get_weight1D(dd_weight, &
+   &                                     id_rho, ld_even)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4)                , INTENT(IN   ) :: id_rho
+      LOGICAL                    , INTENT(IN   ) :: ld_even
+
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+
+      ! loop indices
+      INTEGER(i4) :: ji   
+      !----------------------------------------------------------------
+      
+      IF( ld_even )THEN
+         dl_dx=1._dp/REAL(id_rho-1,dp)
+      ELSE ! odd refinement
+         dl_dx=1._dp/REAL(id_rho,dp)
+      ENDIF
+
+      DO ji=1,id_rho+1
+         IF( ld_even )THEN
+            dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp 
+         ELSE ! odd refinement
+            dl_x=REAL(ji-1,dp)*dl_dx 
+         ENDIF
+
+         dd_weight(:,ji)=(/1._dp, dl_x /)
+      ENDDO
+
+   END SUBROUTINE interp_linear__get_weight1D
+END MODULE interp_linear
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90	(revision 8732)
@@ -0,0 +1,360 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: interp
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage nearest interpolation on regular grid.
+!>
+!> @details
+!> to compute nearest interpolation:<br/>
+!> @code
+!> CALL interp_nearest_fill(dd_value, dd_fill, id_detect, id_rho, ld_even [,ld_discont] )
+!> @endcode
+!>    - dd_value is 2D array of variable value 
+!>    - dd_fill is the FillValue of variable
+!>    - id_detect is 2D array of point to be interpolated (see interp module) 
+!>    - id_rho  is array of refinment factor
+!>    - ld_even indicates even refinment or not 
+!>    - ld_discont indicates longitudinal discontinuity (-180°/180°, 0°/360°) or not
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date September, 2014 - Initial version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp_nearest
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_nearest_fill  !< compute interpolation using nearest method
+
+   PRIVATE :: interp_nearest__2D       !< compute binearest interpolation on 2D gid
+   PRIVATE :: interp_nearest__1D       !< compute   nearest interpolation on 1D gid
+   PRIVATE :: interp_nearest__2D_fill  !< fill value using binearest interpolation
+   PRIVATE :: interp_nearest__1D_fill  !< fill value using   nearest interpolation
+
+CONTAINS   
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute horizontal nearest interpolation on 4D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in]    id_rho    array of refinment factor
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_nearest_fill(dd_value, id_detect, id_rho )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(I4)     , DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      INTEGER(I4)     , DIMENSION(:)      , INTENT(IN   ) :: id_rho
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+      DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
+         ! loop on vertical level
+         DO jk=1,il_shape(3)
+
+            ! I-J plan
+            CALL interp_nearest__2D(dd_value(:,:,jk,jl),&
+            &                       il_detect(:,:,jk),  &
+            &                       id_rho(jp_I), id_rho(jp_J) )            
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
+               ! I direction
+               DO jj=1,il_shape(2)
+                  CALL interp_nearest__1D( dd_value(:,jj,jk,jl),&
+                  &                        il_detect(:,jj,jk),  &
+                  &                        id_rho(jp_I) )
+               ENDDO
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
+                  CYCLE
+               ELSE
+                  ! J direction
+                  DO ji=1,il_shape(1)
+                     CALL interp_nearest__1D( dd_value(ji,:,jk,jl),&
+                     &                        il_detect(ji,:,jk),  &
+                     &                        id_rho(jp_J) )
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
+   END SUBROUTINE interp_nearest_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation on 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor in i-direction
+   !> @param[in] id_rhoj      refinment factor in j-direction
+   !> @param[in] id_rhok      refinment factor in k-direction
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_nearest__2D( dd_value, id_detect, &
+      &                           id_rhoi, id_rhoj )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:,:)==1) )THEN
+
+         il_shape(:)=SHAPE(dd_value)
+
+         DO jj=1,il_shape(2)-1,id_rhoj
+            DO ji=1,il_shape(1)-1,id_rhoi
+         
+               ! check if point to be interpolated
+               IF( ALL(id_detect(ji:ji+id_rhoi,   &
+               &                 jj:jj+id_rhoj)==0) ) CYCLE
+
+               ! compute value on detetected point
+               CALL interp_nearest__2D_fill(dd_value( ji:ji+id_rhoi,   &
+               &                                      jj:jj+id_rhoj ), &
+               &                            id_detect(ji:ji+id_rhoi,   &
+               &                                      jj:jj+id_rhoj ) )
+
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_nearest__2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation on 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of variable value 
+   !> @param[inout] id_detect 1D array of point to be interpolated 
+   !> @param[in]    id_rhoi   refinment factor
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_nearest__1D( dd_value,  id_detect, &
+      &                           id_rhoi )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value 
+      INTEGER(I4)     , DIMENSION(:), INTENT(INOUT) :: id_detect
+      INTEGER(I4)                   , INTENT(IN   ) :: id_rhoi
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         DO ji=1,il_shape(1)-1,id_rhoi
+         
+            ! check if point to be interpolated
+            IF( ALL(id_detect(ji:ji+id_rhoi)==0) ) CYCLE
+
+            ! compute value on detetected point
+            CALL interp_nearest__1D_fill( dd_value( ji:ji+id_rhoi ), &
+            &                             id_detect(ji:ji+id_rhoi ) )
+
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_nearest__1D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation of a 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of mixed grid value
+   !> @param[inout] id_detect 2D array of point to be interpolated
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_nearest__2D_fill( dd_value, id_detect )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:)  , INTENT(INOUT) :: dd_value 
+      INTEGER(i4), DIMENSION(:,:)  , INTENT(INOUT) :: id_detect
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2) :: il_shape
+
+      INTEGER(i4) :: il_i1
+      INTEGER(i4) :: il_i2
+      INTEGER(i4) :: il_j1
+      INTEGER(i4) :: il_j2
+
+      INTEGER(i4) :: il_half1
+      INTEGER(i4) :: il_half2
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      il_i1=1
+      il_i2=il_shape(1)
+
+      il_j1=1
+      il_j2=il_shape(2)
+
+      il_half1=CEILING(il_shape(1)*0.5)
+      il_half2=CEILING(il_shape(2)*0.5)
+
+      DO jj=1,il_half2
+
+         DO ji=1,il_half1
+            
+            ! lower left point
+            IF(id_detect(ji,jj)==1)THEN
+
+               dd_value( ji,jj)=dd_value(il_i1,il_j1)
+               id_detect(ji,jj)=0
+
+            ENDIF
+
+            ! lower right point
+            IF(id_detect(il_shape(1)-ji+1,jj)==1)THEN
+
+               dd_value( il_shape(1)-ji+1,jj)=dd_value(il_i2,il_j1)
+               id_detect(il_shape(1)-ji+1,jj)=0
+
+            ENDIF
+
+            ! upper left point
+            IF(id_detect(ji,il_shape(2)-jj+1)==1)THEN
+
+               dd_value( ji,il_shape(2)-jj+1)=dd_value(il_i1,il_j2)
+               id_detect(ji,il_shape(2)-jj+1)=0
+
+            ENDIF            
+
+            ! upper right point
+            IF(id_detect(il_shape(1)-ji+1,il_shape(2)-jj+1)==1)THEN
+
+               dd_value( il_shape(1)-ji+1,il_shape(2)-jj+1)=dd_value(il_i2,il_j2)
+               id_detect(il_shape(1)-ji+1,il_shape(2)-jj+1)=0
+
+            ENDIF            
+
+         ENDDO
+
+      ENDDO
+
+   END SUBROUTINE interp_nearest__2D_fill
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation of a 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of mixed grid value
+   !> @param[inout] id_detect 1D array of point to be interpolated
+   !-------------------------------------------------------------------
+   SUBROUTINE interp_nearest__1D_fill( dd_value, id_detect )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_value 
+      INTEGER(i4), DIMENSION(:), INTENT(INOUT) :: id_detect
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_shape
+
+      INTEGER(i4) :: il_i1
+      INTEGER(i4) :: il_i2
+
+      INTEGER(i4) :: il_half1
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value)
+
+      il_i1=1
+      il_i2=il_shape(1)
+
+      il_half1=CEILING(il_shape(1)*0.5)
+      
+      DO ji=1,il_half1
+         
+         ! lower left point
+         IF(id_detect(ji)==1)THEN
+
+            dd_value( ji)=dd_value(il_i1)
+            id_detect(ji)=0
+
+         ENDIF
+
+         ! lower right point
+         IF(id_detect(il_shape(1)-ji+1)==1)THEN
+
+            dd_value( il_shape(1)-ji+1)=dd_value(il_i2)
+            id_detect(il_shape(1)-ji+1)=0
+
+         ENDIF
+
+      ENDDO
+
+   END SUBROUTINE interp_nearest__1D_fill
+END MODULE interp_nearest
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom.f90	(revision 8732)
@@ -0,0 +1,597 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: iom
+!
+! DESCRIPTION:
+!> @brief Input/Output manager :  Library to read input files
+!>
+!> @details
+!>    to open file:<br/>
+!> @code
+!>    CALL iom_open(td_file)
+!> @endcode
+!>       - td_file is file structure
+!>
+!>    to create file:<br/>
+!> @code
+!>    CALL iom_create(td_file)
+!> @endcode
+!>       - td_file is file structure
+!> 
+!>    to write in file:<br/>
+!> @code
+!>    CALL  iom_write_file(td_file)
+!> @endcode
+!>
+!>    to close file:<br/>
+!> @code
+!>    CALL iom_close(tl_file)
+!> @endcode
+!>
+!>    to read one dimension in file:<br/>
+!> @code
+!>    tl_dim = iom_read_dim(tl_file, id_dimid)
+!> @endcode
+!>    or<br/>
+!> @code
+!>    tl_dim = iom_read_dim(tl_file, cd_name)
+!> @endcode
+!>       - id_dimid is dimension id
+!>       - cd_name is dimension name
+!>
+!>    to read variable or global attribute in file:<br/>
+!> @code
+!>    tl_att = iom_read_att(tl_file, id_varid, id_attid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_read_att(tl_file, id_varid, cd_attname)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_read_att(tl_file, cd_varname, id_attid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_read_att(tl_file, cd_varname, cd_attname)
+!> @endcode
+!>       - id_varid is variable id
+!>       - id_attid is attribute id
+!>       - cd_attname is attribute name
+!>       - cd_varname is variable name or standard name
+!>    
+!>    to read one variable in file:<br/>
+!> @code
+!>    tl_var = iom_read_var(td_file, id_varid, [id_start, id_count])
+!> @endcode
+!>    or
+!> @code
+!>    tl_var = iom_read_var(td_file, cd_name, [id_start, [id_count,]])
+!> @endcode
+!>       - id_varid is variabale id
+!>       - cd_name is variabale name or standard name.
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!>
+!> @todo
+!> - see lbc_lnk
+!> - see goup netcdf4
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom_cdf                         ! netcdf I/O manager
+   USE iom_rstdimg                     ! restart dimg I/O manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_open        !< open or create file, fill file structure
+   PUBLIC :: iom_create      !< create file, fill file structure
+   PUBLIC :: iom_close       !< close file
+   PUBLIC :: iom_read_dim    !< read one dimension in an opened file
+   PUBLIC :: iom_read_att    !< read one attribute in an opened file
+   PUBLIC :: iom_read_var    !< read one variable  in an opened file   
+   PUBLIC :: iom_write_file  !< write file structure contents in an opened file
+
+                                          ! read variable or global attribute in an opened file
+   PRIVATE :: iom__read_att_varname_id   ! given variable name or standard name and attribute id.
+   PRIVATE :: iom__read_att_varid_id     ! given variable id and attribute id.
+   PRIVATE :: iom__read_att_varname_name ! given variable name or standard name, and attribute name.
+   PRIVATE :: iom__read_att_varid_name   ! given variable id and attribute name.
+
+   PRIVATE :: iom__read_dim_id            ! read one dimension in an opened file, given dimension id.
+   PRIVATE :: iom__read_dim_name          ! read one dimension in an opened netcdf file, given dimension name.
+   PRIVATE :: iom__read_var_id            ! read variable value in an opened file, given variable id.
+   PRIVATE :: iom__read_var_name          ! read variable value in an opened file, given variable name or standard name.
+
+   INTERFACE iom_read_var
+      MODULE PROCEDURE iom__read_var_id
+      MODULE PROCEDURE iom__read_var_name
+   END INTERFACE iom_read_var
+
+   INTERFACE iom_read_dim
+      MODULE PROCEDURE iom__read_dim_id
+      MODULE PROCEDURE iom__read_dim_name
+   END INTERFACE iom_read_dim
+
+   INTERFACE iom_read_att    !< read variable or global attribute in an opened file
+      MODULE PROCEDURE iom__read_att_varname_id   !< given variable name or standard name and attribute id.
+      MODULE PROCEDURE iom__read_att_varid_id     !< given variable id and attribute id.
+      MODULE PROCEDURE iom__read_att_varname_name !< given variable name or standard name, and attribute name.
+      MODULE PROCEDURE iom__read_att_varid_name   !< given variable id and attribute name.
+   END INTERFACE iom_read_att
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This function open a file in read or write mode
+   !> @details
+   !> If try to open a file in write mode that did not exist, create it.<br/>
+   !> 
+   !> If file exist, get information about:
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> and finally read dimensions.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_open(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+      !----------------------------------------------------------------
+
+      ! add suffix to file name
+      td_file%c_name = file_add_suffix( TRIM(td_file%c_name), &
+      &                                 TRIM(td_file%c_type)  )
+      ! check type
+      SELECT CASE(TRIM(ADJUSTL(fct_lower(td_file%c_type))))
+
+         CASE('cdf')
+            CALL iom_cdf_open(td_file)
+         CASE('dimg')
+            CALL iom_rstdimg_open(td_file)
+         CASE DEFAULT
+            CALL logger_error("IOM OPEN: unknow type : "//TRIM(td_file%c_name))
+
+      END SELECT
+
+   END SUBROUTINE iom_open
+   !-------------------------------------------------------------------
+   !> @brief This function create a file.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_create(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+
+      ! local variable
+      LOGICAL     :: ll_exist
+      !----------------------------------------------------------------
+
+      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist )
+      IF( ll_exist )THEN
+         CALL logger_fatal("IOM CREATE: can not create file "//&
+         &  TRIM(td_file%c_name)//". file exist already.")
+      ENDIF
+
+      ! forced to open in write mode
+      td_file%l_wrt=.TRUE.
+      ! check type
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_open(td_file)
+         CASE('dimg')
+            CALL iom_rstdimg_open(td_file)
+         CASE DEFAULT
+            CALL logger_error( "IOM CREATE: can't create file "//&
+            &               TRIM(td_file%c_name)//": type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_create
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close file
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_close(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_close(td_file)
+         CASE('dimg')
+            CALL iom_rstdimg_close(td_file)
+         CASE DEFAULT
+            CALL logger_error( "IOM CLOSE: can't close file "//&
+            &               TRIM(td_file%c_name)//": type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_close
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable name or standard name and attribute id.
+   !> @details
+   !>  - to get global attribute use 'GLOBAL' as variable name. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file      file structure
+   !> @param[in] cd_varname   variable name. use 'GLOBAL' to read global 
+   !> attribute in a file
+   !> @param[in] id_attid     attribute id
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION iom__read_att_varname_id( td_file, cd_varname, &
+   &                                             id_attid)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE),       INTENT(IN) :: td_file
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_varname
+      INTEGER(i4),       INTENT(IN) :: id_attid
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      !----------------------------------------------------------------
+
+      ! get variable id
+      IF( TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         il_varid=NF90_GLOBAL
+      ELSE
+         il_varid=var_get_id(td_file%t_var(:), cd_varname)
+      ENDIF
+
+      IF( il_varid /= 0 .OR. TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         ! open file
+         SELECT CASE(TRIM(td_file%c_type))
+            CASE('cdf')
+               iom__read_att_varname_id=iom_read_att( td_file, il_varid, &
+               &                                       id_attid)
+            CASE('dimg')
+               CALL logger_warn( " IOM READ ATT: can't read attribute "//&
+               &              "in dimg file : "//TRIM(td_file%c_name) )
+            CASE DEFAULT
+               CALL logger_error( " IOM READ ATT: can't read attribute "//&
+               &    " in file "//TRIM(td_file%c_name)//" : type unknown " )
+         END SELECT
+      ENDIF
+
+   END FUNCTION iom__read_att_varname_id
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable id and attribute id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global 
+   !> attribute in a file
+   !> @param[in] id_attid  attribute id
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION iom__read_att_varid_id( td_file, id_varid, &
+   &                                            id_attid)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      INTEGER(i4), INTENT(IN) :: id_attid
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            iom__read_att_varid_id=iom_cdf_read_att( td_file, id_varid, &
+            &                                         id_attid)
+         CASE('dimg')
+            CALL logger_warn( " IOM READ ATT: can't read attribute in dimg file "//&
+            &              TRIM(td_file%c_name) )
+         CASE DEFAULT
+            CALL logger_error( " IOM READ ATT: can't read attribute in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_att_varid_id
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable name or standard name, and attribute name.
+   !> @details
+   !> - to get global attribute use 'GLOBAL' as variable name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file      file structure
+   !> @param[in] cd_varname   variable name or standard name. use 'GLOBAL' to read global
+   !> attribute in a file
+   !> @param[in] cd_attname   attribute name
+   !> @return  attribute structure    
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION iom__read_att_varname_name( td_file, cd_varname, &
+   &                                                cd_attname)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_varname
+      CHARACTER(LEN=*), INTENT(IN) :: cd_attname
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      !----------------------------------------------------------------
+
+      ! get variable id
+      IF( TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         il_varid=NF90_GLOBAL
+      ELSE
+         il_varid=var_get_id(td_file%t_var(:), cd_varname)
+      ENDIF
+
+      IF( il_varid /= 0 .OR. TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         ! open file
+         SELECT CASE(TRIM(td_file%c_type))
+            CASE('cdf')
+               iom__read_att_varname_name=iom_cdf_read_att( td_file, il_varid, &
+               &                                             cd_attname)
+            CASE('dimg')
+               CALL logger_warn( " IOM READ ATT: can't read attribute "//&
+               &              "in dimg file :"//TRIM(td_file%c_name) )
+            CASE DEFAULT
+               CALL logger_error( " IOM READ ATT: can't read attribute in file "//&
+               &               TRIM(td_file%c_name)//" : type unknown " )
+         END SELECT
+      ENDIF
+
+   END FUNCTION iom__read_att_varname_name
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable id and attribute name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file      file structure
+   !> @param[in] id_varid     variable id. use NF90_GLOBAL to read global
+   !> attribute in a file
+   !> @param[in] cd_attname   attribute name
+   !> @return  attribute structure    
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION iom__read_att_varid_name( td_file, id_varid, &
+   &                                              cd_attname)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      CHARACTER(LEN=*), INTENT(IN) :: cd_attname
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            iom__read_att_varid_name=iom_cdf_read_att( td_file, id_varid, &
+            &                                           cd_attname)
+         CASE('dimg')
+            CALL logger_warn( " IOM READ ATT: can't read attribute in dimg file :"&
+            &              //TRIM(td_file%c_name) )
+         CASE DEFAULT
+            CALL logger_error( " IOM READ ATT: can't read attribute in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_att_varid_name
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened file, 
+   !> given dimension id.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_dimid  dimension id
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION iom__read_dim_id(td_file, id_dimid)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_dimid
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            iom__read_dim_id=iom_cdf_read_dim(td_file, id_dimid)
+         CASE('dimg')
+            iom__read_dim_id=iom_rstdimg_read_dim(td_file, id_dimid)
+         CASE DEFAULT
+            CALL logger_error( " IOM READ DIM: can't read dimension in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT      
+
+   END FUNCTION iom__read_dim_id
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   dimension name
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION iom__read_dim_name(td_file, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            iom__read_dim_name=iom_cdf_read_dim(td_file, cd_name)
+         CASE('dimg')
+            iom__read_dim_name=iom_rstdimg_read_dim(td_file, cd_name)
+         CASE DEFAULT
+            CALL logger_error( " IOM READ DIM: can't read dimension in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT      
+
+   END FUNCTION iom__read_dim_name
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> file, given variable id.
+   !> @details
+   !> start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom__read_var_id( td_file, id_varid,&
+   &                                     id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),                       INTENT(IN) :: td_file
+      INTEGER(i4),                       INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            iom__read_var_id=iom_cdf_read_var(td_file, id_varid, &
+            &                                 id_start, id_count)
+         CASE('dimg')
+            iom__read_var_id=iom_rstdimg_read_var(td_file, id_varid, &
+            &                                     id_start, id_count)
+         CASE DEFAULT
+            CALL logger_error( " IOM READ VAR: can't read variable in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_var_id
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> file, given variable name or standard name.
+   !> @details
+   !> start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   variable name or standard name
+   !> @param[in] id_start  index in the variable from which the data values
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom__read_var_name(td_file, cd_name,   &
+   &                                      id_start, id_count  )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)                   , INTENT(IN) :: td_file
+      CHARACTER(LEN=*)              , INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+      !----------------------------------------------------------------
+      
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            iom__read_var_name=iom_cdf_read_var(td_file, cd_name, &
+            &                                   id_start, id_count )
+         CASE('dimg')
+            iom__read_var_name=iom_rstdimg_read_var(td_file, cd_name, &
+            &                                   id_start, id_count )
+         CASE DEFAULT
+            CALL logger_error( " IOM READ VAR: can't read variable in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_var_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write file structure in an opened file.
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option
+   !
+   !> @param[in] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_write_file(td_file, cd_dimorder)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_write_file(td_file, cd_dimorder)
+         CASE('dimg')
+            ! note: can not change dimension order in restart dimg file
+            CALL iom_rstdimg_write_file(td_file)
+         CASE DEFAULT
+            CALL logger_error( " IOM WRITE: can't write file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_write_file
+END MODULE iom
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90	(revision 8732)
@@ -0,0 +1,2349 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: iom_cdf
+!
+! DESCRIPTION:
+!> @brief NETCDF Input/Output manager :  Library to read Netcdf input files
+!>
+!> @details
+!>    to open netcdf file:<br/>
+!> @code
+!>    CALL iom_cdf_open(td_file)
+!> @endcode
+!>       - td_file is file structure (see @ref file)
+!>
+!>    to write in netcdf file:<br/>
+!> @code
+!>    CALL  iom_cdf_write_file(td_file)
+!> @endcode
+!>
+!>    to close netcdf file:<br/>
+!> @code
+!>    CALL iom_cdf_close(tl_file)
+!> @endcode
+!>
+!>    to read one dimension in netcdf file:<br/>
+!> @code
+!>    tl_dim = iom_cdf_read_dim(tl_file, id_dimid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_dim = iom_cdf_read_dim(tl_file, cd_name)
+!> @endcode
+!>       - id_dimid is dimension id<br/>
+!>       - cd_name is dimension name
+!>
+!>    to read one attribute in netcdf file:<br/>
+!> @code
+!>    tl_att = iom_cdf_read_att(tl_file, id_varid, id_attid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_cdf_read_att(tl_file, id_varid, cd_name)
+!> @endcode
+!>       - id_varid is variable id
+!>       - id_attid is attribute id<br/>
+!>       - cd_name is attribute name
+!>    
+!>    to read one variable in netcdf file:<br/>
+!> @code
+!>    tl_var = iom_cdf_read_var(td_file, id_varid, [id_start, id_count])
+!> @endcode
+!>    or
+!> @code
+!>    tl_var = iom_cdf_read_var(td_file, cd_name, [id_start, [id_count,]])
+!> @endcode
+!>       - id_varid is variabale id
+!>       - cd_name is variabale name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_cdf
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE att                             ! attribute manage
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_cdf_open        !< open or create netcdf file, return file structure
+   PUBLIC :: iom_cdf_close       !< close netcdf file
+   PUBLIC :: iom_cdf_read_dim    !< read one dimension in an opened netcdf file, return dimension structure
+   PUBLIC :: iom_cdf_read_att    !< read one attribute in an opened netcdf file, return attribute structure
+   PUBLIC :: iom_cdf_read_var    !< read one variable  in an opened netcdf file, return variable  structure
+   PUBLIC :: iom_cdf_fill_var    !< fill variable value in an opened netcdf file
+   PUBLIC :: iom_cdf_write_file  !< write file structure contents in an opened netcdf file
+
+   PRIVATE :: iom_cdf__check           ! provides a simple interface to netcdf error message
+   PRIVATE :: iom_cdf__get_info        ! get global information in an opened netcdf file
+   PRIVATE :: iom_cdf__get_file_dim    ! read dimension on an opened netcdf file, and reorder it
+   PRIVATE :: iom_cdf__get_file_att    ! read global attribute on an opened netcdf file
+   PRIVATE :: iom_cdf__get_file_var    ! read information about variable on an opened netcdf file
+   PRIVATE :: iom_cdf__read_dim_id     ! read one dimension in an opened netcdf file, given dimension id.
+   PRIVATE :: iom_cdf__read_dim_name   ! read one dimension in an opened netcdf file, given dimension name.
+   PRIVATE :: iom_cdf__read_att_name   ! read variable or global attribute in an opened netcdf file, given attribute name. 
+   PRIVATE :: iom_cdf__read_att_id     ! read variable or global attribute in an opened netcdf file, given attribute id.
+   PRIVATE :: iom_cdf__read_var_id     ! read variable value in an opened netcdf file, given variable id.
+   PRIVATE :: iom_cdf__read_var_name   ! read variable value in an opened netcdf file, given variable name or standard name.
+   PRIVATE :: iom_cdf__read_var_meta   ! read metadata of a variable in an opened netcdf file.
+   PRIVATE :: iom_cdf__read_var_dim    ! read variable dimension in an opened netcdf file.
+   PRIVATE :: iom_cdf__read_var_att    ! read variable attributes in an opened netcdf file.
+   PRIVATE :: iom_cdf__read_var_value  ! read variable value in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_dim       ! write one dimension in an opened netcdf file in write mode.
+   PRIVATE :: iom_cdf__write_att       ! write a variable attribute in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_var       ! write a variable in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_var_def   ! define variable in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_var_value ! put variable value in an opened netcdf file.
+   PRIVATE :: iom_cdf__fill_var_id     ! fill variable value in an opened netcdf file, given variable id
+   PRIVATE :: iom_cdf__fill_var_name   ! fill variable value in an opened netcdf file, given variable name
+   PRIVATE :: iom_cdf__fill_var_all    ! fill all variable value in an opened netcdf file
+   PRIVATE :: iom_cdf__del_coord_var   ! remove coordinate variable from an opened netcdf file
+
+   INTERFACE iom_cdf_read_var
+      MODULE PROCEDURE iom_cdf__read_var_id
+      MODULE PROCEDURE iom_cdf__read_var_name
+   END INTERFACE iom_cdf_read_var
+
+   INTERFACE iom_cdf_fill_var
+      MODULE PROCEDURE iom_cdf__fill_var_id
+      MODULE PROCEDURE iom_cdf__fill_var_name
+      MODULE PROCEDURE iom_cdf__fill_var_all
+   END INTERFACE iom_cdf_fill_var
+
+   INTERFACE iom_cdf_read_dim
+      MODULE PROCEDURE iom_cdf__read_dim_id
+      MODULE PROCEDURE iom_cdf__read_dim_name
+   END INTERFACE iom_cdf_read_dim
+
+   INTERFACE iom_cdf_read_att
+      MODULE PROCEDURE iom_cdf__read_att_id
+      MODULE PROCEDURE iom_cdf__read_att_name
+   END INTERFACE iom_cdf_read_att
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine provides a simple interface to 
+   !> netcdf error message 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date May, 2015 - add optional message to netcdf error message
+   !>
+   !> @param[in] id_status error status
+   !> @param[in] cd_msg    message
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__check(id_status, cd_msg)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4)     , INTENT(IN)           :: id_status
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_msg
+      !----------------------------------------------------------------
+
+      cl_msg=""
+      IF( PRESENT(cd_msg) ) cl_msg=cd_msg
+
+      IF( id_status /= NF90_NOERR )THEN
+         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status)))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__check
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open a netcdf file in read or write mode.
+   !> @details
+   !> if try to open a file in write mode that did not exist, create it.<br/>
+   !> if file already exist, get information about0:<br/>
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> Finally it read dimensions, and 'longitude' variable to compute East-West
+   !> overlap.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf_open(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+
+      ! local variable
+      LOGICAL     :: ll_exist
+      LOGICAL     :: ll_open
+
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      ! check file existence
+      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
+      ! ll_open do not work for netcdf file, always return FALSE
+      IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'cdf' )THEN
+
+         IF( .NOT. td_file%l_wrt )THEN
+
+            CALL logger_fatal( " IOM CDF OPEN: can not open file "//&
+            &               TRIM(td_file%c_name) )
+ 
+         ELSE
+
+            CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) )
+
+            il_status = NF90_CREATE(TRIM(td_file%c_name),&
+            &                       cmode=NF90_64BIT_OFFSET,&
+            &                       ncid=td_file%i_id)
+            CALL iom_cdf__check(il_status," IOM CDF CREATE: ")
+
+            td_file%l_def=.TRUE.
+
+         ENDIF
+
+      ELSE
+
+         IF( td_file%i_id /= 0 )THEN
+
+            CALL logger_error( " IOM CDF OPEN: file "//&
+            &               TRIM(td_file%c_name)//" already opened")
+
+         ELSE
+ 
+            IF( .NOT. td_file%l_wrt )THEN
+
+               CALL logger_info( " IOM CDF OPEN: file "//&
+               &              TRIM(td_file%c_name)//" in read only mode" )
+
+               il_status = NF90_OPEN( TRIM(td_file%c_name), &
+               &                      NF90_NOWRITE,         &
+               &                      td_file%i_id)
+               CALL iom_cdf__check(il_status," IOM CDF OPEN: ")
+
+            ELSE
+
+               CALL logger_info( "IOM CDF OPEN: file "//&
+               &              TRIM(td_file%c_name)//" in write mode" )
+
+               il_status = NF90_OPEN( TRIM(td_file%c_name), &
+               &                      NF90_WRITE,           &
+               &                      td_file%i_id)
+               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ")
+
+            ENDIF
+
+            ! get general information about file
+            CALL iom_cdf__get_info(td_file)
+
+            ! read dimension in file
+            CALL iom_cdf__get_file_dim(td_file) 
+
+            ! read global attribute in file
+            CALL iom_cdf__get_file_att(td_file)
+
+            ! get information about variables in file
+            CALL iom_cdf__get_file_var(td_file)
+
+            ! remove dimension variable from list of variable
+            CALL iom_cdf__del_coord_var(td_file)
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf_open
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close netcdf file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf_close(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF CLOSE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         CALL logger_info( &
+         &  " IOM CDF CLOSE: file "//TRIM(td_file%c_name))
+
+         il_status = NF90_CLOSE(td_file%i_id)
+         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ")
+
+         td_file%i_id = 0
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf_close
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get global information in an opened netcdf 
+   !> file.
+   !> @details
+   !> It gets the number of variables, the number of dimensions, 
+   !> the number of global attributes, the ID of the unlimited dimension
+   !> and finally the format version and filled file strucuture with it.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2016
+   !> - define cdf4 as cdf.
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__get_info(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_fmt   ! format version
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " IOM CDF GET INFO: about netcdf file "//TRIM(td_file%c_name))
+
+      il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, &
+      &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt)
+      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ")
+
+      SELECT CASE(il_fmt)
+         CASE(nf90_format_classic, nf90_format_64bit)
+            td_file%c_type='cdf'
+         CASE(nf90_format_netcdf4, nf90_format_netcdf4_classic)
+            !td_file%c_type='cdf4'
+            td_file%c_type='cdf'
+      END SELECT
+
+      ! record header infos
+      td_file%i_rhd=1
+
+   END SUBROUTINE iom_cdf__get_info
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read dimension on an opened netcdf file, and
+   !> reorder dimension to ('x', 'y', 'z', 't').
+   !> The dimension structure inside file structure is then completed.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2016
+   !> - check unknown dimension
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__get_file_dim(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      ! local variable
+      TYPE(TDIM) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      ! clean dimension
+      DO ji=1,ip_maxdim
+         CALL dim_clean(td_file%t_dim(ji))
+      ENDDO
+
+      IF( td_file%i_ndim > 0 )THEN
+
+         ii=1
+         DO ji = 1, td_file%i_ndim
+            ! read dimension information
+            tl_dim=iom_cdf_read_dim( td_file, ji)
+            ! sname == 'u' if dimension is unknown (not to be used)
+            IF( TRIM(tl_dim%c_sname) /= 'u' )THEN
+               IF( ii > ip_maxdim )THEN
+                  CALL logger_fatal("IOM CDF OPEN: too much dimension "//&
+                  & "to be read. you could choose dimension to be used. see "//&
+                  & " configuration file")
+               ENDIF
+               td_file%t_dim(ii)=dim_copy(tl_dim)
+               ii=ii+1
+            ENDIF
+         ENDDO
+
+         ! inform unlimited dimension
+         IF( td_file%i_uldid == -1 )THEN
+            CALL logger_warn( &
+            &  " IOM CDF GET FILE DIM: there is no unlimited dimension in file "//&
+            &  TRIM(td_file%c_name))
+         !ELSE
+         !   td_file%t_dim( td_file%i_uldid )%l_uld=.TRUE.
+         ENDIF
+
+      ELSE
+
+         CALL logger_warn( &
+         &  " IOM CDF GET FILE DIM: there is no dimension in file "//&
+         &  TRIM(td_file%c_name))
+
+      ENDIF
+
+      ! reorder dimension to ('x','y','z','t')
+      CALL dim_reorder(td_file%t_dim(:))
+
+   END SUBROUTINE iom_cdf__get_file_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read global attribute on an opened netcdf 
+   !> file.
+   !> The attribute structure inside file structure is then completed.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use attribute periodicity read from the file if present.
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__get_file_att(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      IF( td_file%i_natt > 0 )THEN
+         IF(ASSOCIATED(td_file%t_att))THEN
+            CALL att_clean(td_file%t_att(:))
+            DEALLOCATE(td_file%t_att)
+         ENDIF
+         ALLOCATE(td_file%t_att(td_file%i_natt))
+
+         ii=1
+         DO ji = 1, td_file%i_natt
+            ! read global attribute
+            tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji)
+            IF( .NOT. att_is_dummy(tl_att) )THEN
+               td_file%t_att(ii)=att_copy(tl_att)
+               ii=ii+1
+            ENDIF
+            
+         ENDDO
+
+      ELSE
+         CALL logger_debug( &
+         &  " IOM CDF GET FILE ATT: there is no global attribute in file "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__get_file_att
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read information about variable of an 
+   !> opened netcdf file.
+   !> The variable structure inside file structure is then completed.
+   !> @note variable value are not read !
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - manage useless (dummy) variable
+   !> @date January, 2016
+   !> - increment n3d for 4D variable
+   !> @date October, 2016
+   !> - check if variable to be used (variable's dimension allowed and variable
+   !> not "dummy")
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__get_file_var(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_attid
+      INTEGER(i4) :: il_nvar
+
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE  :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      IF( td_file%i_nvar > 0 )THEN
+
+         IF(ASSOCIATED(td_file%t_var))THEN
+            CALL var_clean(td_file%t_var(:))
+            DEALLOCATE(td_file%t_var)
+         ENDIF
+
+         il_nvar=td_file%i_nvar
+         ALLOCATE(tl_var(il_nvar))
+         DO ji = 1, il_nvar
+           ! read variable information
+           tl_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
+         ENDDO
+
+         ! update number of variable used
+         td_file%i_nvar=COUNT(tl_var(:)%l_use)
+
+         ALLOCATE(td_file%t_var(td_file%i_nvar))
+
+         ii=0
+         DO ji = 1, il_nvar
+            IF( tl_var(ji)%l_use )THEN
+               ii=ii+1
+               td_file%t_var(ii)=var_copy(tl_var(ji))
+               SELECT CASE(td_file%t_var(ii)%i_ndim)
+                  CASE(0)
+                     td_file%i_n0d=td_file%i_n0d+1
+                  CASE(1)
+                     td_file%i_n1d=td_file%i_n1d+1
+                     td_file%i_rhd=td_file%i_rhd+1
+                  CASE(2)
+                     td_file%i_n2d=td_file%i_n2d+1
+                     td_file%i_rhd=td_file%i_rhd+1
+                  CASE(3,4)
+                     td_file%i_n3d=td_file%i_n3d+1
+                     td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len
+               END SELECT
+
+               ! look for depth id
+               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'depth')/=0 )THEN
+                  IF( td_file%i_depthid == 0 )THEN
+                     td_file%i_depthid=ji
+                  ELSE
+                     IF( td_file%i_depthid /= ji )THEN
+                        CALL logger_error("IOM CDF GET FILE VAR: find more"//&
+                           &  " than one depth variable in file "//&
+                           &  TRIM(td_file%c_name) )
+                     ENDIF
+                  ENDIF
+               ENDIF
+
+               ! look for time id
+               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN
+                  IF( td_file%i_timeid == 0 )THEN
+                     td_file%i_timeid=ji
+                  ELSE
+                     IF( td_file%i_timeid /= ji )THEN
+                        CALL logger_warn("IOM CDF GET FILE VAR: find more "//&
+                        &                 "than one time variable in file "//&
+                        &                 TRIM(td_file%c_name)//". see "//&
+                        &                 "dummy.cfg configuration file to"//&
+                        &                 " not used dummy variables.")
+                     ENDIF
+                     il_attid=0
+                     IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN
+                        il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar')
+                     ENDIF
+                     IF( il_attid /= 0 )THEN
+                        td_file%i_timeid=ji
+                     ENDIF
+                  ENDIF
+               ENDIF
+
+            ENDIF
+         ENDDO
+
+         CALL var_clean(tl_var(:))
+         DEALLOCATE(tl_var)
+
+      ELSE
+         CALL logger_debug( &
+         &  " IOM CDF GET FILE VAR: there is no variable in file "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__get_file_var
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete coordinate variable from an 
+   !> opened netcdf file if present.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__del_coord_var(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_sname
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      IF( td_file%i_nvar > 0 )THEN
+         DO ji=td_file%i_nvar,1,-1
+            cl_name=TRIM(td_file%t_var(ji)%c_name)
+            DO jj=1,ip_maxdim
+               IF( td_file%t_dim(jj)%l_use )THEN
+                  cl_sname=fct_upper(td_file%t_dim(jj)%c_sname)
+                  IF( TRIM(cl_name) == TRIM(cl_sname) )THEN
+                     CALL file_del_var(td_file,TRIM(cl_name))
+                     EXIT
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE
+         CALL logger_debug( &
+         &  " IOM CDF DEL VAR DIM: there is no variable in file "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+   END SUBROUTINE iom_cdf__del_coord_var
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension id.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 - create unused dimension, when reading dimension
+   !> of length less or equal to zero
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_dimid  dimension id
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION iom_cdf__read_dim_id(td_file, id_dimid)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_dimid
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_name
+      LOGICAL           :: ll_use
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         CALL logger_trace( &
+         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name))
+
+         il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, &
+         &                                cl_name, il_len )
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
+
+         ll_use=.TRUE.
+         IF( il_len <= 0 )THEN
+            CALL logger_warn( &
+         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name)//" is less or equel to zero")
+            il_len=1
+            ll_use=.FALSE.
+         ENDIF
+         iom_cdf__read_dim_id=dim_init(cl_name, il_len, ld_use=ll_use)
+
+      ENDIF
+
+      iom_cdf__read_dim_id%i_id=id_dimid
+
+   END FUNCTION iom_cdf__read_dim_id
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   dimension name
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION iom_cdf__read_dim_name(td_file, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ DIM: no id associated to file "//&
+         &  TRIM(td_file%c_name))
+
+      ELSE      
+
+         il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
+         &                         il_dimid)
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
+
+         iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid)
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_dim_name
+   !-------------------------------------------------------------------
+   !> @brief This function read variable or global attribute in an opened 
+   !> netcdf file, given attribute name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global
+   !> attribute in a file
+   !> @param[in] cd_name   attribute name
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION iom_cdf__read_att_name(td_file, id_varid, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      INTEGER(i4),      INTENT(IN) :: id_varid
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_attid
+      INTEGER(i4) :: il_type
+      INTEGER(i4) :: il_len
+
+      CHARACTER(LEN=lc) :: cl_value
+      
+      INTEGER(i1), DIMENSION(:), ALLOCATABLE :: bl_value
+      INTEGER(i2), DIMENSION(:), ALLOCATABLE :: sl_value
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
+      REAL(sp)   , DIMENSION(:), ALLOCATABLE :: fl_value
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE      
+
+         cl_name=TRIM(ADJUSTL(cd_name))
+
+         ! inquire attribute
+         IF( id_varid == NF90_GLOBAL )THEN
+
+            CALL logger_trace( &
+            &  " IOM CDF READ ATT: inquire global attribute "//&
+            &  " in file "//TRIM(td_file%c_name))
+
+         ELSE
+
+            CALL logger_trace( &
+            &  " IOM CDF READ ATT: inquire attribute "//&
+            &  " of variable "//TRIM(fct_str(id_varid))//&
+            &  " in file "//TRIM(td_file%c_name))
+
+         ENDIF
+
+         il_status=NF90_INQUIRE_ATTRIBUTE(td_file%i_id, id_varid,  &
+         &                                cl_name,&
+         &                                il_type,&
+         &                                il_len, &
+         &                                il_attid )
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+
+         !! get attribute value
+         CALL logger_debug( " IOM CDF READ ATT: get attribute "//&
+            &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name))
+
+         SELECT CASE( il_type )
+
+            CASE(NF90_CHAR)
+
+               ! check string lengths
+               IF( LEN(cl_value) < il_len )THEN
+
+                  CALL logger_warn( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                  &                      cl_name, &
+                  &                      cl_value )
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+
+                  iom_cdf__read_att_name=att_init(cl_name, cl_value)
+
+               ENDIF
+         
+            CASE(NF90_BYTE)
+
+               ALLOCATE( bl_value( il_len), &
+               &         stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( "IOM CDF READ ATT: "//&
+                  &  "not enough space to put attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                  &                      cl_name, &
+                  &                      bl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  iom_cdf__read_att_name=att_init(cl_name, bl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(bl_value)
+
+            CASE(NF90_SHORT)
+
+               ALLOCATE( sl_value( il_len), &
+               &         stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                  &                      cl_name, &
+                  &                      sl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  iom_cdf__read_att_name=att_init(cl_name, sl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(sl_value)
+
+            CASE(NF90_INT)
+
+               ALLOCATE( il_value( il_len), &
+               &         stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                  &                      cl_name, &
+                  &                      il_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  iom_cdf__read_att_name=att_init(cl_name, il_value(:))
+               ENDIF
+
+               DEALLOCATE(il_value)
+
+            CASE(NF90_FLOAT)
+
+               ALLOCATE( fl_value( il_len), &
+               &         stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                  &                      cl_name, &
+                  &                      fl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  iom_cdf__read_att_name=att_init(cl_name, fl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(fl_value)
+
+            CASE(NF90_DOUBLE)
+
+               ALLOCATE( dl_value( il_len), &
+               &         stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                  &                      cl_name, &
+                  &                      dl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  iom_cdf__read_att_name=att_init(cl_name, dl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(dl_value)
+
+         END SELECT
+
+         iom_cdf__read_att_name%i_id=il_attid
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_att_name
+   !-------------------------------------------------------------------
+   !> @brief This function read variable or global attribute in an opened 
+   !> netcdf file, given attribute id.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global 
+   !> attribute in a file
+   !> @param[in] id_attid  attribute id
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+   TYPE(TATT) FUNCTION iom_cdf__read_att_id(td_file, id_varid, id_attid)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      INTEGER(i4), INTENT(IN) :: id_attid
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      CHARACTER(LEN=lc) :: cl_name
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  "IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! get attribute name
+         il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name)
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+
+         ! read attribute
+         iom_cdf__read_att_id=iom_cdf__read_att_name(td_file, id_varid, cl_name)
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_att_id
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> netcdf file, given variable id.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_cdf__read_var_id(td_file, id_varid,&
+   &                                        id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN) :: td_file
+      INTEGER(i4),               INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! look for variable index
+         il_ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
+         IF( il_ind(1) /= 0 )THEN
+
+            iom_cdf__read_var_id=var_copy(td_file%t_var(il_ind(1)))
+
+            !!! read variable value
+            CALL iom_cdf__read_var_value(td_file, iom_cdf__read_var_id, &
+            &                            id_start, id_count)
+
+         ELSE
+            CALL logger_error( &
+            &  " IOM CDF READ VAR: there is no variable with id "//&
+            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+   END FUNCTION iom_cdf__read_var_id
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> netcdf file, given variable name or standard name.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   variable name or standard name.
+   !> @param[in] id_start  index in the variable from which the data values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_cdf__read_var_name(td_file, cd_name,  &
+   &                                          id_start, id_count )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)     ,                INTENT(IN) :: td_file
+      CHARACTER(LEN=*),                INTENT(IN), OPTIONAL :: cd_name
+      INTEGER(i4)     , DIMENSION(:),  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:),  INTENT(IN), OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         IF( .NOT. PRESENT(cd_name) )THEN
+
+            CALL logger_error( &
+            &  " IOM CDF READ VAR: you must specify a variable to read "//&
+            &  " in file "//TRIM(td_file%c_name))
+
+         ELSE
+
+            il_varid=var_get_index(td_file%t_var(:), cd_name)
+            IF( il_varid /= 0 )THEN
+
+               iom_cdf__read_var_name=var_copy(td_file%t_var(il_varid))
+
+               !!! read variable value
+               CALL iom_cdf__read_var_value( td_file, &
+               &                             iom_cdf__read_var_name, &
+               &                             id_start, id_count)
+
+            ELSE
+
+               CALL logger_error( &
+               &  " IOM CDF READ VAR: there is no variable with "//&
+               &  " name or standard name "//TRIM(cd_name)//&
+               &  " in file "//TRIM(td_file%c_name) )
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+      
+   END FUNCTION iom_cdf__read_var_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill all variable value from an opened 
+   !> netcdf file.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] id_start     index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__fill_var_all(td_file, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(INOUT) :: td_file
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ),  OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ),  OPTIONAL :: id_count
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         DO ji=1,td_file%i_nvar
+            CALL iom_cdf_fill_var(td_file, td_file%t_var(ji)%i_id, &
+            &                     id_start, id_count)
+         ENDDO
+
+      ENDIF
+   END SUBROUTINE iom_cdf__fill_var_all
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill variable value in an opened 
+   !> netcdf file, given variable id.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] id_varid     variable id
+   !> @param[in] id_start     index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__fill_var_id(td_file, id_varid, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(INOUT) :: td_file
+      INTEGER(i4),               INTENT(IN)    :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_varid
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! look for variable id
+         il_varid(:)=MINLOC( td_file%t_var(:)%i_id, &
+         &                 mask=(td_file%t_var(:)%i_id==id_varid))
+         IF( il_varid(1) /= 0 )THEN
+
+            !!! read variable value
+            CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid(1)), &
+            &                            id_start, id_count)
+
+            DO ji=1,td_file%i_nvar
+               CALL logger_debug(" IOM CDF FILL VAR: var id "//&
+               &     TRIM(td_file%t_var(ji)%c_name)//" "//&
+               &     TRIM(fct_str(td_file%t_var(ji)%i_id)) )
+            ENDDO
+         ELSE
+            CALL logger_error( &
+            &  " IOM CDF FILL VAR: there is no variable with id "//&
+            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+   END SUBROUTINE iom_cdf__fill_var_id
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill variable value in an opened 
+   !> netcdf file, given variable name or standard name.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      variable name or standard name
+   !> @param[in] id_start     index in the variable from which the data values will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__fill_var_name(td_file, cd_name, id_start, id_count )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),                   INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*),              INTENT(IN)    :: cd_name
+      INTEGER(i4),     DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
+      INTEGER(i4),     DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+            il_varid=var_get_index(td_file%t_var(:), cd_name)
+            IF( il_varid /= 0 )THEN
+
+               !!! read variable value
+               CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid), &
+               &                            id_start, id_count)
+
+            ELSE
+
+               CALL logger_error( &
+               &  "IOM CDF FILL VAR: there is no variable with "//&
+               &  "name or standard name"//TRIM(cd_name)//&
+               &  " in file "//TRIM(td_file%c_name))
+            ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE iom_cdf__fill_var_name
+   !-------------------------------------------------------------------
+   !> @brief This function read metadata of a variable in an opened 
+   !> netcdf file.
+   !
+   !> @note variable value are not read
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable.
+   !> @date September, 2015
+   !> - manage useless (dummy) attribute
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_cdf__read_var_meta(td_file, id_varid)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+
+      ! local variable
+      CHARACTER(LEN=lc)                                       :: cl_name
+
+      INTEGER(i4)                                             :: il_status
+      INTEGER(i4)                                             :: il_type
+      INTEGER(i4)                                             :: il_ndim
+      INTEGER(i4)                                             :: il_natt
+      INTEGER(i4)                                             :: il_attid
+      INTEGER(i4), DIMENSION(NF90_MAX_VAR_DIMS)               :: il_dimid
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)                       :: tl_dim
+      TYPE(TATT)                                              :: tl_fill
+      TYPE(TATT) , DIMENSION(:)                 , ALLOCATABLE :: tl_att
+      TYPE(TATT) , DIMENSION(:)                 , ALLOCATABLE :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ VAR META: no id associated to file "//&
+         &   TRIM(td_file%c_name))
+
+      ELSE
+
+         ! inquire variable
+         CALL logger_debug( &
+         &  " IOM CDF READ VAR META: inquire variable "//&
+         &  TRIM(fct_str(id_varid))//&
+         &  " in file "//TRIM(td_file%c_name))
+         
+         il_dimid(:)=0
+
+         il_status=NF90_INQUIRE_VARIABLE( td_file%i_id, id_varid,        &
+         &                                cl_name,    &
+         &                                il_type,    &
+         &                                il_ndim,    &
+         &                                il_dimid(:),&
+         &                                il_natt )
+         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ")
+
+         !!! fill variable dimension structure
+         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) )
+
+         IF( il_natt /= 0 )THEN
+            ALLOCATE( tl_att(il_natt) )
+            !!! fill variable attribute structure
+            tl_att(:)=iom_cdf__read_var_att(td_file, id_varid, il_natt)
+
+            !! look for _FillValue. if none add one
+            il_attid=att_get_id(tl_att(:),'_FillValue')
+            IF( il_attid == 0 )THEN
+               CALL logger_info("IOM CDF READ VAR META: no _FillValue for variable "//&
+               &  TRIM(cl_name)//" in file "//TRIM(td_file%c_name) )
+
+               il_attid=att_get_id(tl_att(:),'missing_value')
+               IF( il_attid /= 0 )THEN
+                  ! create attribute _FillValue
+                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                  &                "missing_value for variable "//TRIM(cl_name) )
+                  tl_fill=att_init('_FillValue',tl_att(il_attid)%d_value(:), &
+                  &                 id_type=tl_att(il_attid)%i_type)
+               ELSE
+                  ! create attribute _FillValue
+                  SELECT CASE(TRIM(fct_lower(cl_name)))
+                     CASE DEFAULT
+                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                        &                "zero for variable "//TRIM(cl_name) )
+                        tl_fill=att_init('_FillValue',0.)
+                     CASE('nav_lon','nav_lat', 'nav_lev', &
+                        &  'glamt','glamu','glamv','glamf', &
+                        &  'gphit','gphiu','gphiv','gphif')
+                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                        &                "dummy fillValue (1.e20) for variable "//TRIM(cl_name) )
+                        tl_fill=att_init('_FillValue',1.e20)
+                  END SELECT
+               ENDIF
+
+               ALLOCATE( tl_tmp(il_natt) )
+               ! save read attribut
+               tl_tmp(:)=att_copy(tl_att(:))
+               ! change number of attribute in array
+               CALL att_clean(tl_att(:))
+               DEALLOCATE( tl_att )
+               ALLOCATE( tl_att(il_natt+1) )
+               ! copy read attribut
+               tl_att(1:il_natt)=att_copy(tl_tmp(:))
+               ! clean
+               CALL att_clean(tl_tmp(:))
+               DEALLOCATE( tl_tmp )
+
+               ! create attribute _FillValue
+               tl_att(il_natt+1)=att_copy(tl_fill)
+
+            ENDIF
+
+         ELSE
+            ALLOCATE(tl_att(il_natt+1) )
+            ! create attribute _FillValue
+            SELECT CASE(TRIM(fct_lower(cl_name)))
+               CASE DEFAULT
+                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                  &                "zero for variable "//TRIM(cl_name) )
+                  tl_fill=att_init('_FillValue',0.)
+               CASE('nav_lon','nav_lat', &
+                  &  'glamt','glamu','glamv','glamf', &
+                  &  'gphit','gphiu','gphiv','gphif')
+                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                  &                "dummy fillValue (1.e20) for variable "//TRIM(cl_name) )
+                  tl_fill=att_init('_FillValue',1.e20)
+            END SELECT            
+            ! create attribute _FillValue
+            tl_att(il_natt+1)=att_copy(tl_fill)
+         ENDIF
+
+         !! initialize variable
+         iom_cdf__read_var_meta=var_init( cl_name, il_type, tl_dim(:), &
+         &                                tl_att(:), id_id=id_varid )
+
+         !! look for dummy attribute
+         DO ji=il_natt,1,-1
+            IF( att_is_dummy(tl_att(ji)) )THEN
+               CALL var_del_att(iom_cdf__read_var_meta, tl_att(ji))
+            ENDIF
+         ENDDO
+
+         !! check if variable is dummy
+         IF( var_is_dummy(iom_cdf__read_var_meta) )THEN
+            iom_cdf__read_var_meta%l_use=.FALSE.
+         ENDIF
+
+         !! check if all dimensions are allowed
+         DO ji=1,il_ndim
+            IF( ALL(td_file%t_dim(:)%i_id /= il_dimid(ji)) )THEN
+               iom_cdf__read_var_meta%l_use=.FALSE.
+            ENDIF
+         ENDDO
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+         CALL att_clean(tl_fill)
+         CALL att_clean(tl_att(:))
+         DEALLOCATE( tl_att )
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_var_meta
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable dimension
+   !> in an opened netcdf file.
+   !>
+   !> @details
+   !> the number of dimension can't exceed 4, 
+   !> and should be 'x', 'y', 'z', 't' (whatever their order).<br/>
+   !> If the number of dimension read is less than 4, the array of dimension
+   !> strucure is filled with unused dimension.<br/>
+   !> So the array of dimension structure of a variable is always compose of 4
+   !> dimension (use or not). 
+   !>
+   !> @warn dummy dimension are not used. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !> @date September, 2015
+   !> - check dummy dimension
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_ndim   number of dimension
+   !> @param[in] cd_name   variable name
+   !> @param[in] id_dimid  array of dimension id
+   !> @return array dimension structure 
+   !-------------------------------------------------------------------
+   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN) :: td_file
+      INTEGER(i4),               INTENT(IN) :: id_ndim
+      CHARACTER(LEN=*)         , INTENT(IN) :: cd_name
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid
+
+      ! function
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: iom_cdf__read_var_dim
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      IF( id_ndim == 0 )THEN
+
+         tl_dim(:)%l_use=.FALSE.
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(tl_dim(:))
+
+         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ELSE IF( id_ndim > 0 )THEN
+
+         ii=1
+         DO ji = 1, id_ndim
+
+            ! check if dimension to be used, is allowed
+            IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN
+               IF( ii > ip_maxdim )THEN
+                  CALL logger_error(" IOM CDF READ VAR DIM: "//&
+                  &  "too much dimensions for variable "//&
+                  &  TRIM(cd_name)//". check dummy configuration file.")
+               ENDIF
+
+               CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//&
+                  &  "dimension "//TRIM(fct_str(ji)) )
+
+               il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2
+               
+               ! read dimension information
+               tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, &
+               &                      td_file%t_dim(il_xyzt2(ii))%i_len )
+
+               ii=ii+1
+            ELSE
+               CALL logger_debug( " IOM CDF READ VAR DIM: dummy variable "//&
+               &  "dimension "//TRIM(fct_str(ji))//" not used." )
+            ENDIF
+         ENDDO
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(tl_dim(:))
+ 
+         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:))
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_var_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable attributes
+   !> in an opened netcdf file.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_natt   number of attributes
+   !> @return array of attribute structure
+   !-------------------------------------------------------------------
+   FUNCTION iom_cdf__read_var_att(td_file, id_varid, id_natt)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      INTEGER(i4), INTENT(IN) :: id_natt      
+
+      ! function
+      TYPE(TATT), DIMENSION(id_natt) :: iom_cdf__read_var_att
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( id_natt > 0 )THEN
+      
+         ! read attributes
+         DO ji = 1, id_natt
+            CALL logger_trace( " IOM CDF READ VAR ATT: get attribute "//&
+            &               TRIM(fct_str(ji)) )
+
+            iom_cdf__read_var_att(ji)=iom_cdf_read_att(td_file, id_varid, ji)
+
+         ENDDO
+
+      ELSE
+
+         CALL logger_debug( " IOM CDF READ VAR ATT: no attribute for variable " )
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_var_att
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an opened netcdf file.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use scale factor and offset, as soon as read variable value
+   !
+   !> @param[in] td_file   file structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_start  index in the variable from which the data values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return variable structure completed 
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__read_var_value(td_file, td_var, &
+   &                                  id_start, id_count )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN)    :: td_file
+      TYPE(TVAR) ,               INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)                                    :: il_status
+      INTEGER(i4)                                    :: il_tmp1
+      INTEGER(i4)                                    :: il_tmp2
+      INTEGER(i4)                                    :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_ord
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_ord
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if variable in file structure
+      il_varid=var_get_id(td_file%t_var(:),TRIM(td_var%c_name))
+      IF( il_varid /= 0 )THEN
+
+         ! check id_count and id_start optionals parameters...
+         IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
+             ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
+            CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//&
+               & " should be both specify")
+         ENDIF
+         IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
+
+            IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
+            &   SIZE(id_count(:)) /= ip_maxdim )THEN
+               CALL logger_error("IOM CDF READ VAR: dimension of array start"//&
+                  &  " or count are invalid to read variable "//&
+                  &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name) )
+            ENDIF
+
+            ! change dimension order from ('x','y','z','t')
+            il_start(:)=dim_reorder_xyzt2(td_var%t_dim, id_start(:))
+            il_count(:)=dim_reorder_xyzt2(td_var%t_dim, id_count(:))
+
+            ! keep ordered array ('x','y','z','t')
+            il_start_ord(:)=id_start(:)
+            il_count_ord(:)=id_count(:)
+
+         ELSE
+
+            ! change dimension order from ('x','y','z','t')
+            il_start(:)=(/1,1,1,1/)
+            il_count(:)=dim_reorder_xyzt2(td_var%t_dim(:),td_var%t_dim(:)%i_len)
+
+            ! keep ordered array ('x','y','z','t')
+            il_start_ord(:)=(/1,1,1,1/)
+            il_count_ord(:)=td_var%t_dim(:)%i_len
+
+         ENDIF
+
+         ! check dimension
+         IF( .NOT. ALL(il_start_ord(:)>=(/1,1,1,1/)) )THEN
+
+            CALL logger_error( "IOM CDF READ VAR VALUE: start indices should"//&
+            &  " be greater than or equal to 1")
+
+         ENDIF
+
+         IF(.NOT.ALL(il_start_ord(:)+il_count_ord(:)-1 <= &
+            &  (/td_var%t_dim( 1 )%i_len,&
+            &    td_var%t_dim( 2 )%i_len,&
+            &    td_var%t_dim( 3 )%i_len,&
+            &    td_var%t_dim( 4 )%i_len &
+            &                                            /)) )THEN
+
+            DO ji = 1, ip_maxdim
+               il_tmp1=il_start_ord(ji)+il_count_ord(ji)-1
+               il_tmp2=td_var%t_dim(ji)%i_len
+               CALL logger_debug( "IOM CDF READ VAR VALUE: start + count -1:"//&
+               &  TRIM(fct_str(il_tmp1))//" variable dimension"//&
+               &  TRIM(fct_str(il_tmp2)))
+            ENDDO
+            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
+            &  "variable dimension for "//TRIM(td_var%c_name) )
+
+         ELSE
+
+            ! Allocate space to hold variable value (disorder)
+            ALLOCATE(dl_value( il_count(1), &
+               &               il_count(2), &
+               &               il_count(3), &
+               &               il_count(4)),&
+               &               stat=il_status)
+            IF( il_status /= 0 )THEN
+
+              CALL logger_error( &
+               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
+               &  TRIM(td_var%c_name))
+
+            ENDIF
+
+            ! read values
+            CALL logger_debug( &
+            &  "IOM CDF READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
+            &  " in file "//TRIM(td_file%c_name))
+
+            il_status = NF90_GET_VAR( td_file%i_id, il_varid,           &
+            &                                       dl_value(:,:,:,:),  &
+            &                                       start = il_start(:),&
+            &                                       count = il_count(:) )
+            CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ")
+
+            ! Allocate space to hold variable value in structure
+            IF( ASSOCIATED(td_var%d_value) )THEN
+               DEALLOCATE(td_var%d_value)   
+            ENDIF
+  
+            ! new dimension length
+            td_var%t_dim(:)%i_len=il_count_ord(:)
+
+!>   dummy patch for pgf95
+            ALLOCATE( dl_tmp( td_var%t_dim(1)%i_len, &
+            &                 td_var%t_dim(2)%i_len, &
+            &                 td_var%t_dim(3)%i_len, &
+            &                 td_var%t_dim(4)%i_len),&
+            &        stat=il_status)
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
+               &  TRIM(td_var%c_name)//&
+               &  " in variable structure")
+            ENDIF
+            dl_tmp(:,:,:,:)=td_var%d_fill
+
+            ! reshape values to be ordered as ('x','y','z','t')
+            dl_tmp(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), &
+            &                                 dl_value(:,:,:,:))
+
+            DEALLOCATE(dl_value)
+
+            ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, &
+            &                        td_var%t_dim(2)%i_len, &
+            &                        td_var%t_dim(3)%i_len, &
+            &                        td_var%t_dim(4)%i_len),&
+            &        stat=il_status)
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
+               &  TRIM(td_var%c_name)//&
+               &  " in variable structure")
+
+            ENDIF
+!            ! FillValue by default
+!            td_var%d_value(:,:,:,:)=td_var%d_fill
+!
+!            ! reshape values to be ordered as ('x','y','z','t')
+!            td_var%d_value(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), &
+!            &                                         dl_value(:,:,:,:))
+!
+!            DEALLOCATE(dl_value)
+
+            td_var%d_value(:,:,:,:)=dl_tmp(:,:,:,:)
+            DEALLOCATE(dl_tmp)
+!<   dummy patch for pgf95
+
+            ! force to change _FillValue to avoid mistake 
+            ! with dummy zero _FillValue
+            IF( td_var%d_fill == 0._dp )THEN
+               CALL var_chg_FillValue(td_var)
+            ENDIF
+
+            ! use scale factor and offset
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
+            END WHERE
+
+         ENDIF
+      ELSE
+         CALL logger_error( &
+         &  "IOM CDF READ VAR VALUE: no variable "//TRIM(td_var%c_name)//&
+         &  " in file structure "//TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__read_var_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write file structure in an opened netcdf file.
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add dimension order option 
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf_write_file(td_file, cd_dimorder)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
+
+      CHARACTER(LEN=lc)                      :: cl_dimorder
+
+      TYPE(TVAR)                             :: tl_var
+
+      TYPE(TDIM), DIMENSION(ip_maxdim)       :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jvar
+      !----------------------------------------------------------------
+
+      cl_dimorder='xyzt'
+      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder)
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         IF( td_file%l_wrt )THEN
+
+            ! remove dummy variable
+            CALL file_del_var(td_file,'no0d')
+            CALL file_del_var(td_file,'no1d')
+            CALL file_del_var(td_file,'no2d')
+            CALL file_del_var(td_file,'no3d')
+
+            DO ji = 1, td_file%i_nvar
+               CALL var_check_dim( td_file%t_var(ji) )
+            ENDDO
+
+            ! save usefull dimension
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               tl_dim(:)=var_max_dim(td_file%t_var(:))
+
+               DO ji=1,ip_maxdim
+                  IF( tl_dim(ji)%l_use ) CALL file_move_dim(td_file, tl_dim(ji))
+               ENDDO
+               ! clean
+               CALL dim_clean(tl_dim(:))
+            ENDIF
+
+            ! change dimension order
+            IF( TRIM(cl_dimorder) /= 'xyzt' )THEN
+               CALL dim_reorder(td_file%t_dim(:),TRIM(cl_dimorder))
+               DO jvar=1,td_file%i_nvar
+                  CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(jvar)%c_name))
+                  CALL var_reorder(td_file%t_var(jvar),TRIM(cl_dimorder))
+               ENDDO
+            ENDIF
+
+            ! write dimension in file
+            DO ji = 1, ip_maxdim
+               IF( td_file%t_dim(ji)%l_use )THEN
+                  CALL iom_cdf__write_dim(td_file, td_file%t_dim(ji))
+
+                  ! write dimension variable
+                  ALLOCATE(il_value(td_file%t_dim(ji)%i_len))
+                  il_value(:)=(/(jj,jj=1,td_file%t_dim(ji)%i_len)/)
+
+                  tl_var=var_init( fct_upper(td_file%t_dim(ji)%c_sname), &
+                  &                il_value(:),                          &
+                  &                td_dim=td_file%t_dim(ji) )
+
+                  DEALLOCATE(il_value)
+
+                  ! do not use FillValue for dimension variable
+                  CALL var_del_att(tl_var, "_FillValue")
+                   
+                  CALL iom_cdf__write_var(td_file,tl_var)
+                  ! clean
+                  CALL var_clean(tl_var)
+
+               ENDIF
+            ENDDO
+
+            ! write global attibute in file
+            DO ji = 1, td_file%i_natt
+               CALL iom_cdf__write_att(td_file, NF90_GLOBAL, td_file%t_att(ji))
+            ENDDO
+
+            ! write variable in file
+            DO ji = 1, td_file%i_nvar
+               CALL iom_cdf__write_var(td_file, td_file%t_var(ji)) 
+            ENDDO
+
+         ELSE
+
+            CALL logger_error( &
+            &  "IOM CDF WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
+            &  ", not opened in write mode")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_cdf_write_file
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write one dimension in an opened netcdf 
+   !> file in write mode.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[inout] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__write_dim(td_file, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TDIM),  INTENT(INOUT) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      IF( .NOT. td_file%l_def )THEN
+
+         CALL logger_trace( &
+         &  " IOM CDF WRITE FILE DIM: Enter define mode, file "//TRIM(td_file%c_name))
+
+         ! Enter define mode
+         il_status=NF90_REDEF(td_file%i_id)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+
+         td_file%l_def=.TRUE.
+
+      ENDIF
+
+      IF( td_dim%l_use )THEN
+         IF( td_dim%l_uld )THEN
+            ! write unlimited dimension
+            CALL logger_trace( &
+            &  "IOM CDF WRITE FILE DIM: write unlimited dimension "//&
+            &  TRIM(td_dim%c_name)//" in file "//TRIM(td_file%c_name))
+
+            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
+            &                      NF90_UNLIMITED, td_dim%i_id)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+
+         ELSE
+            ! write not unlimited dimension
+            CALL logger_debug( &
+            &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
+            &  " in file "//TRIM(td_file%c_name))
+            
+            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
+            &                      td_dim%i_len, td_dim%i_id)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_cdf__write_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write a variable attribute in
+   !> an opened netcdf file.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] id_varid     variable id. use NF90_GLOBAL to write 
+   !> global attribute in a file
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__write_att(td_file, id_varid, td_att)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      INTEGER(i4), INTENT(IN)    :: id_varid
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      IF( .NOT. td_file%l_def )THEN
+
+         CALL logger_trace( &
+         &  "IOM CDF WRITE FILE ATT: Enter define mode, file "//TRIM(td_file%c_name))
+
+         ! Enter define mode
+         il_status=NF90_REDEF(td_file%i_id)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+
+         td_file%l_def=.TRUE.
+
+      ENDIF
+
+      !! put attribute value
+      CALL logger_trace( &
+      &  "IOM CDF WRITE FILE ATT: write attribute "//TRIM(td_att%c_name)//&
+      &  " of variable "//TRIM(fct_str(id_varid))//&
+      &  " in file "//TRIM(td_file%c_name))
+      SELECT CASE( td_att%i_type )
+
+         CASE(NF90_CHAR)
+            ! put the attribute
+            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
+            &  td_att%c_name, td_att%c_value )
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+
+         CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
+            ! put the attribute
+            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
+            &  td_att%c_name, td_att%d_value )
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+
+      END SELECT
+
+   END SUBROUTINE iom_cdf__write_att
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write a variable in an opened netcdf file.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - do not force to use zero as FillValue for any meshmask variable
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[inout] td_var    variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__write_var(td_file, td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR),  INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      LOGICAL     :: ll_chg
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( .NOT. td_file%l_def )THEN
+
+         CALL logger_trace( &
+         &  " IOM CDF WRITE VAR: Enter define mode, file "//&
+         &  TRIM(td_file%c_name))
+
+         ! Enter define mode
+         il_status=NF90_REDEF(td_file%i_id)
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
+
+         td_file%l_def=.TRUE.
+
+      ENDIF
+ 
+      ! check if file and variable dimension conform
+      IF( file_check_var_dim(td_file, td_var) )THEN
+
+         ll_chg=.TRUE.
+         DO ji=1,ip_maxdim
+            IF( TRIM(fct_lower(cp_dimorder(ji:ji))) == &
+            &   TRIM(fct_lower(td_var%c_name)) )THEN
+               ll_chg=.FALSE.
+               CALL logger_trace(TRIM(fct_lower(td_var%c_name))//' is var dimension')
+               EXIT
+            ENDIF
+         ENDDO
+         ! ugly patch until NEMO do not force to use 0. as FillValue 
+         IF( ll_chg )THEN
+            ! not a dimension variable
+            ! change FillValue
+            SELECT CASE( TRIM(fct_lower(td_var%c_name)) )
+               CASE DEFAULT
+                  CALL var_chg_FillValue(td_var,0._dp)
+               CASE('nav_lon','nav_lat', &
+                  & 'glamt','glamu','glamv','glamf', &
+                  & 'gphit','gphiu','gphiv','gphif', &
+                  & 'e1t','e1u','e1v','e1f',         &
+                  & 'e2t','e2u','e2v','e2f','ff',    &
+                  & 'gcost','gcosu','gcosv','gcosf', &
+                  & 'gsint','gsinu','gsinv','gsinf', &
+                  & 'mbathy','misf','isf_draft','isfdraft',     &
+                  & 'hbatt','hbatu','hbatv','hbatf', &
+                  & 'gsigt','gsigu','gsigv','gsigf', &
+                  & 'e3t_0','e3u_0','e3v_0','e3w_0', &
+                  & 'e3f_0','gdepw_1d','gdept_1d',   &
+                  & 'e3tp','e3wp','gdepw_0','rx1',   &
+                  & 'gdept_0','gdepu','gdepv',       &
+                  & 'hdept','hdepw','e3w_1d','e3t_1d',&
+                  & 'tmask','umask','vmask','fmask'  )
+                  ! do not change for coordinates and meshmask variables
+            END SELECT
+         ENDIF
+
+         ! define variable in file
+         td_var%i_id=iom_cdf__write_var_def(td_file, td_var) 
+
+         IF( td_file%l_def )THEN
+
+            CALL logger_trace( &
+            &  " IOM CDF WRITE VAR: Leave define mode, file "//&
+            &  TRIM(td_file%c_name))
+
+            ! Leave define mode
+            il_status=NF90_ENDDEF(td_file%i_id)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ")
+
+            td_file%l_def=.FALSE.
+
+         ENDIF
+
+         IF( ASSOCIATED(td_var%d_value) )THEN
+            ! write variable value in file
+            CALL iom_cdf__write_var_value(td_file, td_var)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf__write_var
+   !-------------------------------------------------------------------
+   !> @brief This function define variable in an opened netcdf file.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] td_var    variable structure
+   !> @return  variable id
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION iom_cdf__write_var_def(td_file, td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      TYPE(TVAR),  INTENT(IN) :: td_var
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4)                       :: il_ind
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dimid
+
+      TYPE(TVAR)                        :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! copy structure
+      tl_var=var_copy(td_var)
+
+      ! forced to use float type
+      IF( tl_var%d_unf /= 1. .AND. tl_var%i_type==NF90_SHORT )THEN
+         tl_var%i_type=NF90_FLOAT
+      ENDIF
+
+      IF( ALL( .NOT. tl_var%t_dim(:)%l_use ) )THEN
+         CALL logger_debug( &
+         &  "IOM CDF WRITE VAR DEF scalar: define variable "//&
+         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
+         ! scalar value
+         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), &
+         &                        tl_var%i_type, varid=iom_cdf__write_var_def) 
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+      ELSE
+
+         ! check which dimension use
+         jj=0
+         il_dimid(:)=0
+         ! reorder dimension, so unused dimension won't be written
+         DO ji = 1,  ip_maxdim
+            IF( tl_var%t_dim(ji)%l_use )THEN
+               jj=jj+1
+               il_dimid(jj)=dim_get_id(td_file%t_dim(:),tl_var%t_dim(ji)%c_name)
+            ENDIF
+         ENDDO
+
+         CALL logger_debug( &
+         &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//&
+         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name))
+
+         DO ji=1,jj
+            CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
+         ENDDO
+
+         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     &
+         &                        tl_var%i_type,                         &
+         &                        il_dimid(1:jj),                        &
+         &                        varid=iom_cdf__write_var_def           )
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+      ENDIF
+      CALL logger_debug("IOM CDF WRITE VAR DEF: type = "//TRIM(fct_str(tl_var%i_type)))
+
+      ! remove unuseful attribute
+      il_ind=att_get_index( tl_var%t_att(:), "ew_overlap" )
+      IF( il_ind /= 0 )THEN
+         IF( tl_var%t_att(il_ind)%d_value(1) == -1 )THEN
+            CALL var_del_att(tl_var, tl_var%t_att(il_ind))
+         ENDIF
+      ENDIF
+
+      DO ji = 1, tl_var%i_natt
+         CALL logger_debug( &
+         &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//&
+         &  " for variable "//TRIM(tl_var%c_name)//&
+         &  " in file "//TRIM(td_file%c_name) )
+
+         ! forced FillValue to have same type than variable
+         IF( TRIM(tl_var%t_att(ji)%c_name) == '_FillValue' )THEN
+            tl_var%t_att(ji)%i_type=tl_var%i_type
+         ENDIF
+
+         SELECT CASE(tl_var%t_att(ji)%i_type)
+            CASE(NF90_CHAR)
+               IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN
+                  il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, &
+                  &                        TRIM(tl_var%t_att(ji)%c_name),        &
+                  &                        TRIM(tl_var%t_att(ji)%c_value)        )
+               ENDIF
+            CASE(NF90_BYTE)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        INT(tl_var%t_att(ji)%d_value(:),i1))
+            CASE(NF90_SHORT)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        INT(tl_var%t_att(ji)%d_value(:),i2))
+            CASE(NF90_INT)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        INT(tl_var%t_att(ji)%d_value(:),i4))
+            CASE(NF90_FLOAT)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        REAL(tl_var%t_att(ji)%d_value(:),sp))
+            CASE(NF90_DOUBLE)
+               il_status = NF90_PUT_ATT(td_file%i_id,                   &
+               &                        iom_cdf__write_var_def,         &
+               &                        TRIM(tl_var%t_att(ji)%c_name),  &
+               &                        REAL(tl_var%t_att(ji)%d_value(:),dp))
+         END SELECT
+         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+
+      ENDDO
+
+   END FUNCTION iom_cdf__write_var_def
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put variable value in an opened netcdf file.
+   !
+   !> @details
+   !> The variable is written in the type define in variable structure.
+   !> Only dimension used are printed, and fillValue in array are
+   !> replaced by default fill values defined in module netcdf for each type. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - reuse scale factor and offset, before writing variable
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] td_var    variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_cdf__write_var_value(td_file, td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      TYPE(TVAR),  INTENT(IN) :: td_var
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_order
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji, jj
+      !----------------------------------------------------------------
+
+      ! check which dimension use
+      CALL logger_trace( &
+      &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//&
+      &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
+   
+      ! use scale factor and offset
+      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+         td_var%d_value(:,:,:,:) = &
+         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf
+      END WHERE
+
+      jj=0
+      DO ji = 1, ip_maxdim
+         IF( td_var%t_dim(ji)%l_use )THEN
+            jj=jj+1
+            il_order(jj)=ji
+            il_shape(jj)=td_var%t_dim(ji)%i_len
+         ENDIF
+      ENDDO
+      ! dimension not use
+      DO ji = 1, ip_maxdim
+         IF( .NOT. td_var%t_dim(ji)%l_use )THEN
+            jj=jj+1
+            il_order(jj)=ji
+            il_shape(jj)=td_var%t_dim(ji)%i_len
+         ENDIF
+      ENDDO
+
+      ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3),il_shape(4) ) )
+
+      ! reshape array, so unused dimension won't be written
+      dl_value(:,:,:,:)=RESHAPE(source=td_var%d_value(:,:,:,:),&
+      &                         SHAPE = il_shape(:), &
+      &                         ORDER = il_order(:))
+
+      ! put value
+      CALL logger_debug( &
+      &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//&
+      &  "in file "//TRIM(td_file%c_name))
+
+      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:))
+      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE ("//&
+         &  TRIM(td_var%c_name)//") :" )
+
+      DEALLOCATE( dl_value )
+
+   END SUBROUTINE iom_cdf__write_var_value
+END MODULE iom_cdf
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90	(revision 8732)
@@ -0,0 +1,714 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: iom_dom
+!
+! DESCRIPTION:
+!> @brief This module allow to read domain (defined as domain structure) in a mpp files.
+!>
+!> @details
+!>    to read one variable in an mpp files over domain defined as domain structure:<br/>
+!> @code
+!>    tl_var=iom_dom_read_var( td_mpp, id_varid, td_dom ) 
+!> @endcode
+!>    or
+!> @code
+!>    tl_var=iom_dom_read_var( td_mpp, cd_name, td_dom ) 
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>       - id_varid is a variable id
+!>       - cd_name is variable name or standard name
+!>       - td_dom is a domain structure
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date October, 2014 - Initial Version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_dom
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! mpp manager
+   USe dom                             ! domain manager
+   USE iom_mpp                         ! I/O mpp manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_dom_open                    !< open files composing mpp structure over domain to be used
+   PUBLIC :: iom_dom_read_var                !< read one variable in an mpp structure over domain to be used
+   PUBLIC :: iom_dom_close                   !< close file composing mpp structure over domain
+
+   PRIVATE :: iom_dom__read_var_id           ! read one variable in an mpp structure, given variable id
+   PRIVATE :: iom_dom__read_var_name         ! read one variable in an mpp structure, given variable name
+   PRIVATE :: iom_dom__read_var_value        ! read variable value in an mpp structure
+   PRIVATE :: iom_dom__no_pole_no_overlap    ! do not overlap north fold boundary or east-west boundary
+   PRIVATE :: iom_dom__no_pole_cyclic        ! do not overlap north fold boundary. However uses cyclic east-west boundary
+   PRIVATE :: iom_dom__no_pole_overlap       ! do not overlap north fold boundary. However overlaps east-west boundary
+!   PRIVATE :: iom_dom__pole_no_overlap       ! overlaps north fold boundary. However do not overlap east-west boundary
+!   PRIVATE :: iom_dom__pole_cyclic           ! overlaps north fold boundary and uses cyclic east-west boundary
+!   PRIVATE :: iom_dom__pole_overlap          ! overlaps north fold boundary and east-west boundary
+
+   INTERFACE iom_dom_read_var                   ! read one variable in an mpp structure
+      MODULE PROCEDURE iom_dom__read_var_id     ! given variable id
+      MODULE PROCEDURE iom_dom__read_var_name   ! given variable name 
+   END INTERFACE iom_dom_read_var
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open files composing mpp structure 
+   !> over domain to be used.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[inout] td_mpp mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_dom_open(td_mpp, td_dom, id_perio, id_ew)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
+      TYPE(TDOM) , INTENT(IN)    :: td_dom
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM DOM OPEN: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! get processor to be used
+         CALL mpp_get_use( td_mpp, td_dom%i_imin, td_dom%i_imax, &
+         &                         td_dom%i_jmin, td_dom%i_jmax )
+
+         CALL iom_mpp_open(td_mpp, id_perio, id_ew)
+
+      ENDIF
+
+   END SUBROUTINE iom_dom_open
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close files composing mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_dom_close(td_mpp)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL iom_mpp_close(td_mpp)
+
+   END SUBROUTINE iom_dom_close
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files,
+   !> given variable id and domain strcuture.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] td_dom    domain structure
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_dom__read_var_id(td_mpp, id_varid, td_dom )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP) , INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN) :: id_varid
+      TYPE(TDOM) , INTENT(IN) :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM DOM READ VAR: domain decomposition "//&
+         &  "not define in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
+            ! look for variable id
+            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
+            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
+            IF( il_ind(1) /= 0 )THEN
+
+               iom_dom__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
+
+               !!! read variable value
+               CALL iom_dom__read_var_value(td_mpp, iom_dom__read_var_id, &
+               &                            td_dom)
+
+            ELSE
+               CALL logger_error( &
+               &  " IOM DOM READ VAR: there is no variable with id "//&
+               &  TRIM(fct_str(id_varid))//" in processor/file "//&
+               &  TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+         ELSE
+            CALL logger_error(" IOM DOM READ VAR: can't read variable, mpp "//&
+            &  TRIM(td_mpp%c_name)//" not opened")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_dom__read_var_id
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files, 
+   !> given variable name or standard name, and domain structure.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !> If variable name is not present, check variable standard name.<br/>
+   !
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] cd_name   variable name
+   !> @param[in] td_dom    domain structure
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_dom__read_var_name(td_mpp, cd_name, td_dom )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),       INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      TYPE(TDOM)      , INTENT(IN) :: td_dom
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM DOM READ VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+            il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
+            IF( il_ind /= 0 )THEN
+
+               iom_dom__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind))
+
+               !!! read variable value
+               CALL iom_dom__read_var_value( td_mpp, &
+               &                             iom_dom__read_var_name, &
+               &                             td_dom )
+
+            ELSE
+
+               CALL logger_error( &
+               &  " IOM DOM READ VAR: there is no variable with "//&
+               &  "name or standard name "//TRIM(cd_name)//&
+               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+
+      ENDIF
+ 
+   END FUNCTION iom_dom__read_var_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an mpp structure, given domain structure.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @todo
+   !> - handle north fold
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_dom__read_var_value(td_mpp, td_var, td_dom )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      TYPE(TDOM),   INTENT(IN)    :: td_dom
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+
+      TYPE(TATT)                        :: tl_att
+      TYPE(TMPP)                        :: tl_mpp
+      TYPE(TDOM)                        :: tl_dom
+
+      ! loop indices
+      INTEGER(i4)                       :: jk
+      !----------------------------------------------------------------
+
+      CALL logger_debug(" IOM DOM READ VAR VALUE: name "//&
+      &  TRIM(td_var%c_name)//" "//TRIM(td_var%c_point) )
+      CALL logger_debug(" IOM DOM READ VAR VALUE: ndim "//&
+      &  TRIM(fct_str(td_var%i_ndim)) )
+
+      ! copy mpp structure
+      tl_mpp=mpp_copy(td_mpp)
+      ! forced to keep same id
+      tl_mpp%t_proc(:)%i_id=td_mpp%t_proc(:)%i_id         
+
+      ! Allocate space to hold variable value in structure
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         DEALLOCATE(td_var%d_value)   
+      ENDIF
+      
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+      DO jk=1,ip_maxdim
+         IF( .NOT. td_var%t_dim(jk)%l_use ) tl_dom%t_dim(jk)%i_len = 1
+      ENDDO
+
+      ! use domain dimension 
+      td_var%t_dim(1:2)%i_len=tl_dom%t_dim(1:2)%i_len
+
+      ALLOCATE(td_var%d_value( tl_dom%t_dim(1)%i_len, &
+      &                        tl_dom%t_dim(2)%i_len, &
+      &                        td_var%t_dim(3)%i_len, &
+      &                        td_var%t_dim(4)%i_len),&
+      &        stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " IOM DOM READ VAR VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      CALL logger_debug("IOM DOM READ VAR VALUE: shape ("//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )         
+      ! FillValue by default
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      IF( tl_dom%i_perio0 < 3 .OR. &
+      &   tl_dom%i_jmax /= tl_dom%t_dim0(2)%i_len )THEN
+      ! no north pole
+
+         IF( (tl_dom%i_perio0 == 1 .OR. &
+         &    tl_dom%i_perio0 == 4 .OR. &
+         &    tl_dom%i_perio0 == 6) .AND. &
+         &   tl_dom%i_imin == 1 .AND. &
+         &   tl_dom%i_imax == tl_dom%t_dim0(1)%i_len )THEN
+         ! east west cyclic
+
+            CALL iom_dom__no_pole_cyclic(tl_mpp, td_var, tl_dom)
+
+         ELSEIF( tl_dom%i_imin <= tl_dom%i_imax )THEN
+         ! no east west overlap
+            
+            CALL iom_dom__no_pole_no_overlap(tl_mpp, td_var, tl_dom)
+
+            ! no more EW overlap in variable
+            td_var%i_ew=-1
+
+         ELSEIF( (tl_dom%i_perio0 == 1 .OR. &
+         &        tl_dom%i_perio0 == 4 .OR. &
+         &        tl_dom%i_perio0 == 6) .AND. &
+         &       tl_dom%i_imin > tl_dom%i_imax )THEN
+         ! east west overlap
+
+            CALL iom_dom__no_pole_overlap(tl_mpp, td_var, tl_dom)
+
+            ! no more EW overlap in variable
+            td_var%i_ew=-1
+
+         ELSE
+
+            CALL logger_fatal(" IOM DOM READ VAR VALUE: invalid domain definition.")
+
+         ENDIF
+
+      ELSE ! tl_dom%i_jmax == tl_dom%t_dim0(2)%i_len
+         ! north pole
+
+         CALL logger_error("IOM DOM READ VAR VALUE: "//&
+         &                 TRIM(fct_str(tl_dom%i_jmin))//" "//&
+         &                 TRIM(fct_str(tl_dom%i_jmax)) )
+         CALL logger_fatal("IOM DOM READ VAR VALUE: siren is not able to "//&
+         &                 "use north pole now, maybe in the next release")
+      !   IF( tl_dom%i_imin < tl_dom%i_imax )THEN
+      !   ! no east west overlap
+
+      !      CALL iom_dom__pole_no_overlap(tl_mpp, td_var, tl_dom)
+
+      !   ELSEIF(tl_dom%i_imin == tl_dom%i_imax)THEN
+      !   ! east west cyclic
+
+      !      CALL iom_dom__pole_cyclic(tl_mpp, td_var, tl_dom)
+
+      !    ELSE ! tl_dom%i_imin > tl_dom%i_imax
+      !    ! east west overlap
+
+      !      CALL iom_dom__pole_overlap(tl_mpp, td_var, tl_dom)
+
+      !   ENDIF
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_mpp)
+      CALL dom_clean(tl_dom)
+
+      IF( td_var%t_dim(1)%l_use .AND. &
+      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN
+         IF( td_mpp%i_ew >= 0 )THEN
+            tl_att=att_init("ew_overlap",td_mpp%i_ew)
+            CALL var_move_att(td_var,tl_att)
+            ! clean
+            CALL att_clean(tl_att)
+         ENDIF
+      ENDIF
+
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF      
+
+   END SUBROUTINE iom_dom__read_var_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain do not overlap
+   !> north fold boundary or east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_dom__no_pole_no_overlap(td_mpp, td_var, td_dom )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),  INTENT(IN)    :: td_mpp
+      TYPE(TVAR),  INTENT(INOUT) :: td_var
+      TYPE(TDOM),  INTENT(IN)    :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+
+      TYPE(TDOM)                :: tl_dom
+
+      ! loop indices
+      !----------------------------------------------------------------
+      
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+
+      ! change dimension length if not use
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN 
+         tl_dom%i_imin=1 ; tl_dom%i_imax=1
+      ENDIF
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN 
+         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
+      ENDIF
+
+      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
+
+      il_count(:)=(/tl_dom%i_imax-tl_dom%i_imin+1, &
+      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+      &             td_var%t_dim(3)%i_len, &
+      &             td_var%t_dim(4)%i_len/)
+
+      td_var=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+      &                       il_start(:), il_count(:) )
+
+      CALL dom_clean(tl_dom)
+
+   END SUBROUTINE iom_dom__no_pole_no_overlap
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read cyclic variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain do not overlap north fold boundary.
+   !> However it uses cyclic east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_dom__no_pole_cyclic(td_mpp, td_var, td_dom )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN   ) :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      TYPE(TDOM),   INTENT(IN   ) :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+
+      TYPE(TDOM)                :: tl_dom
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+
+      ! cyclic domain
+      tl_dom%i_imin=1
+      tl_dom%i_imax=tl_dom%t_dim(1)%i_len
+
+      ! change dimension length if not use
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN 
+         tl_dom%i_imin=1 ; tl_dom%i_imax=1
+      ENDIF
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN 
+         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
+      ENDIF
+
+      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
+
+      il_count(:)=(/tl_dom%i_imax-tl_dom%i_imin+1, &
+      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+      &             td_var%t_dim(3)%i_len, &
+      &             td_var%t_dim(4)%i_len /)
+
+      td_var=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+      &                       il_start(:), il_count(:) )
+
+      ! clean
+      CALL dom_clean(tl_dom)
+
+   END SUBROUTINE iom_dom__no_pole_cyclic
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read East West overlap variable value
+   !> in an mpp structure.
+   !> @details
+   !> The output domain do not overlap north fold boundary. 
+   !> However it overlaps east-west boundary. 
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_dom__no_pole_overlap(td_mpp, td_var, td_dom )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+
+      INTEGER(i4)               :: il_dim1
+      INTEGER(i4)               :: il_dim2
+
+      TYPE(TVAR)                :: tl_var1
+      TYPE(TVAR)                :: tl_var2
+
+      TYPE(TDOM)                :: tl_dom
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+
+      ! change dimension length if not use
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN 
+         tl_dom%i_imin=1 ; tl_dom%i_imax=1
+      ENDIF
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN 
+         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
+      ENDIF
+
+      ! get first part of domain
+      tl_var1=var_copy(td_var)
+      DEALLOCATE(tl_var1%d_value)
+
+      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
+
+      il_dim1 = td_mpp%t_dim(1)%i_len - td_mpp%i_ew - tl_dom%i_imin + 1
+
+      il_count(:)=(/il_dim1, &
+      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+      &             td_var%t_dim(3)%i_len, &
+      &             td_var%t_dim(4)%i_len /)
+
+      ! dimension part 1
+      tl_var1%t_dim(:)%i_len=il_count(:)
+
+      ALLOCATE(tl_var1%d_value(tl_var1%t_dim(1)%i_len, &
+      &                        tl_var1%t_dim(2)%i_len, &
+      &                        tl_var1%t_dim(3)%i_len, &
+      &                        tl_var1%t_dim(4)%i_len) )
+
+      tl_var1=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+      &                        il_start(:), il_count(:) )      
+
+      IF( td_var%t_dim(jp_I)%l_use )THEN
+         ! get second part of domain
+         tl_var2=var_copy(td_var)
+         DEALLOCATE(tl_var2%d_value)
+
+         il_start(:)=(/1,tl_dom%i_jmin,1,1/)
+
+         il_dim2 = tl_dom%i_imax
+
+         il_count(:)=(/il_dim2, &
+         &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+         &             td_var%t_dim(3)%i_len, &
+         &             td_var%t_dim(4)%i_len /)
+
+         ! dimension part 2
+         tl_var2%t_dim(:)%i_len=il_count(:)
+
+         ALLOCATE(tl_var2%d_value(tl_var2%t_dim(1)%i_len, &
+         &                        tl_var2%t_dim(2)%i_len, &
+         &                        tl_var2%t_dim(3)%i_len, &
+         &                        tl_var2%t_dim(4)%i_len) )
+
+         tl_var2=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+         &                        il_start(:), il_count(:) ) 
+
+         ! concatenate both part
+         td_var=var_concat(tl_var1, tl_var2, jp_I)
+      
+         ! clean
+         CALL var_clean(tl_var1)
+         CALL var_clean(tl_var2)
+      ELSE
+         td_var=var_copy(tl_var1)
+         ! clean
+         CALL var_clean(tl_var1)
+      ENDIF
+
+      ! clean
+      CALL dom_clean(tl_dom)
+
+   END SUBROUTINE iom_dom__no_pole_overlap
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read north fold variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain overlaps
+   !> north fold boundary. However it do not overlap east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+!   SUBROUTINE iom_dom__pole_no_overlap(td_mpp, td_var, td_dom )
+!      IMPLICIT NONE
+!      ! Argument      
+!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+!      TYPE(TVAR),   INTENT(INOUT) :: td_var
+!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+!
+!      ! local variable
+!
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!   END SUBROUTINE iom_dom__pole_no_overlap
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read semi global variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain overlaps north fold boundary.
+   !> and uses cyclic east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !> @return variable structure completed 
+   !-------------------------------------------------------------------
+!   SUBROUTINE iom_dom__pole_cyclic(td_mpp, td_var, td_dom )
+!      IMPLICIT NONE
+!      ! Argument      
+!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+!      TYPE(TVAR),   INTENT(INOUT) :: td_var
+!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+!
+!      ! local variable
+!
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!   END SUBROUTINE iom_dom__pole_cyclic
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read north fold East West overlap variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain overlaps north fold boundary. 
+   !> and east-west boundary. 
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !> @return variable structure completed 
+   !-------------------------------------------------------------------
+!   SUBROUTINE iom_dom__pole_overlap(td_mpp, td_var, td_dom )
+!      IMPLICIT NONE
+!      ! Argument      
+!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+!      TYPE(TVAR),   INTENT(INOUT) :: td_var
+!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+!
+!      ! local variable
+!
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!   END SUBROUTINE iom_dom__pole_overlap
+
+END MODULE iom_dom
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90	(revision 8732)
@@ -0,0 +1,658 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: iom_mpp
+!
+! DESCRIPTION:
+!> @brief This module manage massively parallel processing Input/Output manager.
+!> Library to read/write mpp files.
+!>
+!> @details
+!>    to open mpp files (only file to be used (see mpp_get_use) 
+!>    will be open):<br/>
+!> @code
+!>    CALL iom_mpp_open(td_mpp)
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>
+!>    to creates mpp files:<br/>
+!> @code
+!>    CALL iom_mpp_create(td_mpp)
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>
+!>    to write in mpp files :<br/>
+!> @code
+!>    CALL  iom_mpp_write_file(td_mpp)
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>
+!>    to close mpp files:<br/>
+!> @code
+!>    CALL iom_mpp_close(td_mpp)
+!> @endcode
+!>
+!>    to read one variable in an mpp files:<br/>
+!> @code
+!>    tl_var=iom_mpp_read_var( td_mpp, id_varid, [id_start, id_count] [,id_ew] ) 
+!> @endcode
+!>    or
+!> @code
+!>    tl_var=iom_mpp_read_var( td_mpp, cd_name, [id_start, id_count] [,id_ew] ) 
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>       - id_varid is a variable id
+!>       - cd_name is variable name or standard name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_ew East West overlap [optional]
+!>
+!>    to fill variable value in mpp structure:<br/>
+!> @code
+!>    CALL iom_mpp_fill_var(td_mpp, id_varid, [id_start, id_count] [,id_ew] )
+!> @endcode
+!>    or<br/>
+!> @code
+!>    CALL iom_mpp_fill_var(td_mpp, cd_name, [id_start, id_count] [,id_ew] )
+!> @endcode
+!>       - td_mpp is mpp structure
+!>       - id_varid is variable id
+!>       - cd_name is variable name or standard name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_ew East West overlap [optional]
+!>
+!>    to fill all variable in mpp structure:<br/>
+!> @code
+!>    CALL iom_mpp_fill_var(td_mpp, [id_start, id_count] [,id_ew] )
+!> @endcode
+!>       - td_mpp is mpp structure
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_ew East West overlap
+!>
+!>    to write files composong mpp strucutre:<br/>
+!> @code
+!>    CALL iom_mpp_write_file(td_mpp) 
+!> @endcode
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_mpp
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! mpp manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_mpp_open                    !< open all files composing mpp structure
+   PUBLIC :: iom_mpp_create                  !< creates files composing mpp structure
+   PUBLIC :: iom_mpp_close                   !< close file composing mpp structure
+   PUBLIC :: iom_mpp_read_var                !< read one variable in an mpp structure
+   PUBLIC :: iom_mpp_write_file              !< write mpp structure in files
+
+   PRIVATE :: iom_mpp__read_var_id           ! read one variable in an mpp structure, given variable id
+   PRIVATE :: iom_mpp__read_var_name         ! read one variable in an mpp structure, given variable name
+   PRIVATE :: iom_mpp__read_var_value        ! read variable value in an mpp structure
+
+   INTERFACE iom_mpp_read_var                   ! read one variable in an mpp structure
+      MODULE PROCEDURE iom_mpp__read_var_id     ! given variable id
+      MODULE PROCEDURE iom_mpp__read_var_name   ! given variable name 
+   END INTERFACE iom_mpp_read_var
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open files composing mpp structure to be used.
+   !> @details
+   !> If try to open a file in write mode that did not exist, create it.<br/>
+   !> 
+   !> If file already exist, get information about:
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> and finally read dimensions.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_mpp mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_open(td_mpp, id_perio, id_ew)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP) , INTENT(INOUT)  :: td_mpp
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP OPEN: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! 
+         td_mpp%i_id=1
+
+         ! if no processor file selected
+         ! force to open all files 
+         IF( .NOT. ANY( td_mpp%t_proc(:)%l_use ) )THEN
+            td_mpp%t_proc(:)%l_use=.TRUE.
+         ENDIF
+
+         ! add suffix to mpp name
+         td_mpp%c_name=file_add_suffix( TRIM(td_mpp%c_name), &
+                                      & TRIM(td_mpp%c_type) )
+
+         td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type) 
+         IF( td_mpp%i_nproc > 1 )THEN
+            DO ji=1,td_mpp%i_nproc
+               IF( td_mpp%t_proc(ji)%l_use )THEN
+
+                  SELECT CASE(TRIM(td_mpp%c_type))
+                  CASE('cdf')
+                     cl_name=TRIM( file_rename(td_mpp%c_name, ji-1) )
+                  CASE('dimg')
+                     cl_name=TRIM( file_rename(td_mpp%c_name, ji) )
+                  CASE DEFAULT
+                     CALL logger_fatal("IOM MPP OPEN: can not open file "//&
+                     &  "of type "//TRIM(td_mpp%c_type))
+                  END SELECT
+
+                  td_mpp%t_proc(ji)%c_name=TRIM(cl_name)
+
+                  CALL iom_open(td_mpp%t_proc(ji))
+
+               ENDIF
+            ENDDO
+         ELSE ! td_mpp%i_nproc == 1 
+               cl_name=TRIM( file_rename(td_mpp%c_name) )
+               td_mpp%t_proc(1)%c_name=TRIM(cl_name)
+
+               CALL iom_open(td_mpp%t_proc(1))
+         ENDIF
+
+         IF( PRESENT(id_ew) )THEN
+            td_mpp%i_ew=id_ew
+            ! add east west overlap to each variable
+            DO ji=1,td_mpp%i_nproc
+               WHERE(td_mpp%t_proc(ji)%t_var(:)%t_dim(1)%l_use)
+                  td_mpp%t_proc(ji)%t_var(:)%i_ew=td_mpp%i_ew
+               ENDWHERE
+            ENDDO
+         ENDIF
+
+         IF( PRESENT(id_perio) )THEN
+            td_mpp%i_perio=id_perio
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_mpp_open
+   !-------------------------------------------------------------------
+   !> @brief This subroutine create files, composing mpp structure to be used,
+   !> in write mode.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_mpp mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_create(td_mpp)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT)  :: td_mpp
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP CREATE: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! forced to open in write mode
+         td_mpp%t_proc(:)%l_wrt=.TRUE.
+         td_mpp%t_proc(:)%l_use=.TRUE.
+         CALL iom_mpp_open(td_mpp)
+      ENDIF
+
+   END SUBROUTINE iom_mpp_create
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close files composing mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_mpp mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_close(td_mpp)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP CLOSE: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! 
+         td_mpp%i_id=0         
+
+         DO ji=1,td_mpp%i_nproc
+            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
+               CALL iom_close(td_mpp%t_proc(ji))
+            ENDIF
+         ENDDO
+         td_mpp%t_proc(:)%l_use=.FALSE.
+      ENDIF
+
+   END SUBROUTINE iom_mpp_close
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files,
+   !> given variable id.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use start and count array instead of domain structure.
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,&
+   &                                        id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),                INTENT(IN) :: td_mpp
+      INTEGER(i4),               INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count      
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSEIF( td_mpp%i_id == 0 )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
+         &               " can not read variable in "//TRIM(td_mpp%c_name))   
+      
+      ELSE
+
+
+         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
+            ! look for variable id
+            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
+            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
+            IF( il_ind(1) /= 0 )THEN
+
+               iom_mpp__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
+
+               !!! read variable value
+               CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, &
+               &                            id_start, id_count)
+
+            ELSE
+               CALL logger_error( &
+               &  " IOM MPP READ VAR: there is no variable with id "//&
+               &  TRIM(fct_str(id_varid))//" in processor/file "//&
+               &  TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+         ELSE
+            CALL logger_error(" IOM MPP READ VAR: can't read variable, mpp "//&
+            &  TRIM(td_mpp%c_name)//" not opened")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_mpp__read_var_id
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files, 
+   !> given variable name or standard name.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !> If variable name is not present, check variable standard name.<br/>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use start and count array instead of domain structure.
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] cd_name   variable name
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    &
+   &                                          id_start, id_count )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),                INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*),          INTENT(IN) :: cd_name
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count      
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSEIF( td_mpp%i_id == 0 )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
+         &               " can not read variable in "//TRIM(td_mpp%c_name))   
+      
+      ELSE
+
+            il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
+            IF( il_ind /= 0 )THEN
+
+               iom_mpp__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind))
+
+               !!! read variable value
+               CALL iom_mpp__read_var_value( td_mpp, &
+               &                             iom_mpp__read_var_name, &
+               &                             id_start, id_count)
+
+            ELSE
+
+               CALL logger_fatal( &
+               &  " IOM MPP READ VAR: there is no variable with "//&
+               &  "name or standard name "//TRIM(cd_name)//&
+               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+
+      ENDIF
+      
+   END FUNCTION iom_mpp__read_var_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an mpp structure.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use start and count array instead of domain structure.
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, &
+   &                                  id_start, id_count )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count      
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4), DIMENSION(4)         :: il_ind
+      INTEGER(i4)                       :: il_i1p
+      INTEGER(i4)                       :: il_i2p
+      INTEGER(i4)                       :: il_j1p
+      INTEGER(i4)                       :: il_j2p
+      INTEGER(i4)                       :: il_i1
+      INTEGER(i4)                       :: il_i2
+      INTEGER(i4)                       :: il_j1
+      INTEGER(i4)                       :: il_j2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_end
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count      
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt      
+
+      TYPE(TATT)                        :: tl_att
+      TYPE(TVAR)                        :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      il_start(:)=1
+      IF( PRESENT(id_start) ) il_start(:)=id_start(:)
+
+      il_count(:)=td_mpp%t_dim(:)%i_len
+      IF( PRESENT(id_count) ) il_count(:)=id_count(:)
+
+      CALL logger_debug("IOM MPP READ VAR VALUE: start "//&
+               &  TRIM(fct_str(il_start(jp_I)))//","//&
+               &  TRIM(fct_str(il_start(jp_J)))//","//&
+               &  TRIM(fct_str(il_start(jp_K)))//","//&
+               &  TRIM(fct_str(il_start(jp_L))) )
+      CALL logger_debug("IOM MPP READ VAR VALUE: count "//&
+               &  TRIM(fct_str(il_count(jp_I)))//","//&
+               &  TRIM(fct_str(il_count(jp_J)))//","//&
+               &  TRIM(fct_str(il_count(jp_K)))//","//&
+               &  TRIM(fct_str(il_count(jp_L))) )
+
+      DO jk=1,ip_maxdim
+         IF( .NOT. td_var%t_dim(jk)%l_use )THEN
+            il_start(jk) = 1
+            il_count(jk) = 1
+         ENDIF
+
+         il_end(jk)=il_start(jk)+il_count(jk)-1
+      ENDDO
+
+      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN
+            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//&
+               &  TRIM(fct_str(il_end(jp_I)))//","//&
+               &  TRIM(fct_str(il_end(jp_J)))//","//&
+               &  TRIM(fct_str(il_end(jp_K)))//","//&
+               &  TRIM(fct_str(il_end(jp_L))) )
+            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) )
+            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//&
+            &                 "exceed dimension bound.")
+      ENDIF
+
+      ! use domain dimension 
+      td_var%t_dim(:)%i_len=il_count(:)
+
+      ! Allocate space to hold variable value in structure
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         DEALLOCATE(td_var%d_value)   
+      ENDIF
+
+      ALLOCATE(td_var%d_value( il_count(1), &
+      &                        il_count(2), &
+      &                        il_count(3), &
+      &                        il_count(4)),&
+      &        stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " IOM MPP READ VAR VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      CALL logger_debug("IOM MPP READ VAR VALUE: shape ("//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )
+      ! FillValue by default
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      ! read processor 
+      DO jk=1,td_mpp%i_nproc
+         IF( td_mpp%t_proc(jk)%l_use )THEN
+             
+            ! get processor indices
+            il_ind(:)=mpp_get_proc_index( td_mpp, jk )
+            il_i1p = il_ind(1)
+            il_i2p = il_ind(2)
+            il_j1p = il_ind(3)
+            il_j2p = il_ind(4)
+ 
+            IF( .NOT. td_var%t_dim(1)%l_use )THEN
+               il_i1p=il_start(1) ; il_i2p=il_end(1)
+            ENDIF
+            IF( .NOT. td_var%t_dim(2)%l_use )THEN
+               il_j1p=il_start(2) ; il_j2p=il_end(2)
+            ENDIF            
+            
+            il_i1=MAX(il_i1p, il_start(1))
+            il_i2=MIN(il_i2p, il_end(1))
+
+            il_j1=MAX(il_j1p, il_start(2))
+            il_j2=MIN(il_j2p, il_end(2))
+
+            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN
+               il_strt(:)=(/ il_i1-il_i1p+1, &
+               &             il_j1-il_j1p+1, &
+               &             1,1 /)
+
+               il_cnt(:)=(/ il_i2-il_i1+1,         &
+               &            il_j2-il_j1+1,         &
+               &            td_var%t_dim(3)%i_len, &
+               &            td_var%t_dim(4)%i_len /)
+
+               tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,&
+               &                    il_strt(:), il_cnt(:) )
+               ! replace value in output variable structure
+               td_var%d_value( il_i1 - il_start(1) + 1 : &
+               &               il_i2 - il_start(1) + 1,  &
+               &               il_j1 - il_start(2) + 1 : &
+               &               il_j2 - il_start(2) + 1,  &
+               &               :,:) = tl_var%d_value(:,:,:,:)
+
+               ! clean
+               CALL var_clean(tl_var)
+            ENDIF
+
+         ENDIF
+      ENDDO
+
+      IF( td_var%t_dim(1)%l_use .AND. &
+      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN
+         IF( td_mpp%i_ew >= 0 )THEN
+            tl_att=att_init("ew_overlap",td_mpp%i_ew)
+            CALL var_move_att(td_var,tl_att)
+            ! clean 
+            CALL att_clean(tl_att)
+         ENDIF
+      ENDIF
+
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF      
+
+   END SUBROUTINE iom_mpp__read_var_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write files composing mpp structure.
+   !
+   !> @details
+   !> optionally, you could specify the dimension order (default 'xyzt')
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option 
+   !
+   !> @param[inout] td_mpp mpp structure
+   !> @param[In] cd_dimorder dimension order
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " MPP WRITE: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         DO ji=1, td_mpp%i_nproc
+            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
+               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder)
+            ELSE
+               CALL logger_debug( " MPP WRITE: no id associated to file "//&
+               &              TRIM(td_mpp%t_proc(ji)%c_name) )
+            ENDIF
+         ENDDO
+      ENDIF
+   END SUBROUTINE iom_mpp_write_file
+END MODULE iom_mpp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90	(revision 8732)
@@ -0,0 +1,1748 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: iom_rstdimg
+!
+! DESCRIPTION:
+!> @brief
+!> This module is a library to read/write dimg file.
+!>
+!> @details
+!>    to open dimg file (create file structure):<br/>
+!> @code
+!>    CALL iom_rstdimg_open(td_file)
+!> @endcode
+!>       - td_file is file structure (see file.f90)
+!>
+!>    to write in dimg file:<br/>
+!> @code
+!>    CALL  iom_rstdimg_write_file(td_file)
+!> @endcode
+!>
+!>    to close dimg file:<br/>
+!> @code
+!>    CALL iom_rstdimg_close(tl_file)
+!> @endcode
+!>
+!>    to read one dimension in dimg file:<br/>
+!> @code
+!>    tl_dim = iom_rstdimg_read_dim(tl_file, id_dimid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_dim = iom_rstdimg_read_dim(tl_file, cd_name)
+!> @endcode
+!>       - id_dimid is dimension id<br/>
+!>       - cd_name is dimension name
+!>
+!>    to read one variable in dimg file:<br/>
+!> @code
+!>    tl_var = iom_rstdimg_read_var(td_file, id_varid, [id_start, id_count])
+!> @endcode
+!>    or
+!> @code
+!>    tl_var = iom_rstdimg_read_var(td_file, cd_name, [id_start, [id_count]])
+!> @endcode
+!>       - id_varid is variabale id
+!>       - cd_name is variabale name or standard name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>
+!>    to get sub domain decomppistion in a dimg file:<br/>
+!> @code
+!>    CALL iom_rstdimg_get_mpp(td_file)
+!> @endcode
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_rstdimg
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PRIVATE ::  im_vnl !< variable name length 
+
+   ! function and subroutine
+   PUBLIC :: iom_rstdimg_open        !< open or create dimg file, return file structure
+   PUBLIC :: iom_rstdimg_close       !< close dimg file
+   PUBLIC :: iom_rstdimg_read_dim    !< read one dimension in an opened dimg file, return variable structure
+   PUBLIC :: iom_rstdimg_read_var    !< read one variable  in an opened dimg file, return dimension structure
+   PUBLIC :: iom_rstdimg_write_file  !< write file structure contents in an opened dimg file
+   PUBLIC :: iom_rstdimg_get_mpp     !< get sub domain decomppistion in a dimg file
+
+   PRIVATE :: iom_rstdimg__get_info        ! get global information in an opened dimg file
+   PRIVATE :: iom_rstdimg__get_file_var    ! read information about variable on an opened dimg file.
+   PRIVATE :: iom_rstdimg__get_file_var_0d ! put information about scalar variable in file structure
+   PRIVATE :: iom_rstdimg__get_file_var_1d ! put information about variable 1D in file structure
+   PRIVATE :: iom_rstdimg__get_file_var_2d ! put information about variable 2D in file structure
+   PRIVATE :: iom_rstdimg__get_file_var_3d ! put information about variable 3D in file structure
+   PRIVATE :: iom_rstdimg__read_dim_id     ! read dimension structure in an opened dimg file, given variable id.
+   PRIVATE :: iom_rstdimg__read_dim_name   ! read dimension structure in an opened dimg file, given variable name or standard name.
+   PRIVATE :: iom_rstdimg__read_var_id     ! read variable value in an opened dimg file, given variable id.
+   PRIVATE :: iom_rstdimg__read_var_name   ! read variable value in an opened dimg file, given variable name or standard name.
+   PRIVATE :: iom_rstdimg__read_var_value  ! read variable value in an opened dimg file, for variable 1,2,3d
+   PRIVATE :: iom_rstdimg__get_rec         ! compute record number before writing file
+   PRIVATE :: iom_rstdimg__write_header    ! write header in an opened dimg file
+   PRIVATE :: iom_rstdimg__write_var       ! write variables in an opened dimg file 
+
+   ! module variable
+   INTEGER(i4), PARAMETER :: im_vnl = 32 ! variable name length
+
+   INTERFACE iom_rstdimg_read_dim
+      MODULE PROCEDURE iom_rstdimg__read_dim_id
+      MODULE PROCEDURE iom_rstdimg__read_dim_name
+   END INTERFACE iom_rstdimg_read_dim
+
+   INTERFACE iom_rstdimg_read_var
+      MODULE PROCEDURE iom_rstdimg__read_var_id
+      MODULE PROCEDURE iom_rstdimg__read_var_name
+   END INTERFACE iom_rstdimg_read_var
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open a dimg file in read or write mode.
+   !> @details
+   !> if try to open a file in write mode that did not exist, create it.<br/>
+   !> if file already exist, get information about:
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> Finally it read dimensions, and 'longitude' variable to compute East-West
+   !> overlap.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg_open(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+
+      ! local variable
+      LOGICAL           :: ll_exist
+      LOGICAL           :: ll_open
+
+      INTEGER(i4)       :: il_status
+      !----------------------------------------------------------------
+
+      ! check file existence
+      ! WARNING may be some issue with dimg file !!!
+      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
+      IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'dimg' )THEN
+
+         IF( .NOT. td_file%l_wrt )THEN
+
+            CALL logger_fatal( " OPEN: can not open dimg file "//&
+            &               TRIM(td_file%c_name) )
+         
+         ELSE
+
+            CALL logger_info( " CREATE: dimg file "//TRIM(td_file%c_name) )
+
+            ! get free unit
+            td_file%i_id=fct_getunit()
+
+            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+            &                         FORM='UNFORMATTED',              &
+            &                         ACCESS='DIRECT',                 &
+            &                         STATUS='NEW',                    &
+            &                         ACTION='WRITE',                  &
+            &                         RECL=8,                          &
+            &                         IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("CREATE: dimg file "//&
+               &              TRIM(td_file%c_name))
+            ENDIF
+
+         ENDIF
+
+      ELSE
+
+         IF( ll_open )THEN
+
+            CALL logger_error( " OPEN: dimg file "//&
+            &                TRIM(td_file%c_name)//" already opened")
+
+         ELSE
+
+            ! get free unit
+            td_file%i_id=fct_getunit()
+
+            ! open temporary in read only mode
+            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+            &                         FORM='UNFORMATTED',              &
+            &                         ACCESS='DIRECT',                 &
+            &                         STATUS='OLD',                    &
+            &                         ACTION='READ',                   &
+            &                         RECL=8,                          &
+            &                         IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("OPEN: file "//TRIM(td_file%c_name))
+            ENDIF
+
+            ! get record length
+            READ( td_file%i_id, IOSTAT=il_status, &
+            &                         REC=1) td_file%i_recl
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("OPEN: read record length : "//&
+               &    TRIM(fct_str(td_file%i_recl))//" in file "//&
+               &    TRIM(td_file%c_name) )
+            ENDIF
+
+            CLOSE( td_file%i_id, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("OPEN: close file "//TRIM(td_file%c_name))
+            ENDIF
+
+            IF( .NOT. td_file%l_wrt )THEN
+
+               CALL logger_info( " OPEN: dimg file "//&
+               &              TRIM(td_file%c_name)//" in read only mode" )
+
+               ! open file in read mode
+               OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+               &                         FORM='UNFORMATTED',              &
+               &                         ACCESS='DIRECT',                 &
+               &                         STATUS='OLD',                    &
+               &                         ACTION='READ',                   &
+               &                         RECL=td_file%i_recl,    &
+               &                         IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_debug("IOM RSTDIMG OPEN: open staus "//&
+                  &  TRIM(fct_str(il_status)))
+                  CALL logger_fatal("IOM RSTDIMG OPEN: file "//&
+                  &  TRIM(td_file%c_name)&
+                  &  //" with record length "//TRIM(fct_str(td_file%i_recl)))
+               ENDIF               
+
+            ELSE
+
+               CALL logger_info( " OPEN: dimg file "//&
+               &              TRIM(td_file%c_name)//&
+               &              " in read and write mode")
+
+               ! open file in read mode
+               OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+               &                         FORM='UNFORMATTED',              &
+               &                         ACCESS='DIRECT',                 &
+               &                         STATUS='OLD',                    &
+               &                         ACTION='READWRITE',              &
+               &                         RECL=td_file%i_recl,    &
+               &                         IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_debug("IOM RSTDIMG OPEN: open staus "//&
+                  &  TRIM(fct_str(il_status)))
+                  CALL logger_error("IOM RSTDIMG  OPEN: file "//&
+                  & TRIM(td_file%c_name))
+               ENDIF        
+
+            ENDIF
+
+            ! get general information about file
+            CALL iom_rstdimg__get_info(td_file)
+
+            ! get domain decomposition in file
+            CALL iom_rstdimg_get_mpp(td_file)
+
+            ! get information about variables in file
+            CALL iom_rstdimg__get_file_var(td_file)
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_open
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close dimg file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg_close(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " CLOSE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE      
+         CALL logger_info( &
+         &  " CLOSE: file "//TRIM(td_file%c_name))
+
+         CLOSE( td_file%i_id, IOSTAT=il_status )
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_error("CLOSE "//TRIM(td_file%c_name))
+         ENDIF
+
+         td_file%i_id = 0 
+
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_close
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get global information in an opened dimg 
+   !> file.
+   !> @details
+   !> It gets the number of variables, the  domain decompistion, 
+   !> the record of the header.<br/>
+   !> It read dimensions, and add it to dimension structure inside 
+   !> file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_info(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_recl                          ! record length 
+      INTEGER(i4) :: il_nx, il_ny, il_nz              ! x,y,z dimension 
+      INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables 
+      INTEGER(i4) :: il_rhd                           ! record of the header infos
+
+      TYPE(TDIM)  :: tl_dim ! dimension structure 
+      !----------------------------------------------------------------
+
+      CALL logger_debug( &
+      &  " IOM RSTDIMG GET INFO: about dimg file "//TRIM(td_file%c_name))
+
+      ! read first record 
+      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+      &     il_recl,                         &
+      &     il_nx, il_ny, il_nz,             &
+      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+      &     il_rhd
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_debug(" READ status: "//TRIM(fct_str(il_status)))
+         CALL logger_fatal("IOM RSTDIMG GET INFO: read first line of "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+      td_file%c_type='dimg'
+
+      ! add dimension to file structure
+      tl_dim=dim_init('X', il_nx)
+      CALL file_move_dim(td_file, tl_dim)
+      tl_dim=dim_init('Y', il_ny)
+      CALL file_move_dim(td_file, tl_dim)
+      tl_dim=dim_init('Z', il_nz)
+      CALL file_move_dim(td_file, tl_dim)
+
+      ! reorder dimension to ('x','y','z','t')
+      ! actually fill unused dimension
+      CALL dim_reorder(td_file%t_dim)
+
+      ! save total number of variable 
+      td_file%i_n0d=il_n0d
+      td_file%i_n1d=il_n1d
+      td_file%i_n2d=il_n2d
+      td_file%i_n3d=il_n3d
+      td_file%i_nvar=il_n0d+il_n1d+il_n2d+il_n3d
+
+      ! record header infos
+      td_file%i_rhd=il_rhd
+
+   END SUBROUTINE iom_rstdimg__get_info
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get sub domain decomposition in a dimg file.
+   !> @details
+   !> domain decomposition informations are saved in attributes.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg_get_mpp(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TATT)  :: tl_att
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_recl                          ! record length 
+      INTEGER(i4) :: il_nx, il_ny, il_nz              ! x,y,z dimension 
+      INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables 
+      INTEGER(i4) :: il_iglo, il_jglo                 ! domain global size
+      INTEGER(i4) :: il_rhd                           ! record of the header infos
+      INTEGER(i4) :: il_niproc, il_njproc, il_nproc   ! domain decomposition
+      INTEGER(i4) :: il_area                          ! domain index
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      !----------------------------------------------------------------
+
+      CALL logger_debug( " IOM RSTDIMG GET MPP: dimg file "//&
+      &  TRIM(td_file%c_name))
+
+      ! read first record 
+      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+      &     il_recl,                         &
+      &     il_nx, il_ny, il_nz,             &
+      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+      &     il_rhd,                          &
+      &     il_niproc, il_njproc, il_nproc,  &
+      &     il_area,                         &
+      &     il_iglo, il_jglo
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//&
+         &  TRIM(fct_str(il_status)))
+         CALL logger_error(" IOM RSTDIMG GET MPP: read first line of "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+      ! create attributes to save mpp value
+      tl_att=att_init( "DOMAIN_number_total", il_nproc)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_I_number_total", il_niproc)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_J_number_total", il_njproc)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_number", il_area)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_size_global", (/il_iglo, il_jglo/))
+      CALL file_move_att(td_file, tl_att)
+
+      ! allocate local variable
+      ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
+      &         il_lci(il_nproc),  il_lcj(il_nproc), &
+      &         il_ldi(il_nproc),  il_ldj(il_nproc), &
+      &         il_lei(il_nproc),  il_lej(il_nproc), &
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+         CALL logger_error( " IOM RSTDIMG GET MPP: not enough space to put "//&
+         &  "domain decomposition in file "//TRIM(td_file%c_name) )
+
+      ENDIF
+
+      ! read first record 
+      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+      &     il_recl,                         &
+      &     il_nx, il_ny, il_nz,             &
+      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+      &     il_rhd,                          &
+      &     il_niproc, il_njproc, il_nproc,  &
+      &     il_area,                         &
+      &     il_iglo, il_jglo,                &
+      &     il_lci(:), il_lcj(:),            &
+      &     il_ldi(:), il_ldj(:),            &
+      &     il_lei(:), il_lej(:),            &
+      &     il_impp(:),il_jmpp(:)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//&
+         &  TRIM(fct_str(il_status)))
+         CALL logger_fatal("IOM RSTDIMG GET MPP: read domain decomposition "//&
+         &           "on first line of "//TRIM(td_file%c_name))
+      ENDIF
+
+      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", il_impp(:) )
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", il_jmpp(:) )
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_I_dimensions", il_lci(:))
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_dimensions", il_lcj(:))
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", il_ldi(:))
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", il_ldj(:))
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", il_lei(:))
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", il_lej(:))
+      CALL file_move_att(td_file, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+      DEALLOCATE( il_impp, il_jmpp,&
+      &           il_lci,  il_lcj, &
+      &           il_ldi,  il_ldj, &
+      &           il_lei,  il_lej  )
+
+   END SUBROUTINE iom_rstdimg_get_mpp
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read information about variable on an 
+   !> opened dimg file.
+   !> @details
+   !> The variables structures inside file structure are then completed.
+   !> Variables no0d, no1d, no2d, no3d are deleted from file strucutre.
+   !> @note variable value are read only for scalar variable (0d).
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_file_var(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      CHARACTER(LEN=im_vnl), DIMENSION(:), ALLOCATABLE :: cl_name
+
+      REAL(dp)             , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      INTEGER(i4)                                      :: il_status
+      INTEGER(i4)          , DIMENSION(:), ALLOCATABLE :: il_start
+      INTEGER(i4)          , DIMENSION(:), ALLOCATABLE :: il_count
+
+      !----------------------------------------------------------------
+
+      IF( td_file%i_nvar > 0 )THEN
+
+         ALLOCATE( il_start(4), il_count(4) )
+
+         il_start(1) = 1
+         il_count(1) = td_file%i_n0d
+         
+         il_start(2) = 1 + il_count(1)
+         il_count(2) = il_start(2) - 1 + td_file%i_n1d
+         
+         il_start(3) = 1 + il_count(2)
+         il_count(3) = il_start(3) - 1 + td_file%i_n2d
+         
+         il_start(4) = 1 + il_count(3)
+         il_count(4) = il_start(4) - 1 + td_file%i_n3d
+         
+         ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
+
+         ! read first record 
+         READ( td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )& 
+         & cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
+         & cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
+         & cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
+         & cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_error("GET FILE: reading headers in file "//&
+            &   TRIM(td_file%c_name))
+         ENDIF
+
+         DEALLOCATE( il_start, il_count )
+
+         IF(ASSOCIATED(td_file%t_var))THEN
+            CALL var_clean(td_file%t_var(:))
+            DEALLOCATE(td_file%t_var)
+         ENDIF
+         ALLOCATE(td_file%t_var(td_file%i_nvar))
+
+         ! put information about variable 0D inside file structure
+         CALL iom_rstdimg__get_file_var_0d(td_file, cl_name(:), dl_value(:))
+
+         ! put information about variable 1D inside file structure
+         CALL iom_rstdimg__get_file_var_1d(td_file, cl_name(:), dl_value(:))
+
+         ! put information about variable 2D inside file structure
+         CALL iom_rstdimg__get_file_var_2d(td_file, cl_name(:), dl_value(:))
+
+         ! put information about variable 3D inside file structure
+         CALL iom_rstdimg__get_file_var_3d(td_file, cl_name(:), dl_value(:))
+
+         DEALLOCATE( cl_name, dl_value )
+
+         ! delete dummy variable
+         CALL file_del_var( td_file, 'no0d' )
+         CALL file_del_var( td_file, 'no1d' )
+         CALL file_del_var( td_file, 'no2d' )
+         CALL file_del_var( td_file, 'no3d' )
+
+      ELSE
+
+         CALL logger_debug( &
+         &  " GET FILE VAR: there is no variable in file "//&
+         &  TRIM(td_file%c_name))
+
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg__get_file_var
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about scalar variable 
+   !> inside file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable value
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_file_var_0d(td_file, cd_name, dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! define same dimension as in file
+      tl_dim(:)=dim_copy(td_file%t_dim(:))
+      ! do not use any dimension
+      tl_dim(:)%l_use=.FALSE.
+      tl_dim(:)%i_len=1
+      
+      ! case scalar variable
+      DO ji = 1, td_file%i_n0d
+   
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=1 )
+
+         ! get value of scalar
+         IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
+            DEALLOCATE(td_file%t_var(ji)%d_value)
+         ENDIF
+         ALLOCATE(td_file%t_var(ji)%d_value(1,1,1,1))
+
+         td_file%t_var(ji)%d_value(1,1,1,1)=dd_value(ji)
+
+      ENDDO
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END SUBROUTINE iom_rstdimg__get_file_var_0d
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about variable 1D 
+   !> inside file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable record
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_file_var_1d(td_file, cd_name, dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! case variable 1D
+      DO ji = td_file%i_n0d + 1, &
+      &       td_file%i_n0d + td_file%i_n1d
+
+         ! define same dimension as in file
+         tl_dim(:)=dim_copy(td_file%t_dim(:))
+         ! do not use X and Y dimension
+         td_file%t_var(ji)%t_dim(1:2)%l_use=.FALSE.
+         td_file%t_var(ji)%t_dim(1:2)%i_len=1
+      
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDDO
+
+   END SUBROUTINE iom_rstdimg__get_file_var_1d
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about variable 2D 
+   !> inside file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable record
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_file_var_2d(td_file, cd_name, dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! case variable 2D (X,Y)
+      DO ji = td_file%i_n0d + td_file%i_n1d + 1 , &
+      &       td_file%i_n0d + td_file%i_n1d + td_file%i_n2d
+
+         ! define same dimension as in file
+         tl_dim(:)=dim_copy(td_file%t_dim(:))
+         ! do not use Z dimension
+         tl_dim(3)%l_use=.FALSE.
+         tl_dim(3)%i_len=1       
+
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDDO
+
+   END SUBROUTINE iom_rstdimg__get_file_var_2d
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about variable 3D 
+   !> inside file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable record
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_file_var_3d(td_file, cd_name, dd_value)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! case variable 3D (X,Y,Z)
+      DO ji = td_file%i_n0d + td_file%i_n1d + td_file%i_n2d +1 , &
+      &       td_file%i_n0d + td_file%i_n1d + td_file%i_n2d + td_file%i_n3d
+
+         ! define same dimension as in file
+         tl_dim(:)=dim_copy(td_file%t_dim(:)) 
+
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDDO
+
+   END SUBROUTINE iom_rstdimg__get_file_var_3d
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension id.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_dimid  dimension id
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_id(td_file, id_dimid)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_dimid
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
+
+      ELSE      
+
+         iom_rstdimg__read_dim_id%i_id=id_dimid
+
+         CALL logger_debug( &
+         &  " READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name))
+
+         IF( id_dimid <= 4 )THEN
+            iom_rstdimg__read_dim_id=td_file%t_dim(id_dimid)
+         ELSE
+            CALL logger_error( &
+            &  " READ DIM: no dimension with id "//TRIM(fct_str(id_dimid))//&
+            &  " in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_rstdimg__read_dim_id
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension name.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   dimension name
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+   TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_name(td_file, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
+
+      ELSE      
+
+         il_dimid=dim_get_id(td_file%t_dim(:), TRIM(cd_name))
+         IF( il_dimid /= 0 )THEN
+            iom_rstdimg__read_dim_name=iom_rstdimg_read_dim(td_file, il_dimid)
+         ELSE
+            CALL logger_error( &
+            &  " READ DIM: no dimension "//TRIM(cd_name)//&
+            &  " in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_rstdimg__read_dim_name
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> dimg file, given variable id.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_rstdimg__read_var_id(td_file, id_varid,&
+   &                                            id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN) :: td_file
+      INTEGER(i4),               INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! look for variable id
+         il_varid(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
+         IF( il_varid(1) /= 0 )THEN
+
+            iom_rstdimg__read_var_id=var_copy(td_file%t_var(il_varid(1)))
+
+            IF( iom_rstdimg__read_var_id%i_ndim /= 0 )THEN
+               !!! read variable value
+               CALL iom_rstdimg__read_var_value( td_file, &
+               &                                 iom_rstdimg__read_var_id, &
+               &                                 id_start, id_count)
+            ELSE
+               CALL logger_debug( " READ VAR: variable 0d "//&
+               &               TRIM(td_file%t_var(il_varid(1))%c_name)//&
+               &               " should be already read ")
+            ENDIF            
+
+         ELSE
+            CALL logger_error( &
+            &  " READ VAR: there is no variable with id "//&
+            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+   END FUNCTION iom_rstdimg__read_var_id
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> dimg file, given variable name or standard name.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   variable name or standard name 
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION iom_rstdimg__read_var_name(td_file, cd_name,   &
+   &                                              id_start, id_count  )
+      IMPLICIT NONE
+      ! Argument 
+      TYPE(TFILE),                     INTENT(IN) :: td_file
+      CHARACTER(LEN=*),                INTENT(IN) :: cd_name
+      INTEGER(i4),      DIMENSION(:),  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4),      DIMENSION(:),  INTENT(IN), OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         il_varid=var_get_index(td_file%t_var(:), cd_name)
+         IF( il_varid /= 0 )THEN
+
+            iom_rstdimg__read_var_name=var_copy(td_file%t_var(il_varid))
+
+            IF( td_file%t_var(il_varid)%i_ndim /= 0 )THEN
+               !!! read variable value
+               CALL iom_rstdimg__read_var_value( td_file, &
+               &                                 iom_rstdimg__read_var_name, &
+               &                                 id_start, id_count)
+            ELSE
+               CALL logger_debug( " READ VAR: variable 0d "//&
+               &               TRIM(td_file%t_var(il_varid)%c_name)//&
+               &               " should have been already read ")
+            ENDIF
+
+         ELSE
+
+            CALL logger_error( &
+            &  " READ VAR NAME: there is no variable with "//&
+            &  " name or standard name "//TRIM(cd_name)//&
+            &  " in file "//TRIM(td_file%c_name) )
+
+         ENDIF
+
+      ENDIF
+      
+   END FUNCTION iom_rstdimg__read_var_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value in an opened dimg file, for
+   !> variable 1,2,3d.
+   !> @details
+   !> Optionaly,start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2016
+   !> - use temporary array to read value from file
+   !
+   !> @param[in] td_file   file structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_start  index in the variable from which the data values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__read_var_value(td_file, td_var, &
+   &                                      id_start, id_count )
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN)    :: td_file
+      TYPE(TVAR) ,               INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_tmp1, il_tmp2
+      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
+
+      REAL(dp),    DIMENSION(:,:,:)  , ALLOCATABLE :: dl_tmp
+      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check id_count and id_start optionals parameters...
+      IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
+          ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
+         CALL logger_warn( &
+         &  " READ VAR VALUE: id_start and id_count should be both specify")
+      ENDIF
+
+      IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
+
+         IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
+         &   SIZE(id_count(:)) /= ip_maxdim )THEN
+            CALL logger_error("READ VAR: dimension of array start or count "//&
+            &      " are invalid to read variable "//TRIM(td_var%c_name)//&
+            &      " in file "//TRIM(td_file%c_name) )
+         ENDIF
+
+         ! dimension order assume to be ('x','y','z','t')
+         il_start(:)=id_start(:)
+         il_count(:)=id_count(:)
+
+      ELSE
+
+         ! dimension order assume to be ('x','y','z','t')
+         il_start(:)=(/1,1,1,1/)
+         il_count(:)=td_var%t_dim(:)%i_len
+
+      ENDIF
+
+      ! check dimension
+      IF( .NOT. ALL(il_start(:)>=(/1,1,1,1/)) )THEN
+
+         CALL logger_error( " READ VAR VALUE: "//&
+         &               " start indices should be greater than or equal to 1")
+
+      ENDIF
+
+      IF(.NOT.ALL(il_start(:)+il_count(:)-1<=(/td_var%t_dim(1)%i_len,&
+         &                                     td_var%t_dim(2)%i_len,&
+         &                                     td_var%t_dim(3)%i_len,&
+         &                                     td_var%t_dim(4)%i_len &
+         &                                    /)) )THEN
+
+         CALL logger_error( " READ VAR VALUE: "//&
+         &               "start + count exceed variable dimension" )
+
+         DO ji = 1, ip_maxdim
+            il_tmp1=il_start(ji)+il_count(ji)-1
+            il_tmp2=td_var%t_dim(ji)%i_len
+            CALL logger_debug( &
+            &  " READ VAR VALUE: start + count - 1 "//TRIM(fct_str(il_tmp1))//&
+            &  " variable dimension"//TRIM(fct_str(il_tmp2)))
+         ENDDO
+
+      ELSE
+
+         ! Allocate space to hold variable value
+         ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
+         &                  td_var%t_dim(2)%i_len, &
+         &                  td_var%t_dim(3)%i_len, &
+         &                  td_var%t_dim(4)%i_len),&
+         &        stat=il_status)
+         IF(il_status /= 0 )THEN
+
+           CALL logger_error( &
+            &  " READ VAR VALUE: not enough space to put variable "//&
+            &  TRIM(td_var%c_name)//&
+            &  " in temporary array")
+
+         ENDIF
+
+         ! read values
+         CALL logger_trace( &
+         &  " READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
+         &  " in file "//TRIM(td_file%c_name))     
+
+         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
+            ! 3D variable (X,Y,Z)
+            ALLOCATE(dl_tmp( td_var%t_dim(1)%i_len, &
+            &                td_var%t_dim(2)%i_len, &
+            &                td_var%t_dim(4)%i_len) )           
+            DO ji=1,td_var%t_dim(3)%i_len
+               READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) &
+               &  dl_tmp(:,:,:)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("READ VAR VALUE: reading 3D variable "//&
+                  &              TRIM(td_var%c_name))
+               ENDIF
+               dl_value(:,:,ji,:)=dl_tmp(:,:,:)
+            ENDDO
+            DEALLOCATE(dl_tmp)
+         ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+            ! 2D variable (X,Y)
+            READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
+            &  dl_value(:,:,:,:)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("READ VAR VALUE: reading 2D variable "//&
+                  &            TRIM(td_var%c_name))
+            ENDIF
+         ELSEIF( td_var%t_dim(3)%l_use )THEN
+            ! 1D variable (Z)
+            READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
+            &  dl_value(:,:,:,:)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("READ VAR VALUE: reading 1D variable "//&
+                  &            TRIM(td_var%c_name))
+            ENDIF
+         ENDIF
+ 
+         ! Allocate space to hold variable value in structure
+         IF( ASSOCIATED(td_var%d_value) )THEN
+            DEALLOCATE(td_var%d_value)   
+         ENDIF
+
+         ALLOCATE(td_var%d_value( il_count(1), &
+         &                        il_count(2), &
+         &                        il_count(3), &
+         &                        il_count(4)),&
+         &        stat=il_status)
+         IF(il_status /= 0 )THEN
+
+           CALL logger_error( &
+            &  " READ VAR VALUE: not enough space to put variable "//&
+            &  TRIM(td_var%c_name)//&
+            &  " in variable structure")
+
+         ENDIF
+         ! FillValue by default
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+
+         ! new dimension length
+         td_var%t_dim(:)%i_len=il_count(:)
+
+         ! extract value 
+         td_var%d_value(:,:,:,:) = dl_value(il_start(1):il_start(1)+il_count(1)-1,&
+         &                                  il_start(2):il_start(2)+il_count(2)-1,&
+         &                                  il_start(3):il_start(3)+il_count(3)-1,&
+         &                                  il_start(4):il_start(4)+il_count(4)-1)
+
+         DEALLOCATE(dl_value)
+
+      ENDIF
+
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF
+
+      ! use scale factor and offset
+      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+         td_var%d_value(:,:,:,:) = &
+         &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
+      END WHERE
+
+   END SUBROUTINE iom_rstdimg__read_var_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write dimg file from file structure.
+   !
+   !> @details
+   !> dimg file have to be already opened in write mode.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use iom_rstdimg__get_rec
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg_write_file(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4)           :: il_status
+      INTEGER(i4)           :: il_ind
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         IF( td_file%l_wrt )THEN
+
+            ! check dimension
+            IF( td_file%t_dim(jp_L)%l_use .AND. &
+            &   td_file%t_dim(jp_L)%i_len /= 1 )THEN
+               CALL logger_fatal("WRITE FILE: can not write dimg file with "//&
+               &  " several time step.")
+            ENDIF
+
+            ! close and open file with right record length
+            CALL iom_rstdimg_close(td_file)
+
+            ! compute record number to be used 
+            ! and add variable no0d, no1d,.. if need be
+            CALL iom_rstdimg__get_rec(td_file)
+
+            ! compute record length
+            il_ind=att_get_index(td_file%t_att(:),"DOMAIN_number_total")
+            IF( il_ind /= 0 )THEN
+               td_file%i_recl = MAX( &
+               &     td_file%t_dim(1)%i_len * td_file%t_dim(2)%i_len * 8, &
+               &     ( 8 * INT(td_file%t_att(il_ind)%d_value(1)) + 15 ) * 4 )
+            ELSE
+               td_file%i_recl = td_file%t_dim(1)%i_len * &
+               &                td_file%t_dim(2)%i_len * 8
+            ENDIF
+            ! check record length
+            IF( td_file%i_nvar*(im_vnl+dp) > td_file%i_recl )THEN
+               CALL logger_fatal("WRITE FILE: record length is too small. "//&
+               &  " Try to reduce the output number of processor.")
+            ENDIF
+
+            ! get free unit
+            td_file%i_id=fct_getunit()
+
+            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+            &                         FORM='UNFORMATTED',              &
+            &                         ACCESS='DIRECT',                 &
+            &                         STATUS='REPLACE',                &
+            &                         ACTION='WRITE',                  &
+            &                         RECL=td_file%i_recl,             &
+            &                         IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//&
+               &  " with record length "//TRIM(fct_str(td_file%i_recl)))
+            ELSE
+               CALL logger_debug("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//&
+               &  " with record length "//TRIM(fct_str(td_file%i_recl)))
+            ENDIF
+
+            ! write header
+            CALL iom_rstdimg__write_header(td_file)
+
+            ! write variable in file
+            CALL iom_rstdimg__write_var(td_file) 
+
+         ELSE
+
+            CALL logger_error( &
+            &  " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
+            &  ", not opened in write mode")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_write_file
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute record number to be used.
+   !>
+   !> @details
+   !> Moreover it adds variable no0d, no1d, no2d and no3d if need be.
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__get_rec(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_rec
+      TYPE(TVAR)  :: tl_var
+
+      INTEGER(i4), DIMENSION(:)    , ALLOCATABLE :: il_tmp1d
+      INTEGER(i4), DIMENSION(:,:)  , ALLOCATABLE :: il_tmp2d
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_tmp3d
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! add dummy variable if necessary
+      IF( td_file%i_n0d == 0 )THEN
+         ! create var
+         tl_var=var_init('no0d')
+
+         CALL file_add_var( td_file, tl_var )
+      ENDIF
+
+      IF( td_file%i_n1d == 0 )THEN
+         ! create var
+         ALLOCATE( il_tmp1d( td_file%t_dim(3)%i_len ) )
+         il_tmp1d(:)=-1
+
+         tl_var=var_init( 'no1d', il_tmp1d(:)) 
+
+         DEALLOCATE( il_tmp1d )
+
+         CALL file_add_var( td_file, tl_var ) 
+      ENDIF
+ 
+      IF( td_file%i_n2d == 0 )THEN
+         ! create var
+         ALLOCATE( il_tmp2d( td_file%t_dim(1)%i_len, &
+         &                   td_file%t_dim(2)%i_len ) )
+         il_tmp2d(:,:)=-1
+
+         tl_var=var_init('no2d', il_tmp2d(:,:) )
+
+         DEALLOCATE( il_tmp2d )
+
+         CALL file_add_var( td_file, tl_var ) 
+
+      ENDIF
+ 
+      IF( td_file%i_n3d == 0 )THEN
+         ! create var
+         ALLOCATE( il_tmp3d( td_file%t_dim(1)%i_len, &
+         &                   td_file%t_dim(2)%i_len, &
+         &                   td_file%t_dim(3)%i_len ) )
+         il_tmp3d(:,:,:)=-1
+
+         tl_var=var_init('no3d', il_tmp3d(:,:,:) )
+
+         DEALLOCATE( il_tmp3d )
+
+         CALL file_add_var( td_file, tl_var ) 
+      ENDIF
+
+      ! clean
+      CALL var_clean(tl_var)
+
+      il_rec=2
+      DO ji=1,td_file%i_nvar
+         SELECT CASE(td_file%t_var(ji)%i_ndim)
+            CASE(0)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no0d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + 0
+               ENDIF
+            CASE(1)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no1d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + 1
+               ENDIF
+            CASE(2)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no2d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + 1
+               ENDIF
+            CASE(3)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no3d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + td_file%t_dim(3)%i_len
+               ENDIF
+         END SELECT
+      ENDDO
+      td_file%i_rhd  = il_rec
+
+      END SUBROUTINE iom_rstdimg__get_rec
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write header in an opened dimg 
+   !> file in write mode.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__write_header(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_nproc
+      INTEGER(i4) :: il_niproc
+      INTEGER(i4) :: il_njproc
+      INTEGER(i4) :: il_area
+      INTEGER(i4) :: il_iglo
+      INTEGER(i4) :: il_jglo
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check record length
+      IF( td_file%i_recl <= 8 )THEN
+         CALL logger_warn(" WRITE FILE: record length seems to be tiny!! &
+         & ("//TRIM(fct_str(td_file%i_recl))//")")
+      ENDIF
+
+      ! check dimension
+      IF( ANY(td_file%t_dim(1:3)%i_len <= 0 ) )THEN
+         CALL logger_error(" WRITE FILE: at least one dimension size is less &
+         &                than or equal to zero !! ")
+         DO ji=1,3
+            CALL logger_debug(" WRITE FILE: dimension "//&
+            &               TRIM(td_file%t_dim(ji)%c_name)//" : "//&
+            &               TRIM(fct_str(td_file%t_dim(ji)%i_len)) )
+         ENDDO
+      ENDIF
+
+      ! get domain decomposition
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_number_total" )
+      il_nproc = 1
+      IF( il_ind /= 0 )THEN
+         il_nproc = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_number_total" )
+      il_niproc = 0
+      IF( il_ind /= 0 )THEN
+         il_niproc = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_number_total" )
+      il_njproc = 0
+      IF( il_ind /= 0 )THEN
+         il_njproc = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      ! check domain decomposition
+      IF( il_niproc  <= 0 .OR. &
+      &   il_njproc  <= 0 .OR. &
+      &   il_nproc <= 0 .OR. &
+      &   il_nproc > il_niproc * il_njproc )THEN
+      
+         CALL logger_error(" WRITE FILE: invalid domain splitting ")
+
+         CALL logger_debug(" WRITE FILE: niproc "//TRIM(fct_str(il_niproc)) )
+         CALL logger_debug(" WRITE FILE: njproc "//TRIM(fct_str(il_njproc)) )
+         CALL logger_debug(" WRITE FILE: nproc "//TRIM(fct_str(il_nproc)) )
+
+      ENDIF
+      
+      ! get domain number
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_number" )
+      il_area = 0
+      IF( il_ind /= 0 )THEN
+         il_area = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      ! get domain global size
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_size_global" )
+      il_iglo = 0
+      il_jglo = 0
+      IF( il_ind /= 0 )THEN
+         il_iglo = INT(td_file%t_att(il_ind)%d_value(1))
+         il_jglo = INT(td_file%t_att(il_ind)%d_value(2))
+      ENDIF
+
+      ! check domain global size
+      IF( il_iglo < td_file%t_dim(1)%i_len .OR. &
+      &   il_jglo < td_file%t_dim(2)%i_len )THEN
+         CALL logger_error(" WRITE FILE: invalid global domain ")
+
+         CALL logger_debug(" WRITE FILE: global domain : "//&
+         &              TRIM(fct_str(il_iglo))//" x "//&
+         &              TRIM(fct_str(il_jglo)) )
+         CALL logger_debug(" WRITE FILE: local domain : "//&
+         &              TRIM(fct_str(td_file%t_dim(1)%i_len))//" x "//&
+         &              TRIM(fct_str(td_file%t_dim(2)%i_len)) )
+      ENDIF
+
+      ! allocate local variable
+      ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
+      &         il_lci(il_nproc),  il_lcj(il_nproc), &
+      &         il_ldi(il_nproc),  il_ldj(il_nproc), &
+      &         il_lei(il_nproc),  il_lej(il_nproc) )
+
+      ! get left bottom indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_left_bottom_indices" )
+      il_impp(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_impp(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_left_bottom_indices" )
+      il_jmpp(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_jmpp(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+      
+      ! check left bottom indices
+      IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain left bottom indices")
+      ENDIF
+
+      ! get subdomain dimensions
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_dimensions" )
+      il_lci(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lci(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_dimensions" )
+      il_lcj(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lcj(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      ! check subdomain dimension
+      IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain dimensions")
+      ENDIF
+
+      ! get first indoor indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_first_indoor_indices" )
+      il_ldi(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_ldi(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_first_indoor_indices" )
+      il_ldj(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_ldj(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+      
+      ! check first indoor indices
+      IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain first indoor indices")
+      ENDIF
+
+      ! get last indoor indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_last_indoor_indices" )
+      il_lei(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lei(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_last_indoor_indices" )
+      il_lej(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lej(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      ! check last indoor indices
+      IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain last indoor indices")
+      ENDIF      
+
+      ! write file header
+      WRITE(td_file%i_id, IOSTAT=il_status, REC=1 )&
+      &  td_file%i_recl, &
+      &  td_file%t_dim(1)%i_len, &
+      &  td_file%t_dim(2)%i_len, &
+      &  td_file%t_dim(3)%i_len, &
+      &  td_file%i_n0d, &
+      &  td_file%i_n1d, &
+      &  td_file%i_n2d, &
+      &  td_file%i_n3d, &
+      &  td_file%i_rhd, &
+      &  il_niproc, il_njproc, il_nproc, &
+      &  il_area,                &
+      &  il_iglo, il_jglo,       &
+      &  il_lci(:), il_lcj(:),   &
+      &  il_ldi(:), il_ldj(:),   &
+      &  il_lei(:), il_lej(:),   &
+      &  il_impp(:), il_jmpp(:)
+
+      DEALLOCATE( il_impp, il_jmpp,&
+      &           il_lci,  il_lcj, &
+      &           il_ldi,  il_ldj, &
+      &           il_lei,  il_lej  )
+
+      END SUBROUTINE iom_rstdimg__write_header
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write variables in an opened dimg file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - bug fix: do not use scale factor an offset for case no0d, no1d...
+   !>
+   !> @param[in] td_file file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE iom_rstdimg__write_var(td_file)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_rec
+
+      INTEGER(i4),            DIMENSION(:), ALLOCATABLE :: il_start
+      INTEGER(i4),            DIMENSION(:), ALLOCATABLE :: il_count
+      CHARACTER(LEN=im_vnl),  DIMENSION(:), ALLOCATABLE :: cl_name
+      REAL(dp),               DIMENSION(:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! reform name and record
+      ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
+
+      DO ji=1,td_file%i_nvar
+
+         ! change FillValue to 0.
+         CALL var_chg_FillValue(td_file%t_var(ji),0._dp)
+
+         cl_name(ji)  = TRIM(td_file%t_var(ji)%c_name)
+         dl_value(ji) = REAL(td_file%t_var(ji)%i_rec,dp)
+         
+         SELECT CASE (TRIM(td_file%t_var(ji)%c_name))
+            CASE('no0d','no1d','no2d','no3d')
+            CASE DEFAULT
+               
+               ! use scale factor and offset
+               WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= &
+               &      td_file%t_var(ji)%d_fill )
+                  td_file%t_var(ji)%d_value(:,:,:,:) = &
+                  &   ( td_file%t_var(ji)%d_value(:,:,:,:) - &
+                  &     td_file%t_var(ji)%d_ofs ) / &
+                  &   td_file%t_var(ji)%d_scf
+               END WHERE
+
+               DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len
+                  SELECT CASE (td_file%t_var(ji)%i_ndim)
+                     CASE(0)
+                        ! special case for 0d, value save in rec
+                        dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1)
+                        il_rec = td_file%t_var(ji)%i_rec
+                     CASE(1,2)
+                        il_rec = td_file%t_var(ji)%i_rec
+                     CASE(3)
+                        il_rec = td_file%t_var(ji)%i_rec + jk -1
+                  END SELECT 
+                  WRITE( td_file%i_id, IOSTAT=il_status, REC=il_rec ) &
+                  &  td_file%t_var(ji)%d_value(:,:,jk,1)
+                  CALL fct_err(il_status)
+                  IF( il_status /= 0 )THEN
+                     CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//&
+                     &  "write variable "//TRIM(td_file%t_var(ji)%c_name)//&
+                     &  " in record "//TRIM(fct_str(il_rec)))
+                  ENDIF
+               ENDDO
+            END SELECT
+
+      ENDDO
+
+      ALLOCATE( il_start(4), il_count(4) )
+
+      il_start(1) = 1
+      il_count(1) = td_file%i_n0d
+      
+      il_start(2) = 1 + il_count(1)
+      il_count(2) = il_start(2) - 1 + td_file%i_n1d
+      
+      il_start(3) = 1 + il_count(2)
+      il_count(3) = il_start(3) - 1 + td_file%i_n2d
+      
+      il_start(4) = 1 + il_count(3)
+      il_count(4) = il_start(4) - 1 + td_file%i_n3d
+
+      WRITE(td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )&
+      &  cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
+      &  cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
+      &  cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
+      &  cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//&
+         &  "write restart header in record "//TRIM(fct_str(td_file%i_rhd)))
+      ENDIF
+
+      ! clean
+      DEALLOCATE( cl_name, dl_value )
+      DEALLOCATE( il_start, il_count )
+
+   END SUBROUTINE iom_rstdimg__write_var
+END MODULE iom_rstdimg
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/kind.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/kind.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/kind.f90	(revision 8732)
@@ -0,0 +1,46 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: kind
+!
+! DESCRIPTION:
+!> This module defines the F90 kind parameter for common data types.
+!> 
+!
+!> @author
+!> G. Madec
+! REVISION HISTORY:
+!> @date June, 2006 - Initial Version
+!> @date December, 2012 - G. Madec
+!>  - add a standard length of character strings
+!
+!> @todo
+!> - check i8 max value
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE kind
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   !                                                                !!** Floating point **
+   ! SELECTED_REAL_KIND(P,R) returns the kind value of a real data type 
+   ! with decimal precision of at least P digits, exponent range of at least R
+   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 **
+   ! SELECTED_INT_KIND(R) return the kind value of the smallest integer type 
+   ! that can represent all values ranging ] -10^R , 10^R [
+   INTEGER, PUBLIC, PARAMETER ::   i1 = SELECTED_INT_KIND( 1)        !< single precision (integer 1) 
+   INTEGER, PUBLIC, PARAMETER ::   i2 = SELECTED_INT_KIND( 4)        !< single precision (integer 2) 
+   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                          !< Length of Character strings
+
+END MODULE kind
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/lbc.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/lbc.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/lbc.f90	(revision 8732)
@@ -0,0 +1,804 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: math
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups lateral boundary conditions subroutine.
+!>
+!> @details
+!>
+!> @warning keep only non mpp case
+!>
+!> @author
+!> G. Madec
+! REVISION HISTORY:
+!>  @date June, 1997 - Original code
+!> @date September, 2002
+!> - F90: Free form and module
+!>  @date Marsh, 2009
+!> - R. Benshila : External north fold treatment  
+!>  @date December, 2012
+!> - S.Mocavero, I. Epicoco : Add 'lbc_bdy_lnk' and lbc_obc_lnk' routine to optimize the BDY/OBC communications
+!> @date December, 2012
+!> - R. Bourdalle-Badie and G. Reffray : add a C1D case 
+!> @date January, 2015 
+!> - J.Paul : rewrite with SIREN coding rules
+!> @date Marsh, 2015 
+!> - J.Paul : add hide subroutine
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE lbc
+   USE kind                            ! F90 kind parameter
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: lbc_lnk 
+   PUBLIC :: lbc_nfd  
+   PUBLIC :: lbc_hide  
+
+   PRIVATE :: lbc__lnk_3d
+   PRIVATE :: lbc__lnk_2d
+   PRIVATE :: lbc__nfd_3d
+   PRIVATE :: lbc__nfd_2d
+   PRIVATE :: lbc__hide_lnk_2d
+   PRIVATE :: lbc__hide_nfd
+   PRIVATE :: lbc__hide_nfd_2d
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   lbc__lnk_3d
+      MODULE PROCEDURE   lbc__lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc__nfd_3d
+      MODULE PROCEDURE   lbc__nfd_2d
+   END INTERFACE
+
+   INTERFACE lbc_hide
+      MODULE PROCEDURE   lbc__hide_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc__hide_nfd
+      MODULE PROCEDURE   lbc__hide_nfd_2d
+   END INTERFACE
+    
+CONTAINS
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine set lateral boundary conditions on a 3D array (non mpp case) 
+   !>
+   !> @details
+   !>             dd_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.
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  3D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill   fillValue
+   !-------------------------------------------------------------------
+   SUBROUTINE lbc__lnk_3d( dd_array, cd_type, id_perio, dd_psgn, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)          , INTENT(IN   ) :: cd_type
+      INTEGER(i4)               , INTENT(IN   ) :: id_perio
+      REAL(dp),                   INTENT(IN   ) :: dd_psgn
+      REAL(dp),                   INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+      !
+      !                                     ! East-West boundaries
+      !                                     ! ====================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
+         dd_array(    1 ,:,:) = dd_array(il_jpim1,:,:)            ! all points
+         dd_array(il_jpi,:,:) = dd_array(     2  ,:,:)
+         !
+      CASE DEFAULT                             !**  East closed  --  West closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(    1 ,:,:) = dl_fill
+            dd_array(il_jpi,:,:) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(il_jpi,:,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+      !
+      !                                     ! North-South boundaries
+      !                                     ! ======================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 2 )                               !**  South symmetric  --  North closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+            dd_array(:,    1 ,:) = dd_array(:,3,:)
+            dd_array(:,il_jpj,:) = dl_fill
+         CASE ( 'V' , 'F' )                         ! V-, F-points
+            dd_array(:,    1 ,:) = dd_psgn * dd_array(:,2,:)
+            dd_array(:,il_jpj,:) = dl_fill
+         END SELECT
+         !
+      CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+         SELECT CASE ( TRIM(cd_type) )                    ! South : closed
+         CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+            dd_array(:, 1 ,:) = dl_fill
+         END SELECT
+         !                                          ! North fold
+         CALL lbc_nfd( dd_array(:,:,:), cd_type, id_perio, dd_psgn )
+         !
+      CASE DEFAULT                             !**  North closed  --  South closed
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(:,    1 ,:) = dl_fill
+            dd_array(:,il_jpj,:) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(:,il_jpj,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__lnk_3d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine set lateral boundary conditions on a 2D array (non mpp case) 
+   !>
+   !> @details
+   !>             dd_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.
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules
+   ! 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill   fillValue
+   !-------------------------------------------------------------------
+   SUBROUTINE lbc__lnk_2d( dd_array, cd_type, id_perio, dd_psgn, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+
+      !
+      !                                     ! East-West boundaries
+      !                                     ! ====================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+         dd_array(    1 ,:) = dd_array(il_jpim1,:)               ! all points
+         dd_array(il_jpi,:) = dd_array(     2  ,:)
+         !
+      CASE DEFAULT                             !** East closed  --  West closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+            dd_array(    1 ,:) = dl_fill
+            dd_array(il_jpi,:) = dl_fill
+         CASE ( 'F' )                              ! F-point
+            dd_array(il_jpi,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+      !
+      !                                     ! North-South boundaries
+      !                                     ! ======================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 2 )                               !**  South symmetric  --  North closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+            dd_array(:,   1  ) = dd_array(:,3)
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'V' , 'F' )                         ! V-, F-points
+            dd_array(:,   1  ) = dd_psgn * dd_array(:,2)
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+         SELECT CASE ( TRIM(cd_type) )                    ! South : closed
+         CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+            dd_array(:, 1 ) = dl_fill
+         END SELECT
+         !                                          ! North fold
+         CALL lbc_nfd( dd_array(:,:), cd_type, id_perio, dd_psgn )
+         !
+      CASE DEFAULT                             !**  North closed  --  South closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__lnk_2d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine manage 3D lateral boundary condition : 
+   !> North fold treatment without processor exchanges. 
+   !>
+   !> @warning keep only non mpp case
+   !>
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules
+   ! 
+   !> @param[inout] dd_array  3D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !-------------------------------------------------------------------
+   SUBROUTINE lbc__nfd_3d( dd_array, cd_type, id_perio, dd_psgn )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)          , INTENT(IN   ) :: cd_type
+      INTEGER(i4)               , INTENT(IN   ) :: id_perio
+      REAL(dp)                  , INTENT(IN   ) :: dd_psgn
+
+      ! local variable
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpk
+      INTEGER(i4) :: il_jpim1
+      INTEGER(i4) :: il_jpjm1
+
+      INTEGER(i4) :: ijt
+      INTEGER(i4) :: iju
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      
+      il_jpi=SIZE(dd_array(:,:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:,:),DIM=2)
+      il_jpk=SIZE(dd_array(:,:,:),DIM=3)
+
+      il_jpim1=il_jpi-1
+      il_jpjm1=il_jpj-1
+
+      DO jk = 1, il_jpk
+         !
+         SELECT CASE ( id_perio )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( TRIM(cd_type) )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, il_jpi
+                  ijt = il_jpi-ji+2
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
+               END DO
+               dd_array(1,il_jpj,jk) = dd_psgn * dd_array(3,il_jpj-2,jk)
+               DO ji = il_jpi/2+1, il_jpi
+                  ijt = il_jpi-ji+2
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(ijt,il_jpjm1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji+1
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
+               END DO
+               dd_array(   1  ,il_jpj,jk) = dd_psgn * dd_array(    2   ,il_jpj-2,jk)
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(il_jpi-1,il_jpj-2,jk) 
+               DO ji = il_jpi/2, il_jpi-1
+                  iju = il_jpi-ji+1
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(iju,il_jpjm1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, il_jpi
+                  ijt = il_jpi-ji+2
+                  dd_array(ji,il_jpj-1,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
+                  dd_array(ji,il_jpj  ,jk) = dd_psgn * dd_array(ijt,il_jpj-3,jk)
+               END DO
+               dd_array(1,il_jpj,jk) = dd_psgn * dd_array(3,il_jpj-3,jk) 
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji+1
+                  dd_array(ji,il_jpj-1,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
+                  dd_array(ji,il_jpj  ,jk) = dd_psgn * dd_array(iju,il_jpj-3,jk)
+               END DO
+               dd_array(   1  ,il_jpj,jk) = dd_psgn * dd_array(    2   ,il_jpj-3,jk)
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(il_jpi-1,il_jpj-3,jk) 
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( TRIM(cd_type) )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, il_jpi
+                  ijt = il_jpi-ji+1
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(iju,il_jpj-1,jk)
+               END DO
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(1,il_jpj-1,jk)
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, il_jpi
+                  ijt = il_jpi-ji+1
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
+               END DO
+               DO ji = il_jpi/2+1, il_jpi
+                  ijt = il_jpi-ji+1
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(ijt,il_jpjm1,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji
+                  dd_array(ji,il_jpj  ,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
+               END DO
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(1,il_jpj-2,jk)
+               DO ji = il_jpi/2+1, il_jpi-1
+                  iju = il_jpi-ji
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(iju,il_jpjm1,jk)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( TRIM(cd_type))
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               dd_array(:, 1  ,jk) = 0.e0
+               dd_array(:,il_jpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               dd_array(:,il_jpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  id_perio
+         !
+      END DO
+   END SUBROUTINE lbc__nfd_3d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine manage 2D lateral boundary condition : 
+   !> North fold treatment without processor exchanges. 
+   !>
+   !> @warning keep only non mpp case
+   !> @warning do not use additional halos
+   !>
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules
+   ! 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !-------------------------------------------------------------------
+   SUBROUTINE lbc__nfd_2d( dd_array, cd_type, id_perio, dd_psgn )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+
+      ! local variable
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      INTEGER(i4) :: il_jpjm1
+
+      INTEGER(i4) :: ijt
+      INTEGER(i4) :: iju
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+      il_jpjm1=il_jpj-1
+
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO ji = 2, il_jpi
+               ijt=il_jpi-ji+2
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-2)
+            END DO
+            dd_array(1,il_jpj)   = dd_psgn * dd_array(3,il_jpj-2)
+            dd_array(1,il_jpj-1) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = il_jpi/2+1, il_jpi
+               ijt=il_jpi-ji+2
+               dd_array(ji,il_jpj-1) = dd_psgn * dd_array(ijt,il_jpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-2)
+            END DO
+            dd_array(   1  ,il_jpj  ) = dd_psgn * dd_array(    2   ,il_jpj-2)
+            dd_array(il_jpi,il_jpj  ) = dd_psgn * dd_array(il_jpi-1,il_jpj-2)
+            dd_array(1     ,il_jpj-1) = dd_psgn * dd_array(il_jpi  ,il_jpj-1)   
+            DO ji = il_jpi/2, il_jpi-1
+               iju = il_jpi-ji+1
+               dd_array(ji,il_jpjm1) = dd_psgn * dd_array(iju,il_jpjm1)
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 2, il_jpi
+               ijt = il_jpi-ji+2
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-3)
+            END DO
+            dd_array( 1 ,il_jpj)   = dd_psgn * dd_array( 3 ,il_jpj-3) 
+         CASE ( 'F' )                                     ! F-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-3)
+            END DO
+            dd_array(   1  ,il_jpj)   = dd_psgn * dd_array(    2   ,il_jpj-3)
+            dd_array(il_jpi,il_jpj)   = dd_psgn * dd_array(il_jpi-1,il_jpj-3)
+            dd_array(il_jpi,il_jpj-1) = dd_psgn * dd_array(il_jpi-1,il_jpj-2)      
+            dd_array(   1  ,il_jpj-1) = dd_psgn * dd_array(    2   ,il_jpj-2)      
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = 3, il_jpi
+               iju = il_jpi - ji + 3
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+         CASE ( 'J' )                                     ! first ice U-V point
+            dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = 3, il_jpi
+               iju = il_jpi - ji + 3
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+         CASE ( 'K' )                                     ! second ice U-V point
+            dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = 3, il_jpi
+               iju = il_jpi - ji + 3
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+         END SELECT
+         !
+      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO ji = 1, il_jpi
+               ijt = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+            dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(1,il_jpj-1)
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, il_jpi
+               ijt = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-2)
+            END DO
+            DO ji = il_jpi/2+1, il_jpi
+               ijt = il_jpi-ji+1
+               dd_array(ji,il_jpjm1) = dd_psgn * dd_array(ijt,il_jpjm1)
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-2)
+            END DO
+            dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(1,il_jpj-2)
+            DO ji = il_jpi/2+1, il_jpi-1
+               iju = il_jpi-ji
+               dd_array(ji,il_jpjm1) = dd_psgn * dd_array(iju,il_jpjm1)
+            END DO
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+            dd_array( 2 ,il_jpj) = 0.e0
+            DO ji = 2 , il_jpi-1
+               ijt = il_jpi - ji + 2
+               dd_array(ji,il_jpj)= 0.5 * ( dd_array(ji,il_jpj-1) + dd_psgn * dd_array(ijt,il_jpj-1) )
+            END DO
+         CASE ( 'J' )                                  ! first ice U-V point
+            dd_array( 2 ,il_jpj) = 0.e0
+            DO ji = 2 , il_jpi-1
+               ijt = il_jpi - ji + 2
+               dd_array(ji,il_jpj)= dd_array(ji,il_jpj-1)
+            END DO
+         CASE ( 'K' )                                  ! second ice U-V point
+            dd_array( 2 ,il_jpj) = 0.e0
+            DO ji = 2 , il_jpi-1
+               ijt = il_jpi - ji + 2
+               dd_array(ji,il_jpj)= dd_array(ijt,il_jpj-1)
+            END DO
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'I' )                                   ! ice U-V point
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'J' )                                   ! first ice U-V point
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'K' )                                   ! second ice U-V point
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         END SELECT
+         !
+      END SELECT
+   END SUBROUTINE lbc__nfd_2d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine hide lateral boundary conditions on a 2D array (non mpp case) 
+   !>
+   !> @details
+   !>             dd_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.
+   !> @author J.Paul 
+   !> - Marsh, 2015- initial version
+   ! 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill   fillValue
+   !-------------------------------------------------------------------
+   SUBROUTINE lbc__hide_lnk_2d( dd_array, cd_type, id_perio, dd_psgn, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+
+      !
+      !                                     ! East-West boundaries
+      !                                     ! ====================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+         dd_array(    1 ,:) = dl_fill               ! all points
+         dd_array(il_jpi,:) = dl_fill
+         !
+      CASE DEFAULT                             !** East closed  --  West closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+            dd_array(    1 ,:) = dl_fill
+            dd_array(il_jpi,:) = dl_fill
+         CASE ( 'F' )                              ! F-point
+            dd_array(il_jpi,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+      !
+      !                                     ! North-South boundaries
+      !                                     ! ======================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 2 )                               !**  South symmetric  --  North closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'V' , 'F' )                         ! V-, F-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+         SELECT CASE ( TRIM(cd_type) )                    ! South : closed
+         CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+            dd_array(:, 1 ) = dl_fill
+         END SELECT
+         !                                          ! North fold
+         CALL lbc__hide_nfd( dd_array(:,:), cd_type, id_perio, dd_psgn, &
+         &                   dd_fill=dl_fill )
+         !
+      CASE DEFAULT                             !**  North closed  --  South closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__hide_lnk_2d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine manage 2D lateral boundary condition : 
+   !> hide North fold treatment without processor exchanges. 
+   !>
+   !> @warning keep only non mpp case
+   !> @warning do not use additional halos
+   !>
+   !> @author J.Paul 
+   !> - Marsh, 2015- initial version
+   ! 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill 
+   !-------------------------------------------------------------------
+   SUBROUTINE lbc__hide_nfd_2d( dd_array, cd_type, id_perio, dd_psgn, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      INTEGER(i4) :: il_jpjm1
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+      il_jpjm1=il_jpj-1
+
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO ji = 2, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(1,il_jpj)   = dl_fill
+            DO ji = il_jpi/2+2, il_jpi
+               dd_array(ji,il_jpj-1) = dl_fill
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(   1  ,il_jpj  ) = dl_fill 
+            dd_array(il_jpi,il_jpj  ) = dl_fill
+            dd_array(1     ,il_jpj-1) = dl_fill
+            DO ji = il_jpi/2+1, il_jpi-1
+               dd_array(ji,il_jpjm1) = dl_fill
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 2, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array( 1 ,il_jpj)   = dl_fill 
+         CASE ( 'F' )                                     ! F-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(   1  ,il_jpj)   = dl_fill
+            dd_array(il_jpi,il_jpj)   = dl_fill
+            dd_array(il_jpi,il_jpj-1) = dl_fill 
+            dd_array(   1  ,il_jpj-1) = dl_fill
+         END SELECT
+         !
+      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO ji = 1, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(il_jpi,il_jpj) = dl_fill
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            DO ji = il_jpi/2+2, il_jpi
+               dd_array(ji,il_jpjm1) = dl_fill
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(il_jpi,il_jpj) = dl_fill
+            DO ji = il_jpi/2+2, il_jpi-1
+               dd_array(ji,il_jpjm1) = dl_fill
+            END DO
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            dd_array(:, 1    ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'F' )                                   ! F-point
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      END SELECT
+   END SUBROUTINE lbc__hide_nfd_2d
+END MODULE lbc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/logger.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/logger.f90	(revision 8732)
@@ -0,0 +1,728 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: logger
+!
+! DESCRIPTION:
+!> @brief This module manage log file.
+!> @details
+!> This module create log file and fill it depending of verbosity.
+!>
+!> verbosity could be choosen between :
+!>    - trace : Most detailed information.
+!>    - debug : Detailed information on the flow through the system.
+!>    - info  : Interesting runtime events (startup/shutdown).
+!>    - warning: Use of deprecated APIs, poor use of API, 'almost' errors, 
+!> other runtime situations that are undesirable or unexpected, 
+!> but not necessarily "wrong". 
+!>    - error : Other runtime errors or unexpected conditions.
+!>    - fatal : Severe errors that cause premature termination.
+!>    - none  : to not create and write any information in logger file.<br />
+!>       @warn in this case only FATAL ERROR will be detected.<br />
+!>
+!> @note default verbosity is warning
+!>
+!> If total number of error exceeded maximum number 
+!> authorized, program stop.
+!>
+!> to open/create logger file:<br/>
+!> @code
+!>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid])
+!> @endcode
+!> - cd_file is logger file name
+!> - cd_verbosity is verbosity to be used [optional, default 'warning']
+!> - id_loggerid is file id [optional, use only to flush]
+!> - id_maxerror is the maximum number of error authorized before program stop [optional, default 5]
+!>
+!> to close logger file:<br/>
+!> @code
+!> CALL logger_close()
+!> @endcode
+!>
+!> to clean logger file:<br/>
+!> @code
+!> CALL logger_clean()
+!> @endcode
+!>
+!> to write header in logger file:<br/>
+!> @code
+!> CALL logger_header()
+!> @endcode
+!>
+!> to write footer in logger file:<br/>
+!> @code
+!> CALL logger_footer()
+!> @endcode
+!>
+!> to flushing output:<br/>
+!> @code
+!> CALL logger_flush()
+!> @endcode
+!>
+!> to write TRACE message in logger file:<br/>
+!> @code
+!> CALL logger_trace(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is TRACE message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write DEBUG message in logger file:<br/>
+!> @code
+!> CALL logger_debug(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is DEBUG message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write INFO message in logger file:<br/>
+!> @code
+!> CALL logger_info(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is INFO message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write WARNING message in logger file:<br/>
+!> @code
+!> CALL logger_warn(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is WARNING message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write ERROR message in logger file:<br/>
+!> @code
+!> CALL logger_error(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is ERROR message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write FATAL message in logger file:<br/>
+!> @code
+!> CALL logger_fatal(cd_msg)
+!> @endcode
+!>    - cd_msg is FATAL message
+!>
+!> Examples :<br />
+!> @code
+!>   CALL logger_open('loggerfile.txt','info')
+!>
+!>   CALL logger_header()
+!>   CALL logger_debug('une info de debug')
+!>   CALL logger_info('une info')
+!>   CALL logger_warn('un warning')
+!>   CALL logger_error('une erreur')
+!>   CALL logger_footer()
+!>   CALL logger_close()
+!>   CALL logger_clean()
+!> @endcode
+!>
+!> @code
+!>   CALL logger_open('loggerfile.txt')
+!>
+!>   CALL logger_header()
+!>   CALL logger_debug('une info de debug')
+!>   CALL logger_info('une info')
+!>   CALL logger_warn('un warning')
+!>   CALL logger_error('une erreur')
+!>   CALL logger_footer()
+!>   CALL logger_close()
+!>   CALL logger_clean()
+!> @endcode
+!
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date February, 2015
+!> - check verbosity validity
+!> - add 'none' verbosity level to not used logger file
+!> @date January, 2016
+!> - add logger_clean subroutine
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE logger
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PRIVATE :: TLOGGER            !< logger structure
+
+   PRIVATE :: tm_logger          !< logger structure
+   PRIVATE :: im_nverbosity      !< number of log level
+   PRIVATE :: cm_verbosity       !< verbosity array
+
+   ! function and subroutine
+   PUBLIC :: logger_open        !< create a log file with given verbosity
+   PUBLIC :: logger_close       !< close log file
+   PUBLIC :: logger_clean       !< clean log structure
+   PUBLIC :: logger_header      !< write header on log file
+   PUBLIC :: logger_footer      !< write footer on log file
+   PUBLIC :: logger_flush       !< flushing output
+   PUBLIC :: logger_trace       !< write trace    message in log file
+   PUBLIC :: logger_debug       !< write debug    message in log file 
+   PUBLIC :: logger_info        !< write info     message in log file
+   PUBLIC :: logger_warn        !< write warning  message in log file
+   PUBLIC :: logger_error       !< write error    message in log file
+   PUBLIC :: logger_fatal       !< write fatal    message in log file, and stop
+
+   PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file
+   PRIVATE :: logger__check_verb! check verbosity validity
+
+   TYPE TLOGGER   !< logger structure
+      INTEGER(i4)       :: i_id = 0                 !< log file id
+      LOGICAL           :: l_use=.TRUE.             !< use logger or not
+      CHARACTER(LEN=lc) :: c_name                   !< log file name
+      CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose
+      CHARACTER(LEN=lc) :: c_verb = ""              !< array of "verbosities" to used 
+      INTEGER(i4)       :: i_nerror   = 0           !< number of error
+      INTEGER(i4)       :: i_nfatal   = 0           !< number of fatal error
+      INTEGER(i4)       :: i_maxerror = 5           !< maximum number of error before stoping program
+   END TYPE TLOGGER   
+
+   !  module variable
+   INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level
+   CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array 
+   &               (/ 'trace   ',&
+   &                  'debug   ',&
+   &                  'info    ',& 
+   &                  'warning ',&
+   &                  'error   ',&
+   &                  'fatal   ',&
+   &                  'none    '/)
+
+   TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
+                                                 
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine create a log file with default verbosity
+   !> ('warning').
+   !> @details
+   !> Optionally verbosity could be change to 
+   !> ('trace','debug','info',warning','error','fatal').<br/>
+   !> Optionally maximum number of error allowed could be change.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_file      log file name
+   !> @param[in] cd_verbosity log file verbosity
+   !> @param[in] id_maxerror  maximum number of error
+   !> @param[in] id_logid     log file id (use to flush)
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name
+      CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
+
+      ! local variable
+      INTEGER(i4) :: il_status
+
+      LOGICAL     :: ll_valid
+
+      ! loop
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! if present, change verbosity value
+      IF( PRESENT(cd_verbosity) )THEN
+         ll_valid=logger__check_verb(TRIM(ADJUSTL(cd_verbosity)))
+         IF( ll_valid )THEN
+            tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
+         ENDIF
+      ENDIF
+
+      IF( TRIM(tm_logger%c_verbosity) == 'none' ) tm_logger%l_use=.FALSE.
+      
+      IF( tm_logger%l_use )THEN
+
+         ! get id if not already define
+         IF( PRESENT(id_logid) )THEN
+            tm_logger%i_id=id_logid
+         ELSE
+            tm_logger%i_id=fct_getunit()
+         ENDIF
+
+         ! open log file
+         OPEN( tm_logger%i_id, &
+         &     STATUS="unknown",    &
+         &     FILE=TRIM(ADJUSTL(cd_file)),  &
+         &     ACTION="write",      &
+         &     POSITION="append",   &
+         &     IOSTAT=il_status)
+         CALL fct_err(il_status)
+
+         ! keep filename
+         tm_logger%c_name=TRIM(ADJUSTL(cd_file))
+
+         ! compute "tab" of verbosity to be used
+         IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
+            DO ji=im_nverbosity,1,-1
+               tm_logger%c_verb = &
+               &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
+               IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDIF
+
+         IF( PRESENT(id_maxerror) )THEN
+            tm_logger%i_maxerror=id_maxerror
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE logger_open
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close a log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_close()
+      IMPLICIT NONE
+      ! local variable
+      INTEGER(i4)   :: il_status
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            !tm_logger%i_id = 0
+            CLOSE( tm_logger%i_id, &
+            &      IOSTAT=il_status)      
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_close')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_close
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean a log structure.
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_clean()
+      IMPLICIT NONE
+      ! local variable
+      TYPE(TLOGGER) :: tl_logger
+      !----------------------------------------------------------------
+      tm_logger = tl_logger
+
+   END SUBROUTINE logger_clean
+   !-------------------------------------------------------------------
+   !> @brief This subroutine flushing output into log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_flush()
+      IMPLICIT NONE
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            CALL logger_close()
+            CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, &
+            &                 tm_logger%i_maxerror, tm_logger%i_id )     
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_flush')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_flush
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write header on log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+   RECURSIVE SUBROUTINE logger_header()
+      IMPLICIT NONE
+      ! local variable
+      INTEGER(i4)       :: il_status
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            WRITE( tm_logger%i_id,    &
+               &   FMT='(4(a/))',     &
+               &   IOSTAT=il_status ) &
+               &   "--------------------------------------------------",&
+               &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
+               &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
+               &   "--------------------------------------------------"
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_header')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_header
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write footer on log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_footer()
+      IMPLICIT NONE
+      ! local variable
+      INTEGER(i4)       :: il_status
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            WRITE( tm_logger%i_id,    &
+               &   FMT='(4(/a))',     &
+               &   IOSTAT=il_status ) &
+               &   "--------------------------------------------------",&
+               &   "END      : log ended ",              &
+               &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
+               &   " ERROR detected ",                                  &
+               &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
+               &   " FATAL detected ",                                  &
+               &   "--------------------------------------------------"
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_footer')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_footer
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write trace message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_trace(cd_msg, ld_flush)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
+
+               CALL logger__write("TRACE   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_trace')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_trace
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write debug message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_debug(cd_msg, ld_flush)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
+
+               CALL logger__write("DEBUG   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_debug')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_debug
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write info message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_info(cd_msg, ld_flush)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
+
+               CALL logger__write("INFO    :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_info')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_info
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write warning message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_warn(cd_msg, ld_flush)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
+
+               CALL logger__write("WARNING :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_warn')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_warn
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write error message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_error(cd_msg, ld_flush)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_nerror
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            ! increment the error number
+            tm_logger%i_nerror=tm_logger%i_nerror+1
+
+            IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
+
+               CALL logger__write("ERROR   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+
+            IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
+               WRITE(cl_nerror,*) tm_logger%i_maxerror
+               CALL logger_fatal(&
+               &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_error')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_error
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write fatal error message on log file, 
+   !> close log file and stop process.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - stop program for FATAL ERROR if verbosity is none
+   !
+   !> @param[in] cd_msg message to write
+   !-------------------------------------------------------------------
+   RECURSIVE SUBROUTINE logger_fatal(cd_msg)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
+      !----------------------------------------------------------------
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
+               ! increment the error number
+               tm_logger%i_nfatal=tm_logger%i_nfatal+1
+
+               CALL logger__write("FATAL   :",cd_msg)
+
+               CALL logger_footer()
+               CALL logger_close()
+
+               WRITE(*,*) 'FATAL ERROR'
+               STOP
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_fatal')
+         ENDIF
+      ELSE
+         PRINT *,"FATAL ERROR :"//TRIM(cd_msg)
+         STOP
+      ENDIF
+   END SUBROUTINE logger_fatal
+   !-------------------------------------------------------------------
+   !> @brief This subroutine cut message to get maximum of 80 character 
+   !> by line in log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_verb   verbosity of the message to write
+   !> @param[in] cd_msg    message to write
+   !-------------------------------------------------------------------
+   SUBROUTINE logger__write(cd_verb, cd_msg)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_verb
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      INTEGER(i4)       :: il_verb
+      INTEGER(i4)       :: il_msg
+      CHARACTER(LEN=lc) :: cl_verb
+      CHARACTER(LEN=lc) :: cl_msg
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      !----------------------------------------------------------------
+      cl_verb=TRIM(ADJUSTL(cd_verb))
+      cl_msg=TRIM(ADJUSTL(cd_msg))
+
+      il_verb=LEN_TRIM(cl_verb)
+      il_msg=LEN_TRIM(cl_msg)
+      DO WHILE( il_verb + il_msg > 78 )
+         cl_tmp=TRIM(cl_verb)//' '//TRIM(cl_msg(1:78-il_verb))
+
+         WRITE( tm_logger%i_id,  &
+         &      FMT=*,           &
+         &      IOSTAT=il_status &
+         &      ) TRIM(cl_tmp)
+         CALL fct_err(il_status)
+
+
+         cl_msg=cl_msg(78-il_verb+1:il_msg)
+         cl_verb="        :"
+
+         il_msg=LEN_TRIM(cl_msg)
+
+      ENDDO
+
+      cl_tmp=TRIM(cl_verb)//' '//TRIM(cl_msg)
+      WRITE( tm_logger%i_id,  &
+      &      FMT=*,           &
+      &      IOSTAT=il_status &
+      &      ) TRIM(cl_tmp)
+      CALL fct_err(il_status)
+
+   END SUBROUTINE logger__write
+   !-------------------------------------------------------------------
+   !> @brief This function check validity of verbosity.
+   !>
+   !> @author J.Paul
+   !> @date February, 2015 - Initial Version
+   !
+   !> @param[in] cd_verb   verbosity of the message to write
+   !> @return verbosity is valid or not
+   !-------------------------------------------------------------------
+   FUNCTION logger__check_verb(cd_verb)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_verb
+
+      !function
+      LOGICAL           :: logger__check_verb
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      !----------------------------------------------------------------
+      logger__check_verb=.FALSE.
+
+      DO ji=1,im_nverbosity
+         IF( TRIM(cd_verb) == TRIM(cm_verbosity(ji)) )THEN
+            logger__check_verb=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( .NOT. logger__check_verb )THEN
+         CALL logger_open('logger.log')
+         CALL logger_header()
+         CALL logger_fatal('LOGGER : invalid verbosity, check namelist.'//&
+         &                 ' default one will be used.')
+         CALL logger_footer()
+      ENDIF
+   END FUNCTION logger__check_verb
+END MODULE logger
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/math.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/math.f90	(revision 8732)
@@ -0,0 +1,1287 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: math
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups some useful mathematical function.
+!>
+!> @details
+!> 
+!>    to compute the mean of an array:<br/>
+!> @code
+!>    dl_value=math_mean( dl_value, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - dd_fill is FillValue
+!>
+!>    to compute the median of an array:<br/>
+!> @code
+!>    dl_value=math_median( dl_value, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - dd_fill is FillValue
+!>
+!>    to compute the mean without extremum of an array:<br/>
+!> @code
+!>    dl_value=math_mwe( dl_value, id_next, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - id_next is the number of extremum to be removed
+!>       - dd_fill is FillValue
+!>
+!>    to sort an 1D array:<br/>
+!> @code
+!>    CALL math_QsortC(dl_value)
+!> @endcode
+!>       - dl_value is 1D array
+!>
+!>    to correct phase angles to produce smoother phase:<br/>
+!> @code
+!>    CALL math_unwrap(dl_value, [dl_discont])
+!> @endcode
+!>       - dl_value is 1D array
+!>       - dl_discont maximum discontinuity between values, default pi
+!>
+!>    to compute simple operation
+!> @code
+!>    dl_res=math_compute(cl_var)
+!> @endcode
+!>       - cl_var operation to compute (string of character)
+!>       - dl_res result of the operation, real(dp)
+!>
+!>    to compute first derivative of 1D array:<br/>
+!> @code
+!>    dl_value(:)=math_deriv_1D( dd_value(:), dd_fill, [ld_discont] )
+!> @endcode
+!>       - dd_value is 1D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - ld_discont is logical to take into account longitudinal 
+!>         East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 2D array:<br/>
+!> @code
+!>    dl_value(:,:)=math_deriv_2D( dd_value(:,:), dd_fill, cd_dim, 
+!>                  [ld_discont] )
+!> @endcode
+!>       - dd_value is 2D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I) or
+!>         second (J) dimension
+!>       - ld_discont is logical to take into account longitudinal 
+!>         East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 3D array:<br/>
+!> @code
+!>    dl_value(:,:,:)=math_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim,
+!>                    [ld_discont] )
+!> @endcode
+!>       - dd_value is 3D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I), second (J),
+!>         or third (K) dimension
+!>       - ld_discont is logical to take into account longitudinal East-West 
+!>         discontinuity [optional]
+!>
+!>
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date January, 2015 - Initial version
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE math
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: math_mean      !< return mean of an array
+   PUBLIC :: math_median    !< return median of an array
+   PUBLIC :: math_mwe       !< return mean without extremum of an array
+   PUBLIC :: math_QsortC    !< sort an 1D array
+   PUBLIC :: math_unwrap    !< correct phase angles to produce smoother phase
+   PUBLIC :: math_compute   !< compute simple operation
+   PUBLIC :: math_deriv_1D  !< compute first derivative of 1D array 
+   PUBLIC :: math_deriv_2D  !< compute first derivative of 2D array 
+   PUBLIC :: math_deriv_3D  !< compute first derivative of 3D array
+
+
+   PRIVATE :: math__Partition
+   PRIVATE :: math__mean_1d
+   PRIVATE :: math__mean_2d
+   PRIVATE :: math__median_1d
+   PRIVATE :: math__median_2d
+   PRIVATE :: math__mwe_1d
+   PRIVATE :: math__mwe_2d
+   PRIVATE :: math__parentheses
+
+
+   INTERFACE math_mean
+      MODULE PROCEDURE math__mean_1d ! return mean of an array 1D
+      MODULE PROCEDURE math__mean_2d ! return mean of an array 2D
+   END INTERFACE math_mean
+
+   INTERFACE math_median
+      MODULE PROCEDURE math__median_1d ! return median of an array 1D
+      MODULE PROCEDURE math__median_2d ! return median of an array 2D
+   END INTERFACE math_median
+
+   INTERFACE math_mwe
+      MODULE PROCEDURE math__mwe_1d ! return mean without extremum of an array 1D
+      MODULE PROCEDURE math__mwe_2d ! return mean without extremum of an array 2D
+   END INTERFACE math_mwe
+
+CONTAINS
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean of a 1D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  1D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return mean value, real(dp)
+   !------------------------------------------------------------------- 
+   PURE REAL(dp) FUNCTION math__mean_1d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)  :: il_count
+      REAL(dp)     :: dl_sum
+      REAL(dp)     :: dl_count
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill) )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            dl_sum  =SUM ( dd_array(:), dd_array(:)/= dd_fill )
+            dl_count=REAL( il_count, dp)
+
+            math__mean_1d=dl_sum/dl_count
+         ELSE
+            math__mean_1d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            dl_sum  =SUM ( dd_array(:) )
+            dl_count=REAL( il_count, dp)
+
+            math__mean_1d=dl_sum/dl_count
+         ELSE
+            math__mean_1d=0
+         ENDIF
+      ENDIF
+
+   END FUNCTION math__mean_1d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean of a 2D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  2D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return mean value, real(dp)
+   !------------------------------------------------------------------- 
+   PURE REAL(dp) FUNCTION math__mean_2d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+         ELSE
+            math__mean_2d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+         ELSE
+            math__mean_2d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         math__mean_2d=math_mean(dl_list(:))
+         DEALLOCATE( dl_list )
+      ENDIF
+
+   END FUNCTION math__mean_2d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the median of a 1D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  1D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__median_1d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
+         ELSE
+            math__median_1d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=dd_array(:)
+         ELSE
+            math__median_1d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         CALL math_QsortC(dl_list(:))
+
+         IF( MOD(il_count,2) == 0 )THEN
+            math__median_1d=(dl_list(il_count/2+1)+dl_list(il_count/2))/2_dp
+         ELSE
+            math__median_1d=dl_list(il_count/2+1)
+         ENDIF
+
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__median_1d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the median of a 2D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  2D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__median_2d(dd_array, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+         ELSE
+            math__median_2d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:,:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+         ELSE
+            math__median_2d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         math__median_2d=math_median(dl_list(:))
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__median_2d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean without extremum of a 1D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  1D array 
+   !> @param[in] id_next   number of extremum to be removed
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__mwe_1d(dd_array, id_next, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      INTEGER(i4)           , INTENT(IN), OPTIONAL :: id_next
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_next
+      INTEGER(i4)                         :: il_count
+      INTEGER(i4)                         :: il_size
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+
+      il_next=2
+      IF( PRESENT(id_next) ) il_next=id_next
+      
+      il_size=SIZE(dd_array(:))
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
+         ELSE
+            math__mwe_1d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=dd_array(:)
+         ELSE
+            math__mwe_1d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         CALL math_QsortC(dl_list(:))
+
+         IF( il_count == il_size )THEN
+            ! no fillValue
+            math__mwe_1d=math_mean(dl_list(il_next+1:il_size-il_next))
+         ELSEIF( il_count > il_size-2*il_next )THEN
+            ! remove one extremum each side
+            math__mwe_1d=math_mean(dl_list(2:il_size-1))
+         ELSE ! il_count <= il_size-2*il_next
+            ! more than 2*il_next fillValue
+            ! compute mean only
+            math__mwe_1d=math_mean(dl_list(:))
+         ENDIF
+
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__mwe_1d
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean without extremum of a 2D array. 
+   ! 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   ! 
+   !> @param[in] dd_array  2D array 
+   !> @param[in] id_next   number of extremum to be removed
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+   PURE REAL(dp) FUNCTION math__mwe_2d(dd_array, id_next, dd_fill)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      INTEGER(i4)             , INTENT(IN), OPTIONAL :: id_next
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+
+            math__mwe_2d=math_mwe(dl_list(:), id_next)
+         ELSE
+            math__mwe_2d=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:,:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+
+            math__mwe_2d=math_mwe(dl_list(:), id_next)
+         ELSE
+            math__mwe_2d=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) ) DEALLOCATE(dl_list)
+
+   END FUNCTION math__mwe_2d
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine sort a 1D array. 
+   !>
+   !> @details
+   !> Recursive Fortran 95 quicksort routine
+   !> sorts real numbers into ascending numerical order
+   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
+   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
+   !> 1997 printing
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Rewrite with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  1D array 
+   !-------------------------------------------------------------------
+   PURE RECURSIVE SUBROUTINE math_QsortC(dd_array)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_array
+
+      ! local variable
+      INTEGER(i4) :: il_iq
+      !----------------------------------------------------------------
+     
+      IF( SIZE(dd_array(:)) > 1 )THEN
+         CALL math__Partition(dd_array, il_iq)
+         CALL math_QsortC(dd_array(:il_iq-1))
+         CALL math_QsortC(dd_array(il_iq:))
+      ENDIF
+
+   END SUBROUTINE math_QsortC
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine partition a 1D array. 
+   !>
+   !> @details
+   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
+   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
+   !> 1997 printing
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Rewrite with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  1D array 
+   !> @param[in] id_marker 
+   !-------------------------------------------------------------------
+   PURE SUBROUTINE math__Partition(dd_array, id_marker)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
+      INTEGER(i4),               INTENT(  OUT) :: id_marker
+
+      ! local variable
+      REAL(dp)    :: dl_temp
+      REAL(dp)    :: dl_x     ! pivot point
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      dl_x = dd_array(1)
+      ji= 0
+      jj= SIZE(dd_array(:)) + 1
+
+      DO 
+         jj=jj-1
+         DO
+            IF( dd_array(jj) <= dl_x ) EXIT
+            jj=jj-1
+         ENDDO
+         ji=ji+1
+         DO
+            IF( dd_array(jj) >= dl_x ) EXIT
+            ji=ji+1
+         ENDDO
+         IF( ji < jj )THEN
+            ! exchange dd_array(ji) and dd_array(jj)
+            dl_temp= dd_array(ji)
+            dd_array(ji) = dd_array(jj)
+            dd_array(jj) = dl_temp
+         ELSEIF( ji==jj )THEN
+            id_marker=ji+1
+            RETURN
+         ELSE
+            id_marker=ji
+            RETURN
+         ENDIF
+      ENDDO
+
+   END SUBROUTINE math__Partition
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine correct phase angles to produce smoother 
+   !> phase plots. 
+   !>
+   !> @details
+   !> This code is based on numpy unwrap function
+   !>
+   !> Unwrap by changing deltas between values to 2*pi complement.
+   !>
+   !> Unwrap radian phase `dd_array` by changing absolute jumps greater than
+   !> `dd_discont` to their 2*pi complement.
+   !>
+   !> @note If the discontinuity in `dd_array` is smaller than ``pi``, 
+   !> but larger than `dd_discont`, no unwrapping is done because taking
+   !> the 2*pi complement would only make the discontinuity larger.
+   !>
+   !> @author J.Paul 
+   !> @date Marsh, 2015 - Rewrite in fortran, with SIREN coding rules 
+   ! 
+   !> @param[inout] dd_array  1D array 
+   !> @param[in] dd_discont maximum discontinuity between values, default pi
+   !-------------------------------------------------------------------
+   PURE SUBROUTINE math_unwrap(dd_array, dd_discont)
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
+      REAL(dp)   ,               INTENT(IN   ), OPTIONAL :: dd_discont
+
+      ! local variable
+      INTEGER(i4)                         :: il_size
+
+      REAL(dp)                            :: dl_discont
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_diff
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_mod
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_correct
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      dl_discont=dp_pi
+      IF( PRESENT(dd_discont) ) dl_discont=dd_discont
+
+      il_size=SIZE(dd_array)
+      ALLOCATE(dl_diff(il_size-1))
+      DO ji=1,il_size-1
+         dl_diff(ji)=dd_array(ji+1)-dd_array(ji)
+      ENDDO
+
+      ALLOCATE(dl_mod(il_size-1))
+      DO ji=1,il_size-1
+         dl_mod(ji) = MOD(dl_diff(ji) + dp_pi, 2*dp_pi) - dp_pi
+      ENDDO
+
+      WHERE( (dl_mod(:) == -dp_pi) .AND. (dl_diff(:) > 0._dp ) )
+         dl_mod(:)=dp_pi
+      END WHERE
+
+      ALLOCATE(dl_correct(il_size-1))
+      dl_correct(:)=dl_mod(:)-dl_diff(:)
+
+      DEALLOCATE(dl_mod)
+
+      WHERE( ABS(dl_diff(:)) < dl_discont )
+         dl_correct(:)=0._dp
+      END WHERE
+
+      DEALLOCATE(dl_diff)
+      
+      ALLOCATE(dl_tmp(il_size))
+      dl_tmp(:)=dd_array(:)
+
+      DO ji=1,il_size-1
+         dd_array(ji+1)=dl_tmp(ji+1)+SUM(dl_correct(1:ji))
+      ENDDO
+
+      DEALLOCATE(dl_correct)
+      DEALLOCATE(dl_tmp)
+
+   END SUBROUTINE math_unwrap
+   !------------------------------------------------------------------- 
+   !> @brief This function compute simple operation 
+   !>
+   !> @details
+   !> - operation should be write as a string of character.
+   !> - operators allowed are : +,-,*,/ 
+   !> - to ordered operation you should use parentheses
+   !>
+   !> exemples: '1e6/(16/122)', '(3/2)*(2+1)' 
+   !>
+   !> @author J.Paul 
+   !> @date June, 2015 - initial version
+   ! 
+   !> @param[in] cd_var operation to compute (string of character)  
+   !> @return result of the operation, real(dp)
+   !-------------------------------------------------------------------
+   REAL(dp) RECURSIVE FUNCTION math_compute(cd_var) RESULT(dd_res)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+   
+      ! local variables
+      CHARACTER(LEN=lc) :: cl_var
+      CHARACTER(LEN=lc) :: cl_str1
+      CHARACTER(LEN=lc) :: cl_str2
+   
+      INTEGER(i4)       :: il_ind
+      ! loop indices
+      !----------------------------------------------------------------
+   
+   
+      IF(fct_is_real(cd_var))THEN
+         READ(cd_var,*) dd_res
+      ELSE
+      
+   
+         CALL math__parentheses(cd_var, cl_var)
+         
+         IF(fct_is_real(cl_var))THEN
+            READ(cl_var,*) dd_res
+         ELSE
+            il_ind=SCAN(TRIM(cl_var),'*')
+            IF( il_ind /= 0 )THEN
+               cl_str1=cl_var(1:il_ind-1)
+               cl_str2=cl_var(il_ind+1:)
+               dd_res=math_compute(cl_str1)*math_compute(cl_str2)
+            ELSE
+               il_ind=SCAN(TRIM(cl_var),'/')
+               IF( il_ind /= 0 )THEN
+                  cl_str1=cl_var(1:il_ind-1)
+                  cl_str2=cl_var(il_ind+1:)
+                  dd_res=math_compute(cl_str1)/math_compute(cl_str2)
+               ELSE
+                  il_ind=SCAN(TRIM(cl_var),'+')
+                  IF( il_ind /= 0 )THEN
+                     cl_str1=cl_var(1:il_ind-1)
+                     cl_str2=cl_var(il_ind+1:)
+                     dd_res=math_compute(cl_str1)+math_compute(cl_str2)
+                  ELSE
+                     il_ind=SCAN(TRIM(cl_var),'-')
+                     IF( il_ind /= 0 )THEN
+                        cl_str1=cl_var(1:il_ind-1)
+                        cl_str2=cl_var(il_ind+1:)
+                        dd_res=math_compute(cl_str1)-math_compute(cl_str2)
+                     ELSE
+                        dd_res=dp_fill
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+   
+   END FUNCTION math_compute
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine replace sub string inside parentheses
+   !> by the value of the operation inside.
+   !>
+   !> @details
+   !> exemple : 
+   !> - '2.6+(3/2)' => '2.6+1.5000'
+   !>
+   !> @author J.Paul 
+   !> @date June, 2015 - initial version
+   ! 
+   !> @param[in] cd_varin  string of character with operation inside
+   !> parentheses 
+   !> @param[out] cd_varout string of character with result of 
+   !> operation inside parentheses
+   !-------------------------------------------------------------------   
+   SUBROUTINE math__parentheses(cd_varin, cd_varout)
+      IMPLICIT NONE
+      ! Argument      
+      CHARACTER(LEN=*) , INTENT(IN)  :: cd_varin
+      CHARACTER(LEN=lc), INTENT(OUT) :: cd_varout
+      ! local variables
+      CHARACTER(LEN=lc)     :: cl_cpt
+      INTEGER(i4)           :: il_ind
+      INTEGER(i4)           :: il_count
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_ind=INDEX(cd_varin,'(')
+      IF( il_ind /= 0 )THEN
+         il_count=0
+         DO ji=il_ind+1,LEN(cd_varin)
+            IF( cd_varin(ji:ji) == '(' )THEN
+               il_count=il_count+1
+            ELSEIF( cd_varin(ji:ji) == ')' )THEN
+               IF( il_count == 0 )THEN
+                  WRITE(cl_cpt,*) math_compute(cd_varin(il_ind+1:ji-1))
+                  cd_varout=TRIM(cd_varin(1:il_ind-1))//TRIM(ADJUSTL(cl_cpt))//&
+                     &        TRIM(cd_varin(ji+1:))
+                  EXIT
+               ELSE
+                  il_count=il_count-1
+               ENDIF
+            ENDIF
+         ENDDO
+      ELSE
+         cd_varout=TRIM(cd_varin)
+      ENDIF
+   
+   END SUBROUTINE math__parentheses
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 1D array.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_value     1D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+   PURE FUNCTION math_deriv_1D( dd_value, dd_fill, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value
+      REAL(dp)                 , INTENT(IN) :: dd_fill
+      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: math_deriv_1D
+
+      ! local variable
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+
+      REAL(dp)                               :: dl_min
+      REAL(dp)                               :: dl_max
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+      !----------------------------------------------------------------
+      ! init
+      math_deriv_1D(:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:))
+
+      ALLOCATE( dl_value(3))
+
+      ! compute derivative in i-direction
+      DO ji=1,il_shape(1)
+         
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2)=dd_value(il_imin:il_imax)
+            IF( il_imin == 1 )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=-1,      &
+               &                    BOUNDARY=dl_value(1) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=1,       &
+               &                    BOUNDARY=dl_value(3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:) < 0._dp ) 
+                     dl_value(:) = dl_value(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:) > 180._dp ) 
+                     dl_value(:) = dl_value(:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+         IF( dl_value( 2) /= dd_fill .AND. & ! ji
+         &   dl_value( 3) /= dd_fill .AND. & ! ji+1
+         &   dl_value( 1) /= dd_fill )THEN   ! ji-1
+
+            math_deriv_1D(ji)=&
+            &  ( dl_value(3) - dl_value(1) ) / &
+            &  REAL( il_imax-il_imin ,dp)
+
+         ENDIF
+
+      ENDDO
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_1D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 2D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I) or second (J) dimension. 
+   !>
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] dd_value     2D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension 
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+   FUNCTION math_deriv_2D( dd_value, dd_fill, cd_dim, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value
+      REAL(dp)                   , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim
+      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2) ) :: math_deriv_2D
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin
+      INTEGER(i4)                              :: il_imax
+      INTEGER(i4)                              :: il_jmin
+      INTEGER(i4)                              :: il_jmax
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+
+      REAL(dp)                                 :: dl_min
+      REAL(dp)                                 :: dl_max
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                  :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      !----------------------------------------------------------------
+      ! init
+      math_deriv_2D(:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+
+            ! init
+            dl_value(:,:)=dd_fill
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(1,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+            
+            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji
+            &      dl_value(3,:) /= dd_fill .AND. &  ! ji+1
+            &      dl_value(1,:) /= dd_fill )        ! ji-1
+
+               math_deriv_2D(ji,:)=&
+               &  ( dl_value(3,:) - dl_value(1,:) ) / &
+               &    REAL( il_imax-il_imin,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,1))
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj
+            &      dl_value(:, 3) /= dd_fill .AND. & ! jj+1
+            &      dl_value(:, 1) /= dd_fill )       ! jj-1
+
+               math_deriv_2D(:,jj)=&
+               &  ( dl_value(:,3) - dl_value(:,1) ) / &
+               &   REAL(il_jmax-il_jmin,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_2D
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 3D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I), second (J) or third (K) dimension.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension   
+   !> @param[in] ld_discont   logical to take into account east west discontinuity
+   !-------------------------------------------------------------------
+   PURE FUNCTION math_deriv_3D( dd_value, dd_fill, cd_dim, ld_discont )
+
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)                          , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim
+      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2), &
+      &                   SIZE(dd_value,DIM=3)) :: math_deriv_3D
+
+      ! local variable
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4), DIMENSION(3)                  :: il_shape
+
+      REAL(dp)                                   :: dl_min
+      REAL(dp)                                   :: dl_max
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                    :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      
+      INTEGER(i4) :: k1
+      INTEGER(i4) :: k2      
+      !----------------------------------------------------------------
+      ! init
+      math_deriv_3D(:,:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(1,:,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=1,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(3,:,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji
+            &      dl_value(3,:,:) /= dd_fill .AND. & !ji+1 
+            &      dl_value(1,:,:) /= dd_fill )       !ji-1
+
+               math_deriv_3D(ji,:,:)= &
+               &  ( dl_value(3,:,:) - dl_value(1,:,:) ) / &
+               &  REAL( il_imax-il_imin ,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,1,:) )
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=2,         &
+               &                      SHIFT=1,       &
+               &                      BOUNDARY=dl_value(:,3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj
+               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1
+            &      dl_value(:, 1,:) /= dd_fill )       ! jj-1
+
+               math_deriv_3D(:,jj,:)=&
+               &  ( dl_value(:,3,:) - dl_value(:,1,:) ) / &
+               &  REAL( il_jmax - il_jmin ,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      CASE('K')
+
+         ALLOCATE( dl_value(il_shape(1),il_shape(2),3) )
+         ! compute derivative in k-direction
+         DO jk=1,il_shape(3)
+
+            il_kmin=MAX(jk-1,1)
+            il_kmax=MIN(jk+1,il_shape(3))
+
+            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=3
+            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=2
+            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
+               k1=2  ; k2=3
+            ENDIF
+
+            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
+            IF( il_kmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                      DIM=3,         &
+               &                      SHIFT=-1,      &
+               &                      BOUNDARY=dl_value(:,:,1) )
+            ENDIF
+            IF( il_kmax == il_shape(3) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+               &                        DIM=3,         &
+               &                        SHIFT=1,       &
+               &                        BOUNDARY=dl_value(:,:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF         
+
+            WHERE( dl_value(:,:,2) /= dd_fill .AND. & ! jk
+               &   dl_value(:,:,3) /= dd_fill .AND. & ! jk+1
+               &   dl_value(:,:,1) /= dd_fill )       ! jk-1
+
+               math_deriv_3D(:,:,jk)=&
+               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / &
+               &  REAL( il_kmax-il_kmin,dp)         
+
+            END WHERE
+
+         ENDDO
+
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_3D
+END MODULE math
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90	(revision 8732)
@@ -0,0 +1,1064 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+!
+! PROGRAM: merge_bathy
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program merges bathymetry file at boundaries.
+!>
+!> @details
+!> @section sec1 method
+!> Coarse grid Bathymetry is interpolated on fine grid 
+!> (nearest interpolation method is used).  
+!> Then fine Bathymetry and refined coarse bathymetry are merged at boundaries.<br/>
+!>    @f[BathyFine= Weight * BathyCoarse + (1-Weight)*BathyFine@f]
+!> The weight function used is :<br/>
+!>       @f[Weight = 0.5 + 0.5*COS( \frac{\pi*dist}{width} )@f]<br/>
+!> with
+!> - dist : number of point to border 
+!> - width : boundary size
+!>
+!> @section sec2 how to
+!>    to merge bathymetry file:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/merge_bathy merge_bathy.nam
+!> @endcode
+!>    
+!> @note 
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    merge_bathy.nam contains 7 namelists:
+!>       - logger namelist (namlog)
+!>       - config namelist (namcfg)
+!>       - coarse grid namelist (namcrs)
+!>       - fine grid namelist (namfin)
+!       - variable namelist (namvar)
+!>       - nesting namelist (namnst)
+!>       - boundary namelist (nambdy)
+!>       - output namelist (namout)
+!> 
+!>    * _logger namelist (namlog)_:
+!>       - cn_logfile   : logger filename
+!>       - cn_verbosity : verbosity ('trace','debug','info',
+!>  'warning','error','fatal','none')
+!>       - in_maxerror  : maximum number of error allowed
+!>
+!>    * _config namelist (namcfg)_:
+!>       - cn_varcfg : variable configuration file 
+!> (see ./SIREN/cfg/variable.cfg)
+!>       - cn_dimcfg : dimension configuration file. define dimensions allowed
+!> (see ./SIREN/cfg/dimension.cfg).
+!>       - cn_dumcfg : useless (dummy) configuration file, for useless 
+!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
+!>
+!>    * _coarse grid namelist (namcrs)_:
+!>       - cn_bathy0 : bathymetry file
+!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
+!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
+!>
+!>    * _fine grid namelist (namfin)_:
+!>       - cn_bathy1 : bathymetry file
+!>       - in_perio1 : NEMO periodicity index
+!>
+!    * _variable namelist (namvar)_:
+!       - cn_varinfo : list of variable and extra information about request(s) 
+!       to be used (separated by ',').<br/>
+!          each elements of *cn_varinfo* is a string character.<br/>
+!          it is composed of the variable name follow by ':', 
+!          then request(s) to be used on this variable.<br/> 
+!          request could be:
+!             - int = interpolation method
+! 
+!                requests must be separated by ';'.<br/>
+!                order of requests does not matter.<br/>
+!
+!          informations about available method could be find in 
+!          @ref interp modules.<br/>
+!          Example: 'bathymetry: int=cubic'
+!          @note 
+!             If you do not specify a method which is required, 
+!             default one is apply.
+!          @warning 
+!             variable name must be __Bathymetry__ here.
+!>
+!>    * _nesting namelist (namnst)_:
+!>       - in_rhoi  : refinement factor in i-direction
+!>       - in_rhoj  : refinement factor in j-direction
+!>
+!>    * _boundary namelist (nambdy)_:
+!>       - ln_north : use north boundary or not
+!>       - ln_south : use south boundary or not
+!>       - ln_east  : use east  boundary or not
+!>       - ln_west  : use west  boundary or not
+!>       - cn_north : north boundary indices on fine grid<br/>
+!>          *cn_north* is a string character defining boundary
+!>          segmentation.<br/>
+!>          segments are separated by '|'.<br/>
+!>          each segments of the boundary is composed of:
+!>             - indice of velocity (orthogonal to boundary .ie. 
+!>                for north boundary, J-indice). 
+!>             - indice of segment start (I-indice for north boundary) 
+!>             - indice of segment end   (I-indice for north boundary)<br/>
+!>                indices must be separated by ':' .<br/>
+!>             - optionally, boundary size could be added between '(' and ')' 
+!>             in the first segment defined.
+!>                @note 
+!>                   boundary size is the same for all segments of one boundary.
+!>
+!>          Examples:
+!>             - cn_north='index1,first1:last1(width)'
+!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
+!>
+!>       - cn_south : south boundary indices on fine grid<br/>
+!>       - cn_east  : east  boundary indices on fine grid<br/>
+!>       - cn_west  : west  boundary indices on fine grid<br/>
+!>       - in_ncrs  : number of point(s) with coarse value save at boundaries<br/>
+!>       - ln_oneseg: use only one segment for each boundary or not
+!>
+!>    * _output namelist (namout)_:
+!>       - cn_fileout : merged bathymetry file
+!>
+!> @author J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date Sepember, 2014 
+!> - add header for user
+!> @date July, 2015 
+!> - extrapolate all land points
+!> - add attributes with boundary string character (as in namelist)
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date October, 2016
+!> - allow to choose the number of boundary point with coarse grid value.
+!> - dimension to be used select from configuration file
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM merge_bathy
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE boundary                        ! boundary manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_tmp
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_attind
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_shift
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+
+   REAL(dp)                                           :: dl_fill
+   REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_refined
+   REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_weight
+
+   TYPE(TMPP)                                         :: tl_bathy0
+   TYPE(TMPP)                                         :: tl_bathy1
+   TYPE(TFILE)                                        :: tl_fileout
+   
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_var
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+   
+   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jk
+   INTEGER(i4) :: jl
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'merge_bathy.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namcrs
+   CHARACTER(LEN=lc)                       :: cn_bathy0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namfin
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
+   INTEGER(i4)                             :: in_perio1 = -1
+
+!   ! namvar
+!   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi  = 0
+   INTEGER(i4)                             :: in_rhoj  = 0
+
+   ! nambdy
+   LOGICAL                                 :: ln_north = .TRUE.
+   LOGICAL                                 :: ln_south = .TRUE.
+   LOGICAL                                 :: ln_east  = .TRUE.
+   LOGICAL                                 :: ln_west  = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_north = ''
+   CHARACTER(LEN=lc)                       :: cn_south = ''
+   CHARACTER(LEN=lc)                       :: cn_east  = ''
+   CHARACTER(LEN=lc)                       :: cn_west  = ''
+   INTEGER(i4)                             :: in_ncrs  = 2
+   LOGICAL                                 :: ln_oneseg= .TRUE.
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_merged.nc' 
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< config namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namcrs/ &  !< coarse grid namelist
+   &  cn_bathy0,  &     !< bathymetry file
+   &  in_perio0         !< periodicity index
+   
+   NAMELIST /namfin/ &  !< fine grid namelist
+   &  cn_bathy1,     &  !< bathymetry file
+   &  in_perio1         !< periodicity index
+ 
+!   NAMELIST /namvar/ &  !< variable namelist
+!   &  cn_varinfo        !< list of variable and interpolation 
+!                        !< method to be used. 
+!                        !< (ex: 'votemper|linear','vosaline|cubic' ) 
+   
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,    &     !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /nambdy/ &  !< boundary namelist
+   &  ln_north,   &     !< use north boundary
+   &  ln_south,   &     !< use south boundary
+   &  ln_east ,   &     !< use east  boundary
+   &  ln_west ,   &     !< use west  boundary
+   &  cn_north,   &     !< north boundary indices on fine grid
+   &  cn_south,   &     !< south boundary indices on fine grid
+   &  cn_east ,   &     !< east  boundary indices on fine grid
+   &  cn_west ,   &     !< west  boundary indices on fine grid
+   &  in_ncrs,    &     !< number of point with coarse value save at boundaries 
+   &  ln_oneseg         !< use only one segment for each boundary or not
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout        !< fine grid merged bathymetry file   
+   !-------------------------------------------------------------------
+
+   ! namelist
+   ! get namelist
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+   IF( il_narg/=1 )THEN
+      PRINT *,"MERGE BATHY: ERROR. need a namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+   
+   ! read namelist
+   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"MERGE BATHY: ERROR opening "//TRIM(cl_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namcrs )
+      READ( il_fileid, NML = namfin )
+!      READ( il_fileid, NML = namvar )
+!      ! add user change in extra information
+!      CALL var_chg_extra(cn_varinfo)
+
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = nambdy )
+
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("MERGE BATHY: ERROR closing "//TRIM(cl_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"MERGE BATHY: ERROR. can not find "//TRIM(cl_namelist)
+
+   ENDIF
+
+   ! open files
+   IF( TRIM(cn_bathy0) /= '' )THEN
+      tl_bathy0=mpp_init( file_init(TRIM(cn_bathy0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_bathy0)
+   ELSE
+      CALL logger_fatal("MERGE BATHY: can not find coarse grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("MERGE BATHY: can not find fine grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE BATHY: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check namelist
+   ! check refinament factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("MERGE BATHY: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   ! check domain indices
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_bathy0, tl_bathy1, &
+   &                                 id_rho=il_rho(:) )
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_bathy0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coincidence between coarse and fine grid
+   CALL grid_check_coincidence( tl_bathy0, tl_bathy1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )
+
+   ! open mpp files
+   CALL iom_mpp_open(tl_bathy1)
+
+   ! read or compute boundary
+   tl_var=iom_mpp_read_var(tl_bathy1,'Bathymetry')
+
+   ! close mpp files
+   CALL iom_mpp_close(tl_bathy1)
+
+   tl_bdy(:)=boundary_init(tl_var, ln_north, ln_south, ln_east, ln_west, &
+   &                               cn_north, cn_south, cn_east, cn_west, &
+   &                               ln_oneseg ) 
+
+   ! get boundary on coarse grid
+   ! define refined bathymetry array (for coarse grid)
+   dl_fill=tl_var%d_fill
+   ALLOCATE( dl_refined(tl_var%t_dim(1)%i_len, &
+   &                    tl_var%t_dim(2)%i_len, &
+   &                    tl_var%t_dim(3)%i_len, &
+   &                    tl_var%t_dim(4)%i_len) )
+
+   dl_refined(:,:,:,:)=dl_fill
+
+   ! define weight array
+   ALLOCATE( dl_weight(tl_var%t_dim(1)%i_len, &
+   &                   tl_var%t_dim(2)%i_len, &
+   &                   1,1) )
+
+   dl_weight(:,:,:,:)=dl_fill 
+
+   ! compute coarse grid refined bathymetry on boundary.
+   DO jk=1,ip_ncard
+      CALL merge_bathy_get_boundary(tl_bathy0, tl_bathy1, tl_bdy(jk), &
+      &                             il_rho(:), in_ncrs,                      &
+      &                             dl_refined(:,:,:,:), dl_weight(:,:,:,:), &
+      &                             dl_fill)
+
+   ENDDO
+
+   ! merge bathy on boundary
+   DO jl=1,tl_var%t_dim(4)%i_len
+      DO jk=1,tl_var%t_dim(3)%i_len
+         WHERE(    dl_refined(:,:,jk,jl) /= dl_fill .AND. &
+         &      tl_var%d_value(:,:,jk,jl)/= tl_var%d_fill )
+            tl_var%d_value(:,:,jk,jl)=  &
+            &           dl_weight(:,:,1,1) *    dl_refined(:,:,jk,jl) + &
+            &        (1-dl_weight(:,:,1,1))*tl_var%d_value(:,:,jk,jl)
+         ELSE WHERE( dl_refined(:,:,jk,jl)== dl_fill .AND. &
+         &           dl_weight(:,:,1,1)  /= dl_fill )
+         ! to keep coarse grid mask on boundary
+            tl_var%d_value(:,:,jk,jl)=dl_fill
+         END WHERE
+      ENDDO
+   ENDDO
+
+   DEALLOCATE(dl_refined)
+
+   ! create file
+   tl_fileout=file_init(TRIM(cn_fileout),id_perio=in_perio1)
+
+   ! add dimension
+   tl_dim(:)=dim_copy(tl_var%t_dim(:))
+
+   DO ji=1,ip_maxdim
+      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+      ! open mpp files
+      CALL iom_mpp_open(tl_bathy1)
+
+      ! add longitude
+      tl_lon=iom_mpp_read_var(tl_bathy1,'longitude')
+      CALL file_add_var(tl_fileout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      tl_lat=iom_mpp_read_var(tl_bathy1,'latitude')
+      CALL file_add_var(tl_fileout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_bathy1)      
+   ENDIF
+
+   CALL file_add_var(tl_fileout, tl_var)
+   CALL var_clean(tl_var)
+
+   ! only 2 first dimension to be used
+   tl_dim(:)=dim_copy(tl_fileout%t_dim(:))
+   tl_dim(3:4)%l_use=.FALSE.
+   tl_var=var_init('weight',dl_weight(:,:,:,:),td_dim=tl_dim(:),dd_fill=dl_fill)
+   CALL file_add_var(tl_fileout, tl_var)
+   CALL var_clean(tl_var)
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN merge_bathy")
+   CALL file_add_att(tl_fileout, tl_att)
+
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   tl_att=att_init("coarse_grid_source_file",TRIM(fct_basename(tl_bathy0%c_name)))
+   CALL file_add_att(tl_fileout, tl_att)
+
+   tl_att=att_init("fine_grid_source_file",TRIM(fct_basename(tl_bathy1%c_name)))
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add attribute periodicity
+   il_attind=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attind=att_get_index(tl_fileout%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_bathy1%i_perio >= 0 .AND. il_attind == 0 )THEN
+      tl_att=att_init('periodicity',tl_bathy1%i_perio)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+   il_attind=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attind=att_get_index(tl_fileout%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_bathy1%i_ew >= 0 .AND. il_attind == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_bathy1%i_ew)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+
+   IF( tl_bdy(jp_north)%l_use )THEN
+      ! add shift on north boundary
+      ! boundary compute on T point but express on U or V point
+      il_shift=1
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_index-il_shift))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_north)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_index-il_shift))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_last))
+      ENDDO
+      tl_att=att_init("bdy_north",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_south)%l_use )THEN
+      
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_index))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_south)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_index))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_south",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_east)%l_use )THEN
+      ! add shift on east boundary
+      ! boundary compute on T point but express on U or V point
+      il_shift=1
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_index-il_shift))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_east)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_index-il_shift))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_east",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_west)%l_use )THEN
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_index))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_west)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_index))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_west",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   ! create file
+   CALL iom_create(tl_fileout)
+
+   ! write file
+   CALL iom_write_file(tl_fileout)
+
+   ! close file
+   CALL iom_close(tl_fileout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL file_clean(tl_fileout)
+   CALL mpp_clean(tl_bathy1)
+   CALL mpp_clean(tl_bathy0)
+   DEALLOCATE(dl_weight)
+   CALL boundary_clean(tl_bdy(:))
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute refined bathymetry on boundary from coarse grid.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_bathy0       coarse grid bathymetry file structure 
+   !> @param[in] td_bathy1       fine grid bathymetry file structure
+   !> @param[in] td_bdy          boundary structure
+   !> @param[in] id_rho          array of refinement factor
+   !> @param[in] id_ncrs         number of point with coarse value save at boundaries
+   !> @param[inout] dd_refined   array of refined bathymetry 
+   !> @param[inout] dd_weight    array of weight
+   !> @param[in] dd_fill         fillValue
+   !>
+   !-------------------------------------------------------------------
+   SUBROUTINE merge_bathy_get_boundary( td_bathy0, td_bathy1, td_bdy, &
+   &                                    id_rho, id_ncrs,              &
+   &                                    dd_refined, dd_weight, dd_fill )
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)                     , INTENT(IN   ) :: td_bathy0
+      TYPE(TMPP)                     , INTENT(IN   ) :: td_bathy1
+      TYPE(TBDY)                     , INTENT(IN   ) :: td_bdy
+      INTEGER(i4), DIMENSION(:)      , INTENT(IN   ) :: id_rho
+      INTEGER(i4)                    , INTENT(IN   ) :: id_ncrs
+      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_refined
+      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_weight
+      REAL(dp)                       , INTENT(IN   ) :: dd_fill  
+
+      ! local variable
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+      
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_width
+
+      INTEGER(i4), DIMENSION(2,2)         :: il_offset
+      INTEGER(i4), DIMENSION(2,2)         :: il_ind
+
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_tmp1d
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_tmp2d
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_wseg
+
+      TYPE(TVAR) :: tl_var0
+      TYPE(TVAR) :: tl_lon1
+      TYPE(TVAR) :: tl_lat1
+
+      TYPE(TMPP)  :: tl_bathy1
+      TYPE(TMPP)  :: tl_bathy0
+
+      TYPE(TDOM)  :: tl_dom1
+      TYPE(TDOM)  :: tl_dom0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( td_bdy%l_use )THEN
+         DO jl=1,td_bdy%i_nseg
+            ! get boundary definition
+            SELECT CASE(TRIM(td_bdy%c_card))
+            CASE('north')
+
+               il_imin1=td_bdy%t_seg(jl)%i_first
+               il_imax1=td_bdy%t_seg(jl)%i_last 
+               il_jmin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1)
+               il_jmax1=td_bdy%t_seg(jl)%i_index
+
+               ! do not used grid point to compute 
+               ! boundaries indices (cf create_boundary)
+               ! as Bathymetry always on T point
+
+            CASE('south')
+
+               il_imin1=td_bdy%t_seg(jl)%i_first
+               il_imax1=td_bdy%t_seg(jl)%i_last 
+               il_jmin1=td_bdy%t_seg(jl)%i_index
+               il_jmax1=td_bdy%t_seg(jl)%i_index+(td_bdy%t_seg(jl)%i_width-1)
+
+            CASE('east')
+
+               il_imin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1)
+               il_imax1=td_bdy%t_seg(jl)%i_index
+               il_jmin1=td_bdy%t_seg(jl)%i_first
+               il_jmax1=td_bdy%t_seg(jl)%i_last 
+
+               ! do not used grid point to compute 
+               ! boundaries indices (cf create_boundary)
+               ! as Bathymetry always on T point
+
+            CASE('west')
+
+               il_imin1=td_bdy%t_seg(jl)%i_index
+               il_imax1=td_bdy%t_seg(jl)%i_index+(td_bdy%t_seg(jl)%i_width-1)
+               il_jmin1=td_bdy%t_seg(jl)%i_first
+               il_jmax1=td_bdy%t_seg(jl)%i_last 
+
+            END SELECT
+
+            ! -read fine grid domain
+            tl_bathy1=mpp_copy(td_bathy1)
+
+            ! compute domain
+            tl_dom1=dom_init( tl_bathy1,         &
+            &                 il_imin1, il_imax1,&
+            &                 il_jmin1, il_jmax1,&
+            &                 TRIM(td_bdy%c_card))
+
+            ! add extra band to fine grid domain (if possible)
+            ! to avoid dimension of one and so be able to compute offset
+            CALL dom_add_extra(tl_dom1, id_rho(jp_I), id_rho(jp_J))
+
+            ! open mpp files over domain
+            CALL iom_dom_open(tl_bathy1, tl_dom1)
+
+            ! read variable value on domain
+            tl_lon1=iom_dom_read_var(tl_bathy1,'longitude',tl_dom1)
+            tl_lat1=iom_dom_read_var(tl_bathy1,'latitude' ,tl_dom1)
+
+            ! close mpp files
+            CALL iom_dom_close(tl_bathy1)
+
+            ! clean structure
+            CALL mpp_clean(tl_bathy1)
+
+            ! get coarse grid indices
+            il_ind(:,:)=grid_get_coarse_index(td_bathy0, tl_lon1, tl_lat1, &
+            &                                 id_rho=id_rho(:))
+
+            il_imin0=il_ind(1,1)
+            il_imax0=il_ind(1,2)
+
+            il_jmin0=il_ind(2,1)
+            il_jmax0=il_ind(2,2)
+
+            ! read coarse grid bathymetry on domain
+            tl_bathy0=mpp_copy(td_bathy0)
+
+            ! compute domain
+            tl_dom0=dom_init( tl_bathy0,         &
+            &                 il_imin0, il_imax0,&
+            &                 il_jmin0, il_jmax0 )
+
+            il_offset(:,:)= grid_get_fine_offset(tl_bathy0,         &
+            &                                    il_imin0, il_jmin0,&
+            &                                    il_imax0, il_jmax0,&
+            &                                    tl_lon1%d_value(:,:,1,1), &
+            &                                    tl_lat1%d_value(:,:,1,1), &
+            &                                    id_rho=id_rho(:))
+
+            ! clean
+            CALL var_clean(tl_lon1)
+            CALL var_clean(tl_lat1)
+
+            ! add extra band (if possible) to compute interpolation
+            CALL dom_add_extra(tl_dom0)
+
+            ! open mpp files over domain
+            CALL iom_dom_open(tl_bathy0, tl_dom0)
+
+            ! read variable value on domain
+            tl_var0=iom_dom_read_var(tl_bathy0,'Bathymetry',tl_dom0)
+
+            ! force to use nearest interpolation
+            tl_var0%c_interp(1)='nearest'
+
+            ! close mpp files
+            CALL iom_dom_close(tl_bathy0)
+
+            ! clean structure
+            CALL mpp_clean(tl_bathy0)
+
+            ! interpolate variable
+            CALL merge_bathy_interp( tl_var0,         &
+            &                        id_rho(:),       &
+            &                        il_offset(:,:) )
+
+            ! remove extraband added to domain
+            CALL dom_del_extra( tl_var0, tl_dom0, id_rho(:) )
+
+            ! remove extraband added to domain
+            CALL dom_clean_extra( tl_dom0 )
+
+            ! remove extraband added to fine grid domain
+            CALL dom_del_extra( tl_var0, tl_dom1 )
+
+            ! remove extraband added to fine grid domain
+            CALL dom_clean_extra( tl_dom1 )
+
+            ! fill refined array
+            dd_refined( il_imin1:il_imax1, &
+            &           il_jmin1:il_jmax1, &
+            &           :,: )= tl_var0%d_value(:,:,:,:)
+
+            ! clean
+            CALL var_clean(tl_var0)
+
+            ! compute weight function
+            ALLOCATE( dl_tmp1d(td_bdy%t_seg(jl)%i_width) )
+
+            SELECT CASE(TRIM(td_bdy%c_card))
+            CASE('north')
+
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(ji,ji=il_width,1,-1),(0,ji=1,id_ncrs)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=1,       &
+               &                    NCOPIES=tl_dom1%t_dim(1)%i_len )
+
+            CASE('south')
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=1,       &
+               &                    NCOPIES=tl_dom1%t_dim(1)%i_len )
+
+            CASE('east')
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(ji,ji=il_width,1,-1),(0,ji=1,id_ncrs)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=2,       &
+               &                    NCOPIES=tl_dom1%t_dim(2)%i_len )
+
+            CASE('west')
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=2,       &
+               &                    NCOPIES=tl_dom1%t_dim(2)%i_len )
+
+            END SELECT
+
+            DEALLOCATE( dl_tmp1d )
+
+            ! fill weight array
+            ALLOCATE( dl_tmp2d( tl_dom1%t_dim(1)%i_len, &
+            &                   tl_dom1%t_dim(2)%i_len) )
+
+            dl_tmp2d(:,:)=dd_weight( il_imin1:il_imax1, &
+            &                        il_jmin1:il_jmax1, &
+            &                        1,1 )
+
+            WHERE( dl_tmp2d(:,:) == dd_fill )
+               dl_tmp2d(:,:)= dl_wseg(:,:)
+            ELSE WHERE
+               dl_tmp2d(:,:)= MAX( dl_tmp2d(:,:), dl_wseg(:,:) )
+            END WHERE
+
+            dd_weight( il_imin1:il_imax1, &
+            &          il_jmin1:il_jmax1, &
+            &          1,1 ) = dl_tmp2d(:,:)
+
+            DEALLOCATE( dl_wseg )
+            DEALLOCATE( dl_tmp2d )
+
+         ENDDO
+      ENDIF
+   END SUBROUTINE merge_bathy_get_boundary
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext) 
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+   SUBROUTINE merge_bathy_interp( td_var,          &
+   &                              id_rho,          &
+   &                              id_offset,       &
+   &                              id_iext, id_jext)
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      TYPE(TVAR)  :: tl_mask
+
+      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: two extrabands are required for cubic interpolation
+      il_iext=3
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=3
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("MERGE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("MERGE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on mask
+      ! create mask
+      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+      &                td_var%t_dim(2)%i_len, &
+      &                td_var%t_dim(3)%i_len, &
+      &                td_var%t_dim(4)%i_len) )
+
+      bl_mask(:,:,:,:)=1
+      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+      SELECT CASE(TRIM(td_var%c_point))
+      CASE DEFAULT ! 'T'
+         tl_mask=var_init('tmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+         &                id_ew=td_var%i_ew )
+      CASE('U','V','F')
+         CALL logger_fatal("MERGE BATHY INTERP: can not computed "//&
+         &                 "interpolation on "//TRIM(td_var%c_point)//&
+         &                 " grid point (variable "//TRIM(td_var%c_name)//&
+         &                 "). check namelist.")
+      END SELECT
+
+      DEALLOCATE(bl_mask)
+
+      ! interpolate mask
+      CALL interp_fill_value( tl_mask, id_rho(:),  &
+      &                       id_offset=id_offset(:,:) )
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_iext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate Bathymetry
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+      ! keep original mask 
+      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+      END WHERE
+
+   END SUBROUTINE merge_bathy_interp
+END PROGRAM merge_bathy
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/mpp.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/mpp.f90	(revision 8732)
@@ -0,0 +1,4101 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: mpp
+!
+! DESCRIPTION:
+!> @brief
+!> This module manage massively parallel processing.
+!
+!> @details
+!> define type TMPP:<br/>
+!> @code
+!> TYPE(TMPP) :: tl_mpp
+!> @endcode
+!>
+!>    to initialise a mpp structure:<br/>
+!> @code
+!>    tl_mpp=mpp_init( cd_file, id_mask, 
+!>                       [id_niproc,] [id_njproc,] [id_nproc,]
+!>                       [id_preci,] [id_precj,] 
+!>                       [cd_type,] [id_ew])
+!> @endcode
+!> or
+!> @code
+!>    tl_mpp=mpp_init( cd_file, td_var, 
+!>                      [id_niproc,] [id_njproc,] [id_nproc,]
+!>                      [id_preci,] [id_precj,]
+!>                      [cd_type] )
+!> @endcode
+!> or
+!> @code
+!>    tl_mpp=mpp_init( td_file [,id_ew] )
+!> @endcode
+!>       - cd_file is the filename of the global domain file, in which 
+!>         MPP will be done (example: Bathymetry) 
+!>       - td_file is the file structure of one processor file composing an MPP
+!>       - id_mask is the 2D mask of global domain [optional]
+!>       - td_var is a variable structure (on T-point) from global domain file.
+!>         mask of the domain will be computed using FillValue [optional]
+!>       - id_niproc is the number of processor following I-direction to be used
+!>         [optional]
+!>       - id_njproc is the number of processor following J-direction to be used 
+!>         [optional]
+!>       - id_nproc is the total number of processor to be used [optional]
+!>       - id_preci is the size of the overlap region following I-direction [optional]
+!>       - id_precj is the size of the overlap region following J-direction [optional]
+!>       - cd_type is the type of files composing MPP [optional]
+!>       - id_ew is east-west overlap [optional]<br/> 
+!>  
+!>    to get mpp name:<br/>
+!>    - tl_mpp\%c_name
+!>
+!>    to get the total number of processor:<br/>
+!>    - tl_mpp\%i_nproc
+!>
+!>    to get the number of processor following I-direction:<br/>
+!>    - tl_mpp\%i_niproc
+!>
+!>    to get the number of processor following J-direction:<br/>
+!>    - tl_mpp\%i_njproc
+!>
+!>    to get the length of the overlap region following I-direction:<br/>
+!>    - tl_mpp\%i_preci
+!>
+!>    to get the length of the overlap region following J-direction:<br/>
+!>    - tl_mpp\%i_precj
+!>
+!>    to get the type of files composing mpp structure:<br/>
+!>    - tl_mpp\%c_type
+!>
+!>    to get the type of the global domain:<br/>
+!>    - tl_mpp\%c_dom
+!>
+!>    MPP dimensions (global domain)<br/>
+!>    to get the number of dimensions to be used in mpp strcuture:<br/>
+!>    - tl_mpp\%i_ndim
+!>
+!>    to get the array of dimension structure (4 elts) associated to the
+!>    mpp structure:<br/>
+!>    - tl_mpp\%t_dim(:)
+!>
+!>    MPP processor (files composing domain)<br/>
+!>    - tl_mpp\%t_proc(:)
+!>
+!>    to clean a mpp structure:<br/>
+!> @code
+!>    CALL mpp_clean(tl_mpp)
+!> @endcode
+!>
+!>    to print information about mpp:<br/>
+!> @code
+!>    CALL mpp_print(tl_mpp)
+!> @endcode
+!>
+!>    to add variable to mpp:<br/>
+!> @code
+!>    CALL mpp_add_var(td_mpp, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to add dimension to mpp:<br/>
+!> @code
+!>    CALL mpp_add_dim(td_mpp, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to add attribute to mpp:<br/>
+!> @code
+!>    CALL mpp_add_att(td_mpp, td_att)
+!> @endcode
+!>       - td_att is a attribute structure
+!>
+!>    to delete variable from mpp:<br/>
+!> @code
+!>    CALL mpp_del_var(td_mpp, td_var)
+!> @endcode
+!>    or
+!> @code
+!>    CALL mpp_del_var(td_mpp, cd_name)
+!> @endcode
+!>       - td_var is a variable structure
+!>       - cd_name is variable name or standard name
+!>
+!>    to delete dimension from mpp:<br/>
+!> @code
+!>    CALL mpp_del_dim(td_mpp, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to delete attribute from mpp:<br/>
+!> @code
+!>    CALL mpp_del_att(td_mpp, td_att)
+!> @endcode
+!>    or
+!> @code
+!>    CALL mpp_del_att(td_mpp, cd_name)
+!> @endcode
+!>       - td_att is a attribute structure
+!>       - cd_name is attribute name
+!>
+!>    to overwrite variable to mpp:<br/>
+!> @code
+!>    CALL mpp_move_var(td_mpp, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to overwrite dimension to mpp:<br/>
+!> @code
+!>    CALL mpp_move_dim(td_mpp, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to overwrite attribute to mpp:<br/>
+!> @code
+!>    CALL mpp_move_att(td_mpp, td_att)
+!> @endcode
+!>       - td_att is a attribute structure
+!>
+!>    to determine domain decomposition type:<br/>
+!> @code
+!>    CALL mpp_get_dom(td_mpp)
+!> @endcode
+!>
+!>    to get processors to be used:<br/>
+!> @code
+!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, & 
+!>    &                         id_jmin, id_jmax )
+!> @endcode
+!>       - id_imin 
+!>       - id_imax 
+!>       - id_jmin 
+!>       - id_jmax 
+!>
+!>    to get sub domains which form global domain contour:<br/>
+!> @code
+!>    CALL mpp_get_contour( td_mpp ) 
+!> @endcode
+!>
+!>    to get global domain indices of one processor:<br/>
+!> @code
+!>    il_ind(1:4)=mpp_get_proc_index( td_mpp, id_procid )
+!> @endcode
+!>       - il_ind(1:4) are global domain indices (i1,i2,j1,j2)
+!>       - id_procid is the processor id
+!>
+!>    to get the processor domain size:<br/>
+!> @code
+!>    il_size(1:2)=mpp_get_proc_size( td_mpp, id_procid )
+!> @endcode
+!>       - il_size(1:2) are the size of domain following I and J
+!>       - id_procid is the processor id
+!>
+!> @author
+!>  J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date October, 2015
+!> - improve way to compute domain layout
+!> @date January, 2016
+!> - allow to print layout file (use lm_layout, hard coded)
+!> - add mpp__compute_halo and mpp__read_halo
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE mpp
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC  :: TMPP       !< mpp structure
+   PRIVATE :: TLAY       !< domain layout structure
+
+   ! function and subroutine
+   PUBLIC :: mpp_copy           !< copy mpp structure
+   PUBLIC :: mpp_init           !< initialise mpp structure
+   PUBLIC :: mpp_clean          !< clean mpp strcuture
+   PUBLIC :: mpp_print          !< print information about mpp structure
+   PUBLIC :: mpp_add_var        !< split/add one variable strucutre in mpp structure
+   PUBLIC :: mpp_add_dim        !< add one dimension to mpp structure
+   PUBLIC :: mpp_add_att        !< add one attribute strucutre in mpp structure
+   PUBLIC :: mpp_del_var        !< delete one variable strucutre in mpp structure
+   PUBLIC :: mpp_del_dim        !< delete one dimension strucutre in mpp structure
+   PUBLIC :: mpp_del_att        !< delete one attribute strucutre in mpp structure
+   PUBLIC :: mpp_move_var       !< overwrite variable structure in mpp structure
+   PUBLIC :: mpp_move_dim       !< overwrite one dimension strucutre in mpp structure
+   PUBLIC :: mpp_move_att       !< overwrite one attribute strucutre in mpp structure
+   PUBLIC :: mpp_recombine_var  !< recombine variable from mpp structure
+   PUBLIC :: mpp_get_index      !< return index of mpp 
+
+   PUBLIC :: mpp_get_dom        !< determine domain decomposition type (full, overlap, noverlap)
+   PUBLIC :: mpp_get_use        !< get sub domains to be used (which cover "zoom domain")
+   PUBLIC :: mpp_get_contour    !< get sub domains which form global domain contour
+   PUBLIC :: mpp_get_proc_index !< get processor domain indices
+   PUBLIC :: mpp_get_proc_size  !< get processor domain size
+
+   PRIVATE :: mpp__add_proc            ! add proc strucutre in mpp structure
+   PRIVATE :: mpp__add_proc_unit       ! add one proc strucutre in mpp structure
+   PRIVATE :: mpp__del_proc            ! delete one proc strucutre in mpp structure
+   PRIVATE :: mpp__del_proc_id         ! delete one proc strucutre in mpp structure, given procesor id
+   PRIVATE :: mpp__del_proc_str        ! delete one proc strucutre in mpp structure, given procesor file structure 
+   PRIVATE :: mpp__move_proc           ! overwrite proc strucutre in mpp structure
+   PRIVATE :: mpp__create_layout       ! create mpp structure using domain layout
+   PRIVATE :: mpp__optimiz             ! compute optimum domain decomposition
+   PRIVATE :: mpp__check_dim           ! check mpp structure dimension with proc or variable dimension
+   PRIVATE :: mpp__check_proc_dim      ! check if processor and mpp structure use same dimension
+   PRIVATE :: mpp__check_var_dim       ! check if variable  and mpp structure use same dimension
+   PRIVATE :: mpp__del_var_name        ! delete variable in mpp structure, given variable name
+   PRIVATE :: mpp__del_var_mpp         ! delete all variable in mpp structure
+   PRIVATE :: mpp__del_var_str         ! delete variable in mpp structure, given variable structure
+   PRIVATE :: mpp__del_att_name        ! delete variable in mpp structure, given variable name
+   PRIVATE :: mpp__del_att_str         ! delete variable in mpp structure, given variable structure
+   PRIVATE :: mpp__split_var           ! extract variable part that will be written in processor 
+   PRIVATE :: mpp__copy_unit           ! copy mpp structure
+   PRIVATE :: mpp__copy_arr            ! copy array of mpp structure
+   PRIVATE :: mpp__get_use_unit        ! get sub domains to be used (which cover "zoom domain")
+   PRIVATE :: mpp__init_mask           ! initialise mpp structure, given mask array
+   PRIVATE :: mpp__init_var            ! initialise mpp structure, given variable strcuture
+   PRIVATE :: mpp__init_file           ! initialise a mpp structure, given file structure 
+   PRIVATE :: mpp__init_file_cdf       ! initialise a mpp structure with cdf file
+   PRIVATE :: mpp__init_file_rstdimg   ! initialise a mpp structure with rstdimg file
+   PRIVATE :: mpp__clean_unit          ! clean mpp strcuture
+   PRIVATE :: mpp__clean_arr           ! clean array of mpp strcuture
+   PRIVATE :: mpp__compute_halo        ! compute subdomain indices defined with halo 
+   PRIVATE :: mpp__read_halo           ! read subdomain indices defined with halo
+
+   PRIVATE :: layout__init             ! initialise domain layout structure
+   PRIVATE :: layout__copy             ! clean domain layout structure
+   PRIVATE :: layout__clean            ! copy  domain layout structure
+
+   TYPE TMPP !< mpp structure
+      ! general 
+      CHARACTER(LEN=lc)                  :: c_name = ''   !< base name 
+      INTEGER(i4)                        :: i_id   = 0    !< mpp id
+
+      INTEGER(i4)                        :: i_niproc = 0  !< number of processors following i
+      INTEGER(i4)                        :: i_njproc = 0  !< number of processors following j
+      INTEGER(i4)                        :: i_nproc  = 0  !< total number of proccessors used
+      INTEGER(i4)                        :: i_preci = 1   !< i-direction overlap region length
+      INTEGER(i4)                        :: i_precj = 1   !< j-direction overlap region length
+      INTEGER(i4)                        :: i_ew    = -1  !< east-west overlap
+      INTEGER(i4)                        :: i_perio = -1  !< NEMO periodicity index
+      INTEGER(i4)                        :: i_pivot = -1  !< NEMO pivot point index F(0),T(1)
+
+      CHARACTER(LEN=lc)                  :: c_type = ''   !< type of the files (cdf, cdf4, dimg)
+      CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, noextra, nooverlap)
+
+      INTEGER(i4)                        :: i_ndim = 0    !< number of dimensions used in mpp
+      TYPE(TDIM),  DIMENSION(ip_maxdim)  :: t_dim         !< global domain dimension
+
+      TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL()     !< files/processors composing mpp
+   END TYPE
+
+   TYPE TLAY !< domain layout structure
+      INTEGER(i4)                          :: i_niproc = 0  !< number of processors following i
+      INTEGER(i4)                          :: i_njproc = 0  !< number of processors following j
+      INTEGER(i4)                          :: i_nland  = 0       !< number of land processors
+      INTEGER(i4)                          :: i_nsea   = 0       !< number of sea  processors
+      INTEGER(i4)                          :: i_mean   = 0       !< mean sea point per proc
+      INTEGER(i4)                          :: i_min    = 0       !< min  sea point per proc
+      INTEGER(i4)                          :: i_max    = 0       !< max  sea point per proc
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_msk   => NULL()  !< sea/land processor mask 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_impp  => NULL()  !< i-indexes for mpp-subdomain left bottom 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_jmpp  => NULL()  !< j-indexes for mpp-subdomain left bottom 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lci   => NULL()  !< i-dimensions of subdomain 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lcj   => NULL()  !< j-dimensions of subdomain 
+   END TYPE
+
+   ! module variable
+   INTEGER(i4) :: im_iumout = 44
+   LOGICAL     :: lm_layout =.FALSE.
+
+   INTERFACE mpp_get_use
+      MODULE PROCEDURE mpp__get_use_unit 
+   END INTERFACE mpp_get_use
+
+   INTERFACE mpp__add_proc
+      MODULE PROCEDURE mpp__add_proc_unit 
+   END INTERFACE mpp__add_proc
+
+   INTERFACE mpp_clean
+      MODULE PROCEDURE mpp__clean_unit 
+      MODULE PROCEDURE mpp__clean_arr   
+   END INTERFACE mpp_clean
+
+   INTERFACE mpp__check_dim
+      MODULE PROCEDURE mpp__check_proc_dim !< check if processor and mpp structure use same dimension
+      MODULE PROCEDURE mpp__check_var_dim  !< check if variable  and mpp structure use same dimension
+   END INTERFACE mpp__check_dim
+
+   INTERFACE mpp__del_proc
+      MODULE PROCEDURE mpp__del_proc_id
+      MODULE PROCEDURE mpp__del_proc_str
+   END INTERFACE mpp__del_proc
+
+   INTERFACE mpp_del_var
+      MODULE PROCEDURE mpp__del_var_name
+      MODULE PROCEDURE mpp__del_var_str
+      MODULE PROCEDURE mpp__del_var_mpp
+   END INTERFACE mpp_del_var
+
+   INTERFACE mpp_del_att
+      MODULE PROCEDURE mpp__del_att_name
+      MODULE PROCEDURE mpp__del_att_str
+   END INTERFACE mpp_del_att
+
+   INTERFACE mpp_init
+      MODULE PROCEDURE mpp__init_mask
+      MODULE PROCEDURE mpp__init_var
+      MODULE PROCEDURE mpp__init_file
+   END INTERFACE mpp_init
+
+   INTERFACE mpp_copy
+      MODULE PROCEDURE mpp__copy_unit  ! copy mpp structure
+      MODULE PROCEDURE mpp__copy_arr   ! copy array of mpp structure
+   END INTERFACE
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy mpp structure in another one
+   !> @details 
+   !> mpp file are copied in a temporary array, 
+   !> so input and output mpp structure do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !>    - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_mpp   mpp structure
+   !> @return copy of input mpp structure
+   !-------------------------------------------------------------------
+   FUNCTION mpp__copy_unit( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(IN)  :: td_mpp
+      ! function
+      TYPE(TMPP) :: mpp__copy_unit
+
+      ! local variable
+      TYPE(TFILE) :: tl_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_trace("MPP COPY: "//TRIM(td_mpp%c_name)//" in "//&
+      &  TRIM(mpp__copy_unit%c_name))
+
+      ! copy mpp variable
+      mpp__copy_unit%c_name     = TRIM(td_mpp%c_name)
+      mpp__copy_unit%i_id       = td_mpp%i_id
+      mpp__copy_unit%i_niproc   = td_mpp%i_niproc
+      mpp__copy_unit%i_njproc   = td_mpp%i_njproc
+      mpp__copy_unit%i_nproc    = td_mpp%i_nproc
+      mpp__copy_unit%i_preci    = td_mpp%i_preci
+      mpp__copy_unit%i_precj    = td_mpp%i_precj
+      mpp__copy_unit%c_type     = TRIM(td_mpp%c_type)
+      mpp__copy_unit%c_dom      = TRIM(td_mpp%c_dom)
+      mpp__copy_unit%i_ndim     = td_mpp%i_ndim
+      mpp__copy_unit%i_ew       = td_mpp%i_ew
+      mpp__copy_unit%i_perio    = td_mpp%i_perio
+      mpp__copy_unit%i_pivot    = td_mpp%i_pivot
+
+      ! copy dimension
+      mpp__copy_unit%t_dim(:) = dim_copy(td_mpp%t_dim(:))
+      
+      ! copy file structure
+      IF( ASSOCIATED(mpp__copy_unit%t_proc) )THEN
+         CALL file_clean(mpp__copy_unit%t_proc(:))
+         DEALLOCATE(mpp__copy_unit%t_proc)
+      ENDIF
+      IF( ASSOCIATED(td_mpp%t_proc) .AND. mpp__copy_unit%i_nproc > 0 )THEN
+         ALLOCATE( mpp__copy_unit%t_proc(mpp__copy_unit%i_nproc) )
+         DO ji=1,mpp__copy_unit%i_nproc
+            tl_file = file_copy(td_mpp%t_proc(ji))
+            mpp__copy_unit%t_proc(ji) = file_copy(tl_file)
+         ENDDO
+         ! clean
+         CALL file_clean(tl_file)
+      ENDIF
+
+   END FUNCTION mpp__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an array of mpp structure in another one
+   !> @details 
+   !> mpp file are copied in a temporary array, 
+   !> so input and output mpp structure do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !>    - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !>
+   !> @param[in] td_mpp   mpp structure
+   !> @return copy of input array of mpp structure
+   !-------------------------------------------------------------------
+   FUNCTION mpp__copy_arr( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), DIMENSION(:), INTENT(IN)  :: td_mpp
+      ! function
+      TYPE(TMPP), DIMENSION(SIZE(td_mpp(:))) :: mpp__copy_arr
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_mpp(:))
+         mpp__copy_arr(ji)=mpp_copy(td_mpp(ji))
+      ENDDO
+
+   END FUNCTION mpp__copy_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about mpp strucutre.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_mpp mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_print(td_mpp)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+
+      ! local variable
+      INTEGER(i4), PARAMETER :: il_freq = 4
+
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_proc
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_lcj
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: jm
+      !----------------------------------------------------------------
+
+      WRITE(*,'((a,a),2(/3x,a,a),9(/3x,a,i0))')&
+      &  "MPP : ",TRIM(td_mpp%c_name), &
+      &  " type   : ",TRIM(td_mpp%c_type), &
+      &  " dom    : ",TRIM(td_mpp%c_dom), &
+      &  " nproc  : ",td_mpp%i_nproc, &
+      &  " niproc : ",td_mpp%i_niproc, &
+      &  " njproc : ",td_mpp%i_njproc, &
+      &  " preci  : ",td_mpp%i_preci, &
+      &  " precj  : ",td_mpp%i_precj, &
+      &  " ndim   : ",td_mpp%i_ndim,  &
+      &  " overlap: ",td_mpp%i_ew, &
+      &  " perio  : ",td_mpp%i_perio, &
+      &  " pivot  : ",td_mpp%i_pivot
+
+      ! print dimension
+      IF(  td_mpp%i_ndim /= 0 )THEN
+         WRITE(*,'(/a)') " MPP dimension"
+         DO ji=1,ip_maxdim
+            IF( td_mpp%t_dim(ji)%l_use )THEN
+               CALL dim_print(td_mpp%t_dim(ji))
+            ENDIF
+         ENDDO
+      ENDIF
+
+      ! print file
+      IF( td_mpp%i_nproc /= 0 .AND. ASSOCIATED(td_mpp%t_proc) )THEN
+         IF( ALL( td_mpp%t_proc(:)%i_iind==0 ) .OR. &
+         &   ALL( td_mpp%t_proc(:)%i_jind==0 ) )THEN
+
+            DO ji=1,td_mpp%i_nproc
+               CALL file_print(td_mpp%t_proc(ji))
+               WRITE(*,'((a),(/3x,a,i0),2(/3x,a,a),4(/3x,a,i0,a,i0)/)')&
+               &  " Domain decomposition : ", &
+               &  " id          : ",td_mpp%t_proc(ji)%i_pid, &
+               &  " used        : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_use)), &
+               &  " contour     : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_ctr)), &
+               &  " left-bottom : ",td_mpp%t_proc(ji)%i_impp,', ',&
+               &  td_mpp%t_proc(ji)%i_jmpp, &
+               &  " dimension   : ",td_mpp%t_proc(ji)%i_lci,' x ',&
+               &  td_mpp%t_proc(ji)%i_lcj, &
+               &  " first indoor indices : ",td_mpp%t_proc(ji)%i_ldi,', ',&
+               &  td_mpp%t_proc(ji)%i_ldj, &
+               &  " last  indoor indices : ",td_mpp%t_proc(ji)%i_lei,', ',&
+               &  td_mpp%t_proc(ji)%i_lej
+
+            ENDDO
+
+            IF( td_mpp%t_proc(1)%i_nvar > 0 )THEN
+               WRITE(*,'(/a)') " Variable(s) used : "
+               DO ji=1,td_mpp%t_proc(1)%i_nvar
+                  WRITE(*,'(3x,a)') TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) 
+               ENDDO
+            ENDIF
+
+         ELSE
+
+            DO ji=1,td_mpp%i_nproc
+               WRITE(*,'((a, a),(/3x,a,i0),(/3x,a,a),4(/3x,a,i0,a,i0)/)')&
+               &  " Domain decomposition : ",TRIM(td_mpp%t_proc(ji)%c_name),&
+               &  " id          : ",td_mpp%t_proc(ji)%i_pid, &
+               &  " used        : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_use)),&
+               &  " left-bottom : ",td_mpp%t_proc(ji)%i_impp,', ',&
+               &  td_mpp%t_proc(ji)%i_jmpp, &
+               &  " dimension   : ",td_mpp%t_proc(ji)%i_lci,' x ',&
+               &  td_mpp%t_proc(ji)%i_lcj, &
+               &  " first indoor indices : ",td_mpp%t_proc(ji)%i_ldi,',',&
+               &  td_mpp%t_proc(ji)%i_ldj, &
+               &  " last  indoor indices : ",td_mpp%t_proc(ji)%i_lei,', ',&
+               &  td_mpp%t_proc(ji)%i_lej
+
+            ENDDO
+            
+            IF( td_mpp%t_proc(1)%i_nvar > 0 )THEN
+               WRITE(*,'(/a)') " Variable(s) used : "
+               DO ji=1,td_mpp%t_proc(1)%i_nvar
+                  WRITE(*,'(3x,a)') TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) 
+               ENDDO
+            ENDIF
+
+            ALLOCATE( il_proc(td_mpp%i_niproc,td_mpp%i_njproc) )
+            ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) )
+            ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) )
+            il_proc(:,:)=-1
+            il_lci(:,:) =-1
+            il_lcj(:,:) =-1
+
+            DO jk=1,td_mpp%i_nproc
+               ji=td_mpp%t_proc(jk)%i_iind
+               jj=td_mpp%t_proc(jk)%i_jind
+               il_proc(ji,jj)=jk-1
+               il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci
+               il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj
+            ENDDO
+
+            jl = 1
+            DO jk = 1,(td_mpp%i_niproc-1)/il_freq+1
+               jm = MIN(td_mpp%i_niproc, jl+il_freq-1)
+               WRITE(*,*)
+               WRITE(*,9401) (ji, ji = jl,jm)
+               WRITE(*,9400) ('***', ji = jl,jm-1)
+               DO jj = 1, td_mpp%i_njproc
+                  WRITE(*,9403) ('   ', ji = jl,jm-1)
+                  WRITE(*,9402) jj, ( il_lci(ji,jj), il_lcj(ji,jj), ji = jl,jm)
+                  WRITE(*,9404) (il_proc(ji,jj), ji= jl,jm)
+                  WRITE(*,9403) ('   ', ji = jl,jm-1)
+                  WRITE(*,9400) ('***', ji = jl,jm-1)
+               ENDDO
+               jl = jl+il_freq
+            ENDDO
+         
+            DEALLOCATE( il_proc )
+            DEALLOCATE( il_lci )
+            DEALLOCATE( il_lcj )
+
+         ENDIF
+      ELSE
+         WRITE(*,'(/a)') " Domain decomposition : none"
+      ENDIF
+
+9400   FORMAT('     ***',20('*************',a3))
+9403   FORMAT('     *     ',20('         *   ',a3))
+9401   FORMAT('        ',20('   ',i3,'          '))
+9402   FORMAT(' ',i3,' *  ',20(i0,'  x',i0,'   *   '))
+9404   FORMAT('     *  ',20('      ',i3,'   *   '))
+
+   END SUBROUTINE mpp_print
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function initialise mpp structure, given file name, 
+   !> and optionaly mask and number of processor following I and J
+   !> @detail
+   !> - If no total number of processor is defined (id_nproc), optimize 
+   !> the domain decomposition (look for the domain decomposition with 
+   !> the most land processor to remove)
+   !> - length of the overlap region (id_preci, id_precj) could be specify
+   !> in I and J direction (default value is 1)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2015
+   !> - allow to define dimension with array of dimension structure
+   !> @date January, 2016
+   !> - use RESULT to rename output
+   !> - mismatch with "halo" indices
+   !
+   !> @param[in] cd_file   file name of one file composing mpp domain
+   !> @param[in] id_mask   domain mask
+   !> @param[in] id_niproc number of processors following i
+   !> @param[in] id_njproc number of processors following j
+   !> @param[in] id_nproc  total number of processors
+   !> @param[in] id_preci  i-direction overlap region
+   !> @param[in] id_precj  j-direction overlap region
+   !> @param[in] cd_type   type of the files (cdf, cdf4, dimg)
+   !> @param[in] id_ew     east-west overlap
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @param[in] td_dim    array of dimension structure
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+   FUNCTION mpp__init_mask(cd_file, id_mask,                   &
+   &                       id_niproc, id_njproc, id_nproc,     &
+   &                       id_preci, id_precj,                 &
+   &                       cd_type, id_ew, id_perio, id_pivot, &
+   &                       td_dim )                            &
+   & RESULT(td_mpp)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                  INTENT(IN) :: cd_file
+      INTEGER(i4), DIMENSION(:,:),       INTENT(IN) :: id_mask
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_niproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_njproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_nproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_preci
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_precj
+      CHARACTER(LEN=*),                  INTENT(IN), OPTIONAL :: cd_type
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_pivot
+      TYPE(TDIM) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: td_dim
+
+      ! function
+      TYPE(TMPP) :: td_mpp
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_type
+
+      INTEGER(i4)      , DIMENSION(2)              :: il_shape
+
+      TYPE(TDIM)                                   :: tl_dim
+
+      TYPE(TATT)                                   :: tl_att
+
+      TYPE(TLAY)                                   :: tl_lay
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean mpp
+      CALL mpp_clean(td_mpp)
+
+      ! check type
+      cl_type=''
+      IF( PRESENT(cd_type) ) cl_type=TRIM(ADJUSTL(cd_type))
+
+      IF( TRIM(cl_type) /= '' )THEN
+         SELECT CASE(TRIM(cd_type))
+            CASE('cdf')
+               td_mpp%c_type='cdf'
+            CASE('dimg')
+               td_mpp%c_type='dimg'
+            CASE DEFAULT
+               CALL logger_warn( "MPP INIT: type "//TRIM(cd_type)//&
+               & " unknown. type dimg will be used for mpp "//&
+               &  TRIM(td_mpp%c_name) )
+               td_mpp%c_type='dimg'
+         END SELECT
+      ELSE
+         td_mpp%c_type=TRIM(file_get_type(cd_file))
+      ENDIF
+
+      ! get mpp name
+      td_mpp%c_name=TRIM(file_rename(cd_file))
+
+      ! get global domain dimension
+      il_shape(:)=SHAPE(id_mask)
+
+      IF( PRESENT(td_dim) )THEN
+         DO ji=1,ip_maxdim
+            IF( td_dim(ji)%l_use )THEN
+               CALL mpp_add_dim(td_mpp, td_dim(ji))
+            ENDIF
+         ENDDO
+      ELSE
+         tl_dim=dim_init('X',il_shape(1))
+         CALL mpp_add_dim(td_mpp, tl_dim)
+
+         tl_dim=dim_init('Y',il_shape(2))
+         CALL mpp_add_dim(td_mpp, tl_dim)
+
+         ! clean
+         CALL dim_clean(tl_dim)
+      ENDIF
+
+      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. &
+          ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN
+          CALL logger_warn( "MPP INIT: number of processors following I and J "//&
+          & "should be both specified")
+      ELSE
+         ! get number of processors following I and J
+         IF( PRESENT(id_niproc) ) td_mpp%i_niproc=id_niproc
+         IF( PRESENT(id_njproc) ) td_mpp%i_njproc=id_njproc
+      ENDIF
+
+      ! get maximum number of processors to be used
+      IF( PRESENT(id_nproc) ) td_mpp%i_nproc = id_nproc
+
+      ! get overlap region length
+      IF( PRESENT(id_preci) ) td_mpp%i_preci= id_preci
+      IF( PRESENT(id_precj) ) td_mpp%i_precj= id_precj
+
+      ! east-west overlap
+      IF( PRESENT(id_ew) ) td_mpp%i_ew= id_ew
+      ! NEMO periodicity
+      IF( PRESENT(id_perio) ) td_mpp%i_perio= id_perio
+      IF( PRESENT(id_pivot) ) td_mpp%i_pivot= id_pivot
+
+      IF( td_mpp%i_nproc  /= 0 .AND. &
+      &   td_mpp%i_niproc /= 0 .AND. &
+      &   td_mpp%i_njproc /= 0 .AND. &
+      &   td_mpp%i_nproc > &
+      &   td_mpp%i_niproc * td_mpp%i_njproc )THEN
+
+         CALL logger_error("MPP INIT: invalid domain decomposition ")
+         CALL logger_debug("MPP INIT: "// &
+         & TRIM(fct_str(td_mpp%i_nproc))//" > "//&
+         & TRIM(fct_str(td_mpp%i_niproc))//" x "//&
+         & TRIM(fct_str(td_mpp%i_njproc)) )
+
+      ELSE
+         IF( lm_layout )THEN
+            OPEN(im_iumout,FILE='processor.layout')
+            WRITE(im_iumout,*)
+            WRITE(im_iumout,*) ' optimisation de la partition'
+            WRITE(im_iumout,*) ' ----------------------------'
+            WRITE(im_iumout,*)
+         ENDIF
+
+         IF( td_mpp%i_niproc /= 0 .AND. &
+         &   td_mpp%i_njproc /= 0 )THEN
+            ! compute domain layout
+            tl_lay=layout__init( td_mpp, id_mask, td_mpp%i_niproc, td_mpp%i_njproc )
+            ! create mpp domain layout
+            CALL mpp__create_layout( td_mpp, tl_lay )
+            ! clean
+            CALL layout__clean( tl_lay )
+         ELSEIF( td_mpp%i_nproc  /= 0 )THEN
+            ! optimiz
+            CALL mpp__optimiz( td_mpp, id_mask, td_mpp%i_nproc )
+
+         ELSE
+            CALL logger_warn("MPP INIT: number of processor to be used "//&
+            &                "not specify. force to one.")
+            ! optimiz
+            CALL mpp__optimiz( td_mpp, id_mask, 1 )
+         ENDIF
+
+
+         CALL logger_info("MPP INIT: domain decoposition : "//&
+         &  'niproc('//TRIM(fct_str(td_mpp%i_niproc))//') * '//&
+         &  'njproc('//TRIM(fct_str(td_mpp%i_njproc))//') = '//&
+         &  'nproc('//TRIM(fct_str(td_mpp%i_nproc))//')' )
+
+         ! get domain type
+         CALL mpp_get_dom( td_mpp )
+
+         DO ji=1,td_mpp%i_nproc
+
+            ! get processor size
+            il_shape(:)=mpp_get_proc_size( td_mpp, ji )
+
+            tl_dim=dim_init('X',il_shape(1))
+            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim)
+
+            tl_dim=dim_init('Y',il_shape(2))
+            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim)            
+
+            IF( PRESENT(td_dim) )THEN
+               IF( td_dim(jp_K)%l_use )THEN
+                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_K))
+               ENDIF
+               IF( td_dim(jp_L)%l_use )THEN
+                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_L))
+               ENDIF
+            ENDIF
+            ! add type
+            td_mpp%t_proc(ji)%c_type=TRIM(td_mpp%c_type)
+
+            ! clean
+            CALL dim_clean(tl_dim)
+
+         ENDDO
+
+         ! add global attribute
+         tl_att=att_init("DOMAIN_number_total",td_mpp%i_nproc)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_LOCAL",TRIM(td_mpp%c_dom))
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_I_number_total",td_mpp%i_niproc)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_J_number_total",td_mpp%i_njproc)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_size_global",td_mpp%t_dim(1:2)%i_len)
+         CALL mpp_add_att(td_mpp, tl_att)
+
+         CALL mpp__compute_halo(td_mpp) 
+      ENDIF
+
+   END FUNCTION mpp__init_mask
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function initialise mpp structure, given variable strcuture 
+   !> and optionaly number of processor following I and J
+   !> @detail
+   !> - If no total number of processor is defined (id_nproc), optimize 
+   !> the domain decomposition (look for the domain decomposition with 
+   !> the most land processor to remove)
+   !> - length of the overlap region (id_preci, id_precj) could be specify
+   !> in I and J direction (default value is 1)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[in] cd_file   file name of one file composing mpp domain
+   !> @param[in] td_var    variable structure
+   !> @param[in] id_niproc number of processors following i
+   !> @param[in] id_njproc number of processors following j
+   !> @param[in] id_nproc  total number of processors
+   !> @param[in] id_preci  i-direction overlap region
+   !> @param[in] id_precj  j-direction overlap region
+   !> @param[in] cd_type   type of the files (cdf, cdf4, dimg)
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+   TYPE(TMPP) FUNCTION mpp__init_var( cd_file, td_var,               &
+   &                                  id_niproc, id_njproc, id_nproc,&
+   &                                  id_preci, id_precj, cd_type,   &
+   &                                  id_perio, id_pivot )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      TYPE(TVAR),       INTENT(IN) :: td_var
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_niproc
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_njproc
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_nproc
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_preci
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_precj
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_pivot
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_mask
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+         &                 td_var%t_dim(2)%i_len, &
+         &                 td_var%t_dim(3)%i_len) )
+         il_mask(:,:,:)=var_get_mask(td_var)
+         
+         CALL logger_info("MPP INIT: mask compute from variable "//&
+            &             TRIM(td_var%c_name))
+         mpp__init_var=mpp_init( cd_file, il_mask(:,:,1),       &
+         &                       id_niproc, id_njproc, id_nproc,&
+         &                       id_preci, id_precj, cd_type,   &
+         &                       id_ew=td_var%i_ew, &
+         &                       id_perio=id_perio, id_pivot=id_pivot)
+
+         DEALLOCATE(il_mask)
+      ELSE
+         CALL logger_error("MPP INIT: variable value not define.")
+      ENDIF
+
+   END FUNCTION mpp__init_var
+   !-------------------------------------------------------------------
+   !> @brief This function initalise a mpp structure given file structure. 
+   !> @details 
+   !> It reads restart dimg files, or some netcdf files.
+   !>
+   !> @warning 
+   !>  netcdf file must contains some attributes:
+   !>    - DOMAIN_number_total 
+   !>    - DOMAIN_size_global
+   !>    - DOMAIN_number
+   !>    - DOMAIN_position_first
+   !>    - DOMAIN_position_last
+   !>    - DOMAIN_halo_size_start
+   !>    - DOMAIN_halo_size_end
+   !>  or the file is assume to be no mpp file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__compute_halo
+   !
+   !> @param[in] td_file   file strcuture
+   !> @param[in] id_ew     east-west overlap
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+   TYPE(TMPP) FUNCTION mpp__init_file( td_file, id_ew, id_perio, id_pivot )
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
+
+      ! local variable
+      INTEGER(i4)               :: il_nproc
+      INTEGER(i4)               :: il_attid
+      INTEGER(i4), DIMENSION(2) :: il_shape
+
+      TYPE(TDIM)                :: tl_dim
+
+      TYPE(TATT)                :: tl_att
+
+      TYPE(TFILE)               :: tl_file
+
+      TYPE(TMPP)                :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean mpp
+      CALL mpp_clean(mpp__init_file)
+
+      ! check file type
+      SELECT CASE( TRIM(td_file%c_type) )
+         CASE('cdf')
+            ! need to read all file to get domain decomposition
+            tl_file=file_copy(td_file)
+
+            ! open file
+            CALL iom_open(tl_file)
+            ! read first file domain decomposition
+            tl_mpp=mpp__init_file_cdf(tl_file)
+
+            ! get number of processor/file to be read
+            il_nproc = 1
+            il_attid = 0
+
+            IF( ASSOCIATED(tl_file%t_att) )THEN
+               il_attid=att_get_id( tl_file%t_att, "DOMAIN_number_total" )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+               il_nproc = INT(tl_file%t_att(il_attid)%d_value(1))
+            ENDIF
+
+            ! close file
+            CALL iom_close(tl_file)
+
+            IF( il_nproc /= 1 )THEN
+               DO ji=1,il_nproc
+
+                  ! clean mpp strcuture
+                  CALL mpp_clean(tl_mpp)
+ 
+                  ! get filename 
+                  tl_file=file_rename(td_file,ji)
+ 
+                  ! open file
+                  CALL iom_open(tl_file)
+
+                  ! read domain decomposition
+                  tl_mpp = mpp__init_file_cdf(tl_file)
+                  IF( ji == 1 )THEN
+                     mpp__init_file=mpp_copy(tl_mpp)
+                  ELSE
+                     IF( ANY( mpp__init_file%t_dim(1:2)%i_len /= &
+                                      tl_mpp%t_dim(1:2)%i_len) )THEN
+
+                        CALL logger_error("MPP INIT READ: dimension from file "//&
+                        &     TRIM(tl_file%c_name)//" and mpp strcuture "//&
+                        &     TRIM(mpp__init_file%c_name)//"differ ")
+
+                     ELSE
+
+                        ! add processor to mpp strcuture
+                        CALL mpp__add_proc(mpp__init_file, tl_mpp%t_proc(1))
+
+                     ENDIF
+                  ENDIF
+
+                  ! close file
+                  CALL iom_close(tl_file)
+
+               ENDDO
+               IF( mpp__init_file%i_nproc /= il_nproc )THEN
+                  CALL logger_error("MPP INIT READ: some processors can't be added &
+                  &               to mpp structure")
+               ENDIF
+
+            ELSE
+               mpp__init_file=mpp_copy(tl_mpp)
+            ENDIF
+
+            ! mpp type
+            mpp__init_file%c_type=TRIM(td_file%c_type)
+
+            ! mpp domain type
+            CALL mpp_get_dom(mpp__init_file)
+
+            ! create some attributes for domain decomposition (use with dimg file)
+            tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc )
+            CALL mpp_move_att(mpp__init_file, tl_att)
+
+            CALL mpp__compute_halo(mpp__init_file)
+ 
+            ! clean
+            CALL mpp_clean(tl_mpp)
+            CALL att_clean(tl_att)
+
+         CASE('dimg')
+            ! domain decomposition could be read in one file
+
+            tl_file=file_copy(td_file)
+            ! open file
+            CALL logger_debug("MPP INIT READ: open file "//TRIM(tl_file%c_name))
+            CALL iom_open(tl_file)
+
+            CALL logger_debug("MPP INIT READ: read mpp structure ")
+            ! read mpp structure
+            mpp__init_file=mpp__init_file_rstdimg(tl_file)
+
+            ! mpp type
+            mpp__init_file%c_type=TRIM(td_file%c_type)
+
+            ! mpp domain type
+            CALL logger_debug("MPP INIT READ: mpp_get_dom ")
+            CALL mpp_get_dom(mpp__init_file)
+
+            ! get processor size
+            CALL logger_debug("MPP INIT READ: get processor size ")
+            DO ji=1,mpp__init_file%i_nproc
+
+               il_shape(:)=mpp_get_proc_size( mpp__init_file, ji )
+
+               tl_dim=dim_init('X',il_shape(1))
+               CALL file_add_dim(mpp__init_file%t_proc(ji), tl_dim)
+
+               tl_dim=dim_init('Y',il_shape(2))
+               CALL file_add_dim(mpp__init_file%t_proc(ji), tl_dim)            
+
+               ! clean
+               CALL dim_clean(tl_dim)
+
+            ENDDO
+
+            ! close file
+            CALL iom_close(tl_file)
+
+         CASE DEFAULT
+            CALL logger_error("MPP INIT READ: invalid type for file "//&
+            &              TRIM(tl_file%c_name))
+      END SELECT
+
+      ! east west overlap
+      IF( PRESENT(id_ew) ) mpp__init_file%i_ew=id_ew
+      ! NEMO periodicity
+      IF( PRESENT(id_perio) )THEN
+         mpp__init_file%i_perio= id_perio
+         SELECT CASE(id_perio)
+         CASE(3,4)
+            mpp__init_file%i_pivot=1
+         CASE(5,6)
+            mpp__init_file%i_pivot=0
+         CASE DEFAULT
+            mpp__init_file%i_pivot=1
+         END SELECT
+      ENDIF
+
+      IF( PRESENT(id_pivot) ) mpp__init_file%i_pivot= id_pivot
+
+      ! clean 
+      CALL file_clean(tl_file)
+
+   END FUNCTION mpp__init_file
+   !-------------------------------------------------------------------
+   !> @brief This function initalise a mpp structure, 
+   !> reading some netcdf files.
+   !
+   !> @details 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add only use dimension in MPP structure
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__read_halo
+   !>
+   !> @param[in] td_file   file strcuture
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+   TYPE(TMPP) FUNCTION mpp__init_file_cdf( td_file )
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_attid  ! attribute id
+      
+      LOGICAL     :: ll_exist
+      LOGICAL     :: ll_open
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TDIM)  :: tl_dim
+      
+      TYPE(TFILE) :: tl_proc
+      !----------------------------------------------------------------
+
+      CALL logger_trace("MPP INIT READ: netcdf file "//TRIM(td_file%c_name))
+
+      INQUIRE( FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open )
+      ! ll_open do not work for netcdf file, return always FALSE
+      IF( ll_exist )THEN
+
+         IF( td_file%i_id == 0 )THEN
+            CALL logger_info(" id "//TRIM(fct_str(td_file%i_id))) 
+            CALL logger_error("MPP INIT READ: netcdf file "//&
+               &  TRIM(td_file%c_name)//" not opened")
+         ELSE
+
+            ! get mpp name
+            mpp__init_file_cdf%c_name=TRIM( file_rename(td_file%c_name) )
+
+            ! add type
+            mpp__init_file_cdf%c_type="cdf"
+
+            ! global domain size
+            il_attid = 0
+            IF( ASSOCIATED(td_file%t_att) )THEN
+               il_attid=att_get_id( td_file%t_att, "DOMAIN_size_global" )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+               tl_dim=dim_init('X',INT(td_file%t_att(il_attid)%d_value(1)))
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+
+               tl_dim=dim_init('Y',INT(td_file%t_att(il_attid)%d_value(2)))
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+            ELSE ! assume only one file (not mpp)
+               tl_dim=dim_init( td_file%t_dim(1)%c_name, td_file%t_dim(1)%i_len)
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+
+               tl_dim=dim_init( td_file%t_dim(2)%c_name, td_file%t_dim(2)%i_len)
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+            ENDIF
+
+            IF( td_file%t_dim(3)%l_use )THEN
+               tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+            ENDIF
+
+            IF( td_file%t_dim(4)%l_use )THEN
+               tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
+               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim)
+            ENDIF
+
+            ! initialise file/processor
+            tl_proc=file_copy(td_file)
+
+            ! processor id
+            il_attid = 0
+            IF( ASSOCIATED(td_file%t_att) )THEN
+               il_attid=att_get_id( td_file%t_att, "DOMAIN_number" )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+               tl_proc%i_pid = INT(td_file%t_att(il_attid)%d_value(1))
+            ELSE
+               tl_proc%i_pid = 1
+            ENDIF
+
+            ! processor dimension
+            tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:))
+
+            CALL mpp__read_halo(tl_proc, mpp__init_file_cdf%t_dim(:) )
+
+            ! add attributes
+            tl_att=att_init( "DOMAIN_size_global", &
+            &                mpp__init_file_cdf%t_dim(:)%i_len)
+            CALL file_move_att(tl_proc, tl_att)
+
+            tl_att=att_init( "DOMAIN_number", tl_proc%i_pid )
+            CALL file_move_att(tl_proc, tl_att)
+
+            ! add processor to mpp structure
+            CALL mpp__add_proc(mpp__init_file_cdf, tl_proc)
+
+            ! clean 
+            CALL file_clean(tl_proc)
+            CALL dim_clean(tl_dim)
+            CALL att_clean(tl_att)
+         ENDIF
+
+      ELSE
+
+         CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//&
+         &  " do not exist")
+
+      ENDIF
+
+   END FUNCTION mpp__init_file_cdf
+   !-------------------------------------------------------------------
+   !> @brief This function initalise a mpp structure, 
+   !> reading one dimg restart file.
+   !
+   !> @details 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__compute_halo
+   !>
+   !> @param[in] td_file   file strcuture
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+   TYPE(TMPP) FUNCTION mpp__init_file_rstdimg( td_file )
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      INTEGER(i4)       :: il_recl                          ! record length 
+      INTEGER(i4)       :: il_nx, il_ny, il_nz              ! x,y,z dimension 
+      INTEGER(i4)       :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables 
+      INTEGER(i4)       :: il_iglo, il_jglo                 ! domain global size
+      INTEGER(i4)       :: il_rhd                           ! record of the header infos
+      INTEGER(i4)       :: il_pni, il_pnj, il_pnij          ! domain decomposition
+      INTEGER(i4)       :: il_area                          ! domain index
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
+
+      LOGICAL           ::  ll_exist
+      LOGICAL           ::  ll_open
+
+      CHARACTER(LEN=lc) :: cl_file
+
+      TYPE(TDIM)        :: tl_dim ! dimension structure
+      TYPE(TATT)        :: tl_att
+      TYPE(TFILE)       :: tl_proc
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      INQUIRE( FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
+      IF( ll_exist )THEN
+
+         IF( .NOT. ll_open )THEN
+            CALL logger_error("MPP INIT READ: dimg file "//TRIM(td_file%c_name)//&
+            &  " not opened")
+         ELSE
+
+            ! read first record 
+            READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+            &     il_recl,                         &
+            &     il_nx, il_ny, il_nz,             &
+            &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+            &     il_rhd,                          &
+            &     il_pni, il_pnj, il_pnij,         &
+            &     il_area
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("MPP INIT READ: read first line header of "//&
+               &              TRIM(td_file%c_name))
+            ENDIF
+
+            ! get mpp name
+            mpp__init_file_rstdimg%c_name=TRIM( file_rename(td_file%c_name) )
+
+            ! add type
+            mpp__init_file_rstdimg%c_type="dimg"
+
+            ! number of processors to be read
+            mpp__init_file_rstdimg%i_nproc  = il_pnij
+            mpp__init_file_rstdimg%i_niproc = il_pni
+            mpp__init_file_rstdimg%i_njproc = il_pnj
+
+            IF( ASSOCIATED(mpp__init_file_rstdimg%t_proc) )THEN
+               CALL file_clean(mpp__init_file_rstdimg%t_proc(:))
+               DEALLOCATE(mpp__init_file_rstdimg%t_proc)
+            ENDIF
+            ALLOCATE( mpp__init_file_rstdimg%t_proc(il_pnij) , stat=il_status )
+
+            ALLOCATE(il_lci (il_pnij))
+            ALLOCATE(il_lcj (il_pnij))
+            ALLOCATE(il_ldi (il_pnij))
+            ALLOCATE(il_ldj (il_pnij))
+            ALLOCATE(il_lei (il_pnij))
+            ALLOCATE(il_lej (il_pnij))
+            ALLOCATE(il_impp(il_pnij))
+            ALLOCATE(il_jmpp(il_pnij))
+
+            tl_proc=file_copy(td_file)
+            ! remove dimension from file
+            CALL dim_clean(tl_proc%t_dim(:))
+            ! initialise file/processors
+            DO ji=1,mpp__init_file_rstdimg%i_nproc
+               mpp__init_file_rstdimg%t_proc(ji)=file_copy(tl_proc)
+            ENDDO
+
+            IF( il_status /= 0 )THEN
+               CALL logger_error("MPP INIT READ: not enough space to read domain &
+               &              decomposition in file "//TRIM(td_file%c_name))
+            ENDIF
+
+            ! read first record 
+            READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+            &     il_recl,                         &
+            &     il_nx, il_ny, il_nz,             &
+            &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+            &     il_rhd,                          &
+            &     il_pni, il_pnj, il_pnij,         &
+            &     il_area,                         &
+            &     il_iglo, il_jglo,                &
+            &     il_lci(1:il_pnij),    &
+            &     il_lcj(1:il_pnij),    &
+            &     il_ldi(1:il_pnij),    &
+            &     il_ldj(1:il_pnij),    &
+            &     il_lei(1:il_pnij),    &
+            &     il_lej(1:il_pnij),    &
+            &     il_impp(1:il_pnij),   &
+            &     il_jmpp(1:il_pnij)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("MPP INIT READ: read first line of "//&
+               &              TRIM(td_file%c_name))
+            ENDIF
+
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lci = il_lci (1:il_pnij)
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lcj = il_lcj (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldi = il_ldi (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldj = il_ldj (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lei = il_lei (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lej = il_lej (1:il_pnij) 
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_impp= il_impp(1:il_pnij)
+            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_jmpp= il_jmpp(1:il_pnij)
+
+            DEALLOCATE(il_lci) 
+            DEALLOCATE(il_lcj) 
+            DEALLOCATE(il_ldi) 
+            DEALLOCATE(il_ldj) 
+            DEALLOCATE(il_lei) 
+            DEALLOCATE(il_lej) 
+            DEALLOCATE(il_impp)
+            DEALLOCATE(il_jmpp)
+
+            ! global domain size
+            tl_dim=dim_init('X',il_iglo)
+            CALL mpp_add_dim(mpp__init_file_rstdimg,tl_dim)
+            tl_dim=dim_init('Y',il_jglo)
+            CALL mpp_add_dim(mpp__init_file_rstdimg,tl_dim)
+
+            tl_dim=dim_init('Z',il_nz)
+            CALL mpp_add_dim(mpp__init_file_rstdimg,tl_dim)
+
+            DO ji=1,mpp__init_file_rstdimg%i_nproc
+
+               ! get file name
+               cl_file =  file_rename(td_file%c_name,ji)
+               mpp__init_file_rstdimg%t_proc(ji)%c_name = TRIM(cl_file)
+               ! update processor id
+               mpp__init_file_rstdimg%t_proc(ji)%i_pid=ji
+
+               ! add attributes
+               tl_att=att_init( "DOMAIN_number", ji )
+               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
+
+            ENDDO
+ 
+            ! add type
+            mpp__init_file_rstdimg%t_proc(:)%c_type="dimg"
+
+            ! add attributes
+            tl_att=att_init( "DOMAIN_size_global", &
+            &                mpp__init_file_rstdimg%t_dim(:)%i_len)
+            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
+
+            tl_att=att_init( "DOMAIN_number_total", &
+            &                 mpp__init_file_rstdimg%i_nproc )
+            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
+
+            tl_att=att_init( "DOMAIN_I_number_total", &
+            &                 mpp__init_file_rstdimg%i_niproc )
+            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
+
+            tl_att=att_init( "DOMAIN_J_number_total", &
+            &                 mpp__init_file_rstdimg%i_njproc )
+            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att)
+
+            CALL mpp_get_dom( mpp__init_file_rstdimg )
+
+            CALL mpp__compute_halo( mpp__init_file_rstdimg )
+
+            ! clean
+            CALL dim_clean(tl_dim)
+            CALL att_clean(tl_att)
+         ENDIF
+
+      ELSE
+
+         CALL logger_error("MPP INIT READ: dimg file "//TRIM(td_file%c_name)//&
+         &  " do not exist")
+
+      ENDIF
+
+   END FUNCTION mpp__init_file_rstdimg
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable and mpp structure use same
+   !> dimension.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] td_proc   processor structure
+   !> @return dimension of processor and mpp structure agree (or not)
+   !-------------------------------------------------------------------
+   LOGICAL FUNCTION mpp__check_proc_dim(td_mpp, td_proc)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP),  INTENT(IN) :: td_mpp
+      TYPE(TFILE), INTENT(IN) :: td_proc
+
+      ! local variable
+      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size 
+      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
+
+      !----------------------------------------------------------------
+      mpp__check_proc_dim=.TRUE.
+      ! check used dimension 
+      IF( td_mpp%i_niproc /= 0 .AND. td_mpp%i_njproc /= 0 )THEN
+         ! check with maximum size of sub domain
+         il_isize = ( td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + &
+         &           (td_mpp%i_niproc-1) ) / td_mpp%i_niproc + 2*td_mpp%i_preci
+         il_jsize = ( td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + &
+         &           (td_mpp%i_njproc-1) ) / td_mpp%i_njproc + 2*td_mpp%i_precj
+
+         IF( il_isize < td_proc%i_lci .OR.                     &
+         &   il_jsize < td_proc%i_lcj )THEN
+
+            mpp__check_proc_dim=.FALSE.
+
+            CALL logger_error( "MPP CHECK DIM: processor and mpp dimension differ" )
+
+         ENDIF
+
+      ELSE
+         ! check with global domain size
+         IF( td_mpp%t_dim(1)%i_len < td_proc%i_lci .OR.                     &
+         &   td_mpp%t_dim(2)%i_len < td_proc%i_lcj )THEN
+
+            mpp__check_proc_dim=.FALSE.
+
+            CALL logger_error( "MPP CHECK DIM: processor and mpp dimension differ" )
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION mpp__check_proc_dim
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add variable in all files of mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_var variable strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_add_var( td_mpp, td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP ADD VAR: processor decomposition not "//&
+         &  "define for mpp "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! check if variable exist
+         IF( TRIM(td_var%c_name) == '' .AND. &
+         &   TRIM(td_var%c_stdname) == '' )THEN
+            CALL logger_error("MPP ADD VAR: variable not define ")
+         ELSE
+            ! check if variable already in mpp structure
+            il_varid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+               il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
+               &                       td_var%c_name, td_var%c_stdname )
+            ENDIF
+
+            IF( il_varid /= 0 )THEN
+
+               DO ji=1,td_mpp%t_proc(1)%i_nvar
+                  CALL logger_debug( " MPP ADD VAR: in mpp structure : &
+                  &  variable "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)//&
+                  &  ", standard name "//&
+                  &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
+               ENDDO
+               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", already in mpp "//TRIM(td_mpp%c_name) )
+
+            ELSE
+            
+               CALL logger_info( &
+               &  " MPP ADD VAR: add variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", in mpp "//TRIM(td_mpp%c_name) )
+               ! check used dimension 
+               IF( mpp__check_dim(td_mpp, td_var) )THEN
+         
+                  ! check variable dimension expected
+                  CALL var_check_dim(td_var)
+
+                  ! update dimension if need be
+                  DO ji=1,ip_maxdim
+                     IF( td_var%t_dim(ji)%l_use .AND. &
+                     &   .NOT. td_mpp%t_dim(ji)%l_use )THEN
+                        CALL mpp_add_dim(td_mpp,td_var%t_dim(ji))
+                     ENDIF
+                  ENDDO
+
+                  ! add variable in each processor
+                  DO ji=1,td_mpp%i_nproc
+
+                     ! split variable on domain decomposition
+                     tl_var=mpp__split_var(td_mpp, td_var, ji)
+
+                     CALL file_add_var(td_mpp%t_proc(ji), tl_var)
+
+                     ! clean
+                     CALL var_clean(tl_var)
+                  ENDDO
+
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp_add_var
+   !-------------------------------------------------------------------
+   !> @brief This function extract, from variable structure, part that will 
+   !> be written in processor id_procid.<br/>
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] td_var    variable structure
+   !> @param[in] id_procid processor id
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION mpp__split_var(td_mpp, td_var, id_procid)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  INTENT(IN) :: td_mpp
+      TYPE(TVAR),  INTENT(IN) :: td_var
+      INTEGER(i4), INTENT(IN) :: id_procid
+
+      ! local variable
+      TYPE(TDIM)  :: tl_dim
+
+      INTEGER(i4), DIMENSION(4) :: il_ind
+      INTEGER(i4), DIMENSION(2) :: il_size
+      INTEGER(i4) :: il_i1
+      INTEGER(i4) :: il_i2
+      INTEGER(i4) :: il_j1
+      INTEGER(i4) :: il_j2
+      !----------------------------------------------------------------
+
+      ! copy mpp
+      mpp__split_var=var_copy(td_var)
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ! remove value over global domain from pointer
+         CALL var_del_value( mpp__split_var )
+
+         ! get processor dimension
+         il_size(:)=mpp_get_proc_size( td_mpp, id_procid )
+
+         ! define new dimension in variable structure 
+         IF( td_var%t_dim(1)%l_use )THEN
+            tl_dim=dim_init( TRIM(td_var%t_dim(1)%c_name), il_size(1) )
+            CALL var_move_dim( mpp__split_var, tl_dim )
+         ENDIF
+         IF( td_var%t_dim(2)%l_use )THEN
+            tl_dim=dim_init( TRIM(td_var%t_dim(2)%c_name), il_size(2) )
+            CALL var_move_dim( mpp__split_var, tl_dim )      
+         ENDIF
+
+         ! get processor indices
+         il_ind(:)=mpp_get_proc_index( td_mpp, id_procid )
+         il_i1 = il_ind(1)
+         il_i2 = il_ind(2)
+         il_j1 = il_ind(3)
+         il_j2 = il_ind(4)
+
+         IF( .NOT. td_var%t_dim(1)%l_use )THEN
+            il_i1=1 
+            il_i2=1 
+         ENDIF
+
+         IF( .NOT. td_var%t_dim(2)%l_use )THEN
+            il_j1=1 
+            il_j2=1 
+         ENDIF      
+
+         ! add variable value on processor
+         CALL var_add_value( mpp__split_var, &
+         &                   td_var%d_value(il_i1:il_i2, il_j1:il_j2, :, :) )
+      ENDIF
+
+   END FUNCTION mpp__split_var
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine delete all variable in mpp strcuture.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_var_mpp( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_info( &
+      &  "MPP CLEAN VAR: reset all variable "//&
+      &  "in mpp strcuture "//TRIM(td_mpp%c_name) )
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         DO ji=td_mpp%t_proc(1)%i_nvar,1,-1
+            CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(ji))
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE mpp__del_var_mpp
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete variable in mpp structure, given variable
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_var variable strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_var_str( td_mpp, td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TVAR), INTENT(IN)    :: td_var
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      CHARACTER(LEN=lc) :: cl_name
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP DEL VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         ! check if variable already in mpp structure
+         il_varid = 0
+         IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+            il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
+            &                       td_var%c_name, td_var%c_stdname )
+         ENDIF
+         IF( il_varid == 0 )THEN
+            CALL logger_error( &
+            &  "MPP DEL VAR: no variable "//TRIM(td_var%c_name)//&
+            &  ", in mpp structure "//TRIM(td_mpp%c_name) )
+
+            DO ji=1,td_mpp%t_proc(1)%i_nvar
+               CALL logger_debug( "MPP DEL VAR: in mpp structure : &
+               &  variable : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)//&
+               &  ", standard name "//&
+               &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
+            ENDDO
+
+         ELSE
+
+            cl_name=TRIM(td_var%c_name)
+            DO ji=1,td_mpp%i_nproc
+               CALL file_del_var(td_mpp%t_proc(ji), TRIM(cl_name)) 
+            ENDDO
+
+         ENDIF
+
+      ENDIF
+   END SUBROUTINE mpp__del_var_str
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete variable in mpp structure, given variable name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
+   !
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    cd_name   variable name
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_var_name( td_mpp, cd_name )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      TYPE(TVAR)        :: tl_var
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP DEL VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         IF( td_mpp%t_proc(1)%i_nvar == 0 )THEN
+            CALL logger_debug( "MPP DEL VAR NAME: no variable associated to mpp &
+            &                 structure "//TRIM(td_mpp%c_name) )
+         ELSE
+
+            ! get the variable id, in file variable structure
+            il_varid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+               il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
+               &                       cd_name )
+            ENDIF
+
+            IF( il_varid == 0 )THEN
+
+               CALL logger_warn( &
+               &  "MPP DEL VAR : there is no variable with name "//&
+               &  "or standard name "//TRIM(ADJUSTL(cd_name))//&
+               &  " in mpp structure "//TRIM(td_mpp%c_name))
+
+            ELSE
+
+               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
+               CALL mpp_del_var(td_mpp, tl_var)
+
+            ENDIF
+         ENDIF
+
+      ENDIF
+   END SUBROUTINE mpp__del_var_name
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine overwrite variable in mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_var variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_move_var( td_mpp, td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TVAR), INTENT(IN)    :: td_var
+
+      !local variable
+      TYPE(TVAR) :: tl_var
+      !----------------------------------------------------------------
+      ! copy variablie
+      tl_var=var_copy(td_var)
+
+      ! remove processor
+      CALL mpp_del_var(td_mpp, tl_var)
+
+      ! add processor
+      CALL mpp_add_var(td_mpp, tl_var)
+
+      ! clean 
+      CALL var_clean(tl_var)
+
+   END SUBROUTINE mpp_move_var
+   !> @endcode
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add processor to mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    td_proc   processor strcuture
+   !
+   !> @todo 
+   !> - check proc type
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__add_proc_unit( td_mpp, td_proc )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
+      TYPE(TFILE), INTENT(IN)    :: td_proc
+
+      ! local variable
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_procid
+      INTEGER(i4)      , DIMENSION(1)              :: il_ind
+
+      TYPE(TFILE)      , DIMENSION(:), ALLOCATABLE :: tl_proc
+
+      CHARACTER(LEN=lc)                            :: cl_name
+      !----------------------------------------------------------------
+
+!      ALLOCATE(tl_proc(1))
+!      tl_proc(1)=file_copy(td_proc)
+!
+!      CALL mpp__add_proc(td_mpp, tl_proc(:))
+!
+!      CALL file_clean(tl_proc(:))
+!      DEALLOCATE(tl_proc)
+
+      ! check file name
+      cl_name=TRIM( file_rename(td_proc%c_name) )
+      IF( TRIM(cl_name) /=  TRIM(td_mpp%c_name) )THEN
+         CALL logger_warn("MPP ADD PROC: processor name do not match mpp name")
+      ENDIF
+
+      il_procid=0
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         ! check if processor already in mpp structure
+         il_ind(:)=MINLOC( td_mpp%t_proc(:)%i_pid, &
+                     mask=(td_mpp%t_proc(:)%i_pid==td_proc%i_pid) )
+         il_procid=il_ind(1)
+      ENDIF
+
+      IF( il_procid /= 0 )THEN
+
+            CALL logger_error( &
+            &  "MPP ADD PROC: processor "//TRIM(fct_str(td_proc%i_pid))//&
+            &  ", already in mpp structure " )
+
+      ELSE
+ 
+         CALL logger_trace("MPP ADD PROC: add processor "//&
+         &               TRIM(fct_str(td_mpp%i_nproc+1))//" in mpp structure")
+
+         IF( td_mpp%i_nproc > 0 )THEN
+            ! 
+            il_ind(:)=MAXLOC( td_mpp%t_proc(:)%i_pid, &
+                        mask=(td_mpp%t_proc(:)%i_pid < td_proc%i_pid) )
+            il_procid=il_ind(1)
+
+            ! already other processor in mpp structure
+            ALLOCATE( tl_proc(td_mpp%i_nproc), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( "MPP ADD PROC: not enough space to put processor &
+               &               in mpp structure")
+
+            ELSE
+               ! save temporary mpp structure
+               tl_proc(:)=file_copy(td_mpp%t_proc(:))
+
+               CALL file_clean( td_mpp%t_proc(:) )
+               DEALLOCATE(td_mpp%t_proc)
+               ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc+1), stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( "MPP ADD PROC: not enough space to put "//&
+                  &  "processor in mpp structure ")
+
+               ENDIF
+
+               ! copy processor in mpp before
+               ! processor with lower id than new processor
+               td_mpp%t_proc( 1:il_procid ) = file_copy(tl_proc( 1:il_procid ))
+
+               ! processor with greater id than new processor
+               td_mpp%t_proc( il_procid+1 : td_mpp%i_nproc+1 ) = &
+               &              file_copy(tl_proc( il_procid : td_mpp%i_nproc ))
+
+               ! clean
+               CALL file_clean(tl_proc(:))
+               DEALLOCATE(tl_proc)
+            ENDIF
+
+         ELSE
+            ! no processor in mpp structure
+            IF( ASSOCIATED(td_mpp%t_proc) )THEN
+               CALL file_clean(td_mpp%t_proc(:))
+               DEALLOCATE(td_mpp%t_proc)
+            ENDIF
+            ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( "MPP ADD PROC: not enough space to put "//&
+               &  "processor in mpp structure " )
+
+            ENDIF
+         ENDIF
+
+         ! check dimension
+         IF( ANY(td_mpp%t_dim(1:2)%i_len < td_proc%t_dim(1:2)%i_len) )THEN
+            CALL logger_error( "MPP ADD PROC: mpp structure and new processor "//&
+            &  " dimension differ. ")
+            CALL logger_debug("MPP ADD PROC: mpp dimension ("//&
+            &  TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
+            &  TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")" )
+            CALL logger_debug("MPP ADD PROC: processor dimension ("//&
+            &  TRIM(fct_str(td_proc%t_dim(1)%i_len))//","//&
+            &  TRIM(fct_str(td_proc%t_dim(2)%i_len))//")" )
+         ELSE
+            td_mpp%i_nproc=td_mpp%i_nproc+1
+
+            ! add new processor
+            td_mpp%t_proc(td_mpp%i_nproc)=file_copy(td_proc)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE mpp__add_proc_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete processor in mpp structure, given processor id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    id_procid processor id
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_proc_id( td_mpp, id_procid )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),   INTENT(INOUT) :: td_mpp
+      INTEGER(i4),  INTENT(IN)    :: id_procid
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_procid
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      il_ind(:)=MINLOC(td_mpp%t_proc(:)%i_pid,td_mpp%t_proc(:)%i_pid==id_procid)
+      il_procid=il_ind(1)
+      IF( il_procid == 0 )THEN
+         CALL logger_error("MPP DEL PROC: no processor "//&
+         &                 TRIM(fct_str(id_procid))//&
+         &                 " associated to mpp structure")
+      ELSE
+         CALL logger_trace("DEL PROC: remove processor "//&
+         &                 TRIM(fct_str(id_procid)))
+
+         IF( td_mpp%i_nproc > 1 )THEN
+            ALLOCATE( tl_proc(td_mpp%i_nproc-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+               CALL logger_error( "MPP DEL PROC: not enough space to put &
+               &  processor in temporary mpp structure")
+
+            ELSE
+
+               ! save temporary processor's mpp structure
+               IF( il_procid > 1 )THEN
+                  tl_proc(1:il_procid-1)=file_copy(td_mpp%t_proc(1:il_procid-1))
+               ENDIF
+
+               IF( il_procid < td_mpp%i_nproc )THEN
+                  tl_proc(il_procid:)=file_copy(td_mpp%t_proc(il_procid+1:))
+               ENDIF
+
+               ! new number of processor in mpp
+               td_mpp%i_nproc=td_mpp%i_nproc-1
+
+               CALL file_clean( td_mpp%t_proc(:) )
+               DEALLOCATE(td_mpp%t_proc)
+               ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( "MPP DEL PROC: not enough space &
+                  &  to put processors in mpp structure " )
+
+               ELSE
+
+                  ! copy processor in mpp before
+                  td_mpp%t_proc(:)=file_copy(tl_proc(:))
+
+                  ! update processor id
+                  td_mpp%t_proc( il_procid : td_mpp%i_nproc )%i_pid = &
+                  &     td_mpp%t_proc( il_procid : td_mpp%i_nproc )%i_pid - 1
+
+               ENDIF
+            ENDIF
+            ! clean
+            CALL file_clean( tl_proc(:) )
+            DEALLOCATE(tl_proc)
+         ELSE
+            CALL file_clean( td_mpp%t_proc(:) )
+            DEALLOCATE(td_mpp%t_proc)
+
+            ! new number of processor in mpp
+            td_mpp%i_nproc=td_mpp%i_nproc-1
+         ENDIF
+      ENDIF
+   END SUBROUTINE mpp__del_proc_id
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete processor in mpp structure, given processor
+   !>    structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp : mpp strcuture
+   !> @param[in]    td_proc : file/processor structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_proc_str( td_mpp, td_proc )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),   INTENT(INOUT) :: td_mpp
+      TYPE(TFILE),  INTENT(IN)    :: td_proc
+      !----------------------------------------------------------------
+
+      IF( td_proc%i_pid >= 0 )THEN
+         CALL mpp__del_proc( td_mpp, td_proc%i_pid )
+      ELSE
+         CALL logger_error("MPP DEL PROC: processor not defined")
+      ENDIF
+
+   END SUBROUTINE mpp__del_proc_str
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine overwrite processor in mpp structure.
+   !>
+   !> @detail
+   !
+   !> @author J.Paul
+   !> @date Nov, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    id_procid processor id
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__move_proc( td_mpp, td_proc )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+      TYPE(TFILE), INTENT(IN)    :: td_proc
+      !----------------------------------------------------------------
+
+      ! remove processor
+      CALL mpp__del_proc(td_mpp, td_proc)
+
+      ! add processor
+      CALL mpp__add_proc(td_mpp, td_proc)
+
+   END SUBROUTINE mpp__move_proc
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a dimension structure in a mpp 
+   !> structure.
+   !> Do not overwrite, if dimension already in mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_add_dim
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_add_dim(td_mpp, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TDIM), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already used in mpp structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+         IF( il_ind == 0 )THEN
+            CALL logger_warn( &
+            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", will not be added in mpp "//TRIM(td_mpp%c_name) )
+         ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN
+            CALL logger_error( &
+            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", already used in mpp "//TRIM(td_mpp%c_name) )
+         ELSE
+
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_mpp%t_dim(:))
+
+            ! add new dimension
+            td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim)
+
+            ! update number of attribute
+            td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+
+         ENDIF
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim(:))
+
+      ELSE
+         CALL logger_error( &
+         &  "MPP ADD DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE mpp_add_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a dimension structure in a mpp 
+   !> structure.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_del_dim
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_del_dim(td_mpp, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TDIM), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      TYPE(TDIM)  :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         CALL logger_trace( &
+         &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
+         &  ", short name "//TRIM(td_dim%c_sname)//&
+         &  ", in mpp "//TRIM(td_mpp%c_name) )
+         
+         ! check if dimension already in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+
+         ! replace dimension by empty one
+         td_mpp%t_dim(il_ind)=dim_copy(tl_dim)
+
+         ! update number of dimension
+         td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim)
+
+      ELSE
+         CALL logger_error( &
+         &  " MPP DEL DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE mpp_del_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a dimension structure 
+   !> in mpp structure.
+   !> @warning dimension order may have changed
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_move_dim(td_mpp, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TDIM), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            il_dimid=td_mpp%t_dim(il_ind)%i_id
+            ! replace dimension
+            td_mpp%t_dim(il_ind)=dim_copy(td_dim)
+            td_mpp%t_dim(il_ind)%i_id=il_dimid
+            td_mpp%t_dim(il_ind)%l_use=.TRUE.
+
+         ELSE
+            CALL mpp_add_dim(td_mpp, td_dim)
+         ENDIF
+
+      ELSE
+         CALL logger_error( &
+         &  "MPP MOVE DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+      ENDIF
+   END SUBROUTINE mpp_move_dim
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add global attribute to mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_att attribute strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_add_att( td_mpp, td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_attid
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP ADD ATT: domain decomposition not define "//&
+         &               "for mpp "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! check if variable exist
+         IF( TRIM(td_att%c_name) == '' )THEN
+            CALL logger_error("MPP ADD ATT: attribute not define ")
+         ELSE
+            ! check if attribute already in mpp structure
+            il_attid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+               il_attid=att_get_index( td_mpp%t_proc(1)%t_att(:), &
+               &                    td_att%c_name )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+
+               CALL logger_error( " MPP ADD ATT: attribute "//&
+               &                 TRIM(td_att%c_name)//&
+               &                 ", already in mpp "//TRIM(td_mpp%c_name) )
+
+               DO ji=1,td_mpp%t_proc(1)%i_natt
+                  CALL logger_debug( " MPP ADD ATT: in mpp structure : &
+                  &  attribute "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
+               ENDDO
+
+            ELSE
+            
+               CALL logger_info( &
+               &  " MPP ADD ATT: add attribute "//TRIM(td_att%c_name)//&
+               &  ", in mpp "//TRIM(td_mpp%c_name) )
+
+               ! add attribute in each processor
+               DO ji=1,td_mpp%i_nproc
+
+                  CALL file_add_att(td_mpp%t_proc(ji), td_att)
+
+               ENDDO
+
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp_add_att
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete attribute in mpp structure, given attribute
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_att attribute strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_att_str( td_mpp, td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4)       :: il_attid
+      CHARACTER(LEN=lc) :: cl_name
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_warn( "MPP DEL VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         ! check if attribute already in mpp structure
+         il_attid=0
+         IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+            il_attid=att_get_index( td_mpp%t_proc(1)%t_att(:), &
+            &                    td_att%c_name )
+         ENDIF
+         IF( il_attid == 0 )THEN
+            CALL logger_warn( &
+            &  "MPP DEL VAR: no attribute "//TRIM(td_att%c_name)//&
+            &  ", in mpp structure "//TRIM(td_mpp%c_name) )
+
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+               DO ji=1,td_mpp%t_proc(1)%i_natt
+                  CALL logger_debug( "MPP DEL ATT: in mpp structure : &
+                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
+               ENDDO
+            ENDIF
+
+         ELSE
+
+            cl_name=TRIM(td_att%c_name)
+            CALL logger_debug( "MPP DEL ATT: delete in mpp structure : &
+            &  attribute : "//TRIM(cl_name) )
+            DO ji=1,td_mpp%i_nproc
+               CALL file_del_att(td_mpp%t_proc(ji), TRIM(cl_name)) 
+            ENDDO
+
+         ENDIF
+
+      ENDIF
+   END SUBROUTINE mpp__del_att_str
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete attribute in mpp structure, given attribute name.
+   !>
+   !> @detail
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake with pointer
+   !
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    cd_name   attribute name
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__del_att_name( td_mpp, cd_name )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)       , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*) , INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_attid
+      TYPE(TATT)  :: tl_att
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_warn( "MPP DEL ATT: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         IF( td_mpp%t_proc(1)%i_natt == 0 )THEN
+            CALL logger_debug( "MPP DEL ATT NAME: no attribute associated to mpp &
+            &                 structure "//TRIM(td_mpp%c_name) )
+         ELSE
+
+            ! get the attribute id, in file variable structure
+            il_attid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+               il_attid=att_get_id( td_mpp%t_proc(1)%t_att(:), &
+               &                    cd_name )
+            ENDIF
+
+            IF( il_attid == 0 )THEN
+
+               CALL logger_debug( &
+               &  "MPP DEL ATT : there is no attribute with "//&
+               &  "name "//TRIM(cd_name)//" in mpp structure "//&
+               &  TRIM(td_mpp%c_name))
+
+            ELSE
+
+               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid))
+               CALL mpp_del_att(td_mpp, tl_att) 
+
+            ENDIF
+         ENDIF
+
+      ENDIF
+   END SUBROUTINE mpp__del_att_name
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine overwrite attribute in mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_att attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_move_att( td_mpp, td_att )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      !local variable
+      TYPE(TATT)  :: tl_att
+      !----------------------------------------------------------------
+      ! copy variable
+      tl_att=att_copy(td_att)
+
+      ! remove processor
+      CALL mpp_del_att(td_mpp, tl_att)
+
+      ! add processor
+      CALL mpp_add_att(td_mpp, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE mpp_move_att
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This function initialise domain layout
+   !> 
+   !> @detail
+   !> Domain layout is first compute, with domain dimension, overlap between subdomain,
+   !> and the number of processors following I and J.
+   !> Then the number of sea/land processors is compute with mask
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !> @date October, 2016
+   !> - compare index to td_lay number of proc instead of td_mpp (bug fix)
+   !>
+   !> @param[in] td_mpp mpp strcuture
+   !> @param[in] id_mask   sub domain mask (sea=1, land=0)
+   !> @pâram[in] id_niproc number of processors following I
+   !> @pâram[in] id_njproc number of processors following J
+   !> @return domain layout structure
+   !-------------------------------------------------------------------
+   FUNCTION layout__init( td_mpp, id_mask, id_niproc, id_njproc ) RESULT(td_lay)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)                 , INTENT(IN) :: td_mpp
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
+      INTEGER(i4)                , INTENT(IN) :: id_niproc
+      INTEGER(i4)                , INTENT(IN) :: id_njproc
+
+      ! function
+      TYPE(TLAY) :: td_lay
+
+      ! local variable
+      INTEGER(i4) :: ii1, ii2
+      INTEGER(i4) :: ij1, ij2
+
+      INTEGER(i4) :: il_ldi
+      INTEGER(i4) :: il_ldj
+      INTEGER(i4) :: il_lei
+      INTEGER(i4) :: il_lej
+
+      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size 
+      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
+      INTEGER(i4) :: il_resti !<  
+      INTEGER(i4) :: il_restj !<  
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! intialise
+      td_lay%i_niproc=id_niproc
+      td_lay%i_njproc=id_njproc
+
+      CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//&
+      &               TRIM(fct_str(td_lay%i_niproc))//" x "//&
+      &               TRIM(fct_str(td_lay%i_njproc))//" processors")
+
+      ! maximum size of sub domain
+      il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_lay%i_niproc-1))/ &
+      &           td_lay%i_niproc) + 2*td_mpp%i_preci
+      il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_lay%i_njproc-1))/ &
+      &           td_lay%i_njproc) + 2*td_mpp%i_precj
+
+      il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_lay%i_niproc)
+      il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_lay%i_njproc)
+      IF( il_resti == 0 ) il_resti = td_lay%i_niproc
+      IF( il_restj == 0 ) il_restj = td_lay%i_njproc
+
+      ! compute dimension of each sub domain
+      ALLOCATE( td_lay%i_lci(td_lay%i_niproc,td_lay%i_njproc) )
+      ALLOCATE( td_lay%i_lcj(td_lay%i_niproc,td_lay%i_njproc) )
+
+      td_lay%i_lci( 1          : il_resti       , : ) = il_isize
+      td_lay%i_lci( il_resti+1 : td_lay%i_niproc, : ) = il_isize-1
+
+      td_lay%i_lcj( : , 1          : il_restj       ) = il_jsize
+      td_lay%i_lcj( : , il_restj+1 : td_lay%i_njproc) = il_jsize-1
+
+      ! compute first index of each sub domain
+      ALLOCATE( td_lay%i_impp(td_lay%i_niproc,td_lay%i_njproc) )
+      ALLOCATE( td_lay%i_jmpp(td_lay%i_niproc,td_lay%i_njproc) )
+
+      td_lay%i_impp(:,:)=1
+      td_lay%i_jmpp(:,:)=1
+
+      IF( td_lay%i_niproc > 1 )THEN
+         DO jj=1,td_lay%i_njproc
+            DO ji=2,td_lay%i_niproc
+               td_lay%i_impp(ji,jj) = td_lay%i_impp(ji-1,jj) + &
+               &                       td_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci
+            ENDDO
+         ENDDO
+      ENDIF
+
+      IF( td_lay%i_njproc > 1 )THEN
+         DO jj=2,td_lay%i_njproc
+            DO ji=1,td_lay%i_niproc
+               td_lay%i_jmpp(ji,jj) = td_lay%i_jmpp(ji,jj-1) + &
+               &                       td_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj
+            ENDDO
+         ENDDO 
+      ENDIF
+
+      ALLOCATE(td_lay%i_msk(td_lay%i_niproc,td_lay%i_njproc))
+      td_lay%i_msk(:,:)=0
+      ! init number of sea/land proc
+      td_lay%i_nsea=0
+      td_lay%i_nland=td_lay%i_njproc*td_lay%i_niproc
+
+      ! check if processor is land or sea
+      DO jj = 1,td_lay%i_njproc
+         DO ji = 1,td_lay%i_niproc
+
+            ! compute first and last indoor indices
+            ! west boundary
+            IF( ji == 1 )THEN
+               il_ldi = 1 
+            ELSE
+               il_ldi = 1 + td_mpp%i_preci
+            ENDIF
+
+            ! south boundary
+            IF( jj == 1 )THEN
+               il_ldj = 1 
+            ELSE
+               il_ldj = 1 + td_mpp%i_precj
+            ENDIF
+
+            ! east boundary
+            IF( ji == td_lay%i_niproc )THEN
+               il_lei = td_lay%i_lci(ji,jj)
+            ELSE
+               il_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
+            ENDIF
+
+            ! north boundary
+            IF( jj == td_lay%i_njproc )THEN
+               il_lej = td_lay%i_lcj(ji,jj)
+            ELSE
+               il_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
+            ENDIF
+
+            ii1=td_lay%i_impp(ji,jj) + il_ldi - 1
+            ii2=td_lay%i_impp(ji,jj) + il_lei - 1
+
+            ij1=td_lay%i_jmpp(ji,jj) + il_ldj - 1
+            ij2=td_lay%i_jmpp(ji,jj) + il_lej - 1
+
+            td_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) )
+            IF( td_lay%i_msk(ji,jj) > 0 )THEN ! sea
+               td_lay%i_nsea =td_lay%i_nsea +1
+               td_lay%i_nland=td_lay%i_nland-1
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(td_lay%i_nsea)))
+      CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(td_lay%i_nland)))
+      CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(td_lay%i_msk(:,:)))))
+
+      td_lay%i_mean= SUM(td_lay%i_msk(:,:)) / td_lay%i_nsea
+      td_lay%i_min = MINVAL(td_lay%i_msk(:,:),td_lay%i_msk(:,:)/=0)
+      td_lay%i_max = MAXVAL(td_lay%i_msk(:,:))
+
+      IF( lm_layout )THEN
+         ! print info 
+         WRITE(im_iumout,*) ' '
+         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
+         WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize
+         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
+
+
+         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc
+         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea
+         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
+         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean
+         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min
+         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max
+      ENDIF
+
+   END FUNCTION layout__init
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean domain layout strcuture.
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !>
+   !> @param[inout] td_lay domain layout strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE layout__clean( td_lay )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TLAY),  INTENT(INOUT) :: td_lay
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         DEALLOCATE(td_lay%i_msk)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_impp) )THEN
+         DEALLOCATE(td_lay%i_impp)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_jmpp) )THEN
+         DEALLOCATE(td_lay%i_jmpp)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_lci) )THEN
+         DEALLOCATE(td_lay%i_lci)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_lcj) )THEN
+         DEALLOCATE(td_lay%i_lcj)
+      ENDIF
+
+      td_lay%i_niproc=0
+      td_lay%i_njproc=0
+      td_lay%i_nland =0
+      td_lay%i_nsea  =0
+
+      td_lay%i_mean  =0
+      td_lay%i_min   =0
+      td_lay%i_max   =0
+
+   END SUBROUTINE layout__clean
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy domain layout structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial Version
+   !
+   !> @param[in] td_lay   domain layout structure
+   !> @return copy of input domain layout structure
+   !-------------------------------------------------------------------
+   FUNCTION layout__copy( td_lay )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TLAY), INTENT(IN)  :: td_lay
+      ! function
+      TYPE(TLAY) :: layout__copy
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy scalar 
+      layout__copy%i_niproc   = td_lay%i_niproc
+      layout__copy%i_njproc   = td_lay%i_njproc
+      layout__copy%i_nland    = td_lay%i_nland 
+      layout__copy%i_nsea     = td_lay%i_nsea  
+      layout__copy%i_mean     = td_lay%i_mean  
+      layout__copy%i_min      = td_lay%i_min   
+      layout__copy%i_max      = td_lay%i_max   
+
+      ! copy pointers
+      IF( ASSOCIATED(layout__copy%i_msk) )THEN
+         DEALLOCATE(layout__copy%i_msk)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         il_shape(:)=SHAPE(td_lay%i_msk(:,:))
+         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_msk(:,:)=td_lay%i_msk(:,:)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_msk) ) DEALLOCATE(layout__copy%i_msk)
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         il_shape(:)=SHAPE(td_lay%i_msk(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_msk(:,:)
+
+         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_msk(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_impp) ) DEALLOCATE(layout__copy%i_impp)
+      IF( ASSOCIATED(td_lay%i_impp) )THEN
+         il_shape(:)=SHAPE(td_lay%i_impp(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_impp(:,:)
+
+         ALLOCATE( layout__copy%i_impp(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_impp(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_jmpp) ) DEALLOCATE(layout__copy%i_jmpp)
+      IF( ASSOCIATED(td_lay%i_jmpp) )THEN
+         il_shape(:)=SHAPE(td_lay%i_jmpp(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_jmpp(:,:)
+
+         ALLOCATE( layout__copy%i_jmpp(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_jmpp(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_lci) ) DEALLOCATE(layout__copy%i_lci)
+      IF( ASSOCIATED(td_lay%i_lci) )THEN
+         il_shape(:)=SHAPE(td_lay%i_lci(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_lci(:,:)
+
+         ALLOCATE( layout__copy%i_lci(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_lci(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(layout__copy%i_lcj) ) DEALLOCATE(layout__copy%i_lcj)
+      IF( ASSOCIATED(td_lay%i_lcj) )THEN
+         il_shape(:)=SHAPE(td_lay%i_lcj(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_lcj(:,:)
+
+         ALLOCATE( layout__copy%i_lcj(il_shape(jp_I),il_shape(jp_J)) )
+         layout__copy%i_lcj(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+   END FUNCTION layout__copy
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine create mpp structure using domain layout
+   !>
+   !> @detail
+   !
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in] td_lay domain layout structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__create_layout( td_mpp, td_lay )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TLAY), INTENT(IN   ) :: td_lay
+
+      ! local variable
+      CHARACTER(LEN=lc)                        :: cl_file
+      TYPE(TFILE)                              :: tl_proc
+      TYPE(TATT)                               :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! intialise
+      td_mpp%i_nproc=0
+
+      CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//&
+      &               TRIM(fct_str(td_lay%i_niproc))//" x "//&
+      &               TRIM(fct_str(td_lay%i_njproc))//" = "//&
+      &               TRIM(fct_str(td_lay%i_nsea))//" processors")
+
+      IF( lm_layout )THEN
+         WRITE(im_iumout,*) ' choix optimum'
+         WRITE(im_iumout,*) ' ============='
+         WRITE(im_iumout,*)
+         ! print info 
+         WRITE(im_iumout,*) ' '
+         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
+         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
+
+
+         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc
+         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea
+         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
+         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean
+         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min
+         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max
+      ENDIF
+
+      td_mpp%i_niproc=td_lay%i_niproc
+      td_mpp%i_njproc=td_lay%i_njproc
+      !td_mpp%i_nproc =td_lay%i_nsea
+
+      IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN
+         IF( td_lay%i_nsea == 1 )THEN
+            td_mpp%c_dom='full'
+         ELSE
+            td_mpp%c_dom='nooverlap'
+         ENDIF
+      ELSE
+            td_mpp%c_dom='noextra'
+      ENDIF
+      
+      jk=0
+      DO jj=1,td_lay%i_njproc
+         DO ji=1,td_lay%i_niproc
+
+            IF( td_lay%i_msk(ji,jj) >= 1 )THEN
+
+               ! get processor file name
+               cl_file=file_rename(td_mpp%c_name,jk)
+               ! initialise file structure
+               tl_proc=file_init(cl_file,td_mpp%c_type)
+
+               ! procesor id
+               tl_proc%i_pid=jk
+
+               tl_att=att_init("DOMAIN_number",tl_proc%i_pid)
+               CALL file_add_att(tl_proc, tl_att)
+
+               ! processor indices
+               tl_proc%i_iind=ji
+               tl_proc%i_jind=jj
+
+               ! fill processor dimension and first indices
+               tl_proc%i_impp = td_lay%i_impp(ji,jj)
+               tl_proc%i_jmpp = td_lay%i_jmpp(ji,jj)
+
+               tl_proc%i_lci  = td_lay%i_lci(ji,jj)
+               tl_proc%i_lcj  = td_lay%i_lcj(ji,jj)
+
+               ! compute first and last indoor indices
+               
+               ! west boundary
+               IF( ji == 1 )THEN
+                  tl_proc%i_ldi = 1 
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_ldi = 1 + td_mpp%i_preci
+               ENDIF
+
+               ! south boundary
+               IF( jj == 1 )THEN
+                  tl_proc%i_ldj = 1 
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_ldj = 1 + td_mpp%i_precj
+               ENDIF
+
+               ! east boundary
+               IF( ji == td_mpp%i_niproc )THEN
+                  tl_proc%i_lei = td_lay%i_lci(ji,jj)
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
+               ENDIF
+
+               ! north boundary
+               IF( jj == td_mpp%i_njproc )THEN
+                  tl_proc%i_lej = td_lay%i_lcj(ji,jj)
+                  tl_proc%l_ctr = .TRUE.
+               ELSE
+                  tl_proc%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
+               ENDIF
+
+               ! add processor to mpp structure
+               CALL mpp__add_proc(td_mpp, tl_proc)
+
+               ! clean
+               CALL att_clean(tl_att)
+               CALL file_clean(tl_proc)
+
+               ! update proc number
+               jk=jk+1 !ji+(jj-1)*td_lay%i_niproc
+
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE mpp__create_layout
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine optimize the number of sub domain to be used, given mask.
+   !> @details
+   !>  Actually it get the domain decomposition with the most land 
+   !>  processors removed.
+   !>  If no land processor could be removed, it get the decomposition with the
+   !>  most sea processors.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date October, 2015
+   !> - improve way to compute domain layout 
+   !> @date February, 2016
+   !> - new criteria for domain layout in case no land proc
+   !
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
+   !> @pram[in] id_nproc maximum number of processor to be used
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__optimiz( td_mpp, id_mask, id_nproc )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),                  INTENT(INOUT) :: td_mpp
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask
+      INTEGER(i4)                , INTENT(IN)    :: id_nproc
+
+      ! local variable
+      TYPE(TLAY) :: tl_lay
+      TYPE(TLAY) :: tl_sav
+
+      REAL(dp)   :: dl_min
+      REAL(dp)   :: dl_max
+      REAL(dp)   :: dl_ratio
+      REAL(dp)   :: dl_sav
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition")
+      dl_sav=0
+      ! 
+      DO ji=1,id_nproc
+         DO jj=1,id_nproc
+
+            ! compute domain layout
+            tl_lay=layout__init( td_mpp, id_mask, ji,jj )
+            IF( tl_lay%i_nsea <= id_nproc )THEN
+
+               IF( ASSOCIATED(tl_sav%i_lci) )THEN
+                  IF( tl_sav%i_nland /= 0 )THEN
+                     ! look for layout with most land proc
+                     IF( tl_lay%i_nland > tl_sav%i_nland    .OR. &
+                     &   ( tl_lay%i_nland == tl_sav%i_nland .AND. &
+                     &     tl_lay%i_min   >  tl_sav%i_min   ) )THEN
+                        ! save optimiz layout
+                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+                        &   TRIM(fct_str(tl_lay%i_nsea)) )
+
+                        tl_sav=layout__copy(tl_lay)
+                     ENDIF
+                  ELSE ! tl_sav%i_nland == 0
+                     ! look for layout with most sea proc 
+                     ! and "square" cell 
+                     dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
+                     dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
+                     dl_ratio=dl_min/dl_max
+                     IF( tl_lay%i_nsea > tl_sav%i_nsea    .OR. &
+                     &   ( tl_lay%i_nsea == tl_sav%i_nsea .AND. &
+                     &     dl_ratio   >  dl_sav ) )THEN
+                        ! save optimiz layout
+                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+                        &   TRIM(fct_str(tl_lay%i_nsea)) )
+
+                        tl_sav=layout__copy(tl_lay)
+                        dl_sav=dl_ratio
+                     ENDIF
+                  ENDIF
+               ELSE
+                  ! init tl_sav
+                  tl_sav=layout__copy(tl_lay)
+
+                  dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
+                  dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
+                  dl_sav=dl_min/dl_max
+               ENDIF
+
+            ENDIF
+
+            ! clean
+            CALL layout__clean( tl_lay )
+
+         ENDDO
+      ENDDO
+
+      ! create mpp domain layout
+      CALL mpp__create_layout(td_mpp, tl_sav)
+
+      ! clean
+      CALL layout__clean( tl_sav )
+
+   END SUBROUTINE mpp__optimiz
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean mpp strcuture.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__clean_unit( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      TYPE(TMPP) :: tl_mpp ! empty mpp structure
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info( &
+      &  "MPP CLEAN: reset mpp "//TRIM(td_mpp%c_name) )
+
+      ! del dimension
+      IF( td_mpp%i_ndim /= 0 )THEN
+         CALL dim_clean( td_mpp%t_dim(:) )
+      ENDIF
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         ! clean array of file processor
+         CALL file_clean( td_mpp%t_proc(:) )
+         DEALLOCATE(td_mpp%t_proc)
+      ENDIF
+
+      ! replace by empty structure
+      td_mpp=mpp_copy(tl_mpp)
+
+   END SUBROUTINE mpp__clean_unit
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean mpp strcuture.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__clean_arr( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  DIMENSION(:), INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_mpp(:)),1,-1
+         CALL mpp_clean(td_mpp(ji))
+      ENDDO
+
+   END SUBROUTINE mpp__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine get sub domains which cover "zoom domain".
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in] id_imin   i-direction lower indice
+   !> @param[in] id_imax   i-direction upper indice
+   !> @param[in] id_jmin   j-direction lower indice
+   !> @param[in] id_jmax   j-direction upper indice
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__get_use_unit( td_mpp, id_imin, id_imax, &
+   &                                     id_jmin, id_jmax )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP) ,  INTENT(INOUT) :: td_mpp
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_jmax
+
+      ! local variable
+      LOGICAL     :: ll_iuse
+      LOGICAL     :: ll_juse
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+   
+         il_imin=1
+         il_imax=td_mpp%t_dim(1)%i_len
+         IF( PRESENT(id_imin) ) il_imin=id_imin
+         IF( PRESENT(id_imax) ) il_imax=id_imax
+         il_jmin=1
+         il_jmax=td_mpp%t_dim(2)%i_len
+         IF( PRESENT(id_jmin) ) il_jmin=id_jmin
+         IF( PRESENT(id_jmax) ) il_jmax=id_jmax
+
+         ! check domain
+         IF( il_imin < 1 .OR. il_imin > td_mpp%t_dim(1)%i_len .OR. &
+         &   il_imax < 1 .OR. il_imax > td_mpp%t_dim(1)%i_len .OR. &
+         &   il_jmin < 1 .OR. il_jmin > td_mpp%t_dim(2)%i_len .OR. &
+         &   il_jmax < 1 .OR. il_jmax > td_mpp%t_dim(2)%i_len )THEN
+            CALL logger_debug("MPP GET USE: mpp gloabl size "//&
+            &        TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
+            &        TRIM(fct_str(td_mpp%t_dim(2)%i_len)))
+            CALL logger_debug("MPP GET USE: i-indices "//&
+            &        TRIM(fct_str(il_imin))//","//TRIM(fct_str(il_imax)))
+            CALL logger_debug("MPP GET USE: j-indices "//&
+            &        TRIM(fct_str(il_jmin))//","//TRIM(fct_str(il_jmax)))
+            CALL logger_error("MPP GET USE: invalid indices ")
+         ELSE
+            td_mpp%t_proc(:)%l_use=.FALSE.
+            DO jk=1,td_mpp%i_nproc
+
+               ! check i-direction
+               ll_iuse=.FALSE.
+               IF( il_imin < il_imax )THEN
+
+                  ! not overlap east west boundary
+                  IF( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci > &
+                  &   il_imin .AND.                                  &
+                  &   td_mpp%t_proc(jk)%i_impp < il_imax )THEN
+                      ll_iuse=.TRUE.
+                  ENDIF
+
+               ELSEIF( il_imin == il_imax )THEN
+
+                  ! east west cyclic
+                  ll_iuse=.TRUE.
+
+               ELSE ! il_imin > id_imax
+
+                  ! overlap east west boundary
+                  IF( ( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci >  &
+                  &     il_imin )                                             &
+                  &   .OR.                                                    &
+                  &   ( td_mpp%t_proc(jk)%i_impp < il_imax) )THEN
+                     ll_iuse=.TRUE.
+                  ENDIF
+
+               ENDIF
+
+               ! check j-direction
+               ll_juse=.FALSE.
+               IF( il_jmin < il_jmax )THEN
+
+                  ! not overlap north fold
+                  IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
+                  &   il_jmin .AND.                                  &
+                  &   td_mpp%t_proc(jk)%i_jmpp < il_jmax )THEN
+                     ll_juse=.TRUE.
+                  ENDIF
+
+               ELSE ! id_jmin >= id_jmax
+
+                  IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
+                  &  il_jmin )THEN
+                     ll_juse=.TRUE.
+                  ENDIF
+
+               ENDIF
+
+               IF( ll_iuse .AND. ll_juse ) td_mpp%t_proc(jk)%l_use=.TRUE.
+
+            ENDDO
+         ENDIF
+
+      ELSE
+         CALL logger_error("MPP GET USE: mpp decomposition not define.")
+      ENDIF
+
+   END SUBROUTINE mpp__get_use_unit
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine get sub domains which form global domain border.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_get_contour( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         td_mpp%t_proc(:)%l_use = .FALSE.
+         DO jk=1,td_mpp%i_nproc
+            IF( td_mpp%t_proc(jk)%i_ldi == 1 .OR. &
+            &   td_mpp%t_proc(jk)%i_ldj == 1 .OR. &
+            &   td_mpp%t_proc(jk)%i_lei == td_mpp%t_proc(jk)%i_lci .OR. &
+            &   td_mpp%t_proc(jk)%i_lej == td_mpp%t_proc(jk)%i_lcj )THEN
+
+               td_mpp%t_proc(jk)%l_use = .TRUE.
+ 
+            ENDIF
+         ENDDO
+   
+      ELSE
+         CALL logger_error("MPP GET CONTOUR: domain decomposition not define.")
+      ENDIF
+
+   END SUBROUTINE mpp_get_contour
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function return processor indices, without overlap boundary,
+   !> given processor id. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[in] td_mpp    mpp strcuture
+   !> @param[in] id_procid processor id
+   !> @return array of index (/ i1, i2, j1, j2 /)
+   !-------------------------------------------------------------------
+   FUNCTION mpp_get_proc_index( td_mpp, id_procid )
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN) :: id_procid
+
+      ! function
+      INTEGER(i4), DIMENSION(4) :: mpp_get_proc_index
+
+      ! local variable
+      INTEGER(i4) :: il_i1, il_i2
+      INTEGER(i4) :: il_j1, il_j2
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         IF( TRIM(td_mpp%c_dom) == '' )THEN
+            CALL logger_fatal("MPP GET PROC INDEX: decomposition type unknown. "//&
+            &                 "you should ahve run mpp_get_dom before.")
+         ENDIF
+
+         SELECT CASE(TRIM(td_mpp%c_dom))
+            CASE('full')
+               il_i1 = 1 
+               il_j1 = 1 
+
+               il_i2 = td_mpp%t_dim(1)%i_len
+               il_j2 = td_mpp%t_dim(2)%i_len
+            CASE('noextra')
+               il_i1 = td_mpp%t_proc(id_procid)%i_impp
+               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp
+
+               il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1 
+               il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1 
+            CASE('nooverlap')
+               il_i1 = td_mpp%t_proc(id_procid)%i_impp + &
+               &        td_mpp%t_proc(id_procid)%i_ldi - 1
+               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp + &
+               &        td_mpp%t_proc(id_procid)%i_ldj - 1
+
+               il_i2 = td_mpp%t_proc(id_procid)%i_impp + &
+               &        td_mpp%t_proc(id_procid)%i_lei - 1
+               il_j2 = td_mpp%t_proc(id_procid)%i_jmpp + &
+               &        td_mpp%t_proc(id_procid)%i_lej - 1
+            CASE DEFAULT
+               CALL logger_error("MPP GET PROC INDEX: invalid "//&
+                  &              "decomposition type.")
+         END SELECT
+
+         mpp_get_proc_index(:)=(/il_i1, il_i2, il_j1, il_j2/)
+
+      ELSE
+         CALL logger_error("MPP GET PROC INDEX: domain decomposition not define.")
+      ENDIF
+
+   END FUNCTION mpp_get_proc_index
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function return processor domain size, depending of domain 
+   !> decompisition type, given sub domain id. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !
+   !> @param[in] td_mpp    mpp strcuture
+   !> @param[in] id_procid sub domain id
+   !> @return array of index (/ isize, jsize /)
+   !-------------------------------------------------------------------
+   FUNCTION mpp_get_proc_size( td_mpp, id_procid )
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN) :: id_procid
+
+      ! function
+      INTEGER(i4), DIMENSION(2) :: mpp_get_proc_size
+
+      ! local variable
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         IF( TRIM(td_mpp%c_dom) == '' )THEN
+            CALL logger_fatal("MPP GET PROC SIZE: decomposition type unknown. "//&
+            &                 "you should ahve run mpp_get_dom before.")
+         ENDIF
+
+         SELECT CASE(TRIM(td_mpp%c_dom))
+            CASE('full')
+               
+               il_isize = td_mpp%t_dim(1)%i_len
+               il_jsize = td_mpp%t_dim(2)%i_len
+
+            CASE('noextra')
+
+                il_isize = td_mpp%t_proc(id_procid)%i_lci
+                il_jsize = td_mpp%t_proc(id_procid)%i_lcj
+
+            CASE('nooverlap')
+               il_isize = td_mpp%t_proc(id_procid)%i_lei - &
+               &          td_mpp%t_proc(id_procid)%i_ldi + 1
+               il_jsize = td_mpp%t_proc(id_procid)%i_lej - &
+               &          td_mpp%t_proc(id_procid)%i_ldj + 1
+            CASE DEFAULT
+               CALL logger_error("MPP GET PROC SIZE: invalid decomposition type : "//&
+               &  TRIM(td_mpp%c_dom) )
+         END SELECT
+
+         mpp_get_proc_size(:)=(/il_isize, il_jsize/)
+
+      ELSE
+         CALL logger_error("MPP GET PROC SIZE: domain decomposition not define.")
+      ENDIF
+
+   END FUNCTION mpp_get_proc_size
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine determine domain decomposition type.
+   !>  (full, overlap, noverlap)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp_get_dom( td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN
+            CALL logger_info("MPP GET DOM: use indoor indices to get domain "//&
+            &             "decomposition type.")
+            IF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                         &
+            &   td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1) .AND. &
+            &  (td_mpp%t_proc(1)%t_dim(2)%i_len ==                         &
+            &   td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1) )THEN
+
+               td_mpp%c_dom='nooverlap'
+
+            ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     &
+            &       td_mpp%t_proc(1)%i_lci                     )     .AND. &
+            &      (td_mpp%t_proc(1)%t_dim(2)%i_len ==                     &
+            &       td_mpp%t_proc(1)%i_lcj                     )     )THEN
+
+               td_mpp%c_dom='noextra'
+
+            ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     &
+            &       td_mpp%t_dim(1)%i_len             )              .AND. &
+            &      (td_mpp%t_proc(1)%t_dim(2)%i_len ==                     &
+            &       td_mpp%t_dim(2)%i_len )                          )THEN
+
+               td_mpp%c_dom='full'
+
+            ELSE
+
+               CALL logger_error("MPP GET DOM: should have been an impossible case")
+
+               il_isize=td_mpp%t_proc(1)%t_dim(1)%i_len
+               il_jsize=td_mpp%t_proc(1)%t_dim(2)%i_len
+               CALL logger_debug("MPP GET DOM: proc size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+               il_isize=td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1
+               il_jsize=td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1
+               CALL logger_debug("MPP GET DOM: no overlap size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+               il_isize=td_mpp%t_proc(1)%i_lci
+               il_jsize=td_mpp%t_proc(1)%i_lcj
+               CALL logger_debug("MPP GET DOM: overlap size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+               il_isize=td_mpp%t_dim(1)%i_len
+               il_jsize=td_mpp%t_dim(2)%i_len
+               CALL logger_debug("MPP GET DOM: full size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+            ENDIF
+
+         ELSE
+
+            CALL logger_info("MPP GET DOM: use number of processors following "//&
+            &             "I and J to get domain decomposition type.")
+            IF( td_mpp%i_niproc*td_mpp%i_njproc==td_mpp%i_nproc )THEN
+               IF( td_mpp%i_nproc == 1 )THEN
+                  td_mpp%c_dom='full'
+               ENDIF
+               td_mpp%c_dom='nooverlap'
+            ELSE
+               td_mpp%c_dom='noextra'
+            ENDIF
+
+         ENDIF
+
+      ELSE
+         CALL logger_error("MPP GET DOM: domain decomposition not define.")
+      ENDIF
+
+   END SUBROUTINE mpp_get_dom
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable  and mpp structure use same
+   !> dimension.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September 2015
+   !> - do not check used dimension here
+   !>
+   !> @param[in] td_mpp mpp structure
+   !> @param[in] td_var variable structure
+   !> @return dimension of variable and mpp structure agree (or not)
+   !-------------------------------------------------------------------
+   LOGICAL FUNCTION mpp__check_var_dim(td_mpp, td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_dim
+      LOGICAL :: ll_error
+      LOGICAL :: ll_warn
+
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      mpp__check_var_dim=.TRUE.
+
+      ! check used dimension 
+      ll_error=.FALSE.
+      ll_warn=.FALSE.
+      DO ji=1,ip_maxdim
+         il_ind=dim_get_index( td_mpp%t_dim(:), &
+         &                     TRIM(td_var%t_dim(ji)%c_name), &
+         &                     TRIM(td_var%t_dim(ji)%c_sname))
+         IF( il_ind /= 0 )THEN
+            IF( td_var%t_dim(ji)%l_use  .AND. &
+            &   td_mpp%t_dim(il_ind)%l_use .AND. &
+            &   td_var%t_dim(ji)%i_len /= td_mpp%t_dim(il_ind)%i_len )THEN
+               IF( INDEX( TRIM(td_var%c_axis), &
+               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
+                  ll_warn=.TRUE.
+               ELSE
+                  ll_error=.TRUE.
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      IF( ll_error )THEN
+
+         cl_dim='(/'
+         DO ji = 1, td_mpp%i_ndim
+            IF( td_mpp%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) )
+
+         cl_dim='(/'
+         DO ji = 1, td_var%i_ndim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
+
+         mpp__check_var_dim=.FALSE.
+
+         CALL logger_error( &
+         &  " MPP CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_mpp%c_name))
+
+      ELSEIF( ll_warn )THEN
+         CALL logger_warn( &
+         &  " MPP CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_mpp%c_name)//". you should use"//&
+         &  " var_check_dim to remove useless dimension.")
+      ELSE
+
+         IF( td_var%i_ndim >  td_mpp%i_ndim )THEN
+            CALL logger_info("MPP CHECK VAR DIM: variable "//&
+            &  TRIM(td_var%c_name)//" use more dimension than file "//&
+            &  TRIM(td_mpp%c_name)//" do until now.")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION mpp__check_var_dim
+   !-------------------------------------------------------------------
+   !> @brief This function return the mpp id, in a array of mpp
+   !> structure,  given mpp base name. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_file   array of file structure
+   !> @param[in] cd_name   file name
+   !> @return file id in array of file structure (0 if not found)
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION mpp_get_index(td_mpp, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP)      , DIMENSION(:), INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      INTEGER(i4)       :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      mpp_get_index=0
+      il_size=SIZE(td_mpp(:))
+
+      cl_name=TRIM( file_rename(cd_name) )
+
+      ! check if mpp is in array of mpp structure
+      DO ji=1,il_size
+         ! look for file name
+         IF( TRIM(fct_lower(td_mpp(ji)%c_name)) == TRIM(fct_lower(cd_name)) )THEN
+ 
+            mpp_get_index=ji
+            EXIT
+
+         ENDIF
+      ENDDO
+
+   END FUNCTION mpp_get_index
+   !-------------------------------------------------------------------
+   !> @brief This function recombine variable splitted mpp structure. 
+   !
+   !> @author J.Paul
+   !> @date Ocotber, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp   mpp file structure
+   !> @param[in] cd_name  variable name
+   !> @return variable strucutre
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION mpp_recombine_var(td_mpp, cd_name) 
+   IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP)      , INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4)                       :: il_i1p
+      INTEGER(i4)                       :: il_i2p
+      INTEGER(i4)                       :: il_j1p
+      INTEGER(i4)                       :: il_j2p
+      INTEGER(i4), DIMENSION(4)         :: il_ind
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt
+
+      TYPE(TVAR)                        :: tl_tmp
+      TYPE(TVAR)                        :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
+      IF( il_varid /= 0 )THEN
+      
+         tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
+         ! Allocate space to hold variable value in structure 
+         IF( ASSOCIATED(tl_var%d_value) )THEN
+            DEALLOCATE(tl_var%d_value)   
+         ENDIF
+         ! 
+         DO ji=1,ip_maxdim
+            IF( tl_var%t_dim(ji)%l_use )THEN
+               tl_var%t_dim(ji)%i_len=td_mpp%t_dim(ji)%i_len
+            ENDIF
+         ENDDO
+
+         ALLOCATE(tl_var%d_value( tl_var%t_dim(1)%i_len, &
+         &                        tl_var%t_dim(2)%i_len, &
+         &                        tl_var%t_dim(3)%i_len, &
+         &                        tl_var%t_dim(4)%i_len),&
+         &        stat=il_status)
+         IF(il_status /= 0 )THEN
+
+           CALL logger_error( &
+            &  " MPP RECOMBINE VAR: not enough space to put variable "//&
+            &  TRIM(tl_var%c_name)//" in variable structure")
+
+         ENDIF
+
+         ! FillValue by default
+         tl_var%d_value(:,:,:,:)=tl_var%d_fill
+
+         ! read processor 
+         DO jk=1,td_mpp%i_nproc
+            IF( td_mpp%t_proc(jk)%l_use )THEN
+               ! get processor indices
+               il_ind(:)=mpp_get_proc_index( td_mpp, jk )
+               il_i1p = il_ind(1)
+               il_i2p = il_ind(2)
+               il_j1p = il_ind(3)
+               il_j2p = il_ind(4)
+ 
+               il_strt(:)=(/ 1,1,1,1 /)
+
+               il_cnt(:)=(/ il_i2p-il_i1p+1,         &
+               &            il_j2p-il_j1p+1,         &
+               &            tl_var%t_dim(3)%i_len, &
+               &            tl_var%t_dim(4)%i_len /)
+
+               tl_tmp=iom_read_var( td_mpp%t_proc(jk), tl_var%c_name,&
+               &                    il_strt(:), il_cnt(:) )
+               
+               ! replace value in output variable structure
+               tl_var%d_value( il_i1p : il_i2p,  &
+               &               il_j1p : il_j2p,  &
+               &               :,:) = tl_tmp%d_value(:,:,:,:)
+
+               ! clean
+               CALL var_clean(tl_tmp)
+
+            ENDIF
+         ENDDO
+
+         mpp_recombine_var=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+
+      ELSE
+
+         CALL logger_error( &
+         &  " MPP RECOMBINE VAR: there is no variable with "//&
+         &  "name or standard name"//TRIM(cd_name)//&
+         &  " in mpp file "//TRIM(td_mpp%c_name))
+      ENDIF
+   END FUNCTION mpp_recombine_var
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read subdomain indices defined with halo
+   !> (NEMO netcdf way)
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[inout] td_file   mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__read_halo(td_file, td_dimglo) 
+   IMPLICIT NONE
+      ! Argument      
+      TYPE(TFILE)              , INTENT(INOUT) :: td_file
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN   ) :: td_dimglo
+
+      ! local variable
+      INTEGER(i4)       :: il_attid
+      INTEGER(i4)       :: il_ifirst
+      INTEGER(i4)       :: il_jfirst
+      INTEGER(i4)       :: il_ilast
+      INTEGER(i4)       :: il_jlast
+      INTEGER(i4)       :: il_ihalostart
+      INTEGER(i4)       :: il_jhalostart
+      INTEGER(i4)       :: il_ihaloend
+      INTEGER(i4)       :: il_jhaloend
+
+      CHARACTER(LEN=lc) :: cl_dom
+      !----------------------------------------------------------------
+
+      ! DOMAIN_position_first
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ifirst = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jfirst = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ifirst = 1
+         il_jfirst = 1
+      ENDIF
+
+      ! DOMAIN_position_last
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ilast = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jlast = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ilast = td_file%t_dim(1)%i_len
+         il_jlast = td_file%t_dim(2)%i_len
+      ENDIF
+
+      ! DOMAIN_halo_size_start
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ihalostart = 0
+         il_jhalostart = 0
+      ENDIF
+
+      ! DOMAIN_halo_size_end
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ihaloend = 0
+         il_jhaloend = 0
+      ENDIF
+
+      IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. &
+        & (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN
+         cl_dom='full'
+      ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. &
+           &  il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN
+         cl_dom='nooverlap'
+      ELSE
+         cl_dom='noextra'
+      ENDIF
+
+      SELECT CASE(TRIM(cl_dom))
+         CASE('full')
+            td_file%i_impp = il_ifirst 
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = il_ihalostart + 1
+            td_file%i_ldj  = il_jhalostart + 1
+            td_file%i_lei  = td_file%t_dim(jp_I)%i_len - il_ihaloend
+            td_file%i_lej  = td_file%t_dim(jp_J)%i_len - il_jhaloend
+         CASE('noextra')
+            td_file%i_impp = il_ifirst
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = il_ihalostart + 1
+            td_file%i_ldj  = il_jhalostart + 1
+            td_file%i_lei  = td_file%i_lci - il_ihaloend
+            td_file%i_lej  = td_file%i_lcj - il_jhaloend
+         CASE('nooverlap') !!!?????
+            td_file%i_impp = il_ifirst
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = 1
+            td_file%i_ldj  = 1 
+            td_file%i_lei  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lej  = td_file%t_dim(jp_J)%i_len
+      END SELECT
+
+   END SUBROUTINE mpp__read_halo
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute subdomain indices defined with halo
+   !> (NEMO netcdf way)
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[inout] td_mpp   mpp structure
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__compute_halo(td_mpp) 
+   IMPLICIT NONE
+      ! Argument      
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend
+
+      TYPE(TATT)                             :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ALLOCATE( il_ifirst    (td_mpp%i_nproc) )
+      ALLOCATE( il_jfirst    (td_mpp%i_nproc) )
+
+      ALLOCATE( il_ilast     (td_mpp%i_nproc) )
+      ALLOCATE( il_jlast     (td_mpp%i_nproc) )
+
+      ALLOCATE( il_ihalostart(td_mpp%i_nproc) )
+      ALLOCATE( il_jhalostart(td_mpp%i_nproc) )
+
+      ALLOCATE( il_ihaloend  (td_mpp%i_nproc) )
+      ALLOCATE( il_jhaloend  (td_mpp%i_nproc) )
+
+      SELECT CASE(TRIM(td_mpp%c_dom))
+         CASE('full')
+            
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
+            
+            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1
+            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1
+
+            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
+            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
+            
+            il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei
+            il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej
+
+         CASE('noextra')
+            
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
+
+            il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1
+            il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1
+            
+            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
+            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
+            
+            il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei
+            il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej
+
+         CASE('nooverlap')
+
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1
+
+            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1
+            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1
+
+            il_ihalostart(:)=0
+            il_jhalostart(:)=0
+
+            il_ihaloend(:)=0
+            il_jhaloend(:)=0
+
+         CASE DEFAULT
+            CALL logger_fatal("MPP INIT: invalid "//&
+            &              "decomposition type.")                     
+      END SELECT
+
+      DO ji=1,td_mpp%i_nproc
+         tl_att=att_init( "DOMAIN_position_first", &
+         &                (/ il_ifirst(ji), il_jfirst(ji) /) )
+         CALL file_move_att(td_mpp%t_proc(ji), tl_att)      
+
+         tl_att=att_init( "DOMAIN_position_last", &
+         &                (/ il_ilast(ji), il_jlast(ji) /) )
+         CALL file_move_att(td_mpp%t_proc(ji), tl_att)
+
+         tl_att=att_init( "DOMAIN_halo_size_start", &
+         &                (/ il_ihalostart(ji), il_jhalostart(ji) /) )
+         CALL file_move_att( td_mpp%t_proc(ji), tl_att)               
+
+         tl_att=att_init( "DOMAIN_halo_size_end", &
+         &                (/ il_ihaloend(ji), il_jhaloend(ji) /) )
+         CALL file_move_att( td_mpp%t_proc(ji), tl_att)
+      ENDDO
+
+      DEALLOCATE( il_ifirst    )
+      DEALLOCATE( il_jfirst    )
+ 
+      DEALLOCATE( il_ilast     )
+      DEALLOCATE( il_jlast     )
+ 
+      DEALLOCATE( il_ihalostart)
+      DEALLOCATE( il_jhalostart)
+
+      DEALLOCATE( il_ihaloend  )
+      DEALLOCATE( il_jhaloend  )
+
+      !impp
+      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! lci
+      tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! ldi
+      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! lei
+      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej)
+      CALL mpp_move_att(td_mpp, tl_att)         
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE mpp__compute_halo
+END MODULE mpp
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/multi.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/multi.f90	(revision 8732)
@@ -0,0 +1,513 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: multi
+!
+! DESCRIPTION:
+!> This module manage multi file structure.
+!
+!> @details
+!>    define type TMULTI:<br/>
+!> @code
+!>    TYPE(TMULTI) :: tl_multi
+!> @endcode
+!>
+!>    to initialize a multi-file structure:<br/>
+!> @code
+!>    tl_multi=multi_init(cd_varfile(:))
+!> @endcode
+!>       - cd_varfile : array of variable with file path 
+!>       ('var1:file1','var2:file2')<br/>
+!>          file path could be replaced by a matrix of value.<br/>
+!>          separators used to defined matrix are:
+!>             - ',' for line
+!>             - '/' for row
+!>             - '\' for level<br/>
+!>             Example:<br/>
+!>                - 'var1:3,2,3/1,4,5'
+!>                - 3,2,3/1,4,5  =>  
+!>                      @f$ \left( \begin{array}{ccc}
+!>                           3 & 2 & 3 \\
+!>                           1 & 4 & 5 \end{array} \right) @f$<br/>
+!> 
+!>    to get the number of mpp file in mutli file structure:<br/>
+!>    - tl_multi\%i_nmpp
+!>
+!>    to get the total number of variable in mutli file structure:<br/>
+!>    - tl_multi\%i_nvar
+!>
+!>    @note number of variable and number of file could differ cause several variable
+!>    could be in the same file.
+!>
+!>    to get array of mpp structure in mutli file structure:<br/>
+!>    - tl_multi\%t_mpp(:)
+!>
+!>    to print information about multi structure:<br/>
+!> @code
+!>    CALL multi_print(td_multi)
+!> @endcode
+!>
+!>    to clean multi file strucutre:<br/>
+!> @code
+!>    CALL multi_clean(td_multi)
+!> @endcode
+!>       - td_multi is multi file structure
+!>
+!> @author
+!>  J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date October, 2014
+!> - use mpp file structure instead of file
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE multi
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TMULTI       !< multi file structure
+
+   ! function and subroutine
+   PUBLIC :: multi_copy        !< copy multi structure
+   PUBLIC :: multi_init        !< initialise multi structure
+   PUBLIC :: multi_clean       !< clean multi strcuture
+   PUBLIC :: multi_print       !< print information about milti structure
+
+   PUBLIC :: multi__add_mpp    !< add file strucutre to multi file structure
+   PRIVATE :: multi__copy_unit !< copy multi file structure
+
+   TYPE TMULTI !< multi file structure
+      ! general 
+      INTEGER(i4)                         :: i_nmpp  = 0         !< number of mpp files 
+      INTEGER(i4)                         :: i_nvar  = 0         !< total number of variables
+      TYPE(TMPP) , DIMENSION(:), POINTER  :: t_mpp => NULL()     !< mpp files composing multi
+   END TYPE
+
+   INTERFACE multi_copy
+      MODULE PROCEDURE multi__copy_unit   ! copy multi file structure
+   END INTERFACE   
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function copy multi mpp structure in another one
+   !> @details 
+   !> file variable value are copied in a temporary array, 
+   !> so input and output file structure value do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>   
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !>    - use function instead of overload assignment operator (to avoid memory leak)
+   !>
+   !> @param[in] td_multi    mpp structure
+   !> @return copy of input multi structure
+   !-------------------------------------------------------------------
+   FUNCTION multi__copy_unit( td_multi )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMULTI), INTENT(IN)  :: td_multi
+      ! function
+      TYPE(TMULTI) :: multi__copy_unit
+
+      ! local variable
+      TYPE(TMPP) :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      multi__copy_unit%i_nmpp = td_multi%i_nmpp
+      multi__copy_unit%i_nvar = td_multi%i_nvar
+
+      ! copy variable structure
+      IF( ASSOCIATED(multi__copy_unit%t_mpp) )THEN
+         CALL mpp_clean(multi__copy_unit%t_mpp(:))
+         DEALLOCATE(multi__copy_unit%t_mpp)
+      ENDIF
+      IF( ASSOCIATED(td_multi%t_mpp) .AND. multi__copy_unit%i_nmpp > 0 )THEN
+         ALLOCATE( multi__copy_unit%t_mpp(multi__copy_unit%i_nmpp) )
+         DO ji=1,multi__copy_unit%i_nmpp
+            tl_mpp = mpp_copy(td_multi%t_mpp(ji))
+            multi__copy_unit%t_mpp(ji) = mpp_copy(tl_mpp)
+         ENDDO
+         ! clean
+         CALL mpp_clean(tl_mpp)
+      ENDIF
+
+   END FUNCTION multi__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine initialize multi file structure.
+   !>
+   !> @details
+   !> if variable name is 'all', add all the variable of the file in mutli file
+   !> structure.
+   !> @note if first character of filename is numeric, assume matrix is given as
+   !> input.<br/>
+   !> create pseudo file named 'data-*', with matrix read as variable value.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - check if variable to be read is in file
+   !> @date January, 2016
+   !> - read variable dimensions
+   !>
+   !> @param[in] cd_varfile   variable location information (from namelist) 
+   !> @return multi file structure
+   !-------------------------------------------------------------------
+   FUNCTION multi_init(cd_varfile)
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varfile
+
+      ! function
+      TYPE(TMULTI) :: multi_init
+
+      ! local variable
+      CHARACTER(LEN=lc)                :: cl_name
+      CHARACTER(LEN=lc)                :: cl_lower
+      CHARACTER(LEN=lc)                :: cl_file
+      CHARACTER(LEN=lc)                :: cl_matrix
+
+      INTEGER(i4)                      :: il_nvar
+      INTEGER(i4)                      :: il_varid
+
+      LOGICAL                          :: ll_dim
+
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      TYPE(TVAR)                       :: tl_var
+
+      TYPE(TMPP)                       :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ji=1
+      DO WHILE( TRIM(cd_varfile(ji)) /= '' )
+
+         il_nvar=0
+         cl_name=fct_split(cd_varfile(ji),1,':')
+         cl_lower=fct_lower(cl_name)
+         cl_file=fct_split(cd_varfile(ji),2,':')
+
+         IF( LEN(TRIM(cl_file)) == lc )THEN
+            CALL logger_fatal("MULTI INIT: file name too long (>"//&
+            &          TRIM(fct_str(lc))//"). check namelist.")
+         ENDIF
+
+         IF( TRIM(cl_lower) /= '' )THEN
+            IF( TRIM(cl_file) /= '' )THEN
+               cl_matrix=''
+               IF( fct_is_num(cl_file(1:1)) )THEN
+                  cl_matrix=TRIM(cl_file)
+                  WRITE(cl_file,'(a,i2.2)')'data-',ji
+
+                  tl_var=var_init(TRIM(cl_name))
+                  CALL var_read_matrix(tl_var, cl_matrix)
+
+                  ! create mpp structure
+                  tl_mpp=mpp_init(TRIM(cl_file), tl_var)
+
+                  ! add variable
+                  CALL mpp_add_var(tl_mpp,tl_var)
+
+                  ! number of variable
+                  il_nvar=il_nvar+1
+
+               ELSE
+
+                  ! 
+                  tl_mpp=mpp_init( file_init(TRIM(cl_file)) )
+                  ! define variable
+                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN
+
+                     ! check if variable is in file
+                     il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower)
+                     IF( il_varid == 0 )THEN
+                        CALL logger_fatal("MULTI INIT: variable "//&
+                           & TRIM(cl_name)//" not in file "//&
+                           & TRIM(cl_file) )
+                     ENDIF
+
+                     ! get (global) variable dimension
+                     tl_dim(jp_I)=dim_copy(tl_mpp%t_dim(jp_I))
+                     tl_dim(jp_J)=dim_copy(tl_mpp%t_dim(jp_J))
+                     tl_dim(jp_K)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_K))
+                     tl_dim(jp_L)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_L))
+
+                     ! clean all varible
+                     CALL mpp_del_var(tl_mpp)
+
+                     tl_var=var_init(TRIM(cl_lower), td_dim=tl_dim(:))
+
+                     ! add variable
+                     CALL mpp_add_var(tl_mpp,tl_var)
+
+                     ! number of variable
+                     il_nvar=il_nvar+1
+
+                     ! clean structure
+                     CALL var_clean(tl_var)
+
+                  ELSE ! cl_lower == 'all'
+
+                     DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1
+
+                        ! check if variable is dimension
+                        ll_dim=.FALSE.
+                        DO jj=1,ip_maxdim
+                           IF( TRIM(tl_mpp%t_proc(1)%t_dim(jj)%c_name) == &
+                           &   TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) )THEN
+                              ll_dim=.TRUE.
+                              CALL logger_trace("MULTI INIT: "//&
+                              &  TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name)//&
+                              &  ' is var dimension')
+                              EXIT
+                           ENDIF
+                        ENDDO
+                        ! do not use variable dimension
+                        IF( ll_dim )THEN
+                           tl_var=var_init( &
+                           &  TRIM(tl_mpp%t_proc(1)%t_var(jk)%c_name) )
+                           ! delete variable
+                           CALL mpp_del_var(tl_mpp,tl_var)
+                           ! clean structure
+                           CALL var_clean(tl_var)
+                        ELSE
+                           ! number of variable
+                           il_nvar=il_nvar+1
+                        ENDIF
+
+                     ENDDO
+
+                  ENDIF
+
+               ENDIF
+
+               CALL multi__add_mpp(multi_init, tl_mpp) 
+
+               ! update total number of variable
+               multi_init%i_nvar=multi_init%i_nvar+il_nvar
+
+               ! clean
+               CALL mpp_clean(tl_mpp)
+
+            ELSE
+               CALL logger_error("MULTI INIT: file name matching variable "//&
+               &                 TRIM(cl_name)//" is empty. check namelist.")
+            ENDIF
+         ELSE
+            CALL logger_error("MULTI INIT: variable name "//&
+            &                 "is empty. check namelist.")
+         ENDIF
+
+         ji=ji+1
+      ENDDO
+
+   END FUNCTION multi_init
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean multi file strucutre.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_multi  multi file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE multi_clean(td_multi)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMULTI), INTENT(INOUT) :: td_multi
+
+      ! local variable
+      TYPE(TMULTI) :: tl_multi ! empty multi file structure
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info( " CLEAN: reset multi file " )
+
+      IF( ASSOCIATED( td_multi%t_mpp ) )THEN
+         CALL mpp_clean(td_multi%t_mpp(:))
+         DEALLOCATE(td_multi%t_mpp)
+      ENDIF
+
+      ! replace by empty structure
+      td_multi=multi_copy(tl_multi)
+
+   END SUBROUTINE multi_clean
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about mpp strucutre.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_multi multi file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE multi_print(td_multi)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMULTI), INTENT(IN) :: td_multi
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! print file
+      IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN
+         WRITE(*,'(/a,i3)') 'MULTI: total number of file(s): ',&
+         &  td_multi%i_nmpp
+         WRITE(*,'(6x,a,i3)') ' total number of variable(s): ',&
+         &  td_multi%i_nvar
+         DO ji=1,td_multi%i_nmpp
+            WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_mpp(ji)%c_name),&
+            & ' CONTAINS'
+            DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar
+               IF( ASSOCIATED(td_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+                  WRITE(*,'(6x,a)') &
+                  &  TRIM(td_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE multi_print
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add file to multi file structure.
+   !>
+   !> @detail
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use mpp file structure instead of file
+   !
+   !> @param[inout] td_multi  multi mpp file strcuture
+   !> @param[in]    td_mpp    mpp file strcuture
+   !> @return mpp file id in multi mpp file structure
+   !-------------------------------------------------------------------
+   SUBROUTINE multi__add_mpp( td_multi, td_mpp )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMULTI), INTENT(INOUT) :: td_multi
+      TYPE(TMPP)  , INTENT(IN)    :: td_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_mppid
+      
+      TYPE(TMPP), DIMENSION(:), ALLOCATABLE :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_mppid=0
+      IF( ASSOCIATED(td_multi%t_mpp) )THEN
+         il_mppid=mpp_get_index(td_multi%t_mpp(:),TRIM(td_mpp%c_name))
+      ENDIF
+
+      IF( il_mppid /= 0 )THEN
+
+            CALL logger_debug( " MULTI ADD FILE: mpp file "//TRIM(td_mpp%c_name)//&
+            &               " already in multi mpp file structure")
+
+            ! add new variable
+            DO ji=1,td_mpp%t_proc(1)%i_nvar
+               CALL mpp_add_var(td_multi%t_mpp(il_mppid), td_mpp%t_proc(1)%t_var(ji))
+            ENDDO
+
+      ELSE
+ 
+         CALL logger_trace("MULTI ADD MPP: add mpp "//&
+         &               TRIM(td_mpp%c_name)//" in multi mpp file structure")
+
+         IF( td_multi%i_nmpp > 0 )THEN
+            ! 
+            ! already other mpp file in multi file structure
+            ALLOCATE( tl_mpp(td_multi%i_nmpp), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( " MULTI ADD MPP FILE: not enough space to put &
+               &               mpp file in multi mpp file structure")
+
+            ELSE
+               ! save temporary multi file structure
+               tl_mpp(:)=mpp_copy(td_multi%t_mpp(:))
+
+               CALL mpp_clean(td_multi%t_mpp(:))
+               DEALLOCATE( td_multi%t_mpp )
+               ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( " MULTI ADD MPP FILE: not enough space "//&
+                  &  "to put mpp file in multi mpp file structure ")
+
+               ENDIF
+
+               ! copy mpp file in multi mpp file before
+               td_multi%t_mpp(1:td_multi%i_nmpp) = mpp_copy(tl_mpp(:))
+
+               ! clean
+               CALL mpp_clean(tl_mpp(:))
+               DEALLOCATE(tl_mpp)
+            ENDIF
+
+         ELSE
+            ! no file in multi file structure
+            IF( ASSOCIATED(td_multi%t_mpp) )THEN
+               CALL mpp_clean(td_multi%t_mpp(:))
+               DEALLOCATE(td_multi%t_mpp)
+            ENDIF
+            ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( " MULTI ADD MPP FILE: not enough space "//&
+               &  "to put mpp file in multi mpp file structure " )
+
+            ENDIF
+         ENDIF
+
+         ! update number of mpp
+         td_multi%i_nmpp=td_multi%i_nmpp+1
+
+         ! add new mpp
+         td_multi%t_mpp(td_multi%i_nmpp)=mpp_copy(td_mpp)
+
+      ENDIF
+   END SUBROUTINE multi__add_mpp
+END MODULE multi
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/phycst.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/phycst.f90	(revision 8732)
@@ -0,0 +1,54 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: phycst
+!
+! DESCRIPTION:
+!> @brief This module defines physical constant.
+!
+!> @author
+!> J.paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - add physical constant to compute meshmask
+!
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE phycst
+   USE kind                         ! F90 kind parameter
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   PUBLIC :: dp_pi      !< pi
+   PUBLIC :: dp_eps     !< epsilon value
+   PUBLIC :: dp_rearth  !< earth radius [m]
+   PUBLIC :: dp_deg2rad !< degree to radian ratio 
+   PUBLIC :: dp_rad2deg !< radian to degree ratio 
+   PUBLIC :: dp_delta   !<  
+   PUBLIC :: dp_omega   !< earth rotation parameter [s-1] 
+   PUBLIC :: dp_day     !< day                                [s]
+   PUBLIC :: dp_siyea   !< sideral year                       [s]
+   PUBLIC :: dp_siday   !< sideral day                        [s]
+
+   REAL(dp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
+   REAL(dp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
+   REAL(dp), PUBLIC ::   rsiday                 !: sideral day                        [s]
+
+   REAL(dp), PARAMETER :: dp_pi = 3.14159274101257_dp
+   REAL(dp), PARAMETER :: dp_eps = 0.5 * EPSILON(1._dp)
+   REAL(dp), PARAMETER :: dp_rearth = 6371229._dp
+   REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0
+   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi
+
+   REAL(dp), PARAMETER :: dp_day = 24.*60.*60.     
+   REAL(dp), PARAMETER :: dp_siyea = 365.25_dp * dp_day * &
+      &  2._dp * dp_pi / 6.283076_dp
+   REAL(dp), PARAMETER :: dp_siday = dp_day / ( 1._dp + dp_day / dp_siyea )
+
+   REAL(dp), PARAMETER :: dp_delta=1.e-5
+   REAL(dp), PARAMETER :: dp_omega= 2._dp * dp_pi / dp_siday
+END MODULE phycst
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/variable.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/variable.f90	(revision 8732)
@@ -0,0 +1,8603 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: var
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage variable structure.
+!>
+!> @details
+!>    define type TVAR:<br/>
+!> @code
+!>    TYPE(TVAR) :: tl_var
+!> @endcode
+!>
+!>    @note the variable value inside structure will always be 4D array of real(8).<br/>
+!>    However the variable value could be initialised with
+!>    array of real(4), real(8), integer(4) or integer(8).
+!>        
+!>    to initialise a variable structure:<br/>
+!> @code
+!>    tl_var=var_init( cd_name, [value,] [id_start, [id_count,]] [id_type,] [td_dim,] [td_att]... )
+!> @endcode
+!>       - cd_name is the variable name
+!>       - value is a 1D,2D,3D or 4D array, see var_init for more information [optional]
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_type is the type of the variable to be used [optional]
+!>       - td_dim is the array of dimension structure [optional]
+!>       - td_att is the array of attribute structure [optional]
+!>    Note:<br/>
+!>       - others optionals arguments could be added, see var_init.
+!>       - to put scalar variable (OD), use td_dim with all dimension unused
+!> (td_dim(:)%l_use=.FALSE.)
+!>    
+!>    to print information about variable structure:<br/>
+!> @code
+!>    CALL var_print(td_var [,ld_more])
+!> @endcode
+!>       - td_var is the variable structure
+!>       - ld_more to print more infomration about variable
+!>
+!>    to clean variable structure:<br/>
+!> @code
+!>    CALL var_clean(tl_var)
+!> @endcode
+!>
+!>    to copy variable structure in another one (using different memory cell):<br/>
+!> @code
+!>    tl_var2=var_copy(tl_var1) 
+!> @endcode
+!>    @note as we use pointer for the value array of the variable structure,
+!>    the use of the assignment operator (=) to copy variable structure 
+!>    create a pointer on the same array. 
+!>    This is not the case with this copy function.
+!>
+!>    to get variable name:<br/>
+!>    - tl_var\%c_name
+!>
+!>    to get grid point of the variable:<br/>
+!>    - tl_var\%c_point
+!>
+!>    to get EW overlap:<br/>
+!>    - tl_var\%i_ew
+!>
+!>    to get variable value:<br/>
+!>    - tl_var\%d_value(:,:,:,:)
+!>    
+!>    to get the type number (based on NETCDF type constants) of the variable 
+!>    (as define initially or read in file):<br/>
+!>    - tl_var\%i_type
+!>
+!>    to get variable id (read from a file):<br/>
+!>    - tl_var\%i_id
+!>
+!>    Variable dimension<br/>
+!>    to get the number of dimension used in the variable:<br/>
+!>    - tl_var\%i_ndim
+!>
+!>    to get the array of dimension structure (4 elts) associated to the
+!>    variable:<br/>
+!>    - tl_var\%t_dim(:)
+!>
+!>    Variable attributes<br/>
+!>    @note attribue value are always character or real(8) 1D array.<br/>
+!>
+!>    to get the number of attributes of the variable:<br/>
+!>    - tl_var\%i_natt
+!>
+!>    to get the array of attribute structure associated to the
+!>    variable:<br/>
+!>    - tl_var\%t_att(:)
+!>
+!>    Some attribute are highlight, to be easily used.
+!>    to get variable standard name:<br/>
+!>    - tl_var\%c_stdname
+!>
+!>    to get variable longname:<br/>
+!>    - tl_var\%c_longname
+!>
+!>    to get variable units:<br/>
+!>    - tl_var\%c_units
+!>
+!>    to get variable axis:<br/>
+!>    - tl_var\%c_axis
+!>
+!>    to get variable scale factor:<br/>
+!>    - tl_var\%d_scf
+!>
+!>    to get variable add offset:<br/>
+!>    - tl_var\%d_ofs
+!>
+!>    to get variable FillValue:<br/>
+!>    - tl_var\%d_fill
+!>
+!>    to add value to a variable structure:<br/>
+!> @code
+!>    CALL var_add_value(tl_var, value, [id_type,] [id_start, [id_count]]) 
+!> @endcode
+!>       - value : 4D array of value (real(4), real(8), integer(1), integer(2), integer(4), integer(8))
+!>       - id_type is the type of the variable to be used (default is the type
+!> of array value)
+!>       - id_start : 1D array of the index in the variable from which the data
+!>       values will be read (integer(4), optional)
+!>       - id_count : 1D array of the number of indices selected along each 
+!>       dimension (integer(4), optional)
+!>
+!>    to add attribute to a variable structure:<br/>
+!> @code
+!>    CALL var_add_att(tl_var, td_att)
+!> @endcode
+!>       - td_att is an attribute structure, or array of attribute structure 
+!>
+!>    to add dimension to a variable structure:<br/>
+!> @code
+!>    CALL var_add_dim(tl_var, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure, or array of dimension structure
+!> 
+!>    to delete value of a variable structure:<br/>
+!> @code
+!>    CALL var_del_value(tl_var)
+!> @endcode
+!>
+!>    to delete one attribute of a variable structure:<br/>
+!> @code
+!>    CALL var_del_att(tl_var, td_att)
+!> @endcode
+!>       - td_att is an attribute structure 
+!> or
+!> @code
+!>    CALL var_del_att(tl_var, cd_name)
+!> @endcode
+!>       - cd_name is attribute name 
+!>
+!>    to delete one dimension of a variable structure:<br/>
+!> @code
+!>    CALL var_del_dim(tl_var, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to overwrite one attribute structure in variable structure:<br/>
+!> @code
+!>    CALL var_move_att(tl_var, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to overwrite one dimension structure in variable structure:<br/>
+!> @code
+!>    CALL var_move_dim(tl_var, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to get the mask of a variable strucutre, (based on its FillValue):<br/>
+!> @code
+!>    mask(:,:)=var_get_mask(tl_var)
+!> @endcode
+!>
+!>    to change FillValue to standard NETCDF Fill Value:<br/>
+!> @code
+!>    CALL  var_chg_FillValue(tl_var, [dd_fill])
+!> @endcode
+!>       - dd_fill is the FillValue to be used [optional]
+!>
+!>    to concatenate two variables:<br/>
+!> @code
+!>    tl_var=var_concat(tl_var1, tl_var2, [DIM])
+!> @endcode
+!>       - tl_var1 : variable structure 
+!>       - tl_var2 : variable structure 
+!>       - DIM : number of the dimension following which concatenate (1=>I, 2=>J, 3=>Z, 4=>T) [optional, default=4]
+!>
+!>    to forced min and max value of a variable:<br/>
+!>    define min and max value of the variable:<br/>
+!>    tl_var\%d_min=min<br/>
+!>    tl_var\%d_max=max<br/>
+!>    then<br/>
+!> @code
+!>    CALL  var_limit_value( tl_var )
+!> @endcode
+!>       - min and max : real(8) value
+!>
+!>    to get the biggest dimensions use in a array of variable:<br/>
+!> @code
+!>    tl_dim(:)=var_max_dim(tl_var(:))
+!> @endcode
+!>       - tl_var(:) : array of variable structure
+!>       - tl_dim(:) : array (4 elts) of dimension structure
+!>
+!>    to reorder dimension of a variable (default 'x','y','z','t'):<br/>
+!> @code
+!>    CALL var_reorder( td_var, cd_dimorder )
+!> @endcode
+!>       - td_var is variable structure
+!>       - cd_dimorder string character(LEN=4) of dimension order to be used (example:
+!> 'yxzt') [optional]
+!>
+!>    to get variable index, in an array of variable structure:<br/>
+!> @code
+!>   il_index=var_get_index( td_var, cd_name )
+!> @endcode
+!>    - td_var array of variable structure
+!>    - cd_name variable name
+!> 
+!>    to get variable id, read from a file:<br/>
+!>@code
+!>  il_id=var_get_id( td_var, cd_name )
+!>@endcode
+!>    - td_var array of variable structure
+!>    - cd_name variable name
+!>
+!>    to get free variable unit in an array of variable structure:<br/>
+!>@code
+!>  il_unit=var_get_unit(td_var)
+!>@endcode
+!>    - td_var array of variable structure
+!>
+!>    to convert time variable structure in date structure:<br/>
+!>@code
+!>   tl_date=var_to_date(td_var) 
+!>@endcode
+!>    - td_var is time variable structure
+!>    - tl_date is date structure
+!>
+!>    to read matrix value from character string in namelist
+!>@code
+!>    CALL var_read_matrix(td_var, cd_matrix)
+!>@endcode
+!>    - td_var is variable structure
+!>    - cd_matrix is matrix value
+!>
+!>    to read variable configuration file ('variable.cfg') and fill global array
+!> of variable structure:<br/>
+!>@code
+!>    CALL var_def_extra( cd_file )
+!>@endcode
+!>    - cd_file is filename
+!>
+!>    to add variable information get from namelist, in global array of variable 
+!> structure:
+!>@code
+!>    CALL var_chg_extra( cd_varinfo )
+!>@endcode
+!>    - cd_varinfo is variable information from namelist
+!>
+!>    to clean global array of variable structure:<br/>
+!>@code
+!>    CALL var_clean_extra( )
+!>@endcode
+!>
+!>    to check variable dimension expected, as defined in file 'variable.cfg':<br/>
+!>@code
+!>    CALL var_check_dim( td_var )
+!>@endcode
+!>    - td_var is variable structure
+!> 
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!>  - add var_reorder
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date June, 2015
+!> - change way to get variable information in namelist
+!> @date July, 2015 
+!> - add subroutine var_chg_unit to change unit of output variable
+!> @date Spetember, 2015
+!> - manage useless (dummy) variable
+!> @date October, 2016
+!> - add subroutine to clean global array of extra information.
+!> - define logical for variable to be used
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE var
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE date                            ! date manager
+   USE fct                             ! basic useful function
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE math                            ! mathematical function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TVAR        !< variable structure
+
+   PUBLIC :: tg_varextra !< array of variable structure with extra information.
+
+   PRIVATE :: cm_dumvar  !< dummy variable array
+
+   ! function and subroutine
+   PUBLIC :: var_init          !< initialize variable structure
+   PUBLIC :: var_print         !< print variable information
+   PUBLIC :: var_clean         !< clean variable structure
+   PUBLIC :: var_copy          !< copy variable structure
+   PUBLIC :: var_add_value     !< add array of value in variable structure
+   PUBLIC :: var_add_att       !< add attribute structure in variable structure
+   PUBLIC :: var_add_dim       !< add dimension structure in variable structure
+   PUBLIC :: var_del_value     !< delete array of value of variable structure
+   PUBLIC :: var_del_att       !< delete one attribute structure of variable structure
+   PUBLIC :: var_del_dim       !< delete one dimension structure of variable structure
+   PUBLIC :: var_move_att      !< overwrite one attribute structure in variable structure
+   PUBLIC :: var_move_dim      !< overwrite one dimension structure in variable structure 
+   PUBLIC :: var_get_mask      !< return the mask of variable
+   PUBLIC :: var_chg_FillValue !< change FillValue to standard NETCDF Fill Value
+   PUBLIC :: var_concat        !< concatenate two variables
+   PUBLIC :: var_limit_value   !< forced min and max value
+   PUBLIC :: var_chg_unit      !< change variable unit and value
+   PUBLIC :: var_max_dim       !< get array of maximum dimension use
+   PUBLIC :: var_reorder       !< reorder table of value in variable structure
+   PUBLIC :: var_get_index     !< return the variable index, in an array of variable structure 
+   PUBLIC :: var_get_id        !< return the variable id, read from a file 
+   PUBLIC :: var_get_unit      !< get free variable unit in an array of variable structure
+   PUBLIC :: var_to_date       !< convert time variable structure in date structure
+   PUBLIC :: var_read_matrix   !< read matrix value from character string in namelist 
+   PUBLIC :: var_def_extra     !< read variable configuration file, and save extra information.
+   PUBLIC :: var_chg_extra     !< read variable namelist information, and modify extra information.
+   PUBLIC :: var_clean_extra   !< clean gloabl array of extra information.
+   PUBLIC :: var_check_dim     !< check variable dimension expected
+   PUBLIC :: var_get_dummy     !< fill dummy variable array
+   PUBLIC :: var_is_dummy      !< check if variable is defined as dummy variable
+
+   PRIVATE :: var__init          ! initialize variable structure without array of value
+   PRIVATE :: var__init_dp       ! initialize variable structure with real(8) 4D array of value
+   PRIVATE :: var__init_1D_dp    ! initialize variable structure with real(8) 1D array of value
+   PRIVATE :: var__init_2D_dp    ! initialize variable structure with real(8) 2D array of value
+   PRIVATE :: var__init_3D_dp    ! initialize variable structure with real(8) 3D array of value
+   PRIVATE :: var__init_sp       ! initialize variable structure with real(4) 4D array of value
+   PRIVATE :: var__init_1D_sp    ! initialize variable structure with real(4) 1D array of value
+   PRIVATE :: var__init_2D_sp    ! initialize variable structure with real(4) 2D array of value
+   PRIVATE :: var__init_3D_sp    ! initialize variable structure with real(4) 3D array of value
+   PRIVATE :: var__init_i1       ! initialize variable structure with integer(1) 4D array of value
+   PRIVATE :: var__init_1D_i1    ! initialize variable structure with integer(1) 1D array of value
+   PRIVATE :: var__init_2D_i1    ! initialize variable structure with integer(1) 2D array of value
+   PRIVATE :: var__init_3D_i1    ! initialize variable structure with integer(1) 3D array of value
+   PRIVATE :: var__init_i2       ! initialize variable structure with integer(2) 4D array of value
+   PRIVATE :: var__init_1D_i2    ! initialize variable structure with integer(2) 1D array of value
+   PRIVATE :: var__init_2D_i2    ! initialize variable structure with integer(2) 2D array of value
+   PRIVATE :: var__init_3D_i2    ! initialize variable structure with integer(2) 3D array of value
+   PRIVATE :: var__init_i4       ! initialize variable structure with integer(4) 4D array of value
+   PRIVATE :: var__init_1D_i4    ! initialize variable structure with integer(4) 1D array of value
+   PRIVATE :: var__init_2D_i4    ! initialize variable structure with integer(4) 2D array of value
+   PRIVATE :: var__init_3D_i4    ! initialize variable structure with integer(4) 3D array of value
+   PRIVATE :: var__init_i8       ! initialize variable structure with integer(8) 4D array of value
+   PRIVATE :: var__init_1D_i8    ! initialize variable structure with integer(8) 1D array of value
+   PRIVATE :: var__init_2D_i8    ! initialize variable structure with integer(8) 2D array of value
+   PRIVATE :: var__init_3D_i8    ! initialize variable structure with integer(8) 3D array of value
+   PRIVATE :: var__print_unit ! print information on one variable
+   PRIVATE :: var__print_arr  ! print information on a array of variables
+   PRIVATE :: var__clean_unit    ! clean variable structure
+   PRIVATE :: var__clean_arr_1D  ! clean 1D array of variable structure
+   PRIVATE :: var__clean_arr_2D  ! clean 2D array of variable structure
+   PRIVATE :: var__clean_arr_3D  ! clean 3D array of variable structure
+   PRIVATE :: var__add_value_dp  ! add array of value real(8) in variable structure
+   PRIVATE :: var__add_value_rp  ! add array of value real(4) in variable structure
+   PRIVATE :: var__add_value_i1  ! add array of value integer(1) in variable structure
+   PRIVATE :: var__add_value_i2  ! add array of value integer(2) in variable structure
+   PRIVATE :: var__add_value_i4  ! add array of value integer(4) in variable structure
+   PRIVATE :: var__add_value_i8  ! add array of value integer(8) in variable structure
+   PRIVATE :: var__add_att_unit  ! add one attribute structure in variable structure
+   PRIVATE :: var__add_att_arr   ! add a array of attribute structure in variable structure
+   PRIVATE :: var__del_att_name  ! delete one attribute given attribute name
+   PRIVATE :: var__del_att_str   ! delete one attribute given attribute structure
+   PRIVATE :: var__add_dim_unit  ! add one dimension structure in variable structure
+   PRIVATE :: var__add_dim_arr   ! add a array of dimension structure in variable structure
+   PRIVATE :: var__add_value     ! add a 4D array of real(8) value in a variable structure.
+   PRIVATE :: var__copy_unit     ! copy variable structure
+   PRIVATE :: var__copy_arr      ! copy a array of variable structure
+   PRIVATE :: var__get_extra     ! add extra information in variable structure
+   PRIVATE :: var__concat_i      ! concatenate varibales in i-direction
+   PRIVATE :: var__concat_j      ! concatenate varibales in j-direction
+   PRIVATE :: var__concat_k      ! concatenate varibales in k-direction
+   PRIVATE :: var__concat_l      ! concatenate varibales in l-direction
+   PRIVATE :: var__get_max       ! get maximum value from namelist 
+   PRIVATE :: var__get_min       ! get minimum value from namelist
+   PRIVATE :: var__get_unf       ! get scale factor value from namelist
+   PRIVATE :: var__get_unt       ! get unit from namelist
+   PRIVATE :: var__get_interp    ! get interpolation method from namelist
+   PRIVATE :: var__get_extrap    ! get extrapolation method from namelist
+   PRIVATE :: var__get_filter    ! get filter method from namelist
+
+   TYPE TVAR   !< variable structure
+
+      CHARACTER(LEN=lc) :: c_name  = ''  !< variable name
+      CHARACTER(LEN=lc) :: c_point = 'T' !< ARAKAWA C-grid point name (T,U,V,F)
+      INTEGER(i4)       :: i_id = 0      !< variable id
+      INTEGER(i4)       :: i_ew = -1     !< east-west overlap
+
+      REAL(dp)   , DIMENSION(:,:,:,:), POINTER :: d_value => NULL() !< variable value
+
+      !!! netcdf
+      INTEGER(i4)       :: i_type = 0           !< variable type
+      INTEGER(i4)       :: i_natt = 0           !< number of attributes
+      INTEGER(i4)       :: i_ndim = 0           !< number of dimensions
+      TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension
+ 
+      LOGICAL           :: l_file = .FALSE. !< variable read in a file
+      LOGICAL           :: l_use  = .TRUE.  !< variable to be used
+
+      ! highlight some attributes
+      CHARACTER(LEN=lc) :: c_stdname  = ''!< variable standard name
+      CHARACTER(LEN=lc) :: c_longname = ''!< variable long name
+      CHARACTER(LEN=lc) :: c_units    = ''!< variable units
+      CHARACTER(LEN=lc) :: c_axis     = ''!< variable axis
+      REAL(dp)          :: d_scf = 1.           !< scale factor
+      REAL(dp)          :: d_ofs = 0.           !< offset
+      REAL(dp)          :: d_fill= 0.           !< fill value     ! NF90_FILL_DOUBLE 
+      REAL(dp)          :: d_min = dp_fill      !< minimum value 
+      REAL(dp)          :: d_max = dp_fill      !< maximum value 
+ 
+      CHARACTER(LEN=lc) :: c_unt = ''           !< new variables units (linked to units factor)
+      REAL(dp)          :: d_unf = 1._dp        !< units factor
+
+      !!! netcdf4
+      LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not
+      LOGICAL           :: l_shuffle    = .FALSE. !< shuffle filter is turned on or not
+      LOGICAL           :: l_fletcher32 = .FALSE. !< fletcher32 filter is turned on or not
+      INTEGER(i4)       :: i_deflvl = 0           !< deflate level from 0 to 9, 0 indicates no deflation is in use
+      INTEGER(i4), DIMENSION(ip_maxdim) :: i_chunksz = (/1,1,1,1/) !< chunk size
+
+      !!! dimg
+      INTEGER(i4) :: i_rec  = 0 !< record number
+
+      CHARACTER(LEN=lc), DIMENSION(2) :: c_interp = '' !< interpolation method
+      CHARACTER(LEN=lc), DIMENSION(1) :: c_extrap = '' !< extrapolation method
+      CHARACTER(LEN=lc), DIMENSION(5) :: c_filter = '' !< filter method
+
+   END TYPE TVAR
+
+   TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information.
+                                                        !< fill when running var_def_extra() 
+
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumvar !< dummy variable
+
+   INTERFACE var_init
+      MODULE PROCEDURE var__init       ! initialize variable structure without array of value
+      MODULE PROCEDURE var__init_dp    ! initialize variable structure with real(8) 4D array of value
+      MODULE PROCEDURE var__init_1D_dp ! initialize variable structure with real(8) 1D array of value
+      MODULE PROCEDURE var__init_2D_dp ! initialize variable structure with real(8) 2D array of value
+      MODULE PROCEDURE var__init_3D_dp ! initialize variable structure with real(8) 3D array of value
+      MODULE PROCEDURE var__init_sp    ! initialize variable structure with real(4) 4D array of value
+      MODULE PROCEDURE var__init_1D_sp ! initialize variable structure with real(4) 1D array of value
+      MODULE PROCEDURE var__init_2D_sp ! initialize variable structure with real(4) 2D array of value
+      MODULE PROCEDURE var__init_3D_sp ! initialize variable structure with real(4) 3D array of value
+      MODULE PROCEDURE var__init_i1    ! initialize variable structure with integer(1) 4D array of value
+      MODULE PROCEDURE var__init_1D_i1 ! initialize variable structure with integer(1) 1D array of value
+      MODULE PROCEDURE var__init_2D_i1 ! initialize variable structure with integer(1) 2D array of value
+      MODULE PROCEDURE var__init_3D_i1 ! initialize variable structure with integer(1) 3D array of value
+      MODULE PROCEDURE var__init_i2    ! initialize variable structure with integer(2) 4D array of value
+      MODULE PROCEDURE var__init_1D_i2 ! initialize variable structure with integer(2) 1D array of value
+      MODULE PROCEDURE var__init_2D_i2 ! initialize variable structure with integer(2) 2D array of value
+      MODULE PROCEDURE var__init_3D_i2 ! initialize variable structure with integer(2) 3D array of value
+      MODULE PROCEDURE var__init_i4    ! initialize variable structure with integer(4) 4D array of value
+      MODULE PROCEDURE var__init_1D_i4 ! initialize variable structure with integer(4) 1D array of value
+      MODULE PROCEDURE var__init_2D_i4 ! initialize variable structure with integer(4) 2D array of value
+      MODULE PROCEDURE var__init_3D_i4 ! initialize variable structure with integer(4) 3D array of value
+      MODULE PROCEDURE var__init_i8    ! initialize variable structure with integer(8) 4D array of value
+      MODULE PROCEDURE var__init_1D_i8 ! initialize variable structure with integer(8) 1D array of value
+      MODULE PROCEDURE var__init_2D_i8 ! initialize variable structure with integer(8) 2D array of value
+      MODULE PROCEDURE var__init_3D_i8 ! initialize variable structure with integer(8) 3D array of value
+   END INTERFACE var_init
+
+   INTERFACE var_print
+      MODULE PROCEDURE var__print_unit ! print information on one variable
+      MODULE PROCEDURE var__print_arr  ! print information on a array of variables
+   END INTERFACE var_print
+   
+   INTERFACE var_clean
+      MODULE PROCEDURE var__clean_unit   
+      MODULE PROCEDURE var__clean_arr_1D    
+      MODULE PROCEDURE var__clean_arr_2D    
+      MODULE PROCEDURE var__clean_arr_3D    
+   END INTERFACE
+
+   INTERFACE var_add_value
+      MODULE PROCEDURE var__add_value_dp  ! add array of value real(8) in variable structure
+      MODULE PROCEDURE var__add_value_rp  ! add array of value real(4) in variable structure
+      MODULE PROCEDURE var__add_value_i1  ! add array of value integer(1) in variable structure
+      MODULE PROCEDURE var__add_value_i2  ! add array of value integer(2) in variable structure
+      MODULE PROCEDURE var__add_value_i4  ! add array of value integer(4) in variable structure
+      MODULE PROCEDURE var__add_value_i8  ! add array of value integer(8) in variable structure
+   END INTERFACE var_add_value
+
+   INTERFACE var_add_att
+      MODULE PROCEDURE var__add_att_unit ! add one attribute structure in variable structure
+      MODULE PROCEDURE var__add_att_arr  ! add a array of attribute structure in variable structure
+   END INTERFACE var_add_att
+
+   INTERFACE var_del_att               ! delete one attribute in variable structure
+      MODULE PROCEDURE var__del_att_name ! - given attribute name
+      MODULE PROCEDURE var__del_att_str  ! - given attribute structure
+   END INTERFACE var_del_att
+
+   INTERFACE var_add_dim
+      MODULE PROCEDURE var__add_dim_unit ! add one dimension structure in variable structure
+      MODULE PROCEDURE var__add_dim_arr  ! add a array of dimension structure in variable structure
+   END INTERFACE var_add_dim
+
+   INTERFACE var_copy
+      MODULE PROCEDURE var__copy_unit   ! copy variable structure
+      MODULE PROCEDURE var__copy_arr    ! copy variable structure
+   END INTERFACE
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy variable structure in another one
+   !> @details 
+   !> variable value are copied in a temporary array, so input and output
+   !> variable structure value do not point on the same "memory cell", and so
+   !> are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_var=var_copy(var_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator (to avoid memory leak)
+   !
+   !> @param[in] td_var   variable structure
+   !> @return copy of input variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var__copy_unit( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+      ! function
+      TYPE(TVAR) :: var__copy_unit
+
+      ! local variable
+      TYPE(TATT)                                :: tl_att
+      REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! copy variable name, id, ..
+      var__copy_unit%c_name     = TRIM(td_var%c_name)
+      var__copy_unit%c_point    = TRIM(td_var%c_point)
+      var__copy_unit%i_id       = td_var%i_id
+      var__copy_unit%i_ew       = td_var%i_ew
+
+      var__copy_unit%d_min      = td_var%d_min
+      var__copy_unit%d_max      = td_var%d_max
+
+      var__copy_unit%c_unt      = TRIM(td_var%c_unt)
+      var__copy_unit%d_unf      = td_var%d_unf
+
+      var__copy_unit%i_type     = td_var%i_type
+      var__copy_unit%i_natt     = td_var%i_natt
+      var__copy_unit%i_ndim     = td_var%i_ndim
+      var__copy_unit%i_ndim     = td_var%i_ndim
+
+      ! copy dimension
+      var__copy_unit%t_dim(:)   = dim_copy(td_var%t_dim(:))
+
+      ! copy attribute
+      IF( ASSOCIATED(var__copy_unit%t_att) )THEN
+         CALL att_clean( var__copy_unit%t_att(:) )
+         DEALLOCATE(var__copy_unit%t_att)
+      ENDIF
+      IF( ASSOCIATED(td_var%t_att) .AND. var__copy_unit%i_natt > 0 )THEN
+         ALLOCATE( var__copy_unit%t_att(var__copy_unit%i_natt) )
+         DO ji=1,var__copy_unit%i_natt
+            tl_att=att_copy(td_var%t_att(ji))
+            var__copy_unit%t_att(ji)=att_copy(tl_att)
+         ENDDO
+         ! clean
+         CALL att_clean(tl_att)
+      ENDIF
+
+      var__copy_unit%l_file     = td_var%l_file
+      var__copy_unit%l_use      = td_var%l_use
+
+      ! copy highlight attribute
+      var__copy_unit%c_stdname  = TRIM(td_var%c_stdname)
+      var__copy_unit%c_longname = TRIM(td_var%c_longname)
+      var__copy_unit%c_units    = TRIM(td_var%c_units)
+      var__copy_unit%c_axis     = TRIM(td_var%c_axis)
+      var__copy_unit%d_unf      = td_var%d_unf
+      var__copy_unit%d_scf      = td_var%d_scf
+      var__copy_unit%d_ofs      = td_var%d_ofs
+      var__copy_unit%d_fill     = td_var%d_fill
+      
+      ! copy netcdf4 variable
+      var__copy_unit%l_contiguous  = td_var%l_contiguous
+      var__copy_unit%l_shuffle     = td_var%l_shuffle
+      var__copy_unit%l_fletcher32  = td_var%l_fletcher32 
+      var__copy_unit%i_deflvl      = td_var%i_deflvl
+      var__copy_unit%i_chunksz(:)  = td_var%i_chunksz(:)
+      
+      ! copy dimg variable
+      var__copy_unit%i_rec = td_var%i_rec
+
+      ! copy pointer in an independant variable
+      IF( ASSOCIATED(var__copy_unit%d_value) ) DEALLOCATE(var__copy_unit%d_value)
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ALLOCATE( dl_value( td_var%t_dim(1)%i_len, &
+         &                   td_var%t_dim(2)%i_len, &
+         &                   td_var%t_dim(3)%i_len, &
+         &                   td_var%t_dim(4)%i_len ) )
+         dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+         ALLOCATE( var__copy_unit%d_value( var__copy_unit%t_dim(1)%i_len, &
+         &                          var__copy_unit%t_dim(2)%i_len, &
+         &                          var__copy_unit%t_dim(3)%i_len, &
+         &                          var__copy_unit%t_dim(4)%i_len ) )
+         var__copy_unit%d_value(:,:,:,:)=dl_value(:,:,:,:)
+
+         DEALLOCATE( dl_value )
+      ENDIF
+
+      var__copy_unit%c_interp(:)=td_var%c_interp(:)
+      var__copy_unit%c_extrap(:)=td_var%c_extrap(:)
+      var__copy_unit%c_filter(:)=td_var%c_filter(:)
+
+   END FUNCTION var__copy_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of variable structure in another one
+   !> @details 
+   !> see var__copy_unit
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_var=var_copy(var_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_var   array of variable structure
+   !> @return copy of input array of variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var__copy_arr( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN   ) :: td_var
+      ! function
+      TYPE(TVAR), DIMENSION(SIZE(td_var(:))) :: var__copy_arr
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_var(:))
+         var__copy_arr(ji)=var_copy(td_var(ji))
+      ENDDO
+
+   END FUNCTION var__copy_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean variable structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE var__clean_unit( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      TYPE(TVAR) :: tl_var ! empty variable strucutre
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! del attribute
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         CALL att_clean( td_var%t_att(:) )
+         DEALLOCATE(td_var%t_att)
+      ENDIF
+
+      ! del dimension
+      IF( td_var%i_ndim /= 0 )THEN
+         CALL dim_clean(td_var%t_dim(:))
+      ENDIF
+
+      ! del value
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         CALL var_del_value(td_var)
+      ENDIF
+
+      ! replace by empty structure
+      td_var=var_copy(tl_var)
+
+   END SUBROUTINE var__clean_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean 1D array of variable structure
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_var array of variable strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE var__clean_arr_1D( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_var(:)),1,-1
+         CALL var_clean(td_var(ji))
+      ENDDO
+
+   END SUBROUTINE var__clean_arr_1D
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean 2D array of variable structure
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_var array of variable strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE var__clean_arr_2D( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:,:), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      DO jj=SIZE(td_var(:,:),DIM=2),1,-1
+         DO ji=SIZE(td_var(:,:),DIM=1),1,-1
+            CALL var_clean(td_var(ji,jj))
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE var__clean_arr_2D
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean 3D array of variable structure
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_var array of variable strucutre
+   !-------------------------------------------------------------------
+   SUBROUTINE var__clean_arr_3D( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:,:,:), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      DO jk=SIZE(td_var(:,:,:),DIM=3),1,-1
+         DO jj=SIZE(td_var(:,:,:),DIM=2),1,-1
+            DO ji=SIZE(td_var(:,:,:),DIM=1),1,-1
+               CALL var_clean(td_var(ji,jj,jk))
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE var__clean_arr_3D
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure, given variable name.
+   !
+   !> @details
+   !> Optionally you could add 1D,2D,3D or 4D array of value, 
+   !> see var__init_1D_dp, var__init_2D_dp... for more information.
+   !>
+   !> you could also add more information with the following optional arguments:
+   !>   - id_type :  integer(4) variable type, (as defined by NETCDF type constants).
+   !>   - td_dim : array of dimension structure.
+   !>   - td_att  : array of attribute structure.
+   !>   - dd_fill : real(8) variable FillValue. if none NETCDF FillValue will be used.
+   !>   - cd_units : string character of units.
+   !>   - cd_axis : string character of axis expected to be used
+   !>   - cd_stdname : string character of variable standard name.
+   !>   - cd_longname : string character of variable long name.
+   !>   - cd_point : one character for ARAKAWA C-grid point name (T,U,V,F).
+   !>   - id_id : variable id (read from a file).
+   !>   - id_ew : number of point composing east west wrap band.
+   !>   - dd_unf : real(8) value for units factor attribute.
+   !>   - dd_scf : real(8) value for scale factor attribute.
+   !>   - dd_ofs : real(8) value for add offset attribute.
+   !>   - id_rec : record id (for rstdimg file).
+   !>   - dd_min : real(8) value for minimum value.
+   !>   - dd_max : real(8) value for maximum value.
+   !>   - ld_contiguous : use contiguous storage or not (for netcdf4).
+   !>   - ld_shuffle :  shuffle filter is turned on or not (for netcdf4).
+   !>   - ld_fletcher32 : fletcher32 filter is turned on or not (for netcdf4).
+   !>   - id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use (for netcdf4).
+   !>   - id_chunksz : chunk size (for netcdf4).
+   !>   - cd_interp  : a array of character defining interpolation method.
+   !>   - cd_extrap  : a array of character defining extrapolation method.
+   !>   - cd_filter  : a array of character defining filtering method.
+   !>   - cd_unt : a string character to define output unit
+   !>   - dd_unf : real(8) factor applied to change unit
+   !>
+   !>  @note most of these optionals arguments will be inform automatically,
+   !>  when reading variable from a file, or using confiuguration file variable.cfg.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - Bug fix: conversion of the FillValue type (float case)
+   !> @date June, 2015 
+   !> - add unit factor (to change unit)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init( cd_name, id_type, td_dim, &
+   &                              td_att, dd_fill, cd_units, cd_axis, &
+   &                              cd_stdname, cd_longname,  &
+   &                              cd_point, id_id, id_ew,   &
+   &                              dd_scf, dd_ofs,  id_rec,  &
+   &                              dd_min, dd_max,           &
+   &                              ld_contiguous, ld_shuffle,&
+   &                              ld_fletcher32, id_deflvl, id_chunksz, &
+   &                              cd_interp, cd_extrap, cd_filter, &
+   &                              cd_unt, dd_unf )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      TYPE(TATT)  :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init)
+
+      var__init%c_name=TRIM(ADJUSTL(cd_name))
+
+      ! standard name
+      IF( PRESENT(cd_stdname) )THEN
+         var__init%c_stdname=TRIM(ADJUSTL(cd_stdname))
+      ENDIF
+
+      ! long name
+      IF( PRESENT(cd_longname) )THEN
+         var__init%c_longname=TRIM(ADJUSTL(cd_longname))
+      ENDIF
+
+      ! point
+      IF( PRESENT(cd_point) )THEN
+         var__init%c_point=TRIM(ADJUSTL(cd_point))
+      ENDIF
+
+      ! variable id
+      IF( PRESENT(id_id) )THEN
+         var__init%i_id=id_id
+      ENDIF
+
+      ! east west wrap
+      IF( PRESENT(id_ew) )THEN
+         var__init%i_ew=id_ew
+      ENDIF
+
+      ! type
+      IF( PRESENT(id_type) )THEN
+         var__init%i_type=id_type
+      ELSE
+         var__init%i_type=NF90_DOUBLE
+      ENDIF
+
+      ! add attribute
+      IF( PRESENT(td_att) )THEN
+         CALL var_add_att(var__init, td_att(:))
+      ENDIF
+
+      ! add _FillValue
+      IF( PRESENT(dd_fill) )THEN
+         SELECT CASE( var__init%i_type )
+            CASE(NF90_BYTE)
+               tl_att=att_init('_FillValue', INT(dd_fill,i1) )
+            CASE(NF90_SHORT)
+               tl_att=att_init('_FillValue', INT(dd_fill,i2) )
+            CASE(NF90_INT)
+               tl_att=att_init('_FillValue', INT(dd_fill,i4) )
+            CASE(NF90_FLOAT)
+               tl_att=att_init('_FillValue', REAL(dd_fill,sp) )
+            CASE DEFAULT ! NF90_DOUBLE
+               tl_att=att_init('_FillValue', dd_fill )
+         END SELECT
+         CALL var_move_att(var__init, tl_att)
+      ELSE
+         il_ind=0
+         IF( ASSOCIATED(var__init%t_att) )THEN
+            il_ind=att_get_index(var__init%t_att(:),'_FillValue')
+         ENDIF
+         IF( il_ind == 0 )THEN
+            SELECT CASE( var__init%i_type )
+               CASE(NF90_BYTE)
+                  tl_att=att_init('_FillValue',NF90_FILL_BYTE)
+               CASE(NF90_SHORT)
+                  tl_att=att_init('_FillValue',NF90_FILL_SHORT)
+               CASE(NF90_INT)
+                  tl_att=att_init('_FillValue',NF90_FILL_INT)
+               CASE(NF90_FLOAT)
+                  tl_att=att_init('_FillValue',NF90_FILL_FLOAT)
+               CASE DEFAULT ! NF90_DOUBLE
+                  tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
+            END SELECT         
+            CALL var_add_att(var__init, tl_att)
+         ENDIF
+      ENDIF
+
+      ! scale factor
+      IF( PRESENT(dd_scf) )THEN
+         tl_att=att_init('scale_factor',dd_scf)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
+      ! add offset
+      IF( PRESENT(dd_ofs) )THEN
+         tl_att=att_init('add_offset',dd_ofs)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
+      IF( PRESENT(cd_units) )THEN
+         tl_att=att_init('units',cd_units)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
+      IF( PRESENT(cd_axis) )THEN
+         var__init%c_axis=TRIM(cd_axis)
+      ENDIF
+
+      ! add dimension
+      IF( PRESENT(td_dim) )THEN
+         CALL var_add_dim(var__init, td_dim(:))
+      ELSE
+         CALL var_add_dim(var__init, dim_fill_unused())
+      ENDIF
+
+      IF( PRESENT(id_rec) )THEN
+         var__init%i_rec=id_rec
+      ENDIF
+
+      ! add minimum value
+      IF( PRESENT(dd_min) )THEN
+         var__init%d_min=dd_min
+      ENDIF
+
+      ! add maximum value
+      IF( PRESENT(dd_max) )THEN
+         var__init%d_max=dd_max
+      ENDIF
+
+      ! netcdf4
+      IF( PRESENT(ld_contiguous) )THEN
+         var__init%l_contiguous=ld_contiguous
+      ENDIF
+
+      IF( PRESENT(ld_shuffle) )THEN
+         var__init%l_shuffle=ld_shuffle
+      ENDIF
+
+      IF( PRESENT(ld_fletcher32) )THEN
+         var__init%l_fletcher32=ld_fletcher32
+      ENDIF
+
+       IF( PRESENT(id_deflvl) )THEN
+         var__init%i_deflvl=id_deflvl
+      ENDIF     
+      
+      IF( PRESENT(id_chunksz) )THEN
+         var__init%i_chunksz(:)=id_chunksz(:)
+      ENDIF
+
+      ! interp
+      IF( PRESENT(cd_interp) )THEN
+         var__init%c_interp(:)=cd_interp(:)
+      ENDIF
+
+      !extrap
+      IF( PRESENT(cd_extrap) )THEN
+         var__init%c_extrap(:)=cd_extrap(:)
+      ENDIF
+
+      !filter
+      IF( PRESENT(cd_filter) )THEN
+         var__init%c_filter(:)=cd_filter(:)
+      ENDIF
+
+      ! units factor
+      IF( PRESENT(dd_unf) )THEN
+         tl_att=att_init('units_factor',dd_unf)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
+      ! new units (linked to units factor)
+      IF( PRESENT(cd_unt) )THEN
+         tl_att=att_init('new_units',cd_units)
+         CALL var_move_att(var__init, tl_att)
+      ENDIF
+
+      ! add extra information
+      CALL var__get_extra(var__init)
+
+      ! delete some attribute cause linked to file where variable come from
+      CALL var_del_att(var__init, 'refinment_factor')
+      CALL var_del_att(var__init, 'interpolation')
+      CALL var_del_att(var__init, 'extrapolation')
+      CALL var_del_att(var__init, 'filter')
+      CALL var_del_att(var__init, 'src_file')
+      CALL var_del_att(var__init, 'src_i_indices')
+      CALL var_del_att(var__init, 'src_j_indices')
+      CALL var_del_att(var__init, 'valid_min')
+      CALL var_del_att(var__init, 'valid_max')
+      CALL var_del_att(var__init, 'missing_value')
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END FUNCTION var__init
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 1D array of value.
+   !> @details 
+   !> Optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date November, 2016
+   !> - allow to add scalar value
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        1D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count        number of indices selected along each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_1D_dp( cd_name, dd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, dd_fill, cd_units, cd_axis, &
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:)        , INTENT(IN) :: dd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                    :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_1D_dp)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tl_dim(1)=dim_init( 'Z', id_len=SIZE(dd_value(:)) )
+      IF( PRESENT(td_dim) )THEN
+         tl_dim(1)=dim_copy(td_dim)
+      ENDIF
+
+      il_start(:)=1
+      IF( PRESENT(id_start) )THEN
+         il_start(1)=id_start
+      ENDIF
+
+      il_count(:)=tl_dim(:)%i_len
+      IF( PRESENT(id_count) )THEN
+         il_count(1)=id_count
+      ENDIF
+
+      ! reorder dimension
+      CALL dim_reorder(tl_dim(:))
+      ! reorder array
+      il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
+      il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
+
+      var__init_1D_dp=var__init( cd_name, id_type=il_type,           &
+      &                          td_dim=tl_dim(:), td_att=td_att,    &
+      &                          dd_fill=dd_fill, cd_units=cd_units, &
+      &                          cd_axis=cd_axis,                    &
+      &                          cd_stdname=cd_stdname,              &
+      &                          cd_longname=cd_longname,            &
+      &                          cd_point=cd_point, id_id=id_id,     &
+      &                          id_ew=id_ew, dd_scf=dd_scf,         &
+      &                          dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                          dd_min=dd_min, dd_max=dd_max,       &
+      &                          ld_contiguous=ld_contiguous,        &
+      &                          ld_shuffle=ld_shuffle,              &
+      &                          ld_fletcher32=ld_fletcher32,        &
+      &                          id_deflvl=id_deflvl,                &
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
+   
+      ! add value
+      ALLOCATE( dl_value(tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      IF( tl_dim(1)%l_use )THEN
+         dl_value(:,1,1,1) = dd_value(:)
+      ELSEIF( tl_dim(2)%l_use )THEN
+         dl_value(1,:,1,1) = dd_value(:)
+      ELSEIF( tl_dim(3)%l_use )THEN
+         dl_value(1,1,:,1) = dd_value(:)
+      ELSEIF( tl_dim(4)%l_use )THEN
+         dl_value(1,1,1,:) = dd_value(:)
+      ELSE
+         IF( SIZE(dd_value(:)) > 1 )THEN
+            CALL logger_fatal("VAR INIT: can not add value from variable "//&
+            &  TRIM(cd_name)//". invalid dimension to be used")
+         ELSE
+            dl_value(1,1,1,1) = dd_value(1)
+            CALL logger_warn("VAR INIT: add scalar value for variable "//&
+            &  TRIM(cd_name))
+
+         ENDIF
+      ENDIF
+
+      CALL var_add_value( var__init_1D_dp, dl_value(:,:,:,:), &
+      &                   il_type, il_start(:), il_count(:) )
+
+      ! clean
+      DEALLOCATE( dl_value )
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_1D_dp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 2D array of value. 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !
+   !> @details 
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - bug fix: array initialise with dimension
+   !> array not only one value
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> - Bux fix: dimension array initialise not only one value
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        1D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates 
+   !> no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_2D_dp( cd_name, dd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, dd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:,:)      , INTENT(IN) :: dd_value
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                    :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_2D_dp)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tl_dim(1)=dim_init( 'X', id_len=SIZE(dd_value(:,:),DIM=1) )
+      tl_dim(2)=dim_init( 'Y', id_len=SIZE(dd_value(:,:),DIM=2) )
+      IF( PRESENT(td_dim) )THEN
+         IF( SIZE(td_dim(:)) /= 2 )THEN
+            CALL logger_error("VAR INIT: dimension of dimension structure "//&
+            &                 " not conform")
+         ELSE
+            tl_dim(1)=dim_copy(td_dim(1))
+            tl_dim(2)=dim_copy(td_dim(2))
+         ENDIF
+      ENDIF
+
+      il_start(:)=1
+      IF( PRESENT(id_start) )THEN
+         IF( SIZE(id_start(:)) /= 2 )THEN
+            CALL logger_error("VAR INIT: dimension of start array "//&
+            &                 " not conform")
+         ELSE
+            il_start(1)=id_start(1)
+            il_start(2)=id_start(2)
+         ENDIF
+      ENDIF
+
+      il_count(:)=tl_dim(:)%i_len
+      IF( PRESENT(id_count) )THEN
+         IF( SIZE(id_count(:)) /= 2 )THEN
+            CALL logger_error("VAR INIT: dimension of count array "//&
+            &                 " not conform")
+         ELSE
+            il_count(1)=id_count(1)
+            il_count(2)=id_count(2)
+         ENDIF
+      ENDIF
+
+      ! reorder dimension
+      CALL dim_reorder(tl_dim(:))
+      ! reorder array
+      il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
+      il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
+
+      var__init_2D_dp=var__init( cd_name, id_type=il_type,           &
+      &                          td_dim=tl_dim(:), td_att=td_att,    &
+      &                          dd_fill=dd_fill, cd_units=cd_units, &
+      &                          cd_axis=cd_axis,                    &
+      &                          cd_stdname=cd_stdname,              &
+      &                          cd_longname=cd_longname,            &
+      &                          cd_point=cd_point, id_id=id_id,     &
+      &                          id_ew=id_ew, dd_scf=dd_scf,         &
+      &                          dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                          dd_min=dd_min, dd_max=dd_max,       &
+      &                          ld_contiguous=ld_contiguous,        &
+      &                          ld_shuffle=ld_shuffle,              &
+      &                          ld_fletcher32=ld_fletcher32,        &
+      &                          id_deflvl=id_deflvl,                &
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
+   
+      ! add value
+      ALLOCATE( dl_value(tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      IF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use )THEN
+         dl_value(:,:,1,1)=dd_value(:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(3)%l_use )THEN
+         dl_value(:,1,:,1)=dd_value(:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(:,1,1,:)=dd_value(:,:)
+      ELSEIF( tl_dim(2)%l_use .AND. tl_dim(3)%l_use )THEN
+         dl_value(1,:,:,1)=dd_value(:,:)
+      ELSEIF( tl_dim(2)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(1,:,1,:)=dd_value(:,:)
+      ELSEIF( tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(1,1,:,:)=dd_value(:,:)
+      ELSE
+         CALL logger_fatal("VAR INIT: can not add value from variable "//&
+         &  TRIM(cd_name)//". invalid dimension to be used")
+      ENDIF
+
+      CALL var_add_value( var__init_2D_dp, dl_value(:,:,:,:), &
+      &                   il_type, il_start(:), il_count(:) )
+
+      ! clean
+      DEALLOCATE( dl_value )
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_2D_dp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        1D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_3D_dp( cd_name, dd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, dd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:,:,:)    , INTENT(IN) :: dd_value
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                    :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_3D_dp)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tl_dim(1)=dim_init( 'X', id_len=SIZE(dd_value(:,:,:),DIM=1) )
+      tl_dim(2)=dim_init( 'Y', id_len=SIZE(dd_value(:,:,:),DIM=2) )
+      tl_dim(3)=dim_init( 'Z', id_len=SIZE(dd_value(:,:,:),DIM=3) )
+      IF( PRESENT(td_dim) )THEN
+         IF( SIZE(td_dim(:)) /= 3 )THEN
+            CALL logger_error("VAR INIT: dimension of dimension structure "//&
+            &                 " not conform")
+         ELSE
+            tl_dim(1)=dim_copy(td_dim(1))
+            tl_dim(2)=dim_copy(td_dim(2))
+            tl_dim(3)=dim_copy(td_dim(3))
+         ENDIF
+      ENDIF
+
+      il_start(:)=1
+      IF( PRESENT(id_start) )THEN
+         IF( SIZE(id_start(:)) /= 3 )THEN
+            CALL logger_error("VAR INIT: dimension of start array "//&
+            &                 " not conform")
+         ELSE
+            il_start(1)=id_start(1)
+            il_start(2)=id_start(2)
+            il_start(3)=id_start(3)
+         ENDIF
+      ENDIF
+
+      il_count(:)=tl_dim(:)%i_len
+      IF( PRESENT(id_count) )THEN
+         IF( SIZE(id_count(:)) /= 3 )THEN
+            CALL logger_error("VAR INIT: dimension of count array "//&
+            &                 " not conform")
+         ELSE
+            il_count(1)=id_count(1)
+            il_count(2)=id_count(2)
+            il_count(3)=id_count(3)
+         ENDIF
+      ENDIF
+
+      ! reorder dimension
+      CALL dim_reorder(tl_dim(:))
+      ! reorder array
+      il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
+      il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
+
+      var__init_3D_dp=var__init( cd_name, id_type=il_type,           &
+      &                          td_dim=tl_dim(:), td_att=td_att,    &
+      &                          dd_fill=dd_fill, cd_units=cd_units, &
+      &                          cd_axis=cd_axis,                    &
+      &                          cd_stdname=cd_stdname,              &
+      &                          cd_longname=cd_longname,            &
+      &                          cd_point=cd_point, id_id=id_id,     &
+      &                          id_ew=id_ew, dd_scf=dd_scf,         &
+      &                          dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                          dd_min=dd_min, dd_max=dd_max,       &
+      &                          ld_contiguous=ld_contiguous,        &
+      &                          ld_shuffle=ld_shuffle,              &
+      &                          ld_fletcher32=ld_fletcher32,        &
+      &                          id_deflvl=id_deflvl,                &
+      &                          id_chunksz=id_chunksz(:),           &
+      &                          cd_interp=cd_interp(:),             &
+      &                          cd_extrap=cd_extrap(:),             &
+      &                          cd_filter=cd_filter(:),             &
+      &                          cd_unt=cd_unt, dd_unf=dd_unf )
+   
+      ! add value
+      ALLOCATE( dl_value(tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      IF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use .AND. tl_dim(3)%l_use )THEN
+         dl_value(:,:,:,1)=dd_value(:,:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use .AND. tl_dim(4)%l_use  )THEN
+         dl_value(:,:,1,:)=dd_value(:,:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(:,1,:,:)=dd_value(:,:,:)
+      ELSEIF( tl_dim(2)%l_use .AND. tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(1,:,:,:)=dd_value(:,:,:)
+      ELSE
+         CALL logger_fatal("VAR INIT: can not add value from variable "//&
+         &  TRIM(cd_name)//". invalid dimension to be used")
+      ENDIF
+
+      CALL var_add_value( var__init_3D_dp, dl_value(:,:,:,:), &
+      &                   il_type, il_start(:), il_count(:) )
+
+      ! clean
+      DEALLOCATE( dl_value )
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_3D_dp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        4D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_dp( cd_name, dd_value,        &
+   &                                 id_start, id_count, id_type, td_dim, &
+   &                                 td_att, dd_fill, cd_units, cd_axis,&
+   &                                 cd_stdname, cd_longname,  &
+   &                                 cd_point, id_id, id_ew,   &
+   &                                 dd_scf, dd_ofs,  id_rec,  &
+   &                                 dd_min, dd_max,           &
+   &                                 ld_contiguous, ld_shuffle,&
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:,:,:,:),   INTENT(IN) :: dd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+      TYPE(TDIM)                        :: tl_dim
+
+      INTEGER(i4) :: il_type
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_dp)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      var__init_dp=var__init( cd_name, id_type=il_type,           &
+      &                       td_dim=td_dim, td_att=td_att,       &
+      &                       dd_fill=dd_fill, cd_units=cd_units, &
+      &                       cd_axis=cd_axis,                    &
+      &                       cd_stdname=cd_stdname,              &
+      &                       cd_longname=cd_longname,            &
+      &                       cd_point=cd_point, id_id=id_id,     &
+      &                       id_ew=id_ew, dd_scf=dd_scf,         &
+      &                       dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                       dd_min=dd_min, dd_max=dd_max,       &
+      &                       ld_contiguous=ld_contiguous,        &
+      &                       ld_shuffle=ld_shuffle,              &
+      &                       ld_fletcher32=ld_fletcher32,        &
+      &                       id_deflvl=id_deflvl,                &
+      &                       id_chunksz=id_chunksz(:),           &
+      &                       cd_interp=cd_interp(:),             &
+      &                       cd_extrap=cd_extrap(:),             &
+      &                       cd_filter=cd_filter(:),             &
+      &                       cd_unt=cd_unt, dd_unf=dd_unf )
+ 
+      ! add value
+      IF( .NOT. PRESENT(td_dim) )THEN
+         il_shape(:)=SHAPE(dd_value(:,:,:,:)) 
+         DO ji=1,ip_maxdim
+            tl_dim=dim_init( cp_dimorder(ji:ji), id_len=il_shape(ji)) 
+            CALL var_add_dim(var__init_dp, tl_dim)
+         ENDDO
+      ENDIF
+
+      CALL var_add_value( var__init_dp, dd_value(:,:,:,:), &
+      &                   il_type, id_start(:), id_count(:) )
+
+      ! clean
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_dp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] rd_value        1D array of real(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] rd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_1D_sp( cd_name, rd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, rd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:)        , INTENT(IN) :: rd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_1D_sp)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape=SIZE(rd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      dl_value(:)=REAL(rd_value(:),dp)
+
+      var__init_1D_sp=var_init( cd_name, dl_value(:),               &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf )
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_sp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         : variable name
+   !> @param[in] rd_value        : 2D array of real(4) value
+   !> @param[in] id_start        : index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        : number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         : variable type 
+   !> @param[in] td_dim          : array of dimension structure
+   !> @param[in] td_att          : array of attribute structure
+   !> @param[in] rd_fill         : fill value
+   !> @param[in] cd_units        : units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      : variable standard name
+   !> @param[in] cd_longname     : variable long name
+   !> @param[in] cd_point        : point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           : variable id
+   !> @param[in] id_ew           : east west wrap
+   !> @param[in] dd_scf          : scale factor
+   !> @param[in] dd_ofs          : add offset
+   !> @param[in] id_rec          : record id (for rstdimg file)
+   !> @param[in] dd_min          : minimum value
+   !> @param[in] dd_max          : maximum value
+   !> @param[in] ld_contiguous   : use contiguous storage or not 
+   !> @param[in] ld_shuffle      :  shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   : fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       : deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_2D_sp( cd_name, rd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, rd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:,:)     ,  INTENT(IN) :: rd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_2D_sp)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape(:)=SHAPE(rd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2)) )
+
+      dl_value(:,:)=REAL(rd_value(:,:),dp)
+
+      var__init_2D_sp=var_init( cd_name, dl_value(:,:),             &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_sp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         : variable name
+   !> @param[in] rd_value        : 2D array of real(4) value
+   !> @param[in] id_start        : index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        : number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         : variable type 
+   !> @param[in] td_dim          : array of dimension structure
+   !> @param[in] td_att          : array of attribute structure
+   !> @param[in] rd_fill         : fill value
+   !> @param[in] cd_units        : units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      : variable standard name
+   !> @param[in] cd_longname     : variable long name
+   !> @param[in] cd_point        : point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           : variable id
+   !> @param[in] id_ew           : east west wrap
+   !> @param[in] dd_scf          : scale factor
+   !> @param[in] dd_ofs          : add offset
+   !> @param[in] id_rec          : record id (for rstdimg file)
+   !> @param[in] dd_min          : minimum value
+   !> @param[in] dd_max          : maximum value
+   !> @param[in] ld_contiguous   : use contiguous storage or not 
+   !> @param[in] ld_shuffle      :  shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   : fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       : deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_3D_sp( cd_name, rd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, rd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:,:,:)   ,  INTENT(IN) :: rd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_3D_sp)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape(:)=SHAPE(rd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3)) )
+
+      dl_value(:,:,:)=REAL(rd_value(:,:,:),dp)
+
+      var__init_3D_sp=var_init( cd_name, dl_value(:,:,:),           &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_sp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] rd_value        4D array of real(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] rd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_sp( cd_name, rd_value,        &
+   &                                 id_start, id_count, id_type, td_dim, &
+   &                                 td_att, rd_fill, cd_units, cd_axis,&
+   &                                 cd_stdname, cd_longname,  &
+   &                                 cd_point, id_id, id_ew,   &
+   &                                 dd_scf, dd_ofs,  id_rec,  &
+   &                                 dd_min, dd_max,           &
+   &                                 ld_contiguous, ld_shuffle,&
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:,:,:,:),   INTENT(IN) :: rd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_sp)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape(:)=SHAPE(rd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3), &
+      &                   il_shape(4)) )
+
+      dl_value(:,:,:,:)=REAL(rd_value(:,:,:,:),dp)
+
+      var__init_sp=var_init( cd_name, dl_value(:,:,:,:),         &
+      &                      id_start=id_start,                  &
+      &                      id_count=id_count,                  &
+      &                      id_type=il_type,                    &
+      &                      td_dim=td_dim, td_att=td_att,       &
+      &                      dd_fill=dl_fill,                    &
+      &                      cd_units=cd_units,                  &
+      &                      cd_axis=cd_axis,                    &
+      &                      cd_stdname=cd_stdname,              &
+      &                      cd_longname=cd_longname,            &
+      &                      cd_point=cd_point, id_id=id_id,     &
+      &                      id_ew=id_ew, dd_scf=dd_scf,         &
+      &                      dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                      dd_min=dd_min, dd_max=dd_max,       &
+      &                      ld_contiguous=ld_contiguous,        &
+      &                      ld_shuffle=ld_shuffle,              &
+      &                      ld_fletcher32=ld_fletcher32,        &
+      &                      id_deflvl=id_deflvl,                &
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_sp
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         : variable name
+   !> @param[in] kd_value        : 1D array of integer(8) value
+   !> @param[in] id_start        : index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        : number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         : variable type 
+   !> @param[in] td_dim          : array of dimension structure
+   !> @param[in] td_att          : array of attribute structure
+   !> @param[in] kd_fill         : fill value
+   !> @param[in] cd_units        : units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      : variable standard name
+   !> @param[in] cd_longname     : variable long name
+   !> @param[in] cd_point        : point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           : variable id
+   !> @param[in] id_ew           : east west wrap
+   !> @param[in] dd_scf          : scale factor
+   !> @param[in] dd_ofs          : add offset
+   !> @param[in] id_rec          : record id (for rstdimg file)
+   !> @param[in] dd_min          : minimum value
+   !> @param[in] dd_max          : maximum value
+   !> @param[in] ld_contiguous   : use contiguous storage or not 
+   !> @param[in] ld_shuffle      :  shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   : fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       : deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_1D_i8( cd_name, kd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, kd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:)        , INTENT(IN) :: kd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_1D_i8)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape=SIZE(kd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      dl_value(:)=REAL(kd_value(:),dp)
+
+      var__init_1D_i8=var_init( cd_name, dl_value(:),               &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i8
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] kd_value        2D array of integer(8) value
+   !> @param[in] id_start        index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count        number of indices selected along each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] kd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_2D_i8( cd_name, kd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, kd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:,:)     ,  INTENT(IN) :: kd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_2D_i8)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape(:)=SHAPE(kd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2)) )
+
+      dl_value(:,:)=REAL(kd_value(:,:),dp)
+
+      var__init_2D_i8=var_init( cd_name, dl_value(:,:),             &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i8
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] kd_value        2D array of integer(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] kd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_3D_i8( cd_name, kd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, kd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: kd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_3D_i8)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape(:)=SHAPE(kd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3)) )
+
+      dl_value(:,:,:)=REAL(kd_value(:,:,:),dp)
+
+      var__init_3D_i8=var_init( cd_name, dl_value(:,:,:),           &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i8
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] kd_value        4D array of integer(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] kd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_i8( cd_name, kd_value,        &
+   &                                 id_start, id_count, id_type, td_dim, &
+   &                                 td_att, kd_fill, cd_units, cd_axis,&
+   &                                 cd_stdname, cd_longname,  &
+   &                                 cd_point, id_id, id_ew,   &
+   &                                 dd_scf, dd_ofs,  id_rec,  &
+   &                                 dd_min, dd_max,           &
+   &                                 ld_contiguous, ld_shuffle,&
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:,:,:,:),   INTENT(IN) :: kd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_i8)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape(:)=SHAPE(kd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3), &
+      &                   il_shape(4)) )
+
+      dl_value(:,:,:,:)=REAL(kd_value(:,:,:,:),dp)
+
+      var__init_i8=var_init( cd_name, dl_value(:,:,:,:),         &
+      &                      id_start=id_start,                  &
+      &                      id_count=id_count,                  &
+      &                      id_type=il_type,                    &
+      &                      td_dim=td_dim, td_att=td_att,       &
+      &                      dd_fill=dl_fill,                    &
+      &                      cd_units=cd_units,                  &
+      &                      cd_axis=cd_axis,                    &
+      &                      cd_stdname=cd_stdname,              &
+      &                      cd_longname=cd_longname,            &
+      &                      cd_point=cd_point, id_id=id_id,     &
+      &                      id_ew=id_ew, dd_scf=dd_scf,         &
+      &                      dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                      dd_min=dd_min, dd_max=dd_max,       &
+      &                      ld_contiguous=ld_contiguous,        &
+      &                      ld_shuffle=ld_shuffle,              &
+      &                      ld_fletcher32=ld_fletcher32,        &
+      &                      id_deflvl=id_deflvl,                &
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i8
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        1D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_1D_i4( cd_name, id_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, id_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN) :: id_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_1D_i4)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape=SIZE(id_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      dl_value(:)=REAL(id_value(:),dp)
+
+      var__init_1D_i4=var_init( cd_name, dl_value(:),               &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i4
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        2D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_2D_i4( cd_name, id_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, id_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:,:)     ,  INTENT(IN) :: id_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_2D_i4)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape(:)=SHAPE(id_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2)) )
+
+      dl_value(:,:)=REAL(id_value(:,:),dp)
+
+      var__init_2D_i4=var_init( cd_name, dl_value(:,:),             &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i4
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        3D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_3D_i4( cd_name, id_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, id_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: id_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_3D_i4)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape(:)=SHAPE(id_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3)) )
+
+      dl_value(:,:,:)=REAL(id_value(:,:,:),dp)
+
+      var__init_3D_i4=var_init( cd_name, dl_value(:,:,:),           &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i4
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        4D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_i4( cd_name, id_value,        &
+   &                                 id_start, id_count, id_type, td_dim, &
+   &                                 td_att, id_fill, cd_units, cd_axis,&
+   &                                 cd_stdname, cd_longname,  &
+   &                                 cd_point, id_id, id_ew,   &
+   &                                 dd_scf, dd_ofs,  id_rec,  &
+   &                                 dd_min, dd_max,           &
+   &                                 ld_contiguous, ld_shuffle,&
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:,:,:,:),   INTENT(IN) :: id_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_i4)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape(:)=SHAPE(id_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3), &
+      &                   il_shape(4)) )
+
+      dl_value(:,:,:,:)=REAL(id_value(:,:,:,:),dp)
+
+      var__init_i4=var_init( cd_name, dl_value(:,:,:,:),         &
+      &                      id_start=id_start,                  &
+      &                      id_count=id_count,                  &
+      &                      id_type=il_type,                    &
+      &                      td_dim=td_dim, td_att=td_att,       &
+      &                      dd_fill=dl_fill,                    &
+      &                      cd_units=cd_units,                  &
+      &                      cd_axis=cd_axis,                    &
+      &                      cd_stdname=cd_stdname,              &
+      &                      cd_longname=cd_longname,            &
+      &                      cd_point=cd_point, id_id=id_id,     &
+      &                      id_ew=id_ew, dd_scf=dd_scf,         &
+      &                      dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                      dd_min=dd_min, dd_max=dd_max,       &
+      &                      ld_contiguous=ld_contiguous,        &
+      &                      ld_shuffle=ld_shuffle,              &
+      &                      ld_fletcher32=ld_fletcher32,        &
+      &                      id_deflvl=id_deflvl,                &
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i4
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        1D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_1D_i2( cd_name, sd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, sd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:)        , INTENT(IN) :: sd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_1D_i2)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape=SIZE(sd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      dl_value(:)=REAL(sd_value(:),dp)
+
+      var__init_1D_i2=var_init( cd_name, dl_value(:),               &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i2
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        2D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_2D_i2( cd_name, sd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, sd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:,:)     ,  INTENT(IN) :: sd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_2D_i2)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape(:)=SHAPE(sd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2)) )
+
+      dl_value(:,:)=REAL(sd_value(:,:),dp)
+
+      var__init_2D_i2=var_init( cd_name, dl_value(:,:),             &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i2
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        3D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_3D_i2( cd_name, sd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, sd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: sd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_3D_i2)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape(:)=SHAPE(sd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3)) )
+
+      dl_value(:,:,:)=REAL(sd_value(:,:,:),dp)
+
+      var__init_3D_i2=var_init( cd_name, dl_value(:,:,:),           &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i2
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        4D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_i2( cd_name, sd_value,        &
+   &                                 id_start, id_count, id_type, td_dim, &
+   &                                 td_att, sd_fill, cd_units, cd_axis,&
+   &                                 cd_stdname, cd_longname,  &
+   &                                 cd_point, id_id, id_ew,   &
+   &                                 dd_scf, dd_ofs,  id_rec,  &
+   &                                 dd_min, dd_max,           &
+   &                                 ld_contiguous, ld_shuffle,&
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:,:,:,:),   INTENT(IN) :: sd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_i2)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape(:)=SHAPE(sd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3), &
+      &                   il_shape(4)) )
+
+      dl_value(:,:,:,:)=REAL(sd_value(:,:,:,:),dp)
+
+      var__init_i2=var_init( cd_name, dl_value(:,:,:,:),         &
+      &                      id_start=id_start,                  &
+      &                      id_count=id_count,                  &
+      &                      id_type=il_type,                    &
+      &                      td_dim=td_dim, td_att=td_att,       &
+      &                      dd_fill=dl_fill,                    &
+      &                      cd_units=cd_units,                  &
+      &                      cd_axis=cd_axis,                    &
+      &                      cd_stdname=cd_stdname,              &
+      &                      cd_longname=cd_longname,            &
+      &                      cd_point=cd_point, id_id=id_id,     &
+      &                      id_ew=id_ew, dd_scf=dd_scf,         &
+      &                      dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                      dd_min=dd_min, dd_max=dd_max,       &
+      &                      ld_contiguous=ld_contiguous,        &
+      &                      ld_shuffle=ld_shuffle,              &
+      &                      ld_fletcher32=ld_fletcher32,        &
+      &                      id_deflvl=id_deflvl,                &
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i2
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        1D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_1D_i1( cd_name, bd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, bd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:)        , INTENT(IN) :: bd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_1D_i1)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape=SIZE(bd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      dl_value(:)=REAL(bd_value(:),dp)
+
+      var__init_1D_i1=var_init( cd_name, dl_value(:),               &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i1
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        2D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_2D_i1( cd_name, bd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, bd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:,:)     ,  INTENT(IN) :: bd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_2D_i1)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape(:)=SHAPE(bd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2)) )
+
+      dl_value(:,:)=REAL(bd_value(:,:),dp)
+
+      var__init_2D_i1=var_init( cd_name, dl_value(:,:),             &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i1
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        3D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_3D_i1( cd_name, bd_value,        &
+   &                                    id_start, id_count, id_type, td_dim, &
+   &                                    td_att, bd_fill, cd_units, cd_axis,&
+   &                                    cd_stdname, cd_longname,  &
+   &                                    cd_point, id_id, id_ew,   &
+   &                                    dd_scf, dd_ofs,  id_rec,  &
+   &                                    dd_min, dd_max,           &
+   &                                    ld_contiguous, ld_shuffle,&
+   &                                    ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                    cd_interp, cd_extrap, cd_filter, &
+   &                                    cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: bd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_3D_i1)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape(:)=SHAPE(bd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3)) )
+
+      dl_value(:,:,:)=REAL(bd_value(:,:,:),dp)
+
+      var__init_3D_i1=var_init( cd_name, dl_value(:,:,:),           &
+      &                         id_start=id_start,                  &
+      &                         id_count=id_count,                  &
+      &                         id_type=il_type,                    &
+      &                         td_dim=td_dim, td_att=td_att,       &
+      &                         dd_fill=dl_fill,                    &
+      &                         cd_units=cd_units,                  &
+      &                         cd_axis=cd_axis,                    &
+      &                         cd_stdname=cd_stdname,              &
+      &                         cd_longname=cd_longname,            &
+      &                         cd_point=cd_point, id_id=id_id,     &
+      &                         id_ew=id_ew, dd_scf=dd_scf,         &
+      &                         dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                         dd_min=dd_min, dd_max=dd_max,       &
+      &                         ld_contiguous=ld_contiguous,        &
+      &                         ld_shuffle=ld_shuffle,              &
+      &                         ld_fletcher32=ld_fletcher32,        &
+      &                         id_deflvl=id_deflvl,                &
+      &                         id_chunksz=id_chunksz(:),           &
+      &                         cd_interp=cd_interp(:),             &
+      &                         cd_extrap=cd_extrap(:),             &
+      &                         cd_filter=cd_filter(:),             &
+      &                         cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i1
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case. 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        4D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   TYPE(TVAR) FUNCTION var__init_i1( cd_name, bd_value,        &
+   &                                 id_start, id_count, id_type, td_dim, &
+   &                                 td_att, bd_fill, cd_units, cd_axis,&
+   &                                 cd_stdname, cd_longname,  &
+   &                                 cd_point, id_id, id_ew,   &
+   &                                 dd_scf, dd_ofs,  id_rec,  &
+   &                                 dd_min, dd_max,           &
+   &                                 ld_contiguous, ld_shuffle,&
+   &                                 ld_fletcher32, id_deflvl, id_chunksz, &
+   &                                 cd_interp, cd_extrap, cd_filter, &
+   &                                 cd_unt, dd_unf)
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:,:,:,:),   INTENT(IN) :: bd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(var__init_i1)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape(:)=SHAPE(bd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+      &                   il_shape(2), &
+      &                   il_shape(3), &
+      &                   il_shape(4)) )
+
+      dl_value(:,:,:,:)=REAL(bd_value(:,:,:,:),dp)
+
+      var__init_i1=var_init( cd_name, dl_value(:,:,:,:),         &
+      &                      id_start=id_start,                  &
+      &                      id_count=id_count,                  &
+      &                      id_type=il_type,                    &
+      &                      td_dim=td_dim, td_att=td_att,       &
+      &                      dd_fill=dl_fill,                    &
+      &                      cd_units=cd_units,                  &
+      &                      cd_axis=cd_axis,                    &
+      &                      cd_stdname=cd_stdname,              &
+      &                      cd_longname=cd_longname,            &
+      &                      cd_point=cd_point, id_id=id_id,     &
+      &                      id_ew=id_ew, dd_scf=dd_scf,         &
+      &                      dd_ofs=dd_ofs,  id_rec=id_rec,      &
+      &                      dd_min=dd_min, dd_max=dd_max,       &
+      &                      ld_contiguous=ld_contiguous,        &
+      &                      ld_shuffle=ld_shuffle,              &
+      &                      ld_fletcher32=ld_fletcher32,        &
+      &                      id_deflvl=id_deflvl,                &
+      &                      id_chunksz=id_chunksz(:),           &
+      &                      cd_interp=cd_interp(:),             &
+      &                      cd_extrap=cd_extrap(:),             &
+      &                      cd_filter=cd_filter(:),             &
+      &                      cd_unt=cd_unt, dd_unf=dd_unf)
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i1
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following DIM direction.
+   !> 
+   !> @details
+   !> By default variable are concatenate following time dimension. To
+   !> concatenate following another dimension, specify DIM=x where x is the
+   !> dimension number (jp_I, jp_J,jp_K, jp_L). 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @param[in] DIM       dimension following which concatenate
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var_concat(td_var1, td_var2, DIM)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+      INTEGER(i4), INTENT(IN), OPTIONAL :: DIM
+
+      ! function
+      TYPE(TVAR) :: var_concat
+
+      ! local variable
+      INTEGER(i4) :: il_dim
+      !----------------------------------------------------------------
+      il_dim=4
+      IF( PRESENT(DIM) ) il_dim=DIM
+
+      IF( .NOT. ASSOCIATED(td_var1%d_value) )THEN
+         CALL logger_error("VAR CONCAT: no value associated to variable "//&
+         &  TRIM(td_var1%c_name) )
+      ELSEIF( .NOT. ASSOCIATED(td_var2%d_value) )THEN
+         CALL logger_error("VAR CONCAT: no value associated to variable "//&
+         &  TRIM(td_var2%c_name) )
+      ELSEIF( il_dim < 0 .OR. il_dim > 4 )THEN
+         CALL logger_error("VAR CONCAT: invalid concatenate dimension ")
+      ELSE
+         ! check other dimension
+         SELECT CASE(il_dim)
+         CASE(jp_I)
+            var_concat=var__concat_i(td_var1, td_var2)
+         CASE(jp_J)
+            var_concat=var__concat_j(td_var1, td_var2)
+         CASE(jp_K)
+            var_concat=var__concat_k(td_var1, td_var2)
+         CASE(jp_L)
+            var_concat=var__concat_l(td_var1, td_var2)
+         END SELECT
+      ENDIF
+
+   END FUNCTION var_concat
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following i-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var__concat_i(td_var1, td_var2)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR) :: var__concat_i
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(1)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(1)%l_use )THEN
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension I")
+      ELSEIF( ANY(td_var1%t_dim(2:4)%i_len /=  td_var2%t_dim(2:4)%i_len) )THEN
+
+         cl_tmp='('//":"//","//&
+         &           TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
+         &           TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
+         &           TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+         &  TRIM(cl_tmp) )
+         cl_tmp='('//":"//","//&
+         &           TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
+         &           TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
+         &           TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+         &  TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(1)%i_len=td_var1%t_dim(1)%i_len+td_var2%t_dim(1)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+         &                       tl_var%t_dim(2)%i_len, &
+         &                       tl_var%t_dim(3)%i_len, &
+         &                       tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         tl_var%d_value(1:td_var1%t_dim(1)%i_len,:,:,:) = &
+         &  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         tl_var%d_value(td_var1%t_dim(1)%i_len+1:tl_var%t_dim(1)%i_len,:,:,:)=&
+         &  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         var__concat_i=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_i
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following j-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var__concat_j(td_var1, td_var2)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR) :: var__concat_j
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(2)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(2)%l_use )THEN
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension J")      
+      ELSEIF(     td_var1%t_dim(1)%i_len   /=  td_var2%t_dim(1)%i_len  .OR. &
+      &   ANY(td_var1%t_dim(3:4)%i_len /=  td_var2%t_dim(3:4)%i_len) )THEN
+
+         cl_tmp='('//&
+         &           TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+         &           ":"//','//&
+         &           TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
+         &           TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+         &  TRIM(cl_tmp) )
+         cl_tmp='('//&
+         &           TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+         &           ":"//','//&
+         &           TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
+         &           TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+         &  TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(2)%i_len=td_var1%t_dim(2)%i_len+td_var2%t_dim(2)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+         &                       tl_var%t_dim(2)%i_len, &
+         &                       tl_var%t_dim(3)%i_len, &
+         &                       tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         tl_var%d_value(:,1:td_var1%t_dim(2)%i_len,:,:)= &
+         &  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         tl_var%d_value(:,td_var1%t_dim(2)%i_len+1:tl_var%t_dim(2)%i_len,:,:)=&
+         &  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         var__concat_j=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_j
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following k-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var__concat_k(td_var1, td_var2)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR) :: var__concat_k
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(3)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(3)%l_use )THEN
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension K")      
+      ELSEIF(     td_var1%t_dim(4)%i_len   /=  td_var2%t_dim(4)%i_len  .OR. &
+      &   ANY(td_var1%t_dim(1:2)%i_len /=  td_var2%t_dim(1:2)%i_len) )THEN
+
+         cl_tmp='('//&
+         &           TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+         &           TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
+         &           ":"//','//&
+         &           TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+         &  TRIM(cl_tmp) )
+         cl_tmp='('//&
+         &           TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+         &           TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
+         &           ":"//','//&
+         &           TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+         &  TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(3)%i_len=td_var1%t_dim(3)%i_len+td_var2%t_dim(3)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+         &                       tl_var%t_dim(2)%i_len, &
+         &                       tl_var%t_dim(3)%i_len, &
+         &                       tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         tl_var%d_value(:,:,1:td_var1%t_dim(3)%i_len,:)= &
+         &  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         tl_var%d_value(:,:,td_var1%t_dim(3)%i_len+1:tl_var%t_dim(3)%i_len,:)=&
+         &  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         var__concat_k=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_k
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following l-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+   FUNCTION var__concat_l(td_var1, td_var2)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR) :: var__concat_l
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(4)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(4)%l_use )THEN
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension L")      
+      ELSEIF( ANY(td_var1%t_dim(1:3)%i_len /=  td_var2%t_dim(1:3)%i_len) )THEN
+
+         cl_tmp='('//&
+         &           TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+         &           TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
+         &           TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
+         &           ":"//','//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+         &  TRIM(cl_tmp) )
+         cl_tmp='('//&
+         &           TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+         &           TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
+         &           TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
+         &           ":"//','//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+         &  TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(4)%i_len=td_var1%t_dim(4)%i_len+td_var2%t_dim(4)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+         &                       tl_var%t_dim(2)%i_len, &
+         &                       tl_var%t_dim(3)%i_len, &
+         &                       tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         tl_var%d_value(:,:,1:td_var1%t_dim(4)%i_len,:)= &
+         &  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         tl_var%d_value(:,:,td_var1%t_dim(4)%i_len+1:tl_var%t_dim(4)%i_len,:)=&
+         &  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         var__concat_l=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_l
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add an array of attribute structure 
+   !> in a variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - add all element of the array in the same time
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    array of attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_att_arr(td_var, td_att)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),               INTENT(INOUT) :: td_var
+      TYPE(TATT), DIMENSION(:), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_natt
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_natt=SIZE(td_att(:))
+
+      IF( td_var%i_natt > 0 )THEN
+      ! already other attribute in variable structure
+         ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+            &  " VAR ADD ATT: not enough space to put attributes from "//&
+            &  TRIM(td_var%c_name)//" in temporary attribute structure")
+
+         ELSE
+
+            ! save temporary global attribute's variable structure
+            tl_att(:)=att_copy(td_var%t_att(:))
+
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE( td_var%t_att )
+            ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes "//&
+               &  "in variable structure "//TRIM(td_var%c_name) )
+
+            ENDIF
+
+            ! copy attribute in variable before
+            td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
+
+            ! clean
+            CALL att_clean(tl_att(:))
+            DEALLOCATE(tl_att)
+            
+         ENDIF
+      ELSE
+      ! no attribute in variable structure
+         IF( ASSOCIATED(td_var%t_att) )THEN
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE(td_var%t_att)
+         ENDIF
+         ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+            &  " VAR ADD ATT: not enough space to put attributes "//&
+            &  "in variable structure "//TRIM(td_var%c_name) )
+
+         ENDIF
+      ENDIF
+
+      ALLOCATE( tl_att(il_natt) )
+      tl_att(:)=att_copy(td_att(:))
+
+      ! check if attribute already in variable structure
+      DO ji=1,il_natt
+         il_ind=0
+         il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name )
+         IF( il_ind /= 0 )THEN
+            CALL logger_error( &
+            &  " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//&
+            &  ", already in variable "//TRIM(td_var%c_name) )
+            CALL att_clean(tl_att(ji))
+         ENDIF
+      ENDDO
+
+      ! add new attributes
+      td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:))
+
+      DEALLOCATE(tl_att)
+
+      DO ji=1,il_natt
+         ! highlight some attribute
+         IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. &
+           & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN
+            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name))
+
+               CASE("add_offset")
+                  td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("scale_factor")
+                  td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("_FillValue")
+                  td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("ew_overlap")
+                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4) 
+               CASE("standard_name")
+                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("long_name")
+                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("units")
+                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("grid_point")
+                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+
+            END SELECT
+         ENDIF
+      ENDDO
+
+      ! update number of attribute
+      td_var%i_natt=td_var%i_natt+il_natt
+
+
+   END SUBROUTINE var__add_att_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add an attribute structure 
+   !> in a variable structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use var__add_att_arr subroutine
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_att_unit(td_var, td_att)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      TYPE(TATT), DIMENSION(1) :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy structure in an array
+      tl_att(1)=att_copy(td_att)
+
+      ! 
+      CALL var_add_att( td_var, tl_att(:) )
+
+   END SUBROUTINE var__add_att_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete an attribute 
+   !> from variable structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake 
+   !> with pointer
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] cd_name   attribute name
+   !-------------------------------------------------------------------
+   SUBROUTINE var__del_att_name(td_var, cd_name)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      TYPE(TATT)  :: tl_att
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! check if attribute already in variable structure
+      il_ind=0
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         il_ind=att_get_index( td_var%t_att(:), TRIM(cd_name) )
+      ENDIF
+
+      IF( il_ind == 0 )THEN
+
+         CALL logger_debug( &
+         &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+
+      ELSE
+         
+         tl_att=att_copy(td_var%t_att(il_ind))
+         CALL var_del_att(td_var, tl_att)
+
+      ENDIF
+
+   END SUBROUTINE var__del_att_name
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete an attribute 
+   !> from variable structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013- Initial Version
+   !> @date February, 2015 
+   !> - delete highlight attribute too, when attribute 
+   !> is deleted
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__del_att_str(td_var, td_att)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! check if attribute already in variable structure
+      il_ind=0
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         il_ind=att_get_index( td_var%t_att(:), td_att%c_name )
+      ENDIF
+
+      IF( il_ind == 0 )THEN
+
+         CALL logger_debug( &
+         &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+
+      ELSE
+         
+         CALL logger_trace( &
+         &  " VAR DEL ATT: del attribute "//TRIM(td_att%c_name)//&
+         &  ", in var "//TRIM(td_var%c_name) )
+
+         IF( td_var%i_natt == 1 )THEN
+
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE(td_var%t_att)
+
+            ! new number of attribute in variable
+            td_var%i_natt=td_var%i_natt-1
+
+         ELSE
+            ALLOCATE( tl_att(td_var%i_natt-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes from "//&
+               &  TRIM(td_var%c_name)//" in temporary attribute structure")
+
+            ELSE
+
+               ! save temporary global attribute's variable structure
+               tl_att(1:il_ind-1)=att_copy(td_var%t_att(1:il_ind-1))
+               IF( il_ind < td_var%i_natt )THEN
+                  tl_att(il_ind:)=att_copy(td_var%t_att(il_ind+1:))
+               ENDIF
+
+               CALL att_clean(td_var%t_att(:))
+               DEALLOCATE( td_var%t_att )
+
+               ! new number of attribute in variable
+               td_var%i_natt=td_var%i_natt-1
+
+               ALLOCATE( td_var%t_att(td_var%i_natt), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " VAR ADD ATT: not enough space to put attributes "//&
+                  &  "in variable structure "//TRIM(td_var%c_name) )
+
+               ENDIF
+
+               ! copy attribute in variable before
+               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
+
+               ! clean
+               CALL att_clean(tl_att(:))
+               DEALLOCATE(tl_att)
+            ENDIF 
+         ENDIF
+
+         ! highlight attribute
+         SELECT CASE( TRIM(td_att%c_name) )
+
+            CASE("add_offset")
+               td_var%d_ofs = 0._dp
+            CASE("scale_factor")
+               td_var%d_scf = 1._dp
+            CASE("_FillValue")
+               td_var%d_fill = 0._dp
+            CASE("ew_overlap")
+               td_var%i_ew = -1 
+            CASE("standard_name")
+               td_var%c_stdname = ''
+            CASE("long_name")
+               td_var%c_longname = ''
+            CASE("units")
+               td_var%c_units = ''
+            CASE("grid_point")
+               td_var%c_point = ''
+
+         END SELECT
+
+      ENDIF
+
+   END SUBROUTINE var__del_att_str
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move an attribute structure 
+   !> from variable structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    attribute structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_move_att(td_var, td_att)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+
+      !----------------------------------------------------------------
+      ! copy attribute
+      tl_att=att_copy(td_att)
+
+      ! remove attribute with same name
+      CALL var_del_att(td_var, tl_att)
+
+      ! add new attribute
+      CALL var_add_att(td_var, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE var_move_att
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add an array of dimension structure in a variable 
+   !> structure.
+   !> - number of dimension in variable can't be greater than 4
+   !> - dimension can't be already uses in variable structure
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_dim_arr(td_var, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),               INTENT(INOUT) :: td_var
+      TYPE(TDIM), DIMENSION(:), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ndim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_ndim=SIZE(td_dim(:))
+      IF( il_ndim <= ip_maxdim )THEN
+
+         DO ji=1,il_ndim
+            CALL var_add_dim(td_var, td_dim(ji))
+         ENDDO
+
+      ELSE
+         CALL logger_error( &
+         &  " VAR ADD DIM: too much dimension to put in structure "//&
+         &  "("//TRIM(fct_str(il_ndim))//")" )
+      ENDIF
+
+   END SUBROUTINE var__add_dim_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add one dimension in a variable 
+   !> structure.
+   !> @details
+   !> - number of dimension in variable can't be greater than 4
+   !> - dimension can't be already uses in variable structure 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_dim_unit(td_var, td_dim) 
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      !----------------------------------------------------------------
+
+      IF( td_var%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already used in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+         IF( il_ind == 0 )THEN
+            CALL logger_warn( &
+            &  " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", will not be added in variable "//TRIM(td_var%c_name) )
+         ELSEIF( td_var%t_dim(il_ind)%l_use )THEN
+            CALL logger_error( &
+            &  " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", already used in variable "//TRIM(td_var%c_name) )
+         ELSE
+
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_var%t_dim(:))
+
+            ! add new dimension
+            td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim)
+
+            ! update number of attribute
+            td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use)
+
+         ENDIF
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_var%t_dim(:))
+
+      ELSE
+         CALL logger_error( &
+         &  " VAR ADD DIM: too much dimension in variable "//&
+         &  TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE var__add_dim_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a dimension structure in a variable 
+   !> structure.
+   !
+   !> @warning delete variable value too.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_del_dim(td_var, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+
+      TYPE(TDIM)  :: tl_dim ! empty dimension structure
+
+      !----------------------------------------------------------------
+
+      IF( td_var%i_ndim <= ip_maxdim )THEN
+
+         CALL logger_trace( &
+         &  " VAR DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
+         &  ", short name "//TRIM(td_dim%c_sname)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+         
+         ! check if dimension already in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+
+         ! replace dimension by empty one
+         td_var%t_dim(il_ind)=dim_copy(tl_dim)
+
+         ! update number of dimension
+         td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use)
+
+         ! remove variable value using this dimension
+         IF( ASSOCIATED(td_var%d_value) )THEN
+            il_shape(:)=SHAPE(td_var%d_value(:,:,:,:))
+            IF(il_shape(il_ind)/=td_dim%i_len)THEN
+               CALL logger_warn("VAR DEL DIM: remove value of variable "//&
+               &  TRIM(td_var%c_name) )
+               CALL var_del_value(td_var)
+            ENDIF
+         ENDIF
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_var%t_dim)
+
+      ELSE
+         CALL logger_error( &
+         &  " VAR DEL DIM: too much dimension in variable "//&
+         &  TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE var_del_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a dimension structure 
+   !> in variable structure.
+   !>
+   !> @warning 
+   !> - dimension order could be changed
+   !> - delete variable value 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_move_dim(td_var, td_dim)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      IF( td_var%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_var%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            il_dimid=td_var%t_dim(il_ind)%i_id
+            ! replace dimension
+            td_var%t_dim(il_ind)=dim_copy(td_dim)
+            td_var%t_dim(il_ind)%i_id=il_dimid
+            td_var%t_dim(il_ind)%l_use=.TRUE.
+
+         ELSE
+            CALL var_add_dim(td_var, td_dim)
+         ENDIF
+
+      ELSE
+         CALL logger_error( &
+         &  "VAR MOVE DIM: too much dimension in variale "//&
+         &  TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE var_move_dim
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print informations of an array of variables. 
+   !>
+   !> @author J.Paul
+   !> @date June, 2014 - Initial Version
+   !
+   !> @param[in] td_var array of variables structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__print_arr(td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_var(:))
+         CALL var_print(td_var(ji))
+      ENDDO
+
+   END SUBROUTINE var__print_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print variable information.</br/>
+   !> @details
+   !> If ld_more is TRUE (default), print information about variable dimensions
+   !> and variable attributes.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var    variable structure
+   !> @param[in] ld_more   print more infomration about variable
+   !-------------------------------------------------------------------
+   SUBROUTINE var__print_unit(td_var, ld_more)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+      LOGICAL,    INTENT(IN), OPTIONAL :: ld_more
+
+      ! local vairbale
+      CHARACTER(LEN=lc) :: cl_type
+      REAL(dp)          :: dl_min
+      REAL(dp)          :: dl_max
+      LOGICAL           :: ll_more
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ll_more=.TRUE.
+      IF( PRESENT(ld_more) )THEN
+         ll_more=ld_more
+      ENDIF
+
+      SELECT CASE( td_var%i_type )
+
+         CASE(NF90_CHAR)
+            cl_type='CHAR'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE DEFAULT
+            !cl_type='unknown'
+            cl_type=''
+      END SELECT      
+
+      WRITE(*,'((/a,a),4(/3x,a,a),4(/3x,a,i3),&
+      &         (/3x,a,a),3(/3x,a,ES12.4))')&
+      &        " Variable : ",TRIM(td_var%c_name),    &
+      &        " standard name : ",TRIM(td_var%c_stdname), &
+      &        " long name     : ",TRIM(td_var%c_longname), &
+      &        " units         : ",TRIM(td_var%c_units),   &
+      &        " point         : ",TRIM(td_var%c_point),   &
+      &        " id            : ",td_var%i_id,            &
+      &        " rec           : ",td_var%i_rec,           &
+      &        " ndim          : ",td_var%i_ndim,          &
+      &        " natt          : ",td_var%i_natt,          &
+      &        " type          : ",TRIM(cl_type),          &
+      &        " scale factor  : ",td_var%d_scf,           &
+      &        " add offset    : ",td_var%d_ofs,           &
+      &        " _FillValue    : ",td_var%d_fill
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         dl_min=MINVAL(td_var%d_value(:,:,:,:), &
+         &             mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )&
+         &      *td_var%d_scf+td_var%d_ofs
+         dl_max=MAXVAL(td_var%d_value(:,:,:,:), &
+         &             mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )&
+         &      *td_var%d_scf+td_var%d_ofs
+
+         WRITE(*,'((3x,a),2(/3x,a,ES12.4))')&
+         &        "VALUE ASSOCIATED" ,       &
+         &        " min value     : ",dl_min,&        
+         &        " max value     : ",dl_max
+      ENDIF      
+
+      IF( ll_more )THEN
+         ! print dimension
+         IF(  td_var%i_ndim /= 0 )THEN
+            WRITE(*,'(a)') " Variable dimension"
+            DO ji=1,ip_maxdim
+               IF( td_var%t_dim(ji)%l_use )THEN
+                  CALL dim_print(td_var%t_dim(ji))
+               ENDIF
+            ENDDO
+         ENDIF
+
+         ! print attribute
+         IF( td_var%i_natt /= 0 )THEN
+            WRITE(*,'(a)') " Variable attribute"
+            DO ji=1,td_var%i_natt
+               CALL att_print(td_var%t_att(ji))
+            ENDDO
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE var__print_unit
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of real(8) value in a variable 
+   !> structure.
+   !
+   !> @details 
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. 
+   !> @warning Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] dd_value  array of variable value
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value(td_var, dd_value, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      REAL(dp),    DIMENSION(:,:,:,:),   INTENT(IN)    :: dd_value
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check id_count and id_start optionals parameters...
+      IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
+          ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
+         CALL logger_warn( &
+         &  " VAR ADD VALUE: id_start and id_count should be both specified")
+      ENDIF
+
+      IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
+
+         ! keep ordered array ('x','y','z','t')
+         il_start(:)=id_start(:)
+         il_count(:)=id_count(:)
+
+      ELSE
+
+         ! keep ordered array ('x','y','z','t')
+         il_start(:)=(/1,1,1,1/)
+         il_count(:)=td_var%t_dim(:)%i_len
+
+      ENDIF
+
+      ! check dimension of input array
+      il_shape(:)=SHAPE(dd_value(:,:,:,:))
+      IF(.NOT.ALL( il_count(:) == il_shape(:)) )THEN
+
+         CALL logger_debug(" ADD VALUE: check dimension order !!")
+         DO ji = 1, ip_maxdim
+            CALL logger_debug( &
+            &  " VAR ADD VALUE: count : "//TRIM(fct_str(il_count(ji)))//&
+            &  " array dimension : "//TRIM(fct_str(il_shape(ji))))
+         ENDDO
+         CALL logger_error( &
+         &  " VAR ADD VALUE: dimension of input array, and count array differ " )
+
+      ELSE
+
+         ! check dimension of variable
+         IF(.NOT.ALL(il_start(:)+il_count(:)-1 <= td_var%t_dim(:)%i_len) )THEN
+
+            CALL logger_debug(" VAR ADD VALUE: check dimension order !!")
+            DO ji = 1, ip_maxdim
+               CALL logger_debug( &
+               &  " VAR ADD VALUE: start ("//TRIM(fct_str(il_start(ji)))//") "//&
+               &  "+ count ("//TRIM(fct_str(il_count(ji)))//") "//&
+               &  "variable dimension "//TRIM(fct_str(td_var%t_dim(ji)%i_len)))
+            ENDDO
+
+            CALL logger_error( &
+            &  " VAR ADD VALUE: start + count exceed variable dimension bound. " )
+         ELSE
+
+            ! special case for scalar variable
+            IF( td_var%i_ndim == 0 )THEN
+               ! reorder dimension to ('x','y','z','t')
+               CALL dim_reorder(td_var%t_dim)
+            ENDIF
+
+            IF( ASSOCIATED(td_var%d_value) )THEN
+
+               CALL logger_warn( &
+               &  "VAR ADD VALUE: value already in variable "//&
+               &  TRIM(td_var%c_name)//&
+               &  " (standard name "//TRIM(td_var%c_stdname)//")" )
+
+            ELSE
+
+               ! Allocate space to hold variable value in structure
+               ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, &
+               &                        td_var%t_dim(2)%i_len, &
+               &                        td_var%t_dim(3)%i_len, &
+               &                        td_var%t_dim(4)%i_len),&
+               &        stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                 CALL logger_error( &
+                  &  " VAR ADD VALUE: not enough space to put variable "//&
+                  &  TRIM(td_var%c_name)//&
+                  &  " in variable structure")
+
+               ENDIF
+               
+               ! initialise array
+               CALL logger_trace( &
+               &  " VAR ADD VALUE: value in variable "//TRIM(td_var%c_name)//&
+               &  ", initialise to FillValue "//TRIM(fct_str(td_var%d_fill)) )
+               td_var%d_value(:,:,:,:)=td_var%d_fill
+
+            ENDIF
+
+            CALL logger_debug( &
+            &  " VAR ADD VALUE: put value in variable "//TRIM(td_var%c_name)//&
+            &  " (standard name "//TRIM(td_var%c_stdname)//")" )
+
+            ! put value in variable structure
+            td_var%d_value( il_start(1):il_start(1)+il_count(1)-1, &
+            &               il_start(2):il_start(2)+il_count(2)-1, &
+            &               il_start(3):il_start(3)+il_count(3)-1, &
+            &               il_start(4):il_start(4)+il_count(4)-1 ) = dd_value(:,:,:,:)
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE var__add_value
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of real(8) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default real(8)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] dd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default real(8)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be written
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value_dp(td_var, dd_value, id_type, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      REAL(dp),    DIMENSION(:,:,:,:),   INTENT(IN)    :: dd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_type
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      CALL var__add_value(td_var, dd_value, id_start, id_count)
+
+   END SUBROUTINE var__add_value_dp
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of real(4) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default real(4)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] rd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default real(4)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be written
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value_rp(td_var, rd_value, id_type, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      REAL(sp),    DIMENSION(:,:,:,:),   INTENT(IN)    :: rd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF      
+
+      il_shape=SHAPE(rd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      dl_value(:,:,:,:)=REAL(rd_value(:,:,:,:), dp)
+      
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_rp
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(1) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(1)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @note variable type is forced to BYTE
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variabele structure
+   !> @param[in] bd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(1)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value_i1(td_var, bd_value, id_type, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i1), DIMENSION(:,:,:,:),   INTENT(IN)    :: bd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(bd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      dl_value(:,:,:,:)=REAL(bd_value(:,:,:,:),dp)      
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i1
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(2) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(2)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @note variable type is forced to SHORT
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variabele structure
+   !> @param[in] sd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(2)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value_i2(td_var, sd_value, id_type, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i2), DIMENSION(:,:,:,:),   INTENT(IN)    :: sd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(sd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      dl_value(:,:,:,:)=REAL(sd_value(:,:,:,:),dp)      
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i2
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(4) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(4)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @note variable type is forced to INT
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variabele structure
+   !> @param[in] id_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(4)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value_i4(td_var, id_value, id_type, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:,:,:,:),   INTENT(IN)    :: id_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(id_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      dl_value(:,:,:,:)=REAL(id_value(:,:,:,:),dp)      
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i4
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(8) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(4)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] kd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(8)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+   SUBROUTINE var__add_value_i8(td_var, kd_value, id_type, id_start, id_count)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i8), DIMENSION(:,:,:,:),   INTENT(IN)    :: kd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(kd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      dl_value(:,:,:,:)=REAL(kd_value(:,:,:,:),dp)
+
+      CALL var__add_value(td_var, dl_value, id_start, id_count)
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i8
+   !-------------------------------------------------------------------
+   !> @brief This subroutine remove variable value in a variable 
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_del_value(td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      !----------------------------------------------------------------
+      CALL logger_debug( &
+      &  " VAR DEL VALUE: value in variable "//TRIM(td_var%c_name)//&
+      &  ", standard name "//TRIM(td_var%c_stdname)//&
+      &  " will be remove ")
+
+      DEALLOCATE(td_var%d_value)
+
+   END SUBROUTINE var_del_value
+   !-------------------------------------------------------------------
+   !> @brief This function return the variable index, in a array of variable
+   !> structure,  given variable name or standard name. 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] td_var       array of variable structure
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_stdname   variable standard name
+   !> @return variable index in array of variable structure (0 if not found)
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION var_get_index(td_var, cd_name, cd_stdname)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , DIMENSION(:), INTENT(IN) :: td_var
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_stdname
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      var_get_index=0
+      il_size=SIZE(td_var(:))
+
+      ! check if variable is in array of variable structure
+      DO ji=1,il_size
+
+         ! look for variable name
+         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN
+         
+            var_get_index=ji
+            EXIT
+
+         ! look for variable standard name
+         ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
+         &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+            var_get_index=ji
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN 
+
+            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.&
+            &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+               var_get_index=ji
+               EXIT
+            ENDIF
+
+         ENDIF
+
+         ! look for variable longname
+         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&
+         &   TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+            var_get_index=ji
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN
+
+            IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.&
+            &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+               var_get_index=ji
+               EXIT
+            ENDIF
+
+         ENDIF
+
+      ENDDO
+
+   END FUNCTION var_get_index
+   !-------------------------------------------------------------------
+   !> @brief This function return the variable id, 
+   !> given variable name or standard name. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - check long name
+   !
+   !> @param[in] td_var       array of variable structure
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_stdname   variable standard name
+   !> @return variable id in array of variable structure (0 if not found)
+   !-------------------------------------------------------------------
+   INTEGER(i4) FUNCTION var_get_id(td_var, cd_name, cd_stdname)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , DIMENSION(:), INTENT(IN) :: td_var
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_stdname
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      var_get_id=0
+      il_size=SIZE(td_var(:))
+
+      ! check if variable is in array of variable structure
+      DO ji=1,il_size
+      
+         ! look for variable name
+         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN
+         
+            var_get_id=td_var(ji)%i_id
+            EXIT
+
+         ! look for variable standard name
+         ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
+         &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+            var_get_id=td_var(ji)%i_id
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN
+
+            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.&
+            &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+               var_get_id=td_var(ji)%i_id
+               EXIT
+            ENDIF
+
+         ENDIF
+
+         ! look for variable long name
+         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&
+         &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+            var_get_id=td_var(ji)%i_id
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN 
+
+            IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.&
+            &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+               var_get_id=td_var(ji)%i_id
+               EXIT
+            ENDIF
+
+         ENDIF
+
+      ENDDO
+
+   END FUNCTION var_get_id
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function return the mask 3D of variable, given variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var array of variable structure
+   !> @return variable mask(3D)
+   !-------------------------------------------------------------------
+   FUNCTION var_get_mask(td_var)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
+      &                      td_var%t_dim(2)%i_len, &
+      &                      td_var%t_dim(3)%i_len ) :: var_get_mask
+
+      ! local variable
+      !----------------------------------------------------------------
+      IF( ASSOCIATED(td_var%d_value) )THEN
+
+         CALL logger_debug( "VAR GET MASK: create mask from variable "//&
+         &               TRIM(td_var%c_name)//", FillValue ="//&
+         &               TRIM(fct_str(td_var%d_fill)))
+         var_get_mask(:,:,:)=1
+         WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill )
+            var_get_mask(:,:,:)=0
+         ENDWHERE
+
+      ELSE
+         CALL logger_error("VAR GET MASK: variable value not define.")
+      ENDIF
+   END FUNCTION var_get_mask
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine change FillValue of the variable to 
+   !> standard NETCDF FillValue. 
+   !>
+   !> @details
+   !> optionally, you could specify a dummy _FillValue to be used
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var array of variable structure
+   !> @param[in] dd_fill _FillValue to be used
+   !-------------------------------------------------------------------
+   SUBROUTINE var_chg_FillValue(td_var, dd_fill)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      REAL(dp)  , INTENT(IN)   , OPTIONAL :: dd_fill
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+
+      INTEGER(i1) :: bl_fill
+      INTEGER(i2) :: sl_fill
+      INTEGER(i4) :: il_fill
+      REAL(sp)    :: rl_fill
+      !----------------------------------------------------------------
+
+      CALL logger_trace( "VAR CHG FILL VALUE: change _FillValue in variable "//&
+      &  TRIM(td_var%c_name) )
+
+      ! define attribute FillValue
+      SELECT CASE( td_var%i_type )
+
+         CASE(NF90_BYTE)
+            IF( PRESENT(dd_fill) )THEN
+               bl_fill=INT(dd_fill,i1)
+               tl_att=att_init('_FillValue',bl_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_BYTE)
+            ENDIF
+         CASE(NF90_SHORT)
+            IF( PRESENT(dd_fill) )THEN
+               sl_fill=INT(dd_fill,i2)
+               tl_att=att_init('_FillValue',sl_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_SHORT)
+            ENDIF
+         CASE(NF90_INT)
+            IF( PRESENT(dd_fill) )THEN
+               il_fill=INT(dd_fill,i4)
+               tl_att=att_init('_FillValue',il_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_INT)
+            ENDIF
+         CASE(NF90_FLOAT)
+            IF( PRESENT(dd_fill) )THEN
+               rl_fill=REAL(dd_fill,sp)
+               tl_att=att_init('_FillValue',rl_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_FLOAT)
+            ENDIF
+         CASE DEFAULT ! NF90_DOUBLE
+            IF( PRESENT(dd_fill) )THEN
+               tl_att=att_init('_FillValue',dd_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
+            ENDIF
+
+      END SELECT
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ! change FillValue in variable value
+         WHERE( td_var%d_value(:,:,:,:) == td_var%d_fill )
+            td_var%d_value(:,:,:,:)=tl_att%d_value(1)
+         END WHERE
+      ENDIF
+
+      ! change attribute _FillValue
+      CALL var_move_att(td_var, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE var_chg_FillValue
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine read variable configuration file. And save 
+   !> global array of variable structure with extra information: tg_varextra.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - new namelist format to get extra information (interpolation,...)
+   !
+   !> @param[in] cd_file   configuration file of variable
+   !-------------------------------------------------------------------
+   SUBROUTINE var_def_extra( cd_file )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_line
+      CHARACTER(LEN=lc) :: cl_interp
+
+      INTEGER(i4)       :: il_nvar
+      INTEGER(i4)       :: il_fileid
+      INTEGER(i4)       :: il_status
+
+      LOGICAL           :: ll_exist
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+         CALL var_clean(tg_varextra(:))
+         DEALLOCATE(tg_varextra)
+      ENDIF
+
+      ! read config variable file
+      INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         
+         ! get number of variable to be read
+
+         il_fileid=fct_getunit()
+         OPEN( il_fileid, FILE=TRIM(cd_file), &
+         &                FORM='FORMATTED',   &
+         &                ACCESS='SEQUENTIAL',&
+         &                STATUS='OLD',       &
+         &                ACTION='READ',      &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("VAR DEF EXTRA: can not open file "//&
+            &                 TRIM(cd_file))
+         ENDIF
+
+         ! read file
+         READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+         cl_line=TRIM(ADJUSTL(cl_line))
+         il_nvar=0
+         DO WHILE( il_status == 0 )
+
+         ! search line not beginning with comment character
+            IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
+               il_nvar=il_nvar+1
+            ENDIF
+            
+            READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+            cl_line=TRIM(ADJUSTL(cl_line))
+         ENDDO
+
+         IF( il_nvar <= 0 )THEN
+            CALL logger_warn("VAR DEF EXTRA: no variable to be read")
+
+            CLOSE( il_fileid, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VAR DEF EXTRA: closing file "//TRIM(cd_file))
+            ENDIF
+
+         ELSE
+            CALL logger_info("VAR DEF EXTRA: "//TRIM(fct_str(il_nvar))//&
+            &            " variable to be read on varaible config file"//&
+            &            TRIM(cd_file))
+
+            CALL logger_trace("VAR DEF EXTRA: rewind "//TRIM(cd_file))
+            REWIND( il_fileid, IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file))
+            ENDIF
+
+            ALLOCATE( tg_varextra(il_nvar) )
+
+            ! read file
+            READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+            cl_line=TRIM(ADJUSTL(cl_line))
+            ji=1
+            DO WHILE( il_status == 0 )
+
+               IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
+                  tg_varextra(ji)%i_id      = ji
+                  tg_varextra(ji)%c_name    =TRIM(fct_split(cl_line,1))
+                  tg_varextra(ji)%c_units   =TRIM(fct_split(cl_line,2))
+                  tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3))
+                  tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4))
+
+                  cl_interp='int='//TRIM(fct_split(cl_line,5))
+                  tg_varextra(ji)%c_interp(:) = &
+                  &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp)
+                  CALL logger_debug("VAR DEF EXTRA: "//&
+                  &  TRIM(tg_varextra(ji)%c_name)//&
+                  &  " "//TRIM(tg_varextra(ji)%c_interp(1)))
+
+                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
+                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7))
+               ELSE
+                  ji=ji-1
+               ENDIF
+               
+               READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+               cl_line=TRIM(ADJUSTL(cl_line))
+               ji=ji+1
+            ENDDO
+
+            CLOSE( il_fileid, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VAR DEF EXTRA: closing file "//TRIM(cd_file))
+            ENDIF
+         ENDIF
+
+      ELSE
+
+         CALL logger_error("VAR DEF EXTRA: can't find file "//TRIM(cd_file))
+
+      ENDIF      
+
+   END SUBROUTINE var_def_extra
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add variable information get from namelist in 
+   !> global array of variable structure with extra information: tg_varextra.
+   !> 
+   !> @details 
+   !> string character format must be : <br/>
+   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/>
+   !> you could specify only interpolation, filter or extrapolation method, 
+   !> whatever the order. you could find more
+   !> information about available method in \ref interp, \ref filter, and
+   !> \ref extrap module.<br/>
+   !> Examples: 
+   !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.'
+   !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.'
+   !>
+   !>
+   !> @warning variable should be define in tg_varextra (ie in configuration
+   !> file, to be able to add information from namelist
+   !>
+   !> @note If you do not specify a method which is required, default one is
+   !> apply.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - get unit and unit factor (to change unit) 
+   !
+   !> @param[in] cd_varinfo   variable information from namelist
+   !-------------------------------------------------------------------
+   SUBROUTINE var_chg_extra( cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varinfo
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_name
+      CHARACTER(LEN=lc)                            :: cl_method
+      CHARACTER(LEN=lc), DIMENSION(2)              :: cl_interp
+      CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap
+      CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter
+      CHARACTER(LEN=lc)                            :: cl_unt
+
+      INTEGER(i4)                                  :: il_ind
+      INTEGER(i4)                                  :: il_nvar
+
+      REAL(dp)                                     :: dl_min
+      REAL(dp)                                     :: dl_max
+      REAL(dp)                                     :: dl_unf
+
+      TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+         ji=1
+         DO WHILE( TRIM(cd_varinfo(ji)) /= '' )
+
+            cl_name  =fct_lower(fct_split(cd_varinfo(ji),1,':'))
+            cl_method=fct_split(cd_varinfo(ji),2,':')
+
+            dl_min=var__get_min(cl_name, cl_method)
+            dl_max=var__get_max(cl_name, cl_method)
+            dl_unf=var__get_unf(cl_name, cl_method)
+            cl_interp(:)=var__get_interp(cl_name, cl_method)
+            cl_extrap(:)=var__get_extrap(cl_name, cl_method)
+            cl_filter(:)=var__get_filter(cl_name, cl_method)
+            cl_unt=var__get_unt(cl_name, cl_method)
+
+
+            il_ind=var_get_index(tg_varextra(:), TRIM(cl_name))
+            IF( il_ind /= 0 )THEN
+               IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min
+               IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max
+               IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf
+               IF(cl_unt      /='') tg_varextra(il_ind)%c_unt      =cl_unt
+               IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:)
+               IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:)
+               IF(cl_filter(1)/='') tg_varextra(il_ind)%c_filter(:)=cl_filter(:)
+            ELSE
+
+               IF( ALLOCATED(tg_varextra) )THEN
+                  il_nvar=SIZE(tg_varextra(:))
+                  ! save older variable
+                  ALLOCATE( tl_varextra(il_nvar) )
+                  tl_varextra(:)=var_copy(tg_varextra(:))
+
+                  CALL var_clean(tg_varextra(:))
+                  DEALLOCATE(tg_varextra)
+                  ALLOCATE( tg_varextra(il_nvar+1) )
+                  
+                  tg_varextra(1:il_nvar)=var_copy(tl_varextra(:))
+
+                  ! clean
+                  CALL var_clean(tl_varextra(:))
+                  DEALLOCATE(tl_varextra)
+
+               ELSE
+
+                  il_nvar=0
+                  ALLOCATE( tg_varextra(1) )
+
+               ENDIF
+
+               ! add new variable
+               il_ind=il_nvar+1
+               tg_varextra(il_ind)=var_init( TRIM(cl_name), &
+               &                               cd_interp=cl_interp(:), &
+               &                               cd_extrap=cl_extrap(:), &
+               &                               cd_filter=cl_filter(:), &
+               &                               dd_min = dl_min, &
+               &                               dd_max = dl_max, &
+               &                               cd_unt = cl_unt, &
+               &                               dd_unf = dl_unf )
+
+            ENDIF
+
+            ji=ji+1
+            CALL logger_debug( "VAR CHG EXTRA: name       "//&
+            &                  TRIM(tg_varextra(il_ind)%c_name) )
+            CALL logger_debug( "VAR CHG EXTRA: interp     "//&
+            &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )         
+            CALL logger_debug( "VAR CHG EXTRA: filter     "//&
+            &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )         
+            CALL logger_debug( "VAR CHG EXTRA: extrap     "//&
+            &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) )
+            IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN
+               CALL logger_debug( "VAR CHG EXTRA: min value  "//&
+               &                  TRIM(fct_str(tg_varextra(il_ind)%d_min)) )
+            ENDIF
+            IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN
+               CALL logger_debug( "VAR CHG EXTRA: max value  "//&
+               &                  TRIM(fct_str(tg_varextra(il_ind)%d_max)) )
+            ENDIF
+            IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new unit  "//&
+               &                  TRIM(tg_varextra(il_ind)%c_unt) )
+            ENDIF
+            IF( tg_varextra(il_ind)%d_unf /= 1. )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new unit factor  "//&
+               &                  TRIM(fct_str(tg_varextra(il_ind)%d_unf)) )
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE var_chg_extra
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine clean global array of variable structure 
+   !> with extra information: tg_varextra.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2016 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE var_clean_extra( )
+      IMPLICIT NONE
+      ! Argument
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_varextra(:))
+      DEALLOCATE(tg_varextra)
+
+   END SUBROUTINE var_clean_extra
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine read matrix value from character string in namelist
+   !> and fill variable structure value.
+   !>
+   !> @details
+   !> to split matrix, separator use are:<br/>
+   !> - ',' for line
+   !> - '/' for row
+   !> - '\' for level<br/>
+   !> Example:<br/>
+   !> 3,2,3/1,4,5  => 
+   !> @f$ \left( \begin{array}{ccc}
+   !> 3 & 2 & 3 \\
+   !> 1 & 4 & 5 \end{array} \right) @f$
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !> @param[in] cd_matrix matrix value
+   !-------------------------------------------------------------------
+   SUBROUTINE var_read_matrix(td_var, cd_matrix)
+      IMPLICIT NONE
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_matrix
+
+      ! local variable
+      CHARACTER(LEN=lc)                                  :: cl_array
+      CHARACTER(LEN=lc)                                  :: cl_line
+      CHARACTER(LEN=lc)                                  :: cl_elt
+
+      REAL(dp)         , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_matrix
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(:)      , ALLOCATABLE :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk      
+      !----------------------------------------------------------------
+
+      IF( TRIM(cd_matrix) == '' )THEN
+         CALL logger_debug("VAR READ MATRIX: no matrix to be read")
+      ELSE
+
+         !1- read matrix
+         ALLOCATE( dl_matrix(ip_maxmtx, ip_maxmtx, ip_maxmtx) )
+         dl_matrix(:,:,:)=td_var%d_fill
+
+         jk=1
+         cl_array=fct_split(TRIM(cd_matrix),jk,'\ ')
+         CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) )
+         DO WHILE( TRIM(cl_array) /= '' )
+            jj=1
+            cl_line=fct_split(TRIM(cl_array),jj,'/')
+            CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
+            DO WHILE( TRIM(cl_line) /= '' )
+               ji=1
+               cl_elt=fct_split(TRIM(cl_line),ji,',')
+               CALL logger_debug("VAR MATRIX elt "//TRIM(cl_elt) )
+               DO WHILE( TRIM(cl_elt) /= '') 
+                  READ(cl_elt,*) dl_matrix(ji,jj,jk)
+                  ji=ji+1
+                  cl_elt=fct_split(TRIM(cl_line),ji,',')
+                  CALL logger_debug("VAR MATRIX elt "//TRIM(cl_elt) )
+               ENDDO
+               jj=jj+1
+               cl_line=fct_split(TRIM(cl_array),jj,'/')
+               CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
+            ENDDO
+            jk=jk+1
+            cl_array=fct_split(TRIM(cd_matrix),jk,'\ ')
+            CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) )
+         ENDDO
+
+         ! save useful value
+         ALLOCATE( dl_value(ji-1,jj-1,jk-1,1) )
+         dl_value(:,:,:,1)=dl_matrix(1:ji-1,1:jj-1,1:jk-1)
+
+         DEALLOCATE(dl_matrix)
+
+         ALLOCATE( tl_dim(3) )
+
+         IF( ji-1 > 0 ) tl_dim(1)=dim_init('x',ji-1)
+         IF( jj-1 > 0 ) tl_dim(2)=dim_init('y',jj-1)
+         IF( jk-1 > 0 ) tl_dim(3)=dim_init('z',jk-1)
+         
+         CALL var_add_dim(td_var, tl_dim(:))
+         ! clean
+         CALL dim_clean(tl_dim)
+         DEALLOCATE( tl_dim )
+
+         IF( ASSOCIATED(td_var%d_value) ) DEALLOCATE(td_var%d_value)
+         CALL var_add_value(td_var, dl_value(:,:,:,:), id_type=NF90_FLOAT)
+
+         DEALLOCATE( dl_value )
+      ENDIF
+
+   END SUBROUTINE var_read_matrix
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add extra information in variable structure.
+   !> 
+   !> @details 
+   !> if variable name is informed in global array of variable structure (tg_varextra).
+   !> fill empty parameter on variable structure.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var__get_extra( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      INTEGER(i4)       :: il_ind
+      
+      TYPE(TATT)        :: tl_att
+
+      ! loop indices
+      INTEGER(i4)       :: ji
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+
+         il_ind=var_get_index( tg_varextra(:), TRIM(td_var%c_name),  &
+                                               TRIM(td_var%c_stdname))
+         IF( il_ind /= 0 )THEN
+
+            ! name
+            IF( TRIM(td_var%c_name) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_name) /= '' )THEN
+               td_var%c_name=TRIM(tg_varextra(il_ind)%c_name)
+            ENDIF
+
+            ! standard name
+            IF( TRIM(tg_varextra(il_ind)%c_stdname) /= '' .AND. &
+            &   ( TRIM(td_var%c_stdname) == '' .OR. &
+            &     TRIM(tg_varextra(il_ind)%c_stdname) /= &
+            &     TRIM(td_var%c_stdname) ) )THEN
+               td_var%c_stdname=TRIM(tg_varextra(il_ind)%c_stdname)
+               ! create attibute
+               tl_att=att_init('standard_name',TRIM(td_var%c_stdname))
+               CALL var_move_att(td_var, tl_att)
+            ENDIF
+
+            ! long_name
+            IF( TRIM(tg_varextra(il_ind)%c_longname) /= '' .AND. &
+            &   ( TRIM(td_var%c_longname) == '' .OR. &
+            &     TRIM(tg_varextra(il_ind)%c_longname) /= &
+            &     TRIM(td_var%c_longname) ) )THEN
+               td_var%c_longname=TRIM(tg_varextra(il_ind)%c_longname)
+               ! create attibute
+               tl_att=att_init('long_name',TRIM(td_var%c_longname))
+               CALL var_move_att(td_var, tl_att)               
+            ENDIF
+
+            ! units
+            IF( TRIM(td_var%c_units) == '' .AND. & 
+            &   TRIM(tg_varextra(il_ind)%c_units) /= '' )THEN
+               td_var%c_units=TRIM(tg_varextra(il_ind)%c_units)
+               ! create attibute
+               tl_att=att_init('units',TRIM(td_var%c_units))
+               CALL var_move_att(td_var, tl_att)               
+            ENDIF
+
+            ! axis
+            IF( TRIM(tg_varextra(il_ind)%c_axis) /= '' .AND. &
+            &   ( TRIM(td_var%c_axis) == '' .OR. & 
+            &     TRIM(tg_varextra(il_ind)%c_axis) /= &
+            &     TRIM(td_var%c_axis) ) )THEN
+               td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis)
+               ! create attibute
+               IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN
+                  tl_att=att_init('axis',TRIM(td_var%c_axis))
+               ELSE
+                  cl_tmp=""
+                  DO ji=LEN(TRIM(td_var%c_axis)),1,-1
+                     cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji))
+                  ENDDO
+                  tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp)))
+               ENDIF
+               CALL var_move_att(td_var, tl_att)
+            ENDIF
+
+            ! grid point
+            IF( TRIM(tg_varextra(il_ind)%c_point) /= '' .AND. &
+            &   ( TRIM(td_var%c_point) == '' .OR. &
+            &     TRIM(tg_varextra(il_ind)%c_point) /= &
+            &     TRIM(td_var%c_point) ) )THEN
+               td_var%c_point=TRIM(tg_varextra(il_ind)%c_point)
+            ELSE
+               IF( TRIM(td_var%c_point) == '' )THEN
+                  CALL logger_warn("VAR GET EXTRA: unknown grid point "//&
+                  &  "for variable "//TRIM(td_var%c_name)//&
+                  &  ". assume it is a T-point.")
+                  td_var%c_point='T'
+               ENDIF
+            ENDIF
+            ! create attibute
+            tl_att=att_init('grid_point',TRIM(td_var%c_point))
+            CALL var_move_att(td_var, tl_att)               
+
+            ! clean
+            CALL att_clean(tl_att)
+
+            ! interp
+            IF( TRIM(td_var%c_interp(1)) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_interp(1)) /= '' )THEN
+               td_var%c_interp(:)=tg_varextra(il_ind)%c_interp(:)
+            ENDIF
+
+            ! extrap
+            IF( TRIM(td_var%c_extrap(1)) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_extrap(1)) /= '' )THEN
+               td_var%c_extrap(:)=tg_varextra(il_ind)%c_extrap(:)
+            ENDIF
+
+            ! filter
+            IF( TRIM(td_var%c_filter(1)) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_filter(1)) /= '' )THEN
+               td_var%c_filter(:)=tg_varextra(il_ind)%c_filter(:)
+            ENDIF            
+
+            ! min value
+            IF( td_var%d_min == dp_fill .AND. &
+            &   tg_varextra(il_ind)%d_min /= dp_fill )THEN
+               td_var%d_min=tg_varextra(il_ind)%d_min
+            ENDIF
+
+            ! max value
+            IF( td_var%d_max == dp_fill .AND. &
+            &   tg_varextra(il_ind)%d_max /= dp_fill )THEN
+               td_var%d_max=tg_varextra(il_ind)%d_max
+            ENDIF
+
+            ! unt
+            IF( TRIM(td_var%c_unt) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
+               td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt)
+            ENDIF
+
+            ! units factor
+            IF( td_var%d_unf == 1._dp .AND. &
+            &   tg_varextra(il_ind)%d_unf /= 1._dp )THEN
+               td_var%d_unf=tg_varextra(il_ind)%d_unf
+            ENDIF
+
+         ELSE
+            CALL logger_warn("VAR GET EXTRA: no extra information on "//&
+               &  "variable "//TRIM(td_var%c_name)//". you should define it"//&
+               &  " (see variable.cfg).")
+         ENDIF
+
+      ELSE
+
+         CALL logger_debug("VAR GET EXTRA: no extra information on variable "//&
+         &             " you should have run var_def_extra. ")
+
+      ENDIF
+
+   END SUBROUTINE var__get_extra
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> minimum value and return it if true. 
+   !> 
+   !> @details
+   !> minimum value is assume to follow string "min ="
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "min ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return minimum value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+   FUNCTION var__get_min( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp) :: var__get_min
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_min
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      cl_min=''
+      var__get_min=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'min')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('min')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_min=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_min) /= '' )THEN
+         IF( fct_is_real(cl_min) )THEN
+            READ(cl_min,*) var__get_min
+            CALL logger_debug("VAR GET MIN: will use minimum value of "//&
+            &  TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET MIN: invalid minimum value ("//&
+               & TRIM(cl_min)//") for variable "//TRIM(cd_name)//&
+               & ". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_min
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> maximum value and return it if true. 
+   !> 
+   !> @details
+   !> maximum value is assume to follow string "max ="
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "max ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return maximum value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+   FUNCTION var__get_max( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp) :: var__get_max
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_max
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      cl_max=''
+      var__get_max=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'max')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('max')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_max=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_max) /= '' )THEN
+         IF( fct_is_real(cl_max) )THEN
+            READ(cl_max,*) var__get_max
+            CALL logger_debug("VAR GET MAX: will use maximum value of "//&
+            &  TRIM(fct_str(var__get_max))//" for variable "//TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET MAX: invalid maximum value for "//&
+            &  "variable "//TRIM(cd_name)//". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_max
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> units factor value and return it if true. 
+   !> 
+   !> @details
+   !> units factor value is assume to follow string "unf ="
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return untis factor value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+   FUNCTION var__get_unf( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp) :: var__get_unf
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_unf
+      
+      INTEGER(i4)       :: il_ind
+
+      REAL(dp)          :: rl_unf
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      cl_unf=''
+      var__get_unf=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'unf')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('unf')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_unf=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_unf) /= '' )THEN
+         rl_unf=math_compute(cl_unf)
+         IF( rl_unf /= dp_fill )THEN
+            var__get_unf = rl_unf
+            CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//&
+               &  "value of "//TRIM(fct_str(var__get_unf))//" for variable "//&
+               &   TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//&
+               &  "value for variable "//TRIM(cd_name)//". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_unf
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> interpolation method and return it if true. 
+   !> 
+   !> @details 
+   !> interpolation method is assume to follow string "int ="
+   !>
+   !> compare method name with the list of interpolation method available (see
+   !> module global).
+   !> check if factor (*rhoi, /rhoj..) are present.<br/>
+   !> Example:<br/> 
+   !> - int=cubic/rhoi ; ext=dist_weight
+   !> - int=bilin
+   !> see @ref interp module for more information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "int ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return array of character information about interpolation 
+   !-------------------------------------------------------------------
+   FUNCTION var__get_interp( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(2) :: var__get_interp
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_int
+      CHARACTER(LEN=lc) :: cl_factor
+      
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_len
+
+      INTEGER(i4)       :: il_mul
+      INTEGER(i4)       :: il_div
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      var__get_interp(:)=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'int')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('int')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_int=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_int) /= '' )THEN
+         DO jj=1,ip_ninterp
+            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj)))
+            IF( il_ind /= 0 )THEN
+
+               var__get_interp(1)=TRIM(cp_interp_list(jj))
+               il_len=LEN(TRIM(cp_interp_list(jj)))
+               
+               ! look for factor
+               IF( il_ind==1 )THEN
+                  cl_factor=cl_int(il_len+1:)
+               ELSE
+                  cl_factor=cl_int(1:il_ind-1)
+               ENDIF
+               il_mul=SCAN(TRIM(cl_factor),'*')
+               il_div=SCAN(TRIM(cl_factor),'/')
+               
+               il_len=LEN(cl_factor)
+               IF( il_mul /= 0 )THEN
+                  IF( il_mul==1 )THEN
+                     cl_factor=cl_factor(2:il_len)
+                  ELSE
+                     cl_factor=cl_factor(1:il_mul-1)
+                  ENDIF
+
+               ELSE IF( il_div /=0 )THEN
+                  IF( il_div==1 )THEN
+                     cl_factor=cl_factor(2:il_len)
+                  ELSE
+                     cl_factor=cl_factor(1:il_div-1)
+                  ENDIF
+
+               ELSE
+                  cl_factor=''
+               ENDIF
+
+               SELECT CASE(TRIM(cl_factor))
+                  CASE('rhoi','rhoj','rhok')
+                     IF( il_mul /= 0 ) var__get_interp(2)='*'//TRIM(cl_factor)
+                     IF( il_div /= 0 ) var__get_interp(2)='/'//TRIM(cl_factor)
+                  CASE('')
+                     var__get_interp(2)=''
+                  CASE DEFAULT
+                     var__get_interp(2)=''
+                     CALL logger_error("VAR GET INTERP: variable "//&
+                     &     TRIM(cd_name)//&
+                     &     " invalid factor coefficient. check namelist. "//&
+                     &     " factor should be choose between rhox rhoy rhoz.")
+               END SELECT
+
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END FUNCTION var__get_interp
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> extrapolation method and return it if true. 
+   !> 
+   !> @details 
+   !> extrapolation method is assume to follow string "ext ="
+   !> 
+   !> compare method name with the list of extrapolation method available (see
+   !> module global).<br/>
+   !> Example:<br/>
+   !> - int=cubic ; ext=dist_weight
+   !> - ext=min_error
+   !> see @ref extrap module for more information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "ext ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return array of character information about extrapolation
+   !-------------------------------------------------------------------
+   FUNCTION var__get_extrap( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(1) :: var__get_extrap
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_ext
+
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      var__get_extrap(:)=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'ext')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('ext')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_ext=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_ext) /= '' )THEN
+         DO jj=1,ip_nextrap
+            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN
+               var__get_extrap(1)=TRIM(cp_extrap_list(jj))
+
+               CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//&
+               &  " will use extrapolation method "//TRIM(var__get_extrap(1)) )
+
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+
+   END FUNCTION var__get_extrap
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> filter method and return it if true 
+   !> 
+   !> @details 
+   !> filter method is assume to follow string "flt ="
+   !>
+   !> compare method name with the list of filter method available (see
+   !> module global).
+   !> look for the number of run, using '*' separator, and method parameters inside
+   !> bracket.<br/>
+   !> Example:<br/>
+   !> - int=cubic ; flt=2*hamming(2,3)
+   !> - flt=hann
+   !> see @ref filter module for more information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "flt ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !-------------------------------------------------------------------
+   FUNCTION var__get_filter( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(5) :: var__get_filter
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_flt
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      var__get_filter(:)=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'flt')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('flt')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_flt=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+      
+      IF( TRIM(cl_flt) /= '' )THEN
+         DO jj=1,ip_nfilter
+            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj)))
+            IF( il_ind /= 0 )THEN
+               var__get_filter(1)=TRIM(cp_filter_list(jj))
+
+               ! look for number of run
+               il_ind=SCAN(fct_lower(cl_flt),'*')
+               IF( il_ind /=0 )THEN
+                  IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN
+                     var__get_filter(2)=TRIM(cl_flt(1:il_ind-1))
+                  ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN
+                     var__get_filter(2)=TRIM(cl_flt(il_ind+1:))
+                  ELSE
+                     var__get_filter(2)='1'
+                  ENDIF
+               ELSE
+                  var__get_filter(2)='1'
+               ENDIF
+
+               ! look for filter parameter
+               il_ind=SCAN(fct_lower(cl_flt),'(')
+               IF( il_ind /=0 )THEN
+                  cl_flt=TRIM(cl_flt(il_ind+1:))
+                  il_ind=SCAN(fct_lower(cl_flt),')')
+                  IF( il_ind /=0 )THEN
+                     cl_flt=TRIM(cl_flt(1:il_ind-1))
+                     ! look for cut-off frequency
+                     var__get_filter(3)=fct_split(cl_flt,1,',')
+                     ! look for halo size
+                     var__get_filter(4)=fct_split(cl_flt,2,',')
+                     ! look for alpha parameter
+                     var__get_filter(5)=fct_split(cl_flt,3,',')
+                  ELSE
+                     CALL logger_error("VAR GET FILTER: variable "//&
+                     &  TRIM(cd_name)//&
+                     &  " unclosed parentheses. check namelist. ")
+                  ENDIF
+               ELSE
+                  var__get_filter(3)=''
+                  var__get_filter(4)=''
+                  var__get_filter(5)=''
+               ENDIF
+   
+               CALL logger_trace("VAR GET FILTER: name "//TRIM(var__get_filter(1)))
+               CALL logger_trace("VAR GET FILTER: nturn "//TRIM(var__get_filter(2)))
+               CALL logger_trace("VAR GET FILTER: cutoff "//TRIM(var__get_filter(3)))
+               CALL logger_trace("VAR GET FILTER: halo "//TRIM(var__get_filter(4)))
+               CALL logger_trace("VAR GET FILTER: alpha "//TRIM(var__get_filter(5)))
+
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END FUNCTION var__get_filter
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> unit and return it if true. 
+   !> 
+   !> @details 
+   !> unit is assume to follow string "unt ="
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return unit string character 
+   !-------------------------------------------------------------------
+   FUNCTION var__get_unt( cd_name, cd_varinfo )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc)               :: var__get_unt
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      var__get_unt=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'unt')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('unt')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               var__get_unt=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(var__get_unt) /= '' )THEN
+         CALL logger_debug("VAR GET UNIT: will use units "//&
+            &  TRIM(var__get_unt)//" for variable "//&
+            &  TRIM(cd_name) )
+      ENDIF
+
+   END FUNCTION var__get_unt
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function search and save the biggest dimensions use 
+   !> in an array of variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_var array of variable structure
+   !> @return array of dimension 
+   !-------------------------------------------------------------------
+   FUNCTION var_max_dim(td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
+      
+      ! function
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: var_max_dim
+
+      ! local variable
+      INTEGER(i4) :: il_nvar
+      
+      ! loop indices
+      INTEGER(i4) :: ji   
+      !-------------------------------------------------------------------
+                          
+      il_nvar=SIZE(td_var(:))
+                          
+      var_max_dim(:)=dim_copy(td_var(1)%t_dim(:))
+
+      IF( il_nvar > 1 )THEN
+         DO ji=2,il_nvar     
+                             
+            IF( td_var(ji)%t_dim(1)%l_use .AND. &
+            &   td_var(ji)%t_dim(1)%i_len >= var_max_dim(1)%i_len )THEN
+               var_max_dim(1)=dim_copy(td_var(ji)%t_dim(1))
+            ENDIF            
+                             
+            IF( td_var(ji)%t_dim(2)%l_use .AND. &
+            &   td_var(ji)%t_dim(2)%i_len >= var_max_dim(2)%i_len )THEN 
+               var_max_dim(2)=dim_copy(td_var(ji)%t_dim(2))
+            ENDIF            
+                             
+            IF( td_var(ji)%t_dim(3)%l_use .AND. &
+            &   td_var(ji)%t_dim(3)%i_len >= var_max_dim(3)%i_len )THEN 
+               var_max_dim(3)=dim_copy(td_var(ji)%t_dim(3))
+            ENDIF            
+                             
+            IF( td_var(ji)%t_dim(4)%l_use .AND. &
+            &   td_var(ji)%t_dim(4)%i_len >= var_max_dim(4)%i_len )THEN
+               var_max_dim(4)=dim_copy(td_var(ji)%t_dim(4))
+            ENDIF
+
+         ENDDO
+      ENDIF
+
+   END FUNCTION var_max_dim
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine forced minimum and maximum value of variable,
+   !> with value of variable structure attribute d_min and d_max.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_limit_value( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         !1- forced minimum value
+         IF( td_var%d_min /= dp_fill )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. &
+               &   td_var%d_value(:,:,:,:) <  td_var%d_min )
+               td_var%d_value(:,:,:,:)=td_var%d_min
+            END WHERE
+         ENDIF
+
+         !2- forced maximum value 
+         IF( td_var%d_max /= dp_fill )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. &
+               &   td_var%d_value(:,:,:,:) >  td_var%d_max )
+               td_var%d_value(:,:,:,:)=td_var%d_max
+            END WHERE
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE var_limit_value
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine replace unit name of the variable,
+   !> and apply unit factor to the value of this variable.
+   !> 
+   !> @details
+   !> new unit name (unt) and unit factor (unf) are read from the namelist.
+   !>
+   !> @note the variable value should be already read.
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_chg_unit( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      TYPE(TATT)                :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         !- change value
+         IF( td_var%d_unf /= 1._dp )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf
+            END WHERE
+
+            !- change scale factor and offset to avoid mistake
+            tl_att=att_init('scale_factor',1._dp)
+            CALL var_move_att(td_var, tl_att)
+
+            tl_att=att_init('add_offset',0._dp)
+            CALL var_move_att(td_var, tl_att)
+         ENDIF
+
+         !- change unit name 
+         IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. &
+         &   TRIM(td_var%c_unt) /= '' )THEN
+            tl_att=att_init('units',TRIM(td_var%c_unt))
+            CALL var_move_att(td_var,tl_att)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE var_chg_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check variable dimension expected, as defined in
+   !> file 'variable.cfg'.
+   !> 
+   !> @details 
+   !> compare dimension used in variable structure with string character
+   !> axis from configuration file. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var    variable structure
+   !-------------------------------------------------------------------
+   SUBROUTINE var_check_dim( td_var )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4)       :: il_naxis
+      INTEGER(i4)       :: il_ndim
+      CHARACTER(LEN=lc) :: cl_dim
+
+      LOGICAL           :: ll_warn
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( TRIM(td_var%c_axis) /= '' )THEN
+
+         cl_dim=''
+         DO ji=1,ip_maxdim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//TRIM(fct_upper(td_var%t_dim(ji)%c_sname))
+            ENDIF
+         ENDDO
+
+         il_naxis=LEN( TRIM(ADJUSTL(td_var%c_axis)) )
+         il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) )
+         IF( il_naxis >= il_ndim )THEN
+            ll_warn=.FALSE.
+            DO ji=1,il_naxis
+               IF( INDEX(TRIM(cl_dim),td_var%c_axis(ji:ji)) == 0 )THEN
+                  CALL logger_debug("VAR CHECK DIM: "//TRIM(cl_dim)//&
+                  &                 " "//TRIM(td_var%c_axis(ji:ji)) )
+                  ll_warn=.TRUE.
+                  EXIT
+               ENDIF
+            ENDDO
+
+            IF( ll_warn )THEN
+               CALL logger_warn("VAR CHECK DIM: variable dimension ("//&
+               &                TRIM(cl_dim)//") not conform with dimension"//&
+               &                 " expected ("//TRIM(td_var%c_axis)//"). ") 
+            ENDIF
+         ELSE
+            ! too much dimension
+            CALL logger_warn("VAR CHECK DIM: too much dimension for "//&
+            &                "variable "//TRIM(td_var%c_name)//".")
+            cl_dim=TRIM(fct_upper(cp_dimorder))
+            il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) )
+            DO ji=1,il_ndim 
+               IF( INDEX(TRIM(td_var%c_axis),cl_dim(ji:ji)) == 0 )THEN
+                  IF( td_var%t_dim(ji)%l_use )THEN
+                     IF( td_var%t_dim(ji)%i_len == 1 )THEN
+                        ! remove unuseful dimension
+                        CALL var_del_dim(td_var,td_var%t_dim(ji))
+                     ELSE
+                        CALL logger_warn("VAR CHECK DIM: variable "//&
+                        &           TRIM(td_var%c_name)//" should not use"//&
+                        &           " dimension "//TRIM(td_var%t_dim(ji)%c_name))
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+
+      ELSE
+         ! no information on variable dimension expected
+      ENDIF
+
+   END SUBROUTINE var_check_dim
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine reshape variable value and dimension 
+   !> in variable structure.
+   !> @details
+   !> output dimension will be ordered as defined in 
+   !> input array of dimension
+   !> Optionaly you could specify output dimension order with
+   !> string character of dimension
+   !> 
+   !> @author J.Paul
+   !> @date August, 2014 - Initial Version
+   !> @date July 2015 
+   !> - do not use dim_disorder anymore
+   !
+   !> @param[inout] td_var       variable structure
+   !> @param[in]    cd_dimorder  string character of dimension order to be used
+   !-------------------------------------------------------------------
+   SUBROUTINE var_reorder( td_var, cd_dimorder )
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR)              , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=ip_maxdim), INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      CHARACTER(LEN=lc)                             :: cl_dimorder
+
+      REAL(dp)  , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM), DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      cl_dimorder=TRIM(cp_dimorder)
+      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
+
+      CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//&
+         &  " new dimension order "//TRIM(cl_dimorder))
+
+      tl_dim(:)=dim_copy(td_var%t_dim(:))
+
+      CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
+
+      ALLOCATE(dl_value(tl_dim(1)%i_len, &
+      &                 tl_dim(2)%i_len, &
+      &                 tl_dim(3)%i_len, &
+      &                 tl_dim(4)%i_len ))
+
+      dl_value(:,:,:,:)=dim_reshape_2xyzt(tl_dim, &
+      &                                   td_var%d_value(:,:,:,:))
+
+      ! change dimension
+      td_var%t_dim(:)=dim_copy(tl_dim(:))
+      ! change value
+      DEALLOCATE( td_var%d_value )
+      CALL var_add_value(td_var, dl_value(:,:,:,:))
+
+      ! clean
+      DEALLOCATE(dl_value)
+      CALL dim_clean(tl_dim(:))
+
+   END SUBROUTINE var_reorder
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function get the next unused unit in array of variable structure. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[in] td_var array of variable structure 
+   !> @return free variable id
+   !-------------------------------------------------------------------
+   FUNCTION var_get_unit(td_var)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4) :: var_get_unit
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      var_get_unit=MAXVAL(td_var(:)%i_id)+1
+
+   END FUNCTION var_get_unit
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function convert a time variable structure in date structure. 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !
+   !> @param[in] td_var time variable structure 
+   !> @return date structure
+   !-------------------------------------------------------------------
+   FUNCTION var_to_date(td_var)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      TYPE(TDATE) :: var_to_date
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_step
+      CHARACTER(LEN=lc) :: cl_date
+
+      INTEGER(i4) :: il_attid
+
+      INTEGER(i8) :: kl_nsec
+
+      TYPE(TDATE) :: tl_dateo
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( INDEX(TRIM(td_var%c_name),'time') /= 0 )THEN
+         IF( ASSOCIATED(td_var%d_value) )THEN
+
+            il_attid=att_get_index(td_var%t_att(:),'units')
+            IF( il_attid /=0 )THEN
+               cl_step=fct_split(td_var%t_att(il_attid)%c_value,1,'since')
+               cl_date=fct_split(td_var%t_att(il_attid)%c_value,2,'since')
+
+               SELECT CASE(TRIM(cl_step))
+                  CASE('seconds')
+                     kl_nsec=INT(td_var%d_value(1,1,1,1),i8)
+                  CASE('days')
+                     kl_nsec=INT(td_var%d_value(1,1,1,1)*86400,i8)
+                  CASE DEFAULT
+                     CALL logger_error("VAR TO DATE: unknown units format "//&
+                     &  "in variable "//TRIM(td_var%c_name))
+               END SELECT
+
+               tl_dateo=date_init(cl_date)
+
+               var_to_date=date_init(kl_nsec,tl_dateo)
+
+            ELSE
+               CALL logger_error("VAR TO DATE: no attribute units in "//&
+               &  "variable "//TRIM(td_var%c_name))
+            ENDIF
+         ELSE
+            CALL logger_error("VAR TO DATE: no value associated to "//&
+            &  "variable "//TRIM(td_var%c_name))
+         ENDIF
+      ELSE
+         CALL logger_error("VAR TO DATE: variable "//TRIM(td_var%c_name)//&
+         &  "can not be convert in date.")
+      ENDIF
+
+   END FUNCTION var_to_date
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy variable array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE var_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumvar(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         cm_dumvar(:)=cn_dumvar(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+   
+   END SUBROUTINE var_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable is defined as dummy variable
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_var variable structure
+   !> @return true if variable is dummy variable 
+   !-------------------------------------------------------------------
+   FUNCTION var_is_dummy(td_var)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+      
+      ! function
+      LOGICAL :: var_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      var_is_dummy=.FALSE.
+      DO ji=1,ip_maxdumcfg
+         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN
+            var_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION var_is_dummy
+END MODULE var
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/vgrid.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/src/vgrid.f90	(revision 8732)
@@ -0,0 +1,853 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! MODULE: vgrid
+!
+! DESCRIPTION:
+!> @brief This module manage vertical grid.
+!>
+!> @details
+!>    to set the depth of model levels and the resulting vertical scale
+!> factors:<br/>
+!> @code
+!>    CALL vgrid_zgr_z(dd_gdepw(:), dd_gdept(:), dd_e3w(:), dd_e3t(:), 
+!>                     dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2, 
+!>                     dd_ppdzmin, dd_pphmax, 
+!>                     dd_ppa0, dd_ppa1, dd_ppa2, dd_ppsur)
+!> @endcode
+!>       - dd_gdepw is array of depth value on W point
+!>       - dd_gdept is array of depth value on T point
+!>       - dd_e3w   is array of vertical mesh size on W point
+!>       - dd_e3t   is array of vertical mesh size on T point
+!>       - dd_ppkth              see NEMO documentation
+!>       - dd_ppkth2             see NEMO documentation
+!>       - dd_ppacr              see NEMO documentation
+!>       - dd_ppdzmin            see NEMO documentation
+!>       - dd_pphmax             see NEMO documentation
+!>       - dd_ppa1               see NEMO documentation
+!>       - dd_ppa2               see NEMO documentation
+!>       - dd_ppa0               see NEMO documentation
+!>       - dd_ppsur              see NEMO documentation
+!>    
+!> 
+!>    to set the depth and vertical scale factor in partial step z-coordinate
+!>  case:<br/>
+!> @code
+!>    CALL vgrid_zgr_zps(id_mbathy(:,:), dd_bathy(:,:), id_jpkmax, dd_gdepw(:), 
+!>                       dd_e3t(:), dd_e3zps_min, dd_e3zps_rat)
+!> @endcode
+!>       - id_mbathy is array of bathymetry level
+!>       - dd_bathy  is array of bathymetry
+!>       - id_jpkmax is the maximum number of level to be used
+!>       - dd_gdepw  is array of vertical mesh size on W point
+!>       - dd_e3t    is array of vertical mesh size on T point
+!>       - dd_e3zps_min    see NEMO documentation
+!>       - dd_e3zps_rat    see NEMO documentation
+!>
+!>    to check the bathymetry in levels:<br/>
+!> @code
+!>    CALL vgrid_zgr_bat_ctl(id_mbathy, id_jpkmax, id_jpk)
+!> @endcode
+!>       - id_mbathy is array of bathymetry level
+!>       - id_jpkmax is the maximum number of level to be used
+!>       - id_jpk    is the number of level
+!>   
+!>    to compute bathy level in T,U,V,F point from  Bathymetry file:<br/>
+!> @code
+!>    tl_level(:)=vgrid_get_level(td_bathy, [cd_namelist,] [td_dom,] [id_nlevel])
+!> @endcode
+!>       - td_bathy is Bathymetry file structure
+!>       - cd_namelist is namelist [optional]
+!>       - td_dom is domain structure [optional]
+!>       - id_nlevel is number of lelvel to be used [optional]
+!>    
+!> @author
+!> J.Paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date Spetember, 2014
+!> - add header
+!> @date June, 2015 - update subroutine with NEMO 3.6
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE vgrid
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: vgrid_zgr_z 
+   PUBLIC :: vgrid_zgr_zps
+   PUBLIC :: vgrid_zgr_bat_ctl
+   PUBLIC :: vgrid_get_level
+
+CONTAINS
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set the depth of model levels and the resulting 
+   !>      vertical scale factors.
+   !
+   !> @details
+   !> ** Method  :   z-coordinate system (use in all type of coordinate)
+   !>        The depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the scale factors.
+   !>        both depth and scale factors only depend on k (1d arrays). <\br>
+   !>              w-level: gdepw  = fsdep(k)                           <\br>
+   !>                       e3w(k) = dk(fsdep)(k)     = fse3(k)         <\br>
+   !>              t-level: gdept  = fsdep(k+0.5)                       <\br>
+   !>                       e3t(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)     <\br>
+   !>
+   !> ** Action  : - gdept, gdepw : depth of T- and W-point (m)          <\br>
+   !>              -  e3t, e3w    : scale factors at T- and W-levels (m) <\br>
+   !>
+   !> @author G. Madec
+   !> @date Marsh,2008 - F90: Free form and module
+   !
+   !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+   !>
+   !> @param[inout] dd_gdepw
+   !> @param[inout] dd_gedpt
+   !> @param[inout] dd_e3w
+   !> @param[inout] dd_e2t
+   !> @param[in] dd_ppkth 
+   !> @param[in] dd_ppkth2
+   !> @param[in] dd_ppacr
+   !> @param[in] dd_ppacr2
+   !> @param[in] dd_ppdzmin
+   !> @param[in] dd_pphmax 
+   !> @param[in] dd_ppa1
+   !> @param[in] dd_ppa2 
+   !> @param[in] dd_ppa0
+   !> @param[in] dd_ppsur
+   !-------------------------------------------------------------------
+   SUBROUTINE vgrid_zgr_z( dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          &
+   &                       dd_e3w_1d, dd_e3t_1d,                        &
+   &                       dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    &
+   &                       dd_ppdzmin, dd_pphmax,                       &
+   &                       dd_ppa0, dd_ppa1, dd_ppa2, dd_ppsur )
+      IMPLICIT NONE
+      ! Argument      
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_gdepw
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_gdept
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w_1d
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t_1d
+
+      REAL(dp)              , INTENT(IN   ) :: dd_ppkth
+      REAL(dp)              , INTENT(IN   ) :: dd_ppkth2
+      REAL(dp)              , INTENT(IN   ) :: dd_ppacr
+      REAL(dp)              , INTENT(IN   ) :: dd_ppacr2
+
+      REAL(dp)              , INTENT(IN   ) :: dd_ppdzmin
+      REAL(dp)              , INTENT(IN   ) :: dd_pphmax
+      REAL(dp), PARAMETER                   :: dp_pp_to_be_computed = NF90_FILL_DOUBLE
+
+      REAL(dp)              , INTENT(IN   ) :: dd_ppa0
+      REAL(dp)              , INTENT(IN   ) :: dd_ppa1
+      REAL(dp)              , INTENT(IN   ) :: dd_ppa2
+      REAL(dp)              , INTENT(IN   ) :: dd_ppsur
+
+      ! local variable
+      REAL(dp) :: dl_zkth
+      REAL(dp) :: dl_zkth2
+      REAL(dp) :: dl_zdzmin
+      REAL(dp) :: dl_zhmax
+      REAL(dp) :: dl_zacr
+      REAL(dp) :: dl_zacr2
+
+      REAL(dp) :: dl_ppacr
+      REAL(dp) :: dl_ppacr2
+
+      REAL(dp) :: dl_za0
+      REAL(dp) :: dl_za1
+      REAL(dp) :: dl_za2
+      REAL(dp) :: dl_zsur
+      REAL(dp) :: dl_zw
+      REAL(dp) :: dl_zt
+
+      INTEGER(i4) :: il_jpk
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+       dl_ppacr = dd_ppacr
+       IF( dd_ppa1 == 0._dp ) dl_ppacr =1.0
+       dl_ppacr2= dd_ppacr2
+       IF( dd_ppa2 == 0._dp ) dl_ppacr2=1.0
+
+      ! Set variables from parameters
+      ! ------------------------------
+       dl_zkth   = dd_ppkth       ;   dl_zacr  = dl_ppacr
+       dl_zdzmin = dd_ppdzmin     ;   dl_zhmax = dd_pphmax
+       dl_zkth2  = dd_ppkth2      ;   dl_zacr2 = dl_ppacr2
+
+       il_jpk = SIZE(dd_gdepw(:))
+
+      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      !
+       IF(  dd_ppa1  == dp_pp_to_be_computed  .AND.  &
+         &  dd_ppa0  == dp_pp_to_be_computed  .AND.  &
+         &  dd_ppsur == dp_pp_to_be_computed           ) THEN
+         dl_za1 = ( dl_zdzmin - dl_zhmax / REAL((il_jpk-1),dp) ) &
+             &     / ( TANH((1-dl_zkth)/dl_zacr) - dl_zacr/REAL((il_jpk-1),dp) &
+             &     * (  LOG( COSH( (REAL(il_jpk,dp) - dl_zkth) / dl_zacr) )    &
+             &        - LOG( COSH(( 1.0  - dl_zkth) / dl_zacr) ) )  )
+
+         dl_za0  = dl_zdzmin - dl_za1 * TANH( (1.0-dl_zkth) / dl_zacr )
+         dl_zsur = - dl_za0 - dl_za1 * dl_zacr * LOG( COSH( (1-dl_zkth) / dl_zacr )  )
+
+       ELSE
+         dl_za1 = dd_ppa1 ;       dl_za0 = dd_ppa0 ;  dl_zsur = dd_ppsur
+         dl_za2 = dd_ppa2
+       ENDIF
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      IF(  dd_ppkth == 0. )THEN            !  uniform vertical grid       
+
+         dl_za1 = dl_zhmax/REAL((il_jpk-1),dp) 
+         DO jk = 1, il_jpk
+            dl_zw = REAL(jk,dp)
+            dl_zt = REAL(jk,dp) + 0.5_dp
+            dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1
+            dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1
+            dd_e3w  (jk) =  dl_za1
+            dd_e3t  (jk) =  dl_za1
+         END DO
+
+      ELSE
+
+         DO jk = 1, il_jpk
+            dl_zw = REAL( jk,dp)
+            dl_zt = REAL( jk,dp) + 0.5_dp
+            dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + &
+            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + &
+            &                dl_za2 * dl_zacr2* LOG( COSH( (dl_zw-dl_zkth2)/dl_zacr2 ) ) )
+            dd_gdept(jk) = ( dl_zsur + dl_za0 * dl_zt + &
+            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zt-dl_zkth)/dl_zacr ) ) + &
+            &                dl_za2 * dl_zacr2* LOG( COSH( (dl_zt-dl_zkth2)/dl_zacr2 ) ) )
+            dd_e3w  (jk) =             dl_za0 + &
+            &                          dl_za1 * TANH(      (dl_zw-dl_zkth)/dl_zacr   ) + &
+            &                          dl_za2 * TANH(      (dl_zw-dl_zkth2)/dl_zacr2 )
+            dd_e3t  (jk) =             dl_za0 + &
+            &                          dl_za1 * TANH(      (dl_zt-dl_zkth)/dl_zacr   ) + &
+            &                          dl_za2 * TANH(      (dl_zt-dl_zkth2)/dl_zacr2 )
+         END DO
+         dd_gdepw(1) = 0.e0   ! force first w-level to be exactly at zero
+
+      ENDIF
+
+   ! need to be like this to compute the pressure gradient with ISF.
+   ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+   ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+      DO jk = 1, il_jpk-1
+         dd_e3t_1d(jk) = dd_gdepw(jk+1)-dd_gdepw(jk) 
+      END DO
+      dd_e3t_1d(il_jpk) = dd_e3t_1d(il_jpk-1) ! we don't care because this level is masked in NEMO
+
+      DO jk = 2, il_jpk
+         dd_e3w_1d(jk) = dd_gdept(jk) - dd_gdept(jk-1) 
+      END DO
+      dd_e3w_1d(1  ) = 2._dp * (dd_gdept(1) - dd_gdepw(1))
+
+      ! Control and  print
+      ! ==================
+
+      DO jk = 1, il_jpk
+         IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then
+            CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ")
+         ENDIF   
+
+         IF( dd_e3w_1d(jk)  <= 0. .OR. dd_e3t_1d(jk)  <= 0. )then
+            CALL logger_debug("VGRID ZGR Z: e3w_1d or e3t_1d <= 0 ")
+         ENDIF
+
+         IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then
+            CALL logger_debug("VGRID ZGR Z: gdepw or gdept < 0 ")
+         ENDIF
+      END DO
+
+   END SUBROUTINE vgrid_zgr_z
+   !-------------------------------------------------------------------
+   !> @brief This subroutine
+   !>
+   !> @todo add subroutine description
+   !>
+   !> @param[inout] dd_bathy
+   !> @param[in] dd_gdepw
+   !> @param[in] dd_hmin
+   !> @param[in] dd_fill
+   !-------------------------------------------------------------------
+   SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill )
+      IMPLICIT NONE
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_bathy 
+      REAL(dp), DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
+      REAL(dp)                , INTENT(IN   ) :: dd_hmin
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local
+      INTEGER(i4) :: il_jpk
+      
+      REAL(dp)    :: dl_hmin
+      REAL(dp)    :: dl_fill
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      il_jpk = SIZE(dd_gdepw(:))
+
+      dl_fill=0._dp
+      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
+
+      IF( dd_hmin < 0._dp ) THEN
+         jk = - INT( dd_hmin )     ! from a nb of level
+      ELSE
+         jk = MINLOC( dd_gdepw, mask = dd_gdepw > dd_hmin, dim = 1 )  ! from a depth
+      ENDIF
+      
+      dl_hmin = dd_gdepw(jk+1) ! minimum depth = ik+1 w-levels 
+      WHERE( dd_bathy(:,:) <= 0._wp .OR. dd_bathy(:,:) == dl_fill )
+         dd_bathy(:,:) = dl_fill                         ! min=0     over the lands
+      ELSE WHERE
+         dd_bathy(:,:) = MAX(  dl_hmin , dd_bathy(:,:)  )   ! min=dl_hmin over the oceans
+      END WHERE
+      WRITE(*,*) 'Minimum ocean depth: ', dl_hmin, ' minimum number of ocean levels : ', jk      
+
+   END SUBROUTINE vgrid_zgr_bat
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set the depth and vertical scale factor in partial step
+   !>      z-coordinate case 
+   !
+   !> @details
+   !> ** Method  :   Partial steps : computes the 3D vertical scale factors
+   !>      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+   !>      a partial step representation of bottom topography.
+   !>
+   !>        The reference depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the reference vertical
+   !>      scale factors.
+   !>      From  depth and scale factors reference, we compute there new value
+   !>      with partial steps  on 3d arrays ( i, j, k ).
+   !>
+   !>      w-level: 
+   !>          - gdepw_ps(i,j,k)  = fsdep(k)
+   !>          - e3w_ps(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k)
+   !>      t-level: 
+   !>          - gdept_ps(i,j,k)  = fsdep(k+0.5)
+   !>          - e3t_ps(i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5)
+   !>
+   !>      With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+   !>      we find the mbathy index of the depth at each grid point.
+   !>      This leads us to three cases:
+   !>          - bathy = 0 => mbathy = 0
+   !>          - 1 < mbathy < jpkm1    
+   !>          - bathy > gdepw(jpk) => mbathy = jpkm1  
+   !>
+   !>      Then, for each case, we find the new depth at t- and w- levels
+   !>      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+   !>      and f-points.
+   !> 
+   !>        This routine is given as an example, it must be modified
+   !>      following the user s desiderata. nevertheless, the output as
+   !>      well as the way to compute the model levels and scale factors
+   !>      must be respected in order to insure second order accuracy
+   !>      schemes.
+   !>
+   !>  @warning 
+   !>         - gdept, gdepw and e3 are positives
+   !>         - gdept_ps, gdepw_ps and e3_ps are positives
+   !>
+   !> @author A. Bozec, G. Madec
+   !> @date February, 2009 - F90: Free form and module
+   !> @date February, 2009 
+   !> - A. de Miranda : rigid-lid + islands
+   !>
+   !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+   !>
+   !> @param[inout] id_mbathy
+   !> @param[inout] dd_bathy
+   !> @param[inout] id_jpkmax 
+   !> @param[in] dd_gdepw
+   !> @param[in] dd_e3t 
+   !> @param[in] dd_e3zps_min
+   !> @param[in] dd_e3zps_rat
+   !> @param[in] dd_fill
+   !-------------------------------------------------------------------
+   SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, &
+   &                          dd_gdepw, dd_e3t,               &
+   &                          dd_e3zps_min, dd_e3zps_rat,     &
+   &                          dd_fill )
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(  OUT) :: id_mbathy
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_bathy
+      INTEGER(i4)                , INTENT(INOUT) :: id_jpkmax
+      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw
+      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat
+      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp) :: dl_zmax     ! Maximum depth
+      !REAL(dp) :: dl_zmin     ! Minimum depth
+      REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t 
+      REAL(dp) :: dl_fill     
+
+      INTEGER(i4) :: il_jpk
+      INTEGER(i4) :: il_jpkm1
+      INTEGER(i4) :: il_jpiglo
+      INTEGER(i4) :: il_jpjglo
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      il_jpk=SIZE(dd_gdepw(:))
+      il_jpiglo=SIZE(id_mbathy(:,:),DIM=1)
+      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2)
+
+      dl_fill=0._dp
+      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
+
+      ! Initialization of constant
+      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+
+      ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( dd_bathy(:,:) /= dl_fill )
+         dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) )
+      END WHERE
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      il_jpkm1=il_jpk-1
+      ! initialize mbathy to the maximum ocean level available
+      id_mbathy(:,:) = il_jpkm1
+
+      ! storage of land and island's number (zera and negative values) in mbathy
+      DO jj = 1, il_jpjglo
+         DO ji= 1, il_jpiglo
+            IF( dd_bathy(ji,jj) <= 0._dp )THEN
+               id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4)
+            ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN
+               id_mbathy(ji,jj) = 0_i4
+            ENDIF
+         END DO
+      END DO
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where
+      ! e3t is the reference level thickness
+
+      DO jk = il_jpkm1, 1, -1
+         dl_zdepth = dd_gdepw(jk) + MIN( dd_e3zps_min, dd_e3t(jk)*dd_e3zps_rat )
+
+         DO jj = 1, il_jpjglo
+            DO ji = 1, il_jpiglo
+               IF( dd_bathy(ji,jj) /= dl_fill )THEN
+                  IF( 0. < dd_bathy(ji,jj) .AND. &
+                  &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      CALL vgrid_zgr_bat_ctl( id_mbathy, id_jpkmax, il_jpk)
+
+   END SUBROUTINE vgrid_zgr_zps
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check the bathymetry in levels 
+   !
+   !> @details
+   !> ** 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.
+   !>      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  : - update mbathy: level bathymetry (in level index)
+   !>              - update bathy : meter bathymetry (in meters)
+   !>
+   !> @author G.Madec
+   !> @date Marsh, 2008 - Original code
+   !
+   !> @param[in] id_mbathy 
+   !> @param[in] id_jpkmax
+   !> @param[in] id_jpk
+   !-------------------------------------------------------------------
+   SUBROUTINE vgrid_zgr_bat_ctl( id_mbathy, id_jpkmax, id_jpk)
+      IMPLICIT NONE
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mbathy
+      INTEGER(i4)                , INTENT(INOUT) :: id_jpkmax
+      INTEGER(i4)                , INTENT(INOUT) :: id_jpk
+
+      ! local variable
+      INTEGER(i4) :: il_jpiglo
+      INTEGER(i4) :: il_jpjglo
+
+      INTEGER(i4) :: il_icompt
+      INTEGER(i4) :: il_ibtest
+      INTEGER(i4) :: il_ikmax
+      INTEGER(i4) :: il_jpkm1
+
+      INTEGER(i4) :: il_jim
+      INTEGER(i4) :: il_jip
+      INTEGER(i4) :: il_jjm
+      INTEGER(i4) :: il_jjp
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_jpiglo=SIZE(id_mbathy(:,:),DIM=1)
+      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2)
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      ! suppress isolated ocean grid points'
+      il_icompt = 0
+
+      DO jl = 1, 2
+         DO jj = 1, il_jpjglo
+            DO ji = 1, il_jpiglo
+               il_jim=max(ji-1,1) ; il_jip=min(ji+1,il_jpiglo)
+               il_jjm=max(jj-1,1) ; il_jjp=min(jj+1,il_jpjglo)
+
+               if(il_jim==ji) il_jim=il_jip ; if(il_jip==ji) il_jip=il_jim
+               if(il_jjm==jj) il_jjm=il_jjp ; if(il_jjp==jj) il_jjp=il_jjm
+
+               il_ibtest = MAX( id_mbathy(il_jim,jj), id_mbathy(il_jip,jj),  &
+                                id_mbathy(ji,il_jjm),id_mbathy(ji,il_jjp) )
+
+               IF( il_ibtest < id_mbathy(ji,jj) ) THEN
+                  id_mbathy(ji,jj) = il_ibtest
+                  il_icompt = il_icompt + 1
+               ENDIF
+            END DO
+         END DO
+
+      END DO
+      IF( il_icompt == 0 ) THEN
+         CALL logger_info("VGRID ZGR BAT CTL:  no isolated ocean grid points")
+      ELSE
+         CALL logger_info("VGRID ZGR BAT CTL:"//TRIM(fct_str(il_icompt))//&
+         &              " ocean grid points suppressed")
+      ENDIF
+
+      id_mbathy(:,:) = MAX( 0, id_mbathy(:,:))
+
+      ! Number of ocean level inferior or equal to jpkm1
+
+      il_ikmax = 0
+      DO jj = 1, il_jpjglo
+         DO ji = 1, il_jpiglo
+            il_ikmax = MAX( il_ikmax, id_mbathy(ji,jj) )
+         END DO
+      END DO
+
+      id_jpkmax=id_jpk
+
+      il_jpkm1=id_jpk-1
+      IF( il_ikmax > il_jpkm1 ) THEN
+         CALL logger_error("VGRID ZGR BAT CTL: maximum number of ocean level = "//&
+         &              TRIM(fct_str(il_ikmax))//" >  jpk-1."//&
+         &              " Change jpk to "//TRIM(fct_str(il_ikmax+1))//&
+         &              " to use the exact ead bathymetry" )
+      ELSE IF( il_ikmax < il_jpkm1 ) THEN
+         id_jpkmax=il_ikmax+1
+      ENDIF
+
+   END SUBROUTINE vgrid_zgr_bat_ctl
+   !-------------------------------------------------------------------
+   !> @brief This function compute bathy level in T,U,V,F point, and return 
+   !> them as array of variable structure
+   !
+   !> @details
+   !> Bathymetry is read on Bathymetry file, then bathy level is computed 
+   !> on T point, and finally fit to U,V,F point.
+   !>
+   !> you could specify :<br/>
+   !> - namelist where find parameter to set the depth of model levels
+   !> (default use GLORYS 75 levels parameters)
+   !> - domain structure to specify on e area to work on
+   !> - number of level to be used
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_bathy     Bathymetry file structure 
+   !> @param[in] cd_namelist  namelist 
+   !> @param[in] td_dom       domain structure
+   !> @param[in] id_nlevel    number of lelvel to be used 
+   !> @return array of level on T,U,V,F point (variable structure)
+   !-------------------------------------------------------------------
+   FUNCTION vgrid_get_level(td_bathy, cd_namelist, td_dom, id_nlevel)
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN) :: td_bathy
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_namelist
+      TYPE(TDOM)      , INTENT(IN), OPTIONAL :: td_dom
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_nlevel
+
+      ! function
+      TYPE(TVAR), DIMENSION(ip_npoint) :: vgrid_get_level
+
+      ! local variable
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_gdepw 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_gdept 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d
+
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_fileid
+      INTEGER(i4)                                  :: il_jpkmax
+      INTEGER(i4), DIMENSION(2,2)                  :: il_xghost
+      INTEGER(i4), DIMENSION(:,:)    , ALLOCATABLE :: il_mbathy
+      INTEGER(i4), DIMENSION(:,:,:,:), ALLOCATABLE :: il_level
+      
+      LOGICAL                                      :: ll_exist
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)            :: tl_dim
+
+      TYPE(TDOM)                                   :: tl_dom
+
+      TYPE(TVAR)                                   :: tl_var
+
+      TYPE(TMPP)                                   :: tl_bathy
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      INTEGER(i4) :: jip
+      INTEGER(i4) :: jjp
+
+      !namelist (intialise with GLORYS 75 levels parameters)
+      REAL(dp)                                :: dn_ppsur     = -3958.951371276829_dp
+      REAL(dp)                                :: dn_ppa0      =   103.9530096000000_dp
+      REAL(dp)                                :: dn_ppa1      =     2.4159512690000_dp
+      REAL(dp)                                :: dn_ppa2      =   100.7609285000000_dp
+      REAL(dp)                                :: dn_ppkth     =    15.3510137000000_dp
+      REAL(dp)                                :: dn_ppkth2    =    48.0298937200000_dp
+      REAL(dp)                                :: dn_ppacr     =     7.0000000000000_dp
+      REAL(dp)                                :: dn_ppacr2    =    13.000000000000_dp
+      REAL(dp)                                :: dn_ppdzmin   = 6._dp
+      REAL(dp)                                :: dn_pphmax    = 5750._dp
+      INTEGER(i4)                             :: in_nlevel    = 75
+
+      REAL(dp)                                :: dn_e3zps_min = 25._dp
+      REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
+      !----------------------------------------------------------------
+      NAMELIST /namzgr/ &
+      &  dn_ppsur,     &
+      &  dn_ppa0,      &
+      &  dn_ppa1,      &
+      &  dn_ppa2,      &
+      &  dn_ppkth,     &
+      &  dn_ppkth2,    &
+      &  dn_ppacr,     &
+      &  dn_ppacr2,    &
+      &  dn_ppdzmin,   &
+      &  dn_pphmax,    &
+      &  in_nlevel
+
+      NAMELIST /namzps/ &
+      &  dn_e3zps_min, &
+      &  dn_e3zps_rat
+      !----------------------------------------------------------------
+
+      IF( PRESENT(cd_namelist) )THEN
+         !1- read namelist
+         INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+         IF( ll_exist )THEN
+ 
+            il_fileid=fct_getunit()
+
+            OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+            &                FORM='FORMATTED',       &
+            &                ACCESS='SEQUENTIAL',    &
+            &                STATUS='OLD',           &
+            &                ACTION='READ',          &
+            &                IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_fatal("VGRID GET LEVEL: ERROR opening "//&
+               &  TRIM(cd_namelist))
+            ENDIF
+
+            READ( il_fileid, NML = namzgr )
+            READ( il_fileid, NML = namzps )
+
+            CLOSE( il_fileid, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VGRID GET LEVELL: ERROR closing "//&
+               &  TRIM(cd_namelist))
+            ENDIF
+
+         ELSE
+
+            CALL logger_fatal("VGRID GET LEVEL: ERROR. can not find "//&
+            &  TRIM(cd_namelist))
+
+         ENDIF
+      ENDIF
+
+      ! copy structure
+      tl_bathy=mpp_copy(td_bathy)
+
+      ! get domain
+      IF( PRESENT(td_dom) )THEN
+         tl_dom=dom_copy(td_dom)
+      ELSE
+         CALL logger_debug("VGRID GET LEVEL: get dom from "//&
+         &  TRIM(tl_bathy%c_name))
+         tl_dom=dom_init(tl_bathy)
+      ENDIF
+
+      ! get ghoste cell
+      il_xghost(:,:)=grid_get_ghost(tl_bathy)
+
+      ! open mpp files
+      CALL iom_dom_open(tl_bathy, tl_dom)
+
+      ! check namelist
+      IF( PRESENT(id_nlevel) ) in_nlevel=id_nlevel
+      IF( in_nlevel == 0 )THEN
+         CALL logger_fatal("VGRID GET LEVEL: number of level to be used "//&
+         &                 "is not specify. check namelist.")
+      ENDIF
+
+      ! read bathymetry
+      tl_var=iom_dom_read_var(tl_bathy,'bathymetry',tl_dom)
+      ! clean
+      CALL dom_clean(tl_dom)
+
+      ! remove ghost cell
+      CALL grid_del_ghost(tl_var, il_xghost(:,:))
+
+      ! force _FillValue (land) to be 0
+      WHERE( tl_var%d_value(:,:,1,1) == tl_var%d_fill )
+         tl_var%d_value(:,:,1,1)=0
+      END WHERE
+
+      ! clean
+      CALL iom_dom_close(tl_bathy)
+      CALL mpp_clean(tl_bathy)
+
+      ! compute vertical grid
+      ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) ) 
+      ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) ) 
+      ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) ) 
+      CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), &
+      &                 dl_e3w_1d, dl_e3t_1d, &
+      &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       &
+      &                 dn_ppdzmin, dn_pphmax, &
+      &                 dn_ppa0, dn_ppa1, dn_ppa2, dn_ppsur )
+
+      ! compute bathy level on T point
+      ALLOCATE( il_mbathy(tl_var%t_dim(1)%i_len, &
+      &                   tl_var%t_dim(2)%i_len ) )
+      CALL vgrid_zgr_zps( il_mbathy(:,:), tl_var%d_value(:,:,1,1), il_jpkmax, &
+      &                   dl_gdepw(:), dl_e3t(:),               &
+      &                   dn_e3zps_min, dn_e3zps_rat )
+
+      DEALLOCATE( dl_gdepw, dl_gdept ) 
+      DEALLOCATE(   dl_e3w,   dl_e3t )
+
+      ! compute bathy level in T,U,V,F point
+      ALLOCATE( il_level(tl_var%t_dim(1)%i_len, &
+      &                  tl_var%t_dim(2)%i_len, &
+      &                  ip_npoint,1) )
+
+      DO jj=1,tl_var%t_dim(2)%i_len
+         DO ji= 1,tl_var%t_dim(1)%i_len
+
+         jip=MIN(ji+1,tl_var%t_dim(1)%i_len)
+         jjp=MIN(jj+1,tl_var%t_dim(2)%i_len)
+
+         ! T point
+         il_level(ji,jj,jp_T,1)=il_mbathy(ji,jj)
+         ! U point
+         il_level(ji,jj,jp_U,1)=MIN( il_mbathy(ji, jj ), il_mbathy(jip, jj ))
+         ! V point
+         il_level(ji,jj,jp_V,1)=MIN( il_mbathy(ji, jj ), il_mbathy(ji , jjp))
+         ! F point
+         il_level(ji,jj,jp_F,1)=MIN( il_mbathy(ji, jj ), il_mbathy(jip, jj ), &
+         &                           il_mbathy(ji, jjp), il_mbathy(jip, jjp))
+
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_mbathy )
+
+      tl_dim(:)=dim_copy(tl_var%t_dim(:))
+      ! clean
+      CALL var_clean(tl_var)
+
+      ! only 2 first dimension to be used
+      tl_dim(3:4)%l_use=.FALSE.
+
+      vgrid_get_level(jp_T)=var_init( 'tlevel', il_level(:,:,jp_T:jp_T,:), &
+      &                                td_dim=tl_dim(:) )
+      vgrid_get_level(jp_U)=var_init( 'ulevel', il_level(:,:,jp_U:jp_U,:), &
+      &                                td_dim=tl_dim(:))
+      vgrid_get_level(jp_V)=var_init( 'vlevel', il_level(:,:,jp_V:jp_V,:), &
+      &                                td_dim=tl_dim(:))
+      vgrid_get_level(jp_F)=var_init( 'flevel', il_level(:,:,jp_F:jp_F,:), &
+      &                                td_dim=tl_dim(:))
+
+      DEALLOCATE( il_level )
+
+      CALL grid_add_ghost( vgrid_get_level(jp_T), il_xghost(:,:) )
+      CALL grid_add_ghost( vgrid_get_level(jp_U), il_xghost(:,:) )
+      CALL grid_add_ghost( vgrid_get_level(jp_V), il_xghost(:,:) )
+      CALL grid_add_ghost( vgrid_get_level(jp_F), il_xghost(:,:) )
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END FUNCTION vgrid_get_level
+END MODULE vgrid
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam	(revision 8732)
@@ -0,0 +1,35 @@
+&namlog
+   cn_logfile=
+   cn_verbosity=
+   in_maxerror=
+/
+
+&namcfg
+   cn_varcfg=
+   cn_dumcfg=
+/
+
+&namcrs
+   cn_coord0=
+   in_perio0=
+/
+
+&namfin
+   cn_coord1=
+   in_perio1=
+   ln_fillclosed=
+/
+
+&namvar
+   cn_varfile=
+   cn_varinfo=
+/
+
+&namnst
+   in_rhoi=
+   in_rhoj=
+/
+
+&namout
+   cn_fileout=
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam	(revision 8732)
@@ -0,0 +1,69 @@
+&namlog
+   cn_logfile=
+   cn_verbosity=
+   in_maxerror =
+/
+
+&namcfg
+   cn_varcfg=
+   cn_dumcfg=
+/
+
+&namcrs
+   cn_coord0=
+   in_perio0=
+/
+
+&namfin
+   cn_coord1=
+   cn_bathy1=
+   in_perio1=
+/
+
+&namzgr
+   dn_pp_to_be_computed=
+   dn_ppsur    =
+   dn_ppa0     =
+   dn_ppa1     =
+   dn_ppa2     = 
+   dn_ppkth    =
+   dn_ppkth2   =
+   dn_ppacr    =
+   dn_ppacr2   =
+   dn_ppdzmin  =
+   dn_pphmax   =
+   in_nlevel   =
+/
+
+&namzps
+   dn_e3zps_min =
+   dn_e3zps_rat =
+/
+
+&namvar
+   cn_varfile=
+   cn_varinfo=
+/
+
+&namnst
+   in_rhoi=
+   in_rhoj=
+/
+
+&nambdy
+   ln_north = 
+   ln_south = 
+   ln_east  = 
+   ln_west  = 
+   cn_north = 
+   cn_south = 
+   cn_east  = 
+   cn_west  = 
+   ln_oneseg= 
+/
+
+&namout
+   cn_fileout=
+   dn_dayofs=
+   ln_extrap=
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam	(revision 8732)
@@ -0,0 +1,34 @@
+&namlog
+   cn_logfile=
+   cn_verbosity=
+   in_maxerror=
+/
+
+&namcfg
+   cn_varcfg=
+   cn_dumcfg=
+/
+
+&namcrs
+   cn_coord0=
+   in_perio0=
+/
+
+&namvar
+   cn_varinfo=
+/
+
+&namnst
+   in_imin0=
+   in_imax0=
+   in_jmin0=
+   in_jmax0=
+
+   in_rhoi=
+   in_rhoj=
+/
+
+&namout
+   cn_fileout=
+/
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_meshmask.nam
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_meshmask.nam	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_meshmask.nam	(revision 8732)
@@ -0,0 +1,101 @@
+&namlog
+   cn_logfile  ="meshmask_out.log"
+   cn_verbosity=
+   in_maxerror =
+/
+
+&namcfg
+   cn_varcfg="./cfg/variable.cfg"
+   cn_dumcfg="./cfg/dummy.cfg"
+/
+
+&namin
+   cn_bathy =   !< Bathymetry file
+   cn_coord =   !< Coordinate file (in_mshhgr=0)
+   cn_isfdep=   !< Iceshelf draft  (ln_isfcav=true)
+   in_perio =   !< NEMO periodicity
+   ln_closea=
+   ln_c1d=
+/
+
+&namhgr
+   in_mshhgr  =
+   dn_ppglam0 =
+   dn_ppgphi0 =
+   dn_ppe1_deg=
+   dn_ppe2_deg=
+   dn_ppe1_m  =
+   dn_ppe2_m  =
+/
+
+&namzgr
+   ln_zco     =
+   ln_zps     =
+   ln_sco     =
+   ln_isfcav  =  !< presence of ISF
+   ln_iscpl   =  !< coupling with ice sheet
+   ln_wd      =  !< Wetting/drying activation
+   in_nlevel  =
+/
+
+&namdmin
+   dn_hmin    =
+   dn_isfhmin =
+/
+
+&namzco
+   dn_ppsur   =
+   dn_ppa0    =
+   dn_ppa1    =
+   dn_ppkth   =
+   dn_ppacr   =
+   dn_ppdzmin =
+   dn_pphmax  =
+   ln_dbletanh=
+   dn_ppa2    =
+   dn_ppkth2  =
+   dn_ppacr2  =
+/
+
+&namzps
+   dn_e3zps_min
+   dn_e3zps_rat
+   in_msh
+/
+
+&namsco
+   ln_s_sh94  =
+   ln_s_sf12  =
+   dn_sbot_min=
+   dn_sbot_max=
+   dn_hc      =
+   dn_rmax    =   !< if ln_s_sh94
+   dn_theta   =   !< if ln_s_sh94
+   dn_thetb   =   !< if ln_s_sh94
+   dn_bb      =   !< if ln_s_sh94
+   ln_sigcrit =   !< if ln_s_sf12
+   dn_alpha   =   !< if ln_s_sf12
+   dn_efold   =   !< if ln_s_sf12
+   dn_zs      =   !< if ln_s_sf12
+   dn_zb_a    =   !< if ln_s_sf12
+   dn_zb_b    =   !< if ln_s_sf12
+/
+
+&namwd            !< wetting and drying
+  dn_wdmin1 =
+  dn_wdmin2 =
+  dn_wdld   =
+/
+
+&namgrd
+   in_cfg   =
+   ln_bench =
+   ln_c1d   =
+/
+
+&namout
+   in_msh    =   !< number of output file (1,2,3)
+   in_nproc  =   !< number of processor to be used
+   in_niproc =   
+   in_njproc =
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam	(revision 8732)
@@ -0,0 +1,60 @@
+&namlog
+   cn_logfile=
+   cn_verbosity=
+   in_maxerror=
+/
+
+&namcfg
+   cn_varcfg=
+   cn_dumcfg=
+/
+
+&namcrs
+   cn_coord0=
+   in_perio0=
+/
+
+&namfin
+   cn_coord1=
+   cn_bathy1=
+   in_perio1=
+/
+
+&namzgr
+   dn_pp_to_be_computed=
+   dn_ppsur    =
+   dn_ppa0     =
+   dn_ppa1     =
+   dn_ppa2     = 
+   dn_ppkth    =
+   dn_ppkth2   =
+   dn_ppacr    =
+   dn_ppacr2   =
+   dn_ppdzmin  =
+   dn_pphmax   =
+   in_nlevel   =
+/
+
+&namzps
+   dn_e3zps_min =
+   dn_e3zps_rat =
+/
+
+&namvar
+   cn_varfile=
+   cn_varinfo=
+/
+
+&namnst
+   in_rhoi=
+   in_rhoj=
+/
+
+&namout
+   cn_fileout=
+   ln_extrap=
+   in_niproc=
+   in_njproc=
+   in_nproc=
+   cn_type=
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam	(revision 8732)
@@ -0,0 +1,42 @@
+&namlog
+   cn_logfile=
+   cn_verbosity=
+   in_maxerror=
+/
+
+&namcfg
+   cn_varcfg=
+   cn_dumcfg=
+/
+
+&namcrs
+   cn_bathy0=
+   in_perio0=
+/
+
+&namfin
+   cn_bathy1=
+   in_perio1=
+/
+
+&namnst
+   in_rhoi=
+   in_rhoj=
+/
+
+&nambdy
+   ln_north=
+   ln_south=
+   ln_east=
+   ln_west=
+   cn_north=
+   cn_south=
+   cn_east=
+   cn_west=
+   in_ncrs=
+   ln_oneseg=
+/
+
+&namout
+   cn_fileout=
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/README	(revision 8732)
@@ -0,0 +1,316 @@
+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         src            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 (and derived programs from the nocsutil directory).  
+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 src directory also contains the three programs used to generate a weights file.
+The three programs 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 maketools script.
+E.g. change to the NEMOGCM/TOOLS directory and type:
+
+./maketools -help
+
+and, for example:
+
+./maketools -m gfortran_linux -n WEIGHTS
+
+
+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
+used 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).
+The nemo file need not be called 'coordinates.nc' (e.g. '1_coordinates.nc' instead),
+but must have longitude and latitude variables which start with the four 
+characters 'gphi' and 'glam' respectively.
+"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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 8732)
@@ -0,0 +1,759 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     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 (nemo_lon(1:4) .ne. 'glam' .or. nemo_lat(1:4) .ne. 'gphi') then
+      write(6,*) 'lon name does not start with "glam" or lat name does not start with "gphi"'
+      stop
+    endif
+
+    ! 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)
+
+    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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 8732)
@@ -0,0 +1,24 @@
+! ==========================================================================
+
+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
+  call process_grid(nm_in)
+#endif
+
+end program scripinterp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/copyright
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 8732)
@@ -0,0 +1,759 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     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 (nemo_lon(1:4) .ne. 'glam' .or. nemo_lat(1:4) .ne. 'gphi') then
+      write(6,*) 'lon name does not start with "glam" or lat name does not start with "gphi"'
+      stop
+    endif
+
+    ! 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)
+
+    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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 8732)
@@ -0,0 +1,24 @@
+! ==========================================================================
+
+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
+  call process_grid(nm_in)
+#endif
+
+end program scripinterp
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 8732)
@@ -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: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/maketools
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/maketools	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/maketools	(revision 8732)
@@ -0,0 +1,186 @@
+#!/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_h="";
+x_n="";
+x_m="";
+x_t="";
+x_c="";
+x_j=1;
+while getopts :hm:n:r:j:t: V
+  do
+	 case $V in
+		(h)  x_h=${OPTARG};
+                          echo "Usage	 : "${b_n} \
+					 " [-h] [-n name] [-m arch] [-j No] [-t tmpdir]";
+			  echo " -h	 : help";
+                          echo " -h institute : specific help for consortium members";
+			  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  ${x_h};
+			  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 all && exit
+
+#- When used for the first time, choose a compiler ---
+. ${COMPIL_DIR}/Fcheck_archfile.sh arch_tools.fcm cpp.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;
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/batch/X64_ADA.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/batch/X64_ADA.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/batch/X64_ADA.sh	(revision 8732)
@@ -0,0 +1,21 @@
+#!/bin/bash
+
+# Nom de la requete
+# @ job_name = NEMO_CI
+# Type de travail
+# @ job_type = parallel
+# Fichier de sortie standard
+# @ output = $(job_name)_$(jobid)
+# Fichier de sortie erreur
+# @ error  = $(job_name)_$(jobid)
+# Nombre de processus demande
+# @ total_tasks = 32
+# Temps CPU max. par processus MPI hh:mm:ss
+# @ wall_clock_limit = 0:30:00
+# Fin de l entete
+# @ queue
+
+cd $LOADL_STEP_INITDIR
+
+# running the job in parallel mode
+poe ./opa
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/batch/X64_CURIE.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/batch/X64_CURIE.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/batch/X64_CURIE.sh	(revision 8732)
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+#Config ccc_msub
+#MSUB -A  gen7451
+#MSUB -r  NEMO_CI
+#MSUB -o  NEMO_CI_%I
+#MSUB -e  NEMO_CI_%I
+#MSUB -oe
+#MSUB -q  xlarge
+#MSUB -n  128
+#MSUB -N  1
+#MSUB -T  1800
+##MSUB -@  ntmlod@locean-ipsl.upmc.fr:begin,end
+ccc_mprun ./opa
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/X64_ADA.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/X64_ADA.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/X64_ADA.cfg	(revision 8732)
@@ -0,0 +1,34 @@
+## Ada configuration
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+TRUS_ENVI=${TRUS_XIOS}/arch/arch-${TRUS_HPCC}
+
+TRUS_CDOD='cdo diffn'
+
+[ -z "${TRUS_NPRO}" ] && TRUS_NPRO='16'
+[ -z "${TRUS_TOUT}" ] && TRUS_TOUT='10800'
+
+
+## (Super)computer environment
+##---------------------------------------------------
+TRUS_JSPT=${TRUS_HPCC}.sh
+TRUS_JSUB="llsubmit ${TRUS_JSPT} | grep -oe '\<[0-9]*\>'"
+TRUS_JINF="llq -x \${TRUS_JIDN}"
+TRUS_JSTA="llq      | grep \${TRUS_JIDN}"
+TRUS_JKIL="llcancel        \${TRUS_JIDN}"
+
+TRUS_JTIM="grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f1 | awk '{print \$(NF-1),\$NF}'"
+TRUS_JPME="grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f3 | awk '{print \$3     ,\$4 }'"
+TRUS_JVME="grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f2 | awk '{print \$3     ,\$4 }'"
+
+TRUS_CMPV='ifort'
+TRUS_CDOR='cdo/'
+TRUS_MPIR='intel/impi/'
+TRUS_CDFR='netcdf/'
+
+PATH='/smplocal/pub/cdo/1.5.9/bin':$PATH
+## Not working with module delimiter ':'
+#WRAPPER_LDFLAGS='-L/smplocal/pub/IdrMemMPI/1.4/lib -lidrmem '${WRAPPER_LDFLAGS}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/X64_CURIE.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/X64_CURIE.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/X64_CURIE.cfg	(revision 8732)
@@ -0,0 +1,32 @@
+## Curie configuration
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+TRUS_ENVI=${TRUS_XIOS}/arch/arch-${TRUS_HPCC}
+
+TRUS_CDOD='cdo diffn'
+
+[ -z "${TRUS_NPRO}" ] && TRUS_NPRO='16'
+[ -z "${TRUS_TOUT}" ] && TRUS_TOUT='10800'
+
+
+## (Super)computer environment
+##---------------------------------------------------
+TRUS_JSPT=${TRUS_HPCC}.sh
+TRUS_JSUB="ccc_msub ${TRUS_JSPT} | grep -oe '\<[0-9]*\>'"
+TRUS_JINF="ccc_macct \${TRUS_JIDN}"
+TRUS_JSTA="ccc_mpp  | grep \${TRUS_JIDN}"
+TRUS_JKIL="ccc_mdel        \${TRUS_JIDN}"
+
+TRUS_JTIM="ccc_macct \${TRUS_JIDN} | grep     \"\${TRUS_JIDN}.0 *opa\" | awk '{print               \$9      }'"
+TRUS_JPME="ccc_macct \${TRUS_JIDN} | grep -m1 \"\${TRUS_JIDN}.0\"      | awk '{printf \"%d Mo\n\", \$2; exit}'"
+TRUS_JVME="ccc_macct \${TRUS_JIDN} | grep -m1 \"\${TRUS_JIDN}.0\"      | awk '{printf \"%d Go\n\", \$7; exit}'"
+
+TRUS_CMPV='ifort'
+TRUS_CDOR='netcdf-utils-'
+TRUS_MPIR='bullxmpi/'
+TRUS_CDFR='netcdf-'
+
+PATH='/usr/local/netcdf-utils-4.3.3.1_hdf5/bin':$PATH
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/arch_template.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/arch_template.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/arch_template.cfg	(revision 8732)
@@ -0,0 +1,50 @@
+## (Super)Computer configuration template
+##---------------------------------------------------
+
+## Copy to root, rename it and then fill in according to your (super)computer environment
+## Rules for completion: undefined variables (=) are mandatory & void variables (='') are optional
+## Look into other configuration file for examples
+
+
+## Default settings
+##---------------------------------------------------
+# (Super)Computer environment (${TRUS_XIOS} is already defined in the user configuration file)
+TRUS_ENVI=${TRUS_XIOS}/arch/arch-${TRUS_HPCC}
+## If `module` is available, ${TRUS_ENVI}.env will be sourced
+## If not (scheduled jobs), it will be ${TRUS_ENVI}.path or finally ${TRUS_ENVI}
+
+## Comparison command with restart files as argument (think to append $PATH by any way)
+TRUS_CDOD='cdo diffn'
+
+[ -z "${TRUS_NPRO}" ] && TRUS_NPRO=     ## Number of compiling processes
+[ -z "${TRUS_TOUT}" ] && TRUS_TOUT=     ## Timeout for computation (s)
+
+
+## (Super)computer environment
+##---------------------------------------------------
+## Job commands will almost always be used with `eval ${TRUS_JXXX}` because
+## they will certainly need job ID number as argument for working
+TRUS_JSPT=       ## Submission script contained ./batch folder, will be copied to testing folder
+TRUS_JSUB=	 ## Submit a job and get his ID on the fly (assigned to ${TRUS_JIDN})
+        	   ## ex: `llsubmit ${TRUS_JSPT} | grep -oe '\<[0-9]*\>'`
+TRUS_JSTA=   	 ## Test state of the submitted job (true -> pending/running or false -> completed/crashed)
+                   ## ex: "llq | grep \${TRUS_JIDN}"
+TRUS_JKIL=   	 ## Kill the submitted job
+                   ## ex: "llcancel   \${TRUS_JIDN}"
+
+## Computational performances of job (respectively elapsed time, max physical & virtual memory)
+TRUS_JTIM=''       ## ex: "grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f1 | awk '{print \$(NF-1),\$NF}"
+TRUS_JPME=''       ## ex: "grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f3 | awk '{print \$3     ,\$4 }"
+TRUS_JVME=''       ## ex: "grep IdrisMemMPI NEMO_CI_\${TRUS_JIDN} | cut -d, -f2 | awk '{print \$3     ,\$4 }"
+
+TRUS_JINF=''   	 ## Get job informations to fill in a logfile during computation
+                   ## ex: "llq -x \${TRUS_JIDN}"
+
+## Compiler (use with `${TRUS_CMPV} --version`)
+TRUS_CMPV=''       ## ex: 'ifort'|'gfortran'|'pgfortran'|...
+
+## Software/libraries (string pattern to match just before the release number in $PATH)
+## Respectively CDO (Climate Data Operators) / MPI libraries / NetCDF libraries
+TRUS_CDOR=''       ## ex: 'cdo/'|'netcdf-utils-'
+TRUS_MPIR=''       ## ex: 'intel/impi/'|'bullxmpi/'
+TRUS_CDFR=''       ## ex: 'netcdf/'|'netcdf-'
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/martin.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/martin.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/martin.cfg	(revision 8732)
@@ -0,0 +1,35 @@
+## Installation for trusting tests on Curie Supercomputer
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+[ -z "${TRUS_BRAN}" ] && TRUS_BRAN='trunk'
+TRUS_CKOT=( 'ARCH           CONFIG          NEMO               \
+             EXTERNAL/AGRIF EXTERNAL/fcm    EXTERNAL/IOIPSL    \
+             TOOLS/COMPILE  TOOLS/maketools TOOLS/REBUILD_NEMO  ' )
+
+[ -z "${TRUS_REFE}" ] && TRUS_REFE='ORCA2_LIM_PISCES'
+TRUS_CONF=${TRUS_REFE}'_trust'
+
+[ -z "${TRUS_TARF}" ] && TRUS_TARF='ORCA2_LIM_nemo_v3.6.tar'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_TARF='INPUTS_ORCA1_LIM3_PISCES_V6.tar'
+[ ${TRUS_REFE} == 'AMM12'             ] && TRUS_TARF='AMM12_v3.6.tar'
+
+TRUS_KEYA=''; TRUS_KEYD=''
+[ ${TRUS_REFE} == 'ORCA2_LIM' ] && TRUS_KEYA='key_add key_agrif' && TRUS_KEYD='key_del key_zdftmx'
+
+
+## User environment
+##---------------------------------------------------
+TRUS_WORK=$CCCWORKDIR/NEMO
+TRUS_SCRA=$SCRATCHDIR/NEMO/trusting/${TRUS_REFE}/${TRUS_BRAN}/${DATE}
+TRUS_STOR=$CCCSTOREDIR/NEMO/trusting_sav/${TRUS_REFE}/${TRUS_BRAN}
+TRUS_FORC=$CCCWORKDIR/NEMO/FORC
+TRUS_XIOS=$CCCWORKDIR/XIOS/xios-1.0
+
+[ ${TRUS_REFE} == 'ORCA2_LIM_PISCES'  ] && TRUS_CONF='O2LP_trust'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_CONF='O1L3P_trust'
+[ ${TRUS_REFE} == 'ORCA2_LIM'         ] && TRUS_CONF='O2LA_trust'
+
+[ -z "${TRUS_MAIL}" ] && TRUS_MAIL='ntmlod@locean-ipsl.upmc.fr'
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/romr005.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/romr005.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/romr005.cfg	(revision 8732)
@@ -0,0 +1,35 @@
+## Installation for trusting tests on Ada Supercomputer
+##---------------------------------------------------
+
+
+## Default settings
+##---------------------------------------------------
+[ -z "${TRUS_BRAN}" ] && TRUS_BRAN='trunk'
+TRUS_CKOT=( 'ARCH           CONFIG          NEMO               \
+             EXTERNAL/AGRIF EXTERNAL/fcm    EXTERNAL/IOIPSL    \
+             TOOLS/COMPILE  TOOLS/maketools TOOLS/REBUILD_NEMO  ' )
+
+[ -z "${TRUS_REFE}" ] && TRUS_REFE='ORCA2_LIM_PISCES'
+TRUS_CONF=${TRUS_REFE}'_trust'
+
+[ -z "${TRUS_TARF}" ] && TRUS_TARF='ORCA2_LIM_nemo_v3.6.tar'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_TARF='INPUTS_ORCA1_LIM3_PISCES_V6.tar'
+[ ${TRUS_REFE} == 'AMM12'             ] && TRUS_TARF='AMM12_v3.6.tar'
+
+TRUS_KEYA=''; TRUS_KEYD=''
+[ ${TRUS_REFE} == 'ORCA2_LIM' ] && TRUS_KEYA='key_add key_agrif' && TRUS_KEYD='key_del key_zdftmx'
+
+
+## User environment
+##---------------------------------------------------
+TRUS_WORK=$WORKDIR/NEMO
+TRUS_SCRA=$WORKDIR/NEMO/trusting/${TRUS_REFE}/${TRUS_BRAN}/${DATE}
+TRUS_STOR=$WORKDIR/NEMO/trusting_sav/${TRUS_REFE}/${TRUS_BRAN}
+TRUS_FORC=$WORKDIR/NEMO/FORC
+TRUS_XIOS=$WORKDIR/XIOS/xios-1.0
+
+[ ${TRUS_REFE} == 'ORCA2_LIM_PISCES'  ] && TRUS_CONF='O2LP_trust'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_CONF='O1L3P_trust'
+[ ${TRUS_REFE} == 'ORCA2_LIM'         ] && TRUS_CONF='O2LA_trust'
+
+[ -z "${TRUS_MAIL}" ] && TRUS_MAIL='ntmlod@locean-ipsl.upmc.fr'
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/user_template.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/user_template.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/config/user_template.cfg	(revision 8732)
@@ -0,0 +1,49 @@
+## User configuration template
+##---------------------------------------------------
+
+## Copy to root, rename it and then fill in according to your user environment
+## Rules for completion: undefined variables (=) are mandatory & void variables (='') are optional
+## Look into other configuration file for examples
+
+
+## Default settings
+##---------------------------------------------------
+## These settings can be changed directly from command line to reduce number of user configuration file
+## See `./trusting.sh [-h|--help]`
+
+## SVN branch name ('trunk', 'nemo_v3_6_STABLE', development branches)
+[ -z "${TRUS_BRAN}" ] && TRUS_BRAN='trunk'
+
+## Minimal content for code checkout/update
+TRUS_CKOT=( 'ARCH           CONFIG          NEMO               \
+             EXTERNAL/AGRIF EXTERNAL/fcm    EXTERNAL/IOIPSL    \
+             TOOLS/COMPILE  TOOLS/maketools TOOLS/REBUILD_NEMO  ' )
+
+[ -z "${TRUS_REFE}" ] && TRUS_REFE='ORCA2_LIM_PISCES'     ## Reference configuration to test
+TRUS_CONF=${TRUS_REFE}'_trust'                            ## Testing configuration name
+
+## Forcing archive, let void if just need to copy the files inside ${TRUS_FORC}
+[ -z "${TRUS_TARF}" ] && TRUS_TARF='ORCA2_LIM_nemo_v3.6.tar'
+[ ${TRUS_REFE} == 'ORCA1_LIM3_PISCES' ] && TRUS_TARF='INPUTS_ORCA1_LIM3_PISCES_V6.tar'
+[ ${TRUS_REFE} == 'AMM12'             ] && TRUS_TARF='AMM12_v3.6.tar'
+
+## CPP keys to add or remove from reference configuration
+TRUS_KEYA=''; TRUS_KEYD=''
+[ ${TRUS_REFE} == 'ORCA2_LIM' ] && TRUS_KEYA='key_add key_agrif' && TRUS_KEYD='key_del key_zdftmx'
+
+
+## User environment
+##---------------------------------------------------
+TRUS_WORK=     ## Testing folder for compilation (branches checkouts & configuration compilation)
+TRUS_SCRA=     ##   " "     ""   " " computation
+                 ## ...../${TRUS_REFE}/${TRUS_BRAN}/${DATE} recommended
+TRUS_STOR=     ## Benchmark folder where target files for comparison have been stored, ie:
+               ## Inputs  (all) : CPP_*, namelist_*, *.xml et inputs_list.txt (created by initial test)
+               ## Outputs (any) : *.stat, ocean.output, restarts
+                 ## ...../${TRUS_REFE}/${TRUS_BRAN} recommended (same layout as ${TRUS_SCRA})
+TRUS_FORC=     ## Path to the forcing archive to extract (usage combined with ${TRUS_TARF}) or
+               ##    ""   all inputs files who will be copied into ${TRUS_SCRA}
+TRUS_XIOS=     ## XIOS installation
+
+## Mailing list to notify on failure (-p|--prod option required)
+[ -z "${TRUS_MAIL}" ] && TRUS_MAIL=''
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/cron/ada.env
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/cron/ada.env	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/cron/ada.env	(revision 8732)
@@ -0,0 +1,53 @@
+## Set Ada environment for trusting scheduled job
+
+## Equivalent of source arch-X64_ADA.env with module commands
+PATH='/smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/bin/intel64_mic:/smplocal/intel/composer_xe_2013.1.117/debugger/gui/intel64:/smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/bin/intel64:/smplocal/intel/impi/4.1.0.024/intel64/bin:/smplocal/pub/Modules/IDRIS/wrappers:/smplocal/pub/NetCDF/4.1.3/mpi/bin':$PATH
+LD_LIBRARY_PATH='/smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mkl/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/ipp/../compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/ipp/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/tbb/lib/intel64:/smplocal/intel/impi/4.1.0.024/intel64/lib':${LD_LIBRARY_PATH}
+INCLUDE='/smplocal/intel/composer_xe_2013.1.117/mkl/include':$INCLUDE
+
+## Wrapper flags
+WRAPPER_CXXFLAGS='-I/smplocal/pub/NetCDF/4.1.3/mpi/include'
+WRAPPER_FFLAGS='-I/smplocal/pub/NetCDF/4.1.3/mpi/include'
+WRAPPER_LDFLAGS='-L/smplocal/pub/NetCDF/4.1.3/mpi/lib -Bstatic -lnetcdff -lnetcdf -lnetcdf_c++ -Bdynamic -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz'
+
+## IDRIS files systems (no need with `at`)
+#WORKDIR=/workgpfs/rech/omr/$USER
+#COMMONDIR=/workgpfs/rech/omr/commun
+#TMPDIR=
+
+## Intel license
+INTEL_LICENSE_FILE='/smplocal/intel/composer_xe_2013.1.117/licenses:/smplocal/intel/licenses:/linkhome/rech/omr/romr005/intel/licenses'
+
+## Trusting
+TRUS_HPCC='X64_ADA'
+
+## Export to environment
+export PATH LD_LIBRARY_PATH INCLUDE
+export WRAPPER_CXXFLAGS WRAPPER_FFLAGS WRAPPER_LDFLAGS
+#export WORKDIR COMMONDIR TMPDIR
+export INTEL_LICENSE_FILE
+export TRUS_HPCC
+
+
+#-------------------------------------------------------------------
+#/smplocal/pub/Modules/IDRIS/modulefiles/environnement/intel/2013.0:
+#prepend-path	 PATH               /smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/bin/intel64_mic:/smplocal/intel/composer_xe_2013.1.117/debugger/gui/intel64 
+#prepend-path	 PATH               /smplocal/intel/composer_xe_2013.1.117/bin/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/bin/intel64 
+#prepend-path	 PATH               /smplocal/intel/impi/4.1.0.024/intel64/bin 
+#prepend-path	 PATH               /smplocal/pub/Modules/IDRIS/wrappers 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/tbb/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mkl/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/ipp/../compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/ipp/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/composer_xe_2013.1.117/compiler/lib/intel64:/smplocal/intel/composer_xe_2013.1.117/mpirt/lib/intel64 
+#prepend-path	 LD_LIBRARY_PATH    /smplocal/intel/impi/4.1.0.024/intel64/lib 
+#prepend-path	 INCLUDE            /smplocal/intel/composer_xe_2013.1.117/mkl/include 
+#append-path	 INTEL_LICENSE_FILE /smplocal/intel/composer_xe_2013.1.117/licenses:/smplocal/intel/licenses:/linkhome/rech/omr/romr005/intel/licenses 
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/smplocal/pub/Modules/IDRIS/modulefiles/bibliotheques/netcdf/mpi/4.1.3:
+#prepend-path	 PATH               /smplocal/pub/NetCDF/4.1.3/mpi/bin 
+#prepend-path	 PATH               /smplocal/pub/Modules/IDRIS/wrappers 
+#prepend-path	 WRAPPER_FFLAGS     -I/smplocal/pub/NetCDF/4.1.3/mpi/include 
+#prepend-path	 WRAPPER_CXXFLAGS   -I/smplocal/pub/NetCDF/4.1.3/mpi/include 
+#prepend-path	 WRAPPER_LDFLAGS    -L/smplocal/pub/NetCDF/4.1.3/mpi/lib -Bstatic -lnetcdff -lnetcdf -lnetcdf_c++ -Bdynamic -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz
+#-------------------------------------------------------------------
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/cron/curie.env
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/cron/curie.env	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/cron/curie.env	(revision 8732)
@@ -0,0 +1,74 @@
+## Set Curie environment for trusting scheduled job
+
+## Equivalent of source arch-X64_CURIE.env with module commands
+PATH='/usr/local/ccc_users_env/bin:/opt/intel/14.0.3.174/bin/intel64:/opt/mpi/bullxmpi/1.2.8.2/bin:/usr/local/netcdf-4.3.3.1_hdf5_parallel/bin:/ccc/cont003/home/dsm/p86ipsl/bin':$PATH
+LD_LIBRARY_PATH='/lib64:/lib:/usr/lib64:/usr/lib:/opt/intel/14.0.3.174/compiler/lib/intel64:/usr/local/intel-14.0.3.174/14.0.3.174/mkl/lib/intel64:/opt/intel/14.0.3.174/debugger/lib/intel64:/opt/mpi/bullxmpi/1.2.8.2/lib:/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib':${LD_LIBRARY_PATH}
+
+## NetCDF installation
+NETCDF_INCDIR='/usr/local/netcdf-4.3.3.1_hdf5_parallel/include'
+NETCDF_LDFLAGS='-L/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib -lnetcdf'
+NETCDF_LIBDIR='/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib'
+
+## TGCC files systems
+CCCWORKDIR=/ccc/work/cont003/gen7451/$USER
+SCRATCHDIR=/ccc/scratch/cont003/gen7451/$USER
+CCCSTOREDIR=/ccc/store/cont003/gen7451/$USER
+
+## Intel license
+LM_LICENSE_FILE='27000@licintel.ccc.cea.fr'
+
+## Trusting
+TRUS_HPCC='X64_CURIE'
+
+## Export to environment
+export PATH LD_LIBRARY_PATH
+export NETCDF_INCDIR NETCDF_LDFLAGS NETCDF_LIBDIR
+export CCCWORKDIR SCRATCHDIR CCCSTOREDIR
+export LM_LICENSE_FILE
+export TRUS_HPCC
+
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/environment/ccc:
+#append-path	PATH    	/usr/local/ccc_users_env/bin
+#prepend-path	LD_LIBRARY_PATH	/lib64:/lib:/usr/lib64:/usr/lib
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/environment/dfldatadir/own:
+#setenv		CCCSTOREDIR	/ccc/store/cont003/gen7451/martin
+#setenv		CCCWORKDIR	/ccc/work/cont003/gen7451/martin
+#setenv		SCRATCHDIR	/ccc/scratch/cont003/gen7451/martin
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/environment/licsrv/intel:
+#append-path	LM_LICENSE_FILE	27000@licintel.ccc.cea.fr
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/compilers/intel/14.0.3.174:
+#module load	c/intel/14.0.3.174
+#prepend-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#prepend-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/compiler/lib/intel64
+#module load	c++/intel/14.0.3.174
+#prepend-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#prepend-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/compiler/lib/intel64
+#module load	fortran/intel/14.0.3.174
+#append-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#prepend-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/compiler/lib/intel64
+#module load	mkl/14.0.3.174
+#append-path	LD_LIBRARY_PATH	/usr/local/intel-14.0.3.174/14.0.3.174/mkl/lib/intel64
+#module load	idb/14.0.3.174
+#prepend-path	PATH    	/opt/intel/14.0.3.174/bin/intel64
+#append-path	LD_LIBRARY_PATH	/opt/intel/14.0.3.174/debugger/lib/intel64
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/parallel/bullxmpi/1.2.8.2:
+#prepend-path	PATH    	/opt/mpi/bullxmpi/1.2.8.2/bin
+#prepend-path	LD_LIBRARY_PATH	/opt/mpi/bullxmpi/1.2.8.2/lib
+#-------------------------------------------------------------------
+#-------------------------------------------------------------------
+#/opt/Modules/default/modulefiles/libraries/netcdf/4.3.3.1_hdf5_parallel:
+#prepend-path	PATH    	/usr/local/netcdf-4.3.3.1_hdf5_parallel/bin
+#prepend-path	LD_LIBRARY_PATH	/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib
+#setenv		NETCDF_INCDIR	/usr/local/netcdf-4.3.3.1_hdf5_parallel/include
+#setenv		NETCDF_LIBDIR	/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib
+#setenv		NETCDF_LDFLAGS	-L/usr/local/netcdf-4.3.3.1_hdf5_parallel/lib -lnetcdf
+#-------------------------------------------------------------------
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/banner.html
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/banner.html	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/banner.html	(revision 8732)
@@ -0,0 +1,33 @@
+<pre style="font: 2px/1px monospace;">
+@@@@@@O$$$$$$@@@@@@#$$$$$$&@#$$$$$$$$$$$$$$$&@O$$$$$$&@@@@@@@@@$$$$$$O@@@@@@@@@@@O$$%$O@@@@@@@@@@@@@
+@@@@@@?!!!!!!#@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!?&@@@@@@@$!!!!!!?@@@@@@@@&O#&&&&%??$#@@@@@@@@@@
+@@@@@@?!!!!!!?@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!!%@@@@@@O!!!!!!!?@@@@@@@O#@@&%??!!!!!$@@@@@@@@@
+@@@@@@?!!!!!!!O@@@@O!!!!!!#@$!!!!!!?????????&@%!!!!!!!!$@@@@#!!!!!!!!?@@@@@&O&@&&O$$?!!!!!!%&@@@@@@@
+@@@@@@?!!!!!!!!#@@@O!!!!!!#@$!!!!!!#&&&&&&&&@@%!!!!!!!!!$@@&?!!!!!!!!?@@@@@O&@&??&@@&O!!!!!!%@@@@@@@
+@@@@@@?!!!!!!!!?&@@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!O@%!!!!!!!!!?@@@@O&@@O!O@@@@&O!!!!!!$@@@@@@
+@@@@@@?!!!!!!!!!?#@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!%!!!!!!!!!!?@@@&O@@$!!O&@@@@&O!!!!!!#@@@@@
+@@@@@@?!!!!!!!!!!!OO!!!!!!#@$!!!!!!$OOOOO@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O@&%!!!!!%#&&@&?!!!!!%@@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O&!!!!!!%%eO&@$!!!!!!%&@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@&&$!!!?$O$Oe$@@!!!!!!eO#@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!?%%%%$@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!$&$#%!#@@?!!!!!!$O@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!%?O@%&&&@$!!!!!!?O@@@@
+@@@@@@?!!!!!?#!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!#!!!!!!!!O?!!!!!?@@O#!!!!!!?@@@@@OO!!!!$e?O@@@@
+@@@@@@?!!!!!?@#?!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!&#!!!!!!%&?!!!!!?@@OOO?!!!%%@@@@@#?!%$#O%%$@@@@
+@@@@@@?!!!!!?@@&%!!!!!!!!!#@$!!!!!!?????????&@%!!!!!!&@O!!!!?&@?!!!!!?@@#&##%$&&&@@@@@@$%#&O!??O@@@@
+@@@@@@?!!!!!?@@@@#?!!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@$!!!&@@?!!!!!?@@&#$&@@@@@@@@@@@?O%%?!!!#@@@@
+@@@@@@?!!!!!?@@@@@@#%!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@@$!O@@@?!!!!!?@@@O#&&@@@@@@@@@@O?!!!!!?&@@@@
+@@@@@@?!!!!!?@@@@@@@@&O$%%#@#O##&&&&&&&&##OO&@$!!!!!!&@@@@O@@@@?!!!!!?@@@O&&#&@@@@@@@@@$!!!!!!$@@@@@
+@@@@@@?!!!!!?@@@@@@@@@@@@@@&&#O$$$%%%%$$$OO#&@@&#O%?!&@@@@@@@@@?!!!!!?@@@@OOO@@@@@@@@@&!!!!!!!&@@@@@
+@@@@@@?!!!!!?@@@@@@@@@&#$%?!!!!!!!!!!!!!!!!!!!?%O#@@#@@@@@@@@@@?!!!!!?@@@@#!!%&@@@@@@@%!!!!!!O@@@@@@
+@@@@@@?!!!!!?@@@@@@#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!%$&@@@@@@@@@?!!!!!?@@@@@#!!%@@@@@@@O!!$&$$@@@@@@@
+@@@@@@?!!!!!?@@@O%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@@@@?!!!!!?@@@@@@O!!?@@@@@@@&&@#O@@@@@@&&
+@@@@@@?!!!?O&#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@$?!!!!?@@@@@@@&%!?$#@@@@@&O#@@@@@#O&@
+@@@@@@?!?O&#%!!!!!!!!!??%%$$$OOOOOOOOOO$$%%??!!!!!!!!!!!!!!!?%O&&&O$%%@@@@@@@@@#%?%####O#@@@&#$$#@@@
+@@@@@@%O&#%!!!!!?%$O#&&@@@@@@@@@@@@@@@@@@@@@&&#O$%?!!!!!!!!!!!!!?$O&&&@@@@@@@@@@@&&&&&&&&#$%?%#@@@@@
+@@@@@@&#%!!!?$#&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&#O%?!!!!!!!!!!!!??%$OOO#######OO$%??!!?%#@@@@@@@
+@@@@@&$!?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#O$%?!!!!!!!!!!!!!!!!!!!!!!!!!?$#&@@@@@@@@@
+@@@@O?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#OO$%????!!!!!!!!??%%O#&@@@@@@@@@@@@@
+@@&$$&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&&&&&&&&@@@@@@@@@@@@@@@@@@@@
+@#O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+</pre>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/banner.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/banner.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/banner.txt	(revision 8732)
@@ -0,0 +1,31 @@
+@@@@@@O$$$$$$@@@@@@#$$$$$$&@#$$$$$$$$$$$$$$$&@O$$$$$$&@@@@@@@@@$$$$$$O@@@@@@@@@@@O$$%$O@@@@@@@@@@@@@
+@@@@@@?!!!!!!#@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!?&@@@@@@@$!!!!!!?@@@@@@@@&O#&&&&%??$#@@@@@@@@@@
+@@@@@@?!!!!!!?@@@@@O!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!!%@@@@@@O!!!!!!!?@@@@@@@O#@@&%??!!!!!$@@@@@@@@@
+@@@@@@?!!!!!!!O@@@@O!!!!!!#@$!!!!!!?????????&@%!!!!!!!!$@@@@#!!!!!!!!?@@@@@&O&@&&O$$?!!!!!!%&@@@@@@@
+@@@@@@?!!!!!!!!#@@@O!!!!!!#@$!!!!!!#&&&&&&&&@@%!!!!!!!!!$@@&?!!!!!!!!?@@@@@O&@&??&@@&O!!!!!!%@@@@@@@
+@@@@@@?!!!!!!!!?&@@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!O@%!!!!!!!!!?@@@@O&@@O!O@@@@&O!!!!!!$@@@@@@
+@@@@@@?!!!!!!!!!?#@O!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!%!!!!!!!!!!?@@@&O@@$!!O&@@@@&O!!!!!!#@@@@@
+@@@@@@?!!!!!!!!!!!OO!!!!!!#@$!!!!!!$OOOOO@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O@&%!!!!!%#&&@&?!!!!!%@@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@@O&!!!!!!%%eO&@$!!!!!!%&@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!!!!!!?@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@&&$!!!?$O$Oe$@@!!!!!!eO#@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!?%%%%$@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!$&$#%!#@@?!!!!!!$O@@@@
+@@@@@@?!!!!!!!!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!!!!!!!!!!!!!!!!!?@@O&!!!!%?O@%&&&@$!!!!!!?O@@@@
+@@@@@@?!!!!!?#!!!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!#!!!!!!!!O?!!!!!?@@O#!!!!!!?@@@@@OO!!!!$e?O@@@@
+@@@@@@?!!!!!?@#?!!!!!!!!!!#@$!!!!!!#@@@@@@@@@@%!!!!!!&#!!!!!!%&?!!!!!?@@OOO?!!!%%@@@@@#?!%$#O%%$@@@@
+@@@@@@?!!!!!?@@&%!!!!!!!!!#@$!!!!!!?????????&@%!!!!!!&@O!!!!?&@?!!!!!?@@#&##%$&&&@@@@@@$%#&O!??O@@@@
+@@@@@@?!!!!!?@@@@#?!!!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@$!!!&@@?!!!!!?@@&#$&@@@@@@@@@@@?O%%?!!!#@@@@
+@@@@@@?!!!!!?@@@@@@#%!!!!!#@$!!!!!!!!!!!!!!!#@%!!!!!!&@@@$!O@@@?!!!!!?@@@O#&&@@@@@@@@@@O?!!!!!?&@@@@
+@@@@@@?!!!!!?@@@@@@@@&O$%%#@#O##&&&&&&&&##OO&@$!!!!!!&@@@@O@@@@?!!!!!?@@@O&&#&@@@@@@@@@$!!!!!!$@@@@@
+@@@@@@?!!!!!?@@@@@@@@@@@@@@&&#O$$$%%%%$$$OO#&@@&#O%?!&@@@@@@@@@?!!!!!?@@@@OOO@@@@@@@@@&!!!!!!!&@@@@@
+@@@@@@?!!!!!?@@@@@@@@@&#$%?!!!!!!!!!!!!!!!!!!!?%O#@@#@@@@@@@@@@?!!!!!?@@@@#!!%&@@@@@@@%!!!!!!O@@@@@@
+@@@@@@?!!!!!?@@@@@@#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!%$&@@@@@@@@@?!!!!!?@@@@@#!!%@@@@@@@O!!$&$$@@@@@@@
+@@@@@@?!!!!!?@@@O%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@@@@?!!!!!?@@@@@@O!!?@@@@@@@&&@#O@@@@@@&&
+@@@@@@?!!!?O&#$?!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!?$#@@@$?!!!!?@@@@@@@&%!?$#@@@@@&O#@@@@@#O&@
+@@@@@@?!?O&#%!!!!!!!!!??%%$$$OOOOOOOOOO$$%%??!!!!!!!!!!!!!!!?%O&&&O$%%@@@@@@@@@#%?%####O#@@@&#$$#@@@
+@@@@@@%O&#%!!!!!?%$O#&&@@@@@@@@@@@@@@@@@@@@@&&#O$%?!!!!!!!!!!!!!?$O&&&@@@@@@@@@@@&&&&&&&&#$%?%#@@@@@
+@@@@@@&#%!!!?$#&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&#O%?!!!!!!!!!!!!??%$OOO#######OO$%??!!?%#@@@@@@@
+@@@@@&$!?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#O$%?!!!!!!!!!!!!!!!!!!!!!!!!!?$#&@@@@@@@@@
+@@@@O?%O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&#OO$%????!!!!!!!!??%%O#&@@@@@@@@@@@@@
+@@&$$&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@&&&&&&&&&@@@@@@@@@@@@@@@@@@@@
+@#O&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+&&@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/svn_abstract.awk
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/svn_abstract.awk	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/svn_abstract.awk	(revision 8732)
@@ -0,0 +1,34 @@
+#!/bin/awk
+
+BEGIN{}
+
+func relative_path() { sub(/.*NEMOGCM\/[[:upper:]]*\//,//); return substr($0,2) }
+
+func array_loop(action,nb,array) {
+    if ( nb != 0 ) {
+	printf("\n%-10s: %3d\n\t",action,nb)
+	j = 0
+	for (i in array) {
+	    j += 1
+	    printf("%-45s\t",array[i])
+	    if ( j % 3 == 0 && j != nb ) { printf"\n\t" }
+	}
+    }
+}
+
+/^A[[:upper:] ]/ { acount += 1; aroutines[acount] = relative_path() }
+/^C[[:upper:] ]/ { ccount += 1; croutines[ccount] = relative_path() }
+/^D[[:upper:] ]/ { dcount += 1; droutines[dcount] = relative_path() }
+/^E[[:upper:] ]/ { ecount += 1; eroutines[ecount] = relative_path() }
+/^G[[:upper:] ]/ { gcount += 1; groutines[gcount] = relative_path() }
+/^U[[:upper:] ]/ { ucount += 1; uroutines[ucount] = relative_path() }
+
+END{
+    array_loop("added",     acount,aroutines)
+    array_loop("conflicted",ccount,croutines)
+    array_loop("deleted",   dcount,droutines)
+    array_loop("edited",    ecount,eroutines)
+    array_loop("merged",    gcount,groutines)
+    array_loop("updated",   ucount,uroutines)
+    printf "\n"
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting.env
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting.env	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting.env	(revision 8732)
@@ -0,0 +1,30 @@
+#!/bin/bash
+
+
+## Global environment variables
+##--------------------------------------
+dat=$( date )
+export DATE=$( date -ud "$dat" +"%Y%m%d%Z%H%M" )
+export PATTERNAME=${TRUS_USER}'_'${TRUS_HPCC}
+export TRUS_SVNH='https://forge.ipsl.jussieu.fr/nemo/svn'
+
+
+## Source user configuration
+##---------------------------------------------------
+. ./config/${TRUS_USER}.cfg
+export TRUS_WORK TRUS_SCRA TRUS_STOR TRUS_XIOS TRUS_FORC
+export TRUS_BRAN TRUS_REFE
+export TRUS_CONF TRUS_TARF TRUS_KEYA TRUS_KEYD
+export TRUS_MAIL
+
+
+## Source (super)computer configuration
+##---------------------------------------------------
+. ./config/${TRUS_HPCC}.cfg
+export TRUS_ENVI TRUS_CDOD TRUS_NPRO TRUS_TOUT
+export TRUS_JSPT TRUS_JSUB TRUS_JSTA TRUS_JKIL
+export TRUS_JPME TRUS_JTIM TRUS_JVME TRUS_JINF
+export TRUS_CMPV TRUS_CDOR TRUS_MPIR TRUS_CDFR
+
+
+export TRUS_NGCM=${TRUS_WORK}/${TRUS_BRAN}/NEMOGCM
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting_func.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting_func.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting_func.sh	(revision 8732)
@@ -0,0 +1,427 @@
+#!/bin/bash
+
+
+## Messenger filenames
+FILE_DATE=mesg_01_date_$PATTERNAME.txt  ; FILE_RSLT=mesg_02_result_$PATTERNAME.txt
+FILE_STAT=mesg_03_state_$PATTERNAME.txt ; FILE_NEMO=mesg_04_nemo_$PATTERNAME.txt
+FILE_XIOS=mesg_05_xios_$PATTERNAME.txt  ; FILE_CMPF=mesg_06_compiler_$PATTERNAME.txt
+FILE_LMPI=mesg_07_mpi_$PATTERNAME.txt   ; FILE_NCDF=mesg_08_netcdf_$PATTERNAME.txt
+FILE_INPT=mesg_09_inputs_$PATTERNAME.txt; FILE_TIME=mesg_10_time_$PATTERNAME.txt
+FILE_MEMY=mesg_11_memory_$PATTERNAME.txt; FILE_NOTE=mesg_12_comments_$PATTERNAME.txt
+
+## Trusting timestamped logfile & archive
+TRUS_FILE=trusting_${DATE}_$PATTERNAME.txt; TRUS_ARCH=trusting_${DATE}_$PATTERNAME.tgz
+
+
+## Functions in order of use
+print_step() {
+    local char_nb=$( echo "$1" | wc -c )
+    local outline=$( printf "%${char_nb}s" )
+
+    printf "\nStep.....\n%s\n%s\n" "$1" ${outline// /-}
+}
+
+init_files() {
+    echo 'Date'        	      > ${FILE_DATE}; echo 'Result'           > ${FILE_RSLT}
+    echo 'State'      	      > ${FILE_STAT}; echo 'NEMOGCM rev.'     > ${FILE_NEMO}
+    echo 'XIOS rev.'   	      > ${FILE_XIOS}; echo 'Fortran compiler' > ${FILE_CMPF}
+    echo 'MPI libs'    	      > ${FILE_LMPI}; echo 'NetCDF libs'      > ${FILE_NCDF}
+    echo 'Input files' 	      > ${FILE_INPT}; echo 'Elapsed time'     > ${FILE_TIME}
+    echo 'Memory usage (P/V)' > ${FILE_MEMY}; echo 'Comments'         > ${FILE_NOTE}
+
+    ## 'Failed' status with 'Unknown error' by default
+    echo ${TRUS_RSLT}      \
+	>> ${FILE_RSLT}
+    echo 'Unknown error' \
+	>> ${FILE_STAT}
+}
+
+get_date() {
+    ## UTC time zone for timestamping
+    local dat=$( date -ud "${DATE}" +"%F %R %Z" )
+
+    echo $dat           \
+	>> ${FILE_DATE}
+}
+
+get_nemo_rev() {
+    local dir rev_loc
+    local rev=0
+
+    ## Loop on essential NEMO directories
+    for dir in ${TRUS_CKOT} ${TRUS_XIOS}; do
+
+	## For time being, just get revision from XIOS with no action on directory
+	if [ $dir == ${TRUS_XIOS} ]; then
+	    rev_loc=$( svn info $dir | awk '/Last Changed Rev/ {print $NF}' )
+	    echo 'XIOS '${rev_loc} \
+		>> model.log
+	    echo "<a href=\"https://forge.ipsl.jussieu.fr/ioserver/changeset/${rev_loc}\" target=\"_blank\">${rev_loc}</a>" \
+		>> ${FILE_XIOS}
+	    continue
+	fi
+
+	echo $dir && ${TRUS_SVNA} ${TRUS_NGCM}/$dir
+	rev_loc=$( svn info ${TRUS_NGCM}/$dir | awk '/Last Changed Rev/ {print $NF}' )
+
+	## Keep last rev. nb
+	[ ${rev_loc} -gt $rev ] && rev=${rev_loc}
+    done
+
+    echo 'NEMOGCM '$rev \
+	>> model.log
+    echo "<a href=\"https://forge.ipsl.jussieu.fr/nemo/changeset/$rev\" target=\"_blank\">$rev</a>" \
+	>> ${FILE_NEMO}
+}
+
+get_soft_rel() {
+    local soft_rel str
+
+    ## Sourcing environment
+    if [ -n "${TRUS_ENVI}" ]; then
+	if [[  -e ${TRUS_ENVI}.env && $( declare -F | grep ' module' ) ]]; then
+            ## .env file if module function is available
+	    . ${TRUS_ENVI}.env
+	else
+            ## .path file if existing, if not the given file
+	    [ -e ${TRUS_ENVI}.path ] && . ${TRUS_ENVI}.path || . ${TRUS_ENVI}
+	fi
+    fi
+
+    ## Problem with `prepend-path` of modulefile that use ':' instead of ' ' as delimiter
+    [ $TRUS_HPCC == 'X64_ADA' ] && WRAPPER_LDFLAGS='-L/smplocal/pub/IdrMemMPI/1.4/lib -lidrmem '${WRAPPER_LDFLAGS}
+
+    for str in ${TRUS_CMPV} ${TRUS_MPIR} ${TRUS_CDFR} ${TRUS_CDOR}; do
+	[ -z "$str" ] && continue
+	soft_rel=''
+
+	## Software release: next word after "$soft" in $PATH (case-insensitive)
+	soft_rel=$( echo $PATH | sed "s#.*$str\([0-9.a-z_]*\).*#\1#i" )
+
+	## option --version would work for main compilers (gfortran, intel, pgfortran, ...)
+	[ $str == ${TRUS_CMPV} ] && soft_rel=$( $str --version | grep -m1 -oe '\<[0-9. ]*\>' )
+
+	## Cleaning characters string to display proper soft name
+	str=$( echo $str | sed 's#\\##g; s#[/-]$##' )
+
+	echo $str ${soft_rel} \
+	    >> model.log
+    done
+
+    sed -n 3p model.log \
+	>> ${FILE_CMPF}
+    sed -n 4p model.log \
+	>> ${FILE_LMPI}
+    sed -n 5p model.log \
+	>> ${FILE_NCDF}
+}
+
+get_inputs() {
+    ## Extract archive or copy files in case of personal inputs
+    [ -z "${TRUS_TARF}" ] && get_io="cp ${TRUS_FORC}/* ." || get_io="tar -vxf ${TRUS_FORC}/${TRUS_TARF}"
+
+    ${get_io} > /dev/null
+    [ $? -ne 0 ] && get_out 3 || echo 'Success'
+    [ $( find -name '*.gz' -print -quit ) ] && gunzip *.gz
+
+    ls -lh > inputs_list.txt
+}
+
+diff_inputs() {
+    local dif file
+    local files_list='' mesg='Same' 
+
+    ## Simple diff
+    for file in 'inputs_list.txt' *namelist_* *.xml cpp_*; do
+	dif=''
+
+	## Continue even if input file is not in here (see after)
+	if [ -e ${TRUS_STOR}/$file ]; then dif=$( diff -q $file ${TRUS_STOR}/$file ); else dif=0; fi
+
+	## Pass over useless file omission in benckmark directory
+	[[ -n "$dif" && "$dif" != '0' ]] && { mesg='Different'; echo $dif; files_list+=$file' '; }
+    done
+
+    [ $mesg == 'Same' ] && echo $mesg
+    echo $mesg          \
+	>> ${FILE_INPT}
+
+    ## List different files for web comment
+    [ -n "${files_list}" ] && echo 'Inputs  : '${files_list}'differ<br>' \
+	>> temp_${FILE_NOTE}
+}
+
+job_pending() {
+    local outline=$( printf "%100s" ) time_elapsed=0 time_increment=30
+
+    sleep ${time_increment}
+
+    ## Append a log file while pending
+    while [[ $( eval ${TRUS_JSTA} ) && ${time_elapsed} -lt ${TRUS_TOUT} ]]; do
+	printf "\n%s\n" ${outline// /#}          \
+	    >> computation.log
+	[ -n "${TRUS_JINF}" ] && eval ${JOB_INFO} \
+	    >> computation.log
+	sleep ${time_increment}
+	time_elapsed=$(( ${time_elapsed} + ${time_increment} ))
+    done
+
+    sleep ${time_increment}
+
+    ## Kill remaining job & stop the test if it's too long
+    [ ${time_elapsed} -eq ${TRUS_TOUT} ] && { eval ${JOB_DELE} &> /dev/null; get_out 6; }
+}
+
+diff_results() {
+    local file
+    local files_list='' mesg='Same'
+
+    ## Simple diff
+    for file in 'ocean.output' *.stat; do
+	## Stop if no benchmark files (ocean.output, eventual stat files)
+	[ ! -e ${TRUS_STOR}/$file ] && { TRUS_RSLT='FAILED'; get_out 7; }
+
+	diff -q $file ${TRUS_STOR}/$file
+
+	## Continue even if it differs
+	[ $? -ne 0 ] && { TRUS_RSLT='FAILED'; mesg='Different'; files_list+=$file' '; }
+    done
+
+    [ $mesg == 'Same' ] && echo $mesg
+
+    ## List different files for web comment
+    [ -n "${files_list}" ] && echo 'Results : '${files_list}'differ<br>' \
+	>> temp_${FILE_NOTE}
+}
+
+diff_restart() {
+    local base_name comp dif file list_comp list_tmsp nb_dom time_step tmsp
+    local files_list='' dif_sum=0
+
+    ## Stop if no benchmark files (ie time.step)
+    [ ! -e ${TRUS_STOR}/time.step ] && { TRUS_RSLT='FAILED'; get_out 7; }
+    time_step=$( cat ${TRUS_STOR}/time.step | tr -d [:space:] )
+
+    ## Find all restart files to rebuild
+    if [ $( find -regex ".*_restart.*[0-9]\.nc" -print -quit ) ]; then
+	base_name=$( find -regex ".*_restart.*[0-9]\.nc"                       \
+	             | sed "s#^\./\(.*\)_[0-9]*_restart.*#\1#"       | sort -u   )
+	list_comp=$( find -regex ".*_restart.*[0-9]\.nc"                       \
+	             | sed "s#^.*\(restart[a-z_]*\)_[0-9].*\.nc#\1#" | sort -u   )
+	list_tmsp=$( find -regex ".*_restart.*[0-9]\.nc"                       \
+	             | sed "s#^.*\([0-9]\{8\}\)_restart.*#\1#"       | sort -u   )
+
+	## Loop on each time step
+	for tmsp in ${list_tmsp}; do
+
+	    for comp in ${list_comp}; do
+		file=${base_name}_${tmsp}_${comp}
+		nb_dom=$( find -name "${file}_[0-9]*.nc" | wc -l | awk '{ print $1 }' )
+
+		if   [ ${nb_dom} -gt 1 ]; then
+		    ${TRUS_NGCM}/TOOLS/REBUILD_NEMO/rebuild_nemo -t ${TRUS_NPRO} $file ${nb_dom} \
+			> /dev/null
+
+		     ## Possibility of remaining decomposed restarts (even after rebuild)
+		    [ $? -eq 0 ] && rm -f ${file}_[0-9]*.nc \
+                        > /dev/null
+
+		elif [ ${nb_dom} -eq 0 ]; then
+		    TRUS_RSLT='FAILED' && get_out 8
+		fi
+
+		## Compare restart files at same time step
+		if [ $tmsp -eq ${time_step} ]; then
+
+                    ## Stop if no benchmark files (restart file)
+		    if [ -e ${TRUS_STOR}/$file.nc ]; then
+
+	                ## UNIX `cmp` not suitable (timestamp in .nc file)
+			dif=$( $TRUS_CDOD $file.nc ${TRUS_STOR}/$file.nc 2> /dev/null          \
+			       | awk '/records/ {print $0}' | sed '2 s/^/,/' | tr -d '\n' )
+
+			## CDO can return void stdout with no difference
+			if [[ -n "$dif" && $( echo $dif | awk '{print $1}' ) -ne 0 ]]; then
+			    TRUS_RSLT='FAILED'
+			    files_list+=$comp' ' && let dif_sum+=$( echo $dif | awk '{print $1}' )
+			    echo $file.nc': '$dif
+			fi
+
+		    else
+			TRUS_RSLT='FAILED' && get_out 7
+		    fi
+
+		else
+		    continue
+		fi
+
+	    done
+
+	done
+
+        ## List different files for web comment with sum of different records
+	if [ ${dif_sum} -ne 0 ]; then
+	    echo 'Restarts: '${files_list}${dif_sum}' record(s) differ<br>' \
+		>> temp_${FILE_NOTE}
+	else
+	    echo 'Same'
+	fi
+
+    else
+	TRUS_RSLT='FAILED'
+    fi
+
+}
+
+get_time() {
+    [ -z "${TRUS_JTIM}" ] && return
+
+    ## Interest for checking unusual time computation
+    local time_cpu=$( eval ${TRUS_JTIM} )
+
+    printf "Elapsed time: "
+    echo ${time_cpu} | tee -a ${FILE_TIME}
+}
+
+get_memy() {
+    [[ -z "${TRUS_JPME}" && -z "${TRUS_JVME}" ]] && return
+
+    ## Interest for checking unusual memory usage
+    local memory_pmax=$( eval ${TRUS_JPME} ) memory_vmax=$( eval ${TRUS_JVME} )
+
+    printf "Memory max usage (physical/virtual): "
+    echo ${memory_pmax}' / '${memory_vmax} | tee -a ${FILE_MEMY}
+}
+
+comments() {
+    local opat
+    local line='' state=$1
+
+    if [ -e ocean.output ]; then
+        ## 'W A R N I N G' pattern by default
+	opat="-A2 \"^ $state\""
+	[ "$state" == 'E R R O R' ] && opat="-A4 \"$state\""
+
+        ## Select first occurence for web comment
+	line=$( eval grep -m1 $opat ocean.output | tr -d '\n' )
+    fi
+
+    [ -n "$line" ] && ( echo $line; printf "$line<br>" \
+	>> temp_${FILE_NOTE} )
+}
+
+log_make() {
+    ## Format comments for web
+    [ -e temp_${FILE_NOTE} ] && cat temp_${FILE_NOTE} | tr -d '\n' | sed 's/<br>$//' \
+	>> ${FILE_NOTE}
+
+    ## Construct txt file with all messenger files
+    paste -d ';' mesg_*.txt | tee ${TRUS_FILE}
+}
+
+prod_publish() {
+    local cmd
+    local rev=$( awk '/NEMOGCM/ {print $NF}' model.log )
+
+    ## Production mode (-p|--prod)
+    if [ ${TRUS_PROD} -eq 1 ]; then
+
+	## Create or append trusting logfile
+	if [ -f ${TRUS_STOR}/trusting_$PATTERNAME.txt ]; then cmd='tail -1'; else cmd='cat'; fi
+
+	$cmd ${TRUS_FILE}                            \
+	    >> ${TRUS_STOR}/trusting_$PATTERNAME.txt
+
+        ## Send mail only when FAILED
+	if [[ ! -z "${TRUS_MAIL}" && ${TRUS_RSLT} == 'FAILED' ]]; then
+
+	    ## Content
+	    cat <<END_MAIL      \
+		> trusting.mail
+Dear all,
+
+
+The trusting sequence has not completed successfully on new configuration ${TRUS_CONF} based on ${TRUS_REFE}.
+
+Here is the model summary:
+`cat model.log`
+
+First checking would be on the trusting environment files:
+${TRUS_USER}.cfg & ${TRUS_HPCC}.cfg
+
+For more details, look into the testing folder at:
+${TRUS_SCRA}
+
+An archive has been created to share the questionable configuration for further studies:
+${TRUS_STOR}/${TRUS_ARCH}
+
+END_MAIL
+
+	    ## Send with detailed subject
+	    mail -s "[NEMO Trusting][$rev][${TRUS_BRAN}][${TRUS_REFE}] ${TRUS_RSLT} ${TRUS_RORR}" ${TRUS_MAIL} \
+		<  trusting.mail
+	fi
+
+    fi
+}
+
+get_out() {
+    local time_step=0
+
+    TRUS_RORR=$1
+
+    printf "\n\nEnd of test\n"
+
+    ## In case of compilation error
+    cd ${TRUS_SCRA}
+
+    if [ ${TRUS_RSLT} == 'FAILED' ]; then
+	echo 'Failure'
+
+        ## Error identification
+	case ${TRUS_RORR} in
+            ## Compilation
+	    '1') TRUS_RORR='XIOS compilation failed' ;; '2') TRUS_RORR='NEMO compilation failed';;
+	    ## Submission
+	    '3') TRUS_RORR='Missing input files'     ;; '4') TRUS_RORR='Job submission error'   ;;
+	    ## Computation
+	    '5') TRUS_RORR='Crashed at time step'    ;; '6') TRUS_RORR='Exceeded time limit'    ;;
+	    ## Results
+	    '7') TRUS_RORR='Missing previous outputs';; '8') TRUS_RORR='New outputs differ'     ;;
+	    ## Other
+	    '*') TRUS_RORR='Unknown error'           ;;
+	esac
+
+    else
+	echo 'Success' && TRUS_RORR='Code is reliable'
+    fi
+
+    ## Eventual comments from ocean.output
+    if [ "${TRUS_RORR}" == 'Crashed at time step' ]; then
+	comments 'E R R O R'
+	[ -e time.step ] && time_step=$( grep -o [0-9]* time.step )
+	TRUS_RORR+=' '$time_step
+    else
+	comments 'W A R N I N G'
+	[ "${TRUS_RORR}" == 'Exceeded time limit' ] && TRUS_RORR+=' '$(( ${TRUS_TOUT}/3600 ))'h'
+    fi
+
+    ## Last messenger files
+    #export TRUS_RORR
+    sed -i "2 s/.*/$TRUS_RSLT/" ${FILE_RSLT}; sed -i "2 s/.*/$TRUS_RORR/" ${FILE_STAT}
+
+    ## Save tested configuration if trusting failed in production mode (-p|--prod)
+    if [[ ${TRUS_RSLT} == 'FAILED' && ${TRUS_PROD} -eq 1 ]]; then
+	echo 'Creating archive '${TRUS_ARCH}' under '${TRUS_STOR}
+	tar -czf ${TRUS_STOR}/${TRUS_ARCH}               *                    \
+	    -C   ${TRUS_NGCM}/CONFIG/${TRUS_CONF}/MY_SRC .                    \
+	    -C   ${TRUS_NGCM}/CONFIG/${TRUS_CONF}        cpp_${TRUS_CONF}.fcm
+    fi
+
+    ## Logfile construct & eventual sending of notification email
+    printf "\nTrusting digest:\n----------------\n"
+    log_make
+    prod_publish
+
+    exit 0
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting_help.txt
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting_help.txt	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inc/trusting_help.txt	(revision 8732)
@@ -0,0 +1,42 @@
+Usage: ./trusting.sh        -u $USER -m $ARCH [OPTIONS]
+       ./install_new_branch -u $USER -m $ARCH [OPTIONS]
+
+./trusting.sh            Launch trusting test on $ARCH machine from $USER installation
+./install_new_branch     Install new branch in $USER installation for trusting test on $ARCH machine
+
+Examples: `./trusting.sh        -u romr005 -m X64_CURIE -p -b nemo_v3_6_STABLE`
+          `./install_new_branch -u romr005 -m X64_ADA   -w $HOME/NEMO         `
+
+Mandatory
+    Default settings to source in ./config, templates (arch_template.cfg & user_template.cfg)
+    -m,--machine      Architecture environment (compilation & computation settings)
+    -u,--user         User             ""      (NEMO & XIOS installation)		   
+
+
+Options (modify default settings)
+SVN
+    -b,--branch	      Branch name in working directory ('trunk'|'nemo_v3_6_stable'|...)
+    -v,--version      Action on working copy ('status' by default)
+  		           '{'YYYY-MM-DD'}'  Update to revision available at this date
+		           [0-9]*	       ""   ""    ""    number
+		           HEAD|up|update      ""   "" last revision
+		           st|status	     Show differences with repository
+    -w,--workdir      Installation directory for testing branches
+
+Inputs
+    -a,--archive      Forcing input files archive to extract, if void it will copy all files from given folder (see next line)
+    -f,--forcdir      Path to your personal folder of forcing inputs
+
+Testing configuration
+    -n,--new_conf     Testing   configuration folder created in ./CONFIG
+    -r,--ref_conf     Reference      " "      for trusting test
+
+Compiling & computation
+    -j,--job          Number of processes for compiling
+    -t,--time         Timeout for computation (s)
+
+Trusting output
+    -d,--debug        Verbose output for debugging purpose (`set -vx`)
+    -e,--email        Email trusting digest report to following addresses only on failure
+    -h,--help         Print this help & exit
+    -p,--prod         Production mode (append trusting logfile)
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/AMM12/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/AMM12/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/AMM12/iodef.xml	(revision 8732)
@@ -0,0 +1,157 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1950-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+	
+      </file_group>
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+
+	<file id="file4" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file5" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"    />
+	  <field field_ref="ssu"          name="uos"   />
+	  <field field_ref="utau"         name="tauuo" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"    />
+	  <field field_ref="ssv"          name="vos"   />
+	  <field field_ref="vtau"         name="tauvo" />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+	
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+    
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+     <grid id="gznl_T_2D" domain_ref="gznl"/>
+     <grid id="gznl_T_3D" domain_ref="gznl" axis_ref="deptht"/>
+     <grid id="gznl_W_3D" domain_ref="gznl" axis_ref="depthw"/>
+    </grid_definition>   
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">10000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/AMM12/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/AMM12/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/AMM12/namelist_cfg	(revision 8732)
@@ -0,0 +1,432 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : AMM12 configuration namelist used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "AMM12_trust"  	!  experience name
+   nn_it000    =       1   	 	!  first time step
+   nn_itend    =     576   	 	!  last  time step (std 1 day = 144)
+   nn_date0    =  20120102 	 	!  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_leapy    =       1   	 	!  Leap year calendar (1) or not (0)
+   ln_rstart   =  .true.         	!  start from rest (F) or from a restart file (T)
+   nn_euler    =       1   	 	!  = 0 : start with forward time step if ln_rstart=.true.
+   cn_ocerst_in   = "amm12_restart_oce" !  suffix of ocean restart name (input)
+   cn_ocerst_out  = "restart_oce_out"   !  suffix of ocean restart name (input)
+   nn_stock    =    1296   	 	!  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =     144   	 	!  frequency of write in the output file   (modulo referenced to nit000) 
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "amm"                !  name of the configuration
+   jp_cfg      =     011               !  resolution of the configuration
+   jpidta      =     198               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     224               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      51               !  number of levels      ( >= jpk )
+   jpiglo      =     198               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     224               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .true.    !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.   !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .true.    !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .true.    !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_hc       =   50.0    !  critical depth for transition to stretched coordinates
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdtmin   =   600.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   =   600.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =   600.          !  depth variation of tracer time step  (used if nn_acc=1)
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999999.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999999.0             ! (default coefficients)
+   ppa1        =  999999.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5720.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+   ln_bt_nn_auto =    .FALSE.          !  Set nn_baro automatically to be just below
+                                       !  a user defined maximum courant number (rn_bt_cmax)
+   nn_baro       =    30               !  Number of iterations of barotropic mode
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   ln_flx      = .true.    !  flux formulation       (T => fill namsbc_flx )
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+   ln_apr_dyn  = .false.    !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_utau     = 'amm12_utau'     ,          1        ,  'utau'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_vtau     = 'amm12_vtau'     ,          1        ,  'vtau'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_qtot     = 'amm12_flx'      ,          3        ,  'sonsfldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_qsr      = 'amm12_flx'      ,          3        ,  'soshfldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   sn_emp      = 'amm12_flx'      ,          3        ,  'sowafldo'  ,  .true.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+   cn_dir      = './fluxes/'        !  root directory for the location of the flux files
+/
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'amm12_rivers'       ,        24         , 'rorunoff',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_cnf      = 'runoff_1m_nomask'   ,         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_s_rnf    = 'amm12_rivers'       ,        24         , 'rosaline',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_t_rnf    = 'amm12_rivers'       ,        24         , 'rotemper',   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   sn_dep_rnf  = 'amm12_rivers'       ,        24         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''  , ''
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   ln_rnf_depth = .true.    !  read in depth information for runoff
+   ln_rnf_tem   = .true.    !  read in temperature information for runoff
+   ln_rnf_sal   = .true.    !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_apr     = 'amm12_mslp'     ,          1        ,  'p_msl'      , .false.      , .false. , 'daily'   ,  ''      ,  ''  , ''
+
+   cn_dir      = './fluxes/' !  root directory for the location of the bulk files
+   rn_pref     = 101000.     !  reference atmospheric pressure   [N/m2]/
+   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F)
+   ln_apr_obc  = .true.    !  inverse barometer added to OBC ssh data
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_sst      = 'amm12_sstref'    ,        24         ,  'sst'     ,     .true.     , .false. , 'daily'   , .false. , ''       , '' , ''
+   sn_sss      = 'sss_data'        ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , .false. , ''       , '' , ''
+
+   cn_dir      = 'fluxes/' !  root directory for the location of the runoff files
+   nn_sstr     =     1     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_deds     =  -27.7    !  magnitude of the damping on salinity   [mm/day]
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =     0     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters
+!-----------------------------------------------------------------------
+   ln_tide     = .true.
+   clname(1)     =   'Q1'   !  name of constituent
+   clname(2)     =   'O1'
+   clname(3)     =   'P1'
+   clname(4)     =   'S1'
+   clname(5)     =   'K1'
+   clname(6)     =   '2N2'
+   clname(7)     =   'MU2'
+   clname(8)     =   'N2'
+   clname(9)     =   'NU2'
+   clname(10)    =   'M2'
+   clname(11)    =   'L2'
+   clname(12)    =   'T2'
+   clname(13)    =   'S2'
+   clname(14)    =   'K2'
+   clname(15)    =   'M4'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+    ln_bdy         = .true.
+    nb_bdy         =  1
+    cn_dyn2d       = 'flather'
+    nn_dyn2d_dta   =  3
+    cn_tra         =  'frs'
+    nn_tra_dta    =   1 
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   bn_ssh =     'amm12_bdyT_dyn2d' ,         24        , 'sossheig' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_u2d =     'amm12_bdyU_dyn2d' ,         24        , 'vobtcrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_v2d =     'amm12_bdyV_dyn2d' ,         24        , 'vobtcrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_u3d  =    'amm12_bdyU_dyn3d' ,         24        , 'vozocrtx' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_v3d  =    'amm12_bdyV_dyn3d' ,         24        , 'vomecrty' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_tem  =    'amm12_bdyT_tra'   ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   bn_sal  =    'amm12_bdyT_tra'   ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''  , ''
+   cn_dir  =    './bdydta/'
+   ln_full_vel = .false.
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri2    =    2.5e-3 !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    0.0e0  !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_loglayer =    .true. !  loglayer bottom friction (only effect when nn_bfr = 2)
+   rn_bfrz0    =    0.003  !  bottom roughness (only effect when ln_loglayer = .true.)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp")
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =    50.    !  horizontal eddy diffusivity for tracers [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_prj  = .true.   !  s-coordinate (Pressure Jacobian scheme)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator :
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator
+   ln_dynldf_lap    =  .false.  !  bilaplacian operator
+   !                       !  Direction of action  :
+   ln_dynldf_level  =  .true.   !  iso-level
+   ln_dynldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+                           !  Coefficient
+   rn_ahm_0_lap     = 60.0      !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahm_0_blp     = -1.0e+10  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   0.1e-6  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   0.1e-6  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   ln_zdfevd   = .false.   !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_charn =  100000.     !  Charnock constant for wb induced roughness length
+   nn_z0_met = 1           !  Method for surface roughness computation (0/1/2)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_diaharm   !   Harmonic analysis of tidal constituents ('key_diaharm')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/GYRE/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/GYRE/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/GYRE/iodef.xml	(revision 8732)
@@ -0,0 +1,284 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1900-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+ 
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+
+        <file id="file4" name_suffix="_bioscalar" description="pisces sms variables" >
+          <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>
+          <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+          <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
+          <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
+          <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
+        <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field>
+                                                                                                                             </file>
+      </file_group>
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+
+	<file id="file5" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"     />
+	  <field field_ref="ssu"          name="uos"    />
+	  <field field_ref="utau"         name="tauuo"  />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"     />
+	  <field field_ref="ssv"          name="vos"    />
+	  <field field_ref="vtau"         name="tauvo"  />
+	</file>
+	
+	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+	
+	<file id="file9" name_suffix="_icemod" description="ice variables" >
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd"    />
+	  <field field_ref="icethic_cea"  name="sit"    />
+	  <field field_ref="iceprod_cea"  name="sip"    />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
+	</file>
+	
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+
+	<file id="file10" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="PO4"      />
+          <field field_ref="Si"       />
+          <field field_ref="Fer"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+	</file>
+	
+	<file id="file11" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+	</file>
+
+      </file_group>
+
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files -->
+
+	<file id="file12" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="CaCO3"    />
+          <field field_ref="PO4"      />
+          <field field_ref="POC"      />
+          <field field_ref="Si"       />
+          <field field_ref="PHY"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="DOC"      />
+          <field field_ref="PHY2"     />
+          <field field_ref="ZOO2"     />
+          <field field_ref="DSi"      />
+          <field field_ref="Fer"      />
+          <field field_ref="BFe"      />
+          <field field_ref="GOC"      />
+          <field field_ref="SFe"      />
+          <field field_ref="DFe"      />
+          <field field_ref="GSi"      />
+          <field field_ref="NFe"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+	</file>
+
+	<file id="file13" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="PH"       />
+          <field field_ref="CO3"      />
+          <field field_ref="CO3sat"   />
+          <field field_ref="PAR"      />
+          <field field_ref="PPPHY"    />
+          <field field_ref="PPPHY2"   />
+          <field field_ref="PPNEWN"   />
+          <field field_ref="PPNEWD"   />
+          <field field_ref="PBSi"     />
+          <field field_ref="PFeN"     />
+          <field field_ref="PFeD"     />
+          <field field_ref="xfracal"  />
+          <field field_ref="PCAL"     />
+          <field field_ref="DCAL"     />
+          <field field_ref="GRAZ1"    />
+          <field field_ref="GRAZ2"    />
+          <field field_ref="EPC100"   />
+          <field field_ref="EPFE100"  />
+          <field field_ref="EPSI100"  />
+          <field field_ref="EPCAL100" />
+          <field field_ref="Cflx"     />
+          <field field_ref="Oflx"     />
+          <field field_ref="Kg"       />
+          <field field_ref="Dpco2"    />
+          <field field_ref="Dpo2"     />
+          <field field_ref="Heup"     />
+          <field field_ref="Irondep"  />
+          <field field_ref="Ironsed"  />
+          <field field_ref="Ironice"  />
+          <field field_ref="Nfix"     />
+          <field field_ref="MuN"      />
+          <field field_ref="MuD"      />
+          <field field_ref="LNnut"    />
+          <field field_ref="LDnut"    />
+          <field field_ref="LNFe"     />
+          <field field_ref="LDFe"     />
+          <field field_ref="LNlight"  />
+          <field field_ref="LDlight"  />
+          <field field_ref="pdust"    />
+          <field field_ref="Fe2"      />
+          <field field_ref="Fe3"      />
+          <field field_ref="FeL1"     />
+          <field field_ref="FeL2"     />
+          <field field_ref="FeP"      />
+          <field field_ref="TL1"      />
+          <field field_ref="TL2"      />
+          <field field_ref="Sdenit"   />
+          <field field_ref="Totlig"   />
+	</file>
+
+      </file_group>
+
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+    </grid_definition>  
+  
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">50000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/GYRE/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/GYRE/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/GYRE/namelist_cfg	(revision 8732)
@@ -0,0 +1,371 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  : GYRE_PISCES Configuration namelist to overwrite reference dynamical namelist
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  'GYRE_trust'		 !  experience name
+   nn_it000    =       1   		 !  first time step
+   nn_itend    =     120   		 !  last  time step
+   nn_stock    =      60   		 !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg     !   parameters of the configuration   
+!-----------------------------------------------------------------------
+   cp_cfg      =  "gyre"                 !  name of the configuration
+   jp_cfg      =       1                 !  resolution of the configuration
+   jpidta      =      32                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2
+   jpjdta      =      22                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2 
+   jpkdta      =      31                 !  number of levels      ( >= jpk )
+   jpiglo      =      32                 !  1st dimension of global domain --> i  = jpidta
+   jpjglo      =      22                 !  2nd    -                  -    --> j  = jpjdta
+   jpizoom     =       1                 !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1                 !  in data domain indices
+   jperio      =       0                 !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
+   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   jphgr_msh   =       5                 !  type of horizontal mesh
+   ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      29.0               ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0               !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0               !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0               !  meridional grid-spacing (degrees)
+   ppsur       =   -2033.194295283385    !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     155.8325369664153   ! (default coefficients)
+   ppa1        =     146.3615918601890   !
+   ppkth       =      17.28520372419791  !
+   ppacr       =       5.0               !
+   ppdzmin     =  999999.0               !  Minimum vertical spacing
+   pphmax      =  999999.0               !  Maximum depth
+   ldbletanh   =  .FALSE.                !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0               !  Double tanh function parameters
+   ppkth2      =  999999.0               !
+   ppacr2      =  999999.0               !
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   cn_dir        = './'      !  root directory for the location of the runoff files
+   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F)
+   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+   !                       !     (also = the frequency of sea-ice model call)
+   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana )
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core)
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.1e0   !  uniform value for the i-stress
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_tide      !    tide parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =  0       !  type of equation of state and Brunt-Vaisala frequency
+                                 !  =-1, TEOS-10 
+                                 !  = 0, EOS-80 
+                                 !  = 1, S-EOS   (simplified eos)
+   ln_useCT    = .false.  ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm
+   !                             !
+   !                      ! S-EOS coefficients :
+   !                             !  rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+   rn_a0       =  1.6550e-1      !  thermal expension coefficient (nn_eos= 1)
+   rn_b0       =  7.6554e-1      !  saline  expension coefficient (nn_eos= 1)
+   rn_lambda1  =  5.9520e-2      !  cabbeling coeff in T^2  (=0 for linear eos)
+   rn_lambda2  =  7.4914e-4      !  cabbeling coeff in S^2  (=0 for linear eos)
+   rn_mu1      =  1.4970e-4      !  thermobaric coeff. in T (=0 for linear eos)
+   rn_mu2      =  1.1090e-5      !  thermobaric coeff. in S (=0 for linear eos)
+   rn_nu       =  2.4341e-3      !  cabbeling coeff in T*S  (=0 for linear eos)
+!!org GYRE   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+!!org GYRE   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+!!org  caution  now a0 = alpha / rau0   with rau0 = 1026
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.   !  2nd order centered scheme
+   ln_traadv_tvd    =  .true.    !  TVD scheme
+   ln_traadv_muscl  =  .false.   !  MUSCL scheme
+   ln_traadv_muscl2 =  .false.   !  MUSCL2 scheme + cen2 at boundaries
+   ln_traadv_ubs    =  .false.   !  UBS scheme
+   ln_traadv_qck    =  .false.   !  QUICKEST scheme
+   ln_traadv_msc_ups=  .false.   !  use upstream scheme within muscl
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  energy    conserving scheme  
+   ln_dynvor_ens = .false. !  enstrophy conserving scheme    
+   ln_dynvor_een = .false. !  energy & enstrophy scheme
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.    !  z-coordinate - full steps
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+   nn_nmin     =    210    !  minimum of iterations for the SOR solver
+   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE
+   ln_dyn_trd  = .false.   ! (T) 3D momentum trend output
+   ln_dyn_mxl  = .FALSE.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)
+   ln_vor_trd  = .FALSE.   ! (T) 2D barotropic vorticity trends (not coded yet)
+   ln_KE_trd   = .false.   ! (T) 3D Kinetic   Energy     trends
+   ln_PE_trd   = .false.   ! (T) 3D Potential Energy     trends
+   ln_tra_trd  = .false.    ! (T) 3D tracer trend output
+   ln_tra_mxl  = .false.   ! (T) 2D tracer trends averaged over the mixed layer (not coded yet)
+   nn_trd      = 365       !  print frequency (ln_glo_trd=T) (unit=time step)
+/
+!!gm   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+!!gm   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+!!gm   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+!!gm   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+!!gm   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+!!gm   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+!!gm
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 60       !  time step frequency for transports computing
+    nn_dctwri   = 60       !  time step frequency for transports writing
+    nn_secdebug = 0        !      0 : no section to debug
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_cfg	(revision 8732)
@@ -0,0 +1,331 @@
+
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "O1L3P_trust"        !  experience name
+   nn_itend    =     240               !  last  time step (std 5475)
+   nn_euler    =       0               !  = 0 : start with forward time step if ln_rstart=T
+   nn_stock    =     120               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+!   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpjdta      =     332               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+!   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jpjglo      =     332               !  2nd    -                  -    --> j  =jpjdta
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     103.9530096000000 ! (default coefficients)
+   ppa1        =       2.415951269000000   !
+   ppkth       =      15.35101370000000    !
+   ppacr       =       7.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ppa2        =     100.7609285000000 !  Double tanh function parameters
+   ppkth2      =      48.02989372000000    !
+   ppacr2      =      13.00000000000   !
+   rn_rdt      =    3600.              !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_hmin     =   20. 
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsplit       
+!----------------------------------------------------------------------- 
+   ln_bt_fw      =    .TRUE.           !  Forward integration of barotropic equations
+   ln_bt_av      =    .TRUE.           !  Time filtering of barotropic variables
+   ln_bt_nn_auto =    .TRUE.           !  Set nn_baro automatically to be just below
+                                       !  a user defined maximum courant number (rn_bt_cmax)
+   nn_baro       =    30               !  Number of iterations of barotropic mode
+                                       !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F
+   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T 
+   nn_bt_flt     =    1                !  Time filter choice
+                                       !  = 0 None
+                                       !  = 1 Boxcar over   nn_baro barotropic steps
+                                       !  = 2 Boxcar over 2*nn_baro     "        
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+   ln_tsd_tradmp = .false.  !  damping of ocean T & S toward T &S input data (T) or not (F)
+   sn_tem  = 'conservative_temperature_WOA13_decav_Reg1L75_clim', -1 ,'votemper' , .true. , .true. , 'yearly' , 'weights_3D_WOA13d1_2_eorca1_bilinear.nc'  ,   ''    ,    ''
+   sn_sal  = 'absolute_salinity_WOA13_decav_Reg1L75_clim'       , -1 ,'vosaline' , .true. , .true. , 'yearly' , 'weights_3D_WOA13d1_2_eorca1_bilinear.nc'  ,   ''    ,    ''
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 3         !  frequency of surface boundary condition computation
+   nn_ice_embd = 1         ! embedded sea-ice (full salt and mass exchanges and pressure)
+   ln_dm2dc    = .true.    !  Daily mean to diurnal cycle on short wave
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked
+   ln_rnf      = .true.    !  runoffs                                   (T   => fill namsbc_rnf)
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !   file name                  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
+!              !                              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_fill'       ,         6         , 'U_10_MOD',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bicubic.nc'  , 'U1'
+   sn_wndj     = 'v_10.15JUNE2009_fill'       ,         6         , 'V_10_MOD',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bicubic.nc'  , 'V1'
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'SWDN_MOD',   .false.    ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,        24         , 'LWDN_MOD',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_tair     = 't_10.15JUNE2009_fill'       ,         6         , 'T_10_MOD',   .false.    ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'       ,         6         , 'Q_10_MOD',   .false.    ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill',        -1         , 'PRC_MOD1',   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill',        -1         , 'SNOW'    ,   .true.     ,  .true. , 'yearly'  , 'weights_coreII_2_eorca1_bilinear.nc' , ''
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+   sn_chl      ='merged_ESACCI_BIOMER4V1R1_CHL_REG05',  -1  , 'CHLA' , .true. , .true. , 'yearly' , 'weights_reg05_2_eorca1_bilinear.nc' , '' , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_rnf      = 'eORCA_R1_runoff_clim_v1.0_nomask',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_cnf      = 'eORCA_R1_runoff_clim_v1.0_nomask',         0         , 'socoeff' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''       , ''
+
+   ln_rnf_mouth = .false.    !  specific treatment at rivers mouths
+   ln_rnf_depth = .false.    !  read in depth information for runoff
+   ln_rnf_tem   = .false.    !  read in temperature information for runoff
+   ln_rnf_sal   = .false.    !  read in salinity information for runoff
+   ln_rnf_depth_ini = .true. !  compute depth at initialisation from runoff file
+   rn_rnf_max   = 0.05       !  max value of the runoff climatology over global domain ( if ln_rnf_depth_ini = .true )
+   rn_dep_max = 150.         !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+   nn_rnf_depth_file = 1     ! create (=1) a runoff depth file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_sss      = 'sss_absolute_salinity_WOA13_decav_Reg1L75_clim', -1. , 'sosaline', .true. , .true. , 'yearly' , 'weights_WOA13d1_2_eorca1_bilinear.nc' , ''
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+      ln_icebergs              = .false.
+      ln_bergdia               = .false.              ! Calculate budgets
+      nn_verbose_level         = 0                    ! Turn on more verbose output if level > 0
+      nn_verbose_write         = 120                  ! Timesteps between verbose messages
+      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage
+                                                      ! Initial mass required for an iceberg of each class
+      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
+                                                      ! Proportion of calving mass to apportion to each class  
+      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
+                                                      ! Ratio between effective and real iceberg mass (non-dim)
+                                                      ! i.e. number of icebergs represented at a point         
+      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
+                                                      ! thickness of newly calved bergs (m)
+      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250.
+      rn_rho_bergs             = 850.                 ! Density of icebergs
+      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs
+      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics
+      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits
+      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1)
+      ln_passive_mode          = .false.              ! iceberg - ocean decoupling   
+      nn_test_icebergs         =   8                  ! Create test icebergs of this class (-1 = no)
+                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2)
+      !rn_test_box              = 108.0,  116.0, -66.0, -58.0
+      rn_test_box              = -180.0,  180.0,  70.0,  90.0     !
+      rn_speed_limit           = 0.                   ! CFL speed limit for a berg   
+
+!              ! file name ! frequency (hours) !   variable   ! time interp.   !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!              !           !  (if <0  months)  !     name     !   (logical)    !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      !
+      sn_icb =  'calving' ,       -1           , 'calvingmask',  .true.        , .true.  , 'yearly'  , ''       , ''       , ''
+   
+      cn_dir = './' 
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.0    !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   sn_qgh      ='Goutorbe_ghflux.nc',  -12.  , 'gh_flux'    ,   .false.     , .true. , 'yearly'  , 'weights_Goutorbe1_2_eorca1_bilinear.nc'       , ''       , ''
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+   ln_traadv_tvd    =  .true.   !  TVD scheme
+   ln_traadv_ubs    =  .false.  !  UBS scheme
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   ln_traldf_grif   =  .false.   !  griffies skew flux formulation       (require "key_ldfslp")
+   ln_traldf_gdia   =  .false.   !  griffies operator strfn diagnostics  (require "key_ldfslp")
+   ln_botmix_grif   =  .false.   !  griffies operator with lateral mixing on bottom (require "key_ldfslp")
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_aeiv_0        =  1000.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme
+   nn_dynkeg     = 1       !  scheme for grad(KE): =0  C2  ; =1  Hollingsworth correction
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation)
+   !ln_hpg_isf  = .true.    !  s-coordinate (sco ) adapted to isf
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                           !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   rn_ahm_0_lap     = 20000.    !  horizontal laplacian eddy viscosity   [m2/s]
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =       2               !  elliptic solver: =2 successive-over-relaxation (sor)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!----------------------------------------------------------------------- 
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+   ln_diahsb  = .true.  
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_vvl    !   vertical coordinate options
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends
+!              !       and/or mixed-layer trends and/or barotropic vorticity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_ice_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_ice_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA1_LIM3_PISCES/namelist_ice_cfg	(revision 8732)
@@ -0,0 +1,42 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM-3 : Ice configuration namelist. Overwrites SHARED/namelist_ice_lim3_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!-----------------------------------------------------------------------
+&namicerun     !   Share parameters for dynamics/advection/thermo
+!-----------------------------------------------------------------------
+   ln_limdiahsb  = .false.         !  check the heat and salt budgets (T) or not (F)
+   ln_limdiaout  = .false.          !  output the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namiceini     !   ice initialisation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicedyn     !   ice dynamic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicethd     !   ice thermodynamic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicesal     !   ice salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namiceitdme   !   parameters for mechanical redistribution of ice 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namicedia     !   ice diagnostics
+!-----------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namiceitd     !   Ice discretization
+!------------------------------------------------------------------------------
+/
+!------------------------------------------------------------------------------
+&namicehdf     !   Ice horizontal diffusion
+!------------------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM/1_namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM/1_namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM/1_namelist_cfg	(revision 8732)
@@ -0,0 +1,228 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  Configuration namelist used to overwrite SHARED/1_namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =   "O2LA_trust"        !  experience name 
+   nn_itend    =     300  	       !  last  time step
+   nn_stock    =     150               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "default"             !  name of the configuration
+   jp_cfg      =      -1               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------  
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      !
+   sn_wndi     = 'u_10.15JUNE2009_fill'        ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'      , 'Uwnd'   , ''
+   sn_wndj     = 'v_10.15JUNE2009_fill'        ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'      , 'Vwnd'   , ''
+   sn_qsr      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_fill'        ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_fill'        ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_fill' ,        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_zqt      = 10.        !  Air temperature and humidity reference height (m)
+   rn_zu       = 10.        !  Wind vector reference height (m)
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+   rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.)
+   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity
+                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.   !  add a damping termn (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers 
+!-----------------------------------------------------------------------
+
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .false.  !  laplacian operator         
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
+   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM/namelist_cfg	(revision 8732)
@@ -0,0 +1,203 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =   "O2LA_trust"        !  experience name 
+   nn_itend    =     150  	       !  last  time step
+   nn_stock    =      75               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fwb      =       0               !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =      2    !  elliptic solver: =2 successive-over-relaxation (sor)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namobs       !  observation usage                                      ('key_diaobs')
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/iodef.xml
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/iodef.xml	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/iodef.xml	(revision 8732)
@@ -0,0 +1,284 @@
+<?xml version="1.0"?>
+<simulation> 
+
+ <context id="nemo" time_origin="1900-01-01 00:00:00" >
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    <field_definition src="./field_def.xml"/>
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+ 
+    
+    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">
+    
+      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
+      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files -->
+      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files -->
+      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->     
+      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files -->
+      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->
+     
+      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files -->
+
+	<file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="sst"          name="tos" />
+	  <field field_ref="sss"          name="sos" />
+	  <field field_ref="ssh"          name="zos" />
+	</file>
+
+	<file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="ssu"          name="uos" />
+	</file>
+	
+	<file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="ssv"          name="vos" />
+	</file>
+
+        <file id="file4" name_suffix="_bioscalar" description="pisces sms variables" >
+          <field field_ref="tdenit"   name="tdenit"   unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tnfix"    name="tnfix"    unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>
+          <field field_ref="tcflx"    name="tcflx"    unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tcflxcum" name="tcflxcum" unit="PgC"    operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>
+          <field field_ref="tcexp"    name="tcexp"    unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="tintpp"   name="tintpp"   unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>
+          <field field_ref="pno3tot"  name="pno3tot"  unit="umolN"  > pno3tot * 16. / 122. * 1e6 </field>
+          <field field_ref="ppo4tot"  name="ppo4tot"  unit="umolP"  > ppo4tot * 1. / 122. * 1e6 </field>
+          <field field_ref="psiltot"  name="psiltot"  unit="umolC"  > psiltot * 1e6  </field>
+          <field field_ref="palktot"  name="palktot"  unit="umolC"  > palktot * 1e6  </field>
+        <field field_ref="pfertot"  name="pfertot"  unit="nmolFe" > pfertot * 1e9  </field>
+                                                                                                                             </file>
+      </file_group>
+
+      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->    
+
+      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
+
+	<file id="file5" name_suffix="_grid_T" description="ocean T grid variables" >
+	  <field field_ref="toce"         name="thetao" />
+	  <field field_ref="soce"         name="so"     />
+	  <field field_ref="sst"          name="tos"    />
+	  <field field_ref="sst2"         name="tossq"  />
+	  <field field_ref="sss"          name="sos"    />
+	  <field field_ref="ssh"          name="zos"    />
+	  <field field_ref="ssh2"         name="zossq"  />
+	  <field field_ref="empmr"        name="wfo"    />
+	  <field field_ref="qsr"          name="rsntds" />
+	  <field field_ref="qt"           name="tohfls" />
+	  <field field_ref="taum"     />
+	  <field field_ref="mldkz5"   />
+	  <field field_ref="mldr10_1" />
+	</file>
+	
+	<file id="file6" name_suffix="_grid_U" description="ocean U grid variables" >
+	  <field field_ref="uoce"         name="uo"     />
+	  <field field_ref="ssu"          name="uos"    />
+	  <field field_ref="utau"         name="tauuo"  />
+	</file>
+	
+	<file id="file7" name_suffix="_grid_V" description="ocean V grid variables" >
+	  <field field_ref="voce"         name="vo"     />
+	  <field field_ref="ssv"          name="vos"    />
+	  <field field_ref="vtau"         name="tauvo"  />
+	</file>
+	
+	<file id="file8" name_suffix="_grid_W" description="ocean W grid variables" >
+	  <field field_ref="woce"         name="wo"     />
+	  <field field_ref="avt"          name="difvho" />
+	</file>
+	
+	<file id="file9" name_suffix="_icemod" description="ice variables" >
+	  <field field_ref="ice_pres"   />
+	  <field field_ref="snowthic_cea" name="snd"    />
+	  <field field_ref="icethic_cea"  name="sit"    />
+	  <field field_ref="iceprod_cea"  name="sip"    />
+	  <field field_ref="ist_ipa"    />
+	  <field field_ref="uice_ipa"   />
+	  <field field_ref="vice_ipa"   />
+	  <field field_ref="utau_ice"   />
+	  <field field_ref="vtau_ice"   />
+	  <field field_ref="qsr_io_cea" />
+	  <field field_ref="qns_io_cea" />
+	  <field field_ref="snowpre"    />
+	</file>
+	
+      </file_group>
+
+      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files -->
+
+	<file id="file10" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="PO4"      />
+          <field field_ref="Si"       />
+          <field field_ref="Fer"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+	</file>
+	
+	<file id="file11" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="Cflx"     />
+          <field field_ref="Dpco2"    />
+	</file>
+
+      </file_group>
+
+      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
+      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
+      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
+      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
+
+      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files -->
+
+	<file id="file12" name_suffix="_ptrc_T" description="pisces sms variables" >
+          <field field_ref="DIC"      />
+          <field field_ref="Alkalini" />
+          <field field_ref="O2"       />
+          <field field_ref="CaCO3"    />
+          <field field_ref="PO4"      />
+          <field field_ref="POC"      />
+          <field field_ref="Si"       />
+          <field field_ref="PHY"      />
+          <field field_ref="ZOO"      />
+          <field field_ref="DOC"      />
+          <field field_ref="PHY2"     />
+          <field field_ref="ZOO2"     />
+          <field field_ref="DSi"      />
+          <field field_ref="Fer"      />
+          <field field_ref="BFe"      />
+          <field field_ref="GOC"      />
+          <field field_ref="SFe"      />
+          <field field_ref="DFe"      />
+          <field field_ref="GSi"      />
+          <field field_ref="NFe"      />
+          <field field_ref="NCHL"     />
+          <field field_ref="DCHL"     />
+          <field field_ref="NO3"      />
+          <field field_ref="NH4"      />
+	</file>
+
+	<file id="file13" name_suffix="_diad_T" description="additional pisces diagnostics" >
+          <field field_ref="PH"       />
+          <field field_ref="CO3"      />
+          <field field_ref="CO3sat"   />
+          <field field_ref="PAR"      />
+          <field field_ref="PPPHY"    />
+          <field field_ref="PPPHY2"   />
+          <field field_ref="PPNEWN"   />
+          <field field_ref="PPNEWD"   />
+          <field field_ref="PBSi"     />
+          <field field_ref="PFeN"     />
+          <field field_ref="PFeD"     />
+          <field field_ref="xfracal"  />
+          <field field_ref="PCAL"     />
+          <field field_ref="DCAL"     />
+          <field field_ref="GRAZ1"    />
+          <field field_ref="GRAZ2"    />
+          <field field_ref="EPC100"   />
+          <field field_ref="EPFE100"  />
+          <field field_ref="EPSI100"  />
+          <field field_ref="EPCAL100" />
+          <field field_ref="Cflx"     />
+          <field field_ref="Oflx"     />
+          <field field_ref="Kg"       />
+          <field field_ref="Dpco2"    />
+          <field field_ref="Dpo2"     />
+          <field field_ref="Heup"     />
+          <field field_ref="Irondep"  />
+          <field field_ref="Ironsed"  />
+          <field field_ref="Ironice"  />
+          <field field_ref="Nfix"     />
+          <field field_ref="MuN"      />
+          <field field_ref="MuD"      />
+          <field field_ref="LNnut"    />
+          <field field_ref="LDnut"    />
+          <field field_ref="LNFe"     />
+          <field field_ref="LDFe"     />
+          <field field_ref="LNlight"  />
+          <field field_ref="LDlight"  />
+          <field field_ref="pdust"    />
+          <field field_ref="Fe2"      />
+          <field field_ref="Fe3"      />
+          <field field_ref="FeL1"     />
+          <field field_ref="FeL2"     />
+          <field field_ref="FeP"      />
+          <field field_ref="TL1"      />
+          <field field_ref="TL2"      />
+          <field field_ref="Sdenit"   />
+          <field field_ref="Totlig"   />
+	</file>
+
+      </file_group>
+
+      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
+      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
+      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
+
+   </file_definition>
+
+    <!-- 
+============================================================================================================
+= grid definition = = DO NOT CHANGE =
+============================================================================================================
+    -->
+    
+   <axis_definition>  
+      <axis id="deptht"  long_name="Vertical T levels"  unit="m" positive="down" />
+      <axis id="depthu"  long_name="Vertical U levels"  unit="m" positive="down" />
+      <axis id="depthv"  long_name="Vertical V levels"  unit="m" positive="down" />
+      <axis id="depthw"  long_name="Vertical W levels"  unit="m" positive="down" />
+      <axis id="nfloat"  long_name="Float number"       unit="1"                 />
+      <axis id="icbcla"  long_name="Iceberg class"      unit="1"                 />
+      <axis id="ncatice" long_name="Ice category"       unit="1"                 />
+      <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"              />
+      <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"              />
+   </axis_definition> 
+    
+   <domain_definition src="./domain_def.xml"/>
+   
+   <grid_definition>    
+     <grid id="grid_T_2D" domain_ref="grid_T"/>
+     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/>
+     <grid id="grid_U_2D" domain_ref="grid_U"/>
+     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/>
+     <grid id="grid_V_2D" domain_ref="grid_V"/>
+     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/>
+     <grid id="grid_W_2D" domain_ref="grid_W"/>
+     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/>
+    </grid_definition>  
+  
+  </context>
+  
+
+  <context id="xios">
+
+      <variable_definition>
+	
+     <!-- 
+        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
+-->
+	  <variable id="buffer_size"               type="integer">50000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">0</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >oceanx</variable>
+	
+      </variable_definition>
+               
+  </context>
+  
+</simulation>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_cfg	(revision 8732)
@@ -0,0 +1,205 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   cn_exp      =  "O2LP_trust"         !  experience name
+   nn_itend    =     150               !  last  time step (std 5475)
+   nn_euler    =       0               !  = 0 : start with forward time step if ln_rstart=T
+   nn_stock    =      75               !  frequency of creation of a restart file (modulo referenced to 1)
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_msh      =       0               !  create (=1) a mesh file or not (=0)
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+!-----------------------------------------------------------------------
+&namsplit      !   time splitting parameters                            ("key_dynspg_ts")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcrs        !   Grid coarsening for dynamics output and/or
+               !   passive tracer coarsened online simulations
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtsd    !   data : Temperature  & Salinity
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fwb      =       0               !  FreshWater Budget: =0 unchecked
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namberg       !   iceberg parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param)
+!-----------------------------------------------------------------------
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface
+!-----------------------------------------------------------------------
+   nn_solv     =       2               !  elliptic solver: =2 successive-over-relaxation (sor)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namsto       ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends
+!              !       and/or mixed-layer trends and/or barotropic vorticity
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_pisces_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_pisces_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_pisces_cfg	(revision 8732)
@@ -0,0 +1,72 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  :   Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_pis_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisext     !   air-sea exchange
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisatm     !  Atmospheric prrssure 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_presatm  = .false.   ! constant atmopsheric pressure (F) or from a file (T)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisopt     !   parameters for optics
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_varpar   =  .false.  ! boolean for PAR variable
+/ 
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisfer     !   parameters for iron chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/  
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissbc     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_dust     =  .false.  ! boolean for dust input from the atmosphere
+   ln_solub    =  .false.  ! boolean for variable solubility of atm. Iron
+   ln_river    =  .false.  ! boolean for river input of nutrients
+   ln_ndepo    =  .false.  ! boolean for atmospheric deposition of N
+   ln_ironsed  =  .false.  ! boolean for Fe input from sediments
+   ln_hydrofe  =  .false.  ! boolean for from hydrothermal vents
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdmp     !  Damping 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_pisdmp   =  .false.  !  Relaxation fo some tracers to a mean value
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismass     !  Mass conservation
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_top_cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_top_cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/inputs/ORCA2_LIM_PISCES/namelist_top_cfg	(revision 8732)
@@ -0,0 +1,97 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_top_ref
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namtrc_run     !   run information
+!-----------------------------------------------------------------------
+!   ln_top_euler  = .true.    !  use Euler time-stepping for TOP
+/
+!-----------------------------------------------------------------------
+&namtrc     !   tracers definition
+!-----------------------------------------------------------------------
+   ln_trcdta     =  .false.  !  Initialisation from data input file (T) or not (F)
+!                !    name   !           title of the field              ! initial data ! initial data ! save   !
+!                !           !                                           !  units       ! from file    ! or not ! 
+!                !           !                                           !              ! or not       !        !
+   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true.
+   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(13)  = 'DSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(19)  = 'GSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file
+!-----------------------------------------------------------------------
+!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask !
+!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      !
+   sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , ''   , ''
+   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , ''   , ''
+   rn_trfac(1)   =   1.0e-06  !  multiplicative factor
+   rn_trfac(2)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(3)   =  44.6e-06  !  -      -      -     -
+   rn_trfac(5)   = 122.0e-06  !  -      -      -     -
+   rn_trfac(7)   =   1.0e-06  !  -      -      -     -
+   rn_trfac(10)  =   1.0      !  -      -      -     -
+   rn_trfac(14)  =   1.0      !  -      -      -     -
+   rn_trfac(23)  =   7.6e-06  !  -      -      -     -
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_tvd     =  .false.  !  TVD scheme
+   ln_trcadv_muscl   =  .true.   !  MUSCL scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .false.   !  save additional diag. (T) or not (F)
+/
+!----------------------------------------------------------------------
+&namtrc_bc        !   data for boundary conditions
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namtrc_ice       !    Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+/
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/install_new_branch.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/install_new_branch.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/install_new_branch.sh	(revision 8732)
@@ -0,0 +1,99 @@
+#!/bin/bash
+
+
+cd $( dirname $0 )
+
+## Set defaults
+##---------------------------------------------------
+TRUS_DBUG=0; TRUS_PROD=0; TRUS_HELP=0
+
+
+## Get options (for replacing initials settings)
+##---------------------------------------------------
+while [ $# -ne 0 ]; do
+    case $1 in
+	'-d'|'--debug'  ) TRUS_DBUG=1 ; shift  ;; '-j'|'--job' 	  ) TRUS_NPRO=$2; shift 2;;
+	'-m'|'--machine') TRUS_HPCC=$2; shift 2;; '-h'|'--help'	  ) TRUS_HELP=1 ; shift  ;;
+	'-u'|'--user'   ) TRUS_USER=$2; shift 2;; "*"             ) TRUS_HELP=1 ; shift  ;;
+    esac
+done
+
+
+## Initialization (HPC & user environment)
+##---------------------------------------------------
+if [[ ! -e config/${TRUS_USER}.cfg || ! -e config/${TRUS_HPCC}.cfg || ${TRUS_HELP} -eq 1 ]]; then
+    cat ./inc/trusting_help.txt
+
+    if [ ${TRUS_HELP} -eq 0 ]; then
+	printf "\n\n\033[0;33m"
+	printf "At least one configuration (arch or user) file is missing or misspelled:"
+	printf "\t'%s'.cfg\t'%s'.cfg" ${TRUS_USER} ${TRUS_HPCC}
+	printf "\033[0m"
+    fi
+
+    printf "\n\nContent of 'config' folder:\n"
+    find config -name *.cfg | cut -d/ -f2 \
+	| xargs -n 4 printf "\t- %-25s\t- %-25s\t- %-25s\t- %-25s\n"
+    exit 1
+else
+    . ./inc/trusting.env
+    [ ${TRUS_DBUG} -eq 1 ] && set -vx
+fi
+
+
+## List last branches from NEMO Forge
+##---------------------------------------------------
+printf "\nWhat branch do you want to install in "${TRUS_WORK}" for trusting test ? "
+echo 'Enter 0 to abort'
+select branch in 'trunk' $( svn ls ${TRUS_SVNH}/branches/2015 | tr -d / | sort -r ); do
+
+    if [ $REPLY -eq 0 ]; then exit 1; else export TRUS_BRAN=$branch; fi
+
+    printf "\nInstallation of a working copy of '%s' branch in '%s'? " ${TRUS_BRAN} ${TRUS_WORK}
+    printf "\nType [Y|y|yes] to confirm, if not back to branches list number\n"
+    read answer
+    [[ $answer == 'Y' || $answer == 'y' || $answer == 'yes' ]] && break
+
+done
+
+echo
+
+
+## First checkout of selected branch
+##---------------------------------------------------
+echo 'Initial checkout of '${TRUS_BRAN}' branch'
+mkdir -p ${TRUS_WORK}/${TRUS_BRAN}/NEMOGCM
+cd       ${TRUS_WORK}/${TRUS_BRAN}/NEMOGCM
+
+svn_bran=branches/2015/${TRUS_BRAN}
+[ ${TRUS_BRAN} == 'trunk' ] && svn_bran=${TRUS_BRAN}
+
+for elmt in ${TRUS_CKOT}; do
+    [ $elmt == '\' ] && continue
+    printf "%s " $elmt
+
+    if [ $elmt == 'TOOLS/maketools' ]; then
+	svn co -q ${TRUS_SVNH}/${svn_bran}/NEMOGCM/TOOLS --depth empty
+	svn up -q $elmt
+    else
+	svn co -q ${TRUS_SVNH}/${svn_bran}/NEMOGCM/$elmt $elmt
+    fi
+
+done
+
+printf "\n\n"
+
+
+## Compile rebuild_nemo.exe in anticipation
+##---------------------------------------------------
+if [ $( find ARCH -name arch-${TRUS_HPCC}.fcm ) ]; then
+    echo 'Compile NEMO rebuild tool'
+    cd TOOLS && ./maketools -n REBUILD_NEMO -m ${TRUS_HPCC} -j ${TRUS_NPRO} >& /dev/null
+    [ -e REBUILD_NEMO/rebuild_nemo.exe ] && printf "\033[0;32mOK\033[0m" || printf "\033[0;31mKO\033[0m"
+    printf "\n\n"
+else
+    printf "\033[0;31mNo arch file found to compile NEMO rebuild tool\033[0m\n\n"
+fi
+
+exit 0
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/trusting.sh
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/trusting.sh	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/trusting.sh	(revision 8732)
@@ -0,0 +1,181 @@
+#!/bin/bash
+
+
+cd $( dirname $0 )
+
+## Set defaults
+##---------------------------------------------------
+TRUS_DIRE=$PWD
+TRUS_DBUG=0; TRUS_PROD=0; TRUS_HELP=0
+## No update on SVN directories & 'FAILED' result for 'Unknown error' )
+TRUS_SVNA='svn status'; TRUS_RSLT='FAILED'; TRUS_RORR=0
+xios_mode='--full'; stdout_redir='>&'
+rev=$( svn info | awk '(NR == 9) {print $NF}' )
+
+
+## Get options (replacing initials settings)
+##---------------------------------------------------
+while [ $# -ne 0 ]; do
+    case $1 in
+	'-a'|'--archive') TRUS_TARF=$2; shift 2;; '-b'|'--branch' ) TRUS_BRAN=$2; shift 2;;
+	'-d'|'--debug'  ) TRUS_DBUG=1 ; shift  ;; '-e'|'--email'  ) TRUS_MAIL=$2; shift 2;;
+	'-f'|'--forcdir') TRUS_FORC=$2; shift 2;; '-j'|'--job'    ) TRUS_NPRO=$2; shift 2;;
+	'-h'|'--help'   ) TRUS_HELP=1 ; shift  ;; '-m'|'--machine') TRUS_HPCC=$2; shift 2;;
+	'-n'|'--newconf') TRUS_CONF=$2; shift 2;; '-r'|'--refconf') TRUS_REFE=$2; shift 2;;
+	'-t'|'--time'   ) TRUS_TOUT=$2; shift 2;; '-p'|'--prod'   ) TRUS_PROD=1 ; shift  ;;
+	'-u'|'--user'   ) TRUS_USER=$2; shift 2;; '-v'|'--version') TRUS_SVNV=$2; shift 2;;
+	'-w'|'--workdir') TRUS_WORK=$2; shift 2;; "*"             ) TRUS_HELP=1 ; shift  ;;
+    esac
+done
+
+
+## Initialization (HPC & user environment)
+##---------------------------------------------------
+if [[ ! -e config/${TRUS_USER}.cfg || ! -e config/${TRUS_HPCC}.cfg || ${TRUS_HELP} -eq 1 ]]; then
+    cat ./inc/trusting_help.txt
+
+    if [ ${TRUS_HELP} -eq 0 ]; then
+	printf "\n\n\033[0;33m"
+	printf "At least one configuration (arch or user) file is missing or misspelled:"
+	printf "\t'%s'.cfg\t'%s'.cfg" ${TRUS_USER} ${TRUS_HPCC}
+	printf "\033[0m"
+    fi
+
+    printf "\n\nContent of 'config' folder:"
+    find config -name *.cfg | cut -d/ -f2 \
+	| xargs -n 4 printf "%-25s\t%-25s\t%-25s\n"
+    exit 1
+else
+    . ./inc/trusting.env && . ./inc/trusting_func.sh
+
+    ## DEBUG option to speed up & expand verbosity of compilation
+    [ ${TRUS_DBUG} -eq 1 ] && { set -vx; xios_mode=''; stdout_redir='>'; }
+
+    ## If -v|--version option has been set, modify default SVN action on directories
+    if   [ $( echo ${TRUS_SVNV} | grep  "HEAD\|up\|update"                     ) ]; then
+	TRUS_SVNA='svn update -r HEAD'
+    elif [ $( echo ${TRUS_SVNV} | grep -o '{[0-9]\{4\}-[0-9]\{2\}-[0-9]\{2\}}' ) ]; then
+	TRUS_SVNA='svn update -r     '$( echo ${TRUS_SVNV} | grep -o '{[0-9]\{4\}-[0-9]\{2\}-[0-9]\{2\}}' )
+    elif [ $( echo ${TRUS_SVNV} | grep -o '[0-9]*'                             ) ]; then
+	TRUS_SVNA='svn update -r     '$( echo ${TRUS_SVNV} | grep -o '[0-9]*' )
+    fi
+
+fi
+
+
+## Display contextual summary of trusting test
+##---------------------------------------------------
+echo
+if [ -t 0 ]; then cat ./inc/banner.txt; else cat ./inc/banner.html; fi
+echo
+echo '****************************************************************************************************'
+echo '*                                                                                                  *'
+echo '*                           NEMO Trusting (Continuous Integration Tool)                            *'
+echo "*                                             ver.$rev                                             *"
+echo '*                                                                                                  *'
+echo '****************************************************************************************************'
+echo
+printf "\t§ Testing configuration\t\t%s based on %s\n" ${TRUS_CONF} ${TRUS_REFE}
+printf "\t§ SVN working copy\t\t%s/%s\n"               ${TRUS_WORK} ${TRUS_BRAN}
+printf "\t§ Benchmark folder\t\t%s\n"       	       ${TRUS_STOR}
+printf "\t§ (Super)Computer\t\t%s\n" 		       ${TRUS_HPCC}
+printf "\t§ User installation\t\t%s\n\n" 	       ${TRUS_USER}
+
+
+## Make timestamped directory with messenger files
+##---------------------------------------------------
+print_step 'Timestamped testing directory'
+mkdir -p ${TRUS_SCRA} ${TRUS_STOR}
+cd       ${TRUS_SCRA}
+echo     ${TRUS_SCRA}
+init_files
+get_date
+
+
+## Get SVN revision on XIOS & NEMO essentials directories
+##---------------------------------------------------
+print_step "SVN action on NEMO directories: ${TRUS_SVNA}"
+get_nemo_rev
+
+
+## Check softwares versions (after sourced arch environment)
+##---------------------------------------------------
+print_step 'Get testing environement'
+get_soft_rel
+cat model.log | awk '{printf "%-20s %s %s\n", $1, $2, $3}'
+env | sort > env.log
+
+
+## XIOS compilation from scratch
+##---------------------------------------------------
+print_step 'Compile XIOS'
+cd ${TRUS_XIOS}
+eval ./make_xios ${xios_mode} --arch ${TRUS_HPCC} --job ${TRUS_NPRO} \
+    ${stdout_redir} /dev/null
+[ ! -e lib/libxios.a ] && get_out 1 || echo 'Success'
+
+
+## NEMO compilation from scratch
+##---------------------------------------------------
+print_step "Compile ${TRUS_REFE} configuration"
+cd ${TRUS_NGCM}/CONFIG
+[[ -d ${TRUS_CONF} && ${TRUS_DBUG} -eq 0 ]] && ./makenemo -n ${TRUS_CONF} clean_config \
+    > /dev/null <<EOF
+y
+EOF
+
+eval ./makenemo -n ${TRUS_CONF} -r ${TRUS_REFE} -m ${TRUS_HPCC} -j ${TRUS_NPRO} \
+                ${TRUS_KEYA} ${TRUS_KEYD}                                       \
+    ${stdout_redir} /dev/null
+[ ! -e ${TRUS_CONF}/BLD/bin/nemo.exe ] && get_out 2 || echo 'Success'
+
+
+## Get all inputs for running
+##---------------------------------------------------
+print_step 'Set job (copying or extracting inputs)'
+cd ${TRUS_SCRA}
+get_inputs
+cp   ${TRUS_NGCM}/CONFIG/${TRUS_CONF}/cpp_* .
+find ${TRUS_NGCM}/CONFIG/${TRUS_CONF}/EXP00 -regex '.*\(_cfg\|.in\|opa\|_ref\|.xml\)' \
+                                            -exec  cp {} . \;
+
+
+## Check inputs
+##---------------------------------------------------
+print_step 'Compare inputs'
+diff_inputs
+
+
+## Job submission & computation
+##---------------------------------------------------
+print_step 'Submit job'
+cp ${TRUS_DIRE}/batch/${TRUS_JSPT} ${TRUS_SCRA} ## Copy the submitting script to testing folder
+TRUS_JIDN=$( eval ${TRUS_JSUB} )
+[ $? -ne 0 ] && get_out 4 || printf "Success (job ID %s)\n" ${TRUS_JIDN}
+print_step 'Pending job'
+job_pending
+print_step 'Job finished'
+
+
+## Check job state & get computation performances if succeeded
+##---------------------------------------------------
+print_step 'Test job state'
+[[ ! -e time.step || $( grep 'E R R O R' ocean.output ) ]] && get_out 5 || echo 'Success' ## Must be reviewed
+print_step 'Get job performances'
+get_time
+get_memy
+
+
+## Check outputs
+##---------------------------------------------------
+TRUS_RSLT='OK' ## 'OK' by default
+print_step 'Compare outputs'
+diff_results
+print_step 'Compare restarts'
+diff_restart
+[ $TRUS_RSLT == 'FAILED' ] && get_out 8
+
+
+## End, at least nothing has changed ;-)
+##---------------------------------------------------
+get_out 0
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/sortabletable.css
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/sortabletable.css	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/sortabletable.css	(revision 8732)
@@ -0,0 +1,50 @@
+.sort-table {
+	font:		Icon;
+	border:		1px Solid ThreeDShadow;
+	background:	Window;
+	color:		WindowText;
+}
+
+.sort-table thead {
+	background:	ButtonFace;
+}
+
+.sort-table td {
+	padding:	2px 5px;
+}
+
+.sort-table thead td {
+	border:			1px solid;
+	border-color:	ButtonHighlight ButtonShadow
+					ButtonShadow ButtonHighlight;
+	cursor:			default;
+}
+
+.sort-table thead td:active {
+	border-color:	ButtonShadow ButtonHighlight
+					ButtonHighlight ButtonShadow;
+	padding:		3px 4px 1px 6px;
+}
+
+.sort-table thead td[_sortType=None]:active {
+	border-color:	ButtonHighlight ButtonShadow
+					ButtonShadow ButtonHighlight;
+	padding:		2px 5px;
+}
+
+.sort-arrow {
+	width:					11px;
+	height:					11px;
+	background-position:	center center;
+	background-repeat:		no-repeat;
+	margin:					0 2px;
+}
+
+.sort-arrow.descending {
+	background-image:		url("images/downsimple.png");
+
+}
+
+.sort-arrow.ascending {
+	background-image:		url("images/upsimple.png");
+}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/sortabletable.js
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/sortabletable.js	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/sortabletable.js	(revision 8732)
@@ -0,0 +1,438 @@
+/*----------------------------------------------------------------------------\
+|                            Sortable Table 1.12                              |
+|-----------------------------------------------------------------------------|
+|                         Created by Erik Arvidsson                           |
+|                  (http://webfx.eae.net/contact.html#erik)                   |
+|                      For WebFX (http://webfx.eae.net/)                      |
+|-----------------------------------------------------------------------------|
+| A DOM 1 based script that allows an ordinary HTML table to be sortable.     |
+|-----------------------------------------------------------------------------|
+|                  Copyright (c) 1998 - 2006 Erik Arvidsson                   |
+|-----------------------------------------------------------------------------|
+| Licensed under the Apache License, Version 2.0 (the "License"); you may not |
+| use this file except in compliance with the License.  You may obtain a copy |
+| of the License at http://www.apache.org/licenses/LICENSE-2.0                |
+| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
+| Unless  required  by  applicable law or  agreed  to  in  writing,  software |
+| distributed under the License is distributed on an  "AS IS" BASIS,  WITHOUT |
+| WARRANTIES OR  CONDITIONS OF ANY KIND,  either express or implied.  See the |
+| License  for the  specific language  governing permissions  and limitations |
+| under the License.                                                          |
+|-----------------------------------------------------------------------------|
+| 2003-01-10 | First version                                                  |
+| 2003-01-19 | Minor changes to the date parsing                              |
+| 2003-01-28 | JScript 5.0 fixes (no support for 'in' operator)               |
+| 2003-02-01 | Sloppy typo like error fixed in getInnerText                   |
+| 2003-07-04 | Added workaround for IE cellIndex bug.                         |
+| 2003-11-09 | The bDescending argument to sort was not correctly working     |
+|            | Using onclick DOM0 event if no support for addEventListener    |
+|            | or attachEvent                                                 |
+| 2004-01-13 | Adding addSortType and removeSortType which makes it a lot     |
+|            | easier to add new, custom sort types.                          |
+| 2004-01-27 | Switch to use descending = false as the default sort order.    |
+|            | Change defaultDescending to suit your needs.                   |
+| 2004-03-14 | Improved sort type None look and feel a bit                    |
+| 2004-08-26 | Made the handling of tBody and tHead more flexible. Now you    |
+|            | can use another tHead or no tHead, and you can chose some      |
+|            | other tBody.                                                   |
+| 2006-04-25 | Changed license to Apache Software License 2.0                 |  
+|-----------------------------------------------------------------------------|
+| Created 2003-01-10 | All changes are in the log above. | Updated 2006-04-25 |
+\----------------------------------------------------------------------------*/
+
+
+function SortableTable(oTable, oSortTypes) {
+
+	this.sortTypes = oSortTypes || [];
+
+	this.sortColumn = null;
+	this.descending = null;
+
+	var oThis = this;
+	this._headerOnclick = function (e) {
+		oThis.headerOnclick(e);
+	};
+
+	if (oTable) {
+		this.setTable( oTable );
+		this.document = oTable.ownerDocument || oTable.document;
+	}
+	else {
+		this.document = document;
+	}
+
+
+	// only IE needs this
+	var win = this.document.defaultView || this.document.parentWindow;
+	this._onunload = function () {
+		oThis.destroy();
+	};
+	if (win && typeof win.attachEvent != "undefined") {
+		win.attachEvent("onunload", this._onunload);
+	}
+}
+
+SortableTable.gecko = navigator.product == "Gecko";
+SortableTable.msie = /msie/i.test(navigator.userAgent);
+// Mozilla is faster when doing the DOM manipulations on
+// an orphaned element. MSIE is not
+SortableTable.removeBeforeSort = SortableTable.gecko;
+
+SortableTable.prototype.onsort = function () {};
+
+// default sort order. true -> descending, false -> ascending
+SortableTable.prototype.defaultDescending = false;
+
+// shared between all instances. This is intentional to allow external files
+// to modify the prototype
+SortableTable.prototype._sortTypeInfo = {};
+
+SortableTable.prototype.setTable = function (oTable) {
+	if ( this.tHead )
+		this.uninitHeader();
+	this.element = oTable;
+	this.setTHead( oTable.tHead );
+	this.setTBody( oTable.tBodies[0] );
+};
+
+SortableTable.prototype.setTHead = function (oTHead) {
+	if (this.tHead && this.tHead != oTHead )
+		this.uninitHeader();
+	this.tHead = oTHead;
+	this.initHeader( this.sortTypes );
+};
+
+SortableTable.prototype.setTBody = function (oTBody) {
+	this.tBody = oTBody;
+};
+
+SortableTable.prototype.setSortTypes = function ( oSortTypes ) {
+	if ( this.tHead )
+		this.uninitHeader();
+	this.sortTypes = oSortTypes || [];
+	if ( this.tHead )
+		this.initHeader( this.sortTypes );
+};
+
+// adds arrow containers and events
+// also binds sort type to the header cells so that reordering columns does
+// not break the sort types
+SortableTable.prototype.initHeader = function (oSortTypes) {
+	if (!this.tHead) return;
+	var cells = this.tHead.rows[0].cells;
+	var doc = this.tHead.ownerDocument || this.tHead.document;
+	this.sortTypes = oSortTypes || [];
+	var l = cells.length;
+	var img, c;
+	for (var i = 0; i < l; i++) {
+		c = cells[i];
+		if (this.sortTypes[i] != null && this.sortTypes[i] != "None") {
+			img = doc.createElement("IMG");
+			img.src = "html/images/blank.png";
+			c.appendChild(img);
+			if (this.sortTypes[i] != null)
+				c._sortType = this.sortTypes[i];
+			if (typeof c.addEventListener != "undefined")
+				c.addEventListener("click", this._headerOnclick, false);
+			else if (typeof c.attachEvent != "undefined")
+				c.attachEvent("onclick", this._headerOnclick);
+			else
+				c.onclick = this._headerOnclick;
+		}
+		else
+		{
+			c.setAttribute( "_sortType", oSortTypes[i] );
+			c._sortType = "None";
+		}
+	}
+	this.updateHeaderArrows();
+};
+
+// remove arrows and events
+SortableTable.prototype.uninitHeader = function () {
+	if (!this.tHead) return;
+	var cells = this.tHead.rows[0].cells;
+	var l = cells.length;
+	var c;
+	for (var i = 0; i < l; i++) {
+		c = cells[i];
+		if (c._sortType != null && c._sortType != "None") {
+			c.removeChild(c.lastChild);
+			if (typeof c.removeEventListener != "undefined")
+				c.removeEventListener("click", this._headerOnclick, false);
+			else if (typeof c.detachEvent != "undefined")
+				c.detachEvent("onclick", this._headerOnclick);
+			c._sortType = null;
+			c.removeAttribute( "_sortType" );
+		}
+	}
+};
+
+SortableTable.prototype.updateHeaderArrows = function () {
+	if (!this.tHead) return;
+	var cells = this.tHead.rows[0].cells;
+	var l = cells.length;
+	var img;
+	for (var i = 0; i < l; i++) {
+		if (cells[i]._sortType != null && cells[i]._sortType != "None") {
+			img = cells[i].lastChild;
+			if (i == this.sortColumn)
+				img.className = "sort-arrow " + (this.descending ? "descending" : "ascending");
+			else
+				img.className = "sort-arrow";
+		}
+	}
+};
+
+SortableTable.prototype.headerOnclick = function (e) {
+	// find TD element
+	var el = e.target || e.srcElement;
+	while (el.tagName != "TD")
+		el = el.parentNode;
+
+	this.sort(SortableTable.msie ? SortableTable.getCellIndex(el) : el.cellIndex);
+};
+
+// IE returns wrong cellIndex when columns are hidden
+SortableTable.getCellIndex = function (oTd) {
+	var cells = oTd.parentNode.childNodes
+	var l = cells.length;
+	var i;
+	for (i = 0; cells[i] != oTd && i < l; i++)
+		;
+	return i;
+};
+
+SortableTable.prototype.getSortType = function (nColumn) {
+	return this.sortTypes[nColumn] || "String";
+};
+
+// only nColumn is required
+// if bDescending is left out the old value is taken into account
+// if sSortType is left out the sort type is found from the sortTypes array
+
+SortableTable.prototype.sort = function (nColumn, bDescending, sSortType) {
+	if (!this.tBody) return;
+	if (sSortType == null)
+		sSortType = this.getSortType(nColumn);
+
+	// exit if None
+	if (sSortType == "None")
+		return;
+
+	if (bDescending == null) {
+		if (this.sortColumn != nColumn)
+			this.descending = this.defaultDescending;
+		else
+			this.descending = !this.descending;
+	}
+	else
+		this.descending = bDescending;
+
+	this.sortColumn = nColumn;
+
+	if (typeof this.onbeforesort == "function")
+		this.onbeforesort();
+
+	var f = this.getSortFunction(sSortType, nColumn);
+	var a = this.getCache(sSortType, nColumn);
+	var tBody = this.tBody;
+
+	a.sort(f);
+
+	if (this.descending)
+		a.reverse();
+
+	if (SortableTable.removeBeforeSort) {
+		// remove from doc
+		var nextSibling = tBody.nextSibling;
+		var p = tBody.parentNode;
+		p.removeChild(tBody);
+	}
+
+	// insert in the new order
+	var l = a.length;
+	for (var i = 0; i < l; i++)
+		tBody.appendChild(a[i].element);
+
+	if (SortableTable.removeBeforeSort) {
+		// insert into doc
+		p.insertBefore(tBody, nextSibling);
+	}
+
+	this.updateHeaderArrows();
+
+	this.destroyCache(a);
+
+	if (typeof this.onsort == "function")
+		this.onsort();
+};
+
+SortableTable.prototype.asyncSort = function (nColumn, bDescending, sSortType) {
+	var oThis = this;
+	this._asyncsort = function () {
+		oThis.sort(nColumn, bDescending, sSortType);
+	};
+	window.setTimeout(this._asyncsort, 1);
+};
+
+SortableTable.prototype.getCache = function (sType, nColumn) {
+	if (!this.tBody) return [];
+	var rows = this.tBody.rows;
+	var l = rows.length;
+	var a = new Array(l);
+	var r;
+	for (var i = 0; i < l; i++) {
+		r = rows[i];
+		a[i] = {
+			value:		this.getRowValue(r, sType, nColumn),
+			element:	r
+		};
+	};
+	return a;
+};
+
+SortableTable.prototype.destroyCache = function (oArray) {
+	var l = oArray.length;
+	for (var i = 0; i < l; i++) {
+		oArray[i].value = null;
+		oArray[i].element = null;
+		oArray[i] = null;
+	}
+};
+
+SortableTable.prototype.getRowValue = function (oRow, sType, nColumn) {
+	// if we have defined a custom getRowValue use that
+	if (this._sortTypeInfo[sType] && this._sortTypeInfo[sType].getRowValue)
+		return this._sortTypeInfo[sType].getRowValue(oRow, nColumn);
+
+	var s;
+	var c = oRow.cells[nColumn];
+	if (typeof c.innerText != "undefined")
+		s = c.innerText;
+	else
+		s = SortableTable.getInnerText(c);
+	return this.getValueFromString(s, sType);
+};
+
+SortableTable.getInnerText = function (oNode) {
+	var s = "";
+	var cs = oNode.childNodes;
+	var l = cs.length;
+	for (var i = 0; i < l; i++) {
+		switch (cs[i].nodeType) {
+			case 1: //ELEMENT_NODE
+				s += SortableTable.getInnerText(cs[i]);
+				break;
+			case 3:	//TEXT_NODE
+				s += cs[i].nodeValue;
+				break;
+		}
+	}
+	return s;
+};
+
+SortableTable.prototype.getValueFromString = function (sText, sType) {
+	if (this._sortTypeInfo[sType])
+		return this._sortTypeInfo[sType].getValueFromString( sText );
+	return sText;
+	/*
+	switch (sType) {
+		case "Number":
+			return Number(sText);
+		case "CaseInsensitiveString":
+			return sText.toUpperCase();
+		case "Date":
+			var parts = sText.split("-");
+			var d = new Date(0);
+			d.setFullYear(parts[0]);
+			d.setDate(parts[2]);
+			d.setMonth(parts[1] - 1);
+			return d.valueOf();
+	}
+	return sText;
+	*/
+	};
+
+SortableTable.prototype.getSortFunction = function (sType, nColumn) {
+	if (this._sortTypeInfo[sType])
+		return this._sortTypeInfo[sType].compare;
+	return SortableTable.basicCompare;
+};
+
+SortableTable.prototype.destroy = function () {
+	this.uninitHeader();
+	var win = this.document.parentWindow;
+	if (win && typeof win.detachEvent != "undefined") {	// only IE needs this
+		win.detachEvent("onunload", this._onunload);
+	}
+	this._onunload = null;
+	this.element = null;
+	this.tHead = null;
+	this.tBody = null;
+	this.document = null;
+	this._headerOnclick = null;
+	this.sortTypes = null;
+	this._asyncsort = null;
+	this.onsort = null;
+};
+
+// Adds a sort type to all instance of SortableTable
+// sType : String - the identifier of the sort type
+// fGetValueFromString : function ( s : string ) : T - A function that takes a
+//    string and casts it to a desired format. If left out the string is just
+//    returned
+// fCompareFunction : function ( n1 : T, n2 : T ) : Number - A normal JS sort
+//    compare function. Takes two values and compares them. If left out less than,
+//    <, compare is used
+// fGetRowValue : function( oRow : HTMLTRElement, nColumn : int ) : T - A function
+//    that takes the row and the column index and returns the value used to compare.
+//    If left out then the innerText is first taken for the cell and then the
+//    fGetValueFromString is used to convert that string the desired value and type
+
+SortableTable.prototype.addSortType = function (sType, fGetValueFromString, fCompareFunction, fGetRowValue) {
+	this._sortTypeInfo[sType] = {
+		type:				sType,
+		getValueFromString:	fGetValueFromString || SortableTable.idFunction,
+		compare:			fCompareFunction || SortableTable.basicCompare,
+		getRowValue:		fGetRowValue
+	};
+};
+
+// this removes the sort type from all instances of SortableTable
+SortableTable.prototype.removeSortType = function (sType) {
+	delete this._sortTypeInfo[sType];
+};
+
+SortableTable.basicCompare = function compare(n1, n2) {
+	if (n1.value < n2.value)
+		return -1;
+	if (n2.value < n1.value)
+		return 1;
+	return 0;
+};
+
+SortableTable.idFunction = function (x) {
+	return x;
+};
+
+SortableTable.toUpperCase = function (s) {
+	return s.toUpperCase();
+};
+
+SortableTable.toDate = function (s) {
+	var parts = s.split("-");
+	var d = new Date(0);
+	d.setFullYear(parts[0]);
+	d.setDate(parts[2]);
+	d.setMonth(parts[1] - 1);
+	return d.valueOf();
+};
+
+
+// add sort types
+SortableTable.prototype.addSortType("Number", Number);
+SortableTable.prototype.addSortType("CaseInsensitiveString", SortableTable.toUpperCase);
+SortableTable.prototype.addSortType("Date", SortableTable.toDate);
+SortableTable.prototype.addSortType("String");
+// None is a special case
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/tab-view.css
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/tab-view.css	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/tab-view.css	(revision 8732)
@@ -0,0 +1,60 @@
+	.dhtmlgoodies_tabPane{
+		height:21px;	/* Height of tabs */
+		border-bottom:1px solid #919b9c;
+	}
+	.dhtmlgoodies_aTab{
+		border-left:1px solid #919b9c;
+		border-right:1px solid #919b9c;
+		border-bottom:1px solid #919b9c;
+		font-family: Trebuchet MS, Lucida Sans Unicode, Arial, sans-serif;
+		padding:5px;		
+		
+	}
+	.dhtmlgoodies_tabPane DIV{
+		float:left;
+		height:100%;	/* Height of tabs */
+		padding-left:3px;
+		vertical-align:middle;
+		background-repeat:no-repeat;
+		background-position:bottom left;
+		cursor:pointer;
+		position:relative;
+		bottom:-1px;
+		margin-left:0px;
+		margin-right:0px;
+	}
+	.dhtmlgoodies_tabPane .tabActive{
+		background-image:url('../images/tab_left_active.gif');
+		margin-left:0px;
+		margin-right:0px;	
+		z-index:10;	
+	}
+	.dhtmlgoodies_tabPane .tabInactive{
+		background-image:url('../images/tab_left_inactive.gif');
+		margin-left:0px;
+		margin-right:0px;
+		z-index:1;
+	}
+
+	.dhtmlgoodies_tabPane .inactiveTabOver{
+		background-image:url('../images/tab_left_over.gif');
+		margin-left:0px;
+		margin-right:0px;
+	}
+	.dhtmlgoodies_tabPane span{
+		font-family:arial;
+		vertical-align:top;
+		font-size:11px;
+		padding-left:3px;
+		padding-right:3px;		
+		line-height:21px;
+		float:left;
+	}
+	.dhtmlgoodies_tabPane .tabActive span{
+		padding-bottom:1px;
+		line-height:20px;
+	}
+	
+	.dhtmlgoodies_tabPane img{
+		float:left;
+	}
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/tab-view.js
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/tab-view.js	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/html/tab-view.js	(revision 8732)
@@ -0,0 +1,375 @@
+	/************************************************************************************************************
+	(C) www.dhtmlgoodies.com, October 2005
+	
+	This is a script from www.dhtmlgoodies.com. You will find this and a lot of other scripts at our website.	
+	
+	Terms of use:
+	You are free to use this script as long as the copyright message is kept intact. However, you may not
+	redistribute, sell or repost it without our permission.
+	
+	Updated:
+		
+		March, 14th, 2006 - Create new tabs dynamically
+		March, 15th, 2006 - Dynamically delete a tab
+		
+	Thank you!
+	
+	www.dhtmlgoodies.com
+	Alf Magne Kalleland
+	
+	************************************************************************************************************/		
+	var textPadding = 3; // Padding at the left of tab text - bigger value gives you wider tabs
+	var strictDocType = true; 
+	var tabView_maxNumberOfTabs = 6;	// Maximum number of tabs
+	
+	/* Don't change anything below here */
+	var dhtmlgoodies_tabObj = new Array();
+	var activeTabIndex = new Array();
+	var MSIE = navigator.userAgent.indexOf('MSIE')>=0?true:false;
+	
+	var regExp = new RegExp(".*MSIE ([0-9]\.[0-9]).*","g");
+	var navigatorVersion = navigator.userAgent.replace(regExp,'$1');
+	
+	var ajaxObjects = new Array();
+	var tabView_countTabs = new Array();
+	var tabViewHeight = new Array();
+	var tabDivCounter = 0;
+	var closeImageHeight = 8;	// Pixel height of close buttons
+	var closeImageWidth = 8;	// Pixel height of close buttons
+	
+	
+	function setPadding(obj,padding){
+		var span = obj.getElementsByTagName('SPAN')[0];
+		span.style.paddingLeft = padding + 'px';	
+		span.style.paddingRight = padding + 'px';	
+	}
+	function showTab(parentId,tabIndex)
+	{
+		var parentId_div = parentId + "_";
+		if(!document.getElementById('tabView' + parentId_div + tabIndex)){
+			return;
+		}
+		if(activeTabIndex[parentId]>=0){
+			if(activeTabIndex[parentId]==tabIndex){
+				return;
+			}
+	
+			var obj = document.getElementById('tabTab'+parentId_div + activeTabIndex[parentId]);
+			
+			obj.className='tabInactive';
+			var img = obj.getElementsByTagName('IMG')[0];
+			if(img.src.indexOf('tab_')==-1)img = obj.getElementsByTagName('IMG')[1];
+			img.src = 'images/tab_right_inactive.gif';
+			document.getElementById('tabView' + parentId_div + activeTabIndex[parentId]).style.display='none';
+		}
+		
+		var thisObj = document.getElementById('tabTab'+ parentId_div +tabIndex);	
+			
+		thisObj.className='tabActive';
+		var img = thisObj.getElementsByTagName('IMG')[0];
+		if(img.src.indexOf('tab_')==-1)img = thisObj.getElementsByTagName('IMG')[1];
+		img.src = 'images/tab_right_active.gif';
+		
+		document.getElementById('tabView' + parentId_div + tabIndex).style.display='block';
+		activeTabIndex[parentId] = tabIndex;
+		
+
+		var parentObj = thisObj.parentNode;
+		var aTab = parentObj.getElementsByTagName('DIV')[0];
+		countObjects = 0;
+		var startPos = 2;
+		var previousObjectActive = false;
+		while(aTab){
+			if(aTab.tagName=='DIV'){
+				if(previousObjectActive){
+					previousObjectActive = false;
+					startPos-=2;
+				}
+				if(aTab==thisObj){
+					startPos-=2;
+					previousObjectActive=true;
+					setPadding(aTab,textPadding+1);
+				}else{
+					setPadding(aTab,textPadding);
+				}
+				
+				aTab.style.left = startPos + 'px';
+				countObjects++;
+				startPos+=2;
+			}			
+			aTab = aTab.nextSibling;
+		}
+		
+		return;
+	}
+	
+	function tabClick()
+	{
+		var idArray = this.id.split('_');		
+		showTab(this.parentNode.parentNode.id,idArray[idArray.length-1].replace(/[^0-9]/gi,''));
+		
+	}
+	
+	function rolloverTab()
+	{
+		if(this.className.indexOf('tabInactive')>=0){
+			this.className='inactiveTabOver';
+			var img = this.getElementsByTagName('IMG')[0];
+			if(img.src.indexOf('tab_')<=0)img = this.getElementsByTagName('IMG')[1];
+			img.src = 'images/tab_right_over.gif';
+		}
+		
+	}
+	function rolloutTab()
+	{
+		if(this.className ==  'inactiveTabOver'){
+			this.className='tabInactive';
+			var img = this.getElementsByTagName('IMG')[0];
+			if(img.src.indexOf('tab_')<=0)img = this.getElementsByTagName('IMG')[1];
+			img.src = 'images/tab_right_inactive.gif';
+		}
+		
+	}
+	
+	function hoverTabViewCloseButton()
+	{
+		this.src = this.src.replace('close.gif','close_over.gif');
+	}
+	
+	function stopHoverTabViewCloseButton()
+	{
+		this.src = this.src.replace('close_over.gif','close.gif');
+	}
+	
+	function initTabs(mainContainerID,tabTitles,activeTab,width,height,closeButtonArray,additionalTab)
+	{
+		if(!closeButtonArray)closeButtonArray = new Array();
+		
+		if(!additionalTab || additionalTab=='undefined'){			
+			dhtmlgoodies_tabObj[mainContainerID] = document.getElementById(mainContainerID);
+			width = width + '';
+			if(width.indexOf('%')<0)width= width + 'px';
+			dhtmlgoodies_tabObj[mainContainerID].style.width = width;
+						
+			height = height + '';
+			if(height.length>0){
+				if(height.indexOf('%')<0)height= height + 'px';
+				dhtmlgoodies_tabObj[mainContainerID].style.height = height;
+			}
+			
+
+			tabViewHeight[mainContainerID] = height;
+			
+			var tabDiv = document.createElement('DIV');		
+			var firstDiv = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV')[0];	
+			
+			dhtmlgoodies_tabObj[mainContainerID].insertBefore(tabDiv,firstDiv);	
+			tabDiv.className = 'dhtmlgoodies_tabPane';			
+			tabView_countTabs[mainContainerID] = 0;
+
+		}else{
+			var tabDiv = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV')[0];
+			var firstDiv = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV')[1];
+			height = tabViewHeight[mainContainerID];
+			activeTab = tabView_countTabs[mainContainerID];		
+	
+			
+		}
+		
+		
+		
+		for(var no=0;no<tabTitles.length;no++){
+			var aTab = document.createElement('DIV');
+			aTab.id = 'tabTab' + mainContainerID + "_" +  (no + tabView_countTabs[mainContainerID]);
+			aTab.onmouseover = rolloverTab;
+			aTab.onmouseout = rolloutTab;
+			aTab.onclick = tabClick;
+			aTab.className='tabInactive';
+			tabDiv.appendChild(aTab);
+			var span = document.createElement('SPAN');
+			span.innerHTML = tabTitles[no];
+			span.style.position = 'relative';
+			aTab.appendChild(span);
+			
+			if(closeButtonArray[no]){
+				var closeButton = document.createElement('IMG');
+				closeButton.src = 'images/close.gif';
+				closeButton.height = closeImageHeight + 'px';
+				closeButton.width = closeImageHeight + 'px';
+				closeButton.setAttribute('height',closeImageHeight);
+				closeButton.setAttribute('width',closeImageHeight);
+				closeButton.style.position='absolute';
+				closeButton.style.top = '6px';
+				closeButton.style.right = '0px';
+				closeButton.onmouseover = hoverTabViewCloseButton;
+				closeButton.onmouseout = stopHoverTabViewCloseButton;
+				
+				span.innerHTML = span.innerHTML + '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';	
+				
+				var deleteTxt = span.innerHTML+'';
+
+				closeButton.onclick = function(){ deleteTab(this.parentNode.innerHTML) };
+				span.appendChild(closeButton);
+			}
+			
+			var img = document.createElement('IMG');
+			img.valign = 'bottom';
+			img.src = 'images/tab_right_inactive.gif';
+			// IE5.X FIX
+			if((navigatorVersion && navigatorVersion<6) || (MSIE && !strictDocType)){
+				img.style.styleFloat = 'none';
+				img.style.position = 'relative';	
+				img.style.top = '4px'
+				span.style.paddingTop = '4px';
+				aTab.style.cursor = 'hand';
+			}	// End IE5.x FIX
+			aTab.appendChild(img);
+		}
+
+		var tabs = dhtmlgoodies_tabObj[mainContainerID].getElementsByTagName('DIV');
+		var divCounter = 0;
+		for(var no=0;no<tabs.length;no++){
+			if(tabs[no].className=='dhtmlgoodies_aTab' && tabs[no].parentNode.id == mainContainerID){
+				if(height.length>0)tabs[no].style.height = height;
+				tabs[no].style.display='none';
+				tabs[no].id = 'tabView' + mainContainerID + "_" + divCounter;
+				divCounter++;
+			}			
+		}	
+		tabView_countTabs[mainContainerID] = tabView_countTabs[mainContainerID] + tabTitles.length;	
+		showTab(mainContainerID,activeTab);
+
+		return activeTab;
+	}	
+	
+	function showAjaxTabContent(ajaxIndex,parentId,tabId)
+	{
+		var obj = document.getElementById('tabView'+parentId + '_' + tabId);
+		obj.innerHTML = ajaxObjects[ajaxIndex].response;		
+	}
+	
+	function resetTabIds(parentId)
+	{
+		var tabTitleCounter = 0;
+		var tabContentCounter = 0;
+		
+		
+		var divs = dhtmlgoodies_tabObj[parentId].getElementsByTagName('DIV');
+
+		
+		for(var no=0;no<divs.length;no++){
+			if(divs[no].className=='dhtmlgoodies_aTab'){
+				divs[no].id = 'tabView' + parentId + '_' + tabTitleCounter;
+				tabTitleCounter++;
+			}
+			if(divs[no].id.indexOf('tabTab')>=0){
+				divs[no].id = 'tabTab' + parentId + '_' + tabContentCounter;	
+				tabContentCounter++;
+			}	
+			
+				
+		}
+	
+		tabView_countTabs[parentId] = tabContentCounter;
+	}
+	
+	
+	function createNewTab(parentId,tabTitle,tabContent,tabContentUrl,closeButton)
+	{
+		if(tabView_countTabs[parentId]>=tabView_maxNumberOfTabs)return;	// Maximum number of tabs reached - return
+		var div = document.createElement('DIV');
+		div.className = 'dhtmlgoodies_aTab';
+		dhtmlgoodies_tabObj[parentId].appendChild(div);		
+
+		var tabId = initTabs(parentId,Array(tabTitle),0,'','',Array(closeButton),true);
+		if(tabContent)div.innerHTML = tabContent;
+		if(tabContentUrl){		
+			var ajaxIndex = ajaxObjects.length;
+			ajaxObjects[ajaxIndex] = new sack();
+			ajaxObjects[ajaxIndex].requestFile = tabContentUrl;	// Specifying which file to get
+
+			ajaxObjects[ajaxIndex].onCompletion = function(){ showAjaxTabContent(ajaxIndex,parentId,tabId); };	// Specify function that will be executed after file has been found
+			ajaxObjects[ajaxIndex].runAJAX();		// Execute AJAX function	
+		
+		}
+				
+	}
+	
+	function getTabIndexByTitle(tabTitle)
+	{
+		var regExp = new RegExp("(.*?)&nbsp.*$","gi");
+		tabTitle = tabTitle.replace(regExp,'$1');
+		for(var prop in dhtmlgoodies_tabObj){
+			var divs = dhtmlgoodies_tabObj[prop].getElementsByTagName('DIV');
+			for(var no=0;no<divs.length;no++){
+				if(divs[no].id.indexOf('tabTab')>=0){
+					var span = divs[no].getElementsByTagName('SPAN')[0];
+					var regExp2 = new RegExp("(.*?)&nbsp.*$","gi");
+					var spanTitle = span.innerHTML.replace(regExp2,'$1');
+					
+					if(spanTitle == tabTitle){
+						
+						var tmpId = divs[no].id.split('_');						
+						return Array(prop,tmpId[tmpId.length-1].replace(/[^0-9]/g,'')/1);
+					}		
+				}
+			}
+		}
+		
+		return -1;
+		
+	}
+	
+	/* Call this function if you want to display some content from external file in one of the tabs 
+	Arguments: Title of tab and relative path to external file */
+	
+	function addAjaxContentToTab(tabTitle,tabContentUrl)
+	{
+		var index = getTabIndexByTitle(tabTitle);
+		if(index!=-1){
+			var ajaxIndex = ajaxObjects.length;
+			
+			tabId = index[1];
+			parentId = index[0];
+			
+			
+			ajaxObjects[ajaxIndex] = new sack();
+			ajaxObjects[ajaxIndex].requestFile = tabContentUrl;	// Specifying which file to get
+
+			ajaxObjects[ajaxIndex].onCompletion = function(){ showAjaxTabContent(ajaxIndex,parentId,tabId); };	// Specify function that will be executed after file has been found
+			ajaxObjects[ajaxIndex].runAJAX();		// Execute AJAX function				
+			
+		}	
+	}
+
+	
+	
+	function deleteTab(tabLabel,tabIndex,parentId)
+	{
+
+		if(tabLabel){
+			var index = getTabIndexByTitle(tabLabel);
+			if(index!=-1){
+				deleteTab(false,index[1],index[0]);
+			}
+			
+		}else if(tabIndex>=0){
+			if(document.getElementById('tabTab' + parentId + '_' + tabIndex)){
+				var obj = document.getElementById('tabTab' + parentId + '_' + tabIndex);
+				var id = obj.parentNode.parentNode.id;
+				obj.parentNode.removeChild(obj);
+				var obj2 = document.getElementById('tabView' + parentId + '_' + tabIndex);
+				obj2.parentNode.removeChild(obj2);
+				resetTabIds(parentId);
+				activeTabIndex[parentId]=-1;
+				showTab(parentId,'0');
+			}			
+		}
+		
+
+			
+		
+		
+	}
+	
+	
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/index.html
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/index.html	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/index.html	(revision 8732)
@@ -0,0 +1,354 @@
+<html>
+
+  <head>
+
+    <title>NEMO Trusting Dashboard</title>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+    <script type="text/javascript" src="html/sortabletable.js"></script>
+    <link type="text/css" rel="StyleSheet" href="html/sortabletable.css" />
+    <link rel="stylesheet" href="html/tab-view.css" type="text/css" media="screen">
+    <script type="text/javascript" src="html/tab-view.js"></script>
+    <style type="text/css">
+      body    { font-family:Helvetica, Arial, Sans-Serif;                      	    	      }
+      a1      { color:#000000; text-decoration:none;                           	    	      }
+      .title  { background:#AABBBB; font-weight:bold;                          	    	      }
+      .even   { background:#eee;                                               	    	      }
+      .odd    { background:#ddd;                                               	    	      }
+      td      { font-family:Arial    ; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .td1    { font-family:Monospace; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .table1 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .table2 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .myh3   { font-weight:bold; font-style:italic; font-family:Arial,Helvetica,sans-serif
+                background-color:#FFD700; border:2px outset #FFFFFF
+                padding: 1px 20px 1px 20px; width:120px; -moz-border-radius:6px 6px 6px 6px;  }
+    </style>
+
+  </head>
+
+  <body>
+
+    <?php
+       ini_set('display_errors', 'Off'); error_reporting(E_ALL);
+       include 'read_trusting.php';
+       $DODS_TGCC="http://dods.extra.cea.fr/store/martin/trusting"; $DODS_IDRIS="http://dodsp.idris.fr/romr005/trusting";
+       $file_headers=get_headers("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html");
+       if ($file_headers[0] == '' ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }
+    ?>
+
+       <!--$ctx=stream_context_create(array('http'=>array('timeout'=>1)));
+       $test=file_get_contents("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html", 0, $ctx);
+       if ($test == FALSE ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }-->
+
+    <!-----Begin NEMO trust----->
+    <div id="dhtmlgoodies_tabViewNEMO">
+
+      <!-----Begin v36 trust----->
+      <?php $BRANCH="nemo_v3_6_STABLE" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html"); ?>
+	    <div id="dhtmlgoodies_tabViewHPCC">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-1" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-1"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-2" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-2"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC2">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-3" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-3"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-4" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-4"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC3">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-5" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-5"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-6" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-6"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End AMM12 trust----->
+
+	</div>
+      </div>
+      <!-----End v36 trust----->
+
+
+      <!-----Begin trunk trust----->
+      <?php $BRANCH="trunk" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf2">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC4">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-7" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-7"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-8" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-8"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC5">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-9" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-9"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-10" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-10"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC6">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-11" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-11"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-12" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-12"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	</div>
+      </div>
+      <!-----End trunk trust----->
+
+    </div>
+    <!-----End NEMO trust----->
+
+    <!-------------------------------------------------------------------------------------------->
+    <script type="text/javascript">
+      initTabs('dhtmlgoodies_tabViewNEMO'        ,
+               Array('<B>&nbsp;3.6&nbsp;  </B>',
+	             '<B>&nbsp;trunk&nbsp;</B>' 
+                                                ),
+               0,1820,15100                      ,
+               Array(false)                       )
+      initTabs('dhtmlgoodies_tabViewConf'                                        ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewConf2'                                       ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewHPCC'                         ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC2'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC3'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC4'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC5'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC6'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+    </script>
+    <!-------------------------------------------------------------------------------------------->
+
+  </body>
+
+</html>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/index.php
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/index.php	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/index.php	(revision 8732)
@@ -0,0 +1,354 @@
+<html>
+
+  <head>
+
+    <title>Trusting Dashboard</title>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+    <script type="text/javascript" src="html/sortabletable.js"></script>
+    <link type="text/css" rel="StyleSheet" href="html/sortabletable.css" />
+    <link rel="stylesheet" href="html/tab-view.css" type="text/css" media="screen">
+    <script type="text/javascript" src="html/tab-view.js"></script>
+    <style type="text/css">
+      body    { font-family:Helvetica, Arial, Sans-Serif;                      	    	      }
+      a1      { color:#000000; text-decoration:none;                           	    	      }
+      .title  { background:#AABBBB; font-weight:bold;                          	    	      }
+      .even   { background:#eee;                                               	    	      }
+      .odd    { background:#ddd;                                               	    	      }
+      td      { font-family:Arial    ; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .td1    { font-family:Monospace; font-size:10pt; padding:1px 5px 1px 5px;	    	      }
+      .table1 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .table2 { background:#E6EEC9; border-collapse:collapse;                  	    	      }
+      .myh3   { font-weight:bold; font-style:italic; font-family:Arial,Helvetica,sans-serif
+                background-color:#FFD700; border:2px outset #FFFFFF
+                padding: 1px 20px 1px 20px; width:120px; -moz-border-radius:6px 6px 6px 6px;  }
+    </style>
+
+  </head>
+
+  <body>
+
+    <?php
+       ini_set('display_errors', 'Off'); error_reporting(E_ALL);
+       include 'read_trusting.php';
+       $DODS_TGCC="http://dods.extra.cea.fr/store/martin/trusting"; $DODS_IDRIS="http://dodsp.idris.fr/romr005/trusting";
+       $ctx=stream_context_create(array('http'=>array('timeout'=>1)));
+       $test=file_get_contents("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html", 0, $ctx);
+       if ($test == FALSE ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }
+    ?>
+
+    <!--$file_headers=get_headers("${DODS_TGCC}/ORCA2_LIM_PISCES/nemo_v3_6_STABLE/trusting_info.html");
+       if ($file_headers[0] == '' ) { $LOCATION="./src/martin"; } else { $LOCATION="${DODS_TGCC}"; }-->
+
+    <!-----Begin NEMO trust----->
+    <div id="dhtmlgoodies_tabViewNEMO">
+
+      <!-----Begin v36 trust----->
+      <?php $BRANCH="nemo_v3_6_STABLE" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html"); ?>
+	    <div id="dhtmlgoodies_tabViewHPCC">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-1" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-1"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-2" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-2"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC2">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-3" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-3"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-4" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-4"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC3">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-5" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-5"),
+	                   [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-6" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-6"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End AMM12 trust----->
+
+	</div>
+      </div>
+      <!-----End v36 trust----->
+
+
+      <!-----Begin trunk trust----->
+      <?php $BRANCH="trunk" ?>
+      <div class="dhtmlgoodies_aTab">
+	<div id="dhtmlgoodies_tabViewConf2">
+
+	  <!-----Begin O2LP trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA2_LIM_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC4">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-7" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-7"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-8" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-8"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O2LP trust----->
+
+	  <!-----Begin O1L3P trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="ORCA1_LIM3_PISCES"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC5">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-9" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-9"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-10" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-10"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	  <!-----Begin AMM12 trust----->
+	  <div class="dhtmlgoodies_aTab">
+	    <?php $CONF="AMM12"; echo file_get_contents("$LOCATION/$CONF/$BRANCH/trusting_info.html") ?>
+	    <div id="dhtmlgoodies_tabViewHPCC6">
+
+	      <!-----Begin Curie trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-11" cellspacing="1">
+		  <?php read_trusting("$LOCATION/$CONF/$BRANCH/trusting_martin_X64_CURIE_cron.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-11"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End   Curie trust----->
+
+	      <!-----Begin Ada trust----->
+	      <div class="dhtmlgoodies_aTab">
+		<table class="sort-table" id="table-12" cellspacing="1">
+		  <?php read_trusting("${DODS_IDRIS}/$CONF/$BRANCH/trusting_romr005_X64_ADA_at.txt") ?>
+		</table>
+		<script type="text/javascript">
+		  var st = new SortableTable( document.getElementById("table-12"),
+		           [<?php print substr(str_repeat("\"String\",", $num),0,-1); ?>]);
+		  st.sort(0, true);
+		</script>
+	      </div>
+	      <!-----End Ada trust----->
+
+	    </div>
+	  </div>
+	  <!-----End O1L3P trust----->
+
+	</div>
+      </div>
+      <!-----End trunk trust----->
+
+    </div>
+    <!-----End NEMO trust----->
+
+    <!-------------------------------------------------------------------------------------------->
+    <script type="text/javascript">
+      initTabs('dhtmlgoodies_tabViewNEMO'        ,
+               Array('<B>&nbsp;3.6&nbsp;  </B>',
+	             '<B>&nbsp;trunk&nbsp;</B>' 
+                                                ),
+               0,1820,15100                      ,
+               Array(false)                       )
+      initTabs('dhtmlgoodies_tabViewConf'                                        ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewConf2'                                       ,
+               Array('<B style="color: green">&nbsp;ORCA2_LIM_PISCES&nbsp;  </B>',
+	       	     '<B style="color: green">&nbsp;ORCA1_LIM3_PISCES&nbsp; </B>',
+	       	     '<B style="color: green">&nbsp;AMM12&nbsp;             </B>',
+	       	     '<B style="color: red  ">&nbsp;C1D_PAPA&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE&nbsp;              </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_BFM&nbsp;          </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_PISCES&nbsp;       </B>',
+	       	     '<B style="color: red  ">&nbsp;GYRE_XIOS&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM&nbsp;         </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM3&nbsp;        </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_LIM_CFC_C14b&nbsp;</B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_OFF_PISCES&nbsp;  </B>',
+	       	     '<B style="color: red  ">&nbsp;ORCA2_SAS_LIM&nbsp;     </B>' 
+	                                                                          ),
+               0,1810,15050                                                        ,
+               Array(false)                                                         )
+      initTabs('dhtmlgoodies_tabViewHPCC'                         ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC2'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC3'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC4'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC5'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+      initTabs('dhtmlgoodies_tabViewHPCC6'                        ,
+               Array('<B>&nbsp;TGCC&nbsp;/&nbsp;curie&nbsp;</B>',
+	             '<B>&nbsp;IDRIS&nbsp;/&nbsp;ada&nbsp; </B>' ),
+               0,1800,15000                                       ,
+               Array(false)                                        )
+    </script>
+    <!-------------------------------------------------------------------------------------------->
+
+  </body>
+
+</html>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/read_trusting.php
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/read_trusting.php	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TRUST/web/read_trusting.php	(revision 8732)
@@ -0,0 +1,52 @@
+
+<?php
+
+$num=1;
+
+function read_trusting ($file) { 
+
+  global $num;
+  $row = 1;
+
+  if (($handle = fopen($file, "r")) !== FALSE) {
+
+    while (($data = fgetcsv($handle, 1000, ";")) !== FALSE) {
+
+      switch ($row) {
+        case 1: 
+	  $num1 = count($data);
+	  print("<thead>\n\n"); print("<tr class=\"title\">\n");
+	  break;
+        default:	
+	  if   ( $row % 2 == 1 ) { print("<tr class=\"odd\">\n") ; }
+	  else                   { print("<tr class=\"even\">\n"); }
+      }
+
+      $num = count($data);
+      #echo "<p> $num champs ligne $row: <br /></p>\n";
+
+      for ($c=0; $c<$num1; $c++) {
+        #echo $data[$c] . "<br />\n";
+	if ($c > $num ) { $var=""; } else { $var=trim($data[$c]); }
+
+	switch ($var) { 
+	  case "FAILED"   : print("<td bgcolor=\"#FF6666\">".$var."</td>\n"); break;
+	  case "Different": print("<td bgcolor=\"#FFFF99\">".$var."</td>\n"); break;
+	  case "OK"       : print("<td bgcolor=\"#92CA89\">".$var."</td>\n"); break;
+	  default         : print("<td>".$var."</td>\n")                           ;
+	}
+
+      }
+
+      print("</tr>\n\n");
+      if ( $row == 1 ) { print("</thead>\n\n");	print("<tbody>\n\n"); }
+      $row++;
+    }
+
+    fclose($handle);
+  }
+
+  print("</tbody>\n");
+}
+
+?>
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/common.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/common.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/common.cfg	(revision 8732)
@@ -0,0 +1,63 @@
+step.class[build-tools] = build
+steps = extract preprocess build build-tools
+
+extract.ns = nemo
+extract.location[nemo]  = $HERE/../../..
+extract.path-root[nemo] = NEMOGCM
+extract.path-excl[nemo] = / \
+                        \ NEMO/OPA_SRC/TRD/trdmod_trc.F90 \
+                        \ NEMO/LIM_SRC_2/limrhg.F90 \
+                        \ TOOLS/OBSTOOLS/src/obs_prof_io.F90 \
+                        \ TOOLS/OBSTOOLS/src/ddatetoymdhms.h90 \
+                        \ TOOLS/OBSTOOLS/src/obs_fbm.F90 \
+                        \ TOOLS/OBSTOOLS/src/dom_oce.F90 \
+                        \ TOOLS/OBSTOOLS/src/obsprof_io.h90 \
+                        \ TOOLS/OBSTOOLS/src/str_c_to_for.h90 \
+                        \ TOOLS/OBSTOOLS/src/wrk_nemo.F90 \
+                        \ TOOLS/OBSTOOLS/src/obsvel_io.h90 \
+                        \ TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90 \
+                        \ TOOLS/OBSTOOLS/src/obs_sla_io.F90 \
+                        \ TOOLS/OBSTOOLS/src/lbcnfd.F90 \
+                        \ TOOLS/OBSTOOLS/src/obssla_types.h90 \
+                        \ TOOLS/OBSTOOLS/src/obs_utils.F90 \
+                        \ TOOLS/OBSTOOLS/src/lib_mpp.F90 \
+                        \ TOOLS/OBSTOOLS/src/obs_vel_io.F90 \
+                        \ TOOLS/OBSTOOLS/src/grt_cir_dis.h90 \
+                        \ TOOLS/OBSTOOLS/src/obs_conv_functions.h90 \
+                        \ TOOLS/OBSTOOLS/src/greg2jul.h90 \
+                        \ TOOLS/OBSTOOLS/src/obs_sla_types.F90 \
+                        \ TOOLS/OBSTOOLS/src/obssla_io.h90 \
+                        \ TOOLS/OBSTOOLS/src/obs_conv.F90 \
+                        \ TOOLS/OBSTOOLS/src/par_kind.F90 \
+                        \ TOOLS/WEIGHTS/SCRIP1.4 \
+                        \ TOOLS/WEIGHTS/nocsutil \
+                        \ EXTERNAL/IOIPSL/tools/tkcond.c \
+                        \ EXTERNAL/IOIPSL/tools/tkgen.c \
+                        \ EXTERNAL/IOIPSL/tools/tkparse.c \
+                        \ EXTERNAL/IOIPSL/tools/tkparse.h
+extract.path-incl[nemo] = EXTERNAL/IOIPSL NEMO/LIM_SRC_2 NEMO/LIM_SRC_3 NEMO/OPA_SRC NEMO/TOP_SRC \
+                        \ TOOLS/BDY_TOOLS TOOLS/GRIDGEN TOOLS/MPP_PREP TOOLS/NESTING TOOLS/OBSTOOLS/src \
+                        \ TOOLS/REBUILD_NEMO TOOLS/SECTIONS_DIADCT TOOLS/WEIGHTS
+
+preprocess.prop{file-ext.h} = .h90
+
+$nemo_config{?} = amm12
+include = $HERE/keys-$nemo_config.cfg
+
+build.prop{class,no-dep.f.module} = netcdf xios
+build.prop{class,no-dep.include}  = mpif.h netcdf.inc
+
+build.target            = nemo.exe \
+                        \ bdy_reorder mpp_optimiz_zoom_nc.exe mppopt_showproc_nc.exe \
+                        \ agrif_create_bathy.exe agrif_create_coordinates.exe agrif_create_data.exe \
+                        \ agrif_create_restart.exe agrif_create_restart_trc.exe \
+                        \ rebuild flio_rbld.exe rebuild_nemo rebuild_nemo.exe diadct_sections.exe \
+                        \ scrip.exe scripgrid.exe scripinterp.exe scripshape.exe
+build.ns-excl           = nemo/TOOLS/GRIDGEN/src/domain.f90 nemo/TOOLS/GRIDGEN/src/io_netcdf.f90 nemo/TOOLS/OBSTOOLS
+build.prop{dep.o}[nemo/NEMO/OPA_SRC/nemo.f90] = lib_cray.o
+
+build-tools.target      = create_coordinates.exe corio2fb.exe enact2fb.exe fbcomb.exe fbmatchup.exe \
+                        \ fbprint.exe fbsel.exe fbstat.exe fbthin.exe sla2fb.exe vel2fb.exe
+build-tools.ns-excl     = nemo/NEMO/OPA_SRC/DOM/domain.F90 nemo/NEMO/OPA_SRC/par_oce.F90 \
+                        \ nemo/NEMO/OPA_SRC/IOM/in_out_manager.F90 nemo/TOOLS/NESTING/src/io_netcdf.f90
+
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-amm12.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-amm12.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-amm12.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-gyre.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-gyre.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-gyre.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim2 key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim3.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim3 key_vvl key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_asminc
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_sas_lim.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_sas_lim.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/inc/keys-orca2_sas_lim.cfg	(revision 8732)
@@ -0,0 +1,2 @@
+preprocess.prop{fpp.defs} = \
+  key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi
Index: /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/pwr7-xlf-meto.cfg
===================================================================
--- /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/pwr7-xlf-meto.cfg	(revision 8732)
+++ /branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/fcm-make/pwr7-xlf-meto.cfg	(revision 8732)
@@ -0,0 +1,28 @@
+include = $HERE/inc/common.cfg
+
+$netcdf_path{?}     = /home/cr/ocean/hadcv/netcdf/4.1.3_seq
+$netcdf_inc_path{?} = $netcdf_path/include
+$netcdf_lib_path{?} = $netcdf_path/lib
+$netcdf_lib{?}      = netcdff netcdf hdf5 hdf5_hl hdf5_fortran z
+
+$xios_path{?}     = /data/nwp/ofrd/share/NEMO/xios_lib/seq/xios_r445
+$xios_inc_path{?} = $xios_path/inc
+$xios_lib_path{?} = $xios_path/lib
+$xios_lib{?}      = xios
+
+preprocess.prop{fpp.flags}         = -E -P -traditional
+preprocess.prop{fpp.include-paths} = /opt/ibmhpc/pecurrent/ppe.poe/include /usr/lpp/ppe.poe/include/thread64
+
+build.prop{class,fc}               = mpxlf90_r
+build.prop{class,fc.flags}         = -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -NS32768 -g -O3 -qnostrict
+build.prop{class,fc.flags-ld}      = -O3
+build.prop{class,fc.include-paths} = $netcdf_inc_path $xios_inc_path
+build.prop{class,fc.libs}          = xlf90 sig $netcdf_lib $xios_lib
+build.prop{class,fc.lib-paths}     = /projects/um1/lib $netcdf_lib_path $xios_lib_path
+build.prop{class,ld}               = mpCC_r
+
+# WEIGHTS needs a different NetCDF library at the moment
+build.prop{fc.include-paths}[nemo/TOOLS/WEIGHTS] = /home/nwp/ofrd/share/netcdf-3.6.0-p1_ec/include
+build.prop{fc.libs}[nemo/TOOLS/WEIGHTS]          = netcdf
+build.prop{fc.lib-paths}[nemo/TOOLS/WEIGHTS]     = /home/nwp/ofrd/share/netcdf-3.6.0-p1_ec/lib
+build.prop{ld}[nemo/TOOLS/WEIGHTS]               = mpxlf90_r
